← Back to branch summary

~mmach/netext73/lapack

« back to all changes in this revision

Viewing changes to TESTING/LIN/cchktr.f

  • Committer: mmach
  • Date: 2022-11-27 19:43:35 UTC
  • Revision ID: netbit73@gmail.com-20221127194335-pkgcqw16me0jf80s
3.11.0-2

Show diffs side-by-side

added added

removed removed

Lines of Context:
TESTING/LIN/cchktr.f
31
31
*>
32
32
*> \verbatim
33
33
*>
34
 
*> CCHKTR tests CTRTRI, -TRS, -RFS, and -CON, and CLATRS
 
34
*> CCHKTR tests CTRTRI, -TRS, -RFS, and -CON, and CLATRS(3)
35
35
*> \endverbatim
36
36
*
37
37
*  Arguments:
184
184
      INTEGER            NTYPE1, NTYPES
185
185
      PARAMETER          ( NTYPE1 = 10, NTYPES = 18 )
186
186
      INTEGER            NTESTS
187
 
      PARAMETER          ( NTESTS = 9 )
 
187
      PARAMETER          ( NTESTS = 10 )
188
188
      INTEGER            NTRAN
189
189
      PARAMETER          ( NTRAN = 3 )
190
190
      REAL               ONE, ZERO
195
195
      CHARACTER*3        PATH
196
196
      INTEGER            I, IDIAG, IMAT, IN, INB, INFO, IRHS, ITRAN,
197
197
     $                   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
200
200
*     ..
201
201
*     .. Local Arrays ..
202
202
      CHARACTER          TRANSS( NTRAN ), UPLOS( 2 )
203
203
      INTEGER            ISEED( 4 ), ISEEDY( 4 )
204
 
      REAL               RESULT( NTESTS )
 
204
      REAL               RESULT( NTESTS ), SCALE3( 2 )
205
205
*     ..
206
206
*     .. External Functions ..
207
207
      LOGICAL            LSAME
210
210
*     ..
211
211
*     .. External Subroutines ..
212
212
      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
216
216
*     ..
217
217
*     .. Scalars in Common ..
218
218
      LOGICAL            LERR, OK
236
236
*
237
237
      PATH( 1: 1 ) = 'Complex precision'
238
238
      PATH( 2: 3 ) = 'TR'
 
239
      BIGNUM = SLAMCH('Overflow') / SLAMCH('Precision')
239
240
      NRUN = 0
240
241
      NFAIL = 0
241
242
      NERRS = 0
380
381
*                       This line is needed on a Sun SPARCstation.
381
382
*
382
383
                        IF( N.GT.0 )
383
 
     $                     DUMMY = A( 1 )
 
384
     $                     DUMMY = REAL( A( 1 ) )
384
385
*
385
386
                        CALL CTRT02( UPLO, TRANS, DIAG, N, NRHS, A, LDA,
386
387
     $                               X, LDA, B, LDA, WORK, RWORK,
535
536
     $                         RWORK, ONE, B( N+1 ), LDA, X, LDA, WORK,
536
537
     $                         RESULT( 9 ) )
537
538
*
 
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
*
538
565
*                 Print information about the tests that did not pass
539
566
*                 the threshold.
540
567
*
552
579
     $                  DIAG, 'Y', N, IMAT, 9, RESULT( 9 )
553
580
                     NFAIL = NFAIL + 1
554
581
                  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
556
590
   90          CONTINUE
557
591
  100       CONTINUE
558
592
  110    CONTINUE