Actual source code: petscsysmod.F
petsc-3.11.4 2019-09-28
2: module petscsysdefdummy
3: #include <petscconf.h>
4: #if defined(PETSC_HAVE_MPIUNI)
5: use mpiuni
6: #define PETSC_AVOID_MPIF_H
7: #elif defined(PETSC_HAVE_MPI_F90MODULE)
8: use mpi
9: #define PETSC_AVOID_MPIF_H
10: #endif
11: #include <../src/sys/f90-mod/petscsys.h>
12: #include <../src/sys/f90-mod/petscdraw.h>
13: #include <../src/sys/f90-mod/petscviewer.h>
14: end module
16: module petscsysdef
17: use petscsysdefdummy
18: interface operator(.ne.)
19: function petscviewernotequal(A,B)
20: use petscsysdefdummy
21: logical petscviewernotequal
22: type(tPetscViewer), intent(in) :: A,B
23: end function
24: end interface operator (.ne.)
25: interface operator(.eq.)
26: function petscviewerequals(A,B)
27: use petscsysdefdummy
28: logical petscviewerequals
29: type(tPetscViewer), intent(in) :: A,B
30: end function
31: end interface operator (.eq.)
33: interface operator(.ne.)
34: function petscrandomnotequal(A,B)
35: use petscsysdefdummy
36: logical petscrandomnotequal
37: type(tPetscRandom), intent(in) :: A,B
38: end function
39: end interface operator (.ne.)
40: interface operator(.eq.)
41: function petscrandomequals(A,B)
42: use petscsysdefdummy
43: logical petscrandomequals
44: type(tPetscRandom), intent(in) :: A,B
45: end function
46: end interface operator (.eq.)
47: end module
49: function petscviewernotequal(A,B)
50: use petscsysdefdummy
51: logical petscviewernotequal
52: type(tPetscViewer), intent(in) :: A,B
53: petscviewernotequal = (A%v .ne. B%v)
54: end function
55: function petscviewerequals(A,B)
56: use petscsysdefdummy
57: logical petscviewerequals
58: type(tPetscViewer), intent(in) :: A,B
59: petscviewerequals = (A%v .eq. B%v)
60: end function
62: function petscrandomnotequal(A,B)
63: use petscsysdefdummy
64: logical petscrandomnotequal
65: type(tPetscRandom), intent(in) :: A,B
66: petscrandomnotequal = (A%v .ne. B%v)
67: end function
68: function petscrandomequals(A,B)
69: use petscsysdefdummy
70: logical petscrandomequals
71: type(tPetscRandom), intent(in) :: A,B
72: petscrandomequals = (A%v .eq. B%v)
73: end function
74: #if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
75: !DEC$ ATTRIBUTES DLLEXPORT::petscviewernotequal
76: !DEC$ ATTRIBUTES DLLEXPORT::petscviewerequals
77: !DEC$ ATTRIBUTES DLLEXPORT::petscrandomnotequal
78: !DEC$ ATTRIBUTES DLLEXPORT::petscrandomequals
79: #endif
80: module petscsys
81: use iso_c_binding
82: use petscsysdef
83: MPI_Comm PETSC_COMM_SELF
84: MPI_Comm PETSC_COMM_WORLD
85: PetscChar(80) PETSC_NULL_CHARACTER = ''
86: PetscInt PETSC_NULL_INTEGER(1)
87: PetscFortranDouble PETSC_NULL_DOUBLE(1)
88: PetscScalar PETSC_NULL_SCALAR(1)
89: PetscReal PETSC_NULL_REAL(1)
90: PetscBool PETSC_NULL_BOOL
91: !
92: #if defined(PETSC_USE_REAL___FLOAT128)
93: integer MPIU_REAL
94: integer MPIU_SCALAR
95: integer MPIU_SUM
96: #endif
97: !
98: !
99: !
100: ! Basic math constants
101: !
102: PetscReal PETSC_PI
103: PetscReal PETSC_MAX_REAL
104: PetscReal PETSC_MIN_REAL
105: PetscReal PETSC_MACHINE_EPSILON
106: PetscReal PETSC_SQRT_MACHINE_EPSILON
107: PetscReal PETSC_SMALL
108: PetscReal PETSC_INFINITY
109: PetscReal PETSC_NINFINITY
111: !
112: #include <../src/sys/f90-mod/petscsys.h90>
113: interface
114: #include <../src/sys/f90-mod/ftn-auto-interfaces/petscsys.h90>
115: end interface
117: #if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
118: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_COMM_SELF
119: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_COMM_WORLD
120: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_CHARACTER
121: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_INTEGER
122: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_DOUBLE
123: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_SCALAR
124: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_REAL
125: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_BOOL
126: #if defined(PETSC_USE_REAL___FLOAT128)
127: !DEC$ ATTRIBUTES DLLEXPORT::MPIU_REAL
128: !DEC$ ATTRIBUTES DLLEXPORT::MPIU_SCALAR
129: !DEC$ ATTRIBUTES DLLEXPORT::MPIU_SUM
130: #endif
131: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_PI
132: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_MAX_REAL
133: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_MIN_REAL
134: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_MACHINE_EPSILON
135: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_SQRT_MACHINE_EPSILON
136: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_SMALL
137: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_INFINITY
138: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_NINFINITY
139: #endif
140: end module
142: subroutine PetscSetCOMM(c1,c2)
143: use petscsys
144: implicit none
145: MPI_Comm c1,c2
147: PETSC_COMM_WORLD = c1
148: PETSC_COMM_SELF = c2
149: return
150: end
152: subroutine PetscGetCOMM(c1)
153: use petscsys
154: implicit none
155: MPI_Comm c1
157: c1 = PETSC_COMM_WORLD
158: return
159: end
161: subroutine PetscSetModuleBlock()
162: use petscsys
163: implicit none
165: call PetscSetFortranBasePointers(PETSC_NULL_CHARACTER, &
166: & PETSC_NULL_INTEGER,PETSC_NULL_SCALAR, &
167: & PETSC_NULL_DOUBLE,PETSC_NULL_REAL, &
168: & PETSC_NULL_BOOL,PETSC_NULL_FUNCTION)
170: return
171: end
173: #if defined(PETSC_USE_REAL___FLOAT128)
174: subroutine PetscSetModuleBlockMPI(freal,fscalar,fsum)
175: use petscsys
176: implicit none
178: integer freal,fscalar,fsum
180: MPIU_REAL = freal
181: MPIU_SCALAR = fscalar
182: MPIU_SUM = fsum
183: return
184: end
185: #endif
187: subroutine PetscSetModuleBlockNumeric(pi,maxreal,minreal,eps, &
188: & seps,small,pinf,pninf)
189: use petscsys
190: implicit none
192: PetscReal pi,maxreal,minreal,eps,seps
193: PetscReal small,pinf,pninf
195: PETSC_PI = pi
196: PETSC_MAX_REAL = maxreal
197: PETSC_MIN_REAL = minreal
198: PETSC_MACHINE_EPSILON = eps
199: PETSC_SQRT_MACHINE_EPSILON = seps
200: PETSC_SMALL = small
201: PETSC_INFINITY = pinf
202: PETSC_NINFINITY = pninf
204: return
205: end
208: block data PetscCommInit
209: implicit none
210: !
211: ! this code is duplicated - because including ../src/sys/f90-mod/petscsys.h here
212: ! gives compile errors.
213: !
214: MPI_Comm PETSC_COMM_WORLD
215: MPI_Comm PETSC_COMM_SELF
216: common /petscfortran9/ PETSC_COMM_WORLD
217: common /petscfortran10/ PETSC_COMM_SELF
218: data PETSC_COMM_WORLD /0/
219: data PETSC_COMM_SELF /0/
220: end
221: