LAPACK  3.10.1
LAPACK: Linear Algebra PACKage
dchkab.f
Go to the documentation of this file.
1 *> \brief \b DCHKAB
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 DCHKAB
12 *
13 *
14 *> \par Purpose:
15 * =============
16 *>
17 *> \verbatim
18 *>
19 *> DCHKAB is the test program for the DOUBLE PRECISION LAPACK
20 *> DSGESV/DSPOSV 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 10 lines:
28 *> Data file for testing DOUBLE PRECISION LAPACK DSGESV
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 routines
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 double_lin
70 *
71 * =====================================================================
72  PROGRAM dchkab
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 a( ldamax*nmax, 2 ), b( nmax*maxrhs, 2 ),
111  $ rwork( nmax ), work( nmax*maxrhs*2 )
112  REAL swork(nmax*(nmax+maxrhs))
113 * ..
114 * .. External Functions ..
115  DOUBLE PRECISION dlamch, dsecnd
116  LOGICAL lsame, lsamen
117  REAL slamch
118  EXTERNAL lsame, lsamen, dlamch, dsecnd, slamch
119 * ..
120 * .. External Subroutines ..
121  EXTERNAL alareq, ddrvab, ddrvac, derrab, derrac,
122  $ ilaver
123 * ..
124 * .. Scalars in Common ..
125  LOGICAL lerr, ok
126  CHARACTER*32 srnamt
127  INTEGER infot, nunit
128 * ..
129 * .. Common blocks ..
130  COMMON / infoc / infot, nunit, ok, lerr
131  COMMON / srnamc / srnamt
132 * ..
133 * .. Data statements ..
134  DATA intstr / '0123456789' /
135 * ..
136 * .. Executable Statements ..
137 *
138  s1 = dsecnd( )
139  lda = nmax
140  fatal = .false.
141 *
142 * Read a dummy line.
143 *
144  READ( nin, fmt = * )
145 *
146 * Report values of parameters.
147 *
148  CALL ilaver( vers_major, vers_minor, vers_patch )
149  WRITE( nout, fmt = 9994 ) vers_major, vers_minor, vers_patch
150 *
151 * Read the values of M
152 *
153  READ( nin, fmt = * )nm
154  IF( nm.LT.1 ) THEN
155  WRITE( nout, fmt = 9996 )' NM ', nm, 1
156  nm = 0
157  fatal = .true.
158  ELSE IF( nm.GT.maxin ) THEN
159  WRITE( nout, fmt = 9995 )' NM ', nm, maxin
160  nm = 0
161  fatal = .true.
162  END IF
163  READ( nin, fmt = * )( mval( i ), i = 1, nm )
164  DO 10 i = 1, nm
165  IF( mval( i ).LT.0 ) THEN
166  WRITE( nout, fmt = 9996 )' M ', mval( i ), 0
167  fatal = .true.
168  ELSE IF( mval( i ).GT.nmax ) THEN
169  WRITE( nout, fmt = 9995 )' M ', mval( i ), nmax
170  fatal = .true.
171  END IF
172  10 CONTINUE
173  IF( nm.GT.0 )
174  $ WRITE( nout, fmt = 9993 )'M ', ( mval( i ), i = 1, nm )
175 *
176 * Read the values of NRHS
177 *
178  READ( nin, fmt = * )nns
179  IF( nns.LT.1 ) THEN
180  WRITE( nout, fmt = 9996 )' NNS', nns, 1
181  nns = 0
182  fatal = .true.
183  ELSE IF( nns.GT.maxin ) THEN
184  WRITE( nout, fmt = 9995 )' NNS', nns, maxin
185  nns = 0
186  fatal = .true.
187  END IF
188  READ( nin, fmt = * )( nsval( i ), i = 1, nns )
189  DO 30 i = 1, nns
190  IF( nsval( i ).LT.0 ) THEN
191  WRITE( nout, fmt = 9996 )'NRHS', nsval( i ), 0
192  fatal = .true.
193  ELSE IF( nsval( i ).GT.maxrhs ) THEN
194  WRITE( nout, fmt = 9995 )'NRHS', nsval( i ), maxrhs
195  fatal = .true.
196  END IF
197  30 CONTINUE
198  IF( nns.GT.0 )
199  $ WRITE( nout, fmt = 9993 )'NRHS', ( nsval( i ), i = 1, nns )
200 *
201 * Read the threshold value for the test ratios.
202 *
203  READ( nin, fmt = * )thresh
204  WRITE( nout, fmt = 9992 )thresh
205 *
206 * Read the flag that indicates whether to test the driver routine.
207 *
208  READ( nin, fmt = * )tstdrv
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 * Calculate and print the machine dependent constants.
220 *
221  seps = slamch( 'Underflow threshold' )
222  WRITE( nout, fmt = 9991 )'(single precision) underflow', seps
223  seps = slamch( 'Overflow threshold' )
224  WRITE( nout, fmt = 9991 )'(single precision) overflow ', seps
225  seps = slamch( 'Epsilon' )
226  WRITE( nout, fmt = 9991 )'(single precision) precision', seps
227  WRITE( nout, fmt = * )
228 *
229  eps = dlamch( 'Underflow threshold' )
230  WRITE( nout, fmt = 9991 )'(double precision) underflow', eps
231  eps = dlamch( 'Overflow threshold' )
232  WRITE( nout, fmt = 9991 )'(double precision) overflow ', eps
233  eps = dlamch( 'Epsilon' )
234  WRITE( nout, fmt = 9991 )'(double precision) precision', eps
235  WRITE( nout, fmt = * )
236 *
237  80 CONTINUE
238 *
239 * Read a test path and the number of matrix types to use.
240 *
241  READ( nin, fmt = '(A72)', END = 140 )aline
242  path = aline( 1: 3 )
243  nmats = matmax
244  i = 3
245  90 CONTINUE
246  i = i + 1
247  IF( i.GT.72 ) THEN
248  nmats = matmax
249  GO TO 130
250  END IF
251  IF( aline( i: i ).EQ.' ' )
252  $ GO TO 90
253  nmats = 0
254  100 CONTINUE
255  c1 = aline( i: i )
256  DO 110 k = 1, 10
257  IF( c1.EQ.intstr( k: k ) ) THEN
258  ic = k - 1
259  GO TO 120
260  END IF
261  110 CONTINUE
262  GO TO 130
263  120 CONTINUE
264  nmats = nmats*10 + ic
265  i = i + 1
266  IF( i.GT.72 )
267  $ GO TO 130
268  GO TO 100
269  130 CONTINUE
270  c1 = path( 1: 1 )
271  c2 = path( 2: 3 )
272  nrhs = nsval( 1 )
273 *
274 * Check first character for correct precision.
275 *
276  IF( .NOT.lsame( c1, 'Double precision' ) ) THEN
277  WRITE( nout, fmt = 9990 )path
278 
279 *
280  ELSE IF( nmats.LE.0 ) THEN
281 *
282 * Check for a positive number of tests requested.
283 *
284  WRITE( nout, fmt = 9989 )path
285  GO TO 140
286 *
287  ELSE IF( lsamen( 2, c2, 'GE' ) ) THEN
288 *
289 * GE: general matrices
290 *
291  ntypes = 11
292  CALL alareq( 'DGE', nmats, dotype, ntypes, nin, nout )
293 *
294 * Test the error exits
295 *
296  IF( tsterr )
297  $ CALL derrab( nout )
298 *
299  IF( tstdrv ) THEN
300  CALL ddrvab( dotype, nm, mval, nns,
301  $ nsval, thresh, lda, a( 1, 1 ),
302  $ a( 1, 2 ), b( 1, 1 ), b( 1, 2 ),
303  $ work, rwork, swork, iwork, nout )
304  ELSE
305  WRITE( nout, fmt = 9989 )'DSGESV'
306  END IF
307 *
308  ELSE IF( lsamen( 2, c2, 'PO' ) ) THEN
309 *
310 * PO: positive definite matrices
311 *
312  ntypes = 9
313  CALL alareq( 'DPO', nmats, dotype, ntypes, nin, nout )
314 *
315 *
316  IF( tsterr )
317  $ CALL derrac( nout )
318 *
319 *
320  IF( tstdrv ) THEN
321  CALL ddrvac( 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 )path
327  END IF
328  ELSE
329 *
330  END IF
331 *
332 * Go back to get another input line.
333 *
334  GO TO 80
335 *
336 * Branch to this line when the last record is read.
337 *
338  140 CONTINUE
339  CLOSE ( nin )
340  s2 = dsecnd( )
341  WRITE( nout, fmt = 9998 )
342  WRITE( nout, fmt = 9997 )s2 - s1
343 *
344  9999 FORMAT( / ' Execution not attempted due to input errors' )
345  9998 FORMAT( / ' End of tests' )
346  9997 FORMAT( ' Total time used = ', f12.2, ' seconds', / )
347  9996 FORMAT( ' Invalid input value: ', a4, '=', i6, '; must be >=',
348  $ i6 )
349  9995 FORMAT( ' Invalid input value: ', a4, '=', i6, '; must be <=',
350  $ i6 )
351  9994 FORMAT( ' Tests of the DOUBLE PRECISION LAPACK DSGESV/DSPOSV',
352  $ ' 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 DCHKAB
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
program dchkab
DCHKAB
Definition: dchkab.f:72
subroutine derrac(NUNIT)
DERRAC
Definition: derrac.f:47
subroutine ddrvac(DOTYPE, NM, MVAL, NNS, NSVAL, THRESH, NMAX, A, AFAC, B, X, WORK, RWORK, SWORK, NOUT)
DDRVAC
Definition: ddrvac.f:144
subroutine derrab(NUNIT)
DERRAB
Definition: derrab.f:47
subroutine ddrvab(DOTYPE, NM, MVAL, NNS, NSVAL, THRESH, NMAX, A, AFAC, B, X, WORK, RWORK, SWORK, IWORK, NOUT)
DDRVAB
Definition: ddrvab.f:151
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