From 674fdabb1143f2ab453f26a563f19cbaa46d421b Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Tue, 3 Jan 2012 22:23:16 +0000 Subject: [PATCH] mld2p4-2: 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. --- mlprec/impl/mld_cmlprec_aply.f90 | 65 ++++++++++++++------------------ mlprec/impl/mld_dmlprec_aply.f90 | 65 ++++++++++++++------------------ mlprec/impl/mld_smlprec_aply.f90 | 65 ++++++++++++++------------------ mlprec/impl/mld_zmlprec_aply.f90 | 65 ++++++++++++++------------------ 4 files changed, 112 insertions(+), 148 deletions(-) diff --git a/mlprec/impl/mld_cmlprec_aply.f90 b/mlprec/impl/mld_cmlprec_aply.f90 index 2b0591eb..3b8abdb2 100644 --- a/mlprec/impl/mld_cmlprec_aply.f90 +++ b/mlprec/impl/mld_cmlprec_aply.f90 @@ -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 character(len=20) :: name character :: trans_ - type psb_mlprec_wrk_type + type mld_mlprec_wrk_type complex(psb_spk_), allocatable :: tx(:), ty(:), x2l(:), y2l(:) - end type psb_mlprec_wrk_type - type(psb_mlprec_wrk_type), allocatable :: mlprec_wrk(:) + end type mld_mlprec_wrk_type + type(mld_mlprec_wrk_type), allocatable :: mlprec_wrk(:) name='mld_cmlprec_aply' info = psb_success_ @@ -357,8 +357,8 @@ subroutine mld_cmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info) end if level = 1 - nc2l = psb_cd_get_local_cols(p%precv(level)%base_desc) - nr2l = psb_cd_get_local_rows(p%precv(level)%base_desc) + nc2l = p%precv(level)%base_desc%get_local_cols() + nr2l = p%precv(level)%base_desc%get_local_rows() allocate(mlprec_wrk(level)%x2l(nc2l),mlprec_wrk(level)%y2l(nc2l),& & stat=info) if (info /= psb_success_) then @@ -409,7 +409,7 @@ contains ! Arguments integer :: level 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 complex(psb_spk_),target :: work(:) integer, intent(out) :: info @@ -433,13 +433,13 @@ contains & a_err='wrong call level to inner_ml') goto 9999 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) if (level > 1) then - nc2l = psb_cd_get_local_cols(p%precv(level)%base_desc) - nr2l = psb_cd_get_local_rows(p%precv(level)%base_desc) + nc2l = p%precv(level)%base_desc%get_local_cols() + nr2l = p%precv(level)%base_desc%get_local_rows() allocate(mlprec_wrk(level)%x2l(nc2l),& & mlprec_wrk(level)%y2l(nc2l),& & stat=info) @@ -735,8 +735,8 @@ contains case(mld_twoside_smooth_) - nc2l = psb_cd_get_local_cols(p%precv(level)%base_desc) - nr2l = psb_cd_get_local_rows(p%precv(level)%base_desc) + nc2l = p%precv(level)%base_desc%get_local_cols() + nr2l = p%precv(level)%base_desc%get_local_rows() allocate(mlprec_wrk(level)%ty(nc2l), mlprec_wrk(level)%tx(nc2l), stat=info) if (info /= psb_success_) then 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 character(len=20) :: name character :: trans_ - type psb_mlprec_wrk_type + type mld_mlprec_wrk_type complex(psb_spk_), allocatable :: tx(:), ty(:), x2l(:), y2l(:) type(psb_c_vect_type) :: vtx, vty, vx2l, vy2l - end type psb_mlprec_wrk_type - type(psb_mlprec_wrk_type), allocatable :: mlprec_wrk(:) + end type mld_mlprec_wrk_type + type(mld_mlprec_wrk_type), allocatable :: mlprec_wrk(:) name='mld_cmlprec_aply' info = psb_success_ @@ -909,27 +909,18 @@ subroutine mld_cmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info) end if level = 1 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,& - & p%precv(level)%base_desc,& - & info,scratch=.true.,mold=x%v) - call psb_geasb(mlprec_wrk(level)%vy2l,& - & p%precv(level)%base_desc,& - & info,scratch=.true.,mold=x%v) - call psb_geasb(mlprec_wrk(level)%vtx,& - & p%precv(level)%base_desc,& - & info,scratch=.true.,mold=x%v) - call psb_geasb(mlprec_wrk(level)%vty,& - & p%precv(level)%base_desc,& - & info,scratch=.true.,mold=x%v) - end if + call psb_geasb(mlprec_wrk(level)%vx2l,& + & p%precv(level)%base_desc,info,& + & scratch=.true.,mold=x%v) + call psb_geasb(mlprec_wrk(level)%vy2l,& + & p%precv(level)%base_desc,info,& + & scratch=.true.,mold=x%v) + call psb_geasb(mlprec_wrk(level)%vtx,& + & p%precv(level)%base_desc,info,& + & scratch=.true.,mold=x%v) + call psb_geasb(mlprec_wrk(level)%vty,& + & p%precv(level)%base_desc,info,& + & scratch=.true.,mold=x%v) if (psb_errstatus_fatal()) then info=psb_err_alloc_request_ call psb_errpush(info,name,i_err=(/2*nc2l,0,0,0,0/),& @@ -993,7 +984,7 @@ contains ! Arguments integer :: level 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 complex(psb_spk_),target :: work(:) integer, intent(out) :: info @@ -1017,7 +1008,7 @@ contains & a_err='wrong call level to inner_ml') goto 9999 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) nc2l = p%precv(level)%base_desc%get_local_cols() diff --git a/mlprec/impl/mld_dmlprec_aply.f90 b/mlprec/impl/mld_dmlprec_aply.f90 index 64fc6685..71bb6718 100644 --- a/mlprec/impl/mld_dmlprec_aply.f90 +++ b/mlprec/impl/mld_dmlprec_aply.f90 @@ -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 character(len=20) :: name character :: trans_ - type psb_mlprec_wrk_type + type mld_mlprec_wrk_type real(psb_dpk_), allocatable :: tx(:), ty(:), x2l(:), y2l(:) - end type psb_mlprec_wrk_type - type(psb_mlprec_wrk_type), allocatable :: mlprec_wrk(:) + end type mld_mlprec_wrk_type + type(mld_mlprec_wrk_type), allocatable :: mlprec_wrk(:) name='mld_dmlprec_aply' info = psb_success_ @@ -357,8 +357,8 @@ subroutine mld_dmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info) end if level = 1 - nc2l = psb_cd_get_local_cols(p%precv(level)%base_desc) - nr2l = psb_cd_get_local_rows(p%precv(level)%base_desc) + nc2l = p%precv(level)%base_desc%get_local_cols() + nr2l = p%precv(level)%base_desc%get_local_rows() allocate(mlprec_wrk(level)%x2l(nc2l),mlprec_wrk(level)%y2l(nc2l),& & stat=info) if (info /= psb_success_) then @@ -409,7 +409,7 @@ contains ! Arguments integer :: level 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 real(psb_dpk_),target :: work(:) integer, intent(out) :: info @@ -433,13 +433,13 @@ contains & a_err='wrong call level to inner_ml') goto 9999 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) if (level > 1) then - nc2l = psb_cd_get_local_cols(p%precv(level)%base_desc) - nr2l = psb_cd_get_local_rows(p%precv(level)%base_desc) + nc2l = p%precv(level)%base_desc%get_local_cols() + nr2l = p%precv(level)%base_desc%get_local_rows() allocate(mlprec_wrk(level)%x2l(nc2l),& & mlprec_wrk(level)%y2l(nc2l),& & stat=info) @@ -735,8 +735,8 @@ contains case(mld_twoside_smooth_) - nc2l = psb_cd_get_local_cols(p%precv(level)%base_desc) - nr2l = psb_cd_get_local_rows(p%precv(level)%base_desc) + nc2l = p%precv(level)%base_desc%get_local_cols() + nr2l = p%precv(level)%base_desc%get_local_rows() allocate(mlprec_wrk(level)%ty(nc2l), mlprec_wrk(level)%tx(nc2l), stat=info) if (info /= psb_success_) then 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 character(len=20) :: name character :: trans_ - type psb_mlprec_wrk_type + type mld_mlprec_wrk_type real(psb_dpk_), allocatable :: tx(:), ty(:), x2l(:), y2l(:) type(psb_d_vect_type) :: vtx, vty, vx2l, vy2l - end type psb_mlprec_wrk_type - type(psb_mlprec_wrk_type), allocatable :: mlprec_wrk(:) + end type mld_mlprec_wrk_type + type(mld_mlprec_wrk_type), allocatable :: mlprec_wrk(:) name='mld_dmlprec_aply' info = psb_success_ @@ -909,27 +909,18 @@ subroutine mld_dmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info) end if level = 1 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,& - & p%precv(level)%base_desc,& - & info,scratch=.true.,mold=x%v) - call psb_geasb(mlprec_wrk(level)%vy2l,& - & p%precv(level)%base_desc,& - & info,scratch=.true.,mold=x%v) - call psb_geasb(mlprec_wrk(level)%vtx,& - & p%precv(level)%base_desc,& - & info,scratch=.true.,mold=x%v) - call psb_geasb(mlprec_wrk(level)%vty,& - & p%precv(level)%base_desc,& - & info,scratch=.true.,mold=x%v) - end if + call psb_geasb(mlprec_wrk(level)%vx2l,& + & p%precv(level)%base_desc,info,& + & scratch=.true.,mold=x%v) + call psb_geasb(mlprec_wrk(level)%vy2l,& + & p%precv(level)%base_desc,info,& + & scratch=.true.,mold=x%v) + call psb_geasb(mlprec_wrk(level)%vtx,& + & p%precv(level)%base_desc,info,& + & scratch=.true.,mold=x%v) + call psb_geasb(mlprec_wrk(level)%vty,& + & p%precv(level)%base_desc,info,& + & scratch=.true.,mold=x%v) if (psb_errstatus_fatal()) then info=psb_err_alloc_request_ call psb_errpush(info,name,i_err=(/2*nc2l,0,0,0,0/),& @@ -993,7 +984,7 @@ contains ! Arguments integer :: level 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 real(psb_dpk_),target :: work(:) integer, intent(out) :: info @@ -1017,7 +1008,7 @@ contains & a_err='wrong call level to inner_ml') goto 9999 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) nc2l = p%precv(level)%base_desc%get_local_cols() diff --git a/mlprec/impl/mld_smlprec_aply.f90 b/mlprec/impl/mld_smlprec_aply.f90 index 64a1d5b1..f659fc0c 100644 --- a/mlprec/impl/mld_smlprec_aply.f90 +++ b/mlprec/impl/mld_smlprec_aply.f90 @@ -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 character(len=20) :: name character :: trans_ - type psb_mlprec_wrk_type + type mld_mlprec_wrk_type real(psb_spk_), allocatable :: tx(:), ty(:), x2l(:), y2l(:) - end type psb_mlprec_wrk_type - type(psb_mlprec_wrk_type), allocatable :: mlprec_wrk(:) + end type mld_mlprec_wrk_type + type(mld_mlprec_wrk_type), allocatable :: mlprec_wrk(:) name='mld_smlprec_aply' info = psb_success_ @@ -357,8 +357,8 @@ subroutine mld_smlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info) end if level = 1 - nc2l = psb_cd_get_local_cols(p%precv(level)%base_desc) - nr2l = psb_cd_get_local_rows(p%precv(level)%base_desc) + nc2l = p%precv(level)%base_desc%get_local_cols() + nr2l = p%precv(level)%base_desc%get_local_rows() allocate(mlprec_wrk(level)%x2l(nc2l),mlprec_wrk(level)%y2l(nc2l),& & stat=info) if (info /= psb_success_) then @@ -409,7 +409,7 @@ contains ! Arguments integer :: level 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 real(psb_spk_),target :: work(:) integer, intent(out) :: info @@ -433,13 +433,13 @@ contains & a_err='wrong call level to inner_ml') goto 9999 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) if (level > 1) then - nc2l = psb_cd_get_local_cols(p%precv(level)%base_desc) - nr2l = psb_cd_get_local_rows(p%precv(level)%base_desc) + nc2l = p%precv(level)%base_desc%get_local_cols() + nr2l = p%precv(level)%base_desc%get_local_rows() allocate(mlprec_wrk(level)%x2l(nc2l),& & mlprec_wrk(level)%y2l(nc2l),& & stat=info) @@ -735,8 +735,8 @@ contains case(mld_twoside_smooth_) - nc2l = psb_cd_get_local_cols(p%precv(level)%base_desc) - nr2l = psb_cd_get_local_rows(p%precv(level)%base_desc) + nc2l = p%precv(level)%base_desc%get_local_cols() + nr2l = p%precv(level)%base_desc%get_local_rows() allocate(mlprec_wrk(level)%ty(nc2l), mlprec_wrk(level)%tx(nc2l), stat=info) if (info /= psb_success_) then 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 character(len=20) :: name character :: trans_ - type psb_mlprec_wrk_type + type mld_mlprec_wrk_type real(psb_spk_), allocatable :: tx(:), ty(:), x2l(:), y2l(:) type(psb_s_vect_type) :: vtx, vty, vx2l, vy2l - end type psb_mlprec_wrk_type - type(psb_mlprec_wrk_type), allocatable :: mlprec_wrk(:) + end type mld_mlprec_wrk_type + type(mld_mlprec_wrk_type), allocatable :: mlprec_wrk(:) name='mld_smlprec_aply' info = psb_success_ @@ -909,27 +909,18 @@ subroutine mld_smlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info) end if level = 1 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,& - & p%precv(level)%base_desc,& - & info,scratch=.true.,mold=x%v) - call psb_geasb(mlprec_wrk(level)%vy2l,& - & p%precv(level)%base_desc,& - & info,scratch=.true.,mold=x%v) - call psb_geasb(mlprec_wrk(level)%vtx,& - & p%precv(level)%base_desc,& - & info,scratch=.true.,mold=x%v) - call psb_geasb(mlprec_wrk(level)%vty,& - & p%precv(level)%base_desc,& - & info,scratch=.true.,mold=x%v) - end if + call psb_geasb(mlprec_wrk(level)%vx2l,& + & p%precv(level)%base_desc,info,& + & scratch=.true.,mold=x%v) + call psb_geasb(mlprec_wrk(level)%vy2l,& + & p%precv(level)%base_desc,info,& + & scratch=.true.,mold=x%v) + call psb_geasb(mlprec_wrk(level)%vtx,& + & p%precv(level)%base_desc,info,& + & scratch=.true.,mold=x%v) + call psb_geasb(mlprec_wrk(level)%vty,& + & p%precv(level)%base_desc,info,& + & scratch=.true.,mold=x%v) if (psb_errstatus_fatal()) then info=psb_err_alloc_request_ call psb_errpush(info,name,i_err=(/2*nc2l,0,0,0,0/),& @@ -993,7 +984,7 @@ contains ! Arguments integer :: level 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 real(psb_spk_),target :: work(:) integer, intent(out) :: info @@ -1017,7 +1008,7 @@ contains & a_err='wrong call level to inner_ml') goto 9999 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) nc2l = p%precv(level)%base_desc%get_local_cols() diff --git a/mlprec/impl/mld_zmlprec_aply.f90 b/mlprec/impl/mld_zmlprec_aply.f90 index e25fae2b..2988f558 100644 --- a/mlprec/impl/mld_zmlprec_aply.f90 +++ b/mlprec/impl/mld_zmlprec_aply.f90 @@ -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 character(len=20) :: name character :: trans_ - type psb_mlprec_wrk_type + type mld_mlprec_wrk_type complex(psb_dpk_), allocatable :: tx(:), ty(:), x2l(:), y2l(:) - end type psb_mlprec_wrk_type - type(psb_mlprec_wrk_type), allocatable :: mlprec_wrk(:) + end type mld_mlprec_wrk_type + type(mld_mlprec_wrk_type), allocatable :: mlprec_wrk(:) name='mld_zmlprec_aply' info = psb_success_ @@ -357,8 +357,8 @@ subroutine mld_zmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info) end if level = 1 - nc2l = psb_cd_get_local_cols(p%precv(level)%base_desc) - nr2l = psb_cd_get_local_rows(p%precv(level)%base_desc) + nc2l = p%precv(level)%base_desc%get_local_cols() + nr2l = p%precv(level)%base_desc%get_local_rows() allocate(mlprec_wrk(level)%x2l(nc2l),mlprec_wrk(level)%y2l(nc2l),& & stat=info) if (info /= psb_success_) then @@ -409,7 +409,7 @@ contains ! Arguments integer :: level 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 complex(psb_dpk_),target :: work(:) integer, intent(out) :: info @@ -433,13 +433,13 @@ contains & a_err='wrong call level to inner_ml') goto 9999 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) if (level > 1) then - nc2l = psb_cd_get_local_cols(p%precv(level)%base_desc) - nr2l = psb_cd_get_local_rows(p%precv(level)%base_desc) + nc2l = p%precv(level)%base_desc%get_local_cols() + nr2l = p%precv(level)%base_desc%get_local_rows() allocate(mlprec_wrk(level)%x2l(nc2l),& & mlprec_wrk(level)%y2l(nc2l),& & stat=info) @@ -735,8 +735,8 @@ contains case(mld_twoside_smooth_) - nc2l = psb_cd_get_local_cols(p%precv(level)%base_desc) - nr2l = psb_cd_get_local_rows(p%precv(level)%base_desc) + nc2l = p%precv(level)%base_desc%get_local_cols() + nr2l = p%precv(level)%base_desc%get_local_rows() allocate(mlprec_wrk(level)%ty(nc2l), mlprec_wrk(level)%tx(nc2l), stat=info) if (info /= psb_success_) then 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 character(len=20) :: name character :: trans_ - type psb_mlprec_wrk_type + type mld_mlprec_wrk_type complex(psb_dpk_), allocatable :: tx(:), ty(:), x2l(:), y2l(:) type(psb_z_vect_type) :: vtx, vty, vx2l, vy2l - end type psb_mlprec_wrk_type - type(psb_mlprec_wrk_type), allocatable :: mlprec_wrk(:) + end type mld_mlprec_wrk_type + type(mld_mlprec_wrk_type), allocatable :: mlprec_wrk(:) name='mld_zmlprec_aply' info = psb_success_ @@ -909,27 +909,18 @@ subroutine mld_zmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info) end if level = 1 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,& - & p%precv(level)%base_desc,& - & info,scratch=.true.,mold=x%v) - call psb_geasb(mlprec_wrk(level)%vy2l,& - & p%precv(level)%base_desc,& - & info,scratch=.true.,mold=x%v) - call psb_geasb(mlprec_wrk(level)%vtx,& - & p%precv(level)%base_desc,& - & info,scratch=.true.,mold=x%v) - call psb_geasb(mlprec_wrk(level)%vty,& - & p%precv(level)%base_desc,& - & info,scratch=.true.,mold=x%v) - end if + call psb_geasb(mlprec_wrk(level)%vx2l,& + & p%precv(level)%base_desc,info,& + & scratch=.true.,mold=x%v) + call psb_geasb(mlprec_wrk(level)%vy2l,& + & p%precv(level)%base_desc,info,& + & scratch=.true.,mold=x%v) + call psb_geasb(mlprec_wrk(level)%vtx,& + & p%precv(level)%base_desc,info,& + & scratch=.true.,mold=x%v) + call psb_geasb(mlprec_wrk(level)%vty,& + & p%precv(level)%base_desc,info,& + & scratch=.true.,mold=x%v) if (psb_errstatus_fatal()) then info=psb_err_alloc_request_ call psb_errpush(info,name,i_err=(/2*nc2l,0,0,0,0/),& @@ -993,7 +984,7 @@ contains ! Arguments integer :: level 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 complex(psb_dpk_),target :: work(:) integer, intent(out) :: info @@ -1017,7 +1008,7 @@ contains & a_err='wrong call level to inner_ml') goto 9999 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) nc2l = p%precv(level)%base_desc%get_local_cols()