fdurastante
/
amg4psblas
mirror of https://github.com/sfilippone/amg4psblas.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

mld2p4-2:

Browse Source 
mlprec/impl/smoother/mld_c_as_smoother_free.f90
    mlprec/impl/smoother/mld_z_as_smoother_setc.f90
    mlprec/impl/smoother/mld_d_as_smoother_apply.f90
    mlprec/impl/smoother/mld_z_as_smoother_seti.f90
    mlprec/impl/smoother/mld_c_as_smoother_setc.f90
    mlprec/impl/smoother/mld_c_as_smoother_bld.f90
    mlprec/impl/smoother/mld_s_as_smoother_free.f90
    mlprec/impl/smoother/mld_d_as_smoother_bld.f90
    mlprec/impl/smoother/mld_z_as_smoother_setr.f90
    mlprec/impl/smoother/mld_z_as_smoother_check.f90
    mlprec/impl/smoother/mld_c_as_smoother_seti.f90
    mlprec/impl/smoother/mld_c_as_smoother_apply_vect.f90
    mlprec/impl/smoother/mld_z_as_smoother_apply.f90
    mlprec/impl/smoother/mld_c_as_smoother_setr.f90
    mlprec/impl/smoother/mld_s_as_smoother_setc.f90
    mlprec/impl/smoother/mld_s_as_smoother_bld.f90
    mlprec/impl/smoother/mld_d_as_smoother_free.f90
    mlprec/impl/smoother/mld_s_as_smoother_seti.f90
    mlprec/impl/smoother/mld_s_as_smoother_apply_vect.f90
    mlprec/impl/smoother/mld_z_as_smoother_bld.f90
    mlprec/impl/smoother/mld_s_as_smoother_setr.f90
    mlprec/impl/smoother/mld_d_as_smoother_setc.f90
    mlprec/impl/smoother/mld_d_as_smoother_seti.f90
    mlprec/impl/smoother/mld_c_as_smoother_check.f90
    mlprec/impl/smoother/mld_d_as_smoother_setr.f90
    mlprec/impl/smoother/mld_c_as_smoother_dmp.f90
    mlprec/impl/smoother/mld_d_as_smoother_dmp.f90
    mlprec/impl/smoother/mld_c_as_smoother_apply.f90
    mlprec/impl/smoother/mld_z_as_smoother_apply_vect.f90
    mlprec/impl/smoother/mld_s_as_smoother_check.f90
    mlprec/impl/smoother/mld_s_as_smoother_dmp.f90
    mlprec/impl/smoother/mld_s_as_smoother_apply.f90
    mlprec/impl/smoother/mld_z_as_smoother_dmp.f90
    mlprec/impl/smoother/mld_d_as_smoother_apply_vect.f90
    mlprec/impl/smoother/mld_z_as_smoother_free.f90
    mlprec/impl/smoother/mld_d_as_smoother_check.f90

Long integer fixes.
stopcriterion
Salvatore Filippone 12 years ago
parent c9376b5b4f
commit 3b838cadbf
36 changed files with 328 additions and 268 deletions
Show Stats Download Patch File Download Diff File

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

@ -46,14 +46,14 @@ subroutine mld_c_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
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, nrow_d, i
integer(psb_ipk_) :: n_row,n_col, nrow_d, i
complex(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer :: ictxt,np,me, err_act,isz,int_err(5)
integer(psb_ipk_) :: ictxt,np,me, err_act,isz,int_err(5)
character :: trans_
character(len=20) :: name='c_as_smoother_apply', ch_err
@ -93,7 +93,8 @@ subroutine mld_c_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
aux => work(1:)
allocate(ww(isz),tx(isz),ty(isz),stat=info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_request_,name,i_err=(/3*isz,0,0,0,0/),&
call psb_errpush(psb_err_alloc_request_,name,&
& i_err=(/3*isz,izero,izero,izero,izero/),&
& a_err='complex(psb_spk_)')
goto 9999
end if
@ -103,7 +104,8 @@ subroutine mld_c_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
ty => work(2*isz+1:3*isz)
allocate(aux(4*isz),stat=info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_request_,name,i_err=(/4*isz,0,0,0,0/),&
call psb_errpush(psb_err_alloc_request_,name,&
& i_err=(/4*isz,izero,izero,izero,izero/),&
& a_err='complex(psb_spk_)')
goto 9999
end if
@ -111,7 +113,8 @@ subroutine mld_c_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
allocate(ww(isz),tx(isz),ty(isz),&
&aux(4*isz),stat=info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_request_,name,i_err=(/4*isz,0,0,0,0/),&
call psb_errpush(psb_err_alloc_request_,name,&
& i_err=(/4*isz,izero,izero,izero,izero/),&
& a_err='complex(psb_spk_)')
goto 9999
end if
@ -153,7 +156,8 @@ subroutine mld_c_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
goto 9999
end if
else if (sm%restr /= psb_none_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid mld_sub_restr_')
call psb_errpush(psb_err_internal_error_,name,&
&a_err='Invalid mld_sub_restr_')
goto 9999
end if
@ -187,7 +191,7 @@ subroutine mld_c_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
! (hence only scaling), then we do the halo
!
call psb_ovrl(tx,sm%desc_data,info,&
& update=psb_avg_,work=aux,mode=0)
& update=psb_avg_,work=aux,mode=izero)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_ovrl'
@ -201,7 +205,8 @@ subroutine mld_c_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
end if
case default
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid mld_sub_prol_')
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Invalid mld_sub_prol_')
goto 9999
end select
@ -246,7 +251,8 @@ subroutine mld_c_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
end if
case default
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid mld_sub_prol_')
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Invalid mld_sub_prol_')
goto 9999
end select
@ -263,7 +269,8 @@ subroutine mld_c_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
goto 9999
end if
else if (sm%restr /= psb_none_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid mld_sub_restr_')
call psb_errpush(psb_err_internal_error_,name,&
&a_err='Invalid mld_sub_restr_')
goto 9999
end if
@ -299,7 +306,8 @@ subroutine mld_c_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
goto 9999
end if
else if (sm%restr /= psb_none_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid mld_sub_restr_')
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Invalid mld_sub_restr_')
goto 9999
end if
@ -333,7 +341,7 @@ subroutine mld_c_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
! (hence only scaling), then we do the halo
!
call psb_ovrl(tx,sm%desc_data,info,&
& update=psb_avg_,work=aux,mode=0)
& update=psb_avg_,work=aux,mode=izero)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_ovrl'
@ -347,7 +355,8 @@ subroutine mld_c_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
end if
case default
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid mld_sub_prol_')
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Invalid mld_sub_prol_')
goto 9999
end select
@ -364,7 +373,8 @@ subroutine mld_c_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
! and Y(j) is the approximate solution at sweep j.
!
ww(1:n_row) = tx(1:n_row)
call psb_spmm(-cone,sm%nd,ty,cone,ww,sm%desc_data,info,work=aux,trans=trans_)
call psb_spmm(-cone,sm%nd,ty,cone,ww,sm%desc_data,info,&
& work=aux,trans=trans_)
if (info /= psb_success_) exit
@ -398,7 +408,8 @@ subroutine mld_c_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
end if
case default
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid mld_sub_prol_')
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Invalid mld_sub_prol_')
goto 9999
end select
@ -415,7 +426,8 @@ subroutine mld_c_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
goto 9999
end if
else if (sm%restr /= psb_none_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid mld_sub_restr_')
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Invalid mld_sub_restr_')
goto 9999
end if
@ -438,7 +450,7 @@ subroutine mld_c_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
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

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

@ -36,8 +36,8 @@
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
subroutine mld_c_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info)
subroutine mld_c_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
& sweeps,work,info)
use psb_base_mod
use mld_c_as_smoother, mld_protect_nam => mld_c_as_smoother_apply_vect
implicit none
@ -45,17 +45,17 @@ subroutine mld_c_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps
class(mld_c_as_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, nrow_d, i
integer(psb_ipk_) :: n_row,n_col, nrow_d, i
complex(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:)
complex(psb_spk_), allocatable :: vx(:)
type(psb_c_vect_type) :: vtx, vty, vww
integer :: ictxt,np,me, err_act,isz,int_err(5)
integer(psb_ipk_) :: ictxt,np,me, err_act,isz,int_err(5)
character :: trans_
character(len=20) :: name='c_as_smoother_apply', ch_err
@ -96,7 +96,8 @@ subroutine mld_c_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps
aux => work(1:)
allocate(ww(isz),tx(isz),ty(isz),stat=info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_request_,name,i_err=(/3*isz,0,0,0,0/),&
call psb_errpush(psb_err_alloc_request_,name,&
& i_err=(/3*isz,izero,izero,izero,izero/),&
& a_err='complex(psb_spk_)')
goto 9999
end if
@ -106,7 +107,8 @@ subroutine mld_c_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps
ty => work(2*isz+1:3*isz)
allocate(aux(4*isz),stat=info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_request_,name,i_err=(/4*isz,0,0,0,0/),&
call psb_errpush(psb_err_alloc_request_,name,&
& i_err=(/4*isz,izero,izero,izero,izero/),&
& a_err='complex(psb_spk_)')
goto 9999
end if
@ -114,7 +116,8 @@ subroutine mld_c_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps
allocate(ww(isz),tx(isz),ty(isz),&
&aux(4*isz),stat=info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_request_,name,i_err=(/4*isz,0,0,0,0/),&
call psb_errpush(psb_err_alloc_request_,name,&
& i_err=(/4*isz,izero,izero,izero,izero/),&
& a_err='complex(psb_spk_)')
goto 9999
end if
@ -202,7 +205,7 @@ subroutine mld_c_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps
! (hence only scaling), then we do the halo
!
call psb_ovrl(vtx,sm%desc_data,info,&
& update=psb_avg_,work=aux,mode=0)
& update=psb_avg_,work=aux,mode=izero)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_ovrl'
@ -353,7 +356,7 @@ subroutine mld_c_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps
! (hence only scaling), then we do the halo
!
call psb_ovrl(vtx,sm%desc_data,info,&
& update=psb_avg_,work=aux,mode=0)
& update=psb_avg_,work=aux,mode=izero)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_ovrl'
@ -463,7 +466,7 @@ subroutine mld_c_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps
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

17
mlprec/impl/smoother/mld_c_as_smoother_bld.f90
Unescape Escape View File

@ -43,20 +43,20 @@ subroutine mld_c_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold)
Implicit None
! Arguments
type(psb_cspmat_type), intent(in), target :: a
type(psb_cspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_c_as_smoother_type), intent(inout) :: sm
class(mld_c_as_smoother_type), intent(inout) :: sm
character, intent(in) :: upd
integer, intent(out) :: info
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
type(psb_cspmat_type) :: blck, atmp
integer :: n_row,n_col, nrow_a, nhalo, novr, data_, nzeros
integer(psb_ipk_) :: n_row,n_col, nrow_a, nhalo, novr, data_, 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_as_smoother_bld', ch_err
integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='c_as_smoother_bld', ch_err
info=psb_success_
call psb_erractionsave(err_act)
@ -71,7 +71,8 @@ subroutine mld_c_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold)
novr = sm%novr
if (novr < 0) then
info=psb_err_invalid_ovr_num_
call psb_errpush(info,name,i_err=(/novr,0,0,0,0,0/))
call psb_errpush(info,name,&
& i_err=(/novr,izero,izero,izero,izero,izero/))
goto 9999
endif
@ -91,7 +92,7 @@ subroutine mld_c_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold)
& write(debug_unit,*) me,' ',trim(name),&
& 'Early return: P>=3 N_OVR=0'
endif
call blck%csall(0,0,info,1)
call blck%csall(izero,izero,info,ione)
else
If (psb_toupper(upd) == 'F') Then

7
mlprec/impl/smoother/mld_c_as_smoother_check.f90
Unescape Escape View File

@ -38,7 +38,6 @@
!!$
subroutine mld_c_as_smoother_check(sm,info)
use psb_base_mod
use mld_c_as_smoother, mld_protect_nam => mld_c_as_smoother_check
@ -46,8 +45,8 @@ subroutine mld_c_as_smoother_check(sm,info)
! Arguments
class(mld_c_as_smoother_type), intent(inout) :: sm
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(out) :: info
Integer(Psb_ipk_) :: err_act
character(len=20) :: name='c_as_smoother_check'
call psb_erractionsave(err_act)
@ -58,7 +57,7 @@ subroutine mld_c_as_smoother_check(sm,info)
call mld_check_def(sm%prol,&
& 'Prolongator',psb_none_,is_legal_prolong)
call mld_check_def(sm%novr,&
& 'Overlap layers ',0,is_legal_n_ovr)
& 'Overlap layers ',izero,is_legal_n_ovr)
if (allocated(sm%sv)) then

8
mlprec/impl/smoother/mld_c_as_smoother_dmp.f90
Unescape Escape View File

@ -42,12 +42,12 @@ subroutine mld_c_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver
use mld_c_as_smoother, mld_protect_nam => mld_c_as_smoother_dmp
implicit none
class(mld_c_as_smoother_type), intent(in) :: sm
integer, intent(in) :: ictxt,level
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: ictxt,level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver
integer :: i, j, il1, iln, lname, lev
integer :: icontxt,iam, np
integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np
character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than
logical :: smoother_

4
mlprec/impl/smoother/mld_c_as_smoother_free.f90
Unescape Escape View File

@ -43,8 +43,8 @@ subroutine mld_c_as_smoother_free(sm,info)
Implicit None
! Arguments
class(mld_c_as_smoother_type), intent(inout) :: sm
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='c_as_smoother_free'
call psb_erractionsave(err_act)

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

@ -43,11 +43,11 @@ subroutine mld_c_as_smoother_setc(sm,what,val,info)
Implicit None
! Arguments
class(mld_c_as_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act, ival
character(len=20) :: name='c_as_smoother_setc'
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act, ival
character(len=20) :: name='c_as_smoother_setc'
info = psb_success_
call psb_erractionsave(err_act)

8
mlprec/impl/smoother/mld_c_as_smoother_seti.f90
Unescape Escape View File

@ -44,10 +44,10 @@ subroutine mld_c_as_smoother_seti(sm,what,val,info)
! Arguments
class(mld_c_as_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='c_as_smoother_seti'
info = psb_success_

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

@ -43,11 +43,11 @@ subroutine mld_c_as_smoother_setr(sm,what,val,info)
Implicit None
! Arguments
class(mld_c_as_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
real(psb_spk_), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
character(len=20) :: name='c_as_smoother_setr'
integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='c_as_smoother_setr'
call psb_erractionsave(err_act)
info = psb_success_

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

@ -46,14 +46,14 @@ subroutine mld_d_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
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, nrow_d, i
integer(psb_ipk_) :: n_row,n_col, nrow_d, i
real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer :: ictxt,np,me, err_act,isz,int_err(5)
integer(psb_ipk_) :: ictxt,np,me, err_act,isz,int_err(5)
character :: trans_
character(len=20) :: name='d_as_smoother_apply', ch_err
@ -93,7 +93,8 @@ subroutine mld_d_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
aux => work(1:)
allocate(ww(isz),tx(isz),ty(isz),stat=info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_request_,name,i_err=(/3*isz,0,0,0,0/),&
call psb_errpush(psb_err_alloc_request_,name,&
& i_err=(/3*isz,izero,izero,izero,izero/),&
& a_err='real(psb_dpk_)')
goto 9999
end if
@ -103,7 +104,8 @@ subroutine mld_d_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
ty => work(2*isz+1:3*isz)
allocate(aux(4*isz),stat=info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_request_,name,i_err=(/4*isz,0,0,0,0/),&
call psb_errpush(psb_err_alloc_request_,name,&
& i_err=(/4*isz,izero,izero,izero,izero/),&
& a_err='real(psb_dpk_)')
goto 9999
end if
@ -111,7 +113,8 @@ subroutine mld_d_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
allocate(ww(isz),tx(isz),ty(isz),&
&aux(4*isz),stat=info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_request_,name,i_err=(/4*isz,0,0,0,0/),&
call psb_errpush(psb_err_alloc_request_,name,&
& i_err=(/4*isz,izero,izero,izero,izero/),&
& a_err='real(psb_dpk_)')
goto 9999
end if
@ -153,7 +156,8 @@ subroutine mld_d_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
goto 9999
end if
else if (sm%restr /= psb_none_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid mld_sub_restr_')
call psb_errpush(psb_err_internal_error_,name,&
&a_err='Invalid mld_sub_restr_')
goto 9999
end if
@ -187,7 +191,7 @@ subroutine mld_d_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
! (hence only scaling), then we do the halo
!
call psb_ovrl(tx,sm%desc_data,info,&
& update=psb_avg_,work=aux,mode=0)
& update=psb_avg_,work=aux,mode=izero)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_ovrl'
@ -201,7 +205,8 @@ subroutine mld_d_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
end if
case default
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid mld_sub_prol_')
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Invalid mld_sub_prol_')
goto 9999
end select
@ -246,7 +251,8 @@ subroutine mld_d_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
end if
case default
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid mld_sub_prol_')
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Invalid mld_sub_prol_')
goto 9999
end select
@ -263,7 +269,8 @@ subroutine mld_d_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
goto 9999
end if
else if (sm%restr /= psb_none_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid mld_sub_restr_')
call psb_errpush(psb_err_internal_error_,name,&
&a_err='Invalid mld_sub_restr_')
goto 9999
end if
@ -299,7 +306,8 @@ subroutine mld_d_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
goto 9999
end if
else if (sm%restr /= psb_none_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid mld_sub_restr_')
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Invalid mld_sub_restr_')
goto 9999
end if
@ -333,7 +341,7 @@ subroutine mld_d_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
! (hence only scaling), then we do the halo
!
call psb_ovrl(tx,sm%desc_data,info,&
& update=psb_avg_,work=aux,mode=0)
& update=psb_avg_,work=aux,mode=izero)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_ovrl'
@ -347,7 +355,8 @@ subroutine mld_d_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
end if
case default
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid mld_sub_prol_')
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Invalid mld_sub_prol_')
goto 9999
end select
@ -364,7 +373,8 @@ subroutine mld_d_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
! and Y(j) is the approximate solution at sweep j.
!
ww(1:n_row) = tx(1:n_row)
call psb_spmm(-done,sm%nd,ty,done,ww,sm%desc_data,info,work=aux,trans=trans_)
call psb_spmm(-done,sm%nd,ty,done,ww,sm%desc_data,info,&
& work=aux,trans=trans_)
if (info /= psb_success_) exit
@ -398,7 +408,8 @@ subroutine mld_d_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
end if
case default
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid mld_sub_prol_')
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Invalid mld_sub_prol_')
goto 9999
end select
@ -415,7 +426,8 @@ subroutine mld_d_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
goto 9999
end if
else if (sm%restr /= psb_none_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid mld_sub_restr_')
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Invalid mld_sub_restr_')
goto 9999
end if
@ -438,7 +450,7 @@ subroutine mld_d_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
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

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

@ -36,8 +36,8 @@
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
subroutine mld_d_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info)
subroutine mld_d_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
& sweeps,work,info)
use psb_base_mod
use mld_d_as_smoother, mld_protect_nam => mld_d_as_smoother_apply_vect
implicit none
@ -45,17 +45,17 @@ subroutine mld_d_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps
class(mld_d_as_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, nrow_d, i
integer(psb_ipk_) :: n_row,n_col, nrow_d, i
real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
real(psb_dpk_), allocatable :: vx(:)
type(psb_d_vect_type) :: vtx, vty, vww
integer :: ictxt,np,me, err_act,isz,int_err(5)
integer(psb_ipk_) :: ictxt,np,me, err_act,isz,int_err(5)
character :: trans_
character(len=20) :: name='d_as_smoother_apply', ch_err
@ -96,7 +96,8 @@ subroutine mld_d_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps
aux => work(1:)
allocate(ww(isz),tx(isz),ty(isz),stat=info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_request_,name,i_err=(/3*isz,0,0,0,0/),&
call psb_errpush(psb_err_alloc_request_,name,&
& i_err=(/3*isz,izero,izero,izero,izero/),&
& a_err='real(psb_dpk_)')
goto 9999
end if
@ -106,7 +107,8 @@ subroutine mld_d_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps
ty => work(2*isz+1:3*isz)
allocate(aux(4*isz),stat=info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_request_,name,i_err=(/4*isz,0,0,0,0/),&
call psb_errpush(psb_err_alloc_request_,name,&
& i_err=(/4*isz,izero,izero,izero,izero/),&
& a_err='real(psb_dpk_)')
goto 9999
end if
@ -114,7 +116,8 @@ subroutine mld_d_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps
allocate(ww(isz),tx(isz),ty(isz),&
&aux(4*isz),stat=info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_request_,name,i_err=(/4*isz,0,0,0,0/),&
call psb_errpush(psb_err_alloc_request_,name,&
& i_err=(/4*isz,izero,izero,izero,izero/),&
& a_err='real(psb_dpk_)')
goto 9999
end if
@ -202,7 +205,7 @@ subroutine mld_d_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps
! (hence only scaling), then we do the halo
!
call psb_ovrl(vtx,sm%desc_data,info,&
& update=psb_avg_,work=aux,mode=0)
& update=psb_avg_,work=aux,mode=izero)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_ovrl'
@ -353,7 +356,7 @@ subroutine mld_d_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps
! (hence only scaling), then we do the halo
!
call psb_ovrl(vtx,sm%desc_data,info,&
& update=psb_avg_,work=aux,mode=0)
& update=psb_avg_,work=aux,mode=izero)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_ovrl'
@ -463,7 +466,7 @@ subroutine mld_d_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps
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

17
mlprec/impl/smoother/mld_d_as_smoother_bld.f90
Unescape Escape View File

@ -43,20 +43,20 @@ subroutine mld_d_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold)
Implicit None
! Arguments
type(psb_dspmat_type), intent(in), target :: a
type(psb_dspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_d_as_smoother_type), intent(inout) :: sm
class(mld_d_as_smoother_type), intent(inout) :: sm
character, intent(in) :: upd
integer, intent(out) :: info
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
type(psb_dspmat_type) :: blck, atmp
integer :: n_row,n_col, nrow_a, nhalo, novr, data_, nzeros
integer(psb_ipk_) :: n_row,n_col, nrow_a, nhalo, novr, data_, 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_as_smoother_bld', ch_err
integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='d_as_smoother_bld', ch_err
info=psb_success_
call psb_erractionsave(err_act)
@ -71,7 +71,8 @@ subroutine mld_d_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold)
novr = sm%novr
if (novr < 0) then
info=psb_err_invalid_ovr_num_
call psb_errpush(info,name,i_err=(/novr,0,0,0,0,0/))
call psb_errpush(info,name,&
& i_err=(/novr,izero,izero,izero,izero,izero/))
goto 9999
endif
@ -91,7 +92,7 @@ subroutine mld_d_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold)
& write(debug_unit,*) me,' ',trim(name),&
& 'Early return: P>=3 N_OVR=0'
endif
call blck%csall(0,0,info,1)
call blck%csall(izero,izero,info,ione)
else
If (psb_toupper(upd) == 'F') Then

7
mlprec/impl/smoother/mld_d_as_smoother_check.f90
Unescape Escape View File

@ -38,7 +38,6 @@
!!$
subroutine mld_d_as_smoother_check(sm,info)
use psb_base_mod
use mld_d_as_smoother, mld_protect_nam => mld_d_as_smoother_check
@ -46,8 +45,8 @@ subroutine mld_d_as_smoother_check(sm,info)
! Arguments
class(mld_d_as_smoother_type), intent(inout) :: sm
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(out) :: info
Integer(Psb_ipk_) :: err_act
character(len=20) :: name='d_as_smoother_check'
call psb_erractionsave(err_act)
@ -58,7 +57,7 @@ subroutine mld_d_as_smoother_check(sm,info)
call mld_check_def(sm%prol,&
& 'Prolongator',psb_none_,is_legal_prolong)
call mld_check_def(sm%novr,&
& 'Overlap layers ',0,is_legal_n_ovr)
& 'Overlap layers ',izero,is_legal_n_ovr)
if (allocated(sm%sv)) then

8
mlprec/impl/smoother/mld_d_as_smoother_dmp.f90
Unescape Escape View File

@ -42,12 +42,12 @@ subroutine mld_d_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver
use mld_d_as_smoother, mld_protect_nam => mld_d_as_smoother_dmp
implicit none
class(mld_d_as_smoother_type), intent(in) :: sm
integer, intent(in) :: ictxt,level
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: ictxt,level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver
integer :: i, j, il1, iln, lname, lev
integer :: icontxt,iam, np
integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np
character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than
logical :: smoother_

4
mlprec/impl/smoother/mld_d_as_smoother_free.f90
Unescape Escape View File

@ -43,8 +43,8 @@ subroutine mld_d_as_smoother_free(sm,info)
Implicit None
! Arguments
class(mld_d_as_smoother_type), intent(inout) :: sm
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_as_smoother_free'
call psb_erractionsave(err_act)

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

@ -43,11 +43,11 @@ subroutine mld_d_as_smoother_setc(sm,what,val,info)
Implicit None
! Arguments
class(mld_d_as_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act, ival
character(len=20) :: name='d_as_smoother_setc'
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act, ival
character(len=20) :: name='d_as_smoother_setc'
info = psb_success_
call psb_erractionsave(err_act)

8
mlprec/impl/smoother/mld_d_as_smoother_seti.f90
Unescape Escape View File

@ -44,10 +44,10 @@ subroutine mld_d_as_smoother_seti(sm,what,val,info)
! Arguments
class(mld_d_as_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_as_smoother_seti'
info = psb_success_

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

@ -43,11 +43,11 @@ subroutine mld_d_as_smoother_setr(sm,what,val,info)
Implicit None
! Arguments
class(mld_d_as_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
character(len=20) :: name='d_as_smoother_setr'
integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_as_smoother_setr'
call psb_erractionsave(err_act)
info = psb_success_

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

@ -46,14 +46,14 @@ subroutine mld_s_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
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, nrow_d, i
integer(psb_ipk_) :: n_row,n_col, nrow_d, i
real(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer :: ictxt,np,me, err_act,isz,int_err(5)
integer(psb_ipk_) :: ictxt,np,me, err_act,isz,int_err(5)
character :: trans_
character(len=20) :: name='s_as_smoother_apply', ch_err
@ -93,7 +93,8 @@ subroutine mld_s_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
aux => work(1:)
allocate(ww(isz),tx(isz),ty(isz),stat=info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_request_,name,i_err=(/3*isz,0,0,0,0/),&
call psb_errpush(psb_err_alloc_request_,name,&
& i_err=(/3*isz,izero,izero,izero,izero/),&
& a_err='real(psb_spk_)')
goto 9999
end if
@ -103,7 +104,8 @@ subroutine mld_s_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
ty => work(2*isz+1:3*isz)
allocate(aux(4*isz),stat=info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_request_,name,i_err=(/4*isz,0,0,0,0/),&
call psb_errpush(psb_err_alloc_request_,name,&
& i_err=(/4*isz,izero,izero,izero,izero/),&
& a_err='real(psb_spk_)')
goto 9999
end if
@ -111,7 +113,8 @@ subroutine mld_s_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
allocate(ww(isz),tx(isz),ty(isz),&
&aux(4*isz),stat=info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_request_,name,i_err=(/4*isz,0,0,0,0/),&
call psb_errpush(psb_err_alloc_request_,name,&
& i_err=(/4*isz,izero,izero,izero,izero/),&
& a_err='real(psb_spk_)')
goto 9999
end if
@ -153,7 +156,8 @@ subroutine mld_s_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
goto 9999
end if
else if (sm%restr /= psb_none_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid mld_sub_restr_')
call psb_errpush(psb_err_internal_error_,name,&
&a_err='Invalid mld_sub_restr_')
goto 9999
end if
@ -187,7 +191,7 @@ subroutine mld_s_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
! (hence only scaling), then we do the halo
!
call psb_ovrl(tx,sm%desc_data,info,&
& update=psb_avg_,work=aux,mode=0)
& update=psb_avg_,work=aux,mode=izero)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_ovrl'
@ -201,7 +205,8 @@ subroutine mld_s_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
end if
case default
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid mld_sub_prol_')
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Invalid mld_sub_prol_')
goto 9999
end select
@ -246,7 +251,8 @@ subroutine mld_s_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
end if
case default
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid mld_sub_prol_')
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Invalid mld_sub_prol_')
goto 9999
end select
@ -263,7 +269,8 @@ subroutine mld_s_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
goto 9999
end if
else if (sm%restr /= psb_none_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid mld_sub_restr_')
call psb_errpush(psb_err_internal_error_,name,&
&a_err='Invalid mld_sub_restr_')
goto 9999
end if
@ -299,7 +306,8 @@ subroutine mld_s_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
goto 9999
end if
else if (sm%restr /= psb_none_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid mld_sub_restr_')
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Invalid mld_sub_restr_')
goto 9999
end if
@ -333,7 +341,7 @@ subroutine mld_s_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
! (hence only scaling), then we do the halo
!
call psb_ovrl(tx,sm%desc_data,info,&
& update=psb_avg_,work=aux,mode=0)
& update=psb_avg_,work=aux,mode=izero)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_ovrl'
@ -347,7 +355,8 @@ subroutine mld_s_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
end if
case default
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid mld_sub_prol_')
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Invalid mld_sub_prol_')
goto 9999
end select
@ -364,7 +373,8 @@ subroutine mld_s_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
! and Y(j) is the approximate solution at sweep j.
!
ww(1:n_row) = tx(1:n_row)
call psb_spmm(-sone,sm%nd,ty,sone,ww,sm%desc_data,info,work=aux,trans=trans_)
call psb_spmm(-sone,sm%nd,ty,sone,ww,sm%desc_data,info,&
& work=aux,trans=trans_)
if (info /= psb_success_) exit
@ -398,7 +408,8 @@ subroutine mld_s_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
end if
case default
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid mld_sub_prol_')
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Invalid mld_sub_prol_')
goto 9999
end select
@ -415,7 +426,8 @@ subroutine mld_s_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
goto 9999
end if
else if (sm%restr /= psb_none_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid mld_sub_restr_')
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Invalid mld_sub_restr_')
goto 9999
end if
@ -438,7 +450,7 @@ subroutine mld_s_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
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

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

@ -36,8 +36,8 @@
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
subroutine mld_s_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info)
subroutine mld_s_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
& sweeps,work,info)
use psb_base_mod
use mld_s_as_smoother, mld_protect_nam => mld_s_as_smoother_apply_vect
implicit none
@ -45,17 +45,17 @@ subroutine mld_s_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps
class(mld_s_as_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, nrow_d, i
integer(psb_ipk_) :: n_row,n_col, nrow_d, i
real(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:)
real(psb_spk_), allocatable :: vx(:)
type(psb_s_vect_type) :: vtx, vty, vww
integer :: ictxt,np,me, err_act,isz,int_err(5)
integer(psb_ipk_) :: ictxt,np,me, err_act,isz,int_err(5)
character :: trans_
character(len=20) :: name='s_as_smoother_apply', ch_err
@ -96,7 +96,8 @@ subroutine mld_s_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps
aux => work(1:)
allocate(ww(isz),tx(isz),ty(isz),stat=info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_request_,name,i_err=(/3*isz,0,0,0,0/),&
call psb_errpush(psb_err_alloc_request_,name,&
& i_err=(/3*isz,izero,izero,izero,izero/),&
& a_err='real(psb_spk_)')
goto 9999
end if
@ -106,7 +107,8 @@ subroutine mld_s_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps
ty => work(2*isz+1:3*isz)
allocate(aux(4*isz),stat=info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_request_,name,i_err=(/4*isz,0,0,0,0/),&
call psb_errpush(psb_err_alloc_request_,name,&
& i_err=(/4*isz,izero,izero,izero,izero/),&
& a_err='real(psb_spk_)')
goto 9999
end if
@ -114,7 +116,8 @@ subroutine mld_s_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps
allocate(ww(isz),tx(isz),ty(isz),&
&aux(4*isz),stat=info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_request_,name,i_err=(/4*isz,0,0,0,0/),&
call psb_errpush(psb_err_alloc_request_,name,&
& i_err=(/4*isz,izero,izero,izero,izero/),&
& a_err='real(psb_spk_)')
goto 9999
end if
@ -202,7 +205,7 @@ subroutine mld_s_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps
! (hence only scaling), then we do the halo
!
call psb_ovrl(vtx,sm%desc_data,info,&
& update=psb_avg_,work=aux,mode=0)
& update=psb_avg_,work=aux,mode=izero)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_ovrl'
@ -353,7 +356,7 @@ subroutine mld_s_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps
! (hence only scaling), then we do the halo
!
call psb_ovrl(vtx,sm%desc_data,info,&
& update=psb_avg_,work=aux,mode=0)
& update=psb_avg_,work=aux,mode=izero)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_ovrl'
@ -463,7 +466,7 @@ subroutine mld_s_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps
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

17
mlprec/impl/smoother/mld_s_as_smoother_bld.f90
Unescape Escape View File

@ -43,20 +43,20 @@ subroutine mld_s_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold)
Implicit None
! Arguments
type(psb_sspmat_type), intent(in), target :: a
type(psb_sspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_s_as_smoother_type), intent(inout) :: sm
class(mld_s_as_smoother_type), intent(inout) :: sm
character, intent(in) :: upd
integer, intent(out) :: info
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
type(psb_sspmat_type) :: blck, atmp
integer :: n_row,n_col, nrow_a, nhalo, novr, data_, nzeros
integer(psb_ipk_) :: n_row,n_col, nrow_a, nhalo, novr, data_, 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_as_smoother_bld', ch_err
integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='s_as_smoother_bld', ch_err
info=psb_success_
call psb_erractionsave(err_act)
@ -71,7 +71,8 @@ subroutine mld_s_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold)
novr = sm%novr
if (novr < 0) then
info=psb_err_invalid_ovr_num_
call psb_errpush(info,name,i_err=(/novr,0,0,0,0,0/))
call psb_errpush(info,name,&
& i_err=(/novr,izero,izero,izero,izero,izero/))
goto 9999
endif
@ -91,7 +92,7 @@ subroutine mld_s_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold)
& write(debug_unit,*) me,' ',trim(name),&
& 'Early return: P>=3 N_OVR=0'
endif
call blck%csall(0,0,info,1)
call blck%csall(izero,izero,info,ione)
else
If (psb_toupper(upd) == 'F') Then

7
mlprec/impl/smoother/mld_s_as_smoother_check.f90
Unescape Escape View File

@ -38,7 +38,6 @@
!!$
subroutine mld_s_as_smoother_check(sm,info)
use psb_base_mod
use mld_s_as_smoother, mld_protect_nam => mld_s_as_smoother_check
@ -46,8 +45,8 @@ subroutine mld_s_as_smoother_check(sm,info)
! Arguments
class(mld_s_as_smoother_type), intent(inout) :: sm
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(out) :: info
Integer(Psb_ipk_) :: err_act
character(len=20) :: name='s_as_smoother_check'
call psb_erractionsave(err_act)
@ -58,7 +57,7 @@ subroutine mld_s_as_smoother_check(sm,info)
call mld_check_def(sm%prol,&
& 'Prolongator',psb_none_,is_legal_prolong)
call mld_check_def(sm%novr,&
& 'Overlap layers ',0,is_legal_n_ovr)
& 'Overlap layers ',izero,is_legal_n_ovr)
if (allocated(sm%sv)) then

8
mlprec/impl/smoother/mld_s_as_smoother_dmp.f90
Unescape Escape View File

@ -42,12 +42,12 @@ subroutine mld_s_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver
use mld_s_as_smoother, mld_protect_nam => mld_s_as_smoother_dmp
implicit none
class(mld_s_as_smoother_type), intent(in) :: sm
integer, intent(in) :: ictxt,level
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: ictxt,level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver
integer :: i, j, il1, iln, lname, lev
integer :: icontxt,iam, np
integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np
character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than
logical :: smoother_

4
mlprec/impl/smoother/mld_s_as_smoother_free.f90
Unescape Escape View File

@ -43,8 +43,8 @@ subroutine mld_s_as_smoother_free(sm,info)
Implicit None
! Arguments
class(mld_s_as_smoother_type), intent(inout) :: sm
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='s_as_smoother_free'
call psb_erractionsave(err_act)

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

@ -43,11 +43,11 @@ subroutine mld_s_as_smoother_setc(sm,what,val,info)
Implicit None
! Arguments
class(mld_s_as_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act, ival
character(len=20) :: name='s_as_smoother_setc'
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act, ival
character(len=20) :: name='s_as_smoother_setc'
info = psb_success_
call psb_erractionsave(err_act)

8
mlprec/impl/smoother/mld_s_as_smoother_seti.f90
Unescape Escape View File

@ -44,10 +44,10 @@ subroutine mld_s_as_smoother_seti(sm,what,val,info)
! Arguments
class(mld_s_as_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='s_as_smoother_seti'
info = psb_success_

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

@ -43,11 +43,11 @@ subroutine mld_s_as_smoother_setr(sm,what,val,info)
Implicit None
! Arguments
class(mld_s_as_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
real(psb_spk_), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
character(len=20) :: name='s_as_smoother_setr'
integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='s_as_smoother_setr'
call psb_erractionsave(err_act)
info = psb_success_

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

@ -46,14 +46,14 @@ subroutine mld_z_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
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, nrow_d, i
integer(psb_ipk_) :: n_row,n_col, nrow_d, i
complex(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
integer :: ictxt,np,me, err_act,isz,int_err(5)
integer(psb_ipk_) :: ictxt,np,me, err_act,isz,int_err(5)
character :: trans_
character(len=20) :: name='z_as_smoother_apply', ch_err
@ -93,7 +93,8 @@ subroutine mld_z_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
aux => work(1:)
allocate(ww(isz),tx(isz),ty(isz),stat=info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_request_,name,i_err=(/3*isz,0,0,0,0/),&
call psb_errpush(psb_err_alloc_request_,name,&
& i_err=(/3*isz,izero,izero,izero,izero/),&
& a_err='complex(psb_dpk_)')
goto 9999
end if
@ -103,7 +104,8 @@ subroutine mld_z_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
ty => work(2*isz+1:3*isz)
allocate(aux(4*isz),stat=info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_request_,name,i_err=(/4*isz,0,0,0,0/),&
call psb_errpush(psb_err_alloc_request_,name,&
& i_err=(/4*isz,izero,izero,izero,izero/),&
& a_err='complex(psb_dpk_)')
goto 9999
end if
@ -111,7 +113,8 @@ subroutine mld_z_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
allocate(ww(isz),tx(isz),ty(isz),&
&aux(4*isz),stat=info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_request_,name,i_err=(/4*isz,0,0,0,0/),&
call psb_errpush(psb_err_alloc_request_,name,&
& i_err=(/4*isz,izero,izero,izero,izero/),&
& a_err='complex(psb_dpk_)')
goto 9999
end if
@ -153,7 +156,8 @@ subroutine mld_z_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
goto 9999
end if
else if (sm%restr /= psb_none_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid mld_sub_restr_')
call psb_errpush(psb_err_internal_error_,name,&
&a_err='Invalid mld_sub_restr_')
goto 9999
end if
@ -187,7 +191,7 @@ subroutine mld_z_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
! (hence only scaling), then we do the halo
!
call psb_ovrl(tx,sm%desc_data,info,&
& update=psb_avg_,work=aux,mode=0)
& update=psb_avg_,work=aux,mode=izero)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_ovrl'
@ -201,7 +205,8 @@ subroutine mld_z_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
end if
case default
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid mld_sub_prol_')
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Invalid mld_sub_prol_')
goto 9999
end select
@ -246,7 +251,8 @@ subroutine mld_z_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
end if
case default
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid mld_sub_prol_')
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Invalid mld_sub_prol_')
goto 9999
end select
@ -263,7 +269,8 @@ subroutine mld_z_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
goto 9999
end if
else if (sm%restr /= psb_none_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid mld_sub_restr_')
call psb_errpush(psb_err_internal_error_,name,&
&a_err='Invalid mld_sub_restr_')
goto 9999
end if
@ -299,7 +306,8 @@ subroutine mld_z_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
goto 9999
end if
else if (sm%restr /= psb_none_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid mld_sub_restr_')
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Invalid mld_sub_restr_')
goto 9999
end if
@ -333,7 +341,7 @@ subroutine mld_z_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
! (hence only scaling), then we do the halo
!
call psb_ovrl(tx,sm%desc_data,info,&
& update=psb_avg_,work=aux,mode=0)
& update=psb_avg_,work=aux,mode=izero)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_ovrl'
@ -347,7 +355,8 @@ subroutine mld_z_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
end if
case default
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid mld_sub_prol_')
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Invalid mld_sub_prol_')
goto 9999
end select
@ -364,7 +373,8 @@ subroutine mld_z_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
! and Y(j) is the approximate solution at sweep j.
!
ww(1:n_row) = tx(1:n_row)
call psb_spmm(-zone,sm%nd,ty,zone,ww,sm%desc_data,info,work=aux,trans=trans_)
call psb_spmm(-zone,sm%nd,ty,zone,ww,sm%desc_data,info,&
& work=aux,trans=trans_)
if (info /= psb_success_) exit
@ -398,7 +408,8 @@ subroutine mld_z_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
end if
case default
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid mld_sub_prol_')
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Invalid mld_sub_prol_')
goto 9999
end select
@ -415,7 +426,8 @@ subroutine mld_z_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
goto 9999
end if
else if (sm%restr /= psb_none_) then
call psb_errpush(psb_err_internal_error_,name,a_err='Invalid mld_sub_restr_')
call psb_errpush(psb_err_internal_error_,name,&
& a_err='Invalid mld_sub_restr_')
goto 9999
end if
@ -438,7 +450,7 @@ subroutine mld_z_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
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

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

@ -36,8 +36,8 @@
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
subroutine mld_z_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps,work,info)
subroutine mld_z_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,&
& sweeps,work,info)
use psb_base_mod
use mld_z_as_smoother, mld_protect_nam => mld_z_as_smoother_apply_vect
implicit none
@ -45,17 +45,17 @@ subroutine mld_z_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps
class(mld_z_as_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, nrow_d, i
integer(psb_ipk_) :: n_row,n_col, nrow_d, i
complex(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:)
complex(psb_dpk_), allocatable :: vx(:)
type(psb_z_vect_type) :: vtx, vty, vww
integer :: ictxt,np,me, err_act,isz,int_err(5)
integer(psb_ipk_) :: ictxt,np,me, err_act,isz,int_err(5)
character :: trans_
character(len=20) :: name='z_as_smoother_apply', ch_err
@ -96,7 +96,8 @@ subroutine mld_z_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps
aux => work(1:)
allocate(ww(isz),tx(isz),ty(isz),stat=info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_request_,name,i_err=(/3*isz,0,0,0,0/),&
call psb_errpush(psb_err_alloc_request_,name,&
& i_err=(/3*isz,izero,izero,izero,izero/),&
& a_err='complex(psb_dpk_)')
goto 9999
end if
@ -106,7 +107,8 @@ subroutine mld_z_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps
ty => work(2*isz+1:3*isz)
allocate(aux(4*isz),stat=info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_request_,name,i_err=(/4*isz,0,0,0,0/),&
call psb_errpush(psb_err_alloc_request_,name,&
& i_err=(/4*isz,izero,izero,izero,izero/),&
& a_err='complex(psb_dpk_)')
goto 9999
end if
@ -114,7 +116,8 @@ subroutine mld_z_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps
allocate(ww(isz),tx(isz),ty(isz),&
&aux(4*isz),stat=info)
if (info /= psb_success_) then
call psb_errpush(psb_err_alloc_request_,name,i_err=(/4*isz,0,0,0,0/),&
call psb_errpush(psb_err_alloc_request_,name,&
& i_err=(/4*isz,izero,izero,izero,izero/),&
& a_err='complex(psb_dpk_)')
goto 9999
end if
@ -202,7 +205,7 @@ subroutine mld_z_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps
! (hence only scaling), then we do the halo
!
call psb_ovrl(vtx,sm%desc_data,info,&
& update=psb_avg_,work=aux,mode=0)
& update=psb_avg_,work=aux,mode=izero)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_ovrl'
@ -353,7 +356,7 @@ subroutine mld_z_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps
! (hence only scaling), then we do the halo
!
call psb_ovrl(vtx,sm%desc_data,info,&
& update=psb_avg_,work=aux,mode=0)
& update=psb_avg_,work=aux,mode=izero)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_ovrl'
@ -463,7 +466,7 @@ subroutine mld_z_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps
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

17
mlprec/impl/smoother/mld_z_as_smoother_bld.f90
Unescape Escape View File

@ -43,20 +43,20 @@ subroutine mld_z_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold)
Implicit None
! Arguments
type(psb_zspmat_type), intent(in), target :: a
type(psb_zspmat_type), intent(in), target :: a
Type(psb_desc_type), Intent(in) :: desc_a
class(mld_z_as_smoother_type), intent(inout) :: sm
class(mld_z_as_smoother_type), intent(inout) :: sm
character, intent(in) :: upd
integer, intent(out) :: info
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
type(psb_zspmat_type) :: blck, atmp
integer :: n_row,n_col, nrow_a, nhalo, novr, data_, nzeros
integer(psb_ipk_) :: n_row,n_col, nrow_a, nhalo, novr, data_, 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_as_smoother_bld', ch_err
integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='z_as_smoother_bld', ch_err
info=psb_success_
call psb_erractionsave(err_act)
@ -71,7 +71,8 @@ subroutine mld_z_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold)
novr = sm%novr
if (novr < 0) then
info=psb_err_invalid_ovr_num_
call psb_errpush(info,name,i_err=(/novr,0,0,0,0,0/))
call psb_errpush(info,name,&
& i_err=(/novr,izero,izero,izero,izero,izero/))
goto 9999
endif
@ -91,7 +92,7 @@ subroutine mld_z_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold)
& write(debug_unit,*) me,' ',trim(name),&
& 'Early return: P>=3 N_OVR=0'
endif
call blck%csall(0,0,info,1)
call blck%csall(izero,izero,info,ione)
else
If (psb_toupper(upd) == 'F') Then

7
mlprec/impl/smoother/mld_z_as_smoother_check.f90
Unescape Escape View File

@ -38,7 +38,6 @@
!!$
subroutine mld_z_as_smoother_check(sm,info)
use psb_base_mod
use mld_z_as_smoother, mld_protect_nam => mld_z_as_smoother_check
@ -46,8 +45,8 @@ subroutine mld_z_as_smoother_check(sm,info)
! Arguments
class(mld_z_as_smoother_type), intent(inout) :: sm
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(out) :: info
Integer(Psb_ipk_) :: err_act
character(len=20) :: name='z_as_smoother_check'
call psb_erractionsave(err_act)
@ -58,7 +57,7 @@ subroutine mld_z_as_smoother_check(sm,info)
call mld_check_def(sm%prol,&
& 'Prolongator',psb_none_,is_legal_prolong)
call mld_check_def(sm%novr,&
& 'Overlap layers ',0,is_legal_n_ovr)
& 'Overlap layers ',izero,is_legal_n_ovr)
if (allocated(sm%sv)) then

8
mlprec/impl/smoother/mld_z_as_smoother_dmp.f90
Unescape Escape View File

@ -42,12 +42,12 @@ subroutine mld_z_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver
use mld_z_as_smoother, mld_protect_nam => mld_z_as_smoother_dmp
implicit none
class(mld_z_as_smoother_type), intent(in) :: sm
integer, intent(in) :: ictxt,level
integer, intent(out) :: info
integer(psb_ipk_), intent(in) :: ictxt,level
integer(psb_ipk_), intent(out) :: info
character(len=*), intent(in), optional :: prefix, head
logical, optional, intent(in) :: smoother, solver
integer :: i, j, il1, iln, lname, lev
integer :: icontxt,iam, np
integer(psb_ipk_) :: i, j, il1, iln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np
character(len=80) :: prefix_
character(len=120) :: fname ! len should be at least 20 more than
logical :: smoother_

4
mlprec/impl/smoother/mld_z_as_smoother_free.f90
Unescape Escape View File

@ -43,8 +43,8 @@ subroutine mld_z_as_smoother_free(sm,info)
Implicit None
! Arguments
class(mld_z_as_smoother_type), intent(inout) :: sm
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='z_as_smoother_free'
call psb_erractionsave(err_act)

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

@ -43,11 +43,11 @@ subroutine mld_z_as_smoother_setc(sm,what,val,info)
Implicit None
! Arguments
class(mld_z_as_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act, ival
character(len=20) :: name='z_as_smoother_setc'
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act, ival
character(len=20) :: name='z_as_smoother_setc'
info = psb_success_
call psb_erractionsave(err_act)

8
mlprec/impl/smoother/mld_z_as_smoother_seti.f90
Unescape Escape View File

@ -44,10 +44,10 @@ subroutine mld_z_as_smoother_seti(sm,what,val,info)
! Arguments
class(mld_z_as_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
integer, intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
integer(psb_ipk_), intent(in) :: what
integer(psb_ipk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='z_as_smoother_seti'
info = psb_success_

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

@ -43,11 +43,11 @@ subroutine mld_z_as_smoother_setr(sm,what,val,info)
Implicit None
! Arguments
class(mld_z_as_smoother_type), intent(inout) :: sm
integer, intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act
character(len=20) :: name='z_as_smoother_setr'
integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='z_as_smoother_setr'
call psb_erractionsave(err_act)
info = psb_success_

Write Preview
Loading…
Cancel
Save