diff options
81 files changed, 170 insertions, 397 deletions
diff --git a/BLAS/SRC/drotmg.f b/BLAS/SRC/drotmg.f index ca5de114..108c7949 100644 --- a/BLAS/SRC/drotmg.f +++ b/BLAS/SRC/drotmg.f @@ -186,7 +186,6 @@ DPARAM(5) = DH22 END IF - 260 CONTINUE DPARAM(1) = DFLAG RETURN END diff --git a/BLAS/TESTING/cblat2.f b/BLAS/TESTING/cblat2.f index 478a2205..e9484017 100644 --- a/BLAS/TESTING/cblat2.f +++ b/BLAS/TESTING/cblat2.f @@ -3083,7 +3083,6 @@ 50 CONTINUE END IF * - 60 CONTINUE LCERES = .TRUE. GO TO 80 70 CONTINUE diff --git a/BLAS/TESTING/cblat3.f b/BLAS/TESTING/cblat3.f index 8885f89c..5cc4af5e 100644 --- a/BLAS/TESTING/cblat3.f +++ b/BLAS/TESTING/cblat3.f @@ -3287,7 +3287,6 @@ 50 CONTINUE END IF * - 60 CONTINUE LCERES = .TRUE. GO TO 80 70 CONTINUE diff --git a/BLAS/TESTING/dblat2.f b/BLAS/TESTING/dblat2.f index 36e5d988..297bce68 100644 --- a/BLAS/TESTING/dblat2.f +++ b/BLAS/TESTING/dblat2.f @@ -2986,7 +2986,6 @@ 50 CONTINUE END IF * - 60 CONTINUE LDERES = .TRUE. GO TO 80 70 CONTINUE diff --git a/BLAS/TESTING/dblat3.f b/BLAS/TESTING/dblat3.f index d21c39e9..dab3ce5e 100644 --- a/BLAS/TESTING/dblat3.f +++ b/BLAS/TESTING/dblat3.f @@ -2676,7 +2676,6 @@ 50 CONTINUE END IF * - 60 CONTINUE LDERES = .TRUE. GO TO 80 70 CONTINUE diff --git a/BLAS/TESTING/sblat2.f b/BLAS/TESTING/sblat2.f index c6c952c5..aa11fcc3 100644 --- a/BLAS/TESTING/sblat2.f +++ b/BLAS/TESTING/sblat2.f @@ -2986,7 +2986,6 @@ 50 CONTINUE END IF * - 60 CONTINUE LSERES = .TRUE. GO TO 80 70 CONTINUE diff --git a/BLAS/TESTING/sblat3.f b/BLAS/TESTING/sblat3.f index 0dd7c8bf..e9ac0eef 100644 --- a/BLAS/TESTING/sblat3.f +++ b/BLAS/TESTING/sblat3.f @@ -2676,7 +2676,6 @@ 50 CONTINUE END IF * - 60 CONTINUE LSERES = .TRUE. GO TO 80 70 CONTINUE diff --git a/BLAS/TESTING/zblat2.f b/BLAS/TESTING/zblat2.f index 9d849de2..8e49cabf 100644 --- a/BLAS/TESTING/zblat2.f +++ b/BLAS/TESTING/zblat2.f @@ -3091,7 +3091,6 @@ 50 CONTINUE END IF * - 60 CONTINUE LZERES = .TRUE. GO TO 80 70 CONTINUE diff --git a/BLAS/TESTING/zblat3.f b/BLAS/TESTING/zblat3.f index 41a2e320..fb471255 100644 --- a/BLAS/TESTING/zblat3.f +++ b/BLAS/TESTING/zblat3.f @@ -3296,7 +3296,6 @@ 50 CONTINUE END IF * - 60 CONTINUE LZERES = .TRUE. GO TO 80 70 CONTINUE diff --git a/SRC/cgebal.f b/SRC/cgebal.f index 81556edf..8a4084a6 100644 --- a/SRC/cgebal.f +++ b/SRC/cgebal.f @@ -274,7 +274,7 @@ 160 CONTINUE IF( C.GE.G .OR. MAX( F, C, CA ).GE.SFMAX2 .OR. $ MIN( R, G, RA ).LE.SFMIN2 )GO TO 170 - IF( SISNAN( C+F+CA+R+G+RA ) ) THEN + IF( SISNAN( C+F+CA+R+G+RA ) ) THEN * * Exit if NaN to avoid infinite loop * diff --git a/SRC/cpoequb.f b/SRC/cpoequb.f index c0802482..70686e01 100644 --- a/SRC/cpoequb.f +++ b/SRC/cpoequb.f @@ -72,7 +72,6 @@ * .. Local Scalars .. INTEGER I REAL SMIN, BASE, TMP - COMPLEX ZDUM * .. * .. External Functions .. REAL SLAMCH diff --git a/SRC/csysv.f b/SRC/csysv.f index 60322a9e..fd754ad1 100644 --- a/SRC/csysv.f +++ b/SRC/csysv.f @@ -108,7 +108,7 @@ * * .. Local Scalars .. LOGICAL LQUERY - INTEGER LWKOPT, NB + INTEGER LWKOPT * .. * .. External Functions .. LOGICAL LSAME @@ -145,7 +145,7 @@ IF( N.EQ.0 ) THEN LWKOPT = 1 ELSE - CALL CSYTRF( UPLO, N, A, LDA, IPIV, WORK, -1, INFO ) + CALL CSYTRF( UPLO, N, A, LDA, IPIV, WORK, -1, INFO ) LWKOPT = WORK(1) END IF WORK( 1 ) = LWKOPT diff --git a/SRC/dsysv.f b/SRC/dsysv.f index eaaabecc..f719b406 100644 --- a/SRC/dsysv.f +++ b/SRC/dsysv.f @@ -108,7 +108,7 @@ * * .. Local Scalars .. LOGICAL LQUERY - INTEGER LWKOPT, NB + INTEGER LWKOPT * .. * .. External Functions .. LOGICAL LSAME @@ -145,7 +145,7 @@ IF( N.EQ.0 ) THEN LWKOPT = 1 ELSE - CALL DSYTRF( UPLO, N, A, LDA, IPIV, WORK, -1, INFO ) + CALL DSYTRF( UPLO, N, A, LDA, IPIV, WORK, -1, INFO ) LWKOPT = WORK(1) END IF WORK( 1 ) = LWKOPT diff --git a/SRC/sgejsv.f b/SRC/sgejsv.f index 1afb50d7..57bce24c 100644 --- a/SRC/sgejsv.f +++ b/SRC/sgejsv.f @@ -459,7 +459,7 @@ $ (LWORK .LT. MAX0(7,4*N+N*N,2*M+N))) .OR. $ (LSVEC .AND. (.NOT.RSVEC) .AND. (LWORK .LT. MAX0(7,2*M+N,4*N+1))) $ .OR. - $ (RSVEC .AND. (.NOT.LSVEC) .AND. (LWORK .LT. MAX0(7,2*M+N,4*N+1))) + $ (RSVEC .AND. (.NOT.LSVEC) .AND. (LWORK .LT. MAX0(7,2*M+N,4*N+1))) $ .OR. $ (LSVEC .AND. RSVEC .AND. (.NOT.JRACC) .AND. $ (LWORK.LT.MAX0(2*M+N,6*N+2*N*N))) diff --git a/SRC/sggesx.f b/SRC/sggesx.f index 74a0201e..ee99a537 100644 --- a/SRC/sggesx.f +++ b/SRC/sggesx.f @@ -579,7 +579,7 @@ DO 20 I = 1, N IF( ALPHAI( I ).NE.ZERO ) THEN IF( ( ALPHAR( I ) / SAFMAX ).GT.( ANRMTO / ANRM ) .OR. - $ ( SAFMIN / ALPHAR( I ) ).GT.( ANRM / ANRMTO ) ) + $ ( SAFMIN / ALPHAR( I ) ).GT.( ANRM / ANRMTO ) ) $ THEN WORK( 1 ) = ABS( A( I, I ) / ALPHAR( I ) ) BETA( I ) = BETA( I )*WORK( 1 ) diff --git a/SRC/ssysv.f b/SRC/ssysv.f index 0b995eb7..b4b35051 100644 --- a/SRC/ssysv.f +++ b/SRC/ssysv.f @@ -108,7 +108,7 @@ * * .. Local Scalars .. LOGICAL LQUERY - INTEGER LWKOPT, NB + INTEGER LWKOPT * .. * .. External Functions .. LOGICAL LSAME @@ -145,7 +145,7 @@ IF( N.EQ.0 ) THEN LWKOPT = 1 ELSE - CALL SSYTRF( UPLO, N, A, LDA, IPIV, WORK, -1, INFO ) + CALL SSYTRF( UPLO, N, A, LDA, IPIV, WORK, -1, INFO ) LWKOPT = WORK(1) END IF WORK( 1 ) = LWKOPT diff --git a/SRC/zpoequb.f b/SRC/zpoequb.f index 3b064d7c..24c30e1e 100644 --- a/SRC/zpoequb.f +++ b/SRC/zpoequb.f @@ -72,7 +72,6 @@ * .. Local Scalars .. INTEGER I DOUBLE PRECISION SMIN, BASE, TMP - COMPLEX*16 ZDUM * .. * .. External Functions .. DOUBLE PRECISION DLAMCH diff --git a/SRC/zsysv.f b/SRC/zsysv.f index e1971b85..e027fe40 100644 --- a/SRC/zsysv.f +++ b/SRC/zsysv.f @@ -108,7 +108,7 @@ * * .. Local Scalars .. LOGICAL LQUERY - INTEGER LWKOPT, NB + INTEGER LWKOPT * .. * .. External Functions .. LOGICAL LSAME @@ -145,7 +145,7 @@ IF( N.EQ.0 ) THEN LWKOPT = 1 ELSE - CALL ZSYTRF( UPLO, N, A, LDA, IPIV, WORK, -1, INFO ) + CALL ZSYTRF( UPLO, N, A, LDA, IPIV, WORK, -1, INFO ) LWKOPT = WORK(1) END IF WORK( 1 ) = LWKOPT diff --git a/TESTING/EIG/cchkee.f b/TESTING/EIG/cchkee.f index 11d6846d..aef0b0be 100644 --- a/TESTING/EIG/cchkee.f +++ b/TESTING/EIG/cchkee.f @@ -2346,8 +2346,6 @@ WRITE( NOUT, FMT = 9993 )S2 - S1 * 9999 FORMAT( / ' Execution not attempted due to input errors' ) - 9998 FORMAT( / / 1X, A3, ': NB =', I4, ', NBMIN =', I4, ', NX =', I4, - $ ', NS =', I4, ', MAXB =', I4 ) 9997 FORMAT( / / 1X, A3, ': NB =', I4, ', NBMIN =', I4, ', NX =', I4 ) 9996 FORMAT( / / 1X, A3, ': NB =', I4, ', NBMIN =', I4, ', NS =', I4, $ ', MAXB =', I4, ', NBCOL =', I4 ) diff --git a/TESTING/EIG/cchkhs.f b/TESTING/EIG/cchkhs.f index c8872ddd..98eeb873 100644 --- a/TESTING/EIG/cchkhs.f +++ b/TESTING/EIG/cchkhs.f @@ -616,7 +616,7 @@ CONDS = ZERO END IF * - CALL CLATME( N, 'D', ISEED, WORK, IMODE, COND, CONE, ' ', + CALL CLATME( N, 'D', ISEED, WORK, IMODE, COND, CONE, $ 'T', 'T', 'T', RWORK, 4, CONDS, N, N, ANORM, $ A, LDA, WORK( N+1 ), IINFO ) * diff --git a/TESTING/EIG/cchkst.f b/TESTING/EIG/cchkst.f index 9abda0e9..915b2267 100644 --- a/TESTING/EIG/cchkst.f +++ b/TESTING/EIG/cchkst.f @@ -1794,40 +1794,6 @@ $ / ' 21=Diagonally dominant tridiagonal, geometrically', $ ' spaced eigenvalues' ) * - 9993 FORMAT( / ' Tests performed: ', - $ '(S is Tridiag, D is diagonal, U and Z are ', A, ',', / 20X, - $ A, ', W is a diagonal matrix of eigenvalues,', / 20X, - $ ' V is U represented by Householder vectors, and', / 20X, - $ ' Y is a matrix of eigenvectors of S.)', - $ / ' CHETRD, UPLO=''U'':', / ' 1= | A - V S V', A1, - $ ' | / ( |A| n ulp ) ', ' 2= | I - U V', A1, - $ ' | / ( n ulp )', / ' CHETRD, UPLO=''L'':', - $ / ' 3= | A - V S V', A1, ' | / ( |A| n ulp ) ', - $ ' 4= | I - U V', A1, ' | / ( n ulp )' ) - 9992 FORMAT( ' CHPTRD, UPLO=''U'':', / ' 5= | A - V S V', A1, - $ ' | / ( |A| n ulp ) ', ' 6= | I - U V', A1, - $ ' | / ( n ulp )', / ' CHPTRD, UPLO=''L'':', - $ / ' 7= | A - V S V', A1, ' | / ( |A| n ulp ) ', - $ ' 8= | I - U V', A1, ' | / ( n ulp )', - $ / ' 9= | S - Z D Z', A1, ' | / ( |S| n ulp ) ', - $ ' 10= | I - Z Z', A1, ' | / ( n ulp )', - $ / ' 11= |D(with Z) - D(w/o Z)| / (|D| ulp) ', - $ ' 12= | D(PWK) - D(QR) | / (|D| ulp)', - $ / ' 13= Sturm sequence test on W ' ) - 9991 FORMAT( ' 14= | S - Z4 D4 Z4', A1, ' | / (|S| n ulp)', - $ / ' 15= | I - Z4 Z4', A1, ' | / (n ulp ) ', - $ ' 16= | D4 - D5 | / ( 100 |D4| ulp ) ', - $ / ' 17= max | D4(i) - WR(i) | / ( |D4(i)| (2n-1) ulp )', - $ / ' 18= | WA1 - D3 | / ( |D3| ulp )', - $ / ' 19= max | WA2(i) - WA3(ii) | / ( |D3| ulp )', - $ / ' 20= | S - Y WA1 Y', A1, ' | / ( |S| n ulp )', - $ / ' 21= | I - Y Y', A1, ' | / ( n ulp )' ) - 9990 FORMAT( ' 22= | S - Z D Z', A1, - $ ' | / ( |S| n ulp ) for CSTEDC(I)', / ' 23= | I - Z Z', A1, - $ ' | / ( n ulp ) for CSTEDC(I)', / ' 24= | S - Z D Z', - $ A1, ' | / ( |S| n ulp ) for CSTEDC(V)', / ' 25= | I - Z Z', - $ A1, ' | / ( n ulp ) for CSTEDC(V)', - $ / ' 26= | D1(CSTEDC(V)) - D2(CSTEDC(N)) | / ( |D1| ulp )' ) 9989 FORMAT( ' Matrix order=', I5, ', type=', I2, ', seed=', $ 4( I4, ',' ), ' result ', I3, ' is', 0P, F8.2 ) 9988 FORMAT( ' Matrix order=', I5, ', type=', I2, ', seed=', diff --git a/TESTING/EIG/cdrves.f b/TESTING/EIG/cdrves.f index 3c083305..0c14029d 100644 --- a/TESTING/EIG/cdrves.f +++ b/TESTING/EIG/cdrves.f @@ -524,7 +524,7 @@ CONDS = ZERO END IF * - CALL CLATME( N, 'D', ISEED, WORK, IMODE, COND, CONE, ' ', + CALL CLATME( N, 'D', ISEED, WORK, IMODE, COND, CONE, $ 'T', 'T', 'T', RWORK, 4, CONDS, N, N, ANORM, $ A, LDA, WORK( 2*N+1 ), IINFO ) * diff --git a/TESTING/EIG/cdrvev.f b/TESTING/EIG/cdrvev.f index 6d68cc45..18b2197f 100644 --- a/TESTING/EIG/cdrvev.f +++ b/TESTING/EIG/cdrvev.f @@ -525,7 +525,7 @@ END IF * CALL CLATME( N, 'D', ISEED, WORK, IMODE, COND, CONE, - $ ' ', 'T', 'T', 'T', RWORK, 4, CONDS, N, N, + $ 'T', 'T', 'T', RWORK, 4, CONDS, N, N, $ ANORM, A, LDA, WORK( 2*N+1 ), IINFO ) * ELSE IF( ITYPE.EQ.7 ) THEN diff --git a/TESTING/EIG/cdrvsx.f b/TESTING/EIG/cdrvsx.f index 129fde06..ff72ac4a 100644 --- a/TESTING/EIG/cdrvsx.f +++ b/TESTING/EIG/cdrvsx.f @@ -577,7 +577,7 @@ CONDS = ZERO END IF * - CALL CLATME( N, 'D', ISEED, WORK, IMODE, COND, CONE, ' ', + CALL CLATME( N, 'D', ISEED, WORK, IMODE, COND, CONE, $ 'T', 'T', 'T', RWORK, 4, CONDS, N, N, ANORM, $ A, LDA, WORK( 2*N+1 ), IINFO ) * diff --git a/TESTING/EIG/cdrvvx.f b/TESTING/EIG/cdrvvx.f index 5d23e4a5..7b6fe6e4 100644 --- a/TESTING/EIG/cdrvvx.f +++ b/TESTING/EIG/cdrvvx.f @@ -573,7 +573,7 @@ CONDS = ZERO END IF * - CALL CLATME( N, 'D', ISEED, WORK, IMODE, COND, CONE, ' ', + CALL CLATME( N, 'D', ISEED, WORK, IMODE, COND, CONE, $ 'T', 'T', 'T', RWORK, 4, CONDS, N, N, ANORM, $ A, LDA, WORK( 2*N+1 ), IINFO ) * diff --git a/TESTING/EIG/dchkee.f b/TESTING/EIG/dchkee.f index cc2c0878..2df71a32 100644 --- a/TESTING/EIG/dchkee.f +++ b/TESTING/EIG/dchkee.f @@ -2353,8 +2353,6 @@ WRITE( NOUT, FMT = 9993 )S2 - S1 * 9999 FORMAT( / ' Execution not attempted due to input errors' ) - 9998 FORMAT( / / 1X, A3, ': NB =', I4, ', NBMIN =', I4, ', NX =', I4, - $ ', NS =', I4, ', MAXB =', I4 ) 9997 FORMAT( / / 1X, A3, ': NB =', I4, ', NBMIN =', I4, ', NX =', I4 ) 9996 FORMAT( / / 1X, A3, ': NB =', I4, ', NBMIN =', I4, ', NS =', I4, $ ', MAXB =', I4, ', NBCOL =', I4 ) diff --git a/TESTING/EIG/dchkst.f b/TESTING/EIG/dchkst.f index 8f595413..5cf5e546 100644 --- a/TESTING/EIG/dchkst.f +++ b/TESTING/EIG/dchkst.f @@ -1781,41 +1781,8 @@ $ / ' 21=Diagonally dominant tridiagonal, geometrically', $ ' spaced eigenvalues' ) * - 9993 FORMAT( / ' Tests performed: ', - $ '(S is Tridiag, D is diagonal, U and Z are ', A, ',', / 20X, - $ A, ', W is a diagonal matrix of eigenvalues,', / 20X, - $ ' V is U represented by Householder vectors, and', / 20X, - $ ' Y is a matrix of eigenvectors of S.)', - $ / ' DSYTRD, UPLO=''U'':', / ' 1= | A - V S V', A1, - $ ' | / ( |A| n ulp ) ', ' 2= | I - U V', A1, - $ ' | / ( n ulp )', / ' DSYTRD, UPLO=''L'':', - $ / ' 3= | A - V S V', A1, ' | / ( |A| n ulp ) ', - $ ' 4= | I - U V', A1, ' | / ( n ulp )' ) - 9992 FORMAT( ' DSPTRD, UPLO=''U'':', / ' 5= | A - V S V', A1, - $ ' | / ( |A| n ulp ) ', ' 6= | I - U V', A1, - $ ' | / ( n ulp )', / ' DSPTRD, UPLO=''L'':', - $ / ' 7= | A - V S V', A1, ' | / ( |A| n ulp ) ', - $ ' 8= | I - U V', A1, ' | / ( n ulp )', - $ / ' 9= | S - Z D Z', A1, ' | / ( |S| n ulp ) ', - $ ' 10= | I - Z Z', A1, ' | / ( n ulp )', - $ / ' 11= |D(with Z) - D(w/o Z)| / (|D| ulp) ', - $ ' 12= | D(PWK) - D(QR) | / (|D| ulp)', - $ / ' 13= Sturm sequence test on W ' ) - 9991 FORMAT( ' 14= | S - Z4 D4 Z4', A1, ' | / (|S| n ulp)', - $ / ' 15= | I - Z4 Z4', A1, ' | / (n ulp ) ', - $ ' 16= | D4 - D5 | / ( 100 |D4| ulp ) ', - $ / ' 17= max | D4(i) - WR(i) | / ( |D4(i)| (2n-1) ulp )', - $ / ' 18= | WA1 - D3 | / ( |D3| ulp )', - $ / ' 19= max | WA2(i) - WA3(ii) | / ( |D3| ulp )', - $ / ' 20= | S - Y WA1 Y', A1, ' | / ( |S| n ulp )', - $ / ' 21= | I - Y Y', A1, ' | / ( n ulp )' ) 9990 FORMAT( ' N=', I5, ', seed=', 4( I4, ',' ), ' type ', I2, $ ', test(', I2, ')=', G10.3 ) - 9989 FORMAT( ' 22= | S - Z D Z', A1, '| / ( |S| n ulp ) for DSTEDC(I)', - $ / ' 23= | I - Z Z', A1, '| / ( n ulp ) for DSTEDC(I)', - $ / ' 24= | S - Z D Z', A1, '| / ( |S| n ulp ) for DSTEDC(V)', - $ / ' 25= | I - Z Z', A1, '| / ( n ulp ) for DSTEDC(V)', - $ / ' 26= | D1(DSTEDC(V)) - D2(SSTEDC(N)) | / ( |D1| ulp )' ) * 9988 FORMAT( / 'Test performed: see DCHKST for details.', / ) * End of DCHKST diff --git a/TESTING/EIG/schkee.f b/TESTING/EIG/schkee.f index 00b1f8c1..e5184009 100644 --- a/TESTING/EIG/schkee.f +++ b/TESTING/EIG/schkee.f @@ -2353,8 +2353,6 @@ WRITE( NOUT, FMT = 9993 )S2 - S1 * 9999 FORMAT( / ' Execution not attempted due to input errors' ) - 9998 FORMAT( / / 1X, A3, ': NB =', I4, ', NBMIN =', I4, ', NX =', I4, - $ ', NS =', I4, ', MAXB =', I4 ) 9997 FORMAT( / / 1X, A3, ': NB =', I4, ', NBMIN =', I4, ', NX =', I4 ) 9996 FORMAT( / / 1X, A3, ': NB =', I4, ', NBMIN =', I4, ', NS =', I4, $ ', MAXB =', I4, ', NBCOL =', I4 ) diff --git a/TESTING/EIG/schkst.f b/TESTING/EIG/schkst.f index 2b376745..64891c26 100644 --- a/TESTING/EIG/schkst.f +++ b/TESTING/EIG/schkst.f @@ -1781,41 +1781,8 @@ $ / ' 21=Diagonally dominant tridiagonal, geometrically', $ ' spaced eigenvalues' ) * - 9993 FORMAT( / ' Tests performed: ', - $ '(S is Tridiag, D is diagonal, U and Z are ', A, ',', / 20X, - $ A, ', W is a diagonal matrix of eigenvalues,', / 20X, - $ ' V is U represented by Householder vectors, and', / 20X, - $ ' Y is a matrix of eigenvectors of S.)', - $ / ' SSYTRD, UPLO=''U'':', / ' 1= | A - V S V', A1, - $ ' | / ( |A| n ulp ) ', ' 2= | I - U V', A1, - $ ' | / ( n ulp )', / ' SSYTRD, UPLO=''L'':', - $ / ' 3= | A - V S V', A1, ' | / ( |A| n ulp ) ', - $ ' 4= | I - U V', A1, ' | / ( n ulp )' ) - 9992 FORMAT( ' SSPTRD, UPLO=''U'':', / ' 5= | A - V S V', A1, - $ ' | / ( |A| n ulp ) ', ' 6= | I - U V', A1, - $ ' | / ( n ulp )', / ' SSPTRD, UPLO=''L'':', - $ / ' 7= | A - V S V', A1, ' | / ( |A| n ulp ) ', - $ ' 8= | I - U V', A1, ' | / ( n ulp )', - $ / ' 9= | S - Z D Z', A1, ' | / ( |S| n ulp ) ', - $ ' 10= | I - Z Z', A1, ' | / ( n ulp )', - $ / ' 11= |D(with Z) - D(w/o Z)| / (|D| ulp) ', - $ ' 12= | D(PWK) - D(QR) | / (|D| ulp)', - $ / ' 13= Sturm sequence test on W ' ) - 9991 FORMAT( ' 14= | S - Z4 D4 Z4', A1, ' | / (|S| n ulp)', - $ / ' 15= | I - Z4 Z4', A1, ' | / (n ulp ) ', - $ ' 16= | D4 - D5 | / ( 100 |D4| ulp ) ', - $ / ' 17= max | D4(i) - WR(i) | / ( |D4(i)| (2n-1) ulp )', - $ / ' 18= | WA1 - D3 | / ( |D3| ulp )', - $ / ' 19= max | WA2(i) - WA3(ii) | / ( |D3| ulp )', - $ / ' 20= | S - Y WA1 Y', A1, ' | / ( |S| n ulp )', - $ / ' 21= | I - Y Y', A1, ' | / ( n ulp )' ) 9990 FORMAT( ' N=', I5, ', seed=', 4( I4, ',' ), ' type ', I2, $ ', test(', I2, ')=', G10.3 ) - 9989 FORMAT( ' 22= | S - Z D Z', A1, '| / ( |S| n ulp ) for SSTEDC(I)', - $ / ' 23= | I - Z Z', A1, '| / ( n ulp ) for SSTEDC(I)', - $ / ' 24= | S - Z D Z', A1, '| / ( |S| n ulp ) for SSTEDC(V)', - $ / ' 25= | I - Z Z', A1, '| / ( n ulp ) for SSTEDC(V)', - $ / ' 26= | D1(SSTEDC(V)) - D2(SSTEDC(N)) | / ( |D1| ulp )' ) * 9988 FORMAT( / 'Test performed: see SCHKST for details.', / ) * End of SCHKST diff --git a/TESTING/EIG/zchkee.f b/TESTING/EIG/zchkee.f index d37e3c52..dd3547e6 100644 --- a/TESTING/EIG/zchkee.f +++ b/TESTING/EIG/zchkee.f @@ -2346,8 +2346,6 @@ WRITE( NOUT, FMT = 9993 )S2 - S1 * 9999 FORMAT( / ' Execution not attempted due to input errors' ) - 9998 FORMAT( / / 1X, A3, ': NB =', I4, ', NBMIN =', I4, ', NX =', I4, - $ ', NS =', I4, ', MAXB =', I4 ) 9997 FORMAT( / / 1X, A3, ': NB =', I4, ', NBMIN =', I4, ', NX =', I4 ) 9996 FORMAT( / / 1X, A3, ': NB =', I4, ', NBMIN =', I4, ', NS =', I4, $ ', MAXB =', I4, ', NBCOL =', I4 ) diff --git a/TESTING/EIG/zchkhs.f b/TESTING/EIG/zchkhs.f index 500eacf6..a04be2f6 100644 --- a/TESTING/EIG/zchkhs.f +++ b/TESTING/EIG/zchkhs.f @@ -616,7 +616,7 @@ CONDS = ZERO END IF * - CALL ZLATME( N, 'D', ISEED, WORK, IMODE, COND, CONE, ' ', + CALL ZLATME( N, 'D', ISEED, WORK, IMODE, COND, CONE, $ 'T', 'T', 'T', RWORK, 4, CONDS, N, N, ANORM, $ A, LDA, WORK( N+1 ), IINFO ) * diff --git a/TESTING/EIG/zchkst.f b/TESTING/EIG/zchkst.f index dfa8b1d4..7a2e10b7 100644 --- a/TESTING/EIG/zchkst.f +++ b/TESTING/EIG/zchkst.f @@ -1794,40 +1794,6 @@ $ / ' 21=Diagonally dominant tridiagonal, geometrically', $ ' spaced eigenvalues' ) * - 9993 FORMAT( / ' Tests performed: ', - $ '(S is Tridiag, D is diagonal, U and Z are ', A, ',', / 20X, - $ A, ', W is a diagonal matrix of eigenvalues,', / 20X, - $ ' V is U represented by Householder vectors, and', / 20X, - $ ' Y is a matrix of eigenvectors of S.)', - $ / ' ZHETRD, UPLO=''U'':', / ' 1= | A - V S V', A1, - $ ' | / ( |A| n ulp ) ', ' 2= | I - U V', A1, - $ ' | / ( n ulp )', / ' ZHETRD, UPLO=''L'':', - $ / ' 3= | A - V S V', A1, ' | / ( |A| n ulp ) ', - $ ' 4= | I - U V', A1, ' | / ( n ulp )' ) - 9992 FORMAT( ' ZHPTRD, UPLO=''U'':', / ' 5= | A - V S V', A1, - $ ' | / ( |A| n ulp ) ', ' 6= | I - U V', A1, - $ ' | / ( n ulp )', / ' ZHPTRD, UPLO=''L'':', - $ / ' 7= | A - V S V', A1, ' | / ( |A| n ulp ) ', - $ ' 8= | I - U V', A1, ' | / ( n ulp )', - $ / ' 9= | S - Z D Z', A1, ' | / ( |S| n ulp ) ', - $ ' 10= | I - Z Z', A1, ' | / ( n ulp )', - $ / ' 11= |D(with Z) - D(w/o Z)| / (|D| ulp) ', - $ ' 12= | D(PWK) - D(QR) | / (|D| ulp)', - $ / ' 13= Sturm sequence test on W ' ) - 9991 FORMAT( ' 14= | S - Z4 D4 Z4', A1, ' | / (|S| n ulp)', - $ / ' 15= | I - Z4 Z4', A1, ' | / (n ulp ) ', - $ ' 16= | D4 - D5 | / ( 100 |D4| ulp ) ', - $ / ' 17= max | D4(i) - WR(i) | / ( |D4(i)| (2n-1) ulp )', - $ / ' 18= | WA1 - D3 | / ( |D3| ulp )', - $ / ' 19= max | WA2(i) - WA3(ii) | / ( |D3| ulp )', - $ / ' 20= | S - Y WA1 Y', A1, ' | / ( |S| n ulp )', - $ / ' 21= | I - Y Y', A1, ' | / ( n ulp )' ) - 9990 FORMAT( ' 22= | S - Z D Z', A1, - $ ' | / ( |S| n ulp ) for ZSTEDC(I)', / ' 23= | I - Z Z', A1, - $ ' | / ( n ulp ) for ZSTEDC(I)', / ' 24= | S - Z D Z', - $ A1, ' | / ( |S| n ulp ) for ZSTEDC(V)', / ' 25= | I - Z Z', - $ A1, ' | / ( n ulp ) for ZSTEDC(V)', - $ / ' 26= | D1(ZSTEDC(V)) - D2(CSTEDC(N)) | / ( |D1| ulp )' ) 9989 FORMAT( ' Matrix order=', I5, ', type=', I2, ', seed=', $ 4( I4, ',' ), ' result ', I3, ' is', 0P, F8.2 ) 9988 FORMAT( ' Matrix order=', I5, ', type=', I2, ', seed=', diff --git a/TESTING/EIG/zdrves.f b/TESTING/EIG/zdrves.f index f08d13c0..d0becd53 100644 --- a/TESTING/EIG/zdrves.f +++ b/TESTING/EIG/zdrves.f @@ -524,7 +524,7 @@ CONDS = ZERO END IF * - CALL ZLATME( N, 'D', ISEED, WORK, IMODE, COND, CONE, ' ', + CALL ZLATME( N, 'D', ISEED, WORK, IMODE, COND, CONE, $ 'T', 'T', 'T', RWORK, 4, CONDS, N, N, ANORM, $ A, LDA, WORK( 2*N+1 ), IINFO ) * diff --git a/TESTING/EIG/zdrvev.f b/TESTING/EIG/zdrvev.f index 48165c1c..281b976d 100644 --- a/TESTING/EIG/zdrvev.f +++ b/TESTING/EIG/zdrvev.f @@ -524,7 +524,7 @@ CONDS = ZERO END IF * - CALL ZLATME( N, 'D', ISEED, WORK, IMODE, COND, CONE, ' ', + CALL ZLATME( N, 'D', ISEED, WORK, IMODE, COND, CONE, $ 'T', 'T', 'T', RWORK, 4, CONDS, N, N, ANORM, $ A, LDA, WORK( 2*N+1 ), IINFO ) * diff --git a/TESTING/EIG/zdrvsx.f b/TESTING/EIG/zdrvsx.f index b35d23b8..cd8b5fa6 100644 --- a/TESTING/EIG/zdrvsx.f +++ b/TESTING/EIG/zdrvsx.f @@ -577,7 +577,7 @@ CONDS = ZERO END IF * - CALL ZLATME( N, 'D', ISEED, WORK, IMODE, COND, CONE, ' ', + CALL ZLATME( N, 'D', ISEED, WORK, IMODE, COND, CONE, $ 'T', 'T', 'T', RWORK, 4, CONDS, N, N, ANORM, $ A, LDA, WORK( 2*N+1 ), IINFO ) * diff --git a/TESTING/EIG/zdrvvx.f b/TESTING/EIG/zdrvvx.f index 5bdb4f89..c92bc1c0 100644 --- a/TESTING/EIG/zdrvvx.f +++ b/TESTING/EIG/zdrvvx.f @@ -573,7 +573,7 @@ CONDS = ZERO END IF * - CALL ZLATME( N, 'D', ISEED, WORK, IMODE, COND, CONE, ' ', + CALL ZLATME( N, 'D', ISEED, WORK, IMODE, COND, CONE, $ 'T', 'T', 'T', RWORK, 4, CONDS, N, N, ANORM, $ A, LDA, WORK( 2*N+1 ), IINFO ) * diff --git a/TESTING/LIN/alahd.f b/TESTING/LIN/alahd.f index 63949e83..a8aa21f0 100644 --- a/TESTING/LIN/alahd.f +++ b/TESTING/LIN/alahd.f @@ -801,8 +801,6 @@ 9938 FORMAT( 3X, I2, ': norm( I - Q''*Q ) / ( M * EPS )' ) 9937 FORMAT( 3X, I2, ': norm( A - R*Q ) / ( M * norm(A) * EPS )' $ ) - 9936 FORMAT( ' Test ratios (1-2: ', A1, 'GELS, 3-6: ', A1, - $ 'GELSS, 7-10: ', A1, 'GELSX):' ) 9935 FORMAT( 3X, I2, ': norm( B - A * X ) / ', $ '( max(M,N) * norm(A) * norm(X) * EPS )' ) 9934 FORMAT( 3X, I2, ': norm( (A*X-B)'' *A ) / ', @@ -816,7 +814,6 @@ $ 'otherwise', / 7X, $ 'check if X is in the row space of A or A'' ', $ '(overdetermined case)' ) - 9930 FORMAT( 3X, ' 7-10: same as 3-6' ) 9929 FORMAT( ' Test ratios (1-3: ', A1, 'TZRQF, 4-6: ', A1, $ 'TZRZF):' ) 9920 FORMAT( 3X, ' 7-10: same as 3-6', 3X, ' 11-14: same as 3-6', diff --git a/TESTING/LIN/cchkaa.f b/TESTING/LIN/cchkaa.f index 1680df59..02e9e795 100644 --- a/TESTING/LIN/cchkaa.f +++ b/TESTING/LIN/cchkaa.f @@ -766,10 +766,11 @@ $ NRHS, THRESH, TSTERR, NMAX, A( 1, 1 ), $ A( 1, 2 ), A( 1, 3 ), A( 1, 4 ), A( 1, 5 ), $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), - $ WORK, RWORK, IWORK, NOUT ) + $ WORK, RWORK, NOUT ) ELSE WRITE( NOUT, FMT = 9989 )PATH END IF + * ELSE IF( LSAMEN( 2, C2, 'RQ' ) ) THEN * @@ -808,7 +809,7 @@ * IF( TSTCHK ) THEN CALL CCHKTZ( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, - $ A( 1, 1 ), A( 1, 2 ), S( 1 ), S( NMAX+1 ), + $ A( 1, 1 ), A( 1, 2 ), S( 1 ), $ B( 1, 1 ), WORK, RWORK, NOUT ) ELSE WRITE( NOUT, FMT = 9989 )PATH @@ -823,15 +824,15 @@ * IF( TSTCHK ) THEN CALL CCHKQP( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, - $ A( 1, 1 ), A( 1, 2 ), S( 1 ), S( NMAX+1 ), + $ A( 1, 1 ), A( 1, 2 ), S( 1 ), $ B( 1, 1 ), WORK, RWORK, IWORK, NOUT ) CALL CCHKQ3( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, $ THRESH, A( 1, 1 ), A( 1, 2 ), S( 1 ), - $ S( NMAX+1 ), B( 1, 1 ), WORK, RWORK, IWORK, - $ NOUT ) + $ B( 1, 1 ), WORK, RWORK, IWORK, NOUT ) ELSE WRITE( NOUT, FMT = 9989 )PATH END IF + * ELSE IF( LSAMEN( 2, C2, 'LS' ) ) THEN * @@ -854,6 +855,7 @@ * WRITE( NOUT, FMT = 9990 )PATH END IF + * * Go back to get another input line. * diff --git a/TESTING/LIN/cchkgt.f b/TESTING/LIN/cchkgt.f index 4a9dc39b..42e4b4bb 100644 --- a/TESTING/LIN/cchkgt.f +++ b/TESTING/LIN/cchkgt.f @@ -401,7 +401,7 @@ * CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA ) CALL CGTT02( TRANS, N, NRHS, A, A( M+1 ), A( N+M+1 ), - $ X, LDA, WORK, LDA, RWORK, RESULT( 2 ) ) + $ X, LDA, WORK, LDA, RESULT( 2 ) ) * *+ TEST 3 * Check solution from generated exact solution. diff --git a/TESTING/LIN/cchklq.f b/TESTING/LIN/cchklq.f index 73c90f6d..783f42b6 100644 --- a/TESTING/LIN/cchklq.f +++ b/TESTING/LIN/cchklq.f @@ -1,6 +1,6 @@ SUBROUTINE CCHKLQ( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, $ NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, AL, AC, - $ B, X, XACT, TAU, WORK, RWORK, IWORK, NOUT ) + $ B, X, XACT, TAU, WORK, RWORK, NOUT ) * * -- LAPACK test routine (version 3.1) -- * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. @@ -13,7 +13,7 @@ * .. * .. Array Arguments .. LOGICAL DOTYPE( * ) - INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ), + INTEGER MVAL( * ), NBVAL( * ), NVAL( * ), $ NXVAL( * ) REAL RWORK( * ) COMPLEX A( * ), AC( * ), AF( * ), AL( * ), AQ( * ), @@ -94,8 +94,6 @@ * * RWORK (workspace) REAL array, dimension (NMAX) * -* IWORK (workspace) INTEGER array, dimension (NMAX) -* * NOUT (input) INTEGER * The unit number for output. * diff --git a/TESTING/LIN/cchkq3.f b/TESTING/LIN/cchkq3.f index d9b5f766..bfdb6d28 100644 --- a/TESTING/LIN/cchkq3.f +++ b/TESTING/LIN/cchkq3.f @@ -1,5 +1,5 @@ SUBROUTINE CCHKQ3( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, - $ THRESH, A, COPYA, S, COPYS, TAU, WORK, RWORK, + $ THRESH, A, COPYA, S, TAU, WORK, RWORK, $ IWORK, NOUT ) * * -- LAPACK test routine (version 3.1) -- @@ -14,7 +14,7 @@ LOGICAL DOTYPE( * ) INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ), $ NXVAL( * ) - REAL COPYS( * ), RWORK( * ), S( * ) + REAL S( * ), RWORK( * ) COMPLEX A( * ), COPYA( * ), TAU( * ), WORK( * ) * .. * @@ -68,9 +68,6 @@ * S (workspace) REAL array, dimension * (min(MMAX,NMAX)) * -* COPYS (workspace) REAL array, dimension -* (min(MMAX,NMAX)) -* * TAU (workspace) COMPLEX array, dimension (MMAX) * * WORK (workspace) COMPLEX array, dimension @@ -184,10 +181,10 @@ IF( IMODE.EQ.1 ) THEN CALL CLASET( 'Full', M, N, CZERO, CZERO, COPYA, LDA ) DO 30 I = 1, MNMIN - COPYS( I ) = ZERO + S( I ) = ZERO 30 CONTINUE ELSE - CALL CLATMS( M, N, 'Uniform', ISEED, 'Nonsymm', COPYS, + CALL CLATMS( M, N, 'Uniform', ISEED, 'Nonsymm', S, $ MODE, ONE / EPS, ONE, M, N, 'No packing', $ COPYA, LDA, WORK, INFO ) IF( IMODE.GE.4 ) THEN @@ -208,7 +205,7 @@ IWORK( I ) = 1 40 CONTINUE END IF - CALL SLAORD( 'Decreasing', MNMIN, COPYS, 1 ) + CALL SLAORD( 'Decreasing', MNMIN, S, 1 ) END IF * DO 60 INB = 1, NNB @@ -236,7 +233,7 @@ * * Compute norm(svd(a) - svd(r)) * - RESULT( 1 ) = CQRT12( M, N, A, LDA, COPYS, WORK, + RESULT( 1 ) = CQRT12( M, N, A, LDA, S, WORK, $ LWORK, RWORK ) * * Compute norm( A*P - Q*R ) diff --git a/TESTING/LIN/cchkql.f b/TESTING/LIN/cchkql.f index 3718e5bb..c827919d 100644 --- a/TESTING/LIN/cchkql.f +++ b/TESTING/LIN/cchkql.f @@ -1,6 +1,6 @@ SUBROUTINE CCHKQL( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, $ NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, AL, AC, - $ B, X, XACT, TAU, WORK, RWORK, IWORK, NOUT ) + $ B, X, XACT, TAU, WORK, RWORK, NOUT ) * * -- LAPACK test routine (version 3.1) -- * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. @@ -13,7 +13,7 @@ * .. * .. Array Arguments .. LOGICAL DOTYPE( * ) - INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ), + INTEGER MVAL( * ), NBVAL( * ), NVAL( * ), $ NXVAL( * ) REAL RWORK( * ) COMPLEX A( * ), AC( * ), AF( * ), AL( * ), AQ( * ), @@ -94,8 +94,6 @@ * * RWORK (workspace) REAL array, dimension (NMAX) * -* IWORK (workspace) INTEGER array, dimension (NMAX) -* * NOUT (input) INTEGER * The unit number for output. * diff --git a/TESTING/LIN/cchkqp.f b/TESTING/LIN/cchkqp.f index cf25cf64..0c6537c6 100644 --- a/TESTING/LIN/cchkqp.f +++ b/TESTING/LIN/cchkqp.f @@ -1,5 +1,5 @@ SUBROUTINE CCHKQP( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A, - $ COPYA, S, COPYS, TAU, WORK, RWORK, IWORK, + $ COPYA, S, TAU, WORK, RWORK, IWORK, $ NOUT ) * * -- LAPACK test routine (version 3.1) -- @@ -14,7 +14,7 @@ * .. Array Arguments .. LOGICAL DOTYPE( * ) INTEGER IWORK( * ), MVAL( * ), NVAL( * ) - REAL COPYS( * ), RWORK( * ), S( * ) + REAL S( * ), RWORK( * ) COMPLEX A( * ), COPYA( * ), TAU( * ), WORK( * ) * .. * @@ -60,9 +60,6 @@ * S (workspace) REAL array, dimension * (min(MMAX,NMAX)) * -* COPYS (workspace) REAL array, dimension -* (min(MMAX,NMAX)) -* * TAU (workspace) COMPLEX array, dimension (MMAX) * * WORK (workspace) COMPLEX array, dimension @@ -180,10 +177,10 @@ CALL CLASET( 'Full', M, N, CMPLX( ZERO ), $ CMPLX( ZERO ), COPYA, LDA ) DO 30 I = 1, MNMIN - COPYS( I ) = ZERO + S( I ) = ZERO 30 CONTINUE ELSE - CALL CLATMS( M, N, 'Uniform', ISEED, 'Nonsymm', COPYS, + CALL CLATMS( M, N, 'Uniform', ISEED, 'Nonsymm', S, $ MODE, ONE / EPS, ONE, M, N, 'No packing', $ COPYA, LDA, WORK, INFO ) IF( IMODE.GE.4 ) THEN @@ -204,7 +201,7 @@ IWORK( I ) = 1 40 CONTINUE END IF - CALL SLAORD( 'Decreasing', MNMIN, COPYS, 1 ) + CALL SLAORD( 'Decreasing', MNMIN, S, 1 ) END IF * * Save A and its singular values @@ -219,7 +216,7 @@ * * Compute norm(svd(a) - svd(r)) * - RESULT( 1 ) = CQRT12( M, N, A, LDA, COPYS, WORK, LWORK, + RESULT( 1 ) = CQRT12( M, N, A, LDA, S, WORK, LWORK, $ RWORK ) * * Compute norm( A*P - Q*R ) diff --git a/TESTING/LIN/cchktz.f b/TESTING/LIN/cchktz.f index 85507041..3cd3ec6f 100644 --- a/TESTING/LIN/cchktz.f +++ b/TESTING/LIN/cchktz.f @@ -1,5 +1,5 @@ SUBROUTINE CCHKTZ( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A, - $ COPYA, S, COPYS, TAU, WORK, RWORK, NOUT ) + $ COPYA, S, TAU, WORK, RWORK, NOUT ) * * -- LAPACK test routine (version 3.1) -- * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. @@ -13,7 +13,7 @@ * .. Array Arguments .. LOGICAL DOTYPE( * ) INTEGER MVAL( * ), NVAL( * ) - REAL COPYS( * ), RWORK( * ), S( * ) + REAL S( * ), RWORK( * ) COMPLEX A( * ), COPYA( * ), TAU( * ), WORK( * ) * .. * @@ -59,9 +59,6 @@ * S (workspace) REAL array, dimension * (min(MMAX,NMAX)) * -* COPYS (workspace) REAL array, dimension -* (min(MMAX,NMAX)) -* * TAU (workspace) COMPLEX array, dimension (MMAX) * * WORK (workspace) COMPLEX array, dimension @@ -152,6 +149,8 @@ * IF( M.LE.N ) THEN DO 50 IMODE = 1, NTYPES + IF( .NOT.DOTYPE( IMODE ) ) + $ GO TO 50 * * Do for each type of singular value distribution. * 0: zero matrix @@ -169,18 +168,18 @@ CALL CLASET( 'Full', M, N, CMPLX( ZERO ), $ CMPLX( ZERO ), A, LDA ) DO 20 I = 1, MNMIN - COPYS( I ) = ZERO + S( I ) = ZERO 20 CONTINUE ELSE CALL CLATMS( M, N, 'Uniform', ISEED, - $ 'Nonsymmetric', COPYS, IMODE, + $ 'Nonsymmetric', S, IMODE, $ ONE / EPS, ONE, M, N, 'No packing', A, $ LDA, WORK, INFO ) CALL CGEQR2( M, N, A, LDA, WORK, WORK( MNMIN+1 ), $ INFO ) CALL CLASET( 'Lower', M-1, N, CMPLX( ZERO ), $ CMPLX( ZERO ), A( 2 ), LDA ) - CALL SLAORD( 'Decreasing', MNMIN, COPYS, 1 ) + CALL SLAORD( 'Decreasing', MNMIN, S, 1 ) END IF * * Save A and its singular values @@ -195,7 +194,7 @@ * * Compute norm(svd(a) - svd(r)) * - RESULT( 1 ) = CQRT12( M, M, A, LDA, COPYS, WORK, + RESULT( 1 ) = CQRT12( M, M, A, LDA, S, WORK, $ LWORK, RWORK ) * * Compute norm( A - R*Q ) @@ -216,18 +215,18 @@ CALL CLASET( 'Full', M, N, CMPLX( ZERO ), $ CMPLX( ZERO ), A, LDA ) DO 30 I = 1, MNMIN - COPYS( I ) = ZERO + S( I ) = ZERO 30 CONTINUE ELSE CALL CLATMS( M, N, 'Uniform', ISEED, - $ 'Nonsymmetric', COPYS, IMODE, + $ 'Nonsymmetric', S, IMODE, $ ONE / EPS, ONE, M, N, 'No packing', A, $ LDA, WORK, INFO ) CALL CGEQR2( M, N, A, LDA, WORK, WORK( MNMIN+1 ), $ INFO ) CALL CLASET( 'Lower', M-1, N, CMPLX( ZERO ), $ CMPLX( ZERO ), A( 2 ), LDA ) - CALL SLAORD( 'Decreasing', MNMIN, COPYS, 1 ) + CALL SLAORD( 'Decreasing', MNMIN, S, 1 ) END IF * * Save A and its singular values @@ -242,7 +241,7 @@ * * Compute norm(svd(a) - svd(r)) * - RESULT( 4 ) = CQRT12( M, M, A, LDA, COPYS, WORK, + RESULT( 4 ) = CQRT12( M, M, A, LDA, S, WORK, $ LWORK, RWORK ) * * Compute norm( A - R*Q ) diff --git a/TESTING/LIN/cdrvgt.f b/TESTING/LIN/cdrvgt.f index ace19204..a4003185 100644 --- a/TESTING/LIN/cdrvgt.f +++ b/TESTING/LIN/cdrvgt.f @@ -368,7 +368,7 @@ $ LDA ) CALL CGTT02( TRANS, N, NRHS, A, A( M+1 ), $ A( N+M+1 ), X, LDA, WORK, LDA, - $ RWORK, RESULT( 2 ) ) + $ RESULT( 2 ) ) * * Check solution from generated exact solution. * @@ -442,7 +442,7 @@ * CALL CLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA ) CALL CGTT02( TRANS, N, NRHS, A, A( M+1 ), - $ A( N+M+1 ), X, LDA, WORK, LDA, RWORK, + $ A( N+M+1 ), X, LDA, WORK, LDA, $ RESULT( 2 ) ) * * Check solution from generated exact solution. diff --git a/TESTING/LIN/cgennd.f b/TESTING/LIN/cgennd.f index 6f7e19b4..5e53f4f7 100644 --- a/TESTING/LIN/cgennd.f +++ b/TESTING/LIN/cgennd.f @@ -39,7 +39,6 @@ PARAMETER ( ZERO = 0.0E0 ) * .. * .. Local Scalars .. - LOGICAL OUT INTEGER I, K COMPLEX AII * .. diff --git a/TESTING/LIN/cgtt02.f b/TESTING/LIN/cgtt02.f index c23a2063..e6bb0ece 100644 --- a/TESTING/LIN/cgtt02.f +++ b/TESTING/LIN/cgtt02.f @@ -1,5 +1,5 @@ SUBROUTINE CGTT02( TRANS, N, NRHS, DL, D, DU, X, LDX, B, LDB, - $ RWORK, RESID ) + $ RESID ) * * -- LAPACK test routine (version 3.1) -- * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. @@ -11,7 +11,6 @@ REAL RESID * .. * .. Array Arguments .. - REAL RWORK( * ) COMPLEX B( LDB, * ), D( * ), DL( * ), DU( * ), $ X( LDX, * ) * .. @@ -63,8 +62,6 @@ * LDB (input) INTEGER * The leading dimension of the array B. LDB >= max(1,N). * -* RWORK (workspace) REAL array, dimension (N) -* * RESID (output) REAL * norm(B - op(A)*X) / (norm(A) * norm(X) * EPS) * diff --git a/TESTING/LIN/dchkaa.f b/TESTING/LIN/dchkaa.f index 9ac2c288..d6e5635b 100644 --- a/TESTING/LIN/dchkaa.f +++ b/TESTING/LIN/dchkaa.f @@ -717,7 +717,7 @@ $ NRHS, THRESH, TSTERR, NMAX, A( 1, 1 ), $ A( 1, 2 ), A( 1, 3 ), A( 1, 4 ), A( 1, 5 ), $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), - $ WORK, RWORK, IWORK, NOUT ) + $ WORK, RWORK, NOUT ) ELSE WRITE( NOUT, FMT = 9989 )PATH END IF @@ -748,11 +748,11 @@ * IF( TSTCHK ) THEN CALL DCHKQP( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, - $ A( 1, 1 ), A( 1, 2 ), B( 1, 1 ), B( 1, 2 ), + $ A( 1, 1 ), A( 1, 2 ), B( 1, 1 ), $ B( 1, 3 ), WORK, IWORK, NOUT ) CALL DCHKQ3( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, $ THRESH, A( 1, 1 ), A( 1, 2 ), B( 1, 1 ), - $ B( 1, 2 ), B( 1, 3 ), WORK, IWORK, NOUT ) + $ B( 1, 3 ), WORK, IWORK, NOUT ) ELSE WRITE( NOUT, FMT = 9989 )PATH END IF @@ -766,7 +766,7 @@ * IF( TSTCHK ) THEN CALL DCHKTZ( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, - $ A( 1, 1 ), A( 1, 2 ), B( 1, 1 ), B( 1, 2 ), + $ A( 1, 1 ), A( 1, 2 ), B( 1, 1 ), $ B( 1, 3 ), WORK, NOUT ) ELSE WRITE( NOUT, FMT = 9989 )PATH diff --git a/TESTING/LIN/dchkab.f b/TESTING/LIN/dchkab.f index 8d02f5e8..5a86cfa1 100644 --- a/TESTING/LIN/dchkab.f +++ b/TESTING/LIN/dchkab.f @@ -333,7 +333,6 @@ 9991 FORMAT( ' Relative machine ', A, ' is taken to be', D16.6 ) 9990 FORMAT( / 1X, A6, ' routines were not tested' ) 9989 FORMAT( / 1X, A6, ' driver routines were not tested' ) - 9988 FORMAT( / 1X, A3, ': Unrecognized path name' ) * * End of DCHKAB * diff --git a/TESTING/LIN/dchkgt.f b/TESTING/LIN/dchkgt.f index 250875b8..30202843 100644 --- a/TESTING/LIN/dchkgt.f +++ b/TESTING/LIN/dchkgt.f @@ -398,7 +398,7 @@ * CALL DLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA ) CALL DGTT02( TRANS, N, NRHS, A, A( M+1 ), A( N+M+1 ), - $ X, LDA, WORK, LDA, RWORK, RESULT( 2 ) ) + $ X, LDA, WORK, LDA, RESULT( 2 ) ) * *+ TEST 3 * Check solution from generated exact solution. diff --git a/TESTING/LIN/dchklq.f b/TESTING/LIN/dchklq.f index 4fb6f33d..310c8020 100644 --- a/TESTING/LIN/dchklq.f +++ b/TESTING/LIN/dchklq.f @@ -1,6 +1,6 @@ SUBROUTINE DCHKLQ( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, $ NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, AL, AC, - $ B, X, XACT, TAU, WORK, RWORK, IWORK, NOUT ) + $ B, X, XACT, TAU, WORK, RWORK, NOUT ) * * -- LAPACK test routine (version 3.1) -- * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. @@ -13,7 +13,7 @@ * .. * .. Array Arguments .. LOGICAL DOTYPE( * ) - INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ), + INTEGER MVAL( * ), NBVAL( * ), NVAL( * ), $ NXVAL( * ) DOUBLE PRECISION A( * ), AC( * ), AF( * ), AL( * ), AQ( * ), $ B( * ), RWORK( * ), TAU( * ), WORK( * ), @@ -94,8 +94,6 @@ * * RWORK (workspace) DOUBLE PRECISION array, dimension (NMAX) * -* IWORK (workspace) INTEGER array, dimension (NMAX) -* * NOUT (input) INTEGER * The unit number for output. * diff --git a/TESTING/LIN/dchkq3.f b/TESTING/LIN/dchkq3.f index 797e42a4..00815921 100644 --- a/TESTING/LIN/dchkq3.f +++ b/TESTING/LIN/dchkq3.f @@ -1,5 +1,5 @@ SUBROUTINE DCHKQ3( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, - $ THRESH, A, COPYA, S, COPYS, TAU, WORK, IWORK, + $ THRESH, A, COPYA, S, TAU, WORK, IWORK, $ NOUT ) * * -- LAPACK test routine (version 3.1.1) -- @@ -14,7 +14,7 @@ LOGICAL DOTYPE( * ) INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ), $ NXVAL( * ) - DOUBLE PRECISION A( * ), COPYA( * ), COPYS( * ), S( * ), + DOUBLE PRECISION A( * ), COPYA( * ), S( * ), $ TAU( * ), WORK( * ) * .. * @@ -68,9 +68,6 @@ * S (workspace) DOUBLE PRECISION array, dimension * (min(MMAX,NMAX)) * -* COPYS (workspace) DOUBLE PRECISION array, dimension -* (min(MMAX,NMAX)) -* * TAU (workspace) DOUBLE PRECISION array, dimension (MMAX) * * WORK (workspace) DOUBLE PRECISION array, dimension @@ -181,10 +178,10 @@ IF( IMODE.EQ.1 ) THEN CALL DLASET( 'Full', M, N, ZERO, ZERO, COPYA, LDA ) DO 30 I = 1, MNMIN - COPYS( I ) = ZERO + S( I ) = ZERO 30 CONTINUE ELSE - CALL DLATMS( M, N, 'Uniform', ISEED, 'Nonsymm', COPYS, + CALL DLATMS( M, N, 'Uniform', ISEED, 'Nonsymm', S, $ MODE, ONE / EPS, ONE, M, N, 'No packing', $ COPYA, LDA, WORK, INFO ) IF( IMODE.GE.4 ) THEN @@ -205,7 +202,7 @@ IWORK( I ) = 1 40 CONTINUE END IF - CALL DLAORD( 'Decreasing', MNMIN, COPYS, 1 ) + CALL DLAORD( 'Decreasing', MNMIN, S, 1 ) END IF * DO 60 INB = 1, NNB @@ -235,7 +232,7 @@ * * Compute norm(svd(a) - svd(r)) * - RESULT( 1 ) = DQRT12( M, N, A, LDA, COPYS, WORK, + RESULT( 1 ) = DQRT12( M, N, A, LDA, S, WORK, $ LWORK ) * * Compute norm( A*P - Q*R ) diff --git a/TESTING/LIN/dchkqp.f b/TESTING/LIN/dchkqp.f index ce04030d..2bee2177 100644 --- a/TESTING/LIN/dchkqp.f +++ b/TESTING/LIN/dchkqp.f @@ -1,5 +1,5 @@ SUBROUTINE DCHKQP( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A, - $ COPYA, S, COPYS, TAU, WORK, IWORK, NOUT ) + $ COPYA, S, TAU, WORK, IWORK, NOUT ) * * -- LAPACK test routine (version 3.1.1) -- * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. @@ -13,7 +13,7 @@ * .. Array Arguments .. LOGICAL DOTYPE( * ) INTEGER IWORK( * ), MVAL( * ), NVAL( * ) - DOUBLE PRECISION A( * ), COPYA( * ), COPYS( * ), S( * ), + DOUBLE PRECISION A( * ), COPYA( * ), S( * ), $ TAU( * ), WORK( * ) * .. * @@ -59,9 +59,6 @@ * S (workspace) DOUBLE PRECISION array, dimension * (min(MMAX,NMAX)) * -* COPYS (workspace) DOUBLE PRECISION array, dimension -* (min(MMAX,NMAX)) -* * TAU (workspace) DOUBLE PRECISION array, dimension (MMAX) * * WORK (workspace) DOUBLE PRECISION array, dimension @@ -177,10 +174,10 @@ IF( IMODE.EQ.1 ) THEN CALL DLASET( 'Full', M, N, ZERO, ZERO, COPYA, LDA ) DO 30 I = 1, MNMIN - COPYS( I ) = ZERO + S( I ) = ZERO 30 CONTINUE ELSE - CALL DLATMS( M, N, 'Uniform', ISEED, 'Nonsymm', COPYS, + CALL DLATMS( M, N, 'Uniform', ISEED, 'Nonsymm', S, $ MODE, ONE / EPS, ONE, M, N, 'No packing', $ COPYA, LDA, WORK, INFO ) IF( IMODE.GE.4 ) THEN @@ -201,7 +198,7 @@ IWORK( I ) = 1 40 CONTINUE END IF - CALL DLAORD( 'Decreasing', MNMIN, COPYS, 1 ) + CALL DLAORD( 'Decreasing', MNMIN, S, 1 ) END IF * * Save A and its singular values @@ -215,7 +212,7 @@ * * Compute norm(svd(a) - svd(r)) * - RESULT( 1 ) = DQRT12( M, N, A, LDA, COPYS, WORK, LWORK ) + RESULT( 1 ) = DQRT12( M, N, A, LDA, S, WORK, LWORK ) * * Compute norm( A*P - Q*R ) * diff --git a/TESTING/LIN/dchksy.f b/TESTING/LIN/dchksy.f index 5ec38242..785a49d2 100644 --- a/TESTING/LIN/dchksy.f +++ b/TESTING/LIN/dchksy.f @@ -108,7 +108,6 @@ CHARACTER UPLOS( 2 ) INTEGER ISEED( 4 ), ISEEDY( 4 ) DOUBLE PRECISION RESULT( NTESTS ) - DOUBLE PRECISION MYWORK( NTESTS ) * .. * .. External Functions .. DOUBLE PRECISION DGET06, DLANSY diff --git a/TESTING/LIN/dchktz.f b/TESTING/LIN/dchktz.f index 9d7699c1..9e504be3 100644 --- a/TESTING/LIN/dchktz.f +++ b/TESTING/LIN/dchktz.f @@ -1,5 +1,5 @@ SUBROUTINE DCHKTZ( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A, - $ COPYA, S, COPYS, TAU, WORK, NOUT ) + $ COPYA, S, TAU, WORK, NOUT ) * * -- LAPACK test routine (version 3.1.1) -- * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. @@ -13,7 +13,7 @@ * .. Array Arguments .. LOGICAL DOTYPE( * ) INTEGER MVAL( * ), NVAL( * ) - DOUBLE PRECISION A( * ), COPYA( * ), COPYS( * ), S( * ), + DOUBLE PRECISION A( * ), COPYA( * ), S( * ), $ TAU( * ), WORK( * ) * .. * @@ -59,9 +59,6 @@ * S (workspace) DOUBLE PRECISION array, dimension * (min(MMAX,NMAX)) * -* COPYS (workspace) DOUBLE PRECISION array, dimension -* (min(MMAX,NMAX)) -* * TAU (workspace) DOUBLE PRECISION array, dimension (MMAX) * * WORK (workspace) DOUBLE PRECISION array, dimension @@ -168,18 +165,18 @@ IF( MODE.EQ.0 ) THEN CALL DLASET( 'Full', M, N, ZERO, ZERO, A, LDA ) DO 20 I = 1, MNMIN - COPYS( I ) = ZERO + S( I ) = ZERO 20 CONTINUE ELSE CALL DLATMS( M, N, 'Uniform', ISEED, - $ 'Nonsymmetric', COPYS, IMODE, + $ 'Nonsymmetric', S, IMODE, $ ONE / EPS, ONE, M, N, 'No packing', A, $ LDA, WORK, INFO ) CALL DGEQR2( M, N, A, LDA, WORK, WORK( MNMIN+1 ), $ INFO ) CALL DLASET( 'Lower', M-1, N, ZERO, ZERO, A( 2 ), $ LDA ) - CALL DLAORD( 'Decreasing', MNMIN, COPYS, 1 ) + CALL DLAORD( 'Decreasing', MNMIN, S, 1 ) END IF * * Save A and its singular values @@ -194,7 +191,7 @@ * * Compute norm(svd(a) - svd(r)) * - RESULT( 1 ) = DQRT12( M, M, A, LDA, COPYS, WORK, + RESULT( 1 ) = DQRT12( M, M, A, LDA, S, WORK, $ LWORK ) * * Compute norm( A - R*Q ) @@ -214,18 +211,18 @@ IF( MODE.EQ.0 ) THEN CALL DLASET( 'Full', M, N, ZERO, ZERO, A, LDA ) DO 30 I = 1, MNMIN - COPYS( I ) = ZERO + S( I ) = ZERO 30 CONTINUE ELSE CALL DLATMS( M, N, 'Uniform', ISEED, - $ 'Nonsymmetric', COPYS, IMODE, + $ 'Nonsymmetric', S, IMODE, $ ONE / EPS, ONE, M, N, 'No packing', A, $ LDA, WORK, INFO ) CALL DGEQR2( M, N, A, LDA, WORK, WORK( MNMIN+1 ), $ INFO ) CALL DLASET( 'Lower', M-1, N, ZERO, ZERO, A( 2 ), $ LDA ) - CALL DLAORD( 'Decreasing', MNMIN, COPYS, 1 ) + CALL DLAORD( 'Decreasing', MNMIN, S, 1 ) END IF * * Save A and its singular values @@ -240,7 +237,7 @@ * * Compute norm(svd(a) - svd(r)) * - RESULT( 4 ) = DQRT12( M, M, A, LDA, COPYS, WORK, + RESULT( 4 ) = DQRT12( M, M, A, LDA, S, WORK, $ LWORK ) * * Compute norm( A - R*Q ) diff --git a/TESTING/LIN/ddrvac.f b/TESTING/LIN/ddrvac.f index 417f9427..be2fbc4e 100644 --- a/TESTING/LIN/ddrvac.f +++ b/TESTING/LIN/ddrvac.f @@ -319,8 +319,6 @@ 110 CONTINUE 120 CONTINUE * - 130 CONTINUE -* * Print a summary of the results. * IF( NFAIL.GT.0 ) THEN diff --git a/TESTING/LIN/ddrvgt.f b/TESTING/LIN/ddrvgt.f index 4f7c4111..a8675c88 100644 --- a/TESTING/LIN/ddrvgt.f +++ b/TESTING/LIN/ddrvgt.f @@ -368,7 +368,7 @@ $ LDA ) CALL DGTT02( TRANS, N, NRHS, A, A( M+1 ), $ A( N+M+1 ), X, LDA, WORK, LDA, - $ RWORK, RESULT( 2 ) ) + $ RESULT( 2 ) ) * * Check solution from generated exact solution. * @@ -441,7 +441,7 @@ * CALL DLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA ) CALL DGTT02( TRANS, N, NRHS, A, A( M+1 ), - $ A( N+M+1 ), X, LDA, WORK, LDA, RWORK, + $ A( N+M+1 ), X, LDA, WORK, LDA, $ RESULT( 2 ) ) * * Check solution from generated exact solution. diff --git a/TESTING/LIN/dgtt02.f b/TESTING/LIN/dgtt02.f index c5d6930f..a4710c56 100644 --- a/TESTING/LIN/dgtt02.f +++ b/TESTING/LIN/dgtt02.f @@ -1,5 +1,5 @@ SUBROUTINE DGTT02( TRANS, N, NRHS, DL, D, DU, X, LDX, B, LDB, - $ RWORK, RESID ) + $ RESID ) * * -- LAPACK test routine (version 3.1) -- * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. @@ -12,7 +12,7 @@ * .. * .. Array Arguments .. DOUBLE PRECISION B( LDB, * ), D( * ), DL( * ), DU( * ), - $ RWORK( * ), X( LDX, * ) + $ X( LDX, * ) * .. * * Purpose @@ -62,8 +62,6 @@ * LDB (input) INTEGER * The leading dimension of the array B. LDB >= max(1,N). * -* RWORK (workspace) DOUBLE PRECISION array, dimension (N) -* * RESID (output) DOUBLE PRECISION * norm(B - op(A)*X) / (norm(A) * norm(X) * EPS) * diff --git a/TESTING/LIN/schkaa.f b/TESTING/LIN/schkaa.f index 1251afd7..45f3d189 100644 --- a/TESTING/LIN/schkaa.f +++ b/TESTING/LIN/schkaa.f @@ -700,7 +700,7 @@ $ NRHS, THRESH, TSTERR, NMAX, A( 1, 1 ), $ A( 1, 2 ), A( 1, 3 ), A( 1, 4 ), A( 1, 5 ), $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), - $ WORK, RWORK, IWORK, NOUT ) + $ WORK, RWORK, NOUT ) ELSE WRITE( NOUT, FMT = 9989 )PATH END IF @@ -717,7 +717,7 @@ $ NRHS, THRESH, TSTERR, NMAX, A( 1, 1 ), $ A( 1, 2 ), A( 1, 3 ), A( 1, 4 ), A( 1, 5 ), $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), - $ WORK, RWORK, IWORK, NOUT ) + $ WORK, RWORK, NOUT ) ELSE WRITE( NOUT, FMT = 9989 )PATH END IF @@ -748,11 +748,11 @@ * IF( TSTCHK ) THEN CALL SCHKQP( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, - $ A( 1, 1 ), A( 1, 2 ), B( 1, 1 ), B( 1, 2 ), + $ A( 1, 1 ), A( 1, 2 ), B( 1, 1 ), $ B( 1, 3 ), WORK, IWORK, NOUT ) CALL SCHKQ3( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, $ THRESH, A( 1, 1 ), A( 1, 2 ), B( 1, 1 ), - $ B( 1, 2 ), B( 1, 3 ), WORK, IWORK, NOUT ) + $ B( 1, 3 ), WORK, IWORK, NOUT ) ELSE WRITE( NOUT, FMT = 9989 )PATH END IF @@ -766,7 +766,7 @@ * IF( TSTCHK ) THEN CALL SCHKTZ( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, - $ A( 1, 1 ), A( 1, 2 ), B( 1, 1 ), B( 1, 2 ), + $ A( 1, 1 ), A( 1, 2 ), B( 1, 1 ), $ B( 1, 3 ), WORK, NOUT ) ELSE WRITE( NOUT, FMT = 9989 )PATH diff --git a/TESTING/LIN/schkgt.f b/TESTING/LIN/schkgt.f index 8e7a2f7d..21f7e316 100644 --- a/TESTING/LIN/schkgt.f +++ b/TESTING/LIN/schkgt.f @@ -398,7 +398,7 @@ * CALL SLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA ) CALL SGTT02( TRANS, N, NRHS, A, A( M+1 ), A( N+M+1 ), - $ X, LDA, WORK, LDA, RWORK, RESULT( 2 ) ) + $ X, LDA, WORK, LDA, RESULT( 2 ) ) * *+ TEST 3 * Check solution from generated exact solution. diff --git a/TESTING/LIN/schklq.f b/TESTING/LIN/schklq.f index 38a59066..a6ccabd5 100644 --- a/TESTING/LIN/schklq.f +++ b/TESTING/LIN/schklq.f @@ -1,6 +1,6 @@ SUBROUTINE SCHKLQ( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, $ NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, AL, AC, - $ B, X, XACT, TAU, WORK, RWORK, IWORK, NOUT ) + $ B, X, XACT, TAU, WORK, RWORK, NOUT ) * * -- LAPACK test routine (version 3.1) -- * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. @@ -13,7 +13,7 @@ * .. * .. Array Arguments .. LOGICAL DOTYPE( * ) - INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ), + INTEGER MVAL( * ), NBVAL( * ), NVAL( * ), $ NXVAL( * ) REAL A( * ), AC( * ), AF( * ), AL( * ), AQ( * ), $ B( * ), RWORK( * ), TAU( * ), WORK( * ), @@ -94,8 +94,6 @@ * * RWORK (workspace) REAL array, dimension (NMAX) * -* IWORK (workspace) INTEGER array, dimension (NMAX) -* * NOUT (input) INTEGER * The unit number for output. * diff --git a/TESTING/LIN/schkq3.f b/TESTING/LIN/schkq3.f index e32861d7..b68109e7 100644 --- a/TESTING/LIN/schkq3.f +++ b/TESTING/LIN/schkq3.f @@ -1,5 +1,5 @@ SUBROUTINE SCHKQ3( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, - $ THRESH, A, COPYA, S, COPYS, TAU, WORK, IWORK, + $ THRESH, A, COPYA, S, TAU, WORK, IWORK, $ NOUT ) * * -- LAPACK test routine (version 3.1.1) -- @@ -14,7 +14,7 @@ LOGICAL DOTYPE( * ) INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ), $ NXVAL( * ) - REAL A( * ), COPYA( * ), COPYS( * ), S( * ), + REAL A( * ), COPYA( * ), S( * ), $ TAU( * ), WORK( * ) * .. * @@ -68,9 +68,6 @@ * S (workspace) REAL array, dimension * (min(MMAX,NMAX)) * -* COPYS (workspace) REAL array, dimension -* (min(MMAX,NMAX)) -* * TAU (workspace) REAL array, dimension (MMAX) * * WORK (workspace) REAL array, dimension @@ -181,10 +178,10 @@ IF( IMODE.EQ.1 ) THEN CALL SLASET( 'Full', M, N, ZERO, ZERO, COPYA, LDA ) DO 30 I = 1, MNMIN - COPYS( I ) = ZERO + S( I ) = ZERO 30 CONTINUE ELSE - CALL SLATMS( M, N, 'Uniform', ISEED, 'Nonsymm', COPYS, + CALL SLATMS( M, N, 'Uniform', ISEED, 'Nonsymm', S, $ MODE, ONE / EPS, ONE, M, N, 'No packing', $ COPYA, LDA, WORK, INFO ) IF( IMODE.GE.4 ) THEN @@ -205,7 +202,7 @@ IWORK( I ) = 1 40 CONTINUE END IF - CALL SLAORD( 'Decreasing', MNMIN, COPYS, 1 ) + CALL SLAORD( 'Decreasing', MNMIN, S, 1 ) END IF * DO 60 INB = 1, NNB @@ -235,7 +232,7 @@ * * Compute norm(svd(a) - svd(r)) * - RESULT( 1 ) = SQRT12( M, N, A, LDA, COPYS, WORK, + RESULT( 1 ) = SQRT12( M, N, A, LDA, S, WORK, $ LWORK ) * * Compute norm( A*P - Q*R ) diff --git a/TESTING/LIN/schkql.f b/TESTING/LIN/schkql.f index 09d98dec..e5778d50 100644 --- a/TESTING/LIN/schkql.f +++ b/TESTING/LIN/schkql.f @@ -1,6 +1,6 @@ SUBROUTINE SCHKQL( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, $ NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, AL, AC, - $ B, X, XACT, TAU, WORK, RWORK, IWORK, NOUT ) + $ B, X, XACT, TAU, WORK, RWORK, NOUT ) * * -- LAPACK test routine (version 3.1) -- * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. @@ -13,7 +13,7 @@ * .. * .. Array Arguments .. LOGICAL DOTYPE( * ) - INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ), + INTEGER MVAL( * ), NBVAL( * ), NVAL( * ), $ NXVAL( * ) REAL A( * ), AC( * ), AF( * ), AL( * ), AQ( * ), $ B( * ), RWORK( * ), TAU( * ), WORK( * ), @@ -94,8 +94,6 @@ * * RWORK (workspace) REAL array, dimension (NMAX) * -* IWORK (workspace) INTEGER array, dimension (NMAX) -* * NOUT (input) INTEGER * The unit number for output. * diff --git a/TESTING/LIN/schkqp.f b/TESTING/LIN/schkqp.f index 4c27e013..03da7e7e 100644 --- a/TESTING/LIN/schkqp.f +++ b/TESTING/LIN/schkqp.f @@ -1,5 +1,5 @@ SUBROUTINE SCHKQP( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A, - $ COPYA, S, COPYS, TAU, WORK, IWORK, NOUT ) + $ COPYA, S, TAU, WORK, IWORK, NOUT ) * * -- LAPACK test routine (version 3.1.1) -- * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. @@ -13,7 +13,7 @@ * .. Array Arguments .. LOGICAL DOTYPE( * ) INTEGER IWORK( * ), MVAL( * ), NVAL( * ) - REAL A( * ), COPYA( * ), COPYS( * ), S( * ), + REAL A( * ), COPYA( * ), S( * ), $ TAU( * ), WORK( * ) * .. * @@ -59,9 +59,6 @@ * S (workspace) REAL array, dimension * (min(MMAX,NMAX)) * -* COPYS (workspace) REAL array, dimension -* (min(MMAX,NMAX)) -* * TAU (workspace) REAL array, dimension (MMAX) * * WORK (workspace) REAL array, dimension @@ -177,10 +174,10 @@ IF( IMODE.EQ.1 ) THEN CALL SLASET( 'Full', M, N, ZERO, ZERO, COPYA, LDA ) DO 30 I = 1, MNMIN - COPYS( I ) = ZERO + S( I ) = ZERO 30 CONTINUE ELSE - CALL SLATMS( M, N, 'Uniform', ISEED, 'Nonsymm', COPYS, + CALL SLATMS( M, N, 'Uniform', ISEED, 'Nonsymm', S, $ MODE, ONE / EPS, ONE, M, N, 'No packing', $ COPYA, LDA, WORK, INFO ) IF( IMODE.GE.4 ) THEN @@ -201,7 +198,7 @@ IWORK( I ) = 1 40 CONTINUE END IF - CALL SLAORD( 'Decreasing', MNMIN, COPYS, 1 ) + CALL SLAORD( 'Decreasing', MNMIN, S, 1 ) END IF * * Save A and its singular values @@ -215,7 +212,7 @@ * * Compute norm(svd(a) - svd(r)) * - RESULT( 1 ) = SQRT12( M, N, A, LDA, COPYS, WORK, LWORK ) + RESULT( 1 ) = SQRT12( M, N, A, LDA, S, WORK, LWORK ) * * Compute norm( A*P - Q*R ) * diff --git a/TESTING/LIN/schktz.f b/TESTING/LIN/schktz.f index 12837154..f1f1f580 100644 --- a/TESTING/LIN/schktz.f +++ b/TESTING/LIN/schktz.f @@ -1,5 +1,5 @@ SUBROUTINE SCHKTZ( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A, - $ COPYA, S, COPYS, TAU, WORK, NOUT ) + $ COPYA, S, TAU, WORK, NOUT ) * * -- LAPACK test routine (version 3.1.1) -- * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. @@ -13,7 +13,7 @@ * .. Array Arguments .. LOGICAL DOTYPE( * ) INTEGER MVAL( * ), NVAL( * ) - REAL A( * ), COPYA( * ), COPYS( * ), S( * ), + REAL A( * ), COPYA( * ), S( * ), $ TAU( * ), WORK( * ) * .. * @@ -59,9 +59,6 @@ * S (workspace) REAL array, dimension * (min(MMAX,NMAX)) * -* COPYS (workspace) REAL array, dimension -* (min(MMAX,NMAX)) -* * TAU (workspace) REAL array, dimension (MMAX) * * WORK (workspace) REAL array, dimension @@ -168,18 +165,18 @@ IF( MODE.EQ.0 ) THEN CALL SLASET( 'Full', M, N, ZERO, ZERO, A, LDA ) DO 20 I = 1, MNMIN - COPYS( I ) = ZERO + S( I ) = ZERO 20 CONTINUE ELSE CALL SLATMS( M, N, 'Uniform', ISEED, - $ 'Nonsymmetric', COPYS, IMODE, + $ 'Nonsymmetric', S, IMODE, $ ONE / EPS, ONE, M, N, 'No packing', A, $ LDA, WORK, INFO ) CALL SGEQR2( M, N, A, LDA, WORK, WORK( MNMIN+1 ), $ INFO ) CALL SLASET( 'Lower', M-1, N, ZERO, ZERO, A( 2 ), $ LDA ) - CALL SLAORD( 'Decreasing', MNMIN, COPYS, 1 ) + CALL SLAORD( 'Decreasing', MNMIN, S, 1 ) END IF * * Save A and its singular values @@ -194,7 +191,7 @@ * * Compute norm(svd(a) - svd(r)) * - RESULT( 1 ) = SQRT12( M, M, A, LDA, COPYS, WORK, + RESULT( 1 ) = SQRT12( M, M, A, LDA, S, WORK, $ LWORK ) * * Compute norm( A - R*Q ) @@ -214,18 +211,18 @@ IF( MODE.EQ.0 ) THEN CALL SLASET( 'Full', M, N, ZERO, ZERO, A, LDA ) DO 30 I = 1, MNMIN - COPYS( I ) = ZERO + S( I ) = ZERO 30 CONTINUE ELSE CALL SLATMS( M, N, 'Uniform', ISEED, - $ 'Nonsymmetric', COPYS, IMODE, + $ 'Nonsymmetric', S, IMODE, $ ONE / EPS, ONE, M, N, 'No packing', A, $ LDA, WORK, INFO ) CALL SGEQR2( M, N, A, LDA, WORK, WORK( MNMIN+1 ), $ INFO ) CALL SLASET( 'Lower', M-1, N, ZERO, ZERO, A( 2 ), $ LDA ) - CALL SLAORD( 'Decreasing', MNMIN, COPYS, 1 ) + CALL SLAORD( 'Decreasing', MNMIN, S, 1 ) END IF * * Save A and its singular values @@ -240,7 +237,7 @@ * * Compute norm(svd(a) - svd(r)) * - RESULT( 4 ) = SQRT12( M, M, A, LDA, COPYS, WORK, + RESULT( 4 ) = SQRT12( M, M, A, LDA, S, WORK, $ LWORK ) * * Compute norm( A - R*Q ) diff --git a/TESTING/LIN/sdrvgt.f b/TESTING/LIN/sdrvgt.f index 908383dd..0f6243a9 100644 --- a/TESTING/LIN/sdrvgt.f +++ b/TESTING/LIN/sdrvgt.f @@ -368,7 +368,7 @@ $ LDA ) CALL SGTT02( TRANS, N, NRHS, A, A( M+1 ), $ A( N+M+1 ), X, LDA, WORK, LDA, - $ RWORK, RESULT( 2 ) ) + $ RESULT( 2 ) ) * * Check solution from generated exact solution. * @@ -441,7 +441,7 @@ * CALL SLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA ) CALL SGTT02( TRANS, N, NRHS, A, A( M+1 ), - $ A( N+M+1 ), X, LDA, WORK, LDA, RWORK, + $ A( N+M+1 ), X, LDA, WORK, LDA, $ RESULT( 2 ) ) * * Check solution from generated exact solution. diff --git a/TESTING/LIN/sgtt02.f b/TESTING/LIN/sgtt02.f index afc1fa91..9730b3c4 100644 --- a/TESTING/LIN/sgtt02.f +++ b/TESTING/LIN/sgtt02.f @@ -1,5 +1,5 @@ SUBROUTINE SGTT02( TRANS, N, NRHS, DL, D, DU, X, LDX, B, LDB, - $ RWORK, RESID ) + $ RESID ) * * -- LAPACK test routine (version 3.1) -- * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. @@ -12,7 +12,7 @@ * .. * .. Array Arguments .. REAL B( LDB, * ), D( * ), DL( * ), DU( * ), - $ RWORK( * ), X( LDX, * ) + $ X( LDX, * ) * .. * * Purpose @@ -62,8 +62,6 @@ * LDB (input) INTEGER * The leading dimension of the array B. LDB >= max(1,N). * -* RWORK (workspace) REAL array, dimension (N) -* * RESID (output) REAL * norm(B - op(A)*X) / (norm(A) * norm(X) * EPS) * diff --git a/TESTING/LIN/zchkaa.f b/TESTING/LIN/zchkaa.f index ac47b6ca..1cfd0428 100644 --- a/TESTING/LIN/zchkaa.f +++ b/TESTING/LIN/zchkaa.f @@ -749,7 +749,7 @@ $ NRHS, THRESH, TSTERR, NMAX, A( 1, 1 ), $ A( 1, 2 ), A( 1, 3 ), A( 1, 4 ), A( 1, 5 ), $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), - $ WORK, RWORK, IWORK, NOUT ) + $ WORK, RWORK, NOUT ) ELSE WRITE( NOUT, FMT = 9989 )PATH END IF @@ -766,7 +766,7 @@ $ NRHS, THRESH, TSTERR, NMAX, A( 1, 1 ), $ A( 1, 2 ), A( 1, 3 ), A( 1, 4 ), A( 1, 5 ), $ B( 1, 1 ), B( 1, 2 ), B( 1, 3 ), B( 1, 4 ), - $ WORK, RWORK, IWORK, NOUT ) + $ WORK, RWORK, NOUT ) ELSE WRITE( NOUT, FMT = 9989 )PATH END IF @@ -808,7 +808,7 @@ * IF( TSTCHK ) THEN CALL ZCHKTZ( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, - $ A( 1, 1 ), A( 1, 2 ), S( 1 ), S( NMAX+1 ), + $ A( 1, 1 ), A( 1, 2 ), S( 1 ), $ B( 1, 1 ), WORK, RWORK, NOUT ) ELSE WRITE( NOUT, FMT = 9989 )PATH @@ -823,11 +823,11 @@ * IF( TSTCHK ) THEN CALL ZCHKQP( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, - $ A( 1, 1 ), A( 1, 2 ), S( 1 ), S( NMAX+1 ), + $ A( 1, 1 ), A( 1, 2 ), S( 1 ), $ B( 1, 1 ), WORK, RWORK, IWORK, NOUT ) CALL ZCHKQ3( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, $ THRESH, A( 1, 1 ), A( 1, 2 ), S( 1 ), - $ S( NMAX+1 ), B( 1, 1 ), WORK, RWORK, IWORK, + $ B( 1, 1 ), WORK, RWORK, IWORK, $ NOUT ) ELSE WRITE( NOUT, FMT = 9989 )PATH diff --git a/TESTING/LIN/zchkab.f b/TESTING/LIN/zchkab.f index cea02b0e..36e8e600 100644 --- a/TESTING/LIN/zchkab.f +++ b/TESTING/LIN/zchkab.f @@ -333,7 +333,6 @@ 9991 FORMAT( ' Relative machine ', A, ' is taken to be', D16.6 ) 9990 FORMAT( / 1X, A6, ' routines were not tested' ) 9989 FORMAT( / 1X, A6, ' driver routines were not tested' ) - 9988 FORMAT( / 1X, A3, ': Unrecognized path name' ) * * End of ZCHKAB * diff --git a/TESTING/LIN/zchkgt.f b/TESTING/LIN/zchkgt.f index 47fa3fa3..601afb99 100644 --- a/TESTING/LIN/zchkgt.f +++ b/TESTING/LIN/zchkgt.f @@ -400,7 +400,7 @@ * CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA ) CALL ZGTT02( TRANS, N, NRHS, A, A( M+1 ), A( N+M+1 ), - $ X, LDA, WORK, LDA, RWORK, RESULT( 2 ) ) + $ X, LDA, WORK, LDA, RESULT( 2 ) ) * *+ TEST 3 * Check solution from generated exact solution. diff --git a/TESTING/LIN/zchklq.f b/TESTING/LIN/zchklq.f index 620d1983..0307a4f7 100644 --- a/TESTING/LIN/zchklq.f +++ b/TESTING/LIN/zchklq.f @@ -1,6 +1,6 @@ SUBROUTINE ZCHKLQ( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, $ NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, AL, AC, - $ B, X, XACT, TAU, WORK, RWORK, IWORK, NOUT ) + $ B, X, XACT, TAU, WORK, RWORK, NOUT ) * * -- LAPACK test routine (version 3.1) -- * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. @@ -13,7 +13,7 @@ * .. * .. Array Arguments .. LOGICAL DOTYPE( * ) - INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ), + INTEGER MVAL( * ), NBVAL( * ), NVAL( * ), $ NXVAL( * ) DOUBLE PRECISION RWORK( * ) COMPLEX*16 A( * ), AC( * ), AF( * ), AL( * ), AQ( * ), @@ -94,8 +94,6 @@ * * RWORK (workspace) DOUBLE PRECISION array, dimension (NMAX) * -* IWORK (workspace) INTEGER array, dimension (NMAX) -* * NOUT (input) INTEGER * The unit number for output. * diff --git a/TESTING/LIN/zchkq3.f b/TESTING/LIN/zchkq3.f index d3dcac68..8cb77610 100644 --- a/TESTING/LIN/zchkq3.f +++ b/TESTING/LIN/zchkq3.f @@ -1,5 +1,5 @@ SUBROUTINE ZCHKQ3( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, - $ THRESH, A, COPYA, S, COPYS, TAU, WORK, RWORK, + $ THRESH, A, COPYA, S, TAU, WORK, RWORK, $ IWORK, NOUT ) * * -- LAPACK test routine (version 3.1) -- @@ -14,7 +14,7 @@ LOGICAL DOTYPE( * ) INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ), $ NXVAL( * ) - DOUBLE PRECISION COPYS( * ), RWORK( * ), S( * ) + DOUBLE PRECISION S( * ), RWORK( * ) COMPLEX*16 A( * ), COPYA( * ), TAU( * ), WORK( * ) * .. * @@ -68,9 +68,6 @@ * S (workspace) DOUBLE PRECISION array, dimension * (min(MMAX,NMAX)) * -* COPYS (workspace) DOUBLE PRECISION array, dimension -* (min(MMAX,NMAX)) -* * TAU (workspace) COMPLEX*16 array, dimension (MMAX) * * WORK (workspace) COMPLEX*16 array, dimension @@ -184,10 +181,10 @@ IF( IMODE.EQ.1 ) THEN CALL ZLASET( 'Full', M, N, CZERO, CZERO, COPYA, LDA ) DO 30 I = 1, MNMIN - COPYS( I ) = ZERO + S( I ) = ZERO 30 CONTINUE ELSE - CALL ZLATMS( M, N, 'Uniform', ISEED, 'Nonsymm', COPYS, + CALL ZLATMS( M, N, 'Uniform', ISEED, 'Nonsymm', S, $ MODE, ONE / EPS, ONE, M, N, 'No packing', $ COPYA, LDA, WORK, INFO ) IF( IMODE.GE.4 ) THEN @@ -208,7 +205,7 @@ IWORK( I ) = 1 40 CONTINUE END IF - CALL DLAORD( 'Decreasing', MNMIN, COPYS, 1 ) + CALL DLAORD( 'Decreasing', MNMIN, S, 1 ) END IF * DO 60 INB = 1, NNB @@ -236,7 +233,7 @@ * * Compute norm(svd(a) - svd(r)) * - RESULT( 1 ) = ZQRT12( M, N, A, LDA, COPYS, WORK, + RESULT( 1 ) = ZQRT12( M, N, A, LDA, S, WORK, $ LWORK, RWORK ) * * Compute norm( A*P - Q*R ) diff --git a/TESTING/LIN/zchkql.f b/TESTING/LIN/zchkql.f index e7fcbce1..1976af84 100644 --- a/TESTING/LIN/zchkql.f +++ b/TESTING/LIN/zchkql.f @@ -1,6 +1,6 @@ SUBROUTINE ZCHKQL( DOTYPE, NM, MVAL, NN, NVAL, NNB, NBVAL, NXVAL, $ NRHS, THRESH, TSTERR, NMAX, A, AF, AQ, AL, AC, - $ B, X, XACT, TAU, WORK, RWORK, IWORK, NOUT ) + $ B, X, XACT, TAU, WORK, RWORK, NOUT ) * * -- LAPACK test routine (version 3.1) -- * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. @@ -13,7 +13,7 @@ * .. * .. Array Arguments .. LOGICAL DOTYPE( * ) - INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ), + INTEGER MVAL( * ), NBVAL( * ), NVAL( * ), $ NXVAL( * ) DOUBLE PRECISION RWORK( * ) COMPLEX*16 A( * ), AC( * ), AF( * ), AL( * ), AQ( * ), @@ -94,8 +94,6 @@ * * RWORK (workspace) DOUBLE PRECISION array, dimension (NMAX) * -* IWORK (workspace) INTEGER array, dimension (NMAX) -* * NOUT (input) INTEGER * The unit number for output. * diff --git a/TESTING/LIN/zchkqp.f b/TESTING/LIN/zchkqp.f index 2ed2f7a4..724fea2a 100644 --- a/TESTING/LIN/zchkqp.f +++ b/TESTING/LIN/zchkqp.f @@ -1,5 +1,5 @@ SUBROUTINE ZCHKQP( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A, - $ COPYA, S, COPYS, TAU, WORK, RWORK, IWORK, + $ COPYA, S, TAU, WORK, RWORK, IWORK, $ NOUT ) * * -- LAPACK test routine (version 3.1) -- @@ -14,7 +14,7 @@ * .. Array Arguments .. LOGICAL DOTYPE( * ) INTEGER IWORK( * ), MVAL( * ), NVAL( * ) - DOUBLE PRECISION COPYS( * ), RWORK( * ), S( * ) + DOUBLE PRECISION S( * ), RWORK( * ) COMPLEX*16 A( * ), COPYA( * ), TAU( * ), WORK( * ) * .. * @@ -60,9 +60,6 @@ * S (workspace) DOUBLE PRECISION array, dimension * (min(MMAX,NMAX)) * -* COPYS (workspace) DOUBLE PRECISION array, dimension -* (min(MMAX,NMAX)) -* * TAU (workspace) COMPLEX*16 array, dimension (MMAX) * * WORK (workspace) COMPLEX*16 array, dimension @@ -180,10 +177,10 @@ CALL ZLASET( 'Full', M, N, DCMPLX( ZERO ), $ DCMPLX( ZERO ), COPYA, LDA ) DO 30 I = 1, MNMIN - COPYS( I ) = ZERO + S( I ) = ZERO 30 CONTINUE ELSE - CALL ZLATMS( M, N, 'Uniform', ISEED, 'Nonsymm', COPYS, + CALL ZLATMS( M, N, 'Uniform', ISEED, 'Nonsymm', S, $ MODE, ONE / EPS, ONE, M, N, 'No packing', $ COPYA, LDA, WORK, INFO ) IF( IMODE.GE.4 ) THEN @@ -204,7 +201,7 @@ IWORK( I ) = 1 40 CONTINUE END IF - CALL DLAORD( 'Decreasing', MNMIN, COPYS, 1 ) + CALL DLAORD( 'Decreasing', MNMIN, S, 1 ) END IF * * Save A and its singular values @@ -219,7 +216,7 @@ * * Compute norm(svd(a) - svd(r)) * - RESULT( 1 ) = ZQRT12( M, N, A, LDA, COPYS, WORK, LWORK, + RESULT( 1 ) = ZQRT12( M, N, A, LDA, S, WORK, LWORK, $ RWORK ) * * Compute norm( A*P - Q*R ) diff --git a/TESTING/LIN/zchktz.f b/TESTING/LIN/zchktz.f index 138bf79d..e90e5d7d 100644 --- a/TESTING/LIN/zchktz.f +++ b/TESTING/LIN/zchktz.f @@ -1,5 +1,5 @@ SUBROUTINE ZCHKTZ( DOTYPE, NM, MVAL, NN, NVAL, THRESH, TSTERR, A, - $ COPYA, S, COPYS, TAU, WORK, RWORK, NOUT ) + $ COPYA, S, TAU, WORK, RWORK, NOUT ) * * -- LAPACK test routine (version 3.1) -- * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. @@ -13,7 +13,7 @@ * .. Array Arguments .. LOGICAL DOTYPE( * ) INTEGER MVAL( * ), NVAL( * ) - DOUBLE PRECISION COPYS( * ), RWORK( * ), S( * ) + DOUBLE PRECISION S( * ), RWORK( * ) COMPLEX*16 A( * ), COPYA( * ), TAU( * ), WORK( * ) * .. * @@ -59,9 +59,6 @@ * S (workspace) DOUBLE PRECISION array, dimension * (min(MMAX,NMAX)) * -* COPYS (workspace) DOUBLE PRECISION array, dimension -* (min(MMAX,NMAX)) -* * TAU (workspace) COMPLEX*16 array, dimension (MMAX) * * WORK (workspace) COMPLEX*16 array, dimension @@ -152,6 +149,8 @@ * IF( M.LE.N ) THEN DO 50 IMODE = 1, NTYPES + IF( .NOT.DOTYPE( IMODE ) ) + $ GO TO 50 * * Do for each type of singular value distribution. * 0: zero matrix @@ -169,18 +168,18 @@ CALL ZLASET( 'Full', M, N, DCMPLX( ZERO ), $ DCMPLX( ZERO ), A, LDA ) DO 20 I = 1, MNMIN - COPYS( I ) = ZERO + S( I ) = ZERO 20 CONTINUE ELSE CALL ZLATMS( M, N, 'Uniform', ISEED, - $ 'Nonsymmetric', COPYS, IMODE, + $ 'Nonsymmetric', S, IMODE, $ ONE / EPS, ONE, M, N, 'No packing', A, $ LDA, WORK, INFO ) CALL ZGEQR2( M, N, A, LDA, WORK, WORK( MNMIN+1 ), $ INFO ) CALL ZLASET( 'Lower', M-1, N, DCMPLX( ZERO ), $ DCMPLX( ZERO ), A( 2 ), LDA ) - CALL DLAORD( 'Decreasing', MNMIN, COPYS, 1 ) + CALL DLAORD( 'Decreasing', MNMIN, S, 1 ) END IF * * Save A and its singular values @@ -195,7 +194,7 @@ * * Compute norm(svd(a) - svd(r)) * - RESULT( 1 ) = ZQRT12( M, M, A, LDA, COPYS, WORK, + RESULT( 1 ) = ZQRT12( M, M, A, LDA, S, WORK, $ LWORK, RWORK ) * * Compute norm( A - R*Q ) @@ -216,18 +215,18 @@ CALL ZLASET( 'Full', M, N, DCMPLX( ZERO ), $ DCMPLX( ZERO ), A, LDA ) DO 30 I = 1, MNMIN - COPYS( I ) = ZERO + S( I ) = ZERO 30 CONTINUE ELSE CALL ZLATMS( M, N, 'Uniform', ISEED, - $ 'Nonsymmetric', COPYS, IMODE, + $ 'Nonsymmetric', S, IMODE, $ ONE / EPS, ONE, M, N, 'No packing', A, $ LDA, WORK, INFO ) CALL ZGEQR2( M, N, A, LDA, WORK, WORK( MNMIN+1 ), $ INFO ) CALL ZLASET( 'Lower', M-1, N, DCMPLX( ZERO ), $ DCMPLX( ZERO ), A( 2 ), LDA ) - CALL DLAORD( 'Decreasing', MNMIN, COPYS, 1 ) + CALL DLAORD( 'Decreasing', MNMIN, S, 1 ) END IF * * Save A and its singular values @@ -242,7 +241,7 @@ * * Compute norm(svd(a) - svd(r)) * - RESULT( 4 ) = ZQRT12( M, M, A, LDA, COPYS, WORK, + RESULT( 4 ) = ZQRT12( M, M, A, LDA, S, WORK, $ LWORK, RWORK ) * * Compute norm( A - R*Q ) diff --git a/TESTING/LIN/zdrvac.f b/TESTING/LIN/zdrvac.f index 423bd7ec..5455bd49 100644 --- a/TESTING/LIN/zdrvac.f +++ b/TESTING/LIN/zdrvac.f @@ -324,8 +324,6 @@ 110 CONTINUE 120 CONTINUE * - 130 CONTINUE -* * Print a summary of the results. * IF( NFAIL.GT.0 ) THEN diff --git a/TESTING/LIN/zdrvgt.f b/TESTING/LIN/zdrvgt.f index ee95106f..cd34a3f0 100644 --- a/TESTING/LIN/zdrvgt.f +++ b/TESTING/LIN/zdrvgt.f @@ -368,7 +368,7 @@ $ LDA ) CALL ZGTT02( TRANS, N, NRHS, A, A( M+1 ), $ A( N+M+1 ), X, LDA, WORK, LDA, - $ RWORK, RESULT( 2 ) ) + $ RESULT( 2 ) ) * * Check solution from generated exact solution. * @@ -442,7 +442,7 @@ * CALL ZLACPY( 'Full', N, NRHS, B, LDA, WORK, LDA ) CALL ZGTT02( TRANS, N, NRHS, A, A( M+1 ), - $ A( N+M+1 ), X, LDA, WORK, LDA, RWORK, + $ A( N+M+1 ), X, LDA, WORK, LDA, $ RESULT( 2 ) ) * * Check solution from generated exact solution. diff --git a/TESTING/LIN/zgennd.f b/TESTING/LIN/zgennd.f index 25ccb2f0..33761759 100644 --- a/TESTING/LIN/zgennd.f +++ b/TESTING/LIN/zgennd.f @@ -39,7 +39,6 @@ PARAMETER ( ZERO = 0.0E0 ) * .. * .. Local Scalars .. - LOGICAL OUT INTEGER I, K COMPLEX*16 AII * .. diff --git a/TESTING/LIN/zgtt02.f b/TESTING/LIN/zgtt02.f index 22128b65..8e1a0805 100644 --- a/TESTING/LIN/zgtt02.f +++ b/TESTING/LIN/zgtt02.f @@ -1,5 +1,5 @@ SUBROUTINE ZGTT02( TRANS, N, NRHS, DL, D, DU, X, LDX, B, LDB, - $ RWORK, RESID ) + $ RESID ) * * -- LAPACK test routine (version 3.1) -- * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. @@ -11,7 +11,6 @@ DOUBLE PRECISION RESID * .. * .. Array Arguments .. - DOUBLE PRECISION RWORK( * ) COMPLEX*16 B( LDB, * ), D( * ), DL( * ), DU( * ), $ X( LDX, * ) * .. @@ -63,8 +62,6 @@ * LDB (input) INTEGER * The leading dimension of the array B. LDB >= max(1,N). * -* RWORK (workspace) DOUBLE PRECISION array, dimension (N) -* * RESID (output) DOUBLE PRECISION * norm(B - op(A)*X) / (norm(A) * norm(X) * EPS) * diff --git a/TESTING/MATGEN/clatme.f b/TESTING/MATGEN/clatme.f index c27ba827..ae14e829 100644 --- a/TESTING/MATGEN/clatme.f +++ b/TESTING/MATGEN/clatme.f @@ -1,4 +1,4 @@ - SUBROUTINE CLATME( N, DIST, ISEED, D, MODE, COND, DMAX, EI, + SUBROUTINE CLATME( N, DIST, ISEED, D, MODE, COND, DMAX, $ RSIGN, $ UPPER, SIM, DS, MODES, CONDS, KL, KU, ANORM, $ A, @@ -9,7 +9,7 @@ * June 2010 * * .. Scalar Arguments .. - CHARACTER DIST, EI, RSIGN, SIM, UPPER + CHARACTER DIST, RSIGN, SIM, UPPER INTEGER INFO, KL, KU, LDA, MODE, MODES, N REAL ANORM, COND, CONDS COMPLEX DMAX @@ -118,10 +118,6 @@ * equal to DMAX. * Not modified. * -* EI (input) CHARACTER*1 array, dimension ( N ) -* (ignored) -* Not modified. -* * RSIGN (input) CHARACTER*1 * If MODE is not 0, 6, or -6, and RSIGN='T', then the * elements of D, as computed according to MODE and COND, will diff --git a/TESTING/MATGEN/zlatme.f b/TESTING/MATGEN/zlatme.f index f3345ce2..0063b06c 100644 --- a/TESTING/MATGEN/zlatme.f +++ b/TESTING/MATGEN/zlatme.f @@ -1,4 +1,4 @@ - SUBROUTINE ZLATME( N, DIST, ISEED, D, MODE, COND, DMAX, EI, + SUBROUTINE ZLATME( N, DIST, ISEED, D, MODE, COND, DMAX, $ RSIGN, $ UPPER, SIM, DS, MODES, CONDS, KL, KU, ANORM, $ A, @@ -9,7 +9,7 @@ * June 2010 * * .. Scalar Arguments .. - CHARACTER DIST, EI, RSIGN, SIM, UPPER + CHARACTER DIST, RSIGN, SIM, UPPER INTEGER INFO, KL, KU, LDA, MODE, MODES, N DOUBLE PRECISION ANORM, COND, CONDS COMPLEX*16 DMAX @@ -118,10 +118,6 @@ * equal to DMAX. * Not modified. * -* EI (input) CHARACTER*1 array, dimension ( N ) -* (ignored) -* Not modified. -* * RSIGN (input) CHARACTER*1 * If MODE is not 0, 6, or -6, and RSIGN='T', then the * elements of D, as computed according to MODE and COND, will |