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,