LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
alahdg.f
Go to the documentation of this file.
1*> \brief \b ALAHDG
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8* Definition:
9* ===========
10*
11* SUBROUTINE ALAHDG( IOUNIT, PATH )
12*
13* .. Scalar Arguments ..
14* CHARACTER*3 PATH
15* INTEGER IOUNIT
16* ..
17*
18*
19*> \par Purpose:
20* =============
21*>
22*> \verbatim
23*>
24*> ALAHDG prints header information for the different test paths.
25*> \endverbatim
26*
27* Arguments:
28* ==========
29*
30*> \param[in] IOUNIT
31*> \verbatim
32*> IOUNIT is INTEGER
33*> The unit number to which the header information should be
34*> printed.
35*> \endverbatim
36*>
37*> \param[in] PATH
38*> \verbatim
39*> PATH is CHARACTER*3
40*> The name of the path for which the header information is to
41*> be printed. Current paths are
42*> GQR: GQR (general matrices)
43*> GRQ: GRQ (general matrices)
44*> LSE: LSE Problem
45*> GLM: GLM Problem
46*> GSV: Generalized Singular Value Decomposition
47*> CSD: CS Decomposition
48*> \endverbatim
49*
50* Authors:
51* ========
52*
53*> \author Univ. of Tennessee
54*> \author Univ. of California Berkeley
55*> \author Univ. of Colorado Denver
56*> \author NAG Ltd.
57*
58*> \ingroup aux_eig
59*
60* =====================================================================
61 SUBROUTINE alahdg( IOUNIT, PATH )
62*
63* -- LAPACK test routine --
64* -- LAPACK is a software package provided by Univ. of Tennessee, --
65* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
66*
67* .. Scalar Arguments ..
68 CHARACTER*3 PATH
69 INTEGER IOUNIT
70* ..
71*
72* =====================================================================
73*
74* .. Local Scalars ..
75 CHARACTER*3 C2
76 INTEGER ITYPE
77* ..
78* .. External Functions ..
79 LOGICAL LSAMEN
80 EXTERNAL lsamen
81* ..
82* .. Executable Statements ..
83*
84 IF( iounit.LE.0 )
85 $ RETURN
86 c2 = path( 1: 3 )
87*
88* First line describing matrices in this path
89*
90 IF( lsamen( 3, c2, 'GQR' ) ) THEN
91 itype = 1
92 WRITE( iounit, fmt = 9991 )path
93 ELSE IF( lsamen( 3, c2, 'GRQ' ) ) THEN
94 itype = 2
95 WRITE( iounit, fmt = 9992 )path
96 ELSE IF( lsamen( 3, c2, 'LSE' ) ) THEN
97 itype = 3
98 WRITE( iounit, fmt = 9993 )path
99 ELSE IF( lsamen( 3, c2, 'GLM' ) ) THEN
100 itype = 4
101 WRITE( iounit, fmt = 9994 )path
102 ELSE IF( lsamen( 3, c2, 'GSV' ) ) THEN
103 itype = 5
104 WRITE( iounit, fmt = 9995 )path
105 ELSE IF( lsamen( 3, c2, 'CSD' ) ) THEN
106 itype = 6
107 WRITE( iounit, fmt = 9996 )path
108 END IF
109*
110* Matrix types
111*
112 WRITE( iounit, fmt = 9999 )'Matrix types: '
113*
114 IF( itype.EQ.1 )THEN
115 WRITE( iounit, fmt = 9950 )1
116 WRITE( iounit, fmt = 9952 )2
117 WRITE( iounit, fmt = 9954 )3
118 WRITE( iounit, fmt = 9955 )4
119 WRITE( iounit, fmt = 9956 )5
120 WRITE( iounit, fmt = 9957 )6
121 WRITE( iounit, fmt = 9961 )7
122 WRITE( iounit, fmt = 9962 )8
123 ELSE IF( itype.EQ.2 )THEN
124 WRITE( iounit, fmt = 9951 )1
125 WRITE( iounit, fmt = 9953 )2
126 WRITE( iounit, fmt = 9954 )3
127 WRITE( iounit, fmt = 9955 )4
128 WRITE( iounit, fmt = 9956 )5
129 WRITE( iounit, fmt = 9957 )6
130 WRITE( iounit, fmt = 9961 )7
131 WRITE( iounit, fmt = 9962 )8
132 ELSE IF( itype.EQ.3 )THEN
133 WRITE( iounit, fmt = 9950 )1
134 WRITE( iounit, fmt = 9952 )2
135 WRITE( iounit, fmt = 9954 )3
136 WRITE( iounit, fmt = 9955 )4
137 WRITE( iounit, fmt = 9955 )5
138 WRITE( iounit, fmt = 9955 )6
139 WRITE( iounit, fmt = 9955 )7
140 WRITE( iounit, fmt = 9955 )8
141 ELSE IF( itype.EQ.4 )THEN
142 WRITE( iounit, fmt = 9951 )1
143 WRITE( iounit, fmt = 9953 )2
144 WRITE( iounit, fmt = 9954 )3
145 WRITE( iounit, fmt = 9955 )4
146 WRITE( iounit, fmt = 9955 )5
147 WRITE( iounit, fmt = 9955 )6
148 WRITE( iounit, fmt = 9955 )7
149 WRITE( iounit, fmt = 9955 )8
150 ELSE IF( itype.EQ.5 )THEN
151 WRITE( iounit, fmt = 9950 )1
152 WRITE( iounit, fmt = 9952 )2
153 WRITE( iounit, fmt = 9954 )3
154 WRITE( iounit, fmt = 9955 )4
155 WRITE( iounit, fmt = 9956 )5
156 WRITE( iounit, fmt = 9957 )6
157 WRITE( iounit, fmt = 9959 )7
158 WRITE( iounit, fmt = 9960 )8
159 ELSE IF( itype.EQ.6 )THEN
160 WRITE( iounit, fmt = 9963 )1
161 WRITE( iounit, fmt = 9964 )2
162 WRITE( iounit, fmt = 9965 )3
163 END IF
164*
165* Tests performed
166*
167 WRITE( iounit, fmt = 9999 )'Test ratios: '
168*
169 IF( itype.EQ.1 ) THEN
170*
171* GQR decomposition of rectangular matrices
172*
173 WRITE( iounit, fmt = 9930 )1
174 WRITE( iounit, fmt = 9931 )2
175 WRITE( iounit, fmt = 9932 )3
176 WRITE( iounit, fmt = 9933 )4
177 ELSE IF( itype.EQ.2 ) THEN
178*
179* GRQ decomposition of rectangular matrices
180*
181 WRITE( iounit, fmt = 9934 )1
182 WRITE( iounit, fmt = 9935 )2
183 WRITE( iounit, fmt = 9932 )3
184 WRITE( iounit, fmt = 9933 )4
185 ELSE IF( itype.EQ.3 ) THEN
186*
187* LSE Problem
188*
189 WRITE( iounit, fmt = 9937 )1
190 WRITE( iounit, fmt = 9938 )2
191 ELSE IF( itype.EQ.4 ) THEN
192*
193* GLM Problem
194*
195 WRITE( iounit, fmt = 9939 )1
196 ELSE IF( itype.EQ.5 ) THEN
197*
198* GSVD
199*
200 WRITE( iounit, fmt = 9940 )1
201 WRITE( iounit, fmt = 9941 )2
202 WRITE( iounit, fmt = 9942 )3
203 WRITE( iounit, fmt = 9943 )4
204 WRITE( iounit, fmt = 9944 )5
205 ELSE IF( itype.EQ.6 ) THEN
206*
207* CSD
208*
209 WRITE( iounit, fmt = 9910 )
210 WRITE( iounit, fmt = 9911 )1
211 WRITE( iounit, fmt = 9912 )2
212 WRITE( iounit, fmt = 9913 )3
213 WRITE( iounit, fmt = 9914 )4
214 WRITE( iounit, fmt = 9915 )5
215 WRITE( iounit, fmt = 9916 )6
216 WRITE( iounit, fmt = 9917 )7
217 WRITE( iounit, fmt = 9918 )8
218 WRITE( iounit, fmt = 9919 )9
219 WRITE( iounit, fmt = 9920 )
220 WRITE( iounit, fmt = 9921 )10
221 WRITE( iounit, fmt = 9922 )11
222 WRITE( iounit, fmt = 9923 )12
223 WRITE( iounit, fmt = 9924 )13
224 WRITE( iounit, fmt = 9925 )14
225 WRITE( iounit, fmt = 9926 )15
226 END IF
227*
228 9999 FORMAT( 1x, a )
229 9991 FORMAT( / 1x, a3, ': GQR factorization of general matrices' )
230 9992 FORMAT( / 1x, a3, ': GRQ factorization of general matrices' )
231 9993 FORMAT( / 1x, a3, ': LSE Problem' )
232 9994 FORMAT( / 1x, a3, ': GLM Problem' )
233 9995 FORMAT( / 1x, a3, ': Generalized Singular Value Decomposition' )
234 9996 FORMAT( / 1x, a3, ': CS Decomposition' )
235*
236 9950 FORMAT( 3x, i2, ': A-diagonal matrix B-upper triangular' )
237 9951 FORMAT( 3x, i2, ': A-diagonal matrix B-lower triangular' )
238 9952 FORMAT( 3x, i2, ': A-upper triangular B-upper triangular' )
239 9953 FORMAT( 3x, i2, ': A-lower triangular B-diagonal triangular' )
240 9954 FORMAT( 3x, i2, ': A-lower triangular B-upper triangular' )
241*
242 9955 FORMAT( 3x, i2, ': Random matrices cond(A)=100, cond(B)=10,' )
243*
244 9956 FORMAT( 3x, i2, ': Random matrices cond(A)= sqrt( 0.1/EPS ) ',
245 $ 'cond(B)= sqrt( 0.1/EPS )' )
246 9957 FORMAT( 3x, i2, ': Random matrices cond(A)= 0.1/EPS ',
247 $ 'cond(B)= 0.1/EPS' )
248 9959 FORMAT( 3x, i2, ': Random matrices cond(A)= sqrt( 0.1/EPS ) ',
249 $ 'cond(B)= 0.1/EPS ' )
250 9960 FORMAT( 3x, i2, ': Random matrices cond(A)= 0.1/EPS ',
251 $ 'cond(B)= sqrt( 0.1/EPS )' )
252*
253 9961 FORMAT( 3x, i2, ': Matrix scaled near underflow limit' )
254 9962 FORMAT( 3x, i2, ': Matrix scaled near overflow limit' )
255 9963 FORMAT( 3x, i2, ': Random orthogonal matrix (Haar measure)' )
256 9964 FORMAT( 3x, i2, ': Nearly orthogonal matrix with uniformly ',
257 $ 'distributed angles atan2( S, C ) in CS decomposition' )
258 9965 FORMAT( 3x, i2, ': Random orthogonal matrix with clustered ',
259 $ 'angles atan2( S, C ) in CS decomposition' )
260*
261*
262* GQR test ratio
263*
264 9930 FORMAT( 3x, i2, ': norm( R - Q'' * A ) / ( min( N, M )*norm( A )',
265 $ '* EPS )' )
266 9931 FORMAT( 3x, i2, ': norm( T * Z - Q'' * B ) / ( min(P,N)*norm(B)',
267 $ '* EPS )' )
268 9932 FORMAT( 3x, i2, ': norm( I - Q''*Q ) / ( N * EPS )' )
269 9933 FORMAT( 3x, i2, ': norm( I - Z''*Z ) / ( P * EPS )' )
270*
271* GRQ test ratio
272*
273 9934 FORMAT( 3x, i2, ': norm( R - A * Q'' ) / ( min( N,M )*norm(A) * ',
274 $ 'EPS )' )
275 9935 FORMAT( 3x, i2, ': norm( T * Q - Z'' * B ) / ( min( P,N ) * nor',
276 $ 'm(B)*EPS )' )
277*
278* LSE test ratio
279*
280 9937 FORMAT( 3x, i2, ': norm( A*x - c ) / ( norm(A)*norm(x) * EPS )' )
281 9938 FORMAT( 3x, i2, ': norm( B*x - d ) / ( norm(B)*norm(x) * EPS )' )
282*
283* GLM test ratio
284*
285 9939 FORMAT( 3x, i2, ': norm( d - A*x - B*y ) / ( (norm(A)+norm(B) )*',
286 $ '(norm(x)+norm(y))*EPS )' )
287*
288* GSVD test ratio
289*
290 9940 FORMAT( 3x, i2, ': norm( U'' * A * Q - D1 * R ) / ( min( M, N )*',
291 $ 'norm( A ) * EPS )' )
292 9941 FORMAT( 3x, i2, ': norm( V'' * B * Q - D2 * R ) / ( min( P, N )*',
293 $ 'norm( B ) * EPS )' )
294 9942 FORMAT( 3x, i2, ': norm( I - U''*U ) / ( M * EPS )' )
295 9943 FORMAT( 3x, i2, ': norm( I - V''*V ) / ( P * EPS )' )
296 9944 FORMAT( 3x, i2, ': norm( I - Q''*Q ) / ( N * EPS )' )
297*
298* CSD test ratio
299*
300 9910 FORMAT( 3x, '2-by-2 CSD' )
301 9911 FORMAT( 3x, i2, ': norm( U1'' * X11 * V1 - C ) / ( max( P, Q)',
302 $ ' * max(norm(I-X''*X),EPS) )' )
303 9912 FORMAT( 3x, i2, ': norm( U1'' * X12 * V2-(-S)) / ( max( P,',
304 $ 'M-Q) * max(norm(I-X''*X),EPS) )' )
305 9913 FORMAT( 3x, i2, ': norm( U2'' * X21 * V1 - S ) / ( max(M-P,',
306 $ ' Q) * max(norm(I-X''*X),EPS) )' )
307 9914 FORMAT( 3x, i2, ': norm( U2'' * X22 * V2 - C ) / ( max(M-P,',
308 $ 'M-Q) * max(norm(I-X''*X),EPS) )' )
309 9915 FORMAT( 3x, i2, ': norm( I - U1''*U1 ) / ( P * EPS )' )
310 9916 FORMAT( 3x, i2, ': norm( I - U2''*U2 ) / ( (M-P) * EPS )' )
311 9917 FORMAT( 3x, i2, ': norm( I - V1''*V1 ) / ( Q * EPS )' )
312 9918 FORMAT( 3x, i2, ': norm( I - V2''*V2 ) / ( (M-Q) * EPS )' )
313 9919 FORMAT( 3x, i2, ': principal angle ordering ( 0 or ULP )' )
314 9920 FORMAT( 3x, '2-by-1 CSD' )
315 9921 FORMAT( 3x, i2, ': norm( U1'' * X11 * V1 - C ) / ( max( P, Q)',
316 $ ' * max(norm(I-X''*X),EPS) )' )
317 9922 FORMAT( 3x, i2, ': norm( U2'' * X21 * V1 - S ) / ( max( M-P,',
318 $ 'Q) * max(norm(I-X''*X),EPS) )' )
319 9923 FORMAT( 3x, i2, ': norm( I - U1''*U1 ) / ( P * EPS )' )
320 9924 FORMAT( 3x, i2, ': norm( I - U2''*U2 ) / ( (M-P) * EPS )' )
321 9925 FORMAT( 3x, i2, ': norm( I - V1''*V1 ) / ( Q * EPS )' )
322 9926 FORMAT( 3x, i2, ': principal angle ordering ( 0 or ULP )' )
323 RETURN
324*
325* End of ALAHDG
326*
327 END
alahdg
subroutine alahdg(iounit, path)
ALAHDG
Definition alahdg.f:62