xref: /petsc/src/sys/ftn-src/somefort.F90 (revision b89a13d22df4882bcbf047fcff9c1fc5e2981141) !
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
9      subroutine MPIU_Abort(comm,ierr)
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      endif
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      implicit none
27      character(*) str
28      integer4 unit
29      PetscErrorCode ierr
30      write(unit=unit, fmt="(A)", advance='no') str
31      ierr = 0
32      end
33#if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
34!DEC$ ATTRIBUTES DLLEXPORT::PetscFortranPrintToFileUnit
35#endif
36
37!  This uses F2003 feature - and is the preferred mode for accessing command line arguments
38      integer function PetscCommandArgumentCount()
39      implicit none
40      PetscCommandArgumentCount = command_argument_count()
41      end
42
43      subroutine PetscGetCommandArgument(n,val)
44      implicit none
45      integer, intent(in) :: n
46      character(*) val
47      call get_command_argument(n,val)
48      end
49