Actual source code: somefort.F
petsc-3.8.4 2018-03-24
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