Actual source code: ex1f.F90
petsc-3.12.0 2019-09-29
1: !
2: ! Simple PETSc Program to test setting error handlers from Fortran
3: !
4: subroutine GenerateErr(line,ierr)
6: #include <petsc/finclude/petscsys.h>
7: use petscsys
8: PetscErrorCode ierr
9: integer line
11: call PetscError(PETSC_COMM_SELF,1,PETSC_ERROR_INITIAL,'Error message')
13: return
14: end
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
24: print*,'My error handler ',mess
25: return
26: end
28: program main
29: use petscsys
30: PetscErrorCode ierr
31: external MyErrHandler
33: call PetscInitialize(PETSC_NULL_CHARACTER,ierr)
34: if (ierr .ne. 0) then
35: print*,'Unable to initialize PETSc'
36: stop
37: endif
39: call PetscPushErrorHandler(PetscTraceBackErrorHandler,PETSC_NULL_INTEGER,ierr)
41: call GenerateErr(__LINE__,ierr)
43: call PetscPushErrorHandler(MyErrHandler,PETSC_NULL_INTEGER,ierr)
45: call GenerateErr(__LINE__,ierr)
47: call PetscPushErrorHandler(PetscAbortErrorHandler,PETSC_NULL_INTEGER,ierr)
49: call GenerateErr(__LINE__,ierr)
51: call PetscFinalize(ierr)
52: end
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: ! filter: egrep "(My error handler|Operating system error: Cannot allocate memory)" | wc -l
62: !
63: !TEST*/