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:   MPIU_Comm:: PETSC_COMM_WORLD
 21:   MPIU_Comm:: PETSC_COMM_SELF

 23: #if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
 24: !DEC$ ATTRIBUTES DLLEXPORT::MPIU_REAL
 25: !DEC$ ATTRIBUTES DLLEXPORT::MPIU_SUM
 26: !DEC$ ATTRIBUTES DLLEXPORT::MPIU_SCALAR
 27: !DEC$ ATTRIBUTES DLLEXPORT::MPIU_INTEGER
 28: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_COMM_SELF
 29: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_COMM_WORLD
 30: #endif
 31: end module petscmpi

 33: module petscsysdef
 34:   use, intrinsic :: ISO_C_binding
 35:   use petscmpi
 36:   PetscReal, parameter :: PetscReal_Private = 1.0
 37:   integer, parameter   :: PETSC_REAL_KIND = kind(PetscReal_Private)

 39:   PetscScalar, parameter :: PetscScalar_Private = (1.0, 0.0)
 40:   integer, parameter   :: PETSC_SCALAR_KIND = kind(PetscScalar_Private)

 42:   PetscInt, parameter :: PetscInt_Private = 1
 43:   integer, parameter   :: PETSC_INT_KIND = kind(PetscInt_Private)

 45:   PetscMPIInt, parameter :: PetscMPIInt_Private = 1
 46:   integer, parameter   :: PETSC_MPIINT_KIND = kind(PetscMPIInt_Private)

 48:   PetscBool, parameter :: PETSC_TRUE = .true._C_BOOL
 49:   PetscBool, parameter :: PETSC_FALSE = .false._C_BOOL

 51:   PetscInt, parameter :: PETSC_DECIDE = -1
 52:   PetscInt, parameter :: PETSC_DECIDE_INTEGER = -1_PETSC_INT_KIND
 53:   PetscReal, parameter :: PETSC_DECIDE_REAL = -1.0_PETSC_REAL_KIND
 54: #if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
 55: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_DECIDE
 56: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_DECIDE_INTEGER
 57: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_DECIDE_REAL
 58: #endif

 60:   PetscInt, parameter :: PETSC_DETERMINE = -1
 61:   PetscInt, parameter :: PETSC_DETERMINE_INTEGER = -1
 62:   PetscReal, parameter :: PETSC_DETERMINE_REAL = -1.0_PETSC_REAL_KIND
 63: #if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
 64: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_DETERMINE
 65: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_DETERMINE_INTEGER
 66: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_DETERMINE_REAL
 67: #endif

 69:   PetscInt, parameter :: PETSC_CURRENT = -2
 70:   PetscInt, parameter :: PETSC_CURRENT_INTEGER = -2
 71:   PetscReal, parameter :: PETSC_CURRENT_REAL = -2.0_PETSC_REAL_KIND
 72: #if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
 73: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_CURRENT
 74: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_CURRENT_INTEGER
 75: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_CURRENT_REAL
 76: #endif

 78:   PetscInt, parameter :: PETSC_DEFAULT = -2
 79:   PetscInt, parameter :: PETSC_DEFAULT_INTEGER = -2
 80:   PetscReal, parameter :: PETSC_DEFAULT_REAL = -2.0_PETSC_REAL_KIND
 81: #if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
 82: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_DEFAULT
 83: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_DEFAULT_INTEGER
 84: !DEC$ ATTRIBUTES DLLEXPORT::PETSC_DEFAULT_REAL
 85: #endif

 87:   PetscFortranAddr, parameter :: PETSC_STDOUT = 0
 88: !
 89: !  PETSc DataTypes
 90: !
 91: #if defined(PETSC_USE_REAL_SINGLE)
 92: #define PETSC_REAL PETSC_FLOAT
 93: #elif defined(PETSC_USE_REAL___FLOAT128)
 94: #define PETSC_REAL PETSC___FLOAT128
 95: #else
 96: #define PETSC_REAL PETSC_DOUBLE
 97: #endif
 98: #define PETSC_FORTRANADDR PETSC_LONG

100: ! PETSc mathematics include file. Defines certain basic mathematical
101: ! constants and functions for working with single and double precision
102: ! floating point numbers as well as complex and integers.
103: !
104: ! Representation of complex i
105:   PetscComplex, parameter :: PETSC_i = (0.0_PETSC_REAL_KIND, 1.0_PETSC_REAL_KIND)

107: ! A PETSC_NULL_FUNCTION pointer
108: !
109:   external PETSC_NULL_FUNCTION
110: !
111: ! Possible arguments to PetscPushErrorHandler()
112: !
113:   external PETSCTRACEBACKERRORHANDLER
114:   external PETSCABORTERRORHANDLER
115:   external PETSCEMACSCLIENTERRORHANDLER
116:   external PETSCATTACHDEBUGGERERRORHANDLER
117:   external PETSCIGNOREERRORHANDLER
118: !
119:   external PetscIsInfOrNanScalar
120:   external PetscIsInfOrNanReal
121:   PetscBool PetscIsInfOrNanScalar
122:   PetscBool PetscIsInfOrNanReal

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

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

139:   PetscViewer PETSC_VIEWER_STDOUT_
140:   PetscViewer PETSC_VIEWER_DRAW_
141:   external PETSC_VIEWER_STDOUT_
142:   external PETSC_VIEWER_DRAW_
143:   external PetscViewerAndFormatDestroy

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

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

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

190:   PetscErrorCode, parameter :: PETSC_ERR_FILE_OPEN = 65
191:   PetscErrorCode, parameter :: PETSC_ERR_FILE_READ = 66
192:   PetscErrorCode, parameter :: PETSC_ERR_FILE_WRITE = 67
193:   PetscErrorCode, parameter :: PETSC_ERR_FILE_UNEXPECTED = 79

195:   PetscErrorCode, parameter :: PETSC_ERR_MAT_LU_ZRPVT = 71
196:   PetscErrorCode, parameter :: PETSC_ERR_MAT_CH_ZRPVT = 81

198:   PetscErrorCode, parameter :: PETSC_ERR_INT_OVERFLOW = 84

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

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

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

259:   type tPetscReal2d
260:     sequence
261:     PetscReal, dimension(:), pointer :: ptr
262:   end type tPetscReal2D

264: end module petscsysdef

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

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

275:   interface PetscInitialize
276:     module procedure PetscInitializeWithHelp, PetscInitializeNoHelp, PetscInitializeNoArguments
277:   end interface PetscInitialize

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

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

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

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

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

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

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

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

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

536:     call PetscInitializeF(PETSC_NULL_CHARACTER, PETSC_NULL_CHARACTER, ierr)
537:     CHKERRQ(ierr)
538:   end subroutine PetscInitializeNoArguments

540: #include <../ftn/sys/petscall.hf90>
541: end module petscsys

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

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

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

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

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

575: #include <../ftn/sys/petscbm.hf90>
576: end module petscbm

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

584: contains

586: #include <../ftn/sys/petscmatlab.hf90>
587: end module petscmatlab

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

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

631: contains

633: #include <../ftn/sys/petscdraw.hf90>
634: end module petscdraw

636: subroutine PetscSetCOMM(c1, c2)
637:   use, intrinsic :: ISO_C_binding
638:   use petscmpi

640:   implicit none
641:   MPIU_Comm c1, c2

643:   PETSC_COMM_WORLD = c1
644:   PETSC_COMM_SELF = c2
645: end

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

653:   c1 = PETSC_COMM_WORLD
654: end subroutine PetscGetCOMM

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

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

673: subroutine PetscSetModuleBlockMPI(freal, fscalar, fsum, finteger)
674:   use, intrinsic :: ISO_C_binding
675:   use petscmpi
676:   implicit none

678:   MPIU_Datatype freal, fscalar, finteger
679:   MPIU_Op fsum

681:   MPIU_REAL = freal
682:   MPIU_SCALAR = fscalar
683:   MPIU_SUM = fsum
684:   MPIU_INTEGER = finteger
685: end subroutine PetscSetModuleBlockMPI

687: subroutine PetscSetModuleBlockNumeric(pi, maxreal, minreal, eps, seps, small, pinf, pninf)
688:   use petscsys, only: PETSC_PI, PETSC_MAX_REAL, PETSC_MIN_REAL, &
689:                       PETSC_MACHINE_EPSILON, PETSC_SQRT_MACHINE_EPSILON, &
690:                       PETSC_SMALL, PETSC_INFINITY, PETSC_NINFINITY
691:   use, intrinsic :: ISO_C_binding
692:   implicit none

694:   PetscReal pi, maxreal, minreal, eps, seps
695:   PetscReal small, pinf, pninf

697:   PETSC_PI = pi
698:   PETSC_MAX_REAL = maxreal
699:   PETSC_MIN_REAL = minreal
700:   PETSC_MACHINE_EPSILON = eps
701:   PETSC_SQRT_MACHINE_EPSILON = seps
702:   PETSC_SMALL = small
703:   PETSC_INFINITY = pinf
704:   PETSC_NINFINITY = pninf
705: end subroutine PetscSetModuleBlockNumeric