xref: /petsc/src/sys/objects/ftn-custom/zstart.c (revision 95c0884e6f7665b705eebf88174e89dc920c2fc0)
1ba9a049bSBarry Smith /*
2ba9a049bSBarry Smith   This file contains Fortran stubs for PetscInitialize and Finalize.
3ba9a049bSBarry Smith */
4ba9a049bSBarry Smith 
5ba9a049bSBarry Smith /*
6ba9a049bSBarry Smith     This is to prevent the Cray T3D version of MPI (University of Edinburgh)
7ba9a049bSBarry Smith   from stupidly redefining MPI_INIT(). They put this in to detect errors
8ba9a049bSBarry Smith   in C code,but here I do want to be calling the Fortran version from a
9ba9a049bSBarry Smith   C subroutine.
10ba9a049bSBarry Smith */
11ba9a049bSBarry Smith #define T3DMPI_FORTRAN
12ba9a049bSBarry Smith #define T3EMPI_FORTRAN
13ba9a049bSBarry Smith 
14af0996ceSBarry Smith #include <petsc/private/fortranimpl.h>
15ba9a049bSBarry Smith 
16519f805aSKarl Rupp #if defined(PETSC_HAVE_FORTRAN_CAPS)
17ba9a049bSBarry Smith #define petscinitialize_              PETSCINITIALIZE
18fb2dfec1SJacht Volker #define petscinitializenoarguments_   PETSCINITIALIZENOARGUMENTS
19ba9a049bSBarry Smith #define petscfinalize_                PETSCFINALIZE
20ba9a049bSBarry Smith #define petscend_                     PETSCEND
21ba9a049bSBarry Smith #define iargc_                        IARGC
22ba9a049bSBarry Smith #define getarg_                       GETARG
23ba9a049bSBarry Smith #define mpi_init_                     MPI_INIT
24ba9a049bSBarry Smith #define petscgetcommoncomm_           PETSCGETCOMMONCOMM
25541b5888SSatish Balay #define petsccommandargumentcount_    PETSCCOMMANDARGUMENTCOUNT
26541b5888SSatish Balay #define petscgetcommandargument_      PETSCGETCOMMANDARGUMENT
27ba9a049bSBarry Smith #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
28ba9a049bSBarry Smith #define petscinitialize_              petscinitialize
291bdb895aSBarry Smith #define petscinitializenoarguments_   petscinitializenoarguments
30ba9a049bSBarry Smith #define petscfinalize_                petscfinalize
31ba9a049bSBarry Smith #define petscend_                     petscend
32ba9a049bSBarry Smith #define mpi_init_                     mpi_init
33ba9a049bSBarry Smith #define iargc_                        iargc
34ba9a049bSBarry Smith #define getarg_                       getarg
35ba9a049bSBarry Smith #define petscgetcommoncomm_           petscgetcommoncomm
36541b5888SSatish Balay #define petsccommandargumentcount_    petsccommandargumentcount
37541b5888SSatish Balay #define petscgetcommandargument_      petscgetcommandargument
38ba9a049bSBarry Smith #endif
39ba9a049bSBarry Smith 
40ba9a049bSBarry Smith #if defined(PETSC_HAVE_NAGF90)
41ba9a049bSBarry Smith #undef iargc_
42ba9a049bSBarry Smith #undef getarg_
43ba9a049bSBarry Smith #define iargc_  f90_unix_MP_iargc
44ba9a049bSBarry Smith #define getarg_ f90_unix_MP_getarg
45ba9a049bSBarry Smith #endif
46ba9a049bSBarry Smith #if defined(PETSC_USE_NARGS) /* Digital Fortran */
47ba9a049bSBarry Smith #undef iargc_
48ba9a049bSBarry Smith #undef getarg_
49ba9a049bSBarry Smith #define iargc_  NARGS
50ba9a049bSBarry Smith #define getarg_ GETARG
51ba9a049bSBarry Smith #elif defined(PETSC_HAVE_PXFGETARG_NEW)  /* cray x1 */
52ba9a049bSBarry Smith #undef iargc_
53ba9a049bSBarry Smith #undef getarg_
54ba9a049bSBarry Smith #define iargc_  ipxfargc_
55ba9a049bSBarry Smith #define getarg_ pxfgetarg_
56ba9a049bSBarry Smith #endif
57ba9a049bSBarry Smith #if defined(PETSC_HAVE_FORTRAN_IARGC_UNDERSCORE) /* HPUX + no underscore */
58ba9a049bSBarry Smith #undef iargc_
59ba9a049bSBarry Smith #undef getarg_
60ba9a049bSBarry Smith #define iargc_   iargc_
61ba9a049bSBarry Smith #define getarg_  getarg_
62ba9a049bSBarry Smith #endif
63541b5888SSatish Balay 
64541b5888SSatish Balay #if defined(PETSC_HAVE_FORTRAN_GET_COMMAND_ARGUMENT) /* Fortran 2003 */
65541b5888SSatish Balay #undef iargc_
66541b5888SSatish Balay #undef getarg_
67541b5888SSatish Balay #define iargc_ petsccommandargumentcount_
68541b5888SSatish Balay #define getarg_ petscgetcommandargument_
69541b5888SSatish Balay #elif defined(PETSC_HAVE_GFORTRAN_IARGC) /* gfortran from gcc4 */
70ba9a049bSBarry Smith #undef iargc_
71ba9a049bSBarry Smith #undef getarg_
72ba9a049bSBarry Smith #define iargc_  _gfortran_iargc
73ba9a049bSBarry Smith #define getarg_ _gfortran_getarg_i4
74ba9a049bSBarry Smith #elif defined(PETSC_HAVE_BGL_IARGC) /* bgl g77 has different external & internal name mangling */
75ba9a049bSBarry Smith #undef iargc_
76ba9a049bSBarry Smith #undef getarg_
77ba9a049bSBarry Smith #define iargc  iargc_
78ba9a049bSBarry Smith #define getarg getarg_
79ba9a049bSBarry Smith #endif
80ba9a049bSBarry Smith 
81ba9a049bSBarry Smith /*
82ba9a049bSBarry Smith     The extra _ is because the f2c compiler puts an
83ba9a049bSBarry Smith   extra _ at the end if the original routine name
84ba9a049bSBarry Smith   contained any _.
85ba9a049bSBarry Smith */
86ba9a049bSBarry Smith #if defined(PETSC_HAVE_FORTRAN_UNDERSCORE_UNDERSCORE)
87ba9a049bSBarry Smith #define mpi_init_             mpi_init__
88ba9a049bSBarry Smith #endif
89ba9a049bSBarry Smith 
90a7b85bbcSSatish Balay #if defined(PETSC_HAVE_MPIUNI)
91a7b85bbcSSatish Balay #if defined(mpi_init_)
92a7b85bbcSSatish Balay #undef mpi_init_
93a7b85bbcSSatish Balay #if defined(PETSC_HAVE_FORTRAN_CAPS)
94a7b85bbcSSatish Balay #define mpi_init_             PETSC_MPI_INIT
95a7b85bbcSSatish Balay #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
96a7b85bbcSSatish Balay #define mpi_init_             petsc_mpi_init
97a7b85bbcSSatish Balay #elif defined(PETSC_HAVE_FORTRAN_UNDERSCORE_UNDERSCORE)
98a7b85bbcSSatish Balay #define mpi_init_             petsc_mpi_init__
99a7b85bbcSSatish Balay #endif
100a7b85bbcSSatish Balay #else    /* mpi_init_ */
101a7b85bbcSSatish Balay #define mpi_init_             petsc_mpi_init_
102a7b85bbcSSatish Balay #endif   /* mpi_init_ */
103a7b85bbcSSatish Balay #endif   /* PETSC_HAVE_MPIUNI */
104a7b85bbcSSatish Balay 
1058cc058d9SJed Brown PETSC_EXTERN void PETSC_STDCALL mpi_init_(int*);
1068cc058d9SJed Brown PETSC_EXTERN void PETSC_STDCALL petscgetcommoncomm_(PetscMPIInt*);
107ba9a049bSBarry Smith 
108ba9a049bSBarry Smith /*
109ba9a049bSBarry Smith      Different Fortran compilers handle command lines in different ways
110ba9a049bSBarry Smith */
111541b5888SSatish Balay #if defined(PETSC_HAVE_FORTRAN_GET_COMMAND_ARGUMENT) /* Fortran 2003  - same as 'else' case */
112a30ec4eaSSatish Balay PETSC_EXTERN int iargc_(void);
113541b5888SSatish Balay PETSC_EXTERN void getarg_(int*,char*,int);
114541b5888SSatish Balay #elif defined(PETSC_USE_NARGS)
1158cc058d9SJed Brown PETSC_EXTERN short __stdcall NARGS();
1168cc058d9SJed Brown PETSC_EXTERN void __stdcall GETARG(short*,char*,int,short *);
117ba9a049bSBarry Smith 
118ba9a049bSBarry Smith #elif defined(PETSC_HAVE_FORTRAN_STDCALL)
1198cc058d9SJed Brown PETSC_EXTERN int PETSC_STDCALL IARGC();
1208cc058d9SJed Brown PETSC_EXTERN void PETSC_STDCALL GETARG(int *,char *,int);
121ba9a049bSBarry Smith 
122ba9a049bSBarry Smith #elif defined(PETSC_HAVE_PXFGETARG_NEW)
1238cc058d9SJed Brown PETSC_EXTERN int iargc_();
1248cc058d9SJed Brown PETSC_EXTERN void getarg_(int*,char*,int*,int*,int);
125ba9a049bSBarry Smith 
126ba9a049bSBarry Smith #else
1278cc058d9SJed Brown PETSC_EXTERN int iargc_();
1288cc058d9SJed Brown PETSC_EXTERN void getarg_(int*,char*,int);
129ba9a049bSBarry Smith /*
130ba9a049bSBarry Smith       The Cray T3D/T3E use the PXFGETARG() function
131ba9a049bSBarry Smith */
132ba9a049bSBarry Smith #if defined(PETSC_HAVE_PXFGETARG)
1338cc058d9SJed Brown PETSC_EXTERN void PXFGETARG(int*,_fcd,int*,int*);
134ba9a049bSBarry Smith #endif
135ba9a049bSBarry Smith #endif
136ba9a049bSBarry Smith 
137570b7f6dSBarry Smith #if (defined(PETSC_HAVE_COMPLEX) && !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX)) || defined(PETSC_USE_REAL___FLOAT128) || defined(PETSC_USE_REAL___FP16)
138*95c0884eSLisandro Dalcin PETSC_EXTERN MPI_Op MPIU_SUM;
13999e0435eSBarry Smith 
1408cc058d9SJed Brown PETSC_EXTERN void MPIAPI PetscSum_Local(void*,void*,PetscMPIInt*,MPI_Datatype*);
14199e0435eSBarry Smith 
142ba9a049bSBarry Smith #endif
143570b7f6dSBarry Smith #if defined(PETSC_USE_REAL___FLOAT128) || defined(PETSC_USE_REAL___FP16)
14499e0435eSBarry Smith 
1458cc058d9SJed Brown PETSC_EXTERN void MPIAPI PetscSum_Local(void*,void*,PetscMPIInt*,MPI_Datatype*);
1468cc058d9SJed Brown PETSC_EXTERN void MPIAPI PetscMax_Local(void*,void*,PetscMPIInt*,MPI_Datatype*);
1478cc058d9SJed Brown PETSC_EXTERN void MPIAPI PetscMin_Local(void*,void*,PetscMPIInt*,MPI_Datatype*);
148ba9a049bSBarry Smith #endif
149ba9a049bSBarry Smith 
150367daffbSBarry Smith PETSC_INTERN void MPIAPI MPIU_MaxSum_Local(void*,void*,PetscMPIInt*,MPI_Datatype*);
1518cc058d9SJed Brown PETSC_EXTERN PetscMPIInt MPIAPI Petsc_DelCounter(MPI_Comm,PetscMPIInt,void*,void*);
152da3039f7SJed Brown PETSC_EXTERN PetscMPIInt MPIAPI Petsc_DelComm_Inner(MPI_Comm,PetscMPIInt,void*,void*);
153da3039f7SJed Brown PETSC_EXTERN PetscMPIInt MPIAPI Petsc_DelComm_Outer(MPI_Comm,PetscMPIInt,void*,void*);
154ba9a049bSBarry Smith 
155*95c0884eSLisandro Dalcin PETSC_INTERN PetscErrorCode PetscOptionsCheckInitial_Private(void);
156*95c0884eSLisandro Dalcin PETSC_INTERN PetscErrorCode PetscOptionsCheckInitial_Components(void);
157*95c0884eSLisandro Dalcin PETSC_INTERN PetscErrorCode PetscInitialize_DynamicLibraries(void);
158ba9a049bSBarry Smith #if defined(PETSC_USE_LOG)
159*95c0884eSLisandro Dalcin PETSC_INTERN PetscErrorCode PetscLogInitialize(void);
160ba9a049bSBarry Smith #endif
161*95c0884eSLisandro Dalcin PETSC_EXTERN PetscErrorCode PetscMallocAlign(size_t,int,const char[],const char[],void**);
162*95c0884eSLisandro Dalcin PETSC_EXTERN PetscErrorCode PetscFreeAlign(void*,int,const char[],const char[]);
163*95c0884eSLisandro Dalcin PETSC_INTERN int  PetscGlobalArgc;
164*95c0884eSLisandro Dalcin PETSC_INTERN char **PetscGlobalArgs;
165ba9a049bSBarry Smith 
166ba9a049bSBarry Smith /*
167ba9a049bSBarry Smith     Reads in Fortran command line argments and sends them to
168d5be86a5SBarry Smith   all processors.
169ba9a049bSBarry Smith */
170ba9a049bSBarry Smith 
171ba9a049bSBarry Smith PetscErrorCode PETScParseFortranArgs_Private(int *argc,char ***argv)
172ba9a049bSBarry Smith {
173ba9a049bSBarry Smith #if defined(PETSC_USE_NARGS)
174ba9a049bSBarry Smith   short          i,flg;
175ba9a049bSBarry Smith #else
176ba9a049bSBarry Smith   int            i;
177ba9a049bSBarry Smith #endif
178ba9a049bSBarry Smith   PetscErrorCode ierr;
179ba9a049bSBarry Smith   int            warg = 256;
180ba9a049bSBarry Smith   PetscMPIInt    rank;
181ba9a049bSBarry Smith   char           *p;
182ba9a049bSBarry Smith 
183ba9a049bSBarry Smith   ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
184ba9a049bSBarry Smith   if (!rank) {
185ba9a049bSBarry Smith #if defined(PETSC_HAVE_IARG_COUNT_PROGNAME)
186ba9a049bSBarry Smith     *argc = iargc_();
187ba9a049bSBarry Smith #else
188ba9a049bSBarry Smith     /* most compilers do not count the program name for argv[0] */
189ba9a049bSBarry Smith     *argc = 1 + iargc_();
190ba9a049bSBarry Smith #endif
191ba9a049bSBarry Smith   }
192ba9a049bSBarry Smith   ierr = MPI_Bcast(argc,1,MPI_INT,0,PETSC_COMM_WORLD);CHKERRQ(ierr);
193ba9a049bSBarry Smith 
194ba9a049bSBarry Smith   /* PetscTrMalloc() not yet set, so don't use PetscMalloc() */
195efca3c55SSatish Balay   ierr = PetscMallocAlign((*argc+1)*(warg*sizeof(char)+sizeof(char*)),0,0,0,(void**)argv);CHKERRQ(ierr);
196ba9a049bSBarry Smith   (*argv)[0] = (char*)(*argv + *argc + 1);
197ba9a049bSBarry Smith 
198ba9a049bSBarry Smith   if (!rank) {
199ba9a049bSBarry Smith     ierr = PetscMemzero((*argv)[0],(*argc)*warg*sizeof(char));CHKERRQ(ierr);
200ba9a049bSBarry Smith     for (i=0; i<*argc; i++) {
201ba9a049bSBarry Smith       (*argv)[i+1] = (*argv)[i] + warg;
202541b5888SSatish Balay #if defined (PETSC_HAVE_FORTRAN_GET_COMMAND_ARGUMENT) /* same as 'else' case */
203541b5888SSatish Balay       getarg_(&i,(*argv)[i],warg);
204541b5888SSatish Balay #elif defined(PETSC_HAVE_PXFGETARG_NEW)
205ba9a049bSBarry Smith       {char *tmp = (*argv)[i];
206ba9a049bSBarry Smith       int ilen;
207ba9a049bSBarry Smith       getarg_(&i,tmp,&ilen,&ierr,warg);CHKERRQ(ierr);
208a297a907SKarl Rupp       tmp[ilen] = 0;}
209ba9a049bSBarry Smith #elif defined(PETSC_USE_NARGS)
210ba9a049bSBarry Smith       GETARG(&i,(*argv)[i],warg,&flg);
211ba9a049bSBarry Smith #else
212ba9a049bSBarry Smith       /*
213ba9a049bSBarry Smith       Because the stupid #defines above define all kinds of things to getarg_ we cannot do this test
214ba9a049bSBarry Smith       #elif defined(PETSC_HAVE_GETARG)
215ba9a049bSBarry Smith       getarg_(&i,(*argv)[i],warg);
216ba9a049bSBarry Smith       #else
217ba9a049bSBarry Smith          SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot get Fortran command line arguments");
218ba9a049bSBarry Smith       */
219ba9a049bSBarry Smith       getarg_(&i,(*argv)[i],warg);
220ba9a049bSBarry Smith #endif
221ba9a049bSBarry Smith       /* zero out garbage at end of each argument */
222ba9a049bSBarry Smith       p = (*argv)[i] + warg-1;
223ba9a049bSBarry Smith       while (p > (*argv)[i]) {
224ba9a049bSBarry Smith         if (*p == ' ') *p = 0;
225ba9a049bSBarry Smith         p--;
226ba9a049bSBarry Smith       }
227ba9a049bSBarry Smith     }
228ba9a049bSBarry Smith   }
229ba9a049bSBarry Smith   ierr = MPI_Bcast((*argv)[0],*argc*warg,MPI_CHAR,0,PETSC_COMM_WORLD);CHKERRQ(ierr);
230ba9a049bSBarry Smith   if (rank) {
231a297a907SKarl Rupp     for (i=0; i<*argc; i++) (*argv)[i+1] = (*argv)[i] + warg;
232ba9a049bSBarry Smith   }
233ba9a049bSBarry Smith   return 0;
234ba9a049bSBarry Smith }
235ba9a049bSBarry Smith 
236b2bbaf76SBarry Smith #if defined(PETSC_SERIALIZE_FUNCTIONS)
237*95c0884eSLisandro Dalcin PETSC_INTERN PetscFPT PetscFPTData;
238ef19f930SBarry Smith #endif
239ef19f930SBarry Smith 
240ba9a049bSBarry Smith /* -----------------------------------------------------------------------------------------------*/
241ba9a049bSBarry Smith 
24211525c0dSBarry Smith #if defined(PETSC_HAVE_SAWS)
24311525c0dSBarry Smith #include <petscviewersaws.h>
244*95c0884eSLisandro Dalcin PETSC_INTERN PetscErrorCode  PetscInitializeSAWs(const char[]);
24511525c0dSBarry Smith #endif
246ba9a049bSBarry Smith 
2477f20dbc5SBarry Smith PETSC_EXTERN PetscMPIInt MPIAPI Petsc_DelShared(MPI_Comm,PetscMPIInt,void *,void *);
2487f20dbc5SBarry Smith 
249ba9a049bSBarry Smith /*
250ba9a049bSBarry Smith     petscinitialize - Version called from Fortran.
251ba9a049bSBarry Smith 
252ba9a049bSBarry Smith     Notes:
253ba9a049bSBarry Smith       Since this is called from Fortran it does not return error codes
254ba9a049bSBarry Smith 
255ba9a049bSBarry Smith */
256390e1bf2SBarry Smith static void petscinitialize_internal(char* filename, PetscInt len, PetscBool readarguments, PetscErrorCode *ierr)
257ba9a049bSBarry Smith {
2584b60c348SBarry Smith   int            j,i;
259ba9a049bSBarry Smith #if defined (PETSC_USE_NARGS)
2604b60c348SBarry Smith   short          flg;
261ba9a049bSBarry Smith #endif
262ba9a049bSBarry Smith   int            flag;
263ba9a049bSBarry Smith   PetscMPIInt    size;
264ba9a049bSBarry Smith   char           *t1,name[256],hostname[64];
265ba9a049bSBarry Smith   PetscMPIInt    f_petsc_comm_world;
266ba9a049bSBarry Smith 
2674b60c348SBarry Smith   *ierr = PetscMemzero(name,sizeof(name)); if (*ierr) return;
268ba9a049bSBarry Smith   if (PetscInitializeCalled) {*ierr = 0; return;}
269ba9a049bSBarry Smith 
270ba9a049bSBarry Smith   /* this must be initialized in a routine, not as a constant declaration*/
271ba9a049bSBarry Smith   PETSC_STDOUT = stdout;
272ba9a049bSBarry Smith   PETSC_STDERR = stderr;
273ba9a049bSBarry Smith 
2740c30907bSSatish Balay   /* on Windows - set printf to default to printing 2 digit exponents */
2750c30907bSSatish Balay #if defined(PETSC_HAVE__SET_OUTPUT_FORMAT)
2760c30907bSSatish Balay   _set_output_format(_TWO_DIGIT_EXPONENT);
2770c30907bSSatish Balay #endif
2780c30907bSSatish Balay 
2794416b707SBarry Smith   *ierr = PetscOptionsCreateDefault();
280ba9a049bSBarry Smith   if (*ierr) return;
281ba9a049bSBarry Smith   i = 0;
282541b5888SSatish Balay #if defined (PETSC_HAVE_FORTRAN_GET_COMMAND_ARGUMENT) /* same as 'else' case */
2834b60c348SBarry Smith   getarg_(&i,name,sizeof(name));
284541b5888SSatish Balay #elif defined (PETSC_HAVE_PXFGETARG_NEW)
285ba9a049bSBarry Smith   { int ilen,sierr;
286ba9a049bSBarry Smith     getarg_(&i,name,&ilen,&sierr,256);
287a297a907SKarl Rupp     if (sierr) PetscStrncpy(name,"Unknown Name",256);
288a297a907SKarl Rupp     else name[ilen] = 0;
289ba9a049bSBarry Smith   }
290ba9a049bSBarry Smith #elif defined(PETSC_USE_NARGS)
291ba9a049bSBarry Smith   GETARG(&i,name,256,&flg);
292ba9a049bSBarry Smith #else
293ba9a049bSBarry Smith   getarg_(&i,name,256);
2944b60c348SBarry Smith #endif
295ba9a049bSBarry Smith   /* Eliminate spaces at the end of the string */
2969350f85dSSatish Balay   for (j=sizeof(name)-2; j>=0; j--) {
297ba9a049bSBarry Smith     if (name[j] != ' ') {
298ba9a049bSBarry Smith       name[j+1] = 0;
299ba9a049bSBarry Smith       break;
300ba9a049bSBarry Smith     }
301ba9a049bSBarry Smith   }
302a297a907SKarl Rupp   if (j<0) PetscStrncpy(name,"Unknown Name",256);
303ba9a049bSBarry Smith   *ierr = PetscSetProgramName(name);
304ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Calling PetscSetProgramName()\n");return;}
305ba9a049bSBarry Smith 
306ba9a049bSBarry Smith   /* check if PETSC_COMM_WORLD is initialized by the user in fortran */
307ba9a049bSBarry Smith   petscgetcommoncomm_(&f_petsc_comm_world);
308ba9a049bSBarry Smith   MPI_Initialized(&flag);
309ba9a049bSBarry Smith   if (!flag) {
310ba9a049bSBarry Smith     PetscMPIInt mierr;
311ba9a049bSBarry Smith 
312ba9a049bSBarry Smith     if (f_petsc_comm_world) {(*PetscErrorPrintf)("You cannot set PETSC_COMM_WORLD if you have not initialized MPI first\n");return;}
313ba9a049bSBarry Smith     mpi_init_(&mierr);
314ba9a049bSBarry Smith     if (mierr) {
315ba9a049bSBarry Smith       *ierr = mierr;
316ba9a049bSBarry Smith       (*PetscErrorPrintf)("PetscInitialize: Calling Fortran MPI_Init()\n");
317ba9a049bSBarry Smith       return;
318ba9a049bSBarry Smith     }
319ba9a049bSBarry Smith     PetscBeganMPI = PETSC_TRUE;
320ba9a049bSBarry Smith   }
321a297a907SKarl Rupp   if (f_petsc_comm_world) PETSC_COMM_WORLD = MPI_Comm_f2c(*(MPI_Fint*)&f_petsc_comm_world); /* User called MPI_INITIALIZE() and changed PETSC_COMM_WORLD */
322a297a907SKarl Rupp   else PETSC_COMM_WORLD = MPI_COMM_WORLD;
323ba9a049bSBarry Smith   PetscInitializeCalled = PETSC_TRUE;
324ba9a049bSBarry Smith 
3255ad9ad5bSBarry Smith   *ierr = PetscSpinlockCreate(&PetscViewerASCIISpinLockOpen);
3265ad9ad5bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Creating global spin lock\n");return;}
3275ad9ad5bSBarry Smith   *ierr = PetscSpinlockCreate(&PetscViewerASCIISpinLockStdout);
3285ad9ad5bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Creating global spin lock\n");return;}
3295ad9ad5bSBarry Smith   *ierr = PetscSpinlockCreate(&PetscViewerASCIISpinLockStderr);
330ef19f930SBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Creating global spin lock\n");return;}
331ef19f930SBarry Smith   *ierr = PetscSpinlockCreate(&PetscCommSpinLock);
332ef19f930SBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Creating global spin lock\n");return;}
333ef19f930SBarry Smith 
334ba9a049bSBarry Smith   *ierr = PetscErrorPrintfInitialize();
335ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Calling PetscErrorPrintfInitialize()\n");return;}
336ba9a049bSBarry Smith   *ierr = MPI_Comm_rank(MPI_COMM_WORLD,&PetscGlobalRank);
337ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Setting PetscGlobalRank\n");return;}
338ba9a049bSBarry Smith   *ierr = MPI_Comm_size(MPI_COMM_WORLD,&PetscGlobalSize);
339ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Setting PetscGlobalSize\n");return;}
3408ad47952SJed Brown 
3418ad47952SJed Brown   MPIU_BOOL = MPI_INT;
3428ad47952SJed Brown   MPIU_ENUM = MPI_INT;
3438ad47952SJed Brown 
344e383bbd0SJed Brown #if defined(PETSC_HAVE_COMPLEX)
345ba9a049bSBarry Smith   /*
346ba9a049bSBarry Smith      Initialized the global variable; this is because with
347ba9a049bSBarry Smith      shared libraries the constructors for global variables
348ba9a049bSBarry Smith      are not called; at least on IRIX.
349ba9a049bSBarry Smith   */
350ba9a049bSBarry Smith   {
351252ecd31SSatish Balay #if defined(PETSC_CLANGUAGE_CXX) && !defined(PETSC_USE_REAL___FLOAT128)
352e383bbd0SJed Brown     PetscComplex ic(0.0,1.0);
353ba9a049bSBarry Smith     PETSC_i = ic;
354ba9a049bSBarry Smith #else
355e383bbd0SJed Brown     PETSC_i = _Complex_I;
356ba9a049bSBarry Smith #endif
357ba9a049bSBarry Smith   }
358ba9a049bSBarry Smith 
359ba9a049bSBarry Smith #if !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX)
360e383bbd0SJed Brown   *ierr = MPI_Type_contiguous(2,MPI_DOUBLE,&MPIU_C_DOUBLE_COMPLEX);
361ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
362ba9a049bSBarry Smith   *ierr = MPI_Type_commit(&MPIU_C_DOUBLE_COMPLEX);
363ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
364ba9a049bSBarry Smith   *ierr = MPI_Type_contiguous(2,MPI_FLOAT,&MPIU_C_COMPLEX);
365ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
366ba9a049bSBarry Smith   *ierr = MPI_Type_commit(&MPIU_C_COMPLEX);
367ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
368ba9a049bSBarry Smith   *ierr = MPI_Op_create(PetscSum_Local,1,&MPIU_SUM);
369ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;}
370ba9a049bSBarry Smith #endif
371ba9a049bSBarry Smith 
372ba9a049bSBarry Smith #endif
373ba9a049bSBarry Smith 
374ba9a049bSBarry Smith #if defined(PETSC_USE_REAL___FLOAT128)
375ba9a049bSBarry Smith   *ierr = MPI_Type_contiguous(2,MPI_DOUBLE,&MPIU___FLOAT128);
376ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
377ba9a049bSBarry Smith   *ierr = MPI_Type_commit(&MPIU___FLOAT128);
378ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
379e383bbd0SJed Brown #if defined(PETSC_HAVE_COMPLEX)
380e383bbd0SJed Brown   *ierr = MPI_Type_contiguous(4,MPI_DOUBLE,&MPIU___COMPLEX128);
381ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
382ba9a049bSBarry Smith   *ierr = MPI_Type_commit(&MPIU___COMPLEX128);
383ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
384ba9a049bSBarry Smith #endif
385ba9a049bSBarry Smith   *ierr = MPI_Op_create(PetscSum_Local,1,&MPIU_SUM);
386ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;}
387ba9a049bSBarry Smith   *ierr = MPI_Op_create(PetscMax_Local,1,&MPIU_MAX);
388ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;}
389ba9a049bSBarry Smith   *ierr = MPI_Op_create(PetscMin_Local,1,&MPIU_MIN);
390ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;}
391570b7f6dSBarry Smith #elif defined(PETSC_USE_REAL___FP16)
392570b7f6dSBarry Smith   *ierr = MPI_Type_contiguous(2,MPI_CHAR,&MPIU___FP16);
393570b7f6dSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
394570b7f6dSBarry Smith   *ierr = MPI_Type_commit(&MPIU___FP16);
395570b7f6dSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
396570b7f6dSBarry Smith   *ierr = MPI_Op_create(PetscSum_Local,1,&MPIU_SUM);
397570b7f6dSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;}
398570b7f6dSBarry Smith   *ierr = MPI_Op_create(PetscMax_Local,1,&MPIU_MAX);
399570b7f6dSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;}
400570b7f6dSBarry Smith   *ierr = MPI_Op_create(PetscMin_Local,1,&MPIU_MIN);
401570b7f6dSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;}
402570b7f6dSBarry Smith #endif
403ba9a049bSBarry Smith 
404ba9a049bSBarry Smith   /*
405ba9a049bSBarry Smith        Create the PETSc MPI reduction operator that sums of the first
406ba9a049bSBarry Smith      half of the entries and maxes the second half.
407ba9a049bSBarry Smith   */
408367daffbSBarry Smith   *ierr = MPI_Op_create(MPIU_MaxSum_Local,1,&MPIU_MAXSUM_OP);
409ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;}
410ba9a049bSBarry Smith 
411ba9a049bSBarry Smith   *ierr = MPI_Type_contiguous(2,MPIU_SCALAR,&MPIU_2SCALAR);
412ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
413ba9a049bSBarry Smith   *ierr = MPI_Type_commit(&MPIU_2SCALAR);
414ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
41544041f26SJed Brown #if defined(PETSC_USE_64BIT_INDICES) || !defined(MPI_2INT)
416ba9a049bSBarry Smith   *ierr = MPI_Type_contiguous(2,MPIU_INT,&MPIU_2INT);
417ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
418ba9a049bSBarry Smith   *ierr = MPI_Type_commit(&MPIU_2INT);
419ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
42044041f26SJed Brown #endif
42112801b39SBarry Smith   *ierr = MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN,Petsc_DelCounter,&Petsc_Counter_keyval,(void*)0);
422ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI keyvals\n");return;}
42312801b39SBarry Smith   *ierr = MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN,Petsc_DelComm_Outer,&Petsc_InnerComm_keyval,(void*)0);
424ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI keyvals\n");return;}
42512801b39SBarry Smith   *ierr = MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN,Petsc_DelComm_Inner,&Petsc_OuterComm_keyval,(void*)0);
426ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI keyvals\n");return;}
42712801b39SBarry Smith   *ierr = MPI_Comm_create_keyval(MPI_COMM_NULL_COPY_FN,Petsc_DelShared,&Petsc_Shared_keyval,(void*)0);
4287f20dbc5SBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI keyvals\n");return;}
429ba9a049bSBarry Smith 
430ba9a049bSBarry Smith   /*
431ba9a049bSBarry Smith      PetscInitializeFortran() is called twice. Here it initializes
432ba9a049bSBarry Smith      PETSC_NULL_CHARACTER_Fortran. Below it initializes the PETSC_VIEWERs.
433ba9a049bSBarry Smith      The PETSC_VIEWERs have not been created yet, so they must be initialized
434ba9a049bSBarry Smith      below.
435ba9a049bSBarry Smith   */
436ba9a049bSBarry Smith   PetscInitializeFortran();
437fb2dfec1SJacht Volker   if(readarguments == PETSC_TRUE) {
438ba9a049bSBarry Smith     PETScParseFortranArgs_Private(&PetscGlobalArgc,&PetscGlobalArgs);
439ba9a049bSBarry Smith     FIXCHAR(filename,len,t1);
440c5929fdfSBarry Smith     *ierr = PetscOptionsInsert(NULL,&PetscGlobalArgc,&PetscGlobalArgs,t1);
441ba9a049bSBarry Smith     FREECHAR(filename,t1);
442ba9a049bSBarry Smith     if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating options database\n");return;}
443fb2dfec1SJacht Volker   }
444ba9a049bSBarry Smith   *ierr = PetscOptionsCheckInitial_Private();
445ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Checking initial options\n");return;}
446703f3eceSBarry Smith   /* call a second time to check options database */
447703f3eceSBarry Smith   *ierr = PetscErrorPrintfInitialize();
448703f3eceSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Calling PetscErrorPrintfInitialize()\n");return;}
44911525c0dSBarry Smith   *ierr = PetscCitationsInitialize();
45011525c0dSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:PetscCitationsInitialize()\n");return;}
45111525c0dSBarry Smith #if defined(PETSC_HAVE_SAWS)
45211525c0dSBarry Smith   *ierr = PetscInitializeSAWs(NULL);
45311525c0dSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Initializing SAWs\n");return;}
45411525c0dSBarry Smith #endif
455ba9a049bSBarry Smith #if defined(PETSC_USE_LOG)
456896238b9SBarry Smith   *ierr = PetscLogInitialize();
457ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: intializing logging\n");return;}
458ba9a049bSBarry Smith #endif
459ba9a049bSBarry Smith   *ierr = PetscInitialize_DynamicLibraries();
460ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Initializing dynamic libraries\n");return;}
461ba9a049bSBarry Smith 
462ba9a049bSBarry Smith   *ierr = PetscInitializeFortran();
463ba9a049bSBarry Smith   if (*ierr) { (*PetscErrorPrintf)("PetscInitialize:Setting up common block\n");return;}
464ba9a049bSBarry Smith 
465ba9a049bSBarry Smith   *ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);
466ba9a049bSBarry Smith   if (*ierr) { (*PetscErrorPrintf)("PetscInitialize:Getting MPI_Comm_size()\n");return;}
467ba9a049bSBarry Smith   *ierr = PetscInfo1(0,"(Fortran):PETSc successfully started: procs %d\n",size);
468ba9a049bSBarry Smith   if (*ierr) { (*PetscErrorPrintf)("PetscInitialize:Calling PetscInfo()\n");return;}
469ba9a049bSBarry Smith   *ierr = PetscGetHostName(hostname,64);
470ba9a049bSBarry Smith   if (*ierr) { (*PetscErrorPrintf)("PetscInitialize:Getting hostname\n");return;}
471ba9a049bSBarry Smith   *ierr = PetscInfo1(0,"Running on machine: %s\n",hostname);
472ba9a049bSBarry Smith   if (*ierr) { (*PetscErrorPrintf)("PetscInitialize:Calling PetscInfo()\n");return;}
473ba9a049bSBarry Smith   *ierr = PetscOptionsCheckInitial_Components();
474ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Checking initial options\n");return;}
475ba9a049bSBarry Smith 
476ef19f930SBarry Smith #if defined(PETSC_USE_DEBUG) && !defined(PETSC_HAVE_THREADSAFETY)
4779248b815SShri Abhyankar   *ierr = PetscStackCreate();
4783f209d92SBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:PetscStackCreate()\n");return;}
4799248b815SShri Abhyankar #endif
4809248b815SShri Abhyankar 
481b2bbaf76SBarry Smith #if defined(PETSC_SERIALIZE_FUNCTIONS)
482b2bbaf76SBarry Smith   *ierr = PetscFPTCreate(10000);
483b2bbaf76SBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:PetscFPTCreate()\n");return;}
484b2bbaf76SBarry Smith #endif
485ba9a049bSBarry Smith }
486ba9a049bSBarry Smith 
487390e1bf2SBarry Smith PETSC_EXTERN void PETSC_STDCALL petscinitialize_(char* filename PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
488fb2dfec1SJacht Volker {
489fb2dfec1SJacht Volker   petscinitialize_internal(filename, len, PETSC_TRUE, ierr);
490fb2dfec1SJacht Volker }
491fb2dfec1SJacht Volker 
492fb2dfec1SJacht Volker PETSC_EXTERN void PETSC_STDCALL petscinitializenoarguments_(PetscErrorCode *ierr)
493fb2dfec1SJacht Volker {
494fb2dfec1SJacht Volker   petscinitialize_internal(NULL, (PetscInt) 0, PETSC_FALSE, ierr);
495fb2dfec1SJacht Volker }
496fb2dfec1SJacht Volker 
497fb2dfec1SJacht Volker 
4988cc058d9SJed Brown PETSC_EXTERN void PETSC_STDCALL petscfinalize_(PetscErrorCode *ierr)
499ba9a049bSBarry Smith {
500ba9a049bSBarry Smith #if defined(PETSC_HAVE_SUNMATHPRO)
501ba9a049bSBarry Smith   extern void standard_arithmetic();
502ba9a049bSBarry Smith   standard_arithmetic();
503ba9a049bSBarry Smith #endif
504ba9a049bSBarry Smith   /* was malloced with PetscMallocAlign() so free the same way */
505efca3c55SSatish Balay   *ierr = PetscFreeAlign(PetscGlobalArgs,0,0,0);if (*ierr) {(*PetscErrorPrintf)("PetscFinalize:Freeing args\n");return;}
506ba9a049bSBarry Smith 
507ba9a049bSBarry Smith   *ierr = PetscFinalize();
508ba9a049bSBarry Smith }
509ba9a049bSBarry Smith 
510a45aced0SAlex Fikl PETSC_EXTERN void PETSC_STDCALL petscend_(PetscErrorCode *ierr)
511ba9a049bSBarry Smith {
512ba9a049bSBarry Smith #if defined(PETSC_HAVE_SUNMATHPRO)
513ba9a049bSBarry Smith   extern void standard_arithmetic();
514ba9a049bSBarry Smith   standard_arithmetic();
515ba9a049bSBarry Smith #endif
516ba9a049bSBarry Smith 
517ba9a049bSBarry Smith   *ierr = PetscEnd();
518ba9a049bSBarry Smith }
519ba9a049bSBarry Smith 
520