LAPACK 3.3.1
Linear Algebra PACKage

zdrvrf2.f

Go to the documentation of this file.
00001       SUBROUTINE ZDRVRF2( NOUT, NN, NVAL, A, LDA, ARF, AP, ASAV  )
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 *     ..
00012 *     .. Array Arguments ..
00013       INTEGER            NVAL( NN )
00014       COMPLEX*16         A( LDA, * ), ARF( * ), AP(*), ASAV( LDA, * )
00015 *     ..
00016 *
00017 *  Purpose
00018 *  =======
00019 *
00020 *  ZDRVRF2 tests the LAPACK RFP convertion routines.
00021 *
00022 *  Arguments
00023 *  =========
00024 *
00025 *  NOUT          (input) INTEGER
00026 *                The unit number for output.
00027 *
00028 *  NN            (input) INTEGER
00029 *                The number of values of N contained in the vector NVAL.
00030 *
00031 *  NVAL          (input) INTEGER array, dimension (NN)
00032 *                The values of the matrix dimension N.
00033 *
00034 *  A             (workspace) COMPLEX*16 array, dimension (LDA,NMAX)
00035 *
00036 *  LDA           (input) INTEGER
00037 *                The leading dimension of the array A.  LDA >= max(1,NMAX).
00038 *
00039 *  ARF           (workspace) COMPLEX*16 array, dimension ((NMAX*(NMAX+1))/2).
00040 *
00041 *  AP            (workspace) COMPLEX*16 array, dimension ((NMAX*(NMAX+1))/2).
00042 *
00043 *  A2            (workspace) COMPLEX*16 array, dimension (LDA,NMAX)
00044 *
00045 *  =====================================================================
00046 *     ..
00047 *     .. Local Scalars ..
00048       LOGICAL            LOWER, OK1, OK2
00049       CHARACTER          UPLO, CFORM
00050       INTEGER            I, IFORM, IIN, INFO, IUPLO, J, N,
00051      +                   NERRS, NRUN
00052 *     ..
00053 *     .. Local Arrays ..
00054       CHARACTER          UPLOS( 2 ), FORMS( 2 )
00055       INTEGER            ISEED( 4 ), ISEEDY( 4 )
00056 *     ..
00057 *     .. External Functions ..
00058       COMPLEX*16         ZLARND
00059       EXTERNAL           ZLARND
00060 *     ..
00061 *     .. External Subroutines ..
00062       EXTERNAL           ZTFTTR, ZTFTTP, ZTRTTF, ZTRTTP, ZTPTTR, ZTPTTF
00063 *     ..
00064 *     .. Scalars in Common ..
00065       CHARACTER*32       SRNAMT
00066 *     ..
00067 *     .. Common blocks ..
00068       COMMON             / SRNAMC / SRNAMT
00069 *     ..
00070 *     .. Data statements ..
00071       DATA               ISEEDY / 1988, 1989, 1990, 1991 /
00072       DATA               UPLOS / 'U', 'L' /
00073       DATA               FORMS / 'N', 'C' /
00074 *     ..
00075 *     .. Executable Statements ..
00076 *
00077 *     Initialize constants and the random number seed.
00078 *
00079       NRUN = 0
00080       NERRS = 0
00081       INFO = 0
00082       DO 10 I = 1, 4
00083          ISEED( I ) = ISEEDY( I )
00084    10 CONTINUE
00085 *
00086       DO 120 IIN = 1, NN
00087 *
00088          N = NVAL( IIN )
00089 *
00090 *        Do first for UPLO = 'U', then for UPLO = 'L'
00091 *
00092          DO 110 IUPLO = 1, 2
00093 *
00094             UPLO = UPLOS( IUPLO )
00095             LOWER = .TRUE.
00096             IF ( IUPLO.EQ.1 ) LOWER = .FALSE.
00097 *
00098 *           Do first for CFORM = 'N', then for CFORM = 'C'
00099 *
00100             DO 100 IFORM = 1, 2
00101 *
00102                CFORM = FORMS( IFORM )
00103 *
00104                NRUN = NRUN + 1
00105 *
00106                DO J = 1, N
00107                   DO I = 1, N
00108                      A( I, J) = ZLARND( 4, ISEED )
00109                   END DO
00110                END DO
00111 *
00112                SRNAMT = 'ZTRTTF'
00113                CALL ZTRTTF( CFORM, UPLO, N, A, LDA, ARF, INFO )
00114 *
00115                SRNAMT = 'ZTFTTP'
00116                CALL ZTFTTP( CFORM, UPLO, N, ARF, AP, INFO )
00117 *
00118                SRNAMT = 'ZTPTTR'
00119                CALL ZTPTTR( UPLO, N, AP, ASAV, LDA, INFO )
00120 *
00121                OK1 = .TRUE.
00122                IF ( LOWER ) THEN
00123                   DO J = 1, N
00124                      DO I = J, N
00125                         IF ( A(I,J).NE.ASAV(I,J) ) THEN
00126                            OK1 = .FALSE.
00127                         END IF
00128                      END DO
00129                   END DO
00130                ELSE
00131                   DO J = 1, N
00132                      DO I = 1, J
00133                         IF ( A(I,J).NE.ASAV(I,J) ) THEN
00134                            OK1 = .FALSE.
00135                         END IF
00136                      END DO
00137                   END DO
00138                END IF
00139 *
00140                NRUN = NRUN + 1
00141 *
00142                SRNAMT = 'ZTRTTP'
00143                CALL ZTRTTP( UPLO, N, A, LDA, AP, INFO )
00144 *
00145                SRNAMT = 'ZTPTTF'
00146                CALL ZTPTTF( CFORM, UPLO, N, AP, ARF, INFO )
00147 *
00148                SRNAMT = 'ZTFTTR'
00149                CALL ZTFTTR( CFORM, UPLO, N, ARF, ASAV, LDA, INFO )
00150 *
00151                OK2 = .TRUE.
00152                IF ( LOWER ) THEN
00153                   DO J = 1, N
00154                      DO I = J, N
00155                         IF ( A(I,J).NE.ASAV(I,J) ) THEN
00156                            OK2 = .FALSE.
00157                         END IF
00158                      END DO
00159                   END DO
00160                ELSE
00161                   DO J = 1, N
00162                      DO I = 1, J
00163                         IF ( A(I,J).NE.ASAV(I,J) ) THEN
00164                            OK2 = .FALSE.
00165                         END IF
00166                      END DO
00167                   END DO
00168                END IF
00169 *
00170                IF (( .NOT.OK1 ).OR.( .NOT.OK2 )) THEN
00171                   IF( NERRS.EQ.0 ) THEN
00172                      WRITE( NOUT, * )
00173                      WRITE( NOUT, FMT = 9999 )
00174                   END IF
00175                   WRITE( NOUT, FMT = 9998 ) N, UPLO, CFORM
00176                   NERRS = NERRS + 1
00177                END IF
00178 *
00179   100       CONTINUE
00180   110    CONTINUE
00181   120 CONTINUE
00182 *
00183 *     Print a summary of the results.
00184 *
00185       IF ( NERRS.EQ.0 ) THEN
00186          WRITE( NOUT, FMT = 9997 ) NRUN
00187       ELSE
00188          WRITE( NOUT, FMT = 9996 ) NERRS, NRUN
00189       END IF
00190 *
00191  9999 FORMAT( 1X, ' *** Error(s) while testing the RFP convertion',
00192      +         ' routines ***')
00193  9998 FORMAT( 1X, '     Error in RFP,convertion routines N=',I5,
00194      +        ' UPLO=''', A1, ''', FORM =''',A1,'''')
00195  9997 FORMAT( 1X, 'All tests for the RFP convertion routines passed (', 
00196      +        I5,' tests run)')
00197  9996 FORMAT( 1X, 'RFP convertion routines:',I5,' out of ',I5,
00198      +        ' error message recorded') 
00199 *
00200       RETURN
00201 *
00202 *     End of ZDRVRF2
00203 *
00204       END
 All Files Functions