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