|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
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
1.7.3 
