Actual source code: petscsysmod.F90

  1: module petscmpi
  2:   use, intrinsic :: ISO_C_binding
  3: #include <petscconf.h>
  4: #include "petsc/finclude/petscsys.h"
  5: #if defined(PETSC_HAVE_MPIUNI)
  6:   use mpiuni
  7: #else
  8: #if defined(PETSC_HAVE_MPI_FTN_MODULE)
  9:   use PETSC_MPI_FTN_MODULE
 10: #else
 11: #include "mpif.h"
 12: #endif
 13: #endif

 15:   MPIU_Datatype :: MPIU_REAL
 16:   MPIU_Datatype :: MPIU_SCALAR
 17:   MPIU_Datatype :: MPIU_INTEGER
 18:   MPIU_Op :: MPIU_SUM

 20: ! MPI_C_BOOL is an MPI-2.2 C datatype that some MPIs (e.g. MS-MPI) do not expose to Fortran.
 21: ! When configure finds it missing from the Fortran bindings, declare it as a module variable
 22: ! populated at PetscInitialize() from C via MPI_Type_c2f(MPI_C_BOOL).
 23: #if !defined(PETSC_HAVE_MPI_C_BOOL_FORTRAN)
 24:   MPIU_Datatype :: MPI_C_BOOL
 25: #endif

 27:   MPIU_Comm:: PETSC_COMM_WORLD
 28:   MPIU_Comm:: PETSC_COMM_SELF

 30: #if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
 31: !DEC$ ATTRIBUTES DLLEXPORT::MPIU_REAL
 32: !DEC$ ATTRIBUTES DLLEXPORT::MPIU_SUM
 33: !DEC$ ATTRIBUTES DLLEXPORT::MPIU_SCALAR
 34: !DEC$ ATTRIBUTES DLLEXPORT::MPIU_INTEGER
 35: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_COMM_SELF
 36: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_COMM_WORLD
 37: #if !defined(PETSC_HAVE_MPI_C_BOOL_FORTRAN)
 38: !DEC$ ATTRIBUTES DLLEXPORT::MPI_C_BOOL
 39: #endif
 40: #endif
 41: end module petscmpi

 43: module petscsysdef
 44:   use, intrinsic :: ISO_C_binding
 45:   use petscmpi
 46:   PetscReal, parameter :: PetscReal_Private = 1.0
 47:   integer, parameter   :: PETSC_REAL_KIND = kind(PetscReal_Private)

 49:   PetscScalar, parameter :: PetscScalar_Private = (1.0, 0.0)
 50:   integer, parameter   :: PETSC_SCALAR_KIND = kind(PetscScalar_Private)

 52:   PetscInt, parameter :: PetscInt_Private = 1
 53:   integer, parameter   :: PETSC_INT_KIND = kind(PetscInt_Private)

 55:   PetscMPIInt, parameter :: PetscMPIInt_Private = 1
 56:   integer, parameter   :: PETSC_MPIINT_KIND = kind(PetscMPIInt_Private)

 58:   PetscBool, parameter :: PETSC_TRUE = .true._C_BOOL
 59:   PetscBool, parameter :: PETSC_FALSE = .false._C_BOOL

 61:   PetscInt, parameter :: PETSC_DECIDE = -1
 62:   PetscInt, parameter :: PETSC_DECIDE_INTEGER = -1_PETSC_INT_KIND
 63:   PetscReal, parameter :: PETSC_DECIDE_REAL = -1.0_PETSC_REAL_KIND
 64: #if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
 65: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_DECIDE
 66: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_DECIDE_INTEGER
 67: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_DECIDE_REAL
 68: #endif

 70:   PetscInt, parameter :: PETSC_DETERMINE = -1
 71:   PetscInt, parameter :: PETSC_DETERMINE_INTEGER = -1
 72:   PetscReal, parameter :: PETSC_DETERMINE_REAL = -1.0_PETSC_REAL_KIND
 73: #if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
 74: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_DETERMINE
 75: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_DETERMINE_INTEGER
 76: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_DETERMINE_REAL
 77: #endif

 79:   PetscInt, parameter :: PETSC_CURRENT = -2
 80:   PetscInt, parameter :: PETSC_CURRENT_INTEGER = -2
 81:   PetscReal, parameter :: PETSC_CURRENT_REAL = -2.0_PETSC_REAL_KIND
 82: #if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
 83: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_CURRENT
 84: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_CURRENT_INTEGER
 85: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_CURRENT_REAL
 86: #endif

 88:   PetscInt, parameter :: PETSC_DEFAULT = -2
 89:   PetscInt, parameter :: PETSC_DEFAULT_INTEGER = -2
 90:   PetscReal, parameter :: PETSC_DEFAULT_REAL = -2.0_PETSC_REAL_KIND
 91: #if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
 92: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_DEFAULT
 93: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_DEFAULT_INTEGER
 94: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_DEFAULT_REAL
 95: #endif

 97:   PetscFortranAddr, parameter :: PETSC_STDOUT = 0
 98: !
 99: !  PETSc DataTypes
100: !
101: #if defined(PETSC_USE_REAL_SINGLE)
102: #define PETSC_REAL PETSC_FLOAT
103: #elif defined(PETSC_USE_REAL___FLOAT128)
104: #define PETSC_REAL PETSC___FLOAT128
105: #else
106: #define PETSC_REAL PETSC_DOUBLE
107: #endif
108: #define PETSC_FORTRANADDR PETSC_LONG

110: ! PETSc mathematics include file. Defines certain basic mathematical
111: ! constants and functions for working with single and double precision
112: ! floating point numbers as well as complex and integers.
113: !
114: ! Representation of complex i
115:   PetscComplex, parameter :: PETSC_i = (0.0_PETSC_REAL_KIND, 1.0_PETSC_REAL_KIND)

117: ! A PETSC_NULL_FUNCTION pointer
118: !
119:   external PETSC_NULL_FUNCTION
120: !
121:   external PetscIsInfOrNanScalar
122:   external PetscIsInfOrNanReal
123:   PetscBool PetscIsInfOrNanScalar
124:   PetscBool PetscIsInfOrNanReal

126: #include <../ftn/sys/petscall.h>

128:   PetscViewer, parameter :: PETSC_VIEWER_STDOUT_SELF = tPetscViewer(9)
129:   PetscViewer, parameter :: PETSC_VIEWER_DRAW_WORLD = tPetscViewer(4)
130:   PetscViewer, parameter :: PETSC_VIEWER_DRAW_SELF = tPetscViewer(5)
131:   PetscViewer, parameter :: PETSC_VIEWER_SOCKET_WORLD = tPetscViewer(6)
132:   PetscViewer, parameter :: PETSC_VIEWER_SOCKET_SELF = tPetscViewer(7)
133:   PetscViewer, parameter :: PETSC_VIEWER_STDOUT_WORLD = tPetscViewer(8)
134:   PetscViewer, parameter :: PETSC_VIEWER_STDERR_WORLD = tPetscViewer(10)
135:   PetscViewer, parameter :: PETSC_VIEWER_STDERR_SELF = tPetscViewer(11)
136:   PetscViewer, parameter :: PETSC_VIEWER_BINARY_WORLD = tPetscViewer(12)
137:   PetscViewer, parameter :: PETSC_VIEWER_BINARY_SELF = tPetscViewer(13)
138:   PetscViewer, parameter :: PETSC_VIEWER_MATLAB_WORLD = tPetscViewer(14)
139:   PetscViewer, parameter :: PETSC_VIEWER_MATLAB_SELF = tPetscViewer(15)

141:   PetscViewer PETSC_VIEWER_STDOUT_
142:   PetscViewer PETSC_VIEWER_DRAW_
143:   external PETSC_VIEWER_STDOUT_
144:   external PETSC_VIEWER_DRAW_
145:   external PetscViewerAndFormatDestroy

147: #if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
148: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_VIEWER_STDOUT_SELF
149: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_VIEWER_DRAW_WORLD
150: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_VIEWER_DRAW_SELF
151: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_VIEWER_SOCKET_WORLD
152: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_VIEWER_SOCKET_SELF
153: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_VIEWER_STDOUT_WORLD
154: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_VIEWER_STDERR_WORLD
155: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_VIEWER_STDERR_SELF
156: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_VIEWER_BINARY_WORLD
157: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_VIEWER_BINARY_SELF
158: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_VIEWER_MATLAB_WORLD
159: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_VIEWER_MATLAB_SELF
160: #endif

162:   PetscErrorCode, parameter :: PETSC_ERR_MEM = 55
163:   PetscErrorCode, parameter :: PETSC_ERR_SUP = 56
164:   PetscErrorCode, parameter :: PETSC_ERR_SUP_SYS = 57
165:   PetscErrorCode, parameter :: PETSC_ERR_ORDER = 58
166:   PetscErrorCode, parameter :: PETSC_ERR_SIG = 59
167:   PetscErrorCode, parameter :: PETSC_ERR_FP = 72
168:   PetscErrorCode, parameter :: PETSC_ERR_COR = 74
169:   PetscErrorCode, parameter :: PETSC_ERR_LIB = 76
170:   PetscErrorCode, parameter :: PETSC_ERR_PLIB = 77
171:   PetscErrorCode, parameter :: PETSC_ERR_MEMC = 78
172:   PetscErrorCode, parameter :: PETSC_ERR_CONV_FAILED = 82
173:   PetscErrorCode, parameter :: PETSC_ERR_USER = 83
174:   PetscErrorCode, parameter :: PETSC_ERR_SYS = 88
175:   PetscErrorCode, parameter :: PETSC_ERR_POINTER = 70
176:   PetscErrorCode, parameter :: PETSC_ERR_MPI_LIB_INCOMP = 87

178:   PetscErrorCode, parameter :: PETSC_ERR_ARG_SIZ = 60
179:   PetscErrorCode, parameter :: PETSC_ERR_ARG_IDN = 61
180:   PetscErrorCode, parameter :: PETSC_ERR_ARG_WRONG = 62
181:   PetscErrorCode, parameter :: PETSC_ERR_ARG_CORRUPT = 64
182:   PetscErrorCode, parameter :: PETSC_ERR_ARG_OUTOFRANGE = 63
183:   PetscErrorCode, parameter :: PETSC_ERR_ARG_BADPTR = 68
184:   PetscErrorCode, parameter :: PETSC_ERR_ARG_NOTSAMETYPE = 69
185:   PetscErrorCode, parameter :: PETSC_ERR_ARG_NOTSAMECOMM = 80
186:   PetscErrorCode, parameter :: PETSC_ERR_ARG_WRONGSTATE = 73
187:   PetscErrorCode, parameter :: PETSC_ERR_ARG_TYPENOTSET = 89
188:   PetscErrorCode, parameter :: PETSC_ERR_ARG_INCOMP = 75
189:   PetscErrorCode, parameter :: PETSC_ERR_ARG_NULL = 85
190:   PetscErrorCode, parameter :: PETSC_ERR_ARG_UNKNOWN_TYPE = 86

192:   PetscErrorCode, parameter :: PETSC_ERR_FILE_OPEN = 65
193:   PetscErrorCode, parameter :: PETSC_ERR_FILE_READ = 66
194:   PetscErrorCode, parameter :: PETSC_ERR_FILE_WRITE = 67
195:   PetscErrorCode, parameter :: PETSC_ERR_FILE_UNEXPECTED = 79

197:   PetscErrorCode, parameter :: PETSC_ERR_MAT_LU_ZRPVT = 71
198:   PetscErrorCode, parameter :: PETSC_ERR_MAT_CH_ZRPVT = 81

200:   PetscErrorCode, parameter :: PETSC_ERR_INT_OVERFLOW = 84

202:   PetscErrorCode, parameter :: PETSC_ERR_FLOP_COUNT = 90
203:   PetscErrorCode, parameter :: PETSC_ERR_NOT_CONVERGED = 91
204:   PetscErrorCode, parameter :: PETSC_ERR_MISSING_FACTOR = 92
205:   PetscErrorCode, parameter :: PETSC_ERR_OPT_OVERWRITE = 93
206:   PetscErrorCode, parameter :: PETSC_ERR_WRONG_MPI_SIZE = 94
207:   PetscErrorCode, parameter :: PETSC_ERR_USER_INPUT = 95
208:   PetscErrorCode, parameter :: PETSC_ERR_GPU_RESOURCE = 96
209:   PetscErrorCode, parameter :: PETSC_ERR_GPU = 97
210:   PetscErrorCode, parameter :: PETSC_ERR_MPI = 98
211:   PetscErrorCode, parameter :: PETSC_ERR_RETURN = 99

213:   character(len=80) :: PETSC_NULL_CHARACTER = ''
214:   PetscInt PETSC_NULL_INTEGER, PETSC_NULL_INTEGER_ARRAY(1)
215:   PetscInt, pointer :: PETSC_NULL_INTEGER_POINTER(:)
216:   PetscScalar, pointer :: PETSC_NULL_SCALAR_POINTER(:)
217:   PetscFortranDouble PETSC_NULL_DOUBLE
218:   PetscScalar PETSC_NULL_SCALAR, PETSC_NULL_SCALAR_ARRAY(1)
219:   PetscReal PETSC_NULL_REAL, PETSC_NULL_REAL_ARRAY(1)
220:   PetscReal, pointer :: PETSC_NULL_REAL_POINTER(:)
221:   PetscBool PETSC_NULL_BOOL
222:   PetscEnum PETSC_NULL_ENUM
223:   MPIU_Comm PETSC_NULL_MPI_COMM
224: !
225: !     Basic math constants
226: !
227:   PetscReal PETSC_PI
228:   PetscReal PETSC_MAX_REAL
229:   PetscReal PETSC_MIN_REAL
230:   PetscReal PETSC_MACHINE_EPSILON
231:   PetscReal PETSC_SQRT_MACHINE_EPSILON
232:   PetscReal PETSC_SMALL
233:   PetscReal PETSC_INFINITY
234:   PetscReal PETSC_NINFINITY

236: #if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
237: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_CHARACTER
238: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_INTEGER
239: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_INTEGER_ARRAY
240: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_INTEGER_POINTER
241: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_SCALAR_POINTER
242: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_REAL_POINTER
243: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_DOUBLE
244: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_SCALAR
245: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_SCALAR_ARRAY
246: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_REAL
247: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_REAL_ARRAY
248: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_BOOL
249: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_ENUM
250: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_MPI_COMM
251: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_PI
252: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_MAX_REAL
253: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_MIN_REAL
254: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_MACHINE_EPSILON
255: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_SQRT_MACHINE_EPSILON
256: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_SMALL
257: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_INFINITY
258: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_NINFINITY
259: #endif

261:   type tPetscReal2d
262:     sequence
263:     PetscReal, dimension(:), pointer :: ptr
264:   end type tPetscReal2D

266: end module petscsysdef

268: module petscsys
269:   use, intrinsic :: ISO_C_binding
270:   use petscsysdef
271:   type(c_ptr) :: petscFtnCtx  ! used by automatically generated XXXGetContext() macros

273: #include <../src/sys/ftn-mod/petscsys.h90>
274: #include <../src/sys/ftn-mod/petscviewer.h90>
275: #include <../ftn/sys/petscall.h90>

277:   interface PetscInitialize
278:     module procedure PetscInitializeWithHelp, PetscInitializeNoHelp, PetscInitializeNoArguments
279:   end interface PetscInitialize

281:   interface
282:     subroutine PetscSetFortranBasePointers( &
283:       PETSC_NULL_CHARACTER, &
284:       PETSC_NULL_INTEGER, PETSC_NULL_SCALAR, &
285:       PETSC_NULL_DOUBLE, PETSC_NULL_REAL, &
286:       PETSC_NULL_BOOL, PETSC_NULL_ENUM, PETSC_NULL_FUNCTION, &
287:       PETSC_NULL_MPI_COMM, &
288:       PETSC_NULL_INTEGER_ARRAY, PETSC_NULL_SCALAR_ARRAY, &
289:       PETSC_NULL_REAL_ARRAY, APETSC_NULL_INTEGER_POINTER, &
290:       PETSC_NULL_SCALAR_POINTER, PETSC_NULL_REAL_POINTER)
291:       use, intrinsic :: ISO_C_binding
292:       use petscmpi
293:       character(*) PETSC_NULL_CHARACTER
294:       PetscInt PETSC_NULL_INTEGER
295:       PetscScalar PETSC_NULL_SCALAR
296:       PetscFortranDouble PETSC_NULL_DOUBLE
297:       PetscReal PETSC_NULL_REAL
298:       PetscBool PETSC_NULL_BOOL
299:       PetscEnum PETSC_NULL_ENUM
300:       external PETSC_NULL_FUNCTION
301:       MPIU_Comm PETSC_NULL_MPI_COMM
302:       PetscInt PETSC_NULL_INTEGER_ARRAY(*)
303:       PetscScalar PETSC_NULL_SCALAR_ARRAY(*)
304:       PetscReal PETSC_NULL_REAL_ARRAY(*)
305:       PetscInt, pointer :: APETSC_NULL_INTEGER_POINTER(:)
306:       PetscScalar, pointer :: PETSC_NULL_SCALAR_POINTER(:)
307:       PetscReal, pointer :: PETSC_NULL_REAL_POINTER(:)
308:     end subroutine PetscSetFortranBasePointers

310:     subroutine PetscOptionsString(string, text, man, default, value, flg, ierr)
311:       use, intrinsic :: ISO_C_binding
312:       character(*) string, text, man, default, value
313:       PetscBool flg
314:       PetscErrorCode ierr
315:     end subroutine PetscOptionsString
316:   end interface

318:   interface petscbinaryread
319:     subroutine petscbinaryreadcomplex(fd, data, num, count, type, ierr)
320:       use, intrinsic :: ISO_C_binding
321:       import ePetscDataType
322:       integer4 fd
323:       PetscComplex data(*)
324:       PetscInt num
325:       PetscInt count
326:       PetscDataType type
327:       PetscErrorCode ierr
328:     end subroutine petscbinaryreadcomplex
329:     subroutine petscbinaryreadreal(fd, data, num, count, type, ierr)
330:       use, intrinsic :: ISO_C_binding
331:       import ePetscDataType
332:       integer4 fd
333:       PetscReal data(*)
334:       PetscInt num
335:       PetscInt count
336:       PetscDataType type
337:       PetscErrorCode ierr
338:     end subroutine petscbinaryreadreal
339:     subroutine petscbinaryreadint(fd, data, num, count, type, ierr)
340:       use, intrinsic :: ISO_C_binding
341:       import ePetscDataType
342:       integer4 fd
343:       PetscInt data(*)
344:       PetscInt num
345:       PetscInt count
346:       PetscDataType type
347:       PetscErrorCode ierr
348:     end subroutine petscbinaryreadint
349:     subroutine petscbinaryreadcomplex1(fd, data, num, count, type, ierr)
350:       use, intrinsic :: ISO_C_binding
351:       import ePetscDataType
352:       integer4 fd
353:       PetscComplex data
354:       PetscInt num
355:       PetscInt count
356:       PetscDataType type
357:       PetscErrorCode ierr
358:     end subroutine petscbinaryreadcomplex1
359:     subroutine petscbinaryreadreal1(fd, data, num, count, type, ierr)
360:       use, intrinsic :: ISO_C_binding
361:       import ePetscDataType
362:       integer4 fd
363:       PetscReal data
364:       PetscInt num
365:       PetscInt count
366:       PetscDataType type
367:       PetscErrorCode ierr
368:     end subroutine petscbinaryreadreal1
369:     subroutine petscbinaryreadint1(fd, data, num, count, type, ierr)
370:       use, intrinsic :: ISO_C_binding
371:       import ePetscDataType
372:       integer4 fd
373:       PetscInt data
374:       PetscInt num
375:       PetscInt count
376:       PetscDataType type
377:       PetscErrorCode ierr
378:     end subroutine petscbinaryreadint1
379:     subroutine petscbinaryreadcomplexcnt(fd, data, num, count, type, ierr)
380:       use, intrinsic :: ISO_C_binding
381:       import ePetscDataType
382:       integer4 fd
383:       PetscComplex data(*)
384:       PetscInt num
385:       PetscInt count(1)
386:       PetscDataType type
387:       PetscErrorCode ierr
388:     end subroutine petscbinaryreadcomplexcnt
389:     subroutine petscbinaryreadrealcnt(fd, data, num, count, type, ierr)
390:       use, intrinsic :: ISO_C_binding
391:       import ePetscDataType
392:       integer4 fd
393:       PetscReal data(*)
394:       PetscInt num
395:       PetscInt count(1)
396:       PetscDataType type
397:       PetscErrorCode ierr
398:     end subroutine petscbinaryreadrealcnt
399:     subroutine petscbinaryreadintcnt(fd, data, num, count, type, ierr)
400:       use, intrinsic :: ISO_C_binding
401:       import ePetscDataType
402:       integer4 fd
403:       PetscInt data(*)
404:       PetscInt num
405:       PetscInt count(1)
406:       PetscDataType type
407:       PetscErrorCode ierr
408:     end subroutine petscbinaryreadintcnt
409:     subroutine petscbinaryreadcomplex1cnt(fd, data, num, count, type, ierr)
410:       use, intrinsic :: ISO_C_binding
411:       import ePetscDataType
412:       integer4 fd
413:       PetscComplex data
414:       PetscInt num
415:       PetscInt count(1)
416:       PetscDataType type
417:       PetscErrorCode ierr
418:     end subroutine petscbinaryreadcomplex1cnt
419:     subroutine petscbinaryreadreal1cnt(fd, data, num, count, type, ierr)
420:       use, intrinsic :: ISO_C_binding
421:       import ePetscDataType
422:       integer4 fd
423:       PetscReal data
424:       PetscInt num
425:       PetscInt count(1)
426:       PetscDataType type
427:       PetscErrorCode ierr
428:     end subroutine petscbinaryreadreal1cnt
429:     subroutine petscbinaryreadint1cnt(fd, data, num, count, type, ierr)
430:       use, intrinsic :: ISO_C_binding
431:       import ePetscDataType
432:       integer4 fd
433:       PetscInt data
434:       PetscInt num
435:       PetscInt count(1)
436:       PetscDataType type
437:       PetscErrorCode ierr
438:     end subroutine petscbinaryreadint1cnt
439:   end interface petscbinaryread

441:   interface petscbinarywrite
442:     subroutine petscbinarywritecomplex(fd, data, num, type, ierr)
443:       use, intrinsic :: ISO_C_binding
444:       import ePetscDataType
445:       integer4 fd
446:       PetscComplex data(*)
447:       PetscInt num
448:       PetscDataType type
449:       PetscErrorCode ierr
450:     end subroutine petscbinarywritecomplex
451:     subroutine petscbinarywritereal(fd, data, num, type, ierr)
452:       use, intrinsic :: ISO_C_binding
453:       import ePetscDataType
454:       integer4 fd
455:       PetscReal data(*)
456:       PetscInt num
457:       PetscDataType type
458:       PetscErrorCode ierr
459:     end subroutine petscbinarywritereal
460:     subroutine petscbinarywriteint(fd, data, num, type, ierr)
461:       use, intrinsic :: ISO_C_binding
462:       import ePetscDataType
463:       integer4 fd
464:       PetscInt data(*)
465:       PetscInt num
466:       PetscDataType type
467:       PetscErrorCode ierr
468:     end subroutine petscbinarywriteint
469:     subroutine petscbinarywritecomplex1(fd, data, num, type, ierr)
470:       use, intrinsic :: ISO_C_binding
471:       import ePetscDataType
472:       integer4 fd
473:       PetscComplex data
474:       PetscInt num
475:       PetscDataType type
476:       PetscErrorCode ierr
477:     end subroutine petscbinarywritecomplex1
478:     subroutine petscbinarywritereal1(fd, data, num, type, ierr)
479:       use, intrinsic :: ISO_C_binding
480:       import ePetscDataType
481:       integer4 fd
482:       PetscReal data
483:       PetscInt num
484:       PetscDataType type
485:       PetscErrorCode ierr
486:     end subroutine petscbinarywritereal1
487:     subroutine petscbinarywriteint1(fd, data, num, type, ierr)
488:       use, intrinsic :: ISO_C_binding
489:       import ePetscDataType
490:       integer4 fd
491:       PetscInt data
492:       PetscInt num
493:       PetscDataType type
494:       PetscErrorCode ierr
495:     end subroutine petscbinarywriteint1
496:   end interface petscbinarywrite

498: contains
499: #if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
500: !DEC$ ATTRIBUTES DLLEXPORT::PetscInitializeWithHelp
501: #endif
502:   subroutine PetscInitializeWithHelp(filename, help, ierr)
503:     character(len=*) :: filename
504:     character(len=*) :: help
505:     PetscErrorCode   :: ierr

507:     if (filename /= PETSC_NULL_CHARACTER) then
508:       call PetscInitializeF(trim(filename), help, ierr)
509:       CHKERRQ(ierr)
510:     else
511:       call PetscInitializeF(filename, help, ierr)
512:       CHKERRQ(ierr)
513:     end if
514:   end subroutine PetscInitializeWithHelp

516: #if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
517: !DEC$ ATTRIBUTES DLLEXPORT::PetscInitializeNoHelp
518: #endif
519:   subroutine PetscInitializeNoHelp(filename, ierr)
520:     character(len=*) :: filename
521:     PetscErrorCode   :: ierr

523:     if (filename /= PETSC_NULL_CHARACTER) then
524:       call PetscInitializeF(trim(filename), PETSC_NULL_CHARACTER, ierr)
525:       CHKERRQ(ierr)
526:     else
527:       call PetscInitializeF(filename, PETSC_NULL_CHARACTER, ierr)
528:       CHKERRQ(ierr)
529:     end if
530:   end subroutine PetscInitializeNoHelp

532: #if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
533: !DEC$ ATTRIBUTES DLLEXPORT::PetscInitializeNoArguments
534: #endif
535:   subroutine PetscInitializeNoArguments(ierr)
536:     PetscErrorCode :: ierr

538:     call PetscInitializeF(PETSC_NULL_CHARACTER, PETSC_NULL_CHARACTER, ierr)
539:     CHKERRQ(ierr)
540:   end subroutine PetscInitializeNoArguments

542: #include <../ftn/sys/petscall.hf90>
543: end module petscsys

545: subroutine F90ArraySetRealPointer(array, sz, j, T)
546:   use petscsysdef
547:   PetscInt :: j, sz
548:   PetscReal, target    :: array(1:sz)
549:   PetscReal2d, pointer :: T(:)

551:   T(j + 1)%ptr => array
552: end subroutine F90ArraySetRealPointer
553: #if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
554: !DEC$ ATTRIBUTES DLLEXPORT:: F90ArraySetRealPointer
555: #endif

557: !TODO: generate the modules below by looping over
558: !      ftn/sys/XXX.h90
559: !      and skipping those in petscall.h

561: module petscbag
562:   use petscsys
563: #include <../include/petsc/finclude/petscbag.h>
564: #include <../ftn/sys/petscbag.h>
565: #include <../ftn/sys/petscbag.h90>
566: contains
567: #include <../ftn/sys/petscbag.hf90>
568: end module petscbag

570: module petscbm
571:   use petscsys
572: #include <../include/petsc/finclude/petscbm.h>
573: #include <../ftn/sys/petscbm.h>
574: #include <../ftn/sys/petscbm.h90>
575: contains

577: #include <../ftn/sys/petscbm.hf90>
578: end module petscbm

580: module petscmatlab
581:   use petscsys
582: #include <../include/petsc/finclude/petscmatlab.h>
583: #include <../ftn/sys/petscmatlab.h>
584: #include <../ftn/sys/petscmatlab.h90>

586: contains

588: #include <../ftn/sys/petscmatlab.hf90>
589: end module petscmatlab

591: module petscdraw
592:   use petscsys
593: #include <../include/petsc/finclude/petscdraw.h>
594: #include <../ftn/sys/petscdraw.h>
595: #include <../ftn/sys/petscdraw.h90>

597:   PetscEnum, parameter :: PETSC_DRAW_BASIC_COLORS = 33
598:   PetscEnum, parameter :: PETSC_DRAW_ROTATE = -1
599:   PetscEnum, parameter :: PETSC_DRAW_WHITE = 0
600:   PetscEnum, parameter :: PETSC_DRAW_BLACK = 1
601:   PetscEnum, parameter :: PETSC_DRAW_RED = 2
602:   PetscEnum, parameter :: PETSC_DRAW_GREEN = 3
603:   PetscEnum, parameter :: PETSC_DRAW_CYAN = 4
604:   PetscEnum, parameter :: PETSC_DRAW_BLUE = 5
605:   PetscEnum, parameter :: PETSC_DRAW_MAGENTA = 6
606:   PetscEnum, parameter :: PETSC_DRAW_AQUAMARINE = 7
607:   PetscEnum, parameter :: PETSC_DRAW_FORESTGREEN = 8
608:   PetscEnum, parameter :: PETSC_DRAW_ORANGE = 9
609:   PetscEnum, parameter :: PETSC_DRAW_VIOLET = 10
610:   PetscEnum, parameter :: PETSC_DRAW_BROWN = 11
611:   PetscEnum, parameter :: PETSC_DRAW_PINK = 12
612:   PetscEnum, parameter :: PETSC_DRAW_CORAL = 13
613:   PetscEnum, parameter :: PETSC_DRAW_GRAY = 14
614:   PetscEnum, parameter :: PETSC_DRAW_YELLOW = 15
615:   PetscEnum, parameter :: PETSC_DRAW_GOLD = 16
616:   PetscEnum, parameter :: PETSC_DRAW_LIGHTPINK = 17
617:   PetscEnum, parameter :: PETSC_DRAW_MEDIUMTURQUOISE = 18
618:   PetscEnum, parameter :: PETSC_DRAW_KHAKI = 19
619:   PetscEnum, parameter :: PETSC_DRAW_DIMGRAY = 20
620:   PetscEnum, parameter :: PETSC_DRAW_YELLOWGREEN = 21
621:   PetscEnum, parameter :: PETSC_DRAW_SKYBLUE = 22
622:   PetscEnum, parameter :: PETSC_DRAW_DARKGREEN = 23
623:   PetscEnum, parameter :: PETSC_DRAW_NAVYBLUE = 24
624:   PetscEnum, parameter :: PETSC_DRAW_SANDYBROWN = 25
625:   PetscEnum, parameter :: PETSC_DRAW_CADETBLUE = 26
626:   PetscEnum, parameter :: PETSC_DRAW_POWDERBLUE = 27
627:   PetscEnum, parameter :: PETSC_DRAW_DEEPPINK = 28
628:   PetscEnum, parameter :: PETSC_DRAW_THISTLE = 29
629:   PetscEnum, parameter :: PETSC_DRAW_LIMEGREEN = 30
630:   PetscEnum, parameter :: PETSC_DRAW_LAVENDERBLUSH = 31
631:   PetscEnum, parameter :: PETSC_DRAW_PLUM = 32

633: contains

635: #include <../ftn/sys/petscdraw.hf90>
636: end module petscdraw

638: subroutine PetscSetCOMM(c1, c2)
639:   use, intrinsic :: ISO_C_binding
640:   use petscmpi

642:   implicit none
643:   MPIU_Comm c1, c2

645:   PETSC_COMM_WORLD = c1
646:   PETSC_COMM_SELF = c2
647: end

649: subroutine PetscGetCOMM(c1)
650:   use, intrinsic :: ISO_C_binding
651:   use petscmpi
652:   implicit none
653:   MPIU_Comm c1

655:   c1 = PETSC_COMM_WORLD
656: end subroutine PetscGetCOMM

658: subroutine PetscSetModuleBlock()
659:   use, intrinsic :: ISO_C_binding
660:   use petscsys!, only: PETSC_NULL_CHARACTER,PETSC_NULL_INTEGER,&
661:   !  PETSC_NULL_SCALAR,PETSC_NULL_DOUBLE,PETSC_NULL_REAL,&
662:   !  PETSC_NULL_BOOL,PETSC_NULL_FUNCTION,PETSC_NULL_MPI_COMM
663:   implicit none

665:   call PetscSetFortranBasePointers(PETSC_NULL_CHARACTER, &
666:                                    PETSC_NULL_INTEGER, PETSC_NULL_SCALAR, &
667:                                    PETSC_NULL_DOUBLE, PETSC_NULL_REAL, &
668:                                    PETSC_NULL_BOOL, PETSC_NULL_ENUM, PETSC_NULL_FUNCTION, &
669:                                    PETSC_NULL_MPI_COMM, &
670:                                    PETSC_NULL_INTEGER_ARRAY, PETSC_NULL_SCALAR_ARRAY, &
671:                                    PETSC_NULL_REAL_ARRAY, PETSC_NULL_INTEGER_POINTER, &
672:                                    PETSC_NULL_SCALAR_POINTER, PETSC_NULL_REAL_POINTER)
673: end subroutine PetscSetModuleBlock

675: subroutine PetscSetModuleBlockMPI(freal, fscalar, fsum, finteger, fcbool)
676:   use, intrinsic :: ISO_C_binding
677:   use petscmpi
678:   implicit none

680:   MPIU_Datatype freal, fscalar, finteger, fcbool
681:   MPIU_Op fsum

683:   MPIU_REAL = freal
684:   MPIU_SCALAR = fscalar
685:   MPIU_SUM = fsum
686:   MPIU_INTEGER = finteger
687: #if !defined(PETSC_HAVE_MPI_C_BOOL_FORTRAN)
688:   MPI_C_BOOL = fcbool
689: #endif
690: end subroutine PetscSetModuleBlockMPI

692: subroutine PetscSetModuleBlockNumeric(pi, maxreal, minreal, eps, seps, small, pinf, pninf)
693:   use petscsys, only: PETSC_PI, PETSC_MAX_REAL, PETSC_MIN_REAL, &
694:                       PETSC_MACHINE_EPSILON, PETSC_SQRT_MACHINE_EPSILON, &
695:                       PETSC_SMALL, PETSC_INFINITY, PETSC_NINFINITY
696:   use, intrinsic :: ISO_C_binding
697:   implicit none

699:   PetscReal pi, maxreal, minreal, eps, seps
700:   PetscReal small, pinf, pninf

702:   PETSC_PI = pi
703:   PETSC_MAX_REAL = maxreal
704:   PETSC_MIN_REAL = minreal
705:   PETSC_MACHINE_EPSILON = eps
706:   PETSC_SQRT_MACHINE_EPSILON = seps
707:   PETSC_SMALL = small
708:   PETSC_INFINITY = pinf
709:   PETSC_NINFINITY = pninf
710: end subroutine PetscSetModuleBlockNumeric