diff --git a/mlprec/impl/solver/mld_c_base_solver_apply.f90 b/mlprec/impl/solver/mld_c_base_solver_apply.f90 index ff5d6830..793c0d01 100644 --- a/mlprec/impl/solver/mld_c_base_solver_apply.f90 +++ b/mlprec/impl/solver/mld_c_base_solver_apply.f90 @@ -41,17 +41,17 @@ subroutine mld_c_base_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) use psb_base_mod use mld_c_base_solver_mod, mld_protect_name => mld_c_base_solver_apply implicit none - type(psb_desc_type), intent(in) :: desc_data + type(psb_desc_type), intent(in) :: desc_data class(mld_c_base_solver_type), intent(in) :: sv 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 + character(len=1),intent(in) :: trans complex(psb_spk_),target, intent(inout) :: work(:) - integer, intent(out) :: info + integer(psb_ipk_), intent(out) :: info - Integer :: err_act - character(len=20) :: name='d_base_solver_apply' + integer(psb_ipk_) :: err_act + character(len=20) :: name='d_base_solver_apply' call psb_erractionsave(err_act) diff --git a/mlprec/impl/solver/mld_c_base_solver_apply_vect.f90 b/mlprec/impl/solver/mld_c_base_solver_apply_vect.f90 index fb74bffe..02e9c061 100644 --- a/mlprec/impl/solver/mld_c_base_solver_apply_vect.f90 +++ b/mlprec/impl/solver/mld_c_base_solver_apply_vect.f90 @@ -41,17 +41,17 @@ subroutine mld_c_base_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,i use psb_base_mod use mld_c_base_solver_mod, mld_protect_name => mld_c_base_solver_apply_vect implicit none - type(psb_desc_type), intent(in) :: desc_data + type(psb_desc_type), intent(in) :: desc_data class(mld_c_base_solver_type), intent(inout) :: sv 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 - complex(psb_spk_),target, intent(inout) :: work(:) - integer, intent(out) :: info + complex(psb_spk_),intent(in) :: alpha,beta + character(len=1),intent(in) :: trans + complex(psb_spk_),target, intent(inout) :: work(:) + integer(psb_ipk_), intent(out) :: info - Integer :: err_act - character(len=20) :: name='d_base_solver_apply' + integer(psb_ipk_) :: err_act + character(len=20) :: name='d_base_solver_apply' call psb_erractionsave(err_act) diff --git a/mlprec/impl/solver/mld_c_base_solver_bld.f90 b/mlprec/impl/solver/mld_c_base_solver_bld.f90 index 0ba03dc0..47fa5405 100644 --- a/mlprec/impl/solver/mld_c_base_solver_bld.f90 +++ b/mlprec/impl/solver/mld_c_base_solver_bld.f90 @@ -43,16 +43,16 @@ subroutine mld_c_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) Implicit None ! Arguments type(psb_cspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_c_base_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer, intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_cspmat_type), intent(in), target, optional :: b class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_vect_type), intent(in), optional :: vmold - Integer :: err_act - character(len=20) :: name='d_base_solver_bld' + integer(psb_ipk_) :: err_act + character(len=20) :: name='d_base_solver_bld' call psb_erractionsave(err_act) diff --git a/mlprec/impl/solver/mld_c_base_solver_check.f90 b/mlprec/impl/solver/mld_c_base_solver_check.f90 index fe57a26a..62bd4e89 100644 --- a/mlprec/impl/solver/mld_c_base_solver_check.f90 +++ b/mlprec/impl/solver/mld_c_base_solver_check.f90 @@ -43,8 +43,8 @@ subroutine mld_c_base_solver_check(sv,info) Implicit None ! Arguments class(mld_c_base_solver_type), intent(inout) :: sv - integer, intent(out) :: info - Integer :: err_act + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: err_act character(len=20) :: name='d_base_solver_check' call psb_erractionsave(err_act) diff --git a/mlprec/impl/solver/mld_c_base_solver_descr.f90 b/mlprec/impl/solver/mld_c_base_solver_descr.f90 index ca9bb90a..b8cfae50 100644 --- a/mlprec/impl/solver/mld_c_base_solver_descr.f90 +++ b/mlprec/impl/solver/mld_c_base_solver_descr.f90 @@ -43,15 +43,13 @@ subroutine mld_c_base_solver_descr(sv,info,iout,coarse) Implicit None ! Arguments class(mld_c_base_solver_type), intent(in) :: sv - integer, intent(out) :: info - integer, intent(in), optional :: iout - logical, intent(in), optional :: coarse + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse ! Local variables - integer :: err_act - integer :: ictxt, me, np + integer(psb_ipk_) :: err_act character(len=20), parameter :: name='mld_c_base_solver_descr' - integer :: iout_ call psb_erractionsave(err_act) diff --git a/mlprec/impl/solver/mld_c_base_solver_dmp.f90 b/mlprec/impl/solver/mld_c_base_solver_dmp.f90 index f595bae0..43133c4f 100644 --- a/mlprec/impl/solver/mld_c_base_solver_dmp.f90 +++ b/mlprec/impl/solver/mld_c_base_solver_dmp.f90 @@ -42,12 +42,12 @@ subroutine mld_c_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver) use mld_c_base_solver_mod, mld_protect_name => mld_c_base_solver_dmp implicit none class(mld_c_base_solver_type), intent(in) :: sv - integer, intent(in) :: ictxt,level - integer, intent(out) :: info - character(len=*), intent(in), optional :: prefix, head + integer(psb_ipk_), intent(in) :: ictxt,level + integer(psb_ipk_), intent(out) :: info + character(len=*), intent(in), optional :: prefix, head logical, optional, intent(in) :: 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 :: solver_ diff --git a/mlprec/impl/solver/mld_c_base_solver_free.f90 b/mlprec/impl/solver/mld_c_base_solver_free.f90 index 9925fd1e..453b5803 100644 --- a/mlprec/impl/solver/mld_c_base_solver_free.f90 +++ b/mlprec/impl/solver/mld_c_base_solver_free.f90 @@ -43,8 +43,8 @@ subroutine mld_c_base_solver_free(sv,info) Implicit None ! Arguments class(mld_c_base_solver_type), intent(inout) :: sv - integer, intent(out) :: info - Integer :: err_act + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: err_act character(len=20) :: name='d_base_solver_free' call psb_erractionsave(err_act) diff --git a/mlprec/impl/solver/mld_c_base_solver_setc.f90 b/mlprec/impl/solver/mld_c_base_solver_setc.f90 index e47276c9..8b28de71 100644 --- a/mlprec/impl/solver/mld_c_base_solver_setc.f90 +++ b/mlprec/impl/solver/mld_c_base_solver_setc.f90 @@ -43,10 +43,10 @@ subroutine mld_c_base_solver_setc(sv,what,val,info) Implicit None ! Arguments class(mld_c_base_solver_type), intent(inout) :: sv - integer, intent(in) :: what - character(len=*), intent(in) :: val - integer, intent(out) :: info - Integer :: err_act, ival + 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_base_solver_setc' call psb_erractionsave(err_act) diff --git a/mlprec/impl/solver/mld_c_base_solver_seti.f90 b/mlprec/impl/solver/mld_c_base_solver_seti.f90 index 5210679b..66b4900b 100644 --- a/mlprec/impl/solver/mld_c_base_solver_seti.f90 +++ b/mlprec/impl/solver/mld_c_base_solver_seti.f90 @@ -43,10 +43,10 @@ subroutine mld_c_base_solver_seti(sv,what,val,info) Implicit None ! Arguments class(mld_c_base_solver_type), intent(inout) :: sv - 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_base_solver_seti' ! Correct action here is doing nothing. diff --git a/mlprec/impl/solver/mld_c_base_solver_setr.f90 b/mlprec/impl/solver/mld_c_base_solver_setr.f90 index 96daa62d..d72f0357 100644 --- a/mlprec/impl/solver/mld_c_base_solver_setr.f90 +++ b/mlprec/impl/solver/mld_c_base_solver_setr.f90 @@ -43,10 +43,10 @@ subroutine mld_c_base_solver_setr(sv,what,val,info) Implicit None ! Arguments class(mld_c_base_solver_type), intent(inout) :: sv - integer, intent(in) :: what - real(psb_spk_), intent(in) :: val - integer, intent(out) :: info - Integer :: err_act + 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='d_base_solver_setr' diff --git a/mlprec/impl/solver/mld_c_diag_solver_apply.f90 b/mlprec/impl/solver/mld_c_diag_solver_apply.f90 index 8b56e839..5151dbef 100644 --- a/mlprec/impl/solver/mld_c_diag_solver_apply.f90 +++ b/mlprec/impl/solver/mld_c_diag_solver_apply.f90 @@ -46,13 +46,13 @@ subroutine mld_c_diag_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) 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 + character(len=1),intent(in) :: trans complex(psb_spk_),target, intent(inout) :: work(:) - integer, intent(out) :: info + integer(psb_ipk_), intent(out) :: info - integer :: n_row,n_col + integer(psb_ipk_) :: n_row,n_col complex(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) - integer :: ictxt,np,me,i, err_act + integer(psb_ipk_) :: ictxt,np,me,i, err_act character :: trans_ character(len=20) :: name='c_diag_solver_apply' diff --git a/mlprec/impl/solver/mld_c_diag_solver_apply_vect.f90 b/mlprec/impl/solver/mld_c_diag_solver_apply_vect.f90 index 1f8ac185..6263db58 100644 --- a/mlprec/impl/solver/mld_c_diag_solver_apply_vect.f90 +++ b/mlprec/impl/solver/mld_c_diag_solver_apply_vect.f90 @@ -41,18 +41,18 @@ subroutine mld_c_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,i use psb_base_mod use mld_c_diag_solver, mld_protect_name => mld_c_diag_solver_apply_vect implicit none - type(psb_desc_type), intent(in) :: desc_data + type(psb_desc_type), intent(in) :: desc_data class(mld_c_diag_solver_type), intent(inout) :: sv 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 - complex(psb_spk_),target, intent(inout) :: work(:) - integer, intent(out) :: info + complex(psb_spk_),intent(in) :: alpha,beta + character(len=1),intent(in) :: trans + complex(psb_spk_),target, intent(inout) :: work(:) + integer(psb_ipk_), intent(out) :: info - integer :: n_row,n_col + integer(psb_ipk_) :: n_row,n_col complex(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) - integer :: ictxt,np,me,i, err_act + integer(psb_ipk_) :: ictxt,np,me,i, err_act character :: trans_ character(len=20) :: name='c_diag_solver_apply' @@ -73,12 +73,14 @@ subroutine mld_c_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,i n_col = desc_data%get_local_cols() if (x%get_nrows() < n_row) then info = 36 - call psb_errpush(info,name,i_err=(/2,n_row,0,0,0/)) + call psb_errpush(info,name,& + & i_err=(/itwo,n_row,izero,izero,izero/)) goto 9999 end if if (y%get_nrows() < n_row) then info = 36 - call psb_errpush(info,name,i_err=(/3,n_row,0,0,0/)) + call psb_errpush(info,name,& + & i_err=(/ithree,n_row,izero,izero,izero/)) goto 9999 end if if (.not.allocated(sv%dv)) then diff --git a/mlprec/impl/solver/mld_c_diag_solver_bld.f90 b/mlprec/impl/solver/mld_c_diag_solver_bld.f90 index db3dff15..7ae79afa 100644 --- a/mlprec/impl/solver/mld_c_diag_solver_bld.f90 +++ b/mlprec/impl/solver/mld_c_diag_solver_bld.f90 @@ -45,18 +45,18 @@ subroutine mld_c_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) ! Arguments type(psb_cspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_c_diag_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer, intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_cspmat_type), intent(in), target, optional :: b class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_vect_type), intent(in), optional :: vmold ! Local variables - integer :: n_row,n_col, nrow_a, nztota + integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota complex(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) - integer :: ictxt,np,me,i, err_act, debug_unit, debug_level - character(len=20) :: name='c_diag_solver_bld', ch_err + integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level + character(len=20) :: name='c_diag_solver_bld', ch_err info=psb_success_ call psb_erractionsave(err_act) @@ -111,7 +111,8 @@ subroutine mld_c_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) if (info == psb_success_) then call sv%dv%bld(sv%d) else - call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate sv%dv') + call psb_errpush(psb_err_from_subroutine_,name,& + & a_err='Allocate sv%dv') goto 9999 end if diff --git a/mlprec/impl/solver/mld_c_id_solver_apply.f90 b/mlprec/impl/solver/mld_c_id_solver_apply.f90 index adbc5811..1b676de0 100644 --- a/mlprec/impl/solver/mld_c_id_solver_apply.f90 +++ b/mlprec/impl/solver/mld_c_id_solver_apply.f90 @@ -36,50 +36,50 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ - subroutine mld_c_id_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) - - use psb_base_mod - use mld_c_id_solver, mld_protect_name => mld_c_id_solver_apply - implicit none - type(psb_desc_type), intent(in) :: desc_data - class(mld_c_id_solver_type), intent(in) :: sv - 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 - complex(psb_spk_),target, intent(inout) :: work(:) - integer, intent(out) :: info +subroutine mld_c_id_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) - integer :: n_row,n_col - integer :: ictxt,np,me,i, err_act - character :: trans_ - character(len=20) :: name='c_id_solver_apply' + use psb_base_mod + use mld_c_id_solver, mld_protect_name => mld_c_id_solver_apply + implicit none + type(psb_desc_type), intent(in) :: desc_data + class(mld_c_id_solver_type), intent(in) :: sv + 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 + complex(psb_spk_),target, intent(inout) :: work(:) + integer(psb_ipk_), intent(out) :: info - call psb_erractionsave(err_act) + integer(psb_ipk_) :: n_row,n_col + integer(psb_ipk_) :: ictxt,np,me,i, err_act + character :: trans_ + character(len=20) :: name='c_id_solver_apply' - info = psb_success_ + call psb_erractionsave(err_act) - trans_ = psb_toupper(trans) - select case(trans_) - case('N') - case('T') - case('C') - case default - call psb_errpush(psb_err_iarg_invalid_i_,name) - goto 9999 - end select + info = psb_success_ - call psb_geaxpby(alpha,x,beta,y,desc_data,info) + trans_ = psb_toupper(trans) + select case(trans_) + case('N') + case('T') + case('C') + case default + call psb_errpush(psb_err_iarg_invalid_i_,name) + goto 9999 + end select - call psb_erractionrestore(err_act) - return + call psb_geaxpby(alpha,x,beta,y,desc_data,info) + + call psb_erractionrestore(err_act) + return 9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() return + end if + return - end subroutine mld_c_id_solver_apply +end subroutine mld_c_id_solver_apply diff --git a/mlprec/impl/solver/mld_c_id_solver_apply_vect.f90 b/mlprec/impl/solver/mld_c_id_solver_apply_vect.f90 index 77777263..aa21389a 100644 --- a/mlprec/impl/solver/mld_c_id_solver_apply_vect.f90 +++ b/mlprec/impl/solver/mld_c_id_solver_apply_vect.f90 @@ -36,50 +36,50 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ - subroutine mld_c_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info) - - use psb_base_mod - use mld_c_id_solver, mld_protect_name => mld_c_id_solver_apply_vect - implicit none - type(psb_desc_type), intent(in) :: desc_data - class(mld_c_id_solver_type), intent(inout) :: sv - 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 - complex(psb_spk_),target, intent(inout) :: work(:) - integer, intent(out) :: info +subroutine mld_c_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info) - integer :: n_row,n_col - integer :: ictxt,np,me,i, err_act - character :: trans_ - character(len=20) :: name='c_id_solver_apply_vect' + use psb_base_mod + use mld_c_id_solver, mld_protect_name => mld_c_id_solver_apply_vect + implicit none + type(psb_desc_type), intent(in) :: desc_data + class(mld_c_id_solver_type), intent(inout) :: sv + 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 + complex(psb_spk_),target, intent(inout) :: work(:) + integer(psb_ipk_), intent(out) :: info - call psb_erractionsave(err_act) + integer(psb_ipk_) :: n_row,n_col + integer(psb_ipk_) :: ictxt,np,me,i, err_act + character :: trans_ + character(len=20) :: name='c_id_solver_apply_vect' - info = psb_success_ + call psb_erractionsave(err_act) - trans_ = psb_toupper(trans) - select case(trans_) - case('N') - case('T') - case('C') - case default - call psb_errpush(psb_err_iarg_invalid_i_,name) - goto 9999 - end select + info = psb_success_ - call psb_geaxpby(alpha,x,beta,y,desc_data,info) + trans_ = psb_toupper(trans) + select case(trans_) + case('N') + case('T') + case('C') + case default + call psb_errpush(psb_err_iarg_invalid_i_,name) + goto 9999 + end select - call psb_erractionrestore(err_act) - return + call psb_geaxpby(alpha,x,beta,y,desc_data,info) + + call psb_erractionrestore(err_act) + return 9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() return + end if + return - end subroutine mld_c_id_solver_apply_vect +end subroutine mld_c_id_solver_apply_vect diff --git a/mlprec/impl/solver/mld_c_ilu_solver_apply.f90 b/mlprec/impl/solver/mld_c_ilu_solver_apply.f90 index 6e30de6b..4e338e23 100644 --- a/mlprec/impl/solver/mld_c_ilu_solver_apply.f90 +++ b/mlprec/impl/solver/mld_c_ilu_solver_apply.f90 @@ -41,18 +41,18 @@ subroutine mld_c_ilu_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) use psb_base_mod use mld_c_ilu_solver, mld_protect_name => mld_c_ilu_solver_apply implicit none - type(psb_desc_type), intent(in) :: desc_data + type(psb_desc_type), intent(in) :: desc_data class(mld_c_ilu_solver_type), intent(in) :: sv 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 + character(len=1),intent(in) :: trans complex(psb_spk_),target, intent(inout) :: work(:) - integer, intent(out) :: info + integer(psb_ipk_), intent(out) :: info - integer :: n_row,n_col + integer(psb_ipk_) :: n_row,n_col complex(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) - integer :: ictxt,np,me,i, err_act + integer(psb_ipk_) :: ictxt,np,me,i, err_act character :: trans_ character(len=20) :: name='c_ilu_solver_apply' @@ -80,7 +80,8 @@ subroutine mld_c_ilu_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) allocate(aux(4*n_col),stat=info) if (info /= psb_success_) then info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/4*n_col,0,0,0,0/),& + call psb_errpush(info,name,& + & i_err=(/4*n_col,izero,izero,izero,izero/),& & a_err='complex(psb_spk_)') goto 9999 end if @@ -89,7 +90,8 @@ subroutine mld_c_ilu_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) allocate(ww(n_col),aux(4*n_col),stat=info) if (info /= psb_success_) then info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/5*n_col,0,0,0,0/),& + call psb_errpush(info,name,& + & i_err=(/5*n_col,izero,izero,izero,izero/),& & a_err='complex(psb_spk_)') goto 9999 end if @@ -114,14 +116,16 @@ subroutine mld_c_ilu_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) if (info == psb_success_) call psb_spsm(alpha,sv%l,ww,beta,y,desc_data,info,& & trans=trans_,scale='U',choice=psb_none_,work=aux) case default - call psb_errpush(psb_err_internal_error_,name,a_err='Invalid TRANS in ILU subsolve') + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Invalid TRANS in ILU subsolve') goto 9999 end select if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,a_err='Error in subsolve') + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in subsolve') goto 9999 endif diff --git a/mlprec/impl/solver/mld_c_ilu_solver_apply_vect.f90 b/mlprec/impl/solver/mld_c_ilu_solver_apply_vect.f90 index b2936e46..ae8293c6 100644 --- a/mlprec/impl/solver/mld_c_ilu_solver_apply_vect.f90 +++ b/mlprec/impl/solver/mld_c_ilu_solver_apply_vect.f90 @@ -41,19 +41,19 @@ subroutine mld_c_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,in use psb_base_mod use mld_c_ilu_solver, mld_protect_name => mld_c_ilu_solver_apply_vect implicit none - type(psb_desc_type), intent(in) :: desc_data + type(psb_desc_type), intent(in) :: desc_data class(mld_c_ilu_solver_type), intent(inout) :: sv 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 - complex(psb_spk_),target, intent(inout) :: work(:) - integer, intent(out) :: info + complex(psb_spk_),intent(in) :: alpha,beta + character(len=1),intent(in) :: trans + complex(psb_spk_),target, intent(inout) :: work(:) + integer(psb_ipk_), intent(out) :: info - integer :: n_row,n_col - type(psb_c_vect_type) :: wv, wv1 + integer(psb_ipk_) :: n_row,n_col + type(psb_c_vect_type) :: wv, wv1 complex(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) - integer :: ictxt,np,me,i, err_act + integer(psb_ipk_) :: ictxt,np,me,i, err_act character :: trans_ character(len=20) :: name='c_ilu_solver_apply' @@ -77,12 +77,14 @@ subroutine mld_c_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,in if (x%get_nrows() < n_row) then info = 36 - call psb_errpush(info,name,i_err=(/2,n_row,0,0,0/)) + call psb_errpush(info,name,& + & i_err=(/itwo,n_row,izero,izero,izero/)) goto 9999 end if if (y%get_nrows() < n_row) then info = 36 - call psb_errpush(info,name,i_err=(/3,n_row,0,0,0/)) + call psb_errpush(info,name,& + & i_err=(/ithree,n_row,izero,izero,izero/)) goto 9999 end if if (.not.allocated(sv%dv%v)) then @@ -111,7 +113,8 @@ subroutine mld_c_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,in if (info /= psb_success_) then info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/5*n_col,0,0,0,0/),& + call psb_errpush(info,name,& + & i_err=(/5*n_col,izero,izero,izero,izero/),& & a_err='complex(psb_spk_)') goto 9999 end if @@ -144,14 +147,16 @@ subroutine mld_c_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,in & trans=trans_,scale='U',choice=psb_none_,work=aux) case default - call psb_errpush(psb_err_internal_error_,name,a_err='Invalid TRANS in ILU subsolve') + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Invalid TRANS in ILU subsolve') goto 9999 end select if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,a_err='Error in subsolve') + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in subsolve') goto 9999 endif call wv%free(info) diff --git a/mlprec/impl/solver/mld_c_ilu_solver_bld.f90 b/mlprec/impl/solver/mld_c_ilu_solver_bld.f90 index 2ac2db11..1b407a64 100644 --- a/mlprec/impl/solver/mld_c_ilu_solver_bld.f90 +++ b/mlprec/impl/solver/mld_c_ilu_solver_bld.f90 @@ -37,7 +37,6 @@ !!$ !!$ subroutine mld_c_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) - use psb_base_mod use mld_c_ilu_solver, mld_protect_name => mld_c_ilu_solver_bld @@ -46,18 +45,18 @@ subroutine mld_c_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) ! Arguments type(psb_cspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_c_ilu_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer, intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_cspmat_type), intent(in), target, optional :: b class(psb_c_base_sparse_mat), intent(in), optional :: amold class(psb_c_base_vect_type), intent(in), optional :: vmold ! Local variables - integer :: n_row,n_col, nrow_a, nztota + integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota !!$ complex(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) - integer :: ictxt,np,me,i, err_act, debug_unit, debug_level - character(len=20) :: name='c_ilu_solver_bld', ch_err + integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level + character(len=20) :: name='c_ilu_solver_bld', ch_err info=psb_success_ call psb_erractionsave(err_act) @@ -111,7 +110,7 @@ subroutine mld_c_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) case(:-1) ! Error: fill-in <= -1 call psb_errpush(psb_err_input_value_invalid_i_,& - & name,i_err=(/3,sv%fill_in,0,0,0/)) + & name,i_err=(/ithree,sv%fill_in,izero,izero,izero/)) goto 9999 case(0:) @@ -134,7 +133,7 @@ subroutine mld_c_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) case(:-1) ! Error: fill-in <= -1 call psb_errpush(psb_err_input_value_invalid_i_,& - & name,i_err=(/3,sv%fill_in,0,0,0/)) + & name,i_err=(/ithree,sv%fill_in,izero,izero,izero/)) goto 9999 case(0) ! Fill-in 0 @@ -166,7 +165,7 @@ subroutine mld_c_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) ! If we end up here, something was wrong up in the call chain. info = psb_err_input_value_invalid_i_ call psb_errpush(psb_err_input_value_invalid_i_,name,& - & i_err=(/3,sv%fact_type,0,0,0/)) + & i_err=(/ithree,sv%fact_type,izero,izero,izero/)) goto 9999 end select @@ -175,7 +174,7 @@ subroutine mld_c_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) ! For the time being just throw an error. info = 31 call psb_errpush(info, name,& - & i_err=(/3,0,0,0,0/),a_err=upd) + & i_err=(/ithree,izero,izero,izero,izero/),a_err=upd) goto 9999 ! diff --git a/mlprec/impl/solver/mld_c_ilu_solver_dmp.f90 b/mlprec/impl/solver/mld_c_ilu_solver_dmp.f90 index ba9ccf6a..2c1cd40a 100644 --- a/mlprec/impl/solver/mld_c_ilu_solver_dmp.f90 +++ b/mlprec/impl/solver/mld_c_ilu_solver_dmp.f90 @@ -42,12 +42,12 @@ subroutine mld_c_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver) use mld_c_ilu_solver, mld_protect_name => mld_c_ilu_solver_dmp implicit none class(mld_c_ilu_solver_type), intent(in) :: sv - integer, intent(in) :: ictxt,level - integer, intent(out) :: info - character(len=*), intent(in), optional :: prefix, head - logical, optional, intent(in) :: solver - integer :: i, j, il1, iln, lname, lev - integer :: icontxt,iam, np + integer(psb_ipk_), intent(in) :: ictxt,level + integer(psb_ipk_), intent(out) :: info + character(len=*), intent(in), optional :: prefix, head + logical, optional, intent(in) :: solver + 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 :: solver_ diff --git a/mlprec/impl/solver/mld_d_base_solver_apply.f90 b/mlprec/impl/solver/mld_d_base_solver_apply.f90 index 2b8ad8bb..9501428f 100644 --- a/mlprec/impl/solver/mld_d_base_solver_apply.f90 +++ b/mlprec/impl/solver/mld_d_base_solver_apply.f90 @@ -41,17 +41,17 @@ subroutine mld_d_base_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) use psb_base_mod use mld_d_base_solver_mod, mld_protect_name => mld_d_base_solver_apply implicit none - type(psb_desc_type), intent(in) :: desc_data + type(psb_desc_type), intent(in) :: desc_data class(mld_d_base_solver_type), intent(in) :: sv 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 + character(len=1),intent(in) :: trans real(psb_dpk_),target, intent(inout) :: work(:) - integer, intent(out) :: info + integer(psb_ipk_), intent(out) :: info - Integer :: err_act - character(len=20) :: name='d_base_solver_apply' + integer(psb_ipk_) :: err_act + character(len=20) :: name='d_base_solver_apply' call psb_erractionsave(err_act) diff --git a/mlprec/impl/solver/mld_d_base_solver_apply_vect.f90 b/mlprec/impl/solver/mld_d_base_solver_apply_vect.f90 index df788801..2ca793ed 100644 --- a/mlprec/impl/solver/mld_d_base_solver_apply_vect.f90 +++ b/mlprec/impl/solver/mld_d_base_solver_apply_vect.f90 @@ -41,17 +41,17 @@ subroutine mld_d_base_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,i use psb_base_mod use mld_d_base_solver_mod, mld_protect_name => mld_d_base_solver_apply_vect implicit none - type(psb_desc_type), intent(in) :: desc_data + type(psb_desc_type), intent(in) :: desc_data class(mld_d_base_solver_type), intent(inout) :: sv 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 - real(psb_dpk_),target, intent(inout) :: work(:) - integer, intent(out) :: info + real(psb_dpk_),intent(in) :: alpha,beta + character(len=1),intent(in) :: trans + real(psb_dpk_),target, intent(inout) :: work(:) + integer(psb_ipk_), intent(out) :: info - Integer :: err_act - character(len=20) :: name='d_base_solver_apply' + integer(psb_ipk_) :: err_act + character(len=20) :: name='d_base_solver_apply' call psb_erractionsave(err_act) diff --git a/mlprec/impl/solver/mld_d_base_solver_bld.f90 b/mlprec/impl/solver/mld_d_base_solver_bld.f90 index 6a65e8fa..a9fc15ed 100644 --- a/mlprec/impl/solver/mld_d_base_solver_bld.f90 +++ b/mlprec/impl/solver/mld_d_base_solver_bld.f90 @@ -43,16 +43,16 @@ subroutine mld_d_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) Implicit None ! Arguments type(psb_dspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_d_base_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer, intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_dspmat_type), intent(in), target, optional :: b class(psb_d_base_sparse_mat), intent(in), optional :: amold class(psb_d_base_vect_type), intent(in), optional :: vmold - Integer :: err_act - character(len=20) :: name='d_base_solver_bld' + integer(psb_ipk_) :: err_act + character(len=20) :: name='d_base_solver_bld' call psb_erractionsave(err_act) diff --git a/mlprec/impl/solver/mld_d_base_solver_check.f90 b/mlprec/impl/solver/mld_d_base_solver_check.f90 index c1df3ba7..90e83203 100644 --- a/mlprec/impl/solver/mld_d_base_solver_check.f90 +++ b/mlprec/impl/solver/mld_d_base_solver_check.f90 @@ -43,8 +43,8 @@ subroutine mld_d_base_solver_check(sv,info) Implicit None ! Arguments class(mld_d_base_solver_type), intent(inout) :: sv - integer, intent(out) :: info - Integer :: err_act + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: err_act character(len=20) :: name='d_base_solver_check' call psb_erractionsave(err_act) diff --git a/mlprec/impl/solver/mld_d_base_solver_descr.f90 b/mlprec/impl/solver/mld_d_base_solver_descr.f90 index c07c50de..8a6b2309 100644 --- a/mlprec/impl/solver/mld_d_base_solver_descr.f90 +++ b/mlprec/impl/solver/mld_d_base_solver_descr.f90 @@ -43,15 +43,13 @@ subroutine mld_d_base_solver_descr(sv,info,iout,coarse) Implicit None ! Arguments class(mld_d_base_solver_type), intent(in) :: sv - integer, intent(out) :: info - integer, intent(in), optional :: iout - logical, intent(in), optional :: coarse + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse ! Local variables - integer :: err_act - integer :: ictxt, me, np + integer(psb_ipk_) :: err_act character(len=20), parameter :: name='mld_d_base_solver_descr' - integer :: iout_ call psb_erractionsave(err_act) diff --git a/mlprec/impl/solver/mld_d_base_solver_dmp.f90 b/mlprec/impl/solver/mld_d_base_solver_dmp.f90 index f0a6db59..0702b194 100644 --- a/mlprec/impl/solver/mld_d_base_solver_dmp.f90 +++ b/mlprec/impl/solver/mld_d_base_solver_dmp.f90 @@ -42,12 +42,12 @@ subroutine mld_d_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver) use mld_d_base_solver_mod, mld_protect_name => mld_d_base_solver_dmp implicit none class(mld_d_base_solver_type), intent(in) :: sv - integer, intent(in) :: ictxt,level - integer, intent(out) :: info - character(len=*), intent(in), optional :: prefix, head + integer(psb_ipk_), intent(in) :: ictxt,level + integer(psb_ipk_), intent(out) :: info + character(len=*), intent(in), optional :: prefix, head logical, optional, intent(in) :: 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 :: solver_ diff --git a/mlprec/impl/solver/mld_d_base_solver_free.f90 b/mlprec/impl/solver/mld_d_base_solver_free.f90 index 305765fc..cdd7be21 100644 --- a/mlprec/impl/solver/mld_d_base_solver_free.f90 +++ b/mlprec/impl/solver/mld_d_base_solver_free.f90 @@ -43,8 +43,8 @@ subroutine mld_d_base_solver_free(sv,info) Implicit None ! Arguments class(mld_d_base_solver_type), intent(inout) :: sv - integer, intent(out) :: info - Integer :: err_act + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: err_act character(len=20) :: name='d_base_solver_free' call psb_erractionsave(err_act) diff --git a/mlprec/impl/solver/mld_d_base_solver_setc.f90 b/mlprec/impl/solver/mld_d_base_solver_setc.f90 index caa2fd46..85fd63eb 100644 --- a/mlprec/impl/solver/mld_d_base_solver_setc.f90 +++ b/mlprec/impl/solver/mld_d_base_solver_setc.f90 @@ -43,10 +43,10 @@ subroutine mld_d_base_solver_setc(sv,what,val,info) Implicit None ! Arguments class(mld_d_base_solver_type), intent(inout) :: sv - integer, intent(in) :: what - character(len=*), intent(in) :: val - integer, intent(out) :: info - Integer :: err_act, ival + 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_base_solver_setc' call psb_erractionsave(err_act) diff --git a/mlprec/impl/solver/mld_d_base_solver_seti.f90 b/mlprec/impl/solver/mld_d_base_solver_seti.f90 index 333e141a..4ef99346 100644 --- a/mlprec/impl/solver/mld_d_base_solver_seti.f90 +++ b/mlprec/impl/solver/mld_d_base_solver_seti.f90 @@ -43,10 +43,10 @@ subroutine mld_d_base_solver_seti(sv,what,val,info) Implicit None ! Arguments class(mld_d_base_solver_type), intent(inout) :: sv - 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_base_solver_seti' ! Correct action here is doing nothing. diff --git a/mlprec/impl/solver/mld_d_base_solver_setr.f90 b/mlprec/impl/solver/mld_d_base_solver_setr.f90 index 36c16f54..2ec3d347 100644 --- a/mlprec/impl/solver/mld_d_base_solver_setr.f90 +++ b/mlprec/impl/solver/mld_d_base_solver_setr.f90 @@ -43,10 +43,10 @@ subroutine mld_d_base_solver_setr(sv,what,val,info) Implicit None ! Arguments class(mld_d_base_solver_type), intent(inout) :: sv - integer, intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer, intent(out) :: info - Integer :: err_act + 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_base_solver_setr' diff --git a/mlprec/impl/solver/mld_d_diag_solver_apply.f90 b/mlprec/impl/solver/mld_d_diag_solver_apply.f90 index 38f66521..c5b0c78f 100644 --- a/mlprec/impl/solver/mld_d_diag_solver_apply.f90 +++ b/mlprec/impl/solver/mld_d_diag_solver_apply.f90 @@ -46,13 +46,13 @@ subroutine mld_d_diag_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) 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 + character(len=1),intent(in) :: trans real(psb_dpk_),target, intent(inout) :: work(:) - integer, intent(out) :: info + integer(psb_ipk_), intent(out) :: info - integer :: n_row,n_col + integer(psb_ipk_) :: n_row,n_col real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) - integer :: ictxt,np,me,i, err_act + integer(psb_ipk_) :: ictxt,np,me,i, err_act character :: trans_ character(len=20) :: name='d_diag_solver_apply' diff --git a/mlprec/impl/solver/mld_d_diag_solver_apply_vect.f90 b/mlprec/impl/solver/mld_d_diag_solver_apply_vect.f90 index 051d9a80..d1ebd471 100644 --- a/mlprec/impl/solver/mld_d_diag_solver_apply_vect.f90 +++ b/mlprec/impl/solver/mld_d_diag_solver_apply_vect.f90 @@ -41,18 +41,18 @@ subroutine mld_d_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,i use psb_base_mod use mld_d_diag_solver, mld_protect_name => mld_d_diag_solver_apply_vect implicit none - type(psb_desc_type), intent(in) :: desc_data + type(psb_desc_type), intent(in) :: desc_data class(mld_d_diag_solver_type), intent(inout) :: sv 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 - real(psb_dpk_),target, intent(inout) :: work(:) - integer, intent(out) :: info + real(psb_dpk_),intent(in) :: alpha,beta + character(len=1),intent(in) :: trans + real(psb_dpk_),target, intent(inout) :: work(:) + integer(psb_ipk_), intent(out) :: info - integer :: n_row,n_col + integer(psb_ipk_) :: n_row,n_col real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) - integer :: ictxt,np,me,i, err_act + integer(psb_ipk_) :: ictxt,np,me,i, err_act character :: trans_ character(len=20) :: name='d_diag_solver_apply' @@ -73,12 +73,14 @@ subroutine mld_d_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,i n_col = desc_data%get_local_cols() if (x%get_nrows() < n_row) then info = 36 - call psb_errpush(info,name,i_err=(/2,n_row,0,0,0/)) + call psb_errpush(info,name,& + & i_err=(/itwo,n_row,izero,izero,izero/)) goto 9999 end if if (y%get_nrows() < n_row) then info = 36 - call psb_errpush(info,name,i_err=(/3,n_row,0,0,0/)) + call psb_errpush(info,name,& + & i_err=(/ithree,n_row,izero,izero,izero/)) goto 9999 end if if (.not.allocated(sv%dv)) then diff --git a/mlprec/impl/solver/mld_d_diag_solver_bld.f90 b/mlprec/impl/solver/mld_d_diag_solver_bld.f90 index 54b58f04..d57baaaf 100644 --- a/mlprec/impl/solver/mld_d_diag_solver_bld.f90 +++ b/mlprec/impl/solver/mld_d_diag_solver_bld.f90 @@ -45,18 +45,18 @@ subroutine mld_d_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) ! Arguments type(psb_dspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_d_diag_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer, intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_dspmat_type), intent(in), target, optional :: b class(psb_d_base_sparse_mat), intent(in), optional :: amold class(psb_d_base_vect_type), intent(in), optional :: vmold ! Local variables - integer :: n_row,n_col, nrow_a, nztota + integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) - integer :: ictxt,np,me,i, err_act, debug_unit, debug_level - character(len=20) :: name='d_diag_solver_bld', ch_err + integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level + character(len=20) :: name='d_diag_solver_bld', ch_err info=psb_success_ call psb_erractionsave(err_act) @@ -111,7 +111,8 @@ subroutine mld_d_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) if (info == psb_success_) then call sv%dv%bld(sv%d) else - call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate sv%dv') + call psb_errpush(psb_err_from_subroutine_,name,& + & a_err='Allocate sv%dv') goto 9999 end if diff --git a/mlprec/impl/solver/mld_d_id_solver_apply.f90 b/mlprec/impl/solver/mld_d_id_solver_apply.f90 index 780dede9..f7bfd663 100644 --- a/mlprec/impl/solver/mld_d_id_solver_apply.f90 +++ b/mlprec/impl/solver/mld_d_id_solver_apply.f90 @@ -36,50 +36,50 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ - subroutine mld_d_id_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) - - use psb_base_mod - use mld_d_id_solver, mld_protect_name => mld_d_id_solver_apply - implicit none - type(psb_desc_type), intent(in) :: desc_data - class(mld_d_id_solver_type), intent(in) :: sv - 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 - real(psb_dpk_),target, intent(inout) :: work(:) - integer, intent(out) :: info +subroutine mld_d_id_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) - integer :: n_row,n_col - integer :: ictxt,np,me,i, err_act - character :: trans_ - character(len=20) :: name='d_id_solver_apply' + use psb_base_mod + use mld_d_id_solver, mld_protect_name => mld_d_id_solver_apply + implicit none + type(psb_desc_type), intent(in) :: desc_data + class(mld_d_id_solver_type), intent(in) :: sv + 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 + real(psb_dpk_),target, intent(inout) :: work(:) + integer(psb_ipk_), intent(out) :: info - call psb_erractionsave(err_act) + integer(psb_ipk_) :: n_row,n_col + integer(psb_ipk_) :: ictxt,np,me,i, err_act + character :: trans_ + character(len=20) :: name='d_id_solver_apply' - info = psb_success_ + call psb_erractionsave(err_act) - trans_ = psb_toupper(trans) - select case(trans_) - case('N') - case('T') - case('C') - case default - call psb_errpush(psb_err_iarg_invalid_i_,name) - goto 9999 - end select + info = psb_success_ - call psb_geaxpby(alpha,x,beta,y,desc_data,info) + trans_ = psb_toupper(trans) + select case(trans_) + case('N') + case('T') + case('C') + case default + call psb_errpush(psb_err_iarg_invalid_i_,name) + goto 9999 + end select - call psb_erractionrestore(err_act) - return + call psb_geaxpby(alpha,x,beta,y,desc_data,info) + + call psb_erractionrestore(err_act) + return 9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() return + end if + return - end subroutine mld_d_id_solver_apply +end subroutine mld_d_id_solver_apply diff --git a/mlprec/impl/solver/mld_d_id_solver_apply_vect.f90 b/mlprec/impl/solver/mld_d_id_solver_apply_vect.f90 index c8fb69b9..2317b84e 100644 --- a/mlprec/impl/solver/mld_d_id_solver_apply_vect.f90 +++ b/mlprec/impl/solver/mld_d_id_solver_apply_vect.f90 @@ -36,50 +36,50 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ - subroutine mld_d_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info) - - use psb_base_mod - use mld_d_id_solver, mld_protect_name => mld_d_id_solver_apply_vect - implicit none - type(psb_desc_type), intent(in) :: desc_data - class(mld_d_id_solver_type), intent(inout) :: sv - 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 - real(psb_dpk_),target, intent(inout) :: work(:) - integer, intent(out) :: info +subroutine mld_d_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info) - integer :: n_row,n_col - integer :: ictxt,np,me,i, err_act - character :: trans_ - character(len=20) :: name='d_id_solver_apply_vect' + use psb_base_mod + use mld_d_id_solver, mld_protect_name => mld_d_id_solver_apply_vect + implicit none + type(psb_desc_type), intent(in) :: desc_data + class(mld_d_id_solver_type), intent(inout) :: sv + 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 + real(psb_dpk_),target, intent(inout) :: work(:) + integer(psb_ipk_), intent(out) :: info - call psb_erractionsave(err_act) + integer(psb_ipk_) :: n_row,n_col + integer(psb_ipk_) :: ictxt,np,me,i, err_act + character :: trans_ + character(len=20) :: name='d_id_solver_apply_vect' - info = psb_success_ + call psb_erractionsave(err_act) - trans_ = psb_toupper(trans) - select case(trans_) - case('N') - case('T') - case('C') - case default - call psb_errpush(psb_err_iarg_invalid_i_,name) - goto 9999 - end select + info = psb_success_ - call psb_geaxpby(alpha,x,beta,y,desc_data,info) + trans_ = psb_toupper(trans) + select case(trans_) + case('N') + case('T') + case('C') + case default + call psb_errpush(psb_err_iarg_invalid_i_,name) + goto 9999 + end select - call psb_erractionrestore(err_act) - return + call psb_geaxpby(alpha,x,beta,y,desc_data,info) + + call psb_erractionrestore(err_act) + return 9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() return + end if + return - end subroutine mld_d_id_solver_apply_vect +end subroutine mld_d_id_solver_apply_vect diff --git a/mlprec/impl/solver/mld_d_ilu_solver_apply.f90 b/mlprec/impl/solver/mld_d_ilu_solver_apply.f90 index 669145b2..c15a4b7a 100644 --- a/mlprec/impl/solver/mld_d_ilu_solver_apply.f90 +++ b/mlprec/impl/solver/mld_d_ilu_solver_apply.f90 @@ -41,18 +41,18 @@ subroutine mld_d_ilu_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) use psb_base_mod use mld_d_ilu_solver, mld_protect_name => mld_d_ilu_solver_apply implicit none - type(psb_desc_type), intent(in) :: desc_data + type(psb_desc_type), intent(in) :: desc_data class(mld_d_ilu_solver_type), intent(in) :: sv 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 + character(len=1),intent(in) :: trans real(psb_dpk_),target, intent(inout) :: work(:) - integer, intent(out) :: info + integer(psb_ipk_), intent(out) :: info - integer :: n_row,n_col + integer(psb_ipk_) :: n_row,n_col real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) - integer :: ictxt,np,me,i, err_act + integer(psb_ipk_) :: ictxt,np,me,i, err_act character :: trans_ character(len=20) :: name='d_ilu_solver_apply' @@ -80,7 +80,8 @@ subroutine mld_d_ilu_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) allocate(aux(4*n_col),stat=info) if (info /= psb_success_) then info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/4*n_col,0,0,0,0/),& + call psb_errpush(info,name,& + & i_err=(/4*n_col,izero,izero,izero,izero/),& & a_err='real(psb_dpk_)') goto 9999 end if @@ -89,7 +90,8 @@ subroutine mld_d_ilu_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) allocate(ww(n_col),aux(4*n_col),stat=info) if (info /= psb_success_) then info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/5*n_col,0,0,0,0/),& + call psb_errpush(info,name,& + & i_err=(/5*n_col,izero,izero,izero,izero/),& & a_err='real(psb_dpk_)') goto 9999 end if @@ -114,14 +116,16 @@ subroutine mld_d_ilu_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) if (info == psb_success_) call psb_spsm(alpha,sv%l,ww,beta,y,desc_data,info,& & trans=trans_,scale='U',choice=psb_none_,work=aux) case default - call psb_errpush(psb_err_internal_error_,name,a_err='Invalid TRANS in ILU subsolve') + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Invalid TRANS in ILU subsolve') goto 9999 end select if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,a_err='Error in subsolve') + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in subsolve') goto 9999 endif diff --git a/mlprec/impl/solver/mld_d_ilu_solver_apply_vect.f90 b/mlprec/impl/solver/mld_d_ilu_solver_apply_vect.f90 index 32f5f375..6c606c00 100644 --- a/mlprec/impl/solver/mld_d_ilu_solver_apply_vect.f90 +++ b/mlprec/impl/solver/mld_d_ilu_solver_apply_vect.f90 @@ -41,19 +41,19 @@ subroutine mld_d_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,in use psb_base_mod use mld_d_ilu_solver, mld_protect_name => mld_d_ilu_solver_apply_vect implicit none - type(psb_desc_type), intent(in) :: desc_data + type(psb_desc_type), intent(in) :: desc_data class(mld_d_ilu_solver_type), intent(inout) :: sv 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 - real(psb_dpk_),target, intent(inout) :: work(:) - integer, intent(out) :: info + real(psb_dpk_),intent(in) :: alpha,beta + character(len=1),intent(in) :: trans + real(psb_dpk_),target, intent(inout) :: work(:) + integer(psb_ipk_), intent(out) :: info - integer :: n_row,n_col - type(psb_d_vect_type) :: wv, wv1 + integer(psb_ipk_) :: n_row,n_col + type(psb_d_vect_type) :: wv, wv1 real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) - integer :: ictxt,np,me,i, err_act + integer(psb_ipk_) :: ictxt,np,me,i, err_act character :: trans_ character(len=20) :: name='d_ilu_solver_apply' @@ -77,12 +77,14 @@ subroutine mld_d_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,in if (x%get_nrows() < n_row) then info = 36 - call psb_errpush(info,name,i_err=(/2,n_row,0,0,0/)) + call psb_errpush(info,name,& + & i_err=(/itwo,n_row,izero,izero,izero/)) goto 9999 end if if (y%get_nrows() < n_row) then info = 36 - call psb_errpush(info,name,i_err=(/3,n_row,0,0,0/)) + call psb_errpush(info,name,& + & i_err=(/ithree,n_row,izero,izero,izero/)) goto 9999 end if if (.not.allocated(sv%dv%v)) then @@ -111,7 +113,8 @@ subroutine mld_d_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,in if (info /= psb_success_) then info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/5*n_col,0,0,0,0/),& + call psb_errpush(info,name,& + & i_err=(/5*n_col,izero,izero,izero,izero/),& & a_err='real(psb_dpk_)') goto 9999 end if @@ -144,14 +147,16 @@ subroutine mld_d_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,in & trans=trans_,scale='U',choice=psb_none_,work=aux) case default - call psb_errpush(psb_err_internal_error_,name,a_err='Invalid TRANS in ILU subsolve') + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Invalid TRANS in ILU subsolve') goto 9999 end select if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,a_err='Error in subsolve') + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in subsolve') goto 9999 endif call wv%free(info) diff --git a/mlprec/impl/solver/mld_d_ilu_solver_bld.f90 b/mlprec/impl/solver/mld_d_ilu_solver_bld.f90 index 11b89ff8..8e86225d 100644 --- a/mlprec/impl/solver/mld_d_ilu_solver_bld.f90 +++ b/mlprec/impl/solver/mld_d_ilu_solver_bld.f90 @@ -37,7 +37,6 @@ !!$ !!$ subroutine mld_d_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) - use psb_base_mod use mld_d_ilu_solver, mld_protect_name => mld_d_ilu_solver_bld @@ -46,18 +45,18 @@ subroutine mld_d_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) ! Arguments type(psb_dspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_d_ilu_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer, intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_dspmat_type), intent(in), target, optional :: b class(psb_d_base_sparse_mat), intent(in), optional :: amold class(psb_d_base_vect_type), intent(in), optional :: vmold ! Local variables - integer :: n_row,n_col, nrow_a, nztota + integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota !!$ real(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) - integer :: ictxt,np,me,i, err_act, debug_unit, debug_level - character(len=20) :: name='d_ilu_solver_bld', ch_err + integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level + character(len=20) :: name='d_ilu_solver_bld', ch_err info=psb_success_ call psb_erractionsave(err_act) @@ -111,7 +110,7 @@ subroutine mld_d_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) case(:-1) ! Error: fill-in <= -1 call psb_errpush(psb_err_input_value_invalid_i_,& - & name,i_err=(/3,sv%fill_in,0,0,0/)) + & name,i_err=(/ithree,sv%fill_in,izero,izero,izero/)) goto 9999 case(0:) @@ -134,7 +133,7 @@ subroutine mld_d_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) case(:-1) ! Error: fill-in <= -1 call psb_errpush(psb_err_input_value_invalid_i_,& - & name,i_err=(/3,sv%fill_in,0,0,0/)) + & name,i_err=(/ithree,sv%fill_in,izero,izero,izero/)) goto 9999 case(0) ! Fill-in 0 @@ -166,7 +165,7 @@ subroutine mld_d_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) ! If we end up here, something was wrong up in the call chain. info = psb_err_input_value_invalid_i_ call psb_errpush(psb_err_input_value_invalid_i_,name,& - & i_err=(/3,sv%fact_type,0,0,0/)) + & i_err=(/ithree,sv%fact_type,izero,izero,izero/)) goto 9999 end select @@ -175,7 +174,7 @@ subroutine mld_d_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) ! For the time being just throw an error. info = 31 call psb_errpush(info, name,& - & i_err=(/3,0,0,0,0/),a_err=upd) + & i_err=(/ithree,izero,izero,izero,izero/),a_err=upd) goto 9999 ! diff --git a/mlprec/impl/solver/mld_d_ilu_solver_dmp.f90 b/mlprec/impl/solver/mld_d_ilu_solver_dmp.f90 index 0843ce29..a697658a 100644 --- a/mlprec/impl/solver/mld_d_ilu_solver_dmp.f90 +++ b/mlprec/impl/solver/mld_d_ilu_solver_dmp.f90 @@ -42,12 +42,12 @@ subroutine mld_d_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver) use mld_d_ilu_solver, mld_protect_name => mld_d_ilu_solver_dmp implicit none class(mld_d_ilu_solver_type), intent(in) :: sv - integer, intent(in) :: ictxt,level - integer, intent(out) :: info - character(len=*), intent(in), optional :: prefix, head - logical, optional, intent(in) :: solver - integer :: i, j, il1, iln, lname, lev - integer :: icontxt,iam, np + integer(psb_ipk_), intent(in) :: ictxt,level + integer(psb_ipk_), intent(out) :: info + character(len=*), intent(in), optional :: prefix, head + logical, optional, intent(in) :: solver + 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 :: solver_ diff --git a/mlprec/impl/solver/mld_s_base_solver_apply.f90 b/mlprec/impl/solver/mld_s_base_solver_apply.f90 index 83370ea2..dd9e4fd2 100644 --- a/mlprec/impl/solver/mld_s_base_solver_apply.f90 +++ b/mlprec/impl/solver/mld_s_base_solver_apply.f90 @@ -41,17 +41,17 @@ subroutine mld_s_base_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) use psb_base_mod use mld_s_base_solver_mod, mld_protect_name => mld_s_base_solver_apply implicit none - type(psb_desc_type), intent(in) :: desc_data + type(psb_desc_type), intent(in) :: desc_data class(mld_s_base_solver_type), intent(in) :: sv 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 + character(len=1),intent(in) :: trans real(psb_spk_),target, intent(inout) :: work(:) - integer, intent(out) :: info + integer(psb_ipk_), intent(out) :: info - Integer :: err_act - character(len=20) :: name='d_base_solver_apply' + integer(psb_ipk_) :: err_act + character(len=20) :: name='d_base_solver_apply' call psb_erractionsave(err_act) diff --git a/mlprec/impl/solver/mld_s_base_solver_apply_vect.f90 b/mlprec/impl/solver/mld_s_base_solver_apply_vect.f90 index d939666a..007af39f 100644 --- a/mlprec/impl/solver/mld_s_base_solver_apply_vect.f90 +++ b/mlprec/impl/solver/mld_s_base_solver_apply_vect.f90 @@ -41,17 +41,17 @@ subroutine mld_s_base_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,i use psb_base_mod use mld_s_base_solver_mod, mld_protect_name => mld_s_base_solver_apply_vect implicit none - type(psb_desc_type), intent(in) :: desc_data + type(psb_desc_type), intent(in) :: desc_data class(mld_s_base_solver_type), intent(inout) :: sv 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 - real(psb_spk_),target, intent(inout) :: work(:) - integer, intent(out) :: info + real(psb_spk_),intent(in) :: alpha,beta + character(len=1),intent(in) :: trans + real(psb_spk_),target, intent(inout) :: work(:) + integer(psb_ipk_), intent(out) :: info - Integer :: err_act - character(len=20) :: name='d_base_solver_apply' + integer(psb_ipk_) :: err_act + character(len=20) :: name='d_base_solver_apply' call psb_erractionsave(err_act) diff --git a/mlprec/impl/solver/mld_s_base_solver_bld.f90 b/mlprec/impl/solver/mld_s_base_solver_bld.f90 index a5f031af..18be87c3 100644 --- a/mlprec/impl/solver/mld_s_base_solver_bld.f90 +++ b/mlprec/impl/solver/mld_s_base_solver_bld.f90 @@ -43,16 +43,16 @@ subroutine mld_s_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) Implicit None ! Arguments type(psb_sspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_s_base_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer, intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_sspmat_type), intent(in), target, optional :: b class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_vect_type), intent(in), optional :: vmold - Integer :: err_act - character(len=20) :: name='d_base_solver_bld' + integer(psb_ipk_) :: err_act + character(len=20) :: name='d_base_solver_bld' call psb_erractionsave(err_act) diff --git a/mlprec/impl/solver/mld_s_base_solver_check.f90 b/mlprec/impl/solver/mld_s_base_solver_check.f90 index 73e7683a..52ff26c7 100644 --- a/mlprec/impl/solver/mld_s_base_solver_check.f90 +++ b/mlprec/impl/solver/mld_s_base_solver_check.f90 @@ -43,8 +43,8 @@ subroutine mld_s_base_solver_check(sv,info) Implicit None ! Arguments class(mld_s_base_solver_type), intent(inout) :: sv - integer, intent(out) :: info - Integer :: err_act + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: err_act character(len=20) :: name='d_base_solver_check' call psb_erractionsave(err_act) diff --git a/mlprec/impl/solver/mld_s_base_solver_descr.f90 b/mlprec/impl/solver/mld_s_base_solver_descr.f90 index ae0a2334..7749de7c 100644 --- a/mlprec/impl/solver/mld_s_base_solver_descr.f90 +++ b/mlprec/impl/solver/mld_s_base_solver_descr.f90 @@ -43,15 +43,13 @@ subroutine mld_s_base_solver_descr(sv,info,iout,coarse) Implicit None ! Arguments class(mld_s_base_solver_type), intent(in) :: sv - integer, intent(out) :: info - integer, intent(in), optional :: iout - logical, intent(in), optional :: coarse + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse ! Local variables - integer :: err_act - integer :: ictxt, me, np + integer(psb_ipk_) :: err_act character(len=20), parameter :: name='mld_s_base_solver_descr' - integer :: iout_ call psb_erractionsave(err_act) diff --git a/mlprec/impl/solver/mld_s_base_solver_dmp.f90 b/mlprec/impl/solver/mld_s_base_solver_dmp.f90 index 9e0f7374..f951d586 100644 --- a/mlprec/impl/solver/mld_s_base_solver_dmp.f90 +++ b/mlprec/impl/solver/mld_s_base_solver_dmp.f90 @@ -42,12 +42,12 @@ subroutine mld_s_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver) use mld_s_base_solver_mod, mld_protect_name => mld_s_base_solver_dmp implicit none class(mld_s_base_solver_type), intent(in) :: sv - integer, intent(in) :: ictxt,level - integer, intent(out) :: info - character(len=*), intent(in), optional :: prefix, head + integer(psb_ipk_), intent(in) :: ictxt,level + integer(psb_ipk_), intent(out) :: info + character(len=*), intent(in), optional :: prefix, head logical, optional, intent(in) :: 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 :: solver_ diff --git a/mlprec/impl/solver/mld_s_base_solver_free.f90 b/mlprec/impl/solver/mld_s_base_solver_free.f90 index 7b07b897..2bb29068 100644 --- a/mlprec/impl/solver/mld_s_base_solver_free.f90 +++ b/mlprec/impl/solver/mld_s_base_solver_free.f90 @@ -43,8 +43,8 @@ subroutine mld_s_base_solver_free(sv,info) Implicit None ! Arguments class(mld_s_base_solver_type), intent(inout) :: sv - integer, intent(out) :: info - Integer :: err_act + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: err_act character(len=20) :: name='d_base_solver_free' call psb_erractionsave(err_act) diff --git a/mlprec/impl/solver/mld_s_base_solver_setc.f90 b/mlprec/impl/solver/mld_s_base_solver_setc.f90 index 4d6d2e0d..42e56d6f 100644 --- a/mlprec/impl/solver/mld_s_base_solver_setc.f90 +++ b/mlprec/impl/solver/mld_s_base_solver_setc.f90 @@ -43,10 +43,10 @@ subroutine mld_s_base_solver_setc(sv,what,val,info) Implicit None ! Arguments class(mld_s_base_solver_type), intent(inout) :: sv - integer, intent(in) :: what - character(len=*), intent(in) :: val - integer, intent(out) :: info - Integer :: err_act, ival + 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_base_solver_setc' call psb_erractionsave(err_act) diff --git a/mlprec/impl/solver/mld_s_base_solver_seti.f90 b/mlprec/impl/solver/mld_s_base_solver_seti.f90 index 04502366..d2bc34fa 100644 --- a/mlprec/impl/solver/mld_s_base_solver_seti.f90 +++ b/mlprec/impl/solver/mld_s_base_solver_seti.f90 @@ -43,10 +43,10 @@ subroutine mld_s_base_solver_seti(sv,what,val,info) Implicit None ! Arguments class(mld_s_base_solver_type), intent(inout) :: sv - 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_base_solver_seti' ! Correct action here is doing nothing. diff --git a/mlprec/impl/solver/mld_s_base_solver_setr.f90 b/mlprec/impl/solver/mld_s_base_solver_setr.f90 index 01d68fba..8109abc7 100644 --- a/mlprec/impl/solver/mld_s_base_solver_setr.f90 +++ b/mlprec/impl/solver/mld_s_base_solver_setr.f90 @@ -43,10 +43,10 @@ subroutine mld_s_base_solver_setr(sv,what,val,info) Implicit None ! Arguments class(mld_s_base_solver_type), intent(inout) :: sv - integer, intent(in) :: what - real(psb_spk_), intent(in) :: val - integer, intent(out) :: info - Integer :: err_act + 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='d_base_solver_setr' diff --git a/mlprec/impl/solver/mld_s_diag_solver_apply.f90 b/mlprec/impl/solver/mld_s_diag_solver_apply.f90 index a299cbcc..bf5ef26e 100644 --- a/mlprec/impl/solver/mld_s_diag_solver_apply.f90 +++ b/mlprec/impl/solver/mld_s_diag_solver_apply.f90 @@ -46,13 +46,13 @@ subroutine mld_s_diag_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) 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 + character(len=1),intent(in) :: trans real(psb_spk_),target, intent(inout) :: work(:) - integer, intent(out) :: info + integer(psb_ipk_), intent(out) :: info - integer :: n_row,n_col + integer(psb_ipk_) :: n_row,n_col real(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) - integer :: ictxt,np,me,i, err_act + integer(psb_ipk_) :: ictxt,np,me,i, err_act character :: trans_ character(len=20) :: name='s_diag_solver_apply' diff --git a/mlprec/impl/solver/mld_s_diag_solver_apply_vect.f90 b/mlprec/impl/solver/mld_s_diag_solver_apply_vect.f90 index 4478c906..70b13f6d 100644 --- a/mlprec/impl/solver/mld_s_diag_solver_apply_vect.f90 +++ b/mlprec/impl/solver/mld_s_diag_solver_apply_vect.f90 @@ -41,18 +41,18 @@ subroutine mld_s_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,i use psb_base_mod use mld_s_diag_solver, mld_protect_name => mld_s_diag_solver_apply_vect implicit none - type(psb_desc_type), intent(in) :: desc_data + type(psb_desc_type), intent(in) :: desc_data class(mld_s_diag_solver_type), intent(inout) :: sv 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 - real(psb_spk_),target, intent(inout) :: work(:) - integer, intent(out) :: info + real(psb_spk_),intent(in) :: alpha,beta + character(len=1),intent(in) :: trans + real(psb_spk_),target, intent(inout) :: work(:) + integer(psb_ipk_), intent(out) :: info - integer :: n_row,n_col + integer(psb_ipk_) :: n_row,n_col real(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) - integer :: ictxt,np,me,i, err_act + integer(psb_ipk_) :: ictxt,np,me,i, err_act character :: trans_ character(len=20) :: name='s_diag_solver_apply' @@ -73,12 +73,14 @@ subroutine mld_s_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,i n_col = desc_data%get_local_cols() if (x%get_nrows() < n_row) then info = 36 - call psb_errpush(info,name,i_err=(/2,n_row,0,0,0/)) + call psb_errpush(info,name,& + & i_err=(/itwo,n_row,izero,izero,izero/)) goto 9999 end if if (y%get_nrows() < n_row) then info = 36 - call psb_errpush(info,name,i_err=(/3,n_row,0,0,0/)) + call psb_errpush(info,name,& + & i_err=(/ithree,n_row,izero,izero,izero/)) goto 9999 end if if (.not.allocated(sv%dv)) then diff --git a/mlprec/impl/solver/mld_s_diag_solver_bld.f90 b/mlprec/impl/solver/mld_s_diag_solver_bld.f90 index c56fa7cf..b4fb87fa 100644 --- a/mlprec/impl/solver/mld_s_diag_solver_bld.f90 +++ b/mlprec/impl/solver/mld_s_diag_solver_bld.f90 @@ -45,18 +45,18 @@ subroutine mld_s_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) ! Arguments type(psb_sspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_s_diag_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer, intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_sspmat_type), intent(in), target, optional :: b class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_vect_type), intent(in), optional :: vmold ! Local variables - integer :: n_row,n_col, nrow_a, nztota + integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota real(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) - integer :: ictxt,np,me,i, err_act, debug_unit, debug_level - character(len=20) :: name='s_diag_solver_bld', ch_err + integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level + character(len=20) :: name='s_diag_solver_bld', ch_err info=psb_success_ call psb_erractionsave(err_act) @@ -111,7 +111,8 @@ subroutine mld_s_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) if (info == psb_success_) then call sv%dv%bld(sv%d) else - call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate sv%dv') + call psb_errpush(psb_err_from_subroutine_,name,& + & a_err='Allocate sv%dv') goto 9999 end if diff --git a/mlprec/impl/solver/mld_s_id_solver_apply.f90 b/mlprec/impl/solver/mld_s_id_solver_apply.f90 index 38dc2308..2c3ab339 100644 --- a/mlprec/impl/solver/mld_s_id_solver_apply.f90 +++ b/mlprec/impl/solver/mld_s_id_solver_apply.f90 @@ -36,50 +36,50 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ - subroutine mld_s_id_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) - - use psb_base_mod - use mld_s_id_solver, mld_protect_name => mld_s_id_solver_apply - implicit none - type(psb_desc_type), intent(in) :: desc_data - class(mld_s_id_solver_type), intent(in) :: sv - 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 - real(psb_spk_),target, intent(inout) :: work(:) - integer, intent(out) :: info +subroutine mld_s_id_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) - integer :: n_row,n_col - integer :: ictxt,np,me,i, err_act - character :: trans_ - character(len=20) :: name='s_id_solver_apply' + use psb_base_mod + use mld_s_id_solver, mld_protect_name => mld_s_id_solver_apply + implicit none + type(psb_desc_type), intent(in) :: desc_data + class(mld_s_id_solver_type), intent(in) :: sv + 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 + real(psb_spk_),target, intent(inout) :: work(:) + integer(psb_ipk_), intent(out) :: info - call psb_erractionsave(err_act) + integer(psb_ipk_) :: n_row,n_col + integer(psb_ipk_) :: ictxt,np,me,i, err_act + character :: trans_ + character(len=20) :: name='s_id_solver_apply' - info = psb_success_ + call psb_erractionsave(err_act) - trans_ = psb_toupper(trans) - select case(trans_) - case('N') - case('T') - case('C') - case default - call psb_errpush(psb_err_iarg_invalid_i_,name) - goto 9999 - end select + info = psb_success_ - call psb_geaxpby(alpha,x,beta,y,desc_data,info) + trans_ = psb_toupper(trans) + select case(trans_) + case('N') + case('T') + case('C') + case default + call psb_errpush(psb_err_iarg_invalid_i_,name) + goto 9999 + end select - call psb_erractionrestore(err_act) - return + call psb_geaxpby(alpha,x,beta,y,desc_data,info) + + call psb_erractionrestore(err_act) + return 9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() return + end if + return - end subroutine mld_s_id_solver_apply +end subroutine mld_s_id_solver_apply diff --git a/mlprec/impl/solver/mld_s_id_solver_apply_vect.f90 b/mlprec/impl/solver/mld_s_id_solver_apply_vect.f90 index cfe2c718..0506bdbb 100644 --- a/mlprec/impl/solver/mld_s_id_solver_apply_vect.f90 +++ b/mlprec/impl/solver/mld_s_id_solver_apply_vect.f90 @@ -36,50 +36,50 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ - subroutine mld_s_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info) - - use psb_base_mod - use mld_s_id_solver, mld_protect_name => mld_s_id_solver_apply_vect - implicit none - type(psb_desc_type), intent(in) :: desc_data - class(mld_s_id_solver_type), intent(inout) :: sv - 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 - real(psb_spk_),target, intent(inout) :: work(:) - integer, intent(out) :: info +subroutine mld_s_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info) - integer :: n_row,n_col - integer :: ictxt,np,me,i, err_act - character :: trans_ - character(len=20) :: name='s_id_solver_apply_vect' + use psb_base_mod + use mld_s_id_solver, mld_protect_name => mld_s_id_solver_apply_vect + implicit none + type(psb_desc_type), intent(in) :: desc_data + class(mld_s_id_solver_type), intent(inout) :: sv + 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 + real(psb_spk_),target, intent(inout) :: work(:) + integer(psb_ipk_), intent(out) :: info - call psb_erractionsave(err_act) + integer(psb_ipk_) :: n_row,n_col + integer(psb_ipk_) :: ictxt,np,me,i, err_act + character :: trans_ + character(len=20) :: name='s_id_solver_apply_vect' - info = psb_success_ + call psb_erractionsave(err_act) - trans_ = psb_toupper(trans) - select case(trans_) - case('N') - case('T') - case('C') - case default - call psb_errpush(psb_err_iarg_invalid_i_,name) - goto 9999 - end select + info = psb_success_ - call psb_geaxpby(alpha,x,beta,y,desc_data,info) + trans_ = psb_toupper(trans) + select case(trans_) + case('N') + case('T') + case('C') + case default + call psb_errpush(psb_err_iarg_invalid_i_,name) + goto 9999 + end select - call psb_erractionrestore(err_act) - return + call psb_geaxpby(alpha,x,beta,y,desc_data,info) + + call psb_erractionrestore(err_act) + return 9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() return + end if + return - end subroutine mld_s_id_solver_apply_vect +end subroutine mld_s_id_solver_apply_vect diff --git a/mlprec/impl/solver/mld_s_ilu_solver_apply.f90 b/mlprec/impl/solver/mld_s_ilu_solver_apply.f90 index da09a370..151c8bcf 100644 --- a/mlprec/impl/solver/mld_s_ilu_solver_apply.f90 +++ b/mlprec/impl/solver/mld_s_ilu_solver_apply.f90 @@ -41,18 +41,18 @@ subroutine mld_s_ilu_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) use psb_base_mod use mld_s_ilu_solver, mld_protect_name => mld_s_ilu_solver_apply implicit none - type(psb_desc_type), intent(in) :: desc_data + type(psb_desc_type), intent(in) :: desc_data class(mld_s_ilu_solver_type), intent(in) :: sv 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 + character(len=1),intent(in) :: trans real(psb_spk_),target, intent(inout) :: work(:) - integer, intent(out) :: info + integer(psb_ipk_), intent(out) :: info - integer :: n_row,n_col + integer(psb_ipk_) :: n_row,n_col real(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) - integer :: ictxt,np,me,i, err_act + integer(psb_ipk_) :: ictxt,np,me,i, err_act character :: trans_ character(len=20) :: name='s_ilu_solver_apply' @@ -80,7 +80,8 @@ subroutine mld_s_ilu_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) allocate(aux(4*n_col),stat=info) if (info /= psb_success_) then info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/4*n_col,0,0,0,0/),& + call psb_errpush(info,name,& + & i_err=(/4*n_col,izero,izero,izero,izero/),& & a_err='real(psb_spk_)') goto 9999 end if @@ -89,7 +90,8 @@ subroutine mld_s_ilu_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) allocate(ww(n_col),aux(4*n_col),stat=info) if (info /= psb_success_) then info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/5*n_col,0,0,0,0/),& + call psb_errpush(info,name,& + & i_err=(/5*n_col,izero,izero,izero,izero/),& & a_err='real(psb_spk_)') goto 9999 end if @@ -114,14 +116,16 @@ subroutine mld_s_ilu_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) if (info == psb_success_) call psb_spsm(alpha,sv%l,ww,beta,y,desc_data,info,& & trans=trans_,scale='U',choice=psb_none_,work=aux) case default - call psb_errpush(psb_err_internal_error_,name,a_err='Invalid TRANS in ILU subsolve') + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Invalid TRANS in ILU subsolve') goto 9999 end select if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,a_err='Error in subsolve') + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in subsolve') goto 9999 endif diff --git a/mlprec/impl/solver/mld_s_ilu_solver_apply_vect.f90 b/mlprec/impl/solver/mld_s_ilu_solver_apply_vect.f90 index b4fc14b6..61cb81a5 100644 --- a/mlprec/impl/solver/mld_s_ilu_solver_apply_vect.f90 +++ b/mlprec/impl/solver/mld_s_ilu_solver_apply_vect.f90 @@ -41,19 +41,19 @@ subroutine mld_s_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,in use psb_base_mod use mld_s_ilu_solver, mld_protect_name => mld_s_ilu_solver_apply_vect implicit none - type(psb_desc_type), intent(in) :: desc_data + type(psb_desc_type), intent(in) :: desc_data class(mld_s_ilu_solver_type), intent(inout) :: sv 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 - real(psb_spk_),target, intent(inout) :: work(:) - integer, intent(out) :: info + real(psb_spk_),intent(in) :: alpha,beta + character(len=1),intent(in) :: trans + real(psb_spk_),target, intent(inout) :: work(:) + integer(psb_ipk_), intent(out) :: info - integer :: n_row,n_col - type(psb_s_vect_type) :: wv, wv1 + integer(psb_ipk_) :: n_row,n_col + type(psb_s_vect_type) :: wv, wv1 real(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) - integer :: ictxt,np,me,i, err_act + integer(psb_ipk_) :: ictxt,np,me,i, err_act character :: trans_ character(len=20) :: name='s_ilu_solver_apply' @@ -77,12 +77,14 @@ subroutine mld_s_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,in if (x%get_nrows() < n_row) then info = 36 - call psb_errpush(info,name,i_err=(/2,n_row,0,0,0/)) + call psb_errpush(info,name,& + & i_err=(/itwo,n_row,izero,izero,izero/)) goto 9999 end if if (y%get_nrows() < n_row) then info = 36 - call psb_errpush(info,name,i_err=(/3,n_row,0,0,0/)) + call psb_errpush(info,name,& + & i_err=(/ithree,n_row,izero,izero,izero/)) goto 9999 end if if (.not.allocated(sv%dv%v)) then @@ -111,7 +113,8 @@ subroutine mld_s_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,in if (info /= psb_success_) then info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/5*n_col,0,0,0,0/),& + call psb_errpush(info,name,& + & i_err=(/5*n_col,izero,izero,izero,izero/),& & a_err='real(psb_spk_)') goto 9999 end if @@ -144,14 +147,16 @@ subroutine mld_s_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,in & trans=trans_,scale='U',choice=psb_none_,work=aux) case default - call psb_errpush(psb_err_internal_error_,name,a_err='Invalid TRANS in ILU subsolve') + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Invalid TRANS in ILU subsolve') goto 9999 end select if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,a_err='Error in subsolve') + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in subsolve') goto 9999 endif call wv%free(info) diff --git a/mlprec/impl/solver/mld_s_ilu_solver_bld.f90 b/mlprec/impl/solver/mld_s_ilu_solver_bld.f90 index 7d1db288..b726ad95 100644 --- a/mlprec/impl/solver/mld_s_ilu_solver_bld.f90 +++ b/mlprec/impl/solver/mld_s_ilu_solver_bld.f90 @@ -37,7 +37,6 @@ !!$ !!$ subroutine mld_s_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) - use psb_base_mod use mld_s_ilu_solver, mld_protect_name => mld_s_ilu_solver_bld @@ -46,18 +45,18 @@ subroutine mld_s_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) ! Arguments type(psb_sspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_s_ilu_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer, intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_sspmat_type), intent(in), target, optional :: b class(psb_s_base_sparse_mat), intent(in), optional :: amold class(psb_s_base_vect_type), intent(in), optional :: vmold ! Local variables - integer :: n_row,n_col, nrow_a, nztota + integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota !!$ real(psb_spk_), pointer :: ww(:), aux(:), tx(:),ty(:) - integer :: ictxt,np,me,i, err_act, debug_unit, debug_level - character(len=20) :: name='s_ilu_solver_bld', ch_err + integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level + character(len=20) :: name='s_ilu_solver_bld', ch_err info=psb_success_ call psb_erractionsave(err_act) @@ -111,7 +110,7 @@ subroutine mld_s_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) case(:-1) ! Error: fill-in <= -1 call psb_errpush(psb_err_input_value_invalid_i_,& - & name,i_err=(/3,sv%fill_in,0,0,0/)) + & name,i_err=(/ithree,sv%fill_in,izero,izero,izero/)) goto 9999 case(0:) @@ -134,7 +133,7 @@ subroutine mld_s_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) case(:-1) ! Error: fill-in <= -1 call psb_errpush(psb_err_input_value_invalid_i_,& - & name,i_err=(/3,sv%fill_in,0,0,0/)) + & name,i_err=(/ithree,sv%fill_in,izero,izero,izero/)) goto 9999 case(0) ! Fill-in 0 @@ -166,7 +165,7 @@ subroutine mld_s_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) ! If we end up here, something was wrong up in the call chain. info = psb_err_input_value_invalid_i_ call psb_errpush(psb_err_input_value_invalid_i_,name,& - & i_err=(/3,sv%fact_type,0,0,0/)) + & i_err=(/ithree,sv%fact_type,izero,izero,izero/)) goto 9999 end select @@ -175,7 +174,7 @@ subroutine mld_s_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) ! For the time being just throw an error. info = 31 call psb_errpush(info, name,& - & i_err=(/3,0,0,0,0/),a_err=upd) + & i_err=(/ithree,izero,izero,izero,izero/),a_err=upd) goto 9999 ! diff --git a/mlprec/impl/solver/mld_s_ilu_solver_dmp.f90 b/mlprec/impl/solver/mld_s_ilu_solver_dmp.f90 index dc0e9845..4589ac6f 100644 --- a/mlprec/impl/solver/mld_s_ilu_solver_dmp.f90 +++ b/mlprec/impl/solver/mld_s_ilu_solver_dmp.f90 @@ -42,12 +42,12 @@ subroutine mld_s_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver) use mld_s_ilu_solver, mld_protect_name => mld_s_ilu_solver_dmp implicit none class(mld_s_ilu_solver_type), intent(in) :: sv - integer, intent(in) :: ictxt,level - integer, intent(out) :: info - character(len=*), intent(in), optional :: prefix, head - logical, optional, intent(in) :: solver - integer :: i, j, il1, iln, lname, lev - integer :: icontxt,iam, np + integer(psb_ipk_), intent(in) :: ictxt,level + integer(psb_ipk_), intent(out) :: info + character(len=*), intent(in), optional :: prefix, head + logical, optional, intent(in) :: solver + 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 :: solver_ diff --git a/mlprec/impl/solver/mld_z_base_solver_apply.f90 b/mlprec/impl/solver/mld_z_base_solver_apply.f90 index 10f7d90d..e82f7738 100644 --- a/mlprec/impl/solver/mld_z_base_solver_apply.f90 +++ b/mlprec/impl/solver/mld_z_base_solver_apply.f90 @@ -41,17 +41,17 @@ subroutine mld_z_base_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) use psb_base_mod use mld_z_base_solver_mod, mld_protect_name => mld_z_base_solver_apply implicit none - type(psb_desc_type), intent(in) :: desc_data + type(psb_desc_type), intent(in) :: desc_data class(mld_z_base_solver_type), intent(in) :: sv 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 + character(len=1),intent(in) :: trans complex(psb_dpk_),target, intent(inout) :: work(:) - integer, intent(out) :: info + integer(psb_ipk_), intent(out) :: info - Integer :: err_act - character(len=20) :: name='d_base_solver_apply' + integer(psb_ipk_) :: err_act + character(len=20) :: name='d_base_solver_apply' call psb_erractionsave(err_act) diff --git a/mlprec/impl/solver/mld_z_base_solver_apply_vect.f90 b/mlprec/impl/solver/mld_z_base_solver_apply_vect.f90 index 719e7036..65f17e06 100644 --- a/mlprec/impl/solver/mld_z_base_solver_apply_vect.f90 +++ b/mlprec/impl/solver/mld_z_base_solver_apply_vect.f90 @@ -41,17 +41,17 @@ subroutine mld_z_base_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,i use psb_base_mod use mld_z_base_solver_mod, mld_protect_name => mld_z_base_solver_apply_vect implicit none - type(psb_desc_type), intent(in) :: desc_data + type(psb_desc_type), intent(in) :: desc_data class(mld_z_base_solver_type), intent(inout) :: sv 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 - complex(psb_dpk_),target, intent(inout) :: work(:) - integer, intent(out) :: info + complex(psb_dpk_),intent(in) :: alpha,beta + character(len=1),intent(in) :: trans + complex(psb_dpk_),target, intent(inout) :: work(:) + integer(psb_ipk_), intent(out) :: info - Integer :: err_act - character(len=20) :: name='d_base_solver_apply' + integer(psb_ipk_) :: err_act + character(len=20) :: name='d_base_solver_apply' call psb_erractionsave(err_act) diff --git a/mlprec/impl/solver/mld_z_base_solver_bld.f90 b/mlprec/impl/solver/mld_z_base_solver_bld.f90 index 4da92050..05062eb4 100644 --- a/mlprec/impl/solver/mld_z_base_solver_bld.f90 +++ b/mlprec/impl/solver/mld_z_base_solver_bld.f90 @@ -43,16 +43,16 @@ subroutine mld_z_base_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) Implicit None ! Arguments type(psb_zspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_z_base_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer, intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_zspmat_type), intent(in), target, optional :: b class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_vect_type), intent(in), optional :: vmold - Integer :: err_act - character(len=20) :: name='d_base_solver_bld' + integer(psb_ipk_) :: err_act + character(len=20) :: name='d_base_solver_bld' call psb_erractionsave(err_act) diff --git a/mlprec/impl/solver/mld_z_base_solver_check.f90 b/mlprec/impl/solver/mld_z_base_solver_check.f90 index 04d8502c..1c16cef0 100644 --- a/mlprec/impl/solver/mld_z_base_solver_check.f90 +++ b/mlprec/impl/solver/mld_z_base_solver_check.f90 @@ -43,8 +43,8 @@ subroutine mld_z_base_solver_check(sv,info) Implicit None ! Arguments class(mld_z_base_solver_type), intent(inout) :: sv - integer, intent(out) :: info - Integer :: err_act + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: err_act character(len=20) :: name='d_base_solver_check' call psb_erractionsave(err_act) diff --git a/mlprec/impl/solver/mld_z_base_solver_descr.f90 b/mlprec/impl/solver/mld_z_base_solver_descr.f90 index 2dd5b912..803bcce0 100644 --- a/mlprec/impl/solver/mld_z_base_solver_descr.f90 +++ b/mlprec/impl/solver/mld_z_base_solver_descr.f90 @@ -43,15 +43,13 @@ subroutine mld_z_base_solver_descr(sv,info,iout,coarse) Implicit None ! Arguments class(mld_z_base_solver_type), intent(in) :: sv - integer, intent(out) :: info - integer, intent(in), optional :: iout - logical, intent(in), optional :: coarse + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_), intent(in), optional :: iout + logical, intent(in), optional :: coarse ! Local variables - integer :: err_act - integer :: ictxt, me, np + integer(psb_ipk_) :: err_act character(len=20), parameter :: name='mld_z_base_solver_descr' - integer :: iout_ call psb_erractionsave(err_act) diff --git a/mlprec/impl/solver/mld_z_base_solver_dmp.f90 b/mlprec/impl/solver/mld_z_base_solver_dmp.f90 index 63c59456..f03c1ec8 100644 --- a/mlprec/impl/solver/mld_z_base_solver_dmp.f90 +++ b/mlprec/impl/solver/mld_z_base_solver_dmp.f90 @@ -42,12 +42,12 @@ subroutine mld_z_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver) use mld_z_base_solver_mod, mld_protect_name => mld_z_base_solver_dmp implicit none class(mld_z_base_solver_type), intent(in) :: sv - integer, intent(in) :: ictxt,level - integer, intent(out) :: info - character(len=*), intent(in), optional :: prefix, head + integer(psb_ipk_), intent(in) :: ictxt,level + integer(psb_ipk_), intent(out) :: info + character(len=*), intent(in), optional :: prefix, head logical, optional, intent(in) :: 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 :: solver_ diff --git a/mlprec/impl/solver/mld_z_base_solver_free.f90 b/mlprec/impl/solver/mld_z_base_solver_free.f90 index 4d284024..0b4ac33c 100644 --- a/mlprec/impl/solver/mld_z_base_solver_free.f90 +++ b/mlprec/impl/solver/mld_z_base_solver_free.f90 @@ -43,8 +43,8 @@ subroutine mld_z_base_solver_free(sv,info) Implicit None ! Arguments class(mld_z_base_solver_type), intent(inout) :: sv - integer, intent(out) :: info - Integer :: err_act + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: err_act character(len=20) :: name='d_base_solver_free' call psb_erractionsave(err_act) diff --git a/mlprec/impl/solver/mld_z_base_solver_setc.f90 b/mlprec/impl/solver/mld_z_base_solver_setc.f90 index e842e152..44a17e99 100644 --- a/mlprec/impl/solver/mld_z_base_solver_setc.f90 +++ b/mlprec/impl/solver/mld_z_base_solver_setc.f90 @@ -43,10 +43,10 @@ subroutine mld_z_base_solver_setc(sv,what,val,info) Implicit None ! Arguments class(mld_z_base_solver_type), intent(inout) :: sv - integer, intent(in) :: what - character(len=*), intent(in) :: val - integer, intent(out) :: info - Integer :: err_act, ival + 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_base_solver_setc' call psb_erractionsave(err_act) diff --git a/mlprec/impl/solver/mld_z_base_solver_seti.f90 b/mlprec/impl/solver/mld_z_base_solver_seti.f90 index 71f290fb..916197b6 100644 --- a/mlprec/impl/solver/mld_z_base_solver_seti.f90 +++ b/mlprec/impl/solver/mld_z_base_solver_seti.f90 @@ -43,10 +43,10 @@ subroutine mld_z_base_solver_seti(sv,what,val,info) Implicit None ! Arguments class(mld_z_base_solver_type), intent(inout) :: sv - 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_base_solver_seti' ! Correct action here is doing nothing. diff --git a/mlprec/impl/solver/mld_z_base_solver_setr.f90 b/mlprec/impl/solver/mld_z_base_solver_setr.f90 index 13b3bbac..0e28d4f2 100644 --- a/mlprec/impl/solver/mld_z_base_solver_setr.f90 +++ b/mlprec/impl/solver/mld_z_base_solver_setr.f90 @@ -43,10 +43,10 @@ subroutine mld_z_base_solver_setr(sv,what,val,info) Implicit None ! Arguments class(mld_z_base_solver_type), intent(inout) :: sv - integer, intent(in) :: what - real(psb_dpk_), intent(in) :: val - integer, intent(out) :: info - Integer :: err_act + 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_base_solver_setr' diff --git a/mlprec/impl/solver/mld_z_diag_solver_apply.f90 b/mlprec/impl/solver/mld_z_diag_solver_apply.f90 index f942d3e9..56146ada 100644 --- a/mlprec/impl/solver/mld_z_diag_solver_apply.f90 +++ b/mlprec/impl/solver/mld_z_diag_solver_apply.f90 @@ -46,13 +46,13 @@ subroutine mld_z_diag_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) 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 + character(len=1),intent(in) :: trans complex(psb_dpk_),target, intent(inout) :: work(:) - integer, intent(out) :: info + integer(psb_ipk_), intent(out) :: info - integer :: n_row,n_col + integer(psb_ipk_) :: n_row,n_col complex(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) - integer :: ictxt,np,me,i, err_act + integer(psb_ipk_) :: ictxt,np,me,i, err_act character :: trans_ character(len=20) :: name='z_diag_solver_apply' diff --git a/mlprec/impl/solver/mld_z_diag_solver_apply_vect.f90 b/mlprec/impl/solver/mld_z_diag_solver_apply_vect.f90 index 357b5710..ae879ccc 100644 --- a/mlprec/impl/solver/mld_z_diag_solver_apply_vect.f90 +++ b/mlprec/impl/solver/mld_z_diag_solver_apply_vect.f90 @@ -41,18 +41,18 @@ subroutine mld_z_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,i use psb_base_mod use mld_z_diag_solver, mld_protect_name => mld_z_diag_solver_apply_vect implicit none - type(psb_desc_type), intent(in) :: desc_data + type(psb_desc_type), intent(in) :: desc_data class(mld_z_diag_solver_type), intent(inout) :: sv 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 - complex(psb_dpk_),target, intent(inout) :: work(:) - integer, intent(out) :: info + complex(psb_dpk_),intent(in) :: alpha,beta + character(len=1),intent(in) :: trans + complex(psb_dpk_),target, intent(inout) :: work(:) + integer(psb_ipk_), intent(out) :: info - integer :: n_row,n_col + integer(psb_ipk_) :: n_row,n_col complex(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) - integer :: ictxt,np,me,i, err_act + integer(psb_ipk_) :: ictxt,np,me,i, err_act character :: trans_ character(len=20) :: name='z_diag_solver_apply' @@ -73,12 +73,14 @@ subroutine mld_z_diag_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,i n_col = desc_data%get_local_cols() if (x%get_nrows() < n_row) then info = 36 - call psb_errpush(info,name,i_err=(/2,n_row,0,0,0/)) + call psb_errpush(info,name,& + & i_err=(/itwo,n_row,izero,izero,izero/)) goto 9999 end if if (y%get_nrows() < n_row) then info = 36 - call psb_errpush(info,name,i_err=(/3,n_row,0,0,0/)) + call psb_errpush(info,name,& + & i_err=(/ithree,n_row,izero,izero,izero/)) goto 9999 end if if (.not.allocated(sv%dv)) then diff --git a/mlprec/impl/solver/mld_z_diag_solver_bld.f90 b/mlprec/impl/solver/mld_z_diag_solver_bld.f90 index cc146317..5407e63b 100644 --- a/mlprec/impl/solver/mld_z_diag_solver_bld.f90 +++ b/mlprec/impl/solver/mld_z_diag_solver_bld.f90 @@ -45,18 +45,18 @@ subroutine mld_z_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) ! Arguments type(psb_zspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_z_diag_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer, intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_zspmat_type), intent(in), target, optional :: b class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_vect_type), intent(in), optional :: vmold ! Local variables - integer :: n_row,n_col, nrow_a, nztota + integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota complex(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) - integer :: ictxt,np,me,i, err_act, debug_unit, debug_level - character(len=20) :: name='z_diag_solver_bld', ch_err + integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level + character(len=20) :: name='z_diag_solver_bld', ch_err info=psb_success_ call psb_erractionsave(err_act) @@ -111,7 +111,8 @@ subroutine mld_z_diag_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) if (info == psb_success_) then call sv%dv%bld(sv%d) else - call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate sv%dv') + call psb_errpush(psb_err_from_subroutine_,name,& + & a_err='Allocate sv%dv') goto 9999 end if diff --git a/mlprec/impl/solver/mld_z_id_solver_apply.f90 b/mlprec/impl/solver/mld_z_id_solver_apply.f90 index da054726..d23227e3 100644 --- a/mlprec/impl/solver/mld_z_id_solver_apply.f90 +++ b/mlprec/impl/solver/mld_z_id_solver_apply.f90 @@ -36,50 +36,50 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ - subroutine mld_z_id_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) - - use psb_base_mod - use mld_z_id_solver, mld_protect_name => mld_z_id_solver_apply - implicit none - type(psb_desc_type), intent(in) :: desc_data - class(mld_z_id_solver_type), intent(in) :: sv - 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 - complex(psb_dpk_),target, intent(inout) :: work(:) - integer, intent(out) :: info +subroutine mld_z_id_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) - integer :: n_row,n_col - integer :: ictxt,np,me,i, err_act - character :: trans_ - character(len=20) :: name='z_id_solver_apply' + use psb_base_mod + use mld_z_id_solver, mld_protect_name => mld_z_id_solver_apply + implicit none + type(psb_desc_type), intent(in) :: desc_data + class(mld_z_id_solver_type), intent(in) :: sv + 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 + complex(psb_dpk_),target, intent(inout) :: work(:) + integer(psb_ipk_), intent(out) :: info - call psb_erractionsave(err_act) + integer(psb_ipk_) :: n_row,n_col + integer(psb_ipk_) :: ictxt,np,me,i, err_act + character :: trans_ + character(len=20) :: name='z_id_solver_apply' - info = psb_success_ + call psb_erractionsave(err_act) - trans_ = psb_toupper(trans) - select case(trans_) - case('N') - case('T') - case('C') - case default - call psb_errpush(psb_err_iarg_invalid_i_,name) - goto 9999 - end select + info = psb_success_ - call psb_geaxpby(alpha,x,beta,y,desc_data,info) + trans_ = psb_toupper(trans) + select case(trans_) + case('N') + case('T') + case('C') + case default + call psb_errpush(psb_err_iarg_invalid_i_,name) + goto 9999 + end select - call psb_erractionrestore(err_act) - return + call psb_geaxpby(alpha,x,beta,y,desc_data,info) + + call psb_erractionrestore(err_act) + return 9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() return + end if + return - end subroutine mld_z_id_solver_apply +end subroutine mld_z_id_solver_apply diff --git a/mlprec/impl/solver/mld_z_id_solver_apply_vect.f90 b/mlprec/impl/solver/mld_z_id_solver_apply_vect.f90 index f6aab300..a09c2dd2 100644 --- a/mlprec/impl/solver/mld_z_id_solver_apply_vect.f90 +++ b/mlprec/impl/solver/mld_z_id_solver_apply_vect.f90 @@ -36,50 +36,50 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ - subroutine mld_z_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info) - - use psb_base_mod - use mld_z_id_solver, mld_protect_name => mld_z_id_solver_apply_vect - implicit none - type(psb_desc_type), intent(in) :: desc_data - class(mld_z_id_solver_type), intent(inout) :: sv - 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 - complex(psb_dpk_),target, intent(inout) :: work(:) - integer, intent(out) :: info +subroutine mld_z_id_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info) - integer :: n_row,n_col - integer :: ictxt,np,me,i, err_act - character :: trans_ - character(len=20) :: name='z_id_solver_apply_vect' + use psb_base_mod + use mld_z_id_solver, mld_protect_name => mld_z_id_solver_apply_vect + implicit none + type(psb_desc_type), intent(in) :: desc_data + class(mld_z_id_solver_type), intent(inout) :: sv + 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 + complex(psb_dpk_),target, intent(inout) :: work(:) + integer(psb_ipk_), intent(out) :: info - call psb_erractionsave(err_act) + integer(psb_ipk_) :: n_row,n_col + integer(psb_ipk_) :: ictxt,np,me,i, err_act + character :: trans_ + character(len=20) :: name='z_id_solver_apply_vect' - info = psb_success_ + call psb_erractionsave(err_act) - trans_ = psb_toupper(trans) - select case(trans_) - case('N') - case('T') - case('C') - case default - call psb_errpush(psb_err_iarg_invalid_i_,name) - goto 9999 - end select + info = psb_success_ - call psb_geaxpby(alpha,x,beta,y,desc_data,info) + trans_ = psb_toupper(trans) + select case(trans_) + case('N') + case('T') + case('C') + case default + call psb_errpush(psb_err_iarg_invalid_i_,name) + goto 9999 + end select - call psb_erractionrestore(err_act) - return + call psb_geaxpby(alpha,x,beta,y,desc_data,info) + + call psb_erractionrestore(err_act) + return 9999 continue - call psb_erractionrestore(err_act) - if (err_act == psb_act_abort_) then - call psb_error() - return - end if + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() return + end if + return - end subroutine mld_z_id_solver_apply_vect +end subroutine mld_z_id_solver_apply_vect diff --git a/mlprec/impl/solver/mld_z_ilu_solver_apply.f90 b/mlprec/impl/solver/mld_z_ilu_solver_apply.f90 index 01944e5e..29170ed6 100644 --- a/mlprec/impl/solver/mld_z_ilu_solver_apply.f90 +++ b/mlprec/impl/solver/mld_z_ilu_solver_apply.f90 @@ -41,18 +41,18 @@ subroutine mld_z_ilu_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) use psb_base_mod use mld_z_ilu_solver, mld_protect_name => mld_z_ilu_solver_apply implicit none - type(psb_desc_type), intent(in) :: desc_data + type(psb_desc_type), intent(in) :: desc_data class(mld_z_ilu_solver_type), intent(in) :: sv 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 + character(len=1),intent(in) :: trans complex(psb_dpk_),target, intent(inout) :: work(:) - integer, intent(out) :: info + integer(psb_ipk_), intent(out) :: info - integer :: n_row,n_col + integer(psb_ipk_) :: n_row,n_col complex(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) - integer :: ictxt,np,me,i, err_act + integer(psb_ipk_) :: ictxt,np,me,i, err_act character :: trans_ character(len=20) :: name='z_ilu_solver_apply' @@ -80,7 +80,8 @@ subroutine mld_z_ilu_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) allocate(aux(4*n_col),stat=info) if (info /= psb_success_) then info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/4*n_col,0,0,0,0/),& + call psb_errpush(info,name,& + & i_err=(/4*n_col,izero,izero,izero,izero/),& & a_err='complex(psb_dpk_)') goto 9999 end if @@ -89,7 +90,8 @@ subroutine mld_z_ilu_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) allocate(ww(n_col),aux(4*n_col),stat=info) if (info /= psb_success_) then info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/5*n_col,0,0,0,0/),& + call psb_errpush(info,name,& + & i_err=(/5*n_col,izero,izero,izero,izero/),& & a_err='complex(psb_dpk_)') goto 9999 end if @@ -114,14 +116,16 @@ subroutine mld_z_ilu_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info) if (info == psb_success_) call psb_spsm(alpha,sv%l,ww,beta,y,desc_data,info,& & trans=trans_,scale='U',choice=psb_none_,work=aux) case default - call psb_errpush(psb_err_internal_error_,name,a_err='Invalid TRANS in ILU subsolve') + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Invalid TRANS in ILU subsolve') goto 9999 end select if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,a_err='Error in subsolve') + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in subsolve') goto 9999 endif diff --git a/mlprec/impl/solver/mld_z_ilu_solver_apply_vect.f90 b/mlprec/impl/solver/mld_z_ilu_solver_apply_vect.f90 index f2d82880..e5839281 100644 --- a/mlprec/impl/solver/mld_z_ilu_solver_apply_vect.f90 +++ b/mlprec/impl/solver/mld_z_ilu_solver_apply_vect.f90 @@ -41,19 +41,19 @@ subroutine mld_z_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,in use psb_base_mod use mld_z_ilu_solver, mld_protect_name => mld_z_ilu_solver_apply_vect implicit none - type(psb_desc_type), intent(in) :: desc_data + type(psb_desc_type), intent(in) :: desc_data class(mld_z_ilu_solver_type), intent(inout) :: sv 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 - complex(psb_dpk_),target, intent(inout) :: work(:) - integer, intent(out) :: info + complex(psb_dpk_),intent(in) :: alpha,beta + character(len=1),intent(in) :: trans + complex(psb_dpk_),target, intent(inout) :: work(:) + integer(psb_ipk_), intent(out) :: info - integer :: n_row,n_col - type(psb_z_vect_type) :: wv, wv1 + integer(psb_ipk_) :: n_row,n_col + type(psb_z_vect_type) :: wv, wv1 complex(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) - integer :: ictxt,np,me,i, err_act + integer(psb_ipk_) :: ictxt,np,me,i, err_act character :: trans_ character(len=20) :: name='z_ilu_solver_apply' @@ -77,12 +77,14 @@ subroutine mld_z_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,in if (x%get_nrows() < n_row) then info = 36 - call psb_errpush(info,name,i_err=(/2,n_row,0,0,0/)) + call psb_errpush(info,name,& + & i_err=(/itwo,n_row,izero,izero,izero/)) goto 9999 end if if (y%get_nrows() < n_row) then info = 36 - call psb_errpush(info,name,i_err=(/3,n_row,0,0,0/)) + call psb_errpush(info,name,& + & i_err=(/ithree,n_row,izero,izero,izero/)) goto 9999 end if if (.not.allocated(sv%dv%v)) then @@ -111,7 +113,8 @@ subroutine mld_z_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,in if (info /= psb_success_) then info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/5*n_col,0,0,0,0/),& + call psb_errpush(info,name,& + & i_err=(/5*n_col,izero,izero,izero,izero/),& & a_err='complex(psb_dpk_)') goto 9999 end if @@ -144,14 +147,16 @@ subroutine mld_z_ilu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,in & trans=trans_,scale='U',choice=psb_none_,work=aux) case default - call psb_errpush(psb_err_internal_error_,name,a_err='Invalid TRANS in ILU subsolve') + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Invalid TRANS in ILU subsolve') goto 9999 end select if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,a_err='Error in subsolve') + call psb_errpush(psb_err_internal_error_,name,& + & a_err='Error in subsolve') goto 9999 endif call wv%free(info) diff --git a/mlprec/impl/solver/mld_z_ilu_solver_bld.f90 b/mlprec/impl/solver/mld_z_ilu_solver_bld.f90 index 333a1dd8..424b19d8 100644 --- a/mlprec/impl/solver/mld_z_ilu_solver_bld.f90 +++ b/mlprec/impl/solver/mld_z_ilu_solver_bld.f90 @@ -37,7 +37,6 @@ !!$ !!$ subroutine mld_z_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) - use psb_base_mod use mld_z_ilu_solver, mld_protect_name => mld_z_ilu_solver_bld @@ -46,18 +45,18 @@ subroutine mld_z_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) ! Arguments type(psb_zspmat_type), intent(in), target :: a - Type(psb_desc_type), Intent(in) :: desc_a + Type(psb_desc_type), Intent(in) :: desc_a class(mld_z_ilu_solver_type), intent(inout) :: sv - character, intent(in) :: upd - integer, intent(out) :: info + character, intent(in) :: upd + integer(psb_ipk_), intent(out) :: info type(psb_zspmat_type), intent(in), target, optional :: b class(psb_z_base_sparse_mat), intent(in), optional :: amold class(psb_z_base_vect_type), intent(in), optional :: vmold ! Local variables - integer :: n_row,n_col, nrow_a, nztota + integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota !!$ complex(psb_dpk_), pointer :: ww(:), aux(:), tx(:),ty(:) - integer :: ictxt,np,me,i, err_act, debug_unit, debug_level - character(len=20) :: name='z_ilu_solver_bld', ch_err + integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level + character(len=20) :: name='z_ilu_solver_bld', ch_err info=psb_success_ call psb_erractionsave(err_act) @@ -111,7 +110,7 @@ subroutine mld_z_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) case(:-1) ! Error: fill-in <= -1 call psb_errpush(psb_err_input_value_invalid_i_,& - & name,i_err=(/3,sv%fill_in,0,0,0/)) + & name,i_err=(/ithree,sv%fill_in,izero,izero,izero/)) goto 9999 case(0:) @@ -134,7 +133,7 @@ subroutine mld_z_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) case(:-1) ! Error: fill-in <= -1 call psb_errpush(psb_err_input_value_invalid_i_,& - & name,i_err=(/3,sv%fill_in,0,0,0/)) + & name,i_err=(/ithree,sv%fill_in,izero,izero,izero/)) goto 9999 case(0) ! Fill-in 0 @@ -166,7 +165,7 @@ subroutine mld_z_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) ! If we end up here, something was wrong up in the call chain. info = psb_err_input_value_invalid_i_ call psb_errpush(psb_err_input_value_invalid_i_,name,& - & i_err=(/3,sv%fact_type,0,0,0/)) + & i_err=(/ithree,sv%fact_type,izero,izero,izero/)) goto 9999 end select @@ -175,7 +174,7 @@ subroutine mld_z_ilu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold) ! For the time being just throw an error. info = 31 call psb_errpush(info, name,& - & i_err=(/3,0,0,0,0/),a_err=upd) + & i_err=(/ithree,izero,izero,izero,izero/),a_err=upd) goto 9999 ! diff --git a/mlprec/impl/solver/mld_z_ilu_solver_dmp.f90 b/mlprec/impl/solver/mld_z_ilu_solver_dmp.f90 index 104f0c82..d7c452ee 100644 --- a/mlprec/impl/solver/mld_z_ilu_solver_dmp.f90 +++ b/mlprec/impl/solver/mld_z_ilu_solver_dmp.f90 @@ -42,12 +42,12 @@ subroutine mld_z_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver) use mld_z_ilu_solver, mld_protect_name => mld_z_ilu_solver_dmp implicit none class(mld_z_ilu_solver_type), intent(in) :: sv - integer, intent(in) :: ictxt,level - integer, intent(out) :: info - character(len=*), intent(in), optional :: prefix, head - logical, optional, intent(in) :: solver - integer :: i, j, il1, iln, lname, lev - integer :: icontxt,iam, np + integer(psb_ipk_), intent(in) :: ictxt,level + integer(psb_ipk_), intent(out) :: info + character(len=*), intent(in), optional :: prefix, head + logical, optional, intent(in) :: solver + 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 :: solver_ diff --git a/mlprec/mld_c_ilu_fact_mod.f90 b/mlprec/mld_c_ilu_fact_mod.f90 index b8c13f7e..5ee59341 100644 --- a/mlprec/mld_c_ilu_fact_mod.f90 +++ b/mlprec/mld_c_ilu_fact_mod.f90 @@ -1,43 +1,81 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the MLD2P4 group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ module mld_c_ilu_fact_mod use mld_c_base_solver_mod interface mld_ilu0_fact subroutine mld_cilu0_fact(ialg,a,l,u,d,info,blck,upd) - import psb_cspmat_type, psb_spk_ - integer, intent(in) :: ialg - integer, intent(out) :: info - type(psb_cspmat_type),intent(in) :: a - type(psb_cspmat_type),intent(inout) :: l,u + import psb_cspmat_type, psb_spk_, psb_ipk_ + integer(psb_ipk_), intent(in) :: ialg + integer(psb_ipk_), intent(out) :: info + type(psb_cspmat_type),intent(in) :: a + type(psb_cspmat_type),intent(inout) :: l,u type(psb_cspmat_type),intent(in), optional, target :: blck - character, intent(in), optional :: upd - complex(psb_spk_), intent(inout) :: d(:) + character, intent(in), optional :: upd + complex(psb_spk_), intent(inout) :: d(:) end subroutine mld_cilu0_fact end interface interface mld_iluk_fact subroutine mld_ciluk_fact(fill_in,ialg,a,l,u,d,info,blck) - import psb_cspmat_type, psb_spk_ - integer, intent(in) :: fill_in,ialg - integer, intent(out) :: info - type(psb_cspmat_type),intent(in) :: a - type(psb_cspmat_type),intent(inout) :: l,u + import psb_cspmat_type, psb_spk_, psb_ipk_ + integer(psb_ipk_), intent(in) :: fill_in,ialg + integer(psb_ipk_), intent(out) :: info + type(psb_cspmat_type),intent(in) :: a + type(psb_cspmat_type),intent(inout) :: l,u type(psb_cspmat_type),intent(in), optional, target :: blck - complex(psb_spk_), intent(inout) :: d(:) + complex(psb_spk_), intent(inout) :: d(:) end subroutine mld_ciluk_fact end interface interface mld_ilut_fact subroutine mld_cilut_fact(fill_in,thres,a,l,u,d,info,blck,iscale) - import psb_cspmat_type, psb_spk_ - integer, intent(in) :: fill_in - real(psb_spk_), intent(in) :: thres - integer, intent(out) :: info - type(psb_cspmat_type),intent(in) :: a - type(psb_cspmat_type),intent(inout) :: l,u - complex(psb_spk_), intent(inout) :: d(:) + import psb_cspmat_type, psb_spk_, psb_ipk_ + integer(psb_ipk_), intent(in) :: fill_in + real(psb_spk_), intent(in) :: thres + integer(psb_ipk_), intent(out) :: info + type(psb_cspmat_type),intent(in) :: a + type(psb_cspmat_type),intent(inout) :: l,u + complex(psb_spk_), intent(inout) :: d(:) type(psb_cspmat_type),intent(in), optional, target :: blck - integer, intent(in), optional :: iscale + integer(psb_ipk_), intent(in), optional :: iscale end subroutine mld_cilut_fact end interface diff --git a/mlprec/mld_d_ilu_fact_mod.f90 b/mlprec/mld_d_ilu_fact_mod.f90 index 913b229c..d8a9752f 100644 --- a/mlprec/mld_d_ilu_fact_mod.f90 +++ b/mlprec/mld_d_ilu_fact_mod.f90 @@ -1,43 +1,81 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the MLD2P4 group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ module mld_d_ilu_fact_mod use mld_d_base_solver_mod interface mld_ilu0_fact subroutine mld_dilu0_fact(ialg,a,l,u,d,info,blck,upd) - import psb_dspmat_type, psb_dpk_ - integer, intent(in) :: ialg - integer, intent(out) :: info - type(psb_dspmat_type),intent(in) :: a - type(psb_dspmat_type),intent(inout) :: l,u + import psb_dspmat_type, psb_dpk_, psb_ipk_ + integer(psb_ipk_), intent(in) :: ialg + integer(psb_ipk_), intent(out) :: info + type(psb_dspmat_type),intent(in) :: a + type(psb_dspmat_type),intent(inout) :: l,u type(psb_dspmat_type),intent(in), optional, target :: blck - character, intent(in), optional :: upd - real(psb_dpk_), intent(inout) :: d(:) + character, intent(in), optional :: upd + real(psb_dpk_), intent(inout) :: d(:) end subroutine mld_dilu0_fact end interface interface mld_iluk_fact subroutine mld_diluk_fact(fill_in,ialg,a,l,u,d,info,blck) - import psb_dspmat_type, psb_dpk_ - integer, intent(in) :: fill_in,ialg - integer, intent(out) :: info - type(psb_dspmat_type),intent(in) :: a - type(psb_dspmat_type),intent(inout) :: l,u + import psb_dspmat_type, psb_dpk_, psb_ipk_ + integer(psb_ipk_), intent(in) :: fill_in,ialg + integer(psb_ipk_), intent(out) :: info + type(psb_dspmat_type),intent(in) :: a + type(psb_dspmat_type),intent(inout) :: l,u type(psb_dspmat_type),intent(in), optional, target :: blck - real(psb_dpk_), intent(inout) :: d(:) + real(psb_dpk_), intent(inout) :: d(:) end subroutine mld_diluk_fact end interface interface mld_ilut_fact subroutine mld_dilut_fact(fill_in,thres,a,l,u,d,info,blck,iscale) - import psb_dspmat_type, psb_dpk_ - integer, intent(in) :: fill_in - real(psb_dpk_), intent(in) :: thres - integer, intent(out) :: info - type(psb_dspmat_type),intent(in) :: a - type(psb_dspmat_type),intent(inout) :: l,u - real(psb_dpk_), intent(inout) :: d(:) + import psb_dspmat_type, psb_dpk_, psb_ipk_ + integer(psb_ipk_), intent(in) :: fill_in + real(psb_dpk_), intent(in) :: thres + integer(psb_ipk_), intent(out) :: info + type(psb_dspmat_type),intent(in) :: a + type(psb_dspmat_type),intent(inout) :: l,u + real(psb_dpk_), intent(inout) :: d(:) type(psb_dspmat_type),intent(in), optional, target :: blck - integer, intent(in), optional :: iscale + integer(psb_ipk_), intent(in), optional :: iscale end subroutine mld_dilut_fact end interface diff --git a/mlprec/mld_s_ilu_fact_mod.f90 b/mlprec/mld_s_ilu_fact_mod.f90 index db7a493c..5e894ffa 100644 --- a/mlprec/mld_s_ilu_fact_mod.f90 +++ b/mlprec/mld_s_ilu_fact_mod.f90 @@ -1,43 +1,81 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the MLD2P4 group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ module mld_s_ilu_fact_mod use mld_s_base_solver_mod interface mld_ilu0_fact subroutine mld_silu0_fact(ialg,a,l,u,d,info,blck,upd) - import psb_sspmat_type, psb_spk_ - integer, intent(in) :: ialg - integer, intent(out) :: info - type(psb_sspmat_type),intent(in) :: a - type(psb_sspmat_type),intent(inout) :: l,u + import psb_sspmat_type, psb_spk_, psb_ipk_ + integer(psb_ipk_), intent(in) :: ialg + integer(psb_ipk_), intent(out) :: info + type(psb_sspmat_type),intent(in) :: a + type(psb_sspmat_type),intent(inout) :: l,u type(psb_sspmat_type),intent(in), optional, target :: blck - character, intent(in), optional :: upd - real(psb_spk_), intent(inout) :: d(:) + character, intent(in), optional :: upd + real(psb_spk_), intent(inout) :: d(:) end subroutine mld_silu0_fact end interface interface mld_iluk_fact subroutine mld_siluk_fact(fill_in,ialg,a,l,u,d,info,blck) - import psb_sspmat_type, psb_spk_ - integer, intent(in) :: fill_in,ialg - integer, intent(out) :: info - type(psb_sspmat_type),intent(in) :: a - type(psb_sspmat_type),intent(inout) :: l,u + import psb_sspmat_type, psb_spk_, psb_ipk_ + integer(psb_ipk_), intent(in) :: fill_in,ialg + integer(psb_ipk_), intent(out) :: info + type(psb_sspmat_type),intent(in) :: a + type(psb_sspmat_type),intent(inout) :: l,u type(psb_sspmat_type),intent(in), optional, target :: blck - real(psb_spk_), intent(inout) :: d(:) + real(psb_spk_), intent(inout) :: d(:) end subroutine mld_siluk_fact end interface interface mld_ilut_fact subroutine mld_silut_fact(fill_in,thres,a,l,u,d,info,blck,iscale) - import psb_sspmat_type, psb_spk_ - integer, intent(in) :: fill_in - real(psb_spk_), intent(in) :: thres - integer, intent(out) :: info - type(psb_sspmat_type),intent(in) :: a - type(psb_sspmat_type),intent(inout) :: l,u - real(psb_spk_), intent(inout) :: d(:) + import psb_sspmat_type, psb_spk_, psb_ipk_ + integer(psb_ipk_), intent(in) :: fill_in + real(psb_spk_), intent(in) :: thres + integer(psb_ipk_), intent(out) :: info + type(psb_sspmat_type),intent(in) :: a + type(psb_sspmat_type),intent(inout) :: l,u + real(psb_spk_), intent(inout) :: d(:) type(psb_sspmat_type),intent(in), optional, target :: blck - integer, intent(in), optional :: iscale + integer(psb_ipk_), intent(in), optional :: iscale end subroutine mld_silut_fact end interface diff --git a/mlprec/mld_z_ilu_fact_mod.f90 b/mlprec/mld_z_ilu_fact_mod.f90 index 37905a5e..9c5e7056 100644 --- a/mlprec/mld_z_ilu_fact_mod.f90 +++ b/mlprec/mld_z_ilu_fact_mod.f90 @@ -1,43 +1,81 @@ +!!$ +!!$ +!!$ MLD2P4 version 2.0 +!!$ MultiLevel Domain Decomposition Parallel Preconditioners Package +!!$ based on PSBLAS (Parallel Sparse BLAS version 3.0) +!!$ +!!$ (C) Copyright 2008,2009,2010,2012 +!!$ +!!$ Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari CNRS-IRIT, Toulouse +!!$ Pasqua D'Ambra ICAR-CNR, Naples +!!$ Daniela di Serafino Second University of Naples +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the MLD2P4 group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE MLD2P4 GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ module mld_z_ilu_fact_mod use mld_z_base_solver_mod interface mld_ilu0_fact subroutine mld_zilu0_fact(ialg,a,l,u,d,info,blck,upd) - import psb_zspmat_type, psb_dpk_ - integer, intent(in) :: ialg - integer, intent(out) :: info - type(psb_zspmat_type),intent(in) :: a - type(psb_zspmat_type),intent(inout) :: l,u + import psb_zspmat_type, psb_dpk_, psb_ipk_ + integer(psb_ipk_), intent(in) :: ialg + integer(psb_ipk_), intent(out) :: info + type(psb_zspmat_type),intent(in) :: a + type(psb_zspmat_type),intent(inout) :: l,u type(psb_zspmat_type),intent(in), optional, target :: blck - character, intent(in), optional :: upd - complex(psb_dpk_), intent(inout) :: d(:) + character, intent(in), optional :: upd + complex(psb_dpk_), intent(inout) :: d(:) end subroutine mld_zilu0_fact end interface interface mld_iluk_fact subroutine mld_ziluk_fact(fill_in,ialg,a,l,u,d,info,blck) - import psb_zspmat_type, psb_dpk_ - integer, intent(in) :: fill_in,ialg - integer, intent(out) :: info - type(psb_zspmat_type),intent(in) :: a - type(psb_zspmat_type),intent(inout) :: l,u + import psb_zspmat_type, psb_dpk_, psb_ipk_ + integer(psb_ipk_), intent(in) :: fill_in,ialg + integer(psb_ipk_), intent(out) :: info + type(psb_zspmat_type),intent(in) :: a + type(psb_zspmat_type),intent(inout) :: l,u type(psb_zspmat_type),intent(in), optional, target :: blck - complex(psb_dpk_), intent(inout) :: d(:) + complex(psb_dpk_), intent(inout) :: d(:) end subroutine mld_ziluk_fact end interface interface mld_ilut_fact subroutine mld_zilut_fact(fill_in,thres,a,l,u,d,info,blck,iscale) - import psb_zspmat_type, psb_dpk_ - integer, intent(in) :: fill_in - real(psb_dpk_), intent(in) :: thres - integer, intent(out) :: info - type(psb_zspmat_type),intent(in) :: a - type(psb_zspmat_type),intent(inout) :: l,u - complex(psb_dpk_), intent(inout) :: d(:) + import psb_zspmat_type, psb_dpk_, psb_ipk_ + integer(psb_ipk_), intent(in) :: fill_in + real(psb_dpk_), intent(in) :: thres + integer(psb_ipk_), intent(out) :: info + type(psb_zspmat_type),intent(in) :: a + type(psb_zspmat_type),intent(inout) :: l,u + complex(psb_dpk_), intent(inout) :: d(:) type(psb_zspmat_type),intent(in), optional, target :: blck - integer, intent(in), optional :: iscale + integer(psb_ipk_), intent(in), optional :: iscale end subroutine mld_zilut_fact end interface