1*> \brief \b DDRVRF1
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 DDRVRF1( 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   A( LDA, * ), ARF( * ), WORK( * )
20*       ..
21*
22*
23*> \par Purpose:
24*  =============
25*>
26*> \verbatim
27*>
28*> DDRVRF1 tests the LAPACK RFP routines:
29*>     DLANSF
30*> \endverbatim
31*
32*  Arguments:
33*  ==========
34*
35*> \param[in] NOUT
36*> \verbatim
37*>          NOUT is INTEGER
38*>                The unit number for output.
39*> \endverbatim
40*>
41*> \param[in] NN
42*> \verbatim
43*>          NN is INTEGER
44*>                The number of values of N contained in the vector NVAL.
45*> \endverbatim
46*>
47*> \param[in] NVAL
48*> \verbatim
49*>          NVAL is INTEGER array, dimension (NN)
50*>                The values of the matrix dimension N.
51*> \endverbatim
52*>
53*> \param[in] THRESH
54*> \verbatim
55*>          THRESH is DOUBLE PRECISION
56*>                The threshold value for the test ratios.  A result is
57*>                included in the output file if RESULT >= THRESH.  To have
58*>                every test ratio printed, use THRESH = 0.
59*> \endverbatim
60*>
61*> \param[out] A
62*> \verbatim
63*>          A is DOUBLE PRECISION array, dimension (LDA,NMAX)
64*> \endverbatim
65*>
66*> \param[in] LDA
67*> \verbatim
68*>          LDA is INTEGER
69*>                The leading dimension of the array A.  LDA >= max(1,NMAX).
70*> \endverbatim
71*>
72*> \param[out] ARF
73*> \verbatim
74*>          ARF is DOUBLE PRECISION array, dimension ((NMAX*(NMAX+1))/2).
75*> \endverbatim
76*>
77*> \param[out] WORK
78*> \verbatim
79*>          WORK is DOUBLE PRECISION array, dimension ( NMAX )
80*> \endverbatim
81*
82*  Authors:
83*  ========
84*
85*> \author Univ. of Tennessee
86*> \author Univ. of California Berkeley
87*> \author Univ. of Colorado Denver
88*> \author NAG Ltd.
89*
90*> \date December 2016
91*
92*> \ingroup double_lin
93*
94*  =====================================================================
95      SUBROUTINE DDRVRF1( NOUT, NN, NVAL, THRESH, A, LDA, ARF, WORK )
96*
97*  -- LAPACK test routine (version 3.7.0) --
98*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
99*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
100*     December 2016
101*
102*     .. Scalar Arguments ..
103      INTEGER            LDA, NN, NOUT
104      DOUBLE PRECISION   THRESH
105*     ..
106*     .. Array Arguments ..
107      INTEGER            NVAL( NN )
108      DOUBLE PRECISION   A( LDA, * ), ARF( * ), WORK( * )
109*     ..
110*
111*  =====================================================================
112*     ..
113*     .. Parameters ..
114      DOUBLE PRECISION   ONE
115      PARAMETER          ( ONE = 1.0D+0 )
116      INTEGER            NTESTS
117      PARAMETER          ( NTESTS = 1 )
118*     ..
119*     .. Local Scalars ..
120      CHARACTER          UPLO, CFORM, NORM
121      INTEGER            I, IFORM, IIN, IIT, INFO, INORM, IUPLO, J, N,
122     +                   NERRS, NFAIL, NRUN
123      DOUBLE PRECISION   EPS, LARGE, NORMA, NORMARF, SMALL
124*     ..
125*     .. Local Arrays ..
126      CHARACTER          UPLOS( 2 ), FORMS( 2 ), NORMS( 4 )
127      INTEGER            ISEED( 4 ), ISEEDY( 4 )
128      DOUBLE PRECISION   RESULT( NTESTS )
129*     ..
130*     .. External Functions ..
131      DOUBLE PRECISION   DLAMCH, DLANSY, DLANSF, DLARND
132      EXTERNAL           DLAMCH, DLANSY, DLANSF, DLARND
133*     ..
134*     .. External Subroutines ..
135      EXTERNAL           DTRTTF
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', 'T' /
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) = DLARND( 2, 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 = 'DTRTTF'
214                  CALL DTRTTF( CFORM, UPLO, N, A, LDA, ARF, INFO )
215*
216*                 Check error code from DTRTTF
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 = DLANSF( NORM, CFORM, UPLO, N, ARF, WORK )
234                     NORMA = DLANSY( 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 ) 'DLANSF',
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 ) 'DLANSF', NRUN
258      ELSE
259         WRITE( NOUT, FMT = 9995 ) 'DLANSF', NFAIL, NRUN
260      END IF
261      IF ( NERRS.NE.0 ) THEN
262         WRITE( NOUT, FMT = 9994 ) NERRS, 'DLANSF'
263      END IF
264*
265 9999 FORMAT( 1X, ' *** Error(s) or Failure(s) while testing DLANSF
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 DDRVRF1
280*
281      END
282