LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
alareq.f
Go to the documentation of this file.
00001 *> \brief \b ALAREQ
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 ALAREQ( 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 *> ALAREQ 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_lin
00089 *
00090 *  =====================================================================
00091       SUBROUTINE ALAREQ( 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 ALAREQ
00220 *
00221       END
 All Files Functions