LAPACK  3.8.0
LAPACK: Linear Algebra PACKage

◆ dckglm()

subroutine dckglm ( integer  NN,
integer, dimension( * )  MVAL,
integer, dimension( * )  PVAL,
integer, dimension( * )  NVAL,
integer  NMATS,
integer, dimension( 4 )  ISEED,
double precision  THRESH,
integer  NMAX,
double precision, dimension( * )  A,
double precision, dimension( * )  AF,
double precision, dimension( * )  B,
double precision, dimension( * )  BF,
double precision, dimension( * )  X,
double precision, dimension( * )  WORK,
double precision, dimension( * )  RWORK,
integer  NIN,
integer  NOUT,
integer  INFO 
)

DCKGLM

Purpose:
 DCKGLM tests DGGGLM - subroutine for solving generalized linear
                       model problem.
Parameters
[in]NN
          NN is INTEGER
          The number of values of N, M and P contained in the vectors
          NVAL, MVAL and PVAL.
[in]MVAL
          MVAL is INTEGER array, dimension (NN)
          The values of the matrix column dimension M.
[in]PVAL
          PVAL is INTEGER array, dimension (NN)
          The values of the matrix column dimension P.
[in]NVAL
          NVAL is INTEGER array, dimension (NN)
          The values of the matrix row dimension N.
[in]NMATS
          NMATS is INTEGER
          The number of matrix types to be tested for each combination
          of matrix dimensions.  If NMATS >= NTYPES (the maximum
          number of matrix types), then all the different types are
          generated for testing.  If NMATS < NTYPES, another input line
          is read to get the numbers of the matrix types to be used.
[in,out]ISEED
          ISEED is INTEGER array, dimension (4)
          On entry, the seed of the random number generator.  The array
          elements should be between 0 and 4095, otherwise they will be
          reduced mod 4096, and ISEED(4) must be odd.
          On exit, the next seed in the random number sequence after
          all the test matrices have been generated.
[in]THRESH
          THRESH is DOUBLE PRECISION
          The threshold value for the test ratios.  A result is
          included in the output file if RESID >= THRESH.  To have
          every test ratio printed, use THRESH = 0.
[in]NMAX
          NMAX is INTEGER
          The maximum value permitted for M or N, used in dimensioning
          the work arrays.
[out]A
          A is DOUBLE PRECISION array, dimension (NMAX*NMAX)
[out]AF
          AF is DOUBLE PRECISION array, dimension (NMAX*NMAX)
[out]B
          B is DOUBLE PRECISION array, dimension (NMAX*NMAX)
[out]BF
          BF is DOUBLE PRECISION array, dimension (NMAX*NMAX)
[out]X
          X is DOUBLE PRECISION array, dimension (4*NMAX)
[out]RWORK
          RWORK is DOUBLE PRECISION array, dimension (NMAX)
[out]WORK
          WORK is DOUBLE PRECISION array, dimension (NMAX*NMAX)
[in]NIN
          NIN is INTEGER
          The unit number for input.
[in]NOUT
          NOUT is INTEGER
          The unit number for output.
[out]INFO
          INFO is INTEGER
          = 0 :  successful exit
          > 0 :  If DLATMS returns an error code, the absolute value
                 of it is returned.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
December 2016

Definition at line 169 of file dckglm.f.

169 *
170 * -- LAPACK test routine (version 3.7.0) --
171 * -- LAPACK is a software package provided by Univ. of Tennessee, --
172 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
173 * December 2016
174 *
175 * .. Scalar Arguments ..
176  INTEGER info, nin, nmats, nmax, nn, nout
177  DOUBLE PRECISION thresh
178 * ..
179 * .. Array Arguments ..
180  INTEGER iseed( 4 ), mval( * ), nval( * ), pval( * )
181  DOUBLE PRECISION a( * ), af( * ), b( * ), bf( * ), rwork( * ),
182  $ work( * ), x( * )
183 * ..
184 *
185 * =====================================================================
186 *
187 * .. Parameters ..
188  INTEGER ntypes
189  parameter( ntypes = 8 )
190 * ..
191 * .. Local Scalars ..
192  LOGICAL firstt
193  CHARACTER dista, distb, type
194  CHARACTER*3 path
195  INTEGER i, iinfo, ik, imat, kla, klb, kua, kub, lda,
196  $ ldb, lwork, m, modea, modeb, n, nfail, nrun, p
197  DOUBLE PRECISION anorm, bnorm, cndnma, cndnmb, resid
198 * ..
199 * .. Local Arrays ..
200  LOGICAL dotype( ntypes )
201 * ..
202 * .. External Functions ..
203  DOUBLE PRECISION dlarnd
204  EXTERNAL dlarnd
205 * ..
206 * .. External Subroutines ..
207  EXTERNAL alahdg, alareq, alasum, dglmts, dlatb9, dlatms
208 * ..
209 * .. Intrinsic Functions ..
210  INTRINSIC abs
211 * ..
212 * .. Executable Statements ..
213 *
214 * Initialize constants.
215 *
216  path( 1: 3 ) = 'GLM'
217  info = 0
218  nrun = 0
219  nfail = 0
220  firstt = .true.
221  CALL alareq( path, nmats, dotype, ntypes, nin, nout )
222  lda = nmax
223  ldb = nmax
224  lwork = nmax*nmax
225 *
226 * Check for valid input values.
227 *
228  DO 10 ik = 1, nn
229  m = mval( ik )
230  p = pval( ik )
231  n = nval( ik )
232  IF( m.GT.n .OR. n.GT.m+p ) THEN
233  IF( firstt ) THEN
234  WRITE( nout, fmt = * )
235  firstt = .false.
236  END IF
237  WRITE( nout, fmt = 9997 )m, p, n
238  END IF
239  10 CONTINUE
240  firstt = .true.
241 *
242 * Do for each value of M in MVAL.
243 *
244  DO 40 ik = 1, nn
245  m = mval( ik )
246  p = pval( ik )
247  n = nval( ik )
248  IF( m.GT.n .OR. n.GT.m+p )
249  $ GO TO 40
250 *
251  DO 30 imat = 1, ntypes
252 *
253 * Do the tests only if DOTYPE( IMAT ) is true.
254 *
255  IF( .NOT.dotype( imat ) )
256  $ GO TO 30
257 *
258 * Set up parameters with DLATB9 and generate test
259 * matrices A and B with DLATMS.
260 *
261  CALL dlatb9( path, imat, m, p, n, TYPE, kla, kua, klb, kub,
262  $ anorm, bnorm, modea, modeb, cndnma, cndnmb,
263  $ dista, distb )
264 *
265  CALL dlatms( n, m, dista, iseed, TYPE, rwork, modea, cndnma,
266  $ anorm, kla, kua, 'No packing', a, lda, work,
267  $ iinfo )
268  IF( iinfo.NE.0 ) THEN
269  WRITE( nout, fmt = 9999 )iinfo
270  info = abs( iinfo )
271  GO TO 30
272  END IF
273 *
274  CALL dlatms( n, p, distb, iseed, TYPE, rwork, modeb, cndnmb,
275  $ bnorm, klb, kub, 'No packing', b, ldb, work,
276  $ iinfo )
277  IF( iinfo.NE.0 ) THEN
278  WRITE( nout, fmt = 9999 )iinfo
279  info = abs( iinfo )
280  GO TO 30
281  END IF
282 *
283 * Generate random left hand side vector of GLM
284 *
285  DO 20 i = 1, n
286  x( i ) = dlarnd( 2, iseed )
287  20 CONTINUE
288 *
289  CALL dglmts( n, m, p, a, af, lda, b, bf, ldb, x,
290  $ x( nmax+1 ), x( 2*nmax+1 ), x( 3*nmax+1 ),
291  $ work, lwork, rwork, resid )
292 *
293 * Print information about the tests that did not
294 * pass the threshold.
295 *
296  IF( resid.GE.thresh ) THEN
297  IF( nfail.EQ.0 .AND. firstt ) THEN
298  firstt = .false.
299  CALL alahdg( nout, path )
300  END IF
301  WRITE( nout, fmt = 9998 )n, m, p, imat, 1, resid
302  nfail = nfail + 1
303  END IF
304  nrun = nrun + 1
305 *
306  30 CONTINUE
307  40 CONTINUE
308 *
309 * Print a summary of the results.
310 *
311  CALL alasum( path, nout, nfail, nrun, 0 )
312 *
313  9999 FORMAT( ' DLATMS in DCKGLM INFO = ', i5 )
314  9998 FORMAT( ' N=', i4, ' M=', i4, ', P=', i4, ', type ', i2,
315  $ ', test ', i2, ', ratio=', g13.6 )
316  9997 FORMAT( ' *** Invalid input for GLM: M = ', i6, ', P = ', i6,
317  $ ', N = ', i6, ';', / ' must satisfy M <= N <= M+P ',
318  $ '(this set of values will be skipped)' )
319  RETURN
320 *
321 * End of DCKGLM
322 *
subroutine dlatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
DLATMS
Definition: dlatms.f:323
subroutine alareq(PATH, NMATS, DOTYPE, NTYPES, NIN, NOUT)
ALAREQ
Definition: alareq.f:92
subroutine dlatb9(PATH, IMAT, M, P, N, TYPE, KLA, KUA, KLB, KUB, ANORM, BNORM, MODEA, MODEB, CNDNMA, CNDNMB, DISTA, DISTB)
DLATB9
Definition: dlatb9.f:172
subroutine dglmts(N, M, P, A, AF, LDA, B, BF, LDB, D, DF, X, U, WORK, LWORK, RWORK, RESULT)
DGLMTS
Definition: dglmts.f:148
double precision function dlarnd(IDIST, ISEED)
DLARND
Definition: dlarnd.f:75
subroutine alahdg(IOUNIT, PATH)
ALAHDG
Definition: alahdg.f:64
subroutine alasum(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASUM
Definition: alasum.f:75
Here is the call graph for this function:
Here is the caller graph for this function: