LAPACK: TESTING/EIG/alarqg.f Source File

Go to the documentation of this file.
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