From e42dfbe4f73d51f21ad27d62a99cc84228e84f8e Mon Sep 17 00:00:00 2001 From: sfilippone Date: Sat, 8 Mar 2025 20:28:14 +0100 Subject: [PATCH] Changes for --enable-serial --- base/comm/psb_cspgather.F90 | 47 ++-- base/comm/psb_dspgather.F90 | 47 ++-- base/comm/psb_ispgather.F90 | 47 ++-- base/comm/psb_lspgather.F90 | 47 ++-- base/comm/psb_sspgather.F90 | 47 ++-- base/comm/psb_zspgather.F90 | 47 ++-- base/modules/Makefile | 2 + base/modules/fakempi.c | 287 ++++++++------------ base/modules/penv/psi_c_collective_mod.F90 | 41 +-- base/modules/penv/psi_d_collective_mod.F90 | 41 +-- base/modules/penv/psi_e_collective_mod.F90 | 41 +-- base/modules/penv/psi_i2_collective_mod.F90 | 41 +-- base/modules/penv/psi_m_collective_mod.F90 | 41 +-- base/modules/penv/psi_penv_mod.F90 | 132 ++++++++- base/modules/penv/psi_s_collective_mod.F90 | 41 +-- base/modules/penv/psi_z_collective_mod.F90 | 41 +-- base/modules/psb_internals.h | 4 +- util/Makefile | 2 +- 18 files changed, 533 insertions(+), 463 deletions(-) diff --git a/base/comm/psb_cspgather.F90 b/base/comm/psb_cspgather.F90 index 9d50ef56..675046bf 100644 --- a/base/comm/psb_cspgather.F90 +++ b/base/comm/psb_cspgather.F90 @@ -48,6 +48,7 @@ subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep use psb_penv_mod use psb_mat_mod use psb_tools_mod + use iso_c_binding #ifdef MPI_MOD use mpi #endif @@ -62,7 +63,7 @@ subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep integer(psb_ipk_), intent(in), optional :: root, dupl logical, intent(in), optional :: keepnum,keeploc - type(psb_c_coo_sparse_mat) :: loc_coo, glob_coo + type(psb_c_coo_sparse_mat), target :: loc_coo, glob_coo integer(psb_ipk_) :: nrg, ncg, nzg, nzl integer(psb_ipk_) :: err_act, dupl_ integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k @@ -156,27 +157,27 @@ subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep enddo ndx = nzbr(me+1) if (root_ == -1) then - call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_c_spk_,& + call mpi_allgatherv((loc_coo%val),ndx,psb_mpi_c_spk_,& & glob_coo%val,nzbr,idisp,& & psb_mpi_c_spk_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_allgatherv(locia,ndx,psb_mpi_lpk_,& + & mpi_allgatherv((locia),ndx,psb_mpi_lpk_,& & glbia,nzbr,idisp,& & psb_mpi_lpk_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_allgatherv(locja,ndx,psb_mpi_lpk_,& + & mpi_allgatherv((locja),ndx,psb_mpi_lpk_,& & glbja,nzbr,idisp,& & psb_mpi_lpk_,icomm,minfo) else - call mpi_gatherv(loc_coo%val,ndx,psb_mpi_c_spk_,& + call mpi_gatherv((loc_coo%val),ndx,psb_mpi_c_spk_,& & glob_coo%val,nzbr,idisp,& & psb_mpi_c_spk_,root_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_gatherv(locia,ndx,psb_mpi_lpk_,& + & mpi_gatherv((locia),ndx,psb_mpi_lpk_,& & glbia,nzbr,idisp,& & psb_mpi_lpk_,root_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_gatherv(locja,ndx,psb_mpi_lpk_,& + & mpi_gatherv((locja),ndx,psb_mpi_lpk_,& & glbja,nzbr,idisp,& & psb_mpi_lpk_,root_,icomm,minfo) @@ -231,6 +232,7 @@ subroutine psb_lcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee use psb_penv_mod use psb_mat_mod use psb_tools_mod + use iso_c_binding #ifdef MPI_MOD use mpi #endif @@ -245,7 +247,7 @@ subroutine psb_lcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee integer(psb_ipk_), intent(in), optional :: root, dupl logical, intent(in), optional :: keepnum,keeploc - type(psb_lc_coo_sparse_mat) :: loc_coo, glob_coo + type(psb_lc_coo_sparse_mat), target :: loc_coo, glob_coo integer(psb_lpk_) :: nrg, ncg, nzg integer(psb_ipk_) :: err_act, dupl_ integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl @@ -337,27 +339,27 @@ subroutine psb_lcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee enddo ndx = nzbr(me+1) if (root_ == -1) then - call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_c_spk_,& + call mpi_allgatherv((loc_coo%val),ndx,psb_mpi_c_spk_,& & glob_coo%val,nzbr,idisp,& & psb_mpi_c_spk_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & mpi_allgatherv((loc_coo%ia),ndx,psb_mpi_lpk_,& & glob_coo%ia,nzbr,idisp,& & psb_mpi_lpk_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & mpi_allgatherv((loc_coo%ja),ndx,psb_mpi_lpk_,& & glob_coo%ja,nzbr,idisp,& & psb_mpi_lpk_,icomm,minfo) else - call mpi_gatherv(loc_coo%val,ndx,psb_mpi_c_spk_,& + call mpi_gatherv((loc_coo%val),ndx,psb_mpi_c_spk_,& & glob_coo%val,nzbr,idisp,& & psb_mpi_c_spk_,root_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_gatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & mpi_gatherv((loc_coo%ia),ndx,psb_mpi_lpk_,& & glob_coo%ia,nzbr,idisp,& & psb_mpi_lpk_,root_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_gatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & mpi_gatherv((loc_coo%ja),ndx,psb_mpi_lpk_,& & glob_coo%ja,nzbr,idisp,& & psb_mpi_lpk_,root_,icomm,minfo) end if @@ -369,7 +371,7 @@ subroutine psb_lcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee call loc_coo%free() ! ! Is the code below safe? For very large cases - ! the indices in glob_coo will overflow. But then, + ! the indices in glob_coo will overflow. But then), ! for very large cases it does not make sense to ! gather the matrix on a single procecss anyway... ! @@ -403,6 +405,7 @@ subroutine psb_lclcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k use psb_penv_mod use psb_mat_mod use psb_tools_mod + use iso_c_binding #ifdef MPI_MOD use mpi #endif @@ -417,7 +420,7 @@ subroutine psb_lclcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k integer(psb_ipk_), intent(in), optional :: root, dupl logical, intent(in), optional :: keepnum,keeploc - type(psb_lc_coo_sparse_mat) :: loc_coo, glob_coo + type(psb_lc_coo_sparse_mat), target :: loc_coo, glob_coo integer(psb_lpk_) :: nrg, ncg, nzg integer(psb_ipk_) :: err_act, dupl_ integer(psb_lpk_) :: ip,naggrm1,naggrp1, i, j, k, nzl @@ -507,27 +510,27 @@ subroutine psb_lclcsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k ndx = nzbr(me+1) if (root_ == -1) then - call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_c_spk_,& + call mpi_allgatherv((loc_coo%val),ndx,psb_mpi_c_spk_,& & glob_coo%val,nzbr,idisp,& & psb_mpi_c_spk_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & mpi_allgatherv((loc_coo%ia),ndx,psb_mpi_lpk_,& & glob_coo%ia,nzbr,idisp,& & psb_mpi_lpk_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & mpi_allgatherv((loc_coo%ja),ndx,psb_mpi_lpk_,& & glob_coo%ja,nzbr,idisp,& & psb_mpi_lpk_,icomm,minfo) else - call mpi_gatherv(loc_coo%val,ndx,psb_mpi_c_spk_,& + call mpi_gatherv((loc_coo%val),ndx,psb_mpi_c_spk_,& & glob_coo%val,nzbr,idisp,& & psb_mpi_c_spk_,root_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_gatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & mpi_gatherv((loc_coo%ia),ndx,psb_mpi_lpk_,& & glob_coo%ia,nzbr,idisp,& & psb_mpi_lpk_,root_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_gatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & mpi_gatherv((loc_coo%ja),ndx,psb_mpi_lpk_,& & glob_coo%ja,nzbr,idisp,& & psb_mpi_lpk_,root_,icomm,minfo) end if diff --git a/base/comm/psb_dspgather.F90 b/base/comm/psb_dspgather.F90 index 13d04d7b..da86790a 100644 --- a/base/comm/psb_dspgather.F90 +++ b/base/comm/psb_dspgather.F90 @@ -48,6 +48,7 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep use psb_penv_mod use psb_mat_mod use psb_tools_mod + use iso_c_binding #ifdef MPI_MOD use mpi #endif @@ -62,7 +63,7 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep integer(psb_ipk_), intent(in), optional :: root, dupl logical, intent(in), optional :: keepnum,keeploc - type(psb_d_coo_sparse_mat) :: loc_coo, glob_coo + type(psb_d_coo_sparse_mat), target :: loc_coo, glob_coo integer(psb_ipk_) :: nrg, ncg, nzg, nzl integer(psb_ipk_) :: err_act, dupl_ integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k @@ -156,27 +157,27 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep enddo ndx = nzbr(me+1) if (root_ == -1) then - call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_r_dpk_,& + call mpi_allgatherv((loc_coo%val),ndx,psb_mpi_r_dpk_,& & glob_coo%val,nzbr,idisp,& & psb_mpi_r_dpk_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_allgatherv(locia,ndx,psb_mpi_lpk_,& + & mpi_allgatherv((locia),ndx,psb_mpi_lpk_,& & glbia,nzbr,idisp,& & psb_mpi_lpk_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_allgatherv(locja,ndx,psb_mpi_lpk_,& + & mpi_allgatherv((locja),ndx,psb_mpi_lpk_,& & glbja,nzbr,idisp,& & psb_mpi_lpk_,icomm,minfo) else - call mpi_gatherv(loc_coo%val,ndx,psb_mpi_r_dpk_,& + call mpi_gatherv((loc_coo%val),ndx,psb_mpi_r_dpk_,& & glob_coo%val,nzbr,idisp,& & psb_mpi_r_dpk_,root_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_gatherv(locia,ndx,psb_mpi_lpk_,& + & mpi_gatherv((locia),ndx,psb_mpi_lpk_,& & glbia,nzbr,idisp,& & psb_mpi_lpk_,root_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_gatherv(locja,ndx,psb_mpi_lpk_,& + & mpi_gatherv((locja),ndx,psb_mpi_lpk_,& & glbja,nzbr,idisp,& & psb_mpi_lpk_,root_,icomm,minfo) @@ -231,6 +232,7 @@ subroutine psb_ldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee use psb_penv_mod use psb_mat_mod use psb_tools_mod + use iso_c_binding #ifdef MPI_MOD use mpi #endif @@ -245,7 +247,7 @@ subroutine psb_ldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee integer(psb_ipk_), intent(in), optional :: root, dupl logical, intent(in), optional :: keepnum,keeploc - type(psb_ld_coo_sparse_mat) :: loc_coo, glob_coo + type(psb_ld_coo_sparse_mat), target :: loc_coo, glob_coo integer(psb_lpk_) :: nrg, ncg, nzg integer(psb_ipk_) :: err_act, dupl_ integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl @@ -337,27 +339,27 @@ subroutine psb_ldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee enddo ndx = nzbr(me+1) if (root_ == -1) then - call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_r_dpk_,& + call mpi_allgatherv((loc_coo%val),ndx,psb_mpi_r_dpk_,& & glob_coo%val,nzbr,idisp,& & psb_mpi_r_dpk_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & mpi_allgatherv((loc_coo%ia),ndx,psb_mpi_lpk_,& & glob_coo%ia,nzbr,idisp,& & psb_mpi_lpk_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & mpi_allgatherv((loc_coo%ja),ndx,psb_mpi_lpk_,& & glob_coo%ja,nzbr,idisp,& & psb_mpi_lpk_,icomm,minfo) else - call mpi_gatherv(loc_coo%val,ndx,psb_mpi_r_dpk_,& + call mpi_gatherv((loc_coo%val),ndx,psb_mpi_r_dpk_,& & glob_coo%val,nzbr,idisp,& & psb_mpi_r_dpk_,root_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_gatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & mpi_gatherv((loc_coo%ia),ndx,psb_mpi_lpk_,& & glob_coo%ia,nzbr,idisp,& & psb_mpi_lpk_,root_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_gatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & mpi_gatherv((loc_coo%ja),ndx,psb_mpi_lpk_,& & glob_coo%ja,nzbr,idisp,& & psb_mpi_lpk_,root_,icomm,minfo) end if @@ -369,7 +371,7 @@ subroutine psb_ldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee call loc_coo%free() ! ! Is the code below safe? For very large cases - ! the indices in glob_coo will overflow. But then, + ! the indices in glob_coo will overflow. But then), ! for very large cases it does not make sense to ! gather the matrix on a single procecss anyway... ! @@ -403,6 +405,7 @@ subroutine psb_ldldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k use psb_penv_mod use psb_mat_mod use psb_tools_mod + use iso_c_binding #ifdef MPI_MOD use mpi #endif @@ -417,7 +420,7 @@ subroutine psb_ldldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k integer(psb_ipk_), intent(in), optional :: root, dupl logical, intent(in), optional :: keepnum,keeploc - type(psb_ld_coo_sparse_mat) :: loc_coo, glob_coo + type(psb_ld_coo_sparse_mat), target :: loc_coo, glob_coo integer(psb_lpk_) :: nrg, ncg, nzg integer(psb_ipk_) :: err_act, dupl_ integer(psb_lpk_) :: ip,naggrm1,naggrp1, i, j, k, nzl @@ -507,27 +510,27 @@ subroutine psb_ldldsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k ndx = nzbr(me+1) if (root_ == -1) then - call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_r_dpk_,& + call mpi_allgatherv((loc_coo%val),ndx,psb_mpi_r_dpk_,& & glob_coo%val,nzbr,idisp,& & psb_mpi_r_dpk_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & mpi_allgatherv((loc_coo%ia),ndx,psb_mpi_lpk_,& & glob_coo%ia,nzbr,idisp,& & psb_mpi_lpk_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & mpi_allgatherv((loc_coo%ja),ndx,psb_mpi_lpk_,& & glob_coo%ja,nzbr,idisp,& & psb_mpi_lpk_,icomm,minfo) else - call mpi_gatherv(loc_coo%val,ndx,psb_mpi_r_dpk_,& + call mpi_gatherv((loc_coo%val),ndx,psb_mpi_r_dpk_,& & glob_coo%val,nzbr,idisp,& & psb_mpi_r_dpk_,root_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_gatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & mpi_gatherv((loc_coo%ia),ndx,psb_mpi_lpk_,& & glob_coo%ia,nzbr,idisp,& & psb_mpi_lpk_,root_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_gatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & mpi_gatherv((loc_coo%ja),ndx,psb_mpi_lpk_,& & glob_coo%ja,nzbr,idisp,& & psb_mpi_lpk_,root_,icomm,minfo) end if diff --git a/base/comm/psb_ispgather.F90 b/base/comm/psb_ispgather.F90 index e45f0f5d..c51519bf 100644 --- a/base/comm/psb_ispgather.F90 +++ b/base/comm/psb_ispgather.F90 @@ -48,6 +48,7 @@ subroutine psb_isp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep use psb_penv_mod use psb_mat_mod use psb_tools_mod + use iso_c_binding #ifdef MPI_MOD use mpi #endif @@ -62,7 +63,7 @@ subroutine psb_isp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep integer(psb_ipk_), intent(in), optional :: root, dupl logical, intent(in), optional :: keepnum,keeploc - type(psb_i_coo_sparse_mat) :: loc_coo, glob_coo + type(psb_i_coo_sparse_mat), target :: loc_coo, glob_coo integer(psb_ipk_) :: nrg, ncg, nzg, nzl integer(psb_ipk_) :: err_act, dupl_ integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k @@ -156,27 +157,27 @@ subroutine psb_isp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep enddo ndx = nzbr(me+1) if (root_ == -1) then - call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_ipk_,& + call mpi_allgatherv((loc_coo%val),ndx,psb_mpi_ipk_,& & glob_coo%val,nzbr,idisp,& & psb_mpi_ipk_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_allgatherv(locia,ndx,psb_mpi_lpk_,& + & mpi_allgatherv((locia),ndx,psb_mpi_lpk_,& & glbia,nzbr,idisp,& & psb_mpi_lpk_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_allgatherv(locja,ndx,psb_mpi_lpk_,& + & mpi_allgatherv((locja),ndx,psb_mpi_lpk_,& & glbja,nzbr,idisp,& & psb_mpi_lpk_,icomm,minfo) else - call mpi_gatherv(loc_coo%val,ndx,psb_mpi_ipk_,& + call mpi_gatherv((loc_coo%val),ndx,psb_mpi_ipk_,& & glob_coo%val,nzbr,idisp,& & psb_mpi_ipk_,root_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_gatherv(locia,ndx,psb_mpi_lpk_,& + & mpi_gatherv((locia),ndx,psb_mpi_lpk_,& & glbia,nzbr,idisp,& & psb_mpi_lpk_,root_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_gatherv(locja,ndx,psb_mpi_lpk_,& + & mpi_gatherv((locja),ndx,psb_mpi_lpk_,& & glbja,nzbr,idisp,& & psb_mpi_lpk_,root_,icomm,minfo) @@ -231,6 +232,7 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k use psb_penv_mod use psb_mat_mod use psb_tools_mod + use iso_c_binding #ifdef MPI_MOD use mpi #endif @@ -245,7 +247,7 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k integer(psb_ipk_), intent(in), optional :: root, dupl logical, intent(in), optional :: keepnum,keeploc - type(psb_@LX@_coo_sparse_mat) :: loc_coo, glob_coo + type(psb_@LX@_coo_sparse_mat), target :: loc_coo, glob_coo integer(psb_lpk_) :: nrg, ncg, nzg integer(psb_ipk_) :: err_act, dupl_ integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl @@ -337,27 +339,27 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k enddo ndx = nzbr(me+1) if (root_ == -1) then - call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_ipk_,& + call mpi_allgatherv((loc_coo%val),ndx,psb_mpi_ipk_,& & glob_coo%val,nzbr,idisp,& & psb_mpi_ipk_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & mpi_allgatherv((loc_coo%ia),ndx,psb_mpi_lpk_,& & glob_coo%ia,nzbr,idisp,& & psb_mpi_lpk_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & mpi_allgatherv((loc_coo%ja),ndx,psb_mpi_lpk_,& & glob_coo%ja,nzbr,idisp,& & psb_mpi_lpk_,icomm,minfo) else - call mpi_gatherv(loc_coo%val,ndx,psb_mpi_ipk_,& + call mpi_gatherv((loc_coo%val),ndx,psb_mpi_ipk_,& & glob_coo%val,nzbr,idisp,& & psb_mpi_ipk_,root_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_gatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & mpi_gatherv((loc_coo%ia),ndx,psb_mpi_lpk_,& & glob_coo%ia,nzbr,idisp,& & psb_mpi_lpk_,root_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_gatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & mpi_gatherv((loc_coo%ja),ndx,psb_mpi_lpk_,& & glob_coo%ja,nzbr,idisp,& & psb_mpi_lpk_,root_,icomm,minfo) end if @@ -369,7 +371,7 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k call loc_coo%free() ! ! Is the code below safe? For very large cases - ! the indices in glob_coo will overflow. But then, + ! the indices in glob_coo will overflow. But then), ! for very large cases it does not make sense to ! gather the matrix on a single procecss anyway... ! @@ -403,6 +405,7 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn use psb_penv_mod use psb_mat_mod use psb_tools_mod + use iso_c_binding #ifdef MPI_MOD use mpi #endif @@ -417,7 +420,7 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn integer(psb_ipk_), intent(in), optional :: root, dupl logical, intent(in), optional :: keepnum,keeploc - type(psb_@LX@_coo_sparse_mat) :: loc_coo, glob_coo + type(psb_@LX@_coo_sparse_mat), target :: loc_coo, glob_coo integer(psb_lpk_) :: nrg, ncg, nzg integer(psb_ipk_) :: err_act, dupl_ integer(psb_lpk_) :: ip,naggrm1,naggrp1, i, j, k, nzl @@ -507,27 +510,27 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn ndx = nzbr(me+1) if (root_ == -1) then - call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_ipk_,& + call mpi_allgatherv((loc_coo%val),ndx,psb_mpi_ipk_,& & glob_coo%val,nzbr,idisp,& & psb_mpi_ipk_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & mpi_allgatherv((loc_coo%ia),ndx,psb_mpi_lpk_,& & glob_coo%ia,nzbr,idisp,& & psb_mpi_lpk_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & mpi_allgatherv((loc_coo%ja),ndx,psb_mpi_lpk_,& & glob_coo%ja,nzbr,idisp,& & psb_mpi_lpk_,icomm,minfo) else - call mpi_gatherv(loc_coo%val,ndx,psb_mpi_ipk_,& + call mpi_gatherv((loc_coo%val),ndx,psb_mpi_ipk_,& & glob_coo%val,nzbr,idisp,& & psb_mpi_ipk_,root_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_gatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & mpi_gatherv((loc_coo%ia),ndx,psb_mpi_lpk_,& & glob_coo%ia,nzbr,idisp,& & psb_mpi_lpk_,root_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_gatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & mpi_gatherv((loc_coo%ja),ndx,psb_mpi_lpk_,& & glob_coo%ja,nzbr,idisp,& & psb_mpi_lpk_,root_,icomm,minfo) end if diff --git a/base/comm/psb_lspgather.F90 b/base/comm/psb_lspgather.F90 index aa7b8fcc..a072811d 100644 --- a/base/comm/psb_lspgather.F90 +++ b/base/comm/psb_lspgather.F90 @@ -48,6 +48,7 @@ subroutine psb_lsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep use psb_penv_mod use psb_mat_mod use psb_tools_mod + use iso_c_binding #ifdef MPI_MOD use mpi #endif @@ -62,7 +63,7 @@ subroutine psb_lsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep integer(psb_ipk_), intent(in), optional :: root, dupl logical, intent(in), optional :: keepnum,keeploc - type(psb_l_coo_sparse_mat) :: loc_coo, glob_coo + type(psb_l_coo_sparse_mat), target :: loc_coo, glob_coo integer(psb_ipk_) :: nrg, ncg, nzg, nzl integer(psb_ipk_) :: err_act, dupl_ integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k @@ -156,27 +157,27 @@ subroutine psb_lsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep enddo ndx = nzbr(me+1) if (root_ == -1) then - call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_lpk_,& + call mpi_allgatherv((loc_coo%val),ndx,psb_mpi_lpk_,& & glob_coo%val,nzbr,idisp,& & psb_mpi_lpk_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_allgatherv(locia,ndx,psb_mpi_lpk_,& + & mpi_allgatherv((locia),ndx,psb_mpi_lpk_,& & glbia,nzbr,idisp,& & psb_mpi_lpk_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_allgatherv(locja,ndx,psb_mpi_lpk_,& + & mpi_allgatherv((locja),ndx,psb_mpi_lpk_,& & glbja,nzbr,idisp,& & psb_mpi_lpk_,icomm,minfo) else - call mpi_gatherv(loc_coo%val,ndx,psb_mpi_lpk_,& + call mpi_gatherv((loc_coo%val),ndx,psb_mpi_lpk_,& & glob_coo%val,nzbr,idisp,& & psb_mpi_lpk_,root_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_gatherv(locia,ndx,psb_mpi_lpk_,& + & mpi_gatherv((locia),ndx,psb_mpi_lpk_,& & glbia,nzbr,idisp,& & psb_mpi_lpk_,root_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_gatherv(locja,ndx,psb_mpi_lpk_,& + & mpi_gatherv((locja),ndx,psb_mpi_lpk_,& & glbja,nzbr,idisp,& & psb_mpi_lpk_,root_,icomm,minfo) @@ -231,6 +232,7 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k use psb_penv_mod use psb_mat_mod use psb_tools_mod + use iso_c_binding #ifdef MPI_MOD use mpi #endif @@ -245,7 +247,7 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k integer(psb_ipk_), intent(in), optional :: root, dupl logical, intent(in), optional :: keepnum,keeploc - type(psb_@LX@_coo_sparse_mat) :: loc_coo, glob_coo + type(psb_@LX@_coo_sparse_mat), target :: loc_coo, glob_coo integer(psb_lpk_) :: nrg, ncg, nzg integer(psb_ipk_) :: err_act, dupl_ integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl @@ -337,27 +339,27 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k enddo ndx = nzbr(me+1) if (root_ == -1) then - call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_lpk_,& + call mpi_allgatherv((loc_coo%val),ndx,psb_mpi_lpk_,& & glob_coo%val,nzbr,idisp,& & psb_mpi_lpk_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & mpi_allgatherv((loc_coo%ia),ndx,psb_mpi_lpk_,& & glob_coo%ia,nzbr,idisp,& & psb_mpi_lpk_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & mpi_allgatherv((loc_coo%ja),ndx,psb_mpi_lpk_,& & glob_coo%ja,nzbr,idisp,& & psb_mpi_lpk_,icomm,minfo) else - call mpi_gatherv(loc_coo%val,ndx,psb_mpi_lpk_,& + call mpi_gatherv((loc_coo%val),ndx,psb_mpi_lpk_,& & glob_coo%val,nzbr,idisp,& & psb_mpi_lpk_,root_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_gatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & mpi_gatherv((loc_coo%ia),ndx,psb_mpi_lpk_,& & glob_coo%ia,nzbr,idisp,& & psb_mpi_lpk_,root_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_gatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & mpi_gatherv((loc_coo%ja),ndx,psb_mpi_lpk_,& & glob_coo%ja,nzbr,idisp,& & psb_mpi_lpk_,root_,icomm,minfo) end if @@ -369,7 +371,7 @@ subroutine psb_@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k call loc_coo%free() ! ! Is the code below safe? For very large cases - ! the indices in glob_coo will overflow. But then, + ! the indices in glob_coo will overflow. But then), ! for very large cases it does not make sense to ! gather the matrix on a single procecss anyway... ! @@ -403,6 +405,7 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn use psb_penv_mod use psb_mat_mod use psb_tools_mod + use iso_c_binding #ifdef MPI_MOD use mpi #endif @@ -417,7 +420,7 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn integer(psb_ipk_), intent(in), optional :: root, dupl logical, intent(in), optional :: keepnum,keeploc - type(psb_@LX@_coo_sparse_mat) :: loc_coo, glob_coo + type(psb_@LX@_coo_sparse_mat), target :: loc_coo, glob_coo integer(psb_lpk_) :: nrg, ncg, nzg integer(psb_ipk_) :: err_act, dupl_ integer(psb_lpk_) :: ip,naggrm1,naggrp1, i, j, k, nzl @@ -507,27 +510,27 @@ subroutine psb_@LX@@LX@sp_allgather(globa, loca, desc_a, info, root, dupl,keepn ndx = nzbr(me+1) if (root_ == -1) then - call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_lpk_,& + call mpi_allgatherv((loc_coo%val),ndx,psb_mpi_lpk_,& & glob_coo%val,nzbr,idisp,& & psb_mpi_lpk_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & mpi_allgatherv((loc_coo%ia),ndx,psb_mpi_lpk_,& & glob_coo%ia,nzbr,idisp,& & psb_mpi_lpk_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & mpi_allgatherv((loc_coo%ja),ndx,psb_mpi_lpk_,& & glob_coo%ja,nzbr,idisp,& & psb_mpi_lpk_,icomm,minfo) else - call mpi_gatherv(loc_coo%val,ndx,psb_mpi_lpk_,& + call mpi_gatherv((loc_coo%val),ndx,psb_mpi_lpk_,& & glob_coo%val,nzbr,idisp,& & psb_mpi_lpk_,root_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_gatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & mpi_gatherv((loc_coo%ia),ndx,psb_mpi_lpk_,& & glob_coo%ia,nzbr,idisp,& & psb_mpi_lpk_,root_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_gatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & mpi_gatherv((loc_coo%ja),ndx,psb_mpi_lpk_,& & glob_coo%ja,nzbr,idisp,& & psb_mpi_lpk_,root_,icomm,minfo) end if diff --git a/base/comm/psb_sspgather.F90 b/base/comm/psb_sspgather.F90 index 5678b676..79ade9c1 100644 --- a/base/comm/psb_sspgather.F90 +++ b/base/comm/psb_sspgather.F90 @@ -48,6 +48,7 @@ subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep use psb_penv_mod use psb_mat_mod use psb_tools_mod + use iso_c_binding #ifdef MPI_MOD use mpi #endif @@ -62,7 +63,7 @@ subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep integer(psb_ipk_), intent(in), optional :: root, dupl logical, intent(in), optional :: keepnum,keeploc - type(psb_s_coo_sparse_mat) :: loc_coo, glob_coo + type(psb_s_coo_sparse_mat), target :: loc_coo, glob_coo integer(psb_ipk_) :: nrg, ncg, nzg, nzl integer(psb_ipk_) :: err_act, dupl_ integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k @@ -156,27 +157,27 @@ subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep enddo ndx = nzbr(me+1) if (root_ == -1) then - call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_r_spk_,& + call mpi_allgatherv((loc_coo%val),ndx,psb_mpi_r_spk_,& & glob_coo%val,nzbr,idisp,& & psb_mpi_r_spk_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_allgatherv(locia,ndx,psb_mpi_lpk_,& + & mpi_allgatherv((locia),ndx,psb_mpi_lpk_,& & glbia,nzbr,idisp,& & psb_mpi_lpk_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_allgatherv(locja,ndx,psb_mpi_lpk_,& + & mpi_allgatherv((locja),ndx,psb_mpi_lpk_,& & glbja,nzbr,idisp,& & psb_mpi_lpk_,icomm,minfo) else - call mpi_gatherv(loc_coo%val,ndx,psb_mpi_r_spk_,& + call mpi_gatherv((loc_coo%val),ndx,psb_mpi_r_spk_,& & glob_coo%val,nzbr,idisp,& & psb_mpi_r_spk_,root_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_gatherv(locia,ndx,psb_mpi_lpk_,& + & mpi_gatherv((locia),ndx,psb_mpi_lpk_,& & glbia,nzbr,idisp,& & psb_mpi_lpk_,root_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_gatherv(locja,ndx,psb_mpi_lpk_,& + & mpi_gatherv((locja),ndx,psb_mpi_lpk_,& & glbja,nzbr,idisp,& & psb_mpi_lpk_,root_,icomm,minfo) @@ -231,6 +232,7 @@ subroutine psb_lssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee use psb_penv_mod use psb_mat_mod use psb_tools_mod + use iso_c_binding #ifdef MPI_MOD use mpi #endif @@ -245,7 +247,7 @@ subroutine psb_lssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee integer(psb_ipk_), intent(in), optional :: root, dupl logical, intent(in), optional :: keepnum,keeploc - type(psb_ls_coo_sparse_mat) :: loc_coo, glob_coo + type(psb_ls_coo_sparse_mat), target :: loc_coo, glob_coo integer(psb_lpk_) :: nrg, ncg, nzg integer(psb_ipk_) :: err_act, dupl_ integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl @@ -337,27 +339,27 @@ subroutine psb_lssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee enddo ndx = nzbr(me+1) if (root_ == -1) then - call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_r_spk_,& + call mpi_allgatherv((loc_coo%val),ndx,psb_mpi_r_spk_,& & glob_coo%val,nzbr,idisp,& & psb_mpi_r_spk_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & mpi_allgatherv((loc_coo%ia),ndx,psb_mpi_lpk_,& & glob_coo%ia,nzbr,idisp,& & psb_mpi_lpk_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & mpi_allgatherv((loc_coo%ja),ndx,psb_mpi_lpk_,& & glob_coo%ja,nzbr,idisp,& & psb_mpi_lpk_,icomm,minfo) else - call mpi_gatherv(loc_coo%val,ndx,psb_mpi_r_spk_,& + call mpi_gatherv((loc_coo%val),ndx,psb_mpi_r_spk_,& & glob_coo%val,nzbr,idisp,& & psb_mpi_r_spk_,root_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_gatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & mpi_gatherv((loc_coo%ia),ndx,psb_mpi_lpk_,& & glob_coo%ia,nzbr,idisp,& & psb_mpi_lpk_,root_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_gatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & mpi_gatherv((loc_coo%ja),ndx,psb_mpi_lpk_,& & glob_coo%ja,nzbr,idisp,& & psb_mpi_lpk_,root_,icomm,minfo) end if @@ -369,7 +371,7 @@ subroutine psb_lssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee call loc_coo%free() ! ! Is the code below safe? For very large cases - ! the indices in glob_coo will overflow. But then, + ! the indices in glob_coo will overflow. But then), ! for very large cases it does not make sense to ! gather the matrix on a single procecss anyway... ! @@ -403,6 +405,7 @@ subroutine psb_lslssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k use psb_penv_mod use psb_mat_mod use psb_tools_mod + use iso_c_binding #ifdef MPI_MOD use mpi #endif @@ -417,7 +420,7 @@ subroutine psb_lslssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k integer(psb_ipk_), intent(in), optional :: root, dupl logical, intent(in), optional :: keepnum,keeploc - type(psb_ls_coo_sparse_mat) :: loc_coo, glob_coo + type(psb_ls_coo_sparse_mat), target :: loc_coo, glob_coo integer(psb_lpk_) :: nrg, ncg, nzg integer(psb_ipk_) :: err_act, dupl_ integer(psb_lpk_) :: ip,naggrm1,naggrp1, i, j, k, nzl @@ -507,27 +510,27 @@ subroutine psb_lslssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k ndx = nzbr(me+1) if (root_ == -1) then - call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_r_spk_,& + call mpi_allgatherv((loc_coo%val),ndx,psb_mpi_r_spk_,& & glob_coo%val,nzbr,idisp,& & psb_mpi_r_spk_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & mpi_allgatherv((loc_coo%ia),ndx,psb_mpi_lpk_,& & glob_coo%ia,nzbr,idisp,& & psb_mpi_lpk_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & mpi_allgatherv((loc_coo%ja),ndx,psb_mpi_lpk_,& & glob_coo%ja,nzbr,idisp,& & psb_mpi_lpk_,icomm,minfo) else - call mpi_gatherv(loc_coo%val,ndx,psb_mpi_r_spk_,& + call mpi_gatherv((loc_coo%val),ndx,psb_mpi_r_spk_,& & glob_coo%val,nzbr,idisp,& & psb_mpi_r_spk_,root_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_gatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & mpi_gatherv((loc_coo%ia),ndx,psb_mpi_lpk_,& & glob_coo%ia,nzbr,idisp,& & psb_mpi_lpk_,root_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_gatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & mpi_gatherv((loc_coo%ja),ndx,psb_mpi_lpk_,& & glob_coo%ja,nzbr,idisp,& & psb_mpi_lpk_,root_,icomm,minfo) end if diff --git a/base/comm/psb_zspgather.F90 b/base/comm/psb_zspgather.F90 index 6b59caa8..2190b5cc 100644 --- a/base/comm/psb_zspgather.F90 +++ b/base/comm/psb_zspgather.F90 @@ -48,6 +48,7 @@ subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep use psb_penv_mod use psb_mat_mod use psb_tools_mod + use iso_c_binding #ifdef MPI_MOD use mpi #endif @@ -62,7 +63,7 @@ subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep integer(psb_ipk_), intent(in), optional :: root, dupl logical, intent(in), optional :: keepnum,keeploc - type(psb_z_coo_sparse_mat) :: loc_coo, glob_coo + type(psb_z_coo_sparse_mat), target :: loc_coo, glob_coo integer(psb_ipk_) :: nrg, ncg, nzg, nzl integer(psb_ipk_) :: err_act, dupl_ integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k @@ -156,27 +157,27 @@ subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep enddo ndx = nzbr(me+1) if (root_ == -1) then - call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_c_dpk_,& + call mpi_allgatherv((loc_coo%val),ndx,psb_mpi_c_dpk_,& & glob_coo%val,nzbr,idisp,& & psb_mpi_c_dpk_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_allgatherv(locia,ndx,psb_mpi_lpk_,& + & mpi_allgatherv((locia),ndx,psb_mpi_lpk_,& & glbia,nzbr,idisp,& & psb_mpi_lpk_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_allgatherv(locja,ndx,psb_mpi_lpk_,& + & mpi_allgatherv((locja),ndx,psb_mpi_lpk_,& & glbja,nzbr,idisp,& & psb_mpi_lpk_,icomm,minfo) else - call mpi_gatherv(loc_coo%val,ndx,psb_mpi_c_dpk_,& + call mpi_gatherv((loc_coo%val),ndx,psb_mpi_c_dpk_,& & glob_coo%val,nzbr,idisp,& & psb_mpi_c_dpk_,root_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_gatherv(locia,ndx,psb_mpi_lpk_,& + & mpi_gatherv((locia),ndx,psb_mpi_lpk_,& & glbia,nzbr,idisp,& & psb_mpi_lpk_,root_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_gatherv(locja,ndx,psb_mpi_lpk_,& + & mpi_gatherv((locja),ndx,psb_mpi_lpk_,& & glbja,nzbr,idisp,& & psb_mpi_lpk_,root_,icomm,minfo) @@ -231,6 +232,7 @@ subroutine psb_lzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee use psb_penv_mod use psb_mat_mod use psb_tools_mod + use iso_c_binding #ifdef MPI_MOD use mpi #endif @@ -245,7 +247,7 @@ subroutine psb_lzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee integer(psb_ipk_), intent(in), optional :: root, dupl logical, intent(in), optional :: keepnum,keeploc - type(psb_lz_coo_sparse_mat) :: loc_coo, glob_coo + type(psb_lz_coo_sparse_mat), target :: loc_coo, glob_coo integer(psb_lpk_) :: nrg, ncg, nzg integer(psb_ipk_) :: err_act, dupl_ integer(psb_ipk_) :: ip,naggrm1,naggrp1, i, j, k, nzl @@ -337,27 +339,27 @@ subroutine psb_lzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee enddo ndx = nzbr(me+1) if (root_ == -1) then - call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_c_dpk_,& + call mpi_allgatherv((loc_coo%val),ndx,psb_mpi_c_dpk_,& & glob_coo%val,nzbr,idisp,& & psb_mpi_c_dpk_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & mpi_allgatherv((loc_coo%ia),ndx,psb_mpi_lpk_,& & glob_coo%ia,nzbr,idisp,& & psb_mpi_lpk_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & mpi_allgatherv((loc_coo%ja),ndx,psb_mpi_lpk_,& & glob_coo%ja,nzbr,idisp,& & psb_mpi_lpk_,icomm,minfo) else - call mpi_gatherv(loc_coo%val,ndx,psb_mpi_c_dpk_,& + call mpi_gatherv((loc_coo%val),ndx,psb_mpi_c_dpk_,& & glob_coo%val,nzbr,idisp,& & psb_mpi_c_dpk_,root_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_gatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & mpi_gatherv((loc_coo%ia),ndx,psb_mpi_lpk_,& & glob_coo%ia,nzbr,idisp,& & psb_mpi_lpk_,root_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_gatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & mpi_gatherv((loc_coo%ja),ndx,psb_mpi_lpk_,& & glob_coo%ja,nzbr,idisp,& & psb_mpi_lpk_,root_,icomm,minfo) end if @@ -369,7 +371,7 @@ subroutine psb_lzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,kee call loc_coo%free() ! ! Is the code below safe? For very large cases - ! the indices in glob_coo will overflow. But then, + ! the indices in glob_coo will overflow. But then), ! for very large cases it does not make sense to ! gather the matrix on a single procecss anyway... ! @@ -403,6 +405,7 @@ subroutine psb_lzlzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k use psb_penv_mod use psb_mat_mod use psb_tools_mod + use iso_c_binding #ifdef MPI_MOD use mpi #endif @@ -417,7 +420,7 @@ subroutine psb_lzlzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k integer(psb_ipk_), intent(in), optional :: root, dupl logical, intent(in), optional :: keepnum,keeploc - type(psb_lz_coo_sparse_mat) :: loc_coo, glob_coo + type(psb_lz_coo_sparse_mat), target :: loc_coo, glob_coo integer(psb_lpk_) :: nrg, ncg, nzg integer(psb_ipk_) :: err_act, dupl_ integer(psb_lpk_) :: ip,naggrm1,naggrp1, i, j, k, nzl @@ -507,27 +510,27 @@ subroutine psb_lzlzsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,k ndx = nzbr(me+1) if (root_ == -1) then - call mpi_allgatherv(loc_coo%val,ndx,psb_mpi_c_dpk_,& + call mpi_allgatherv((loc_coo%val),ndx,psb_mpi_c_dpk_,& & glob_coo%val,nzbr,idisp,& & psb_mpi_c_dpk_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & mpi_allgatherv((loc_coo%ia),ndx,psb_mpi_lpk_,& & glob_coo%ia,nzbr,idisp,& & psb_mpi_lpk_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_allgatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & mpi_allgatherv((loc_coo%ja),ndx,psb_mpi_lpk_,& & glob_coo%ja,nzbr,idisp,& & psb_mpi_lpk_,icomm,minfo) else - call mpi_gatherv(loc_coo%val,ndx,psb_mpi_c_dpk_,& + call mpi_gatherv((loc_coo%val),ndx,psb_mpi_c_dpk_,& & glob_coo%val,nzbr,idisp,& & psb_mpi_c_dpk_,root_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_gatherv(loc_coo%ia,ndx,psb_mpi_lpk_,& + & mpi_gatherv((loc_coo%ia),ndx,psb_mpi_lpk_,& & glob_coo%ia,nzbr,idisp,& & psb_mpi_lpk_,root_,icomm,minfo) if (minfo == psb_success_) call & - & mpi_gatherv(loc_coo%ja,ndx,psb_mpi_lpk_,& + & mpi_gatherv((loc_coo%ja),ndx,psb_mpi_lpk_,& & glob_coo%ja,nzbr,idisp,& & psb_mpi_lpk_,root_,icomm,minfo) end if diff --git a/base/modules/Makefile b/base/modules/Makefile index b0dd8660..ed2b34c8 100644 --- a/base/modules/Makefile +++ b/base/modules/Makefile @@ -116,6 +116,7 @@ UTIL_MODS = desc/psb_desc_const_mod.o desc/psb_indx_map_mod.o\ MODULES=$(BASIC_MODS) $(SERIAL_MODS) $(UTIL_MODS) OBJS = error.o psb_base_mod.o $(EXTRA_COBJS) cutil.o MODDIR=../../modules +INCDIR=../../include LIBDIR=../ CINCLUDES=-I. FINCLUDES=$(FMFLAG)$(LIBDIR) $(FMFLAG). $(FIFLAG). @@ -123,6 +124,7 @@ FINCLUDES=$(FMFLAG)$(LIBDIR) $(FMFLAG). $(FIFLAG). objs: $(MODULES) $(OBJS) $(MPFOBJS) /bin/cp -p $(CPUPDFLAG) *$(.mod) $(MODDIR) + /bin/cp -p $(CPUPDFLAG) *.h $(INCDIR) lib: objs $(LIBDIR)/$(LIBNAME) diff --git a/base/modules/fakempi.c b/base/modules/fakempi.c index 7d56938f..290815db 100644 --- a/base/modules/fakempi.c +++ b/base/modules/fakempi.c @@ -3,105 +3,6 @@ #include #include "psb_internals.h" - -#ifdef LowerUnderscore -#define mpi_wtime mpi_wtime_ -#define mpi_send mpi_send_ -#define mpi_isend mpi_isend_ -#define mpi_irecv mpi_irecv_ -#define mpi_wait mpi_wait_ -#define mpi_alltoall mpi_alltoall_ -#define mpi_alltoallv mpi_alltoallv_ -#define mpi_gather mpi_gather_ -#define mpi_gatherv mpi_gatherv_ -#define mpi_allgather mpi_allgather_ -#define mpi_allgatherv mpi_allgatherv_ -#define mpi_scatterv mpi_scatterv_ -#define mpi_scatter mpi_scatter_ -#endif -#ifdef LowerDoubleUnderscore -#define mpi_wtime mpi_wtime__ -#define mpi_send mpi_send__ -#define mpi_isend mpi_isend__ -#define mpi_irecv mpi_irecv__ -#define mpi_wait mpi_wait__ -#define mpi_alltoall mpi_alltoall__ -#define mpi_alltoallv mpi_alltoallv__ -#define mpi_gather mpi_gather__ -#define mpi_gatherv mpi_gatherv__ -#define mpi_allgather mpi_allgather__ -#define mpi_allgatherv mpi_allgatherv__ -#define mpi_scatterv mpi_scatterv__ -#define mpi_scatter mpi_scatter__ -#endif -#ifdef LowerCase -#define mpi_wtime mpi_wtime -#define mpi_send mpi_send -#define mpi_isend mpi_isend -#define mpi_irecv mpi_irecv -#define mpi_wait mpi_wait -#define mpi_alltoall mpi_alltoall -#define mpi_alltoallv mpi_alltoallv -#define mpi_gather mpi_gather -#define mpi_gatherv mpi_gatherv -#define mpi_allgather mpi_allgather -#define mpi_allgatherv mpi_allgatherv -#define mpi_scatterv mpi_scatterv -#define mpi_scatter mpi_scatter -#endif -#ifdef UpperUnderscore -#define mpi_wtime MPI_WTIME_ -#define mpi_send MPI_SEND_ -#define mpi_isend MPI_ISEND_ -#define mpi_irecv MPI_IRECV_ -#define mpi_wait MPI_WAIT_ -#define mpi_alltoall MPI_ALLTOALL_ -#define mpi_alltoallv MPI_ALLTOALLV_ -#define mpi_gather MPI_GATHER_ -#define mpi_gatherv MPI_GATHERV_ -#define mpi_allgather MPI_ALLGATHER_ -#define mpi_allgatherv MPI_ALLGATHERV_ -#define mpi_scatterv MPI_SCATTERV_ -#define mpi_scatter MPI_SCATTER_ -#endif -#ifdef UpperDoubleUnderscore -#define mpi_wtime MPI_WTIME__ -#define mpi_send MPI_SEND__ -#define mpi_isend MPI_ISEND__ -#define mpi_irecv MPI_IRECV__ -#define mpi_wait MPI_WAIT__ -#define mpi_alltoall MPI_ALLTOALL__ -#define mpi_alltoallv MPI_ALLTOALLV__ -#define mpi_gather MPI_GATHER__ -#define mpi_gatherv MPI_GATHERV__ -#define mpi_allgather MPI_ALLGATHER__ -#define mpi_allgatherv MPI_ALLGATHERV__ -#define mpi_scatterv MPI_SCATTERV__ -#define mpi_scatter MPI_SCATTER__ -#endif -#ifdef UpperCase -#define mpi_wtime MPI_WTIME -#define mpi_send MPI_SEND -#define mpi_isend MPI_ISEND -#define mpi_irecv MPI_IRECV -#define mpi_wait MPI_WAIT -#define mpi_alltoall MPI_ALLTOALL -#define mpi_alltoallv MPI_ALLTOALLV -#define mpi_gather MPI_GATHER -#define mpi_gatherv MPI_GATHERV -#define mpi_allgather MPI_ALLGATHER -#define mpi_allgatherv MPI_ALLGATHERV -#define mpi_scatterv MPI_SCATTERV -#define mpi_scatter MPI_SCATTER -#endif - -#define mpi_integer 1 -#define mpi_integer8 2 -#define mpi_real 3 -#define mpi_double 4 -#define mpi_complex 5 -#define mpi_double_complex 6 - double mpi_wtime() { struct timeval tt; @@ -150,22 +51,28 @@ void mpi_alltoall(void* sdb, int* sdc, int* sdt, { int i,j,k; - if (*sdt == mpi_integer) { - memcpy(rvb,sdb, (*sdc)*sizeof(int)); + if ((*sdt == MPI_INTEGER)||(*sdt == MPI_INTEGER4)||(*sdt == MPI_LOGICAL)) { + memcpy(rvb,sdb, (*sdc)*sizeof(int32_t)); + } + if (*sdt == MPI_CHARACTER) { + memcpy(rvb,sdb, (*sdc)*sizeof(char)); + } + if (*sdt == MPI_INTEGER8) { + memcpy(rvb,sdb, (*sdc)*sizeof(int64_t)); } - if (*sdt == mpi_integer8) { - memcpy(rvb,sdb, (*sdc)*sizeof(long long)); + if (*sdt == MPI_INTEGER2) { + memcpy(rvb,sdb, (*sdc)*sizeof(int16_t)); } - if (*sdt == mpi_real) { + if (*sdt == MPI_REAL) { memcpy(rvb,sdb, (*sdc)*sizeof(float)); } - if (*sdt == mpi_double) { + if (*sdt == MPI_DOUBLE) { memcpy(rvb,sdb, (*sdc)*sizeof(double)); } - if (*sdt == mpi_complex) { + if (*sdt == MPI_COMPLEX) { memcpy(rvb,sdb, (*sdc)*2*sizeof(float)); } - if (*sdt == mpi_double_complex) { + if (*sdt == MPI_DOUBLE_COMPLEX) { memcpy(rvb,sdb, (*sdc)*2*sizeof(double)); } *ierr = 0; @@ -177,27 +84,31 @@ void mpi_alltoallv(void* sdb, int* sdc, int* sdspl, int* sdt, int i,j,k; - if (*sdt == mpi_integer) { - memcpy((void *)((char *)rvb+rdspl[0]*sizeof(int)), - (void *)((char *)sdb+sdspl[0]*sizeof(int)),(*sdc)*sizeof(int)); + if ((*sdt == MPI_INTEGER)||(*sdt == MPI_INTEGER4)||(*sdt == MPI_LOGICAL)) { + memcpy((void *)((char *)rvb+rdspl[0]*sizeof(int32_t)), + (void *)((char *)sdb+sdspl[0]*sizeof(int32_t)),(*sdc)*sizeof(int32_t)); } - if (*sdt == mpi_integer8) { - memcpy((void *)((char *)rvb+rdspl[0]*sizeof(long long)), - (void *)((char *)sdb+sdspl[0]*sizeof(long long)),(*sdc)*sizeof(long long)); + if (*sdt == MPI_CHARACTER) { + memcpy((void *)((char *)rvb+rdspl[0]*sizeof(char)), + (void *)((char *)sdb+sdspl[0]*sizeof(char)),(*sdc)*sizeof(char)); } - if (*sdt == mpi_real) { + if (*sdt == MPI_INTEGER8) { + memcpy((void *)((char *)rvb+rdspl[0]*sizeof(int64_t)), + (void *)((char *)sdb+sdspl[0]*sizeof(int64_t)),(*sdc)*sizeof(int64_t)); + } + if (*sdt == MPI_REAL) { memcpy((void *)((char *)rvb+rdspl[0]*sizeof(float)), (void *)((char *)sdb+sdspl[0]*sizeof(float)),(*sdc)*sizeof(float)); } - if (*sdt == mpi_double) { + if (*sdt == MPI_DOUBLE) { memcpy((void *)((char *)rvb+rdspl[0]*sizeof(double)), (void *)((char *)sdb+sdspl[0]*sizeof(double)),(*sdc)*sizeof(double)); } - if (*sdt == mpi_complex) { + if (*sdt == MPI_COMPLEX) { memcpy((void *)((char *)rvb+rdspl[0]*2*sizeof(float)), (void *)((char *)sdb+sdspl[0]*2*sizeof(float)),(*sdc)*2*sizeof(float)); } - if (*sdt == mpi_double_complex) { + if (*sdt == MPI_DOUBLE_COMPLEX) { memcpy((void *)((char *)rvb+rdspl[0]*2*sizeof(double)), (void *)((char *)sdb+sdspl[0]*2*sizeof(double)),(*sdc)*2*sizeof(double)); } @@ -210,22 +121,25 @@ void mpi_gather(void* sdb, int* sdc, int* sdt, { int i,j,k; - if (*sdt == mpi_integer) { - memcpy(rvb,sdb, (*sdc)*sizeof(int)); + if ((*sdt == MPI_INTEGER)||(*sdt == MPI_INTEGER4)||(*sdt == MPI_LOGICAL)) { + memcpy(rvb,sdb, (*sdc)*sizeof(int32_t)); + } + if (*sdt == MPI_INTEGER8) { + memcpy(rvb,sdb, (*sdc)*sizeof(int64_t)); } - if (*sdt == mpi_integer8) { - memcpy(rvb,sdb, (*sdc)*sizeof(long long)); + if (*sdt == MPI_CHARACTER) { + memcpy(rvb,sdb, (*sdc)*sizeof(char)); } - if (*sdt == mpi_real) { + if (*sdt == MPI_REAL) { memcpy(rvb,sdb, (*sdc)*sizeof(float)); } - if (*sdt == mpi_double) { + if (*sdt == MPI_DOUBLE) { memcpy(rvb,sdb, (*sdc)*sizeof(double)); } - if (*sdt == mpi_complex) { + if (*sdt == MPI_COMPLEX) { memcpy(rvb,sdb, (*sdc)*2*sizeof(float)); } - if (*sdt == mpi_double_complex) { + if (*sdt == MPI_DOUBLE_COMPLEX) { memcpy(rvb,sdb, (*sdc)*2*sizeof(double)); } *ierr = 0; @@ -238,27 +152,31 @@ void mpi_gatherv(void* sdb, int* sdc, int* sdt, { int i,j,k; - if (*sdt == mpi_integer) { - memcpy((void *)((char *)rvb+rdspl[0]*sizeof(int)), - (void *)((char *)sdb),(*sdc)*sizeof(int)); + if ((*sdt == MPI_INTEGER)||(*sdt == MPI_INTEGER4)||(*sdt == MPI_LOGICAL)) { + memcpy((void *)((char *)rvb+rdspl[0]*sizeof(int32_t)), + (void *)((char *)sdb),(*sdc)*sizeof(int32_t)); } - if (*sdt == mpi_integer8) { - memcpy((void *)((char *)rvb+rdspl[0]*sizeof(long long)), - (void *)((char *)sdb),(*sdc)*sizeof(long long)); + if (*sdt == MPI_INTEGER8) { + memcpy((void *)((char *)rvb+rdspl[0]*sizeof(int64_t)), + (void *)((char *)sdb),(*sdc)*sizeof(int64_t)); } - if (*sdt == mpi_real) { + if (*sdt == MPI_CHARACTER) { + memcpy((void *)((char *)rvb+rdspl[0]*sizeof(char)), + (void *)((char *)sdb),(*sdc)*sizeof(char)); + } + if (*sdt == MPI_REAL) { memcpy((void *)((char *)rvb+rdspl[0]*sizeof(float)), (void *)((char *)sdb),(*sdc)*sizeof(float)); } - if (*sdt == mpi_double) { + if (*sdt == MPI_DOUBLE) { memcpy((void *)((char *)rvb+rdspl[0]*sizeof(double)), (void *)((char *)sdb),(*sdc)*sizeof(double)); } - if (*sdt == mpi_complex) { + if (*sdt == MPI_COMPLEX) { memcpy((void *)((char *)rvb+rdspl[0]*2*sizeof(float)), (void *)((char *)sdb),(*sdc)*2*sizeof(float)); } - if (*sdt == mpi_double_complex) { + if (*sdt == MPI_DOUBLE_COMPLEX) { memcpy((void *)((char *)rvb+rdspl[0]*2*sizeof(double)), (void *)((char *)sdb),(*sdc)*2*sizeof(double)); } @@ -273,56 +191,63 @@ void mpi_scatter(void* sdb, int* sdc, int* sdt, { int i,j,k; - if (*sdt == mpi_integer) { - memcpy(rvb,sdb, (*sdc)*sizeof(int)); + if ((*sdt == MPI_INTEGER)||(*sdt == MPI_INTEGER4)||(*sdt == MPI_LOGICAL)) { + memcpy(rvb,sdb, (*sdc)*sizeof(int32_t)); + } + if (*sdt == MPI_CHARACTER) { + memcpy(rvb,sdb, (*sdc)*sizeof(char)); } - if (*sdt == mpi_integer8) { - memcpy(rvb,sdb, (*sdc)*sizeof(long long)); + if (*sdt == MPI_INTEGER8) { + memcpy(rvb,sdb, (*sdc)*sizeof(int64_t)); } - if (*sdt == mpi_real) { + if (*sdt == MPI_REAL) { memcpy(rvb,sdb, (*sdc)*sizeof(float)); } - if (*sdt == mpi_double) { + if (*sdt == MPI_DOUBLE) { memcpy(rvb,sdb, (*sdc)*sizeof(double)); } - if (*sdt == mpi_complex) { + if (*sdt == MPI_COMPLEX) { memcpy(rvb,sdb, (*sdc)*2*sizeof(float)); } - if (*sdt == mpi_double_complex) { + if (*sdt == MPI_DOUBLE_COMPLEX) { memcpy(rvb,sdb, (*sdc)*2*sizeof(double)); } *ierr = 0; } -void mpi_scatterv(void* sdb, int* sdc, int* sdt, - void* rvb, int* rvc, int* rdspl, +void mpi_scatterv(void* sdb, int* sdc, int* sdspl, int* sdt, + void* rvb, int* rvc, int* rvt, int* comm, int *root, int* ierr) { int i,j,k; - if (*sdt == mpi_integer) { - memcpy((void *)((char *)rvb+rdspl[0]*sizeof(int)), - (void *)((char *)sdb),(*sdc)*sizeof(int)); + if ((*sdt == MPI_INTEGER)||(*sdt == MPI_INTEGER4)||(*sdt == MPI_LOGICAL)) { + memcpy((void *)((char *)rvb+sdspl[0]*sizeof(int32_t)), + (void *)((char *)sdb),(*sdc)*sizeof(int32_t)); } - if (*sdt == mpi_integer8) { - memcpy((void *)((char *)rvb+rdspl[0]*sizeof(long long)), - (void *)((char *)sdb),(*sdc)*sizeof(long long)); + if (*sdt == MPI_CHARACTER) { + memcpy((void *)((char *)rvb+sdspl[0]*sizeof(char)), + (void *)((char *)sdb),(*sdc)*sizeof(char)); } - if (*sdt == mpi_real) { - memcpy((void *)((char *)rvb+rdspl[0]*sizeof(float)), + if (*sdt == MPI_INTEGER8) { + memcpy((void *)((char *)rvb+sdspl[0]*sizeof(int64_t)), + (void *)((char *)sdb),(*sdc)*sizeof(int64_t)); + } + if (*sdt == MPI_REAL) { + memcpy((void *)((char *)rvb+sdspl[0]*sizeof(float)), (void *)((char *)sdb),(*sdc)*sizeof(float)); } - if (*sdt == mpi_double) { - memcpy((void *)((char *)rvb+rdspl[0]*sizeof(double)), + if (*sdt == MPI_DOUBLE) { + memcpy((void *)((char *)rvb+sdspl[0]*sizeof(double)), (void *)((char *)sdb),(*sdc)*sizeof(double)); } - if (*sdt == mpi_complex) { - memcpy((void *)((char *)rvb+rdspl[0]*2*sizeof(float)), + if (*sdt == MPI_COMPLEX) { + memcpy((void *)((char *)rvb+sdspl[0]*2*sizeof(float)), (void *)((char *)sdb),(*sdc)*2*sizeof(float)); } - if (*sdt == mpi_double_complex) { - memcpy((void *)((char *)rvb+rdspl[0]*2*sizeof(double)), + if (*sdt == MPI_DOUBLE_COMPLEX) { + memcpy((void *)((char *)rvb+sdspl[0]*2*sizeof(double)), (void *)((char *)sdb),(*sdc)*2*sizeof(double)); } @@ -336,22 +261,25 @@ void mpi_allgather(void* sdb, int* sdc, int* sdt, { int i,j,k; - if (*sdt == mpi_integer) { - memcpy(rvb,sdb, (*sdc)*sizeof(int)); + if ((*sdt == MPI_INTEGER)||(*sdt == MPI_INTEGER4)||(*sdt == MPI_LOGICAL)) { + memcpy(rvb,sdb, (*sdc)*sizeof(int32_t)); + } + if (*sdt == MPI_CHARACTER) { + memcpy(rvb,sdb, (*sdc)*sizeof(char)); } - if (*sdt == mpi_integer8) { - memcpy(rvb,sdb, (*sdc)*sizeof(long long)); + if (*sdt == MPI_INTEGER8) { + memcpy(rvb,sdb, (*sdc)*sizeof(int64_t)); } - if (*sdt == mpi_real) { + if (*sdt == MPI_REAL) { memcpy(rvb,sdb, (*sdc)*sizeof(float)); } - if (*sdt == mpi_double) { + if (*sdt == MPI_DOUBLE) { memcpy(rvb,sdb, (*sdc)*sizeof(double)); } - if (*sdt == mpi_complex) { + if (*sdt == MPI_COMPLEX) { memcpy(rvb,sdb, (*sdc)*2*sizeof(float)); } - if (*sdt == mpi_double_complex) { + if (*sdt == MPI_DOUBLE_COMPLEX) { memcpy(rvb,sdb, (*sdc)*2*sizeof(double)); } *ierr = 0; @@ -363,31 +291,34 @@ void mpi_allgatherv(void* sdb, int* sdc, int* sdt, { int i,j,k; - if (*sdt == mpi_integer) { - memcpy((void *)((char *)rvb+rdspl[0]*sizeof(int)), - (void *)((char *)sdb),(*sdc)*sizeof(int)); + if ((*sdt == MPI_INTEGER)||(*sdt == MPI_INTEGER4)||(*sdt == MPI_LOGICAL)) { + memcpy((void *)((char *)rvb+rdspl[0]*sizeof(int32_t)), + (void *)((char *)sdb),(*sdc)*sizeof(int32_t)); } - if (*sdt == mpi_integer8) { - memcpy((void *)((char *)rvb+rdspl[0]*sizeof(long long)), - (void *)((char *)sdb),(*sdc)*sizeof(long long)); + if (*sdt == MPI_CHARACTER) { + memcpy((void *)((char *)rvb+rdspl[0]*sizeof(char)), + (void *)((char *)sdb),(*sdc)*sizeof(char)); } - if (*sdt == mpi_real) { + if (*sdt == MPI_INTEGER8) { + memcpy((void *)((char *)rvb+rdspl[0]*sizeof(int64_t)), + (void *)((char *)sdb),(*sdc)*sizeof(int64_t)); + } + if (*sdt == MPI_REAL) { memcpy((void *)((char *)rvb+rdspl[0]*sizeof(float)), (void *)((char *)sdb),(*sdc)*sizeof(float)); } - if (*sdt == mpi_double) { + if (*sdt == MPI_DOUBLE) { memcpy((void *)((char *)rvb+rdspl[0]*sizeof(double)), (void *)((char *)sdb),(*sdc)*sizeof(double)); } - if (*sdt == mpi_complex) { + if (*sdt == MPI_COMPLEX) { memcpy((void *)((char *)rvb+rdspl[0]*2*sizeof(float)), (void *)((char *)sdb),(*sdc)*2*sizeof(float)); } - if (*sdt == mpi_double_complex) { + if (*sdt == MPI_DOUBLE_COMPLEX) { memcpy((void *)((char *)rvb+rdspl[0]*2*sizeof(double)), (void *)((char *)sdb),(*sdc)*2*sizeof(double)); } - *ierr = 0; } diff --git a/base/modules/penv/psi_c_collective_mod.F90 b/base/modules/penv/psi_c_collective_mod.F90 index 80a4b6a1..dab33b65 100644 --- a/base/modules/penv/psi_c_collective_mod.F90 +++ b/base/modules/penv/psi_c_collective_mod.F90 @@ -32,6 +32,7 @@ module psi_c_collective_mod use psi_penv_mod use psb_desc_const_mod + use iso_c_binding interface psb_gather @@ -1463,10 +1464,10 @@ contains #ifdef MPI_H include 'mpif.h' #endif - complex(psb_spk_), intent(in) :: valsnd(:) - integer(psb_mpk_), intent(in) :: iasnd(:), jasnd(:) - complex(psb_spk_), intent(out) :: valrcv(:) - integer(psb_mpk_), intent(out) :: iarcv(:), jarcv(:) + complex(psb_spk_), intent(in), target :: valsnd(:) + integer(psb_mpk_), intent(in), target :: iasnd(:), jasnd(:) + complex(psb_spk_), intent(out), target :: valrcv(:) + integer(psb_mpk_), intent(out),target :: iarcv(:), jarcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info @@ -1493,14 +1494,14 @@ contains prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = brvindx(ip+1) p2ptag = psb_complex_tag - call mpi_irecv(valrcv(idx+1:idx+sz),sz,& + call mpi_irecv((valrcv(idx+1:idx+sz)),sz,& & psb_mpi_c_spk_,prcid(ip+1),& & p2ptag, icomm,rvhd(ip+1,1),iret) p2ptag = psb_int_swap_tag - call mpi_irecv(iarcv(idx+1:idx+sz),sz,& + call mpi_irecv((iarcv(idx+1:idx+sz)),sz,& & psb_mpi_mpk_,prcid(ip+1),& & p2ptag, icomm,rvhd(ip+1,2),iret) - call mpi_irecv(jarcv(idx+1:idx+sz),sz,& + call mpi_irecv((jarcv(idx+1:idx+sz)),sz,& & psb_mpi_mpk_,prcid(ip+1),& & p2ptag, icomm,rvhd(ip+1,3),iret) end if @@ -1513,14 +1514,14 @@ contains if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = bsdindx(ip+1) p2ptag = psb_complex_tag - call mpi_send(valsnd(idx+1:idx+sz),sz,& + call mpi_send((valsnd(idx+1:idx+sz)),sz,& & psb_mpi_c_spk_,prcid(ip+1),& & p2ptag, icomm,iret) p2ptag = psb_int_swap_tag - call mpi_send(iasnd(idx+1:idx+sz),sz,& + call mpi_send((iasnd(idx+1:idx+sz)),sz,& & psb_mpi_mpk_,prcid(ip+1),& & p2ptag, icomm,iret) - call mpi_send(jasnd(idx+1:idx+sz),sz,& + call mpi_send((jasnd(idx+1:idx+sz)),sz,& & psb_mpi_mpk_,prcid(ip+1),& & p2ptag, icomm,iret) end if @@ -1546,10 +1547,10 @@ contains #ifdef MPI_H include 'mpif.h' #endif - complex(psb_spk_), intent(in) :: valsnd(:) - integer(psb_epk_), intent(in) :: iasnd(:), jasnd(:) - complex(psb_spk_), intent(out) :: valrcv(:) - integer(psb_epk_), intent(out) :: iarcv(:), jarcv(:) + complex(psb_spk_), intent(in), target :: valsnd(:) + integer(psb_epk_), intent(in), target :: iasnd(:), jasnd(:) + complex(psb_spk_), intent(out), target :: valrcv(:) + integer(psb_epk_), intent(out), target :: iarcv(:), jarcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info @@ -1576,14 +1577,14 @@ contains prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = brvindx(ip+1) p2ptag = psb_complex_tag - call mpi_irecv(valrcv(idx+1:idx+sz),sz,& + call mpi_irecv((valrcv(idx+1:idx+sz)),sz,& & psb_mpi_c_spk_,prcid(ip+1),& & p2ptag, icomm,rvhd(ip+1,1),iret) p2ptag = psb_int_swap_tag - call mpi_irecv(iarcv(idx+1:idx+sz),sz,& + call mpi_irecv((iarcv(idx+1:idx+sz)),sz,& & psb_mpi_epk_,prcid(ip+1),& & p2ptag, icomm,rvhd(ip+1,2),iret) - call mpi_irecv(jarcv(idx+1:idx+sz),sz,& + call mpi_irecv((jarcv(idx+1:idx+sz)),sz,& & psb_mpi_epk_,prcid(ip+1),& & p2ptag, icomm,rvhd(ip+1,3),iret) end if @@ -1596,14 +1597,14 @@ contains if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = bsdindx(ip+1) p2ptag = psb_complex_tag - call mpi_send(valsnd(idx+1:idx+sz),sz,& + call mpi_send((valsnd(idx+1:idx+sz)),sz,& & psb_mpi_c_spk_,prcid(ip+1),& & p2ptag, icomm,iret) p2ptag = psb_int_swap_tag - call mpi_send(iasnd(idx+1:idx+sz),sz,& + call mpi_send((iasnd(idx+1:idx+sz)),sz,& & psb_mpi_epk_,prcid(ip+1),& & p2ptag, icomm,iret) - call mpi_send(jasnd(idx+1:idx+sz),sz,& + call mpi_send((jasnd(idx+1:idx+sz)),sz,& & psb_mpi_epk_,prcid(ip+1),& & p2ptag, icomm,iret) end if diff --git a/base/modules/penv/psi_d_collective_mod.F90 b/base/modules/penv/psi_d_collective_mod.F90 index 67f95f55..52d4ff2d 100644 --- a/base/modules/penv/psi_d_collective_mod.F90 +++ b/base/modules/penv/psi_d_collective_mod.F90 @@ -32,6 +32,7 @@ module psi_d_collective_mod use psi_penv_mod use psb_desc_const_mod + use iso_c_binding interface psb_max module procedure psb_dmaxs, psb_dmaxv, psb_dmaxm @@ -2103,10 +2104,10 @@ contains #ifdef MPI_H include 'mpif.h' #endif - real(psb_dpk_), intent(in) :: valsnd(:) - integer(psb_mpk_), intent(in) :: iasnd(:), jasnd(:) - real(psb_dpk_), intent(out) :: valrcv(:) - integer(psb_mpk_), intent(out) :: iarcv(:), jarcv(:) + real(psb_dpk_), intent(in), target :: valsnd(:) + integer(psb_mpk_), intent(in), target :: iasnd(:), jasnd(:) + real(psb_dpk_), intent(out), target :: valrcv(:) + integer(psb_mpk_), intent(out),target :: iarcv(:), jarcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info @@ -2133,14 +2134,14 @@ contains prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = brvindx(ip+1) p2ptag = psb_double_tag - call mpi_irecv(valrcv(idx+1:idx+sz),sz,& + call mpi_irecv((valrcv(idx+1:idx+sz)),sz,& & psb_mpi_r_dpk_,prcid(ip+1),& & p2ptag, icomm,rvhd(ip+1,1),iret) p2ptag = psb_int_swap_tag - call mpi_irecv(iarcv(idx+1:idx+sz),sz,& + call mpi_irecv((iarcv(idx+1:idx+sz)),sz,& & psb_mpi_mpk_,prcid(ip+1),& & p2ptag, icomm,rvhd(ip+1,2),iret) - call mpi_irecv(jarcv(idx+1:idx+sz),sz,& + call mpi_irecv((jarcv(idx+1:idx+sz)),sz,& & psb_mpi_mpk_,prcid(ip+1),& & p2ptag, icomm,rvhd(ip+1,3),iret) end if @@ -2153,14 +2154,14 @@ contains if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = bsdindx(ip+1) p2ptag = psb_double_tag - call mpi_send(valsnd(idx+1:idx+sz),sz,& + call mpi_send((valsnd(idx+1:idx+sz)),sz,& & psb_mpi_r_dpk_,prcid(ip+1),& & p2ptag, icomm,iret) p2ptag = psb_int_swap_tag - call mpi_send(iasnd(idx+1:idx+sz),sz,& + call mpi_send((iasnd(idx+1:idx+sz)),sz,& & psb_mpi_mpk_,prcid(ip+1),& & p2ptag, icomm,iret) - call mpi_send(jasnd(idx+1:idx+sz),sz,& + call mpi_send((jasnd(idx+1:idx+sz)),sz,& & psb_mpi_mpk_,prcid(ip+1),& & p2ptag, icomm,iret) end if @@ -2186,10 +2187,10 @@ contains #ifdef MPI_H include 'mpif.h' #endif - real(psb_dpk_), intent(in) :: valsnd(:) - integer(psb_epk_), intent(in) :: iasnd(:), jasnd(:) - real(psb_dpk_), intent(out) :: valrcv(:) - integer(psb_epk_), intent(out) :: iarcv(:), jarcv(:) + real(psb_dpk_), intent(in), target :: valsnd(:) + integer(psb_epk_), intent(in), target :: iasnd(:), jasnd(:) + real(psb_dpk_), intent(out), target :: valrcv(:) + integer(psb_epk_), intent(out), target :: iarcv(:), jarcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info @@ -2216,14 +2217,14 @@ contains prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = brvindx(ip+1) p2ptag = psb_double_tag - call mpi_irecv(valrcv(idx+1:idx+sz),sz,& + call mpi_irecv((valrcv(idx+1:idx+sz)),sz,& & psb_mpi_r_dpk_,prcid(ip+1),& & p2ptag, icomm,rvhd(ip+1,1),iret) p2ptag = psb_int_swap_tag - call mpi_irecv(iarcv(idx+1:idx+sz),sz,& + call mpi_irecv((iarcv(idx+1:idx+sz)),sz,& & psb_mpi_epk_,prcid(ip+1),& & p2ptag, icomm,rvhd(ip+1,2),iret) - call mpi_irecv(jarcv(idx+1:idx+sz),sz,& + call mpi_irecv((jarcv(idx+1:idx+sz)),sz,& & psb_mpi_epk_,prcid(ip+1),& & p2ptag, icomm,rvhd(ip+1,3),iret) end if @@ -2236,14 +2237,14 @@ contains if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = bsdindx(ip+1) p2ptag = psb_double_tag - call mpi_send(valsnd(idx+1:idx+sz),sz,& + call mpi_send((valsnd(idx+1:idx+sz)),sz,& & psb_mpi_r_dpk_,prcid(ip+1),& & p2ptag, icomm,iret) p2ptag = psb_int_swap_tag - call mpi_send(iasnd(idx+1:idx+sz),sz,& + call mpi_send((iasnd(idx+1:idx+sz)),sz,& & psb_mpi_epk_,prcid(ip+1),& & p2ptag, icomm,iret) - call mpi_send(jasnd(idx+1:idx+sz),sz,& + call mpi_send((jasnd(idx+1:idx+sz)),sz,& & psb_mpi_epk_,prcid(ip+1),& & p2ptag, icomm,iret) end if diff --git a/base/modules/penv/psi_e_collective_mod.F90 b/base/modules/penv/psi_e_collective_mod.F90 index 5d66eed6..20f99d5c 100644 --- a/base/modules/penv/psi_e_collective_mod.F90 +++ b/base/modules/penv/psi_e_collective_mod.F90 @@ -32,6 +32,7 @@ module psi_e_collective_mod use psi_penv_mod use psb_desc_const_mod + use iso_c_binding interface psb_max module procedure psb_emaxs, psb_emaxv, psb_emaxm @@ -1941,10 +1942,10 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_epk_), intent(in) :: valsnd(:) - integer(psb_mpk_), intent(in) :: iasnd(:), jasnd(:) - integer(psb_epk_), intent(out) :: valrcv(:) - integer(psb_mpk_), intent(out) :: iarcv(:), jarcv(:) + integer(psb_epk_), intent(in), target :: valsnd(:) + integer(psb_mpk_), intent(in), target :: iasnd(:), jasnd(:) + integer(psb_epk_), intent(out), target :: valrcv(:) + integer(psb_mpk_), intent(out),target :: iarcv(:), jarcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info @@ -1971,14 +1972,14 @@ contains prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = brvindx(ip+1) p2ptag = psb_int8_tag - call mpi_irecv(valrcv(idx+1:idx+sz),sz,& + call mpi_irecv((valrcv(idx+1:idx+sz)),sz,& & psb_mpi_epk_,prcid(ip+1),& & p2ptag, icomm,rvhd(ip+1,1),iret) p2ptag = psb_int_swap_tag - call mpi_irecv(iarcv(idx+1:idx+sz),sz,& + call mpi_irecv((iarcv(idx+1:idx+sz)),sz,& & psb_mpi_mpk_,prcid(ip+1),& & p2ptag, icomm,rvhd(ip+1,2),iret) - call mpi_irecv(jarcv(idx+1:idx+sz),sz,& + call mpi_irecv((jarcv(idx+1:idx+sz)),sz,& & psb_mpi_mpk_,prcid(ip+1),& & p2ptag, icomm,rvhd(ip+1,3),iret) end if @@ -1991,14 +1992,14 @@ contains if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = bsdindx(ip+1) p2ptag = psb_int8_tag - call mpi_send(valsnd(idx+1:idx+sz),sz,& + call mpi_send((valsnd(idx+1:idx+sz)),sz,& & psb_mpi_epk_,prcid(ip+1),& & p2ptag, icomm,iret) p2ptag = psb_int_swap_tag - call mpi_send(iasnd(idx+1:idx+sz),sz,& + call mpi_send((iasnd(idx+1:idx+sz)),sz,& & psb_mpi_mpk_,prcid(ip+1),& & p2ptag, icomm,iret) - call mpi_send(jasnd(idx+1:idx+sz),sz,& + call mpi_send((jasnd(idx+1:idx+sz)),sz,& & psb_mpi_mpk_,prcid(ip+1),& & p2ptag, icomm,iret) end if @@ -2024,10 +2025,10 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_epk_), intent(in) :: valsnd(:) - integer(psb_epk_), intent(in) :: iasnd(:), jasnd(:) - integer(psb_epk_), intent(out) :: valrcv(:) - integer(psb_epk_), intent(out) :: iarcv(:), jarcv(:) + integer(psb_epk_), intent(in), target :: valsnd(:) + integer(psb_epk_), intent(in), target :: iasnd(:), jasnd(:) + integer(psb_epk_), intent(out), target :: valrcv(:) + integer(psb_epk_), intent(out), target :: iarcv(:), jarcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info @@ -2054,14 +2055,14 @@ contains prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = brvindx(ip+1) p2ptag = psb_int8_tag - call mpi_irecv(valrcv(idx+1:idx+sz),sz,& + call mpi_irecv((valrcv(idx+1:idx+sz)),sz,& & psb_mpi_epk_,prcid(ip+1),& & p2ptag, icomm,rvhd(ip+1,1),iret) p2ptag = psb_int_swap_tag - call mpi_irecv(iarcv(idx+1:idx+sz),sz,& + call mpi_irecv((iarcv(idx+1:idx+sz)),sz,& & psb_mpi_epk_,prcid(ip+1),& & p2ptag, icomm,rvhd(ip+1,2),iret) - call mpi_irecv(jarcv(idx+1:idx+sz),sz,& + call mpi_irecv((jarcv(idx+1:idx+sz)),sz,& & psb_mpi_epk_,prcid(ip+1),& & p2ptag, icomm,rvhd(ip+1,3),iret) end if @@ -2074,14 +2075,14 @@ contains if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = bsdindx(ip+1) p2ptag = psb_int8_tag - call mpi_send(valsnd(idx+1:idx+sz),sz,& + call mpi_send((valsnd(idx+1:idx+sz)),sz,& & psb_mpi_epk_,prcid(ip+1),& & p2ptag, icomm,iret) p2ptag = psb_int_swap_tag - call mpi_send(iasnd(idx+1:idx+sz),sz,& + call mpi_send((iasnd(idx+1:idx+sz)),sz,& & psb_mpi_epk_,prcid(ip+1),& & p2ptag, icomm,iret) - call mpi_send(jasnd(idx+1:idx+sz),sz,& + call mpi_send((jasnd(idx+1:idx+sz)),sz,& & psb_mpi_epk_,prcid(ip+1),& & p2ptag, icomm,iret) end if diff --git a/base/modules/penv/psi_i2_collective_mod.F90 b/base/modules/penv/psi_i2_collective_mod.F90 index 88d40b66..b571f581 100644 --- a/base/modules/penv/psi_i2_collective_mod.F90 +++ b/base/modules/penv/psi_i2_collective_mod.F90 @@ -32,6 +32,7 @@ module psi_i2_collective_mod use psi_penv_mod use psb_desc_const_mod + use iso_c_binding interface psb_max module procedure psb_i2maxs, psb_i2maxv, psb_i2maxm @@ -1941,10 +1942,10 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_i2pk_), intent(in) :: valsnd(:) - integer(psb_mpk_), intent(in) :: iasnd(:), jasnd(:) - integer(psb_i2pk_), intent(out) :: valrcv(:) - integer(psb_mpk_), intent(out) :: iarcv(:), jarcv(:) + integer(psb_i2pk_), intent(in), target :: valsnd(:) + integer(psb_mpk_), intent(in), target :: iasnd(:), jasnd(:) + integer(psb_i2pk_), intent(out), target :: valrcv(:) + integer(psb_mpk_), intent(out),target :: iarcv(:), jarcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info @@ -1971,14 +1972,14 @@ contains prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = brvindx(ip+1) p2ptag = psb_int2_tag - call mpi_irecv(valrcv(idx+1:idx+sz),sz,& + call mpi_irecv((valrcv(idx+1:idx+sz)),sz,& & psb_mpi_i2pk_,prcid(ip+1),& & p2ptag, icomm,rvhd(ip+1,1),iret) p2ptag = psb_int_swap_tag - call mpi_irecv(iarcv(idx+1:idx+sz),sz,& + call mpi_irecv((iarcv(idx+1:idx+sz)),sz,& & psb_mpi_mpk_,prcid(ip+1),& & p2ptag, icomm,rvhd(ip+1,2),iret) - call mpi_irecv(jarcv(idx+1:idx+sz),sz,& + call mpi_irecv((jarcv(idx+1:idx+sz)),sz,& & psb_mpi_mpk_,prcid(ip+1),& & p2ptag, icomm,rvhd(ip+1,3),iret) end if @@ -1991,14 +1992,14 @@ contains if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = bsdindx(ip+1) p2ptag = psb_int2_tag - call mpi_send(valsnd(idx+1:idx+sz),sz,& + call mpi_send((valsnd(idx+1:idx+sz)),sz,& & psb_mpi_i2pk_,prcid(ip+1),& & p2ptag, icomm,iret) p2ptag = psb_int_swap_tag - call mpi_send(iasnd(idx+1:idx+sz),sz,& + call mpi_send((iasnd(idx+1:idx+sz)),sz,& & psb_mpi_mpk_,prcid(ip+1),& & p2ptag, icomm,iret) - call mpi_send(jasnd(idx+1:idx+sz),sz,& + call mpi_send((jasnd(idx+1:idx+sz)),sz,& & psb_mpi_mpk_,prcid(ip+1),& & p2ptag, icomm,iret) end if @@ -2024,10 +2025,10 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_i2pk_), intent(in) :: valsnd(:) - integer(psb_epk_), intent(in) :: iasnd(:), jasnd(:) - integer(psb_i2pk_), intent(out) :: valrcv(:) - integer(psb_epk_), intent(out) :: iarcv(:), jarcv(:) + integer(psb_i2pk_), intent(in), target :: valsnd(:) + integer(psb_epk_), intent(in), target :: iasnd(:), jasnd(:) + integer(psb_i2pk_), intent(out), target :: valrcv(:) + integer(psb_epk_), intent(out), target :: iarcv(:), jarcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info @@ -2054,14 +2055,14 @@ contains prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = brvindx(ip+1) p2ptag = psb_int2_tag - call mpi_irecv(valrcv(idx+1:idx+sz),sz,& + call mpi_irecv((valrcv(idx+1:idx+sz)),sz,& & psb_mpi_i2pk_,prcid(ip+1),& & p2ptag, icomm,rvhd(ip+1,1),iret) p2ptag = psb_int_swap_tag - call mpi_irecv(iarcv(idx+1:idx+sz),sz,& + call mpi_irecv((iarcv(idx+1:idx+sz)),sz,& & psb_mpi_epk_,prcid(ip+1),& & p2ptag, icomm,rvhd(ip+1,2),iret) - call mpi_irecv(jarcv(idx+1:idx+sz),sz,& + call mpi_irecv((jarcv(idx+1:idx+sz)),sz,& & psb_mpi_epk_,prcid(ip+1),& & p2ptag, icomm,rvhd(ip+1,3),iret) end if @@ -2074,14 +2075,14 @@ contains if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = bsdindx(ip+1) p2ptag = psb_int2_tag - call mpi_send(valsnd(idx+1:idx+sz),sz,& + call mpi_send((valsnd(idx+1:idx+sz)),sz,& & psb_mpi_i2pk_,prcid(ip+1),& & p2ptag, icomm,iret) p2ptag = psb_int_swap_tag - call mpi_send(iasnd(idx+1:idx+sz),sz,& + call mpi_send((iasnd(idx+1:idx+sz)),sz,& & psb_mpi_epk_,prcid(ip+1),& & p2ptag, icomm,iret) - call mpi_send(jasnd(idx+1:idx+sz),sz,& + call mpi_send((jasnd(idx+1:idx+sz)),sz,& & psb_mpi_epk_,prcid(ip+1),& & p2ptag, icomm,iret) end if diff --git a/base/modules/penv/psi_m_collective_mod.F90 b/base/modules/penv/psi_m_collective_mod.F90 index c97ac5a3..ca4fc7d2 100644 --- a/base/modules/penv/psi_m_collective_mod.F90 +++ b/base/modules/penv/psi_m_collective_mod.F90 @@ -32,6 +32,7 @@ module psi_m_collective_mod use psi_penv_mod use psb_desc_const_mod + use iso_c_binding interface psb_max module procedure psb_mmaxs, psb_mmaxv, psb_mmaxm @@ -1941,10 +1942,10 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: valsnd(:) - integer(psb_mpk_), intent(in) :: iasnd(:), jasnd(:) - integer(psb_mpk_), intent(out) :: valrcv(:) - integer(psb_mpk_), intent(out) :: iarcv(:), jarcv(:) + integer(psb_mpk_), intent(in), target :: valsnd(:) + integer(psb_mpk_), intent(in), target :: iasnd(:), jasnd(:) + integer(psb_mpk_), intent(out), target :: valrcv(:) + integer(psb_mpk_), intent(out),target :: iarcv(:), jarcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info @@ -1971,14 +1972,14 @@ contains prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = brvindx(ip+1) p2ptag = psb_int4_tag - call mpi_irecv(valrcv(idx+1:idx+sz),sz,& + call mpi_irecv((valrcv(idx+1:idx+sz)),sz,& & psb_mpi_mpk_,prcid(ip+1),& & p2ptag, icomm,rvhd(ip+1,1),iret) p2ptag = psb_int_swap_tag - call mpi_irecv(iarcv(idx+1:idx+sz),sz,& + call mpi_irecv((iarcv(idx+1:idx+sz)),sz,& & psb_mpi_mpk_,prcid(ip+1),& & p2ptag, icomm,rvhd(ip+1,2),iret) - call mpi_irecv(jarcv(idx+1:idx+sz),sz,& + call mpi_irecv((jarcv(idx+1:idx+sz)),sz,& & psb_mpi_mpk_,prcid(ip+1),& & p2ptag, icomm,rvhd(ip+1,3),iret) end if @@ -1991,14 +1992,14 @@ contains if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = bsdindx(ip+1) p2ptag = psb_int4_tag - call mpi_send(valsnd(idx+1:idx+sz),sz,& + call mpi_send((valsnd(idx+1:idx+sz)),sz,& & psb_mpi_mpk_,prcid(ip+1),& & p2ptag, icomm,iret) p2ptag = psb_int_swap_tag - call mpi_send(iasnd(idx+1:idx+sz),sz,& + call mpi_send((iasnd(idx+1:idx+sz)),sz,& & psb_mpi_mpk_,prcid(ip+1),& & p2ptag, icomm,iret) - call mpi_send(jasnd(idx+1:idx+sz),sz,& + call mpi_send((jasnd(idx+1:idx+sz)),sz,& & psb_mpi_mpk_,prcid(ip+1),& & p2ptag, icomm,iret) end if @@ -2024,10 +2025,10 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: valsnd(:) - integer(psb_epk_), intent(in) :: iasnd(:), jasnd(:) - integer(psb_mpk_), intent(out) :: valrcv(:) - integer(psb_epk_), intent(out) :: iarcv(:), jarcv(:) + integer(psb_mpk_), intent(in), target :: valsnd(:) + integer(psb_epk_), intent(in), target :: iasnd(:), jasnd(:) + integer(psb_mpk_), intent(out), target :: valrcv(:) + integer(psb_epk_), intent(out), target :: iarcv(:), jarcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info @@ -2054,14 +2055,14 @@ contains prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = brvindx(ip+1) p2ptag = psb_int4_tag - call mpi_irecv(valrcv(idx+1:idx+sz),sz,& + call mpi_irecv((valrcv(idx+1:idx+sz)),sz,& & psb_mpi_mpk_,prcid(ip+1),& & p2ptag, icomm,rvhd(ip+1,1),iret) p2ptag = psb_int_swap_tag - call mpi_irecv(iarcv(idx+1:idx+sz),sz,& + call mpi_irecv((iarcv(idx+1:idx+sz)),sz,& & psb_mpi_epk_,prcid(ip+1),& & p2ptag, icomm,rvhd(ip+1,2),iret) - call mpi_irecv(jarcv(idx+1:idx+sz),sz,& + call mpi_irecv((jarcv(idx+1:idx+sz)),sz,& & psb_mpi_epk_,prcid(ip+1),& & p2ptag, icomm,rvhd(ip+1,3),iret) end if @@ -2074,14 +2075,14 @@ contains if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = bsdindx(ip+1) p2ptag = psb_int4_tag - call mpi_send(valsnd(idx+1:idx+sz),sz,& + call mpi_send((valsnd(idx+1:idx+sz)),sz,& & psb_mpi_mpk_,prcid(ip+1),& & p2ptag, icomm,iret) p2ptag = psb_int_swap_tag - call mpi_send(iasnd(idx+1:idx+sz),sz,& + call mpi_send((iasnd(idx+1:idx+sz)),sz,& & psb_mpi_epk_,prcid(ip+1),& & p2ptag, icomm,iret) - call mpi_send(jasnd(idx+1:idx+sz),sz,& + call mpi_send((jasnd(idx+1:idx+sz)),sz,& & psb_mpi_epk_,prcid(ip+1),& & p2ptag, icomm,iret) end if diff --git a/base/modules/penv/psi_penv_mod.F90 b/base/modules/penv/psi_penv_mod.F90 index 8467831a..1f22f551 100644 --- a/base/modules/penv/psi_penv_mod.F90 +++ b/base/modules/penv/psi_penv_mod.F90 @@ -33,6 +33,7 @@ ! Provide a fake mpi module just to keep the compiler(s) happy. module mpi use psb_const_mod + use iso_c_binding integer(psb_mpk_), parameter :: mpi_success = 0 integer(psb_mpk_), parameter :: mpi_request_null = 0 integer(psb_mpk_), parameter :: mpi_status_size = 1 @@ -49,13 +50,124 @@ module mpi integer(psb_mpk_), parameter :: mpi_comm_null = -1 integer(psb_mpk_), parameter :: mpi_comm_world = 1 - real(psb_dpk_), external :: mpi_wtime + !real(psb_dpk_), external :: mpi_wtime + + interface + function mpi_wtime() result(res) bind(c,name='mpi_wtime') + import + end function mpi_wtime + end interface + + interface + subroutine mpi_wait(request, status,ierr) bind(c,name='mpi_wait') + import + type(*), dimension(..) :: request + integer(psb_mpk_) :: status(*) + integer(psb_mpk_) :: ierr + end subroutine mpi_wait + end interface + + interface + subroutine mpi_send(buf,count,datatype,dest,tag,comm,ierr) & + & bind(c,name='mpi_send') + import + type(*), dimension(..) :: buf + integer(psb_mpk_) :: count, datatype, dest, tag, comm, ierr + end subroutine mpi_send + end interface + + interface + subroutine mpi_irecv(buf,count,datatype,src,tag,comm,request,ierr) & + & bind(c,name='mpi_irecv') + import + type(*), dimension(..) :: buf + integer(psb_mpk_) :: count, datatype, src, tag, comm, request, ierr + end subroutine mpi_irecv + end interface + + interface + subroutine mpi_alltoall(sdb,sdc,sdt,rvb,rvc,rvt,comm,ierr) & + & bind(c,name='mpi_alltoall') + import + type(*), dimension(..) :: sdb, rvb + integer(psb_mpk_) :: sdc,sdt,rvc,rvt, comm, ierr + end subroutine mpi_alltoall + end interface + + interface + subroutine mpi_alltoallv(sdb,sdc,sdspl,sdt,rvb,rvc,rdspl,rvt,comm,ierr) & + & bind(c,name='mpi_alltoallv') + import + type(*), dimension(..) :: sdb, rvb + integer(psb_mpk_) :: sdspl(*), rdspl(*), sdc(*), rvc(*) + integer(psb_mpk_) :: sdt,rvt, comm, ierr + end subroutine mpi_alltoallv + end interface + + interface + subroutine mpi_gather(sdb,sdc,sdt,rvb,rvc,rvt,root,comm,ierr) & + & bind(c,name='mpi_gather') + import + type(*), dimension(..) :: sdb, rvb + integer(psb_mpk_) :: sdc,sdt,rvc,rvt, root, comm, ierr + end subroutine mpi_gather + end interface + + interface + subroutine mpi_gatherv(sdb,sdc,sdt,rvb,rvc,rdspl,rvt,root,comm,ierr) & + & bind(c,name='mpi_gatherv') + import + type(*), dimension(..) :: sdb, rvb + integer(psb_mpk_) :: rdspl(*), rvc(*) + integer(psb_mpk_) :: sdt,sdc,rvt, root, comm, ierr + end subroutine mpi_gatherv + end interface + + interface + subroutine mpi_scatter(sdb,sdc,sdt,rvb,rvc,rvt,root,comm,ierr) & + & bind(c,name='mpi_scatter') + import + type(*), dimension(..) :: sdb, rvb + integer(psb_mpk_) :: sdc,sdt,rvc,rvt, root, comm, ierr + end subroutine mpi_scatter + end interface + + interface + subroutine mpi_scatterv(sdb,sdc,sdspl,sdt,rvb,rvc,rvt,root,comm,ierr) & + & bind(c,name='mpi_scatterv') + import + type(*), dimension(..) :: sdb, rvb + integer(psb_mpk_) :: sdspl(*), sdc(*) + integer(psb_mpk_) :: sdt,rvc,rvt, root, comm, ierr + end subroutine mpi_scatterv + end interface + + interface + subroutine mpi_allgather(sdb,sdc,sdt,rvb,rvc,rvt,comm,ierr) & + & bind(c,name='mpi_allgather') + import + type(*), dimension(..) :: sdb, rvb + integer(psb_mpk_) :: sdc,sdt,rvc,rvt, comm, ierr + end subroutine mpi_allgather + end interface + + interface + subroutine mpi_allgatherv(sdb,sdc,sdt,rvb,rvc,rdspl,rvt,comm,ierr) & + & bind(c,name='mpi_allgatherv') + import + type(*), dimension(..) :: sdb, rvb + integer(psb_mpk_) :: rdspl(*),rvc(*) + integer(psb_mpk_) :: sdc,sdt,rvt, comm, ierr + end subroutine mpi_allgatherv + end interface + end module mpi #endif module psi_penv_mod use psb_const_mod + use iso_c_binding integer(psb_mpk_), parameter:: psb_int_tag = 543987 integer(psb_mpk_), parameter:: psb_real_tag = psb_int_tag + 1 @@ -381,7 +493,7 @@ contains write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' return end if - call mpi_isend(node%int4buf,size(node%int4buf),psb_mpi_mpk_,& + call mpi_isend(c_loc(node%int4buf),size(node%int4buf),psb_mpi_mpk_,& & dest,tag,icomm,node%request,minfo) info = minfo call psb_insert_node(mesg_queue,node) @@ -420,7 +532,7 @@ contains write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' return end if - call mpi_isend(node%int8buf,size(node%int8buf),psb_mpi_epk_,& + call mpi_isend(c_loc(node%int8buf),size(node%int8buf),psb_mpi_epk_,& & dest,tag,icomm,node%request,minfo) info = minfo call psb_insert_node(mesg_queue,node) @@ -457,7 +569,7 @@ contains write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' return end if - call mpi_isend(node%int2buf,size(node%int2buf),psb_mpi_i2pk_,& + call mpi_isend(c_loc(node%int2buf),size(node%int2buf),psb_mpi_i2pk_,& & dest,tag,icomm,node%request,minfo) info = minfo call psb_insert_node(mesg_queue,node) @@ -494,7 +606,7 @@ contains write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' return end if - call mpi_isend(node%realbuf,size(node%realbuf),psb_mpi_r_spk_,& + call mpi_isend(c_loc(node%realbuf),size(node%realbuf),psb_mpi_r_spk_,& & dest,tag,icomm,node%request,minfo) info = minfo call psb_insert_node(mesg_queue,node) @@ -531,7 +643,7 @@ contains write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' return end if - call mpi_isend(node%doublebuf,size(node%doublebuf),psb_mpi_r_dpk_,& + call mpi_isend(c_loc(node%doublebuf),size(node%doublebuf),psb_mpi_r_dpk_,& & dest,tag,icomm,node%request,minfo) info = minfo call psb_insert_node(mesg_queue,node) @@ -568,7 +680,7 @@ contains write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' return end if - call mpi_isend(node%complexbuf,size(node%complexbuf),psb_mpi_c_spk_,& + call mpi_isend(c_loc(node%complexbuf),size(node%complexbuf),psb_mpi_c_spk_,& & dest,tag,icomm,node%request,minfo) info = minfo call psb_insert_node(mesg_queue,node) @@ -605,7 +717,7 @@ contains write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' return end if - call mpi_isend(node%dcomplbuf,size(node%dcomplbuf),psb_mpi_c_dpk_,& + call mpi_isend(c_loc(node%dcomplbuf),size(node%dcomplbuf),psb_mpi_c_dpk_,& & dest,tag,icomm,node%request,minfo) info = minfo call psb_insert_node(mesg_queue,node) @@ -643,7 +755,7 @@ contains write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' return end if - call mpi_isend(node%logbuf,size(node%logbuf),mpi_logical,& + call mpi_isend(c_loc(node%logbuf),size(node%logbuf),mpi_logical,& & dest,tag,icomm,node%request,minfo) info = minfo call psb_insert_node(mesg_queue,node) @@ -681,7 +793,7 @@ contains write(psb_err_unit,*) 'Fatal memory error inside communication subsystem' return end if - call mpi_isend(node%charbuf,size(node%charbuf),mpi_character,& + call mpi_isend(c_loc(node%charbuf),size(node%charbuf),mpi_character,& & dest,tag,icomm,node%request,minfo) info = minfo call psb_insert_node(mesg_queue,node) diff --git a/base/modules/penv/psi_s_collective_mod.F90 b/base/modules/penv/psi_s_collective_mod.F90 index 6dcc5253..9f976d79 100644 --- a/base/modules/penv/psi_s_collective_mod.F90 +++ b/base/modules/penv/psi_s_collective_mod.F90 @@ -32,6 +32,7 @@ module psi_s_collective_mod use psi_penv_mod use psb_desc_const_mod + use iso_c_binding interface psb_max module procedure psb_smaxs, psb_smaxv, psb_smaxm @@ -2103,10 +2104,10 @@ contains #ifdef MPI_H include 'mpif.h' #endif - real(psb_spk_), intent(in) :: valsnd(:) - integer(psb_mpk_), intent(in) :: iasnd(:), jasnd(:) - real(psb_spk_), intent(out) :: valrcv(:) - integer(psb_mpk_), intent(out) :: iarcv(:), jarcv(:) + real(psb_spk_), intent(in), target :: valsnd(:) + integer(psb_mpk_), intent(in), target :: iasnd(:), jasnd(:) + real(psb_spk_), intent(out), target :: valrcv(:) + integer(psb_mpk_), intent(out),target :: iarcv(:), jarcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info @@ -2133,14 +2134,14 @@ contains prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = brvindx(ip+1) p2ptag = psb_real_tag - call mpi_irecv(valrcv(idx+1:idx+sz),sz,& + call mpi_irecv((valrcv(idx+1:idx+sz)),sz,& & psb_mpi_r_spk_,prcid(ip+1),& & p2ptag, icomm,rvhd(ip+1,1),iret) p2ptag = psb_int_swap_tag - call mpi_irecv(iarcv(idx+1:idx+sz),sz,& + call mpi_irecv((iarcv(idx+1:idx+sz)),sz,& & psb_mpi_mpk_,prcid(ip+1),& & p2ptag, icomm,rvhd(ip+1,2),iret) - call mpi_irecv(jarcv(idx+1:idx+sz),sz,& + call mpi_irecv((jarcv(idx+1:idx+sz)),sz,& & psb_mpi_mpk_,prcid(ip+1),& & p2ptag, icomm,rvhd(ip+1,3),iret) end if @@ -2153,14 +2154,14 @@ contains if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = bsdindx(ip+1) p2ptag = psb_real_tag - call mpi_send(valsnd(idx+1:idx+sz),sz,& + call mpi_send((valsnd(idx+1:idx+sz)),sz,& & psb_mpi_r_spk_,prcid(ip+1),& & p2ptag, icomm,iret) p2ptag = psb_int_swap_tag - call mpi_send(iasnd(idx+1:idx+sz),sz,& + call mpi_send((iasnd(idx+1:idx+sz)),sz,& & psb_mpi_mpk_,prcid(ip+1),& & p2ptag, icomm,iret) - call mpi_send(jasnd(idx+1:idx+sz),sz,& + call mpi_send((jasnd(idx+1:idx+sz)),sz,& & psb_mpi_mpk_,prcid(ip+1),& & p2ptag, icomm,iret) end if @@ -2186,10 +2187,10 @@ contains #ifdef MPI_H include 'mpif.h' #endif - real(psb_spk_), intent(in) :: valsnd(:) - integer(psb_epk_), intent(in) :: iasnd(:), jasnd(:) - real(psb_spk_), intent(out) :: valrcv(:) - integer(psb_epk_), intent(out) :: iarcv(:), jarcv(:) + real(psb_spk_), intent(in), target :: valsnd(:) + integer(psb_epk_), intent(in), target :: iasnd(:), jasnd(:) + real(psb_spk_), intent(out), target :: valrcv(:) + integer(psb_epk_), intent(out), target :: iarcv(:), jarcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info @@ -2216,14 +2217,14 @@ contains prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = brvindx(ip+1) p2ptag = psb_real_tag - call mpi_irecv(valrcv(idx+1:idx+sz),sz,& + call mpi_irecv((valrcv(idx+1:idx+sz)),sz,& & psb_mpi_r_spk_,prcid(ip+1),& & p2ptag, icomm,rvhd(ip+1,1),iret) p2ptag = psb_int_swap_tag - call mpi_irecv(iarcv(idx+1:idx+sz),sz,& + call mpi_irecv((iarcv(idx+1:idx+sz)),sz,& & psb_mpi_epk_,prcid(ip+1),& & p2ptag, icomm,rvhd(ip+1,2),iret) - call mpi_irecv(jarcv(idx+1:idx+sz),sz,& + call mpi_irecv((jarcv(idx+1:idx+sz)),sz,& & psb_mpi_epk_,prcid(ip+1),& & p2ptag, icomm,rvhd(ip+1,3),iret) end if @@ -2236,14 +2237,14 @@ contains if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = bsdindx(ip+1) p2ptag = psb_real_tag - call mpi_send(valsnd(idx+1:idx+sz),sz,& + call mpi_send((valsnd(idx+1:idx+sz)),sz,& & psb_mpi_r_spk_,prcid(ip+1),& & p2ptag, icomm,iret) p2ptag = psb_int_swap_tag - call mpi_send(iasnd(idx+1:idx+sz),sz,& + call mpi_send((iasnd(idx+1:idx+sz)),sz,& & psb_mpi_epk_,prcid(ip+1),& & p2ptag, icomm,iret) - call mpi_send(jasnd(idx+1:idx+sz),sz,& + call mpi_send((jasnd(idx+1:idx+sz)),sz,& & psb_mpi_epk_,prcid(ip+1),& & p2ptag, icomm,iret) end if diff --git a/base/modules/penv/psi_z_collective_mod.F90 b/base/modules/penv/psi_z_collective_mod.F90 index ff5e6a2d..2149669f 100644 --- a/base/modules/penv/psi_z_collective_mod.F90 +++ b/base/modules/penv/psi_z_collective_mod.F90 @@ -32,6 +32,7 @@ module psi_z_collective_mod use psi_penv_mod use psb_desc_const_mod + use iso_c_binding interface psb_gather @@ -1463,10 +1464,10 @@ contains #ifdef MPI_H include 'mpif.h' #endif - complex(psb_dpk_), intent(in) :: valsnd(:) - integer(psb_mpk_), intent(in) :: iasnd(:), jasnd(:) - complex(psb_dpk_), intent(out) :: valrcv(:) - integer(psb_mpk_), intent(out) :: iarcv(:), jarcv(:) + complex(psb_dpk_), intent(in), target :: valsnd(:) + integer(psb_mpk_), intent(in), target :: iasnd(:), jasnd(:) + complex(psb_dpk_), intent(out), target :: valrcv(:) + integer(psb_mpk_), intent(out),target :: iarcv(:), jarcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info @@ -1493,14 +1494,14 @@ contains prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = brvindx(ip+1) p2ptag = psb_dcomplex_tag - call mpi_irecv(valrcv(idx+1:idx+sz),sz,& + call mpi_irecv((valrcv(idx+1:idx+sz)),sz,& & psb_mpi_c_dpk_,prcid(ip+1),& & p2ptag, icomm,rvhd(ip+1,1),iret) p2ptag = psb_int_swap_tag - call mpi_irecv(iarcv(idx+1:idx+sz),sz,& + call mpi_irecv((iarcv(idx+1:idx+sz)),sz,& & psb_mpi_mpk_,prcid(ip+1),& & p2ptag, icomm,rvhd(ip+1,2),iret) - call mpi_irecv(jarcv(idx+1:idx+sz),sz,& + call mpi_irecv((jarcv(idx+1:idx+sz)),sz,& & psb_mpi_mpk_,prcid(ip+1),& & p2ptag, icomm,rvhd(ip+1,3),iret) end if @@ -1513,14 +1514,14 @@ contains if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = bsdindx(ip+1) p2ptag = psb_dcomplex_tag - call mpi_send(valsnd(idx+1:idx+sz),sz,& + call mpi_send((valsnd(idx+1:idx+sz)),sz,& & psb_mpi_c_dpk_,prcid(ip+1),& & p2ptag, icomm,iret) p2ptag = psb_int_swap_tag - call mpi_send(iasnd(idx+1:idx+sz),sz,& + call mpi_send((iasnd(idx+1:idx+sz)),sz,& & psb_mpi_mpk_,prcid(ip+1),& & p2ptag, icomm,iret) - call mpi_send(jasnd(idx+1:idx+sz),sz,& + call mpi_send((jasnd(idx+1:idx+sz)),sz,& & psb_mpi_mpk_,prcid(ip+1),& & p2ptag, icomm,iret) end if @@ -1546,10 +1547,10 @@ contains #ifdef MPI_H include 'mpif.h' #endif - complex(psb_dpk_), intent(in) :: valsnd(:) - integer(psb_epk_), intent(in) :: iasnd(:), jasnd(:) - complex(psb_dpk_), intent(out) :: valrcv(:) - integer(psb_epk_), intent(out) :: iarcv(:), jarcv(:) + complex(psb_dpk_), intent(in), target :: valsnd(:) + integer(psb_epk_), intent(in), target :: iasnd(:), jasnd(:) + complex(psb_dpk_), intent(out), target :: valrcv(:) + integer(psb_epk_), intent(out), target :: iarcv(:), jarcv(:) integer(psb_mpk_), intent(in) :: bsdindx(:), brvindx(:), sdsz(:), rvsz(:) type(psb_ctxt_type), intent(in) :: ctxt integer(psb_ipk_), intent(out) :: info @@ -1576,14 +1577,14 @@ contains prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = brvindx(ip+1) p2ptag = psb_dcomplex_tag - call mpi_irecv(valrcv(idx+1:idx+sz),sz,& + call mpi_irecv((valrcv(idx+1:idx+sz)),sz,& & psb_mpi_c_dpk_,prcid(ip+1),& & p2ptag, icomm,rvhd(ip+1,1),iret) p2ptag = psb_int_swap_tag - call mpi_irecv(iarcv(idx+1:idx+sz),sz,& + call mpi_irecv((iarcv(idx+1:idx+sz)),sz,& & psb_mpi_epk_,prcid(ip+1),& & p2ptag, icomm,rvhd(ip+1,2),iret) - call mpi_irecv(jarcv(idx+1:idx+sz),sz,& + call mpi_irecv((jarcv(idx+1:idx+sz)),sz,& & psb_mpi_epk_,prcid(ip+1),& & p2ptag, icomm,rvhd(ip+1,3),iret) end if @@ -1596,14 +1597,14 @@ contains if (prcid(ip+1)<0) prcid(ip+1) = psb_get_mpi_rank(ctxt,ip) idx = bsdindx(ip+1) p2ptag = psb_dcomplex_tag - call mpi_send(valsnd(idx+1:idx+sz),sz,& + call mpi_send((valsnd(idx+1:idx+sz)),sz,& & psb_mpi_c_dpk_,prcid(ip+1),& & p2ptag, icomm,iret) p2ptag = psb_int_swap_tag - call mpi_send(iasnd(idx+1:idx+sz),sz,& + call mpi_send((iasnd(idx+1:idx+sz)),sz,& & psb_mpi_epk_,prcid(ip+1),& & p2ptag, icomm,iret) - call mpi_send(jasnd(idx+1:idx+sz),sz,& + call mpi_send((jasnd(idx+1:idx+sz)),sz,& & psb_mpi_epk_,prcid(ip+1),& & p2ptag, icomm,iret) end if diff --git a/base/modules/psb_internals.h b/base/modules/psb_internals.h index a1c31f24..61e7fa82 100644 --- a/base/modules/psb_internals.h +++ b/base/modules/psb_internals.h @@ -37,8 +37,8 @@ void mpi_gatherv(void* sdb, int* sdc, int* sdt, int* rvt, int* comm, int *root, int* ierr); void mpi_scatter(void* sdb, int* sdc, int* sdt, void* rvb, int* rvc, int* rvt, int *root, int* comm, int* ierr); -void mpi_scatterv(void* sdb, int* sdc, int* sdt, - void* rvb, int* rvc, int* rdspl, +void mpi_scatterv(void* sdb, int* sdc, int* sdspl, int* sdt, + void* rvb, int* rvc, int* rvt, int* comm, int *root, int* ierr); void mpi_allgather(void* sdb, int* sdc, int* sdt, void* rvb, int* rvc, int* rvt, int* comm, int* ierr); diff --git a/util/Makefile b/util/Makefile index 8ad3248c..96820899 100644 --- a/util/Makefile +++ b/util/Makefile @@ -27,7 +27,7 @@ OBJS=$(COBJS) $(MODOBJS) $(IMPLOBJS) LOCAL_MODS=$(MODOBJS:.o=$(.mod)) LIBNAME=$(UTILLIBNAME) FINCLUDES=$(FMFLAG). $(FMFLAG)$(MODDIR) - +CINCLUDES=-I. -I$(INCDIR) objs: $(OBJS) /bin/cp -p $(CPUPDFLAG) *$(.mod) $(MODDIR)