xref: /petsc/src/sys/objects/ftn-custom/zstartf.c (revision d5410ed832ff4cf468b67e5bd7e5366a026f63f4)
1ba9a049bSBarry Smith 
2ba9a049bSBarry Smith #include <petsc-private/fortranimpl.h>
3ba9a049bSBarry Smith 
4519f805aSKarl Rupp #if defined(PETSC_HAVE_FORTRAN_CAPS)
5ba9a049bSBarry Smith #define petscinitializefortran_       PETSCINITIALIZEFORTRAN
6ba9a049bSBarry Smith #define petscsetcommonblock_          PETSCSETCOMMONBLOCK
7ba9a049bSBarry Smith #define petscsetfortranbasepointers_  PETSCSETFORTRANBASEPOINTERS
8ba9a049bSBarry Smith #define petsc_null_function_          PETSC_NULL_FUNCTION
9*d5410ed8SSatish Balay #define petscsetcommonblocknumeric_   PETSCSETCOMMONBLOCKNUMERIC
10ba9a049bSBarry Smith #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
11ba9a049bSBarry Smith #define petscinitializefortran_       petscinitializefortran
12ba9a049bSBarry Smith #define petscsetcommonblock_          petscsetcommonblock
13ba9a049bSBarry Smith #define petscsetfortranbasepointers_  petscsetfortranbasepointers
14ba9a049bSBarry Smith #define petsc_null_function_          petsc_null_function
15*d5410ed8SSatish Balay #define petscsetcommonblocknumeric_   petscsetcommonblocknumeric
16ba9a049bSBarry Smith #endif
17ba9a049bSBarry Smith 
18ba9a049bSBarry Smith #if defined(PETSC_HAVE_FORTRAN_UNDERSCORE_UNDERSCORE)
19ba9a049bSBarry Smith #define petsc_null_function_  petsc_null_function__
20ba9a049bSBarry Smith #endif
21ba9a049bSBarry Smith 
2251674068SBarry Smith PETSC_EXTERN void PETSC_STDCALL petscsetcommonblock_(MPI_Fint*,MPI_Fint*);
2351674068SBarry Smith PETSC_EXTERN void PETSC_STDCALL petscsetcommonblockmpi_(MPI_Fint*,MPI_Fint*,MPI_Fint*);
24639f5a5bSBarry Smith PETSC_EXTERN void PETSC_STDCALL petscsetcommonblocknumeric_(PetscReal*,PetscReal*,PetscReal*,PetscReal*,PetscReal*,PetscReal*,PetscReal*,PetscReal*);
25ba9a049bSBarry Smith 
26ba9a049bSBarry Smith /*@C
27ba9a049bSBarry Smith    PetscInitializeFortran - Routine that should be called soon AFTER
28ba9a049bSBarry Smith    the call to PetscInitialize() if one is using a C main program
29ba9a049bSBarry Smith    that calls Fortran routines that in turn call PETSc routines.
30ba9a049bSBarry Smith 
31ba9a049bSBarry Smith    Collective on PETSC_COMM_WORLD
32ba9a049bSBarry Smith 
33ba9a049bSBarry Smith    Level: beginner
34ba9a049bSBarry Smith 
35ba9a049bSBarry Smith    Notes:
36ba9a049bSBarry Smith    PetscInitializeFortran() initializes some of the default viewers,
37ba9a049bSBarry Smith    communicators, etc. for use in the Fortran if a user's main program is
38ba9a049bSBarry Smith    written in C.  PetscInitializeFortran() is NOT needed if a user's main
39ba9a049bSBarry Smith    program is written in Fortran; in this case, just calling
40ba9a049bSBarry Smith    PetscInitialize() in the main (Fortran) program is sufficient.
41ba9a049bSBarry Smith 
42ba9a049bSBarry Smith .seealso:  PetscInitialize()
43ba9a049bSBarry Smith 
44ba9a049bSBarry Smith .keywords: Mixing C and Fortran, passing PETSc objects to Fortran
45ba9a049bSBarry Smith @*/
46ba9a049bSBarry Smith PetscErrorCode PetscInitializeFortran(void)
47ba9a049bSBarry Smith {
4851674068SBarry Smith   MPI_Fint c1=0,c2=0;
49ba9a049bSBarry Smith 
50a297a907SKarl Rupp   if (PETSC_COMM_WORLD) c1 =  MPI_Comm_c2f(PETSC_COMM_WORLD);
51ba9a049bSBarry Smith   c2 =  MPI_Comm_c2f(PETSC_COMM_SELF);
52ba9a049bSBarry Smith   petscsetcommonblock_(&c1,&c2);
5351674068SBarry Smith 
54122e1178SBarry Smith #if defined(PETSC_USE_REAL___FLOAT128)
5551674068SBarry Smith   {
5651674068SBarry Smith     MPI_Fint freal,fscalar,fsum;
57122e1178SBarry Smith     freal   = MPI_Type_c2f(MPIU_REAL);
58122e1178SBarry Smith     fscalar = MPI_Type_c2f(MPIU_SCALAR);
59122e1178SBarry Smith     fsum    = MPI_Op_c2f(MPIU_SUM);
60122e1178SBarry Smith     petscsetcommonblockmpi_(&freal,&fscalar,&fsum);
6151674068SBarry Smith   }
6251674068SBarry Smith #endif
63639f5a5bSBarry Smith 
64639f5a5bSBarry Smith   {
65639f5a5bSBarry Smith     PetscReal pi = PETSC_PI;
66639f5a5bSBarry Smith     PetscReal maxreal = PETSC_MAX_REAL;
67639f5a5bSBarry Smith     PetscReal minreal = PETSC_MIN_REAL;
68639f5a5bSBarry Smith     PetscReal eps = PETSC_MACHINE_EPSILON;
69639f5a5bSBarry Smith     PetscReal seps = PETSC_SQRT_MACHINE_EPSILON;
70639f5a5bSBarry Smith     PetscReal small = PETSC_SMALL;
71639f5a5bSBarry Smith     PetscReal pinf = PETSC_INFINITY;
72639f5a5bSBarry Smith     PetscReal pninf = PETSC_NINFINITY;
73639f5a5bSBarry Smith     petscsetcommonblocknumeric_(&pi,&maxreal,&minreal,&eps,&seps,&small,&pinf,&pninf);
74639f5a5bSBarry Smith   }
75ba9a049bSBarry Smith   return 0;
76ba9a049bSBarry Smith }
77ba9a049bSBarry Smith 
788cc058d9SJed Brown PETSC_EXTERN void PETSC_STDCALL petscinitializefortran_(int *ierr)
79ba9a049bSBarry Smith {
80ba9a049bSBarry Smith   *ierr = PetscInitializeFortran();
81ba9a049bSBarry Smith }
82ba9a049bSBarry Smith 
838cc058d9SJed Brown PETSC_EXTERN void PETSC_STDCALL petscsetfortranbasepointers_(char *fnull_character PETSC_MIXED_LEN(len),
840298fd71SBarry Smith                                   void *fnull_integer,void *fnull_scalar,void * fnull_double,
85ba9a049bSBarry Smith                                   void *fnull_real,void *fnull_object,
86ba9a049bSBarry Smith                                   void* fnull_truth,void (*fnull_function)(void) PETSC_END_LEN(len))
87ba9a049bSBarry Smith {
88ba9a049bSBarry Smith   PETSC_NULL_CHARACTER_Fortran = fnull_character;
89ba9a049bSBarry Smith   PETSC_NULL_INTEGER_Fortran   = fnull_integer;
90ba9a049bSBarry Smith   PETSC_NULL_SCALAR_Fortran    = fnull_scalar;
91ba9a049bSBarry Smith   PETSC_NULL_DOUBLE_Fortran    = fnull_double;
92ba9a049bSBarry Smith   PETSC_NULL_REAL_Fortran      = fnull_real;
93ba9a049bSBarry Smith   PETSC_NULL_OBJECT_Fortran    = fnull_object;
94ba9a049bSBarry Smith   PETSC_NULL_BOOL_Fortran      = fnull_truth;
95ba9a049bSBarry Smith   PETSC_NULL_FUNCTION_Fortran  = fnull_function;
96ba9a049bSBarry Smith }
97ba9a049bSBarry Smith 
98ba9a049bSBarry Smith /*
99ba9a049bSBarry Smith   A valid address for the fortran variable PETSC_NULL_FUNCTION
100ba9a049bSBarry Smith */
1018cc058d9SJed Brown PETSC_EXTERN void petsc_null_function_(void)
102ba9a049bSBarry Smith {
103ba9a049bSBarry Smith   return;
104ba9a049bSBarry Smith }
105ba9a049bSBarry Smith 
106ba9a049bSBarry Smith 
107