Skip to content

Commit

Permalink
Merge branch 'master' into master
Browse files Browse the repository at this point in the history
  • Loading branch information
@friedc
friedc authored Jul 5, 2022
2 parents 9551a31 + 08de166 commit f039b8c
Show file tree
Hide file tree
Showing 15 changed files with 349 additions and 240 deletions.
48 changes: 48 additions & 0 deletions CMAKE/CheckLAPACKCompilerFlags.cmake
View file
Original file line number Diff line number Diff line change
Expand Up @@ -25,6 +25,12 @@ if ( FORTRAN_ILP )
elseif( (CMAKE_Fortran_COMPILER_ID STREQUAL "VisualAge" ) OR # CMake 2.6
(CMAKE_Fortran_COMPILER_ID STREQUAL "XL" ) ) # CMake 2.8
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -qintsize=8")
elseif( CMAKE_Fortran_COMPILER_ID STREQUAL "NAG" )
if ( WIN32 )
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} /i8")
else ()
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -i8")
endif()
else()
set(CPE_ENV $ENV{PE_ENV})
if(CPE_ENV STREQUAL "CRAY")
Expand Down Expand Up @@ -88,6 +94,48 @@ elseif( CMAKE_Fortran_COMPILER_ID STREQUAL "HP" )
CACHE STRING "Flags used by the compiler during release builds" FORCE )
set( CMAKE_Fortran_FLAGS_DEBUG "${CMAKE_Fortran_FLAGS_RELWITHDEBINFO} +O2 -g"
CACHE STRING "Flags used by the compiler during release with debug info builds" FORCE )

# NAG Fortran
elseif( CMAKE_Fortran_COMPILER_ID STREQUAL "NAG" )
if( "${CMAKE_Fortran_FLAGS}" MATCHES "[-/]ieee=(stop|nonstd)" )
set( FPE_EXIT TRUE )
endif()

if( NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "[-/]ieee=full") )
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -ieee=full")
endif()

if( NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "[-/]dcfuns") )
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -dcfuns")
endif()

if( NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "[-/]thread_safe") )
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -thread_safe")
endif()

# Disable warnings
if( NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "[-/]w=obs") )
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -w=obs")
endif()

if( NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "[-/]w=x77") )
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -w=x77")
endif()

if( NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "[-/]w=ques") )
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -w=ques")
endif()

if( NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "[-/]w=unused") )
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -w=unused")
endif()

# Suppress compiler banner and summary
check_fortran_compiler_flag("-quiet" _quiet)
if( _quiet AND NOT ("${CMAKE_Fortran_FLAGS}" MATCHES "[-/]quiet") )
set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -quiet")
endif()

else()
endif()

Expand Down
2 changes: 2 additions & 0 deletions CMakeLists.txt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -133,6 +133,8 @@ elseif(CMAKE_Fortran_COMPILER_ID STREQUAL Intel)
check_fortran_compiler_flag("-recursive" _recursiveFlag)
elseif(CMAKE_Fortran_COMPILER_ID STREQUAL XL)
check_fortran_compiler_flag("-qrecur" _qrecurFlag)
elseif(CMAKE_Fortran_COMPILER_ID STREQUAL NAG)
check_fortran_compiler_flag("-recursive" _recursiveFlag)
else()
message(WARNING "Fortran local arrays should be allocated on the stack."
" Please use a compiler which guarantees that feature."
Expand Down
26 changes: 13 additions & 13 deletions SRC/cgelss.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -266,11 +266,11 @@ SUBROUTINE CGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
*
* Compute space needed for CGEQRF
CALL CGEQRF( M, N, A, LDA, DUM(1), DUM(1), -1, INFO )
LWORK_CGEQRF = REAL( DUM(1) )
LWORK_CGEQRF = INT( DUM(1) )
* Compute space needed for CUNMQR
CALL CUNMQR( 'L', 'C', M, NRHS, N, A, LDA, DUM(1), B,
$ LDB, DUM(1), -1, INFO )
LWORK_CUNMQR = REAL( DUM(1) )
LWORK_CUNMQR = INT( DUM(1) )
MM = N
MAXWRK = MAX( MAXWRK, N + N*ILAENV( 1, 'CGEQRF', ' ', M,
$ N, -1, -1 ) )
Expand All @@ -284,15 +284,15 @@ SUBROUTINE CGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
* Compute space needed for CGEBRD
CALL CGEBRD( MM, N, A, LDA, S, S, DUM(1), DUM(1), DUM(1),
$ -1, INFO )
LWORK_CGEBRD = REAL( DUM(1) )
LWORK_CGEBRD = INT( DUM(1) )
* Compute space needed for CUNMBR
CALL CUNMBR( 'Q', 'L', 'C', MM, NRHS, N, A, LDA, DUM(1),
$ B, LDB, DUM(1), -1, INFO )
LWORK_CUNMBR = REAL( DUM(1) )
LWORK_CUNMBR = INT( DUM(1) )
* Compute space needed for CUNGBR
CALL CUNGBR( 'P', N, N, N, A, LDA, DUM(1),
$ DUM(1), -1, INFO )
LWORK_CUNGBR = REAL( DUM(1) )
LWORK_CUNGBR = INT( DUM(1) )
* Compute total workspace needed
MAXWRK = MAX( MAXWRK, 2*N + LWORK_CGEBRD )
MAXWRK = MAX( MAXWRK, 2*N + LWORK_CUNMBR )
Expand All @@ -310,23 +310,23 @@ SUBROUTINE CGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
* Compute space needed for CGELQF
CALL CGELQF( M, N, A, LDA, DUM(1), DUM(1),
$ -1, INFO )
LWORK_CGELQF = REAL( DUM(1) )
LWORK_CGELQF = INT( DUM(1) )
* Compute space needed for CGEBRD
CALL CGEBRD( M, M, A, LDA, S, S, DUM(1), DUM(1),
$ DUM(1), -1, INFO )
LWORK_CGEBRD = REAL( DUM(1) )
LWORK_CGEBRD = INT( DUM(1) )
* Compute space needed for CUNMBR
CALL CUNMBR( 'Q', 'L', 'C', M, NRHS, N, A, LDA,
$ DUM(1), B, LDB, DUM(1), -1, INFO )
LWORK_CUNMBR = REAL( DUM(1) )
LWORK_CUNMBR = INT( DUM(1) )
* Compute space needed for CUNGBR
CALL CUNGBR( 'P', M, M, M, A, LDA, DUM(1),
$ DUM(1), -1, INFO )
LWORK_CUNGBR = REAL( DUM(1) )
LWORK_CUNGBR = INT( DUM(1) )
* Compute space needed for CUNMLQ
CALL CUNMLQ( 'L', 'C', N, NRHS, M, A, LDA, DUM(1),
$ B, LDB, DUM(1), -1, INFO )
LWORK_CUNMLQ = REAL( DUM(1) )
LWORK_CUNMLQ = INT( DUM(1) )
* Compute total workspace needed
MAXWRK = M + LWORK_CGELQF
MAXWRK = MAX( MAXWRK, 3*M + M*M + LWORK_CGEBRD )
Expand All @@ -345,15 +345,15 @@ SUBROUTINE CGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
* Compute space needed for CGEBRD
CALL CGEBRD( M, N, A, LDA, S, S, DUM(1), DUM(1),
$ DUM(1), -1, INFO )
LWORK_CGEBRD = REAL( DUM(1) )
LWORK_CGEBRD = INT( DUM(1) )
* Compute space needed for CUNMBR
CALL CUNMBR( 'Q', 'L', 'C', M, NRHS, M, A, LDA,
$ DUM(1), B, LDB, DUM(1), -1, INFO )
LWORK_CUNMBR = REAL( DUM(1) )
LWORK_CUNMBR = INT( DUM(1) )
* Compute space needed for CUNGBR
CALL CUNGBR( 'P', M, N, M, A, LDA, DUM(1),
$ DUM(1), -1, INFO )
LWORK_CUNGBR = REAL( DUM(1) )
LWORK_CUNGBR = INT( DUM(1) )
MAXWRK = 2*M + LWORK_CGEBRD
MAXWRK = MAX( MAXWRK, 2*M + LWORK_CUNMBR )
MAXWRK = MAX( MAXWRK, 2*M + LWORK_CUNGBR )
Expand Down
96 changes: 52 additions & 44 deletions SRC/claqr5.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -279,7 +279,7 @@ SUBROUTINE CLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, S,
PARAMETER ( RZERO = 0.0e0, RONE = 1.0e0 )
* ..
* .. Local Scalars ..
COMPLEX ALPHA, BETA, CDUM, REFSUM
COMPLEX ALPHA, BETA, CDUM, REFSUM, T1, T2, T3
REAL H11, H12, H21, H22, SAFMAX, SAFMIN, SCL,
$ SMLNUM, TST1, TST2, ULP
INTEGER I2, I4, INCOL, J, JBOT, JCOL, JLEN,
Expand Down Expand Up @@ -424,12 +424,12 @@ SUBROUTINE CLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, S,
* ==== Perform update from right within
* . computational window. ====
*
T1 = V( 1, M22 )
T2 = T1*CONJG( V( 2, M22 ) )
DO 30 J = JTOP, MIN( KBOT, K+3 )
REFSUM = V( 1, M22 )*( H( J, K+1 )+V( 2, M22 )*
$ H( J, K+2 ) )
H( J, K+1 ) = H( J, K+1 ) - REFSUM
H( J, K+2 ) = H( J, K+2 ) -
$ REFSUM*CONJG( V( 2, M22 ) )
REFSUM = H( J, K+1 ) + V( 2, M22 )*H( J, K+2 )
H( J, K+1 ) = H( J, K+1 ) - REFSUM*T1
H( J, K+2 ) = H( J, K+2 ) - REFSUM*T2
30 CONTINUE
*
* ==== Perform update from left within
Expand All @@ -442,12 +442,13 @@ SUBROUTINE CLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, S,
ELSE
JBOT = KBOT
END IF
T1 = CONJG( V( 1, M22 ) )
T2 = T1*V( 2, M22 )
DO 40 J = K+1, JBOT
REFSUM = CONJG( V( 1, M22 ) )*
$ ( H( K+1, J )+CONJG( V( 2, M22 ) )*
$ H( K+2, J ) )
H( K+1, J ) = H( K+1, J ) - REFSUM
H( K+2, J ) = H( K+2, J ) - REFSUM*V( 2, M22 )
REFSUM = H( K+1, J ) +
$ CONJG( V( 2, M22 ) )*H( K+2, J )
H( K+1, J ) = H( K+1, J ) - REFSUM*T1
H( K+2, J ) = H( K+2, J ) - REFSUM*T2
40 CONTINUE
*
* ==== The following convergence test requires that
Expand Down Expand Up @@ -610,25 +611,28 @@ SUBROUTINE CLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, S,
* . deflation check. We still delay most of the
* . updates from the left for efficiency. ====
*
T1 = V( 1, M )
T2 = T1*CONJG( V( 2, M ) )
T3 = T1*CONJG( V( 3, M ) )
DO 70 J = JTOP, MIN( KBOT, K+3 )
REFSUM = V( 1, M )*( H( J, K+1 )+V( 2, M )*
$ H( J, K+2 )+V( 3, M )*H( J, K+3 ) )
H( J, K+1 ) = H( J, K+1 ) - REFSUM
H( J, K+2 ) = H( J, K+2 ) -
$ REFSUM*CONJG( V( 2, M ) )
H( J, K+3 ) = H( J, K+3 ) -
$ REFSUM*CONJG( V( 3, M ) )
REFSUM = H( J, K+1 ) + V( 2, M )*H( J, K+2 )
$ + V( 3, M )*H( J, K+3 )
H( J, K+1 ) = H( J, K+1 ) - REFSUM*T1
H( J, K+2 ) = H( J, K+2 ) - REFSUM*T2
H( J, K+3 ) = H( J, K+3 ) - REFSUM*T3
70 CONTINUE
*
* ==== Perform update from left for subsequent
* . column. ====
*
REFSUM = CONJG( V( 1, M ) )*( H( K+1, K+1 )
$ +CONJG( V( 2, M ) )*H( K+2, K+1 )
$ +CONJG( V( 3, M ) )*H( K+3, K+1 ) )
H( K+1, K+1 ) = H( K+1, K+1 ) - REFSUM
H( K+2, K+1 ) = H( K+2, K+1 ) - REFSUM*V( 2, M )
H( K+3, K+1 ) = H( K+3, K+1 ) - REFSUM*V( 3, M )
T1 = CONJG( V( 1, M ) )
T2 = T1*V( 2, M )
T3 = T1*V( 3, M )
REFSUM = H( K+1, K+1 ) + CONJG( V( 2, M ) )*H( K+2, K+1 )
$ + CONJG( V( 3, M ) )*H( K+3, K+1 )
H( K+1, K+1 ) = H( K+1, K+1 ) - REFSUM*T1
H( K+2, K+1 ) = H( K+2, K+1 ) - REFSUM*T2
H( K+3, K+1 ) = H( K+3, K+1 ) - REFSUM*T3
*
* ==== The following convergence test requires that
* . the tradition small-compared-to-nearby-diagonals
Expand Down Expand Up @@ -688,13 +692,15 @@ SUBROUTINE CLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, S,
*
DO 100 M = MBOT, MTOP, -1
K = KRCOL + 2*( M-1 )
T1 = CONJG( V( 1, M ) )
T2 = T1*V( 2, M )
T3 = T1*V( 3, M )
DO 90 J = MAX( KTOP, KRCOL + 2*M ), JBOT
REFSUM = CONJG( V( 1, M ) )*
$ ( H( K+1, J )+CONJG( V( 2, M ) )*
$ H( K+2, J )+CONJG( V( 3, M ) )*H( K+3, J ) )
H( K+1, J ) = H( K+1, J ) - REFSUM
H( K+2, J ) = H( K+2, J ) - REFSUM*V( 2, M )
H( K+3, J ) = H( K+3, J ) - REFSUM*V( 3, M )
REFSUM = H( K+1, J ) + CONJG( V( 2, M ) )*
$ H( K+2, J ) + CONJG( V( 3, M ) )*H( K+3, J )
H( K+1, J ) = H( K+1, J ) - REFSUM*T1
H( K+2, J ) = H( K+2, J ) - REFSUM*T2
H( K+3, J ) = H( K+3, J ) - REFSUM*T3
90 CONTINUE
100 CONTINUE
*
Expand All @@ -712,14 +718,15 @@ SUBROUTINE CLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, S,
I2 = MAX( 1, KTOP-INCOL )
I2 = MAX( I2, KMS-(KRCOL-INCOL)+1 )
I4 = MIN( KDU, KRCOL + 2*( MBOT-1 ) - INCOL + 5 )
T1 = V( 1, M )
T2 = T1*CONJG( V( 2, M ) )
T3 = T1*CONJG( V( 3, M ) )
DO 110 J = I2, I4
REFSUM = V( 1, M )*( U( J, KMS+1 )+V( 2, M )*
$ U( J, KMS+2 )+V( 3, M )*U( J, KMS+3 ) )
U( J, KMS+1 ) = U( J, KMS+1 ) - REFSUM
U( J, KMS+2 ) = U( J, KMS+2 ) -
$ REFSUM*CONJG( V( 2, M ) )
U( J, KMS+3 ) = U( J, KMS+3 ) -
$ REFSUM*CONJG( V( 3, M ) )
REFSUM = U( J, KMS+1 ) + V( 2, M )*U( J, KMS+2 )
$ + V( 3, M )*U( J, KMS+3 )
U( J, KMS+1 ) = U( J, KMS+1 ) - REFSUM*T1
U( J, KMS+2 ) = U( J, KMS+2 ) - REFSUM*T2
U( J, KMS+3 ) = U( J, KMS+3 ) - REFSUM*T3
110 CONTINUE
120 CONTINUE
ELSE IF( WANTZ ) THEN
Expand All @@ -730,14 +737,15 @@ SUBROUTINE CLAQR5( WANTT, WANTZ, KACC22, N, KTOP, KBOT, NSHFTS, S,
*
DO 140 M = MBOT, MTOP, -1
K = KRCOL + 2*( M-1 )
T1 = V( 1, M )
T2 = T1*CONJG( V( 2, M ) )
T3 = T1*CONJG( V( 3, M ) )
DO 130 J = ILOZ, IHIZ
REFSUM = V( 1, M )*( Z( J, K+1 )+V( 2, M )*
$ Z( J, K+2 )+V( 3, M )*Z( J, K+3 ) )
Z( J, K+1 ) = Z( J, K+1 ) - REFSUM
Z( J, K+2 ) = Z( J, K+2 ) -
$ REFSUM*CONJG( V( 2, M ) )
Z( J, K+3 ) = Z( J, K+3 ) -
$ REFSUM*CONJG( V( 3, M ) )
REFSUM = Z( J, K+1 ) + V( 2, M )*Z( J, K+2 )
$ + V( 3, M )*Z( J, K+3 )
Z( J, K+1 ) = Z( J, K+1 ) - REFSUM*T1
Z( J, K+2 ) = Z( J, K+2 ) - REFSUM*T2
Z( J, K+3 ) = Z( J, K+3 ) - REFSUM*T3
130 CONTINUE
140 CONTINUE
END IF
Expand Down
24 changes: 12 additions & 12 deletions SRC/dgelss.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -254,11 +254,11 @@ SUBROUTINE DGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
*
* Compute space needed for DGEQRF
CALL DGEQRF( M, N, A, LDA, DUM(1), DUM(1), -1, INFO )
LWORK_DGEQRF=DUM(1)
LWORK_DGEQRF = INT( DUM(1) )
* Compute space needed for DORMQR
CALL DORMQR( 'L', 'T', M, NRHS, N, A, LDA, DUM(1), B,
$ LDB, DUM(1), -1, INFO )
LWORK_DORMQR=DUM(1)
LWORK_DORMQR = INT( DUM(1) )
MM = N
MAXWRK = MAX( MAXWRK, N + LWORK_DGEQRF )
MAXWRK = MAX( MAXWRK, N + LWORK_DORMQR )
Expand All @@ -273,15 +273,15 @@ SUBROUTINE DGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
* Compute space needed for DGEBRD
CALL DGEBRD( MM, N, A, LDA, S, DUM(1), DUM(1),
$ DUM(1), DUM(1), -1, INFO )
LWORK_DGEBRD=DUM(1)
LWORK_DGEBRD = INT( DUM(1) )
* Compute space needed for DORMBR
CALL DORMBR( 'Q', 'L', 'T', MM, NRHS, N, A, LDA, DUM(1),
$ B, LDB, DUM(1), -1, INFO )
LWORK_DORMBR=DUM(1)
LWORK_DORMBR = INT( DUM(1) )
* Compute space needed for DORGBR
CALL DORGBR( 'P', N, N, N, A, LDA, DUM(1),
$ DUM(1), -1, INFO )
LWORK_DORGBR=DUM(1)
LWORK_DORGBR = INT( DUM(1) )
* Compute total workspace needed
MAXWRK = MAX( MAXWRK, 3*N + LWORK_DGEBRD )
MAXWRK = MAX( MAXWRK, 3*N + LWORK_DORMBR )
Expand Down Expand Up @@ -309,19 +309,19 @@ SUBROUTINE DGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
* Compute space needed for DGEBRD
CALL DGEBRD( M, M, A, LDA, S, DUM(1), DUM(1),
$ DUM(1), DUM(1), -1, INFO )
LWORK_DGEBRD=DUM(1)
LWORK_DGEBRD = INT( DUM(1) )
* Compute space needed for DORMBR
CALL DORMBR( 'Q', 'L', 'T', M, NRHS, N, A, LDA,
$ DUM(1), B, LDB, DUM(1), -1, INFO )
LWORK_DORMBR=DUM(1)
LWORK_DORMBR = INT( DUM(1) )
* Compute space needed for DORGBR
CALL DORGBR( 'P', M, M, M, A, LDA, DUM(1),
$ DUM(1), -1, INFO )
LWORK_DORGBR=DUM(1)
LWORK_DORGBR = INT( DUM(1) )
* Compute space needed for DORMLQ
CALL DORMLQ( 'L', 'T', N, NRHS, M, A, LDA, DUM(1),
$ B, LDB, DUM(1), -1, INFO )
LWORK_DORMLQ=DUM(1)
LWORK_DORMLQ = INT( DUM(1) )
* Compute total workspace needed
MAXWRK = M + LWORK_DGELQF
MAXWRK = MAX( MAXWRK, M*M + 4*M + LWORK_DGEBRD )
Expand All @@ -341,15 +341,15 @@ SUBROUTINE DGELSS( M, N, NRHS, A, LDA, B, LDB, S, RCOND, RANK,
* Compute space needed for DGEBRD
CALL DGEBRD( M, N, A, LDA, S, DUM(1), DUM(1),
$ DUM(1), DUM(1), -1, INFO )
LWORK_DGEBRD=DUM(1)
LWORK_DGEBRD = INT( DUM(1) )
* Compute space needed for DORMBR
CALL DORMBR( 'Q', 'L', 'T', M, NRHS, M, A, LDA,
$ DUM(1), B, LDB, DUM(1), -1, INFO )
LWORK_DORMBR=DUM(1)
LWORK_DORMBR = INT( DUM(1) )
* Compute space needed for DORGBR
CALL DORGBR( 'P', M, N, M, A, LDA, DUM(1),
$ DUM(1), -1, INFO )
LWORK_DORGBR=DUM(1)
LWORK_DORGBR = INT( DUM(1) )
MAXWRK = 3*M + LWORK_DGEBRD
MAXWRK = MAX( MAXWRK, 3*M + LWORK_DORMBR )
MAXWRK = MAX( MAXWRK, 3*M + LWORK_DORGBR )
Expand Down
Loading

0 comments on commit f039b8c

Please sign in to comment.