LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
zchkrfp.f
Go to the documentation of this file.
1*> \brief \b ZCHKRFP
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 ZCHKRFP
12*
13*
14*> \par Purpose:
15* =============
16*>
17*> \verbatim
18*>
19*> ZCHKRFP is the main test program for the COMPLEX*16 linear equation
20*> 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 complex16_lin
56*
57* =====================================================================
58 PROGRAM zchkrfp
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 COMPLEX*16 worka( nmax, nmax )
88 COMPLEX*16 workasav( nmax, nmax )
89 COMPLEX*16 workb( nmax, maxrhs )
90 COMPLEX*16 workxact( nmax, maxrhs )
91 COMPLEX*16 workbsav( nmax, maxrhs )
92 COMPLEX*16 workx( nmax, maxrhs )
93 COMPLEX*16 workafac( nmax, nmax )
94 COMPLEX*16 workainv( nmax, nmax )
95 COMPLEX*16 workarf( (nmax*(nmax+1))/2 )
96 COMPLEX*16 workap( (nmax*(nmax+1))/2 )
97 COMPLEX*16 workarfinv( (nmax*(nmax+1))/2 )
98 COMPLEX*16 z_work_zlatms( 3 * nmax )
99 COMPLEX*16 z_work_zpot02( nmax, maxrhs )
100 COMPLEX*16 z_work_zpot03( nmax, nmax )
101 DOUBLE PRECISION d_work_zlatms( nmax )
102 DOUBLE PRECISION d_work_zlanhe( nmax )
103 DOUBLE PRECISION d_work_zpot01( nmax )
104 DOUBLE PRECISION d_work_zpot02( nmax )
105 DOUBLE PRECISION d_work_zpot03( nmax )
106* ..
107* .. External Functions ..
108 DOUBLE PRECISION dlamch, dsecnd
109 EXTERNAL dlamch, dsecnd
110* ..
111* .. External Subroutines ..
112 EXTERNAL ilaver, zdrvrfp, zdrvrf1, zdrvrf2, zdrvrf3,
113 + zdrvrf4
114* ..
115* .. Executable Statements ..
116*
117 s1 = dsecnd( )
118 fatal = .false.
119*
120* Read a dummy line.
121*
122 READ( nin, fmt = * )
123*
124* Report LAPACK version tag (e.g. LAPACK-3.2.0)
125*
126 CALL ilaver( vers_major, vers_minor, vers_patch )
127 WRITE( nout, fmt = 9994 ) vers_major, vers_minor, vers_patch
128*
129* Read the values of N
130*
131 READ( nin, fmt = * )nn
132 IF( nn.LT.1 ) THEN
133 WRITE( nout, fmt = 9996 )' NN ', nn, 1
134 nn = 0
135 fatal = .true.
136 ELSE IF( nn.GT.maxin ) THEN
137 WRITE( nout, fmt = 9995 )' NN ', nn, maxin
138 nn = 0
139 fatal = .true.
140 END IF
141 READ( nin, fmt = * )( nval( i ), i = 1, nn )
142 DO 10 i = 1, nn
143 IF( nval( i ).LT.0 ) THEN
144 WRITE( nout, fmt = 9996 )' M ', nval( i ), 0
145 fatal = .true.
146 ELSE IF( nval( i ).GT.nmax ) THEN
147 WRITE( nout, fmt = 9995 )' M ', nval( i ), nmax
148 fatal = .true.
149 END IF
150 10 CONTINUE
151 IF( nn.GT.0 )
152 $ WRITE( nout, fmt = 9993 )'N ', ( nval( i ), i = 1, nn )
153*
154* Read the values of NRHS
155*
156 READ( nin, fmt = * )nns
157 IF( nns.LT.1 ) THEN
158 WRITE( nout, fmt = 9996 )' NNS', nns, 1
159 nns = 0
160 fatal = .true.
161 ELSE IF( nns.GT.maxin ) THEN
162 WRITE( nout, fmt = 9995 )' NNS', nns, maxin
163 nns = 0
164 fatal = .true.
165 END IF
166 READ( nin, fmt = * )( nsval( i ), i = 1, nns )
167 DO 30 i = 1, nns
168 IF( nsval( i ).LT.0 ) THEN
169 WRITE( nout, fmt = 9996 )'NRHS', nsval( i ), 0
170 fatal = .true.
171 ELSE IF( nsval( i ).GT.maxrhs ) THEN
172 WRITE( nout, fmt = 9995 )'NRHS', nsval( i ), maxrhs
173 fatal = .true.
174 END IF
175 30 CONTINUE
176 IF( nns.GT.0 )
177 $ WRITE( nout, fmt = 9993 )'NRHS', ( nsval( i ), i = 1, nns )
178*
179* Read the matrix types
180*
181 READ( nin, fmt = * )nnt
182 IF( nnt.LT.1 ) THEN
183 WRITE( nout, fmt = 9996 )' NMA', nnt, 1
184 nnt = 0
185 fatal = .true.
186 ELSE IF( nnt.GT.ntypes ) THEN
187 WRITE( nout, fmt = 9995 )' NMA', nnt, ntypes
188 nnt = 0
189 fatal = .true.
190 END IF
191 READ( nin, fmt = * )( ntval( i ), i = 1, nnt )
192 DO 320 i = 1, nnt
193 IF( ntval( i ).LT.0 ) THEN
194 WRITE( nout, fmt = 9996 )'TYPE', ntval( i ), 0
195 fatal = .true.
196 ELSE IF( ntval( i ).GT.ntypes ) THEN
197 WRITE( nout, fmt = 9995 )'TYPE', ntval( i ), ntypes
198 fatal = .true.
199 END IF
200 320 CONTINUE
201 IF( nnt.GT.0 )
202 $ WRITE( nout, fmt = 9993 )'TYPE', ( ntval( i ), i = 1, nnt )
203*
204* Read the threshold value for the test ratios.
205*
206 READ( nin, fmt = * )thresh
207 WRITE( nout, fmt = 9992 )thresh
208*
209* Read the flag that indicates whether to test the error exits.
210*
211 READ( nin, fmt = * )tsterr
212*
213 IF( fatal ) THEN
214 WRITE( nout, fmt = 9999 )
215 stop
216 END IF
217*
218* Calculate and print the machine dependent constants.
219*
220 eps = dlamch( 'Underflow threshold' )
221 WRITE( nout, fmt = 9991 )'underflow', eps
222 eps = dlamch( 'Overflow threshold' )
223 WRITE( nout, fmt = 9991 )'overflow ', eps
224 eps = dlamch( 'Epsilon' )
225 WRITE( nout, fmt = 9991 )'precision', eps
226 WRITE( nout, fmt = * )
227*
228* Test the error exit of:
229*
230 IF( tsterr )
231 $ CALL zerrrfp( nout )
232*
233* Test the routines: zpftrf, zpftri, zpftrs (as in ZDRVPO).
234* This also tests the routines: ztfsm, ztftri, ztfttr, ztrttf.
235*
236 CALL zdrvrfp( nout, nn, nval, nns, nsval, nnt, ntval, thresh,
237 $ worka, workasav, workafac, workainv, workb,
238 $ workbsav, workxact, workx, workarf, workarfinv,
239 $ z_work_zlatms, z_work_zpot02,
240 $ z_work_zpot03, d_work_zlatms, d_work_zlanhe,
241 $ d_work_zpot01, d_work_zpot02, d_work_zpot03 )
242*
243* Test the routine: zlanhf
244*
245 CALL zdrvrf1( nout, nn, nval, thresh, worka, nmax, workarf,
246 + d_work_zlanhe )
247*
248* Test the conversion routines:
249* zhfttp, ztpthf, ztfttr, ztrttf, ztrttp and ztpttr.
250*
251 CALL zdrvrf2( nout, nn, nval, worka, nmax, workarf,
252 + workap, workasav )
253*
254* Test the routine: ztfsm
255*
256 CALL zdrvrf3( nout, nn, nval, thresh, worka, nmax, workarf,
257 + workainv, workafac, d_work_zlanhe,
258 + z_work_zpot03, z_work_zpot02 )
259
260*
261* Test the routine: zhfrk
262*
263 CALL zdrvrf4( nout, nn, nval, thresh, worka, workafac, nmax,
264 + workarf, workainv, nmax,d_work_zlanhe)
265*
266 CLOSE ( nin )
267 s2 = dsecnd( )
268 WRITE( nout, fmt = 9998 )
269 WRITE( nout, fmt = 9997 )s2 - s1
270*
271 9999 FORMAT( / ' Execution not attempted due to input errors' )
272 9998 FORMAT( / ' End of tests' )
273 9997 FORMAT( ' Total time used = ', f12.2, ' seconds', / )
274 9996 FORMAT( ' !! Invalid input value: ', a4, '=', i6, '; must be >=',
275 $ i6 )
276 9995 FORMAT( ' !! Invalid input value: ', a4, '=', i6, '; must be <=',
277 $ i6 )
278 9994 FORMAT( / ' Tests of the COMPLEX*16 LAPACK RFP routines ',
279 $ / ' LAPACK VERSION ', i1, '.', i1, '.', i1,
280 $ / / ' The following parameter values will be used:' )
281 9993 FORMAT( 4x, a4, ': ', 10i6, / 11x, 10i6 )
282 9992 FORMAT( / ' Routines pass computational tests if test ratio is ',
283 $ 'less than', f8.2, / )
284 9991 FORMAT( ' Relative machine ', a, ' is taken to be', d16.6 )
285*
286* End of ZCHKRFP
287*
288 END
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
program zchkrfp
ZCHKRFP
Definition zchkrfp.f:58
subroutine zdrvrf1(nout, nn, nval, thresh, a, lda, arf, work)
ZDRVRF1
Definition zdrvrf1.f:95
subroutine zdrvrf2(nout, nn, nval, a, lda, arf, ap, asav)
ZDRVRF2
Definition zdrvrf2.f:89
subroutine zdrvrf3(nout, nn, nval, thresh, a, lda, arf, b1, b2, d_work_zlange, z_work_zgeqrf, tau)
ZDRVRF3
Definition zdrvrf3.f:119
subroutine zdrvrf4(nout, nn, nval, thresh, c1, c2, ldc, crf, a, lda, d_work_zlange)
ZDRVRF4
Definition zdrvrf4.f:114
subroutine zdrvrfp(nout, nn, nval, nns, nsval, nnt, ntval, thresh, a, asav, afac, ainv, b, bsav, xact, x, arf, arfinv, z_work_zlatms, z_work_zpot02, z_work_zpot03, d_work_zlatms, d_work_zlanhe, d_work_zpot01, d_work_zpot02, d_work_zpot03)
ZDRVRFP
Definition zdrvrfp.f:244
subroutine zerrrfp(nunit)
ZERRRFP
Definition zerrrfp.f:52