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 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 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