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