51 parameter( nin = 5, nout = 6 )
53 parameter( nsubs = 10 )
55 parameter( zero = ( 0.0, 0.0 ), one = ( 1.0, 0.0 ) )
56 REAL rzero, rhalf, rone
57 parameter( rzero = 0.0, rhalf = 0.5, rone = 1.0 )
59 parameter( nmax = 65 )
60 INTEGER nidmax, nalmax, nbemax
61 parameter( nidmax = 9, nalmax = 7, nbemax = 7 )
64 INTEGER i, isnum, j, n, nalf, nbet, nidim, ntra,
66 LOGICAL fatal, ltestt, rewi, same, sfatal, trace,
67 $ tsterr, corder, rorder
68 CHARACTER*1 transa, transb
72 COMPLEX aa( nmax*nmax ), ab( nmax, 2*nmax ),
73 $ alf( nalmax ), as( nmax*nmax ),
74 $ bb( nmax*nmax ), bet( nbemax ),
75 $ bs( nmax*nmax ), c( nmax, nmax ),
76 $ cc( nmax*nmax ), cs( nmax*nmax ), ct( nmax ),
79 INTEGER idim( nidmax )
80 LOGICAL ltest( nsubs )
81 CHARACTER*13 snames( nsubs )
95 COMMON /infoc/infot, noutc, ok, lerr
98 DATA snames/
'cblas_cgemm ',
'cblas_chemm ',
99 $
'cblas_csymm ',
'cblas_ctrmm ',
'cblas_ctrsm ',
100 $
'cblas_cherk ',
'cblas_csyrk ',
'cblas_cher2k',
101 $
'cblas_csyr2k',
'cblas_cgemmtr' /
108 READ( nin, fmt = * )snaps
109 READ( nin, fmt = * )ntra
112 OPEN( ntra, file = snaps )
115 READ( nin, fmt = * )rewi
116 rewi = rewi.AND.trace
118 READ( nin, fmt = * )sfatal
120 READ( nin, fmt = * )tsterr
122 READ( nin, fmt = * )layout
124 READ( nin, fmt = * )thresh
129 READ( nin, fmt = * )nidim
130 IF( nidim.LT.1.OR.nidim.GT.nidmax )
THEN
131 WRITE( nout, fmt = 9997 )
'N', nidmax
134 READ( nin, fmt = * )( idim( i ), i = 1, nidim )
136 IF( idim( i ).LT.0.OR.idim( i ).GT.nmax )
THEN
137 WRITE( nout, fmt = 9996 )nmax
142 READ( nin, fmt = * )nalf
143 IF( nalf.LT.1.OR.nalf.GT.nalmax )
THEN
144 WRITE( nout, fmt = 9997 )
'ALPHA', nalmax
147 READ( nin, fmt = * )( alf( i ), i = 1, nalf )
149 READ( nin, fmt = * )nbet
150 IF( nbet.LT.1.OR.nbet.GT.nbemax )
THEN
151 WRITE( nout, fmt = 9997 )
'BETA', nbemax
154 READ( nin, fmt = * )( bet( i ), i = 1, nbet )
158 WRITE( nout, fmt = 9995 )
159 WRITE( nout, fmt = 9994 )( idim( i ), i = 1, nidim )
160 WRITE( nout, fmt = 9993 )( alf( i ), i = 1, nalf )
161 WRITE( nout, fmt = 9992 )( bet( i ), i = 1, nbet )
162 IF( .NOT.tsterr )
THEN
163 WRITE( nout, fmt = * )
164 WRITE( nout, fmt = 9984 )
166 WRITE( nout, fmt = * )
167 WRITE( nout, fmt = 9999 )thresh
168 WRITE( nout, fmt = * )
172 IF (layout.EQ.2)
THEN
175 WRITE( *, fmt = 10002 )
176 ELSE IF (layout.EQ.1)
THEN
178 WRITE( *, fmt = 10001 )
179 ELSE IF (layout.EQ.0)
THEN
181 WRITE( *, fmt = 10000 )
192 30
READ( nin, fmt = 9988,
END = 60 )SNAMET, ltestt
194 IF( snamet.EQ.snames( i ) )
197 WRITE( nout, fmt = 9990 )snamet
199 50 ltest( i ) = ltestt
209 IF(
sdiff( rone + eps, rone ).EQ.rzero )
215 WRITE( nout, fmt = 9998 )eps
222 ab( i, j ) = max( i - j + 1, 0 )
224 ab( j, nmax + 1 ) = j
225 ab( 1, nmax + j ) = j
229 cc( j ) = j*( ( j + 1 )*j )/2 - ( ( j + 1 )*j*( j - 1 ) )/3
235 CALL cmmch( transa, transb, n, 1, n, one, ab, nmax,
236 $ ab( 1, nmax + 1 ), nmax, zero, c, nmax, ct, g, cc,
237 $ nmax, eps, err, fatal, nout, .true. )
238 same =
lce( cc, ct, n )
239 IF( .NOT.same.OR.err.NE.rzero )
THEN
240 WRITE( nout, fmt = 9989 )transa, transb, same, err
244 CALL cmmch( transa, transb, n, 1, n, one, ab, nmax,
245 $ ab( 1, nmax + 1 ), nmax, zero, c, nmax, ct, g, cc,
246 $ nmax, eps, err, fatal, nout, .true. )
247 same =
lce( cc, ct, n )
248 IF( .NOT.same.OR.err.NE.rzero )
THEN
249 WRITE( nout, fmt = 9989 )transa, transb, same, err
253 ab( j, nmax + 1 ) = n - j + 1
254 ab( 1, nmax + j ) = n - j + 1
257 cc( n - j + 1 ) = j*( ( j + 1 )*j )/2 -
258 $ ( ( j + 1 )*j*( j - 1 ) )/3
262 CALL cmmch( transa, transb, n, 1, n, one, ab, nmax,
263 $ ab( 1, nmax + 1 ), nmax, zero, c, nmax, ct, g, cc,
264 $ nmax, eps, err, fatal, nout, .true. )
265 same =
lce( cc, ct, n )
266 IF( .NOT.same.OR.err.NE.rzero )
THEN
267 WRITE( nout, fmt = 9989 )transa, transb, same, err
271 CALL cmmch( transa, transb, n, 1, n, one, ab, nmax,
272 $ ab( 1, nmax + 1 ), nmax, zero, c, nmax, ct, g, cc,
273 $ nmax, eps, err, fatal, nout, .true. )
274 same =
lce( cc, ct, n )
275 IF( .NOT.same.OR.err.NE.rzero )
THEN
276 WRITE( nout, fmt = 9989 )transa, transb, same, err
282 DO 200 isnum = 1, nsubs
283 WRITE( nout, fmt = * )
284 IF( .NOT.ltest( isnum ) )
THEN
286 WRITE( nout, fmt = 9987 )snames( isnum )
288 srnamt = snames( isnum )
291 CALL cc3chke( snames( isnum ) )
292 WRITE( nout, fmt = * )
298 GO TO ( 140, 150, 150, 160, 160, 170, 170,
299 $ 180, 180, 185 )isnum
302 CALL cchk1(snames( isnum ), eps, thresh, nout, ntra, trace,
303 $ rewi, fatal, nidim, idim, nalf, alf, nbet, bet,
304 $ nmax, ab, aa, as, ab( 1, nmax + 1 ), bb, bs, c,
308 CALL cchk1(snames( isnum ), eps, thresh, nout, ntra, trace,
309 $ rewi, fatal, nidim, idim, nalf, alf, nbet, bet,
310 $ nmax, ab, aa, as, ab( 1, nmax + 1 ), bb, bs, c,
316 CALL cchk2(snames( isnum ), eps, thresh, nout, ntra, trace,
317 $ rewi, fatal, nidim, idim, nalf, alf, nbet, bet,
318 $ nmax, ab, aa, as, ab( 1, nmax + 1 ), bb, bs, c,
322 CALL cchk2(snames( isnum ), eps, thresh, nout, ntra, trace,
323 $ rewi, fatal, nidim, idim, nalf, alf, nbet, bet,
324 $ nmax, ab, aa, as, ab( 1, nmax + 1 ), bb, bs, c,
330 CALL cchk3(snames( isnum ), eps, thresh, nout, ntra, trace,
331 $ rewi, fatal, nidim, idim, nalf, alf, nmax, ab,
332 $ aa, as, ab( 1, nmax + 1 ), bb, bs, ct, g, c,
336 CALL cchk3(snames( isnum ), eps, thresh, nout, ntra, trace,
337 $ rewi, fatal, nidim, idim, nalf, alf, nmax, ab,
338 $ aa, as, ab( 1, nmax + 1 ), bb, bs, ct, g, c,
344 CALL cchk4(snames( isnum ), eps, thresh, nout, ntra, trace,
345 $ rewi, fatal, nidim, idim, nalf, alf, nbet, bet,
346 $ nmax, ab, aa, as, ab( 1, nmax + 1 ), bb, bs, c,
350 CALL cchk4(snames( isnum ), eps, thresh, nout, ntra, trace,
351 $ rewi, fatal, nidim, idim, nalf, alf, nbet, bet,
352 $ nmax, ab, aa, as, ab( 1, nmax + 1 ), bb, bs, c,
358 CALL cchk5(snames( isnum ), eps, thresh, nout, ntra, trace,
359 $ rewi, fatal, nidim, idim, nalf, alf, nbet, bet,
360 $ nmax, ab, aa, as, bb, bs, c, cc, cs, ct, g, w,
364 CALL cchk5(snames( isnum ), eps, thresh, nout, ntra, trace,
365 $ rewi, fatal, nidim, idim, nalf, alf, nbet, bet,
366 $ nmax, ab, aa, as, bb, bs, c, cc, cs, ct, g, w,
372 CALL cchk6(snames( isnum ), eps, thresh, nout, ntra, trace,
373 $ rewi, fatal, nidim, idim, nalf, alf, nbet, bet,
374 $ nmax, ab, aa, as, ab( 1, nmax + 1 ), bb, bs, c,
378 CALL cchk6(snames( isnum ), eps, thresh, nout, ntra, trace,
379 $ rewi, fatal, nidim, idim, nalf, alf, nbet, bet,
380 $ nmax, ab, aa, as, ab( 1, nmax + 1 ), bb, bs, c,
386 190
IF( fatal.AND.sfatal )
390 WRITE( nout, fmt = 9986 )
394 WRITE( nout, fmt = 9985 )
398 WRITE( nout, fmt = 9991 )
40610002
FORMAT(
' COLUMN-MAJOR AND ROW-MAJOR DATA LAYOUTS ARE TESTED' )
40710001
FORMAT(
' ROW-MAJOR DATA LAYOUT IS TESTED' )
40810000
FORMAT(
' COLUMN-MAJOR DATA LAYOUT IS TESTED' )
409 9999
FORMAT(
' ROUTINES PASS COMPUTATIONAL TESTS IF TEST RATIO IS LES',
411 9998
FORMAT(
' RELATIVE MACHINE PRECISION IS TAKEN TO BE', 1p, e9.1 )
412 9997
FORMAT(
' NUMBER OF VALUES OF ', a,
' IS LESS THAN 1 OR GREATER ',
414 9996
FORMAT(
' VALUE OF N IS LESS THAN 0 OR GREATER THAN ', i2 )
415 9995
FORMAT(
' TESTS OF THE COMPLEX LEVEL 3 BLAS', //
' THE F',
416 $
'OLLOWING PARAMETER VALUES WILL BE USED:' )
417 9994
FORMAT(
' FOR N ', 9i6 )
418 9993
FORMAT(
' FOR ALPHA ',
419 $ 7(
'(', f4.1,
',', f4.1,
') ', : ) )
420 9992
FORMAT(
' FOR BETA ',
421 $ 7(
'(', f4.1,
',', f4.1,
') ', : ) )
422 9991
FORMAT(
' AMEND DATA FILE OR INCREASE ARRAY SIZES IN PROGRAM',
423 $ /
' ******* TESTS ABANDONED *******' )
424 9990
FORMAT(
' SUBPROGRAM NAME ', a13,
' NOT RECOGNIZED', /
' ******* T',
425 $
'ESTS ABANDONED *******' )
426 9989
FORMAT(
' ERROR IN CMMCH - IN-LINE DOT PRODUCTS ARE BEING EVALU',
427 $
'ATED WRONGLY.', /
' CMMCH WAS CALLED WITH TRANSA = ', a1,
428 $
'AND TRANSB = ', a1, /
' AND RETURNED SAME = ', l1,
' AND ',
429 $
' ERR = ', f12.3,
'.', /
' THIS MAY BE DUE TO FAULTS IN THE ',
430 $
'ARITHMETIC OR THE COMPILER.', /
' ******* TESTS ABANDONED ',
432 9988
FORMAT( a13,l2 )
433 9987
FORMAT( 1x, a13,
' WAS NOT TESTED' )
434 9986
FORMAT( /
' END OF TESTS' )
435 9985
FORMAT( /
' ******* FATAL ERROR - TESTS ABANDONED *******' )
436 9984
FORMAT(
' ERROR-EXITS WILL NOT BE TESTED' )
441 SUBROUTINE cchk1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
442 $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
443 $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G,
458 PARAMETER ( ZERO = ( 0.0, 0.0 ) )
460 parameter( rzero = 0.0 )
463 INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER
464 LOGICAL FATAL, REWI, TRACE
467 COMPLEX A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
468 $ as( nmax*nmax ), b( nmax, nmax ),
469 $ bb( nmax*nmax ), bet( nbet ), bs( nmax*nmax ),
470 $ c( nmax, nmax ), cc( nmax*nmax ),
471 $ cs( nmax*nmax ), ct( nmax )
473 INTEGER IDIM( NIDIM )
475 COMPLEX ALPHA, ALS, BETA, BLS
477 INTEGER I, IA, IB, ICA, ICB, IK, IM, IN, K, KS, LAA,
478 $ lbb, lcc, lda, ldas, ldb, ldbs, ldc, ldcs, m,
479 $ ma, mb, ms, n, na, nargs, nb, nc, ns
480 LOGICAL NULL, RESET, SAME, TRANA, TRANB
481 CHARACTER*1 TRANAS, TRANBS, TRANSA, TRANSB
496 COMMON /infoc/infot, noutc, ok, lerr
519 null = n.LE.0.OR.m.LE.0
525 transa = ich( ica: ica )
526 trana = transa.EQ.
'T'.OR.transa.EQ.
'C'
546 CALL cmake(
'ge',
' ',
' ', ma, na, a, nmax, aa, lda,
550 transb = ich( icb: icb )
551 tranb = transb.EQ.
'T'.OR.transb.EQ.
'C'
571 CALL cmake(
'ge',
' ',
' ', mb, nb, b, nmax, bb,
582 CALL cmake(
'ge',
' ',
' ', m, n, c, nmax,
583 $ cc, ldc, reset, zero )
613 $
CALL cprcn1(ntra, nc, sname, iorder,
614 $ transa, transb, m, n, k, alpha, lda,
618 CALL ccgemm( iorder, transa, transb, m, n,
619 $ k, alpha, aa, lda, bb, ldb,
625 WRITE( nout, fmt = 9994 )
632 isame( 1 ) = transa.EQ.tranas
633 isame( 2 ) = transb.EQ.tranbs
637 isame( 6 ) = als.EQ.alpha
638 isame( 7 ) = lce( as, aa, laa )
639 isame( 8 ) = ldas.EQ.lda
640 isame( 9 ) = lce( bs, bb, lbb )
641 isame( 10 ) = ldbs.EQ.ldb
642 isame( 11 ) = bls.EQ.beta
644 isame( 12 ) = lce( cs, cc, lcc )
646 isame( 12 ) = lceres(
'ge',
' ', m, n, cs,
649 isame( 13 ) = ldcs.EQ.ldc
656 same = same.AND.isame( i )
657 IF( .NOT.isame( i ) )
658 $
WRITE( nout, fmt = 9998 )i
669 CALL cmmch( transa, transb, m, n, k,
670 $ alpha, a, nmax, b, nmax, beta,
671 $ c, nmax, ct, g, cc, ldc, eps,
672 $ err, fatal, nout, .true. )
673 errmax = max( errmax, err )
696 IF( errmax.LT.thresh )
THEN
697 IF ( iorder.EQ.0)
WRITE( nout, fmt = 10000 )sname, nc
698 IF ( iorder.EQ.1)
WRITE( nout, fmt = 10001 )sname, nc
700 IF ( iorder.EQ.0)
WRITE( nout, fmt = 10002 )sname, nc, errmax
701 IF ( iorder.EQ.1)
WRITE( nout, fmt = 10003 )sname, nc, errmax
706 WRITE( nout, fmt = 9996 )sname
707 CALL cprcn1(nout, nc, sname, iorder, transa, transb,
708 $ m, n, k, alpha, lda, ldb, beta, ldc)
71310003
FORMAT(
' ', a13,
' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
714 $
'TESTS (', i6,
' CALLS)', /
' ******* BUT WITH MAXIMUM TEST ',
715 $
'RATIO ', f8.2,
' - SUSPECT *******' )
71610002
FORMAT(
' ', a13,
' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
717 $
'TESTS (', i6,
' CALLS)', /
' ******* BUT WITH MAXIMUM TEST ',
718 $
'RATIO ', f8.2,
' - SUSPECT *******' )
71910001
FORMAT(
' ', a13,
' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
720 $
' (', i6,
' CALL',
'S)' )
72110000
FORMAT(
' ', a13,
' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
722 $
' (', i6,
' CALL',
'S)' )
723 9998
FORMAT(
' ******* FATAL ERROR - PARAMETER NUMBER ', i2,
' WAS CH',
724 $
'ANGED INCORRECTLY *******' )
725 9996
FORMAT(
' ******* ', a13,
' FAILED ON CALL NUMBER:' )
726 9995
FORMAT( 1x, i6,
': ', a13,
'(''', a1,
''',''', a1,
''',',
727 $ 3( i3,
',' ),
'(', f4.1,
',', f4.1,
'), A,', i3,
', B,', i3,
728 $
',(', f4.1,
',', f4.1,
'), C,', i3,
').' )
729 9994
FORMAT(
' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
441 SUBROUTINE cchk1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
…
736 SUBROUTINE cprcn1(NOUT, NC, SNAME, IORDER, TRANSA, TRANSB, M, N,
737 $ K, ALPHA, LDA, LDB, BETA, LDC)
738 INTEGER NOUT, NC, IORDER, M, N, K, LDA, LDB, LDC
740 CHARACTER*1 TRANSA, TRANSB
742 CHARACTER*14 CRC, CTA,CTB
744 IF (transa.EQ.
'N')
THEN
745 cta =
' CblasNoTrans'
746 ELSE IF (transa.EQ.
'T')
THEN
749 cta =
'CblasConjTrans'
751 IF (transb.EQ.
'N')
THEN
752 ctb =
' CblasNoTrans'
753 ELSE IF (transb.EQ.
'T')
THEN
756 ctb =
'CblasConjTrans'
759 crc =
' CblasRowMajor'
761 crc =
' CblasColMajor'
763 WRITE(nout, fmt = 9995)nc,sname,crc, cta,ctb
764 WRITE(nout, fmt = 9994)m, n, k, alpha, lda, ldb, beta, ldc
766 9995
FORMAT( 1x, i6,
': ', a13,
'(', a14,
',', a14,
',', a14,
',')
767 9994
FORMAT( 10x, 3( i3,
',' ) ,
' (', f4.1,
',',f4.1,
') , A,',
768 $ i3,
', B,', i3,
', (', f4.1,
',',f4.1,
') , C,', i3,
').' )
736 SUBROUTINE cprcn1(NOUT, NC, SNAME, IORDER, TRANSA, TRANSB, M, N,
…
771 SUBROUTINE cchk2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
772 $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
773 $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G,
788 PARAMETER ( ZERO = ( 0.0, 0.0 ) )
790 parameter( rzero = 0.0 )
793 INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER
794 LOGICAL FATAL, REWI, TRACE
797 COMPLEX A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
798 $ AS( NMAX*NMAX ), B( NMAX, NMAX ),
799 $ bb( nmax*nmax ), bet( nbet ), bs( nmax*nmax ),
800 $ c( nmax, nmax ), cc( nmax*nmax ),
801 $ cs( nmax*nmax ), ct( nmax )
803 INTEGER IDIM( NIDIM )
805 COMPLEX ALPHA, ALS, BETA, BLS
807 INTEGER I, IA, IB, ICS, ICU, IM, IN, LAA, LBB, LCC,
808 $ LDA, LDAS, LDB, LDBS, LDC, LDCS, M, MS, N, NA,
810 LOGICAL CONJ, LEFT, NULL, RESET, SAME
811 CHARACTER*1 SIDE, SIDES, UPLO, UPLOS
812 CHARACTER*2 ICHS, ICHU
826 COMMON /infoc/infot, noutc, ok, lerr
828 DATA ichs/
'LR'/, ichu/
'UL'/
830 conj = sname( 8: 9 ).EQ.
'he'
850 null = n.LE.0.OR.m.LE.0
862 CALL cmake(
'ge',
' ',
' ', m, n, b, nmax, bb, ldb, reset,
866 side = ichs( ics: ics )
884 uplo = ichu( icu: icu )
888 CALL cmake(sname( 8: 9 ), uplo,
' ', na, na, a, nmax,
889 $ aa, lda, reset, zero )
899 CALL cmake(
'ge',
' ',
' ', m, n, c, nmax, cc,
929 $
CALL cprcn2(ntra, nc, sname, iorder,
930 $ side, uplo, m, n, alpha, lda, ldb,
935 CALL cchemm( iorder, side, uplo, m, n,
936 $ alpha, aa, lda, bb, ldb, beta,
939 CALL ccsymm( iorder, side, uplo, m, n,
940 $ alpha, aa, lda, bb, ldb, beta,
947 WRITE( nout, fmt = 9994 )
954 isame( 1 ) = sides.EQ.side
955 isame( 2 ) = uplos.EQ.uplo
958 isame( 5 ) = als.EQ.alpha
959 isame( 6 ) = lce( as, aa, laa )
960 isame( 7 ) = ldas.EQ.lda
961 isame( 8 ) = lce( bs, bb, lbb )
962 isame( 9 ) = ldbs.EQ.ldb
963 isame( 10 ) = bls.EQ.beta
965 isame( 11 ) = lce( cs, cc, lcc )
967 isame( 11 ) = lceres(
'ge',
' ', m, n, cs,
970 isame( 12 ) = ldcs.EQ.ldc
977 same = same.AND.isame( i )
978 IF( .NOT.isame( i ) )
979 $
WRITE( nout, fmt = 9998 )i
991 CALL cmmch(
'N',
'N', m, n, m, alpha, a,
992 $ nmax, b, nmax, beta, c, nmax,
993 $ ct, g, cc, ldc, eps, err,
994 $ fatal, nout, .true. )
996 CALL cmmch(
'N',
'N', m, n, n, alpha, b,
997 $ nmax, a, nmax, beta, c, nmax,
998 $ ct, g, cc, ldc, eps, err,
999 $ fatal, nout, .true. )
1001 errmax = max( errmax, err )
1022 IF( errmax.LT.thresh )
THEN
1023 IF ( iorder.EQ.0)
WRITE( nout, fmt = 10000 )sname, nc
1024 IF ( iorder.EQ.1)
WRITE( nout, fmt = 10001 )sname, nc
1026 IF ( iorder.EQ.0)
WRITE( nout, fmt = 10002 )sname, nc, errmax
1027 IF ( iorder.EQ.1)
WRITE( nout, fmt = 10003 )sname, nc, errmax
1032 WRITE( nout, fmt = 9996 )sname
1033 CALL cprcn2(nout, nc, sname, iorder, side, uplo, m, n, alpha, lda,
103910003
FORMAT(
' ', a13,
' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
1040 $
'TESTS (', i6,
' CALLS)', /
' ******* BUT WITH MAXIMUM TEST ',
1041 $
'RATIO ', f8.2,
' - SUSPECT *******' )
104210002
FORMAT(
' ', a13,
' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
1043 $
'TESTS (', i6,
' CALLS)', /
' ******* BUT WITH MAXIMUM TEST ',
1044 $
'RATIO ', f8.2,
' - SUSPECT *******' )
104510001
FORMAT(
' ', a13,
' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
1046 $
' (', i6,
' CALL',
'S)' )
104710000
FORMAT(
' ', a13,
' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
1048 $
' (', i6,
' CALL',
'S)' )
1049 9998
FORMAT(
' ******* FATAL ERROR - PARAMETER NUMBER ', i2,
' WAS CH',
1050 $
'ANGED INCORRECTLY *******' )
1051 9996
FORMAT(
' ******* ', a13,
' FAILED ON CALL NUMBER:' )
1052 9995
FORMAT(1x, i6,
': ', a13,
'(', 2(
'''', a1,
''',' ), 2( i3,
',' ),
1053 $
'(', f4.1,
',', f4.1,
'), A,', i3,
', B,', i3,
',(', f4.1,
1054 $
',', f4.1,
'), C,', i3,
') .' )
1055 9994
FORMAT(
' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
771 SUBROUTINE cchk2( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
…
1062 SUBROUTINE cprcn2(NOUT, NC, SNAME, IORDER, SIDE, UPLO, M, N,
1063 $ ALPHA, LDA, LDB, BETA, LDC)
1064 INTEGER NOUT, NC, IORDER, M, N, LDA, LDB, LDC
1066 CHARACTER*1 SIDE, UPLO
1068 CHARACTER*14 CRC, CS,CU
1070 IF (side.EQ.
'L')
THEN
1075 IF (uplo.EQ.
'U')
THEN
1080 IF (iorder.EQ.1)
THEN
1081 crc =
' CblasRowMajor'
1083 crc =
' CblasColMajor'
1085 WRITE(nout, fmt = 9995)nc,sname,crc, cs,cu
1086 WRITE(nout, fmt = 9994)m, n, alpha, lda, ldb, beta, ldc
1088 9995
FORMAT( 1x, i6,
': ', a13,
'(', a14,
',', a14,
',', a14,
',')
1089 9994
FORMAT( 10x, 2( i3,
',' ),
' (',f4.1,
',',f4.1,
'), A,', i3,
1090 $
', B,', i3,
', (',f4.1,
',',f4.1,
'), ',
'C,', i3,
').' )
1062 SUBROUTINE cprcn2(NOUT, NC, SNAME, IORDER, SIDE, UPLO, M, N,
…
1093 SUBROUTINE cchk3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
1094 $ FATAL, NIDIM, IDIM, NALF, ALF, NMAX, A, AA, AS,
1095 $ B, BB, BS, CT, G, C, IORDER )
1109 PARAMETER ( ZERO = ( 0.0, 0.0 ), one = ( 1.0, 0.0 ) )
1111 PARAMETER ( RZERO = 0.0 )
1114 INTEGER NALF, NIDIM, NMAX, NOUT, NTRA, IORDER
1115 LOGICAL FATAL, REWI, TRACE
1118 COMPLEX A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
1119 $ as( nmax*nmax ), b( nmax, nmax ),
1120 $ bb( nmax*nmax ), bs( nmax*nmax ),
1121 $ c( nmax, nmax ), ct( nmax )
1123 INTEGER IDIM( NIDIM )
1127 INTEGER I, IA, ICD, ICS, ICT, ICU, IM, IN, J, LAA, LBB,
1128 $ lda, ldas, ldb, ldbs, m, ms, n, na, nargs, nc,
1130 LOGICAL LEFT, NULL, RESET, SAME
1131 CHARACTER*1 DIAG, DIAGS, SIDE, SIDES, TRANAS, TRANSA, UPLO,
1133 CHARACTER*2 ICHD, ICHS, ICHU
1139 EXTERNAL LCE, LCERES
1145 INTEGER INFOT, NOUTC
1148 COMMON /infoc/infot, noutc, ok, lerr
1150 DATA ichu/
'UL'/, icht/
'NTC'/, ichd/
'UN'/, ichs/
'LR'/
1164 DO 140 im = 1, nidim
1167 DO 130 in = 1, nidim
1177 null = m.LE.0.OR.n.LE.0
1180 side = ichs( ics: ics )
1197 uplo = ichu( icu: icu )
1200 transa = icht( ict: ict )
1203 diag = ichd( icd: icd )
1210 CALL cmake(
'tr', uplo, diag, na, na, a,
1211 $ nmax, aa, lda, reset, zero )
1215 CALL cmake(
'ge',
' ',
' ', m, n, b, nmax,
1216 $ bb, ldb, reset, zero )
1241 IF( sname( 10: 11 ).EQ.
'mm' )
THEN
1243 $
CALL cprcn3( ntra, nc, sname, iorder,
1244 $ side, uplo, transa, diag, m, n, alpha,
1248 CALL cctrmm(iorder, side, uplo, transa,
1249 $ diag, m, n, alpha, aa, lda,
1251 ELSE IF( sname( 10: 11 ).EQ.
'sm' )
THEN
1253 $
CALL cprcn3( ntra, nc, sname, iorder,
1254 $ side, uplo, transa, diag, m, n, alpha,
1258 CALL cctrsm(iorder, side, uplo, transa,
1259 $ diag, m, n, alpha, aa, lda,
1266 WRITE( nout, fmt = 9994 )
1273 isame( 1 ) = sides.EQ.side
1274 isame( 2 ) = uplos.EQ.uplo
1275 isame( 3 ) = tranas.EQ.transa
1276 isame( 4 ) = diags.EQ.diag
1277 isame( 5 ) = ms.EQ.m
1278 isame( 6 ) = ns.EQ.n
1279 isame( 7 ) = als.EQ.alpha
1280 isame( 8 ) = lce( as, aa, laa )
1281 isame( 9 ) = ldas.EQ.lda
1283 isame( 10 ) = lce( bs, bb, lbb )
1285 isame( 10 ) = lceres(
'ge',
' ', m, n, bs,
1288 isame( 11 ) = ldbs.EQ.ldb
1295 same = same.AND.isame( i )
1296 IF( .NOT.isame( i ) )
1297 $
WRITE( nout, fmt = 9998 )i
1305 IF( sname( 10: 11 ).EQ.
'mm' )
THEN
1310 CALL cmmch( transa,
'N', m, n, m,
1311 $ alpha, a, nmax, b, nmax,
1312 $ zero, c, nmax, ct, g,
1313 $ bb, ldb, eps, err,
1314 $ fatal, nout, .true. )
1316 CALL cmmch(
'N', transa, m, n, n,
1317 $ alpha, b, nmax, a, nmax,
1318 $ zero, c, nmax, ct, g,
1319 $ bb, ldb, eps, err,
1320 $ fatal, nout, .true. )
1322 ELSE IF( sname( 10: 11 ).EQ.
'sm' )
THEN
1329 c( i, j ) = bb( i + ( j - 1 )*
1331 bb( i + ( j - 1 )*ldb ) = alpha*
1337 CALL cmmch( transa,
'N', m, n, m,
1338 $ one, a, nmax, c, nmax,
1339 $ zero, b, nmax, ct, g,
1340 $ bb, ldb, eps, err,
1341 $ fatal, nout, .false. )
1343 CALL cmmch(
'N', transa, m, n, n,
1344 $ one, c, nmax, a, nmax,
1345 $ zero, b, nmax, ct, g,
1346 $ bb, ldb, eps, err,
1347 $ fatal, nout, .false. )
1350 errmax = max( errmax, err )
1373 IF( errmax.LT.thresh )
THEN
1374 IF ( iorder.EQ.0)
WRITE( nout, fmt = 10000 )sname, nc
1375 IF ( iorder.EQ.1)
WRITE( nout, fmt = 10001 )sname, nc
1377 IF ( iorder.EQ.0)
WRITE( nout, fmt = 10002 )sname, nc, errmax
1378 IF ( iorder.EQ.1)
WRITE( nout, fmt = 10003 )sname, nc, errmax
1383 WRITE( nout, fmt = 9996 )sname
1385 $
CALL cprcn3( ntra, nc, sname, iorder, side, uplo, transa, diag,
1386 $ m, n, alpha, lda, ldb)
139110003
FORMAT(
' ', a13,
' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
1392 $
'TESTS (', i6,
' CALLS)', /
' ******* BUT WITH MAXIMUM TEST ',
1393 $
'RATIO ', f8.2,
' - SUSPECT *******' )
139410002
FORMAT(
' ', a13,
' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
1395 $
'TESTS (', i6,
' CALLS)', /
' ******* BUT WITH MAXIMUM TEST ',
1396 $
'RATIO ', f8.2,
' - SUSPECT *******' )
139710001
FORMAT(
' ', a13,
' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
1398 $
' (', i6,
' CALL',
'S)' )
139910000
FORMAT(
' ', a13,
' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
1400 $
' (', i6,
' CALL',
'S)' )
1401 9998
FORMAT(
' ******* FATAL ERROR - PARAMETER NUMBER ', i2,
' WAS CH',
1402 $
'ANGED INCORRECTLY *******' )
1403 9996
FORMAT(
' ******* ', a13,
' FAILED ON CALL NUMBER:' )
1404 9995
FORMAT(1x, i6,
': ', a13,
'(', 4(
'''', a1,
''',' ), 2( i3,
',' ),
1405 $
'(', f4.1,
',', f4.1,
'), A,', i3,
', B,', i3,
') ',
1407 9994
FORMAT(
' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
1093 SUBROUTINE cchk3( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
…
1414 SUBROUTINE cprcn3(NOUT, NC, SNAME, IORDER, SIDE, UPLO, TRANSA,
1415 $ DIAG, M, N, ALPHA, LDA, LDB)
1416 INTEGER NOUT, NC, IORDER, M, N, LDA, LDB
1418 CHARACTER*1 SIDE, UPLO, TRANSA, DIAG
1420 CHARACTER*14 CRC, CS, CU, CA, CD
1422 IF (SIDE.EQ.
'L')THEN
1427 IF (uplo.EQ.
'U')
THEN
1432 IF (transa.EQ.
'N')
THEN
1433 ca =
' CblasNoTrans'
1434 ELSE IF (transa.EQ.
'T')
THEN
1437 ca =
'CblasConjTrans'
1439 IF (diag.EQ.
'N')
THEN
1440 cd =
' CblasNonUnit'
1444 IF (iorder.EQ.1)
THEN
1445 crc =
' CblasRowMajor'
1447 crc =
' CblasColMajor'
1449 WRITE(nout, fmt = 9995)nc,sname,crc, cs,cu
1450 WRITE(nout, fmt = 9994)ca, cd, m, n, alpha, lda, ldb
1452 9995
FORMAT( 1x, i6,
': ', a13,
'(', a14,
',', a14,
',', a14,
',')
1453 9994
FORMAT( 10x, 2( a14,
',') , 2( i3,
',' ),
' (', f4.1,
',',
1454 $ f4.1,
'), A,', i3,
', B,', i3,
').' )
1414 SUBROUTINE cprcn3(NOUT, NC, SNAME, IORDER, SIDE, UPLO, TRANSA,
…
1457 SUBROUTINE cchk4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
1458 $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
1459 $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G,
1474 PARAMETER ( ZERO = ( 0.0, 0.0 ) )
1476 parameter( rone = 1.0, rzero = 0.0 )
1479 INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER
1480 LOGICAL FATAL, REWI, TRACE
1483 COMPLEX A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
1484 $ AS( NMAX*NMAX ), B( NMAX, NMAX ),
1485 $ BB( NMAX*NMAX ), BET( NBET ), BS( NMAX*NMAX ),
1486 $ C( NMAX, NMAX ), CC( NMAX*NMAX ),
1487 $ cs( nmax*nmax ), ct( nmax )
1489 INTEGER IDIM( NIDIM )
1491 COMPLEX ALPHA, ALS, BETA, BETS
1492 REAL ERR, ERRMAX, RALPHA, RALS, RBETA, RBETS
1493 INTEGER I, IA, IB, ICT, ICU, IK, IN, J, JC, JJ, K, KS,
1494 $ laa, lcc, lda, ldas, ldc, ldcs, lj, ma, n, na,
1496 LOGICAL CONJ, NULL, RESET, SAME, TRAN, UPPER
1497 CHARACTER*1 TRANS, TRANSS, TRANST, UPLO, UPLOS
1498 CHARACTER*2 ICHT, ICHU
1503 EXTERNAL lce, lceres
1507 INTRINSIC cmplx, max, real
1509 INTEGER INFOT, NOUTC
1512 COMMON /infoc/infot, noutc, ok, lerr
1514 DATA icht/
'NC'/, ichu/
'UL'/
1516 conj = sname( 8: 9 ).EQ.
'he'
1523 DO 100 in = 1, nidim
1538 trans = icht( ict: ict )
1540 IF( tran.AND..NOT.conj )
1560 CALL cmake(
'ge',
' ',
' ', ma, na, a, nmax, aa, lda,
1564 uplo = ichu( icu: icu )
1570 ralpha = real( alpha )
1571 alpha = cmplx( ralpha, rzero )
1577 rbeta = real( beta )
1578 beta = cmplx( rbeta, rzero )
1582 $ null = null.OR.( ( k.LE.0.OR.ralpha.EQ.
1583 $ rzero ).AND.rbeta.EQ.rone )
1587 CALL cmake( sname( 8: 9 ), uplo,
' ', n, n, c,
1588 $ nmax, cc, ldc, reset, zero )
1621 $
CALL cprcn6( ntra, nc, sname, iorder,
1622 $ uplo, trans, n, k, ralpha, lda, rbeta,
1626 CALL ccherk( iorder, uplo, trans, n, k,
1627 $ ralpha, aa, lda, rbeta, cc,
1631 $
CALL cprcn4( ntra, nc, sname, iorder,
1632 $ uplo, trans, n, k, alpha, lda, beta, ldc)
1635 CALL ccsyrk( iorder, uplo, trans, n, k,
1636 $ alpha, aa, lda, beta, cc, ldc )
1642 WRITE( nout, fmt = 9992 )
1649 isame( 1 ) = uplos.EQ.uplo
1650 isame( 2 ) = transs.EQ.trans
1651 isame( 3 ) = ns.EQ.n
1652 isame( 4 ) = ks.EQ.k
1654 isame( 5 ) = rals.EQ.ralpha
1656 isame( 5 ) = als.EQ.alpha
1658 isame( 6 ) = lce( as, aa, laa )
1659 isame( 7 ) = ldas.EQ.lda
1661 isame( 8 ) = rbets.EQ.rbeta
1663 isame( 8 ) = bets.EQ.beta
1666 isame( 9 ) = lce( cs, cc, lcc )
1668 isame( 9 ) = lceres( sname( 8: 9 ), uplo, n,
1671 isame( 10 ) = ldcs.EQ.ldc
1678 same = same.AND.isame( i )
1679 IF( .NOT.isame( i ) )
1680 $
WRITE( nout, fmt = 9998 )i
1706 CALL cmmch( transt,
'N', lj, 1, k,
1707 $ alpha, a( 1, jj ), nmax,
1708 $ a( 1, j ), nmax, beta,
1709 $ c( jj, j ), nmax, ct, g,
1710 $ cc( jc ), ldc, eps, err,
1711 $ fatal, nout, .true. )
1713 CALL cmmch(
'N', transt, lj, 1, k,
1714 $ alpha, a( jj, 1 ), nmax,
1715 $ a( j, 1 ), nmax, beta,
1716 $ c( jj, j ), nmax, ct, g,
1717 $ cc( jc ), ldc, eps, err,
1718 $ fatal, nout, .true. )
1725 errmax = max( errmax, err )
1747 IF( errmax.LT.thresh )
THEN
1748 IF ( iorder.EQ.0)
WRITE( nout, fmt = 10000 )sname, nc
1749 IF ( iorder.EQ.1)
WRITE( nout, fmt = 10001 )sname, nc
1751 IF ( iorder.EQ.0)
WRITE( nout, fmt = 10002 )sname, nc, errmax
1752 IF ( iorder.EQ.1)
WRITE( nout, fmt = 10003 )sname, nc, errmax
1758 $
WRITE( nout, fmt = 9995 )j
1761 WRITE( nout, fmt = 9996 )sname
1763 CALL cprcn6( nout, nc, sname, iorder, uplo, trans, n, k, ralpha,
1766 CALL cprcn4( nout, nc, sname, iorder, uplo, trans, n, k, alpha,
177310003
FORMAT(
' ', a13,
' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
1774 $
'TESTS (', i6,
' CALLS)', /
' ******* BUT WITH MAXIMUM TEST ',
1775 $
'RATIO ', f8.2,
' - SUSPECT *******' )
177610002
FORMAT(
' ', a13,
' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
1777 $
'TESTS (', i6,
' CALLS)', /
' ******* BUT WITH MAXIMUM TEST ',
1778 $
'RATIO ', f8.2,
' - SUSPECT *******' )
177910001
FORMAT(
' ', a13,
' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
1780 $
' (', i6,
' CALL',
'S)' )
178110000
FORMAT(
' ', a13,
' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
1782 $
' (', i6,
' CALL',
'S)' )
1783 9998
FORMAT(
' ******* FATAL ERROR - PARAMETER NUMBER ', i2,
' WAS CH',
1784 $
'ANGED INCORRECTLY *******' )
1785 9996
FORMAT(
' ******* ', a13,
' FAILED ON CALL NUMBER:' )
1786 9995
FORMAT(
' THESE ARE THE RESULTS FOR COLUMN ', i3 )
1787 9994
FORMAT(1x, i6,
': ', a13,
'(', 2(
'''', a1,
''',' ), 2( i3,
',' ),
1788 $ f4.1,
', A,', i3,
',', f4.1,
', C,', i3,
') ',
1790 9993
FORMAT(1x, i6,
': ', a13,
'(', 2(
'''', a1,
''',' ), 2( i3,
',' ),
1791 $
'(', f4.1,
',', f4.1,
') , A,', i3,
',(', f4.1,
',', f4.1,
1792 $
'), C,', i3,
') .' )
1793 9992
FORMAT(
' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
1457 SUBROUTINE cchk4( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
…
1800 SUBROUTINE cprcn4(NOUT, NC, SNAME, IORDER, UPLO, TRANSA,
1801 $ N, K, ALPHA, LDA, BETA, LDC)
1802 INTEGER NOUT, NC, IORDER, N, K, LDA, LDC
1804 CHARACTER*1 UPLO, TRANSA
1806 CHARACTER*14 CRC, CU, CA
1808 IF (uplo.EQ.
'U')
THEN
1813 IF (transa.EQ.
'N')
THEN
1814 ca =
' CblasNoTrans'
1815 ELSE IF (transa.EQ.
'T')
THEN
1818 ca =
'CblasConjTrans'
1820 IF (iorder.EQ.1)
THEN
1821 crc =
' CblasRowMajor'
1823 crc =
' CblasColMajor'
1825 WRITE(nout, fmt = 9995)nc, sname, crc, cu, ca
1826 WRITE(nout, fmt = 9994)n, k, alpha, lda, beta, ldc
1828 9995
FORMAT( 1x, i6,
': ', a13,
'(', 3( a14,
',') )
1829 9994
FORMAT( 10x, 2( i3,
',' ),
' (', f4.1,
',', f4.1 ,
'), A,',
1830 $ i3,
', (', f4.1,
',', f4.1,
'), C,', i3,
').' )
1800 SUBROUTINE cprcn4(NOUT, NC, SNAME, IORDER, UPLO, TRANSA,
…
1834 SUBROUTINE cprcn6(NOUT, NC, SNAME, IORDER, UPLO, TRANSA,
1835 $ N, K, ALPHA, LDA, BETA, LDC)
1836 INTEGER NOUT, NC, IORDER, N, K, LDA, LDC
1838 CHARACTER*1 UPLO, TRANSA
1840 CHARACTER*14 CRC, CU, CA
1842 IF (uplo.EQ.
'U')
THEN
1847 IF (transa.EQ.
'N')
THEN
1848 ca =
' CblasNoTrans'
1849 ELSE IF (transa.EQ.
'T')
THEN
1852 ca =
'CblasConjTrans'
1854 IF (iorder.EQ.1)
THEN
1855 crc =
' CblasRowMajor'
1857 crc =
' CblasColMajor'
1859 WRITE(nout, fmt = 9995)nc, sname, crc, cu, ca
1860 WRITE(nout, fmt = 9994)n, k, alpha, lda, beta, ldc
1862 9995
FORMAT( 1x, i6,
': ', a13,
'(', 3( a14,
',') )
1863 9994
FORMAT( 10x, 2( i3,
',' ),
1864 $ f4.1,
', A,', i3,
',', f4.1,
', C,', i3,
').' )
1834 SUBROUTINE cprcn6(NOUT, NC, SNAME, IORDER, UPLO, TRANSA,
…
1867 SUBROUTINE cchk5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
1868 $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
1869 $ AB, AA, AS, BB, BS, C, CC, CS, CT, G, W,
1884 parameter( zero = ( 0.0, 0.0 ), one = ( 1.0, 0.0 ) )
1886 parameter( rone = 1.0, rzero = 0.0 )
1889 INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER
1890 LOGICAL FATAL, REWI, TRACE
1893 COMPLEX AA( NMAX*NMAX ), AB( 2*NMAX*NMAX ),
1894 $ ALF( NALF ), AS( NMAX*NMAX ), BB( NMAX*NMAX ),
1895 $ BET( NBET ), BS( NMAX*NMAX ), C( NMAX, NMAX ),
1896 $ CC( NMAX*NMAX ), CS( NMAX*NMAX ), CT( NMAX ),
1899 INTEGER IDIM( NIDIM )
1901 COMPLEX ALPHA, ALS, BETA, BETS
1902 REAL ERR, ERRMAX, RBETA, RBETS
1903 INTEGER I, IA, IB, ICT, ICU, IK, IN, J, JC, JJ, JJAB,
1904 $ k, ks, laa, lbb, lcc, lda, ldas, ldb, ldbs,
1905 $ ldc, ldcs, lj, ma, n, na, nargs, nc, ns
1906 LOGICAL CONJ, NULL, RESET, SAME, TRAN, UPPER
1907 CHARACTER*1 TRANS, TRANSS, TRANST, UPLO, UPLOS
1908 CHARACTER*2 ICHT, ICHU
1913 EXTERNAL LCE, LCERES
1915 EXTERNAL CCHER2K, CMAKE, CMMCH, CCSYR2K
1917 INTRINSIC cmplx, conjg, max, real
1919 INTEGER INFOT, NOUTC
1922 COMMON /infoc/infot, noutc, ok, lerr
1924 DATA icht/
'NC'/, ichu/
'UL'/
1926 conj = sname( 8: 9 ).EQ.
'he'
1933 DO 130 in = 1, nidim
1944 DO 120 ik = 1, nidim
1948 trans = icht( ict: ict )
1950 IF( tran.AND..NOT.conj )
1971 CALL cmake(
'ge',
' ',
' ', ma, na, ab, 2*nmax, aa,
1972 $ lda, reset, zero )
1974 CALL cmake(
'ge',
' ',
' ', ma, na, ab, nmax, aa, lda,
1983 CALL cmake(
'ge',
' ',
' ', ma, na, ab( k + 1 ),
1984 $ 2*nmax, bb, ldb, reset, zero )
1986 CALL cmake(
'ge',
' ',
' ', ma, na, ab( k*nmax + 1 ),
1987 $ nmax, bb, ldb, reset, zero )
1991 uplo = ichu( icu: icu )
2000 rbeta = real( beta )
2001 beta = cmplx( rbeta, rzero )
2005 $ null = null.OR.( ( k.LE.0.OR.alpha.EQ.
2006 $ zero ).AND.rbeta.EQ.rone )
2010 CALL cmake( sname( 8: 9 ), uplo,
' ', n, n, c,
2011 $ nmax, cc, ldc, reset, zero )
2044 $
CALL cprcn7( ntra, nc, sname, iorder,
2045 $ uplo, trans, n, k, alpha, lda, ldb,
2049 CALL ccher2k( iorder, uplo, trans, n, k,
2050 $ alpha, aa, lda, bb, ldb, rbeta,
2054 $
CALL cprcn5( ntra, nc, sname, iorder,
2055 $ uplo, trans, n, k, alpha, lda, ldb,
2059 CALL ccsyr2k( iorder, uplo, trans, n, k,
2060 $ alpha, aa, lda, bb, ldb, beta,
2067 WRITE( nout, fmt = 9992 )
2074 isame( 1 ) = uplos.EQ.uplo
2075 isame( 2 ) = transs.EQ.trans
2076 isame( 3 ) = ns.EQ.n
2077 isame( 4 ) = ks.EQ.k
2078 isame( 5 ) = als.EQ.alpha
2079 isame( 6 ) = lce( as, aa, laa )
2080 isame( 7 ) = ldas.EQ.lda
2081 isame( 8 ) = lce( bs, bb, lbb )
2082 isame( 9 ) = ldbs.EQ.ldb
2084 isame( 10 ) = rbets.EQ.rbeta
2086 isame( 10 ) = bets.EQ.beta
2089 isame( 11 ) = lce( cs, cc, lcc )
2091 isame( 11 ) = lceres(
'he', uplo, n, n, cs,
2094 isame( 12 ) = ldcs.EQ.ldc
2101 same = same.AND.isame( i )
2102 IF( .NOT.isame( i ) )
2103 $
WRITE( nout, fmt = 9998 )i
2131 w( i ) = alpha*ab( ( j - 1 )*2*
2134 w( k + i ) = conjg( alpha )*
2143 CALL cmmch( transt,
'N', lj, 1, 2*k,
2144 $ one, ab( jjab ), 2*nmax, w,
2145 $ 2*nmax, beta, c( jj, j ),
2146 $ nmax, ct, g, cc( jc ), ldc,
2147 $ eps, err, fatal, nout,
2152 w( i ) = alpha*conjg( ab( ( k +
2153 $ i - 1 )*nmax + j ) )
2154 w( k + i ) = conjg( alpha*
2155 $ ab( ( i - 1 )*nmax +
2158 w( i ) = alpha*ab( ( k + i - 1 )*
2161 $ ab( ( i - 1 )*nmax +
2165 CALL cmmch(
'N',
'N', lj, 1, 2*k, one,
2166 $ ab( jj ), nmax, w, 2*nmax,
2167 $ beta, c( jj, j ), nmax, ct,
2168 $ g, cc( jc ), ldc, eps, err,
2169 $ fatal, nout, .true. )
2176 $ jjab = jjab + 2*nmax
2178 errmax = max( errmax, err )
2200 IF( errmax.LT.thresh )
THEN
2201 IF ( iorder.EQ.0)
WRITE( nout, fmt = 10000 )sname, nc
2202 IF ( iorder.EQ.1)
WRITE( nout, fmt = 10001 )sname, nc
2204 IF ( iorder.EQ.0)
WRITE( nout, fmt = 10002 )sname, nc, errmax
2205 IF ( iorder.EQ.1)
WRITE( nout, fmt = 10003 )sname, nc, errmax
2211 $
WRITE( nout, fmt = 9995 )j
2214 WRITE( nout, fmt = 9996 )sname
2216 CALL cprcn7( nout, nc, sname, iorder, uplo, trans, n, k,
2217 $ alpha, lda, ldb, rbeta, ldc)
2219 CALL cprcn5( nout, nc, sname, iorder, uplo, trans, n, k,
2220 $ alpha, lda, ldb, beta, ldc)
222610003
FORMAT(
' ', a13,
' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
2227 $
'TESTS (', i6,
' CALLS)', /
' ******* BUT WITH MAXIMUM TEST ',
2228 $
'RATIO ', f8.2,
' - SUSPECT *******' )
222910002
FORMAT(
' ', a13,
' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
2230 $
'TESTS (', i6,
' CALLS)', /
' ******* BUT WITH MAXIMUM TEST ',
2231 $
'RATIO ', f8.2,
' - SUSPECT *******' )
223210001
FORMAT(
' ', a13,
' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
2233 $
' (', i6,
' CALL',
'S)' )
223410000
FORMAT(
' ', a13,
' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
2235 $
' (', i6,
' CALL',
'S)' )
2236 9998
FORMAT(
' ******* FATAL ERROR - PARAMETER NUMBER ', i2,
' WAS CH',
2237 $
'ANGED INCORRECTLY *******' )
2238 9996
FORMAT(
' ******* ', a13,
' FAILED ON CALL NUMBER:' )
2239 9995
FORMAT(
' THESE ARE THE RESULTS FOR COLUMN ', i3 )
2240 9994
FORMAT(1x, i6,
': ', a13,
'(', 2(
'''', a1,
''',' ), 2( i3,
',' ),
2241 $
'(', f4.1,
',', f4.1,
'), A,', i3,
', B,', i3,
',', f4.1,
2242 $
', C,', i3,
') .' )
2243 9993
FORMAT(1x, i6,
': ', a13,
'(', 2(
'''', a1,
''',' ), 2( i3,
',' ),
2244 $
'(', f4.1,
',', f4.1,
'), A,', i3,
', B,', i3,
',(', f4.1,
2245 $
',', f4.1,
'), C,', i3,
') .' )
2246 9992
FORMAT(
' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
1867 SUBROUTINE cchk5( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
…
2253 SUBROUTINE cprcn5(NOUT, NC, SNAME, IORDER, UPLO, TRANSA,
2254 $ N, K, ALPHA, LDA, LDB, BETA, LDC)
2255 INTEGER NOUT, NC, IORDER, N, K, LDA, LDB, LDC
2257 CHARACTER*1 UPLO, TRANSA
2259 CHARACTER*14 CRC, CU, CA
2261 IF (uplo.EQ.
'U')
THEN
2266 IF (transa.EQ.
'N')
THEN
2267 ca =
' CblasNoTrans'
2268 ELSE IF (transa.EQ.
'T')
THEN
2271 ca =
'CblasConjTrans'
2273 IF (iorder.EQ.1)
THEN
2274 crc =
' CblasRowMajor'
2276 crc =
' CblasColMajor'
2278 WRITE(nout, fmt = 9995)nc, sname, crc, cu, ca
2279 WRITE(nout, fmt = 9994)n, k, alpha, lda, ldb, beta, ldc
2281 9995
FORMAT( 1x, i6,
': ', a13,
'(', 3( a14,
',') )
2282 9994
FORMAT( 10x, 2( i3,
',' ),
' (', f4.1,
',', f4.1,
'), A,',
2283 $ i3,
', B', i3,
', (', f4.1,
',', f4.1,
'), C,', i3,
').' )
2253 SUBROUTINE cprcn5(NOUT, NC, SNAME, IORDER, UPLO, TRANSA,
…
2287 SUBROUTINE cprcn7(NOUT, NC, SNAME, IORDER, UPLO, TRANSA,
2288 $ N, K, ALPHA, LDA, LDB, BETA, LDC)
2289 INTEGER NOUT, NC, IORDER, N, K, LDA, LDB, LDC
2292 CHARACTER*1 UPLO, TRANSA
2294 CHARACTER*14 CRC, CU, CA
2296 IF (uplo.EQ.
'U')
THEN
2301 IF (transa.EQ.
'N')
THEN
2302 ca =
' CblasNoTrans'
2303 ELSE IF (transa.EQ.
'T')
THEN
2306 ca =
'CblasConjTrans'
2308 IF (iorder.EQ.1)
THEN
2309 crc =
' CblasRowMajor'
2311 crc =
' CblasColMajor'
2313 WRITE(nout, fmt = 9995)nc, sname, crc, cu, ca
2314 WRITE(nout, fmt = 9994)n, k, alpha, lda, ldb, beta, ldc
2316 9995
FORMAT( 1x, i6,
': ', a13,
'(', 3( a14,
',') )
2317 9994
FORMAT( 10x, 2( i3,
',' ),
' (', f4.1,
',', f4.1,
'), A,',
2318 $ i3,
', B', i3,
',', f4.1,
', C,', i3,
').' )
2287 SUBROUTINE cprcn7(NOUT, NC, SNAME, IORDER, UPLO, TRANSA,
…
2321 SUBROUTINE cmake(TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, RESET,
2340 PARAMETER ( ZERO = ( 0.0, 0.0 ), one = ( 1.0, 0.0 ) )
2342 PARAMETER ( ROGUE = ( -1.0e10, 1.0e10 ) )
2344 PARAMETER ( RZERO = 0.0 )
2346 parameter( rrogue = -1.0e10 )
2349 INTEGER LDA, M, N, NMAX
2351 CHARACTER*1 DIAG, UPLO
2354 COMPLEX A( NMAX, * ), AA( * )
2356 INTEGER I, IBEG, IEND, J, JJ
2357 LOGICAL GEN, HER, LOWER, SYM, TRI, UNIT, UPPER
2362 INTRINSIC cmplx, conjg, real
2368 upper = ( her.OR.sym.OR.tri ).AND.uplo.EQ.
'U'
2369 lower = ( her.OR.sym.OR.tri ).AND.uplo.EQ.
'L'
2370 unit = tri.AND.diag.EQ.
'U'
2376 IF( gen.OR.( upper.AND.i.LE.j ).OR.( lower.AND.i.GE.j ) )
2378 a( i, j ) = cbeg( reset ) + transl
2381 IF( n.GT.3.AND.j.EQ.n/2 )
2384 a( j, i ) = conjg( a( i, j ) )
2386 a( j, i ) = a( i, j )
2394 $ a( j, j ) = cmplx( real( a( j, j ) ), rzero )
2396 $ a( j, j ) = a( j, j ) + one
2403 IF( type.EQ.
'ge' )
THEN
2406 aa( i + ( j - 1 )*lda ) = a( i, j )
2408 DO 40 i = m + 1, lda
2409 aa( i + ( j - 1 )*lda ) = rogue
2412 ELSE IF( type.EQ.
'he'.OR.type.EQ.
'sy'.OR.type.EQ.
'tr' )
THEN
2429 DO 60 i = 1, ibeg - 1
2430 aa( i + ( j - 1 )*lda ) = rogue
2432 DO 70 i = ibeg, iend
2433 aa( i + ( j - 1 )*lda ) = a( i, j )
2435 DO 80 i = iend + 1, lda
2436 aa( i + ( j - 1 )*lda ) = rogue
2439 jj = j + ( j - 1 )*lda
2440 aa( jj ) = cmplx( real( aa( jj ) ), rrogue )
2321 SUBROUTINE cmake(TYPE, UPLO, DIAG, M, N, A, NMAX, AA, LDA, RESET,
…
2449 SUBROUTINE cmmch(TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB,
2450 $ BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR, FATAL,
2465 parameter( zero = ( 0.0, 0.0 ) )
2467 parameter( rzero = 0.0, rone = 1.0 )
2471 INTEGER KK, LDA, LDB, LDC, LDCC, M, N, NOUT
2473 CHARACTER*1 TRANSA, TRANSB
2475 COMPLEX A( LDA, * ), B( LDB, * ), C( LDC, * ),
2476 $ CC( LDCC, * ), CT( * )
2482 LOGICAL CTRANA, CTRANB, TRANA, TRANB
2484 INTRINSIC ABS, AIMAG, CONJG, MAX,
REAL, SQRT
2488 abs1( cl ) = abs( real( cl ) ) + abs( aimag( cl ) )
2490 trana = transa.EQ.
'T'.OR.transa.EQ.
'C'
2491 tranb = transb.EQ.
'T'.OR.transb.EQ.
'C'
2492 ctrana = transa.EQ.
'C'
2493 ctranb = transb.EQ.
'C'
2505 IF( .NOT.trana.AND..NOT.tranb )
THEN
2508 ct( i ) = ct( i ) + a( i, k )*b( k, j )
2509 g( i ) = g( i ) + abs1( a( i, k ) )*abs1( b( k, j ) )
2512 ELSE IF( trana.AND..NOT.tranb )
THEN
2516 ct( i ) = ct( i ) + conjg( a( k, i ) )*b( k, j )
2517 g( i ) = g( i ) + abs1( a( k, i ) )*
2524 ct( i ) = ct( i ) + a( k, i )*b( k, j )
2525 g( i ) = g( i ) + abs1( a( k, i ) )*
2530 ELSE IF( .NOT.trana.AND.tranb )
THEN
2534 ct( i ) = ct( i ) + a( i, k )*conjg( b( j, k ) )
2535 g( i ) = g( i ) + abs1( a( i, k ) )*
2542 ct( i ) = ct( i ) + a( i, k )*b( j, k )
2543 g( i ) = g( i ) + abs1( a( i, k ) )*
2548 ELSE IF( trana.AND.tranb )
THEN
2553 ct( i ) = ct( i ) + conjg( a( k, i ) )*
2554 $ conjg( b( j, k ) )
2555 g( i ) = g( i ) + abs1( a( k, i ) )*
2562 ct( i ) = ct( i ) + conjg( a( k, i ) )*b( j, k )
2563 g( i ) = g( i ) + abs1( a( k, i ) )*
2572 ct( i ) = ct( i ) + a( k, i )*conjg( b( j, k ) )
2573 g( i ) = g( i ) + abs1( a( k, i ) )*
2580 ct( i ) = ct( i ) + a( k, i )*b( j, k )
2581 g( i ) = g( i ) + abs1( a( k, i ) )*
2589 ct( i ) = alpha*ct( i ) + beta*c( i, j )
2590 g( i ) = abs1( alpha )*g( i ) +
2591 $ abs1( beta )*abs1( c( i, j ) )
2598 erri = abs1( ct( i ) - cc( i, j ) )/eps
2599 IF( g( i ).NE.rzero )
2600 $ erri = erri/g( i )
2601 err = max( err, erri )
2602 IF( err*sqrt( eps ).GE.rone )
2614 WRITE( nout, fmt = 9999 )
2617 WRITE( nout, fmt = 9998 )i, ct( i ), cc( i, j )
2619 WRITE( nout, fmt = 9998 )i, cc( i, j ), ct( i )
2623 $
WRITE( nout, fmt = 9997 )j
2628 9999
FORMAT(
' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL',
2629 $
'F ACCURATE *******', /
' EXPECTED RE',
2630 $
'SULT COMPUTED RESULT' )
2631 9998
FORMAT( 1x, i7, 2(
' (', g15.6,
',', g15.6,
')' ) )
2632 9997
FORMAT(
' THESE ARE THE RESULTS FOR COLUMN ', i3 )
2449 SUBROUTINE cmmch(TRANSA, TRANSB, M, N, KK, ALPHA, A, LDA, B, LDB,
…
2637 LOGICAL FUNCTION lce( RI, RJ, LR )
2652 COMPLEX ri( * ), rj( * )
2657 IF( ri( i ).NE.rj( i ) )
2637 LOGICAL FUNCTION lce( RI, RJ, LR )
…
2669 LOGICAL FUNCTION lceres( TYPE, UPLO, M, N, AA, AS, LDA )
2688 COMPLEX aa( lda, * ), as( lda, * )
2690 INTEGER i, ibeg, iend, j
2694 IF( type.EQ.
'ge' )
THEN
2696 DO 10 i = m + 1, lda
2697 IF( aa( i, j ).NE.as( i, j ) )
2701 ELSE IF( type.EQ.
'he'.OR.type.EQ.
'sy' )
THEN
2710 DO 30 i = 1, ibeg - 1
2711 IF( aa( i, j ).NE.as( i, j ) )
2714 DO 40 i = iend + 1, lda
2715 IF( aa( i, j ).NE.as( i, j ) )
2669 LOGICAL FUNCTION lceres( TYPE, UPLO, M, N, AA, AS, LDA )
…
2747 INTEGER i, ic, j, mi, mj
2749 SAVE i, ic, j, mi, mj
2773 i = i - 1000*( i/1000 )
2774 j = j - 1000*( j/1000 )
2779 cbeg = cmplx( ( i - 500 )/1001.0, ( j - 500 )/1001.0 )
2805 SUBROUTINE cchk6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
2806 $ FATAL, NIDIM, IDIM, NALF, ALF, NBET, BET, NMAX,
2807 $ A, AA, AS, B, BB, BS, C, CC, CS, CT, G,
2820 PARAMETER ( ZERO = ( 0.0, 0.0 ) )
2822 parameter( rzero = 0.0 )
2825 INTEGER NALF, NBET, NIDIM, NMAX, NOUT, NTRA, IORDER
2826 LOGICAL FATAL, REWI, TRACE
2829 COMPLEX A( NMAX, NMAX ), AA( NMAX*NMAX ), ALF( NALF ),
2830 $ as( nmax*nmax ), b( nmax, nmax ),
2831 $ bb( nmax*nmax ), bet( nbet ), bs( nmax*nmax ),
2832 $ c( nmax, nmax ), cc( nmax*nmax ),
2833 $ cs( nmax*nmax ), ct( nmax )
2835 INTEGER IDIM( NIDIM )
2837 COMPLEX ALPHA, ALS, BETA, BLS
2839 INTEGER I, IA, IB, ICA, ICB, IK, IM, IN, K, KS, LAA,
2840 $ LBB, LCC, LDA, LDAS, LDB, LDBS, LDC, LDCS,
2841 $ MA, MB, N, NA, NARGS, NB, NC, NS, IS
2842 LOGICAL NULL, RESET, SAME, TRANA, TRANB
2843 CHARACTER*1 TRANAS, TRANBS, TRANSA, TRANSB, UPLO, UPLOS
2850 EXTERNAL LCE, LCERES
2856 INTEGER INFOT, NOUTC
2859 COMMON /INFOC/INFOT, NOUTC, OK, LERR
2870 DO 100 in = 1, nidim
2886 transa = ich( ica: ica )
2887 trana = transa.EQ.
'T'.OR.transa.EQ.
'C'
2907 CALL cmake(
'ge',
' ',
' ', ma, na, a, nmax, aa, lda,
2911 transb = ich( icb: icb )
2912 tranb = transb.EQ.
'T'.OR.transb.EQ.
'C'
2932 CALL cmake(
'ge',
' ',
' ', mb, nb, b, nmax, bb,
2933 $ ldb, reset, zero )
2941 uplo = ishape(is:is)
2945 CALL cmake(
'ge', uplo,
' ', n, n, c, nmax,
2946 $ cc, ldc, reset, zero )
2976 $
CALL cprcn8(ntra, nc, sname, iorder, uplo,
2977 $ transa, transb, n, k, alpha, lda,
2981 CALL ccgemmtr(iorder, uplo, transa, transb,
2982 $ n, k, alpha, aa, lda, bb, ldb,
2988 WRITE( nout, fmt = 9994 )
2995 isame( 1 ) = uplo .EQ. uplos
2996 isame( 2 ) = transa.EQ.tranas
2997 isame( 3 ) = transb.EQ.tranbs
2998 isame( 4 ) = ns.EQ.n
2999 isame( 5 ) = ks.EQ.k
3000 isame( 6 ) = als.EQ.alpha
3001 isame( 7 ) = lce( as, aa, laa )
3002 isame( 8 ) = ldas.EQ.lda
3003 isame( 9 ) = lce( bs, bb, lbb )
3004 isame( 10 ) = ldbs.EQ.ldb
3005 isame( 11 ) = bls.EQ.beta
3007 isame( 12 ) = lce( cs, cc, lcc )
3009 isame( 12 ) = lceres(
'ge',
' ', n, n, cs,
3012 isame( 13 ) = ldcs.EQ.ldc
3019 same = same.AND.isame( i )
3020 IF( .NOT.isame( i ) )
3021 $
WRITE( nout, fmt = 9998 )i
3032 CALL cmmtch( uplo, transa, transb, n, k,
3033 $ alpha, a, nmax, b, nmax, beta,
3034 $ c, nmax, ct, g, cc, ldc, eps,
3035 $ err, fatal, nout, .true. )
3036 errmax = max( errmax, err )
3060 IF( errmax.LT.thresh )
THEN
3061 IF ( iorder.EQ.0)
WRITE( nout, fmt = 10000 )sname, nc
3062 IF ( iorder.EQ.1)
WRITE( nout, fmt = 10001 )sname, nc
3064 IF ( iorder.EQ.0)
WRITE( nout, fmt = 10002 )sname, nc, errmax
3065 IF ( iorder.EQ.1)
WRITE( nout, fmt = 10003 )sname, nc, errmax
3070 WRITE( nout, fmt = 9996 )sname
3071 CALL cprcn8(nout, nc, sname, iorder, uplo, transa, transb,
3072 $ n, k, alpha, lda, ldb, beta, ldc)
307710003
FORMAT(
' ', a13,
' COMPLETED THE ROW-MAJOR COMPUTATIONAL ',
3078 $
'TESTS (', i6,
' CALLS)', /
' ******* BUT WITH MAXIMUM TEST ',
3079 $
'RATIO ', f8.2,
' - SUSPECT *******' )
308010002
FORMAT(
' ', a13,
' COMPLETED THE COLUMN-MAJOR COMPUTATIONAL ',
3081 $
'TESTS (', i6,
' CALLS)', /
' ******* BUT WITH MAXIMUM TEST ',
3082 $
'RATIO ', f8.2,
' - SUSPECT *******' )
308310001
FORMAT(
' ', a13,
' PASSED THE ROW-MAJOR COMPUTATIONAL TESTS',
3084 $
' (', i6,
' CALL',
'S)' )
308510000
FORMAT(
' ', a13,
' PASSED THE COLUMN-MAJOR COMPUTATIONAL TESTS',
3086 $
' (', i6,
' CALL',
'S)' )
3087 9998
FORMAT(
' ******* FATAL ERROR - PARAMETER NUMBER ', i2,
' WAS CH',
3088 $
'ANGED INCORRECTLY *******' )
3089 9996
FORMAT(
' ******* ', a13,
' FAILED ON CALL NUMBER:' )
3090 9995
FORMAT( 1x, i6,
': ', a13,
'(''', a1,
''',''', a1,
''',',
3091 $ 3( i3,
',' ),
'(', f4.1,
',', f4.1,
'), A,', i3,
', B,', i3,
3092 $
',(', f4.1,
',', f4.1,
'), C,', i3,
').' )
3093 9994
FORMAT(
' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
2805 SUBROUTINE cchk6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
…
3100 SUBROUTINE cprcn8(NOUT, NC, SNAME, IORDER, UPLO,
3101 $ TRANSA, TRANSB, N,
3102 $ K, ALPHA, LDA, LDB, BETA, LDC)
3103 INTEGER NOUT, NC, IORDER, N, K, LDA, LDB, LDC
3105 CHARACTER*1 TRANSA, TRANSB, UPLO
3107 CHARACTER*14 CRC, CTA,CTB,CUPLO
3109 IF (uplo.EQ.
'U')
THEN
3110 cuplo =
'CblasUpper'
3112 cuplo =
'CblasLower'
3114 IF (transa.EQ.
'N')
THEN
3115 cta =
' CblasNoTrans'
3116 ELSE IF (transa.EQ.
'T')
THEN
3119 cta =
'CblasConjTrans'
3121 IF (transb.EQ.
'N')
THEN
3122 ctb =
' CblasNoTrans'
3123 ELSE IF (transb.EQ.
'T')
THEN
3126 ctb =
'CblasConjTrans'
3128 IF (iorder.EQ.1)
THEN
3129 crc =
' CblasRowMajor'
3131 crc =
' CblasColMajor'
3133 WRITE(nout, fmt = 9995)nc,sname,crc, cuplo, cta,ctb
3134 WRITE(nout, fmt = 9994)n, k, alpha, lda, ldb, beta, ldc
3136 9995
FORMAT( 1x, i6,
': ', a13,
'(', a14,
',', a14,
',', a14,
',',
3138 9994
FORMAT( 10x, 2( i3,
',' ) ,
' (', f4.1,
',',f4.1,
') , A,',
3139 $ i3,
', B,', i3,
', (', f4.1,
',',f4.1,
') , C,', i3,
').' )
3100 SUBROUTINE cprcn8(NOUT, NC, SNAME, IORDER, UPLO,
…
3142 SUBROUTINE cmmtch(UPLO, TRANSA, TRANSB, N, KK, ALPHA, A, LDA,
3144 $ BETA, C, LDC, CT, G, CC, LDCC, EPS, ERR, FATAL,
3157 parameter( zero = ( 0.0, 0.0 ) )
3159 parameter( rzero = 0.0, rone = 1.0 )
3163 INTEGER KK, LDA, LDB, LDC, LDCC, N, NOUT
3165 CHARACTER*1 TRANSA, TRANSB, UPLO
3167 COMPLEX A( LDA, * ), B( LDB, * ), C( LDC, * ),
3168 $ cc( ldcc, * ), ct( * )
3173 INTEGER I, J, K, ISTART, ISTOP
3174 LOGICAL CTRANA, CTRANB, TRANA, TRANB, UPPER
3176 INTRINSIC ABS, AIMAG, CONJG, MAX,
REAL, SQRT
3180 ABS1( CL ) = abs( real( cl ) ) + abs( aimag( cl ) )
3184 trana = transa.EQ.
'T'.OR.transa.EQ.
'C'
3185 tranb = transb.EQ.
'T'.OR.transb.EQ.
'C'
3186 ctrana = transa.EQ.
'C'
3187 ctranb = transb.EQ.
'C'
3205 DO 10 i = istart, istop
3209 IF( .NOT.trana.AND..NOT.tranb )
THEN
3211 DO 20 i = istart, istop
3212 ct( i ) = ct( i ) + a( i, k )*b( k, j )
3213 g( i ) = g( i ) + abs1( a( i, k ) )*abs1( b( k, j ) )
3216 ELSE IF( trana.AND..NOT.tranb )
THEN
3219 DO 40 i = istart, istop
3220 ct( i ) = ct( i ) + conjg( a( k, i ) )*b( k, j )
3221 g( i ) = g( i ) + abs1( a( k, i ) )*
3227 DO 60 i = istart, istop
3228 ct( i ) = ct( i ) + a( k, i )*b( k, j )
3229 g( i ) = g( i ) + abs1( a( k, i ) )*
3234 ELSE IF( .NOT.trana.AND.tranb )
THEN
3237 DO 80 i = istart, istop
3238 ct( i ) = ct( i ) + a( i, k )*conjg( b( j, k ) )
3239 g( i ) = g( i ) + abs1( a( i, k ) )*
3245 DO 100 i = istart, istop
3246 ct( i ) = ct( i ) + a( i, k )*b( j, k )
3247 g( i ) = g( i ) + abs1( a( i, k ) )*
3252 ELSE IF( trana.AND.tranb )
THEN
3256 DO 120 i = istart, istop
3257 ct( i ) = ct( i ) + conjg( a( k, i ) )*
3258 $ conjg( b( j, k ) )
3259 g( i ) = g( i ) + abs1( a( k, i ) )*
3265 DO 140 i = istart, istop
3266 ct( i ) = ct( i ) + conjg( a( k, i ) )*b( j, k )
3267 g( i ) = g( i ) + abs1( a( k, i ) )*
3275 DO 160 i = istart, istop
3276 ct( i ) = ct( i ) + a( k, i )*conjg( b( j, k ) )
3277 g( i ) = g( i ) + abs1( a( k, i ) )*
3283 DO 180 i = istart, istop
3284 ct( i ) = ct( i ) + a( k, i )*b( j, k )
3285 g( i ) = g( i ) + abs1( a( k, i ) )*
3292 DO 200 i = istart, istop
3293 ct( i ) = alpha*ct( i ) + beta*c( i, j )
3294 g( i ) = abs1( alpha )*g( i ) +
3295 $ abs1( beta )*abs1( c( i, j ) )
3301 DO 210 i = istart, istop
3302 erri = abs1( ct( i ) - cc( i, j ) )/eps
3303 IF( g( i ).NE.rzero )
3304 $ erri = erri/g( i )
3305 err = max( err, erri )
3306 IF( err*sqrt( eps ).GE.rone )
3318 WRITE( nout, fmt = 9999 )
3319 DO 240 i = istart, istop
3321 WRITE( nout, fmt = 9998 )i, ct( i ), cc( i, j )
3323 WRITE( nout, fmt = 9998 )i, cc( i, j ), ct( i )
3327 $
WRITE( nout, fmt = 9997 )j
3332 9999
FORMAT(
' ******* FATAL ERROR - COMPUTED RESULT IS LESS THAN HAL',
3333 $
'F ACCURATE *******', /
' EXPECTED RE',
3334 $
'SULT COMPUTED RESULT' )
3335 9998
FORMAT( 1x, i7, 2(
' (', g15.6,
',', g15.6,
')' ) )
3336 9997
FORMAT(
' THESE ARE THE RESULTS FOR COLUMN ', i3 )
3142 SUBROUTINE cmmtch(UPLO, TRANSA, TRANSB, N, KK, ALPHA, A, LDA,
…
subroutine cprcn6(nout, nc, sname, iorder, uplo, transa, n, k, alpha, lda, beta, ldc)
subroutine cprcn4(nout, nc, sname, iorder, uplo, transa, n, k, alpha, lda, beta, ldc)
subroutine cprcn7(nout, nc, sname, iorder, uplo, transa, n, k, alpha, lda, ldb, beta, ldc)
subroutine cprcn3(nout, nc, sname, iorder, side, uplo, transa, diag, m, n, alpha, lda, ldb)
subroutine cprcn2(nout, nc, sname, iorder, side, uplo, m, n, alpha, lda, ldb, beta, ldc)
subroutine cprcn1(nout, nc, sname, iorder, transa, transb, m, n, k, alpha, lda, ldb, beta, ldc)
subroutine cprcn8(nout, nc, sname, iorder, uplo, transa, transb, n, k, alpha, lda, ldb, beta, ldc)
subroutine cprcn5(nout, nc, sname, iorder, uplo, transa, n, k, alpha, lda, ldb, beta, ldc)
real function sdiff(sa, sb)
subroutine cmake(type, uplo, diag, m, n, a, nmax, aa, lda, kl, ku, reset, transl)
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)
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 cchk6(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)
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)
logical function lceres(type, uplo, m, n, aa, as, lda)
logical function lce(ri, rj, lr)
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)
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)
complex function cbeg(reset)
subroutine cmmtch(uplo, transa, transb, n, kk, alpha, a, lda, b, ldb, beta, c, ldc, ct, g, cc, ldcc, eps, err, fatal, nout, mv)
subroutine cmmch(transa, transb, m, n, kk, alpha, a, lda, b, ldb, beta, c, ldc, ct, g, cc, ldcc, eps, err, fatal, nout, mv)