1*> \brief \b SCKGLM
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 SCKGLM( 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*> SCKGLM tests SGGGLM - subroutine for solving generalized linear
32*>                       model problem.
33*> \endverbatim
34*
35*  Arguments:
36*  ==========
37*
38*> \param[in] NN
39*> \verbatim
40*>          NN is INTEGER
41*>          The number of values of N, M and P contained in the vectors
42*>          NVAL, MVAL and PVAL.
43*> \endverbatim
44*>
45*> \param[in] MVAL
46*> \verbatim
47*>          MVAL is INTEGER array, dimension (NN)
48*>          The values of the matrix 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 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 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 RESID >= 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 (4*NMAX)
121*> \endverbatim
122*>
123*> \param[out] RWORK
124*> \verbatim
125*>          RWORK is REAL array, dimension (NMAX)
126*> \endverbatim
127*>
128*> \param[out] WORK
129*> \verbatim
130*>          WORK is REAL array, dimension (NMAX*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 SCKGLM( 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            NTYPES
186      PARAMETER          ( NTYPES = 8 )
187*     ..
188*     .. Local Scalars ..
189      LOGICAL            FIRSTT
190      CHARACTER          DISTA, DISTB, TYPE
191      CHARACTER*3        PATH
192      INTEGER            I, IINFO, IK, IMAT, KLA, KLB, KUA, KUB, LDA,
193     $                   LDB, LWORK, M, MODEA, MODEB, N, NFAIL, NRUN, P
194      REAL               ANORM, BNORM, CNDNMA, CNDNMB, RESID
195*     ..
196*     .. Local Arrays ..
197      LOGICAL            DOTYPE( NTYPES )
198*     ..
199*     .. External Functions ..
200      REAL               SLARND
201      EXTERNAL           SLARND
202*     ..
203*     .. External Subroutines ..
204      EXTERNAL           ALAHDG, ALAREQ, ALASUM, SGLMTS, SLATB9, SLATMS
205*     ..
206*     .. Intrinsic Functions ..
207      INTRINSIC          ABS
208*     ..
209*     .. Executable Statements ..
210*
211*     Initialize constants.
212*
213      PATH( 1: 3 ) = 'GLM'
214      INFO = 0
215      NRUN = 0
216      NFAIL = 0
217      FIRSTT = .TRUE.
218      CALL ALAREQ( PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT )
219      LDA = NMAX
220      LDB = NMAX
221      LWORK = NMAX*NMAX
222*
223*     Check for valid input values.
224*
225      DO 10 IK = 1, NN
226         M = MVAL( IK )
227         P = PVAL( IK )
228         N = NVAL( IK )
229         IF( M.GT.N .OR. N.GT.M+P ) THEN
230            IF( FIRSTT ) THEN
231               WRITE( NOUT, FMT = * )
232               FIRSTT = .FALSE.
233            END IF
234            WRITE( NOUT, FMT = 9997 )M, P, N
235         END IF
236   10 CONTINUE
237      FIRSTT = .TRUE.
238*
239*     Do for each value of M in MVAL.
240*
241      DO 40 IK = 1, NN
242         M = MVAL( IK )
243         P = PVAL( IK )
244         N = NVAL( IK )
245         IF( M.GT.N .OR. N.GT.M+P )
246     $      GO TO 40
247*
248         DO 30 IMAT = 1, NTYPES
249*
250*           Do the tests only if DOTYPE( IMAT ) is true.
251*
252            IF( .NOT.DOTYPE( IMAT ) )
253     $         GO TO 30
254*
255*           Set up parameters with SLATB9 and generate test
256*           matrices A and B with SLATMS.
257*
258            CALL SLATB9( PATH, IMAT, M, P, N, TYPE, KLA, KUA, KLB, KUB,
259     $                   ANORM, BNORM, MODEA, MODEB, CNDNMA, CNDNMB,
260     $                   DISTA, DISTB )
261*
262            CALL SLATMS( N, M, DISTA, ISEED, TYPE, RWORK, MODEA, CNDNMA,
263     $                   ANORM, KLA, KUA, 'No packing', A, LDA, WORK,
264     $                   IINFO )
265            IF( IINFO.NE.0 ) THEN
266               WRITE( NOUT, FMT = 9999 )IINFO
267               INFO = ABS( IINFO )
268               GO TO 30
269            END IF
270*
271            CALL SLATMS( N, P, DISTB, ISEED, TYPE, RWORK, MODEB, CNDNMB,
272     $                   BNORM, KLB, KUB, 'No packing', B, LDB, WORK,
273     $                   IINFO )
274            IF( IINFO.NE.0 ) THEN
275               WRITE( NOUT, FMT = 9999 )IINFO
276               INFO = ABS( IINFO )
277               GO TO 30
278            END IF
279*
280*           Generate random left hand side vector of GLM
281*
282            DO 20 I = 1, N
283               X( I ) = SLARND( 2, ISEED )
284   20       CONTINUE
285*
286            CALL SGLMTS( N, M, P, A, AF, LDA, B, BF, LDB, X,
287     $                   X( NMAX+1 ), X( 2*NMAX+1 ), X( 3*NMAX+1 ),
288     $                   WORK, LWORK, RWORK, RESID )
289*
290*           Print information about the tests that did not
291*           pass the threshold.
292*
293            IF( RESID.GE.THRESH ) THEN
294               IF( NFAIL.EQ.0 .AND. FIRSTT ) THEN
295                  FIRSTT = .FALSE.
296                  CALL ALAHDG( NOUT, PATH )
297               END IF
298               WRITE( NOUT, FMT = 9998 )N, M, P, IMAT, 1, RESID
299               NFAIL = NFAIL + 1
300            END IF
301            NRUN = NRUN + 1
302*
303   30    CONTINUE
304   40 CONTINUE
305*
306*     Print a summary of the results.
307*
308      CALL ALASUM( PATH, NOUT, NFAIL, NRUN, 0 )
309*
310 9999 FORMAT( ' SLATMS in SCKGLM INFO = ', I5 )
311 9998 FORMAT( ' N=', I4, ' M=', I4, ', P=', I4, ', type ', I2,
312     $      ', test ', I2, ', ratio=', G13.6 )
313 9997 FORMAT( ' *** Invalid input  for GLM:  M = ', I6, ', P = ', I6,
314     $      ', N = ', I6, ';', / '     must satisfy M <= N <= M+P  ',
315     $      '(this set of values will be skipped)' )
316      RETURN
317*
318*     End of SCKGLM
319*
320      END
321