Actual source code: somefort.F90

  1: !
  2: !     Prevents: Warning: Same actual argument associated with INTENT(IN)
  3: !     argument 'errorcode' and INTENT(OUT) argument 'ierror' at (1)
  4: !     when MPI_Abort() is called directly
  5: !

  7: #include <petsc/finclude/petscsys.h>
  8: subroutine MPIU_Abort(comm, ierr)
  9:   use, intrinsic :: ISO_C_binding
 10:   use petscmpi
 11:   implicit none
 12:   MPIU_Comm comm
 13:   PetscMPIInt ierr, nierr, ciportable
 14:   call PetscCIEnabledPortableErrorOutput(ciportable)
 15:   if (ciportable == 1) then
 16:     call MPI_Finalize(nierr)
 17:     stop 0
 18:   else
 19:     call MPI_Abort(comm, ierr, nierr)
 20:   end if
 21: end
 22: #if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
 23: !DEC$ ATTRIBUTES DLLEXPORT::MPIU_Abort
 24: #endif

 26: subroutine PetscFortranPrintToFileUnit(unit, str, ierr)
 27:   use, intrinsic :: ISO_C_binding
 28:   implicit none
 29:   character(*) str
 30:   integer4, intent(in) :: unit
 31:   PetscErrorCode, intent(out) :: ierr
 32:   write (unit=unit, fmt="(A)", advance='no') str
 33:   ierr = 0
 34: end
 35: #if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
 36: !DEC$ ATTRIBUTES DLLEXPORT::PetscFortranPrintToFileUnit
 37: #endif

 39: integer pure function PetscCommandArgumentCount()
 40:   use, intrinsic :: ISO_C_binding
 41:   implicit none
 42:   PetscCommandArgumentCount = command_argument_count()
 43: end

 45: subroutine PetscGetCommandArgument(n, val)
 46:   implicit none
 47:   integer, intent(in) :: n
 48:   character(*), intent(out) :: val
 49:   call get_command_argument(n, val)
 50: end