1 2 #include <petsc/private/petscimpl.h> /*I "petscsys.h" I*/ 3 4 /* Logging support */ 5 PetscLogEvent PETSC_Barrier=0; 6 7 static int hash(const char *str) 8 { 9 int c,hash = 5381; 10 11 while ((c = *str++)) hash = ((hash << 5) + hash) + c; /* hash * 33 + c */ 12 return hash; 13 } 14 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]; 22 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 } 33 34 #undef __FUNCT__ 35 #define __FUNCT__ "PetscBarrier" 36 /*@C 37 PetscBarrier - Blocks until this routine is executed by all 38 processors owning the object A. 39 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) 43 44 Level: intermediate 45 46 Notes: 47 This routine calls MPI_Barrier with the communicator of the PETSc Object "A". 48 49 With fortran Use NULL_OBJECT (instead of NULL) 50 51 Concepts: barrier 52 53 @*/ 54 PetscErrorCode PetscBarrier(PetscObject obj) 55 { 56 PetscErrorCode ierr; 57 MPI_Comm comm; 58 59 PetscFunctionBegin; 60 if (obj) PetscValidHeader(obj,1); 61 ierr = PetscLogEventBegin(PETSC_Barrier,obj,0,0,0);CHKERRQ(ierr); 62 if (obj) { 63 ierr = PetscObjectGetComm(obj,&comm);CHKERRQ(ierr); 64 } else comm = PETSC_COMM_WORLD; 65 ierr = MPI_Barrier(comm);CHKERRQ(ierr); 66 ierr = PetscLogEventEnd(PETSC_Barrier,obj,0,0,0);CHKERRQ(ierr); 67 PetscFunctionReturn(0); 68 } 69 70