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 )
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
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 )
real function second()
SECOND Using ETIME
subroutine ilaver(VERS_MAJOR, VERS_MINOR, VERS_PATCH)
ILAVER returns the LAPACK version.
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 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 sdrvrf2(NOUT, NN, NVAL, A, LDA, ARF, AP, ASAV)
SDRVRF2
subroutine serrrfp(NUNIT)
SERRRFP
real function slamch(CMACH)
SLAMCH
subroutine sdrvrf4(NOUT, NN, NVAL, THRESH, C1, C2, LDC, CRF, A, LDA, S_WORK_SLANGE)
SDRVRF4