LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
cdrvrf1.f
Go to the documentation of this file.
00001 *> \brief \b CDRVRF1
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 CDRVRF1( NOUT, NN, NVAL, THRESH, A, LDA, ARF, WORK )
00012 * 
00013 *       .. Scalar Arguments ..
00014 *       INTEGER            LDA, NN, NOUT
00015 *       REAL               THRESH
00016 *       ..
00017 *       .. Array Arguments ..
00018 *       INTEGER            NVAL( NN )
00019 *       REAL               WORK( * )
00020 *       COMPLEX            A( LDA, * ), ARF( * )
00021 *       ..
00022 *  
00023 *
00024 *> \par Purpose:
00025 *  =============
00026 *>
00027 *> \verbatim
00028 *>
00029 *> CDRVRF1 tests the LAPACK RFP routines:
00030 *>     CLANHF.F
00031 *> \endverbatim
00032 *
00033 *  Arguments:
00034 *  ==========
00035 *
00036 *> \param[in] NOUT
00037 *> \verbatim
00038 *>          NOUT is INTEGER
00039 *>                The unit number for output.
00040 *> \endverbatim
00041 *>
00042 *> \param[in] NN
00043 *> \verbatim
00044 *>          NN is INTEGER
00045 *>                The number of values of N contained in the vector NVAL.
00046 *> \endverbatim
00047 *>
00048 *> \param[in] NVAL
00049 *> \verbatim
00050 *>          NVAL is INTEGER array, dimension (NN)
00051 *>                The values of the matrix dimension N.
00052 *> \endverbatim
00053 *>
00054 *> \param[in] THRESH
00055 *> \verbatim
00056 *>          THRESH is REAL
00057 *>                The threshold value for the test ratios.  A result is
00058 *>                included in the output file if RESULT >= THRESH.  To have
00059 *>                every test ratio printed, use THRESH = 0.
00060 *> \endverbatim
00061 *>
00062 *> \param[out] A
00063 *> \verbatim
00064 *>          A is COMPLEX array, dimension (LDA,NMAX)
00065 *> \endverbatim
00066 *>
00067 *> \param[in] LDA
00068 *> \verbatim
00069 *>          LDA is INTEGER
00070 *>                The leading dimension of the array A.  LDA >= max(1,NMAX).
00071 *> \endverbatim
00072 *>
00073 *> \param[out] ARF
00074 *> \verbatim
00075 *>          ARF is COMPLEX array, dimension ((NMAX*(NMAX+1))/2).
00076 *> \endverbatim
00077 *>
00078 *> \param[out] WORK
00079 *> \verbatim
00080 *>          WORK is COMPLEX array, dimension ( NMAX )
00081 *> \endverbatim
00082 *
00083 *  Authors:
00084 *  ========
00085 *
00086 *> \author Univ. of Tennessee 
00087 *> \author Univ. of California Berkeley 
00088 *> \author Univ. of Colorado Denver 
00089 *> \author NAG Ltd. 
00090 *
00091 *> \date November 2011
00092 *
00093 *> \ingroup complex_lin
00094 *
00095 *  =====================================================================
00096       SUBROUTINE CDRVRF1( NOUT, NN, NVAL, THRESH, A, LDA, ARF, WORK )
00097 *
00098 *  -- LAPACK test routine (version 3.4.0) --
00099 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00100 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00101 *     November 2011
00102 *
00103 *     .. Scalar Arguments ..
00104       INTEGER            LDA, NN, NOUT
00105       REAL               THRESH
00106 *     ..
00107 *     .. Array Arguments ..
00108       INTEGER            NVAL( NN )
00109       REAL               WORK( * )
00110       COMPLEX            A( LDA, * ), ARF( * )
00111 *     ..
00112 *
00113 *  =====================================================================
00114 *     ..
00115 *     .. Parameters ..
00116       REAL               ONE
00117       PARAMETER          ( ONE = 1.0E+0 )
00118       INTEGER            NTESTS
00119       PARAMETER          ( NTESTS = 1 )
00120 *     ..
00121 *     .. Local Scalars ..
00122       CHARACTER          UPLO, CFORM, NORM
00123       INTEGER            I, IFORM, IIN, IIT, INFO, INORM, IUPLO, J, N,
00124      +                   NERRS, NFAIL, NRUN
00125       REAL               EPS, LARGE, NORMA, NORMARF, SMALL
00126 *     ..
00127 *     .. Local Arrays ..
00128       CHARACTER          UPLOS( 2 ), FORMS( 2 ), NORMS( 4 )
00129       INTEGER            ISEED( 4 ), ISEEDY( 4 )
00130       REAL               RESULT( NTESTS )
00131 *     ..
00132 *     .. External Functions ..
00133       COMPLEX            CLARND
00134       REAL               SLAMCH, CLANHE, CLANHF
00135       EXTERNAL           SLAMCH, CLARND, CLANHE, CLANHF
00136 *     ..
00137 *     .. External Subroutines ..
00138       EXTERNAL           CTRTTF
00139 *     ..
00140 *     .. Scalars in Common ..
00141       CHARACTER*32       SRNAMT
00142 *     ..
00143 *     .. Common blocks ..
00144       COMMON             / SRNAMC / SRNAMT
00145 *     ..
00146 *     .. Data statements ..
00147       DATA               ISEEDY / 1988, 1989, 1990, 1991 /
00148       DATA               UPLOS / 'U', 'L' /
00149       DATA               FORMS / 'N', 'C' /
00150       DATA               NORMS / 'M', '1', 'I', 'F' /
00151 *     ..
00152 *     .. Executable Statements ..
00153 *
00154 *     Initialize constants and the random number seed.
00155 *
00156       NRUN = 0
00157       NFAIL = 0
00158       NERRS = 0
00159       INFO = 0
00160       DO 10 I = 1, 4
00161          ISEED( I ) = ISEEDY( I )
00162    10 CONTINUE
00163 *
00164       EPS = SLAMCH( 'Precision' )
00165       SMALL = SLAMCH( 'Safe minimum' )
00166       LARGE = ONE / SMALL
00167       SMALL = SMALL * LDA * LDA 
00168       LARGE = LARGE / LDA / LDA
00169 *
00170       DO 130 IIN = 1, NN
00171 *
00172          N = NVAL( IIN )
00173 *
00174          DO 120 IIT = 1, 3         
00175 *           Nothing to do for N=0
00176             IF ( N .EQ. 0 ) EXIT
00177 *
00178 *           IIT = 1 : random matrix
00179 *           IIT = 2 : random matrix scaled near underflow
00180 *           IIT = 3 : random matrix scaled near overflow
00181 *
00182             DO J = 1, N
00183                DO I = 1, N
00184                   A( I, J) = CLARND( 4, ISEED )
00185                END DO
00186             END DO
00187 *
00188             IF ( IIT.EQ.2 ) THEN
00189                DO J = 1, N
00190                   DO I = 1, N
00191                      A( I, J) = A( I, J ) * LARGE
00192                   END DO
00193                END DO
00194             END IF
00195 *
00196             IF ( IIT.EQ.3 ) THEN
00197                DO J = 1, N
00198                   DO I = 1, N
00199                      A( I, J) = A( I, J) * SMALL
00200                   END DO
00201                END DO
00202             END IF
00203 *
00204 *           Do first for UPLO = 'U', then for UPLO = 'L'
00205 *
00206             DO 110 IUPLO = 1, 2
00207 *
00208                UPLO = UPLOS( IUPLO )
00209 *
00210 *              Do first for CFORM = 'N', then for CFORM = 'C'
00211 *
00212                DO 100 IFORM = 1, 2
00213 *
00214                   CFORM = FORMS( IFORM )
00215 *
00216                   SRNAMT = 'CTRTTF'
00217                   CALL CTRTTF( CFORM, UPLO, N, A, LDA, ARF, INFO )
00218 *
00219 *                 Check error code from CTRTTF
00220 *
00221                   IF( INFO.NE.0 ) THEN
00222                      IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) THEN
00223                         WRITE( NOUT, * )
00224                         WRITE( NOUT, FMT = 9999 )
00225                      END IF
00226                      WRITE( NOUT, FMT = 9998 ) SRNAMT, UPLO, CFORM, N
00227                      NERRS = NERRS + 1
00228                      GO TO 100
00229                   END IF
00230 *
00231                   DO 90 INORM = 1, 4
00232 *
00233 *                    Check all four norms: 'M', '1', 'I', 'F'
00234 *
00235                      NORM = NORMS( INORM )
00236                      NORMARF = CLANHF( NORM, CFORM, UPLO, N, ARF, WORK )
00237                      NORMA = CLANHE( NORM, UPLO, N, A, LDA, WORK )
00238 *
00239                      RESULT(1) = ( NORMA - NORMARF ) / NORMA / EPS
00240                      NRUN = NRUN + 1
00241 *
00242                      IF( RESULT(1).GE.THRESH ) THEN
00243                         IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) THEN
00244                            WRITE( NOUT, * )
00245                            WRITE( NOUT, FMT = 9999 )
00246                         END IF
00247                         WRITE( NOUT, FMT = 9997 ) 'CLANHF', 
00248      +                      N, IIT, UPLO, CFORM, NORM, RESULT(1)
00249                         NFAIL = NFAIL + 1
00250                      END IF
00251    90             CONTINUE
00252   100          CONTINUE
00253   110       CONTINUE
00254   120    CONTINUE
00255   130 CONTINUE
00256 *
00257 *     Print a summary of the results.
00258 *
00259       IF ( NFAIL.EQ.0 ) THEN
00260          WRITE( NOUT, FMT = 9996 )'CLANHF', NRUN
00261       ELSE
00262          WRITE( NOUT, FMT = 9995 ) 'CLANHF', NFAIL, NRUN
00263       END IF
00264       IF ( NERRS.NE.0 ) THEN
00265          WRITE( NOUT, FMT = 9994 ) NERRS, 'CLANHF'
00266       END IF
00267 *
00268  9999 FORMAT( 1X, 
00269 ' *** Error(s) or Failure(s) while testing CLANHF     +         ***')
00270  9998 FORMAT( 1X, '     Error in ',A6,' with UPLO=''',A1,''', FORM=''',
00271      +        A1,''', N=',I5)
00272  9997 FORMAT( 1X, '     Failure in ',A6,' N=',I5,' TYPE=',I5,' UPLO=''',
00273      +        A1, ''', FORM =''',A1,''', NORM=''',A1,''', test=',G12.5)
00274  9996 FORMAT( 1X, 'All tests for ',A6,' auxiliary routine passed the ',
00275      +        'threshold ( ',I5,' tests run)')
00276  9995 FORMAT( 1X, A6, ' auxiliary routine: ',I5,' out of ',I5,
00277      +        ' tests failed to pass the threshold')
00278  9994 FORMAT( 26X, I5,' error message recorded (',A6,')')
00279 *
00280       RETURN
00281 *
00282 *     End of CDRVRF1
00283 *
00284       END
 All Files Functions