Actual source code: ex1f.F90
petsc-3.12.4 2020-02-04
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*/