Skip to content

Commit

Permalink
mpif08: convert scatter_init
Browse files Browse the repository at this point in the history
Signed-off-by: Howard Pritchard <howardp@lanl.gov>
  • Loading branch information
hppritcha committed Oct 4, 2024
1 parent ea15323 commit e01eb0b
Show file tree
Hide file tree
Showing 5 changed files with 101 additions and 53 deletions.
1 change: 0 additions & 1 deletion ompi/mpi/fortran/use-mpi-f08/Makefile.am
Original file line number Diff line number Diff line change
Expand Up @@ -286,7 +286,6 @@ mpi_api_files = \
request_free_f08.F90 \
request_get_status_f08.F90 \
scan_init_f08.F90 \
scatter_init_f08.F90 \
session_call_errhandler_f08.F90\
session_create_errhandler_f08.F90\
session_get_errhandler_f08.F90\
Expand Down
2 changes: 2 additions & 0 deletions ompi/mpi/fortran/use-mpi-f08/Makefile.prototype_files
Original file line number Diff line number Diff line change
Expand Up @@ -129,6 +129,7 @@ prototype_files = \
$(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/rsend_ts.c.in \
$(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/scan_ts.c.in \
$(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/scatter_ts.c.in \
$(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/scatter_init_ts.c.in \
$(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/scatterv_ts.c.in \
$(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/scatterv_init_ts.c.in \
$(abs_top_srcdir)/ompi/mpi/fortran/use-mpi-f08/send_init_ts.c.in \
Expand Down Expand Up @@ -190,6 +191,7 @@ extra_dist_prototype_files = \
scatterv_ts.c.in \
scatterv_init_ts.c.in \
scatter_ts.c.in \
scatter_init_ts.c.in \
neighbor_alltoallv_ts.c.in \
compare_and_swap_ts.c.in \
rput_ts.c.in \
Expand Down
17 changes: 0 additions & 17 deletions ompi/mpi/fortran/use-mpi-f08/mod/mpi-f08-interfaces.h.in
Original file line number Diff line number Diff line change
Expand Up @@ -772,23 +772,6 @@ subroutine MPI_Scan_init_f08(sendbuf,recvbuf,count,datatype,op,comm,info,request
end subroutine MPI_Scan_init_f08
end interface MPI_Scan_init

interface MPI_Scatter_init
subroutine MPI_Scatter_init_f08(sendbuf,sendcount,sendtype,recvbuf,recvcount,recvtype, &
root,comm,info,request,ierror)
use :: mpi_f08_types, only : MPI_Datatype, MPI_Comm, MPI_Info, MPI_Request
implicit none
@OMPI_FORTRAN_IGNORE_TKR_PREDECL@ sendbuf, recvbuf
@OMPI_FORTRAN_IGNORE_TKR_TYPE@, INTENT(IN) OMPI_ASYNCHRONOUS :: sendbuf
@OMPI_FORTRAN_IGNORE_TKR_TYPE@ OMPI_ASYNCHRONOUS :: recvbuf
INTEGER, INTENT(IN) :: sendcount, recvcount, root
TYPE(MPI_Datatype), INTENT(IN) :: sendtype, recvtype
TYPE(MPI_Comm), INTENT(IN) :: comm
TYPE(MPI_Info), INTENT(IN) :: info
TYPE(MPI_Request), INTENT(OUT) :: request
INTEGER, OPTIONAL, INTENT(OUT) :: ierror
end subroutine MPI_Scatter_init_f08
end interface MPI_Scatter_init

interface MPI_Comm_compare
subroutine MPI_Comm_compare_f08(comm1,comm2,result,ierror)
use :: mpi_f08_types, only : MPI_Comm
Expand Down
35 changes: 0 additions & 35 deletions ompi/mpi/fortran/use-mpi-f08/scatter_init_f08.F90

This file was deleted.

99 changes: 99 additions & 0 deletions ompi/mpi/fortran/use-mpi-f08/scatter_init_ts.c.in
Original file line number Diff line number Diff line change
@@ -0,0 +1,99 @@
/*
* Copyright (c) 2004-2005 The Trustees of Indiana University and Indiana
* University Research and Technology
* Corporation. All rights reserved.
* Copyright (c) 2004-2005 The University of Tennessee and The University
* of Tennessee Research Foundation. All rights
* reserved.
* Copyright (c) 2004-2005 High Performance Computing Center Stuttgart,
* University of Stuttgart. All rights reserved.
* Copyright (c) 2004-2005 The Regents of the University of California.
* All rights reserved.
* Copyright (c) 2011-2013 Cisco Systems, Inc. All rights reserved.
* Copyright (c) 2015-2019 Research Organization for Information Science
* and Technology (RIST). All rights reserved.
* $COPYRIGHT$
*
* Additional copyrights may follow
*
* $HEADER$
*/

PROTOTYPE VOID scatter_init(BUFFER x1, COUNT sendcount,
DATATYPE sendtype, BUFFER_OUT x2,
COUNT recvcount, DATATYPE recvtype,
RANK root, COMM comm, INFO info, REQUEST_OUT request)
{
int c_ierr;
MPI_Comm c_comm = PMPI_Comm_f2c(*comm);
int c_root = OMPI_FINT_2_INT(*root);
MPI_Datatype c_sendtype = NULL, c_recvtype = NULL, c_recvdatatype = NULL;
void *sendbuf = OMPI_CFI_BASE_ADDR(x1), *recvbuf = OMPI_CFI_BASE_ADDR(x2);
MPI_Info c_info;
MPI_Request c_request;
@COUNT_TYPE@ c_sendcount = 0, c_recvcount = 0;

c_info = PMPI_Info_f2c(*info);

if (OMPI_COMM_IS_INTER(c_comm)) {
if (MPI_ROOT == c_root) {
c_sendtype = PMPI_Type_f2c(*sendtype);
c_sendcount = (@COUNT_TYPE@) *sendcount;
OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr);
if (MPI_SUCCESS != c_ierr) {
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME)
return;
}
} else if (MPI_PROC_NULL != c_root) {
c_recvtype = PMPI_Type_f2c(*recvtype);
c_recvcount = (@COUNT_TYPE@) *recvcount;
OMPI_CFI_2_C(x2, c_recvcount, c_recvtype, c_recvdatatype, c_ierr);
if (MPI_SUCCESS != c_ierr) {
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME)
return;
}
}
} else {
if (ompi_comm_rank(c_comm) == c_root) {
c_sendtype = PMPI_Type_f2c(*sendtype);
c_sendcount = (@COUNT_TYPE@) *sendcount;
OMPI_CFI_CHECK_CONTIGUOUS(x1, c_ierr);
if (MPI_SUCCESS != c_ierr) {
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME)
return;
}
}
if (OMPI_IS_FORTRAN_IN_PLACE(recvbuf)) {
recvbuf = MPI_IN_PLACE;
} else {
c_recvtype = PMPI_Type_f2c(*recvtype);
c_recvcount = (@COUNT_TYPE@) *recvcount;
OMPI_CFI_2_C(x2, c_recvcount, c_recvtype, c_recvdatatype, c_ierr);
if (MPI_SUCCESS != c_ierr) {
if (NULL != ierr) *ierr = OMPI_INT_2_FINT(c_ierr);
OMPI_ERRHANDLER_INVOKE(c_comm, c_ierr, FUNC_NAME)
return;
}
}
}

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

c_ierr = @INNER_CALL@(sendbuf,c_sendcount, c_sendtype,
recvbuf, c_recvcount, c_recvdatatype,
c_root, c_comm, c_info, &c_request);
if (MPI_SUCCESS == c_ierr) {
*request = PMPI_Request_c2f(c_request);
}

if ((c_recvdatatype != NULL ) && (c_recvdatatype != c_recvtype)){
ompi_datatype_destroy(&c_recvdatatype);
}

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

}

0 comments on commit e01eb0b

Please sign in to comment.