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

mld2p4-2:

Browse Source 
mlprec/impl/mld_cmlprec_aply.f90
 mlprec/impl/mld_dmlprec_aply.f90
 mlprec/impl/mld_smlprec_aply.f90
 mlprec/impl/mld_zmlprec_aply.f90

Merged mplrec_aply from preproc.
stopcriterion
Salvatore Filippone 13 years ago
parent 637863c057
commit 674fdabb11
4 changed files with 112 additions and 148 deletions
Show Stats Download Patch File Download Diff File

57
mlprec/impl/mld_cmlprec_aply.f90
Unescape Escape View File

@ -329,10 +329,10 @@ subroutine mld_cmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
integer :: debug_level, debug_unit, nlev,nc2l,nr2l,level integer :: debug_level, debug_unit, nlev,nc2l,nr2l,level
character(len=20) :: name character(len=20) :: name
character :: trans_ character :: trans_
type psb_mlprec_wrk_type type mld_mlprec_wrk_type
complex(psb_spk_), allocatable :: tx(:), ty(:), x2l(:), y2l(:) complex(psb_spk_), allocatable :: tx(:), ty(:), x2l(:), y2l(:)
end type psb_mlprec_wrk_type end type mld_mlprec_wrk_type
type(psb_mlprec_wrk_type), allocatable :: mlprec_wrk(:) type(mld_mlprec_wrk_type), allocatable :: mlprec_wrk(:)
name='mld_cmlprec_aply' name='mld_cmlprec_aply'
info = psb_success_ info = psb_success_
@ -357,8 +357,8 @@ subroutine mld_cmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
end if end if
level = 1 level = 1
nc2l = psb_cd_get_local_cols(p%precv(level)%base_desc) nc2l = p%precv(level)%base_desc%get_local_cols()
nr2l = psb_cd_get_local_rows(p%precv(level)%base_desc) nr2l = p%precv(level)%base_desc%get_local_rows()
allocate(mlprec_wrk(level)%x2l(nc2l),mlprec_wrk(level)%y2l(nc2l),& allocate(mlprec_wrk(level)%x2l(nc2l),mlprec_wrk(level)%y2l(nc2l),&
& stat=info) & stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
@ -409,7 +409,7 @@ contains
! Arguments ! Arguments
integer :: level integer :: level
type(mld_cprec_type), intent(in) :: p type(mld_cprec_type), intent(in) :: p
type(psb_mlprec_wrk_type), intent(inout) :: mlprec_wrk(:) type(mld_mlprec_wrk_type), intent(inout) :: mlprec_wrk(:)
character, intent(in) :: trans character, intent(in) :: trans
complex(psb_spk_),target :: work(:) complex(psb_spk_),target :: work(:)
integer, intent(out) :: info integer, intent(out) :: info
@ -433,13 +433,13 @@ contains
& a_err='wrong call level to inner_ml') & a_err='wrong call level to inner_ml')
goto 9999 goto 9999
end if end if
ictxt = psb_cd_get_context(p%precv(level)%base_desc) ictxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (level > 1) then if (level > 1) then
nc2l = psb_cd_get_local_cols(p%precv(level)%base_desc) nc2l = p%precv(level)%base_desc%get_local_cols()
nr2l = psb_cd_get_local_rows(p%precv(level)%base_desc) nr2l = p%precv(level)%base_desc%get_local_rows()
allocate(mlprec_wrk(level)%x2l(nc2l),& allocate(mlprec_wrk(level)%x2l(nc2l),&
& mlprec_wrk(level)%y2l(nc2l),& & mlprec_wrk(level)%y2l(nc2l),&
& stat=info) & stat=info)
@ -735,8 +735,8 @@ contains
case(mld_twoside_smooth_) case(mld_twoside_smooth_)
nc2l = psb_cd_get_local_cols(p%precv(level)%base_desc) nc2l = p%precv(level)%base_desc%get_local_cols()
nr2l = psb_cd_get_local_rows(p%precv(level)%base_desc) nr2l = p%precv(level)%base_desc%get_local_rows()
allocate(mlprec_wrk(level)%ty(nc2l), mlprec_wrk(level)%tx(nc2l), stat=info) allocate(mlprec_wrk(level)%ty(nc2l), mlprec_wrk(level)%tx(nc2l), stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
@ -880,11 +880,11 @@ subroutine mld_cmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
integer :: debug_level, debug_unit, nlev,nc2l,nr2l,level integer :: debug_level, debug_unit, nlev,nc2l,nr2l,level
character(len=20) :: name character(len=20) :: name
character :: trans_ character :: trans_
type psb_mlprec_wrk_type type mld_mlprec_wrk_type
complex(psb_spk_), allocatable :: tx(:), ty(:), x2l(:), y2l(:) complex(psb_spk_), allocatable :: tx(:), ty(:), x2l(:), y2l(:)
type(psb_c_vect_type) :: vtx, vty, vx2l, vy2l type(psb_c_vect_type) :: vtx, vty, vx2l, vy2l
end type psb_mlprec_wrk_type end type mld_mlprec_wrk_type
type(psb_mlprec_wrk_type), allocatable :: mlprec_wrk(:) type(mld_mlprec_wrk_type), allocatable :: mlprec_wrk(:)
name='mld_cmlprec_aply' name='mld_cmlprec_aply'
info = psb_success_ info = psb_success_
@ -909,27 +909,18 @@ subroutine mld_cmlprec_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
if (.false.) then
nc2l = p%precv(level)%base_desc%get_local_cols()
nr2l = p%precv(level)%base_desc%get_local_rows()
call mlprec_wrk(level)%vx2l%bld(nc2l,mold=x%v)
call mlprec_wrk(level)%vy2l%bld(nc2l,mold=x%v)
call mlprec_wrk(level)%vtx%bld(nc2l,mold=x%v)
call mlprec_wrk(level)%vty%bld(nc2l,mold=x%v)
else
call psb_geasb(mlprec_wrk(level)%vx2l,& call psb_geasb(mlprec_wrk(level)%vx2l,&
& p%precv(level)%base_desc,& & p%precv(level)%base_desc,info,&
& info,scratch=.true.,mold=x%v) & scratch=.true.,mold=x%v)
call psb_geasb(mlprec_wrk(level)%vy2l,& call psb_geasb(mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc,& & p%precv(level)%base_desc,info,&
& info,scratch=.true.,mold=x%v) & scratch=.true.,mold=x%v)
call psb_geasb(mlprec_wrk(level)%vtx,& call psb_geasb(mlprec_wrk(level)%vtx,&
& p%precv(level)%base_desc,& & p%precv(level)%base_desc,info,&
& info,scratch=.true.,mold=x%v) & scratch=.true.,mold=x%v)
call psb_geasb(mlprec_wrk(level)%vty,& call psb_geasb(mlprec_wrk(level)%vty,&
& p%precv(level)%base_desc,& & p%precv(level)%base_desc,info,&
& info,scratch=.true.,mold=x%v) & scratch=.true.,mold=x%v)
end if
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/2*nc2l,0,0,0,0/),& call psb_errpush(info,name,i_err=(/2*nc2l,0,0,0,0/),&
@ -993,7 +984,7 @@ contains
! Arguments ! Arguments
integer :: level integer :: level
type(mld_cprec_type), intent(inout) :: p type(mld_cprec_type), intent(inout) :: p
type(psb_mlprec_wrk_type), intent(inout) :: mlprec_wrk(:) type(mld_mlprec_wrk_type), intent(inout) :: mlprec_wrk(:)
character, intent(in) :: trans character, intent(in) :: trans
complex(psb_spk_),target :: work(:) complex(psb_spk_),target :: work(:)
integer, intent(out) :: info integer, intent(out) :: info
@ -1017,7 +1008,7 @@ contains
& a_err='wrong call level to inner_ml') & a_err='wrong call level to inner_ml')
goto 9999 goto 9999
end if end if
ictxt = psb_cd_get_context(p%precv(level)%base_desc) ictxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
nc2l = p%precv(level)%base_desc%get_local_cols() nc2l = p%precv(level)%base_desc%get_local_cols()

57
mlprec/impl/mld_dmlprec_aply.f90
Unescape Escape View File

@ -329,10 +329,10 @@ subroutine mld_dmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
integer :: debug_level, debug_unit, nlev,nc2l,nr2l,level integer :: debug_level, debug_unit, nlev,nc2l,nr2l,level
character(len=20) :: name character(len=20) :: name
character :: trans_ character :: trans_
type psb_mlprec_wrk_type type mld_mlprec_wrk_type
real(psb_dpk_), allocatable :: tx(:), ty(:), x2l(:), y2l(:) real(psb_dpk_), allocatable :: tx(:), ty(:), x2l(:), y2l(:)
end type psb_mlprec_wrk_type end type mld_mlprec_wrk_type
type(psb_mlprec_wrk_type), allocatable :: mlprec_wrk(:) type(mld_mlprec_wrk_type), allocatable :: mlprec_wrk(:)
name='mld_dmlprec_aply' name='mld_dmlprec_aply'
info = psb_success_ info = psb_success_
@ -357,8 +357,8 @@ subroutine mld_dmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
end if end if
level = 1 level = 1
nc2l = psb_cd_get_local_cols(p%precv(level)%base_desc) nc2l = p%precv(level)%base_desc%get_local_cols()
nr2l = psb_cd_get_local_rows(p%precv(level)%base_desc) nr2l = p%precv(level)%base_desc%get_local_rows()
allocate(mlprec_wrk(level)%x2l(nc2l),mlprec_wrk(level)%y2l(nc2l),& allocate(mlprec_wrk(level)%x2l(nc2l),mlprec_wrk(level)%y2l(nc2l),&
& stat=info) & stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
@ -409,7 +409,7 @@ contains
! Arguments ! Arguments
integer :: level integer :: level
type(mld_dprec_type), intent(in) :: p type(mld_dprec_type), intent(in) :: p
type(psb_mlprec_wrk_type), intent(inout) :: mlprec_wrk(:) type(mld_mlprec_wrk_type), intent(inout) :: mlprec_wrk(:)
character, intent(in) :: trans character, intent(in) :: trans
real(psb_dpk_),target :: work(:) real(psb_dpk_),target :: work(:)
integer, intent(out) :: info integer, intent(out) :: info
@ -433,13 +433,13 @@ contains
& a_err='wrong call level to inner_ml') & a_err='wrong call level to inner_ml')
goto 9999 goto 9999
end if end if
ictxt = psb_cd_get_context(p%precv(level)%base_desc) ictxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (level > 1) then if (level > 1) then
nc2l = psb_cd_get_local_cols(p%precv(level)%base_desc) nc2l = p%precv(level)%base_desc%get_local_cols()
nr2l = psb_cd_get_local_rows(p%precv(level)%base_desc) nr2l = p%precv(level)%base_desc%get_local_rows()
allocate(mlprec_wrk(level)%x2l(nc2l),& allocate(mlprec_wrk(level)%x2l(nc2l),&
& mlprec_wrk(level)%y2l(nc2l),& & mlprec_wrk(level)%y2l(nc2l),&
& stat=info) & stat=info)
@ -735,8 +735,8 @@ contains
case(mld_twoside_smooth_) case(mld_twoside_smooth_)
nc2l = psb_cd_get_local_cols(p%precv(level)%base_desc) nc2l = p%precv(level)%base_desc%get_local_cols()
nr2l = psb_cd_get_local_rows(p%precv(level)%base_desc) nr2l = p%precv(level)%base_desc%get_local_rows()
allocate(mlprec_wrk(level)%ty(nc2l), mlprec_wrk(level)%tx(nc2l), stat=info) allocate(mlprec_wrk(level)%ty(nc2l), mlprec_wrk(level)%tx(nc2l), stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
@ -880,11 +880,11 @@ subroutine mld_dmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
integer :: debug_level, debug_unit, nlev,nc2l,nr2l,level integer :: debug_level, debug_unit, nlev,nc2l,nr2l,level
character(len=20) :: name character(len=20) :: name
character :: trans_ character :: trans_
type psb_mlprec_wrk_type type mld_mlprec_wrk_type
real(psb_dpk_), allocatable :: tx(:), ty(:), x2l(:), y2l(:) real(psb_dpk_), allocatable :: tx(:), ty(:), x2l(:), y2l(:)
type(psb_d_vect_type) :: vtx, vty, vx2l, vy2l type(psb_d_vect_type) :: vtx, vty, vx2l, vy2l
end type psb_mlprec_wrk_type end type mld_mlprec_wrk_type
type(psb_mlprec_wrk_type), allocatable :: mlprec_wrk(:) type(mld_mlprec_wrk_type), allocatable :: mlprec_wrk(:)
name='mld_dmlprec_aply' name='mld_dmlprec_aply'
info = psb_success_ info = psb_success_
@ -909,27 +909,18 @@ 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
if (.false.) then
nc2l = p%precv(level)%base_desc%get_local_cols()
nr2l = p%precv(level)%base_desc%get_local_rows()
call mlprec_wrk(level)%vx2l%bld(nc2l,mold=x%v)
call mlprec_wrk(level)%vy2l%bld(nc2l,mold=x%v)
call mlprec_wrk(level)%vtx%bld(nc2l,mold=x%v)
call mlprec_wrk(level)%vty%bld(nc2l,mold=x%v)
else
call psb_geasb(mlprec_wrk(level)%vx2l,& call psb_geasb(mlprec_wrk(level)%vx2l,&
& p%precv(level)%base_desc,& & p%precv(level)%base_desc,info,&
& info,scratch=.true.,mold=x%v) & scratch=.true.,mold=x%v)
call psb_geasb(mlprec_wrk(level)%vy2l,& call psb_geasb(mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc,& & p%precv(level)%base_desc,info,&
& info,scratch=.true.,mold=x%v) & scratch=.true.,mold=x%v)
call psb_geasb(mlprec_wrk(level)%vtx,& call psb_geasb(mlprec_wrk(level)%vtx,&
& p%precv(level)%base_desc,& & p%precv(level)%base_desc,info,&
& info,scratch=.true.,mold=x%v) & scratch=.true.,mold=x%v)
call psb_geasb(mlprec_wrk(level)%vty,& call psb_geasb(mlprec_wrk(level)%vty,&
& p%precv(level)%base_desc,& & p%precv(level)%base_desc,info,&
& info,scratch=.true.,mold=x%v) & scratch=.true.,mold=x%v)
end if
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/2*nc2l,0,0,0,0/),& call psb_errpush(info,name,i_err=(/2*nc2l,0,0,0,0/),&
@ -993,7 +984,7 @@ contains
! Arguments ! Arguments
integer :: level integer :: level
type(mld_dprec_type), intent(inout) :: p type(mld_dprec_type), intent(inout) :: p
type(psb_mlprec_wrk_type), intent(inout) :: mlprec_wrk(:) type(mld_mlprec_wrk_type), intent(inout) :: mlprec_wrk(:)
character, intent(in) :: trans character, intent(in) :: trans
real(psb_dpk_),target :: work(:) real(psb_dpk_),target :: work(:)
integer, intent(out) :: info integer, intent(out) :: info
@ -1017,7 +1008,7 @@ contains
& a_err='wrong call level to inner_ml') & a_err='wrong call level to inner_ml')
goto 9999 goto 9999
end if end if
ictxt = psb_cd_get_context(p%precv(level)%base_desc) ictxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
nc2l = p%precv(level)%base_desc%get_local_cols() nc2l = p%precv(level)%base_desc%get_local_cols()

57
mlprec/impl/mld_smlprec_aply.f90
Unescape Escape View File

@ -329,10 +329,10 @@ subroutine mld_smlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
integer :: debug_level, debug_unit, nlev,nc2l,nr2l,level integer :: debug_level, debug_unit, nlev,nc2l,nr2l,level
character(len=20) :: name character(len=20) :: name
character :: trans_ character :: trans_
type psb_mlprec_wrk_type type mld_mlprec_wrk_type
real(psb_spk_), allocatable :: tx(:), ty(:), x2l(:), y2l(:) real(psb_spk_), allocatable :: tx(:), ty(:), x2l(:), y2l(:)
end type psb_mlprec_wrk_type end type mld_mlprec_wrk_type
type(psb_mlprec_wrk_type), allocatable :: mlprec_wrk(:) type(mld_mlprec_wrk_type), allocatable :: mlprec_wrk(:)
name='mld_smlprec_aply' name='mld_smlprec_aply'
info = psb_success_ info = psb_success_
@ -357,8 +357,8 @@ subroutine mld_smlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
end if end if
level = 1 level = 1
nc2l = psb_cd_get_local_cols(p%precv(level)%base_desc) nc2l = p%precv(level)%base_desc%get_local_cols()
nr2l = psb_cd_get_local_rows(p%precv(level)%base_desc) nr2l = p%precv(level)%base_desc%get_local_rows()
allocate(mlprec_wrk(level)%x2l(nc2l),mlprec_wrk(level)%y2l(nc2l),& allocate(mlprec_wrk(level)%x2l(nc2l),mlprec_wrk(level)%y2l(nc2l),&
& stat=info) & stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
@ -409,7 +409,7 @@ contains
! Arguments ! Arguments
integer :: level integer :: level
type(mld_sprec_type), intent(in) :: p type(mld_sprec_type), intent(in) :: p
type(psb_mlprec_wrk_type), intent(inout) :: mlprec_wrk(:) type(mld_mlprec_wrk_type), intent(inout) :: mlprec_wrk(:)
character, intent(in) :: trans character, intent(in) :: trans
real(psb_spk_),target :: work(:) real(psb_spk_),target :: work(:)
integer, intent(out) :: info integer, intent(out) :: info
@ -433,13 +433,13 @@ contains
& a_err='wrong call level to inner_ml') & a_err='wrong call level to inner_ml')
goto 9999 goto 9999
end if end if
ictxt = psb_cd_get_context(p%precv(level)%base_desc) ictxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (level > 1) then if (level > 1) then
nc2l = psb_cd_get_local_cols(p%precv(level)%base_desc) nc2l = p%precv(level)%base_desc%get_local_cols()
nr2l = psb_cd_get_local_rows(p%precv(level)%base_desc) nr2l = p%precv(level)%base_desc%get_local_rows()
allocate(mlprec_wrk(level)%x2l(nc2l),& allocate(mlprec_wrk(level)%x2l(nc2l),&
& mlprec_wrk(level)%y2l(nc2l),& & mlprec_wrk(level)%y2l(nc2l),&
& stat=info) & stat=info)
@ -735,8 +735,8 @@ contains
case(mld_twoside_smooth_) case(mld_twoside_smooth_)
nc2l = psb_cd_get_local_cols(p%precv(level)%base_desc) nc2l = p%precv(level)%base_desc%get_local_cols()
nr2l = psb_cd_get_local_rows(p%precv(level)%base_desc) nr2l = p%precv(level)%base_desc%get_local_rows()
allocate(mlprec_wrk(level)%ty(nc2l), mlprec_wrk(level)%tx(nc2l), stat=info) allocate(mlprec_wrk(level)%ty(nc2l), mlprec_wrk(level)%tx(nc2l), stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
@ -880,11 +880,11 @@ subroutine mld_smlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
integer :: debug_level, debug_unit, nlev,nc2l,nr2l,level integer :: debug_level, debug_unit, nlev,nc2l,nr2l,level
character(len=20) :: name character(len=20) :: name
character :: trans_ character :: trans_
type psb_mlprec_wrk_type type mld_mlprec_wrk_type
real(psb_spk_), allocatable :: tx(:), ty(:), x2l(:), y2l(:) real(psb_spk_), allocatable :: tx(:), ty(:), x2l(:), y2l(:)
type(psb_s_vect_type) :: vtx, vty, vx2l, vy2l type(psb_s_vect_type) :: vtx, vty, vx2l, vy2l
end type psb_mlprec_wrk_type end type mld_mlprec_wrk_type
type(psb_mlprec_wrk_type), allocatable :: mlprec_wrk(:) type(mld_mlprec_wrk_type), allocatable :: mlprec_wrk(:)
name='mld_smlprec_aply' name='mld_smlprec_aply'
info = psb_success_ info = psb_success_
@ -909,27 +909,18 @@ subroutine mld_smlprec_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
if (.false.) then
nc2l = p%precv(level)%base_desc%get_local_cols()
nr2l = p%precv(level)%base_desc%get_local_rows()
call mlprec_wrk(level)%vx2l%bld(nc2l,mold=x%v)
call mlprec_wrk(level)%vy2l%bld(nc2l,mold=x%v)
call mlprec_wrk(level)%vtx%bld(nc2l,mold=x%v)
call mlprec_wrk(level)%vty%bld(nc2l,mold=x%v)
else
call psb_geasb(mlprec_wrk(level)%vx2l,& call psb_geasb(mlprec_wrk(level)%vx2l,&
& p%precv(level)%base_desc,& & p%precv(level)%base_desc,info,&
& info,scratch=.true.,mold=x%v) & scratch=.true.,mold=x%v)
call psb_geasb(mlprec_wrk(level)%vy2l,& call psb_geasb(mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc,& & p%precv(level)%base_desc,info,&
& info,scratch=.true.,mold=x%v) & scratch=.true.,mold=x%v)
call psb_geasb(mlprec_wrk(level)%vtx,& call psb_geasb(mlprec_wrk(level)%vtx,&
& p%precv(level)%base_desc,& & p%precv(level)%base_desc,info,&
& info,scratch=.true.,mold=x%v) & scratch=.true.,mold=x%v)
call psb_geasb(mlprec_wrk(level)%vty,& call psb_geasb(mlprec_wrk(level)%vty,&
& p%precv(level)%base_desc,& & p%precv(level)%base_desc,info,&
& info,scratch=.true.,mold=x%v) & scratch=.true.,mold=x%v)
end if
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/2*nc2l,0,0,0,0/),& call psb_errpush(info,name,i_err=(/2*nc2l,0,0,0,0/),&
@ -993,7 +984,7 @@ contains
! Arguments ! Arguments
integer :: level integer :: level
type(mld_sprec_type), intent(inout) :: p type(mld_sprec_type), intent(inout) :: p
type(psb_mlprec_wrk_type), intent(inout) :: mlprec_wrk(:) type(mld_mlprec_wrk_type), intent(inout) :: mlprec_wrk(:)
character, intent(in) :: trans character, intent(in) :: trans
real(psb_spk_),target :: work(:) real(psb_spk_),target :: work(:)
integer, intent(out) :: info integer, intent(out) :: info
@ -1017,7 +1008,7 @@ contains
& a_err='wrong call level to inner_ml') & a_err='wrong call level to inner_ml')
goto 9999 goto 9999
end if end if
ictxt = psb_cd_get_context(p%precv(level)%base_desc) ictxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
nc2l = p%precv(level)%base_desc%get_local_cols() nc2l = p%precv(level)%base_desc%get_local_cols()

57
mlprec/impl/mld_zmlprec_aply.f90
Unescape Escape View File

@ -329,10 +329,10 @@ subroutine mld_zmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
integer :: debug_level, debug_unit, nlev,nc2l,nr2l,level integer :: debug_level, debug_unit, nlev,nc2l,nr2l,level
character(len=20) :: name character(len=20) :: name
character :: trans_ character :: trans_
type psb_mlprec_wrk_type type mld_mlprec_wrk_type
complex(psb_dpk_), allocatable :: tx(:), ty(:), x2l(:), y2l(:) complex(psb_dpk_), allocatable :: tx(:), ty(:), x2l(:), y2l(:)
end type psb_mlprec_wrk_type end type mld_mlprec_wrk_type
type(psb_mlprec_wrk_type), allocatable :: mlprec_wrk(:) type(mld_mlprec_wrk_type), allocatable :: mlprec_wrk(:)
name='mld_zmlprec_aply' name='mld_zmlprec_aply'
info = psb_success_ info = psb_success_
@ -357,8 +357,8 @@ subroutine mld_zmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
end if end if
level = 1 level = 1
nc2l = psb_cd_get_local_cols(p%precv(level)%base_desc) nc2l = p%precv(level)%base_desc%get_local_cols()
nr2l = psb_cd_get_local_rows(p%precv(level)%base_desc) nr2l = p%precv(level)%base_desc%get_local_rows()
allocate(mlprec_wrk(level)%x2l(nc2l),mlprec_wrk(level)%y2l(nc2l),& allocate(mlprec_wrk(level)%x2l(nc2l),mlprec_wrk(level)%y2l(nc2l),&
& stat=info) & stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
@ -409,7 +409,7 @@ contains
! Arguments ! Arguments
integer :: level integer :: level
type(mld_zprec_type), intent(in) :: p type(mld_zprec_type), intent(in) :: p
type(psb_mlprec_wrk_type), intent(inout) :: mlprec_wrk(:) type(mld_mlprec_wrk_type), intent(inout) :: mlprec_wrk(:)
character, intent(in) :: trans character, intent(in) :: trans
complex(psb_dpk_),target :: work(:) complex(psb_dpk_),target :: work(:)
integer, intent(out) :: info integer, intent(out) :: info
@ -433,13 +433,13 @@ contains
& a_err='wrong call level to inner_ml') & a_err='wrong call level to inner_ml')
goto 9999 goto 9999
end if end if
ictxt = psb_cd_get_context(p%precv(level)%base_desc) ictxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
if (level > 1) then if (level > 1) then
nc2l = psb_cd_get_local_cols(p%precv(level)%base_desc) nc2l = p%precv(level)%base_desc%get_local_cols()
nr2l = psb_cd_get_local_rows(p%precv(level)%base_desc) nr2l = p%precv(level)%base_desc%get_local_rows()
allocate(mlprec_wrk(level)%x2l(nc2l),& allocate(mlprec_wrk(level)%x2l(nc2l),&
& mlprec_wrk(level)%y2l(nc2l),& & mlprec_wrk(level)%y2l(nc2l),&
& stat=info) & stat=info)
@ -735,8 +735,8 @@ contains
case(mld_twoside_smooth_) case(mld_twoside_smooth_)
nc2l = psb_cd_get_local_cols(p%precv(level)%base_desc) nc2l = p%precv(level)%base_desc%get_local_cols()
nr2l = psb_cd_get_local_rows(p%precv(level)%base_desc) nr2l = p%precv(level)%base_desc%get_local_rows()
allocate(mlprec_wrk(level)%ty(nc2l), mlprec_wrk(level)%tx(nc2l), stat=info) allocate(mlprec_wrk(level)%ty(nc2l), mlprec_wrk(level)%tx(nc2l), stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
@ -880,11 +880,11 @@ subroutine mld_zmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
integer :: debug_level, debug_unit, nlev,nc2l,nr2l,level integer :: debug_level, debug_unit, nlev,nc2l,nr2l,level
character(len=20) :: name character(len=20) :: name
character :: trans_ character :: trans_
type psb_mlprec_wrk_type type mld_mlprec_wrk_type
complex(psb_dpk_), allocatable :: tx(:), ty(:), x2l(:), y2l(:) complex(psb_dpk_), allocatable :: tx(:), ty(:), x2l(:), y2l(:)
type(psb_z_vect_type) :: vtx, vty, vx2l, vy2l type(psb_z_vect_type) :: vtx, vty, vx2l, vy2l
end type psb_mlprec_wrk_type end type mld_mlprec_wrk_type
type(psb_mlprec_wrk_type), allocatable :: mlprec_wrk(:) type(mld_mlprec_wrk_type), allocatable :: mlprec_wrk(:)
name='mld_zmlprec_aply' name='mld_zmlprec_aply'
info = psb_success_ info = psb_success_
@ -909,27 +909,18 @@ subroutine mld_zmlprec_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
if (.false.) then
nc2l = p%precv(level)%base_desc%get_local_cols()
nr2l = p%precv(level)%base_desc%get_local_rows()
call mlprec_wrk(level)%vx2l%bld(nc2l,mold=x%v)
call mlprec_wrk(level)%vy2l%bld(nc2l,mold=x%v)
call mlprec_wrk(level)%vtx%bld(nc2l,mold=x%v)
call mlprec_wrk(level)%vty%bld(nc2l,mold=x%v)
else
call psb_geasb(mlprec_wrk(level)%vx2l,& call psb_geasb(mlprec_wrk(level)%vx2l,&
& p%precv(level)%base_desc,& & p%precv(level)%base_desc,info,&
& info,scratch=.true.,mold=x%v) & scratch=.true.,mold=x%v)
call psb_geasb(mlprec_wrk(level)%vy2l,& call psb_geasb(mlprec_wrk(level)%vy2l,&
& p%precv(level)%base_desc,& & p%precv(level)%base_desc,info,&
& info,scratch=.true.,mold=x%v) & scratch=.true.,mold=x%v)
call psb_geasb(mlprec_wrk(level)%vtx,& call psb_geasb(mlprec_wrk(level)%vtx,&
& p%precv(level)%base_desc,& & p%precv(level)%base_desc,info,&
& info,scratch=.true.,mold=x%v) & scratch=.true.,mold=x%v)
call psb_geasb(mlprec_wrk(level)%vty,& call psb_geasb(mlprec_wrk(level)%vty,&
& p%precv(level)%base_desc,& & p%precv(level)%base_desc,info,&
& info,scratch=.true.,mold=x%v) & scratch=.true.,mold=x%v)
end if
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/2*nc2l,0,0,0,0/),& call psb_errpush(info,name,i_err=(/2*nc2l,0,0,0,0/),&
@ -993,7 +984,7 @@ contains
! Arguments ! Arguments
integer :: level integer :: level
type(mld_zprec_type), intent(inout) :: p type(mld_zprec_type), intent(inout) :: p
type(psb_mlprec_wrk_type), intent(inout) :: mlprec_wrk(:) type(mld_mlprec_wrk_type), intent(inout) :: mlprec_wrk(:)
character, intent(in) :: trans character, intent(in) :: trans
complex(psb_dpk_),target :: work(:) complex(psb_dpk_),target :: work(:)
integer, intent(out) :: info integer, intent(out) :: info
@ -1017,7 +1008,7 @@ contains
& a_err='wrong call level to inner_ml') & a_err='wrong call level to inner_ml')
goto 9999 goto 9999
end if end if
ictxt = psb_cd_get_context(p%precv(level)%base_desc) ictxt = p%precv(level)%base_desc%get_context()
call psb_info(ictxt, me, np) call psb_info(ictxt, me, np)
nc2l = p%precv(level)%base_desc%get_local_cols() nc2l = p%precv(level)%base_desc%get_local_cols()

Write Preview
Loading…
Cancel
Save