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