de/dc4/clatm3_8f_source.html

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