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/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.
stopcriterion
Salvatore Filippone 9 years ago
parent 342d117ca1
commit c4ee9f8c9a
24 changed files with 257 additions and 49 deletions
Show Stats Download Patch File Download Diff File

10
mlprec/impl/smoother/mld_c_as_smoother_apply.f90
Unescape Escape View File

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

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

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

18
mlprec/impl/smoother/mld_c_base_smoother_apply.f90
Unescape Escape View File

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

18
mlprec/impl/smoother/mld_c_base_smoother_apply_vect.f90
Unescape Escape View File

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

10
mlprec/impl/smoother/mld_c_jac_smoother_apply.f90
Unescape Escape View File

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

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

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

10
mlprec/impl/smoother/mld_d_as_smoother_apply.f90
Unescape Escape View File

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

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

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

18
mlprec/impl/smoother/mld_d_base_smoother_apply.f90
Unescape Escape View File

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

18
mlprec/impl/smoother/mld_d_base_smoother_apply_vect.f90
Unescape Escape View File

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

10
mlprec/impl/smoother/mld_d_jac_smoother_apply.f90
Unescape Escape View File

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

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

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

10
mlprec/impl/smoother/mld_s_as_smoother_apply.f90
Unescape Escape View File

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

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

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

18
mlprec/impl/smoother/mld_s_base_smoother_apply.f90
Unescape Escape View File

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

18
mlprec/impl/smoother/mld_s_base_smoother_apply_vect.f90
Unescape Escape View File

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

10
mlprec/impl/smoother/mld_s_jac_smoother_apply.f90
Unescape Escape View File

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

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

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

10
mlprec/impl/smoother/mld_z_as_smoother_apply.f90
Unescape Escape View File

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

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

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

18
mlprec/impl/smoother/mld_z_base_smoother_apply.f90
Unescape Escape View File

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

18
mlprec/impl/smoother/mld_z_base_smoother_apply_vect.f90
Unescape Escape View File

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

10
mlprec/impl/smoother/mld_z_jac_smoother_apply.f90
Unescape Escape View File

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

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

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

Write Preview
Loading…
Cancel
Save