![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b ALARQG 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 * Definition: 00009 * =========== 00010 * 00011 * SUBROUTINE ALARQG( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 00012 * 00013 * .. Scalar Arguments .. 00014 * CHARACTER*3 PATH 00015 * INTEGER NIN, NMATS, NOUT, NTYPES 00016 * .. 00017 * .. Array Arguments .. 00018 * LOGICAL DOTYPE( * ) 00019 * .. 00020 * 00021 * 00022 *> \par Purpose: 00023 * ============= 00024 *> 00025 *> \verbatim 00026 *> 00027 *> ALARQG handles input for the LAPACK test program. It is called 00028 *> to evaluate the input line which requested NMATS matrix types for 00029 *> PATH. The flow of control is as follows: 00030 *> 00031 *> If NMATS = NTYPES then 00032 *> DOTYPE(1:NTYPES) = .TRUE. 00033 *> else 00034 *> Read the next input line for NMATS matrix types 00035 *> Set DOTYPE(I) = .TRUE. for each valid type I 00036 *> endif 00037 *> \endverbatim 00038 * 00039 * Arguments: 00040 * ========== 00041 * 00042 *> \param[in] PATH 00043 *> \verbatim 00044 *> PATH is CHARACTER*3 00045 *> An LAPACK path name for testing. 00046 *> \endverbatim 00047 *> 00048 *> \param[in] NMATS 00049 *> \verbatim 00050 *> NMATS is INTEGER 00051 *> The number of matrix types to be used in testing this path. 00052 *> \endverbatim 00053 *> 00054 *> \param[out] DOTYPE 00055 *> \verbatim 00056 *> DOTYPE is LOGICAL array, dimension (NTYPES) 00057 *> The vector of flags indicating if each type will be tested. 00058 *> \endverbatim 00059 *> 00060 *> \param[in] NTYPES 00061 *> \verbatim 00062 *> NTYPES is INTEGER 00063 *> The maximum number of matrix types for this path. 00064 *> \endverbatim 00065 *> 00066 *> \param[in] NIN 00067 *> \verbatim 00068 *> NIN is INTEGER 00069 *> The unit number for input. NIN >= 1. 00070 *> \endverbatim 00071 *> 00072 *> \param[in] NOUT 00073 *> \verbatim 00074 *> NOUT is INTEGER 00075 *> The unit number for output. NOUT >= 1. 00076 *> \endverbatim 00077 * 00078 * Authors: 00079 * ======== 00080 * 00081 *> \author Univ. of Tennessee 00082 *> \author Univ. of California Berkeley 00083 *> \author Univ. of Colorado Denver 00084 *> \author NAG Ltd. 00085 * 00086 *> \date November 2011 00087 * 00088 *> \ingroup aux_eig 00089 * 00090 * ===================================================================== 00091 SUBROUTINE ALARQG( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT ) 00092 * 00093 * -- LAPACK test routine (version 3.4.0) -- 00094 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00095 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00096 * November 2011 00097 * 00098 * .. Scalar Arguments .. 00099 CHARACTER*3 PATH 00100 INTEGER NIN, NMATS, NOUT, NTYPES 00101 * .. 00102 * .. Array Arguments .. 00103 LOGICAL DOTYPE( * ) 00104 * .. 00105 * 00106 * ====================================================================== 00107 * 00108 * .. Local Scalars .. 00109 LOGICAL FIRSTT 00110 CHARACTER C1 00111 CHARACTER*10 INTSTR 00112 CHARACTER*80 LINE 00113 INTEGER I, I1, IC, J, K, LENP, NT 00114 * .. 00115 * .. Local Arrays .. 00116 INTEGER NREQ( 100 ) 00117 * .. 00118 * .. Intrinsic Functions .. 00119 INTRINSIC LEN 00120 * .. 00121 * .. Data statements .. 00122 DATA INTSTR / '0123456789' / 00123 * .. 00124 * .. Executable Statements .. 00125 * 00126 IF( NMATS.GE.NTYPES ) THEN 00127 * 00128 * Test everything if NMATS >= NTYPES. 00129 * 00130 DO 10 I = 1, NTYPES 00131 DOTYPE( I ) = .TRUE. 00132 10 CONTINUE 00133 ELSE 00134 DO 20 I = 1, NTYPES 00135 DOTYPE( I ) = .FALSE. 00136 20 CONTINUE 00137 FIRSTT = .TRUE. 00138 * 00139 * Read a line of matrix types if 0 < NMATS < NTYPES. 00140 * 00141 IF( NMATS.GT.0 ) THEN 00142 READ( NIN, FMT = '(A80)', END = 90 )LINE 00143 LENP = LEN( LINE ) 00144 I = 0 00145 DO 60 J = 1, NMATS 00146 NREQ( J ) = 0 00147 I1 = 0 00148 30 CONTINUE 00149 I = I + 1 00150 IF( I.GT.LENP ) THEN 00151 IF( J.EQ.NMATS .AND. I1.GT.0 ) THEN 00152 GO TO 60 00153 ELSE 00154 WRITE( NOUT, FMT = 9995 )LINE 00155 WRITE( NOUT, FMT = 9994 )NMATS 00156 GO TO 80 00157 END IF 00158 END IF 00159 IF( LINE( I: I ).NE.' ' .AND. LINE( I: I ).NE.',' ) THEN 00160 I1 = I 00161 C1 = LINE( I1: I1 ) 00162 * 00163 * Check that a valid integer was read 00164 * 00165 DO 40 K = 1, 10 00166 IF( C1.EQ.INTSTR( K: K ) ) THEN 00167 IC = K - 1 00168 GO TO 50 00169 END IF 00170 40 CONTINUE 00171 WRITE( NOUT, FMT = 9996 )I, LINE 00172 WRITE( NOUT, FMT = 9994 )NMATS 00173 GO TO 80 00174 50 CONTINUE 00175 NREQ( J ) = 10*NREQ( J ) + IC 00176 GO TO 30 00177 ELSE IF( I1.GT.0 ) THEN 00178 GO TO 60 00179 ELSE 00180 GO TO 30 00181 END IF 00182 60 CONTINUE 00183 END IF 00184 DO 70 I = 1, NMATS 00185 NT = NREQ( I ) 00186 IF( NT.GT.0 .AND. NT.LE.NTYPES ) THEN 00187 IF( DOTYPE( NT ) ) THEN 00188 IF( FIRSTT ) 00189 $ WRITE( NOUT, FMT = * ) 00190 FIRSTT = .FALSE. 00191 WRITE( NOUT, FMT = 9997 )NT, PATH 00192 END IF 00193 DOTYPE( NT ) = .TRUE. 00194 ELSE 00195 WRITE( NOUT, FMT = 9999 )PATH, NT, NTYPES 00196 9999 FORMAT( ' *** Invalid type request for ', A3, ', type ', 00197 $ I4, ': must satisfy 1 <= type <= ', I2 ) 00198 END IF 00199 70 CONTINUE 00200 80 CONTINUE 00201 END IF 00202 RETURN 00203 * 00204 90 CONTINUE 00205 WRITE( NOUT, FMT = 9998 )PATH 00206 9998 FORMAT( /' *** End of file reached when trying to read matrix ', 00207 $ 'types for ', A3, /' *** Check that you are requesting the', 00208 $ ' right number of types for each path', / ) 00209 9997 FORMAT( ' *** Warning: duplicate request of matrix type ', I2, 00210 $ ' for ', A3 ) 00211 9996 FORMAT( //' *** Invalid integer value in column ', I2, 00212 $ ' of input', ' line:', /A79 ) 00213 9995 FORMAT( //' *** Not enough matrix types on input line', /A79 ) 00214 9994 FORMAT( ' ==> Specify ', I4, ' matrix types on this line or ', 00215 $ 'adjust NTYPES on previous line' ) 00216 WRITE( NOUT, FMT = * ) 00217 STOP 00218 * 00219 * End of ALARQG 00220 * 00221 END