71 parameter( maxin = 12 )
73 parameter( nmax = 50 )
75 parameter( maxrhs = 16 )
77 parameter( ntypes = 9 )
79 parameter( nin = 5, nout = 6 )
83 INTEGER VERS_MAJOR, VERS_MINOR, VERS_PATCH
84 INTEGER I, NN, NNS, NNT
85 DOUBLE PRECISION EPS, S1, S2, THRESH
89 INTEGER NVAL( maxin ), NSVAL( maxin ), NTVAL( ntypes )
90 DOUBLE PRECISION WORKA( nmax, nmax )
91 DOUBLE PRECISION WORKASAV( nmax, nmax )
92 DOUBLE PRECISION WORKB( nmax, maxrhs )
93 DOUBLE PRECISION WORKXACT( nmax, maxrhs )
94 DOUBLE PRECISION WORKBSAV( nmax, maxrhs )
95 DOUBLE PRECISION WORKX( nmax, maxrhs )
96 DOUBLE PRECISION WORKAFAC( nmax, nmax )
97 DOUBLE PRECISION WORKAINV( nmax, nmax )
98 DOUBLE PRECISION WORKARF( (nmax*(nmax+1))/2 )
99 DOUBLE PRECISION WORKAP( (nmax*(nmax+1))/2 )
100 DOUBLE PRECISION WORKARFINV( (nmax*(nmax+1))/2 )
101 DOUBLE PRECISION D_WORK_DLATMS( 3 * nmax )
102 DOUBLE PRECISION D_WORK_DPOT01( nmax )
103 DOUBLE PRECISION D_TEMP_DPOT02( nmax, maxrhs )
104 DOUBLE PRECISION D_TEMP_DPOT03( nmax, nmax )
105 DOUBLE PRECISION D_WORK_DLANSY( nmax )
106 DOUBLE PRECISION D_WORK_DPOT02( nmax )
107 DOUBLE PRECISION D_WORK_DPOT03( nmax )
110 DOUBLE PRECISION DLAMCH, DSECND
111 EXTERNAL dlamch, dsecnd
128 CALL
ilaver( vers_major, vers_minor, vers_patch )
129 WRITE( nout, fmt = 9994 ) vers_major, vers_minor, vers_patch
133 READ( nin, fmt = * )nn
135 WRITE( nout, fmt = 9996 )
' NN ', nn, 1
138 ELSE IF( nn.GT.maxin )
THEN
139 WRITE( nout, fmt = 9995 )
' NN ', nn, maxin
143 READ( nin, fmt = * )( nval( i ), i = 1, nn )
145 IF( nval( i ).LT.0 )
THEN
146 WRITE( nout, fmt = 9996 )
' M ', nval( i ), 0
148 ELSE IF( nval( i ).GT.nmax )
THEN
149 WRITE( nout, fmt = 9995 )
' M ', nval( i ), nmax
154 $
WRITE( nout, fmt = 9993 )
'N ', ( nval( i ), i = 1, nn )
158 READ( nin, fmt = * )nns
160 WRITE( nout, fmt = 9996 )
' NNS', nns, 1
163 ELSE IF( nns.GT.maxin )
THEN
164 WRITE( nout, fmt = 9995 )
' NNS', nns, maxin
168 READ( nin, fmt = * )( nsval( i ), i = 1, nns )
170 IF( nsval( i ).LT.0 )
THEN
171 WRITE( nout, fmt = 9996 )
'NRHS', nsval( i ), 0
173 ELSE IF( nsval( i ).GT.maxrhs )
THEN
174 WRITE( nout, fmt = 9995 )
'NRHS', nsval( i ), maxrhs
179 $
WRITE( nout, fmt = 9993 )
'NRHS', ( nsval( i ), i = 1, nns )
183 READ( nin, fmt = * )nnt
185 WRITE( nout, fmt = 9996 )
' NMA', nnt, 1
188 ELSE IF( nnt.GT.ntypes )
THEN
189 WRITE( nout, fmt = 9995 )
' NMA', nnt, ntypes
193 READ( nin, fmt = * )( ntval( i ), i = 1, nnt )
195 IF( ntval( i ).LT.0 )
THEN
196 WRITE( nout, fmt = 9996 )
'TYPE', ntval( i ), 0
198 ELSE IF( ntval( i ).GT.ntypes )
THEN
199 WRITE( nout, fmt = 9995 )
'TYPE', ntval( i ), ntypes
204 $
WRITE( nout, fmt = 9993 )
'TYPE', ( ntval( i ), i = 1, nnt )
208 READ( nin, fmt = * )thresh
209 WRITE( nout, fmt = 9992 )thresh
213 READ( nin, fmt = * )tsterr
216 WRITE( nout, fmt = 9999 )
221 WRITE( nout, fmt = 9999 )
227 eps = dlamch(
'Underflow threshold' )
228 WRITE( nout, fmt = 9991 )
'underflow', eps
229 eps = dlamch(
'Overflow threshold' )
230 WRITE( nout, fmt = 9991 )
'overflow ', eps
231 eps = dlamch(
'Epsilon' )
232 WRITE( nout, fmt = 9991 )
'precision', eps
233 WRITE( nout, fmt = * )
243 CALL
ddrvrfp( nout, nn, nval, nns, nsval, nnt, ntval, thresh,
244 $ worka, workasav, workafac, workainv, workb,
245 $ workbsav, workxact, workx, workarf, workarfinv,
246 $ d_work_dlatms, d_work_dpot01, d_temp_dpot02,
247 $ d_temp_dpot03, d_work_dlansy, d_work_dpot02,
252 CALL
ddrvrf1( nout, nn, nval, thresh, worka, nmax, workarf,
258 CALL
ddrvrf2( nout, nn, nval, worka, nmax, workarf,
263 CALL
ddrvrf3( nout, nn, nval, thresh, worka, nmax, workarf,
264 + workainv, workafac, d_work_dlansy,
265 + d_work_dpot03, d_work_dpot01 )
270 CALL
ddrvrf4( nout, nn, nval, thresh, worka, workafac, nmax,
271 + workarf, workainv, nmax, d_work_dlansy)
275 WRITE( nout, fmt = 9998 )
276 WRITE( nout, fmt = 9997 )s2 - s1
278 9999
FORMAT( /
' Execution not attempted due to input errors' )
279 9998
FORMAT( /
' End of tests' )
280 9997
FORMAT(
' Total time used = ', f12.2,
' seconds', / )
281 9996
FORMAT(
' !! Invalid input value: ', a4,
'=', i6,
'; must be >=',
283 9995
FORMAT(
' !! Invalid input value: ', a4,
'=', i6,
'; must be <=',
285 9994
FORMAT( /
' Tests of the DOUBLE PRECISION LAPACK RFP routines ',
286 $ /
' LAPACK VERSION ', i1,
'.', i1,
'.', i1,
287 $ / /
' The following parameter values will be used:' )
288 9993
FORMAT( 4x, a4,
': ', 10i6, / 11x, 10i6 )
289 9992
FORMAT( /
' Routines pass computational tests if test ratio is ',
290 $
'less than', f8.2, / )
291 9991
FORMAT(
' Relative machine ', a,
' is taken to be', d16.6 )
subroutine ddrvrf3(NOUT, NN, NVAL, THRESH, A, LDA, ARF, B1, B2, D_WORK_DLANGE, D_WORK_DGEQRF, TAU)
DDRVRF3
subroutine derrrfp(NUNIT)
DERRRFP
subroutine ilaver(VERS_MAJOR, VERS_MINOR, VERS_PATCH)
ILAVER returns the LAPACK version.
subroutine ddrvrf1(NOUT, NN, NVAL, THRESH, A, LDA, ARF, WORK)
DDRVRF1
subroutine ddrvrfp(NOUT, NN, NVAL, NNS, NSVAL, NNT, NTVAL, THRESH, A, ASAV, AFAC, AINV, B, BSAV, XACT, X, ARF, ARFINV, D_WORK_DLATMS, D_WORK_DPOT01, D_TEMP_DPOT02, D_TEMP_DPOT03, D_WORK_DLANSY, D_WORK_DPOT02, D_WORK_DPOT03)
DDRVRFP
subroutine ddrvrf2(NOUT, NN, NVAL, A, LDA, ARF, AP, ASAV)
DDRVRF2
subroutine ddrvrf4(NOUT, NN, NVAL, THRESH, C1, C2, LDC, CRF, A, LDA, D_WORK_DLANGE)
DDRVRF4