From d735f09838dcae48c8860266680b4b95d93f2c2b Mon Sep 17 00:00:00 2001 From: "Tim Hopkins, University of Kent" <@> Date: Fri, 17 Jun 2016 17:10:39 -0400 Subject: Patch from Tim Hopkins sent by email on March 14th, 2016 (merge from Julien on June 17th, 2016) --- SRC/CMakeLists.txt | 8 +++--- SRC/cgeev.f | 30 +++++++++++---------- SRC/cgeevx.f | 40 ++++++++++++++------------- SRC/cuncsd.f | 2 +- SRC/cuncsd2by1.f | 2 +- SRC/dgeev.f | 2 ++ SRC/dgeevx.f | 4 ++- SRC/dorcsd2by1.f | 76 ++++++++++++++++++++++++++-------------------------- SRC/sgeev.f | 18 +++++++------ SRC/sgeevx.f | 26 +++++++++--------- SRC/sorcsd2by1.f | 66 ++++++++++++++++++++++----------------------- SRC/zgeev.f | 12 +++++---- SRC/zgeevx.f | 14 +++++----- SRC/zuncsd2by1.f | 2 +- TESTING/EIG/cchkee.f | 4 +++ TESTING/EIG/cerrgg.f | 40 +++++++++++++-------------- TESTING/EIG/dchkee.f | 3 +++ TESTING/EIG/ddrvbd.f | 2 +- TESTING/EIG/derrgg.f | 24 ++++++++--------- TESTING/EIG/schkee.f | 5 +++- TESTING/EIG/serrgg.f | 26 +++++++++--------- TESTING/EIG/zchkee.f | 3 +++ TESTING/EIG/zerrgg.f | 40 +++++++++++++-------------- 23 files changed, 239 insertions(+), 210 deletions(-) diff --git a/SRC/CMakeLists.txt b/SRC/CMakeLists.txt index 4857f474..03441b94 100644 --- a/SRC/CMakeLists.txt +++ b/SRC/CMakeLists.txt @@ -141,7 +141,7 @@ set(SLASRC stbrfs.f stbtrs.f stgevc.f stgex2.f stgexc.f stgsen.f stgsja.f stgsna.f stgsy2.f stgsyl.f stpcon.f stprfs.f stptri.f stptrs.f - strcon.f strevc.f strevc3.f strexc.f strrfs.f strsen.f strsna.f strsyl.f + strcon.f strevc.f strexc.f strrfs.f strsen.f strsna.f strsyl.f strti2.f strtri.f strtrs.f stzrzf.f sstemr.f slansf.f spftrf.f spftri.f spftrs.f ssfrk.f stfsm.f stftri.f stfttp.f stfttr.f stpttf.f stpttr.f strttf.f strttp.f @@ -221,7 +221,7 @@ set(CLASRC ctbcon.f ctbrfs.f ctbtrs.f ctgevc.f ctgex2.f ctgexc.f ctgsen.f ctgsja.f ctgsna.f ctgsy2.f ctgsyl.f ctpcon.f ctprfs.f ctptri.f - ctptrs.f ctrcon.f ctrevc.f ctrevc3.f ctrexc.f ctrrfs.f ctrsen.f ctrsna.f + ctptrs.f ctrcon.f ctrevc.f ctrexc.f ctrrfs.f ctrsen.f ctrsna.f ctrsyl.f ctrti2.f ctrtri.f ctrtrs.f ctzrzf.f cung2l.f cung2r.f cungbr.f cunghr.f cungl2.f cunglq.f cungql.f cungqr.f cungr2.f cungrq.f cungtr.f cunm2l.f cunm2r.f cunmbr.f cunmhr.f cunml2.f cunm22.f @@ -302,7 +302,7 @@ set(DLASRC dtbrfs.f dtbtrs.f dtgevc.f dtgex2.f dtgexc.f dtgsen.f dtgsja.f dtgsna.f dtgsy2.f dtgsyl.f dtpcon.f dtprfs.f dtptri.f dtptrs.f - dtrcon.f dtrevc.f dtrevc3.f dtrexc.f dtrrfs.f dtrsen.f dtrsna.f dtrsyl.f + dtrcon.f dtrevc.f dtrexc.f dtrrfs.f dtrsen.f dtrsna.f dtrsyl.f dtrti2.f dtrtri.f dtrtrs.f dtzrzf.f dstemr.f dsgesv.f dsposv.f dlag2s.f slag2d.f dlat2s.f dlansf.f dpftrf.f dpftri.f dpftrs.f dsfrk.f dtfsm.f dtftri.f dtfttp.f @@ -383,7 +383,7 @@ set(ZLASRC ztbcon.f ztbrfs.f ztbtrs.f ztgevc.f ztgex2.f ztgexc.f ztgsen.f ztgsja.f ztgsna.f ztgsy2.f ztgsyl.f ztpcon.f ztprfs.f ztptri.f - ztptrs.f ztrcon.f ztrevc.f ztrevc3.f ztrexc.f ztrrfs.f ztrsen.f ztrsna.f + ztptrs.f ztrcon.f ztrevc.f ztrexc.f ztrrfs.f ztrsen.f ztrsna.f ztrsyl.f ztrti2.f ztrtri.f ztrtrs.f ztzrzf.f zung2l.f zung2r.f zungbr.f zunghr.f zungl2.f zunglq.f zungql.f zungqr.f zungr2.f zungrq.f zungtr.f zunm2l.f zunm2r.f zunmbr.f zunmhr.f zunml2.f zunm22.f diff --git a/SRC/cgeev.f b/SRC/cgeev.f index a888c64f..ec787ef9 100644 --- a/SRC/cgeev.f +++ b/SRC/cgeev.f @@ -26,8 +26,8 @@ * INTEGER INFO, LDA, LDVL, LDVR, LWORK, N * .. * .. Array Arguments .. -* REAL RWORK( * ) -* COMPLEX A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ), +* REAL RWORK( * ) +* COMPLEX A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ), * $ W( * ), WORK( * ) * .. * @@ -171,6 +171,8 @@ * *> \date November 2011 * +* @generated from zgeev.f, fortran z -> c, Tue Apr 19 01:47:44 2016 +* *> \ingroup complexGEeigen * * ===================================================================== @@ -188,15 +190,15 @@ INTEGER INFO, LDA, LDVL, LDVR, LWORK, N * .. * .. Array Arguments .. - REAL RWORK( * ) - COMPLEX A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ), + REAL RWORK( * ) + COMPLEX A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ), $ W( * ), WORK( * ) * .. * * ===================================================================== * * .. Parameters .. - REAL ZERO, ONE + REAL ZERO, ONE PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 ) * .. * .. Local Scalars .. @@ -204,25 +206,25 @@ CHARACTER SIDE INTEGER HSWORK, I, IBAL, IERR, IHI, ILO, IRWORK, ITAU, $ IWRK, K, LWORK_TREVC, MAXWRK, MINWRK, NOUT - REAL ANRM, BIGNUM, CSCALE, EPS, SCL, SMLNUM - COMPLEX TMP + REAL ANRM, BIGNUM, CSCALE, EPS, SCL, SMLNUM + COMPLEX TMP * .. * .. Local Arrays .. LOGICAL SELECT( 1 ) - REAL DUM( 1 ) + REAL DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL CGEBAK, CGEBAL, CGEHRD, CHSEQR, CLACPY, CLASCL, - $ CSCAL, CSSCAL, CTREVC3, CUNGHR, SLABAD, XERBLA + EXTERNAL SLABAD, XERBLA, CSSCAL, CGEBAK, CGEBAL, CGEHRD, + $ CHSEQR, CLACPY, CLASCL, CSCAL, CTREVC3, CUNGHR * .. * .. External Functions .. LOGICAL LSAME - INTEGER ILAENV, ISAMAX - REAL CLANGE, SCNRM2, SLAMCH - EXTERNAL LSAME, ILAENV, ISAMAX, CLANGE, SCNRM2, SLAMCH + INTEGER ISAMAX, ILAENV + REAL SLAMCH, SCNRM2, CLANGE + EXTERNAL LSAME, ISAMAX, ILAENV, SLAMCH, SCNRM2, CLANGE * .. * .. Intrinsic Functions .. - INTRINSIC AIMAG, CMPLX, CONJG, MAX, REAL, SQRT + INTRINSIC REAL, CMPLX, CONJG, AIMAG, MAX, SQRT * .. * .. Executable Statements .. * diff --git a/SRC/cgeevx.f b/SRC/cgeevx.f index b62f070c..0d63cd00 100644 --- a/SRC/cgeevx.f +++ b/SRC/cgeevx.f @@ -25,12 +25,12 @@ * .. Scalar Arguments .. * CHARACTER BALANC, JOBVL, JOBVR, SENSE * INTEGER IHI, ILO, INFO, LDA, LDVL, LDVR, LWORK, N -* REAL ABNRM +* REAL ABNRM * .. * .. Array Arguments .. -* REAL RCONDE( * ), RCONDV( * ), RWORK( * ), +* REAL RCONDE( * ), RCONDV( * ), RWORK( * ), * $ SCALE( * ) -* COMPLEX A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ), +* COMPLEX A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ), * $ W( * ), WORK( * ) * .. * @@ -134,7 +134,7 @@ *> A is COMPLEX array, dimension (LDA,N) *> On entry, the N-by-N matrix A. *> On exit, A has been overwritten. If JOBVL = 'V' or -*> JOBVR = 'V', A contains the Schur form of the balanced +*> JOBVR = 'V', A contains the Schur form of the balanced *> version of the matrix A. *> \endverbatim *> @@ -278,6 +278,8 @@ * *> \date November 2011 * +* @generated from zgeevx.f, fortran z -> c, Tue Apr 19 01:47:44 2016 +* *> \ingroup complexGEeigen * * ===================================================================== @@ -294,47 +296,47 @@ * .. Scalar Arguments .. CHARACTER BALANC, JOBVL, JOBVR, SENSE INTEGER IHI, ILO, INFO, LDA, LDVL, LDVR, LWORK, N - REAL ABNRM + REAL ABNRM * .. * .. Array Arguments .. - REAL RCONDE( * ), RCONDV( * ), RWORK( * ), + REAL RCONDE( * ), RCONDV( * ), RWORK( * ), $ SCALE( * ) - COMPLEX A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ), + COMPLEX A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ), $ W( * ), WORK( * ) * .. * * ===================================================================== * * .. Parameters .. - REAL ZERO, ONE + REAL ZERO, ONE PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 ) * .. * .. Local Scalars .. LOGICAL LQUERY, SCALEA, WANTVL, WANTVR, WNTSNB, WNTSNE, $ WNTSNN, WNTSNV CHARACTER JOB, SIDE - INTEGER HSWORK, I, ICOND, IERR, ITAU, IWRK, K, + INTEGER HSWORK, I, ICOND, IERR, ITAU, IWRK, K, $ LWORK_TREVC, MAXWRK, MINWRK, NOUT - REAL ANRM, BIGNUM, CSCALE, EPS, SCL, SMLNUM - COMPLEX TMP + REAL ANRM, BIGNUM, CSCALE, EPS, SCL, SMLNUM + COMPLEX TMP * .. * .. Local Arrays .. LOGICAL SELECT( 1 ) - REAL DUM( 1 ) + REAL DUM( 1 ) * .. * .. External Subroutines .. - EXTERNAL CGEBAK, CGEBAL, CGEHRD, CHSEQR, CLACPY, CLASCL, - $ CSCAL, CSSCAL, CTREVC3, CTRSNA, CUNGHR, SLABAD, - $ SLASCL, XERBLA + EXTERNAL SLABAD, SLASCL, XERBLA, CSSCAL, CGEBAK, CGEBAL, + $ CGEHRD, CHSEQR, CLACPY, CLASCL, CSCAL, CTREVC3, + $ CTRSNA, CUNGHR * .. * .. External Functions .. LOGICAL LSAME - INTEGER ILAENV, ISAMAX - REAL CLANGE, SCNRM2, SLAMCH - EXTERNAL LSAME, ILAENV, ISAMAX, CLANGE, SCNRM2, SLAMCH + INTEGER ISAMAX, ILAENV + REAL SLAMCH, SCNRM2, CLANGE + EXTERNAL LSAME, ISAMAX, ILAENV, SLAMCH, SCNRM2, CLANGE * .. * .. Intrinsic Functions .. - INTRINSIC AIMAG, CMPLX, CONJG, MAX, REAL, SQRT + INTRINSIC REAL, CMPLX, CONJG, AIMAG, MAX, SQRT * .. * .. Executable Statements .. * diff --git a/SRC/cuncsd.f b/SRC/cuncsd.f index dd785857..a988b6c4 100644 --- a/SRC/cuncsd.f +++ b/SRC/cuncsd.f @@ -371,7 +371,7 @@ EXTERNAL LSAME * .. * .. Intrinsic Functions - INTRINSIC COS, INT, MAX, MIN, SIN + INTRINSIC INT, MAX, MIN * .. * .. Executable Statements .. * diff --git a/SRC/cuncsd2by1.f b/SRC/cuncsd2by1.f index 96af777f..05685927 100644 --- a/SRC/cuncsd2by1.f +++ b/SRC/cuncsd2by1.f @@ -290,7 +290,7 @@ * .. * .. Local Arrays .. REAL DUM( 1 ) - COMPLEX CDUM( 1 ) + COMPLEX CDUM( 1, 1 ) * .. * .. External Subroutines .. EXTERNAL CBBCSD, CCOPY, CLACPY, CLAPMR, CLAPMT, CUNBDB1, diff --git a/SRC/dgeev.f b/SRC/dgeev.f index 1c92b7e3..3640b7d1 100644 --- a/SRC/dgeev.f +++ b/SRC/dgeev.f @@ -183,6 +183,8 @@ * *> \date September 2012 * +* @precisions fortran d -> s +* *> \ingroup doubleGEeigen * * ===================================================================== diff --git a/SRC/dgeevx.f b/SRC/dgeevx.f index d2ba08f0..e8610de0 100644 --- a/SRC/dgeevx.f +++ b/SRC/dgeevx.f @@ -296,6 +296,8 @@ * *> \date September 2012 * +* @precisions fortran d -> s +* *> \ingroup doubleGEeigen * * ===================================================================== @@ -331,7 +333,7 @@ LOGICAL LQUERY, SCALEA, WANTVL, WANTVR, WNTSNB, WNTSNE, $ WNTSNN, WNTSNV CHARACTER JOB, SIDE - INTEGER HSWORK, I, ICOND, IERR, ITAU, IWRK, K, + INTEGER HSWORK, I, ICOND, IERR, ITAU, IWRK, K, $ LWORK_TREVC, MAXWRK, MINWRK, NOUT DOUBLE PRECISION ANRM, BIGNUM, CS, CSCALE, EPS, R, SCL, SMLNUM, $ SN diff --git a/SRC/dorcsd2by1.f b/SRC/dorcsd2by1.f index 809997d0..dd0cd351 100644 --- a/SRC/dorcsd2by1.f +++ b/SRC/dorcsd2by1.f @@ -267,7 +267,7 @@ LOGICAL LQUERY, WANTU1, WANTU2, WANTV1T * .. * .. Local Arrays .. - DOUBLE PRECISION DUM( 1 ) + DOUBLE PRECISION DUM1(1), DUM2(1,1) * .. * .. External Subroutines .. EXTERNAL DBBCSD, DCOPY, DLACPY, DLAPMR, DLAPMT, DORBDB1, @@ -353,119 +353,119 @@ LORGLQOPT = 1 IF( R .EQ. Q ) THEN CALL DORBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, - $ DUM, DUM, DUM, DUM, WORK, + $ DUM1, DUM1, DUM1, DUM1, WORK, $ -1, CHILDINFO ) LORBDB = INT( WORK(1) ) IF( WANTU1 .AND. P .GT. 0 ) THEN - CALL DORGQR( P, P, Q, U1, LDU1, DUM, WORK(1), -1, + CALL DORGQR( P, P, Q, U1, LDU1, DUM1, WORK(1), -1, $ CHILDINFO ) LORGQRMIN = MAX( LORGQRMIN, P ) LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) ENDIF IF( WANTU2 .AND. M-P .GT. 0 ) THEN - CALL DORGQR( M-P, M-P, Q, U2, LDU2, DUM, WORK(1), + CALL DORGQR( M-P, M-P, Q, U2, LDU2, DUM1, WORK(1), $ -1, CHILDINFO ) LORGQRMIN = MAX( LORGQRMIN, M-P ) LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) END IF IF( WANTV1T .AND. Q .GT. 0 ) THEN CALL DORGLQ( Q-1, Q-1, Q-1, V1T, LDV1T, - $ DUM, WORK(1), -1, CHILDINFO ) + $ DUM1, WORK(1), -1, CHILDINFO ) LORGLQMIN = MAX( LORGLQMIN, Q-1 ) LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF CALL DBBCSD( JOBU1, JOBU2, JOBV1T, 'N', 'N', M, P, Q, THETA, - $ DUM, U1, LDU1, U2, LDU2, V1T, LDV1T, - $ DUM, 1, DUM, DUM, DUM, - $ DUM, DUM, DUM, DUM, - $ DUM, WORK(1), -1, CHILDINFO ) + $ DUM1, U1, LDU1, U2, LDU2, V1T, LDV1T, + $ DUM2, 1, DUM1, DUM1, DUM1, + $ DUM1, DUM1, DUM1, DUM1, + $ DUM1, WORK(1), -1, CHILDINFO ) LBBCSD = INT( WORK(1) ) ELSE IF( R .EQ. P ) THEN CALL DORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, - $ DUM, DUM, DUM, DUM, + $ DUM1, DUM1, DUM1, DUM1, $ WORK(1), -1, CHILDINFO ) LORBDB = INT( WORK(1) ) IF( WANTU1 .AND. P .GT. 0 ) THEN - CALL DORGQR( P-1, P-1, P-1, U1(2,2), LDU1, DUM, + CALL DORGQR( P-1, P-1, P-1, U1(2,2), LDU1, DUM1, $ WORK(1), -1, CHILDINFO ) LORGQRMIN = MAX( LORGQRMIN, P-1 ) LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) END IF IF( WANTU2 .AND. M-P .GT. 0 ) THEN - CALL DORGQR( M-P, M-P, Q, U2, LDU2, DUM, WORK(1), + CALL DORGQR( M-P, M-P, Q, U2, LDU2, DUM1, WORK(1), $ -1, CHILDINFO ) LORGQRMIN = MAX( LORGQRMIN, M-P ) LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) END IF IF( WANTV1T .AND. Q .GT. 0 ) THEN - CALL DORGLQ( Q, Q, R, V1T, LDV1T, DUM, WORK(1), -1, + CALL DORGLQ( Q, Q, R, V1T, LDV1T, DUM1, WORK(1), -1, $ CHILDINFO ) LORGLQMIN = MAX( LORGLQMIN, Q ) LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF CALL DBBCSD( JOBV1T, 'N', JOBU1, JOBU2, 'T', M, Q, P, THETA, - $ DUM, V1T, LDV1T, DUM, 1, U1, LDU1, - $ U2, LDU2, DUM, DUM, DUM, - $ DUM, DUM, DUM, DUM, - $ DUM, WORK(1), -1, CHILDINFO ) + $ DUM1, V1T, LDV1T, DUM2, 1, U1, LDU1, + $ U2, LDU2, DUM1, DUM1, DUM1, + $ DUM1, DUM1, DUM1, DUM1, + $ DUM1, WORK(1), -1, CHILDINFO ) LBBCSD = INT( WORK(1) ) ELSE IF( R .EQ. M-P ) THEN CALL DORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, - $ DUM, DUM, DUM, DUM, + $ DUM1, DUM1, DUM1, DUM1, $ WORK(1), -1, CHILDINFO ) LORBDB = INT( WORK(1) ) IF( WANTU1 .AND. P .GT. 0 ) THEN - CALL DORGQR( P, P, Q, U1, LDU1, DUM, WORK(1), -1, + CALL DORGQR( P, P, Q, U1, LDU1, DUM1, WORK(1), -1, $ CHILDINFO ) LORGQRMIN = MAX( LORGQRMIN, P ) LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) END IF IF( WANTU2 .AND. M-P .GT. 0 ) THEN CALL DORGQR( M-P-1, M-P-1, M-P-1, U2(2,2), LDU2, - $ DUM, WORK(1), -1, CHILDINFO ) + $ DUM1, WORK(1), -1, CHILDINFO ) LORGQRMIN = MAX( LORGQRMIN, M-P-1 ) LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) END IF IF( WANTV1T .AND. Q .GT. 0 ) THEN - CALL DORGLQ( Q, Q, R, V1T, LDV1T, DUM, WORK(1), -1, + CALL DORGLQ( Q, Q, R, V1T, LDV1T, DUM1, WORK(1), -1, $ CHILDINFO ) LORGLQMIN = MAX( LORGLQMIN, Q ) LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF CALL DBBCSD( 'N', JOBV1T, JOBU2, JOBU1, 'T', M, M-Q, M-P, - $ THETA, DUM, DUM, 1, V1T, LDV1T, U2, - $ LDU2, U1, LDU1, DUM, DUM, DUM, - $ DUM, DUM, DUM, DUM, - $ DUM, WORK(1), -1, CHILDINFO ) + $ THETA, DUM1, DUM2, 1, V1T, LDV1T, U2, + $ LDU2, U1, LDU1, DUM1, DUM1, DUM1, + $ DUM1, DUM1, DUM1, DUM1, + $ DUM1, WORK(1), -1, CHILDINFO ) LBBCSD = INT( WORK(1) ) ELSE CALL DORBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, - $ DUM, DUM, DUM, DUM, - $ DUM, WORK(1), -1, CHILDINFO ) + $ DUM1, DUM1, DUM1, DUM1, + $ DUM1, WORK(1), -1, CHILDINFO ) LORBDB = M + INT( WORK(1) ) IF( WANTU1 .AND. P .GT. 0 ) THEN - CALL DORGQR( P, P, M-Q, U1, LDU1, DUM, WORK(1), -1, + CALL DORGQR( P, P, M-Q, U1, LDU1, DUM1, WORK(1), -1, $ CHILDINFO ) LORGQRMIN = MAX( LORGQRMIN, P ) LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) END IF IF( WANTU2 .AND. M-P .GT. 0 ) THEN - CALL DORGQR( M-P, M-P, M-Q, U2, LDU2, DUM, WORK(1), + CALL DORGQR( M-P, M-P, M-Q, U2, LDU2, DUM1, WORK(1), $ -1, CHILDINFO ) LORGQRMIN = MAX( LORGQRMIN, M-P ) LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) END IF IF( WANTV1T .AND. Q .GT. 0 ) THEN - CALL DORGLQ( Q, Q, Q, V1T, LDV1T, DUM, WORK(1), -1, + CALL DORGLQ( Q, Q, Q, V1T, LDV1T, DUM1, WORK(1), -1, $ CHILDINFO ) LORGLQMIN = MAX( LORGLQMIN, Q ) LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF CALL DBBCSD( JOBU2, JOBU1, 'N', JOBV1T, 'N', M, M-P, M-Q, - $ THETA, DUM, U2, LDU2, U1, LDU1, DUM, - $ 1, V1T, LDV1T, DUM, DUM, DUM, - $ DUM, DUM, DUM, DUM, - $ DUM, WORK(1), -1, CHILDINFO ) + $ THETA, DUM1, U2, LDU2, U1, LDU1, DUM2, + $ 1, V1T, LDV1T, DUM1, DUM1, DUM1, + $ DUM1, DUM1, DUM1, DUM1, + $ DUM1, WORK(1), -1, CHILDINFO ) LBBCSD = INT( WORK(1) ) END IF LWORKMIN = MAX( IORBDB+LORBDB-1, @@ -531,7 +531,7 @@ * CALL DBBCSD( JOBU1, JOBU2, JOBV1T, 'N', 'N', M, P, Q, THETA, $ WORK(IPHI), U1, LDU1, U2, LDU2, V1T, LDV1T, - $ DUM, 1, WORK(IB11D), WORK(IB11E), + $ DUM2, 1, WORK(IB11D), WORK(IB11E), $ WORK(IB12D), WORK(IB12E), WORK(IB21D), $ WORK(IB21E), WORK(IB22D), WORK(IB22E), $ WORK(IBBCSD), LBBCSD, CHILDINFO ) @@ -584,7 +584,7 @@ * Simultaneously diagonalize X11 and X21. * CALL DBBCSD( JOBV1T, 'N', JOBU1, JOBU2, 'T', M, Q, P, THETA, - $ WORK(IPHI), V1T, LDV1T, DUM, 1, U1, LDU1, U2, + $ WORK(IPHI), V1T, LDV1T, DUM2, 1, U1, LDU1, U2, $ LDU2, WORK(IB11D), WORK(IB11E), WORK(IB12D), $ WORK(IB12E), WORK(IB21D), WORK(IB21E), $ WORK(IB22D), WORK(IB22E), WORK(IBBCSD), LBBCSD, @@ -639,7 +639,7 @@ * Simultaneously diagonalize X11 and X21. * CALL DBBCSD( 'N', JOBV1T, JOBU2, JOBU1, 'T', M, M-Q, M-P, - $ THETA, WORK(IPHI), DUM, 1, V1T, LDV1T, U2, + $ THETA, WORK(IPHI), DUM2, 1, V1T, LDV1T, U2, $ LDU2, U1, LDU1, WORK(IB11D), WORK(IB11E), $ WORK(IB12D), WORK(IB12E), WORK(IB21D), $ WORK(IB21E), WORK(IB22D), WORK(IB22E), @@ -708,7 +708,7 @@ * Simultaneously diagonalize X11 and X21. * CALL DBBCSD( JOBU2, JOBU1, 'N', JOBV1T, 'N', M, M-P, M-Q, - $ THETA, WORK(IPHI), U2, LDU2, U1, LDU1, DUM, + $ THETA, WORK(IPHI), U2, LDU2, U1, LDU1, DUM2, $ 1, V1T, LDV1T, WORK(IB11D), WORK(IB11E), $ WORK(IB12D), WORK(IB12E), WORK(IB21D), $ WORK(IB21E), WORK(IB22D), WORK(IB22E), diff --git a/SRC/sgeev.f b/SRC/sgeev.f index 1187f5c3..c9377b46 100644 --- a/SRC/sgeev.f +++ b/SRC/sgeev.f @@ -26,7 +26,7 @@ * INTEGER INFO, LDA, LDVL, LDVR, LWORK, N * .. * .. Array Arguments .. -* REAL A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ), +* REAL A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ), * $ WI( * ), WORK( * ), WR( * ) * .. * @@ -183,6 +183,8 @@ * *> \date September 2012 * +* @generated from dgeev.f, fortran d -> s, Tue Apr 19 01:47:44 2016 +* *> \ingroup realGEeigen * * ===================================================================== @@ -200,14 +202,14 @@ INTEGER INFO, LDA, LDVL, LDVR, LWORK, N * .. * .. Array Arguments .. - REAL A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ), + REAL A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ), $ WI( * ), WORK( * ), WR( * ) * .. * * ===================================================================== * * .. Parameters .. - REAL ZERO, ONE + REAL ZERO, ONE PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 ) * .. * .. Local Scalars .. @@ -215,12 +217,12 @@ CHARACTER SIDE INTEGER HSWORK, I, IBAL, IERR, IHI, ILO, ITAU, IWRK, K, $ LWORK_TREVC, MAXWRK, MINWRK, NOUT - REAL ANRM, BIGNUM, CS, CSCALE, EPS, R, SCL, SMLNUM, + REAL ANRM, BIGNUM, CS, CSCALE, EPS, R, SCL, SMLNUM, $ SN * .. * .. Local Arrays .. LOGICAL SELECT( 1 ) - REAL DUM( 1 ) + REAL DUM( 1 ) * .. * .. External Subroutines .. EXTERNAL SGEBAK, SGEBAL, SGEHRD, SHSEQR, SLABAD, SLACPY, @@ -229,9 +231,9 @@ * .. * .. External Functions .. LOGICAL LSAME - INTEGER ILAENV, ISAMAX - REAL SLAMCH, SLANGE, SLAPY2, SNRM2 - EXTERNAL LSAME, ILAENV, ISAMAX, SLAMCH, SLANGE, SLAPY2, + INTEGER ISAMAX, ILAENV + REAL SLAMCH, SLANGE, SLAPY2, SNRM2 + EXTERNAL LSAME, ISAMAX, ILAENV, SLAMCH, SLANGE, SLAPY2, $ SNRM2 * .. * .. Intrinsic Functions .. diff --git a/SRC/sgeevx.f b/SRC/sgeevx.f index eff3a9f4..f1ae89e7 100644 --- a/SRC/sgeevx.f +++ b/SRC/sgeevx.f @@ -25,11 +25,11 @@ * .. Scalar Arguments .. * CHARACTER BALANC, JOBVL, JOBVR, SENSE * INTEGER IHI, ILO, INFO, LDA, LDVL, LDVR, LWORK, N -* REAL ABNRM +* REAL ABNRM * .. * .. Array Arguments .. * INTEGER IWORK( * ) -* REAL A( LDA, * ), RCONDE( * ), RCONDV( * ), +* REAL A( LDA, * ), RCONDE( * ), RCONDV( * ), * $ SCALE( * ), VL( LDVL, * ), VR( LDVR, * ), * $ WI( * ), WORK( * ), WR( * ) * .. @@ -210,7 +210,7 @@ *> \verbatim *> IHI is INTEGER *> ILO and IHI are integer values determined when A was -*> balanced. The balanced A(i,j) = 0 if I > J and +*> balanced. The balanced A(i,j) = 0 if I > J and *> J = 1,...,ILO-1 or I = IHI+1,...,N. *> \endverbatim *> @@ -296,6 +296,8 @@ * *> \date September 2012 * +* @generated from dgeevx.f, fortran d -> s, Tue Apr 19 01:47:44 2016 +* *> \ingroup realGEeigen * * ===================================================================== @@ -312,11 +314,11 @@ * .. Scalar Arguments .. CHARACTER BALANC, JOBVL, JOBVR, SENSE INTEGER IHI, ILO, INFO, LDA, LDVL, LDVR, LWORK, N - REAL ABNRM + REAL ABNRM * .. * .. Array Arguments .. INTEGER IWORK( * ) - REAL A( LDA, * ), RCONDE( * ), RCONDV( * ), + REAL A( LDA, * ), RCONDE( * ), RCONDV( * ), $ SCALE( * ), VL( LDVL, * ), VR( LDVR, * ), $ WI( * ), WORK( * ), WR( * ) * .. @@ -324,21 +326,21 @@ * ===================================================================== * * .. Parameters .. - REAL ZERO, ONE + REAL ZERO, ONE PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 ) * .. * .. Local Scalars .. LOGICAL LQUERY, SCALEA, WANTVL, WANTVR, WNTSNB, WNTSNE, $ WNTSNN, WNTSNV CHARACTER JOB, SIDE - INTEGER HSWORK, I, ICOND, IERR, ITAU, IWRK, K, + INTEGER HSWORK, I, ICOND, IERR, ITAU, IWRK, K, $ LWORK_TREVC, MAXWRK, MINWRK, NOUT - REAL ANRM, BIGNUM, CS, CSCALE, EPS, R, SCL, SMLNUM, + REAL ANRM, BIGNUM, CS, CSCALE, EPS, R, SCL, SMLNUM, $ SN * .. * .. Local Arrays .. LOGICAL SELECT( 1 ) - REAL DUM( 1 ) + REAL DUM( 1 ) * .. * .. External Subroutines .. EXTERNAL SGEBAK, SGEBAL, SGEHRD, SHSEQR, SLABAD, SLACPY, @@ -347,9 +349,9 @@ * .. * .. External Functions .. LOGICAL LSAME - INTEGER ILAENV, ISAMAX - REAL SLAMCH, SLANGE, SLAPY2, SNRM2 - EXTERNAL LSAME, ILAENV, ISAMAX, SLAMCH, SLANGE, SLAPY2, + INTEGER ISAMAX, ILAENV + REAL SLAMCH, SLANGE, SLAPY2, SNRM2 + EXTERNAL LSAME, ISAMAX, ILAENV, SLAMCH, SLANGE, SLAPY2, $ SNRM2 * .. * .. Intrinsic Functions .. diff --git a/SRC/sorcsd2by1.f b/SRC/sorcsd2by1.f index 71b547d7..72d0dbfe 100644 --- a/SRC/sorcsd2by1.f +++ b/SRC/sorcsd2by1.f @@ -265,7 +265,7 @@ LOGICAL LQUERY, WANTU1, WANTU2, WANTV1T * .. * .. Local Arrays .. - REAL DUM( 1 ) + REAL DUM1(1), DUM2(1,1) * .. * .. External Subroutines .. EXTERNAL SBBCSD, SCOPY, SLACPY, SLAPMR, SLAPMT, SORBDB1, @@ -351,118 +351,118 @@ LORGLQOPT = 1 IF( R .EQ. Q ) THEN CALL SORBDB1( M, P, Q, X11, LDX11, X21, LDX21, THETA, - $ DUM, DUM, DUM, DUM, WORK, -1, + $ DUM1, DUM1, DUM1, DUM1, WORK, -1, $ CHILDINFO ) LORBDB = INT( WORK(1) ) IF( WANTU1 .AND. P .GT. 0 ) THEN - CALL SORGQR( P, P, Q, U1, LDU1, DUM, WORK(1), -1, + CALL SORGQR( P, P, Q, U1, LDU1, DUM1, WORK(1), -1, $ CHILDINFO ) LORGQRMIN = MAX( LORGQRMIN, P ) LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) ENDIF IF( WANTU2 .AND. M-P .GT. 0 ) THEN - CALL SORGQR( M-P, M-P, Q, U2, LDU2, DUM, WORK(1), -1, + CALL SORGQR( M-P, M-P, Q, U2, LDU2, DUM1, WORK(1), -1, $ CHILDINFO ) LORGQRMIN = MAX( LORGQRMIN, M-P ) LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) END IF IF( WANTV1T .AND. Q .GT. 0 ) THEN CALL SORGLQ( Q-1, Q-1, Q-1, V1T, LDV1T, - $ DUM, WORK(1), -1, CHILDINFO ) + $ DUM1, WORK(1), -1, CHILDINFO ) LORGLQMIN = MAX( LORGLQMIN, Q-1 ) LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF CALL SBBCSD( JOBU1, JOBU2, JOBV1T, 'N', 'N', M, P, Q, THETA, - $ DUM, U1, LDU1, U2, LDU2, V1T, LDV1T, DUM, - $ 1, DUM, DUM, DUM, DUM, DUM, - $ DUM, DUM, DUM, WORK(1), -1, CHILDINFO + $ DUM1, U1, LDU1, U2, LDU2, V1T, LDV1T, DUM2, + $ 1, DUM1, DUM1, DUM1, DUM1, DUM1, + $ DUM1, DUM1, DUM1, WORK(1), -1, CHILDINFO $ ) LBBCSD = INT( WORK(1) ) ELSE IF( R .EQ. P ) THEN CALL SORBDB2( M, P, Q, X11, LDX11, X21, LDX21, THETA, - $ DUM, DUM, DUM, DUM, WORK(1), -1, + $ DUM1, DUM1, DUM1, DUM1, WORK(1), -1, $ CHILDINFO ) LORBDB = INT( WORK(1) ) IF( WANTU1 .AND. P .GT. 0 ) THEN - CALL SORGQR( P-1, P-1, P-1, U1(2,2), LDU1, DUM, + CALL SORGQR( P-1, P-1, P-1, U1(2,2), LDU1, DUM1, $ WORK(1), -1, CHILDINFO ) LORGQRMIN = MAX( LORGQRMIN, P-1 ) LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) END IF IF( WANTU2 .AND. M-P .GT. 0 ) THEN - CALL SORGQR( M-P, M-P, Q, U2, LDU2, DUM, WORK(1), -1, + CALL SORGQR( M-P, M-P, Q, U2, LDU2, DUM1, WORK(1), -1, $ CHILDINFO ) LORGQRMIN = MAX( LORGQRMIN, M-P ) LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) END IF IF( WANTV1T .AND. Q .GT. 0 ) THEN - CALL SORGLQ( Q, Q, R, V1T, LDV1T, DUM, WORK(1), -1, + CALL SORGLQ( Q, Q, R, V1T, LDV1T, DUM1, WORK(1), -1, $ CHILDINFO ) LORGLQMIN = MAX( LORGLQMIN, Q ) LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF CALL SBBCSD( JOBV1T, 'N', JOBU1, JOBU2, 'T', M, Q, P, THETA, - $ DUM, V1T, LDV1T, DUM, 1, U1, LDU1, U2, - $ LDU2, DUM, DUM, DUM, DUM, DUM, - $ DUM, DUM, DUM, WORK(1), -1, CHILDINFO + $ DUM1, V1T, LDV1T, DUM2, 1, U1, LDU1, U2, + $ LDU2, DUM1, DUM1, DUM1, DUM1, DUM1, + $ DUM1, DUM1, DUM1, WORK(1), -1, CHILDINFO $ ) LBBCSD = INT( WORK(1) ) ELSE IF( R .EQ. M-P ) THEN CALL SORBDB3( M, P, Q, X11, LDX11, X21, LDX21, THETA, - $ DUM, DUM, DUM, DUM, WORK(1), -1, + $ DUM1, DUM1, DUM1, DUM1, WORK(1), -1, $ CHILDINFO ) LORBDB = INT( WORK(1) ) IF( WANTU1 .AND. P .GT. 0 ) THEN - CALL SORGQR( P, P, Q, U1, LDU1, DUM, WORK(1), -1, + CALL SORGQR( P, P, Q, U1, LDU1, DUM1, WORK(1), -1, $ CHILDINFO ) LORGQRMIN = MAX( LORGQRMIN, P ) LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) END IF IF( WANTU2 .AND. M-P .GT. 0 ) THEN - CALL SORGQR( M-P-1, M-P-1, M-P-1, U2(2,2), LDU2, DUM, + CALL SORGQR( M-P-1, M-P-1, M-P-1, U2(2,2), LDU2, DUM1, $ WORK(1), -1, CHILDINFO ) LORGQRMIN = MAX( LORGQRMIN, M-P-1 ) LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) END IF IF( WANTV1T .AND. Q .GT. 0 ) THEN - CALL SORGLQ( Q, Q, R, V1T, LDV1T, DUM, WORK(1), -1, + CALL SORGLQ( Q, Q, R, V1T, LDV1T, DUM1, WORK(1), -1, $ CHILDINFO ) LORGLQMIN = MAX( LORGLQMIN, Q ) LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF CALL SBBCSD( 'N', JOBV1T, JOBU2, JOBU1, 'T', M, M-Q, M-P, - $ THETA, DUM, DUM, 1, V1T, LDV1T, U2, LDU2, - $ U1, LDU1, DUM, DUM, DUM, DUM, - $ DUM, DUM, DUM, DUM, WORK(1), -1, + $ THETA, DUM1, DUM2, 1, V1T, LDV1T, U2, LDU2, + $ U1, LDU1, DUM1, DUM1, DUM1, DUM1, + $ DUM1, DUM1, DUM1, DUM1, WORK(1), -1, $ CHILDINFO ) LBBCSD = INT( WORK(1) ) ELSE CALL SORBDB4( M, P, Q, X11, LDX11, X21, LDX21, THETA, - $ DUM, DUM, DUM, DUM, DUM, + $ DUM1, DUM1, DUM1, DUM1, DUM1, $ WORK(1), -1, CHILDINFO ) LORBDB = M + INT( WORK(1) ) IF( WANTU1 .AND. P .GT. 0 ) THEN - CALL SORGQR( P, P, M-Q, U1, LDU1, DUM, WORK(1), -1, + CALL SORGQR( P, P, M-Q, U1, LDU1, DUM1, WORK(1), -1, $ CHILDINFO ) LORGQRMIN = MAX( LORGQRMIN, P ) LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) END IF IF( WANTU2 .AND. M-P .GT. 0 ) THEN - CALL SORGQR( M-P, M-P, M-Q, U2, LDU2, DUM, WORK(1), + CALL SORGQR( M-P, M-P, M-Q, U2, LDU2, DUM1, WORK(1), $ -1, CHILDINFO ) LORGQRMIN = MAX( LORGQRMIN, M-P ) LORGQROPT = MAX( LORGQROPT, INT( WORK(1) ) ) END IF IF( WANTV1T .AND. Q .GT. 0 ) THEN - CALL SORGLQ( Q, Q, Q, V1T, LDV1T, DUM, WORK(1), -1, + CALL SORGLQ( Q, Q, Q, V1T, LDV1T, DUM1, WORK(1), -1, $ CHILDINFO ) LORGLQMIN = MAX( LORGLQMIN, Q ) LORGLQOPT = MAX( LORGLQOPT, INT( WORK(1) ) ) END IF CALL SBBCSD( JOBU2, JOBU1, 'N', JOBV1T, 'N', M, M-P, M-Q, - $ THETA, DUM, U2, LDU2, U1, LDU1, DUM, 1, - $ V1T, LDV1T, DUM, DUM, DUM, DUM, - $ DUM, DUM, DUM, DUM, WORK(1), -1, + $ THETA, DUM1, U2, LDU2, U1, LDU1, DUM2, 1, + $ V1T, LDV1T, DUM1, DUM1, DUM1, DUM1, + $ DUM1, DUM1, DUM1, DUM1, WORK(1), -1, $ CHILDINFO ) LBBCSD = INT( WORK(1) ) END IF @@ -529,7 +529,7 @@ * CALL SBBCSD( JOBU1, JOBU2, JOBV1T, 'N', 'N', M, P, Q, THETA, $ WORK(IPHI), U1, LDU1, U2, LDU2, V1T, LDV1T, - $ DUM, 1, WORK(IB11D), WORK(IB11E), WORK(IB12D), + $ DUM2, 1, WORK(IB11D), WORK(IB11E), WORK(IB12D), $ WORK(IB12E), WORK(IB21D), WORK(IB21E), $ WORK(IB22D), WORK(IB22E), WORK(IBBCSD), LBBCSD, $ CHILDINFO ) @@ -582,7 +582,7 @@ * Simultaneously diagonalize X11 and X21. * CALL SBBCSD( JOBV1T, 'N', JOBU1, JOBU2, 'T', M, Q, P, THETA, - $ WORK(IPHI), V1T, LDV1T, DUM, 1, U1, LDU1, U2, + $ WORK(IPHI), V1T, LDV1T, DUM1, 1, U1, LDU1, U2, $ LDU2, WORK(IB11D), WORK(IB11E), WORK(IB12D), $ WORK(IB12E), WORK(IB21D), WORK(IB21E), $ WORK(IB22D), WORK(IB22E), WORK(IBBCSD), LBBCSD, @@ -637,7 +637,7 @@ * Simultaneously diagonalize X11 and X21. * CALL SBBCSD( 'N', JOBV1T, JOBU2, JOBU1, 'T', M, M-Q, M-P, - $ THETA, WORK(IPHI), DUM, 1, V1T, LDV1T, U2, + $ THETA, WORK(IPHI), DUM1, 1, V1T, LDV1T, U2, $ LDU2, U1, LDU1, WORK(IB11D), WORK(IB11E), $ WORK(IB12D), WORK(IB12E), WORK(IB21D), $ WORK(IB21E), WORK(IB22D), WORK(IB22E), @@ -706,7 +706,7 @@ * Simultaneously diagonalize X11 and X21. * CALL SBBCSD( JOBU2, JOBU1, 'N', JOBV1T, 'N', M, M-P, M-Q, - $ THETA, WORK(IPHI), U2, LDU2, U1, LDU1, DUM, 1, + $ THETA, WORK(IPHI), U2, LDU2, U1, LDU1, DUM1, 1, $ V1T, LDV1T, WORK(IB11D), WORK(IB11E), WORK(IB12D), $ WORK(IB12E), WORK(IB21D), WORK(IB21E), $ WORK(IB22D), WORK(IB22E), WORK(IBBCSD), LBBCSD, diff --git a/SRC/zgeev.f b/SRC/zgeev.f index caed1818..7baa6889 100644 --- a/SRC/zgeev.f +++ b/SRC/zgeev.f @@ -171,6 +171,8 @@ * *> \date November 2011 * +* @precisions fortran z -> c +* *> \ingroup complex16GEeigen * * ===================================================================== @@ -222,7 +224,7 @@ EXTERNAL LSAME, IDAMAX, ILAENV, DLAMCH, DZNRM2, ZLANGE * .. * .. Intrinsic Functions .. - INTRINSIC DBLE, DCMPLX, DCONJG, DIMAG, MAX, SQRT + INTRINSIC DBLE, DCMPLX, CONJG, AIMAG, MAX, SQRT * .. * .. Executable Statements .. * @@ -448,10 +450,10 @@ CALL ZDSCAL( N, SCL, VL( 1, I ), 1 ) DO 10 K = 1, N RWORK( IRWORK+K-1 ) = DBLE( VL( K, I ) )**2 + - $ DIMAG( VL( K, I ) )**2 + $ AIMAG( VL( K, I ) )**2 10 CONTINUE K = IDAMAX( N, RWORK( IRWORK ), 1 ) - TMP = DCONJG( VL( K, I ) ) / SQRT( RWORK( IRWORK+K-1 ) ) + TMP = CONJG( VL( K, I ) ) / SQRT( RWORK( IRWORK+K-1 ) ) CALL ZSCAL( N, TMP, VL( 1, I ), 1 ) VL( K, I ) = DCMPLX( DBLE( VL( K, I ) ), ZERO ) 20 CONTINUE @@ -473,10 +475,10 @@ CALL ZDSCAL( N, SCL, VR( 1, I ), 1 ) DO 30 K = 1, N RWORK( IRWORK+K-1 ) = DBLE( VR( K, I ) )**2 + - $ DIMAG( VR( K, I ) )**2 + $ AIMAG( VR( K, I ) )**2 30 CONTINUE K = IDAMAX( N, RWORK( IRWORK ), 1 ) - TMP = DCONJG( VR( K, I ) ) / SQRT( RWORK( IRWORK+K-1 ) ) + TMP = CONJG( VR( K, I ) ) / SQRT( RWORK( IRWORK+K-1 ) ) CALL ZSCAL( N, TMP, VR( 1, I ), 1 ) VR( K, I ) = DCMPLX( DBLE( VR( K, I ) ), ZERO ) 40 CONTINUE diff --git a/SRC/zgeevx.f b/SRC/zgeevx.f index cb750650..a0baa344 100644 --- a/SRC/zgeevx.f +++ b/SRC/zgeevx.f @@ -278,6 +278,8 @@ * *> \date November 2011 * +* @precisions fortran z -> c +* *> \ingroup complex16GEeigen * * ===================================================================== @@ -313,7 +315,7 @@ LOGICAL LQUERY, SCALEA, WANTVL, WANTVR, WNTSNB, WNTSNE, $ WNTSNN, WNTSNV CHARACTER JOB, SIDE - INTEGER HSWORK, I, ICOND, IERR, ITAU, IWRK, K, + INTEGER HSWORK, I, ICOND, IERR, ITAU, IWRK, K, $ LWORK_TREVC, MAXWRK, MINWRK, NOUT DOUBLE PRECISION ANRM, BIGNUM, CSCALE, EPS, SCL, SMLNUM COMPLEX*16 TMP @@ -334,7 +336,7 @@ EXTERNAL LSAME, IDAMAX, ILAENV, DLAMCH, DZNRM2, ZLANGE * .. * .. Intrinsic Functions .. - INTRINSIC DBLE, DCMPLX, DCONJG, DIMAG, MAX, SQRT + INTRINSIC DBLE, DCMPLX, CONJG, AIMAG, MAX, SQRT * .. * .. Executable Statements .. * @@ -610,10 +612,10 @@ CALL ZDSCAL( N, SCL, VL( 1, I ), 1 ) DO 10 K = 1, N RWORK( K ) = DBLE( VL( K, I ) )**2 + - $ DIMAG( VL( K, I ) )**2 + $ AIMAG( VL( K, I ) )**2 10 CONTINUE K = IDAMAX( N, RWORK, 1 ) - TMP = DCONJG( VL( K, I ) ) / SQRT( RWORK( K ) ) + TMP = CONJG( VL( K, I ) ) / SQRT( RWORK( K ) ) CALL ZSCAL( N, TMP, VL( 1, I ), 1 ) VL( K, I ) = DCMPLX( DBLE( VL( K, I ) ), ZERO ) 20 CONTINUE @@ -633,10 +635,10 @@ CALL ZDSCAL( N, SCL, VR( 1, I ), 1 ) DO 30 K = 1, N RWORK( K ) = DBLE( VR( K, I ) )**2 + - $ DIMAG( VR( K, I ) )**2 + $ AIMAG( VR( K, I ) )**2 30 CONTINUE K = IDAMAX( N, RWORK, 1 ) - TMP = DCONJG( VR( K, I ) ) / SQRT( RWORK( K ) ) + TMP = CONJG( VR( K, I ) ) / SQRT( RWORK( K ) ) CALL ZSCAL( N, TMP, VR( 1, I ), 1 ) VR( K, I ) = DCMPLX( DBLE( VR( K, I ) ), ZERO ) 40 CONTINUE diff --git a/SRC/zuncsd2by1.f b/SRC/zuncsd2by1.f index 8c0a2c07..b0d3615b 100644 --- a/SRC/zuncsd2by1.f +++ b/SRC/zuncsd2by1.f @@ -289,7 +289,7 @@ * .. * .. Local Arrays .. DOUBLE PRECISION DUM( 1 ) - COMPLEX*16 CDUM( 1 ) + COMPLEX*16 CDUM( 1, 1 ) * .. * .. External Subroutines .. EXTERNAL ZBBCSD, ZCOPY, ZLACPY, ZLAPMR, ZLAPMT, ZUNBDB1, diff --git a/TESTING/EIG/cchkee.f b/TESTING/EIG/cchkee.f index 91214b0c..74329653 100644 --- a/TESTING/EIG/cchkee.f +++ b/TESTING/EIG/cchkee.f @@ -2098,6 +2098,7 @@ MAXTYP = 26 NTYPES = MIN( MAXTYP, NTYPES ) CALL ALAREQ( C3, NTYPES, DOTYPE, MAXTYP, NIN, NOUT ) + CALL XLAENV(1,1) IF( TSTCHK .AND. TSTERR ) $ CALL CERRGG( C3, NOUT ) DO 350 I = 1, NPARMS @@ -2157,6 +2158,7 @@ * * Blocked version * + CALL XLAENV(16,2) CALL CDRGES3( NN, NVAL, MAXTYP, DOTYPE, ISEED, THRESH, NOUT, $ A( 1, 1 ), NMAX, A( 1, 2 ), A( 1, 3 ), $ A( 1, 4 ), A( 1, 7 ), NMAX, A( 1, 8 ), @@ -2223,6 +2225,7 @@ * * Blocked version * + CALL XLAENV(16,2) CALL CDRGEV3( NN, NVAL, MAXTYP, DOTYPE, ISEED, THRESH, NOUT, $ A( 1, 1 ), NMAX, A( 1, 2 ), A( 1, 3 ), $ A( 1, 4 ), A( 1, 7 ), NMAX, A( 1, 8 ), @@ -2348,6 +2351,7 @@ * GSV: Generalized Singular Value Decomposition * ---------------------------------------------- * + CALL XLAENV(1,1) IF( TSTERR ) $ CALL CERRGG( 'GSV', NOUT ) CALL CCKGSV( NN, MVAL, PVAL, NVAL, NTYPES, ISEED, THRESH, NMAX, diff --git a/TESTING/EIG/cerrgg.f b/TESTING/EIG/cerrgg.f index a60c4eb2..0901af94 100644 --- a/TESTING/EIG/cerrgg.f +++ b/TESTING/EIG/cerrgg.f @@ -83,7 +83,7 @@ * .. * .. Local Arrays .. LOGICAL BW( NMAX ), SEL( NMAX ) - INTEGER IW( LW ) + INTEGER IW( LW ), IDUM(NMAX) REAL LS( NMAX ), R1( NMAX ), R2( NMAX ), $ RCE( NMAX ), RCV( NMAX ), RS( NMAX ), RW( LW ) COMPLEX A( NMAX, NMAX ), ALPHA( NMAX ), @@ -306,57 +306,57 @@ SRNAMT = 'CGGSVD3' INFOT = 1 CALL CGGSVD3( '/', 'N', 'N', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, LWORK, + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, RW, IDUM, $ INFO ) CALL CHKXER( 'CGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 2 CALL CGGSVD3( 'N', '/', 'N', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, LWORK, + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, RW, IDUM, $ INFO ) CALL CHKXER( 'CGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 3 CALL CGGSVD3( 'N', 'N', '/', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, LWORK, + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, RW, IDUM, $ INFO ) CALL CHKXER( 'CGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 4 CALL CGGSVD3( 'N', 'N', 'N', -1, 0, 0, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, LWORK, + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, RW, IDUM, $ INFO ) CALL CHKXER( 'CGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 5 CALL CGGSVD3( 'N', 'N', 'N', 0, -1, 0, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, LWORK, + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, RW, IDUM, $ INFO ) CALL CHKXER( 'CGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 6 CALL CGGSVD3( 'N', 'N', 'N', 0, 0, -1, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, LWORK, + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, RW, IDUM, $ INFO ) CALL CHKXER( 'CGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 10 CALL CGGSVD3( 'N', 'N', 'N', 2, 1, 1, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, LWORK, + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, RW, IDUM, $ INFO ) CALL CHKXER( 'CGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 12 CALL CGGSVD3( 'N', 'N', 'N', 1, 1, 2, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, LWORK, + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, RW, IDUM, $ INFO ) CALL CHKXER( 'CGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 16 CALL CGGSVD3( 'U', 'N', 'N', 2, 2, 2, DUMMYK, DUMMYL, A, 2, B, - $ 2, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, LWORK, + $ 2, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, RW, IDUM, $ INFO ) CALL CHKXER( 'CGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 18 CALL CGGSVD3( 'N', 'V', 'N', 2, 2, 2, DUMMYK, DUMMYL, A, 2, B, - $ 2, R1, R2, U, 2, V, 1, Q, 1, W, RW, IW, LWORK, + $ 2, R1, R2, U, 2, V, 1, Q, 1, W, LWORK, RW, IDUM, $ INFO ) CALL CHKXER( 'CGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 20 CALL CGGSVD3( 'N', 'N', 'Q', 2, 2, 2, DUMMYK, DUMMYL, A, 2, B, - $ 2, R1, R2, U, 2, V, 2, Q, 1, W, RW, IW, LWORK, + $ 2, R1, R2, U, 2, V, 2, Q, 1, W, LWORK, RW, IDUM, $ INFO ) CALL CHKXER( 'CGGSVD3', INFOT, NOUT, LERR, OK ) NT = NT + 11 @@ -573,56 +573,56 @@ INFOT = 7 CALL CUNCSD( 'Y', 'Y', 'Y', 'Y', 'N', 'N', $ -1, 0, 0, A, 1, A, - $ 1, A, 1, A, 1, A, + $ 1, A, 1, A, 1, RS, $ A, 1, A, 1, A, 1, A, $ 1, W, LW, RW, LW, IW, INFO ) CALL CHKXER( 'CUNCSD', INFOT, NOUT, LERR, OK ) INFOT = 8 CALL CUNCSD( 'Y', 'Y', 'Y', 'Y', 'N', 'N', $ 1, -1, 0, A, 1, A, - $ 1, A, 1, A, 1, A, + $ 1, A, 1, A, 1, RS, $ A, 1, A, 1, A, 1, A, $ 1, W, LW, RW, LW, IW, INFO ) CALL CHKXER( 'CUNCSD', INFOT, NOUT, LERR, OK ) INFOT = 9 CALL CUNCSD( 'Y', 'Y', 'Y', 'Y', 'N', 'N', $ 1, 1, -1, A, 1, A, - $ 1, A, 1, A, 1, A, + $ 1, A, 1, A, 1, RS, $ A, 1, A, 1, A, 1, A, $ 1, W, LW, RW, LW, IW, INFO ) CALL CHKXER( 'CUNCSD', INFOT, NOUT, LERR, OK ) INFOT = 11 CALL CUNCSD( 'Y', 'Y', 'Y', 'Y', 'N', 'N', $ 1, 1, 1, A, -1, A, - $ 1, A, 1, A, 1, A, + $ 1, A, 1, A, 1, RS, $ A, 1, A, 1, A, 1, A, $ 1, W, LW, RW, LW, IW, INFO ) CALL CHKXER( 'CUNCSD', INFOT, NOUT, LERR, OK ) INFOT = 20 CALL CUNCSD( 'Y', 'Y', 'Y', 'Y', 'N', 'N', $ 1, 1, 1, A, 1, A, - $ 1, A, 1, A, 1, A, + $ 1, A, 1, A, 1, RS, $ A, -1, A, 1, A, 1, A, $ 1, W, LW, RW, LW, IW, INFO ) CALL CHKXER( 'CUNCSD', INFOT, NOUT, LERR, OK ) INFOT = 22 CALL CUNCSD( 'Y', 'Y', 'Y', 'Y', 'N', 'N', $ 1, 1, 1, A, 1, A, - $ 1, A, 1, A, 1, A, + $ 1, A, 1, A, 1, RS, $ A, 1, A, -1, A, 1, A, $ 1, W, LW, RW, LW, IW, INFO ) CALL CHKXER( 'CUNCSD', INFOT, NOUT, LERR, OK ) INFOT = 24 CALL CUNCSD( 'Y', 'Y', 'Y', 'Y', 'N', 'N', $ 1, 1, 1, A, 1, A, - $ 1, A, 1, A, 1, A, + $ 1, A, 1, A, 1, RS, $ A, 1, A, 1, A, -1, A, $ 1, W, LW, RW, LW, IW, INFO ) CALL CHKXER( 'CUNCSD', INFOT, NOUT, LERR, OK ) INFOT = 26 CALL CUNCSD( 'Y', 'Y', 'Y', 'Y', 'N', 'N', $ 1, 1, 1, A, 1, A, - $ 1, A, 1, A, 1, A, + $ 1, A, 1, A, 1, RS, $ A, 1, A, 1, A, 1, A, $ -1, W, LW, RW, LW, IW, INFO ) CALL CHKXER( 'CUNCSD', INFOT, NOUT, LERR, OK ) diff --git a/TESTING/EIG/dchkee.f b/TESTING/EIG/dchkee.f index 14272bc4..c344bfea 100644 --- a/TESTING/EIG/dchkee.f +++ b/TESTING/EIG/dchkee.f @@ -2105,6 +2105,7 @@ MAXTYP = 26 NTYPES = MIN( MAXTYP, NTYPES ) CALL ALAREQ( C3, NTYPES, DOTYPE, MAXTYP, NIN, NOUT ) + CALL XLAENV(1,1) IF( TSTCHK .AND. TSTERR ) $ CALL DERRGG( C3, NOUT ) DO 350 I = 1, NPARMS @@ -2164,6 +2165,7 @@ * * Blocked version * + CALL XLAENV(16, 2) CALL DDRGES3( NN, NVAL, MAXTYP, DOTYPE, ISEED, THRESH, NOUT, $ A( 1, 1 ), NMAX, A( 1, 2 ), A( 1, 3 ), $ A( 1, 4 ), A( 1, 7 ), NMAX, A( 1, 8 ), @@ -2351,6 +2353,7 @@ * GSV: Generalized Singular Value Decomposition * ---------------------------------------------- * + CALL XLAENV(1,1) IF( TSTERR ) $ CALL DERRGG( 'GSV', NOUT ) CALL DCKGSV( NN, MVAL, PVAL, NVAL, NTYPES, ISEED, THRESH, NMAX, diff --git a/TESTING/EIG/ddrvbd.f b/TESTING/EIG/ddrvbd.f index 6d671f3b..dc552a98 100644 --- a/TESTING/EIG/ddrvbd.f +++ b/TESTING/EIG/ddrvbd.f @@ -1141,7 +1141,7 @@ $ / '21 = | S - Spartial | / ( min(M,N) ulp |S| )', $ / '22 = 0 if S contains min(M,N) nonnegative values in', $ ' decreasing order, else 1/ulp', - $ / '23 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ),' + $ / '23 = | A - U diag(S) VT | / ( |A| max(M,N) ulp ),', $ ' DGESVDX(V,V,A) ', $ / '24 = | I - U**T U | / ( M ulp ) ', $ / '25 = | I - VT VT**T | / ( N ulp ) ', diff --git a/TESTING/EIG/derrgg.f b/TESTING/EIG/derrgg.f index 917cf048..10a5fe78 100644 --- a/TESTING/EIG/derrgg.f +++ b/TESTING/EIG/derrgg.f @@ -83,7 +83,7 @@ * .. * .. Local Arrays .. LOGICAL BW( NMAX ), SEL( NMAX ) - INTEGER IW( NMAX ) + INTEGER IW( NMAX ), IDUM(NMAX) DOUBLE PRECISION A( NMAX, NMAX ), B( NMAX, NMAX ), LS( NMAX ), $ Q( NMAX, NMAX ), R1( NMAX ), R2( NMAX ), $ R3( NMAX ), RCE( 2 ), RCV( 2 ), RS( NMAX ), @@ -305,47 +305,47 @@ SRNAMT = 'DGGSVD3' INFOT = 1 CALL DGGSVD3( '/', 'N', 'N', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, IW, LWORK, INFO ) + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, IDUM, INFO ) CALL CHKXER( 'DGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 2 CALL DGGSVD3( 'N', '/', 'N', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, IW, LWORK, INFO ) + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, IDUM, INFO ) CALL CHKXER( 'DGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 3 CALL DGGSVD3( 'N', 'N', '/', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, IW, LWORK, INFO ) + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, IDUM, INFO ) CALL CHKXER( 'DGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 4 CALL DGGSVD3( 'N', 'N', 'N', -1, 0, 0, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, IW, LWORK, INFO ) + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, IDUM, INFO ) CALL CHKXER( 'DGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 5 CALL DGGSVD3( 'N', 'N', 'N', 0, -1, 0, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, IW, LWORK, INFO ) + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, IDUM, INFO ) CALL CHKXER( 'DGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 6 CALL DGGSVD3( 'N', 'N', 'N', 0, 0, -1, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, IW, LWORK, INFO ) + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, IDUM, INFO ) CALL CHKXER( 'DGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 10 CALL DGGSVD3( 'N', 'N', 'N', 2, 1, 1, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, IW, LWORK, INFO ) + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, IDUM, INFO ) CALL CHKXER( 'DGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 12 CALL DGGSVD3( 'N', 'N', 'N', 1, 1, 2, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, IW, LWORK, INFO ) + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, IDUM, INFO ) CALL CHKXER( 'DGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 16 CALL DGGSVD3( 'U', 'N', 'N', 2, 2, 2, DUMMYK, DUMMYL, A, 2, B, - $ 2, R1, R2, U, 1, V, 1, Q, 1, W, IW, LWORK, INFO ) + $ 2, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, IDUM, INFO ) CALL CHKXER( 'DGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 18 CALL DGGSVD3( 'N', 'V', 'N', 1, 1, 2, DUMMYK, DUMMYL, A, 1, B, - $ 2, R1, R2, U, 1, V, 1, Q, 1, W, IW, LWORK, INFO ) + $ 2, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, IDUM, INFO ) CALL CHKXER( 'DGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 20 CALL DGGSVD3( 'N', 'N', 'Q', 1, 2, 1, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, IW, LWORK, INFO ) + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, IDUM, INFO ) CALL CHKXER( 'DGGSVD3', INFOT, NOUT, LERR, OK ) NT = NT + 11 * diff --git a/TESTING/EIG/schkee.f b/TESTING/EIG/schkee.f index 0bd994cc..b235c320 100644 --- a/TESTING/EIG/schkee.f +++ b/TESTING/EIG/schkee.f @@ -2105,8 +2105,9 @@ MAXTYP = 26 NTYPES = MIN( MAXTYP, NTYPES ) CALL ALAREQ( C3, NTYPES, DOTYPE, MAXTYP, NIN, NOUT ) + CALL XLAENV(1,1) IF( TSTCHK .AND. TSTERR ) - $ CALL SERRGG( C3, NOUT ) + & CALL SERRGG( C3, NOUT ) DO 350 I = 1, NPARMS CALL XLAENV( 1, NBVAL( I ) ) CALL XLAENV( 2, NBMIN( I ) ) @@ -2165,6 +2166,7 @@ * * Blocked version * + CALL XLAENV(16,1) CALL SDRGES3( NN, NVAL, MAXTYP, DOTYPE, ISEED, THRESH, NOUT, $ A( 1, 1 ), NMAX, A( 1, 2 ), A( 1, 3 ), $ A( 1, 4 ), A( 1, 7 ), NMAX, A( 1, 8 ), @@ -2353,6 +2355,7 @@ * GSV: Generalized Singular Value Decomposition * ---------------------------------------------- * + CALL XLAENV( 1, 1 ) IF( TSTERR ) $ CALL SERRGG( 'GSV', NOUT ) CALL SCKGSV( NN, MVAL, PVAL, NVAL, NTYPES, ISEED, THRESH, NMAX, diff --git a/TESTING/EIG/serrgg.f b/TESTING/EIG/serrgg.f index aede817b..5b9a8956 100644 --- a/TESTING/EIG/serrgg.f +++ b/TESTING/EIG/serrgg.f @@ -78,12 +78,12 @@ * .. Local Scalars .. CHARACTER*2 C2 INTEGER DUMMYK, DUMMYL, I, IFST, ILO, IHI, ILST, INFO, - $ J, M, NCYCLE, NT, SDIM, LWORK + $ J, M, NCYCLE, NT, SDIM, LWORK, JDUM REAL ANRM, BNRM, DIF, SCALE, TOLA, TOLB * .. * .. Local Arrays .. LOGICAL BW( NMAX ), SEL( NMAX ) - INTEGER IW( NMAX ) + INTEGER IW( NMAX ), IDUM(NMAX) REAL A( NMAX, NMAX ), B( NMAX, NMAX ), LS( NMAX ), $ Q( NMAX, NMAX ), R1( NMAX ), R2( NMAX ), $ R3( NMAX ), RCE( 2 ), RCV( 2 ), RS( NMAX ), @@ -305,47 +305,47 @@ SRNAMT = 'SGGSVD3' INFOT = 1 CALL SGGSVD3( '/', 'N', 'N', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, IW, LWORK, INFO ) + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, IDUM, INFO ) CALL CHKXER( 'SGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 2 CALL SGGSVD3( 'N', '/', 'N', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, IW, LWORK, INFO ) + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, IDUM, INFO ) CALL CHKXER( 'SGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 3 CALL SGGSVD3( 'N', 'N', '/', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, IW, LWORK, INFO ) + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, IDUM, INFO ) CALL CHKXER( 'SGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 4 CALL SGGSVD3( 'N', 'N', 'N', -1, 0, 0, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, IW, LWORK, INFO ) + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, IDUM, INFO ) CALL CHKXER( 'SGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 5 CALL SGGSVD3( 'N', 'N', 'N', 0, -1, 0, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, IW, LWORK, INFO ) + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, IDUM, INFO ) CALL CHKXER( 'SGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 6 CALL SGGSVD3( 'N', 'N', 'N', 0, 0, -1, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, IW, LWORK, INFO ) + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, IDUM, INFO ) CALL CHKXER( 'SGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 10 CALL SGGSVD3( 'N', 'N', 'N', 2, 1, 1, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, IW, LWORK, INFO ) + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, IDUM, INFO ) CALL CHKXER( 'SGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 12 CALL SGGSVD3( 'N', 'N', 'N', 1, 1, 2, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, IW, LWORK, INFO ) + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, IDUM, INFO ) CALL CHKXER( 'SGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 16 CALL SGGSVD3( 'U', 'N', 'N', 2, 2, 2, DUMMYK, DUMMYL, A, 2, B, - $ 2, R1, R2, U, 1, V, 1, Q, 1, W, IW, LWORK, INFO ) + $ 2, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, IDUM, INFO ) CALL CHKXER( 'SGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 18 CALL SGGSVD3( 'N', 'V', 'N', 1, 1, 2, DUMMYK, DUMMYL, A, 1, B, - $ 2, R1, R2, U, 1, V, 1, Q, 1, W, IW, LWORK, INFO ) + $ 2, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, IDUM, INFO ) CALL CHKXER( 'SGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 20 CALL SGGSVD3( 'N', 'N', 'Q', 1, 2, 1, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, IW, LWORK, INFO ) + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, IDUM, INFO ) CALL CHKXER( 'SGGSVD3', INFOT, NOUT, LERR, OK ) NT = NT + 11 * diff --git a/TESTING/EIG/zchkee.f b/TESTING/EIG/zchkee.f index 67221276..bcfecf80 100644 --- a/TESTING/EIG/zchkee.f +++ b/TESTING/EIG/zchkee.f @@ -2098,6 +2098,7 @@ MAXTYP = 26 NTYPES = MIN( MAXTYP, NTYPES ) CALL ALAREQ( C3, NTYPES, DOTYPE, MAXTYP, NIN, NOUT ) + CALL XLAENV(1,1) IF( TSTCHK .AND. TSTERR ) $ CALL ZERRGG( C3, NOUT ) DO 350 I = 1, NPARMS @@ -2222,6 +2223,7 @@ * * Blocked version * + CALL XLAENV(16,2) CALL ZDRGEV3( NN, NVAL, MAXTYP, DOTYPE, ISEED, THRESH, NOUT, $ A( 1, 1 ), NMAX, A( 1, 2 ), A( 1, 3 ), $ A( 1, 4 ), A( 1, 7 ), NMAX, A( 1, 8 ), @@ -2347,6 +2349,7 @@ * GSV: Generalized Singular Value Decomposition * ---------------------------------------------- * + CALL XLAENV(1,1) IF( TSTERR ) $ CALL ZERRGG( 'GSV', NOUT ) CALL ZCKGSV( NN, MVAL, PVAL, NVAL, NTYPES, ISEED, THRESH, NMAX, diff --git a/TESTING/EIG/zerrgg.f b/TESTING/EIG/zerrgg.f index 3366c771..e0589348 100644 --- a/TESTING/EIG/zerrgg.f +++ b/TESTING/EIG/zerrgg.f @@ -83,7 +83,7 @@ * .. * .. Local Arrays .. LOGICAL BW( NMAX ), SEL( NMAX ) - INTEGER IW( LW ) + INTEGER IW( LW ), IDUM(NMAX) DOUBLE PRECISION LS( NMAX ), R1( NMAX ), R2( NMAX ), $ RCE( NMAX ), RCV( NMAX ), RS( NMAX ), RW( LW ) COMPLEX*16 A( NMAX, NMAX ), ALPHA( NMAX ), @@ -306,57 +306,57 @@ SRNAMT = 'ZGGSVD3' INFOT = 1 CALL ZGGSVD3( '/', 'N', 'N', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, LWORK, + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, RW, IDUM, $ INFO ) CALL CHKXER( 'ZGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 2 CALL ZGGSVD3( 'N', '/', 'N', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, LWORK, + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, RW, IDUM, $ INFO ) CALL CHKXER( 'ZGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 3 CALL ZGGSVD3( 'N', 'N', '/', 0, 0, 0, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, LWORK, + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, RW, IDUM, $ INFO ) CALL CHKXER( 'ZGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 4 CALL ZGGSVD3( 'N', 'N', 'N', -1, 0, 0, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, LWORK, + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, RW, IDUM, $ INFO ) CALL CHKXER( 'ZGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 5 CALL ZGGSVD3( 'N', 'N', 'N', 0, -1, 0, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, LWORK, + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, RW, IDUM, $ INFO ) CALL CHKXER( 'ZGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 6 CALL ZGGSVD3( 'N', 'N', 'N', 0, 0, -1, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, LWORK, + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, RW, IDUM, $ INFO ) CALL CHKXER( 'ZGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 10 CALL ZGGSVD3( 'N', 'N', 'N', 2, 1, 1, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, LWORK, + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, RW, IDUM, $ INFO ) CALL CHKXER( 'ZGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 12 CALL ZGGSVD3( 'N', 'N', 'N', 1, 1, 2, DUMMYK, DUMMYL, A, 1, B, - $ 1, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, LWORK, + $ 1, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, RW, IDUM, $ INFO ) CALL CHKXER( 'ZGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 16 CALL ZGGSVD3( 'U', 'N', 'N', 2, 2, 2, DUMMYK, DUMMYL, A, 2, B, - $ 2, R1, R2, U, 1, V, 1, Q, 1, W, RW, IW, LWORK, + $ 2, R1, R2, U, 1, V, 1, Q, 1, W, LWORK, RW, IDUM, $ INFO ) CALL CHKXER( 'ZGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 18 CALL ZGGSVD3( 'N', 'V', 'N', 2, 2, 2, DUMMYK, DUMMYL, A, 2, B, - $ 2, R1, R2, U, 2, V, 1, Q, 1, W, RW, IW, LWORK, + $ 2, R1, R2, U, 2, V, 1, Q, 1, W, LWORK, RW, IDUM, $ INFO ) CALL CHKXER( 'ZGGSVD3', INFOT, NOUT, LERR, OK ) INFOT = 20 CALL ZGGSVD3( 'N', 'N', 'Q', 2, 2, 2, DUMMYK, DUMMYL, A, 2, B, - $ 2, R1, R2, U, 2, V, 2, Q, 1, W, RW, IW, LWORK, + $ 2, R1, R2, U, 2, V, 2, Q, 1, W, LWORK, RW, IDUM, $ INFO ) CALL CHKXER( 'ZGGSVD3', INFOT, NOUT, LERR, OK ) NT = NT + 11 @@ -573,56 +573,56 @@ INFOT = 7 CALL ZUNCSD( 'Y', 'Y', 'Y', 'Y', 'N', 'N', $ -1, 0, 0, A, 1, A, - $ 1, A, 1, A, 1, A, + $ 1, A, 1, A, 1, RS, $ A, 1, A, 1, A, 1, A, $ 1, W, LW, RW, LW, IW, INFO ) CALL CHKXER( 'ZUNCSD', INFOT, NOUT, LERR, OK ) INFOT = 8 CALL ZUNCSD( 'Y', 'Y', 'Y', 'Y', 'N', 'N', $ 1, -1, 0, A, 1, A, - $ 1, A, 1, A, 1, A, + $ 1, A, 1, A, 1, RS, $ A, 1, A, 1, A, 1, A, $ 1, W, LW, RW, LW, IW, INFO ) CALL CHKXER( 'ZUNCSD', INFOT, NOUT, LERR, OK ) INFOT = 9 CALL ZUNCSD( 'Y', 'Y', 'Y', 'Y', 'N', 'N', $ 1, 1, -1, A, 1, A, - $ 1, A, 1, A, 1, A, + $ 1, A, 1, A, 1, RS, $ A, 1, A, 1, A, 1, A, $ 1, W, LW, RW, LW, IW, INFO ) CALL CHKXER( 'ZUNCSD', INFOT, NOUT, LERR, OK ) INFOT = 11 CALL ZUNCSD( 'Y', 'Y', 'Y', 'Y', 'N', 'N', $ 1, 1, 1, A, -1, A, - $ 1, A, 1, A, 1, A, + $ 1, A, 1, A, 1, RS, $ A, 1, A, 1, A, 1, A, $ 1, W, LW, RW, LW, IW, INFO ) CALL CHKXER( 'ZUNCSD', INFOT, NOUT, LERR, OK ) INFOT = 20 CALL ZUNCSD( 'Y', 'Y', 'Y', 'Y', 'N', 'N', $ 1, 1, 1, A, 1, A, - $ 1, A, 1, A, 1, A, + $ 1, A, 1, A, 1, RS, $ A, -1, A, 1, A, 1, A, $ 1, W, LW, RW, LW, IW, INFO ) CALL CHKXER( 'ZUNCSD', INFOT, NOUT, LERR, OK ) INFOT = 22 CALL ZUNCSD( 'Y', 'Y', 'Y', 'Y', 'N', 'N', $ 1, 1, 1, A, 1, A, - $ 1, A, 1, A, 1, A, + $ 1, A, 1, A, 1, RS, $ A, 1, A, -1, A, 1, A, $ 1, W, LW, RW, LW, IW, INFO ) CALL CHKXER( 'ZUNCSD', INFOT, NOUT, LERR, OK ) INFOT = 24 CALL ZUNCSD( 'Y', 'Y', 'Y', 'Y', 'N', 'N', $ 1, 1, 1, A, 1, A, - $ 1, A, 1, A, 1, A, + $ 1, A, 1, A, 1, RS, $ A, 1, A, 1, A, -1, A, $ 1, W, LW, RW, LW, IW, INFO ) CALL CHKXER( 'ZUNCSD', INFOT, NOUT, LERR, OK ) INFOT = 26 CALL ZUNCSD( 'Y', 'Y', 'Y', 'Y', 'N', 'N', $ 1, 1, 1, A, 1, A, - $ 1, A, 1, A, 1, A, + $ 1, A, 1, A, 1, RS, $ A, 1, A, 1, A, 1, A, $ -1, W, LW, RW, LW, IW, INFO ) CALL CHKXER( 'ZUNCSD', INFOT, NOUT, LERR, OK ) -- cgit v1.2.3