SUBROUTINE PCHK1MAT( MA, MAPOS0, NA, NAPOS0, IA, JA, DESCA,
     $                     DESCAPOS0, NEXTRA, EX, EXPOS, INFO )

*
* -- ScaLAPACK tools routine (version 1.5) -- 

*     University of Tennessee, Knoxville, Oak Ridge National Laboratory,
*     and University of California, Berkeley.
*     May 1, 1997
*
*     .. Scalar Arguments ..
      INTEGER            DESCAPOS0, IA, INFO, JA, MA, MAPOS0, NA,
     $                   NAPOS0, NEXTRA
*     ..
*     .. Array Arguments ..
      INTEGER            DESCA( * ), EX( NEXTRA ), EXPOS( NEXTRA )
*     ..

*
* Purpose

*
* PCHK1MAT checks that the values associated with one distributed * matrix are consistant across the entire process grid. *
* Notes
*
* This routine checks that all values are the same across the grid. * It does no local checking; it is therefore legal to abuse the * definitions of the non-descriptor arguments, i.e., if the routine * you are checking does not possess a MA value, you may pass some * other integer that must be global into this argument instead. *
* Arguments
* 
*  MA      (global input) INTEGER
*          The global number of matrix rows of A being operated on.

*
* MAPOS0 (global input) INTEGER
* Where in the calling routine's parameter list MA appears. * 

*  NA      (global input) INTEGER
*          The global number of matrix columns of A being operated on.

*
* NAPOS0 (global input) INTEGER
* Where in the calling routine's parameter list NA appears. * 

*  IA      (global input) INTEGER
*          The row index in the global array A indicating the first
*          row of sub( A ).
*
*  JA      (global input) INTEGER
*          The column index in the global array A indicating the
*          first column of sub( A ).

*
* DESCA (global and local input) INTEGER array of dimension DLEN_. * The array descriptor for the distributed matrix A. *
* DESCAPOS0 (global input) INTEGER 

*          Where in the calling routine's parameter list DESCA
*          appears.  Note that we assume IA and JA are respectively 2
*          and 1 entries behind DESCA.

*
* NEXTRA (global input) INTEGER 

*          The number of extra parameters (i.e., besides the ones
*          above) to check.  NEXTRA <= LDW - 11.
*
*  EX      (local input) INTEGER array of dimension (NEXTRA)
*          The values of these extra parameters

*
* EXPOS (local input) INTEGER array of dimension (NEXTRA) * The parameter list positions of these extra values. *
* INFO (local input/global output) INTEGER 

*          = 0:  successful exit
*          < 0:  If the i-th argument is an array and the j-entry had
*                an illegal value, then INFO = -(i*100+j), if the i-th
*                argument is a scalar and had an illegal value, then
*                INFO = -i.

*

* 
*     .. Parameters ..
      INTEGER            BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_,
     $                   LLD_, MB_, M_, NB_, N_, RSRC_
      PARAMETER          ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1,
     $                     CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6,
     $                     RSRC_ = 7, CSRC_ = 8, LLD_ = 9 )
      INTEGER            BIGNUM, DESCMULT, LDW
      PARAMETER          ( DESCMULT = 100, BIGNUM = DESCMULT * DESCMULT,
     $                     LDW = 25 )
*     ..
*     .. Local Scalars ..
      INTEGER            DESCPOS, K
*     ..
*     .. Local Arrays ..
      INTEGER            IWORK( LDW, 2 ), IWORK2( LDW )
*     ..
*     .. External Subroutines ..
      EXTERNAL           GLOBCHK
*     ..
*     .. Executable Statements ..
*
*     Want to find errors with MIN( ), so if no error, set it to a big
*     number. If there already is an error, multiply by the the
*     descriptor multiplier.
*
      IF( INFO.GE.0 ) THEN
         INFO = BIGNUM
      ELSE IF( INFO.LT.-DESCMULT ) THEN
         INFO = -INFO
      ELSE
         INFO = -INFO * DESCMULT
      END IF
*
*     Pack values and their positions in the parameter list, factoring
*     in the descriptor multiplier
*
      IWORK( 1, 1 ) = MA
      IWORK( 1, 2 ) = MAPOS0 * DESCMULT
      IWORK( 2, 1 ) = NA
      IWORK( 2, 2 ) = NAPOS0 * DESCMULT
      IWORK( 3, 1 ) = IA
      IWORK( 3, 2 ) = (DESCAPOS0-2) * DESCMULT
      IWORK( 4, 1 ) = JA
      IWORK( 4, 2 ) = (DESCAPOS0-1) * DESCMULT
      DESCPOS = DESCAPOS0 * DESCMULT
*
      IWORK(  5, 1 ) = DESCA( DTYPE_ )
      IWORK(  5, 2 ) = DESCPOS + DTYPE_
      IWORK(  6, 1 ) = DESCA( M_ )
      IWORK(  6, 2 ) = DESCPOS + M_
      IWORK(  7, 1 ) = DESCA( N_ )
      IWORK(  7, 2 ) = DESCPOS + N_
      IWORK(  8, 1 ) = DESCA( MB_ )
      IWORK(  8, 2 ) = DESCPOS + MB_
      IWORK(  9, 1 ) = DESCA( NB_ )
      IWORK(  9, 2 ) = DESCPOS + NB_
      IWORK( 10, 1 ) = DESCA( RSRC_ )
      IWORK( 10, 2 ) = DESCPOS + RSRC_
      IWORK( 11, 1 ) = DESCA( CSRC_ )
      IWORK( 11, 2 ) = DESCPOS + CSRC_
*
      IF( NEXTRA.GT.0 ) THEN
         DO 10 K = 1, NEXTRA
            IWORK( 11+K, 1 ) = EX( K )
            IWORK( 11+K, 2 ) = EXPOS( K )
   10    CONTINUE
      END IF
      K = 11 + NEXTRA
*
*     Get the smallest error detected anywhere (BIGNUM if no error)
*
      CALL GLOBCHK( DESCA( CTXT_ ), K, IWORK, LDW, IWORK2, INFO )
*
*     Prepare output: set info = 0 if no error, and divide by DESCMULT if
*     error is not in a descriptor entry
*
      IF( INFO .EQ. BIGNUM ) THEN
         INFO = 0
      ELSE IF( MOD( INFO, DESCMULT ) .EQ. 0 ) THEN
         INFO = -INFO / DESCMULT
      ELSE
         INFO = -INFO
      END IF
*
      RETURN
*
*     End of PCHK1MAT
*
      END
*
      SUBROUTINE PCHK2MAT( MA, MAPOS0, NA, NAPOS0, IA, JA, DESCA,
     $                     DESCAPOS0, MB, MBPOS0, NB, NBPOS0, IB, JB,
     $                     DESCB, DESCBPOS0, NEXTRA, EX, EXPOS, INFO )

*
* -- ScaLAPACK tools routine (version 1.5) -- 

*     University of Tennessee, Knoxville, Oak Ridge National Laboratory,
*     and University of California, Berkeley.
*     May 1, 1997
*
*     .. Scalar Arguments ..
      INTEGER            DESCAPOS0, DESCBPOS0, IA, IB, INFO, JA, JB, MA,
     $                   MAPOS0, MB, MBPOS0, NA, NAPOS0, NB, NBPOS0,
     $                   NEXTRA
*     ..
*     .. Array Arguments ..
      INTEGER            DESCA( * ), DESCB( 8 ), EX( NEXTRA ),
     $                   EXPOS( NEXTRA )
*     ..

*
* Purpose

*
* PCHK2MAT checks that the values associated with two distributed * matrices are consistant across the entire process grid. *
* Notes
*
* This routine checks that all values are the same across the grid. * It does no local checking; it is therefore legal to abuse the * definitions of the non-descriptor arguments, i.e., if the routine * you are checking does not possess a MA value, you may pass some * other integer that must be global into this argument instead. *
* Arguments
* 
*  MA      (global input) INTEGER
*          The global number of matrix rows of A being operated on.

*
* MAPOS0 (global input) INTEGER
* Where in the calling routine's parameter list MA appears. * 

*  NA      (global input) INTEGER
*          The global number of matrix columns of A being operated on.

*
* NAPOS0 (global input) INTEGER
* Where in the calling routine's parameter list NA appears. * 

*  IA      (global input) INTEGER
*          The row index in the global array A indicating the first
*          row of sub( A ).
*
*  JA      (global input) INTEGER
*          The column index in the global array A indicating the
*          first column of sub( A ).

*
* DESCA (global and local input) INTEGER array of dimension DLEN_. * The array descriptor for the distributed matrix A. *
* DESCAPOS0 (global input) INTEGER 

*          Where in the calling routine's parameter list DESCA
*          appears.  Note that we assume IA and JA are respectively 2
*          and 1 entries behind DESCA.
*
*  MB      (global input) INTEGER
*          The global number of matrix rows of B being operated on.

*
* MBPOS0 (global input) INTEGER
* Where in the calling routine's parameter list MB appears. * 

*  NB      (global input) INTEGER
*          The global number of matrix columns of B being operated on.

*
* NBPOS0 (global input) INTEGER
* Where in the calling routine's parameter list NB appears. * 

*  IB      (global input) INTEGER
*          The row index in the global array B indicating the first
*          row of sub( B ).
*
*  JB      (global input) INTEGER
*          The column index in the global array B indicating the
*          first column of sub( B ).

*
* DESCB (global and local input) INTEGER array of dimension DLEN_. * The array descriptor for the distributed matrix B. *
* DESCBPOS0 (global input) INTEGER 

*          Where in the calling routine's parameter list DESCB
*          appears. Note that we assume IB and JB are respectively 2
*          and 1 entries behind DESCB.

*
* NEXTRA (global input) INTEGER 

*          The number of extra parameters (i.e., besides the ones
*          above) to check.  NEXTRA <= LDW - 22.
*
*  EX      (local input) INTEGER array of dimension (NEXTRA)
*          The values of these extra parameters

*
* EXPOS (local input) INTEGER array of dimension (NEXTRA) * The parameter list positions of these extra values. *
* INFO (local input/global output) INTEGER 

*          = 0:  successful exit
*          < 0:  If the i-th argument is an array and the j-entry had
*                an illegal value, then INFO = -(i*100+j), if the i-th
*                argument is a scalar and had an illegal value, then
*                INFO = -i.

*

* 
*     .. Parameters ..
      INTEGER            BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_,
     $                   LLD_, MB_, M_, NB_, N_, RSRC_
      PARAMETER          ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1,
     $                     CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6,
     $                     RSRC_ = 7, CSRC_ = 8, LLD_ = 9 )
      INTEGER            DESCMULT, BIGNUM, LDW
      PARAMETER          ( DESCMULT = 100, BIGNUM = DESCMULT * DESCMULT,
     $                     LDW = 35 )
*     ..
*     .. Local Scalars ..
      INTEGER            K, DESCPOS
*     ..
*     .. Local Arrays ..
      INTEGER            IWORK( LDW, 2 ), IWORK2( LDW )
*     ..
*     .. External Subroutines ..
      EXTERNAL           GLOBCHK
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          MOD
*     ..
*     .. Executable Statements ..
*
*     Want to find errors with MIN( ), so if no error, set it to a big
*     number. If there already is an error, multiply by the the
*     descriptor multiplier.
*
      IF( INFO.GE.0 ) THEN
         INFO = BIGNUM
      ELSE IF( INFO.LT.-DESCMULT ) THEN
         INFO = -INFO
      ELSE
         INFO = -INFO * DESCMULT
      END IF
*
*     Pack values and their positions in the parameter list, factoring
*     in the descriptor multiplier
*
      IWORK( 1, 1 ) = MA
      IWORK( 1, 2 ) = MAPOS0 * DESCMULT
      IWORK( 2, 1 ) = NA
      IWORK( 2, 2 ) = NAPOS0 * DESCMULT
      IWORK( 3, 1 ) = IA
      IWORK( 3, 2 ) = (DESCAPOS0-2) * DESCMULT
      IWORK( 4, 1 ) = JA
      IWORK( 4, 2 ) = (DESCAPOS0-1) * DESCMULT
      DESCPOS = DESCAPOS0 * DESCMULT
*
      IWORK(  5, 1 ) = DESCA( DTYPE_ )
      IWORK(  5, 2 ) = DESCPOS + DTYPE_
      IWORK(  6, 1 ) = DESCA( M_ )
      IWORK(  6, 2 ) = DESCPOS + M_
      IWORK(  7, 1 ) = DESCA( N_ )
      IWORK(  7, 2 ) = DESCPOS + N_
      IWORK(  8, 1 ) = DESCA( MB_ )
      IWORK(  8, 2 ) = DESCPOS + MB_
      IWORK(  9, 1 ) = DESCA( NB_ )
      IWORK(  9, 2 ) = DESCPOS + NB_
      IWORK( 10, 1 ) = DESCA( RSRC_ )
      IWORK( 10, 2 ) = DESCPOS + RSRC_
      IWORK( 11, 1 ) = DESCA( CSRC_ )
      IWORK( 11, 2 ) = DESCPOS + CSRC_
*
      IWORK( 12, 1 ) = MB
      IWORK( 12, 2 ) = MBPOS0 * DESCMULT
      IWORK( 13, 1 ) = NB
      IWORK( 13, 2 ) = NBPOS0 * DESCMULT
      IWORK( 14, 1 ) = IB
      IWORK( 14, 2 ) = (DESCBPOS0-2) * DESCMULT
      IWORK( 15, 1 ) = JB
      IWORK( 15, 2 ) = (DESCBPOS0-1) * DESCMULT
      DESCPOS = DESCBPOS0 * DESCMULT
*
      IWORK( 16, 1 ) = DESCB( DTYPE_ )
      IWORK( 16, 2 ) = DESCPOS + DTYPE_
      IWORK( 17, 1 ) = DESCB( M_ )
      IWORK( 17, 2 ) = DESCPOS + M_
      IWORK( 18, 1 ) = DESCB( N_ )
      IWORK( 18, 2 ) = DESCPOS + N_
      IWORK( 19, 1 ) = DESCB( MB_ )
      IWORK( 19, 2 ) = DESCPOS + MB_
      IWORK( 20, 1 ) = DESCB( NB_ )
      IWORK( 20, 2 ) = DESCPOS + NB_
      IWORK( 21, 1 ) = DESCB( RSRC_ )
      IWORK( 21, 2 ) = DESCPOS + RSRC_
      IWORK( 22, 1 ) = DESCB( CSRC_ )
      IWORK( 22, 2 ) = DESCPOS + CSRC_
*
      IF( NEXTRA.GT.0 ) THEN
         DO 10 K = 1, NEXTRA
            IWORK( 22+K, 1 ) = EX( K )
            IWORK( 22+K, 2 ) = EXPOS( K )
   10    CONTINUE
      END IF
      K = 22 + NEXTRA
*
*     Get the smallest error detected anywhere (BIGNUM if no error)
*
      CALL GLOBCHK( DESCA( CTXT_ ), K, IWORK, LDW, IWORK2, INFO )
*
*     Prepare output: set info = 0 if no error, and divide by DESCMULT
*     if error is not in a descriptor entry.
*
      IF( INFO.EQ.BIGNUM ) THEN
         INFO = 0
      ELSE IF( MOD( INFO, DESCMULT ) .EQ. 0 ) THEN
         INFO = -INFO / DESCMULT
      ELSE
         INFO = -INFO
      END IF
*
      RETURN
*
*     End of PCHK2MAT
*
      END
*
      SUBROUTINE GLOBCHK( ICTXT, N, X, LDX, IWORK, INFO )

*
* -- ScaLAPACK tools routine (version 1.5) -- 

*     University of Tennessee, Knoxville, Oak Ridge National Laboratory,
*     and University of California, Berkeley.
*     May 1, 1997
*
*     .. Scalar Arguments ..
      INTEGER            ICTXT, INFO, LDX, N
*     ..
*     .. Array Arguments ..
      INTEGER            IWORK( N ), X( LDX, 2 )
*     ..

*
* Purpose

*
* GLOBCHK checks that values in X(i,1) are the same on all processes * in the process grid indicated by ICTXT. *
* Arguments
*
* ICTXT (global input) INTEGER 
*          The BLACS context handle indicating the context over which
*          the values are to be the same.
*
*  N       (global input) INTEGER
*          The number of values to be compared.
*
*  X       (local input) INTEGER array, dimension (N,2)
*          The 1st column contains the values which should be the same
*          on all processes.  The 2nd column indicates where in the
*          calling routine's parameter list the corresponding value
*          from column 1 came from.
*
*  LDX     (local input) INTEGER
*          The leading dimension of the array X. LDX >= MAX(1,N).

*
* IWORK (local workspace) INTEGER array, dimension (N) * Used to receive other processes' values for comparing with X. *
* INFO (local input/global output) INTEGER 

*          On entry, the smallest error flag so far generated, or BIGNUM
*          for no error. On exit:
*          = BIGNUM : no error
*          < 0: if INFO = -i*100, the i-th argument had an illegal
*               value, or was different between processes.

*

* 
*     .. Local Scalars ..
      INTEGER            K, MYROW, MYCOL
*     ..
*     .. External Subroutines ..
      EXTERNAL           BLACS_GRIDINFO, IGAMN2D, IGEBR2D, IGEBS2D
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          MIN
*     ..
*     .. Executable Statements ..
*
      CALL BLACS_GRIDINFO( ICTXT, IWORK, K, MYROW, MYCOL )
*
      IF( MYROW.EQ.0 .AND. MYCOL.EQ.0 ) THEN
         CALL IGEBS2D( ICTXT, 'All', ' ', N, 1, X, N )
      ELSE
         CALL IGEBR2D( ICTXT, 'All', ' ', N, 1, IWORK, N, 0, 0 )
         DO 10 K = 1, N
            IF( X( K, 1 ).NE.IWORK( K ) )
     $         INFO = MIN( INFO, X( K, 2 ) )
   10    CONTINUE
      END IF
*
      CALL IGAMN2D( ICTXT, 'All', ' ', 1, 1, INFO, 1, K, K, -1, -1, 0 )
*
      RETURN
*
*     End GLOBCHK
*
      END