1 #define PETSC_DLL 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 #undef __FUNCT__ 12 #define __FUNCT__ "PetscMPIDump" 13 /*@C 14 PetscMPIDump - Dumps a listing of incomplete MPI operations, such as sends that 15 have never been received, etc. 16 17 Collective on PETSC_COMM_WORLD 18 19 Input Parameter: 20 . fp - file pointer. If fp is NULL, stdout is assumed. 21 22 Options Database Key: 23 . -mpidump - Dumps MPI incompleteness during call to PetscFinalize() 24 25 Level: developer 26 27 .seealso: PetscMallocDump() 28 @*/ 29 PetscErrorCode PETSCSYS_DLLEXPORT PetscMPIDump(FILE *fd) 30 { 31 PetscErrorCode ierr; 32 PetscMPIInt rank; 33 double tsends,trecvs,work; 34 int err; 35 36 PetscFunctionBegin; 37 ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr); 38 if (!fd) fd = PETSC_STDOUT; 39 40 /* Did we wait on all the non-blocking sends and receives? */ 41 ierr = PetscSequentialPhaseBegin(PETSC_COMM_WORLD,1);CHKERRQ(ierr); 42 if (irecv_ct + isend_ct != sum_of_waits_ct) { 43 ierr = PetscFPrintf(PETSC_COMM_SELF,fd,"[%d]You have not waited on all non-blocking sends and receives",rank);CHKERRQ(ierr); 44 ierr = PetscFPrintf(PETSC_COMM_SELF,fd,"[%d]Number non-blocking sends %g receives %g number of waits %g\n",rank,isend_ct,irecv_ct,sum_of_waits_ct);CHKERRQ(ierr); 45 err = fflush(fd); 46 if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file"); 47 } 48 ierr = PetscSequentialPhaseEnd(PETSC_COMM_WORLD,1);CHKERRQ(ierr); 49 /* Did we receive all the messages that we sent? */ 50 work = irecv_ct + recv_ct; 51 ierr = MPI_Reduce(&work,&trecvs,1,MPI_DOUBLE,MPI_SUM,0,PETSC_COMM_WORLD);CHKERRQ(ierr); 52 work = isend_ct + send_ct; 53 ierr = MPI_Reduce(&work,&tsends,1,MPI_DOUBLE,MPI_SUM,0,PETSC_COMM_WORLD);CHKERRQ(ierr); 54 if (!rank && tsends != trecvs) { 55 ierr = PetscFPrintf(PETSC_COMM_SELF,fd,"Total number sends %g not equal receives %g\n",tsends,trecvs);CHKERRQ(ierr); 56 err = fflush(fd); 57 if (err) SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SYS,"fflush() failed on file"); 58 } 59 PetscFunctionReturn(0); 60 } 61 62 #else 63 64 #undef __FUNCT__ 65 #define __FUNCT__ "PetscMPIDump" 66 PetscErrorCode PETSCSYS_DLLEXPORT PetscMPIDump(FILE *fd) 67 { 68 PetscFunctionBegin; 69 PetscFunctionReturn(0); 70 } 71 72 #endif 73 74 75 76 77 78 79 80 81 82