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 by
  5: !

  7:       subroutine MPIU_Abort(comm,ierr)
  8:       implicit none

 10: #include      <../src/sys/f90-mod/petscsys.h>

 12:       integer comm,ierr,nierr

 14:       call MPI_Abort(comm,ierr,nierr)

 16:       return
 17:       end

 19: !
 20: !
 21: !     Utility routine used to set constants into the
 22: !     PETSc Fortran common block
 23: !

 25:       subroutine PetscSetCommonBlock(c1,c2)
 26:       implicit none

 28: #include      <../src/sys/f90-mod/petscsys.h>

 30:       integer c1,c2

 32:       PETSC_COMM_WORLD    = c1
 33:       PETSC_COMM_SELF     = c2

 35:       call PetscSetFortranBasePointers(PETSC_NULL_CHARACTER,            &
 36:      &     PETSC_NULL_INTEGER,PETSC_NULL_SCALAR,                        &
 37:      &     PETSC_NULL_DOUBLE,PETSC_NULL_REAL,                           &
 38:      &     PETSC_NULL_BOOL,PETSC_NULL_FUNCTION)

 40:       return
 41:       end

 43:       subroutine PetscGetCommonCOMM(c1)
 44:       implicit none
 45: #include      <../src/sys/f90-mod/petscsys.h>
 46:       integer c1

 48:       c1 = PETSC_COMM_WORLD
 49:       return
 50:       end

 52: #if defined(PETSC_USE_REAL___FLOAT128)
 53:       subroutine PetscSetCommonBlockMPI(freal,fscalar,fsum)
 54:       implicit none

 56: #include      <../src/sys/f90-mod/petscsys.h>

 58:       integer freal,fscalar,fsum

 60:       MPIU_REAL   = freal
 61:       MPIU_SCALAR = fscalar
 62:       MPIU_SUM    = fsum
 63:       return
 64:       end
 65: #endif

 67:       subroutine PetscSetCommonBlockNumeric(pi,maxreal,minreal,eps,seps,    &
 68:      &                     small,pinf,pninf)
 69:       implicit none

 71: #include      <../src/sys/f90-mod/petscsys.h>

 73:       PetscReal pi,maxreal,minreal,eps,seps
 74:       PetscReal small,pinf,pninf

 76:       PETSC_PI = pi
 77:       PETSC_MAX_REAL = maxreal
 78:       PETSC_MIN_REAL = minreal
 79:       PETSC_MACHINE_EPSILON = eps
 80:       PETSC_SQRT_MACHINE_EPSILON = seps
 81:       PETSC_SMALL = small
 82:       PETSC_INFINITY = pinf
 83:       PETSC_NINFINITY = pninf

 85:       return
 86:       end


 89:       block data PetscCommInit
 90:       implicit none
 91: !
 92: !     this code is duplicated - because including ../src/sys/f90-mod/petscsys.h here
 93: !     gives compile errors.
 94: !
 95:       MPI_Comm PETSC_COMM_WORLD
 96:       MPI_Comm PETSC_COMM_SELF
 97:       common /petscfortran9/ PETSC_COMM_WORLD
 98:       common /petscfortran10/ PETSC_COMM_SELF
 99:       data   PETSC_COMM_WORLD /0/
100:       data   PETSC_COMM_SELF /0/
101:       end

103: #if defined(PETSC_HAVE_FORTRAN_GET_COMMAND_ARGUMENT)
104:       integer function PetscCommandArgumentCount()
105:       implicit none
106:       PetscCommandArgumentCount= command_argument_count()
107:       return
108:       end

110:       subroutine PetscGetCommandArgument(n,val)
111:       implicit none
112:       integer n
113:       character(*) val
114:       call get_command_argument(n,val)
115:       return
116:       end

118: #endif