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