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