1: !
  2: !
  3: !     Utility routine used to set constants into the
  4: !     PETSc Fortran common block
  5: !

  7:       subroutine PetscSetCommonBlock(c1,c2)
  8:       implicit none

 10: #include      <petsc/finclude/petscsys.h>

 12:       integer c1,c2

 14:       PETSC_COMM_WORLD    = c1
 15:       PETSC_COMM_SELF     = c2

 17:       call PetscSetFortranBasePointers(PETSC_NULL_CHARACTER,            &
 18:      &     PETSC_NULL_INTEGER,PETSC_NULL_SCALAR,                        &
 19:      &     PETSC_NULL_DOUBLE,PETSC_NULL_REAL,PETSC_NULL_OBJECT,         &
 20:      &     PETSC_NULL_BOOL,PETSC_NULL_FUNCTION)

 22:       return
 23:       end

 25:       subroutine PetscGetCommonCOMM(c1)
 26:       implicit none
 27: #include      <petsc/finclude/petscsys.h>
 28:       integer c1

 30:       c1 = PETSC_COMM_WORLD
 31:       return
 32:       end

 34: #if defined(PETSC_USE_REAL___FLOAT128)
 35:       subroutine PetscSetCommonBlockMPI(freal,fscalar,fsum)
 36:       implicit none

 38: #include      <petsc/finclude/petscsys.h>

 40:       integer freal,fscalar,fsum

 42:       MPIU_REAL   = freal
 43:       MPIU_SCALAR = fscalar
 44:       MPIU_SUM    = fsum
 45:       return
 46:       end
 47: #endif

 49:       subroutine PetscSetCommonBlockNumeric(pi,maxreal,minreal,eps,seps,    &
 50:      &                     small,pinf,pninf)
 51:       implicit none

 53: #include      <petsc/finclude/petscsys.h>

 55:       PetscReal pi,maxreal,minreal,eps,seps
 56:       PetscReal small,pinf,pninf

 58:       PETSC_PI = pi
 59:       PETSC_MAX_REAL = maxreal
 60:       PETSC_MIN_REAL = minreal
 61:       PETSC_MACHINE_EPSILON = eps
 62:       PETSC_SQRT_MACHINE_EPSILON = seps
 63:       PETSC_SMALL = small
 64:       PETSC_INFINITY = pinf
 65:       PETSC_NINFINITY = pninf

 67:       return
 68:       end


 71:       block data PetscCommInit
 72:       implicit none
 73: !
 74: !     this code is duplicated - because including petsc/finclude/petscsys.h here
 75: !     gives compile errors.
 76: !
 77:       MPI_Comm PETSC_COMM_WORLD
 78:       MPI_Comm PETSC_COMM_SELF
 79:       common /petscfortran9/ PETSC_COMM_WORLD
 80:       common /petscfortran10/ PETSC_COMM_SELF
 81:       data   PETSC_COMM_WORLD /0/
 82:       data   PETSC_COMM_SELF /0/
 83:       end

 85: #if defined(PETSC_HAVE_FORTRAN_GET_COMMAND_ARGUMENT)
 86:       integer function PetscCommandArgumentCount()
 87:       implicit none
 88:       PetscCommandArgumentCount= command_argument_count()
 89:       return
 90:       end

 92:       subroutine PetscGetCommandArgument(n,val)
 93:       implicit none
 94:       integer n
 95:       character(*) val
 96:       call get_command_argument(n,val)
 97:       return
 98:       end

100: #endif