Actual source code: zstart.c
1: /*
2: This file contains Fortran stubs for PetscInitialize and Finalize.
3: */
5: /*
6: This is to prevent the Cray T3D version of MPI (University of Edinburgh)
7: from stupidly redefining MPI_INIT(). They put this in to detect errors
8: in C code,but here I do want to be calling the Fortran version from a
9: C subroutine.
10: */
11: #define T3DMPI_FORTRAN
12: #define T3EMPI_FORTRAN
14: #include src/fortran/custom/zpetsc.h
15: #include petscsys.h
19: #ifdef PETSC_HAVE_FORTRAN_CAPS
20: #define petscinitialize_ PETSCINITIALIZE
21: #define petscfinalize_ PETSCFINALIZE
22: #define petscend_ PETSCEND
23: #define iargc_ IARGC
24: #define getarg_ GETARG
25: #define mpi_init_ MPI_INIT
26: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
27: #define petscinitialize_ petscinitialize
28: #define petscfinalize_ petscfinalize
29: #define petscend_ petscend
30: #define mpi_init_ mpi_init
31: #define iargc_ iargc
32: #define getarg_ getarg
33: #endif
35: #if defined(PETSC_HAVE_NAGF90)
36: #undef iargc_
37: #undef getarg_
38: #define iargc_ f90_unix_MP_iargc
39: #define getarg_ f90_unix_MP_getarg
40: #endif
41: #if defined(PETSC_USE_NARGS) /* Digital Fortran */
42: #undef iargc_
43: #undef getarg_
44: #define iargc_ NARGS
45: #define getarg_ GETARG
46: #elif defined (PETSC_HAVE_PXFGETARG_NEW) /* cray x1 */
47: #undef iargc_
48: #undef getarg_
49: #define iargc_ ipxfargc_
50: #define getarg_ pxfgetarg_
51: #endif
52: #if defined(PETSC_HAVE_FORTRAN_IARGC_UNDERSCORE) /* HPUX + no underscore */
53: #undef iargc_
54: #undef getarg_
55: #define iargc_ iargc_
56: #define getarg_ getarg_
57: #endif
58: #if defined(PETSC_HAVE_GFORTRAN_IARGC) /* gfortran from gcc4 */
59: #define iargc_ _gfortran_iargc
60: #define getarg_ _gfortran_getarg_i4
61: #endif
63: /*
64: The extra _ is because the f2c compiler puts an
65: extra _ at the end if the original routine name
66: contained any _.
67: */
68: #if defined(PETSC_HAVE_FORTRAN_UNDERSCORE_UNDERSCORE)
69: #define mpi_init_ mpi_init__
70: #endif
75: /*
76: Different Fortran compilers handle command lines in different ways
77: */
78: #if defined(PETSC_USE_NARGS)
82: #elif defined(PETSC_HAVE_FORTRAN_STDCALL)
86: #elif defined (PETSC_HAVE_PXFGETARG_NEW)
90: #else
93: /*
94: The Cray T3D/T3E use the PXFGETARG() function
95: */
96: #if defined(PETSC_HAVE_PXFGETARG)
98: #endif
99: #endif
102: #if defined(PETSC_USE_COMPLEX)
108: #endif
115: EXTERN PetscErrorCode PETSC_DLL_IMPORT PetscOptionsCheckInitial_Private(void);
116: EXTERN PetscErrorCode PETSC_DLL_IMPORT PetscOptionsCheckInitial_Components(void);
117: EXTERN PetscErrorCode PETSC_DLL_IMPORT PetscInitialize_DynamicLibraries(void);
118: EXTERN PetscErrorCode PETSC_DLL_IMPORT PetscLogBegin_Private(void);
120: /*
121: Reads in Fortran command line argments and sends them to
122: all processors and adds them to Options database.
123: */
125: PetscErrorCode PETScParseFortranArgs_Private(int *argc,char ***argv)
126: {
127: #if defined (PETSC_USE_NARGS)
128: short i,flg;
129: #else
130: int i;
131: #endif
133: int warg = 256;
134: PetscMPIInt rank;
135: char *p;
137: MPI_Comm_rank(PETSC_COMM_WORLD,&rank);
138: if (!rank) {
139: #if defined (PETSC_HAVE_IARG_COUNT_PROGNAME)
140: *argc = iargc_();
141: #else
142: /* most compilers do not count the program name for argv[0] */
143: *argc = 1 + iargc_();
144: #endif
145: }
146: MPI_Bcast(argc,1,MPI_INT,0,PETSC_COMM_WORLD);
148: PetscMalloc((*argc+1)*(warg*sizeof(char)+sizeof(char*)),argv);
149: (*argv)[0] = (char*)(*argv + *argc + 1);
151: if (!rank) {
152: PetscMemzero((*argv)[0],(*argc)*warg*sizeof(char));
153: for (i=0; i<*argc; i++) {
154: (*argv)[i+1] = (*argv)[i] + warg;
155: #if defined(PETSC_HAVE_PXFGETARG)
156: {char *tmp = (*argv)[i];
157: int ilen;
158: PXFGETARG(&i,_cptofcd(tmp,warg),&ilen,&ierr);
159: tmp[ilen] = 0;
160: }
161: #elif defined (PETSC_HAVE_PXFGETARG_NEW)
162: {char *tmp = (*argv)[i];
163: int ilen;
164: getarg_(&i,tmp,&ilen,&ierr,warg);
165: tmp[ilen] = 0;
166: }
167: #elif defined (PETSC_USE_NARGS)
168: GETARG(&i,(*argv)[i],warg,&flg);
169: #else
170: getarg_(&i,(*argv)[i],warg);
171: #endif
172: /* zero out garbage at end of each argument */
173: p = (*argv)[i] + warg-1;
174: while (p > (*argv)[i]) {
175: if (*p == ' ') *p = 0;
176: p--;
177: }
178: }
179: }
180: MPI_Bcast((*argv)[0],*argc*warg,MPI_CHAR,0,PETSC_COMM_WORLD);
181: if (rank) {
182: for (i=0; i<*argc; i++) {
183: (*argv)[i+1] = (*argv)[i] + warg;
184: }
185: }
186: return 0;
187: }
189: /* -----------------------------------------------------------------------------------------------*/
200: /*
201: petscinitialize - Version called from Fortran.
203: Notes:
204: Since this is called from Fortran it does not return error codes
205:
206: */
207: void PETSC_STDCALL petscinitialize_(CHAR filename PETSC_MIXED_LEN(len),PetscErrorCode *ierr PETSC_END_LEN(len))
208: {
209: #if defined (PETSC_USE_NARGS)
210: short flg,i;
211: #else
212: int i;
213: #if !defined(PETSC_HAVE_PXFGETARG_NEW) && !defined (PETSC_HAVE_PXFGETARG_NEW)
214: int j;
215: #endif
216: #endif
217: int flag,argc = 0;
218: PetscMPIInt size;
219: char **args = 0,*t1,name[256],hostname[64];
220:
221: *1;
222: *PetscMemzero(name,256); if (*ierr) return;
223: if (PetscInitializeCalled) {*0; return;}
224:
225: *PetscOptionsCreate();
226: if (*ierr) return;
227: i = 0;
228: #if defined(PETSC_HAVE_PXFGETARG)
229: { int ilen,sierr;
230: PXFGETARG(&i,_cptofcd(name,256),&ilen,&sierr);
231: if (sierr) {
232: *sierr;
233: return;
234: }
235: name[ilen] = 0;
236: }
237: #elif defined (PETSC_HAVE_PXFGETARG_NEW)
238: { int ilen,sierr;
239: getarg_(&i,name,&ilen,&sierr,256);
240: if (sierr) {
241: *sierr;
242: return;
243: }
244: name[ilen] = 0;
245: }
246: #elif defined (PETSC_USE_NARGS)
247: GETARG(&i,name,256,&flg);
248: #else
249: getarg_(&i,name,256);
250: /* Eliminate spaces at the end of the string */
251: for (j=254; j>=0; j--) {
252: if (name[j] != ' ') {
253: name[j+1] = 0;
254: break;
255: }
256: }
257: #endif
258: *PetscSetProgramName(name);
259: if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Calling PetscSetProgramName()");return;}
261: MPI_Initialized(&flag);
262: if (!flag) {
263: PetscMPIInt mierr;
265: if (PETSC_COMM_WORLD) {(*PetscErrorPrintf)("You cannot set PETSC_COMM_WORLD if you have not initialized MPI first");return;}
266: /* MPI requires calling Fortran mpi_init() if main program is Fortran */
267: mpi_init_(&mierr);
268: if (mierr) {
269: *mierr;
270: (*PetscErrorPrintf)("PetscInitialize: Calling Fortran MPI_Init()");
271: return;
272: }
273: PetscBeganMPI = PETSC_TRUE;
274: }
275: if (!PETSC_COMM_WORLD) {
276: PETSC_COMM_WORLD = MPI_COMM_WORLD;
277: }
278: PetscInitializeCalled = PETSC_TRUE;
280: *PetscErrorPrintfInitialize();
281: if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Calling PetscErrorPrintfInitialize()");return;}
283: *MPI_Comm_rank(MPI_COMM_WORLD,&PetscGlobalRank);
284: if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Setting PetscGlobalRank");return;}
285: *MPI_Comm_size(MPI_COMM_WORLD,&PetscGlobalSize);
286: if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: Setting PetscGlobalSize");return;}
288: #if defined(PETSC_USE_COMPLEX)
289: /*
290: Initialized the global variable; this is because with
291: shared libraries the constructors for global variables
292: are not called; at least on IRIX.
293: */
294: {
295: PetscScalar ic(0.0,1.0);
296: PETSC_i = ic;
297: }
298: *MPI_Type_contiguous(2,MPIU_REAL,&MPIU_COMPLEX);
299: if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types");return;}
300: *MPI_Type_commit(&MPIU_COMPLEX);
301: if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types");return;}
302: *MPI_Op_create(PetscSum_Local,1,&PetscSum_Op);
303: if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops");return;}
304: #endif
306: /*
307: Create the PETSc MPI reduction operator that sums of the first
308: half of the entries and maxes the second half.
309: */
310: *MPI_Op_create(PetscMaxSum_Local,1,&PetscMaxSum_Op);
311: if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops");return;}
313: *MPI_Type_contiguous(2,MPIU_SCALAR,&MPIU_2SCALAR);
314: if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types");return;}
315: *MPI_Type_commit(&MPIU_2SCALAR);
316: if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types");return;}
317: *MPI_Type_contiguous(2,MPIU_INT,&MPIU_2INT);
318: if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types");return;}
319: *MPI_Type_commit(&MPIU_2INT);
320: if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI types");return;}
321: *MPI_Op_create(PetscADMax_Local,1,&PetscADMax_Op);
322: if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops");return;}
323: *MPI_Op_create(PetscADMin_Local,1,&PetscADMin_Op);
324: if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating MPI ops");return;}
326: /*
327: PetscInitializeFortran() is called twice. Here it initializes
328: PETSC_NULLCHARACTER_Fortran. Below it initializes the PETSC_VIEWERs.
329: The PETSC_VIEWERs have not been created yet, so they must be initialized
330: below.
331: */
332: PetscInitializeFortran();
334: PETScParseFortranArgs_Private(&argc,&args);
335: FIXCHAR(filename,len,t1);
336: *PetscOptionsInsert(&argc,&args,t1);
337: FREECHAR(filename,t1);
338: if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Creating options database");return;}
339: *PetscFree(args);
340: if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Freeing args");return;}
341: *PetscOptionsCheckInitial_Private();
342: if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Checking initial options");return;}
343: *PetscLogBegin_Private();
344: if (*ierr) {(*PetscErrorPrintf)("PetscInitialize: intializing logging");return;}
345: *PetscInitialize_DynamicLibraries();
346: if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Initializing dynamic libraries");return;}
348: *PetscInitializeFortran();
349: if (*ierr) { (*PetscErrorPrintf)("PetscInitialize:Setting up common block");return;}
351: *MPI_Comm_size(PETSC_COMM_WORLD,&size);
352: if (*ierr) { (*PetscErrorPrintf)("PetscInitialize:Getting MPI_Comm_size()");return;}
353: *PetscLogInfo((0,"PetscInitialize(Fortran):PETSc successfully started: procs %d\n",size));
354: if (*ierr) { (*PetscErrorPrintf)("PetscInitialize:Calling PetscLogInfo()");return;}
355: *PetscGetHostName(hostname,64);
356: if (*ierr) { (*PetscErrorPrintf)("PetscInitialize:Getting hostname");return;}
357: *PetscLogInfo((0,"Running on machine: %s\n",hostname));
358: if (*ierr) { (*PetscErrorPrintf)("PetscInitialize:Calling PetscLogInfo()");return;}
359: *PetscOptionsCheckInitial_Components();
360: if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:Checking initial options");return;}
361: }
363: void PETSC_STDCALL petscfinalize_(PetscErrorCode *ierr)
364: {
365: #if defined(PETSC_HAVE_SUNMATHPRO)
367: standard_arithmetic();
368: #endif
370: *PetscFinalize();
371: }
373: void PETSC_STDCALL petscend_(PetscErrorCode *ierr)
374: {
375: #if defined(PETSC_HAVE_SUNMATHPRO)
377: standard_arithmetic();
378: #endif
380: *PetscEnd();
381: }