LAPACK  3.10.1
LAPACK: Linear Algebra PACKage
zchkab.f
Go to the documentation of this file.
1 *> \brief \b ZCHKAB
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 ZCHKAB
12 *
13 *
14 *> \par Purpose:
15 * =============
16 *>
17 *> \verbatim
18 *>
19 *> ZCHKAB is the test program for the COMPLEX*16 LAPACK
20 *> ZCGESV/ZCPOSV routine
21 *>
22 *> The program must be driven by a short data file. The first 5 records
23 *> specify problem dimensions and program options using list-directed
24 *> input. The remaining lines specify the LAPACK test paths and the
25 *> number of matrix types to use in testing. An annotated example of a
26 *> data file can be obtained by deleting the first 3 characters from the
27 *> following 9 lines:
28 *> Data file for testing COMPLEX*16 LAPACK ZCGESV
29 *> 7 Number of values of M
30 *> 0 1 2 3 5 10 16 Values of M (row dimension)
31 *> 1 Number of values of NRHS
32 *> 2 Values of NRHS (number of right hand sides)
33 *> 20.0 Threshold value of test ratio
34 *> T Put T to test the LAPACK routine
35 *> T Put T to test the error exits
36 *> DGE 11 List types on next line if 0 < NTYPES < 11
37 *> DPO 9 List types on next line if 0 < NTYPES < 9
38 *> \endverbatim
39 *
40 * Arguments:
41 * ==========
42 *
43 *> \verbatim
44 *> NMAX INTEGER
45 *> The maximum allowable value for N
46 *>
47 *> MAXIN INTEGER
48 *> The number of different values that can be used for each of
49 *> M, N, NRHS, NB, and NX
50 *>
51 *> MAXRHS INTEGER
52 *> The maximum number of right hand sides
53 *>
54 *> NIN INTEGER
55 *> The unit number for input
56 *>
57 *> NOUT INTEGER
58 *> The unit number for output
59 *> \endverbatim
60 *
61 * Authors:
62 * ========
63 *
64 *> \author Univ. of Tennessee
65 *> \author Univ. of California Berkeley
66 *> \author Univ. of Colorado Denver
67 *> \author NAG Ltd.
68 *
69 *> \ingroup complex16_lin
70 *
71 * =====================================================================
72  PROGRAM zchkab
73 *
74 * -- LAPACK test routine --
75 * -- LAPACK is a software package provided by Univ. of Tennessee, --
76 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
77 *
78 * =====================================================================
79 *
80 * .. Parameters ..
81  INTEGER nmax
82  parameter( nmax = 132 )
83  INTEGER maxin
84  parameter( maxin = 12 )
85  INTEGER maxrhs
86  parameter( maxrhs = 16 )
87  INTEGER matmax
88  parameter( matmax = 30 )
89  INTEGER nin, nout
90  parameter( nin = 5, nout = 6 )
91  INTEGER ldamax
92  parameter( ldamax = nmax )
93 * ..
94 * .. Local Scalars ..
95  LOGICAL fatal, tstdrv, tsterr
96  CHARACTER c1
97  CHARACTER*2 c2
98  CHARACTER*3 path
99  CHARACTER*10 intstr
100  CHARACTER*72 aline
101  INTEGER i, ic, k, lda, nm, nmats,
102  $ nns, nrhs, ntypes,
103  $ vers_major, vers_minor, vers_patch
104  DOUBLE PRECISION eps, s1, s2, thresh
105  REAL seps
106 * ..
107 * .. Local Arrays ..
108  LOGICAL dotype( matmax )
109  INTEGER iwork( nmax ), mval( maxin ), nsval( maxin )
110  DOUBLE PRECISION rwork(nmax)
111  COMPLEX*16 a( ldamax*nmax, 2 ), b( nmax*maxrhs, 2 ),
112  $ work( nmax*maxrhs*2 )
113  COMPLEX swork(nmax*(nmax+maxrhs))
114 * ..
115 * .. External Functions ..
116  DOUBLE PRECISION dlamch, dsecnd
117  LOGICAL lsame, lsamen
118  REAL slamch
119  EXTERNAL dlamch, dsecnd, lsame, lsamen, slamch
120 * ..
121 * .. External Subroutines ..
122  EXTERNAL alareq, zdrvab, zdrvac, zerrab, zerrac,
123  $ ilaver
124 * ..
125 * .. Scalars in Common ..
126  LOGICAL lerr, ok
127  CHARACTER*32 srnamt
128  INTEGER infot, nunit
129 * ..
130 * .. Common blocks ..
131  COMMON / infoc / infot, nunit, ok, lerr
132  COMMON / srnamc / srnamt
133 *
134 * .. Data statements ..
135  DATA intstr / '0123456789' /
136 * ..
137 * .. Executable Statements ..
138 *
139  s1 = dsecnd( )
140  lda = nmax
141  fatal = .false.
142 *
143 * Read a dummy line.
144 *
145  READ( nin, fmt = * )
146 *
147 * Report values of parameters.
148 *
149  CALL ilaver( vers_major, vers_minor, vers_patch )
150  WRITE( nout, fmt = 9994 ) vers_major, vers_minor, vers_patch
151 *
152 * Read the values of M
153 *
154  READ( nin, fmt = * )nm
155  IF( nm.LT.1 ) THEN
156  WRITE( nout, fmt = 9996 )' NM ', nm, 1
157  nm = 0
158  fatal = .true.
159  ELSE IF( nm.GT.maxin ) THEN
160  WRITE( nout, fmt = 9995 )' NM ', nm, maxin
161  nm = 0
162  fatal = .true.
163  END IF
164  READ( nin, fmt = * )( mval( i ), i = 1, nm )
165  DO 10 i = 1, nm
166  IF( mval( i ).LT.0 ) THEN
167  WRITE( nout, fmt = 9996 )' M ', mval( i ), 0
168  fatal = .true.
169  ELSE IF( mval( i ).GT.nmax ) THEN
170  WRITE( nout, fmt = 9995 )' M ', mval( i ), nmax
171  fatal = .true.
172  END IF
173  10 CONTINUE
174  IF( nm.GT.0 )
175  $ WRITE( nout, fmt = 9993 )'M ', ( mval( i ), i = 1, nm )
176 *
177 * Read the values of NRHS
178 *
179  READ( nin, fmt = * )nns
180  IF( nns.LT.1 ) THEN
181  WRITE( nout, fmt = 9996 )' NNS', nns, 1
182  nns = 0
183  fatal = .true.
184  ELSE IF( nns.GT.maxin ) THEN
185  WRITE( nout, fmt = 9995 )' NNS', nns, maxin
186  nns = 0
187  fatal = .true.
188  END IF
189  READ( nin, fmt = * )( nsval( i ), i = 1, nns )
190  DO 30 i = 1, nns
191  IF( nsval( i ).LT.0 ) THEN
192  WRITE( nout, fmt = 9996 )'NRHS', nsval( i ), 0
193  fatal = .true.
194  ELSE IF( nsval( i ).GT.maxrhs ) THEN
195  WRITE( nout, fmt = 9995 )'NRHS', nsval( i ), maxrhs
196  fatal = .true.
197  END IF
198  30 CONTINUE
199  IF( nns.GT.0 )
200  $ WRITE( nout, fmt = 9993 )'NRHS', ( nsval( i ), i = 1, nns )
201 *
202 * Read the threshold value for the test ratios.
203 *
204  READ( nin, fmt = * )thresh
205  WRITE( nout, fmt = 9992 )thresh
206 *
207 * Read the flag that indicates whether to test the driver routine.
208 *
209  READ( nin, fmt = * )tstdrv
210 *
211 * Read the flag that indicates whether to test the error exits.
212 *
213  READ( nin, fmt = * )tsterr
214 *
215  IF( fatal ) THEN
216  WRITE( nout, fmt = 9999 )
217  stop
218  END IF
219 *
220 * Calculate and print the machine dependent constants.
221 *
222  seps = slamch( 'Underflow threshold' )
223  WRITE( nout, fmt = 9991 )'(single precision) underflow', seps
224  seps = slamch( 'Overflow threshold' )
225  WRITE( nout, fmt = 9991 )'(single precision) overflow ', seps
226  seps = slamch( 'Epsilon' )
227  WRITE( nout, fmt = 9991 )'(single precision) precision', seps
228  WRITE( nout, fmt = * )
229 *
230  eps = dlamch( 'Underflow threshold' )
231  WRITE( nout, fmt = 9991 )'(double precision) underflow', eps
232  eps = dlamch( 'Overflow threshold' )
233  WRITE( nout, fmt = 9991 )'(double precision) overflow ', eps
234  eps = dlamch( 'Epsilon' )
235  WRITE( nout, fmt = 9991 )'(double precision) precision', eps
236  WRITE( nout, fmt = * )
237 *
238  80 CONTINUE
239 *
240 * Read a test path and the number of matrix types to use.
241 *
242  READ( nin, fmt = '(A72)', END = 140 )aline
243  path = aline( 1: 3 )
244  nmats = matmax
245  i = 3
246  90 CONTINUE
247  i = i + 1
248  IF( i.GT.72 ) THEN
249  nmats = matmax
250  GO TO 130
251  END IF
252  IF( aline( i: i ).EQ.' ' )
253  $ GO TO 90
254  nmats = 0
255  100 CONTINUE
256  c1 = aline( i: i )
257  DO 110 k = 1, 10
258  IF( c1.EQ.intstr( k: k ) ) THEN
259  ic = k - 1
260  GO TO 120
261  END IF
262  110 CONTINUE
263  GO TO 130
264  120 CONTINUE
265  nmats = nmats*10 + ic
266  i = i + 1
267  IF( i.GT.72 )
268  $ GO TO 130
269  GO TO 100
270  130 CONTINUE
271  c1 = path( 1: 1 )
272  c2 = path( 2: 3 )
273  nrhs = nsval( 1 )
274  nrhs = nsval( 1 )
275 *
276 * Check first character for correct precision.
277 *
278  IF( .NOT.lsame( c1, 'Zomplex precision' ) ) THEN
279  WRITE( nout, fmt = 9990 )path
280 *
281  ELSE IF( nmats.LE.0 ) THEN
282 *
283 * Check for a positive number of tests requested.
284 *
285  WRITE( nout, fmt = 9990 )'ZCGESV'
286  GO TO 140
287 *
288  ELSE IF( lsamen( 2, c2, 'GE' ) ) THEN
289 *
290 * GE: general matrices
291 *
292  ntypes = 11
293  CALL alareq( 'ZGE', nmats, dotype, ntypes, nin, nout )
294 *
295 * Test the error exits
296 *
297  IF( tsterr )
298  $ CALL zerrab( nout )
299 *
300  IF( tstdrv ) THEN
301  CALL zdrvab( dotype, nm, mval, nns,
302  $ nsval, thresh, lda, a( 1, 1 ),
303  $ a( 1, 2 ), b( 1, 1 ), b( 1, 2 ),
304  $ work, rwork, swork, iwork, nout )
305  ELSE
306  WRITE( nout, fmt = 9989 )'ZCGESV'
307  END IF
308 *
309  ELSE IF( lsamen( 2, c2, 'PO' ) ) THEN
310 *
311 * PO: positive definite matrices
312 *
313  ntypes = 9
314  CALL alareq( 'DPO', nmats, dotype, ntypes, nin, nout )
315 *
316  IF( tsterr )
317  $ CALL zerrac( nout )
318 *
319 *
320  IF( tstdrv ) THEN
321  CALL zdrvac( dotype, nm, mval, nns, nsval,
322  $ thresh, lda, a( 1, 1 ), a( 1, 2 ),
323  $ b( 1, 1 ), b( 1, 2 ),
324  $ work, rwork, swork, nout )
325  ELSE
326  WRITE( nout, fmt = 9989 )'ZCPOSV'
327  END IF
328 *
329  ELSE
330 *
331  END IF
332 *
333 * Go back to get another input line.
334 *
335  GO TO 80
336 *
337 * Branch to this line when the last record is read.
338 *
339  140 CONTINUE
340  CLOSE ( nin )
341  s2 = dsecnd( )
342  WRITE( nout, fmt = 9998 )
343  WRITE( nout, fmt = 9997 )s2 - s1
344 *
345  9999 FORMAT( / ' Execution not attempted due to input errors' )
346  9998 FORMAT( / ' End of tests' )
347  9997 FORMAT( ' Total time used = ', f12.2, ' seconds', / )
348  9996 FORMAT( ' Invalid input value: ', a4, '=', i6, '; must be >=',
349  $ i6 )
350  9995 FORMAT( ' Invalid input value: ', a4, '=', i6, '; must be <=',
351  $ i6 )
352  9994 FORMAT( ' Tests of the COMPLEX*16 LAPACK ZCGESV/ZCPOSV routines ',
353  $ / ' LAPACK VERSION ', i1, '.', i1, '.', i1,
354  $ / / ' The following parameter values will be used:' )
355  9993 FORMAT( 4x, a4, ': ', 10i6, / 11x, 10i6 )
356  9992 FORMAT( / ' Routines pass computational tests if test ratio is ',
357  $ 'less than', f8.2, / )
358  9991 FORMAT( ' Relative machine ', a, ' is taken to be', d16.6 )
359  9990 FORMAT( / 1x, a6, ' routines were not tested' )
360  9989 FORMAT( / 1x, a6, ' driver routines were not tested' )
361 *
362 * End of ZCHKAB
363 *
364  END
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:69
double precision function dsecnd()
DSECND Using ETIME
logical function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:74
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:53
subroutine alareq(PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT)
ALAREQ
Definition: alareq.f:90
subroutine zdrvac(DOTYPE, NM, MVAL, NNS, NSVAL, THRESH, NMAX, A, AFAC, B, X, WORK, RWORK, SWORK, NOUT)
ZDRVAC
Definition: zdrvac.f:145
subroutine zdrvab(DOTYPE, NM, MVAL, NNS, NSVAL, THRESH, NMAX, A, AFAC, B, X, WORK, RWORK, SWORK, IWORK, NOUT)
ZDRVAB
Definition: zdrvab.f:152
subroutine zerrac(NUNIT)
ZERRAC
Definition: zerrac.f:47
program zchkab
ZCHKAB
Definition: zchkab.f:72
subroutine zerrab(NUNIT)
ZERRAB
Definition: zerrab.f:47
subroutine ilaver(VERS_MAJOR, VERS_MINOR, VERS_PATCH)
ILAVER returns the LAPACK version.
Definition: ilaver.f:51
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:68