TESTING/LIN/schkrfp.f

   1 *> \brief \b SCHKRFP
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *  Definition:
   9 *  ===========
  10 *
  11 *       PROGRAM SCHKRFP
  12 *
  13 *
  14 *> \par Purpose:
  15 *  =============
  16 *>
  17 *> \verbatim
  18 *>
  19 *> SCHKRFP is the main test program for the REAL linear
  20 *> equation routines with RFP storage format
  21 *>
  22 *> \endverbatim
  23 *
  24 *  Arguments:
  25 *  ==========
  26 *
  27 *> \verbatim
  28 *>  MAXIN   INTEGER
  29 *>          The number of different values that can be used for each of
  30 *>          M, N, or NB
  31 *>
  32 *>  MAXRHS  INTEGER
  33 *>          The maximum number of right hand sides
  34 *>
  35 *>  NTYPES  INTEGER
  36 *>
  37 *>  NMAX    INTEGER
  38 *>          The maximum allowable value for N.
  39 *>
  40 *>  NIN     INTEGER
  41 *>          The unit number for input
  42 *>
  43 *>  NOUT    INTEGER
  44 *>          The unit number for output
  45 *> \endverbatim
  46 *
  47 *  Authors:
  48 *  ========
  49 *
  50 *> \author Univ. of Tennessee
  51 *> \author Univ. of California Berkeley
  52 *> \author Univ. of Colorado Denver
  53 *> \author NAG Ltd.
  54 *
  55 *> \date April 2012
  56 *
  57 *> \ingroup single_lin
  58 *
  59 *  =====================================================================
  60       PROGRAM SCHKRFP
  61 *
  62 *  -- LAPACK test routine (version 3.4.1) --
  63 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  64 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  65 *     April 2012
  66 *
  67 *  =====================================================================
  68 *
  69 *     .. Parameters ..
  70       INTEGER            MAXIN
  71       PARAMETER          ( MAXIN = 12 )
  72       INTEGER            NMAX
  73       PARAMETER          ( NMAX =  50 )
  74       INTEGER            MAXRHS
  75       PARAMETER          ( MAXRHS = 16 )
  76       INTEGER            NTYPES
  77       PARAMETER          ( NTYPES = 9 )
  78       INTEGER            NIN, NOUT
  79       PARAMETER          ( NIN = 5, NOUT = 6 )
  80 *     ..
  81 *     .. Local Scalars ..
  82       LOGICAL            FATAL, TSTERR
  83       INTEGER            VERS_MAJOR, VERS_MINOR, VERS_PATCH
  84       INTEGER            I, NN, NNS, NNT
  85       REAL               EPS, S1, S2, THRESH
  86 *     ..
  87 *     .. Local Arrays ..
  88       INTEGER            NVAL( MAXIN ), NSVAL( MAXIN ), NTVAL( NTYPES )
  89       REAL               WORKA( NMAX, NMAX )
  90       REAL               WORKASAV( NMAX, NMAX )
  91       REAL               WORKB( NMAX, MAXRHS )
  92       REAL               WORKXACT( NMAX, MAXRHS )
  93       REAL               WORKBSAV( NMAX, MAXRHS )
  94       REAL               WORKX( NMAX, MAXRHS )
  95       REAL               WORKAFAC( NMAX, NMAX )
  96       REAL               WORKAINV( NMAX, NMAX )
  97       REAL               WORKARF( (NMAX*(NMAX+1))/2 )
  98       REAL               WORKAP( (NMAX*(NMAX+1))/2 )
  99       REAL               WORKARFINV( (NMAX*(NMAX+1))/2 )
 100       REAL               S_WORK_SLATMS( 3 * NMAX )
 101       REAL               S_WORK_SPOT01( NMAX )
 102       REAL               S_TEMP_SPOT02( NMAX, MAXRHS )
 103       REAL               S_TEMP_SPOT03( NMAX, NMAX )
 104       REAL               S_WORK_SLANSY( NMAX )
 105       REAL               S_WORK_SPOT02( NMAX )
 106       REAL               S_WORK_SPOT03( NMAX )
 107 *     ..
 108 *     .. External Functions ..
 109       REAL               SLAMCH, SECOND
 110       EXTERNAL           SLAMCH, SECOND
 111 *     ..
 112 *     .. External Subroutines ..
 113       EXTERNAL           ILAVER, SDRVRFP, SDRVRF1, SDRVRF2, SDRVRF3,
 114      +                   SDRVRF4
 115 *     ..
 116 *     .. Executable Statements ..
 117 *
 118       S1 = SECOND( )
 119       FATAL = .FALSE.
 120 *
 121 *     Read a dummy line.
 122 *
 123       READ( NIN, FMT = * )
 124 *
 125 *     Report LAPACK version tag (e.g. LAPACK-3.2.0)
 126 *
 127       CALL ILAVER( VERS_MAJOR, VERS_MINOR, VERS_PATCH )
 128       WRITE( NOUT, FMT = 9994 ) VERS_MAJOR, VERS_MINOR, VERS_PATCH
 129 *
 130 *     Read the values of N
 131 *
 132       READ( NIN, FMT = * )NN
 133       IF( NN.LT.1 ) THEN
 134          WRITE( NOUT, FMT = 9996 )' NN ', NN, 1
 135          NN = 0
 136          FATAL = .TRUE.
 137       ELSE IF( NN.GT.MAXIN ) THEN
 138          WRITE( NOUT, FMT = 9995 )' NN ', NN, MAXIN
 139          NN = 0
 140          FATAL = .TRUE.
 141       END IF
 142       READ( NIN, FMT = * )( NVAL( I ), I = 1, NN )
 143       DO 10 I = 1, NN
 144          IF( NVAL( I ).LT.0 ) THEN
 145             WRITE( NOUT, FMT = 9996 )' M  ', NVAL( I ), 0
 146             FATAL = .TRUE.
 147          ELSE IF( NVAL( I ).GT.NMAX ) THEN
 148             WRITE( NOUT, FMT = 9995 )' M  ', NVAL( I ), NMAX
 149             FATAL = .TRUE.
 150          END IF
 151    10 CONTINUE
 152       IF( NN.GT.0 )
 153      $   WRITE( NOUT, FMT = 9993 )'N   ', ( NVAL( I ), I = 1, NN )
 154 *
 155 *     Read the values of NRHS
 156 *
 157       READ( NIN, FMT = * )NNS
 158       IF( NNS.LT.1 ) THEN
 159          WRITE( NOUT, FMT = 9996 )' NNS', NNS, 1
 160          NNS = 0
 161          FATAL = .TRUE.
 162       ELSE IF( NNS.GT.MAXIN ) THEN
 163          WRITE( NOUT, FMT = 9995 )' NNS', NNS, MAXIN
 164          NNS = 0
 165          FATAL = .TRUE.
 166       END IF
 167       READ( NIN, FMT = * )( NSVAL( I ), I = 1, NNS )
 168       DO 30 I = 1, NNS
 169          IF( NSVAL( I ).LT.0 ) THEN
 170             WRITE( NOUT, FMT = 9996 )'NRHS', NSVAL( I ), 0
 171             FATAL = .TRUE.
 172          ELSE IF( NSVAL( I ).GT.MAXRHS ) THEN
 173             WRITE( NOUT, FMT = 9995 )'NRHS', NSVAL( I ), MAXRHS
 174             FATAL = .TRUE.
 175          END IF
 176    30 CONTINUE
 177       IF( NNS.GT.0 )
 178      $   WRITE( NOUT, FMT = 9993 )'NRHS', ( NSVAL( I ), I = 1, NNS )
 179 *
 180 *     Read the matrix types
 181 *
 182       READ( NIN, FMT = * )NNT
 183       IF( NNT.LT.1 ) THEN
 184          WRITE( NOUT, FMT = 9996 )' NMA', NNT, 1
 185          NNT = 0
 186          FATAL = .TRUE.
 187       ELSE IF( NNT.GT.NTYPES ) THEN
 188          WRITE( NOUT, FMT = 9995 )' NMA', NNT, NTYPES
 189          NNT = 0
 190          FATAL = .TRUE.
 191       END IF
 192       READ( NIN, FMT = * )( NTVAL( I ), I = 1, NNT )
 193       DO 320 I = 1, NNT
 194          IF( NTVAL( I ).LT.0 ) THEN
 195             WRITE( NOUT, FMT = 9996 )'TYPE', NTVAL( I ), 0
 196             FATAL = .TRUE.
 197          ELSE IF( NTVAL( I ).GT.NTYPES ) THEN
 198             WRITE( NOUT, FMT = 9995 )'TYPE', NTVAL( I ), NTYPES
 199             FATAL = .TRUE.
 200          END IF
 201   320 CONTINUE
 202       IF( NNT.GT.0 )
 203      $   WRITE( NOUT, FMT = 9993 )'TYPE', ( NTVAL( I ), I = 1, NNT )
 204 *
 205 *     Read the threshold value for the test ratios.
 206 *
 207       READ( NIN, FMT = * )THRESH
 208       WRITE( NOUT, FMT = 9992 )THRESH
 209 *
 210 *     Read the flag that indicates whether to test the error exits.
 211 *
 212       READ( NIN, FMT = * )TSTERR
 213 *
 214       IF( FATAL ) THEN
 215          WRITE( NOUT, FMT = 9999 )
 216          STOP
 217       END IF
 218 *
 219       IF( FATAL ) THEN
 220          WRITE( NOUT, FMT = 9999 )
 221          STOP
 222       END IF
 223 *
 224 *     Calculate and print the machine dependent constants.
 225 *
 226       EPS = SLAMCH( 'Underflow threshold' )
 227       WRITE( NOUT, FMT = 9991 )'underflow', EPS
 228       EPS = SLAMCH( 'Overflow threshold' )
 229       WRITE( NOUT, FMT = 9991 )'overflow ', EPS
 230       EPS = SLAMCH( 'Epsilon' )
 231       WRITE( NOUT, FMT = 9991 )'precision', EPS
 232       WRITE( NOUT, FMT = * )
 233 *
 234 *     Test the error exit of:
 235 *
 236       IF( TSTERR )
 237      $   CALL SERRRFP( NOUT )
 238 *
 239 *     Test the routines: spftrf, spftri, spftrs (as in SDRVPO).
 240 *     This also tests the routines: stfsm, stftri, stfttr, strttf.
 241 *
 242       CALL SDRVRFP( NOUT, NN, NVAL, NNS, NSVAL, NNT, NTVAL, THRESH,
 243      $              WORKA, WORKASAV, WORKAFAC, WORKAINV, WORKB,
 244      $              WORKBSAV, WORKXACT, WORKX, WORKARF, WORKARFINV,
 245      $              S_WORK_SLATMS, S_WORK_SPOT01, S_TEMP_SPOT02,
 246      $              S_TEMP_SPOT03, S_WORK_SLANSY, S_WORK_SPOT02,
 247      $              S_WORK_SPOT03 )
 248 *
 249 *     Test the routine: slansf
 250 *
 251       CALL SDRVRF1( NOUT, NN, NVAL, THRESH, WORKA, NMAX, WORKARF,
 252      +              S_WORK_SLANSY )
 253 *
 254 *     Test the conversion routines:
 255 *       stfttp, stpttf, stfttr, strttf, strttp and stpttr.
 256 *
 257       CALL SDRVRF2( NOUT, NN, NVAL, WORKA, NMAX, WORKARF,
 258      +              WORKAP, WORKASAV )
 259 *
 260 *     Test the routine: stfsm
 261 *
 262       CALL SDRVRF3( NOUT, NN, NVAL, THRESH, WORKA, NMAX, WORKARF,
 263      +              WORKAINV, WORKAFAC, S_WORK_SLANSY,
 264      +              S_WORK_SPOT03, S_WORK_SPOT01 )
 265 *
 266 *
 267 *     Test the routine: ssfrk
 268 *
 269       CALL SDRVRF4( NOUT, NN, NVAL, THRESH, WORKA, WORKAFAC, NMAX,
 270      +              WORKARF, WORKAINV, NMAX, S_WORK_SLANSY)
 271 *
 272       CLOSE ( NIN )
 273       S2 = SECOND( )
 274       WRITE( NOUT, FMT = 9998 )
 275       WRITE( NOUT, FMT = 9997 )S2 - S1
 276 *
 277  9999 FORMAT( / ' Execution not attempted due to input errors' )
 278  9998 FORMAT( / ' End of tests' )
 279  9997 FORMAT( ' Total time used = ', F12.2, ' seconds', / )
 280  9996 FORMAT( ' !! Invalid input value: ', A4, '=', I6, '; must be >=',
 281      $      I6 )
 282  9995 FORMAT( ' !! Invalid input value: ', A4, '=', I6, '; must be <=',
 283      $      I6 )
 284  9994 FORMAT( /  ' Tests of the REAL LAPACK RFP routines ',
 285      $      / ' LAPACK VERSION ', I1, '.', I1, '.', I1,
 286      $      / / ' The following parameter values will be used:' )
 287  9993 FORMAT( 4X, A4, ':  ', 10I6, / 11X, 10I6 )
 288  9992 FORMAT( / ' Routines pass computational tests if test ratio is ',
 289      $      'less than', F8.2, / )
 290  9991 FORMAT( ' Relative machine ', A, ' is taken to be', D16.6 )
 291 *
 292 *     End of SCHKRFP
 293 *
 294       END