Actual source code: somefort.F
petsc-3.7.1 2016-05-15
Report Typos and Errors

      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