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_jac_smoother_apply.f90
 mlprec/impl/smoother/mld_c_jac_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_jac_smoother_apply.f90
 mlprec/impl/smoother/mld_s_jac_smoother_apply_vect.f90
 mlprec/impl/smoother/mld_z_jac_smoother_apply.f90
 mlprec/impl/smoother/mld_z_jac_smoother_apply_vect.f90

Improve readability
stopcriterion
Salvatore Filippone 9 years ago
parent e7492ad867
commit 0daf3db1f1
8 changed files with 136 additions and 204 deletions
Show Stats Download Patch File Download Diff File

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

@ -114,25 +114,17 @@ subroutine mld_c_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,&
end if end if
endif endif
if (sweeps == 0) then !!$ if ((.not.sm%sv%is_iterative()).and.((sweeps == 1).or.(sm%nnz_nd_tot==0))) then
!!$ ! if .not.sv%is_iterative, there's no need to pass init
! !!$ call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,info)
! K^0 = I !!$
! zero sweeps of any smoother is just the identity. !!$ if (info /= psb_success_) then
! !!$ call psb_errpush(psb_err_internal_error_,&
call psb_geaxpby(alpha,x,beta,y,desc_data,info) !!$ & name,a_err='Error in sub_aply Jacobi Sweeps = 1')
!!$ goto 9999
else if ((.not.sm%sv%is_iterative()).and.((sweeps == 1).or.(sm%nnz_nd_tot==0))) then !!$ endif
! if .not.sv%is_iterative, there's no need to pass init !!$
call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,info) !!$ else if (sweeps >= 1) then
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,&
& name,a_err='Error in sub_aply Jacobi Sweeps = 1')
goto 9999
endif
else if (sweeps >= 1) then
! !
! !
! Apply multiple sweeps of a block-Jacobi solver ! Apply multiple sweeps of a block-Jacobi solver
@ -145,16 +137,16 @@ subroutine mld_c_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,&
select case (init_) select case (init_)
case('Z') case('Z')
tx(:) = czero ty(:) = czero
case('Y') case('Y')
call psb_geaxpby(cone,y,czero,tx,desc_data,info) call psb_geaxpby(cone,y,czero,ty,desc_data,info)
case('U') case('U')
if (.not.present(initu)) then if (.not.present(initu)) then
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='missing initu to smoother_apply') & a_err='missing initu to smoother_apply')
goto 9999 goto 9999
end if end if
call psb_geaxpby(cone,initu,czero,tx,desc_data,info) call psb_geaxpby(cone,initu,czero,ty,desc_data,info)
case default case default
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='wrong init to smoother_apply') & a_err='wrong init to smoother_apply')
@ -167,17 +159,17 @@ subroutine mld_c_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,&
! block diagonal part and the remaining part of the local matrix ! block diagonal part and the remaining part of the local matrix
! and Y(j) is the approximate solution at sweep j. ! and Y(j) is the approximate solution at sweep j.
! !
call psb_geaxpby(cone,x,czero,ty,desc_data,info) call psb_geaxpby(cone,x,czero,tx,desc_data,info)
call psb_spmm(-cone,sm%nd,tx,cone,ty,desc_data,info,work=aux,trans=trans_) call psb_spmm(-cone,sm%nd,ty,cone,tx,desc_data,info,work=aux,trans=trans_)
if (info /= psb_success_) exit if (info /= psb_success_) exit
call sm%sv%apply(cone,ty,czero,tx,desc_data,trans_,aux,info,init='Y') call sm%sv%apply(cone,tx,czero,ty,desc_data,trans_,aux,info,init='Y')
if (info /= psb_success_) exit if (info /= psb_success_) exit
end do end do
if (info == psb_success_) call psb_geaxpby(alpha,tx,beta,y,desc_data,info) if (info == psb_success_) call psb_geaxpby(alpha,ty,beta,y,desc_data,info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_internal_error_ info=psb_err_internal_error_
@ -194,14 +186,14 @@ subroutine mld_c_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,&
goto 9999 goto 9999
end if end if
else !!$ else
!!$
info = psb_err_iarg_neg_ !!$ info = psb_err_iarg_neg_
call psb_errpush(info,name,& !!$ call psb_errpush(info,name,&
& i_err=(/itwo,sweeps,izero,izero,izero/)) !!$ & i_err=(/itwo,sweeps,izero,izero,izero/))
goto 9999 !!$ goto 9999
!!$
endif !!$ endif
if (n_col <= size(work)) then if (n_col <= size(work)) then

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

@ -115,15 +115,7 @@ subroutine mld_c_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
end if end if
endif endif
!!$ if (sweeps == 0) then !!$ if ((.not.sm%sv%is_iterative()).and.((sweeps == 1).or.(sm%nnz_nd_tot==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
!!$ ! if .not.sv%is_iterative, there's no need to pass init !!$ ! if .not.sv%is_iterative, there's no need to pass init
!!$ call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,info) !!$ call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,info)
!!$ !!$
@ -146,16 +138,16 @@ subroutine mld_c_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
select case (init_) select case (init_)
case('Z') case('Z')
call tx%zero() call ty%zero()
case('Y') case('Y')
call psb_geaxpby(cone,y,czero,tx,desc_data,info) call psb_geaxpby(cone,y,czero,ty,desc_data,info)
case('U') case('U')
if (.not.present(initu)) then if (.not.present(initu)) then
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='missing initu to smoother_apply') & a_err='missing initu to smoother_apply')
goto 9999 goto 9999
end if end if
call psb_geaxpby(cone,initu,czero,tx,desc_data,info) call psb_geaxpby(cone,initu,czero,ty,desc_data,info)
case default case default
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='wrong init to smoother_apply') & a_err='wrong init to smoother_apply')
@ -168,17 +160,17 @@ subroutine mld_c_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
! block diagonal part and the remaining part of the local matrix ! block diagonal part and the remaining part of the local matrix
! and Y(j) is the approximate solution at sweep j. ! and Y(j) is the approximate solution at sweep j.
! !
call psb_geaxpby(cone,x,czero,ty,desc_data,info) call psb_geaxpby(cone,x,czero,tx,desc_data,info)
call psb_spmm(-cone,sm%nd,tx,cone,ty,desc_data,info,work=aux,trans=trans_) call psb_spmm(-cone,sm%nd,ty,cone,tx,desc_data,info,work=aux,trans=trans_)
if (info /= psb_success_) exit if (info /= psb_success_) exit
call sm%sv%apply(cone,ty,czero,tx,desc_data,trans_,aux,info,init='Y') call sm%sv%apply(cone,tx,czero,ty,desc_data,trans_,aux,info,init='Y')
if (info /= psb_success_) exit if (info /= psb_success_) exit
end do end do
if (info == psb_success_) call psb_geaxpby(alpha,tx,beta,y,desc_data,info) if (info == psb_success_) call psb_geaxpby(alpha,ty,beta,y,desc_data,info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_internal_error_ info=psb_err_internal_error_
@ -205,7 +197,6 @@ subroutine mld_c_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
!!$ !!$
!!$ endif !!$ endif
if (n_col <= size(work)) then if (n_col <= size(work)) then
if ((4*n_col+n_col) <= size(work)) then if ((4*n_col+n_col) <= size(work)) then
else else

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

@ -114,25 +114,17 @@ subroutine mld_d_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,&
end if end if
endif endif
if (sweeps == 0) then !!$ if ((.not.sm%sv%is_iterative()).and.((sweeps == 1).or.(sm%nnz_nd_tot==0))) then
!!$ ! if .not.sv%is_iterative, there's no need to pass init
! !!$ call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,info)
! K^0 = I !!$
! zero sweeps of any smoother is just the identity. !!$ if (info /= psb_success_) then
! !!$ call psb_errpush(psb_err_internal_error_,&
call psb_geaxpby(alpha,x,beta,y,desc_data,info) !!$ & name,a_err='Error in sub_aply Jacobi Sweeps = 1')
!!$ goto 9999
else if ((.not.sm%sv%is_iterative()).and.((sweeps == 1).or.(sm%nnz_nd_tot==0))) then !!$ endif
! if .not.sv%is_iterative, there's no need to pass init !!$
call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,info) !!$ else if (sweeps >= 1) then
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,&
& name,a_err='Error in sub_aply Jacobi Sweeps = 1')
goto 9999
endif
else if (sweeps >= 1) then
! !
! !
! Apply multiple sweeps of a block-Jacobi solver ! Apply multiple sweeps of a block-Jacobi solver
@ -145,16 +137,16 @@ subroutine mld_d_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,&
select case (init_) select case (init_)
case('Z') case('Z')
tx(:) = dzero ty(:) = dzero
case('Y') case('Y')
call psb_geaxpby(done,y,dzero,tx,desc_data,info) call psb_geaxpby(done,y,dzero,ty,desc_data,info)
case('U') case('U')
if (.not.present(initu)) then if (.not.present(initu)) then
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='missing initu to smoother_apply') & a_err='missing initu to smoother_apply')
goto 9999 goto 9999
end if end if
call psb_geaxpby(done,initu,dzero,tx,desc_data,info) call psb_geaxpby(done,initu,dzero,ty,desc_data,info)
case default case default
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='wrong init to smoother_apply') & a_err='wrong init to smoother_apply')
@ -167,17 +159,17 @@ subroutine mld_d_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,&
! block diagonal part and the remaining part of the local matrix ! block diagonal part and the remaining part of the local matrix
! and Y(j) is the approximate solution at sweep j. ! and Y(j) is the approximate solution at sweep j.
! !
call psb_geaxpby(done,x,dzero,ty,desc_data,info) call psb_geaxpby(done,x,dzero,tx,desc_data,info)
call psb_spmm(-done,sm%nd,tx,done,ty,desc_data,info,work=aux,trans=trans_) call psb_spmm(-done,sm%nd,ty,done,tx,desc_data,info,work=aux,trans=trans_)
if (info /= psb_success_) exit if (info /= psb_success_) exit
call sm%sv%apply(done,ty,dzero,tx,desc_data,trans_,aux,info,init='Y') call sm%sv%apply(done,tx,dzero,ty,desc_data,trans_,aux,info,init='Y')
if (info /= psb_success_) exit if (info /= psb_success_) exit
end do end do
if (info == psb_success_) call psb_geaxpby(alpha,tx,beta,y,desc_data,info) if (info == psb_success_) call psb_geaxpby(alpha,ty,beta,y,desc_data,info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_internal_error_ info=psb_err_internal_error_
@ -194,14 +186,14 @@ subroutine mld_d_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,&
goto 9999 goto 9999
end if end if
else !!$ else
!!$
info = psb_err_iarg_neg_ !!$ info = psb_err_iarg_neg_
call psb_errpush(info,name,& !!$ call psb_errpush(info,name,&
& i_err=(/itwo,sweeps,izero,izero,izero/)) !!$ & i_err=(/itwo,sweeps,izero,izero,izero/))
goto 9999 !!$ goto 9999
!!$
endif !!$ endif
if (n_col <= size(work)) then if (n_col <= size(work)) then

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

@ -115,15 +115,7 @@ subroutine mld_d_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
end if end if
endif endif
!!$ if (sweeps == 0) then !!$ if ((.not.sm%sv%is_iterative()).and.((sweeps == 1).or.(sm%nnz_nd_tot==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
!!$ ! if .not.sv%is_iterative, there's no need to pass init !!$ ! if .not.sv%is_iterative, there's no need to pass init
!!$ call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,info) !!$ call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,info)
!!$ !!$
@ -146,16 +138,16 @@ subroutine mld_d_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
select case (init_) select case (init_)
case('Z') case('Z')
call tx%zero() call ty%zero()
case('Y') case('Y')
call psb_geaxpby(done,y,dzero,tx,desc_data,info) call psb_geaxpby(done,y,dzero,ty,desc_data,info)
case('U') case('U')
if (.not.present(initu)) then if (.not.present(initu)) then
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='missing initu to smoother_apply') & a_err='missing initu to smoother_apply')
goto 9999 goto 9999
end if end if
call psb_geaxpby(done,initu,dzero,tx,desc_data,info) call psb_geaxpby(done,initu,dzero,ty,desc_data,info)
case default case default
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='wrong init to smoother_apply') & a_err='wrong init to smoother_apply')
@ -168,17 +160,17 @@ subroutine mld_d_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
! block diagonal part and the remaining part of the local matrix ! block diagonal part and the remaining part of the local matrix
! and Y(j) is the approximate solution at sweep j. ! and Y(j) is the approximate solution at sweep j.
! !
call psb_geaxpby(done,x,dzero,ty,desc_data,info) call psb_geaxpby(done,x,dzero,tx,desc_data,info)
call psb_spmm(-done,sm%nd,tx,done,ty,desc_data,info,work=aux,trans=trans_) call psb_spmm(-done,sm%nd,ty,done,tx,desc_data,info,work=aux,trans=trans_)
if (info /= psb_success_) exit if (info /= psb_success_) exit
call sm%sv%apply(done,ty,dzero,tx,desc_data,trans_,aux,info,init='Y') call sm%sv%apply(done,tx,dzero,ty,desc_data,trans_,aux,info,init='Y')
if (info /= psb_success_) exit if (info /= psb_success_) exit
end do end do
if (info == psb_success_) call psb_geaxpby(alpha,tx,beta,y,desc_data,info) if (info == psb_success_) call psb_geaxpby(alpha,ty,beta,y,desc_data,info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_internal_error_ info=psb_err_internal_error_
@ -205,7 +197,6 @@ subroutine mld_d_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
!!$ !!$
!!$ endif !!$ endif
if (n_col <= size(work)) then if (n_col <= size(work)) then
if ((4*n_col+n_col) <= size(work)) then if ((4*n_col+n_col) <= size(work)) then
else else

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

@ -114,25 +114,17 @@ subroutine mld_s_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,&
end if end if
endif endif
if (sweeps == 0) then !!$ if ((.not.sm%sv%is_iterative()).and.((sweeps == 1).or.(sm%nnz_nd_tot==0))) then
!!$ ! if .not.sv%is_iterative, there's no need to pass init
! !!$ call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,info)
! K^0 = I !!$
! zero sweeps of any smoother is just the identity. !!$ if (info /= psb_success_) then
! !!$ call psb_errpush(psb_err_internal_error_,&
call psb_geaxpby(alpha,x,beta,y,desc_data,info) !!$ & name,a_err='Error in sub_aply Jacobi Sweeps = 1')
!!$ goto 9999
else if ((.not.sm%sv%is_iterative()).and.((sweeps == 1).or.(sm%nnz_nd_tot==0))) then !!$ endif
! if .not.sv%is_iterative, there's no need to pass init !!$
call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,info) !!$ else if (sweeps >= 1) then
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,&
& name,a_err='Error in sub_aply Jacobi Sweeps = 1')
goto 9999
endif
else if (sweeps >= 1) then
! !
! !
! Apply multiple sweeps of a block-Jacobi solver ! Apply multiple sweeps of a block-Jacobi solver
@ -145,16 +137,16 @@ subroutine mld_s_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,&
select case (init_) select case (init_)
case('Z') case('Z')
tx(:) = szero ty(:) = szero
case('Y') case('Y')
call psb_geaxpby(sone,y,szero,tx,desc_data,info) call psb_geaxpby(sone,y,szero,ty,desc_data,info)
case('U') case('U')
if (.not.present(initu)) then if (.not.present(initu)) then
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='missing initu to smoother_apply') & a_err='missing initu to smoother_apply')
goto 9999 goto 9999
end if end if
call psb_geaxpby(sone,initu,szero,tx,desc_data,info) call psb_geaxpby(sone,initu,szero,ty,desc_data,info)
case default case default
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='wrong init to smoother_apply') & a_err='wrong init to smoother_apply')
@ -167,17 +159,17 @@ subroutine mld_s_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,&
! block diagonal part and the remaining part of the local matrix ! block diagonal part and the remaining part of the local matrix
! and Y(j) is the approximate solution at sweep j. ! and Y(j) is the approximate solution at sweep j.
! !
call psb_geaxpby(sone,x,szero,ty,desc_data,info) call psb_geaxpby(sone,x,szero,tx,desc_data,info)
call psb_spmm(-sone,sm%nd,tx,sone,ty,desc_data,info,work=aux,trans=trans_) call psb_spmm(-sone,sm%nd,ty,sone,tx,desc_data,info,work=aux,trans=trans_)
if (info /= psb_success_) exit if (info /= psb_success_) exit
call sm%sv%apply(sone,ty,szero,tx,desc_data,trans_,aux,info,init='Y') call sm%sv%apply(sone,tx,szero,ty,desc_data,trans_,aux,info,init='Y')
if (info /= psb_success_) exit if (info /= psb_success_) exit
end do end do
if (info == psb_success_) call psb_geaxpby(alpha,tx,beta,y,desc_data,info) if (info == psb_success_) call psb_geaxpby(alpha,ty,beta,y,desc_data,info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_internal_error_ info=psb_err_internal_error_
@ -194,14 +186,14 @@ subroutine mld_s_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,&
goto 9999 goto 9999
end if end if
else !!$ else
!!$
info = psb_err_iarg_neg_ !!$ info = psb_err_iarg_neg_
call psb_errpush(info,name,& !!$ call psb_errpush(info,name,&
& i_err=(/itwo,sweeps,izero,izero,izero/)) !!$ & i_err=(/itwo,sweeps,izero,izero,izero/))
goto 9999 !!$ goto 9999
!!$
endif !!$ endif
if (n_col <= size(work)) then if (n_col <= size(work)) then

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

@ -115,15 +115,7 @@ subroutine mld_s_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
end if end if
endif endif
!!$ if (sweeps == 0) then !!$ if ((.not.sm%sv%is_iterative()).and.((sweeps == 1).or.(sm%nnz_nd_tot==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
!!$ ! if .not.sv%is_iterative, there's no need to pass init !!$ ! if .not.sv%is_iterative, there's no need to pass init
!!$ call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,info) !!$ call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,info)
!!$ !!$
@ -146,16 +138,16 @@ subroutine mld_s_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
select case (init_) select case (init_)
case('Z') case('Z')
call tx%zero() call ty%zero()
case('Y') case('Y')
call psb_geaxpby(sone,y,szero,tx,desc_data,info) call psb_geaxpby(sone,y,szero,ty,desc_data,info)
case('U') case('U')
if (.not.present(initu)) then if (.not.present(initu)) then
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='missing initu to smoother_apply') & a_err='missing initu to smoother_apply')
goto 9999 goto 9999
end if end if
call psb_geaxpby(sone,initu,szero,tx,desc_data,info) call psb_geaxpby(sone,initu,szero,ty,desc_data,info)
case default case default
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='wrong init to smoother_apply') & a_err='wrong init to smoother_apply')
@ -168,17 +160,17 @@ subroutine mld_s_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
! block diagonal part and the remaining part of the local matrix ! block diagonal part and the remaining part of the local matrix
! and Y(j) is the approximate solution at sweep j. ! and Y(j) is the approximate solution at sweep j.
! !
call psb_geaxpby(sone,x,szero,ty,desc_data,info) call psb_geaxpby(sone,x,szero,tx,desc_data,info)
call psb_spmm(-sone,sm%nd,tx,sone,ty,desc_data,info,work=aux,trans=trans_) call psb_spmm(-sone,sm%nd,ty,sone,tx,desc_data,info,work=aux,trans=trans_)
if (info /= psb_success_) exit if (info /= psb_success_) exit
call sm%sv%apply(sone,ty,szero,tx,desc_data,trans_,aux,info,init='Y') call sm%sv%apply(sone,tx,szero,ty,desc_data,trans_,aux,info,init='Y')
if (info /= psb_success_) exit if (info /= psb_success_) exit
end do end do
if (info == psb_success_) call psb_geaxpby(alpha,tx,beta,y,desc_data,info) if (info == psb_success_) call psb_geaxpby(alpha,ty,beta,y,desc_data,info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_internal_error_ info=psb_err_internal_error_
@ -205,7 +197,6 @@ subroutine mld_s_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
!!$ !!$
!!$ endif !!$ endif
if (n_col <= size(work)) then if (n_col <= size(work)) then
if ((4*n_col+n_col) <= size(work)) then if ((4*n_col+n_col) <= size(work)) then
else else

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

@ -114,25 +114,17 @@ subroutine mld_z_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,&
end if end if
endif endif
if (sweeps == 0) then !!$ if ((.not.sm%sv%is_iterative()).and.((sweeps == 1).or.(sm%nnz_nd_tot==0))) then
!!$ ! if .not.sv%is_iterative, there's no need to pass init
! !!$ call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,info)
! K^0 = I !!$
! zero sweeps of any smoother is just the identity. !!$ if (info /= psb_success_) then
! !!$ call psb_errpush(psb_err_internal_error_,&
call psb_geaxpby(alpha,x,beta,y,desc_data,info) !!$ & name,a_err='Error in sub_aply Jacobi Sweeps = 1')
!!$ goto 9999
else if ((.not.sm%sv%is_iterative()).and.((sweeps == 1).or.(sm%nnz_nd_tot==0))) then !!$ endif
! if .not.sv%is_iterative, there's no need to pass init !!$
call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,info) !!$ else if (sweeps >= 1) then
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,&
& name,a_err='Error in sub_aply Jacobi Sweeps = 1')
goto 9999
endif
else if (sweeps >= 1) then
! !
! !
! Apply multiple sweeps of a block-Jacobi solver ! Apply multiple sweeps of a block-Jacobi solver
@ -145,16 +137,16 @@ subroutine mld_z_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,&
select case (init_) select case (init_)
case('Z') case('Z')
tx(:) = zzero ty(:) = zzero
case('Y') case('Y')
call psb_geaxpby(zone,y,zzero,tx,desc_data,info) call psb_geaxpby(zone,y,zzero,ty,desc_data,info)
case('U') case('U')
if (.not.present(initu)) then if (.not.present(initu)) then
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='missing initu to smoother_apply') & a_err='missing initu to smoother_apply')
goto 9999 goto 9999
end if end if
call psb_geaxpby(zone,initu,zzero,tx,desc_data,info) call psb_geaxpby(zone,initu,zzero,ty,desc_data,info)
case default case default
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='wrong init to smoother_apply') & a_err='wrong init to smoother_apply')
@ -167,17 +159,17 @@ subroutine mld_z_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,&
! block diagonal part and the remaining part of the local matrix ! block diagonal part and the remaining part of the local matrix
! and Y(j) is the approximate solution at sweep j. ! and Y(j) is the approximate solution at sweep j.
! !
call psb_geaxpby(zone,x,zzero,ty,desc_data,info) call psb_geaxpby(zone,x,zzero,tx,desc_data,info)
call psb_spmm(-zone,sm%nd,tx,zone,ty,desc_data,info,work=aux,trans=trans_) call psb_spmm(-zone,sm%nd,ty,zone,tx,desc_data,info,work=aux,trans=trans_)
if (info /= psb_success_) exit if (info /= psb_success_) exit
call sm%sv%apply(zone,ty,zzero,tx,desc_data,trans_,aux,info,init='Y') call sm%sv%apply(zone,tx,zzero,ty,desc_data,trans_,aux,info,init='Y')
if (info /= psb_success_) exit if (info /= psb_success_) exit
end do end do
if (info == psb_success_) call psb_geaxpby(alpha,tx,beta,y,desc_data,info) if (info == psb_success_) call psb_geaxpby(alpha,ty,beta,y,desc_data,info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_internal_error_ info=psb_err_internal_error_
@ -194,14 +186,14 @@ subroutine mld_z_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,&
goto 9999 goto 9999
end if end if
else !!$ else
!!$
info = psb_err_iarg_neg_ !!$ info = psb_err_iarg_neg_
call psb_errpush(info,name,& !!$ call psb_errpush(info,name,&
& i_err=(/itwo,sweeps,izero,izero,izero/)) !!$ & i_err=(/itwo,sweeps,izero,izero,izero/))
goto 9999 !!$ goto 9999
!!$
endif !!$ endif
if (n_col <= size(work)) then if (n_col <= size(work)) then

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

@ -115,15 +115,7 @@ subroutine mld_z_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
end if end if
endif endif
!!$ if (sweeps == 0) then !!$ if ((.not.sm%sv%is_iterative()).and.((sweeps == 1).or.(sm%nnz_nd_tot==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
!!$ ! if .not.sv%is_iterative, there's no need to pass init !!$ ! if .not.sv%is_iterative, there's no need to pass init
!!$ call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,info) !!$ call sm%sv%apply(alpha,x,beta,y,desc_data,trans_,aux,info)
!!$ !!$
@ -146,16 +138,16 @@ subroutine mld_z_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
select case (init_) select case (init_)
case('Z') case('Z')
call tx%zero() call ty%zero()
case('Y') case('Y')
call psb_geaxpby(zone,y,zzero,tx,desc_data,info) call psb_geaxpby(zone,y,zzero,ty,desc_data,info)
case('U') case('U')
if (.not.present(initu)) then if (.not.present(initu)) then
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='missing initu to smoother_apply') & a_err='missing initu to smoother_apply')
goto 9999 goto 9999
end if end if
call psb_geaxpby(zone,initu,zzero,tx,desc_data,info) call psb_geaxpby(zone,initu,zzero,ty,desc_data,info)
case default case default
call psb_errpush(psb_err_internal_error_,name,& call psb_errpush(psb_err_internal_error_,name,&
& a_err='wrong init to smoother_apply') & a_err='wrong init to smoother_apply')
@ -168,17 +160,17 @@ subroutine mld_z_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
! block diagonal part and the remaining part of the local matrix ! block diagonal part and the remaining part of the local matrix
! and Y(j) is the approximate solution at sweep j. ! and Y(j) is the approximate solution at sweep j.
! !
call psb_geaxpby(zone,x,zzero,ty,desc_data,info) call psb_geaxpby(zone,x,zzero,tx,desc_data,info)
call psb_spmm(-zone,sm%nd,tx,zone,ty,desc_data,info,work=aux,trans=trans_) call psb_spmm(-zone,sm%nd,ty,zone,tx,desc_data,info,work=aux,trans=trans_)
if (info /= psb_success_) exit if (info /= psb_success_) exit
call sm%sv%apply(zone,ty,zzero,tx,desc_data,trans_,aux,info,init='Y') call sm%sv%apply(zone,tx,zzero,ty,desc_data,trans_,aux,info,init='Y')
if (info /= psb_success_) exit if (info /= psb_success_) exit
end do end do
if (info == psb_success_) call psb_geaxpby(alpha,tx,beta,y,desc_data,info) if (info == psb_success_) call psb_geaxpby(alpha,ty,beta,y,desc_data,info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_internal_error_ info=psb_err_internal_error_
@ -205,7 +197,6 @@ subroutine mld_z_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
!!$ !!$
!!$ endif !!$ endif
if (n_col <= size(work)) then if (n_col <= size(work)) then
if ((4*n_col+n_col) <= size(work)) then if ((4*n_col+n_col) <= size(work)) then
else else

Write Preview
Loading…
Cancel
Save