mirror of
https://github.com/sfilippone/amg4psblas.git
synced 2026-10-19 20:32:13 +00:00
mld2p4-2:
mlprec/impl/smoother/mld_c_as_smoother_apply.f90 mlprec/impl/smoother/mld_c_as_smoother_apply_vect.f90 mlprec/impl/smoother/mld_c_base_smoother_apply.f90 mlprec/impl/smoother/mld_c_base_smoother_apply_vect.f90 mlprec/impl/smoother/mld_c_jac_smoother_apply.f90 mlprec/impl/smoother/mld_c_jac_smoother_apply_vect.f90 mlprec/impl/smoother/mld_d_as_smoother_apply.f90 mlprec/impl/smoother/mld_d_as_smoother_apply_vect.f90 mlprec/impl/smoother/mld_d_base_smoother_apply.f90 mlprec/impl/smoother/mld_d_base_smoother_apply_vect.f90 mlprec/impl/smoother/mld_d_jac_smoother_apply.f90 mlprec/impl/smoother/mld_d_jac_smoother_apply_vect.f90 mlprec/impl/smoother/mld_s_as_smoother_apply.f90 mlprec/impl/smoother/mld_s_as_smoother_apply_vect.f90 mlprec/impl/smoother/mld_s_base_smoother_apply.f90 mlprec/impl/smoother/mld_s_base_smoother_apply_vect.f90 mlprec/impl/smoother/mld_s_jac_smoother_apply.f90 mlprec/impl/smoother/mld_s_jac_smoother_apply_vect.f90 mlprec/impl/smoother/mld_z_as_smoother_apply.f90 mlprec/impl/smoother/mld_z_as_smoother_apply_vect.f90 mlprec/impl/smoother/mld_z_base_smoother_apply.f90 mlprec/impl/smoother/mld_z_base_smoother_apply_vect.f90 mlprec/impl/smoother/mld_z_jac_smoother_apply.f90 mlprec/impl/smoother/mld_z_jac_smoother_apply_vect.f90 When number of smoothing passes is 0, the smoother applies the identity.
This commit is contained in:
Salvatore Filippone
@@ -121,7 +121,15 @@ subroutine mld_c_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
|
||||
|
||||
endif
|
||||
|
||||
if ((sm%novr == 0).and.(sweeps == 1)) then
|
||||
if (sweeps == 0) then
|
||||
|
||||
!
|
||||
! K^0 = I
|
||||
! zero sweeps of any smoother is just the identity.
|
||||
!
|
||||
call psb_geaxpby(alpha,x,beta,y,desc_data,info)
|
||||
|
||||
else if ((sm%novr == 0).and.(sweeps == 1)) then
|
||||
!
|
||||
! Shortcut: in this case it's just the same
|
||||
! as Block Jacobi.
|
||||
|
||||
@@ -124,7 +124,15 @@ subroutine mld_c_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
|
||||
|
||||
endif
|
||||
|
||||
if ((sm%novr == 0).and.(sweeps == 1).and.(.not.sm%sv%is_iterative())) then
|
||||
if (sweeps == 0) then
|
||||
|
||||
!
|
||||
! K^0 = I
|
||||
! zero sweeps of any smoother is just the identity.
|
||||
!
|
||||
call psb_geaxpby(alpha,x,beta,y,desc_data,info)
|
||||
|
||||
else if ((sm%novr == 0).and.(sweeps == 1).and.(.not.sm%sv%is_iterative())) then
|
||||
!
|
||||
! Shortcut: in this case it's just the same
|
||||
! as Block Jacobi.
|
||||
|
||||
@@ -56,11 +56,21 @@ subroutine mld_c_base_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,wo
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%apply(alpha,x,beta,y,desc_data,trans,work,info)
|
||||
if (sweeps == 0) then
|
||||
|
||||
!
|
||||
! K^0 = I
|
||||
! zero sweeps of any smoother is just the identity.
|
||||
!
|
||||
call psb_geaxpby(alpha,x,beta,y,desc_data,info)
|
||||
|
||||
else
|
||||
info = 1121
|
||||
endif
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%apply(alpha,x,beta,y,desc_data,trans,work,info)
|
||||
else
|
||||
info = 1121
|
||||
endif
|
||||
end if
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
|
||||
@@ -57,11 +57,21 @@ subroutine mld_c_base_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,&
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%apply(alpha,x,beta,y,desc_data,trans,work,info)
|
||||
if (sweeps == 0) then
|
||||
|
||||
!
|
||||
! K^0 = I
|
||||
! zero sweeps of any smoother is just the identity.
|
||||
!
|
||||
call psb_geaxpby(alpha,x,beta,y,desc_data,info)
|
||||
|
||||
else
|
||||
info = 1121
|
||||
endif
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%apply(alpha,x,beta,y,desc_data,trans,work,info)
|
||||
else
|
||||
info = 1121
|
||||
endif
|
||||
end if
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
|
||||
@@ -104,7 +104,15 @@ subroutine mld_c_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,wor
|
||||
end if
|
||||
endif
|
||||
|
||||
if ((sweeps == 1).or.(sm%nnz_nd_tot==0)) then
|
||||
if (sweeps == 0) then
|
||||
|
||||
!
|
||||
! K^0 = I
|
||||
! zero sweeps of any smoother is just the identity.
|
||||
!
|
||||
call psb_geaxpby(alpha,x,beta,y,desc_data,info)
|
||||
|
||||
else if ((sweeps == 1).or.(sm%nnz_nd_tot==0)) then
|
||||
|
||||
call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,info)
|
||||
|
||||
|
||||
@@ -109,7 +109,15 @@ subroutine mld_c_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
|
||||
|
||||
!!$ write(0,*) 'Jacobi smoother with ',sweeps
|
||||
|
||||
if ((.not.sm%sv%is_iterative()).and.((sweeps == 1).or.(sm%nnz_nd_tot==0))) then
|
||||
if (sweeps == 0) then
|
||||
|
||||
!
|
||||
! K^0 = I
|
||||
! zero sweeps of any smoother is just the identity.
|
||||
!
|
||||
call psb_geaxpby(alpha,x,beta,y,desc_data,info)
|
||||
|
||||
else if ((.not.sm%sv%is_iterative()).and.((sweeps == 1).or.(sm%nnz_nd_tot==0))) then
|
||||
|
||||
call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,info)
|
||||
|
||||
|
||||
@@ -121,7 +121,15 @@ subroutine mld_d_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
|
||||
|
||||
endif
|
||||
|
||||
if ((sm%novr == 0).and.(sweeps == 1)) then
|
||||
if (sweeps == 0) then
|
||||
|
||||
!
|
||||
! K^0 = I
|
||||
! zero sweeps of any smoother is just the identity.
|
||||
!
|
||||
call psb_geaxpby(alpha,x,beta,y,desc_data,info)
|
||||
|
||||
else if ((sm%novr == 0).and.(sweeps == 1)) then
|
||||
!
|
||||
! Shortcut: in this case it's just the same
|
||||
! as Block Jacobi.
|
||||
|
||||
@@ -124,7 +124,15 @@ subroutine mld_d_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
|
||||
|
||||
endif
|
||||
|
||||
if ((sm%novr == 0).and.(sweeps == 1).and.(.not.sm%sv%is_iterative())) then
|
||||
if (sweeps == 0) then
|
||||
|
||||
!
|
||||
! K^0 = I
|
||||
! zero sweeps of any smoother is just the identity.
|
||||
!
|
||||
call psb_geaxpby(alpha,x,beta,y,desc_data,info)
|
||||
|
||||
else if ((sm%novr == 0).and.(sweeps == 1).and.(.not.sm%sv%is_iterative())) then
|
||||
!
|
||||
! Shortcut: in this case it's just the same
|
||||
! as Block Jacobi.
|
||||
|
||||
@@ -56,11 +56,21 @@ subroutine mld_d_base_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,wo
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%apply(alpha,x,beta,y,desc_data,trans,work,info)
|
||||
if (sweeps == 0) then
|
||||
|
||||
!
|
||||
! K^0 = I
|
||||
! zero sweeps of any smoother is just the identity.
|
||||
!
|
||||
call psb_geaxpby(alpha,x,beta,y,desc_data,info)
|
||||
|
||||
else
|
||||
info = 1121
|
||||
endif
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%apply(alpha,x,beta,y,desc_data,trans,work,info)
|
||||
else
|
||||
info = 1121
|
||||
endif
|
||||
end if
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
|
||||
@@ -57,11 +57,21 @@ subroutine mld_d_base_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,&
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%apply(alpha,x,beta,y,desc_data,trans,work,info)
|
||||
if (sweeps == 0) then
|
||||
|
||||
!
|
||||
! K^0 = I
|
||||
! zero sweeps of any smoother is just the identity.
|
||||
!
|
||||
call psb_geaxpby(alpha,x,beta,y,desc_data,info)
|
||||
|
||||
else
|
||||
info = 1121
|
||||
endif
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%apply(alpha,x,beta,y,desc_data,trans,work,info)
|
||||
else
|
||||
info = 1121
|
||||
endif
|
||||
end if
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
|
||||
@@ -104,7 +104,15 @@ subroutine mld_d_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,wor
|
||||
end if
|
||||
endif
|
||||
|
||||
if ((sweeps == 1).or.(sm%nnz_nd_tot==0)) then
|
||||
if (sweeps == 0) then
|
||||
|
||||
!
|
||||
! K^0 = I
|
||||
! zero sweeps of any smoother is just the identity.
|
||||
!
|
||||
call psb_geaxpby(alpha,x,beta,y,desc_data,info)
|
||||
|
||||
else if ((sweeps == 1).or.(sm%nnz_nd_tot==0)) then
|
||||
|
||||
call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,info)
|
||||
|
||||
|
||||
@@ -109,7 +109,15 @@ subroutine mld_d_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
|
||||
|
||||
!!$ write(0,*) 'Jacobi smoother with ',sweeps
|
||||
|
||||
if ((.not.sm%sv%is_iterative()).and.((sweeps == 1).or.(sm%nnz_nd_tot==0))) then
|
||||
if (sweeps == 0) then
|
||||
|
||||
!
|
||||
! K^0 = I
|
||||
! zero sweeps of any smoother is just the identity.
|
||||
!
|
||||
call psb_geaxpby(alpha,x,beta,y,desc_data,info)
|
||||
|
||||
else if ((.not.sm%sv%is_iterative()).and.((sweeps == 1).or.(sm%nnz_nd_tot==0))) then
|
||||
|
||||
call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,info)
|
||||
|
||||
@@ -127,7 +135,7 @@ subroutine mld_d_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
|
||||
!
|
||||
!
|
||||
call tx%bld(x%get_nrows(),mold=x%v)
|
||||
call tx%set(dzero)
|
||||
call psb_geaxpby(done,y,dzero,tx,desc_data,info)
|
||||
call ty%bld(x%get_nrows(),mold=x%v)
|
||||
|
||||
do i=1, sweeps
|
||||
|
||||
@@ -121,7 +121,15 @@ subroutine mld_s_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
|
||||
|
||||
endif
|
||||
|
||||
if ((sm%novr == 0).and.(sweeps == 1)) then
|
||||
if (sweeps == 0) then
|
||||
|
||||
!
|
||||
! K^0 = I
|
||||
! zero sweeps of any smoother is just the identity.
|
||||
!
|
||||
call psb_geaxpby(alpha,x,beta,y,desc_data,info)
|
||||
|
||||
else if ((sm%novr == 0).and.(sweeps == 1)) then
|
||||
!
|
||||
! Shortcut: in this case it's just the same
|
||||
! as Block Jacobi.
|
||||
|
||||
@@ -124,7 +124,15 @@ subroutine mld_s_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
|
||||
|
||||
endif
|
||||
|
||||
if ((sm%novr == 0).and.(sweeps == 1).and.(.not.sm%sv%is_iterative())) then
|
||||
if (sweeps == 0) then
|
||||
|
||||
!
|
||||
! K^0 = I
|
||||
! zero sweeps of any smoother is just the identity.
|
||||
!
|
||||
call psb_geaxpby(alpha,x,beta,y,desc_data,info)
|
||||
|
||||
else if ((sm%novr == 0).and.(sweeps == 1).and.(.not.sm%sv%is_iterative())) then
|
||||
!
|
||||
! Shortcut: in this case it's just the same
|
||||
! as Block Jacobi.
|
||||
|
||||
@@ -56,11 +56,21 @@ subroutine mld_s_base_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,wo
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%apply(alpha,x,beta,y,desc_data,trans,work,info)
|
||||
if (sweeps == 0) then
|
||||
|
||||
!
|
||||
! K^0 = I
|
||||
! zero sweeps of any smoother is just the identity.
|
||||
!
|
||||
call psb_geaxpby(alpha,x,beta,y,desc_data,info)
|
||||
|
||||
else
|
||||
info = 1121
|
||||
endif
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%apply(alpha,x,beta,y,desc_data,trans,work,info)
|
||||
else
|
||||
info = 1121
|
||||
endif
|
||||
end if
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
|
||||
@@ -57,11 +57,21 @@ subroutine mld_s_base_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,&
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%apply(alpha,x,beta,y,desc_data,trans,work,info)
|
||||
if (sweeps == 0) then
|
||||
|
||||
!
|
||||
! K^0 = I
|
||||
! zero sweeps of any smoother is just the identity.
|
||||
!
|
||||
call psb_geaxpby(alpha,x,beta,y,desc_data,info)
|
||||
|
||||
else
|
||||
info = 1121
|
||||
endif
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%apply(alpha,x,beta,y,desc_data,trans,work,info)
|
||||
else
|
||||
info = 1121
|
||||
endif
|
||||
end if
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
|
||||
@@ -104,7 +104,15 @@ subroutine mld_s_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,wor
|
||||
end if
|
||||
endif
|
||||
|
||||
if ((sweeps == 1).or.(sm%nnz_nd_tot==0)) then
|
||||
if (sweeps == 0) then
|
||||
|
||||
!
|
||||
! K^0 = I
|
||||
! zero sweeps of any smoother is just the identity.
|
||||
!
|
||||
call psb_geaxpby(alpha,x,beta,y,desc_data,info)
|
||||
|
||||
else if ((sweeps == 1).or.(sm%nnz_nd_tot==0)) then
|
||||
|
||||
call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,info)
|
||||
|
||||
|
||||
@@ -109,7 +109,15 @@ subroutine mld_s_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
|
||||
|
||||
!!$ write(0,*) 'Jacobi smoother with ',sweeps
|
||||
|
||||
if ((.not.sm%sv%is_iterative()).and.((sweeps == 1).or.(sm%nnz_nd_tot==0))) then
|
||||
if (sweeps == 0) then
|
||||
|
||||
!
|
||||
! K^0 = I
|
||||
! zero sweeps of any smoother is just the identity.
|
||||
!
|
||||
call psb_geaxpby(alpha,x,beta,y,desc_data,info)
|
||||
|
||||
else if ((.not.sm%sv%is_iterative()).and.((sweeps == 1).or.(sm%nnz_nd_tot==0))) then
|
||||
|
||||
call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,info)
|
||||
|
||||
|
||||
@@ -121,7 +121,15 @@ subroutine mld_z_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
|
||||
|
||||
endif
|
||||
|
||||
if ((sm%novr == 0).and.(sweeps == 1)) then
|
||||
if (sweeps == 0) then
|
||||
|
||||
!
|
||||
! K^0 = I
|
||||
! zero sweeps of any smoother is just the identity.
|
||||
!
|
||||
call psb_geaxpby(alpha,x,beta,y,desc_data,info)
|
||||
|
||||
else if ((sm%novr == 0).and.(sweeps == 1)) then
|
||||
!
|
||||
! Shortcut: in this case it's just the same
|
||||
! as Block Jacobi.
|
||||
|
||||
@@ -124,7 +124,15 @@ subroutine mld_z_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
|
||||
|
||||
endif
|
||||
|
||||
if ((sm%novr == 0).and.(sweeps == 1).and.(.not.sm%sv%is_iterative())) then
|
||||
if (sweeps == 0) then
|
||||
|
||||
!
|
||||
! K^0 = I
|
||||
! zero sweeps of any smoother is just the identity.
|
||||
!
|
||||
call psb_geaxpby(alpha,x,beta,y,desc_data,info)
|
||||
|
||||
else if ((sm%novr == 0).and.(sweeps == 1).and.(.not.sm%sv%is_iterative())) then
|
||||
!
|
||||
! Shortcut: in this case it's just the same
|
||||
! as Block Jacobi.
|
||||
|
||||
@@ -56,11 +56,21 @@ subroutine mld_z_base_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,wo
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%apply(alpha,x,beta,y,desc_data,trans,work,info)
|
||||
if (sweeps == 0) then
|
||||
|
||||
!
|
||||
! K^0 = I
|
||||
! zero sweeps of any smoother is just the identity.
|
||||
!
|
||||
call psb_geaxpby(alpha,x,beta,y,desc_data,info)
|
||||
|
||||
else
|
||||
info = 1121
|
||||
endif
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%apply(alpha,x,beta,y,desc_data,trans,work,info)
|
||||
else
|
||||
info = 1121
|
||||
endif
|
||||
end if
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
|
||||
@@ -57,11 +57,21 @@ subroutine mld_z_base_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,&
|
||||
|
||||
call psb_erractionsave(err_act)
|
||||
info = psb_success_
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%apply(alpha,x,beta,y,desc_data,trans,work,info)
|
||||
if (sweeps == 0) then
|
||||
|
||||
!
|
||||
! K^0 = I
|
||||
! zero sweeps of any smoother is just the identity.
|
||||
!
|
||||
call psb_geaxpby(alpha,x,beta,y,desc_data,info)
|
||||
|
||||
else
|
||||
info = 1121
|
||||
endif
|
||||
if (allocated(sm%sv)) then
|
||||
call sm%sv%apply(alpha,x,beta,y,desc_data,trans,work,info)
|
||||
else
|
||||
info = 1121
|
||||
endif
|
||||
end if
|
||||
if (info /= psb_success_) then
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
|
||||
@@ -104,7 +104,15 @@ subroutine mld_z_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,wor
|
||||
end if
|
||||
endif
|
||||
|
||||
if ((sweeps == 1).or.(sm%nnz_nd_tot==0)) then
|
||||
if (sweeps == 0) then
|
||||
|
||||
!
|
||||
! K^0 = I
|
||||
! zero sweeps of any smoother is just the identity.
|
||||
!
|
||||
call psb_geaxpby(alpha,x,beta,y,desc_data,info)
|
||||
|
||||
else if ((sweeps == 1).or.(sm%nnz_nd_tot==0)) then
|
||||
|
||||
call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,info)
|
||||
|
||||
|
||||
@@ -109,7 +109,15 @@ subroutine mld_z_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
|
||||
|
||||
!!$ write(0,*) 'Jacobi smoother with ',sweeps
|
||||
|
||||
if ((.not.sm%sv%is_iterative()).and.((sweeps == 1).or.(sm%nnz_nd_tot==0))) then
|
||||
if (sweeps == 0) then
|
||||
|
||||
!
|
||||
! K^0 = I
|
||||
! zero sweeps of any smoother is just the identity.
|
||||
!
|
||||
call psb_geaxpby(alpha,x,beta,y,desc_data,info)
|
||||
|
||||
else if ((.not.sm%sv%is_iterative()).and.((sweeps == 1).or.(sm%nnz_nd_tot==0))) then
|
||||
|
||||
call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,info)
|
||||
|
||||
|
||||
Reference in New Issue
Block a user