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
     253
     254
     255
      SUBROUTINE SLATM7MODECONDIRSIGNIDISTISEEDDN,
     $                   RANKINFO )
*
*  -- LAPACK test routine (version 3.1) --
*     Craig Lucas, University of Manchester / NAG Ltd.
*     October, 2008
*
*     .. Scalar Arguments ..
      REAL               COND
      INTEGER            IDISTINFOIRSIGNMODENRANK
*     ..
*     .. Array Arguments ..
      REAL               D* )
      INTEGER            ISEED4 )
*     ..
*
*  Purpose
*  =======
*
*     SLATM7 computes the entries of D as specified by MODE
*     COND and IRSIGN. IDIST and ISEED determine the generation
*     of random numbers. SLATM7 is called by SLATMT to generate
*     random test matrices.
*
*  Arguments
*  =========
*
*  MODE   - INTEGER
*           On entry describes how D is to be computed:
*           MODE = 0 means do not change D.
*
*           MODE = 1 sets D(1)=1 and D(2:RANK)=1.0/COND
*           MODE = 2 sets D(1:RANK-1)=1 and D(RANK)=1.0/COND
*           MODE = 3 sets D(I)=COND**(-(I-1)/(RANK-1)) I=1:RANK
*
*           MODE = 4 sets D(i)=1 - (i-1)/(N-1)*(1 - 1/COND)
*           MODE = 5 sets D to random numbers in the range
*                    ( 1/COND , 1 ) such that their logarithms
*                    are uniformly distributed.
*           MODE = 6 set D to random numbers from same distribution
*                    as the rest of the matrix.
*           MODE < 0 has the same meaning as ABS(MODE), except that
*              the order of the elements of D is reversed.
*           Thus if MODE is positive, D has entries ranging from
*              1 to 1/COND, if negative, from 1/COND to 1,
*           Not modified.
*
*  COND   - REAL
*           On entry, used as described under MODE above.
*           If used, it must be >= 1. Not modified.
*
*  IRSIGN - INTEGER
*           On entry, if MODE neither -6, 0 nor 6, determines sign of
*           entries of D
*           0 => leave entries of D unchanged
*           1 => multiply each entry of D by 1 or -1 with probability .5
*
*  IDIST  - CHARACTER*1
*           On entry, IDIST specifies the type of distribution to be
*           used to generate a random matrix .
*           1 => UNIFORM( 0, 1 )
*           2 => UNIFORM( -1, 1 )
*           3 => NORMAL( 0, 1 )
*           Not modified.
*
*  ISEED  - INTEGER array, dimension ( 4 )
*           On entry ISEED specifies the seed of the random number
*           generator. The random number generator uses a
*           linear congruential sequence limited to small
*           integers, and so should produce machine independent
*           random numbers. The values of ISEED are changed on
*           exit, and can be used in the next call to SLATM7
*           to continue the same random number sequence.
*           Changed on exit.
*
*  D      - REAL array, dimension ( MIN( M , N ) )
*           Array to be computed according to MODE, COND and IRSIGN.
*           May be changed on exit if MODE is nonzero.
*
*  N      - INTEGER
*           Number of entries of D. Not modified.
*
*  RANK   - INTEGER
*           The rank of matrix to be generated for modes 1,2,3 only.
*           D( RANK+1:N ) = 0.
*           Not modified.
*
*  INFO   - INTEGER
*            0  => normal termination
*           -1  => if MODE not in range -6 to 6
*           -2  => if MODE neither -6, 0 nor 6, and
*                  IRSIGN neither 0 nor 1
*           -3  => if MODE neither -6, 0 nor 6 and COND less than 1
*           -4  => if MODE equals 6 or -6 and IDIST not in range 1 to 3
*           -7  => if N negative
*
*  =====================================================================
*
*     .. Parameters ..
      REAL               ONE
      PARAMETER          ( ONE = 1.0E0 )
      REAL               ZERO
      PARAMETER          ( ZERO = 0.0E0 )
      REAL               HALF
      PARAMETER          ( HALF = 0.5E0 )
*     ..
*     .. Local Scalars ..
      REAL               ALPHATEMP
      INTEGER            I
*     ..
*     .. External Functions ..
      REAL               SLARAN
      EXTERNAL           SLARAN
*     ..
*     .. External Subroutines ..
      EXTERNAL           SLARNVXERBLA
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          ABSEXPLOGREAL
*     ..
*     .. Executable Statements ..
*
*     Decode and Test the input parameters. Initialize flags & seed.
*
      INFO = 0
*
*     Quick return if possible
*
      IFN.EQ.0 )
     $   RETURN
*
*     Set INFO if an error
*
      IFMODE.LT.-6 .OR. MODE.GT.6 ) THEN
         INFO = -1
      ELSE IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND.
     $         ( IRSIGN.NE.0 .AND. IRSIGN.NE.1 ) ) THEN
         INFO = -2
      ELSE IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND.
     $         COND.LT.ONE ) THEN
         INFO = -3
      ELSE IF( ( MODE.EQ.6 .OR. MODE.EQ.-6 ) .AND.
     $         ( IDIST.LT.1 .OR. IDIST.GT.3 ) ) THEN
         INFO = -4
      ELSE IFN.LT.0 ) THEN
         INFO = -7
      END IF
*
      IFINFO.NE.0 ) THEN
         CALL XERBLA'SLATM7'-INFO )
         RETURN
      END IF
*
*     Compute D according to COND and MODE
*
      IFMODE.NE.0 ) THEN
         GO TO ( 100130160190210230 )ABSMODE )
*
*        One large D value:
*
  100    CONTINUE
         DO 110 I = 2RANK
            DI ) = ONE / COND
  110    CONTINUE
         DO 120 I = RANK + 1N
            DI ) = ZERO
  120    CONTINUE
         D1 ) = ONE
         GO TO 240
*
*        One small D value:
*
  130    CONTINUE
         DO 140 I = 1RANK - 1
            DI ) = ONE
  140    CONTINUE
         DO 150 I = RANK + 1N
            DI ) = ZERO
  150    CONTINUE
         DRANK ) = ONE / COND
         GO TO 240
*
*        Exponentially distributed D values:
*
  160    CONTINUE
         D1 ) = ONE
         IFN.GT.1 ) THEN
            ALPHA = COND**( -ONE / REALRANK-1 ) )
            DO 170 I = 2RANK
               DI ) = ALPHA**( I-1 )
  170       CONTINUE
            DO 180 I = RANK + 1N
               DI ) = ZERO
  180       CONTINUE
         END IF
         GO TO 240
*
*        Arithmetically distributed D values:
*
  190    CONTINUE
         D1 ) = ONE
         IFN.GT.1 ) THEN
            TEMP = ONE / COND
            ALPHA = ( ONE-TEMP ) / REALN-1 )
            DO 200 I = 2N
               DI ) = REALN-I )*ALPHA + TEMP
  200       CONTINUE
         END IF
         GO TO 240
*
*        Randomly distributed D values on ( 1/COND , 1):
*
  210    CONTINUE
         ALPHA = LOGONE / COND )
         DO 220 I = 1N
            DI ) = EXPALPHA*SLARANISEED ) )
  220    CONTINUE
         GO TO 240
*
*        Randomly distributed D values from IDIST
*
  230    CONTINUE
         CALL SLARNVIDISTISEEDND )
*
  240    CONTINUE
*
*        If MODE neither -6 nor 0 nor 6, and IRSIGN = 1, assign
*        random signs to D
*
         IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND.
     $       IRSIGN.EQ.1 ) THEN
            DO 250 I = 1N
               TEMP = SLARANISEED )
               IFTEMP.GT.HALF )
     $            DI ) = -DI )
  250       CONTINUE
         END IF
*
*        Reverse if MODE < 0
*
         IFMODE.LT.0 ) THEN
            DO 260 I = 1N / 2
               TEMP = DI )
               DI ) = DN+1-I )
               DN+1-I ) = TEMP
  260       CONTINUE
         END IF
*
      END IF
*
      RETURN
*
*     End of SLATM7
*
      END