1 SUBROUTINE DCKGLM( NN, MVAL, PVAL, NVAL, NMATS, ISEED, THRESH,
2 $ NMAX, A, AF, B, BF, X, WORK, RWORK, NIN, NOUT,
3 $ INFO )
4 *
5 * -- LAPACK test routine (version 3.1) --
6 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
7 * November 2006
8 *
9 * .. Scalar Arguments ..
10 INTEGER INFO, NIN, NMATS, NMAX, NN, NOUT
11 DOUBLE PRECISION THRESH
12 * ..
13 * .. Array Arguments ..
14 INTEGER ISEED( 4 ), MVAL( * ), NVAL( * ), PVAL( * )
15 DOUBLE PRECISION A( * ), AF( * ), B( * ), BF( * ), RWORK( * ),
16 $ WORK( * ), X( * )
17 * ..
18 *
19 * Purpose
20 * =======
21 *
22 * DCKGLM tests DGGGLM - subroutine for solving generalized linear
23 * model problem.
24 *
25 * Arguments
26 * =========
27 *
28 * NN (input) INTEGER
29 * The number of values of N, M and P contained in the vectors
30 * NVAL, MVAL and PVAL.
31 *
32 * MVAL (input) INTEGER array, dimension (NN)
33 * The values of the matrix column dimension M.
34 *
35 * PVAL (input) INTEGER array, dimension (NN)
36 * The values of the matrix column dimension P.
37 *
38 * NVAL (input) INTEGER array, dimension (NN)
39 * The values of the matrix row dimension N.
40 *
41 * NMATS (input) INTEGER
42 * The number of matrix types to be tested for each combination
43 * of matrix dimensions. If NMATS >= NTYPES (the maximum
44 * number of matrix types), then all the different types are
45 * generated for testing. If NMATS < NTYPES, another input line
46 * is read to get the numbers of the matrix types to be used.
47 *
48 * ISEED (input/output) INTEGER array, dimension (4)
49 * On entry, the seed of the random number generator. The array
50 * elements should be between 0 and 4095, otherwise they will be
51 * reduced mod 4096, and ISEED(4) must be odd.
52 * On exit, the next seed in the random number sequence after
53 * all the test matrices have been generated.
54 *
55 * THRESH (input) DOUBLE PRECISION
56 * The threshold value for the test ratios. A result is
57 * included in the output file if RESID >= THRESH. To have
58 * every test ratio printed, use THRESH = 0.
59 *
60 * NMAX (input) INTEGER
61 * The maximum value permitted for M or N, used in dimensioning
62 * the work arrays.
63 *
64 * A (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX)
65 *
66 * AF (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX)
67 *
68 * B (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX)
69 *
70 * BF (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX)
71 *
72 * X (workspace) DOUBLE PRECISION array, dimension (4*NMAX)
73 *
74 * RWORK (workspace) DOUBLE PRECISION array, dimension (NMAX)
75 *
76 * WORK (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX)
77 *
78 * NIN (input) INTEGER
79 * The unit number for input.
80 *
81 * NOUT (input) INTEGER
82 * The unit number for output.
83 *
84 * INFO (output) INTEGER
85 * = 0 : successful exit
86 * > 0 : If DLATMS returns an error code, the absolute value
87 * of it is returned.
88 *
89 * =====================================================================
90 *
91 * .. Parameters ..
92 INTEGER NTYPES
93 PARAMETER ( NTYPES = 8 )
94 * ..
95 * .. Local Scalars ..
96 LOGICAL FIRSTT
97 CHARACTER DISTA, DISTB, TYPE
98 CHARACTER*3 PATH
99 INTEGER I, IINFO, IK, IMAT, KLA, KLB, KUA, KUB, LDA,
100 $ LDB, LWORK, M, MODEA, MODEB, N, NFAIL, NRUN, P
101 DOUBLE PRECISION ANORM, BNORM, CNDNMA, CNDNMB, RESID
102 * ..
103 * .. Local Arrays ..
104 LOGICAL DOTYPE( NTYPES )
105 * ..
106 * .. External Functions ..
107 DOUBLE PRECISION DLARND
108 EXTERNAL DLARND
109 * ..
110 * .. External Subroutines ..
111 EXTERNAL ALAHDG, ALAREQ, ALASUM, DGLMTS, DLATB9, DLATMS
112 * ..
113 * .. Intrinsic Functions ..
114 INTRINSIC ABS
115 * ..
116 * .. Executable Statements ..
117 *
118 * Initialize constants.
119 *
120 PATH( 1: 3 ) = 'GLM'
121 INFO = 0
122 NRUN = 0
123 NFAIL = 0
124 FIRSTT = .TRUE.
125 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
126 LDA = NMAX
127 LDB = NMAX
128 LWORK = NMAX*NMAX
129 *
130 * Check for valid input values.
131 *
132 DO 10 IK = 1, NN
133 M = MVAL( IK )
134 P = PVAL( IK )
135 N = NVAL( IK )
136 IF( M.GT.N .OR. N.GT.M+P ) THEN
137 IF( FIRSTT ) THEN
138 WRITE( NOUT, FMT = * )
139 FIRSTT = .FALSE.
140 END IF
141 WRITE( NOUT, FMT = 9997 )M, P, N
142 END IF
143 10 CONTINUE
144 FIRSTT = .TRUE.
145 *
146 * Do for each value of M in MVAL.
147 *
148 DO 40 IK = 1, NN
149 M = MVAL( IK )
150 P = PVAL( IK )
151 N = NVAL( IK )
152 IF( M.GT.N .OR. N.GT.M+P )
153 $ GO TO 40
154 *
155 DO 30 IMAT = 1, NTYPES
156 *
157 * Do the tests only if DOTYPE( IMAT ) is true.
158 *
159 IF( .NOT.DOTYPE( IMAT ) )
160 $ GO TO 30
161 *
162 * Set up parameters with DLATB9 and generate test
163 * matrices A and B with DLATMS.
164 *
165 CALL DLATB9( PATH, IMAT, M, P, N, TYPE, KLA, KUA, KLB, KUB,
166 $ ANORM, BNORM, MODEA, MODEB, CNDNMA, CNDNMB,
167 $ DISTA, DISTB )
168 *
169 CALL DLATMS( N, M, DISTA, ISEED, TYPE, RWORK, MODEA, CNDNMA,
170 $ ANORM, KLA, KUA, 'No packing', A, LDA, WORK,
171 $ IINFO )
172 IF( IINFO.NE.0 ) THEN
173 WRITE( NOUT, FMT = 9999 )IINFO
174 INFO = ABS( IINFO )
175 GO TO 30
176 END IF
177 *
178 CALL DLATMS( N, P, DISTB, ISEED, TYPE, RWORK, MODEB, CNDNMB,
179 $ BNORM, KLB, KUB, 'No packing', B, LDB, WORK,
180 $ IINFO )
181 IF( IINFO.NE.0 ) THEN
182 WRITE( NOUT, FMT = 9999 )IINFO
183 INFO = ABS( IINFO )
184 GO TO 30
185 END IF
186 *
187 * Generate random left hand side vector of GLM
188 *
189 DO 20 I = 1, N
190 X( I ) = DLARND( 2, ISEED )
191 20 CONTINUE
192 *
193 CALL DGLMTS( N, M, P, A, AF, LDA, B, BF, LDB, X,
194 $ X( NMAX+1 ), X( 2*NMAX+1 ), X( 3*NMAX+1 ),
195 $ WORK, LWORK, RWORK, RESID )
196 *
197 * Print information about the tests that did not
198 * pass the threshold.
199 *
200 IF( RESID.GE.THRESH ) THEN
201 IF( NFAIL.EQ.0 .AND. FIRSTT ) THEN
202 FIRSTT = .FALSE.
203 CALL ALAHDG( NOUT, PATH )
204 END IF
205 WRITE( NOUT, FMT = 9998 )N, M, P, IMAT, 1, RESID
206 NFAIL = NFAIL + 1
207 END IF
208 NRUN = NRUN + 1
209 *
210 30 CONTINUE
211 40 CONTINUE
212 *
213 * Print a summary of the results.
214 *
215 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, 0 )
216 *
217 9999 FORMAT( ' DLATMS in DCKGLM INFO = ', I5 )
218 9998 FORMAT( ' N=', I4, ' M=', I4, ', P=', I4, ', type ', I2,
219 $ ', test ', I2, ', ratio=', G13.6 )
220 9997 FORMAT( ' *** Invalid input for GLM: M = ', I6, ', P = ', I6,
221 $ ', N = ', I6, ';', / ' must satisfy M <= N <= M+P ',
222 $ '(this set of values will be skipped)' )
223 RETURN
224 *
225 * End of DCKGLM
226 *
227 END
2 $ NMAX, A, AF, B, BF, X, WORK, RWORK, NIN, NOUT,
3 $ INFO )
4 *
5 * -- LAPACK test routine (version 3.1) --
6 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
7 * November 2006
8 *
9 * .. Scalar Arguments ..
10 INTEGER INFO, NIN, NMATS, NMAX, NN, NOUT
11 DOUBLE PRECISION THRESH
12 * ..
13 * .. Array Arguments ..
14 INTEGER ISEED( 4 ), MVAL( * ), NVAL( * ), PVAL( * )
15 DOUBLE PRECISION A( * ), AF( * ), B( * ), BF( * ), RWORK( * ),
16 $ WORK( * ), X( * )
17 * ..
18 *
19 * Purpose
20 * =======
21 *
22 * DCKGLM tests DGGGLM - subroutine for solving generalized linear
23 * model problem.
24 *
25 * Arguments
26 * =========
27 *
28 * NN (input) INTEGER
29 * The number of values of N, M and P contained in the vectors
30 * NVAL, MVAL and PVAL.
31 *
32 * MVAL (input) INTEGER array, dimension (NN)
33 * The values of the matrix column dimension M.
34 *
35 * PVAL (input) INTEGER array, dimension (NN)
36 * The values of the matrix column dimension P.
37 *
38 * NVAL (input) INTEGER array, dimension (NN)
39 * The values of the matrix row dimension N.
40 *
41 * NMATS (input) INTEGER
42 * The number of matrix types to be tested for each combination
43 * of matrix dimensions. If NMATS >= NTYPES (the maximum
44 * number of matrix types), then all the different types are
45 * generated for testing. If NMATS < NTYPES, another input line
46 * is read to get the numbers of the matrix types to be used.
47 *
48 * ISEED (input/output) INTEGER array, dimension (4)
49 * On entry, the seed of the random number generator. The array
50 * elements should be between 0 and 4095, otherwise they will be
51 * reduced mod 4096, and ISEED(4) must be odd.
52 * On exit, the next seed in the random number sequence after
53 * all the test matrices have been generated.
54 *
55 * THRESH (input) DOUBLE PRECISION
56 * The threshold value for the test ratios. A result is
57 * included in the output file if RESID >= THRESH. To have
58 * every test ratio printed, use THRESH = 0.
59 *
60 * NMAX (input) INTEGER
61 * The maximum value permitted for M or N, used in dimensioning
62 * the work arrays.
63 *
64 * A (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX)
65 *
66 * AF (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX)
67 *
68 * B (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX)
69 *
70 * BF (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX)
71 *
72 * X (workspace) DOUBLE PRECISION array, dimension (4*NMAX)
73 *
74 * RWORK (workspace) DOUBLE PRECISION array, dimension (NMAX)
75 *
76 * WORK (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX)
77 *
78 * NIN (input) INTEGER
79 * The unit number for input.
80 *
81 * NOUT (input) INTEGER
82 * The unit number for output.
83 *
84 * INFO (output) INTEGER
85 * = 0 : successful exit
86 * > 0 : If DLATMS returns an error code, the absolute value
87 * of it is returned.
88 *
89 * =====================================================================
90 *
91 * .. Parameters ..
92 INTEGER NTYPES
93 PARAMETER ( NTYPES = 8 )
94 * ..
95 * .. Local Scalars ..
96 LOGICAL FIRSTT
97 CHARACTER DISTA, DISTB, TYPE
98 CHARACTER*3 PATH
99 INTEGER I, IINFO, IK, IMAT, KLA, KLB, KUA, KUB, LDA,
100 $ LDB, LWORK, M, MODEA, MODEB, N, NFAIL, NRUN, P
101 DOUBLE PRECISION ANORM, BNORM, CNDNMA, CNDNMB, RESID
102 * ..
103 * .. Local Arrays ..
104 LOGICAL DOTYPE( NTYPES )
105 * ..
106 * .. External Functions ..
107 DOUBLE PRECISION DLARND
108 EXTERNAL DLARND
109 * ..
110 * .. External Subroutines ..
111 EXTERNAL ALAHDG, ALAREQ, ALASUM, DGLMTS, DLATB9, DLATMS
112 * ..
113 * .. Intrinsic Functions ..
114 INTRINSIC ABS
115 * ..
116 * .. Executable Statements ..
117 *
118 * Initialize constants.
119 *
120 PATH( 1: 3 ) = 'GLM'
121 INFO = 0
122 NRUN = 0
123 NFAIL = 0
124 FIRSTT = .TRUE.
125 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
126 LDA = NMAX
127 LDB = NMAX
128 LWORK = NMAX*NMAX
129 *
130 * Check for valid input values.
131 *
132 DO 10 IK = 1, NN
133 M = MVAL( IK )
134 P = PVAL( IK )
135 N = NVAL( IK )
136 IF( M.GT.N .OR. N.GT.M+P ) THEN
137 IF( FIRSTT ) THEN
138 WRITE( NOUT, FMT = * )
139 FIRSTT = .FALSE.
140 END IF
141 WRITE( NOUT, FMT = 9997 )M, P, N
142 END IF
143 10 CONTINUE
144 FIRSTT = .TRUE.
145 *
146 * Do for each value of M in MVAL.
147 *
148 DO 40 IK = 1, NN
149 M = MVAL( IK )
150 P = PVAL( IK )
151 N = NVAL( IK )
152 IF( M.GT.N .OR. N.GT.M+P )
153 $ GO TO 40
154 *
155 DO 30 IMAT = 1, NTYPES
156 *
157 * Do the tests only if DOTYPE( IMAT ) is true.
158 *
159 IF( .NOT.DOTYPE( IMAT ) )
160 $ GO TO 30
161 *
162 * Set up parameters with DLATB9 and generate test
163 * matrices A and B with DLATMS.
164 *
165 CALL DLATB9( PATH, IMAT, M, P, N, TYPE, KLA, KUA, KLB, KUB,
166 $ ANORM, BNORM, MODEA, MODEB, CNDNMA, CNDNMB,
167 $ DISTA, DISTB )
168 *
169 CALL DLATMS( N, M, DISTA, ISEED, TYPE, RWORK, MODEA, CNDNMA,
170 $ ANORM, KLA, KUA, 'No packing', A, LDA, WORK,
171 $ IINFO )
172 IF( IINFO.NE.0 ) THEN
173 WRITE( NOUT, FMT = 9999 )IINFO
174 INFO = ABS( IINFO )
175 GO TO 30
176 END IF
177 *
178 CALL DLATMS( N, P, DISTB, ISEED, TYPE, RWORK, MODEB, CNDNMB,
179 $ BNORM, KLB, KUB, 'No packing', B, LDB, WORK,
180 $ IINFO )
181 IF( IINFO.NE.0 ) THEN
182 WRITE( NOUT, FMT = 9999 )IINFO
183 INFO = ABS( IINFO )
184 GO TO 30
185 END IF
186 *
187 * Generate random left hand side vector of GLM
188 *
189 DO 20 I = 1, N
190 X( I ) = DLARND( 2, ISEED )
191 20 CONTINUE
192 *
193 CALL DGLMTS( N, M, P, A, AF, LDA, B, BF, LDB, X,
194 $ X( NMAX+1 ), X( 2*NMAX+1 ), X( 3*NMAX+1 ),
195 $ WORK, LWORK, RWORK, RESID )
196 *
197 * Print information about the tests that did not
198 * pass the threshold.
199 *
200 IF( RESID.GE.THRESH ) THEN
201 IF( NFAIL.EQ.0 .AND. FIRSTT ) THEN
202 FIRSTT = .FALSE.
203 CALL ALAHDG( NOUT, PATH )
204 END IF
205 WRITE( NOUT, FMT = 9998 )N, M, P, IMAT, 1, RESID
206 NFAIL = NFAIL + 1
207 END IF
208 NRUN = NRUN + 1
209 *
210 30 CONTINUE
211 40 CONTINUE
212 *
213 * Print a summary of the results.
214 *
215 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, 0 )
216 *
217 9999 FORMAT( ' DLATMS in DCKGLM INFO = ', I5 )
218 9998 FORMAT( ' N=', I4, ' M=', I4, ', P=', I4, ', type ', I2,
219 $ ', test ', I2, ', ratio=', G13.6 )
220 9997 FORMAT( ' *** Invalid input for GLM: M = ', I6, ', P = ', I6,
221 $ ', N = ', I6, ';', / ' must satisfy M <= N <= M+P ',
222 $ '(this set of values will be skipped)' )
223 RETURN
224 *
225 * End of DCKGLM
226 *
227 END