Define type conversions explicitly (Reference-LAPACK PR 703)

This commit is contained in:
Martin Kroeker 2022-11-19 15:22:46 +01:00 committed by GitHub
parent e9b0f5a364
commit 4e60737c2d
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
18 changed files with 44 additions and 44 deletions

View File

@ -238,7 +238,7 @@
$ GO TO 40 $ GO TO 40
IF( I.LT.ILO ) IF( I.LT.ILO )
$ I = ILO - II $ I = ILO - II
K = SCALE( I ) K = INT( SCALE( I ) )
IF( K.EQ.I ) IF( K.EQ.I )
$ GO TO 40 $ GO TO 40
CALL ZSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV ) CALL ZSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
@ -252,7 +252,7 @@
$ GO TO 50 $ GO TO 50
IF( I.LT.ILO ) IF( I.LT.ILO )
$ I = ILO - II $ I = ILO - II
K = SCALE( I ) K = INT( SCALE( I ) )
IF( K.EQ.I ) IF( K.EQ.I )
$ GO TO 50 $ GO TO 50
CALL ZSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV ) CALL ZSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )

View File

@ -282,7 +282,7 @@
* *
CALL ZHSEQR( 'S', JOBVS, N, 1, N, A, LDA, W, VS, LDVS, CALL ZHSEQR( 'S', JOBVS, N, 1, N, A, LDA, W, VS, LDVS,
$ WORK, -1, IEVAL ) $ WORK, -1, IEVAL )
HSWORK = DBLE( WORK( 1 ) ) HSWORK = INT( WORK( 1 ) )
* *
IF( .NOT.WANTVS ) THEN IF( .NOT.WANTVS ) THEN
MAXWRK = MAX( MAXWRK, HSWORK ) MAXWRK = MAX( MAXWRK, HSWORK )

View File

@ -337,7 +337,7 @@
* *
CALL ZHSEQR( 'S', JOBVS, N, 1, N, A, LDA, W, VS, LDVS, CALL ZHSEQR( 'S', JOBVS, N, 1, N, A, LDA, W, VS, LDVS,
$ WORK, -1, IEVAL ) $ WORK, -1, IEVAL )
HSWORK = DBLE( WORK( 1 ) ) HSWORK = INT( WORK( 1 ) )
* *
IF( .NOT.WANTVS ) THEN IF( .NOT.WANTVS ) THEN
MAXWRK = MAX( MAXWRK, HSWORK ) MAXWRK = MAX( MAXWRK, HSWORK )

View File

@ -707,11 +707,11 @@
IF ( LQUERY ) THEN IF ( LQUERY ) THEN
CALL ZGEQP3( M, N, A, LDA, IWORK, CDUMMY, CDUMMY, -1, CALL ZGEQP3( M, N, A, LDA, IWORK, CDUMMY, CDUMMY, -1,
$ RDUMMY, IERR ) $ RDUMMY, IERR )
LWRK_ZGEQP3 = DBLE( CDUMMY(1) ) LWRK_ZGEQP3 = INT( CDUMMY(1) )
CALL ZGEQRF( N, N, A, LDA, CDUMMY, CDUMMY,-1, IERR ) CALL ZGEQRF( N, N, A, LDA, CDUMMY, CDUMMY,-1, IERR )
LWRK_ZGEQRF = DBLE( CDUMMY(1) ) LWRK_ZGEQRF = INT( CDUMMY(1) )
CALL ZGELQF( N, N, A, LDA, CDUMMY, CDUMMY,-1, IERR ) CALL ZGELQF( N, N, A, LDA, CDUMMY, CDUMMY,-1, IERR )
LWRK_ZGELQF = DBLE( CDUMMY(1) ) LWRK_ZGELQF = INT( CDUMMY(1) )
END IF END IF
MINWRK = 2 MINWRK = 2
OPTWRK = 2 OPTWRK = 2
@ -727,7 +727,7 @@
IF ( LQUERY ) THEN IF ( LQUERY ) THEN
CALL ZGESVJ( 'L', 'N', 'N', N, N, A, LDA, SVA, N, V, CALL ZGESVJ( 'L', 'N', 'N', N, N, A, LDA, SVA, N, V,
$ LDV, CDUMMY, -1, RDUMMY, -1, IERR ) $ LDV, CDUMMY, -1, RDUMMY, -1, IERR )
LWRK_ZGESVJ = DBLE( CDUMMY(1) ) LWRK_ZGESVJ = INT( CDUMMY(1) )
IF ( ERREST ) THEN IF ( ERREST ) THEN
OPTWRK = MAX( N+LWRK_ZGEQP3, N**2+LWCON, OPTWRK = MAX( N+LWRK_ZGEQP3, N**2+LWCON,
$ N+LWRK_ZGEQRF, LWRK_ZGESVJ ) $ N+LWRK_ZGEQRF, LWRK_ZGESVJ )
@ -763,10 +763,10 @@
IF ( LQUERY ) THEN IF ( LQUERY ) THEN
CALL ZGESVJ( 'L', 'U', 'N', N,N, U, LDU, SVA, N, A, CALL ZGESVJ( 'L', 'U', 'N', N,N, U, LDU, SVA, N, A,
$ LDA, CDUMMY, -1, RDUMMY, -1, IERR ) $ LDA, CDUMMY, -1, RDUMMY, -1, IERR )
LWRK_ZGESVJ = DBLE( CDUMMY(1) ) LWRK_ZGESVJ = INT( CDUMMY(1) )
CALL ZUNMLQ( 'L', 'C', N, N, N, A, LDA, CDUMMY, CALL ZUNMLQ( 'L', 'C', N, N, N, A, LDA, CDUMMY,
$ V, LDV, CDUMMY, -1, IERR ) $ V, LDV, CDUMMY, -1, IERR )
LWRK_ZUNMLQ = DBLE( CDUMMY(1) ) LWRK_ZUNMLQ = INT( CDUMMY(1) )
IF ( ERREST ) THEN IF ( ERREST ) THEN
OPTWRK = MAX( N+LWRK_ZGEQP3, LWCON, LWRK_ZGESVJ, OPTWRK = MAX( N+LWRK_ZGEQP3, LWCON, LWRK_ZGESVJ,
$ N+LWRK_ZGELQF, 2*N+LWRK_ZGEQRF, $ N+LWRK_ZGELQF, 2*N+LWRK_ZGEQRF,
@ -802,10 +802,10 @@
IF ( LQUERY ) THEN IF ( LQUERY ) THEN
CALL ZGESVJ( 'L', 'U', 'N', N,N, U, LDU, SVA, N, A, CALL ZGESVJ( 'L', 'U', 'N', N,N, U, LDU, SVA, N, A,
$ LDA, CDUMMY, -1, RDUMMY, -1, IERR ) $ LDA, CDUMMY, -1, RDUMMY, -1, IERR )
LWRK_ZGESVJ = DBLE( CDUMMY(1) ) LWRK_ZGESVJ = INT( CDUMMY(1) )
CALL ZUNMQR( 'L', 'N', M, N, N, A, LDA, CDUMMY, U, CALL ZUNMQR( 'L', 'N', M, N, N, A, LDA, CDUMMY, U,
$ LDU, CDUMMY, -1, IERR ) $ LDU, CDUMMY, -1, IERR )
LWRK_ZUNMQRM = DBLE( CDUMMY(1) ) LWRK_ZUNMQRM = INT( CDUMMY(1) )
IF ( ERREST ) THEN IF ( ERREST ) THEN
OPTWRK = N + MAX( LWRK_ZGEQP3, LWCON, N+LWRK_ZGEQRF, OPTWRK = N + MAX( LWRK_ZGEQP3, LWCON, N+LWRK_ZGEQRF,
$ LWRK_ZGESVJ, LWRK_ZUNMQRM ) $ LWRK_ZGESVJ, LWRK_ZUNMQRM )
@ -864,26 +864,26 @@
IF ( LQUERY ) THEN IF ( LQUERY ) THEN
CALL ZUNMQR( 'L', 'N', M, N, N, A, LDA, CDUMMY, U, CALL ZUNMQR( 'L', 'N', M, N, N, A, LDA, CDUMMY, U,
$ LDU, CDUMMY, -1, IERR ) $ LDU, CDUMMY, -1, IERR )
LWRK_ZUNMQRM = DBLE( CDUMMY(1) ) LWRK_ZUNMQRM = INT( CDUMMY(1) )
CALL ZUNMQR( 'L', 'N', N, N, N, A, LDA, CDUMMY, U, CALL ZUNMQR( 'L', 'N', N, N, N, A, LDA, CDUMMY, U,
$ LDU, CDUMMY, -1, IERR ) $ LDU, CDUMMY, -1, IERR )
LWRK_ZUNMQR = DBLE( CDUMMY(1) ) LWRK_ZUNMQR = INT( CDUMMY(1) )
IF ( .NOT. JRACC ) THEN IF ( .NOT. JRACC ) THEN
CALL ZGEQP3( N,N, A, LDA, IWORK, CDUMMY,CDUMMY, -1, CALL ZGEQP3( N,N, A, LDA, IWORK, CDUMMY,CDUMMY, -1,
$ RDUMMY, IERR ) $ RDUMMY, IERR )
LWRK_ZGEQP3N = DBLE( CDUMMY(1) ) LWRK_ZGEQP3N = INT( CDUMMY(1) )
CALL ZGESVJ( 'L', 'U', 'N', N, N, U, LDU, SVA, CALL ZGESVJ( 'L', 'U', 'N', N, N, U, LDU, SVA,
$ N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR ) $ N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR )
LWRK_ZGESVJ = DBLE( CDUMMY(1) ) LWRK_ZGESVJ = INT( CDUMMY(1) )
CALL ZGESVJ( 'U', 'U', 'N', N, N, U, LDU, SVA, CALL ZGESVJ( 'U', 'U', 'N', N, N, U, LDU, SVA,
$ N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR ) $ N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR )
LWRK_ZGESVJU = DBLE( CDUMMY(1) ) LWRK_ZGESVJU = INT( CDUMMY(1) )
CALL ZGESVJ( 'L', 'U', 'V', N, N, U, LDU, SVA, CALL ZGESVJ( 'L', 'U', 'V', N, N, U, LDU, SVA,
$ N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR ) $ N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR )
LWRK_ZGESVJV = DBLE( CDUMMY(1) ) LWRK_ZGESVJV = INT( CDUMMY(1) )
CALL ZUNMLQ( 'L', 'C', N, N, N, A, LDA, CDUMMY, CALL ZUNMLQ( 'L', 'C', N, N, N, A, LDA, CDUMMY,
$ V, LDV, CDUMMY, -1, IERR ) $ V, LDV, CDUMMY, -1, IERR )
LWRK_ZUNMLQ = DBLE( CDUMMY(1) ) LWRK_ZUNMLQ = INT( CDUMMY(1) )
IF ( ERREST ) THEN IF ( ERREST ) THEN
OPTWRK = MAX( N+LWRK_ZGEQP3, N+LWCON, OPTWRK = MAX( N+LWRK_ZGEQP3, N+LWCON,
$ 2*N+N**2+LWCON, 2*N+LWRK_ZGEQRF, $ 2*N+N**2+LWCON, 2*N+LWRK_ZGEQRF,
@ -912,13 +912,13 @@
ELSE ELSE
CALL ZGESVJ( 'L', 'U', 'V', N, N, U, LDU, SVA, CALL ZGESVJ( 'L', 'U', 'V', N, N, U, LDU, SVA,
$ N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR ) $ N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR )
LWRK_ZGESVJV = DBLE( CDUMMY(1) ) LWRK_ZGESVJV = INT( CDUMMY(1) )
CALL ZUNMQR( 'L', 'N', N, N, N, CDUMMY, N, CDUMMY, CALL ZUNMQR( 'L', 'N', N, N, N, CDUMMY, N, CDUMMY,
$ V, LDV, CDUMMY, -1, IERR ) $ V, LDV, CDUMMY, -1, IERR )
LWRK_ZUNMQR = DBLE( CDUMMY(1) ) LWRK_ZUNMQR = INT( CDUMMY(1) )
CALL ZUNMQR( 'L', 'N', M, N, N, A, LDA, CDUMMY, U, CALL ZUNMQR( 'L', 'N', M, N, N, A, LDA, CDUMMY, U,
$ LDU, CDUMMY, -1, IERR ) $ LDU, CDUMMY, -1, IERR )
LWRK_ZUNMQRM = DBLE( CDUMMY(1) ) LWRK_ZUNMQRM = INT( CDUMMY(1) )
IF ( ERREST ) THEN IF ( ERREST ) THEN
OPTWRK = MAX( N+LWRK_ZGEQP3, N+LWCON, OPTWRK = MAX( N+LWRK_ZGEQP3, N+LWCON,
$ 2*N+LWRK_ZGEQRF, 2*N+N**2, $ 2*N+LWRK_ZGEQRF, 2*N+N**2,

View File

@ -289,7 +289,7 @@
* *
CALL ZGGQRF( N, M, P, A, LDA, WORK, B, LDB, WORK( M+1 ), CALL ZGGQRF( N, M, P, A, LDA, WORK, B, LDB, WORK( M+1 ),
$ WORK( M+NP+1 ), LWORK-M-NP, INFO ) $ WORK( M+NP+1 ), LWORK-M-NP, INFO )
LOPT = DBLE( WORK( M+NP+1 ) ) LOPT = INT( WORK( M+NP+1 ) )
* *
* Update left-hand-side vector d = Q**H*d = ( d1 ) M * Update left-hand-side vector d = Q**H*d = ( d1 ) M
* ( d2 ) N-M * ( d2 ) N-M

View File

@ -276,7 +276,7 @@
* *
CALL ZGGRQF( P, M, N, B, LDB, WORK, A, LDA, WORK( P+1 ), CALL ZGGRQF( P, M, N, B, LDB, WORK, A, LDA, WORK( P+1 ),
$ WORK( P+MN+1 ), LWORK-P-MN, INFO ) $ WORK( P+MN+1 ), LWORK-P-MN, INFO )
LOPT = DBLE( WORK( P+MN+1 ) ) LOPT = INT( WORK( P+MN+1 ) )
* *
* Update c = Z**H *c = ( c1 ) N-P * Update c = Z**H *c = ( c1 ) N-P
* ( c2 ) M+P-N * ( c2 ) M+P-N

View File

@ -276,7 +276,7 @@
* QR factorization of N-by-M matrix A: A = Q*R * QR factorization of N-by-M matrix A: A = Q*R
* *
CALL ZGEQRF( N, M, A, LDA, TAUA, WORK, LWORK, INFO ) CALL ZGEQRF( N, M, A, LDA, TAUA, WORK, LWORK, INFO )
LOPT = DBLE( WORK( 1 ) ) LOPT = INT( WORK( 1 ) )
* *
* Update B := Q**H*B. * Update B := Q**H*B.
* *

View File

@ -275,7 +275,7 @@
* RQ factorization of M-by-N matrix A: A = R*Q * RQ factorization of M-by-N matrix A: A = R*Q
* *
CALL ZGERQF( M, N, A, LDA, TAUA, WORK, LWORK, INFO ) CALL ZGERQF( M, N, A, LDA, TAUA, WORK, LWORK, INFO )
LOPT = DBLE( WORK( 1 ) ) LOPT = INT( WORK( 1 ) )
* *
* Update B := B*Q**H * Update B := B*Q**H
* *

View File

@ -360,9 +360,9 @@
CALL ZHEGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) CALL ZHEGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
CALL ZHEEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK, LRWORK, CALL ZHEEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK, LRWORK,
$ IWORK, LIWORK, INFO ) $ IWORK, LIWORK, INFO )
LOPT = MAX( DBLE( LOPT ), DBLE( WORK( 1 ) ) ) LOPT = INT( MAX( DBLE( LOPT ), DBLE( WORK( 1 ) ) ) )
LROPT = MAX( DBLE( LROPT ), DBLE( RWORK( 1 ) ) ) LROPT = INT( MAX( DBLE( LROPT ), DBLE( RWORK( 1 ) ) ) )
LIOPT = MAX( DBLE( LIOPT ), DBLE( IWORK( 1 ) ) ) LIOPT = INT( MAX( DBLE( LIOPT ), DBLE( IWORK( 1 ) ) ) )
* *
IF( WANTZ .AND. INFO.EQ.0 ) THEN IF( WANTZ .AND. INFO.EQ.0 ) THEN
* *

View File

@ -280,7 +280,7 @@
LWKOPT = 1 LWKOPT = 1
ELSE ELSE
CALL ZHETRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, -1, INFO ) CALL ZHETRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, -1, INFO )
LWKOPT = DBLE( WORK(1) ) LWKOPT = INT( DBLE( WORK( 1 ) ) )
END IF END IF
WORK( 1 ) = LWKOPT WORK( 1 ) = LWKOPT
END IF END IF

View File

@ -335,9 +335,9 @@
CALL ZHPGST( ITYPE, UPLO, N, AP, BP, INFO ) CALL ZHPGST( ITYPE, UPLO, N, AP, BP, INFO )
CALL ZHPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK, RWORK, CALL ZHPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK, RWORK,
$ LRWORK, IWORK, LIWORK, INFO ) $ LRWORK, IWORK, LIWORK, INFO )
LWMIN = MAX( DBLE( LWMIN ), DBLE( WORK( 1 ) ) ) LWMIN = INT( MAX( DBLE( LWMIN ), DBLE( WORK( 1 ) ) ) )
LRWMIN = MAX( DBLE( LRWMIN ), DBLE( RWORK( 1 ) ) ) LRWMIN = INT( MAX( DBLE( LRWMIN ), DBLE( RWORK( 1 ) ) ) )
LIWMIN = MAX( DBLE( LIWMIN ), DBLE( IWORK( 1 ) ) ) LIWMIN = INT( MAX( DBLE( LIWMIN ), DBLE( IWORK( 1 ) ) ) )
* *
IF( WANTZ ) THEN IF( WANTZ ) THEN
* *

View File

@ -124,7 +124,7 @@
DOUBLE PRECISION RMAX DOUBLE PRECISION RMAX
* .. * ..
* .. Intrinsic Functions .. * .. Intrinsic Functions ..
INTRINSIC DBLE, DIMAG INTRINSIC DBLE, DIMAG, CMPLX
* .. * ..
* .. External Functions .. * .. External Functions ..
REAL SLAMCH REAL SLAMCH
@ -142,7 +142,7 @@
INFO = 1 INFO = 1
GO TO 30 GO TO 30
END IF END IF
SA( I, J ) = A( I, J ) SA( I, J ) = CMPLX( A( I, J ) )
10 CONTINUE 10 CONTINUE
20 CONTINUE 20 CONTINUE
INFO = 0 INFO = 0

View File

@ -348,9 +348,9 @@
B = ( ZETA2*ZETA2+ZETA1*ZETA1-ONE )*HALF B = ( ZETA2*ZETA2+ZETA1*ZETA1-ONE )*HALF
C = ZETA1*ZETA1 C = ZETA1*ZETA1
IF( B.GE.ZERO ) THEN IF( B.GE.ZERO ) THEN
T = -C / ( B+SQRT( B*B+C ) ) T = DBLE( -C / ( B+SQRT( B*B+C ) ) )
ELSE ELSE
T = B - SQRT( B*B+C ) T = DBLE( B - SQRT( B*B+C ) )
END IF END IF
SINE = -( ALPHA / ABSEST ) / T SINE = -( ALPHA / ABSEST ) / T
COSINE = -( GAMMA / ABSEST ) / ( ONE+T ) COSINE = -( GAMMA / ABSEST ) / ( ONE+T )

View File

@ -130,7 +130,7 @@
LOGICAL UPPER LOGICAL UPPER
* .. * ..
* .. Intrinsic Functions .. * .. Intrinsic Functions ..
INTRINSIC DBLE, DIMAG INTRINSIC DBLE, DIMAG, CMPLX
* .. * ..
* .. External Functions .. * .. External Functions ..
REAL SLAMCH REAL SLAMCH
@ -151,7 +151,7 @@
INFO = 1 INFO = 1
GO TO 50 GO TO 50
END IF END IF
SA( I, J ) = A( I, J ) SA( I, J ) = CMPLX( A( I, J ) )
10 CONTINUE 10 CONTINUE
20 CONTINUE 20 CONTINUE
ELSE ELSE
@ -164,7 +164,7 @@
INFO = 1 INFO = 1
GO TO 50 GO TO 50
END IF END IF
SA( I, J ) = A( I, J ) SA( I, J ) = CMPLX( A( I, J ) )
30 CONTINUE 30 CONTINUE
40 CONTINUE 40 CONTINUE
END IF END IF

View File

@ -223,7 +223,7 @@
LWKOPT = 1 LWKOPT = 1
ELSE ELSE
CALL ZSYTRF( UPLO, N, A, LDA, IPIV, WORK, -1, INFO ) CALL ZSYTRF( UPLO, N, A, LDA, IPIV, WORK, -1, INFO )
LWKOPT = DBLE( WORK(1) ) LWKOPT = INT( DBLE( WORK( 1 ) ) )
END IF END IF
WORK( 1 ) = LWKOPT WORK( 1 ) = LWKOPT
END IF END IF

View File

@ -280,7 +280,7 @@
LWKOPT = 1 LWKOPT = 1
ELSE ELSE
CALL ZSYTRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, -1, INFO ) CALL ZSYTRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, -1, INFO )
LWKOPT = DBLE( WORK(1) ) LWKOPT = INT( DBLE( WORK( 1 ) ) )
END IF END IF
WORK( 1 ) = LWKOPT WORK( 1 ) = LWKOPT
END IF END IF

View File

@ -256,7 +256,7 @@
LWKOPT = 1 LWKOPT = 1
ELSE ELSE
CALL ZSYTRF_ROOK( UPLO, N, A, LDA, IPIV, WORK, -1, INFO ) CALL ZSYTRF_ROOK( UPLO, N, A, LDA, IPIV, WORK, -1, INFO )
LWKOPT = DBLE( WORK(1) ) LWKOPT = INT( DBLE( WORK( 1 ) ) )
END IF END IF
WORK( 1 ) = LWKOPT WORK( 1 ) = LWKOPT
END IF END IF

View File

@ -233,7 +233,7 @@
END IF END IF
END IF END IF
END IF END IF
LWKOPT = DBLE( WORK( 1 ) ) LWKOPT = INT( DBLE( WORK( 1 ) ) )
LWKOPT = MAX (LWKOPT, MN) LWKOPT = MAX (LWKOPT, MN)
END IF END IF
* *