Define type conversions explicitly (Reference-LAPACK PR 703)
This commit is contained in:
parent
35295912a3
commit
08bc43c73d
|
@ -236,7 +236,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 DSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
|
CALL DSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
|
||||||
|
@ -250,7 +250,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 DSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
|
CALL DSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV )
|
||||||
|
|
|
@ -302,7 +302,7 @@
|
||||||
*
|
*
|
||||||
CALL DHSEQR( 'S', JOBVS, N, 1, N, A, LDA, WR, WI, VS, LDVS,
|
CALL DHSEQR( 'S', JOBVS, N, 1, N, A, LDA, WR, WI, VS, LDVS,
|
||||||
$ WORK, -1, IEVAL )
|
$ WORK, -1, IEVAL )
|
||||||
HSWORK = WORK( 1 )
|
HSWORK = INT( WORK( 1 ) )
|
||||||
*
|
*
|
||||||
IF( .NOT.WANTVS ) THEN
|
IF( .NOT.WANTVS ) THEN
|
||||||
MAXWRK = MAX( MAXWRK, N + HSWORK )
|
MAXWRK = MAX( MAXWRK, N + HSWORK )
|
||||||
|
|
|
@ -382,7 +382,7 @@
|
||||||
*
|
*
|
||||||
CALL DHSEQR( 'S', JOBVS, N, 1, N, A, LDA, WR, WI, VS, LDVS,
|
CALL DHSEQR( 'S', JOBVS, N, 1, N, A, LDA, WR, WI, VS, LDVS,
|
||||||
$ WORK, -1, IEVAL )
|
$ WORK, -1, IEVAL )
|
||||||
HSWORK = WORK( 1 )
|
HSWORK = INT( WORK( 1 ) )
|
||||||
*
|
*
|
||||||
IF( .NOT.WANTVS ) THEN
|
IF( .NOT.WANTVS ) THEN
|
||||||
MAXWRK = MAX( MAXWRK, N + HSWORK )
|
MAXWRK = MAX( MAXWRK, N + HSWORK )
|
||||||
|
|
|
@ -254,11 +254,11 @@
|
||||||
*
|
*
|
||||||
* Compute space needed for DGEQRF
|
* Compute space needed for DGEQRF
|
||||||
CALL DGEQRF( M, N, A, LDA, DUM(1), DUM(1), -1, INFO )
|
CALL DGEQRF( M, N, A, LDA, DUM(1), DUM(1), -1, INFO )
|
||||||
LWORK_DGEQRF=DUM(1)
|
LWORK_DGEQRF = INT( DUM(1) )
|
||||||
* Compute space needed for DORMQR
|
* Compute space needed for DORMQR
|
||||||
CALL DORMQR( 'L', 'T', M, NRHS, N, A, LDA, DUM(1), B,
|
CALL DORMQR( 'L', 'T', M, NRHS, N, A, LDA, DUM(1), B,
|
||||||
$ LDB, DUM(1), -1, INFO )
|
$ LDB, DUM(1), -1, INFO )
|
||||||
LWORK_DORMQR=DUM(1)
|
LWORK_DORMQR = INT( DUM(1) )
|
||||||
MM = N
|
MM = N
|
||||||
MAXWRK = MAX( MAXWRK, N + LWORK_DGEQRF )
|
MAXWRK = MAX( MAXWRK, N + LWORK_DGEQRF )
|
||||||
MAXWRK = MAX( MAXWRK, N + LWORK_DORMQR )
|
MAXWRK = MAX( MAXWRK, N + LWORK_DORMQR )
|
||||||
|
@ -273,15 +273,15 @@
|
||||||
* Compute space needed for DGEBRD
|
* Compute space needed for DGEBRD
|
||||||
CALL DGEBRD( MM, N, A, LDA, S, DUM(1), DUM(1),
|
CALL DGEBRD( MM, N, A, LDA, S, DUM(1), DUM(1),
|
||||||
$ DUM(1), DUM(1), -1, INFO )
|
$ DUM(1), DUM(1), -1, INFO )
|
||||||
LWORK_DGEBRD=DUM(1)
|
LWORK_DGEBRD = INT( DUM(1) )
|
||||||
* Compute space needed for DORMBR
|
* Compute space needed for DORMBR
|
||||||
CALL DORMBR( 'Q', 'L', 'T', MM, NRHS, N, A, LDA, DUM(1),
|
CALL DORMBR( 'Q', 'L', 'T', MM, NRHS, N, A, LDA, DUM(1),
|
||||||
$ B, LDB, DUM(1), -1, INFO )
|
$ B, LDB, DUM(1), -1, INFO )
|
||||||
LWORK_DORMBR=DUM(1)
|
LWORK_DORMBR = INT( DUM(1) )
|
||||||
* Compute space needed for DORGBR
|
* Compute space needed for DORGBR
|
||||||
CALL DORGBR( 'P', N, N, N, A, LDA, DUM(1),
|
CALL DORGBR( 'P', N, N, N, A, LDA, DUM(1),
|
||||||
$ DUM(1), -1, INFO )
|
$ DUM(1), -1, INFO )
|
||||||
LWORK_DORGBR=DUM(1)
|
LWORK_DORGBR = INT( DUM(1) )
|
||||||
* Compute total workspace needed
|
* Compute total workspace needed
|
||||||
MAXWRK = MAX( MAXWRK, 3*N + LWORK_DGEBRD )
|
MAXWRK = MAX( MAXWRK, 3*N + LWORK_DGEBRD )
|
||||||
MAXWRK = MAX( MAXWRK, 3*N + LWORK_DORMBR )
|
MAXWRK = MAX( MAXWRK, 3*N + LWORK_DORMBR )
|
||||||
|
@ -305,23 +305,23 @@
|
||||||
* Compute space needed for DGELQF
|
* Compute space needed for DGELQF
|
||||||
CALL DGELQF( M, N, A, LDA, DUM(1), DUM(1),
|
CALL DGELQF( M, N, A, LDA, DUM(1), DUM(1),
|
||||||
$ -1, INFO )
|
$ -1, INFO )
|
||||||
LWORK_DGELQF=DUM(1)
|
LWORK_DGELQF = INT( DUM(1) )
|
||||||
* Compute space needed for DGEBRD
|
* Compute space needed for DGEBRD
|
||||||
CALL DGEBRD( M, M, A, LDA, S, DUM(1), DUM(1),
|
CALL DGEBRD( M, M, A, LDA, S, DUM(1), DUM(1),
|
||||||
$ DUM(1), DUM(1), -1, INFO )
|
$ DUM(1), DUM(1), -1, INFO )
|
||||||
LWORK_DGEBRD=DUM(1)
|
LWORK_DGEBRD = INT( DUM(1) )
|
||||||
* Compute space needed for DORMBR
|
* Compute space needed for DORMBR
|
||||||
CALL DORMBR( 'Q', 'L', 'T', M, NRHS, N, A, LDA,
|
CALL DORMBR( 'Q', 'L', 'T', M, NRHS, N, A, LDA,
|
||||||
$ DUM(1), B, LDB, DUM(1), -1, INFO )
|
$ DUM(1), B, LDB, DUM(1), -1, INFO )
|
||||||
LWORK_DORMBR=DUM(1)
|
LWORK_DORMBR = INT( DUM(1) )
|
||||||
* Compute space needed for DORGBR
|
* Compute space needed for DORGBR
|
||||||
CALL DORGBR( 'P', M, M, M, A, LDA, DUM(1),
|
CALL DORGBR( 'P', M, M, M, A, LDA, DUM(1),
|
||||||
$ DUM(1), -1, INFO )
|
$ DUM(1), -1, INFO )
|
||||||
LWORK_DORGBR=DUM(1)
|
LWORK_DORGBR = INT( DUM(1) )
|
||||||
* Compute space needed for DORMLQ
|
* Compute space needed for DORMLQ
|
||||||
CALL DORMLQ( 'L', 'T', N, NRHS, M, A, LDA, DUM(1),
|
CALL DORMLQ( 'L', 'T', N, NRHS, M, A, LDA, DUM(1),
|
||||||
$ B, LDB, DUM(1), -1, INFO )
|
$ B, LDB, DUM(1), -1, INFO )
|
||||||
LWORK_DORMLQ=DUM(1)
|
LWORK_DORMLQ = INT( DUM(1) )
|
||||||
* Compute total workspace needed
|
* Compute total workspace needed
|
||||||
MAXWRK = M + LWORK_DGELQF
|
MAXWRK = M + LWORK_DGELQF
|
||||||
MAXWRK = MAX( MAXWRK, M*M + 4*M + LWORK_DGEBRD )
|
MAXWRK = MAX( MAXWRK, M*M + 4*M + LWORK_DGEBRD )
|
||||||
|
@ -341,15 +341,15 @@
|
||||||
* Compute space needed for DGEBRD
|
* Compute space needed for DGEBRD
|
||||||
CALL DGEBRD( M, N, A, LDA, S, DUM(1), DUM(1),
|
CALL DGEBRD( M, N, A, LDA, S, DUM(1), DUM(1),
|
||||||
$ DUM(1), DUM(1), -1, INFO )
|
$ DUM(1), DUM(1), -1, INFO )
|
||||||
LWORK_DGEBRD=DUM(1)
|
LWORK_DGEBRD = INT( DUM(1) )
|
||||||
* Compute space needed for DORMBR
|
* Compute space needed for DORMBR
|
||||||
CALL DORMBR( 'Q', 'L', 'T', M, NRHS, M, A, LDA,
|
CALL DORMBR( 'Q', 'L', 'T', M, NRHS, M, A, LDA,
|
||||||
$ DUM(1), B, LDB, DUM(1), -1, INFO )
|
$ DUM(1), B, LDB, DUM(1), -1, INFO )
|
||||||
LWORK_DORMBR=DUM(1)
|
LWORK_DORMBR = INT( DUM(1) )
|
||||||
* Compute space needed for DORGBR
|
* Compute space needed for DORGBR
|
||||||
CALL DORGBR( 'P', M, N, M, A, LDA, DUM(1),
|
CALL DORGBR( 'P', M, N, M, A, LDA, DUM(1),
|
||||||
$ DUM(1), -1, INFO )
|
$ DUM(1), -1, INFO )
|
||||||
LWORK_DORGBR=DUM(1)
|
LWORK_DORGBR = INT( DUM(1) )
|
||||||
MAXWRK = 3*M + LWORK_DGEBRD
|
MAXWRK = 3*M + LWORK_DGEBRD
|
||||||
MAXWRK = MAX( MAXWRK, 3*M + LWORK_DORMBR )
|
MAXWRK = MAX( MAXWRK, 3*M + LWORK_DORMBR )
|
||||||
MAXWRK = MAX( MAXWRK, 3*M + LWORK_DORGBR )
|
MAXWRK = MAX( MAXWRK, 3*M + LWORK_DORGBR )
|
||||||
|
|
|
@ -288,7 +288,7 @@
|
||||||
*
|
*
|
||||||
CALL DGGQRF( N, M, P, A, LDA, WORK, B, LDB, WORK( M+1 ),
|
CALL DGGQRF( 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 = WORK( M+NP+1 )
|
LOPT = INT( WORK( M+NP+1 ) )
|
||||||
*
|
*
|
||||||
* Update left-hand-side vector d = Q**T*d = ( d1 ) M
|
* Update left-hand-side vector d = Q**T*d = ( d1 ) M
|
||||||
* ( d2 ) N-M
|
* ( d2 ) N-M
|
||||||
|
|
|
@ -276,7 +276,7 @@
|
||||||
*
|
*
|
||||||
CALL DGGRQF( P, M, N, B, LDB, WORK, A, LDA, WORK( P+1 ),
|
CALL DGGRQF( 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 = WORK( P+MN+1 )
|
LOPT = INT( WORK( P+MN+1 ) )
|
||||||
*
|
*
|
||||||
* Update c = Z**T *c = ( c1 ) N-P
|
* Update c = Z**T *c = ( c1 ) N-P
|
||||||
* ( c2 ) M+P-N
|
* ( c2 ) M+P-N
|
||||||
|
|
|
@ -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 DGEQRF( N, M, A, LDA, TAUA, WORK, LWORK, INFO )
|
CALL DGEQRF( N, M, A, LDA, TAUA, WORK, LWORK, INFO )
|
||||||
LOPT = WORK( 1 )
|
LOPT = INT( WORK( 1 ) )
|
||||||
*
|
*
|
||||||
* Update B := Q**T*B.
|
* Update B := Q**T*B.
|
||||||
*
|
*
|
||||||
|
|
|
@ -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 DGERQF( M, N, A, LDA, TAUA, WORK, LWORK, INFO )
|
CALL DGERQF( M, N, A, LDA, TAUA, WORK, LWORK, INFO )
|
||||||
LOPT = WORK( 1 )
|
LOPT = INT( WORK( 1 ) )
|
||||||
*
|
*
|
||||||
* Update B := B*Q**T
|
* Update B := B*Q**T
|
||||||
*
|
*
|
||||||
|
|
|
@ -34,8 +34,8 @@
|
||||||
*>
|
*>
|
||||||
*> \verbatim
|
*> \verbatim
|
||||||
*>
|
*>
|
||||||
*> DLAG2S converts a DOUBLE PRECISION matrix, SA, to a SINGLE
|
*> DLAG2S converts a DOUBLE PRECISION matrix, A, to a SINGLE
|
||||||
*> PRECISION matrix, A.
|
*> PRECISION matrix, SA.
|
||||||
*>
|
*>
|
||||||
*> RMAX is the overflow for the SINGLE PRECISION arithmetic
|
*> RMAX is the overflow for the SINGLE PRECISION arithmetic
|
||||||
*> DLAG2S checks that all the entries of A are between -RMAX and
|
*> DLAG2S checks that all the entries of A are between -RMAX and
|
||||||
|
@ -128,6 +128,9 @@
|
||||||
REAL SLAMCH
|
REAL SLAMCH
|
||||||
EXTERNAL SLAMCH
|
EXTERNAL SLAMCH
|
||||||
* ..
|
* ..
|
||||||
|
* .. Intrinsic Functions ..
|
||||||
|
INTRINSIC REAL
|
||||||
|
* ..
|
||||||
* .. Executable Statements ..
|
* .. Executable Statements ..
|
||||||
*
|
*
|
||||||
RMAX = SLAMCH( 'O' )
|
RMAX = SLAMCH( 'O' )
|
||||||
|
@ -137,7 +140,7 @@
|
||||||
INFO = 1
|
INFO = 1
|
||||||
GO TO 30
|
GO TO 30
|
||||||
END IF
|
END IF
|
||||||
SA( I, J ) = A( I, J )
|
SA( I, J ) = REAL( A( I, J ) )
|
||||||
10 CONTINUE
|
10 CONTINUE
|
||||||
20 CONTINUE
|
20 CONTINUE
|
||||||
INFO = 0
|
INFO = 0
|
||||||
|
|
|
@ -134,6 +134,9 @@
|
||||||
LOGICAL LSAME
|
LOGICAL LSAME
|
||||||
EXTERNAL SLAMCH, LSAME
|
EXTERNAL SLAMCH, LSAME
|
||||||
* ..
|
* ..
|
||||||
|
* .. Intrinsic Functions ..
|
||||||
|
INTRINSIC REAL
|
||||||
|
* ..
|
||||||
* .. Executable Statements ..
|
* .. Executable Statements ..
|
||||||
*
|
*
|
||||||
RMAX = SLAMCH( 'O' )
|
RMAX = SLAMCH( 'O' )
|
||||||
|
@ -146,7 +149,7 @@
|
||||||
INFO = 1
|
INFO = 1
|
||||||
GO TO 50
|
GO TO 50
|
||||||
END IF
|
END IF
|
||||||
SA( I, J ) = A( I, J )
|
SA( I, J ) = REAL( A( I, J ) )
|
||||||
10 CONTINUE
|
10 CONTINUE
|
||||||
20 CONTINUE
|
20 CONTINUE
|
||||||
ELSE
|
ELSE
|
||||||
|
@ -157,7 +160,7 @@
|
||||||
INFO = 1
|
INFO = 1
|
||||||
GO TO 50
|
GO TO 50
|
||||||
END IF
|
END IF
|
||||||
SA( I, J ) = A( I, J )
|
SA( I, J ) = REAL( A( I, J ) )
|
||||||
30 CONTINUE
|
30 CONTINUE
|
||||||
40 CONTINUE
|
40 CONTINUE
|
||||||
END IF
|
END IF
|
||||||
|
|
|
@ -232,7 +232,7 @@
|
||||||
END IF
|
END IF
|
||||||
END IF
|
END IF
|
||||||
END IF
|
END IF
|
||||||
LWKOPT = WORK( 1 )
|
LWKOPT = INT( WORK( 1 ) )
|
||||||
LWKOPT = MAX (LWKOPT, MN)
|
LWKOPT = MAX (LWKOPT, MN)
|
||||||
END IF
|
END IF
|
||||||
*
|
*
|
||||||
|
|
|
@ -307,8 +307,8 @@
|
||||||
CALL DSPGST( ITYPE, UPLO, N, AP, BP, INFO )
|
CALL DSPGST( ITYPE, UPLO, N, AP, BP, INFO )
|
||||||
CALL DSPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK, IWORK,
|
CALL DSPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK, IWORK,
|
||||||
$ LIWORK, INFO )
|
$ LIWORK, INFO )
|
||||||
LWMIN = MAX( DBLE( LWMIN ), DBLE( WORK( 1 ) ) )
|
LWMIN = INT( MAX( DBLE( LWMIN ), DBLE( WORK( 1 ) ) ) )
|
||||||
LIWMIN = MAX( DBLE( LIWMIN ), DBLE( IWORK( 1 ) ) )
|
LIWMIN = INT( MAX( DBLE( LIWMIN ), DBLE( IWORK( 1 ) ) ) )
|
||||||
*
|
*
|
||||||
IF( WANTZ ) THEN
|
IF( WANTZ ) THEN
|
||||||
*
|
*
|
||||||
|
|
|
@ -330,8 +330,8 @@
|
||||||
CALL DSYGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
|
CALL DSYGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO )
|
||||||
CALL DSYEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, IWORK, LIWORK,
|
CALL DSYEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, IWORK, LIWORK,
|
||||||
$ INFO )
|
$ INFO )
|
||||||
LOPT = MAX( DBLE( LOPT ), DBLE( WORK( 1 ) ) )
|
LOPT = INT( MAX( DBLE( LOPT ), DBLE( WORK( 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
|
||||||
*
|
*
|
||||||
|
|
|
@ -223,7 +223,7 @@
|
||||||
LWKOPT = 1
|
LWKOPT = 1
|
||||||
ELSE
|
ELSE
|
||||||
CALL DSYTRF( UPLO, N, A, LDA, IPIV, WORK, -1, INFO )
|
CALL DSYTRF( UPLO, N, A, LDA, IPIV, WORK, -1, INFO )
|
||||||
LWKOPT = WORK(1)
|
LWKOPT = INT( WORK( 1 ) )
|
||||||
END IF
|
END IF
|
||||||
WORK( 1 ) = LWKOPT
|
WORK( 1 ) = LWKOPT
|
||||||
END IF
|
END IF
|
||||||
|
|
|
@ -280,7 +280,7 @@
|
||||||
LWKOPT = 1
|
LWKOPT = 1
|
||||||
ELSE
|
ELSE
|
||||||
CALL DSYTRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, -1, INFO )
|
CALL DSYTRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, -1, INFO )
|
||||||
LWKOPT = WORK(1)
|
LWKOPT = INT( WORK( 1 ) )
|
||||||
END IF
|
END IF
|
||||||
WORK( 1 ) = LWKOPT
|
WORK( 1 ) = LWKOPT
|
||||||
END IF
|
END IF
|
||||||
|
|
|
@ -256,7 +256,7 @@
|
||||||
LWKOPT = 1
|
LWKOPT = 1
|
||||||
ELSE
|
ELSE
|
||||||
CALL DSYTRF_ROOK( UPLO, N, A, LDA, IPIV, WORK, -1, INFO )
|
CALL DSYTRF_ROOK( UPLO, N, A, LDA, IPIV, WORK, -1, INFO )
|
||||||
LWKOPT = WORK(1)
|
LWKOPT = INT( WORK( 1 ) )
|
||||||
END IF
|
END IF
|
||||||
WORK( 1 ) = LWKOPT
|
WORK( 1 ) = LWKOPT
|
||||||
END IF
|
END IF
|
||||||
|
|
Loading…
Reference in New Issue