1*> \brief \b ZDRVRF1
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 ZDRVRF1( NOUT, NN, NVAL, THRESH, A, LDA, ARF, WORK )
12*
13*       .. Scalar Arguments ..
14*       INTEGER            LDA, NN, NOUT
15*       DOUBLE PRECISION   THRESH
16*       ..
17*       .. Array Arguments ..
18*       INTEGER            NVAL( NN )
19*       DOUBLE PRECISION   WORK( * )
20*       COMPLEX*16         A( LDA, * ), ARF( * )
21*       ..
22*
23*
24*> \par Purpose:
25*  =============
26*>
27*> \verbatim
28*>
29*> ZDRVRF1 tests the LAPACK RFP routines:
30*>     ZLANHF.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 DOUBLE PRECISION
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*16 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*16 array, dimension ((NMAX*(NMAX+1))/2).
76*> \endverbatim
77*>
78*> \param[out] WORK
79*> \verbatim
80*>          WORK is DOUBLE PRECISION 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*> \ingroup complex16_lin
92*
93*  =====================================================================
94      SUBROUTINE ZDRVRF1( NOUT, NN, NVAL, THRESH, A, LDA, ARF, WORK )
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      DOUBLE PRECISION   THRESH
103*     ..
104*     .. Array Arguments ..
105      INTEGER            NVAL( NN )
106      DOUBLE PRECISION   WORK( * )
107      COMPLEX*16         A( LDA, * ), ARF( * )
108*     ..
109*
110*  =====================================================================
111*     ..
112*     .. Parameters ..
113      DOUBLE PRECISION   ONE
114      PARAMETER          ( ONE = 1.0D+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      DOUBLE PRECISION   EPS, LARGE, NORMA, NORMARF, SMALL
123*     ..
124*     .. Local Arrays ..
125      CHARACTER          UPLOS( 2 ), FORMS( 2 ), NORMS( 4 )
126      INTEGER            ISEED( 4 ), ISEEDY( 4 )
127      DOUBLE PRECISION   RESULT( NTESTS )
128*     ..
129*     .. External Functions ..
130      COMPLEX*16         ZLARND
131      DOUBLE PRECISION   DLAMCH, ZLANHE, ZLANHF
132      EXTERNAL           DLAMCH, ZLARND, ZLANHE, ZLANHF
133*     ..
134*     .. External Subroutines ..
135      EXTERNAL           ZTRTTF
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 = DLAMCH( 'Precision' )
162      SMALL = DLAMCH( '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) = ZLARND( 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 = 'ZTRTTF'
214                  CALL ZTRTTF( CFORM, UPLO, N, A, LDA, ARF, INFO )
215*
216*                 Check error code from ZTRTTF
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 = ZLANHF( NORM, CFORM, UPLO, N, ARF, WORK )
234                     NORMA = ZLANHE( 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 ) 'ZLANHF',
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 ) 'ZLANHF', NRUN
258      ELSE
259         WRITE( NOUT, FMT = 9995 ) 'ZLANHF', NFAIL, NRUN
260      END IF
261      IF ( NERRS.NE.0 ) THEN
262         WRITE( NOUT, FMT = 9994 ) NERRS, 'ZLANHF'
263      END IF
264*
265 9999 FORMAT( 1X, ' *** Error(s) or Failure(s) while testing ZLANHF
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 ZDRVRF1
280*
281      END
282