Skip to content

Commit 9d85169

Browse files
Merge pull request #553 from martin-frbg/issue548
Use dynamic allocation in the LIN tests as well
2 parents 956a370 + 96db3e4 commit 9d85169

File tree

6 files changed

+98
-21
lines changed

6 files changed

+98
-21
lines changed

TESTING/LIN/CMakeLists.txt

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,7 @@ set(SCLNTST slaord.f)
66

77
set(DZLNTST dlaord.f)
88

9-
set(SLINTST schkaa.f
9+
set(SLINTST schkaa.F
1010
schkeq.f schkgb.f schkge.f schkgt.f
1111
schklq.f schkpb.f schkpo.f schkps.f schkpp.f
1212
schkpt.f schkq3.f schkql.f schkqr.f schkrq.f
@@ -51,7 +51,7 @@ else()
5151
serrvx.f serrge.f serrsy.f serrpo.f)
5252
endif()
5353

54-
set(CLINTST cchkaa.f
54+
set(CLINTST cchkaa.F
5555
cchkeq.f cchkgb.f cchkge.f cchkgt.f
5656
cchkhe.f cchkhe_rook.f cchkhe_rk.f
5757
cchkhe_aa.f cchkhe_aa_2stage.f
@@ -107,7 +107,7 @@ else()
107107
cerrvx.f cerrge.f cerrhe.f cerrsy.f cerrpo.f)
108108
endif()
109109

110-
set(DLINTST dchkaa.f
110+
set(DLINTST dchkaa.F
111111
dchkeq.f dchkgb.f dchkge.f dchkgt.f
112112
dchklq.f dchkpb.f dchkpo.f dchkps.f dchkpp.f
113113
dchkpt.f dchkq3.f dchkql.f dchkqr.f dchkrq.f
@@ -153,7 +153,7 @@ else()
153153
derrvx.f derrge.f derrsy.f derrpo.f)
154154
endif()
155155

156-
set(ZLINTST zchkaa.f
156+
set(ZLINTST zchkaa.F
157157
zchkeq.f zchkgb.f zchkge.f zchkgt.f
158158
zchkhe.f zchkhe_rook.f zchkhe_rk.f
159159
zchkhe_aa.f zchkhe_aa_2stage.f

TESTING/LIN/Makefile

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -317,13 +317,13 @@ cleanobj:
317317
cleanexe:
318318
rm -f xlintst*
319319

320-
schkaa.o: schkaa.f
320+
schkaa.o: schkaa.F
321321
$(FC) $(FFLAGS_DRV) -c -o $@ $<
322-
dchkaa.o: dchkaa.f
322+
dchkaa.o: dchkaa.F
323323
$(FC) $(FFLAGS_DRV) -c -o $@ $<
324-
cchkaa.o: cchkaa.f
324+
cchkaa.o: cchkaa.F
325325
$(FC) $(FFLAGS_DRV) -c -o $@ $<
326-
zchkaa.o: zchkaa.f
326+
zchkaa.o: zchkaa.F
327327
$(FC) $(FFLAGS_DRV) -c -o $@ $<
328328

329329
.NOTPARALLEL:

TESTING/LIN/cchkaa.f renamed to TESTING/LIN/cchkaa.F

Lines changed: 23 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -153,9 +153,13 @@ PROGRAM CCHKAA
153153
$ NBVAL( MAXIN ), NBVAL2( MAXIN ),
154154
$ NSVAL( MAXIN ), NVAL( MAXIN ), NXVAL( MAXIN ),
155155
$ RANKVAL( MAXIN ), PIV( NMAX )
156-
REAL RWORK( 150*NMAX+2*MAXRHS ), S( 2*NMAX )
157-
COMPLEX A( ( KDMAX+1 )*NMAX, 7 ), B( NMAX*MAXRHS, 4 ),
158-
$ E( NMAX ), WORK( NMAX, NMAX+MAXRHS+10 )
156+
REAL S( 2*NMAX )
157+
COMPLEX E( NMAX )
158+
* ..
159+
* .. Allocatable Arrays ..
160+
INTEGER AllocateStatus
161+
REAL, DIMENSION(:), ALLOCATABLE :: RWORK
162+
COMPLEX, DIMENSION(:,:), ALLOCATABLE :: A, B, WORK
159163
* ..
160164
* .. External Functions ..
161165
LOGICAL LSAME, LSAMEN
@@ -191,6 +195,17 @@ PROGRAM CCHKAA
191195
* .. Data statements ..
192196
DATA THREQ / 2.0 / , INTSTR / '0123456789' /
193197
* ..
198+
* .. Allocate memory dynamically ..
199+
*
200+
ALLOCATE ( A( ( KDMAX+1 )*NMAX, 7 ), STAT = AllocateStatus )
201+
IF (AllocateStatus /= 0) STOP "*** Not enough memory ***"
202+
ALLOCATE ( B( NMAX*MAXRHS, 4 ), STAT = AllocateStatus )
203+
IF (AllocateStatus /= 0) STOP "*** Not enough memory ***"
204+
ALLOCATE ( WORK( NMAX, NMAX+MAXRHS+10 ), STAT = AllocateStatus )
205+
IF (AllocateStatus /= 0) STOP "*** Not enough memory ***"
206+
ALLOCATE ( RWORK( 150*NMAX+2*MAXRHS ), STAT = AllocateStatus )
207+
IF (AllocateStatus /= 0) STOP "*** Not enough memory ***"
208+
* ..
194209
* .. Executable Statements ..
195210
*
196211
S1 = SECOND( )
@@ -1193,6 +1208,11 @@ PROGRAM CCHKAA
11931208
S2 = SECOND( )
11941209
WRITE( NOUT, FMT = 9998 )
11951210
WRITE( NOUT, FMT = 9997 )S2 - S1
1211+
*
1212+
DEALLOCATE (A, STAT = AllocateStatus)
1213+
DEALLOCATE (B, STAT = AllocateStatus)
1214+
DEALLOCATE (WORK, STAT = AllocateStatus)
1215+
DEALLOCATE (RWORK, STAT = AllocateStatus)
11961216
*
11971217
9999 FORMAT( / ' Execution not attempted due to input errors' )
11981218
9998 FORMAT( / ' End of tests' )

TESTING/LIN/dchkaa.f renamed to TESTING/LIN/dchkaa.F

Lines changed: 23 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -114,7 +114,6 @@ PROGRAM DCHKAA
114114
* -- LAPACK test routine --
115115
* -- LAPACK is a software package provided by Univ. of Tennessee, --
116116
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
117-
* Novemebr 2019
118117
*
119118
* =====================================================================
120119
*
@@ -150,9 +149,12 @@ PROGRAM DCHKAA
150149
$ NBVAL( MAXIN ), NBVAL2( MAXIN ),
151150
$ NSVAL( MAXIN ), NVAL( MAXIN ), NXVAL( MAXIN ),
152151
$ RANKVAL( MAXIN ), PIV( NMAX )
153-
DOUBLE PRECISION A( ( KDMAX+1 )*NMAX, 7 ), B( NMAX*MAXRHS, 4 ),
154-
$ E( NMAX ), RWORK( 5*NMAX+2*MAXRHS ),
155-
$ S( 2*NMAX ), WORK( NMAX, 3*NMAX+MAXRHS+30 )
152+
DOUBLE PRECISION E( NMAX ), S( 2*NMAX )
153+
* ..
154+
* .. Allocatable Arrays ..
155+
INTEGER AllocateStatus
156+
DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: RWORK
157+
DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE :: A, B, WORK
156158
* ..
157159
* .. External Functions ..
158160
LOGICAL LSAME, LSAMEN
@@ -186,6 +188,18 @@ PROGRAM DCHKAA
186188
* .. Data statements ..
187189
DATA THREQ / 2.0D0 / , INTSTR / '0123456789' /
188190
* ..
191+
* ..
192+
* .. Allocate memory dynamically ..
193+
*
194+
ALLOCATE ( A( ( KDMAX+1 )*NMAX, 7 ), STAT = AllocateStatus )
195+
IF (AllocateStatus /= 0) STOP "*** Not enough memory ***"
196+
ALLOCATE ( B( NMAX*MAXRHS, 4 ), STAT = AllocateStatus )
197+
IF (AllocateStatus /= 0) STOP "*** Not enough memory ***"
198+
ALLOCATE ( WORK( NMAX, 3*NMAX+MAXRHS+30 ), STAT = AllocateStatus )
199+
IF (AllocateStatus /= 0) STOP "*** Not enough memory ***"
200+
ALLOCATE ( RWORK( 5*NMAX+2*MAXRHS ), STAT = AllocateStatus )
201+
IF (AllocateStatus /= 0) STOP "*** Not enough memory ***"
202+
*
189203
* .. Executable Statements ..
190204
*
191205
S1 = DSECND( )
@@ -1037,6 +1051,11 @@ PROGRAM DCHKAA
10371051
S2 = DSECND( )
10381052
WRITE( NOUT, FMT = 9998 )
10391053
WRITE( NOUT, FMT = 9997 )S2 - S1
1054+
*
1055+
DEALLOCATE (A, STAT = AllocateStatus)
1056+
DEALLOCATE (B, STAT = AllocateStatus)
1057+
DEALLOCATE (WORK, STAT = AllocateStatus)
1058+
DEALLOCATE (RWORK, STAT = AllocateStatus)
10401059
*
10411060
9999 FORMAT( / ' Execution not attempted due to input errors' )
10421061
9998 FORMAT( / ' End of tests' )

TESTING/LIN/schkaa.f renamed to TESTING/LIN/schkaa.F

Lines changed: 22 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -147,9 +147,12 @@ PROGRAM SCHKAA
147147
$ NBVAL( MAXIN ), NBVAL2( MAXIN ),
148148
$ NSVAL( MAXIN ), NVAL( MAXIN ), NXVAL( MAXIN ),
149149
$ RANKVAL( MAXIN ), PIV( NMAX )
150-
REAL A( ( KDMAX+1 )*NMAX, 7 ), B( NMAX*MAXRHS, 4 ),
151-
$ E( NMAX ), RWORK( 5*NMAX+2*MAXRHS ),
152-
$ S( 2*NMAX ), WORK( NMAX, NMAX+MAXRHS+30 )
150+
REAL E( NMAX ), S( 2*NMAX )
151+
* ..
152+
* .. Allocatable Arrays ..
153+
INTEGER AllocateStatus
154+
REAL, DIMENSION(:), ALLOCATABLE :: RWORK
155+
REAL, DIMENSION(:,:), ALLOCATABLE :: A, B, WORK
153156
* ..
154157
* .. External Functions ..
155158
LOGICAL LSAME, LSAMEN
@@ -183,6 +186,17 @@ PROGRAM SCHKAA
183186
* .. Data statements ..
184187
DATA THREQ / 2.0E0 / , INTSTR / '0123456789' /
185188
* ..
189+
* .. Allocate memory dynamically ..
190+
*
191+
ALLOCATE (A( ( KDMAX+1 )*NMAX, 7 ), STAT = AllocateStatus )
192+
IF (AllocateStatus /= 0) STOP "*** Not enough memory ***"
193+
ALLOCATE (B( NMAX*MAXRHS, 4 ), STAT = AllocateStatus )
194+
IF (AllocateStatus /= 0) STOP "*** Not enough memory ***"
195+
ALLOCATE (WORK( NMAX, NMAX+MAXRHS+30 ) , STAT = AllocateStatus )
196+
IF (AllocateStatus /= 0) STOP "*** Not enough memory ***"
197+
ALLOCATE (RWORK( 5*NMAX+2*MAXRHS ), STAT = AllocateStatus )
198+
IF (AllocateStatus /= 0) STOP "*** Not enough memory ***"
199+
* ..
186200
* .. Executable Statements ..
187201
*
188202
S1 = SECOND( )
@@ -1031,6 +1045,11 @@ PROGRAM SCHKAA
10311045
S2 = SECOND( )
10321046
WRITE( NOUT, FMT = 9998 )
10331047
WRITE( NOUT, FMT = 9997 )S2 - S1
1048+
*
1049+
DEALLOCATE (A, STAT = AllocateStatus)
1050+
DEALLOCATE (B, STAT = AllocateStatus)
1051+
DEALLOCATE (WORK, STAT = AllocateStatus)
1052+
DEALLOCATE (RWORK, STAT = AllocateStatus)
10341053
*
10351054
9999 FORMAT( / ' Execution not attempted due to input errors' )
10361055
9998 FORMAT( / ' End of tests' )

TESTING/LIN/zchkaa.f renamed to TESTING/LIN/zchkaa.F

Lines changed: 22 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -153,9 +153,13 @@ PROGRAM ZCHKAA
153153
$ NBVAL( MAXIN ), NBVAL2( MAXIN ),
154154
$ NSVAL( MAXIN ), NVAL( MAXIN ), NXVAL( MAXIN ),
155155
$ RANKVAL( MAXIN ), PIV( NMAX )
156-
DOUBLE PRECISION RWORK( 150*NMAX+2*MAXRHS ), S( 2*NMAX )
157-
COMPLEX*16 A( ( KDMAX+1 )*NMAX, 7 ), B( NMAX*MAXRHS, 4 ),
158-
$ E( NMAX ), WORK( NMAX, NMAX+MAXRHS+10 )
156+
DOUBLE PRECISION S( 2*NMAX )
157+
COMPLEX*16 E( NMAX )
158+
*
159+
* .. Allocatable Arrays ..
160+
INTEGER AllocateStatus
161+
DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE:: RWORK
162+
COMPLEX*16, DIMENSION(:,:), ALLOCATABLE:: A, B, WORK
159163
* ..
160164
* .. External Functions ..
161165
LOGICAL LSAME, LSAMEN
@@ -191,6 +195,16 @@ PROGRAM ZCHKAA
191195
* ..
192196
* .. Data statements ..
193197
DATA THREQ / 2.0D0 / , INTSTR / '0123456789' /
198+
*
199+
* .. Allocate memory dynamically ..
200+
ALLOCATE (RWORK( 150*NMAX+2*MAXRHS ), STAT = AllocateStatus)
201+
IF (AllocateStatus /= 0) STOP "*** Not enough memory ***"
202+
ALLOCATE (A ((KDMAX+1) * NMAX, 7), STAT = AllocateStatus)
203+
IF (AllocateStatus /= 0) STOP "*** Not enough memory ***"
204+
ALLOCATE (B (NMAX * MAXRHS, 4), STAT = AllocateStatus)
205+
IF (AllocateStatus /= 0) STOP "*** Not enough memory ***"
206+
ALLOCATE (WORK (NMAX, NMAX+MAXRHS+10), STAT = AllocateStatus)
207+
IF (AllocateStatus /= 0) STOP "*** Not enough memory ***"
194208
* ..
195209
* .. Executable Statements ..
196210
*
@@ -1228,6 +1242,11 @@ PROGRAM ZCHKAA
12281242
S2 = DSECND( )
12291243
WRITE( NOUT, FMT = 9998 )
12301244
WRITE( NOUT, FMT = 9997 )S2 - S1
1245+
*
1246+
DEALLOCATE (A, STAT = AllocateStatus)
1247+
DEALLOCATE (B, STAT = AllocateStatus)
1248+
DEALLOCATE (RWORK, STAT = AllocateStatus)
1249+
DEALLOCATE (WORK, STAT = AllocateStatus)
12311250
*
12321251
9999 FORMAT( / ' Execution not attempted due to input errors' )
12331252
9998 FORMAT( / ' End of tests' )

0 commit comments

Comments
 (0)