pvdescchk()

subroutine pvdescchk	(	integer	ictxt,
		integer	nout,
		character*1	matrix,
		integer, dimension( * )	descx,
		integer	dtx,
		integer	mx,
		integer	nx,
		integer	imbx,
		integer	inbx,
		integer	mbx,
		integer	nbx,
		integer	rsrcx,
		integer	csrcx,
		integer	incx,
		integer	mpx,
		integer	nqx,
		integer	iprex,
		integer	imidx,
		integer	ipostx,
		integer	igap,
		integer	gapmul,
		integer	info
	)

Definition at line 384 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            CSRCX, DTX, GAPMUL, ICTXT, IGAP, IMBX, IMIDX,
     $                   INBX, INCX, INFO, IPOSTX, IPREX, MBX, MPX, MX,
     $                   NBX, NOUT, NQX, NX, RSRCX
*     ..
*     .. Array Arguments ..
      INTEGER            DESCX( * )
*     ..
*
*  Purpose
*  =======
*
*  PVDESCCHK  checks  the validity of the input test parameters and ini-
*  tializes  the  descriptor DESCX and the scalar variables MPX, NQX. 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.
*
*  DESCX   (global output) INTEGER array
*          On entry, DESCX  is an array of dimension DLEN_. DESCX is the
*          array descriptor to be set.
*
*  DTYPEX  (global input) INTEGER
*          On entry, DTYPEX  specifies the descriptor type. In this ver-
*          sion, DTYPEX must be BLOCK_CYCLIC_INB_2D.
*
*  MX      (global input) INTEGER
*          On entry, MX  specifies the number of rows in the matrix.  MX
*          must be at least zero.
*
*  NX      (global input) INTEGER
*          On  entry,  NX specifies the number of columns in the matrix.
*          NX must be at least zero.
*
*  IMBX    (global input) INTEGER
*          On entry, IMBX specifies the row blocking factor used to dis-
*          tribute  the  first  IMBX rows of the matrix. IMBX must be at
*          least one.
*
*  INBX    (global input) INTEGER
*          On entry,  INBX  specifies the column blocking factor used to
*          distribute  the  first  INBX columns of the matrix. INBX must
*          be at least one.
*
*  MBX     (global input) INTEGER
*          On entry, MBX  specifies the row blocking factor used to dis-
*          tribute the rows of the matrix. MBX must be at least one.
*
*  NBX     (global input) INTEGER
*          On entry, NBX  specifies  the  column blocking factor used to
*          distribute  the  columns  of the matrix. NBX must be at least
*          one.
*
*  RSRCX   (global input) INTEGER
*          On entry, RSRCX  specifies the process row in which the first
*          row  of  the  matrix resides. When RSRCX is -1, the matrix is
*          row replicated,  otherwise  RSCRX  must  be at least zero and
*          strictly less than NPROW.
*
*  CSRCX   (global input) INTEGER
*          On entry,  CSRCX  specifies  the  process column in which the
*          first column of the matrix resides.  When  CSRCX  is -1,  the
*          matrix is column replicated, otherwise CSCRX must be at least
*          zero and strictly less than NPCOL.
*
*  INCX    (global input) INTEGER
*          On entry,  INCX  specifies  the global vector increment. INCX
*          must be one or MX.
*
*  MPX     (local output) INTEGER
*          On exit, MPX is Lr( 1, MX ).
*
*  NQX     (local output) INTEGER
*          On exit, NQX is Lc( 1, NX ).
*
*  IPREX   (local output) INTEGER
*          On exit,  IPREX  specifies  the size of the guard zone to put
*          before the start of the local padded array.
*
*  IMIDX   (local output) INTEGER
*          On exit,  IMIDX  specifies  the  ldx-gap of the guard zone to
*          put after each column of the local padded array.
*
*  IPOSTX  (local output) INTEGER
*          On exit,  IPOSTX  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 ldx-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            LLDX, 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( dtx.NE.block_cyclic_2d_inb ) THEN
         IF( myrow.EQ.0 .AND. mycol.EQ.0 )
     $      WRITE( nout, fmt = 9999 ) matrix, 'DTYPE', matrix, dtx,
     $                                block_cyclic_2d_inb
         info = 1
      END IF
*
*     Verify global matrix dimensions (M_,N_) are correct
*
      IF( mx.LT.0 ) THEN
         IF( myrow.EQ.0 .AND. mycol.EQ.0 )
     $      WRITE( nout, fmt = 9998 ) matrix, 'M', matrix, mx
         info = 1
      ELSE IF( nx.LT.0 ) THEN
         IF( myrow.EQ.0 .AND. mycol.EQ.0 )
     $      WRITE( nout, fmt = 9997 ) matrix, 'N', matrix, nx
         info = 1
      END IF
*
*     Verify if blocking factors (IMB_, INB_) are correct
*
      IF( imbx.LT.1 ) THEN
         IF( myrow.EQ.0 .AND. mycol.EQ.0 )
     $      WRITE( nout, fmt = 9996 ) matrix, 'IMB', matrix, imbx
         info = 1
      ELSE IF( inbx.LT.1 ) THEN
         IF( myrow.EQ.0 .AND. mycol.EQ.0 )
     $      WRITE( nout, fmt = 9995 ) matrix, 'INB', matrix, inbx
         info = 1
      END IF
*
*     Verify if blocking factors (MB_, NB_) are correct
*
      IF( mbx.LT.1 ) THEN
         IF( myrow.EQ.0 .AND. mycol.EQ.0 )
     $      WRITE( nout, fmt = 9994 ) matrix, 'MB', matrix, mbx
         info = 1
      ELSE IF( nbx.LT.1 ) THEN
         IF( myrow.EQ.0 .AND. mycol.EQ.0 )
     $      WRITE( nout, fmt = 9993 ) matrix, 'NB', matrix, nbx
         info = 1
      END IF
*
*     Verify if origin process coordinates (RSRC_, CSRC_) are valid
*
      IF( rsrcx.LT.-1 .OR. rsrcx.GE.nprow ) THEN
         IF( myrow.EQ.0 .AND. mycol.EQ.0 ) THEN
            WRITE( nout, fmt = 9992 ) matrix
            WRITE( nout, fmt = 9990 ) 'RSRC', matrix, rsrcx, nprow
         END IF
         info = 1
      ELSE IF( csrcx.LT.-1 .OR. csrcx.GE.npcol ) THEN
         IF( myrow.EQ.0 .AND. mycol.EQ.0 ) THEN
            WRITE( nout, fmt = 9991 ) matrix
            WRITE( nout, fmt = 9990 ) 'CSRC', matrix, csrcx, npcol
         END IF
         info = 1
      END IF
*
*     Check input increment value
*
      IF( incx.NE.1 .AND. incx.NE.mx ) THEN
         IF( myrow.EQ.0 .AND. mycol.EQ.0 ) THEN
            WRITE( nout, fmt = 9989 ) matrix
            WRITE( nout, fmt = 9988 ) 'INC', matrix, incx, matrix, mx
         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 = 9987 ) matrix
            WRITE( nout, fmt = * )
         END IF
*
      ELSE
*
*        Compute local testing leading dimension
*
         mpx    = pb_numroc( mx, 1, imbx, mbx, myrow, rsrcx, nprow )
         nqx    = pb_numroc( nx, 1, inbx, nbx, mycol, csrcx, npcol )
         iprex  = max( gapmul*nbx, mpx )
         imidx  = igap
         ipostx = max( gapmul*nbx, nqx )
         lldx   = max( 1, mpx ) + imidx
*
         CALL pb_descinit2( descx, mx, nx, imbx, inbx, mbx, nbx, rsrcx,
     $                      csrcx, ictxt, lldx, 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 = 9987 ) 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 vector ', a1, ' increment:' )
 9988 FORMAT( 2x, '>> ', a3, a1, '= ', i6, ' should be 1 or M', a1,
     $        ' = ', i6, '.' )
 9987 FORMAT( 2x, '>> Invalid matrix ', a1, ' descriptor: going on to ',
     $        'next test case.' )
*
      RETURN
*
*     End of PVDESCCHK
*