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:         implicit none
 11:         MPI_Comm comm
 12:         PetscMPIInt ierr, nierr, ciportable
 13:         call PetscCIEnabledPortableErrorOutput(ciportable)
 14:         if (ciportable == 1) then
 15:           call MPI_Finalize(nierr)
 16:           stop 0
 17:         else
 18:           call MPI_Abort(comm, ierr, nierr)
 19:         end if
 20:       end
 21: #if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
 22: !DEC$ ATTRIBUTES DLLEXPORT::MPIU_Abort
 23: #endif

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

 38: !  This uses F2003 feature - and is the preferred mode for accessing command line arguments
 39:       integer 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(*) val
 49:         call get_command_argument(n, val)
 50:       end