Actual source code: petscsysmod.F90
1: module petscmpi
2: #include <petscconf.h>
3: #include "petsc/finclude/petscsys.h"
4: #if defined(PETSC_HAVE_MPIUNI)
5: use mpiuni
6: #else
7: #if defined(PETSC_HAVE_MPI_F90MODULE)
8: use mpi
9: #else
10: #include "mpif.h"
11: #endif
12: #endif
14: public:: MPIU_REAL, MPIU_SUM, MPIU_SCALAR, MPIU_INTEGER
15: public:: PETSC_COMM_WORLD, PETSC_COMM_SELF
17: ! ----------------------------------------------------------------------------
18: ! BEGIN PETSc aliases for MPI_ constants
19: !
20: ! These values for __float128 are handled in the common block (below)
21: ! and transmitted from the C code
22: !
23: integer4 :: MPIU_REAL
24: integer4 :: MPIU_SUM
25: integer4 :: MPIU_SCALAR
26: integer4 :: MPIU_INTEGER
28: MPI_Comm::PETSC_COMM_WORLD=0
29: MPI_Comm::PETSC_COMM_SELF=0
31: #if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
32: !DEC$ ATTRIBUTES DLLEXPORT::MPIU_REAL
33: !DEC$ ATTRIBUTES DLLEXPORT::MPIU_SUM
34: !DEC$ ATTRIBUTES DLLEXPORT::MPIU_SCALAR
35: !DEC$ ATTRIBUTES DLLEXPORT::MPIU_INTEGER
36: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_COMM_SELF
37: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_COMM_WORLD
38: #endif
39: end module
41: module petscsysdefdummy
42: #if defined(PETSC_HAVE_MPI_F90MODULE_VISIBILITY)
43: use petscmpi
44: #else
45: use petscmpi, only: MPIU_REAL,MPIU_SUM,MPIU_SCALAR,MPIU_INTEGER,PETSC_COMM_WORLD,PETSC_COMM_SELF
46: #endif
47: #include <../src/sys/f90-mod/petscsys.h>
48: #include <../src/sys/f90-mod/petscdraw.h>
49: #include <../src/sys/f90-mod/petscviewer.h>
50: #include <../src/sys/f90-mod/petscbag.h>
51: #include <../src/sys/f90-mod/petscerror.h>
52: #include <../src/sys/f90-mod/petsclog.h>
53: end module petscsysdefdummy
55: module petscsysdef
56: use petscsysdefdummy
57: interface operator(.ne.)
58: function petscviewernotequal(A,B)
59: import tPetscViewer
60: logical petscviewernotequal
61: type(tPetscViewer), intent(in) :: A,B
62: end function
63: end interface operator (.ne.)
64: interface operator(.eq.)
65: function petscviewerequals(A,B)
66: import tPetscViewer
67: logical petscviewerequals
68: type(tPetscViewer), intent(in) :: A,B
69: end function
70: end interface operator (.eq.)
72: interface operator(.ne.)
73: function petscrandomnotequal(A,B)
74: import tPetscRandom
75: logical petscrandomnotequal
76: type(tPetscRandom), intent(in) :: A,B
77: end function
78: end interface operator (.ne.)
79: interface operator(.eq.)
80: function petscrandomequals(A,B)
81: import tPetscRandom
82: logical petscrandomequals
83: type(tPetscRandom), intent(in) :: A,B
84: end function
85: end interface operator (.eq.)
87: Interface petscbinaryread
88: subroutine petscbinaryreadcomplex(fd,data,num,count,type,z)
89: integer fd
90: PetscComplex data(*)
91: PetscInt num
92: PetscInt count
93: PetscDataType type
94: PetscErrorCode z
95: end subroutine
96: subroutine petscbinaryreadreal(fd,data,num,count,type,z)
97: integer fd
98: PetscReal data(*)
99: PetscInt num
100: PetscInt count
101: PetscDataType type
102: PetscErrorCode z
103: end subroutine
104: subroutine petscbinaryreadint(fd,data,num,count,type,z)
105: integer fd
106: PetscInt data(*)
107: PetscInt num
108: PetscInt count
109: PetscDataType type
110: PetscErrorCode z
111: end subroutine
112: subroutine petscbinaryreadcomplex1(fd,data,num,count,type,z)
113: integer fd
114: PetscComplex data
115: PetscInt num
116: PetscInt count
117: PetscDataType type
118: PetscErrorCode z
119: end subroutine
120: subroutine petscbinaryreadreal1(fd,data,num,count,type,z)
121: integer fd
122: PetscReal data
123: PetscInt num
124: PetscInt count
125: PetscDataType type
126: PetscErrorCode z
127: end subroutine
128: subroutine petscbinaryreadint1(fd,data,num,count,type,z)
129: integer fd
130: PetscInt data
131: PetscInt num
132: PetscInt count
133: PetscDataType type
134: PetscErrorCode z
135: end subroutine
136: subroutine petscbinaryreadcomplexcnt(fd,data,num,count,type,z)
137: integer fd
138: PetscComplex data(*)
139: PetscInt num
140: PetscInt count(1)
141: PetscDataType type
142: PetscErrorCode z
143: end subroutine
144: subroutine petscbinaryreadrealcnt(fd,data,num,count,type,z)
145: integer fd
146: PetscReal data(*)
147: PetscInt num
148: PetscInt count(1)
149: PetscDataType type
150: PetscErrorCode z
151: end subroutine
152: subroutine petscbinaryreadintcnt(fd,data,num,count,type,z)
153: integer fd
154: PetscInt data(*)
155: PetscInt num
156: PetscInt count(1)
157: PetscDataType type
158: PetscErrorCode z
159: end subroutine
160: subroutine petscbinaryreadcomplex1cnt(fd,data,num,count,type,z)
161: integer fd
162: PetscComplex data
163: PetscInt num
164: PetscInt count(1)
165: PetscDataType type
166: PetscErrorCode z
167: end subroutine
168: subroutine petscbinaryreadreal1cnt(fd,data,num,count,type,z)
169: integer fd
170: PetscReal data
171: PetscInt num
172: PetscInt count(1)
173: PetscDataType type
174: PetscErrorCode z
175: end subroutine
176: subroutine petscbinaryreadint1cnt(fd,data,num,count,type,z)
177: integer fd
178: PetscInt data
179: PetscInt num
180: PetscInt count(1)
181: PetscDataType type
182: PetscErrorCode z
183: end subroutine
184: end Interface
186: Interface petscbinarywrite
187: subroutine petscbinarywritecomplex(fd,data,num,type,z)
188: integer fd
189: PetscComplex data(*)
190: PetscInt num
191: PetscDataType type
192: PetscErrorCode z
193: end subroutine
194: subroutine petscbinarywritereal(fd,data,num,type,z)
195: integer fd
196: PetscReal data(*)
197: PetscInt num
198: PetscDataType type
199: PetscErrorCode z
200: end subroutine
201: subroutine petscbinarywriteint(fd,data,num,type,z)
202: integer fd
203: PetscInt data(*)
204: PetscInt num
205: PetscDataType type
206: PetscErrorCode z
207: end subroutine
208: subroutine petscbinarywritecomplex1(fd,data,num,type,z)
209: integer fd
210: PetscComplex data
211: PetscInt num
212: PetscDataType type
213: PetscErrorCode z
214: end subroutine
215: subroutine petscbinarywritereal1(fd,data,num,type,z)
216: integer fd
217: PetscReal data
218: PetscInt num
219: PetscDataType type
220: PetscErrorCode z
221: end subroutine
222: subroutine petscbinarywriteint1(fd,data,num,type,z)
223: integer fd
224: PetscInt data
225: PetscInt num
226: PetscDataType type
227: PetscErrorCode z
228: end subroutine
229: end Interface
231: Interface petscintview
232: subroutine petscintview(N,idx,viewer,ierr)
233: use petscsysdefdummy, only: tPetscViewer
234: PetscInt N
235: PetscInt idx(*)
236: PetscViewer viewer
237: PetscErrorCode ierr
238: end subroutine
239: end Interface
241: Interface petscscalarview
242: subroutine petscscalarview(N,s,viewer,ierr)
243: use petscsysdefdummy, only: tPetscViewer
244: PetscInt N
245: PetscScalar s(*)
246: PetscViewer viewer
247: PetscErrorCode ierr
248: end subroutine
249: end Interface
251: Interface petscrealview
252: subroutine petscrealview(N,s,viewer,ierr)
253: use petscsysdefdummy, only: tPetscViewer
254: PetscInt N
255: PetscReal s(*)
256: PetscViewer viewer
257: PetscErrorCode ierr
258: end subroutine
259: end Interface
261: end module
263: function petscviewernotequal(A,B)
264: use petscsysdefdummy, only: tPetscViewer
265: logical petscviewernotequal
266: type(tPetscViewer), intent(in) :: A,B
267: petscviewernotequal = (A%v .ne. B%v)
268: end function
269: function petscviewerequals(A,B)
270: use petscsysdefdummy, only: tPetscViewer
271: logical petscviewerequals
272: type(tPetscViewer), intent(in) :: A,B
273: petscviewerequals = (A%v .eq. B%v)
274: end function
276: function petscrandomnotequal(A,B)
277: use petscsysdefdummy, only: tPetscRandom
278: logical petscrandomnotequal
279: type(tPetscRandom), intent(in) :: A,B
280: petscrandomnotequal = (A%v .ne. B%v)
281: end function
282: function petscrandomequals(A,B)
283: use petscsysdefdummy, only: tPetscRandom
284: logical petscrandomequals
285: type(tPetscRandom), intent(in) :: A,B
286: petscrandomequals = (A%v .eq. B%v)
287: end function
288: #if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
289: !DEC$ ATTRIBUTES DLLEXPORT::petscviewernotequal
290: !DEC$ ATTRIBUTES DLLEXPORT::petscviewerequals
291: !DEC$ ATTRIBUTES DLLEXPORT::petscrandomnotequal
292: !DEC$ ATTRIBUTES DLLEXPORT::petscrandomequals
293: #endif
294: module petscsys
295: use,intrinsic :: iso_c_binding
296: use petscsysdef
297: PetscChar(80) PETSC_NULL_CHARACTER = ''
298: PetscInt PETSC_NULL_INTEGER(1)
299: PetscFortranDouble PETSC_NULL_DOUBLE(1)
300: PetscScalar PETSC_NULL_SCALAR(1)
301: PetscReal PETSC_NULL_REAL(1)
302: PetscBool PETSC_NULL_BOOL
303: MPI_Comm PETSC_NULL_MPI_COMM(1)
304: !
305: !
306: !
307: !
308: ! Basic math constants
309: !
310: PetscReal PETSC_PI
311: PetscReal PETSC_MAX_REAL
312: PetscReal PETSC_MIN_REAL
313: PetscReal PETSC_MACHINE_EPSILON
314: PetscReal PETSC_SQRT_MACHINE_EPSILON
315: PetscReal PETSC_SMALL
316: PetscReal PETSC_INFINITY
317: PetscReal PETSC_NINFINITY
319: #if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
320: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_CHARACTER
321: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_INTEGER
322: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_DOUBLE
323: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_SCALAR
324: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_REAL
325: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_BOOL
326: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_MPI_COMM
327: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_PI
328: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_MAX_REAL
329: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_MIN_REAL
330: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_MACHINE_EPSILON
331: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_SQRT_MACHINE_EPSILON
332: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_SMALL
333: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_INFINITY
334: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_NINFINITY
335: #endif
337: #include <../src/sys/f90-mod/petscsys.h90>
338: interface
339: #include <../src/sys/f90-mod/ftn-auto-interfaces/petscsys.h90>
340: end interface
341: interface PetscInitialize
342: module procedure PetscInitializeWithHelp, PetscInitializeNoHelp, PetscInitializeNoArguments
343: end interface
345: contains
346: #if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
347: !DEC$ ATTRIBUTES DLLEXPORT::PetscInitializeWithHelp
348: #endif
349: subroutine PetscInitializeWithHelp(filename,help,ierr)
350: character(len=*) :: filename
351: character(len=*) :: help
352: PetscErrorCode :: ierr
354: if (filename .ne. PETSC_NULL_CHARACTER) then
355: call PetscInitializeF(trim(filename),help,PETSC_TRUE,ierr)
356: CHKERRQ(ierr)
357: else
358: call PetscInitializeF(filename,help,PETSC_TRUE,ierr)
359: CHKERRQ(ierr)
360: endif
361: end subroutine PetscInitializeWithHelp
363: #if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
364: !DEC$ ATTRIBUTES DLLEXPORT::PetscInitializeNoHelp
365: #endif
366: subroutine PetscInitializeNoHelp(filename,ierr)
367: character(len=*) :: filename
368: PetscErrorCode :: ierr
370: if (filename .ne. PETSC_NULL_CHARACTER) then
371: call PetscInitializeF(trim(filename),PETSC_NULL_CHARACTER,PETSC_TRUE,ierr)
372: CHKERRQ(ierr)
373: else
374: call PetscInitializeF(filename,PETSC_NULL_CHARACTER,PETSC_TRUE,ierr)
375: CHKERRQ(ierr)
376: endif
377: end subroutine PetscInitializeNoHelp
379: #if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
380: !DEC$ ATTRIBUTES DLLEXPORT::PetscInitializeNoArguments
381: #endif
382: subroutine PetscInitializeNoArguments(ierr)
383: PetscErrorCode :: ierr
385: call PetscInitializeF(PETSC_NULL_CHARACTER,PETSC_NULL_CHARACTER,PETSC_TRUE,ierr)
386: CHKERRQ(ierr)
387: end subroutine PetscInitializeNoArguments
388: end module
390: subroutine PetscSetCOMM(c1,c2)
391: use petscmpi, only: PETSC_COMM_WORLD,PETSC_COMM_SELF
393: implicit none
394: MPI_Comm c1,c2
396: PETSC_COMM_WORLD = c1
397: PETSC_COMM_SELF = c2
398: return
399: end
401: subroutine PetscGetCOMM(c1)
402: use petscmpi, only: PETSC_COMM_WORLD
403: implicit none
404: MPI_Comm c1
406: c1 = PETSC_COMM_WORLD
407: return
408: end
410: subroutine PetscSetModuleBlock()
411: use petscsys, only: PETSC_NULL_CHARACTER,PETSC_NULL_INTEGER,&
412: PETSC_NULL_SCALAR,PETSC_NULL_DOUBLE,PETSC_NULL_REAL,&
413: PETSC_NULL_BOOL,PETSC_NULL_FUNCTION,PETSC_NULL_MPI_COMM
414: implicit none
416: call PetscSetFortranBasePointers(PETSC_NULL_CHARACTER, &
417: & PETSC_NULL_INTEGER,PETSC_NULL_SCALAR, &
418: & PETSC_NULL_DOUBLE,PETSC_NULL_REAL, &
419: & PETSC_NULL_BOOL,PETSC_NULL_FUNCTION,PETSC_NULL_MPI_COMM)
421: return
422: end
424: subroutine PetscSetModuleBlockMPI(freal,fscalar,fsum,finteger)
425: use petscmpi, only: MPIU_REAL,MPIU_SUM,MPIU_SCALAR,MPIU_INTEGER
426: implicit none
428: integer4 freal,fscalar,fsum,finteger
430: MPIU_REAL = freal
431: MPIU_SCALAR = fscalar
432: MPIU_SUM = fsum
433: MPIU_INTEGER = finteger
435: return
436: end
438: subroutine PetscSetModuleBlockNumeric(pi,maxreal,minreal,eps, &
439: & seps,small,pinf,pninf)
440: use petscsys, only: PETSC_PI,PETSC_MAX_REAL,PETSC_MIN_REAL,&
441: PETSC_MACHINE_EPSILON,PETSC_SQRT_MACHINE_EPSILON,&
442: PETSC_SMALL,PETSC_INFINITY,PETSC_NINFINITY
443: implicit none
445: PetscReal pi,maxreal,minreal,eps,seps
446: PetscReal small,pinf,pninf
448: PETSC_PI = pi
449: PETSC_MAX_REAL = maxreal
450: PETSC_MIN_REAL = minreal
451: PETSC_MACHINE_EPSILON = eps
452: PETSC_SQRT_MACHINE_EPSILON = seps
453: PETSC_SMALL = small
454: PETSC_INFINITY = pinf
455: PETSC_NINFINITY = pninf
457: return
458: end