LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
cchkrfp.f
Go to the documentation of this file.
00001 *> \brief \b CCHKRFP
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *  Definition:
00009 *  ===========
00010 *
00011 *       PROGRAM CCHKRFP
00012 * 
00013 *
00014 *> \par Purpose:
00015 *  =============
00016 *>
00017 *> \verbatim
00018 *>
00019 *> CCHKRFP is the main test program for the COMPLEX linear equation
00020 *> routines with RFP storage format
00021 *>
00022 *> \endverbatim
00023 *
00024 *  Arguments:
00025 *  ==========
00026 *
00027 *> \verbatim
00028 *>  MAXIN   INTEGER
00029 *>          The number of different values that can be used for each of
00030 *>          M, N, or NB
00031 *>
00032 *>  MAXRHS  INTEGER
00033 *>          The maximum number of right hand sides
00034 *>
00035 *>  NTYPES  INTEGER
00036 *>
00037 *>  NMAX    INTEGER
00038 *>          The maximum allowable value for N.
00039 *>
00040 *>  NIN     INTEGER
00041 *>          The unit number for input
00042 *>
00043 *>  NOUT    INTEGER
00044 *>          The unit number for output
00045 *> \endverbatim
00046 *
00047 *  Authors:
00048 *  ========
00049 *
00050 *> \author Univ. of Tennessee 
00051 *> \author Univ. of California Berkeley 
00052 *> \author Univ. of Colorado Denver 
00053 *> \author NAG Ltd. 
00054 *
00055 *> \date April 2012
00056 *
00057 *> \ingroup complex_lin
00058 *
00059 *  =====================================================================
00060       PROGRAM CCHKRFP
00061 *
00062 *  -- LAPACK test routine (version 3.4.1) --
00063 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00064 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00065 *     April 2012
00066 *
00067 *  =====================================================================
00068 *
00069 *     .. Parameters ..
00070       INTEGER            MAXIN
00071       PARAMETER          ( MAXIN = 12 )
00072       INTEGER            NMAX
00073       PARAMETER          ( NMAX =  50 )
00074       INTEGER            MAXRHS
00075       PARAMETER          ( MAXRHS = 16 )
00076       INTEGER            NTYPES
00077       PARAMETER          ( NTYPES = 9 )
00078       INTEGER            NIN, NOUT
00079       PARAMETER          ( NIN = 5, NOUT = 6 )
00080 *     ..
00081 *     .. Local Scalars ..
00082       LOGICAL            FATAL, TSTERR
00083       INTEGER            VERS_MAJOR, VERS_MINOR, VERS_PATCH
00084       INTEGER            I, NN, NNS, NNT
00085       REAL               EPS, S1, S2, THRESH
00086 
00087 *     ..
00088 *     .. Local Arrays ..
00089       INTEGER            NVAL( MAXIN ), NSVAL( MAXIN ), NTVAL( NTYPES )
00090       COMPLEX            WORKA( NMAX, NMAX )
00091       COMPLEX            WORKASAV( NMAX, NMAX )
00092       COMPLEX            WORKB( NMAX, MAXRHS )
00093       COMPLEX            WORKXACT( NMAX, MAXRHS )
00094       COMPLEX            WORKBSAV( NMAX, MAXRHS )
00095       COMPLEX            WORKX( NMAX, MAXRHS )
00096       COMPLEX            WORKAFAC( NMAX, NMAX )
00097       COMPLEX            WORKAINV( NMAX, NMAX )
00098       COMPLEX            WORKARF( (NMAX*(NMAX+1))/2 )
00099       COMPLEX            WORKAP( (NMAX*(NMAX+1))/2 )
00100       COMPLEX            WORKARFINV( (NMAX*(NMAX+1))/2 )
00101       COMPLEX            C_WORK_CLATMS( 3 * NMAX )
00102       COMPLEX            C_WORK_CPOT02( NMAX, MAXRHS )
00103       COMPLEX            C_WORK_CPOT03( NMAX, NMAX )
00104       REAL               S_WORK_CLATMS( NMAX )
00105       REAL               S_WORK_CLANHE( NMAX )
00106       REAL               S_WORK_CPOT01( NMAX )
00107       REAL               S_WORK_CPOT02( NMAX )
00108       REAL               S_WORK_CPOT03( NMAX )
00109 *     ..
00110 *     .. External Functions ..
00111       REAL               SLAMCH, SECOND
00112       EXTERNAL           SLAMCH, SECOND
00113 *     ..
00114 *     .. External Subroutines ..
00115       EXTERNAL           ILAVER, CDRVRFP, CDRVRF1, CDRVRF2, CDRVRF3,
00116      +                   CDRVRF4
00117 *     ..
00118 *     .. Executable Statements ..
00119 *
00120       S1 = SECOND( )
00121       FATAL = .FALSE.
00122 *
00123 *     Read a dummy line.
00124 *
00125       READ( NIN, FMT = * )
00126 *
00127 *     Report LAPACK version tag (e.g. LAPACK-3.2.0)
00128 *
00129       CALL ILAVER( VERS_MAJOR, VERS_MINOR, VERS_PATCH )
00130       WRITE( NOUT, FMT = 9994 ) VERS_MAJOR, VERS_MINOR, VERS_PATCH
00131 *
00132 *     Read the values of N
00133 *
00134       READ( NIN, FMT = * )NN
00135       IF( NN.LT.1 ) THEN
00136          WRITE( NOUT, FMT = 9996 )' NN ', NN, 1
00137          NN = 0
00138          FATAL = .TRUE.
00139       ELSE IF( NN.GT.MAXIN ) THEN
00140          WRITE( NOUT, FMT = 9995 )' NN ', NN, MAXIN
00141          NN = 0
00142          FATAL = .TRUE.
00143       END IF
00144       READ( NIN, FMT = * )( NVAL( I ), I = 1, NN )
00145       DO 10 I = 1, NN
00146          IF( NVAL( I ).LT.0 ) THEN
00147             WRITE( NOUT, FMT = 9996 )' M  ', NVAL( I ), 0
00148             FATAL = .TRUE.
00149          ELSE IF( NVAL( I ).GT.NMAX ) THEN
00150             WRITE( NOUT, FMT = 9995 )' M  ', NVAL( I ), NMAX
00151             FATAL = .TRUE.
00152          END IF
00153    10 CONTINUE
00154       IF( NN.GT.0 )
00155      $   WRITE( NOUT, FMT = 9993 )'N   ', ( NVAL( I ), I = 1, NN )
00156 *
00157 *     Read the values of NRHS
00158 *
00159       READ( NIN, FMT = * )NNS
00160       IF( NNS.LT.1 ) THEN
00161          WRITE( NOUT, FMT = 9996 )' NNS', NNS, 1
00162          NNS = 0
00163          FATAL = .TRUE.
00164       ELSE IF( NNS.GT.MAXIN ) THEN
00165          WRITE( NOUT, FMT = 9995 )' NNS', NNS, MAXIN
00166          NNS = 0
00167          FATAL = .TRUE.
00168       END IF
00169       READ( NIN, FMT = * )( NSVAL( I ), I = 1, NNS )
00170       DO 30 I = 1, NNS
00171          IF( NSVAL( I ).LT.0 ) THEN
00172             WRITE( NOUT, FMT = 9996 )'NRHS', NSVAL( I ), 0
00173             FATAL = .TRUE.
00174          ELSE IF( NSVAL( I ).GT.MAXRHS ) THEN
00175             WRITE( NOUT, FMT = 9995 )'NRHS', NSVAL( I ), MAXRHS
00176             FATAL = .TRUE.
00177          END IF
00178    30 CONTINUE
00179       IF( NNS.GT.0 )
00180      $   WRITE( NOUT, FMT = 9993 )'NRHS', ( NSVAL( I ), I = 1, NNS )
00181 *
00182 *     Read the matrix types
00183 *
00184       READ( NIN, FMT = * )NNT
00185       IF( NNT.LT.1 ) THEN
00186          WRITE( NOUT, FMT = 9996 )' NMA', NNT, 1
00187          NNT = 0
00188          FATAL = .TRUE.
00189       ELSE IF( NNT.GT.NTYPES ) THEN
00190          WRITE( NOUT, FMT = 9995 )' NMA', NNT, NTYPES
00191          NNT = 0
00192          FATAL = .TRUE.
00193       END IF
00194       READ( NIN, FMT = * )( NTVAL( I ), I = 1, NNT )
00195       DO 320 I = 1, NNT
00196          IF( NTVAL( I ).LT.0 ) THEN
00197             WRITE( NOUT, FMT = 9996 )'TYPE', NTVAL( I ), 0
00198             FATAL = .TRUE.
00199          ELSE IF( NTVAL( I ).GT.NTYPES ) THEN
00200             WRITE( NOUT, FMT = 9995 )'TYPE', NTVAL( I ), NTYPES
00201             FATAL = .TRUE.
00202          END IF
00203   320 CONTINUE
00204       IF( NNT.GT.0 )
00205      $   WRITE( NOUT, FMT = 9993 )'TYPE', ( NTVAL( I ), I = 1, NNT )
00206 *
00207 *     Read the threshold value for the test ratios.
00208 *
00209       READ( NIN, FMT = * )THRESH
00210       WRITE( NOUT, FMT = 9992 )THRESH
00211 *
00212 *     Read the flag that indicates whether to test the error exits.
00213 *
00214       READ( NIN, FMT = * )TSTERR
00215 *
00216       IF( FATAL ) THEN
00217          WRITE( NOUT, FMT = 9999 )
00218          STOP
00219       END IF
00220 *
00221       IF( FATAL ) THEN
00222          WRITE( NOUT, FMT = 9999 )
00223          STOP
00224       END IF
00225 *
00226 *     Calculate and print the machine dependent constants.
00227 *
00228       EPS = SLAMCH( 'Underflow threshold' )
00229       WRITE( NOUT, FMT = 9991 )'underflow', EPS
00230       EPS = SLAMCH( 'Overflow threshold' )
00231       WRITE( NOUT, FMT = 9991 )'overflow ', EPS
00232       EPS = SLAMCH( 'Epsilon' )
00233       WRITE( NOUT, FMT = 9991 )'precision', EPS
00234       WRITE( NOUT, FMT = * )
00235 *
00236 *     Test the error exit of:
00237 *
00238       IF( TSTERR )
00239      $   CALL CERRRFP( NOUT )
00240 *
00241 *    Test the routines: cpftrf, cpftri, cpftrs (as in CDRVPO).
00242 *    This also tests the routines: ctfsm, ctftri, ctfttr, ctrttf.
00243 *
00244       CALL CDRVRFP( NOUT, NN, NVAL, NNS, NSVAL, NNT, NTVAL, THRESH,
00245      $              WORKA, WORKASAV, WORKAFAC, WORKAINV, WORKB,
00246      $              WORKBSAV, WORKXACT, WORKX, WORKARF, WORKARFINV,
00247      $              C_WORK_CLATMS, C_WORK_CPOT02,
00248      $              C_WORK_CPOT03, S_WORK_CLATMS, S_WORK_CLANHE,
00249      $              S_WORK_CPOT01, S_WORK_CPOT02, S_WORK_CPOT03 )
00250 *
00251 *    Test the routine: clanhf
00252 *
00253       CALL CDRVRF1( NOUT, NN, NVAL, THRESH, WORKA, NMAX, WORKARF,
00254      +              S_WORK_CLANHE )
00255 *
00256 *    Test the convertion routines:
00257 *       chfttp, ctpthf, ctfttr, ctrttf, ctrttp and ctpttr.
00258 *
00259       CALL CDRVRF2( NOUT, NN, NVAL, WORKA, NMAX, WORKARF,
00260      +              WORKAP, WORKASAV )
00261 *
00262 *    Test the routine: ctfsm
00263 *
00264       CALL CDRVRF3( NOUT, NN, NVAL, THRESH, WORKA, NMAX, WORKARF,
00265      +              WORKAINV, WORKAFAC, S_WORK_CLANHE,
00266      +              C_WORK_CPOT03, C_WORK_CPOT02 )
00267 *
00268 *
00269 *    Test the routine: chfrk
00270 *
00271       CALL CDRVRF4( NOUT, NN, NVAL, THRESH, WORKA, WORKAFAC, NMAX,
00272      +              WORKARF, WORKAINV, NMAX, S_WORK_CLANHE)
00273 *
00274       CLOSE ( NIN )
00275       S2 = SECOND( )
00276       WRITE( NOUT, FMT = 9998 )
00277       WRITE( NOUT, FMT = 9997 )S2 - S1
00278 *
00279  9999 FORMAT( / ' Execution not attempted due to input errors' )
00280  9998 FORMAT( / ' End of tests' )
00281  9997 FORMAT( ' Total time used = ', F12.2, ' seconds', / )
00282  9996 FORMAT( ' !! Invalid input value: ', A4, '=', I6, '; must be >=',
00283      $      I6 )
00284  9995 FORMAT( ' !! Invalid input value: ', A4, '=', I6, '; must be <=',
00285      $      I6 )
00286  9994 FORMAT( /  ' Tests of the COMPLEX LAPACK RFP routines ',
00287      $      / ' LAPACK VERSION ', I1, '.', I1, '.', I1,
00288      $      / / ' The following parameter values will be used:' )
00289  9993 FORMAT( 4X, A4, ':  ', 10I6, / 11X, 10I6 )
00290  9992 FORMAT( / ' Routines pass computational tests if test ratio is ',
00291      $      'less than', F8.2, / )
00292  9991 FORMAT( ' Relative machine ', A, ' is taken to be', D16.6 )
00293 *
00294 *     End of CCHKRFP
00295 *
00296       END
 All Files Functions