xref: /petsc/src/sys/ftn-src/somefort.F90 (revision 2f04c52277ae86d0bd99bd90d9d5574dfa2d51e6)
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>
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
24
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
37
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
44
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
51