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