1 SUBROUTINE SCKLSE( 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 REAL THRESH
12 * ..
13 * .. Array Arguments ..
14 INTEGER ISEED( 4 ), MVAL( * ), NVAL( * ), PVAL( * )
15 REAL A( * ), AF( * ), B( * ), BF( * ), RWORK( * ),
16 $ WORK( * ), X( * )
17 * ..
18 *
19 * Purpose
20 * =======
21 *
22 * SCKLSE tests SGGLSE - a subroutine for solving linear equality
23 * constrained least square problem (LSE).
24 *
25 * Arguments
26 * =========
27 *
28 * NN (input) INTEGER
29 * The number of values of (M,P,N) contained in the vectors
30 * (MVAL, PVAL, NVAL).
31 *
32 * MVAL (input) INTEGER array, dimension (NN)
33 * The values of the matrix row(column) dimension M.
34 *
35 * PVAL (input) INTEGER array, dimension (NN)
36 * The values of the matrix row(column) dimension P.
37 *
38 * NVAL (input) INTEGER array, dimension (NN)
39 * The values of the matrix column(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) REAL
56 * The threshold value for the test ratios. A result is
57 * included in the output file if RESULT >= 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) REAL array, dimension (NMAX*NMAX)
65 *
66 * AF (workspace) REAL array, dimension (NMAX*NMAX)
67 *
68 * B (workspace) REAL array, dimension (NMAX*NMAX)
69 *
70 * BF (workspace) REAL array, dimension (NMAX*NMAX)
71 *
72 * X (workspace) REAL array, dimension (5*NMAX)
73 *
74 * WORK (workspace) REAL array, dimension (NMAX*NMAX)
75 *
76 * RWORK (workspace) REAL array, dimension (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 SLATMS returns an error code, the absolute value
87 * of it is returned.
88 *
89 * =====================================================================
90 *
91 * .. Parameters ..
92 INTEGER NTESTS
93 PARAMETER ( NTESTS = 7 )
94 INTEGER NTYPES
95 PARAMETER ( NTYPES = 8 )
96 * ..
97 * .. Local Scalars ..
98 LOGICAL FIRSTT
99 CHARACTER DISTA, DISTB, TYPE
100 CHARACTER*3 PATH
101 INTEGER I, IINFO, IK, IMAT, KLA, KLB, KUA, KUB, LDA,
102 $ LDB, LWORK, M, MODEA, MODEB, N, NFAIL, NRUN,
103 $ NT, P
104 REAL ANORM, BNORM, CNDNMA, CNDNMB
105 * ..
106 * .. Local Arrays ..
107 LOGICAL DOTYPE( NTYPES )
108 REAL RESULT( NTESTS )
109 * ..
110 * .. External Subroutines ..
111 EXTERNAL ALAHDG, ALAREQ, ALASUM, SLARHS, SLATB9, SLATMS,
112 $ SLSETS
113 * ..
114 * .. Intrinsic Functions ..
115 INTRINSIC ABS, MAX
116 * ..
117 * .. Executable Statements ..
118 *
119 * Initialize constants and the random number seed.
120 *
121 PATH( 1: 3 ) = 'LSE'
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( P.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( P.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 SLATMS.
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 SLATMS( M, N, 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 SLATMS( P, N, 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 the right-hand sides C and D for the LSE.
189 *
190 CALL SLARHS( 'SGE', 'New solution', 'Upper', 'N', M, N,
191 $ MAX( M-1, 0 ), MAX( N-1, 0 ), 1, A, LDA,
192 $ X( 4*NMAX+1 ), MAX( N, 1 ), X, MAX( M, 1 ),
193 $ ISEED, IINFO )
194 *
195 CALL SLARHS( 'SGE', 'Computed', 'Upper', 'N', P, N,
196 $ MAX( P-1, 0 ), MAX( N-1, 0 ), 1, B, LDB,
197 $ X( 4*NMAX+1 ), MAX( N, 1 ), X( 2*NMAX+1 ),
198 $ MAX( P, 1 ), ISEED, IINFO )
199 *
200 NT = 2
201 *
202 CALL SLSETS( M, P, N, A, AF, LDA, B, BF, LDB, X,
203 $ X( NMAX+1 ), X( 2*NMAX+1 ), X( 3*NMAX+1 ),
204 $ X( 4*NMAX+1 ), WORK, LWORK, RWORK,
205 $ RESULT( 1 ) )
206 *
207 * Print information about the tests that did not
208 * pass the threshold.
209 *
210 DO 20 I = 1, NT
211 IF( RESULT( I ).GE.THRESH ) THEN
212 IF( NFAIL.EQ.0 .AND. FIRSTT ) THEN
213 FIRSTT = .FALSE.
214 CALL ALAHDG( NOUT, PATH )
215 END IF
216 WRITE( NOUT, FMT = 9998 )M, P, N, IMAT, I,
217 $ RESULT( I )
218 NFAIL = NFAIL + 1
219 END IF
220 20 CONTINUE
221 NRUN = NRUN + NT
222 *
223 30 CONTINUE
224 40 CONTINUE
225 *
226 * Print a summary of the results.
227 *
228 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, 0 )
229 *
230 9999 FORMAT( ' SLATMS in SCKLSE INFO = ', I5 )
231 9998 FORMAT( ' M=', I4, ' P=', I4, ', N=', I4, ', type ', I2,
232 $ ', test ', I2, ', ratio=', G13.6 )
233 9997 FORMAT( ' *** Invalid input for LSE: M = ', I6, ', P = ', I6,
234 $ ', N = ', I6, ';', / ' must satisfy P <= N <= P+M ',
235 $ '(this set of values will be skipped)' )
236 RETURN
237 *
238 * End of SCKLSE
239 *
240 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 A( * ), AF( * ), B( * ), BF( * ), RWORK( * ),
16 $ WORK( * ), X( * )
17 * ..
18 *
19 * Purpose
20 * =======
21 *
22 * SCKLSE tests SGGLSE - a subroutine for solving linear equality
23 * constrained least square problem (LSE).
24 *
25 * Arguments
26 * =========
27 *
28 * NN (input) INTEGER
29 * The number of values of (M,P,N) contained in the vectors
30 * (MVAL, PVAL, NVAL).
31 *
32 * MVAL (input) INTEGER array, dimension (NN)
33 * The values of the matrix row(column) dimension M.
34 *
35 * PVAL (input) INTEGER array, dimension (NN)
36 * The values of the matrix row(column) dimension P.
37 *
38 * NVAL (input) INTEGER array, dimension (NN)
39 * The values of the matrix column(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) REAL
56 * The threshold value for the test ratios. A result is
57 * included in the output file if RESULT >= 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) REAL array, dimension (NMAX*NMAX)
65 *
66 * AF (workspace) REAL array, dimension (NMAX*NMAX)
67 *
68 * B (workspace) REAL array, dimension (NMAX*NMAX)
69 *
70 * BF (workspace) REAL array, dimension (NMAX*NMAX)
71 *
72 * X (workspace) REAL array, dimension (5*NMAX)
73 *
74 * WORK (workspace) REAL array, dimension (NMAX*NMAX)
75 *
76 * RWORK (workspace) REAL array, dimension (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 SLATMS returns an error code, the absolute value
87 * of it is returned.
88 *
89 * =====================================================================
90 *
91 * .. Parameters ..
92 INTEGER NTESTS
93 PARAMETER ( NTESTS = 7 )
94 INTEGER NTYPES
95 PARAMETER ( NTYPES = 8 )
96 * ..
97 * .. Local Scalars ..
98 LOGICAL FIRSTT
99 CHARACTER DISTA, DISTB, TYPE
100 CHARACTER*3 PATH
101 INTEGER I, IINFO, IK, IMAT, KLA, KLB, KUA, KUB, LDA,
102 $ LDB, LWORK, M, MODEA, MODEB, N, NFAIL, NRUN,
103 $ NT, P
104 REAL ANORM, BNORM, CNDNMA, CNDNMB
105 * ..
106 * .. Local Arrays ..
107 LOGICAL DOTYPE( NTYPES )
108 REAL RESULT( NTESTS )
109 * ..
110 * .. External Subroutines ..
111 EXTERNAL ALAHDG, ALAREQ, ALASUM, SLARHS, SLATB9, SLATMS,
112 $ SLSETS
113 * ..
114 * .. Intrinsic Functions ..
115 INTRINSIC ABS, MAX
116 * ..
117 * .. Executable Statements ..
118 *
119 * Initialize constants and the random number seed.
120 *
121 PATH( 1: 3 ) = 'LSE'
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( P.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( P.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 SLATMS.
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 SLATMS( M, N, 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 SLATMS( P, N, 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 the right-hand sides C and D for the LSE.
189 *
190 CALL SLARHS( 'SGE', 'New solution', 'Upper', 'N', M, N,
191 $ MAX( M-1, 0 ), MAX( N-1, 0 ), 1, A, LDA,
192 $ X( 4*NMAX+1 ), MAX( N, 1 ), X, MAX( M, 1 ),
193 $ ISEED, IINFO )
194 *
195 CALL SLARHS( 'SGE', 'Computed', 'Upper', 'N', P, N,
196 $ MAX( P-1, 0 ), MAX( N-1, 0 ), 1, B, LDB,
197 $ X( 4*NMAX+1 ), MAX( N, 1 ), X( 2*NMAX+1 ),
198 $ MAX( P, 1 ), ISEED, IINFO )
199 *
200 NT = 2
201 *
202 CALL SLSETS( M, P, N, A, AF, LDA, B, BF, LDB, X,
203 $ X( NMAX+1 ), X( 2*NMAX+1 ), X( 3*NMAX+1 ),
204 $ X( 4*NMAX+1 ), WORK, LWORK, RWORK,
205 $ RESULT( 1 ) )
206 *
207 * Print information about the tests that did not
208 * pass the threshold.
209 *
210 DO 20 I = 1, NT
211 IF( RESULT( I ).GE.THRESH ) THEN
212 IF( NFAIL.EQ.0 .AND. FIRSTT ) THEN
213 FIRSTT = .FALSE.
214 CALL ALAHDG( NOUT, PATH )
215 END IF
216 WRITE( NOUT, FMT = 9998 )M, P, N, IMAT, I,
217 $ RESULT( I )
218 NFAIL = NFAIL + 1
219 END IF
220 20 CONTINUE
221 NRUN = NRUN + NT
222 *
223 30 CONTINUE
224 40 CONTINUE
225 *
226 * Print a summary of the results.
227 *
228 CALL ALASUM( PATH, NOUT, NFAIL, NRUN, 0 )
229 *
230 9999 FORMAT( ' SLATMS in SCKLSE INFO = ', I5 )
231 9998 FORMAT( ' M=', I4, ' P=', I4, ', N=', I4, ', type ', I2,
232 $ ', test ', I2, ', ratio=', G13.6 )
233 9997 FORMAT( ' *** Invalid input for LSE: M = ', I6, ', P = ', I6,
234 $ ', N = ', I6, ';', / ' must satisfy P <= N <= P+M ',
235 $ '(this set of values will be skipped)' )
236 RETURN
237 *
238 * End of SCKLSE
239 *
240 END