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