68 parameter( maxin = 12 )
70 parameter( nmax = 50 )
72 parameter( maxrhs = 16 )
74 parameter( ntypes = 9 )
76 parameter( nin = 5, nout = 6 )
80 INTEGER vers_major, vers_minor, vers_patch
81 INTEGER i, nn, nns, nnt
82 REAL eps, s1, s2, thresh
86 INTEGER nval( maxin ), nsval( maxin ), ntval( ntypes )
87 COMPLEX worka( nmax, nmax )
88 COMPLEX workasav( nmax, nmax )
89 COMPLEX workb( nmax, maxrhs )
90 COMPLEX workxact( nmax, maxrhs )
91 COMPLEX workbsav( nmax, maxrhs )
92 COMPLEX workx( nmax, maxrhs )
93 COMPLEX workafac( nmax, nmax )
94 COMPLEX workainv( nmax, nmax )
95 COMPLEX workarf( (nmax*(nmax+1))/2 )
96 COMPLEX workap( (nmax*(nmax+1))/2 )
97 COMPLEX workarfinv( (nmax*(nmax+1))/2 )
98 COMPLEX c_work_clatms( 3 * nmax )
99 COMPLEX c_work_cpot02( nmax, maxrhs )
100 COMPLEX c_work_cpot03( nmax, nmax )
101 REAL s_work_clatms( nmax )
102 REAL s_work_clanhe( nmax )
103 REAL s_work_cpot01( nmax )
104 REAL s_work_cpot02( nmax )
105 REAL s_work_cpot03( nmax )
126 CALL ilaver( vers_major, vers_minor, vers_patch )
127 WRITE( nout, fmt = 9994 ) vers_major, vers_minor, vers_patch
131 READ( nin, fmt = * )nn
133 WRITE( nout, fmt = 9996 )
' NN ', nn, 1
136 ELSE IF( nn.GT.maxin )
THEN
137 WRITE( nout, fmt = 9995 )
' NN ', nn, maxin
141 READ( nin, fmt = * )( nval( i ), i = 1, nn )
143 IF( nval( i ).LT.0 )
THEN
144 WRITE( nout, fmt = 9996 )
' M ', nval( i ), 0
146 ELSE IF( nval( i ).GT.nmax )
THEN
147 WRITE( nout, fmt = 9995 )
' M ', nval( i ), nmax
152 $
WRITE( nout, fmt = 9993 )
'N ', ( nval( i ), i = 1, nn )
156 READ( nin, fmt = * )nns
158 WRITE( nout, fmt = 9996 )
' NNS', nns, 1
161 ELSE IF( nns.GT.maxin )
THEN
162 WRITE( nout, fmt = 9995 )
' NNS', nns, maxin
166 READ( nin, fmt = * )( nsval( i ), i = 1, nns )
168 IF( nsval( i ).LT.0 )
THEN
169 WRITE( nout, fmt = 9996 )
'NRHS', nsval( i ), 0
171 ELSE IF( nsval( i ).GT.maxrhs )
THEN
172 WRITE( nout, fmt = 9995 )
'NRHS', nsval( i ), maxrhs
177 $
WRITE( nout, fmt = 9993 )
'NRHS', ( nsval( i ), i = 1, nns )
181 READ( nin, fmt = * )nnt
183 WRITE( nout, fmt = 9996 )
' NMA', nnt, 1
186 ELSE IF( nnt.GT.ntypes )
THEN
187 WRITE( nout, fmt = 9995 )
' NMA', nnt, ntypes
191 READ( nin, fmt = * )( ntval( i ), i = 1, nnt )
193 IF( ntval( i ).LT.0 )
THEN
194 WRITE( nout, fmt = 9996 )
'TYPE', ntval( i ), 0
196 ELSE IF( ntval( i ).GT.ntypes )
THEN
197 WRITE( nout, fmt = 9995 )
'TYPE', ntval( i ), ntypes
202 $
WRITE( nout, fmt = 9993 )
'TYPE', ( ntval( i ), i = 1, nnt )
206 READ( nin, fmt = * )thresh
207 WRITE( nout, fmt = 9992 )thresh
211 READ( nin, fmt = * )tsterr
214 WRITE( nout, fmt = 9999 )
220 eps =
slamch(
'Underflow threshold' )
221 WRITE( nout, fmt = 9991 )
'underflow', eps
222 eps =
slamch(
'Overflow threshold' )
223 WRITE( nout, fmt = 9991 )
'overflow ', eps
225 WRITE( nout, fmt = 9991 )
'precision', eps
226 WRITE( nout, fmt = * )
236 CALL cdrvrfp( nout, nn, nval, nns, nsval, nnt, ntval, thresh,
237 $ worka, workasav, workafac, workainv, workb,
238 $ workbsav, workxact, workx, workarf, workarfinv,
239 $ c_work_clatms, c_work_cpot02,
240 $ c_work_cpot03, s_work_clatms, s_work_clanhe,
241 $ s_work_cpot01, s_work_cpot02, s_work_cpot03 )
245 CALL cdrvrf1( nout, nn, nval, thresh, worka, nmax, workarf,
251 CALL cdrvrf2( nout, nn, nval, worka, nmax, workarf,
256 CALL cdrvrf3( nout, nn, nval, thresh, worka, nmax, workarf,
257 + workainv, workafac, s_work_clanhe,
258 + c_work_cpot03, c_work_cpot02 )
263 CALL cdrvrf4( nout, nn, nval, thresh, worka, workafac, nmax,
264 + workarf, workainv, nmax, s_work_clanhe)
268 WRITE( nout, fmt = 9998 )
269 WRITE( nout, fmt = 9997 )s2 - s1
271 9999
FORMAT( /
' Execution not attempted due to input errors' )
272 9998
FORMAT( /
' End of tests' )
273 9997
FORMAT(
' Total time used = ', f12.2,
' seconds', / )
274 9996
FORMAT(
' !! Invalid input value: ', a4,
'=', i6,
'; must be >=',
276 9995
FORMAT(
' !! Invalid input value: ', a4,
'=', i6,
'; must be <=',
278 9994
FORMAT( /
' Tests of the COMPLEX LAPACK RFP routines ',
279 $ /
' LAPACK VERSION ', i1,
'.', i1,
'.', i1,
280 $ / /
' The following parameter values will be used:' )
281 9993
FORMAT( 4x, a4,
': ', 10i6, / 11x, 10i6 )
282 9992
FORMAT( /
' Routines pass computational tests if test ratio is ',
283 $
'less than', f8.2, / )
284 9991
FORMAT(
' Relative machine ', a,
' is taken to be', d16.6 )
subroutine cdrvrf1(NOUT, NN, NVAL, THRESH, A, LDA, ARF, WORK)
CDRVRF1
subroutine cerrrfp(NUNIT)
CERRRFP
subroutine cdrvrfp(NOUT, NN, NVAL, NNS, NSVAL, NNT, NTVAL, THRESH, A, ASAV, AFAC, AINV, B, BSAV, XACT, X, ARF, ARFINV, C_WORK_CLATMS, C_WORK_CPOT02, C_WORK_CPOT03, S_WORK_CLATMS, S_WORK_CLANHE, S_WORK_CPOT01, S_WORK_CPOT02, S_WORK_CPOT03)
CDRVRFP
subroutine cdrvrf2(NOUT, NN, NVAL, A, LDA, ARF, AP, ASAV)
CDRVRF2
subroutine cdrvrf3(NOUT, NN, NVAL, THRESH, A, LDA, ARF, B1, B2, S_WORK_CLANGE, C_WORK_CGEQRF, TAU)
CDRVRF3
subroutine cdrvrf4(NOUT, NN, NVAL, THRESH, C1, C2, LDC, CRF, A, LDA, S_WORK_CLANGE)
CDRVRF4
subroutine ilaver(VERS_MAJOR, VERS_MINOR, VERS_PATCH)
ILAVER returns the LAPACK version.
real function second()
SECOND Using ETIME
real function slamch(CMACH)
SLAMCH