LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
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 *> \date April 2012
70 *
71 *> \ingroup complex16_lin
72 *
73 * =====================================================================
74  PROGRAM zchkab
75 *
76 * -- LAPACK test routine (version 3.4.1) --
77 * -- LAPACK is a software package provided by Univ. of Tennessee, --
78 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
79 * April 2012
80 *
81 * =====================================================================
82 *
83 * .. Parameters ..
84  INTEGER nmax
85  parameter( nmax = 132 )
86  INTEGER maxin
87  parameter( maxin = 12 )
88  INTEGER maxrhs
89  parameter( maxrhs = 16 )
90  INTEGER matmax
91  parameter( matmax = 30 )
92  INTEGER nin, nout
93  parameter( nin = 5, nout = 6 )
94  INTEGER ldamax
95  parameter( ldamax = nmax )
96 * ..
97 * .. Local Scalars ..
98  LOGICAL fatal, tstdrv, tsterr
99  CHARACTER c1
100  CHARACTER*2 c2
101  CHARACTER*3 path
102  CHARACTER*10 intstr
103  CHARACTER*72 aline
104  INTEGER i, ic, k, lda, nm, nmats,
105  $ nns, nrhs, ntypes,
106  $ vers_major, vers_minor, vers_patch
107  DOUBLE PRECISION eps, s1, s2, thresh
108  REAL seps
109 * ..
110 * .. Local Arrays ..
111  LOGICAL dotype( matmax )
112  INTEGER iwork( nmax ), mval( maxin ), nsval( maxin )
113  DOUBLE PRECISION rwork(nmax)
114  COMPLEX*16 a( ldamax*nmax, 2 ), b( nmax*maxrhs, 2 ),
115  $ work( nmax*maxrhs*2 )
116  COMPLEX swork(nmax*(nmax+maxrhs))
117 * ..
118 * .. External Functions ..
119  DOUBLE PRECISION dlamch, dsecnd
120  LOGICAL lsame, lsamen
121  REAL slamch
122  EXTERNAL dlamch, dsecnd, lsame, lsamen, slamch
123 * ..
124 * .. External Subroutines ..
125  EXTERNAL alareq, zdrvab, zdrvac, zerrab, zerrac,
126  $ ilaver
127 * ..
128 * .. Scalars in Common ..
129  LOGICAL lerr, ok
130  CHARACTER*32 srnamt
131  INTEGER infot, nunit
132 * ..
133 * .. Common blocks ..
134  common / infoc / infot, nunit, ok, lerr
135  common / srnamc / srnamt
136 *
137 * .. Data statements ..
138  DATA intstr / '0123456789' /
139 * ..
140 * .. Executable Statements ..
141 *
142  s1 = dsecnd( )
143  lda = nmax
144  fatal = .false.
145 *
146 * Read a dummy line.
147 *
148  READ( nin, fmt = * )
149 *
150 * Report values of parameters.
151 *
152  CALL ilaver( vers_major, vers_minor, vers_patch )
153  WRITE( nout, fmt = 9994 ) vers_major, vers_minor, vers_patch
154 *
155 * Read the values of M
156 *
157  READ( nin, fmt = * )nm
158  IF( nm.LT.1 ) THEN
159  WRITE( nout, fmt = 9996 )' NM ', nm, 1
160  nm = 0
161  fatal = .true.
162  ELSE IF( nm.GT.maxin ) THEN
163  WRITE( nout, fmt = 9995 )' NM ', nm, maxin
164  nm = 0
165  fatal = .true.
166  END IF
167  READ( nin, fmt = * )( mval( i ), i = 1, nm )
168  DO 10 i = 1, nm
169  IF( mval( i ).LT.0 ) THEN
170  WRITE( nout, fmt = 9996 )' M ', mval( i ), 0
171  fatal = .true.
172  ELSE IF( mval( i ).GT.nmax ) THEN
173  WRITE( nout, fmt = 9995 )' M ', mval( i ), nmax
174  fatal = .true.
175  END IF
176  10 continue
177  IF( nm.GT.0 )
178  $ WRITE( nout, fmt = 9993 )'M ', ( mval( i ), i = 1, nm )
179 *
180 * Read the values of NRHS
181 *
182  READ( nin, fmt = * )nns
183  IF( nns.LT.1 ) THEN
184  WRITE( nout, fmt = 9996 )' NNS', nns, 1
185  nns = 0
186  fatal = .true.
187  ELSE IF( nns.GT.maxin ) THEN
188  WRITE( nout, fmt = 9995 )' NNS', nns, maxin
189  nns = 0
190  fatal = .true.
191  END IF
192  READ( nin, fmt = * )( nsval( i ), i = 1, nns )
193  DO 30 i = 1, nns
194  IF( nsval( i ).LT.0 ) THEN
195  WRITE( nout, fmt = 9996 )'NRHS', nsval( i ), 0
196  fatal = .true.
197  ELSE IF( nsval( i ).GT.maxrhs ) THEN
198  WRITE( nout, fmt = 9995 )'NRHS', nsval( i ), maxrhs
199  fatal = .true.
200  END IF
201  30 continue
202  IF( nns.GT.0 )
203  $ WRITE( nout, fmt = 9993 )'NRHS', ( nsval( i ), i = 1, nns )
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 driver routine.
211 *
212  READ( nin, fmt = * )tstdrv
213 *
214 * Read the flag that indicates whether to test the error exits.
215 *
216  READ( nin, fmt = * )tsterr
217 *
218  IF( fatal ) THEN
219  WRITE( nout, fmt = 9999 )
220  stop
221  END IF
222 *
223 * Calculate and print the machine dependent constants.
224 *
225  seps = slamch( 'Underflow threshold' )
226  WRITE( nout, fmt = 9991 )'(single precision) underflow', seps
227  seps = slamch( 'Overflow threshold' )
228  WRITE( nout, fmt = 9991 )'(single precision) overflow ', seps
229  seps = slamch( 'Epsilon' )
230  WRITE( nout, fmt = 9991 )'(single precision) precision', seps
231  WRITE( nout, fmt = * )
232 *
233  eps = dlamch( 'Underflow threshold' )
234  WRITE( nout, fmt = 9991 )'(double precision) underflow', eps
235  eps = dlamch( 'Overflow threshold' )
236  WRITE( nout, fmt = 9991 )'(double precision) overflow ', eps
237  eps = dlamch( 'Epsilon' )
238  WRITE( nout, fmt = 9991 )'(double precision) precision', eps
239  WRITE( nout, fmt = * )
240 *
241  80 continue
242 *
243 * Read a test path and the number of matrix types to use.
244 *
245  READ( nin, fmt = '(A72)', END = 140 )aline
246  path = aline( 1: 3 )
247  nmats = matmax
248  i = 3
249  90 continue
250  i = i + 1
251  IF( i.GT.72 ) THEN
252  nmats = matmax
253  go to 130
254  END IF
255  IF( aline( i: i ).EQ.' ' )
256  $ go to 90
257  nmats = 0
258  100 continue
259  c1 = aline( i: i )
260  DO 110 k = 1, 10
261  IF( c1.EQ.intstr( k: k ) ) THEN
262  ic = k - 1
263  go to 120
264  END IF
265  110 continue
266  go to 130
267  120 continue
268  nmats = nmats*10 + ic
269  i = i + 1
270  IF( i.GT.72 )
271  $ go to 130
272  go to 100
273  130 continue
274  c1 = path( 1: 1 )
275  c2 = path( 2: 3 )
276  nrhs = nsval( 1 )
277  nrhs = nsval( 1 )
278 *
279 * Check first character for correct precision.
280 *
281  IF( .NOT.lsame( c1, 'Zomplex precision' ) ) THEN
282  WRITE( nout, fmt = 9990 )path
283 *
284  ELSE IF( nmats.LE.0 ) THEN
285 *
286 * Check for a positive number of tests requested.
287 *
288  WRITE( nout, fmt = 9990 )'ZCGESV'
289  go to 140
290 *
291  ELSE IF( lsamen( 2, c2, 'GE' ) ) THEN
292 *
293 * GE: general matrices
294 *
295  ntypes = 11
296  CALL alareq( 'ZGE', nmats, dotype, ntypes, nin, nout )
297 *
298 * Test the error exits
299 *
300  IF( tsterr )
301  $ CALL zerrab( nout )
302 *
303  IF( tstdrv ) THEN
304  CALL zdrvab( dotype, nm, mval, nns,
305  $ nsval, thresh, lda, a( 1, 1 ),
306  $ a( 1, 2 ), b( 1, 1 ), b( 1, 2 ),
307  $ work, rwork, swork, iwork, nout )
308  ELSE
309  WRITE( nout, fmt = 9989 )'ZCGESV'
310  END IF
311 *
312  ELSE IF( lsamen( 2, c2, 'PO' ) ) THEN
313 *
314 * PO: positive definite matrices
315 *
316  ntypes = 9
317  CALL alareq( 'DPO', nmats, dotype, ntypes, nin, nout )
318 *
319  IF( tsterr )
320  $ CALL zerrac( nout )
321 *
322 *
323  IF( tstdrv ) THEN
324  CALL zdrvac( dotype, nm, mval, nns, nsval,
325  $ thresh, lda, a( 1, 1 ), a( 1, 2 ),
326  $ b( 1, 1 ), b( 1, 2 ),
327  $ work, rwork, swork, nout )
328  ELSE
329  WRITE( nout, fmt = 9989 )'ZCPOSV'
330  END IF
331 *
332  ELSE
333 *
334  END IF
335 *
336 * Go back to get another input line.
337 *
338  go to 80
339 *
340 * Branch to this line when the last record is read.
341 *
342  140 continue
343  CLOSE ( nin )
344  s2 = dsecnd( )
345  WRITE( nout, fmt = 9998 )
346  WRITE( nout, fmt = 9997 )s2 - s1
347 *
348  9999 format( / ' Execution not attempted due to input errors' )
349  9998 format( / ' End of tests' )
350  9997 format( ' Total time used = ', f12.2, ' seconds', / )
351  9996 format( ' Invalid input value: ', a4, '=', i6, '; must be >=',
352  $ i6 )
353  9995 format( ' Invalid input value: ', a4, '=', i6, '; must be <=',
354  $ i6 )
355  9994 format( ' Tests of the COMPLEX*16 LAPACK ZCGESV/ZCPOSV routines ',
356  $ / ' LAPACK VERSION ', i1, '.', i1, '.', i1,
357  $ / / ' The following parameter values will be used:' )
358  9993 format( 4x, a4, ': ', 10i6, / 11x, 10i6 )
359  9992 format( / ' Routines pass computational tests if test ratio is ',
360  $ 'less than', f8.2, / )
361  9991 format( ' Relative machine ', a, ' is taken to be', d16.6 )
362  9990 format( / 1x, a6, ' routines were not tested' )
363  9989 format( / 1x, a6, ' driver routines were not tested' )
364 *
365 * End of ZCHKAB
366 *
367  END