pb_schekpad()

subroutine pb_schekpad	(	integer	ictxt,
		character*(*)	mess,
		integer	m,
		integer	n,
		real, dimension( * )	a,
		integer	lda,
		integer	ipre,
		integer	ipost,
		real	chkval
	)

Definition at line 9192 of file psblastst.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 ..
      INTEGER            ICTXT, IPOST, IPRE, LDA, M, N
      REAL               CHKVAL
*     ..
*     .. Array Arguments ..
      CHARACTER*(*)      MESS
      REAL               A( * )
*     ..
*
*  Purpose
*  =======
*
*  PB_SCHEKPAD checks that the padding around a local array has not been
*  overwritten since the call to PB_SFILLPAD.  Three types of errors are
*  reported:
*
*  1) Overwrite in pre-guardzone.  This indicates a memory overwrite has
*  occurred in the  first  IPRE  elements which form a buffer before the
*  beginning of A. Therefore, the error message:
*     'Overwrite in  pre-guardzone: loc(  5) =         18.00000'
*  tells that the 5th element of the IPRE long buffer has been overwrit-
*  ten with the value 18, where it should still have the value CHKVAL.
*
*  2) Overwrite in post-guardzone. This indicates a memory overwrite has
*  occurred in the last IPOST elements which form a buffer after the end
*  of A. Error reports are refered from the end of A.  Therefore,
*     'Overwrite in post-guardzone: loc( 19) =         24.00000'
*  tells  that the  19th element after the end of A was overwritten with
*  the value 24, where it should still have the value of CHKVAL.
*
*  3) Overwrite in lda-m gap.  Tells you elements between M and LDA were
*  overwritten.  So,
*     'Overwrite in lda-m gap: A( 12,  3) =         22.00000'
*  tells  that the element at the 12th row and 3rd column of A was over-
*  written with the value of 22, where it should still have the value of
*  CHKVAL.
*
*  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.
*
*  MESS    (local input) CHARACTER*(*)
*          On entry, MESS is a ttring containing a user-defined message.
*
*  M       (local input) INTEGER
*          On entry, M  specifies the number of rows in the local  array
*          A.  M must be at least zero.
*
*  N       (local input) INTEGER
*          On entry, N  specifies the number of columns in the local ar-
*          ray A. N must be at least zero.
*
*  A       (local input) REAL array
*          On entry,  A  is an array of dimension (LDA,N).
*
*  LDA     (local input) INTEGER
*          On entry,  LDA  specifies  the leading dimension of the local
*          array to be padded. LDA must be at least MAX( 1, M ).
*
*  IPRE    (local input) INTEGER
*          On entry, IPRE specifies the size of  the  guard zone  to put
*          before the start of the padded array.
*
*  IPOST   (local input) INTEGER
*          On entry, IPOST specifies the size of the  guard zone  to put
*          after the end of the padded array.
*
*  CHKVAL  (local input) REAL
*          On entry, CHKVAL specifies the value to pad the array with.
*
*
*  -- Written on April 1, 1998 by
*     R. Clint Whaley, University of Tennessee, Knoxville 37996, USA.
*
*  =====================================================================
*
*     .. Local Scalars ..
      CHARACTER*1        TOP
      INTEGER            I, IAM, IDUMM, INFO, J, K, MYCOL, MYROW, NPCOL,
     $                   NPROW
*     ..
*     .. External Subroutines ..
      EXTERNAL           blacs_gridinfo, igamx2d, pb_topget
*     ..
*     .. Executable Statements ..
*
*     Get grid parameters
*
      CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
      iam  = myrow*npcol + mycol
      info = -1
*
*     Check buffer in front of A
*
      IF( ipre.GT.0 ) THEN
         DO 10 i = 1, ipre
            IF( a( i ).NE.chkval ) THEN
               WRITE( *, fmt = 9998 ) myrow, mycol, mess, ' pre', i,
     $                                a( i )
               info = iam
            END IF
   10    CONTINUE
      ELSE
         WRITE( *, fmt = * ) 'WARNING no pre-guardzone in PB_SCHEKPAD'
      END IF
*
*     Check buffer after A
*
      IF( ipost.GT.0 ) THEN
         j = ipre+lda*n+1
         DO 20 i = j, j+ipost-1
            IF( a( i ).NE.chkval ) THEN
               WRITE( *, fmt = 9998 ) myrow, mycol, mess, 'post',
     $                                i-j+1, a( i )
               info = iam
            END IF
   20    CONTINUE
      ELSE
         WRITE( *, fmt = * )
     $          'WARNING no post-guardzone buffer in PB_SCHEKPAD'
      END IF
*
*     Check all (LDA-M) gaps
*
      IF( lda.GT.m ) THEN
         k = ipre + m + 1
         DO 40 j = 1, n
            DO 30 i = k, k + (lda-m) - 1
               IF( a( i ).NE.chkval ) THEN
                  WRITE( *, fmt = 9997 ) myrow, mycol, mess,
     $               i-ipre-lda*(j-1), j, a( i )
                  info = iam
               END IF
   30       CONTINUE
            k = k + lda
   40    CONTINUE
      END IF
*
      CALL pb_topget( ictxt, 'Combine', 'All', top )
      CALL igamx2d( ictxt, 'All', top, 1, 1, info, 1, idumm, idumm, -1,
     $              0, 0 )
      IF( iam.EQ.0 .AND. info.GE.0 ) THEN
         WRITE( *, fmt = 9999 ) info / npcol, mod( info, npcol ), mess
      END IF
*
 9999 FORMAT( '{', i5, ',', i5, '}:  Memory overwrite in ', a )
 9998 FORMAT( '{', i5, ',', i5, '}:  ', a, ' memory overwrite in ',
     $        a4, '-guardzone: loc(', i3, ') = ', g11.4 )
 9997 FORMAT( '{', i5, ',', i5, '}: ', a, ' memory overwrite in ',
     $        'lda-m gap: loc(', i3, ',', i3, ') = ', g11.4 )
*
      RETURN
*
*     End of PB_SCHEKPAD
*

Here is the caller graph for this function: