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