xref: /petsc/src/sys/ftn-mod/petscsysmod.F90 (revision 57d508425293f0bb93f59574d14951d8faac9af8) 
1module 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_F90MODULE)
9  use mpi
10#else
11#include "mpif.h"
12#endif
13#endif
14
15  public:: MPIU_REAL, MPIU_SUM, MPIU_SCALAR, MPIU_INTEGER
16  public:: PETSC_COMM_WORLD, PETSC_COMM_SELF
17
18  integer4 :: MPIU_REAL
19  integer4 :: MPIU_SUM
20  integer4 :: MPIU_SCALAR
21  integer4 :: MPIU_INTEGER
22
23  MPI_Comm::PETSC_COMM_WORLD = 0
24  MPI_Comm::PETSC_COMM_SELF = 0
25
26#if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
27!DEC$ ATTRIBUTES DLLEXPORT::MPIU_REAL
28!DEC$ ATTRIBUTES DLLEXPORT::MPIU_SUM
29!DEC$ ATTRIBUTES DLLEXPORT::MPIU_SCALAR
30!DEC$ ATTRIBUTES DLLEXPORT::MPIU_INTEGER
31!DEC$ ATTRIBUTES DLLEXPORT::PETSC_COMM_SELF
32!DEC$ ATTRIBUTES DLLEXPORT::PETSC_COMM_WORLD
33#endif
34end module petscmpi
35
36! ------------------------------------------------------------------------
37module petscsysdef
38  use, intrinsic :: ISO_C_binding
39#if defined(PETSC_HAVE_MPI_F90MODULE_VISIBILITY)
40  use petscmpi
41#else
42  use petscmpi, only: MPIU_REAL, MPIU_SUM, MPIU_SCALAR, MPIU_INTEGER, PETSC_COMM_WORLD, PETSC_COMM_SELF
43#endif
44  PetscReal, parameter :: PetscReal_Private = 1.0
45  Integer, parameter   :: PETSC_REAL_KIND = kind(PetscReal_Private)
46
47  PetscBool, parameter :: PETSC_TRUE = .true._C_BOOL
48  PetscBool, parameter :: PETSC_FALSE = .false._C_BOOL
49
50  PetscInt, parameter :: PETSC_DECIDE = -1
51  PetscInt, parameter :: PETSC_DECIDE_INTEGER = -1
52  PetscReal, parameter :: PETSC_DECIDE_REAL = -1.0_PETSC_REAL_KIND
53#if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
54!DEC$ ATTRIBUTES DLLEXPORT::PETSC_DECIDE
55!DEC$ ATTRIBUTES DLLEXPORT::PETSC_DECIDE_INTEGER
56!DEC$ ATTRIBUTES DLLEXPORT::PETSC_DECIDE_REAL
57#endif
58
59  PetscInt, parameter :: PETSC_DETERMINE = -1
60  PetscInt, parameter :: PETSC_DETERMINE_INTEGER = -1
61  PetscReal, parameter :: PETSC_DETERMINE_REAL = -1.0_PETSC_REAL_KIND
62#if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
63!DEC$ ATTRIBUTES DLLEXPORT::PETSC_DETERMINE
64!DEC$ ATTRIBUTES DLLEXPORT::PETSC_DETERMINE_INTEGER
65!DEC$ ATTRIBUTES DLLEXPORT::PETSC_DETERMINE_REAL
66#endif
67
68  PetscInt, parameter :: PETSC_CURRENT = -2
69  PetscInt, parameter :: PETSC_CURRENT_INTEGER = -2
70  PetscReal, parameter :: PETSC_CURRENT_REAL = -2.0_PETSC_REAL_KIND
71#if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
72!DEC$ ATTRIBUTES DLLEXPORT::PETSC_CURRENT
73!DEC$ ATTRIBUTES DLLEXPORT::PETSC_CURRENT_INTEGER
74!DEC$ ATTRIBUTES DLLEXPORT::PETSC_CURRENT_REAL
75#endif
76
77  PetscInt, parameter :: PETSC_DEFAULT = -2
78  PetscInt, parameter :: PETSC_DEFAULT_INTEGER = -2
79  PetscReal, parameter :: PETSC_DEFAULT_REAL = -2.0_PETSC_REAL_KIND
80#if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
81!DEC$ ATTRIBUTES DLLEXPORT::PETSC_DEFAULT
82!DEC$ ATTRIBUTES DLLEXPORT::PETSC_DEFAULT_INTEGER
83!DEC$ ATTRIBUTES DLLEXPORT::PETSC_DEFAULT_REAL
84#endif
85
86  PetscFortranAddr, parameter :: PETSC_STDOUT = 0
87!
88!  PETSc DataTypes
89!
90#if defined(PETSC_USE_REAL_SINGLE)
91#define PETSC_REAL PETSC_FLOAT
92#elif defined(PETSC_USE_REAL___FLOAT128)
93#define PETSC_REAL PETSC___FLOAT128
94#else
95#define PETSC_REAL PETSC_DOUBLE
96#endif
97#define PETSC_FORTRANADDR PETSC_LONG
98
99! PETSc mathematics include file. Defines certain basic mathematical
100! constants and functions for working with single and double precision
101! floating point numbers as well as complex and integers.
102!
103! Representation of complex i
104  PetscComplex, parameter :: PETSC_i = (0.0_PETSC_REAL_KIND, 1.0_PETSC_REAL_KIND)
105
106! A PETSC_NULL_FUNCTION pointer
107!
108  external PETSC_NULL_FUNCTION
109!
110! Possible arguments to PetscPushErrorHandler()
111!
112  external PETSCTRACEBACKERRORHANDLER
113  external PETSCABORTERRORHANDLER
114  external PETSCEMACSCLIENTERRORHANDLER
115  external PETSCATTACHDEBUGGERERRORHANDLER
116  external PETSCIGNOREERRORHANDLER
117!
118  external PetscIsInfOrNanScalar
119  external PetscIsInfOrNanReal
120  PetscBool PetscIsInfOrNanScalar
121  PetscBool PetscIsInfOrNanReal
122
123#include <../ftn/sys/petscall.h>
124
125  PetscViewer, parameter :: PETSC_VIEWER_STDOUT_SELF = tPetscViewer(9)
126  PetscViewer, parameter :: PETSC_VIEWER_DRAW_WORLD = tPetscViewer(4)
127  PetscViewer, parameter :: PETSC_VIEWER_DRAW_SELF = tPetscViewer(5)
128  PetscViewer, parameter :: PETSC_VIEWER_SOCKET_WORLD = tPetscViewer(6)
129  PetscViewer, parameter :: PETSC_VIEWER_SOCKET_SELF = tPetscViewer(7)
130  PetscViewer, parameter :: PETSC_VIEWER_STDOUT_WORLD = tPetscViewer(8)
131  PetscViewer, parameter :: PETSC_VIEWER_STDERR_WORLD = tPetscViewer(10)
132  PetscViewer, parameter :: PETSC_VIEWER_STDERR_SELF = tPetscViewer(11)
133  PetscViewer, parameter :: PETSC_VIEWER_BINARY_WORLD = tPetscViewer(12)
134  PetscViewer, parameter :: PETSC_VIEWER_BINARY_SELF = tPetscViewer(13)
135  PetscViewer, parameter :: PETSC_VIEWER_MATLAB_WORLD = tPetscViewer(14)
136  PetscViewer, parameter :: PETSC_VIEWER_MATLAB_SELF = tPetscViewer(15)
137
138  PetscViewer PETSC_VIEWER_STDOUT_
139  PetscViewer PETSC_VIEWER_DRAW_
140  external PETSC_VIEWER_STDOUT_
141  external PETSC_VIEWER_DRAW_
142  external PetscViewerAndFormatDestroy
143
144#if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
145!DEC$ ATTRIBUTES DLLEXPORT::PETSC_VIEWER_STDOUT_SELF
146!DEC$ ATTRIBUTES DLLEXPORT::PETSC_VIEWER_DRAW_WORLD
147!DEC$ ATTRIBUTES DLLEXPORT::PETSC_VIEWER_DRAW_SELF
148!DEC$ ATTRIBUTES DLLEXPORT::PETSC_VIEWER_SOCKET_WORLD
149!DEC$ ATTRIBUTES DLLEXPORT::PETSC_VIEWER_SOCKET_SELF
150!DEC$ ATTRIBUTES DLLEXPORT::PETSC_VIEWER_STDOUT_WORLD
151!DEC$ ATTRIBUTES DLLEXPORT::PETSC_VIEWER_STDERR_WORLD
152!DEC$ ATTRIBUTES DLLEXPORT::PETSC_VIEWER_STDERR_SELF
153!DEC$ ATTRIBUTES DLLEXPORT::PETSC_VIEWER_BINARY_WORLD
154!DEC$ ATTRIBUTES DLLEXPORT::PETSC_VIEWER_BINARY_SELF
155!DEC$ ATTRIBUTES DLLEXPORT::PETSC_VIEWER_MATLAB_WORLD
156!DEC$ ATTRIBUTES DLLEXPORT::PETSC_VIEWER_MATLAB_SELF
157#endif
158
159  PetscErrorCode, parameter :: PETSC_ERR_MEM = 55
160  PetscErrorCode, parameter :: PETSC_ERR_SUP = 56
161  PetscErrorCode, parameter :: PETSC_ERR_SUP_SYS = 57
162  PetscErrorCode, parameter :: PETSC_ERR_ORDER = 58
163  PetscErrorCode, parameter :: PETSC_ERR_SIG = 59
164  PetscErrorCode, parameter :: PETSC_ERR_FP = 72
165  PetscErrorCode, parameter :: PETSC_ERR_COR = 74
166  PetscErrorCode, parameter :: PETSC_ERR_LIB = 76
167  PetscErrorCode, parameter :: PETSC_ERR_PLIB = 77
168  PetscErrorCode, parameter :: PETSC_ERR_MEMC = 78
169  PetscErrorCode, parameter :: PETSC_ERR_CONV_FAILED = 82
170  PetscErrorCode, parameter :: PETSC_ERR_USER = 83
171  PetscErrorCode, parameter :: PETSC_ERR_SYS = 88
172  PetscErrorCode, parameter :: PETSC_ERR_POINTER = 70
173  PetscErrorCode, parameter :: PETSC_ERR_MPI_LIB_INCOMP = 87
174
175  PetscErrorCode, parameter :: PETSC_ERR_ARG_SIZ = 60
176  PetscErrorCode, parameter :: PETSC_ERR_ARG_IDN = 61
177  PetscErrorCode, parameter :: PETSC_ERR_ARG_WRONG = 62
178  PetscErrorCode, parameter :: PETSC_ERR_ARG_CORRUPT = 64
179  PetscErrorCode, parameter :: PETSC_ERR_ARG_OUTOFRANGE = 63
180  PetscErrorCode, parameter :: PETSC_ERR_ARG_BADPTR = 68
181  PetscErrorCode, parameter :: PETSC_ERR_ARG_NOTSAMETYPE = 69
182  PetscErrorCode, parameter :: PETSC_ERR_ARG_NOTSAMECOMM = 80
183  PetscErrorCode, parameter :: PETSC_ERR_ARG_WRONGSTATE = 73
184  PetscErrorCode, parameter :: PETSC_ERR_ARG_TYPENOTSET = 89
185  PetscErrorCode, parameter :: PETSC_ERR_ARG_INCOMP = 75
186  PetscErrorCode, parameter :: PETSC_ERR_ARG_NULL = 85
187  PetscErrorCode, parameter :: PETSC_ERR_ARG_UNKNOWN_TYPE = 86
188
189  PetscErrorCode, parameter :: PETSC_ERR_FILE_OPEN = 65
190  PetscErrorCode, parameter :: PETSC_ERR_FILE_READ = 66
191  PetscErrorCode, parameter :: PETSC_ERR_FILE_WRITE = 67
192  PetscErrorCode, parameter :: PETSC_ERR_FILE_UNEXPECTED = 79
193
194  PetscErrorCode, parameter :: PETSC_ERR_MAT_LU_ZRPVT = 71
195  PetscErrorCode, parameter :: PETSC_ERR_MAT_CH_ZRPVT = 81
196
197  PetscErrorCode, parameter :: PETSC_ERR_INT_OVERFLOW = 84
198
199  PetscErrorCode, parameter :: PETSC_ERR_FLOP_COUNT = 90
200  PetscErrorCode, parameter :: PETSC_ERR_NOT_CONVERGED = 91
201  PetscErrorCode, parameter :: PETSC_ERR_MISSING_FACTOR = 92
202  PetscErrorCode, parameter :: PETSC_ERR_OPT_OVERWRITE = 93
203  PetscErrorCode, parameter :: PETSC_ERR_WRONG_MPI_SIZE = 94
204  PetscErrorCode, parameter :: PETSC_ERR_USER_INPUT = 95
205  PetscErrorCode, parameter :: PETSC_ERR_GPU_RESOURCE = 96
206  PetscErrorCode, parameter :: PETSC_ERR_GPU = 97
207  PetscErrorCode, parameter :: PETSC_ERR_MPI = 98
208  PetscErrorCode, parameter :: PETSC_ERR_RETURN = 99
209
210  character(len=80) :: PETSC_NULL_CHARACTER = ''
211  PetscInt PETSC_NULL_INTEGER, PETSC_NULL_INTEGER_ARRAY(1)
212  PetscInt, pointer :: PETSC_NULL_INTEGER_POINTER(:)
213  PetscScalar, pointer :: PETSC_NULL_SCALAR_POINTER(:)
214  PetscFortranDouble PETSC_NULL_DOUBLE
215  PetscScalar PETSC_NULL_SCALAR, PETSC_NULL_SCALAR_ARRAY(1)
216  PetscReal PETSC_NULL_REAL, PETSC_NULL_REAL_ARRAY(1)
217  PetscReal, pointer :: PETSC_NULL_REAL_POINTER(:)
218  PetscBool PETSC_NULL_BOOL
219  PetscEnum PETSC_NULL_ENUM
220  MPI_Comm PETSC_NULL_MPI_COMM
221!
222!     Basic math constants
223!
224  PetscReal PETSC_PI
225  PetscReal PETSC_MAX_REAL
226  PetscReal PETSC_MIN_REAL
227  PetscReal PETSC_MACHINE_EPSILON
228  PetscReal PETSC_SQRT_MACHINE_EPSILON
229  PetscReal PETSC_SMALL
230  PetscReal PETSC_INFINITY
231  PetscReal PETSC_NINFINITY
232
233#if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
234!DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_CHARACTER
235!DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_INTEGER
236!DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_INTEGER_ARRAY
237!DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_INTEGER_POINTER
238!DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_SCALAR_POINTER
239!DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_REAL_POINTER
240!DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_DOUBLE
241!DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_SCALAR
242!DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_SCALAR_ARRAY
243!DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_REAL
244!DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_REAL_ARRAY
245!DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_BOOL
246!DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_ENUM
247!DEC$ ATTRIBUTES DLLEXPORT::PETSC_NULL_MPI_COMM
248!DEC$ ATTRIBUTES DLLEXPORT::PETSC_PI
249!DEC$ ATTRIBUTES DLLEXPORT::PETSC_MAX_REAL
250!DEC$ ATTRIBUTES DLLEXPORT::PETSC_MIN_REAL
251!DEC$ ATTRIBUTES DLLEXPORT::PETSC_MACHINE_EPSILON
252!DEC$ ATTRIBUTES DLLEXPORT::PETSC_SQRT_MACHINE_EPSILON
253!DEC$ ATTRIBUTES DLLEXPORT::PETSC_SMALL
254!DEC$ ATTRIBUTES DLLEXPORT::PETSC_INFINITY
255!DEC$ ATTRIBUTES DLLEXPORT::PETSC_NINFINITY
256#endif
257
258  type tPetscReal2d
259    sequence
260    PetscReal, dimension(:), pointer :: ptr
261  end type tPetscReal2D
262
263end module petscsysdef
264
265!   ------------------------------------------------------------------------
266
267module petscsys
268  use, intrinsic :: ISO_C_binding
269  use petscsysdef
270
271#include <../src/sys/ftn-mod/petscsys.h90>
272#include <../src/sys/ftn-mod/petscviewer.h90>
273#include <../ftn/sys/petscall.h90>
274
275  interface PetscInitialize
276    module procedure PetscInitializeWithHelp, PetscInitializeNoHelp, PetscInitializeNoArguments
277  end interface PetscInitialize
278
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      character(*) PETSC_NULL_CHARACTER
291      PetscInt PETSC_NULL_INTEGER
292      PetscScalar PETSC_NULL_SCALAR
293      PetscFortranDouble PETSC_NULL_DOUBLE
294      PetscReal PETSC_NULL_REAL
295      PetscBool PETSC_NULL_BOOL
296      PetscEnum PETSC_NULL_ENUM
297      external PETSC_NULL_FUNCTION
298      MPI_Comm PETSC_NULL_MPI_COMM
299      PetscInt PETSC_NULL_INTEGER_ARRAY(*)
300      PetscScalar PETSC_NULL_SCALAR_ARRAY(*)
301      PetscReal PETSC_NULL_REAL_ARRAY(*)
302      PetscInt, pointer :: APETSC_NULL_INTEGER_POINTER(:)
303      PetscScalar, pointer :: PETSC_NULL_SCALAR_POINTER(:)
304      PetscReal, pointer :: PETSC_NULL_REAL_POINTER(:)
305    end subroutine PetscSetFortranBasePointers
306
307    subroutine PetscOptionsString(string, text, man, default, value, flg, ierr)
308      use, intrinsic :: ISO_C_binding
309      character(*) string, text, man, default, value
310      PetscBool flg
311      PetscErrorCode ierr
312    end subroutine PetscOptionsString
313  end interface
314
315  interface petscbinaryread
316    subroutine petscbinaryreadcomplex(fd, data, num, count, type, z)
317      use, intrinsic :: ISO_C_binding
318      import ePetscDataType
319      integer4 fd
320      PetscComplex data(*)
321      PetscInt num
322      PetscInt count
323      PetscDataType type
324      PetscErrorCode z
325    end subroutine petscbinaryreadcomplex
326    subroutine petscbinaryreadreal(fd, data, num, count, type, z)
327      use, intrinsic :: ISO_C_binding
328      import ePetscDataType
329      integer4 fd
330      PetscReal data(*)
331      PetscInt num
332      PetscInt count
333      PetscDataType type
334      PetscErrorCode z
335    end subroutine petscbinaryreadreal
336    subroutine petscbinaryreadint(fd, data, num, count, type, z)
337      use, intrinsic :: ISO_C_binding
338      import ePetscDataType
339      integer4 fd
340      PetscInt data(*)
341      PetscInt num
342      PetscInt count
343      PetscDataType type
344      PetscErrorCode z
345    end subroutine petscbinaryreadint
346    subroutine petscbinaryreadcomplex1(fd, data, num, count, type, z)
347      use, intrinsic :: ISO_C_binding
348      import ePetscDataType
349      integer4 fd
350      PetscComplex data
351      PetscInt num
352      PetscInt count
353      PetscDataType type
354      PetscErrorCode z
355    end subroutine petscbinaryreadcomplex1
356    subroutine petscbinaryreadreal1(fd, data, num, count, type, z)
357      use, intrinsic :: ISO_C_binding
358      import ePetscDataType
359      integer4 fd
360      PetscReal data
361      PetscInt num
362      PetscInt count
363      PetscDataType type
364      PetscErrorCode z
365    end subroutine petscbinaryreadreal1
366    subroutine petscbinaryreadint1(fd, data, num, count, type, z)
367      use, intrinsic :: ISO_C_binding
368      import ePetscDataType
369      integer4 fd
370      PetscInt data
371      PetscInt num
372      PetscInt count
373      PetscDataType type
374      PetscErrorCode z
375    end subroutine petscbinaryreadint1
376    subroutine petscbinaryreadcomplexcnt(fd, data, num, count, type, z)
377      use, intrinsic :: ISO_C_binding
378      import ePetscDataType
379      integer4 fd
380      PetscComplex data(*)
381      PetscInt num
382      PetscInt count(1)
383      PetscDataType type
384      PetscErrorCode z
385    end subroutine petscbinaryreadcomplexcnt
386    subroutine petscbinaryreadrealcnt(fd, data, num, count, type, z)
387      use, intrinsic :: ISO_C_binding
388      import ePetscDataType
389      integer4 fd
390      PetscReal data(*)
391      PetscInt num
392      PetscInt count(1)
393      PetscDataType type
394      PetscErrorCode z
395    end subroutine petscbinaryreadrealcnt
396    subroutine petscbinaryreadintcnt(fd, data, num, count, type, z)
397      use, intrinsic :: ISO_C_binding
398      import ePetscDataType
399      integer4 fd
400      PetscInt data(*)
401      PetscInt num
402      PetscInt count(1)
403      PetscDataType type
404      PetscErrorCode z
405    end subroutine petscbinaryreadintcnt
406    subroutine petscbinaryreadcomplex1cnt(fd, data, num, count, type, z)
407      use, intrinsic :: ISO_C_binding
408      import ePetscDataType
409      integer4 fd
410      PetscComplex data
411      PetscInt num
412      PetscInt count(1)
413      PetscDataType type
414      PetscErrorCode z
415    end subroutine petscbinaryreadcomplex1cnt
416    subroutine petscbinaryreadreal1cnt(fd, data, num, count, type, z)
417      use, intrinsic :: ISO_C_binding
418      import ePetscDataType
419      integer4 fd
420      PetscReal data
421      PetscInt num
422      PetscInt count(1)
423      PetscDataType type
424      PetscErrorCode z
425    end subroutine petscbinaryreadreal1cnt
426    subroutine petscbinaryreadint1cnt(fd, data, num, count, type, z)
427      use, intrinsic :: ISO_C_binding
428      import ePetscDataType
429      integer4 fd
430      PetscInt data
431      PetscInt num
432      PetscInt count(1)
433      PetscDataType type
434      PetscErrorCode z
435    end subroutine petscbinaryreadint1cnt
436  end interface petscbinaryread
437
438  interface petscbinarywrite
439    subroutine petscbinarywritecomplex(fd, data, num, type, z)
440      use, intrinsic :: ISO_C_binding
441      import ePetscDataType
442      integer4 fd
443      PetscComplex data(*)
444      PetscInt num
445      PetscDataType type
446      PetscErrorCode z
447    end subroutine petscbinarywritecomplex
448    subroutine petscbinarywritereal(fd, data, num, type, z)
449      use, intrinsic :: ISO_C_binding
450      import ePetscDataType
451      integer4 fd
452      PetscReal data(*)
453      PetscInt num
454      PetscDataType type
455      PetscErrorCode z
456    end subroutine petscbinarywritereal
457    subroutine petscbinarywriteint(fd, data, num, type, z)
458      use, intrinsic :: ISO_C_binding
459      import ePetscDataType
460      integer4 fd
461      PetscInt data(*)
462      PetscInt num
463      PetscDataType type
464      PetscErrorCode z
465    end subroutine petscbinarywriteint
466    subroutine petscbinarywritecomplex1(fd, data, num, type, z)
467      use, intrinsic :: ISO_C_binding
468      import ePetscDataType
469      integer4 fd
470      PetscComplex data
471      PetscInt num
472      PetscDataType type
473      PetscErrorCode z
474    end subroutine petscbinarywritecomplex1
475    subroutine petscbinarywritereal1(fd, data, num, type, z)
476      use, intrinsic :: ISO_C_binding
477      import ePetscDataType
478      integer4 fd
479      PetscReal data
480      PetscInt num
481      PetscDataType type
482      PetscErrorCode z
483    end subroutine petscbinarywritereal1
484    subroutine petscbinarywriteint1(fd, data, num, type, z)
485      use, intrinsic :: ISO_C_binding
486      import ePetscDataType
487      integer4 fd
488      PetscInt data
489      PetscInt num
490      PetscDataType type
491      PetscErrorCode z
492    end subroutine petscbinarywriteint1
493  end interface petscbinarywrite
494
495contains
496#if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
497!DEC$ ATTRIBUTES DLLEXPORT::PetscInitializeWithHelp
498#endif
499  subroutine PetscInitializeWithHelp(filename, help, ierr)
500    character(len=*) :: filename
501    character(len=*) :: help
502    PetscErrorCode   :: ierr
503
504    if (filename /= PETSC_NULL_CHARACTER) then
505      call PetscInitializeF(trim(filename), help, ierr)
506      CHKERRQ(ierr)
507    else
508      call PetscInitializeF(filename, help, ierr)
509      CHKERRQ(ierr)
510    end if
511  end subroutine PetscInitializeWithHelp
512
513#if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
514!DEC$ ATTRIBUTES DLLEXPORT::PetscInitializeNoHelp
515#endif
516  subroutine PetscInitializeNoHelp(filename, ierr)
517    character(len=*) :: filename
518    PetscErrorCode   :: ierr
519
520    if (filename /= PETSC_NULL_CHARACTER) then
521      call PetscInitializeF(trim(filename), PETSC_NULL_CHARACTER, ierr)
522      CHKERRQ(ierr)
523    else
524      call PetscInitializeF(filename, PETSC_NULL_CHARACTER, ierr)
525      CHKERRQ(ierr)
526    end if
527  end subroutine PetscInitializeNoHelp
528
529#if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
530!DEC$ ATTRIBUTES DLLEXPORT::PetscInitializeNoArguments
531#endif
532  subroutine PetscInitializeNoArguments(ierr)
533    PetscErrorCode :: ierr
534
535    call PetscInitializeF(PETSC_NULL_CHARACTER, PETSC_NULL_CHARACTER, ierr)
536    CHKERRQ(ierr)
537  end subroutine PetscInitializeNoArguments
538
539#include <../ftn/sys/petscall.hf90>
540end module petscsys
541
542subroutine F90ArraySetRealPointer(array, sz, j, T)
543  use petscsysdef
544  PetscInt :: j, sz
545  PetscReal, target    :: array(1:sz)
546  PetscReal2d, pointer :: T(:)
547
548  T(j + 1)%ptr => array
549end subroutine F90ArraySetRealPointer
550#if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
551!DEC$ ATTRIBUTES DLLEXPORT:: F90ArraySetRealPointer
552#endif
553
554!------------------------------------------------------------------------
555!TODO: generate the modules below by looping over
556!      ftn/sys/XXX.h90
557!      and skipping those in petscall.h
558
559module petscbag
560  use petscsys
561#include <../include/petsc/finclude/petscbag.h>
562#include <../ftn/sys/petscbag.h>
563#include <../ftn/sys/petscbag.h90>
564contains
565#include <../ftn/sys/petscbag.hf90>
566end module petscbag
567
568!------------------------------------------------------------------------
569module petscbm
570  use petscsys
571#include <../include/petsc/finclude/petscbm.h>
572#include <../ftn/sys/petscbm.h>
573#include <../ftn/sys/petscbm.h90>
574contains
575
576#include <../ftn/sys/petscbm.hf90>
577end module petscbm
578
579!------------------------------------------------------------------------
580module petscmatlab
581  use petscsys
582#include <../include/petsc/finclude/petscmatlab.h>
583#include <../ftn/sys/petscmatlab.h>
584#include <../ftn/sys/petscmatlab.h90>
585
586contains
587
588#include <../ftn/sys/petscmatlab.hf90>
589end module petscmatlab
590
591!------------------------------------------------------------------------
592module petscdraw
593  use petscsys
594#include <../include/petsc/finclude/petscdraw.h>
595#include <../ftn/sys/petscdraw.h>
596#include <../ftn/sys/petscdraw.h90>
597
598  PetscEnum, parameter :: PETSC_DRAW_BASIC_COLORS = 33
599  PetscEnum, parameter :: PETSC_DRAW_ROTATE = -1
600  PetscEnum, parameter :: PETSC_DRAW_WHITE = 0
601  PetscEnum, parameter :: PETSC_DRAW_BLACK = 1
602  PetscEnum, parameter :: PETSC_DRAW_RED = 2
603  PetscEnum, parameter :: PETSC_DRAW_GREEN = 3
604  PetscEnum, parameter :: PETSC_DRAW_CYAN = 4
605  PetscEnum, parameter :: PETSC_DRAW_BLUE = 5
606  PetscEnum, parameter :: PETSC_DRAW_MAGENTA = 6
607  PetscEnum, parameter :: PETSC_DRAW_AQUAMARINE = 7
608  PetscEnum, parameter :: PETSC_DRAW_FORESTGREEN = 8
609  PetscEnum, parameter :: PETSC_DRAW_ORANGE = 9
610  PetscEnum, parameter :: PETSC_DRAW_VIOLET = 10
611  PetscEnum, parameter :: PETSC_DRAW_BROWN = 11
612  PetscEnum, parameter :: PETSC_DRAW_PINK = 12
613  PetscEnum, parameter :: PETSC_DRAW_CORAL = 13
614  PetscEnum, parameter :: PETSC_DRAW_GRAY = 14
615  PetscEnum, parameter :: PETSC_DRAW_YELLOW = 15
616  PetscEnum, parameter :: PETSC_DRAW_GOLD = 16
617  PetscEnum, parameter :: PETSC_DRAW_LIGHTPINK = 17
618  PetscEnum, parameter :: PETSC_DRAW_MEDIUMTURQUOISE = 18
619  PetscEnum, parameter :: PETSC_DRAW_KHAKI = 19
620  PetscEnum, parameter :: PETSC_DRAW_DIMGRAY = 20
621  PetscEnum, parameter :: PETSC_DRAW_YELLOWGREEN = 21
622  PetscEnum, parameter :: PETSC_DRAW_SKYBLUE = 22
623  PetscEnum, parameter :: PETSC_DRAW_DARKGREEN = 23
624  PetscEnum, parameter :: PETSC_DRAW_NAVYBLUE = 24
625  PetscEnum, parameter :: PETSC_DRAW_SANDYBROWN = 25
626  PetscEnum, parameter :: PETSC_DRAW_CADETBLUE = 26
627  PetscEnum, parameter :: PETSC_DRAW_POWDERBLUE = 27
628  PetscEnum, parameter :: PETSC_DRAW_DEEPPINK = 28
629  PetscEnum, parameter :: PETSC_DRAW_THISTLE = 29
630  PetscEnum, parameter :: PETSC_DRAW_LIMEGREEN = 30
631  PetscEnum, parameter :: PETSC_DRAW_LAVENDERBLUSH = 31
632  PetscEnum, parameter :: PETSC_DRAW_PLUM = 32
633
634contains
635
636#include <../ftn/sys/petscdraw.hf90>
637end module petscdraw
638
639!------------------------------------------------------------------------
640subroutine PetscSetCOMM(c1, c2)
641  use, intrinsic :: ISO_C_binding
642  use petscmpi, only: PETSC_COMM_WORLD, PETSC_COMM_SELF
643
644  implicit none
645  MPI_Comm c1, c2
646
647  PETSC_COMM_WORLD = c1
648  PETSC_COMM_SELF = c2
649end
650
651subroutine PetscGetCOMM(c1)
652  use, intrinsic :: ISO_C_binding
653  use petscmpi, only: PETSC_COMM_WORLD
654  implicit none
655  MPI_Comm c1
656
657  c1 = PETSC_COMM_WORLD
658end subroutine PetscGetCOMM
659
660subroutine PetscSetModuleBlock()
661  use, intrinsic :: ISO_C_binding
662  use petscsys!, only: PETSC_NULL_CHARACTER,PETSC_NULL_INTEGER,&
663  !  PETSC_NULL_SCALAR,PETSC_NULL_DOUBLE,PETSC_NULL_REAL,&
664  !  PETSC_NULL_BOOL,PETSC_NULL_FUNCTION,PETSC_NULL_MPI_COMM
665  implicit none
666
667  call PetscSetFortranBasePointers(PETSC_NULL_CHARACTER, &
668                                   PETSC_NULL_INTEGER, PETSC_NULL_SCALAR, &
669                                   PETSC_NULL_DOUBLE, PETSC_NULL_REAL, &
670                                   PETSC_NULL_BOOL, PETSC_NULL_ENUM, PETSC_NULL_FUNCTION, &
671                                   PETSC_NULL_MPI_COMM, &
672                                   PETSC_NULL_INTEGER_ARRAY, PETSC_NULL_SCALAR_ARRAY, &
673                                   PETSC_NULL_REAL_ARRAY, PETSC_NULL_INTEGER_POINTER, &
674                                   PETSC_NULL_SCALAR_POINTER, PETSC_NULL_REAL_POINTER)
675end subroutine PetscSetModuleBlock
676
677subroutine PetscSetModuleBlockMPI(freal, fscalar, fsum, finteger)
678  use, intrinsic :: ISO_C_binding
679  use petscmpi, only: MPIU_REAL, MPIU_SUM, MPIU_SCALAR, MPIU_INTEGER
680  implicit none
681
682  integer4 freal, fscalar, fsum, finteger
683
684  MPIU_REAL = freal
685  MPIU_SCALAR = fscalar
686  MPIU_SUM = fsum
687  MPIU_INTEGER = finteger
688end subroutine PetscSetModuleBlockMPI
689
690subroutine PetscSetModuleBlockNumeric(pi, maxreal, minreal, eps, seps, small, pinf, pninf)
691  use petscsys, only: PETSC_PI, PETSC_MAX_REAL, PETSC_MIN_REAL, &
692                      PETSC_MACHINE_EPSILON, PETSC_SQRT_MACHINE_EPSILON, &
693                      PETSC_SMALL, PETSC_INFINITY, PETSC_NINFINITY
694  use, intrinsic :: ISO_C_binding
695  implicit none
696
697  PetscReal pi, maxreal, minreal, eps, seps
698  PetscReal small, pinf, pninf
699
700  PETSC_PI = pi
701  PETSC_MAX_REAL = maxreal
702  PETSC_MIN_REAL = minreal
703  PETSC_MACHINE_EPSILON = eps
704  PETSC_SQRT_MACHINE_EPSILON = seps
705  PETSC_SMALL = small
706  PETSC_INFINITY = pinf
707  PETSC_NINFINITY = pninf
708end subroutine PetscSetModuleBlockNumeric
709