LAPACK 3.11.0 LAPACK: Linear Algebra PACKage
Searching...
No Matches

## ◆ zdrvrf2()

 subroutine zdrvrf2 ( integer NOUT, integer NN, integer, dimension( nn ) NVAL, complex*16, dimension( lda, * ) A, integer LDA, complex*16, dimension( * ) ARF, complex*16, dimension(*) AP, complex*16, dimension( lda, * ) ASAV )

ZDRVRF2

Purpose:
` ZDRVRF2 tests the LAPACK RFP conversion routines.`
Parameters
 [in] NOUT ``` NOUT is INTEGER The unit number for output.``` [in] NN ``` NN is INTEGER The number of values of N contained in the vector NVAL.``` [in] NVAL ``` NVAL is INTEGER array, dimension (NN) The values of the matrix dimension N.``` [out] A ` A is COMPLEX*16 array, dimension (LDA,NMAX)` [in] LDA ``` LDA is INTEGER The leading dimension of the array A. LDA >= max(1,NMAX).``` [out] ARF ` ARF is COMPLEX*16 array, dimension ((NMAX*(NMAX+1))/2).` [out] AP ` AP is COMPLEX*16 array, dimension ((NMAX*(NMAX+1))/2).` [out] ASAV ` ASAV is COMPLEX*16 array, dimension (LDA,NMAX)`

Definition at line 88 of file zdrvrf2.f.

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*16 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*16 ZLARND
116 EXTERNAL zlarnd
117* ..
118* .. External Subroutines ..
119 EXTERNAL ztfttr, ztfttp, ztrttf, ztrttp, ztpttr, ztpttf
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) = zlarnd( 4, iseed )
166 END DO
167 END DO
168*
169 srnamt = 'ZTRTTF'
170 CALL ztrttf( cform, uplo, n, a, lda, arf, info )
171*
172 srnamt = 'ZTFTTP'
173 CALL ztfttp( cform, uplo, n, arf, ap, info )
174*
175 srnamt = 'ZTPTTR'
176 CALL ztpttr( 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 = 'ZTRTTP'
200 CALL ztrttp( uplo, n, a, lda, ap, info )
201*
202 srnamt = 'ZTPTTF'
203 CALL ztpttf( cform, uplo, n, ap, arf, info )
204*
205 srnamt = 'ZTFTTR'
206 CALL ztfttr( 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 ZDRVRF2
260*
complex *16 function zlarnd(IDIST, ISEED)
ZLARND
Definition: zlarnd.f:75
subroutine ztpttr(UPLO, N, AP, A, LDA, INFO)
ZTPTTR copies a triangular matrix from the standard packed format (TP) to the standard full format (T...
Definition: ztpttr.f:104
subroutine ztrttp(UPLO, N, A, LDA, AP, INFO)
ZTRTTP copies a triangular matrix from the standard full format (TR) to the standard packed format (T...
Definition: ztrttp.f:104
subroutine ztfttp(TRANSR, UPLO, N, ARF, AP, INFO)
ZTFTTP copies a triangular matrix from the rectangular full packed format (TF) to the standard packed...
Definition: ztfttp.f:208
subroutine ztrttf(TRANSR, UPLO, N, A, LDA, ARF, INFO)
ZTRTTF copies a triangular matrix from the standard full format (TR) to the rectangular full packed f...
Definition: ztrttf.f:216
subroutine ztfttr(TRANSR, UPLO, N, ARF, A, LDA, INFO)
ZTFTTR copies a triangular matrix from the rectangular full packed format (TF) to the standard full f...
Definition: ztfttr.f:216
subroutine ztpttf(TRANSR, UPLO, N, AP, ARF, INFO)
ZTPTTF copies a triangular matrix from the standard packed format (TP) to the rectangular full packed...
Definition: ztpttf.f:207
Here is the call graph for this function:
Here is the caller graph for this function: