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