1*> \brief \b SDRVRF2
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 SDRVRF2( NOUT, NN, NVAL, A, LDA, ARF, AP, ASAV  )
12*
13*       .. Scalar Arguments ..
14*       INTEGER            LDA, NN, NOUT
15*       ..
16*       .. Array Arguments ..
17*       INTEGER            NVAL( NN )
18*       REAL               A( LDA, * ), ARF( * ), AP(*), ASAV( LDA, * )
19*       ..
20*
21*
22*> \par Purpose:
23*  =============
24*>
25*> \verbatim
26*>
27*> SDRVRF2 tests the LAPACK RFP conversion routines.
28*> \endverbatim
29*
30*  Arguments:
31*  ==========
32*
33*> \param[in] NOUT
34*> \verbatim
35*>          NOUT is INTEGER
36*>                The unit number for output.
37*> \endverbatim
38*>
39*> \param[in] NN
40*> \verbatim
41*>          NN is INTEGER
42*>                The number of values of N contained in the vector NVAL.
43*> \endverbatim
44*>
45*> \param[in] NVAL
46*> \verbatim
47*>          NVAL is INTEGER array, dimension (NN)
48*>                The values of the matrix dimension N.
49*> \endverbatim
50*>
51*> \param[out] A
52*> \verbatim
53*>          A is REAL array, dimension (LDA,NMAX)
54*> \endverbatim
55*>
56*> \param[in] LDA
57*> \verbatim
58*>          LDA is INTEGER
59*>                The leading dimension of the array A.  LDA >= max(1,NMAX).
60*> \endverbatim
61*>
62*> \param[out] ARF
63*> \verbatim
64*>          ARF is REAL array, dimension ((NMAX*(NMAX+1))/2).
65*> \endverbatim
66*>
67*> \param[out] AP
68*> \verbatim
69*>          AP is REAL array, dimension ((NMAX*(NMAX+1))/2).
70*> \endverbatim
71*>
72*> \param[out] ASAV
73*> \verbatim
74*>          ASAV is REAL array, dimension (LDA,NMAX)
75*> \endverbatim
76*
77*  Authors:
78*  ========
79*
80*> \author Univ. of Tennessee
81*> \author Univ. of California Berkeley
82*> \author Univ. of Colorado Denver
83*> \author NAG Ltd.
84*
85*> \ingroup single_lin
86*
87*  =====================================================================
88      SUBROUTINE SDRVRF2( NOUT, NN, NVAL, A, LDA, ARF, AP, ASAV  )
89*
90*  -- LAPACK test routine --
91*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
92*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
93*
94*     .. Scalar Arguments ..
95      INTEGER            LDA, NN, NOUT
96*     ..
97*     .. Array Arguments ..
98      INTEGER            NVAL( NN )
99      REAL               A( LDA, * ), ARF( * ), AP(*), ASAV( LDA, * )
100*     ..
101*
102*  =====================================================================
103*     ..
104*     .. Local Scalars ..
105      LOGICAL            LOWER, OK1, OK2
106      CHARACTER          UPLO, CFORM
107      INTEGER            I, IFORM, IIN, INFO, IUPLO, J, N,
108     +                   NERRS, NRUN
109*     ..
110*     .. Local Arrays ..
111      CHARACTER          UPLOS( 2 ), FORMS( 2 )
112      INTEGER            ISEED( 4 ), ISEEDY( 4 )
113*     ..
114*     .. External Functions ..
115      REAL               SLARND
116      EXTERNAL           SLARND
117*     ..
118*     .. External Subroutines ..
119      EXTERNAL           STFTTR, STFTTP, STRTTF, STRTTP, STPTTR, STPTTF
120*     ..
121*     .. Scalars in Common ..
122      CHARACTER*32       SRNAMT
123*     ..
124*     .. Common blocks ..
125      COMMON             / SRNAMC / SRNAMT
126*     ..
127*     .. Data statements ..
128      DATA               ISEEDY / 1988, 1989, 1990, 1991 /
129      DATA               UPLOS / 'U', 'L' /
130      DATA               FORMS / 'N', 'T' /
131*     ..
132*     .. Executable Statements ..
133*
134*     Initialize constants and the random number seed.
135*
136      NRUN = 0
137      NERRS = 0
138      INFO = 0
139      DO 10 I = 1, 4
140         ISEED( I ) = ISEEDY( I )
141   10 CONTINUE
142*
143      DO 120 IIN = 1, NN
144*
145         N = NVAL( IIN )
146*
147*        Do first for UPLO = 'U', then for UPLO = 'L'
148*
149         DO 110 IUPLO = 1, 2
150*
151            UPLO = UPLOS( IUPLO )
152            LOWER = .TRUE.
153            IF ( IUPLO.EQ.1 ) LOWER = .FALSE.
154*
155*           Do first for CFORM = 'N', then for CFORM = 'T'
156*
157            DO 100 IFORM = 1, 2
158*
159               CFORM = FORMS( IFORM )
160*
161               NRUN = NRUN + 1
162*
163               DO J = 1, N
164                  DO I = 1, N
165                     A( I, J) = SLARND( 2, ISEED )
166                  END DO
167               END DO
168*
169               SRNAMT = 'DTRTTF'
170               CALL STRTTF( CFORM, UPLO, N, A, LDA, ARF, INFO )
171*
172               SRNAMT = 'DTFTTP'
173               CALL STFTTP( CFORM, UPLO, N, ARF, AP, INFO )
174*
175               SRNAMT = 'DTPTTR'
176               CALL STPTTR( UPLO, N, AP, ASAV, LDA, INFO )
177*
178               OK1 = .TRUE.
179               IF ( LOWER ) THEN
180                  DO J = 1, N
181                     DO I = J, N
182                        IF ( A(I,J).NE.ASAV(I,J) ) THEN
183                           OK1 = .FALSE.
184                        END IF
185                     END DO
186                  END DO
187               ELSE
188                  DO J = 1, N
189                     DO I = 1, J
190                        IF ( A(I,J).NE.ASAV(I,J) ) THEN
191                           OK1 = .FALSE.
192                        END IF
193                     END DO
194                  END DO
195               END IF
196*
197               NRUN = NRUN + 1
198*
199               SRNAMT = 'DTRTTP'
200               CALL STRTTP( UPLO, N, A, LDA, AP, INFO )
201*
202               SRNAMT = 'DTPTTF'
203               CALL STPTTF( CFORM, UPLO, N, AP, ARF, INFO )
204*
205               SRNAMT = 'DTFTTR'
206               CALL STFTTR( CFORM, UPLO, N, ARF, ASAV, LDA, INFO )
207*
208               OK2 = .TRUE.
209               IF ( LOWER ) THEN
210                  DO J = 1, N
211                     DO I = J, N
212                        IF ( A(I,J).NE.ASAV(I,J) ) THEN
213                           OK2 = .FALSE.
214                        END IF
215                     END DO
216                  END DO
217               ELSE
218                  DO J = 1, N
219                     DO I = 1, J
220                        IF ( A(I,J).NE.ASAV(I,J) ) THEN
221                           OK2 = .FALSE.
222                        END IF
223                     END DO
224                  END DO
225               END IF
226*
227               IF (( .NOT.OK1 ).OR.( .NOT.OK2 )) THEN
228                  IF( NERRS.EQ.0 ) THEN
229                     WRITE( NOUT, * )
230                     WRITE( NOUT, FMT = 9999 )
231                  END IF
232                  WRITE( NOUT, FMT = 9998 ) N, UPLO, CFORM
233                  NERRS = NERRS + 1
234               END IF
235*
236  100       CONTINUE
237  110    CONTINUE
238  120 CONTINUE
239*
240*     Print a summary of the results.
241*
242      IF ( NERRS.EQ.0 ) THEN
243         WRITE( NOUT, FMT = 9997 ) NRUN
244      ELSE
245         WRITE( NOUT, FMT = 9996 ) NERRS, NRUN
246      END IF
247*
248 9999 FORMAT( 1X, ' *** Error(s) while testing the RFP conversion',
249     +         ' routines ***')
250 9998 FORMAT( 1X, '     Error in RFP,conversion routines N=',I5,
251     +        ' UPLO=''', A1, ''', FORM =''',A1,'''')
252 9997 FORMAT( 1X, 'All tests for the RFP conversion routines passed ( ',
253     +        I5,' tests run)')
254 9996 FORMAT( 1X, 'RFP conversion routines: ',I5,' out of ',I5,
255     +        ' error message recorded')
256*
257      RETURN
258*
259*     End of SDRVRF2
260*
261      END
262