LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
sdrvrf2.f
Go to the documentation of this file.
00001 *> \brief \b SDRVRF2
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 SDRVRF2( NOUT, NN, NVAL, A, LDA, ARF, AP, ASAV  )
00012 * 
00013 *       .. Scalar Arguments ..
00014 *       INTEGER            LDA, NN, NOUT
00015 *       ..
00016 *       .. Array Arguments ..
00017 *       INTEGER            NVAL( NN )
00018 *       REAL               A( LDA, * ), ARF( * ), AP(*), ASAV( LDA, * )
00019 *       ..
00020 *  
00021 *
00022 *> \par Purpose:
00023 *  =============
00024 *>
00025 *> \verbatim
00026 *>
00027 *> SDRVRF2 tests the LAPACK RFP convertion routines.
00028 *> \endverbatim
00029 *
00030 *  Arguments:
00031 *  ==========
00032 *
00033 *> \param[in] NOUT
00034 *> \verbatim
00035 *>          NOUT is INTEGER
00036 *>                The unit number for output.
00037 *> \endverbatim
00038 *>
00039 *> \param[in] NN
00040 *> \verbatim
00041 *>          NN is INTEGER
00042 *>                The number of values of N contained in the vector NVAL.
00043 *> \endverbatim
00044 *>
00045 *> \param[in] NVAL
00046 *> \verbatim
00047 *>          NVAL is INTEGER array, dimension (NN)
00048 *>                The values of the matrix dimension N.
00049 *> \endverbatim
00050 *>
00051 *> \param[out] A
00052 *> \verbatim
00053 *>          A is REAL array, dimension (LDA,NMAX)
00054 *> \endverbatim
00055 *>
00056 *> \param[in] LDA
00057 *> \verbatim
00058 *>          LDA is INTEGER
00059 *>                The leading dimension of the array A.  LDA >= max(1,NMAX).
00060 *> \endverbatim
00061 *>
00062 *> \param[out] ARF
00063 *> \verbatim
00064 *>          ARF is REAL array, dimension ((NMAX*(NMAX+1))/2).
00065 *> \endverbatim
00066 *>
00067 *> \param[out] AP
00068 *> \verbatim
00069 *>          AP is REAL array, dimension ((NMAX*(NMAX+1))/2).
00070 *> \endverbatim
00071 *>
00072 *> \param[out] ASAV
00073 *> \verbatim
00074 *>          ASAV is REAL array, dimension (LDA,NMAX)
00075 *> \endverbatim
00076 *
00077 *  Authors:
00078 *  ========
00079 *
00080 *> \author Univ. of Tennessee 
00081 *> \author Univ. of California Berkeley 
00082 *> \author Univ. of Colorado Denver 
00083 *> \author NAG Ltd. 
00084 *
00085 *> \date November 2011
00086 *
00087 *> \ingroup single_lin
00088 *
00089 *  =====================================================================
00090       SUBROUTINE SDRVRF2( NOUT, NN, NVAL, A, LDA, ARF, AP, ASAV  )
00091 *
00092 *  -- LAPACK test routine (version 3.4.0) --
00093 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00094 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00095 *     November 2011
00096 *
00097 *     .. Scalar Arguments ..
00098       INTEGER            LDA, NN, NOUT
00099 *     ..
00100 *     .. Array Arguments ..
00101       INTEGER            NVAL( NN )
00102       REAL               A( LDA, * ), ARF( * ), AP(*), ASAV( LDA, * )
00103 *     ..
00104 *
00105 *  =====================================================================
00106 *     ..
00107 *     .. Local Scalars ..
00108       LOGICAL            LOWER, OK1, OK2
00109       CHARACTER          UPLO, CFORM
00110       INTEGER            I, IFORM, IIN, INFO, IUPLO, J, N,
00111      +                   NERRS, NRUN
00112 *     ..
00113 *     .. Local Arrays ..
00114       CHARACTER          UPLOS( 2 ), FORMS( 2 )
00115       INTEGER            ISEED( 4 ), ISEEDY( 4 )
00116 *     ..
00117 *     .. External Functions ..
00118       REAL               SLARND
00119       EXTERNAL           SLARND
00120 *     ..
00121 *     .. External Subroutines ..
00122       EXTERNAL           STFTTR, STFTTP, STRTTF, STRTTP, STPTTR, STPTTF
00123 *     ..
00124 *     .. Scalars in Common ..
00125       CHARACTER*32       SRNAMT
00126 *     ..
00127 *     .. Common blocks ..
00128       COMMON             / SRNAMC / SRNAMT
00129 *     ..
00130 *     .. Data statements ..
00131       DATA               ISEEDY / 1988, 1989, 1990, 1991 /
00132       DATA               UPLOS / 'U', 'L' /
00133       DATA               FORMS / 'N', 'T' /
00134 *     ..
00135 *     .. Executable Statements ..
00136 *
00137 *     Initialize constants and the random number seed.
00138 *
00139       NRUN = 0
00140       NERRS = 0
00141       INFO = 0
00142       DO 10 I = 1, 4
00143          ISEED( I ) = ISEEDY( I )
00144    10 CONTINUE
00145 *
00146       DO 120 IIN = 1, NN
00147 *
00148          N = NVAL( IIN )
00149 *
00150 *        Do first for UPLO = 'U', then for UPLO = 'L'
00151 *
00152          DO 110 IUPLO = 1, 2
00153 *
00154             UPLO = UPLOS( IUPLO )
00155             LOWER = .TRUE.
00156             IF ( IUPLO.EQ.1 ) LOWER = .FALSE.
00157 *
00158 *           Do first for CFORM = 'N', then for CFORM = 'T'
00159 *
00160             DO 100 IFORM = 1, 2
00161 *
00162                CFORM = FORMS( IFORM )
00163 *
00164                NRUN = NRUN + 1
00165 *
00166                DO J = 1, N
00167                   DO I = 1, N
00168                      A( I, J) = SLARND( 2, ISEED )
00169                   END DO
00170                END DO
00171 *
00172                SRNAMT = 'DTRTTF'
00173                CALL STRTTF( CFORM, UPLO, N, A, LDA, ARF, INFO )
00174 *
00175                SRNAMT = 'DTFTTP'
00176                CALL STFTTP( CFORM, UPLO, N, ARF, AP, INFO )
00177 *
00178                SRNAMT = 'DTPTTR'
00179                CALL STPTTR( UPLO, N, AP, ASAV, LDA, INFO )
00180 *
00181                OK1 = .TRUE.
00182                IF ( LOWER ) THEN
00183                   DO J = 1, N
00184                      DO I = J, N
00185                         IF ( A(I,J).NE.ASAV(I,J) ) THEN
00186                            OK1 = .FALSE.
00187                         END IF
00188                      END DO
00189                   END DO
00190                ELSE
00191                   DO J = 1, N
00192                      DO I = 1, J
00193                         IF ( A(I,J).NE.ASAV(I,J) ) THEN
00194                            OK1 = .FALSE.
00195                         END IF
00196                      END DO
00197                   END DO
00198                END IF
00199 *
00200                NRUN = NRUN + 1
00201 *
00202                SRNAMT = 'DTRTTP'
00203                CALL STRTTP( UPLO, N, A, LDA, AP, INFO )
00204 *
00205                SRNAMT = 'DTPTTF'
00206                CALL STPTTF( CFORM, UPLO, N, AP, ARF, INFO )
00207 *
00208                SRNAMT = 'DTFTTR'
00209                CALL STFTTR( CFORM, UPLO, N, ARF, ASAV, LDA, INFO )
00210 *
00211                OK2 = .TRUE.
00212                IF ( LOWER ) THEN
00213                   DO J = 1, N
00214                      DO I = J, N
00215                         IF ( A(I,J).NE.ASAV(I,J) ) THEN
00216                            OK2 = .FALSE.
00217                         END IF
00218                      END DO
00219                   END DO
00220                ELSE
00221                   DO J = 1, N
00222                      DO I = 1, J
00223                         IF ( A(I,J).NE.ASAV(I,J) ) THEN
00224                            OK2 = .FALSE.
00225                         END IF
00226                      END DO
00227                   END DO
00228                END IF
00229 *
00230                IF (( .NOT.OK1 ).OR.( .NOT.OK2 )) THEN
00231                   IF( NERRS.EQ.0 ) THEN
00232                      WRITE( NOUT, * )
00233                      WRITE( NOUT, FMT = 9999 )
00234                   END IF
00235                   WRITE( NOUT, FMT = 9998 ) N, UPLO, CFORM
00236                   NERRS = NERRS + 1
00237                END IF
00238 *
00239   100       CONTINUE
00240   110    CONTINUE
00241   120 CONTINUE
00242 *
00243 *     Print a summary of the results.
00244 *
00245       IF ( NERRS.EQ.0 ) THEN
00246          WRITE( NOUT, FMT = 9997 ) NRUN
00247       ELSE
00248          WRITE( NOUT, FMT = 9996 ) NERRS, NRUN
00249       END IF
00250 *
00251  9999 FORMAT( 1X, ' *** Error(s) while testing the RFP convertion',
00252      +         ' routines ***')
00253  9998 FORMAT( 1X, '     Error in RFP,convertion routines N=',I5,
00254      +        ' UPLO=''', A1, ''', FORM =''',A1,'''')
00255  9997 FORMAT( 1X, 'All tests for the RFP convertion routines passed ( ', 
00256      +        I5,' tests run)')
00257  9996 FORMAT( 1X, 'RFP convertion routines: ',I5,' out of ',I5,
00258      +        ' error message recorded') 
00259 *
00260       RETURN
00261 *
00262 *     End of SDRVRF2
00263 *
00264       END
 All Files Functions