LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
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
program dchkrfp
DCHKRFP
Definition dchkrfp.f:58
subroutine ddrvrf1(nout, nn, nval, thresh, a, lda, arf, work)
DDRVRF1
Definition ddrvrf1.f:94
subroutine ddrvrf2(nout, nn, nval, a, lda, arf, ap, asav)
DDRVRF2
Definition ddrvrf2.f:89
subroutine ddrvrf3(nout, nn, nval, thresh, a, lda, arf, b1, b2, d_work_dlange, d_work_dgeqrf, tau)
DDRVRF3
Definition ddrvrf3.f:118
subroutine ddrvrf4(nout, nn, nval, thresh, c1, c2, ldc, crf, a, lda, d_work_dlange)
DDRVRF4
Definition ddrvrf4.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 ilaver(vers_major, vers_minor, vers_patch)
ILAVER returns the LAPACK version.
Definition ilaver.f:51
double precision function dlamch(cmach)
DLAMCH
Definition dlamch.f:69
double precision function dsecnd()
DSECND Using ETIME