fdurastante/amg4psblas
1
0
Fork 0
mirror of https://github.com/sfilippone/amg4psblas.git synced 2026-10-06 14:44:55 +00:00
Code Issues Packages Projects Releases Wiki Activity

Round of improvements for remap

Browse Source
This commit is contained in:
Salvatore Filippone
2026-04-20 08:45:21 +02:00
parent f26b66334a
commit d833362f4b
12 changed files with 312 additions and 304 deletions
Download Patch File Download Diff File Expand all files Collapse all files
amgprec/impl/amg_cmlprec_aply.f90
+67 -69
View File
@@ -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
amgprec/impl/amg_dmlprec_aply.f90
+67 -69
View File
@@ -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
amgprec/impl/amg_smlprec_aply.f90
+67 -69
View File
@@ -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
amgprec/impl/amg_zmlprec_aply.f90
+67 -69
View File
@@ -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
amgprec/impl/level/amg_c_base_onelev_map_prol.F90
+6 -4
View File
@@ -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
amgprec/impl/level/amg_c_base_onelev_map_rstr.F90
+5 -3
View File
@@ -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()
amgprec/impl/level/amg_d_base_onelev_map_prol.F90
+6 -4
View File
@@ -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
amgprec/impl/level/amg_d_base_onelev_map_rstr.F90
+5 -3
View File
@@ -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()
amgprec/impl/level/amg_s_base_onelev_map_prol.F90
+6 -4
View File
@@ -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
amgprec/impl/level/amg_s_base_onelev_map_rstr.F90
+5 -3
View File
@@ -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()
amgprec/impl/level/amg_z_base_onelev_map_prol.F90
+6 -4
View File
@@ -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
amgprec/impl/level/amg_z_base_onelev_map_rstr.F90
+5 -3
View File
@@ -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()