|
|
@ -231,7 +231,7 @@
|
|
|
|
! b. Call recursively itself passing
|
|
|
|
! b. Call recursively itself passing
|
|
|
|
! r(ilev) for transfer to the next level
|
|
|
|
! r(ilev) for transfer to the next level
|
|
|
|
! (r(ilev) matches x(ilev-1) in step 1)
|
|
|
|
! (r(ilev) matches x(ilev-1) in step 1)
|
|
|
|
|
|
|
|
!
|
|
|
|
! c. Transfer y(ilev+1) to the current level:
|
|
|
|
! c. Transfer y(ilev+1) to the current level:
|
|
|
|
! y(ilev) = y(ilev) + P(ilev+1)*y(ilev+1)
|
|
|
|
! y(ilev) = y(ilev) + P(ilev+1)*y(ilev+1)
|
|
|
|
!
|
|
|
|
!
|
|
|
@ -1028,23 +1028,22 @@ subroutine mld_dmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
|
|
|
|
end if
|
|
|
|
end if
|
|
|
|
level = 1
|
|
|
|
level = 1
|
|
|
|
do level = 1, nlev
|
|
|
|
do level = 1, nlev
|
|
|
|
!!$ write(0,*) me, 'Allocating MLPREC_WRK at level ',level
|
|
|
|
|
|
|
|
call psb_geasb(mlprec_wrk(level)%vx2l,&
|
|
|
|
call psb_geasb(mlprec_wrk(level)%vx2l,&
|
|
|
|
& p%precv(level)%base_desc,info,&
|
|
|
|
& p%precv(level)%base_desc,info,&
|
|
|
|
& scratch=.true.,mold=x%v)
|
|
|
|
& scratch=.true.,mold=x%v)
|
|
|
|
if (info == 0) call psb_geasb(mlprec_wrk(level)%vy2l,&
|
|
|
|
call psb_geasb(mlprec_wrk(level)%vy2l,&
|
|
|
|
& p%precv(level)%base_desc,info,&
|
|
|
|
& p%precv(level)%base_desc,info,&
|
|
|
|
& scratch=.true.,mold=x%v)
|
|
|
|
& scratch=.true.,mold=x%v)
|
|
|
|
if (info == 0) call psb_geasb(mlprec_wrk(level)%vtx,&
|
|
|
|
call psb_geasb(mlprec_wrk(level)%vtx,&
|
|
|
|
& p%precv(level)%base_desc,info,&
|
|
|
|
& p%precv(level)%base_desc,info,&
|
|
|
|
& scratch=.true.,mold=x%v)
|
|
|
|
& scratch=.true.,mold=x%v)
|
|
|
|
if (info == 0) call psb_geasb(mlprec_wrk(level)%vty,&
|
|
|
|
call psb_geasb(mlprec_wrk(level)%vty,&
|
|
|
|
& p%precv(level)%base_desc,info,&
|
|
|
|
& p%precv(level)%base_desc,info,&
|
|
|
|
& scratch=.true.,mold=x%v)
|
|
|
|
& scratch=.true.,mold=x%v)
|
|
|
|
if ((info/=0).or.psb_errstatus_fatal()) then
|
|
|
|
if (psb_errstatus_fatal()) then
|
|
|
|
nc2l = p%precv(level)%base_desc%get_local_cols()
|
|
|
|
nc2l = p%precv(level)%base_desc%get_local_cols()
|
|
|
|
info=psb_err_alloc_request_
|
|
|
|
info=psb_err_alloc_request_
|
|
|
|
call psb_errpush(info,name,i_err=(/4*nc2l,izero,izero,izero,izero/),&
|
|
|
|
call psb_errpush(info,name,i_err=(/2*nc2l,izero,izero,izero,izero/),&
|
|
|
|
& a_err='real(psb_dpk_)')
|
|
|
|
& a_err='real(psb_dpk_)')
|
|
|
|
goto 9999
|
|
|
|
goto 9999
|
|
|
|
end if
|
|
|
|
end if
|
|
|
@ -1066,12 +1065,11 @@ subroutine mld_dmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
|
|
|
|
call psb_geaxpby(alpha,mlprec_wrk(level)%vy2l,beta,y,&
|
|
|
|
call psb_geaxpby(alpha,mlprec_wrk(level)%vy2l,beta,y,&
|
|
|
|
& p%precv(level)%base_desc,info)
|
|
|
|
& p%precv(level)%base_desc,info)
|
|
|
|
do level = 1, nlev
|
|
|
|
do level = 1, nlev
|
|
|
|
!!$ write(0,*) me, 'Freeing MLPREC_WRK at level ',level
|
|
|
|
call mlprec_wrk(level)%vx2l%free(info)
|
|
|
|
if (info == 0) call mlprec_wrk(level)%vx2l%free(info)
|
|
|
|
call mlprec_wrk(level)%vy2l%free(info)
|
|
|
|
if (info == 0) call mlprec_wrk(level)%vy2l%free(info)
|
|
|
|
call mlprec_wrk(level)%vtx%free(info)
|
|
|
|
if (info == 0) call mlprec_wrk(level)%vtx%free(info)
|
|
|
|
call mlprec_wrk(level)%vty%free(info)
|
|
|
|
if (info == 0) call mlprec_wrk(level)%vty%free(info)
|
|
|
|
if (psb_errstatus_fatal()) then
|
|
|
|
if ((info /= 0).or.psb_errstatus_fatal()) then
|
|
|
|
|
|
|
|
info=psb_err_alloc_request_
|
|
|
|
info=psb_err_alloc_request_
|
|
|
|
nc2l = p%precv(level)%base_desc%get_local_cols()
|
|
|
|
nc2l = p%precv(level)%base_desc%get_local_cols()
|
|
|
|
call psb_errpush(info,name,i_err=(/2*nc2l,izero,izero,izero,izero/),&
|
|
|
|
call psb_errpush(info,name,i_err=(/2*nc2l,izero,izero,izero,izero/),&
|
|
|
@ -1216,7 +1214,6 @@ contains
|
|
|
|
|
|
|
|
|
|
|
|
select case (trans_)
|
|
|
|
select case (trans_)
|
|
|
|
case('N')
|
|
|
|
case('N')
|
|
|
|
!!$ write(0,*) me,' Applying POST at level ',level
|
|
|
|
|
|
|
|
if (level > 1) then
|
|
|
|
if (level > 1) then
|
|
|
|
! Apply the restriction
|
|
|
|
! Apply the restriction
|
|
|
|
call psb_map_X2Y(done,mlprec_wrk(level-1)%vx2l,&
|
|
|
|
call psb_map_X2Y(done,mlprec_wrk(level-1)%vx2l,&
|
|
|
@ -1289,7 +1286,7 @@ contains
|
|
|
|
end if
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
|
|
end if
|
|
|
|
end if
|
|
|
|
!!$ write(0,*) me,' Done POST at level ',level
|
|
|
|
|
|
|
|
case('T','C')
|
|
|
|
case('T','C')
|
|
|
|
|
|
|
|
|
|
|
|
! Post-smoothing transpose is pre-smoothing
|
|
|
|
! Post-smoothing transpose is pre-smoothing
|
|
|
|