pcbmatgen.f

Go to the documentation of this file.

      SUBROUTINE pcbmatgen( ICTXT, AFORM, AFORM2, BWL, BWU, N,
     $                     MB, NB, A,
     $                     LDA, IAROW, IACOL, ISEED,
     $                     MYROW, MYCOL, NPROW, NPCOL )
*
*
*
*  -- ScaLAPACK routine (version 1.7) --
*     University of Tennessee, Knoxville, Oak Ridge National Laboratory,
*     and University of California, Berkeley.
*     November 15, 1997
*
*     .. Scalar Arguments ..
*     .. Scalar Arguments ..
      CHARACTER*1        AFORM, AFORM2
      INTEGER            IACOL, IAROW, ICTXT,
     $                   ISEED, LDA, MB, MYCOL, MYROW, N,
     $                   nb, npcol, nprow, bwl, bwu
*     ..
*     .. Array Arguments ..
      COMPLEX            A( LDA, * )
*     ..
*
*  Purpose
*  =======
*
*  PCBMATGEN : Parallel Complex Single precision Band MATrix GENerator.
*  (Re)Generate a distributed Band matrix A (or sub-matrix of A).
*
*  Arguments
*  =========
*
*  ICTXT   (global input) INTEGER
*          The BLACS context handle, indicating the global context of
*          the operation. The context itself is global.
*
*  AFORM   (global input) CHARACTER*1
*          if AFORM = 'L' : A is returned as a hermitian lower
*            triangular matrix, and is diagonally dominant.
*          if AFORM = 'U' : A is returned as a hermitian upper
*            triangular matrix, and is diagonally dominant.
*          if AFORM = 'G' : A is returned as a general matrix.
*          if AFORM = 'T' : A is returned as a general matrix in
*            tridiagonal-compatible form.
*
*  AFORM2  (global input) CHARACTER*1
*          if the matrix is general:
*            if AFORM2 = 'D' : A is returned diagonally dominant.
*            if AFORM2 != 'D' : A is not returned diagonally dominant.
*          if the matrix is symmetric or hermitian:
*            if AFORM2 = 'T' : A is returned in tridiagonally-compatible
*              form (a transpose form).
*            if AFORM2 != 'T' : A is returned in banded-compatible form.
*
*  M       (global input) INTEGER
*          The number of nonzero rows in the generated distributed
*           band matrix.
*
*  N       (global input) INTEGER
*          The number of columns in the generated distributed
*          matrix.
*
*  MB      (global input) INTEGER
*          The row blocking factor of the distributed matrix A.
*
*  NB      (global input) INTEGER
*          The column blocking factor of the distributed matrix A.
*
*  A       (local output) COMPLEX, pointer into the local memory to
*          an array of dimension ( LDA, * ) containing the local
*          pieces of the distributed matrix.
*
*  LDA     (local input) INTEGER
*          The leading dimension of the array containing the local
*          pieces of the distributed matrix A.
*
*  IAROW   (global input) INTEGER
*          The row processor coordinate which holds the first block
*          of the distributed matrix A.
*            A( DIAG_INDEX, I ) = A( DIAG_INDEX, I ) + BWL+BWU
*
*  IACOL   (global input) INTEGER
*          The column processor coordinate which holds the first
*          block of the distributed matrix A.
*
*  ISEED   (global input) INTEGER
*          The seed number to generate the distributed matrix A.
*
*  MYROW   (local input) INTEGER
*          The row process coordinate of the calling process.
*
*  MYCOL   (local input) INTEGER
*          The column process coordinate of the calling process.
*
*  NPROW   (global input) INTEGER
*          The number of process rows in the grid.
*
*  NPCOL   (global input) INTEGER
*          The number of process columns in the grid.
*
*  Notes
*  =====
*
*  This code is a simple wrapper around PCMATGEN, for band matrices.
*
*  =====================================================================
*
*  Code Developer: Andrew J. Cleary, University of Tennessee.
*    Current address: Lawrence Livermore National Labs.
*  This version released: August, 2001.
*
*  =====================================================================
*
*     ..
*     .. Parameters ..
      REAL               ONE, ZERO
      PARAMETER          ( ONE = 1.0e+0 )
      parameter( zero = 0.0e+0 )
      COMPLEX            CONE, CZERO
      parameter( cone = ( 1.0e+0, 0.0e+0 ) )
      parameter( czero = ( 0.0e+0, 0.0e+0 ) )
*     ..
*     .. Local Scalars ..
      INTEGER           DIAG_INDEX, I, J, M_MATGEN, NQ, N_MATGEN,
     $                  START_INDEX
*     ..
*     .. External Subroutines ..
      EXTERNAL           pcmatgen
*     ..
*     .. External Functions ..
      LOGICAL            LSAME
      INTEGER            ICEIL, NUMROC
      EXTERNAL           ICEIL, NUMROC, LSAME
*     ..
*     .. Executable Statements ..
*
*
      IF( lsame( aform, 'L' ).OR.lsame( aform, 'U' ) ) THEN
         m_matgen = bwl + 1
         n_matgen = n
         start_index = 1
         IF( lsame( aform, 'L' ) ) THEN
            diag_index = 1
         ELSE
            diag_index = bwl + 1
         ENDIF
      ELSE
         m_matgen = bwl + bwu + 1
         n_matgen = n
         diag_index = bwu + 1
         start_index = 1
      ENDIF
*
      nq = numroc( n, nb, mycol, iacol, npcol )
*
*
*     Generate a random matrix initially
*
      IF( lsame( aform, 'T' ) .OR.
     $  ( lsame( aform2, 'T' ) ) ) THEN
*
          CALL pcmatgen( ictxt, 'T', 'N',
     $                        n_matgen, m_matgen,
     $                        nb, m_matgen, a( start_index, 1 ),
     $                        lda, iarow, iacol,
     $                        iseed, 0, nq, 0, m_matgen,
     $                        mycol, myrow, npcol, nprow )
*
      ELSE
*
          CALL pcmatgen( ictxt, 'N', 'N',
     $                        m_matgen, n_matgen,
     $                        m_matgen, nb, a( start_index, 1 ),
     $                        lda, iarow, iacol,
     $                        iseed, 0, m_matgen, 0, nq,
     $                        myrow, mycol, nprow, npcol )
*
*        Zero out padding at tops of columns
*
         DO 1000 j=1,nb
*
            DO 2000 i=1, lda-m_matgen
*
*              Indexing goes negative; BMATGEN assumes that space
*              has been preallocated above the first column as it
*              has to be if the matrix is to be input to
*              Scalapack's band solvers.
*
               a( i-lda+m_matgen, j ) = czero
*
 2000       CONTINUE
*
 1000    CONTINUE
*
      ENDIF
*
      IF( lsame( aform2, 'D' ).OR.
     $  ( lsame( aform, 'L' ).OR.lsame( aform, 'U' ) ) ) THEN
*
*       Loop over diagonal elements stored on this processor.
*
*
       DO 330 i=1, nq
         IF( lsame( aform, 'T' ) .OR.
     $     ( lsame( aform2, 'T' ) ) ) THEN
             IF( nprow .EQ. 1 ) THEN
                a( i, diag_index ) = cmplx( real( a( i, diag_index ) )
     $                               + real( 2*( bwl+bwu+1 ) ) )
             ENDIF
          ELSE
             IF( nprow .EQ. 1 ) THEN
                a( diag_index, i ) = cmplx( real( a( diag_index, i ) )
     $                               + real( 2*( bwl+bwu+1 ) ) )
             ENDIF
          END IF
  330  CONTINUE
*
*
      ELSE
*
*       Must add elements to keep condition of matrix in check
*
        DO 380 i=1, nq
*
          IF( nprow .EQ. 1 ) THEN
*
            IF( mod(i+mycol*nb,2) .EQ. 1 ) THEN
                a( diag_index+1, i ) =
     $                         cmplx( real( a( diag_index+1, i ) )
     $                         + real( 2*( bwl+bwu+1 ) ) )
*
            ELSE
*
                a( diag_index-1, i ) =
     $                          cmplx( real( a( diag_index-1, i ) )
     $                          + real( 2*( bwl+bwu+1 ) ) )
            ENDIF
*
          ENDIF
*
  380   CONTINUE
*
      END IF
*
      RETURN
*
*     End of PCBMATGEN
*
      END