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