pmdescchk()

subroutine pmdescchk	(	integer	ictxt,
		integer	nout,
		character*1	matrix,
		integer, dimension( * )	desca,
		integer	dta,
		integer	ma,
		integer	na,
		integer	imba,
		integer	inba,
		integer	mba,
		integer	nba,
		integer	rsrca,
		integer	csrca,
		integer	mpa,
		integer	nqa,
		integer	iprea,
		integer	imida,
		integer	iposta,
		integer	igap,
		integer	gapmul,
		integer	info
	)

Definition at line 742 of file pblastim.f.

*
*  -- PBLAS test routine (version 2.0) --
*     University of Tennessee, Knoxville, Oak Ridge National Laboratory,
*     and University of California, Berkeley.
*     April 1, 1998
*
*     .. Scalar Arguments ..
      CHARACTER*1        MATRIX
      INTEGER            CSRCA, DTA, GAPMUL, ICTXT, IGAP, IMBA, IMIDA,
     $                   INBA, INFO, IPOSTA, IPREA, MA, MBA, MPA, NA,
     $                   NBA, NOUT, NQA, RSRCA
*     ..
*     .. Array Arguments ..
      INTEGER            DESCA( * )
*     ..
*
*  Purpose
*  =======
*
*  PMDESCCHK  checks  the validity of the input test parameters and ini-
*  tializes  the  descriptor DESCA and the scalar variables MPA, NQA. In
*  case  of  an  invalid parameter, this routine displays error messages
*  and return an non-zero error code in INFO.
*
*  Notes
*  =====
*
*  A description  vector  is associated with each 2D block-cyclicly dis-
*  tributed matrix.  This  vector  stores  the  information  required to
*  establish the  mapping  between a  matrix entry and its corresponding
*  process and memory location.
*
*  In  the  following  comments,   the character _  should  be  read  as
*  "of  the  distributed  matrix".  Let  A  be a generic term for any 2D
*  block cyclicly distributed matrix.  Its description vector is DESCA:
*
*  NOTATION         STORED IN       EXPLANATION
*  ---------------- --------------- ------------------------------------
*  DTYPE_A (global) DESCA( DTYPE_ ) The descriptor type.
*  CTXT_A  (global) DESCA( CTXT_  ) The BLACS context handle, indicating
*                                   the NPROW x NPCOL BLACS process grid
*                                   A  is distributed over.  The context
*                                   itself  is  global,  but  the handle
*                                   (the integer value) may vary.
*  M_A     (global) DESCA( M_     ) The  number of rows in the distribu-
*                                   ted matrix A, M_A >= 0.
*  N_A     (global) DESCA( N_     ) The number of columns in the distri-
*                                   buted matrix A, N_A >= 0.
*  IMB_A   (global) DESCA( IMB_   ) The number of rows of the upper left
*                                   block of the matrix A, IMB_A > 0.
*  INB_A   (global) DESCA( INB_   ) The  number  of columns of the upper
*                                   left   block   of   the   matrix  A,
*                                   INB_A > 0.
*  MB_A    (global) DESCA( MB_    ) The blocking factor used to  distri-
*                                   bute the last  M_A-IMB_A rows of  A,
*                                   MB_A > 0.
*  NB_A    (global) DESCA( NB_    ) The blocking factor used to  distri-
*                                   bute the last  N_A-INB_A  columns of
*                                   A, NB_A > 0.
*  RSRC_A  (global) DESCA( RSRC_  ) The process row over which the first
*                                   row of the matrix  A is distributed,
*                                   NPROW > RSRC_A >= 0.
*  CSRC_A  (global) DESCA( CSRC_  ) The  process  column  over which the
*                                   first  column of  A  is distributed.
*                                   NPCOL > CSRC_A >= 0.
*  LLD_A   (local)  DESCA( LLD_   ) The  leading  dimension of the local
*                                   array  storing  the  local blocks of
*                                   the distributed matrix A,
*                                   IF( Lc( 1, N_A ) > 0 )
*                                      LLD_A >= MAX( 1, Lr( 1, M_A ) )
*                                   ELSE
*                                      LLD_A >= 1.
*
*  Let K be the number of  rows of a matrix A starting at the global in-
*  dex IA,i.e, A( IA:IA+K-1, : ). Lr( IA, K ) denotes the number of rows
*  that the process of row coordinate MYROW ( 0 <= MYROW < NPROW ) would
*  receive if these K rows were distributed over NPROW processes.  If  K
*  is the number of columns of a matrix  A  starting at the global index
*  JA, i.e, A( :, JA:JA+K-1, : ), Lc( JA, K ) denotes the number  of co-
*  lumns that the process MYCOL ( 0 <= MYCOL < NPCOL ) would  receive if
*  these K columns were distributed over NPCOL processes.
*
*  The values of Lr() and Lc() may be determined via a call to the func-
*  tion PB_NUMROC:
*  Lr( IA, K ) = PB_NUMROC( K, IA, IMB_A, MB_A, MYROW, RSRC_A, NPROW )
*  Lc( JA, K ) = PB_NUMROC( K, JA, INB_A, NB_A, MYCOL, CSRC_A, NPCOL )
*
*  Arguments
*  =========
*
*  ICTXT   (local input) INTEGER
*          On entry,  ICTXT  specifies the BLACS context handle, indica-
*          ting the global  context of the operation. The context itself
*          is global, but the value of ICTXT is local.
*
*  NOUT    (global input) INTEGER
*          On entry, NOUT specifies the unit number for the output file.
*          When NOUT is 6, output to screen,  when  NOUT is 0, output to
*          stderr. NOUT is only defined for process 0.
*
*  MATRIX  (global input) CHARACTER*1
*          On entry,  MATRIX  specifies the one character matrix identi-
*          fier.
*
*  DESCA   (global output) INTEGER array
*          On entry, DESCA  is an array of dimension DLEN_. DESCA is the
*          array descriptor to be set.
*
*  DTYPEA  (global input) INTEGER
*          On entry, DTYPEA  specifies the descriptor type. In this ver-
*          sion, DTYPEA must be BLOCK_CYCLIC_INB_2D.
*
*  MA      (global input) INTEGER
*          On entry, MA  specifies the number of rows in the matrix.  MA
*          must be at least zero.
*
*  NA      (global input) INTEGER
*          On  entry,  NA specifies the number of columns in the matrix.
*          NA must be at least zero.
*
*  IMBA    (global input) INTEGER
*          On entry, IMBA specifies the row blocking factor used to dis-
*          tribute  the  first  IMBA rows of the matrix. IMBA must be at
*          least one.
*
*  INBA    (global input) INTEGER
*          On entry,  INBA  specifies the column blocking factor used to
*          distribute  the  first  INBA columns of the matrix. INBA must
*          be at least one.
*
*  MBA     (global input) INTEGER
*          On entry, MBA  specifies the row blocking factor used to dis-
*          tribute the rows of the matrix. MBA must be at least one.
*
*  NBA     (global input) INTEGER
*          On entry, NBA  specifies  the  column blocking factor used to
*          distribute  the  columns  of the matrix. NBA must be at least
*          one.
*
*  RSRCA   (global input) INTEGER
*          On entry, RSRCA  specifies the process row in which the first
*          row  of  the  matrix resides. When RSRCA is -1, the matrix is
*          row replicated,  otherwise  RSCRA  must  be at least zero and
*          strictly less than NPROW.
*
*  CSRCA   (global input) INTEGER
*          On entry,  CSRCA  specifies  the  process column in which the
*          first column of the matrix resides.  When  CSRCA  is -1,  the
*          matrix is column replicated, otherwise CSCRA must be at least
*          zero and strictly less than NPCOL.
*
*  MPA     (local output) INTEGER
*          On exit, MPA is Lr( 1, MA ).
*
*  NQA     (local output) INTEGER
*          On exit, NQA is Lc( 1, NA ).
*
*  IPREA   (local output) INTEGER
*          On exit,  IPREA  specifies  the size of the guard zone to put
*          before the start of the local padded array.
*
*  IMIDA   (local output) INTEGER
*          On exit,  IMIDA  specifies  the  lda-gap of the guard zone to
*          put after each column of the local padded array.
*
*  IPOSTA  (local output) INTEGER
*          On exit,  IPOSTA  specifies the size of the guard zone to put
*          after the local padded array.
*
*  IGAP    (global input) INTEGER
*          On entry, IGAP specifies the size of the lda-gap.
*
*  GAPMUL  (global input) INTEGER
*          On entry,  GAPMUL  is  a constant factor controlling the size
*          of the pre- and post guardzone.
*
*  INFO    (global output) INTEGER
*          On exit,  when  INFO  is  zero,  no  error has been detected,
*          otherwise an error has been detected.
*
*  -- Written on April 1, 1998 by
*     Antoine Petitet, University  of  Tennessee, Knoxville 37996, USA.
*
*  =====================================================================
*
*     .. Parameters ..
      INTEGER            BLOCK_CYCLIC_2D_INB, CSRC_, CTXT_, DLEN_,
     $                   DTYPE_, IMB_, INB_, LLD_, MB_, M_, NB_, N_,
     $                   RSRC_
      parameter( block_cyclic_2d_inb = 2, dlen_ = 11,
     $                   dtype_ = 1, ctxt_ = 2, m_ = 3, n_ = 4,
     $                   imb_ = 5, inb_ = 6, mb_ = 7, nb_ = 8,
     $                   rsrc_ = 9, csrc_ = 10, lld_ = 11 )
*     ..
*     .. Local Scalars ..
      INTEGER            LLDA, MYCOL, MYROW, NPCOL, NPROW
*     ..
*     .. External Subroutines ..
      EXTERNAL           blacs_gridinfo, igsum2d, pb_descinit2
*     ..
*     .. External Functions ..
      INTEGER            PB_NUMROC
      EXTERNAL           pb_numroc
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          max
*     ..
*     .. Executable Statements ..
*
      info = 0
      CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
*
*     Verify descriptor type DTYPE_
*
      IF( dta.NE.block_cyclic_2d_inb ) THEN
         IF( myrow.EQ.0 .AND. mycol.EQ.0 )
     $      WRITE( nout, fmt = 9999 ) matrix, 'DTYPE', matrix, dta,
     $                                block_cyclic_2d_inb
         info = 1
      END IF
*
*     Verify global matrix dimensions (M_,N_) are correct
*
      IF( ma.LT.0 ) THEN
         IF( myrow.EQ.0 .AND. mycol.EQ.0 )
     $      WRITE( nout, fmt = 9998 ) matrix, 'M', matrix, ma
         info = 1
      ELSE IF( na.LT.0 ) THEN
         IF( myrow.EQ.0 .AND. mycol.EQ.0 )
     $      WRITE( nout, fmt = 9997 ) matrix, 'N', matrix, na
         info = 1
      END IF
*
*     Verify if blocking factors (IMB_, INB_) are correct
*
      IF( imba.LT.1 ) THEN
         IF( myrow.EQ.0 .AND. mycol.EQ.0 )
     $      WRITE( nout, fmt = 9996 ) matrix, 'IMB', matrix, imba
         info = 1
      ELSE IF( inba.LT.1 ) THEN
         IF( myrow.EQ.0 .AND. mycol.EQ.0 )
     $      WRITE( nout, fmt = 9995 ) matrix, 'INB', matrix, inba
         info = 1
      END IF
*
*     Verify if blocking factors (MB_, NB_) are correct
*
      IF( mba.LT.1 ) THEN
         IF( myrow.EQ.0 .AND. mycol.EQ.0 )
     $      WRITE( nout, fmt = 9994 ) matrix, 'MB', matrix, mba
         info = 1
      ELSE IF( nba.LT.1 ) THEN
         IF( myrow.EQ.0 .AND. mycol.EQ.0 )
     $      WRITE( nout, fmt = 9993 ) matrix, 'NB', matrix, nba
         info = 1
      END IF
*
*     Verify if origin process coordinates (RSRC_, CSRC_) are valid
*
      IF( rsrca.LT.-1 .OR. rsrca.GE.nprow ) THEN
         IF( myrow.EQ.0 .AND. mycol.EQ.0 ) THEN
            WRITE( nout, fmt = 9992 ) matrix
            WRITE( nout, fmt = 9990 ) 'RSRC', matrix, rsrca, nprow
         END IF
         info = 1
      ELSE IF( csrca.LT.-1 .OR. csrca.GE.npcol ) THEN
         IF( myrow.EQ.0 .AND. mycol.EQ.0 ) THEN
            WRITE( nout, fmt = 9991 ) matrix
            WRITE( nout, fmt = 9990 ) 'CSRC', matrix, csrca, npcol
         END IF
         info = 1
      END IF
*
*     Check all processes for an error
*
      CALL igsum2d( ictxt, 'All', ' ', 1, 1, info, 1, -1, 0 )
*
      IF( info.NE.0 ) THEN
*
         IF( myrow.EQ.0 .AND. mycol.EQ.0 ) THEN
            WRITE( nout, fmt = 9989 ) matrix
            WRITE( nout, fmt = * )
         END IF
*
      ELSE
*
*        Compute local testing leading dimension
*
         mpa    = pb_numroc( ma, 1, imba, mba, myrow, rsrca, nprow )
         nqa    = pb_numroc( na, 1, inba, nba, mycol, csrca, npcol )
         iprea  = max( gapmul*nba, mpa )
         imida  = igap
         iposta = max( gapmul*nba, nqa )
         llda   = max( 1, mpa ) + imida
*
         CALL pb_descinit2( desca, ma, na, imba, inba, mba, nba, rsrca,
     $                      csrca, ictxt, llda, info )
*
*        Check all processes for an error
*
         CALL igsum2d( ictxt, 'All', ' ', 1, 1, info, 1, -1, 0 )
*
         IF( info.NE.0 ) THEN
            IF( myrow.EQ.0 .AND. mycol.EQ.0 ) THEN
               WRITE( nout, fmt = 9989 ) matrix
               WRITE( nout, fmt = * )
            END IF
         END IF
*
      END IF
*
 9999 FORMAT( 2x, '>> Invalid matrix ', a1, ' descriptor type ', a5, a1,
     $        ': ', i6, ' should be ', i3, '.' )
 9998 FORMAT( 2x, '>> Invalid matrix ', a1, ' row dimension ', a1, a1,
     $        ': ', i6, ' should be at least 1.' )
 9997 FORMAT( 2x, '>> Invalid matrix ', a1, ' column dimension ', a1,
     $        a1, ': ', i6, ' should be at least 1.' )
 9996 FORMAT( 2x, '>> Invalid matrix ', a1, ' first row block size ',
     $        a3, a1, ': ', i6, ' should be at least 1.' )
 9995 FORMAT( 2x, '>> Invalid matrix ', a1, ' first column block size ',
     $        a3, a1,': ', i6, ' should be at least 1.' )
 9994 FORMAT( 2x, '>> Invalid matrix ', a1, ' row block size ', a2, a1,
     $        ': ', i6, ' should be at least 1.' )
 9993 FORMAT( 2x, '>> Invalid matrix ', a1, ' column block size ', a2,
     $        a1,': ', i6, ' should be at least 1.' )
 9992 FORMAT( 2x, '>> Invalid matrix ', a1, ' row process source:' )
 9991 FORMAT( 2x, '>> Invalid matrix ', a1, ' column process source:' )
 9990 FORMAT( 2x, '>> ', a4, a1, '= ', i6, ' should be >= -1 and < ',
     $        i6, '.' )
 9989 FORMAT( 2x, '>> Invalid matrix ', a1, ' descriptor: going on to ',
     $        'next test case.' )
*
      RETURN
*
*     End of PMDESCCHK
*

Here is the call graph for this function: