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