xref: /petsc/src/sys/objects/ftn-custom/zstartf.c (revision e6e75211d226c622f451867f53ce5d558649ff4f)
1 
2 #include <petsc/private/fortranimpl.h>
3 
4 #if defined(PETSC_HAVE_FORTRAN_CAPS)
5 #define petscinitializefortran_       PETSCINITIALIZEFORTRAN
6 #define petscsetcommonblock_          PETSCSETCOMMONBLOCK
7 #define petscsetfortranbasepointers_  PETSCSETFORTRANBASEPOINTERS
8 #define petsc_null_function_          PETSC_NULL_FUNCTION
9 #define petscsetcommonblocknumeric_   PETSCSETCOMMONBLOCKNUMERIC
10 #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
11 #define petscinitializefortran_       petscinitializefortran
12 #define petscsetcommonblock_          petscsetcommonblock
13 #define petscsetfortranbasepointers_  petscsetfortranbasepointers
14 #define petsc_null_function_          petsc_null_function
15 #define petscsetcommonblocknumeric_   petscsetcommonblocknumeric
16 #endif
17 
18 #if defined(PETSC_HAVE_FORTRAN_UNDERSCORE_UNDERSCORE)
19 #define petsc_null_function_  petsc_null_function__
20 #endif
21 
22 PETSC_EXTERN void PETSC_STDCALL petscsetcommonblock_(MPI_Fint*,MPI_Fint*);
23 PETSC_EXTERN void PETSC_STDCALL petscsetcommonblockmpi_(MPI_Fint*,MPI_Fint*,MPI_Fint*);
24 PETSC_EXTERN void PETSC_STDCALL petscsetcommonblocknumeric_(PetscReal*,PetscReal*,PetscReal*,PetscReal*,PetscReal*,PetscReal*,PetscReal*,PetscReal*);
25 
26 /*@C
27    PetscInitializeFortran - Routine that should be called soon AFTER
28    the call to PetscInitialize() if one is using a C main program
29    that calls Fortran routines that in turn call PETSc routines.
30 
31    Collective on PETSC_COMM_WORLD
32 
33    Level: beginner
34 
35    Notes:
36    PetscInitializeFortran() initializes some of the default viewers,
37    communicators, etc. for use in the Fortran if a user's main program is
38    written in C.  PetscInitializeFortran() is NOT needed if a user's main
39    program is written in Fortran; in this case, just calling
40    PetscInitialize() in the main (Fortran) program is sufficient.
41 
42 .seealso:  PetscInitialize()
43 
44 .keywords: Mixing C and Fortran, passing PETSc objects to Fortran
45 @*/
46 PetscErrorCode PetscInitializeFortran(void)
47 {
48   MPI_Fint c1=0,c2=0;
49 
50   if (PETSC_COMM_WORLD) c1 =  MPI_Comm_c2f(PETSC_COMM_WORLD);
51   c2 =  MPI_Comm_c2f(PETSC_COMM_SELF);
52   petscsetcommonblock_(&c1,&c2);
53 
54 #if defined(PETSC_USE_REAL___FLOAT128)
55   {
56     MPI_Fint freal,fscalar,fsum;
57     freal   = MPI_Type_c2f(MPIU_REAL);
58     fscalar = MPI_Type_c2f(MPIU_SCALAR);
59     fsum    = MPI_Op_c2f(MPIU_SUM);
60     petscsetcommonblockmpi_(&freal,&fscalar,&fsum);
61   }
62 #endif
63 
64   {
65     PetscReal pi = PETSC_PI;
66     PetscReal maxreal = PETSC_MAX_REAL;
67     PetscReal minreal = PETSC_MIN_REAL;
68     PetscReal eps = PETSC_MACHINE_EPSILON;
69     PetscReal seps = PETSC_SQRT_MACHINE_EPSILON;
70     PetscReal small = PETSC_SMALL;
71     PetscReal pinf = PETSC_INFINITY;
72     PetscReal pninf = PETSC_NINFINITY;
73     petscsetcommonblocknumeric_(&pi,&maxreal,&minreal,&eps,&seps,&small,&pinf,&pninf);
74   }
75   return 0;
76 }
77 
78 PETSC_EXTERN void PETSC_STDCALL petscinitializefortran_(int *ierr)
79 {
80   *ierr = PetscInitializeFortran();
81 }
82 
83 PETSC_EXTERN void PETSC_STDCALL petscsetfortranbasepointers_(char *fnull_character PETSC_MIXED_LEN(len),
84                                   void *fnull_integer,void *fnull_scalar,void * fnull_double,
85                                   void *fnull_real,void *fnull_object,
86                                   void* fnull_truth,void (*fnull_function)(void) PETSC_END_LEN(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_OBJECT_Fortran    = fnull_object;
94   PETSC_NULL_BOOL_Fortran      = fnull_truth;
95   PETSC_NULL_FUNCTION_Fortran  = fnull_function;
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 
106 
107