xref: /petsc/src/sys/objects/ftn-custom/zstart.c (revision a30ec4eab21047868b4ea34d315622f953eb6ffa)
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 
1676c028afSSatish Balay #if defined(PETSC_HAVE_CUDA)
1782f73ecaSAlejandro Lamas Daviña #include <cublas_v2.h>
18d730656cSKarl Rupp 
19d730656cSKarl Rupp extern cublasHandle_t cublasv2handle;
20ba9a049bSBarry Smith #endif
21ba9a049bSBarry Smith 
22519f805aSKarl Rupp #if defined(PETSC_HAVE_FORTRAN_CAPS)
23ba9a049bSBarry Smith #define petscinitialize_              PETSCINITIALIZE
24fb2dfec1SJacht Volker #define petscinitializenoarguments_   PETSCINITIALIZENOARGUMENTS
25ba9a049bSBarry Smith #define petscfinalize_                PETSCFINALIZE
26ba9a049bSBarry Smith #define petscend_                     PETSCEND
27ba9a049bSBarry Smith #define iargc_                        IARGC
28ba9a049bSBarry Smith #define getarg_                       GETARG
29ba9a049bSBarry Smith #define mpi_init_                     MPI_INIT
30ba9a049bSBarry Smith #define petscgetcommoncomm_           PETSCGETCOMMONCOMM
31541b5888SSatish Balay #define petsccommandargumentcount_    PETSCCOMMANDARGUMENTCOUNT
32541b5888SSatish Balay #define petscgetcommandargument_      PETSCGETCOMMANDARGUMENT
33ba9a049bSBarry Smith #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
34ba9a049bSBarry Smith #define petscinitialize_              petscinitialize
351bdb895aSBarry Smith #define petscinitializenoarguments_   petscinitializenoarguments
36ba9a049bSBarry Smith #define petscfinalize_                petscfinalize
37ba9a049bSBarry Smith #define petscend_                     petscend
38ba9a049bSBarry Smith #define mpi_init_                     mpi_init
39ba9a049bSBarry Smith #define iargc_                        iargc
40ba9a049bSBarry Smith #define getarg_                       getarg
41ba9a049bSBarry Smith #define petscgetcommoncomm_           petscgetcommoncomm
42541b5888SSatish Balay #define petsccommandargumentcount_    petsccommandargumentcount
43541b5888SSatish Balay #define petscgetcommandargument_      petscgetcommandargument
44ba9a049bSBarry Smith #endif
45ba9a049bSBarry Smith 
46ba9a049bSBarry Smith #if defined(PETSC_HAVE_NAGF90)
47ba9a049bSBarry Smith #undef iargc_
48ba9a049bSBarry Smith #undef getarg_
49ba9a049bSBarry Smith #define iargc_  f90_unix_MP_iargc
50ba9a049bSBarry Smith #define getarg_ f90_unix_MP_getarg
51ba9a049bSBarry Smith #endif
52ba9a049bSBarry Smith #if defined(PETSC_USE_NARGS) /* Digital Fortran */
53ba9a049bSBarry Smith #undef iargc_
54ba9a049bSBarry Smith #undef getarg_
55ba9a049bSBarry Smith #define iargc_  NARGS
56ba9a049bSBarry Smith #define getarg_ GETARG
57ba9a049bSBarry Smith #elif defined(PETSC_HAVE_PXFGETARG_NEW)  /* cray x1 */
58ba9a049bSBarry Smith #undef iargc_
59ba9a049bSBarry Smith #undef getarg_
60ba9a049bSBarry Smith #define iargc_  ipxfargc_
61ba9a049bSBarry Smith #define getarg_ pxfgetarg_
62ba9a049bSBarry Smith #endif
63ba9a049bSBarry Smith #if defined(PETSC_HAVE_FORTRAN_IARGC_UNDERSCORE) /* HPUX + no underscore */
64ba9a049bSBarry Smith #undef iargc_
65ba9a049bSBarry Smith #undef getarg_
66ba9a049bSBarry Smith #define iargc_   iargc_
67ba9a049bSBarry Smith #define getarg_  getarg_
68ba9a049bSBarry Smith #endif
69541b5888SSatish Balay 
70541b5888SSatish Balay #if defined(PETSC_HAVE_FORTRAN_GET_COMMAND_ARGUMENT) /* Fortran 2003 */
71541b5888SSatish Balay #undef iargc_
72541b5888SSatish Balay #undef getarg_
73541b5888SSatish Balay #define iargc_ petsccommandargumentcount_
74541b5888SSatish Balay #define getarg_ petscgetcommandargument_
75541b5888SSatish Balay #elif defined(PETSC_HAVE_GFORTRAN_IARGC) /* gfortran from gcc4 */
76ba9a049bSBarry Smith #undef iargc_
77ba9a049bSBarry Smith #undef getarg_
78ba9a049bSBarry Smith #define iargc_  _gfortran_iargc
79ba9a049bSBarry Smith #define getarg_ _gfortran_getarg_i4
80ba9a049bSBarry Smith #elif defined(PETSC_HAVE_BGL_IARGC) /* bgl g77 has different external & internal name mangling */
81ba9a049bSBarry Smith #undef iargc_
82ba9a049bSBarry Smith #undef getarg_
83ba9a049bSBarry Smith #define iargc  iargc_
84ba9a049bSBarry Smith #define getarg getarg_
85ba9a049bSBarry Smith #endif
86ba9a049bSBarry Smith 
87ba9a049bSBarry Smith /*
88ba9a049bSBarry Smith     The extra _ is because the f2c compiler puts an
89ba9a049bSBarry Smith   extra _ at the end if the original routine name
90ba9a049bSBarry Smith   contained any _.
91ba9a049bSBarry Smith */
92ba9a049bSBarry Smith #if defined(PETSC_HAVE_FORTRAN_UNDERSCORE_UNDERSCORE)
93ba9a049bSBarry Smith #define mpi_init_             mpi_init__
94ba9a049bSBarry Smith #endif
95ba9a049bSBarry Smith 
96a7b85bbcSSatish Balay #if defined(PETSC_HAVE_MPIUNI)
97a7b85bbcSSatish Balay #if defined(mpi_init_)
98a7b85bbcSSatish Balay #undef mpi_init_
99a7b85bbcSSatish Balay #if defined(PETSC_HAVE_FORTRAN_CAPS)
100a7b85bbcSSatish Balay #define mpi_init_             PETSC_MPI_INIT
101a7b85bbcSSatish Balay #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
102a7b85bbcSSatish Balay #define mpi_init_             petsc_mpi_init
103a7b85bbcSSatish Balay #elif defined(PETSC_HAVE_FORTRAN_UNDERSCORE_UNDERSCORE)
104a7b85bbcSSatish Balay #define mpi_init_             petsc_mpi_init__
105a7b85bbcSSatish Balay #endif
106a7b85bbcSSatish Balay #else    /* mpi_init_ */
107a7b85bbcSSatish Balay #define mpi_init_             petsc_mpi_init_
108a7b85bbcSSatish Balay #endif   /* mpi_init_ */
109a7b85bbcSSatish Balay #endif   /* PETSC_HAVE_MPIUNI */
110a7b85bbcSSatish Balay 
1118cc058d9SJed Brown PETSC_EXTERN void PETSC_STDCALL mpi_init_(int*);
1128cc058d9SJed Brown PETSC_EXTERN void PETSC_STDCALL petscgetcommoncomm_(PetscMPIInt*);
113ba9a049bSBarry Smith 
114ba9a049bSBarry Smith /*
115ba9a049bSBarry Smith      Different Fortran compilers handle command lines in different ways
116ba9a049bSBarry Smith */
117541b5888SSatish Balay #if defined(PETSC_HAVE_FORTRAN_GET_COMMAND_ARGUMENT) /* Fortran 2003  - same as 'else' case */
118*a30ec4eaSSatish Balay PETSC_EXTERN int iargc_(void);
119541b5888SSatish Balay PETSC_EXTERN void getarg_(int*,char*,int);
120541b5888SSatish Balay #elif defined(PETSC_USE_NARGS)
1218cc058d9SJed Brown PETSC_EXTERN short __stdcall NARGS();
1228cc058d9SJed Brown PETSC_EXTERN void __stdcall GETARG(short*,char*,int,short *);
123ba9a049bSBarry Smith 
124ba9a049bSBarry Smith #elif defined(PETSC_HAVE_FORTRAN_STDCALL)
1258cc058d9SJed Brown PETSC_EXTERN int PETSC_STDCALL IARGC();
1268cc058d9SJed Brown PETSC_EXTERN void PETSC_STDCALL GETARG(int *,char *,int);
127ba9a049bSBarry Smith 
128ba9a049bSBarry Smith #elif defined(PETSC_HAVE_PXFGETARG_NEW)
1298cc058d9SJed Brown PETSC_EXTERN int iargc_();
1308cc058d9SJed Brown PETSC_EXTERN void getarg_(int*,char*,int*,int*,int);
131ba9a049bSBarry Smith 
132ba9a049bSBarry Smith #else
1338cc058d9SJed Brown PETSC_EXTERN int iargc_();
1348cc058d9SJed Brown PETSC_EXTERN void getarg_(int*,char*,int);
135ba9a049bSBarry Smith /*
136ba9a049bSBarry Smith       The Cray T3D/T3E use the PXFGETARG() function
137ba9a049bSBarry Smith */
138ba9a049bSBarry Smith #if defined(PETSC_HAVE_PXFGETARG)
1398cc058d9SJed Brown PETSC_EXTERN void PXFGETARG(int*,_fcd,int*,int*);
140ba9a049bSBarry Smith #endif
141ba9a049bSBarry Smith #endif
142ba9a049bSBarry Smith 
143570b7f6dSBarry Smith #if (defined(PETSC_HAVE_COMPLEX) && !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX)) || defined(PETSC_USE_REAL___FLOAT128) || defined(PETSC_USE_REAL___FP16)
144ba9a049bSBarry Smith extern MPI_Op MPIU_SUM;
14599e0435eSBarry Smith 
1468cc058d9SJed Brown PETSC_EXTERN void MPIAPI PetscSum_Local(void*,void*,PetscMPIInt*,MPI_Datatype*);
14799e0435eSBarry Smith 
148ba9a049bSBarry Smith #endif
149570b7f6dSBarry Smith #if defined(PETSC_USE_REAL___FLOAT128) || defined(PETSC_USE_REAL___FP16)
15099e0435eSBarry Smith 
1518cc058d9SJed Brown PETSC_EXTERN void MPIAPI PetscSum_Local(void*,void*,PetscMPIInt*,MPI_Datatype*);
1528cc058d9SJed Brown PETSC_EXTERN void MPIAPI PetscMax_Local(void*,void*,PetscMPIInt*,MPI_Datatype*);
1538cc058d9SJed Brown PETSC_EXTERN void MPIAPI PetscMin_Local(void*,void*,PetscMPIInt*,MPI_Datatype*);
154ba9a049bSBarry Smith #endif
155ba9a049bSBarry Smith 
156367daffbSBarry Smith PETSC_INTERN void MPIAPI MPIU_MaxSum_Local(void*,void*,PetscMPIInt*,MPI_Datatype*);
1578cc058d9SJed Brown PETSC_EXTERN PetscMPIInt MPIAPI Petsc_DelCounter(MPI_Comm,PetscMPIInt,void*,void*);
158da3039f7SJed Brown PETSC_EXTERN PetscMPIInt MPIAPI Petsc_DelComm_Inner(MPI_Comm,PetscMPIInt,void*,void*);
159da3039f7SJed Brown PETSC_EXTERN PetscMPIInt MPIAPI Petsc_DelComm_Outer(MPI_Comm,PetscMPIInt,void*,void*);
160ba9a049bSBarry Smith 
161ba9a049bSBarry Smith extern PetscErrorCode  PetscOptionsCheckInitial_Private(void);
162ba9a049bSBarry Smith extern PetscErrorCode  PetscOptionsCheckInitial_Components(void);
163ba9a049bSBarry Smith extern PetscErrorCode  PetscInitialize_DynamicLibraries(void);
164ba9a049bSBarry Smith #if defined(PETSC_USE_LOG)
165896238b9SBarry Smith extern PetscErrorCode  PetscLogInitialize(void);
166ba9a049bSBarry Smith #endif
167efca3c55SSatish Balay extern PetscErrorCode  PetscMallocAlign(size_t,int,const char[],const char[],void**);
168efca3c55SSatish Balay extern PetscErrorCode  PetscFreeAlign(void*,int,const char[],const char[]);
169ba9a049bSBarry Smith extern int  PetscGlobalArgc;
170ba9a049bSBarry Smith extern char **PetscGlobalArgs;
171ba9a049bSBarry Smith 
172ba9a049bSBarry Smith /*
173ba9a049bSBarry Smith     Reads in Fortran command line argments and sends them to
174d5be86a5SBarry Smith   all processors.
175ba9a049bSBarry Smith */
176ba9a049bSBarry Smith 
177ba9a049bSBarry Smith PetscErrorCode PETScParseFortranArgs_Private(int *argc,char ***argv)
178ba9a049bSBarry Smith {
179ba9a049bSBarry Smith #if defined(PETSC_USE_NARGS)
180ba9a049bSBarry Smith   short          i,flg;
181ba9a049bSBarry Smith #else
182ba9a049bSBarry Smith   int            i;
183ba9a049bSBarry Smith #endif
184ba9a049bSBarry Smith   PetscErrorCode ierr;
185ba9a049bSBarry Smith   int            warg = 256;
186ba9a049bSBarry Smith   PetscMPIInt    rank;
187ba9a049bSBarry Smith   char           *p;
188ba9a049bSBarry Smith 
189ba9a049bSBarry Smith   ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
190ba9a049bSBarry Smith   if (!rank) {
191ba9a049bSBarry Smith #if defined(PETSC_HAVE_IARG_COUNT_PROGNAME)
192ba9a049bSBarry Smith     *argc = iargc_();
193ba9a049bSBarry Smith #else
194ba9a049bSBarry Smith     /* most compilers do not count the program name for argv[0] */
195ba9a049bSBarry Smith     *argc = 1 + iargc_();
196ba9a049bSBarry Smith #endif
197ba9a049bSBarry Smith   }
198ba9a049bSBarry Smith   ierr = MPI_Bcast(argc,1,MPI_INT,0,PETSC_COMM_WORLD);CHKERRQ(ierr);
199ba9a049bSBarry Smith 
200ba9a049bSBarry Smith   /* PetscTrMalloc() not yet set, so don't use PetscMalloc() */
201efca3c55SSatish Balay   ierr = PetscMallocAlign((*argc+1)*(warg*sizeof(char)+sizeof(char*)),0,0,0,(void**)argv);CHKERRQ(ierr);
202ba9a049bSBarry Smith   (*argv)[0] = (char*)(*argv + *argc + 1);
203ba9a049bSBarry Smith 
204ba9a049bSBarry Smith   if (!rank) {
205ba9a049bSBarry Smith     ierr = PetscMemzero((*argv)[0],(*argc)*warg*sizeof(char));CHKERRQ(ierr);
206ba9a049bSBarry Smith     for (i=0; i<*argc; i++) {
207ba9a049bSBarry Smith       (*argv)[i+1] = (*argv)[i] + warg;
208541b5888SSatish Balay #if defined (PETSC_HAVE_FORTRAN_GET_COMMAND_ARGUMENT) /* same as 'else' case */
209541b5888SSatish Balay       getarg_(&i,(*argv)[i],warg);
210541b5888SSatish Balay #elif defined(PETSC_HAVE_PXFGETARG_NEW)
211ba9a049bSBarry Smith       {char *tmp = (*argv)[i];
212ba9a049bSBarry Smith       int ilen;
213ba9a049bSBarry Smith       getarg_(&i,tmp,&ilen,&ierr,warg);CHKERRQ(ierr);
214a297a907SKarl Rupp       tmp[ilen] = 0;}
215ba9a049bSBarry Smith #elif defined(PETSC_USE_NARGS)
216ba9a049bSBarry Smith       GETARG(&i,(*argv)[i],warg,&flg);
217ba9a049bSBarry Smith #else
218ba9a049bSBarry Smith       /*
219ba9a049bSBarry Smith       Because the stupid #defines above define all kinds of things to getarg_ we cannot do this test
220ba9a049bSBarry Smith       #elif defined(PETSC_HAVE_GETARG)
221ba9a049bSBarry Smith       getarg_(&i,(*argv)[i],warg);
222ba9a049bSBarry Smith       #else
223ba9a049bSBarry Smith          SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot get Fortran command line arguments");
224ba9a049bSBarry Smith       */
225ba9a049bSBarry Smith       getarg_(&i,(*argv)[i],warg);
226ba9a049bSBarry Smith #endif
227ba9a049bSBarry Smith       /* zero out garbage at end of each argument */
228ba9a049bSBarry Smith       p = (*argv)[i] + warg-1;
229ba9a049bSBarry Smith       while (p > (*argv)[i]) {
230ba9a049bSBarry Smith         if (*p == ' ') *p = 0;
231ba9a049bSBarry Smith         p--;
232ba9a049bSBarry Smith       }
233ba9a049bSBarry Smith     }
234ba9a049bSBarry Smith   }
235ba9a049bSBarry Smith   ierr = MPI_Bcast((*argv)[0],*argc*warg,MPI_CHAR,0,PETSC_COMM_WORLD);CHKERRQ(ierr);
236ba9a049bSBarry Smith   if (rank) {
237a297a907SKarl Rupp     for (i=0; i<*argc; i++) (*argv)[i+1] = (*argv)[i] + warg;
238ba9a049bSBarry Smith   }
239ba9a049bSBarry Smith   return 0;
240ba9a049bSBarry Smith }
241ba9a049bSBarry Smith 
242b2bbaf76SBarry Smith #if defined(PETSC_SERIALIZE_FUNCTIONS)
243b2bbaf76SBarry Smith extern PetscFPT PetscFPTData;
244b2bbaf76SBarry Smith #endif
245b2bbaf76SBarry Smith 
246ef19f930SBarry Smith #if defined(PETSC_HAVE_THREADSAFETY)
247b22622e2STadeu Manoel extern PetscSpinlock PetscViewerASCIISpinLockOpen;
248b22622e2STadeu Manoel extern PetscSpinlock PetscViewerASCIISpinLockStdout;
249b22622e2STadeu Manoel extern PetscSpinlock PetscViewerASCIISpinLockStderr;
250b22622e2STadeu Manoel extern PetscSpinlock PetscCommSpinLock;
251ef19f930SBarry Smith #endif
252ef19f930SBarry Smith 
253ba9a049bSBarry Smith /* -----------------------------------------------------------------------------------------------*/
254ba9a049bSBarry Smith 
25511525c0dSBarry Smith #if defined(PETSC_HAVE_SAWS)
25611525c0dSBarry Smith #include <petscviewersaws.h>
25711525c0dSBarry Smith extern PetscErrorCode  PetscInitializeSAWs(const char[]);
25811525c0dSBarry Smith #endif
259ba9a049bSBarry Smith 
260ba9a049bSBarry Smith /*
261ba9a049bSBarry Smith     petscinitialize - Version called from Fortran.
262ba9a049bSBarry Smith 
263ba9a049bSBarry Smith     Notes:
264ba9a049bSBarry Smith       Since this is called from Fortran it does not return error codes
265ba9a049bSBarry Smith 
266ba9a049bSBarry Smith */
267390e1bf2SBarry Smith static void petscinitialize_internal(char* filename, PetscInt len, PetscBool readarguments, PetscErrorCode *ierr)
268ba9a049bSBarry Smith {
2694b60c348SBarry Smith   int            j,i;
270ba9a049bSBarry Smith #if defined (PETSC_USE_NARGS)
2714b60c348SBarry Smith   short          flg;
272ba9a049bSBarry Smith #endif
273da748e8fSMatthew G. Knepley #if defined(PETSC_HAVE_CUDA)
274da748e8fSMatthew G. Knepley   PetscBool      flg2;
27582f73ecaSAlejandro Lamas Daviña   cublasStatus_t cberr;
276da748e8fSMatthew G. Knepley #endif
277ba9a049bSBarry Smith   int            flag;
278ba9a049bSBarry Smith   PetscMPIInt    size;
279ba9a049bSBarry Smith   char           *t1,name[256],hostname[64];
280ba9a049bSBarry Smith   PetscMPIInt    f_petsc_comm_world;
281ba9a049bSBarry Smith 
2824b60c348SBarry Smith   *ierr = PetscMemzero(name,sizeof(name)); if (*ierr) return;
283ba9a049bSBarry Smith   if (PetscInitializeCalled) {*ierr = 0; return;}
284ba9a049bSBarry Smith 
285ba9a049bSBarry Smith   /* this must be initialized in a routine, not as a constant declaration*/
286ba9a049bSBarry Smith   PETSC_STDOUT = stdout;
287ba9a049bSBarry Smith   PETSC_STDERR = stderr;
288ba9a049bSBarry Smith 
2890c30907bSSatish Balay   /* on Windows - set printf to default to printing 2 digit exponents */
2900c30907bSSatish Balay #if defined(PETSC_HAVE__SET_OUTPUT_FORMAT)
2910c30907bSSatish Balay   _set_output_format(_TWO_DIGIT_EXPONENT);
2920c30907bSSatish Balay #endif
2930c30907bSSatish Balay 
2944416b707SBarry Smith   *ierr = PetscOptionsCreateDefault();
295ba9a049bSBarry Smith   if (*ierr) return;
296ba9a049bSBarry Smith   i = 0;
297541b5888SSatish Balay #if defined (PETSC_HAVE_FORTRAN_GET_COMMAND_ARGUMENT) /* same as 'else' case */
2984b60c348SBarry Smith   getarg_(&i,name,sizeof(name));
299541b5888SSatish Balay #elif defined (PETSC_HAVE_PXFGETARG_NEW)
300ba9a049bSBarry Smith   { int ilen,sierr;
301ba9a049bSBarry Smith     getarg_(&i,name,&ilen,&sierr,256);
302a297a907SKarl Rupp     if (sierr) PetscStrncpy(name,"Unknown Name",256);
303a297a907SKarl Rupp     else name[ilen] = 0;
304ba9a049bSBarry Smith   }
305ba9a049bSBarry Smith #elif defined(PETSC_USE_NARGS)
306ba9a049bSBarry Smith   GETARG(&i,name,256,&flg);
307ba9a049bSBarry Smith #else
308ba9a049bSBarry Smith   getarg_(&i,name,256);
3094b60c348SBarry Smith #endif
310ba9a049bSBarry Smith   /* Eliminate spaces at the end of the string */
3119350f85dSSatish Balay   for (j=sizeof(name)-2; j>=0; j--) {
312ba9a049bSBarry Smith     if (name[j] != ' ') {
313ba9a049bSBarry Smith       name[j+1] = 0;
314ba9a049bSBarry Smith       break;
315ba9a049bSBarry Smith     }
316ba9a049bSBarry Smith   }
317a297a907SKarl Rupp   if (j<0) PetscStrncpy(name,"Unknown Name",256);
318ba9a049bSBarry Smith   *ierr = PetscSetProgramName(name);
319ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Calling PetscSetProgramName()\n");return;}
320ba9a049bSBarry Smith 
321ba9a049bSBarry Smith   /* check if PETSC_COMM_WORLD is initialized by the user in fortran */
322ba9a049bSBarry Smith   petscgetcommoncomm_(&f_petsc_comm_world);
323ba9a049bSBarry Smith   MPI_Initialized(&flag);
324ba9a049bSBarry Smith   if (!flag) {
325ba9a049bSBarry Smith     PetscMPIInt mierr;
326ba9a049bSBarry Smith 
327ba9a049bSBarry Smith     if (f_petsc_comm_world) {(*PetscErrorPrintf)("You cannot set PETSC_COMM_WORLD if you have not initialized MPI first\n");return;}
328ba9a049bSBarry Smith     mpi_init_(&mierr);
329ba9a049bSBarry Smith     if (mierr) {
330ba9a049bSBarry Smith       *ierr = mierr;
331ba9a049bSBarry Smith       (*PetscErrorPrintf)("PetscInitialize: Calling Fortran MPI_Init()\n");
332ba9a049bSBarry Smith       return;
333ba9a049bSBarry Smith     }
334ba9a049bSBarry Smith     PetscBeganMPI = PETSC_TRUE;
335ba9a049bSBarry Smith   }
336a297a907SKarl 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 */
337a297a907SKarl Rupp   else PETSC_COMM_WORLD = MPI_COMM_WORLD;
338ba9a049bSBarry Smith   PetscInitializeCalled = PETSC_TRUE;
339ba9a049bSBarry Smith 
3405ad9ad5bSBarry Smith   *ierr = PetscSpinlockCreate(&PetscViewerASCIISpinLockOpen);
3415ad9ad5bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Creating global spin lock\n");return;}
3425ad9ad5bSBarry Smith   *ierr = PetscSpinlockCreate(&PetscViewerASCIISpinLockStdout);
3435ad9ad5bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Creating global spin lock\n");return;}
3445ad9ad5bSBarry Smith   *ierr = PetscSpinlockCreate(&PetscViewerASCIISpinLockStderr);
345ef19f930SBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Creating global spin lock\n");return;}
346ef19f930SBarry Smith   *ierr = PetscSpinlockCreate(&PetscCommSpinLock);
347ef19f930SBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Creating global spin lock\n");return;}
348ef19f930SBarry Smith 
349ba9a049bSBarry Smith   *ierr = PetscErrorPrintfInitialize();
350ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Calling PetscErrorPrintfInitialize()\n");return;}
351ba9a049bSBarry Smith   *ierr = MPI_Comm_rank(MPI_COMM_WORLD,&PetscGlobalRank);
352ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Setting PetscGlobalRank\n");return;}
353ba9a049bSBarry Smith   *ierr = MPI_Comm_size(MPI_COMM_WORLD,&PetscGlobalSize);
354ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Setting PetscGlobalSize\n");return;}
3558ad47952SJed Brown 
3568ad47952SJed Brown   MPIU_BOOL = MPI_INT;
3578ad47952SJed Brown   MPIU_ENUM = MPI_INT;
3588ad47952SJed Brown 
359e383bbd0SJed Brown #if defined(PETSC_HAVE_COMPLEX)
360ba9a049bSBarry Smith   /*
361ba9a049bSBarry Smith      Initialized the global variable; this is because with
362ba9a049bSBarry Smith      shared libraries the constructors for global variables
363ba9a049bSBarry Smith      are not called; at least on IRIX.
364ba9a049bSBarry Smith   */
365ba9a049bSBarry Smith   {
366ba9a049bSBarry Smith #if defined(PETSC_CLANGUAGE_CXX)
367e383bbd0SJed Brown     PetscComplex ic(0.0,1.0);
368ba9a049bSBarry Smith     PETSC_i = ic;
369ba9a049bSBarry Smith #else
370e383bbd0SJed Brown     PETSC_i = _Complex_I;
371ba9a049bSBarry Smith #endif
372ba9a049bSBarry Smith   }
373ba9a049bSBarry Smith 
374ba9a049bSBarry Smith #if !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX)
375e383bbd0SJed Brown   *ierr = MPI_Type_contiguous(2,MPI_DOUBLE,&MPIU_C_DOUBLE_COMPLEX);
376ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
377ba9a049bSBarry Smith   *ierr = MPI_Type_commit(&MPIU_C_DOUBLE_COMPLEX);
378ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
379ba9a049bSBarry Smith   *ierr = MPI_Type_contiguous(2,MPI_FLOAT,&MPIU_C_COMPLEX);
380ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
381ba9a049bSBarry Smith   *ierr = MPI_Type_commit(&MPIU_C_COMPLEX);
382ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
383ba9a049bSBarry Smith   *ierr = MPI_Op_create(PetscSum_Local,1,&MPIU_SUM);
384ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;}
385ba9a049bSBarry Smith #endif
386ba9a049bSBarry Smith 
387ba9a049bSBarry Smith #endif
388ba9a049bSBarry Smith 
389ba9a049bSBarry Smith #if defined(PETSC_USE_REAL___FLOAT128)
390ba9a049bSBarry Smith   *ierr = MPI_Type_contiguous(2,MPI_DOUBLE,&MPIU___FLOAT128);
391ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
392ba9a049bSBarry Smith   *ierr = MPI_Type_commit(&MPIU___FLOAT128);
393ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
394e383bbd0SJed Brown #if defined(PETSC_HAVE_COMPLEX)
395e383bbd0SJed Brown   *ierr = MPI_Type_contiguous(4,MPI_DOUBLE,&MPIU___COMPLEX128);
396ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
397ba9a049bSBarry Smith   *ierr = MPI_Type_commit(&MPIU___COMPLEX128);
398ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
399ba9a049bSBarry Smith #endif
400ba9a049bSBarry Smith   *ierr = MPI_Op_create(PetscSum_Local,1,&MPIU_SUM);
401ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;}
402ba9a049bSBarry Smith   *ierr = MPI_Op_create(PetscMax_Local,1,&MPIU_MAX);
403ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;}
404ba9a049bSBarry Smith   *ierr = MPI_Op_create(PetscMin_Local,1,&MPIU_MIN);
405ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;}
406570b7f6dSBarry Smith #elif defined(PETSC_USE_REAL___FP16)
407570b7f6dSBarry Smith   *ierr = MPI_Type_contiguous(2,MPI_CHAR,&MPIU___FP16);
408570b7f6dSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
409570b7f6dSBarry Smith   *ierr = MPI_Type_commit(&MPIU___FP16);
410570b7f6dSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
411570b7f6dSBarry Smith   *ierr = MPI_Op_create(PetscSum_Local,1,&MPIU_SUM);
412570b7f6dSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;}
413570b7f6dSBarry Smith   *ierr = MPI_Op_create(PetscMax_Local,1,&MPIU_MAX);
414570b7f6dSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;}
415570b7f6dSBarry Smith   *ierr = MPI_Op_create(PetscMin_Local,1,&MPIU_MIN);
416570b7f6dSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;}
417570b7f6dSBarry Smith #endif
418ba9a049bSBarry Smith 
419ba9a049bSBarry Smith   /*
420ba9a049bSBarry Smith        Create the PETSc MPI reduction operator that sums of the first
421ba9a049bSBarry Smith      half of the entries and maxes the second half.
422ba9a049bSBarry Smith   */
423367daffbSBarry Smith   *ierr = MPI_Op_create(MPIU_MaxSum_Local,1,&MPIU_MAXSUM_OP);
424ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;}
425ba9a049bSBarry Smith 
426ba9a049bSBarry Smith   *ierr = MPI_Type_contiguous(2,MPIU_SCALAR,&MPIU_2SCALAR);
427ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
428ba9a049bSBarry Smith   *ierr = MPI_Type_commit(&MPIU_2SCALAR);
429ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
43044041f26SJed Brown #if defined(PETSC_USE_64BIT_INDICES) || !defined(MPI_2INT)
431ba9a049bSBarry Smith   *ierr = MPI_Type_contiguous(2,MPIU_INT,&MPIU_2INT);
432ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
433ba9a049bSBarry Smith   *ierr = MPI_Type_commit(&MPIU_2INT);
434ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
43544041f26SJed Brown #endif
436ba9a049bSBarry Smith   *ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelCounter,&Petsc_Counter_keyval,(void*)0);
437ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI keyvals\n");return;}
438da3039f7SJed Brown   *ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelComm_Outer,&Petsc_InnerComm_keyval,(void*)0);
439ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI keyvals\n");return;}
440da3039f7SJed Brown   *ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelComm_Inner,&Petsc_OuterComm_keyval,(void*)0);
441ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI keyvals\n");return;}
442ba9a049bSBarry Smith 
443ba9a049bSBarry Smith   /*
444ba9a049bSBarry Smith      PetscInitializeFortran() is called twice. Here it initializes
445ba9a049bSBarry Smith      PETSC_NULL_CHARACTER_Fortran. Below it initializes the PETSC_VIEWERs.
446ba9a049bSBarry Smith      The PETSC_VIEWERs have not been created yet, so they must be initialized
447ba9a049bSBarry Smith      below.
448ba9a049bSBarry Smith   */
449ba9a049bSBarry Smith   PetscInitializeFortran();
450fb2dfec1SJacht Volker   if(readarguments == PETSC_TRUE) {
451ba9a049bSBarry Smith     PETScParseFortranArgs_Private(&PetscGlobalArgc,&PetscGlobalArgs);
452ba9a049bSBarry Smith     FIXCHAR(filename,len,t1);
453c5929fdfSBarry Smith     *ierr = PetscOptionsInsert(NULL,&PetscGlobalArgc,&PetscGlobalArgs,t1);
454ba9a049bSBarry Smith     FREECHAR(filename,t1);
455ba9a049bSBarry Smith     if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating options database\n");return;}
456fb2dfec1SJacht Volker   }
457ba9a049bSBarry Smith   *ierr = PetscOptionsCheckInitial_Private();
458ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Checking initial options\n");return;}
45911525c0dSBarry Smith   *ierr = PetscCitationsInitialize();
46011525c0dSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:PetscCitationsInitialize()\n");return;}
46111525c0dSBarry Smith #if defined(PETSC_HAVE_SAWS)
46211525c0dSBarry Smith   *ierr = PetscInitializeSAWs(NULL);
46311525c0dSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Initializing SAWs\n");return;}
46411525c0dSBarry Smith #endif
465ba9a049bSBarry Smith #if defined(PETSC_USE_LOG)
466896238b9SBarry Smith   *ierr = PetscLogInitialize();
467ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: intializing logging\n");return;}
468ba9a049bSBarry Smith #endif
469ba9a049bSBarry Smith   *ierr = PetscInitialize_DynamicLibraries();
470ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Initializing dynamic libraries\n");return;}
471ba9a049bSBarry Smith 
472ba9a049bSBarry Smith   *ierr = PetscInitializeFortran();
473ba9a049bSBarry Smith   if (*ierr) { (*PetscErrorPrintf)("PetscInitialize:Setting up common block\n");return;}
474ba9a049bSBarry Smith 
475ba9a049bSBarry Smith   *ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);
476ba9a049bSBarry Smith   if (*ierr) { (*PetscErrorPrintf)("PetscInitialize:Getting MPI_Comm_size()\n");return;}
477ba9a049bSBarry Smith   *ierr = PetscInfo1(0,"(Fortran):PETSc successfully started: procs %d\n",size);
478ba9a049bSBarry Smith   if (*ierr) { (*PetscErrorPrintf)("PetscInitialize:Calling PetscInfo()\n");return;}
479ba9a049bSBarry Smith   *ierr = PetscGetHostName(hostname,64);
480ba9a049bSBarry Smith   if (*ierr) { (*PetscErrorPrintf)("PetscInitialize:Getting hostname\n");return;}
481ba9a049bSBarry Smith   *ierr = PetscInfo1(0,"Running on machine: %s\n",hostname);
482ba9a049bSBarry Smith   if (*ierr) { (*PetscErrorPrintf)("PetscInitialize:Calling PetscInfo()\n");return;}
483ba9a049bSBarry Smith   *ierr = PetscOptionsCheckInitial_Components();
484ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Checking initial options\n");return;}
485ba9a049bSBarry Smith 
486ef19f930SBarry Smith #if defined(PETSC_USE_DEBUG) && !defined(PETSC_HAVE_THREADSAFETY)
4879248b815SShri Abhyankar   *ierr = PetscStackCreate();
4883f209d92SBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:PetscStackCreate()\n");return;}
4899248b815SShri Abhyankar #endif
4909248b815SShri Abhyankar 
491b2bbaf76SBarry Smith #if defined(PETSC_SERIALIZE_FUNCTIONS)
492b2bbaf76SBarry Smith   *ierr = PetscFPTCreate(10000);
493b2bbaf76SBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:PetscFPTCreate()\n");return;}
494b2bbaf76SBarry Smith #endif
495b2bbaf76SBarry Smith 
496ba9a049bSBarry Smith #if defined(PETSC_HAVE_CUDA)
497da748e8fSMatthew G. Knepley   flg2  = PETSC_TRUE;
498c5929fdfSBarry Smith   *ierr = PetscOptionsGetBool(NULL,NULL,"-cublas",&flg2,NULL);
49982f73ecaSAlejandro Lamas Daviña   if (flg2) {
50082f73ecaSAlejandro Lamas Daviña     cberr = cublasCreate(&cublasv2handle);
50182f73ecaSAlejandro Lamas Daviña     if (((int)cberr) != (int)CUBLAS_STATUS_SUCCESS) {(*PetscErrorPrintf)("PetscInitialize:CUBLAS error %d\n",cberr);return;}
50282f73ecaSAlejandro Lamas Daviña   }
503ba9a049bSBarry Smith #endif
504ba9a049bSBarry Smith }
505ba9a049bSBarry Smith 
506390e1bf2SBarry Smith PETSC_EXTERN void PETSC_STDCALL petscinitialize_(char* filename PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
507fb2dfec1SJacht Volker {
508fb2dfec1SJacht Volker   petscinitialize_internal(filename, len, PETSC_TRUE, ierr);
509fb2dfec1SJacht Volker }
510fb2dfec1SJacht Volker 
511fb2dfec1SJacht Volker PETSC_EXTERN void PETSC_STDCALL petscinitializenoarguments_(PetscErrorCode *ierr)
512fb2dfec1SJacht Volker {
513fb2dfec1SJacht Volker   petscinitialize_internal(NULL, (PetscInt) 0, PETSC_FALSE, ierr);
514fb2dfec1SJacht Volker }
515fb2dfec1SJacht Volker 
516fb2dfec1SJacht Volker 
5178cc058d9SJed Brown PETSC_EXTERN void PETSC_STDCALL petscfinalize_(PetscErrorCode *ierr)
518ba9a049bSBarry Smith {
519ba9a049bSBarry Smith #if defined(PETSC_HAVE_SUNMATHPRO)
520ba9a049bSBarry Smith   extern void standard_arithmetic();
521ba9a049bSBarry Smith   standard_arithmetic();
522ba9a049bSBarry Smith #endif
523ba9a049bSBarry Smith   /* was malloced with PetscMallocAlign() so free the same way */
524efca3c55SSatish Balay   *ierr = PetscFreeAlign(PetscGlobalArgs,0,0,0);if (*ierr) {(*PetscErrorPrintf)("PetscFinalize:Freeing args\n");return;}
525ba9a049bSBarry Smith 
526ba9a049bSBarry Smith   *ierr = PetscFinalize();
527ba9a049bSBarry Smith }
528ba9a049bSBarry Smith 
529a45aced0SAlex Fikl PETSC_EXTERN void PETSC_STDCALL petscend_(PetscErrorCode *ierr)
530ba9a049bSBarry Smith {
531ba9a049bSBarry Smith #if defined(PETSC_HAVE_SUNMATHPRO)
532ba9a049bSBarry Smith   extern void standard_arithmetic();
533ba9a049bSBarry Smith   standard_arithmetic();
534ba9a049bSBarry Smith #endif
535ba9a049bSBarry Smith 
536ba9a049bSBarry Smith   *ierr = PetscEnd();
537ba9a049bSBarry Smith }
538ba9a049bSBarry Smith 
539