LAPACK  3.7.1
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.
Date
December 2016

Definition at line 97 of file cdrvrf1.f.

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