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