1 SUBROUTINE CDRVRF1( NOUT, NN, NVAL, THRESH, A, LDA, ARF, WORK )
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 REAL THRESH
10 * ..
11 * .. Array Arguments ..
12 INTEGER NVAL( NN )
13 REAL WORK( * )
14 COMPLEX A( LDA, * ), ARF( * )
15 * ..
16 *
17 * Purpose
18 * =======
19 *
20 * CDRVRF1 tests the LAPACK RFP routines:
21 * CLANHF.F
22 *
23 * Arguments
24 * =========
25 *
26 * NOUT (input) INTEGER
27 * The unit number for output.
28 *
29 * NN (input) INTEGER
30 * The number of values of N contained in the vector NVAL.
31 *
32 * NVAL (input) INTEGER array, dimension (NN)
33 * The values of the matrix dimension N.
34 *
35 * THRESH (input) REAL
36 * The threshold value for the test ratios. A result is
37 * included in the output file if RESULT >= THRESH. To have
38 * every test ratio printed, use THRESH = 0.
39 *
40 * A (workspace) COMPLEX array, dimension (LDA,NMAX)
41 *
42 * LDA (input) INTEGER
43 * The leading dimension of the array A. LDA >= max(1,NMAX).
44 *
45 * ARF (workspace) COMPLEX array, dimension ((NMAX*(NMAX+1))/2).
46 *
47 * WORK (workspace) COMPLEX array, dimension ( NMAX )
48 *
49 * =====================================================================
50 * ..
51 * .. Parameters ..
52 REAL ONE
53 PARAMETER ( ONE = 1.0E+0 )
54 INTEGER NTESTS
55 PARAMETER ( NTESTS = 1 )
56 * ..
57 * .. Local Scalars ..
58 CHARACTER UPLO, CFORM, NORM
59 INTEGER I, IFORM, IIN, IIT, INFO, INORM, IUPLO, J, N,
60 + NERRS, NFAIL, NRUN
61 REAL EPS, LARGE, NORMA, NORMARF, SMALL
62 * ..
63 * .. Local Arrays ..
64 CHARACTER UPLOS( 2 ), FORMS( 2 ), NORMS( 4 )
65 INTEGER ISEED( 4 ), ISEEDY( 4 )
66 REAL RESULT( NTESTS )
67 * ..
68 * .. External Functions ..
69 COMPLEX CLARND
70 REAL SLAMCH, CLANHE, CLANHF
71 EXTERNAL SLAMCH, CLARND, CLANHE, CLANHF
72 * ..
73 * .. External Subroutines ..
74 EXTERNAL CTRTTF
75 * ..
76 * .. Scalars in Common ..
77 CHARACTER*32 SRNAMT
78 * ..
79 * .. Common blocks ..
80 COMMON / SRNAMC / SRNAMT
81 * ..
82 * .. Data statements ..
83 DATA ISEEDY / 1988, 1989, 1990, 1991 /
84 DATA UPLOS / 'U', 'L' /
85 DATA FORMS / 'N', 'C' /
86 DATA NORMS / 'M', '1', 'I', 'F' /
87 * ..
88 * .. Executable Statements ..
89 *
90 * Initialize constants and the random number seed.
91 *
92 NRUN = 0
93 NFAIL = 0
94 NERRS = 0
95 INFO = 0
96 DO 10 I = 1, 4
97 ISEED( I ) = ISEEDY( I )
98 10 CONTINUE
99 *
100 EPS = SLAMCH( 'Precision' )
101 SMALL = SLAMCH( 'Safe minimum' )
102 LARGE = ONE / SMALL
103 SMALL = SMALL * LDA * LDA
104 LARGE = LARGE / LDA / LDA
105 *
106 DO 130 IIN = 1, NN
107 *
108 N = NVAL( IIN )
109 *
110 DO 120 IIT = 1, 3
111 *
112 * IIT = 1 : random matrix
113 * IIT = 2 : random matrix scaled near underflow
114 * IIT = 3 : random matrix scaled near overflow
115 *
116 DO J = 1, N
117 DO I = 1, N
118 A( I, J) = CLARND( 4, ISEED )
119 END DO
120 END DO
121 *
122 IF ( IIT.EQ.2 ) THEN
123 DO J = 1, N
124 DO I = 1, N
125 A( I, J) = A( I, J ) * LARGE
126 END DO
127 END DO
128 END IF
129 *
130 IF ( IIT.EQ.3 ) THEN
131 DO J = 1, N
132 DO I = 1, N
133 A( I, J) = A( I, J) * SMALL
134 END DO
135 END DO
136 END IF
137 *
138 * Do first for UPLO = 'U', then for UPLO = 'L'
139 *
140 DO 110 IUPLO = 1, 2
141 *
142 UPLO = UPLOS( IUPLO )
143 *
144 * Do first for CFORM = 'N', then for CFORM = 'C'
145 *
146 DO 100 IFORM = 1, 2
147 *
148 CFORM = FORMS( IFORM )
149 *
150 SRNAMT = 'CTRTTF'
151 CALL CTRTTF( CFORM, UPLO, N, A, LDA, ARF, INFO )
152 *
153 * Check error code from CTRTTF
154 *
155 IF( INFO.NE.0 ) THEN
156 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) THEN
157 WRITE( NOUT, * )
158 WRITE( NOUT, FMT = 9999 )
159 END IF
160 WRITE( NOUT, FMT = 9998 ) SRNAMT, UPLO, CFORM, N
161 NERRS = NERRS + 1
162 GO TO 100
163 END IF
164 *
165 DO 90 INORM = 1, 4
166 *
167 * Check all four norms: 'M', '1', 'I', 'F'
168 *
169 NORM = NORMS( INORM )
170 NORMARF = CLANHF( NORM, CFORM, UPLO, N, ARF, WORK )
171 NORMA = CLANHE( NORM, UPLO, N, A, LDA, WORK )
172 *
173 RESULT(1) = ( NORMA - NORMARF ) / NORMA / EPS
174 NRUN = NRUN + 1
175 *
176 IF( RESULT(1).GE.THRESH ) THEN
177 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) THEN
178 WRITE( NOUT, * )
179 WRITE( NOUT, FMT = 9999 )
180 END IF
181 WRITE( NOUT, FMT = 9997 ) 'CLANHF',
182 + N, IIT, UPLO, CFORM, NORM, RESULT(1)
183 NFAIL = NFAIL + 1
184 END IF
185 90 CONTINUE
186 100 CONTINUE
187 110 CONTINUE
188 120 CONTINUE
189 130 CONTINUE
190 *
191 * Print a summary of the results.
192 *
193 IF ( NFAIL.EQ.0 ) THEN
194 WRITE( NOUT, FMT = 9996 )'CLANHF', NRUN
195 ELSE
196 WRITE( NOUT, FMT = 9995 ) 'CLANHF', NFAIL, NRUN
197 END IF
198 IF ( NERRS.NE.0 ) THEN
199 WRITE( NOUT, FMT = 9994 ) NERRS, 'CLANHF'
200 END IF
201 *
202 9999 FORMAT( 1X, ' *** Error(s) or Failure(s) while testing CLANHF
203 + ***')
204 9998 FORMAT( 1X, ' Error in ',A6,' with UPLO=''',A1,''', FORM=''',
205 + A1,''', N=',I5)
206 9997 FORMAT( 1X, ' Failure in ',A6,' N=',I5,' TYPE=',I5,' UPLO=''',
207 + A1, ''', FORM =''',A1,''', NORM=''',A1,''', test=',G12.5)
208 9996 FORMAT( 1X, 'All tests for ',A6,' auxiliary routine passed the ',
209 + 'threshold (',I5,' tests run)')
210 9995 FORMAT( 1X, A6, ' auxiliary routine:',I5,' out of ',I5,
211 + ' tests failed to pass the threshold')
212 9994 FORMAT( 26X, I5,' error message recorded (',A6,')')
213 *
214 RETURN
215 *
216 * End of CDRVRF1
217 *
218 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 REAL THRESH
10 * ..
11 * .. Array Arguments ..
12 INTEGER NVAL( NN )
13 REAL WORK( * )
14 COMPLEX A( LDA, * ), ARF( * )
15 * ..
16 *
17 * Purpose
18 * =======
19 *
20 * CDRVRF1 tests the LAPACK RFP routines:
21 * CLANHF.F
22 *
23 * Arguments
24 * =========
25 *
26 * NOUT (input) INTEGER
27 * The unit number for output.
28 *
29 * NN (input) INTEGER
30 * The number of values of N contained in the vector NVAL.
31 *
32 * NVAL (input) INTEGER array, dimension (NN)
33 * The values of the matrix dimension N.
34 *
35 * THRESH (input) REAL
36 * The threshold value for the test ratios. A result is
37 * included in the output file if RESULT >= THRESH. To have
38 * every test ratio printed, use THRESH = 0.
39 *
40 * A (workspace) COMPLEX array, dimension (LDA,NMAX)
41 *
42 * LDA (input) INTEGER
43 * The leading dimension of the array A. LDA >= max(1,NMAX).
44 *
45 * ARF (workspace) COMPLEX array, dimension ((NMAX*(NMAX+1))/2).
46 *
47 * WORK (workspace) COMPLEX array, dimension ( NMAX )
48 *
49 * =====================================================================
50 * ..
51 * .. Parameters ..
52 REAL ONE
53 PARAMETER ( ONE = 1.0E+0 )
54 INTEGER NTESTS
55 PARAMETER ( NTESTS = 1 )
56 * ..
57 * .. Local Scalars ..
58 CHARACTER UPLO, CFORM, NORM
59 INTEGER I, IFORM, IIN, IIT, INFO, INORM, IUPLO, J, N,
60 + NERRS, NFAIL, NRUN
61 REAL EPS, LARGE, NORMA, NORMARF, SMALL
62 * ..
63 * .. Local Arrays ..
64 CHARACTER UPLOS( 2 ), FORMS( 2 ), NORMS( 4 )
65 INTEGER ISEED( 4 ), ISEEDY( 4 )
66 REAL RESULT( NTESTS )
67 * ..
68 * .. External Functions ..
69 COMPLEX CLARND
70 REAL SLAMCH, CLANHE, CLANHF
71 EXTERNAL SLAMCH, CLARND, CLANHE, CLANHF
72 * ..
73 * .. External Subroutines ..
74 EXTERNAL CTRTTF
75 * ..
76 * .. Scalars in Common ..
77 CHARACTER*32 SRNAMT
78 * ..
79 * .. Common blocks ..
80 COMMON / SRNAMC / SRNAMT
81 * ..
82 * .. Data statements ..
83 DATA ISEEDY / 1988, 1989, 1990, 1991 /
84 DATA UPLOS / 'U', 'L' /
85 DATA FORMS / 'N', 'C' /
86 DATA NORMS / 'M', '1', 'I', 'F' /
87 * ..
88 * .. Executable Statements ..
89 *
90 * Initialize constants and the random number seed.
91 *
92 NRUN = 0
93 NFAIL = 0
94 NERRS = 0
95 INFO = 0
96 DO 10 I = 1, 4
97 ISEED( I ) = ISEEDY( I )
98 10 CONTINUE
99 *
100 EPS = SLAMCH( 'Precision' )
101 SMALL = SLAMCH( 'Safe minimum' )
102 LARGE = ONE / SMALL
103 SMALL = SMALL * LDA * LDA
104 LARGE = LARGE / LDA / LDA
105 *
106 DO 130 IIN = 1, NN
107 *
108 N = NVAL( IIN )
109 *
110 DO 120 IIT = 1, 3
111 *
112 * IIT = 1 : random matrix
113 * IIT = 2 : random matrix scaled near underflow
114 * IIT = 3 : random matrix scaled near overflow
115 *
116 DO J = 1, N
117 DO I = 1, N
118 A( I, J) = CLARND( 4, ISEED )
119 END DO
120 END DO
121 *
122 IF ( IIT.EQ.2 ) THEN
123 DO J = 1, N
124 DO I = 1, N
125 A( I, J) = A( I, J ) * LARGE
126 END DO
127 END DO
128 END IF
129 *
130 IF ( IIT.EQ.3 ) THEN
131 DO J = 1, N
132 DO I = 1, N
133 A( I, J) = A( I, J) * SMALL
134 END DO
135 END DO
136 END IF
137 *
138 * Do first for UPLO = 'U', then for UPLO = 'L'
139 *
140 DO 110 IUPLO = 1, 2
141 *
142 UPLO = UPLOS( IUPLO )
143 *
144 * Do first for CFORM = 'N', then for CFORM = 'C'
145 *
146 DO 100 IFORM = 1, 2
147 *
148 CFORM = FORMS( IFORM )
149 *
150 SRNAMT = 'CTRTTF'
151 CALL CTRTTF( CFORM, UPLO, N, A, LDA, ARF, INFO )
152 *
153 * Check error code from CTRTTF
154 *
155 IF( INFO.NE.0 ) THEN
156 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) THEN
157 WRITE( NOUT, * )
158 WRITE( NOUT, FMT = 9999 )
159 END IF
160 WRITE( NOUT, FMT = 9998 ) SRNAMT, UPLO, CFORM, N
161 NERRS = NERRS + 1
162 GO TO 100
163 END IF
164 *
165 DO 90 INORM = 1, 4
166 *
167 * Check all four norms: 'M', '1', 'I', 'F'
168 *
169 NORM = NORMS( INORM )
170 NORMARF = CLANHF( NORM, CFORM, UPLO, N, ARF, WORK )
171 NORMA = CLANHE( NORM, UPLO, N, A, LDA, WORK )
172 *
173 RESULT(1) = ( NORMA - NORMARF ) / NORMA / EPS
174 NRUN = NRUN + 1
175 *
176 IF( RESULT(1).GE.THRESH ) THEN
177 IF( NFAIL.EQ.0 .AND. NERRS.EQ.0 ) THEN
178 WRITE( NOUT, * )
179 WRITE( NOUT, FMT = 9999 )
180 END IF
181 WRITE( NOUT, FMT = 9997 ) 'CLANHF',
182 + N, IIT, UPLO, CFORM, NORM, RESULT(1)
183 NFAIL = NFAIL + 1
184 END IF
185 90 CONTINUE
186 100 CONTINUE
187 110 CONTINUE
188 120 CONTINUE
189 130 CONTINUE
190 *
191 * Print a summary of the results.
192 *
193 IF ( NFAIL.EQ.0 ) THEN
194 WRITE( NOUT, FMT = 9996 )'CLANHF', NRUN
195 ELSE
196 WRITE( NOUT, FMT = 9995 ) 'CLANHF', NFAIL, NRUN
197 END IF
198 IF ( NERRS.NE.0 ) THEN
199 WRITE( NOUT, FMT = 9994 ) NERRS, 'CLANHF'
200 END IF
201 *
202 9999 FORMAT( 1X, ' *** Error(s) or Failure(s) while testing CLANHF
203 + ***')
204 9998 FORMAT( 1X, ' Error in ',A6,' with UPLO=''',A1,''', FORM=''',
205 + A1,''', N=',I5)
206 9997 FORMAT( 1X, ' Failure in ',A6,' N=',I5,' TYPE=',I5,' UPLO=''',
207 + A1, ''', FORM =''',A1,''', NORM=''',A1,''', test=',G12.5)
208 9996 FORMAT( 1X, 'All tests for ',A6,' auxiliary routine passed the ',
209 + 'threshold (',I5,' tests run)')
210 9995 FORMAT( 1X, A6, ' auxiliary routine:',I5,' out of ',I5,
211 + ' tests failed to pass the threshold')
212 9994 FORMAT( 26X, I5,' error message recorded (',A6,')')
213 *
214 RETURN
215 *
216 * End of CDRVRF1
217 *
218 END