LAPACK  3.8.0
LAPACK: Linear Algebra PACKage

◆ ddrvrf2()

subroutine ddrvrf2 ( integer  NOUT,
integer  NN,
integer, dimension( nn )  NVAL,
double precision, dimension( lda, * )  A,
integer  LDA,
double precision, dimension( * )  ARF,
double precision, dimension(*)  AP,
double precision, dimension( lda, * )  ASAV 
)

DDRVRF2

Purpose:
 DDRVRF2 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 DOUBLE PRECISION array, dimension (LDA,NMAX)
[in]LDA
          LDA is INTEGER
                The leading dimension of the array A.  LDA >= max(1,NMAX).
[out]ARF
          ARF is DOUBLE PRECISION array, dimension ((NMAX*(NMAX+1))/2).
[out]AP
          AP is DOUBLE PRECISION array, dimension ((NMAX*(NMAX+1))/2).
[out]ASAV
          ASAV is DOUBLE PRECISION 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 ddrvrf2.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  DOUBLE PRECISION 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  DOUBLE PRECISION dlarnd
119  EXTERNAL dlarnd
120 * ..
121 * .. External Subroutines ..
122  EXTERNAL dtfttr, dtfttp, dtrttf, dtrttp, dtpttr, dtpttf
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) = dlarnd( 2, iseed )
169  END DO
170  END DO
171 *
172  srnamt = 'DTRTTF'
173  CALL dtrttf( cform, uplo, n, a, lda, arf, info )
174 *
175  srnamt = 'DTFTTP'
176  CALL dtfttp( cform, uplo, n, arf, ap, info )
177 *
178  srnamt = 'DTPTTR'
179  CALL dtpttr( 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 dtrttp( uplo, n, a, lda, ap, info )
204 *
205  srnamt = 'DTPTTF'
206  CALL dtpttf( cform, uplo, n, ap, arf, info )
207 *
208  srnamt = 'DTFTTR'
209  CALL dtfttr( 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 DDRVRF2
263 *
subroutine dtrttf(TRANSR, UPLO, N, A, LDA, ARF, INFO)
DTRTTF copies a triangular matrix from the standard full format (TR) to the rectangular full packed f...
Definition: dtrttf.f:196
subroutine dtpttr(UPLO, N, AP, A, LDA, INFO)
DTPTTR copies a triangular matrix from the standard packed format (TP) to the standard full format (T...
Definition: dtpttr.f:106
double precision function dlarnd(IDIST, ISEED)
DLARND
Definition: dlarnd.f:75
subroutine dtpttf(TRANSR, UPLO, N, AP, ARF, INFO)
DTPTTF copies a triangular matrix from the standard packed format (TP) to the rectangular full packed...
Definition: dtpttf.f:188
subroutine dtrttp(UPLO, N, A, LDA, AP, INFO)
DTRTTP copies a triangular matrix from the standard full format (TR) to the standard packed format (T...
Definition: dtrttp.f:106
subroutine dtfttp(TRANSR, UPLO, N, ARF, AP, INFO)
DTFTTP copies a triangular matrix from the rectangular full packed format (TF) to the standard packed...
Definition: dtfttp.f:189
subroutine dtfttr(TRANSR, UPLO, N, ARF, A, LDA, INFO)
DTFTTR copies a triangular matrix from the rectangular full packed format (TF) to the standard full f...
Definition: dtfttr.f:198
Here is the call graph for this function:
Here is the caller graph for this function: