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