1*> \brief \b SCKLSE
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*  Definition:
9*  ===========
10*
11*       SUBROUTINE SCKLSE( NN, MVAL, PVAL, NVAL, NMATS, ISEED, THRESH,
12*                          NMAX, A, AF, B, BF, X, WORK, RWORK, NIN, NOUT,
13*                          INFO )
14*
15*       .. Scalar Arguments ..
16*       INTEGER            INFO, NIN, NMATS, NMAX, NN, NOUT
17*       REAL               THRESH
18*       ..
19*       .. Array Arguments ..
20*       INTEGER            ISEED( 4 ), MVAL( * ), NVAL( * ), PVAL( * )
21*       REAL               A( * ), AF( * ), B( * ), BF( * ), RWORK( * ),
22*      $                   WORK( * ), X( * )
23*       ..
24*
25*
26*> \par Purpose:
27*  =============
28*>
29*> \verbatim
30*>
31*> SCKLSE tests SGGLSE - a subroutine for solving linear equality
32*> constrained least square problem (LSE).
33*> \endverbatim
34*
35*  Arguments:
36*  ==========
37*
38*> \param[in] NN
39*> \verbatim
40*>          NN is INTEGER
41*>          The number of values of (M,P,N) contained in the vectors
42*>          (MVAL, PVAL, NVAL).
43*> \endverbatim
44*>
45*> \param[in] MVAL
46*> \verbatim
47*>          MVAL is INTEGER array, dimension (NN)
48*>          The values of the matrix row(column) dimension M.
49*> \endverbatim
50*>
51*> \param[in] PVAL
52*> \verbatim
53*>          PVAL is INTEGER array, dimension (NN)
54*>          The values of the matrix row(column) dimension P.
55*> \endverbatim
56*>
57*> \param[in] NVAL
58*> \verbatim
59*>          NVAL is INTEGER array, dimension (NN)
60*>          The values of the matrix column(row) dimension N.
61*> \endverbatim
62*>
63*> \param[in] NMATS
64*> \verbatim
65*>          NMATS is INTEGER
66*>          The number of matrix types to be tested for each combination
67*>          of matrix dimensions.  If NMATS >= NTYPES (the maximum
68*>          number of matrix types), then all the different types are
69*>          generated for testing.  If NMATS < NTYPES, another input line
70*>          is read to get the numbers of the matrix types to be used.
71*> \endverbatim
72*>
73*> \param[in,out] ISEED
74*> \verbatim
75*>          ISEED is INTEGER array, dimension (4)
76*>          On entry, the seed of the random number generator.  The array
77*>          elements should be between 0 and 4095, otherwise they will be
78*>          reduced mod 4096, and ISEED(4) must be odd.
79*>          On exit, the next seed in the random number sequence after
80*>          all the test matrices have been generated.
81*> \endverbatim
82*>
83*> \param[in] THRESH
84*> \verbatim
85*>          THRESH is REAL
86*>          The threshold value for the test ratios.  A result is
87*>          included in the output file if RESULT >= THRESH.  To have
88*>          every test ratio printed, use THRESH = 0.
89*> \endverbatim
90*>
91*> \param[in] NMAX
92*> \verbatim
93*>          NMAX is INTEGER
94*>          The maximum value permitted for M or N, used in dimensioning
95*>          the work arrays.
96*> \endverbatim
97*>
98*> \param[out] A
99*> \verbatim
100*>          A is REAL array, dimension (NMAX*NMAX)
101*> \endverbatim
102*>
103*> \param[out] AF
104*> \verbatim
105*>          AF is REAL array, dimension (NMAX*NMAX)
106*> \endverbatim
107*>
108*> \param[out] B
109*> \verbatim
110*>          B is REAL array, dimension (NMAX*NMAX)
111*> \endverbatim
112*>
113*> \param[out] BF
114*> \verbatim
115*>          BF is REAL array, dimension (NMAX*NMAX)
116*> \endverbatim
117*>
118*> \param[out] X
119*> \verbatim
120*>          X is REAL array, dimension (5*NMAX)
121*> \endverbatim
122*>
123*> \param[out] WORK
124*> \verbatim
125*>          WORK is REAL array, dimension (NMAX*NMAX)
126*> \endverbatim
127*>
128*> \param[out] RWORK
129*> \verbatim
130*>          RWORK is REAL array, dimension (NMAX)
131*> \endverbatim
132*>
133*> \param[in] NIN
134*> \verbatim
135*>          NIN is INTEGER
136*>          The unit number for input.
137*> \endverbatim
138*>
139*> \param[in] NOUT
140*> \verbatim
141*>          NOUT is INTEGER
142*>          The unit number for output.
143*> \endverbatim
144*>
145*> \param[out] INFO
146*> \verbatim
147*>          INFO is INTEGER
148*>          = 0 :  successful exit
149*>          > 0 :  If SLATMS returns an error code, the absolute value
150*>                 of it is returned.
151*> \endverbatim
152*
153*  Authors:
154*  ========
155*
156*> \author Univ. of Tennessee
157*> \author Univ. of California Berkeley
158*> \author Univ. of Colorado Denver
159*> \author NAG Ltd.
160*
161*> \ingroup single_eig
162*
163*  =====================================================================
164      SUBROUTINE SCKLSE( NN, MVAL, PVAL, NVAL, NMATS, ISEED, THRESH,
165     $                   NMAX, A, AF, B, BF, X, WORK, RWORK, NIN, NOUT,
166     $                   INFO )
167*
168*  -- LAPACK test routine --
169*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
170*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
171*
172*     .. Scalar Arguments ..
173      INTEGER            INFO, NIN, NMATS, NMAX, NN, NOUT
174      REAL               THRESH
175*     ..
176*     .. Array Arguments ..
177      INTEGER            ISEED( 4 ), MVAL( * ), NVAL( * ), PVAL( * )
178      REAL               A( * ), AF( * ), B( * ), BF( * ), RWORK( * ),
179     $                   WORK( * ), X( * )
180*     ..
181*
182*  =====================================================================
183*
184*     .. Parameters ..
185      INTEGER            NTESTS
186      PARAMETER          ( NTESTS = 7 )
187      INTEGER            NTYPES
188      PARAMETER          ( NTYPES = 8 )
189*     ..
190*     .. Local Scalars ..
191      LOGICAL            FIRSTT
192      CHARACTER          DISTA, DISTB, TYPE
193      CHARACTER*3        PATH
194      INTEGER            I, IINFO, IK, IMAT, KLA, KLB, KUA, KUB, LDA,
195     $                   LDB, LWORK, M, MODEA, MODEB, N, NFAIL, NRUN,
196     $                   NT, P
197      REAL               ANORM, BNORM, CNDNMA, CNDNMB
198*     ..
199*     .. Local Arrays ..
200      LOGICAL            DOTYPE( NTYPES )
201      REAL               RESULT( NTESTS )
202*     ..
203*     .. External Subroutines ..
204      EXTERNAL           ALAHDG, ALAREQ, ALASUM, SLARHS, SLATB9, SLATMS,
205     $                   SLSETS
206*     ..
207*     .. Intrinsic Functions ..
208      INTRINSIC          ABS, MAX
209*     ..
210*     .. Executable Statements ..
211*
212*     Initialize constants and the random number seed.
213*
214      PATH( 1: 3 ) = 'LSE'
215      INFO = 0
216      NRUN = 0
217      NFAIL = 0
218      FIRSTT = .TRUE.
219      CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
220      LDA = NMAX
221      LDB = NMAX
222      LWORK = NMAX*NMAX
223*
224*     Check for valid input values.
225*
226      DO 10 IK = 1, NN
227         M = MVAL( IK )
228         P = PVAL( IK )
229         N = NVAL( IK )
230         IF( P.GT.N .OR. N.GT.M+P ) THEN
231            IF( FIRSTT ) THEN
232               WRITE( NOUT, FMT = * )
233               FIRSTT = .FALSE.
234            END IF
235            WRITE( NOUT, FMT = 9997 )M, P, N
236         END IF
237   10 CONTINUE
238      FIRSTT = .TRUE.
239*
240*     Do for each value of M in MVAL.
241*
242      DO 40 IK = 1, NN
243         M = MVAL( IK )
244         P = PVAL( IK )
245         N = NVAL( IK )
246         IF( P.GT.N .OR. N.GT.M+P )
247     $      GO TO 40
248*
249         DO 30 IMAT = 1, NTYPES
250*
251*           Do the tests only if DOTYPE( IMAT ) is true.
252*
253            IF( .NOT.DOTYPE( IMAT ) )
254     $         GO TO 30
255*
256*           Set up parameters with SLATB9 and generate test
257*           matrices A and B with SLATMS.
258*
259            CALL SLATB9( PATH, IMAT, M, P, N, TYPE, KLA, KUA, KLB, KUB,
260     $                   ANORM, BNORM, MODEA, MODEB, CNDNMA, CNDNMB,
261     $                   DISTA, DISTB )
262*
263            CALL SLATMS( M, N, DISTA, ISEED, TYPE, RWORK, MODEA, CNDNMA,
264     $                   ANORM, KLA, KUA, 'No packing', A, LDA, WORK,
265     $                   IINFO )
266            IF( IINFO.NE.0 ) THEN
267               WRITE( NOUT, FMT = 9999 )IINFO
268               INFO = ABS( IINFO )
269               GO TO 30
270            END IF
271*
272            CALL SLATMS( P, N, DISTB, ISEED, TYPE, RWORK, MODEB, CNDNMB,
273     $                   BNORM, KLB, KUB, 'No packing', B, LDB, WORK,
274     $                   IINFO )
275            IF( IINFO.NE.0 ) THEN
276               WRITE( NOUT, FMT = 9999 )IINFO
277               INFO = ABS( IINFO )
278               GO TO 30
279            END IF
280*
281*           Generate the right-hand sides C and D for the LSE.
282*
283            CALL SLARHS( 'SGE', 'New solution', 'Upper', 'N', M, N,
284     $                   MAX( M-1, 0 ), MAX( N-1, 0 ), 1, A, LDA,
285     $                   X( 4*NMAX+1 ), MAX( N, 1 ), X, MAX( M, 1 ),
286     $                   ISEED, IINFO )
287*
288            CALL SLARHS( 'SGE', 'Computed', 'Upper', 'N', P, N,
289     $                   MAX( P-1, 0 ), MAX( N-1, 0 ), 1, B, LDB,
290     $                   X( 4*NMAX+1 ), MAX( N, 1 ), X( 2*NMAX+1 ),
291     $                   MAX( P, 1 ), ISEED, IINFO )
292*
293            NT = 2
294*
295            CALL SLSETS( M, P, N, A, AF, LDA, B, BF, LDB, X,
296     $                   X( NMAX+1 ), X( 2*NMAX+1 ), X( 3*NMAX+1 ),
297     $                   X( 4*NMAX+1 ), WORK, LWORK, RWORK,
298     $                   RESULT( 1 ) )
299*
300*           Print information about the tests that did not
301*           pass the threshold.
302*
303            DO 20 I = 1, NT
304               IF( RESULT( I ).GE.THRESH ) THEN
305                  IF( NFAIL.EQ.0 .AND. FIRSTT ) THEN
306                     FIRSTT = .FALSE.
307                     CALL ALAHDG( NOUT, PATH )
308                  END IF
309                  WRITE( NOUT, FMT = 9998 )M, P, N, IMAT, I,
310     $               RESULT( I )
311                  NFAIL = NFAIL + 1
312               END IF
313   20       CONTINUE
314            NRUN = NRUN + NT
315*
316   30    CONTINUE
317   40 CONTINUE
318*
319*     Print a summary of the results.
320*
321      CALL ALASUM( PATH, NOUT, NFAIL, NRUN, 0 )
322*
323 9999 FORMAT( ' SLATMS in SCKLSE   INFO = ', I5 )
324 9998 FORMAT( ' M=', I4, ' P=', I4, ', N=', I4, ', type ', I2,
325     $      ', test ', I2, ', ratio=', G13.6 )
326 9997 FORMAT( ' *** Invalid input  for LSE:  M = ', I6, ', P = ', I6,
327     $      ', N = ', I6, ';', / '     must satisfy P <= N <= P+M  ',
328     $      '(this set of values will be skipped)' )
329      RETURN
330*
331*     End of SCKLSE
332*
333      END
334