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