1 PROGRAM SCHKRFP
2 *
3 * -- LAPACK test routine (version 3.2.0) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * November 2008
6 *
7 * Purpose
8 * =======
9 *
10 * SCHKRFP is the main test program for the REAL linear
11 * equation routines with RFP storage format
12 *
13 *
14 * Internal Parameters
15 * ===================
16 *
17 * MAXIN INTEGER
18 * The number of different values that can be used for each of
19 * M, N, or NB
20 *
21 * MAXRHS INTEGER
22 * The maximum number of right hand sides
23 *
24 * NTYPES INTEGER
25 *
26 * NMAX INTEGER
27 * The maximum allowable value for N.
28 *
29 * NIN INTEGER
30 * The unit number for input
31 *
32 * NOUT INTEGER
33 * The unit number for output
34 *
35 * =====================================================================
36 *
37 * .. Parameters ..
38 INTEGER MAXIN
39 PARAMETER ( MAXIN = 12 )
40 INTEGER NMAX
41 PARAMETER ( NMAX = 50 )
42 INTEGER MAXRHS
43 PARAMETER ( MAXRHS = 16 )
44 INTEGER NTYPES
45 PARAMETER ( NTYPES = 9 )
46 INTEGER NIN, NOUT
47 PARAMETER ( NIN = 5, NOUT = 6 )
48 * ..
49 * .. Local Scalars ..
50 LOGICAL FATAL, TSTERR
51 INTEGER VERS_MAJOR, VERS_MINOR, VERS_PATCH
52 INTEGER I, NN, NNS, NNT
53 REAL EPS, S1, S2, THRESH
54 * ..
55 * .. Local Arrays ..
56 INTEGER NVAL( MAXIN ), NSVAL( MAXIN ), NTVAL( NTYPES )
57 REAL WORKA( NMAX, NMAX )
58 REAL WORKASAV( NMAX, NMAX )
59 REAL WORKB( NMAX, MAXRHS )
60 REAL WORKXACT( NMAX, MAXRHS )
61 REAL WORKBSAV( NMAX, MAXRHS )
62 REAL WORKX( NMAX, MAXRHS )
63 REAL WORKAFAC( NMAX, NMAX )
64 REAL WORKAINV( NMAX, NMAX )
65 REAL WORKARF( (NMAX*(NMAX+1))/2 )
66 REAL WORKAP( (NMAX*(NMAX+1))/2 )
67 REAL WORKARFINV( (NMAX*(NMAX+1))/2 )
68 REAL S_WORK_SLATMS( 3 * NMAX )
69 REAL S_WORK_SPOT01( NMAX )
70 REAL S_TEMP_SPOT02( NMAX, MAXRHS )
71 REAL S_TEMP_SPOT03( NMAX, NMAX )
72 REAL S_WORK_SLANSY( NMAX )
73 REAL S_WORK_SPOT02( NMAX )
74 REAL S_WORK_SPOT03( NMAX )
75 * ..
76 * .. External Functions ..
77 REAL SLAMCH, SECOND
78 EXTERNAL SLAMCH, SECOND
79 * ..
80 * .. External Subroutines ..
81 EXTERNAL ILAVER, SDRVRFP, SDRVRF1, SDRVRF2, SDRVRF3,
82 + SDRVRF4
83 * ..
84 * .. Executable Statements ..
85 *
86 S1 = SECOND( )
87 FATAL = .FALSE.
88 *
89 * Read a dummy line.
90 *
91 READ( NIN, FMT = * )
92 *
93 * Report LAPACK version tag (e.g. LAPACK-3.2.0)
94 *
95 CALL ILAVER( VERS_MAJOR, VERS_MINOR, VERS_PATCH )
96 WRITE( NOUT, FMT = 9994 ) VERS_MAJOR, VERS_MINOR, VERS_PATCH
97 *
98 * Read the values of N
99 *
100 READ( NIN, FMT = * )NN
101 IF( NN.LT.1 ) THEN
102 WRITE( NOUT, FMT = 9996 )' NN ', NN, 1
103 NN = 0
104 FATAL = .TRUE.
105 ELSE IF( NN.GT.MAXIN ) THEN
106 WRITE( NOUT, FMT = 9995 )' NN ', NN, MAXIN
107 NN = 0
108 FATAL = .TRUE.
109 END IF
110 READ( NIN, FMT = * )( NVAL( I ), I = 1, NN )
111 DO 10 I = 1, NN
112 IF( NVAL( I ).LT.0 ) THEN
113 WRITE( NOUT, FMT = 9996 )' M ', NVAL( I ), 0
114 FATAL = .TRUE.
115 ELSE IF( NVAL( I ).GT.NMAX ) THEN
116 WRITE( NOUT, FMT = 9995 )' M ', NVAL( I ), NMAX
117 FATAL = .TRUE.
118 END IF
119 10 CONTINUE
120 IF( NN.GT.0 )
121 $ WRITE( NOUT, FMT = 9993 )'N ', ( NVAL( I ), I = 1, NN )
122 *
123 * Read the values of NRHS
124 *
125 READ( NIN, FMT = * )NNS
126 IF( NNS.LT.1 ) THEN
127 WRITE( NOUT, FMT = 9996 )' NNS', NNS, 1
128 NNS = 0
129 FATAL = .TRUE.
130 ELSE IF( NNS.GT.MAXIN ) THEN
131 WRITE( NOUT, FMT = 9995 )' NNS', NNS, MAXIN
132 NNS = 0
133 FATAL = .TRUE.
134 END IF
135 READ( NIN, FMT = * )( NSVAL( I ), I = 1, NNS )
136 DO 30 I = 1, NNS
137 IF( NSVAL( I ).LT.0 ) THEN
138 WRITE( NOUT, FMT = 9996 )'NRHS', NSVAL( I ), 0
139 FATAL = .TRUE.
140 ELSE IF( NSVAL( I ).GT.MAXRHS ) THEN
141 WRITE( NOUT, FMT = 9995 )'NRHS', NSVAL( I ), MAXRHS
142 FATAL = .TRUE.
143 END IF
144 30 CONTINUE
145 IF( NNS.GT.0 )
146 $ WRITE( NOUT, FMT = 9993 )'NRHS', ( NSVAL( I ), I = 1, NNS )
147 *
148 * Read the matrix types
149 *
150 READ( NIN, FMT = * )NNT
151 IF( NNT.LT.1 ) THEN
152 WRITE( NOUT, FMT = 9996 )' NMA', NNT, 1
153 NNT = 0
154 FATAL = .TRUE.
155 ELSE IF( NNT.GT.NTYPES ) THEN
156 WRITE( NOUT, FMT = 9995 )' NMA', NNT, NTYPES
157 NNT = 0
158 FATAL = .TRUE.
159 END IF
160 READ( NIN, FMT = * )( NTVAL( I ), I = 1, NNT )
161 DO 320 I = 1, NNT
162 IF( NTVAL( I ).LT.0 ) THEN
163 WRITE( NOUT, FMT = 9996 )'TYPE', NTVAL( I ), 0
164 FATAL = .TRUE.
165 ELSE IF( NTVAL( I ).GT.NTYPES ) THEN
166 WRITE( NOUT, FMT = 9995 )'TYPE', NTVAL( I ), NTYPES
167 FATAL = .TRUE.
168 END IF
169 320 CONTINUE
170 IF( NNT.GT.0 )
171 $ WRITE( NOUT, FMT = 9993 )'TYPE', ( NTVAL( I ), I = 1, NNT )
172 *
173 * Read the threshold value for the test ratios.
174 *
175 READ( NIN, FMT = * )THRESH
176 WRITE( NOUT, FMT = 9992 )THRESH
177 *
178 * Read the flag that indicates whether to test the error exits.
179 *
180 READ( NIN, FMT = * )TSTERR
181 *
182 IF( FATAL ) THEN
183 WRITE( NOUT, FMT = 9999 )
184 STOP
185 END IF
186 *
187 IF( FATAL ) THEN
188 WRITE( NOUT, FMT = 9999 )
189 STOP
190 END IF
191 *
192 * Calculate and print the machine dependent constants.
193 *
194 EPS = SLAMCH( 'Underflow threshold' )
195 WRITE( NOUT, FMT = 9991 )'underflow', EPS
196 EPS = SLAMCH( 'Overflow threshold' )
197 WRITE( NOUT, FMT = 9991 )'overflow ', EPS
198 EPS = SLAMCH( 'Epsilon' )
199 WRITE( NOUT, FMT = 9991 )'precision', EPS
200 WRITE( NOUT, FMT = * )
201 *
202 * Test the error exit of:
203 *
204 IF( TSTERR )
205 $ CALL SERRRFP( NOUT )
206 *
207 * Test the routines: spftrf, spftri, spftrs (as in SDRVPO).
208 * This also tests the routines: stfsm, stftri, stfttr, strttf.
209 *
210 CALL SDRVRFP( NOUT, NN, NVAL, NNS, NSVAL, NNT, NTVAL, THRESH,
211 $ WORKA, WORKASAV, WORKAFAC, WORKAINV, WORKB,
212 $ WORKBSAV, WORKXACT, WORKX, WORKARF, WORKARFINV,
213 $ S_WORK_SLATMS, S_WORK_SPOT01, S_TEMP_SPOT02,
214 $ S_TEMP_SPOT03, S_WORK_SLANSY, S_WORK_SPOT02,
215 $ S_WORK_SPOT03 )
216 *
217 * Test the routine: slansf
218 *
219 CALL SDRVRF1( NOUT, NN, NVAL, THRESH, WORKA, NMAX, WORKARF,
220 + S_WORK_SLANSY )
221 *
222 * Test the convertion routines:
223 * stfttp, stpttf, stfttr, strttf, strttp and stpttr.
224 *
225 CALL SDRVRF2( NOUT, NN, NVAL, WORKA, NMAX, WORKARF,
226 + WORKAP, WORKASAV )
227 *
228 * Test the routine: stfsm
229 *
230 CALL SDRVRF3( NOUT, NN, NVAL, THRESH, WORKA, NMAX, WORKARF,
231 + WORKAINV, WORKAFAC, S_WORK_SLANSY,
232 + S_WORK_SPOT03, S_WORK_SPOT01 )
233 *
234 *
235 * Test the routine: ssfrk
236 *
237 CALL SDRVRF4( NOUT, NN, NVAL, THRESH, WORKA, WORKAFAC, NMAX,
238 + WORKARF, WORKAINV, NMAX, S_WORK_SLANSY)
239 *
240 CLOSE ( NIN )
241 S2 = SECOND( )
242 WRITE( NOUT, FMT = 9998 )
243 WRITE( NOUT, FMT = 9997 )S2 - S1
244 *
245 9999 FORMAT( / ' Execution not attempted due to input errors' )
246 9998 FORMAT( / ' End of tests' )
247 9997 FORMAT( ' Total time used = ', F12.2, ' seconds', / )
248 9996 FORMAT( ' !! Invalid input value: ', A4, '=', I6, '; must be >=',
249 $ I6 )
250 9995 FORMAT( ' !! Invalid input value: ', A4, '=', I6, '; must be <=',
251 $ I6 )
252 9994 FORMAT( / ' Tests of the REAL LAPACK RFP routines ',
253 $ / ' LAPACK VERSION ', I1, '.', I1, '.', I1,
254 $ / / ' The following parameter values will be used:' )
255 9993 FORMAT( 4X, A4, ': ', 10I6, / 11X, 10I6 )
256 9992 FORMAT( / ' Routines pass computational tests if test ratio is ',
257 $ 'less than', F8.2, / )
258 9991 FORMAT( ' Relative machine ', A, ' is taken to be', D16.6 )
259 *
260 * End of SCHKRFP
261 *
262 END
2 *
3 * -- LAPACK test routine (version 3.2.0) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * November 2008
6 *
7 * Purpose
8 * =======
9 *
10 * SCHKRFP is the main test program for the REAL linear
11 * equation routines with RFP storage format
12 *
13 *
14 * Internal Parameters
15 * ===================
16 *
17 * MAXIN INTEGER
18 * The number of different values that can be used for each of
19 * M, N, or NB
20 *
21 * MAXRHS INTEGER
22 * The maximum number of right hand sides
23 *
24 * NTYPES INTEGER
25 *
26 * NMAX INTEGER
27 * The maximum allowable value for N.
28 *
29 * NIN INTEGER
30 * The unit number for input
31 *
32 * NOUT INTEGER
33 * The unit number for output
34 *
35 * =====================================================================
36 *
37 * .. Parameters ..
38 INTEGER MAXIN
39 PARAMETER ( MAXIN = 12 )
40 INTEGER NMAX
41 PARAMETER ( NMAX = 50 )
42 INTEGER MAXRHS
43 PARAMETER ( MAXRHS = 16 )
44 INTEGER NTYPES
45 PARAMETER ( NTYPES = 9 )
46 INTEGER NIN, NOUT
47 PARAMETER ( NIN = 5, NOUT = 6 )
48 * ..
49 * .. Local Scalars ..
50 LOGICAL FATAL, TSTERR
51 INTEGER VERS_MAJOR, VERS_MINOR, VERS_PATCH
52 INTEGER I, NN, NNS, NNT
53 REAL EPS, S1, S2, THRESH
54 * ..
55 * .. Local Arrays ..
56 INTEGER NVAL( MAXIN ), NSVAL( MAXIN ), NTVAL( NTYPES )
57 REAL WORKA( NMAX, NMAX )
58 REAL WORKASAV( NMAX, NMAX )
59 REAL WORKB( NMAX, MAXRHS )
60 REAL WORKXACT( NMAX, MAXRHS )
61 REAL WORKBSAV( NMAX, MAXRHS )
62 REAL WORKX( NMAX, MAXRHS )
63 REAL WORKAFAC( NMAX, NMAX )
64 REAL WORKAINV( NMAX, NMAX )
65 REAL WORKARF( (NMAX*(NMAX+1))/2 )
66 REAL WORKAP( (NMAX*(NMAX+1))/2 )
67 REAL WORKARFINV( (NMAX*(NMAX+1))/2 )
68 REAL S_WORK_SLATMS( 3 * NMAX )
69 REAL S_WORK_SPOT01( NMAX )
70 REAL S_TEMP_SPOT02( NMAX, MAXRHS )
71 REAL S_TEMP_SPOT03( NMAX, NMAX )
72 REAL S_WORK_SLANSY( NMAX )
73 REAL S_WORK_SPOT02( NMAX )
74 REAL S_WORK_SPOT03( NMAX )
75 * ..
76 * .. External Functions ..
77 REAL SLAMCH, SECOND
78 EXTERNAL SLAMCH, SECOND
79 * ..
80 * .. External Subroutines ..
81 EXTERNAL ILAVER, SDRVRFP, SDRVRF1, SDRVRF2, SDRVRF3,
82 + SDRVRF4
83 * ..
84 * .. Executable Statements ..
85 *
86 S1 = SECOND( )
87 FATAL = .FALSE.
88 *
89 * Read a dummy line.
90 *
91 READ( NIN, FMT = * )
92 *
93 * Report LAPACK version tag (e.g. LAPACK-3.2.0)
94 *
95 CALL ILAVER( VERS_MAJOR, VERS_MINOR, VERS_PATCH )
96 WRITE( NOUT, FMT = 9994 ) VERS_MAJOR, VERS_MINOR, VERS_PATCH
97 *
98 * Read the values of N
99 *
100 READ( NIN, FMT = * )NN
101 IF( NN.LT.1 ) THEN
102 WRITE( NOUT, FMT = 9996 )' NN ', NN, 1
103 NN = 0
104 FATAL = .TRUE.
105 ELSE IF( NN.GT.MAXIN ) THEN
106 WRITE( NOUT, FMT = 9995 )' NN ', NN, MAXIN
107 NN = 0
108 FATAL = .TRUE.
109 END IF
110 READ( NIN, FMT = * )( NVAL( I ), I = 1, NN )
111 DO 10 I = 1, NN
112 IF( NVAL( I ).LT.0 ) THEN
113 WRITE( NOUT, FMT = 9996 )' M ', NVAL( I ), 0
114 FATAL = .TRUE.
115 ELSE IF( NVAL( I ).GT.NMAX ) THEN
116 WRITE( NOUT, FMT = 9995 )' M ', NVAL( I ), NMAX
117 FATAL = .TRUE.
118 END IF
119 10 CONTINUE
120 IF( NN.GT.0 )
121 $ WRITE( NOUT, FMT = 9993 )'N ', ( NVAL( I ), I = 1, NN )
122 *
123 * Read the values of NRHS
124 *
125 READ( NIN, FMT = * )NNS
126 IF( NNS.LT.1 ) THEN
127 WRITE( NOUT, FMT = 9996 )' NNS', NNS, 1
128 NNS = 0
129 FATAL = .TRUE.
130 ELSE IF( NNS.GT.MAXIN ) THEN
131 WRITE( NOUT, FMT = 9995 )' NNS', NNS, MAXIN
132 NNS = 0
133 FATAL = .TRUE.
134 END IF
135 READ( NIN, FMT = * )( NSVAL( I ), I = 1, NNS )
136 DO 30 I = 1, NNS
137 IF( NSVAL( I ).LT.0 ) THEN
138 WRITE( NOUT, FMT = 9996 )'NRHS', NSVAL( I ), 0
139 FATAL = .TRUE.
140 ELSE IF( NSVAL( I ).GT.MAXRHS ) THEN
141 WRITE( NOUT, FMT = 9995 )'NRHS', NSVAL( I ), MAXRHS
142 FATAL = .TRUE.
143 END IF
144 30 CONTINUE
145 IF( NNS.GT.0 )
146 $ WRITE( NOUT, FMT = 9993 )'NRHS', ( NSVAL( I ), I = 1, NNS )
147 *
148 * Read the matrix types
149 *
150 READ( NIN, FMT = * )NNT
151 IF( NNT.LT.1 ) THEN
152 WRITE( NOUT, FMT = 9996 )' NMA', NNT, 1
153 NNT = 0
154 FATAL = .TRUE.
155 ELSE IF( NNT.GT.NTYPES ) THEN
156 WRITE( NOUT, FMT = 9995 )' NMA', NNT, NTYPES
157 NNT = 0
158 FATAL = .TRUE.
159 END IF
160 READ( NIN, FMT = * )( NTVAL( I ), I = 1, NNT )
161 DO 320 I = 1, NNT
162 IF( NTVAL( I ).LT.0 ) THEN
163 WRITE( NOUT, FMT = 9996 )'TYPE', NTVAL( I ), 0
164 FATAL = .TRUE.
165 ELSE IF( NTVAL( I ).GT.NTYPES ) THEN
166 WRITE( NOUT, FMT = 9995 )'TYPE', NTVAL( I ), NTYPES
167 FATAL = .TRUE.
168 END IF
169 320 CONTINUE
170 IF( NNT.GT.0 )
171 $ WRITE( NOUT, FMT = 9993 )'TYPE', ( NTVAL( I ), I = 1, NNT )
172 *
173 * Read the threshold value for the test ratios.
174 *
175 READ( NIN, FMT = * )THRESH
176 WRITE( NOUT, FMT = 9992 )THRESH
177 *
178 * Read the flag that indicates whether to test the error exits.
179 *
180 READ( NIN, FMT = * )TSTERR
181 *
182 IF( FATAL ) THEN
183 WRITE( NOUT, FMT = 9999 )
184 STOP
185 END IF
186 *
187 IF( FATAL ) THEN
188 WRITE( NOUT, FMT = 9999 )
189 STOP
190 END IF
191 *
192 * Calculate and print the machine dependent constants.
193 *
194 EPS = SLAMCH( 'Underflow threshold' )
195 WRITE( NOUT, FMT = 9991 )'underflow', EPS
196 EPS = SLAMCH( 'Overflow threshold' )
197 WRITE( NOUT, FMT = 9991 )'overflow ', EPS
198 EPS = SLAMCH( 'Epsilon' )
199 WRITE( NOUT, FMT = 9991 )'precision', EPS
200 WRITE( NOUT, FMT = * )
201 *
202 * Test the error exit of:
203 *
204 IF( TSTERR )
205 $ CALL SERRRFP( NOUT )
206 *
207 * Test the routines: spftrf, spftri, spftrs (as in SDRVPO).
208 * This also tests the routines: stfsm, stftri, stfttr, strttf.
209 *
210 CALL SDRVRFP( NOUT, NN, NVAL, NNS, NSVAL, NNT, NTVAL, THRESH,
211 $ WORKA, WORKASAV, WORKAFAC, WORKAINV, WORKB,
212 $ WORKBSAV, WORKXACT, WORKX, WORKARF, WORKARFINV,
213 $ S_WORK_SLATMS, S_WORK_SPOT01, S_TEMP_SPOT02,
214 $ S_TEMP_SPOT03, S_WORK_SLANSY, S_WORK_SPOT02,
215 $ S_WORK_SPOT03 )
216 *
217 * Test the routine: slansf
218 *
219 CALL SDRVRF1( NOUT, NN, NVAL, THRESH, WORKA, NMAX, WORKARF,
220 + S_WORK_SLANSY )
221 *
222 * Test the convertion routines:
223 * stfttp, stpttf, stfttr, strttf, strttp and stpttr.
224 *
225 CALL SDRVRF2( NOUT, NN, NVAL, WORKA, NMAX, WORKARF,
226 + WORKAP, WORKASAV )
227 *
228 * Test the routine: stfsm
229 *
230 CALL SDRVRF3( NOUT, NN, NVAL, THRESH, WORKA, NMAX, WORKARF,
231 + WORKAINV, WORKAFAC, S_WORK_SLANSY,
232 + S_WORK_SPOT03, S_WORK_SPOT01 )
233 *
234 *
235 * Test the routine: ssfrk
236 *
237 CALL SDRVRF4( NOUT, NN, NVAL, THRESH, WORKA, WORKAFAC, NMAX,
238 + WORKARF, WORKAINV, NMAX, S_WORK_SLANSY)
239 *
240 CLOSE ( NIN )
241 S2 = SECOND( )
242 WRITE( NOUT, FMT = 9998 )
243 WRITE( NOUT, FMT = 9997 )S2 - S1
244 *
245 9999 FORMAT( / ' Execution not attempted due to input errors' )
246 9998 FORMAT( / ' End of tests' )
247 9997 FORMAT( ' Total time used = ', F12.2, ' seconds', / )
248 9996 FORMAT( ' !! Invalid input value: ', A4, '=', I6, '; must be >=',
249 $ I6 )
250 9995 FORMAT( ' !! Invalid input value: ', A4, '=', I6, '; must be <=',
251 $ I6 )
252 9994 FORMAT( / ' Tests of the REAL LAPACK RFP routines ',
253 $ / ' LAPACK VERSION ', I1, '.', I1, '.', I1,
254 $ / / ' The following parameter values will be used:' )
255 9993 FORMAT( 4X, A4, ': ', 10I6, / 11X, 10I6 )
256 9992 FORMAT( / ' Routines pass computational tests if test ratio is ',
257 $ 'less than', F8.2, / )
258 9991 FORMAT( ' Relative machine ', A, ' is taken to be', D16.6 )
259 *
260 * End of SCHKRFP
261 *
262 END