|
|
|
@ -456,7 +456,7 @@ contains
|
|
|
|
|
!
|
|
|
|
|
call mld_baseprec_aply(done,baseprecv(ilev),&
|
|
|
|
|
& mlprec_wrk(ilev)%x2l,dzero,mlprec_wrk(ilev)%y2l,&
|
|
|
|
|
& baseprecv(ilev)%desc_data, 'N',work,info)
|
|
|
|
|
& baseprecv(ilev)%desc_data, trans,work,info)
|
|
|
|
|
|
|
|
|
|
enddo
|
|
|
|
|
|
|
|
|
@ -636,8 +636,7 @@ contains
|
|
|
|
|
! Apply the base preconditioner at the finest level
|
|
|
|
|
!
|
|
|
|
|
call mld_baseprec_aply(done,baseprecv(1),mlprec_wrk(1)%x2l,&
|
|
|
|
|
& dzero,mlprec_wrk(1)%y2l,&
|
|
|
|
|
& baseprecv(1)%base_desc,&
|
|
|
|
|
& dzero,mlprec_wrk(1)%y2l,baseprecv(1)%base_desc,&
|
|
|
|
|
& trans,work,info)
|
|
|
|
|
if (info /=0) then
|
|
|
|
|
call psb_errpush(4010,name,a_err=' baseprec_aply')
|
|
|
|
@ -652,7 +651,8 @@ contains
|
|
|
|
|
mlprec_wrk(1)%tx = mlprec_wrk(1)%x2l
|
|
|
|
|
|
|
|
|
|
call psb_spmm(-done,baseprecv(1)%base_a,mlprec_wrk(1)%y2l,&
|
|
|
|
|
& done,mlprec_wrk(1)%tx,baseprecv(1)%base_desc,info,work=work)
|
|
|
|
|
& done,mlprec_wrk(1)%tx,baseprecv(1)%base_desc,info,&
|
|
|
|
|
& work=work,trans=trans)
|
|
|
|
|
if (info /=0) then
|
|
|
|
|
call psb_errpush(4001,name,a_err=' fine level residual')
|
|
|
|
|
goto 9999
|
|
|
|
@ -722,7 +722,7 @@ contains
|
|
|
|
|
! Apply the base preconditioner
|
|
|
|
|
!
|
|
|
|
|
call mld_baseprec_aply(done,baseprecv(ilev),mlprec_wrk(ilev)%x2l,&
|
|
|
|
|
& dzero,mlprec_wrk(ilev)%y2l,baseprecv(ilev)%desc_data, 'N',work,info)
|
|
|
|
|
& dzero,mlprec_wrk(ilev)%y2l,baseprecv(ilev)%desc_data,trans,work,info)
|
|
|
|
|
|
|
|
|
|
!
|
|
|
|
|
! Compute the residual (at all levels but the coarsest one)
|
|
|
|
@ -731,7 +731,7 @@ contains
|
|
|
|
|
mlprec_wrk(ilev)%tx = mlprec_wrk(ilev)%x2l
|
|
|
|
|
if (info == 0) call psb_spmm(-done,baseprecv(ilev)%base_a,&
|
|
|
|
|
& mlprec_wrk(ilev)%y2l,done,mlprec_wrk(ilev)%tx,&
|
|
|
|
|
& baseprecv(ilev)%base_desc,info,work=work)
|
|
|
|
|
& baseprecv(ilev)%base_desc,info,work=work,trans=trans)
|
|
|
|
|
endif
|
|
|
|
|
if (info /=0) then
|
|
|
|
|
call psb_errpush(4001,name,a_err='Error on up sweep residual')
|
|
|
|
@ -993,7 +993,7 @@ contains
|
|
|
|
|
! Apply the base preconditioner at the coarsest level
|
|
|
|
|
!
|
|
|
|
|
call mld_baseprec_aply(done,baseprecv(nlev),mlprec_wrk(nlev)%x2l, &
|
|
|
|
|
& dzero, mlprec_wrk(nlev)%y2l,baseprecv(nlev)%desc_data,'N',work,info)
|
|
|
|
|
& dzero, mlprec_wrk(nlev)%y2l,baseprecv(nlev)%desc_data,trans,work,info)
|
|
|
|
|
if (info /=0) then
|
|
|
|
|
call psb_errpush(4010,name,a_err='baseprec_aply')
|
|
|
|
|
goto 9999
|
|
|
|
@ -1044,7 +1044,8 @@ contains
|
|
|
|
|
! Compute the residual
|
|
|
|
|
!
|
|
|
|
|
call psb_spmm(-done,baseprecv(ilev)%base_a,mlprec_wrk(ilev)%y2l,&
|
|
|
|
|
& done,mlprec_wrk(ilev)%tx,baseprecv(ilev)%base_desc,info,work=work)
|
|
|
|
|
& done,mlprec_wrk(ilev)%tx,baseprecv(ilev)%base_desc,info,&
|
|
|
|
|
& work=work,trans=trans)
|
|
|
|
|
|
|
|
|
|
!
|
|
|
|
|
! Apply the base preconditioner
|
|
|
|
@ -1212,8 +1213,7 @@ contains
|
|
|
|
|
! Apply the base preconditioner at the finest level
|
|
|
|
|
!
|
|
|
|
|
call mld_baseprec_aply(done,baseprecv(1),mlprec_wrk(1)%x2l,&
|
|
|
|
|
& dzero,mlprec_wrk(1)%y2l,&
|
|
|
|
|
& baseprecv(1)%base_desc,&
|
|
|
|
|
& dzero,mlprec_wrk(1)%y2l,baseprecv(1)%base_desc,&
|
|
|
|
|
& trans,work,info)
|
|
|
|
|
!
|
|
|
|
|
! STEP 3
|
|
|
|
@ -1222,7 +1222,8 @@ contains
|
|
|
|
|
!
|
|
|
|
|
mlprec_wrk(1)%ty = mlprec_wrk(1)%x2l
|
|
|
|
|
if (info == 0) call psb_spmm(-done,baseprecv(1)%base_a,mlprec_wrk(1)%y2l,&
|
|
|
|
|
& done,mlprec_wrk(1)%ty,baseprecv(1)%base_desc,info,work=work)
|
|
|
|
|
& done,mlprec_wrk(1)%ty,baseprecv(1)%base_desc,info,&
|
|
|
|
|
& work=work,trans=trans)
|
|
|
|
|
if (info /=0) then
|
|
|
|
|
call psb_errpush(4010,name,a_err='Fine level baseprec/residual')
|
|
|
|
|
goto 9999
|
|
|
|
@ -1296,7 +1297,7 @@ contains
|
|
|
|
|
!
|
|
|
|
|
if (info == 0) call mld_baseprec_aply(done,baseprecv(ilev),&
|
|
|
|
|
& mlprec_wrk(ilev)%x2l,dzero,mlprec_wrk(ilev)%y2l,&
|
|
|
|
|
& baseprecv(ilev)%desc_data, 'N',work,info)
|
|
|
|
|
& baseprecv(ilev)%desc_data,trans,work,info)
|
|
|
|
|
!
|
|
|
|
|
! Compute the residual (at all levels but the coarsest one)
|
|
|
|
|
!
|
|
|
|
@ -1304,7 +1305,7 @@ contains
|
|
|
|
|
mlprec_wrk(ilev)%ty = mlprec_wrk(ilev)%x2l
|
|
|
|
|
if (info == 0) call psb_spmm(-done,baseprecv(ilev)%base_a,&
|
|
|
|
|
& mlprec_wrk(ilev)%y2l,done,mlprec_wrk(ilev)%ty,&
|
|
|
|
|
& baseprecv(ilev)%base_desc,info,work=work)
|
|
|
|
|
& baseprecv(ilev)%base_desc,info,work=work,trans=trans)
|
|
|
|
|
endif
|
|
|
|
|
if (info /=0) then
|
|
|
|
|
call psb_errpush(4001,name,a_err='baseprec_aply/residual')
|
|
|
|
@ -1350,7 +1351,8 @@ contains
|
|
|
|
|
! Compute the residual
|
|
|
|
|
!
|
|
|
|
|
call psb_spmm(-done,baseprecv(ilev)%base_a,mlprec_wrk(ilev)%y2l,&
|
|
|
|
|
& done,mlprec_wrk(ilev)%tx,baseprecv(ilev)%base_desc,info,work=work)
|
|
|
|
|
& done,mlprec_wrk(ilev)%tx,baseprecv(ilev)%base_desc,info,&
|
|
|
|
|
& work=work,trans=trans)
|
|
|
|
|
!
|
|
|
|
|
! Apply the base preconditioner
|
|
|
|
|
!
|
|
|
|
|