diff --git a/mlprec/impl/smoother/mld_c_as_smoother_apply.f90 b/mlprec/impl/smoother/mld_c_as_smoother_apply.f90 index 7c7cb118..dcdd9b04 100644 --- a/mlprec/impl/smoother/mld_c_as_smoother_apply.f90 +++ b/mlprec/impl/smoother/mld_c_as_smoother_apply.f90 @@ -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 diff --git a/mlprec/impl/smoother/mld_c_as_smoother_apply_vect.f90 b/mlprec/impl/smoother/mld_c_as_smoother_apply_vect.f90 index b9645761..14c5a198 100644 --- a/mlprec/impl/smoother/mld_c_as_smoother_apply_vect.f90 +++ b/mlprec/impl/smoother/mld_c_as_smoother_apply_vect.f90 @@ -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 diff --git a/mlprec/impl/smoother/mld_c_as_smoother_bld.f90 b/mlprec/impl/smoother/mld_c_as_smoother_bld.f90 index f22a5c1e..9c54e586 100644 --- a/mlprec/impl/smoother/mld_c_as_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_c_as_smoother_bld.f90 @@ -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 diff --git a/mlprec/impl/smoother/mld_c_as_smoother_check.f90 b/mlprec/impl/smoother/mld_c_as_smoother_check.f90 index 29ff73b7..46fe001c 100644 --- a/mlprec/impl/smoother/mld_c_as_smoother_check.f90 +++ b/mlprec/impl/smoother/mld_c_as_smoother_check.f90 @@ -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 diff --git a/mlprec/impl/smoother/mld_c_as_smoother_dmp.f90 b/mlprec/impl/smoother/mld_c_as_smoother_dmp.f90 index aa2edec4..8abac7c3 100644 --- a/mlprec/impl/smoother/mld_c_as_smoother_dmp.f90 +++ b/mlprec/impl/smoother/mld_c_as_smoother_dmp.f90 @@ -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_ diff --git a/mlprec/impl/smoother/mld_c_as_smoother_free.f90 b/mlprec/impl/smoother/mld_c_as_smoother_free.f90 index 4383d264..712e0da1 100644 --- a/mlprec/impl/smoother/mld_c_as_smoother_free.f90 +++ b/mlprec/impl/smoother/mld_c_as_smoother_free.f90 @@ -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) diff --git a/mlprec/impl/smoother/mld_c_as_smoother_setc.f90 b/mlprec/impl/smoother/mld_c_as_smoother_setc.f90 index 016ad927..a6f7ae71 100644 --- a/mlprec/impl/smoother/mld_c_as_smoother_setc.f90 +++ b/mlprec/impl/smoother/mld_c_as_smoother_setc.f90 @@ -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) diff --git a/mlprec/impl/smoother/mld_c_as_smoother_seti.f90 b/mlprec/impl/smoother/mld_c_as_smoother_seti.f90 index be74fed6..b7c2d328 100644 --- a/mlprec/impl/smoother/mld_c_as_smoother_seti.f90 +++ b/mlprec/impl/smoother/mld_c_as_smoother_seti.f90 @@ -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_ diff --git a/mlprec/impl/smoother/mld_c_as_smoother_setr.f90 b/mlprec/impl/smoother/mld_c_as_smoother_setr.f90 index aa7b8923..706f5d8f 100644 --- a/mlprec/impl/smoother/mld_c_as_smoother_setr.f90 +++ b/mlprec/impl/smoother/mld_c_as_smoother_setr.f90 @@ -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_ diff --git a/mlprec/impl/smoother/mld_d_as_smoother_apply.f90 b/mlprec/impl/smoother/mld_d_as_smoother_apply.f90 index 1e9ddbd4..81ff59db 100644 --- a/mlprec/impl/smoother/mld_d_as_smoother_apply.f90 +++ b/mlprec/impl/smoother/mld_d_as_smoother_apply.f90 @@ -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 diff --git a/mlprec/impl/smoother/mld_d_as_smoother_apply_vect.f90 b/mlprec/impl/smoother/mld_d_as_smoother_apply_vect.f90 index d80adf63..4dfe7be5 100644 --- a/mlprec/impl/smoother/mld_d_as_smoother_apply_vect.f90 +++ b/mlprec/impl/smoother/mld_d_as_smoother_apply_vect.f90 @@ -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 diff --git a/mlprec/impl/smoother/mld_d_as_smoother_bld.f90 b/mlprec/impl/smoother/mld_d_as_smoother_bld.f90 index da7e31fe..bc3d0336 100644 --- a/mlprec/impl/smoother/mld_d_as_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_d_as_smoother_bld.f90 @@ -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 diff --git a/mlprec/impl/smoother/mld_d_as_smoother_check.f90 b/mlprec/impl/smoother/mld_d_as_smoother_check.f90 index 763353e6..9e5d4674 100644 --- a/mlprec/impl/smoother/mld_d_as_smoother_check.f90 +++ b/mlprec/impl/smoother/mld_d_as_smoother_check.f90 @@ -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 diff --git a/mlprec/impl/smoother/mld_d_as_smoother_dmp.f90 b/mlprec/impl/smoother/mld_d_as_smoother_dmp.f90 index 4aa7a6f5..f87c64e7 100644 --- a/mlprec/impl/smoother/mld_d_as_smoother_dmp.f90 +++ b/mlprec/impl/smoother/mld_d_as_smoother_dmp.f90 @@ -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_ diff --git a/mlprec/impl/smoother/mld_d_as_smoother_free.f90 b/mlprec/impl/smoother/mld_d_as_smoother_free.f90 index 34c154e3..a6f881f0 100644 --- a/mlprec/impl/smoother/mld_d_as_smoother_free.f90 +++ b/mlprec/impl/smoother/mld_d_as_smoother_free.f90 @@ -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) diff --git a/mlprec/impl/smoother/mld_d_as_smoother_setc.f90 b/mlprec/impl/smoother/mld_d_as_smoother_setc.f90 index 13e8ceb1..5204c52c 100644 --- a/mlprec/impl/smoother/mld_d_as_smoother_setc.f90 +++ b/mlprec/impl/smoother/mld_d_as_smoother_setc.f90 @@ -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) diff --git a/mlprec/impl/smoother/mld_d_as_smoother_seti.f90 b/mlprec/impl/smoother/mld_d_as_smoother_seti.f90 index 0694774b..ee1ebaa2 100644 --- a/mlprec/impl/smoother/mld_d_as_smoother_seti.f90 +++ b/mlprec/impl/smoother/mld_d_as_smoother_seti.f90 @@ -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_ diff --git a/mlprec/impl/smoother/mld_d_as_smoother_setr.f90 b/mlprec/impl/smoother/mld_d_as_smoother_setr.f90 index e1a72b90..3f73ab7e 100644 --- a/mlprec/impl/smoother/mld_d_as_smoother_setr.f90 +++ b/mlprec/impl/smoother/mld_d_as_smoother_setr.f90 @@ -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_ diff --git a/mlprec/impl/smoother/mld_s_as_smoother_apply.f90 b/mlprec/impl/smoother/mld_s_as_smoother_apply.f90 index 58168622..a4c46cf1 100644 --- a/mlprec/impl/smoother/mld_s_as_smoother_apply.f90 +++ b/mlprec/impl/smoother/mld_s_as_smoother_apply.f90 @@ -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 diff --git a/mlprec/impl/smoother/mld_s_as_smoother_apply_vect.f90 b/mlprec/impl/smoother/mld_s_as_smoother_apply_vect.f90 index fe4d14aa..266e2b3a 100644 --- a/mlprec/impl/smoother/mld_s_as_smoother_apply_vect.f90 +++ b/mlprec/impl/smoother/mld_s_as_smoother_apply_vect.f90 @@ -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 diff --git a/mlprec/impl/smoother/mld_s_as_smoother_bld.f90 b/mlprec/impl/smoother/mld_s_as_smoother_bld.f90 index e3d82040..81d9e697 100644 --- a/mlprec/impl/smoother/mld_s_as_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_s_as_smoother_bld.f90 @@ -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 diff --git a/mlprec/impl/smoother/mld_s_as_smoother_check.f90 b/mlprec/impl/smoother/mld_s_as_smoother_check.f90 index 0559f4e0..0eb1484f 100644 --- a/mlprec/impl/smoother/mld_s_as_smoother_check.f90 +++ b/mlprec/impl/smoother/mld_s_as_smoother_check.f90 @@ -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 diff --git a/mlprec/impl/smoother/mld_s_as_smoother_dmp.f90 b/mlprec/impl/smoother/mld_s_as_smoother_dmp.f90 index e11fc6f5..a5e31c74 100644 --- a/mlprec/impl/smoother/mld_s_as_smoother_dmp.f90 +++ b/mlprec/impl/smoother/mld_s_as_smoother_dmp.f90 @@ -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_ diff --git a/mlprec/impl/smoother/mld_s_as_smoother_free.f90 b/mlprec/impl/smoother/mld_s_as_smoother_free.f90 index fb61f6aa..1d67b5d1 100644 --- a/mlprec/impl/smoother/mld_s_as_smoother_free.f90 +++ b/mlprec/impl/smoother/mld_s_as_smoother_free.f90 @@ -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) diff --git a/mlprec/impl/smoother/mld_s_as_smoother_setc.f90 b/mlprec/impl/smoother/mld_s_as_smoother_setc.f90 index fea75bd6..200f1f91 100644 --- a/mlprec/impl/smoother/mld_s_as_smoother_setc.f90 +++ b/mlprec/impl/smoother/mld_s_as_smoother_setc.f90 @@ -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) diff --git a/mlprec/impl/smoother/mld_s_as_smoother_seti.f90 b/mlprec/impl/smoother/mld_s_as_smoother_seti.f90 index 16920d7d..c0bfac0e 100644 --- a/mlprec/impl/smoother/mld_s_as_smoother_seti.f90 +++ b/mlprec/impl/smoother/mld_s_as_smoother_seti.f90 @@ -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_ diff --git a/mlprec/impl/smoother/mld_s_as_smoother_setr.f90 b/mlprec/impl/smoother/mld_s_as_smoother_setr.f90 index 5819a628..10f3f3d7 100644 --- a/mlprec/impl/smoother/mld_s_as_smoother_setr.f90 +++ b/mlprec/impl/smoother/mld_s_as_smoother_setr.f90 @@ -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_ diff --git a/mlprec/impl/smoother/mld_z_as_smoother_apply.f90 b/mlprec/impl/smoother/mld_z_as_smoother_apply.f90 index 7ac95274..d16a31ae 100644 --- a/mlprec/impl/smoother/mld_z_as_smoother_apply.f90 +++ b/mlprec/impl/smoother/mld_z_as_smoother_apply.f90 @@ -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 diff --git a/mlprec/impl/smoother/mld_z_as_smoother_apply_vect.f90 b/mlprec/impl/smoother/mld_z_as_smoother_apply_vect.f90 index 81a1f357..64e1c518 100644 --- a/mlprec/impl/smoother/mld_z_as_smoother_apply_vect.f90 +++ b/mlprec/impl/smoother/mld_z_as_smoother_apply_vect.f90 @@ -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 diff --git a/mlprec/impl/smoother/mld_z_as_smoother_bld.f90 b/mlprec/impl/smoother/mld_z_as_smoother_bld.f90 index 48ca3829..9b672e81 100644 --- a/mlprec/impl/smoother/mld_z_as_smoother_bld.f90 +++ b/mlprec/impl/smoother/mld_z_as_smoother_bld.f90 @@ -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 diff --git a/mlprec/impl/smoother/mld_z_as_smoother_check.f90 b/mlprec/impl/smoother/mld_z_as_smoother_check.f90 index 59dcbbd4..2f81c353 100644 --- a/mlprec/impl/smoother/mld_z_as_smoother_check.f90 +++ b/mlprec/impl/smoother/mld_z_as_smoother_check.f90 @@ -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 diff --git a/mlprec/impl/smoother/mld_z_as_smoother_dmp.f90 b/mlprec/impl/smoother/mld_z_as_smoother_dmp.f90 index d726c10b..c1956625 100644 --- a/mlprec/impl/smoother/mld_z_as_smoother_dmp.f90 +++ b/mlprec/impl/smoother/mld_z_as_smoother_dmp.f90 @@ -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_ diff --git a/mlprec/impl/smoother/mld_z_as_smoother_free.f90 b/mlprec/impl/smoother/mld_z_as_smoother_free.f90 index 43ae4a6e..69588d19 100644 --- a/mlprec/impl/smoother/mld_z_as_smoother_free.f90 +++ b/mlprec/impl/smoother/mld_z_as_smoother_free.f90 @@ -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) diff --git a/mlprec/impl/smoother/mld_z_as_smoother_setc.f90 b/mlprec/impl/smoother/mld_z_as_smoother_setc.f90 index 44102c61..97cc59d6 100644 --- a/mlprec/impl/smoother/mld_z_as_smoother_setc.f90 +++ b/mlprec/impl/smoother/mld_z_as_smoother_setc.f90 @@ -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) diff --git a/mlprec/impl/smoother/mld_z_as_smoother_seti.f90 b/mlprec/impl/smoother/mld_z_as_smoother_seti.f90 index a7fc4ac8..739a7f00 100644 --- a/mlprec/impl/smoother/mld_z_as_smoother_seti.f90 +++ b/mlprec/impl/smoother/mld_z_as_smoother_seti.f90 @@ -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_ diff --git a/mlprec/impl/smoother/mld_z_as_smoother_setr.f90 b/mlprec/impl/smoother/mld_z_as_smoother_setr.f90 index 29229f2b..53215570 100644 --- a/mlprec/impl/smoother/mld_z_as_smoother_setr.f90 +++ b/mlprec/impl/smoother/mld_z_as_smoother_setr.f90 @@ -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_