1*c4762a1bSJed Brown! 2*c4762a1bSJed Brown! Simple PETSc Program to test setting error handlers from Fortran 3*c4762a1bSJed Brown! 4*c4762a1bSJed Brown subroutine GenerateErr(line,ierr) 5*c4762a1bSJed Brown 6*c4762a1bSJed Brown#include <petsc/finclude/petscsys.h> 7*c4762a1bSJed Brown use petscsys 8*c4762a1bSJed Brown PetscErrorCode ierr 9*c4762a1bSJed Brown integer line 10*c4762a1bSJed Brown 11*c4762a1bSJed Brown call PetscError(PETSC_COMM_SELF,1,PETSC_ERROR_INITIAL,'Error message') 12*c4762a1bSJed Brown 13*c4762a1bSJed Brown return 14*c4762a1bSJed Brown end 15*c4762a1bSJed Brown 16*c4762a1bSJed Brown subroutine MyErrHandler(comm,line,fun,file,n,p,mess,ctx,ierr) 17*c4762a1bSJed Brown use petscsysdef 18*c4762a1bSJed Brown integer line,n,p 19*c4762a1bSJed Brown PetscInt ctx 20*c4762a1bSJed Brown PetscErrorCode ierr 21*c4762a1bSJed Brown MPI_Comm comm 22*c4762a1bSJed Brown character*(*) fun,file,mess 23*c4762a1bSJed Brown 24*c4762a1bSJed Brown print*,'My error handler ',mess 25*c4762a1bSJed Brown return 26*c4762a1bSJed Brown end 27*c4762a1bSJed Brown 28*c4762a1bSJed Brown program main 29*c4762a1bSJed Brown use petscsys 30*c4762a1bSJed Brown PetscErrorCode ierr 31*c4762a1bSJed Brown external MyErrHandler 32*c4762a1bSJed Brown 33*c4762a1bSJed Brown call PetscInitialize(PETSC_NULL_CHARACTER,ierr) 34*c4762a1bSJed Brown if (ierr .ne. 0) then 35*c4762a1bSJed Brown print*,'Unable to initialize PETSc' 36*c4762a1bSJed Brown stop 37*c4762a1bSJed Brown endif 38*c4762a1bSJed Brown 39*c4762a1bSJed Brown call PetscPushErrorHandler(PetscTraceBackErrorHandler,PETSC_NULL_INTEGER,ierr) 40*c4762a1bSJed Brown 41*c4762a1bSJed Brown call GenerateErr(__LINE__,ierr) 42*c4762a1bSJed Brown 43*c4762a1bSJed Brown call PetscPushErrorHandler(MyErrHandler,PETSC_NULL_INTEGER,ierr) 44*c4762a1bSJed Brown 45*c4762a1bSJed Brown call GenerateErr(__LINE__,ierr) 46*c4762a1bSJed Brown 47*c4762a1bSJed Brown call PetscPushErrorHandler(PetscAbortErrorHandler,PETSC_NULL_INTEGER,ierr) 48*c4762a1bSJed Brown 49*c4762a1bSJed Brown call GenerateErr(__LINE__,ierr) 50*c4762a1bSJed Brown 51*c4762a1bSJed Brown call PetscFinalize(ierr) 52*c4762a1bSJed Brown end 53*c4762a1bSJed Brown 54*c4762a1bSJed Brown! 55*c4762a1bSJed Brown! These test fails on some systems randomly due to the Fortran and C output becoming mixxed up, 56*c4762a1bSJed Brown! using a Fortran flush after the Fortran print* does not resolve the issue 57*c4762a1bSJed Brown! 58*c4762a1bSJed Brown!/*TEST 59*c4762a1bSJed Brown! 60*c4762a1bSJed Brown! test: 61*c4762a1bSJed Brown! args: -error_output_stdout 62*c4762a1bSJed Brown! filter:Error: egrep "(My error handler|Operating system error: Cannot allocate memory)" | wc -l 63*c4762a1bSJed Brown! 64*c4762a1bSJed Brown!TEST*/ 65