Charm++: Charm Source Code Documentation

00001 /* -*- Mode: C; c-basic-offset:4 ; -*- */
00002 /* 
00003  *   $Id$    
00004  *
00005  *   Copyright (C) 1997 University of Chicago. 
00006  *   See COPYRIGHT notice in top-level directory.
00007  */
00008 
00009 #ifdef _UNICOS
00010 #include <fortran.h>
00011 #endif
00012 #include "adio.h"
00013 #include "mpio.h"
00014 
00015 
00016 #if defined(MPIO_BUILD_PROFILING) || defined(HAVE_WEAK_SYMBOLS)
00017 
00018 #if defined(HAVE_WEAK_SYMBOLS)
00019 #if defined(HAVE_PRAGMA_WEAK)
00020 #if defined(FORTRANCAPS)
00021 #pragma weak MPI_FILE_OPEN = PMPI_FILE_OPEN
00022 #elif defined(FORTRANDOUBLEUNDERSCORE)
00023 #pragma weak mpi_file_open__ = pmpi_file_open__
00024 #elif !defined(FORTRANUNDERSCORE)
00025 #pragma weak mpi_file_open = pmpi_file_open
00026 #else
00027 #pragma weak mpi_file_open_ = pmpi_file_open_
00028 #endif
00029 
00030 #elif defined(HAVE_PRAGMA_HP_SEC_DEF)
00031 #if defined(FORTRANCAPS)
00032 #pragma _HP_SECONDARY_DEF PMPI_FILE_OPEN MPI_FILE_OPEN
00033 #elif defined(FORTRANDOUBLEUNDERSCORE)
00034 #pragma _HP_SECONDARY_DEF pmpi_file_open__ mpi_file_open__
00035 #elif !defined(FORTRANUNDERSCORE)
00036 #pragma _HP_SECONDARY_DEF pmpi_file_open mpi_file_open
00037 #else
00038 #pragma _HP_SECONDARY_DEF pmpi_file_open_ mpi_file_open_
00039 #endif
00040 
00041 #elif defined(HAVE_PRAGMA_CRI_DUP)
00042 #if defined(FORTRANCAPS)
00043 #pragma _CRI duplicate MPI_FILE_OPEN as PMPI_FILE_OPEN
00044 #elif defined(FORTRANDOUBLEUNDERSCORE)
00045 #pragma _CRI duplicate mpi_file_open__ as pmpi_file_open__
00046 #elif !defined(FORTRANUNDERSCORE)
00047 #pragma _CRI duplicate mpi_file_open as pmpi_file_open
00048 #else
00049 #pragma _CRI duplicate mpi_file_open_ as pmpi_file_open_
00050 #endif
00051 
00052 /* end of weak pragmas */
00053 #endif
00054 /* Include mapping from MPI->PMPI */
00055 #include "mpioprof.h"
00056 #endif
00057 
00058 #ifdef FORTRANCAPS
00059 #define mpi_file_open_ PMPI_FILE_OPEN
00060 #elif defined(FORTRANDOUBLEUNDERSCORE)
00061 #define mpi_file_open_ pmpi_file_open__
00062 #elif !defined(FORTRANUNDERSCORE)
00063 #if defined(HPUX) || defined(SPPUX)
00064 #pragma _HP_SECONDARY_DEF pmpi_file_open pmpi_file_open_
00065 #endif
00066 #define mpi_file_open_ pmpi_file_open
00067 #else
00068 #if defined(HPUX) || defined(SPPUX)
00069 #pragma _HP_SECONDARY_DEF pmpi_file_open_ pmpi_file_open
00070 #endif
00071 #define mpi_file_open_ pmpi_file_open_
00072 #endif
00073 
00074 #else
00075 
00076 #ifdef FORTRANCAPS
00077 #define mpi_file_open_ MPI_FILE_OPEN
00078 #elif defined(FORTRANDOUBLEUNDERSCORE)
00079 #define mpi_file_open_ mpi_file_open__
00080 #elif !defined(FORTRANUNDERSCORE)
00081 #if defined(HPUX) || defined(SPPUX)
00082 #pragma _HP_SECONDARY_DEF mpi_file_open mpi_file_open_
00083 #endif
00084 #define mpi_file_open_ mpi_file_open
00085 #else
00086 #if defined(HPUX) || defined(SPPUX)
00087 #pragma _HP_SECONDARY_DEF mpi_file_open_ mpi_file_open
00088 #endif
00089 #endif
00090 #endif
00091 
00092 #if defined(MPIHP) || defined(MPILAM)
00093 /* Prototype to keep compiler happy */
00094 void mpi_file_open_(MPI_Fint *comm,char *filename,int *amode,
00095                     MPI_Fint *info, MPI_Fint *fh, int *ierr, int str_len );
00096 
00097 void mpi_file_open_(MPI_Fint *comm,char *filename,int *amode,
00098                   MPI_Fint *info, MPI_Fint *fh, int *ierr, int str_len )
00099 {
00100     char *newfname;
00101     MPI_File fh_c;
00102     int real_len, i;
00103     MPI_Comm comm_c;
00104     MPI_Info info_c;
00105 
00106     comm_c = MPI_Comm_f2c(*comm);
00107     info_c = MPI_Info_f2c(*info);
00108 
00109     /* strip trailing blanks */
00110     if (filename <= (char *) 0) {
00111         FPRINTF(stderr, "MPI_File_open: filename is an invalid address\n");
00112         MPI_Abort(MPI_COMM_WORLD, 1);
00113     }
00114     for (i=str_len-1; i>=0; i--) if (filename[i] != ' ') break;
00115     if (i < 0) {
00116         FPRINTF(stderr, "MPI_File_open: filename is a blank string\n");
00117         MPI_Abort(MPI_COMM_WORLD, 1);
00118     }
00119     real_len = i + 1;
00120 
00121     newfname = (char *) ADIOI_Malloc((real_len+1)*sizeof(char));
00122     strncpy(newfname, filename, real_len);
00123     newfname[real_len] = '\0';
00124 
00125     *ierr = MPI_File_open(comm_c, newfname, *amode, info_c, &fh_c);
00126 
00127     *fh = MPI_File_c2f(fh_c);
00128     ADIOI_Free(newfname);
00129 }
00130 
00131 #else
00132 
00133 #ifdef _UNICOS
00134 void mpi_file_open_(MPI_Comm *comm,_fcd filename_fcd,int *amode,
00135                   MPI_Fint *info, MPI_Fint *fh, int *ierr)
00136 {
00137     char *filename = _fcdtocp(filename_fcd);
00138     int str_len = _fcdlen(filename_fcd);
00139 #else
00140 /* Prototype to keep compiler happy */
00141 /*
00142 FORTRAN_API void FORT_CALL mpi_file_open_(MPI_Comm *comm,char *filename,int *amode,
00143                     MPI_Fint *info, MPI_Fint *fh, int *ierr, int str_len );
00144 
00145 FORTRAN_API void FORT_CALL mpi_file_open_(MPI_Comm *comm,char *filename,int *amode,
00146                   MPI_Fint *info, MPI_Fint *fh, int *ierr, int str_len )
00147 */
00148 /* Prototype to keep compiler happy */
00149 FORTRAN_API void FORT_CALL mpi_file_open_(MPI_Comm *comm,char *filename FORT_MIXED_LEN_DECL,int *amode,
00150                     MPI_Fint *info, MPI_Fint *fh, int *ierr FORT_END_LEN_DECL);
00151 
00152 FORTRAN_API void FORT_CALL mpi_file_open_(MPI_Comm *comm,char *filename FORT_MIXED_LEN(str_len),int *amode,
00153                   MPI_Fint *info, MPI_Fint *fh, int *ierr FORT_END_LEN(str_len))
00154 {
00155 #endif
00156     char *newfname;
00157     MPI_File fh_c;
00158     int real_len, i;
00159     MPI_Info info_c;
00160 
00161     info_c = MPI_Info_f2c(*info);
00162 
00163     /* strip trailing blanks */
00164     if (filename <= (char *) 0) {
00165         FPRINTF(stderr, "MPI_File_open: filename is an invalid address\n");
00166         MPI_Abort(MPI_COMM_WORLD, 1);
00167     }
00168     for (i=str_len-1; i>=0; i--) if (filename[i] != ' ') break;
00169     if (i < 0) {
00170         FPRINTF(stderr, "MPI_File_open: filename is a blank string\n");
00171         MPI_Abort(MPI_COMM_WORLD, 1);
00172     }
00173     real_len = i + 1;
00174 
00175     newfname = (char *) ADIOI_Malloc((real_len+1)*sizeof(char));
00176     strncpy(newfname, filename, real_len);
00177     newfname[real_len] = '\0';
00178 
00179     *ierr = MPI_File_open(*comm, newfname, *amode, info_c, &fh_c);
00180 
00181     *fh = MPI_File_c2f(fh_c);
00182     ADIOI_Free(newfname);
00183 }
00184 #endif
libs/ck-libs/ampi/romio/mpi-io/fortran/openf.c
