floraachy
/
OpenBLAS
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Use dynamic allocation in ?SYL01 tests (Reference-LAPACK PR 854)

This commit is contained in:
Martin Kroeker 2023-06-18 11:17:21 +02:00 committed by GitHub
parent c3a2d407a0
commit 0e55702b80
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
4 changed files with 114 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
lapack-netlib/TESTING/EIG/csyl01.f
View File

@ -120,14 +120,16 @@
COMPLEX RMUL
* ..
* .. Local Arrays ..
COMPLEX A( MAXM, MAXM ), B( MAXN, MAXN ),
$ C( MAXM, MAXN ), CC( MAXM, MAXN ),
$ X( MAXM, MAXN ),
$ DUML( MAXM ), DUMR( MAXN ),
COMPLEX DUML( MAXM ), DUMR( MAXN ),
$ D( MAX( MAXM, MAXN ) )
REAL SWORK( LDSWORK, 54 ), DUM( MAXN ), VM( 2 )
REAL DUM( MAXN ), VM( 2 )
INTEGER ISEED( 4 ), IWORK( MAXM + MAXN + 2 )
* ..
* .. Allocatable Arrays ..
INTEGER AllocateStatus
COMPLEX, DIMENSION(:,:), ALLOCATABLE :: A, B, C, CC, X
REAL, DIMENSION(:,:), ALLOCATABLE :: SWORK
* ..
* .. External Functions ..
LOGICAL SISNAN
REAL SLAMCH, CLANGE
@ -139,6 +141,20 @@
* .. Intrinsic Functions ..
INTRINSIC ABS, REAL, MAX
* ..
* .. Allocate memory dynamically ..
ALLOCATE ( A( MAXM, MAXM ), STAT = AllocateStatus )
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
ALLOCATE ( B( MAXN, MAXN ), STAT = AllocateStatus )
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
ALLOCATE ( C( MAXM, MAXN ), STAT = AllocateStatus )
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
ALLOCATE ( CC( MAXM, MAXN ), STAT = AllocateStatus )
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
ALLOCATE ( X( MAXM, MAXN ), STAT = AllocateStatus )
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
ALLOCATE ( SWORK( LDSWORK, 54 ), STAT = AllocateStatus )
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
* ..
* .. Executable Statements ..
*
* Get machine parameters
@ -286,6 +302,13 @@
END DO
END DO
END DO
*
DEALLOCATE (A, STAT = AllocateStatus)
DEALLOCATE (B, STAT = AllocateStatus)
DEALLOCATE (C, STAT = AllocateStatus)
DEALLOCATE (CC, STAT = AllocateStatus)
DEALLOCATE (X, STAT = AllocateStatus)
DEALLOCATE (SWORK, STAT = AllocateStatus)
*
RETURN
*

35
lapack-netlib/TESTING/EIG/dsyl01.f
View File

@ -117,13 +117,15 @@
$ SCALE, SCALE3, SMLNUM, TNRM, XNRM
* ..
* .. Local Arrays ..
DOUBLE PRECISION A( MAXM, MAXM ), B( MAXN, MAXN ),
$ C( MAXM, MAXN ), CC( MAXM, MAXN ),
$ X( MAXM, MAXN ),
$ DUML( MAXM ), DUMR( MAXN ),
DOUBLE PRECISION DUML( MAXM ), DUMR( MAXN ),
$ D( MAX( MAXM, MAXN ) ), DUM( MAXN ),
$ SWORK( LDSWORK, 126 ), VM( 2 )
INTEGER ISEED( 4 ), IWORK( MAXM + MAXN + 2 ), IDUM( 2 )
$ VM( 2 )
INTEGER ISEED( 4 ), IWORK( MAXM + MAXN + 2 )
* ..
* .. Allocatable Arrays ..
INTEGER AllocateStatus
DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE :: A, B, C, CC, X,
$ SWORK
* ..
* .. External Functions ..
LOGICAL DISNAN
@ -136,6 +138,20 @@
* .. Intrinsic Functions ..
INTRINSIC ABS, DBLE, MAX
* ..
* .. Allocate memory dynamically ..
ALLOCATE ( A( MAXM, MAXM ), STAT = AllocateStatus )
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
ALLOCATE ( B( MAXN, MAXN ), STAT = AllocateStatus )
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
ALLOCATE ( C( MAXM, MAXN ), STAT = AllocateStatus )
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
ALLOCATE ( CC( MAXM, MAXN ), STAT = AllocateStatus )
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
ALLOCATE ( X( MAXM, MAXN ), STAT = AllocateStatus )
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
ALLOCATE ( SWORK( LDSWORK, 126 ), STAT = AllocateStatus )
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
* ..
* .. Executable Statements ..
*
* Get machine parameters
@ -280,6 +296,13 @@
END DO
END DO
END DO
*
DEALLOCATE (A, STAT = AllocateStatus)
DEALLOCATE (B, STAT = AllocateStatus)
DEALLOCATE (C, STAT = AllocateStatus)
DEALLOCATE (CC, STAT = AllocateStatus)
DEALLOCATE (X, STAT = AllocateStatus)
DEALLOCATE (SWORK, STAT = AllocateStatus)
*
RETURN
*

35
lapack-netlib/TESTING/EIG/ssyl01.f
View File

@ -117,13 +117,15 @@
$ SCALE, SCALE3, SMLNUM, TNRM, XNRM
* ..
* .. Local Arrays ..
REAL A( MAXM, MAXM ), B( MAXN, MAXN ),
$ C( MAXM, MAXN ), CC( MAXM, MAXN ),
$ X( MAXM, MAXN ),
$ DUML( MAXM ), DUMR( MAXN ),
REAL DUML( MAXM ), DUMR( MAXN ),
$ D( MAX( MAXM, MAXN ) ), DUM( MAXN ),
$ SWORK( LDSWORK, 54 ), VM( 2 )
INTEGER ISEED( 4 ), IWORK( MAXM + MAXN + 2 ), IDUM( 2 )
$ VM( 2 )
INTEGER ISEED( 4 ), IWORK( MAXM + MAXN + 2 )
* ..
* .. Allocatable Arrays ..
INTEGER AllocateStatus
REAL, DIMENSION(:,:), ALLOCATABLE :: A, B, C, CC, X,
$ SWORK
* ..
* .. External Functions ..
LOGICAL SISNAN
@ -136,6 +138,20 @@
* .. Intrinsic Functions ..
INTRINSIC ABS, REAL, MAX
* ..
* .. Allocate memory dynamically ..
ALLOCATE ( A( MAXM, MAXM ), STAT = AllocateStatus )
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
ALLOCATE ( B( MAXN, MAXN ), STAT = AllocateStatus )
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
ALLOCATE ( C( MAXM, MAXN ), STAT = AllocateStatus )
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
ALLOCATE ( CC( MAXM, MAXN ), STAT = AllocateStatus )
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
ALLOCATE ( X( MAXM, MAXN ), STAT = AllocateStatus )
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
ALLOCATE ( SWORK( LDSWORK, 54 ), STAT = AllocateStatus )
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
* ..
* .. Executable Statements ..
*
* Get machine parameters
@ -280,6 +296,13 @@
END DO
END DO
END DO
*
DEALLOCATE (A, STAT = AllocateStatus)
DEALLOCATE (B, STAT = AllocateStatus)
DEALLOCATE (C, STAT = AllocateStatus)
DEALLOCATE (CC, STAT = AllocateStatus)
DEALLOCATE (X, STAT = AllocateStatus)
DEALLOCATE (SWORK, STAT = AllocateStatus)
*
RETURN
*

33
lapack-netlib/TESTING/EIG/zsyl01.f
View File

@ -120,14 +120,16 @@
COMPLEX*16 RMUL
* ..
* .. Local Arrays ..
COMPLEX*16 A( MAXM, MAXM ), B( MAXN, MAXN ),
$ C( MAXM, MAXN ), CC( MAXM, MAXN ),
$ X( MAXM, MAXN ),
$ DUML( MAXM ), DUMR( MAXN ),
COMPLEX*16 DUML( MAXM ), DUMR( MAXN ),
$ D( MAX( MAXM, MAXN ) )
DOUBLE PRECISION SWORK( LDSWORK, 103 ), DUM( MAXN ), VM( 2 )
DOUBLE PRECISION DUM( MAXN ), VM( 2 )
INTEGER ISEED( 4 ), IWORK( MAXM + MAXN + 2 )
* ..
* .. Allocatable Arrays ..
INTEGER AllocateStatus
COMPLEX*16, DIMENSION(:,:), ALLOCATABLE :: A, B, C, CC, X
DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE :: SWORK
* ..
* .. External Functions ..
LOGICAL DISNAN
DOUBLE PRECISION DLAMCH, ZLANGE
@ -139,6 +141,20 @@
* .. Intrinsic Functions ..
INTRINSIC ABS, DBLE, MAX, SQRT
* ..
* .. Allocate memory dynamically ..
ALLOCATE ( A( MAXM, MAXM ), STAT = AllocateStatus )
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
ALLOCATE ( B( MAXN, MAXN ), STAT = AllocateStatus )
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
ALLOCATE ( C( MAXM, MAXN ), STAT = AllocateStatus )
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
ALLOCATE ( CC( MAXM, MAXN ), STAT = AllocateStatus )
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
ALLOCATE ( X( MAXM, MAXN ), STAT = AllocateStatus )
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
ALLOCATE ( SWORK( LDSWORK, 103 ), STAT = AllocateStatus )
IF( AllocateStatus /= 0 ) STOP "*** Not enough memory ***"
* ..
* .. Executable Statements ..
*
* Get machine parameters
@ -286,6 +302,13 @@
END DO
END DO
END DO
*
DEALLOCATE (A, STAT = AllocateStatus)
DEALLOCATE (B, STAT = AllocateStatus)
DEALLOCATE (C, STAT = AllocateStatus)
DEALLOCATE (CC, STAT = AllocateStatus)
DEALLOCATE (X, STAT = AllocateStatus)
DEALLOCATE (SWORK, STAT = AllocateStatus)
*
RETURN
*