fdurastante
/
amg4psblas
mirror of https://github.com/sfilippone/amg4psblas.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Round of improvements for remap

Browse Source
remap-coarse
Salvatore Filippone 3 months ago
parent f26b66334a
commit d833362f4b
12 changed files with 312 additions and 304 deletions
Show Stats Download Patch File Download Diff File

110
amgprec/impl/amg_cmlprec_aply.f90
Unescape Escape View File

@ -393,39 +393,38 @@ contains
if(debug_level > 1) then if(debug_level > 1) then
write(debug_unit,*) me,' Start inner_ml_aply at level ',level, info write(debug_unit,*) me,' Start inner_ml_aply at level ',level, info
end if end if
if (me >= 0) then
select case(p%precv(level)%parms%ml_cycle)
case(amg_no_ml_) select case(p%precv(level)%parms%ml_cycle)
!
! 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_) 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
call amg_c_inner_add(p, level, trans, work) case(amg_add_ml_)
case(amg_mult_ml_,amg_vcycle_ml_, amg_wcycle_ml_) call amg_c_inner_add(p, level, trans, work)
call amg_c_inner_mult(p, level, trans, work) case(amg_mult_ml_,amg_vcycle_ml_, amg_wcycle_ml_)
case(amg_kcycle_ml_, amg_kcyclesym_ml_) call amg_c_inner_mult(p, level, trans, work)
call amg_c_inner_k_cycle(p, level, trans, work) case(amg_kcycle_ml_, amg_kcyclesym_ml_)
case default call amg_c_inner_k_cycle(p, level, trans, work)
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 case default
if(debug_level > 1) then info = psb_err_from_subroutine_ai_
write(debug_unit,*) me,' End inner_ml_aply at level ',level call psb_errpush(info,name,a_err='invalid ml_cycle',&
end if & 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 end if
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
@ -523,42 +522,41 @@ contains
& a_err='Error during ADD smoother_apply') & a_err='Error during ADD smoother_apply')
goto 9999 goto 9999
end if end if
end if
if (level < nlev) then if (level < nlev) then
! Apply the restriction ! Apply the restriction
call p%precv(level+1)%map_rstr(cone,vx2l,& call p%precv(level+1)%map_rstr(cone,vx2l,&
& czero,p%precv(level+1)%wrk%vx2l,& & czero,p%precv(level+1)%wrk%vx2l,&
& info,work=work,& & info,work=work,&
& vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1)) & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during restriction') & a_err='Error during restriction')
goto 9999 goto 9999
end if 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
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
end associate
end associate
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

110
amgprec/impl/amg_dmlprec_aply.f90
Unescape Escape View File

@ -393,39 +393,38 @@ contains
if(debug_level > 1) then if(debug_level > 1) then
write(debug_unit,*) me,' Start inner_ml_aply at level ',level, info write(debug_unit,*) me,' Start inner_ml_aply at level ',level, info
end if end if
if (me >= 0) then
select case(p%precv(level)%parms%ml_cycle)
case(amg_no_ml_) select case(p%precv(level)%parms%ml_cycle)
!
! 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_) 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
call amg_d_inner_add(p, level, trans, work) case(amg_add_ml_)
case(amg_mult_ml_,amg_vcycle_ml_, amg_wcycle_ml_) call amg_d_inner_add(p, level, trans, work)
call amg_d_inner_mult(p, level, trans, work) case(amg_mult_ml_,amg_vcycle_ml_, amg_wcycle_ml_)
case(amg_kcycle_ml_, amg_kcyclesym_ml_) call amg_d_inner_mult(p, level, trans, work)
call amg_d_inner_k_cycle(p, level, trans, work) case(amg_kcycle_ml_, amg_kcyclesym_ml_)
case default call amg_d_inner_k_cycle(p, level, trans, work)
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 case default
if(debug_level > 1) then info = psb_err_from_subroutine_ai_
write(debug_unit,*) me,' End inner_ml_aply at level ',level call psb_errpush(info,name,a_err='invalid ml_cycle',&
end if & 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 end if
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
@ -523,42 +522,41 @@ contains
& a_err='Error during ADD smoother_apply') & a_err='Error during ADD smoother_apply')
goto 9999 goto 9999
end if end if
end if
if (level < nlev) then if (level < nlev) then
! Apply the restriction ! Apply the restriction
call p%precv(level+1)%map_rstr(done,vx2l,& call p%precv(level+1)%map_rstr(done,vx2l,&
& dzero,p%precv(level+1)%wrk%vx2l,& & dzero,p%precv(level+1)%wrk%vx2l,&
& info,work=work,& & info,work=work,&
& vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1)) & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during restriction') & a_err='Error during restriction')
goto 9999 goto 9999
end if 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
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
end associate
end associate
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

110
amgprec/impl/amg_smlprec_aply.f90
Unescape Escape View File

@ -393,39 +393,38 @@ contains
if(debug_level > 1) then if(debug_level > 1) then
write(debug_unit,*) me,' Start inner_ml_aply at level ',level, info write(debug_unit,*) me,' Start inner_ml_aply at level ',level, info
end if end if
if (me >= 0) then
select case(p%precv(level)%parms%ml_cycle)
case(amg_no_ml_) select case(p%precv(level)%parms%ml_cycle)
!
! 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_) 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
call amg_s_inner_add(p, level, trans, work) case(amg_add_ml_)
case(amg_mult_ml_,amg_vcycle_ml_, amg_wcycle_ml_) call amg_s_inner_add(p, level, trans, work)
call amg_s_inner_mult(p, level, trans, work) case(amg_mult_ml_,amg_vcycle_ml_, amg_wcycle_ml_)
case(amg_kcycle_ml_, amg_kcyclesym_ml_) call amg_s_inner_mult(p, level, trans, work)
call amg_s_inner_k_cycle(p, level, trans, work) case(amg_kcycle_ml_, amg_kcyclesym_ml_)
case default call amg_s_inner_k_cycle(p, level, trans, work)
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 case default
if(debug_level > 1) then info = psb_err_from_subroutine_ai_
write(debug_unit,*) me,' End inner_ml_aply at level ',level call psb_errpush(info,name,a_err='invalid ml_cycle',&
end if & 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 end if
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
@ -523,42 +522,41 @@ contains
& a_err='Error during ADD smoother_apply') & a_err='Error during ADD smoother_apply')
goto 9999 goto 9999
end if end if
end if
if (level < nlev) then if (level < nlev) then
! Apply the restriction ! Apply the restriction
call p%precv(level+1)%map_rstr(sone,vx2l,& call p%precv(level+1)%map_rstr(sone,vx2l,&
& szero,p%precv(level+1)%wrk%vx2l,& & szero,p%precv(level+1)%wrk%vx2l,&
& info,work=work,& & info,work=work,&
& vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1)) & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during restriction') & a_err='Error during restriction')
goto 9999 goto 9999
end if 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
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
end associate
end associate
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

110
amgprec/impl/amg_zmlprec_aply.f90
Unescape Escape View File

@ -393,39 +393,38 @@ contains
if(debug_level > 1) then if(debug_level > 1) then
write(debug_unit,*) me,' Start inner_ml_aply at level ',level, info write(debug_unit,*) me,' Start inner_ml_aply at level ',level, info
end if end if
if (me >= 0) then
select case(p%precv(level)%parms%ml_cycle)
case(amg_no_ml_) select case(p%precv(level)%parms%ml_cycle)
!
! 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_) 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
call amg_z_inner_add(p, level, trans, work) case(amg_add_ml_)
case(amg_mult_ml_,amg_vcycle_ml_, amg_wcycle_ml_) call amg_z_inner_add(p, level, trans, work)
call amg_z_inner_mult(p, level, trans, work) case(amg_mult_ml_,amg_vcycle_ml_, amg_wcycle_ml_)
case(amg_kcycle_ml_, amg_kcyclesym_ml_) call amg_z_inner_mult(p, level, trans, work)
call amg_z_inner_k_cycle(p, level, trans, work) case(amg_kcycle_ml_, amg_kcyclesym_ml_)
case default call amg_z_inner_k_cycle(p, level, trans, work)
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 case default
if(debug_level > 1) then info = psb_err_from_subroutine_ai_
write(debug_unit,*) me,' End inner_ml_aply at level ',level call psb_errpush(info,name,a_err='invalid ml_cycle',&
end if & 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 end if
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
@ -523,42 +522,41 @@ contains
& a_err='Error during ADD smoother_apply') & a_err='Error during ADD smoother_apply')
goto 9999 goto 9999
end if end if
end if
if (level < nlev) then if (level < nlev) then
! Apply the restriction ! Apply the restriction
call p%precv(level+1)%map_rstr(zone,vx2l,& call p%precv(level+1)%map_rstr(zone,vx2l,&
& zzero,p%precv(level+1)%wrk%vx2l,& & zzero,p%precv(level+1)%wrk%vx2l,&
& info,work=work,& & info,work=work,&
& vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1)) & vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
if (info /= psb_success_) then if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='Error during restriction') & a_err='Error during restriction')
goto 9999 goto 9999
end if 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
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
end associate
end associate
call psb_erractionrestore(err_act) call psb_erractionrestore(err_act)
return return

10
amgprec/impl/level/amg_c_base_onelev_map_prol.F90
Unescape Escape 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) call psb_geall(tv,lv%remap_data%desc_ac_pre_remap,info)
!!$ write(0,*) me, ' Allocated ',nrl,info,psb_errstatus_fatal() !!$ 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,' Size of TV ',nrl,tv%get_nrows(),info
!!$ write(0,*) me,' Receiving from ',idest,nrl,psb_errstatus_fatal() !!$ write(0,*) me,' Receiving from ',idest,nrl,psb_errstatus_fatal()
call psb_realloc(nrc,rsnd,info) !!$ call psb_realloc(nrc,rsnd,info)
call psb_rcv(ctxt,rsnd(1:nrl),idest) !!$ call psb_rcv(ctxt,rsnd(1:nrl),idest)
call tv%set_vect(rsnd) !!$ 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,& call lv%linmap%map_V2U(alpha,tv,beta,vect_u,info,&
& work=work,vtx=vtx,vty=vty) & work=work,vtx=vtx,vty=vty)
end associate end associate

8
amgprec/impl/level/amg_c_base_onelev_map_rstr.F90
Unescape Escape 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) nsrc = size(isrc)
nrl = lv%remap_data%desc_ac_pre_remap%get_local_rows() 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_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() !!$ write(0,*) me,' Size of TV ',tv%get_nrows()
call lv%linmap%map_U2V(alpha,vect_u,beta,tv,info,& call lv%linmap%map_U2V(alpha,vect_u,beta,tv,info,&
& work=work,vtx=vtx,vty=vty) & work=work,vtx=vtx,vty=vty)
rsnd = tv%get_vect() call tv%sync()
call psb_snd(ctxt,rsnd(1:nrl),idest) !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 if (rme >=0) then
allocate(rrcv(sum(nrsrc))) allocate(rrcv(sum(nrsrc)))
!!$ write(0,*) me,rme,' Size check ',size(rrcv)!,lv%desc_ac%get_local_rows() !!$ write(0,*) me,rme,' Size check ',size(rrcv)!,lv%desc_ac%get_local_rows()

10
amgprec/impl/level/amg_d_base_onelev_map_prol.F90
Unescape Escape 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) call psb_geall(tv,lv%remap_data%desc_ac_pre_remap,info)
!!$ write(0,*) me, ' Allocated ',nrl,info,psb_errstatus_fatal() !!$ 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,' Size of TV ',nrl,tv%get_nrows(),info
!!$ write(0,*) me,' Receiving from ',idest,nrl,psb_errstatus_fatal() !!$ write(0,*) me,' Receiving from ',idest,nrl,psb_errstatus_fatal()
call psb_realloc(nrc,rsnd,info) !!$ call psb_realloc(nrc,rsnd,info)
call psb_rcv(ctxt,rsnd(1:nrl),idest) !!$ call psb_rcv(ctxt,rsnd(1:nrl),idest)
call tv%set_vect(rsnd) !!$ 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,& call lv%linmap%map_V2U(alpha,tv,beta,vect_u,info,&
& work=work,vtx=vtx,vty=vty) & work=work,vtx=vtx,vty=vty)
end associate end associate

8
amgprec/impl/level/amg_d_base_onelev_map_rstr.F90
Unescape Escape 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) nsrc = size(isrc)
nrl = lv%remap_data%desc_ac_pre_remap%get_local_rows() 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_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() !!$ write(0,*) me,' Size of TV ',tv%get_nrows()
call lv%linmap%map_U2V(alpha,vect_u,beta,tv,info,& call lv%linmap%map_U2V(alpha,vect_u,beta,tv,info,&
& work=work,vtx=vtx,vty=vty) & work=work,vtx=vtx,vty=vty)
rsnd = tv%get_vect() call tv%sync()
call psb_snd(ctxt,rsnd(1:nrl),idest) !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 if (rme >=0) then
allocate(rrcv(sum(nrsrc))) allocate(rrcv(sum(nrsrc)))
!!$ write(0,*) me,rme,' Size check ',size(rrcv)!,lv%desc_ac%get_local_rows() !!$ write(0,*) me,rme,' Size check ',size(rrcv)!,lv%desc_ac%get_local_rows()

10
amgprec/impl/level/amg_s_base_onelev_map_prol.F90
Unescape Escape 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) call psb_geall(tv,lv%remap_data%desc_ac_pre_remap,info)
!!$ write(0,*) me, ' Allocated ',nrl,info,psb_errstatus_fatal() !!$ 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,' Size of TV ',nrl,tv%get_nrows(),info
!!$ write(0,*) me,' Receiving from ',idest,nrl,psb_errstatus_fatal() !!$ write(0,*) me,' Receiving from ',idest,nrl,psb_errstatus_fatal()
call psb_realloc(nrc,rsnd,info) !!$ call psb_realloc(nrc,rsnd,info)
call psb_rcv(ctxt,rsnd(1:nrl),idest) !!$ call psb_rcv(ctxt,rsnd(1:nrl),idest)
call tv%set_vect(rsnd) !!$ 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,& call lv%linmap%map_V2U(alpha,tv,beta,vect_u,info,&
& work=work,vtx=vtx,vty=vty) & work=work,vtx=vtx,vty=vty)
end associate end associate

8
amgprec/impl/level/amg_s_base_onelev_map_rstr.F90
Unescape Escape 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) nsrc = size(isrc)
nrl = lv%remap_data%desc_ac_pre_remap%get_local_rows() 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_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() !!$ write(0,*) me,' Size of TV ',tv%get_nrows()
call lv%linmap%map_U2V(alpha,vect_u,beta,tv,info,& call lv%linmap%map_U2V(alpha,vect_u,beta,tv,info,&
& work=work,vtx=vtx,vty=vty) & work=work,vtx=vtx,vty=vty)
rsnd = tv%get_vect() call tv%sync()
call psb_snd(ctxt,rsnd(1:nrl),idest) !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 if (rme >=0) then
allocate(rrcv(sum(nrsrc))) allocate(rrcv(sum(nrsrc)))
!!$ write(0,*) me,rme,' Size check ',size(rrcv)!,lv%desc_ac%get_local_rows() !!$ write(0,*) me,rme,' Size check ',size(rrcv)!,lv%desc_ac%get_local_rows()

10
amgprec/impl/level/amg_z_base_onelev_map_prol.F90
Unescape Escape 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) call psb_geall(tv,lv%remap_data%desc_ac_pre_remap,info)
!!$ write(0,*) me, ' Allocated ',nrl,info,psb_errstatus_fatal() !!$ 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,' Size of TV ',nrl,tv%get_nrows(),info
!!$ write(0,*) me,' Receiving from ',idest,nrl,psb_errstatus_fatal() !!$ write(0,*) me,' Receiving from ',idest,nrl,psb_errstatus_fatal()
call psb_realloc(nrc,rsnd,info) !!$ call psb_realloc(nrc,rsnd,info)
call psb_rcv(ctxt,rsnd(1:nrl),idest) !!$ call psb_rcv(ctxt,rsnd(1:nrl),idest)
call tv%set_vect(rsnd) !!$ 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,& call lv%linmap%map_V2U(alpha,tv,beta,vect_u,info,&
& work=work,vtx=vtx,vty=vty) & work=work,vtx=vtx,vty=vty)
end associate end associate

8
amgprec/impl/level/amg_z_base_onelev_map_rstr.F90
Unescape Escape 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) nsrc = size(isrc)
nrl = lv%remap_data%desc_ac_pre_remap%get_local_rows() 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_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() !!$ write(0,*) me,' Size of TV ',tv%get_nrows()
call lv%linmap%map_U2V(alpha,vect_u,beta,tv,info,& call lv%linmap%map_U2V(alpha,vect_u,beta,tv,info,&
& work=work,vtx=vtx,vty=vty) & work=work,vtx=vtx,vty=vty)
rsnd = tv%get_vect() call tv%sync()
call psb_snd(ctxt,rsnd(1:nrl),idest) !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 if (rme >=0) then
allocate(rrcv(sum(nrsrc))) allocate(rrcv(sum(nrsrc)))
!!$ write(0,*) me,rme,' Size check ',size(rrcv)!,lv%desc_ac%get_local_rows() !!$ write(0,*) me,rme,' Size check ',size(rrcv)!,lv%desc_ac%get_local_rows()

Write Preview
Loading…
Cancel
Save