LAPACK 3.11.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ cdrvrf1()

subroutine cdrvrf1 ( integer  NOUT,
integer  NN,
integer, dimension( nn )  NVAL,
real  THRESH,
complex, dimension( lda, * )  A,
integer  LDA,
complex, dimension( * )  ARF,
real, dimension( * )  WORK 
)

CDRVRF1

Purpose:
 CDRVRF1 tests the LAPACK RFP routines:
     CLANHF.F
Parameters
[in]NOUT
          NOUT is INTEGER
                The unit number for output.
[in]NN
          NN is INTEGER
                The number of values of N contained in the vector NVAL.
[in]NVAL
          NVAL is INTEGER array, dimension (NN)
                The values of the matrix dimension N.
[in]THRESH
          THRESH is REAL
                The threshold value for the test ratios.  A result is
                included in the output file if RESULT >= THRESH.  To have
                every test ratio printed, use THRESH = 0.
[out]A
          A is COMPLEX array, dimension (LDA,NMAX)
[in]LDA
          LDA is INTEGER
                The leading dimension of the array A.  LDA >= max(1,NMAX).
[out]ARF
          ARF is COMPLEX array, dimension ((NMAX*(NMAX+1))/2).
[out]WORK
          WORK is COMPLEX array, dimension ( NMAX )
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 94 of file cdrvrf1.f.

95*
96* -- LAPACK test routine --
97* -- LAPACK is a software package provided by Univ. of Tennessee, --
98* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
99*
100* .. Scalar Arguments ..
101 INTEGER LDA, NN, NOUT
102 REAL THRESH
103* ..
104* .. Array Arguments ..
105 INTEGER NVAL( NN )
106 REAL WORK( * )
107 COMPLEX A( LDA, * ), ARF( * )
108* ..
109*
110* =====================================================================
111* ..
112* .. Parameters ..
113 REAL ONE
114 parameter( one = 1.0e+0 )
115 INTEGER NTESTS
116 parameter( ntests = 1 )
117* ..
118* .. Local Scalars ..
119 CHARACTER UPLO, CFORM, NORM
120 INTEGER I, IFORM, IIN, IIT, INFO, INORM, IUPLO, J, N,
121 + NERRS, NFAIL, NRUN
122 REAL EPS, LARGE, NORMA, NORMARF, SMALL
123* ..
124* .. Local Arrays ..
125 CHARACTER UPLOS( 2 ), FORMS( 2 ), NORMS( 4 )
126 INTEGER ISEED( 4 ), ISEEDY( 4 )
127 REAL RESULT( NTESTS )
128* ..
129* .. External Functions ..
130 COMPLEX CLARND
131 REAL SLAMCH, CLANHE, CLANHF
132 EXTERNAL slamch, clarnd, clanhe, clanhf
133* ..
134* .. External Subroutines ..
135 EXTERNAL ctrttf
136* ..
137* .. Scalars in Common ..
138 CHARACTER*32 SRNAMT
139* ..
140* .. Common blocks ..
141 COMMON / srnamc / srnamt
142* ..
143* .. Data statements ..
144 DATA iseedy / 1988, 1989, 1990, 1991 /
145 DATA uplos / 'U', 'L' /
146 DATA forms / 'N', 'C' /
147 DATA norms / 'M', '1', 'I', 'F' /
148* ..
149* .. Executable Statements ..
150*
151* Initialize constants and the random number seed.
152*
153 nrun = 0
154 nfail = 0
155 nerrs = 0
156 info = 0
157 DO 10 i = 1, 4
158 iseed( i ) = iseedy( i )
159 10 CONTINUE
160*
161 eps = slamch( 'Precision' )
162 small = slamch( 'Safe minimum' )
163 large = one / small
164 small = small * lda * lda
165 large = large / lda / lda
166*
167 DO 130 iin = 1, nn
168*
169 n = nval( iin )
170*
171 DO 120 iit = 1, 3
172* Nothing to do for N=0
173 IF ( n .EQ. 0 ) EXIT
174*
175* IIT = 1 : random matrix
176* IIT = 2 : random matrix scaled near underflow
177* IIT = 3 : random matrix scaled near overflow
178*
179 DO j = 1, n
180 DO i = 1, n
181 a( i, j) = clarnd( 4, iseed )
182 END DO
183 END DO
184*
185 IF ( iit.EQ.2 ) THEN
186 DO j = 1, n
187 DO i = 1, n
188 a( i, j) = a( i, j ) * large
189 END DO
190 END DO
191 END IF
192*
193 IF ( iit.EQ.3 ) THEN
194 DO j = 1, n
195 DO i = 1, n
196 a( i, j) = a( i, j) * small
197 END DO
198 END DO
199 END IF
200*
201* Do first for UPLO = 'U', then for UPLO = 'L'
202*
203 DO 110 iuplo = 1, 2
204*
205 uplo = uplos( iuplo )
206*
207* Do first for CFORM = 'N', then for CFORM = 'C'
208*
209 DO 100 iform = 1, 2
210*
211 cform = forms( iform )
212*
213 srnamt = 'CTRTTF'
214 CALL ctrttf( cform, uplo, n, a, lda, arf, info )
215*
216* Check error code from CTRTTF
217*
218 IF( info.NE.0 ) THEN
219 IF( nfail.EQ.0 .AND. nerrs.EQ.0 ) THEN
220 WRITE( nout, * )
221 WRITE( nout, fmt = 9999 )
222 END IF
223 WRITE( nout, fmt = 9998 ) srnamt, uplo, cform, n
224 nerrs = nerrs + 1
225 GO TO 100
226 END IF
227*
228 DO 90 inorm = 1, 4
229*
230* Check all four norms: 'M', '1', 'I', 'F'
231*
232 norm = norms( inorm )
233 normarf = clanhf( norm, cform, uplo, n, arf, work )
234 norma = clanhe( norm, uplo, n, a, lda, work )
235*
236 result(1) = ( norma - normarf ) / norma / eps
237 nrun = nrun + 1
238*
239 IF( result(1).GE.thresh ) THEN
240 IF( nfail.EQ.0 .AND. nerrs.EQ.0 ) THEN
241 WRITE( nout, * )
242 WRITE( nout, fmt = 9999 )
243 END IF
244 WRITE( nout, fmt = 9997 ) 'CLANHF',
245 + n, iit, uplo, cform, norm, result(1)
246 nfail = nfail + 1
247 END IF
248 90 CONTINUE
249 100 CONTINUE
250 110 CONTINUE
251 120 CONTINUE
252 130 CONTINUE
253*
254* Print a summary of the results.
255*
256 IF ( nfail.EQ.0 ) THEN
257 WRITE( nout, fmt = 9996 )'CLANHF', nrun
258 ELSE
259 WRITE( nout, fmt = 9995 ) 'CLANHF', nfail, nrun
260 END IF
261 IF ( nerrs.NE.0 ) THEN
262 WRITE( nout, fmt = 9994 ) nerrs, 'CLANHF'
263 END IF
264*
265 9999 FORMAT( 1x, ' *** Error(s) or Failure(s) while testing CLANHF
266 + ***')
267 9998 FORMAT( 1x, ' Error in ',a6,' with UPLO=''',a1,''', FORM=''',
268 + a1,''', N=',i5)
269 9997 FORMAT( 1x, ' Failure in ',a6,' N=',i5,' TYPE=',i5,' UPLO=''',
270 + a1, ''', FORM =''',a1,''', NORM=''',a1,''', test=',g12.5)
271 9996 FORMAT( 1x, 'All tests for ',a6,' auxiliary routine passed the ',
272 + 'threshold ( ',i5,' tests run)')
273 9995 FORMAT( 1x, a6, ' auxiliary routine: ',i5,' out of ',i5,
274 + ' tests failed to pass the threshold')
275 9994 FORMAT( 26x, i5,' error message recorded (',a6,')')
276*
277 RETURN
278*
279* End of CDRVRF1
280*
complex function clarnd(IDIST, ISEED)
CLARND
Definition: clarnd.f:75
real function clanhe(NORM, UPLO, N, A, LDA, WORK)
CLANHE returns the value of the 1-norm, or the Frobenius norm, or the infinity norm,...
Definition: clanhe.f:124
real function clanhf(NORM, TRANSR, UPLO, N, A, WORK)
CLANHF returns the value of the 1-norm, or the Frobenius norm, or the infinity norm,...
Definition: clanhf.f:246
subroutine ctrttf(TRANSR, UPLO, N, A, LDA, ARF, INFO)
CTRTTF copies a triangular matrix from the standard full format (TR) to the rectangular full packed f...
Definition: ctrttf.f:216
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:68
Here is the call graph for this function:
Here is the caller graph for this function: