d8/d6d/clatm2_8f_source.html

00001       COMPLEX FUNCTION CLATM2( M, N, I, J, KL, KU, IDIST, ISEED, D,
00002      $                         IGRADE, DL, DR, IPVTNG, IWORK, SPARSE )
00003 *
00004 *  -- LAPACK auxiliary test routine (version 3.1) --
00005 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
00006 *     June 2010
00007 *
00008 *     .. Scalar Arguments ..
00009 *
00010       INTEGER            I, IDIST, IGRADE, IPVTNG, J, KL, KU, M, N
00011       REAL               SPARSE
00012 *     ..
00013 *
00014 *     .. Array Arguments ..
00015 *
00016       INTEGER            ISEED( 4 ), IWORK( * )
00017       COMPLEX            D( * ), DL( * ), DR( * )
00018 *     ..
00019 *
00020 *  Purpose
00021 *  =======
00022 *
00023 *     CLATM2 returns the (I,J) entry of a random matrix of dimension
00024 *     (M, N) described by the other paramters. It is called by the
00025 *     CLATMR routine in order to build random test matrices. No error
00026 *     checking on parameters is done, because this routine is called in
00027 *     a tight loop by CLATMR which has already checked the parameters.
00028 *
00029 *     Use of CLATM2 differs from CLATM3 in the order in which the random
00030 *     number generator is called to fill in random matrix entries.
00031 *     With CLATM2, the generator is called to fill in the pivoted matrix
00032 *     columnwise. With CLATM3, the generator is called to fill in the
00033 *     matrix columnwise, after which it is pivoted. Thus, CLATM3 can
00034 *     be used to construct random matrices which differ only in their
00035 *     order of rows and/or columns. CLATM2 is used to construct band
00036 *     matrices while avoiding calling the random number generator for
00037 *     entries outside the band (and therefore generating random numbers
00038 *
00039 *     The matrix whose (I,J) entry is returned is constructed as
00040 *     follows (this routine only computes one entry):
00041 *
00042 *       If I is outside (1..M) or J is outside (1..N), return zero
00043 *          (this is convenient for generating matrices in band format).
00044 *
00045 *       Generate a matrix A with random entries of distribution IDIST.
00046 *
00047 *       Set the diagonal to D.
00048 *
00049 *       Grade the matrix, if desired, from the left (by DL) and/or
00050 *          from the right (by DR or DL) as specified by IGRADE.
00051 *
00052 *       Permute, if desired, the rows and/or columns as specified by
00053 *          IPVTNG and IWORK.
00054 *
00055 *       Band the matrix to have lower bandwidth KL and upper
00056 *          bandwidth KU.
00057 *
00058 *       Set random entries to zero as specified by SPARSE.
00059 *
00060 *  Arguments
00061 *  =========
00062 *
00063 *  M        (input) INTEGER
00064 *           Number of rows of matrix. Not modified.
00065 *
00066 *  N        (input) INTEGER
00067 *           Number of columns of matrix. Not modified.
00068 *
00069 *  I        (input) INTEGER
00070 *           Row of entry to be returned. Not modified.
00071 *
00072 *  J        (input) INTEGER
00073 *           Column of entry to be returned. Not modified.
00074 *
00075 *  KL       (input) INTEGER
00076 *           Lower bandwidth. Not modified.
00077 *
00078 *  KU       (input) INTEGER
00079 *           Upper bandwidth. Not modified.
00080 *
00081 *  IDIST    (input) INTEGER
00082 *           On entry, IDIST specifies the type of distribution to be
00083 *           used to generate a random matrix .
00084 *           1 => real and imaginary parts each UNIFORM( 0, 1 )
00085 *           2 => real and imaginary parts each UNIFORM( -1, 1 )
00086 *           3 => real and imaginary parts each NORMAL( 0, 1 )
00087 *           4 => complex number uniform in DISK( 0 , 1 )
00088 *           Not modified.
00089 *
00090 *  ISEED    (input/output) INTEGER array of dimension ( 4 )
00091 *           Seed for random number generator.
00092 *           Changed on exit.
00093 *
00094 *  D        (input) COMPLEX array of dimension ( MIN( I , J ) )
00095 *           Diagonal entries of matrix. Not modified.
00096 *
00097 *  IGRADE   (input) INTEGER
00098 *           Specifies grading of matrix as follows:
00099 *           0  => no grading
00100 *           1  => matrix premultiplied by diag( DL )
00101 *           2  => matrix postmultiplied by diag( DR )
00102 *           3  => matrix premultiplied by diag( DL ) and
00103 *                         postmultiplied by diag( DR )
00104 *           4  => matrix premultiplied by diag( DL ) and
00105 *                         postmultiplied by inv( diag( DL ) )
00106 *           5  => matrix premultiplied by diag( DL ) and
00107 *                         postmultiplied by diag( CONJG(DL) )
00108 *           6  => matrix premultiplied by diag( DL ) and
00109 *                         postmultiplied by diag( DL )
00110 *           Not modified.
00111 *
00112 *  DL       (input) COMPLEX array ( I or J, as appropriate )
00113 *           Left scale factors for grading matrix.  Not modified.
00114 *
00115 *  DR       (input) COMPLEX array ( I or J, as appropriate )
00116 *           Right scale factors for grading matrix.  Not modified.
00117 *
00118 *  IPVTNG   (input) INTEGER
00119 *           On entry specifies pivoting permutations as follows:
00120 *           0 => none.
00121 *           1 => row pivoting.
00122 *           2 => column pivoting.
00123 *           3 => full pivoting, i.e., on both sides.
00124 *           Not modified.
00125 *
00126 *  IWORK    (workspace) INTEGER array ( I or J, as appropriate )
00127 *           This array specifies the permutation used. The
00128 *           row (or column) in position K was originally in
00129 *           position IWORK( K ).
00130 *           This differs from IWORK for CLATM3. Not modified.
00131 *
00132 *  SPARSE   (input) REAL
00133 *           Value between 0. and 1.
00134 *           On entry specifies the sparsity of the matrix
00135 *           if sparse matix is to be generated.
00136 *           SPARSE should lie between 0 and 1.
00137 *           A uniform ( 0, 1 ) random number x is generated and
00138 *           compared to SPARSE; if x is larger the matrix entry
00139 *           is unchanged and if x is smaller the entry is set
00140 *           to zero. Thus on the average a fraction SPARSE of the
00141 *           entries will be set to zero.
00142 *           Not modified.
00143 *
00144 *  =====================================================================
00145 *
00146 *     .. Parameters ..
00147 *
00148       COMPLEX            CZERO
00149       PARAMETER          ( CZERO = ( 0.0E0, 0.0E0 ) )
00150       REAL               ZERO
00151       PARAMETER          ( ZERO = 0.0E0 )
00152 *     ..
00153 *
00154 *     .. Local Scalars ..
00155 *
00156       INTEGER            ISUB, JSUB
00157       COMPLEX            CTEMP
00158 *     ..
00159 *
00160 *     .. External Functions ..
00161 *
00162       REAL               SLARAN
00163       COMPLEX            CLARND
00164       EXTERNAL           SLARAN, CLARND
00165 *     ..
00166 *
00167 *     .. Intrinsic Functions ..
00168 *
00169       INTRINSIC          CONJG
00170 *     ..
00171 *
00172 *-----------------------------------------------------------------------
00173 *
00174 *     .. Executable Statements ..
00175 *
00176 *
00177 *     Check for I and J in range
00178 *
00179       IF( I.LT.1 .OR. I.GT.M .OR. J.LT.1 .OR. J.GT.N ) THEN
00180          CLATM2 = CZERO
00181          RETURN
00182       END IF
00183 *
00184 *     Check for banding
00185 *
00186       IF( J.GT.I+KU .OR. J.LT.I-KL ) THEN
00187          CLATM2 = CZERO
00188          RETURN
00189       END IF
00190 *
00191 *     Check for sparsity
00192 *
00193       IF( SPARSE.GT.ZERO ) THEN
00194          IF( SLARAN( ISEED ).LT.SPARSE ) THEN
00195             CLATM2 = CZERO
00196             RETURN
00197          END IF
00198       END IF
00199 *
00200 *     Compute subscripts depending on IPVTNG
00201 *
00202       IF( IPVTNG.EQ.0 ) THEN
00203          ISUB = I
00204          JSUB = J
00205       ELSE IF( IPVTNG.EQ.1 ) THEN
00206          ISUB = IWORK( I )
00207          JSUB = J
00208       ELSE IF( IPVTNG.EQ.2 ) THEN
00209          ISUB = I
00210          JSUB = IWORK( J )
00211       ELSE IF( IPVTNG.EQ.3 ) THEN
00212          ISUB = IWORK( I )
00213          JSUB = IWORK( J )
00214       END IF
00215 *
00216 *     Compute entry and grade it according to IGRADE
00217 *
00218       IF( ISUB.EQ.JSUB ) THEN
00219          CTEMP = D( ISUB )
00220       ELSE
00221          CTEMP = CLARND( IDIST, ISEED )
00222       END IF
00223       IF( IGRADE.EQ.1 ) THEN
00224          CTEMP = CTEMP*DL( ISUB )
00225       ELSE IF( IGRADE.EQ.2 ) THEN
00226          CTEMP = CTEMP*DR( JSUB )
00227       ELSE IF( IGRADE.EQ.3 ) THEN
00228          CTEMP = CTEMP*DL( ISUB )*DR( JSUB )
00229       ELSE IF( IGRADE.EQ.4 .AND. ISUB.NE.JSUB ) THEN
00230          CTEMP = CTEMP*DL( ISUB ) / DL( JSUB )
00231       ELSE IF( IGRADE.EQ.5 ) THEN
00232          CTEMP = CTEMP*DL( ISUB )*CONJG( DL( JSUB ) )
00233       ELSE IF( IGRADE.EQ.6 ) THEN
00234          CTEMP = CTEMP*DL( ISUB )*DL( JSUB )
00235       END IF
00236       CLATM2 = CTEMP
00237       RETURN
00238 *
00239 *     End of CLATM2
00240 *
00241       END