mld2p4-2:

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

@ -47,13 +47,13 @@ subroutine mld_c_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
complex(psb_spk_),intent(inout) :: y(:)
complex(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps
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

@ -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
@ -47,15 +47,15 @@ subroutine mld_c_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps
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
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(:)
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

@ -47,15 +47,15 @@ subroutine mld_c_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold)
Type(psb_desc_type), Intent(in) :: desc_a
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
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_
@ -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

@ -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

@ -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_

@ -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)

@ -43,10 +43,10 @@ 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
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act, ival
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act, ival
character(len=20) :: name='c_as_smoother_setc'
info = psb_success_

@ -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_

@ -43,10 +43,10 @@ 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
integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val
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_setr'
call psb_erractionsave(err_act)

@ -47,13 +47,13 @@ subroutine mld_d_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
real(psb_dpk_),intent(inout) :: y(:)
real(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps
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

@ -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
@ -47,15 +47,15 @@ subroutine mld_d_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps
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
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(:)
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

@ -47,15 +47,15 @@ subroutine mld_d_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold)
Type(psb_desc_type), Intent(in) :: desc_a
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
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_
@ -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

@ -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

@ -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_

@ -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)

@ -43,10 +43,10 @@ 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
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act, ival
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act, ival
character(len=20) :: name='d_as_smoother_setc'
info = psb_success_

@ -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_

@ -43,10 +43,10 @@ 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
integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val
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_setr'
call psb_erractionsave(err_act)

@ -47,13 +47,13 @@ subroutine mld_s_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
real(psb_spk_),intent(inout) :: y(:)
real(psb_spk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps
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

@ -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
@ -47,15 +47,15 @@ subroutine mld_s_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps
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
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(:)
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

@ -47,15 +47,15 @@ subroutine mld_s_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold)
Type(psb_desc_type), Intent(in) :: desc_a
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
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_
@ -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

@ -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

@ -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_

@ -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)

@ -43,10 +43,10 @@ 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
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act, ival
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act, ival
character(len=20) :: name='s_as_smoother_setc'
info = psb_success_

@ -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_

@ -43,10 +43,10 @@ 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
integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val
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_setr'
call psb_erractionsave(err_act)

@ -47,13 +47,13 @@ subroutine mld_z_as_smoother_apply(alpha,sm,x,beta,y,desc_data,trans,sweeps,work
complex(psb_dpk_),intent(inout) :: y(:)
complex(psb_dpk_),intent(in) :: alpha,beta
character(len=1),intent(in) :: trans
integer, intent(in) :: sweeps
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

@ -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
@ -47,15 +47,15 @@ subroutine mld_z_as_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,sweeps
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
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(:)
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

@ -47,15 +47,15 @@ subroutine mld_z_as_smoother_bld(a,desc_a,sm,upd,info,amold,vmold)
Type(psb_desc_type), Intent(in) :: desc_a
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
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_
@ -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

@ -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

@ -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_

@ -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)

@ -43,10 +43,10 @@ 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
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer, intent(out) :: info
Integer :: err_act, ival
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act, ival
character(len=20) :: name='z_as_smoother_setc'
info = psb_success_

@ -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_

@ -43,10 +43,10 @@ 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
integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val
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_setr'
call psb_erractionsave(err_act)

Loading…
Cancel
Save