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