Charm++: Charm Source Code Documentation

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