LAPACK  3.10.0
LAPACK: Linear Algebra PACKage
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 *> \ingroup complex_lin
56 *
57 * =====================================================================
58  PROGRAM cchkrfp
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  REAL eps, s1, s2, thresh
83 
84 * ..
85 * .. Local Arrays ..
86  INTEGER nval( maxin ), nsval( maxin ), ntval( ntypes )
87  COMPLEX worka( nmax, nmax )
88  COMPLEX workasav( nmax, nmax )
89  COMPLEX workb( nmax, maxrhs )
90  COMPLEX workxact( nmax, maxrhs )
91  COMPLEX workbsav( nmax, maxrhs )
92  COMPLEX workx( nmax, maxrhs )
93  COMPLEX workafac( nmax, nmax )
94  COMPLEX workainv( nmax, nmax )
95  COMPLEX workarf( (nmax*(nmax+1))/2 )
96  COMPLEX workap( (nmax*(nmax+1))/2 )
97  COMPLEX workarfinv( (nmax*(nmax+1))/2 )
98  COMPLEX c_work_clatms( 3 * nmax )
99  COMPLEX c_work_cpot02( nmax, maxrhs )
100  COMPLEX c_work_cpot03( nmax, nmax )
101  REAL s_work_clatms( nmax )
102  REAL s_work_clanhe( nmax )
103  REAL s_work_cpot01( nmax )
104  REAL s_work_cpot02( nmax )
105  REAL s_work_cpot03( nmax )
106 * ..
107 * .. External Functions ..
108  REAL slamch, second
109  EXTERNAL slamch, second
110 * ..
111 * .. External Subroutines ..
112  EXTERNAL ilaver, cdrvrfp, cdrvrf1, cdrvrf2, cdrvrf3,
113  + cdrvrf4
114 * ..
115 * .. Executable Statements ..
116 *
117  s1 = second( )
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 = slamch( 'Underflow threshold' )
221  WRITE( nout, fmt = 9991 )'underflow', eps
222  eps = slamch( 'Overflow threshold' )
223  WRITE( nout, fmt = 9991 )'overflow ', eps
224  eps = slamch( '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 cerrrfp( nout )
232 *
233 * Test the routines: cpftrf, cpftri, cpftrs (as in CDRVPO).
234 * This also tests the routines: ctfsm, ctftri, ctfttr, ctrttf.
235 *
236  CALL cdrvrfp( nout, nn, nval, nns, nsval, nnt, ntval, thresh,
237  $ worka, workasav, workafac, workainv, workb,
238  $ workbsav, workxact, workx, workarf, workarfinv,
239  $ c_work_clatms, c_work_cpot02,
240  $ c_work_cpot03, s_work_clatms, s_work_clanhe,
241  $ s_work_cpot01, s_work_cpot02, s_work_cpot03 )
242 *
243 * Test the routine: clanhf
244 *
245  CALL cdrvrf1( nout, nn, nval, thresh, worka, nmax, workarf,
246  + s_work_clanhe )
247 *
248 * Test the conversion routines:
249 * chfttp, ctpthf, ctfttr, ctrttf, ctrttp and ctpttr.
250 *
251  CALL cdrvrf2( nout, nn, nval, worka, nmax, workarf,
252  + workap, workasav )
253 *
254 * Test the routine: ctfsm
255 *
256  CALL cdrvrf3( nout, nn, nval, thresh, worka, nmax, workarf,
257  + workainv, workafac, s_work_clanhe,
258  + c_work_cpot03, c_work_cpot02 )
259 *
260 *
261 * Test the routine: chfrk
262 *
263  CALL cdrvrf4( nout, nn, nval, thresh, worka, workafac, nmax,
264  + workarf, workainv, nmax, s_work_clanhe)
265 *
266  CLOSE ( nin )
267  s2 = second( )
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 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 CCHKRFP
287 *
288  END
subroutine cdrvrf1(NOUT, NN, NVAL, THRESH, A, LDA, ARF, WORK)
CDRVRF1
Definition: cdrvrf1.f:95
subroutine cerrrfp(NUNIT)
CERRRFP
Definition: cerrrfp.f:52
subroutine cdrvrfp(NOUT, NN, NVAL, NNS, NSVAL, NNT, NTVAL, THRESH, A, ASAV, AFAC, AINV, B, BSAV, XACT, X, ARF, ARFINV, C_WORK_CLATMS, C_WORK_CPOT02, C_WORK_CPOT03, S_WORK_CLATMS, S_WORK_CLANHE, S_WORK_CPOT01, S_WORK_CPOT02, S_WORK_CPOT03)
CDRVRFP
Definition: cdrvrfp.f:244
program cchkrfp
CCHKRFP
Definition: cchkrfp.f:58
subroutine cdrvrf2(NOUT, NN, NVAL, A, LDA, ARF, AP, ASAV)
CDRVRF2
Definition: cdrvrf2.f:89
subroutine cdrvrf3(NOUT, NN, NVAL, THRESH, A, LDA, ARF, B1, B2, S_WORK_CLANGE, C_WORK_CGEQRF, TAU)
CDRVRF3
Definition: cdrvrf3.f:119
subroutine cdrvrf4(NOUT, NN, NVAL, THRESH, C1, C2, LDC, CRF, A, LDA, S_WORK_CLANGE)
CDRVRF4
Definition: cdrvrf4.f:114
subroutine ilaver(VERS_MAJOR, VERS_MINOR, VERS_PATCH)
ILAVER returns the LAPACK version.
Definition: ilaver.f:51
real function second()
SECOND Using ETIME
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:68