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