Actual source code: zstart.c
1: /*$Id: zstart.c,v 1.80 2001/03/24 04:39:33 balay 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 petscsetcommworld_ PETSCSETCOMMWORLD
25: #define iargc_ IARGC
26: #define getarg_ GETARG
27: #define mpi_init_ MPI_INIT
28: #elif !defined(PETSC_HAVE_FORTRAN_UNDERSCORE)
29: #define petscinitialize_ petscinitialize
30: #define petscfinalize_ petscfinalize
31: #define petscsetcommworld_ petscsetcommworld
32: #define mpi_init_ mpi_init
33: #define iargc_ iargc
34: #define getarg_ getarg
35: #endif
37: #if defined(PETSC_HAVE_NAGF90)
38: #undef iargc_
39: #undef getarg_
40: #define iargc_ f90_unix_MP_iargc
41: #define getarg_ f90_unix_MP_getarg
42: #endif
43: #if defined(PETSC_USE_NARGS) /* Digital Fortran */
44: #undef iargc_
45: #undef getarg_
46: #define iargc_ NARGS
47: #define getarg_ GETARG
48: #endif
49: #if defined(PETSC_HAVE_FORTRAN_IARGC_UNDERSCORE) /* HPUX + no underscore */
50: #undef iargc_
51: #undef getarg_
52: #define iargc iargc_
53: #define getarg getarg_
54: #endif
56: /*
57: The extra _ is because the f2c compiler puts an
58: extra _ at the end if the original routine name
59: contained any _.
60: */
61: #if defined(PETSC_HAVE_FORTRAN_UNDERSCORE_UNDERSCORE)
62: #define mpi_init_ mpi_init__
63: #endif
65: EXTERN_C_BEGIN
66: extern void PETSC_STDCALL mpi_init_(int*);
68: /*
69: Different Fortran compilers handle command lines in different ways
70: */
71: #if defined(PETSC_USE_NARGS)
72: extern short __stdcall NARGS();
73: extern void __stdcall GETARG(short*,char*,int,short *);
75: #else
76: extern int iargc_();
77: extern void getarg_(int*,char*,int);
78: /*
79: The Cray T3D/T3E use the PXFGETARG() function
80: */
81: #if defined(PETSC_HAVE_PXFGETARG)
82: extern void PXFGETARG(int *,_fcd,int*,int*);
83: #endif
84: #endif
85: EXTERN_C_END
87: #if defined(PETSC_USE_COMPLEX)
88: extern MPI_Op PetscSum_Op;
90: EXTERN_C_BEGIN
91: extern void PetscSum_Local(void *,void *,int *,MPI_Datatype *);
92: EXTERN_C_END
93: #endif
94: extern MPI_Op PetscMaxSum_Op;
96: EXTERN_C_BEGIN
97: extern void PetscMaxSum_Local(void *,void *,int *,MPI_Datatype *);
98: EXTERN_C_END
100: EXTERN int PetscOptionsCheckInitial(void);
101: EXTERN int PetscOptionsCheckInitial_Components(void);
102: EXTERN int PetscInitialize_DynamicLibraries(void);
104: /*
105: Reads in Fortran command line argments and sends them to
106: all processors and adds them to Options database.
107: */
109: int PETScParseFortranArgs_Private(int *argc,char ***argv)
110: {
111: #if defined (PETSC_USE_NARGS)
112: short i,flg;
113: #else
114: int i;
115: #endif
116: int warg = 256,rank,ierr;
117: char *p;
119: MPI_Comm_rank(PETSC_COMM_WORLD,&rank);
120: if (!rank) {
121: #if defined (PETSC_HAVE_IARG_COUNT_PROGNAME)
122: *argc = iargc_();
123: #else
124: /* most compilers do not count the program name for argv[0] */
125: *argc = 1 + iargc_();
126: #endif
127: }
128: MPI_Bcast(argc,1,MPI_INT,0,PETSC_COMM_WORLD); if (ierr) return ierr;
130: PetscMalloc((*argc+1)*(warg*sizeof(char)+sizeof(char*)),argv);
131: (*argv)[0] = (char*)(*argv + *argc + 1);
133: if (!rank) {
134: PetscMemzero((*argv)[0],(*argc)*warg*sizeof(char));
135: for (i=0; i<*argc; i++) {
136: (*argv)[i+1] = (*argv)[i] + warg;
137: #if defined(PETSC_HAVE_PXFGETARG)
138: {char *tmp = (*argv)[i];
139: int ierr,ilen;
140: PXFGETARG(&i,_cptofcd(tmp,warg),&ilen,&ierr);
141: tmp[ilen] = 0;
142: }
143: #elif defined (PETSC_USE_NARGS)
144: GETARG(&i,(*argv)[i],warg,&flg);
145: #else
146: getarg_(&i,(*argv)[i],warg);
147: #endif
148: /* zero out garbage at end of each argument */
149: p = (*argv)[i] + warg-1;
150: while (p > (*argv)[i]) {
151: if (*p == ' ') *p = 0;
152: p--;
153: }
154: }
155: }
156: MPI_Bcast((*argv)[0],*argc*warg,MPI_CHAR,0,PETSC_COMM_WORLD); if (ierr) return ierr;
157: if (rank) {
158: for (i=0; i<*argc; i++) {
159: (*argv)[i+1] = (*argv)[i] + warg;
160: }
161: }
162: return 0;
163: }
165: /* -----------------------------------------------------------------------------------------------*/
168: EXTERN_C_BEGIN
169: /*
170: petscinitialize - Version called from Fortran.
172: Notes:
173: Since this is called from Fortran it does not return error codes
174:
175: */
176: void PETSC_STDCALL petscinitialize_(CHAR filename PETSC_MIXED_LEN(len),int *ierr PETSC_END_LEN(len))
177: {
178: #if defined (PETSC_USE_NARGS)
179: short flg,i;
180: #else
181: int i;
182: #endif
183: int j,flag,argc = 0,dummy_tag,size;
184: char **args = 0,*t1,name[256],hostname[16];
185:
186: *1;
187: *PetscMemzero(name,256); if (*ierr) return;
188: if (PetscInitializeCalled) {*0; return;}
189:
190: *PetscOptionsCreate();
191: if (*ierr) return;
192: i = 0;
193: #if defined(PETSC_HAVE_PXFGETARG)
194: { int ilen;
195: PXFGETARG(&i,_cptofcd(name,256),&ilen,ierr);
196: if (*ierr) return;
197: name[ilen] = 0;
198: }
199: #elif defined (PETSC_USE_NARGS)
200: GETARG(&i,name,256,&flg);
201: #else
202: getarg_(&i,name,256);
203: /* Eliminate spaces at the end of the string */
204: for (j=254; j>=0; j--) {
205: if (name[j] != ' ') {
206: name[j+1] = 0;
207: break;
208: }
209: }
210: #endif
211: PetscSetProgramName(name);
213: MPI_Initialized(&flag);
214: if (!flag) {
215: mpi_init_(ierr);
216: if (*ierr) {(*PetscErrorPrintf)("PetscInitialize:");return;}
217: PetscBeganMPI = PETSC_TRUE;
218: }
219: PetscInitializeCalled = PETSC_TRUE;
221: if (!PETSC_COMM_WORLD) {
222: PETSC_COMM_WORLD = MPI_COMM_WORLD;
223: }
225: #if defined(PETSC_USE_COMPLEX)
226: /*
227: Initialized the global variable; this is because with
228: shared libraries the constructors for global variables
229: are not called; at least on IRIX.
230: */
231: {
232: Scalar ic(0.0,1.0);
233: PETSC_i = ic;
234: }
235: MPI_Type_contiguous(2,MPI_DOUBLE,&MPIU_COMPLEX);
236: MPI_Type_commit(&MPIU_COMPLEX);
237: *MPI_Op_create(PetscSum_Local,1,&PetscSum_Op);
238: if (*ierr) {(*PetscErrorPrintf)("PETSC ERROR: PetscInitialize:Creating MPI ops");return;}
239: #endif
241: /*
242: Create the PETSc MPI reduction operator that sums of the first
243: half of the entries and maxes the second half.
244: */
245: *MPI_Op_create(PetscMaxSum_Local,1,&PetscMaxSum_Op);
246: if (*ierr) {(*PetscErrorPrintf)("PETSC ERROR: PetscInitialize:Creating MPI ops");return;}
248: /*
249: PetscInitializeFortran() is called twice. Here it initializes
250: PETSC_NULLCHARACTOR_Fortran. Below it initializes the PETSC_VIEWERs.
251: The PETSC_VIEWERs have not been created yet, so they must be initialized
252: below.
253: */
254: PetscInitializeFortran();
256: PETScParseFortranArgs_Private(&argc,&args);
257: FIXCHAR(filename,len,t1);
258: *PetscOptionsInsert(&argc,&args,t1);
259: FREECHAR(filename,t1);
260: if (*ierr) {(*PetscErrorPrintf)("PETSC ERROR: PetscInitialize:Creating options database");return;}
261: *PetscFree(args);
262: if (*ierr) {(*PetscErrorPrintf)("PETSC ERROR: PetscInitialize:Freeing args");return;}
263: *PetscOptionsCheckInitial();
264: if (*ierr) {(*PetscErrorPrintf)("PETSC ERROR: PetscInitialize:Checking initial options");return;}
266: /*
267: Initialize PETSC_COMM_SELF as a MPI_Comm with the PETSc attribute.
268: */
269: *PetscCommDuplicate_Private(MPI_COMM_SELF,&PETSC_COMM_SELF,&dummy_tag);
270: if (*ierr) { (*PetscErrorPrintf)("PETSC ERROR: PetscInitialize:Setting up PETSC_COMM_SELF");return;}
271: *PetscCommDuplicate_Private(PETSC_COMM_WORLD,&PETSC_COMM_WORLD,&dummy_tag);
272: if (*ierr) { (*PetscErrorPrintf)("PETSC ERROR: PetscInitialize:Setting up PETSC_COMM_WORLD");return;}
273: *PetscInitialize_DynamicLibraries();
274: if (*ierr) {(*PetscErrorPrintf)("PETSC ERROR: PetscInitialize:Initializing dynamic libraries");return;}
276: *PetscInitializeFortran();
277: if (*ierr) { (*PetscErrorPrintf)("PETSC ERROR: PetscInitialize:Setting up common block");return;}
279: *MPI_Comm_size(PETSC_COMM_WORLD,&size);
280: if (*ierr) { (*PetscErrorPrintf)("PETSC ERROR: PetscInitialize:Getting MPI_Comm_size()");return;}
281: PetscLogInfo(0,"PetscInitialize(Fortran):PETSc successfully started: procs %dn",size);
282: *PetscGetHostName(hostname,16);
283: if (*ierr) { (*PetscErrorPrintf)("PETSC ERROR: PetscInitialize:Getting hostname");return;}
284: PetscLogInfo(0,"Running on machine: %sn",hostname);
285:
286: *PetscOptionsCheckInitial_Components();
287: if (*ierr) {(*PetscErrorPrintf)("PETSC ERROR: PetscInitialize:Checking initial options");return;}
289: }
291: void PETSC_STDCALL petscfinalize_(int *ierr)
292: {
293: #if defined(PETSC_HAVE_SUNMATHPRO)
294: extern void standard_arithmetic();
295: standard_arithmetic();
296: #endif
298: *PetscFinalize();
299: }
301: void PETSC_STDCALL petscsetcommworld_(MPI_Comm *comm,int *ierr)
302: {
303: *PetscSetCommWorld((MPI_Comm)PetscToPointerComm(*comm));
304: }
305: EXTERN_C_END