1 PROGRAM CCHKRFP
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 * CCHKRFP is the main test program for the COMPLEX linear equation
12 * 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 REAL EPS, S1, S2, THRESH
55
56 * ..
57 * .. Local Arrays ..
58 INTEGER NVAL( MAXIN ), NSVAL( MAXIN ), NTVAL( NTYPES )
59 COMPLEX WORKA( NMAX, NMAX )
60 COMPLEX WORKASAV( NMAX, NMAX )
61 COMPLEX WORKB( NMAX, MAXRHS )
62 COMPLEX WORKXACT( NMAX, MAXRHS )
63 COMPLEX WORKBSAV( NMAX, MAXRHS )
64 COMPLEX WORKX( NMAX, MAXRHS )
65 COMPLEX WORKAFAC( NMAX, NMAX )
66 COMPLEX WORKAINV( NMAX, NMAX )
67 COMPLEX WORKARF( (NMAX*(NMAX+1))/2 )
68 COMPLEX WORKAP( (NMAX*(NMAX+1))/2 )
69 COMPLEX WORKARFINV( (NMAX*(NMAX+1))/2 )
70 COMPLEX C_WORK_CLATMS( 3 * NMAX )
71 COMPLEX C_WORK_CPOT02( NMAX, MAXRHS )
72 COMPLEX C_WORK_CPOT03( NMAX, NMAX )
73 REAL S_WORK_CLATMS( NMAX )
74 REAL S_WORK_CLANHE( NMAX )
75 REAL S_WORK_CPOT01( NMAX )
76 REAL S_WORK_CPOT02( NMAX )
77 REAL S_WORK_CPOT03( NMAX )
78 * ..
79 * .. External Functions ..
80 REAL SLAMCH, SECOND
81 EXTERNAL SLAMCH, SECOND
82 * ..
83 * .. External Subroutines ..
84 EXTERNAL ILAVER, CDRVRFP, CDRVRF1, CDRVRF2, CDRVRF3,
85 + CDRVRF4
86 * ..
87 * .. Executable Statements ..
88 *
89 S1 = SECOND( )
90 FATAL = .FALSE.
91 *
92 * Read a dummy line.
93 *
94 READ( NIN, FMT = * )
95 *
96 * Report LAPACK version tag (e.g. LAPACK-3.2.0)
97 *
98 CALL ILAVER( VERS_MAJOR, VERS_MINOR, VERS_PATCH )
99 WRITE( NOUT, FMT = 9994 ) VERS_MAJOR, VERS_MINOR, VERS_PATCH
100 *
101 * Read the values of N
102 *
103 READ( NIN, FMT = * )NN
104 IF( NN.LT.1 ) THEN
105 WRITE( NOUT, FMT = 9996 )' NN ', NN, 1
106 NN = 0
107 FATAL = .TRUE.
108 ELSE IF( NN.GT.MAXIN ) THEN
109 WRITE( NOUT, FMT = 9995 )' NN ', NN, MAXIN
110 NN = 0
111 FATAL = .TRUE.
112 END IF
113 READ( NIN, FMT = * )( NVAL( I ), I = 1, NN )
114 DO 10 I = 1, NN
115 IF( NVAL( I ).LT.0 ) THEN
116 WRITE( NOUT, FMT = 9996 )' M ', NVAL( I ), 0
117 FATAL = .TRUE.
118 ELSE IF( NVAL( I ).GT.NMAX ) THEN
119 WRITE( NOUT, FMT = 9995 )' M ', NVAL( I ), NMAX
120 FATAL = .TRUE.
121 END IF
122 10 CONTINUE
123 IF( NN.GT.0 )
124 $ WRITE( NOUT, FMT = 9993 )'N ', ( NVAL( I ), I = 1, NN )
125 *
126 * Read the values of NRHS
127 *
128 READ( NIN, FMT = * )NNS
129 IF( NNS.LT.1 ) THEN
130 WRITE( NOUT, FMT = 9996 )' NNS', NNS, 1
131 NNS = 0
132 FATAL = .TRUE.
133 ELSE IF( NNS.GT.MAXIN ) THEN
134 WRITE( NOUT, FMT = 9995 )' NNS', NNS, MAXIN
135 NNS = 0
136 FATAL = .TRUE.
137 END IF
138 READ( NIN, FMT = * )( NSVAL( I ), I = 1, NNS )
139 DO 30 I = 1, NNS
140 IF( NSVAL( I ).LT.0 ) THEN
141 WRITE( NOUT, FMT = 9996 )'NRHS', NSVAL( I ), 0
142 FATAL = .TRUE.
143 ELSE IF( NSVAL( I ).GT.MAXRHS ) THEN
144 WRITE( NOUT, FMT = 9995 )'NRHS', NSVAL( I ), MAXRHS
145 FATAL = .TRUE.
146 END IF
147 30 CONTINUE
148 IF( NNS.GT.0 )
149 $ WRITE( NOUT, FMT = 9993 )'NRHS', ( NSVAL( I ), I = 1, NNS )
150 *
151 * Read the matrix types
152 *
153 READ( NIN, FMT = * )NNT
154 IF( NNT.LT.1 ) THEN
155 WRITE( NOUT, FMT = 9996 )' NMA', NNT, 1
156 NNT = 0
157 FATAL = .TRUE.
158 ELSE IF( NNT.GT.NTYPES ) THEN
159 WRITE( NOUT, FMT = 9995 )' NMA', NNT, NTYPES
160 NNT = 0
161 FATAL = .TRUE.
162 END IF
163 READ( NIN, FMT = * )( NTVAL( I ), I = 1, NNT )
164 DO 320 I = 1, NNT
165 IF( NTVAL( I ).LT.0 ) THEN
166 WRITE( NOUT, FMT = 9996 )'TYPE', NTVAL( I ), 0
167 FATAL = .TRUE.
168 ELSE IF( NTVAL( I ).GT.NTYPES ) THEN
169 WRITE( NOUT, FMT = 9995 )'TYPE', NTVAL( I ), NTYPES
170 FATAL = .TRUE.
171 END IF
172 320 CONTINUE
173 IF( NNT.GT.0 )
174 $ WRITE( NOUT, FMT = 9993 )'TYPE', ( NTVAL( I ), I = 1, NNT )
175 *
176 * Read the threshold value for the test ratios.
177 *
178 READ( NIN, FMT = * )THRESH
179 WRITE( NOUT, FMT = 9992 )THRESH
180 *
181 * Read the flag that indicates whether to test the error exits.
182 *
183 READ( NIN, FMT = * )TSTERR
184 *
185 IF( FATAL ) THEN
186 WRITE( NOUT, FMT = 9999 )
187 STOP
188 END IF
189 *
190 IF( FATAL ) THEN
191 WRITE( NOUT, FMT = 9999 )
192 STOP
193 END IF
194 *
195 * Calculate and print the machine dependent constants.
196 *
197 EPS = SLAMCH( 'Underflow threshold' )
198 WRITE( NOUT, FMT = 9991 )'underflow', EPS
199 EPS = SLAMCH( 'Overflow threshold' )
200 WRITE( NOUT, FMT = 9991 )'overflow ', EPS
201 EPS = SLAMCH( 'Epsilon' )
202 WRITE( NOUT, FMT = 9991 )'precision', EPS
203 WRITE( NOUT, FMT = * )
204 *
205 * Test the error exit of:
206 *
207 IF( TSTERR )
208 $ CALL CERRRFP( NOUT )
209 *
210 * Test the routines: cpftrf, cpftri, cpftrs (as in CDRVPO).
211 * This also tests the routines: ctfsm, ctftri, ctfttr, ctrttf.
212 *
213 CALL CDRVRFP( NOUT, NN, NVAL, NNS, NSVAL, NNT, NTVAL, THRESH,
214 $ WORKA, WORKASAV, WORKAFAC, WORKAINV, WORKB,
215 $ WORKBSAV, WORKXACT, WORKX, WORKARF, WORKARFINV,
216 $ C_WORK_CLATMS, C_WORK_CPOT02,
217 $ C_WORK_CPOT03, S_WORK_CLATMS, S_WORK_CLANHE,
218 $ S_WORK_CPOT01, S_WORK_CPOT02, S_WORK_CPOT03 )
219 *
220 * Test the routine: clanhf
221 *
222 CALL CDRVRF1( NOUT, NN, NVAL, THRESH, WORKA, NMAX, WORKARF,
223 + S_WORK_CLANHE )
224 *
225 * Test the convertion routines:
226 * chfttp, ctpthf, ctfttr, ctrttf, ctrttp and ctpttr.
227 *
228 CALL CDRVRF2( NOUT, NN, NVAL, WORKA, NMAX, WORKARF,
229 + WORKAP, WORKASAV )
230 *
231 * Test the routine: ctfsm
232 *
233 CALL CDRVRF3( NOUT, NN, NVAL, THRESH, WORKA, NMAX, WORKARF,
234 + WORKAINV, WORKAFAC, S_WORK_CLANHE,
235 + C_WORK_CPOT03, C_WORK_CPOT02 )
236 *
237 *
238 * Test the routine: chfrk
239 *
240 CALL CDRVRF4( NOUT, NN, NVAL, THRESH, WORKA, WORKAFAC, NMAX,
241 + WORKARF, WORKAINV, NMAX, S_WORK_CLANHE)
242 *
243 CLOSE ( NIN )
244 S2 = SECOND( )
245 WRITE( NOUT, FMT = 9998 )
246 WRITE( NOUT, FMT = 9997 )S2 - S1
247 *
248 9999 FORMAT( / ' Execution not attempted due to input errors' )
249 9998 FORMAT( / ' End of tests' )
250 9997 FORMAT( ' Total time used = ', F12.2, ' seconds', / )
251 9996 FORMAT( ' !! Invalid input value: ', A4, '=', I6, '; must be >=',
252 $ I6 )
253 9995 FORMAT( ' !! Invalid input value: ', A4, '=', I6, '; must be <=',
254 $ I6 )
255 9994 FORMAT( / ' Tests of the COMPLEX LAPACK RFP routines ',
256 $ / ' LAPACK VERSION ', I1, '.', I1, '.', I1,
257 $ / / ' The following parameter values will be used:' )
258 9993 FORMAT( 4X, A4, ': ', 10I6, / 11X, 10I6 )
259 9992 FORMAT( / ' Routines pass computational tests if test ratio is ',
260 $ 'less than', F8.2, / )
261 9991 FORMAT( ' Relative machine ', A, ' is taken to be', D16.6 )
262 *
263 * End of CCHKRFP
264 *
265 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 * CCHKRFP is the main test program for the COMPLEX linear equation
12 * 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 REAL EPS, S1, S2, THRESH
55
56 * ..
57 * .. Local Arrays ..
58 INTEGER NVAL( MAXIN ), NSVAL( MAXIN ), NTVAL( NTYPES )
59 COMPLEX WORKA( NMAX, NMAX )
60 COMPLEX WORKASAV( NMAX, NMAX )
61 COMPLEX WORKB( NMAX, MAXRHS )
62 COMPLEX WORKXACT( NMAX, MAXRHS )
63 COMPLEX WORKBSAV( NMAX, MAXRHS )
64 COMPLEX WORKX( NMAX, MAXRHS )
65 COMPLEX WORKAFAC( NMAX, NMAX )
66 COMPLEX WORKAINV( NMAX, NMAX )
67 COMPLEX WORKARF( (NMAX*(NMAX+1))/2 )
68 COMPLEX WORKAP( (NMAX*(NMAX+1))/2 )
69 COMPLEX WORKARFINV( (NMAX*(NMAX+1))/2 )
70 COMPLEX C_WORK_CLATMS( 3 * NMAX )
71 COMPLEX C_WORK_CPOT02( NMAX, MAXRHS )
72 COMPLEX C_WORK_CPOT03( NMAX, NMAX )
73 REAL S_WORK_CLATMS( NMAX )
74 REAL S_WORK_CLANHE( NMAX )
75 REAL S_WORK_CPOT01( NMAX )
76 REAL S_WORK_CPOT02( NMAX )
77 REAL S_WORK_CPOT03( NMAX )
78 * ..
79 * .. External Functions ..
80 REAL SLAMCH, SECOND
81 EXTERNAL SLAMCH, SECOND
82 * ..
83 * .. External Subroutines ..
84 EXTERNAL ILAVER, CDRVRFP, CDRVRF1, CDRVRF2, CDRVRF3,
85 + CDRVRF4
86 * ..
87 * .. Executable Statements ..
88 *
89 S1 = SECOND( )
90 FATAL = .FALSE.
91 *
92 * Read a dummy line.
93 *
94 READ( NIN, FMT = * )
95 *
96 * Report LAPACK version tag (e.g. LAPACK-3.2.0)
97 *
98 CALL ILAVER( VERS_MAJOR, VERS_MINOR, VERS_PATCH )
99 WRITE( NOUT, FMT = 9994 ) VERS_MAJOR, VERS_MINOR, VERS_PATCH
100 *
101 * Read the values of N
102 *
103 READ( NIN, FMT = * )NN
104 IF( NN.LT.1 ) THEN
105 WRITE( NOUT, FMT = 9996 )' NN ', NN, 1
106 NN = 0
107 FATAL = .TRUE.
108 ELSE IF( NN.GT.MAXIN ) THEN
109 WRITE( NOUT, FMT = 9995 )' NN ', NN, MAXIN
110 NN = 0
111 FATAL = .TRUE.
112 END IF
113 READ( NIN, FMT = * )( NVAL( I ), I = 1, NN )
114 DO 10 I = 1, NN
115 IF( NVAL( I ).LT.0 ) THEN
116 WRITE( NOUT, FMT = 9996 )' M ', NVAL( I ), 0
117 FATAL = .TRUE.
118 ELSE IF( NVAL( I ).GT.NMAX ) THEN
119 WRITE( NOUT, FMT = 9995 )' M ', NVAL( I ), NMAX
120 FATAL = .TRUE.
121 END IF
122 10 CONTINUE
123 IF( NN.GT.0 )
124 $ WRITE( NOUT, FMT = 9993 )'N ', ( NVAL( I ), I = 1, NN )
125 *
126 * Read the values of NRHS
127 *
128 READ( NIN, FMT = * )NNS
129 IF( NNS.LT.1 ) THEN
130 WRITE( NOUT, FMT = 9996 )' NNS', NNS, 1
131 NNS = 0
132 FATAL = .TRUE.
133 ELSE IF( NNS.GT.MAXIN ) THEN
134 WRITE( NOUT, FMT = 9995 )' NNS', NNS, MAXIN
135 NNS = 0
136 FATAL = .TRUE.
137 END IF
138 READ( NIN, FMT = * )( NSVAL( I ), I = 1, NNS )
139 DO 30 I = 1, NNS
140 IF( NSVAL( I ).LT.0 ) THEN
141 WRITE( NOUT, FMT = 9996 )'NRHS', NSVAL( I ), 0
142 FATAL = .TRUE.
143 ELSE IF( NSVAL( I ).GT.MAXRHS ) THEN
144 WRITE( NOUT, FMT = 9995 )'NRHS', NSVAL( I ), MAXRHS
145 FATAL = .TRUE.
146 END IF
147 30 CONTINUE
148 IF( NNS.GT.0 )
149 $ WRITE( NOUT, FMT = 9993 )'NRHS', ( NSVAL( I ), I = 1, NNS )
150 *
151 * Read the matrix types
152 *
153 READ( NIN, FMT = * )NNT
154 IF( NNT.LT.1 ) THEN
155 WRITE( NOUT, FMT = 9996 )' NMA', NNT, 1
156 NNT = 0
157 FATAL = .TRUE.
158 ELSE IF( NNT.GT.NTYPES ) THEN
159 WRITE( NOUT, FMT = 9995 )' NMA', NNT, NTYPES
160 NNT = 0
161 FATAL = .TRUE.
162 END IF
163 READ( NIN, FMT = * )( NTVAL( I ), I = 1, NNT )
164 DO 320 I = 1, NNT
165 IF( NTVAL( I ).LT.0 ) THEN
166 WRITE( NOUT, FMT = 9996 )'TYPE', NTVAL( I ), 0
167 FATAL = .TRUE.
168 ELSE IF( NTVAL( I ).GT.NTYPES ) THEN
169 WRITE( NOUT, FMT = 9995 )'TYPE', NTVAL( I ), NTYPES
170 FATAL = .TRUE.
171 END IF
172 320 CONTINUE
173 IF( NNT.GT.0 )
174 $ WRITE( NOUT, FMT = 9993 )'TYPE', ( NTVAL( I ), I = 1, NNT )
175 *
176 * Read the threshold value for the test ratios.
177 *
178 READ( NIN, FMT = * )THRESH
179 WRITE( NOUT, FMT = 9992 )THRESH
180 *
181 * Read the flag that indicates whether to test the error exits.
182 *
183 READ( NIN, FMT = * )TSTERR
184 *
185 IF( FATAL ) THEN
186 WRITE( NOUT, FMT = 9999 )
187 STOP
188 END IF
189 *
190 IF( FATAL ) THEN
191 WRITE( NOUT, FMT = 9999 )
192 STOP
193 END IF
194 *
195 * Calculate and print the machine dependent constants.
196 *
197 EPS = SLAMCH( 'Underflow threshold' )
198 WRITE( NOUT, FMT = 9991 )'underflow', EPS
199 EPS = SLAMCH( 'Overflow threshold' )
200 WRITE( NOUT, FMT = 9991 )'overflow ', EPS
201 EPS = SLAMCH( 'Epsilon' )
202 WRITE( NOUT, FMT = 9991 )'precision', EPS
203 WRITE( NOUT, FMT = * )
204 *
205 * Test the error exit of:
206 *
207 IF( TSTERR )
208 $ CALL CERRRFP( NOUT )
209 *
210 * Test the routines: cpftrf, cpftri, cpftrs (as in CDRVPO).
211 * This also tests the routines: ctfsm, ctftri, ctfttr, ctrttf.
212 *
213 CALL CDRVRFP( NOUT, NN, NVAL, NNS, NSVAL, NNT, NTVAL, THRESH,
214 $ WORKA, WORKASAV, WORKAFAC, WORKAINV, WORKB,
215 $ WORKBSAV, WORKXACT, WORKX, WORKARF, WORKARFINV,
216 $ C_WORK_CLATMS, C_WORK_CPOT02,
217 $ C_WORK_CPOT03, S_WORK_CLATMS, S_WORK_CLANHE,
218 $ S_WORK_CPOT01, S_WORK_CPOT02, S_WORK_CPOT03 )
219 *
220 * Test the routine: clanhf
221 *
222 CALL CDRVRF1( NOUT, NN, NVAL, THRESH, WORKA, NMAX, WORKARF,
223 + S_WORK_CLANHE )
224 *
225 * Test the convertion routines:
226 * chfttp, ctpthf, ctfttr, ctrttf, ctrttp and ctpttr.
227 *
228 CALL CDRVRF2( NOUT, NN, NVAL, WORKA, NMAX, WORKARF,
229 + WORKAP, WORKASAV )
230 *
231 * Test the routine: ctfsm
232 *
233 CALL CDRVRF3( NOUT, NN, NVAL, THRESH, WORKA, NMAX, WORKARF,
234 + WORKAINV, WORKAFAC, S_WORK_CLANHE,
235 + C_WORK_CPOT03, C_WORK_CPOT02 )
236 *
237 *
238 * Test the routine: chfrk
239 *
240 CALL CDRVRF4( NOUT, NN, NVAL, THRESH, WORKA, WORKAFAC, NMAX,
241 + WORKARF, WORKAINV, NMAX, S_WORK_CLANHE)
242 *
243 CLOSE ( NIN )
244 S2 = SECOND( )
245 WRITE( NOUT, FMT = 9998 )
246 WRITE( NOUT, FMT = 9997 )S2 - S1
247 *
248 9999 FORMAT( / ' Execution not attempted due to input errors' )
249 9998 FORMAT( / ' End of tests' )
250 9997 FORMAT( ' Total time used = ', F12.2, ' seconds', / )
251 9996 FORMAT( ' !! Invalid input value: ', A4, '=', I6, '; must be >=',
252 $ I6 )
253 9995 FORMAT( ' !! Invalid input value: ', A4, '=', I6, '; must be <=',
254 $ I6 )
255 9994 FORMAT( / ' Tests of the COMPLEX LAPACK RFP routines ',
256 $ / ' LAPACK VERSION ', I1, '.', I1, '.', I1,
257 $ / / ' The following parameter values will be used:' )
258 9993 FORMAT( 4X, A4, ': ', 10I6, / 11X, 10I6 )
259 9992 FORMAT( / ' Routines pass computational tests if test ratio is ',
260 $ 'less than', F8.2, / )
261 9991 FORMAT( ' Relative machine ', A, ' is taken to be', D16.6 )
262 *
263 * End of CCHKRFP
264 *
265 END