Skip to content

Commit fdb012c

Browse files
martin-frbgmartin-frbg
authored
Fix implicit conversions and unused variables (Reference-LAPACK PR 703)
1 parent c99d27a commit fdb012c

File tree

17 files changed

+131
-61
lines changed

17 files changed

+131
-61
lines changed

‎lapack-netlib/TESTING/LIN/cchkpt.f

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -319,15 +319,15 @@ SUBROUTINE CCHKPT( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
319319
* elements.
320320
*
321321
IF( IZERO.EQ.1 ) THEN
322-
D( 1 ) = Z( 2 )
322+
D( 1 ) = REAL( Z( 2 ) )
323323
IF( N.GT.1 )
324324
$ E( 1 ) = Z( 3 )
325325
ELSE IF( IZERO.EQ.N ) THEN
326326
E( N-1 ) = Z( 1 )
327-
D( N ) = Z( 2 )
327+
D( N ) = REAL( Z( 2 ) )
328328
ELSE
329329
E( IZERO-1 ) = Z( 1 )
330-
D( IZERO ) = Z( 2 )
330+
D( IZERO ) = REAL( Z( 2 ) )
331331
E( IZERO ) = Z( 3 )
332332
END IF
333333
END IF

‎lapack-netlib/TESTING/LIN/cchktr.f

Lines changed: 44 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -31,7 +31,7 @@
3131
*>
3232
*> \verbatim
3333
*>
34-
*> CCHKTR tests CTRTRI, -TRS, -RFS, and -CON, and CLATRS
34+
*> CCHKTR tests CTRTRI, -TRS, -RFS, and -CON, and CLATRS(3)
3535
*> \endverbatim
3636
*
3737
* Arguments:
@@ -184,7 +184,7 @@ SUBROUTINE CCHKTR( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
184184
INTEGER NTYPE1, NTYPES
185185
PARAMETER ( NTYPE1 = 10, NTYPES = 18 )
186186
INTEGER NTESTS
187-
PARAMETER ( NTESTS = 9 )
187+
PARAMETER ( NTESTS = 10 )
188188
INTEGER NTRAN
189189
PARAMETER ( NTRAN = 3 )
190190
REAL ONE, ZERO
@@ -195,13 +195,13 @@ SUBROUTINE CCHKTR( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
195195
CHARACTER*3 PATH
196196
INTEGER I, IDIAG, IMAT, IN, INB, INFO, IRHS, ITRAN,
197197
$ IUPLO, K, LDA, N, NB, NERRS, NFAIL, NRHS, NRUN
198-
REAL AINVNM, ANORM, DUMMY, RCOND, RCONDC, RCONDI,
199-
$ RCONDO, SCALE
198+
REAL AINVNM, ANORM, BIGNUM, DUMMY, RCOND, RCONDC,
199+
$ RCONDI, RCONDO, RES, SCALE, SLAMCH
200200
* ..
201201
* .. Local Arrays ..
202202
CHARACTER TRANSS( NTRAN ), UPLOS( 2 )
203203
INTEGER ISEED( 4 ), ISEEDY( 4 )
204-
REAL RESULT( NTESTS )
204+
REAL RESULT( NTESTS ), SCALE3( 2 )
205205
* ..
206206
* .. External Functions ..
207207
LOGICAL LSAME
@@ -210,9 +210,9 @@ SUBROUTINE CCHKTR( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
210210
* ..
211211
* .. External Subroutines ..
212212
EXTERNAL ALAERH, ALAHD, ALASUM, CCOPY, CERRTR, CGET04,
213-
$ CLACPY, CLARHS, CLATRS, CLATTR, CTRCON, CTRRFS,
214-
$ CTRT01, CTRT02, CTRT03, CTRT05, CTRT06, CTRTRI,
215-
$ CTRTRS, XLAENV
213+
$ CLACPY, CLARHS, CLATRS, CLATRS3, CLATTR,
214+
$ CSSCAL, CTRCON, CTRRFS, CTRT01, CTRT02, CTRT03,
215+
$ CTRT05, CTRT06, CTRTRI, CTRTRS, XLAENV, SLAMCH
216216
* ..
217217
* .. Scalars in Common ..
218218
LOGICAL LERR, OK
@@ -236,6 +236,7 @@ SUBROUTINE CCHKTR( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
236236
*
237237
PATH( 1: 1 ) = 'Complex precision'
238238
PATH( 2: 3 ) = 'TR'
239+
BIGNUM = SLAMCH('Overflow') / SLAMCH('Precision')
239240
NRUN = 0
240241
NFAIL = 0
241242
NERRS = 0
@@ -380,7 +381,7 @@ SUBROUTINE CCHKTR( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
380381
* This line is needed on a Sun SPARCstation.
381382
*
382383
IF( N.GT.0 )
383-
$ DUMMY = A( 1 )
384+
$ DUMMY = REAL( A( 1 ) )
384385
*
385386
CALL CTRT02( UPLO, TRANS, DIAG, N, NRHS, A, LDA,
386387
$ X, LDA, B, LDA, WORK, RWORK,
@@ -535,6 +536,32 @@ SUBROUTINE CCHKTR( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
535536
$ RWORK, ONE, B( N+1 ), LDA, X, LDA, WORK,
536537
$ RESULT( 9 ) )
537538
*
539+
*+ TEST 10
540+
* Solve op(A)*X = B.
541+
*
542+
SRNAMT = 'CLATRS3'
543+
CALL CCOPY( N, X, 1, B, 1 )
544+
CALL CCOPY( N, X, 1, B, 1 )
545+
CALL CSCAL( N, BIGNUM, B( N+1 ), 1 )
546+
CALL CLATRS3( UPLO, TRANS, DIAG, 'N', N, 2, A, LDA,
547+
$ B, MAX(1, N), SCALE3, RWORK, WORK, NMAX,
548+
$ INFO )
549+
*
550+
* Check error code from CLATRS3.
551+
*
552+
IF( INFO.NE.0 )
553+
$ CALL ALAERH( PATH, 'CLATRS3', INFO, 0,
554+
$ UPLO // TRANS // DIAG // 'Y', N, N,
555+
$ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
556+
CALL CTRT03( UPLO, TRANS, DIAG, N, 1, A, LDA,
557+
$ SCALE3( 1 ), RWORK, ONE, B( 1 ), LDA,
558+
$ X, LDA, WORK, RESULT( 10 ) )
559+
CALL CSSCAL( N, BIGNUM, X, 1 )
560+
CALL CTRT03( UPLO, TRANS, DIAG, N, 1, A, LDA,
561+
$ SCALE3( 2 ), RWORK, ONE, B( N+1 ), LDA,
562+
$ X, LDA, WORK, RESULT( 10 ) )
563+
RESULT( 10 ) = MAX( RESULT( 10 ), RES )
564+
*
538565
* Print information about the tests that did not pass
539566
* the threshold.
540567
*
@@ -552,7 +579,14 @@ SUBROUTINE CCHKTR( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
552579
$ DIAG, 'Y', N, IMAT, 9, RESULT( 9 )
553580
NFAIL = NFAIL + 1
554581
END IF
555-
NRUN = NRUN + 2
582+
IF( RESULT( 10 ).GE.THRESH ) THEN
583+
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
584+
$ CALL ALAHD( NOUT, PATH )
585+
WRITE( NOUT, FMT = 9996 )'CLATRS3', UPLO, TRANS,
586+
$ DIAG, 'N', N, IMAT, 10, RESULT( 10 )
587+
NFAIL = NFAIL + 1
588+
END IF
589+
NRUN = NRUN + 3
556590
90 CONTINUE
557591
100 CONTINUE
558592
110 CONTINUE

‎lapack-netlib/TESTING/LIN/cdrvgt.f

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -307,16 +307,16 @@ SUBROUTINE CDRVGT( DOTYPE, NN, NVAL, NRHS, THRESH, TSTERR, A, AF,
307307
IZERO = 0
308308
ELSE IF( IMAT.EQ.8 ) THEN
309309
IZERO = 1
310-
Z( 2 ) = A( N )
310+
Z( 2 ) = REAL( A( N ) )
311311
A( N ) = ZERO
312312
IF( N.GT.1 ) THEN
313-
Z( 3 ) = A( 1 )
313+
Z( 3 ) = REAL( A( 1 ) )
314314
A( 1 ) = ZERO
315315
END IF
316316
ELSE IF( IMAT.EQ.9 ) THEN
317317
IZERO = N
318-
Z( 1 ) = A( 3*N-2 )
319-
Z( 2 ) = A( 2*N-1 )
318+
Z( 1 ) = REAL( A( 3*N-2 ) )
319+
Z( 2 ) = REAL( A( 2*N-1 ) )
320320
A( 3*N-2 ) = ZERO
321321
A( 2*N-1 ) = ZERO
322322
ELSE

‎lapack-netlib/TESTING/LIN/clattp.f

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -336,7 +336,7 @@ SUBROUTINE CLATTP( IMAT, UPLO, TRANS, DIAG, ISEED, N, AP, B, WORK,
336336
WORK( J+1 ) = PLUS2
337337
WORK( N+J+1 ) = ZERO
338338
PLUS1 = STAR1 / PLUS2
339-
REXP = CLARND( 2, ISEED )
339+
REXP = REAL( CLARND( 2, ISEED ) )
340340
IF( REXP.LT.ZERO ) THEN
341341
STAR1 = -SFAC**( ONE-REXP )*CLARND( 5, ISEED )
342342
ELSE
@@ -790,7 +790,7 @@ SUBROUTINE CLATTP( IMAT, UPLO, TRANS, DIAG, ISEED, N, AP, B, WORK,
790790
DO 460 J = 1, N / 2
791791
JL = JJ
792792
DO 450 I = J, N - J
793-
T = AP( JR-I+J )
793+
T = REAL( AP( JR-I+J ) )
794794
AP( JR-I+J ) = AP( JL )
795795
AP( JL ) = T
796796
JL = JL + I
@@ -804,7 +804,7 @@ SUBROUTINE CLATTP( IMAT, UPLO, TRANS, DIAG, ISEED, N, AP, B, WORK,
804804
DO 480 J = 1, N / 2
805805
JR = JJ
806806
DO 470 I = J, N - J
807-
T = AP( JL+I-J )
807+
T = REAL( AP( JL+I-J ) )
808808
AP( JL+I-J ) = AP( JR )
809809
AP( JR ) = T
810810
JR = JR - I

‎lapack-netlib/TESTING/LIN/cpbt01.f

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -201,7 +201,8 @@ SUBROUTINE CPBT01( UPLO, N, KD, A, LDA, AFAC, LDAFAC, RWORK,
201201
*
202202
* Compute the (K,K) element of the result.
203203
*
204-
AKK = CDOTC( KLEN+1, AFAC( KC, K ), 1, AFAC( KC, K ), 1 )
204+
AKK = REAL(
205+
$ CDOTC( KLEN+1, AFAC( KC, K ), 1, AFAC( KC, K ), 1 ) )
205206
AFAC( KD+1, K ) = AKK
206207
*
207208
* Compute the rest of column K.
@@ -228,7 +229,7 @@ SUBROUTINE CPBT01( UPLO, N, KD, A, LDA, AFAC, LDAFAC, RWORK,
228229
*
229230
* Scale column K by the diagonal element.
230231
*
231-
AKK = AFAC( 1, K )
232+
AKK = REAL( AFAC( 1, K ) )
232233
CALL CSSCAL( KLEN+1, AKK, AFAC( 1, K ), 1 )
233234
*
234235
40 CONTINUE

‎lapack-netlib/TESTING/LIN/cpot01.f

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -176,7 +176,7 @@ SUBROUTINE CPOT01( UPLO, N, A, LDA, AFAC, LDAFAC, RWORK, RESID )
176176
*
177177
* Compute the (K,K) element of the result.
178178
*
179-
TR = CDOTC( K, AFAC( 1, K ), 1, AFAC( 1, K ), 1 )
179+
TR = REAL( CDOTC( K, AFAC( 1, K ), 1, AFAC( 1, K ), 1 ) )
180180
AFAC( K, K ) = TR
181181
*
182182
* Compute the rest of column K.
@@ -224,7 +224,7 @@ SUBROUTINE CPOT01( UPLO, N, A, LDA, AFAC, LDAFAC, RWORK, RESID )
224224
70 CONTINUE
225225
END IF
226226
*
227-
* Compute norm( L*U - A ) / ( N * norm(A) * EPS )
227+
* Compute norm(L*U - A) / ( N * norm(A) * EPS )
228228
*
229229
RESID = CLANHE( '1', UPLO, N, AFAC, LDAFAC, RWORK )
230230
*

‎lapack-netlib/TESTING/LIN/cppt01.f

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -178,7 +178,7 @@ SUBROUTINE CPPT01( UPLO, N, A, AFAC, RWORK, RESID )
178178
*
179179
* Compute the (K,K) element of the result.
180180
*
181-
TR = CDOTC( K, AFAC( KC ), 1, AFAC( KC ), 1 )
181+
TR = REAL( CDOTC( K, AFAC( KC ), 1, AFAC( KC ), 1 ) )
182182
AFAC( KC+K-1 ) = TR
183183
*
184184
* Compute the rest of column K.

‎lapack-netlib/TESTING/LIN/cpst01.f

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -219,7 +219,7 @@ SUBROUTINE CPST01( UPLO, N, A, LDA, AFAC, LDAFAC, PERM, LDPERM,
219219
*
220220
* Compute the (K,K) element of the result.
221221
*
222-
TR = CDOTC( K, AFAC( 1, K ), 1, AFAC( 1, K ), 1 )
222+
TR = REAL( CDOTC( K, AFAC( 1, K ), 1, AFAC( 1, K ), 1 ) )
223223
AFAC( K, K ) = TR
224224
*
225225
* Compute the rest of column K.

‎lapack-netlib/TESTING/LIN/zchkpt.f

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -319,15 +319,15 @@ SUBROUTINE ZCHKPT( DOTYPE, NN, NVAL, NNS, NSVAL, THRESH, TSTERR,
319319
* elements.
320320
*
321321
IF( IZERO.EQ.1 ) THEN
322-
D( 1 ) = Z( 2 )
322+
D( 1 ) = DBLE( Z( 2 ) )
323323
IF( N.GT.1 )
324324
$ E( 1 ) = Z( 3 )
325325
ELSE IF( IZERO.EQ.N ) THEN
326326
E( N-1 ) = Z( 1 )
327-
D( N ) = Z( 2 )
327+
D( N ) = DBLE( Z( 2 ) )
328328
ELSE
329329
E( IZERO-1 ) = Z( 1 )
330-
D( IZERO ) = Z( 2 )
330+
D( IZERO ) = DBLE( Z( 2 ) )
331331
E( IZERO ) = Z( 3 )
332332
END IF
333333
END IF

‎lapack-netlib/TESTING/LIN/zchktr.f

Lines changed: 47 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -31,7 +31,7 @@
3131
*>
3232
*> \verbatim
3333
*>
34-
*> ZCHKTR tests ZTRTRI, -TRS, -RFS, and -CON, and ZLATRS
34+
*> ZCHKTR tests ZTRTRI, -TRS, -RFS, and -CON, and ZLATRS(3)
3535
*> \endverbatim
3636
*
3737
* Arguments:
@@ -184,7 +184,7 @@ SUBROUTINE ZCHKTR( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
184184
INTEGER NTYPE1, NTYPES
185185
PARAMETER ( NTYPE1 = 10, NTYPES = 18 )
186186
INTEGER NTESTS
187-
PARAMETER ( NTESTS = 9 )
187+
PARAMETER ( NTESTS = 10 )
188188
INTEGER NTRAN
189189
PARAMETER ( NTRAN = 3 )
190190
DOUBLE PRECISION ONE, ZERO
@@ -195,24 +195,24 @@ SUBROUTINE ZCHKTR( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
195195
CHARACTER*3 PATH
196196
INTEGER I, IDIAG, IMAT, IN, INB, INFO, IRHS, ITRAN,
197197
$ IUPLO, K, LDA, N, NB, NERRS, NFAIL, NRHS, NRUN
198-
DOUBLE PRECISION AINVNM, ANORM, DUMMY, RCOND, RCONDC, RCONDI,
199-
$ RCONDO, SCALE
198+
DOUBLE PRECISION AINVNM, ANORM, BIGNUM, DUMMY, RCOND, RCONDC,
199+
$ RCONDI, RCONDO, RES, SCALE, DLAMCH
200200
* ..
201201
* .. Local Arrays ..
202202
CHARACTER TRANSS( NTRAN ), UPLOS( 2 )
203203
INTEGER ISEED( 4 ), ISEEDY( 4 )
204-
DOUBLE PRECISION RESULT( NTESTS )
204+
DOUBLE PRECISION RESULT( NTESTS ), SCALE3( 2 )
205205
* ..
206206
* .. External Functions ..
207207
LOGICAL LSAME
208208
DOUBLE PRECISION ZLANTR
209209
EXTERNAL LSAME, ZLANTR
210210
* ..
211211
* .. External Subroutines ..
212-
EXTERNAL ALAERH, ALAHD, ALASUM, XLAENV, ZCOPY, ZERRTR,
213-
$ ZGET04, ZLACPY, ZLARHS, ZLATRS, ZLATTR, ZTRCON,
214-
$ ZTRRFS, ZTRT01, ZTRT02, ZTRT03, ZTRT05, ZTRT06,
215-
$ ZTRTRI, ZTRTRS
212+
EXTERNAL ALAERH, ALAHD, ALASUM, DLAMCH, XLAENV, ZCOPY,
213+
$ ZDSCAL, ZERRTR, ZGET04, ZLACPY, ZLARHS, ZLATRS,
214+
$ ZLATRS3, ZLATTR, ZTRCON, ZTRRFS, ZTRT01,
215+
$ ZTRT02, ZTRT03, ZTRT05, ZTRT06, ZTRTRI, ZTRTRS
216216
* ..
217217
* .. Scalars in Common ..
218218
LOGICAL LERR, OK
@@ -236,6 +236,7 @@ SUBROUTINE ZCHKTR( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
236236
*
237237
PATH( 1: 1 ) = 'Zomplex precision'
238238
PATH( 2: 3 ) = 'TR'
239+
BIGNUM = DLAMCH('Overflow') / DLAMCH('Precision')
239240
NRUN = 0
240241
NFAIL = 0
241242
NERRS = 0
@@ -380,7 +381,7 @@ SUBROUTINE ZCHKTR( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
380381
* This line is needed on a Sun SPARCstation.
381382
*
382383
IF( N.GT.0 )
383-
$ DUMMY = A( 1 )
384+
$ DUMMY = DBLE( A( 1 ) )
384385
*
385386
CALL ZTRT02( UPLO, TRANS, DIAG, N, NRHS, A, LDA,
386387
$ X, LDA, B, LDA, WORK, RWORK,
@@ -535,6 +536,32 @@ SUBROUTINE ZCHKTR( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
535536
$ RWORK, ONE, B( N+1 ), LDA, X, LDA, WORK,
536537
$ RESULT( 9 ) )
537538
*
539+
*+ TEST 10
540+
* Solve op(A)*X = B
541+
*
542+
SRNAMT = 'ZLATRS3'
543+
CALL ZCOPY( N, X, 1, B, 1 )
544+
CALL ZCOPY( N, X, 1, B( N+1 ), 1 )
545+
CALL ZDSCAL( N, BIGNUM, B( N+1 ), 1 )
546+
CALL ZLATRS3( UPLO, TRANS, DIAG, 'N', N, 2, A, LDA,
547+
$ B, MAX(1, N), SCALE3, RWORK, WORK, NMAX,
548+
$ INFO )
549+
*
550+
* Check error code from ZLATRS3.
551+
*
552+
IF( INFO.NE.0 )
553+
$ CALL ALAERH( PATH, 'ZLATRS3', INFO, 0,
554+
$ UPLO // TRANS // DIAG // 'N', N, N,
555+
$ -1, -1, -1, IMAT, NFAIL, NERRS, NOUT )
556+
CALL ZTRT03( UPLO, TRANS, DIAG, N, 1, A, LDA,
557+
$ SCALE3( 1 ), RWORK, ONE, B( 1 ), LDA,
558+
$ X, LDA, WORK, RESULT( 10 ) )
559+
CALL ZDSCAL( N, BIGNUM, X, 1 )
560+
CALL ZTRT03( UPLO, TRANS, DIAG, N, 1, A, LDA,
561+
$ SCALE3( 2 ), RWORK, ONE, B( N+1 ), LDA,
562+
$ X, LDA, WORK, RES )
563+
RESULT( 10 ) = MAX( RESULT( 10 ), RES )
564+
*
538565
* Print information about the tests that did not pass
539566
* the threshold.
540567
*
@@ -552,7 +579,14 @@ SUBROUTINE ZCHKTR( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
552579
$ DIAG, 'Y', N, IMAT, 9, RESULT( 9 )
553580
NFAIL = NFAIL + 1
554581
END IF
555-
NRUN = NRUN + 2
582+
IF( RESULT( 10 ).GE.THRESH ) THEN
583+
IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 )
584+
$ CALL ALAHD( NOUT, PATH )
585+
WRITE( NOUT, FMT = 9996 )'ZLATRS3', UPLO, TRANS,
586+
$ DIAG, 'N', N, IMAT, 10, RESULT( 10 )
587+
NFAIL = NFAIL + 1
588+
END IF
589+
NRUN = NRUN + 3
556590
90 CONTINUE
557591
100 CONTINUE
558592
110 CONTINUE
@@ -565,8 +599,8 @@ SUBROUTINE ZCHKTR( DOTYPE, NN, NVAL, NNB, NBVAL, NNS, NSVAL,
565599
9999 FORMAT( ' UPLO=''', A1, ''', DIAG=''', A1, ''', N=', I5, ', NB=',
566600
$ I4, ', type ', I2, ', test(', I2, ')= ', G12.5 )
567601
9998 FORMAT( ' UPLO=''', A1, ''', TRANS=''', A1, ''', DIAG=''', A1,
568-
$ ''', N=', I5, ', NB=', I4, ', type ', I2, ',
569-
$ test(', I2, ')= ', G12.5 )
602+
$ ''', N=', I5, ', NB=', I4, ', type ', I2, ', test(',
603+
$ I2, ')= ', G12.5 )
570604
9997 FORMAT( ' NORM=''', A1, ''', UPLO =''', A1, ''', N=', I5, ',',
571605
$ 11X, ' type ', I2, ', test(', I2, ')=', G12.5 )
572606
9996 FORMAT( 1X, A, '( ''', A1, ''', ''', A1, ''', ''', A1, ''', ''',

0 commit comments

Comments
 (0)