1       PROGRAM DCHKAB
  2       IMPLICIT NONE
  3 *
  4 *  -- LAPACK test routine (version 3.2.1) --
  5 *
  6 *  -- April 2009                                                   --
  7 *
  8 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  9 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 10 *
 11 *  Purpose
 12 *  =======
 13 *
 14 *  DCHKAB is the test program for the DOUBLE PRECISION LAPACK
 15 *  DSGESV/DSPOSV routine
 16 *
 17 *  The program must be driven by a short data file. The first 5 records
 18 *  specify problem dimensions and program options using list-directed
 19 *  input. The remaining lines specify the LAPACK test paths and the
 20 *  number of matrix types to use in testing.  An annotated example of a
 21 *  data file can be obtained by deleting the first 3 characters from the
 22 *  following 10 lines:
 23 *  Data file for testing DOUBLE PRECISION LAPACK DSGESV
 24 *  7                      Number of values of M
 25 *  0 1 2 3 5 10 16        Values of M (row dimension)
 26 *  1                      Number of values of NRHS
 27 *  2                      Values of NRHS (number of right hand sides)
 28 *  20.0                   Threshold value of test ratio
 29 *  T                      Put T to test the LAPACK routines
 30 *  T                      Put T to test the error exits 
 31 *  DGE    11              List types on next line if 0 < NTYPES < 11
 32 *  DPO    9               List types on next line if 0 < NTYPES <  9
 33 *
 34 *  Internal Parameters
 35 *  ===================
 36 *
 37 *  NMAX    INTEGER
 38 *          The maximum allowable value for N
 39 *
 40 *  MAXIN   INTEGER
 41 *          The number of different values that can be used for each of
 42 *          M, N, NRHS, NB, and NX
 43 *
 44 *  MAXRHS  INTEGER
 45 *          The maximum number of right hand sides
 46 *
 47 *  NIN     INTEGER
 48 *          The unit number for input
 49 *
 50 *  NOUT    INTEGER
 51 *          The unit number for output
 52 *
 53 *  =====================================================================
 54 *
 55 *     .. Parameters ..
 56       INTEGER            NMAX
 57       PARAMETER          ( NMAX = 132 )
 58       INTEGER            MAXIN
 59       PARAMETER          ( MAXIN = 12 )
 60       INTEGER            MAXRHS
 61       PARAMETER          ( MAXRHS = 16 )
 62       INTEGER            MATMAX
 63       PARAMETER          ( MATMAX = 30 )
 64       INTEGER            NIN, NOUT
 65       PARAMETER          ( NIN = 5, NOUT = 6 )
 66       INTEGER            LDAMAX
 67       PARAMETER          ( LDAMAX = NMAX )
 68 *     ..
 69 *     .. Local Scalars ..
 70       LOGICAL            FATAL, TSTDRV, TSTERR
 71       CHARACTER          C1
 72       CHARACTER*2        C2
 73       CHARACTER*3        PATH
 74       CHARACTER*10       INTSTR
 75       CHARACTER*72       ALINE
 76       INTEGER            I, IC, K, LDA, NM, NMATS, 
 77      $                   NNS, NRHS, NTYPES,
 78      $                   VERS_MAJOR, VERS_MINOR, VERS_PATCH
 79       DOUBLE PRECISION   EPS, S1, S2, THRESH
 80       REAL               SEPS
 81 *     ..
 82 *     .. Local Arrays ..
 83       LOGICAL            DOTYPE( MATMAX )
 84       INTEGER            IWORK( NMAX ), MVAL( MAXIN ), NSVAL( MAXIN )
 85       DOUBLE PRECISION   A( LDAMAX*NMAX, 2 ), B( NMAX*MAXRHS, 2 ),
 86      $                   RWORK( NMAX ), WORK( NMAX*MAXRHS*2 )
 87       REAL               SWORK(NMAX*(NMAX+MAXRHS))
 88 *     ..
 89 *     .. External Functions ..
 90       DOUBLE PRECISION   DLAMCH, DSECND
 91       LOGICAL            LSAME, LSAMEN
 92       REAL               SLAMCH
 93       EXTERNAL           LSAME, LSAMEN, DLAMCH, DSECND, SLAMCH
 94 *     ..
 95 *     .. External Subroutines ..
 96       EXTERNAL           ALAREQ, DDRVAB, DDRVAC, DERRAB, DERRAC,
 97      $                   ILAVER
 98 *     ..
 99 *     .. Scalars in Common ..
100       LOGICAL            LERR, OK
101       CHARACTER*32       SRNAMT
102       INTEGER            INFOT, NUNIT
103 *     ..
104 *     .. Common blocks ..
105       COMMON             / INFOC / INFOT, NUNIT, OK, LERR
106       COMMON             / SRNAMC / SRNAMT
107 *     ..
108 *     .. Data statements ..
109       DATA               INTSTR / '0123456789' /
110 *     ..
111 *     .. Executable Statements ..
112 *
113       S1 = DSECND( )
114       LDA = NMAX
115       FATAL = .FALSE.
116 *
117 *     Read a dummy line.
118 *
119       READ( NIN, FMT = * )
120 *
121 *     Report values of parameters.
122 *
123       CALL ILAVER( VERS_MAJOR, VERS_MINOR, VERS_PATCH )
124       WRITE( NOUT, FMT = 9994 ) VERS_MAJOR, VERS_MINOR, VERS_PATCH
125 *
126 *     Read the values of M
127 *
128       READ( NIN, FMT = * )NM
129       IF( NM.LT.1 ) THEN
130          WRITE( NOUT, FMT = 9996 )' NM ', NM, 1
131          NM = 0
132          FATAL = .TRUE.
133       ELSE IF( NM.GT.MAXIN ) THEN
134          WRITE( NOUT, FMT = 9995 )' NM ', NM, MAXIN
135          NM = 0
136          FATAL = .TRUE.
137       END IF
138       READ( NIN, FMT = * )( MVAL( I ), I = 1, NM )
139       DO 10 I = 1, NM
140          IF( MVAL( I ).LT.0 ) THEN
141             WRITE( NOUT, FMT = 9996 )' M  ', MVAL( I ), 0
142             FATAL = .TRUE.
143          ELSE IF( MVAL( I ).GT.NMAX ) THEN
144             WRITE( NOUT, FMT = 9995 )' M  ', MVAL( I ), NMAX
145             FATAL = .TRUE.
146          END IF
147    10 CONTINUE
148       IF( NM.GT.0 )
149      $   WRITE( NOUT, FMT = 9993 )'M   ', ( MVAL( I ), I = 1, NM )
150 *
151 *     Read the values of NRHS
152 *
153       READ( NIN, FMT = * )NNS
154       IF( NNS.LT.1 ) THEN
155          WRITE( NOUT, FMT = 9996 )' NNS', NNS, 1
156          NNS = 0
157          FATAL = .TRUE.
158       ELSE IF( NNS.GT.MAXIN ) THEN
159          WRITE( NOUT, FMT = 9995 )' NNS', NNS, MAXIN
160          NNS = 0
161          FATAL = .TRUE.
162       END IF
163       READ( NIN, FMT = * )( NSVAL( I ), I = 1, NNS )
164       DO 30 I = 1, NNS
165          IF( NSVAL( I ).LT.0 ) THEN
166             WRITE( NOUT, FMT = 9996 )'NRHS', NSVAL( I ), 0
167             FATAL = .TRUE.
168          ELSE IF( NSVAL( I ).GT.MAXRHS ) THEN
169             WRITE( NOUT, FMT = 9995 )'NRHS', NSVAL( I ), MAXRHS
170             FATAL = .TRUE.
171          END IF
172    30 CONTINUE
173       IF( NNS.GT.0 )
174      $   WRITE( NOUT, FMT = 9993 )'NRHS', ( NSVAL( I ), I = 1, NNS )
175 *
176 *     Read the threshold value for the test ratios.
177 *
178       READ( NIN, FMT = * )THRESH
179       WRITE( NOUT, FMT = 9992 )THRESH
180 *
181 *     Read the flag that indicates whether to test the driver routine.
182 *
183       READ( NIN, FMT = * )TSTDRV
184 *
185 *     Read the flag that indicates whether to test the error exits.
186 *
187       READ( NIN, FMT = * )TSTERR
188 *
189       IF( FATAL ) THEN
190          WRITE( NOUT, FMT = 9999 )
191          STOP
192       END IF
193 *
194 *     Calculate and print the machine dependent constants.
195 *
196       SEPS = SLAMCH( 'Underflow threshold' )
197       WRITE( NOUT, FMT = 9991 )'(single precision) underflow', SEPS
198       SEPS = SLAMCH( 'Overflow threshold' )
199       WRITE( NOUT, FMT = 9991 )'(single precision) overflow ', SEPS
200       SEPS = SLAMCH( 'Epsilon' )
201       WRITE( NOUT, FMT = 9991 )'(single precision) precision', SEPS
202       WRITE( NOUT, FMT = * )
203 *
204       EPS = DLAMCH( 'Underflow threshold' )
205       WRITE( NOUT, FMT = 9991 )'(double precision) underflow', EPS
206       EPS = DLAMCH( 'Overflow threshold' )
207       WRITE( NOUT, FMT = 9991 )'(double precision) overflow ', EPS
208       EPS = DLAMCH( 'Epsilon' )
209       WRITE( NOUT, FMT = 9991 )'(double precision) precision', EPS
210       WRITE( NOUT, FMT = * )
211 *
212    80 CONTINUE
213 *
214 *     Read a test path and the number of matrix types to use.
215 *
216       READ( NIN, FMT = '(A72)'END = 140 )ALINE
217       PATH = ALINE( 13 )
218       NMATS = MATMAX
219       I = 3
220    90 CONTINUE
221       I = I + 1
222       IF( I.GT.72 ) THEN
223          NMATS = MATMAX
224          GO TO 130
225       END IF
226       IF( ALINE( I: I ).EQ.' ' )
227      $   GO TO 90
228       NMATS = 0
229   100 CONTINUE
230       C1 = ALINE( I: I )
231       DO 110 K = 110
232          IF( C1.EQ.INTSTR( K: K ) ) THEN
233             IC = K - 1
234             GO TO 120
235          END IF
236   110 CONTINUE
237       GO TO 130
238   120 CONTINUE
239       NMATS = NMATS*10 + IC
240       I = I + 1
241       IF( I.GT.72 )
242      $   GO TO 130
243       GO TO 100
244   130 CONTINUE
245       C1 = PATH( 11 )
246       C2 = PATH( 23 )
247       NRHS = NSVAL( 1 )
248 *
249 *     Check first character for correct precision.
250 *
251       IF.NOT.LSAME( C1, 'Double precision' ) ) THEN
252          WRITE( NOUT, FMT = 9990 )PATH
253 
254 *
255       ELSE IF( NMATS.LE.0 ) THEN
256 *
257 *        Check for a positive number of tests requested.
258 *
259          WRITE( NOUT, FMT = 9989 )PATH
260          GO TO 140
261 *
262       ELSE IF( LSAMEN( 2, C2, 'GE' ) ) THEN
263 *
264 *        GE:  general matrices
265 *
266          NTYPES = 11
267          CALL ALAREQ( 'DGE', NMATS, DOTYPE, NTYPES, NIN, NOUT )
268 *
269 *        Test the error exits
270 *
271          IF( TSTERR )
272      $      CALL DERRAB( NOUT )
273 *
274          IF( TSTDRV ) THEN
275             CALL DDRVAB( DOTYPE, NM, MVAL, NNS,
276      $                   NSVAL, THRESH, LDA, A( 11 ),
277      $                   A( 12 ), B( 11 ), B( 12 ),
278      $                   WORK, RWORK, SWORK, IWORK, NOUT )
279          ELSE
280             WRITE( NOUT, FMT = 9989 )'DSGESV'
281          END IF
282 *     
283       ELSE IF( LSAMEN( 2, C2, 'PO' ) ) THEN
284 *
285 *        PO:  positive definite matrices
286 *
287          NTYPES = 9
288          CALL ALAREQ( 'DPO', NMATS, DOTYPE, NTYPES, NIN, NOUT )
289 *
290 *
291          IF( TSTERR )
292      $      CALL DERRAC( NOUT )
293 *
294 *
295          IF( TSTDRV ) THEN
296             CALL DDRVAC( DOTYPE, NM, MVAL, NNS, NSVAL,
297      $                   THRESH, LDA, A( 11 ), A( 12 ),
298      $                   B( 11 ), B( 12 ), 
299      $                   WORK, RWORK, SWORK, NOUT )
300          ELSE
301             WRITE( NOUT, FMT = 9989 )PATH
302          END IF
303       ELSE
304 *
305       END IF
306 *
307 *     Go back to get another input line.
308 *
309       GO TO 80
310 *
311 *     Branch to this line when the last record is read.
312 *
313   140 CONTINUE
314       CLOSE ( NIN )
315       S2 = DSECND( )
316       WRITE( NOUT, FMT = 9998 )
317       WRITE( NOUT, FMT = 9997 )S2 - S1
318 *
319  9999 FORMAT/ ' Execution not attempted due to input errors' )
320  9998 FORMAT/ ' End of tests' )
321  9997 FORMAT' Total time used = 'F12.2' seconds'/ )
322  9996 FORMAT' Invalid input value: ', A4, '=', I6, '; must be >=',
323      $      I6 )
324  9995 FORMAT' Invalid input value: ', A4, '=', I6, '; must be <=',
325      $      I6 )
326  9994 FORMAT' Tests of the DOUBLE PRECISION LAPACK DSGESV/DSPOSV'
327      $  ' routines ',
328      $      / ' LAPACK VERSION ', I1, '.', I1, '.', I1,
329      $      / / ' The following parameter values will be used:' )
330  9993 FORMAT4X, A4, ':  ', 10I6, / 11X, 10I6 )
331  9992 FORMAT/ ' Routines pass computational tests if test ratio is ',
332      $      'less than'F8.2/ )
333  9991 FORMAT' Relative machine ', A, ' is taken to be'D16.6 )
334  9990 FORMAT/ 1X, A6, ' routines were not tested' )
335  9989 FORMAT/ 1X, A6, ' driver routines were not tested' )
336  9988 FORMAT/ 1X, A3, ':  Unrecognized path name' )
337 *
338 *     End of DCHKAB
339 *
340       END