Actual source code: ex1f.F90

petsc-3.13.4 2020-08-01
Report Typos and Errors
  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: !     args: -error_output_stdout
 62: !     filter:Error: egrep  "(My error handler|Operating system error: Cannot allocate memory)" | wc -l
 63: !
 64: !TEST*/