xref: /petsc/src/sys/ftn-mod/petscsysmod.F90 (revision bcd4bb4a4158aa96f212e9537e87b40407faf83e) 
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
273#include <../src/sys/ftn-mod/petscsys.h90>
274#include <../src/sys/ftn-mod/petscviewer.h90>
275#include <../ftn/sys/petscall.h90>
276
277  interface PetscInitialize
278    module procedure PetscInitializeWithHelp, PetscInitializeNoHelp, PetscInitializeNoArguments
279  end interface PetscInitialize
280
281  interface
282    subroutine PetscSetFortranBasePointers( &
283      PETSC_NULL_CHARACTER, &
284      PETSC_NULL_INTEGER, PETSC_NULL_SCALAR, &
285      PETSC_NULL_DOUBLE, PETSC_NULL_REAL, &
286      PETSC_NULL_BOOL, PETSC_NULL_ENUM, PETSC_NULL_FUNCTION, &
287      PETSC_NULL_MPI_COMM, &
288      PETSC_NULL_INTEGER_ARRAY, PETSC_NULL_SCALAR_ARRAY, &
289      PETSC_NULL_REAL_ARRAY, APETSC_NULL_INTEGER_POINTER, &
290      PETSC_NULL_SCALAR_POINTER, PETSC_NULL_REAL_POINTER)
291      use, intrinsic :: ISO_C_binding
292      use petscmpi
293      character(*) PETSC_NULL_CHARACTER
294      PetscInt PETSC_NULL_INTEGER
295      PetscScalar PETSC_NULL_SCALAR
296      PetscFortranDouble PETSC_NULL_DOUBLE
297      PetscReal PETSC_NULL_REAL
298      PetscBool PETSC_NULL_BOOL
299      PetscEnum PETSC_NULL_ENUM
300      external PETSC_NULL_FUNCTION
301      MPIU_Comm PETSC_NULL_MPI_COMM
302      PetscInt PETSC_NULL_INTEGER_ARRAY(*)
303      PetscScalar PETSC_NULL_SCALAR_ARRAY(*)
304      PetscReal PETSC_NULL_REAL_ARRAY(*)
305      PetscInt, pointer :: APETSC_NULL_INTEGER_POINTER(:)
306      PetscScalar, pointer :: PETSC_NULL_SCALAR_POINTER(:)
307      PetscReal, pointer :: PETSC_NULL_REAL_POINTER(:)
308    end subroutine PetscSetFortranBasePointers
309
310    subroutine PetscOptionsString(string, text, man, default, value, flg, ierr)
311      use, intrinsic :: ISO_C_binding
312      character(*) string, text, man, default, value
313      PetscBool flg
314      PetscErrorCode ierr
315    end subroutine PetscOptionsString
316  end interface
317
318  interface petscbinaryread
319    subroutine petscbinaryreadcomplex(fd, data, num, count, type, z)
320      use, intrinsic :: ISO_C_binding
321      import ePetscDataType
322      integer4 fd
323      PetscComplex data(*)
324      PetscInt num
325      PetscInt count
326      PetscDataType type
327      PetscErrorCode z
328    end subroutine petscbinaryreadcomplex
329    subroutine petscbinaryreadreal(fd, data, num, count, type, z)
330      use, intrinsic :: ISO_C_binding
331      import ePetscDataType
332      integer4 fd
333      PetscReal data(*)
334      PetscInt num
335      PetscInt count
336      PetscDataType type
337      PetscErrorCode z
338    end subroutine petscbinaryreadreal
339    subroutine petscbinaryreadint(fd, data, num, count, type, z)
340      use, intrinsic :: ISO_C_binding
341      import ePetscDataType
342      integer4 fd
343      PetscInt data(*)
344      PetscInt num
345      PetscInt count
346      PetscDataType type
347      PetscErrorCode z
348    end subroutine petscbinaryreadint
349    subroutine petscbinaryreadcomplex1(fd, data, num, count, type, z)
350      use, intrinsic :: ISO_C_binding
351      import ePetscDataType
352      integer4 fd
353      PetscComplex data
354      PetscInt num
355      PetscInt count
356      PetscDataType type
357      PetscErrorCode z
358    end subroutine petscbinaryreadcomplex1
359    subroutine petscbinaryreadreal1(fd, data, num, count, type, z)
360      use, intrinsic :: ISO_C_binding
361      import ePetscDataType
362      integer4 fd
363      PetscReal data
364      PetscInt num
365      PetscInt count
366      PetscDataType type
367      PetscErrorCode z
368    end subroutine petscbinaryreadreal1
369    subroutine petscbinaryreadint1(fd, data, num, count, type, z)
370      use, intrinsic :: ISO_C_binding
371      import ePetscDataType
372      integer4 fd
373      PetscInt data
374      PetscInt num
375      PetscInt count
376      PetscDataType type
377      PetscErrorCode z
378    end subroutine petscbinaryreadint1
379    subroutine petscbinaryreadcomplexcnt(fd, data, num, count, type, z)
380      use, intrinsic :: ISO_C_binding
381      import ePetscDataType
382      integer4 fd
383      PetscComplex data(*)
384      PetscInt num
385      PetscInt count(1)
386      PetscDataType type
387      PetscErrorCode z
388    end subroutine petscbinaryreadcomplexcnt
389    subroutine petscbinaryreadrealcnt(fd, data, num, count, type, z)
390      use, intrinsic :: ISO_C_binding
391      import ePetscDataType
392      integer4 fd
393      PetscReal data(*)
394      PetscInt num
395      PetscInt count(1)
396      PetscDataType type
397      PetscErrorCode z
398    end subroutine petscbinaryreadrealcnt
399    subroutine petscbinaryreadintcnt(fd, data, num, count, type, z)
400      use, intrinsic :: ISO_C_binding
401      import ePetscDataType
402      integer4 fd
403      PetscInt data(*)
404      PetscInt num
405      PetscInt count(1)
406      PetscDataType type
407      PetscErrorCode z
408    end subroutine petscbinaryreadintcnt
409    subroutine petscbinaryreadcomplex1cnt(fd, data, num, count, type, z)
410      use, intrinsic :: ISO_C_binding
411      import ePetscDataType
412      integer4 fd
413      PetscComplex data
414      PetscInt num
415      PetscInt count(1)
416      PetscDataType type
417      PetscErrorCode z
418    end subroutine petscbinaryreadcomplex1cnt
419    subroutine petscbinaryreadreal1cnt(fd, data, num, count, type, z)
420      use, intrinsic :: ISO_C_binding
421      import ePetscDataType
422      integer4 fd
423      PetscReal data
424      PetscInt num
425      PetscInt count(1)
426      PetscDataType type
427      PetscErrorCode z
428    end subroutine petscbinaryreadreal1cnt
429    subroutine petscbinaryreadint1cnt(fd, data, num, count, type, z)
430      use, intrinsic :: ISO_C_binding
431      import ePetscDataType
432      integer4 fd
433      PetscInt data
434      PetscInt num
435      PetscInt count(1)
436      PetscDataType type
437      PetscErrorCode z
438    end subroutine petscbinaryreadint1cnt
439  end interface petscbinaryread
440
441  interface petscbinarywrite
442    subroutine petscbinarywritecomplex(fd, data, num, type, z)
443      use, intrinsic :: ISO_C_binding
444      import ePetscDataType
445      integer4 fd
446      PetscComplex data(*)
447      PetscInt num
448      PetscDataType type
449      PetscErrorCode z
450    end subroutine petscbinarywritecomplex
451    subroutine petscbinarywritereal(fd, data, num, type, z)
452      use, intrinsic :: ISO_C_binding
453      import ePetscDataType
454      integer4 fd
455      PetscReal data(*)
456      PetscInt num
457      PetscDataType type
458      PetscErrorCode z
459    end subroutine petscbinarywritereal
460    subroutine petscbinarywriteint(fd, data, num, type, z)
461      use, intrinsic :: ISO_C_binding
462      import ePetscDataType
463      integer4 fd
464      PetscInt data(*)
465      PetscInt num
466      PetscDataType type
467      PetscErrorCode z
468    end subroutine petscbinarywriteint
469    subroutine petscbinarywritecomplex1(fd, data, num, type, z)
470      use, intrinsic :: ISO_C_binding
471      import ePetscDataType
472      integer4 fd
473      PetscComplex data
474      PetscInt num
475      PetscDataType type
476      PetscErrorCode z
477    end subroutine petscbinarywritecomplex1
478    subroutine petscbinarywritereal1(fd, data, num, type, z)
479      use, intrinsic :: ISO_C_binding
480      import ePetscDataType
481      integer4 fd
482      PetscReal data
483      PetscInt num
484      PetscDataType type
485      PetscErrorCode z
486    end subroutine petscbinarywritereal1
487    subroutine petscbinarywriteint1(fd, data, num, type, z)
488      use, intrinsic :: ISO_C_binding
489      import ePetscDataType
490      integer4 fd
491      PetscInt data
492      PetscInt num
493      PetscDataType type
494      PetscErrorCode z
495    end subroutine petscbinarywriteint1
496  end interface petscbinarywrite
497
498contains
499#if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
500!DEC$ ATTRIBUTES DLLEXPORT::PetscInitializeWithHelp
501#endif
502  subroutine PetscInitializeWithHelp(filename, help, ierr)
503    character(len=*) :: filename
504    character(len=*) :: help
505    PetscErrorCode   :: ierr
506
507    if (filename /= PETSC_NULL_CHARACTER) then
508      call PetscInitializeF(trim(filename), help, ierr)
509      CHKERRQ(ierr)
510    else
511      call PetscInitializeF(filename, help, ierr)
512      CHKERRQ(ierr)
513    end if
514  end subroutine PetscInitializeWithHelp
515
516#if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
517!DEC$ ATTRIBUTES DLLEXPORT::PetscInitializeNoHelp
518#endif
519  subroutine PetscInitializeNoHelp(filename, ierr)
520    character(len=*) :: filename
521    PetscErrorCode   :: ierr
522
523    if (filename /= PETSC_NULL_CHARACTER) then
524      call PetscInitializeF(trim(filename), PETSC_NULL_CHARACTER, ierr)
525      CHKERRQ(ierr)
526    else
527      call PetscInitializeF(filename, PETSC_NULL_CHARACTER, ierr)
528      CHKERRQ(ierr)
529    end if
530  end subroutine PetscInitializeNoHelp
531
532#if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
533!DEC$ ATTRIBUTES DLLEXPORT::PetscInitializeNoArguments
534#endif
535  subroutine PetscInitializeNoArguments(ierr)
536    PetscErrorCode :: ierr
537
538    call PetscInitializeF(PETSC_NULL_CHARACTER, PETSC_NULL_CHARACTER, ierr)
539    CHKERRQ(ierr)
540  end subroutine PetscInitializeNoArguments
541
542#include <../ftn/sys/petscall.hf90>
543end module petscsys
544
545subroutine F90ArraySetRealPointer(array, sz, j, T)
546  use petscsysdef
547  PetscInt :: j, sz
548  PetscReal, target    :: array(1:sz)
549  PetscReal2d, pointer :: T(:)
550
551  T(j + 1)%ptr => array
552end subroutine F90ArraySetRealPointer
553#if defined(_WIN32) && defined(PETSC_USE_SHARED_LIBRARIES)
554!DEC$ ATTRIBUTES DLLEXPORT:: F90ArraySetRealPointer
555#endif
556
557!------------------------------------------------------------------------
558!TODO: generate the modules below by looping over
559!      ftn/sys/XXX.h90
560!      and skipping those in petscall.h
561
562module petscbag
563  use petscsys
564#include <../include/petsc/finclude/petscbag.h>
565#include <../ftn/sys/petscbag.h>
566#include <../ftn/sys/petscbag.h90>
567contains
568#include <../ftn/sys/petscbag.hf90>
569end module petscbag
570
571!------------------------------------------------------------------------
572module petscbm
573  use petscsys
574#include <../include/petsc/finclude/petscbm.h>
575#include <../ftn/sys/petscbm.h>
576#include <../ftn/sys/petscbm.h90>
577contains
578
579#include <../ftn/sys/petscbm.hf90>
580end module petscbm
581
582!------------------------------------------------------------------------
583module petscmatlab
584  use petscsys
585#include <../include/petsc/finclude/petscmatlab.h>
586#include <../ftn/sys/petscmatlab.h>
587#include <../ftn/sys/petscmatlab.h90>
588
589contains
590
591#include <../ftn/sys/petscmatlab.hf90>
592end module petscmatlab
593
594!------------------------------------------------------------------------
595module petscdraw
596  use petscsys
597#include <../include/petsc/finclude/petscdraw.h>
598#include <../ftn/sys/petscdraw.h>
599#include <../ftn/sys/petscdraw.h90>
600
601  PetscEnum, parameter :: PETSC_DRAW_BASIC_COLORS = 33
602  PetscEnum, parameter :: PETSC_DRAW_ROTATE = -1
603  PetscEnum, parameter :: PETSC_DRAW_WHITE = 0
604  PetscEnum, parameter :: PETSC_DRAW_BLACK = 1
605  PetscEnum, parameter :: PETSC_DRAW_RED = 2
606  PetscEnum, parameter :: PETSC_DRAW_GREEN = 3
607  PetscEnum, parameter :: PETSC_DRAW_CYAN = 4
608  PetscEnum, parameter :: PETSC_DRAW_BLUE = 5
609  PetscEnum, parameter :: PETSC_DRAW_MAGENTA = 6
610  PetscEnum, parameter :: PETSC_DRAW_AQUAMARINE = 7
611  PetscEnum, parameter :: PETSC_DRAW_FORESTGREEN = 8
612  PetscEnum, parameter :: PETSC_DRAW_ORANGE = 9
613  PetscEnum, parameter :: PETSC_DRAW_VIOLET = 10
614  PetscEnum, parameter :: PETSC_DRAW_BROWN = 11
615  PetscEnum, parameter :: PETSC_DRAW_PINK = 12
616  PetscEnum, parameter :: PETSC_DRAW_CORAL = 13
617  PetscEnum, parameter :: PETSC_DRAW_GRAY = 14
618  PetscEnum, parameter :: PETSC_DRAW_YELLOW = 15
619  PetscEnum, parameter :: PETSC_DRAW_GOLD = 16
620  PetscEnum, parameter :: PETSC_DRAW_LIGHTPINK = 17
621  PetscEnum, parameter :: PETSC_DRAW_MEDIUMTURQUOISE = 18
622  PetscEnum, parameter :: PETSC_DRAW_KHAKI = 19
623  PetscEnum, parameter :: PETSC_DRAW_DIMGRAY = 20
624  PetscEnum, parameter :: PETSC_DRAW_YELLOWGREEN = 21
625  PetscEnum, parameter :: PETSC_DRAW_SKYBLUE = 22
626  PetscEnum, parameter :: PETSC_DRAW_DARKGREEN = 23
627  PetscEnum, parameter :: PETSC_DRAW_NAVYBLUE = 24
628  PetscEnum, parameter :: PETSC_DRAW_SANDYBROWN = 25
629  PetscEnum, parameter :: PETSC_DRAW_CADETBLUE = 26
630  PetscEnum, parameter :: PETSC_DRAW_POWDERBLUE = 27
631  PetscEnum, parameter :: PETSC_DRAW_DEEPPINK = 28
632  PetscEnum, parameter :: PETSC_DRAW_THISTLE = 29
633  PetscEnum, parameter :: PETSC_DRAW_LIMEGREEN = 30
634  PetscEnum, parameter :: PETSC_DRAW_LAVENDERBLUSH = 31
635  PetscEnum, parameter :: PETSC_DRAW_PLUM = 32
636
637contains
638
639#include <../ftn/sys/petscdraw.hf90>
640end module petscdraw
641
642!------------------------------------------------------------------------
643subroutine PetscSetCOMM(c1, c2)
644  use, intrinsic :: ISO_C_binding
645  use petscmpi
646
647  implicit none
648  MPIU_Comm c1, c2
649
650  PETSC_COMM_WORLD = c1
651  PETSC_COMM_SELF = c2
652end
653
654subroutine PetscGetCOMM(c1)
655  use, intrinsic :: ISO_C_binding
656  use petscmpi
657  implicit none
658  MPIU_Comm c1
659
660  c1 = PETSC_COMM_WORLD
661end subroutine PetscGetCOMM
662
663subroutine PetscSetModuleBlock()
664  use, intrinsic :: ISO_C_binding
665  use petscsys!, only: PETSC_NULL_CHARACTER,PETSC_NULL_INTEGER,&
666  !  PETSC_NULL_SCALAR,PETSC_NULL_DOUBLE,PETSC_NULL_REAL,&
667  !  PETSC_NULL_BOOL,PETSC_NULL_FUNCTION,PETSC_NULL_MPI_COMM
668  implicit none
669
670  call PetscSetFortranBasePointers(PETSC_NULL_CHARACTER, &
671                                   PETSC_NULL_INTEGER, PETSC_NULL_SCALAR, &
672                                   PETSC_NULL_DOUBLE, PETSC_NULL_REAL, &
673                                   PETSC_NULL_BOOL, PETSC_NULL_ENUM, PETSC_NULL_FUNCTION, &
674                                   PETSC_NULL_MPI_COMM, &
675                                   PETSC_NULL_INTEGER_ARRAY, PETSC_NULL_SCALAR_ARRAY, &
676                                   PETSC_NULL_REAL_ARRAY, PETSC_NULL_INTEGER_POINTER, &
677                                   PETSC_NULL_SCALAR_POINTER, PETSC_NULL_REAL_POINTER)
678end subroutine PetscSetModuleBlock
679
680subroutine PetscSetModuleBlockMPI(freal, fscalar, fsum, finteger)
681  use, intrinsic :: ISO_C_binding
682  use petscmpi
683  implicit none
684
685  MPIU_Datatype freal, fscalar, finteger
686  MPIU_Op fsum
687
688  MPIU_REAL = freal
689  MPIU_SCALAR = fscalar
690  MPIU_SUM = fsum
691  MPIU_INTEGER = finteger
692end subroutine PetscSetModuleBlockMPI
693
694subroutine PetscSetModuleBlockNumeric(pi, maxreal, minreal, eps, seps, small, pinf, pninf)
695  use petscsys, only: PETSC_PI, PETSC_MAX_REAL, PETSC_MIN_REAL, &
696                      PETSC_MACHINE_EPSILON, PETSC_SQRT_MACHINE_EPSILON, &
697                      PETSC_SMALL, PETSC_INFINITY, PETSC_NINFINITY
698  use, intrinsic :: ISO_C_binding
699  implicit none
700
701  PetscReal pi, maxreal, minreal, eps, seps
702  PetscReal small, pinf, pninf
703
704  PETSC_PI = pi
705  PETSC_MAX_REAL = maxreal
706  PETSC_MIN_REAL = minreal
707  PETSC_MACHINE_EPSILON = eps
708  PETSC_SQRT_MACHINE_EPSILON = seps
709  PETSC_SMALL = small
710  PETSC_INFINITY = pinf
711  PETSC_NINFINITY = pninf
712end subroutine PetscSetModuleBlockNumeric
713