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