LAPACK  3.8.0
LAPACK: Linear Algebra PACKage
schkrfp.f
Go to the documentation of this file.
1 *> \brief \b SCHKRFP
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 SCHKRFP
12 *
13 *
14 *> \par Purpose:
15 * =============
16 *>
17 *> \verbatim
18 *>
19 *> SCHKRFP is the main test program for the REAL linear
20 *> equation 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 single_lin
58 *
59 * =====================================================================
60  PROGRAM schkrfp
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  REAL EPS, S1, S2, THRESH
86 * ..
87 * .. Local Arrays ..
88  INTEGER NVAL( maxin ), NSVAL( maxin ), NTVAL( ntypes )
89  REAL WORKA( nmax, nmax )
90  REAL WORKASAV( nmax, nmax )
91  REAL WORKB( nmax, maxrhs )
92  REAL WORKXACT( nmax, maxrhs )
93  REAL WORKBSAV( nmax, maxrhs )
94  REAL WORKX( nmax, maxrhs )
95  REAL WORKAFAC( nmax, nmax )
96  REAL WORKAINV( nmax, nmax )
97  REAL WORKARF( (nmax*(nmax+1))/2 )
98  REAL WORKAP( (nmax*(nmax+1))/2 )
99  REAL WORKARFINV( (nmax*(nmax+1))/2 )
100  REAL S_WORK_SLATMS( 3 * nmax )
101  REAL S_WORK_SPOT01( nmax )
102  REAL S_TEMP_SPOT02( nmax, maxrhs )
103  REAL S_TEMP_SPOT03( nmax, nmax )
104  REAL S_WORK_SLANSY( nmax )
105  REAL S_WORK_SPOT02( nmax )
106  REAL S_WORK_SPOT03( nmax )
107 * ..
108 * .. External Functions ..
109  REAL SLAMCH, SECOND
110  EXTERNAL slamch, second
111 * ..
112 * .. External Subroutines ..
113  EXTERNAL ilaver, sdrvrfp, sdrvrf1, sdrvrf2, sdrvrf3,
114  + sdrvrf4
115 * ..
116 * .. Executable Statements ..
117 *
118  s1 = second( )
119  fatal = .false.
120 *
121 * Read a dummy line.
122 *
123  READ( nin, fmt = * )
124 *
125 * Report LAPACK version tag (e.g. LAPACK-3.2.0)
126 *
127  CALL ilaver( vers_major, vers_minor, vers_patch )
128  WRITE( nout, fmt = 9994 ) vers_major, vers_minor, vers_patch
129 *
130 * Read the values of N
131 *
132  READ( nin, fmt = * )nn
133  IF( nn.LT.1 ) THEN
134  WRITE( nout, fmt = 9996 )' NN ', nn, 1
135  nn = 0
136  fatal = .true.
137  ELSE IF( nn.GT.maxin ) THEN
138  WRITE( nout, fmt = 9995 )' NN ', nn, maxin
139  nn = 0
140  fatal = .true.
141  END IF
142  READ( nin, fmt = * )( nval( i ), i = 1, nn )
143  DO 10 i = 1, nn
144  IF( nval( i ).LT.0 ) THEN
145  WRITE( nout, fmt = 9996 )' M ', nval( i ), 0
146  fatal = .true.
147  ELSE IF( nval( i ).GT.nmax ) THEN
148  WRITE( nout, fmt = 9995 )' M ', nval( i ), nmax
149  fatal = .true.
150  END IF
151  10 CONTINUE
152  IF( nn.GT.0 )
153  $ WRITE( nout, fmt = 9993 )'N ', ( nval( i ), i = 1, nn )
154 *
155 * Read the values of NRHS
156 *
157  READ( nin, fmt = * )nns
158  IF( nns.LT.1 ) THEN
159  WRITE( nout, fmt = 9996 )' NNS', nns, 1
160  nns = 0
161  fatal = .true.
162  ELSE IF( nns.GT.maxin ) THEN
163  WRITE( nout, fmt = 9995 )' NNS', nns, maxin
164  nns = 0
165  fatal = .true.
166  END IF
167  READ( nin, fmt = * )( nsval( i ), i = 1, nns )
168  DO 30 i = 1, nns
169  IF( nsval( i ).LT.0 ) THEN
170  WRITE( nout, fmt = 9996 )'NRHS', nsval( i ), 0
171  fatal = .true.
172  ELSE IF( nsval( i ).GT.maxrhs ) THEN
173  WRITE( nout, fmt = 9995 )'NRHS', nsval( i ), maxrhs
174  fatal = .true.
175  END IF
176  30 CONTINUE
177  IF( nns.GT.0 )
178  $ WRITE( nout, fmt = 9993 )'NRHS', ( nsval( i ), i = 1, nns )
179 *
180 * Read the matrix types
181 *
182  READ( nin, fmt = * )nnt
183  IF( nnt.LT.1 ) THEN
184  WRITE( nout, fmt = 9996 )' NMA', nnt, 1
185  nnt = 0
186  fatal = .true.
187  ELSE IF( nnt.GT.ntypes ) THEN
188  WRITE( nout, fmt = 9995 )' NMA', nnt, ntypes
189  nnt = 0
190  fatal = .true.
191  END IF
192  READ( nin, fmt = * )( ntval( i ), i = 1, nnt )
193  DO 320 i = 1, nnt
194  IF( ntval( i ).LT.0 ) THEN
195  WRITE( nout, fmt = 9996 )'TYPE', ntval( i ), 0
196  fatal = .true.
197  ELSE IF( ntval( i ).GT.ntypes ) THEN
198  WRITE( nout, fmt = 9995 )'TYPE', ntval( i ), ntypes
199  fatal = .true.
200  END IF
201  320 CONTINUE
202  IF( nnt.GT.0 )
203  $ WRITE( nout, fmt = 9993 )'TYPE', ( ntval( i ), i = 1, nnt )
204 *
205 * Read the threshold value for the test ratios.
206 *
207  READ( nin, fmt = * )thresh
208  WRITE( nout, fmt = 9992 )thresh
209 *
210 * Read the flag that indicates whether to test the error exits.
211 *
212  READ( nin, fmt = * )tsterr
213 *
214  IF( fatal ) THEN
215  WRITE( nout, fmt = 9999 )
216  stop
217  END IF
218 *
219 * Calculate and print the machine dependent constants.
220 *
221  eps = slamch( 'Underflow threshold' )
222  WRITE( nout, fmt = 9991 )'underflow', eps
223  eps = slamch( 'Overflow threshold' )
224  WRITE( nout, fmt = 9991 )'overflow ', eps
225  eps = slamch( 'Epsilon' )
226  WRITE( nout, fmt = 9991 )'precision', eps
227  WRITE( nout, fmt = * )
228 *
229 * Test the error exit of:
230 *
231  IF( tsterr )
232  $ CALL serrrfp( nout )
233 *
234 * Test the routines: spftrf, spftri, spftrs (as in SDRVPO).
235 * This also tests the routines: stfsm, stftri, stfttr, strttf.
236 *
237  CALL sdrvrfp( nout, nn, nval, nns, nsval, nnt, ntval, thresh,
238  $ worka, workasav, workafac, workainv, workb,
239  $ workbsav, workxact, workx, workarf, workarfinv,
240  $ s_work_slatms, s_work_spot01, s_temp_spot02,
241  $ s_temp_spot03, s_work_slansy, s_work_spot02,
242  $ s_work_spot03 )
243 *
244 * Test the routine: slansf
245 *
246  CALL sdrvrf1( nout, nn, nval, thresh, worka, nmax, workarf,
247  + s_work_slansy )
248 *
249 * Test the conversion routines:
250 * stfttp, stpttf, stfttr, strttf, strttp and stpttr.
251 *
252  CALL sdrvrf2( nout, nn, nval, worka, nmax, workarf,
253  + workap, workasav )
254 *
255 * Test the routine: stfsm
256 *
257  CALL sdrvrf3( nout, nn, nval, thresh, worka, nmax, workarf,
258  + workainv, workafac, s_work_slansy,
259  + s_work_spot03, s_work_spot01 )
260 *
261 *
262 * Test the routine: ssfrk
263 *
264  CALL sdrvrf4( nout, nn, nval, thresh, worka, workafac, nmax,
265  + workarf, workainv, nmax, s_work_slansy)
266 *
267  CLOSE ( nin )
268  s2 = second( )
269  WRITE( nout, fmt = 9998 )
270  WRITE( nout, fmt = 9997 )s2 - s1
271 *
272  9999 FORMAT( / ' Execution not attempted due to input errors' )
273  9998 FORMAT( / ' End of tests' )
274  9997 FORMAT( ' Total time used = ', f12.2, ' seconds', / )
275  9996 FORMAT( ' !! Invalid input value: ', a4, '=', i6, '; must be >=',
276  $ i6 )
277  9995 FORMAT( ' !! Invalid input value: ', a4, '=', i6, '; must be <=',
278  $ i6 )
279  9994 FORMAT( / ' Tests of the REAL LAPACK RFP routines ',
280  $ / ' LAPACK VERSION ', i1, '.', i1, '.', i1,
281  $ / / ' The following parameter values will be used:' )
282  9993 FORMAT( 4x, a4, ': ', 10i6, / 11x, 10i6 )
283  9992 FORMAT( / ' Routines pass computational tests if test ratio is ',
284  $ 'less than', f8.2, / )
285  9991 FORMAT( ' Relative machine ', a, ' is taken to be', d16.6 )
286 *
287 * End of SCHKRFP
288 *
289  END
subroutine sdrvrf3(NOUT, NN, NVAL, THRESH, A, LDA, ARF, B1, B2, S_WORK_SLANGE, S_WORK_SGEQRF, TAU)
SDRVRF3
Definition: sdrvrf3.f:120
program schkrfp
SCHKRFP
Definition: schkrfp.f:60
subroutine sdrvrf4(NOUT, NN, NVAL, THRESH, C1, C2, LDC, CRF, A, LDA, S_WORK_SLANGE)
SDRVRF4
Definition: sdrvrf4.f:120
subroutine sdrvrf2(NOUT, NN, NVAL, A, LDA, ARF, AP, ASAV)
SDRVRF2
Definition: sdrvrf2.f:91
subroutine sdrvrf1(NOUT, NN, NVAL, THRESH, A, LDA, ARF, WORK)
SDRVRF1
Definition: sdrvrf1.f:96
subroutine ilaver(VERS_MAJOR, VERS_MINOR, VERS_PATCH)
ILAVER returns the LAPACK version.
Definition: ilaver.f:50
subroutine serrrfp(NUNIT)
SERRRFP
Definition: serrrfp.f:54
subroutine sdrvrfp(NOUT, NN, NVAL, NNS, NSVAL, NNT, NTVAL, THRESH, A, ASAV, AFAC, AINV, B, BSAV, XACT, X, ARF, ARFINV, S_WORK_SLATMS, S_WORK_SPOT01, S_TEMP_SPOT02, S_TEMP_SPOT03, S_WORK_SLANSY, S_WORK_SPOT02, S_WORK_SPOT03)
SDRVRFP
Definition: sdrvrfp.f:245