Skip to content

Commit 16c7f0f

Browse files
committed
ajout de la fonction MPI_Test pour l'interposition Fortran
1 parent f3cc465 commit 16c7f0f

File tree

1 file changed

+59
-0
lines changed

1 file changed

+59
-0
lines changed

src/interpolf.c

Lines changed: 59 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -561,4 +561,63 @@ _EXTERN_C_ void mpi_ibarrier_(MPI_Fint *comm, MPI_Fint *request, MPI_Fint *ierr)
561561

562562
_EXTERN_C_ void mpi_ibarrier__(MPI_Fint *comm, MPI_Fint *request, MPI_Fint *ierr) {
563563
MPI_Ibarrier_fortran_wrapper(comm, request, ierr);
564+
}
565+
566+
567+
static void MPI_Test_fortran_wrapper(MPI_Fint *request, MPI_Fint *flag, MPI_Fint *status, MPI_Fint *ierr) {
568+
int _wrap_py_return_val = 0;
569+
570+
Tsc const tsc = rdtsc();
571+
572+
#if (!defined(MPICH_HAS_C2F) && defined(MPICH_NAME) && (MPICH_NAME == 1)) /* MPICH test */
573+
_wrap_py_return_val = PMPI_Test((MPI_Request*)request, (int*)flag, (MPI_Status*)status);
574+
#else /* MPI-2 safe call */
575+
MPI_Request temp_request;
576+
MPI_Status temp_status;
577+
temp_request = MPI_Request_f2c(*request);
578+
MPI_Status_f2c(status, &temp_status);
579+
_wrap_py_return_val = PMPI_Test(&temp_request, (int*)flag, &temp_status);
580+
*request = MPI_Request_c2f(temp_request);
581+
MPI_Status_c2f(&temp_status, status);
582+
#endif /* MPICH test */
583+
584+
Tsc const duration = rdtsc() - tsc;
585+
586+
MpiCall const test = {
587+
.kind = Test,
588+
.time = -1.0,
589+
.tsc = tsc,
590+
.duration = duration,
591+
.current_rank = current_rank,
592+
.partner_rank = -1,
593+
.nb_bytes_s = 0,
594+
.nb_bytes_r = 0,
595+
.comm = -1,
596+
.req = *request,
597+
.tag = -1,
598+
.required_thread_lvl = -1,
599+
.provided_thread_lvl = -1,
600+
.op_type = -1,
601+
.finished = (int*)flag != 0 ? true : false,
602+
};
603+
604+
register_mpi_call(test);
605+
606+
*ierr = _wrap_py_return_val;
607+
}
608+
609+
_EXTERN_C_ void MPI_TEST(MPI_Fint *request, MPI_Fint *flag, MPI_Fint *status, MPI_Fint *ierr) {
610+
MPI_Test_fortran_wrapper(request, flag, status, ierr);
611+
}
612+
613+
_EXTERN_C_ void mpi_test(MPI_Fint *request, MPI_Fint *flag, MPI_Fint *status, MPI_Fint *ierr) {
614+
MPI_Test_fortran_wrapper(request, flag, status, ierr);
615+
}
616+
617+
_EXTERN_C_ void mpi_test_(MPI_Fint *request, MPI_Fint *flag, MPI_Fint *status, MPI_Fint *ierr) {
618+
MPI_Test_fortran_wrapper(request, flag, status, ierr);
619+
}
620+
621+
_EXTERN_C_ void mpi_test__(MPI_Fint *request, MPI_Fint *flag, MPI_Fint *status, MPI_Fint *ierr) {
622+
MPI_Test_fortran_wrapper(request, flag, status, ierr);
564623
}

0 commit comments

Comments
 (0)