Cleanup some codes, like unused variables.
Used -Walls to detect problems.
DPARAM(5) = DH22
END IF
- 260 CONTINUE
DPARAM(1) = DFLAG
RETURN
END
50 CONTINUE
END IF
*
- 60 CONTINUE
LCERES = .TRUE.
GO TO 80
70 CONTINUE
50 CONTINUE
END IF
*
- 60 CONTINUE
LCERES = .TRUE.
GO TO 80
70 CONTINUE
50 CONTINUE
END IF
*
- 60 CONTINUE
LDERES = .TRUE.
GO TO 80
70 CONTINUE
50 CONTINUE
END IF
*
- 60 CONTINUE
LDERES = .TRUE.
GO TO 80
70 CONTINUE
50 CONTINUE
END IF
*
- 60 CONTINUE
LSERES = .TRUE.
GO TO 80
70 CONTINUE
50 CONTINUE
END IF
*
- 60 CONTINUE
LSERES = .TRUE.
GO TO 80
70 CONTINUE
50 CONTINUE
END IF
*
- 60 CONTINUE
LZERES = .TRUE.
GO TO 80
70 CONTINUE
50 CONTINUE
END IF
*
- 60 CONTINUE
LZERES = .TRUE.
GO TO 80
70 CONTINUE
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
*
* .. Local Scalars ..
INTEGER I
REAL SMIN, BASE, TMP
- COMPLEX ZDUM
* ..
* .. External Functions ..
REAL SLAMCH
*
* .. Local Scalars ..
LOGICAL LQUERY
- INTEGER LWKOPT, NB
+ INTEGER LWKOPT
* ..
* .. External Functions ..
LOGICAL LSAME
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
*
* .. Local Scalars ..
LOGICAL LQUERY
- INTEGER LWKOPT, NB
+ INTEGER LWKOPT
* ..
* .. External Functions ..
LOGICAL LSAME
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
$ (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)))
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 )
*
* .. Local Scalars ..
LOGICAL LQUERY
- INTEGER LWKOPT, NB
+ INTEGER LWKOPT
* ..
* .. External Functions ..
LOGICAL LSAME
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
* .. Local Scalars ..
INTEGER I
DOUBLE PRECISION SMIN, BASE, TMP
- COMPLEX*16 ZDUM
* ..
* .. External Functions ..
DOUBLE PRECISION DLAMCH
*
* .. Local Scalars ..
LOGICAL LQUERY
- INTEGER LWKOPT, NB
+ INTEGER LWKOPT
* ..
* .. External Functions ..
LOGICAL LSAME
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
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 )
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 )
*
$ / ' 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=',
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 )
*
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
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 )
*
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 )
*
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 )
$ / ' 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
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 )
$ / ' 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
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 )
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 )
*
$ / ' 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=',
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 )
*
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 )
*
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 )
*
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 )
*
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 ) / ',
$ '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',
$ 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
*
*
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
*
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
*
*
WRITE( NOUT, FMT = 9990 )PATH
END IF
+
*
* Go back to get another input line.
*
*
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.
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..
* ..
* .. Array Arguments ..
LOGICAL DOTYPE( * )
- INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ),
+ INTEGER MVAL( * ), NBVAL( * ), NVAL( * ),
$ NXVAL( * )
REAL RWORK( * )
COMPLEX A( * ), AC( * ), AF( * ), AL( * ), AQ( * ),
*
* RWORK (workspace) REAL array, dimension (NMAX)
*
-* IWORK (workspace) INTEGER array, dimension (NMAX)
-*
* NOUT (input) INTEGER
* The unit number for output.
*
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) --
LOGICAL DOTYPE( * )
INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ),
$ NXVAL( * )
- REAL COPYS( * ), RWORK( * ), S( * )
+ REAL S( * ), RWORK( * )
COMPLEX A( * ), COPYA( * ), TAU( * ), WORK( * )
* ..
*
* 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
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
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
*
* 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 )
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..
* ..
* .. Array Arguments ..
LOGICAL DOTYPE( * )
- INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ),
+ INTEGER MVAL( * ), NBVAL( * ), NVAL( * ),
$ NXVAL( * )
REAL RWORK( * )
COMPLEX A( * ), AC( * ), AF( * ), AL( * ), AQ( * ),
*
* RWORK (workspace) REAL array, dimension (NMAX)
*
-* IWORK (workspace) INTEGER array, dimension (NMAX)
-*
* NOUT (input) INTEGER
* The unit number for output.
*
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) --
* .. Array Arguments ..
LOGICAL DOTYPE( * )
INTEGER IWORK( * ), MVAL( * ), NVAL( * )
- REAL COPYS( * ), RWORK( * ), S( * )
+ REAL S( * ), RWORK( * )
COMPLEX A( * ), COPYA( * ), TAU( * ), WORK( * )
* ..
*
* 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
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
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
*
* 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 )
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..
* .. Array Arguments ..
LOGICAL DOTYPE( * )
INTEGER MVAL( * ), NVAL( * )
- REAL COPYS( * ), RWORK( * ), S( * )
+ REAL S( * ), RWORK( * )
COMPLEX A( * ), COPYA( * ), TAU( * ), WORK( * )
* ..
*
* 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
*
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
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
*
* 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 )
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
*
* 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 )
$ 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.
*
*
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.
PARAMETER ( ZERO = 0.0E0 )
* ..
* .. Local Scalars ..
- LOGICAL OUT
INTEGER I, K
COMPLEX AII
* ..
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..
REAL RESID
* ..
* .. Array Arguments ..
- REAL RWORK( * )
COMPLEX B( LDB, * ), D( * ), DL( * ), DU( * ),
$ X( LDX, * )
* ..
* 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)
*
$ 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
*
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
*
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
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
*
*
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.
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..
* ..
* .. 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( * ),
*
* RWORK (workspace) DOUBLE PRECISION array, dimension (NMAX)
*
-* IWORK (workspace) INTEGER array, dimension (NMAX)
-*
* NOUT (input) INTEGER
* The unit number for output.
*
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) --
LOGICAL DOTYPE( * )
INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ),
$ NXVAL( * )
- DOUBLE PRECISION A( * ), COPYA( * ), COPYS( * ), S( * ),
+ DOUBLE PRECISION A( * ), COPYA( * ), S( * ),
$ TAU( * ), WORK( * )
* ..
*
* 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
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
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
*
* 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 )
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..
* .. Array Arguments ..
LOGICAL DOTYPE( * )
INTEGER IWORK( * ), MVAL( * ), NVAL( * )
- DOUBLE PRECISION A( * ), COPYA( * ), COPYS( * ), S( * ),
+ DOUBLE PRECISION A( * ), COPYA( * ), S( * ),
$ TAU( * ), WORK( * )
* ..
*
* 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
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
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
*
* 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 )
*
CHARACTER UPLOS( 2 )
INTEGER ISEED( 4 ), ISEEDY( 4 )
DOUBLE PRECISION RESULT( NTESTS )
- DOUBLE PRECISION MYWORK( NTESTS )
* ..
* .. External Functions ..
DOUBLE PRECISION DGET06, DLANSY
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..
* .. Array Arguments ..
LOGICAL DOTYPE( * )
INTEGER MVAL( * ), NVAL( * )
- DOUBLE PRECISION A( * ), COPYA( * ), COPYS( * ), S( * ),
+ DOUBLE PRECISION A( * ), COPYA( * ), S( * ),
$ TAU( * ), WORK( * )
* ..
*
* 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
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
*
* 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 )
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
*
* 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 )
110 CONTINUE
120 CONTINUE
*
- 130 CONTINUE
-*
* Print a summary of the results.
*
IF( NFAIL.GT.0 ) THEN
$ 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.
*
*
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.
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..
* ..
* .. Array Arguments ..
DOUBLE PRECISION B( LDB, * ), D( * ), DL( * ), DU( * ),
- $ RWORK( * ), X( LDX, * )
+ $ X( LDX, * )
* ..
*
* Purpose
* 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)
*
$ 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
$ 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
*
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
*
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
*
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.
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..
* ..
* .. Array Arguments ..
LOGICAL DOTYPE( * )
- INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ),
+ INTEGER MVAL( * ), NBVAL( * ), NVAL( * ),
$ NXVAL( * )
REAL A( * ), AC( * ), AF( * ), AL( * ), AQ( * ),
$ B( * ), RWORK( * ), TAU( * ), WORK( * ),
*
* RWORK (workspace) REAL array, dimension (NMAX)
*
-* IWORK (workspace) INTEGER array, dimension (NMAX)
-*
* NOUT (input) INTEGER
* The unit number for output.
*
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) --
LOGICAL DOTYPE( * )
INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ),
$ NXVAL( * )
- REAL A( * ), COPYA( * ), COPYS( * ), S( * ),
+ REAL A( * ), COPYA( * ), S( * ),
$ TAU( * ), WORK( * )
* ..
*
* 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
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
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
*
* 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 )
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..
* ..
* .. Array Arguments ..
LOGICAL DOTYPE( * )
- INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ),
+ INTEGER MVAL( * ), NBVAL( * ), NVAL( * ),
$ NXVAL( * )
REAL A( * ), AC( * ), AF( * ), AL( * ), AQ( * ),
$ B( * ), RWORK( * ), TAU( * ), WORK( * ),
*
* RWORK (workspace) REAL array, dimension (NMAX)
*
-* IWORK (workspace) INTEGER array, dimension (NMAX)
-*
* NOUT (input) INTEGER
* The unit number for output.
*
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..
* .. Array Arguments ..
LOGICAL DOTYPE( * )
INTEGER IWORK( * ), MVAL( * ), NVAL( * )
- REAL A( * ), COPYA( * ), COPYS( * ), S( * ),
+ REAL A( * ), COPYA( * ), S( * ),
$ TAU( * ), WORK( * )
* ..
*
* 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
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
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
*
* 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 )
*
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..
* .. Array Arguments ..
LOGICAL DOTYPE( * )
INTEGER MVAL( * ), NVAL( * )
- REAL A( * ), COPYA( * ), COPYS( * ), S( * ),
+ REAL A( * ), COPYA( * ), S( * ),
$ TAU( * ), WORK( * )
* ..
*
* 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
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
*
* 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 )
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
*
* 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 )
$ 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.
*
*
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.
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..
* ..
* .. Array Arguments ..
REAL B( LDB, * ), D( * ), DL( * ), DU( * ),
- $ RWORK( * ), X( LDX, * )
+ $ X( LDX, * )
* ..
*
* Purpose
* 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)
*
$ 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
$ 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
*
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
*
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
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
*
*
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.
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..
* ..
* .. Array Arguments ..
LOGICAL DOTYPE( * )
- INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ),
+ INTEGER MVAL( * ), NBVAL( * ), NVAL( * ),
$ NXVAL( * )
DOUBLE PRECISION RWORK( * )
COMPLEX*16 A( * ), AC( * ), AF( * ), AL( * ), AQ( * ),
*
* RWORK (workspace) DOUBLE PRECISION array, dimension (NMAX)
*
-* IWORK (workspace) INTEGER array, dimension (NMAX)
-*
* NOUT (input) INTEGER
* The unit number for output.
*
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) --
LOGICAL DOTYPE( * )
INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ),
$ NXVAL( * )
- DOUBLE PRECISION COPYS( * ), RWORK( * ), S( * )
+ DOUBLE PRECISION S( * ), RWORK( * )
COMPLEX*16 A( * ), COPYA( * ), TAU( * ), WORK( * )
* ..
*
* 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
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
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
*
* 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 )
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..
* ..
* .. Array Arguments ..
LOGICAL DOTYPE( * )
- INTEGER IWORK( * ), MVAL( * ), NBVAL( * ), NVAL( * ),
+ INTEGER MVAL( * ), NBVAL( * ), NVAL( * ),
$ NXVAL( * )
DOUBLE PRECISION RWORK( * )
COMPLEX*16 A( * ), AC( * ), AF( * ), AL( * ), AQ( * ),
*
* RWORK (workspace) DOUBLE PRECISION array, dimension (NMAX)
*
-* IWORK (workspace) INTEGER array, dimension (NMAX)
-*
* NOUT (input) INTEGER
* The unit number for output.
*
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) --
* .. Array Arguments ..
LOGICAL DOTYPE( * )
INTEGER IWORK( * ), MVAL( * ), NVAL( * )
- DOUBLE PRECISION COPYS( * ), RWORK( * ), S( * )
+ DOUBLE PRECISION S( * ), RWORK( * )
COMPLEX*16 A( * ), COPYA( * ), TAU( * ), WORK( * )
* ..
*
* 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
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
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
*
* 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 )
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..
* .. Array Arguments ..
LOGICAL DOTYPE( * )
INTEGER MVAL( * ), NVAL( * )
- DOUBLE PRECISION COPYS( * ), RWORK( * ), S( * )
+ DOUBLE PRECISION S( * ), RWORK( * )
COMPLEX*16 A( * ), COPYA( * ), TAU( * ), WORK( * )
* ..
*
* 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
*
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
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
*
* 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 )
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
*
* 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 )
110 CONTINUE
120 CONTINUE
*
- 130 CONTINUE
-*
* Print a summary of the results.
*
IF( NFAIL.GT.0 ) THEN
$ 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.
*
*
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.
PARAMETER ( ZERO = 0.0E0 )
* ..
* .. Local Scalars ..
- LOGICAL OUT
INTEGER I, K
COMPLEX*16 AII
* ..
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..
DOUBLE PRECISION RESID
* ..
* .. Array Arguments ..
- DOUBLE PRECISION RWORK( * )
COMPLEX*16 B( LDB, * ), D( * ), DL( * ), DU( * ),
$ X( LDX, * )
* ..
* 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)
*
- 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,
* 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
* 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
- 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,
* 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
* 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
projects / platform / upstream / lapack.git / commitdiff