LAPACK: TESTING/MATGEN/slatm7.f Source File

Go to the documentation of this file.
00001       SUBROUTINE SLATM7( MODE, COND, IRSIGN, IDIST, ISEED, D, N,
00002      $                   RANK, INFO )
00003 *
00004 *  -- LAPACK test routine (version 3.1) --
00005 *     Craig Lucas, University of Manchester / NAG Ltd.
00006 *     October, 2008
00007 *
00008 *     .. Scalar Arguments ..
00009       REAL               COND
00010       INTEGER            IDIST, INFO, IRSIGN, MODE, N, RANK
00011 *     ..
00012 *     .. Array Arguments ..
00013       REAL               D( * )
00014       INTEGER            ISEED( 4 )
00015 *     ..
00016 *
00017 *  Purpose
00018 *  =======
00019 *
00020 *     SLATM7 computes the entries of D as specified by MODE
00021 *     COND and IRSIGN. IDIST and ISEED determine the generation
00022 *     of random numbers. SLATM7 is called by SLATMT to generate
00023 *     random test matrices.
00024 *
00025 *  Arguments
00026 *  =========
00027 *
00028 *  MODE   - INTEGER
00029 *           On entry describes how D is to be computed:
00030 *           MODE = 0 means do not change D.
00031 *
00032 *           MODE = 1 sets D(1)=1 and D(2:RANK)=1.0/COND
00033 *           MODE = 2 sets D(1:RANK-1)=1 and D(RANK)=1.0/COND
00034 *           MODE = 3 sets D(I)=COND**(-(I-1)/(RANK-1)) I=1:RANK
00035 *
00036 *           MODE = 4 sets D(i)=1 - (i-1)/(N-1)*(1 - 1/COND)
00037 *           MODE = 5 sets D to random numbers in the range
00038 *                    ( 1/COND , 1 ) such that their logarithms
00039 *                    are uniformly distributed.
00040 *           MODE = 6 set D to random numbers from same distribution
00041 *                    as the rest of the matrix.
00042 *           MODE < 0 has the same meaning as ABS(MODE), except that
00043 *              the order of the elements of D is reversed.
00044 *           Thus if MODE is positive, D has entries ranging from
00045 *              1 to 1/COND, if negative, from 1/COND to 1,
00046 *           Not modified.
00047 *
00048 *  COND   - REAL
00049 *           On entry, used as described under MODE above.
00050 *           If used, it must be >= 1. Not modified.
00051 *
00052 *  IRSIGN - INTEGER
00053 *           On entry, if MODE neither -6, 0 nor 6, determines sign of
00054 *           entries of D
00055 *           0 => leave entries of D unchanged
00056 *           1 => multiply each entry of D by 1 or -1 with probability .5
00057 *
00058 *  IDIST  - CHARACTER*1
00059 *           On entry, IDIST specifies the type of distribution to be
00060 *           used to generate a random matrix .
00061 *           1 => UNIFORM( 0, 1 )
00062 *           2 => UNIFORM( -1, 1 )
00063 *           3 => NORMAL( 0, 1 )
00064 *           Not modified.
00065 *
00066 *  ISEED  - INTEGER array, dimension ( 4 )
00067 *           On entry ISEED specifies the seed of the random number
00068 *           generator. The random number generator uses a
00069 *           linear congruential sequence limited to small
00070 *           integers, and so should produce machine independent
00071 *           random numbers. The values of ISEED are changed on
00072 *           exit, and can be used in the next call to SLATM7
00073 *           to continue the same random number sequence.
00074 *           Changed on exit.
00075 *
00076 *  D      - REAL array, dimension ( MIN( M , N ) )
00077 *           Array to be computed according to MODE, COND and IRSIGN.
00078 *           May be changed on exit if MODE is nonzero.
00079 *
00080 *  N      - INTEGER
00081 *           Number of entries of D. Not modified.
00082 *
00083 *  RANK   - INTEGER
00084 *           The rank of matrix to be generated for modes 1,2,3 only.
00085 *           D( RANK+1:N ) = 0.
00086 *           Not modified.
00087 *
00088 *  INFO   - INTEGER
00089 *            0  => normal termination
00090 *           -1  => if MODE not in range -6 to 6
00091 *           -2  => if MODE neither -6, 0 nor 6, and
00092 *                  IRSIGN neither 0 nor 1
00093 *           -3  => if MODE neither -6, 0 nor 6 and COND less than 1
00094 *           -4  => if MODE equals 6 or -6 and IDIST not in range 1 to 3
00095 *           -7  => if N negative
00096 *
00097 *  =====================================================================
00098 *
00099 *     .. Parameters ..
00100       REAL               ONE
00101       PARAMETER          ( ONE = 1.0E0 )
00102       REAL               ZERO
00103       PARAMETER          ( ZERO = 0.0E0 )
00104       REAL               HALF
00105       PARAMETER          ( HALF = 0.5E0 )
00106 *     ..
00107 *     .. Local Scalars ..
00108       REAL               ALPHA, TEMP
00109       INTEGER            I
00110 *     ..
00111 *     .. External Functions ..
00112       REAL               SLARAN
00113       EXTERNAL           SLARAN
00114 *     ..
00115 *     .. External Subroutines ..
00116       EXTERNAL           SLARNV, XERBLA
00117 *     ..
00118 *     .. Intrinsic Functions ..
00119       INTRINSIC          ABS, EXP, LOG, REAL
00120 *     ..
00121 *     .. Executable Statements ..
00122 *
00123 *     Decode and Test the input parameters. Initialize flags & seed.
00124 *
00125       INFO = 0
00126 *
00127 *     Quick return if possible
00128 *
00129       IF( N.EQ.0 )
00130      $   RETURN
00131 *
00132 *     Set INFO if an error
00133 *
00134       IF( MODE.LT.-6 .OR. MODE.GT.6 ) THEN
00135          INFO = -1
00136       ELSE IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND.
00137      $         ( IRSIGN.NE.0 .AND. IRSIGN.NE.1 ) ) THEN
00138          INFO = -2
00139       ELSE IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND.
00140      $         COND.LT.ONE ) THEN
00141          INFO = -3
00142       ELSE IF( ( MODE.EQ.6 .OR. MODE.EQ.-6 ) .AND.
00143      $         ( IDIST.LT.1 .OR. IDIST.GT.3 ) ) THEN
00144          INFO = -4
00145       ELSE IF( N.LT.0 ) THEN
00146          INFO = -7
00147       END IF
00148 *
00149       IF( INFO.NE.0 ) THEN
00150          CALL XERBLA( 'SLATM7', -INFO )
00151          RETURN
00152       END IF
00153 *
00154 *     Compute D according to COND and MODE
00155 *
00156       IF( MODE.NE.0 ) THEN
00157          GO TO ( 100, 130, 160, 190, 210, 230 )ABS( MODE )
00158 *
00159 *        One large D value:
00160 *
00161   100    CONTINUE
00162          DO 110 I = 2, RANK
00163             D( I ) = ONE / COND
00164   110    CONTINUE
00165          DO 120 I = RANK + 1, N
00166             D( I ) = ZERO
00167   120    CONTINUE
00168          D( 1 ) = ONE
00169          GO TO 240
00170 *
00171 *        One small D value:
00172 *
00173   130    CONTINUE
00174          DO 140 I = 1, RANK - 1
00175             D( I ) = ONE
00176   140    CONTINUE
00177          DO 150 I = RANK + 1, N
00178             D( I ) = ZERO
00179   150    CONTINUE
00180          D( RANK ) = ONE / COND
00181          GO TO 240
00182 *
00183 *        Exponentially distributed D values:
00184 *
00185   160    CONTINUE
00186          D( 1 ) = ONE
00187          IF( N.GT.1 ) THEN
00188             ALPHA = COND**( -ONE / REAL( RANK-1 ) )
00189             DO 170 I = 2, RANK
00190                D( I ) = ALPHA**( I-1 )
00191   170       CONTINUE
00192             DO 180 I = RANK + 1, N
00193                D( I ) = ZERO
00194   180       CONTINUE
00195          END IF
00196          GO TO 240
00197 *
00198 *        Arithmetically distributed D values:
00199 *
00200   190    CONTINUE
00201          D( 1 ) = ONE
00202          IF( N.GT.1 ) THEN
00203             TEMP = ONE / COND
00204             ALPHA = ( ONE-TEMP ) / REAL( N-1 )
00205             DO 200 I = 2, N
00206                D( I ) = REAL( N-I )*ALPHA + TEMP
00207   200       CONTINUE
00208          END IF
00209          GO TO 240
00210 *
00211 *        Randomly distributed D values on ( 1/COND , 1):
00212 *
00213   210    CONTINUE
00214          ALPHA = LOG( ONE / COND )
00215          DO 220 I = 1, N
00216             D( I ) = EXP( ALPHA*SLARAN( ISEED ) )
00217   220    CONTINUE
00218          GO TO 240
00219 *
00220 *        Randomly distributed D values from IDIST
00221 *
00222   230    CONTINUE
00223          CALL SLARNV( IDIST, ISEED, N, D )
00224 *
00225   240    CONTINUE
00226 *
00227 *        If MODE neither -6 nor 0 nor 6, and IRSIGN = 1, assign
00228 *        random signs to D
00229 *
00230          IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND.
00231      $       IRSIGN.EQ.1 ) THEN
00232             DO 250 I = 1, N
00233                TEMP = SLARAN( ISEED )
00234                IF( TEMP.GT.HALF )
00235      $            D( I ) = -D( I )
00236   250       CONTINUE
00237          END IF
00238 *
00239 *        Reverse if MODE < 0
00240 *
00241          IF( MODE.LT.0 ) THEN
00242             DO 260 I = 1, N / 2
00243                TEMP = D( I )
00244                D( I ) = D( N+1-I )
00245                D( N+1-I ) = TEMP
00246   260       CONTINUE
00247          END IF
00248 *
00249       END IF
00250 *
00251       RETURN
00252 *
00253 *     End of SLATM7
00254 *
00255       END