LAPACK  3.8.0
LAPACK: Linear Algebra PACKage
dchkrfp.f
Go to the documentation of this file.
1 *> \brief \b DCHKRFP
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 DCHKRFP
12 *
13 *
14 *> \par Purpose:
15 * =============
16 *>
17 *> \verbatim
18 *>
19 *> DCHKRFP is the main test program for the DOUBLE PRECISION linear
20 *> equation routines with RFP storage format
21 *>
22 *> \endverbatim
23 *
24 * Arguments:
25 * ==========
26 *
27 *> \verbatim
28 *> MAXIN INTEGER
29 *> The number of different values that can be used for each of
30 *> M, N, or NB
31 *>
32 *> MAXRHS INTEGER
33 *> The maximum number of right hand sides
34 *>
35 *> NTYPES INTEGER
36 *>
37 *> NMAX INTEGER
38 *> The maximum allowable value for N.
39 *>
40 *> NIN INTEGER
41 *> The unit number for input
42 *>
43 *> NOUT INTEGER
44 *> The unit number for output
45 *> \endverbatim
46 *
47 * Authors:
48 * ========
49 *
50 *> \author Univ. of Tennessee
51 *> \author Univ. of California Berkeley
52 *> \author Univ. of Colorado Denver
53 *> \author NAG Ltd.
54 *
55 *> \date April 2012
56 *
57 *> \ingroup double_lin
58 *
59 * =====================================================================
60  PROGRAM dchkrfp
61 *
62 * -- LAPACK test routine (version 3.7.1) --
63 * -- LAPACK is a software package provided by Univ. of Tennessee, --
64 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
65 * April 2012
66 *
67 * =====================================================================
68 *
69 * .. Parameters ..
70  INTEGER MAXIN
71  parameter( maxin = 12 )
72  INTEGER NMAX
73  parameter( nmax = 50 )
74  INTEGER MAXRHS
75  parameter( maxrhs = 16 )
76  INTEGER NTYPES
77  parameter( ntypes = 9 )
78  INTEGER NIN, NOUT
79  parameter( nin = 5, nout = 6 )
80 * ..
81 * .. Local Scalars ..
82  LOGICAL FATAL, TSTERR
83  INTEGER VERS_MAJOR, VERS_MINOR, VERS_PATCH
84  INTEGER I, NN, NNS, NNT
85  DOUBLE PRECISION EPS, S1, S2, THRESH
86 
87 * ..
88 * .. Local Arrays ..
89  INTEGER NVAL( maxin ), NSVAL( maxin ), NTVAL( ntypes )
90  DOUBLE PRECISION WORKA( nmax, nmax )
91  DOUBLE PRECISION WORKASAV( nmax, nmax )
92  DOUBLE PRECISION WORKB( nmax, maxrhs )
93  DOUBLE PRECISION WORKXACT( nmax, maxrhs )
94  DOUBLE PRECISION WORKBSAV( nmax, maxrhs )
95  DOUBLE PRECISION WORKX( nmax, maxrhs )
96  DOUBLE PRECISION WORKAFAC( nmax, nmax )
97  DOUBLE PRECISION WORKAINV( nmax, nmax )
98  DOUBLE PRECISION WORKARF( (nmax*(nmax+1))/2 )
99  DOUBLE PRECISION WORKAP( (nmax*(nmax+1))/2 )
100  DOUBLE PRECISION WORKARFINV( (nmax*(nmax+1))/2 )
101  DOUBLE PRECISION D_WORK_DLATMS( 3 * nmax )
102  DOUBLE PRECISION D_WORK_DPOT01( nmax )
103  DOUBLE PRECISION D_TEMP_DPOT02( nmax, maxrhs )
104  DOUBLE PRECISION D_TEMP_DPOT03( nmax, nmax )
105  DOUBLE PRECISION D_WORK_DLANSY( nmax )
106  DOUBLE PRECISION D_WORK_DPOT02( nmax )
107  DOUBLE PRECISION D_WORK_DPOT03( nmax )
108 * ..
109 * .. External Functions ..
110  DOUBLE PRECISION DLAMCH, DSECND
111  EXTERNAL dlamch, dsecnd
112 * ..
113 * .. External Subroutines ..
114  EXTERNAL ilaver, ddrvrfp, ddrvrf1, ddrvrf2, ddrvrf3,
115  + ddrvrf4
116 * ..
117 * .. Executable Statements ..
118 *
119  s1 = dsecnd( )
120  fatal = .false.
121 *
122 * Read a dummy line.
123 *
124  READ( nin, fmt = * )
125 *
126 * Report LAPACK version tag (e.g. LAPACK-3.2.0)
127 *
128  CALL ilaver( vers_major, vers_minor, vers_patch )
129  WRITE( nout, fmt = 9994 ) vers_major, vers_minor, vers_patch
130 *
131 * Read the values of N
132 *
133  READ( nin, fmt = * )nn
134  IF( nn.LT.1 ) THEN
135  WRITE( nout, fmt = 9996 )' NN ', nn, 1
136  nn = 0
137  fatal = .true.
138  ELSE IF( nn.GT.maxin ) THEN
139  WRITE( nout, fmt = 9995 )' NN ', nn, maxin
140  nn = 0
141  fatal = .true.
142  END IF
143  READ( nin, fmt = * )( nval( i ), i = 1, nn )
144  DO 10 i = 1, nn
145  IF( nval( i ).LT.0 ) THEN
146  WRITE( nout, fmt = 9996 )' M ', nval( i ), 0
147  fatal = .true.
148  ELSE IF( nval( i ).GT.nmax ) THEN
149  WRITE( nout, fmt = 9995 )' M ', nval( i ), nmax
150  fatal = .true.
151  END IF
152  10 CONTINUE
153  IF( nn.GT.0 )
154  $ WRITE( nout, fmt = 9993 )'N ', ( nval( i ), i = 1, nn )
155 *
156 * Read the values of NRHS
157 *
158  READ( nin, fmt = * )nns
159  IF( nns.LT.1 ) THEN
160  WRITE( nout, fmt = 9996 )' NNS', nns, 1
161  nns = 0
162  fatal = .true.
163  ELSE IF( nns.GT.maxin ) THEN
164  WRITE( nout, fmt = 9995 )' NNS', nns, maxin
165  nns = 0
166  fatal = .true.
167  END IF
168  READ( nin, fmt = * )( nsval( i ), i = 1, nns )
169  DO 30 i = 1, nns
170  IF( nsval( i ).LT.0 ) THEN
171  WRITE( nout, fmt = 9996 )'NRHS', nsval( i ), 0
172  fatal = .true.
173  ELSE IF( nsval( i ).GT.maxrhs ) THEN
174  WRITE( nout, fmt = 9995 )'NRHS', nsval( i ), maxrhs
175  fatal = .true.
176  END IF
177  30 CONTINUE
178  IF( nns.GT.0 )
179  $ WRITE( nout, fmt = 9993 )'NRHS', ( nsval( i ), i = 1, nns )
180 *
181 * Read the matrix types
182 *
183  READ( nin, fmt = * )nnt
184  IF( nnt.LT.1 ) THEN
185  WRITE( nout, fmt = 9996 )' NMA', nnt, 1
186  nnt = 0
187  fatal = .true.
188  ELSE IF( nnt.GT.ntypes ) THEN
189  WRITE( nout, fmt = 9995 )' NMA', nnt, ntypes
190  nnt = 0
191  fatal = .true.
192  END IF
193  READ( nin, fmt = * )( ntval( i ), i = 1, nnt )
194  DO 320 i = 1, nnt
195  IF( ntval( i ).LT.0 ) THEN
196  WRITE( nout, fmt = 9996 )'TYPE', ntval( i ), 0
197  fatal = .true.
198  ELSE IF( ntval( i ).GT.ntypes ) THEN
199  WRITE( nout, fmt = 9995 )'TYPE', ntval( i ), ntypes
200  fatal = .true.
201  END IF
202  320 CONTINUE
203  IF( nnt.GT.0 )
204  $ WRITE( nout, fmt = 9993 )'TYPE', ( ntval( i ), i = 1, nnt )
205 *
206 * Read the threshold value for the test ratios.
207 *
208  READ( nin, fmt = * )thresh
209  WRITE( nout, fmt = 9992 )thresh
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  eps = dlamch( 'Underflow threshold' )
223  WRITE( nout, fmt = 9991 )'underflow', eps
224  eps = dlamch( 'Overflow threshold' )
225  WRITE( nout, fmt = 9991 )'overflow ', eps
226  eps = dlamch( 'Epsilon' )
227  WRITE( nout, fmt = 9991 )'precision', eps
228  WRITE( nout, fmt = * )
229 *
230 * Test the error exit of:
231 *
232  IF( tsterr )
233  $ CALL derrrfp( nout )
234 *
235 * Test the routines: dpftrf, dpftri, dpftrs (as in DDRVPO).
236 * This also tests the routines: dtfsm, dtftri, dtfttr, dtrttf.
237 *
238  CALL ddrvrfp( nout, nn, nval, nns, nsval, nnt, ntval, thresh,
239  $ worka, workasav, workafac, workainv, workb,
240  $ workbsav, workxact, workx, workarf, workarfinv,
241  $ d_work_dlatms, d_work_dpot01, d_temp_dpot02,
242  $ d_temp_dpot03, d_work_dlansy, d_work_dpot02,
243  $ d_work_dpot03 )
244 *
245 * Test the routine: dlansf
246 *
247  CALL ddrvrf1( nout, nn, nval, thresh, worka, nmax, workarf,
248  + d_work_dlansy )
249 *
250 * Test the conversion routines:
251 * dtfttp, dtpttf, dtfttr, dtrttf, dtrttp and dtpttr.
252 *
253  CALL ddrvrf2( nout, nn, nval, worka, nmax, workarf,
254  + workap, workasav )
255 *
256 * Test the routine: dtfsm
257 *
258  CALL ddrvrf3( nout, nn, nval, thresh, worka, nmax, workarf,
259  + workainv, workafac, d_work_dlansy,
260  + d_work_dpot03, d_work_dpot01 )
261 *
262 *
263 * Test the routine: dsfrk
264 *
265  CALL ddrvrf4( nout, nn, nval, thresh, worka, workafac, nmax,
266  + workarf, workainv, nmax, d_work_dlansy)
267 *
268  CLOSE ( nin )
269  s2 = dsecnd( )
270  WRITE( nout, fmt = 9998 )
271  WRITE( nout, fmt = 9997 )s2 - s1
272 *
273  9999 FORMAT( / ' Execution not attempted due to input errors' )
274  9998 FORMAT( / ' End of tests' )
275  9997 FORMAT( ' Total time used = ', f12.2, ' seconds', / )
276  9996 FORMAT( ' !! Invalid input value: ', a4, '=', i6, '; must be >=',
277  $ i6 )
278  9995 FORMAT( ' !! Invalid input value: ', a4, '=', i6, '; must be <=',
279  $ i6 )
280  9994 FORMAT( / ' Tests of the DOUBLE PRECISION LAPACK RFP routines ',
281  $ / ' LAPACK VERSION ', i1, '.', i1, '.', i1,
282  $ / / ' The following parameter values will be used:' )
283  9993 FORMAT( 4x, a4, ': ', 10i6, / 11x, 10i6 )
284  9992 FORMAT( / ' Routines pass computational tests if test ratio is ',
285  $ 'less than', f8.2, / )
286  9991 FORMAT( ' Relative machine ', a, ' is taken to be', d16.6 )
287 *
288 * End of DCHKRFP
289 *
290  END
subroutine ddrvrf2(NOUT, NN, NVAL, A, LDA, ARF, AP, ASAV)
DDRVRF2
Definition: ddrvrf2.f:91
subroutine ddrvrf3(NOUT, NN, NVAL, THRESH, A, LDA, ARF, B1, B2, D_WORK_DLANGE, D_WORK_DGEQRF, TAU)
DDRVRF3
Definition: ddrvrf3.f:120
subroutine ddrvrf4(NOUT, NN, NVAL, THRESH, C1, C2, LDC, CRF, A, LDA, D_WORK_DLANGE)
DDRVRF4
Definition: ddrvrf4.f:120
subroutine ilaver(VERS_MAJOR, VERS_MINOR, VERS_PATCH)
ILAVER returns the LAPACK version.
Definition: ilaver.f:50
subroutine ddrvrfp(NOUT, NN, NVAL, NNS, NSVAL, NNT, NTVAL, THRESH, A, ASAV, AFAC, AINV, B, BSAV, XACT, X, ARF, ARFINV, D_WORK_DLATMS, D_WORK_DPOT01, D_TEMP_DPOT02, D_TEMP_DPOT03, D_WORK_DLANSY, D_WORK_DPOT02, D_WORK_DPOT03)
DDRVRFP
Definition: ddrvrfp.f:245
subroutine ddrvrf1(NOUT, NN, NVAL, THRESH, A, LDA, ARF, WORK)
DDRVRF1
Definition: ddrvrf1.f:96
program dchkrfp
DCHKRFP
Definition: dchkrfp.f:60
subroutine derrrfp(NUNIT)
DERRRFP
Definition: derrrfp.f:54