LAPACK  3.10.1
LAPACK: Linear Algebra PACKage
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
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:69
double precision function dsecnd()
DSECND Using ETIME
subroutine zerrrfp(NUNIT)
ZERRRFP
Definition: zerrrfp.f:52
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 zdrvrf1(NOUT, NN, NVAL, THRESH, A, LDA, ARF, WORK)
ZDRVRF1
Definition: zdrvrf1.f:95
subroutine zdrvrf3(NOUT, NN, NVAL, THRESH, A, LDA, ARF, B1, B2, D_WORK_ZLANGE, Z_WORK_ZGEQRF, TAU)
ZDRVRF3
Definition: zdrvrf3.f:119
subroutine zdrvrf2(NOUT, NN, NVAL, A, LDA, ARF, AP, ASAV)
ZDRVRF2
Definition: zdrvrf2.f:89
program zchkrfp
ZCHKRFP
Definition: zchkrfp.f:58
subroutine ilaver(VERS_MAJOR, VERS_MINOR, VERS_PATCH)
ILAVER returns the LAPACK version.
Definition: ilaver.f:51