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 convertion 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*> \date November 2011
86*
87*> \ingroup single_lin
88*
89*  =====================================================================
90      SUBROUTINE SDRVRF2( NOUT, NN, NVAL, A, LDA, ARF, AP, ASAV  )
91*
92*  -- LAPACK test routine (version 3.4.0) --
93*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
94*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
95*     November 2011
96*
97*     .. Scalar Arguments ..
98      INTEGER            LDA, NN, NOUT
99*     ..
100*     .. Array Arguments ..
101      INTEGER            NVAL( NN )
102      REAL               A( LDA, * ), ARF( * ), AP(*), ASAV( LDA, * )
103*     ..
104*
105*  =====================================================================
106*     ..
107*     .. Local Scalars ..
108      LOGICAL            LOWER, OK1, OK2
109      CHARACTER          UPLO, CFORM
110      INTEGER            I, IFORM, IIN, INFO, IUPLO, J, N,
111     +                   NERRS, NRUN
112*     ..
113*     .. Local Arrays ..
114      CHARACTER          UPLOS( 2 ), FORMS( 2 )
115      INTEGER            ISEED( 4 ), ISEEDY( 4 )
116*     ..
117*     .. External Functions ..
118      REAL               SLARND
119      EXTERNAL           SLARND
120*     ..
121*     .. External Subroutines ..
122      EXTERNAL           STFTTR, STFTTP, STRTTF, STRTTP, STPTTR, STPTTF
123*     ..
124*     .. Scalars in Common ..
125      CHARACTER*32       SRNAMT
126*     ..
127*     .. Common blocks ..
128      COMMON             / SRNAMC / SRNAMT
129*     ..
130*     .. Data statements ..
131      DATA               ISEEDY / 1988, 1989, 1990, 1991 /
132      DATA               UPLOS / 'U', 'L' /
133      DATA               FORMS / 'N', 'T' /
134*     ..
135*     .. Executable Statements ..
136*
137*     Initialize constants and the random number seed.
138*
139      NRUN = 0
140      NERRS = 0
141      INFO = 0
142      DO 10 I = 1, 4
143         ISEED( I ) = ISEEDY( I )
144   10 CONTINUE
145*
146      DO 120 IIN = 1, NN
147*
148         N = NVAL( IIN )
149*
150*        Do first for UPLO = 'U', then for UPLO = 'L'
151*
152         DO 110 IUPLO = 1, 2
153*
154            UPLO = UPLOS( IUPLO )
155            LOWER = .TRUE.
156            IF ( IUPLO.EQ.1 ) LOWER = .FALSE.
157*
158*           Do first for CFORM = 'N', then for CFORM = 'T'
159*
160            DO 100 IFORM = 1, 2
161*
162               CFORM = FORMS( IFORM )
163*
164               NRUN = NRUN + 1
165*
166               DO J = 1, N
167                  DO I = 1, N
168                     A( I, J) = SLARND( 2, ISEED )
169                  END DO
170               END DO
171*
172               SRNAMT = 'DTRTTF'
173               CALL STRTTF( CFORM, UPLO, N, A, LDA, ARF, INFO )
174*
175               SRNAMT = 'DTFTTP'
176               CALL STFTTP( CFORM, UPLO, N, ARF, AP, INFO )
177*
178               SRNAMT = 'DTPTTR'
179               CALL STPTTR( UPLO, N, AP, ASAV, LDA, INFO )
180*
181               OK1 = .TRUE.
182               IF ( LOWER ) THEN
183                  DO J = 1, N
184                     DO I = J, N
185                        IF ( A(I,J).NE.ASAV(I,J) ) THEN
186                           OK1 = .FALSE.
187                        END IF
188                     END DO
189                  END DO
190               ELSE
191                  DO J = 1, N
192                     DO I = 1, J
193                        IF ( A(I,J).NE.ASAV(I,J) ) THEN
194                           OK1 = .FALSE.
195                        END IF
196                     END DO
197                  END DO
198               END IF
199*
200               NRUN = NRUN + 1
201*
202               SRNAMT = 'DTRTTP'
203               CALL STRTTP( UPLO, N, A, LDA, AP, INFO )
204*
205               SRNAMT = 'DTPTTF'
206               CALL STPTTF( CFORM, UPLO, N, AP, ARF, INFO )
207*
208               SRNAMT = 'DTFTTR'
209               CALL STFTTR( CFORM, UPLO, N, ARF, ASAV, LDA, INFO )
210*
211               OK2 = .TRUE.
212               IF ( LOWER ) THEN
213                  DO J = 1, N
214                     DO I = J, N
215                        IF ( A(I,J).NE.ASAV(I,J) ) THEN
216                           OK2 = .FALSE.
217                        END IF
218                     END DO
219                  END DO
220               ELSE
221                  DO J = 1, N
222                     DO I = 1, J
223                        IF ( A(I,J).NE.ASAV(I,J) ) THEN
224                           OK2 = .FALSE.
225                        END IF
226                     END DO
227                  END DO
228               END IF
229*
230               IF (( .NOT.OK1 ).OR.( .NOT.OK2 )) THEN
231                  IF( NERRS.EQ.0 ) THEN
232                     WRITE( NOUT, * )
233                     WRITE( NOUT, FMT = 9999 )
234                  END IF
235                  WRITE( NOUT, FMT = 9998 ) N, UPLO, CFORM
236                  NERRS = NERRS + 1
237               END IF
238*
239  100       CONTINUE
240  110    CONTINUE
241  120 CONTINUE
242*
243*     Print a summary of the results.
244*
245      IF ( NERRS.EQ.0 ) THEN
246         WRITE( NOUT, FMT = 9997 ) NRUN
247      ELSE
248         WRITE( NOUT, FMT = 9996 ) NERRS, NRUN
249      END IF
250*
251 9999 FORMAT( 1X, ' *** Error(s) while testing the RFP convertion',
252     +         ' routines ***')
253 9998 FORMAT( 1X, '     Error in RFP,convertion routines N=',I5,
254     +        ' UPLO=''', A1, ''', FORM =''',A1,'''')
255 9997 FORMAT( 1X, 'All tests for the RFP convertion routines passed ( ',
256     +        I5,' tests run)')
257 9996 FORMAT( 1X, 'RFP convertion routines: ',I5,' out of ',I5,
258     +        ' error message recorded')
259*
260      RETURN
261*
262*     End of SDRVRF2
263*
264      END
265