Skip to content

Commit db501d9

Browse files
authored
Merge pull request #959 from dklyuchinskiy/lapack-fix-dmd-issues
fix some DMD issues
2 parents c2255a8 + 4787915 commit db501d9

File tree

6 files changed

+41
-10
lines changed

6 files changed

+41
-10
lines changed

SRC/cgedmd.f90

+4-2
Original file line numberDiff line numberDiff line change
@@ -761,7 +761,8 @@ SUBROUTINE CGEDMD( JOBS, JOBZ, JOBR, JOBF, WHTSVD, &
761761
K = 0
762762
DO i = 1, N
763763
!WORK(i) = SCNRM2( M, X(1,i), 1 )
764-
SCALE = ZERO
764+
SSUM = ONE
765+
SCALE = ZERO
765766
CALL CLASSQ( M, X(1,i), 1, SCALE, SSUM )
766767
IF ( SISNAN(SCALE) .OR. SISNAN(SSUM) ) THEN
767768
K = 0
@@ -834,7 +835,8 @@ SUBROUTINE CGEDMD( JOBS, JOBZ, JOBR, JOBF, WHTSVD, &
834835
! carefully computed using CLASSQ.
835836
DO i = 1, N
836837
!RWORK(i) = SCNRM2( M, Y(1,i), 1 )
837-
SCALE = ZERO
838+
SSUM = ONE
839+
SCALE = ZERO
838840
CALL CLASSQ( M, Y(1,i), 1, SCALE, SSUM )
839841
IF ( SISNAN(SCALE) .OR. SISNAN(SSUM) ) THEN
840842
K = 0

SRC/dgedmd.f90

+4-2
Original file line numberDiff line numberDiff line change
@@ -783,7 +783,8 @@ SUBROUTINE DGEDMD( JOBS, JOBZ, JOBR, JOBF, WHTSVD, &
783783
K = 0
784784
DO i = 1, N
785785
!WORK(i) = DNRM2( M, X(1,i), 1 )
786-
SCALE = ZERO
786+
SSUM = ONE
787+
SCALE = ZERO
787788
CALL DLASSQ( M, X(1,i), 1, SCALE, SSUM )
788789
IF ( DISNAN(SCALE) .OR. DISNAN(SSUM) ) THEN
789790
K = 0
@@ -856,7 +857,8 @@ SUBROUTINE DGEDMD( JOBS, JOBZ, JOBR, JOBF, WHTSVD, &
856857
! carefully computed using DLASSQ.
857858
DO i = 1, N
858859
!WORK(i) = DNRM2( M, Y(1,i), 1 )
859-
SCALE = ZERO
860+
SSUM = ONE
861+
SCALE = ZERO
860862
CALL DLASSQ( M, Y(1,i), 1, SCALE, SSUM )
861863
IF ( DISNAN(SCALE) .OR. DISNAN(SSUM) ) THEN
862864
K = 0

SRC/sgedmd.f90

+4-2
Original file line numberDiff line numberDiff line change
@@ -782,7 +782,8 @@ SUBROUTINE SGEDMD( JOBS, JOBZ, JOBR, JOBF, WHTSVD, &
782782
K = 0
783783
DO i = 1, N
784784
!WORK(i) = DNRM2( M, X(1,i), 1 )
785-
SCALE = ZERO
785+
SSUM = ONE
786+
SCALE = ZERO
786787
CALL SLASSQ( M, X(1,i), 1, SCALE, SSUM )
787788
IF ( SISNAN(SCALE) .OR. SISNAN(SSUM) ) THEN
788789
K = 0
@@ -855,7 +856,8 @@ SUBROUTINE SGEDMD( JOBS, JOBZ, JOBR, JOBF, WHTSVD, &
855856
! carefully computed using SLASSQ.
856857
DO i = 1, N
857858
!WORK(i) = DNRM2( M, Y(1,i), 1 )
858-
SCALE = ZERO
859+
SSUM = ONE
860+
SCALE = ZERO
859861
CALL SLASSQ( M, Y(1,i), 1, SCALE, SSUM )
860862
IF ( SISNAN(SCALE) .OR. SISNAN(SSUM) ) THEN
861863
K = 0

SRC/zgedmd.f90

+4-2
Original file line numberDiff line numberDiff line change
@@ -758,7 +758,8 @@ SUBROUTINE ZGEDMD( JOBS, JOBZ, JOBR, JOBF, WHTSVD, &
758758
K = 0
759759
DO i = 1, N
760760
!WORK(i) = DZNRM2( M, X(1,i), 1 )
761-
SCALE = ZERO
761+
SSUM = ONE
762+
SCALE = ZERO
762763
CALL ZLASSQ( M, X(1,i), 1, SCALE, SSUM )
763764
IF ( DISNAN(SCALE) .OR. DISNAN(SSUM) ) THEN
764765
K = 0
@@ -831,7 +832,8 @@ SUBROUTINE ZGEDMD( JOBS, JOBZ, JOBR, JOBF, WHTSVD, &
831832
! carefully computed using ZLASSQ.
832833
DO i = 1, N
833834
!RWORK(i) = DZNRM2( M, Y(1,i), 1 )
834-
SCALE = ZERO
835+
SSUM = ONE
836+
SCALE = ZERO
835837
CALL ZLASSQ( M, Y(1,i), 1, SCALE, SSUM )
836838
IF ( DISNAN(SCALE) .OR. DISNAN(SSUM) ) THEN
837839
K = 0

TESTING/CMakeLists.txt

+12-2
Original file line numberDiff line numberDiff line change
@@ -53,9 +53,7 @@ add_lapack_test(stest.out stest.in xlintsts)
5353
# ======== SINGLE RFP LIN TESTS ========================
5454
add_lapack_test(stest_rfp.out stest_rfp.in xlintstrfs)
5555
#
56-
#
5756
# ======== SINGLE EIG TESTS ===========================
58-
#
5957
add_lapack_test(snep.out nep.in xeigtsts)
6058
add_lapack_test(ssep.out sep.in xeigtsts)
6159
add_lapack_test(sse2.out se2.in xeigtsts)
@@ -76,6 +74,9 @@ add_lapack_test(sgqr.out gqr.in xeigtsts)
7674
add_lapack_test(sgsv.out gsv.in xeigtsts)
7775
add_lapack_test(scsd.out csd.in xeigtsts)
7876
add_lapack_test(slse.out lse.in xeigtsts)
77+
#
78+
# ======== SINGLE DMD EIG TESTS ===========================
79+
add_lapack_test(sdmd.out sdmd.in xdmdeigtsts)
7980
endif()
8081

8182
if(BUILD_DOUBLE)
@@ -107,6 +108,9 @@ add_lapack_test(dgqr.out gqr.in xeigtstd)
107108
add_lapack_test(dgsv.out gsv.in xeigtstd)
108109
add_lapack_test(dcsd.out csd.in xeigtstd)
109110
add_lapack_test(dlse.out lse.in xeigtstd)
111+
#
112+
# ======== DOUBLE DMD EIG TESTS ===========================
113+
add_lapack_test(ddmd.out ddmd.in xdmdeigtstd)
110114
endif()
111115

112116
if(BUILD_COMPLEX)
@@ -136,6 +140,9 @@ add_lapack_test(cgqr.out gqr.in xeigtstc)
136140
add_lapack_test(cgsv.out gsv.in xeigtstc)
137141
add_lapack_test(ccsd.out csd.in xeigtstc)
138142
add_lapack_test(clse.out lse.in xeigtstc)
143+
#
144+
# ======== COMPLEX DMD EIG TESTS ===========================
145+
add_lapack_test(cdmd.out cdmd.in xdmdeigtstc)
139146
endif()
140147

141148
if(BUILD_COMPLEX16)
@@ -167,6 +174,9 @@ add_lapack_test(zgqr.out gqr.in xeigtstz)
167174
add_lapack_test(zgsv.out gsv.in xeigtstz)
168175
add_lapack_test(zcsd.out csd.in xeigtstz)
169176
add_lapack_test(zlse.out lse.in xeigtstz)
177+
#
178+
# ======== COMPLEX16 DMD EIG TESTS ===========================
179+
add_lapack_test(zdmd.out zdmd.in xdmdeigtstz)
170180
endif()
171181

172182

TESTING/EIG/CMakeLists.txt

+13
Original file line numberDiff line numberDiff line change
@@ -42,6 +42,8 @@ set(SEIGTST schkee.F
4242
sort03.f ssbt21.f ssgt01.f sslect.f sspt21.f sstt21.f
4343
sstt22.f ssyl01.f ssyt21.f ssyt22.f)
4444

45+
set(SDMDEIGTST schkdmd.f90)
46+
4547
set(CEIGTST cchkee.F
4648
cbdt01.f cbdt02.f cbdt03.f cbdt05.f
4749
cchkbb.f cchkbd.f cchkbk.f cchkbl.f cchkec.f
@@ -59,6 +61,8 @@ set(CEIGTST cchkee.F
5961
csgt01.f cslect.f csyl01.f
6062
cstt21.f cstt22.f cunt01.f cunt03.f)
6163

64+
set(CDMDEIGTST cchkdmd.f90)
65+
6266
set(DZIGTST dlafts.f dlahd2.f dlasum.f dlatb9.f dstech.f dstect.f
6367
dsvdch.f dsvdct.f dsxt1.f)
6468

@@ -79,6 +83,8 @@ set(DEIGTST dchkee.F
7983
dort03.f dsbt21.f dsgt01.f dslect.f dspt21.f dstt21.f
8084
dstt22.f dsyl01.f dsyt21.f dsyt22.f)
8185

86+
set(DDMDEIGTST dchkdmd.f90)
87+
8288
set(ZEIGTST zchkee.F
8389
zbdt01.f zbdt02.f zbdt03.f zbdt05.f
8490
zchkbb.f zchkbd.f zchkbk.f zchkbl.f zchkec.f
@@ -96,23 +102,30 @@ set(ZEIGTST zchkee.F
96102
zsgt01.f zslect.f zsyl01.f
97103
zstt21.f zstt22.f zunt01.f zunt03.f)
98104

105+
set(ZDMDEIGTST zchkdmd.f90)
106+
99107
macro(add_eig_executable name)
100108
add_executable(${name} ${ARGN})
101109
target_link_libraries(${name} ${TMGLIB} ${LAPACK_LIBRARIES} ${BLAS_LIBRARIES})
102110
endmacro()
103111

104112
if(BUILD_SINGLE)
105113
add_eig_executable(xeigtsts ${SEIGTST} ${SCIGTST} ${AEIGTST})
114+
add_eig_executable(xdmdeigtsts ${SDMDEIGTST})
106115
endif()
107116

108117
if(BUILD_COMPLEX)
109118
add_eig_executable(xeigtstc ${CEIGTST} ${SCIGTST} ${AEIGTST})
119+
add_eig_executable(xdmdeigtstc ${CDMDEIGTST})
110120
endif()
111121

122+
112123
if(BUILD_DOUBLE)
113124
add_eig_executable(xeigtstd ${DEIGTST} ${DZIGTST} ${AEIGTST})
125+
add_eig_executable(xdmdeigtstd ${DDMDEIGTST})
114126
endif()
115127

116128
if(BUILD_COMPLEX16)
117129
add_eig_executable(xeigtstz ${ZEIGTST} ${DZIGTST} ${AEIGTST})
130+
add_eig_executable(xdmdeigtstz ${ZDMDEIGTST})
118131
endif()

0 commit comments

Comments
 (0)