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