xref: /petsc/src/sys/objects/ftn-custom/zstartf.c (revision 66af8762ec03dbef0e079729eb2a1734a35ed7ff)
1 #include <petsc/private/fortranimpl.h>
2 
3 #if defined(PETSC_HAVE_FORTRAN_CAPS)
4   #define petscinitializefortran_      PETSCINITIALIZEFORTRAN
5   #define petscsetmoduleblock_         PETSCSETMODULEBLOCK
6   #define petscsetmoduleblockmpi_      PETSCSETMODULEBLOCKMPI
7   #define petscsetfortranbasepointers_ PETSCSETFORTRANBASEPOINTERS
8   #define petsc_null_function_         PETSC_NULL_FUNCTION
9   #define petscsetmoduleblocknumeric_  PETSCSETMODULEBLOCKNUMERIC
10   #define petscsetcomm_                PETSCSETCOMM
11 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
12   #define petscinitializefortran_      petscinitializefortran
13   #define petscsetmoduleblock_         petscsetmoduleblock
14   #define petscsetmoduleblockmpi_      petscsetmoduleblockmpi
15   #define petscsetfortranbasepointers_ petscsetfortranbasepointers
16   #define petsc_null_function_         petsc_null_function
17   #define petscsetmoduleblocknumeric_  petscsetmoduleblocknumeric
18   #define petscsetcomm_                petscsetcomm
19 #endif
20 
21 #if defined(PETSC_HAVE_FORTRAN_UNDERSCORE_UNDERSCORE)
22   #define petsc_null_function_ petsc_null_function__
23 #endif
24 
25 PETSC_EXTERN void petscsetmoduleblock_(void);
26 PETSC_EXTERN void petscsetmoduleblockmpi_(MPI_Fint *, MPI_Fint *, MPI_Fint *, MPI_Fint *);
27 PETSC_EXTERN void petscsetmoduleblocknumeric_(PetscReal *, PetscReal *, PetscReal *, PetscReal *, PetscReal *, PetscReal *, PetscReal *, PetscReal *);
28 PETSC_EXTERN void petscsetcomm_(MPI_Fint *, MPI_Fint *);
29 
30 /*@C
31    PetscInitializeFortran - Routine that should be called soon AFTER
32    the call to `PetscInitialize()` if one is using a C main program
33    that calls Fortran routines that in turn call PETSc routines.
34 
35    Collective on `PETSC_COMM_WORLD`
36 
37    Level: beginner
38 
39    Note:
40    `PetscInitializeFortran()` initializes some of the default viewers,
41    communicators, etc. for use in the Fortran if a user's main program is
42    written in C.  `PetscInitializeFortran()` is NOT needed if a user's main
43    program is written in Fortran; in this case, just calling
44    `PetscInitialize()` in the main (Fortran) program is sufficient.
45 
46 .seealso:  PetscInitialize()
47 @*/
48 PetscErrorCode PetscInitializeFortran(void)
49 {
50   MPI_Fint c1 = 0, c2 = 0;
51 
52   if (PETSC_COMM_WORLD) c1 = MPI_Comm_c2f(PETSC_COMM_WORLD);
53   c2 = MPI_Comm_c2f(PETSC_COMM_SELF);
54   petscsetmoduleblock_();
55   petscsetcomm_(&c1, &c2);
56 
57   {
58     MPI_Fint freal, fscalar, fsum, fint;
59     freal   = MPI_Type_c2f(MPIU_REAL);
60     fscalar = MPI_Type_c2f(MPIU_SCALAR);
61     fsum    = MPI_Op_c2f(MPIU_SUM);
62     fint    = MPI_Type_c2f(MPIU_INT);
63     petscsetmoduleblockmpi_(&freal, &fscalar, &fsum, &fint);
64   }
65 
66   {
67     PetscReal pi      = PETSC_PI;
68     PetscReal maxreal = PETSC_MAX_REAL;
69     PetscReal minreal = PETSC_MIN_REAL;
70     PetscReal eps     = PETSC_MACHINE_EPSILON;
71     PetscReal seps    = PETSC_SQRT_MACHINE_EPSILON;
72     PetscReal small   = PETSC_SMALL;
73     PetscReal pinf    = PETSC_INFINITY;
74     PetscReal pninf   = PETSC_NINFINITY;
75     petscsetmoduleblocknumeric_(&pi, &maxreal, &minreal, &eps, &seps, &small, &pinf, &pninf);
76   }
77   return PETSC_SUCCESS;
78 }
79 
80 PETSC_EXTERN void petscinitializefortran_(int *ierr)
81 {
82   *ierr = PetscInitializeFortran();
83 }
84 
85 PETSC_EXTERN void petscsetfortranbasepointers_(char *fnull_character, void *fnull_integer, void *fnull_scalar, void *fnull_double, void *fnull_real, void *fnull_truth, void (*fnull_function)(void), void *fnull_mpi_comm, PETSC_FORTRAN_CHARLEN_T len)
86 {
87   PETSC_NULL_CHARACTER_Fortran = fnull_character;
88   PETSC_NULL_INTEGER_Fortran   = fnull_integer;
89   PETSC_NULL_SCALAR_Fortran    = fnull_scalar;
90   PETSC_NULL_DOUBLE_Fortran    = fnull_double;
91   PETSC_NULL_REAL_Fortran      = fnull_real;
92   PETSC_NULL_BOOL_Fortran      = fnull_truth;
93   PETSC_NULL_FUNCTION_Fortran  = fnull_function;
94   PETSC_NULL_MPI_COMM_Fortran  = fnull_mpi_comm;
95 }
96 
97 /*
98   A valid address for the fortran variable PETSC_NULL_FUNCTION
99 */
100 PETSC_EXTERN void petsc_null_function_(void)
101 {
102   return;
103 }
104