LAPACK: BLAS/TESTING/zblat3.f Source File

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