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 ddrvrf2(NOUT, NN, NVAL, A, LDA, ARF, AP, ASAV)
DDRVRF2
subroutine ddrvrf3(NOUT, NN, NVAL, THRESH, A, LDA, ARF, B1, B2, D_WORK_DLANGE, D_WORK_DGEQRF, TAU)
DDRVRF3
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 ddrvrf4(NOUT, NN, NVAL, THRESH, C1, C2, LDC, CRF, A, LDA, D_WORK_DLANGE)
DDRVRF4
subroutine ddrvrf1(NOUT, NN, NVAL, THRESH, A, LDA, ARF, WORK)
DDRVRF1
subroutine derrrfp(NUNIT)
DERRRFP
subroutine ilaver(VERS_MAJOR, VERS_MINOR, VERS_PATCH)
ILAVER returns the LAPACK version.