Actual source code: pbarrier.c
petsc-3.10.5 2019-03-28
Report Typos and Errors

      2:  #include <petsc/private/petscimpl.h>

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

      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_LIB,PETSC_ERROR_INITIAL,"MPI_Allreduce() failed with error code %d",err);
     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: }

     34: /*@
     35:     PetscBarrier - Blocks until this routine is executed by all
     36:                    processors owning the object obj.

     38:    Input Parameters:
     39: .  obj - PETSc object  (Mat, Vec, IS, SNES etc...)
     40:         The object be caste with a (PetscObject). NULL can be used to indicate the barrier should be across MPI_COMM_WORLD

     42:   Level: intermediate

     44:   Notes:
     45:   This routine calls MPI_Barrier with the communicator of the PETSc Object obj

     47:   Fortran Usage:
     48:     You may pass PETSC_NULL_VEC or any other PETSc null object, such as PETSC_NULL_MAT, to indicate the barrier should be
     49:     across MPI_COMM_WORLD.

     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: }