From 0daf3db1f1862af9cec4ad6f6f8859f657ceb3d3 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Tue, 12 Jul 2016 09:58:12 +0000 Subject: [PATCH] mld2p4-2 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 --- .../smoother/mld_c_jac_smoother_apply.f90 | 60 ++++++++----------- .../mld_c_jac_smoother_apply_vect.f90 | 25 +++----- .../smoother/mld_d_jac_smoother_apply.f90 | 60 ++++++++----------- .../mld_d_jac_smoother_apply_vect.f90 | 25 +++----- .../smoother/mld_s_jac_smoother_apply.f90 | 60 ++++++++----------- .../mld_s_jac_smoother_apply_vect.f90 | 25 +++----- .../smoother/mld_z_jac_smoother_apply.f90 | 60 ++++++++----------- .../mld_z_jac_smoother_apply_vect.f90 | 25 +++----- 8 files changed, 136 insertions(+), 204 deletions(-) diff --git a/mlprec/impl/smoother/mld_c_jac_smoother_apply.f90 b/mlprec/impl/smoother/mld_c_jac_smoother_apply.f90 index 91290dc8..3d842f29 100644 --- a/mlprec/impl/smoother/mld_c_jac_smoother_apply.f90 +++ b/mlprec/impl/smoother/mld_c_jac_smoother_apply.f90 @@ -114,25 +114,17 @@ subroutine mld_c_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,& end if endif - 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 - ! 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) - - 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 +!!$ 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) +!!$ +!!$ 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 @@ -145,16 +137,16 @@ subroutine mld_c_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,& select case (init_) case('Z') - tx(:) = czero + ty(:) = czero case('Y') - call psb_geaxpby(cone,y,czero,tx,desc_data,info) + call psb_geaxpby(cone,y,czero,ty,desc_data,info) case('U') if (.not.present(initu)) then call psb_errpush(psb_err_internal_error_,name,& & a_err='missing initu to smoother_apply') goto 9999 end if - call psb_geaxpby(cone,initu,czero,tx,desc_data,info) + call psb_geaxpby(cone,initu,czero,ty,desc_data,info) case default call psb_errpush(psb_err_internal_error_,name,& & 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 ! and Y(j) is the approximate solution at sweep j. ! - call psb_geaxpby(cone,x,czero,ty,desc_data,info) - call psb_spmm(-cone,sm%nd,tx,cone,ty,desc_data,info,work=aux,trans=trans_) + call psb_geaxpby(cone,x,czero,tx,desc_data,info) + call psb_spmm(-cone,sm%nd,ty,cone,tx,desc_data,info,work=aux,trans=trans_) 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 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 info=psb_err_internal_error_ @@ -194,14 +186,14 @@ subroutine mld_c_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,& goto 9999 end if - else - - info = psb_err_iarg_neg_ - call psb_errpush(info,name,& - & i_err=(/itwo,sweeps,izero,izero,izero/)) - goto 9999 - - endif +!!$ else +!!$ +!!$ info = psb_err_iarg_neg_ +!!$ call psb_errpush(info,name,& +!!$ & i_err=(/itwo,sweeps,izero,izero,izero/)) +!!$ goto 9999 +!!$ +!!$ endif if (n_col <= size(work)) then 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 4f3ebe5f..20004c72 100644 --- a/mlprec/impl/smoother/mld_c_jac_smoother_apply_vect.f90 +++ b/mlprec/impl/smoother/mld_c_jac_smoother_apply_vect.f90 @@ -115,15 +115,7 @@ subroutine mld_c_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& end if endif -!!$ 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 +!!$ 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) !!$ @@ -146,16 +138,16 @@ subroutine mld_c_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& select case (init_) case('Z') - call tx%zero() + call ty%zero() case('Y') - call psb_geaxpby(cone,y,czero,tx,desc_data,info) + call psb_geaxpby(cone,y,czero,ty,desc_data,info) case('U') if (.not.present(initu)) then call psb_errpush(psb_err_internal_error_,name,& & a_err='missing initu to smoother_apply') goto 9999 end if - call psb_geaxpby(cone,initu,czero,tx,desc_data,info) + call psb_geaxpby(cone,initu,czero,ty,desc_data,info) case default call psb_errpush(psb_err_internal_error_,name,& & 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 ! and Y(j) is the approximate solution at sweep j. ! - call psb_geaxpby(cone,x,czero,ty,desc_data,info) - call psb_spmm(-cone,sm%nd,tx,cone,ty,desc_data,info,work=aux,trans=trans_) + call psb_geaxpby(cone,x,czero,tx,desc_data,info) + call psb_spmm(-cone,sm%nd,ty,cone,tx,desc_data,info,work=aux,trans=trans_) 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 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 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 - if (n_col <= size(work)) then if ((4*n_col+n_col) <= size(work)) then else diff --git a/mlprec/impl/smoother/mld_d_jac_smoother_apply.f90 b/mlprec/impl/smoother/mld_d_jac_smoother_apply.f90 index 3067c90a..2d4cbd4a 100644 --- a/mlprec/impl/smoother/mld_d_jac_smoother_apply.f90 +++ b/mlprec/impl/smoother/mld_d_jac_smoother_apply.f90 @@ -114,25 +114,17 @@ subroutine mld_d_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,& end if endif - 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 - ! 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) - - 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 +!!$ 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) +!!$ +!!$ 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 @@ -145,16 +137,16 @@ subroutine mld_d_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,& select case (init_) case('Z') - tx(:) = dzero + ty(:) = dzero case('Y') - call psb_geaxpby(done,y,dzero,tx,desc_data,info) + call psb_geaxpby(done,y,dzero,ty,desc_data,info) case('U') if (.not.present(initu)) then call psb_errpush(psb_err_internal_error_,name,& & a_err='missing initu to smoother_apply') goto 9999 end if - call psb_geaxpby(done,initu,dzero,tx,desc_data,info) + call psb_geaxpby(done,initu,dzero,ty,desc_data,info) case default call psb_errpush(psb_err_internal_error_,name,& & 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 ! and Y(j) is the approximate solution at sweep j. ! - call psb_geaxpby(done,x,dzero,ty,desc_data,info) - call psb_spmm(-done,sm%nd,tx,done,ty,desc_data,info,work=aux,trans=trans_) + call psb_geaxpby(done,x,dzero,tx,desc_data,info) + call psb_spmm(-done,sm%nd,ty,done,tx,desc_data,info,work=aux,trans=trans_) 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 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 info=psb_err_internal_error_ @@ -194,14 +186,14 @@ subroutine mld_d_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,& goto 9999 end if - else - - info = psb_err_iarg_neg_ - call psb_errpush(info,name,& - & i_err=(/itwo,sweeps,izero,izero,izero/)) - goto 9999 - - endif +!!$ else +!!$ +!!$ info = psb_err_iarg_neg_ +!!$ call psb_errpush(info,name,& +!!$ & i_err=(/itwo,sweeps,izero,izero,izero/)) +!!$ goto 9999 +!!$ +!!$ endif if (n_col <= size(work)) then 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 31fb6263..469e9c7d 100644 --- a/mlprec/impl/smoother/mld_d_jac_smoother_apply_vect.f90 +++ b/mlprec/impl/smoother/mld_d_jac_smoother_apply_vect.f90 @@ -115,15 +115,7 @@ subroutine mld_d_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& end if endif -!!$ 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 +!!$ 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) !!$ @@ -146,16 +138,16 @@ subroutine mld_d_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& select case (init_) case('Z') - call tx%zero() + call ty%zero() case('Y') - call psb_geaxpby(done,y,dzero,tx,desc_data,info) + call psb_geaxpby(done,y,dzero,ty,desc_data,info) case('U') if (.not.present(initu)) then call psb_errpush(psb_err_internal_error_,name,& & a_err='missing initu to smoother_apply') goto 9999 end if - call psb_geaxpby(done,initu,dzero,tx,desc_data,info) + call psb_geaxpby(done,initu,dzero,ty,desc_data,info) case default call psb_errpush(psb_err_internal_error_,name,& & 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 ! and Y(j) is the approximate solution at sweep j. ! - call psb_geaxpby(done,x,dzero,ty,desc_data,info) - call psb_spmm(-done,sm%nd,tx,done,ty,desc_data,info,work=aux,trans=trans_) + call psb_geaxpby(done,x,dzero,tx,desc_data,info) + call psb_spmm(-done,sm%nd,ty,done,tx,desc_data,info,work=aux,trans=trans_) 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 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 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 - if (n_col <= size(work)) then if ((4*n_col+n_col) <= size(work)) then else diff --git a/mlprec/impl/smoother/mld_s_jac_smoother_apply.f90 b/mlprec/impl/smoother/mld_s_jac_smoother_apply.f90 index 1682eb30..3f2f10e8 100644 --- a/mlprec/impl/smoother/mld_s_jac_smoother_apply.f90 +++ b/mlprec/impl/smoother/mld_s_jac_smoother_apply.f90 @@ -114,25 +114,17 @@ subroutine mld_s_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,& end if endif - 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 - ! 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) - - 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 +!!$ 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) +!!$ +!!$ 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 @@ -145,16 +137,16 @@ subroutine mld_s_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,& select case (init_) case('Z') - tx(:) = szero + ty(:) = szero case('Y') - call psb_geaxpby(sone,y,szero,tx,desc_data,info) + call psb_geaxpby(sone,y,szero,ty,desc_data,info) case('U') if (.not.present(initu)) then call psb_errpush(psb_err_internal_error_,name,& & a_err='missing initu to smoother_apply') goto 9999 end if - call psb_geaxpby(sone,initu,szero,tx,desc_data,info) + call psb_geaxpby(sone,initu,szero,ty,desc_data,info) case default call psb_errpush(psb_err_internal_error_,name,& & 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 ! and Y(j) is the approximate solution at sweep j. ! - call psb_geaxpby(sone,x,szero,ty,desc_data,info) - call psb_spmm(-sone,sm%nd,tx,sone,ty,desc_data,info,work=aux,trans=trans_) + call psb_geaxpby(sone,x,szero,tx,desc_data,info) + call psb_spmm(-sone,sm%nd,ty,sone,tx,desc_data,info,work=aux,trans=trans_) 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 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 info=psb_err_internal_error_ @@ -194,14 +186,14 @@ subroutine mld_s_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,& goto 9999 end if - else - - info = psb_err_iarg_neg_ - call psb_errpush(info,name,& - & i_err=(/itwo,sweeps,izero,izero,izero/)) - goto 9999 - - endif +!!$ else +!!$ +!!$ info = psb_err_iarg_neg_ +!!$ call psb_errpush(info,name,& +!!$ & i_err=(/itwo,sweeps,izero,izero,izero/)) +!!$ goto 9999 +!!$ +!!$ endif if (n_col <= size(work)) then 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 a0f1a3b6..53e0006c 100644 --- a/mlprec/impl/smoother/mld_s_jac_smoother_apply_vect.f90 +++ b/mlprec/impl/smoother/mld_s_jac_smoother_apply_vect.f90 @@ -115,15 +115,7 @@ subroutine mld_s_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& end if endif -!!$ 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 +!!$ 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) !!$ @@ -146,16 +138,16 @@ subroutine mld_s_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& select case (init_) case('Z') - call tx%zero() + call ty%zero() case('Y') - call psb_geaxpby(sone,y,szero,tx,desc_data,info) + call psb_geaxpby(sone,y,szero,ty,desc_data,info) case('U') if (.not.present(initu)) then call psb_errpush(psb_err_internal_error_,name,& & a_err='missing initu to smoother_apply') goto 9999 end if - call psb_geaxpby(sone,initu,szero,tx,desc_data,info) + call psb_geaxpby(sone,initu,szero,ty,desc_data,info) case default call psb_errpush(psb_err_internal_error_,name,& & 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 ! and Y(j) is the approximate solution at sweep j. ! - call psb_geaxpby(sone,x,szero,ty,desc_data,info) - call psb_spmm(-sone,sm%nd,tx,sone,ty,desc_data,info,work=aux,trans=trans_) + call psb_geaxpby(sone,x,szero,tx,desc_data,info) + call psb_spmm(-sone,sm%nd,ty,sone,tx,desc_data,info,work=aux,trans=trans_) 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 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 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 - if (n_col <= size(work)) then if ((4*n_col+n_col) <= size(work)) then else diff --git a/mlprec/impl/smoother/mld_z_jac_smoother_apply.f90 b/mlprec/impl/smoother/mld_z_jac_smoother_apply.f90 index a5231534..7204e2c0 100644 --- a/mlprec/impl/smoother/mld_z_jac_smoother_apply.f90 +++ b/mlprec/impl/smoother/mld_z_jac_smoother_apply.f90 @@ -114,25 +114,17 @@ subroutine mld_z_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,& end if endif - 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 - ! 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) - - 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 +!!$ 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) +!!$ +!!$ 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 @@ -145,16 +137,16 @@ subroutine mld_z_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,& select case (init_) case('Z') - tx(:) = zzero + ty(:) = zzero case('Y') - call psb_geaxpby(zone,y,zzero,tx,desc_data,info) + call psb_geaxpby(zone,y,zzero,ty,desc_data,info) case('U') if (.not.present(initu)) then call psb_errpush(psb_err_internal_error_,name,& & a_err='missing initu to smoother_apply') goto 9999 end if - call psb_geaxpby(zone,initu,zzero,tx,desc_data,info) + call psb_geaxpby(zone,initu,zzero,ty,desc_data,info) case default call psb_errpush(psb_err_internal_error_,name,& & 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 ! and Y(j) is the approximate solution at sweep j. ! - call psb_geaxpby(zone,x,zzero,ty,desc_data,info) - call psb_spmm(-zone,sm%nd,tx,zone,ty,desc_data,info,work=aux,trans=trans_) + call psb_geaxpby(zone,x,zzero,tx,desc_data,info) + call psb_spmm(-zone,sm%nd,ty,zone,tx,desc_data,info,work=aux,trans=trans_) 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 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 info=psb_err_internal_error_ @@ -194,14 +186,14 @@ subroutine mld_z_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,& goto 9999 end if - else - - info = psb_err_iarg_neg_ - call psb_errpush(info,name,& - & i_err=(/itwo,sweeps,izero,izero,izero/)) - goto 9999 - - endif +!!$ else +!!$ +!!$ info = psb_err_iarg_neg_ +!!$ call psb_errpush(info,name,& +!!$ & i_err=(/itwo,sweeps,izero,izero,izero/)) +!!$ goto 9999 +!!$ +!!$ endif if (n_col <= size(work)) then 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 25284030..ca12723c 100644 --- a/mlprec/impl/smoother/mld_z_jac_smoother_apply_vect.f90 +++ b/mlprec/impl/smoother/mld_z_jac_smoother_apply_vect.f90 @@ -115,15 +115,7 @@ subroutine mld_z_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& end if endif -!!$ 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 +!!$ 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) !!$ @@ -146,16 +138,16 @@ subroutine mld_z_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& select case (init_) case('Z') - call tx%zero() + call ty%zero() case('Y') - call psb_geaxpby(zone,y,zzero,tx,desc_data,info) + call psb_geaxpby(zone,y,zzero,ty,desc_data,info) case('U') if (.not.present(initu)) then call psb_errpush(psb_err_internal_error_,name,& & a_err='missing initu to smoother_apply') goto 9999 end if - call psb_geaxpby(zone,initu,zzero,tx,desc_data,info) + call psb_geaxpby(zone,initu,zzero,ty,desc_data,info) case default call psb_errpush(psb_err_internal_error_,name,& & 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 ! and Y(j) is the approximate solution at sweep j. ! - call psb_geaxpby(zone,x,zzero,ty,desc_data,info) - call psb_spmm(-zone,sm%nd,tx,zone,ty,desc_data,info,work=aux,trans=trans_) + call psb_geaxpby(zone,x,zzero,tx,desc_data,info) + call psb_spmm(-zone,sm%nd,ty,zone,tx,desc_data,info,work=aux,trans=trans_) 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 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 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 - if (n_col <= size(work)) then if ((4*n_col+n_col) <= size(work)) then else