From 35295912a3f1b83ba8fd22f1fe2fccce6ff4a201 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sat, 19 Nov 2022 14:57:54 +0100 Subject: [PATCH 1/4] Define type conversions explicitly (Reference-LAPACK PR 703) --- lapack-netlib/SRC/cgebak.f | 4 ++-- lapack-netlib/SRC/cgees.f | 2 +- lapack-netlib/SRC/cgeesx.f | 2 +- lapack-netlib/SRC/cgejsv.f | 36 +++++++++++++++++----------------- lapack-netlib/SRC/cggbak.f | 8 ++++---- lapack-netlib/SRC/cggbal.f | 4 ++-- lapack-netlib/SRC/cggglm.f | 2 +- lapack-netlib/SRC/cgghd3.f | 2 +- lapack-netlib/SRC/cgglse.f | 2 +- lapack-netlib/SRC/cggqrf.f | 2 +- lapack-netlib/SRC/chegvd.f | 6 +++--- lapack-netlib/SRC/chesv_rk.f | 2 +- lapack-netlib/SRC/chpgvd.f | 6 +++--- lapack-netlib/SRC/csysv.f | 2 +- lapack-netlib/SRC/csysv_rk.f | 2 +- lapack-netlib/SRC/csysv_rook.f | 2 +- lapack-netlib/SRC/cungbr.f | 2 +- 17 files changed, 43 insertions(+), 43 deletions(-) diff --git a/lapack-netlib/SRC/cgebak.f b/lapack-netlib/SRC/cgebak.f index 201dbfcec..4348d5ea4 100644 --- a/lapack-netlib/SRC/cgebak.f +++ b/lapack-netlib/SRC/cgebak.f @@ -238,7 +238,7 @@ $ GO TO 40 IF( I.LT.ILO ) $ I = ILO - II - K = SCALE( I ) + K = INT( SCALE( I ) ) IF( K.EQ.I ) $ GO TO 40 CALL CSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV ) @@ -252,7 +252,7 @@ $ GO TO 50 IF( I.LT.ILO ) $ I = ILO - II - K = SCALE( I ) + K = INT( SCALE( I ) ) IF( K.EQ.I ) $ GO TO 50 CALL CSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV ) diff --git a/lapack-netlib/SRC/cgees.f b/lapack-netlib/SRC/cgees.f index 359fa2afe..71acfdba3 100644 --- a/lapack-netlib/SRC/cgees.f +++ b/lapack-netlib/SRC/cgees.f @@ -282,7 +282,7 @@ * CALL CHSEQR( 'S', JOBVS, N, 1, N, A, LDA, W, VS, LDVS, $ WORK, -1, IEVAL ) - HSWORK = REAL( WORK( 1 ) ) + HSWORK = INT( WORK( 1 ) ) * IF( .NOT.WANTVS ) THEN MAXWRK = MAX( MAXWRK, HSWORK ) diff --git a/lapack-netlib/SRC/cgeesx.f b/lapack-netlib/SRC/cgeesx.f index 1113563ba..782e36747 100644 --- a/lapack-netlib/SRC/cgeesx.f +++ b/lapack-netlib/SRC/cgeesx.f @@ -337,7 +337,7 @@ * CALL CHSEQR( 'S', JOBVS, N, 1, N, A, LDA, W, VS, LDVS, $ WORK, -1, IEVAL ) - HSWORK = REAL( WORK( 1 ) ) + HSWORK = INT( WORK( 1 ) ) * IF( .NOT.WANTVS ) THEN MAXWRK = MAX( MAXWRK, HSWORK ) diff --git a/lapack-netlib/SRC/cgejsv.f b/lapack-netlib/SRC/cgejsv.f index 25ab81302..e37b25b6b 100644 --- a/lapack-netlib/SRC/cgejsv.f +++ b/lapack-netlib/SRC/cgejsv.f @@ -704,11 +704,11 @@ IF ( LQUERY ) THEN CALL CGEQP3( M, N, A, LDA, IWORK, CDUMMY, CDUMMY, -1, $ RDUMMY, IERR ) - LWRK_CGEQP3 = REAL( CDUMMY(1) ) + LWRK_CGEQP3 = INT( CDUMMY(1) ) CALL CGEQRF( N, N, A, LDA, CDUMMY, CDUMMY,-1, IERR ) - LWRK_CGEQRF = REAL( CDUMMY(1) ) + LWRK_CGEQRF = INT( CDUMMY(1) ) CALL CGELQF( N, N, A, LDA, CDUMMY, CDUMMY,-1, IERR ) - LWRK_CGELQF = REAL( CDUMMY(1) ) + LWRK_CGELQF = INT( CDUMMY(1) ) END IF MINWRK = 2 OPTWRK = 2 @@ -724,7 +724,7 @@ IF ( LQUERY ) THEN CALL CGESVJ( 'L', 'N', 'N', N, N, A, LDA, SVA, N, V, $ LDV, CDUMMY, -1, RDUMMY, -1, IERR ) - LWRK_CGESVJ = REAL( CDUMMY(1) ) + LWRK_CGESVJ = INT( CDUMMY(1) ) IF ( ERREST ) THEN OPTWRK = MAX( N+LWRK_CGEQP3, N**2+LWCON, $ N+LWRK_CGEQRF, LWRK_CGESVJ ) @@ -760,10 +760,10 @@ IF ( LQUERY ) THEN CALL CGESVJ( 'L', 'U', 'N', N,N, U, LDU, SVA, N, A, $ LDA, CDUMMY, -1, RDUMMY, -1, IERR ) - LWRK_CGESVJ = REAL( CDUMMY(1) ) + LWRK_CGESVJ = INT( CDUMMY(1) ) CALL CUNMLQ( 'L', 'C', N, N, N, A, LDA, CDUMMY, $ V, LDV, CDUMMY, -1, IERR ) - LWRK_CUNMLQ = REAL( CDUMMY(1) ) + LWRK_CUNMLQ = INT( CDUMMY(1) ) IF ( ERREST ) THEN OPTWRK = MAX( N+LWRK_CGEQP3, LWCON, LWRK_CGESVJ, $ N+LWRK_CGELQF, 2*N+LWRK_CGEQRF, @@ -799,10 +799,10 @@ IF ( LQUERY ) THEN CALL CGESVJ( 'L', 'U', 'N', N,N, U, LDU, SVA, N, A, $ LDA, CDUMMY, -1, RDUMMY, -1, IERR ) - LWRK_CGESVJ = REAL( CDUMMY(1) ) + LWRK_CGESVJ = INT( CDUMMY(1) ) CALL CUNMQR( 'L', 'N', M, N, N, A, LDA, CDUMMY, U, $ LDU, CDUMMY, -1, IERR ) - LWRK_CUNMQRM = REAL( CDUMMY(1) ) + LWRK_CUNMQRM = INT( CDUMMY(1) ) IF ( ERREST ) THEN OPTWRK = N + MAX( LWRK_CGEQP3, LWCON, N+LWRK_CGEQRF, $ LWRK_CGESVJ, LWRK_CUNMQRM ) @@ -861,26 +861,26 @@ IF ( LQUERY ) THEN CALL CUNMQR( 'L', 'N', M, N, N, A, LDA, CDUMMY, U, $ LDU, CDUMMY, -1, IERR ) - LWRK_CUNMQRM = REAL( CDUMMY(1) ) + LWRK_CUNMQRM = INT( CDUMMY(1) ) CALL CUNMQR( 'L', 'N', N, N, N, A, LDA, CDUMMY, U, $ LDU, CDUMMY, -1, IERR ) - LWRK_CUNMQR = REAL( CDUMMY(1) ) + LWRK_CUNMQR = INT( CDUMMY(1) ) IF ( .NOT. JRACC ) THEN CALL CGEQP3( N,N, A, LDA, IWORK, CDUMMY,CDUMMY, -1, $ RDUMMY, IERR ) - LWRK_CGEQP3N = REAL( CDUMMY(1) ) + LWRK_CGEQP3N = INT( CDUMMY(1) ) CALL CGESVJ( 'L', 'U', 'N', N, N, U, LDU, SVA, $ N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR ) - LWRK_CGESVJ = REAL( CDUMMY(1) ) + LWRK_CGESVJ = INT( CDUMMY(1) ) CALL CGESVJ( 'U', 'U', 'N', N, N, U, LDU, SVA, $ N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR ) - LWRK_CGESVJU = REAL( CDUMMY(1) ) + LWRK_CGESVJU = INT( CDUMMY(1) ) CALL CGESVJ( 'L', 'U', 'V', N, N, U, LDU, SVA, $ N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR ) - LWRK_CGESVJV = REAL( CDUMMY(1) ) + LWRK_CGESVJV = INT( CDUMMY(1) ) CALL CUNMLQ( 'L', 'C', N, N, N, A, LDA, CDUMMY, $ V, LDV, CDUMMY, -1, IERR ) - LWRK_CUNMLQ = REAL( CDUMMY(1) ) + LWRK_CUNMLQ = INT( CDUMMY(1) ) IF ( ERREST ) THEN OPTWRK = MAX( N+LWRK_CGEQP3, N+LWCON, $ 2*N+N**2+LWCON, 2*N+LWRK_CGEQRF, @@ -909,13 +909,13 @@ ELSE CALL CGESVJ( 'L', 'U', 'V', N, N, U, LDU, SVA, $ N, V, LDV, CDUMMY, -1, RDUMMY, -1, IERR ) - LWRK_CGESVJV = REAL( CDUMMY(1) ) + LWRK_CGESVJV = INT( CDUMMY(1) ) CALL CUNMQR( 'L', 'N', N, N, N, CDUMMY, N, CDUMMY, $ V, LDV, CDUMMY, -1, IERR ) - LWRK_CUNMQR = REAL( CDUMMY(1) ) + LWRK_CUNMQR = INT( CDUMMY(1) ) CALL CUNMQR( 'L', 'N', M, N, N, A, LDA, CDUMMY, U, $ LDU, CDUMMY, -1, IERR ) - LWRK_CUNMQRM = REAL( CDUMMY(1) ) + LWRK_CUNMQRM = INT( CDUMMY(1) ) IF ( ERREST ) THEN OPTWRK = MAX( N+LWRK_CGEQP3, N+LWCON, $ 2*N+LWRK_CGEQRF, 2*N+N**2, diff --git a/lapack-netlib/SRC/cggbak.f b/lapack-netlib/SRC/cggbak.f index e8ac34805..159449601 100644 --- a/lapack-netlib/SRC/cggbak.f +++ b/lapack-netlib/SRC/cggbak.f @@ -253,7 +253,7 @@ IF( ILO.EQ.1 ) $ GO TO 50 DO 40 I = ILO - 1, 1, -1 - K = RSCALE( I ) + K = INT( RSCALE( I ) ) IF( K.EQ.I ) $ GO TO 40 CALL CSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV ) @@ -263,7 +263,7 @@ IF( IHI.EQ.N ) $ GO TO 70 DO 60 I = IHI + 1, N - K = RSCALE( I ) + K = INT( RSCALE( I ) ) IF( K.EQ.I ) $ GO TO 60 CALL CSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV ) @@ -277,7 +277,7 @@ IF( ILO.EQ.1 ) $ GO TO 90 DO 80 I = ILO - 1, 1, -1 - K = LSCALE( I ) + K = INT( LSCALE( I ) ) IF( K.EQ.I ) $ GO TO 80 CALL CSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV ) @@ -287,7 +287,7 @@ IF( IHI.EQ.N ) $ GO TO 110 DO 100 I = IHI + 1, N - K = LSCALE( I ) + K = INT( LSCALE( I ) ) IF( K.EQ.I ) $ GO TO 100 CALL CSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV ) diff --git a/lapack-netlib/SRC/cggbal.f b/lapack-netlib/SRC/cggbal.f index c7a232415..66ba7a881 100644 --- a/lapack-netlib/SRC/cggbal.f +++ b/lapack-netlib/SRC/cggbal.f @@ -535,7 +535,7 @@ IRAB = ICAMAX( N-ILO+1, B( I, ILO ), LDB ) RAB = MAX( RAB, ABS( B( I, IRAB+ILO-1 ) ) ) LRAB = INT( LOG10( RAB+SFMIN ) / BASL+ONE ) - IR = LSCALE( I ) + SIGN( HALF, LSCALE( I ) ) + IR = INT( LSCALE( I ) + SIGN( HALF, LSCALE( I ) ) ) IR = MIN( MAX( IR, LSFMIN ), LSFMAX, LSFMAX-LRAB ) LSCALE( I ) = SCLFAC**IR ICAB = ICAMAX( IHI, A( 1, I ), 1 ) @@ -543,7 +543,7 @@ ICAB = ICAMAX( IHI, B( 1, I ), 1 ) CAB = MAX( CAB, ABS( B( ICAB, I ) ) ) LCAB = INT( LOG10( CAB+SFMIN ) / BASL+ONE ) - JC = RSCALE( I ) + SIGN( HALF, RSCALE( I ) ) + JC = INT( RSCALE( I ) + SIGN( HALF, RSCALE( I ) ) ) JC = MIN( MAX( JC, LSFMIN ), LSFMAX, LSFMAX-LCAB ) RSCALE( I ) = SCLFAC**JC 360 CONTINUE diff --git a/lapack-netlib/SRC/cggglm.f b/lapack-netlib/SRC/cggglm.f index 3efca1e71..fb384b651 100644 --- a/lapack-netlib/SRC/cggglm.f +++ b/lapack-netlib/SRC/cggglm.f @@ -289,7 +289,7 @@ * CALL CGGQRF( N, M, P, A, LDA, WORK, B, LDB, WORK( M+1 ), $ WORK( M+NP+1 ), LWORK-M-NP, INFO ) - LOPT = REAL( WORK( M+NP+1 ) ) + LOPT = INT( WORK( M+NP+1 ) ) * * Update left-hand-side vector d = Q**H*d = ( d1 ) M * ( d2 ) N-M diff --git a/lapack-netlib/SRC/cgghd3.f b/lapack-netlib/SRC/cgghd3.f index 76d7de4ce..1074b4828 100644 --- a/lapack-netlib/SRC/cgghd3.f +++ b/lapack-netlib/SRC/cgghd3.f @@ -511,7 +511,7 @@ * IF( JJ.GT.0 ) THEN DO I = JJ, 1, -1 - C = DBLE( A( J+1+I, J ) ) + C = REAL( A( J+1+I, J ) ) CALL CROT( IHI-TOP, A( TOP+1, J+I+1 ), 1, $ A( TOP+1, J+I ), 1, C, $ -CONJG( B( J+1+I, J ) ) ) diff --git a/lapack-netlib/SRC/cgglse.f b/lapack-netlib/SRC/cgglse.f index 4785941db..cca20dfed 100644 --- a/lapack-netlib/SRC/cgglse.f +++ b/lapack-netlib/SRC/cgglse.f @@ -276,7 +276,7 @@ * CALL CGGRQF( P, M, N, B, LDB, WORK, A, LDA, WORK( P+1 ), $ WORK( P+MN+1 ), LWORK-P-MN, INFO ) - LOPT = REAL( WORK( P+MN+1 ) ) + LOPT = INT( WORK( P+MN+1 ) ) * * Update c = Z**H *c = ( c1 ) N-P * ( c2 ) M+P-N diff --git a/lapack-netlib/SRC/cggqrf.f b/lapack-netlib/SRC/cggqrf.f index febd9be8d..0185f4e0d 100644 --- a/lapack-netlib/SRC/cggqrf.f +++ b/lapack-netlib/SRC/cggqrf.f @@ -276,7 +276,7 @@ * QR factorization of N-by-M matrix A: A = Q*R * CALL CGEQRF( N, M, A, LDA, TAUA, WORK, LWORK, INFO ) - LOPT = REAL( WORK( 1 ) ) + LOPT = INT( WORK( 1 ) ) * * Update B := Q**H*B. * diff --git a/lapack-netlib/SRC/chegvd.f b/lapack-netlib/SRC/chegvd.f index 0c708190c..4b7f43d52 100644 --- a/lapack-netlib/SRC/chegvd.f +++ b/lapack-netlib/SRC/chegvd.f @@ -360,9 +360,9 @@ CALL CHEGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) CALL CHEEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK, LRWORK, $ IWORK, LIWORK, INFO ) - LOPT = MAX( REAL( LOPT ), REAL( WORK( 1 ) ) ) - LROPT = MAX( REAL( LROPT ), REAL( RWORK( 1 ) ) ) - LIOPT = MAX( REAL( LIOPT ), REAL( IWORK( 1 ) ) ) + LOPT = INT( MAX( REAL( LOPT ), REAL( WORK( 1 ) ) ) ) + LROPT = INT( MAX( REAL( LROPT ), REAL( RWORK( 1 ) ) ) ) + LIOPT = INT( MAX( REAL( LIOPT ), REAL( IWORK( 1 ) ) ) ) * IF( WANTZ .AND. INFO.EQ.0 ) THEN * diff --git a/lapack-netlib/SRC/chesv_rk.f b/lapack-netlib/SRC/chesv_rk.f index a659c8e79..e123fa299 100644 --- a/lapack-netlib/SRC/chesv_rk.f +++ b/lapack-netlib/SRC/chesv_rk.f @@ -280,7 +280,7 @@ LWKOPT = 1 ELSE CALL CHETRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, -1, INFO ) - LWKOPT = REAL( WORK(1) ) + LWKOPT = INT( WORK( 1 ) ) END IF WORK( 1 ) = LWKOPT END IF diff --git a/lapack-netlib/SRC/chpgvd.f b/lapack-netlib/SRC/chpgvd.f index 754be31ed..65d08b783 100644 --- a/lapack-netlib/SRC/chpgvd.f +++ b/lapack-netlib/SRC/chpgvd.f @@ -335,9 +335,9 @@ CALL CHPGST( ITYPE, UPLO, N, AP, BP, INFO ) CALL CHPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK, RWORK, $ LRWORK, IWORK, LIWORK, INFO ) - LWMIN = MAX( REAL( LWMIN ), REAL( WORK( 1 ) ) ) - LRWMIN = MAX( REAL( LRWMIN ), REAL( RWORK( 1 ) ) ) - LIWMIN = MAX( REAL( LIWMIN ), REAL( IWORK( 1 ) ) ) + LWMIN = INT( MAX( REAL( LWMIN ), REAL( WORK( 1 ) ) ) ) + LRWMIN = INT( MAX( REAL( LRWMIN ), REAL( RWORK( 1 ) ) ) ) + LIWMIN = INT( MAX( REAL( LIWMIN ), REAL( IWORK( 1 ) ) ) ) * IF( WANTZ ) THEN * diff --git a/lapack-netlib/SRC/csysv.f b/lapack-netlib/SRC/csysv.f index 6f175e381..4ddabf62f 100644 --- a/lapack-netlib/SRC/csysv.f +++ b/lapack-netlib/SRC/csysv.f @@ -223,7 +223,7 @@ LWKOPT = 1 ELSE CALL CSYTRF( UPLO, N, A, LDA, IPIV, WORK, -1, INFO ) - LWKOPT = REAL( WORK(1) ) + LWKOPT = INT( WORK( 1 ) ) END IF WORK( 1 ) = LWKOPT END IF diff --git a/lapack-netlib/SRC/csysv_rk.f b/lapack-netlib/SRC/csysv_rk.f index 793e39df5..ef5334dcd 100644 --- a/lapack-netlib/SRC/csysv_rk.f +++ b/lapack-netlib/SRC/csysv_rk.f @@ -280,7 +280,7 @@ LWKOPT = 1 ELSE CALL CSYTRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, -1, INFO ) - LWKOPT = REAL( WORK(1) ) + LWKOPT = INT( WORK( 1 ) ) END IF WORK( 1 ) = LWKOPT END IF diff --git a/lapack-netlib/SRC/csysv_rook.f b/lapack-netlib/SRC/csysv_rook.f index daa9f27c4..aad594e21 100644 --- a/lapack-netlib/SRC/csysv_rook.f +++ b/lapack-netlib/SRC/csysv_rook.f @@ -256,7 +256,7 @@ LWKOPT = 1 ELSE CALL CSYTRF_ROOK( UPLO, N, A, LDA, IPIV, WORK, -1, INFO ) - LWKOPT = REAL( WORK(1) ) + LWKOPT = INT( WORK( 1 ) ) END IF WORK( 1 ) = LWKOPT END IF diff --git a/lapack-netlib/SRC/cungbr.f b/lapack-netlib/SRC/cungbr.f index c973d0b0a..a31a53d79 100644 --- a/lapack-netlib/SRC/cungbr.f +++ b/lapack-netlib/SRC/cungbr.f @@ -233,7 +233,7 @@ END IF END IF END IF - LWKOPT = REAL( WORK( 1 ) ) + LWKOPT = INT( WORK( 1 ) ) LWKOPT = MAX (LWKOPT, MN) END IF * From 08bc43c73d43ab0f20595b705c1b07a2ddabf41e Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sat, 19 Nov 2022 15:04:30 +0100 Subject: [PATCH 2/4] Define type conversions explicitly (Reference-LAPACK PR 703) --- lapack-netlib/SRC/dgebak.f | 4 ++-- lapack-netlib/SRC/dgees.f | 2 +- lapack-netlib/SRC/dgeesx.f | 2 +- lapack-netlib/SRC/dgelss.f | 26 +++++++++++++------------- lapack-netlib/SRC/dggglm.f | 2 +- lapack-netlib/SRC/dgglse.f | 2 +- lapack-netlib/SRC/dggqrf.f | 2 +- lapack-netlib/SRC/dggrqf.f | 2 +- lapack-netlib/SRC/dlag2s.f | 9 ++++++--- lapack-netlib/SRC/dlat2s.f | 7 +++++-- lapack-netlib/SRC/dorgbr.f | 2 +- lapack-netlib/SRC/dspgvd.f | 4 ++-- lapack-netlib/SRC/dsygvd.f | 4 ++-- lapack-netlib/SRC/dsysv.f | 2 +- lapack-netlib/SRC/dsysv_rk.f | 2 +- lapack-netlib/SRC/dsysv_rook.f | 2 +- 16 files changed, 40 insertions(+), 34 deletions(-) diff --git a/lapack-netlib/SRC/dgebak.f b/lapack-netlib/SRC/dgebak.f index e978d7af2..9c086794a 100644 --- a/lapack-netlib/SRC/dgebak.f +++ b/lapack-netlib/SRC/dgebak.f @@ -236,7 +236,7 @@ $ GO TO 40 IF( I.LT.ILO ) $ I = ILO - II - K = SCALE( I ) + K = INT( SCALE( I ) ) IF( K.EQ.I ) $ GO TO 40 CALL DSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV ) @@ -250,7 +250,7 @@ $ GO TO 50 IF( I.LT.ILO ) $ I = ILO - II - K = SCALE( I ) + K = INT( SCALE( I ) ) IF( K.EQ.I ) $ GO TO 50 CALL DSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV ) diff --git a/lapack-netlib/SRC/dgees.f b/lapack-netlib/SRC/dgees.f index 82b9d6ee4..24739b1cf 100644 --- a/lapack-netlib/SRC/dgees.f +++ b/lapack-netlib/SRC/dgees.f @@ -302,7 +302,7 @@ * CALL DHSEQR( 'S', JOBVS, N, 1, N, A, LDA, WR, WI, VS, LDVS, $ WORK, -1, IEVAL ) - HSWORK = WORK( 1 ) + HSWORK = INT( WORK( 1 ) ) * IF( .NOT.WANTVS ) THEN MAXWRK = MAX( MAXWRK, N + HSWORK ) diff --git a/lapack-netlib/SRC/dgeesx.f b/lapack-netlib/SRC/dgeesx.f index 08fbb6468..f3677fcb3 100644 --- a/lapack-netlib/SRC/dgeesx.f +++ b/lapack-netlib/SRC/dgeesx.f @@ -382,7 +382,7 @@ * CALL DHSEQR( 'S', JOBVS, N, 1, N, A, LDA, WR, WI, VS, LDVS, $ WORK, -1, IEVAL ) - HSWORK = WORK( 1 ) + HSWORK = INT( WORK( 1 ) ) * IF( .NOT.WANTVS ) THEN MAXWRK = MAX( MAXWRK, N + HSWORK ) diff --git a/lapack-netlib/SRC/dgelss.f b/lapack-netlib/SRC/dgelss.f index 8ed703fcf..c4190f2e0 100644 --- a/lapack-netlib/SRC/dgelss.f +++ b/lapack-netlib/SRC/dgelss.f @@ -254,11 +254,11 @@ * * Compute space needed for DGEQRF 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 CALL DORMQR( 'L', 'T', M, NRHS, N, A, LDA, DUM(1), B, $ LDB, DUM(1), -1, INFO ) - LWORK_DORMQR=DUM(1) + LWORK_DORMQR = INT( DUM(1) ) MM = N MAXWRK = MAX( MAXWRK, N + LWORK_DGEQRF ) MAXWRK = MAX( MAXWRK, N + LWORK_DORMQR ) @@ -273,15 +273,15 @@ * Compute space needed for DGEBRD CALL DGEBRD( MM, N, A, LDA, S, DUM(1), DUM(1), $ DUM(1), DUM(1), -1, INFO ) - LWORK_DGEBRD=DUM(1) + LWORK_DGEBRD = INT( DUM(1) ) * Compute space needed for DORMBR CALL DORMBR( 'Q', 'L', 'T', MM, NRHS, N, A, LDA, DUM(1), $ B, LDB, DUM(1), -1, INFO ) - LWORK_DORMBR=DUM(1) + LWORK_DORMBR = INT( DUM(1) ) * Compute space needed for DORGBR CALL DORGBR( 'P', N, N, N, A, LDA, DUM(1), $ DUM(1), -1, INFO ) - LWORK_DORGBR=DUM(1) + LWORK_DORGBR = INT( DUM(1) ) * Compute total workspace needed MAXWRK = MAX( MAXWRK, 3*N + LWORK_DGEBRD ) MAXWRK = MAX( MAXWRK, 3*N + LWORK_DORMBR ) @@ -305,23 +305,23 @@ * Compute space needed for DGELQF CALL DGELQF( M, N, A, LDA, DUM(1), DUM(1), $ -1, INFO ) - LWORK_DGELQF=DUM(1) + LWORK_DGELQF = INT( DUM(1) ) * Compute space needed for DGEBRD CALL DGEBRD( M, M, A, LDA, S, DUM(1), DUM(1), $ DUM(1), DUM(1), -1, INFO ) - LWORK_DGEBRD=DUM(1) + LWORK_DGEBRD = INT( DUM(1) ) * Compute space needed for DORMBR CALL DORMBR( 'Q', 'L', 'T', M, NRHS, N, A, LDA, $ DUM(1), B, LDB, DUM(1), -1, INFO ) - LWORK_DORMBR=DUM(1) + LWORK_DORMBR = INT( DUM(1) ) * Compute space needed for DORGBR CALL DORGBR( 'P', M, M, M, A, LDA, DUM(1), $ DUM(1), -1, INFO ) - LWORK_DORGBR=DUM(1) + LWORK_DORGBR = INT( DUM(1) ) * Compute space needed for DORMLQ CALL DORMLQ( 'L', 'T', N, NRHS, M, A, LDA, DUM(1), $ B, LDB, DUM(1), -1, INFO ) - LWORK_DORMLQ=DUM(1) + LWORK_DORMLQ = INT( DUM(1) ) * Compute total workspace needed MAXWRK = M + LWORK_DGELQF MAXWRK = MAX( MAXWRK, M*M + 4*M + LWORK_DGEBRD ) @@ -341,15 +341,15 @@ * Compute space needed for DGEBRD CALL DGEBRD( M, N, A, LDA, S, DUM(1), DUM(1), $ DUM(1), DUM(1), -1, INFO ) - LWORK_DGEBRD=DUM(1) + LWORK_DGEBRD = INT( DUM(1) ) * Compute space needed for DORMBR CALL DORMBR( 'Q', 'L', 'T', M, NRHS, M, A, LDA, $ DUM(1), B, LDB, DUM(1), -1, INFO ) - LWORK_DORMBR=DUM(1) + LWORK_DORMBR = INT( DUM(1) ) * Compute space needed for DORGBR CALL DORGBR( 'P', M, N, M, A, LDA, DUM(1), $ DUM(1), -1, INFO ) - LWORK_DORGBR=DUM(1) + LWORK_DORGBR = INT( DUM(1) ) MAXWRK = 3*M + LWORK_DGEBRD MAXWRK = MAX( MAXWRK, 3*M + LWORK_DORMBR ) MAXWRK = MAX( MAXWRK, 3*M + LWORK_DORGBR ) diff --git a/lapack-netlib/SRC/dggglm.f b/lapack-netlib/SRC/dggglm.f index d43785d32..ae0f0e908 100644 --- a/lapack-netlib/SRC/dggglm.f +++ b/lapack-netlib/SRC/dggglm.f @@ -288,7 +288,7 @@ * CALL DGGQRF( N, M, P, A, LDA, WORK, B, LDB, WORK( M+1 ), $ 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 * ( d2 ) N-M diff --git a/lapack-netlib/SRC/dgglse.f b/lapack-netlib/SRC/dgglse.f index 2fd17bbcb..28aeaf6e7 100644 --- a/lapack-netlib/SRC/dgglse.f +++ b/lapack-netlib/SRC/dgglse.f @@ -276,7 +276,7 @@ * CALL DGGRQF( P, M, N, B, LDB, WORK, A, LDA, WORK( P+1 ), $ 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 * ( c2 ) M+P-N diff --git a/lapack-netlib/SRC/dggqrf.f b/lapack-netlib/SRC/dggqrf.f index 617af274f..39d27a5c9 100644 --- a/lapack-netlib/SRC/dggqrf.f +++ b/lapack-netlib/SRC/dggqrf.f @@ -276,7 +276,7 @@ * QR factorization of N-by-M matrix A: A = Q*R * CALL DGEQRF( N, M, A, LDA, TAUA, WORK, LWORK, INFO ) - LOPT = WORK( 1 ) + LOPT = INT( WORK( 1 ) ) * * Update B := Q**T*B. * diff --git a/lapack-netlib/SRC/dggrqf.f b/lapack-netlib/SRC/dggrqf.f index 07f8752d8..ddf4104c5 100644 --- a/lapack-netlib/SRC/dggrqf.f +++ b/lapack-netlib/SRC/dggrqf.f @@ -275,7 +275,7 @@ * RQ factorization of M-by-N matrix A: A = R*Q * CALL DGERQF( M, N, A, LDA, TAUA, WORK, LWORK, INFO ) - LOPT = WORK( 1 ) + LOPT = INT( WORK( 1 ) ) * * Update B := B*Q**T * diff --git a/lapack-netlib/SRC/dlag2s.f b/lapack-netlib/SRC/dlag2s.f index e5a930223..9e6dead49 100644 --- a/lapack-netlib/SRC/dlag2s.f +++ b/lapack-netlib/SRC/dlag2s.f @@ -34,8 +34,8 @@ *> *> \verbatim *> -*> DLAG2S converts a DOUBLE PRECISION matrix, SA, to a SINGLE -*> PRECISION matrix, A. +*> DLAG2S converts a DOUBLE PRECISION matrix, A, to a SINGLE +*> PRECISION matrix, SA. *> *> RMAX is the overflow for the SINGLE PRECISION arithmetic *> DLAG2S checks that all the entries of A are between -RMAX and @@ -128,6 +128,9 @@ REAL SLAMCH EXTERNAL SLAMCH * .. +* .. Intrinsic Functions .. + INTRINSIC REAL +* .. * .. Executable Statements .. * RMAX = SLAMCH( 'O' ) @@ -137,7 +140,7 @@ INFO = 1 GO TO 30 END IF - SA( I, J ) = A( I, J ) + SA( I, J ) = REAL( A( I, J ) ) 10 CONTINUE 20 CONTINUE INFO = 0 diff --git a/lapack-netlib/SRC/dlat2s.f b/lapack-netlib/SRC/dlat2s.f index 3d00fe0a3..c926e9930 100644 --- a/lapack-netlib/SRC/dlat2s.f +++ b/lapack-netlib/SRC/dlat2s.f @@ -134,6 +134,9 @@ LOGICAL LSAME EXTERNAL SLAMCH, LSAME * .. +* .. Intrinsic Functions .. + INTRINSIC REAL +* .. * .. Executable Statements .. * RMAX = SLAMCH( 'O' ) @@ -146,7 +149,7 @@ INFO = 1 GO TO 50 END IF - SA( I, J ) = A( I, J ) + SA( I, J ) = REAL( A( I, J ) ) 10 CONTINUE 20 CONTINUE ELSE @@ -157,7 +160,7 @@ INFO = 1 GO TO 50 END IF - SA( I, J ) = A( I, J ) + SA( I, J ) = REAL( A( I, J ) ) 30 CONTINUE 40 CONTINUE END IF diff --git a/lapack-netlib/SRC/dorgbr.f b/lapack-netlib/SRC/dorgbr.f index 1b242ff97..7dfd03961 100644 --- a/lapack-netlib/SRC/dorgbr.f +++ b/lapack-netlib/SRC/dorgbr.f @@ -232,7 +232,7 @@ END IF END IF END IF - LWKOPT = WORK( 1 ) + LWKOPT = INT( WORK( 1 ) ) LWKOPT = MAX (LWKOPT, MN) END IF * diff --git a/lapack-netlib/SRC/dspgvd.f b/lapack-netlib/SRC/dspgvd.f index 556326388..df215ae1a 100644 --- a/lapack-netlib/SRC/dspgvd.f +++ b/lapack-netlib/SRC/dspgvd.f @@ -307,8 +307,8 @@ CALL DSPGST( ITYPE, UPLO, N, AP, BP, INFO ) CALL DSPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK, IWORK, $ LIWORK, INFO ) - LWMIN = MAX( DBLE( LWMIN ), DBLE( WORK( 1 ) ) ) - LIWMIN = MAX( DBLE( LIWMIN ), DBLE( IWORK( 1 ) ) ) + LWMIN = INT( MAX( DBLE( LWMIN ), DBLE( WORK( 1 ) ) ) ) + LIWMIN = INT( MAX( DBLE( LIWMIN ), DBLE( IWORK( 1 ) ) ) ) * IF( WANTZ ) THEN * diff --git a/lapack-netlib/SRC/dsygvd.f b/lapack-netlib/SRC/dsygvd.f index 61134bedc..3b38665a7 100644 --- a/lapack-netlib/SRC/dsygvd.f +++ b/lapack-netlib/SRC/dsygvd.f @@ -330,8 +330,8 @@ CALL DSYGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) CALL DSYEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, IWORK, LIWORK, $ INFO ) - LOPT = MAX( DBLE( LOPT ), DBLE( WORK( 1 ) ) ) - LIOPT = MAX( DBLE( LIOPT ), DBLE( IWORK( 1 ) ) ) + LOPT = INT( MAX( DBLE( LOPT ), DBLE( WORK( 1 ) ) ) ) + LIOPT = INT( MAX( DBLE( LIOPT ), DBLE( IWORK( 1 ) ) ) ) * IF( WANTZ .AND. INFO.EQ.0 ) THEN * diff --git a/lapack-netlib/SRC/dsysv.f b/lapack-netlib/SRC/dsysv.f index a6305e13c..ed6629ad9 100644 --- a/lapack-netlib/SRC/dsysv.f +++ b/lapack-netlib/SRC/dsysv.f @@ -223,7 +223,7 @@ LWKOPT = 1 ELSE CALL DSYTRF( UPLO, N, A, LDA, IPIV, WORK, -1, INFO ) - LWKOPT = WORK(1) + LWKOPT = INT( WORK( 1 ) ) END IF WORK( 1 ) = LWKOPT END IF diff --git a/lapack-netlib/SRC/dsysv_rk.f b/lapack-netlib/SRC/dsysv_rk.f index 05d8f7d3f..db8fd36dd 100644 --- a/lapack-netlib/SRC/dsysv_rk.f +++ b/lapack-netlib/SRC/dsysv_rk.f @@ -280,7 +280,7 @@ LWKOPT = 1 ELSE CALL DSYTRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, -1, INFO ) - LWKOPT = WORK(1) + LWKOPT = INT( WORK( 1 ) ) END IF WORK( 1 ) = LWKOPT END IF diff --git a/lapack-netlib/SRC/dsysv_rook.f b/lapack-netlib/SRC/dsysv_rook.f index 6ebb52eae..85f293309 100644 --- a/lapack-netlib/SRC/dsysv_rook.f +++ b/lapack-netlib/SRC/dsysv_rook.f @@ -256,7 +256,7 @@ LWKOPT = 1 ELSE CALL DSYTRF_ROOK( UPLO, N, A, LDA, IPIV, WORK, -1, INFO ) - LWKOPT = WORK(1) + LWKOPT = INT( WORK( 1 ) ) END IF WORK( 1 ) = LWKOPT END IF From e9b0f5a3648572db51b810afd8e0cb42993175e6 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sat, 19 Nov 2022 15:11:05 +0100 Subject: [PATCH 3/4] Define type conversions explicitly (Reference-LAPACK PR 703) --- lapack-netlib/SRC/sgebak.f | 4 ++-- lapack-netlib/SRC/sgees.f | 2 +- lapack-netlib/SRC/sgeesx.f | 2 +- lapack-netlib/SRC/sggbak.f | 8 ++++---- lapack-netlib/SRC/sggbal.f | 4 ++-- lapack-netlib/SRC/sggglm.f | 2 +- lapack-netlib/SRC/sgglse.f | 2 +- lapack-netlib/SRC/sggqrf.f | 2 +- lapack-netlib/SRC/sggrqf.f | 2 +- lapack-netlib/SRC/sorgbr.f | 2 +- lapack-netlib/SRC/sspgvd.f | 4 ++-- lapack-netlib/SRC/ssygvd.f | 4 ++-- lapack-netlib/SRC/ssysv.f | 2 +- lapack-netlib/SRC/ssysv_rk.f | 2 +- lapack-netlib/SRC/ssysv_rook.f | 2 +- 15 files changed, 22 insertions(+), 22 deletions(-) diff --git a/lapack-netlib/SRC/sgebak.f b/lapack-netlib/SRC/sgebak.f index b51b611a9..abb7809a3 100644 --- a/lapack-netlib/SRC/sgebak.f +++ b/lapack-netlib/SRC/sgebak.f @@ -236,7 +236,7 @@ $ GO TO 40 IF( I.LT.ILO ) $ I = ILO - II - K = SCALE( I ) + K = INT( SCALE( I ) ) IF( K.EQ.I ) $ GO TO 40 CALL SSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV ) @@ -250,7 +250,7 @@ $ GO TO 50 IF( I.LT.ILO ) $ I = ILO - II - K = SCALE( I ) + K = INT( SCALE( I ) ) IF( K.EQ.I ) $ GO TO 50 CALL SSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV ) diff --git a/lapack-netlib/SRC/sgees.f b/lapack-netlib/SRC/sgees.f index d40503f89..6febd549c 100644 --- a/lapack-netlib/SRC/sgees.f +++ b/lapack-netlib/SRC/sgees.f @@ -302,7 +302,7 @@ * CALL SHSEQR( 'S', JOBVS, N, 1, N, A, LDA, WR, WI, VS, LDVS, $ WORK, -1, IEVAL ) - HSWORK = WORK( 1 ) + HSWORK = INT( WORK( 1 ) ) * IF( .NOT.WANTVS ) THEN MAXWRK = MAX( MAXWRK, N + HSWORK ) diff --git a/lapack-netlib/SRC/sgeesx.f b/lapack-netlib/SRC/sgeesx.f index 27c4338d4..6810fe7c8 100644 --- a/lapack-netlib/SRC/sgeesx.f +++ b/lapack-netlib/SRC/sgeesx.f @@ -382,7 +382,7 @@ * CALL SHSEQR( 'S', JOBVS, N, 1, N, A, LDA, WR, WI, VS, LDVS, $ WORK, -1, IEVAL ) - HSWORK = WORK( 1 ) + HSWORK = INT( WORK( 1 ) ) * IF( .NOT.WANTVS ) THEN MAXWRK = MAX( MAXWRK, N + HSWORK ) diff --git a/lapack-netlib/SRC/sggbak.f b/lapack-netlib/SRC/sggbak.f index bb7f36011..8a796fdb1 100644 --- a/lapack-netlib/SRC/sggbak.f +++ b/lapack-netlib/SRC/sggbak.f @@ -252,7 +252,7 @@ $ GO TO 50 * DO 40 I = ILO - 1, 1, -1 - K = RSCALE( I ) + K = INT( RSCALE( I ) ) IF( K.EQ.I ) $ GO TO 40 CALL SSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV ) @@ -262,7 +262,7 @@ IF( IHI.EQ.N ) $ GO TO 70 DO 60 I = IHI + 1, N - K = RSCALE( I ) + K = INT( RSCALE( I ) ) IF( K.EQ.I ) $ GO TO 60 CALL SSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV ) @@ -276,7 +276,7 @@ IF( ILO.EQ.1 ) $ GO TO 90 DO 80 I = ILO - 1, 1, -1 - K = LSCALE( I ) + K = INT( LSCALE( I ) ) IF( K.EQ.I ) $ GO TO 80 CALL SSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV ) @@ -286,7 +286,7 @@ IF( IHI.EQ.N ) $ GO TO 110 DO 100 I = IHI + 1, N - K = LSCALE( I ) + K = INT( LSCALE( I ) ) IF( K.EQ.I ) $ GO TO 100 CALL SSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV ) diff --git a/lapack-netlib/SRC/sggbal.f b/lapack-netlib/SRC/sggbal.f index 6cfdbcdba..d7a8ef16c 100644 --- a/lapack-netlib/SRC/sggbal.f +++ b/lapack-netlib/SRC/sggbal.f @@ -522,7 +522,7 @@ IRAB = ISAMAX( N-ILO+1, B( I, ILO ), LDB ) RAB = MAX( RAB, ABS( B( I, IRAB+ILO-1 ) ) ) LRAB = INT( LOG10( RAB+SFMIN ) / BASL+ONE ) - IR = LSCALE( I ) + SIGN( HALF, LSCALE( I ) ) + IR = INT( LSCALE( I ) + SIGN( HALF, LSCALE( I ) ) ) IR = MIN( MAX( IR, LSFMIN ), LSFMAX, LSFMAX-LRAB ) LSCALE( I ) = SCLFAC**IR ICAB = ISAMAX( IHI, A( 1, I ), 1 ) @@ -530,7 +530,7 @@ ICAB = ISAMAX( IHI, B( 1, I ), 1 ) CAB = MAX( CAB, ABS( B( ICAB, I ) ) ) LCAB = INT( LOG10( CAB+SFMIN ) / BASL+ONE ) - JC = RSCALE( I ) + SIGN( HALF, RSCALE( I ) ) + JC = INT( RSCALE( I ) + SIGN( HALF, RSCALE( I ) ) ) JC = MIN( MAX( JC, LSFMIN ), LSFMAX, LSFMAX-LCAB ) RSCALE( I ) = SCLFAC**JC 360 CONTINUE diff --git a/lapack-netlib/SRC/sggglm.f b/lapack-netlib/SRC/sggglm.f index bbd032beb..56b4dba52 100644 --- a/lapack-netlib/SRC/sggglm.f +++ b/lapack-netlib/SRC/sggglm.f @@ -288,7 +288,7 @@ * CALL SGGQRF( N, M, P, A, LDA, WORK, B, LDB, WORK( M+1 ), $ 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 * ( d2 ) N-M diff --git a/lapack-netlib/SRC/sgglse.f b/lapack-netlib/SRC/sgglse.f index 7ef8782b0..59addc3f4 100644 --- a/lapack-netlib/SRC/sgglse.f +++ b/lapack-netlib/SRC/sgglse.f @@ -276,7 +276,7 @@ * CALL SGGRQF( P, M, N, B, LDB, WORK, A, LDA, WORK( P+1 ), $ 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 * ( c2 ) M+P-N diff --git a/lapack-netlib/SRC/sggqrf.f b/lapack-netlib/SRC/sggqrf.f index c57b16a56..59b498da5 100644 --- a/lapack-netlib/SRC/sggqrf.f +++ b/lapack-netlib/SRC/sggqrf.f @@ -276,7 +276,7 @@ * QR factorization of N-by-M matrix A: A = Q*R * CALL SGEQRF( N, M, A, LDA, TAUA, WORK, LWORK, INFO ) - LOPT = WORK( 1 ) + LOPT = INT( WORK( 1 ) ) * * Update B := Q**T*B. * diff --git a/lapack-netlib/SRC/sggrqf.f b/lapack-netlib/SRC/sggrqf.f index c4a78c347..8b7d4786a 100644 --- a/lapack-netlib/SRC/sggrqf.f +++ b/lapack-netlib/SRC/sggrqf.f @@ -275,7 +275,7 @@ * RQ factorization of M-by-N matrix A: A = R*Q * CALL SGERQF( M, N, A, LDA, TAUA, WORK, LWORK, INFO ) - LOPT = WORK( 1 ) + LOPT = INT( WORK( 1 ) ) * * Update B := B*Q**T * diff --git a/lapack-netlib/SRC/sorgbr.f b/lapack-netlib/SRC/sorgbr.f index 8f15523d4..b1a5c03a2 100644 --- a/lapack-netlib/SRC/sorgbr.f +++ b/lapack-netlib/SRC/sorgbr.f @@ -232,7 +232,7 @@ END IF END IF END IF - LWKOPT = WORK( 1 ) + LWKOPT = INT( WORK( 1 ) ) LWKOPT = MAX (LWKOPT, MN) END IF * diff --git a/lapack-netlib/SRC/sspgvd.f b/lapack-netlib/SRC/sspgvd.f index 9db8de08c..73862ed1b 100644 --- a/lapack-netlib/SRC/sspgvd.f +++ b/lapack-netlib/SRC/sspgvd.f @@ -307,8 +307,8 @@ CALL SSPGST( ITYPE, UPLO, N, AP, BP, INFO ) CALL SSPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK, IWORK, $ LIWORK, INFO ) - LWMIN = MAX( REAL( LWMIN ), REAL( WORK( 1 ) ) ) - LIWMIN = MAX( REAL( LIWMIN ), REAL( IWORK( 1 ) ) ) + LWMIN = INT( MAX( REAL( LWMIN ), REAL( WORK( 1 ) ) ) ) + LIWMIN = INT( MAX( REAL( LIWMIN ), REAL( IWORK( 1 ) ) ) ) * IF( WANTZ ) THEN * diff --git a/lapack-netlib/SRC/ssygvd.f b/lapack-netlib/SRC/ssygvd.f index 9002df237..7c7e0de01 100644 --- a/lapack-netlib/SRC/ssygvd.f +++ b/lapack-netlib/SRC/ssygvd.f @@ -330,8 +330,8 @@ CALL SSYGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) CALL SSYEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, IWORK, LIWORK, $ INFO ) - LOPT = MAX( REAL( LOPT ), REAL( WORK( 1 ) ) ) - LIOPT = MAX( REAL( LIOPT ), REAL( IWORK( 1 ) ) ) + LOPT = INT( MAX( REAL( LOPT ), REAL( WORK( 1 ) ) ) ) + LIOPT = INT( MAX( REAL( LIOPT ), REAL( IWORK( 1 ) ) ) ) * IF( WANTZ .AND. INFO.EQ.0 ) THEN * diff --git a/lapack-netlib/SRC/ssysv.f b/lapack-netlib/SRC/ssysv.f index 5f4062e9a..06a42dfb7 100644 --- a/lapack-netlib/SRC/ssysv.f +++ b/lapack-netlib/SRC/ssysv.f @@ -223,7 +223,7 @@ LWKOPT = 1 ELSE CALL SSYTRF( UPLO, N, A, LDA, IPIV, WORK, -1, INFO ) - LWKOPT = WORK(1) + LWKOPT = INT( WORK( 1 ) ) END IF WORK( 1 ) = LWKOPT END IF diff --git a/lapack-netlib/SRC/ssysv_rk.f b/lapack-netlib/SRC/ssysv_rk.f index 9e0487623..9a7dfa4bb 100644 --- a/lapack-netlib/SRC/ssysv_rk.f +++ b/lapack-netlib/SRC/ssysv_rk.f @@ -280,7 +280,7 @@ LWKOPT = 1 ELSE CALL SSYTRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, -1, INFO ) - LWKOPT = WORK(1) + LWKOPT = INT( WORK( 1 ) ) END IF WORK( 1 ) = LWKOPT END IF diff --git a/lapack-netlib/SRC/ssysv_rook.f b/lapack-netlib/SRC/ssysv_rook.f index b4da1101c..fb7ba8c53 100644 --- a/lapack-netlib/SRC/ssysv_rook.f +++ b/lapack-netlib/SRC/ssysv_rook.f @@ -256,7 +256,7 @@ LWKOPT = 1 ELSE CALL SSYTRF_ROOK( UPLO, N, A, LDA, IPIV, WORK, -1, INFO ) - LWKOPT = WORK(1) + LWKOPT = INT( WORK( 1 ) ) END IF WORK( 1 ) = LWKOPT END IF From 4e60737c2d914de2385c66dfb097b8d3d4d73d10 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sat, 19 Nov 2022 15:22:46 +0100 Subject: [PATCH 4/4] Define type conversions explicitly (Reference-LAPACK PR 703) --- lapack-netlib/SRC/zgebak.f | 4 ++-- lapack-netlib/SRC/zgees.f | 2 +- lapack-netlib/SRC/zgeesx.f | 2 +- lapack-netlib/SRC/zgejsv.f | 36 +++++++++++++++++----------------- lapack-netlib/SRC/zggglm.f | 2 +- lapack-netlib/SRC/zgglse.f | 2 +- lapack-netlib/SRC/zggqrf.f | 2 +- lapack-netlib/SRC/zggrqf.f | 2 +- lapack-netlib/SRC/zhegvd.f | 6 +++--- lapack-netlib/SRC/zhesv_rk.f | 2 +- lapack-netlib/SRC/zhpgvd.f | 6 +++--- lapack-netlib/SRC/zlag2c.f | 4 ++-- lapack-netlib/SRC/zlaic1.f | 4 ++-- lapack-netlib/SRC/zlat2c.f | 6 +++--- lapack-netlib/SRC/zsysv.f | 2 +- lapack-netlib/SRC/zsysv_rk.f | 2 +- lapack-netlib/SRC/zsysv_rook.f | 2 +- lapack-netlib/SRC/zungbr.f | 2 +- 18 files changed, 44 insertions(+), 44 deletions(-) diff --git a/lapack-netlib/SRC/zgebak.f b/lapack-netlib/SRC/zgebak.f index 9ec610efb..9a0f65a43 100644 --- a/lapack-netlib/SRC/zgebak.f +++ b/lapack-netlib/SRC/zgebak.f @@ -238,7 +238,7 @@ $ GO TO 40 IF( I.LT.ILO ) $ I = ILO - II - K = SCALE( I ) + K = INT( SCALE( I ) ) IF( K.EQ.I ) $ GO TO 40 CALL ZSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV ) @@ -252,7 +252,7 @@ $ GO TO 50 IF( I.LT.ILO ) $ I = ILO - II - K = SCALE( I ) + K = INT( SCALE( I ) ) IF( K.EQ.I ) $ GO TO 50 CALL ZSWAP( M, V( I, 1 ), LDV, V( K, 1 ), LDV ) diff --git a/lapack-netlib/SRC/zgees.f b/lapack-netlib/SRC/zgees.f index 40fe78d34..d673087bf 100644 --- a/lapack-netlib/SRC/zgees.f +++ b/lapack-netlib/SRC/zgees.f @@ -282,7 +282,7 @@ * CALL ZHSEQR( 'S', JOBVS, N, 1, N, A, LDA, W, VS, LDVS, $ WORK, -1, IEVAL ) - HSWORK = DBLE( WORK( 1 ) ) + HSWORK = INT( WORK( 1 ) ) * IF( .NOT.WANTVS ) THEN MAXWRK = MAX( MAXWRK, HSWORK ) diff --git a/lapack-netlib/SRC/zgeesx.f b/lapack-netlib/SRC/zgeesx.f index ca4f5c913..bdd741b11 100644 --- a/lapack-netlib/SRC/zgeesx.f +++ b/lapack-netlib/SRC/zgeesx.f @@ -337,7 +337,7 @@ * CALL ZHSEQR( 'S', JOBVS, N, 1, N, A, LDA, W, VS, LDVS, $ WORK, -1, IEVAL ) - HSWORK = DBLE( WORK( 1 ) ) + HSWORK = INT( WORK( 1 ) ) * IF( .NOT.WANTVS ) THEN MAXWRK = MAX( MAXWRK, HSWORK ) diff --git a/lapack-netlib/SRC/zgejsv.f b/lapack-netlib/SRC/zgejsv.f index 0c2226f9f..d1106696c 100644 --- a/lapack-netlib/SRC/zgejsv.f +++ b/lapack-netlib/SRC/zgejsv.f @@ -707,11 +707,11 @@ IF ( LQUERY ) THEN CALL ZGEQP3( M, N, A, LDA, IWORK, CDUMMY, CDUMMY, -1, $ RDUMMY, IERR ) - LWRK_ZGEQP3 = DBLE( CDUMMY(1) ) + LWRK_ZGEQP3 = INT( CDUMMY(1) ) 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 ) - LWRK_ZGELQF = DBLE( CDUMMY(1) ) + LWRK_ZGELQF = INT( CDUMMY(1) ) END IF MINWRK = 2 OPTWRK = 2 @@ -727,7 +727,7 @@ IF ( LQUERY ) THEN CALL ZGESVJ( 'L', 'N', 'N', N, N, A, LDA, SVA, N, V, $ LDV, CDUMMY, -1, RDUMMY, -1, IERR ) - LWRK_ZGESVJ = DBLE( CDUMMY(1) ) + LWRK_ZGESVJ = INT( CDUMMY(1) ) IF ( ERREST ) THEN OPTWRK = MAX( N+LWRK_ZGEQP3, N**2+LWCON, $ N+LWRK_ZGEQRF, LWRK_ZGESVJ ) @@ -763,10 +763,10 @@ IF ( LQUERY ) THEN CALL ZGESVJ( 'L', 'U', 'N', N,N, U, LDU, SVA, N, A, $ 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, $ V, LDV, CDUMMY, -1, IERR ) - LWRK_ZUNMLQ = DBLE( CDUMMY(1) ) + LWRK_ZUNMLQ = INT( CDUMMY(1) ) IF ( ERREST ) THEN OPTWRK = MAX( N+LWRK_ZGEQP3, LWCON, LWRK_ZGESVJ, $ N+LWRK_ZGELQF, 2*N+LWRK_ZGEQRF, @@ -802,10 +802,10 @@ IF ( LQUERY ) THEN CALL ZGESVJ( 'L', 'U', 'N', N,N, U, LDU, SVA, N, A, $ 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, $ LDU, CDUMMY, -1, IERR ) - LWRK_ZUNMQRM = DBLE( CDUMMY(1) ) + LWRK_ZUNMQRM = INT( CDUMMY(1) ) IF ( ERREST ) THEN OPTWRK = N + MAX( LWRK_ZGEQP3, LWCON, N+LWRK_ZGEQRF, $ LWRK_ZGESVJ, LWRK_ZUNMQRM ) @@ -864,26 +864,26 @@ IF ( LQUERY ) THEN CALL ZUNMQR( 'L', 'N', M, N, N, A, LDA, CDUMMY, U, $ 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, $ LDU, CDUMMY, -1, IERR ) - LWRK_ZUNMQR = DBLE( CDUMMY(1) ) + LWRK_ZUNMQR = INT( CDUMMY(1) ) IF ( .NOT. JRACC ) THEN CALL ZGEQP3( N,N, A, LDA, IWORK, CDUMMY,CDUMMY, -1, $ RDUMMY, IERR ) - LWRK_ZGEQP3N = DBLE( CDUMMY(1) ) + LWRK_ZGEQP3N = INT( CDUMMY(1) ) CALL ZGESVJ( 'L', 'U', 'N', N, N, U, LDU, SVA, $ 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, $ 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, $ 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, $ V, LDV, CDUMMY, -1, IERR ) - LWRK_ZUNMLQ = DBLE( CDUMMY(1) ) + LWRK_ZUNMLQ = INT( CDUMMY(1) ) IF ( ERREST ) THEN OPTWRK = MAX( N+LWRK_ZGEQP3, N+LWCON, $ 2*N+N**2+LWCON, 2*N+LWRK_ZGEQRF, @@ -912,13 +912,13 @@ ELSE CALL ZGESVJ( 'L', 'U', 'V', N, N, U, LDU, SVA, $ 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, $ 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, $ LDU, CDUMMY, -1, IERR ) - LWRK_ZUNMQRM = DBLE( CDUMMY(1) ) + LWRK_ZUNMQRM = INT( CDUMMY(1) ) IF ( ERREST ) THEN OPTWRK = MAX( N+LWRK_ZGEQP3, N+LWCON, $ 2*N+LWRK_ZGEQRF, 2*N+N**2, diff --git a/lapack-netlib/SRC/zggglm.f b/lapack-netlib/SRC/zggglm.f index 6c24131aa..62b4acdec 100644 --- a/lapack-netlib/SRC/zggglm.f +++ b/lapack-netlib/SRC/zggglm.f @@ -289,7 +289,7 @@ * CALL ZGGQRF( N, M, P, A, LDA, WORK, B, LDB, WORK( M+1 ), $ 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 * ( d2 ) N-M diff --git a/lapack-netlib/SRC/zgglse.f b/lapack-netlib/SRC/zgglse.f index e5869a7d4..cc558bc40 100644 --- a/lapack-netlib/SRC/zgglse.f +++ b/lapack-netlib/SRC/zgglse.f @@ -276,7 +276,7 @@ * CALL ZGGRQF( P, M, N, B, LDB, WORK, A, LDA, WORK( P+1 ), $ 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 * ( c2 ) M+P-N diff --git a/lapack-netlib/SRC/zggqrf.f b/lapack-netlib/SRC/zggqrf.f index 93b1dc0fc..0388b0874 100644 --- a/lapack-netlib/SRC/zggqrf.f +++ b/lapack-netlib/SRC/zggqrf.f @@ -276,7 +276,7 @@ * QR factorization of N-by-M matrix A: A = Q*R * CALL ZGEQRF( N, M, A, LDA, TAUA, WORK, LWORK, INFO ) - LOPT = DBLE( WORK( 1 ) ) + LOPT = INT( WORK( 1 ) ) * * Update B := Q**H*B. * diff --git a/lapack-netlib/SRC/zggrqf.f b/lapack-netlib/SRC/zggrqf.f index a2d4a9d55..be912c772 100644 --- a/lapack-netlib/SRC/zggrqf.f +++ b/lapack-netlib/SRC/zggrqf.f @@ -275,7 +275,7 @@ * RQ factorization of M-by-N matrix A: A = R*Q * CALL ZGERQF( M, N, A, LDA, TAUA, WORK, LWORK, INFO ) - LOPT = DBLE( WORK( 1 ) ) + LOPT = INT( WORK( 1 ) ) * * Update B := B*Q**H * diff --git a/lapack-netlib/SRC/zhegvd.f b/lapack-netlib/SRC/zhegvd.f index 2e92255df..eeda656ad 100644 --- a/lapack-netlib/SRC/zhegvd.f +++ b/lapack-netlib/SRC/zhegvd.f @@ -360,9 +360,9 @@ CALL ZHEGST( ITYPE, UPLO, N, A, LDA, B, LDB, INFO ) CALL ZHEEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK, LRWORK, $ IWORK, LIWORK, INFO ) - LOPT = MAX( DBLE( LOPT ), DBLE( WORK( 1 ) ) ) - LROPT = MAX( DBLE( LROPT ), DBLE( RWORK( 1 ) ) ) - LIOPT = MAX( DBLE( LIOPT ), DBLE( IWORK( 1 ) ) ) + LOPT = INT( MAX( DBLE( LOPT ), DBLE( WORK( 1 ) ) ) ) + LROPT = INT( MAX( DBLE( LROPT ), DBLE( RWORK( 1 ) ) ) ) + LIOPT = INT( MAX( DBLE( LIOPT ), DBLE( IWORK( 1 ) ) ) ) * IF( WANTZ .AND. INFO.EQ.0 ) THEN * diff --git a/lapack-netlib/SRC/zhesv_rk.f b/lapack-netlib/SRC/zhesv_rk.f index 1ec75cc04..6333e9f36 100644 --- a/lapack-netlib/SRC/zhesv_rk.f +++ b/lapack-netlib/SRC/zhesv_rk.f @@ -280,7 +280,7 @@ LWKOPT = 1 ELSE CALL ZHETRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, -1, INFO ) - LWKOPT = DBLE( WORK(1) ) + LWKOPT = INT( DBLE( WORK( 1 ) ) ) END IF WORK( 1 ) = LWKOPT END IF diff --git a/lapack-netlib/SRC/zhpgvd.f b/lapack-netlib/SRC/zhpgvd.f index d27cdc761..e96e39738 100644 --- a/lapack-netlib/SRC/zhpgvd.f +++ b/lapack-netlib/SRC/zhpgvd.f @@ -335,9 +335,9 @@ CALL ZHPGST( ITYPE, UPLO, N, AP, BP, INFO ) CALL ZHPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK, RWORK, $ LRWORK, IWORK, LIWORK, INFO ) - LWMIN = MAX( DBLE( LWMIN ), DBLE( WORK( 1 ) ) ) - LRWMIN = MAX( DBLE( LRWMIN ), DBLE( RWORK( 1 ) ) ) - LIWMIN = MAX( DBLE( LIWMIN ), DBLE( IWORK( 1 ) ) ) + LWMIN = INT( MAX( DBLE( LWMIN ), DBLE( WORK( 1 ) ) ) ) + LRWMIN = INT( MAX( DBLE( LRWMIN ), DBLE( RWORK( 1 ) ) ) ) + LIWMIN = INT( MAX( DBLE( LIWMIN ), DBLE( IWORK( 1 ) ) ) ) * IF( WANTZ ) THEN * diff --git a/lapack-netlib/SRC/zlag2c.f b/lapack-netlib/SRC/zlag2c.f index ba141a98f..434590bb9 100644 --- a/lapack-netlib/SRC/zlag2c.f +++ b/lapack-netlib/SRC/zlag2c.f @@ -124,7 +124,7 @@ DOUBLE PRECISION RMAX * .. * .. Intrinsic Functions .. - INTRINSIC DBLE, DIMAG + INTRINSIC DBLE, DIMAG, CMPLX * .. * .. External Functions .. REAL SLAMCH @@ -142,7 +142,7 @@ INFO = 1 GO TO 30 END IF - SA( I, J ) = A( I, J ) + SA( I, J ) = CMPLX( A( I, J ) ) 10 CONTINUE 20 CONTINUE INFO = 0 diff --git a/lapack-netlib/SRC/zlaic1.f b/lapack-netlib/SRC/zlaic1.f index 72948cde9..47927e778 100644 --- a/lapack-netlib/SRC/zlaic1.f +++ b/lapack-netlib/SRC/zlaic1.f @@ -348,9 +348,9 @@ B = ( ZETA2*ZETA2+ZETA1*ZETA1-ONE )*HALF C = ZETA1*ZETA1 IF( B.GE.ZERO ) THEN - T = -C / ( B+SQRT( B*B+C ) ) + T = DBLE( -C / ( B+SQRT( B*B+C ) ) ) ELSE - T = B - SQRT( B*B+C ) + T = DBLE( B - SQRT( B*B+C ) ) END IF SINE = -( ALPHA / ABSEST ) / T COSINE = -( GAMMA / ABSEST ) / ( ONE+T ) diff --git a/lapack-netlib/SRC/zlat2c.f b/lapack-netlib/SRC/zlat2c.f index 1d607dcea..a413b05c1 100644 --- a/lapack-netlib/SRC/zlat2c.f +++ b/lapack-netlib/SRC/zlat2c.f @@ -130,7 +130,7 @@ LOGICAL UPPER * .. * .. Intrinsic Functions .. - INTRINSIC DBLE, DIMAG + INTRINSIC DBLE, DIMAG, CMPLX * .. * .. External Functions .. REAL SLAMCH @@ -151,7 +151,7 @@ INFO = 1 GO TO 50 END IF - SA( I, J ) = A( I, J ) + SA( I, J ) = CMPLX( A( I, J ) ) 10 CONTINUE 20 CONTINUE ELSE @@ -164,7 +164,7 @@ INFO = 1 GO TO 50 END IF - SA( I, J ) = A( I, J ) + SA( I, J ) = CMPLX( A( I, J ) ) 30 CONTINUE 40 CONTINUE END IF diff --git a/lapack-netlib/SRC/zsysv.f b/lapack-netlib/SRC/zsysv.f index ed173dadc..44f1e25b1 100644 --- a/lapack-netlib/SRC/zsysv.f +++ b/lapack-netlib/SRC/zsysv.f @@ -223,7 +223,7 @@ LWKOPT = 1 ELSE CALL ZSYTRF( UPLO, N, A, LDA, IPIV, WORK, -1, INFO ) - LWKOPT = DBLE( WORK(1) ) + LWKOPT = INT( DBLE( WORK( 1 ) ) ) END IF WORK( 1 ) = LWKOPT END IF diff --git a/lapack-netlib/SRC/zsysv_rk.f b/lapack-netlib/SRC/zsysv_rk.f index df828ee33..8d9fb82c8 100644 --- a/lapack-netlib/SRC/zsysv_rk.f +++ b/lapack-netlib/SRC/zsysv_rk.f @@ -280,7 +280,7 @@ LWKOPT = 1 ELSE CALL ZSYTRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, -1, INFO ) - LWKOPT = DBLE( WORK(1) ) + LWKOPT = INT( DBLE( WORK( 1 ) ) ) END IF WORK( 1 ) = LWKOPT END IF diff --git a/lapack-netlib/SRC/zsysv_rook.f b/lapack-netlib/SRC/zsysv_rook.f index 7c9fb4bf6..745339512 100644 --- a/lapack-netlib/SRC/zsysv_rook.f +++ b/lapack-netlib/SRC/zsysv_rook.f @@ -256,7 +256,7 @@ LWKOPT = 1 ELSE CALL ZSYTRF_ROOK( UPLO, N, A, LDA, IPIV, WORK, -1, INFO ) - LWKOPT = DBLE( WORK(1) ) + LWKOPT = INT( DBLE( WORK( 1 ) ) ) END IF WORK( 1 ) = LWKOPT END IF diff --git a/lapack-netlib/SRC/zungbr.f b/lapack-netlib/SRC/zungbr.f index 3dfca43be..c42a372c5 100644 --- a/lapack-netlib/SRC/zungbr.f +++ b/lapack-netlib/SRC/zungbr.f @@ -233,7 +233,7 @@ END IF END IF END IF - LWKOPT = DBLE( WORK( 1 ) ) + LWKOPT = INT( DBLE( WORK( 1 ) ) ) LWKOPT = MAX (LWKOPT, MN) END IF *