99 parameter( nsubs = 9 )
101 parameter( zero = ( 0.0, 0.0 ), one = ( 1.0, 0.0 ) )
103 parameter( rzero = 0.0 )
105 parameter( nmax = 65 )
106 INTEGER nidmax, nalmax, nbemax
107 parameter( nidmax = 9, nalmax = 7, nbemax = 7 )
109 REAL eps, err, thresh
110 INTEGER i, isnum,
j, n, nalf, nbet, nidim, nout, ntra
111 LOGICAL fatal, ltestt, rewi, same, sfatal, trace,
113 CHARACTER*1 transa, transb
115 CHARACTER*32 snaps, summry
117 COMPLEX aa( nmax*nmax ), ab( nmax, 2*nmax ),
118 $ alf( nalmax ), as( nmax*nmax ),
119 $ bb( nmax*nmax ), bet( nbemax ),
120 $ bs( nmax*nmax ), c( nmax, nmax ),
121 $ cc( nmax*nmax ), cs( nmax*nmax ), ct( nmax ),
124 INTEGER idim( nidmax )
125 LOGICAL ltest( nsubs )
126 CHARACTER*6 snames( nsubs )
140 COMMON /infoc/infot, noutc, ok, lerr
141 COMMON /srnamc/srnamt
143 DATA snames/
'CGEMM ',
'CHEMM ',
'CSYMM ',
'CTRMM ',
144 $
'CTRSM ',
'CHERK ',
'CSYRK ',
'CHER2K',
150 READ( nin, fmt = * )summry
151 READ( nin, fmt = * )nout
152 OPEN( nout, file = summry )
157 READ( nin, fmt = * )snaps
158 READ( nin, fmt = * )ntra
161 OPEN( ntra, file = snaps )
164 READ( nin, fmt = * )rewi
165 rewi = rewi.AND.trace
167 READ( nin, fmt = * )sfatal
169 READ( nin, fmt = * )tsterr
171 READ( nin, fmt = * )thresh
176 READ( nin, fmt = * )nidim
177 IF( nidim.LT.1.OR.nidim.GT.nidmax )
THEN
178 WRITE( nout, fmt = 9997 )
'N', nidmax
181 READ( nin, fmt = * )( idim( i ), i = 1, nidim )
183 IF( idim( i ).LT.0.OR.idim( i ).GT.nmax )
THEN
184 WRITE( nout, fmt = 9996 )nmax
189 READ( nin, fmt = * )nalf
190 IF( nalf.LT.1.OR.nalf.GT.nalmax )
THEN
191 WRITE( nout, fmt = 9997 )
'ALPHA', nalmax
194 READ( nin, fmt = * )( alf( i ), i = 1, nalf )
196 READ( nin, fmt = * )nbet
197 IF( nbet.LT.1.OR.nbet.GT.nbemax )
THEN
198 WRITE( nout, fmt = 9997 )
'BETA', nbemax
201 READ( nin, fmt = * )( bet( i ), i = 1, nbet )
205 WRITE( nout, fmt = 9995 )
206 WRITE( nout, fmt = 9994 )( idim( i ), i = 1, nidim )
207 WRITE( nout, fmt = 9993 )( alf( i ), i = 1, nalf )
208 WRITE( nout, fmt = 9992 )( bet( i ), i = 1, nbet )
209 IF( .NOT.tsterr )
THEN
210 WRITE( nout, fmt = * )
211 WRITE( nout, fmt = 9984 )
213 WRITE( nout, fmt = * )
214 WRITE( nout, fmt = 9999 )thresh
215 WRITE( nout, fmt = * )
223 30
READ( nin, fmt = 9988,
END = 60 )snamet, ltestt
225 IF( snamet.EQ.snames( i ) )
228 WRITE( nout, fmt = 9990 )snamet
230 50 ltest( i ) = ltestt
239 WRITE( nout, fmt = 9998 )eps
246 ab( i,
j ) = max( i -
j + 1, 0 )
248 ab(
j, nmax + 1 ) =
j
249 ab( 1, nmax +
j ) =
j
253 cc(
j ) =
j*( (
j + 1 )*
j )/2 - ( (
j + 1 )*
j*(
j - 1 ) )/3
259 CALL
cmmch( transa, transb, n, 1, n, one, ab, nmax,
260 $ ab( 1, nmax + 1 ), nmax, zero, c, nmax, ct, g, cc,
261 $ nmax, eps, err, fatal, nout, .true. )
262 same =
lce( cc, ct, n )
263 IF( .NOT.same.OR.err.NE.rzero )
THEN
264 WRITE( nout, fmt = 9989 )transa, transb, same, err
268 CALL
cmmch( transa, transb, n, 1, n, one, ab, nmax,
269 $ ab( 1, nmax + 1 ), nmax, zero, c, nmax, ct, g, cc,
270 $ nmax, eps, err, fatal, nout, .true. )
271 same =
lce( cc, ct, n )
272 IF( .NOT.same.OR.err.NE.rzero )
THEN
273 WRITE( nout, fmt = 9989 )transa, transb, same, err
277 ab(
j, nmax + 1 ) = n -
j + 1
278 ab( 1, nmax +
j ) = n -
j + 1
281 cc( n -
j + 1 ) =
j*( (
j + 1 )*
j )/2 -
282 $ ( (
j + 1 )*
j*(
j - 1 ) )/3
286 CALL
cmmch( transa, transb, n, 1, n, one, ab, nmax,
287 $ ab( 1, nmax + 1 ), nmax, zero, c, nmax, ct, g, cc,
288 $ nmax, eps, err, fatal, nout, .true. )
289 same =
lce( cc, ct, n )
290 IF( .NOT.same.OR.err.NE.rzero )
THEN
291 WRITE( nout, fmt = 9989 )transa, transb, same, err
295 CALL
cmmch( transa, transb, n, 1, n, one, ab, nmax,
296 $ ab( 1, nmax + 1 ), nmax, zero, c, nmax, ct, g, cc,
297 $ nmax, eps, err, fatal, nout, .true. )
298 same =
lce( cc, ct, n )
299 IF( .NOT.same.OR.err.NE.rzero )
THEN
300 WRITE( nout, fmt = 9989 )transa, transb, same, err
306 DO 200 isnum = 1, nsubs
307 WRITE( nout, fmt = * )
308 IF( .NOT.ltest( isnum ) )
THEN
310 WRITE( nout, fmt = 9987 )snames( isnum )
312 srnamt = snames( isnum )
315 CALL
cchke( isnum, snames( isnum ), nout )
316 WRITE( nout, fmt = * )
322 go to( 140, 150, 150, 160, 160, 170, 170,
325 140 CALL
cchk1( snames( isnum ), eps, thresh, nout, ntra, trace,
326 $ rewi, fatal, nidim, idim, nalf, alf, nbet, bet,
327 $ nmax, ab, aa, as, ab( 1, nmax + 1 ), bb, bs, c,
331 150 CALL
cchk2( snames( isnum ), eps, thresh, nout, ntra, trace,
332 $ rewi, fatal, nidim, idim, nalf, alf, nbet, bet,
333 $ nmax, ab, aa, as, ab( 1, nmax + 1 ), bb, bs, c,
337 160 CALL
cchk3( snames( isnum ), eps, thresh, nout, ntra, trace,
338 $ rewi, fatal, nidim, idim, nalf, alf, nmax, ab,
339 $ aa, as, ab( 1, nmax + 1 ), bb, bs, ct, g, c )
342 170 CALL
cchk4( snames( isnum ), eps, thresh, nout, ntra, trace,
343 $ rewi, fatal, nidim, idim, nalf, alf, nbet, bet,
344 $ nmax, ab, aa, as, ab( 1, nmax + 1 ), bb, bs, c,
348 180 CALL
cchk5( snames( isnum ), eps, thresh, nout, ntra, trace,
349 $ rewi, fatal, nidim, idim, nalf, alf, nbet, bet,
350 $ nmax, ab, aa, as, bb, bs, c, cc, cs, ct, g, w )
353 190
IF( fatal.AND.sfatal )
357 WRITE( nout, fmt = 9986 )
361 WRITE( nout, fmt = 9985 )
365 WRITE( nout, fmt = 9991 )
373 9999
FORMAT(
' ROUTINES PASS COMPUTATIONAL TESTS IF TEST RATIO IS LES',
375 9998
FORMAT(
' RELATIVE MACHINE PRECISION IS TAKEN TO BE', 1p, e9.1 )
376 9997
FORMAT(
' NUMBER OF VALUES OF ', a,
' IS LESS THAN 1 OR GREATER ',
378 9996
FORMAT(
' VALUE OF N IS LESS THAN 0 OR GREATER THAN ', i2 )
379 9995
FORMAT(
' TESTS OF THE COMPLEX LEVEL 3 BLAS', //
' THE F',
380 $
'OLLOWING PARAMETER VALUES WILL BE USED:' )
381 9994
FORMAT(
' FOR N ', 9i6 )
382 9993
FORMAT(
' FOR ALPHA ',
383 $ 7(
'(', f4.1,
',', f4.1,
') ', : ) )
384 9992
FORMAT(
' FOR BETA ',
385 $ 7(
'(', f4.1,
',', f4.1,
') ', : ) )
386 9991
FORMAT(
' AMEND DATA FILE OR INCREASE ARRAY SIZES IN PROGRAM',
387 $ /
' ******* TESTS ABANDONED *******' )
388 9990
FORMAT(
' SUBPROGRAM NAME ', a6,
' NOT RECOGNIZED', /
' ******* T',
389 $
'ESTS ABANDONED *******' )
390 9989
FORMAT(
' ERROR IN CMMCH - IN-LINE DOT PRODUCTS ARE BEING EVALU',
391 $
'ATED WRONGLY.', /
' CMMCH WAS CALLED WITH TRANSA = ', a1,
392 $
' AND TRANSB = ', a1, /
' AND RETURNED SAME = ', l1,
' AND ',
393 $
'ERR = ', f12.3,
'.', /
' THIS MAY BE DUE TO FAULTS IN THE ',
394 $
'ARITHMETIC OR THE COMPILER.', /
' ******* TESTS ABANDONED ',
396 9988
FORMAT( a6, l2 )
397 9987
FORMAT( 1x, a6,
' WAS NOT TESTED' )
398 9986
FORMAT( /
' END OF TESTS' )
399 9985
FORMAT( /
' ******* FATAL ERROR - TESTS ABANDONED *******' )
400 9984
FORMAT(
' ERROR-EXITS WILL NOT BE TESTED' )
405 SUBROUTINE cchk1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
406 $ fatal, nidim, idim, nalf, alf, nbet, bet, nmax,
407 $ a, aa, as,
b, bb, bs, c, cc, cs, ct, g )
421 parameter( zero = ( 0.0, 0.0 ) )
423 parameter( rzero = 0.0 )
426 INTEGER nalf, nbet, nidim, nmax, nout, ntra
427 LOGICAL fatal, rewi, trace
430 COMPLEX a( nmax, nmax ), aa( nmax*nmax ), alf( nalf ),
431 $ as( nmax*nmax ),
b( nmax, nmax ),
432 $ bb( nmax*nmax ), bet( nbet ), bs( nmax*nmax ),
433 $ c( nmax, nmax ), cc( nmax*nmax ),
434 $ cs( nmax*nmax ), ct( nmax )
436 INTEGER idim( nidim )
438 COMPLEX alpha, als, beta, bls
440 INTEGER i, ia, ib, ica, icb, ik, im, in, k, ks, laa,
441 $ lbb, lcc, lda, ldas, ldb, ldbs, ldc, ldcs, m,
442 $ ma, mb, ms, n, na, nargs, nb, nc, ns
443 LOGICAL null, reset, same, trana, tranb
444 CHARACTER*1 tranas, tranbs, transa, transb
459 COMMON /infoc/infot, noutc, ok, lerr
482 null = n.LE.0.OR.m.LE.0
488 transa = ich( ica: ica )
489 trana = transa.EQ.
'T'.OR.transa.EQ.
'C'
509 CALL
cmake(
'GE',
' ',
' ', ma, na, a, nmax, aa, lda,
513 transb = ich( icb: icb )
514 tranb = transb.EQ.
'T'.OR.transb.EQ.
'C'
534 CALL
cmake(
'GE',
' ',
' ', mb, nb,
b, nmax, bb,
545 CALL
cmake(
'GE',
' ',
' ', m, n, c, nmax,
546 $ cc, ldc, reset, zero )
576 $
WRITE( ntra, fmt = 9995 )nc, sname,
577 $ transa, transb, m, n, k, alpha, lda, ldb,
581 CALL
cgemm( transa, transb, m, n, k, alpha,
582 $ aa, lda, bb, ldb, beta, cc, ldc )
587 WRITE( nout, fmt = 9994 )
594 isame( 1 ) = transa.EQ.tranas
595 isame( 2 ) = transb.EQ.tranbs
599 isame( 6 ) = als.EQ.alpha
600 isame( 7 ) =
lce( as, aa, laa )
601 isame( 8 ) = ldas.EQ.lda
602 isame( 9 ) =
lce( bs, bb, lbb )
603 isame( 10 ) = ldbs.EQ.ldb
604 isame( 11 ) = bls.EQ.beta
606 isame( 12 ) =
lce( cs, cc, lcc )
608 isame( 12 ) =
lceres(
'GE',
' ', m, n, cs,
611 isame( 13 ) = ldcs.EQ.ldc
618 same = same.AND.isame( i )
619 IF( .NOT.isame( i ) )
620 $
WRITE( nout, fmt = 9998 )i
631 CALL
cmmch( transa, transb, m, n, k,
632 $ alpha, a, nmax,
b, nmax, beta,
633 $ c, nmax, ct, g, cc, ldc, eps,
634 $ err, fatal, nout, .true. )
635 errmax = max( errmax, err )
658 IF( errmax.LT.thresh )
THEN
659 WRITE( nout, fmt = 9999 )sname, nc
661 WRITE( nout, fmt = 9997 )sname, nc, errmax
666 WRITE( nout, fmt = 9996 )sname
667 WRITE( nout, fmt = 9995 )nc, sname, transa, transb, m, n, k,
668 $ alpha, lda, ldb, beta, ldc
673 9999
FORMAT(
' ', a6,
' PASSED THE COMPUTATIONAL TESTS (', i6,
' CALL',
675 9998
FORMAT(
' ******* FATAL ERROR - PARAMETER NUMBER ', i2,
' WAS CH',
676 $
'ANGED INCORRECTLY *******' )
677 9997
FORMAT(
' ', a6,
' COMPLETED THE COMPUTATIONAL TESTS (', i6,
' C',
678 $
'ALLS)', /
' ******* BUT WITH MAXIMUM TEST RATIO', f8.2,
679 $
' - SUSPECT *******' )
680 9996
FORMAT(
' ******* ', a6,
' FAILED ON CALL NUMBER:' )
681 9995
FORMAT( 1x, i6,
': ', a6,
'(''', a1,
''',''', a1,
''',',
682 $ 3( i3,
',' ),
'(', f4.1,
',', f4.1,
'), A,', i3,
', B,', i3,
683 $
',(', f4.1,
',', f4.1,
'), C,', i3,
').' )
684 9994
FORMAT(
' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
690 SUBROUTINE cchk2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
691 $ fatal, nidim, idim, nalf, alf, nbet, bet, nmax,
692 $ a, aa, as,
b, bb, bs, c, cc, cs, ct, g )
706 parameter( zero = ( 0.0, 0.0 ) )
708 parameter( rzero = 0.0 )
711 INTEGER nalf, nbet, nidim, nmax, nout, ntra
712 LOGICAL fatal, rewi, trace
715 COMPLEX a( nmax, nmax ), aa( nmax*nmax ), alf( nalf ),
716 $ as( nmax*nmax ),
b( nmax, nmax ),
717 $ bb( nmax*nmax ), bet( nbet ), bs( nmax*nmax ),
718 $ c( nmax, nmax ), cc( nmax*nmax ),
719 $ cs( nmax*nmax ), ct( nmax )
721 INTEGER idim( nidim )
723 COMPLEX alpha, als, beta, bls
725 INTEGER i, ia, ib, ics, icu, im, in, laa, lbb, lcc,
726 $ lda, ldas, ldb, ldbs, ldc, ldcs, m, ms, n, na,
728 LOGICAL conj, left, null, reset, same
729 CHARACTER*1 side, sides, uplo, uplos
730 CHARACTER*2 ichs, ichu
744 COMMON /infoc/infot, noutc, ok, lerr
746 DATA ichs/
'LR'/, ichu/
'UL'/
748 conj = sname( 2: 3 ).EQ.
'HE'
768 null = n.LE.0.OR.m.LE.0
780 CALL
cmake(
'GE',
' ',
' ', m, n,
b, nmax, bb, ldb, reset,
784 side = ichs( ics: ics )
802 uplo = ichu( icu: icu )
806 CALL
cmake( sname( 2: 3 ), uplo,
' ', na, na, a, nmax,
807 $ aa, lda, reset, zero )
817 CALL
cmake(
'GE',
' ',
' ', m, n, c, nmax, cc,
847 $
WRITE( ntra, fmt = 9995 )nc, sname, side,
848 $ uplo, m, n, alpha, lda, ldb, beta, ldc
852 CALL
chemm( side, uplo, m, n, alpha, aa, lda,
853 $ bb, ldb, beta, cc, ldc )
855 CALL
csymm( side, uplo, m, n, alpha, aa, lda,
856 $ bb, ldb, beta, cc, ldc )
862 WRITE( nout, fmt = 9994 )
869 isame( 1 ) = sides.EQ.side
870 isame( 2 ) = uplos.EQ.uplo
873 isame( 5 ) = als.EQ.alpha
874 isame( 6 ) =
lce( as, aa, laa )
875 isame( 7 ) = ldas.EQ.lda
876 isame( 8 ) =
lce( bs, bb, lbb )
877 isame( 9 ) = ldbs.EQ.ldb
878 isame( 10 ) = bls.EQ.beta
880 isame( 11 ) =
lce( cs, cc, lcc )
882 isame( 11 ) =
lceres(
'GE',
' ', m, n, cs,
885 isame( 12 ) = ldcs.EQ.ldc
892 same = same.AND.isame( i )
893 IF( .NOT.isame( i ) )
894 $
WRITE( nout, fmt = 9998 )i
906 CALL
cmmch(
'N',
'N', m, n, m, alpha, a,
907 $ nmax,
b, nmax, beta, c, nmax,
908 $ ct, g, cc, ldc, eps, err,
909 $ fatal, nout, .true. )
911 CALL
cmmch(
'N',
'N', m, n, n, alpha,
b,
912 $ nmax, a, nmax, beta, c, nmax,
913 $ ct, g, cc, ldc, eps, err,
914 $ fatal, nout, .true. )
916 errmax = max( errmax, err )
937 IF( errmax.LT.thresh )
THEN
938 WRITE( nout, fmt = 9999 )sname, nc
940 WRITE( nout, fmt = 9997 )sname, nc, errmax
945 WRITE( nout, fmt = 9996 )sname
946 WRITE( nout, fmt = 9995 )nc, sname, side, uplo, m, n, alpha, lda,
952 9999
FORMAT(
' ', a6,
' PASSED THE COMPUTATIONAL TESTS (', i6,
' CALL',
954 9998
FORMAT(
' ******* FATAL ERROR - PARAMETER NUMBER ', i2,
' WAS CH',
955 $
'ANGED INCORRECTLY *******' )
956 9997
FORMAT(
' ', a6,
' COMPLETED THE COMPUTATIONAL TESTS (', i6,
' C',
957 $
'ALLS)', /
' ******* BUT WITH MAXIMUM TEST RATIO', f8.2,
958 $
' - SUSPECT *******' )
959 9996
FORMAT(
' ******* ', a6,
' FAILED ON CALL NUMBER:' )
960 9995
FORMAT( 1x, i6,
': ', a6,
'(', 2(
'''', a1,
''',' ), 2( i3,
',' ),
961 $
'(', f4.1,
',', f4.1,
'), A,', i3,
', B,', i3,
',(', f4.1,
962 $
',', f4.1,
'), C,', i3,
') .' )
963 9994
FORMAT(
' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
969 SUBROUTINE cchk3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
970 $ fatal, nidim, idim, nalf, alf, nmax, a, aa, as,
971 $
b, bb, bs, ct, g, c )
985 parameter( zero = ( 0.0, 0.0 ), one = ( 1.0, 0.0 ) )
987 parameter( rzero = 0.0 )
990 INTEGER nalf, nidim, nmax, nout, ntra
991 LOGICAL fatal, rewi, trace
994 COMPLEX a( nmax, nmax ), aa( nmax*nmax ), alf( nalf ),
995 $ as( nmax*nmax ),
b( nmax, nmax ),
996 $ bb( nmax*nmax ), bs( nmax*nmax ),
997 $ c( nmax, nmax ), ct( nmax )
999 INTEGER idim( nidim )
1003 INTEGER i, ia, icd, ics, ict, icu, im, in,
j, laa, lbb,
1004 $ lda, ldas, ldb, ldbs, m, ms, n, na, nargs, nc,
1006 LOGICAL left, null, reset, same
1007 CHARACTER*1 diag, diags, side, sides, tranas, transa, uplo,
1009 CHARACTER*2 ichd, ichs, ichu
1021 INTEGER infot, noutc
1024 COMMON /infoc/infot, noutc, ok, lerr
1026 DATA ichu/
'UL'/, icht/
'NTC'/, ichd/
'UN'/, ichs/
'LR'/
1040 DO 140 im = 1, nidim
1043 DO 130 in = 1, nidim
1053 null = m.LE.0.OR.n.LE.0
1056 side = ichs( ics: ics )
1073 uplo = ichu( icu: icu )
1076 transa = icht( ict: ict )
1079 diag = ichd( icd: icd )
1086 CALL
cmake(
'TR', uplo, diag, na, na, a,
1087 $ nmax, aa, lda, reset, zero )
1091 CALL
cmake(
'GE',
' ',
' ', m, n,
b, nmax,
1092 $ bb, ldb, reset, zero )
1117 IF( sname( 4: 5 ).EQ.
'MM' )
THEN
1119 $
WRITE( ntra, fmt = 9995 )nc, sname,
1120 $ side, uplo, transa, diag, m, n, alpha,
1124 CALL
ctrmm( side, uplo, transa, diag, m,
1125 $ n, alpha, aa, lda, bb, ldb )
1126 ELSE IF( sname( 4: 5 ).EQ.
'SM' )
THEN
1128 $
WRITE( ntra, fmt = 9995 )nc, sname,
1129 $ side, uplo, transa, diag, m, n, alpha,
1133 CALL
ctrsm( side, uplo, transa, diag, m,
1134 $ n, alpha, aa, lda, bb, ldb )
1140 WRITE( nout, fmt = 9994 )
1147 isame( 1 ) = sides.EQ.side
1148 isame( 2 ) = uplos.EQ.uplo
1149 isame( 3 ) = tranas.EQ.transa
1150 isame( 4 ) = diags.EQ.diag
1151 isame( 5 ) = ms.EQ.m
1152 isame( 6 ) = ns.EQ.n
1153 isame( 7 ) = als.EQ.alpha
1154 isame( 8 ) =
lce( as, aa, laa )
1155 isame( 9 ) = ldas.EQ.lda
1157 isame( 10 ) =
lce( bs, bb, lbb )
1159 isame( 10 ) =
lceres(
'GE',
' ', m, n, bs,
1162 isame( 11 ) = ldbs.EQ.ldb
1169 same = same.AND.isame( i )
1170 IF( .NOT.isame( i ) )
1171 $
WRITE( nout, fmt = 9998 )i
1179 IF( sname( 4: 5 ).EQ.
'MM' )
THEN
1184 CALL
cmmch( transa,
'N', m, n, m,
1185 $ alpha, a, nmax,
b, nmax,
1186 $ zero, c, nmax, ct, g,
1187 $ bb, ldb, eps, err,
1188 $ fatal, nout, .true. )
1190 CALL
cmmch(
'N', transa, m, n, n,
1191 $ alpha,
b, nmax, a, nmax,
1192 $ zero, c, nmax, ct, g,
1193 $ bb, ldb, eps, err,
1194 $ fatal, nout, .true. )
1196 ELSE IF( sname( 4: 5 ).EQ.
'SM' )
THEN
1203 c( i,
j ) = bb( i + (
j - 1 )*
1205 bb( i + (
j - 1 )*ldb ) = alpha*
1211 CALL
cmmch( transa,
'N', m, n, m,
1212 $ one, a, nmax, c, nmax,
1213 $ zero,
b, nmax, ct, g,
1214 $ bb, ldb, eps, err,
1215 $ fatal, nout, .false. )
1217 CALL
cmmch(
'N', transa, m, n, n,
1218 $ one, c, nmax, a, nmax,
1219 $ zero,
b, nmax, ct, g,
1220 $ bb, ldb, eps, err,
1221 $ fatal, nout, .false. )
1224 errmax = max( errmax, err )
1247 IF( errmax.LT.thresh )
THEN
1248 WRITE( nout, fmt = 9999 )sname, nc
1250 WRITE( nout, fmt = 9997 )sname, nc, errmax
1255 WRITE( nout, fmt = 9996 )sname
1256 WRITE( nout, fmt = 9995 )nc, sname, side, uplo, transa, diag, m,
1257 $ n, alpha, lda, ldb
1262 9999
FORMAT(
' ', a6,
' PASSED THE COMPUTATIONAL TESTS (', i6,
' CALL',
1264 9998
FORMAT(
' ******* FATAL ERROR - PARAMETER NUMBER ', i2,
' WAS CH',
1265 $
'ANGED INCORRECTLY *******' )
1266 9997
FORMAT(
' ', a6,
' COMPLETED THE COMPUTATIONAL TESTS (', i6,
' C',
1267 $
'ALLS)', /
' ******* BUT WITH MAXIMUM TEST RATIO', f8.2,
1268 $
' - SUSPECT *******' )
1269 9996
FORMAT(
' ******* ', a6,
' FAILED ON CALL NUMBER:' )
1270 9995
FORMAT( 1x, i6,
': ', a6,
'(', 4(
'''', a1,
''',' ), 2( i3,
',' ),
1271 $
'(', f4.1,
',', f4.1,
'), A,', i3,
', B,', i3,
') ',
1273 9994
FORMAT(
' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
1279 SUBROUTINE cchk4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
1280 $ fatal, nidim, idim, nalf, alf, nbet, bet, nmax,
1281 $ a, aa, as,
b, bb, bs, c, cc, cs, ct, g )
1295 parameter( zero = ( 0.0, 0.0 ) )
1297 parameter( rone = 1.0, rzero = 0.0 )
1300 INTEGER nalf, nbet, nidim, nmax, nout, ntra
1301 LOGICAL fatal, rewi, trace
1304 COMPLEX a( nmax, nmax ), aa( nmax*nmax ), alf( nalf ),
1305 $ as( nmax*nmax ),
b( nmax, nmax ),
1306 $ bb( nmax*nmax ), bet( nbet ), bs( nmax*nmax ),
1307 $ c( nmax, nmax ), cc( nmax*nmax ),
1308 $ cs( nmax*nmax ), ct( nmax )
1310 INTEGER idim( nidim )
1312 COMPLEX alpha, als, beta, bets
1313 REAL err, errmax, ralpha, rals, rbeta, rbets
1314 INTEGER i, ia, ib, ict, icu, ik, in,
j, jc, jj, k, ks,
1315 $ laa, lcc, lda, ldas, ldc, ldcs, lj, ma, n, na,
1317 LOGICAL conj, null, reset, same, tran, upper
1318 CHARACTER*1 trans, transs, transt, uplo, uplos
1319 CHARACTER*2 icht, ichu
1328 INTRINSIC cmplx, max, real
1330 INTEGER infot, noutc
1333 COMMON /infoc/infot, noutc, ok, lerr
1335 DATA icht/
'NC'/, ichu/
'UL'/
1337 conj = sname( 2: 3 ).EQ.
'HE'
1344 DO 100 in = 1, nidim
1359 trans = icht( ict: ict )
1361 IF( tran.AND..NOT.conj )
1381 CALL
cmake(
'GE',
' ',
' ', ma, na, a, nmax, aa, lda,
1385 uplo = ichu( icu: icu )
1391 ralpha =
REAL( alpha )
1392 alpha = cmplx( ralpha, rzero )
1398 rbeta =
REAL( beta )
1399 beta = cmplx( rbeta, rzero )
1403 $ null = null.OR.( ( k.LE.0.OR.ralpha.EQ.
1404 $ rzero ).AND.rbeta.EQ.rone )
1408 CALL
cmake( sname( 2: 3 ), uplo,
' ', n, n, c,
1409 $ nmax, cc, ldc, reset, zero )
1442 $
WRITE( ntra, fmt = 9994 )nc, sname, uplo,
1443 $ trans, n, k, ralpha, lda, rbeta, ldc
1446 CALL
cherk( uplo, trans, n, k, ralpha, aa,
1447 $ lda, rbeta, cc, ldc )
1450 $
WRITE( ntra, fmt = 9993 )nc, sname, uplo,
1451 $ trans, n, k, alpha, lda, beta, ldc
1454 CALL
csyrk( uplo, trans, n, k, alpha, aa,
1455 $ lda, beta, cc, ldc )
1461 WRITE( nout, fmt = 9992 )
1468 isame( 1 ) = uplos.EQ.uplo
1469 isame( 2 ) = transs.EQ.trans
1470 isame( 3 ) = ns.EQ.n
1471 isame( 4 ) = ks.EQ.k
1473 isame( 5 ) = rals.EQ.ralpha
1475 isame( 5 ) = als.EQ.alpha
1477 isame( 6 ) =
lce( as, aa, laa )
1478 isame( 7 ) = ldas.EQ.lda
1480 isame( 8 ) = rbets.EQ.rbeta
1482 isame( 8 ) = bets.EQ.beta
1485 isame( 9 ) =
lce( cs, cc, lcc )
1487 isame( 9 ) =
lceres( sname( 2: 3 ), uplo, n,
1490 isame( 10 ) = ldcs.EQ.ldc
1497 same = same.AND.isame( i )
1498 IF( .NOT.isame( i ) )
1499 $
WRITE( nout, fmt = 9998 )i
1525 CALL
cmmch( transt,
'N', lj, 1, k,
1526 $ alpha, a( 1, jj ), nmax,
1527 $ a( 1,
j ), nmax, beta,
1528 $ c( jj,
j ), nmax, ct, g,
1529 $ cc( jc ), ldc, eps, err,
1530 $ fatal, nout, .true. )
1532 CALL
cmmch(
'N', transt, lj, 1, k,
1533 $ alpha, a( jj, 1 ), nmax,
1534 $ a(
j, 1 ), nmax, beta,
1535 $ c( jj,
j ), nmax, ct, g,
1536 $ cc( jc ), ldc, eps, err,
1537 $ fatal, nout, .true. )
1544 errmax = max( errmax, err )
1566 IF( errmax.LT.thresh )
THEN
1567 WRITE( nout, fmt = 9999 )sname, nc
1569 WRITE( nout, fmt = 9997 )sname, nc, errmax
1575 $
WRITE( nout, fmt = 9995 )
j
1578 WRITE( nout, fmt = 9996 )sname
1580 WRITE( nout, fmt = 9994 )nc, sname, uplo, trans, n, k, ralpha,
1583 WRITE( nout, fmt = 9993 )nc, sname, uplo, trans, n, k, alpha,
1590 9999
FORMAT(
' ', a6,
' PASSED THE COMPUTATIONAL TESTS (', i6,
' CALL',
1592 9998
FORMAT(
' ******* FATAL ERROR - PARAMETER NUMBER ', i2,
' WAS CH',
1593 $
'ANGED INCORRECTLY *******' )
1594 9997
FORMAT(
' ', a6,
' COMPLETED THE COMPUTATIONAL TESTS (', i6,
' C',
1595 $
'ALLS)', /
' ******* BUT WITH MAXIMUM TEST RATIO', f8.2,
1596 $
' - SUSPECT *******' )
1597 9996
FORMAT(
' ******* ', a6,
' FAILED ON CALL NUMBER:' )
1598 9995
FORMAT(
' THESE ARE THE RESULTS FOR COLUMN ', i3 )
1599 9994
FORMAT( 1x, i6,
': ', a6,
'(', 2(
'''', a1,
''',' ), 2( i3,
',' ),
1600 $ f4.1,
', A,', i3,
',', f4.1,
', C,', i3,
') ',
1602 9993
FORMAT( 1x, i6,
': ', a6,
'(', 2(
'''', a1,
''',' ), 2( i3,
',' ),
1603 $
'(', f4.1,
',', f4.1,
') , A,', i3,
',(', f4.1,
',', f4.1,
1604 $
'), C,', i3,
') .' )
1605 9992
FORMAT(
' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
1611 SUBROUTINE cchk5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
1612 $ fatal, nidim, idim, nalf, alf, nbet, bet, nmax,
1613 $ ab, aa, as, bb, bs, c, cc, cs, ct, g, w )
1627 parameter( zero = ( 0.0, 0.0 ), one = ( 1.0, 0.0 ) )
1629 parameter( rone = 1.0, rzero = 0.0 )
1632 INTEGER nalf, nbet, nidim, nmax, nout, ntra
1633 LOGICAL fatal, rewi, trace
1636 COMPLEX aa( nmax*nmax ), ab( 2*nmax*nmax ),
1637 $ alf( nalf ), as( nmax*nmax ), bb( nmax*nmax ),
1638 $ bet( nbet ), bs( nmax*nmax ), c( nmax, nmax ),
1639 $ cc( nmax*nmax ), cs( nmax*nmax ), ct( nmax ),
1642 INTEGER idim( nidim )
1644 COMPLEX alpha, als, beta, bets
1645 REAL err, errmax, rbeta, rbets
1646 INTEGER i, ia, ib, ict, icu, ik, in,
j, jc, jj, jjab,
1647 $ k, ks, laa, lbb, lcc, lda, ldas, ldb, ldbs,
1648 $ ldc, ldcs, lj, ma, n, na, nargs, nc, ns
1649 LOGICAL conj, null, reset, same, tran, upper
1650 CHARACTER*1 trans, transs, transt, uplo, uplos
1651 CHARACTER*2 icht, ichu
1660 INTRINSIC cmplx, conjg, max, real
1662 INTEGER infot, noutc
1665 COMMON /infoc/infot, noutc, ok, lerr
1667 DATA icht/
'NC'/, ichu/
'UL'/
1669 conj = sname( 2: 3 ).EQ.
'HE'
1676 DO 130 in = 1, nidim
1687 DO 120 ik = 1, nidim
1691 trans = icht( ict: ict )
1693 IF( tran.AND..NOT.conj )
1714 CALL
cmake(
'GE',
' ',
' ', ma, na, ab, 2*nmax, aa,
1715 $ lda, reset, zero )
1717 CALL
cmake(
'GE',
' ',
' ', ma, na, ab, nmax, aa, lda,
1726 CALL
cmake(
'GE',
' ',
' ', ma, na, ab( k + 1 ),
1727 $ 2*nmax, bb, ldb, reset, zero )
1729 CALL
cmake(
'GE',
' ',
' ', ma, na, ab( k*nmax + 1 ),
1730 $ nmax, bb, ldb, reset, zero )
1734 uplo = ichu( icu: icu )
1743 rbeta =
REAL( beta )
1744 beta = cmplx( rbeta, rzero )
1748 $ null = null.OR.( ( k.LE.0.OR.alpha.EQ.
1749 $ zero ).AND.rbeta.EQ.rone )
1753 CALL
cmake( sname( 2: 3 ), uplo,
' ', n, n, c,
1754 $ nmax, cc, ldc, reset, zero )
1787 $
WRITE( ntra, fmt = 9994 )nc, sname, uplo,
1788 $ trans, n, k, alpha, lda, ldb, rbeta, ldc
1791 CALL
cher2k( uplo, trans, n, k, alpha, aa,
1792 $ lda, bb, ldb, rbeta, cc, ldc )
1795 $
WRITE( ntra, fmt = 9993 )nc, sname, uplo,
1796 $ trans, n, k, alpha, lda, ldb, beta, ldc
1799 CALL
csyr2k( uplo, trans, n, k, alpha, aa,
1800 $ lda, bb, ldb, beta, cc, ldc )
1806 WRITE( nout, fmt = 9992 )
1813 isame( 1 ) = uplos.EQ.uplo
1814 isame( 2 ) = transs.EQ.trans
1815 isame( 3 ) = ns.EQ.n
1816 isame( 4 ) = ks.EQ.k
1817 isame( 5 ) = als.EQ.alpha
1818 isame( 6 ) =
lce( as, aa, laa )
1819 isame( 7 ) = ldas.EQ.lda
1820 isame( 8 ) =
lce( bs, bb, lbb )
1821 isame( 9 ) = ldbs.EQ.ldb
1823 isame( 10 ) = rbets.EQ.rbeta
1825 isame( 10 ) = bets.EQ.beta
1828 isame( 11 ) =
lce( cs, cc, lcc )
1830 isame( 11 ) =
lceres(
'HE', uplo, n, n, cs,
1833 isame( 12 ) = ldcs.EQ.ldc
1840 same = same.AND.isame( i )
1841 IF( .NOT.isame( i ) )
1842 $
WRITE( nout, fmt = 9998 )i
1870 w( i ) = alpha*ab( (
j - 1 )*2*
1873 w( k + i ) = conjg( alpha )*
1882 CALL
cmmch( transt,
'N', lj, 1, 2*k,
1883 $ one, ab( jjab ), 2*nmax, w,
1884 $ 2*nmax, beta, c( jj,
j ),
1885 $ nmax, ct, g, cc( jc ), ldc,
1886 $ eps, err, fatal, nout,
1891 w( i ) = alpha*conjg( ab( ( k +
1892 $ i - 1 )*nmax +
j ) )
1893 w( k + i ) = conjg( alpha*
1894 $ ab( ( i - 1 )*nmax +
1897 w( i ) = alpha*ab( ( k + i - 1 )*
1900 $ ab( ( i - 1 )*nmax +
1904 CALL
cmmch(
'N',
'N', lj, 1, 2*k, one,
1905 $ ab( jj ), nmax, w, 2*nmax,
1906 $ beta, c( jj,
j ), nmax, ct,
1907 $ g, cc( jc ), ldc, eps, err,
1908 $ fatal, nout, .true. )
1915 $ jjab = jjab + 2*nmax
1917 errmax = max( errmax, err )
1939 IF( errmax.LT.thresh )
THEN
1940 WRITE( nout, fmt = 9999 )sname, nc
1942 WRITE( nout, fmt = 9997 )sname, nc, errmax
1948 $
WRITE( nout, fmt = 9995 )
j
1951 WRITE( nout, fmt = 9996 )sname
1953 WRITE( nout, fmt = 9994 )nc, sname, uplo, trans, n, k, alpha,
1954 $ lda, ldb, rbeta, ldc
1956 WRITE( nout, fmt = 9993 )nc, sname, uplo, trans, n, k, alpha,
1957 $ lda, ldb, beta, ldc
1963 9999
FORMAT(
' ', a6,
' PASSED THE COMPUTATIONAL TESTS (', i6,
' CALL',
1965 9998
FORMAT(
' ******* FATAL ERROR - PARAMETER NUMBER ', i2,
' WAS CH',
1966 $
'ANGED INCORRECTLY *******' )
1967 9997
FORMAT(
' ', a6,
' COMPLETED THE COMPUTATIONAL TESTS (', i6,
' C',
1968 $
'ALLS)', /
' ******* BUT WITH MAXIMUM TEST RATIO', f8.2,
1969 $
' - SUSPECT *******' )
1970 9996
FORMAT(
' ******* ', a6,
' FAILED ON CALL NUMBER:' )
1971 9995
FORMAT(
' THESE ARE THE RESULTS FOR COLUMN ', i3 )
1972 9994
FORMAT( 1x, i6,
': ', a6,
'(', 2(
'''', a1,
''',' ), 2( i3,
',' ),
1973 $
'(', f4.1,
',', f4.1,
'), A,', i3,
', B,', i3,
',', f4.1,
1974 $
', C,', i3,
') .' )
1975 9993
FORMAT( 1x, i6,
': ', a6,
'(', 2(
'''', a1,
''',' ), 2( i3,
',' ),
1976 $
'(', f4.1,
',', f4.1,
'), A,', i3,
', B,', i3,
',(', f4.1,
1977 $
',', f4.1,
'), C,', i3,
') .' )
1978 9992
FORMAT(
' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
2006 INTEGER infot, noutc
2010 parameter( one = 1.0e0, two = 2.0e0 )
2015 COMPLEX a( 2, 1 ),
b( 2, 1 ), c( 2, 1 )
2020 COMMON /infoc/infot, noutc, ok, lerr
2031 alpha = cmplx( one, -one )
2032 beta = cmplx( two, -two )
2036 go to( 10, 20, 30, 40, 50, 60, 70, 80,
2039 CALL
cgemm(
'/',
'N', 0, 0, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2040 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2042 CALL
cgemm(
'/',
'C', 0, 0, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2043 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2045 CALL
cgemm(
'/',
'T', 0, 0, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2046 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2048 CALL
cgemm(
'N',
'/', 0, 0, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2049 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2051 CALL
cgemm(
'C',
'/', 0, 0, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2052 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2054 CALL
cgemm(
'T',
'/', 0, 0, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2055 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2057 CALL
cgemm(
'N',
'N', -1, 0, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2058 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2060 CALL
cgemm(
'N',
'C', -1, 0, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2061 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2063 CALL
cgemm(
'N',
'T', -1, 0, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2064 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2066 CALL
cgemm(
'C',
'N', -1, 0, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2067 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2069 CALL
cgemm(
'C',
'C', -1, 0, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2070 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2072 CALL
cgemm(
'C',
'T', -1, 0, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2073 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2075 CALL
cgemm(
'T',
'N', -1, 0, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2076 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2078 CALL
cgemm(
'T',
'C', -1, 0, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2079 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2081 CALL
cgemm(
'T',
'T', -1, 0, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2082 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2084 CALL
cgemm(
'N',
'N', 0, -1, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2085 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2087 CALL
cgemm(
'N',
'C', 0, -1, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2088 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2090 CALL
cgemm(
'N',
'T', 0, -1, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2091 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2093 CALL
cgemm(
'C',
'N', 0, -1, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2094 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2096 CALL
cgemm(
'C',
'C', 0, -1, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2097 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2099 CALL
cgemm(
'C',
'T', 0, -1, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2100 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2102 CALL
cgemm(
'T',
'N', 0, -1, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2103 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2105 CALL
cgemm(
'T',
'C', 0, -1, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2106 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2108 CALL
cgemm(
'T',
'T', 0, -1, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2109 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2111 CALL
cgemm(
'N',
'N', 0, 0, -1, alpha, a, 1,
b, 1, beta, c, 1 )
2112 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2114 CALL
cgemm(
'N',
'C', 0, 0, -1, alpha, a, 1,
b, 1, beta, c, 1 )
2115 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2117 CALL
cgemm(
'N',
'T', 0, 0, -1, alpha, a, 1,
b, 1, beta, c, 1 )
2118 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2120 CALL
cgemm(
'C',
'N', 0, 0, -1, alpha, a, 1,
b, 1, beta, c, 1 )
2121 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2123 CALL
cgemm(
'C',
'C', 0, 0, -1, alpha, a, 1,
b, 1, beta, c, 1 )
2124 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2126 CALL
cgemm(
'C',
'T', 0, 0, -1, alpha, a, 1,
b, 1, beta, c, 1 )
2127 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2129 CALL
cgemm(
'T',
'N', 0, 0, -1, alpha, a, 1,
b, 1, beta, c, 1 )
2130 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2132 CALL
cgemm(
'T',
'C', 0, 0, -1, alpha, a, 1,
b, 1, beta, c, 1 )
2133 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2135 CALL
cgemm(
'T',
'T', 0, 0, -1, alpha, a, 1,
b, 1, beta, c, 1 )
2136 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2138 CALL
cgemm(
'N',
'N', 2, 0, 0, alpha, a, 1,
b, 1, beta, c, 2 )
2139 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2141 CALL
cgemm(
'N',
'C', 2, 0, 0, alpha, a, 1,
b, 1, beta, c, 2 )
2142 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2144 CALL
cgemm(
'N',
'T', 2, 0, 0, alpha, a, 1,
b, 1, beta, c, 2 )
2145 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2147 CALL
cgemm(
'C',
'N', 0, 0, 2, alpha, a, 1,
b, 2, beta, c, 1 )
2148 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2150 CALL
cgemm(
'C',
'C', 0, 0, 2, alpha, a, 1,
b, 1, beta, c, 1 )
2151 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2153 CALL
cgemm(
'C',
'T', 0, 0, 2, alpha, a, 1,
b, 1, beta, c, 1 )
2154 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2156 CALL
cgemm(
'T',
'N', 0, 0, 2, alpha, a, 1,
b, 2, beta, c, 1 )
2157 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2159 CALL
cgemm(
'T',
'C', 0, 0, 2, alpha, a, 1,
b, 1, beta, c, 1 )
2160 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2162 CALL
cgemm(
'T',
'T', 0, 0, 2, alpha, a, 1,
b, 1, beta, c, 1 )
2163 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2165 CALL
cgemm(
'N',
'N', 0, 0, 2, alpha, a, 1,
b, 1, beta, c, 1 )
2166 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2168 CALL
cgemm(
'C',
'N', 0, 0, 2, alpha, a, 2,
b, 1, beta, c, 1 )
2169 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2171 CALL
cgemm(
'T',
'N', 0, 0, 2, alpha, a, 2,
b, 1, beta, c, 1 )
2172 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2174 CALL
cgemm(
'N',
'C', 0, 2, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2175 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2177 CALL
cgemm(
'C',
'C', 0, 2, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2178 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2180 CALL
cgemm(
'T',
'C', 0, 2, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2181 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2183 CALL
cgemm(
'N',
'T', 0, 2, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2184 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2186 CALL
cgemm(
'C',
'T', 0, 2, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2187 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2189 CALL
cgemm(
'T',
'T', 0, 2, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2190 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2192 CALL
cgemm(
'N',
'N', 2, 0, 0, alpha, a, 2,
b, 1, beta, c, 1 )
2193 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2195 CALL
cgemm(
'N',
'C', 2, 0, 0, alpha, a, 2,
b, 1, beta, c, 1 )
2196 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2198 CALL
cgemm(
'N',
'T', 2, 0, 0, alpha, a, 2,
b, 1, beta, c, 1 )
2199 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2201 CALL
cgemm(
'C',
'N', 2, 0, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2202 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2204 CALL
cgemm(
'C',
'C', 2, 0, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2205 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2207 CALL
cgemm(
'C',
'T', 2, 0, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2208 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2210 CALL
cgemm(
'T',
'N', 2, 0, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2211 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2213 CALL
cgemm(
'T',
'C', 2, 0, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2214 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2216 CALL
cgemm(
'T',
'T', 2, 0, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2217 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2220 CALL
chemm(
'/',
'U', 0, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2221 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2223 CALL
chemm(
'L',
'/', 0, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2224 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2226 CALL
chemm(
'L',
'U', -1, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2227 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2229 CALL
chemm(
'R',
'U', -1, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2230 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2232 CALL
chemm(
'L',
'L', -1, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2233 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2235 CALL
chemm(
'R',
'L', -1, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2236 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2238 CALL
chemm(
'L',
'U', 0, -1, alpha, a, 1,
b, 1, beta, c, 1 )
2239 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2241 CALL
chemm(
'R',
'U', 0, -1, alpha, a, 1,
b, 1, beta, c, 1 )
2242 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2244 CALL
chemm(
'L',
'L', 0, -1, alpha, a, 1,
b, 1, beta, c, 1 )
2245 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2247 CALL
chemm(
'R',
'L', 0, -1, alpha, a, 1,
b, 1, beta, c, 1 )
2248 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2250 CALL
chemm(
'L',
'U', 2, 0, alpha, a, 1,
b, 2, beta, c, 2 )
2251 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2253 CALL
chemm(
'R',
'U', 0, 2, alpha, a, 1,
b, 1, beta, c, 1 )
2254 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2256 CALL
chemm(
'L',
'L', 2, 0, alpha, a, 1,
b, 2, beta, c, 2 )
2257 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2259 CALL
chemm(
'R',
'L', 0, 2, alpha, a, 1,
b, 1, beta, c, 1 )
2260 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2262 CALL
chemm(
'L',
'U', 2, 0, alpha, a, 2,
b, 1, beta, c, 2 )
2263 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2265 CALL
chemm(
'R',
'U', 2, 0, alpha, a, 1,
b, 1, beta, c, 2 )
2266 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2268 CALL
chemm(
'L',
'L', 2, 0, alpha, a, 2,
b, 1, beta, c, 2 )
2269 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2271 CALL
chemm(
'R',
'L', 2, 0, alpha, a, 1,
b, 1, beta, c, 2 )
2272 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2274 CALL
chemm(
'L',
'U', 2, 0, alpha, a, 2,
b, 2, beta, c, 1 )
2275 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2277 CALL
chemm(
'R',
'U', 2, 0, alpha, a, 1,
b, 2, beta, c, 1 )
2278 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2280 CALL
chemm(
'L',
'L', 2, 0, alpha, a, 2,
b, 2, beta, c, 1 )
2281 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2283 CALL
chemm(
'R',
'L', 2, 0, alpha, a, 1,
b, 2, beta, c, 1 )
2284 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2287 CALL
csymm(
'/',
'U', 0, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2288 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2290 CALL
csymm(
'L',
'/', 0, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2291 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2293 CALL
csymm(
'L',
'U', -1, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2294 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2296 CALL
csymm(
'R',
'U', -1, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2297 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2299 CALL
csymm(
'L',
'L', -1, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2300 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2302 CALL
csymm(
'R',
'L', -1, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2303 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2305 CALL
csymm(
'L',
'U', 0, -1, alpha, a, 1,
b, 1, beta, c, 1 )
2306 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2308 CALL
csymm(
'R',
'U', 0, -1, alpha, a, 1,
b, 1, beta, c, 1 )
2309 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2311 CALL
csymm(
'L',
'L', 0, -1, alpha, a, 1,
b, 1, beta, c, 1 )
2312 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2314 CALL
csymm(
'R',
'L', 0, -1, alpha, a, 1,
b, 1, beta, c, 1 )
2315 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2317 CALL
csymm(
'L',
'U', 2, 0, alpha, a, 1,
b, 2, beta, c, 2 )
2318 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2320 CALL
csymm(
'R',
'U', 0, 2, alpha, a, 1,
b, 1, beta, c, 1 )
2321 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2323 CALL
csymm(
'L',
'L', 2, 0, alpha, a, 1,
b, 2, beta, c, 2 )
2324 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2326 CALL
csymm(
'R',
'L', 0, 2, alpha, a, 1,
b, 1, beta, c, 1 )
2327 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2329 CALL
csymm(
'L',
'U', 2, 0, alpha, a, 2,
b, 1, beta, c, 2 )
2330 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2332 CALL
csymm(
'R',
'U', 2, 0, alpha, a, 1,
b, 1, beta, c, 2 )
2333 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2335 CALL
csymm(
'L',
'L', 2, 0, alpha, a, 2,
b, 1, beta, c, 2 )
2336 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2338 CALL
csymm(
'R',
'L', 2, 0, alpha, a, 1,
b, 1, beta, c, 2 )
2339 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2341 CALL
csymm(
'L',
'U', 2, 0, alpha, a, 2,
b, 2, beta, c, 1 )
2342 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2344 CALL
csymm(
'R',
'U', 2, 0, alpha, a, 1,
b, 2, beta, c, 1 )
2345 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2347 CALL
csymm(
'L',
'L', 2, 0, alpha, a, 2,
b, 2, beta, c, 1 )
2348 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2350 CALL
csymm(
'R',
'L', 2, 0, alpha, a, 1,
b, 2, beta, c, 1 )
2351 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2354 CALL
ctrmm(
'/',
'U',
'N',
'N', 0, 0, alpha, a, 1,
b, 1 )
2355 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2357 CALL
ctrmm(
'L',
'/',
'N',
'N', 0, 0, alpha, a, 1,
b, 1 )
2358 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2360 CALL
ctrmm(
'L',
'U',
'/',
'N', 0, 0, alpha, a, 1,
b, 1 )
2361 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2363 CALL
ctrmm(
'L',
'U',
'N',
'/', 0, 0, alpha, a, 1,
b, 1 )
2364 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2366 CALL
ctrmm(
'L',
'U',
'N',
'N', -1, 0, alpha, a, 1,
b, 1 )
2367 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2369 CALL
ctrmm(
'L',
'U',
'C',
'N', -1, 0, alpha, a, 1,
b, 1 )
2370 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2372 CALL
ctrmm(
'L',
'U',
'T',
'N', -1, 0, alpha, a, 1,
b, 1 )
2373 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2375 CALL
ctrmm(
'R',
'U',
'N',
'N', -1, 0, alpha, a, 1,
b, 1 )
2376 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2378 CALL
ctrmm(
'R',
'U',
'C',
'N', -1, 0, alpha, a, 1,
b, 1 )
2379 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2381 CALL
ctrmm(
'R',
'U',
'T',
'N', -1, 0, alpha, a, 1,
b, 1 )
2382 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2384 CALL
ctrmm(
'L',
'L',
'N',
'N', -1, 0, alpha, a, 1,
b, 1 )
2385 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2387 CALL
ctrmm(
'L',
'L',
'C',
'N', -1, 0, alpha, a, 1,
b, 1 )
2388 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2390 CALL
ctrmm(
'L',
'L',
'T',
'N', -1, 0, alpha, a, 1,
b, 1 )
2391 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2393 CALL
ctrmm(
'R',
'L',
'N',
'N', -1, 0, alpha, a, 1,
b, 1 )
2394 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2396 CALL
ctrmm(
'R',
'L',
'C',
'N', -1, 0, alpha, a, 1,
b, 1 )
2397 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2399 CALL
ctrmm(
'R',
'L',
'T',
'N', -1, 0, alpha, a, 1,
b, 1 )
2400 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2402 CALL
ctrmm(
'L',
'U',
'N',
'N', 0, -1, alpha, a, 1,
b, 1 )
2403 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2405 CALL
ctrmm(
'L',
'U',
'C',
'N', 0, -1, alpha, a, 1,
b, 1 )
2406 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2408 CALL
ctrmm(
'L',
'U',
'T',
'N', 0, -1, alpha, a, 1,
b, 1 )
2409 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2411 CALL
ctrmm(
'R',
'U',
'N',
'N', 0, -1, alpha, a, 1,
b, 1 )
2412 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2414 CALL
ctrmm(
'R',
'U',
'C',
'N', 0, -1, alpha, a, 1,
b, 1 )
2415 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2417 CALL
ctrmm(
'R',
'U',
'T',
'N', 0, -1, alpha, a, 1,
b, 1 )
2418 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2420 CALL
ctrmm(
'L',
'L',
'N',
'N', 0, -1, alpha, a, 1,
b, 1 )
2421 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2423 CALL
ctrmm(
'L',
'L',
'C',
'N', 0, -1, alpha, a, 1,
b, 1 )
2424 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2426 CALL
ctrmm(
'L',
'L',
'T',
'N', 0, -1, alpha, a, 1,
b, 1 )
2427 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2429 CALL
ctrmm(
'R',
'L',
'N',
'N', 0, -1, alpha, a, 1,
b, 1 )
2430 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2432 CALL
ctrmm(
'R',
'L',
'C',
'N', 0, -1, alpha, a, 1,
b, 1 )
2433 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2435 CALL
ctrmm(
'R',
'L',
'T',
'N', 0, -1, alpha, a, 1,
b, 1 )
2436 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2438 CALL
ctrmm(
'L',
'U',
'N',
'N', 2, 0, alpha, a, 1,
b, 2 )
2439 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2441 CALL
ctrmm(
'L',
'U',
'C',
'N', 2, 0, alpha, a, 1,
b, 2 )
2442 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2444 CALL
ctrmm(
'L',
'U',
'T',
'N', 2, 0, alpha, a, 1,
b, 2 )
2445 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2447 CALL
ctrmm(
'R',
'U',
'N',
'N', 0, 2, alpha, a, 1,
b, 1 )
2448 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2450 CALL
ctrmm(
'R',
'U',
'C',
'N', 0, 2, alpha, a, 1,
b, 1 )
2451 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2453 CALL
ctrmm(
'R',
'U',
'T',
'N', 0, 2, alpha, a, 1,
b, 1 )
2454 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2456 CALL
ctrmm(
'L',
'L',
'N',
'N', 2, 0, alpha, a, 1,
b, 2 )
2457 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2459 CALL
ctrmm(
'L',
'L',
'C',
'N', 2, 0, alpha, a, 1,
b, 2 )
2460 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2462 CALL
ctrmm(
'L',
'L',
'T',
'N', 2, 0, alpha, a, 1,
b, 2 )
2463 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2465 CALL
ctrmm(
'R',
'L',
'N',
'N', 0, 2, alpha, a, 1,
b, 1 )
2466 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2468 CALL
ctrmm(
'R',
'L',
'C',
'N', 0, 2, alpha, a, 1,
b, 1 )
2469 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2471 CALL
ctrmm(
'R',
'L',
'T',
'N', 0, 2, alpha, a, 1,
b, 1 )
2472 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2474 CALL
ctrmm(
'L',
'U',
'N',
'N', 2, 0, alpha, a, 2,
b, 1 )
2475 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2477 CALL
ctrmm(
'L',
'U',
'C',
'N', 2, 0, alpha, a, 2,
b, 1 )
2478 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2480 CALL
ctrmm(
'L',
'U',
'T',
'N', 2, 0, alpha, a, 2,
b, 1 )
2481 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2483 CALL
ctrmm(
'R',
'U',
'N',
'N', 2, 0, alpha, a, 1,
b, 1 )
2484 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2486 CALL
ctrmm(
'R',
'U',
'C',
'N', 2, 0, alpha, a, 1,
b, 1 )
2487 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2489 CALL
ctrmm(
'R',
'U',
'T',
'N', 2, 0, alpha, a, 1,
b, 1 )
2490 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2492 CALL
ctrmm(
'L',
'L',
'N',
'N', 2, 0, alpha, a, 2,
b, 1 )
2493 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2495 CALL
ctrmm(
'L',
'L',
'C',
'N', 2, 0, alpha, a, 2,
b, 1 )
2496 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2498 CALL
ctrmm(
'L',
'L',
'T',
'N', 2, 0, alpha, a, 2,
b, 1 )
2499 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2501 CALL
ctrmm(
'R',
'L',
'N',
'N', 2, 0, alpha, a, 1,
b, 1 )
2502 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2504 CALL
ctrmm(
'R',
'L',
'C',
'N', 2, 0, alpha, a, 1,
b, 1 )
2505 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2507 CALL
ctrmm(
'R',
'L',
'T',
'N', 2, 0, alpha, a, 1,
b, 1 )
2508 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2511 CALL
ctrsm(
'/',
'U',
'N',
'N', 0, 0, alpha, a, 1,
b, 1 )
2512 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2514 CALL
ctrsm(
'L',
'/',
'N',
'N', 0, 0, alpha, a, 1,
b, 1 )
2515 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2517 CALL
ctrsm(
'L',
'U',
'/',
'N', 0, 0, alpha, a, 1,
b, 1 )
2518 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2520 CALL
ctrsm(
'L',
'U',
'N',
'/', 0, 0, alpha, a, 1,
b, 1 )
2521 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2523 CALL
ctrsm(
'L',
'U',
'N',
'N', -1, 0, alpha, a, 1,
b, 1 )
2524 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2526 CALL
ctrsm(
'L',
'U',
'C',
'N', -1, 0, alpha, a, 1,
b, 1 )
2527 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2529 CALL
ctrsm(
'L',
'U',
'T',
'N', -1, 0, alpha, a, 1,
b, 1 )
2530 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2532 CALL
ctrsm(
'R',
'U',
'N',
'N', -1, 0, alpha, a, 1,
b, 1 )
2533 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2535 CALL
ctrsm(
'R',
'U',
'C',
'N', -1, 0, alpha, a, 1,
b, 1 )
2536 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2538 CALL
ctrsm(
'R',
'U',
'T',
'N', -1, 0, alpha, a, 1,
b, 1 )
2539 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2541 CALL
ctrsm(
'L',
'L',
'N',
'N', -1, 0, alpha, a, 1,
b, 1 )
2542 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2544 CALL
ctrsm(
'L',
'L',
'C',
'N', -1, 0, alpha, a, 1,
b, 1 )
2545 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2547 CALL
ctrsm(
'L',
'L',
'T',
'N', -1, 0, alpha, a, 1,
b, 1 )
2548 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2550 CALL
ctrsm(
'R',
'L',
'N',
'N', -1, 0, alpha, a, 1,
b, 1 )
2551 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2553 CALL
ctrsm(
'R',
'L',
'C',
'N', -1, 0, alpha, a, 1,
b, 1 )
2554 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2556 CALL
ctrsm(
'R',
'L',
'T',
'N', -1, 0, alpha, a, 1,
b, 1 )
2557 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2559 CALL
ctrsm(
'L',
'U',
'N',
'N', 0, -1, alpha, a, 1,
b, 1 )
2560 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2562 CALL
ctrsm(
'L',
'U',
'C',
'N', 0, -1, alpha, a, 1,
b, 1 )
2563 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2565 CALL
ctrsm(
'L',
'U',
'T',
'N', 0, -1, alpha, a, 1,
b, 1 )
2566 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2568 CALL
ctrsm(
'R',
'U',
'N',
'N', 0, -1, alpha, a, 1,
b, 1 )
2569 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2571 CALL
ctrsm(
'R',
'U',
'C',
'N', 0, -1, alpha, a, 1,
b, 1 )
2572 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2574 CALL
ctrsm(
'R',
'U',
'T',
'N', 0, -1, alpha, a, 1,
b, 1 )
2575 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2577 CALL
ctrsm(
'L',
'L',
'N',
'N', 0, -1, alpha, a, 1,
b, 1 )
2578 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2580 CALL
ctrsm(
'L',
'L',
'C',
'N', 0, -1, alpha, a, 1,
b, 1 )
2581 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2583 CALL
ctrsm(
'L',
'L',
'T',
'N', 0, -1, alpha, a, 1,
b, 1 )
2584 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2586 CALL
ctrsm(
'R',
'L',
'N',
'N', 0, -1, alpha, a, 1,
b, 1 )
2587 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2589 CALL
ctrsm(
'R',
'L',
'C',
'N', 0, -1, alpha, a, 1,
b, 1 )
2590 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2592 CALL
ctrsm(
'R',
'L',
'T',
'N', 0, -1, alpha, a, 1,
b, 1 )
2593 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2595 CALL
ctrsm(
'L',
'U',
'N',
'N', 2, 0, alpha, a, 1,
b, 2 )
2596 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2598 CALL
ctrsm(
'L',
'U',
'C',
'N', 2, 0, alpha, a, 1,
b, 2 )
2599 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2601 CALL
ctrsm(
'L',
'U',
'T',
'N', 2, 0, alpha, a, 1,
b, 2 )
2602 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2604 CALL
ctrsm(
'R',
'U',
'N',
'N', 0, 2, alpha, a, 1,
b, 1 )
2605 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2607 CALL
ctrsm(
'R',
'U',
'C',
'N', 0, 2, alpha, a, 1,
b, 1 )
2608 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2610 CALL
ctrsm(
'R',
'U',
'T',
'N', 0, 2, alpha, a, 1,
b, 1 )
2611 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2613 CALL
ctrsm(
'L',
'L',
'N',
'N', 2, 0, alpha, a, 1,
b, 2 )
2614 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2616 CALL
ctrsm(
'L',
'L',
'C',
'N', 2, 0, alpha, a, 1,
b, 2 )
2617 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2619 CALL
ctrsm(
'L',
'L',
'T',
'N', 2, 0, alpha, a, 1,
b, 2 )
2620 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2622 CALL
ctrsm(
'R',
'L',
'N',
'N', 0, 2, alpha, a, 1,
b, 1 )
2623 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2625 CALL
ctrsm(
'R',
'L',
'C',
'N', 0, 2, alpha, a, 1,
b, 1 )
2626 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2628 CALL
ctrsm(
'R',
'L',
'T',
'N', 0, 2, alpha, a, 1,
b, 1 )
2629 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2631 CALL
ctrsm(
'L',
'U',
'N',
'N', 2, 0, alpha, a, 2,
b, 1 )
2632 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2634 CALL
ctrsm(
'L',
'U',
'C',
'N', 2, 0, alpha, a, 2,
b, 1 )
2635 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2637 CALL
ctrsm(
'L',
'U',
'T',
'N', 2, 0, alpha, a, 2,
b, 1 )
2638 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2640 CALL
ctrsm(
'R',
'U',
'N',
'N', 2, 0, alpha, a, 1,
b, 1 )
2641 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2643 CALL
ctrsm(
'R',
'U',
'C',
'N', 2, 0, alpha, a, 1,
b, 1 )
2644 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2646 CALL
ctrsm(
'R',
'U',
'T',
'N', 2, 0, alpha, a, 1,
b, 1 )
2647 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2649 CALL
ctrsm(
'L',
'L',
'N',
'N', 2, 0, alpha, a, 2,
b, 1 )
2650 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2652 CALL
ctrsm(
'L',
'L',
'C',
'N', 2, 0, alpha, a, 2,
b, 1 )
2653 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2655 CALL
ctrsm(
'L',
'L',
'T',
'N', 2, 0, alpha, a, 2,
b, 1 )
2656 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2658 CALL
ctrsm(
'R',
'L',
'N',
'N', 2, 0, alpha, a, 1,
b, 1 )
2659 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2661 CALL
ctrsm(
'R',
'L',
'C',
'N', 2, 0, alpha, a, 1,
b, 1 )
2662 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2664 CALL
ctrsm(
'R',
'L',
'T',
'N', 2, 0, alpha, a, 1,
b, 1 )
2665 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2668 CALL
cherk(
'/',
'N', 0, 0, ralpha, a, 1, rbeta, c, 1 )
2669 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2671 CALL
cherk(
'U',
'T', 0, 0, ralpha, a, 1, rbeta, c, 1 )
2672 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2674 CALL
cherk(
'U',
'N', -1, 0, ralpha, a, 1, rbeta, c, 1 )
2675 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2677 CALL
cherk(
'U',
'C', -1, 0, ralpha, a, 1, rbeta, c, 1 )
2678 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2680 CALL
cherk(
'L',
'N', -1, 0, ralpha, a, 1, rbeta, c, 1 )
2681 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2683 CALL
cherk(
'L',
'C', -1, 0, ralpha, a, 1, rbeta, c, 1 )
2684 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2686 CALL
cherk(
'U',
'N', 0, -1, ralpha, a, 1, rbeta, c, 1 )
2687 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2689 CALL
cherk(
'U',
'C', 0, -1, ralpha, a, 1, rbeta, c, 1 )
2690 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2692 CALL
cherk(
'L',
'N', 0, -1, ralpha, a, 1, rbeta, c, 1 )
2693 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2695 CALL
cherk(
'L',
'C', 0, -1, ralpha, a, 1, rbeta, c, 1 )
2696 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2698 CALL
cherk(
'U',
'N', 2, 0, ralpha, a, 1, rbeta, c, 2 )
2699 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2701 CALL
cherk(
'U',
'C', 0, 2, ralpha, a, 1, rbeta, c, 1 )
2702 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2704 CALL
cherk(
'L',
'N', 2, 0, ralpha, a, 1, rbeta, c, 2 )
2705 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2707 CALL
cherk(
'L',
'C', 0, 2, ralpha, a, 1, rbeta, c, 1 )
2708 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2710 CALL
cherk(
'U',
'N', 2, 0, ralpha, a, 2, rbeta, c, 1 )
2711 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2713 CALL
cherk(
'U',
'C', 2, 0, ralpha, a, 1, rbeta, c, 1 )
2714 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2716 CALL
cherk(
'L',
'N', 2, 0, ralpha, a, 2, rbeta, c, 1 )
2717 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2719 CALL
cherk(
'L',
'C', 2, 0, ralpha, a, 1, rbeta, c, 1 )
2720 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2723 CALL
csyrk(
'/',
'N', 0, 0, alpha, a, 1, beta, c, 1 )
2724 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2726 CALL
csyrk(
'U',
'C', 0, 0, alpha, a, 1, beta, c, 1 )
2727 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2729 CALL
csyrk(
'U',
'N', -1, 0, alpha, a, 1, beta, c, 1 )
2730 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2732 CALL
csyrk(
'U',
'T', -1, 0, alpha, a, 1, beta, c, 1 )
2733 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2735 CALL
csyrk(
'L',
'N', -1, 0, alpha, a, 1, beta, c, 1 )
2736 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2738 CALL
csyrk(
'L',
'T', -1, 0, alpha, a, 1, beta, c, 1 )
2739 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2741 CALL
csyrk(
'U',
'N', 0, -1, alpha, a, 1, beta, c, 1 )
2742 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2744 CALL
csyrk(
'U',
'T', 0, -1, alpha, a, 1, beta, c, 1 )
2745 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2747 CALL
csyrk(
'L',
'N', 0, -1, alpha, a, 1, beta, c, 1 )
2748 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2750 CALL
csyrk(
'L',
'T', 0, -1, alpha, a, 1, beta, c, 1 )
2751 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2753 CALL
csyrk(
'U',
'N', 2, 0, alpha, a, 1, beta, c, 2 )
2754 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2756 CALL
csyrk(
'U',
'T', 0, 2, alpha, a, 1, beta, c, 1 )
2757 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2759 CALL
csyrk(
'L',
'N', 2, 0, alpha, a, 1, beta, c, 2 )
2760 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2762 CALL
csyrk(
'L',
'T', 0, 2, alpha, a, 1, beta, c, 1 )
2763 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2765 CALL
csyrk(
'U',
'N', 2, 0, alpha, a, 2, beta, c, 1 )
2766 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2768 CALL
csyrk(
'U',
'T', 2, 0, alpha, a, 1, beta, c, 1 )
2769 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2771 CALL
csyrk(
'L',
'N', 2, 0, alpha, a, 2, beta, c, 1 )
2772 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2774 CALL
csyrk(
'L',
'T', 2, 0, alpha, a, 1, beta, c, 1 )
2775 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2778 CALL
cher2k(
'/',
'N', 0, 0, alpha, a, 1,
b, 1, rbeta, c, 1 )
2779 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2781 CALL
cher2k(
'U',
'T', 0, 0, alpha, a, 1,
b, 1, rbeta, c, 1 )
2782 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2784 CALL
cher2k(
'U',
'N', -1, 0, alpha, a, 1,
b, 1, rbeta, c, 1 )
2785 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2787 CALL
cher2k(
'U',
'C', -1, 0, alpha, a, 1,
b, 1, rbeta, c, 1 )
2788 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2790 CALL
cher2k(
'L',
'N', -1, 0, alpha, a, 1,
b, 1, rbeta, c, 1 )
2791 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2793 CALL
cher2k(
'L',
'C', -1, 0, alpha, a, 1,
b, 1, rbeta, c, 1 )
2794 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2796 CALL
cher2k(
'U',
'N', 0, -1, alpha, a, 1,
b, 1, rbeta, c, 1 )
2797 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2799 CALL
cher2k(
'U',
'C', 0, -1, alpha, a, 1,
b, 1, rbeta, c, 1 )
2800 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2802 CALL
cher2k(
'L',
'N', 0, -1, alpha, a, 1,
b, 1, rbeta, c, 1 )
2803 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2805 CALL
cher2k(
'L',
'C', 0, -1, alpha, a, 1,
b, 1, rbeta, c, 1 )
2806 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2808 CALL
cher2k(
'U',
'N', 2, 0, alpha, a, 1,
b, 1, rbeta, c, 2 )
2809 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2811 CALL
cher2k(
'U',
'C', 0, 2, alpha, a, 1,
b, 1, rbeta, c, 1 )
2812 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2814 CALL
cher2k(
'L',
'N', 2, 0, alpha, a, 1,
b, 1, rbeta, c, 2 )
2815 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2817 CALL
cher2k(
'L',
'C', 0, 2, alpha, a, 1,
b, 1, rbeta, c, 1 )
2818 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2820 CALL
cher2k(
'U',
'N', 2, 0, alpha, a, 2,
b, 1, rbeta, c, 2 )
2821 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2823 CALL
cher2k(
'U',
'C', 0, 2, alpha, a, 2,
b, 1, rbeta, c, 1 )
2824 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2826 CALL
cher2k(
'L',
'N', 2, 0, alpha, a, 2,
b, 1, rbeta, c, 2 )
2827 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2829 CALL
cher2k(
'L',
'C', 0, 2, alpha, a, 2,
b, 1, rbeta, c, 1 )
2830 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2832 CALL
cher2k(
'U',
'N', 2, 0, alpha, a, 2,
b, 2, rbeta, c, 1 )
2833 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2835 CALL
cher2k(
'U',
'C', 2, 0, alpha, a, 1,
b, 1, rbeta, c, 1 )
2836 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2838 CALL
cher2k(
'L',
'N', 2, 0, alpha, a, 2,
b, 2, rbeta, c, 1 )
2839 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2841 CALL
cher2k(
'L',
'C', 2, 0, alpha, a, 1,
b, 1, rbeta, c, 1 )
2842 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2845 CALL
csyr2k(
'/',
'N', 0, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2846 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2848 CALL
csyr2k(
'U',
'C', 0, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2849 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2851 CALL
csyr2k(
'U',
'N', -1, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2852 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2854 CALL
csyr2k(
'U',
'T', -1, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2855 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2857 CALL
csyr2k(
'L',
'N', -1, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2858 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2860 CALL
csyr2k(
'L',
'T', -1, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2861 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2863 CALL
csyr2k(
'U',
'N', 0, -1, alpha, a, 1,
b, 1, beta, c, 1 )
2864 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2866 CALL
csyr2k(
'U',
'T', 0, -1, alpha, a, 1,
b, 1, beta, c, 1 )
2867 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2869 CALL
csyr2k(
'L',
'N', 0, -1, alpha, a, 1,
b, 1, beta, c, 1 )
2870 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2872 CALL
csyr2k(
'L',
'T', 0, -1, alpha, a, 1,
b, 1, beta, c, 1 )
2873 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2875 CALL
csyr2k(
'U',
'N', 2, 0, alpha, a, 1,
b, 1, beta, c, 2 )
2876 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2878 CALL
csyr2k(
'U',
'T', 0, 2, alpha, a, 1,
b, 1, beta, c, 1 )
2879 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2881 CALL
csyr2k(
'L',
'N', 2, 0, alpha, a, 1,
b, 1, beta, c, 2 )
2882 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2884 CALL
csyr2k(
'L',
'T', 0, 2, alpha, a, 1,
b, 1, beta, c, 1 )
2885 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2887 CALL
csyr2k(
'U',
'N', 2, 0, alpha, a, 2,
b, 1, beta, c, 2 )
2888 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2890 CALL
csyr2k(
'U',
'T', 0, 2, alpha, a, 2,
b, 1, beta, c, 1 )
2891 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2893 CALL
csyr2k(
'L',
'N', 2, 0, alpha, a, 2,
b, 1, beta, c, 2 )
2894 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2896 CALL
csyr2k(
'L',
'T', 0, 2, alpha, a, 2,
b, 1, beta, c, 1 )
2897 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2899 CALL
csyr2k(
'U',
'N', 2, 0, alpha, a, 2,
b, 2, beta, c, 1 )
2900 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2902 CALL
csyr2k(
'U',
'T', 2, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2903 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2905 CALL
csyr2k(
'L',
'N', 2, 0, alpha, a, 2,
b, 2, beta, c, 1 )
2906 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2908 CALL
csyr2k(
'L',
'T', 2, 0, alpha, a, 1,
b, 1, beta, c, 1 )
2909 CALL
chkxer( srnamt, infot, nout, lerr, ok )
2912 WRITE( nout, fmt = 9999 )srnamt
2914 WRITE( nout, fmt = 9998 )srnamt
2918 9999
FORMAT(
' ', a6,
' PASSED THE TESTS OF ERROR-EXITS' )
2919 9998
FORMAT(
' ******* ', a6,
' FAILED THE TESTS OF ERROR-EXITS *****',
2925 SUBROUTINE cmake( TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, RESET,
2944 parameter( zero = ( 0.0, 0.0 ), one = ( 1.0, 0.0 ) )
2946 parameter( rogue = ( -1.0e10, 1.0e10 ) )
2948 parameter( rzero = 0.0 )
2950 parameter( rrogue = -1.0e10 )
2953 INTEGER lda, m, n, nmax
2955 CHARACTER*1 diag, uplo
2958 COMPLEX a( nmax, * ), aa( * )
2960 INTEGER i, ibeg, iend,
j, jj
2961 LOGICAL gen, her, lower, sym, tri, unit, upper
2966 INTRINSIC cmplx, conjg, real
2972 upper = ( her.OR.sym.OR.tri ).AND.uplo.EQ.
'U'
2973 lower = ( her.OR.sym.OR.tri ).AND.uplo.EQ.
'L'
2974 unit = tri.AND.diag.EQ.
'U'
2980 IF( gen.OR.( upper.AND.i.LE.
j ).OR.( lower.AND.i.GE.
j ) )
2982 a( i,
j ) =
cbeg( reset ) + transl
2985 IF( n.GT.3.AND.
j.EQ.n/2 )
2988 a(
j, i ) = conjg( a( i,
j ) )
2990 a(
j, i ) = a( i,
j )
2998 $ a(
j,
j ) = cmplx(
REAL( A( J, J ) ), rzero )
3000 $ a(
j,
j ) = a(
j,
j ) + one
3007 IF( type.EQ.
'GE' )
THEN
3010 aa( i + (
j - 1 )*lda ) = a( i,
j )
3012 DO 40 i = m + 1, lda
3013 aa( i + (
j - 1 )*lda ) = rogue
3016 ELSE IF( type.EQ.
'HE'.OR.type.EQ.
'SY'.OR.type.EQ.
'TR' )
THEN
3033 DO 60 i = 1, ibeg - 1
3034 aa( i + (
j - 1 )*lda ) = rogue
3036 DO 70 i = ibeg, iend
3037 aa( i + (
j - 1 )*lda ) = a( i,
j )
3039 DO 80 i = iend + 1, lda
3040 aa( i + (
j - 1 )*lda ) = rogue
3043 jj =
j + (
j - 1 )*lda
3044 aa( jj ) = cmplx(
REAL( AA( JJ ) ), rrogue )
3053 SUBROUTINE cmmch( TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB,
3054 $ beta, c, ldc, ct, g, cc, ldcc, eps, err, fatal,
3069 parameter( zero = ( 0.0, 0.0 ) )
3071 parameter( rzero = 0.0, rone = 1.0 )
3075 INTEGER kk, lda, ldb, ldc, ldcc, m, n, nout
3077 CHARACTER*1 transa, transb
3079 COMPLEX a( lda, * ),
b( ldb, * ), c( ldc, * ),
3080 $ cc( ldcc, * ), ct( * )
3086 LOGICAL ctrana, ctranb, trana, tranb
3088 INTRINSIC abs, aimag, conjg, max,
REAL, sqrt
3092 abs1( cl ) = abs(
REAL( CL ) ) + abs( aimag( cl ) )
3094 trana = transa.EQ.
'T'.OR.transa.EQ.
'C'
3095 tranb = transb.EQ.
'T'.OR.transb.EQ.
'C'
3096 ctrana = transa.EQ.
'C'
3097 ctranb = transb.EQ.
'C'
3109 IF( .NOT.trana.AND..NOT.tranb )
THEN
3112 ct( i ) = ct( i ) + a( i, k )*
b( k,
j )
3113 g( i ) = g( i ) + abs1( a( i, k ) )*abs1(
b( k,
j ) )
3116 ELSE IF( trana.AND..NOT.tranb )
THEN
3120 ct( i ) = ct( i ) + conjg( a( k, i ) )*
b( k,
j )
3121 g( i ) = g( i ) + abs1( a( k, i ) )*
3128 ct( i ) = ct( i ) + a( k, i )*
b( k,
j )
3129 g( i ) = g( i ) + abs1( a( k, i ) )*
3134 ELSE IF( .NOT.trana.AND.tranb )
THEN
3138 ct( i ) = ct( i ) + a( i, k )*conjg(
b(
j, k ) )
3139 g( i ) = g( i ) + abs1( a( i, k ) )*
3146 ct( i ) = ct( i ) + a( i, k )*
b(
j, k )
3147 g( i ) = g( i ) + abs1( a( i, k ) )*
3152 ELSE IF( trana.AND.tranb )
THEN
3157 ct( i ) = ct( i ) + conjg( a( k, i ) )*
3158 $ conjg(
b(
j, k ) )
3159 g( i ) = g( i ) + abs1( a( k, i ) )*
3166 ct( i ) = ct( i ) + conjg( a( k, i ) )*
b(
j, k )
3167 g( i ) = g( i ) + abs1( a( k, i ) )*
3176 ct( i ) = ct( i ) + a( k, i )*conjg(
b(
j, k ) )
3177 g( i ) = g( i ) + abs1( a( k, i ) )*
3184 ct( i ) = ct( i ) + a( k, i )*
b(
j, k )
3185 g( i ) = g( i ) + abs1( a( k, i ) )*
3193 ct( i ) = alpha*ct( i ) + beta*c( i,
j )
3194 g( i ) = abs1( alpha )*g( i ) +
3195 $ abs1( beta )*abs1( c( i,
j ) )
3202 erri = abs1( ct( i ) - cc( i,
j ) )/eps
3203 IF( g( i ).NE.rzero )
3204 $ erri = erri/g( i )
3205 err = max( err, erri )
3206 IF( err*sqrt( eps ).GE.rone )
3218 WRITE( nout, fmt = 9999 )
3221 WRITE( nout, fmt = 9998 )i, ct( i ), cc( i,
j )
3223 WRITE( nout, fmt = 9998 )i, cc( i,
j ), ct( i )
3227 $
WRITE( nout, fmt = 9997 )
j
3232 9999
FORMAT(
' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL',
3233 $
'F ACCURATE *******', /
' EXPECTED RE',
3234 $
'SULT COMPUTED RESULT' )
3235 9998
FORMAT( 1x, i7, 2(
' (', g15.6,
',', g15.6,
')' ) )
3236 9997
FORMAT(
' THESE ARE THE RESULTS FOR COLUMN ', i3 )
3241 LOGICAL FUNCTION lce( RI, RJ, LR )
3256 COMPLEX ri( * ), rj( * )
3261 IF( ri( i ).NE.rj( i ) )
3273 LOGICAL FUNCTION lceres( TYPE, UPLO, M, N, AA, AS, LDA )
3292 COMPLEX aa( lda, * ), as( lda, * )
3294 INTEGER i, ibeg, iend,
j
3298 IF( type.EQ.
'GE' )
THEN
3300 DO 10 i = m + 1, lda
3301 IF( aa( i,
j ).NE.as( i,
j ) )
3305 ELSE IF( type.EQ.
'HE'.OR.type.EQ.
'SY' )
THEN
3314 DO 30 i = 1, ibeg - 1
3315 IF( aa( i,
j ).NE.as( i,
j ) )
3318 DO 40 i = iend + 1, lda
3319 IF( aa( i,
j ).NE.as( i,
j ) )
3350 INTEGER i, ic,
j, mi, mj
3352 SAVE i, ic,
j, mi, mj
3376 i = i - 1000*( i/1000 )
3377 j =
j - 1000*(
j/1000 )
3382 cbeg = cmplx( ( i - 500 )/1001.0, (
j - 500 )/1001.0 )
3407 SUBROUTINE chkxer( SRNAMT, INFOT, NOUT, LERR, OK )
3425 WRITE( nout, fmt = 9999 )infot, srnamt
3431 9999
FORMAT(
' ***** ILLEGAL VALUE OF PARAMETER NUMBER ', i2,
' NOT D',
3432 $
'ETECTED BY ', a6,
' *****' )
3464 COMMON /infoc/infot, nout, ok, lerr
3465 COMMON /srnamc/srnamt
3468 IF( info.NE.infot )
THEN
3469 IF( infot.NE.0 )
THEN
3470 WRITE( nout, fmt = 9999 )info, infot
3472 WRITE( nout, fmt = 9997 )info
3476 IF( srname.NE.srnamt )
THEN
3477 WRITE( nout, fmt = 9998 )srname, srnamt
3482 9999
FORMAT(
' ******* XERBLA WAS CALLED WITH INFO = ', i6,
' INSTEAD',
3483 $
' OF ', i2,
' *******' )
3484 9998
FORMAT(
' ******* XERBLA WAS CALLED WITH SRNAME = ', a6,
' INSTE',
3485 $
'AD OF ', a6,
' *******' )
3486 9997
FORMAT(
' ******* XERBLA WAS CALLED WITH INFO = ', i6,
subroutine ctrsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
CTRSM
subroutine cchk2(SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, FATAL, NIDIM, IDIM, NKB, KB, NALF, ALF, NBET, BET, NINC, INC, NMAX, INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G)
subroutine cchk5(SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, NMAX, INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G, Z)
complex function cbeg(RESET)
subroutine cchke(ISNUM, SRNAMT, NOUT)
logical function lce(RI, RJ, LR)
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine ctrmm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
CTRMM
subroutine chkxer(SRNAMT, INFOT, NOUT, LERR, OK)
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine csyrk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
CSYRK
subroutine cmmch(TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB, BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR, FATAL, NOUT, MV)
subroutine cchk3(SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, FATAL, NIDIM, IDIM, NKB, KB, NINC, INC, NMAX, INCMAX, A, AA, AS, X, XX, XS, XT, G, Z)
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine cmake(TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, KL, KU, RESET, TRANSL)
subroutine cher2k(UPLO, TRANS, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CHER2K
logical function lceres(TYPE, UPLO, M, N, AA, AS, LDA)
subroutine cgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CGEMM
subroutine cchk4(SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, FATAL, NIDIM, IDIM, NALF, ALF, NINC, INC, NMAX, INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G, Z)
real function sdiff(SA, SB)
subroutine chemm(SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CHEMM
subroutine csymm(SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CSYMM
subroutine cherk(UPLO, TRANS, N, K, ALPHA, A, LDA, BETA, C, LDC)
CHERK
subroutine cchk1(SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, FATAL, NIDIM, IDIM, NKB, KB, NALF, ALF, NBET, BET, NINC, INC, NMAX, INCMAX, A, AA, AS, X, XX, XS, Y, YY, YS, YT, G)
subroutine csyr2k(UPLO, TRANS, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CSYR2K