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
     228
     229
     230
     231
     232
     233
     234
     235
     236
     237
     238
     239
     240
     241
     242
     243
     244
     245
     246
     247
     248
     249
     250
     251
     252
      SUBROUTINE DLATB9PATHIMATMPNTYPEKLAKUAKLBKUB,
     $                   ANORMBNORMMODEAMODEBCNDNMACNDNMB,
     $                   DISTADISTB )
*
*  -- LAPACK test routine (version 3.1) --
*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
*     November 2006
*
*     .. Scalar Arguments ..
      CHARACTER          DISTADISTBTYPE
      CHARACTER*3        PATH
      INTEGER            IMATKLAKLBKUAKUBMMODEAMODEBNP
      DOUBLE PRECISION   ANORMBNORMCNDNMACNDNMB
*     ..
*
*  Purpose
*  =======
*
*  DLATB9 sets parameters for the matrix generator based on the type of
*  matrix to be generated.
*
*  Arguments
*  =========
*
*  PATH    (input) CHARACTER*3
*          The LAPACK path name.
*
*  IMAT    (input) INTEGER
*          An integer key describing which matrix to generate for this
*          path.
*
*  M       (input) INTEGER
*          The number of rows in the matrix to be generated.
*
*  N       (input) INTEGER
*          The number of columns in the matrix to be generated.
*
*  TYPE    (output) CHARACTER*1
*          The type of the matrix to be generated:
*          = 'S':  symmetric matrix;
*          = 'P':  symmetric positive (semi)definite matrix;
*          = 'N':  nonsymmetric matrix.
*
*  KL      (output) INTEGER
*          The lower band width of the matrix to be generated.
*
*  KU      (output) INTEGER
*          The upper band width of the matrix to be generated.
*
*  ANORM   (output) DOUBLE PRECISION
*          The desired norm of the matrix to be generated.  The diagonal
*          matrix of singular values or eigenvalues is scaled by this
*          value.
*
*  MODE    (output) INTEGER
*          A key indicating how to choose the vector of eigenvalues.
*
*  CNDNUM  (output) DOUBLE PRECISION
*          The desired condition number.
*
*  DIST    (output) CHARACTER*1
*          The type of distribution to be used by the random number
*          generator.
*
*  =====================================================================
*
*     .. Parameters ..
      DOUBLE PRECISION   SHRINKTENTH
      PARAMETER          ( SHRINK = 0.25D0TENTH = 0.1D+0 )
      DOUBLE PRECISION   ONETEN
      PARAMETER          ( ONE = 1.0D+0TEN = 1.0D+1 )
*     ..
*     .. Local Scalars ..
      LOGICAL            FIRST
      DOUBLE PRECISION   BADC1BADC2EPSLARGESMALL
*     ..
*     .. External Functions ..
      LOGICAL            LSAMEN
      DOUBLE PRECISION   DLAMCH
      EXTERNAL           LSAMENDLAMCH
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          MAXSQRT
*     ..
*     .. External Subroutines ..
      EXTERNAL           DLABAD
*     ..
*     .. Save statement ..
      SAVE               EPSSMALLLARGEBADC1BADC2FIRST
*     ..
*     .. Data statements ..
      DATA               FIRST / .TRUE. /
*     ..
*     .. Executable Statements ..
*
*     Set some constants for use in the subroutine.
*
      IFFIRST ) THEN
         FIRST = .FALSE.
         EPS = DLAMCH'Precision' )
         BADC2 = TENTH / EPS
         BADC1 = SQRTBADC2 )
         SMALL = DLAMCH'Safe minimum' )
         LARGE = ONE / SMALL
*
*        If it looks like we're on a Cray, take the square root of
*        SMALL and LARGE to avoid overflow and underflow problems.
*
         CALL DLABADSMALLLARGE )
         SMALL = SHRINK*SMALL / EPS )
         LARGE = ONE / SMALL
      END IF
*
*     Set some parameters we don't plan to change.
*
      TYPE = 'N'
      DISTA = 'S'
      DISTB = 'S'
      MODEA = 3
      MODEB = 4
*
*     Set the lower and upper bandwidths.
*
      IFLSAMEN3PATH'GRQ' ) .OR. LSAMEN3PATH'LSE' ) .OR.
     $    LSAMEN3PATH'GSV' ) ) THEN
*
*        A: M by N, B: P by N
*
         IFIMAT.EQ.1 ) THEN
*
*           A: diagonal, B: upper triangular
*
            KLA = 0
            KUA = 0
            KLB = 0
            KUB = MAXN-10 )
*
         ELSE IFIMAT.EQ.2 ) THEN
*
*           A: upper triangular, B: upper triangular
*
            KLA = 0
            KUA = MAXN-10 )
            KLB = 0
            KUB = MAXN-10 )
*
         ELSE IFIMAT.EQ.3 ) THEN
*
*           A: lower triangular, B: upper triangular
*
            KLA = MAXM-10 )
            KUA = 0
            KLB = 0
            KUB = MAXN-10 )
*
         ELSE
*
*           A: general dense, B: general dense
*
            KLA = MAXM-10 )
            KUA = MAXN-10 )
            KLB = MAXP-10 )
            KUB = MAXN-10 )
*
         END IF
*
      ELSE IFLSAMEN3PATH'GQR' ) .OR. LSAMEN3PATH'GLM' ) )
     $          THEN
*
*        A: N by M, B: N by P
*
         IFIMAT.EQ.1 ) THEN
*
*           A: diagonal, B: lower triangular
*
            KLA = 0
            KUA = 0
            KLB = MAXN-10 )
            KUB = 0
         ELSE IFIMAT.EQ.2 ) THEN
*
*           A: lower triangular, B: diagonal
*
            KLA = MAXN-10 )
            KUA = 0
            KLB = 0
            KUB = 0
*
         ELSE IFIMAT.EQ.3 ) THEN
*
*           A: lower triangular, B: upper triangular
*
            KLA = MAXN-10 )
            KUA = 0
            KLB = 0
            KUB = MAXP-10 )
*
         ELSE
*
*           A: general dense, B: general dense
*
            KLA = MAXN-10 )
            KUA = MAXM-10 )
            KLB = MAXN-10 )
            KUB = MAXP-10 )
         END IF
*
      END IF
*
*     Set the condition number and norm.
*
      CNDNMA = TEN*TEN
      CNDNMB = TEN
      IFLSAMEN3PATH'GQR' ) .OR. LSAMEN3PATH'GRQ' ) .OR.
     $    LSAMEN3PATH'GSV' ) ) THEN
         IFIMAT.EQ.5 ) THEN
            CNDNMA = BADC1
            CNDNMB = BADC1
         ELSE IFIMAT.EQ.6 ) THEN
            CNDNMA = BADC2
            CNDNMB = BADC2
         ELSE IFIMAT.EQ.7 ) THEN
            CNDNMA = BADC1
            CNDNMB = BADC2
         ELSE IFIMAT.EQ.8 ) THEN
            CNDNMA = BADC2
            CNDNMB = BADC1
         END IF
      END IF
*
      ANORM = TEN
      BNORM = TEN*TEN*TEN
      IFLSAMEN3PATH'GQR' ) .OR. LSAMEN3PATH'GRQ' ) ) THEN
         IFIMAT.EQ.7 ) THEN
            ANORM = SMALL
            BNORM = LARGE
         ELSE IFIMAT.EQ.8 ) THEN
            ANORM = LARGE
            BNORM = SMALL
         END IF
      END IF
*
      IFN.LE.1 ) THEN
         CNDNMA = ONE
         CNDNMB = ONE
      END IF
*
      RETURN
*
*     End of DLATB9
*
      END