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/petscviewer.h90>
51: #include <../src/sys/f90-mod/petscbag.h>
52: #include <../src/sys/f90-mod/petscerror.h>
53: #include <../src/sys/f90-mod/petsclog.h>
54: end module petscsysdefdummy
56: module petscsysdef
57: use petscsysdefdummy
58: interface operator(.ne.)
59: function petscviewernotequal(A,B)
60: import tPetscViewer
61: logical petscviewernotequal
62: type(tPetscViewer), intent(in) :: A,B
63: end function
64: end interface operator (.ne.)
65: interface operator(.eq.)
66: function petscviewerequals(A,B)
67: import tPetscViewer
68: logical petscviewerequals
69: type(tPetscViewer), intent(in) :: A,B
70: end function
71: end interface operator (.eq.)
73: interface operator(.ne.)
74: function petscrandomnotequal(A,B)
75: import tPetscRandom
76: logical petscrandomnotequal
77: type(tPetscRandom), intent(in) :: A,B
78: end function
79: end interface operator (.ne.)
80: interface operator(.eq.)
81: function petscrandomequals(A,B)
82: import tPetscRandom
83: logical petscrandomequals
84: type(tPetscRandom), intent(in) :: A,B
85: end function
86: end interface operator (.eq.)
88: Interface petscbinaryread
89: subroutine petscbinaryreadcomplex(fd,data,num,count,type,z)
90: integer fd
91: PetscComplex data(*)
92: PetscInt num
93: PetscInt count
94: PetscDataType type
95: PetscErrorCode z
96: end subroutine
97: subroutine petscbinaryreadreal(fd,data,num,count,type,z)
98: integer fd
99: PetscReal data(*)
100: PetscInt num
101: PetscInt count
102: PetscDataType type
103: PetscErrorCode z
104: end subroutine
105: subroutine petscbinaryreadint(fd,data,num,count,type,z)
106: integer fd
107: PetscInt data(*)
108: PetscInt num
109: PetscInt count
110: PetscDataType type
111: PetscErrorCode z
112: end subroutine
113: subroutine petscbinaryreadcomplex1(fd,data,num,count,type,z)
114: integer fd
115: PetscComplex data
116: PetscInt num
117: PetscInt count
118: PetscDataType type
119: PetscErrorCode z
120: end subroutine
121: subroutine petscbinaryreadreal1(fd,data,num,count,type,z)
122: integer fd
123: PetscReal data
124: PetscInt num
125: PetscInt count
126: PetscDataType type
127: PetscErrorCode z
128: end subroutine
129: subroutine petscbinaryreadint1(fd,data,num,count,type,z)
130: integer fd
131: PetscInt data
132: PetscInt num
133: PetscInt count
134: PetscDataType type
135: PetscErrorCode z
136: end subroutine
137: subroutine petscbinaryreadcomplexcnt(fd,data,num,count,type,z)
138: integer fd
139: PetscComplex data(*)
140: PetscInt num
141: PetscInt count(1)
142: PetscDataType type
143: PetscErrorCode z
144: end subroutine
145: subroutine petscbinaryreadrealcnt(fd,data,num,count,type,z)
146: integer fd
147: PetscReal data(*)
148: PetscInt num
149: PetscInt count(1)
150: PetscDataType type
151: PetscErrorCode z
152: end subroutine
153: subroutine petscbinaryreadintcnt(fd,data,num,count,type,z)
154: integer fd
155: PetscInt data(*)
156: PetscInt num
157: PetscInt count(1)
158: PetscDataType type
159: PetscErrorCode z
160: end subroutine
161: subroutine petscbinaryreadcomplex1cnt(fd,data,num,count,type,z)
162: integer fd
163: PetscComplex data
164: PetscInt num
165: PetscInt count(1)
166: PetscDataType type
167: PetscErrorCode z
168: end subroutine
169: subroutine petscbinaryreadreal1cnt(fd,data,num,count,type,z)
170: integer fd
171: PetscReal data
172: PetscInt num
173: PetscInt count(1)
174: PetscDataType type
175: PetscErrorCode z
176: end subroutine
177: subroutine petscbinaryreadint1cnt(fd,data,num,count,type,z)
178: integer fd
179: PetscInt data
180: PetscInt num
181: PetscInt count(1)
182: PetscDataType type
183: PetscErrorCode z
184: end subroutine
185: end Interface
187: Interface petscbinarywrite
188: subroutine petscbinarywritecomplex(fd,data,num,type,z)
189: integer fd
190: PetscComplex data(*)
191: PetscInt num
192: PetscDataType type
193: PetscErrorCode z
194: end subroutine
195: subroutine petscbinarywritereal(fd,data,num,type,z)
196: integer fd
197: PetscReal data(*)
198: PetscInt num
199: PetscDataType type
200: PetscErrorCode z
201: end subroutine
202: subroutine petscbinarywriteint(fd,data,num,type,z)
203: integer fd
204: PetscInt data(*)
205: PetscInt num
206: PetscDataType type
207: PetscErrorCode z
208: end subroutine
209: subroutine petscbinarywritecomplex1(fd,data,num,type,z)
210: integer fd
211: PetscComplex data
212: PetscInt num
213: PetscDataType type
214: PetscErrorCode z
215: end subroutine
216: subroutine petscbinarywritereal1(fd,data,num,type,z)
217: integer fd
218: PetscReal data
219: PetscInt num
220: PetscDataType type
221: PetscErrorCode z
222: end subroutine
223: subroutine petscbinarywriteint1(fd,data,num,type,z)
224: integer fd
225: PetscInt data
226: PetscInt num
227: PetscDataType type
228: PetscErrorCode z
229: end subroutine
230: end Interface
232: Interface petscintview
233: subroutine petscintview(N,idx,viewer,ierr)
234: use petscsysdefdummy, only: tPetscViewer
235: PetscInt N
236: PetscInt idx(*)
237: PetscViewer viewer
238: PetscErrorCode ierr
239: end subroutine
240: end Interface
242: Interface petscscalarview
243: subroutine petscscalarview(N,s,viewer,ierr)
244: use petscsysdefdummy, only: tPetscViewer
245: PetscInt N
246: PetscScalar s(*)
247: PetscViewer viewer
248: PetscErrorCode ierr
249: end subroutine
250: end Interface
252: Interface petscrealview
253: subroutine petscrealview(N,s,viewer,ierr)
254: use petscsysdefdummy, only: tPetscViewer
255: PetscInt N
256: PetscReal s(*)
257: PetscViewer viewer
258: PetscErrorCode ierr
259: end subroutine
260: end Interface
262: end module
264: function petscviewernotequal(A,B)
265: use petscsysdefdummy, only: tPetscViewer
266: logical petscviewernotequal
267: type(tPetscViewer), intent(in) :: A,B
268: petscviewernotequal = (A%v .ne. B%v)
269: end function
270: function petscviewerequals(A,B)
271: use petscsysdefdummy, only: tPetscViewer
272: logical petscviewerequals
273: type(tPetscViewer), intent(in) :: A,B
274: petscviewerequals = (A%v .eq. B%v)
275: end function
277: function petscrandomnotequal(A,B)
278: use petscsysdefdummy, only: tPetscRandom
279: logical petscrandomnotequal
280: type(tPetscRandom), intent(in) :: A,B
281: petscrandomnotequal = (A%v .ne. B%v)
282: end function
283: function petscrandomequals(A,B)
284: use petscsysdefdummy, only: tPetscRandom
285: logical petscrandomequals
286: type(tPetscRandom), intent(in) :: A,B
287: petscrandomequals = (A%v .eq. B%v)
288: end function
289: #if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
290: !DEC$ ATTRIBUTES DLLEXPORT::petscviewernotequal
291: !DEC$ ATTRIBUTES DLLEXPORT::petscviewerequals
292: !DEC$ ATTRIBUTES DLLEXPORT::petscrandomnotequal
293: !DEC$ ATTRIBUTES DLLEXPORT::petscrandomequals
294: #endif
295: module petscsys
296: use,intrinsic :: iso_c_binding
297: use petscsysdef
298: PetscChar(80) PETSC_NULL_CHARACTER = ''
299: PetscInt PETSC_NULL_INTEGER(1)
300: PetscFortranDouble PETSC_NULL_DOUBLE(1)
301: PetscScalar PETSC_NULL_SCALAR(1)
302: PetscReal PETSC_NULL_REAL(1)
303: PetscBool PETSC_NULL_BOOL
304: MPI_Comm PETSC_NULL_MPI_COMM(1)
305: !
306: !
307: !
308: !
309: ! Basic math constants
310: !
311: PetscReal PETSC_PI
312: PetscReal PETSC_MAX_REAL
313: PetscReal PETSC_MIN_REAL
314: PetscReal PETSC_MACHINE_EPSILON
315: PetscReal PETSC_SQRT_MACHINE_EPSILON
316: PetscReal PETSC_SMALL
317: PetscReal PETSC_INFINITY
318: PetscReal PETSC_NINFINITY
320: #if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
321: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_CHARACTER
322: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_INTEGER
323: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_DOUBLE
324: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_SCALAR
325: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_REAL
326: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_BOOL
327: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_MPI_COMM
328: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_PI
329: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_MAX_REAL
330: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_MIN_REAL
331: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_MACHINE_EPSILON
332: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_SQRT_MACHINE_EPSILON
333: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_SMALL
334: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_INFINITY
335: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_NINFINITY
336: #endif
338: #include <../src/sys/f90-mod/petscsys.h90>
339: interface
340: #include <../src/sys/f90-mod/ftn-auto-interfaces/petscsys.h90>
341: end interface
342: interface PetscInitialize
343: module procedure PetscInitializeWithHelp, PetscInitializeNoHelp, PetscInitializeNoArguments
344: end interface
346: contains
347: #if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
348: !DEC$ ATTRIBUTES DLLEXPORT::PetscInitializeWithHelp
349: #endif
350: subroutine PetscInitializeWithHelp(filename,help,ierr)
351: character(len=*) :: filename
352: character(len=*) :: help
353: PetscErrorCode :: ierr
355: if (filename .ne. PETSC_NULL_CHARACTER) then
356: call PetscInitializeF(trim(filename),help,PETSC_TRUE,ierr)
357: CHKERRQ(ierr)
358: else
359: call PetscInitializeF(filename,help,PETSC_TRUE,ierr)
360: CHKERRQ(ierr)
361: endif
362: end subroutine PetscInitializeWithHelp
364: #if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
365: !DEC$ ATTRIBUTES DLLEXPORT::PetscInitializeNoHelp
366: #endif
367: subroutine PetscInitializeNoHelp(filename,ierr)
368: character(len=*) :: filename
369: PetscErrorCode :: ierr
371: if (filename .ne. PETSC_NULL_CHARACTER) then
372: call PetscInitializeF(trim(filename),PETSC_NULL_CHARACTER,PETSC_TRUE,ierr)
373: CHKERRQ(ierr)
374: else
375: call PetscInitializeF(filename,PETSC_NULL_CHARACTER,PETSC_TRUE,ierr)
376: CHKERRQ(ierr)
377: endif
378: end subroutine PetscInitializeNoHelp
380: #if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
381: !DEC$ ATTRIBUTES DLLEXPORT::PetscInitializeNoArguments
382: #endif
383: subroutine PetscInitializeNoArguments(ierr)
384: PetscErrorCode :: ierr
386: call PetscInitializeF(PETSC_NULL_CHARACTER,PETSC_NULL_CHARACTER,PETSC_TRUE,ierr)
387: CHKERRQ(ierr)
388: end subroutine PetscInitializeNoArguments
389: end module
391: subroutine PetscSetCOMM(c1,c2)
392: use petscmpi, only: PETSC_COMM_WORLD,PETSC_COMM_SELF
394: implicit none
395: MPI_Comm c1,c2
397: PETSC_COMM_WORLD = c1
398: PETSC_COMM_SELF = c2
399: return
400: end
402: subroutine PetscGetCOMM(c1)
403: use petscmpi, only: PETSC_COMM_WORLD
404: implicit none
405: MPI_Comm c1
407: c1 = PETSC_COMM_WORLD
408: return
409: end
411: subroutine PetscSetModuleBlock()
412: use petscsys, only: PETSC_NULL_CHARACTER,PETSC_NULL_INTEGER,&
413: PETSC_NULL_SCALAR,PETSC_NULL_DOUBLE,PETSC_NULL_REAL,&
414: PETSC_NULL_BOOL,PETSC_NULL_FUNCTION,PETSC_NULL_MPI_COMM
415: implicit none
417: call PetscSetFortranBasePointers(PETSC_NULL_CHARACTER, &
418: & PETSC_NULL_INTEGER,PETSC_NULL_SCALAR, &
419: & PETSC_NULL_DOUBLE,PETSC_NULL_REAL, &
420: & PETSC_NULL_BOOL,PETSC_NULL_FUNCTION,PETSC_NULL_MPI_COMM)
422: return
423: end
425: subroutine PetscSetModuleBlockMPI(freal,fscalar,fsum,finteger)
426: use petscmpi, only: MPIU_REAL,MPIU_SUM,MPIU_SCALAR,MPIU_INTEGER
427: implicit none
429: integer4 freal,fscalar,fsum,finteger
431: MPIU_REAL = freal
432: MPIU_SCALAR = fscalar
433: MPIU_SUM = fsum
434: MPIU_INTEGER = finteger
436: return
437: end
439: subroutine PetscSetModuleBlockNumeric(pi,maxreal,minreal,eps, &
440: & seps,small,pinf,pninf)
441: use petscsys, only: PETSC_PI,PETSC_MAX_REAL,PETSC_MIN_REAL,&
442: PETSC_MACHINE_EPSILON,PETSC_SQRT_MACHINE_EPSILON,&
443: PETSC_SMALL,PETSC_INFINITY,PETSC_NINFINITY
444: implicit none
446: PetscReal pi,maxreal,minreal,eps,seps
447: PetscReal small,pinf,pninf
449: PETSC_PI = pi
450: PETSC_MAX_REAL = maxreal
451: PETSC_MIN_REAL = minreal
452: PETSC_MACHINE_EPSILON = eps
453: PETSC_SQRT_MACHINE_EPSILON = seps
454: PETSC_SMALL = small
455: PETSC_INFINITY = pinf
456: PETSC_NINFINITY = pninf
458: return
459: end