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 REAL EPS, S1, S2, THRESH
88 INTEGER NVAL( maxin ), NSVAL( maxin ), NTVAL( ntypes )
89 REAL WORKA( nmax, nmax )
90 REAL WORKASAV( nmax, nmax )
91 REAL WORKB( nmax, maxrhs )
92 REAL WORKXACT( nmax, maxrhs )
93 REAL WORKBSAV( nmax, maxrhs )
94 REAL WORKX( nmax, maxrhs )
95 REAL WORKAFAC( nmax, nmax )
96 REAL WORKAINV( nmax, nmax )
97 REAL WORKARF( (nmax*(nmax+1))/2 )
98 REAL WORKAP( (nmax*(nmax+1))/2 )
99 REAL WORKARFINV( (nmax*(nmax+1))/2 )
100 REAL S_WORK_SLATMS( 3 * nmax )
101 REAL S_WORK_SPOT01( nmax )
102 REAL S_TEMP_SPOT02( nmax, maxrhs )
103 REAL S_TEMP_SPOT03( nmax, nmax )
104 REAL S_WORK_SLANSY( nmax )
105 REAL S_WORK_SPOT02( nmax )
106 REAL S_WORK_SPOT03( nmax )
110 EXTERNAL slamch, second
127 CALL ilaver( vers_major, vers_minor, vers_patch )
128 WRITE( nout, fmt = 9994 ) vers_major, vers_minor, vers_patch
132 READ( nin, fmt = * )nn
134 WRITE( nout, fmt = 9996 )
' NN ', nn, 1
137 ELSE IF( nn.GT.maxin )
THEN
138 WRITE( nout, fmt = 9995 )
' NN ', nn, maxin
142 READ( nin, fmt = * )( nval( i ), i = 1, nn )
144 IF( nval( i ).LT.0 )
THEN
145 WRITE( nout, fmt = 9996 )
' M ', nval( i ), 0
147 ELSE IF( nval( i ).GT.nmax )
THEN
148 WRITE( nout, fmt = 9995 )
' M ', nval( i ), nmax
153 $
WRITE( nout, fmt = 9993 )
'N ', ( nval( i ), i = 1, nn )
157 READ( nin, fmt = * )nns
159 WRITE( nout, fmt = 9996 )
' NNS', nns, 1
162 ELSE IF( nns.GT.maxin )
THEN
163 WRITE( nout, fmt = 9995 )
' NNS', nns, maxin
167 READ( nin, fmt = * )( nsval( i ), i = 1, nns )
169 IF( nsval( i ).LT.0 )
THEN
170 WRITE( nout, fmt = 9996 )
'NRHS', nsval( i ), 0
172 ELSE IF( nsval( i ).GT.maxrhs )
THEN
173 WRITE( nout, fmt = 9995 )
'NRHS', nsval( i ), maxrhs
178 $
WRITE( nout, fmt = 9993 )
'NRHS', ( nsval( i ), i = 1, nns )
182 READ( nin, fmt = * )nnt
184 WRITE( nout, fmt = 9996 )
' NMA', nnt, 1
187 ELSE IF( nnt.GT.ntypes )
THEN
188 WRITE( nout, fmt = 9995 )
' NMA', nnt, ntypes
192 READ( nin, fmt = * )( ntval( i ), i = 1, nnt )
194 IF( ntval( i ).LT.0 )
THEN
195 WRITE( nout, fmt = 9996 )
'TYPE', ntval( i ), 0
197 ELSE IF( ntval( i ).GT.ntypes )
THEN
198 WRITE( nout, fmt = 9995 )
'TYPE', ntval( i ), ntypes
203 $
WRITE( nout, fmt = 9993 )
'TYPE', ( ntval( i ), i = 1, nnt )
207 READ( nin, fmt = * )thresh
208 WRITE( nout, fmt = 9992 )thresh
212 READ( nin, fmt = * )tsterr
215 WRITE( nout, fmt = 9999 )
220 WRITE( nout, fmt = 9999 )
226 eps = slamch(
'Underflow threshold' )
227 WRITE( nout, fmt = 9991 )
'underflow', eps
228 eps = slamch(
'Overflow threshold' )
229 WRITE( nout, fmt = 9991 )
'overflow ', eps
230 eps = slamch(
'Epsilon' )
231 WRITE( nout, fmt = 9991 )
'precision', eps
232 WRITE( nout, fmt = * )
242 CALL sdrvrfp( nout, nn, nval, nns, nsval, nnt, ntval, thresh,
243 $ worka, workasav, workafac, workainv, workb,
244 $ workbsav, workxact, workx, workarf, workarfinv,
245 $ s_work_slatms, s_work_spot01, s_temp_spot02,
246 $ s_temp_spot03, s_work_slansy, s_work_spot02,
251 CALL sdrvrf1( nout, nn, nval, thresh, worka, nmax, workarf,
257 CALL sdrvrf2( nout, nn, nval, worka, nmax, workarf,
262 CALL sdrvrf3( nout, nn, nval, thresh, worka, nmax, workarf,
263 + workainv, workafac, s_work_slansy,
264 + s_work_spot03, s_work_spot01 )
269 CALL sdrvrf4( nout, nn, nval, thresh, worka, workafac, nmax,
270 + workarf, workainv, nmax, s_work_slansy)
274 WRITE( nout, fmt = 9998 )
275 WRITE( nout, fmt = 9997 )s2 - s1
277 9999
FORMAT( /
' Execution not attempted due to input errors' )
278 9998
FORMAT( /
' End of tests' )
279 9997
FORMAT(
' Total time used = ', f12.2,
' seconds', / )
280 9996
FORMAT(
' !! Invalid input value: ', a4,
'=', i6,
'; must be >=',
282 9995
FORMAT(
' !! Invalid input value: ', a4,
'=', i6,
'; must be <=',
284 9994
FORMAT( /
' Tests of the REAL LAPACK RFP routines ',
285 $ /
' LAPACK VERSION ', i1,
'.', i1,
'.', i1,
286 $ / /
' The following parameter values will be used:' )
287 9993
FORMAT( 4x, a4,
': ', 10i6, / 11x, 10i6 )
288 9992
FORMAT( /
' Routines pass computational tests if test ratio is ',
289 $
'less than', f8.2, / )
290 9991
FORMAT(
' Relative machine ', a,
' is taken to be', d16.6 )
subroutine sdrvrf2(NOUT, NN, NVAL, A, LDA, ARF, AP, ASAV)
SDRVRF2
subroutine sdrvrf3(NOUT, NN, NVAL, THRESH, A, LDA, ARF, B1, B2, S_WORK_SLANGE, S_WORK_SGEQRF, TAU)
SDRVRF3
subroutine sdrvrf1(NOUT, NN, NVAL, THRESH, A, LDA, ARF, WORK)
SDRVRF1
subroutine sdrvrfp(NOUT, NN, NVAL, NNS, NSVAL, NNT, NTVAL, THRESH, A, ASAV, AFAC, AINV, B, BSAV, XACT, X, ARF, ARFINV, S_WORK_SLATMS, S_WORK_SPOT01, S_TEMP_SPOT02, S_TEMP_SPOT03, S_WORK_SLANSY, S_WORK_SPOT02, S_WORK_SPOT03)
SDRVRFP
subroutine serrrfp(NUNIT)
SERRRFP
subroutine sdrvrf4(NOUT, NN, NVAL, THRESH, C1, C2, LDC, CRF, A, LDA, S_WORK_SLANGE)
SDRVRF4
subroutine ilaver(VERS_MAJOR, VERS_MINOR, VERS_PATCH)
ILAVER returns the LAPACK version.