1 SUBROUTINE ZDRVRF2( NOUT, NN, NVAL, A, LDA, ARF, AP, ASAV )
2 *
3 IMPLICIT NONE
4 *
5 * -- LAPACK test routine (version 3.2.0) --
6 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
7 * November 2008
8 *
9 * .. Scalar Arguments ..
10 INTEGER LDA, NN, NOUT
11 * ..
12 * .. Array Arguments ..
13 INTEGER NVAL( NN )
14 COMPLEX*16 A( LDA, * ), ARF( * ), AP(*), ASAV( LDA, * )
15 * ..
16 *
17 * Purpose
18 * =======
19 *
20 * ZDRVRF2 tests the LAPACK RFP convertion routines.
21 *
22 * Arguments
23 * =========
24 *
25 * NOUT (input) INTEGER
26 * The unit number for output.
27 *
28 * NN (input) INTEGER
29 * The number of values of N contained in the vector NVAL.
30 *
31 * NVAL (input) INTEGER array, dimension (NN)
32 * The values of the matrix dimension N.
33 *
34 * A (workspace) COMPLEX*16 array, dimension (LDA,NMAX)
35 *
36 * LDA (input) INTEGER
37 * The leading dimension of the array A. LDA >= max(1,NMAX).
38 *
39 * ARF (workspace) COMPLEX*16 array, dimension ((NMAX*(NMAX+1))/2).
40 *
41 * AP (workspace) COMPLEX*16 array, dimension ((NMAX*(NMAX+1))/2).
42 *
43 * A2 (workspace) COMPLEX*16 array, dimension (LDA,NMAX)
44 *
45 * =====================================================================
46 * ..
47 * .. Local Scalars ..
48 LOGICAL LOWER, OK1, OK2
49 CHARACTER UPLO, CFORM
50 INTEGER I, IFORM, IIN, INFO, IUPLO, J, N,
51 + NERRS, NRUN
52 * ..
53 * .. Local Arrays ..
54 CHARACTER UPLOS( 2 ), FORMS( 2 )
55 INTEGER ISEED( 4 ), ISEEDY( 4 )
56 * ..
57 * .. External Functions ..
58 COMPLEX*16 ZLARND
59 EXTERNAL ZLARND
60 * ..
61 * .. External Subroutines ..
62 EXTERNAL ZTFTTR, ZTFTTP, ZTRTTF, ZTRTTP, ZTPTTR, ZTPTTF
63 * ..
64 * .. Scalars in Common ..
65 CHARACTER*32 SRNAMT
66 * ..
67 * .. Common blocks ..
68 COMMON / SRNAMC / SRNAMT
69 * ..
70 * .. Data statements ..
71 DATA ISEEDY / 1988, 1989, 1990, 1991 /
72 DATA UPLOS / 'U', 'L' /
73 DATA FORMS / 'N', 'C' /
74 * ..
75 * .. Executable Statements ..
76 *
77 * Initialize constants and the random number seed.
78 *
79 NRUN = 0
80 NERRS = 0
81 INFO = 0
82 DO 10 I = 1, 4
83 ISEED( I ) = ISEEDY( I )
84 10 CONTINUE
85 *
86 DO 120 IIN = 1, NN
87 *
88 N = NVAL( IIN )
89 *
90 * Do first for UPLO = 'U', then for UPLO = 'L'
91 *
92 DO 110 IUPLO = 1, 2
93 *
94 UPLO = UPLOS( IUPLO )
95 LOWER = .TRUE.
96 IF ( IUPLO.EQ.1 ) LOWER = .FALSE.
97 *
98 * Do first for CFORM = 'N', then for CFORM = 'C'
99 *
100 DO 100 IFORM = 1, 2
101 *
102 CFORM = FORMS( IFORM )
103 *
104 NRUN = NRUN + 1
105 *
106 DO J = 1, N
107 DO I = 1, N
108 A( I, J) = ZLARND( 4, ISEED )
109 END DO
110 END DO
111 *
112 SRNAMT = 'ZTRTTF'
113 CALL ZTRTTF( CFORM, UPLO, N, A, LDA, ARF, INFO )
114 *
115 SRNAMT = 'ZTFTTP'
116 CALL ZTFTTP( CFORM, UPLO, N, ARF, AP, INFO )
117 *
118 SRNAMT = 'ZTPTTR'
119 CALL ZTPTTR( UPLO, N, AP, ASAV, LDA, INFO )
120 *
121 OK1 = .TRUE.
122 IF ( LOWER ) THEN
123 DO J = 1, N
124 DO I = J, N
125 IF ( A(I,J).NE.ASAV(I,J) ) THEN
126 OK1 = .FALSE.
127 END IF
128 END DO
129 END DO
130 ELSE
131 DO J = 1, N
132 DO I = 1, J
133 IF ( A(I,J).NE.ASAV(I,J) ) THEN
134 OK1 = .FALSE.
135 END IF
136 END DO
137 END DO
138 END IF
139 *
140 NRUN = NRUN + 1
141 *
142 SRNAMT = 'ZTRTTP'
143 CALL ZTRTTP( UPLO, N, A, LDA, AP, INFO )
144 *
145 SRNAMT = 'ZTPTTF'
146 CALL ZTPTTF( CFORM, UPLO, N, AP, ARF, INFO )
147 *
148 SRNAMT = 'ZTFTTR'
149 CALL ZTFTTR( CFORM, UPLO, N, ARF, ASAV, LDA, INFO )
150 *
151 OK2 = .TRUE.
152 IF ( LOWER ) THEN
153 DO J = 1, N
154 DO I = J, N
155 IF ( A(I,J).NE.ASAV(I,J) ) THEN
156 OK2 = .FALSE.
157 END IF
158 END DO
159 END DO
160 ELSE
161 DO J = 1, N
162 DO I = 1, J
163 IF ( A(I,J).NE.ASAV(I,J) ) THEN
164 OK2 = .FALSE.
165 END IF
166 END DO
167 END DO
168 END IF
169 *
170 IF (( .NOT.OK1 ).OR.( .NOT.OK2 )) THEN
171 IF( NERRS.EQ.0 ) THEN
172 WRITE( NOUT, * )
173 WRITE( NOUT, FMT = 9999 )
174 END IF
175 WRITE( NOUT, FMT = 9998 ) N, UPLO, CFORM
176 NERRS = NERRS + 1
177 END IF
178 *
179 100 CONTINUE
180 110 CONTINUE
181 120 CONTINUE
182 *
183 * Print a summary of the results.
184 *
185 IF ( NERRS.EQ.0 ) THEN
186 WRITE( NOUT, FMT = 9997 ) NRUN
187 ELSE
188 WRITE( NOUT, FMT = 9996 ) NERRS, NRUN
189 END IF
190 *
191 9999 FORMAT( 1X, ' *** Error(s) while testing the RFP convertion',
192 + ' routines ***')
193 9998 FORMAT( 1X, ' Error in RFP,convertion routines N=',I5,
194 + ' UPLO=''', A1, ''', FORM =''',A1,'''')
195 9997 FORMAT( 1X, 'All tests for the RFP convertion routines passed (',
196 + I5,' tests run)')
197 9996 FORMAT( 1X, 'RFP convertion routines:',I5,' out of ',I5,
198 + ' error message recorded')
199 *
200 RETURN
201 *
202 * End of ZDRVRF2
203 *
204 END
2 *
3 IMPLICIT NONE
4 *
5 * -- LAPACK test routine (version 3.2.0) --
6 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
7 * November 2008
8 *
9 * .. Scalar Arguments ..
10 INTEGER LDA, NN, NOUT
11 * ..
12 * .. Array Arguments ..
13 INTEGER NVAL( NN )
14 COMPLEX*16 A( LDA, * ), ARF( * ), AP(*), ASAV( LDA, * )
15 * ..
16 *
17 * Purpose
18 * =======
19 *
20 * ZDRVRF2 tests the LAPACK RFP convertion routines.
21 *
22 * Arguments
23 * =========
24 *
25 * NOUT (input) INTEGER
26 * The unit number for output.
27 *
28 * NN (input) INTEGER
29 * The number of values of N contained in the vector NVAL.
30 *
31 * NVAL (input) INTEGER array, dimension (NN)
32 * The values of the matrix dimension N.
33 *
34 * A (workspace) COMPLEX*16 array, dimension (LDA,NMAX)
35 *
36 * LDA (input) INTEGER
37 * The leading dimension of the array A. LDA >= max(1,NMAX).
38 *
39 * ARF (workspace) COMPLEX*16 array, dimension ((NMAX*(NMAX+1))/2).
40 *
41 * AP (workspace) COMPLEX*16 array, dimension ((NMAX*(NMAX+1))/2).
42 *
43 * A2 (workspace) COMPLEX*16 array, dimension (LDA,NMAX)
44 *
45 * =====================================================================
46 * ..
47 * .. Local Scalars ..
48 LOGICAL LOWER, OK1, OK2
49 CHARACTER UPLO, CFORM
50 INTEGER I, IFORM, IIN, INFO, IUPLO, J, N,
51 + NERRS, NRUN
52 * ..
53 * .. Local Arrays ..
54 CHARACTER UPLOS( 2 ), FORMS( 2 )
55 INTEGER ISEED( 4 ), ISEEDY( 4 )
56 * ..
57 * .. External Functions ..
58 COMPLEX*16 ZLARND
59 EXTERNAL ZLARND
60 * ..
61 * .. External Subroutines ..
62 EXTERNAL ZTFTTR, ZTFTTP, ZTRTTF, ZTRTTP, ZTPTTR, ZTPTTF
63 * ..
64 * .. Scalars in Common ..
65 CHARACTER*32 SRNAMT
66 * ..
67 * .. Common blocks ..
68 COMMON / SRNAMC / SRNAMT
69 * ..
70 * .. Data statements ..
71 DATA ISEEDY / 1988, 1989, 1990, 1991 /
72 DATA UPLOS / 'U', 'L' /
73 DATA FORMS / 'N', 'C' /
74 * ..
75 * .. Executable Statements ..
76 *
77 * Initialize constants and the random number seed.
78 *
79 NRUN = 0
80 NERRS = 0
81 INFO = 0
82 DO 10 I = 1, 4
83 ISEED( I ) = ISEEDY( I )
84 10 CONTINUE
85 *
86 DO 120 IIN = 1, NN
87 *
88 N = NVAL( IIN )
89 *
90 * Do first for UPLO = 'U', then for UPLO = 'L'
91 *
92 DO 110 IUPLO = 1, 2
93 *
94 UPLO = UPLOS( IUPLO )
95 LOWER = .TRUE.
96 IF ( IUPLO.EQ.1 ) LOWER = .FALSE.
97 *
98 * Do first for CFORM = 'N', then for CFORM = 'C'
99 *
100 DO 100 IFORM = 1, 2
101 *
102 CFORM = FORMS( IFORM )
103 *
104 NRUN = NRUN + 1
105 *
106 DO J = 1, N
107 DO I = 1, N
108 A( I, J) = ZLARND( 4, ISEED )
109 END DO
110 END DO
111 *
112 SRNAMT = 'ZTRTTF'
113 CALL ZTRTTF( CFORM, UPLO, N, A, LDA, ARF, INFO )
114 *
115 SRNAMT = 'ZTFTTP'
116 CALL ZTFTTP( CFORM, UPLO, N, ARF, AP, INFO )
117 *
118 SRNAMT = 'ZTPTTR'
119 CALL ZTPTTR( UPLO, N, AP, ASAV, LDA, INFO )
120 *
121 OK1 = .TRUE.
122 IF ( LOWER ) THEN
123 DO J = 1, N
124 DO I = J, N
125 IF ( A(I,J).NE.ASAV(I,J) ) THEN
126 OK1 = .FALSE.
127 END IF
128 END DO
129 END DO
130 ELSE
131 DO J = 1, N
132 DO I = 1, J
133 IF ( A(I,J).NE.ASAV(I,J) ) THEN
134 OK1 = .FALSE.
135 END IF
136 END DO
137 END DO
138 END IF
139 *
140 NRUN = NRUN + 1
141 *
142 SRNAMT = 'ZTRTTP'
143 CALL ZTRTTP( UPLO, N, A, LDA, AP, INFO )
144 *
145 SRNAMT = 'ZTPTTF'
146 CALL ZTPTTF( CFORM, UPLO, N, AP, ARF, INFO )
147 *
148 SRNAMT = 'ZTFTTR'
149 CALL ZTFTTR( CFORM, UPLO, N, ARF, ASAV, LDA, INFO )
150 *
151 OK2 = .TRUE.
152 IF ( LOWER ) THEN
153 DO J = 1, N
154 DO I = J, N
155 IF ( A(I,J).NE.ASAV(I,J) ) THEN
156 OK2 = .FALSE.
157 END IF
158 END DO
159 END DO
160 ELSE
161 DO J = 1, N
162 DO I = 1, J
163 IF ( A(I,J).NE.ASAV(I,J) ) THEN
164 OK2 = .FALSE.
165 END IF
166 END DO
167 END DO
168 END IF
169 *
170 IF (( .NOT.OK1 ).OR.( .NOT.OK2 )) THEN
171 IF( NERRS.EQ.0 ) THEN
172 WRITE( NOUT, * )
173 WRITE( NOUT, FMT = 9999 )
174 END IF
175 WRITE( NOUT, FMT = 9998 ) N, UPLO, CFORM
176 NERRS = NERRS + 1
177 END IF
178 *
179 100 CONTINUE
180 110 CONTINUE
181 120 CONTINUE
182 *
183 * Print a summary of the results.
184 *
185 IF ( NERRS.EQ.0 ) THEN
186 WRITE( NOUT, FMT = 9997 ) NRUN
187 ELSE
188 WRITE( NOUT, FMT = 9996 ) NERRS, NRUN
189 END IF
190 *
191 9999 FORMAT( 1X, ' *** Error(s) while testing the RFP convertion',
192 + ' routines ***')
193 9998 FORMAT( 1X, ' Error in RFP,convertion routines N=',I5,
194 + ' UPLO=''', A1, ''', FORM =''',A1,'''')
195 9997 FORMAT( 1X, 'All tests for the RFP convertion routines passed (',
196 + I5,' tests run)')
197 9996 FORMAT( 1X, 'RFP convertion routines:',I5,' out of ',I5,
198 + ' error message recorded')
199 *
200 RETURN
201 *
202 * End of ZDRVRF2
203 *
204 END