alaerh.f

来自「famous linear algebra library (LAPACK) p」· F 代码 · 共 911 行 · 第 1/3 页

      SUBROUTINE ALAERH( PATH, SUBNAM, INFO, INFOE, OPTS, M, N, KL, KU,
     $                   N5, IMAT, NFAIL, NERRS, NOUT )
*
*  -- LAPACK auxiliary test routine (version 3.1) --
*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
*     November 2006
*
*     .. Scalar Arguments ..
      CHARACTER*3        PATH
      CHARACTER*6        SUBNAM
      CHARACTER*( * )    OPTS
      INTEGER            IMAT, INFO, INFOE, KL, KU, M, N, N5, NERRS,
     $                   NFAIL, NOUT
*     ..
*
*  Purpose
*  =======
*
*  ALAERH is an error handler for the LAPACK routines.  It prints the
*  header if this is the first error message and prints the error code
*  and form of recovery, if any.  The character evaluations in this
*  routine may make it slow, but it should not be called once the LAPACK
*  routines are fully debugged.
*
*  Arguments
*  =========
*
*  PATH    (input) CHARACTER*3
*          The LAPACK path name of subroutine SUBNAM.
*
*  SUBNAM  (input) CHARACTER*6
*          The name of the subroutine that returned an error code.
*
*  INFO    (input) INTEGER
*          The error code returned from routine SUBNAM.
*
*  INFOE   (input) INTEGER
*          The expected error code from routine SUBNAM, if SUBNAM were
*          error-free.  If INFOE = 0, an error message is printed, but
*          if INFOE.NE.0, we assume only the return code INFO is wrong.
*
*  OPTS    (input) CHARACTER*(*)
*          The character options to the subroutine SUBNAM, concatenated
*          into a single character string.  For example, UPLO = 'U',
*          TRANS = 'T', and DIAG = 'N' for a triangular routine would
*          be specified as OPTS = 'UTN'.
*
*  M       (input) INTEGER
*          The matrix row dimension.
*
*  N       (input) INTEGER
*          The matrix column dimension.  Accessed only if PATH = xGE or
*          xGB.
*
*  KL      (input) INTEGER
*          The number of sub-diagonals of the matrix.  Accessed only if
*          PATH = xGB, xPB, or xTB.  Also used for NRHS for PATH = xLS.
*
*  KU      (input) INTEGER
*          The number of super-diagonals of the matrix.  Accessed only
*          if PATH = xGB.
*
*  N5      (input) INTEGER
*          A fifth integer parameter, may be the blocksize NB or the
*          number of right hand sides NRHS.
*
*  IMAT    (input) INTEGER
*          The matrix type.
*
*  NFAIL   (input) INTEGER
*          The number of prior tests that did not pass the threshold;
*          used to determine if the header should be printed.
*
*  NERRS   (input/output) INTEGER
*          On entry, the number of errors already detected; used to
*          determine if the header should be printed.
*          On exit, NERRS is increased by 1.
*
*  NOUT    (input) INTEGER
*          The unit number on which results are to be printed.
*
*  =====================================================================
*
*     .. Local Scalars ..
      CHARACTER          UPLO
      CHARACTER*2        P2
      CHARACTER*3        C3
*     ..
*     .. External Functions ..
      LOGICAL            LSAME, LSAMEN
      EXTERNAL           LSAME, LSAMEN
*     ..
*     .. External Subroutines ..
      EXTERNAL           ALADHD, ALAHD
*     ..
*     .. Executable Statements ..
*
      IF( INFO.EQ.0 )
     $   RETURN
      P2 = PATH( 2: 3 )
      C3 = SUBNAM( 4: 6 )
*
*     Print the header if this is the first error message.
*
      IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) THEN
         IF( LSAMEN( 3, C3, 'SV ' ) .OR. LSAMEN( 3, C3, 'SVX' ) ) THEN
            CALL ALADHD( NOUT, PATH )
         ELSE
            CALL ALAHD( NOUT, PATH )
         END IF
      END IF
      NERRS = NERRS + 1
*
*     Print the message detailing the error and form of recovery,
*     if any.
*
      IF( LSAMEN( 2, P2, 'GE' ) ) THEN
*
*        xGE:  General matrices
*
         IF( LSAMEN( 3, C3, 'TRF' ) ) THEN
            IF( INFO.NE.INFOE .AND. INFOE.NE.0 ) THEN
               WRITE( NOUT, FMT = 9988 )SUBNAM, INFO, INFOE, M, N, N5,
     $            IMAT
            ELSE
               WRITE( NOUT, FMT = 9975 )SUBNAM, INFO, M, N, N5, IMAT
            END IF
            IF( INFO.NE.0 )
     $         WRITE( NOUT, FMT = 9949 )
*
         ELSE IF( LSAMEN( 3, C3, 'SV ' ) ) THEN
*
            IF( INFO.NE.INFOE .AND. INFOE.NE.0 ) THEN
               WRITE( NOUT, FMT = 9984 )SUBNAM, INFO, INFOE, N, N5,
     $            IMAT
            ELSE
               WRITE( NOUT, FMT = 9970 )SUBNAM, INFO, N, N5, IMAT
            END IF
*
         ELSE IF( LSAMEN( 3, C3, 'SVX' ) ) THEN
*
            IF( INFO.NE.INFOE .AND. INFOE.NE.0 ) THEN
               WRITE( NOUT, FMT = 9992 )SUBNAM, INFO, INFOE,
     $            OPTS( 1: 1 ), OPTS( 2: 2 ), N, N5, IMAT
            ELSE
               WRITE( NOUT, FMT = 9997 )SUBNAM, INFO, OPTS( 1: 1 ),
     $            OPTS( 2: 2 ), N, N5, IMAT
            END IF
*
         ELSE IF( LSAMEN( 3, C3, 'TRI' ) ) THEN
*
            WRITE( NOUT, FMT = 9971 )SUBNAM, INFO, N, N5, IMAT
*
         ELSE IF( LSAMEN( 5, SUBNAM( 2: 6 ), 'LATMS' ) ) THEN
*
            WRITE( NOUT, FMT = 9978 )SUBNAM, INFO, M, N, IMAT
*
         ELSE IF( LSAMEN( 3, C3, 'CON' ) ) THEN
*
            WRITE( NOUT, FMT = 9969 )SUBNAM, INFO, OPTS( 1: 1 ), M,
     $         IMAT
*
         ELSE IF( LSAMEN( 3, C3, 'LS ' ) ) THEN
*
            WRITE( NOUT, FMT = 9965 )SUBNAM, INFO, OPTS( 1: 1 ), M, N,
     $         KL, N5, IMAT
*
         ELSE IF( LSAMEN( 3, C3, 'LSX' ) .OR. LSAMEN( 3, C3, 'LSS' ) )
     $             THEN
*
            WRITE( NOUT, FMT = 9974 )SUBNAM, INFO, M, N, KL, N5, IMAT
*
         ELSE
*
            WRITE( NOUT, FMT = 9963 )SUBNAM, INFO, OPTS( 1: 1 ), M, N5,
     $         IMAT
         END IF
*
      ELSE IF( LSAMEN( 2, P2, 'GB' ) ) THEN
*
*        xGB:  General band matrices
*
         IF( LSAMEN( 3, C3, 'TRF' ) ) THEN
            IF( INFO.NE.INFOE .AND. INFOE.NE.0 ) THEN
               WRITE( NOUT, FMT = 9989 )SUBNAM, INFO, INFOE, M, N, KL,
     $            KU, N5, IMAT
            ELSE
               WRITE( NOUT, FMT = 9976 )SUBNAM, INFO, M, N, KL, KU, N5,
     $            IMAT
            END IF
            IF( INFO.NE.0 )
     $         WRITE( NOUT, FMT = 9949 )
*
         ELSE IF( LSAMEN( 3, C3, 'SV ' ) ) THEN
*
            IF( INFO.NE.INFOE .AND. INFOE.NE.0 ) THEN
               WRITE( NOUT, FMT = 9986 )SUBNAM, INFO, INFOE, N, KL, KU,
     $            N5, IMAT
            ELSE
               WRITE( NOUT, FMT = 9972 )SUBNAM, INFO, N, KL, KU, N5,
     $            IMAT
            END IF
*
         ELSE IF( LSAMEN( 3, C3, 'SVX' ) ) THEN
*
            IF( INFO.NE.INFOE .AND. INFOE.NE.0 ) THEN
               WRITE( NOUT, FMT = 9993 )SUBNAM, INFO, INFOE,
     $            OPTS( 1: 1 ), OPTS( 2: 2 ), N, KL, KU, N5, IMAT
            ELSE
               WRITE( NOUT, FMT = 9998 )SUBNAM, INFO, OPTS( 1: 1 ),
     $            OPTS( 2: 2 ), N, KL, KU, N5, IMAT
            END IF
*
         ELSE IF( LSAMEN( 5, SUBNAM( 2: 6 ), 'LATMS' ) ) THEN
*
            WRITE( NOUT, FMT = 9977 )SUBNAM, INFO, M, N, KL, KU, IMAT
*
         ELSE IF( LSAMEN( 3, C3, 'CON' ) ) THEN
*
            WRITE( NOUT, FMT = 9968 )SUBNAM, INFO, OPTS( 1: 1 ), M, KL,
     $         KU, IMAT
*
         ELSE
*
            WRITE( NOUT, FMT = 9964 )SUBNAM, INFO, OPTS( 1: 1 ), M, KL,
     $         KU, N5, IMAT
         END IF
*
      ELSE IF( LSAMEN( 2, P2, 'GT' ) ) THEN
*
*        xGT:  General tridiagonal matrices
*
         IF( LSAMEN( 3, C3, 'TRF' ) ) THEN
            IF( INFO.NE.INFOE .AND. INFOE.NE.0 ) THEN
               WRITE( NOUT, FMT = 9987 )SUBNAM, INFO, INFOE, N, IMAT
            ELSE
               WRITE( NOUT, FMT = 9973 )SUBNAM, INFO, N, IMAT
            END IF
            IF( INFO.NE.0 )
     $         WRITE( NOUT, FMT = 9949 )
*
         ELSE IF( LSAMEN( 3, C3, 'SV ' ) ) THEN
*
            IF( INFO.NE.INFOE .AND. INFOE.NE.0 ) THEN
               WRITE( NOUT, FMT = 9984 )SUBNAM, INFO, INFOE, N, N5,
     $            IMAT
            ELSE
               WRITE( NOUT, FMT = 9970 )SUBNAM, INFO, N, N5, IMAT
            END IF
*
         ELSE IF( LSAMEN( 3, C3, 'SVX' ) ) THEN
*
            IF( INFO.NE.INFOE .AND. INFOE.NE.0 ) THEN
               WRITE( NOUT, FMT = 9992 )SUBNAM, INFO, INFOE,
     $            OPTS( 1: 1 ), OPTS( 2: 2 ), N, N5, IMAT
            ELSE
               WRITE( NOUT, FMT = 9997 )SUBNAM, INFO, OPTS( 1: 1 ),
     $            OPTS( 2: 2 ), N, N5, IMAT
            END IF
*
         ELSE IF( LSAMEN( 3, C3, 'CON' ) ) THEN
*
            WRITE( NOUT, FMT = 9969 )SUBNAM, INFO, OPTS( 1: 1 ), M,
     $         IMAT
*
         ELSE
*
            WRITE( NOUT, FMT = 9963 )SUBNAM, INFO, OPTS( 1: 1 ), M, N5,
     $         IMAT
         END IF
*
      ELSE IF( LSAMEN( 2, P2, 'PO' ) ) THEN
*
*        xPO:  Symmetric or Hermitian positive definite matrices
*
         UPLO = OPTS( 1: 1 )
         IF( LSAMEN( 3, C3, 'TRF' ) ) THEN
            IF( INFO.NE.INFOE .AND. INFOE.NE.0 ) THEN
               WRITE( NOUT, FMT = 9980 )SUBNAM, INFO, INFOE, UPLO, M,
     $            N5, IMAT
            ELSE
               WRITE( NOUT, FMT = 9956 )SUBNAM, INFO, UPLO, M, N5, IMAT
            END IF
            IF( INFO.NE.0 )
     $         WRITE( NOUT, FMT = 9949 )
*
         ELSE IF( LSAMEN( 3, C3, 'SV ' ) ) THEN
*
            IF( INFO.NE.INFOE .AND. INFOE.NE.0 ) THEN
               WRITE( NOUT, FMT = 9979 )SUBNAM, INFO, INFOE, UPLO, N,
     $            N5, IMAT
            ELSE
               WRITE( NOUT, FMT = 9955 )SUBNAM, INFO, UPLO, N, N5, IMAT
            END IF
*
         ELSE IF( LSAMEN( 3, C3, 'SVX' ) ) THEN
*
            IF( INFO.NE.INFOE .AND. INFOE.NE.0 ) THEN
               WRITE( NOUT, FMT = 9990 )SUBNAM, INFO, INFOE,
     $            OPTS( 1: 1 ), OPTS( 2: 2 ), N, N5, IMAT
            ELSE
               WRITE( NOUT, FMT = 9995 )SUBNAM, INFO, OPTS( 1: 1 ),
     $            OPTS( 2: 2 ), N, N5, IMAT
            END IF