LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
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 *> \date November 2011
59 *
60 *> \ingroup aux_eig
61 *
62 * =====================================================================
63  SUBROUTINE alahdg( IOUNIT, PATH )
64 *
65 * -- LAPACK test routine (version 3.4.0) --
66 * -- LAPACK is a software package provided by Univ. of Tennessee, --
67 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
68 * November 2011
69 *
70 * .. Scalar Arguments ..
71  CHARACTER*3 path
72  INTEGER iounit
73 * ..
74 *
75 * =====================================================================
76 *
77 * .. Local Scalars ..
78  CHARACTER*3 c2
79  INTEGER itype
80 * ..
81 * .. External Functions ..
82  LOGICAL lsamen
83  EXTERNAL lsamen
84 * ..
85 * .. Executable Statements ..
86 *
87  IF( iounit.LE.0 )
88  $ return
89  c2 = path( 1: 3 )
90 *
91 * First line describing matrices in this path
92 *
93  IF( lsamen( 3, c2, 'GQR' ) ) THEN
94  itype = 1
95  WRITE( iounit, fmt = 9991 )path
96  ELSE IF( lsamen( 3, c2, 'GRQ' ) ) THEN
97  itype = 2
98  WRITE( iounit, fmt = 9992 )path
99  ELSE IF( lsamen( 3, c2, 'LSE' ) ) THEN
100  itype = 3
101  WRITE( iounit, fmt = 9993 )path
102  ELSE IF( lsamen( 3, c2, 'GLM' ) ) THEN
103  itype = 4
104  WRITE( iounit, fmt = 9994 )path
105  ELSE IF( lsamen( 3, c2, 'GSV' ) ) THEN
106  itype = 5
107  WRITE( iounit, fmt = 9995 )path
108  ELSE IF( lsamen( 3, c2, 'CSD' ) ) THEN
109  itype = 6
110  WRITE( iounit, fmt = 9996 )path
111  END IF
112 *
113 * Matrix types
114 *
115  WRITE( iounit, fmt = 9999 )'Matrix types: '
116 *
117  IF( itype.EQ.1 )THEN
118  WRITE( iounit, fmt = 9950 )1
119  WRITE( iounit, fmt = 9952 )2
120  WRITE( iounit, fmt = 9954 )3
121  WRITE( iounit, fmt = 9955 )4
122  WRITE( iounit, fmt = 9956 )5
123  WRITE( iounit, fmt = 9957 )6
124  WRITE( iounit, fmt = 9961 )7
125  WRITE( iounit, fmt = 9962 )8
126  ELSE IF( itype.EQ.2 )THEN
127  WRITE( iounit, fmt = 9951 )1
128  WRITE( iounit, fmt = 9953 )2
129  WRITE( iounit, fmt = 9954 )3
130  WRITE( iounit, fmt = 9955 )4
131  WRITE( iounit, fmt = 9956 )5
132  WRITE( iounit, fmt = 9957 )6
133  WRITE( iounit, fmt = 9961 )7
134  WRITE( iounit, fmt = 9962 )8
135  ELSE IF( itype.EQ.3 )THEN
136  WRITE( iounit, fmt = 9950 )1
137  WRITE( iounit, fmt = 9952 )2
138  WRITE( iounit, fmt = 9954 )3
139  WRITE( iounit, fmt = 9955 )4
140  WRITE( iounit, fmt = 9955 )5
141  WRITE( iounit, fmt = 9955 )6
142  WRITE( iounit, fmt = 9955 )7
143  WRITE( iounit, fmt = 9955 )8
144  ELSE IF( itype.EQ.4 )THEN
145  WRITE( iounit, fmt = 9951 )1
146  WRITE( iounit, fmt = 9953 )2
147  WRITE( iounit, fmt = 9954 )3
148  WRITE( iounit, fmt = 9955 )4
149  WRITE( iounit, fmt = 9955 )5
150  WRITE( iounit, fmt = 9955 )6
151  WRITE( iounit, fmt = 9955 )7
152  WRITE( iounit, fmt = 9955 )8
153  ELSE IF( itype.EQ.5 )THEN
154  WRITE( iounit, fmt = 9950 )1
155  WRITE( iounit, fmt = 9952 )2
156  WRITE( iounit, fmt = 9954 )3
157  WRITE( iounit, fmt = 9955 )4
158  WRITE( iounit, fmt = 9956 )5
159  WRITE( iounit, fmt = 9957 )6
160  WRITE( iounit, fmt = 9959 )7
161  WRITE( iounit, fmt = 9960 )8
162  ELSE IF( itype.EQ.6 )THEN
163  WRITE( iounit, fmt = 9963 )1
164  WRITE( iounit, fmt = 9964 )2
165  WRITE( iounit, fmt = 9965 )3
166  END IF
167 *
168 * Tests performed
169 *
170  WRITE( iounit, fmt = 9999 )'Test ratios: '
171 *
172  IF( itype.EQ.1 ) THEN
173 *
174 * GQR decomposition of rectangular matrices
175 *
176  WRITE( iounit, fmt = 9930 )1
177  WRITE( iounit, fmt = 9931 )2
178  WRITE( iounit, fmt = 9932 )3
179  WRITE( iounit, fmt = 9933 )4
180  ELSE IF( itype.EQ.2 ) THEN
181 *
182 * GRQ decomposition of rectangular matrices
183 *
184  WRITE( iounit, fmt = 9934 )1
185  WRITE( iounit, fmt = 9935 )2
186  WRITE( iounit, fmt = 9932 )3
187  WRITE( iounit, fmt = 9933 )4
188  ELSE IF( itype.EQ.3 ) THEN
189 *
190 * LSE Problem
191 *
192  WRITE( iounit, fmt = 9937 )1
193  WRITE( iounit, fmt = 9938 )2
194  ELSE IF( itype.EQ.4 ) THEN
195 *
196 * GLM Problem
197 *
198  WRITE( iounit, fmt = 9939 )1
199  ELSE IF( itype.EQ.5 ) THEN
200 *
201 * GSVD
202 *
203  WRITE( iounit, fmt = 9940 )1
204  WRITE( iounit, fmt = 9941 )2
205  WRITE( iounit, fmt = 9942 )3
206  WRITE( iounit, fmt = 9943 )4
207  WRITE( iounit, fmt = 9944 )5
208  ELSE IF( itype.EQ.6 ) THEN
209 *
210 * CSD
211 *
212  WRITE( iounit, fmt = 9920 )1
213  WRITE( iounit, fmt = 9921 )2
214  WRITE( iounit, fmt = 9922 )3
215  WRITE( iounit, fmt = 9923 )4
216  WRITE( iounit, fmt = 9924 )5
217  WRITE( iounit, fmt = 9925 )6
218  WRITE( iounit, fmt = 9926 )7
219  WRITE( iounit, fmt = 9927 )8
220  END IF
221 *
222  9999 format( 1x, a )
223  9991 format( / 1x, a3, ': GQR factorization of general matrices' )
224  9992 format( / 1x, a3, ': GRQ factorization of general matrices' )
225  9993 format( / 1x, a3, ': LSE Problem' )
226  9994 format( / 1x, a3, ': GLM Problem' )
227  9995 format( / 1x, a3, ': Generalized Singular Value Decomposition' )
228  9996 format( / 1x, a3, ': CS Decomposition' )
229 *
230  9950 format( 3x, i2, ': A-diagonal matrix B-upper triangular' )
231  9951 format( 3x, i2, ': A-diagonal matrix B-lower triangular' )
232  9952 format( 3x, i2, ': A-upper triangular B-upper triangular' )
233  9953 format( 3x, i2, ': A-lower triangular B-diagonal triangular' )
234  9954 format( 3x, i2, ': A-lower triangular B-upper triangular' )
235 *
236  9955 format( 3x, i2, ': Random matrices cond(A)=100, cond(B)=10,' )
237 *
238  9956 format( 3x, i2, ': Random matrices cond(A)= sqrt( 0.1/EPS ) ',
239  $ 'cond(B)= sqrt( 0.1/EPS )' )
240  9957 format( 3x, i2, ': Random matrices cond(A)= 0.1/EPS ',
241  $ 'cond(B)= 0.1/EPS' )
242  9959 format( 3x, i2, ': Random matrices cond(A)= sqrt( 0.1/EPS ) ',
243  $ 'cond(B)= 0.1/EPS ' )
244  9960 format( 3x, i2, ': Random matrices cond(A)= 0.1/EPS ',
245  $ 'cond(B)= sqrt( 0.1/EPS )' )
246 *
247  9961 format( 3x, i2, ': Matrix scaled near underflow limit' )
248  9962 format( 3x, i2, ': Matrix scaled near overflow limit' )
249  9963 format( 3x, i2, ': Random orthogonal matrix (Haar measure)' )
250  9964 format( 3x, i2, ': Nearly orthogonal matrix with uniformly ',
251  $ 'distributed angles atan2( S, C ) in CS decomposition' )
252  9965 format( 3x, i2, ': Random orthogonal matrix with clustered ',
253  $ 'angles atan2( S, C ) in CS decomposition' )
254 *
255 *
256 * GQR test ratio
257 *
258  9930 format( 3x, i2, ': norm( R - Q'' * A ) / ( min( N, M )*norm( A )',
259  $ '* EPS )' )
260  9931 format( 3x, i2, ': norm( T * Z - Q'' * B ) / ( min(P,N)*norm(B)',
261  $ '* EPS )' )
262  9932 format( 3x, i2, ': norm( I - Q''*Q ) / ( N * EPS )' )
263  9933 format( 3x, i2, ': norm( I - Z''*Z ) / ( P * EPS )' )
264 *
265 * GRQ test ratio
266 *
267  9934 format( 3x, i2, ': norm( R - A * Q'' ) / ( min( N,M )*norm(A) * ',
268  $ 'EPS )' )
269  9935 format( 3x, i2, ': norm( T * Q - Z'' * B ) / ( min( P,N ) * nor',
270  $ 'm(B)*EPS )' )
271 *
272 * LSE test ratio
273 *
274  9937 format( 3x, i2, ': norm( A*x - c ) / ( norm(A)*norm(x) * EPS )' )
275  9938 format( 3x, i2, ': norm( B*x - d ) / ( norm(B)*norm(x) * EPS )' )
276 *
277 * GLM test ratio
278 *
279  9939 format( 3x, i2, ': norm( d - A*x - B*y ) / ( (norm(A)+norm(B) )*',
280  $ '(norm(x)+norm(y))*EPS )' )
281 *
282 * GSVD test ratio
283 *
284  9940 format( 3x, i2, ': norm( U'' * A * Q - D1 * R ) / ( min( M, N )*',
285  $ 'norm( A ) * EPS )' )
286  9941 format( 3x, i2, ': norm( V'' * B * Q - D2 * R ) / ( min( P, N )*',
287  $ 'norm( B ) * EPS )' )
288  9942 format( 3x, i2, ': norm( I - U''*U ) / ( M * EPS )' )
289  9943 format( 3x, i2, ': norm( I - V''*V ) / ( P * EPS )' )
290  9944 format( 3x, i2, ': norm( I - Q''*Q ) / ( N * EPS )' )
291 *
292 * CSD test ratio
293 *
294  9920 format( 3x, i2, ': norm( U1'' * X11 * V1 - C ) / ( max( P, Q)',
295  $ ' * max(norm(I-X''*X),EPS) )' )
296  9921 format( 3x, i2, ': norm( U1'' * X12 * V2-(-S)) / ( max( P,',
297  $ 'M-Q) * max(norm(I-X''*X),EPS) )' )
298  9922 format( 3x, i2, ': norm( U2'' * X21 * V1 - S ) / ( max(M-P,',
299  $ ' Q) * max(norm(I-X''*X),EPS) )' )
300  9923 format( 3x, i2, ': norm( U2'' * X22 * V2 - C ) / ( max(M-P,',
301  $ 'M-Q) * max(norm(I-X''*X),EPS) )' )
302  9924 format( 3x, i2, ': norm( I - U1''*U1 ) / ( P * EPS )' )
303  9925 format( 3x, i2, ': norm( I - U2''*U2 ) / ( (M-P) * EPS )' )
304  9926 format( 3x, i2, ': norm( I - V1''*V1 ) / ( Q * EPS )' )
305  9927 format( 3x, i2, ': norm( I - V2''*V2 ) / ( (M-Q) * EPS )' )
306  return
307 *
308 * End of ALAHDG
309 *
310  END