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