From 4564e1e4bacca029fccdf36f5869e5d4047fc466 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Mon, 11 Dec 2017 17:17:43 +0000 Subject: [PATCH] Cleanup smoother_apply. --- .../impl/smoother/mld_c_as_smoother_apply_vect.f90 | 7 +------ .../impl/smoother/mld_c_jac_smoother_apply_vect.f90 | 12 ------------ .../impl/smoother/mld_d_as_smoother_apply_vect.f90 | 7 +------ .../impl/smoother/mld_d_jac_smoother_apply_vect.f90 | 12 ------------ .../impl/smoother/mld_s_as_smoother_apply_vect.f90 | 7 +------ .../impl/smoother/mld_s_jac_smoother_apply_vect.f90 | 12 ------------ .../impl/smoother/mld_z_as_smoother_apply_vect.f90 | 7 +------ .../impl/smoother/mld_z_jac_smoother_apply_vect.f90 | 12 ------------ 8 files changed, 4 insertions(+), 72 deletions(-) diff --git a/mlprec/impl/smoother/mld_c_as_smoother_apply_vect.f90 b/mlprec/impl/smoother/mld_c_as_smoother_apply_vect.f90 index 6fc4ae38..23bb76ab 100644 --- a/mlprec/impl/smoother/mld_c_as_smoother_apply_vect.f90 +++ b/mlprec/impl/smoother/mld_c_as_smoother_apply_vect.f90 @@ -132,9 +132,6 @@ subroutine mld_c_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& end if associate(tx => wv(1), ty => wv(2), ww => wv(3)) -!!$ call psb_geasb(tx,sm%desc_data,info,mold=x%v,scratch=.true.) -!!$ call psb_geasb(ty,sm%desc_data,info,mold=x%v,scratch=.true.) -!!$ call psb_geasb(ww,sm%desc_data,info,mold=x%v,scratch=.true.) ! Need to zero tx because of the apply_restr call. call tx%zero() ! @@ -227,9 +224,7 @@ subroutine mld_c_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& if (.not.(4*isz <= size(work))) then deallocate(aux,stat=info) endif -!!$ if (info ==0) call ww%free(info) -!!$ if (info ==0) call tx%free(info) -!!$ if (info ==0) call ty%free(info) + if (info /= 0) then info = psb_err_alloc_dealloc_ call psb_errpush(info,name) diff --git a/mlprec/impl/smoother/mld_c_jac_smoother_apply_vect.f90 b/mlprec/impl/smoother/mld_c_jac_smoother_apply_vect.f90 index 5e393745..bc316805 100644 --- a/mlprec/impl/smoother/mld_c_jac_smoother_apply_vect.f90 +++ b/mlprec/impl/smoother/mld_c_jac_smoother_apply_vect.f90 @@ -124,15 +124,11 @@ subroutine mld_c_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& ! if (size(wv) < 2) then info = psb_err_internal_error_ - write(0,*) 'Size (WV) : ',size(wv) call psb_errpush(info,name,& & a_err='invalid wv size in smoother_apply') goto 9999 end if associate(tx => wv(1), ty => wv(2)) -!!$ call psb_geasb(tx,desc_data,info,mold=x%v,scratch=.true.) -!!$ call psb_geasb(ty,desc_data,info,mold=x%v,scratch=.true.) - ! ! Unroll the first iteration and fold it inside SELECT CASE @@ -192,14 +188,6 @@ subroutine mld_c_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& goto 9999 end if -!!$ call tx%free(info) -!!$ if (info == psb_success_) call ty%free(info) -!!$ if (info /= psb_success_) then -!!$ info=psb_err_internal_error_ -!!$ call psb_errpush(info,name,& -!!$ & a_err='final cleanup with Jacobi sweeps > 1') -!!$ goto 9999 -!!$ end if end associate else diff --git a/mlprec/impl/smoother/mld_d_as_smoother_apply_vect.f90 b/mlprec/impl/smoother/mld_d_as_smoother_apply_vect.f90 index 68bae713..d0c99f3f 100644 --- a/mlprec/impl/smoother/mld_d_as_smoother_apply_vect.f90 +++ b/mlprec/impl/smoother/mld_d_as_smoother_apply_vect.f90 @@ -132,9 +132,6 @@ subroutine mld_d_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& end if associate(tx => wv(1), ty => wv(2), ww => wv(3)) -!!$ call psb_geasb(tx,sm%desc_data,info,mold=x%v,scratch=.true.) -!!$ call psb_geasb(ty,sm%desc_data,info,mold=x%v,scratch=.true.) -!!$ call psb_geasb(ww,sm%desc_data,info,mold=x%v,scratch=.true.) ! Need to zero tx because of the apply_restr call. call tx%zero() ! @@ -227,9 +224,7 @@ subroutine mld_d_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& if (.not.(4*isz <= size(work))) then deallocate(aux,stat=info) endif -!!$ if (info ==0) call ww%free(info) -!!$ if (info ==0) call tx%free(info) -!!$ if (info ==0) call ty%free(info) + if (info /= 0) then info = psb_err_alloc_dealloc_ call psb_errpush(info,name) diff --git a/mlprec/impl/smoother/mld_d_jac_smoother_apply_vect.f90 b/mlprec/impl/smoother/mld_d_jac_smoother_apply_vect.f90 index c5d2b002..82ab514e 100644 --- a/mlprec/impl/smoother/mld_d_jac_smoother_apply_vect.f90 +++ b/mlprec/impl/smoother/mld_d_jac_smoother_apply_vect.f90 @@ -124,15 +124,11 @@ subroutine mld_d_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& ! if (size(wv) < 2) then info = psb_err_internal_error_ - write(0,*) 'Size (WV) : ',size(wv) call psb_errpush(info,name,& & a_err='invalid wv size in smoother_apply') goto 9999 end if associate(tx => wv(1), ty => wv(2)) -!!$ call psb_geasb(tx,desc_data,info,mold=x%v,scratch=.true.) -!!$ call psb_geasb(ty,desc_data,info,mold=x%v,scratch=.true.) - ! ! Unroll the first iteration and fold it inside SELECT CASE @@ -192,14 +188,6 @@ subroutine mld_d_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& goto 9999 end if -!!$ call tx%free(info) -!!$ if (info == psb_success_) call ty%free(info) -!!$ if (info /= psb_success_) then -!!$ info=psb_err_internal_error_ -!!$ call psb_errpush(info,name,& -!!$ & a_err='final cleanup with Jacobi sweeps > 1') -!!$ goto 9999 -!!$ end if end associate else diff --git a/mlprec/impl/smoother/mld_s_as_smoother_apply_vect.f90 b/mlprec/impl/smoother/mld_s_as_smoother_apply_vect.f90 index ecfcd54b..18b53ee9 100644 --- a/mlprec/impl/smoother/mld_s_as_smoother_apply_vect.f90 +++ b/mlprec/impl/smoother/mld_s_as_smoother_apply_vect.f90 @@ -132,9 +132,6 @@ subroutine mld_s_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& end if associate(tx => wv(1), ty => wv(2), ww => wv(3)) -!!$ call psb_geasb(tx,sm%desc_data,info,mold=x%v,scratch=.true.) -!!$ call psb_geasb(ty,sm%desc_data,info,mold=x%v,scratch=.true.) -!!$ call psb_geasb(ww,sm%desc_data,info,mold=x%v,scratch=.true.) ! Need to zero tx because of the apply_restr call. call tx%zero() ! @@ -227,9 +224,7 @@ subroutine mld_s_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& if (.not.(4*isz <= size(work))) then deallocate(aux,stat=info) endif -!!$ if (info ==0) call ww%free(info) -!!$ if (info ==0) call tx%free(info) -!!$ if (info ==0) call ty%free(info) + if (info /= 0) then info = psb_err_alloc_dealloc_ call psb_errpush(info,name) diff --git a/mlprec/impl/smoother/mld_s_jac_smoother_apply_vect.f90 b/mlprec/impl/smoother/mld_s_jac_smoother_apply_vect.f90 index 64927b4e..94f5d601 100644 --- a/mlprec/impl/smoother/mld_s_jac_smoother_apply_vect.f90 +++ b/mlprec/impl/smoother/mld_s_jac_smoother_apply_vect.f90 @@ -124,15 +124,11 @@ subroutine mld_s_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& ! if (size(wv) < 2) then info = psb_err_internal_error_ - write(0,*) 'Size (WV) : ',size(wv) call psb_errpush(info,name,& & a_err='invalid wv size in smoother_apply') goto 9999 end if associate(tx => wv(1), ty => wv(2)) -!!$ call psb_geasb(tx,desc_data,info,mold=x%v,scratch=.true.) -!!$ call psb_geasb(ty,desc_data,info,mold=x%v,scratch=.true.) - ! ! Unroll the first iteration and fold it inside SELECT CASE @@ -192,14 +188,6 @@ subroutine mld_s_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& goto 9999 end if -!!$ call tx%free(info) -!!$ if (info == psb_success_) call ty%free(info) -!!$ if (info /= psb_success_) then -!!$ info=psb_err_internal_error_ -!!$ call psb_errpush(info,name,& -!!$ & a_err='final cleanup with Jacobi sweeps > 1') -!!$ goto 9999 -!!$ end if end associate else diff --git a/mlprec/impl/smoother/mld_z_as_smoother_apply_vect.f90 b/mlprec/impl/smoother/mld_z_as_smoother_apply_vect.f90 index ae52866b..4ec1deb4 100644 --- a/mlprec/impl/smoother/mld_z_as_smoother_apply_vect.f90 +++ b/mlprec/impl/smoother/mld_z_as_smoother_apply_vect.f90 @@ -132,9 +132,6 @@ subroutine mld_z_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& end if associate(tx => wv(1), ty => wv(2), ww => wv(3)) -!!$ call psb_geasb(tx,sm%desc_data,info,mold=x%v,scratch=.true.) -!!$ call psb_geasb(ty,sm%desc_data,info,mold=x%v,scratch=.true.) -!!$ call psb_geasb(ww,sm%desc_data,info,mold=x%v,scratch=.true.) ! Need to zero tx because of the apply_restr call. call tx%zero() ! @@ -227,9 +224,7 @@ subroutine mld_z_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& if (.not.(4*isz <= size(work))) then deallocate(aux,stat=info) endif -!!$ if (info ==0) call ww%free(info) -!!$ if (info ==0) call tx%free(info) -!!$ if (info ==0) call ty%free(info) + if (info /= 0) then info = psb_err_alloc_dealloc_ call psb_errpush(info,name) diff --git a/mlprec/impl/smoother/mld_z_jac_smoother_apply_vect.f90 b/mlprec/impl/smoother/mld_z_jac_smoother_apply_vect.f90 index af0e6488..b576d0da 100644 --- a/mlprec/impl/smoother/mld_z_jac_smoother_apply_vect.f90 +++ b/mlprec/impl/smoother/mld_z_jac_smoother_apply_vect.f90 @@ -124,15 +124,11 @@ subroutine mld_z_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& ! if (size(wv) < 2) then info = psb_err_internal_error_ - write(0,*) 'Size (WV) : ',size(wv) call psb_errpush(info,name,& & a_err='invalid wv size in smoother_apply') goto 9999 end if associate(tx => wv(1), ty => wv(2)) -!!$ call psb_geasb(tx,desc_data,info,mold=x%v,scratch=.true.) -!!$ call psb_geasb(ty,desc_data,info,mold=x%v,scratch=.true.) - ! ! Unroll the first iteration and fold it inside SELECT CASE @@ -192,14 +188,6 @@ subroutine mld_z_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& goto 9999 end if -!!$ call tx%free(info) -!!$ if (info == psb_success_) call ty%free(info) -!!$ if (info /= psb_success_) then -!!$ info=psb_err_internal_error_ -!!$ call psb_errpush(info,name,& -!!$ & a_err='final cleanup with Jacobi sweeps > 1') -!!$ goto 9999 -!!$ end if end associate else