Actual source code: zstart.c
1: /*$Id: zstart.c,v 1.84 2001/08/10 03:35:41 bsmith Exp $*/
3: /*
4: This file contains Fortran stubs for PetscInitialize and Finalize.
5: */
7: /*
8: This is to prevent the Cray T3D version of MPI (University of Edinburgh)
9: from stupidly redefining MPI_INIT(). They put this in to detect errors
10: in C code,but here I do want to be calling the Fortran version from a
11: C subroutine.
12: */
13: #define T3DMPI_FORTRAN
14: #define T3EMPI_FORTRAN
16: #include src/fortran/custom/zpetsc.h
17: #include petscsys.h
19: extern PetscTruth PetscBeganMPI;
21: #ifdef PETSC_HAVE_FORTRAN_CAPS
22: #define petscinitialize_ PETSCINITIALIZE
23: #define petscfinalize_ PETSCFINALIZE
24: #define petscend_ PETSCEND
25: #define petscsetcommworld_ PETSCSETCOMMWORLD
26: #define iargc_ IARGC
27: #define getarg_ GETARG
28: #define mpi_init_ MPI_INIT
29: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
30: #define petscinitialize_ petscinitialize
31: #define petscfinalize_ petscfinalize
32: #define petscend_ petscend
33: #define petscsetcommworld_ petscsetcommworld
34: #define mpi_init_ mpi_init
35: #define iargc_ iargc
36: #define getarg_ getarg
37: #endif
39: #if defined(PETSC_HAVE_NAGF90)
40: #undef iargc_
41: #undef getarg_
42: #define iargc_ f90_unix_MP_iargc
43: #define getarg_ f90_unix_MP_getarg
44: #endif
45: #if defined(PETSC_USE_NARGS) /* Digital Fortran */
46: #undef iargc_
47: #undef getarg_
48: #define iargc_ NARGS
49: #define getarg_ GETARG
50: #elif defined (PETSC_HAVE_PXFGETARG_NEW) /* cray x1 */
51: #undef iargc_
52: #undef getarg_
53: #define iargc_ ipxfargc_
54: #define getarg_ pxfgetarg_
55: #endif
56: #if defined(PETSC_HAVE_FORTRAN_IARGC_UNDERSCORE) /* HPUX + no underscore */
57: #undef iargc_
58: #undef getarg_
59: #define iargc iargc_
60: #define getarg getarg_
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
72: EXTERN_C_BEGIN
73: extern void PETSC_STDCALL mpi_init_(int*);
75: /*
76: Different Fortran compilers handle command lines in different ways
77: */
78: #if defined(PETSC_USE_NARGS)
79: extern short __stdcall NARGS();
80: extern void __stdcall GETARG(short*,char*,int,short *);
82: #elif defined (PETSC_HAVE_PXFGETARG_NEW)
83: extern int iargc_();
84: extern void getarg_(int*,char*,int*,int*,int);
86: #else
87: extern int iargc_();
88: extern void getarg_(int*,char*,int);
89: /*
90: The Cray T3D/T3E use the PXFGETARG() function
91: */
92: #if defined(PETSC_HAVE_PXFGETARG)
93: extern void PXFGETARG(int *,_fcd,int*,int*);
94: #endif
95: #endif
96: EXTERN_C_END
98: #if defined(PETSC_USE_COMPLEX)
99: extern MPI_Op PetscSum_Op;
101: EXTERN_C_BEGIN
102: extern void PetscSum_Local(void *,void *,int *,MPI_Datatype *);
103: EXTERN_C_END
104: #endif
105: extern MPI_Op PetscMaxSum_Op;
107: EXTERN_C_BEGIN
108: extern void PetscMaxSum_Local(void *,void *,int *,MPI_Datatype *);
109: EXTERN_C_END
111: EXTERN int PetscOptionsCheckInitial_Private(void);
112: EXTERN int PetscOptionsCheckInitial_Components(void);
113: EXTERN int PetscInitialize_DynamicLibraries(void);
114: EXTERN int PetscLogBegin_Private(void);
116: /*
117: Reads in Fortran command line argments and sends them to
118: all processors and adds them to Options database.
119: */
121: int PETScParseFortranArgs_Private(int *argc,char ***argv)
122: {
123: #if defined (PETSC_USE_NARGS)
124: short i,flg;
125: #else
126: int i;
127: #endif
128: int warg = 256,rank,ierr;
129: char *p;
131: MPI_Comm_rank(PETSC_COMM_WORLD,&rank);
132: if (!rank) {
133: #if defined (PETSC_HAVE_IARG_COUNT_PROGNAME)
134: *argc = iargc_();
135: #else
136: /* most compilers do not count the program name for argv[0] */
137: *argc = 1 + iargc_();
138: #endif
139: }
140: MPI_Bcast(argc,1,MPI_INT,0,PETSC_COMM_WORLD);
142: PetscMalloc((*argc+1)*(warg*sizeof(char)+sizeof(char*)),argv);
143: (*argv)[0] = (char*)(*argv + *argc + 1);
145: if (!rank) {
146: PetscMemzero((*argv)[0],(*argc)*warg*sizeof(char));
147: for (i=0; i<*argc; i++) {
148: (*argv)[i+1] = (*argv)[i] + warg;
149: #if defined(PETSC_HAVE_PXFGETARG)
150: {char *tmp = (*argv)[i];
151: int ierr,ilen;
152: PXFGETARG(&i,_cptofcd(tmp,warg),&ilen,&ierr);
153: tmp[ilen] = 0;
154: }
155: #elif defined (PETSC_HAVE_PXFGETARG_NEW)
156: {char *tmp = (*argv)[i];
157: int ierr,ilen;
158: getarg_(&i,tmp,&ilen,&ierr,warg);
159: tmp[ilen] = 0;
160: }
161: #elif defined (PETSC_USE_NARGS)
162: GETARG(&i,(*argv)[i],warg,&flg);
163: #else
164: getarg_(&i,(*argv)[i],warg);
165: #endif
166: /* zero out garbage at end of each argument */
167: p = (*argv)[i] + warg-1;
168: while (p > (*argv)[i]) {
169: if (*p == ' ') *p = 0;
170: p--;
171: }
172: }
173: }
174: MPI_Bcast((*argv)[0],*argc*warg,MPI_CHAR,0,PETSC_COMM_WORLD);
175: if (rank) {
176: for (i=0; i<*argc; i++) {
177: (*argv)[i+1] = (*argv)[i] + warg;
178: }
179: }
180: return 0;
181: }
183: /* -----------------------------------------------------------------------------------------------*/
186: EXTERN_C_BEGIN
187: /*
188: petscinitialize - Version called from Fortran.
190: Notes:
191: Since this is called from Fortran it does not return error codes
192:
193: */
194: void PETSC_STDCALL petscinitialize_(CHAR filename PETSC_MIXED_LEN(len),int *ierr PETSC_END_LEN(len))
195: {
196: #if defined (PETSC_USE_NARGS)
197: short flg,i;
198: #else
199: int i;
200: #endif
201: int j,flag,argc = 0,dummy_tag,size;
202: char **args = 0,*t1,name[256],hostname[64];
203:
204: *1;
205: *PetscMemzero(name,256); if (*ierr) return;
206: if (PetscInitializeCalled) {*0; return;}
207:
208: *PetscOptionsCreate();
209: if (*ierr) return;
210: i = 0;
211: #if defined(PETSC_HAVE_PXFGETARG)
212: { int ilen;
213: PXFGETARG(&i,_cptofcd(name,256),&ilen,ierr);
214: if (*ierr) return;
215: name[ilen] = 0;
216: }
217: #elif defined (PETSC_HAVE_PXFGETARG_NEW)
218: { int ilen;
219: getarg_(&i,name,&ilen,ierr,256);
220: if (*ierr) return;
221: name[ilen] = 0;
222: }
223: #elif defined (PETSC_USE_NARGS)
224: GETARG(&i,name,256,&flg);
225: #else
226: getarg_(&i,name,256);
227: /* Eliminate spaces at the end of the string */
228: for (j=254; j>=0; j--) {
229: if (name[j] != ' ') {
230: name[j+1] = 0;
231: break;
232: }
233: }
234: #endif
235: *PetscSetProgramName(name);
236: if (*ierr) {(*PetscErrorPrintf)("PETSC ERROR: PetscInitialize: Calling PetscSetProgramName()");return;}
238: MPI_Initialized(&flag);
239: if (!flag) {
240: mpi_init_(ierr);
241: if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:");return;}
242: PetscBeganMPI = PETSC_TRUE;
243: }
244: PetscInitializeCalled = PETSC_TRUE;
246: *PetscSetInitialDate();
247: if (*ierr) {(*PetscErrorPrintf)("PETSC ERROR: PetscInitialize: Calling PetscSetInitialDate()");return;}
249: if (!PETSC_COMM_WORLD) {
250: PETSC_COMM_WORLD = MPI_COMM_WORLD;
251: }
253: *MPI_Comm_rank(MPI_COMM_WORLD,&PetscGlobalRank);
254: if (*ierr) {(*PetscErrorPrintf)("PETSC ERROR: PetscInitialize: Setting PetscGlobalRank");return;}
255: *MPI_Comm_size(MPI_COMM_WORLD,&PetscGlobalSize);
256: if (*ierr) {(*PetscErrorPrintf)("PETSC ERROR: PetscInitialize: Setting PetscGlobalSize");return;}
258: #if defined(PETSC_USE_COMPLEX)
259: /*
260: Initialized the global variable; this is because with
261: shared libraries the constructors for global variables
262: are not called; at least on IRIX.
263: */
264: {
265: PetscScalar ic(0.0,1.0);
266: PETSC_i = ic;
267: }
268: MPI_Type_contiguous(2,MPIU_REAL,&MPIU_COMPLEX);
269: MPI_Type_commit(&MPIU_COMPLEX);
270: *MPI_Op_create(PetscSum_Local,1,&PetscSum_Op);
271: if (*ierr) {(*PetscErrorPrintf)("PETSC ERROR: PetscInitialize:Creating MPI ops");return;}
272: #endif
274: /*
275: Create the PETSc MPI reduction operator that sums of the first
276: half of the entries and maxes the second half.
277: */
278: *MPI_Op_create(PetscMaxSum_Local,1,&PetscMaxSum_Op);
279: if (*ierr) {(*PetscErrorPrintf)("PETSC ERROR: PetscInitialize:Creating MPI ops");return;}
281: /*
282: PetscInitializeFortran() is called twice. Here it initializes
283: PETSC_NULLCHARACTER_Fortran. Below it initializes the PETSC_VIEWERs.
284: The PETSC_VIEWERs have not been created yet, so they must be initialized
285: below.
286: */
287: PetscInitializeFortran();
289: PETScParseFortranArgs_Private(&argc,&args);
290: FIXCHAR(filename,len,t1);
291: *PetscOptionsInsert(&argc,&args,t1);
292: FREECHAR(filename,t1);
293: if (*ierr) {(*PetscErrorPrintf)("PETSC ERROR: PetscInitialize:Creating options database");return;}
294: *PetscFree(args);
295: if (*ierr) {(*PetscErrorPrintf)("PETSC ERROR: PetscInitialize:Freeing args");return;}
296: *PetscOptionsCheckInitial_Private();
297: if (*ierr) {(*PetscErrorPrintf)("PETSC ERROR: PetscInitialize:Checking initial options");return;}
298: *PetscLogBegin_Private();
299: if (*ierr) {(*PetscErrorPrintf)("PETSC ERROR: PetscInitialize: intializing logging");return;}
300: /*
301: Initialize PETSC_COMM_SELF as a MPI_Comm with the PETSc attribute.
302: */
303: *PetscCommDuplicate(MPI_COMM_SELF,&PETSC_COMM_SELF,&dummy_tag);
304: if (*ierr) { (*PetscErrorPrintf)("PETSC ERROR: PetscInitialize:Setting up PETSC_COMM_SELF");return;}
305: *PetscCommDuplicate(PETSC_COMM_WORLD,&PETSC_COMM_WORLD,&dummy_tag);
306: if (*ierr) { (*PetscErrorPrintf)("PETSC ERROR: PetscInitialize:Setting up PETSC_COMM_WORLD");return;}
307: *PetscInitialize_DynamicLibraries();
308: if (*ierr) {(*PetscErrorPrintf)("PETSC ERROR: PetscInitialize:Initializing dynamic libraries");return;}
310: *PetscInitializeFortran();
311: if (*ierr) { (*PetscErrorPrintf)("PETSC ERROR: PetscInitialize:Setting up common block");return;}
313: *MPI_Comm_size(PETSC_COMM_WORLD,&size);
314: if (*ierr) { (*PetscErrorPrintf)("PETSC ERROR: PetscInitialize:Getting MPI_Comm_size()");return;}
315: PetscLogInfo(0,"PetscInitialize(Fortran):PETSc successfully started: procs %d\n",size);
316: *PetscGetHostName(hostname,64);
317: if (*ierr) { (*PetscErrorPrintf)("PETSC ERROR: PetscInitialize:Getting hostname");return;}
318: PetscLogInfo(0,"Running on machine: %s\n",hostname);
319:
320: *PetscOptionsCheckInitial_Components();
321: if (*ierr) {(*PetscErrorPrintf)("PETSC ERROR: PetscInitialize:Checking initial options");return;}
323: }
325: void PETSC_STDCALL petscfinalize_(int *ierr)
326: {
327: #if defined(PETSC_HAVE_SUNMATHPRO)
328: extern void standard_arithmetic();
329: standard_arithmetic();
330: #endif
332: *PetscFinalize();
333: }
335: void PETSC_STDCALL petscend_(int *ierr)
336: {
337: #if defined(PETSC_HAVE_SUNMATHPRO)
338: extern void standard_arithmetic();
339: standard_arithmetic();
340: #endif
342: *PetscEnd();
343: }
345: void PETSC_STDCALL petscsetcommworld_(MPI_Comm *comm,int *ierr)
346: {
347: *PetscSetCommWorld((MPI_Comm)PetscToPointerComm(*comm));
348: }
349: EXTERN_C_END