LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ alahdg()

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.

Definition at line 61 of file alahdg.f.

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 *
logical function lsamen(N, CA, CB)
LSAMEN
Definition: lsamen.f:74
Here is the caller graph for this function: