Date: 2013-07-02T14:39:25+00:00

Actual source code: ex1f.F
petsc-3.4.2 2013-07-02

      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(PETSC_COMM_SELF,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