C++ OMPI_FINT_2_INT函数代码示例

void ompi_ireduce_f(char *sendbuf, char *recvbuf, MPI_Fint *count,
                    MPI_Fint *datatype, MPI_Fint *op,
                    MPI_Fint *root, MPI_Fint *comm, MPI_Fint *request,
                    MPI_Fint *ierr)
{
    int c_ierr;
    MPI_Datatype c_type;
    MPI_Request c_request;
    MPI_Op c_op;
    MPI_Comm c_comm;

    c_type = PMPI_Type_f2c(*datatype);
    c_op = PMPI_Op_f2c(*op);
    c_comm = PMPI_Comm_f2c(*comm);

    sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf);
    sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf);
    recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf);

    c_ierr = PMPI_Ireduce(sendbuf, recvbuf,
                         OMPI_FINT_2_INT(*count),
                         c_type, c_op,
                         OMPI_FINT_2_INT(*root),
                         c_comm, &c_request);
    if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
    if (MPI_SUCCESS == c_ierr) *request = PMPI_Request_c2f(c_request);
}

void ompi_rput_f(char *origin_addr, MPI_Fint *origin_count,
                 MPI_Fint *origin_datatype, MPI_Fint *target_rank,
                 MPI_Aint *target_disp, MPI_Fint *target_count,
                 MPI_Fint *target_datatype, MPI_Fint *win, MPI_Fint *request,
                 MPI_Fint *ierr)
{
    int c_ierr;
    MPI_Datatype c_origin_datatype = PMPI_Type_f2c(*origin_datatype);
    MPI_Datatype c_target_datatype = PMPI_Type_f2c(*target_datatype);
    MPI_Win c_win = PMPI_Win_f2c(*win);
    MPI_Request c_req;

    c_ierr = PMPI_Rput(OMPI_F2C_BOTTOM(origin_addr),
                      OMPI_FINT_2_INT(*origin_count),
                      c_origin_datatype,
                      OMPI_FINT_2_INT(*target_rank),
                      *target_disp,
                      OMPI_FINT_2_INT(*target_count),
                      c_target_datatype, c_win, &c_req);
    if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);

    if (MPI_SUCCESS != c_ierr) {
        *request = PMPI_Request_c2f(c_req);
    }
}

void ompi_ineighbor_allgather_f(char *sendbuf, MPI_Fint *sendcount, MPI_Fint *sendtype,
                                char *recvbuf, MPI_Fint *recvcount, MPI_Fint *recvtype,
                                MPI_Fint *comm, MPI_Fint *request, MPI_Fint *ierr)
{
    int ierr_c;
    MPI_Comm c_comm;
    MPI_Request c_req;
    MPI_Datatype c_sendtype, c_recvtype;

    c_comm = MPI_Comm_f2c(*comm);
    c_sendtype = MPI_Type_f2c(*sendtype);
    c_recvtype = MPI_Type_f2c(*recvtype);

    sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf);
    sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf);
    recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf);

    ierr_c = MPI_Ineighbor_allgather(sendbuf,
                                     OMPI_FINT_2_INT(*sendcount),
                                     c_sendtype,
                                     recvbuf,
                                     OMPI_FINT_2_INT(*recvcount),
                                     c_recvtype, c_comm, &c_req);

    if (NULL != ierr) *ierr = OMPI_INT_2_FINT(ierr_c);

    if (MPI_SUCCESS == ierr_c) *request = MPI_Request_c2f(c_req);
}

void shmem_get128_f(FORTRAN_POINTER_T target, FORTRAN_POINTER_T source, MPI_Fint *len, MPI_Fint *pe)
{
    MCA_SPML_CALL(get(oshmem_ctx_default, FPTR_2_VOID_PTR(source),
        OMPI_FINT_2_INT(*len) * 16,
        FPTR_2_VOID_PTR(target),
        OMPI_FINT_2_INT(*pe)));
}

void ompi_ialltoall_f(char *sendbuf, MPI_Fint *sendcount, MPI_Fint *sendtype,
                      char *recvbuf, MPI_Fint *recvcount, MPI_Fint *recvtype,
                      MPI_Fint *comm, MPI_Fint *request, MPI_Fint *ierr)
{
    int c_ierr;
    MPI_Comm c_comm;
    MPI_Request c_req;
    MPI_Datatype c_sendtype, c_recvtype;

    c_comm = MPI_Comm_f2c(*comm);
    c_sendtype = MPI_Type_f2c(*sendtype);
    c_recvtype = MPI_Type_f2c(*recvtype);

    sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf);
    sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf);
    recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf);

    c_ierr = MPI_Ialltoall(sendbuf,
                           OMPI_FINT_2_INT(*sendcount),
                           c_sendtype, 
                           recvbuf, 
                           OMPI_FINT_2_INT(*recvcount),
                           c_recvtype, c_comm, &c_req);
    if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);

    if (MPI_SUCCESS == c_ierr) *request = MPI_Request_c2f(c_req);
}

void mpi_file_write_at_all_end_f(MPI_Fint *fh, char *buf,
				 MPI_Fint *status, MPI_Fint *ierr)
{
    MPI_File c_fh = MPI_File_f2c(*fh);
    MPI_Status *c_status;
#if OMPI_SIZEOF_FORTRAN_INTEGER != SIZEOF_INT
    MPI_Status c_status2;
#endif

    /* See if we got MPI_STATUS_IGNORE */

    if (OMPI_IS_FORTRAN_STATUS_IGNORE(status)) {
        c_status = MPI_STATUS_IGNORE;
    } else {

        /* If sizeof(int) == sizeof(INTEGER), then there's no
           translation necessary -- let the underlying functions write
           directly into the Fortran status */

#if OMPI_SIZEOF_FORTRAN_INTEGER == SIZEOF_INT
        c_status = (MPI_Status *) status;
#else
        c_status = &c_status2;
#endif
    }

    *ierr = OMPI_FINT_2_INT(MPI_File_write_at_all_end(c_fh, buf, c_status));

#if OMPI_SIZEOF_FORTRAN_INTEGER != SIZEOF_INT
    if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr) &&
        MPI_STATUS_IGNORE != c_status) {
        MPI_Status_c2f(c_status, status);
    }
#endif
}

void mpi_type_create_subarray_f(MPI_Fint *ndims, MPI_Fint *size_array,
				MPI_Fint *subsize_array, 
				MPI_Fint *start_array, MPI_Fint *order,
				MPI_Fint *oldtype, MPI_Fint *newtype, 
				MPI_Fint *ierr)
{
    MPI_Datatype c_old;
    MPI_Datatype c_new;
    OMPI_ARRAY_NAME_DECL(size_array);
    OMPI_ARRAY_NAME_DECL(subsize_array);
    OMPI_ARRAY_NAME_DECL(start_array);

    c_old = MPI_Type_f2c(*oldtype);

    OMPI_ARRAY_FINT_2_INT(size_array, *ndims);
    OMPI_ARRAY_FINT_2_INT(subsize_array, *ndims);
    OMPI_ARRAY_FINT_2_INT(start_array, *ndims);

    *ierr = OMPI_INT_2_FINT(MPI_Type_create_subarray(OMPI_FINT_2_INT(*ndims),
				     OMPI_ARRAY_NAME_CONVERT(size_array),
                                     OMPI_ARRAY_NAME_CONVERT(subsize_array),
                                     OMPI_ARRAY_NAME_CONVERT(start_array),
                                     *order, c_old, &c_new));

    if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr)) {
        *newtype = MPI_Type_c2f(c_new);
    }

    OMPI_ARRAY_FINT_2_INT_CLEANUP(size_array);
    OMPI_ARRAY_FINT_2_INT_CLEANUP(subsize_array);
    OMPI_ARRAY_FINT_2_INT_CLEANUP(start_array);
}

void mpi_graph_create_f(MPI_Fint *comm_old, MPI_Fint *nnodes,
                        MPI_Fint *index, MPI_Fint *edges,
                        MPI_Flogical *reorder, MPI_Fint *comm_graph,
                        MPI_Fint *ierr)
{
    MPI_Comm c_comm_old, c_comm_graph;
    OMPI_ARRAY_NAME_DECL(index);
    OMPI_ARRAY_NAME_DECL(edges);

    c_comm_old = MPI_Comm_f2c(*comm_old);

    OMPI_ARRAY_FINT_2_INT(index, *nnodes);

    /* Number of edges is equal to the last entry in the index array */
    OMPI_ARRAY_FINT_2_INT(edges, index[*nnodes - 1]);

    *ierr = OMPI_INT_2_FINT(MPI_Graph_create(c_comm_old, 
                                             OMPI_FINT_2_INT(*nnodes),
                                             OMPI_ARRAY_NAME_CONVERT(index),
                                             OMPI_ARRAY_NAME_CONVERT(edges),
                                             OMPI_LOGICAL_2_INT(*reorder),
                                             &c_comm_graph));
    if (OMPI_SUCCESS == OMPI_FINT_2_INT(*ierr)) {
        *comm_graph = MPI_Comm_c2f(c_comm_graph);
    }

    OMPI_ARRAY_FINT_2_INT_CLEANUP(index);
    OMPI_ARRAY_FINT_2_INT_CLEANUP(edges);
}

void mpi_cart_sub_f(MPI_Fint *comm, ompi_fortran_logical_t *remain_dims,
                    MPI_Fint *new_comm, MPI_Fint *ierr)
{
    MPI_Comm c_comm, c_new_comm;
    /*
     * Just in the case, when sizeof(logical)!=sizeof(int) and
     * Fortran TRUE-value != 1, we have to convert -- then we need
     * to know the number of dimensions, for the size of remain_dims
     */
#if OMPI_FORTRAN_MUST_CONVERT_LOGICAL_2_INT == 1
    int ndims;
#endif
    OMPI_LOGICAL_ARRAY_NAME_DECL(remain_dims);

    c_comm = MPI_Comm_f2c(*comm);
    c_new_comm = MPI_Comm_f2c(*new_comm);

#if OMPI_FORTRAN_MUST_CONVERT_LOGICAL_2_INT == 1
    *ierr = OMPI_INT_2_FINT(MPI_Cartdim_get(c_comm, &ndims));
    if (MPI_SUCCESS != OMPI_FINT_2_INT(*ierr)) {
        return;
    }
#endif
    OMPI_ARRAY_LOGICAL_2_INT(remain_dims, ndims);

    *ierr = OMPI_INT_2_FINT(MPI_Cart_sub(c_comm,
                              OMPI_LOGICAL_ARRAY_NAME_CONVERT(remain_dims),
                              &c_new_comm));
    if (MPI_SUCCESS == OMPI_FINT_2_INT(*ierr)) {
        *new_comm = MPI_Comm_c2f(c_new_comm);
    }

    OMPI_ARRAY_INT_2_LOGICAL(remain_dims, ndims);
}

void mpi_cart_get_f(MPI_Fint *comm, MPI_Fint *maxdims, MPI_Fint *dims,
		    ompi_fortran_logical_t *periods, MPI_Fint *coords, MPI_Fint *ierr)
{
    MPI_Comm c_comm;
    int size;
    OMPI_ARRAY_NAME_DECL(dims);
    OMPI_ARRAY_NAME_DECL(coords);
    OMPI_LOGICAL_ARRAY_NAME_DECL(periods);

    c_comm = MPI_Comm_f2c(*comm);

    size = OMPI_FINT_2_INT(*maxdims);
    OMPI_ARRAY_FINT_2_INT_ALLOC(dims, size);
    OMPI_ARRAY_FINT_2_INT_ALLOC(coords, size);
    OMPI_ARRAY_LOGICAL_2_INT_ALLOC(periods, size);

    *ierr = OMPI_INT_2_FINT(MPI_Cart_get(c_comm,
                                         OMPI_FINT_2_INT(*maxdims), 
                                         OMPI_ARRAY_NAME_CONVERT(dims),
                                         OMPI_LOGICAL_ARRAY_NAME_CONVERT(periods),
                                         OMPI_ARRAY_NAME_CONVERT(coords)));

    OMPI_ARRAY_INT_2_FINT(dims, size);
    OMPI_ARRAY_INT_2_LOGICAL(periods, size);
    OMPI_ARRAY_INT_2_FINT(coords, size);
}

void ompix_allgather_init_f(char *sendbuf, MPI_Fint *sendcount, MPI_Fint *sendtype,
                            char *recvbuf, MPI_Fint *recvcount, MPI_Fint *recvtype,
                            MPI_Fint *comm, MPI_Fint *info, MPI_Fint *request, MPI_Fint *ierr)
{
    int ierr_c;
    MPI_Comm c_comm;
    MPI_Request c_req;
    MPI_Datatype c_sendtype, c_recvtype;
    MPI_Info c_info;

    c_comm = PMPI_Comm_f2c(*comm);
    c_sendtype = PMPI_Type_f2c(*sendtype);
    c_recvtype = PMPI_Type_f2c(*recvtype);
    c_info = PMPI_Info_f2c(*info);

    sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf);
    sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf);
    recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf);

    ierr_c = PMPIX_Allgather_init(sendbuf,
                                  OMPI_FINT_2_INT(*sendcount),
                                  c_sendtype,
                                  recvbuf,
                                  OMPI_FINT_2_INT(*recvcount),
                                  c_recvtype, c_comm, c_info, &c_req);

    if (NULL != ierr) *ierr = OMPI_INT_2_FINT(ierr_c);

    if (MPI_SUCCESS == ierr_c) *request = PMPI_Request_c2f(c_req);
}

void mpi_scatterv_f(char *sendbuf, MPI_Fint *sendcounts,
		    MPI_Fint *displs, MPI_Fint *sendtype,
		    char *recvbuf, MPI_Fint *recvcount, 
		    MPI_Fint *recvtype, MPI_Fint *root,
		    MPI_Fint *comm, MPI_Fint *ierr)
{
    MPI_Comm c_comm;
    MPI_Datatype c_sendtype, c_recvtype;
    int size;
    OMPI_ARRAY_NAME_DECL(sendcounts);
    OMPI_ARRAY_NAME_DECL(displs);

    c_comm = MPI_Comm_f2c(*comm);
    c_sendtype = MPI_Type_f2c(*sendtype);
    c_recvtype = MPI_Type_f2c(*recvtype);

    MPI_Comm_size(c_comm, &size);
    OMPI_ARRAY_FINT_2_INT(sendcounts, size);
    OMPI_ARRAY_FINT_2_INT(displs, size);

    sendbuf = (char *) OMPI_F2C_IN_PLACE(sendbuf);
    sendbuf = (char *) OMPI_F2C_BOTTOM(sendbuf);
    recvbuf = (char *) OMPI_F2C_BOTTOM(recvbuf);

    *ierr = OMPI_INT_2_FINT(MPI_Scatterv(sendbuf, 
					 OMPI_ARRAY_NAME_CONVERT(sendcounts),
					 OMPI_ARRAY_NAME_CONVERT(displs),
					 c_sendtype, recvbuf,
					 OMPI_FINT_2_INT(*recvcount),
					 c_recvtype, 
					 OMPI_FINT_2_INT(*root), c_comm));

    OMPI_ARRAY_FINT_2_INT_CLEANUP(sendcounts);
    OMPI_ARRAY_FINT_2_INT_CLEANUP(displs);
}

void shmem_put_f(FORTRAN_POINTER_T target, FORTRAN_POINTER_T source, MPI_Fint *length, MPI_Fint *pe)
{
    shmem_put(FPTR_2_VOID_PTR(target), 
        FPTR_2_VOID_PTR(source), 
        OMPI_FINT_2_INT(*length), 
        OMPI_FINT_2_INT(*pe));
}

void shmem_putmem_nbi_f(FORTRAN_POINTER_T target, FORTRAN_POINTER_T source, MPI_Fint *length, MPI_Fint *pe)
{
    MCA_SPML_CALL(put_nb(FPTR_2_VOID_PTR(target),
        OMPI_FINT_2_INT(*length),
        FPTR_2_VOID_PTR(source),
        OMPI_FINT_2_INT(*pe), NULL));
}

void ompi_sendrecv_replace_f(char *buf, MPI_Fint *count, MPI_Fint *datatype,
			    MPI_Fint *dest, MPI_Fint *sendtag,
			    MPI_Fint *source, MPI_Fint *recvtag,
			    MPI_Fint *comm, MPI_Fint *status, MPI_Fint *ierr)
{
   int c_ierr;
   MPI_Datatype c_type = PMPI_Type_f2c(*datatype);
   MPI_Comm c_comm;
   MPI_Status c_status;

   c_comm = PMPI_Comm_f2c (*comm);

   c_ierr = PMPI_Sendrecv_replace(OMPI_F2C_BOTTOM(buf),
                                 OMPI_FINT_2_INT(*count),
                                 c_type,
                                 OMPI_FINT_2_INT(*dest),
                                 OMPI_FINT_2_INT(*sendtag),
                                 OMPI_FINT_2_INT(*source),
                                 OMPI_FINT_2_INT(*recvtag),
                                 c_comm, &c_status);
   if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);

   if (MPI_SUCCESS == c_ierr &&
        !OMPI_IS_FORTRAN_STATUS_IGNORE(status)) {
      PMPI_Status_c2f(&c_status, status);
   }
}