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