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