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