Skip to content

Commit

Permalink
Merge pull request Reference-LAPACK#854 from angsch/dynamic-alloc
Browse files Browse the repository at this point in the history 
Attempt to fix Appveyor on Windows
  • Loading branch information
@langou
langou authored Jun 17, 2023
2 parents a83d8d2 + e6a8f4b commit 824c1cf
Show file tree
Hide file tree
Showing 4 changed files with 114 additions and 22 deletions.
33 changes: 28 additions & 5 deletions TESTING/EIG/csyl01.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -120,14 +120,16 @@ SUBROUTINE CSYL01( THRESH, NFAIL, RMAX, NINFO, KNT )
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
Expand All @@ -139,6 +141,20 @@ SUBROUTINE CSYL01( THRESH, NFAIL, RMAX, NINFO, KNT )
* .. 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
Expand Down Expand Up @@ -286,6 +302,13 @@ SUBROUTINE CSYL01( THRESH, NFAIL, RMAX, NINFO, KNT )
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
*
Expand Down
35 changes: 29 additions & 6 deletions TESTING/EIG/dsyl01.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -117,13 +117,15 @@ SUBROUTINE DSYL01( THRESH, NFAIL, RMAX, NINFO, KNT )
$ 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
Expand All @@ -136,6 +138,20 @@ SUBROUTINE DSYL01( THRESH, NFAIL, RMAX, NINFO, KNT )
* .. 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
Expand Down Expand Up @@ -280,6 +296,13 @@ SUBROUTINE DSYL01( THRESH, NFAIL, RMAX, NINFO, KNT )
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
*
Expand Down
35 changes: 29 additions & 6 deletions TESTING/EIG/ssyl01.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -117,13 +117,15 @@ SUBROUTINE SSYL01( THRESH, NFAIL, RMAX, NINFO, KNT )
$ 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
Expand All @@ -136,6 +138,20 @@ SUBROUTINE SSYL01( THRESH, NFAIL, RMAX, NINFO, KNT )
* .. 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
Expand Down Expand Up @@ -280,6 +296,13 @@ SUBROUTINE SSYL01( THRESH, NFAIL, RMAX, NINFO, KNT )
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
*
Expand Down
33 changes: 28 additions & 5 deletions TESTING/EIG/zsyl01.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -120,14 +120,16 @@ SUBROUTINE ZSYL01( THRESH, NFAIL, RMAX, NINFO, KNT )
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
Expand All @@ -139,6 +141,20 @@ SUBROUTINE ZSYL01( THRESH, NFAIL, RMAX, NINFO, KNT )
* .. 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
Expand Down Expand Up @@ -286,6 +302,13 @@ SUBROUTINE ZSYL01( THRESH, NFAIL, RMAX, NINFO, KNT )
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
*
Expand Down

0 comments on commit 824c1cf

Please sign in to comment.