diff --git a/base/modules/Makefile b/base/modules/Makefile index c4c810312..92bb7fb39 100644 --- a/base/modules/Makefile +++ b/base/modules/Makefile @@ -413,10 +413,10 @@ tools/psb_c_tools_a_mod.o tools/psb_z_tools_a_mod.o: desc/psb_desc_mod.o psi_mod tools/psb_i_tools_mod.o: serial/psb_i_vect_mod.o tools/psb_m_tools_a_mod.o tools/psb_e_tools_a_mod.o tools/psb_l_tools_mod.o: serial/psb_l_vect_mod.o tools/psb_m_tools_a_mod.o tools/psb_e_tools_a_mod.o -tools/psb_s_tools_mod.o: serial/psb_s_vect_mod.o -tools/psb_d_tools_mod.o: serial/psb_d_vect_mod.o -tools/psb_c_tools_mod.o: serial/psb_c_vect_mod.o -tools/psb_z_tools_mod.o: serial/psb_z_vect_mod.o +tools/psb_s_tools_mod.o: serial/psb_s_vect_mod.o comm/psb_s_linmap_mod.o +tools/psb_d_tools_mod.o: serial/psb_d_vect_mod.o comm/psb_d_linmap_mod.o +tools/psb_c_tools_mod.o: serial/psb_c_vect_mod.o comm/psb_c_linmap_mod.o +tools/psb_z_tools_mod.o: serial/psb_z_vect_mod.o comm/psb_z_linmap_mod.o psblas/psb_s_psblas_mod.o: serial/psb_s_vect_mod.o serial/psb_s_mat_mod.o psblas/psb_d_psblas_mod.o: serial/psb_d_vect_mod.o serial/psb_d_mat_mod.o diff --git a/base/modules/comm/psb_base_linmap_mod.f90 b/base/modules/comm/psb_base_linmap_mod.f90 index aeb3822a3..c85094aa4 100644 --- a/base/modules/comm/psb_base_linmap_mod.f90 +++ b/base/modules/comm/psb_base_linmap_mod.f90 @@ -57,6 +57,10 @@ module psb_base_linmap_mod procedure, pass(map) :: set_kind => base_set_kind procedure, pass(map) :: free => base_free procedure, pass(map) :: clone => base_clone + procedure, pass(map) :: set_pU => base_set_pU + procedure, pass(map) :: set_pV => base_set_pV + procedure, pass(map) :: get_pU => base_get_pU + procedure, pass(map) :: get_pV => base_get_pV end type psb_base_linmap_type @@ -134,8 +138,13 @@ contains if (.not.associated(map%p_desc_U)) return if (.not.associated(map%p_desc_V)) return res = map%p_desc_U%is_asb().and.map%p_desc_V%is_asb() +!!$ write(0,*) 'map_aggr ',map%p_desc_U%is_asb(),map%p_desc_V%is_asb() case(psb_map_gen_linear_) - res = map%desc_U%is_asb().and.map%desc_V%is_asb() + res = map%desc_U%is_asb().and.map%desc_V%is_asb() +!!$ write(0,*) 'map_gen_linear ',map%desc_U%is_asb(),map%desc_V%is_asb() + case default + write(0,*) 'Unknown map kind ',map%get_kind(),& + & psb_map_aggr_, psb_map_gen_linear_ end select end function base_is_asb @@ -221,7 +230,42 @@ contains if (map%desc_V%is_ok()) call map%desc_V%free(info) end subroutine base_free - + + subroutine base_set_pU(map,desc) + implicit none + class(psb_base_linmap_type) :: map + type(psb_desc_type), target :: desc + + map%p_desc_U => desc + + end subroutine base_set_pU + + subroutine base_set_pV(map,desc) + implicit none + class(psb_base_linmap_type) :: map + type(psb_desc_type), target :: desc + + map%p_desc_V => desc + + end subroutine base_set_pV + + function base_get_pU(map) result(desc) + implicit none + class(psb_base_linmap_type) :: map + type(psb_desc_type), pointer :: desc + + desc => map%p_desc_U + + end function base_get_pU + + function base_get_pV(map) result(desc) + implicit none + class(psb_base_linmap_type) :: map + type(psb_desc_type), pointer :: desc + + desc => map%p_desc_V + + end function base_get_pV end module psb_base_linmap_mod diff --git a/base/modules/tools/psb_c_tools_mod.F90 b/base/modules/tools/psb_c_tools_mod.F90 index 148ddf59f..c51fc97d4 100644 --- a/base/modules/tools/psb_c_tools_mod.F90 +++ b/base/modules/tools/psb_c_tools_mod.F90 @@ -36,9 +36,10 @@ Module psb_c_tools_mod & psb_lc_csr_sparse_mat, psb_lc_coo_sparse_mat, & & psb_c_csr_sparse_mat, psb_c_coo_sparse_mat use psb_l_vect_mod, only : psb_l_vect_type + use psb_c_linmap_mod, only : psb_clinmap_type use psb_c_multivect_mod, only : psb_c_base_multivect_type, psb_c_multivect_type use psi_mod, only : psb_snd, psb_rcv ! Needed only for psb_getelem - + interface psb_geall subroutine psb_calloc_vect(x, desc_a,info, dupl, bldmode) import @@ -469,6 +470,16 @@ Module psb_c_tools_mod integer(psb_ipk_), allocatable, intent(out) :: isrc(:), nrsrc(:), naggr(:) integer(psb_ipk_), intent(out) :: info end subroutine psb_c_remap + subroutine psb_c_remap2(map_in, desc_new, map_out, flag, info) + import + implicit none + !....parameters... + type(psb_desc_type), intent(inout) :: desc_new + type(psb_clinmap_type), intent(inout) :: map_in + type(psb_clinmap_type), intent(out) :: map_out + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info + end subroutine psb_c_remap2 end interface psb_remap end module psb_c_tools_mod diff --git a/base/modules/tools/psb_d_tools_mod.F90 b/base/modules/tools/psb_d_tools_mod.F90 index 97f70fc13..048beefe6 100644 --- a/base/modules/tools/psb_d_tools_mod.F90 +++ b/base/modules/tools/psb_d_tools_mod.F90 @@ -36,9 +36,10 @@ Module psb_d_tools_mod & psb_ld_csr_sparse_mat, psb_ld_coo_sparse_mat, & & psb_d_csr_sparse_mat, psb_d_coo_sparse_mat use psb_l_vect_mod, only : psb_l_vect_type + use psb_d_linmap_mod, only : psb_dlinmap_type use psb_d_multivect_mod, only : psb_d_base_multivect_type, psb_d_multivect_type use psi_mod, only : psb_snd, psb_rcv ! Needed only for psb_getelem - + interface psb_geall subroutine psb_dalloc_vect(x, desc_a,info, dupl, bldmode) import @@ -469,6 +470,16 @@ Module psb_d_tools_mod integer(psb_ipk_), allocatable, intent(out) :: isrc(:), nrsrc(:), naggr(:) integer(psb_ipk_), intent(out) :: info end subroutine psb_d_remap + subroutine psb_d_remap2(map_in, desc_new, map_out, flag, info) + import + implicit none + !....parameters... + type(psb_desc_type), intent(inout) :: desc_new + type(psb_dlinmap_type), intent(inout) :: map_in + type(psb_dlinmap_type), intent(out) :: map_out + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info + end subroutine psb_d_remap2 end interface psb_remap end module psb_d_tools_mod diff --git a/base/modules/tools/psb_i_tools_mod.F90 b/base/modules/tools/psb_i_tools_mod.F90 index 28899c9fe..e1b3b0d93 100644 --- a/base/modules/tools/psb_i_tools_mod.F90 +++ b/base/modules/tools/psb_i_tools_mod.F90 @@ -37,7 +37,7 @@ Module psb_i_tools_mod use psb_l_vect_mod, only : psb_l_vect_type use psb_i_multivect_mod, only : psb_i_base_multivect_type, psb_i_multivect_type use psi_mod, only : psb_snd, psb_rcv ! Needed only for psb_getelem - + interface psb_geall subroutine psb_ialloc_vect(x, desc_a,info, dupl, bldmode) import diff --git a/base/modules/tools/psb_l_tools_mod.F90 b/base/modules/tools/psb_l_tools_mod.F90 index 078f06dc7..07fbbb98e 100644 --- a/base/modules/tools/psb_l_tools_mod.F90 +++ b/base/modules/tools/psb_l_tools_mod.F90 @@ -37,7 +37,7 @@ Module psb_l_tools_mod ! use psb_i_vect_mod, only : psb_i_vect_type use psb_l_multivect_mod, only : psb_l_base_multivect_type, psb_l_multivect_type use psi_mod, only : psb_snd, psb_rcv ! Needed only for psb_getelem - + interface psb_geall subroutine psb_lalloc_vect(x, desc_a,info, dupl, bldmode) import diff --git a/base/modules/tools/psb_s_tools_mod.F90 b/base/modules/tools/psb_s_tools_mod.F90 index c87607bc9..e8f4397a3 100644 --- a/base/modules/tools/psb_s_tools_mod.F90 +++ b/base/modules/tools/psb_s_tools_mod.F90 @@ -36,9 +36,10 @@ Module psb_s_tools_mod & psb_ls_csr_sparse_mat, psb_ls_coo_sparse_mat, & & psb_s_csr_sparse_mat, psb_s_coo_sparse_mat use psb_l_vect_mod, only : psb_l_vect_type + use psb_s_linmap_mod, only : psb_slinmap_type use psb_s_multivect_mod, only : psb_s_base_multivect_type, psb_s_multivect_type use psi_mod, only : psb_snd, psb_rcv ! Needed only for psb_getelem - + interface psb_geall subroutine psb_salloc_vect(x, desc_a,info, dupl, bldmode) import @@ -469,6 +470,16 @@ Module psb_s_tools_mod integer(psb_ipk_), allocatable, intent(out) :: isrc(:), nrsrc(:), naggr(:) integer(psb_ipk_), intent(out) :: info end subroutine psb_s_remap + subroutine psb_s_remap2(map_in, desc_new, map_out, flag, info) + import + implicit none + !....parameters... + type(psb_desc_type), intent(inout) :: desc_new + type(psb_slinmap_type), intent(inout) :: map_in + type(psb_slinmap_type), intent(out) :: map_out + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info + end subroutine psb_s_remap2 end interface psb_remap end module psb_s_tools_mod diff --git a/base/modules/tools/psb_z_tools_mod.F90 b/base/modules/tools/psb_z_tools_mod.F90 index 8a6c2d34c..e48ce1cf0 100644 --- a/base/modules/tools/psb_z_tools_mod.F90 +++ b/base/modules/tools/psb_z_tools_mod.F90 @@ -36,9 +36,10 @@ Module psb_z_tools_mod & psb_lz_csr_sparse_mat, psb_lz_coo_sparse_mat, & & psb_z_csr_sparse_mat, psb_z_coo_sparse_mat use psb_l_vect_mod, only : psb_l_vect_type + use psb_z_linmap_mod, only : psb_zlinmap_type use psb_z_multivect_mod, only : psb_z_base_multivect_type, psb_z_multivect_type use psi_mod, only : psb_snd, psb_rcv ! Needed only for psb_getelem - + interface psb_geall subroutine psb_zalloc_vect(x, desc_a,info, dupl, bldmode) import @@ -469,6 +470,16 @@ Module psb_z_tools_mod integer(psb_ipk_), allocatable, intent(out) :: isrc(:), nrsrc(:), naggr(:) integer(psb_ipk_), intent(out) :: info end subroutine psb_z_remap + subroutine psb_z_remap2(map_in, desc_new, map_out, flag, info) + import + implicit none + !....parameters... + type(psb_desc_type), intent(inout) :: desc_new + type(psb_zlinmap_type), intent(inout) :: map_in + type(psb_zlinmap_type), intent(out) :: map_out + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info + end subroutine psb_z_remap2 end interface psb_remap end module psb_z_tools_mod diff --git a/base/tools/psb_c_map.f90 b/base/tools/psb_c_map.f90 index dd027563d..49f061987 100644 --- a/base/tools/psb_c_map.f90 +++ b/base/tools/psb_c_map.f90 @@ -56,9 +56,19 @@ subroutine psb_c_map_U2V_a(alpha,x,beta,y,map,info,work) character(len=20), parameter :: name='psb_map_U2V' info = psb_success_ - if (.not.map%is_asb()) then - write(psb_err_unit,*) trim(name),' Invalid map input: unassembled' - info = 1 + if (.not.map%is_asb()) then + block + integer(psb_ipk_) :: meu,npu,mev,npv + type(psb_ctxt_type) :: ct + ct = map%p_desc_u%get_context() + call psb_info(ct,meu,npu) + ct = map%p_desc_v%get_context() + call psb_info(ct,mev,npv) + + write(psb_err_unit,*) trim(name),' Invalid map input: unassembled',& + & ':',meu,npu,mev,npv + info = 1 + end block return end if @@ -132,7 +142,17 @@ subroutine psb_c_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) info = psb_success_ if (.not.map%is_asb()) then - write(psb_err_unit,*) trim(name),' Invalid map input: unassembled' + block + integer(psb_ipk_) :: meu,npu,mev,npv + type(psb_ctxt_type) :: ct + ct = map%p_desc_u%get_context() + call psb_info(ct,meu,npu) + ct = map%p_desc_v%get_context() + call psb_info(ct,mev,npv) + + write(psb_err_unit,*) trim(name),' Invalid map input: unassembled',& + & ':',meu,npu,mev,npv + end block info = 1 return end if diff --git a/base/tools/psb_c_remap.F90 b/base/tools/psb_c_remap.F90 index 9b40dd29c..e5ccd9a04 100644 --- a/base/tools/psb_c_remap.F90 +++ b/base/tools/psb_c_remap.F90 @@ -86,7 +86,6 @@ subroutine psb_c_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, & endif !!$ write(0,*) ' Remapping from ',np,' onto ', np_remap - mipd = ipd if (desc_in%get_fmt() == 'BLOCK') then ! ! Should we spread the processes in the new context, @@ -121,7 +120,7 @@ subroutine psb_c_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, & goto 9999 endif if (rnp >= np) then - write(0,*) ' No remapping on larger proc count now' + write(0,*) ' No remapping on larger proc count now',rnp,np info = psb_err_internal_error_ call psb_errpush(info,name) goto 9999 @@ -245,6 +244,7 @@ subroutine psb_c_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, & else naggr(me+1) = 0 end if + ipd = mipd call psb_sum(ctxt,naggr) end block @@ -257,3 +257,16 @@ subroutine psb_c_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, & return end subroutine psb_c_remap +subroutine psb_c_remap2(map_in, desc_new, map_out, flag, info) + + use psb_base_mod, psb_protect_name => psb_c_remap2 + + implicit none + !....parameters... + type(psb_desc_type), intent(inout) :: desc_new + type(psb_clinmap_type), intent(inout) :: map_in + type(psb_clinmap_type), intent(out) :: map_out + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info + +end subroutine psb_c_remap2 diff --git a/base/tools/psb_d_map.f90 b/base/tools/psb_d_map.f90 index 707ab9a8b..a5d934d4f 100644 --- a/base/tools/psb_d_map.f90 +++ b/base/tools/psb_d_map.f90 @@ -56,9 +56,19 @@ subroutine psb_d_map_U2V_a(alpha,x,beta,y,map,info,work) character(len=20), parameter :: name='psb_map_U2V' info = psb_success_ - if (.not.map%is_asb()) then - write(psb_err_unit,*) trim(name),' Invalid map input: unassembled' - info = 1 + if (.not.map%is_asb()) then + block + integer(psb_ipk_) :: meu,npu,mev,npv + type(psb_ctxt_type) :: ct + ct = map%p_desc_u%get_context() + call psb_info(ct,meu,npu) + ct = map%p_desc_v%get_context() + call psb_info(ct,mev,npv) + + write(psb_err_unit,*) trim(name),' Invalid map input: unassembled',& + & ':',meu,npu,mev,npv + info = 1 + end block return end if @@ -132,7 +142,17 @@ subroutine psb_d_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) info = psb_success_ if (.not.map%is_asb()) then - write(psb_err_unit,*) trim(name),' Invalid map input: unassembled' + block + integer(psb_ipk_) :: meu,npu,mev,npv + type(psb_ctxt_type) :: ct + ct = map%p_desc_u%get_context() + call psb_info(ct,meu,npu) + ct = map%p_desc_v%get_context() + call psb_info(ct,mev,npv) + + write(psb_err_unit,*) trim(name),' Invalid map input: unassembled',& + & ':',meu,npu,mev,npv + end block info = 1 return end if diff --git a/base/tools/psb_d_remap.F90 b/base/tools/psb_d_remap.F90 index a2c9c291f..fb2ce2754 100644 --- a/base/tools/psb_d_remap.F90 +++ b/base/tools/psb_d_remap.F90 @@ -86,7 +86,6 @@ subroutine psb_d_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, & endif !!$ write(0,*) ' Remapping from ',np,' onto ', np_remap - mipd = ipd if (desc_in%get_fmt() == 'BLOCK') then ! ! Should we spread the processes in the new context, @@ -121,7 +120,7 @@ subroutine psb_d_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, & goto 9999 endif if (rnp >= np) then - write(0,*) ' No remapping on larger proc count now' + write(0,*) ' No remapping on larger proc count now',rnp,np info = psb_err_internal_error_ call psb_errpush(info,name) goto 9999 @@ -245,6 +244,7 @@ subroutine psb_d_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, & else naggr(me+1) = 0 end if + ipd = mipd call psb_sum(ctxt,naggr) end block @@ -257,3 +257,16 @@ subroutine psb_d_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, & return end subroutine psb_d_remap +subroutine psb_d_remap2(map_in, desc_new, map_out, flag, info) + + use psb_base_mod, psb_protect_name => psb_d_remap2 + + implicit none + !....parameters... + type(psb_desc_type), intent(inout) :: desc_new + type(psb_dlinmap_type), intent(inout) :: map_in + type(psb_dlinmap_type), intent(out) :: map_out + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info + +end subroutine psb_d_remap2 diff --git a/base/tools/psb_s_map.f90 b/base/tools/psb_s_map.f90 index 1a4469e01..e78e5631d 100644 --- a/base/tools/psb_s_map.f90 +++ b/base/tools/psb_s_map.f90 @@ -56,9 +56,19 @@ subroutine psb_s_map_U2V_a(alpha,x,beta,y,map,info,work) character(len=20), parameter :: name='psb_map_U2V' info = psb_success_ - if (.not.map%is_asb()) then - write(psb_err_unit,*) trim(name),' Invalid map input: unassembled' - info = 1 + if (.not.map%is_asb()) then + block + integer(psb_ipk_) :: meu,npu,mev,npv + type(psb_ctxt_type) :: ct + ct = map%p_desc_u%get_context() + call psb_info(ct,meu,npu) + ct = map%p_desc_v%get_context() + call psb_info(ct,mev,npv) + + write(psb_err_unit,*) trim(name),' Invalid map input: unassembled',& + & ':',meu,npu,mev,npv + info = 1 + end block return end if @@ -132,7 +142,17 @@ subroutine psb_s_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) info = psb_success_ if (.not.map%is_asb()) then - write(psb_err_unit,*) trim(name),' Invalid map input: unassembled' + block + integer(psb_ipk_) :: meu,npu,mev,npv + type(psb_ctxt_type) :: ct + ct = map%p_desc_u%get_context() + call psb_info(ct,meu,npu) + ct = map%p_desc_v%get_context() + call psb_info(ct,mev,npv) + + write(psb_err_unit,*) trim(name),' Invalid map input: unassembled',& + & ':',meu,npu,mev,npv + end block info = 1 return end if diff --git a/base/tools/psb_s_remap.F90 b/base/tools/psb_s_remap.F90 index 6f5365b32..3f861fd88 100644 --- a/base/tools/psb_s_remap.F90 +++ b/base/tools/psb_s_remap.F90 @@ -86,7 +86,6 @@ subroutine psb_s_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, & endif !!$ write(0,*) ' Remapping from ',np,' onto ', np_remap - mipd = ipd if (desc_in%get_fmt() == 'BLOCK') then ! ! Should we spread the processes in the new context, @@ -121,7 +120,7 @@ subroutine psb_s_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, & goto 9999 endif if (rnp >= np) then - write(0,*) ' No remapping on larger proc count now' + write(0,*) ' No remapping on larger proc count now',rnp,np info = psb_err_internal_error_ call psb_errpush(info,name) goto 9999 @@ -245,6 +244,7 @@ subroutine psb_s_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, & else naggr(me+1) = 0 end if + ipd = mipd call psb_sum(ctxt,naggr) end block @@ -257,3 +257,16 @@ subroutine psb_s_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, & return end subroutine psb_s_remap +subroutine psb_s_remap2(map_in, desc_new, map_out, flag, info) + + use psb_base_mod, psb_protect_name => psb_s_remap2 + + implicit none + !....parameters... + type(psb_desc_type), intent(inout) :: desc_new + type(psb_slinmap_type), intent(inout) :: map_in + type(psb_slinmap_type), intent(out) :: map_out + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info + +end subroutine psb_s_remap2 diff --git a/base/tools/psb_z_map.f90 b/base/tools/psb_z_map.f90 index 8b9ff4cee..39dd60675 100644 --- a/base/tools/psb_z_map.f90 +++ b/base/tools/psb_z_map.f90 @@ -56,9 +56,19 @@ subroutine psb_z_map_U2V_a(alpha,x,beta,y,map,info,work) character(len=20), parameter :: name='psb_map_U2V' info = psb_success_ - if (.not.map%is_asb()) then - write(psb_err_unit,*) trim(name),' Invalid map input: unassembled' - info = 1 + if (.not.map%is_asb()) then + block + integer(psb_ipk_) :: meu,npu,mev,npv + type(psb_ctxt_type) :: ct + ct = map%p_desc_u%get_context() + call psb_info(ct,meu,npu) + ct = map%p_desc_v%get_context() + call psb_info(ct,mev,npv) + + write(psb_err_unit,*) trim(name),' Invalid map input: unassembled',& + & ':',meu,npu,mev,npv + info = 1 + end block return end if @@ -132,7 +142,17 @@ subroutine psb_z_map_U2V_v(alpha,x,beta,y,map,info,work,vtx,vty) info = psb_success_ if (.not.map%is_asb()) then - write(psb_err_unit,*) trim(name),' Invalid map input: unassembled' + block + integer(psb_ipk_) :: meu,npu,mev,npv + type(psb_ctxt_type) :: ct + ct = map%p_desc_u%get_context() + call psb_info(ct,meu,npu) + ct = map%p_desc_v%get_context() + call psb_info(ct,mev,npv) + + write(psb_err_unit,*) trim(name),' Invalid map input: unassembled',& + & ':',meu,npu,mev,npv + end block info = 1 return end if diff --git a/base/tools/psb_z_remap.F90 b/base/tools/psb_z_remap.F90 index c8d23a600..706f09869 100644 --- a/base/tools/psb_z_remap.F90 +++ b/base/tools/psb_z_remap.F90 @@ -86,7 +86,6 @@ subroutine psb_z_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, & endif !!$ write(0,*) ' Remapping from ',np,' onto ', np_remap - mipd = ipd if (desc_in%get_fmt() == 'BLOCK') then ! ! Should we spread the processes in the new context, @@ -121,7 +120,7 @@ subroutine psb_z_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, & goto 9999 endif if (rnp >= np) then - write(0,*) ' No remapping on larger proc count now' + write(0,*) ' No remapping on larger proc count now',rnp,np info = psb_err_internal_error_ call psb_errpush(info,name) goto 9999 @@ -245,6 +244,7 @@ subroutine psb_z_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, & else naggr(me+1) = 0 end if + ipd = mipd call psb_sum(ctxt,naggr) end block @@ -257,3 +257,16 @@ subroutine psb_z_remap(np_remap, desc_in, a_in, ipd, isrc, nrsrc, naggr, & return end subroutine psb_z_remap +subroutine psb_z_remap2(map_in, desc_new, map_out, flag, info) + + use psb_base_mod, psb_protect_name => psb_z_remap2 + + implicit none + !....parameters... + type(psb_desc_type), intent(inout) :: desc_new + type(psb_zlinmap_type), intent(inout) :: map_in + type(psb_zlinmap_type), intent(out) :: map_out + integer(psb_ipk_), intent(in) :: flag + integer(psb_ipk_), intent(out) :: info + +end subroutine psb_z_remap2