LAPACK  3.8.0
LAPACK: Linear Algebra PACKage

◆ cdrvrf2()

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

CDRVRF2

Purpose:
 CDRVRF2 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 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 array, dimension ((NMAX*(NMAX+1))/2).
[out]AP
          AP is COMPLEX array, dimension ((NMAX*(NMAX+1))/2).
[out]ASAV
          ASAV is COMPLEX6 array, dimension (LDA,NMAX)
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
December 2016

Definition at line 91 of file cdrvrf2.f.

91 *
92 * -- LAPACK test routine (version 3.7.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 * December 2016
96 *
97 * .. Scalar Arguments ..
98  INTEGER lda, nn, nout
99 * ..
100 * .. Array Arguments ..
101  INTEGER nval( nn )
102  COMPLEX 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  COMPLEX clarnd
119  EXTERNAL clarnd
120 * ..
121 * .. External Subroutines ..
122  EXTERNAL ctfttr, ctfttp, ctrttf, ctrttp, ctpttr, ctpttf
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', 'C' /
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 = 'C'
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) = clarnd( 4, iseed )
169  END DO
170  END DO
171 *
172  srnamt = 'CTRTTF'
173  CALL ctrttf( cform, uplo, n, a, lda, arf, info )
174 *
175  srnamt = 'CTFTTP'
176  CALL ctfttp( cform, uplo, n, arf, ap, info )
177 *
178  srnamt = 'CTPTTR'
179  CALL ctpttr( 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 = 'CTRTTP'
203  CALL ctrttp( uplo, n, a, lda, ap, info )
204 *
205  srnamt = 'CTPTTF'
206  CALL ctpttf( cform, uplo, n, ap, arf, info )
207 *
208  srnamt = 'CTFTTR'
209  CALL ctfttr( 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 conversion',
252  + ' routines ***')
253  9998 FORMAT( 1x, ' Error in RFP,conversion routines N=',i5,
254  + ' UPLO=''', a1, ''', FORM =''',a1,'''')
255  9997 FORMAT( 1x, 'All tests for the RFP conversion routines passed ( ',
256  + i5,' tests run)')
257  9996 FORMAT( 1x, 'RFP conversion routines: ',i5,' out of ',i5,
258  + ' error message recorded')
259 *
260  RETURN
261 *
262 * End of CDRVRF2
263 *
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:106
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:218
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:218
complex function clarnd(IDIST, ISEED)
CLARND
Definition: clarnd.f:77
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:210
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:106
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:209
Here is the call graph for this function:
Here is the caller graph for this function: