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 use petscmpi 11 implicit none 12 MPIU_Comm comm 13 PetscMPIInt ierr, nierr, ciportable 14 call PetscCIEnabledPortableErrorOutput(ciportable) 15 if (ciportable == 1) then 16 call MPI_Finalize(nierr) 17 stop 0 18 else 19 call MPI_Abort(comm, ierr, nierr) 20 end if 21 end 22#if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES) 23!DEC$ ATTRIBUTES DLLEXPORT::MPIU_Abort 24#endif 25 26 subroutine PetscFortranPrintToFileUnit(unit, str, ierr) 27 use, intrinsic :: ISO_C_binding 28 implicit none 29 character(*) str 30 integer4 unit 31 PetscErrorCode ierr 32 write (unit=unit, fmt="(A)", advance='no') str 33 ierr = 0 34 end 35#if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES) 36!DEC$ ATTRIBUTES DLLEXPORT::PetscFortranPrintToFileUnit 37#endif 38 39! This uses F2003 feature - and is the preferred mode for accessing command line arguments 40 integer function PetscCommandArgumentCount() 41 use, intrinsic :: ISO_C_binding 42 implicit none 43 PetscCommandArgumentCount = command_argument_count() 44 end 45 46 subroutine PetscGetCommandArgument(n, val) 47 implicit none 48 integer, intent(in) :: n 49 character(*) val 50 call get_command_argument(n, val) 51 end 52