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

Cleanup smoother_apply.

Browse Source
stopcriterion
Salvatore Filippone 7 years ago
parent 3250853810
commit 4564e1e4ba
8 changed files with 4 additions and 72 deletions
Show Stats Download Patch File Download Diff File

7
mlprec/impl/smoother/mld_c_as_smoother_apply_vect.f90
Unescape Escape View File

@ -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)

12
mlprec/impl/smoother/mld_c_jac_smoother_apply_vect.f90
Unescape Escape View File

@ -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

7
mlprec/impl/smoother/mld_d_as_smoother_apply_vect.f90
Unescape Escape View File

@ -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)

12
mlprec/impl/smoother/mld_d_jac_smoother_apply_vect.f90
Unescape Escape View File

@ -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

7
mlprec/impl/smoother/mld_s_as_smoother_apply_vect.f90
Unescape Escape View File

@ -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)

12
mlprec/impl/smoother/mld_s_jac_smoother_apply_vect.f90
Unescape Escape View File

@ -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

7
mlprec/impl/smoother/mld_z_as_smoother_apply_vect.f90
Unescape Escape View File

@ -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)

12
mlprec/impl/smoother/mld_z_jac_smoother_apply_vect.f90
Unescape Escape View File

@ -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

Write Preview
Loading…
Cancel
Save