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

Check error conditions in single level apply. Make sure AS vectors are good.

Browse Source
This commit is contained in:
Salvatore Filippone
2018-01-16 14:42:12 +00:00
parent cbe0a5754f
commit 6178a2ec13
8 changed files with 196 additions and 60 deletions
Download Patch File Download Diff File Expand all files Collapse all files
mlprec/impl/mld_cprecaply.f90
+29 -13
View File
@@ -391,17 +391,17 @@ subroutine mld_cprecaply2_vect(prec,x,y,desc_data,info,trans,work)
select case(trans_)
case ('N')
do k=1, nswps
call prec%precv(1)%sm%apply(cone,w1,czero,w2,desc_data,trans_,&
if (info == 0) call prec%precv(1)%sm%apply(cone,w1,czero,w2,desc_data,trans_,&
& ione, work_,wv,info)
call prec%precv(1)%sm2a%apply(cone,w2,czero,w1,desc_data,trans_,&
if (info == 0) call prec%precv(1)%sm2a%apply(cone,w2,czero,w1,desc_data,trans_,&
& ione, work_,wv,info)
end do
case('T','C')
do k=1, nswps
call prec%precv(1)%sm2a%apply(cone,w1,czero,w2,desc_data,trans_,&
if (info == 0) call prec%precv(1)%sm2a%apply(cone,w1,czero,w2,desc_data,trans_,&
& ione, work_,wv,info)
call prec%precv(1)%sm%apply(cone,w2,czero,w1,desc_data,trans_,&
if (info == 0) call prec%precv(1)%sm%apply(cone,w2,czero,w1,desc_data,trans_,&
& ione, work_,wv,info)
end do
case default
@@ -409,15 +409,22 @@ subroutine mld_cprecaply2_vect(prec,x,y,desc_data,info,trans,work)
call psb_errpush(info,name,a_err='Invalid trans')
goto 9999
end select
call psb_geaxpby(cone,w1,czero,y,desc_data,info)
if (info == 0) call psb_geaxpby(cone,w1,czero,y,desc_data,info)
else
call prec%precv(1)%sm%apply(cone,x,czero,y,desc_data,trans_,&
if (info == 0) call prec%precv(1)%sm%apply(cone,x,czero,y,desc_data,trans_,&
& nswps,work_,wv,info)
end if
end associate
if (psb_get_errstatus() /=0) info = psb_err_internal_error_
if (info /= 0) then
info = psb_err_from_subroutine_ai_
call psb_errpush(info,name,a_err='Smoother application',&
& i_Err=(/ione*size(prec%precv),izero,izero,izero,izero/))
goto 9999
end if
else
info = psb_err_from_subroutine_ai_
call psb_errpush(info,name,a_err='Invalid size of precv',&
& i_Err=(/ione*size(prec%precv),izero,izero,izero,izero/))
@@ -530,16 +537,16 @@ subroutine mld_cprecaply1_vect(prec,x,desc_data,info,trans,work)
select case(trans_)
case ('N')
do k=1, nswps
call prec%precv(1)%sm%apply(cone,x,czero,ww,desc_data,trans_,&
if (info == 0) call prec%precv(1)%sm%apply(cone,x,czero,ww,desc_data,trans_,&
& ione, work_,wv,info)
call prec%precv(1)%sm2a%apply(cone,ww,czero,x,desc_data,trans_,&
if (info == 0) call prec%precv(1)%sm2a%apply(cone,ww,czero,x,desc_data,trans_,&
& ione, work_,wv,info)
end do
case('T','C')
do k=1, nswps
call prec%precv(1)%sm2a%apply(cone,x,czero,ww,desc_data,trans_,&
if (info == 0) call prec%precv(1)%sm2a%apply(cone,x,czero,ww,desc_data,trans_,&
& ione, work_,wv,info)
call prec%precv(1)%sm%apply(cone,ww,czero,x,desc_data,trans_,&
if (info == 0) call prec%precv(1)%sm%apply(cone,ww,czero,x,desc_data,trans_,&
& ione, work_,wv,info)
end do
case default
@@ -549,10 +556,19 @@ subroutine mld_cprecaply1_vect(prec,x,desc_data,info,trans,work)
end select
else
call prec%precv(1)%sm%apply(cone,x,czero,ww,desc_data,trans_,&
if (info == 0) call prec%precv(1)%sm%apply(cone,x,czero,ww,desc_data,trans_,&
& nswps, work_,wv,info)
if (info == 0) call psb_geaxpby(cone,ww,czero,x,desc_data,info)
end if
if (psb_get_errstatus() /=0) info = psb_err_internal_error_
if (info /=0) then
info = psb_err_internal_error_
call psb_errpush(info,name,a_err='Smoother application',&
& i_Err=(/ione*size(prec%precv),izero,izero,izero,izero/))
goto 9999
end if
else
info = psb_err_from_subroutine_ai_
mlprec/impl/mld_dprecaply.f90
+29 -13
View File
@@ -391,17 +391,17 @@ subroutine mld_dprecaply2_vect(prec,x,y,desc_data,info,trans,work)
select case(trans_)
case ('N')
do k=1, nswps
call prec%precv(1)%sm%apply(done,w1,dzero,w2,desc_data,trans_,&
if (info == 0) call prec%precv(1)%sm%apply(done,w1,dzero,w2,desc_data,trans_,&
& ione, work_,wv,info)
call prec%precv(1)%sm2a%apply(done,w2,dzero,w1,desc_data,trans_,&
if (info == 0) call prec%precv(1)%sm2a%apply(done,w2,dzero,w1,desc_data,trans_,&
& ione, work_,wv,info)
end do
case('T','C')
do k=1, nswps
call prec%precv(1)%sm2a%apply(done,w1,dzero,w2,desc_data,trans_,&
if (info == 0) call prec%precv(1)%sm2a%apply(done,w1,dzero,w2,desc_data,trans_,&
& ione, work_,wv,info)
call prec%precv(1)%sm%apply(done,w2,dzero,w1,desc_data,trans_,&
if (info == 0) call prec%precv(1)%sm%apply(done,w2,dzero,w1,desc_data,trans_,&
& ione, work_,wv,info)
end do
case default
@@ -409,15 +409,22 @@ subroutine mld_dprecaply2_vect(prec,x,y,desc_data,info,trans,work)
call psb_errpush(info,name,a_err='Invalid trans')
goto 9999
end select
call psb_geaxpby(done,w1,dzero,y,desc_data,info)
if (info == 0) call psb_geaxpby(done,w1,dzero,y,desc_data,info)
else
call prec%precv(1)%sm%apply(done,x,dzero,y,desc_data,trans_,&
if (info == 0) call prec%precv(1)%sm%apply(done,x,dzero,y,desc_data,trans_,&
& nswps,work_,wv,info)
end if
end associate
if (psb_get_errstatus() /=0) info = psb_err_internal_error_
if (info /= 0) then
info = psb_err_from_subroutine_ai_
call psb_errpush(info,name,a_err='Smoother application',&
& i_Err=(/ione*size(prec%precv),izero,izero,izero,izero/))
goto 9999
end if
else
info = psb_err_from_subroutine_ai_
call psb_errpush(info,name,a_err='Invalid size of precv',&
& i_Err=(/ione*size(prec%precv),izero,izero,izero,izero/))
@@ -530,16 +537,16 @@ subroutine mld_dprecaply1_vect(prec,x,desc_data,info,trans,work)
select case(trans_)
case ('N')
do k=1, nswps
call prec%precv(1)%sm%apply(done,x,dzero,ww,desc_data,trans_,&
if (info == 0) call prec%precv(1)%sm%apply(done,x,dzero,ww,desc_data,trans_,&
& ione, work_,wv,info)
call prec%precv(1)%sm2a%apply(done,ww,dzero,x,desc_data,trans_,&
if (info == 0) call prec%precv(1)%sm2a%apply(done,ww,dzero,x,desc_data,trans_,&
& ione, work_,wv,info)
end do
case('T','C')
do k=1, nswps
call prec%precv(1)%sm2a%apply(done,x,dzero,ww,desc_data,trans_,&
if (info == 0) call prec%precv(1)%sm2a%apply(done,x,dzero,ww,desc_data,trans_,&
& ione, work_,wv,info)
call prec%precv(1)%sm%apply(done,ww,dzero,x,desc_data,trans_,&
if (info == 0) call prec%precv(1)%sm%apply(done,ww,dzero,x,desc_data,trans_,&
& ione, work_,wv,info)
end do
case default
@@ -549,10 +556,19 @@ subroutine mld_dprecaply1_vect(prec,x,desc_data,info,trans,work)
end select
else
call prec%precv(1)%sm%apply(done,x,dzero,ww,desc_data,trans_,&
if (info == 0) call prec%precv(1)%sm%apply(done,x,dzero,ww,desc_data,trans_,&
& nswps, work_,wv,info)
if (info == 0) call psb_geaxpby(done,ww,dzero,x,desc_data,info)
end if
if (psb_get_errstatus() /=0) info = psb_err_internal_error_
if (info /=0) then
info = psb_err_internal_error_
call psb_errpush(info,name,a_err='Smoother application',&
& i_Err=(/ione*size(prec%precv),izero,izero,izero,izero/))
goto 9999
end if
else
info = psb_err_from_subroutine_ai_
mlprec/impl/mld_sprecaply.f90
+29 -13
View File
@@ -391,17 +391,17 @@ subroutine mld_sprecaply2_vect(prec,x,y,desc_data,info,trans,work)
select case(trans_)
case ('N')
do k=1, nswps
call prec%precv(1)%sm%apply(sone,w1,szero,w2,desc_data,trans_,&
if (info == 0) call prec%precv(1)%sm%apply(sone,w1,szero,w2,desc_data,trans_,&
& ione, work_,wv,info)
call prec%precv(1)%sm2a%apply(sone,w2,szero,w1,desc_data,trans_,&
if (info == 0) call prec%precv(1)%sm2a%apply(sone,w2,szero,w1,desc_data,trans_,&
& ione, work_,wv,info)
end do
case('T','C')
do k=1, nswps
call prec%precv(1)%sm2a%apply(sone,w1,szero,w2,desc_data,trans_,&
if (info == 0) call prec%precv(1)%sm2a%apply(sone,w1,szero,w2,desc_data,trans_,&
& ione, work_,wv,info)
call prec%precv(1)%sm%apply(sone,w2,szero,w1,desc_data,trans_,&
if (info == 0) call prec%precv(1)%sm%apply(sone,w2,szero,w1,desc_data,trans_,&
& ione, work_,wv,info)
end do
case default
@@ -409,15 +409,22 @@ subroutine mld_sprecaply2_vect(prec,x,y,desc_data,info,trans,work)
call psb_errpush(info,name,a_err='Invalid trans')
goto 9999
end select
call psb_geaxpby(sone,w1,szero,y,desc_data,info)
if (info == 0) call psb_geaxpby(sone,w1,szero,y,desc_data,info)
else
call prec%precv(1)%sm%apply(sone,x,szero,y,desc_data,trans_,&
if (info == 0) call prec%precv(1)%sm%apply(sone,x,szero,y,desc_data,trans_,&
& nswps,work_,wv,info)
end if
end associate
if (psb_get_errstatus() /=0) info = psb_err_internal_error_
if (info /= 0) then
info = psb_err_from_subroutine_ai_
call psb_errpush(info,name,a_err='Smoother application',&
& i_Err=(/ione*size(prec%precv),izero,izero,izero,izero/))
goto 9999
end if
else
info = psb_err_from_subroutine_ai_
call psb_errpush(info,name,a_err='Invalid size of precv',&
& i_Err=(/ione*size(prec%precv),izero,izero,izero,izero/))
@@ -530,16 +537,16 @@ subroutine mld_sprecaply1_vect(prec,x,desc_data,info,trans,work)
select case(trans_)
case ('N')
do k=1, nswps
call prec%precv(1)%sm%apply(sone,x,szero,ww,desc_data,trans_,&
if (info == 0) call prec%precv(1)%sm%apply(sone,x,szero,ww,desc_data,trans_,&
& ione, work_,wv,info)
call prec%precv(1)%sm2a%apply(sone,ww,szero,x,desc_data,trans_,&
if (info == 0) call prec%precv(1)%sm2a%apply(sone,ww,szero,x,desc_data,trans_,&
& ione, work_,wv,info)
end do
case('T','C')
do k=1, nswps
call prec%precv(1)%sm2a%apply(sone,x,szero,ww,desc_data,trans_,&
if (info == 0) call prec%precv(1)%sm2a%apply(sone,x,szero,ww,desc_data,trans_,&
& ione, work_,wv,info)
call prec%precv(1)%sm%apply(sone,ww,szero,x,desc_data,trans_,&
if (info == 0) call prec%precv(1)%sm%apply(sone,ww,szero,x,desc_data,trans_,&
& ione, work_,wv,info)
end do
case default
@@ -549,10 +556,19 @@ subroutine mld_sprecaply1_vect(prec,x,desc_data,info,trans,work)
end select
else
call prec%precv(1)%sm%apply(sone,x,szero,ww,desc_data,trans_,&
if (info == 0) call prec%precv(1)%sm%apply(sone,x,szero,ww,desc_data,trans_,&
& nswps, work_,wv,info)
if (info == 0) call psb_geaxpby(sone,ww,szero,x,desc_data,info)
end if
if (psb_get_errstatus() /=0) info = psb_err_internal_error_
if (info /=0) then
info = psb_err_internal_error_
call psb_errpush(info,name,a_err='Smoother application',&
& i_Err=(/ione*size(prec%precv),izero,izero,izero,izero/))
goto 9999
end if
else
info = psb_err_from_subroutine_ai_
mlprec/impl/mld_zprecaply.f90
+29 -13
View File
@@ -391,17 +391,17 @@ subroutine mld_zprecaply2_vect(prec,x,y,desc_data,info,trans,work)
select case(trans_)
case ('N')
do k=1, nswps
call prec%precv(1)%sm%apply(zone,w1,zzero,w2,desc_data,trans_,&
if (info == 0) call prec%precv(1)%sm%apply(zone,w1,zzero,w2,desc_data,trans_,&
& ione, work_,wv,info)
call prec%precv(1)%sm2a%apply(zone,w2,zzero,w1,desc_data,trans_,&
if (info == 0) call prec%precv(1)%sm2a%apply(zone,w2,zzero,w1,desc_data,trans_,&
& ione, work_,wv,info)
end do
case('T','C')
do k=1, nswps
call prec%precv(1)%sm2a%apply(zone,w1,zzero,w2,desc_data,trans_,&
if (info == 0) call prec%precv(1)%sm2a%apply(zone,w1,zzero,w2,desc_data,trans_,&
& ione, work_,wv,info)
call prec%precv(1)%sm%apply(zone,w2,zzero,w1,desc_data,trans_,&
if (info == 0) call prec%precv(1)%sm%apply(zone,w2,zzero,w1,desc_data,trans_,&
& ione, work_,wv,info)
end do
case default
@@ -409,15 +409,22 @@ subroutine mld_zprecaply2_vect(prec,x,y,desc_data,info,trans,work)
call psb_errpush(info,name,a_err='Invalid trans')
goto 9999
end select
call psb_geaxpby(zone,w1,zzero,y,desc_data,info)
if (info == 0) call psb_geaxpby(zone,w1,zzero,y,desc_data,info)
else
call prec%precv(1)%sm%apply(zone,x,zzero,y,desc_data,trans_,&
if (info == 0) call prec%precv(1)%sm%apply(zone,x,zzero,y,desc_data,trans_,&
& nswps,work_,wv,info)
end if
end associate
if (psb_get_errstatus() /=0) info = psb_err_internal_error_
if (info /= 0) then
info = psb_err_from_subroutine_ai_
call psb_errpush(info,name,a_err='Smoother application',&
& i_Err=(/ione*size(prec%precv),izero,izero,izero,izero/))
goto 9999
end if
else
info = psb_err_from_subroutine_ai_
call psb_errpush(info,name,a_err='Invalid size of precv',&
& i_Err=(/ione*size(prec%precv),izero,izero,izero,izero/))
@@ -530,16 +537,16 @@ subroutine mld_zprecaply1_vect(prec,x,desc_data,info,trans,work)
select case(trans_)
case ('N')
do k=1, nswps
call prec%precv(1)%sm%apply(zone,x,zzero,ww,desc_data,trans_,&
if (info == 0) call prec%precv(1)%sm%apply(zone,x,zzero,ww,desc_data,trans_,&
& ione, work_,wv,info)
call prec%precv(1)%sm2a%apply(zone,ww,zzero,x,desc_data,trans_,&
if (info == 0) call prec%precv(1)%sm2a%apply(zone,ww,zzero,x,desc_data,trans_,&
& ione, work_,wv,info)
end do
case('T','C')
do k=1, nswps
call prec%precv(1)%sm2a%apply(zone,x,zzero,ww,desc_data,trans_,&
if (info == 0) call prec%precv(1)%sm2a%apply(zone,x,zzero,ww,desc_data,trans_,&
& ione, work_,wv,info)
call prec%precv(1)%sm%apply(zone,ww,zzero,x,desc_data,trans_,&
if (info == 0) call prec%precv(1)%sm%apply(zone,ww,zzero,x,desc_data,trans_,&
& ione, work_,wv,info)
end do
case default
@@ -549,10 +556,19 @@ subroutine mld_zprecaply1_vect(prec,x,desc_data,info,trans,work)
end select
else
call prec%precv(1)%sm%apply(zone,x,zzero,ww,desc_data,trans_,&
if (info == 0) call prec%precv(1)%sm%apply(zone,x,zzero,ww,desc_data,trans_,&
& nswps, work_,wv,info)
if (info == 0) call psb_geaxpby(zone,ww,zzero,x,desc_data,info)
end if
if (psb_get_errstatus() /=0) info = psb_err_internal_error_
if (info /=0) then
info = psb_err_internal_error_
call psb_errpush(info,name,a_err='Smoother application',&
& i_Err=(/ione*size(prec%precv),izero,izero,izero,izero/))
goto 9999
end if
else
info = psb_err_from_subroutine_ai_
mlprec/impl/smoother/mld_c_as_smoother_apply_vect.f90
+20 -2
View File
@@ -58,6 +58,7 @@ subroutine mld_c_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
type(psb_c_vect_type) :: tx, ty, ww
integer(psb_ipk_) :: ictxt,np,me, err_act,isz,int_err(5)
character :: trans_, init_
logical :: do_realloc_wv
character(len=20) :: name='c_as_smoother_apply_v', ch_err
call psb_erractionsave(err_act)
@@ -130,8 +131,25 @@ subroutine mld_c_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
& a_err='invalid wv size in smoother_apply')
goto 9999
end if
associate(tx => wv(1), ty => wv(2), ww => wv(3))
!
! This is tricky. This smoother has a descriptor sm%desc_data
! for an index space potentially different from
! that of desc_data. Hence the size of the work vectors
! could be wrong. We need to check and reallocate as needed.
!
do_realloc_wv = (wv(1)%get_nrows() < sm%desc_data%get_local_cols()).or.&
& (wv(2)%get_nrows() < sm%desc_data%get_local_cols()).or.&
& (wv(3)%get_nrows() < sm%desc_data%get_local_cols())
if (do_realloc_wv) then
call psb_geasb(wv(1),sm%desc_data,info,scratch=.true.,mold=wv(2)%v)
call psb_geasb(wv(2),sm%desc_data,info,scratch=.true.,mold=wv(1)%v)
call psb_geasb(wv(3),sm%desc_data,info,scratch=.true.,mold=wv(1)%v)
end if
associate(tx => wv(1), ty => wv(2), ww => wv(3))
! Need to zero tx because of the apply_restr call.
call tx%zero()
!
mlprec/impl/smoother/mld_d_as_smoother_apply_vect.f90
+20 -2
View File
@@ -58,6 +58,7 @@ subroutine mld_d_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
type(psb_d_vect_type) :: tx, ty, ww
integer(psb_ipk_) :: ictxt,np,me, err_act,isz,int_err(5)
character :: trans_, init_
logical :: do_realloc_wv
character(len=20) :: name='d_as_smoother_apply_v', ch_err
call psb_erractionsave(err_act)
@@ -130,8 +131,25 @@ subroutine mld_d_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
& a_err='invalid wv size in smoother_apply')
goto 9999
end if
associate(tx => wv(1), ty => wv(2), ww => wv(3))
!
! This is tricky. This smoother has a descriptor sm%desc_data
! for an index space potentially different from
! that of desc_data. Hence the size of the work vectors
! could be wrong. We need to check and reallocate as needed.
!
do_realloc_wv = (wv(1)%get_nrows() < sm%desc_data%get_local_cols()).or.&
& (wv(2)%get_nrows() < sm%desc_data%get_local_cols()).or.&
& (wv(3)%get_nrows() < sm%desc_data%get_local_cols())
if (do_realloc_wv) then
call psb_geasb(wv(1),sm%desc_data,info,scratch=.true.,mold=wv(2)%v)
call psb_geasb(wv(2),sm%desc_data,info,scratch=.true.,mold=wv(1)%v)
call psb_geasb(wv(3),sm%desc_data,info,scratch=.true.,mold=wv(1)%v)
end if
associate(tx => wv(1), ty => wv(2), ww => wv(3))
! Need to zero tx because of the apply_restr call.
call tx%zero()
!
mlprec/impl/smoother/mld_s_as_smoother_apply_vect.f90
+20 -2
View File
@@ -58,6 +58,7 @@ subroutine mld_s_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
type(psb_s_vect_type) :: tx, ty, ww
integer(psb_ipk_) :: ictxt,np,me, err_act,isz,int_err(5)
character :: trans_, init_
logical :: do_realloc_wv
character(len=20) :: name='s_as_smoother_apply_v', ch_err
call psb_erractionsave(err_act)
@@ -130,8 +131,25 @@ subroutine mld_s_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
& a_err='invalid wv size in smoother_apply')
goto 9999
end if
associate(tx => wv(1), ty => wv(2), ww => wv(3))
!
! This is tricky. This smoother has a descriptor sm%desc_data
! for an index space potentially different from
! that of desc_data. Hence the size of the work vectors
! could be wrong. We need to check and reallocate as needed.
!
do_realloc_wv = (wv(1)%get_nrows() < sm%desc_data%get_local_cols()).or.&
& (wv(2)%get_nrows() < sm%desc_data%get_local_cols()).or.&
& (wv(3)%get_nrows() < sm%desc_data%get_local_cols())
if (do_realloc_wv) then
call psb_geasb(wv(1),sm%desc_data,info,scratch=.true.,mold=wv(2)%v)
call psb_geasb(wv(2),sm%desc_data,info,scratch=.true.,mold=wv(1)%v)
call psb_geasb(wv(3),sm%desc_data,info,scratch=.true.,mold=wv(1)%v)
end if
associate(tx => wv(1), ty => wv(2), ww => wv(3))
! Need to zero tx because of the apply_restr call.
call tx%zero()
!
mlprec/impl/smoother/mld_z_as_smoother_apply_vect.f90
+20 -2
View File
@@ -58,6 +58,7 @@ subroutine mld_z_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
type(psb_z_vect_type) :: tx, ty, ww
integer(psb_ipk_) :: ictxt,np,me, err_act,isz,int_err(5)
character :: trans_, init_
logical :: do_realloc_wv
character(len=20) :: name='z_as_smoother_apply_v', ch_err
call psb_erractionsave(err_act)
@@ -130,8 +131,25 @@ subroutine mld_z_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
& a_err='invalid wv size in smoother_apply')
goto 9999
end if
associate(tx => wv(1), ty => wv(2), ww => wv(3))
!
! This is tricky. This smoother has a descriptor sm%desc_data
! for an index space potentially different from
! that of desc_data. Hence the size of the work vectors
! could be wrong. We need to check and reallocate as needed.
!
do_realloc_wv = (wv(1)%get_nrows() < sm%desc_data%get_local_cols()).or.&
& (wv(2)%get_nrows() < sm%desc_data%get_local_cols()).or.&
& (wv(3)%get_nrows() < sm%desc_data%get_local_cols())
if (do_realloc_wv) then
call psb_geasb(wv(1),sm%desc_data,info,scratch=.true.,mold=wv(2)%v)
call psb_geasb(wv(2),sm%desc_data,info,scratch=.true.,mold=wv(1)%v)
call psb_geasb(wv(3),sm%desc_data,info,scratch=.true.,mold=wv(1)%v)
end if
associate(tx => wv(1), ty => wv(2), ww => wv(3))
! Need to zero tx because of the apply_restr call.
call tx%zero()
!