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_d_jac_smoother_bld.f90
    mlprec/impl/smoother/mld_c_jac_smoother_apply.f90
    mlprec/impl/smoother/mld_s_jac_smoother_apply.f90
    mlprec/impl/smoother/mld_c_jac_smoother_apply_vect.f90
    mlprec/impl/smoother/mld_d_jac_smoother_apply_vect.f90
    mlprec/impl/smoother/mld_s_jac_smoother_apply_vect.f90
    mlprec/impl/smoother/mld_z_jac_smoother_apply_vect.f90
    mlprec/impl/smoother/mld_z_jac_smoother_apply.f90
    mlprec/impl/smoother/mld_z_jac_smoother_bld.f90
    mlprec/impl/smoother/mld_c_jac_smoother_bld.f90
    mlprec/impl/smoother/mld_s_jac_smoother_bld.f90
    mlprec/impl/smoother/mld_d_jac_smoother_apply.f90

Finish fix smoothers for long integers.
stopcriterion
Salvatore Filippone 12 years ago
parent db061fe5e1
commit bb63339295
12 changed files with 172 additions and 132 deletions
Show Stats Download Patch File Download Diff File

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

@ -46,14 +46,14 @@ subroutine mld_c_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,wor
complex(psb_spk_),intent(inout) :: x(:)
complex(psb_spk_),intent(inout) :: y(:)
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps
character(len=1),intent(in) :: trans
integer(psb_ipk_), intent(in) :: sweeps
complex(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
integer :: n_row,n_col
integer(psb_ipk_) :: n_row,n_col
complex(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer :: ictxt,np,me,i, err_act
integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_
character(len=20) :: name='c_jac_smoother_apply'
@ -87,7 +87,8 @@ subroutine mld_c_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,wor
allocate(aux(4*n_col),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/4*n_col,0,0,0,0/),&
call psb_errpush(info,name,&
& i_err=(/4*n_col,izero,izero,izero,izero/),&
& a_err='complex(psb_spk_)')
goto 9999
end if
@ -96,7 +97,8 @@ subroutine mld_c_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,wor
allocate(ww(n_col),aux(4*n_col),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/5*n_col,0,0,0,0/),&
call psb_errpush(info,name,&
& i_err=(/5*n_col,izero,izero,izero,izero/),&
& a_err='complex(psb_spk_)')
goto 9999
end if
@ -123,7 +125,8 @@ subroutine mld_c_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,wor
allocate(tx(n_col),ty(n_col),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/2*n_col,0,0,0,0/),&
call psb_errpush(info,name,&
& i_err=(/2*n_col,izero,izero,izero,izero/),&
& a_err='complex(psb_spk_)')
goto 9999
end if
@ -137,7 +140,8 @@ subroutine mld_c_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,wor
! and Y(j) is the approximate solution at sweep j.
!
ty(1:n_row) = x(1:n_row)
call psb_spmm(-cone,sm%nd,tx,cone,ty,desc_data,info,work=aux,trans=trans_)
call psb_spmm(-cone,sm%nd,tx,cone,ty,desc_data,info,&
& work=aux,trans=trans_)
if (info /= psb_success_) exit
@ -150,14 +154,16 @@ subroutine mld_c_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,wor
if (info /= psb_success_) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='subsolve with Jacobi sweeps > 1')
call psb_errpush(info,name,&
& a_err='subsolve with Jacobi sweeps > 1')
goto 9999
end if
deallocate(tx,ty,stat=info)
if (info /= psb_success_) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='final cleanup with Jacobi sweeps > 1')
call psb_errpush(info,name,&
& a_err='final cleanup with Jacobi sweeps > 1')
goto 9999
end if
@ -165,7 +171,7 @@ subroutine mld_c_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,wor
info = psb_err_iarg_neg_
call psb_errpush(info,name,&
& i_err=(/2,sweeps,0,0,0/))
& i_err=(/itwo,sweeps,izero,izero,izero/))
goto 9999
endif

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

@ -36,25 +36,26 @@
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
subroutine mld_c_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info)
subroutine mld_c_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
& sweeps,work,info)
use psb_base_mod
use mld_c_jac_smoother, mld_protect_name => mld_c_jac_smoother_apply_vect
implicit none
type(psb_desc_type), intent(in) :: desc_data
type(psb_desc_type), intent(in) :: desc_data
class(mld_c_jac_smoother_type), intent(inout) :: sm
type(psb_c_vect_type),intent(inout) :: x
type(psb_c_vect_type),intent(inout) :: y
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps
complex(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer(psb_ipk_), intent(in) :: sweeps
complex(psb_spk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
integer :: n_row,n_col
integer(psb_ipk_) :: n_row,n_col
type(psb_c_vect_type) :: tx, ty
complex(psb_spk_), pointer :: ww(:), aux(:)
integer :: ictxt,np,me,i, err_act
integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_
character(len=20) :: name='c_jac_smoother_apply'
@ -89,7 +90,8 @@ subroutine mld_c_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweep
allocate(aux(4*n_col),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/4*n_col,0,0,0,0/),&
call psb_errpush(info,name,&
& i_err=(/4*n_col,izero,izero,izero,izero/),&
& a_err='complex(psb_spk_)')
goto 9999
end if
@ -98,7 +100,8 @@ subroutine mld_c_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweep
allocate(ww(n_col),aux(4*n_col),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/5*n_col,0,0,0,0/),&
call psb_errpush(info,name,&
& i_err=(/5*n_col,izero,izero,izero,izero/),&
& a_err='complex(psb_spk_)')
goto 9999
end if
@ -146,7 +149,8 @@ subroutine mld_c_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweep
if (info /= psb_success_) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='subsolve with Jacobi sweeps > 1')
call psb_errpush(info,name,&
& a_err='subsolve with Jacobi sweeps > 1')
goto 9999
end if
@ -154,7 +158,8 @@ subroutine mld_c_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweep
if (info == psb_success_) call ty%free(info)
if (info /= psb_success_) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='final cleanup with Jacobi sweeps > 1')
call psb_errpush(info,name,&
& a_err='final cleanup with Jacobi sweeps > 1')
goto 9999
end if
@ -162,7 +167,7 @@ subroutine mld_c_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweep
info = psb_err_iarg_neg_
call psb_errpush(info,name,&
& i_err=(/2,sweeps,0,0,0/))
& i_err=(/itwo,sweeps,izero,izero,izero/))
goto 9999
endif

13
mlprec/impl/smoother/mld_c_jac_smoother_bld.f90
Unescape Escape View File

@ -37,7 +37,6 @@
!!$
!!$
subroutine mld_c_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold)
use psb_base_mod
use mld_c_diag_solver
@ -46,17 +45,17 @@ subroutine mld_c_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold)
! Arguments
type(psb_cspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_c_jac_smoother_type), intent(inout) :: sm
character, intent(in) :: upd
integer, intent(out) :: info
character, intent(in) :: upd
integer(psb_ipk_), intent(out) :: info
class(psb_c_base_sparse_mat), intent(in), optional :: amold
class(psb_c_base_vect_type), intent(in), optional :: vmold
! Local variables
integer :: n_row,n_col, nrow_a, nztota, nzeros
integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nzeros
complex(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='c_jac_smoother_bld', ch_err
integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='c_jac_smoother_bld', ch_err
info=psb_success_
call psb_erractionsave(err_act)

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

@ -46,14 +46,14 @@ subroutine mld_d_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,wor
real(psb_dpk_),intent(inout) :: x(:)
real(psb_dpk_),intent(inout) :: y(:)
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps
character(len=1),intent(in) :: trans
integer(psb_ipk_), intent(in) :: sweeps
real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
integer :: n_row,n_col
integer(psb_ipk_) :: n_row,n_col
real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer :: ictxt,np,me,i, err_act
integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_
character(len=20) :: name='d_jac_smoother_apply'
@ -87,7 +87,8 @@ subroutine mld_d_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,wor
allocate(aux(4*n_col),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/4*n_col,0,0,0,0/),&
call psb_errpush(info,name,&
& i_err=(/4*n_col,izero,izero,izero,izero/),&
& a_err='real(psb_dpk_)')
goto 9999
end if
@ -96,7 +97,8 @@ subroutine mld_d_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,wor
allocate(ww(n_col),aux(4*n_col),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/5*n_col,0,0,0,0/),&
call psb_errpush(info,name,&
& i_err=(/5*n_col,izero,izero,izero,izero/),&
& a_err='real(psb_dpk_)')
goto 9999
end if
@ -123,7 +125,8 @@ subroutine mld_d_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,wor
allocate(tx(n_col),ty(n_col),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/2*n_col,0,0,0,0/),&
call psb_errpush(info,name,&
& i_err=(/2*n_col,izero,izero,izero,izero/),&
& a_err='real(psb_dpk_)')
goto 9999
end if
@ -137,7 +140,8 @@ subroutine mld_d_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,wor
! and Y(j) is the approximate solution at sweep j.
!
ty(1:n_row) = x(1:n_row)
call psb_spmm(-done,sm%nd,tx,done,ty,desc_data,info,work=aux,trans=trans_)
call psb_spmm(-done,sm%nd,tx,done,ty,desc_data,info,&
& work=aux,trans=trans_)
if (info /= psb_success_) exit
@ -150,14 +154,16 @@ subroutine mld_d_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,wor
if (info /= psb_success_) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='subsolve with Jacobi sweeps > 1')
call psb_errpush(info,name,&
& a_err='subsolve with Jacobi sweeps > 1')
goto 9999
end if
deallocate(tx,ty,stat=info)
if (info /= psb_success_) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='final cleanup with Jacobi sweeps > 1')
call psb_errpush(info,name,&
& a_err='final cleanup with Jacobi sweeps > 1')
goto 9999
end if
@ -165,7 +171,7 @@ subroutine mld_d_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,wor
info = psb_err_iarg_neg_
call psb_errpush(info,name,&
& i_err=(/2,sweeps,0,0,0/))
& i_err=(/itwo,sweeps,izero,izero,izero/))
goto 9999
endif

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

@ -36,25 +36,26 @@
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
subroutine mld_d_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info)
subroutine mld_d_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
& sweeps,work,info)
use psb_base_mod
use mld_d_jac_smoother, mld_protect_name => mld_d_jac_smoother_apply_vect
implicit none
type(psb_desc_type), intent(in) :: desc_data
type(psb_desc_type), intent(in) :: desc_data
class(mld_d_jac_smoother_type), intent(inout) :: sm
type(psb_d_vect_type),intent(inout) :: x
type(psb_d_vect_type),intent(inout) :: y
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps
real(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer(psb_ipk_), intent(in) :: sweeps
real(psb_dpk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
integer :: n_row,n_col
integer(psb_ipk_) :: n_row,n_col
type(psb_d_vect_type) :: tx, ty
real(psb_dpk_), pointer :: ww(:), aux(:)
integer :: ictxt,np,me,i, err_act
integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_
character(len=20) :: name='d_jac_smoother_apply'
@ -89,7 +90,8 @@ subroutine mld_d_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweep
allocate(aux(4*n_col),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/4*n_col,0,0,0,0/),&
call psb_errpush(info,name,&
& i_err=(/4*n_col,izero,izero,izero,izero/),&
& a_err='real(psb_dpk_)')
goto 9999
end if
@ -98,7 +100,8 @@ subroutine mld_d_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweep
allocate(ww(n_col),aux(4*n_col),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/5*n_col,0,0,0,0/),&
call psb_errpush(info,name,&
& i_err=(/5*n_col,izero,izero,izero,izero/),&
& a_err='real(psb_dpk_)')
goto 9999
end if
@ -146,7 +149,8 @@ subroutine mld_d_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweep
if (info /= psb_success_) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='subsolve with Jacobi sweeps > 1')
call psb_errpush(info,name,&
& a_err='subsolve with Jacobi sweeps > 1')
goto 9999
end if
@ -154,7 +158,8 @@ subroutine mld_d_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweep
if (info == psb_success_) call ty%free(info)
if (info /= psb_success_) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='final cleanup with Jacobi sweeps > 1')
call psb_errpush(info,name,&
& a_err='final cleanup with Jacobi sweeps > 1')
goto 9999
end if
@ -162,7 +167,7 @@ subroutine mld_d_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweep
info = psb_err_iarg_neg_
call psb_errpush(info,name,&
& i_err=(/2,sweeps,0,0,0/))
& i_err=(/itwo,sweeps,izero,izero,izero/))
goto 9999
endif

13
mlprec/impl/smoother/mld_d_jac_smoother_bld.f90
Unescape Escape View File

@ -37,7 +37,6 @@
!!$
!!$
subroutine mld_d_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold)
use psb_base_mod
use mld_d_diag_solver
@ -46,17 +45,17 @@ subroutine mld_d_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold)
! Arguments
type(psb_dspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_d_jac_smoother_type), intent(inout) :: sm
character, intent(in) :: upd
integer, intent(out) :: info
character, intent(in) :: upd
integer(psb_ipk_), intent(out) :: info
class(psb_d_base_sparse_mat), intent(in), optional :: amold
class(psb_d_base_vect_type), intent(in), optional :: vmold
! Local variables
integer :: n_row,n_col, nrow_a, nztota, nzeros
integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nzeros
real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='d_jac_smoother_bld', ch_err
integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='d_jac_smoother_bld', ch_err
info=psb_success_
call psb_erractionsave(err_act)

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

@ -46,14 +46,14 @@ subroutine mld_s_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,wor
real(psb_spk_),intent(inout) :: x(:)
real(psb_spk_),intent(inout) :: y(:)
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps
character(len=1),intent(in) :: trans
integer(psb_ipk_), intent(in) :: sweeps
real(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
integer :: n_row,n_col
integer(psb_ipk_) :: n_row,n_col
real(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer :: ictxt,np,me,i, err_act
integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_
character(len=20) :: name='s_jac_smoother_apply'
@ -87,7 +87,8 @@ subroutine mld_s_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,wor
allocate(aux(4*n_col),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/4*n_col,0,0,0,0/),&
call psb_errpush(info,name,&
& i_err=(/4*n_col,izero,izero,izero,izero/),&
& a_err='real(psb_spk_)')
goto 9999
end if
@ -96,7 +97,8 @@ subroutine mld_s_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,wor
allocate(ww(n_col),aux(4*n_col),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/5*n_col,0,0,0,0/),&
call psb_errpush(info,name,&
& i_err=(/5*n_col,izero,izero,izero,izero/),&
& a_err='real(psb_spk_)')
goto 9999
end if
@ -123,7 +125,8 @@ subroutine mld_s_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,wor
allocate(tx(n_col),ty(n_col),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/2*n_col,0,0,0,0/),&
call psb_errpush(info,name,&
& i_err=(/2*n_col,izero,izero,izero,izero/),&
& a_err='real(psb_spk_)')
goto 9999
end if
@ -137,7 +140,8 @@ subroutine mld_s_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,wor
! and Y(j) is the approximate solution at sweep j.
!
ty(1:n_row) = x(1:n_row)
call psb_spmm(-sone,sm%nd,tx,sone,ty,desc_data,info,work=aux,trans=trans_)
call psb_spmm(-sone,sm%nd,tx,sone,ty,desc_data,info,&
& work=aux,trans=trans_)
if (info /= psb_success_) exit
@ -150,14 +154,16 @@ subroutine mld_s_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,wor
if (info /= psb_success_) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='subsolve with Jacobi sweeps > 1')
call psb_errpush(info,name,&
& a_err='subsolve with Jacobi sweeps > 1')
goto 9999
end if
deallocate(tx,ty,stat=info)
if (info /= psb_success_) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='final cleanup with Jacobi sweeps > 1')
call psb_errpush(info,name,&
& a_err='final cleanup with Jacobi sweeps > 1')
goto 9999
end if
@ -165,7 +171,7 @@ subroutine mld_s_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,wor
info = psb_err_iarg_neg_
call psb_errpush(info,name,&
& i_err=(/2,sweeps,0,0,0/))
& i_err=(/itwo,sweeps,izero,izero,izero/))
goto 9999
endif

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

@ -36,25 +36,26 @@
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
subroutine mld_s_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info)
subroutine mld_s_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
& sweeps,work,info)
use psb_base_mod
use mld_s_jac_smoother, mld_protect_name => mld_s_jac_smoother_apply_vect
implicit none
type(psb_desc_type), intent(in) :: desc_data
type(psb_desc_type), intent(in) :: desc_data
class(mld_s_jac_smoother_type), intent(inout) :: sm
type(psb_s_vect_type),intent(inout) :: x
type(psb_s_vect_type),intent(inout) :: y
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps
real(psb_spk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer(psb_ipk_), intent(in) :: sweeps
real(psb_spk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
integer :: n_row,n_col
integer(psb_ipk_) :: n_row,n_col
type(psb_s_vect_type) :: tx, ty
real(psb_spk_), pointer :: ww(:), aux(:)
integer :: ictxt,np,me,i, err_act
integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_
character(len=20) :: name='s_jac_smoother_apply'
@ -89,7 +90,8 @@ subroutine mld_s_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweep
allocate(aux(4*n_col),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/4*n_col,0,0,0,0/),&
call psb_errpush(info,name,&
& i_err=(/4*n_col,izero,izero,izero,izero/),&
& a_err='real(psb_spk_)')
goto 9999
end if
@ -98,7 +100,8 @@ subroutine mld_s_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweep
allocate(ww(n_col),aux(4*n_col),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/5*n_col,0,0,0,0/),&
call psb_errpush(info,name,&
& i_err=(/5*n_col,izero,izero,izero,izero/),&
& a_err='real(psb_spk_)')
goto 9999
end if
@ -146,7 +149,8 @@ subroutine mld_s_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweep
if (info /= psb_success_) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='subsolve with Jacobi sweeps > 1')
call psb_errpush(info,name,&
& a_err='subsolve with Jacobi sweeps > 1')
goto 9999
end if
@ -154,7 +158,8 @@ subroutine mld_s_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweep
if (info == psb_success_) call ty%free(info)
if (info /= psb_success_) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='final cleanup with Jacobi sweeps > 1')
call psb_errpush(info,name,&
& a_err='final cleanup with Jacobi sweeps > 1')
goto 9999
end if
@ -162,7 +167,7 @@ subroutine mld_s_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweep
info = psb_err_iarg_neg_
call psb_errpush(info,name,&
& i_err=(/2,sweeps,0,0,0/))
& i_err=(/itwo,sweeps,izero,izero,izero/))
goto 9999
endif

13
mlprec/impl/smoother/mld_s_jac_smoother_bld.f90
Unescape Escape View File

@ -37,7 +37,6 @@
!!$
!!$
subroutine mld_s_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold)
use psb_base_mod
use mld_s_diag_solver
@ -46,17 +45,17 @@ subroutine mld_s_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold)
! Arguments
type(psb_sspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_s_jac_smoother_type), intent(inout) :: sm
character, intent(in) :: upd
integer, intent(out) :: info
character, intent(in) :: upd
integer(psb_ipk_), intent(out) :: info
class(psb_s_base_sparse_mat), intent(in), optional :: amold
class(psb_s_base_vect_type), intent(in), optional :: vmold
! Local variables
integer :: n_row,n_col, nrow_a, nztota, nzeros
integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nzeros
real(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='s_jac_smoother_bld', ch_err
integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='s_jac_smoother_bld', ch_err
info=psb_success_
call psb_erractionsave(err_act)

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

@ -46,14 +46,14 @@ subroutine mld_z_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,wor
complex(psb_dpk_),intent(inout) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:)
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps
character(len=1),intent(in) :: trans
integer(psb_ipk_), intent(in) :: sweeps
complex(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
integer(psb_ipk_), intent(out) :: info
integer :: n_row,n_col
integer(psb_ipk_) :: n_row,n_col
complex(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer :: ictxt,np,me,i, err_act
integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_
character(len=20) :: name='z_jac_smoother_apply'
@ -87,7 +87,8 @@ subroutine mld_z_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,wor
allocate(aux(4*n_col),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/4*n_col,0,0,0,0/),&
call psb_errpush(info,name,&
& i_err=(/4*n_col,izero,izero,izero,izero/),&
& a_err='complex(psb_dpk_)')
goto 9999
end if
@ -96,7 +97,8 @@ subroutine mld_z_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,wor
allocate(ww(n_col),aux(4*n_col),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/5*n_col,0,0,0,0/),&
call psb_errpush(info,name,&
& i_err=(/5*n_col,izero,izero,izero,izero/),&
& a_err='complex(psb_dpk_)')
goto 9999
end if
@ -123,7 +125,8 @@ subroutine mld_z_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,wor
allocate(tx(n_col),ty(n_col),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/2*n_col,0,0,0,0/),&
call psb_errpush(info,name,&
& i_err=(/2*n_col,izero,izero,izero,izero/),&
& a_err='complex(psb_dpk_)')
goto 9999
end if
@ -137,7 +140,8 @@ subroutine mld_z_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,wor
! and Y(j) is the approximate solution at sweep j.
!
ty(1:n_row) = x(1:n_row)
call psb_spmm(-zone,sm%nd,tx,zone,ty,desc_data,info,work=aux,trans=trans_)
call psb_spmm(-zone,sm%nd,tx,zone,ty,desc_data,info,&
& work=aux,trans=trans_)
if (info /= psb_success_) exit
@ -150,14 +154,16 @@ subroutine mld_z_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,wor
if (info /= psb_success_) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='subsolve with Jacobi sweeps > 1')
call psb_errpush(info,name,&
& a_err='subsolve with Jacobi sweeps > 1')
goto 9999
end if
deallocate(tx,ty,stat=info)
if (info /= psb_success_) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='final cleanup with Jacobi sweeps > 1')
call psb_errpush(info,name,&
& a_err='final cleanup with Jacobi sweeps > 1')
goto 9999
end if
@ -165,7 +171,7 @@ subroutine mld_z_jac_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,wor
info = psb_err_iarg_neg_
call psb_errpush(info,name,&
& i_err=(/2,sweeps,0,0,0/))
& i_err=(/itwo,sweeps,izero,izero,izero/))
goto 9999
endif

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

@ -36,25 +36,26 @@
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
subroutine mld_z_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info)
subroutine mld_z_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
& sweeps,work,info)
use psb_base_mod
use mld_z_jac_smoother, mld_protect_name => mld_z_jac_smoother_apply_vect
implicit none
type(psb_desc_type), intent(in) :: desc_data
type(psb_desc_type), intent(in) :: desc_data
class(mld_z_jac_smoother_type), intent(inout) :: sm
type(psb_z_vect_type),intent(inout) :: x
type(psb_z_vect_type),intent(inout) :: y
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps
complex(psb_dpk_),target, intent(inout) :: work(:)
integer, intent(out) :: info
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer(psb_ipk_), intent(in) :: sweeps
complex(psb_dpk_),target, intent(inout) :: work(:)
integer(psb_ipk_), intent(out) :: info
integer :: n_row,n_col
integer(psb_ipk_) :: n_row,n_col
type(psb_z_vect_type) :: tx, ty
complex(psb_dpk_), pointer :: ww(:), aux(:)
integer :: ictxt,np,me,i, err_act
integer(psb_ipk_) :: ictxt,np,me,i, err_act
character :: trans_
character(len=20) :: name='z_jac_smoother_apply'
@ -89,7 +90,8 @@ subroutine mld_z_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweep
allocate(aux(4*n_col),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/4*n_col,0,0,0,0/),&
call psb_errpush(info,name,&
& i_err=(/4*n_col,izero,izero,izero,izero/),&
& a_err='complex(psb_dpk_)')
goto 9999
end if
@ -98,7 +100,8 @@ subroutine mld_z_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweep
allocate(ww(n_col),aux(4*n_col),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
call psb_errpush(info,name,i_err=(/5*n_col,0,0,0,0/),&
call psb_errpush(info,name,&
& i_err=(/5*n_col,izero,izero,izero,izero/),&
& a_err='complex(psb_dpk_)')
goto 9999
end if
@ -146,7 +149,8 @@ subroutine mld_z_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweep
if (info /= psb_success_) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='subsolve with Jacobi sweeps > 1')
call psb_errpush(info,name,&
& a_err='subsolve with Jacobi sweeps > 1')
goto 9999
end if
@ -154,7 +158,8 @@ subroutine mld_z_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweep
if (info == psb_success_) call ty%free(info)
if (info /= psb_success_) then
info=psb_err_internal_error_
call psb_errpush(info,name,a_err='final cleanup with Jacobi sweeps > 1')
call psb_errpush(info,name,&
& a_err='final cleanup with Jacobi sweeps > 1')
goto 9999
end if
@ -162,7 +167,7 @@ subroutine mld_z_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweep
info = psb_err_iarg_neg_
call psb_errpush(info,name,&
& i_err=(/2,sweeps,0,0,0/))
& i_err=(/itwo,sweeps,izero,izero,izero/))
goto 9999
endif

13
mlprec/impl/smoother/mld_z_jac_smoother_bld.f90
Unescape Escape View File

@ -37,7 +37,6 @@
!!$
!!$
subroutine mld_z_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold)
use psb_base_mod
use mld_z_diag_solver
@ -46,17 +45,17 @@ subroutine mld_z_jac_smoother_bld(a,desc_a,sm,upd,info,amold,vmold)
! Arguments
type(psb_zspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_z_jac_smoother_type), intent(inout) :: sm
character, intent(in) :: upd
integer, intent(out) :: info
character, intent(in) :: upd
integer(psb_ipk_), intent(out) :: info
class(psb_z_base_sparse_mat), intent(in), optional :: amold
class(psb_z_base_vect_type), intent(in), optional :: vmold
! Local variables
integer :: n_row,n_col, nrow_a, nztota, nzeros
integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nzeros
complex(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='z_jac_smoother_bld', ch_err
integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='z_jac_smoother_bld', ch_err
info=psb_success_
call psb_erractionsave(err_act)

Write Preview
Loading…
Cancel
Save