LAPACK: TESTING/LIN/zdrvrf1.f Source File

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