Actual source code: ex1f.F

  1: !
  2: !  Simple PETSc Program to test setting error handlers from Fortran
  3: !
  4:       subroutine GenerateErr(line,ierr)
 5:  #include finclude/petscsys.h
  6:       PetscErrorCode  ierr
  7:       PetscInt line

  9:       call PetscError(1,line,1,'Error message',ierr)

 11:       return
 12:       end

 14:       subroutine MyErrHandler(line,fun,file,dir,n,p,mess,ctx,ierr)
 15:  #include finclude/petscsys.h
 16:       integer line,n,p
 17:       PetscInt ctx
 18:       PetscErrorCode ierr
 19:       character*(*) fun,file,dir,mess

 21:       print*,'My error handler ',mess
 22:       return
 23:       end

 25:       program main
 26:  #include finclude/petscsys.h
 27:       PetscErrorCode ierr
 28:       external       MyErrHandler

 30:       call PetscInitialize(PETSC_NULL_CHARACTER,ierr)

 32:       call PetscPushErrorHandler(PetscTraceBackErrorHandler,               &
 33:      &                           PETSC_NULL_INTEGER,ierr)

 35:       call GenerateErr(__LINE__,ierr)

 37:       call PetscPushErrorHandler(MyErrHandler,                           &
 38:      &                           PETSC_NULL_INTEGER,ierr)

 40:       call GenerateErr(__LINE__,ierr)

 42:       call PetscPushErrorHandler(PetscAbortErrorHandler,                   &
 43:      &                           PETSC_NULL_INTEGER,ierr)

 45:       call GenerateErr(__LINE__,ierr)

 47:       call PetscFinalize(ierr)
 48:       end