home *** CD-ROM | disk | FTP | other *** search
/ SGI Developer Toolbox 6.1 / SGI Developer Toolbox 6.1 - Disc 4.iso / lib / mathlib / libblas / test / zblat3.f < prev    next >
Encoding:
Text File  |  1994-08-02  |  127.5 KB  |  3,446 lines
  1.       PROGRAM ZBLAT3
  2. *
  3. *  Test program for the COMPLEX*16       Level 3 Blas.
  4. *
  5. *  The program must be driven by a short data file. The first 14 records
  6. *  of the file are read using list-directed input, the last 9 records
  7. *  are read using the format ( A6, L2 ). An annotated example of a data
  8. *  file can be obtained by deleting the first 3 characters from the
  9. *  following 23 lines:
  10. *  'ZBLAT3.SUMM'     NAME OF SUMMARY OUTPUT FILE
  11. *  6                 UNIT NUMBER OF SUMMARY FILE
  12. *  'ZBLAT3.SNAP'     NAME OF SNAPSHOT OUTPUT FILE
  13. *  -1                UNIT NUMBER OF SNAPSHOT FILE (NOT USED IF .LT. 0)
  14. *  F        LOGICAL FLAG, T TO REWIND SNAPSHOT FILE AFTER EACH RECORD.
  15. *  F        LOGICAL FLAG, T TO STOP ON FAILURES.
  16. *  T        LOGICAL FLAG, T TO TEST ERROR EXITS.
  17. *  16.0     THRESHOLD VALUE OF TEST RATIO
  18. *  6                 NUMBER OF VALUES OF N
  19. *  0 1 2 3 5 9       VALUES OF N
  20. *  3                 NUMBER OF VALUES OF ALPHA
  21. *  (0.0,0.0) (1.0,0.0) (0.7,-0.9)       VALUES OF ALPHA
  22. *  3                 NUMBER OF VALUES OF BETA
  23. *  (0.0,0.0) (1.0,0.0) (1.3,-1.1)       VALUES OF BETA
  24. *  ZGEMM  T PUT F FOR NO TEST. SAME COLUMNS.
  25. *  ZHEMM  T PUT F FOR NO TEST. SAME COLUMNS.
  26. *  ZSYMM  T PUT F FOR NO TEST. SAME COLUMNS.
  27. *  ZTRMM  T PUT F FOR NO TEST. SAME COLUMNS.
  28. *  ZTRSM  T PUT F FOR NO TEST. SAME COLUMNS.
  29. *  ZHERK  T PUT F FOR NO TEST. SAME COLUMNS.
  30. *  ZSYRK  T PUT F FOR NO TEST. SAME COLUMNS.
  31. *  ZHER2K T PUT F FOR NO TEST. SAME COLUMNS.
  32. *  ZSYR2K T PUT F FOR NO TEST. SAME COLUMNS.
  33. *
  34. *  See:
  35. *
  36. *     Dongarra J. J., Du Croz J. J., Duff I. S. and Hammarling S.
  37. *     A Set of Level 3 Basic Linear Algebra Subprograms.
  38. *
  39. *     Technical Memorandum No.88 (Revision 1), Mathematics and
  40. *     Computer Science Division, Argonne National Laboratory, 9700
  41. *     South Cass Avenue, Argonne, Illinois 60439, US.
  42. *
  43. *  -- Written on 8-February-1989.
  44. *     Jack Dongarra, Argonne National Laboratory.
  45. *     Iain Duff, AERE Harwell.
  46. *     Jeremy Du Croz, Numerical Algorithms Group Ltd.
  47. *     Sven Hammarling, Numerical Algorithms Group Ltd.
  48. *
  49. *     .. Parameters ..
  50.       INTEGER            NIN
  51.       PARAMETER          ( NIN = 5 )
  52.       INTEGER            NSUBS
  53.       PARAMETER          ( NSUBS = 9 )
  54.       COMPLEX*16         ZERO, ONE
  55.       PARAMETER          ( ZERO = ( 0.0D0, 0.0D0 ),
  56.      $                   ONE = ( 1.0D0, 0.0D0 ) )
  57.       DOUBLE PRECISION   RZERO, RHALF, RONE
  58.       PARAMETER          ( RZERO = 0.0D0, RHALF = 0.5D0, RONE = 1.0D0 )
  59.       INTEGER            NMAX
  60.       PARAMETER          ( NMAX = 65 )
  61.       INTEGER            NIDMAX, NALMAX, NBEMAX
  62.       PARAMETER          ( NIDMAX = 9, NALMAX = 7, NBEMAX = 7 )
  63. *     .. Local Scalars ..
  64.       DOUBLE PRECISION   EPS, ERR, THRESH
  65.       INTEGER            I, ISNUM, J, N, NALF, NBET, NIDIM, NOUT, NTRA
  66.       LOGICAL            FATAL, LTESTT, REWI, SAME, SFATAL, TRACE,
  67.      $                   TSTERR
  68.       CHARACTER*1        TRANSA, TRANSB
  69.       CHARACTER*6        SNAMET
  70.       CHARACTER*32       SNAPS, SUMMRY
  71. *     .. Local Arrays ..
  72.       COMPLEX*16         AA( NMAX*NMAX ), AB( NMAX, 2*NMAX ),
  73.      $                   ALF( NALMAX ), AS( NMAX*NMAX ),
  74.      $                   BB( NMAX*NMAX ), BET( NBEMAX ),
  75.      $                   BS( NMAX*NMAX ), C( NMAX, NMAX ),
  76.      $                   CC( NMAX*NMAX ), CS( NMAX*NMAX ), CT( NMAX ),
  77.      $                   W( 2*NMAX )
  78.       DOUBLE PRECISION   G( NMAX )
  79.       INTEGER            IDIM( NIDMAX )
  80.       LOGICAL            LTEST( NSUBS )
  81.       CHARACTER*6        SNAMES( NSUBS )
  82. *     .. External Functions ..
  83.       DOUBLE PRECISION   DDIFF
  84.       LOGICAL            LZE
  85.       EXTERNAL           DDIFF, LZE
  86. *     .. External Subroutines ..
  87.       EXTERNAL           ZCHK1, ZCHK2, ZCHK3, ZCHK4, ZCHK5, ZCHKE, ZMMCH
  88. *     .. Intrinsic Functions ..
  89.       INTRINSIC          MAX, MIN
  90. *     .. Scalars in Common ..
  91.       INTEGER            INFOT, NOUTC
  92.       LOGICAL            LERR, OK
  93.       CHARACTER*6        SRNAMT
  94. *     .. Common blocks ..
  95.       COMMON             /INFOC/INFOT, NOUTC, OK, LERR
  96.       COMMON             /SRNAMC/SRNAMT
  97. *     .. Data statements ..
  98.       DATA               SNAMES/'ZGEMM ', 'ZHEMM ', 'ZSYMM ', 'ZTRMM ',
  99.      $                   'ZTRSM ', 'ZHERK ', 'ZSYRK ', 'ZHER2K',
  100.      $                   'ZSYR2K'/
  101. *     .. Executable Statements ..
  102. *
  103. *     Read name and unit number for summary output file and open file.
  104. *
  105.       READ( NIN, FMT = * )SUMMRY
  106.       READ( NIN, FMT = * )NOUT
  107.       OPEN( NOUT, FILE = SUMMRY, STATUS = 'NEW' )
  108.       NOUTC = NOUT
  109. *
  110. *     Read name and unit number for snapshot output file and open file.
  111. *
  112.       READ( NIN, FMT = * )SNAPS
  113.       READ( NIN, FMT = * )NTRA
  114.       TRACE = NTRA.GE.0
  115.       IF( TRACE )THEN
  116.          OPEN( NTRA, FILE = SNAPS, STATUS = 'NEW' )
  117.       END IF
  118. *     Read the flag that directs rewinding of the snapshot file.
  119.       READ( NIN, FMT = * )REWI
  120.       REWI = REWI.AND.TRACE
  121. *     Read the flag that directs stopping on any failure.
  122.       READ( NIN, FMT = * )SFATAL
  123. *     Read the flag that indicates whether error exits are to be tested.
  124.       READ( NIN, FMT = * )TSTERR
  125. *     Read the threshold value of the test ratio
  126.       READ( NIN, FMT = * )THRESH
  127. *
  128. *     Read and check the parameter values for the tests.
  129. *
  130. *     Values of N
  131.       READ( NIN, FMT = * )NIDIM
  132.       IF( NIDIM.LT.1.OR.NIDIM.GT.NIDMAX )THEN
  133.          WRITE( NOUT, FMT = 9997 )'N', NIDMAX
  134.          GO TO 220
  135.       END IF
  136.       READ( NIN, FMT = * )( IDIM( I ), I = 1, NIDIM )
  137.       DO 10 I = 1, NIDIM
  138.          IF( IDIM( I ).LT.0.OR.IDIM( I ).GT.NMAX )THEN
  139.             WRITE( NOUT, FMT = 9996 )NMAX
  140.             GO TO 220
  141.          END IF
  142.    10 CONTINUE
  143. *     Values of ALPHA
  144.       READ( NIN, FMT = * )NALF
  145.       IF( NALF.LT.1.OR.NALF.GT.NALMAX )THEN
  146.          WRITE( NOUT, FMT = 9997 )'ALPHA', NALMAX
  147.          GO TO 220
  148.       END IF
  149.       READ( NIN, FMT = * )( ALF( I ), I = 1, NALF )
  150. *     Values of BETA
  151.       READ( NIN, FMT = * )NBET
  152.       IF( NBET.LT.1.OR.NBET.GT.NBEMAX )THEN
  153.          WRITE( NOUT, FMT = 9997 )'BETA', NBEMAX
  154.          GO TO 220
  155.       END IF
  156.       READ( NIN, FMT = * )( BET( I ), I = 1, NBET )
  157. *
  158. *     Report values of parameters.
  159. *
  160.       WRITE( NOUT, FMT = 9995 )
  161.       WRITE( NOUT, FMT = 9994 )( IDIM( I ), I = 1, NIDIM )
  162.       WRITE( NOUT, FMT = 9993 )( ALF( I ), I = 1, NALF )
  163.       WRITE( NOUT, FMT = 9992 )( BET( I ), I = 1, NBET )
  164.       IF( .NOT.TSTERR )THEN
  165.          WRITE( NOUT, FMT = * )
  166.          WRITE( NOUT, FMT = 9984 )
  167.       END IF
  168.       WRITE( NOUT, FMT = * )
  169.       WRITE( NOUT, FMT = 9999 )THRESH
  170.       WRITE( NOUT, FMT = * )
  171. *
  172. *     Read names of subroutines and flags which indicate
  173. *     whether they are to be tested.
  174. *
  175.       DO 20 I = 1, NSUBS
  176.          LTEST( I ) = .FALSE.
  177.    20 CONTINUE
  178.    30 READ( NIN, FMT = 9988, END = 60 )SNAMET, LTESTT
  179.       DO 40 I = 1, NSUBS
  180.          IF( SNAMET.EQ.SNAMES( I ) )
  181.      $      GO TO 50
  182.    40 CONTINUE
  183.       WRITE( NOUT, FMT = 9990 )SNAMET
  184.       STOP
  185.    50 LTEST( I ) = LTESTT
  186.       GO TO 30
  187. *
  188.    60 CONTINUE
  189.       CLOSE ( NIN )
  190. *
  191. *     Compute EPS (the machine precision).
  192. *
  193.       EPS = RONE
  194.    70 CONTINUE
  195.       IF( DDIFF( RONE + EPS, RONE ).EQ.RZERO )
  196.      $   GO TO 80
  197.       EPS = RHALF*EPS
  198.       GO TO 70
  199.    80 CONTINUE
  200.       EPS = EPS + EPS
  201.       WRITE( NOUT, FMT = 9998 )EPS
  202. *
  203. *     Check the reliability of ZMMCH using exact data.
  204. *
  205.       N = MIN( 32, NMAX )
  206.       DO 100 J = 1, N
  207.          DO 90 I = 1, N
  208.             AB( I, J ) = MAX( I - J + 1, 0 )
  209.    90    CONTINUE
  210.          AB( J, NMAX + 1 ) = J
  211.          AB( 1, NMAX + J ) = J
  212.          C( J, 1 ) = ZERO
  213.   100 CONTINUE
  214.       DO 110 J = 1, N
  215.          CC( J ) = J*( ( J + 1 )*J )/2 - ( ( J + 1 )*J*( J - 1 ) )/3
  216.   110 CONTINUE
  217. *     CC holds the exact result. On exit from ZMMCH CT holds
  218. *     the result computed by ZMMCH.
  219.       TRANSA = 'N'
  220.       TRANSB = 'N'
  221.       CALL ZMMCH( TRANSA, TRANSB, N, 1, N, ONE, AB, NMAX,
  222.      $            AB( 1, NMAX + 1 ), NMAX, ZERO, C, NMAX, CT, G, CC,
  223.      $            NMAX, EPS, ERR, FATAL, NOUT, .TRUE. )
  224.       SAME = LZE( CC, CT, N )
  225.       IF( .NOT.SAME.OR.ERR.NE.RZERO )THEN
  226.          WRITE( NOUT, FMT = 9989 )TRANSA, TRANSB, SAME, ERR
  227.          STOP
  228.       END IF
  229.       TRANSB = 'C'
  230.       CALL ZMMCH( TRANSA, TRANSB, N, 1, N, ONE, AB, NMAX,
  231.      $            AB( 1, NMAX + 1 ), NMAX, ZERO, C, NMAX, CT, G, CC,
  232.      $            NMAX, EPS, ERR, FATAL, NOUT, .TRUE. )
  233.       SAME = LZE( CC, CT, N )
  234.       IF( .NOT.SAME.OR.ERR.NE.RZERO )THEN
  235.          WRITE( NOUT, FMT = 9989 )TRANSA, TRANSB, SAME, ERR
  236.          STOP
  237.       END IF
  238.       DO 120 J = 1, N
  239.          AB( J, NMAX + 1 ) = N - J + 1
  240.          AB( 1, NMAX + J ) = N - J + 1
  241.   120 CONTINUE
  242.       DO 130 J = 1, N
  243.          CC( N - J + 1 ) = J*( ( J + 1 )*J )/2 -
  244.      $                     ( ( J + 1 )*J*( J - 1 ) )/3
  245.   130 CONTINUE
  246.       TRANSA = 'C'
  247.       TRANSB = 'N'
  248.       CALL ZMMCH( TRANSA, TRANSB, N, 1, N, ONE, AB, NMAX,
  249.      $            AB( 1, NMAX + 1 ), NMAX, ZERO, C, NMAX, CT, G, CC,
  250.      $            NMAX, EPS, ERR, FATAL, NOUT, .TRUE. )
  251.       SAME = LZE( CC, CT, N )
  252.       IF( .NOT.SAME.OR.ERR.NE.RZERO )THEN
  253.          WRITE( NOUT, FMT = 9989 )TRANSA, TRANSB, SAME, ERR
  254.          STOP
  255.       END IF
  256.       TRANSB = 'C'
  257.       CALL ZMMCH( TRANSA, TRANSB, N, 1, N, ONE, AB, NMAX,
  258.      $            AB( 1, NMAX + 1 ), NMAX, ZERO, C, NMAX, CT, G, CC,
  259.      $            NMAX, EPS, ERR, FATAL, NOUT, .TRUE. )
  260.       SAME = LZE( CC, CT, N )
  261.       IF( .NOT.SAME.OR.ERR.NE.RZERO )THEN
  262.          WRITE( NOUT, FMT = 9989 )TRANSA, TRANSB, SAME, ERR
  263.          STOP
  264.       END IF
  265. *
  266. *     Test each subroutine in turn.
  267. *
  268.       DO 200 ISNUM = 1, NSUBS
  269.          WRITE( NOUT, FMT = * )
  270.          IF( .NOT.LTEST( ISNUM ) )THEN
  271. *           Subprogram is not to be tested.
  272.             WRITE( NOUT, FMT = 9987 )SNAMES( ISNUM )
  273.          ELSE
  274.             SRNAMT = SNAMES( ISNUM )
  275. *           Test error exits.
  276.             IF( TSTERR )THEN
  277.                CALL ZCHKE( ISNUM, SNAMES( ISNUM ), NOUT )
  278.                WRITE( NOUT, FMT = * )
  279.             END IF
  280. *           Test computations.
  281.             INFOT = 0
  282.             OK = .TRUE.
  283.             FATAL = .FALSE.
  284.             GO TO ( 140, 150, 150, 160, 160, 170, 170,
  285.      $              180, 180 )ISNUM
  286. *           Test ZGEMM, 01.
  287.   140       CALL ZCHK1( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
  288.      $                  REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
  289.      $                  NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C,
  290.      $                  CC, CS, CT, G )
  291.             GO TO 190
  292. *           Test ZHEMM, 02, ZSYMM, 03.
  293.   150       CALL ZCHK2( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
  294.      $                  REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
  295.      $                  NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C,
  296.      $                  CC, CS, CT, G )
  297.             GO TO 190
  298. *           Test ZTRMM, 04, ZTRSM, 05.
  299.   160       CALL ZCHK3( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
  300.      $                  REWI, FATAL, NIDIM, IDIM, NALF, ALF, NMAX, AB,
  301.      $                  AA, AS, AB( 1, NMAX + 1 ), BB, BS, CT, G, C )
  302.             GO TO 190
  303. *           Test ZHERK, 06, ZSYRK, 07.
  304.   170       CALL ZCHK4( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
  305.      $                  REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
  306.      $                  NMAX, AB, AA, AS, AB( 1, NMAX + 1 ), BB, BS, C,
  307.      $                  CC, CS, CT, G )
  308.             GO TO 190
  309. *           Test ZHER2K, 08, ZSYR2K, 09.
  310.   180       CALL ZCHK5( SNAMES( ISNUM ), EPS, THRESH, NOUT, NTRA, TRACE,
  311.      $                  REWI, FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET,
  312.      $                  NMAX, AB, AA, AS, BB, BS, C, CC, CS, CT, G, W )
  313.             GO TO 190
  314. *
  315.   190       IF( FATAL.AND.SFATAL )
  316.      $         GO TO 210
  317.          END IF
  318.   200 CONTINUE
  319.       WRITE( NOUT, FMT = 9986 )
  320.       GO TO 230
  321. *
  322.   210 CONTINUE
  323.       WRITE( NOUT, FMT = 9985 )
  324.       GO TO 230
  325. *
  326.   220 CONTINUE
  327.       WRITE( NOUT, FMT = 9991 )
  328. *
  329.   230 CONTINUE
  330.       IF( TRACE )
  331.      $   CLOSE ( NTRA )
  332.       CLOSE ( NOUT )
  333.       STOP
  334. *
  335.  9999 FORMAT( ' ROUTINES PASS COMPUTATIONAL TESTS IF TEST RATIO IS LES',
  336.      $      'S THAN', F8.2 )
  337.  9998 FORMAT( ' RELATIVE MACHINE PRECISION IS TAKEN TO BE', 1P, D9.1 )
  338.  9997 FORMAT( ' NUMBER OF VALUES OF ', A, ' IS LESS THAN 1 OR GREATER ',
  339.      $      'THAN ', I2 )
  340.  9996 FORMAT( ' VALUE OF N IS LESS THAN 0 OR GREATER THAN ', I2 )
  341.  9995 FORMAT( ' TESTS OF THE COMPLEX*16       LEVEL 3 BLAS', //' THE F',
  342.      $      'OLLOWING PARAMETER VALUES WILL BE USED:' )
  343.  9994 FORMAT( '   FOR N              ', 9I6 )
  344.  9993 FORMAT( '   FOR ALPHA          ',
  345.      $      7( '(', F4.1, ',', F4.1, ')  ', : ) )
  346.  9992 FORMAT( '   FOR BETA           ',
  347.      $      7( '(', F4.1, ',', F4.1, ')  ', : ) )
  348.  9991 FORMAT( ' AMEND DATA FILE OR INCREASE ARRAY SIZES IN PROGRAM',
  349.      $      /' ******* TESTS ABANDONED *******' )
  350.  9990 FORMAT( ' SUBPROGRAM NAME ', A6, ' NOT RECOGNIZED', /' ******* T',
  351.      $      'ESTS ABANDONED *******' )
  352.  9989 FORMAT( ' ERROR IN ZMMCH -  IN-LINE DOT PRODUCTS ARE BEING EVALU',
  353.      $      'ATED WRONGLY.', /' ZMMCH WAS CALLED WITH TRANSA = ', A1,
  354.      $      ' AND TRANSB = ', A1, /' AND RETURNED SAME = ', L1, ' AND ',
  355.      $      'ERR = ', F12.3, '.', /' THIS MAY BE DUE TO FAULTS IN THE ',
  356.      $      'ARITHMETIC OR THE COMPILER.', /' ******* TESTS ABANDONED ',
  357.      $      '*******' )
  358.  9988 FORMAT( A6, L2 )
  359.  9987 FORMAT( 1X, A6, ' WAS NOT TESTED' )
  360.  9986 FORMAT( /' END OF TESTS' )
  361.  9985 FORMAT( /' ******* FATAL ERROR - TESTS ABANDONED *******' )
  362.  9984 FORMAT( ' ERROR-EXITS WILL NOT BE TESTED' )
  363. *
  364. *     End of ZBLAT3.
  365. *
  366.       END
  367.       SUBROUTINE ZCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
  368.      $                  FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
  369.      $                  A, AA, AS, B, BB, BS, C, CC, CS, CT, G )
  370. *
  371. *  Tests ZGEMM.
  372. *
  373. *  Auxiliary routine for test program for Level 3 Blas.
  374. *
  375. *  -- Written on 8-February-1989.
  376. *     Jack Dongarra, Argonne National Laboratory.
  377. *     Iain Duff, AERE Harwell.
  378. *     Jeremy Du Croz, Numerical Algorithms Group Ltd.
  379. *     Sven Hammarling, Numerical Algorithms Group Ltd.
  380. *
  381. *     .. Parameters ..
  382.       COMPLEX*16         ZERO
  383.       PARAMETER          ( ZERO = ( 0.0D0, 0.0D0 ) )
  384.       DOUBLE PRECISION   RZERO
  385.       PARAMETER          ( RZERO = 0.0D0 )
  386. *     .. Scalar Arguments ..
  387.       DOUBLE PRECISION   EPS, THRESH
  388.       INTEGER            NALF, NBET, NIDIM, NMAX, NOUT, NTRA
  389.       LOGICAL            FATAL, REWI, TRACE
  390.       CHARACTER*6        SNAME
  391. *     .. Array Arguments ..
  392.       COMPLEX*16         A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
  393.      $                   AS( NMAX*NMAX ), B( NMAX, NMAX ),
  394.      $                   BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ),
  395.      $                   C( NMAX, NMAX ), CC( NMAX*NMAX ),
  396.      $                   CS( NMAX*NMAX ), CT( NMAX )
  397.       DOUBLE PRECISION   G( NMAX )
  398.       INTEGER            IDIM( NIDIM )
  399. *     .. Local Scalars ..
  400.       COMPLEX*16         ALPHA, ALS, BETA, BLS
  401.       DOUBLE PRECISION   ERR, ERRMAX
  402.       INTEGER            I, IA, IB, ICA, ICB, IK, IM, IN, K, KS, LAA,
  403.      $                   LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS, M,
  404.      $                   MA, MB, MS, N, NA, NARGS, NB, NC, NS
  405.       LOGICAL            NULL, RESET, SAME, TRANA, TRANB
  406.       CHARACTER*1        TRANAS, TRANBS, TRANSA, TRANSB
  407.       CHARACTER*3        ICH
  408. *     .. Local Arrays ..
  409.       LOGICAL            ISAME( 13 )
  410. *     .. External Functions ..
  411.       LOGICAL            LZE, LZERES
  412.       EXTERNAL           LZE, LZERES
  413. *     .. External Subroutines ..
  414.       EXTERNAL           ZGEMM, ZMAKE, ZMMCH
  415. *     .. Intrinsic Functions ..
  416.       INTRINSIC          MAX
  417. *     .. Scalars in Common ..
  418.       INTEGER            INFOT, NOUTC
  419.       LOGICAL            LERR, OK
  420. *     .. Common blocks ..
  421.       COMMON             /INFOC/INFOT, NOUTC, OK, LERR
  422. *     .. Data statements ..
  423.       DATA               ICH/'NTC'/
  424. *     .. Executable Statements ..
  425. *
  426.       NARGS = 13
  427.       NC = 0
  428.       RESET = .TRUE.
  429.       ERRMAX = RZERO
  430. *
  431.       DO 110 IM = 1, NIDIM
  432.          M = IDIM( IM )
  433. *
  434.          DO 100 IN = 1, NIDIM
  435.             N = IDIM( IN )
  436. *           Set LDC to 1 more than minimum value if room.
  437.             LDC = M
  438.             IF( LDC.LT.NMAX )
  439.      $         LDC = LDC + 1
  440. *           Skip tests if not enough room.
  441.             IF( LDC.GT.NMAX )
  442.      $         GO TO 100
  443.             LCC = LDC*N
  444.             NULL = N.LE.0.OR.M.LE.0
  445. *
  446.             DO 90 IK = 1, NIDIM
  447.                K = IDIM( IK )
  448. *
  449.                DO 80 ICA = 1, 3
  450.                   TRANSA = ICH( ICA: ICA )
  451.                   TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C'
  452. *
  453.                   IF( TRANA )THEN
  454.                      MA = K
  455.                      NA = M
  456.                   ELSE
  457.                      MA = M
  458.                      NA = K
  459.                   END IF
  460. *                 Set LDA to 1 more than minimum value if room.
  461.                   LDA = MA
  462.                   IF( LDA.LT.NMAX )
  463.      $               LDA = LDA + 1
  464. *                 Skip tests if not enough room.
  465.                   IF( LDA.GT.NMAX )
  466.      $               GO TO 80
  467.                   LAA = LDA*NA
  468. *
  469. *                 Generate the matrix A.
  470. *
  471.                   CALL ZMAKE( 'GE', ' ', ' ', MA, NA, A, NMAX, AA, LDA,
  472.      $                        RESET, ZERO )
  473. *
  474.                   DO 70 ICB = 1, 3
  475.                      TRANSB = ICH( ICB: ICB )
  476.                      TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C'
  477. *
  478.                      IF( TRANB )THEN
  479.                         MB = N
  480.                         NB = K
  481.                      ELSE
  482.                         MB = K
  483.                         NB = N
  484.                      END IF
  485. *                    Set LDB to 1 more than minimum value if room.
  486.                      LDB = MB
  487.                      IF( LDB.LT.NMAX )
  488.      $                  LDB = LDB + 1
  489. *                    Skip tests if not enough room.
  490.                      IF( LDB.GT.NMAX )
  491.      $                  GO TO 70
  492.                      LBB = LDB*NB
  493. *
  494. *                    Generate the matrix B.
  495. *
  496.                      CALL ZMAKE( 'GE', ' ', ' ', MB, NB, B, NMAX, BB,
  497.      $                           LDB, RESET, ZERO )
  498. *
  499.                      DO 60 IA = 1, NALF
  500.                         ALPHA = ALF( IA )
  501. *
  502.                         DO 50 IB = 1, NBET
  503.                            BETA = BET( IB )
  504. *
  505. *                          Generate the matrix C.
  506. *
  507.                            CALL ZMAKE( 'GE', ' ', ' ', M, N, C, NMAX,
  508.      $                                 CC, LDC, RESET, ZERO )
  509. *
  510.                            NC = NC + 1
  511. *
  512. *                          Save every datum before calling the
  513. *                          subroutine.
  514. *
  515.                            TRANAS = TRANSA
  516.                            TRANBS = TRANSB
  517.                            MS = M
  518.                            NS = N
  519.                            KS = K
  520.                            ALS = ALPHA
  521.                            DO 10 I = 1, LAA
  522.                               AS( I ) = AA( I )
  523.    10                      CONTINUE
  524.                            LDAS = LDA
  525.                            DO 20 I = 1, LBB
  526.                               BS( I ) = BB( I )
  527.    20                      CONTINUE
  528.                            LDBS = LDB
  529.                            BLS = BETA
  530.                            DO 30 I = 1, LCC
  531.                               CS( I ) = CC( I )
  532.    30                      CONTINUE
  533.                            LDCS = LDC
  534. *
  535. *                          Call the subroutine.
  536. *
  537.                            IF( TRACE )
  538.      $                        WRITE( NTRA, FMT = 9995 )NC, SNAME,
  539.      $                        TRANSA, TRANSB, M, N, K, ALPHA, LDA, LDB,
  540.      $                        BETA, LDC
  541.                            IF( REWI )
  542.      $                        REWIND NTRA
  543.                            CALL ZGEMM( TRANSA, TRANSB, M, N, K, ALPHA,
  544.      $                                 AA, LDA, BB, LDB, BETA, CC, LDC )
  545. *
  546. *                          Check if error-exit was taken incorrectly.
  547. *
  548.                            IF( .NOT.OK )THEN
  549.                               WRITE( NOUT, FMT = 9994 )
  550.                               FATAL = .TRUE.
  551.                               GO TO 120
  552.                            END IF
  553. *
  554. *                          See what data changed inside subroutines.
  555. *
  556.                            ISAME( 1 ) = TRANSA.EQ.TRANAS
  557.                            ISAME( 2 ) = TRANSB.EQ.TRANBS
  558.                            ISAME( 3 ) = MS.EQ.M
  559.                            ISAME( 4 ) = NS.EQ.N
  560.                            ISAME( 5 ) = KS.EQ.K
  561.                            ISAME( 6 ) = ALS.EQ.ALPHA
  562.                            ISAME( 7 ) = LZE( AS, AA, LAA )
  563.                            ISAME( 8 ) = LDAS.EQ.LDA
  564.                            ISAME( 9 ) = LZE( BS, BB, LBB )
  565.                            ISAME( 10 ) = LDBS.EQ.LDB
  566.                            ISAME( 11 ) = BLS.EQ.BETA
  567.                            IF( NULL )THEN
  568.                               ISAME( 12 ) = LZE( CS, CC, LCC )
  569.                            ELSE
  570.                               ISAME( 12 ) = LZERES( 'GE', ' ', M, N, CS,
  571.      $                                      CC, LDC )
  572.                            END IF
  573.                            ISAME( 13 ) = LDCS.EQ.LDC
  574. *
  575. *                          If data was incorrectly changed, report
  576. *                          and return.
  577. *
  578.                            SAME = .TRUE.
  579.                            DO 40 I = 1, NARGS
  580.                               SAME = SAME.AND.ISAME( I )
  581.                               IF( .NOT.ISAME( I ) )
  582.      $                           WRITE( NOUT, FMT = 9998 )I
  583.    40                      CONTINUE
  584.                            IF( .NOT.SAME )THEN
  585.                               FATAL = .TRUE.
  586.                               GO TO 120
  587.                            END IF
  588. *
  589.                            IF( .NOT.NULL )THEN
  590. *
  591. *                             Check the result.
  592. *
  593.                               CALL ZMMCH( TRANSA, TRANSB, M, N, K,
  594.      $                                    ALPHA, A, NMAX, B, NMAX, BETA,
  595.      $                                    C, NMAX, CT, G, CC, LDC, EPS,
  596.      $                                    ERR, FATAL, NOUT, .TRUE. )
  597.                               ERRMAX = MAX( ERRMAX, ERR )
  598. *                             If got really bad answer, report and
  599. *                             return.
  600.                               IF( FATAL )
  601.      $                           GO TO 120
  602.                            END IF
  603. *
  604.    50                   CONTINUE
  605. *
  606.    60                CONTINUE
  607. *
  608.    70             CONTINUE
  609. *
  610.    80          CONTINUE
  611. *
  612.    90       CONTINUE
  613. *
  614.   100    CONTINUE
  615. *
  616.   110 CONTINUE
  617. *
  618. *     Report result.
  619. *
  620.       IF( ERRMAX.LT.THRESH )THEN
  621.          WRITE( NOUT, FMT = 9999 )SNAME, NC
  622.       ELSE
  623.          WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
  624.       END IF
  625.       GO TO 130
  626. *
  627.   120 CONTINUE
  628.       WRITE( NOUT, FMT = 9996 )SNAME
  629.       WRITE( NOUT, FMT = 9995 )NC, SNAME, TRANSA, TRANSB, M, N, K,
  630.      $   ALPHA, LDA, LDB, BETA, LDC
  631. *
  632.   130 CONTINUE
  633.       RETURN
  634. *
  635.  9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
  636.      $      'S)' )
  637.  9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
  638.      $      'ANGED INCORRECTLY *******' )
  639.  9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
  640.      $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
  641.      $      ' - SUSPECT *******' )
  642.  9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
  643.  9995 FORMAT( 1X, I6, ': ', A6, '(''', A1, ''',''', A1, ''',',
  644.      $      3( I3, ',' ), '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3,
  645.      $      ',(', F4.1, ',', F4.1, '), C,', I3, ').' )
  646.  9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
  647.      $      '******' )
  648. *
  649. *     End of ZCHK1.
  650. *
  651.       END
  652.       SUBROUTINE ZCHK2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
  653.      $                  FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
  654.      $                  A, AA, AS, B, BB, BS, C, CC, CS, CT, G )
  655. *
  656. *  Tests ZHEMM and ZSYMM.
  657. *
  658. *  Auxiliary routine for test program for Level 3 Blas.
  659. *
  660. *  -- Written on 8-February-1989.
  661. *     Jack Dongarra, Argonne National Laboratory.
  662. *     Iain Duff, AERE Harwell.
  663. *     Jeremy Du Croz, Numerical Algorithms Group Ltd.
  664. *     Sven Hammarling, Numerical Algorithms Group Ltd.
  665. *
  666. *     .. Parameters ..
  667.       COMPLEX*16         ZERO
  668.       PARAMETER          ( ZERO = ( 0.0D0, 0.0D0 ) )
  669.       DOUBLE PRECISION   RZERO
  670.       PARAMETER          ( RZERO = 0.0D0 )
  671. *     .. Scalar Arguments ..
  672.       DOUBLE PRECISION   EPS, THRESH
  673.       INTEGER            NALF, NBET, NIDIM, NMAX, NOUT, NTRA
  674.       LOGICAL            FATAL, REWI, TRACE
  675.       CHARACTER*6        SNAME
  676. *     .. Array Arguments ..
  677.       COMPLEX*16         A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
  678.      $                   AS( NMAX*NMAX ), B( NMAX, NMAX ),
  679.      $                   BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ),
  680.      $                   C( NMAX, NMAX ), CC( NMAX*NMAX ),
  681.      $                   CS( NMAX*NMAX ), CT( NMAX )
  682.       DOUBLE PRECISION   G( NMAX )
  683.       INTEGER            IDIM( NIDIM )
  684. *     .. Local Scalars ..
  685.       COMPLEX*16         ALPHA, ALS, BETA, BLS
  686.       DOUBLE PRECISION   ERR, ERRMAX
  687.       INTEGER            I, IA, IB, ICS, ICU, IM, IN, LAA, LBB, LCC,
  688.      $                   LDA, LDAS, LDB, LDBS, LDC, LDCS, M, MS, N, NA,
  689.      $                   NARGS, NC, NS
  690.       LOGICAL            CONJ, LEFT, NULL, RESET, SAME
  691.       CHARACTER*1        SIDE, SIDES, UPLO, UPLOS
  692.       CHARACTER*2        ICHS, ICHU
  693. *     .. Local Arrays ..
  694.       LOGICAL            ISAME( 13 )
  695. *     .. External Functions ..
  696.       LOGICAL            LZE, LZERES
  697.       EXTERNAL           LZE, LZERES
  698. *     .. External Subroutines ..
  699.       EXTERNAL           ZHEMM, ZMAKE, ZMMCH, ZSYMM
  700. *     .. Intrinsic Functions ..
  701.       INTRINSIC          MAX
  702. *     .. Scalars in Common ..
  703.       INTEGER            INFOT, NOUTC
  704.       LOGICAL            LERR, OK
  705. *     .. Common blocks ..
  706.       COMMON             /INFOC/INFOT, NOUTC, OK, LERR
  707. *     .. Data statements ..
  708.       DATA               ICHS/'LR'/, ICHU/'UL'/
  709. *     .. Executable Statements ..
  710.       CONJ = SNAME( 2: 3 ).EQ.'HE'
  711. *
  712.       NARGS = 12
  713.       NC = 0
  714.       RESET = .TRUE.
  715.       ERRMAX = RZERO
  716. *
  717.       DO 100 IM = 1, NIDIM
  718.          M = IDIM( IM )
  719. *
  720.          DO 90 IN = 1, NIDIM
  721.             N = IDIM( IN )
  722. *           Set LDC to 1 more than minimum value if room.
  723.             LDC = M
  724.             IF( LDC.LT.NMAX )
  725.      $         LDC = LDC + 1
  726. *           Skip tests if not enough room.
  727.             IF( LDC.GT.NMAX )
  728.      $         GO TO 90
  729.             LCC = LDC*N
  730.             NULL = N.LE.0.OR.M.LE.0
  731. *           Set LDB to 1 more than minimum value if room.
  732.             LDB = M
  733.             IF( LDB.LT.NMAX )
  734.      $         LDB = LDB + 1
  735. *           Skip tests if not enough room.
  736.             IF( LDB.GT.NMAX )
  737.      $         GO TO 90
  738.             LBB = LDB*N
  739. *
  740. *           Generate the matrix B.
  741. *
  742.             CALL ZMAKE( 'GE', ' ', ' ', M, N, B, NMAX, BB, LDB, RESET,
  743.      $                  ZERO )
  744. *
  745.             DO 80 ICS = 1, 2
  746.                SIDE = ICHS( ICS: ICS )
  747.                LEFT = SIDE.EQ.'L'
  748. *
  749.                IF( LEFT )THEN
  750.                   NA = M
  751.                ELSE
  752.                   NA = N
  753.                END IF
  754. *              Set LDA to 1 more than minimum value if room.
  755.                LDA = NA
  756.                IF( LDA.LT.NMAX )
  757.      $            LDA = LDA + 1
  758. *              Skip tests if not enough room.
  759.                IF( LDA.GT.NMAX )
  760.      $            GO TO 80
  761.                LAA = LDA*NA
  762. *
  763.                DO 70 ICU = 1, 2
  764.                   UPLO = ICHU( ICU: ICU )
  765. *
  766. *                 Generate the hermitian or symmetric matrix A.
  767. *
  768.                   CALL ZMAKE( SNAME( 2: 3 ), UPLO, ' ', NA, NA, A, NMAX,
  769.      $                        AA, LDA, RESET, ZERO )
  770. *
  771.                   DO 60 IA = 1, NALF
  772.                      ALPHA = ALF( IA )
  773. *
  774.                      DO 50 IB = 1, NBET
  775.                         BETA = BET( IB )
  776. *
  777. *                       Generate the matrix C.
  778. *
  779.                         CALL ZMAKE( 'GE', ' ', ' ', M, N, C, NMAX, CC,
  780.      $                              LDC, RESET, ZERO )
  781. *
  782.                         NC = NC + 1
  783. *
  784. *                       Save every datum before calling the
  785. *                       subroutine.
  786. *
  787.                         SIDES = SIDE
  788.                         UPLOS = UPLO
  789.                         MS = M
  790.                         NS = N
  791.                         ALS = ALPHA
  792.                         DO 10 I = 1, LAA
  793.                            AS( I ) = AA( I )
  794.    10                   CONTINUE
  795.                         LDAS = LDA
  796.                         DO 20 I = 1, LBB
  797.                            BS( I ) = BB( I )
  798.    20                   CONTINUE
  799.                         LDBS = LDB
  800.                         BLS = BETA
  801.                         DO 30 I = 1, LCC
  802.                            CS( I ) = CC( I )
  803.    30                   CONTINUE
  804.                         LDCS = LDC
  805. *
  806. *                       Call the subroutine.
  807. *
  808.                         IF( TRACE )
  809.      $                     WRITE( NTRA, FMT = 9995 )NC, SNAME, SIDE,
  810.      $                     UPLO, M, N, ALPHA, LDA, LDB, BETA, LDC
  811.                         IF( REWI )
  812.      $                     REWIND NTRA
  813.                         IF( CONJ )THEN
  814.                            CALL ZHEMM( SIDE, UPLO, M, N, ALPHA, AA, LDA,
  815.      $                                 BB, LDB, BETA, CC, LDC )
  816.                         ELSE
  817.                            CALL ZSYMM( SIDE, UPLO, M, N, ALPHA, AA, LDA,
  818.      $                                 BB, LDB, BETA, CC, LDC )
  819.                         END IF
  820. *
  821. *                       Check if error-exit was taken incorrectly.
  822. *
  823.                         IF( .NOT.OK )THEN
  824.                            WRITE( NOUT, FMT = 9994 )
  825.                            FATAL = .TRUE.
  826.                            GO TO 110
  827.                         END IF
  828. *
  829. *                       See what data changed inside subroutines.
  830. *
  831.                         ISAME( 1 ) = SIDES.EQ.SIDE
  832.                         ISAME( 2 ) = UPLOS.EQ.UPLO
  833.                         ISAME( 3 ) = MS.EQ.M
  834.                         ISAME( 4 ) = NS.EQ.N
  835.                         ISAME( 5 ) = ALS.EQ.ALPHA
  836.                         ISAME( 6 ) = LZE( AS, AA, LAA )
  837.                         ISAME( 7 ) = LDAS.EQ.LDA
  838.                         ISAME( 8 ) = LZE( BS, BB, LBB )
  839.                         ISAME( 9 ) = LDBS.EQ.LDB
  840.                         ISAME( 10 ) = BLS.EQ.BETA
  841.                         IF( NULL )THEN
  842.                            ISAME( 11 ) = LZE( CS, CC, LCC )
  843.                         ELSE
  844.                            ISAME( 11 ) = LZERES( 'GE', ' ', M, N, CS,
  845.      $                                   CC, LDC )
  846.                         END IF
  847.                         ISAME( 12 ) = LDCS.EQ.LDC
  848. *
  849. *                       If data was incorrectly changed, report and
  850. *                       return.
  851. *
  852.                         SAME = .TRUE.
  853.                         DO 40 I = 1, NARGS
  854.                            SAME = SAME.AND.ISAME( I )
  855.                            IF( .NOT.ISAME( I ) )
  856.      $                        WRITE( NOUT, FMT = 9998 )I
  857.    40                   CONTINUE
  858.                         IF( .NOT.SAME )THEN
  859.                            FATAL = .TRUE.
  860.                            GO TO 110
  861.                         END IF
  862. *
  863.                         IF( .NOT.NULL )THEN
  864. *
  865. *                          Check the result.
  866. *
  867.                            IF( LEFT )THEN
  868.                               CALL ZMMCH( 'N', 'N', M, N, M, ALPHA, A,
  869.      $                                    NMAX, B, NMAX, BETA, C, NMAX,
  870.      $                                    CT, G, CC, LDC, EPS, ERR,
  871.      $                                    FATAL, NOUT, .TRUE. )
  872.                            ELSE
  873.                               CALL ZMMCH( 'N', 'N', M, N, N, ALPHA, B,
  874.      $                                    NMAX, A, NMAX, BETA, C, NMAX,
  875.      $                                    CT, G, CC, LDC, EPS, ERR,
  876.      $                                    FATAL, NOUT, .TRUE. )
  877.                            END IF
  878.                            ERRMAX = MAX( ERRMAX, ERR )
  879. *                          If got really bad answer, report and
  880. *                          return.
  881.                            IF( FATAL )
  882.      $                        GO TO 110
  883.                         END IF
  884. *
  885.    50                CONTINUE
  886. *
  887.    60             CONTINUE
  888. *
  889.    70          CONTINUE
  890. *
  891.    80       CONTINUE
  892. *
  893.    90    CONTINUE
  894. *
  895.   100 CONTINUE
  896. *
  897. *     Report result.
  898. *
  899.       IF( ERRMAX.LT.THRESH )THEN
  900.          WRITE( NOUT, FMT = 9999 )SNAME, NC
  901.       ELSE
  902.          WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
  903.       END IF
  904.       GO TO 120
  905. *
  906.   110 CONTINUE
  907.       WRITE( NOUT, FMT = 9996 )SNAME
  908.       WRITE( NOUT, FMT = 9995 )NC, SNAME, SIDE, UPLO, M, N, ALPHA, LDA,
  909.      $   LDB, BETA, LDC
  910. *
  911.   120 CONTINUE
  912.       RETURN
  913. *
  914.  9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
  915.      $      'S)' )
  916.  9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
  917.      $      'ANGED INCORRECTLY *******' )
  918.  9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
  919.      $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
  920.      $      ' - SUSPECT *******' )
  921.  9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
  922.  9995 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
  923.      $      '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',(', F4.1,
  924.      $      ',', F4.1, '), C,', I3, ')    .' )
  925.  9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
  926.      $      '******' )
  927. *
  928. *     End of ZCHK2.
  929. *
  930.       END
  931.       SUBROUTINE ZCHK3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
  932.      $                  FATAL, NIDIM, IDIM, NALF, ALF, NMAX, A, AA, AS,
  933.      $                  B, BB, BS, CT, G, C )
  934. *
  935. *  Tests ZTRMM and ZTRSM.
  936. *
  937. *  Auxiliary routine for test program for Level 3 Blas.
  938. *
  939. *  -- Written on 8-February-1989.
  940. *     Jack Dongarra, Argonne National Laboratory.
  941. *     Iain Duff, AERE Harwell.
  942. *     Jeremy Du Croz, Numerical Algorithms Group Ltd.
  943. *     Sven Hammarling, Numerical Algorithms Group Ltd.
  944. *
  945. *     .. Parameters ..
  946.       COMPLEX*16         ZERO, ONE
  947.       PARAMETER          ( ZERO = ( 0.0D0, 0.0D0 ),
  948.      $                   ONE = ( 1.0D0, 0.0D0 ) )
  949.       DOUBLE PRECISION   RZERO
  950.       PARAMETER          ( RZERO = 0.0D0 )
  951. *     .. Scalar Arguments ..
  952.       DOUBLE PRECISION   EPS, THRESH
  953.       INTEGER            NALF, NIDIM, NMAX, NOUT, NTRA
  954.       LOGICAL            FATAL, REWI, TRACE
  955.       CHARACTER*6        SNAME
  956. *     .. Array Arguments ..
  957.       COMPLEX*16         A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
  958.      $                   AS( NMAX*NMAX ), B( NMAX, NMAX ),
  959.      $                   BB( NMAX*NMAX ), BS( NMAX*NMAX ),
  960.      $                   C( NMAX, NMAX ), CT( NMAX )
  961.       DOUBLE PRECISION   G( NMAX )
  962.       INTEGER            IDIM( NIDIM )
  963. *     .. Local Scalars ..
  964.       COMPLEX*16         ALPHA, ALS
  965.       DOUBLE PRECISION   ERR, ERRMAX
  966.       INTEGER            I, IA, ICD, ICS, ICT, ICU, IM, IN, J, LAA, LBB,
  967.      $                   LDA, LDAS, LDB, LDBS, M, MS, N, NA, NARGS, NC,
  968.      $                   NS
  969.       LOGICAL            LEFT, NULL, RESET, SAME
  970.       CHARACTER*1        DIAG, DIAGS, SIDE, SIDES, TRANAS, TRANSA, UPLO,
  971.      $                   UPLOS
  972.       CHARACTER*2        ICHD, ICHS, ICHU
  973.       CHARACTER*3        ICHT
  974. *     .. Local Arrays ..
  975.       LOGICAL            ISAME( 13 )
  976. *     .. External Functions ..
  977.       LOGICAL            LZE, LZERES
  978.       EXTERNAL           LZE, LZERES
  979. *     .. External Subroutines ..
  980.       EXTERNAL           ZMAKE, ZMMCH, ZTRMM, ZTRSM
  981. *     .. Intrinsic Functions ..
  982.       INTRINSIC          MAX
  983. *     .. Scalars in Common ..
  984.       INTEGER            INFOT, NOUTC
  985.       LOGICAL            LERR, OK
  986. *     .. Common blocks ..
  987.       COMMON             /INFOC/INFOT, NOUTC, OK, LERR
  988. *     .. Data statements ..
  989.       DATA               ICHU/'UL'/, ICHT/'NTC'/, ICHD/'UN'/, ICHS/'LR'/
  990. *     .. Executable Statements ..
  991. *
  992.       NARGS = 11
  993.       NC = 0
  994.       RESET = .TRUE.
  995.       ERRMAX = RZERO
  996. *     Set up zero matrix for ZMMCH.
  997.       DO 20 J = 1, NMAX
  998.          DO 10 I = 1, NMAX
  999.             C( I, J ) = ZERO
  1000.    10    CONTINUE
  1001.    20 CONTINUE
  1002. *
  1003.       DO 140 IM = 1, NIDIM
  1004.          M = IDIM( IM )
  1005. *
  1006.          DO 130 IN = 1, NIDIM
  1007.             N = IDIM( IN )
  1008. *           Set LDB to 1 more than minimum value if room.
  1009.             LDB = M
  1010.             IF( LDB.LT.NMAX )
  1011.      $         LDB = LDB + 1
  1012. *           Skip tests if not enough room.
  1013.             IF( LDB.GT.NMAX )
  1014.      $         GO TO 130
  1015.             LBB = LDB*N
  1016.             NULL = M.LE.0.OR.N.LE.0
  1017. *
  1018.             DO 120 ICS = 1, 2
  1019.                SIDE = ICHS( ICS: ICS )
  1020.                LEFT = SIDE.EQ.'L'
  1021.                IF( LEFT )THEN
  1022.                   NA = M
  1023.                ELSE
  1024.                   NA = N
  1025.                END IF
  1026. *              Set LDA to 1 more than minimum value if room.
  1027.                LDA = NA
  1028.                IF( LDA.LT.NMAX )
  1029.      $            LDA = LDA + 1
  1030. *              Skip tests if not enough room.
  1031.                IF( LDA.GT.NMAX )
  1032.      $            GO TO 130
  1033.                LAA = LDA*NA
  1034. *
  1035.                DO 110 ICU = 1, 2
  1036.                   UPLO = ICHU( ICU: ICU )
  1037. *
  1038.                   DO 100 ICT = 1, 3
  1039.                      TRANSA = ICHT( ICT: ICT )
  1040. *
  1041.                      DO 90 ICD = 1, 2
  1042.                         DIAG = ICHD( ICD: ICD )
  1043. *
  1044.                         DO 80 IA = 1, NALF
  1045.                            ALPHA = ALF( IA )
  1046. *
  1047. *                          Generate the matrix A.
  1048. *
  1049.                            CALL ZMAKE( 'TR', UPLO, DIAG, NA, NA, A,
  1050.      $                                 NMAX, AA, LDA, RESET, ZERO )
  1051. *
  1052. *                          Generate the matrix B.
  1053. *
  1054.                            CALL ZMAKE( 'GE', ' ', ' ', M, N, B, NMAX,
  1055.      $                                 BB, LDB, RESET, ZERO )
  1056. *
  1057.                            NC = NC + 1
  1058. *
  1059. *                          Save every datum before calling the
  1060. *                          subroutine.
  1061. *
  1062.                            SIDES = SIDE
  1063.                            UPLOS = UPLO
  1064.                            TRANAS = TRANSA
  1065.                            DIAGS = DIAG
  1066.                            MS = M
  1067.                            NS = N
  1068.                            ALS = ALPHA
  1069.                            DO 30 I = 1, LAA
  1070.                               AS( I ) = AA( I )
  1071.    30                      CONTINUE
  1072.                            LDAS = LDA
  1073.                            DO 40 I = 1, LBB
  1074.                               BS( I ) = BB( I )
  1075.    40                      CONTINUE
  1076.                            LDBS = LDB
  1077. *
  1078. *                          Call the subroutine.
  1079. *
  1080.                            IF( SNAME( 4: 5 ).EQ.'MM' )THEN
  1081.                               IF( TRACE )
  1082.      $                           WRITE( NTRA, FMT = 9995 )NC, SNAME,
  1083.      $                           SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA,
  1084.      $                           LDA, LDB
  1085.                               IF( REWI )
  1086.      $                           REWIND NTRA
  1087.                               CALL ZTRMM( SIDE, UPLO, TRANSA, DIAG, M,
  1088.      $                                    N, ALPHA, AA, LDA, BB, LDB )
  1089.                            ELSE IF( SNAME( 4: 5 ).EQ.'SM' )THEN
  1090.                               IF( TRACE )
  1091.      $                           WRITE( NTRA, FMT = 9995 )NC, SNAME,
  1092.      $                           SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA,
  1093.      $                           LDA, LDB
  1094.                               IF( REWI )
  1095.      $                           REWIND NTRA
  1096.                               CALL ZTRSM( SIDE, UPLO, TRANSA, DIAG, M,
  1097.      $                                    N, ALPHA, AA, LDA, BB, LDB )
  1098.                            END IF
  1099. *
  1100. *                          Check if error-exit was taken incorrectly.
  1101. *
  1102.                            IF( .NOT.OK )THEN
  1103.                               WRITE( NOUT, FMT = 9994 )
  1104.                               FATAL = .TRUE.
  1105.                               GO TO 150
  1106.                            END IF
  1107. *
  1108. *                          See what data changed inside subroutines.
  1109. *
  1110.                            ISAME( 1 ) = SIDES.EQ.SIDE
  1111.                            ISAME( 2 ) = UPLOS.EQ.UPLO
  1112.                            ISAME( 3 ) = TRANAS.EQ.TRANSA
  1113.                            ISAME( 4 ) = DIAGS.EQ.DIAG
  1114.                            ISAME( 5 ) = MS.EQ.M
  1115.                            ISAME( 6 ) = NS.EQ.N
  1116.                            ISAME( 7 ) = ALS.EQ.ALPHA
  1117.                            ISAME( 8 ) = LZE( AS, AA, LAA )
  1118.                            ISAME( 9 ) = LDAS.EQ.LDA
  1119.                            IF( NULL )THEN
  1120.                               ISAME( 10 ) = LZE( BS, BB, LBB )
  1121.                            ELSE
  1122.                               ISAME( 10 ) = LZERES( 'GE', ' ', M, N, BS,
  1123.      $                                      BB, LDB )
  1124.                            END IF
  1125.                            ISAME( 11 ) = LDBS.EQ.LDB
  1126. *
  1127. *                          If data was incorrectly changed, report and
  1128. *                          return.
  1129. *
  1130.                            SAME = .TRUE.
  1131.                            DO 50 I = 1, NARGS
  1132.                               SAME = SAME.AND.ISAME( I )
  1133.                               IF( .NOT.ISAME( I ) )
  1134.      $                           WRITE( NOUT, FMT = 9998 )I
  1135.    50                      CONTINUE
  1136.                            IF( .NOT.SAME )THEN
  1137.                               FATAL = .TRUE.
  1138.                               GO TO 150
  1139.                            END IF
  1140. *
  1141.                            IF( .NOT.NULL )THEN
  1142.                               IF( SNAME( 4: 5 ).EQ.'MM' )THEN
  1143. *
  1144. *                                Check the result.
  1145. *
  1146.                                  IF( LEFT )THEN
  1147.                                     CALL ZMMCH( TRANSA, 'N', M, N, M,
  1148.      $                                          ALPHA, A, NMAX, B, NMAX,
  1149.      $                                          ZERO, C, NMAX, CT, G,
  1150.      $                                          BB, LDB, EPS, ERR,
  1151.      $                                          FATAL, NOUT, .TRUE. )
  1152.                                  ELSE
  1153.                                     CALL ZMMCH( 'N', TRANSA, M, N, N,
  1154.      $                                          ALPHA, B, NMAX, A, NMAX,
  1155.      $                                          ZERO, C, NMAX, CT, G,
  1156.      $                                          BB, LDB, EPS, ERR,
  1157.      $                                          FATAL, NOUT, .TRUE. )
  1158.                                  END IF
  1159.                               ELSE IF( SNAME( 4: 5 ).EQ.'SM' )THEN
  1160. *
  1161. *                                Compute approximation to original
  1162. *                                matrix.
  1163. *
  1164.                                  DO 70 J = 1, N
  1165.                                     DO 60 I = 1, M
  1166.                                        C( I, J ) = BB( I + ( J - 1 )*
  1167.      $                                             LDB )
  1168.                                        BB( I + ( J - 1 )*LDB ) = ALPHA*
  1169.      $                                    B( I, J )
  1170.    60                               CONTINUE
  1171.    70                            CONTINUE
  1172. *
  1173.                                  IF( LEFT )THEN
  1174.                                     CALL ZMMCH( TRANSA, 'N', M, N, M,
  1175.      $                                          ONE, A, NMAX, C, NMAX,
  1176.      $                                          ZERO, B, NMAX, CT, G,
  1177.      $                                          BB, LDB, EPS, ERR,
  1178.      $                                          FATAL, NOUT, .FALSE. )
  1179.                                  ELSE
  1180.                                     CALL ZMMCH( 'N', TRANSA, M, N, N,
  1181.      $                                          ONE, C, NMAX, A, NMAX,
  1182.      $                                          ZERO, B, NMAX, CT, G,
  1183.      $                                          BB, LDB, EPS, ERR,
  1184.      $                                          FATAL, NOUT, .FALSE. )
  1185.                                  END IF
  1186.                               END IF
  1187.                               ERRMAX = MAX( ERRMAX, ERR )
  1188. *                             If got really bad answer, report and
  1189. *                             return.
  1190.                               IF( FATAL )
  1191.      $                           GO TO 150
  1192.                            END IF
  1193. *
  1194.    80                   CONTINUE
  1195. *
  1196.    90                CONTINUE
  1197. *
  1198.   100             CONTINUE
  1199. *
  1200.   110          CONTINUE
  1201. *
  1202.   120       CONTINUE
  1203. *
  1204.   130    CONTINUE
  1205. *
  1206.   140 CONTINUE
  1207. *
  1208. *     Report result.
  1209. *
  1210.       IF( ERRMAX.LT.THRESH )THEN
  1211.          WRITE( NOUT, FMT = 9999 )SNAME, NC
  1212.       ELSE
  1213.          WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
  1214.       END IF
  1215.       GO TO 160
  1216. *
  1217.   150 CONTINUE
  1218.       WRITE( NOUT, FMT = 9996 )SNAME
  1219.       WRITE( NOUT, FMT = 9995 )NC, SNAME, SIDE, UPLO, TRANSA, DIAG, M,
  1220.      $   N, ALPHA, LDA, LDB
  1221. *
  1222.   160 CONTINUE
  1223.       RETURN
  1224. *
  1225.  9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
  1226.      $      'S)' )
  1227.  9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
  1228.      $      'ANGED INCORRECTLY *******' )
  1229.  9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
  1230.      $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
  1231.      $      ' - SUSPECT *******' )
  1232.  9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
  1233.  9995 FORMAT( 1X, I6, ': ', A6, '(', 4( '''', A1, ''',' ), 2( I3, ',' ),
  1234.      $      '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ')         ',
  1235.      $      '      .' )
  1236.  9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
  1237.      $      '******' )
  1238. *
  1239. *     End of ZCHK3.
  1240. *
  1241.       END
  1242.       SUBROUTINE ZCHK4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
  1243.      $                  FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
  1244.      $                  A, AA, AS, B, BB, BS, C, CC, CS, CT, G )
  1245. *
  1246. *  Tests ZHERK and ZSYRK.
  1247. *
  1248. *  Auxiliary routine for test program for Level 3 Blas.
  1249. *
  1250. *  -- Written on 8-February-1989.
  1251. *     Jack Dongarra, Argonne National Laboratory.
  1252. *     Iain Duff, AERE Harwell.
  1253. *     Jeremy Du Croz, Numerical Algorithms Group Ltd.
  1254. *     Sven Hammarling, Numerical Algorithms Group Ltd.
  1255. *
  1256. *     .. Parameters ..
  1257.       COMPLEX*16         ZERO
  1258.       PARAMETER          ( ZERO = ( 0.0D0, 0.0D0 ) )
  1259.       DOUBLE PRECISION   RONE, RZERO
  1260.       PARAMETER          ( RONE = 1.0D0, RZERO = 0.0D0 )
  1261. *     .. Scalar Arguments ..
  1262.       DOUBLE PRECISION   EPS, THRESH
  1263.       INTEGER            NALF, NBET, NIDIM, NMAX, NOUT, NTRA
  1264.       LOGICAL            FATAL, REWI, TRACE
  1265.       CHARACTER*6        SNAME
  1266. *     .. Array Arguments ..
  1267.       COMPLEX*16         A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
  1268.      $                   AS( NMAX*NMAX ), B( NMAX, NMAX ),
  1269.      $                   BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ),
  1270.      $                   C( NMAX, NMAX ), CC( NMAX*NMAX ),
  1271.      $                   CS( NMAX*NMAX ), CT( NMAX )
  1272.       DOUBLE PRECISION   G( NMAX )
  1273.       INTEGER            IDIM( NIDIM )
  1274. *     .. Local Scalars ..
  1275.       COMPLEX*16         ALPHA, ALS, BETA, BETS
  1276.       DOUBLE PRECISION   ERR, ERRMAX, RALPHA, RALS, RBETA, RBETS
  1277.       INTEGER            I, IA, IB, ICT, ICU, IK, IN, J, JC, JJ, K, KS,
  1278.      $                   LAA, LCC, LDA, LDAS, LDC, LDCS, LJ, MA, N, NA,
  1279.      $                   NARGS, NC, NS
  1280.       LOGICAL            CONJ, NULL, RESET, SAME, TRAN, UPPER
  1281.       CHARACTER*1        TRANS, TRANSS, TRANST, UPLO, UPLOS
  1282.       CHARACTER*2        ICHT, ICHU
  1283. *     .. Local Arrays ..
  1284.       LOGICAL            ISAME( 13 )
  1285. *     .. External Functions ..
  1286.       LOGICAL            LZE, LZERES
  1287.       EXTERNAL           LZE, LZERES
  1288. *     .. External Subroutines ..
  1289.       EXTERNAL           ZHERK, ZMAKE, ZMMCH, ZSYRK
  1290. *     .. Intrinsic Functions ..
  1291.       INTRINSIC          DCMPLX, MAX, DBLE
  1292. *     .. Scalars in Common ..
  1293.       INTEGER            INFOT, NOUTC
  1294.       LOGICAL            LERR, OK
  1295. *     .. Common blocks ..
  1296.       COMMON             /INFOC/INFOT, NOUTC, OK, LERR
  1297. *     .. Data statements ..
  1298.       DATA               ICHT/'NC'/, ICHU/'UL'/
  1299. *     .. Executable Statements ..
  1300.       CONJ = SNAME( 2: 3 ).EQ.'HE'
  1301. *
  1302.       NARGS = 10
  1303.       NC = 0
  1304.       RESET = .TRUE.
  1305.       ERRMAX = RZERO
  1306. *
  1307.       DO 100 IN = 1, NIDIM
  1308.          N = IDIM( IN )
  1309. *        Set LDC to 1 more than minimum value if room.
  1310.          LDC = N
  1311.          IF( LDC.LT.NMAX )
  1312.      $      LDC = LDC + 1
  1313. *        Skip tests if not enough room.
  1314.          IF( LDC.GT.NMAX )
  1315.      $      GO TO 100
  1316.          LCC = LDC*N
  1317. *
  1318.          DO 90 IK = 1, NIDIM
  1319.             K = IDIM( IK )
  1320. *
  1321.             DO 80 ICT = 1, 2
  1322.                TRANS = ICHT( ICT: ICT )
  1323.                TRAN = TRANS.EQ.'C'
  1324.                IF( TRAN.AND..NOT.CONJ )
  1325.      $            TRANS = 'T'
  1326.                IF( TRAN )THEN
  1327.                   MA = K
  1328.                   NA = N
  1329.                ELSE
  1330.                   MA = N
  1331.                   NA = K
  1332.                END IF
  1333. *              Set LDA to 1 more than minimum value if room.
  1334.                LDA = MA
  1335.                IF( LDA.LT.NMAX )
  1336.      $            LDA = LDA + 1
  1337. *              Skip tests if not enough room.
  1338.                IF( LDA.GT.NMAX )
  1339.      $            GO TO 80
  1340.                LAA = LDA*NA
  1341. *
  1342. *              Generate the matrix A.
  1343. *
  1344.                CALL ZMAKE( 'GE', ' ', ' ', MA, NA, A, NMAX, AA, LDA,
  1345.      $                     RESET, ZERO )
  1346. *
  1347.                DO 70 ICU = 1, 2
  1348.                   UPLO = ICHU( ICU: ICU )
  1349.                   UPPER = UPLO.EQ.'U'
  1350. *
  1351.                   DO 60 IA = 1, NALF
  1352.                      ALPHA = ALF( IA )
  1353.                      IF( CONJ )THEN
  1354.                         RALPHA = DBLE( ALPHA )
  1355.                         ALPHA = DCMPLX( RALPHA, RZERO )
  1356.                      END IF
  1357. *
  1358.                      DO 50 IB = 1, NBET
  1359.                         BETA = BET( IB )
  1360.                         IF( CONJ )THEN
  1361.                            RBETA = DBLE( BETA )
  1362.                            BETA = DCMPLX( RBETA, RZERO )
  1363.                         END IF
  1364.                         NULL = N.LE.0
  1365.                         IF( CONJ )
  1366.      $                     NULL = NULL.OR.( ( K.LE.0.OR.RALPHA.EQ.
  1367.      $                            RZERO ).AND.RBETA.EQ.RONE )
  1368. *
  1369. *                       Generate the matrix C.
  1370. *
  1371.                         CALL ZMAKE( SNAME( 2: 3 ), UPLO, ' ', N, N, C,
  1372.      $                              NMAX, CC, LDC, RESET, ZERO )
  1373. *
  1374.                         NC = NC + 1
  1375. *
  1376. *                       Save every datum before calling the subroutine.
  1377. *
  1378.                         UPLOS = UPLO
  1379.                         TRANSS = TRANS
  1380.                         NS = N
  1381.                         KS = K
  1382.                         IF( CONJ )THEN
  1383.                            RALS = RALPHA
  1384.                         ELSE
  1385.                            ALS = ALPHA
  1386.                         END IF
  1387.                         DO 10 I = 1, LAA
  1388.                            AS( I ) = AA( I )
  1389.    10                   CONTINUE
  1390.                         LDAS = LDA
  1391.                         IF( CONJ )THEN
  1392.                            RBETS = RBETA
  1393.                         ELSE
  1394.                            BETS = BETA
  1395.                         END IF
  1396.                         DO 20 I = 1, LCC
  1397.                            CS( I ) = CC( I )
  1398.    20                   CONTINUE
  1399.                         LDCS = LDC
  1400. *
  1401. *                       Call the subroutine.
  1402. *
  1403.                         IF( CONJ )THEN
  1404.                            IF( TRACE )
  1405.      $                        WRITE( NTRA, FMT = 9994 )NC, SNAME, UPLO,
  1406.      $                        TRANS, N, K, RALPHA, LDA, RBETA, LDC
  1407.                            IF( REWI )
  1408.      $                        REWIND NTRA
  1409.                            CALL ZHERK( UPLO, TRANS, N, K, RALPHA, AA,
  1410.      $                                 LDA, RBETA, CC, LDC )
  1411.                         ELSE
  1412.                            IF( TRACE )
  1413.      $                        WRITE( NTRA, FMT = 9993 )NC, SNAME, UPLO,
  1414.      $                        TRANS, N, K, ALPHA, LDA, BETA, LDC
  1415.                            IF( REWI )
  1416.      $                        REWIND NTRA
  1417.                            CALL ZSYRK( UPLO, TRANS, N, K, ALPHA, AA,
  1418.      $                                 LDA, BETA, CC, LDC )
  1419.                         END IF
  1420. *
  1421. *                       Check if error-exit was taken incorrectly.
  1422. *
  1423.                         IF( .NOT.OK )THEN
  1424.                            WRITE( NOUT, FMT = 9992 )
  1425.                            FATAL = .TRUE.
  1426.                            GO TO 120
  1427.                         END IF
  1428. *
  1429. *                       See what data changed inside subroutines.
  1430. *
  1431.                         ISAME( 1 ) = UPLOS.EQ.UPLO
  1432.                         ISAME( 2 ) = TRANSS.EQ.TRANS
  1433.                         ISAME( 3 ) = NS.EQ.N
  1434.                         ISAME( 4 ) = KS.EQ.K
  1435.                         IF( CONJ )THEN
  1436.                            ISAME( 5 ) = RALS.EQ.RALPHA
  1437.                         ELSE
  1438.                            ISAME( 5 ) = ALS.EQ.ALPHA
  1439.                         END IF
  1440.                         ISAME( 6 ) = LZE( AS, AA, LAA )
  1441.                         ISAME( 7 ) = LDAS.EQ.LDA
  1442.                         IF( CONJ )THEN
  1443.                            ISAME( 8 ) = RBETS.EQ.RBETA
  1444.                         ELSE
  1445.                            ISAME( 8 ) = BETS.EQ.BETA
  1446.                         END IF
  1447.                         IF( NULL )THEN
  1448.                            ISAME( 9 ) = LZE( CS, CC, LCC )
  1449.                         ELSE
  1450.                            ISAME( 9 ) = LZERES( SNAME( 2: 3 ), UPLO, N,
  1451.      $                                  N, CS, CC, LDC )
  1452.                         END IF
  1453.                         ISAME( 10 ) = LDCS.EQ.LDC
  1454. *
  1455. *                       If data was incorrectly changed, report and
  1456. *                       return.
  1457. *
  1458.                         SAME = .TRUE.
  1459.                         DO 30 I = 1, NARGS
  1460.                            SAME = SAME.AND.ISAME( I )
  1461.                            IF( .NOT.ISAME( I ) )
  1462.      $                        WRITE( NOUT, FMT = 9998 )I
  1463.    30                   CONTINUE
  1464.                         IF( .NOT.SAME )THEN
  1465.                            FATAL = .TRUE.
  1466.                            GO TO 120
  1467.                         END IF
  1468. *
  1469.                         IF( .NOT.NULL )THEN
  1470. *
  1471. *                          Check the result column by column.
  1472. *
  1473.                            IF( CONJ )THEN
  1474.                               TRANST = 'C'
  1475.                            ELSE
  1476.                               TRANST = 'T'
  1477.                            END IF
  1478.                            JC = 1
  1479.                            DO 40 J = 1, N
  1480.                               IF( UPPER )THEN
  1481.                                  JJ = 1
  1482.                                  LJ = J
  1483.                               ELSE
  1484.                                  JJ = J
  1485.                                  LJ = N - J + 1
  1486.                               END IF
  1487.                               IF( TRAN )THEN
  1488.                                  CALL ZMMCH( TRANST, 'N', LJ, 1, K,
  1489.      $                                       ALPHA, A( 1, JJ ), NMAX,
  1490.      $                                       A( 1, J ), NMAX, BETA,
  1491.      $                                       C( JJ, J ), NMAX, CT, G,
  1492.      $                                       CC( JC ), LDC, EPS, ERR,
  1493.      $                                       FATAL, NOUT, .TRUE. )
  1494.                               ELSE
  1495.                                  CALL ZMMCH( 'N', TRANST, LJ, 1, K,
  1496.      $                                       ALPHA, A( JJ, 1 ), NMAX,
  1497.      $                                       A( J, 1 ), NMAX, BETA,
  1498.      $                                       C( JJ, J ), NMAX, CT, G,
  1499.      $                                       CC( JC ), LDC, EPS, ERR,
  1500.      $                                       FATAL, NOUT, .TRUE. )
  1501.                               END IF
  1502.                               IF( UPPER )THEN
  1503.                                  JC = JC + LDC
  1504.                               ELSE
  1505.                                  JC = JC + LDC + 1
  1506.                               END IF
  1507.                               ERRMAX = MAX( ERRMAX, ERR )
  1508. *                             If got really bad answer, report and
  1509. *                             return.
  1510.                               IF( FATAL )
  1511.      $                           GO TO 110
  1512.    40                      CONTINUE
  1513.                         END IF
  1514. *
  1515.    50                CONTINUE
  1516. *
  1517.    60             CONTINUE
  1518. *
  1519.    70          CONTINUE
  1520. *
  1521.    80       CONTINUE
  1522. *
  1523.    90    CONTINUE
  1524. *
  1525.   100 CONTINUE
  1526. *
  1527. *     Report result.
  1528. *
  1529.       IF( ERRMAX.LT.THRESH )THEN
  1530.          WRITE( NOUT, FMT = 9999 )SNAME, NC
  1531.       ELSE
  1532.          WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
  1533.       END IF
  1534.       GO TO 130
  1535. *
  1536.   110 CONTINUE
  1537.       IF( N.GT.1 )
  1538.      $   WRITE( NOUT, FMT = 9995 )J
  1539. *
  1540.   120 CONTINUE
  1541.       WRITE( NOUT, FMT = 9996 )SNAME
  1542.       IF( CONJ )THEN
  1543.          WRITE( NOUT, FMT = 9994 )NC, SNAME, UPLO, TRANS, N, K, RALPHA,
  1544.      $      LDA, RBETA, LDC
  1545.       ELSE
  1546.          WRITE( NOUT, FMT = 9993 )NC, SNAME, UPLO, TRANS, N, K, ALPHA,
  1547.      $      LDA, BETA, LDC
  1548.       END IF
  1549. *
  1550.   130 CONTINUE
  1551.       RETURN
  1552. *
  1553.  9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
  1554.      $      'S)' )
  1555.  9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
  1556.      $      'ANGED INCORRECTLY *******' )
  1557.  9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
  1558.      $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
  1559.      $      ' - SUSPECT *******' )
  1560.  9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
  1561.  9995 FORMAT( '      THESE ARE THE RESULTS FOR COLUMN ', I3 )
  1562.  9994 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
  1563.      $      F4.1, ', A,', I3, ',', F4.1, ', C,', I3, ')               ',
  1564.      $      '          .' )
  1565.  9993 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
  1566.      $      '(', F4.1, ',', F4.1, ') , A,', I3, ',(', F4.1, ',', F4.1,
  1567.      $      '), C,', I3, ')          .' )
  1568.  9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
  1569.      $      '******' )
  1570. *
  1571. *     End of ZCHK4.
  1572. *
  1573.       END
  1574.       SUBROUTINE ZCHK5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
  1575.      $                  FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
  1576.      $                  AB, AA, AS, BB, BS, C, CC, CS, CT, G, W )
  1577. *
  1578. *  Tests ZHER2K and ZSYR2K.
  1579. *
  1580. *  Auxiliary routine for test program for Level 3 Blas.
  1581. *
  1582. *  -- Written on 8-February-1989.
  1583. *     Jack Dongarra, Argonne National Laboratory.
  1584. *     Iain Duff, AERE Harwell.
  1585. *     Jeremy Du Croz, Numerical Algorithms Group Ltd.
  1586. *     Sven Hammarling, Numerical Algorithms Group Ltd.
  1587. *
  1588. *     .. Parameters ..
  1589.       COMPLEX*16         ZERO, ONE
  1590.       PARAMETER          ( ZERO = ( 0.0D0, 0.0D0 ),
  1591.      $                   ONE = ( 1.0D0, 0.0D0 ) )
  1592.       DOUBLE PRECISION   RONE, RZERO
  1593.       PARAMETER          ( RONE = 1.0D0, RZERO = 0.0D0 )
  1594. *     .. Scalar Arguments ..
  1595.       DOUBLE PRECISION   EPS, THRESH
  1596.       INTEGER            NALF, NBET, NIDIM, NMAX, NOUT, NTRA
  1597.       LOGICAL            FATAL, REWI, TRACE
  1598.       CHARACTER*6        SNAME
  1599. *     .. Array Arguments ..
  1600.       COMPLEX*16         AA( NMAX*NMAX ), AB( 2*NMAX*NMAX ),
  1601.      $                   ALF( NALF ), AS( NMAX*NMAX ), BB( NMAX*NMAX ),
  1602.      $                   BET( NBET ), BS( NMAX*NMAX ), C( NMAX, NMAX ),
  1603.      $                   CC( NMAX*NMAX ), CS( NMAX*NMAX ), CT( NMAX ),
  1604.      $                   W( 2*NMAX )
  1605.       DOUBLE PRECISION   G( NMAX )
  1606.       INTEGER            IDIM( NIDIM )
  1607. *     .. Local Scalars ..
  1608.       COMPLEX*16         ALPHA, ALS, BETA, BETS
  1609.       DOUBLE PRECISION   ERR, ERRMAX, RBETA, RBETS
  1610.       INTEGER            I, IA, IB, ICT, ICU, IK, IN, J, JC, JJ, JJAB,
  1611.      $                   K, KS, LAA, LBB, LCC, LDA, LDAS, LDB, LDBS,
  1612.      $                   LDC, LDCS, LJ, MA, N, NA, NARGS, NC, NS
  1613.       LOGICAL            CONJ, NULL, RESET, SAME, TRAN, UPPER
  1614.       CHARACTER*1        TRANS, TRANSS, TRANST, UPLO, UPLOS
  1615.       CHARACTER*2        ICHT, ICHU
  1616. *     .. Local Arrays ..
  1617.       LOGICAL            ISAME( 13 )
  1618. *     .. External Functions ..
  1619.       LOGICAL            LZE, LZERES
  1620.       EXTERNAL           LZE, LZERES
  1621. *     .. External Subroutines ..
  1622.       EXTERNAL           ZHER2K, ZMAKE, ZMMCH, ZSYR2K
  1623. *     .. Intrinsic Functions ..
  1624.       INTRINSIC          DCMPLX, DCONJG, MAX, DBLE
  1625. *     .. Scalars in Common ..
  1626.       INTEGER            INFOT, NOUTC
  1627.       LOGICAL            LERR, OK
  1628. *     .. Common blocks ..
  1629.       COMMON             /INFOC/INFOT, NOUTC, OK, LERR
  1630. *     .. Data statements ..
  1631.       DATA               ICHT/'NC'/, ICHU/'UL'/
  1632. *     .. Executable Statements ..
  1633.       CONJ = SNAME( 2: 3 ).EQ.'HE'
  1634. *
  1635.       NARGS = 12
  1636.       NC = 0
  1637.       RESET = .TRUE.
  1638.       ERRMAX = RZERO
  1639. *
  1640.       DO 130 IN = 1, NIDIM
  1641.          N = IDIM( IN )
  1642. *        Set LDC to 1 more than minimum value if room.
  1643.          LDC = N
  1644.          IF( LDC.LT.NMAX )
  1645.      $      LDC = LDC + 1
  1646. *        Skip tests if not enough room.
  1647.          IF( LDC.GT.NMAX )
  1648.      $      GO TO 130
  1649.          LCC = LDC*N
  1650. *
  1651.          DO 120 IK = 1, NIDIM
  1652.             K = IDIM( IK )
  1653. *
  1654.             DO 110 ICT = 1, 2
  1655.                TRANS = ICHT( ICT: ICT )
  1656.                TRAN = TRANS.EQ.'C'
  1657.                IF( TRAN.AND..NOT.CONJ )
  1658.      $            TRANS = 'T'
  1659.                IF( TRAN )THEN
  1660.                   MA = K
  1661.                   NA = N
  1662.                ELSE
  1663.                   MA = N
  1664.                   NA = K
  1665.                END IF
  1666. *              Set LDA to 1 more than minimum value if room.
  1667.                LDA = MA
  1668.                IF( LDA.LT.NMAX )
  1669.      $            LDA = LDA + 1
  1670. *              Skip tests if not enough room.
  1671.                IF( LDA.GT.NMAX )
  1672.      $            GO TO 110
  1673.                LAA = LDA*NA
  1674. *
  1675. *              Generate the matrix A.
  1676. *
  1677.                IF( TRAN )THEN
  1678.                   CALL ZMAKE( 'GE', ' ', ' ', MA, NA, AB, 2*NMAX, AA,
  1679.      $                        LDA, RESET, ZERO )
  1680.                ELSE
  1681.                   CALL ZMAKE( 'GE', ' ', ' ', MA, NA, AB, NMAX, AA, LDA,
  1682.      $                        RESET, ZERO )
  1683.                END IF
  1684. *
  1685. *              Generate the matrix B.
  1686. *
  1687.                LDB = LDA
  1688.                LBB = LAA
  1689.                IF( TRAN )THEN
  1690.                   CALL ZMAKE( 'GE', ' ', ' ', MA, NA, AB( K + 1 ),
  1691.      $                        2*NMAX, BB, LDB, RESET, ZERO )
  1692.                ELSE
  1693.                   CALL ZMAKE( 'GE', ' ', ' ', MA, NA, AB( K*NMAX + 1 ),
  1694.      $                        NMAX, BB, LDB, RESET, ZERO )
  1695.                END IF
  1696. *
  1697.                DO 100 ICU = 1, 2
  1698.                   UPLO = ICHU( ICU: ICU )
  1699.                   UPPER = UPLO.EQ.'U'
  1700. *
  1701.                   DO 90 IA = 1, NALF
  1702.                      ALPHA = ALF( IA )
  1703. *
  1704.                      DO 80 IB = 1, NBET
  1705.                         BETA = BET( IB )
  1706.                         IF( CONJ )THEN
  1707.                            RBETA = DBLE( BETA )
  1708.                            BETA = DCMPLX( RBETA, RZERO )
  1709.                         END IF
  1710.                         NULL = N.LE.0
  1711.                         IF( CONJ )
  1712.      $                     NULL = NULL.OR.( ( K.LE.0.OR.ALPHA.EQ.
  1713.      $                            ZERO ).AND.RBETA.EQ.RONE )
  1714. *
  1715. *                       Generate the matrix C.
  1716. *
  1717.                         CALL ZMAKE( SNAME( 2: 3 ), UPLO, ' ', N, N, C,
  1718.      $                              NMAX, CC, LDC, RESET, ZERO )
  1719. *
  1720.                         NC = NC + 1
  1721. *
  1722. *                       Save every datum before calling the subroutine.
  1723. *
  1724.                         UPLOS = UPLO
  1725.                         TRANSS = TRANS
  1726.                         NS = N
  1727.                         KS = K
  1728.                         ALS = ALPHA
  1729.                         DO 10 I = 1, LAA
  1730.                            AS( I ) = AA( I )
  1731.    10                   CONTINUE
  1732.                         LDAS = LDA
  1733.                         DO 20 I = 1, LBB
  1734.                            BS( I ) = BB( I )
  1735.    20                   CONTINUE
  1736.                         LDBS = LDB
  1737.                         IF( CONJ )THEN
  1738.                            RBETS = RBETA
  1739.                         ELSE
  1740.                            BETS = BETA
  1741.                         END IF
  1742.                         DO 30 I = 1, LCC
  1743.                            CS( I ) = CC( I )
  1744.    30                   CONTINUE
  1745.                         LDCS = LDC
  1746. *
  1747. *                       Call the subroutine.
  1748. *
  1749.                         IF( CONJ )THEN
  1750.                            IF( TRACE )
  1751.      $                        WRITE( NTRA, FMT = 9994 )NC, SNAME, UPLO,
  1752.      $                        TRANS, N, K, ALPHA, LDA, LDB, RBETA, LDC
  1753.                            IF( REWI )
  1754.      $                        REWIND NTRA
  1755.                            CALL ZHER2K( UPLO, TRANS, N, K, ALPHA, AA,
  1756.      $                                  LDA, BB, LDB, RBETA, CC, LDC )
  1757.                         ELSE
  1758.                            IF( TRACE )
  1759.      $                        WRITE( NTRA, FMT = 9993 )NC, SNAME, UPLO,
  1760.      $                        TRANS, N, K, ALPHA, LDA, LDB, BETA, LDC
  1761.                            IF( REWI )
  1762.      $                        REWIND NTRA
  1763.                            CALL ZSYR2K( UPLO, TRANS, N, K, ALPHA, AA,
  1764.      $                                  LDA, BB, LDB, BETA, CC, LDC )
  1765.                         END IF
  1766. *
  1767. *                       Check if error-exit was taken incorrectly.
  1768. *
  1769.                         IF( .NOT.OK )THEN
  1770.                            WRITE( NOUT, FMT = 9992 )
  1771.                            FATAL = .TRUE.
  1772.                            GO TO 150
  1773.                         END IF
  1774. *
  1775. *                       See what data changed inside subroutines.
  1776. *
  1777.                         ISAME( 1 ) = UPLOS.EQ.UPLO
  1778.                         ISAME( 2 ) = TRANSS.EQ.TRANS
  1779.                         ISAME( 3 ) = NS.EQ.N
  1780.                         ISAME( 4 ) = KS.EQ.K
  1781.                         ISAME( 5 ) = ALS.EQ.ALPHA
  1782.                         ISAME( 6 ) = LZE( AS, AA, LAA )
  1783.                         ISAME( 7 ) = LDAS.EQ.LDA
  1784.                         ISAME( 8 ) = LZE( BS, BB, LBB )
  1785.                         ISAME( 9 ) = LDBS.EQ.LDB
  1786.                         IF( CONJ )THEN
  1787.                            ISAME( 10 ) = RBETS.EQ.RBETA
  1788.                         ELSE
  1789.                            ISAME( 10 ) = BETS.EQ.BETA
  1790.                         END IF
  1791.                         IF( NULL )THEN
  1792.                            ISAME( 11 ) = LZE( CS, CC, LCC )
  1793.                         ELSE
  1794.                            ISAME( 11 ) = LZERES( 'HE', UPLO, N, N, CS,
  1795.      $                                   CC, LDC )
  1796.                         END IF
  1797.                         ISAME( 12 ) = LDCS.EQ.LDC
  1798. *
  1799. *                       If data was incorrectly changed, report and
  1800. *                       return.
  1801. *
  1802.                         SAME = .TRUE.
  1803.                         DO 40 I = 1, NARGS
  1804.                            SAME = SAME.AND.ISAME( I )
  1805.                            IF( .NOT.ISAME( I ) )
  1806.      $                        WRITE( NOUT, FMT = 9998 )I
  1807.    40                   CONTINUE
  1808.                         IF( .NOT.SAME )THEN
  1809.                            FATAL = .TRUE.
  1810.                            GO TO 150
  1811.                         END IF
  1812. *
  1813.                         IF( .NOT.NULL )THEN
  1814. *
  1815. *                          Check the result column by column.
  1816. *
  1817.                            IF( CONJ )THEN
  1818.                               TRANST = 'C'
  1819.                            ELSE
  1820.                               TRANST = 'T'
  1821.                            END IF
  1822.                            JJAB = 1
  1823.                            JC = 1
  1824.                            DO 70 J = 1, N
  1825.                               IF( UPPER )THEN
  1826.                                  JJ = 1
  1827.                                  LJ = J
  1828.                               ELSE
  1829.                                  JJ = J
  1830.                                  LJ = N - J + 1
  1831.                               END IF
  1832.                               IF( TRAN )THEN
  1833.                                  DO 50 I = 1, K
  1834.                                     W( I ) = ALPHA*AB( ( J - 1 )*2*
  1835.      $                                       NMAX + K + I )
  1836.                                     IF( CONJ )THEN
  1837.                                        W( K + I ) = DCONJG( ALPHA )*
  1838.      $                                              AB( ( J - 1 )*2*
  1839.      $                                              NMAX + I )
  1840.                                     ELSE
  1841.                                        W( K + I ) = ALPHA*
  1842.      $                                              AB( ( J - 1 )*2*
  1843.      $                                              NMAX + I )
  1844.                                     END IF
  1845.    50                            CONTINUE
  1846.                                  CALL ZMMCH( TRANST, 'N', LJ, 1, 2*K,
  1847.      $                                       ONE, AB( JJAB ), 2*NMAX, W,
  1848.      $                                       2*NMAX, BETA, C( JJ, J ),
  1849.      $                                       NMAX, CT, G, CC( JC ), LDC,
  1850.      $                                       EPS, ERR, FATAL, NOUT,
  1851.      $                                       .TRUE. )
  1852.                               ELSE
  1853.                                  DO 60 I = 1, K
  1854.                                     IF( CONJ )THEN
  1855.                                        W( I ) = ALPHA*DCONJG( AB( ( K +
  1856.      $                                          I - 1 )*NMAX + J ) )
  1857.                                        W( K + I ) = DCONJG( ALPHA*
  1858.      $                                              AB( ( I - 1 )*NMAX +
  1859.      $                                              J ) )
  1860.                                     ELSE
  1861.                                        W( I ) = ALPHA*AB( ( K + I - 1 )*
  1862.      $                                          NMAX + J )
  1863.                                        W( K + I ) = ALPHA*
  1864.      $                                              AB( ( I - 1 )*NMAX +
  1865.      $                                              J )
  1866.                                     END IF
  1867.    60                            CONTINUE
  1868.                                  CALL ZMMCH( 'N', 'N', LJ, 1, 2*K, ONE,
  1869.      $                                       AB( JJ ), NMAX, W, 2*NMAX,
  1870.      $                                       BETA, C( JJ, J ), NMAX, CT,
  1871.      $                                       G, CC( JC ), LDC, EPS, ERR,
  1872.      $                                       FATAL, NOUT, .TRUE. )
  1873.                               END IF
  1874.                               IF( UPPER )THEN
  1875.                                  JC = JC + LDC
  1876.                               ELSE
  1877.                                  JC = JC + LDC + 1
  1878.                                  IF( TRAN )
  1879.      $                              JJAB = JJAB + 2*NMAX
  1880.                               END IF
  1881.                               ERRMAX = MAX( ERRMAX, ERR )
  1882. *                             If got really bad answer, report and
  1883. *                             return.
  1884.                               IF( FATAL )
  1885.      $                           GO TO 140
  1886.    70                      CONTINUE
  1887.                         END IF
  1888. *
  1889.    80                CONTINUE
  1890. *
  1891.    90             CONTINUE
  1892. *
  1893.   100          CONTINUE
  1894. *
  1895.   110       CONTINUE
  1896. *
  1897.   120    CONTINUE
  1898. *
  1899.   130 CONTINUE
  1900. *
  1901. *     Report result.
  1902. *
  1903.       IF( ERRMAX.LT.THRESH )THEN
  1904.          WRITE( NOUT, FMT = 9999 )SNAME, NC
  1905.       ELSE
  1906.          WRITE( NOUT, FMT = 9997 )SNAME, NC, ERRMAX
  1907.       END IF
  1908.       GO TO 160
  1909. *
  1910.   140 CONTINUE
  1911.       IF( N.GT.1 )
  1912.      $   WRITE( NOUT, FMT = 9995 )J
  1913. *
  1914.   150 CONTINUE
  1915.       WRITE( NOUT, FMT = 9996 )SNAME
  1916.       IF( CONJ )THEN
  1917.          WRITE( NOUT, FMT = 9994 )NC, SNAME, UPLO, TRANS, N, K, ALPHA,
  1918.      $      LDA, LDB, RBETA, LDC
  1919.       ELSE
  1920.          WRITE( NOUT, FMT = 9993 )NC, SNAME, UPLO, TRANS, N, K, ALPHA,
  1921.      $      LDA, LDB, BETA, LDC
  1922.       END IF
  1923. *
  1924.   160 CONTINUE
  1925.       RETURN
  1926. *
  1927.  9999 FORMAT( ' ', A6, ' PASSED THE COMPUTATIONAL TESTS (', I6, ' CALL',
  1928.      $      'S)' )
  1929.  9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
  1930.      $      'ANGED INCORRECTLY *******' )
  1931.  9997 FORMAT( ' ', A6, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
  1932.      $      'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
  1933.      $      ' - SUSPECT *******' )
  1934.  9996 FORMAT( ' ******* ', A6, ' FAILED ON CALL NUMBER:' )
  1935.  9995 FORMAT( '      THESE ARE THE RESULTS FOR COLUMN ', I3 )
  1936.  9994 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
  1937.      $      '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',', F4.1,
  1938.      $      ', C,', I3, ')           .' )
  1939.  9993 FORMAT( 1X, I6, ': ', A6, '(', 2( '''', A1, ''',' ), 2( I3, ',' ),
  1940.      $      '(', F4.1, ',', F4.1, '), A,', I3, ', B,', I3, ',(', F4.1,
  1941.      $      ',', F4.1, '), C,', I3, ')    .' )
  1942.  9992 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
  1943.      $      '******' )
  1944. *
  1945. *     End of ZCHK5.
  1946. *
  1947.       END
  1948.       SUBROUTINE ZCHKE( ISNUM, SRNAMT, NOUT )
  1949. *
  1950. *  Tests the error exits from the Level 3 Blas.
  1951. *  Requires a special version of the error-handling routine XERBLA.
  1952. *  ALPHA, RALPHA, BETA, RBETA, A, B and C should not need to be defined.
  1953. *
  1954. *  Auxiliary routine for test program for Level 3 Blas.
  1955. *
  1956. *  -- Written on 8-February-1989.
  1957. *     Jack Dongarra, Argonne National Laboratory.
  1958. *     Iain Duff, AERE Harwell.
  1959. *     Jeremy Du Croz, Numerical Algorithms Group Ltd.
  1960. *     Sven Hammarling, Numerical Algorithms Group Ltd.
  1961. *
  1962. *     .. Scalar Arguments ..
  1963.       INTEGER            ISNUM, NOUT
  1964.       CHARACTER*6        SRNAMT
  1965. *     .. Scalars in Common ..
  1966.       INTEGER            INFOT, NOUTC
  1967.       LOGICAL            LERR, OK
  1968. *     .. Local Scalars ..
  1969.       COMPLEX*16         ALPHA, BETA
  1970.       DOUBLE PRECISION   RALPHA, RBETA
  1971. *     .. Local Arrays ..
  1972.       COMPLEX*16         A( 2, 1 ), B( 2, 1 ), C( 2, 1 )
  1973. *     .. External Subroutines ..
  1974.       EXTERNAL           ZGEMM, ZHEMM, ZHER2K, ZHERK, CHKXER, ZSYMM,
  1975.      $                   ZSYR2K, ZSYRK, ZTRMM, ZTRSM
  1976. *     .. Common blocks ..
  1977.       COMMON             /INFOC/INFOT, NOUTC, OK, LERR
  1978. *     .. Executable Statements ..
  1979. *     OK is set to .FALSE. by the special version of XERBLA or by CHKXER
  1980. *     if anything is wrong.
  1981.       OK = .TRUE.
  1982. *     LERR is set to .TRUE. by the special version of XERBLA each time
  1983. *     it is called, and is then tested and re-set by CHKXER.
  1984.       LERR = .FALSE.
  1985.       GO TO ( 10, 20, 30, 40, 50, 60, 70, 80,
  1986.      $        90 )ISNUM
  1987.    10 INFOT = 1
  1988.       CALL ZGEMM( '/', 'N', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  1989.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  1990.       INFOT = 1
  1991.       CALL ZGEMM( '/', 'C', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  1992.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  1993.       INFOT = 1
  1994.       CALL ZGEMM( '/', 'T', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  1995.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  1996.       INFOT = 2
  1997.       CALL ZGEMM( 'N', '/', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  1998.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  1999.       INFOT = 2
  2000.       CALL ZGEMM( 'C', '/', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2001.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2002.       INFOT = 2
  2003.       CALL ZGEMM( 'T', '/', 0, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2004.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2005.       INFOT = 3
  2006.       CALL ZGEMM( 'N', 'N', -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2007.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2008.       INFOT = 3
  2009.       CALL ZGEMM( 'N', 'C', -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2010.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2011.       INFOT = 3
  2012.       CALL ZGEMM( 'N', 'T', -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2013.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2014.       INFOT = 3
  2015.       CALL ZGEMM( 'C', 'N', -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2016.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2017.       INFOT = 3
  2018.       CALL ZGEMM( 'C', 'C', -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2019.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2020.       INFOT = 3
  2021.       CALL ZGEMM( 'C', 'T', -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2022.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2023.       INFOT = 3
  2024.       CALL ZGEMM( 'T', 'N', -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2025.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2026.       INFOT = 3
  2027.       CALL ZGEMM( 'T', 'C', -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2028.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2029.       INFOT = 3
  2030.       CALL ZGEMM( 'T', 'T', -1, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2031.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2032.       INFOT = 4
  2033.       CALL ZGEMM( 'N', 'N', 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2034.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2035.       INFOT = 4
  2036.       CALL ZGEMM( 'N', 'C', 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2037.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2038.       INFOT = 4
  2039.       CALL ZGEMM( 'N', 'T', 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2040.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2041.       INFOT = 4
  2042.       CALL ZGEMM( 'C', 'N', 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2043.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2044.       INFOT = 4
  2045.       CALL ZGEMM( 'C', 'C', 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2046.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2047.       INFOT = 4
  2048.       CALL ZGEMM( 'C', 'T', 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2049.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2050.       INFOT = 4
  2051.       CALL ZGEMM( 'T', 'N', 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2052.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2053.       INFOT = 4
  2054.       CALL ZGEMM( 'T', 'C', 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2055.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2056.       INFOT = 4
  2057.       CALL ZGEMM( 'T', 'T', 0, -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2058.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2059.       INFOT = 5
  2060.       CALL ZGEMM( 'N', 'N', 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2061.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2062.       INFOT = 5
  2063.       CALL ZGEMM( 'N', 'C', 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2064.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2065.       INFOT = 5
  2066.       CALL ZGEMM( 'N', 'T', 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2067.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2068.       INFOT = 5
  2069.       CALL ZGEMM( 'C', 'N', 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2070.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2071.       INFOT = 5
  2072.       CALL ZGEMM( 'C', 'C', 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2073.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2074.       INFOT = 5
  2075.       CALL ZGEMM( 'C', 'T', 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2076.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2077.       INFOT = 5
  2078.       CALL ZGEMM( 'T', 'N', 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2079.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2080.       INFOT = 5
  2081.       CALL ZGEMM( 'T', 'C', 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2082.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2083.       INFOT = 5
  2084.       CALL ZGEMM( 'T', 'T', 0, 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2085.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2086.       INFOT = 8
  2087.       CALL ZGEMM( 'N', 'N', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
  2088.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2089.       INFOT = 8
  2090.       CALL ZGEMM( 'N', 'C', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
  2091.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2092.       INFOT = 8
  2093.       CALL ZGEMM( 'N', 'T', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
  2094.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2095.       INFOT = 8
  2096.       CALL ZGEMM( 'C', 'N', 0, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 )
  2097.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2098.       INFOT = 8
  2099.       CALL ZGEMM( 'C', 'C', 0, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2100.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2101.       INFOT = 8
  2102.       CALL ZGEMM( 'C', 'T', 0, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2103.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2104.       INFOT = 8
  2105.       CALL ZGEMM( 'T', 'N', 0, 0, 2, ALPHA, A, 1, B, 2, BETA, C, 1 )
  2106.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2107.       INFOT = 8
  2108.       CALL ZGEMM( 'T', 'C', 0, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2109.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2110.       INFOT = 8
  2111.       CALL ZGEMM( 'T', 'T', 0, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2112.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2113.       INFOT = 10
  2114.       CALL ZGEMM( 'N', 'N', 0, 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2115.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2116.       INFOT = 10
  2117.       CALL ZGEMM( 'C', 'N', 0, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 )
  2118.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2119.       INFOT = 10
  2120.       CALL ZGEMM( 'T', 'N', 0, 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 )
  2121.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2122.       INFOT = 10
  2123.       CALL ZGEMM( 'N', 'C', 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2124.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2125.       INFOT = 10
  2126.       CALL ZGEMM( 'C', 'C', 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2127.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2128.       INFOT = 10
  2129.       CALL ZGEMM( 'T', 'C', 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2130.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2131.       INFOT = 10
  2132.       CALL ZGEMM( 'N', 'T', 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2133.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2134.       INFOT = 10
  2135.       CALL ZGEMM( 'C', 'T', 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2136.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2137.       INFOT = 10
  2138.       CALL ZGEMM( 'T', 'T', 0, 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2139.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2140.       INFOT = 13
  2141.       CALL ZGEMM( 'N', 'N', 2, 0, 0, ALPHA, A, 2, B, 1, BETA, C, 1 )
  2142.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2143.       INFOT = 13
  2144.       CALL ZGEMM( 'N', 'C', 2, 0, 0, ALPHA, A, 2, B, 1, BETA, C, 1 )
  2145.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2146.       INFOT = 13
  2147.       CALL ZGEMM( 'N', 'T', 2, 0, 0, ALPHA, A, 2, B, 1, BETA, C, 1 )
  2148.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2149.       INFOT = 13
  2150.       CALL ZGEMM( 'C', 'N', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2151.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2152.       INFOT = 13
  2153.       CALL ZGEMM( 'C', 'C', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2154.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2155.       INFOT = 13
  2156.       CALL ZGEMM( 'C', 'T', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2157.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2158.       INFOT = 13
  2159.       CALL ZGEMM( 'T', 'N', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2160.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2161.       INFOT = 13
  2162.       CALL ZGEMM( 'T', 'C', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2163.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2164.       INFOT = 13
  2165.       CALL ZGEMM( 'T', 'T', 2, 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2166.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2167.       GO TO 100
  2168.    20 INFOT = 1
  2169.       CALL ZHEMM( '/', 'U', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2170.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2171.       INFOT = 2
  2172.       CALL ZHEMM( 'L', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2173.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2174.       INFOT = 3
  2175.       CALL ZHEMM( 'L', 'U', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2176.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2177.       INFOT = 3
  2178.       CALL ZHEMM( 'R', 'U', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2179.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2180.       INFOT = 3
  2181.       CALL ZHEMM( 'L', 'L', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2182.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2183.       INFOT = 3
  2184.       CALL ZHEMM( 'R', 'L', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2185.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2186.       INFOT = 4
  2187.       CALL ZHEMM( 'L', 'U', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2188.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2189.       INFOT = 4
  2190.       CALL ZHEMM( 'R', 'U', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2191.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2192.       INFOT = 4
  2193.       CALL ZHEMM( 'L', 'L', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2194.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2195.       INFOT = 4
  2196.       CALL ZHEMM( 'R', 'L', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2197.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2198.       INFOT = 7
  2199.       CALL ZHEMM( 'L', 'U', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 )
  2200.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2201.       INFOT = 7
  2202.       CALL ZHEMM( 'R', 'U', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2203.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2204.       INFOT = 7
  2205.       CALL ZHEMM( 'L', 'L', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 )
  2206.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2207.       INFOT = 7
  2208.       CALL ZHEMM( 'R', 'L', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2209.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2210.       INFOT = 9
  2211.       CALL ZHEMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 )
  2212.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2213.       INFOT = 9
  2214.       CALL ZHEMM( 'R', 'U', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2215.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2216.       INFOT = 9
  2217.       CALL ZHEMM( 'L', 'L', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 )
  2218.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2219.       INFOT = 9
  2220.       CALL ZHEMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2221.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2222.       INFOT = 12
  2223.       CALL ZHEMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
  2224.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2225.       INFOT = 12
  2226.       CALL ZHEMM( 'R', 'U', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 )
  2227.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2228.       INFOT = 12
  2229.       CALL ZHEMM( 'L', 'L', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
  2230.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2231.       INFOT = 12
  2232.       CALL ZHEMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 )
  2233.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2234.       GO TO 100
  2235.    30 INFOT = 1
  2236.       CALL ZSYMM( '/', 'U', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2237.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2238.       INFOT = 2
  2239.       CALL ZSYMM( 'L', '/', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2240.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2241.       INFOT = 3
  2242.       CALL ZSYMM( 'L', 'U', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2243.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2244.       INFOT = 3
  2245.       CALL ZSYMM( 'R', 'U', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2246.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2247.       INFOT = 3
  2248.       CALL ZSYMM( 'L', 'L', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2249.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2250.       INFOT = 3
  2251.       CALL ZSYMM( 'R', 'L', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2252.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2253.       INFOT = 4
  2254.       CALL ZSYMM( 'L', 'U', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2255.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2256.       INFOT = 4
  2257.       CALL ZSYMM( 'R', 'U', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2258.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2259.       INFOT = 4
  2260.       CALL ZSYMM( 'L', 'L', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2261.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2262.       INFOT = 4
  2263.       CALL ZSYMM( 'R', 'L', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2264.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2265.       INFOT = 7
  2266.       CALL ZSYMM( 'L', 'U', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 )
  2267.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2268.       INFOT = 7
  2269.       CALL ZSYMM( 'R', 'U', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2270.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2271.       INFOT = 7
  2272.       CALL ZSYMM( 'L', 'L', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 2 )
  2273.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2274.       INFOT = 7
  2275.       CALL ZSYMM( 'R', 'L', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2276.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2277.       INFOT = 9
  2278.       CALL ZSYMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 )
  2279.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2280.       INFOT = 9
  2281.       CALL ZSYMM( 'R', 'U', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2282.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2283.       INFOT = 9
  2284.       CALL ZSYMM( 'L', 'L', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 1 )
  2285.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2286.       INFOT = 9
  2287.       CALL ZSYMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2288.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2289.       INFOT = 12
  2290.       CALL ZSYMM( 'L', 'U', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
  2291.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2292.       INFOT = 12
  2293.       CALL ZSYMM( 'R', 'U', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 )
  2294.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2295.       INFOT = 12
  2296.       CALL ZSYMM( 'L', 'L', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
  2297.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2298.       INFOT = 12
  2299.       CALL ZSYMM( 'R', 'L', 2, 0, ALPHA, A, 1, B, 2, BETA, C, 1 )
  2300.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2301.       GO TO 100
  2302.    40 INFOT = 1
  2303.       CALL ZTRMM( '/', 'U', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 )
  2304.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2305.       INFOT = 2
  2306.       CALL ZTRMM( 'L', '/', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 )
  2307.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2308.       INFOT = 3
  2309.       CALL ZTRMM( 'L', 'U', '/', 'N', 0, 0, ALPHA, A, 1, B, 1 )
  2310.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2311.       INFOT = 4
  2312.       CALL ZTRMM( 'L', 'U', 'N', '/', 0, 0, ALPHA, A, 1, B, 1 )
  2313.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2314.       INFOT = 5
  2315.       CALL ZTRMM( 'L', 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
  2316.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2317.       INFOT = 5
  2318.       CALL ZTRMM( 'L', 'U', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1 )
  2319.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2320.       INFOT = 5
  2321.       CALL ZTRMM( 'L', 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
  2322.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2323.       INFOT = 5
  2324.       CALL ZTRMM( 'R', 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
  2325.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2326.       INFOT = 5
  2327.       CALL ZTRMM( 'R', 'U', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1 )
  2328.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2329.       INFOT = 5
  2330.       CALL ZTRMM( 'R', 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
  2331.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2332.       INFOT = 5
  2333.       CALL ZTRMM( 'L', 'L', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
  2334.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2335.       INFOT = 5
  2336.       CALL ZTRMM( 'L', 'L', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1 )
  2337.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2338.       INFOT = 5
  2339.       CALL ZTRMM( 'L', 'L', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
  2340.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2341.       INFOT = 5
  2342.       CALL ZTRMM( 'R', 'L', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
  2343.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2344.       INFOT = 5
  2345.       CALL ZTRMM( 'R', 'L', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1 )
  2346.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2347.       INFOT = 5
  2348.       CALL ZTRMM( 'R', 'L', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
  2349.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2350.       INFOT = 6
  2351.       CALL ZTRMM( 'L', 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
  2352.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2353.       INFOT = 6
  2354.       CALL ZTRMM( 'L', 'U', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1 )
  2355.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2356.       INFOT = 6
  2357.       CALL ZTRMM( 'L', 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
  2358.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2359.       INFOT = 6
  2360.       CALL ZTRMM( 'R', 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
  2361.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2362.       INFOT = 6
  2363.       CALL ZTRMM( 'R', 'U', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1 )
  2364.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2365.       INFOT = 6
  2366.       CALL ZTRMM( 'R', 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
  2367.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2368.       INFOT = 6
  2369.       CALL ZTRMM( 'L', 'L', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
  2370.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2371.       INFOT = 6
  2372.       CALL ZTRMM( 'L', 'L', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1 )
  2373.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2374.       INFOT = 6
  2375.       CALL ZTRMM( 'L', 'L', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
  2376.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2377.       INFOT = 6
  2378.       CALL ZTRMM( 'R', 'L', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
  2379.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2380.       INFOT = 6
  2381.       CALL ZTRMM( 'R', 'L', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1 )
  2382.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2383.       INFOT = 6
  2384.       CALL ZTRMM( 'R', 'L', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
  2385.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2386.       INFOT = 9
  2387.       CALL ZTRMM( 'L', 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 2 )
  2388.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2389.       INFOT = 9
  2390.       CALL ZTRMM( 'L', 'U', 'C', 'N', 2, 0, ALPHA, A, 1, B, 2 )
  2391.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2392.       INFOT = 9
  2393.       CALL ZTRMM( 'L', 'U', 'T', 'N', 2, 0, ALPHA, A, 1, B, 2 )
  2394.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2395.       INFOT = 9
  2396.       CALL ZTRMM( 'R', 'U', 'N', 'N', 0, 2, ALPHA, A, 1, B, 1 )
  2397.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2398.       INFOT = 9
  2399.       CALL ZTRMM( 'R', 'U', 'C', 'N', 0, 2, ALPHA, A, 1, B, 1 )
  2400.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2401.       INFOT = 9
  2402.       CALL ZTRMM( 'R', 'U', 'T', 'N', 0, 2, ALPHA, A, 1, B, 1 )
  2403.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2404.       INFOT = 9
  2405.       CALL ZTRMM( 'L', 'L', 'N', 'N', 2, 0, ALPHA, A, 1, B, 2 )
  2406.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2407.       INFOT = 9
  2408.       CALL ZTRMM( 'L', 'L', 'C', 'N', 2, 0, ALPHA, A, 1, B, 2 )
  2409.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2410.       INFOT = 9
  2411.       CALL ZTRMM( 'L', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 2 )
  2412.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2413.       INFOT = 9
  2414.       CALL ZTRMM( 'R', 'L', 'N', 'N', 0, 2, ALPHA, A, 1, B, 1 )
  2415.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2416.       INFOT = 9
  2417.       CALL ZTRMM( 'R', 'L', 'C', 'N', 0, 2, ALPHA, A, 1, B, 1 )
  2418.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2419.       INFOT = 9
  2420.       CALL ZTRMM( 'R', 'L', 'T', 'N', 0, 2, ALPHA, A, 1, B, 1 )
  2421.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2422.       INFOT = 11
  2423.       CALL ZTRMM( 'L', 'U', 'N', 'N', 2, 0, ALPHA, A, 2, B, 1 )
  2424.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2425.       INFOT = 11
  2426.       CALL ZTRMM( 'L', 'U', 'C', 'N', 2, 0, ALPHA, A, 2, B, 1 )
  2427.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2428.       INFOT = 11
  2429.       CALL ZTRMM( 'L', 'U', 'T', 'N', 2, 0, ALPHA, A, 2, B, 1 )
  2430.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2431.       INFOT = 11
  2432.       CALL ZTRMM( 'R', 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 1 )
  2433.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2434.       INFOT = 11
  2435.       CALL ZTRMM( 'R', 'U', 'C', 'N', 2, 0, ALPHA, A, 1, B, 1 )
  2436.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2437.       INFOT = 11
  2438.       CALL ZTRMM( 'R', 'U', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 )
  2439.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2440.       INFOT = 11
  2441.       CALL ZTRMM( 'L', 'L', 'N', 'N', 2, 0, ALPHA, A, 2, B, 1 )
  2442.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2443.       INFOT = 11
  2444.       CALL ZTRMM( 'L', 'L', 'C', 'N', 2, 0, ALPHA, A, 2, B, 1 )
  2445.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2446.       INFOT = 11
  2447.       CALL ZTRMM( 'L', 'L', 'T', 'N', 2, 0, ALPHA, A, 2, B, 1 )
  2448.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2449.       INFOT = 11
  2450.       CALL ZTRMM( 'R', 'L', 'N', 'N', 2, 0, ALPHA, A, 1, B, 1 )
  2451.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2452.       INFOT = 11
  2453.       CALL ZTRMM( 'R', 'L', 'C', 'N', 2, 0, ALPHA, A, 1, B, 1 )
  2454.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2455.       INFOT = 11
  2456.       CALL ZTRMM( 'R', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 )
  2457.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2458.       GO TO 100
  2459.    50 INFOT = 1
  2460.       CALL ZTRSM( '/', 'U', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 )
  2461.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2462.       INFOT = 2
  2463.       CALL ZTRSM( 'L', '/', 'N', 'N', 0, 0, ALPHA, A, 1, B, 1 )
  2464.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2465.       INFOT = 3
  2466.       CALL ZTRSM( 'L', 'U', '/', 'N', 0, 0, ALPHA, A, 1, B, 1 )
  2467.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2468.       INFOT = 4
  2469.       CALL ZTRSM( 'L', 'U', 'N', '/', 0, 0, ALPHA, A, 1, B, 1 )
  2470.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2471.       INFOT = 5
  2472.       CALL ZTRSM( 'L', 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
  2473.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2474.       INFOT = 5
  2475.       CALL ZTRSM( 'L', 'U', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1 )
  2476.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2477.       INFOT = 5
  2478.       CALL ZTRSM( 'L', 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
  2479.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2480.       INFOT = 5
  2481.       CALL ZTRSM( 'R', 'U', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
  2482.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2483.       INFOT = 5
  2484.       CALL ZTRSM( 'R', 'U', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1 )
  2485.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2486.       INFOT = 5
  2487.       CALL ZTRSM( 'R', 'U', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
  2488.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2489.       INFOT = 5
  2490.       CALL ZTRSM( 'L', 'L', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
  2491.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2492.       INFOT = 5
  2493.       CALL ZTRSM( 'L', 'L', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1 )
  2494.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2495.       INFOT = 5
  2496.       CALL ZTRSM( 'L', 'L', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
  2497.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2498.       INFOT = 5
  2499.       CALL ZTRSM( 'R', 'L', 'N', 'N', -1, 0, ALPHA, A, 1, B, 1 )
  2500.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2501.       INFOT = 5
  2502.       CALL ZTRSM( 'R', 'L', 'C', 'N', -1, 0, ALPHA, A, 1, B, 1 )
  2503.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2504.       INFOT = 5
  2505.       CALL ZTRSM( 'R', 'L', 'T', 'N', -1, 0, ALPHA, A, 1, B, 1 )
  2506.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2507.       INFOT = 6
  2508.       CALL ZTRSM( 'L', 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
  2509.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2510.       INFOT = 6
  2511.       CALL ZTRSM( 'L', 'U', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1 )
  2512.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2513.       INFOT = 6
  2514.       CALL ZTRSM( 'L', 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
  2515.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2516.       INFOT = 6
  2517.       CALL ZTRSM( 'R', 'U', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
  2518.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2519.       INFOT = 6
  2520.       CALL ZTRSM( 'R', 'U', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1 )
  2521.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2522.       INFOT = 6
  2523.       CALL ZTRSM( 'R', 'U', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
  2524.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2525.       INFOT = 6
  2526.       CALL ZTRSM( 'L', 'L', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
  2527.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2528.       INFOT = 6
  2529.       CALL ZTRSM( 'L', 'L', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1 )
  2530.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2531.       INFOT = 6
  2532.       CALL ZTRSM( 'L', 'L', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
  2533.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2534.       INFOT = 6
  2535.       CALL ZTRSM( 'R', 'L', 'N', 'N', 0, -1, ALPHA, A, 1, B, 1 )
  2536.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2537.       INFOT = 6
  2538.       CALL ZTRSM( 'R', 'L', 'C', 'N', 0, -1, ALPHA, A, 1, B, 1 )
  2539.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2540.       INFOT = 6
  2541.       CALL ZTRSM( 'R', 'L', 'T', 'N', 0, -1, ALPHA, A, 1, B, 1 )
  2542.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2543.       INFOT = 9
  2544.       CALL ZTRSM( 'L', 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 2 )
  2545.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2546.       INFOT = 9
  2547.       CALL ZTRSM( 'L', 'U', 'C', 'N', 2, 0, ALPHA, A, 1, B, 2 )
  2548.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2549.       INFOT = 9
  2550.       CALL ZTRSM( 'L', 'U', 'T', 'N', 2, 0, ALPHA, A, 1, B, 2 )
  2551.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2552.       INFOT = 9
  2553.       CALL ZTRSM( 'R', 'U', 'N', 'N', 0, 2, ALPHA, A, 1, B, 1 )
  2554.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2555.       INFOT = 9
  2556.       CALL ZTRSM( 'R', 'U', 'C', 'N', 0, 2, ALPHA, A, 1, B, 1 )
  2557.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2558.       INFOT = 9
  2559.       CALL ZTRSM( 'R', 'U', 'T', 'N', 0, 2, ALPHA, A, 1, B, 1 )
  2560.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2561.       INFOT = 9
  2562.       CALL ZTRSM( 'L', 'L', 'N', 'N', 2, 0, ALPHA, A, 1, B, 2 )
  2563.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2564.       INFOT = 9
  2565.       CALL ZTRSM( 'L', 'L', 'C', 'N', 2, 0, ALPHA, A, 1, B, 2 )
  2566.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2567.       INFOT = 9
  2568.       CALL ZTRSM( 'L', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 2 )
  2569.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2570.       INFOT = 9
  2571.       CALL ZTRSM( 'R', 'L', 'N', 'N', 0, 2, ALPHA, A, 1, B, 1 )
  2572.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2573.       INFOT = 9
  2574.       CALL ZTRSM( 'R', 'L', 'C', 'N', 0, 2, ALPHA, A, 1, B, 1 )
  2575.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2576.       INFOT = 9
  2577.       CALL ZTRSM( 'R', 'L', 'T', 'N', 0, 2, ALPHA, A, 1, B, 1 )
  2578.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2579.       INFOT = 11
  2580.       CALL ZTRSM( 'L', 'U', 'N', 'N', 2, 0, ALPHA, A, 2, B, 1 )
  2581.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2582.       INFOT = 11
  2583.       CALL ZTRSM( 'L', 'U', 'C', 'N', 2, 0, ALPHA, A, 2, B, 1 )
  2584.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2585.       INFOT = 11
  2586.       CALL ZTRSM( 'L', 'U', 'T', 'N', 2, 0, ALPHA, A, 2, B, 1 )
  2587.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2588.       INFOT = 11
  2589.       CALL ZTRSM( 'R', 'U', 'N', 'N', 2, 0, ALPHA, A, 1, B, 1 )
  2590.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2591.       INFOT = 11
  2592.       CALL ZTRSM( 'R', 'U', 'C', 'N', 2, 0, ALPHA, A, 1, B, 1 )
  2593.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2594.       INFOT = 11
  2595.       CALL ZTRSM( 'R', 'U', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 )
  2596.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2597.       INFOT = 11
  2598.       CALL ZTRSM( 'L', 'L', 'N', 'N', 2, 0, ALPHA, A, 2, B, 1 )
  2599.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2600.       INFOT = 11
  2601.       CALL ZTRSM( 'L', 'L', 'C', 'N', 2, 0, ALPHA, A, 2, B, 1 )
  2602.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2603.       INFOT = 11
  2604.       CALL ZTRSM( 'L', 'L', 'T', 'N', 2, 0, ALPHA, A, 2, B, 1 )
  2605.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2606.       INFOT = 11
  2607.       CALL ZTRSM( 'R', 'L', 'N', 'N', 2, 0, ALPHA, A, 1, B, 1 )
  2608.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2609.       INFOT = 11
  2610.       CALL ZTRSM( 'R', 'L', 'C', 'N', 2, 0, ALPHA, A, 1, B, 1 )
  2611.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2612.       INFOT = 11
  2613.       CALL ZTRSM( 'R', 'L', 'T', 'N', 2, 0, ALPHA, A, 1, B, 1 )
  2614.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2615.       GO TO 100
  2616.    60 INFOT = 1
  2617.       CALL ZHERK( '/', 'N', 0, 0, RALPHA, A, 1, RBETA, C, 1 )
  2618.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2619.       INFOT = 2
  2620.       CALL ZHERK( 'U', 'T', 0, 0, RALPHA, A, 1, RBETA, C, 1 )
  2621.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2622.       INFOT = 3
  2623.       CALL ZHERK( 'U', 'N', -1, 0, RALPHA, A, 1, RBETA, C, 1 )
  2624.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2625.       INFOT = 3
  2626.       CALL ZHERK( 'U', 'C', -1, 0, RALPHA, A, 1, RBETA, C, 1 )
  2627.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2628.       INFOT = 3
  2629.       CALL ZHERK( 'L', 'N', -1, 0, RALPHA, A, 1, RBETA, C, 1 )
  2630.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2631.       INFOT = 3
  2632.       CALL ZHERK( 'L', 'C', -1, 0, RALPHA, A, 1, RBETA, C, 1 )
  2633.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2634.       INFOT = 4
  2635.       CALL ZHERK( 'U', 'N', 0, -1, RALPHA, A, 1, RBETA, C, 1 )
  2636.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2637.       INFOT = 4
  2638.       CALL ZHERK( 'U', 'C', 0, -1, RALPHA, A, 1, RBETA, C, 1 )
  2639.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2640.       INFOT = 4
  2641.       CALL ZHERK( 'L', 'N', 0, -1, RALPHA, A, 1, RBETA, C, 1 )
  2642.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2643.       INFOT = 4
  2644.       CALL ZHERK( 'L', 'C', 0, -1, RALPHA, A, 1, RBETA, C, 1 )
  2645.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2646.       INFOT = 7
  2647.       CALL ZHERK( 'U', 'N', 2, 0, RALPHA, A, 1, RBETA, C, 2 )
  2648.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2649.       INFOT = 7
  2650.       CALL ZHERK( 'U', 'C', 0, 2, RALPHA, A, 1, RBETA, C, 1 )
  2651.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2652.       INFOT = 7
  2653.       CALL ZHERK( 'L', 'N', 2, 0, RALPHA, A, 1, RBETA, C, 2 )
  2654.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2655.       INFOT = 7
  2656.       CALL ZHERK( 'L', 'C', 0, 2, RALPHA, A, 1, RBETA, C, 1 )
  2657.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2658.       INFOT = 10
  2659.       CALL ZHERK( 'U', 'N', 2, 0, RALPHA, A, 2, RBETA, C, 1 )
  2660.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2661.       INFOT = 10
  2662.       CALL ZHERK( 'U', 'C', 2, 0, RALPHA, A, 1, RBETA, C, 1 )
  2663.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2664.       INFOT = 10
  2665.       CALL ZHERK( 'L', 'N', 2, 0, RALPHA, A, 2, RBETA, C, 1 )
  2666.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2667.       INFOT = 10
  2668.       CALL ZHERK( 'L', 'C', 2, 0, RALPHA, A, 1, RBETA, C, 1 )
  2669.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2670.       GO TO 100
  2671.    70 INFOT = 1
  2672.       CALL ZSYRK( '/', 'N', 0, 0, ALPHA, A, 1, BETA, C, 1 )
  2673.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2674.       INFOT = 2
  2675.       CALL ZSYRK( 'U', 'C', 0, 0, ALPHA, A, 1, BETA, C, 1 )
  2676.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2677.       INFOT = 3
  2678.       CALL ZSYRK( 'U', 'N', -1, 0, ALPHA, A, 1, BETA, C, 1 )
  2679.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2680.       INFOT = 3
  2681.       CALL ZSYRK( 'U', 'T', -1, 0, ALPHA, A, 1, BETA, C, 1 )
  2682.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2683.       INFOT = 3
  2684.       CALL ZSYRK( 'L', 'N', -1, 0, ALPHA, A, 1, BETA, C, 1 )
  2685.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2686.       INFOT = 3
  2687.       CALL ZSYRK( 'L', 'T', -1, 0, ALPHA, A, 1, BETA, C, 1 )
  2688.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2689.       INFOT = 4
  2690.       CALL ZSYRK( 'U', 'N', 0, -1, ALPHA, A, 1, BETA, C, 1 )
  2691.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2692.       INFOT = 4
  2693.       CALL ZSYRK( 'U', 'T', 0, -1, ALPHA, A, 1, BETA, C, 1 )
  2694.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2695.       INFOT = 4
  2696.       CALL ZSYRK( 'L', 'N', 0, -1, ALPHA, A, 1, BETA, C, 1 )
  2697.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2698.       INFOT = 4
  2699.       CALL ZSYRK( 'L', 'T', 0, -1, ALPHA, A, 1, BETA, C, 1 )
  2700.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2701.       INFOT = 7
  2702.       CALL ZSYRK( 'U', 'N', 2, 0, ALPHA, A, 1, BETA, C, 2 )
  2703.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2704.       INFOT = 7
  2705.       CALL ZSYRK( 'U', 'T', 0, 2, ALPHA, A, 1, BETA, C, 1 )
  2706.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2707.       INFOT = 7
  2708.       CALL ZSYRK( 'L', 'N', 2, 0, ALPHA, A, 1, BETA, C, 2 )
  2709.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2710.       INFOT = 7
  2711.       CALL ZSYRK( 'L', 'T', 0, 2, ALPHA, A, 1, BETA, C, 1 )
  2712.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2713.       INFOT = 10
  2714.       CALL ZSYRK( 'U', 'N', 2, 0, ALPHA, A, 2, BETA, C, 1 )
  2715.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2716.       INFOT = 10
  2717.       CALL ZSYRK( 'U', 'T', 2, 0, ALPHA, A, 1, BETA, C, 1 )
  2718.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2719.       INFOT = 10
  2720.       CALL ZSYRK( 'L', 'N', 2, 0, ALPHA, A, 2, BETA, C, 1 )
  2721.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2722.       INFOT = 10
  2723.       CALL ZSYRK( 'L', 'T', 2, 0, ALPHA, A, 1, BETA, C, 1 )
  2724.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2725.       GO TO 100
  2726.    80 INFOT = 1
  2727.       CALL ZHER2K( '/', 'N', 0, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
  2728.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2729.       INFOT = 2
  2730.       CALL ZHER2K( 'U', 'T', 0, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
  2731.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2732.       INFOT = 3
  2733.       CALL ZHER2K( 'U', 'N', -1, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
  2734.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2735.       INFOT = 3
  2736.       CALL ZHER2K( 'U', 'C', -1, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
  2737.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2738.       INFOT = 3
  2739.       CALL ZHER2K( 'L', 'N', -1, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
  2740.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2741.       INFOT = 3
  2742.       CALL ZHER2K( 'L', 'C', -1, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
  2743.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2744.       INFOT = 4
  2745.       CALL ZHER2K( 'U', 'N', 0, -1, ALPHA, A, 1, B, 1, RBETA, C, 1 )
  2746.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2747.       INFOT = 4
  2748.       CALL ZHER2K( 'U', 'C', 0, -1, ALPHA, A, 1, B, 1, RBETA, C, 1 )
  2749.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2750.       INFOT = 4
  2751.       CALL ZHER2K( 'L', 'N', 0, -1, ALPHA, A, 1, B, 1, RBETA, C, 1 )
  2752.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2753.       INFOT = 4
  2754.       CALL ZHER2K( 'L', 'C', 0, -1, ALPHA, A, 1, B, 1, RBETA, C, 1 )
  2755.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2756.       INFOT = 7
  2757.       CALL ZHER2K( 'U', 'N', 2, 0, ALPHA, A, 1, B, 1, RBETA, C, 2 )
  2758.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2759.       INFOT = 7
  2760.       CALL ZHER2K( 'U', 'C', 0, 2, ALPHA, A, 1, B, 1, RBETA, C, 1 )
  2761.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2762.       INFOT = 7
  2763.       CALL ZHER2K( 'L', 'N', 2, 0, ALPHA, A, 1, B, 1, RBETA, C, 2 )
  2764.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2765.       INFOT = 7
  2766.       CALL ZHER2K( 'L', 'C', 0, 2, ALPHA, A, 1, B, 1, RBETA, C, 1 )
  2767.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2768.       INFOT = 9
  2769.       CALL ZHER2K( 'U', 'N', 2, 0, ALPHA, A, 2, B, 1, RBETA, C, 2 )
  2770.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2771.       INFOT = 9
  2772.       CALL ZHER2K( 'U', 'C', 0, 2, ALPHA, A, 2, B, 1, RBETA, C, 1 )
  2773.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2774.       INFOT = 9
  2775.       CALL ZHER2K( 'L', 'N', 2, 0, ALPHA, A, 2, B, 1, RBETA, C, 2 )
  2776.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2777.       INFOT = 9
  2778.       CALL ZHER2K( 'L', 'C', 0, 2, ALPHA, A, 2, B, 1, RBETA, C, 1 )
  2779.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2780.       INFOT = 12
  2781.       CALL ZHER2K( 'U', 'N', 2, 0, ALPHA, A, 2, B, 2, RBETA, C, 1 )
  2782.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2783.       INFOT = 12
  2784.       CALL ZHER2K( 'U', 'C', 2, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
  2785.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2786.       INFOT = 12
  2787.       CALL ZHER2K( 'L', 'N', 2, 0, ALPHA, A, 2, B, 2, RBETA, C, 1 )
  2788.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2789.       INFOT = 12
  2790.       CALL ZHER2K( 'L', 'C', 2, 0, ALPHA, A, 1, B, 1, RBETA, C, 1 )
  2791.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2792.       GO TO 100
  2793.    90 INFOT = 1
  2794.       CALL ZSYR2K( '/', 'N', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2795.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2796.       INFOT = 2
  2797.       CALL ZSYR2K( 'U', 'C', 0, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2798.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2799.       INFOT = 3
  2800.       CALL ZSYR2K( 'U', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2801.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2802.       INFOT = 3
  2803.       CALL ZSYR2K( 'U', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2804.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2805.       INFOT = 3
  2806.       CALL ZSYR2K( 'L', 'N', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2807.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2808.       INFOT = 3
  2809.       CALL ZSYR2K( 'L', 'T', -1, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2810.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2811.       INFOT = 4
  2812.       CALL ZSYR2K( 'U', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2813.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2814.       INFOT = 4
  2815.       CALL ZSYR2K( 'U', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2816.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2817.       INFOT = 4
  2818.       CALL ZSYR2K( 'L', 'N', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2819.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2820.       INFOT = 4
  2821.       CALL ZSYR2K( 'L', 'T', 0, -1, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2822.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2823.       INFOT = 7
  2824.       CALL ZSYR2K( 'U', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
  2825.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2826.       INFOT = 7
  2827.       CALL ZSYR2K( 'U', 'T', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2828.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2829.       INFOT = 7
  2830.       CALL ZSYR2K( 'L', 'N', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 2 )
  2831.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2832.       INFOT = 7
  2833.       CALL ZSYR2K( 'L', 'T', 0, 2, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2834.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2835.       INFOT = 9
  2836.       CALL ZSYR2K( 'U', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 )
  2837.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2838.       INFOT = 9
  2839.       CALL ZSYR2K( 'U', 'T', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 )
  2840.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2841.       INFOT = 9
  2842.       CALL ZSYR2K( 'L', 'N', 2, 0, ALPHA, A, 2, B, 1, BETA, C, 2 )
  2843.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2844.       INFOT = 9
  2845.       CALL ZSYR2K( 'L', 'T', 0, 2, ALPHA, A, 2, B, 1, BETA, C, 1 )
  2846.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2847.       INFOT = 12
  2848.       CALL ZSYR2K( 'U', 'N', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
  2849.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2850.       INFOT = 12
  2851.       CALL ZSYR2K( 'U', 'T', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2852.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2853.       INFOT = 12
  2854.       CALL ZSYR2K( 'L', 'N', 2, 0, ALPHA, A, 2, B, 2, BETA, C, 1 )
  2855.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2856.       INFOT = 12
  2857.       CALL ZSYR2K( 'L', 'T', 2, 0, ALPHA, A, 1, B, 1, BETA, C, 1 )
  2858.       CALL CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  2859. *
  2860.   100 IF( OK )THEN
  2861.          WRITE( NOUT, FMT = 9999 )SRNAMT
  2862.       ELSE
  2863.          WRITE( NOUT, FMT = 9998 )SRNAMT
  2864.       END IF
  2865.       RETURN
  2866. *
  2867.  9999 FORMAT( ' ', A6, ' PASSED THE TESTS OF ERROR-EXITS' )
  2868.  9998 FORMAT( ' ******* ', A6, ' FAILED THE TESTS OF ERROR-EXITS *****',
  2869.      $      '**' )
  2870. *
  2871. *     End of ZCHKE.
  2872. *
  2873.       END
  2874.       SUBROUTINE ZMAKE( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, RESET,
  2875.      $                  TRANSL )
  2876. *
  2877. *  Generates values for an M by N matrix A.
  2878. *  Stores the values in the array AA in the data structure required
  2879. *  by the routine, with unwanted elements set to rogue value.
  2880. *
  2881. *  TYPE is 'GE', 'HE', 'SY' or 'TR'.
  2882. *
  2883. *  Auxiliary routine for test program for Level 3 Blas.
  2884. *
  2885. *  -- Written on 8-February-1989.
  2886. *     Jack Dongarra, Argonne National Laboratory.
  2887. *     Iain Duff, AERE Harwell.
  2888. *     Jeremy Du Croz, Numerical Algorithms Group Ltd.
  2889. *     Sven Hammarling, Numerical Algorithms Group Ltd.
  2890. *
  2891. *     .. Parameters ..
  2892.       COMPLEX*16         ZERO, ONE
  2893.       PARAMETER          ( ZERO = ( 0.0D0, 0.0D0 ),
  2894.      $                   ONE = ( 1.0D0, 0.0D0 ) )
  2895.       COMPLEX*16         ROGUE
  2896.       PARAMETER          ( ROGUE = ( -1.0D10, 1.0D10 ) )
  2897.       DOUBLE PRECISION   RZERO
  2898.       PARAMETER          ( RZERO = 0.0D0 )
  2899.       DOUBLE PRECISION   RROGUE
  2900.       PARAMETER          ( RROGUE = -1.0D10 )
  2901. *     .. Scalar Arguments ..
  2902.       COMPLEX*16         TRANSL
  2903.       INTEGER            LDA, M, N, NMAX
  2904.       LOGICAL            RESET
  2905.       CHARACTER*1        DIAG, UPLO
  2906.       CHARACTER*2        TYPE
  2907. *     .. Array Arguments ..
  2908.       COMPLEX*16         A( NMAX, * ), AA( * )
  2909. *     .. Local Scalars ..
  2910.       INTEGER            I, IBEG, IEND, J, JJ
  2911.       LOGICAL            GEN, HER, LOWER, SYM, TRI, UNIT, UPPER
  2912. *     .. External Functions ..
  2913.       COMPLEX*16         ZBEG
  2914.       EXTERNAL           ZBEG
  2915. *     .. Intrinsic Functions ..
  2916.       INTRINSIC          DCMPLX, DCONJG, DBLE
  2917. *     .. Executable Statements ..
  2918.       GEN = TYPE.EQ.'GE'
  2919.       HER = TYPE.EQ.'HE'
  2920.       SYM = TYPE.EQ.'SY'
  2921.       TRI = TYPE.EQ.'TR'
  2922.       UPPER = ( HER.OR.SYM.OR.TRI ).AND.UPLO.EQ.'U'
  2923.       LOWER = ( HER.OR.SYM.OR.TRI ).AND.UPLO.EQ.'L'
  2924.       UNIT = TRI.AND.DIAG.EQ.'U'
  2925. *
  2926. *     Generate data in array A.
  2927. *
  2928.       DO 20 J = 1, N
  2929.          DO 10 I = 1, M
  2930.             IF( GEN.OR.( UPPER.AND.I.LE.J ).OR.( LOWER.AND.I.GE.J ) )
  2931.      $          THEN
  2932.                A( I, J ) = ZBEG( RESET ) + TRANSL
  2933.                IF( I.NE.J )THEN
  2934. *                 Set some elements to zero
  2935.                   IF( N.GT.3.AND.J.EQ.N/2 )
  2936.      $               A( I, J ) = ZERO
  2937.                   IF( HER )THEN
  2938.                      A( J, I ) = DCONJG( A( I, J ) )
  2939.                   ELSE IF( SYM )THEN
  2940.                      A( J, I ) = A( I, J )
  2941.                   ELSE IF( TRI )THEN
  2942.                      A( J, I ) = ZERO
  2943.                   END IF
  2944.                END IF
  2945.             END IF
  2946.    10    CONTINUE
  2947.          IF( HER )
  2948.      $      A( J, J ) = DCMPLX( DBLE( A( J, J ) ), RZERO )
  2949.          IF( TRI )
  2950.      $      A( J, J ) = A( J, J ) + ONE
  2951.          IF( UNIT )
  2952.      $      A( J, J ) = ONE
  2953.    20 CONTINUE
  2954. *
  2955. *     Store elements in array AS in data structure required by routine.
  2956. *
  2957.       IF( TYPE.EQ.'GE' )THEN
  2958.          DO 50 J = 1, N
  2959.             DO 30 I = 1, M
  2960.                AA( I + ( J - 1 )*LDA ) = A( I, J )
  2961.    30       CONTINUE
  2962.             DO 40 I = M + 1, LDA
  2963.                AA( I + ( J - 1 )*LDA ) = ROGUE
  2964.    40       CONTINUE
  2965.    50    CONTINUE
  2966.       ELSE IF( TYPE.EQ.'HE'.OR.TYPE.EQ.'SY'.OR.TYPE.EQ.'TR' )THEN
  2967.          DO 90 J = 1, N
  2968.             IF( UPPER )THEN
  2969.                IBEG = 1
  2970.                IF( UNIT )THEN
  2971.                   IEND = J - 1
  2972.                ELSE
  2973.                   IEND = J
  2974.                END IF
  2975.             ELSE
  2976.                IF( UNIT )THEN
  2977.                   IBEG = J + 1
  2978.                ELSE
  2979.                   IBEG = J
  2980.                END IF
  2981.                IEND = N
  2982.             END IF
  2983.             DO 60 I = 1, IBEG - 1
  2984.                AA( I + ( J - 1 )*LDA ) = ROGUE
  2985.    60       CONTINUE
  2986.             DO 70 I = IBEG, IEND
  2987.                AA( I + ( J - 1 )*LDA ) = A( I, J )
  2988.    70       CONTINUE
  2989.             DO 80 I = IEND + 1, LDA
  2990.                AA( I + ( J - 1 )*LDA ) = ROGUE
  2991.    80       CONTINUE
  2992.             IF( HER )THEN
  2993.                JJ = J + ( J - 1 )*LDA
  2994.                AA( JJ ) = DCMPLX( DBLE( AA( JJ ) ), RROGUE )
  2995.             END IF
  2996.    90    CONTINUE
  2997.       END IF
  2998.       RETURN
  2999. *
  3000. *     End of ZMAKE.
  3001. *
  3002.       END
  3003.       SUBROUTINE ZMMCH( TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB,
  3004.      $                  BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR, FATAL,
  3005.      $                  NOUT, MV )
  3006. *
  3007. *  Checks the results of the computational tests.
  3008. *
  3009. *  Auxiliary routine for test program for Level 3 Blas.
  3010. *
  3011. *  -- Written on 8-February-1989.
  3012. *     Jack Dongarra, Argonne National Laboratory.
  3013. *     Iain Duff, AERE Harwell.
  3014. *     Jeremy Du Croz, Numerical Algorithms Group Ltd.
  3015. *     Sven Hammarling, Numerical Algorithms Group Ltd.
  3016. *
  3017. *     .. Parameters ..
  3018.       COMPLEX*16         ZERO
  3019.       PARAMETER          ( ZERO = ( 0.0D0, 0.0D0 ) )
  3020.       DOUBLE PRECISION   RZERO, RONE
  3021.       PARAMETER          ( RZERO = 0.0D0, RONE = 1.0D0 )
  3022. *     .. Scalar Arguments ..
  3023.       COMPLEX*16         ALPHA, BETA
  3024.       DOUBLE PRECISION   EPS, ERR
  3025.       INTEGER            KK, LDA, LDB, LDC, LDCC, M, N, NOUT
  3026.       LOGICAL            FATAL, MV
  3027.       CHARACTER*1        TRANSA, TRANSB
  3028. *     .. Array Arguments ..
  3029.       COMPLEX*16         A( LDA, * ), B( LDB, * ), C( LDC, * ),
  3030.      $                   CC( LDCC, * ), CT( * )
  3031.       DOUBLE PRECISION   G( * )
  3032. *     .. Local Scalars ..
  3033.       COMPLEX*16         CL
  3034.       DOUBLE PRECISION   ERRI
  3035.       INTEGER            I, J, K
  3036.       LOGICAL            CTRANA, CTRANB, TRANA, TRANB
  3037. *     .. Intrinsic Functions ..
  3038.       INTRINSIC          ABS, DIMAG, DCONJG, MAX, DBLE, SQRT
  3039. *     .. Statement Functions ..
  3040.       DOUBLE PRECISION   ABS1
  3041. *     .. Statement Function definitions ..
  3042.       ABS1( CL ) = ABS( DBLE( CL ) ) + ABS( DIMAG( CL ) )
  3043. *     .. Executable Statements ..
  3044.       TRANA = TRANSA.EQ.'T'.OR.TRANSA.EQ.'C'
  3045.       TRANB = TRANSB.EQ.'T'.OR.TRANSB.EQ.'C'
  3046.       CTRANA = TRANSA.EQ.'C'
  3047.       CTRANB = TRANSB.EQ.'C'
  3048. *
  3049. *     Compute expected result, one column at a time, in CT using data
  3050. *     in A, B and C.
  3051. *     Compute gauges in G.
  3052. *
  3053.       DO 220 J = 1, N
  3054. *
  3055.          DO 10 I = 1, M
  3056.             CT( I ) = ZERO
  3057.             G( I ) = RZERO
  3058.    10    CONTINUE
  3059.          IF( .NOT.TRANA.AND..NOT.TRANB )THEN
  3060.             DO 30 K = 1, KK
  3061.                DO 20 I = 1, M
  3062.                   CT( I ) = CT( I ) + A( I, K )*B( K, J )
  3063.                   G( I ) = G( I ) + ABS1( A( I, K ) )*ABS1( B( K, J ) )
  3064.    20          CONTINUE
  3065.    30       CONTINUE
  3066.          ELSE IF( TRANA.AND..NOT.TRANB )THEN
  3067.             IF( CTRANA )THEN
  3068.                DO 50 K = 1, KK
  3069.                   DO 40 I = 1, M
  3070.                      CT( I ) = CT( I ) + DCONJG( A( K, I ) )*B( K, J )
  3071.                      G( I ) = G( I ) + ABS1( A( K, I ) )*
  3072.      $                        ABS1( B( K, J ) )
  3073.    40             CONTINUE
  3074.    50          CONTINUE
  3075.             ELSE
  3076.                DO 70 K = 1, KK
  3077.                   DO 60 I = 1, M
  3078.                      CT( I ) = CT( I ) + A( K, I )*B( K, J )
  3079.                      G( I ) = G( I ) + ABS1( A( K, I ) )*
  3080.      $                        ABS1( B( K, J ) )
  3081.    60             CONTINUE
  3082.    70          CONTINUE
  3083.             END IF
  3084.          ELSE IF( .NOT.TRANA.AND.TRANB )THEN
  3085.             IF( CTRANB )THEN
  3086.                DO 90 K = 1, KK
  3087.                   DO 80 I = 1, M
  3088.                      CT( I ) = CT( I ) + A( I, K )*DCONJG( B( J, K ) )
  3089.                      G( I ) = G( I ) + ABS1( A( I, K ) )*
  3090.      $                        ABS1( B( J, K ) )
  3091.    80             CONTINUE
  3092.    90          CONTINUE
  3093.             ELSE
  3094.                DO 110 K = 1, KK
  3095.                   DO 100 I = 1, M
  3096.                      CT( I ) = CT( I ) + A( I, K )*B( J, K )
  3097.                      G( I ) = G( I ) + ABS1( A( I, K ) )*
  3098.      $                        ABS1( B( J, K ) )
  3099.   100             CONTINUE
  3100.   110          CONTINUE
  3101.             END IF
  3102.          ELSE IF( TRANA.AND.TRANB )THEN
  3103.             IF( CTRANA )THEN
  3104.                IF( CTRANB )THEN
  3105.                   DO 130 K = 1, KK
  3106.                      DO 120 I = 1, M
  3107.                         CT( I ) = CT( I ) + DCONJG( A( K, I ) )*
  3108.      $                            DCONJG( B( J, K ) )
  3109.                         G( I ) = G( I ) + ABS1( A( K, I ) )*
  3110.      $                           ABS1( B( J, K ) )
  3111.   120                CONTINUE
  3112.   130             CONTINUE
  3113.                ELSE
  3114.                   DO 150 K = 1, KK
  3115.                      DO 140 I = 1, M
  3116.                         CT( I ) = CT( I ) + DCONJG( A( K, I ) )*
  3117.      $                            B( J, K )
  3118.                         G( I ) = G( I ) + ABS1( A( K, I ) )*
  3119.      $                           ABS1( B( J, K ) )
  3120.   140                CONTINUE
  3121.   150             CONTINUE
  3122.                END IF
  3123.             ELSE
  3124.                IF( CTRANB )THEN
  3125.                   DO 170 K = 1, KK
  3126.                      DO 160 I = 1, M
  3127.                         CT( I ) = CT( I ) + A( K, I )*
  3128.      $                            DCONJG( B( J, K ) )
  3129.                         G( I ) = G( I ) + ABS1( A( K, I ) )*
  3130.      $                           ABS1( B( J, K ) )
  3131.   160                CONTINUE
  3132.   170             CONTINUE
  3133.                ELSE
  3134.                   DO 190 K = 1, KK
  3135.                      DO 180 I = 1, M
  3136.                         CT( I ) = CT( I ) + A( K, I )*B( J, K )
  3137.                         G( I ) = G( I ) + ABS1( A( K, I ) )*
  3138.      $                           ABS1( B( J, K ) )
  3139.   180                CONTINUE
  3140.   190             CONTINUE
  3141.                END IF
  3142.             END IF
  3143.          END IF
  3144.          DO 200 I = 1, M
  3145.             CT( I ) = ALPHA*CT( I ) + BETA*C( I, J )
  3146.             G( I ) = ABS1( ALPHA )*G( I ) +
  3147.      $               ABS1( BETA )*ABS1( C( I, J ) )
  3148.   200    CONTINUE
  3149. *
  3150. *        Compute the error ratio for this result.
  3151. *
  3152.          ERR = ZERO
  3153.          DO 210 I = 1, M
  3154.             ERRI = ABS1( CT( I ) - CC( I, J ) )/EPS
  3155.             IF( G( I ).NE.RZERO )
  3156.      $         ERRI = ERRI/G( I )
  3157.             ERR = MAX( ERR, ERRI )
  3158.             IF( ERR*SQRT( EPS ).GE.RONE )
  3159.      $         GO TO 230
  3160.   210    CONTINUE
  3161. *
  3162.   220 CONTINUE
  3163. *
  3164. *     If the loop completes, all results are at least half accurate.
  3165.       GO TO 250
  3166. *
  3167. *     Report fatal error.
  3168. *
  3169.   230 FATAL = .TRUE.
  3170.       WRITE( NOUT, FMT = 9999 )
  3171.       DO 240 I = 1, M
  3172.          IF( MV )THEN
  3173.             WRITE( NOUT, FMT = 9998 )I, CT( I ), CC( I, J )
  3174.          ELSE
  3175.             WRITE( NOUT, FMT = 9998 )I, CC( I, J ), CT( I )
  3176.          END IF
  3177.   240 CONTINUE
  3178.       IF( N.GT.1 )
  3179.      $   WRITE( NOUT, FMT = 9997 )J
  3180. *
  3181.   250 CONTINUE
  3182.       RETURN
  3183. *
  3184.  9999 FORMAT( ' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL',
  3185.      $      'F ACCURATE *******', /'                       EXPECTED RE',
  3186.      $      'SULT                    COMPUTED RESULT' )
  3187.  9998 FORMAT( 1X, I7, 2( '  (', G15.6, ',', G15.6, ')' ) )
  3188.  9997 FORMAT( '      THESE ARE THE RESULTS FOR COLUMN ', I3 )
  3189. *
  3190. *     End of ZMMCH.
  3191. *
  3192.       END
  3193.       LOGICAL FUNCTION LZE( RI, RJ, LR )
  3194. *
  3195. *  Tests if two arrays are identical.
  3196. *
  3197. *  Auxiliary routine for test program for Level 3 Blas.
  3198. *
  3199. *  -- Written on 8-February-1989.
  3200. *     Jack Dongarra, Argonne National Laboratory.
  3201. *     Iain Duff, AERE Harwell.
  3202. *     Jeremy Du Croz, Numerical Algorithms Group Ltd.
  3203. *     Sven Hammarling, Numerical Algorithms Group Ltd.
  3204. *
  3205. *     .. Scalar Arguments ..
  3206.       INTEGER            LR
  3207. *     .. Array Arguments ..
  3208.       COMPLEX*16         RI( * ), RJ( * )
  3209. *     .. Local Scalars ..
  3210.       INTEGER            I
  3211. *     .. Executable Statements ..
  3212.       DO 10 I = 1, LR
  3213.          IF( RI( I ).NE.RJ( I ) )
  3214.      $      GO TO 20
  3215.    10 CONTINUE
  3216.       LZE = .TRUE.
  3217.       GO TO 30
  3218.    20 CONTINUE
  3219.       LZE = .FALSE.
  3220.    30 RETURN
  3221. *
  3222. *     End of LZE.
  3223. *
  3224.       END
  3225.       LOGICAL FUNCTION LZERES( TYPE, UPLO, M, N, AA, AS, LDA )
  3226. *
  3227. *  Tests if selected elements in two arrays are equal.
  3228. *
  3229. *  TYPE is 'GE' or 'HE' or 'SY'.
  3230. *
  3231. *  Auxiliary routine for test program for Level 3 Blas.
  3232. *
  3233. *  -- Written on 8-February-1989.
  3234. *     Jack Dongarra, Argonne National Laboratory.
  3235. *     Iain Duff, AERE Harwell.
  3236. *     Jeremy Du Croz, Numerical Algorithms Group Ltd.
  3237. *     Sven Hammarling, Numerical Algorithms Group Ltd.
  3238. *
  3239. *     .. Scalar Arguments ..
  3240.       INTEGER            LDA, M, N
  3241.       CHARACTER*1        UPLO
  3242.       CHARACTER*2        TYPE
  3243. *     .. Array Arguments ..
  3244.       COMPLEX*16         AA( LDA, * ), AS( LDA, * )
  3245. *     .. Local Scalars ..
  3246.       INTEGER            I, IBEG, IEND, J
  3247.       LOGICAL            UPPER
  3248. *     .. Executable Statements ..
  3249.       UPPER = UPLO.EQ.'U'
  3250.       IF( TYPE.EQ.'GE' )THEN
  3251.          DO 20 J = 1, N
  3252.             DO 10 I = M + 1, LDA
  3253.                IF( AA( I, J ).NE.AS( I, J ) )
  3254.      $            GO TO 70
  3255.    10       CONTINUE
  3256.    20    CONTINUE
  3257.       ELSE IF( TYPE.EQ.'HE'.OR.TYPE.EQ.'SY' )THEN
  3258.          DO 50 J = 1, N
  3259.             IF( UPPER )THEN
  3260.                IBEG = 1
  3261.                IEND = J
  3262.             ELSE
  3263.                IBEG = J
  3264.                IEND = N
  3265.             END IF
  3266.             DO 30 I = 1, IBEG - 1
  3267.                IF( AA( I, J ).NE.AS( I, J ) )
  3268.      $            GO TO 70
  3269.    30       CONTINUE
  3270.             DO 40 I = IEND + 1, LDA
  3271.                IF( AA( I, J ).NE.AS( I, J ) )
  3272.      $            GO TO 70
  3273.    40       CONTINUE
  3274.    50    CONTINUE
  3275.       END IF
  3276. *
  3277.    60 CONTINUE
  3278.       LZERES = .TRUE.
  3279.       GO TO 80
  3280.    70 CONTINUE
  3281.       LZERES = .FALSE.
  3282.    80 RETURN
  3283. *
  3284. *     End of LZERES.
  3285. *
  3286.       END
  3287.       COMPLEX*16     FUNCTION ZBEG( RESET )
  3288. *
  3289. *  Generates complex numbers as pairs of random numbers uniformly
  3290. *  distributed between -0.5 and 0.5.
  3291. *
  3292. *  Auxiliary routine for test program for Level 3 Blas.
  3293. *
  3294. *  -- Written on 8-February-1989.
  3295. *     Jack Dongarra, Argonne National Laboratory.
  3296. *     Iain Duff, AERE Harwell.
  3297. *     Jeremy Du Croz, Numerical Algorithms Group Ltd.
  3298. *     Sven Hammarling, Numerical Algorithms Group Ltd.
  3299. *
  3300. *     .. Scalar Arguments ..
  3301.       LOGICAL            RESET
  3302. *     .. Local Scalars ..
  3303.       INTEGER            I, IC, J, MI, MJ
  3304. *     .. Save statement ..
  3305.       SAVE               I, IC, J, MI, MJ
  3306. *     .. Intrinsic Functions ..
  3307.       INTRINSIC          DCMPLX
  3308. *     .. Executable Statements ..
  3309.       IF( RESET )THEN
  3310. *        Initialize local variables.
  3311.          MI = 891
  3312.          MJ = 457
  3313.          I = 7
  3314.          J = 7
  3315.          IC = 0
  3316.          RESET = .FALSE.
  3317.       END IF
  3318. *
  3319. *     The sequence of values of I or J is bounded between 1 and 999.
  3320. *     If initial I or J = 1,2,3,6,7 or 9, the period will be 50.
  3321. *     If initial I or J = 4 or 8, the period will be 25.
  3322. *     If initial I or J = 5, the period will be 10.
  3323. *     IC is used to break up the period by skipping 1 value of I or J
  3324. *     in 6.
  3325. *
  3326.       IC = IC + 1
  3327.    10 I = I*MI
  3328.       J = J*MJ
  3329.       I = I - 1000*( I/1000 )
  3330.       J = J - 1000*( J/1000 )
  3331.       IF( IC.GE.5 )THEN
  3332.          IC = 0
  3333.          GO TO 10
  3334.       END IF
  3335.       ZBEG = DCMPLX( ( I - 500 )/1001.0D0, ( J - 500 )/1001.0D0 )
  3336.       RETURN
  3337. *
  3338. *     End of ZBEG.
  3339. *
  3340.       END
  3341.       DOUBLE PRECISION FUNCTION DDIFF( X, Y )
  3342. *
  3343. *  Auxiliary routine for test program for Level 3 Blas.
  3344. *
  3345. *  -- Written on 8-February-1989.
  3346. *     Jack Dongarra, Argonne National Laboratory.
  3347. *     Iain Duff, AERE Harwell.
  3348. *     Jeremy Du Croz, Numerical Algorithms Group Ltd.
  3349. *     Sven Hammarling, Numerical Algorithms Group Ltd.
  3350. *
  3351. *     .. Scalar Arguments ..
  3352.       DOUBLE PRECISION   X, Y
  3353. *     .. Executable Statements ..
  3354.       DDIFF = X - Y
  3355.       RETURN
  3356. *
  3357. *     End of DDIFF.
  3358. *
  3359.       END
  3360.       SUBROUTINE CHKXER( SRNAMT, INFOT, NOUT, LERR, OK )
  3361. *
  3362. *  Tests whether XERBLA has detected an error when it should.
  3363. *
  3364. *  Auxiliary routine for test program for Level 3 Blas.
  3365. *
  3366. *  -- Written on 8-February-1989.
  3367. *     Jack Dongarra, Argonne National Laboratory.
  3368. *     Iain Duff, AERE Harwell.
  3369. *     Jeremy Du Croz, Numerical Algorithms Group Ltd.
  3370. *     Sven Hammarling, Numerical Algorithms Group Ltd.
  3371. *
  3372. *     .. Scalar Arguments ..
  3373.       INTEGER            INFOT, NOUT
  3374.       LOGICAL            LERR, OK
  3375.       CHARACTER*6        SRNAMT
  3376. *     .. Executable Statements ..
  3377.       IF( .NOT.LERR )THEN
  3378.          WRITE( NOUT, FMT = 9999 )INFOT, SRNAMT
  3379.          OK = .FALSE.
  3380.       END IF
  3381.       LERR = .FALSE.
  3382.       RETURN
  3383. *
  3384.  9999 FORMAT( ' ***** ILLEGAL VALUE OF PARAMETER NUMBER ', I2, ' NOT D',
  3385.      $      'ETECTED BY ', A6, ' *****' )
  3386. *
  3387. *     End of CHKXER.
  3388. *
  3389.       END
  3390.       SUBROUTINE XERBLA( SRNAME, INFO )
  3391. *
  3392. *  This is a special version of XERBLA to be used only as part of
  3393. *  the test program for testing error exits from the Level 3 BLAS
  3394. *  routines.
  3395. *
  3396. *  XERBLA  is an error handler for the Level 3 BLAS routines.
  3397. *
  3398. *  It is called by the Level 3 BLAS routines if an input parameter is
  3399. *  invalid.
  3400. *
  3401. *  Auxiliary routine for test program for Level 3 Blas.
  3402. *
  3403. *  -- Written on 8-February-1989.
  3404. *     Jack Dongarra, Argonne National Laboratory.
  3405. *     Iain Duff, AERE Harwell.
  3406. *     Jeremy Du Croz, Numerical Algorithms Group Ltd.
  3407. *     Sven Hammarling, Numerical Algorithms Group Ltd.
  3408. *
  3409. *     .. Scalar Arguments ..
  3410.       INTEGER            INFO
  3411.       CHARACTER*6        SRNAME
  3412. *     .. Scalars in Common ..
  3413.       INTEGER            INFOT, NOUT
  3414.       LOGICAL            LERR, OK
  3415.       CHARACTER*6        SRNAMT
  3416. *     .. Common blocks ..
  3417.       COMMON             /INFOC/INFOT, NOUT, OK, LERR
  3418.       COMMON             /SRNAMC/SRNAMT
  3419. *     .. Executable Statements ..
  3420.       LERR = .TRUE.
  3421.       IF( INFO.NE.INFOT )THEN
  3422.          IF( INFOT.NE.0 )THEN
  3423.             WRITE( NOUT, FMT = 9999 )INFO, INFOT
  3424.          ELSE
  3425.             WRITE( NOUT, FMT = 9997 )INFO
  3426.          END IF
  3427.          OK = .FALSE.
  3428.       END IF
  3429.       IF( SRNAME.NE.SRNAMT )THEN
  3430.          WRITE( NOUT, FMT = 9998 )SRNAME, SRNAMT
  3431.          OK = .FALSE.
  3432.       END IF
  3433.       RETURN
  3434. *
  3435.  9999 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6, ' INSTEAD',
  3436.      $      ' OF ', I2, ' *******' )
  3437.  9998 FORMAT( ' ******* XERBLA WAS CALLED WITH SRNAME = ', A6, ' INSTE',
  3438.      $      'AD OF ', A6, ' *******' )
  3439.  9997 FORMAT( ' ******* XERBLA WAS CALLED WITH INFO = ', I6,
  3440.      $      ' *******' )
  3441. *
  3442. *     End of XERBLA
  3443. *
  3444.       END
  3445.  
  3446.