From 76d5c5f3ae5fc2b4ec1ff7f46cb340c3b1c72831 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Sun, 2 Feb 2020 15:24:16 +0000 Subject: [PATCH] Fixes for cases where IPK==LPK --- base/comm/psb_cspgather.F90 | 6 +-- base/comm/psb_dspgather.F90 | 6 +-- base/comm/psb_ispgather.F90 | 6 +-- base/comm/psb_lspgather.F90 | 6 +-- base/comm/psb_sspgather.F90 | 6 +-- base/comm/psb_zspgather.F90 | 6 +-- base/modules/desc/psb_gen_block_map_mod.F90 | 10 ++-- base/modules/desc/psb_glist_map_mod.f90 | 4 +- base/modules/desc/psb_hash_map_mod.f90 | 16 +++---- base/modules/desc/psb_indx_map_mod.f90 | 10 ++-- base/modules/desc/psb_list_map_mod.f90 | 8 ++-- base/modules/desc/psb_repl_map_mod.f90 | 4 +- base/modules/penv/psi_c_collective_mod.F90 | 48 ++++++++++--------- base/modules/penv/psi_d_collective_mod.F90 | 48 ++++++++++--------- base/modules/penv/psi_e_collective_mod.F90 | 48 ++++++++++--------- base/modules/penv/psi_m_collective_mod.F90 | 48 ++++++++++--------- base/modules/penv/psi_s_collective_mod.F90 | 48 ++++++++++--------- base/modules/penv/psi_z_collective_mod.F90 | 48 ++++++++++--------- base/modules/tools/psb_c_tools_mod.F90 | 2 + base/modules/tools/psb_cd_tools_mod.F90 | 4 +- base/modules/tools/psb_d_tools_mod.F90 | 2 + base/modules/tools/psb_s_tools_mod.F90 | 2 + base/modules/tools/psb_z_tools_mod.F90 | 2 + ...{psb_c_coo_impl.f90 => psb_c_coo_impl.F90} | 0 ...{psb_d_coo_impl.f90 => psb_d_coo_impl.F90} | 0 ...{psb_s_coo_impl.f90 => psb_s_coo_impl.F90} | 0 ...{psb_z_coo_impl.f90 => psb_z_coo_impl.F90} | 0 base/tools/psb_cd_inloc.f90 | 6 +-- base/tools/psb_cd_switch_ovl_indxmap.f90 | 4 +- base/tools/psb_cdall.f90 | 6 +-- base/tools/psb_cdals.f90 | 6 +-- base/tools/psb_cdalv.f90 | 8 ++-- base/tools/{psb_cdins.f90 => psb_cdins.F90} | 6 ++- base/tools/psb_cdrep.f90 | 4 +- base/tools/{psb_cspins.f90 => psb_cspins.F90} | 2 + base/tools/{psb_dspins.f90 => psb_dspins.F90} | 2 + base/tools/{psb_sspins.f90 => psb_sspins.F90} | 2 + base/tools/{psb_zspins.f90 => psb_zspins.F90} | 2 + ...sb_i_mmio_impl.f90 => psb_i_mmio_impl.F90} | 5 +- util/psb_mmio_mod.F90 | 4 ++ util/psb_partidx_mod.F90 | 1 + 41 files changed, 239 insertions(+), 207 deletions(-) rename base/serial/impl/{psb_c_coo_impl.f90 => psb_c_coo_impl.F90} (100%) rename base/serial/impl/{psb_d_coo_impl.f90 => psb_d_coo_impl.F90} (100%) rename base/serial/impl/{psb_s_coo_impl.f90 => psb_s_coo_impl.F90} (100%) rename base/serial/impl/{psb_z_coo_impl.f90 => psb_z_coo_impl.F90} (100%) rename base/tools/{psb_cdins.f90 => psb_cdins.F90} (99%) rename base/tools/{psb_cspins.f90 => psb_cspins.F90} (99%) rename base/tools/{psb_dspins.f90 => psb_dspins.F90} (99%) rename base/tools/{psb_sspins.f90 => psb_sspins.F90} (99%) rename base/tools/{psb_zspins.f90 => psb_zspins.F90} (99%) rename util/{psb_i_mmio_impl.f90 => psb_i_mmio_impl.F90} (99%) diff --git a/base/comm/psb_cspgather.F90 b/base/comm/psb_cspgather.F90 index a0855982..23ab271f 100644 --- a/base/comm/psb_cspgather.F90 +++ b/base/comm/psb_cspgather.F90 @@ -147,9 +147,9 @@ subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep if (info == psb_success_) call psb_realloc(nzg,glbja,info) if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) else - if (info == psb_success_) call psb_realloc(1,glbia,info) - if (info == psb_success_) call psb_realloc(1,glbja,info) - if (info == psb_success_) call glob_coo%allocate(1,1,1) + if (info == psb_success_) call psb_realloc(ione,glbia,info) + if (info == psb_success_) call psb_realloc(ione,glbja,info) + if (info == psb_success_) call glob_coo%allocate(ione,ione,ione) end if if (info /= psb_success_) goto 9999 diff --git a/base/comm/psb_dspgather.F90 b/base/comm/psb_dspgather.F90 index 91b1c9ba..11eedaf4 100644 --- a/base/comm/psb_dspgather.F90 +++ b/base/comm/psb_dspgather.F90 @@ -147,9 +147,9 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep if (info == psb_success_) call psb_realloc(nzg,glbja,info) if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) else - if (info == psb_success_) call psb_realloc(1,glbia,info) - if (info == psb_success_) call psb_realloc(1,glbja,info) - if (info == psb_success_) call glob_coo%allocate(1,1,1) + if (info == psb_success_) call psb_realloc(ione,glbia,info) + if (info == psb_success_) call psb_realloc(ione,glbja,info) + if (info == psb_success_) call glob_coo%allocate(ione,ione,ione) end if if (info /= psb_success_) goto 9999 diff --git a/base/comm/psb_ispgather.F90 b/base/comm/psb_ispgather.F90 index 4229e751..622641cb 100644 --- a/base/comm/psb_ispgather.F90 +++ b/base/comm/psb_ispgather.F90 @@ -147,9 +147,9 @@ subroutine psb_isp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep if (info == psb_success_) call psb_realloc(nzg,glbja,info) if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) else - if (info == psb_success_) call psb_realloc(1,glbia,info) - if (info == psb_success_) call psb_realloc(1,glbja,info) - if (info == psb_success_) call glob_coo%allocate(1,1,1) + if (info == psb_success_) call psb_realloc(ione,glbia,info) + if (info == psb_success_) call psb_realloc(ione,glbja,info) + if (info == psb_success_) call glob_coo%allocate(ione,ione,ione) end if if (info /= psb_success_) goto 9999 diff --git a/base/comm/psb_lspgather.F90 b/base/comm/psb_lspgather.F90 index d475750b..bfba8a97 100644 --- a/base/comm/psb_lspgather.F90 +++ b/base/comm/psb_lspgather.F90 @@ -147,9 +147,9 @@ subroutine psb_lsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep if (info == psb_success_) call psb_realloc(nzg,glbja,info) if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) else - if (info == psb_success_) call psb_realloc(1,glbia,info) - if (info == psb_success_) call psb_realloc(1,glbja,info) - if (info == psb_success_) call glob_coo%allocate(1,1,1) + if (info == psb_success_) call psb_realloc(ione,glbia,info) + if (info == psb_success_) call psb_realloc(ione,glbja,info) + if (info == psb_success_) call glob_coo%allocate(ione,ione,ione) end if if (info /= psb_success_) goto 9999 diff --git a/base/comm/psb_sspgather.F90 b/base/comm/psb_sspgather.F90 index 2de0e046..e25c1145 100644 --- a/base/comm/psb_sspgather.F90 +++ b/base/comm/psb_sspgather.F90 @@ -147,9 +147,9 @@ subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep if (info == psb_success_) call psb_realloc(nzg,glbja,info) if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) else - if (info == psb_success_) call psb_realloc(1,glbia,info) - if (info == psb_success_) call psb_realloc(1,glbja,info) - if (info == psb_success_) call glob_coo%allocate(1,1,1) + if (info == psb_success_) call psb_realloc(ione,glbia,info) + if (info == psb_success_) call psb_realloc(ione,glbja,info) + if (info == psb_success_) call glob_coo%allocate(ione,ione,ione) end if if (info /= psb_success_) goto 9999 diff --git a/base/comm/psb_zspgather.F90 b/base/comm/psb_zspgather.F90 index 9ed7ed6f..62a4c186 100644 --- a/base/comm/psb_zspgather.F90 +++ b/base/comm/psb_zspgather.F90 @@ -147,9 +147,9 @@ subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep if (info == psb_success_) call psb_realloc(nzg,glbja,info) if (info == psb_success_) call glob_coo%allocate(nrg,ncg,nzg) else - if (info == psb_success_) call psb_realloc(1,glbia,info) - if (info == psb_success_) call psb_realloc(1,glbja,info) - if (info == psb_success_) call glob_coo%allocate(1,1,1) + if (info == psb_success_) call psb_realloc(ione,glbia,info) + if (info == psb_success_) call psb_realloc(ione,glbja,info) + if (info == psb_success_) call glob_coo%allocate(ione,ione,ione) end if if (info /= psb_success_) goto 9999 diff --git a/base/modules/desc/psb_gen_block_map_mod.F90 b/base/modules/desc/psb_gen_block_map_mod.F90 index 255b05d1..f1953f7c 100644 --- a/base/modules/desc/psb_gen_block_map_mod.F90 +++ b/base/modules/desc/psb_gen_block_map_mod.F90 @@ -806,7 +806,7 @@ contains logical, intent(in), optional :: owned integer(psb_ipk_) :: i, nv, is integer(psb_lpk_) :: tidx, ip, lip - integer(psb_mpk_) :: ictxt, iam, np + integer(psb_ipk_) :: ictxt, iam, np logical :: owned_ info = 0 @@ -922,7 +922,7 @@ contains integer(psb_ipk_) :: i, nv, is, im integer(psb_lpk_) :: tidx, ip, lip - integer(psb_mpk_) :: ictxt, iam, np + integer(psb_ipk_) :: ictxt, iam, np logical :: owned_ info = 0 @@ -1964,11 +1964,11 @@ contains use psb_error_mod implicit none class(psb_gen_block_map), intent(inout) :: idxmap - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_ipk_), intent(in) :: nl integer(psb_ipk_), intent(out) :: info ! To be implemented - integer(psb_mpk_) :: iam, np + integer(psb_ipk_) :: iam, np integer(psb_ipk_) :: i integer(psb_lpk_) :: ntot integer(psb_lpk_), allocatable :: vnl(:) @@ -2030,7 +2030,7 @@ contains integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: nhal, i - integer(psb_mpk_) :: ictxt, iam, np + integer(psb_ipk_) :: ictxt, iam, np logical :: debug=.false. info = 0 ictxt = idxmap%get_ctxt() diff --git a/base/modules/desc/psb_glist_map_mod.f90 b/base/modules/desc/psb_glist_map_mod.f90 index 3298291a..69169b17 100644 --- a/base/modules/desc/psb_glist_map_mod.f90 +++ b/base/modules/desc/psb_glist_map_mod.f90 @@ -96,11 +96,11 @@ contains use psb_error_mod implicit none class(psb_glist_map), intent(inout) :: idxmap - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_ipk_), intent(in) :: vg(:) integer(psb_ipk_), intent(out) :: info ! To be implemented - integer(psb_mpk_) :: iam, np + integer(psb_ipk_) :: iam, np integer(psb_ipk_) :: nl integer(psb_lpk_) :: i, n diff --git a/base/modules/desc/psb_hash_map_mod.f90 b/base/modules/desc/psb_hash_map_mod.f90 index 02eff7a4..2f4e8653 100644 --- a/base/modules/desc/psb_hash_map_mod.f90 +++ b/base/modules/desc/psb_hash_map_mod.f90 @@ -805,11 +805,11 @@ contains use psb_realloc_mod implicit none class(psb_hash_map), intent(inout) :: idxmap - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_lpk_), intent(in) :: vl(:) integer(psb_ipk_), intent(out) :: info ! To be implemented - integer(psb_mpk_) :: iam, np + integer(psb_ipk_) :: iam, np integer(psb_ipk_) :: i, nlu, nl, int_err(5) integer(psb_lpk_) :: m, nrt integer(psb_lpk_), allocatable :: vlu(:) @@ -878,11 +878,11 @@ contains use psb_error_mod implicit none class(psb_hash_map), intent(inout) :: idxmap - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_ipk_), intent(in) :: vg(:) integer(psb_ipk_), intent(out) :: info ! To be implemented - integer(psb_mpk_) :: iam, np + integer(psb_ipk_) :: iam, np integer(psb_ipk_) :: i, j, nl, int_err(5) integer(psb_lpk_) :: n integer(psb_lpk_), allocatable :: vlu(:) @@ -938,12 +938,12 @@ contains use psb_realloc_mod implicit none class(psb_hash_map), intent(inout) :: idxmap - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_lpk_), intent(in) :: vlu(:), ntot integer(psb_ipk_), intent(in) :: nl integer(psb_ipk_), intent(out) :: info ! To be implemented - integer(psb_mpk_) :: iam, np + integer(psb_ipk_) :: iam, np integer(psb_ipk_) :: i, j, lc2, nlu, m, nrt,int_err(5) character(len=20), parameter :: name='hash_map_init_vlu' @@ -1522,8 +1522,6 @@ contains & call psb_hash_copy(idxmap%hash,outmap%hash,info) end subroutine hash_cpy - - subroutine hash_reinit(idxmap,info) use psb_penv_mod use psb_error_mod @@ -1534,7 +1532,7 @@ contains integer(psb_ipk_) :: err_act, nr,nc,k, nl integer(psb_lpk_) :: lk integer(psb_lpk_) :: ntot - integer(psb_mpk_) :: ictxt, me, np + integer(psb_ipk_) :: ictxt, me, np integer(psb_ipk_), allocatable :: lidx(:) integer(psb_lpk_), allocatable :: gidx(:) character(len=20) :: name='hash_reinit' diff --git a/base/modules/desc/psb_indx_map_mod.f90 b/base/modules/desc/psb_indx_map_mod.f90 index b79be471..f5aeaa4d 100644 --- a/base/modules/desc/psb_indx_map_mod.f90 +++ b/base/modules/desc/psb_indx_map_mod.f90 @@ -108,7 +108,7 @@ module psb_indx_map_mod !> State of the map integer(psb_ipk_) :: state = psb_desc_null_ !> Communication context - integer(psb_mpk_) :: ictxt = -1 + integer(psb_ipk_) :: ictxt = -1 !> MPI communicator integer(psb_mpk_) :: mpic = -1 !> Number of global rows @@ -487,7 +487,7 @@ contains function base_get_ctxt(idxmap) result(val) implicit none class(psb_indx_map), intent(in) :: idxmap - integer(psb_mpk_) :: val + integer(psb_ipk_) :: val val = idxmap%ictxt @@ -515,7 +515,7 @@ contains subroutine base_set_ctxt(idxmap,val) implicit none class(psb_indx_map), intent(inout) :: idxmap - integer(psb_mpk_), intent(in) :: val + integer(psb_ipk_), intent(in) :: val idxmap%ictxt = val end subroutine base_set_ctxt @@ -1348,7 +1348,7 @@ contains use psb_error_mod implicit none class(psb_indx_map), intent(inout) :: idxmap - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_lpk_), intent(in) :: vl(:) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: err_act @@ -1470,7 +1470,7 @@ contains integer(psb_ipk_), intent(in) :: v(:) integer(psb_ipk_), intent(out) :: info ! - integer(psb_mpk_) :: me, np + integer(psb_ipk_) :: me, np integer(psb_ipk_) :: i, j, nr, nc, nh call psb_info(idxmap%ictxt,me,np) diff --git a/base/modules/desc/psb_list_map_mod.f90 b/base/modules/desc/psb_list_map_mod.f90 index 68223682..aab2a9d4 100644 --- a/base/modules/desc/psb_list_map_mod.f90 +++ b/base/modules/desc/psb_list_map_mod.f90 @@ -1044,13 +1044,13 @@ contains use psb_error_mod implicit none class(psb_list_map), intent(inout) :: idxmap - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_ipk_), intent(in) :: vl(:) integer(psb_ipk_), intent(out) :: info ! To be implemented integer(psb_lpk_) :: nl integer(psb_lpk_), allocatable :: lvl(:) - integer(psb_mpk_) :: iam, np + integer(psb_ipk_) :: iam, np info = 0 call psb_info(ictxt,iam,np) @@ -1078,12 +1078,12 @@ contains use psb_error_mod implicit none class(psb_list_map), intent(inout) :: idxmap - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_lpk_), intent(in) :: vl(:) integer(psb_ipk_), intent(out) :: info ! To be implemented integer(psb_lpk_) :: i, ix, nl, n, nrt - integer(psb_mpk_) :: iam, np + integer(psb_ipk_) :: iam, np info = 0 call psb_info(ictxt,iam,np) diff --git a/base/modules/desc/psb_repl_map_mod.f90 b/base/modules/desc/psb_repl_map_mod.f90 index f262c8f5..7b29833b 100644 --- a/base/modules/desc/psb_repl_map_mod.f90 +++ b/base/modules/desc/psb_repl_map_mod.f90 @@ -726,10 +726,10 @@ contains implicit none class(psb_repl_map), intent(inout) :: idxmap integer(psb_lpk_), intent(in) :: nl - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_ipk_), intent(out) :: info ! To be implemented - integer(psb_mpk_) :: iam, np + integer(psb_ipk_) :: iam, np info = 0 call psb_info(ictxt,iam,np) diff --git a/base/modules/penv/psi_c_collective_mod.F90 b/base/modules/penv/psi_c_collective_mod.F90 index cfedfa95..de836d38 100644 --- a/base/modules/penv/psi_c_collective_mod.F90 +++ b/base/modules/penv/psi_c_collective_mod.F90 @@ -771,16 +771,17 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt complex(psb_spk_), intent(inout) :: dat complex(psb_spk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) - call mpi_scan(dat,dat_,1,psb_mpi_c_spk_,mpi_sum,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_scan(dat,dat_,1,psb_mpi_c_spk_,mpi_sum,icomm,minfo) dat = dat_ #endif end subroutine psb_cscan_sums @@ -794,16 +795,17 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt complex(psb_spk_), intent(inout) :: dat complex(psb_spk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: icomm, minfo #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) - call mpi_exscan(dat,dat_,1,psb_mpi_c_spk_,mpi_sum,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_exscan(dat,dat_,1,psb_mpi_c_spk_,mpi_sum,icomm,minfo) dat = dat_ #else dat = czero @@ -819,20 +821,21 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt complex(psb_spk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root + integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ complex(psb_spk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) - call psb_realloc(size(dat),dat_,iinfo) + icomm = psb_get_mpi_comm(ictxt) + call psb_realloc(size(dat),dat_,info) dat_ = dat - if (iinfo == psb_success_) & - & call mpi_scan(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_sum,ictxt,info) + if (info == psb_success_) & + & call mpi_scan(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_sum,icomm,minfo) #endif end subroutine psb_cscan_sumv @@ -845,20 +848,21 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt complex(psb_spk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root + integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ complex(psb_spk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) - call psb_realloc(size(dat),dat_,iinfo) + icomm = psb_get_mpi_comm(ictxt) + call psb_realloc(size(dat),dat_,info) dat_ = dat - if (iinfo == psb_success_) & - & call mpi_exscan(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_sum,ictxt,info) + if (info == psb_success_) & + & call mpi_exscan(dat,dat_,size(dat),psb_mpi_c_spk_,mpi_sum,icomm,minfo) #else dat = czero #endif diff --git a/base/modules/penv/psi_d_collective_mod.F90 b/base/modules/penv/psi_d_collective_mod.F90 index f226758c..eb848a9f 100644 --- a/base/modules/penv/psi_d_collective_mod.F90 +++ b/base/modules/penv/psi_d_collective_mod.F90 @@ -1262,16 +1262,17 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt real(psb_dpk_), intent(inout) :: dat real(psb_dpk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) - call mpi_scan(dat,dat_,1,psb_mpi_r_dpk_,mpi_sum,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_scan(dat,dat_,1,psb_mpi_r_dpk_,mpi_sum,icomm,minfo) dat = dat_ #endif end subroutine psb_dscan_sums @@ -1285,16 +1286,17 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt real(psb_dpk_), intent(inout) :: dat real(psb_dpk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: icomm, minfo #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) - call mpi_exscan(dat,dat_,1,psb_mpi_r_dpk_,mpi_sum,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_exscan(dat,dat_,1,psb_mpi_r_dpk_,mpi_sum,icomm,minfo) dat = dat_ #else dat = dzero @@ -1310,20 +1312,21 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt real(psb_dpk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root + integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ real(psb_dpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) - call psb_realloc(size(dat),dat_,iinfo) + icomm = psb_get_mpi_comm(ictxt) + call psb_realloc(size(dat),dat_,info) dat_ = dat - if (iinfo == psb_success_) & - & call mpi_scan(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_sum,ictxt,info) + if (info == psb_success_) & + & call mpi_scan(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_sum,icomm,minfo) #endif end subroutine psb_dscan_sumv @@ -1336,20 +1339,21 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt real(psb_dpk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root + integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ real(psb_dpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) - call psb_realloc(size(dat),dat_,iinfo) + icomm = psb_get_mpi_comm(ictxt) + call psb_realloc(size(dat),dat_,info) dat_ = dat - if (iinfo == psb_success_) & - & call mpi_exscan(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_sum,ictxt,info) + if (info == psb_success_) & + & call mpi_exscan(dat,dat_,size(dat),psb_mpi_r_dpk_,mpi_sum,icomm,minfo) #else dat = dzero #endif diff --git a/base/modules/penv/psi_e_collective_mod.F90 b/base/modules/penv/psi_e_collective_mod.F90 index 8218a1ff..4c3a006e 100644 --- a/base/modules/penv/psi_e_collective_mod.F90 +++ b/base/modules/penv/psi_e_collective_mod.F90 @@ -1139,16 +1139,17 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_epk_), intent(inout) :: dat integer(psb_epk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) - call mpi_scan(dat,dat_,1,psb_mpi_epk_,mpi_sum,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_scan(dat,dat_,1,psb_mpi_epk_,mpi_sum,icomm,minfo) dat = dat_ #endif end subroutine psb_escan_sums @@ -1162,16 +1163,17 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_epk_), intent(inout) :: dat integer(psb_epk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: icomm, minfo #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) - call mpi_exscan(dat,dat_,1,psb_mpi_epk_,mpi_sum,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_exscan(dat,dat_,1,psb_mpi_epk_,mpi_sum,icomm,minfo) dat = dat_ #else dat = ezero @@ -1187,20 +1189,21 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_epk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root + integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_epk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) - call psb_realloc(size(dat),dat_,iinfo) + icomm = psb_get_mpi_comm(ictxt) + call psb_realloc(size(dat),dat_,info) dat_ = dat - if (iinfo == psb_success_) & - & call mpi_scan(dat,dat_,size(dat),psb_mpi_epk_,mpi_sum,ictxt,info) + if (info == psb_success_) & + & call mpi_scan(dat,dat_,size(dat),psb_mpi_epk_,mpi_sum,icomm,minfo) #endif end subroutine psb_escan_sumv @@ -1213,20 +1216,21 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_epk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root + integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_epk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) - call psb_realloc(size(dat),dat_,iinfo) + icomm = psb_get_mpi_comm(ictxt) + call psb_realloc(size(dat),dat_,info) dat_ = dat - if (iinfo == psb_success_) & - & call mpi_exscan(dat,dat_,size(dat),psb_mpi_epk_,mpi_sum,ictxt,info) + if (info == psb_success_) & + & call mpi_exscan(dat,dat_,size(dat),psb_mpi_epk_,mpi_sum,icomm,minfo) #else dat = ezero #endif diff --git a/base/modules/penv/psi_m_collective_mod.F90 b/base/modules/penv/psi_m_collective_mod.F90 index e39aea60..206b15fa 100644 --- a/base/modules/penv/psi_m_collective_mod.F90 +++ b/base/modules/penv/psi_m_collective_mod.F90 @@ -1139,16 +1139,17 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_mpk_), intent(inout) :: dat integer(psb_mpk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) - call mpi_scan(dat,dat_,1,psb_mpi_mpk_,mpi_sum,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_scan(dat,dat_,1,psb_mpi_mpk_,mpi_sum,icomm,minfo) dat = dat_ #endif end subroutine psb_mscan_sums @@ -1162,16 +1163,17 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_mpk_), intent(inout) :: dat integer(psb_mpk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: icomm, minfo #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) - call mpi_exscan(dat,dat_,1,psb_mpi_mpk_,mpi_sum,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_exscan(dat,dat_,1,psb_mpi_mpk_,mpi_sum,icomm,minfo) dat = dat_ #else dat = mzero @@ -1187,20 +1189,21 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_mpk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root + integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_mpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) - call psb_realloc(size(dat),dat_,iinfo) + icomm = psb_get_mpi_comm(ictxt) + call psb_realloc(size(dat),dat_,info) dat_ = dat - if (iinfo == psb_success_) & - & call mpi_scan(dat,dat_,size(dat),psb_mpi_mpk_,mpi_sum,ictxt,info) + if (info == psb_success_) & + & call mpi_scan(dat,dat_,size(dat),psb_mpi_mpk_,mpi_sum,icomm,minfo) #endif end subroutine psb_mscan_sumv @@ -1213,20 +1216,21 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_mpk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root + integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ integer(psb_mpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) - call psb_realloc(size(dat),dat_,iinfo) + icomm = psb_get_mpi_comm(ictxt) + call psb_realloc(size(dat),dat_,info) dat_ = dat - if (iinfo == psb_success_) & - & call mpi_exscan(dat,dat_,size(dat),psb_mpi_mpk_,mpi_sum,ictxt,info) + if (info == psb_success_) & + & call mpi_exscan(dat,dat_,size(dat),psb_mpi_mpk_,mpi_sum,icomm,minfo) #else dat = mzero #endif diff --git a/base/modules/penv/psi_s_collective_mod.F90 b/base/modules/penv/psi_s_collective_mod.F90 index 8a95e2d0..eda86961 100644 --- a/base/modules/penv/psi_s_collective_mod.F90 +++ b/base/modules/penv/psi_s_collective_mod.F90 @@ -1262,16 +1262,17 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt real(psb_spk_), intent(inout) :: dat real(psb_spk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) - call mpi_scan(dat,dat_,1,psb_mpi_r_spk_,mpi_sum,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_scan(dat,dat_,1,psb_mpi_r_spk_,mpi_sum,icomm,minfo) dat = dat_ #endif end subroutine psb_sscan_sums @@ -1285,16 +1286,17 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt real(psb_spk_), intent(inout) :: dat real(psb_spk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: icomm, minfo #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) - call mpi_exscan(dat,dat_,1,psb_mpi_r_spk_,mpi_sum,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_exscan(dat,dat_,1,psb_mpi_r_spk_,mpi_sum,icomm,minfo) dat = dat_ #else dat = szero @@ -1310,20 +1312,21 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt real(psb_spk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root + integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ real(psb_spk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) - call psb_realloc(size(dat),dat_,iinfo) + icomm = psb_get_mpi_comm(ictxt) + call psb_realloc(size(dat),dat_,info) dat_ = dat - if (iinfo == psb_success_) & - & call mpi_scan(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_sum,ictxt,info) + if (info == psb_success_) & + & call mpi_scan(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_sum,icomm,minfo) #endif end subroutine psb_sscan_sumv @@ -1336,20 +1339,21 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt real(psb_spk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root + integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ real(psb_spk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) - call psb_realloc(size(dat),dat_,iinfo) + icomm = psb_get_mpi_comm(ictxt) + call psb_realloc(size(dat),dat_,info) dat_ = dat - if (iinfo == psb_success_) & - & call mpi_exscan(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_sum,ictxt,info) + if (info == psb_success_) & + & call mpi_exscan(dat,dat_,size(dat),psb_mpi_r_spk_,mpi_sum,icomm,minfo) #else dat = szero #endif diff --git a/base/modules/penv/psi_z_collective_mod.F90 b/base/modules/penv/psi_z_collective_mod.F90 index f57d9629..a517cb03 100644 --- a/base/modules/penv/psi_z_collective_mod.F90 +++ b/base/modules/penv/psi_z_collective_mod.F90 @@ -771,16 +771,17 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt complex(psb_dpk_), intent(inout) :: dat complex(psb_dpk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) - call mpi_scan(dat,dat_,1,psb_mpi_c_dpk_,mpi_sum,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_scan(dat,dat_,1,psb_mpi_c_dpk_,mpi_sum,icomm,minfo) dat = dat_ #endif end subroutine psb_zscan_sums @@ -794,16 +795,17 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt complex(psb_dpk_), intent(inout) :: dat complex(psb_dpk_) :: dat_ - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: icomm, minfo #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) - call mpi_exscan(dat,dat_,1,psb_mpi_c_dpk_,mpi_sum,ictxt,info) + icomm = psb_get_mpi_comm(ictxt) + call mpi_exscan(dat,dat_,1,psb_mpi_c_dpk_,mpi_sum,icomm,minfo) dat = dat_ #else dat = zzero @@ -819,20 +821,21 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt complex(psb_dpk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root + integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ complex(psb_dpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) - call psb_realloc(size(dat),dat_,iinfo) + icomm = psb_get_mpi_comm(ictxt) + call psb_realloc(size(dat),dat_,info) dat_ = dat - if (iinfo == psb_success_) & - & call mpi_scan(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_sum,ictxt,info) + if (info == psb_success_) & + & call mpi_scan(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_sum,icomm,minfo) #endif end subroutine psb_zscan_sumv @@ -845,20 +848,21 @@ contains #ifdef MPI_H include 'mpif.h' #endif - integer(psb_mpk_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt complex(psb_dpk_), intent(inout) :: dat(:) - integer(psb_mpk_), intent(in), optional :: root + integer(psb_ipk_), intent(in), optional :: root integer(psb_mpk_) :: root_ complex(psb_dpk_), allocatable :: dat_(:) - integer(psb_mpk_) :: iam, np, info - integer(psb_ipk_) :: iinfo + integer(psb_ipk_) :: iam, np, info + integer(psb_mpk_) :: minfo, icomm #if !defined(SERIAL_MPI) call psb_info(ictxt,iam,np) - call psb_realloc(size(dat),dat_,iinfo) + icomm = psb_get_mpi_comm(ictxt) + call psb_realloc(size(dat),dat_,info) dat_ = dat - if (iinfo == psb_success_) & - & call mpi_exscan(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_sum,ictxt,info) + if (info == psb_success_) & + & call mpi_exscan(dat,dat_,size(dat),psb_mpi_c_dpk_,mpi_sum,icomm,minfo) #else dat = zzero #endif diff --git a/base/modules/tools/psb_c_tools_mod.F90 b/base/modules/tools/psb_c_tools_mod.F90 index c843b683..9f417d63 100644 --- a/base/modules/tools/psb_c_tools_mod.F90 +++ b/base/modules/tools/psb_c_tools_mod.F90 @@ -283,6 +283,7 @@ Module psb_c_tools_mod integer(psb_ipk_), intent(out) :: info logical, intent(in), optional :: rebuild, local end subroutine psb_cspins_csr_lirp +#if defined(IPK4) && defined(LPK8) subroutine psb_cspins_csr_iirp(nr,irw,irp,ja,val,a,desc_a,info,rebuild,local) import implicit none @@ -294,6 +295,7 @@ Module psb_c_tools_mod integer(psb_ipk_), intent(out) :: info logical, intent(in), optional :: rebuild, local end subroutine psb_cspins_csr_iirp +#endif subroutine psb_cspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local) use psb_i_vect_mod, only : psb_i_vect_type import diff --git a/base/modules/tools/psb_cd_tools_mod.F90 b/base/modules/tools/psb_cd_tools_mod.F90 index 09715318..3a67d829 100644 --- a/base/modules/tools/psb_cd_tools_mod.F90 +++ b/base/modules/tools/psb_cd_tools_mod.F90 @@ -104,6 +104,7 @@ module psb_cd_tools_mod end interface interface psb_cdins +#if defined(IPK4) && defined(LPK8) subroutine psb_cdinsrc(nz,ia,ja,desc_a,info,ila,jla) import :: psb_ipk_, psb_lpk_, psb_desc_type type(psb_desc_type), intent(inout) :: desc_a @@ -122,7 +123,7 @@ module psb_cd_tools_mod logical, optional, target, intent(in) :: mask(:) integer(psb_ipk_), intent(in), optional :: lidx(:) end subroutine psb_cdinsc -#if defined(IPK4) && defined(LPK8) +#endif subroutine psb_lcdinsrc(nz,ia,ja,desc_a,info,ila,jla) import :: psb_ipk_, psb_lpk_, psb_desc_type type(psb_desc_type), intent(inout) :: desc_a @@ -141,7 +142,6 @@ module psb_cd_tools_mod logical, optional, target, intent(in) :: mask(:) integer(psb_ipk_), intent(in), optional :: lidx(:) end subroutine psb_lcdinsc -#endif end interface interface psb_cdbldext diff --git a/base/modules/tools/psb_d_tools_mod.F90 b/base/modules/tools/psb_d_tools_mod.F90 index ba1057d6..e49a4d7f 100644 --- a/base/modules/tools/psb_d_tools_mod.F90 +++ b/base/modules/tools/psb_d_tools_mod.F90 @@ -283,6 +283,7 @@ Module psb_d_tools_mod integer(psb_ipk_), intent(out) :: info logical, intent(in), optional :: rebuild, local end subroutine psb_dspins_csr_lirp +#if defined(IPK4) && defined(LPK8) subroutine psb_dspins_csr_iirp(nr,irw,irp,ja,val,a,desc_a,info,rebuild,local) import implicit none @@ -294,6 +295,7 @@ Module psb_d_tools_mod integer(psb_ipk_), intent(out) :: info logical, intent(in), optional :: rebuild, local end subroutine psb_dspins_csr_iirp +#endif subroutine psb_dspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local) use psb_i_vect_mod, only : psb_i_vect_type import diff --git a/base/modules/tools/psb_s_tools_mod.F90 b/base/modules/tools/psb_s_tools_mod.F90 index 740a7949..0383f62b 100644 --- a/base/modules/tools/psb_s_tools_mod.F90 +++ b/base/modules/tools/psb_s_tools_mod.F90 @@ -283,6 +283,7 @@ Module psb_s_tools_mod integer(psb_ipk_), intent(out) :: info logical, intent(in), optional :: rebuild, local end subroutine psb_sspins_csr_lirp +#if defined(IPK4) && defined(LPK8) subroutine psb_sspins_csr_iirp(nr,irw,irp,ja,val,a,desc_a,info,rebuild,local) import implicit none @@ -294,6 +295,7 @@ Module psb_s_tools_mod integer(psb_ipk_), intent(out) :: info logical, intent(in), optional :: rebuild, local end subroutine psb_sspins_csr_iirp +#endif subroutine psb_sspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local) use psb_i_vect_mod, only : psb_i_vect_type import diff --git a/base/modules/tools/psb_z_tools_mod.F90 b/base/modules/tools/psb_z_tools_mod.F90 index c421cb77..55455072 100644 --- a/base/modules/tools/psb_z_tools_mod.F90 +++ b/base/modules/tools/psb_z_tools_mod.F90 @@ -283,6 +283,7 @@ Module psb_z_tools_mod integer(psb_ipk_), intent(out) :: info logical, intent(in), optional :: rebuild, local end subroutine psb_zspins_csr_lirp +#if defined(IPK4) && defined(LPK8) subroutine psb_zspins_csr_iirp(nr,irw,irp,ja,val,a,desc_a,info,rebuild,local) import implicit none @@ -294,6 +295,7 @@ Module psb_z_tools_mod integer(psb_ipk_), intent(out) :: info logical, intent(in), optional :: rebuild, local end subroutine psb_zspins_csr_iirp +#endif subroutine psb_zspins_v(nz,ia,ja,val,a,desc_a,info,rebuild,local) use psb_i_vect_mod, only : psb_i_vect_type import diff --git a/base/serial/impl/psb_c_coo_impl.f90 b/base/serial/impl/psb_c_coo_impl.F90 similarity index 100% rename from base/serial/impl/psb_c_coo_impl.f90 rename to base/serial/impl/psb_c_coo_impl.F90 diff --git a/base/serial/impl/psb_d_coo_impl.f90 b/base/serial/impl/psb_d_coo_impl.F90 similarity index 100% rename from base/serial/impl/psb_d_coo_impl.f90 rename to base/serial/impl/psb_d_coo_impl.F90 diff --git a/base/serial/impl/psb_s_coo_impl.f90 b/base/serial/impl/psb_s_coo_impl.F90 similarity index 100% rename from base/serial/impl/psb_s_coo_impl.f90 rename to base/serial/impl/psb_s_coo_impl.F90 diff --git a/base/serial/impl/psb_z_coo_impl.f90 b/base/serial/impl/psb_z_coo_impl.F90 similarity index 100% rename from base/serial/impl/psb_z_coo_impl.f90 rename to base/serial/impl/psb_z_coo_impl.F90 diff --git a/base/tools/psb_cd_inloc.f90 b/base/tools/psb_cd_inloc.f90 index 1cb2c913..b4a067de 100644 --- a/base/tools/psb_cd_inloc.f90 +++ b/base/tools/psb_cd_inloc.f90 @@ -67,7 +67,6 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx,usehash) & nov(:), ov_idx(:,:), temp_ovrlap(:) integer(psb_lpk_), allocatable :: vl(:), ix(:), l_temp_ovrlap(:) integer(psb_ipk_) :: debug_level, debug_unit - integer(psb_mpk_) :: iictxt real(psb_dpk_) :: t0, t1, t2, t3, t4, t5 logical :: do_timings=.false. logical :: check_, islarge, usehash_ @@ -84,7 +83,6 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx,usehash) call psb_info(ictxt, me, np) if (debug_level >= psb_debug_ext_) & & write(debug_unit,*) me,' ',trim(name),': start',np - iictxt = ictxt if (do_timings) then call psb_barrier(ictxt) t0 = psb_wtime() @@ -388,9 +386,9 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx,usehash) select type(aa => desc%indxmap) type is (psb_repl_map) - call aa%repl_map_init(iictxt,m,info) + call aa%repl_map_init(ictxt,m,info) class default - call aa%init(iictxt,vl(1:nlu),info) + call aa%init(ictxt,vl(1:nlu),info) end select if (do_timings) then diff --git a/base/tools/psb_cd_switch_ovl_indxmap.f90 b/base/tools/psb_cd_switch_ovl_indxmap.f90 index ea8aabcf..b2bdd9e4 100644 --- a/base/tools/psb_cd_switch_ovl_indxmap.f90 +++ b/base/tools/psb_cd_switch_ovl_indxmap.f90 @@ -51,7 +51,6 @@ Subroutine psb_cd_switch_ovl_indxmap(desc,info) integer(psb_lpk_), allocatable :: vl(:) integer(psb_ipk_) :: debug_level, debug_unit, ierr(5) - integer(psb_mpk_) :: iictxt character(len=20) :: name, ch_err name='cd_switch_ovl_indxmap' @@ -66,7 +65,6 @@ Subroutine psb_cd_switch_ovl_indxmap(desc,info) If (debug_level >= psb_debug_outer_) & & Write(debug_unit,*) me,' ',trim(name),& & ': start' - iictxt = ictxt mglob = desc%get_global_rows() n_row = desc%get_local_rows() n_col = desc%get_local_cols() @@ -99,7 +97,7 @@ Subroutine psb_cd_switch_ovl_indxmap(desc,info) end if if (info == psb_success_)& - & call desc%indxmap%init(iictxt,vl(1:n_row),info) + & call desc%indxmap%init(ictxt,vl(1:n_row),info) if (info == psb_success_) call psb_cd_set_bld(desc,info) if (info == psb_success_) & & call desc%indxmap%g2lip_ins(vl(n_row+1:n_col),info) diff --git a/base/tools/psb_cdall.f90 b/base/tools/psb_cdall.f90 index 0f0ec813..15ce572f 100644 --- a/base/tools/psb_cdall.f90 +++ b/base/tools/psb_cdall.f90 @@ -57,7 +57,6 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl,globalchec logical :: usehash_ integer(psb_ipk_), allocatable :: itmpv(:) integer(psb_lpk_), allocatable :: lvl(:) - integer(psb_mpk_) :: iictxt @@ -67,7 +66,6 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl,globalchec call psb_erractionsave(err_act) call psb_info(ictxt, me, np) - iictxt = ictxt if (count((/ present(vg),present(vl),& & present(parts),present(nl), present(repl) /)) /= 1) then info=psb_err_no_optional_arg_ @@ -159,9 +157,9 @@ subroutine psb_cdall(ictxt, desc, info,mg,ng,parts,vg,vl,flag,nl,repl,globalchec select type(aa => desc%indxmap) type is (psb_repl_map) n_ = nl - call aa%repl_map_init(iictxt,n_,info) + call aa%repl_map_init(ictxt,n_,info) type is (psb_gen_block_map) - call aa%gen_block_map_init(iictxt,nl,info) + call aa%gen_block_map_init(ictxt,nl,info) class default ! This cannot happen info = psb_err_internal_error_ diff --git a/base/tools/psb_cdals.f90 b/base/tools/psb_cdals.f90 index dc8a2873..dfee4113 100644 --- a/base/tools/psb_cdals.f90 +++ b/base/tools/psb_cdals.f90 @@ -67,7 +67,6 @@ subroutine psb_cdals(m, n, parts, ictxt, desc, info) integer(psb_ipk_), allocatable :: prc_v(:) integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: me, np, nprocs - integer(psb_mpk_) :: iictxt character(len=20) :: name if(psb_get_errstatus() /= 0) return @@ -239,12 +238,11 @@ subroutine psb_cdals(m, n, parts, ictxt, desc, info) if (debug_level >= psb_debug_ext_) & & write(debug_unit,*) me,' ',trim(name),': End main loop:' ,loc_row,itmpov,info - iictxt = ictxt select type(aa => desc%indxmap) type is (psb_repl_map) - call aa%repl_map_init(iictxt,m,info) + call aa%repl_map_init(ictxt,m,info) class default - call aa%init(iictxt,loc_idx(1:k),info) + call aa%init(ictxt,loc_idx(1:k),info) end select diff --git a/base/tools/psb_cdalv.f90 b/base/tools/psb_cdalv.f90 index 1e433eaa..8b850f6b 100644 --- a/base/tools/psb_cdalv.f90 +++ b/base/tools/psb_cdalv.f90 @@ -64,7 +64,6 @@ subroutine psb_cdalv(v, ictxt, desc, info, flag) integer(psb_lpk_) :: l_err(5) integer(psb_ipk_), allocatable :: temp_ovrlap(:) integer(psb_ipk_) :: debug_level, debug_unit - integer(psb_mpk_) :: iictxt character(len=20) :: name if(psb_get_errstatus() /= 0) return @@ -77,7 +76,6 @@ subroutine psb_cdalv(v, ictxt, desc, info, flag) call psb_info(ictxt, me, np) if (debug_level >= psb_debug_ext_) & & write(debug_unit,*) me,' ',trim(name),': ',np,me - iictxt = ictxt m = size(v) n = m !... check m and n parameters.... @@ -192,11 +190,11 @@ subroutine psb_cdalv(v, ictxt, desc, info, flag) select type(aa => desc%indxmap) type is (psb_repl_map) - call aa%repl_map_init(iictxt,m,info) + call aa%repl_map_init(ictxt,m,info) type is (psb_hash_map) - call aa%hash_map_init(iictxt,v,info) + call aa%hash_map_init(ictxt,v,info) type is (psb_glist_map) - call aa%glist_map_init(iictxt,v,info) + call aa%glist_map_init(ictxt,v,info) class default ! This cannot happen info = psb_err_internal_error_ diff --git a/base/tools/psb_cdins.f90 b/base/tools/psb_cdins.F90 similarity index 99% rename from base/tools/psb_cdins.f90 rename to base/tools/psb_cdins.F90 index 5e219296..d1b186f9 100644 --- a/base/tools/psb_cdins.f90 +++ b/base/tools/psb_cdins.F90 @@ -45,6 +45,7 @@ ! ila(:) - integer(psb_ipk_), optional The row indices in local numbering ! jla(:) - integer(psb_ipk_), optional The col indices in local numbering ! +#if defined(IPK4) && defined(LPK8) subroutine psb_cdinsrc(nz,ia,ja,desc_a,info,ila,jla) use psb_base_mod, psb_protect_name => psb_cdinsrc use psi_mod @@ -61,7 +62,7 @@ subroutine psb_cdinsrc(nz,ia,ja,desc_a,info,ila,jla) lnz = nz call psb_cdins(lnz,ia,ja,desc_a,info,ila,jla) end subroutine psb_cdinsrc - +#endif subroutine psb_lcdinsrc(nz,ia,ja,desc_a,info,ila,jla) use psb_base_mod, psb_protect_name => psb_lcdinsrc use psi_mod @@ -180,6 +181,7 @@ end subroutine psb_lcdinsrc ! mask(:) - logical, optional, target ! lidx(:) - integer(psb_ipk_), optional User-defined local col indices ! +#if defined(IPK4) && defined(LPK8) subroutine psb_cdinsc(nz,ja,desc,info,jla,mask,lidx) use psb_base_mod, psb_protect_name => psb_cdinsc use psi_mod @@ -199,7 +201,7 @@ subroutine psb_cdinsc(nz,ja,desc,info,jla,mask,lidx) lnz = nz call psb_cdins(lnz,ja,desc,info,jla,mask,lidx) end subroutine psb_cdinsc - +#endif subroutine psb_lcdinsc(nz,ja,desc,info,jla,mask,lidx) use psb_base_mod, psb_protect_name => psb_lcdinsc use psi_mod diff --git a/base/tools/psb_cdrep.f90 b/base/tools/psb_cdrep.f90 index 61f0ac2a..2ba47c2c 100644 --- a/base/tools/psb_cdrep.f90 +++ b/base/tools/psb_cdrep.f90 @@ -118,7 +118,6 @@ subroutine psb_cdrep(m, ictxt, desc, info) integer(psb_lpk_) :: l_err(5),exch(2) integer(psb_ipk_) :: thalo(1), tovr(1), text(1) integer(psb_ipk_) :: debug_level, debug_unit - integer(psb_mpk_) :: iictxt character(len=20) :: name if(psb_get_errstatus() /= 0) return @@ -131,7 +130,6 @@ subroutine psb_cdrep(m, ictxt, desc, info) call psb_info(ictxt, me, np) if (debug_level >= psb_debug_ext_) & & write(debug_unit,*) me,' ',trim(name),': ',np - iictxt = ictxt n = m !... check m and n parameters.... if (m < 1) then @@ -182,7 +180,7 @@ subroutine psb_cdrep(m, ictxt, desc, info) allocate(psb_repl_map :: desc%indxmap, stat=info) select type(aa => desc%indxmap) type is (psb_repl_map) - call aa%repl_map_init(iictxt,m,info) + call aa%repl_map_init(ictxt,m,info) class default ! This cannot happen info = psb_err_internal_error_ diff --git a/base/tools/psb_cspins.f90 b/base/tools/psb_cspins.F90 similarity index 99% rename from base/tools/psb_cspins.f90 rename to base/tools/psb_cspins.F90 index c17c1409..c2a52eb3 100644 --- a/base/tools/psb_cspins.f90 +++ b/base/tools/psb_cspins.F90 @@ -288,6 +288,7 @@ subroutine psb_cspins_csr_lirp(nr,irp,ja,val,irw,a,desc_a,info,rebuild,local) end subroutine psb_cspins_csr_lirp +#if defined(IPK4) && defined(LPK8) subroutine psb_cspins_csr_iirp(nr,irw,irp,ja,val,a,desc_a,info,rebuild,local) use psb_base_mod, psb_protect_name => psb_cspins_csr_iirp use psi_mod @@ -384,6 +385,7 @@ subroutine psb_cspins_csr_iirp(nr,irw,irp,ja,val,a,desc_a,info,rebuild,local) return end subroutine psb_cspins_csr_iirp +#endif subroutine psb_cspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) use psb_base_mod, psb_protect_name => psb_cspins_2desc diff --git a/base/tools/psb_dspins.f90 b/base/tools/psb_dspins.F90 similarity index 99% rename from base/tools/psb_dspins.f90 rename to base/tools/psb_dspins.F90 index b774358b..4018a36a 100644 --- a/base/tools/psb_dspins.f90 +++ b/base/tools/psb_dspins.F90 @@ -288,6 +288,7 @@ subroutine psb_dspins_csr_lirp(nr,irp,ja,val,irw,a,desc_a,info,rebuild,local) end subroutine psb_dspins_csr_lirp +#if defined(IPK4) && defined(LPK8) subroutine psb_dspins_csr_iirp(nr,irw,irp,ja,val,a,desc_a,info,rebuild,local) use psb_base_mod, psb_protect_name => psb_dspins_csr_iirp use psi_mod @@ -384,6 +385,7 @@ subroutine psb_dspins_csr_iirp(nr,irw,irp,ja,val,a,desc_a,info,rebuild,local) return end subroutine psb_dspins_csr_iirp +#endif subroutine psb_dspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) use psb_base_mod, psb_protect_name => psb_dspins_2desc diff --git a/base/tools/psb_sspins.f90 b/base/tools/psb_sspins.F90 similarity index 99% rename from base/tools/psb_sspins.f90 rename to base/tools/psb_sspins.F90 index e1cea619..7a86e559 100644 --- a/base/tools/psb_sspins.f90 +++ b/base/tools/psb_sspins.F90 @@ -288,6 +288,7 @@ subroutine psb_sspins_csr_lirp(nr,irp,ja,val,irw,a,desc_a,info,rebuild,local) end subroutine psb_sspins_csr_lirp +#if defined(IPK4) && defined(LPK8) subroutine psb_sspins_csr_iirp(nr,irw,irp,ja,val,a,desc_a,info,rebuild,local) use psb_base_mod, psb_protect_name => psb_sspins_csr_iirp use psi_mod @@ -384,6 +385,7 @@ subroutine psb_sspins_csr_iirp(nr,irw,irp,ja,val,a,desc_a,info,rebuild,local) return end subroutine psb_sspins_csr_iirp +#endif subroutine psb_sspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) use psb_base_mod, psb_protect_name => psb_sspins_2desc diff --git a/base/tools/psb_zspins.f90 b/base/tools/psb_zspins.F90 similarity index 99% rename from base/tools/psb_zspins.f90 rename to base/tools/psb_zspins.F90 index f7129ce5..6926bdc0 100644 --- a/base/tools/psb_zspins.f90 +++ b/base/tools/psb_zspins.F90 @@ -288,6 +288,7 @@ subroutine psb_zspins_csr_lirp(nr,irp,ja,val,irw,a,desc_a,info,rebuild,local) end subroutine psb_zspins_csr_lirp +#if defined(IPK4) && defined(LPK8) subroutine psb_zspins_csr_iirp(nr,irw,irp,ja,val,a,desc_a,info,rebuild,local) use psb_base_mod, psb_protect_name => psb_zspins_csr_iirp use psi_mod @@ -384,6 +385,7 @@ subroutine psb_zspins_csr_iirp(nr,irw,irp,ja,val,a,desc_a,info,rebuild,local) return end subroutine psb_zspins_csr_iirp +#endif subroutine psb_zspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) use psb_base_mod, psb_protect_name => psb_zspins_2desc diff --git a/util/psb_i_mmio_impl.f90 b/util/psb_i_mmio_impl.F90 similarity index 99% rename from util/psb_i_mmio_impl.f90 rename to util/psb_i_mmio_impl.F90 index 9a071721..6d7367b5 100644 --- a/util/psb_i_mmio_impl.f90 +++ b/util/psb_i_mmio_impl.F90 @@ -284,8 +284,7 @@ subroutine mm_ivet1_write(b, header, info, iunit, filename) end subroutine mm_ivet1_write - - +#if defined(IPK4) && defined(LPK8) subroutine mm_lvet_read(b, info, iunit, filename) use psb_base_mod implicit none @@ -536,4 +535,4 @@ subroutine mm_lvet1_write(b, header, info, iunit, filename) end subroutine mm_lvet1_write - +#endif diff --git a/util/psb_mmio_mod.F90 b/util/psb_mmio_mod.F90 index 71fa53b7..d02b514b 100644 --- a/util/psb_mmio_mod.F90 +++ b/util/psb_mmio_mod.F90 @@ -125,6 +125,7 @@ module psb_mmio_mod integer(psb_ipk_), optional, intent(in) :: iunit character(len=*), optional, intent(in) :: filename end subroutine mm_ivet2_read +#if defined(IPK4) && defined(LPK8) subroutine mm_lvet_read(b, info, iunit, filename) import :: psb_dpk_, psb_ipk_, psb_lpk_ implicit none @@ -141,6 +142,7 @@ module psb_mmio_mod integer(psb_ipk_), optional, intent(in) :: iunit character(len=*), optional, intent(in) :: filename end subroutine mm_lvet2_read +#endif end interface @@ -244,6 +246,7 @@ module psb_mmio_mod integer(psb_ipk_), optional, intent(in) :: iunit character(len=*), optional, intent(in) :: filename end subroutine mm_ivet1_write +#if defined(IPK4) && defined(LPK8) subroutine mm_lvet2_write(b, header, info, iunit, filename) import :: psb_dpk_, psb_ipk_, psb_lpk_ implicit none @@ -262,6 +265,7 @@ module psb_mmio_mod integer(psb_ipk_), optional, intent(in) :: iunit character(len=*), optional, intent(in) :: filename end subroutine mm_lvet1_write +#endif end interface #if ! defined(HAVE_BUGGY_GENERICS) diff --git a/util/psb_partidx_mod.F90 b/util/psb_partidx_mod.F90 index 0bf67aed..08fee380 100644 --- a/util/psb_partidx_mod.F90 +++ b/util/psb_partidx_mod.F90 @@ -47,6 +47,7 @@ module psb_partidx_mod interface ijk2idx module procedure ijk2idx3d, ijk2idxv, ijk2idx2d end interface ijk2idx + interface idx2ijk module procedure lidx2ijk3d, lidx2ijkv, lidx2ijk2d,& & lidx2lijk3d, lidx2lijkv, lidx2lijk2d