LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
cchkrfp.f
Go to the documentation of this file.
1 *> \brief \b CCHKRFP
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 CCHKRFP
12 *
13 *
14 *> \par Purpose:
15 * =============
16 *>
17 *> \verbatim
18 *>
19 *> CCHKRFP is the main test program for the COMPLEX 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 complex_lin
58 *
59 * =====================================================================
60  PROGRAM cchkrfp
61 *
62 * -- LAPACK test routine (version 3.4.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  REAL eps, s1, s2, thresh
86 
87 * ..
88 * .. Local Arrays ..
89  INTEGER nval( maxin ), nsval( maxin ), ntval( ntypes )
90  COMPLEX worka( nmax, nmax )
91  COMPLEX workasav( nmax, nmax )
92  COMPLEX workb( nmax, maxrhs )
93  COMPLEX workxact( nmax, maxrhs )
94  COMPLEX workbsav( nmax, maxrhs )
95  COMPLEX workx( nmax, maxrhs )
96  COMPLEX workafac( nmax, nmax )
97  COMPLEX workainv( nmax, nmax )
98  COMPLEX workarf( (nmax*(nmax+1))/2 )
99  COMPLEX workap( (nmax*(nmax+1))/2 )
100  COMPLEX workarfinv( (nmax*(nmax+1))/2 )
101  COMPLEX c_work_clatms( 3 * nmax )
102  COMPLEX c_work_cpot02( nmax, maxrhs )
103  COMPLEX c_work_cpot03( nmax, nmax )
104  REAL s_work_clatms( nmax )
105  REAL s_work_clanhe( nmax )
106  REAL s_work_cpot01( nmax )
107  REAL s_work_cpot02( nmax )
108  REAL s_work_cpot03( nmax )
109 * ..
110 * .. External Functions ..
111  REAL slamch, second
112  EXTERNAL slamch, second
113 * ..
114 * .. External Subroutines ..
115  EXTERNAL ilaver, cdrvrfp, cdrvrf1, cdrvrf2, cdrvrf3,
116  + cdrvrf4
117 * ..
118 * .. Executable Statements ..
119 *
120  s1 = second( )
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  IF( fatal ) THEN
222  WRITE( nout, fmt = 9999 )
223  stop
224  END IF
225 *
226 * Calculate and print the machine dependent constants.
227 *
228  eps = slamch( 'Underflow threshold' )
229  WRITE( nout, fmt = 9991 )'underflow', eps
230  eps = slamch( 'Overflow threshold' )
231  WRITE( nout, fmt = 9991 )'overflow ', eps
232  eps = slamch( 'Epsilon' )
233  WRITE( nout, fmt = 9991 )'precision', eps
234  WRITE( nout, fmt = * )
235 *
236 * Test the error exit of:
237 *
238  IF( tsterr )
239  $ CALL cerrrfp( nout )
240 *
241 * Test the routines: cpftrf, cpftri, cpftrs (as in CDRVPO).
242 * This also tests the routines: ctfsm, ctftri, ctfttr, ctrttf.
243 *
244  CALL cdrvrfp( nout, nn, nval, nns, nsval, nnt, ntval, thresh,
245  $ worka, workasav, workafac, workainv, workb,
246  $ workbsav, workxact, workx, workarf, workarfinv,
247  $ c_work_clatms, c_work_cpot02,
248  $ c_work_cpot03, s_work_clatms, s_work_clanhe,
249  $ s_work_cpot01, s_work_cpot02, s_work_cpot03 )
250 *
251 * Test the routine: clanhf
252 *
253  CALL cdrvrf1( nout, nn, nval, thresh, worka, nmax, workarf,
254  + s_work_clanhe )
255 *
256 * Test the convertion routines:
257 * chfttp, ctpthf, ctfttr, ctrttf, ctrttp and ctpttr.
258 *
259  CALL cdrvrf2( nout, nn, nval, worka, nmax, workarf,
260  + workap, workasav )
261 *
262 * Test the routine: ctfsm
263 *
264  CALL cdrvrf3( nout, nn, nval, thresh, worka, nmax, workarf,
265  + workainv, workafac, s_work_clanhe,
266  + c_work_cpot03, c_work_cpot02 )
267 *
268 *
269 * Test the routine: chfrk
270 *
271  CALL cdrvrf4( nout, nn, nval, thresh, worka, workafac, nmax,
272  + workarf, workainv, nmax, s_work_clanhe)
273 *
274  CLOSE ( nin )
275  s2 = second( )
276  WRITE( nout, fmt = 9998 )
277  WRITE( nout, fmt = 9997 )s2 - s1
278 *
279  9999 format( / ' Execution not attempted due to input errors' )
280  9998 format( / ' End of tests' )
281  9997 format( ' Total time used = ', f12.2, ' seconds', / )
282  9996 format( ' !! Invalid input value: ', a4, '=', i6, '; must be >=',
283  $ i6 )
284  9995 format( ' !! Invalid input value: ', a4, '=', i6, '; must be <=',
285  $ i6 )
286  9994 format( / ' Tests of the COMPLEX LAPACK RFP routines ',
287  $ / ' LAPACK VERSION ', i1, '.', i1, '.', i1,
288  $ / / ' The following parameter values will be used:' )
289  9993 format( 4x, a4, ': ', 10i6, / 11x, 10i6 )
290  9992 format( / ' Routines pass computational tests if test ratio is ',
291  $ 'less than', f8.2, / )
292  9991 format( ' Relative machine ', a, ' is taken to be', d16.6 )
293 *
294 * End of CCHKRFP
295 *
296  END