From d833362f4b2a02c62144a752d1ac842c2975c5f0 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Mon, 20 Apr 2026 08:45:21 +0200 Subject: [PATCH] Round of improvements for remap --- amgprec/impl/amg_cmlprec_aply.f90 | 136 +++++++++--------- amgprec/impl/amg_dmlprec_aply.f90 | 136 +++++++++--------- amgprec/impl/amg_smlprec_aply.f90 | 136 +++++++++--------- amgprec/impl/amg_zmlprec_aply.f90 | 136 +++++++++--------- .../impl/level/amg_c_base_onelev_map_prol.F90 | 10 +- .../impl/level/amg_c_base_onelev_map_rstr.F90 | 8 +- .../impl/level/amg_d_base_onelev_map_prol.F90 | 10 +- .../impl/level/amg_d_base_onelev_map_rstr.F90 | 8 +- .../impl/level/amg_s_base_onelev_map_prol.F90 | 10 +- .../impl/level/amg_s_base_onelev_map_rstr.F90 | 8 +- .../impl/level/amg_z_base_onelev_map_prol.F90 | 10 +- .../impl/level/amg_z_base_onelev_map_rstr.F90 | 8 +- 12 files changed, 312 insertions(+), 304 deletions(-) diff --git a/amgprec/impl/amg_cmlprec_aply.f90 b/amgprec/impl/amg_cmlprec_aply.f90 index bea1547d..e13dfbe0 100644 --- a/amgprec/impl/amg_cmlprec_aply.f90 +++ b/amgprec/impl/amg_cmlprec_aply.f90 @@ -393,39 +393,38 @@ contains if(debug_level > 1) then write(debug_unit,*) me,' Start inner_ml_aply at level ',level, info end if - if (me >= 0) then - select case(p%precv(level)%parms%ml_cycle) - - case(amg_no_ml_) - ! - ! No preconditioning, should not really get here - ! - call psb_errpush(psb_err_internal_error_,name,& - & a_err='amg_no_ml_ in mlprc_aply?') - goto 9999 - - case(amg_add_ml_) - - call amg_c_inner_add(p, level, trans, work) - - case(amg_mult_ml_,amg_vcycle_ml_, amg_wcycle_ml_) - - call amg_c_inner_mult(p, level, trans, work) - - case(amg_kcycle_ml_, amg_kcyclesym_ml_) - - call amg_c_inner_k_cycle(p, level, trans, work) - - case default - info = psb_err_from_subroutine_ai_ - call psb_errpush(info,name,a_err='invalid ml_cycle',& - & i_Err=(/p%precv(level)%parms%ml_cycle,izero,izero,izero,izero/)) - goto 9999 - - end select - if(debug_level > 1) then - write(debug_unit,*) me,' End inner_ml_aply at level ',level - end if + + select case(p%precv(level)%parms%ml_cycle) + + case(amg_no_ml_) + ! + ! No preconditioning, should not really get here + ! + call psb_errpush(psb_err_internal_error_,name,& + & a_err='amg_no_ml_ in mlprc_aply?') + goto 9999 + + case(amg_add_ml_) + + call amg_c_inner_add(p, level, trans, work) + + case(amg_mult_ml_,amg_vcycle_ml_, amg_wcycle_ml_) + + call amg_c_inner_mult(p, level, trans, work) + + case(amg_kcycle_ml_, amg_kcyclesym_ml_) + + call amg_c_inner_k_cycle(p, level, trans, work) + + case default + info = psb_err_from_subroutine_ai_ + call psb_errpush(info,name,a_err='invalid ml_cycle',& + & i_Err=(/p%precv(level)%parms%ml_cycle,izero,izero,izero,izero/)) + goto 9999 + + end select + if(debug_level > 1) then + write(debug_unit,*) me,' End inner_ml_aply at level ',level end if call psb_erractionrestore(err_act) @@ -492,7 +491,7 @@ contains & vtx => p%precv(level)%wrk%vtx,vty => p%precv(level)%wrk%vty,& & base_a => p%precv(level)%base_a, base_desc=>p%precv(level)%base_desc,& & wv => p%precv(level)%wrk%wv) - + if (me >= 0) then if (allocated(p%precv(level)%sm2a)) then call psb_geaxpby(cone,vx2l,czero,vy2l,base_desc,info) @@ -523,42 +522,41 @@ contains & a_err='Error during ADD smoother_apply') goto 9999 end if - - if (level < nlev) then - ! Apply the restriction - call p%precv(level+1)%map_rstr(cone,vx2l,& - & czero,p%precv(level+1)%wrk%vx2l,& - & info,work=work,& - & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1)) - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error during restriction') - goto 9999 - end if - - call inner_ml_aply(level+1,p,trans,work,info) - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error in recursive call') - goto 9999 - end if - - ! - ! Apply the prolongator - ! - call p%precv(level+1)%map_prol(cone,& - & p%precv(level+1)%wrk%vy2l, cone,vy2l,& - & info,work=work,& - & vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1)) - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error during prolongation') - goto 9999 - end if - - + end if + + if (level < nlev) then + ! Apply the restriction + call p%precv(level+1)%map_rstr(cone,vx2l,& + & czero,p%precv(level+1)%wrk%vx2l,& + & info,work=work,& + & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1)) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during restriction') + goto 9999 end if - end associate + + call inner_ml_aply(level+1,p,trans,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + + ! + ! Apply the prolongator + ! + call p%precv(level+1)%map_prol(cone,& + & p%precv(level+1)%wrk%vy2l, cone,vy2l,& + & info,work=work,& + & vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1)) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + + end associate call psb_erractionrestore(err_act) return diff --git a/amgprec/impl/amg_dmlprec_aply.f90 b/amgprec/impl/amg_dmlprec_aply.f90 index ea7c3487..2efc300f 100644 --- a/amgprec/impl/amg_dmlprec_aply.f90 +++ b/amgprec/impl/amg_dmlprec_aply.f90 @@ -393,39 +393,38 @@ contains if(debug_level > 1) then write(debug_unit,*) me,' Start inner_ml_aply at level ',level, info end if - if (me >= 0) then - select case(p%precv(level)%parms%ml_cycle) - - case(amg_no_ml_) - ! - ! No preconditioning, should not really get here - ! - call psb_errpush(psb_err_internal_error_,name,& - & a_err='amg_no_ml_ in mlprc_aply?') - goto 9999 - - case(amg_add_ml_) - - call amg_d_inner_add(p, level, trans, work) - - case(amg_mult_ml_,amg_vcycle_ml_, amg_wcycle_ml_) - - call amg_d_inner_mult(p, level, trans, work) - - case(amg_kcycle_ml_, amg_kcyclesym_ml_) - - call amg_d_inner_k_cycle(p, level, trans, work) - - case default - info = psb_err_from_subroutine_ai_ - call psb_errpush(info,name,a_err='invalid ml_cycle',& - & i_Err=(/p%precv(level)%parms%ml_cycle,izero,izero,izero,izero/)) - goto 9999 - - end select - if(debug_level > 1) then - write(debug_unit,*) me,' End inner_ml_aply at level ',level - end if + + select case(p%precv(level)%parms%ml_cycle) + + case(amg_no_ml_) + ! + ! No preconditioning, should not really get here + ! + call psb_errpush(psb_err_internal_error_,name,& + & a_err='amg_no_ml_ in mlprc_aply?') + goto 9999 + + case(amg_add_ml_) + + call amg_d_inner_add(p, level, trans, work) + + case(amg_mult_ml_,amg_vcycle_ml_, amg_wcycle_ml_) + + call amg_d_inner_mult(p, level, trans, work) + + case(amg_kcycle_ml_, amg_kcyclesym_ml_) + + call amg_d_inner_k_cycle(p, level, trans, work) + + case default + info = psb_err_from_subroutine_ai_ + call psb_errpush(info,name,a_err='invalid ml_cycle',& + & i_Err=(/p%precv(level)%parms%ml_cycle,izero,izero,izero,izero/)) + goto 9999 + + end select + if(debug_level > 1) then + write(debug_unit,*) me,' End inner_ml_aply at level ',level end if call psb_erractionrestore(err_act) @@ -492,7 +491,7 @@ contains & vtx => p%precv(level)%wrk%vtx,vty => p%precv(level)%wrk%vty,& & base_a => p%precv(level)%base_a, base_desc=>p%precv(level)%base_desc,& & wv => p%precv(level)%wrk%wv) - + if (me >= 0) then if (allocated(p%precv(level)%sm2a)) then call psb_geaxpby(done,vx2l,dzero,vy2l,base_desc,info) @@ -523,42 +522,41 @@ contains & a_err='Error during ADD smoother_apply') goto 9999 end if - - if (level < nlev) then - ! Apply the restriction - call p%precv(level+1)%map_rstr(done,vx2l,& - & dzero,p%precv(level+1)%wrk%vx2l,& - & info,work=work,& - & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1)) - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error during restriction') - goto 9999 - end if - - call inner_ml_aply(level+1,p,trans,work,info) - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error in recursive call') - goto 9999 - end if - - ! - ! Apply the prolongator - ! - call p%precv(level+1)%map_prol(done,& - & p%precv(level+1)%wrk%vy2l, done,vy2l,& - & info,work=work,& - & vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1)) - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error during prolongation') - goto 9999 - end if - - + end if + + if (level < nlev) then + ! Apply the restriction + call p%precv(level+1)%map_rstr(done,vx2l,& + & dzero,p%precv(level+1)%wrk%vx2l,& + & info,work=work,& + & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1)) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during restriction') + goto 9999 end if - end associate + + call inner_ml_aply(level+1,p,trans,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + + ! + ! Apply the prolongator + ! + call p%precv(level+1)%map_prol(done,& + & p%precv(level+1)%wrk%vy2l, done,vy2l,& + & info,work=work,& + & vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1)) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + + end associate call psb_erractionrestore(err_act) return diff --git a/amgprec/impl/amg_smlprec_aply.f90 b/amgprec/impl/amg_smlprec_aply.f90 index 26e88853..a12d3e43 100644 --- a/amgprec/impl/amg_smlprec_aply.f90 +++ b/amgprec/impl/amg_smlprec_aply.f90 @@ -393,39 +393,38 @@ contains if(debug_level > 1) then write(debug_unit,*) me,' Start inner_ml_aply at level ',level, info end if - if (me >= 0) then - select case(p%precv(level)%parms%ml_cycle) - - case(amg_no_ml_) - ! - ! No preconditioning, should not really get here - ! - call psb_errpush(psb_err_internal_error_,name,& - & a_err='amg_no_ml_ in mlprc_aply?') - goto 9999 - - case(amg_add_ml_) - - call amg_s_inner_add(p, level, trans, work) - - case(amg_mult_ml_,amg_vcycle_ml_, amg_wcycle_ml_) - - call amg_s_inner_mult(p, level, trans, work) - - case(amg_kcycle_ml_, amg_kcyclesym_ml_) - - call amg_s_inner_k_cycle(p, level, trans, work) - - case default - info = psb_err_from_subroutine_ai_ - call psb_errpush(info,name,a_err='invalid ml_cycle',& - & i_Err=(/p%precv(level)%parms%ml_cycle,izero,izero,izero,izero/)) - goto 9999 - - end select - if(debug_level > 1) then - write(debug_unit,*) me,' End inner_ml_aply at level ',level - end if + + select case(p%precv(level)%parms%ml_cycle) + + case(amg_no_ml_) + ! + ! No preconditioning, should not really get here + ! + call psb_errpush(psb_err_internal_error_,name,& + & a_err='amg_no_ml_ in mlprc_aply?') + goto 9999 + + case(amg_add_ml_) + + call amg_s_inner_add(p, level, trans, work) + + case(amg_mult_ml_,amg_vcycle_ml_, amg_wcycle_ml_) + + call amg_s_inner_mult(p, level, trans, work) + + case(amg_kcycle_ml_, amg_kcyclesym_ml_) + + call amg_s_inner_k_cycle(p, level, trans, work) + + case default + info = psb_err_from_subroutine_ai_ + call psb_errpush(info,name,a_err='invalid ml_cycle',& + & i_Err=(/p%precv(level)%parms%ml_cycle,izero,izero,izero,izero/)) + goto 9999 + + end select + if(debug_level > 1) then + write(debug_unit,*) me,' End inner_ml_aply at level ',level end if call psb_erractionrestore(err_act) @@ -492,7 +491,7 @@ contains & vtx => p%precv(level)%wrk%vtx,vty => p%precv(level)%wrk%vty,& & base_a => p%precv(level)%base_a, base_desc=>p%precv(level)%base_desc,& & wv => p%precv(level)%wrk%wv) - + if (me >= 0) then if (allocated(p%precv(level)%sm2a)) then call psb_geaxpby(sone,vx2l,szero,vy2l,base_desc,info) @@ -523,42 +522,41 @@ contains & a_err='Error during ADD smoother_apply') goto 9999 end if - - if (level < nlev) then - ! Apply the restriction - call p%precv(level+1)%map_rstr(sone,vx2l,& - & szero,p%precv(level+1)%wrk%vx2l,& - & info,work=work,& - & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1)) - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error during restriction') - goto 9999 - end if - - call inner_ml_aply(level+1,p,trans,work,info) - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error in recursive call') - goto 9999 - end if - - ! - ! Apply the prolongator - ! - call p%precv(level+1)%map_prol(sone,& - & p%precv(level+1)%wrk%vy2l, sone,vy2l,& - & info,work=work,& - & vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1)) - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error during prolongation') - goto 9999 - end if - - + end if + + if (level < nlev) then + ! Apply the restriction + call p%precv(level+1)%map_rstr(sone,vx2l,& + & szero,p%precv(level+1)%wrk%vx2l,& + & info,work=work,& + & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1)) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during restriction') + goto 9999 end if - end associate + + call inner_ml_aply(level+1,p,trans,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + + ! + ! Apply the prolongator + ! + call p%precv(level+1)%map_prol(sone,& + & p%precv(level+1)%wrk%vy2l, sone,vy2l,& + & info,work=work,& + & vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1)) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + + end associate call psb_erractionrestore(err_act) return diff --git a/amgprec/impl/amg_zmlprec_aply.f90 b/amgprec/impl/amg_zmlprec_aply.f90 index 6b1064e7..806d1f3f 100644 --- a/amgprec/impl/amg_zmlprec_aply.f90 +++ b/amgprec/impl/amg_zmlprec_aply.f90 @@ -393,39 +393,38 @@ contains if(debug_level > 1) then write(debug_unit,*) me,' Start inner_ml_aply at level ',level, info end if - if (me >= 0) then - select case(p%precv(level)%parms%ml_cycle) - - case(amg_no_ml_) - ! - ! No preconditioning, should not really get here - ! - call psb_errpush(psb_err_internal_error_,name,& - & a_err='amg_no_ml_ in mlprc_aply?') - goto 9999 - - case(amg_add_ml_) - - call amg_z_inner_add(p, level, trans, work) - - case(amg_mult_ml_,amg_vcycle_ml_, amg_wcycle_ml_) - - call amg_z_inner_mult(p, level, trans, work) - - case(amg_kcycle_ml_, amg_kcyclesym_ml_) - - call amg_z_inner_k_cycle(p, level, trans, work) - - case default - info = psb_err_from_subroutine_ai_ - call psb_errpush(info,name,a_err='invalid ml_cycle',& - & i_Err=(/p%precv(level)%parms%ml_cycle,izero,izero,izero,izero/)) - goto 9999 - - end select - if(debug_level > 1) then - write(debug_unit,*) me,' End inner_ml_aply at level ',level - end if + + select case(p%precv(level)%parms%ml_cycle) + + case(amg_no_ml_) + ! + ! No preconditioning, should not really get here + ! + call psb_errpush(psb_err_internal_error_,name,& + & a_err='amg_no_ml_ in mlprc_aply?') + goto 9999 + + case(amg_add_ml_) + + call amg_z_inner_add(p, level, trans, work) + + case(amg_mult_ml_,amg_vcycle_ml_, amg_wcycle_ml_) + + call amg_z_inner_mult(p, level, trans, work) + + case(amg_kcycle_ml_, amg_kcyclesym_ml_) + + call amg_z_inner_k_cycle(p, level, trans, work) + + case default + info = psb_err_from_subroutine_ai_ + call psb_errpush(info,name,a_err='invalid ml_cycle',& + & i_Err=(/p%precv(level)%parms%ml_cycle,izero,izero,izero,izero/)) + goto 9999 + + end select + if(debug_level > 1) then + write(debug_unit,*) me,' End inner_ml_aply at level ',level end if call psb_erractionrestore(err_act) @@ -492,7 +491,7 @@ contains & vtx => p%precv(level)%wrk%vtx,vty => p%precv(level)%wrk%vty,& & base_a => p%precv(level)%base_a, base_desc=>p%precv(level)%base_desc,& & wv => p%precv(level)%wrk%wv) - + if (me >= 0) then if (allocated(p%precv(level)%sm2a)) then call psb_geaxpby(zone,vx2l,zzero,vy2l,base_desc,info) @@ -523,42 +522,41 @@ contains & a_err='Error during ADD smoother_apply') goto 9999 end if - - if (level < nlev) then - ! Apply the restriction - call p%precv(level+1)%map_rstr(zone,vx2l,& - & zzero,p%precv(level+1)%wrk%vx2l,& - & info,work=work,& - & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1)) - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error during restriction') - goto 9999 - end if - - call inner_ml_aply(level+1,p,trans,work,info) - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error in recursive call') - goto 9999 - end if - - ! - ! Apply the prolongator - ! - call p%precv(level+1)%map_prol(zone,& - & p%precv(level+1)%wrk%vy2l, zone,vy2l,& - & info,work=work,& - & vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1)) - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Error during prolongation') - goto 9999 - end if - - + end if + + if (level < nlev) then + ! Apply the restriction + call p%precv(level+1)%map_rstr(zone,vx2l,& + & zzero,p%precv(level+1)%wrk%vx2l,& + & info,work=work,& + & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1)) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during restriction') + goto 9999 end if - end associate + + call inner_ml_aply(level+1,p,trans,work,info) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in recursive call') + goto 9999 + end if + + ! + ! Apply the prolongator + ! + call p%precv(level+1)%map_prol(zone,& + & p%precv(level+1)%wrk%vy2l, zone,vy2l,& + & info,work=work,& + & vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1)) + if (info /= psb_success_) then + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error during prolongation') + goto 9999 + end if + + end associate call psb_erractionrestore(err_act) return diff --git a/amgprec/impl/level/amg_c_base_onelev_map_prol.F90 b/amgprec/impl/level/amg_c_base_onelev_map_prol.F90 index 4c5ecd0d..08ee412f 100644 --- a/amgprec/impl/level/amg_c_base_onelev_map_prol.F90 +++ b/amgprec/impl/level/amg_c_base_onelev_map_prol.F90 @@ -89,12 +89,14 @@ subroutine amg_c_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vt call psb_geall(tv,lv%remap_data%desc_ac_pre_remap,info) !!$ write(0,*) me, ' Allocated ',nrl,info,psb_errstatus_fatal() - call psb_geasb(tv,lv%remap_data%desc_ac_pre_remap,info) + call psb_geasb(tv,lv%remap_data%desc_ac_pre_remap,info,mold=vect_u%v) !!$ write(0,*) me,' Size of TV ',nrl,tv%get_nrows(),info !!$ write(0,*) me,' Receiving from ',idest,nrl,psb_errstatus_fatal() - call psb_realloc(nrc,rsnd,info) - call psb_rcv(ctxt,rsnd(1:nrl),idest) - call tv%set_vect(rsnd) +!!$ call psb_realloc(nrc,rsnd,info) +!!$ call psb_rcv(ctxt,rsnd(1:nrl),idest) +!!$ call tv%set_vect(rsnd) + call psb_rcv(ctxt,tv%v%v(1:nrl),idest) + call tv%set_host() call lv%linmap%map_V2U(alpha,tv,beta,vect_u,info,& & work=work,vtx=vtx,vty=vty) end associate diff --git a/amgprec/impl/level/amg_c_base_onelev_map_rstr.F90 b/amgprec/impl/level/amg_c_base_onelev_map_rstr.F90 index 3afce5f8..eedbe26d 100644 --- a/amgprec/impl/level/amg_c_base_onelev_map_rstr.F90 +++ b/amgprec/impl/level/amg_c_base_onelev_map_rstr.F90 @@ -73,12 +73,14 @@ subroutine amg_c_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,& nsrc = size(isrc) nrl = lv%remap_data%desc_ac_pre_remap%get_local_rows() call psb_geall(tv,lv%remap_data%desc_ac_pre_remap,info) - call psb_geasb(tv,lv%remap_data%desc_ac_pre_remap,info) + call psb_geasb(tv,lv%remap_data%desc_ac_pre_remap,info,mold=vect_u%v) !!$ write(0,*) me,' Size of TV ',tv%get_nrows() call lv%linmap%map_U2V(alpha,vect_u,beta,tv,info,& & work=work,vtx=vtx,vty=vty) - rsnd = tv%get_vect() - call psb_snd(ctxt,rsnd(1:nrl),idest) + call tv%sync() + !rsnd = tv%get_vect() + !call psb_snd(ctxt,rsnd(1:nrl),idest) + call psb_snd(ctxt,tv%v%v(1:nrl),idest) if (rme >=0) then allocate(rrcv(sum(nrsrc))) !!$ write(0,*) me,rme,' Size check ',size(rrcv)!,lv%desc_ac%get_local_rows() diff --git a/amgprec/impl/level/amg_d_base_onelev_map_prol.F90 b/amgprec/impl/level/amg_d_base_onelev_map_prol.F90 index 8619a8e9..dd1b0a9a 100644 --- a/amgprec/impl/level/amg_d_base_onelev_map_prol.F90 +++ b/amgprec/impl/level/amg_d_base_onelev_map_prol.F90 @@ -89,12 +89,14 @@ subroutine amg_d_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vt call psb_geall(tv,lv%remap_data%desc_ac_pre_remap,info) !!$ write(0,*) me, ' Allocated ',nrl,info,psb_errstatus_fatal() - call psb_geasb(tv,lv%remap_data%desc_ac_pre_remap,info) + call psb_geasb(tv,lv%remap_data%desc_ac_pre_remap,info,mold=vect_u%v) !!$ write(0,*) me,' Size of TV ',nrl,tv%get_nrows(),info !!$ write(0,*) me,' Receiving from ',idest,nrl,psb_errstatus_fatal() - call psb_realloc(nrc,rsnd,info) - call psb_rcv(ctxt,rsnd(1:nrl),idest) - call tv%set_vect(rsnd) +!!$ call psb_realloc(nrc,rsnd,info) +!!$ call psb_rcv(ctxt,rsnd(1:nrl),idest) +!!$ call tv%set_vect(rsnd) + call psb_rcv(ctxt,tv%v%v(1:nrl),idest) + call tv%set_host() call lv%linmap%map_V2U(alpha,tv,beta,vect_u,info,& & work=work,vtx=vtx,vty=vty) end associate diff --git a/amgprec/impl/level/amg_d_base_onelev_map_rstr.F90 b/amgprec/impl/level/amg_d_base_onelev_map_rstr.F90 index b1f6dd6b..25104694 100644 --- a/amgprec/impl/level/amg_d_base_onelev_map_rstr.F90 +++ b/amgprec/impl/level/amg_d_base_onelev_map_rstr.F90 @@ -73,12 +73,14 @@ subroutine amg_d_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,& nsrc = size(isrc) nrl = lv%remap_data%desc_ac_pre_remap%get_local_rows() call psb_geall(tv,lv%remap_data%desc_ac_pre_remap,info) - call psb_geasb(tv,lv%remap_data%desc_ac_pre_remap,info) + call psb_geasb(tv,lv%remap_data%desc_ac_pre_remap,info,mold=vect_u%v) !!$ write(0,*) me,' Size of TV ',tv%get_nrows() call lv%linmap%map_U2V(alpha,vect_u,beta,tv,info,& & work=work,vtx=vtx,vty=vty) - rsnd = tv%get_vect() - call psb_snd(ctxt,rsnd(1:nrl),idest) + call tv%sync() + !rsnd = tv%get_vect() + !call psb_snd(ctxt,rsnd(1:nrl),idest) + call psb_snd(ctxt,tv%v%v(1:nrl),idest) if (rme >=0) then allocate(rrcv(sum(nrsrc))) !!$ write(0,*) me,rme,' Size check ',size(rrcv)!,lv%desc_ac%get_local_rows() diff --git a/amgprec/impl/level/amg_s_base_onelev_map_prol.F90 b/amgprec/impl/level/amg_s_base_onelev_map_prol.F90 index 20324056..97ef0988 100644 --- a/amgprec/impl/level/amg_s_base_onelev_map_prol.F90 +++ b/amgprec/impl/level/amg_s_base_onelev_map_prol.F90 @@ -89,12 +89,14 @@ subroutine amg_s_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vt call psb_geall(tv,lv%remap_data%desc_ac_pre_remap,info) !!$ write(0,*) me, ' Allocated ',nrl,info,psb_errstatus_fatal() - call psb_geasb(tv,lv%remap_data%desc_ac_pre_remap,info) + call psb_geasb(tv,lv%remap_data%desc_ac_pre_remap,info,mold=vect_u%v) !!$ write(0,*) me,' Size of TV ',nrl,tv%get_nrows(),info !!$ write(0,*) me,' Receiving from ',idest,nrl,psb_errstatus_fatal() - call psb_realloc(nrc,rsnd,info) - call psb_rcv(ctxt,rsnd(1:nrl),idest) - call tv%set_vect(rsnd) +!!$ call psb_realloc(nrc,rsnd,info) +!!$ call psb_rcv(ctxt,rsnd(1:nrl),idest) +!!$ call tv%set_vect(rsnd) + call psb_rcv(ctxt,tv%v%v(1:nrl),idest) + call tv%set_host() call lv%linmap%map_V2U(alpha,tv,beta,vect_u,info,& & work=work,vtx=vtx,vty=vty) end associate diff --git a/amgprec/impl/level/amg_s_base_onelev_map_rstr.F90 b/amgprec/impl/level/amg_s_base_onelev_map_rstr.F90 index f24c9f53..63d8af5b 100644 --- a/amgprec/impl/level/amg_s_base_onelev_map_rstr.F90 +++ b/amgprec/impl/level/amg_s_base_onelev_map_rstr.F90 @@ -73,12 +73,14 @@ subroutine amg_s_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,& nsrc = size(isrc) nrl = lv%remap_data%desc_ac_pre_remap%get_local_rows() call psb_geall(tv,lv%remap_data%desc_ac_pre_remap,info) - call psb_geasb(tv,lv%remap_data%desc_ac_pre_remap,info) + call psb_geasb(tv,lv%remap_data%desc_ac_pre_remap,info,mold=vect_u%v) !!$ write(0,*) me,' Size of TV ',tv%get_nrows() call lv%linmap%map_U2V(alpha,vect_u,beta,tv,info,& & work=work,vtx=vtx,vty=vty) - rsnd = tv%get_vect() - call psb_snd(ctxt,rsnd(1:nrl),idest) + call tv%sync() + !rsnd = tv%get_vect() + !call psb_snd(ctxt,rsnd(1:nrl),idest) + call psb_snd(ctxt,tv%v%v(1:nrl),idest) if (rme >=0) then allocate(rrcv(sum(nrsrc))) !!$ write(0,*) me,rme,' Size check ',size(rrcv)!,lv%desc_ac%get_local_rows() diff --git a/amgprec/impl/level/amg_z_base_onelev_map_prol.F90 b/amgprec/impl/level/amg_z_base_onelev_map_prol.F90 index 2f662566..37c356ac 100644 --- a/amgprec/impl/level/amg_z_base_onelev_map_prol.F90 +++ b/amgprec/impl/level/amg_z_base_onelev_map_prol.F90 @@ -89,12 +89,14 @@ subroutine amg_z_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vt call psb_geall(tv,lv%remap_data%desc_ac_pre_remap,info) !!$ write(0,*) me, ' Allocated ',nrl,info,psb_errstatus_fatal() - call psb_geasb(tv,lv%remap_data%desc_ac_pre_remap,info) + call psb_geasb(tv,lv%remap_data%desc_ac_pre_remap,info,mold=vect_u%v) !!$ write(0,*) me,' Size of TV ',nrl,tv%get_nrows(),info !!$ write(0,*) me,' Receiving from ',idest,nrl,psb_errstatus_fatal() - call psb_realloc(nrc,rsnd,info) - call psb_rcv(ctxt,rsnd(1:nrl),idest) - call tv%set_vect(rsnd) +!!$ call psb_realloc(nrc,rsnd,info) +!!$ call psb_rcv(ctxt,rsnd(1:nrl),idest) +!!$ call tv%set_vect(rsnd) + call psb_rcv(ctxt,tv%v%v(1:nrl),idest) + call tv%set_host() call lv%linmap%map_V2U(alpha,tv,beta,vect_u,info,& & work=work,vtx=vtx,vty=vty) end associate diff --git a/amgprec/impl/level/amg_z_base_onelev_map_rstr.F90 b/amgprec/impl/level/amg_z_base_onelev_map_rstr.F90 index 8986a78b..2b26e27a 100644 --- a/amgprec/impl/level/amg_z_base_onelev_map_rstr.F90 +++ b/amgprec/impl/level/amg_z_base_onelev_map_rstr.F90 @@ -73,12 +73,14 @@ subroutine amg_z_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,& nsrc = size(isrc) nrl = lv%remap_data%desc_ac_pre_remap%get_local_rows() call psb_geall(tv,lv%remap_data%desc_ac_pre_remap,info) - call psb_geasb(tv,lv%remap_data%desc_ac_pre_remap,info) + call psb_geasb(tv,lv%remap_data%desc_ac_pre_remap,info,mold=vect_u%v) !!$ write(0,*) me,' Size of TV ',tv%get_nrows() call lv%linmap%map_U2V(alpha,vect_u,beta,tv,info,& & work=work,vtx=vtx,vty=vty) - rsnd = tv%get_vect() - call psb_snd(ctxt,rsnd(1:nrl),idest) + call tv%sync() + !rsnd = tv%get_vect() + !call psb_snd(ctxt,rsnd(1:nrl),idest) + call psb_snd(ctxt,tv%v%v(1:nrl),idest) if (rme >=0) then allocate(rrcv(sum(nrsrc))) !!$ write(0,*) me,rme,' Size check ',size(rrcv)!,lv%desc_ac%get_local_rows()