1 2 /* 3 Code for tracing mistakes in MPI usage. For example, sends that are never received, 4 nonblocking messages that are not correctly waited for, etc. 5 */ 6 7 #include <petscsys.h> /*I "petscsys.h" I*/ 8 9 #if defined(PETSC_USE_LOG) && !defined(__MPIUNI_H) 10 11 /*@C 12 PetscMPIDump - Dumps a listing of incomplete MPI operations, such as sends that 13 have never been received, etc. 14 15 Collective on PETSC_COMM_WORLD 16 17 Input Parameter: 18 . fp - file pointer. If fp is NULL, stdout is assumed. 19 20 Options Database Key: 21 . -mpidump - Dumps MPI incompleteness during call to PetscFinalize() 22 23 Level: developer 24 25 .seealso: PetscMallocDump() 26 @*/ 27 PetscErrorCode PetscMPIDump(FILE *fd) 28 { 29 PetscErrorCode ierr; 30 PetscMPIInt rank; 31 double tsends,trecvs,work; 32 int err; 33 34 PetscFunctionBegin; 35 ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr); 36 if (!fd) fd = PETSC_STDOUT; 37 38 /* Did we wait on all the non-blocking sends and receives? */ 39 ierr = PetscSequentialPhaseBegin(PETSC_COMM_WORLD,1);CHKERRQ(ierr); 40 if (petsc_irecv_ct + petsc_isend_ct != petsc_sum_of_waits_ct) { 41 ierr = PetscFPrintf(PETSC_COMM_SELF,fd,"[%d]You have not waited on all non-blocking sends and receives",rank);CHKERRQ(ierr); 42 ierr = PetscFPrintf(PETSC_COMM_SELF,fd,"[%d]Number non-blocking sends %g receives %g number of waits %g\n",rank,petsc_isend_ct,petsc_irecv_ct,petsc_sum_of_waits_ct);CHKERRQ(ierr); 43 err = fflush(fd); 44 if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file"); 45 } 46 ierr = PetscSequentialPhaseEnd(PETSC_COMM_WORLD,1);CHKERRQ(ierr); 47 /* Did we receive all the messages that we sent? */ 48 work = petsc_irecv_ct + petsc_recv_ct; 49 ierr = MPI_Reduce(&work,&trecvs,1,MPI_DOUBLE,MPI_SUM,0,PETSC_COMM_WORLD);CHKERRQ(ierr); 50 work = petsc_isend_ct + petsc_send_ct; 51 ierr = MPI_Reduce(&work,&tsends,1,MPI_DOUBLE,MPI_SUM,0,PETSC_COMM_WORLD);CHKERRQ(ierr); 52 if (!rank && tsends != trecvs) { 53 ierr = PetscFPrintf(PETSC_COMM_SELF,fd,"Total number sends %g not equal receives %g\n",tsends,trecvs);CHKERRQ(ierr); 54 err = fflush(fd); 55 if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file"); 56 } 57 PetscFunctionReturn(0); 58 } 59 60 #else 61 62 PetscErrorCode PetscMPIDump(FILE *fd) 63 { 64 PetscFunctionBegin; 65 PetscFunctionReturn(0); 66 } 67 68 #endif 69 70 71 72 73 74 75 76 77 78