Skip to content

Commit 8ff127d

Browse files
martin-frbgmartin-frbg
authored
Use dynamic allocation for all large arrays
1 parent b1b81b2 commit 8ff127d

File tree

4 files changed

+90
-13
lines changed

4 files changed

+90
-13
lines changed

‎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

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

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

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)