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

First working version

Browse Source
This commit is contained in:
sfilippone
2026-07-13 15:42:23 +02:00
parent 42313bb843
commit 23f84ce236
8 changed files with 110 additions and 155 deletions
Download Patch File Download Diff File Expand all files Collapse all files
amgprec/amg_d_onelev_mod.f90
+4 -4
View File
@@ -762,7 +762,7 @@ contains
info = psb_success_
nwv = lv%get_wrksz()
if (.not.allocated(lv%wrk)) allocate(lv%wrk,stat=info)
write(0,*) 'From allocate_wrk :',lv%remap_data%desc_ac_pre_remap%is_asb()
!!$ write(0,*) 'From allocate_wrk :',lv%remap_data%desc_ac_pre_remap%is_asb()
if (info == 0) then
if (lv%remap_data%desc_ac_pre_remap%is_asb()) then
!
@@ -810,12 +810,12 @@ contains
info = psb_success_
call wk%free(info)
write(0,*) 'wrk_alloc D: "',trim(desc%get_fmt()),'"',&
& present(desc2),desc%is_valid()
!!$ write(0,*) 'wrk_alloc D: "',trim(desc%get_fmt()),'"',&
!!$ & present(desc2),desc%is_valid()
allocate(wk%wv(nwv),stat=info)
if (present(desc2).and.(desc%is_valid())) then
write(0,*) 'wrk_alloc D2:',desc2%get_fmt(),desc2%is_asb()
!!$ write(0,*) 'wrk_alloc D2:',desc2%get_fmt(),desc2%is_asb()
if (desc2%get_local_cols()>desc%get_local_cols()) then
call inner_do_wrk_alloc(wk,nwv,desc2,vmold=vmold)
else
amgprec/amg_d_prec_type.f90
+6 -13
View File
@@ -437,11 +437,11 @@ contains
class(amg_dprec_type), intent(in) :: prec
integer(psb_ipk_) :: val
val = 0
if (allocated(prec%precv)) then
val = size(prec%precv)
end if
!!$ if (allocated(prec%precv)) then
!!$ val = size(prec%precv)
!!$ end if
val = prec%nlevs
write(0,*) ' NLEVS: ',prec%nlevs, val,size(prec%precv)
!!$ write(0,*) ' NLEVS: ',prec%nlevs, val,size(prec%precv)
end function amg_d_get_nlevs
@@ -532,9 +532,9 @@ contains
if (num >= dzero) then
den = num
nl = prec%get_nlevs()
write(0,*) 'Inside cmp_compl ',nl,size(prec%precv)
!!$ write(0,*) 'Inside cmp_compl ',nl,size(prec%precv)
do il=2, nl
write(0,*) ' ',il,associated(prec%precv(il)%base_a)
!!$ write(0,*) ' ',il,associated(prec%precv(il)%base_a)
num = num + max(0,prec%precv(il)%base_a%get_nzeros())
end do
end if
@@ -627,9 +627,7 @@ contains
end subroutine amg_dprecfree
subroutine amg_d_prec_free(prec,info)
implicit none
! Arguments
class(amg_dprec_type), intent(inout) :: prec
integer(psb_ipk_), intent(out) :: info
@@ -661,9 +659,7 @@ contains
end subroutine amg_d_prec_free
subroutine amg_d_smoothers_free(prec,info)
implicit none
! Arguments
class(amg_dprec_type), intent(inout) :: prec
integer(psb_ipk_), intent(out) :: info
@@ -927,7 +923,6 @@ contains
end subroutine amg_d_clone
subroutine amg_d_inner_clone(prec,precout,info)
implicit none
class(amg_dprec_type), intent(inout) :: prec
class(psb_dprec_type), target, intent(inout) :: precout
@@ -1012,7 +1007,6 @@ contains
subroutine amg_d_allocate_wrk(prec,info,vmold,desc)
use psb_base_mod
implicit none
! Arguments
class(amg_dprec_type), intent(inout) :: prec
integer(psb_ipk_), intent(out) :: info
@@ -1090,7 +1084,6 @@ contains
function amg_d_is_allocated_wrk(prec) result(res)
use psb_base_mod
implicit none
! Arguments
class(amg_dprec_type), intent(in) :: prec
logical :: res
amgprec/impl/amg_d_hierarchy_bld.F90
+63 -101
View File
@@ -243,7 +243,7 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat)
goto 9999
end if
!
! First set desired number of levels
! First set desired number of levels if different from default.
!
if (iszv /= nplevs) then
allocate(tprecv(nplevs),stat=info)
@@ -292,6 +292,7 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat)
call prec%set_nlevs(nplevs)
iszv = prec%get_nlevs()
end if
!
! Finest level first; create a GEN_BLOCK
! copy of the descriptor.
@@ -305,6 +306,10 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat)
call psb_cd_renum_block(desc_a,prec%precv(1)%desc_ac,info)
prec%precv(1)%base_desc => prec%precv(1)%desc_ac
!
! Main build loop
!
newsz = 0
stop_hierarchy_loop = .false.
array_build_loop: do i=2, iszv
@@ -313,9 +318,12 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat)
! on all processes.
!
call psb_bcast(ctxt,prec%precv(i)%parms)
!
! Get current context: might have performed remapping
!
lctxt = prec%precv(i-1)%base_desc%get_ctxt()
call psb_info(lctxt,lme,lnp)
write(0,*) 'Check at level',i,lme,lnp
!!$ write(0,*) 'Check at level',i,lme,lnp
!
! Sanity checks on the parameters
!
@@ -331,8 +339,8 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat)
& write(debug_unit,*) me,' ',trim(name),&
& 'Calling mlprcbld at level ',i
!
! Build the mapping between levels i-1 and i and the matrix
! at level i
! Build the tentative mapping between levels i-1 and i
! and the matrixat level i
!
if (do_timings) call psb_tic(idx_bldtp)
if (info == psb_success_)&
@@ -355,22 +363,25 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat)
!
call op_prol%clone(prec%precv(i)%tprol,info)
!
! Check for early termination of aggregation loop.
!
if (i == 2) then
call amg_hierarchy_bld_newsz(i,iszv,&
& desc_a%get_global_rows(),nlaggr,mnaggratio,sizeratio,newsz)
call amg_d_hierarchy_bld_cmp_newsz(i,iszv,&
& desc_a%get_global_rows(),&
& nlaggr,casize,mnaggratio,sizeratio,newsz)
else
call amg_hierarchy_bld_newsz(i,iszv,&
& sum(prec%precv(i-1)%linmap%naggr),nlaggr,mnaggratio,sizeratio,newsz)
call amg_d_hierarchy_bld_cmp_newsz(i,iszv,&
& sum(prec%precv(i-1)%linmap%naggr),&
& nlaggr,casize,mnaggratio,sizeratio,newsz)
end if
prec%precv(i)%szratio = sizeratio
call psb_bcast(ctxt,newsz)
!
! Handle reallocation, if needed, and then mat_asb to polish off the
! construction
!
if (newsz > 0) then
!
! This is awkward, we are saving the aggregation parms, for the sake
@@ -405,8 +416,6 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat)
goto 9999
endif
!!$ write(0,*) ' Early exit of array_build_loop',i,iszv,info,&
!!$ & prec%precv(i)%remap_data%desc_ac_pre_remap%is_asb()
!!$ exit array_build_loop
level = newsz
stop_hierarchy_loop = .true.
else
@@ -420,27 +429,27 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat)
!
! Do we want to remap onto a smaller subset of processes?
! Will need a more sophisticated policy
!
if (amg_policy_do_remap(level,sum(nlaggr))) then
block
type(psb_ctxt_type) :: lctxt
integer(psb_ipk_) :: lme,lnp
lctxt = prec%precv(level)%desc_ac%get_ctxt()
call psb_info(lctxt,lme,lnp)
write(0,*) ' Context on remapping ',lme,lnp
if (amg_d_policy_do_remap(lctxt,level,sum(nlaggr))) then
!!$ write(0,*) ' Context on remapping ',lme,lnp
if ((lme >=0).and.(lnp>=2)) then
associate(lv=>prec%precv(level), rmp => prec%precv(level)%remap_data)
call lv%desc_ac%clone(rmp%desc_ac_pre_remap,info)
call lv%ac%clone(rmp%ac_pre_remap,info)
write(0,*) 'During first remapping desc_ac:',lv%desc_ac%is_asb(),&
& rmp%desc_ac_pre_remap%is_asb()
write(0,*) ' First Doing remapping ',lnp, lnp/2
!!$ write(0,*) 'During first remapping desc_ac:',lv%desc_ac%is_asb(),&
!!$ & rmp%desc_ac_pre_remap%is_asb()
!!$ write(0,*) ' First Doing remapping ',lnp, lnp/2
call psb_remap(lnp/2,rmp%desc_ac_pre_remap,rmp%ac_pre_remap,&
& rmp%idest,rmp%isrc,rmp%nrsrc,rmp%naggr,lv%desc_ac,lv%ac,info)
!!$ write(0,*) me,' Out of remapping ',rmp%desc_ac_pre_remap%get_fmt(),' ',&
!!$ & lv%desc_ac%get_fmt(),sum(lv%linmap%naggr),sum(rmp%naggr)
write(0,*) 'First Assignment ',size(lv%linmap%naggr),size(rmp%naggr)
!!$ write(0,*) 'First Assignment ',size(lv%linmap%naggr),size(rmp%naggr)
lv%linmap%naggr(:) = rmp%naggr(:)
lv%linmap%p_desc_V => rmp%desc_ac_pre_remap
lv%base_a => lv%ac
@@ -452,16 +461,16 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat)
call psb_info(ct,meu,npu)
ct = lv%linmap%p_desc_V%get_ctxt()
call psb_info(ct,mev,npv)
write(0,*) 'First Check on out remapping ',i,&
& rmp%desc_ac_pre_remap%is_asb(),&
& ':',meu,npu,mev,npv
!!$ write(0,*) 'First Check on out remapping ',i,&
!!$ & rmp%desc_ac_pre_remap%is_asb(),&
!!$ & ':',meu,npu,mev,npv
end block
end associate
end if
end block
write(0,*) 'Second Check on out remapping ',level,&
& prec%precv(level)%remap_data%desc_ac_pre_remap%is_asb()
!!$ write(0,*) 'Second Check on out remapping ',level,&
!!$ & prec%precv(level)%remap_data%desc_ac_pre_remap%is_asb(), newsz
end if
end block
if (info /= psb_success_) then
write(ch_err,'(a,i7)') 'Mat asb fail @ level ',i
@@ -476,82 +485,31 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat)
end if
end do array_build_loop
write(0,*) ' Done array_build_loop',iszv,newsz,info,psb_errstatus_fatal()
!!$ write(0,*) ' Done array_build_loop',iszv,newsz,info,psb_errstatus_fatal()
if (newsz>0) then
do i=2,newsz
write(0,*) me,'Newsz Out of array_build_loop ',i,':',&
& prec%precv(i)%remap_data%desc_ac_pre_remap%is_asb()
end do
write(0,*) 'Calling set_nlevs ',newsz
!!$ do i=2,newsz
!!$ write(0,*) me,'Newsz Out of array_build_loop ',i,':',&
!!$ & prec%precv(i)%remap_data%desc_ac_pre_remap%is_asb()
!!$ end do
!!$ write(0,*) 'Calling set_nlevs ',newsz
call prec%set_nlevs(newsz)
else
do i=2, iszv
write(0,*) me,'Out of array_build_loop ',i,':',&
& prec%precv(i)%remap_data%desc_ac_pre_remap%is_asb()
end do
!!$ do i=2, iszv
!!$ write(0,*) me,'Out of array_build_loop ',i,':',&
!!$ & prec%precv(i)%remap_data%desc_ac_pre_remap%is_asb()
!!$ end do
end if
iszv = prec%get_nlevs()
call psb_barrier(ctxt)
if (.false.) then
if (newsz > 0) then
!
! We exited early from the build loop, need to fix
! the size.
!
allocate(tprecv(newsz),stat=info)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,&
& a_err='prec reallocation')
goto 9999
endif
do i=1,newsz
call prec%precv(i)%move_alloc(tprecv(i),info)
end do
do i=newsz+1, iszv
call prec%precv(i)%free(info)
end do
call move_alloc(tprecv,prec%precv)
! Ignore errors from transfer
info = psb_success_
!
! Restart
iszv = newsz
! Fix the pointers, but the level 1 should
! be treated differently
if (.not.associated(prec%precv(1)%base_a,a)) then
prec%precv(1)%base_a => prec%precv(1)%ac
end if
if (.not.associated(prec%precv(1)%base_desc,desc_a)) then
prec%precv(1)%base_desc => prec%precv(1)%desc_ac
end if
do i=2, iszv
prec%precv(i)%base_a => prec%precv(i)%ac
prec%precv(i)%base_desc => prec%precv(i)%desc_ac
! This is needed when the linmap object has been built
! reusing the base_desc descriptor through a pointer.
! With PSBLAS 4 we will have a better solution
if (associated(prec%precv(i)%linmap%p_desc_U)) &
& prec%precv(i)%linmap%p_desc_U => prec%precv(i-1)%base_desc
if (associated(prec%precv(i)%linmap%p_desc_V))&
& prec%precv(i)%linmap%p_desc_V => prec%precv(i)%base_desc
end do
end if
else
if (.not.associated(prec%precv(1)%base_a,a)) then
prec%precv(1)%base_a => prec%precv(1)%ac
end if
if (.not.associated(prec%precv(1)%base_desc,desc_a)) then
prec%precv(1)%base_desc => prec%precv(1)%desc_ac
end if
end if
write(0,*) ' Done reallocating precv',iszv,newsz,info
do i=2, iszv
write(0,*) me,'At end of hierarchy_bld level',i,':',&
& prec%precv(i)%remap_data%desc_ac_pre_remap%is_asb()
end do
!!$ write(0,*) ' Done reallocating precv',iszv,newsz,info
!!$
!!$ do i=2, iszv
!!$ write(0,*) me,'At end of hierarchy_bld level',i,':',&
!!$ & prec%precv(i)%remap_data%desc_ac_pre_remap%is_asb()
!!$ end do
call psb_barrier(ctxt)
@@ -562,8 +520,8 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat)
endif
iszv = prec%get_nlevs()
write(0,*) 'Going for cmp_complexity ',&
& allocated(prec%precv),iszv,size(prec%precv)
!!$ write(0,*) 'Going for cmp_complexity ',&
!!$ & allocated(prec%precv),iszv,size(prec%precv)
call prec%cmp_complexity()
call prec%cmp_avg_cr()
@@ -704,34 +662,37 @@ contains
end subroutine restore_smoothers
#endif
function amg_policy_do_remap(level,aggsize) result(res)
function amg_d_policy_do_remap(ctxt,level,aggsize) result(res)
logical :: res
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: level
integer(psb_lpk_) :: aggsize
res = amg_get_do_remap().and.(level>=2)
!!$ res = .false.
end function amg_policy_do_remap
end function amg_d_policy_do_remap
subroutine amg_hierarchy_bld_newsz(level,iszv,prevsize,&
& nlaggr,mnratio,sizeratio,newsz)
subroutine amg_d_hierarchy_bld_cmp_newsz(level,iszv,prevsize,&
& nlaggr,casize,mnratio,sizeratio,newsz)
implicit none
integer(psb_ipk_) :: level,iszv,newsz
integer(psb_lpk_) :: nlaggr(:)
integer(psb_lpk_) :: prevsize
integer(psb_lpk_) :: prevsize, casize
real(psb_dpk_) :: mnratio, sizeratio
! ==============================
integer(psb_lpk_) :: iaggsize, casize
integer(psb_lpk_) :: iaggsize
newsz = 0
iaggsize = sum(nlaggr)
sizeratio = prevsize
sizeratio = sizeratio/iaggsize
!!$ write(0,*) 'From cmp_newsz: ',iaggsize,casize,&
!!$ & sizeratio,mnratio, level
if (iaggsize <= casize) newsz = level
if (level == iszv) newsz = level
if (level>2) then
if (sizeratio < mnaggratio) then
if (sizeratio < mnratio) then
if (sizeratio > 1) then
newsz = level
else
@@ -742,6 +703,7 @@ contains
end if
end if
end if
end subroutine amg_hierarchy_bld_newsz
!!$ write(0,*) 'At end of cmp_newsz ',newsz
end subroutine amg_d_hierarchy_bld_cmp_newsz
end subroutine amg_d_hierarchy_bld
amgprec/impl/amg_dfile_prec_descr.f90
+1 -2
View File
@@ -130,8 +130,6 @@ subroutine amg_dfile_prec_descr(prec,info,iout,root, verbosity,prefix)
!
if (me == root_) then
nlev = prec%get_nlevs()
write(0,*) 'From file_prec_descr: nlev ',nlev
flush(0)
do ilev = 1, nlev
if (.not.allocated(prec%precv(ilev)%sm)) then
info = 3111
@@ -143,6 +141,7 @@ subroutine amg_dfile_prec_descr(prec,info,iout,root, verbosity,prefix)
write(iout_,*)
write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner description'
write(iout_,*) 'At level :',1,' we have ',np,' processes'
if (nlev == 1) then
!
amgprec/impl/amg_dmlprec_aply.f90
+4 -4
View File
@@ -605,7 +605,7 @@ contains
if(debug_level > 1) then
write(debug_unit,*) me,' inner_mult at level ',level
end if
write(debug_unit,*) me,' inner_mult at level (1):',level,np
!!$ write(debug_unit,*) me,' inner_mult at level (1):',level,np
sweeps_post = p%precv(level)%parms%sweeps_post
sweeps_pre = p%precv(level)%parms%sweeps_pre
pre = ((sweeps_pre>0).and.(trans=='N')).or.((sweeps_post>0).and.(trans/='N'))
@@ -615,8 +615,8 @@ 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)
write(0,*) 'Inner mult at level (2):',level,' :',me,np,':',&
& size(p%precv(level)%wrk%wv), allocated(p%precv(level)%wrk%wv)
!!$ write(0,*) 'Inner mult at level (2):',level,' :',me,np,':',&
!!$ & size(p%precv(level)%wrk%wv), allocated(p%precv(level)%wrk%wv)
if (me >=0) then
if (level < nlev) then
@@ -664,7 +664,7 @@ contains
goto 9999
end if
write(0,*) me,' Map_rstr from ', level,' to ',level+1
!!$ write(0,*) me,' Map_rstr from ', level,' to ',level+1
call p%precv(level+1)%map_rstr(done,vty,&
& dzero,p%precv(level+1)%wrk%vx2l,&
& info,work=work,vtx=wv(1))
amgprec/impl/amg_dprecinit.F90
+2 -1
View File
@@ -240,6 +240,8 @@ subroutine amg_dprecinit(ctxt,prec,ptype,info)
do ilev_ = 1, nlev_
call prec%precv(ilev_)%default()
end do
call prec%set_nlevs(nlev_)
call prec%set('ML_CYCLE','VCYCLE',info)
call prec%set('SMOOTHER_TYPE','FBGS',info)
#if defined(AMG_HAVE_UMF)
@@ -256,7 +258,6 @@ subroutine amg_dprecinit(ctxt,prec,ptype,info)
&': Warning: Unknown preconditioner type request "',ptype,'"'
info = psb_err_pivot_too_small_
end select
call prec%set_nlevs(nlev_)
call psb_erractionrestore(err_act)
return
amgprec/impl/level/amg_d_base_onelev_map_rstr.F90
+13 -13
View File
@@ -49,7 +49,7 @@ subroutine amg_d_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,&
type(psb_d_vect_type), pointer :: vty_
integer(psb_mpk_) :: me, np
write(0,*) 'New map_rstr ',lv%remap_data%ac_pre_remap%is_asb()
!!$ write(0,*) 'New map_rstr ',lv%remap_data%ac_pre_remap%is_asb()
if (present(vty)) then
vty_ => vty
else
@@ -60,7 +60,7 @@ subroutine amg_d_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,&
!
! Remap has happened, deal with it
!
write(0,*) 'Level map_rstr with remapping '
!!$ write(0,*) 'Level map_rstr with remapping '
block
type(psb_ctxt_type) :: ctxt, rctxt
integer(psb_mpk_) :: i,j,ip, idest, nsrc, nrl, kp
@@ -72,25 +72,25 @@ subroutine amg_d_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,&
call psb_info(ctxt,me,np)
rctxt = lv%desc_ac%get_ctxt()
call psb_info(rctxt,rme,rnp)
write(0,*) 'New context map rstr',rme,rnp,me,np
!!$ write(0,*) 'New context map rstr',rme,rnp,me,np
idest = lv%remap_data%idest
associate(isrc => lv%remap_data%isrc, nrsrc => lv%remap_data%nrsrc)
write(0,*) 'Should apply maps, then send data from ',me,' to ',idest
if (rme >= 0) write(0,*) rme, ' Receiving data from ',isrc(:)
!!$ write(0,*) 'Should apply maps, then send data from ',me,' to ',idest
!!$ if (rme >= 0) write(0,*) rme, ' Receiving data from ',isrc(:)
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,mold=vect_u%v)
write(0,*) me,' remap map_rstr calling U2V: ',me,np,rme,rnp,tv%get_nrows(),&
& psb_errstatus_fatal()
flush(0)
!!$ write(0,*) me,' remap map_rstr calling U2V: ',me,np,rme,rnp,tv%get_nrows(),&
!!$ & psb_errstatus_fatal()
!!$ flush(0)
call psb_barrier(ctxt)
call lv%linmap%map_U2V(alpha,vect_u,beta,tv,info,&
& work=work,vtx=vtx,vty=vty_)
!call tv%sync()
!rsnd = tv%get_vect()
!call psb_snd(ctxt,rsnd(1:nrl),idest)
write(0,*) me,' map_rstr sending ',me,idest,psb_errstatus_fatal()
!!$ write(0,*) me,' map_rstr sending ',me,idest,psb_errstatus_fatal()
call psb_snd(ctxt,tv%v%v(1:nrl),idest)
if (rme >=0) then
allocate(rrcv(sum(nrsrc)))
@@ -99,14 +99,14 @@ subroutine amg_d_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,&
do i = 1,size(isrc)
ip = isrc(i)
nrl = nrsrc(i)
write(0,*) me,' map_rstr receiving',rme,ip,psb_errstatus_fatal()
!!$ write(0,*) me,' map_rstr receiving',rme,ip,psb_errstatus_fatal()
call psb_rcv(ctxt,rrcv(kp+1:kp+nrl),ip)
kp = kp + nrl
end do
call vect_v%set_vect(rrcv)
end if
end associate
write(0,*) me, ' Restrictor with remap done ',psb_errstatus_fatal()
!!$ write(0,*) me, ' Restrictor with remap done ',psb_errstatus_fatal()
end block
else
@@ -115,12 +115,12 @@ subroutine amg_d_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,&
type(psb_ctxt_type) :: ctxt, rctxt
ctxt = lv%linmap%p_desc_U%get_ctxt()
call psb_info(ctxt,me,np)
write(0,*) me,' map_rstr calling U2V: ',me,np
!!$ write(0,*) me,' map_rstr calling U2V: ',me,np
call lv%linmap%map_U2V(alpha,vect_u,beta,vect_v,info,&
& work=work,vtx=vtx,vty=vty_)
end block
end if
write(0,*) me, 'End of restriction ',info,psb_errstatus_fatal()
!!$ write(0,*) me, 'End of restriction ',info,psb_errstatus_fatal()
end subroutine amg_d_base_onelev_map_rstr_v
subroutine amg_d_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work)
samples/advanced/remap/amg_d_pde3d.F90
+10 -10
View File
@@ -473,10 +473,10 @@ program amg_d_pde3d
goto 9999
end if
do i=2, size(prec%precv)
write(0,*) iam,'Between hier and smoothers_bld level',i,':',&
& prec%precv(i)%remap_data%desc_ac_pre_remap%is_asb()
end do
!!$ do i=2, size(prec%precv)
!!$ write(0,*) iam,'Between hier and smoothers_bld level',i,':',&
!!$ & prec%precv(i)%remap_data%desc_ac_pre_remap%is_asb()
!!$ end do
call psb_barrier(ctxt)
t1 = psb_wtime()
@@ -497,11 +497,11 @@ program amg_d_pde3d
write(psb_out_unit,'(" ")')
end if
do i=2, size(prec%precv)
write(0,*) iam,'After smoothers_bld level',i,':',&
& prec%precv(i)%remap_data%desc_ac_pre_remap%is_asb()
end do
!!$ do i=2, size(prec%precv)
!!$ write(0,*) iam,'After smoothers_bld level',i,':',&
!!$ & prec%precv(i)%remap_data%desc_ac_pre_remap%is_asb()
!!$ end do
!!$
call prec%descr(info,iout=psb_out_unit)
if (p_choice%dump) then
@@ -565,7 +565,7 @@ program amg_d_pde3d
call psb_sum(ctxt,amatsize)
call psb_sum(ctxt,descsize)
call psb_sum(ctxt,precsize)
call prec%descr(info,iout=psb_out_unit)
!!$ call prec%descr(info,iout=psb_out_unit)
if (iam == psb_root_) then
write(psb_out_unit,'("Computed solution on ",i8," process(es)")') np
write(psb_out_unit,'("Number of threads : ",i12)') nth