initcxx.cxx

fortran并行计算包

		if (ttype) {
		    MPI::Intercomm comm1 = (MPI_Comm)handle;
		    err=(*f1)( comm1, keyval, extra_state, value, new_value, flag );
		}
		else {
		    MPI::Intracomm comm1 = (MPI_Comm)handle;
		    err=(*f1)( comm1, keyval, extra_state, value, new_value, flag );
		}
	    }
	    else if (ttype == MPI_CART) {
		MPI::Cartcomm comm1 = (MPI_Comm)handle;
		err=(*f1)( comm1, keyval, extra_state, value, new_value, flag );
	    }
	    else {
		MPI::Graphcomm comm1 = (MPI_Comm)handle;
	        err=(*f1)( comm1, keyval, extra_state, value, new_value, flag );
	    }
        }
	break;
	case MPID_DATATYPE:
	{
	MPI::Datatype cxxtype = handle;
        MPI::Datatype::Copy_attr_function *f1 = (MPI::Datatype::Copy_attr_function *)f;
	err=(*f1)( cxxtype, keyval, extra_state, value, new_value, flag );
        }
	break;
	case MPID_WIN:
	{
	MPI::Win cxxwin = handle;
        MPI::Win::Copy_attr_function *f1 = (MPI::Win::Copy_attr_function *)f;
	err=(*f1)( cxxwin, keyval, extra_state, value, new_value, flag );
        }
	break;
    }
    *cflag = flag;
    return err;
}
extern "C" void MPIR_Keyval_set_cxx( int, void (*)(void), void (*)(void) );
int Comm::Create_keyval( Copy_attr_function *cf, Delete_attr_function *df, 
			void *extra_state ) {
    int keyval;

    if (cf == MPI::Comm::NULL_COPY_FN) cf = 0;
    if (df == MPI::Comm::NULL_DELETE_FN) df = 0;

    MPIX_CALL( MPI_Comm_create_keyval( (MPI_Comm_copy_attr_function *)cf, 
				       (MPI_Comm_delete_attr_function *)df,
				      &keyval, extra_state ) );
    MPIR_Keyval_set_cxx( keyval, (mpircallback) MPIR_Call_delfn, 
			         (mpircallback) MPIR_Call_copyfn );

    return keyval;
}
int Datatype::Create_keyval( Copy_attr_function *cf, Delete_attr_function *df, 
			void *extra_state ) {
    int keyval;

    if (cf == MPI::Datatype::NULL_COPY_FN) cf = 0;
    if (df == MPI::Datatype::NULL_DELETE_FN) df = 0;

    MPIX_CALL( MPI_Type_create_keyval( (MPI_Type_copy_attr_function *)cf, 
				       (MPI_Type_delete_attr_function *)df,
				      &keyval, extra_state ) );
    MPIR_Keyval_set_cxx( keyval, (mpircallback) MPIR_Call_delfn, 
			         (mpircallback) MPIR_Call_copyfn );

    return keyval;
}
int Win::Create_keyval( Copy_attr_function *cf, Delete_attr_function *df, 
			void *extra_state ) {
    int keyval;

    if (cf == MPI::Win::NULL_COPY_FN) cf = 0;
    if (df == MPI::Win::NULL_DELETE_FN) df = 0;

    MPIX_CALL( MPI_Win_create_keyval( (MPI_Win_copy_attr_function *)cf, 
				       (MPI_Win_delete_attr_function *)df,
				      &keyval, extra_state ) );
    MPIR_Keyval_set_cxx( keyval, (mpircallback) MPIR_Call_delfn, 
			         (mpircallback) MPIR_Call_copyfn );

    return keyval;
}

// Provide a C routine that can call the C++ error handler, handling
// any calling-sequence change.  
extern "C" void MPIR_Errhandler_set_cxx( MPI_Errhandler, void (*)(void) );
extern "C" 
void MPIR_Call_errhandler_fn( int kind, int *handle, int *errcode, 
			      void (*cxxfn)(void) )
{
    // Use horrible casts to get the correct routine signature
    switch (kind) {
    case 0: // comm
	    {
		MPI_Comm *ch = (MPI_Comm *)handle;
		int flag;
		MPI::Comm::Errhandler_fn *f = (MPI::Comm::Errhandler_fn *)cxxfn;
		// Make an actual Comm (inter or intra-comm)
		MPI_Comm_test_inter( *ch, &flag );
		if (flag) {
		    MPI::Intercomm ic(*ch);
		    (*f)( ic, errcode );
		}
		else {
		    MPI::Intracomm ic(*ch);
		    (*f)( ic, errcode );
		}
	    }
	    break;
#ifdef MPI_MODE_RDONLY
    case 1: // file
	    {
		MPI::File fh = (MPI_File)*(MPI_File*)handle;
		MPI::File::Errhandler_fn *f = (MPI::File::Errhandler_fn *)cxxfn;
		(*f)( fh, errcode );
	    }
	    break;
#endif // IO
    case 2: // win
	    {
		MPI::Win fh = (MPI_Win)*(MPI_Win*)handle;
		MPI::Win::Errhandler_fn *f = (MPI::Win::Errhandler_fn *)cxxfn;
		(*f)( fh, errcode );
	    }
	    break;
    }
}
#ifdef MPI_MODE_RDONLY
Errhandler File::Create_errhandler( Errhandler_fn *f )
{
    MPI_Errhandler eh;
    MPI::Errhandler e1;
    MPI_File_create_errhandler( (MPI_File_errhandler_fn *)f, &eh );
    MPIR_Errhandler_set_cxx( eh, 
			     (mpircallback)MPIR_Call_errhandler_fn );
    e1.the_real_errhandler = eh;
    return e1;
}
#endif // IO
Errhandler Comm::Create_errhandler( Errhandler_fn *f )
{
    MPI_Errhandler eh;
    MPI::Errhandler e1;
    MPI_Comm_create_errhandler( (MPI_Comm_errhandler_fn *)f, &eh );
    MPIR_Errhandler_set_cxx( eh, 
			     (mpircallback)MPIR_Call_errhandler_fn );
    e1.the_real_errhandler = eh;
    return e1;
}
Errhandler Win::Create_errhandler( Errhandler_fn *f )
{
    MPI_Errhandler eh;
    MPI::Errhandler e1;
    MPI_Win_create_errhandler( (MPI_Win_errhandler_fn *)f, &eh );
    MPIR_Errhandler_set_cxx( eh, 
			     (mpircallback)MPIR_Call_errhandler_fn );
    e1.the_real_errhandler = eh;
    return e1;
}

#ifdef MPI_MODE_RDONLY

extern "C" {
//
// Rather than use a registered interposer, instead we interpose, taking 
// advantage of the extra_data field, similar to the handling of Grequest.
typedef struct { 
    Datarep_conversion_function *read_fn;
    Datarep_conversion_function *write_fn;
    Datarep_extent_function *extent_fn;
    void *orig_extra_state;
    } MPIR_Datarep_data;
int MPIR_Call_datarep_read_fn( void *userbuf, MPI_Datatype datatype, 
			       int count, 
			       void *filebuf, MPI_Offset position, 
			       void *extra_state )
{
    MPIR_Datarep_data *ldata = (MPIR_Datarep_data *)extra_state;
    Datatype dtype = (Datatype)datatype;
    return (ldata->read_fn)( userbuf, dtype, count, filebuf,
			    position, ldata->orig_extra_state);
}
int MPIR_Call_datarep_write_fn( void *userbuf, MPI_Datatype datatype, 
			       int count, 
			       void *filebuf, MPI_Offset position, 
			       void *extra_state )
{
    MPIR_Datarep_data *ldata = (MPIR_Datarep_data *)extra_state;
    Datatype dtype = (Datatype)datatype;
    return (ldata->write_fn)( userbuf, dtype, count, filebuf,
			     position, ldata->orig_extra_state);
}
int MPIR_Call_datarep_extent_fn( MPI_Datatype datatype, MPI_Aint *extent,
				 void *extra_state ) {
    MPIR_Datarep_data *ldata = (MPIR_Datarep_data *)extra_state;
    Aint myextent;
    int err;
    err =  (ldata->extent_fn)( (Datatype)datatype, myextent, 
			       ldata->orig_extra_state);
    *extent = myextent;
    return err;
}
} /* extern C */
void Register_datarep( const char *datarep, 
		       Datarep_conversion_function *read_fn,
		       Datarep_conversion_function *write_fn,
		       Datarep_extent_function *extent_fn,
		       void *orig_extra_state )
{
    MPIR_Datarep_data *ldata = new(MPIR_Datarep_data);
    ldata->read_fn          = read_fn;
    ldata->write_fn         = write_fn;
    ldata->extent_fn        = extent_fn;
    ldata->orig_extra_state = orig_extra_state;
    MPIX_CALL(MPI_Register_datarep( (char *)datarep, 
				MPIR_Call_datarep_read_fn,
				MPIR_Call_datarep_write_fn, 
				MPIR_Call_datarep_extent_fn, (void *)ldata ));
    /* Because datareps are never freed, the space allocated in this
       routine for ldata will never be freed */
}
#endif

void Datatype::Pack( const void *inbuf, int incount, void *outbuf, 
		     int outsize, int &position, const Comm &comm ) const {

	MPIX_CALL( MPI_Pack( (void *)inbuf, incount, the_real_datatype, outbuf, 
			    outsize, &position, comm.the_real_comm ) );

    }

int Datatype::Pack_size( int count, const Comm &comm ) const {

        int size;
	MPIX_CALL( MPI_Pack_size( count, the_real_datatype, comm.the_real_comm, &size ) );

	return size;
    }

void Datatype::Unpack( const void *inbuf, int insize, void *outbuf,
                       int outcount, int &position, const Comm &comm ) const {

	MPIX_CALL( MPI_Unpack( (void *)inbuf, insize, &position, outbuf, outcount, 
			      the_real_datatype, comm.the_real_comm ) );

    }
double Wtime(void) { return MPI_Wtime(); }
double Wtick(void) { return MPI_Wtick(); }

    Cartcomm Intracomm::Create_cart( int v2, const int * v3, const bool v4[], bool v5 ) const
    {
        Cartcomm v6;
        int *l4 = new int[v2];
        int l5;
        { 
            int i4; 
            for (i4=0;i4<v2;i4++) {
                l4[i4] = v4[i4] == true ? 1 : 0;
            }
        }
         l5 = (v5 == true) ? 1 : 0;

        MPIX_CALL( MPI_Cart_create( (MPI_Comm) the_real_comm, v2, (int *)v3, l4, l5, &(v6.the_real_comm) ));

            delete[] l4;
        return v6;
    }

    Graphcomm Intracomm::Create_graph( int v2, const int * v3, const int * v4, bool v5 ) const
    {
        Graphcomm v6;
        int l5;
         l5 = (v5 == true) ? 1 : 0;

        MPIX_CALL( MPI_Graph_create( (MPI_Comm) the_real_comm, v2, (int *)v3, (int *)v4, l5, &(v6.the_real_comm) ));

        return v6;
    }

    Intracomm Intercomm::Merge( bool v2 ) const
    {
        Intracomm v3;
        int l2;
         l2 = (v2 == true) ? 1 : 0;

        MPIX_CALL( MPI_Intercomm_merge( (MPI_Comm) the_real_comm, l2, &(v3.the_real_comm) ));

        return v3;
    }

bool Is_finalized( void )
    {
    int flag;
    MPIX_CALL( MPI_Finalized( &flag ) );
    return (flag != 0);
}

int Query_thread( void )
    {
    int provided;
    MPIX_CALL( MPI_Query_thread( &provided ) );
    return provided;
}

bool Is_thread_main( void )
    {
    int flag;
    MPIX_CALL( MPI_Is_thread_main( &flag ) );
    return (flag != 0);
}

void Get_version( int &v, int&sv )
    {
    
    MPIX_CALL( MPI_Get_version( &v,&sv ) );
}

int Add_error_class( void )
    {
    int eclass;
    MPIX_CALL( MPI_Add_error_class( &eclass ) );
    return eclass;
}

int Add_error_code( int eclass )
    {
    int ecode;
    MPIX_CALL( MPI_Add_error_code( eclass, &ecode ) );
    return ecode;
}

void Add_error_string( int ecode, const char *estring )
    {
    
    MPIX_CALL( MPI_Add_error_string( ecode, (char *)estring ) );
}

void Lookup_name( const char *sn, const Info &info, char *pn )
    {
    
    MPIX_CALL( MPI_Lookup_name( (char *)sn, (MPI_Info)info, pn ) );
}

void Publish_name( const char *sn, const Info &info, const char *pn )
    {
    
    MPIX_CALL( MPI_Publish_name( (char *)sn, (MPI_Info)info, (char *)pn ) );
}

void Unpublish_name( const char *sn, const Info &info, const char *pn )
    {
    
    MPIX_CALL( MPI_Unpublish_name( (char *)sn, (MPI_Info)info, (char *)pn ) );
}

Intercomm Comm::Get_parent( void )
    {
    MPI::Intercomm v;MPI_Comm vv;
    MPIX_CALL( MPI_Comm_get_parent( &vv ) );
    return (v = (Intercomm)vv, v);
}

Intercomm Comm::Join( const int fd )
    {
    MPI::Intercomm v;MPI_Comm vv;
    MPIX_CALL( MPI_Comm_join( fd,&vv ) );
    return (v = (Intercomm)vv,v);
}

void Close_port( const char *pn )
    {
    
    MPIX_CALL( MPI_Close_port( (char *)pn ) );
}

void Open_port( const Info &info, char *portname )
    {
    
    MPIX_CALL( MPI_Open_port( (MPI_Info)info, portname ) );
}

//
// Rather than use a registered interposer, instead we interpose taking 
// advantage of the extra_data field
typedef struct { 
    MPI::Grequest::Query_function  *query_fn;
    MPI::Grequest::Free_function   *free_fn;
    MPI::Grequest::Cancel_function *cancel_fn;
    void *orig_extra_data; } MPIR_Grequest_data;
extern "C" int MPIR_Grequest_call_query_fn( void *extra_data, 
					    MPI_Status *status )
{
    int err;
    MPI::Status s;
    MPIR_Grequest_data *d = (MPIR_Grequest_data *)extra_data;
    
    err = (d->query_fn)( d->orig_extra_data, s );
    *status = s;

    return err;
}
extern "C" int MPIR_Grequest_call_free_fn( void *extra_data )
{
    int err;
    MPIR_Grequest_data *d = (MPIR_Grequest_data *)extra_data;
    
    err = (d->free_fn)( d->orig_extra_data );

    // Recover the storage that we used for the extra_data item.
    delete d;
    return err;
}
extern "C" int MPIR_Grequest_call_cancel_fn( void *extra_data, int done )
{
    int err;
    MPI::Status s;
    MPIR_Grequest_data *d = (MPIR_Grequest_data *)extra_data;
    
    // Pass a C++ bool to the C++ version of the cancel function
    err = (d->cancel_fn)( d->orig_extra_data, done ? true : false );
    return err;
}
Grequest Grequest::Start( Grequest::Query_function query_fn,
                          Grequest::Free_function free_fn,
                          Grequest::Cancel_function cancel_fn,
                          void *extra_state ) 
{
    MPI::Grequest req;
    MPIR_Grequest_data *d = new MPIR_Grequest_data;
    d->query_fn        = query_fn;
    d->free_fn         = free_fn;
    d->cancel_fn       = cancel_fn;
    d->orig_extra_data = extra_state;
    MPI_Grequest_start( MPIR_Grequest_call_query_fn,
			MPIR_Grequest_call_free_fn,
			MPIR_Grequest_call_cancel_fn,
			(void *)d, &req.the_real_request );
    return req;
}

void MPIR_CXX_InitDatatypeNames( void )
{
    static int _isInit = 1; 
    if (_isInit) { 
	_isInit=0; 
	PMPI_Type_set_name( MPI::BOOL, (char *)"MPI::BOOL" );
	PMPI_Type_set_name( MPI::COMPLEX, (char *)"MPI::COMPLEX" );
	PMPI_Type_set_name( MPI::DOUBLE_COMPLEX, (char *)"MPI::DOUBLE_COMPLEX" );
#if defined(HAVE_LONG_DOUBLE)
	PMPI_Type_set_name( MPI::LONG_DOUBLE_COMPLEX, (char *)"MPI::LONG_DOUBLE_COMPLEX" );
#endif
    }
}
} // namespace MPI