1
       2
       3
       4
       5
       6
       7
       8
       9
      10
      11
      12
      13
      14
      15
      16
      17
      18
      19
      20
      21
      22
      23
      24
      25
      26
      27
      28
      29
      30
      31
      32
      33
      34
      35
      36
      37
      38
      39
      40
      41
      42
      43
      44
      45
      46
      47
      48
      49
      50
      51
      52
      53
      54
      55
      56
      57
      58
      59
      60
      61
      62
      63
      64
      65
      66
      67
      68
      69
      70
      71
      72
      73
      74
      75
      76
      77
      78
      79
      80
      81
      82
      83
      84
      85
      86
      87
      88
      89
      90
      91
      92
      93
      94
      95
      96
      97
      98
      99
     100
     101
     102
     103
     104
     105
     106
     107
     108
     109
     110
     111
     112
     113
     114
     115
     116
     117
     118
     119
     120
     121
     122
     123
     124
     125
     126
     127
     128
     129
     130
     131
     132
     133
     134
     135
     136
     137
     138
     139
     140
     141
     142
     143
     144
     145
     146
     147
     148
     149
     150
     151
     152
     153
     154
     155
     156
     157
     158
     159
     160
     161
     162
     163
     164
     165
     166
     167
     168
     169
     170
     171
     172
     173
     174
     175
     176
     177
     178
     179
     180
     181
     182
     183
     184
     185
     186
     187
     188
     189
     190
     191
     192
     193
     194
     195
     196
     197
     198
     199
     200
     201
     202
     203
     204
     205
     206
     207
     208
     209
     210
     211
     212
     213
     214
     215
     216
     217
     218
     219
     220
     221
     222
     223
     224
     225
     226
     227
      SUBROUTINE DCKGLMNNMVALPVALNVALNMATSISEEDTHRESH,
     $                   NMAXAAFBBFXWORKRWORKNINNOUT,
     $                   INFO )
*
*  -- LAPACK test routine (version 3.1) --
*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
*     November 2006
*
*     .. Scalar Arguments ..
      INTEGER            INFONINNMATSNMAXNNNOUT
      DOUBLE PRECISION   THRESH
*     ..
*     .. Array Arguments ..
      INTEGER            ISEED4 ), MVAL* ), NVAL* ), PVAL* )
      DOUBLE PRECISION   A* ), AF* ), B* ), BF* ), RWORK* ),
     $                   WORK* ), X* )
*     ..
*
*  Purpose
*  =======
*
*  DCKGLM tests DGGGLM - subroutine for solving generalized linear
*                        model problem.
*
*  Arguments
*  =========
*
*  NN      (input) INTEGER
*          The number of values of N, M and P contained in the vectors
*          NVAL, MVAL and PVAL.
*
*  MVAL    (input) INTEGER array, dimension (NN)
*          The values of the matrix column dimension M.
*
*  PVAL    (input) INTEGER array, dimension (NN)
*          The values of the matrix column dimension P.
*
*  NVAL    (input) INTEGER array, dimension (NN)
*          The values of the matrix row dimension N.
*
*  NMATS   (input) 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.
*
*  ISEED   (input/output) 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.
*
*  THRESH  (input) 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.
*
*  NMAX    (input) INTEGER
*          The maximum value permitted for M or N, used in dimensioning
*          the work arrays.
*
*  A       (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX)
*
*  AF      (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX)
*
*  B       (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX)
*
*  BF      (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX)
*
*  X       (workspace) DOUBLE PRECISION array, dimension (4*NMAX)
*
*  RWORK   (workspace) DOUBLE PRECISION array, dimension (NMAX)
*
*  WORK    (workspace) DOUBLE PRECISION array, dimension (NMAX*NMAX)
*
*  NIN     (input) INTEGER
*          The unit number for input.
*
*  NOUT    (input) INTEGER
*          The unit number for output.
*
*  INFO    (output) INTEGER
*          = 0 :  successful exit
*          > 0 :  If DLATMS returns an error code, the absolute value
*                 of it is returned.
*
*  =====================================================================
*
*     .. Parameters ..
      INTEGER            NTYPES
      PARAMETER          ( NTYPES = 8 )
*     ..
*     .. Local Scalars ..
      LOGICAL            FIRSTT
      CHARACTER          DISTADISTBTYPE
      CHARACTER*3        PATH
      INTEGER            IIINFOIKIMATKLAKLBKUAKUBLDA,
     $                   LDBLWORKMMODEAMODEBNNFAILNRUNP
      DOUBLE PRECISION   ANORMBNORMCNDNMACNDNMBRESID
*     ..
*     .. Local Arrays ..
      LOGICAL            DOTYPENTYPES )
*     ..
*     .. External Functions ..
      DOUBLE PRECISION   DLARND
      EXTERNAL           DLARND
*     ..
*     .. External Subroutines ..
      EXTERNAL           ALAHDGALAREQALASUMDGLMTSDLATB9DLATMS
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          ABS
*     ..
*     .. Executable Statements ..
*
*     Initialize constants.
*
      PATH13 ) = 'GLM'
      INFO = 0
      NRUN = 0
      NFAIL = 0
      FIRSTT = .TRUE.
      CALL ALAREQPATHNMATSDOTYPENTYPESNINNOUT )
      LDA = NMAX
      LDB = NMAX
      LWORK = NMAX*NMAX
*
*     Check for valid input values.
*
      DO 10 IK = 1NN
         M = MVALIK )
         P = PVALIK )
         N = NVALIK )
         IFM.GT.N .OR. N.GT.M+P ) THEN
            IFFIRSTT ) THEN
               WRITENOUT, FMT = * )
               FIRSTT = .FALSE.
            END IF
            WRITENOUT, FMT = 9997 )M, P, N
         END IF
   10 CONTINUE
      FIRSTT = .TRUE.
*
*     Do for each value of M in MVAL.
*
      DO 40 IK = 1NN
         M = MVALIK )
         P = PVALIK )
         N = NVALIK )
         IFM.GT.N .OR. N.GT.M+P )
     $      GO TO 40
*
         DO 30 IMAT = 1NTYPES
*
*           Do the tests only if DOTYPE( IMAT ) is true.
*
            IF.NOT.DOTYPEIMAT ) )
     $         GO TO 30
*
*           Set up parameters with DLATB9 and generate test
*           matrices A and B with DLATMS.
*
            CALL DLATB9PATHIMATMPNTYPEKLAKUAKLBKUB,
     $                   ANORMBNORMMODEAMODEBCNDNMACNDNMB,
     $                   DISTADISTB )
*
            CALL DLATMSNMDISTAISEEDTYPERWORKMODEACNDNMA,
     $                   ANORMKLAKUA'No packing'ALDAWORK,
     $                   IINFO )
            IFIINFO.NE.0 ) THEN
               WRITENOUT, FMT = 9999 )IINFO
               INFO = ABSIINFO )
               GO TO 30
            END IF
*
            CALL DLATMSNPDISTBISEEDTYPERWORKMODEBCNDNMB,
     $                   BNORMKLBKUB'No packing'BLDBWORK,
     $                   IINFO )
            IFIINFO.NE.0 ) THEN
               WRITENOUT, FMT = 9999 )IINFO
               INFO = ABSIINFO )
               GO TO 30
            END IF
*
*           Generate random left hand side vector of GLM
*
            DO 20 I = 1N
               XI ) = DLARND2ISEED )
   20       CONTINUE
*
            CALL DGLMTSNMPAAFLDABBFLDBX,
     $                   XNMAX+1 ), X2*NMAX+1 ), X3*NMAX+1 ),
     $                   WORKLWORKRWORKRESID )
*
*           Print information about the tests that did not
*           pass the threshold.
*
            IFRESID.GE.THRESH ) THEN
               IFNFAIL.EQ.0 .AND. FIRSTT ) THEN
                  FIRSTT = .FALSE.
                  CALL ALAHDGNOUTPATH )
               END IF
               WRITENOUT, FMT = 9998 )N, M, P, IMAT, 1, RESID
               NFAIL = NFAIL + 1
            END IF
            NRUN = NRUN + 1
*
   30    CONTINUE
   40 CONTINUE
*
*     Print a summary of the results.
*
      CALL ALASUMPATHNOUTNFAILNRUN0 )
*
 9999 FORMAT( ' DLATMS in DCKGLM INFO = ', I5 )
 9998 FORMAT( ' N=', I4, ' M=', I4, ', P=', I4, ', type ', I2,
     $      ', test ', I2, ', ratio=', G13.6 )
 9997 FORMAT( ' *** Invalid input  for GLM:  M = ', I6, ', P = ', I6,
     $      ', N = ', I6, ';', / '     must satisfy M <= N <= M+P  ',
     $      '(this set of values will be skipped)' )
      RETURN
*
*     End of DCKGLM
*
      END