LAPACK: TESTING/LIN/cdrvrf1.f Source File

Go to the documentation of this file.
00001       SUBROUTINE CDRVRF1( NOUT, NN, NVAL, THRESH, A, LDA, ARF, WORK )
00002 *
00003 *  -- LAPACK test routine (version 3.2.0) --
00004 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
00005 *     November 2008
00006 *
00007 *     .. Scalar Arguments ..
00008       INTEGER            LDA, NN, NOUT
00009       REAL               THRESH
00010 *     ..
00011 *     .. Array Arguments ..
00012       INTEGER            NVAL( NN )
00013       REAL               WORK( * )
00014       COMPLEX            A( LDA, * ), ARF( * )
00015 *     ..
00016 *
00017 *  Purpose
00018 *  =======
00019 *
00020 *  CDRVRF1 tests the LAPACK RFP routines:
00021 *      CLANHF.F
00022 *
00023 *  Arguments
00024 *  =========
00025 *
00026 *  NOUT          (input) INTEGER
00027 *                The unit number for output.
00028 *
00029 *  NN            (input) INTEGER
00030 *                The number of values of N contained in the vector NVAL.
00031 *
00032 *  NVAL          (input) INTEGER array, dimension (NN)
00033 *                The values of the matrix dimension N.
00034 *
00035 *  THRESH        (input) REAL
00036 *                The threshold value for the test ratios.  A result is
00037 *                included in the output file if RESULT >= THRESH.  To have
00038 *                every test ratio printed, use THRESH = 0.
00039 *
00040 *  A             (workspace) COMPLEX array, dimension (LDA,NMAX)
00041 *
00042 *  LDA           (input) INTEGER
00043 *                The leading dimension of the array A.  LDA >= max(1,NMAX).
00044 *
00045 *  ARF           (workspace) COMPLEX array, dimension ((NMAX*(NMAX+1))/2).
00046 *
00047 *  WORK          (workspace) COMPLEX array, dimension ( NMAX )
00048 *
00049 *  =====================================================================
00050 *     ..
00051 *     .. Parameters ..
00052       REAL               ONE
00053       PARAMETER          ( ONE = 1.0E+0 )
00054       INTEGER            NTESTS
00055       PARAMETER          ( NTESTS = 1 )
00056 *     ..
00057 *     .. Local Scalars ..
00058       CHARACTER          UPLO, CFORM, NORM
00059       INTEGER            I, IFORM, IIN, IIT, INFO, INORM, IUPLO, J, N,
00060      +                   NERRS, NFAIL, NRUN
00061       REAL               EPS, LARGE, NORMA, NORMARF, SMALL
00062 *     ..
00063 *     .. Local Arrays ..
00064       CHARACTER          UPLOS( 2 ), FORMS( 2 ), NORMS( 4 )
00065       INTEGER            ISEED( 4 ), ISEEDY( 4 )
00066       REAL               RESULT( NTESTS )
00067 *     ..
00068 *     .. External Functions ..
00069       COMPLEX            CLARND
00070       REAL               SLAMCH, CLANHE, CLANHF
00071       EXTERNAL           SLAMCH, CLARND, CLANHE, CLANHF
00072 *     ..
00073 *     .. External Subroutines ..
00074       EXTERNAL           CTRTTF
00075 *     ..
00076 *     .. Scalars in Common ..
00077       CHARACTER*32       SRNAMT
00078 *     ..
00079 *     .. Common blocks ..
00080       COMMON             / SRNAMC / SRNAMT
00081 *     ..
00082 *     .. Data statements ..
00083       DATA               ISEEDY / 1988, 1989, 1990, 1991 /
00084       DATA               UPLOS / 'U', 'L' /
00085       DATA               FORMS / 'N', 'C' /
00086       DATA               NORMS / 'M', '1', 'I', 'F' /
00087 *     ..
00088 *     .. Executable Statements ..
00089 *
00090 *     Initialize constants and the random number seed.
00091 *
00092       NRUN = 0
00093       NFAIL = 0
00094       NERRS = 0
00095       INFO = 0
00096       DO 10 I = 1, 4
00097          ISEED( I ) = ISEEDY( I )
00098    10 CONTINUE
00099 *
00100       EPS = SLAMCH( 'Precision' )
00101       SMALL = SLAMCH( 'Safe minimum' )
00102       LARGE = ONE / SMALL
00103       SMALL = SMALL * LDA * LDA 
00104       LARGE = LARGE / LDA / LDA
00105 *
00106       DO 130 IIN = 1, NN
00107 *
00108          N = NVAL( IIN )
00109 *
00110          DO 120 IIT = 1, 3
00111 *
00112 *           IIT = 1 : random matrix
00113 *           IIT = 2 : random matrix scaled near underflow
00114 *           IIT = 3 : random matrix scaled near overflow
00115 *
00116             DO J = 1, N
00117                DO I = 1, N
00118                   A( I, J) = CLARND( 4, ISEED )
00119                END DO
00120             END DO
00121 *
00122             IF ( IIT.EQ.2 ) THEN
00123                DO J = 1, N
00124                   DO I = 1, N
00125                      A( I, J) = A( I, J ) * LARGE
00126                   END DO
00127                END DO
00128             END IF
00129 *
00130             IF ( IIT.EQ.3 ) THEN
00131                DO J = 1, N
00132                   DO I = 1, N
00133                      A( I, J) = A( I, J) * SMALL
00134                   END DO
00135                END DO
00136             END IF
00137 *
00138 *           Do first for UPLO = 'U', then for UPLO = 'L'
00139 *
00140             DO 110 IUPLO = 1, 2
00141 *
00142                UPLO = UPLOS( IUPLO )
00143 *
00144 *              Do first for CFORM = 'N', then for CFORM = 'C'
00145 *
00146                DO 100 IFORM = 1, 2
00147 *
00148                   CFORM = FORMS( IFORM )
00149 *
00150                   SRNAMT = 'CTRTTF'
00151                   CALL CTRTTF( CFORM, UPLO, N, A, LDA, ARF, INFO )
00152 *
00153 *                 Check error code from CTRTTF
00154 *
00155                   IF( INFO.NE.0 ) THEN
00156                      IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) THEN
00157                         WRITE( NOUT, * )
00158                         WRITE( NOUT, FMT = 9999 )
00159                      END IF
00160                      WRITE( NOUT, FMT = 9998 ) SRNAMT, UPLO, CFORM, N
00161                      NERRS = NERRS + 1
00162                      GO TO 100
00163                   END IF
00164 *
00165                   DO 90 INORM = 1, 4
00166 *
00167 *                    Check all four norms: 'M', '1', 'I', 'F'
00168 *
00169                      NORM = NORMS( INORM )
00170                      NORMARF = CLANHF( NORM, CFORM, UPLO, N, ARF, WORK )
00171                      NORMA = CLANHE( NORM, UPLO, N, A, LDA, WORK )
00172 *
00173                      RESULT(1) = ( NORMA - NORMARF ) / NORMA / EPS
00174                      NRUN = NRUN + 1
00175 *
00176                      IF( RESULT(1).GE.THRESH ) THEN
00177                         IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) THEN
00178                            WRITE( NOUT, * )
00179                            WRITE( NOUT, FMT = 9999 )
00180                         END IF
00181                         WRITE( NOUT, FMT = 9997 ) 'CLANHF', 
00182      +                      N, IIT, UPLO, CFORM, NORM, RESULT(1)
00183                         NFAIL = NFAIL + 1
00184                      END IF
00185    90             CONTINUE
00186   100          CONTINUE
00187   110       CONTINUE
00188   120    CONTINUE
00189   130 CONTINUE
00190 *
00191 *     Print a summary of the results.
00192 *
00193       IF ( NFAIL.EQ.0 ) THEN
00194          WRITE( NOUT, FMT = 9996 )'CLANHF', NRUN
00195       ELSE
00196          WRITE( NOUT, FMT = 9995 ) 'CLANHF', NFAIL, NRUN
00197       END IF
00198       IF ( NERRS.NE.0 ) THEN
00199          WRITE( NOUT, FMT = 9994 ) NERRS, 'CLANHF'
00200       END IF
00201 *
00202  9999 FORMAT( 1X, 
00203 ' *** Error(s) or Failure(s) while testing CLANHF     +         ***')
00204  9998 FORMAT( 1X, '     Error in ',A6,' with UPLO=''',A1,''', FORM=''',
00205      +        A1,''', N=',I5)
00206  9997 FORMAT( 1X, '     Failure in ',A6,' N=',I5,' TYPE=',I5,' UPLO=''',
00207      +        A1, ''', FORM =''',A1,''', NORM=''',A1,''', test=',G12.5)
00208  9996 FORMAT( 1X, 'All tests for ',A6,' auxiliary routine passed the ',
00209      +        'threshold (',I5,' tests run)')
00210  9995 FORMAT( 1X, A6, ' auxiliary routine:',I5,' out of ',I5,
00211      +        ' tests failed to pass the threshold')
00212  9994 FORMAT( 26X, I5,' error message recorded (',A6,')')
00213 *
00214       RETURN
00215 *
00216 *     End of CDRVRF1
00217 *
00218       END