xref: /petsc/src/sys/ftn-src/somefort.F90 (revision fe66ebcc023cb303106674d426ee542bea707d38)
16dd63270SBarry Smith!
26dd63270SBarry Smith!     Prevents: Warning: Same actual argument associated with INTENT(IN)
36dd63270SBarry Smith!     argument 'errorcode' and INTENT(OUT) argument 'ierror' at (1)
46dd63270SBarry Smith!     when MPI_Abort() is called directly
56dd63270SBarry Smith!
66dd63270SBarry Smith
76dd63270SBarry Smith#include <petsc/finclude/petscsys.h>
86dd63270SBarry Smith      subroutine MPIU_Abort(comm,ierr)
9*fe66ebccSMartin Diehl      use, intrinsic :: ISO_C_binding
106dd63270SBarry Smith      implicit none
116dd63270SBarry Smith      MPI_Comm comm
126dd63270SBarry Smith      PetscMPIInt ierr, nierr, ciportable
136dd63270SBarry Smith      call PetscCIEnabledPortableErrorOutput(ciportable)
146dd63270SBarry Smith      if (ciportable == 1) then
156dd63270SBarry Smith        call MPI_Finalize(nierr)
166dd63270SBarry Smith        stop 0
176dd63270SBarry Smith      else
186dd63270SBarry Smith        call MPI_Abort(comm,ierr,nierr)
196dd63270SBarry Smith      endif
206dd63270SBarry Smith      end
216dd63270SBarry Smith#if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
226dd63270SBarry Smith!DEC$ ATTRIBUTES DLLEXPORT::MPIU_Abort
236dd63270SBarry Smith#endif
246dd63270SBarry Smith
256dd63270SBarry Smith      subroutine PetscFortranPrintToFileUnit(unit,str,ierr)
26*fe66ebccSMartin Diehl      use, intrinsic :: ISO_C_binding
276dd63270SBarry Smith      implicit none
286dd63270SBarry Smith      character(*) str
296dd63270SBarry Smith      integer4 unit
306dd63270SBarry Smith      PetscErrorCode ierr
316dd63270SBarry Smith      write(unit=unit, fmt="(A)", advance='no') str
326dd63270SBarry Smith      ierr = 0
336dd63270SBarry Smith      end
346dd63270SBarry Smith#if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
356dd63270SBarry Smith!DEC$ ATTRIBUTES DLLEXPORT::PetscFortranPrintToFileUnit
366dd63270SBarry Smith#endif
376dd63270SBarry Smith
386dd63270SBarry Smith!  This uses F2003 feature - and is the preferred mode for accessing command line arguments
396dd63270SBarry Smith      integer function PetscCommandArgumentCount()
40*fe66ebccSMartin Diehl      use, intrinsic :: ISO_C_binding
416dd63270SBarry Smith      implicit none
426dd63270SBarry Smith      PetscCommandArgumentCount = command_argument_count()
436dd63270SBarry Smith      end
446dd63270SBarry Smith
456dd63270SBarry Smith      subroutine PetscGetCommandArgument(n,val)
466dd63270SBarry Smith      implicit none
476dd63270SBarry Smith      integer, intent(in) :: n
486dd63270SBarry Smith      character(*) val
496dd63270SBarry Smith      call get_command_argument(n,val)
506dd63270SBarry Smith      end
51