LAPACK  3.10.1
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 *> \ingroup double_lin
56 *
57 * =====================================================================
58  PROGRAM dchkrfp
59 *
60 * -- LAPACK test routine --
61 * -- LAPACK is a software package provided by Univ. of Tennessee, --
62 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
63 *
64 * =====================================================================
65 *
66 * .. Parameters ..
67  INTEGER maxin
68  parameter( maxin = 12 )
69  INTEGER nmax
70  parameter( nmax = 50 )
71  INTEGER maxrhs
72  parameter( maxrhs = 16 )
73  INTEGER ntypes
74  parameter( ntypes = 9 )
75  INTEGER nin, nout
76  parameter( nin = 5, nout = 6 )
77 * ..
78 * .. Local Scalars ..
79  LOGICAL fatal, tsterr
80  INTEGER vers_major, vers_minor, vers_patch
81  INTEGER i, nn, nns, nnt
82  DOUBLE PRECISION eps, s1, s2, thresh
83 
84 * ..
85 * .. Local Arrays ..
86  INTEGER nval( maxin ), nsval( maxin ), ntval( ntypes )
87  DOUBLE PRECISION worka( nmax, nmax )
88  DOUBLE PRECISION workasav( nmax, nmax )
89  DOUBLE PRECISION workb( nmax, maxrhs )
90  DOUBLE PRECISION workxact( nmax, maxrhs )
91  DOUBLE PRECISION workbsav( nmax, maxrhs )
92  DOUBLE PRECISION workx( nmax, maxrhs )
93  DOUBLE PRECISION workafac( nmax, nmax )
94  DOUBLE PRECISION workainv( nmax, nmax )
95  DOUBLE PRECISION workarf( (nmax*(nmax+1))/2 )
96  DOUBLE PRECISION workap( (nmax*(nmax+1))/2 )
97  DOUBLE PRECISION workarfinv( (nmax*(nmax+1))/2 )
98  DOUBLE PRECISION d_work_dlatms( 3 * nmax )
99  DOUBLE PRECISION d_work_dpot01( nmax )
100  DOUBLE PRECISION d_temp_dpot02( nmax, maxrhs )
101  DOUBLE PRECISION d_temp_dpot03( nmax, nmax )
102  DOUBLE PRECISION d_work_dlansy( nmax )
103  DOUBLE PRECISION d_work_dpot02( nmax )
104  DOUBLE PRECISION d_work_dpot03( nmax )
105 * ..
106 * .. External Functions ..
107  DOUBLE PRECISION dlamch, dsecnd
108  EXTERNAL dlamch, dsecnd
109 * ..
110 * .. External Subroutines ..
111  EXTERNAL ilaver, ddrvrfp, ddrvrf1, ddrvrf2, ddrvrf3,
112  + ddrvrf4
113 * ..
114 * .. Executable Statements ..
115 *
116  s1 = dsecnd( )
117  fatal = .false.
118 *
119 * Read a dummy line.
120 *
121  READ( nin, fmt = * )
122 *
123 * Report LAPACK version tag (e.g. LAPACK-3.2.0)
124 *
125  CALL ilaver( vers_major, vers_minor, vers_patch )
126  WRITE( nout, fmt = 9994 ) vers_major, vers_minor, vers_patch
127 *
128 * Read the values of N
129 *
130  READ( nin, fmt = * )nn
131  IF( nn.LT.1 ) THEN
132  WRITE( nout, fmt = 9996 )' NN ', nn, 1
133  nn = 0
134  fatal = .true.
135  ELSE IF( nn.GT.maxin ) THEN
136  WRITE( nout, fmt = 9995 )' NN ', nn, maxin
137  nn = 0
138  fatal = .true.
139  END IF
140  READ( nin, fmt = * )( nval( i ), i = 1, nn )
141  DO 10 i = 1, nn
142  IF( nval( i ).LT.0 ) THEN
143  WRITE( nout, fmt = 9996 )' M ', nval( i ), 0
144  fatal = .true.
145  ELSE IF( nval( i ).GT.nmax ) THEN
146  WRITE( nout, fmt = 9995 )' M ', nval( i ), nmax
147  fatal = .true.
148  END IF
149  10 CONTINUE
150  IF( nn.GT.0 )
151  $ WRITE( nout, fmt = 9993 )'N ', ( nval( i ), i = 1, nn )
152 *
153 * Read the values of NRHS
154 *
155  READ( nin, fmt = * )nns
156  IF( nns.LT.1 ) THEN
157  WRITE( nout, fmt = 9996 )' NNS', nns, 1
158  nns = 0
159  fatal = .true.
160  ELSE IF( nns.GT.maxin ) THEN
161  WRITE( nout, fmt = 9995 )' NNS', nns, maxin
162  nns = 0
163  fatal = .true.
164  END IF
165  READ( nin, fmt = * )( nsval( i ), i = 1, nns )
166  DO 30 i = 1, nns
167  IF( nsval( i ).LT.0 ) THEN
168  WRITE( nout, fmt = 9996 )'NRHS', nsval( i ), 0
169  fatal = .true.
170  ELSE IF( nsval( i ).GT.maxrhs ) THEN
171  WRITE( nout, fmt = 9995 )'NRHS', nsval( i ), maxrhs
172  fatal = .true.
173  END IF
174  30 CONTINUE
175  IF( nns.GT.0 )
176  $ WRITE( nout, fmt = 9993 )'NRHS', ( nsval( i ), i = 1, nns )
177 *
178 * Read the matrix types
179 *
180  READ( nin, fmt = * )nnt
181  IF( nnt.LT.1 ) THEN
182  WRITE( nout, fmt = 9996 )' NMA', nnt, 1
183  nnt = 0
184  fatal = .true.
185  ELSE IF( nnt.GT.ntypes ) THEN
186  WRITE( nout, fmt = 9995 )' NMA', nnt, ntypes
187  nnt = 0
188  fatal = .true.
189  END IF
190  READ( nin, fmt = * )( ntval( i ), i = 1, nnt )
191  DO 320 i = 1, nnt
192  IF( ntval( i ).LT.0 ) THEN
193  WRITE( nout, fmt = 9996 )'TYPE', ntval( i ), 0
194  fatal = .true.
195  ELSE IF( ntval( i ).GT.ntypes ) THEN
196  WRITE( nout, fmt = 9995 )'TYPE', ntval( i ), ntypes
197  fatal = .true.
198  END IF
199  320 CONTINUE
200  IF( nnt.GT.0 )
201  $ WRITE( nout, fmt = 9993 )'TYPE', ( ntval( i ), i = 1, nnt )
202 *
203 * Read the threshold value for the test ratios.
204 *
205  READ( nin, fmt = * )thresh
206  WRITE( nout, fmt = 9992 )thresh
207 *
208 * Read the flag that indicates whether to test the error exits.
209 *
210  READ( nin, fmt = * )tsterr
211 *
212  IF( fatal ) THEN
213  WRITE( nout, fmt = 9999 )
214  stop
215  END IF
216 *
217 * Calculate and print the machine dependent constants.
218 *
219  eps = dlamch( 'Underflow threshold' )
220  WRITE( nout, fmt = 9991 )'underflow', eps
221  eps = dlamch( 'Overflow threshold' )
222  WRITE( nout, fmt = 9991 )'overflow ', eps
223  eps = dlamch( 'Epsilon' )
224  WRITE( nout, fmt = 9991 )'precision', eps
225  WRITE( nout, fmt = * )
226 *
227 * Test the error exit of:
228 *
229  IF( tsterr )
230  $ CALL derrrfp( nout )
231 *
232 * Test the routines: dpftrf, dpftri, dpftrs (as in DDRVPO).
233 * This also tests the routines: dtfsm, dtftri, dtfttr, dtrttf.
234 *
235  CALL ddrvrfp( nout, nn, nval, nns, nsval, nnt, ntval, thresh,
236  $ worka, workasav, workafac, workainv, workb,
237  $ workbsav, workxact, workx, workarf, workarfinv,
238  $ d_work_dlatms, d_work_dpot01, d_temp_dpot02,
239  $ d_temp_dpot03, d_work_dlansy, d_work_dpot02,
240  $ d_work_dpot03 )
241 *
242 * Test the routine: dlansf
243 *
244  CALL ddrvrf1( nout, nn, nval, thresh, worka, nmax, workarf,
245  + d_work_dlansy )
246 *
247 * Test the conversion routines:
248 * dtfttp, dtpttf, dtfttr, dtrttf, dtrttp and dtpttr.
249 *
250  CALL ddrvrf2( nout, nn, nval, worka, nmax, workarf,
251  + workap, workasav )
252 *
253 * Test the routine: dtfsm
254 *
255  CALL ddrvrf3( nout, nn, nval, thresh, worka, nmax, workarf,
256  + workainv, workafac, d_work_dlansy,
257  + d_work_dpot03, d_work_dpot01 )
258 *
259 *
260 * Test the routine: dsfrk
261 *
262  CALL ddrvrf4( nout, nn, nval, thresh, worka, workafac, nmax,
263  + workarf, workainv, nmax, d_work_dlansy)
264 *
265  CLOSE ( nin )
266  s2 = dsecnd( )
267  WRITE( nout, fmt = 9998 )
268  WRITE( nout, fmt = 9997 )s2 - s1
269 *
270  9999 FORMAT( / ' Execution not attempted due to input errors' )
271  9998 FORMAT( / ' End of tests' )
272  9997 FORMAT( ' Total time used = ', f12.2, ' seconds', / )
273  9996 FORMAT( ' !! Invalid input value: ', a4, '=', i6, '; must be >=',
274  $ i6 )
275  9995 FORMAT( ' !! Invalid input value: ', a4, '=', i6, '; must be <=',
276  $ i6 )
277  9994 FORMAT( / ' Tests of the DOUBLE PRECISION LAPACK RFP routines ',
278  $ / ' LAPACK VERSION ', i1, '.', i1, '.', i1,
279  $ / / ' The following parameter values will be used:' )
280  9993 FORMAT( 4x, a4, ': ', 10i6, / 11x, 10i6 )
281  9992 FORMAT( / ' Routines pass computational tests if test ratio is ',
282  $ 'less than', f8.2, / )
283  9991 FORMAT( ' Relative machine ', a, ' is taken to be', d16.6 )
284 *
285 * End of DCHKRFP
286 *
287  END
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:69
double precision function dsecnd()
DSECND Using ETIME
subroutine ddrvrf1(NOUT, NN, NVAL, THRESH, A, LDA, ARF, WORK)
DDRVRF1
Definition: ddrvrf1.f:94
program dchkrfp
DCHKRFP
Definition: dchkrfp.f:58
subroutine ddrvrf3(NOUT, NN, NVAL, THRESH, A, LDA, ARF, B1, B2, D_WORK_DLANGE, D_WORK_DGEQRF, TAU)
DDRVRF3
Definition: ddrvrf3.f:118
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:238
subroutine derrrfp(NUNIT)
DERRRFP
Definition: derrrfp.f:52
subroutine ddrvrf4(NOUT, NN, NVAL, THRESH, C1, C2, LDC, CRF, A, LDA, D_WORK_DLANGE)
DDRVRF4
Definition: ddrvrf4.f:118
subroutine ddrvrf2(NOUT, NN, NVAL, A, LDA, ARF, AP, ASAV)
DDRVRF2
Definition: ddrvrf2.f:89
subroutine ilaver(VERS_MAJOR, VERS_MINOR, VERS_PATCH)
ILAVER returns the LAPACK version.
Definition: ilaver.f:51