LAPACK 3.3.0

slatm1.f

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