1 SUBROUTINE ZCKLSE( 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 RWORK( * )
16 COMPLEX*16 A( * ), AF( * ), B( * ), BF( * ), WORK( * ),
17 $ X( * )
18 * ..
19 *
20 * Purpose
21 * =======
22 *
23 * ZCKLSE tests ZGGLSE - a subroutine for solving linear equality
24 * constrained least square problem (LSE).
25 *
26 * Arguments
27 * =========
28 *
29 * NN (input) INTEGER
30 * The number of values of (M,P,N) contained in the vectors
31 * (MVAL, PVAL, NVAL).
32 *
33 * MVAL (input) INTEGER array, dimension (NN)
34 * The values of the matrix row(column) dimension M.
35 *
36 * PVAL (input) INTEGER array, dimension (NN)
37 * The values of the matrix row(column) dimension P.
38 *
39 * NVAL (input) INTEGER array, dimension (NN)
40 * The values of the matrix column(row) dimension N.
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) DOUBLE PRECISION
57 * The threshold value for the test ratios. A result is
58 * included in the output file if RESULT >= 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*16 array, dimension (NMAX*NMAX)
66 *
67 * AF (workspace) COMPLEX*16 array, dimension (NMAX*NMAX)
68 *
69 * B (workspace) COMPLEX*16 array, dimension (NMAX*NMAX)
70 *
71 * BF (workspace) COMPLEX*16 array, dimension (NMAX*NMAX)
72 *
73 * X (workspace) COMPLEX*16 array, dimension (5*NMAX)
74 *
75 * WORK (workspace) COMPLEX*16 array, dimension (NMAX*NMAX)
76 *
77 * RWORK (workspace) DOUBLE PRECISION array, dimension (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 ZLATMS returns an error code, the absolute value
88 * of it is returned.
89 *
90 * =====================================================================
91 *
92 * .. Parameters ..
93 INTEGER NTESTS
94 PARAMETER ( NTESTS = 7 )
95 INTEGER NTYPES
96 PARAMETER ( NTYPES = 8 )
97 * ..
98 * .. Local Scalars ..
99 LOGICAL FIRSTT
100 CHARACTER DISTA, DISTB, TYPE
101 CHARACTER*3 PATH
102 INTEGER I, IINFO, IK, IMAT, KLA, KLB, KUA, KUB, LDA,
103 $ LDB, LWORK, M, MODEA, MODEB, N, NFAIL, NRUN,
104 $ NT, P
105 DOUBLE PRECISION ANORM, BNORM, CNDNMA, CNDNMB
106 * ..
107 * .. Local Arrays ..
108 LOGICAL DOTYPE( NTYPES )
109 DOUBLE PRECISION RESULT( NTESTS )
110 * ..
111 * .. External Subroutines ..
112 EXTERNAL ALAHDG, ALAREQ, ALASUM, DLATB9, ZLARHS, ZLATMS,
113 $ ZLSETS
114 * ..
115 * .. Intrinsic Functions ..
116 INTRINSIC ABS, MAX
117 * ..
118 * .. Executable Statements ..
119 *
120 * Initialize constants and the random number seed.
121 *
122 PATH( 1: 3 ) = 'LSE'
123 INFO = 0
124 NRUN = 0
125 NFAIL = 0
126 FIRSTT = .TRUE.
127 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
128 LDA = NMAX
129 LDB = NMAX
130 LWORK = NMAX*NMAX
131 *
132 * Check for valid input values.
133 *
134 DO 10 IK = 1, NN
135 M = MVAL( IK )
136 P = PVAL( IK )
137 N = NVAL( IK )
138 IF( P.GT.N .OR. N.GT.M+P ) THEN
139 IF( FIRSTT ) THEN
140 WRITE( NOUT, FMT = * )
141 FIRSTT = .FALSE.
142 END IF
143 WRITE( NOUT, FMT = 9997 )M, P, N
144 END IF
145 10 CONTINUE
146 FIRSTT = .TRUE.
147 *
148 * Do for each value of M in MVAL.
149 *
150 DO 40 IK = 1, NN
151 M = MVAL( IK )
152 P = PVAL( IK )
153 N = NVAL( IK )
154 IF( P.GT.N .OR. N.GT.M+P )
155 $ GO TO 40
156 *
157 DO 30 IMAT = 1, NTYPES
158 *
159 * Do the tests only if DOTYPE( IMAT ) is true.
160 *
161 IF( .NOT.DOTYPE( IMAT ) )
162 $ GO TO 30
163 *
164 * Set up parameters with DLATB9 and generate test
165 * matrices A and B with ZLATMS.
166 *
167 CALL DLATB9( PATH, IMAT, M, P, N, TYPE, KLA, KUA, KLB, KUB,
168 $ ANORM, BNORM, MODEA, MODEB, CNDNMA, CNDNMB,
169 $ DISTA, DISTB )
170 *
171 CALL ZLATMS( M, N, DISTA, ISEED, TYPE, RWORK, MODEA, CNDNMA,
172 $ ANORM, KLA, KUA, 'No packing', A, LDA, WORK,
173 $ IINFO )
174 IF( IINFO.NE.0 ) THEN
175 WRITE( NOUT, FMT = 9999 )IINFO
176 INFO = ABS( IINFO )
177 GO TO 30
178 END IF
179 *
180 CALL ZLATMS( P, N, DISTB, ISEED, TYPE, RWORK, MODEB, CNDNMB,
181 $ BNORM, KLB, KUB, 'No packing', B, LDB, WORK,
182 $ IINFO )
183 IF( IINFO.NE.0 ) THEN
184 WRITE( NOUT, FMT = 9999 )IINFO
185 INFO = ABS( IINFO )
186 GO TO 30
187 END IF
188 *
189 * Generate the right-hand sides C and D for the LSE.
190 *
191 CALL ZLARHS( 'ZGE', 'New solution', 'Upper', 'N', M, N,
192 $ MAX( M-1, 0 ), MAX( N-1, 0 ), 1, A, LDA,
193 $ X( 4*NMAX+1 ), MAX( N, 1 ), X, MAX( M, 1 ),
194 $ ISEED, IINFO )
195 *
196 CALL ZLARHS( 'ZGE', 'Computed', 'Upper', 'N', P, N,
197 $ MAX( P-1, 0 ), MAX( N-1, 0 ), 1, B, LDB,
198 $ X( 4*NMAX+1 ), MAX( N, 1 ), X( 2*NMAX+1 ),
199 $ MAX( P, 1 ), ISEED, IINFO )
200 *
201 NT = 2
202 *
203 CALL ZLSETS( M, P, N, A, AF, LDA, B, BF, LDB, X,
204 $ X( NMAX+1 ), X( 2*NMAX+1 ), X( 3*NMAX+1 ),
205 $ X( 4*NMAX+1 ), WORK, LWORK, RWORK,
206 $ RESULT( 1 ) )
207 *
208 * Print information about the tests that did not
209 * pass the threshold.
210 *
211 DO 20 I = 1, NT
212 IF( RESULT( I ).GE.THRESH ) THEN
213 IF( NFAIL.EQ.0 .AND. FIRSTT ) THEN
214 FIRSTT = .FALSE.
215 CALL ALAHDG( NOUT, PATH )
216 END IF
217 WRITE( NOUT, FMT = 9998 )M, P, N, IMAT, I,
218 $ RESULT( I )
219 NFAIL = NFAIL + 1
220 END IF
221 20 CONTINUE
222 NRUN = NRUN + NT
223 *
224 30 CONTINUE
225 40 CONTINUE
226 *
227 * Print a summary of the results.
228 *
229 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, 0 )
230 *
231 9999 FORMAT( ' ZLATMS in ZCKLSE INFO = ', I5 )
232 9998 FORMAT( ' M=', I4, ' P=', I4, ', N=', I4, ', type ', I2,
233 $ ', test ', I2, ', ratio=', G13.6 )
234 9997 FORMAT( ' *** Invalid input for LSE: M = ', I6, ', P = ', I6,
235 $ ', N = ', I6, ';', / ' must satisfy P <= N <= P+M ',
236 $ '(this set of values will be skipped)' )
237 RETURN
238 *
239 * End of ZCKLSE
240 *
241 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 RWORK( * )
16 COMPLEX*16 A( * ), AF( * ), B( * ), BF( * ), WORK( * ),
17 $ X( * )
18 * ..
19 *
20 * Purpose
21 * =======
22 *
23 * ZCKLSE tests ZGGLSE - a subroutine for solving linear equality
24 * constrained least square problem (LSE).
25 *
26 * Arguments
27 * =========
28 *
29 * NN (input) INTEGER
30 * The number of values of (M,P,N) contained in the vectors
31 * (MVAL, PVAL, NVAL).
32 *
33 * MVAL (input) INTEGER array, dimension (NN)
34 * The values of the matrix row(column) dimension M.
35 *
36 * PVAL (input) INTEGER array, dimension (NN)
37 * The values of the matrix row(column) dimension P.
38 *
39 * NVAL (input) INTEGER array, dimension (NN)
40 * The values of the matrix column(row) dimension N.
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) DOUBLE PRECISION
57 * The threshold value for the test ratios. A result is
58 * included in the output file if RESULT >= 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*16 array, dimension (NMAX*NMAX)
66 *
67 * AF (workspace) COMPLEX*16 array, dimension (NMAX*NMAX)
68 *
69 * B (workspace) COMPLEX*16 array, dimension (NMAX*NMAX)
70 *
71 * BF (workspace) COMPLEX*16 array, dimension (NMAX*NMAX)
72 *
73 * X (workspace) COMPLEX*16 array, dimension (5*NMAX)
74 *
75 * WORK (workspace) COMPLEX*16 array, dimension (NMAX*NMAX)
76 *
77 * RWORK (workspace) DOUBLE PRECISION array, dimension (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 ZLATMS returns an error code, the absolute value
88 * of it is returned.
89 *
90 * =====================================================================
91 *
92 * .. Parameters ..
93 INTEGER NTESTS
94 PARAMETER ( NTESTS = 7 )
95 INTEGER NTYPES
96 PARAMETER ( NTYPES = 8 )
97 * ..
98 * .. Local Scalars ..
99 LOGICAL FIRSTT
100 CHARACTER DISTA, DISTB, TYPE
101 CHARACTER*3 PATH
102 INTEGER I, IINFO, IK, IMAT, KLA, KLB, KUA, KUB, LDA,
103 $ LDB, LWORK, M, MODEA, MODEB, N, NFAIL, NRUN,
104 $ NT, P
105 DOUBLE PRECISION ANORM, BNORM, CNDNMA, CNDNMB
106 * ..
107 * .. Local Arrays ..
108 LOGICAL DOTYPE( NTYPES )
109 DOUBLE PRECISION RESULT( NTESTS )
110 * ..
111 * .. External Subroutines ..
112 EXTERNAL ALAHDG, ALAREQ, ALASUM, DLATB9, ZLARHS, ZLATMS,
113 $ ZLSETS
114 * ..
115 * .. Intrinsic Functions ..
116 INTRINSIC ABS, MAX
117 * ..
118 * .. Executable Statements ..
119 *
120 * Initialize constants and the random number seed.
121 *
122 PATH( 1: 3 ) = 'LSE'
123 INFO = 0
124 NRUN = 0
125 NFAIL = 0
126 FIRSTT = .TRUE.
127 CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
128 LDA = NMAX
129 LDB = NMAX
130 LWORK = NMAX*NMAX
131 *
132 * Check for valid input values.
133 *
134 DO 10 IK = 1, NN
135 M = MVAL( IK )
136 P = PVAL( IK )
137 N = NVAL( IK )
138 IF( P.GT.N .OR. N.GT.M+P ) THEN
139 IF( FIRSTT ) THEN
140 WRITE( NOUT, FMT = * )
141 FIRSTT = .FALSE.
142 END IF
143 WRITE( NOUT, FMT = 9997 )M, P, N
144 END IF
145 10 CONTINUE
146 FIRSTT = .TRUE.
147 *
148 * Do for each value of M in MVAL.
149 *
150 DO 40 IK = 1, NN
151 M = MVAL( IK )
152 P = PVAL( IK )
153 N = NVAL( IK )
154 IF( P.GT.N .OR. N.GT.M+P )
155 $ GO TO 40
156 *
157 DO 30 IMAT = 1, NTYPES
158 *
159 * Do the tests only if DOTYPE( IMAT ) is true.
160 *
161 IF( .NOT.DOTYPE( IMAT ) )
162 $ GO TO 30
163 *
164 * Set up parameters with DLATB9 and generate test
165 * matrices A and B with ZLATMS.
166 *
167 CALL DLATB9( PATH, IMAT, M, P, N, TYPE, KLA, KUA, KLB, KUB,
168 $ ANORM, BNORM, MODEA, MODEB, CNDNMA, CNDNMB,
169 $ DISTA, DISTB )
170 *
171 CALL ZLATMS( M, N, DISTA, ISEED, TYPE, RWORK, MODEA, CNDNMA,
172 $ ANORM, KLA, KUA, 'No packing', A, LDA, WORK,
173 $ IINFO )
174 IF( IINFO.NE.0 ) THEN
175 WRITE( NOUT, FMT = 9999 )IINFO
176 INFO = ABS( IINFO )
177 GO TO 30
178 END IF
179 *
180 CALL ZLATMS( P, N, DISTB, ISEED, TYPE, RWORK, MODEB, CNDNMB,
181 $ BNORM, KLB, KUB, 'No packing', B, LDB, WORK,
182 $ IINFO )
183 IF( IINFO.NE.0 ) THEN
184 WRITE( NOUT, FMT = 9999 )IINFO
185 INFO = ABS( IINFO )
186 GO TO 30
187 END IF
188 *
189 * Generate the right-hand sides C and D for the LSE.
190 *
191 CALL ZLARHS( 'ZGE', 'New solution', 'Upper', 'N', M, N,
192 $ MAX( M-1, 0 ), MAX( N-1, 0 ), 1, A, LDA,
193 $ X( 4*NMAX+1 ), MAX( N, 1 ), X, MAX( M, 1 ),
194 $ ISEED, IINFO )
195 *
196 CALL ZLARHS( 'ZGE', 'Computed', 'Upper', 'N', P, N,
197 $ MAX( P-1, 0 ), MAX( N-1, 0 ), 1, B, LDB,
198 $ X( 4*NMAX+1 ), MAX( N, 1 ), X( 2*NMAX+1 ),
199 $ MAX( P, 1 ), ISEED, IINFO )
200 *
201 NT = 2
202 *
203 CALL ZLSETS( M, P, N, A, AF, LDA, B, BF, LDB, X,
204 $ X( NMAX+1 ), X( 2*NMAX+1 ), X( 3*NMAX+1 ),
205 $ X( 4*NMAX+1 ), WORK, LWORK, RWORK,
206 $ RESULT( 1 ) )
207 *
208 * Print information about the tests that did not
209 * pass the threshold.
210 *
211 DO 20 I = 1, NT
212 IF( RESULT( I ).GE.THRESH ) THEN
213 IF( NFAIL.EQ.0 .AND. FIRSTT ) THEN
214 FIRSTT = .FALSE.
215 CALL ALAHDG( NOUT, PATH )
216 END IF
217 WRITE( NOUT, FMT = 9998 )M, P, N, IMAT, I,
218 $ RESULT( I )
219 NFAIL = NFAIL + 1
220 END IF
221 20 CONTINUE
222 NRUN = NRUN + NT
223 *
224 30 CONTINUE
225 40 CONTINUE
226 *
227 * Print a summary of the results.
228 *
229 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, 0 )
230 *
231 9999 FORMAT( ' ZLATMS in ZCKLSE INFO = ', I5 )
232 9998 FORMAT( ' M=', I4, ' P=', I4, ', N=', I4, ', type ', I2,
233 $ ', test ', I2, ', ratio=', G13.6 )
234 9997 FORMAT( ' *** Invalid input for LSE: M = ', I6, ', P = ', I6,
235 $ ', N = ', I6, ';', / ' must satisfy P <= N <= P+M ',
236 $ '(this set of values will be skipped)' )
237 RETURN
238 *
239 * End of ZCKLSE
240 *
241 END