xref: /petsc/src/sys/ftn-src/somefort.F90 (revision d47c0497e3b52bb8681c9d2e1026ce8506d72f69)
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!
6
7#include <petsc/finclude/petscsys.h>
8subroutine 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
21end
22#if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
23!DEC$ ATTRIBUTES DLLEXPORT::MPIU_Abort
24#endif
25
26subroutine 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
34end
35#if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
36!DEC$ ATTRIBUTES DLLEXPORT::PetscFortranPrintToFileUnit
37#endif
38
39integer pure function PetscCommandArgumentCount()
40  use, intrinsic :: ISO_C_binding
41  implicit none
42  PetscCommandArgumentCount = command_argument_count()
43end
44
45subroutine PetscGetCommandArgument(n, val)
46  implicit none
47  integer, intent(in) :: n
48  character(*), intent(out) :: val
49  call get_command_argument(n, val)
50end
51