xref: /petsc/src/sys/objects/ftn-custom/zstartf.c (revision f97672e55eacc8688507b9471cd7ec2664d7f203)
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_();
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    Notes:
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 @*/
50 PetscErrorCode PetscInitializeFortran(void)
51 {
52   MPI_Fint c1=0,c2=0;
53 
54   if (PETSC_COMM_WORLD) c1 =  MPI_Comm_c2f(PETSC_COMM_WORLD);
55   c2 =  MPI_Comm_c2f(PETSC_COMM_SELF);
56   petscsetmoduleblock_();
57   petscsetcomm_(&c1,&c2);
58 
59   {
60     MPI_Fint freal,fscalar,fsum,fint;
61     freal   = MPI_Type_c2f(MPIU_REAL);
62     fscalar = MPI_Type_c2f(MPIU_SCALAR);
63     fsum    = MPI_Op_c2f(MPIU_SUM);
64     fint    = MPI_Type_c2f(MPIU_INT);
65     petscsetmoduleblockmpi_(&freal,&fscalar,&fsum,&fint);
66   }
67 
68   {
69     PetscReal pi = PETSC_PI;
70     PetscReal maxreal = PETSC_MAX_REAL;
71     PetscReal minreal = PETSC_MIN_REAL;
72     PetscReal eps = PETSC_MACHINE_EPSILON;
73     PetscReal seps = PETSC_SQRT_MACHINE_EPSILON;
74     PetscReal small = PETSC_SMALL;
75     PetscReal pinf = PETSC_INFINITY;
76     PetscReal pninf = PETSC_NINFINITY;
77     petscsetmoduleblocknumeric_(&pi,&maxreal,&minreal,&eps,&seps,&small,&pinf,&pninf);
78   }
79   return 0;
80 }
81 
82 PETSC_EXTERN void petscinitializefortran_(int *ierr)
83 {
84   *ierr = PetscInitializeFortran();
85 }
86 
87 PETSC_EXTERN void petscsetfortranbasepointers_(char *fnull_character,
88                                   void *fnull_integer,void *fnull_scalar,void * fnull_double,
89                                   void *fnull_real,
90                                   void* fnull_truth,void (*fnull_function)(void),void *fnull_mpi_comm,PETSC_FORTRAN_CHARLEN_T len)
91 {
92   PETSC_NULL_CHARACTER_Fortran = fnull_character;
93   PETSC_NULL_INTEGER_Fortran   = fnull_integer;
94   PETSC_NULL_SCALAR_Fortran    = fnull_scalar;
95   PETSC_NULL_DOUBLE_Fortran    = fnull_double;
96   PETSC_NULL_REAL_Fortran      = fnull_real;
97   PETSC_NULL_BOOL_Fortran      = fnull_truth;
98   PETSC_NULL_FUNCTION_Fortran  = fnull_function;
99   PETSC_NULL_MPI_COMM_Fortran  = fnull_mpi_comm;
100 }
101 
102 /*
103   A valid address for the fortran variable PETSC_NULL_FUNCTION
104 */
105 PETSC_EXTERN void petsc_null_function_(void)
106 {
107   return;
108 }
109 
110