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