1       SUBROUTINE SLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, N, INFO )
  2 *
  3 *  -- LAPACK auxiliary test routine (version 3.1) --
  4 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
  5 *     June 2010
  6 *
  7 *     .. Scalar Arguments ..
  8       INTEGER            IDIST, INFO, IRSIGN, MODE, N
  9       REAL               COND
 10 *     ..
 11 *     .. Array Arguments ..
 12       INTEGER            ISEED( 4 )
 13       REAL               D( * )
 14 *     ..
 15 *
 16 *  Purpose
 17 *  =======
 18 *
 19 *     SLATM1 computes the entries of D(1..N) as specified by
 20 *     MODE, COND and IRSIGN. IDIST and ISEED determine the generation
 21 *     of random numbers. SLATM1 is called by SLATMR to generate
 22 *     random test matrices for LAPACK programs.
 23 *
 24 *  Arguments
 25 *  =========
 26 *
 27 *  MODE     (input) INTEGER
 28 *           On entry describes how D is to be computed:
 29 *           MODE = 0 means do not change D.
 30 *           MODE = 1 sets D(1)=1 and D(2:N)=1.0/COND
 31 *           MODE = 2 sets D(1:N-1)=1 and D(N)=1.0/COND
 32 *           MODE = 3 sets D(I)=COND**(-(I-1)/(N-1))
 33 *           MODE = 4 sets D(i)=1 - (i-1)/(N-1)*(1 - 1/COND)
 34 *           MODE = 5 sets D to random numbers in the range
 35 *                    ( 1/COND , 1 ) such that their logarithms
 36 *                    are uniformly distributed.
 37 *           MODE = 6 set D to random numbers from same distribution
 38 *                    as the rest of the matrix.
 39 *           MODE < 0 has the same meaning as ABS(MODE), except that
 40 *              the order of the elements of D is reversed.
 41 *           Thus if MODE is positive, D has entries ranging from
 42 *              1 to 1/COND, if negative, from 1/COND to 1,
 43 *           Not modified.
 44 *
 45 *  COND     (input) REAL
 46 *           On entry, used as described under MODE above.
 47 *           If used, it must be >= 1. Not modified.
 48 *
 49 *  IRSIGN   (input) INTEGER
 50 *           On entry, if MODE neither -6, 0 nor 6, determines sign of
 51 *           entries of D
 52 *           0 => leave entries of D unchanged
 53 *           1 => multiply each entry of D by 1 or -1 with probability .5
 54 *
 55 *  IDIST    (input) CHARACTER*1
 56 *           On entry, IDIST specifies the type of distribution to be
 57 *           used to generate a random matrix .
 58 *           1 => UNIFORM( 0, 1 )
 59 *           2 => UNIFORM( -1, 1 )
 60 *           3 => NORMAL( 0, 1 )
 61 *           Not modified.
 62 *
 63 *  ISEED    (input/output) INTEGER array, dimension ( 4 )
 64 *           On entry ISEED specifies the seed of the random number
 65 *           generator. The random number generator uses a
 66 *           linear congruential sequence limited to small
 67 *           integers, and so should produce machine independent
 68 *           random numbers. The values of ISEED are changed on
 69 *           exit, and can be used in the next call to SLATM1
 70 *           to continue the same random number sequence.
 71 *           Changed on exit.
 72 *
 73 *  D        (input/output) REAL array, dimension ( MIN( M , N ) )
 74 *           Array to be computed according to MODE, COND and IRSIGN.
 75 *           May be changed on exit if MODE is nonzero.
 76 *
 77 *  N        (input) INTEGER
 78 *           Number of entries of D. Not modified.
 79 *
 80 *  INFO     (output) INTEGER
 81 *            0  => normal termination
 82 *           -1  => if MODE not in range -6 to 6
 83 *           -2  => if MODE neither -6, 0 nor 6, and
 84 *                  IRSIGN neither 0 nor 1
 85 *           -3  => if MODE neither -6, 0 nor 6 and COND less than 1
 86 *           -4  => if MODE equals 6 or -6 and IDIST not in range 1 to 3
 87 *           -7  => if N negative
 88 *
 89 *  =====================================================================
 90 *
 91 *     .. Parameters ..
 92       REAL               ONE
 93       PARAMETER          ( ONE = 1.0E0 )
 94       REAL               HALF
 95       PARAMETER          ( HALF = 0.5E0 )
 96 *     ..
 97 *     .. Local Scalars ..
 98       INTEGER            I
 99       REAL               ALPHA, TEMP
100 *     ..
101 *     .. External Functions ..
102       REAL               SLARAN
103       EXTERNAL           SLARAN
104 *     ..
105 *     .. External Subroutines ..
106       EXTERNAL           SLARNV, XERBLA
107 *     ..
108 *     .. Intrinsic Functions ..
109       INTRINSIC          ABSEXPLOG, REAL
110 *     ..
111 *     .. Executable Statements ..
112 *
113 *     Decode and Test the input parameters. Initialize flags & seed.
114 *
115       INFO = 0
116 *
117 *     Quick return if possible
118 *
119       IF( N.EQ.0 )
120      $   RETURN
121 *
122 *     Set INFO if an error
123 *
124       IF( MODE.LT.-6 .OR. MODE.GT.6 ) THEN
125          INFO = -1
126       ELSE IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND.
127      $         ( IRSIGN.NE.0 .AND. IRSIGN.NE.1 ) ) THEN
128          INFO = -2
129       ELSE IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND.
130      $         COND.LT.ONE ) THEN
131          INFO = -3
132       ELSE IF( ( MODE.EQ.6 .OR. MODE.EQ.-6 ) .AND.
133      $         ( IDIST.LT.1 .OR. IDIST.GT.3 ) ) THEN
134          INFO = -4
135       ELSE IF( N.LT.0 ) THEN
136          INFO = -7
137       END IF
138 *
139       IF( INFO.NE.0 ) THEN
140          CALL XERBLA( 'SLATM1'-INFO )
141          RETURN
142       END IF
143 *
144 *     Compute D according to COND and MODE
145 *
146       IF( MODE.NE.0 ) THEN
147          GO TO ( 1030507090110 )ABS( MODE )
148 *
149 *        One large D value:
150 *
151    10    CONTINUE
152          DO 20 I = 1, N
153             D( I ) = ONE / COND
154    20    CONTINUE
155          D( 1 ) = ONE
156          GO TO 120
157 *
158 *        One small D value:
159 *
160    30    CONTINUE
161          DO 40 I = 1, N
162             D( I ) = ONE
163    40    CONTINUE
164          D( N ) = ONE / COND
165          GO TO 120
166 *
167 *        Exponentially distributed D values:
168 *
169    50    CONTINUE
170          D( 1 ) = ONE
171          IF( N.GT.1 ) THEN
172             ALPHA = COND**-ONE / REAL( N-1 ) )
173             DO 60 I = 2, N
174                D( I ) = ALPHA**( I-1 )
175    60       CONTINUE
176          END IF
177          GO TO 120
178 *
179 *        Arithmetically distributed D values:
180 *
181    70    CONTINUE
182          D( 1 ) = ONE
183          IF( N.GT.1 ) THEN
184             TEMP = ONE / COND
185             ALPHA = ( ONE-TEMP ) / REAL( N-1 )
186             DO 80 I = 2, N
187                D( I ) = REAL( N-I )*ALPHA + TEMP
188    80       CONTINUE
189          END IF
190          GO TO 120
191 *
192 *        Randomly distributed D values on ( 1/COND , 1):
193 *
194    90    CONTINUE
195          ALPHA = LOG( ONE / COND )
196          DO 100 I = 1, N
197             D( I ) = EXP( ALPHA*SLARAN( ISEED ) )
198   100    CONTINUE
199          GO TO 120
200 *
201 *        Randomly distributed D values from IDIST
202 *
203   110    CONTINUE
204          CALL SLARNV( IDIST, ISEED, N, D )
205 *
206   120    CONTINUE
207 *
208 *        If MODE neither -6 nor 0 nor 6, and IRSIGN = 1, assign
209 *        random signs to D
210 *
211          IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND.
212      $       IRSIGN.EQ.1 ) THEN
213             DO 130 I = 1, N
214                TEMP = SLARAN( ISEED )
215                IF( TEMP.GT.HALF )
216      $            D( I ) = -D( I )
217   130       CONTINUE
218          END IF
219 *
220 *        Reverse if MODE < 0
221 *
222          IF( MODE.LT.0 ) THEN
223             DO 140 I = 1, N / 2
224                TEMP = D( I )
225                D( I ) = D( N+1-I )
226                D( N+1-I ) = TEMP
227   140       CONTINUE
228          END IF
229 *
230       END IF
231 *
232       RETURN
233 *
234 *     End of SLATM1
235 *
236       END