1*> \brief \b CDRVRF1
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*  Definition:
9*  ===========
10*
11*       SUBROUTINE CDRVRF1( NOUT, NN, NVAL, THRESH, A, LDA, ARF, WORK )
12*
13*       .. Scalar Arguments ..
14*       INTEGER            LDA, NN, NOUT
15*       REAL               THRESH
16*       ..
17*       .. Array Arguments ..
18*       INTEGER            NVAL( NN )
19*       REAL               WORK( * )
20*       COMPLEX            A( LDA, * ), ARF( * )
21*       ..
22*
23*
24*> \par Purpose:
25*  =============
26*>
27*> \verbatim
28*>
29*> CDRVRF1 tests the LAPACK RFP routines:
30*>     CLANHF.F
31*> \endverbatim
32*
33*  Arguments:
34*  ==========
35*
36*> \param[in] NOUT
37*> \verbatim
38*>          NOUT is INTEGER
39*>                The unit number for output.
40*> \endverbatim
41*>
42*> \param[in] NN
43*> \verbatim
44*>          NN is INTEGER
45*>                The number of values of N contained in the vector NVAL.
46*> \endverbatim
47*>
48*> \param[in] NVAL
49*> \verbatim
50*>          NVAL is INTEGER array, dimension (NN)
51*>                The values of the matrix dimension N.
52*> \endverbatim
53*>
54*> \param[in] THRESH
55*> \verbatim
56*>          THRESH is REAL
57*>                The threshold value for the test ratios.  A result is
58*>                included in the output file if RESULT >= THRESH.  To have
59*>                every test ratio printed, use THRESH = 0.
60*> \endverbatim
61*>
62*> \param[out] A
63*> \verbatim
64*>          A is COMPLEX array, dimension (LDA,NMAX)
65*> \endverbatim
66*>
67*> \param[in] LDA
68*> \verbatim
69*>          LDA is INTEGER
70*>                The leading dimension of the array A.  LDA >= max(1,NMAX).
71*> \endverbatim
72*>
73*> \param[out] ARF
74*> \verbatim
75*>          ARF is COMPLEX array, dimension ((NMAX*(NMAX+1))/2).
76*> \endverbatim
77*>
78*> \param[out] WORK
79*> \verbatim
80*>          WORK is COMPLEX array, dimension ( NMAX )
81*> \endverbatim
82*
83*  Authors:
84*  ========
85*
86*> \author Univ. of Tennessee
87*> \author Univ. of California Berkeley
88*> \author Univ. of Colorado Denver
89*> \author NAG Ltd.
90*
91*> \date November 2011
92*
93*> \ingroup complex_lin
94*
95*  =====================================================================
96      SUBROUTINE CDRVRF1( NOUT, NN, NVAL, THRESH, A, LDA, ARF, WORK )
97*
98*  -- LAPACK test routine (version 3.4.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*     November 2011
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*
284      END
285