LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ 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: