Actual source code: pbarrier.c

petsc-master 2016-07-26
Report Typos and Errors
  2: #include <petsc/private/petscimpl.h>              /*I "petscsys.h" I*/

  4: /* Logging support */
  5: PetscLogEvent PETSC_Barrier=0;

  7: static int hash(const char *str)
  8: {
  9:   int c,hash = 5381;

 11:   while ((c = *str++)) hash = ((hash << 5) + hash) + c; /* hash * 33 + c */
 12:   return hash;
 13: }

 15: /*
 16:    This is used by MPIU_Allreduce() to insure that all callers originated from the same place in the PETSc code
 17: */
 18: PetscErrorCode PetscAllreduceBarrierCheck(MPI_Comm comm,PetscMPIInt ctn,int line,const char *func,const char *file)
 19: {
 20:   PetscMPIInt err;
 21:   PetscMPIInt b1[6],b2[6];

 23:   b1[0] = -(PetscMPIInt)line;       b1[1] = -b1[0];
 24:   b1[2] = -(PetscMPIInt)hash(func); b1[3] = -b1[2];
 25:   b1[4] = -(PetscMPIInt)ctn;        b1[5] = -b1[4];
 26:   err = MPI_Allreduce(b1,b2,6,MPI_INT,MPI_MAX,comm);
 27:   if (err) return PetscError(PETSC_COMM_SELF,line,func,file,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL,"MPI_Allreduced() failed");
 28:   if (-b2[0] != b2[1]) return PetscError(PETSC_COMM_SELF,line,func,file,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL,"MPI_Allreduce() called in different locations (code lines) on different processors");
 29:   if (-b2[2] != b2[3]) return PetscError(PETSC_COMM_SELF,line,func,file,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL,"MPI_Allreduce() called in different locations (functions) on different processors");
 30:   if (-b2[4] != b2[5]) return PetscError(PETSC_COMM_SELF,line,func,file,PETSC_ERR_PLIB,PETSC_ERROR_INITIAL,"MPI_Allreduce() called with different counts %d on different processors",ctn);
 31:   return 0;
 32: }

 36: /*@C
 37:     PetscBarrier - Blocks until this routine is executed by all
 38:                    processors owning the object A.

 40:    Input Parameters:
 41: .  A - PETSc object  (Mat, Vec, IS, SNES etc...)
 42:         Must be caste with a (PetscObject), can use NULL (for MPI_COMM_WORLD)

 44:   Level: intermediate

 46:   Notes:
 47:   This routine calls MPI_Barrier with the communicator of the PETSc Object "A".

 49:   With fortran Use NULL_OBJECT (instead of NULL)

 51:    Concepts: barrier

 53: @*/
 54: PetscErrorCode  PetscBarrier(PetscObject obj)
 55: {
 57:   MPI_Comm       comm;

 61:   PetscLogEventBegin(PETSC_Barrier,obj,0,0,0);
 62:   if (obj) {
 63:     PetscObjectGetComm(obj,&comm);
 64:   } else comm = PETSC_COMM_WORLD;
 65:   MPI_Barrier(comm);
 66:   PetscLogEventEnd(PETSC_Barrier,obj,0,0,0);
 67:   return(0);
 68: }