Actual source code: petscsysmod.F
petsc-3.12.5 2020-03-29
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.)
48: Interface petscbinaryread
49: subroutine petscbinaryreadcomplex(fd,data,num,count,type,z)
50: use petscsysdefdummy
51: integer fd
52: PetscComplex data(*)
53: PetscInt num
54: PetscInt count
55: PetscDataType type
56: integer z
57: end subroutine
58: subroutine petscbinaryreadreal(fd,data,num,count,type,z)
59: use petscsysdefdummy
60: integer fd
61: PetscReal data(*)
62: PetscInt num
63: PetscInt count
64: PetscDataType type
65: integer z
66: end subroutine
67: subroutine petscbinaryreadint(fd,data,num,count,type,z)
68: use petscsysdefdummy
69: integer fd
70: PetscInt data(*)
71: PetscInt num
72: PetscInt count
73: PetscDataType type
74: integer z
75: end subroutine
76: subroutine petscbinaryreadcomplex1(fd,data,num,count,type,z)
77: use petscsysdefdummy
78: integer fd
79: PetscComplex data
80: PetscInt num
81: PetscInt count
82: PetscDataType type
83: integer z
84: end subroutine
85: subroutine petscbinaryreadreal1(fd,data,num,count,type,z)
86: use petscsysdefdummy
87: integer fd
88: PetscReal data
89: PetscInt num
90: PetscInt count
91: PetscDataType type
92: integer z
93: end subroutine
94: subroutine petscbinaryreadint1(fd,data,num,count,type,z)
95: use petscsysdefdummy
96: integer fd
97: PetscInt data
98: PetscInt num
99: PetscInt count
100: PetscDataType type
101: integer z
102: end subroutine
103: subroutine petscbinaryreadcomplexcnt(fd,data,num,count,type,z)
104: use petscsysdefdummy
105: integer fd
106: PetscComplex data(*)
107: PetscInt num
108: PetscInt count(1)
109: PetscDataType type
110: integer z
111: end subroutine
112: subroutine petscbinaryreadrealcnt(fd,data,num,count,type,z)
113: use petscsysdefdummy
114: integer fd
115: PetscReal data(*)
116: PetscInt num
117: PetscInt count(1)
118: PetscDataType type
119: integer z
120: end subroutine
121: subroutine petscbinaryreadintcnt(fd,data,num,count,type,z)
122: use petscsysdefdummy
123: integer fd
124: PetscInt data(*)
125: PetscInt num
126: PetscInt count(1)
127: PetscDataType type
128: integer z
129: end subroutine
130: subroutine petscbinaryreadcomplex1cnt(fd,data,num,count,type,z)
131: use petscsysdefdummy
132: integer fd
133: PetscComplex data
134: PetscInt num
135: PetscInt count(1)
136: PetscDataType type
137: integer z
138: end subroutine
139: subroutine petscbinaryreadreal1cnt(fd,data,num,count,type,z)
140: use petscsysdefdummy
141: integer fd
142: PetscReal data
143: PetscInt num
144: PetscInt count(1)
145: PetscDataType type
146: integer z
147: end subroutine
148: subroutine petscbinaryreadint1cnt(fd,data,num,count,type,z)
149: use petscsysdefdummy
150: integer fd
151: PetscInt data
152: PetscInt num
153: PetscInt count(1)
154: PetscDataType type
155: integer z
156: end subroutine
157: end Interface
159: Interface petscbinarywrite
160: subroutine petscbinarywritecomplex(fd,data,num,type,tmp,z)
161: use petscsysdefdummy
162: integer fd
163: PetscComplex data(*)
164: PetscInt num
165: PetscDataType type
166: PetscBool tmp
167: integer z
168: end subroutine
169: subroutine petscbinarywritereal(fd,data,num,type,tmp,z)
170: use petscsysdefdummy
171: integer fd
172: PetscReal data(*)
173: PetscInt num
174: PetscDataType type
175: PetscBool tmp
176: integer z
177: end subroutine
178: subroutine petscbinarywriteint(fd,data,num,type,tmp, z)
179: use petscsysdefdummy
180: integer fd
181: PetscInt data(*)
182: PetscInt num
183: PetscDataType type
184: PetscBool tmp
185: integer z
186: end subroutine
187: subroutine petscbinarywritecomplex1(fd,data,num,type,tmp,z)
188: use petscsysdefdummy
189: integer fd
190: PetscComplex data
191: PetscInt num
192: PetscDataType type
193: PetscBool tmp
194: integer z
195: end subroutine
196: subroutine petscbinarywritereal1(fd,data,num,type,tmp,z)
197: use petscsysdefdummy
198: integer fd
199: PetscReal data
200: PetscInt num
201: PetscDataType type
202: PetscBool tmp
203: integer z
204: end subroutine
205: subroutine petscbinarywriteint1(fd,data,num,type,tmp, z)
206: use petscsysdefdummy
207: integer fd
208: PetscInt data
209: PetscInt num
210: PetscDataType type
211: PetscBool tmp
212: integer z
213: end subroutine
214: end Interface
216: end module
218: function petscviewernotequal(A,B)
219: use petscsysdefdummy
220: logical petscviewernotequal
221: type(tPetscViewer), intent(in) :: A,B
222: petscviewernotequal = (A%v .ne. B%v)
223: end function
224: function petscviewerequals(A,B)
225: use petscsysdefdummy
226: logical petscviewerequals
227: type(tPetscViewer), intent(in) :: A,B
228: petscviewerequals = (A%v .eq. B%v)
229: end function
231: function petscrandomnotequal(A,B)
232: use petscsysdefdummy
233: logical petscrandomnotequal
234: type(tPetscRandom), intent(in) :: A,B
235: petscrandomnotequal = (A%v .ne. B%v)
236: end function
237: function petscrandomequals(A,B)
238: use petscsysdefdummy
239: logical petscrandomequals
240: type(tPetscRandom), intent(in) :: A,B
241: petscrandomequals = (A%v .eq. B%v)
242: end function
243: #if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
244: !DEC$ ATTRIBUTES DLLEXPORT::petscviewernotequal
245: !DEC$ ATTRIBUTES DLLEXPORT::petscviewerequals
246: !DEC$ ATTRIBUTES DLLEXPORT::petscrandomnotequal
247: !DEC$ ATTRIBUTES DLLEXPORT::petscrandomequals
248: #endif
249: module petscsys
250: use iso_c_binding
251: use petscsysdef
252: MPI_Comm PETSC_COMM_SELF
253: MPI_Comm PETSC_COMM_WORLD
254: PetscChar(80) PETSC_NULL_CHARACTER = ''
255: PetscInt PETSC_NULL_INTEGER(1)
256: PetscFortranDouble PETSC_NULL_DOUBLE(1)
257: PetscScalar PETSC_NULL_SCALAR(1)
258: PetscReal PETSC_NULL_REAL(1)
259: PetscBool PETSC_NULL_BOOL
260: !
261: #if defined(PETSC_USE_REAL___FLOAT128)
262: integer MPIU_REAL
263: integer MPIU_SCALAR
264: integer MPIU_SUM
265: #endif
266: !
267: !
268: !
269: ! Basic math constants
270: !
271: PetscReal PETSC_PI
272: PetscReal PETSC_MAX_REAL
273: PetscReal PETSC_MIN_REAL
274: PetscReal PETSC_MACHINE_EPSILON
275: PetscReal PETSC_SQRT_MACHINE_EPSILON
276: PetscReal PETSC_SMALL
277: PetscReal PETSC_INFINITY
278: PetscReal PETSC_NINFINITY
280: !
281: #include <../src/sys/f90-mod/petscsys.h90>
282: interface
283: #include <../src/sys/f90-mod/ftn-auto-interfaces/petscsys.h90>
284: end interface
286: #if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
287: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_COMM_SELF
288: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_COMM_WORLD
289: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_CHARACTER
290: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_INTEGER
291: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_DOUBLE
292: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_SCALAR
293: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_REAL
294: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_BOOL
295: #if defined(PETSC_USE_REAL___FLOAT128)
296: !DEC$ ATTRIBUTES DLLEXPORT::MPIU_REAL
297: !DEC$ ATTRIBUTES DLLEXPORT::MPIU_SCALAR
298: !DEC$ ATTRIBUTES DLLEXPORT::MPIU_SUM
299: #endif
300: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_PI
301: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_MAX_REAL
302: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_MIN_REAL
303: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_MACHINE_EPSILON
304: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_SQRT_MACHINE_EPSILON
305: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_SMALL
306: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_INFINITY
307: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_NINFINITY
308: #endif
309: end module
311: subroutine PetscSetCOMM(c1,c2)
312: use petscsys
313: implicit none
314: MPI_Comm c1,c2
316: PETSC_COMM_WORLD = c1
317: PETSC_COMM_SELF = c2
318: return
319: end
321: subroutine PetscGetCOMM(c1)
322: use petscsys
323: implicit none
324: MPI_Comm c1
326: c1 = PETSC_COMM_WORLD
327: return
328: end
330: subroutine PetscSetModuleBlock()
331: use petscsys
332: implicit none
334: call PetscSetFortranBasePointers(PETSC_NULL_CHARACTER, &
335: & PETSC_NULL_INTEGER,PETSC_NULL_SCALAR, &
336: & PETSC_NULL_DOUBLE,PETSC_NULL_REAL, &
337: & PETSC_NULL_BOOL,PETSC_NULL_FUNCTION)
339: return
340: end
342: #if defined(PETSC_USE_REAL___FLOAT128)
343: subroutine PetscSetModuleBlockMPI(freal,fscalar,fsum)
344: use petscsys
345: implicit none
347: integer freal,fscalar,fsum
349: MPIU_REAL = freal
350: MPIU_SCALAR = fscalar
351: MPIU_SUM = fsum
352: return
353: end
354: #endif
356: subroutine PetscSetModuleBlockNumeric(pi,maxreal,minreal,eps, &
357: & seps,small,pinf,pninf)
358: use petscsys
359: implicit none
361: PetscReal pi,maxreal,minreal,eps,seps
362: PetscReal small,pinf,pninf
364: PETSC_PI = pi
365: PETSC_MAX_REAL = maxreal
366: PETSC_MIN_REAL = minreal
367: PETSC_MACHINE_EPSILON = eps
368: PETSC_SQRT_MACHINE_EPSILON = seps
369: PETSC_SMALL = small
370: PETSC_INFINITY = pinf
371: PETSC_NINFINITY = pninf
373: return
374: end
377: block data PetscCommInit
378: implicit none
379: !
380: ! this code is duplicated - because including ../src/sys/f90-mod/petscsys.h here
381: ! gives compile errors.
382: !
383: MPI_Comm PETSC_COMM_WORLD
384: MPI_Comm PETSC_COMM_SELF
385: common /petscfortran9/ PETSC_COMM_WORLD
386: common /petscfortran10/ PETSC_COMM_SELF
387: data PETSC_COMM_WORLD /0/
388: data PETSC_COMM_SELF /0/
389: end
390: