xref: /petsc/src/sys/objects/ftn-custom/zstart.c (revision fb2dfec1ce55457db93eeb2a8a1569a386563980)
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
24*fb2dfec1SJacht 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
35ba9a049bSBarry Smith #define petscfinalize_                petscfinalize
36ba9a049bSBarry Smith #define petscend_                     petscend
37ba9a049bSBarry Smith #define mpi_init_                     mpi_init
38ba9a049bSBarry Smith #define iargc_                        iargc
39ba9a049bSBarry Smith #define getarg_                       getarg
40ba9a049bSBarry Smith #define petscgetcommoncomm_           petscgetcommoncomm
41541b5888SSatish Balay #define petsccommandargumentcount_    petsccommandargumentcount
42541b5888SSatish Balay #define petscgetcommandargument_      petscgetcommandargument
43ba9a049bSBarry Smith #endif
44ba9a049bSBarry Smith 
45ba9a049bSBarry Smith #if defined(PETSC_HAVE_NAGF90)
46ba9a049bSBarry Smith #undef iargc_
47ba9a049bSBarry Smith #undef getarg_
48ba9a049bSBarry Smith #define iargc_  f90_unix_MP_iargc
49ba9a049bSBarry Smith #define getarg_ f90_unix_MP_getarg
50ba9a049bSBarry Smith #endif
51ba9a049bSBarry Smith #if defined(PETSC_USE_NARGS) /* Digital Fortran */
52ba9a049bSBarry Smith #undef iargc_
53ba9a049bSBarry Smith #undef getarg_
54ba9a049bSBarry Smith #define iargc_  NARGS
55ba9a049bSBarry Smith #define getarg_ GETARG
56ba9a049bSBarry Smith #elif defined(PETSC_HAVE_PXFGETARG_NEW)  /* cray x1 */
57ba9a049bSBarry Smith #undef iargc_
58ba9a049bSBarry Smith #undef getarg_
59ba9a049bSBarry Smith #define iargc_  ipxfargc_
60ba9a049bSBarry Smith #define getarg_ pxfgetarg_
61ba9a049bSBarry Smith #endif
62ba9a049bSBarry Smith #if defined(PETSC_HAVE_FORTRAN_IARGC_UNDERSCORE) /* HPUX + no underscore */
63ba9a049bSBarry Smith #undef iargc_
64ba9a049bSBarry Smith #undef getarg_
65ba9a049bSBarry Smith #define iargc_   iargc_
66ba9a049bSBarry Smith #define getarg_  getarg_
67ba9a049bSBarry Smith #endif
68541b5888SSatish Balay 
69541b5888SSatish Balay #if defined(PETSC_HAVE_FORTRAN_GET_COMMAND_ARGUMENT) /* Fortran 2003 */
70541b5888SSatish Balay #undef iargc_
71541b5888SSatish Balay #undef getarg_
72541b5888SSatish Balay #define iargc_ petsccommandargumentcount_
73541b5888SSatish Balay #define getarg_ petscgetcommandargument_
74541b5888SSatish Balay #elif defined(PETSC_HAVE_GFORTRAN_IARGC) /* gfortran from gcc4 */
75ba9a049bSBarry Smith #undef iargc_
76ba9a049bSBarry Smith #undef getarg_
77ba9a049bSBarry Smith #define iargc_  _gfortran_iargc
78ba9a049bSBarry Smith #define getarg_ _gfortran_getarg_i4
79ba9a049bSBarry Smith #elif defined(PETSC_HAVE_BGL_IARGC) /* bgl g77 has different external & internal name mangling */
80ba9a049bSBarry Smith #undef iargc_
81ba9a049bSBarry Smith #undef getarg_
82ba9a049bSBarry Smith #define iargc  iargc_
83ba9a049bSBarry Smith #define getarg getarg_
84ba9a049bSBarry Smith #endif
85ba9a049bSBarry Smith 
86ba9a049bSBarry Smith /*
87ba9a049bSBarry Smith     The extra _ is because the f2c compiler puts an
88ba9a049bSBarry Smith   extra _ at the end if the original routine name
89ba9a049bSBarry Smith   contained any _.
90ba9a049bSBarry Smith */
91ba9a049bSBarry Smith #if defined(PETSC_HAVE_FORTRAN_UNDERSCORE_UNDERSCORE)
92ba9a049bSBarry Smith #undef mpi_init_
93ba9a049bSBarry Smith #define mpi_init_             mpi_init__
94ba9a049bSBarry Smith #endif
95ba9a049bSBarry Smith 
968cc058d9SJed Brown PETSC_EXTERN void PETSC_STDCALL mpi_init_(int*);
978cc058d9SJed Brown PETSC_EXTERN void PETSC_STDCALL petscgetcommoncomm_(PetscMPIInt*);
98ba9a049bSBarry Smith 
99ba9a049bSBarry Smith /*
100ba9a049bSBarry Smith      Different Fortran compilers handle command lines in different ways
101ba9a049bSBarry Smith */
102541b5888SSatish Balay #if defined(PETSC_HAVE_FORTRAN_GET_COMMAND_ARGUMENT) /* Fortran 2003  - same as 'else' case */
103541b5888SSatish Balay PETSC_EXTERN int iargc_();
104541b5888SSatish Balay PETSC_EXTERN void getarg_(int*,char*,int);
105541b5888SSatish Balay #elif defined(PETSC_USE_NARGS)
1068cc058d9SJed Brown PETSC_EXTERN short __stdcall NARGS();
1078cc058d9SJed Brown PETSC_EXTERN void __stdcall GETARG(short*,char*,int,short *);
108ba9a049bSBarry Smith 
109ba9a049bSBarry Smith #elif defined(PETSC_HAVE_FORTRAN_STDCALL)
1108cc058d9SJed Brown PETSC_EXTERN int PETSC_STDCALL IARGC();
1118cc058d9SJed Brown PETSC_EXTERN void PETSC_STDCALL GETARG(int *,char *,int);
112ba9a049bSBarry Smith 
113ba9a049bSBarry Smith #elif defined(PETSC_HAVE_PXFGETARG_NEW)
1148cc058d9SJed Brown PETSC_EXTERN int iargc_();
1158cc058d9SJed Brown PETSC_EXTERN void getarg_(int*,char*,int*,int*,int);
116ba9a049bSBarry Smith 
117ba9a049bSBarry Smith #else
1188cc058d9SJed Brown PETSC_EXTERN int iargc_();
1198cc058d9SJed Brown PETSC_EXTERN void getarg_(int*,char*,int);
120ba9a049bSBarry Smith /*
121ba9a049bSBarry Smith       The Cray T3D/T3E use the PXFGETARG() function
122ba9a049bSBarry Smith */
123ba9a049bSBarry Smith #if defined(PETSC_HAVE_PXFGETARG)
1248cc058d9SJed Brown PETSC_EXTERN void PXFGETARG(int*,_fcd,int*,int*);
125ba9a049bSBarry Smith #endif
126ba9a049bSBarry Smith #endif
127ba9a049bSBarry Smith 
128e383bbd0SJed Brown #if (defined(PETSC_HAVE_COMPLEX) && !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX)) || defined(PETSC_USE_REAL___FLOAT128)
129ba9a049bSBarry Smith extern MPI_Op MPIU_SUM;
13099e0435eSBarry Smith 
1318cc058d9SJed Brown PETSC_EXTERN void MPIAPI PetscSum_Local(void*,void*,PetscMPIInt*,MPI_Datatype*);
13299e0435eSBarry Smith 
133ba9a049bSBarry Smith #endif
134ba9a049bSBarry Smith #if defined(PETSC_USE_REAL___FLOAT128)
13599e0435eSBarry Smith 
1368cc058d9SJed Brown PETSC_EXTERN void MPIAPI PetscSum_Local(void*,void*,PetscMPIInt*,MPI_Datatype*);
1378cc058d9SJed Brown PETSC_EXTERN void MPIAPI PetscMax_Local(void*,void*,PetscMPIInt*,MPI_Datatype*);
1388cc058d9SJed Brown PETSC_EXTERN void MPIAPI PetscMin_Local(void*,void*,PetscMPIInt*,MPI_Datatype*);
139ba9a049bSBarry Smith #endif
140ba9a049bSBarry Smith 
141367daffbSBarry Smith PETSC_INTERN void MPIAPI MPIU_MaxSum_Local(void*,void*,PetscMPIInt*,MPI_Datatype*);
1428cc058d9SJed Brown PETSC_EXTERN PetscMPIInt MPIAPI Petsc_DelCounter(MPI_Comm,PetscMPIInt,void*,void*);
143da3039f7SJed Brown PETSC_EXTERN PetscMPIInt MPIAPI Petsc_DelComm_Inner(MPI_Comm,PetscMPIInt,void*,void*);
144da3039f7SJed Brown PETSC_EXTERN PetscMPIInt MPIAPI Petsc_DelComm_Outer(MPI_Comm,PetscMPIInt,void*,void*);
145ba9a049bSBarry Smith 
146ba9a049bSBarry Smith extern PetscErrorCode  PetscOptionsCheckInitial_Private(void);
147ba9a049bSBarry Smith extern PetscErrorCode  PetscOptionsCheckInitial_Components(void);
148ba9a049bSBarry Smith extern PetscErrorCode  PetscInitialize_DynamicLibraries(void);
149ba9a049bSBarry Smith #if defined(PETSC_USE_LOG)
150896238b9SBarry Smith extern PetscErrorCode  PetscLogInitialize(void);
151ba9a049bSBarry Smith #endif
152efca3c55SSatish Balay extern PetscErrorCode  PetscMallocAlign(size_t,int,const char[],const char[],void**);
153efca3c55SSatish Balay extern PetscErrorCode  PetscFreeAlign(void*,int,const char[],const char[]);
154ba9a049bSBarry Smith extern int  PetscGlobalArgc;
155ba9a049bSBarry Smith extern char **PetscGlobalArgs;
156ba9a049bSBarry Smith 
157ba9a049bSBarry Smith /*
158ba9a049bSBarry Smith     Reads in Fortran command line argments and sends them to
159d5be86a5SBarry Smith   all processors.
160ba9a049bSBarry Smith */
161ba9a049bSBarry Smith 
162ba9a049bSBarry Smith PetscErrorCode PETScParseFortranArgs_Private(int *argc,char ***argv)
163ba9a049bSBarry Smith {
164ba9a049bSBarry Smith #if defined(PETSC_USE_NARGS)
165ba9a049bSBarry Smith   short          i,flg;
166ba9a049bSBarry Smith #else
167ba9a049bSBarry Smith   int            i;
168ba9a049bSBarry Smith #endif
169ba9a049bSBarry Smith   PetscErrorCode ierr;
170ba9a049bSBarry Smith   int            warg = 256;
171ba9a049bSBarry Smith   PetscMPIInt    rank;
172ba9a049bSBarry Smith   char           *p;
173ba9a049bSBarry Smith 
174ba9a049bSBarry Smith   ierr = MPI_Comm_rank(PETSC_COMM_WORLD,&rank);CHKERRQ(ierr);
175ba9a049bSBarry Smith   if (!rank) {
176ba9a049bSBarry Smith #if defined(PETSC_HAVE_IARG_COUNT_PROGNAME)
177ba9a049bSBarry Smith     *argc = iargc_();
178ba9a049bSBarry Smith #else
179ba9a049bSBarry Smith     /* most compilers do not count the program name for argv[0] */
180ba9a049bSBarry Smith     *argc = 1 + iargc_();
181ba9a049bSBarry Smith #endif
182ba9a049bSBarry Smith   }
183ba9a049bSBarry Smith   ierr = MPI_Bcast(argc,1,MPI_INT,0,PETSC_COMM_WORLD);CHKERRQ(ierr);
184ba9a049bSBarry Smith 
185ba9a049bSBarry Smith   /* PetscTrMalloc() not yet set, so don't use PetscMalloc() */
186efca3c55SSatish Balay   ierr = PetscMallocAlign((*argc+1)*(warg*sizeof(char)+sizeof(char*)),0,0,0,(void**)argv);CHKERRQ(ierr);
187ba9a049bSBarry Smith   (*argv)[0] = (char*)(*argv + *argc + 1);
188ba9a049bSBarry Smith 
189ba9a049bSBarry Smith   if (!rank) {
190ba9a049bSBarry Smith     ierr = PetscMemzero((*argv)[0],(*argc)*warg*sizeof(char));CHKERRQ(ierr);
191ba9a049bSBarry Smith     for (i=0; i<*argc; i++) {
192ba9a049bSBarry Smith       (*argv)[i+1] = (*argv)[i] + warg;
193541b5888SSatish Balay #if defined (PETSC_HAVE_FORTRAN_GET_COMMAND_ARGUMENT) /* same as 'else' case */
194541b5888SSatish Balay       getarg_(&i,(*argv)[i],warg);
195541b5888SSatish Balay #elif defined(PETSC_HAVE_PXFGETARG_NEW)
196ba9a049bSBarry Smith       {char *tmp = (*argv)[i];
197ba9a049bSBarry Smith       int ilen;
198ba9a049bSBarry Smith       getarg_(&i,tmp,&ilen,&ierr,warg);CHKERRQ(ierr);
199a297a907SKarl Rupp       tmp[ilen] = 0;}
200ba9a049bSBarry Smith #elif defined(PETSC_USE_NARGS)
201ba9a049bSBarry Smith       GETARG(&i,(*argv)[i],warg,&flg);
202ba9a049bSBarry Smith #else
203ba9a049bSBarry Smith       /*
204ba9a049bSBarry Smith       Because the stupid #defines above define all kinds of things to getarg_ we cannot do this test
205ba9a049bSBarry Smith       #elif defined(PETSC_HAVE_GETARG)
206ba9a049bSBarry Smith       getarg_(&i,(*argv)[i],warg);
207ba9a049bSBarry Smith       #else
208ba9a049bSBarry Smith          SETERRQ(PETSC_COMM_SELF,PETSC_ERR_SUP,"Cannot get Fortran command line arguments");
209ba9a049bSBarry Smith       */
210ba9a049bSBarry Smith       getarg_(&i,(*argv)[i],warg);
211ba9a049bSBarry Smith #endif
212ba9a049bSBarry Smith       /* zero out garbage at end of each argument */
213ba9a049bSBarry Smith       p = (*argv)[i] + warg-1;
214ba9a049bSBarry Smith       while (p > (*argv)[i]) {
215ba9a049bSBarry Smith         if (*p == ' ') *p = 0;
216ba9a049bSBarry Smith         p--;
217ba9a049bSBarry Smith       }
218ba9a049bSBarry Smith     }
219ba9a049bSBarry Smith   }
220ba9a049bSBarry Smith   ierr = MPI_Bcast((*argv)[0],*argc*warg,MPI_CHAR,0,PETSC_COMM_WORLD);CHKERRQ(ierr);
221ba9a049bSBarry Smith   if (rank) {
222a297a907SKarl Rupp     for (i=0; i<*argc; i++) (*argv)[i+1] = (*argv)[i] + warg;
223ba9a049bSBarry Smith   }
224ba9a049bSBarry Smith   return 0;
225ba9a049bSBarry Smith }
226ba9a049bSBarry Smith 
227b2bbaf76SBarry Smith #if defined(PETSC_SERIALIZE_FUNCTIONS)
228b2bbaf76SBarry Smith extern PetscFPT PetscFPTData;
229b2bbaf76SBarry Smith #endif
230b2bbaf76SBarry Smith 
231ef19f930SBarry Smith #if defined(PETSC_HAVE_THREADSAFETY)
232b22622e2STadeu Manoel extern PetscSpinlock PetscViewerASCIISpinLockOpen;
233b22622e2STadeu Manoel extern PetscSpinlock PetscViewerASCIISpinLockStdout;
234b22622e2STadeu Manoel extern PetscSpinlock PetscViewerASCIISpinLockStderr;
235b22622e2STadeu Manoel extern PetscSpinlock PetscCommSpinLock;
236ef19f930SBarry Smith #endif
237ef19f930SBarry Smith 
238ba9a049bSBarry Smith /* -----------------------------------------------------------------------------------------------*/
239ba9a049bSBarry Smith 
24011525c0dSBarry Smith #if defined(PETSC_HAVE_SAWS)
24111525c0dSBarry Smith #include <petscviewersaws.h>
24211525c0dSBarry Smith extern PetscErrorCode  PetscInitializeSAWs(const char[]);
24311525c0dSBarry Smith #endif
244ba9a049bSBarry Smith 
245ba9a049bSBarry Smith /*
246ba9a049bSBarry Smith     petscinitialize - Version called from Fortran.
247ba9a049bSBarry Smith 
248ba9a049bSBarry Smith     Notes:
249ba9a049bSBarry Smith       Since this is called from Fortran it does not return error codes
250ba9a049bSBarry Smith 
251ba9a049bSBarry Smith */
252*fb2dfec1SJacht Volker void petscinitialize_internal(CHAR filename, PetscInt len, PetscBool readarguments, PetscErrorCode *ierr)
253ba9a049bSBarry Smith {
254ba9a049bSBarry Smith #if defined (PETSC_USE_NARGS)
255ba9a049bSBarry Smith   short          flg,i;
256ba9a049bSBarry Smith #else
257ba9a049bSBarry Smith   int            i;
258bf8bcf57SSatish Balay #if !defined(PETSC_HAVE_PXFGETARG_NEW) && !defined (PETSC_HAVE_PXFGETARG_NEW) && !defined(PETSC_HAVE_FORTRAN_GET_COMMAND_ARGUMENT)
259ba9a049bSBarry Smith   int            j;
260ba9a049bSBarry Smith #endif
261ba9a049bSBarry Smith #endif
262da748e8fSMatthew G. Knepley #if defined(PETSC_HAVE_CUDA)
263da748e8fSMatthew G. Knepley   PetscBool      flg2;
26482f73ecaSAlejandro Lamas Daviña   cublasStatus_t cberr;
265da748e8fSMatthew G. Knepley #endif
266ba9a049bSBarry Smith   int            flag;
267ba9a049bSBarry Smith   PetscMPIInt    size;
268ba9a049bSBarry Smith   char           *t1,name[256],hostname[64];
269ba9a049bSBarry Smith   PetscMPIInt    f_petsc_comm_world;
270ba9a049bSBarry Smith 
271ba9a049bSBarry Smith   *ierr = PetscMemzero(name,256); if (*ierr) return;
272ba9a049bSBarry Smith   if (PetscInitializeCalled) {*ierr = 0; return;}
273ba9a049bSBarry Smith 
274ba9a049bSBarry Smith   /* this must be initialized in a routine, not as a constant declaration*/
275ba9a049bSBarry Smith   PETSC_STDOUT = stdout;
276ba9a049bSBarry Smith   PETSC_STDERR = stderr;
277ba9a049bSBarry Smith 
2780c30907bSSatish Balay   /* on Windows - set printf to default to printing 2 digit exponents */
2790c30907bSSatish Balay #if defined(PETSC_HAVE__SET_OUTPUT_FORMAT)
2800c30907bSSatish Balay   _set_output_format(_TWO_DIGIT_EXPONENT);
2810c30907bSSatish Balay #endif
2820c30907bSSatish Balay 
2834416b707SBarry Smith   *ierr = PetscOptionsCreateDefault();
284ba9a049bSBarry Smith   if (*ierr) return;
285ba9a049bSBarry Smith   i = 0;
286541b5888SSatish Balay #if defined (PETSC_HAVE_FORTRAN_GET_COMMAND_ARGUMENT) /* same as 'else' case */
287541b5888SSatish Balay   getarg_(&i,name,256);
288541b5888SSatish Balay #elif defined (PETSC_HAVE_PXFGETARG_NEW)
289ba9a049bSBarry Smith   { int ilen,sierr;
290ba9a049bSBarry Smith     getarg_(&i,name,&ilen,&sierr,256);
291a297a907SKarl Rupp     if (sierr) PetscStrncpy(name,"Unknown Name",256);
292a297a907SKarl Rupp     else name[ilen] = 0;
293ba9a049bSBarry Smith   }
294ba9a049bSBarry Smith #elif defined(PETSC_USE_NARGS)
295ba9a049bSBarry Smith   GETARG(&i,name,256,&flg);
296ba9a049bSBarry Smith #else
297ba9a049bSBarry Smith   getarg_(&i,name,256);
298ba9a049bSBarry Smith   /* Eliminate spaces at the end of the string */
299ba9a049bSBarry Smith   for (j=254; j>=0; j--) {
300ba9a049bSBarry Smith     if (name[j] != ' ') {
301ba9a049bSBarry Smith       name[j+1] = 0;
302ba9a049bSBarry Smith       break;
303ba9a049bSBarry Smith     }
304ba9a049bSBarry Smith   }
305a297a907SKarl Rupp   if (j<0) PetscStrncpy(name,"Unknown Name",256);
306ba9a049bSBarry Smith #endif
307ba9a049bSBarry Smith   *ierr = PetscSetProgramName(name);
308ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Calling PetscSetProgramName()\n");return;}
309ba9a049bSBarry Smith 
310ba9a049bSBarry Smith   /* check if PETSC_COMM_WORLD is initialized by the user in fortran */
311ba9a049bSBarry Smith   petscgetcommoncomm_(&f_petsc_comm_world);
312ba9a049bSBarry Smith   MPI_Initialized(&flag);
313ba9a049bSBarry Smith   if (!flag) {
314ba9a049bSBarry Smith     PetscMPIInt mierr;
315ba9a049bSBarry Smith 
316ba9a049bSBarry Smith     if (f_petsc_comm_world) {(*PetscErrorPrintf)("You cannot set PETSC_COMM_WORLD if you have not initialized MPI first\n");return;}
317ba9a049bSBarry Smith     /* MPI requires calling Fortran mpi_init() if main program is Fortran */
3188dc331a1SSatish Balay #if defined(PETSC_HAVE_MPIUNI) && defined(MPIUNI_AVOID_MPI_NAMESPACE)
3198dc331a1SSatish Balay     mierr = MPI_Init((int*)0, (char***)0);
3208dc331a1SSatish Balay #else
321ba9a049bSBarry Smith     mpi_init_(&mierr);
3228dc331a1SSatish Balay #endif
323ba9a049bSBarry Smith     if (mierr) {
324ba9a049bSBarry Smith       *ierr = mierr;
325ba9a049bSBarry Smith       (*PetscErrorPrintf)("PetscInitialize: Calling Fortran MPI_Init()\n");
326ba9a049bSBarry Smith       return;
327ba9a049bSBarry Smith     }
328ba9a049bSBarry Smith     PetscBeganMPI = PETSC_TRUE;
329ba9a049bSBarry Smith   }
330a297a907SKarl 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 */
331a297a907SKarl Rupp   else PETSC_COMM_WORLD = MPI_COMM_WORLD;
332ba9a049bSBarry Smith   PetscInitializeCalled = PETSC_TRUE;
333ba9a049bSBarry Smith 
3345ad9ad5bSBarry Smith   *ierr = PetscSpinlockCreate(&PetscViewerASCIISpinLockOpen);
3355ad9ad5bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Creating global spin lock\n");return;}
3365ad9ad5bSBarry Smith   *ierr = PetscSpinlockCreate(&PetscViewerASCIISpinLockStdout);
3375ad9ad5bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Creating global spin lock\n");return;}
3385ad9ad5bSBarry Smith   *ierr = PetscSpinlockCreate(&PetscViewerASCIISpinLockStderr);
339ef19f930SBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Creating global spin lock\n");return;}
340ef19f930SBarry Smith   *ierr = PetscSpinlockCreate(&PetscCommSpinLock);
341ef19f930SBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Creating global spin lock\n");return;}
342ef19f930SBarry Smith 
343ba9a049bSBarry Smith   *ierr = PetscErrorPrintfInitialize();
344ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Calling PetscErrorPrintfInitialize()\n");return;}
345ba9a049bSBarry Smith   *ierr = MPI_Comm_rank(MPI_COMM_WORLD,&PetscGlobalRank);
346ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Setting PetscGlobalRank\n");return;}
347ba9a049bSBarry Smith   *ierr = MPI_Comm_size(MPI_COMM_WORLD,&PetscGlobalSize);
348ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Setting PetscGlobalSize\n");return;}
3498ad47952SJed Brown 
3508ad47952SJed Brown   MPIU_BOOL = MPI_INT;
3518ad47952SJed Brown   MPIU_ENUM = MPI_INT;
3528ad47952SJed Brown 
353e383bbd0SJed Brown #if defined(PETSC_HAVE_COMPLEX)
354ba9a049bSBarry Smith   /*
355ba9a049bSBarry Smith      Initialized the global variable; this is because with
356ba9a049bSBarry Smith      shared libraries the constructors for global variables
357ba9a049bSBarry Smith      are not called; at least on IRIX.
358ba9a049bSBarry Smith   */
359ba9a049bSBarry Smith   {
360ba9a049bSBarry Smith #if defined(PETSC_CLANGUAGE_CXX)
361e383bbd0SJed Brown     PetscComplex ic(0.0,1.0);
362ba9a049bSBarry Smith     PETSC_i = ic;
363ba9a049bSBarry Smith #else
364e383bbd0SJed Brown     PETSC_i = _Complex_I;
365ba9a049bSBarry Smith #endif
366ba9a049bSBarry Smith   }
367ba9a049bSBarry Smith 
368ba9a049bSBarry Smith #if !defined(PETSC_HAVE_MPI_C_DOUBLE_COMPLEX)
369e383bbd0SJed Brown   *ierr = MPI_Type_contiguous(2,MPI_DOUBLE,&MPIU_C_DOUBLE_COMPLEX);
370ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
371ba9a049bSBarry Smith   *ierr = MPI_Type_commit(&MPIU_C_DOUBLE_COMPLEX);
372ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
373ba9a049bSBarry Smith   *ierr = MPI_Type_contiguous(2,MPI_FLOAT,&MPIU_C_COMPLEX);
374ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
375ba9a049bSBarry Smith   *ierr = MPI_Type_commit(&MPIU_C_COMPLEX);
376ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
377ba9a049bSBarry Smith   *ierr = MPI_Op_create(PetscSum_Local,1,&MPIU_SUM);
378ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;}
379ba9a049bSBarry Smith #endif
380ba9a049bSBarry Smith 
381ba9a049bSBarry Smith #endif
382ba9a049bSBarry Smith 
383ba9a049bSBarry Smith #if defined(PETSC_USE_REAL___FLOAT128)
384ba9a049bSBarry Smith   *ierr = MPI_Type_contiguous(2,MPI_DOUBLE,&MPIU___FLOAT128);
385ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
386ba9a049bSBarry Smith   *ierr = MPI_Type_commit(&MPIU___FLOAT128);
387ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
388e383bbd0SJed Brown #if defined(PETSC_HAVE_COMPLEX)
389e383bbd0SJed Brown   *ierr = MPI_Type_contiguous(4,MPI_DOUBLE,&MPIU___COMPLEX128);
390ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
391ba9a049bSBarry Smith   *ierr = MPI_Type_commit(&MPIU___COMPLEX128);
392ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
393ba9a049bSBarry Smith #endif
394ba9a049bSBarry Smith   *ierr = MPI_Op_create(PetscSum_Local,1,&MPIU_SUM);
395ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;}
396ba9a049bSBarry Smith   *ierr = MPI_Op_create(PetscMax_Local,1,&MPIU_MAX);
397ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;}
398ba9a049bSBarry Smith   *ierr = MPI_Op_create(PetscMin_Local,1,&MPIU_MIN);
399ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;}
400ba9a049bSBarry Smith #endif
401ba9a049bSBarry Smith 
402ba9a049bSBarry Smith   /*
403ba9a049bSBarry Smith        Create the PETSc MPI reduction operator that sums of the first
404ba9a049bSBarry Smith      half of the entries and maxes the second half.
405ba9a049bSBarry Smith   */
406367daffbSBarry Smith   *ierr = MPI_Op_create(MPIU_MaxSum_Local,1,&MPIU_MAXSUM_OP);
407ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops\n");return;}
408ba9a049bSBarry Smith 
409ba9a049bSBarry Smith   *ierr = MPI_Type_contiguous(2,MPIU_SCALAR,&MPIU_2SCALAR);
410ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
411ba9a049bSBarry Smith   *ierr = MPI_Type_commit(&MPIU_2SCALAR);
412ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
41344041f26SJed Brown #if defined(PETSC_USE_64BIT_INDICES) || !defined(MPI_2INT)
414ba9a049bSBarry Smith   *ierr = MPI_Type_contiguous(2,MPIU_INT,&MPIU_2INT);
415ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
416ba9a049bSBarry Smith   *ierr = MPI_Type_commit(&MPIU_2INT);
417ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types\n");return;}
41844041f26SJed Brown #endif
419ba9a049bSBarry Smith   *ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelCounter,&Petsc_Counter_keyval,(void*)0);
420ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI keyvals\n");return;}
421da3039f7SJed Brown   *ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelComm_Outer,&Petsc_InnerComm_keyval,(void*)0);
422ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI keyvals\n");return;}
423da3039f7SJed Brown   *ierr = MPI_Keyval_create(MPI_NULL_COPY_FN,Petsc_DelComm_Inner,&Petsc_OuterComm_keyval,(void*)0);
424ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI keyvals\n");return;}
425ba9a049bSBarry Smith 
426ba9a049bSBarry Smith   /*
427ba9a049bSBarry Smith      PetscInitializeFortran() is called twice. Here it initializes
428ba9a049bSBarry Smith      PETSC_NULL_CHARACTER_Fortran. Below it initializes the PETSC_VIEWERs.
429ba9a049bSBarry Smith      The PETSC_VIEWERs have not been created yet, so they must be initialized
430ba9a049bSBarry Smith      below.
431ba9a049bSBarry Smith   */
432ba9a049bSBarry Smith   PetscInitializeFortran();
433*fb2dfec1SJacht Volker   if(readarguments == PETSC_TRUE) {
434ba9a049bSBarry Smith     PETScParseFortranArgs_Private(&PetscGlobalArgc,&PetscGlobalArgs);
435ba9a049bSBarry Smith     FIXCHAR(filename,len,t1);
436c5929fdfSBarry Smith     *ierr = PetscOptionsInsert(NULL,&PetscGlobalArgc,&PetscGlobalArgs,t1);
437ba9a049bSBarry Smith     FREECHAR(filename,t1);
438ba9a049bSBarry Smith     if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating options database\n");return;}
439*fb2dfec1SJacht Volker   }
440ba9a049bSBarry Smith   *ierr = PetscOptionsCheckInitial_Private();
441ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Checking initial options\n");return;}
44211525c0dSBarry Smith   *ierr = PetscCitationsInitialize();
44311525c0dSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:PetscCitationsInitialize()\n");return;}
44411525c0dSBarry Smith #if defined(PETSC_HAVE_SAWS)
44511525c0dSBarry Smith   *ierr = PetscInitializeSAWs(NULL);
44611525c0dSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Initializing SAWs\n");return;}
44711525c0dSBarry Smith #endif
448ba9a049bSBarry Smith #if defined(PETSC_USE_LOG)
449896238b9SBarry Smith   *ierr = PetscLogInitialize();
450ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: intializing logging\n");return;}
451ba9a049bSBarry Smith #endif
452ba9a049bSBarry Smith   *ierr = PetscInitialize_DynamicLibraries();
453ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Initializing dynamic libraries\n");return;}
454ba9a049bSBarry Smith 
455ba9a049bSBarry Smith   *ierr = PetscInitializeFortran();
456ba9a049bSBarry Smith   if (*ierr) { (*PetscErrorPrintf)("PetscInitialize:Setting up common block\n");return;}
457ba9a049bSBarry Smith 
458ba9a049bSBarry Smith   *ierr = MPI_Comm_size(PETSC_COMM_WORLD,&size);
459ba9a049bSBarry Smith   if (*ierr) { (*PetscErrorPrintf)("PetscInitialize:Getting MPI_Comm_size()\n");return;}
460ba9a049bSBarry Smith   *ierr = PetscInfo1(0,"(Fortran):PETSc successfully started: procs %d\n",size);
461ba9a049bSBarry Smith   if (*ierr) { (*PetscErrorPrintf)("PetscInitialize:Calling PetscInfo()\n");return;}
462ba9a049bSBarry Smith   *ierr = PetscGetHostName(hostname,64);
463ba9a049bSBarry Smith   if (*ierr) { (*PetscErrorPrintf)("PetscInitialize:Getting hostname\n");return;}
464ba9a049bSBarry Smith   *ierr = PetscInfo1(0,"Running on machine: %s\n",hostname);
465ba9a049bSBarry Smith   if (*ierr) { (*PetscErrorPrintf)("PetscInitialize:Calling PetscInfo()\n");return;}
466ba9a049bSBarry Smith   *ierr = PetscOptionsCheckInitial_Components();
467ba9a049bSBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Checking initial options\n");return;}
468ba9a049bSBarry Smith 
469ef19f930SBarry Smith #if defined(PETSC_USE_DEBUG) && !defined(PETSC_HAVE_THREADSAFETY)
4709248b815SShri Abhyankar   *ierr = PetscStackCreate();
4713f209d92SBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:PetscStackCreate()\n");return;}
4729248b815SShri Abhyankar #endif
4739248b815SShri Abhyankar 
474b2bbaf76SBarry Smith #if defined(PETSC_SERIALIZE_FUNCTIONS)
475b2bbaf76SBarry Smith   *ierr = PetscFPTCreate(10000);
476b2bbaf76SBarry Smith   if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:PetscFPTCreate()\n");return;}
477b2bbaf76SBarry Smith #endif
478b2bbaf76SBarry Smith 
479ba9a049bSBarry Smith #if defined(PETSC_HAVE_CUDA)
480da748e8fSMatthew G. Knepley   flg2  = PETSC_TRUE;
481c5929fdfSBarry Smith   *ierr = PetscOptionsGetBool(NULL,NULL,"-cublas",&flg2,NULL);
48282f73ecaSAlejandro Lamas Daviña   if (flg2) {
48382f73ecaSAlejandro Lamas Daviña     cberr = cublasCreate(&cublasv2handle);
48482f73ecaSAlejandro Lamas Daviña     if (((int)cberr) != (int)CUBLAS_STATUS_SUCCESS) {(*PetscErrorPrintf)("PetscInitialize:CUBLAS error %d\n",cberr);return;}
48582f73ecaSAlejandro Lamas Daviña   }
486ba9a049bSBarry Smith #endif
487ba9a049bSBarry Smith }
488ba9a049bSBarry Smith 
489*fb2dfec1SJacht Volker /*
490*fb2dfec1SJacht Volker     petscinitialize - Wrapper methods to enable or disable argument passing
491*fb2dfec1SJacht Volker */
492*fb2dfec1SJacht Volker PETSC_EXTERN void PETSC_STDCALL petscinitialize_(CHAR filename PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
493*fb2dfec1SJacht Volker {
494*fb2dfec1SJacht Volker 	petscinitialize_internal(filename, len, PETSC_TRUE, ierr);
495*fb2dfec1SJacht Volker }
496*fb2dfec1SJacht Volker 
497*fb2dfec1SJacht Volker PETSC_EXTERN void PETSC_STDCALL petscinitializenoarguments_(PetscErrorCode *ierr)
498*fb2dfec1SJacht Volker {
499*fb2dfec1SJacht Volker 	petscinitialize_internal(NULL, (PetscInt) 0, PETSC_FALSE, ierr);
500*fb2dfec1SJacht Volker }
501*fb2dfec1SJacht Volker 
502*fb2dfec1SJacht Volker 
5038cc058d9SJed Brown PETSC_EXTERN void PETSC_STDCALL petscfinalize_(PetscErrorCode *ierr)
504ba9a049bSBarry Smith {
505ba9a049bSBarry Smith #if defined(PETSC_HAVE_SUNMATHPRO)
506ba9a049bSBarry Smith   extern void standard_arithmetic();
507ba9a049bSBarry Smith   standard_arithmetic();
508ba9a049bSBarry Smith #endif
509ba9a049bSBarry Smith   /* was malloced with PetscMallocAlign() so free the same way */
510efca3c55SSatish Balay   *ierr = PetscFreeAlign(PetscGlobalArgs,0,0,0);if (*ierr) {(*PetscErrorPrintf)("PetscFinalize:Freeing args\n");return;}
511ba9a049bSBarry Smith 
512ba9a049bSBarry Smith   *ierr = PetscFinalize();
513ba9a049bSBarry Smith }
514ba9a049bSBarry Smith 
515a45aced0SAlex Fikl PETSC_EXTERN void PETSC_STDCALL petscend_(PetscErrorCode *ierr)
516ba9a049bSBarry Smith {
517ba9a049bSBarry Smith #if defined(PETSC_HAVE_SUNMATHPRO)
518ba9a049bSBarry Smith   extern void standard_arithmetic();
519ba9a049bSBarry Smith   standard_arithmetic();
520ba9a049bSBarry Smith #endif
521ba9a049bSBarry Smith 
522ba9a049bSBarry Smith   *ierr = PetscEnd();
523ba9a049bSBarry Smith }
524ba9a049bSBarry Smith 
525