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: }