LAPACK: BLAS/TESTING/cblat3.f Source File

Go to the documentation of this file.
00001       PROGRAM CBLAT3
00002 *
00003 *  Test program for the COMPLEX          Level 3 Blas.
00004 *
00005 *  The program must be driven by a short data file. The first 14 records
00006 *  of the file are read using list-directed input, the last 9 records
00007 *  are read using the format ( A6, L2 ). An annotated example of a data
00008 *  file can be obtained by deleting the first 3 characters from the
00009 *  following 23 lines:
00010 *  'cblat3.out'      NAME OF SUMMARY OUTPUT FILE
00011 *  6                 UNIT NUMBER OF SUMMARY FILE
00012 *  'CBLAT3.SNAP'     NAME OF SNAPSHOT OUTPUT FILE
00013 *  -1                UNIT NUMBER OF SNAPSHOT FILE (NOT USED IF .LT. 0)
00014 *  F        LOGICAL FLAG, T TO REWIND SNAPSHOT FILE AFTER EACH RECORD.
00015 *  F        LOGICAL FLAG, T TO STOP ON FAILURES.
00016 *  T        LOGICAL FLAG, T TO TEST ERROR EXITS.
00017 *  16.0     THRESHOLD VALUE OF TEST RATIO
00018 *  6                 NUMBER OF VALUES OF N
00019 *  0 1 2 3 5 9       VALUES OF N
00020 *  3                 NUMBER OF VALUES OF ALPHA
00021 *  (0.0,0.0) (1.0,0.0) (0.7,-0.9)       VALUES OF ALPHA
00022 *  3                 NUMBER OF VALUES OF BETA
00023 *  (0.0,0.0) (1.0,0.0) (1.3,-1.1)       VALUES OF BETA
00024 *  CGEMM  T PUT F FOR NO TEST. SAME COLUMNS.
00025 *  CHEMM  T PUT F FOR NO TEST. SAME COLUMNS.
00026 *  CSYMM  T PUT F FOR NO TEST. SAME COLUMNS.
00027 *  CTRMM  T PUT F FOR NO TEST. SAME COLUMNS.
00028 *  CTRSM  T PUT F FOR NO TEST. SAME COLUMNS.
00029 *  CHERK  T PUT F FOR NO TEST. SAME COLUMNS.
00030 *  CSYRK  T PUT F FOR NO TEST. SAME COLUMNS.
00031 *  CHER2K T PUT F FOR NO TEST. SAME COLUMNS.
00032 *  CSYR2K T PUT F FOR NO TEST. SAME COLUMNS.
00033 *
00034 *  See:
00035 *
00036 *     Dongarra J. J., Du Croz J. J., Duff I. S. and Hammarling S.
00037 *     A Set of Level 3 Basic Linear Algebra Subprograms.
00038 *
00039 *     Technical Memorandum No.88 (Revision 1), Mathematics and
00040 *     Computer Science Division, Argonne National Laboratory, 9700
00041 *     South Cass Avenue, Argonne, Illinois 60439, US.
00042 *
00043 *  -- Written on 8-February-1989.
00044 *     Jack Dongarra, Argonne National Laboratory.
00045 *     Iain Duff, AERE Harwell.
00046 *     Jeremy Du Croz, Numerical Algorithms Group Ltd.
00047 *     Sven Hammarling, Numerical Algorithms Group Ltd.
00048 *
00049 *     10-9-00:  Change STATUS='NEW' to 'UNKNOWN' so that the testers
00050 *               can be run multiple times without deleting generated
00051 *               output files (susan)
00052 *
00053 *     .. Parameters ..
00054       INTEGER            NIN
00055       PARAMETER          ( NIN = 5 )
00056       INTEGER            NSUBS
00057       PARAMETER          ( NSUBS = 9 )
00058       COMPLEX            ZERO, ONE
00059       PARAMETER          ( ZERO = ( 0.0, 0.0 ), ONE = ( 1.0, 0.0 ) )
00060       REAL               RZERO, RHALF, RONE
00061       PARAMETER          ( RZERO = 0.0, RHALF = 0.5, RONE = 1.0 )
00062       INTEGER            NMAX
00063       PARAMETER          ( NMAX = 65 )
00064       INTEGER            NIDMAX, NALMAX, NBEMAX
00065       PARAMETER          ( NIDMAX = 9, NALMAX = 7, NBEMAX = 7 )
00066 *     .. Local Scalars ..
00067       REAL               EPS, ERR, THRESH
00068       INTEGER            I, ISNUM, J, N, NALF, NBET, NIDIM, NOUT, NTRA
00069       LOGICAL            FATAL, LTESTT, REWI, SAME, SFATAL, TRACE,
00070      $                   TSTERR
00071       CHARACTER*1        TRANSA, TRANSB
00072       CHARACTER*6        SNAMET
00073       CHARACTER*32       SNAPS, SUMMRY
00074 *     .. Local Arrays ..
00075       COMPLEX            AA( NMAX*NMAX ), AB( NMAX, 2*NMAX ),
00076      $                   ALF( NALMAX ), AS( NMAX*NMAX ),
00077      $                   BB( NMAX*NMAX ), BET( NBEMAX ),
00078      $                   BS( NMAX*NMAX ), C( NMAX, NMAX ),
00079      $                   CC( NMAX*NMAX ), CS( NMAX*NMAX ), CT( NMAX ),
00080      $                   W( 2*NMAX )
00081       REAL               G( NMAX )
00082       INTEGER            IDIM( NIDMAX )
00083       LOGICAL            LTEST( NSUBS )
00084       CHARACTER*6        SNAMES( NSUBS )
00085 *     .. External Functions ..
00086       REAL               SDIFF
00087       LOGICAL            LCE
00088       EXTERNAL           SDIFF, LCE
00089 *     .. External Subroutines ..
00090       EXTERNAL           CCHK1, CCHK2, CCHK3, CCHK4, CCHK5, CCHKE, CMMCH
00091 *     .. Intrinsic Functions ..
00092       INTRINSIC          MAX, MIN
00093 *     .. Scalars in Common ..
00094       INTEGER            INFOT, NOUTC
00095       LOGICAL            LERR, OK
00096       CHARACTER*6        SRNAMT
00097 *     .. Common blocks ..
00098       COMMON             /INFOC/INFOT, NOUTC, OK, LERR
00099       COMMON             /SRNAMC/SRNAMT
00100 *     .. Data statements ..
00101       DATA               SNAMES/'CGEMM ', 'CHEMM ', 'CSYMM ', 'CTRMM ',
00102      $                   'CTRSM ', 'CHERK ', 'CSYRK ', 'CHER2K',
00103      $                   'CSYR2K'/
00104 *     .. Executable Statements ..
00105 *
00106 *     Read name and unit number for summary output file and open file.
00107 *
00108       READ( NIN, FMT = * )SUMMRY
00109       READ( NIN, FMT = * )NOUT
00110       OPEN( NOUT, FILE = SUMMRY )
00111       NOUTC = NOUT
00112 *
00113 *     Read name and unit number for snapshot output file and open file.
00114 *
00115       READ( NIN, FMT = * )SNAPS
00116       READ( NIN, FMT = * )NTRA
00117       TRACE = NTRA.GE.0
00118       IF( TRACE )THEN
00119          OPEN( NTRA, FILE = SNAPS )
00120       END IF
00121 *     Read the flag that directs rewinding of the snapshot file.
00122       READ( NIN, FMT = * )REWI
00123       REWI = REWI.AND.TRACE
00124 *     Read the flag that directs stopping on any failure.
00125       READ( NIN, FMT = * )SFATAL
00126 *     Read the flag that indicates whether error exits are to be tested.
00127       READ( NIN, FMT = * )TSTERR
00128 *     Read the threshold value of the test ratio
00129       READ( NIN, FMT = * )THRESH
00130 *
00131 *     Read and check the parameter values for the tests.
00132 *
00133 *     Values of N
00134       READ( NIN, FMT = * )NIDIM
00135       IF( NIDIM.LT.1.OR.NIDIM.GT.NIDMAX )THEN
00136          WRITE( NOUT, FMT = 9997 )'N', NIDMAX
00137          GO TO 220
00138       END IF
00139       READ( NIN, FMT = * )( IDIM( I ), I = 1, NIDIM )
00140       DO 10 I = 1, NIDIM
00141          IF( IDIM( I ).LT.0.OR.IDIM( I ).GT.NMAX )THEN
00142             WRITE( NOUT, FMT = 9996 )NMAX
00143             GO TO 220
00144          END IF
00145    10 CONTINUE
00146 *     Values of ALPHA
00147       READ( NIN, FMT = * )NALF
00148       IF( NALF.LT.1.OR.NALF.GT.NALMAX )THEN
00149          WRITE( NOUT, FMT = 9997 )'ALPHA', NALMAX
00150          GO TO 220
00151       END IF
00152       READ( NIN, FMT = * )( ALF( I ), I = 1, NALF )
00153 *     Values of BETA
00154       READ( NIN, FMT = * )NBET
00155       IF( NBET.LT.1.OR.NBET.GT.NBEMAX )THEN
00156          WRITE( NOUT, FMT = 9997 )'BETA', NBEMAX
00157          GO TO 220
00158       END IF
00159       READ( NIN, FMT = * )( BET( I ), I = 1, NBET )
00160 *
00161 *     Report values of parameters.
00162 *
00163       WRITE( NOUT, FMT = 9995 )
00164       WRITE( NOUT, FMT = 9994 )( IDIM( I ), I = 1, NIDIM )
00165       WRITE( NOUT, FMT = 9993 )( ALF( I ), I = 1, NALF )
00166       WRITE( NOUT, FMT = 9992 )( BET( I ), I = 1, NBET )
00167       IF( .NOT.TSTERR )THEN
00168          WRITE( NOUT, FMT = * )
00169          WRITE( NOUT, FMT = 9984 )
00170       END IF
00171       WRITE( NOUT, FMT = * )
00172       WRITE( NOUT, FMT = 9999 )THRESH
00173       WRITE( NOUT, FMT = * )
00174 *
00175 *     Read names of subroutines and flags which indicate
00176 *     whether they are to be tested.
00177 *
00178       DO 20 I = 1, NSUBS
00179          LTEST( I ) = .FALSE.
00180    20 CONTINUE
00181    30 READ( NIN, FMT = 9988, END = 60 )SNAMET, LTESTT
00182       DO 40 I = 1, NSUBS
00183          IF( SNAMET.EQ.SNAMES( I ) )
00184      $      GO TO 50
00185    40 CONTINUE
00186       WRITE( NOUT, FMT = 9990 )SNAMET
00187       STOP
00188    50 LTEST( I ) = LTESTT
00189       GO TO 30
00190 *
00191    60 CONTINUE
00192       CLOSE ( NIN )
00193 *
00194 *     Compute EPS (the machine precision).
00195 *
00196       EPS = RONE
00197    70 CONTINUE
00198       IF( SDIFF( RONE + EPS, RONE ).EQ.RZERO )
00199      $   GO TO 80
00200       EPS = RHALF*EPS
00201       GO TO 70
00202    80 CONTINUE
00203       EPS = EPS + EPS
00204       WRITE( NOUT, FMT = 9998 )EPS
00205 *
00206 *     Check the reliability of CMMCH using exact data.
00207 *
00208       N = MIN( 32, NMAX )
00209       DO 100 J = 1, N
00210          DO 90 I = 1, N
00211             AB( I, J ) = MAX( I - J + 1, 0 )
00212    90    CONTINUE
00213          AB( J, NMAX + 1 ) = J
00214          AB( 1, NMAX + J ) = J
00215          C( J, 1 ) = ZERO
00216   100 CONTINUE
00217       DO 110 J = 1, N
00218          CC( J ) = J*( ( J + 1 )*J )/2 - ( ( J + 1 )*J*( J - 1 ) )/3
00219   110 CONTINUE
00220 *     CC holds the exact result. On exit from CMMCH CT holds
00221 *     the result computed by CMMCH.
00222       TRANSA = 'N'
00223       TRANSB = 'N'
00224       CALL CMMCH( TRANSA, TRANSB, N, 1, N, ONE, AB, NMAX,
00225      $            AB( 1, NMAX + 1 ), NMAX, ZERO, C, NMAX, CT, G, CC,
00226      $            NMAX, EPS, ERR, FATAL, NOUT, .TRUE. )
00227       SAME = LCE( CC, CT, N )
00228       IF( .NOT.SAME.OR.ERR.NE.RZERO )THEN
00229          WRITE( NOUT, FMT = 9989 )TRANSA, TRANSB, SAME, ERR
00230          STOP
00231       END IF
00232       TRANSB = 'C'
00233       CALL CMMCH( TRANSA, TRANSB, N, 1, N, ONE, AB, NMAX,
00234      $            AB( 1, NMAX + 1 ), NMAX, ZERO, C, NMAX, CT, G, CC,
00235      $            NMAX, EPS, ERR, FATAL, NOUT, .TRUE. )
00236       SAME = LCE( CC, CT, N )
00237       IF( .NOT.SAME.OR.ERR.NE.RZERO )THEN
00238          WRITE( NOUT, FMT = 9989 )TRANSA, TRANSB, SAME, ERR
00239          STOP
00240       END IF
00241       DO 120 J = 1, N
00242          AB( J, NMAX + 1 ) = N - J + 1
00243          AB( 1, NMAX + J ) = N - J + 1
00244   120 CONTINUE
00245       DO 130 J = 1, N
00246          CC( N - J + 1 ) = J*( ( J + 1 )*J )/2 -
00247      $                     ( ( J + 1 )*J*( J - 1 ) )/3
00248   130 CONTINUE
00249       TRANSA = 'C'
00250       TRANSB = 'N'
00251       CALL CMMCH( TRANSA, TRANSB, N, 1, N, ONE, AB, NMAX,
00252      $            AB( 1, NMAX + 1 ), NMAX, ZERO, C, NMAX, CT, G, CC,
00253      $            NMAX, EPS, ERR, FATAL, NOUT, .TRUE. )
00254       SAME = LCE( CC, CT, N )
00255       IF( .NOT.SAME.OR.ERR.NE.RZERO )THEN
00256          WRITE( NOUT, FMT = 9989 )TRANSA, TRANSB, SAME, ERR
00257          STOP
00258       END IF
00259       TRANSB = 'C'
00260       CALL CMMCH( TRANSA, TRANSB, N, 1, N, ONE, AB, NMAX,
00261      $            AB( 1, NMAX + 1 ), NMAX, ZERO, C, NMAX, CT, G, CC,
00262      $            NMAX, EPS, ERR, FATAL, NOUT, .TRUE. )
00263       SAME = LCE( CC, CT, N )
00264       IF( .NOT.SAME.OR.ERR.NE.RZERO )THEN
00265          WRITE( NOUT, FMT = 9989 )TRANSA, TRANSB, SAME, ERR
00266          STOP
00267       END IF
00268 *
00269 *     Test each subroutine in turn.
00270 *
00271       DO 200 ISNUM = 1, NSUBS
00272          WRITE( NOUT, FMT = * )
00273          IF( .NOT.LTEST( ISNUM ) )THEN
00274 *           Subprogram is not to be tested.
00275             WRITE( NOUT, FMT = 9987 )SNAMES( ISNUM )
00276          ELSE
00277             SRNAMT = SNAMES( ISNUM )
00278 *           Test error exits.
00279             IF( TSTERR )THEN
00280                CALL CCHKE( ISNUM, SNAMES( ISNUM ), NOUT )
00281                WRITE( NOUT, FMT = * )
00282             END IF
00283 *           Test computations.
00284             INFOT = 0
00285             OK = .TRUE.
00286             FATAL = .FALSE.
00287             GO TO ( 140, 150, 150, 160, 160, 170, 170,
00288      $              180, 180 )ISNUM
00289 *           Test CGEMM, 01.
00290   140       CALL CCHK1( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
00291      $                  REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
00292      $                  NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C,
00293      $                  CC, CS, CT, G )
00294             GO TO 190
00295 *           Test CHEMM, 02, CSYMM, 03.
00296   150       CALL CCHK2( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
00297      $                  REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
00298      $                  NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C,
00299      $                  CC, CS, CT, G )
00300             GO TO 190
00301 *           Test CTRMM, 04, CTRSM, 05.
00302   160       CALL CCHK3( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
00303      $                  REWI, FATAL, NIDIM, IDIM, NALF, ALF, NMAX, AB,
00304      $                  AA, AS, AB( 1, NMAX + 1 ), BB, BS, CT, G, C )
00305             GO TO 190
00306 *           Test CHERK, 06, CSYRK, 07.
00307   170       CALL CCHK4( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
00308      $                  REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
00309      $                  NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C,
00310      $                  CC, CS, CT, G )
00311             GO TO 190
00312 *           Test CHER2K, 08, CSYR2K, 09.
00313   180       CALL CCHK5( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
00314      $                  REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
00315      $                  NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W )
00316             GO TO 190
00317 *
00318   190       IF( FATAL.AND.SFATAL )
00319      $         GO TO 210
00320          END IF
00321   200 CONTINUE
00322       WRITE( NOUT, FMT = 9986 )
00323       GO TO 230
00324 *
00325   210 CONTINUE
00326       WRITE( NOUT, FMT = 9985 )
00327       GO TO 230
00328 *
00329   220 CONTINUE
00330       WRITE( NOUT, FMT = 9991 )
00331 *
00332   230 CONTINUE
00333       IF( TRACE )
00334      $   CLOSE ( NTRA )
00335       CLOSE ( NOUT )
00336       STOP
00337 *
00338  9999 FORMAT( ' ROUTINES PASS COMPUTATIONAL TESTS IF TEST RATIO IS LES',
00339      $      'S THAN', F8.2 )
00340  9998 FORMAT( ' RELATIVE MACHINE PRECISION IS TAKEN TO BE', 1P, E9.1 )
00341  9997 FORMAT( ' NUMBER OF VALUES OF ', A, ' IS LESS THAN 1 OR GREATER ',
00342      $      'THAN ', I2 )
00343  9996 FORMAT( ' VALUE OF N IS LESS THAN 0 OR GREATER THAN ', I2 )
00344  9995 FORMAT( ' TESTS OF THE COMPLEX          LEVEL 3 BLAS', //' THE F',
00345      $      'OLLOWING PARAMETER VALUES WILL BE USED:' )
00346  9994 FORMAT( '   FOR N              ', 9I6 )
00347  9993 FORMAT( '   FOR ALPHA          ',
00348      $      7( '(', F4.1, ',', F4.1, ')  ', : ) )
00349  9992 FORMAT( '   FOR BETA           ',
00350      $      7( '(', F4.1, ',', F4.1, ')  ', : ) )
00351  9991 FORMAT( ' AMEND DATA FILE OR INCREASE ARRAY SIZES IN PROGRAM',
00352      $      /' ******* TESTS ABANDONED *******' )
00353  9990 FORMAT( ' SUBPROGRAM NAME ', A6, ' NOT RECOGNIZED', /' ******* T',
00354      $      'ESTS ABANDONED *******' )
00355  9989 FORMAT( ' ERROR IN CMMCH -  IN-LINE DOT PRODUCTS ARE BEING EVALU',
00356      $      'ATED WRONGLY.', /' CMMCH WAS CALLED WITH TRANSA = ', A1,
00357      $      ' AND TRANSB = ', A1, /' AND RETURNED SAME = ', L1, ' AND ',
00358      $      'ERR = ', F12.3, '.', /' THIS MAY BE DUE TO FAULTS IN THE ',
00359      $      'ARITHMETIC OR THE COMPILER.', /' ******* TESTS ABANDONED ',
00360      $      '*******' )
00361  9988 FORMAT( A6, L2 )
00362  9987 FORMAT( 1X, A6, ' WAS NOT TESTED' )
00363  9986 FORMAT( /' END OF TESTS' )
00364  9985 FORMAT( /' ******* FATAL ERROR - TESTS ABANDONED *******' )
00365  9984 FORMAT( ' ERROR-EXITS WILL NOT BE TESTED' )
00366 *
00367 *     End of CBLAT3.
00368 *
00369       END
00370       SUBROUTINE CCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
00371      $                  FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
00372      $                  A, AA, AS, B, BB, BS, C, CC, CS, CT, G )
00373 *
00374 *  Tests CGEMM.
00375 *
00376 *  Auxiliary routine for test program for Level 3 Blas.
00377 *
00378 *  -- Written on 8-February-1989.
00379 *     Jack Dongarra, Argonne National Laboratory.
00380 *     Iain Duff, AERE Harwell.
00381 *     Jeremy Du Croz, Numerical Algorithms Group Ltd.
00382 *     Sven Hammarling, Numerical Algorithms Group Ltd.
00383 *
00384 *     .. Parameters ..
00385       COMPLEX            ZERO
00386       PARAMETER          ( ZERO = ( 0.0, 0.0 ) )
00387       REAL               RZERO
00388       PARAMETER          ( RZERO = 0.0 )
00389 *     .. Scalar Arguments ..
00390       REAL               EPS, THRESH
00391       INTEGER            NALF, NBET, NIDIM, NMAX, NOUT, NTRA
00392       LOGICAL            FATAL, REWI, TRACE
00393       CHARACTER*6        SNAME
00394 *     .. Array Arguments ..
00395       COMPLEX            A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
00396      $                   AS( NMAX*NMAX ), B( NMAX, NMAX ),
00397      $                   BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ),
00398      $                   C( NMAX, NMAX ), CC( NMAX*NMAX ),
00399      $                   CS( NMAX*NMAX ), CT( NMAX )
00400       REAL               G( NMAX )
00401       INTEGER            IDIM( NIDIM )
00402 *     .. Local Scalars ..
00403       COMPLEX            ALPHA, ALS, BETA, BLS
00404       REAL               ERR, ERRMAX
00405       INTEGER            I, IA, IB, ICA, ICB, IK, IM, IN, K, KS, LAA,
00406      $                   LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS, M,
00407      $                   MA, MB, MS, N, NA, NARGS, NB, NC, NS
00408       LOGICAL            NULL, RESET, SAME, TRANA, TRANB
00409       CHARACTER*1        TRANAS, TRANBS, TRANSA, TRANSB
00410       CHARACTER*3        ICH
00411 *     .. Local Arrays ..
00412       LOGICAL            ISAME( 13 )
00413 *     .. External Functions ..
00414       LOGICAL            LCE, LCERES
00415       EXTERNAL           LCE, LCERES
00416 *     .. External Subroutines ..
00417       EXTERNAL           CGEMM, CMAKE, CMMCH
00418 *     .. Intrinsic Functions ..
00419       INTRINSIC          MAX
00420 *     .. Scalars in Common ..
00421       INTEGER            INFOT, NOUTC
00422       LOGICAL            LERR, OK
00423 *     .. Common blocks ..
00424       COMMON             /INFOC/INFOT, NOUTC, OK, LERR
00425 *     .. Data statements ..
00426       DATA               ICH/'NTC'/
00427 *     .. Executable Statements ..
00428 *
00429       NARGS = 13
00430       NC = 0
00431       RESET = .TRUE.
00432       ERRMAX = RZERO
00433 *
00434       DO 110 IM = 1, NIDIM
00435          M = IDIM( IM )
00436 *
00437          DO 100 IN = 1, NIDIM
00438             N = IDIM( IN )
00439 *           Set LDC to 1 more than minimum value if room.
00440             LDC = M
00441             IF( LDC.LT.NMAX )
00442      $         LDC = LDC + 1
00443 *           Skip tests if not enough room.
00444             IF( LDC.GT.NMAX )
00445      $         GO TO 100
00446             LCC = LDC*N
00447             NULL = N.LE.0.OR.M.LE.0
00448 *
00449             DO 90 IK = 1, NIDIM
00450                K = IDIM( IK )
00451 *
00452                DO 80 ICA = 1, 3
00453                   TRANSA = ICH( ICA: ICA )
00454                   TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C'
00455 *
00456                   IF( TRANA )THEN
00457                      MA = K
00458                      NA = M
00459                   ELSE
00460                      MA = M
00461                      NA = K
00462                   END IF
00463 *                 Set LDA to 1 more than minimum value if room.
00464                   LDA = MA
00465                   IF( LDA.LT.NMAX )
00466      $               LDA = LDA + 1
00467 *                 Skip tests if not enough room.
00468                   IF( LDA.GT.NMAX )
00469      $               GO TO 80
00470                   LAA = LDA*NA
00471 *
00472 *                 Generate the matrix A.
00473 *
00474                   CALL CMAKE( 'GE', ' ', ' ', MA, NA, A, NMAX, AA, LDA,
00475      $                        RESET, ZERO )
00476 *
00477                   DO 70 ICB = 1, 3
00478                      TRANSB = ICH( ICB: ICB )
00479                      TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C'
00480 *
00481                      IF( TRANB )THEN
00482                         MB = N
00483                         NB = K
00484                      ELSE
00485                         MB = K
00486                         NB = N
00487                      END IF
00488 *                    Set LDB to 1 more than minimum value if room.
00489                      LDB = MB
00490                      IF( LDB.LT.NMAX )
00491      $                  LDB = LDB + 1
00492 *                    Skip tests if not enough room.
00493                      IF( LDB.GT.NMAX )
00494      $                  GO TO 70
00495                      LBB = LDB*NB
00496 *
00497 *                    Generate the matrix B.
00498 *
00499                      CALL CMAKE( 'GE', ' ', ' ', MB, NB, B, NMAX, BB,
00500      $                           LDB, RESET, ZERO )
00501 *
00502                      DO 60 IA = 1, NALF
00503                         ALPHA = ALF( IA )
00504 *
00505                         DO 50 IB = 1, NBET
00506                            BETA = BET( IB )
00507 *
00508 *                          Generate the matrix C.
00509 *
00510                            CALL CMAKE( 'GE', ' ', ' ', M, N, C, NMAX,
00511      $                                 CC, LDC, RESET, ZERO )
00512 *
00513                            NC = NC + 1
00514 *
00515 *                          Save every datum before calling the
00516 *                          subroutine.
00517 *
00518                            TRANAS = TRANSA
00519                            TRANBS = TRANSB
00520                            MS = M
00521                            NS = N
00522                            KS = K
00523                            ALS = ALPHA
00524                            DO 10 I = 1, LAA
00525                               AS( I ) = AA( I )
00526    10                      CONTINUE
00527                            LDAS = LDA
00528                            DO 20 I = 1, LBB
00529                               BS( I ) = BB( I )
00530    20                      CONTINUE
00531                            LDBS = LDB
00532                            BLS = BETA
00533                            DO 30 I = 1, LCC
00534                               CS( I ) = CC( I )
00535    30                      CONTINUE
00536                            LDCS = LDC
00537 *
00538 *                          Call the subroutine.
00539 *
00540                            IF( TRACE )
00541      $                        WRITE( NTRA, FMT = 9995 )NC, SNAME,
00542      $                        TRANSA, TRANSB, M, N, K, ALPHA, LDA, LDB,
00543      $                        BETA, LDC
00544                            IF( REWI )
00545      $                        REWIND NTRA
00546                            CALL CGEMM( TRANSA, TRANSB, M, N, K, ALPHA,
00547      $                                 AA, LDA, BB, LDB, BETA, CC, LDC )
00548 *
00549 *                          Check if error-exit was taken incorrectly.
00550 *
00551                            IF( .NOT.OK )THEN
00552                               WRITE( NOUT, FMT = 9994 )
00553                               FATAL = .TRUE.
00554                               GO TO 120
00555                            END IF
00556 *
00557 *                          See what data changed inside subroutines.
00558 *
00559                            ISAME( 1 ) = TRANSA.EQ.TRANAS
00560                            ISAME( 2 ) = TRANSB.EQ.TRANBS
00561                            ISAME( 3 ) = MS.EQ.M
00562                            ISAME( 4 ) = NS.EQ.N
00563                            ISAME( 5 ) = KS.EQ.K
00564                            ISAME( 6 ) = ALS.EQ.ALPHA
00565                            ISAME( 7 ) = LCE( AS, AA, LAA )
00566                            ISAME( 8 ) = LDAS.EQ.LDA
00567                            ISAME( 9 ) = LCE( BS, BB, LBB )
00568                            ISAME( 10 ) = LDBS.EQ.LDB
00569                            ISAME( 11 ) = BLS.EQ.BETA
00570                            IF( NULL )THEN
00571                               ISAME( 12 ) = LCE( CS, CC, LCC )
00572                            ELSE
00573                               ISAME( 12 ) = LCERES( 'GE', ' ', M, N, CS,
00574      $                                      CC, LDC )
00575                            END IF
00576                            ISAME( 13 ) = LDCS.EQ.LDC
00577 *
00578 *                          If data was incorrectly changed, report
00579 *                          and return.
00580 *
00581                            SAME = .TRUE.
00582                            DO 40 I = 1, NARGS
00583                               SAME = SAME.AND.ISAME( I )
00584                               IF( .NOT.ISAME( I ) )
00585      $                           WRITE( NOUT, FMT = 9998 )I
00586    40                      CONTINUE
00587                            IF( .NOT.SAME )THEN
00588                               FATAL = .TRUE.
00589                               GO TO 120
00590                            END IF
00591 *
00592                            IF( .NOT.NULL )THEN
00593 *
00594 *                             Check the result.
00595 *
00596                               CALL CMMCH( TRANSA, TRANSB, M, N, K,
00597      $                                    ALPHA, A, NMAX, B, NMAX, BETA,
00598      $                                    C, NMAX, CT, G, CC, LDC, EPS,
00599      $                                    ERR, FATAL, NOUT, .TRUE. )
00600                               ERRMAX = MAX( ERRMAX, ERR )
00601 *                             If got really bad answer, report and
00602 *                             return.
00603                               IF( FATAL )
00604      $                           GO TO 120
00605                            END IF
00606 *
00607    50                   CONTINUE
00608 *
00609    60                CONTINUE
00610 *
00611    70             CONTINUE
00612 *
00613    80          CONTINUE
00614 *
00615    90       CONTINUE
00616 *
00617   100    CONTINUE
00618 *
00619   110 CONTINUE
00620 *
00621 *     Report result.
00622 *
00623       IF( ERRMAX.LT.THRESH )THEN
00624          WRITE( NOUT, FMT = 9999 )SNAME, NC
00625       ELSE
00626          WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
00627       END IF
00628       GO TO 130
00629 *
00630   120 CONTINUE
00631       WRITE( NOUT, FMT = 9996 )SNAME
00632       WRITE( NOUT, FMT = 9995 )NC, SNAME, TRANSA, TRANSB, M, N, K,
00633      $   ALPHA, LDA, LDB, BETA, LDC
00634 *
00635   130 CONTINUE
00636       RETURN
00637 *
00638  9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
00639      $      'S)' )
00640  9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
00641      $      'ANGED INCORRECTLY *******' )
00642  9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
00643      $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
00644      $      ' - SUSPECT *******' )
00645  9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
00646  9995 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',''', A1, ''',',
00647      $      3( I3, ',' ), '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3,
00648      $      ',(', F4.1, ',', F4.1, '), C,', I3, ').' )
00649  9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
00650      $      '******' )
00651 *
00652 *     End of CCHK1.
00653 *
00654       END
00655       SUBROUTINE CCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
00656      $                  FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
00657      $                  A, AA, AS, B, BB, BS, C, CC, CS, CT, G )
00658 *
00659 *  Tests CHEMM and CSYMM.
00660 *
00661 *  Auxiliary routine for test program for Level 3 Blas.
00662 *
00663 *  -- Written on 8-February-1989.
00664 *     Jack Dongarra, Argonne National Laboratory.
00665 *     Iain Duff, AERE Harwell.
00666 *     Jeremy Du Croz, Numerical Algorithms Group Ltd.
00667 *     Sven Hammarling, Numerical Algorithms Group Ltd.
00668 *
00669 *     .. Parameters ..
00670       COMPLEX            ZERO
00671       PARAMETER          ( ZERO = ( 0.0, 0.0 ) )
00672       REAL               RZERO
00673       PARAMETER          ( RZERO = 0.0 )
00674 *     .. Scalar Arguments ..
00675       REAL               EPS, THRESH
00676       INTEGER            NALF, NBET, NIDIM, NMAX, NOUT, NTRA
00677       LOGICAL            FATAL, REWI, TRACE
00678       CHARACTER*6        SNAME
00679 *     .. Array Arguments ..
00680       COMPLEX            A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
00681      $                   AS( NMAX*NMAX ), B( NMAX, NMAX ),
00682      $                   BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ),
00683      $                   C( NMAX, NMAX ), CC( NMAX*NMAX ),
00684      $                   CS( NMAX*NMAX ), CT( NMAX )
00685       REAL               G( NMAX )
00686       INTEGER            IDIM( NIDIM )
00687 *     .. Local Scalars ..
00688       COMPLEX            ALPHA, ALS, BETA, BLS
00689       REAL               ERR, ERRMAX
00690       INTEGER            I, IA, IB, ICS, ICU, IM, IN, LAA, LBB, LCC,
00691      $                   LDA, LDAS, LDB, LDBS, LDC, LDCS, M, MS, N, NA,
00692      $                   NARGS, NC, NS
00693       LOGICAL            CONJ, LEFT, NULL, RESET, SAME
00694       CHARACTER*1        SIDE, SIDES, UPLO, UPLOS
00695       CHARACTER*2        ICHS, ICHU
00696 *     .. Local Arrays ..
00697       LOGICAL            ISAME( 13 )
00698 *     .. External Functions ..
00699       LOGICAL            LCE, LCERES
00700       EXTERNAL           LCE, LCERES
00701 *     .. External Subroutines ..
00702       EXTERNAL           CHEMM, CMAKE, CMMCH, CSYMM
00703 *     .. Intrinsic Functions ..
00704       INTRINSIC          MAX
00705 *     .. Scalars in Common ..
00706       INTEGER            INFOT, NOUTC
00707       LOGICAL            LERR, OK
00708 *     .. Common blocks ..
00709       COMMON             /INFOC/INFOT, NOUTC, OK, LERR
00710 *     .. Data statements ..
00711       DATA               ICHS/'LR'/, ICHU/'UL'/
00712 *     .. Executable Statements ..
00713       CONJ = SNAME( 2: 3 ).EQ.'HE'
00714 *
00715       NARGS = 12
00716       NC = 0
00717       RESET = .TRUE.
00718       ERRMAX = RZERO
00719 *
00720       DO 100 IM = 1, NIDIM
00721          M = IDIM( IM )
00722 *
00723          DO 90 IN = 1, NIDIM
00724             N = IDIM( IN )
00725 *           Set LDC to 1 more than minimum value if room.
00726             LDC = M
00727             IF( LDC.LT.NMAX )
00728      $         LDC = LDC + 1
00729 *           Skip tests if not enough room.
00730             IF( LDC.GT.NMAX )
00731      $         GO TO 90
00732             LCC = LDC*N
00733             NULL = N.LE.0.OR.M.LE.0
00734 *           Set LDB to 1 more than minimum value if room.
00735             LDB = M
00736             IF( LDB.LT.NMAX )
00737      $         LDB = LDB + 1
00738 *           Skip tests if not enough room.
00739             IF( LDB.GT.NMAX )
00740      $         GO TO 90
00741             LBB = LDB*N
00742 *
00743 *           Generate the matrix B.
00744 *
00745             CALL CMAKE( 'GE', ' ', ' ', M, N, B, NMAX, BB, LDB, RESET,
00746      $                  ZERO )
00747 *
00748             DO 80 ICS = 1, 2
00749                SIDE = ICHS( ICS: ICS )
00750                LEFT = SIDE.EQ.'L'
00751 *
00752                IF( LEFT )THEN
00753                   NA = M
00754                ELSE
00755                   NA = N
00756                END IF
00757 *              Set LDA to 1 more than minimum value if room.
00758                LDA = NA
00759                IF( LDA.LT.NMAX )
00760      $            LDA = LDA + 1
00761 *              Skip tests if not enough room.
00762                IF( LDA.GT.NMAX )
00763      $            GO TO 80
00764                LAA = LDA*NA
00765 *
00766                DO 70 ICU = 1, 2
00767                   UPLO = ICHU( ICU: ICU )
00768 *
00769 *                 Generate the hermitian or symmetric matrix A.
00770 *
00771                   CALL CMAKE( SNAME( 2: 3 ), UPLO, ' ', NA, NA, A, NMAX,
00772      $                        AA, LDA, RESET, ZERO )
00773 *
00774                   DO 60 IA = 1, NALF
00775                      ALPHA = ALF( IA )
00776 *
00777                      DO 50 IB = 1, NBET
00778                         BETA = BET( IB )
00779 *
00780 *                       Generate the matrix C.
00781 *
00782                         CALL CMAKE( 'GE', ' ', ' ', M, N, C, NMAX, CC,
00783      $                              LDC, RESET, ZERO )
00784 *
00785                         NC = NC + 1
00786 *
00787 *                       Save every datum before calling the
00788 *                       subroutine.
00789 *
00790                         SIDES = SIDE
00791                         UPLOS = UPLO
00792                         MS = M
00793                         NS = N
00794                         ALS = ALPHA
00795                         DO 10 I = 1, LAA
00796                            AS( I ) = AA( I )
00797    10                   CONTINUE
00798                         LDAS = LDA
00799                         DO 20 I = 1, LBB
00800                            BS( I ) = BB( I )
00801    20                   CONTINUE
00802                         LDBS = LDB
00803                         BLS = BETA
00804                         DO 30 I = 1, LCC
00805                            CS( I ) = CC( I )
00806    30                   CONTINUE
00807                         LDCS = LDC
00808 *
00809 *                       Call the subroutine.
00810 *
00811                         IF( TRACE )
00812      $                     WRITE( NTRA, FMT = 9995 )NC, SNAME, SIDE,
00813      $                     UPLO, M, N, ALPHA, LDA, LDB, BETA, LDC
00814                         IF( REWI )
00815      $                     REWIND NTRA
00816                         IF( CONJ )THEN
00817                            CALL CHEMM( SIDE, UPLO, M, N, ALPHA, AA, LDA,
00818      $                                 BB, LDB, BETA, CC, LDC )
00819                         ELSE
00820                            CALL CSYMM( SIDE, UPLO, M, N, ALPHA, AA, LDA,
00821      $                                 BB, LDB, BETA, CC, LDC )
00822                         END IF
00823 *
00824 *                       Check if error-exit was taken incorrectly.
00825 *
00826                         IF( .NOT.OK )THEN
00827                            WRITE( NOUT, FMT = 9994 )
00828                            FATAL = .TRUE.
00829                            GO TO 110
00830                         END IF
00831 *
00832 *                       See what data changed inside subroutines.
00833 *
00834                         ISAME( 1 ) = SIDES.EQ.SIDE
00835                         ISAME( 2 ) = UPLOS.EQ.UPLO
00836                         ISAME( 3 ) = MS.EQ.M
00837                         ISAME( 4 ) = NS.EQ.N
00838                         ISAME( 5 ) = ALS.EQ.ALPHA
00839                         ISAME( 6 ) = LCE( AS, AA, LAA )
00840                         ISAME( 7 ) = LDAS.EQ.LDA
00841                         ISAME( 8 ) = LCE( BS, BB, LBB )
00842                         ISAME( 9 ) = LDBS.EQ.LDB
00843                         ISAME( 10 ) = BLS.EQ.BETA
00844                         IF( NULL )THEN
00845                            ISAME( 11 ) = LCE( CS, CC, LCC )
00846                         ELSE
00847                            ISAME( 11 ) = LCERES( 'GE', ' ', M, N, CS,
00848      $                                   CC, LDC )
00849                         END IF
00850                         ISAME( 12 ) = LDCS.EQ.LDC
00851 *
00852 *                       If data was incorrectly changed, report and
00853 *                       return.
00854 *
00855                         SAME = .TRUE.
00856                         DO 40 I = 1, NARGS
00857                            SAME = SAME.AND.ISAME( I )
00858                            IF( .NOT.ISAME( I ) )
00859      $                        WRITE( NOUT, FMT = 9998 )I
00860    40                   CONTINUE
00861                         IF( .NOT.SAME )THEN
00862                            FATAL = .TRUE.
00863                            GO TO 110
00864                         END IF
00865 *
00866                         IF( .NOT.NULL )THEN
00867 *
00868 *                          Check the result.
00869 *
00870                            IF( LEFT )THEN
00871                               CALL CMMCH( 'N', 'N', M, N, M, ALPHA, A,
00872      $                                    NMAX, B, NMAX, BETA, C, NMAX,
00873      $                                    CT, G, CC, LDC, EPS, ERR,
00874      $                                    FATAL, NOUT, .TRUE. )
00875                            ELSE
00876                               CALL CMMCH( 'N', 'N', M, N, N, ALPHA, B,
00877      $                                    NMAX, A, NMAX, BETA, C, NMAX,
00878      $                                    CT, G, CC, LDC, EPS, ERR,
00879      $                                    FATAL, NOUT, .TRUE. )
00880                            END IF
00881                            ERRMAX = MAX( ERRMAX, ERR )
00882 *                          If got really bad answer, report and
00883 *                          return.
00884                            IF( FATAL )
00885      $                        GO TO 110
00886                         END IF
00887 *
00888    50                CONTINUE
00889 *
00890    60             CONTINUE
00891 *
00892    70          CONTINUE
00893 *
00894    80       CONTINUE
00895 *
00896    90    CONTINUE
00897 *
00898   100 CONTINUE
00899 *
00900 *     Report result.
00901 *
00902       IF( ERRMAX.LT.THRESH )THEN
00903          WRITE( NOUT, FMT = 9999 )SNAME, NC
00904       ELSE
00905          WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
00906       END IF
00907       GO TO 120
00908 *
00909   110 CONTINUE
00910       WRITE( NOUT, FMT = 9996 )SNAME
00911       WRITE( NOUT, FMT = 9995 )NC, SNAME, SIDE, UPLO, M, N, ALPHA, LDA,
00912      $   LDB, BETA, LDC
00913 *
00914   120 CONTINUE
00915       RETURN
00916 *
00917  9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
00918      $      'S)' )
00919  9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
00920      $      'ANGED INCORRECTLY *******' )
00921  9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
00922      $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
00923      $      ' - SUSPECT *******' )
00924  9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
00925  9995 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
00926      $      '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',(', F4.1,
00927      $      ',', F4.1, '), C,', I3, ')    .' )
00928  9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
00929      $      '******' )
00930 *
00931 *     End of CCHK2.
00932 *
00933       END
00934       SUBROUTINE CCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
00935      $                  FATAL, NIDIM, IDIM, NALF, ALF, NMAX, A, AA, AS,
00936      $                  B, BB, BS, CT, G, C )
00937 *
00938 *  Tests CTRMM and CTRSM.
00939 *
00940 *  Auxiliary routine for test program for Level 3 Blas.
00941 *
00942 *  -- Written on 8-February-1989.
00943 *     Jack Dongarra, Argonne National Laboratory.
00944 *     Iain Duff, AERE Harwell.
00945 *     Jeremy Du Croz, Numerical Algorithms Group Ltd.
00946 *     Sven Hammarling, Numerical Algorithms Group Ltd.
00947 *
00948 *     .. Parameters ..
00949       COMPLEX            ZERO, ONE
00950       PARAMETER          ( ZERO = ( 0.0, 0.0 ), ONE = ( 1.0, 0.0 ) )
00951       REAL               RZERO
00952       PARAMETER          ( RZERO = 0.0 )
00953 *     .. Scalar Arguments ..
00954       REAL               EPS, THRESH
00955       INTEGER            NALF, NIDIM, NMAX, NOUT, NTRA
00956       LOGICAL            FATAL, REWI, TRACE
00957       CHARACTER*6        SNAME
00958 *     .. Array Arguments ..
00959       COMPLEX            A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
00960      $                   AS( NMAX*NMAX ), B( NMAX, NMAX ),
00961      $                   BB( NMAX*NMAX ), BS( NMAX*NMAX ),
00962      $                   C( NMAX, NMAX ), CT( NMAX )
00963       REAL               G( NMAX )
00964       INTEGER            IDIM( NIDIM )
00965 *     .. Local Scalars ..
00966       COMPLEX            ALPHA, ALS
00967       REAL               ERR, ERRMAX
00968       INTEGER            I, IA, ICD, ICS, ICT, ICU, IM, IN, J, LAA, LBB,
00969      $                   LDA, LDAS, LDB, LDBS, M, MS, N, NA, NARGS, NC,
00970      $                   NS
00971       LOGICAL            LEFT, NULL, RESET, SAME
00972       CHARACTER*1        DIAG, DIAGS, SIDE, SIDES, TRANAS, TRANSA, UPLO,
00973      $                   UPLOS
00974       CHARACTER*2        ICHD, ICHS, ICHU
00975       CHARACTER*3        ICHT
00976 *     .. Local Arrays ..
00977       LOGICAL            ISAME( 13 )
00978 *     .. External Functions ..
00979       LOGICAL            LCE, LCERES
00980       EXTERNAL           LCE, LCERES
00981 *     .. External Subroutines ..
00982       EXTERNAL           CMAKE, CMMCH, CTRMM, CTRSM
00983 *     .. Intrinsic Functions ..
00984       INTRINSIC          MAX
00985 *     .. Scalars in Common ..
00986       INTEGER            INFOT, NOUTC
00987       LOGICAL            LERR, OK
00988 *     .. Common blocks ..
00989       COMMON             /INFOC/INFOT, NOUTC, OK, LERR
00990 *     .. Data statements ..
00991       DATA               ICHU/'UL'/, ICHT/'NTC'/, ICHD/'UN'/, ICHS/'LR'/
00992 *     .. Executable Statements ..
00993 *
00994       NARGS = 11
00995       NC = 0
00996       RESET = .TRUE.
00997       ERRMAX = RZERO
00998 *     Set up zero matrix for CMMCH.
00999       DO 20 J = 1, NMAX
01000          DO 10 I = 1, NMAX
01001             C( I, J ) = ZERO
01002    10    CONTINUE
01003    20 CONTINUE
01004 *
01005       DO 140 IM = 1, NIDIM
01006          M = IDIM( IM )
01007 *
01008          DO 130 IN = 1, NIDIM
01009             N = IDIM( IN )
01010 *           Set LDB to 1 more than minimum value if room.
01011             LDB = M
01012             IF( LDB.LT.NMAX )
01013      $         LDB = LDB + 1
01014 *           Skip tests if not enough room.
01015             IF( LDB.GT.NMAX )
01016      $         GO TO 130
01017             LBB = LDB*N
01018             NULL = M.LE.0.OR.N.LE.0
01019 *
01020             DO 120 ICS = 1, 2
01021                SIDE = ICHS( ICS: ICS )
01022                LEFT = SIDE.EQ.'L'
01023                IF( LEFT )THEN
01024                   NA = M
01025                ELSE
01026                   NA = N
01027                END IF
01028 *              Set LDA to 1 more than minimum value if room.
01029                LDA = NA
01030                IF( LDA.LT.NMAX )
01031      $            LDA = LDA + 1
01032 *              Skip tests if not enough room.
01033                IF( LDA.GT.NMAX )
01034      $            GO TO 130
01035                LAA = LDA*NA
01036 *
01037                DO 110 ICU = 1, 2
01038                   UPLO = ICHU( ICU: ICU )
01039 *
01040                   DO 100 ICT = 1, 3
01041                      TRANSA = ICHT( ICT: ICT )
01042 *
01043                      DO 90 ICD = 1, 2
01044                         DIAG = ICHD( ICD: ICD )
01045 *
01046                         DO 80 IA = 1, NALF
01047                            ALPHA = ALF( IA )
01048 *
01049 *                          Generate the matrix A.
01050 *
01051                            CALL CMAKE( 'TR', UPLO, DIAG, NA, NA, A,
01052      $                                 NMAX, AA, LDA, RESET, ZERO )
01053 *
01054 *                          Generate the matrix B.
01055 *
01056                            CALL CMAKE( 'GE', ' ', ' ', M, N, B, NMAX,
01057      $                                 BB, LDB, RESET, ZERO )
01058 *
01059                            NC = NC + 1
01060 *
01061 *                          Save every datum before calling the
01062 *                          subroutine.
01063 *
01064                            SIDES = SIDE
01065                            UPLOS = UPLO
01066                            TRANAS = TRANSA
01067                            DIAGS = DIAG
01068                            MS = M
01069                            NS = N
01070                            ALS = ALPHA
01071                            DO 30 I = 1, LAA
01072                               AS( I ) = AA( I )
01073    30                      CONTINUE
01074                            LDAS = LDA
01075                            DO 40 I = 1, LBB
01076                               BS( I ) = BB( I )
01077    40                      CONTINUE
01078                            LDBS = LDB
01079 *
01080 *                          Call the subroutine.
01081 *
01082                            IF( SNAME( 4: 5 ).EQ.'MM' )THEN
01083                               IF( TRACE )
01084      $                           WRITE( NTRA, FMT = 9995 )NC, SNAME,
01085      $                           SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA,
01086      $                           LDA, LDB
01087                               IF( REWI )
01088      $                           REWIND NTRA
01089                               CALL CTRMM( SIDE, UPLO, TRANSA, DIAG, M,
01090      $                                    N, ALPHA, AA, LDA, BB, LDB )
01091                            ELSE IF( SNAME( 4: 5 ).EQ.'SM' )THEN
01092                               IF( TRACE )
01093      $                           WRITE( NTRA, FMT = 9995 )NC, SNAME,
01094      $                           SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA,
01095      $                           LDA, LDB
01096                               IF( REWI )
01097      $                           REWIND NTRA
01098                               CALL CTRSM( SIDE, UPLO, TRANSA, DIAG, M,
01099      $                                    N, ALPHA, AA, LDA, BB, LDB )
01100                            END IF
01101 *
01102 *                          Check if error-exit was taken incorrectly.
01103 *
01104                            IF( .NOT.OK )THEN
01105                               WRITE( NOUT, FMT = 9994 )
01106                               FATAL = .TRUE.
01107                               GO TO 150
01108                            END IF
01109 *
01110 *                          See what data changed inside subroutines.
01111 *
01112                            ISAME( 1 ) = SIDES.EQ.SIDE
01113                            ISAME( 2 ) = UPLOS.EQ.UPLO
01114                            ISAME( 3 ) = TRANAS.EQ.TRANSA
01115                            ISAME( 4 ) = DIAGS.EQ.DIAG
01116                            ISAME( 5 ) = MS.EQ.M
01117                            ISAME( 6 ) = NS.EQ.N
01118                            ISAME( 7 ) = ALS.EQ.ALPHA
01119                            ISAME( 8 ) = LCE( AS, AA, LAA )
01120                            ISAME( 9 ) = LDAS.EQ.LDA
01121                            IF( NULL )THEN
01122                               ISAME( 10 ) = LCE( BS, BB, LBB )
01123                            ELSE
01124                               ISAME( 10 ) = LCERES( 'GE', ' ', M, N, BS,
01125      $                                      BB, LDB )
01126                            END IF
01127                            ISAME( 11 ) = LDBS.EQ.LDB
01128 *
01129 *                          If data was incorrectly changed, report and
01130 *                          return.
01131 *
01132                            SAME = .TRUE.
01133                            DO 50 I = 1, NARGS
01134                               SAME = SAME.AND.ISAME( I )
01135                               IF( .NOT.ISAME( I ) )
01136      $                           WRITE( NOUT, FMT = 9998 )I
01137    50                      CONTINUE
01138                            IF( .NOT.SAME )THEN
01139                               FATAL = .TRUE.
01140                               GO TO 150
01141                            END IF
01142 *
01143                            IF( .NOT.NULL )THEN
01144                               IF( SNAME( 4: 5 ).EQ.'MM' )THEN
01145 *
01146 *                                Check the result.
01147 *
01148                                  IF( LEFT )THEN
01149                                     CALL CMMCH( TRANSA, 'N', M, N, M,
01150      $                                          ALPHA, A, NMAX, B, NMAX,
01151      $                                          ZERO, C, NMAX, CT, G,
01152      $                                          BB, LDB, EPS, ERR,
01153      $                                          FATAL, NOUT, .TRUE. )
01154                                  ELSE
01155                                     CALL CMMCH( 'N', TRANSA, M, N, N,
01156      $                                          ALPHA, B, NMAX, A, NMAX,
01157      $                                          ZERO, C, NMAX, CT, G,
01158      $                                          BB, LDB, EPS, ERR,
01159      $                                          FATAL, NOUT, .TRUE. )
01160                                  END IF
01161                               ELSE IF( SNAME( 4: 5 ).EQ.'SM' )THEN
01162 *
01163 *                                Compute approximation to original
01164 *                                matrix.
01165 *
01166                                  DO 70 J = 1, N
01167                                     DO 60 I = 1, M
01168                                        C( I, J ) = BB( I + ( J - 1 )*
01169      $                                             LDB )
01170                                        BB( I + ( J - 1 )*LDB ) = ALPHA*
01171      $                                    B( I, J )
01172    60                               CONTINUE
01173    70                            CONTINUE
01174 *
01175                                  IF( LEFT )THEN
01176                                     CALL CMMCH( TRANSA, 'N', M, N, M,
01177      $                                          ONE, A, NMAX, C, NMAX,
01178      $                                          ZERO, B, NMAX, CT, G,
01179      $                                          BB, LDB, EPS, ERR,
01180      $                                          FATAL, NOUT, .FALSE. )
01181                                  ELSE
01182                                     CALL CMMCH( 'N', TRANSA, M, N, N,
01183      $                                          ONE, C, NMAX, A, NMAX,
01184      $                                          ZERO, B, NMAX, CT, G,
01185      $                                          BB, LDB, EPS, ERR,
01186      $                                          FATAL, NOUT, .FALSE. )
01187                                  END IF
01188                               END IF
01189                               ERRMAX = MAX( ERRMAX, ERR )
01190 *                             If got really bad answer, report and
01191 *                             return.
01192                               IF( FATAL )
01193      $                           GO TO 150
01194                            END IF
01195 *
01196    80                   CONTINUE
01197 *
01198    90                CONTINUE
01199 *
01200   100             CONTINUE
01201 *
01202   110          CONTINUE
01203 *
01204   120       CONTINUE
01205 *
01206   130    CONTINUE
01207 *
01208   140 CONTINUE
01209 *
01210 *     Report result.
01211 *
01212       IF( ERRMAX.LT.THRESH )THEN
01213          WRITE( NOUT, FMT = 9999 )SNAME, NC
01214       ELSE
01215          WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
01216       END IF
01217       GO TO 160
01218 *
01219   150 CONTINUE
01220       WRITE( NOUT, FMT = 9996 )SNAME
01221       WRITE( NOUT, FMT = 9995 )NC, SNAME, SIDE, UPLO, TRANSA, DIAG, M,
01222      $   N, ALPHA, LDA, LDB
01223 *
01224   160 CONTINUE
01225       RETURN
01226 *
01227  9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
01228      $      'S)' )
01229  9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
01230      $      'ANGED INCORRECTLY *******' )
01231  9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
01232      $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
01233      $      ' - SUSPECT *******' )
01234  9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
01235  9995 FORMAT( 1X, I6, ': ', A6, '(', 4( '''', A1, ''',' ), 2( I3, ',' ),
01236      $      '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ')         ',
01237      $      '      .' )
01238  9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
01239      $      '******' )
01240 *
01241 *     End of CCHK3.
01242 *
01243       END
01244       SUBROUTINE CCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
01245      $                  FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
01246      $                  A, AA, AS, B, BB, BS, C, CC, CS, CT, G )
01247 *
01248 *  Tests CHERK and CSYRK.
01249 *
01250 *  Auxiliary routine for test program for Level 3 Blas.
01251 *
01252 *  -- Written on 8-February-1989.
01253 *     Jack Dongarra, Argonne National Laboratory.
01254 *     Iain Duff, AERE Harwell.
01255 *     Jeremy Du Croz, Numerical Algorithms Group Ltd.
01256 *     Sven Hammarling, Numerical Algorithms Group Ltd.
01257 *
01258 *     .. Parameters ..
01259       COMPLEX            ZERO
01260       PARAMETER          ( ZERO = ( 0.0, 0.0 ) )
01261       REAL               RONE, RZERO
01262       PARAMETER          ( RONE = 1.0, RZERO = 0.0 )
01263 *     .. Scalar Arguments ..
01264       REAL               EPS, THRESH
01265       INTEGER            NALF, NBET, NIDIM, NMAX, NOUT, NTRA
01266       LOGICAL            FATAL, REWI, TRACE
01267       CHARACTER*6        SNAME
01268 *     .. Array Arguments ..
01269       COMPLEX            A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
01270      $                   AS( NMAX*NMAX ), B( NMAX, NMAX ),
01271      $                   BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ),
01272      $                   C( NMAX, NMAX ), CC( NMAX*NMAX ),
01273      $                   CS( NMAX*NMAX ), CT( NMAX )
01274       REAL               G( NMAX )
01275       INTEGER            IDIM( NIDIM )
01276 *     .. Local Scalars ..
01277       COMPLEX            ALPHA, ALS, BETA, BETS
01278       REAL               ERR, ERRMAX, RALPHA, RALS, RBETA, RBETS
01279       INTEGER            I, IA, IB, ICT, ICU, IK, IN, J, JC, JJ, K, KS,
01280      $                   LAA, LCC, LDA, LDAS, LDC, LDCS, LJ, MA, N, NA,
01281      $                   NARGS, NC, NS
01282       LOGICAL            CONJ, NULL, RESET, SAME, TRAN, UPPER
01283       CHARACTER*1        TRANS, TRANSS, TRANST, UPLO, UPLOS
01284       CHARACTER*2        ICHT, ICHU
01285 *     .. Local Arrays ..
01286       LOGICAL            ISAME( 13 )
01287 *     .. External Functions ..
01288       LOGICAL            LCE, LCERES
01289       EXTERNAL           LCE, LCERES
01290 *     .. External Subroutines ..
01291       EXTERNAL           CHERK, CMAKE, CMMCH, CSYRK
01292 *     .. Intrinsic Functions ..
01293       INTRINSIC          CMPLX, MAX, REAL
01294 *     .. Scalars in Common ..
01295       INTEGER            INFOT, NOUTC
01296       LOGICAL            LERR, OK
01297 *     .. Common blocks ..
01298       COMMON             /INFOC/INFOT, NOUTC, OK, LERR
01299 *     .. Data statements ..
01300       DATA               ICHT/'NC'/, ICHU/'UL'/
01301 *     .. Executable Statements ..
01302       CONJ = SNAME( 2: 3 ).EQ.'HE'
01303 *
01304       NARGS = 10
01305       NC = 0
01306       RESET = .TRUE.
01307       ERRMAX = RZERO
01308 *
01309       DO 100 IN = 1, NIDIM
01310          N = IDIM( IN )
01311 *        Set LDC to 1 more than minimum value if room.
01312          LDC = N
01313          IF( LDC.LT.NMAX )
01314      $      LDC = LDC + 1
01315 *        Skip tests if not enough room.
01316          IF( LDC.GT.NMAX )
01317      $      GO TO 100
01318          LCC = LDC*N
01319 *
01320          DO 90 IK = 1, NIDIM
01321             K = IDIM( IK )
01322 *
01323             DO 80 ICT = 1, 2
01324                TRANS = ICHT( ICT: ICT )
01325                TRAN = TRANS.EQ.'C'
01326                IF( TRAN.AND..NOT.CONJ )
01327      $            TRANS = 'T'
01328                IF( TRAN )THEN
01329                   MA = K
01330                   NA = N
01331                ELSE
01332                   MA = N
01333                   NA = K
01334                END IF
01335 *              Set LDA to 1 more than minimum value if room.
01336                LDA = MA
01337                IF( LDA.LT.NMAX )
01338      $            LDA = LDA + 1
01339 *              Skip tests if not enough room.
01340                IF( LDA.GT.NMAX )
01341      $            GO TO 80
01342                LAA = LDA*NA
01343 *
01344 *              Generate the matrix A.
01345 *
01346                CALL CMAKE( 'GE', ' ', ' ', MA, NA, A, NMAX, AA, LDA,
01347      $                     RESET, ZERO )
01348 *
01349                DO 70 ICU = 1, 2
01350                   UPLO = ICHU( ICU: ICU )
01351                   UPPER = UPLO.EQ.'U'
01352 *
01353                   DO 60 IA = 1, NALF
01354                      ALPHA = ALF( IA )
01355                      IF( CONJ )THEN
01356                         RALPHA = REAL( ALPHA )
01357                         ALPHA = CMPLX( RALPHA, RZERO )
01358                      END IF
01359 *
01360                      DO 50 IB = 1, NBET
01361                         BETA = BET( IB )
01362                         IF( CONJ )THEN
01363                            RBETA = REAL( BETA )
01364                            BETA = CMPLX( RBETA, RZERO )
01365                         END IF
01366                         NULL = N.LE.0
01367                         IF( CONJ )
01368      $                     NULL = NULL.OR.( ( K.LE.0.OR.RALPHA.EQ.
01369      $                            RZERO ).AND.RBETA.EQ.RONE )
01370 *
01371 *                       Generate the matrix C.
01372 *
01373                         CALL CMAKE( SNAME( 2: 3 ), UPLO, ' ', N, N, C,
01374      $                              NMAX, CC, LDC, RESET, ZERO )
01375 *
01376                         NC = NC + 1
01377 *
01378 *                       Save every datum before calling the subroutine.
01379 *
01380                         UPLOS = UPLO
01381                         TRANSS = TRANS
01382                         NS = N
01383                         KS = K
01384                         IF( CONJ )THEN
01385                            RALS = RALPHA
01386                         ELSE
01387                            ALS = ALPHA
01388                         END IF
01389                         DO 10 I = 1, LAA
01390                            AS( I ) = AA( I )
01391    10                   CONTINUE
01392                         LDAS = LDA
01393                         IF( CONJ )THEN
01394                            RBETS = RBETA
01395                         ELSE
01396                            BETS = BETA
01397                         END IF
01398                         DO 20 I = 1, LCC
01399                            CS( I ) = CC( I )
01400    20                   CONTINUE
01401                         LDCS = LDC
01402 *
01403 *                       Call the subroutine.
01404 *
01405                         IF( CONJ )THEN
01406                            IF( TRACE )
01407      $                        WRITE( NTRA, FMT = 9994 )NC, SNAME, UPLO,
01408      $                        TRANS, N, K, RALPHA, LDA, RBETA, LDC
01409                            IF( REWI )
01410      $                        REWIND NTRA
01411                            CALL CHERK( UPLO, TRANS, N, K, RALPHA, AA,
01412      $                                 LDA, RBETA, CC, LDC )
01413                         ELSE
01414                            IF( TRACE )
01415      $                        WRITE( NTRA, FMT = 9993 )NC, SNAME, UPLO,
01416      $                        TRANS, N, K, ALPHA, LDA, BETA, LDC
01417                            IF( REWI )
01418      $                        REWIND NTRA
01419                            CALL CSYRK( UPLO, TRANS, N, K, ALPHA, AA,
01420      $                                 LDA, BETA, CC, LDC )
01421                         END IF
01422 *
01423 *                       Check if error-exit was taken incorrectly.
01424 *
01425                         IF( .NOT.OK )THEN
01426                            WRITE( NOUT, FMT = 9992 )
01427                            FATAL = .TRUE.
01428                            GO TO 120
01429                         END IF
01430 *
01431 *                       See what data changed inside subroutines.
01432 *
01433                         ISAME( 1 ) = UPLOS.EQ.UPLO
01434                         ISAME( 2 ) = TRANSS.EQ.TRANS
01435                         ISAME( 3 ) = NS.EQ.N
01436                         ISAME( 4 ) = KS.EQ.K
01437                         IF( CONJ )THEN
01438                            ISAME( 5 ) = RALS.EQ.RALPHA
01439                         ELSE
01440                            ISAME( 5 ) = ALS.EQ.ALPHA
01441                         END IF
01442                         ISAME( 6 ) = LCE( AS, AA, LAA )
01443                         ISAME( 7 ) = LDAS.EQ.LDA
01444                         IF( CONJ )THEN
01445                            ISAME( 8 ) = RBETS.EQ.RBETA
01446                         ELSE
01447                            ISAME( 8 ) = BETS.EQ.BETA
01448                         END IF
01449                         IF( NULL )THEN
01450                            ISAME( 9 ) = LCE( CS, CC, LCC )
01451                         ELSE
01452                            ISAME( 9 ) = LCERES( SNAME( 2: 3 ), UPLO, N,
01453      $                                  N, CS, CC, LDC )
01454                         END IF
01455                         ISAME( 10 ) = LDCS.EQ.LDC
01456 *
01457 *                       If data was incorrectly changed, report and
01458 *                       return.
01459 *
01460                         SAME = .TRUE.
01461                         DO 30 I = 1, NARGS
01462                            SAME = SAME.AND.ISAME( I )
01463                            IF( .NOT.ISAME( I ) )
01464      $                        WRITE( NOUT, FMT = 9998 )I
01465    30                   CONTINUE
01466                         IF( .NOT.SAME )THEN
01467                            FATAL = .TRUE.
01468                            GO TO 120
01469                         END IF
01470 *
01471                         IF( .NOT.NULL )THEN
01472 *
01473 *                          Check the result column by column.
01474 *
01475                            IF( CONJ )THEN
01476                               TRANST = 'C'
01477                            ELSE
01478                               TRANST = 'T'
01479                            END IF
01480                            JC = 1
01481                            DO 40 J = 1, N
01482                               IF( UPPER )THEN
01483                                  JJ = 1
01484                                  LJ = J
01485                               ELSE
01486                                  JJ = J
01487                                  LJ = N - J + 1
01488                               END IF
01489                               IF( TRAN )THEN
01490                                  CALL CMMCH( TRANST, 'N', LJ, 1, K,
01491      $                                       ALPHA, A( 1, JJ ), NMAX,
01492      $                                       A( 1, J ), NMAX, BETA,
01493      $                                       C( JJ, J ), NMAX, CT, G,
01494      $                                       CC( JC ), LDC, EPS, ERR,
01495      $                                       FATAL, NOUT, .TRUE. )
01496                               ELSE
01497                                  CALL CMMCH( 'N', TRANST, LJ, 1, K,
01498      $                                       ALPHA, A( JJ, 1 ), NMAX,
01499      $                                       A( J, 1 ), NMAX, BETA,
01500      $                                       C( JJ, J ), NMAX, CT, G,
01501      $                                       CC( JC ), LDC, EPS, ERR,
01502      $                                       FATAL, NOUT, .TRUE. )
01503                               END IF
01504                               IF( UPPER )THEN
01505                                  JC = JC + LDC
01506                               ELSE
01507                                  JC = JC + LDC + 1
01508                               END IF
01509                               ERRMAX = MAX( ERRMAX, ERR )
01510 *                             If got really bad answer, report and
01511 *                             return.
01512                               IF( FATAL )
01513      $                           GO TO 110
01514    40                      CONTINUE
01515                         END IF
01516 *
01517    50                CONTINUE
01518 *
01519    60             CONTINUE
01520 *
01521    70          CONTINUE
01522 *
01523    80       CONTINUE
01524 *
01525    90    CONTINUE
01526 *
01527   100 CONTINUE
01528 *
01529 *     Report result.
01530 *
01531       IF( ERRMAX.LT.THRESH )THEN
01532          WRITE( NOUT, FMT = 9999 )SNAME, NC
01533       ELSE
01534          WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
01535       END IF
01536       GO TO 130
01537 *
01538   110 CONTINUE
01539       IF( N.GT.1 )
01540      $   WRITE( NOUT, FMT = 9995 )J
01541 *
01542   120 CONTINUE
01543       WRITE( NOUT, FMT = 9996 )SNAME
01544       IF( CONJ )THEN
01545          WRITE( NOUT, FMT = 9994 )NC, SNAME, UPLO, TRANS, N, K, RALPHA,
01546      $      LDA, RBETA, LDC
01547       ELSE
01548          WRITE( NOUT, FMT = 9993 )NC, SNAME, UPLO, TRANS, N, K, ALPHA,
01549      $      LDA, BETA, LDC
01550       END IF
01551 *
01552   130 CONTINUE
01553       RETURN
01554 *
01555  9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
01556      $      'S)' )
01557  9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
01558      $      'ANGED INCORRECTLY *******' )
01559  9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
01560      $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
01561      $      ' - SUSPECT *******' )
01562  9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
01563  9995 FORMAT( '      THESE ARE THE RESULTS FOR COLUMN ', I3 )
01564  9994 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
01565      $      F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ')               ',
01566      $      '          .' )
01567  9993 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
01568      $      '(', F4.1, ',', F4.1, ') , A,', I3, ',(', F4.1, ',', F4.1,
01569      $      '), C,', I3, ')          .' )
01570  9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
01571      $      '******' )
01572 *
01573 *     End of CCHK4.
01574 *
01575       END
01576       SUBROUTINE CCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
01577      $                  FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
01578      $                  AB, AA, AS, BB, BS, C, CC, CS, CT, G, W )
01579 *
01580 *  Tests CHER2K and CSYR2K.
01581 *
01582 *  Auxiliary routine for test program for Level 3 Blas.
01583 *
01584 *  -- Written on 8-February-1989.
01585 *     Jack Dongarra, Argonne National Laboratory.
01586 *     Iain Duff, AERE Harwell.
01587 *     Jeremy Du Croz, Numerical Algorithms Group Ltd.
01588 *     Sven Hammarling, Numerical Algorithms Group Ltd.
01589 *
01590 *     .. Parameters ..
01591       COMPLEX            ZERO, ONE
01592       PARAMETER          ( ZERO = ( 0.0, 0.0 ), ONE = ( 1.0, 0.0 ) )
01593       REAL               RONE, RZERO
01594       PARAMETER          ( RONE = 1.0, RZERO = 0.0 )
01595 *     .. Scalar Arguments ..
01596       REAL               EPS, THRESH
01597       INTEGER            NALF, NBET, NIDIM, NMAX, NOUT, NTRA
01598       LOGICAL            FATAL, REWI, TRACE
01599       CHARACTER*6        SNAME
01600 *     .. Array Arguments ..
01601       COMPLEX            AA( NMAX*NMAX ), AB( 2*NMAX*NMAX ),
01602      $                   ALF( NALF ), AS( NMAX*NMAX ), BB( NMAX*NMAX ),
01603      $                   BET( NBET ), BS( NMAX*NMAX ), C( NMAX, NMAX ),
01604      $                   CC( NMAX*NMAX ), CS( NMAX*NMAX ), CT( NMAX ),
01605      $                   W( 2*NMAX )
01606       REAL               G( NMAX )
01607       INTEGER            IDIM( NIDIM )
01608 *     .. Local Scalars ..
01609       COMPLEX            ALPHA, ALS, BETA, BETS
01610       REAL               ERR, ERRMAX, RBETA, RBETS
01611       INTEGER            I, IA, IB, ICT, ICU, IK, IN, J, JC, JJ, JJAB,
01612      $                   K, KS, LAA, LBB, LCC, LDA, LDAS, LDB, LDBS,
01613      $                   LDC, LDCS, LJ, MA, N, NA, NARGS, NC, NS
01614       LOGICAL            CONJ, NULL, RESET, SAME, TRAN, UPPER
01615       CHARACTER*1        TRANS, TRANSS, TRANST, UPLO, UPLOS
01616       CHARACTER*2        ICHT, ICHU
01617 *     .. Local Arrays ..
01618       LOGICAL            ISAME( 13 )
01619 *     .. External Functions ..
01620       LOGICAL            LCE, LCERES
01621       EXTERNAL           LCE, LCERES
01622 *     .. External Subroutines ..
01623       EXTERNAL           CHER2K, CMAKE, CMMCH, CSYR2K
01624 *     .. Intrinsic Functions ..
01625       INTRINSIC          CMPLX, CONJG, MAX, REAL
01626 *     .. Scalars in Common ..
01627       INTEGER            INFOT, NOUTC
01628       LOGICAL            LERR, OK
01629 *     .. Common blocks ..
01630       COMMON             /INFOC/INFOT, NOUTC, OK, LERR
01631 *     .. Data statements ..
01632       DATA               ICHT/'NC'/, ICHU/'UL'/
01633 *     .. Executable Statements ..
01634       CONJ = SNAME( 2: 3 ).EQ.'HE'
01635 *
01636       NARGS = 12
01637       NC = 0
01638       RESET = .TRUE.
01639       ERRMAX = RZERO
01640 *
01641       DO 130 IN = 1, NIDIM
01642          N = IDIM( IN )
01643 *        Set LDC to 1 more than minimum value if room.
01644          LDC = N
01645          IF( LDC.LT.NMAX )
01646      $      LDC = LDC + 1
01647 *        Skip tests if not enough room.
01648          IF( LDC.GT.NMAX )
01649      $      GO TO 130
01650          LCC = LDC*N
01651 *
01652          DO 120 IK = 1, NIDIM
01653             K = IDIM( IK )
01654 *
01655             DO 110 ICT = 1, 2
01656                TRANS = ICHT( ICT: ICT )
01657                TRAN = TRANS.EQ.'C'
01658                IF( TRAN.AND..NOT.CONJ )
01659      $            TRANS = 'T'
01660                IF( TRAN )THEN
01661                   MA = K
01662                   NA = N
01663                ELSE
01664                   MA = N
01665                   NA = K
01666                END IF
01667 *              Set LDA to 1 more than minimum value if room.
01668                LDA = MA
01669                IF( LDA.LT.NMAX )
01670      $            LDA = LDA + 1
01671 *              Skip tests if not enough room.
01672                IF( LDA.GT.NMAX )
01673      $            GO TO 110
01674                LAA = LDA*NA
01675 *
01676 *              Generate the matrix A.
01677 *
01678                IF( TRAN )THEN
01679                   CALL CMAKE( 'GE', ' ', ' ', MA, NA, AB, 2*NMAX, AA,
01680      $                        LDA, RESET, ZERO )
01681                ELSE
01682                   CALL CMAKE( 'GE', ' ', ' ', MA, NA, AB, NMAX, AA, LDA,
01683      $                        RESET, ZERO )
01684                END IF
01685 *
01686 *              Generate the matrix B.
01687 *
01688                LDB = LDA
01689                LBB = LAA
01690                IF( TRAN )THEN
01691                   CALL CMAKE( 'GE', ' ', ' ', MA, NA, AB( K + 1 ),
01692      $                        2*NMAX, BB, LDB, RESET, ZERO )
01693                ELSE
01694                   CALL CMAKE( 'GE', ' ', ' ', MA, NA, AB( K*NMAX + 1 ),
01695      $                        NMAX, BB, LDB, RESET, ZERO )
01696                END IF
01697 *
01698                DO 100 ICU = 1, 2
01699                   UPLO = ICHU( ICU: ICU )
01700                   UPPER = UPLO.EQ.'U'
01701 *
01702                   DO 90 IA = 1, NALF
01703                      ALPHA = ALF( IA )
01704 *
01705                      DO 80 IB = 1, NBET
01706                         BETA = BET( IB )
01707                         IF( CONJ )THEN
01708                            RBETA = REAL( BETA )
01709                            BETA = CMPLX( RBETA, RZERO )
01710                         END IF
01711                         NULL = N.LE.0
01712                         IF( CONJ )
01713      $                     NULL = NULL.OR.( ( K.LE.0.OR.ALPHA.EQ.
01714      $                            ZERO ).AND.RBETA.EQ.RONE )
01715 *
01716 *                       Generate the matrix C.
01717 *
01718                         CALL CMAKE( SNAME( 2: 3 ), UPLO, ' ', N, N, C,
01719      $                              NMAX, CC, LDC, RESET, ZERO )
01720 *
01721                         NC = NC + 1
01722 *
01723 *                       Save every datum before calling the subroutine.
01724 *
01725                         UPLOS = UPLO
01726                         TRANSS = TRANS
01727                         NS = N
01728                         KS = K
01729                         ALS = ALPHA
01730                         DO 10 I = 1, LAA
01731                            AS( I ) = AA( I )
01732    10                   CONTINUE
01733                         LDAS = LDA
01734                         DO 20 I = 1, LBB
01735                            BS( I ) = BB( I )
01736    20                   CONTINUE
01737                         LDBS = LDB
01738                         IF( CONJ )THEN
01739                            RBETS = RBETA
01740                         ELSE
01741                            BETS = BETA
01742                         END IF
01743                         DO 30 I = 1, LCC
01744                            CS( I ) = CC( I )
01745    30                   CONTINUE
01746                         LDCS = LDC
01747 *
01748 *                       Call the subroutine.
01749 *
01750                         IF( CONJ )THEN
01751                            IF( TRACE )
01752      $                        WRITE( NTRA, FMT = 9994 )NC, SNAME, UPLO,
01753      $                        TRANS, N, K, ALPHA, LDA, LDB, RBETA, LDC
01754                            IF( REWI )
01755      $                        REWIND NTRA
01756                            CALL CHER2K( UPLO, TRANS, N, K, ALPHA, AA,
01757      $                                  LDA, BB, LDB, RBETA, CC, LDC )
01758                         ELSE
01759                            IF( TRACE )
01760      $                        WRITE( NTRA, FMT = 9993 )NC, SNAME, UPLO,
01761      $                        TRANS, N, K, ALPHA, LDA, LDB, BETA, LDC
01762                            IF( REWI )
01763      $                        REWIND NTRA
01764                            CALL CSYR2K( UPLO, TRANS, N, K, ALPHA, AA,
01765      $                                  LDA, BB, LDB, BETA, CC, LDC )
01766                         END IF
01767 *
01768 *                       Check if error-exit was taken incorrectly.
01769 *
01770                         IF( .NOT.OK )THEN
01771                            WRITE( NOUT, FMT = 9992 )
01772                            FATAL = .TRUE.
01773                            GO TO 150
01774                         END IF
01775 *
01776 *                       See what data changed inside subroutines.
01777 *
01778                         ISAME( 1 ) = UPLOS.EQ.UPLO
01779                         ISAME( 2 ) = TRANSS.EQ.TRANS
01780                         ISAME( 3 ) = NS.EQ.N
01781                         ISAME( 4 ) = KS.EQ.K
01782                         ISAME( 5 ) = ALS.EQ.ALPHA
01783                         ISAME( 6 ) = LCE( AS, AA, LAA )
01784                         ISAME( 7 ) = LDAS.EQ.LDA
01785                         ISAME( 8 ) = LCE( BS, BB, LBB )
01786                         ISAME( 9 ) = LDBS.EQ.LDB
01787                         IF( CONJ )THEN
01788                            ISAME( 10 ) = RBETS.EQ.RBETA
01789                         ELSE
01790                            ISAME( 10 ) = BETS.EQ.BETA
01791                         END IF
01792                         IF( NULL )THEN
01793                            ISAME( 11 ) = LCE( CS, CC, LCC )
01794                         ELSE
01795                            ISAME( 11 ) = LCERES( 'HE', UPLO, N, N, CS,
01796      $                                   CC, LDC )
01797                         END IF
01798                         ISAME( 12 ) = LDCS.EQ.LDC
01799 *
01800 *                       If data was incorrectly changed, report and
01801 *                       return.
01802 *
01803                         SAME = .TRUE.
01804                         DO 40 I = 1, NARGS
01805                            SAME = SAME.AND.ISAME( I )
01806                            IF( .NOT.ISAME( I ) )
01807      $                        WRITE( NOUT, FMT = 9998 )I
01808    40                   CONTINUE
01809                         IF( .NOT.SAME )THEN
01810                            FATAL = .TRUE.
01811                            GO TO 150
01812                         END IF
01813 *
01814                         IF( .NOT.NULL )THEN
01815 *
01816 *                          Check the result column by column.
01817 *
01818                            IF( CONJ )THEN
01819                               TRANST = 'C'
01820                            ELSE
01821                               TRANST = 'T'
01822                            END IF
01823                            JJAB = 1
01824                            JC = 1
01825                            DO 70 J = 1, N
01826                               IF( UPPER )THEN
01827                                  JJ = 1
01828                                  LJ = J
01829                               ELSE
01830                                  JJ = J
01831                                  LJ = N - J + 1
01832                               END IF
01833                               IF( TRAN )THEN
01834                                  DO 50 I = 1, K
01835                                     W( I ) = ALPHA*AB( ( J - 1 )*2*
01836      $                                       NMAX + K + I )
01837                                     IF( CONJ )THEN
01838                                        W( K + I ) = CONJG( ALPHA )*
01839      $                                              AB( ( J - 1 )*2*
01840      $                                              NMAX + I )
01841                                     ELSE
01842                                        W( K + I ) = ALPHA*
01843      $                                              AB( ( J - 1 )*2*
01844      $                                              NMAX + I )
01845                                     END IF
01846    50                            CONTINUE
01847                                  CALL CMMCH( TRANST, 'N', LJ, 1, 2*K,
01848      $                                       ONE, AB( JJAB ), 2*NMAX, W,
01849      $                                       2*NMAX, BETA, C( JJ, J ),
01850      $                                       NMAX, CT, G, CC( JC ), LDC,
01851      $                                       EPS, ERR, FATAL, NOUT,
01852      $                                       .TRUE. )
01853                               ELSE
01854                                  DO 60 I = 1, K
01855                                     IF( CONJ )THEN
01856                                        W( I ) = ALPHA*CONJG( AB( ( K +
01857      $                                          I - 1 )*NMAX + J ) )
01858                                        W( K + I ) = CONJG( ALPHA*
01859      $                                              AB( ( I - 1 )*NMAX +
01860      $                                              J ) )
01861                                     ELSE
01862                                        W( I ) = ALPHA*AB( ( K + I - 1 )*
01863      $                                          NMAX + J )
01864                                        W( K + I ) = ALPHA*
01865      $                                              AB( ( I - 1 )*NMAX +
01866      $                                              J )
01867                                     END IF
01868    60                            CONTINUE
01869                                  CALL CMMCH( 'N', 'N', LJ, 1, 2*K, ONE,
01870      $                                       AB( JJ ), NMAX, W, 2*NMAX,
01871      $                                       BETA, C( JJ, J ), NMAX, CT,
01872      $                                       G, CC( JC ), LDC, EPS, ERR,
01873      $                                       FATAL, NOUT, .TRUE. )
01874                               END IF
01875                               IF( UPPER )THEN
01876                                  JC = JC + LDC
01877                               ELSE
01878                                  JC = JC + LDC + 1
01879                                  IF( TRAN )
01880      $                              JJAB = JJAB + 2*NMAX
01881                               END IF
01882                               ERRMAX = MAX( ERRMAX, ERR )
01883 *                             If got really bad answer, report and
01884 *                             return.
01885                               IF( FATAL )
01886      $                           GO TO 140
01887    70                      CONTINUE
01888                         END IF
01889 *
01890    80                CONTINUE
01891 *
01892    90             CONTINUE
01893 *
01894   100          CONTINUE
01895 *
01896   110       CONTINUE
01897 *
01898   120    CONTINUE
01899 *
01900   130 CONTINUE
01901 *
01902 *     Report result.
01903 *
01904       IF( ERRMAX.LT.THRESH )THEN
01905          WRITE( NOUT, FMT = 9999 )SNAME, NC
01906       ELSE
01907          WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
01908       END IF
01909       GO TO 160
01910 *
01911   140 CONTINUE
01912       IF( N.GT.1 )
01913      $   WRITE( NOUT, FMT = 9995 )J
01914 *
01915   150 CONTINUE
01916       WRITE( NOUT, FMT = 9996 )SNAME
01917       IF( CONJ )THEN
01918          WRITE( NOUT, FMT = 9994 )NC, SNAME, UPLO, TRANS, N, K, ALPHA,
01919      $      LDA, LDB, RBETA, LDC
01920       ELSE
01921          WRITE( NOUT, FMT = 9993 )NC, SNAME, UPLO, TRANS, N, K, ALPHA,
01922      $      LDA, LDB, BETA, LDC
01923       END IF
01924 *
01925   160 CONTINUE
01926       RETURN
01927 *
01928  9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
01929      $      'S)' )
01930  9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
01931      $      'ANGED INCORRECTLY *******' )
01932  9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
01933      $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
01934      $      ' - SUSPECT *******' )
01935  9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
01936  9995 FORMAT( '      THESE ARE THE RESULTS FOR COLUMN ', I3 )
01937  9994 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
01938      $      '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',', F4.1,
01939      $      ', C,', I3, ')           .' )
01940  9993 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
01941      $      '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',(', F4.1,
01942      $      ',', F4.1, '), C,', I3, ')    .' )
01943  9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
01944      $      '******' )
01945 *
01946 *     End of CCHK5.
01947 *
01948       END
01949       SUBROUTINE CCHKE( ISNUM, SRNAMT, NOUT )
01950 *
01951 *  Tests the error exits from the Level 3 Blas.
01952 *  Requires a special version of the error-handling routine XERBLA.
01953 *  A, B and C should not need to be defined.
01954 *
01955 *  Auxiliary routine for test program for Level 3 Blas.
01956 *
01957 *  -- Written on 8-February-1989.
01958 *     Jack Dongarra, Argonne National Laboratory.
01959 *     Iain Duff, AERE Harwell.
01960 *     Jeremy Du Croz, Numerical Algorithms Group Ltd.
01961 *     Sven Hammarling, Numerical Algorithms Group Ltd.
01962 *
01963 *  3-19-92:  Initialize ALPHA, BETA, RALPHA, and RBETA  (eca)
01964 *  3-19-92:  Fix argument 12 in calls to CSYMM and CHEMM
01965 *            with INFOT = 9  (eca)
01966 *
01967 *     .. Scalar Arguments ..
01968       INTEGER            ISNUM, NOUT
01969       CHARACTER*6        SRNAMT
01970 *     .. Scalars in Common ..
01971       INTEGER            INFOT, NOUTC
01972       LOGICAL            LERR, OK
01973 *     .. Parameters ..
01974       REAL               ONE, TWO
01975       PARAMETER          ( ONE = 1.0E0, TWO = 2.0E0 )
01976 *     .. Local Scalars ..
01977       COMPLEX            ALPHA, BETA
01978       REAL               RALPHA, RBETA
01979 *     .. Local Arrays ..
01980       COMPLEX            A( 2, 1 ), B( 2, 1 ), C( 2, 1 )
01981 *     .. External Subroutines ..
01982       EXTERNAL           CGEMM, CHEMM, CHER2K, CHERK, CHKXER, CSYMM,
01983      $                   CSYR2K, CSYRK, CTRMM, CTRSM
01984 *     .. Common blocks ..
01985       COMMON             /INFOC/INFOT, NOUTC, OK, LERR
01986 *     .. Executable Statements ..
01987 *     OK is set to .FALSE. by the special version of XERBLA or by CHKXER
01988 *     if anything is wrong.
01989       OK = .TRUE.
01990 *     LERR is set to .TRUE. by the special version of XERBLA each time
01991 *     it is called, and is then tested and re-set by CHKXER.
01992       LERR = .FALSE.
01993 *
01994 *     Initialize ALPHA, BETA, RALPHA, and RBETA.
01995 *
01996       ALPHA = CMPLX( ONE, -ONE )
01997       BETA = CMPLX( TWO, -TWO )
01998       RALPHA = ONE
01999       RBETA = TWO
02000 *
02001       GO TO ( 10, 20, 30, 40, 50, 60, 70, 80,
02002      $        90 )ISNUM
02003    10 INFOT = 1
02004       CALL CGEMM( '/', 'N', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02005       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02006       INFOT = 1
02007       CALL CGEMM( '/', 'C', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02008       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02009       INFOT = 1
02010       CALL CGEMM( '/', 'T', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02011       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02012       INFOT = 2
02013       CALL CGEMM( 'N', '/', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02014       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02015       INFOT = 2
02016       CALL CGEMM( 'C', '/', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02017       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02018       INFOT = 2
02019       CALL CGEMM( 'T', '/', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02020       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02021       INFOT = 3
02022       CALL CGEMM( 'N', 'N', -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02023       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02024       INFOT = 3
02025       CALL CGEMM( 'N', 'C', -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02026       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02027       INFOT = 3
02028       CALL CGEMM( 'N', 'T', -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02029       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02030       INFOT = 3
02031       CALL CGEMM( 'C', 'N', -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02032       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02033       INFOT = 3
02034       CALL CGEMM( 'C', 'C', -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02035       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02036       INFOT = 3
02037       CALL CGEMM( 'C', 'T', -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02038       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02039       INFOT = 3
02040       CALL CGEMM( 'T', 'N', -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02041       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02042       INFOT = 3
02043       CALL CGEMM( 'T', 'C', -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02044       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02045       INFOT = 3
02046       CALL CGEMM( 'T', 'T', -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02047       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02048       INFOT = 4
02049       CALL CGEMM( 'N', 'N', 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02050       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02051       INFOT = 4
02052       CALL CGEMM( 'N', 'C', 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02053       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02054       INFOT = 4
02055       CALL CGEMM( 'N', 'T', 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02056       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02057       INFOT = 4
02058       CALL CGEMM( 'C', 'N', 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02059       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02060       INFOT = 4
02061       CALL CGEMM( 'C', 'C', 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02062       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02063       INFOT = 4
02064       CALL CGEMM( 'C', 'T', 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02065       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02066       INFOT = 4
02067       CALL CGEMM( 'T', 'N', 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02068       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02069       INFOT = 4
02070       CALL CGEMM( 'T', 'C', 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02071       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02072       INFOT = 4
02073       CALL CGEMM( 'T', 'T', 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02074       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02075       INFOT = 5
02076       CALL CGEMM( 'N', 'N', 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
02077       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02078       INFOT = 5
02079       CALL CGEMM( 'N', 'C', 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
02080       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02081       INFOT = 5
02082       CALL CGEMM( 'N', 'T', 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
02083       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02084       INFOT = 5
02085       CALL CGEMM( 'C', 'N', 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
02086       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02087       INFOT = 5
02088       CALL CGEMM( 'C', 'C', 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
02089       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02090       INFOT = 5
02091       CALL CGEMM( 'C', 'T', 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
02092       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02093       INFOT = 5
02094       CALL CGEMM( 'T', 'N', 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
02095       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02096       INFOT = 5
02097       CALL CGEMM( 'T', 'C', 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
02098       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02099       INFOT = 5
02100       CALL CGEMM( 'T', 'T', 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
02101       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02102       INFOT = 8
02103       CALL CGEMM( 'N', 'N', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
02104       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02105       INFOT = 8
02106       CALL CGEMM( 'N', 'C', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
02107       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02108       INFOT = 8
02109       CALL CGEMM( 'N', 'T', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
02110       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02111       INFOT = 8
02112       CALL CGEMM( 'C', 'N', 0, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 )
02113       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02114       INFOT = 8
02115       CALL CGEMM( 'C', 'C', 0, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
02116       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02117       INFOT = 8
02118       CALL CGEMM( 'C', 'T', 0, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
02119       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02120       INFOT = 8
02121       CALL CGEMM( 'T', 'N', 0, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 )
02122       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02123       INFOT = 8
02124       CALL CGEMM( 'T', 'C', 0, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
02125       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02126       INFOT = 8
02127       CALL CGEMM( 'T', 'T', 0, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
02128       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02129       INFOT = 10
02130       CALL CGEMM( 'N', 'N', 0, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
02131       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02132       INFOT = 10
02133       CALL CGEMM( 'C', 'N', 0, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 )
02134       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02135       INFOT = 10
02136       CALL CGEMM( 'T', 'N', 0, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 )
02137       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02138       INFOT = 10
02139       CALL CGEMM( 'N', 'C', 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02140       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02141       INFOT = 10
02142       CALL CGEMM( 'C', 'C', 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02143       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02144       INFOT = 10
02145       CALL CGEMM( 'T', 'C', 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02146       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02147       INFOT = 10
02148       CALL CGEMM( 'N', 'T', 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02149       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02150       INFOT = 10
02151       CALL CGEMM( 'C', 'T', 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02152       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02153       INFOT = 10
02154       CALL CGEMM( 'T', 'T', 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02155       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02156       INFOT = 13
02157       CALL CGEMM( 'N', 'N', 2, 0, 0, ALPHA, A, 2, B, 1, BETA, C, 1 )
02158       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02159       INFOT = 13
02160       CALL CGEMM( 'N', 'C', 2, 0, 0, ALPHA, A, 2, B, 1, BETA, C, 1 )
02161       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02162       INFOT = 13
02163       CALL CGEMM( 'N', 'T', 2, 0, 0, ALPHA, A, 2, B, 1, BETA, C, 1 )
02164       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02165       INFOT = 13
02166       CALL CGEMM( 'C', 'N', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02167       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02168       INFOT = 13
02169       CALL CGEMM( 'C', 'C', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02170       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02171       INFOT = 13
02172       CALL CGEMM( 'C', 'T', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02173       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02174       INFOT = 13
02175       CALL CGEMM( 'T', 'N', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02176       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02177       INFOT = 13
02178       CALL CGEMM( 'T', 'C', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02179       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02180       INFOT = 13
02181       CALL CGEMM( 'T', 'T', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02182       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02183       GO TO 100
02184    20 INFOT = 1
02185       CALL CHEMM( '/', 'U', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02186       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02187       INFOT = 2
02188       CALL CHEMM( 'L', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02189       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02190       INFOT = 3
02191       CALL CHEMM( 'L', 'U', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02192       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02193       INFOT = 3
02194       CALL CHEMM( 'R', 'U', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02195       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02196       INFOT = 3
02197       CALL CHEMM( 'L', 'L', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02198       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02199       INFOT = 3
02200       CALL CHEMM( 'R', 'L', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02201       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02202       INFOT = 4
02203       CALL CHEMM( 'L', 'U', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
02204       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02205       INFOT = 4
02206       CALL CHEMM( 'R', 'U', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
02207       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02208       INFOT = 4
02209       CALL CHEMM( 'L', 'L', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
02210       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02211       INFOT = 4
02212       CALL CHEMM( 'R', 'L', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
02213       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02214       INFOT = 7
02215       CALL CHEMM( 'L', 'U', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 )
02216       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02217       INFOT = 7
02218       CALL CHEMM( 'R', 'U', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
02219       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02220       INFOT = 7
02221       CALL CHEMM( 'L', 'L', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 )
02222       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02223       INFOT = 7
02224       CALL CHEMM( 'R', 'L', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
02225       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02226       INFOT = 9
02227       CALL CHEMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 )
02228       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02229       INFOT = 9
02230       CALL CHEMM( 'R', 'U', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
02231       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02232       INFOT = 9
02233       CALL CHEMM( 'L', 'L', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 )
02234       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02235       INFOT = 9
02236       CALL CHEMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
02237       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02238       INFOT = 12
02239       CALL CHEMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
02240       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02241       INFOT = 12
02242       CALL CHEMM( 'R', 'U', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 )
02243       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02244       INFOT = 12
02245       CALL CHEMM( 'L', 'L', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
02246       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02247       INFOT = 12
02248       CALL CHEMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 )
02249       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02250       GO TO 100
02251    30 INFOT = 1
02252       CALL CSYMM( '/', 'U', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02253       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02254       INFOT = 2
02255       CALL CSYMM( 'L', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02256       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02257       INFOT = 3
02258       CALL CSYMM( 'L', 'U', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02259       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02260       INFOT = 3
02261       CALL CSYMM( 'R', 'U', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02262       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02263       INFOT = 3
02264       CALL CSYMM( 'L', 'L', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02265       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02266       INFOT = 3
02267       CALL CSYMM( 'R', 'L', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02268       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02269       INFOT = 4
02270       CALL CSYMM( 'L', 'U', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
02271       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02272       INFOT = 4
02273       CALL CSYMM( 'R', 'U', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
02274       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02275       INFOT = 4
02276       CALL CSYMM( 'L', 'L', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
02277       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02278       INFOT = 4
02279       CALL CSYMM( 'R', 'L', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
02280       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02281       INFOT = 7
02282       CALL CSYMM( 'L', 'U', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 )
02283       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02284       INFOT = 7
02285       CALL CSYMM( 'R', 'U', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
02286       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02287       INFOT = 7
02288       CALL CSYMM( 'L', 'L', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 )
02289       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02290       INFOT = 7
02291       CALL CSYMM( 'R', 'L', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
02292       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02293       INFOT = 9
02294       CALL CSYMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 )
02295       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02296       INFOT = 9
02297       CALL CSYMM( 'R', 'U', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
02298       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02299       INFOT = 9
02300       CALL CSYMM( 'L', 'L', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 )
02301       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02302       INFOT = 9
02303       CALL CSYMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
02304       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02305       INFOT = 12
02306       CALL CSYMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
02307       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02308       INFOT = 12
02309       CALL CSYMM( 'R', 'U', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 )
02310       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02311       INFOT = 12
02312       CALL CSYMM( 'L', 'L', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
02313       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02314       INFOT = 12
02315       CALL CSYMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 )
02316       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02317       GO TO 100
02318    40 INFOT = 1
02319       CALL CTRMM( '/', 'U', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 )
02320       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02321       INFOT = 2
02322       CALL CTRMM( 'L', '/', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 )
02323       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02324       INFOT = 3
02325       CALL CTRMM( 'L', 'U', '/', 'N', 0, 0, ALPHA, A, 1, B, 1 )
02326       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02327       INFOT = 4
02328       CALL CTRMM( 'L', 'U', 'N', '/', 0, 0, ALPHA, A, 1, B, 1 )
02329       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02330       INFOT = 5
02331       CALL CTRMM( 'L', 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
02332       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02333       INFOT = 5
02334       CALL CTRMM( 'L', 'U', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1 )
02335       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02336       INFOT = 5
02337       CALL CTRMM( 'L', 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
02338       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02339       INFOT = 5
02340       CALL CTRMM( 'R', 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
02341       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02342       INFOT = 5
02343       CALL CTRMM( 'R', 'U', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1 )
02344       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02345       INFOT = 5
02346       CALL CTRMM( 'R', 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
02347       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02348       INFOT = 5
02349       CALL CTRMM( 'L', 'L', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
02350       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02351       INFOT = 5
02352       CALL CTRMM( 'L', 'L', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1 )
02353       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02354       INFOT = 5
02355       CALL CTRMM( 'L', 'L', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
02356       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02357       INFOT = 5
02358       CALL CTRMM( 'R', 'L', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
02359       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02360       INFOT = 5
02361       CALL CTRMM( 'R', 'L', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1 )
02362       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02363       INFOT = 5
02364       CALL CTRMM( 'R', 'L', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
02365       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02366       INFOT = 6
02367       CALL CTRMM( 'L', 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
02368       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02369       INFOT = 6
02370       CALL CTRMM( 'L', 'U', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1 )
02371       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02372       INFOT = 6
02373       CALL CTRMM( 'L', 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
02374       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02375       INFOT = 6
02376       CALL CTRMM( 'R', 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
02377       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02378       INFOT = 6
02379       CALL CTRMM( 'R', 'U', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1 )
02380       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02381       INFOT = 6
02382       CALL CTRMM( 'R', 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
02383       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02384       INFOT = 6
02385       CALL CTRMM( 'L', 'L', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
02386       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02387       INFOT = 6
02388       CALL CTRMM( 'L', 'L', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1 )
02389       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02390       INFOT = 6
02391       CALL CTRMM( 'L', 'L', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
02392       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02393       INFOT = 6
02394       CALL CTRMM( 'R', 'L', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
02395       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02396       INFOT = 6
02397       CALL CTRMM( 'R', 'L', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1 )
02398       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02399       INFOT = 6
02400       CALL CTRMM( 'R', 'L', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
02401       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02402       INFOT = 9
02403       CALL CTRMM( 'L', 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 2 )
02404       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02405       INFOT = 9
02406       CALL CTRMM( 'L', 'U', 'C', 'N', 2, 0, ALPHA, A, 1, B, 2 )
02407       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02408       INFOT = 9
02409       CALL CTRMM( 'L', 'U', 'T', 'N', 2, 0, ALPHA, A, 1, B, 2 )
02410       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02411       INFOT = 9
02412       CALL CTRMM( 'R', 'U', 'N', 'N', 0, 2, ALPHA, A, 1, B, 1 )
02413       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02414       INFOT = 9
02415       CALL CTRMM( 'R', 'U', 'C', 'N', 0, 2, ALPHA, A, 1, B, 1 )
02416       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02417       INFOT = 9
02418       CALL CTRMM( 'R', 'U', 'T', 'N', 0, 2, ALPHA, A, 1, B, 1 )
02419       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02420       INFOT = 9
02421       CALL CTRMM( 'L', 'L', 'N', 'N', 2, 0, ALPHA, A, 1, B, 2 )
02422       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02423       INFOT = 9
02424       CALL CTRMM( 'L', 'L', 'C', 'N', 2, 0, ALPHA, A, 1, B, 2 )
02425       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02426       INFOT = 9
02427       CALL CTRMM( 'L', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 2 )
02428       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02429       INFOT = 9
02430       CALL CTRMM( 'R', 'L', 'N', 'N', 0, 2, ALPHA, A, 1, B, 1 )
02431       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02432       INFOT = 9
02433       CALL CTRMM( 'R', 'L', 'C', 'N', 0, 2, ALPHA, A, 1, B, 1 )
02434       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02435       INFOT = 9
02436       CALL CTRMM( 'R', 'L', 'T', 'N', 0, 2, ALPHA, A, 1, B, 1 )
02437       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02438       INFOT = 11
02439       CALL CTRMM( 'L', 'U', 'N', 'N', 2, 0, ALPHA, A, 2, B, 1 )
02440       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02441       INFOT = 11
02442       CALL CTRMM( 'L', 'U', 'C', 'N', 2, 0, ALPHA, A, 2, B, 1 )
02443       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02444       INFOT = 11
02445       CALL CTRMM( 'L', 'U', 'T', 'N', 2, 0, ALPHA, A, 2, B, 1 )
02446       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02447       INFOT = 11
02448       CALL CTRMM( 'R', 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 1 )
02449       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02450       INFOT = 11
02451       CALL CTRMM( 'R', 'U', 'C', 'N', 2, 0, ALPHA, A, 1, B, 1 )
02452       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02453       INFOT = 11
02454       CALL CTRMM( 'R', 'U', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 )
02455       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02456       INFOT = 11
02457       CALL CTRMM( 'L', 'L', 'N', 'N', 2, 0, ALPHA, A, 2, B, 1 )
02458       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02459       INFOT = 11
02460       CALL CTRMM( 'L', 'L', 'C', 'N', 2, 0, ALPHA, A, 2, B, 1 )
02461       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02462       INFOT = 11
02463       CALL CTRMM( 'L', 'L', 'T', 'N', 2, 0, ALPHA, A, 2, B, 1 )
02464       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02465       INFOT = 11
02466       CALL CTRMM( 'R', 'L', 'N', 'N', 2, 0, ALPHA, A, 1, B, 1 )
02467       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02468       INFOT = 11
02469       CALL CTRMM( 'R', 'L', 'C', 'N', 2, 0, ALPHA, A, 1, B, 1 )
02470       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02471       INFOT = 11
02472       CALL CTRMM( 'R', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 )
02473       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02474       GO TO 100
02475    50 INFOT = 1
02476       CALL CTRSM( '/', 'U', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 )
02477       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02478       INFOT = 2
02479       CALL CTRSM( 'L', '/', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 )
02480       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02481       INFOT = 3
02482       CALL CTRSM( 'L', 'U', '/', 'N', 0, 0, ALPHA, A, 1, B, 1 )
02483       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02484       INFOT = 4
02485       CALL CTRSM( 'L', 'U', 'N', '/', 0, 0, ALPHA, A, 1, B, 1 )
02486       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02487       INFOT = 5
02488       CALL CTRSM( 'L', 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
02489       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02490       INFOT = 5
02491       CALL CTRSM( 'L', 'U', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1 )
02492       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02493       INFOT = 5
02494       CALL CTRSM( 'L', 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
02495       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02496       INFOT = 5
02497       CALL CTRSM( 'R', 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
02498       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02499       INFOT = 5
02500       CALL CTRSM( 'R', 'U', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1 )
02501       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02502       INFOT = 5
02503       CALL CTRSM( 'R', 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
02504       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02505       INFOT = 5
02506       CALL CTRSM( 'L', 'L', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
02507       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02508       INFOT = 5
02509       CALL CTRSM( 'L', 'L', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1 )
02510       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02511       INFOT = 5
02512       CALL CTRSM( 'L', 'L', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
02513       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02514       INFOT = 5
02515       CALL CTRSM( 'R', 'L', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
02516       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02517       INFOT = 5
02518       CALL CTRSM( 'R', 'L', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1 )
02519       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02520       INFOT = 5
02521       CALL CTRSM( 'R', 'L', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
02522       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02523       INFOT = 6
02524       CALL CTRSM( 'L', 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
02525       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02526       INFOT = 6
02527       CALL CTRSM( 'L', 'U', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1 )
02528       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02529       INFOT = 6
02530       CALL CTRSM( 'L', 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
02531       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02532       INFOT = 6
02533       CALL CTRSM( 'R', 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
02534       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02535       INFOT = 6
02536       CALL CTRSM( 'R', 'U', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1 )
02537       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02538       INFOT = 6
02539       CALL CTRSM( 'R', 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
02540       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02541       INFOT = 6
02542       CALL CTRSM( 'L', 'L', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
02543       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02544       INFOT = 6
02545       CALL CTRSM( 'L', 'L', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1 )
02546       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02547       INFOT = 6
02548       CALL CTRSM( 'L', 'L', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
02549       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02550       INFOT = 6
02551       CALL CTRSM( 'R', 'L', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
02552       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02553       INFOT = 6
02554       CALL CTRSM( 'R', 'L', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1 )
02555       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02556       INFOT = 6
02557       CALL CTRSM( 'R', 'L', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
02558       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02559       INFOT = 9
02560       CALL CTRSM( 'L', 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 2 )
02561       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02562       INFOT = 9
02563       CALL CTRSM( 'L', 'U', 'C', 'N', 2, 0, ALPHA, A, 1, B, 2 )
02564       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02565       INFOT = 9
02566       CALL CTRSM( 'L', 'U', 'T', 'N', 2, 0, ALPHA, A, 1, B, 2 )
02567       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02568       INFOT = 9
02569       CALL CTRSM( 'R', 'U', 'N', 'N', 0, 2, ALPHA, A, 1, B, 1 )
02570       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02571       INFOT = 9
02572       CALL CTRSM( 'R', 'U', 'C', 'N', 0, 2, ALPHA, A, 1, B, 1 )
02573       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02574       INFOT = 9
02575       CALL CTRSM( 'R', 'U', 'T', 'N', 0, 2, ALPHA, A, 1, B, 1 )
02576       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02577       INFOT = 9
02578       CALL CTRSM( 'L', 'L', 'N', 'N', 2, 0, ALPHA, A, 1, B, 2 )
02579       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02580       INFOT = 9
02581       CALL CTRSM( 'L', 'L', 'C', 'N', 2, 0, ALPHA, A, 1, B, 2 )
02582       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02583       INFOT = 9
02584       CALL CTRSM( 'L', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 2 )
02585       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02586       INFOT = 9
02587       CALL CTRSM( 'R', 'L', 'N', 'N', 0, 2, ALPHA, A, 1, B, 1 )
02588       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02589       INFOT = 9
02590       CALL CTRSM( 'R', 'L', 'C', 'N', 0, 2, ALPHA, A, 1, B, 1 )
02591       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02592       INFOT = 9
02593       CALL CTRSM( 'R', 'L', 'T', 'N', 0, 2, ALPHA, A, 1, B, 1 )
02594       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02595       INFOT = 11
02596       CALL CTRSM( 'L', 'U', 'N', 'N', 2, 0, ALPHA, A, 2, B, 1 )
02597       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02598       INFOT = 11
02599       CALL CTRSM( 'L', 'U', 'C', 'N', 2, 0, ALPHA, A, 2, B, 1 )
02600       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02601       INFOT = 11
02602       CALL CTRSM( 'L', 'U', 'T', 'N', 2, 0, ALPHA, A, 2, B, 1 )
02603       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02604       INFOT = 11
02605       CALL CTRSM( 'R', 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 1 )
02606       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02607       INFOT = 11
02608       CALL CTRSM( 'R', 'U', 'C', 'N', 2, 0, ALPHA, A, 1, B, 1 )
02609       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02610       INFOT = 11
02611       CALL CTRSM( 'R', 'U', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 )
02612       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02613       INFOT = 11
02614       CALL CTRSM( 'L', 'L', 'N', 'N', 2, 0, ALPHA, A, 2, B, 1 )
02615       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02616       INFOT = 11
02617       CALL CTRSM( 'L', 'L', 'C', 'N', 2, 0, ALPHA, A, 2, B, 1 )
02618       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02619       INFOT = 11
02620       CALL CTRSM( 'L', 'L', 'T', 'N', 2, 0, ALPHA, A, 2, B, 1 )
02621       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02622       INFOT = 11
02623       CALL CTRSM( 'R', 'L', 'N', 'N', 2, 0, ALPHA, A, 1, B, 1 )
02624       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02625       INFOT = 11
02626       CALL CTRSM( 'R', 'L', 'C', 'N', 2, 0, ALPHA, A, 1, B, 1 )
02627       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02628       INFOT = 11
02629       CALL CTRSM( 'R', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 )
02630       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02631       GO TO 100
02632    60 INFOT = 1
02633       CALL CHERK( '/', 'N', 0, 0, RALPHA, A, 1, RBETA, C, 1 )
02634       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02635       INFOT = 2
02636       CALL CHERK( 'U', 'T', 0, 0, RALPHA, A, 1, RBETA, C, 1 )
02637       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02638       INFOT = 3
02639       CALL CHERK( 'U', 'N', -1, 0, RALPHA, A, 1, RBETA, C, 1 )
02640       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02641       INFOT = 3
02642       CALL CHERK( 'U', 'C', -1, 0, RALPHA, A, 1, RBETA, C, 1 )
02643       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02644       INFOT = 3
02645       CALL CHERK( 'L', 'N', -1, 0, RALPHA, A, 1, RBETA, C, 1 )
02646       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02647       INFOT = 3
02648       CALL CHERK( 'L', 'C', -1, 0, RALPHA, A, 1, RBETA, C, 1 )
02649       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02650       INFOT = 4
02651       CALL CHERK( 'U', 'N', 0, -1, RALPHA, A, 1, RBETA, C, 1 )
02652       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02653       INFOT = 4
02654       CALL CHERK( 'U', 'C', 0, -1, RALPHA, A, 1, RBETA, C, 1 )
02655       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02656       INFOT = 4
02657       CALL CHERK( 'L', 'N', 0, -1, RALPHA, A, 1, RBETA, C, 1 )
02658       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02659       INFOT = 4
02660       CALL CHERK( 'L', 'C', 0, -1, RALPHA, A, 1, RBETA, C, 1 )
02661       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02662       INFOT = 7
02663       CALL CHERK( 'U', 'N', 2, 0, RALPHA, A, 1, RBETA, C, 2 )
02664       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02665       INFOT = 7
02666       CALL CHERK( 'U', 'C', 0, 2, RALPHA, A, 1, RBETA, C, 1 )
02667       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02668       INFOT = 7
02669       CALL CHERK( 'L', 'N', 2, 0, RALPHA, A, 1, RBETA, C, 2 )
02670       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02671       INFOT = 7
02672       CALL CHERK( 'L', 'C', 0, 2, RALPHA, A, 1, RBETA, C, 1 )
02673       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02674       INFOT = 10
02675       CALL CHERK( 'U', 'N', 2, 0, RALPHA, A, 2, RBETA, C, 1 )
02676       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02677       INFOT = 10
02678       CALL CHERK( 'U', 'C', 2, 0, RALPHA, A, 1, RBETA, C, 1 )
02679       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02680       INFOT = 10
02681       CALL CHERK( 'L', 'N', 2, 0, RALPHA, A, 2, RBETA, C, 1 )
02682       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02683       INFOT = 10
02684       CALL CHERK( 'L', 'C', 2, 0, RALPHA, A, 1, RBETA, C, 1 )
02685       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02686       GO TO 100
02687    70 INFOT = 1
02688       CALL CSYRK( '/', 'N', 0, 0, ALPHA, A, 1, BETA, C, 1 )
02689       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02690       INFOT = 2
02691       CALL CSYRK( 'U', 'C', 0, 0, ALPHA, A, 1, BETA, C, 1 )
02692       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02693       INFOT = 3
02694       CALL CSYRK( 'U', 'N', -1, 0, ALPHA, A, 1, BETA, C, 1 )
02695       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02696       INFOT = 3
02697       CALL CSYRK( 'U', 'T', -1, 0, ALPHA, A, 1, BETA, C, 1 )
02698       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02699       INFOT = 3
02700       CALL CSYRK( 'L', 'N', -1, 0, ALPHA, A, 1, BETA, C, 1 )
02701       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02702       INFOT = 3
02703       CALL CSYRK( 'L', 'T', -1, 0, ALPHA, A, 1, BETA, C, 1 )
02704       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02705       INFOT = 4
02706       CALL CSYRK( 'U', 'N', 0, -1, ALPHA, A, 1, BETA, C, 1 )
02707       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02708       INFOT = 4
02709       CALL CSYRK( 'U', 'T', 0, -1, ALPHA, A, 1, BETA, C, 1 )
02710       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02711       INFOT = 4
02712       CALL CSYRK( 'L', 'N', 0, -1, ALPHA, A, 1, BETA, C, 1 )
02713       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02714       INFOT = 4
02715       CALL CSYRK( 'L', 'T', 0, -1, ALPHA, A, 1, BETA, C, 1 )
02716       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02717       INFOT = 7
02718       CALL CSYRK( 'U', 'N', 2, 0, ALPHA, A, 1, BETA, C, 2 )
02719       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02720       INFOT = 7
02721       CALL CSYRK( 'U', 'T', 0, 2, ALPHA, A, 1, BETA, C, 1 )
02722       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02723       INFOT = 7
02724       CALL CSYRK( 'L', 'N', 2, 0, ALPHA, A, 1, BETA, C, 2 )
02725       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02726       INFOT = 7
02727       CALL CSYRK( 'L', 'T', 0, 2, ALPHA, A, 1, BETA, C, 1 )
02728       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02729       INFOT = 10
02730       CALL CSYRK( 'U', 'N', 2, 0, ALPHA, A, 2, BETA, C, 1 )
02731       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02732       INFOT = 10
02733       CALL CSYRK( 'U', 'T', 2, 0, ALPHA, A, 1, BETA, C, 1 )
02734       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02735       INFOT = 10
02736       CALL CSYRK( 'L', 'N', 2, 0, ALPHA, A, 2, BETA, C, 1 )
02737       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02738       INFOT = 10
02739       CALL CSYRK( 'L', 'T', 2, 0, ALPHA, A, 1, BETA, C, 1 )
02740       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02741       GO TO 100
02742    80 INFOT = 1
02743       CALL CHER2K( '/', 'N', 0, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
02744       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02745       INFOT = 2
02746       CALL CHER2K( 'U', 'T', 0, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
02747       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02748       INFOT = 3
02749       CALL CHER2K( 'U', 'N', -1, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
02750       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02751       INFOT = 3
02752       CALL CHER2K( 'U', 'C', -1, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
02753       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02754       INFOT = 3
02755       CALL CHER2K( 'L', 'N', -1, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
02756       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02757       INFOT = 3
02758       CALL CHER2K( 'L', 'C', -1, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
02759       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02760       INFOT = 4
02761       CALL CHER2K( 'U', 'N', 0, -1, ALPHA, A, 1, B, 1, RBETA, C, 1 )
02762       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02763       INFOT = 4
02764       CALL CHER2K( 'U', 'C', 0, -1, ALPHA, A, 1, B, 1, RBETA, C, 1 )
02765       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02766       INFOT = 4
02767       CALL CHER2K( 'L', 'N', 0, -1, ALPHA, A, 1, B, 1, RBETA, C, 1 )
02768       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02769       INFOT = 4
02770       CALL CHER2K( 'L', 'C', 0, -1, ALPHA, A, 1, B, 1, RBETA, C, 1 )
02771       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02772       INFOT = 7
02773       CALL CHER2K( 'U', 'N', 2, 0, ALPHA, A, 1, B, 1, RBETA, C, 2 )
02774       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02775       INFOT = 7
02776       CALL CHER2K( 'U', 'C', 0, 2, ALPHA, A, 1, B, 1, RBETA, C, 1 )
02777       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02778       INFOT = 7
02779       CALL CHER2K( 'L', 'N', 2, 0, ALPHA, A, 1, B, 1, RBETA, C, 2 )
02780       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02781       INFOT = 7
02782       CALL CHER2K( 'L', 'C', 0, 2, ALPHA, A, 1, B, 1, RBETA, C, 1 )
02783       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02784       INFOT = 9
02785       CALL CHER2K( 'U', 'N', 2, 0, ALPHA, A, 2, B, 1, RBETA, C, 2 )
02786       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02787       INFOT = 9
02788       CALL CHER2K( 'U', 'C', 0, 2, ALPHA, A, 2, B, 1, RBETA, C, 1 )
02789       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02790       INFOT = 9
02791       CALL CHER2K( 'L', 'N', 2, 0, ALPHA, A, 2, B, 1, RBETA, C, 2 )
02792       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02793       INFOT = 9
02794       CALL CHER2K( 'L', 'C', 0, 2, ALPHA, A, 2, B, 1, RBETA, C, 1 )
02795       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02796       INFOT = 12
02797       CALL CHER2K( 'U', 'N', 2, 0, ALPHA, A, 2, B, 2, RBETA, C, 1 )
02798       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02799       INFOT = 12
02800       CALL CHER2K( 'U', 'C', 2, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
02801       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02802       INFOT = 12
02803       CALL CHER2K( 'L', 'N', 2, 0, ALPHA, A, 2, B, 2, RBETA, C, 1 )
02804       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02805       INFOT = 12
02806       CALL CHER2K( 'L', 'C', 2, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
02807       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02808       GO TO 100
02809    90 INFOT = 1
02810       CALL CSYR2K( '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02811       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02812       INFOT = 2
02813       CALL CSYR2K( 'U', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02814       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02815       INFOT = 3
02816       CALL CSYR2K( 'U', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02817       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02818       INFOT = 3
02819       CALL CSYR2K( 'U', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02820       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02821       INFOT = 3
02822       CALL CSYR2K( 'L', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02823       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02824       INFOT = 3
02825       CALL CSYR2K( 'L', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02826       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02827       INFOT = 4
02828       CALL CSYR2K( 'U', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
02829       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02830       INFOT = 4
02831       CALL CSYR2K( 'U', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
02832       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02833       INFOT = 4
02834       CALL CSYR2K( 'L', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
02835       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02836       INFOT = 4
02837       CALL CSYR2K( 'L', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
02838       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02839       INFOT = 7
02840       CALL CSYR2K( 'U', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
02841       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02842       INFOT = 7
02843       CALL CSYR2K( 'U', 'T', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
02844       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02845       INFOT = 7
02846       CALL CSYR2K( 'L', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
02847       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02848       INFOT = 7
02849       CALL CSYR2K( 'L', 'T', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
02850       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02851       INFOT = 9
02852       CALL CSYR2K( 'U', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 )
02853       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02854       INFOT = 9
02855       CALL CSYR2K( 'U', 'T', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 )
02856       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02857       INFOT = 9
02858       CALL CSYR2K( 'L', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 )
02859       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02860       INFOT = 9
02861       CALL CSYR2K( 'L', 'T', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 )
02862       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02863       INFOT = 12
02864       CALL CSYR2K( 'U', 'N', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
02865       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02866       INFOT = 12
02867       CALL CSYR2K( 'U', 'T', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02868       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02869       INFOT = 12
02870       CALL CSYR2K( 'L', 'N', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
02871       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02872       INFOT = 12
02873       CALL CSYR2K( 'L', 'T', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
02874       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
02875 *
02876   100 IF( OK )THEN
02877          WRITE( NOUT, FMT = 9999 )SRNAMT
02878       ELSE
02879          WRITE( NOUT, FMT = 9998 )SRNAMT
02880       END IF
02881       RETURN
02882 *
02883  9999 FORMAT( ' ', A6, ' PASSED THE TESTS OF ERROR-EXITS' )
02884  9998 FORMAT( ' ******* ', A6, ' FAILED THE TESTS OF ERROR-EXITS *****',
02885      $      '**' )
02886 *
02887 *     End of CCHKE.
02888 *
02889       END
02890       SUBROUTINE CMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, RESET,
02891      $                  TRANSL )
02892 *
02893 *  Generates values for an M by N matrix A.
02894 *  Stores the values in the array AA in the data structure required
02895 *  by the routine, with unwanted elements set to rogue value.
02896 *
02897 *  TYPE is 'GE', 'HE', 'SY' or 'TR'.
02898 *
02899 *  Auxiliary routine for test program for Level 3 Blas.
02900 *
02901 *  -- Written on 8-February-1989.
02902 *     Jack Dongarra, Argonne National Laboratory.
02903 *     Iain Duff, AERE Harwell.
02904 *     Jeremy Du Croz, Numerical Algorithms Group Ltd.
02905 *     Sven Hammarling, Numerical Algorithms Group Ltd.
02906 *
02907 *     .. Parameters ..
02908       COMPLEX            ZERO, ONE
02909       PARAMETER          ( ZERO = ( 0.0, 0.0 ), ONE = ( 1.0, 0.0 ) )
02910       COMPLEX            ROGUE
02911       PARAMETER          ( ROGUE = ( -1.0E10, 1.0E10 ) )
02912       REAL               RZERO
02913       PARAMETER          ( RZERO = 0.0 )
02914       REAL               RROGUE
02915       PARAMETER          ( RROGUE = -1.0E10 )
02916 *     .. Scalar Arguments ..
02917       COMPLEX            TRANSL
02918       INTEGER            LDA, M, N, NMAX
02919       LOGICAL            RESET
02920       CHARACTER*1        DIAG, UPLO
02921       CHARACTER*2        TYPE
02922 *     .. Array Arguments ..
02923       COMPLEX            A( NMAX, * ), AA( * )
02924 *     .. Local Scalars ..
02925       INTEGER            I, IBEG, IEND, J, JJ
02926       LOGICAL            GEN, HER, LOWER, SYM, TRI, UNIT, UPPER
02927 *     .. External Functions ..
02928       COMPLEX            CBEG
02929       EXTERNAL           CBEG
02930 *     .. Intrinsic Functions ..
02931       INTRINSIC          CMPLX, CONJG, REAL
02932 *     .. Executable Statements ..
02933       GEN = TYPE.EQ.'GE'
02934       HER = TYPE.EQ.'HE'
02935       SYM = TYPE.EQ.'SY'
02936       TRI = TYPE.EQ.'TR'
02937       UPPER = ( HER.OR.SYM.OR.TRI ).AND.UPLO.EQ.'U'
02938       LOWER = ( HER.OR.SYM.OR.TRI ).AND.UPLO.EQ.'L'
02939       UNIT = TRI.AND.DIAG.EQ.'U'
02940 *
02941 *     Generate data in array A.
02942 *
02943       DO 20 J = 1, N
02944          DO 10 I = 1, M
02945             IF( GEN.OR.( UPPER.AND.I.LE.J ).OR.( LOWER.AND.I.GE.J ) )
02946      $          THEN
02947                A( I, J ) = CBEG( RESET ) + TRANSL
02948                IF( I.NE.J )THEN
02949 *                 Set some elements to zero
02950                   IF( N.GT.3.AND.J.EQ.N/2 )
02951      $               A( I, J ) = ZERO
02952                   IF( HER )THEN
02953                      A( J, I ) = CONJG( A( I, J ) )
02954                   ELSE IF( SYM )THEN
02955                      A( J, I ) = A( I, J )
02956                   ELSE IF( TRI )THEN
02957                      A( J, I ) = ZERO
02958                   END IF
02959                END IF
02960             END IF
02961    10    CONTINUE
02962          IF( HER )
02963      $      A( J, J ) = CMPLX( REAL( A( J, J ) ), RZERO )
02964          IF( TRI )
02965      $      A( J, J ) = A( J, J ) + ONE
02966          IF( UNIT )
02967      $      A( J, J ) = ONE
02968    20 CONTINUE
02969 *
02970 *     Store elements in array AS in data structure required by routine.
02971 *
02972       IF( TYPE.EQ.'GE' )THEN
02973          DO 50 J = 1, N
02974             DO 30 I = 1, M
02975                AA( I + ( J - 1 )*LDA ) = A( I, J )
02976    30       CONTINUE
02977             DO 40 I = M + 1, LDA
02978                AA( I + ( J - 1 )*LDA ) = ROGUE
02979    40       CONTINUE
02980    50    CONTINUE
02981       ELSE IF( TYPE.EQ.'HE'.OR.TYPE.EQ.'SY'.OR.TYPE.EQ.'TR' )THEN
02982          DO 90 J = 1, N
02983             IF( UPPER )THEN
02984                IBEG = 1
02985                IF( UNIT )THEN
02986                   IEND = J - 1
02987                ELSE
02988                   IEND = J
02989                END IF
02990             ELSE
02991                IF( UNIT )THEN
02992                   IBEG = J + 1
02993                ELSE
02994                   IBEG = J
02995                END IF
02996                IEND = N
02997             END IF
02998             DO 60 I = 1, IBEG - 1
02999                AA( I + ( J - 1 )*LDA ) = ROGUE
03000    60       CONTINUE
03001             DO 70 I = IBEG, IEND
03002                AA( I + ( J - 1 )*LDA ) = A( I, J )
03003    70       CONTINUE
03004             DO 80 I = IEND + 1, LDA
03005                AA( I + ( J - 1 )*LDA ) = ROGUE
03006    80       CONTINUE
03007             IF( HER )THEN
03008                JJ = J + ( J - 1 )*LDA
03009                AA( JJ ) = CMPLX( REAL( AA( JJ ) ), RROGUE )
03010             END IF
03011    90    CONTINUE
03012       END IF
03013       RETURN
03014 *
03015 *     End of CMAKE.
03016 *
03017       END
03018       SUBROUTINE CMMCH( TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB,
03019      $                  BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR, FATAL,
03020      $                  NOUT, MV )
03021 *
03022 *  Checks the results of the computational tests.
03023 *
03024 *  Auxiliary routine for test program for Level 3 Blas.
03025 *
03026 *  -- Written on 8-February-1989.
03027 *     Jack Dongarra, Argonne National Laboratory.
03028 *     Iain Duff, AERE Harwell.
03029 *     Jeremy Du Croz, Numerical Algorithms Group Ltd.
03030 *     Sven Hammarling, Numerical Algorithms Group Ltd.
03031 *
03032 *     .. Parameters ..
03033       COMPLEX            ZERO
03034       PARAMETER          ( ZERO = ( 0.0, 0.0 ) )
03035       REAL               RZERO, RONE
03036       PARAMETER          ( RZERO = 0.0, RONE = 1.0 )
03037 *     .. Scalar Arguments ..
03038       COMPLEX            ALPHA, BETA
03039       REAL               EPS, ERR
03040       INTEGER            KK, LDA, LDB, LDC, LDCC, M, N, NOUT
03041       LOGICAL            FATAL, MV
03042       CHARACTER*1        TRANSA, TRANSB
03043 *     .. Array Arguments ..
03044       COMPLEX            A( LDA, * ), B( LDB, * ), C( LDC, * ),
03045      $                   CC( LDCC, * ), CT( * )
03046       REAL               G( * )
03047 *     .. Local Scalars ..
03048       COMPLEX            CL
03049       REAL               ERRI
03050       INTEGER            I, J, K
03051       LOGICAL            CTRANA, CTRANB, TRANA, TRANB
03052 *     .. Intrinsic Functions ..
03053       INTRINSIC          ABS, AIMAG, CONJG, MAX, REAL, SQRT
03054 *     .. Statement Functions ..
03055       REAL               ABS1
03056 *     .. Statement Function definitions ..
03057       ABS1( CL ) = ABS( REAL( CL ) ) + ABS( AIMAG( CL ) )
03058 *     .. Executable Statements ..
03059       TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C'
03060       TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C'
03061       CTRANA = TRANSA.EQ.'C'
03062       CTRANB = TRANSB.EQ.'C'
03063 *
03064 *     Compute expected result, one column at a time, in CT using data
03065 *     in A, B and C.
03066 *     Compute gauges in G.
03067 *
03068       DO 220 J = 1, N
03069 *
03070          DO 10 I = 1, M
03071             CT( I ) = ZERO
03072             G( I ) = RZERO
03073    10    CONTINUE
03074          IF( .NOT.TRANA.AND..NOT.TRANB )THEN
03075             DO 30 K = 1, KK
03076                DO 20 I = 1, M
03077                   CT( I ) = CT( I ) + A( I, K )*B( K, J )
03078                   G( I ) = G( I ) + ABS1( A( I, K ) )*ABS1( B( K, J ) )
03079    20          CONTINUE
03080    30       CONTINUE
03081          ELSE IF( TRANA.AND..NOT.TRANB )THEN
03082             IF( CTRANA )THEN
03083                DO 50 K = 1, KK
03084                   DO 40 I = 1, M
03085                      CT( I ) = CT( I ) + CONJG( A( K, I ) )*B( K, J )
03086                      G( I ) = G( I ) + ABS1( A( K, I ) )*
03087      $                        ABS1( B( K, J ) )
03088    40             CONTINUE
03089    50          CONTINUE
03090             ELSE
03091                DO 70 K = 1, KK
03092                   DO 60 I = 1, M
03093                      CT( I ) = CT( I ) + A( K, I )*B( K, J )
03094                      G( I ) = G( I ) + ABS1( A( K, I ) )*
03095      $                        ABS1( B( K, J ) )
03096    60             CONTINUE
03097    70          CONTINUE
03098             END IF
03099          ELSE IF( .NOT.TRANA.AND.TRANB )THEN
03100             IF( CTRANB )THEN
03101                DO 90 K = 1, KK
03102                   DO 80 I = 1, M
03103                      CT( I ) = CT( I ) + A( I, K )*CONJG( B( J, K ) )
03104                      G( I ) = G( I ) + ABS1( A( I, K ) )*
03105      $                        ABS1( B( J, K ) )
03106    80             CONTINUE
03107    90          CONTINUE
03108             ELSE
03109                DO 110 K = 1, KK
03110                   DO 100 I = 1, M
03111                      CT( I ) = CT( I ) + A( I, K )*B( J, K )
03112                      G( I ) = G( I ) + ABS1( A( I, K ) )*
03113      $                        ABS1( B( J, K ) )
03114   100             CONTINUE
03115   110          CONTINUE
03116             END IF
03117          ELSE IF( TRANA.AND.TRANB )THEN
03118             IF( CTRANA )THEN
03119                IF( CTRANB )THEN
03120                   DO 130 K = 1, KK
03121                      DO 120 I = 1, M
03122                         CT( I ) = CT( I ) + CONJG( A( K, I ) )*
03123      $                            CONJG( B( J, K ) )
03124                         G( I ) = G( I ) + ABS1( A( K, I ) )*
03125      $                           ABS1( B( J, K ) )
03126   120                CONTINUE
03127   130             CONTINUE
03128                ELSE
03129                   DO 150 K = 1, KK
03130                      DO 140 I = 1, M
03131                         CT( I ) = CT( I ) + CONJG( A( K, I ) )*B( J, K )
03132                         G( I ) = G( I ) + ABS1( A( K, I ) )*
03133      $                           ABS1( B( J, K ) )
03134   140                CONTINUE
03135   150             CONTINUE
03136                END IF
03137             ELSE
03138                IF( CTRANB )THEN
03139                   DO 170 K = 1, KK
03140                      DO 160 I = 1, M
03141                         CT( I ) = CT( I ) + A( K, I )*CONJG( B( J, K ) )
03142                         G( I ) = G( I ) + ABS1( A( K, I ) )*
03143      $                           ABS1( B( J, K ) )
03144   160                CONTINUE
03145   170             CONTINUE
03146                ELSE
03147                   DO 190 K = 1, KK
03148                      DO 180 I = 1, M
03149                         CT( I ) = CT( I ) + A( K, I )*B( J, K )
03150                         G( I ) = G( I ) + ABS1( A( K, I ) )*
03151      $                           ABS1( B( J, K ) )
03152   180                CONTINUE
03153   190             CONTINUE
03154                END IF
03155             END IF
03156          END IF
03157          DO 200 I = 1, M
03158             CT( I ) = ALPHA*CT( I ) + BETA*C( I, J )
03159             G( I ) = ABS1( ALPHA )*G( I ) +
03160      $               ABS1( BETA )*ABS1( C( I, J ) )
03161   200    CONTINUE
03162 *
03163 *        Compute the error ratio for this result.
03164 *
03165          ERR = ZERO
03166          DO 210 I = 1, M
03167             ERRI = ABS1( CT( I ) - CC( I, J ) )/EPS
03168             IF( G( I ).NE.RZERO )
03169      $         ERRI = ERRI/G( I )
03170             ERR = MAX( ERR, ERRI )
03171             IF( ERR*SQRT( EPS ).GE.RONE )
03172      $         GO TO 230
03173   210    CONTINUE
03174 *
03175   220 CONTINUE
03176 *
03177 *     If the loop completes, all results are at least half accurate.
03178       GO TO 250
03179 *
03180 *     Report fatal error.
03181 *
03182   230 FATAL = .TRUE.
03183       WRITE( NOUT, FMT = 9999 )
03184       DO 240 I = 1, M
03185          IF( MV )THEN
03186             WRITE( NOUT, FMT = 9998 )I, CT( I ), CC( I, J )
03187          ELSE
03188             WRITE( NOUT, FMT = 9998 )I, CC( I, J ), CT( I )
03189          END IF
03190   240 CONTINUE
03191       IF( N.GT.1 )
03192      $   WRITE( NOUT, FMT = 9997 )J
03193 *
03194   250 CONTINUE
03195       RETURN
03196 *
03197  9999 FORMAT( ' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL',
03198      $      'F ACCURATE *******', /'                       EXPECTED RE',
03199      $      'SULT                    COMPUTED RESULT' )
03200  9998 FORMAT( 1X, I7, 2( '  (', G15.6, ',', G15.6, ')' ) )
03201  9997 FORMAT( '      THESE ARE THE RESULTS FOR COLUMN ', I3 )
03202 *
03203 *     End of CMMCH.
03204 *
03205       END
03206       LOGICAL FUNCTION LCE( RI, RJ, LR )
03207 *
03208 *  Tests if two arrays are identical.
03209 *
03210 *  Auxiliary routine for test program for Level 3 Blas.
03211 *
03212 *  -- Written on 8-February-1989.
03213 *     Jack Dongarra, Argonne National Laboratory.
03214 *     Iain Duff, AERE Harwell.
03215 *     Jeremy Du Croz, Numerical Algorithms Group Ltd.
03216 *     Sven Hammarling, Numerical Algorithms Group Ltd.
03217 *
03218 *     .. Scalar Arguments ..
03219       INTEGER            LR
03220 *     .. Array Arguments ..
03221       COMPLEX            RI( * ), RJ( * )
03222 *     .. Local Scalars ..
03223       INTEGER            I
03224 *     .. Executable Statements ..
03225       DO 10 I = 1, LR
03226          IF( RI( I ).NE.RJ( I ) )
03227      $      GO TO 20
03228    10 CONTINUE
03229       LCE = .TRUE.
03230       GO TO 30
03231    20 CONTINUE
03232       LCE = .FALSE.
03233    30 RETURN
03234 *
03235 *     End of LCE.
03236 *
03237       END
03238       LOGICAL FUNCTION LCERES( TYPE, UPLO, M, N, AA, AS, LDA )
03239 *
03240 *  Tests if selected elements in two arrays are equal.
03241 *
03242 *  TYPE is 'GE' or 'HE' or 'SY'.
03243 *
03244 *  Auxiliary routine for test program for Level 3 Blas.
03245 *
03246 *  -- Written on 8-February-1989.
03247 *     Jack Dongarra, Argonne National Laboratory.
03248 *     Iain Duff, AERE Harwell.
03249 *     Jeremy Du Croz, Numerical Algorithms Group Ltd.
03250 *     Sven Hammarling, Numerical Algorithms Group Ltd.
03251 *
03252 *     .. Scalar Arguments ..
03253       INTEGER            LDA, M, N
03254       CHARACTER*1        UPLO
03255       CHARACTER*2        TYPE
03256 *     .. Array Arguments ..
03257       COMPLEX            AA( LDA, * ), AS( LDA, * )
03258 *     .. Local Scalars ..
03259       INTEGER            I, IBEG, IEND, J
03260       LOGICAL            UPPER
03261 *     .. Executable Statements ..
03262       UPPER = UPLO.EQ.'U'
03263       IF( TYPE.EQ.'GE' )THEN
03264          DO 20 J = 1, N
03265             DO 10 I = M + 1, LDA
03266                IF( AA( I, J ).NE.AS( I, J ) )
03267      $            GO TO 70
03268    10       CONTINUE
03269    20    CONTINUE
03270       ELSE IF( TYPE.EQ.'HE'.OR.TYPE.EQ.'SY' )THEN
03271          DO 50 J = 1, N
03272             IF( UPPER )THEN
03273                IBEG = 1
03274                IEND = J
03275             ELSE
03276                IBEG = J
03277                IEND = N
03278             END IF
03279             DO 30 I = 1, IBEG - 1
03280                IF( AA( I, J ).NE.AS( I, J ) )
03281      $            GO TO 70
03282    30       CONTINUE
03283             DO 40 I = IEND + 1, LDA
03284                IF( AA( I, J ).NE.AS( I, J ) )
03285      $            GO TO 70
03286    40       CONTINUE
03287    50    CONTINUE
03288       END IF
03289 *
03290    60 CONTINUE
03291       LCERES = .TRUE.
03292       GO TO 80
03293    70 CONTINUE
03294       LCERES = .FALSE.
03295    80 RETURN
03296 *
03297 *     End of LCERES.
03298 *
03299       END
03300       COMPLEX FUNCTION CBEG( RESET )
03301 *
03302 *  Generates complex numbers as pairs of random numbers uniformly
03303 *  distributed between -0.5 and 0.5.
03304 *
03305 *  Auxiliary routine for test program for Level 3 Blas.
03306 *
03307 *  -- Written on 8-February-1989.
03308 *     Jack Dongarra, Argonne National Laboratory.
03309 *     Iain Duff, AERE Harwell.
03310 *     Jeremy Du Croz, Numerical Algorithms Group Ltd.
03311 *     Sven Hammarling, Numerical Algorithms Group Ltd.
03312 *
03313 *     .. Scalar Arguments ..
03314       LOGICAL            RESET
03315 *     .. Local Scalars ..
03316       INTEGER            I, IC, J, MI, MJ
03317 *     .. Save statement ..
03318       SAVE               I, IC, J, MI, MJ
03319 *     .. Intrinsic Functions ..
03320       INTRINSIC          CMPLX
03321 *     .. Executable Statements ..
03322       IF( RESET )THEN
03323 *        Initialize local variables.
03324          MI = 891
03325          MJ = 457
03326          I = 7
03327          J = 7
03328          IC = 0
03329          RESET = .FALSE.
03330       END IF
03331 *
03332 *     The sequence of values of I or J is bounded between 1 and 999.
03333 *     If initial I or J = 1,2,3,6,7 or 9, the period will be 50.
03334 *     If initial I or J = 4 or 8, the period will be 25.
03335 *     If initial I or J = 5, the period will be 10.
03336 *     IC is used to break up the period by skipping 1 value of I or J
03337 *     in 6.
03338 *
03339       IC = IC + 1
03340    10 I = I*MI
03341       J = J*MJ
03342       I = I - 1000*( I/1000 )
03343       J = J - 1000*( J/1000 )
03344       IF( IC.GE.5 )THEN
03345          IC = 0
03346          GO TO 10
03347       END IF
03348       CBEG = CMPLX( ( I - 500 )/1001.0, ( J - 500 )/1001.0 )
03349       RETURN
03350 *
03351 *     End of CBEG.
03352 *
03353       END
03354       REAL FUNCTION SDIFF( X, Y )
03355 *
03356 *  Auxiliary routine for test program for Level 3 Blas.
03357 *
03358 *  -- Written on 8-February-1989.
03359 *     Jack Dongarra, Argonne National Laboratory.
03360 *     Iain Duff, AERE Harwell.
03361 *     Jeremy Du Croz, Numerical Algorithms Group Ltd.
03362 *     Sven Hammarling, Numerical Algorithms Group Ltd.
03363 *
03364 *     .. Scalar Arguments ..
03365       REAL               X, Y
03366 *     .. Executable Statements ..
03367       SDIFF = X - Y
03368       RETURN
03369 *
03370 *     End of SDIFF.
03371 *
03372       END
03373       SUBROUTINE CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
03374 *
03375 *  Tests whether XERBLA has detected an error when it should.
03376 *
03377 *  Auxiliary routine for test program for Level 3 Blas.
03378 *
03379 *  -- Written on 8-February-1989.
03380 *     Jack Dongarra, Argonne National Laboratory.
03381 *     Iain Duff, AERE Harwell.
03382 *     Jeremy Du Croz, Numerical Algorithms Group Ltd.
03383 *     Sven Hammarling, Numerical Algorithms Group Ltd.
03384 *
03385 *     .. Scalar Arguments ..
03386       INTEGER            INFOT, NOUT
03387       LOGICAL            LERR, OK
03388       CHARACTER*6        SRNAMT
03389 *     .. Executable Statements ..
03390       IF( .NOT.LERR )THEN
03391          WRITE( NOUT, FMT = 9999 )INFOT, SRNAMT
03392          OK = .FALSE.
03393       END IF
03394       LERR = .FALSE.
03395       RETURN
03396 *
03397  9999 FORMAT( ' ***** ILLEGAL VALUE OF PARAMETER NUMBER ', I2, ' NOT D',
03398      $      'ETECTED BY ', A6, ' *****' )
03399 *
03400 *     End of CHKXER.
03401 *
03402       END
03403       SUBROUTINE XERBLA( SRNAME, INFO )
03404 *
03405 *  This is a special version of XERBLA to be used only as part of
03406 *  the test program for testing error exits from the Level 3 BLAS
03407 *  routines.
03408 *
03409 *  XERBLA  is an error handler for the Level 3 BLAS routines.
03410 *
03411 *  It is called by the Level 3 BLAS routines if an input parameter is
03412 *  invalid.
03413 *
03414 *  Auxiliary routine for test program for Level 3 Blas.
03415 *
03416 *  -- Written on 8-February-1989.
03417 *     Jack Dongarra, Argonne National Laboratory.
03418 *     Iain Duff, AERE Harwell.
03419 *     Jeremy Du Croz, Numerical Algorithms Group Ltd.
03420 *     Sven Hammarling, Numerical Algorithms Group Ltd.
03421 *
03422 *     .. Scalar Arguments ..
03423       INTEGER            INFO
03424       CHARACTER*6        SRNAME
03425 *     .. Scalars in Common ..
03426       INTEGER            INFOT, NOUT
03427       LOGICAL            LERR, OK
03428       CHARACTER*6        SRNAMT
03429 *     .. Common blocks ..
03430       COMMON             /INFOC/INFOT, NOUT, OK, LERR
03431       COMMON             /SRNAMC/SRNAMT
03432 *     .. Executable Statements ..
03433       LERR = .TRUE.
03434       IF( INFO.NE.INFOT )THEN
03435          IF( INFOT.NE.0 )THEN
03436             WRITE( NOUT, FMT = 9999 )INFO, INFOT
03437          ELSE
03438             WRITE( NOUT, FMT = 9997 )INFO
03439          END IF
03440          OK = .FALSE.
03441       END IF
03442       IF( SRNAME.NE.SRNAMT )THEN
03443          WRITE( NOUT, FMT = 9998 )SRNAME, SRNAMT
03444          OK = .FALSE.
03445       END IF
03446       RETURN
03447 *
03448  9999 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6, ' INSTEAD',
03449      $      ' OF ', I2, ' *******' )
03450  9998 FORMAT( ' ******* XERBLA WAS CALLED WITH SRNAME = ', A6, ' INSTE',
03451      $      'AD OF ', A6, ' *******' )
03452  9997 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6,
03453      $      ' *******' )
03454 *
03455 *     End of XERBLA
03456 *
03457       END
03458