LAPACK 3.11.0 LAPACK: Linear Algebra PACKage
Searching...
No Matches
cdrvrf2.f
Go to the documentation of this file.
1*> \brief \b CDRVRF2
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 CDRVRF2( 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* COMPLEX A( LDA, * ), ARF( * ), AP(*), ASAV( LDA, * )
19* ..
20*
21*
22*> \par Purpose:
23* =============
24*>
25*> \verbatim
26*>
27*> CDRVRF2 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 COMPLEX 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 COMPLEX array, dimension ((NMAX*(NMAX+1))/2).
65*> \endverbatim
66*>
67*> \param[out] AP
68*> \verbatim
69*> AP is COMPLEX array, dimension ((NMAX*(NMAX+1))/2).
70*> \endverbatim
71*>
72*> \param[out] ASAV
73*> \verbatim
74*> ASAV is COMPLEX6 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 complex_lin
86*
87* =====================================================================
88 SUBROUTINE cdrvrf2( 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 COMPLEX 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 COMPLEX CLARND
116 EXTERNAL clarnd
117* ..
118* .. External Subroutines ..
119 EXTERNAL ctfttr, ctfttp, ctrttf, ctrttp, ctpttr, ctpttf
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', 'C' /
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 = 'C'
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) = clarnd( 4, iseed )
166 END DO
167 END DO
168*
169 srnamt = 'CTRTTF'
170 CALL ctrttf( cform, uplo, n, a, lda, arf, info )
171*
172 srnamt = 'CTFTTP'
173 CALL ctfttp( cform, uplo, n, arf, ap, info )
174*
175 srnamt = 'CTPTTR'
176 CALL ctpttr( 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 = 'CTRTTP'
200 CALL ctrttp( uplo, n, a, lda, ap, info )
201*
202 srnamt = 'CTPTTF'
203 CALL ctpttf( cform, uplo, n, ap, arf, info )
204*
205 srnamt = 'CTFTTR'
206 CALL ctfttr( 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 CDRVRF2
260*
261 END
subroutine cdrvrf2(NOUT, NN, NVAL, A, LDA, ARF, AP, ASAV)
CDRVRF2
Definition: cdrvrf2.f:89
subroutine ctfttr(TRANSR, UPLO, N, ARF, A, LDA, INFO)
CTFTTR copies a triangular matrix from the rectangular full packed format (TF) to the standard full f...
Definition: ctfttr.f:216
subroutine ctpttr(UPLO, N, AP, A, LDA, INFO)
CTPTTR copies a triangular matrix from the standard packed format (TP) to the standard full format (T...
Definition: ctpttr.f:104
subroutine ctrttp(UPLO, N, A, LDA, AP, INFO)
CTRTTP copies a triangular matrix from the standard full format (TR) to the standard packed format (T...
Definition: ctrttp.f:104
subroutine ctpttf(TRANSR, UPLO, N, AP, ARF, INFO)
CTPTTF copies a triangular matrix from the standard packed format (TP) to the rectangular full packed...
Definition: ctpttf.f:207
subroutine ctfttp(TRANSR, UPLO, N, ARF, AP, INFO)
CTFTTP copies a triangular matrix from the rectangular full packed format (TF) to the standard packed...
Definition: ctfttp.f:208
subroutine ctrttf(TRANSR, UPLO, N, A, LDA, ARF, INFO)
CTRTTF copies a triangular matrix from the standard full format (TR) to the rectangular full packed f...
Definition: ctrttf.f:216