 |
LAPACK 3.3.1
Linear Algebra PACKage
|
|
LAPACK 3.3.1
Linear Algebra PACKage
|
00001 SUBROUTINE ALARQG( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 00002 * 00003 * -- LAPACK test routine (version 3.1) -- 00004 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. 00005 * November 2006 00006 * 00007 * .. Scalar Arguments .. 00008 CHARACTER*3 PATH 00009 INTEGER NIN, NMATS, NOUT, NTYPES 00010 * .. 00011 * .. Array Arguments .. 00012 LOGICAL DOTYPE( * ) 00013 * .. 00014 * 00015 * Purpose 00016 * ======= 00017 * 00018 * ALARQG handles input for the LAPACK test program. It is called 00019 * to evaluate the input line which requested NMATS matrix types for 00020 * PATH. The flow of control is as follows: 00021 * 00022 * If NMATS = NTYPES then 00023 * DOTYPE(1:NTYPES) = .TRUE. 00024 * else 00025 * Read the next input line for NMATS matrix types 00026 * Set DOTYPE(I) = .TRUE. for each valid type I 00027 * endif 00028 * 00029 * Arguments 00030 * ========= 00031 * 00032 * PATH (input) CHARACTER*3 00033 * An LAPACK path name for testing. 00034 * 00035 * NMATS (input) INTEGER 00036 * The number of matrix types to be used in testing this path. 00037 * 00038 * DOTYPE (output) LOGICAL array, dimension (NTYPES) 00039 * The vector of flags indicating if each type will be tested. 00040 * 00041 * NTYPES (input) INTEGER 00042 * The maximum number of matrix types for this path. 00043 * 00044 * NIN (input) INTEGER 00045 * The unit number for input. NIN >= 1. 00046 * 00047 * NOUT (input) INTEGER 00048 * The unit number for output. NOUT >= 1. 00049 * 00050 * ====================================================================== 00051 * 00052 * .. Local Scalars .. 00053 LOGICAL FIRSTT 00054 CHARACTER C1 00055 CHARACTER*10 INTSTR 00056 CHARACTER*80 LINE 00057 INTEGER I, I1, IC, J, K, LENP, NT 00058 * .. 00059 * .. Local Arrays .. 00060 INTEGER NREQ( 100 ) 00061 * .. 00062 * .. Intrinsic Functions .. 00063 INTRINSIC LEN 00064 * .. 00065 * .. Data statements .. 00066 DATA INTSTR / '0123456789' / 00067 * .. 00068 * .. Executable Statements .. 00069 * 00070 IF( NMATS.GE.NTYPES ) THEN 00071 * 00072 * Test everything if NMATS >= NTYPES. 00073 * 00074 DO 10 I = 1, NTYPES 00075 DOTYPE( I ) = .TRUE. 00076 10 CONTINUE 00077 ELSE 00078 DO 20 I = 1, NTYPES 00079 DOTYPE( I ) = .FALSE. 00080 20 CONTINUE 00081 FIRSTT = .TRUE. 00082 * 00083 * Read a line of matrix types if 0 < NMATS < NTYPES. 00084 * 00085 IF( NMATS.GT.0 ) THEN 00086 READ( NIN, FMT = '(A80)', END = 90 )LINE 00087 LENP = LEN( LINE ) 00088 I = 0 00089 DO 60 J = 1, NMATS 00090 NREQ( J ) = 0 00091 I1 = 0 00092 30 CONTINUE 00093 I = I + 1 00094 IF( I.GT.LENP ) THEN 00095 IF( J.EQ.NMATS .AND. I1.GT.0 ) THEN 00096 GO TO 60 00097 ELSE 00098 WRITE( NOUT, FMT = 9995 )LINE 00099 WRITE( NOUT, FMT = 9994 )NMATS 00100 GO TO 80 00101 END IF 00102 END IF 00103 IF( LINE( I: I ).NE.' ' .AND. LINE( I: I ).NE.',' ) THEN 00104 I1 = I 00105 C1 = LINE( I1: I1 ) 00106 * 00107 * Check that a valid integer was read 00108 * 00109 DO 40 K = 1, 10 00110 IF( C1.EQ.INTSTR( K: K ) ) THEN 00111 IC = K - 1 00112 GO TO 50 00113 END IF 00114 40 CONTINUE 00115 WRITE( NOUT, FMT = 9996 )I, LINE 00116 WRITE( NOUT, FMT = 9994 )NMATS 00117 GO TO 80 00118 50 CONTINUE 00119 NREQ( J ) = 10*NREQ( J ) + IC 00120 GO TO 30 00121 ELSE IF( I1.GT.0 ) THEN 00122 GO TO 60 00123 ELSE 00124 GO TO 30 00125 END IF 00126 60 CONTINUE 00127 END IF 00128 DO 70 I = 1, NMATS 00129 NT = NREQ( I ) 00130 IF( NT.GT.0 .AND. NT.LE.NTYPES ) THEN 00131 IF( DOTYPE( NT ) ) THEN 00132 IF( FIRSTT ) 00133 $ WRITE( NOUT, FMT = * ) 00134 FIRSTT = .FALSE. 00135 WRITE( NOUT, FMT = 9997 )NT, PATH 00136 END IF 00137 DOTYPE( NT ) = .TRUE. 00138 ELSE 00139 WRITE( NOUT, FMT = 9999 )PATH, NT, NTYPES 00140 9999 FORMAT( ' *** Invalid type request for ', A3, ', type ', 00141 $ I4, ': must satisfy 1 <= type <= ', I2 ) 00142 END IF 00143 70 CONTINUE 00144 80 CONTINUE 00145 END IF 00146 RETURN 00147 * 00148 90 CONTINUE 00149 WRITE( NOUT, FMT = 9998 )PATH 00150 9998 FORMAT( /' *** End of file reached when trying to read matrix ', 00151 $ 'types for ', A3, /' *** Check that you are requesting the', 00152 $ ' right number of types for each path', / ) 00153 9997 FORMAT( ' *** Warning: duplicate request of matrix type ', I2, 00154 $ ' for ', A3 ) 00155 9996 FORMAT( //' *** Invalid integer value in column ', I2, 00156 $ ' of input', ' line:', /A79 ) 00157 9995 FORMAT( //' *** Not enough matrix types on input line', /A79 ) 00158 9994 FORMAT( ' ==> Specify ', I4, ' matrix types on this line or ', 00159 $ 'adjust NTYPES on previous line' ) 00160 WRITE( NOUT, FMT = * ) 00161 STOP 00162 * 00163 * End of ALARQG 00164 * 00165 END
1.7.3 
