mirror of
https://github.com/sfilippone/amg4psblas.git
synced 2026-10-06 22:55:12 +00:00
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
This commit is contained in:
Salvatore Filippone
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user