LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine alahdg ( integer  IOUNIT,
character*3  PATH 
)

ALAHDG

Purpose: 
 ALAHDG prints header information for the different test paths.
Parameters
[in]IOUNIT
          IOUNIT is INTEGER
          The unit number to which the header information should be
          printed.
[in]PATH
          PATH is CHARACTER*3
          The name of the path for which the header information is to
          be printed.  Current paths are
             GQR:  GQR (general matrices)
             GRQ:  GRQ (general matrices)
             LSE:  LSE Problem
             GLM:  GLM Problem
             GSV:  Generalized Singular Value Decomposition
             CSD:  CS Decomposition
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 64 of file alahdg.f.

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 = 9910 )
213  WRITE( iounit, fmt = 9911 )1
214  WRITE( iounit, fmt = 9912 )2
215  WRITE( iounit, fmt = 9913 )3
216  WRITE( iounit, fmt = 9914 )4
217  WRITE( iounit, fmt = 9915 )5
218  WRITE( iounit, fmt = 9916 )6
219  WRITE( iounit, fmt = 9917 )7
220  WRITE( iounit, fmt = 9918 )8
221  WRITE( iounit, fmt = 9919 )9
222  WRITE( iounit, fmt = 9920 )
223  WRITE( iounit, fmt = 9921 )10
224  WRITE( iounit, fmt = 9922 )11
225  WRITE( iounit, fmt = 9923 )12
226  WRITE( iounit, fmt = 9924 )13
227  WRITE( iounit, fmt = 9925 )14
228  WRITE( iounit, fmt = 9926 )15
229  END IF
230 *
231  9999 FORMAT( 1x, a )
232  9991 FORMAT( / 1x, a3, ': GQR factorization of general matrices' )
233  9992 FORMAT( / 1x, a3, ': GRQ factorization of general matrices' )
234  9993 FORMAT( / 1x, a3, ': LSE Problem' )
235  9994 FORMAT( / 1x, a3, ': GLM Problem' )
236  9995 FORMAT( / 1x, a3, ': Generalized Singular Value Decomposition' )
237  9996 FORMAT( / 1x, a3, ': CS Decomposition' )
238 *
239  9950 FORMAT( 3x, i2, ': A-diagonal matrix B-upper triangular' )
240  9951 FORMAT( 3x, i2, ': A-diagonal matrix B-lower triangular' )
241  9952 FORMAT( 3x, i2, ': A-upper triangular B-upper triangular' )
242  9953 FORMAT( 3x, i2, ': A-lower triangular B-diagonal triangular' )
243  9954 FORMAT( 3x, i2, ': A-lower triangular B-upper triangular' )
244 *
245  9955 FORMAT( 3x, i2, ': Random matrices cond(A)=100, cond(B)=10,' )
246 *
247  9956 FORMAT( 3x, i2, ': Random matrices cond(A)= sqrt( 0.1/EPS ) ',
248  $ 'cond(B)= sqrt( 0.1/EPS )' )
249  9957 FORMAT( 3x, i2, ': Random matrices cond(A)= 0.1/EPS ',
250  $ 'cond(B)= 0.1/EPS' )
251  9959 FORMAT( 3x, i2, ': Random matrices cond(A)= sqrt( 0.1/EPS ) ',
252  $ 'cond(B)= 0.1/EPS ' )
253  9960 FORMAT( 3x, i2, ': Random matrices cond(A)= 0.1/EPS ',
254  $ 'cond(B)= sqrt( 0.1/EPS )' )
255 *
256  9961 FORMAT( 3x, i2, ': Matrix scaled near underflow limit' )
257  9962 FORMAT( 3x, i2, ': Matrix scaled near overflow limit' )
258  9963 FORMAT( 3x, i2, ': Random orthogonal matrix (Haar measure)' )
259  9964 FORMAT( 3x, i2, ': Nearly orthogonal matrix with uniformly ',
260  $ 'distributed angles atan2( S, C ) in CS decomposition' )
261  9965 FORMAT( 3x, i2, ': Random orthogonal matrix with clustered ',
262  $ 'angles atan2( S, C ) in CS decomposition' )
263 *
264 *
265 * GQR test ratio
266 *
267  9930 FORMAT( 3x, i2, ': norm( R - Q'' * A ) / ( min( N, M )*norm( A )',
268  $ '* EPS )' )
269  9931 FORMAT( 3x, i2, ': norm( T * Z - Q'' * B ) / ( min(P,N)*norm(B)',
270  $ '* EPS )' )
271  9932 FORMAT( 3x, i2, ': norm( I - Q''*Q ) / ( N * EPS )' )
272  9933 FORMAT( 3x, i2, ': norm( I - Z''*Z ) / ( P * EPS )' )
273 *
274 * GRQ test ratio
275 *
276  9934 FORMAT( 3x, i2, ': norm( R - A * Q'' ) / ( min( N,M )*norm(A) * ',
277  $ 'EPS )' )
278  9935 FORMAT( 3x, i2, ': norm( T * Q - Z'' * B ) / ( min( P,N ) * nor',
279  $ 'm(B)*EPS )' )
280 *
281 * LSE test ratio
282 *
283  9937 FORMAT( 3x, i2, ': norm( A*x - c ) / ( norm(A)*norm(x) * EPS )' )
284  9938 FORMAT( 3x, i2, ': norm( B*x - d ) / ( norm(B)*norm(x) * EPS )' )
285 *
286 * GLM test ratio
287 *
288  9939 FORMAT( 3x, i2, ': norm( d - A*x - B*y ) / ( (norm(A)+norm(B) )*',
289  $ '(norm(x)+norm(y))*EPS )' )
290 *
291 * GSVD test ratio
292 *
293  9940 FORMAT( 3x, i2, ': norm( U'' * A * Q - D1 * R ) / ( min( M, N )*',
294  $ 'norm( A ) * EPS )' )
295  9941 FORMAT( 3x, i2, ': norm( V'' * B * Q - D2 * R ) / ( min( P, N )*',
296  $ 'norm( B ) * EPS )' )
297  9942 FORMAT( 3x, i2, ': norm( I - U''*U ) / ( M * EPS )' )
298  9943 FORMAT( 3x, i2, ': norm( I - V''*V ) / ( P * EPS )' )
299  9944 FORMAT( 3x, i2, ': norm( I - Q''*Q ) / ( N * EPS )' )
300 *
301 * CSD test ratio
302 *
303  9910 FORMAT( 3x, '2-by-2 CSD' )
304  9911 FORMAT( 3x, i2, ': norm( U1'' * X11 * V1 - C ) / ( max( P, Q)',
305  $ ' * max(norm(I-X''*X),EPS) )' )
306  9912 FORMAT( 3x, i2, ': norm( U1'' * X12 * V2-(-S)) / ( max( P,',
307  $ 'M-Q) * max(norm(I-X''*X),EPS) )' )
308  9913 FORMAT( 3x, i2, ': norm( U2'' * X21 * V1 - S ) / ( max(M-P,',
309  $ ' Q) * max(norm(I-X''*X),EPS) )' )
310  9914 FORMAT( 3x, i2, ': norm( U2'' * X22 * V2 - C ) / ( max(M-P,',
311  $ 'M-Q) * max(norm(I-X''*X),EPS) )' )
312  9915 FORMAT( 3x, i2, ': norm( I - U1''*U1 ) / ( P * EPS )' )
313  9916 FORMAT( 3x, i2, ': norm( I - U2''*U2 ) / ( (M-P) * EPS )' )
314  9917 FORMAT( 3x, i2, ': norm( I - V1''*V1 ) / ( Q * EPS )' )
315  9918 FORMAT( 3x, i2, ': norm( I - V2''*V2 ) / ( (M-Q) * EPS )' )
316  9919 FORMAT( 3x, i2, ': principal angle ordering ( 0 or ULP )' )
317  9920 FORMAT( 3x, '2-by-1 CSD' )
318  9921 FORMAT( 3x, i2, ': norm( U1'' * X11 * V1 - C ) / ( max( P, Q)',
319  $ ' * max(norm(I-X''*X),EPS) )' )
320  9922 FORMAT( 3x, i2, ': norm( U2'' * X21 * V1 - S ) / ( max( M-P,',
321  $ 'Q) * max(norm(I-X''*X),EPS) )' )
322  9923 FORMAT( 3x, i2, ': norm( I - U1''*U1 ) / ( P * EPS )' )
323  9924 FORMAT( 3x, i2, ': norm( I - U2''*U2 ) / ( (M-P) * EPS )' )
324  9925 FORMAT( 3x, i2, ': norm( I - V1''*V1 ) / ( Q * EPS )' )
325  9926 FORMAT( 3x, i2, ': principal angle ordering ( 0 or ULP )' )
326  RETURN
327 *
328 * End of ALAHDG
329 *
lsamen
logical function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:76

Here is the caller graph for this function: