xref: /petsc/src/sys/objects/ftn-custom/zstart.c (revision a45aced0b33403f5a0e2da5c3ab3d3ef5081aa2f)
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>
18ba9a049bSBarry Smith #endif
19ba9a049bSBarry Smith 
20519f805aSKarl Rupp #if defined(PETSC_HAVE_FORTRAN_CAPS)
21ba9a049bSBarry Smith #define petscinitialize_              PETSCINITIALIZE
22ba9a049bSBarry Smith #define petscfinalize_                PETSCFINALIZE
23ba9a049bSBarry Smith #define petscend_                     PETSCEND
24ba9a049bSBarry Smith #define iargc_                        IARGC
25ba9a049bSBarry Smith #define getarg_                       GETARG
26ba9a049bSBarry Smith #define mpi_init_                     MPI_INIT
27ba9a049bSBarry Smith #define petscgetcommoncomm_           PETSCGETCOMMONCOMM
28541b5888SSatish Balay #define petsccommandargumentcount_    PETSCCOMMANDARGUMENTCOUNT
29541b5888SSatish Balay #define petscgetcommandargument_      PETSCGETCOMMANDARGUMENT
30ba9a049bSBarry Smith #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
31ba9a049bSBarry Smith #define petscinitialize_              petscinitialize
32ba9a049bSBarry Smith #define petscfinalize_                petscfinalize
33ba9a049bSBarry Smith #define petscend_                     petscend
34ba9a049bSBarry Smith #define mpi_init_                     mpi_init
35ba9a049bSBarry Smith #define iargc_                        iargc
36ba9a049bSBarry Smith #define getarg_                       getarg
37ba9a049bSBarry Smith #define petscgetcommoncomm_           petscgetcommoncomm
38541b5888SSatish Balay #define petsccommandargumentcount_    petsccommandargumentcount
39541b5888SSatish Balay #define petscgetcommandargument_      petscgetcommandargument
40ba9a049bSBarry Smith #endif
41ba9a049bSBarry Smith 
42ba9a049bSBarry Smith #if defined(PETSC_HAVE_NAGF90)
43ba9a049bSBarry Smith #undef iargc_
44ba9a049bSBarry Smith #undef getarg_
45ba9a049bSBarry Smith #define iargc_  f90_unix_MP_iargc
46ba9a049bSBarry Smith #define getarg_ f90_unix_MP_getarg
47ba9a049bSBarry Smith #endif
48ba9a049bSBarry Smith #if defined(PETSC_USE_NARGS) /* Digital Fortran */
49ba9a049bSBarry Smith #undef iargc_
50ba9a049bSBarry Smith #undef getarg_
51ba9a049bSBarry Smith #define iargc_  NARGS
52ba9a049bSBarry Smith #define getarg_ GETARG
53ba9a049bSBarry Smith #elif defined(PETSC_HAVE_PXFGETARG_NEW)  /* cray x1 */
54ba9a049bSBarry Smith #undef iargc_
55ba9a049bSBarry Smith #undef getarg_
56ba9a049bSBarry Smith #define iargc_  ipxfargc_
57ba9a049bSBarry Smith #define getarg_ pxfgetarg_
58ba9a049bSBarry Smith #endif
59ba9a049bSBarry Smith #if defined(PETSC_HAVE_FORTRAN_IARGC_UNDERSCORE) /* HPUX + no underscore */
60ba9a049bSBarry Smith #undef iargc_
61ba9a049bSBarry Smith #undef getarg_
62ba9a049bSBarry Smith #define iargc_   iargc_
63ba9a049bSBarry Smith #define getarg_  getarg_
64ba9a049bSBarry Smith #endif
65541b5888SSatish Balay 
66541b5888SSatish Balay #if defined(PETSC_HAVE_FORTRAN_GET_COMMAND_ARGUMENT) /* Fortran 2003 */
67541b5888SSatish Balay #undef iargc_
68541b5888SSatish Balay #undef getarg_
69541b5888SSatish Balay #define iargc_ petsccommandargumentcount_
70541b5888SSatish Balay #define getarg_ petscgetcommandargument_
71541b5888SSatish Balay #elif defined(PETSC_HAVE_GFORTRAN_IARGC) /* gfortran from gcc4 */
72ba9a049bSBarry Smith #undef iargc_
73ba9a049bSBarry Smith #undef getarg_
74ba9a049bSBarry Smith #define iargc_  _gfortran_iargc
75ba9a049bSBarry Smith #define getarg_ _gfortran_getarg_i4
76ba9a049bSBarry Smith #elif defined(PETSC_HAVE_BGL_IARGC) /* bgl g77 has different external & internal name mangling */
77ba9a049bSBarry Smith #undef iargc_
78ba9a049bSBarry Smith #undef getarg_
79ba9a049bSBarry Smith #define iargc  iargc_
80ba9a049bSBarry Smith #define getarg getarg_
81ba9a049bSBarry Smith #endif
82ba9a049bSBarry Smith 
83ba9a049bSBarry Smith /*
84ba9a049bSBarry Smith     The extra _ is because the f2c compiler puts an
85ba9a049bSBarry Smith   extra _ at the end if the original routine name
86ba9a049bSBarry Smith   contained any _.
87ba9a049bSBarry Smith */
88ba9a049bSBarry Smith #if defined(PETSC_HAVE_FORTRAN_UNDERSCORE_UNDERSCORE)
89ba9a049bSBarry Smith #undef mpi_init_
90ba9a049bSBarry Smith #define mpi_init_             mpi_init__
91ba9a049bSBarry Smith #endif
92ba9a049bSBarry Smith 
938cc058d9SJed Brown PETSC_EXTERN void PETSC_STDCALL mpi_init_(int*);
948cc058d9SJed Brown PETSC_EXTERN void PETSC_STDCALL petscgetcommoncomm_(PetscMPIInt*);
95ba9a049bSBarry Smith 
96ba9a049bSBarry Smith /*
97ba9a049bSBarry Smith      Different Fortran compilers handle command lines in different ways
98ba9a049bSBarry Smith */
99541b5888SSatish Balay #if defined(PETSC_HAVE_FORTRAN_GET_COMMAND_ARGUMENT) /* Fortran 2003  - same as 'else' case */
100541b5888SSatish Balay PETSC_EXTERN int iargc_();
101541b5888SSatish Balay PETSC_EXTERN void getarg_(int*,char*,int);
102541b5888SSatish Balay #elif defined(PETSC_USE_NARGS)
1038cc058d9SJed Brown PETSC_EXTERN short __stdcall NARGS();
1048cc058d9SJed Brown PETSC_EXTERN void __stdcall GETARG(short*,char*,int,short *);
105ba9a049bSBarry Smith 
106ba9a049bSBarry Smith #elif defined(PETSC_HAVE_FORTRAN_STDCALL)
1078cc058d9SJed Brown PETSC_EXTERN int PETSC_STDCALL IARGC();
1088cc058d9SJed Brown PETSC_EXTERN void PETSC_STDCALL GETARG(int *,char *,int);
109ba9a049bSBarry Smith 
110ba9a049bSBarry Smith #elif defined(PETSC_HAVE_PXFGETARG_NEW)
1118cc058d9SJed Brown PETSC_EXTERN int iargc_();
1128cc058d9SJed Brown PETSC_EXTERN void getarg_(int*,char*,int*,int*,int);
113ba9a049bSBarry Smith 
114ba9a049bSBarry Smith #else
1158cc058d9SJed Brown PETSC_EXTERN int iargc_();
1168cc058d9SJed Brown PETSC_EXTERN void getarg_(int*,char*,int);
117ba9a049bSBarry Smith /*
118ba9a049bSBarry Smith       The Cray T3D/T3E use the PXFGETARG() function
119ba9a049bSBarry Smith */
120ba9a049bSBarry Smith #if defined(PETSC_HAVE_PXFGETARG)
1218cc058d9SJed Brown PETSC_EXTERN void PXFGETARG(int*,_fcd,int*,int*);
122ba9a049bSBarry Smith #endif
123ba9a049bSBarry Smith #endif
124ba9a049bSBarry Smith 
125e383bbd0SJed Brown #if (defined(PETSC_HAVE_COMPLEX) && !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX)) || defined(PETSC_USE_REAL___FLOAT128)
126ba9a049bSBarry Smith extern MPI_Op MPIU_SUM;
12799e0435eSBarry Smith 
1288cc058d9SJed Brown PETSC_EXTERN void MPIAPI PetscSum_Local(void*,void*,PetscMPIInt*,MPI_Datatype*);
12999e0435eSBarry Smith 
130ba9a049bSBarry Smith #endif
131ba9a049bSBarry Smith #if defined(PETSC_USE_REAL___FLOAT128)
13299e0435eSBarry Smith 
1338cc058d9SJed Brown PETSC_EXTERN void MPIAPI PetscSum_Local(void*,void*,PetscMPIInt*,MPI_Datatype*);
1348cc058d9SJed Brown PETSC_EXTERN void MPIAPI PetscMax_Local(void*,void*,PetscMPIInt*,MPI_Datatype*);
1358cc058d9SJed Brown PETSC_EXTERN void MPIAPI PetscMin_Local(void*,void*,PetscMPIInt*,MPI_Datatype*);
136ba9a049bSBarry Smith #endif
137ba9a049bSBarry Smith 
138ba9a049bSBarry Smith extern MPI_Op PetscMaxSum_Op;
139ba9a049bSBarry Smith 
1408cc058d9SJed Brown PETSC_EXTERN void MPIAPI PetscMaxSum_Local(void*,void*,PetscMPIInt*,MPI_Datatype*);
1418cc058d9SJed Brown PETSC_EXTERN PetscMPIInt MPIAPI Petsc_DelCounter(MPI_Comm,PetscMPIInt,void*,void*);
142da3039f7SJed Brown PETSC_EXTERN PetscMPIInt MPIAPI Petsc_DelComm_Inner(MPI_Comm,PetscMPIInt,void*,void*);
143da3039f7SJed Brown PETSC_EXTERN PetscMPIInt MPIAPI Petsc_DelComm_Outer(MPI_Comm,PetscMPIInt,void*,void*);
144ba9a049bSBarry Smith 
145ba9a049bSBarry Smith extern PetscErrorCode  PetscOptionsCheckInitial_Private(void);
146ba9a049bSBarry Smith extern PetscErrorCode  PetscOptionsCheckInitial_Components(void);
147ba9a049bSBarry Smith extern PetscErrorCode  PetscInitialize_DynamicLibraries(void);
148ba9a049bSBarry Smith #if defined(PETSC_USE_LOG)
149896238b9SBarry Smith extern PetscErrorCode  PetscLogInitialize(void);
150ba9a049bSBarry Smith #endif
151efca3c55SSatish Balay extern PetscErrorCode  PetscMallocAlign(size_t,int,const char[],const char[],void**);
152efca3c55SSatish Balay extern PetscErrorCode  PetscFreeAlign(void*,int,const char[],const char[]);
153ba9a049bSBarry Smith extern int  PetscGlobalArgc;
154ba9a049bSBarry Smith extern char **PetscGlobalArgs;
155ba9a049bSBarry Smith 
156ba9a049bSBarry Smith /*
157ba9a049bSBarry Smith     Reads in Fortran command line argments and sends them to
158ba9a049bSBarry Smith   all processors and adds them to Options database.
159ba9a049bSBarry Smith */
160ba9a049bSBarry Smith 
161ba9a049bSBarry Smith PetscErrorCode PETScParseFortranArgs_Private(int *argc,char ***argv)
162ba9a049bSBarry Smith {
163ba9a049bSBarry Smith #if defined(PETSC_USE_NARGS)
164ba9a049bSBarry Smith   short          i,flg;
165ba9a049bSBarry Smith #else
166ba9a049bSBarry Smith   int            i;
167ba9a049bSBarry Smith #endif
168ba9a049bSBarry Smith   PetscErrorCode ierr;
169ba9a049bSBarry Smith   int            warg = 256;
170ba9a049bSBarry Smith   PetscMPIInt    rank;
171ba9a049bSBarry Smith   char           *p;
172ba9a049bSBarry Smith 
173ba9a049bSBarry Smith   ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
174ba9a049bSBarry Smith   if (!rank) {
175ba9a049bSBarry Smith #if defined(PETSC_HAVE_IARG_COUNT_PROGNAME)
176ba9a049bSBarry Smith     *argc = iargc_();
177ba9a049bSBarry Smith #else
178ba9a049bSBarry Smith     /* most compilers do not count the program name for argv[0] */
179ba9a049bSBarry Smith     *argc = 1 + iargc_();
180ba9a049bSBarry Smith #endif
181ba9a049bSBarry Smith   }
182ba9a049bSBarry Smith   ierr = MPI_Bcast(argc,1,MPI_INT,0,PETSC_COMM_WORLD);CHKERRQ(ierr);
183ba9a049bSBarry Smith 
184ba9a049bSBarry Smith   /* PetscTrMalloc() not yet set, so don't use PetscMalloc() */
185efca3c55SSatish Balay   ierr = PetscMallocAlign((*argc+1)*(warg*sizeof(char)+sizeof(char*)),0,0,0,(void**)argv);CHKERRQ(ierr);
186ba9a049bSBarry Smith   (*argv)[0] = (char*)(*argv + *argc + 1);
187ba9a049bSBarry Smith 
188ba9a049bSBarry Smith   if (!rank) {
189ba9a049bSBarry Smith     ierr = PetscMemzero((*argv)[0],(*argc)*warg*sizeof(char));CHKERRQ(ierr);
190ba9a049bSBarry Smith     for (i=0; i<*argc; i++) {
191ba9a049bSBarry Smith       (*argv)[i+1] = (*argv)[i] + warg;
192541b5888SSatish Balay #if defined (PETSC_HAVE_FORTRAN_GET_COMMAND_ARGUMENT) /* same as 'else' case */
193541b5888SSatish Balay       getarg_(&i,(*argv)[i],warg);
194541b5888SSatish Balay #elif defined(PETSC_HAVE_PXFGETARG_NEW)
195ba9a049bSBarry Smith       {char *tmp = (*argv)[i];
196ba9a049bSBarry Smith       int ilen;
197ba9a049bSBarry Smith       getarg_(&i,tmp,&ilen,&ierr,warg);CHKERRQ(ierr);
198a297a907SKarl Rupp       tmp[ilen] = 0;}
199ba9a049bSBarry Smith #elif defined(PETSC_USE_NARGS)
200ba9a049bSBarry Smith       GETARG(&i,(*argv)[i],warg,&flg);
201ba9a049bSBarry Smith #else
202ba9a049bSBarry Smith       /*
203ba9a049bSBarry Smith       Because the stupid #defines above define all kinds of things to getarg_ we cannot do this test
204ba9a049bSBarry Smith       #elif defined(PETSC_HAVE_GETARG)
205ba9a049bSBarry Smith       getarg_(&i,(*argv)[i],warg);
206ba9a049bSBarry Smith       #else
207ba9a049bSBarry Smith          SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot get Fortran command line arguments");
208ba9a049bSBarry Smith       */
209ba9a049bSBarry Smith       getarg_(&i,(*argv)[i],warg);
210ba9a049bSBarry Smith #endif
211ba9a049bSBarry Smith       /* zero out garbage at end of each argument */
212ba9a049bSBarry Smith       p = (*argv)[i] + warg-1;
213ba9a049bSBarry Smith       while (p > (*argv)[i]) {
214ba9a049bSBarry Smith         if (*p == ' ') *p = 0;
215ba9a049bSBarry Smith         p--;
216ba9a049bSBarry Smith       }
217ba9a049bSBarry Smith     }
218ba9a049bSBarry Smith   }
219ba9a049bSBarry Smith   ierr = MPI_Bcast((*argv)[0],*argc*warg,MPI_CHAR,0,PETSC_COMM_WORLD);CHKERRQ(ierr);
220ba9a049bSBarry Smith   if (rank) {
221a297a907SKarl Rupp     for (i=0; i<*argc; i++) (*argv)[i+1] = (*argv)[i] + warg;
222ba9a049bSBarry Smith   }
223ba9a049bSBarry Smith   return 0;
224ba9a049bSBarry Smith }
225ba9a049bSBarry Smith 
226b2bbaf76SBarry Smith #if defined(PETSC_SERIALIZE_FUNCTIONS)
227b2bbaf76SBarry Smith extern PetscFPT PetscFPTData;
228b2bbaf76SBarry Smith #endif
229b2bbaf76SBarry Smith 
230ef19f930SBarry Smith #if defined(PETSC_HAVE_THREADSAFETY)
231b22622e2STadeu Manoel extern PetscSpinlock PetscViewerASCIISpinLockOpen;
232b22622e2STadeu Manoel extern PetscSpinlock PetscViewerASCIISpinLockStdout;
233b22622e2STadeu Manoel extern PetscSpinlock PetscViewerASCIISpinLockStderr;
234b22622e2STadeu Manoel extern PetscSpinlock PetscCommSpinLock;
235ef19f930SBarry Smith #endif
236ef19f930SBarry Smith 
237ba9a049bSBarry Smith /* -----------------------------------------------------------------------------------------------*/
238ba9a049bSBarry Smith 
23911525c0dSBarry Smith #if defined(PETSC_HAVE_SAWS)
24011525c0dSBarry Smith #include <petscviewersaws.h>
24111525c0dSBarry Smith extern PetscErrorCode  PetscInitializeSAWs(const char[]);
24211525c0dSBarry Smith #endif
243ba9a049bSBarry Smith 
244ba9a049bSBarry Smith /*
245ba9a049bSBarry Smith     petscinitialize - Version called from Fortran.
246ba9a049bSBarry Smith 
247ba9a049bSBarry Smith     Notes:
248ba9a049bSBarry Smith       Since this is called from Fortran it does not return error codes
249ba9a049bSBarry Smith 
250ba9a049bSBarry Smith */
2518cc058d9SJed Brown PETSC_EXTERN void PETSC_STDCALL petscinitialize_(CHAR filename PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
252ba9a049bSBarry Smith {
253ba9a049bSBarry Smith #if defined (PETSC_USE_NARGS)
254ba9a049bSBarry Smith   short          flg,i;
255ba9a049bSBarry Smith #else
256ba9a049bSBarry Smith   int            i;
257bf8bcf57SSatish Balay #if !defined(PETSC_HAVE_PXFGETARG_NEW) && !defined (PETSC_HAVE_PXFGETARG_NEW) && !defined(PETSC_HAVE_FORTRAN_GET_COMMAND_ARGUMENT)
258ba9a049bSBarry Smith   int            j;
259ba9a049bSBarry Smith #endif
260ba9a049bSBarry Smith #endif
261da748e8fSMatthew G. Knepley #if defined(PETSC_HAVE_CUDA)
262da748e8fSMatthew G. Knepley   PetscBool      flg2;
26382f73ecaSAlejandro Lamas Daviña   cublasStatus_t cberr;
264da748e8fSMatthew G. Knepley #endif
265ba9a049bSBarry Smith   int            flag;
266ba9a049bSBarry Smith   PetscMPIInt    size;
267ba9a049bSBarry Smith   char           *t1,name[256],hostname[64];
268ba9a049bSBarry Smith   PetscMPIInt    f_petsc_comm_world;
269ba9a049bSBarry Smith 
270ba9a049bSBarry Smith   *ierr = PetscMemzero(name,256); if (*ierr) return;
271ba9a049bSBarry Smith   if (PetscInitializeCalled) {*ierr = 0; return;}
272ba9a049bSBarry Smith 
273ba9a049bSBarry Smith   /* this must be initialized in a routine, not as a constant declaration*/
274ba9a049bSBarry Smith   PETSC_STDOUT = stdout;
275ba9a049bSBarry Smith   PETSC_STDERR = stderr;
276ba9a049bSBarry Smith 
2770c30907bSSatish Balay   /* on Windows - set printf to default to printing 2 digit exponents */
2780c30907bSSatish Balay #if defined(PETSC_HAVE__SET_OUTPUT_FORMAT)
2790c30907bSSatish Balay   _set_output_format(_TWO_DIGIT_EXPONENT);
2800c30907bSSatish Balay #endif
2810c30907bSSatish Balay 
2824416b707SBarry Smith   *ierr = PetscOptionsCreateDefault();
283ba9a049bSBarry Smith   if (*ierr) return;
284ba9a049bSBarry Smith   i = 0;
285541b5888SSatish Balay #if defined (PETSC_HAVE_FORTRAN_GET_COMMAND_ARGUMENT) /* same as 'else' case */
286541b5888SSatish Balay   getarg_(&i,name,256);
287541b5888SSatish Balay #elif defined (PETSC_HAVE_PXFGETARG_NEW)
288ba9a049bSBarry Smith   { int ilen,sierr;
289ba9a049bSBarry Smith     getarg_(&i,name,&ilen,&sierr,256);
290a297a907SKarl Rupp     if (sierr) PetscStrncpy(name,"Unknown Name",256);
291a297a907SKarl Rupp     else name[ilen] = 0;
292ba9a049bSBarry Smith   }
293ba9a049bSBarry Smith #elif defined(PETSC_USE_NARGS)
294ba9a049bSBarry Smith   GETARG(&i,name,256,&flg);
295ba9a049bSBarry Smith #else
296ba9a049bSBarry Smith   getarg_(&i,name,256);
297ba9a049bSBarry Smith   /* Eliminate spaces at the end of the string */
298ba9a049bSBarry Smith   for (j=254; j>=0; j--) {
299ba9a049bSBarry Smith     if (name[j] != ' ') {
300ba9a049bSBarry Smith       name[j+1] = 0;
301ba9a049bSBarry Smith       break;
302ba9a049bSBarry Smith     }
303ba9a049bSBarry Smith   }
304a297a907SKarl Rupp   if (j<0) PetscStrncpy(name,"Unknown Name",256);
305ba9a049bSBarry Smith #endif
306ba9a049bSBarry Smith   *ierr = PetscSetProgramName(name);
307ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Calling PetscSetProgramName()\n");return;}
308ba9a049bSBarry Smith 
309ba9a049bSBarry Smith   /* check if PETSC_COMM_WORLD is initialized by the user in fortran */
310ba9a049bSBarry Smith   petscgetcommoncomm_(&f_petsc_comm_world);
311ba9a049bSBarry Smith   MPI_Initialized(&flag);
312ba9a049bSBarry Smith   if (!flag) {
313ba9a049bSBarry Smith     PetscMPIInt mierr;
314ba9a049bSBarry Smith 
315ba9a049bSBarry Smith     if (f_petsc_comm_world) {(*PetscErrorPrintf)("You cannot set PETSC_COMM_WORLD if you have not initialized MPI first\n");return;}
316ba9a049bSBarry Smith     /* MPI requires calling Fortran mpi_init() if main program is Fortran */
3178dc331a1SSatish Balay #if defined(PETSC_HAVE_MPIUNI) && defined(MPIUNI_AVOID_MPI_NAMESPACE)
3188dc331a1SSatish Balay     mierr = MPI_Init((int*)0, (char***)0);
3198dc331a1SSatish Balay #else
320ba9a049bSBarry Smith     mpi_init_(&mierr);
3218dc331a1SSatish Balay #endif
322ba9a049bSBarry Smith     if (mierr) {
323ba9a049bSBarry Smith       *ierr = mierr;
324ba9a049bSBarry Smith       (*PetscErrorPrintf)("PetscInitialize: Calling Fortran MPI_Init()\n");
325ba9a049bSBarry Smith       return;
326ba9a049bSBarry Smith     }
327ba9a049bSBarry Smith     PetscBeganMPI = PETSC_TRUE;
328ba9a049bSBarry Smith   }
329a297a907SKarl 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 */
330a297a907SKarl Rupp   else PETSC_COMM_WORLD = MPI_COMM_WORLD;
331ba9a049bSBarry Smith   PetscInitializeCalled = PETSC_TRUE;
332ba9a049bSBarry Smith 
3335ad9ad5bSBarry Smith   *ierr = PetscSpinlockCreate(&PetscViewerASCIISpinLockOpen);
3345ad9ad5bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Creating global spin lock\n");return;}
3355ad9ad5bSBarry Smith   *ierr = PetscSpinlockCreate(&PetscViewerASCIISpinLockStdout);
3365ad9ad5bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Creating global spin lock\n");return;}
3375ad9ad5bSBarry Smith   *ierr = PetscSpinlockCreate(&PetscViewerASCIISpinLockStderr);
338ef19f930SBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Creating global spin lock\n");return;}
339ef19f930SBarry Smith   *ierr = PetscSpinlockCreate(&PetscCommSpinLock);
340ef19f930SBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Creating global spin lock\n");return;}
341ef19f930SBarry Smith 
342ba9a049bSBarry Smith   *ierr = PetscErrorPrintfInitialize();
343ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Calling PetscErrorPrintfInitialize()\n");return;}
344ba9a049bSBarry Smith   *ierr = MPI_Comm_rank(MPI_COMM_WORLD,&PetscGlobalRank);
345ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Setting PetscGlobalRank\n");return;}
346ba9a049bSBarry Smith   *ierr = MPI_Comm_size(MPI_COMM_WORLD,&PetscGlobalSize);
347ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Setting PetscGlobalSize\n");return;}
3488ad47952SJed Brown 
3498ad47952SJed Brown   MPIU_BOOL = MPI_INT;
3508ad47952SJed Brown   MPIU_ENUM = MPI_INT;
3518ad47952SJed Brown 
352e383bbd0SJed Brown #if defined(PETSC_HAVE_COMPLEX)
353ba9a049bSBarry Smith   /*
354ba9a049bSBarry Smith      Initialized the global variable; this is because with
355ba9a049bSBarry Smith      shared libraries the constructors for global variables
356ba9a049bSBarry Smith      are not called; at least on IRIX.
357ba9a049bSBarry Smith   */
358ba9a049bSBarry Smith   {
359ba9a049bSBarry Smith #if defined(PETSC_CLANGUAGE_CXX)
360e383bbd0SJed Brown     PetscComplex ic(0.0,1.0);
361ba9a049bSBarry Smith     PETSC_i = ic;
362ba9a049bSBarry Smith #else
363e383bbd0SJed Brown     PETSC_i = _Complex_I;
364ba9a049bSBarry Smith #endif
365ba9a049bSBarry Smith   }
366ba9a049bSBarry Smith 
367ba9a049bSBarry Smith #if !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX)
368e383bbd0SJed Brown   *ierr = MPI_Type_contiguous(2,MPI_DOUBLE,&MPIU_C_DOUBLE_COMPLEX);
369ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
370ba9a049bSBarry Smith   *ierr = MPI_Type_commit(&MPIU_C_DOUBLE_COMPLEX);
371ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
372ba9a049bSBarry Smith   *ierr = MPI_Type_contiguous(2,MPI_FLOAT,&MPIU_C_COMPLEX);
373ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
374ba9a049bSBarry Smith   *ierr = MPI_Type_commit(&MPIU_C_COMPLEX);
375ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
376ba9a049bSBarry Smith   *ierr = MPI_Op_create(PetscSum_Local,1,&MPIU_SUM);
377ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;}
378ba9a049bSBarry Smith #endif
379ba9a049bSBarry Smith 
380ba9a049bSBarry Smith #endif
381ba9a049bSBarry Smith 
382ba9a049bSBarry Smith #if defined(PETSC_USE_REAL___FLOAT128)
383ba9a049bSBarry Smith   *ierr = MPI_Type_contiguous(2,MPI_DOUBLE,&MPIU___FLOAT128);
384ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
385ba9a049bSBarry Smith   *ierr = MPI_Type_commit(&MPIU___FLOAT128);
386ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
387e383bbd0SJed Brown #if defined(PETSC_HAVE_COMPLEX)
388e383bbd0SJed Brown   *ierr = MPI_Type_contiguous(4,MPI_DOUBLE,&MPIU___COMPLEX128);
389ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
390ba9a049bSBarry Smith   *ierr = MPI_Type_commit(&MPIU___COMPLEX128);
391ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
392ba9a049bSBarry Smith #endif
393ba9a049bSBarry Smith   *ierr = MPI_Op_create(PetscSum_Local,1,&MPIU_SUM);
394ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;}
395ba9a049bSBarry Smith   *ierr = MPI_Op_create(PetscMax_Local,1,&MPIU_MAX);
396ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;}
397ba9a049bSBarry Smith   *ierr = MPI_Op_create(PetscMin_Local,1,&MPIU_MIN);
398ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;}
399ba9a049bSBarry Smith #endif
400ba9a049bSBarry Smith 
401ba9a049bSBarry Smith   /*
402ba9a049bSBarry Smith        Create the PETSc MPI reduction operator that sums of the first
403ba9a049bSBarry Smith      half of the entries and maxes the second half.
404ba9a049bSBarry Smith   */
405ba9a049bSBarry Smith   *ierr = MPI_Op_create(PetscMaxSum_Local,1,&PetscMaxSum_Op);
406ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;}
407ba9a049bSBarry Smith 
408ba9a049bSBarry Smith   *ierr = MPI_Type_contiguous(2,MPIU_SCALAR,&MPIU_2SCALAR);
409ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
410ba9a049bSBarry Smith   *ierr = MPI_Type_commit(&MPIU_2SCALAR);
411ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
41244041f26SJed Brown #if defined(PETSC_USE_64BIT_INDICES) || !defined(MPI_2INT)
413ba9a049bSBarry Smith   *ierr = MPI_Type_contiguous(2,MPIU_INT,&MPIU_2INT);
414ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
415ba9a049bSBarry Smith   *ierr = MPI_Type_commit(&MPIU_2INT);
416ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
41744041f26SJed Brown #endif
418ba9a049bSBarry Smith   *ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelCounter,&Petsc_Counter_keyval,(void*)0);
419ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI keyvals\n");return;}
420da3039f7SJed Brown   *ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelComm_Outer,&Petsc_InnerComm_keyval,(void*)0);
421ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI keyvals\n");return;}
422da3039f7SJed Brown   *ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelComm_Inner,&Petsc_OuterComm_keyval,(void*)0);
423ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI keyvals\n");return;}
424ba9a049bSBarry Smith 
425ba9a049bSBarry Smith   /*
426ba9a049bSBarry Smith      PetscInitializeFortran() is called twice. Here it initializes
427ba9a049bSBarry Smith      PETSC_NULL_CHARACTER_Fortran. Below it initializes the PETSC_VIEWERs.
428ba9a049bSBarry Smith      The PETSC_VIEWERs have not been created yet, so they must be initialized
429ba9a049bSBarry Smith      below.
430ba9a049bSBarry Smith   */
431ba9a049bSBarry Smith   PetscInitializeFortran();
432ba9a049bSBarry Smith   PETScParseFortranArgs_Private(&PetscGlobalArgc,&PetscGlobalArgs);
433ba9a049bSBarry Smith   FIXCHAR(filename,len,t1);
434c5929fdfSBarry Smith   *ierr = PetscOptionsInsert(NULL,&PetscGlobalArgc,&PetscGlobalArgs,t1);
435ba9a049bSBarry Smith   FREECHAR(filename,t1);
436ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating options database\n");return;}
437ba9a049bSBarry Smith   *ierr = PetscOptionsCheckInitial_Private();
438ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Checking initial options\n");return;}
43911525c0dSBarry Smith   *ierr = PetscCitationsInitialize();
44011525c0dSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:PetscCitationsInitialize()\n");return;}
44111525c0dSBarry Smith #if defined(PETSC_HAVE_SAWS)
44211525c0dSBarry Smith   *ierr = PetscInitializeSAWs(NULL);
44311525c0dSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Initializing SAWs\n");return;}
44411525c0dSBarry Smith #endif
445ba9a049bSBarry Smith #if defined(PETSC_USE_LOG)
446896238b9SBarry Smith   *ierr = PetscLogInitialize();
447ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: intializing logging\n");return;}
448ba9a049bSBarry Smith #endif
449ba9a049bSBarry Smith   *ierr = PetscInitialize_DynamicLibraries();
450ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Initializing dynamic libraries\n");return;}
451ba9a049bSBarry Smith 
452ba9a049bSBarry Smith   *ierr = PetscInitializeFortran();
453ba9a049bSBarry Smith   if (*ierr) { (*PetscErrorPrintf)("PetscInitialize:Setting up common block\n");return;}
454ba9a049bSBarry Smith 
455ba9a049bSBarry Smith   *ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);
456ba9a049bSBarry Smith   if (*ierr) { (*PetscErrorPrintf)("PetscInitialize:Getting MPI_Comm_size()\n");return;}
457ba9a049bSBarry Smith   *ierr = PetscInfo1(0,"(Fortran):PETSc successfully started: procs %d\n",size);
458ba9a049bSBarry Smith   if (*ierr) { (*PetscErrorPrintf)("PetscInitialize:Calling PetscInfo()\n");return;}
459ba9a049bSBarry Smith   *ierr = PetscGetHostName(hostname,64);
460ba9a049bSBarry Smith   if (*ierr) { (*PetscErrorPrintf)("PetscInitialize:Getting hostname\n");return;}
461ba9a049bSBarry Smith   *ierr = PetscInfo1(0,"Running on machine: %s\n",hostname);
462ba9a049bSBarry Smith   if (*ierr) { (*PetscErrorPrintf)("PetscInitialize:Calling PetscInfo()\n");return;}
463ba9a049bSBarry Smith   *ierr = PetscOptionsCheckInitial_Components();
464ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Checking initial options\n");return;}
465ba9a049bSBarry Smith 
466ef19f930SBarry Smith #if defined(PETSC_USE_DEBUG) && !defined(PETSC_HAVE_THREADSAFETY)
4679248b815SShri Abhyankar   *ierr = PetscStackCreate();
4683f209d92SBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:PetscStackCreate()\n");return;}
4699248b815SShri Abhyankar #endif
4709248b815SShri Abhyankar 
471b2bbaf76SBarry Smith #if defined(PETSC_SERIALIZE_FUNCTIONS)
472b2bbaf76SBarry Smith   *ierr = PetscFPTCreate(10000);
473b2bbaf76SBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:PetscFPTCreate()\n");return;}
474b2bbaf76SBarry Smith #endif
475b2bbaf76SBarry Smith 
476ba9a049bSBarry Smith #if defined(PETSC_HAVE_CUDA)
477da748e8fSMatthew G. Knepley   flg2  = PETSC_TRUE;
478c5929fdfSBarry Smith   *ierr = PetscOptionsGetBool(NULL,NULL,"-cublas",&flg2,NULL);
47982f73ecaSAlejandro Lamas Daviña   if (flg2) {
48082f73ecaSAlejandro Lamas Daviña     cberr = cublasCreate(&cublasv2handle);
48182f73ecaSAlejandro Lamas Daviña     if (((int)cberr) != (int)CUBLAS_STATUS_SUCCESS) {(*PetscErrorPrintf)("PetscInitialize:CUBLAS error %d\n",cberr);return;}
48282f73ecaSAlejandro Lamas Daviña   }
483ba9a049bSBarry Smith #endif
484ba9a049bSBarry Smith }
485ba9a049bSBarry Smith 
4868cc058d9SJed Brown PETSC_EXTERN void PETSC_STDCALL petscfinalize_(PetscErrorCode *ierr)
487ba9a049bSBarry Smith {
488ba9a049bSBarry Smith #if defined(PETSC_HAVE_SUNMATHPRO)
489ba9a049bSBarry Smith   extern void standard_arithmetic();
490ba9a049bSBarry Smith   standard_arithmetic();
491ba9a049bSBarry Smith #endif
492ba9a049bSBarry Smith   /* was malloced with PetscMallocAlign() so free the same way */
493efca3c55SSatish Balay   *ierr = PetscFreeAlign(PetscGlobalArgs,0,0,0);if (*ierr) {(*PetscErrorPrintf)("PetscFinalize:Freeing args\n");return;}
494ba9a049bSBarry Smith 
495ba9a049bSBarry Smith   *ierr = PetscFinalize();
496ba9a049bSBarry Smith }
497ba9a049bSBarry Smith 
498*a45aced0SAlex Fikl PETSC_EXTERN void PETSC_STDCALL petscend_(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 
505ba9a049bSBarry Smith   *ierr = PetscEnd();
506ba9a049bSBarry Smith }
507ba9a049bSBarry Smith 
508