dlatm3.f

Go to the documentation of this file.

      DOUBLE PRECISION FUNCTION dlatm3( M, N, I, J, ISUB, JSUB, KL, KU,
     $                 idist, iseed, d, igrade, dl, dr, ipvtng, iwork,
     $                 sparse )
*
*  -- LAPACK auxiliary test routine (version 3.1) --
*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
*     June 2010
*
*     .. Scalar Arguments ..
*
      INTEGER            i, idist, igrade, ipvtng, isub, j, jsub, kl,
     $                   ku, m, n
      DOUBLE PRECISION   sparse
*     ..
*
*     .. Array Arguments ..
*
      INTEGER            iseed( 4 ), iwork( * )
      DOUBLE PRECISION   d( * ), dl( * ), dr( * )
*     ..
*
*  Purpose
*  =======
*
*     DLATM3 returns the (ISUB,JSUB) entry of a random matrix of
*     dimension (M, N) described by the other paramters. (ISUB,JSUB)
*     is the final position of the (I,J) entry after pivoting
*     according to IPVTNG and IWORK. DLATM3 is called by the
*     DLATMR routine in order to build random test matrices. No error
*     checking on parameters is done, because this routine is called in
*     a tight loop by DLATMR which has already checked the parameters.
*
*     Use of DLATM3 differs from SLATM2 in the order in which the random
*     number generator is called to fill in random matrix entries.
*     With DLATM2, the generator is called to fill in the pivoted matrix
*     columnwise. With DLATM3, the generator is called to fill in the
*     matrix columnwise, after which it is pivoted. Thus, DLATM3 can
*     be used to construct random matrices which differ only in their
*     order of rows and/or columns. DLATM2 is used to construct band
*     matrices while avoiding calling the random number generator for
*     entries outside the band (and therefore generating random numbers
*     in different orders for different pivot orders).
*
*     The matrix whose (ISUB,JSUB) entry is returned is constructed as
*     follows (this routine only computes one entry):
*
*       If ISUB is outside (1..M) or JSUB is outside (1..N), return zero
*          (this is convenient for generating matrices in band format).
*
*       Generate a matrix A with random entries of distribution IDIST.
*
*       Set the diagonal to D.
*
*       Grade the matrix, if desired, from the left (by DL) and/or
*          from the right (by DR or DL) as specified by IGRADE.
*
*       Permute, if desired, the rows and/or columns as specified by
*          IPVTNG and IWORK.
*
*       Band the matrix to have lower bandwidth KL and upper
*          bandwidth KU.
*
*       Set random entries to zero as specified by SPARSE.
*
*  Arguments
*  =========
*
*  M        (input) INTEGER
*           Number of rows of matrix. Not modified.
*
*  N        (input) INTEGER
*           Number of columns of matrix. Not modified.
*
*  I       (input) INTEGER
*           Row of unpivoted entry to be returned. Not modified.
*
*  J        (input) INTEGER
*           Column of unpivoted entry to be returned. Not modified.
*
*  ISUB    (input/output) INTEGER
*           Row of pivoted entry to be returned. Changed on exit.
*
*  JSUB     (input/output) INTEGER
*           Column of pivoted entry to be returned. Changed on exit.
*
*  KL       (input) INTEGER
*           Lower bandwidth. Not modified.
*
*  KU       (input) INTEGER
*           Upper bandwidth. Not modified.
*
*  IDIST    (input) INTEGER
*           On entry, IDIST specifies the type of distribution to be
*           used to generate a random matrix .
*           1 => UNIFORM( 0, 1 )
*           2 => UNIFORM( -1, 1 )
*           3 => NORMAL( 0, 1 )
*           Not modified.
*
*  ISEED    (input/output) INTEGER array of dimension ( 4 )
*           Seed for random number generator.
*           Changed on exit.
*
*  D        (input) DOUBLE PRECISION array of dimension ( MIN( I , J ) )
*           Diagonal entries of matrix. Not modified.
*
*  IGRADE   (input) INTEGER
*           Specifies grading of matrix as follows:
*           0  => no grading
*           1  => matrix premultiplied by diag( DL )
*           2  => matrix postmultiplied by diag( DR )
*           3  => matrix premultiplied by diag( DL ) and
*                         postmultiplied by diag( DR )
*           4  => matrix premultiplied by diag( DL ) and
*                         postmultiplied by inv( diag( DL ) )
*           5  => matrix premultiplied by diag( DL ) and
*                         postmultiplied by diag( DL )
*           Not modified.
*
*  DL       (input) DOUBLE PRECISION array ( I or J, as appropriate )
*           Left scale factors for grading matrix.  Not modified.
*
*  DR       (input) DOUBLE PRECISION array ( I or J, as appropriate )
*           Right scale factors for grading matrix.  Not modified.
*
*  IPVTNG   (input) INTEGER
*           On entry specifies pivoting permutations as follows:
*           0 => none.
*           1 => row pivoting.
*           2 => column pivoting.
*           3 => full pivoting, i.e., on both sides.
*           Not modified.
*
*  IWORK    (input) INTEGER array ( I or J, as appropriate )
*           This array specifies the permutation used. The
*           row (or column) originally in position K is in
*           position IWORK( K ) after pivoting.
*           This differs from IWORK for DLATM2. Not modified.
*
*  SPARSE   (input) DOUBLE PRECISION between 0. and 1.
*           On entry specifies the sparsity of the matrix
*           if sparse matix is to be generated.
*           SPARSE should lie between 0 and 1.
*           A uniform ( 0, 1 ) random number x is generated and
*           compared to SPARSE; if x is larger the matrix entry
*           is unchanged and if x is smaller the entry is set
*           to zero. Thus on the average a fraction SPARSE of the
*           entries will be set to zero.
*           Not modified.
*
*  =====================================================================
*
*     .. Parameters ..
*
      DOUBLE PRECISION   zero
      parameter( zero = 0.0d0 )
*     ..
*
*     .. Local Scalars ..
*
      DOUBLE PRECISION   temp
*     ..
*
*     .. External Functions ..
*
      DOUBLE PRECISION   dlaran, dlarnd
      EXTERNAL           dlaran, dlarnd
*     ..
*
*-----------------------------------------------------------------------
*
*     .. Executable Statements ..
*
*
*     Check for I and J in range
*
      IF( i.LT.1 .OR. i.GT.m .OR. j.LT.1 .OR. j.GT.n ) THEN
         isub = i
         jsub = j
         dlatm3 = zero
         return
      END IF
*
*     Compute subscripts depending on IPVTNG
*
      IF( ipvtng.EQ.0 ) THEN
         isub = i
         jsub = j
      ELSE IF( ipvtng.EQ.1 ) THEN
         isub = iwork( i )
         jsub = j
      ELSE IF( ipvtng.EQ.2 ) THEN
         isub = i
         jsub = iwork( j )
      ELSE IF( ipvtng.EQ.3 ) THEN
         isub = iwork( i )
         jsub = iwork( j )
      END IF
*
*     Check for banding
*
      IF( jsub.GT.isub+ku .OR. jsub.LT.isub-kl ) THEN
         dlatm3 = zero
         return
      END IF
*
*     Check for sparsity
*
      IF( sparse.GT.zero ) THEN
         IF( dlaran( iseed ).LT.sparse ) THEN
            dlatm3 = zero
            return
         END IF
      END IF
*
*     Compute entry and grade it according to IGRADE
*
      IF( i.EQ.j ) THEN
         temp = d( i )
      ELSE
         temp = dlarnd( idist, iseed )
      END IF
      IF( igrade.EQ.1 ) THEN
         temp = temp*dl( i )
      ELSE IF( igrade.EQ.2 ) THEN
         temp = temp*dr( j )
      ELSE IF( igrade.EQ.3 ) THEN
         temp = temp*dl( i )*dr( j )
      ELSE IF( igrade.EQ.4 .AND. i.NE.j ) THEN
         temp = temp*dl( i ) / dl( j )
      ELSE IF( igrade.EQ.5 ) THEN
         temp = temp*dl( i )*dl( j )
      END IF
      dlatm3 = temp
      return
*
*     End of DLATM3
*
      END