1       PROGRAM ZCHKAB
  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 *  ZCHKAB is the test program for the COMPLEX*16 LAPACK
 15 *  ZCGESV/ZCPOSV 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 9 lines:
 23 *  Data file for testing COMPLEX*16 LAPACK ZCGESV
 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 routine
 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   RWORK(NMAX)
 86       COMPLEX*16         A( LDAMAX*NMAX, 2 ), B( NMAX*MAXRHS, 2 ),
 87      $                   WORK( NMAX*MAXRHS*2 )
 88       COMPLEX            SWORK(NMAX*(NMAX+MAXRHS))
 89 *     ..
 90 *     .. External Functions ..
 91       DOUBLE PRECISION   DLAMCH, DSECND
 92       LOGICAL            LSAME, LSAMEN
 93       REAL               SLAMCH
 94       EXTERNAL           DLAMCH, DSECND, LSAME, LSAMEN, SLAMCH
 95 *     ..
 96 *     .. External Subroutines ..
 97       EXTERNAL           ALAREQ, ZDRVAB, ZDRVAC, ZERRAB, ZERRAC,
 98      $                   ILAVER
 99 *     ..
100 *     .. Scalars in Common ..
101       LOGICAL            LERR, OK
102       CHARACTER*32       SRNAMT
103       INTEGER            INFOT, NUNIT
104 *     ..
105 *     .. Common blocks ..
106       COMMON             / INFOC / INFOT, NUNIT, OK, LERR
107       COMMON             / SRNAMC / SRNAMT
108 *
109 *     .. Data statements ..
110       DATA               INTSTR / '0123456789' /
111 *     ..
112 *     .. Executable Statements ..
113 *
114       S1 = DSECND( )
115       LDA = NMAX
116       FATAL = .FALSE.
117 *
118 *     Read a dummy line.
119 *
120       READ( NIN, FMT = * )
121 *
122 *     Report values of parameters.
123 *
124       CALL ILAVER( VERS_MAJOR, VERS_MINOR, VERS_PATCH )
125       WRITE( NOUT, FMT = 9994 ) VERS_MAJOR, VERS_MINOR, VERS_PATCH
126 *
127 *     Read the values of M
128 *
129       READ( NIN, FMT = * )NM
130       IF( NM.LT.1 ) THEN
131          WRITE( NOUT, FMT = 9996 )' NM ', NM, 1
132          NM = 0
133          FATAL = .TRUE.
134       ELSE IF( NM.GT.MAXIN ) THEN
135          WRITE( NOUT, FMT = 9995 )' NM ', NM, MAXIN
136          NM = 0
137          FATAL = .TRUE.
138       END IF
139       READ( NIN, FMT = * )( MVAL( I ), I = 1, NM )
140       DO 10 I = 1, NM
141          IF( MVAL( I ).LT.0 ) THEN
142             WRITE( NOUT, FMT = 9996 )' M  ', MVAL( I ), 0
143             FATAL = .TRUE.
144          ELSE IF( MVAL( I ).GT.NMAX ) THEN
145             WRITE( NOUT, FMT = 9995 )' M  ', MVAL( I ), NMAX
146             FATAL = .TRUE.
147          END IF
148    10 CONTINUE
149       IF( NM.GT.0 )
150      $   WRITE( NOUT, FMT = 9993 )'M   ', ( MVAL( I ), I = 1, NM )
151 *
152 *     Read the values of NRHS
153 *
154       READ( NIN, FMT = * )NNS
155       IF( NNS.LT.1 ) THEN
156          WRITE( NOUT, FMT = 9996 )' NNS', NNS, 1
157          NNS = 0
158          FATAL = .TRUE.
159       ELSE IF( NNS.GT.MAXIN ) THEN
160          WRITE( NOUT, FMT = 9995 )' NNS', NNS, MAXIN
161          NNS = 0
162          FATAL = .TRUE.
163       END IF
164       READ( NIN, FMT = * )( NSVAL( I ), I = 1, NNS )
165       DO 30 I = 1, NNS
166          IF( NSVAL( I ).LT.0 ) THEN
167             WRITE( NOUT, FMT = 9996 )'NRHS', NSVAL( I ), 0
168             FATAL = .TRUE.
169          ELSE IF( NSVAL( I ).GT.MAXRHS ) THEN
170             WRITE( NOUT, FMT = 9995 )'NRHS', NSVAL( I ), MAXRHS
171             FATAL = .TRUE.
172          END IF
173    30 CONTINUE
174       IF( NNS.GT.0 )
175      $   WRITE( NOUT, FMT = 9993 )'NRHS', ( NSVAL( I ), I = 1, NNS )
176 *
177 *     Read the threshold value for the test ratios.
178 *
179       READ( NIN, FMT = * )THRESH
180       WRITE( NOUT, FMT = 9992 )THRESH
181 *
182 *     Read the flag that indicates whether to test the driver routine.
183 *
184       READ( NIN, FMT = * )TSTDRV
185 *
186 *     Read the flag that indicates whether to test the error exits.
187 *
188       READ( NIN, FMT = * )TSTERR
189 *
190       IF( FATAL ) THEN
191          WRITE( NOUT, FMT = 9999 )
192          STOP
193       END IF
194 *
195 *     Calculate and print the machine dependent constants.
196 *
197       SEPS = SLAMCH( 'Underflow threshold' )
198       WRITE( NOUT, FMT = 9991 )'(single precision) underflow', SEPS
199       SEPS = SLAMCH( 'Overflow threshold' )
200       WRITE( NOUT, FMT = 9991 )'(single precision) overflow ', SEPS
201       SEPS = SLAMCH( 'Epsilon' )
202       WRITE( NOUT, FMT = 9991 )'(single precision) precision', SEPS
203       WRITE( NOUT, FMT = * )
204 *
205       EPS = DLAMCH( 'Underflow threshold' )
206       WRITE( NOUT, FMT = 9991 )'(double precision) underflow', EPS
207       EPS = DLAMCH( 'Overflow threshold' )
208       WRITE( NOUT, FMT = 9991 )'(double precision) overflow ', EPS
209       EPS = DLAMCH( 'Epsilon' )
210       WRITE( NOUT, FMT = 9991 )'(double precision) precision', EPS
211       WRITE( NOUT, FMT = * )
212 *
213    80 CONTINUE
214 *
215 *     Read a test path and the number of matrix types to use.
216 *
217       READ( NIN, FMT = '(A72)'END = 140 )ALINE
218       PATH = ALINE( 13 )
219       NMATS = MATMAX
220       I = 3
221    90 CONTINUE
222       I = I + 1
223       IF( I.GT.72 ) THEN
224          NMATS = MATMAX
225          GO TO 130
226       END IF
227       IF( ALINE( I: I ).EQ.' ' )
228      $   GO TO 90
229       NMATS = 0
230   100 CONTINUE
231       C1 = ALINE( I: I )
232       DO 110 K = 110
233          IF( C1.EQ.INTSTR( K: K ) ) THEN
234             IC = K - 1
235             GO TO 120
236          END IF
237   110 CONTINUE
238       GO TO 130
239   120 CONTINUE
240       NMATS = NMATS*10 + IC
241       I = I + 1
242       IF( I.GT.72 )
243      $   GO TO 130
244       GO TO 100
245   130 CONTINUE
246       C1 = PATH( 11 )
247       C2 = PATH( 23 )
248       NRHS = NSVAL( 1 )
249       NRHS = NSVAL( 1 )
250 *
251 *     Check first character for correct precision.
252 *
253       IF.NOT.LSAME( C1, 'Zomplex precision' ) ) THEN
254             WRITE( NOUT, FMT = 9990 )PATH
255 *
256       ELSE IF( NMATS.LE.0 ) THEN
257 *
258 *        Check for a positive number of tests requested.
259 *
260          WRITE( NOUT, FMT = 9990 )'ZCGESV'
261          GO TO 140
262 *
263       ELSE IF( LSAMEN( 2, C2, 'GE' ) ) THEN
264 *
265 *        GE:  general matrices
266 *
267       NTYPES = 11
268       CALL ALAREQ( 'ZGE', NMATS, DOTYPE, NTYPES, NIN, NOUT )
269 *
270 *        Test the error exits
271 *
272          IF( TSTERR )
273      $     CALL ZERRAB( NOUT )
274 *
275          IF( TSTDRV ) THEN
276             CALL ZDRVAB( DOTYPE, NM, MVAL, NNS,
277      $                   NSVAL, THRESH, LDA, A( 11 ),
278      $                   A( 12 ), B( 11 ), B( 12 ),
279      $                   WORK, RWORK, SWORK, IWORK, NOUT )
280          ELSE
281             WRITE( NOUT, FMT = 9989 )'ZCGESV'
282          END IF
283 *
284       ELSE IF( LSAMEN( 2, C2, 'PO' ) ) THEN
285 *
286 *        PO:  positive definite matrices
287 *
288          NTYPES = 9
289          CALL ALAREQ( 'DPO', NMATS, DOTYPE, NTYPES, NIN, NOUT )
290 *
291          IF( TSTERR )
292      $      CALL ZERRAC( NOUT )
293 *
294 *
295          IF( TSTDRV ) THEN
296             CALL ZDRVAC( 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 )'ZCPOSV'
302          END IF
303 *
304       ELSE
305 *
306       END IF
307 *
308 *     Go back to get another input line.
309 *
310       GO TO 80
311 *
312 *     Branch to this line when the last record is read.
313 *
314   140 CONTINUE
315       CLOSE ( NIN )
316       S2 = DSECND( )
317       WRITE( NOUT, FMT = 9998 )
318       WRITE( NOUT, FMT = 9997 )S2 - S1
319 *
320  9999 FORMAT/ ' Execution not attempted due to input errors' )
321  9998 FORMAT/ ' End of tests' )
322  9997 FORMAT' Total time used = 'F12.2' seconds'/ )
323  9996 FORMAT' Invalid input value: ', A4, '=', I6, '; must be >=',
324      $      I6 )
325  9995 FORMAT' Invalid input value: ', A4, '=', I6, '; must be <=',
326      $      I6 )
327  9994 FORMAT' Tests of the COMPLEX*16 LAPACK ZCGESV/ZCPOSV 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 ZCHKAB
339 *
340       END