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