xref: /petsc/src/sys/ftn-mod/petscsysmod.F90 (revision d756bedd70a89ca052be956bccd75c5761cb2ab4)
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_FTN_MODULE)
9  use PETSC_MPI_FTN_MODULE
10#else
11#include "mpif.h"
12#endif
13#endif
14
15  MPIU_Datatype :: MPIU_REAL
16  MPIU_Datatype :: MPIU_SCALAR
17  MPIU_Datatype :: MPIU_INTEGER
18  MPIU_Op :: MPIU_SUM
19
20  MPIU_Comm:: PETSC_COMM_WORLD
21  MPIU_Comm:: PETSC_COMM_SELF
22
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
31end module petscmpi
32
33module 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)
38
39  PetscScalar, parameter :: PetscScalar_Private = (1.0, 0.0)
40  integer, parameter   :: PETSC_SCALAR_KIND = kind(PetscScalar_Private)
41
42  PetscInt, parameter :: PetscInt_Private = 1
43  integer, parameter   :: PETSC_INT_KIND = kind(PetscInt_Private)
44
45  PetscMPIInt, parameter :: PetscMPIInt_Private = 1
46  integer, parameter   :: PETSC_MPIINT_KIND = kind(PetscMPIInt_Private)
47
48  PetscBool, parameter :: PETSC_TRUE = .true._C_BOOL
49  PetscBool, parameter :: PETSC_FALSE = .false._C_BOOL
50
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
59
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
68
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
77
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
86
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
99
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)
106
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
123
124#include <../ftn/sys/petscall.h>
125
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)
138
139  PetscViewer PETSC_VIEWER_STDOUT_
140  PetscViewer PETSC_VIEWER_DRAW_
141  external PETSC_VIEWER_STDOUT_
142  external PETSC_VIEWER_DRAW_
143  external PetscViewerAndFormatDestroy
144
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
159
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
175
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
189
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
194
195  PetscErrorCode, parameter :: PETSC_ERR_MAT_LU_ZRPVT = 71
196  PetscErrorCode, parameter :: PETSC_ERR_MAT_CH_ZRPVT = 81
197
198  PetscErrorCode, parameter :: PETSC_ERR_INT_OVERFLOW = 84
199
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
210
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
233
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
258
259  type tPetscReal2d
260    sequence
261    PetscReal, dimension(:), pointer :: ptr
262  end type tPetscReal2D
263
264end module petscsysdef
265
266module petscsys
267  use, intrinsic :: ISO_C_binding
268  use petscsysdef
269  type(c_ptr) :: petscFtnCtx  ! used by automatically generated XXXGetContext() macros
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      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
307
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
315
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
438
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
495
496contains
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
504
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
513
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
520
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
529
530#if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
531!DEC$ ATTRIBUTES DLLEXPORT::PetscInitializeNoArguments
532#endif
533  subroutine PetscInitializeNoArguments(ierr)
534    PetscErrorCode :: ierr
535
536    call PetscInitializeF(PETSC_NULL_CHARACTER, PETSC_NULL_CHARACTER, ierr)
537    CHKERRQ(ierr)
538  end subroutine PetscInitializeNoArguments
539
540#include <../ftn/sys/petscall.hf90>
541end module petscsys
542
543subroutine F90ArraySetRealPointer(array, sz, j, T)
544  use petscsysdef
545  PetscInt :: j, sz
546  PetscReal, target    :: array(1:sz)
547  PetscReal2d, pointer :: T(:)
548
549  T(j + 1)%ptr => array
550end subroutine F90ArraySetRealPointer
551#if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
552!DEC$ ATTRIBUTES DLLEXPORT:: F90ArraySetRealPointer
553#endif
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
568module petscbm
569  use petscsys
570#include <../include/petsc/finclude/petscbm.h>
571#include <../ftn/sys/petscbm.h>
572#include <../ftn/sys/petscbm.h90>
573contains
574
575#include <../ftn/sys/petscbm.hf90>
576end module petscbm
577
578module petscmatlab
579  use petscsys
580#include <../include/petsc/finclude/petscmatlab.h>
581#include <../ftn/sys/petscmatlab.h>
582#include <../ftn/sys/petscmatlab.h90>
583
584contains
585
586#include <../ftn/sys/petscmatlab.hf90>
587end module petscmatlab
588
589module petscdraw
590  use petscsys
591#include <../include/petsc/finclude/petscdraw.h>
592#include <../ftn/sys/petscdraw.h>
593#include <../ftn/sys/petscdraw.h90>
594
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
630
631contains
632
633#include <../ftn/sys/petscdraw.hf90>
634end module petscdraw
635
636subroutine PetscSetCOMM(c1, c2)
637  use, intrinsic :: ISO_C_binding
638  use petscmpi
639
640  implicit none
641  MPIU_Comm c1, c2
642
643  PETSC_COMM_WORLD = c1
644  PETSC_COMM_SELF = c2
645end
646
647subroutine PetscGetCOMM(c1)
648  use, intrinsic :: ISO_C_binding
649  use petscmpi
650  implicit none
651  MPIU_Comm c1
652
653  c1 = PETSC_COMM_WORLD
654end subroutine PetscGetCOMM
655
656subroutine 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
662
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)
671end subroutine PetscSetModuleBlock
672
673subroutine PetscSetModuleBlockMPI(freal, fscalar, fsum, finteger)
674  use, intrinsic :: ISO_C_binding
675  use petscmpi
676  implicit none
677
678  MPIU_Datatype freal, fscalar, finteger
679  MPIU_Op fsum
680
681  MPIU_REAL = freal
682  MPIU_SCALAR = fscalar
683  MPIU_SUM = fsum
684  MPIU_INTEGER = finteger
685end subroutine PetscSetModuleBlockMPI
686
687subroutine 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
693
694  PetscReal pi, maxreal, minreal, eps, seps
695  PetscReal small, pinf, pninf
696
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
705end subroutine PetscSetModuleBlockNumeric
706