From df4f84e3ee5bb40e50f41de1ec574443e7c688a1 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Thu, 6 Dec 2012 17:03:23 +0000 Subject: [PATCH] mld2p4-2: mlprec/impl/mld_caggrmat_asb.f90 mlprec/impl/mld_caggrmat_biz_asb.f90 mlprec/impl/mld_caggrmat_minnrg_asb.f90 mlprec/impl/mld_caggrmat_nosmth_asb.f90 mlprec/impl/mld_caggrmat_smth_asb.f90 mlprec/impl/mld_cilu0_fact.f90 mlprec/impl/mld_ciluk_fact.f90 mlprec/impl/mld_cilut_fact.f90 mlprec/impl/mld_cmlprec_aply.f90 mlprec/impl/mld_cmlprec_bld.f90 mlprec/impl/mld_cprecaply.f90 mlprec/impl/mld_cprecbld.f90 mlprec/impl/mld_daggrmat_asb.f90 mlprec/impl/mld_daggrmat_biz_asb.f90 mlprec/impl/mld_daggrmat_minnrg_asb.f90 mlprec/impl/mld_daggrmat_nosmth_asb.f90 mlprec/impl/mld_daggrmat_smth_asb.f90 mlprec/impl/mld_dilu0_fact.f90 mlprec/impl/mld_diluk_fact.f90 mlprec/impl/mld_dilut_fact.f90 mlprec/impl/mld_dmlprec_aply.f90 mlprec/impl/mld_dmlprec_bld.f90 mlprec/impl/mld_dprecaply.f90 mlprec/impl/mld_dprecbld.f90 mlprec/impl/mld_saggrmat_asb.f90 mlprec/impl/mld_saggrmat_biz_asb.f90 mlprec/impl/mld_saggrmat_minnrg_asb.f90 mlprec/impl/mld_saggrmat_nosmth_asb.f90 mlprec/impl/mld_saggrmat_smth_asb.f90 mlprec/impl/mld_silu0_fact.f90 mlprec/impl/mld_siluk_fact.f90 mlprec/impl/mld_silut_fact.f90 mlprec/impl/mld_smlprec_aply.f90 mlprec/impl/mld_smlprec_bld.f90 mlprec/impl/mld_sprecaply.f90 mlprec/impl/mld_sprecbld.f90 mlprec/impl/mld_zaggrmat_asb.f90 mlprec/impl/mld_zaggrmat_biz_asb.f90 mlprec/impl/mld_zaggrmat_minnrg_asb.f90 mlprec/impl/mld_zaggrmat_nosmth_asb.f90 mlprec/impl/mld_zaggrmat_smth_asb.f90 mlprec/impl/mld_zilu0_fact.f90 mlprec/impl/mld_ziluk_fact.f90 mlprec/impl/mld_zilut_fact.f90 mlprec/impl/mld_zmlprec_aply.f90 mlprec/impl/mld_zmlprec_bld.f90 mlprec/impl/mld_zprecaply.f90 mlprec/impl/mld_zprecbld.f90 mlprec/mld_base_prec_type.F90 mlprec/mld_c_as_smoother.f90 mlprec/mld_c_base_smoother_mod.f90 mlprec/mld_c_base_solver_mod.f90 mlprec/mld_c_ilu_solver.f90 mlprec/mld_c_onelev_mod.f90 mlprec/mld_c_prec_type.f90 mlprec/mld_d_as_smoother.f90 mlprec/mld_d_base_smoother_mod.f90 mlprec/mld_d_base_solver_mod.f90 mlprec/mld_d_ilu_solver.f90 mlprec/mld_d_onelev_mod.f90 mlprec/mld_d_prec_type.f90 mlprec/mld_s_as_smoother.f90 mlprec/mld_s_base_smoother_mod.f90 mlprec/mld_s_base_solver_mod.f90 mlprec/mld_s_ilu_solver.f90 mlprec/mld_s_onelev_mod.f90 mlprec/mld_s_prec_type.f90 mlprec/mld_z_as_smoother.f90 mlprec/mld_z_base_smoother_mod.f90 mlprec/mld_z_base_solver_mod.f90 mlprec/mld_z_ilu_solver.f90 mlprec/mld_z_onelev_mod.f90 mlprec/mld_z_prec_type.f90 Long integer fixes. --- mlprec/impl/mld_caggrmat_asb.f90 | 2 +- mlprec/impl/mld_caggrmat_biz_asb.f90 | 2 +- mlprec/impl/mld_caggrmat_minnrg_asb.f90 | 4 +- mlprec/impl/mld_caggrmat_nosmth_asb.f90 | 2 +- mlprec/impl/mld_caggrmat_smth_asb.f90 | 2 +- mlprec/impl/mld_cilu0_fact.f90 | 59 +++++----- mlprec/impl/mld_ciluk_fact.f90 | 94 ++++++++-------- mlprec/impl/mld_cilut_fact.f90 | 87 +++++++-------- mlprec/impl/mld_cmlprec_aply.f90 | 8 +- mlprec/impl/mld_cmlprec_bld.f90 | 2 +- mlprec/impl/mld_cprecaply.f90 | 8 +- mlprec/impl/mld_cprecbld.f90 | 4 +- mlprec/impl/mld_daggrmat_asb.f90 | 2 +- mlprec/impl/mld_daggrmat_biz_asb.f90 | 2 +- mlprec/impl/mld_daggrmat_minnrg_asb.f90 | 4 +- mlprec/impl/mld_daggrmat_nosmth_asb.f90 | 2 +- mlprec/impl/mld_daggrmat_smth_asb.f90 | 2 +- mlprec/impl/mld_dilu0_fact.f90 | 73 +++++++------ mlprec/impl/mld_diluk_fact.f90 | 98 +++++++++-------- mlprec/impl/mld_dilut_fact.f90 | 132 +++++++++++----------- mlprec/impl/mld_dmlprec_aply.f90 | 8 +- mlprec/impl/mld_dmlprec_bld.f90 | 2 +- mlprec/impl/mld_dprecaply.f90 | 8 +- mlprec/impl/mld_dprecbld.f90 | 4 +- mlprec/impl/mld_saggrmat_asb.f90 | 2 +- mlprec/impl/mld_saggrmat_biz_asb.f90 | 2 +- mlprec/impl/mld_saggrmat_minnrg_asb.f90 | 4 +- mlprec/impl/mld_saggrmat_nosmth_asb.f90 | 2 +- mlprec/impl/mld_saggrmat_smth_asb.f90 | 2 +- mlprec/impl/mld_silu0_fact.f90 | 73 +++++++------ mlprec/impl/mld_siluk_fact.f90 | 104 +++++++++--------- mlprec/impl/mld_silut_fact.f90 | 118 ++++++++++---------- mlprec/impl/mld_smlprec_aply.f90 | 8 +- mlprec/impl/mld_smlprec_bld.f90 | 2 +- mlprec/impl/mld_sprecaply.f90 | 8 +- mlprec/impl/mld_sprecbld.f90 | 4 +- mlprec/impl/mld_zaggrmat_asb.f90 | 2 +- mlprec/impl/mld_zaggrmat_biz_asb.f90 | 2 +- mlprec/impl/mld_zaggrmat_minnrg_asb.f90 | 4 +- mlprec/impl/mld_zaggrmat_nosmth_asb.f90 | 2 +- mlprec/impl/mld_zaggrmat_smth_asb.f90 | 2 +- mlprec/impl/mld_zilu0_fact.f90 | 57 +++++----- mlprec/impl/mld_ziluk_fact.f90 | 86 ++++++++------- mlprec/impl/mld_zilut_fact.f90 | 139 ++++++++++++------------ mlprec/impl/mld_zmlprec_aply.f90 | 8 +- mlprec/impl/mld_zmlprec_bld.f90 | 2 +- mlprec/impl/mld_zprecaply.f90 | 8 +- mlprec/impl/mld_zprecbld.f90 | 4 +- mlprec/mld_base_prec_type.F90 | 14 +-- mlprec/mld_c_as_smoother.f90 | 4 +- mlprec/mld_c_base_smoother_mod.f90 | 4 +- mlprec/mld_c_base_solver_mod.f90 | 4 +- mlprec/mld_c_ilu_solver.f90 | 4 +- mlprec/mld_c_onelev_mod.f90 | 2 +- mlprec/mld_c_prec_type.f90 | 8 +- mlprec/mld_d_as_smoother.f90 | 4 +- mlprec/mld_d_base_smoother_mod.f90 | 4 +- mlprec/mld_d_base_solver_mod.f90 | 4 +- mlprec/mld_d_ilu_solver.f90 | 4 +- mlprec/mld_d_onelev_mod.f90 | 2 +- mlprec/mld_d_prec_type.f90 | 8 +- mlprec/mld_s_as_smoother.f90 | 4 +- mlprec/mld_s_base_smoother_mod.f90 | 4 +- mlprec/mld_s_base_solver_mod.f90 | 4 +- mlprec/mld_s_ilu_solver.f90 | 4 +- mlprec/mld_s_onelev_mod.f90 | 2 +- mlprec/mld_s_prec_type.f90 | 8 +- mlprec/mld_z_as_smoother.f90 | 4 +- mlprec/mld_z_base_smoother_mod.f90 | 4 +- mlprec/mld_z_base_solver_mod.f90 | 4 +- mlprec/mld_z_ilu_solver.f90 | 4 +- mlprec/mld_z_onelev_mod.f90 | 2 +- mlprec/mld_z_prec_type.f90 | 8 +- 73 files changed, 700 insertions(+), 674 deletions(-) diff --git a/mlprec/impl/mld_caggrmat_asb.f90 b/mlprec/impl/mld_caggrmat_asb.f90 index 3d6bd6cf..539296de 100644 --- a/mlprec/impl/mld_caggrmat_asb.f90 +++ b/mlprec/impl/mld_caggrmat_asb.f90 @@ -118,7 +118,7 @@ subroutine mld_caggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info) type(psb_c_csr_sparse_mat) :: acsr1 integer(psb_ipk_) :: nzl,ntaggr, err_act integer(psb_ipk_) :: debug_level, debug_unit - integer(psb_mpik_) :: ictxt,np,me + integer(psb_ipk_) :: ictxt,np,me character(len=20) :: name name='mld_aggrmat_asb' diff --git a/mlprec/impl/mld_caggrmat_biz_asb.f90 b/mlprec/impl/mld_caggrmat_biz_asb.f90 index 5471b318..0f30ea6d 100644 --- a/mlprec/impl/mld_caggrmat_biz_asb.f90 +++ b/mlprec/impl/mld_caggrmat_biz_asb.f90 @@ -95,7 +95,7 @@ subroutine mld_caggrmat_biz_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr ! Local variables integer(psb_ipk_) :: nrow, nglob, ncol, ntaggr, ip, ndx,& & naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw, err_act - integer(psb_mpik_) ::ictxt, np, me + integer(psb_ipk_) ::ictxt, np, me character(len=20) :: name type(psb_cspmat_type) :: am3, am4 type(psb_c_coo_sparse_mat) :: tmpcoo diff --git a/mlprec/impl/mld_caggrmat_minnrg_asb.f90 b/mlprec/impl/mld_caggrmat_minnrg_asb.f90 index 4c2af56a..335fd75c 100644 --- a/mlprec/impl/mld_caggrmat_minnrg_asb.f90 +++ b/mlprec/impl/mld_caggrmat_minnrg_asb.f90 @@ -116,7 +116,7 @@ subroutine mld_caggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re integer(psb_ipk_), allocatable :: nzbr(:), idisp(:) integer(psb_ipk_) :: nrow, nglob, ncol, ntaggr, nzac, ip, ndx,& & naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrt, err_act - integer(psb_mpik_) :: ictxt,np,me, icomm + integer(psb_ipk_) :: ictxt,np,me, icomm character(len=20) :: name type(psb_cspmat_type) :: af, ptilde, rtilde, atran, atp, atdatp type(psb_cspmat_type) :: am3,am4, ap, adap,atmp,rada, ra, atmp2, dap, dadap, da @@ -688,7 +688,7 @@ contains subroutine local_dump(me,mat,name,header) type(psb_cspmat_type), intent(in) :: mat - integer(psb_mpik_), intent(in) :: me + integer(psb_ipk_), intent(in) :: me character(len=*), intent(in) :: name character(len=*), intent(in) :: header character(len=80) :: filename diff --git a/mlprec/impl/mld_caggrmat_nosmth_asb.f90 b/mlprec/impl/mld_caggrmat_nosmth_asb.f90 index 953e8576..57405feb 100644 --- a/mlprec/impl/mld_caggrmat_nosmth_asb.f90 +++ b/mlprec/impl/mld_caggrmat_nosmth_asb.f90 @@ -97,7 +97,7 @@ subroutine mld_caggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re ! Local variables integer(psb_ipk_) :: err_act - integer(psb_mpik_) :: ictxt,np,me, icomm, ndx, minfo + integer(psb_ipk_) :: ictxt,np,me, icomm, ndx, minfo character(len=20) :: name integer(psb_ipk_) :: ierr(5) type(psb_c_coo_sparse_mat) :: ac_coo, acoo diff --git a/mlprec/impl/mld_caggrmat_smth_asb.f90 b/mlprec/impl/mld_caggrmat_smth_asb.f90 index 3876ff89..fe9a2bc0 100644 --- a/mlprec/impl/mld_caggrmat_smth_asb.f90 +++ b/mlprec/impl/mld_caggrmat_smth_asb.f90 @@ -110,7 +110,7 @@ subroutine mld_caggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest ! Local variables integer(psb_ipk_) :: nrow, nglob, ncol, ntaggr, ip, ndx,& & naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw, err_act - integer(psb_mpik_) ::ictxt, np, me + integer(psb_ipk_) ::ictxt, np, me character(len=20) :: name type(psb_cspmat_type) :: am3, am4 type(psb_c_coo_sparse_mat) :: tmpcoo diff --git a/mlprec/impl/mld_cilu0_fact.f90 b/mlprec/impl/mld_cilu0_fact.f90 index 99cf31f9..4ca4e2d3 100644 --- a/mlprec/impl/mld_cilu0_fact.f90 +++ b/mlprec/impl/mld_cilu0_fact.f90 @@ -107,19 +107,19 @@ subroutine mld_cilu0_fact(ialg,a,l,u,d,info,blck, upd) implicit none ! Arguments - integer, intent(in) :: ialg + integer(psb_ipk_), intent(in) :: ialg type(psb_cspmat_type),intent(in) :: a type(psb_cspmat_type),intent(inout) :: l,u - complex(psb_spk_), intent(inout) :: d(:) - integer, intent(out) :: info + complex(psb_spk_), intent(inout) :: d(:) + integer(psb_ipk_), intent(out) :: info type(psb_cspmat_type),intent(in), optional, target :: blck - character, intent(in), optional :: upd + character, intent(in), optional :: upd ! Local variables - integer :: l1, l2, m, err_act + integer(psb_ipk_) :: l1, l2, m, err_act type(psb_cspmat_type), pointer :: blck_ - type(psb_c_csr_sparse_mat) :: ll, uu - character :: upd_ + type(psb_c_csr_sparse_mat) :: ll, uu + character :: upd_ character(len=20) :: name, ch_err name='mld_cilu0_fact' @@ -133,7 +133,7 @@ subroutine mld_cilu0_fact(ialg,a,l,u,d,info,blck, upd) blck_ => blck else allocate(blck_,stat=info) - if (info == psb_success_) call blck_%csall(0,0,info,1) + if (info == psb_success_) call blck_%csall(izero,izero,info,ione) if (info /= psb_success_) then info=psb_err_from_subroutine_ ch_err='csall' @@ -292,20 +292,20 @@ contains implicit none ! Arguments - integer, intent(in) :: ialg + integer(psb_ipk_), intent(in) :: ialg type(psb_cspmat_type),intent(in) :: a,b - integer,intent(inout) :: l1,l2,info - integer, intent(inout) :: lja(:),lirp(:),uja(:),uirp(:) + integer(psb_ipk_),intent(inout) :: l1,l2,info + integer(psb_ipk_), intent(inout) :: lja(:),lirp(:),uja(:),uirp(:) complex(psb_spk_), intent(inout) :: lval(:),uval(:),d(:) character, intent(in) :: upd ! Local variables - integer :: i,j,k,l,low1,low2,kk,jj,ll, ktrw,err_act, m - integer :: ma,mb + integer(psb_ipk_) :: i,j,k,l,low1,low2,kk,jj,ll, ktrw,err_act, m + integer(psb_ipk_) :: ma,mb complex(psb_spk_) :: dia,temp - integer, parameter :: nrb=16 + integer(psb_ipk_), parameter :: nrb=16 type(psb_c_coo_sparse_mat) :: trw - integer :: int_err(5) + integer(psb_ipk_) :: int_err(5) character(len=20) :: name, ch_err name='mld_cilu0_factint' @@ -320,11 +320,12 @@ contains ! Ok case default info=psb_err_input_asize_invalid_i_ - call psb_errpush(info,name,i_err=(/1,ialg,0,0,0/)) + call psb_errpush(info,name,& + & i_err=(/ione,ialg,izero,izero,izero/)) goto 9999 end select - call trw%allocate(0,0,1) + call trw%allocate(izero,izero,ione) if(info /= psb_success_) then info=psb_err_from_subroutine_ ch_err='psb_sp_all' @@ -351,14 +352,14 @@ contains ! Copy the i-th local row of the matrix, stored in a, ! into lval/d(i)/uval ! - call ilu_copyin(i,ma,a,i,1,m,l1,lja,lval,& + call ilu_copyin(i,ma,a,i,ione,m,l1,lja,lval,& & d(i),l2,uja,uval,ktrw,trw,upd) else ! ! Copy the i-th local row of the matrix, stored in b ! (as (i-ma)-th row), into lval/d(i)/uval ! - call ilu_copyin(i-ma,mb,b,i,1,m,l1,lja,lval,& + call ilu_copyin(i-ma,mb,b,i,ione,m,l1,lja,lval,& & d(i),l2,uja,uval,ktrw,trw,upd) endif @@ -437,7 +438,7 @@ contains ! ! Check the pivot size ! - if (abs(dia) < d_epstol) then + if (abs(dia) < s_epstol) then ! ! Too small pivot: unstable factorization ! @@ -463,7 +464,8 @@ contains else write(0,*) 'Update not implemented ' info = 31 - call psb_errpush(info,name,i_err=(/13,0,0,0,0/),a_err=upd) + call psb_errpush(info,name,& + & i_err=(/ione*13,izero,izero,izero,izero/),a_err=upd) goto 9999 end if @@ -564,14 +566,14 @@ contains ! Arguments type(psb_cspmat_type), intent(in) :: a type(psb_c_coo_sparse_mat), intent(inout) :: trw - integer, intent(in) :: i,m,jd,jmin,jmax - integer, intent(inout) :: ktrw,l1,l2 - integer, intent(inout) :: lja(:), uja(:) - complex(psb_spk_), intent(inout) :: lval(:), uval(:), dia + integer(psb_ipk_), intent(in) :: i,m,jd,jmin,jmax + integer(psb_ipk_), intent(inout) :: ktrw,l1,l2 + integer(psb_ipk_), intent(inout) :: lja(:), uja(:) + complex(psb_spk_), intent(inout) :: lval(:), uval(:), dia character, intent(in) :: upd ! Local variables - integer :: k,j,info,irb, nz - integer, parameter :: nrb=40 + integer(psb_ipk_) :: k,j,info,irb, nz + integer(psb_ipk_), parameter :: nrb=40 character(len=20), parameter :: name='ilu_copyin' character(len=20) :: ch_err @@ -650,7 +652,8 @@ contains write(0,*) 'Update not implemented ' info = 31 - call psb_errpush(info,name,i_err=(/13,0,0,0,0/),a_err=upd) + call psb_errpush(info,name,& + & i_err=(/ione*13,izero,izero,izero,izero/),a_err=upd) goto 9999 end if diff --git a/mlprec/impl/mld_ciluk_fact.f90 b/mlprec/impl/mld_ciluk_fact.f90 index a5d9f24d..b634f6f6 100644 --- a/mlprec/impl/mld_ciluk_fact.f90 +++ b/mlprec/impl/mld_ciluk_fact.f90 @@ -104,17 +104,17 @@ subroutine mld_ciluk_fact(fill_in,ialg,a,l,u,d,info,blck) implicit none ! Arguments - integer, intent(in) :: fill_in, ialg - integer, intent(out) :: info + 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(:) ! Local Variables - integer :: l1, l2, m, err_act + integer(psb_ipk_) :: l1, l2, m, err_act type(psb_cspmat_type), pointer :: blck_ - type(psb_c_csr_sparse_mat) :: ll, uu + type(psb_c_csr_sparse_mat) :: ll, uu character(len=20) :: name, ch_err name='mld_ciluk_fact' @@ -128,7 +128,7 @@ subroutine mld_ciluk_fact(fill_in,ialg,a,l,u,d,info,blck) blck_ => blck else allocate(blck_,stat=info) - if (info == psb_success_) call blck_%csall(0,0,info,1) + if (info == psb_success_) call blck_%csall(izero,izero,info,ione) if (info /= psb_success_) then info=psb_err_from_subroutine_ ch_err='csall' @@ -278,21 +278,21 @@ contains implicit none ! Arguments - integer, intent(in) :: fill_in, ialg - type(psb_cspmat_type),intent(in) :: a,b - integer,intent(inout) :: l1,l2,info - integer, allocatable, intent(inout) :: lja(:),lirp(:),uja(:),uirp(:) + integer(psb_ipk_), intent(in) :: fill_in, ialg + type(psb_cspmat_type),intent(in) :: a,b + integer(psb_ipk_),intent(inout) :: l1,l2,info + integer(psb_ipk_), allocatable, intent(inout) :: lja(:),lirp(:),uja(:),uirp(:) complex(psb_spk_), allocatable, intent(inout) :: lval(:),uval(:) complex(psb_spk_), intent(inout) :: d(:) ! Local variables - integer :: ma,mb,i, ktrw,err_act,nidx, m - integer, allocatable :: uplevs(:), rowlevs(:),idxs(:) + integer(psb_ipk_) :: ma,mb,i, ktrw,err_act,nidx, m + integer(psb_ipk_), allocatable :: uplevs(:), rowlevs(:),idxs(:) complex(psb_spk_), allocatable :: row(:) type(psb_int_heap) :: heap - type(psb_c_coo_sparse_mat) :: trw - character(len=20), parameter :: name='mld_ciluk_factint' - character(len=20) :: ch_err + type(psb_c_coo_sparse_mat) :: trw + character(len=20), parameter :: name='mld_ciluk_factint' + character(len=20) :: ch_err if (psb_get_errstatus() /= 0) return info=psb_success_ @@ -304,12 +304,14 @@ contains ! Ok case default info=psb_err_input_asize_invalid_i_ - call psb_errpush(info,name,i_err=(/2,ialg,0,0,0/)) + call psb_errpush(info,name,& + & i_err=(/itwo,ialg,izero,izero,izero/)) goto 9999 end select if (fill_in < 0) then info=psb_err_input_asize_invalid_i_ - call psb_errpush(info,name,i_err=(/1,fill_in,0,0,0/)) + call psb_errpush(info,name, & + & i_err=(/ione,fill_in,izero,izero,izero/)) goto 9999 end if @@ -321,7 +323,7 @@ contains ! Allocate a temporary buffer for the iluk_copyin function ! - call trw%allocate(0,0,1) + call trw%allocate(izero,izero,ione) if (info == psb_success_) call psb_ensure_size(m+1,lirp,info) if (info == psb_success_) call psb_ensure_size(m+1,uirp,info) @@ -369,13 +371,13 @@ contains ! ! Copy into trw the i-th local row of the matrix, stored in a ! - call iluk_copyin(i,ma,a,1,m,row,rowlevs,heap,ktrw,trw,info) + call iluk_copyin(i,ma,a,ione,m,row,rowlevs,heap,ktrw,trw,info) else ! ! Copy into trw the i-th local row of the matrix, stored in b ! (as (i-ma)-th row) ! - call iluk_copyin(i-ma,mb,b,1,m,row,rowlevs,heap,ktrw,trw,info) + call iluk_copyin(i-ma,mb,b,ione,m,row,rowlevs,heap,ktrw,trw,info) endif ! Do an elimination step on the current row. It turns out we only @@ -397,7 +399,7 @@ contains end do ! - ! And we're sone, so deallocate the memory + ! And we're done, so deallocate the memory ! deallocate(uplevs,rowlevs,row,stat=info) if (info /= psb_success_) then @@ -476,7 +478,7 @@ contains ! The heap containing the column indices of the nonzero ! entries in the array row. ! Note: this argument is intent(inout) and not only intent(out) - ! to retain its allocation, sone by psb_init_heap inside this + ! to retain its allocation, done by psb_init_heap inside this ! routine. ! ktrw - integer, input/output. ! The index identifying the last entry taken from the @@ -496,17 +498,17 @@ contains implicit none ! Arguments - type(psb_cspmat_type), intent(in) :: a + type(psb_cspmat_type), intent(in) :: a type(psb_c_coo_sparse_mat), intent(inout) :: trw - integer, intent(in) :: i,m,jmin,jmax - integer, intent(inout) :: ktrw,info - integer, intent(inout) :: rowlevs(:) - complex(psb_spk_), intent(inout) :: row(:) - type(psb_int_heap), intent(inout) :: heap + integer(psb_ipk_), intent(in) :: i,m,jmin,jmax + integer(psb_ipk_), intent(inout) :: ktrw,info + integer(psb_ipk_), intent(inout) :: rowlevs(:) + complex(psb_spk_), intent(inout) :: row(:) + type(psb_int_heap), intent(inout) :: heap ! Local variables - integer :: k,j,irb,err_act,nz - integer, parameter :: nrb=40 + integer(psb_ipk_) :: k,j,irb,err_act,nz + integer(psb_ipk_), parameter :: nrb=40 character(len=20), parameter :: name='iluk_copyin' character(len=20) :: ch_err @@ -644,7 +646,7 @@ contains ! examined during the elimination step.This will be used by ! by the routine iluk_copyout. ! Note: this argument is intent(inout) and not only intent(out) - ! to retain its allocation, sone by this routine. + ! to retain its allocation, done by this routine. ! subroutine iluk_fact(fill_in,i,row,rowlevs,heap,d,uja,uirp,uval,uplevs,nidx,idxs,info) @@ -653,16 +655,16 @@ contains implicit none ! Arguments - type(psb_int_heap), intent(inout) :: heap - integer, intent(in) :: i, fill_in - integer, intent(inout) :: nidx,info - integer, intent(inout) :: rowlevs(:) - integer, allocatable, intent(inout) :: idxs(:) - integer, intent(inout) :: uja(:),uirp(:),uplevs(:) - complex(psb_spk_), intent(inout) :: row(:), uval(:),d(:) + type(psb_int_heap), intent(inout) :: heap + integer(psb_ipk_), intent(in) :: i, fill_in + integer(psb_ipk_), intent(inout) :: nidx,info + integer(psb_ipk_), intent(inout) :: rowlevs(:) + integer(psb_ipk_), allocatable, intent(inout) :: idxs(:) + integer(psb_ipk_), intent(inout) :: uja(:),uirp(:),uplevs(:) + complex(psb_spk_), intent(inout) :: row(:), uval(:),d(:) ! Local variables - integer :: k,j,lrwk,jj,lastk, iret + integer(psb_ipk_) :: k,j,lrwk,jj,lastk, iret complex(psb_spk_) :: rwk info = psb_success_ @@ -829,15 +831,15 @@ contains implicit none ! Arguments - integer, intent(in) :: fill_in, ialg, i, m, nidx - integer, intent(inout) :: l1, l2, info - integer, intent(inout) :: rowlevs(:), idxs(:) - integer, allocatable, intent(inout) :: uja(:), uirp(:), lja(:), lirp(:),uplevs(:) - complex(psb_spk_), allocatable, intent(inout) :: uval(:), lval(:) + integer(psb_ipk_), intent(in) :: fill_in, ialg, i, m, nidx + integer(psb_ipk_), intent(inout) :: l1, l2, info + integer(psb_ipk_), intent(inout) :: rowlevs(:), idxs(:) + integer(psb_ipk_), allocatable, intent(inout) :: uja(:), uirp(:), lja(:), lirp(:),uplevs(:) + complex(psb_spk_), allocatable, intent(inout) :: uval(:), lval(:) complex(psb_spk_), intent(inout) :: row(:), d(:) ! Local variables - integer :: j,isz,err_act,int_err(5),idxp + integer(psb_ipk_) :: j,isz,err_act,int_err(5),idxp character(len=20), parameter :: name='mld_ciluk_factint' character(len=20) :: ch_err @@ -940,7 +942,7 @@ contains ! ! Check the pivot size ! - if (abs(d(i)) < d_epstol) then + if (abs(d(i)) < s_epstol) then ! ! Too small pivot: unstable factorization ! diff --git a/mlprec/impl/mld_cilut_fact.f90 b/mlprec/impl/mld_cilut_fact.f90 index f82994b1..154eebdf 100644 --- a/mlprec/impl/mld_cilut_fact.f90 +++ b/mlprec/impl/mld_cilut_fact.f90 @@ -100,16 +100,16 @@ subroutine mld_cilut_fact(fill_in,thres,a,l,u,d,info,blck,iscale) implicit none ! Arguments - integer, intent(in) :: fill_in - real(psb_spk_), intent(in) :: thres - integer, intent(out) :: info + 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(:) + 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 ! Local Variables - integer :: l1, l2, m, err_act, iscale_ + integer(psb_ipk_) :: l1, l2, m, err_act, iscale_ type(psb_cspmat_type), pointer :: blck_ type(psb_c_csr_sparse_mat) :: ll, uu @@ -122,7 +122,8 @@ subroutine mld_cilut_fact(fill_in,thres,a,l,u,d,info,blck,iscale) if (fill_in < 0) then info=psb_err_input_asize_invalid_i_ - call psb_errpush(info,name,i_err=(/1,fill_in,0,0,0/)) + call psb_errpush(info,name, & + & i_err=(/ione,fill_in,izero,izero,izero/)) goto 9999 end if ! @@ -132,7 +133,7 @@ subroutine mld_cilut_fact(fill_in,thres,a,l,u,d,info,blck,iscale) blck_ => blck else allocate(blck_,stat=info) - if (info == psb_success_) call blck_%csall(0,0,info,1) + if (info == psb_success_) call blck_%csall(izero,izero,info,ione) if (info /= psb_success_) then info=psb_err_from_subroutine_ ch_err='csall' @@ -154,7 +155,7 @@ subroutine mld_cilut_fact(fill_in,thres,a,l,u,d,info,blck,iscale) scale = sone/scale case default info=psb_err_input_asize_invalid_i_ - call psb_errpush(info,name,i_err=(/9,iscale_,0,0,0/)) + call psb_errpush(info,name,i_err=(/ione*9,iscale_,izero,izero,izero/)) goto 9999 end select @@ -296,20 +297,20 @@ contains implicit none ! Arguments - integer, intent(in) :: fill_in - real(psb_spk_), intent(in) :: thres - type(psb_cspmat_type),intent(in) :: a,b - integer,intent(inout) :: l1,l2,info - integer, allocatable, intent(inout) :: lja(:),lirp(:),uja(:),uirp(:) - complex(psb_spk_), allocatable, intent(inout) :: lval(:),uval(:) - complex(psb_spk_), intent(inout) :: d(:) - real(psb_spk_), intent(in), optional :: scale + integer(psb_ipk_), intent(in) :: fill_in + real(psb_spk_), intent(in) :: thres + type(psb_cspmat_type),intent(in) :: a,b + integer(psb_ipk_),intent(inout) :: l1,l2,info + integer(psb_ipk_), allocatable, intent(inout) :: lja(:),lirp(:),uja(:),uirp(:) + complex(psb_spk_), allocatable, intent(inout) :: lval(:),uval(:) + complex(psb_spk_), intent(inout) :: d(:) + real(psb_spk_), intent(in), optional :: scale ! Local Variables - integer :: i, ktrw,err_act,nidx,nlw,nup,jmaxup, ma, mb, m + integer(psb_ipk_) :: i, ktrw,err_act,nidx,nlw,nup,jmaxup, ma, mb, m real(psb_spk_) :: nrmi real(psb_spk_) :: weight - integer, allocatable :: idxs(:) + integer(psb_ipk_), allocatable :: idxs(:) complex(psb_spk_), allocatable :: row(:) type(psb_int_heap) :: heap type(psb_c_coo_sparse_mat) :: trw @@ -328,7 +329,7 @@ contains ! ! Allocate a temporary buffer for the ilut_copyin function ! - call trw%allocate(0,0,1) + call trw%allocate(izero,izero,ione) if (info == psb_success_) call psb_ensure_size(m+1,lirp,info) if (info == psb_success_) call psb_ensure_size(m+1,uirp,info) @@ -371,10 +372,10 @@ contains ! d(i) = czero if (i<=ma) then - call ilut_copyin(i,ma,a,i,1,m,nlw,nup,jmaxup,nrmi,weight,& + call ilut_copyin(i,ma,a,i,ione,m,nlw,nup,jmaxup,nrmi,weight,& & row,heap,ktrw,trw,info) else - call ilut_copyin(i-ma,mb,b,i,1,m,nlw,nup,jmaxup,nrmi,weight,& + call ilut_copyin(i-ma,mb,b,i,ione,m,nlw,nup,jmaxup,nrmi,weight,& & row,heap,ktrw,trw,info) endif @@ -520,15 +521,15 @@ contains implicit none type(psb_cspmat_type), intent(in) :: a type(psb_c_coo_sparse_mat), intent(inout) :: trw - integer, intent(in) :: i, m,jmin,jmax,jd - integer, intent(inout) :: ktrw,nlw,nup,jmaxup,info - real(psb_spk_), intent(inout) :: nrmi - complex(psb_spk_), intent(inout) :: row(:) - real(psb_spk_), intent(in) :: weight + integer(psb_ipk_), intent(in) :: i, m,jmin,jmax,jd + integer(psb_ipk_), intent(inout) :: ktrw,nlw,nup,jmaxup,info + real(psb_spk_), intent(inout) :: nrmi + complex(psb_spk_), intent(inout) :: row(:) + real(psb_spk_), intent(in) :: weight type(psb_int_heap), intent(inout) :: heap - integer :: k,j,irb,kin,nz - integer, parameter :: nrb=40 + integer(psb_ipk_) :: k,j,irb,kin,nz + integer(psb_ipk_), parameter :: nrb=40 real(psb_spk_) :: dmaxup real(psb_spk_), external :: dnrm2 character(len=20), parameter :: name='mld_cilut_factint' @@ -716,19 +717,19 @@ contains ! Arguments type(psb_int_heap), intent(inout) :: heap - integer, intent(in) :: i - integer, intent(inout) :: nidx,info + integer(psb_ipk_), intent(in) :: i + integer(psb_ipk_), intent(inout) :: nidx,info real(psb_spk_), intent(in) :: thres,nrmi - integer, allocatable, intent(inout) :: idxs(:) - integer, intent(inout) :: uja(:),uirp(:) + integer(psb_ipk_), allocatable, intent(inout) :: idxs(:) + integer(psb_ipk_), intent(inout) :: uja(:),uirp(:) complex(psb_spk_), intent(inout) :: row(:), uval(:),d(:) ! Local Variables - integer :: k,j,jj,lastk,iret + integer(psb_ipk_) :: k,j,jj,lastk,iret complex(psb_spk_) :: rwk info = psb_success_ - call psb_ensure_size(200,idxs,info) + call psb_ensure_size(200*ione,idxs,info) if (info /= psb_success_) return nidx = 0 lastk = -1 @@ -902,20 +903,20 @@ contains implicit none ! Arguments - integer, intent(in) :: fill_in,i,m,nidx,nlw,nup,jmaxup - integer, intent(in) :: idxs(:) - integer, intent(inout) :: l1,l2, info - integer, allocatable, intent(inout) :: uja(:),uirp(:), lja(:),lirp(:) + integer(psb_ipk_), intent(in) :: fill_in,i,m,nidx,nlw,nup,jmaxup + integer(psb_ipk_), intent(in) :: idxs(:) + integer(psb_ipk_), intent(inout) :: l1,l2, info + integer(psb_ipk_), allocatable, intent(inout) :: uja(:),uirp(:), lja(:),lirp(:) real(psb_spk_), intent(in) :: thres,nrmi complex(psb_spk_),allocatable, intent(inout) :: uval(:), lval(:) complex(psb_spk_), intent(inout) :: row(:), d(:) ! Local variables complex(psb_spk_),allocatable :: xw(:) - integer, allocatable :: xwid(:), indx(:) + integer(psb_ipk_), allocatable :: xwid(:), indx(:) complex(psb_spk_) :: witem - integer :: widx - integer :: k,isz,err_act,int_err(5),idxp, nz + integer(psb_ipk_) :: widx + integer(psb_ipk_) :: k,isz,err_act,int_err(5),idxp, nz type(psb_scomplex_idx_heap) :: heap character(len=20), parameter :: name='ilut_copyout' character(len=20) :: ch_err @@ -939,7 +940,7 @@ contains if (info == psb_success_) allocate(xwid(nidx),xw(nidx),indx(nidx),stat=info) if (info /= psb_success_) then info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/3*nidx,0,0,0,0/),& + call psb_errpush(info,name,i_err=(/3*nidx,izero,izero,izero,izero/),& & a_err='complex(psb_spk_)') goto 9999 end if diff --git a/mlprec/impl/mld_cmlprec_aply.f90 b/mlprec/impl/mld_cmlprec_aply.f90 index 7839745e..31439544 100644 --- a/mlprec/impl/mld_cmlprec_aply.f90 +++ b/mlprec/impl/mld_cmlprec_aply.f90 @@ -325,7 +325,7 @@ subroutine mld_cmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info) integer(psb_ipk_), intent(out) :: info ! Local variables - integer(psb_mpik_) :: ictxt, np, me + integer(psb_ipk_) :: ictxt, np, me integer(psb_ipk_) :: err_act integer(psb_ipk_) :: debug_level, debug_unit, nlev,nc2l,nr2l,level character(len=20) :: name @@ -416,7 +416,7 @@ contains integer(psb_ipk_), intent(out) :: info ! Local variables - integer(psb_mpik_) :: ictxt,np,me + integer(psb_ipk_) :: ictxt,np,me integer(psb_ipk_) :: i, nr2l,nc2l,err_act integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: nlev, ilev, sweeps @@ -877,7 +877,7 @@ subroutine mld_cmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info) integer(psb_ipk_), intent(out) :: info ! Local variables - integer(psb_mpik_) :: ictxt, np, me + integer(psb_ipk_) :: ictxt, np, me integer(psb_ipk_) :: debug_level, debug_unit, nlev,nc2l,nr2l,level, err_act character(len=20) :: name character :: trans_ @@ -993,7 +993,7 @@ contains integer(psb_ipk_), intent(out) :: info ! Local variables - integer(psb_mpik_) :: ictxt,np,me + integer(psb_ipk_) :: ictxt,np,me integer(psb_ipk_) :: i, nr2l,nc2l,err_act integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: nlev, ilev, sweeps diff --git a/mlprec/impl/mld_cmlprec_bld.f90 b/mlprec/impl/mld_cmlprec_bld.f90 index aed33fc0..c097b479 100644 --- a/mlprec/impl/mld_cmlprec_bld.f90 +++ b/mlprec/impl/mld_cmlprec_bld.f90 @@ -93,7 +93,7 @@ subroutine mld_cmlprec_bld(a,desc_a,p,info,amold,vmold) ! Local Variables type(mld_cprec_type) :: t_prec - integer(psb_mpik_) :: ictxt, me,np + integer(psb_ipk_) :: ictxt, me,np integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize integer(psb_ipk_) :: ipv(mld_ifpsz_), val integer(psb_ipk_) :: int_err(5) diff --git a/mlprec/impl/mld_cprecaply.f90 b/mlprec/impl/mld_cprecaply.f90 index 641dfee4..f433f0cb 100644 --- a/mlprec/impl/mld_cprecaply.f90 +++ b/mlprec/impl/mld_cprecaply.f90 @@ -90,7 +90,7 @@ subroutine mld_cprecaply(prec,x,y,desc_data,info,trans,work) ! Local variables character :: trans_ complex(psb_spk_), pointer :: work_(:) - integer(psb_mpik_) :: ictxt,np,me + integer(psb_ipk_) :: ictxt,np,me integer(psb_ipk_) :: err_act,iwsz character(len=20) :: name @@ -221,7 +221,7 @@ subroutine mld_cprecaply1(prec,x,desc_data,info,trans) character(len=1), optional :: trans ! Local variables - integer(psb_mpik_) :: ictxt,np,me + integer(psb_ipk_) :: ictxt,np,me integer(psb_ipk_) :: err_act complex(psb_spk_), pointer :: WW(:), w1(:) character(len=20) :: name @@ -290,7 +290,7 @@ subroutine mld_cprecaply2_vect(prec,x,y,desc_data,info,trans,work) ! Local variables character :: trans_ complex(psb_spk_), pointer :: work_(:) - integer(psb_mpik_) :: ictxt,np,me + integer(psb_ipk_) :: ictxt,np,me integer(psb_ipk_) :: err_act,iwsz character(len=20) :: name @@ -395,7 +395,7 @@ subroutine mld_cprecaply1_vect(prec,x,desc_data,info,trans,work) character :: trans_ type(psb_c_vect_type) :: ww complex(psb_spk_), pointer :: work_(:) - integer(psb_mpik_) :: ictxt,np,me + integer(psb_ipk_) :: ictxt,np,me integer(psb_ipk_) :: err_act,iwsz character(len=20) :: name diff --git a/mlprec/impl/mld_cprecbld.f90 b/mlprec/impl/mld_cprecbld.f90 index 1cc653e8..50c0d881 100644 --- a/mlprec/impl/mld_cprecbld.f90 +++ b/mlprec/impl/mld_cprecbld.f90 @@ -76,8 +76,8 @@ subroutine mld_cprecbld(a,desc_a,p,info,amold,vmold) !!$ character, intent(in), optional :: upd ! Local Variables - type(mld_cprec_type) :: t_prec - integer(psb_mpik_) :: ictxt, me,np + type(mld_cprec_type) :: t_prec + integer(psb_ipk_) :: ictxt, me,np integer(psb_ipk_) :: err,i,k,err_act, iszv, newsz integer(psb_ipk_) :: ipv(mld_ifpsz_), val integer(psb_ipk_) :: int_err(5) diff --git a/mlprec/impl/mld_daggrmat_asb.f90 b/mlprec/impl/mld_daggrmat_asb.f90 index 5c281b19..77e66446 100644 --- a/mlprec/impl/mld_daggrmat_asb.f90 +++ b/mlprec/impl/mld_daggrmat_asb.f90 @@ -118,7 +118,7 @@ subroutine mld_daggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info) type(psb_d_csr_sparse_mat) :: acsr1 integer(psb_ipk_) :: nzl,ntaggr, err_act integer(psb_ipk_) :: debug_level, debug_unit - integer(psb_mpik_) :: ictxt,np,me + integer(psb_ipk_) :: ictxt,np,me character(len=20) :: name name='mld_aggrmat_asb' diff --git a/mlprec/impl/mld_daggrmat_biz_asb.f90 b/mlprec/impl/mld_daggrmat_biz_asb.f90 index aca829d7..c3e30088 100644 --- a/mlprec/impl/mld_daggrmat_biz_asb.f90 +++ b/mlprec/impl/mld_daggrmat_biz_asb.f90 @@ -95,7 +95,7 @@ subroutine mld_daggrmat_biz_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr ! Local variables integer(psb_ipk_) :: nrow, nglob, ncol, ntaggr, ip, ndx,& & naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw, err_act - integer(psb_mpik_) ::ictxt, np, me + integer(psb_ipk_) ::ictxt, np, me character(len=20) :: name type(psb_dspmat_type) :: am3, am4 type(psb_d_coo_sparse_mat) :: tmpcoo diff --git a/mlprec/impl/mld_daggrmat_minnrg_asb.f90 b/mlprec/impl/mld_daggrmat_minnrg_asb.f90 index 0360a4e2..679a09a5 100644 --- a/mlprec/impl/mld_daggrmat_minnrg_asb.f90 +++ b/mlprec/impl/mld_daggrmat_minnrg_asb.f90 @@ -116,7 +116,7 @@ subroutine mld_daggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re integer(psb_ipk_), allocatable :: nzbr(:), idisp(:) integer(psb_ipk_) :: nrow, nglob, ncol, ntaggr, nzac, ip, ndx,& & naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrt, err_act - integer(psb_mpik_) :: ictxt,np,me, icomm + integer(psb_ipk_) :: ictxt,np,me, icomm character(len=20) :: name type(psb_dspmat_type) :: af, ptilde, rtilde, atran, atp, atdatp type(psb_dspmat_type) :: am3,am4, ap, adap,atmp,rada, ra, atmp2, dap, dadap, da @@ -688,7 +688,7 @@ contains subroutine local_dump(me,mat,name,header) type(psb_dspmat_type), intent(in) :: mat - integer(psb_mpik_), intent(in) :: me + integer(psb_ipk_), intent(in) :: me character(len=*), intent(in) :: name character(len=*), intent(in) :: header character(len=80) :: filename diff --git a/mlprec/impl/mld_daggrmat_nosmth_asb.f90 b/mlprec/impl/mld_daggrmat_nosmth_asb.f90 index 7b4d548e..f68fe1d4 100644 --- a/mlprec/impl/mld_daggrmat_nosmth_asb.f90 +++ b/mlprec/impl/mld_daggrmat_nosmth_asb.f90 @@ -97,7 +97,7 @@ subroutine mld_daggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re ! Local variables integer(psb_ipk_) :: err_act - integer(psb_mpik_) :: ictxt,np,me, icomm, ndx, minfo + integer(psb_ipk_) :: ictxt,np,me, icomm, ndx, minfo character(len=20) :: name integer(psb_ipk_) :: ierr(5) type(psb_d_coo_sparse_mat) :: ac_coo, acoo diff --git a/mlprec/impl/mld_daggrmat_smth_asb.f90 b/mlprec/impl/mld_daggrmat_smth_asb.f90 index 33cb97c9..c64bf60d 100644 --- a/mlprec/impl/mld_daggrmat_smth_asb.f90 +++ b/mlprec/impl/mld_daggrmat_smth_asb.f90 @@ -110,7 +110,7 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest ! Local variables integer(psb_ipk_) :: nrow, nglob, ncol, ntaggr, ip, ndx,& & naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw, err_act - integer(psb_mpik_) ::ictxt, np, me + integer(psb_ipk_) ::ictxt, np, me character(len=20) :: name type(psb_dspmat_type) :: am3, am4 type(psb_d_coo_sparse_mat) :: tmpcoo diff --git a/mlprec/impl/mld_dilu0_fact.f90 b/mlprec/impl/mld_dilu0_fact.f90 index 2b325909..ea86a699 100644 --- a/mlprec/impl/mld_dilu0_fact.f90 +++ b/mlprec/impl/mld_dilu0_fact.f90 @@ -62,7 +62,7 @@ ! u (U factor, except its diagonal) and d (diagonal of U). ! ! This implementation of ILU(0)/MILU(0) is faster than the implementation in -! mld_diluk_fct (the latter routine performs the more general ILU(k)/MILU(k)). +! mld_ziluk_fct (the latter routine performs the more general ILU(k)/MILU(k)). ! ! ! Arguments: @@ -107,19 +107,19 @@ subroutine mld_dilu0_fact(ialg,a,l,u,d,info,blck, upd) implicit none ! Arguments - integer, intent(in) :: ialg + integer(psb_ipk_), intent(in) :: ialg type(psb_dspmat_type),intent(in) :: a type(psb_dspmat_type),intent(inout) :: l,u - real(psb_dpk_), intent(inout) :: d(:) - integer, intent(out) :: info + real(psb_dpk_), intent(inout) :: d(:) + integer(psb_ipk_), intent(out) :: info type(psb_dspmat_type),intent(in), optional, target :: blck - character, intent(in), optional :: upd + character, intent(in), optional :: upd ! Local variables - integer :: l1, l2, m, err_act + integer(psb_ipk_) :: l1, l2, m, err_act type(psb_dspmat_type), pointer :: blck_ - type(psb_d_csr_sparse_mat) :: ll, uu - character :: upd_ + type(psb_d_csr_sparse_mat) :: ll, uu + character :: upd_ character(len=20) :: name, ch_err name='mld_dilu0_fact' @@ -133,7 +133,7 @@ subroutine mld_dilu0_fact(ialg,a,l,u,d,info,blck, upd) blck_ => blck else allocate(blck_,stat=info) - if (info == psb_success_) call blck_%csall(0,0,info,1) + if (info == psb_success_) call blck_%csall(izero,izero,info,ione) if (info /= psb_success_) then info=psb_err_from_subroutine_ ch_err='csall' @@ -261,19 +261,19 @@ contains ! d - real(psb_dpk_), dimension(:), output. ! The inverse of the diagonal entries of the U factor in the ! incomplete factorization. - ! lval - real(psb_dpk_), dimension(:), input/output. + ! lval - real(psb_dpk_), dimension(:), input/output. ! The entries of U are stored according to the CSR format. ! The L factor in the incomplete factorization. - ! lja - integer, dimension(:), input/output. + ! lja - integer, dimension(:), input/output. ! The column indices of the nonzero entries of the L factor, ! according to the CSR storage format. ! lirp - integer, dimension(:), input/output. ! The indices identifying the first nonzero entry of each row ! of the L factor in lval, according to the CSR storage format. - ! uval - real(psb_dpk_), dimension(:), input/output. + ! uval - real(psb_dpk_), dimension(:), input/output. ! The U factor in the incomplete factorization. ! The entries of U are stored according to the CSR format. - ! uja - integer, dimension(:), input/output. + ! uja - integer, dimension(:), input/output. ! The column indices of the nonzero entries of the U factor, ! according to the CSR storage format. ! uirp - integer, dimension(:), input/output. @@ -292,20 +292,20 @@ contains implicit none ! Arguments - integer, intent(in) :: ialg - type(psb_dspmat_type),intent(in) :: a,b - integer,intent(inout) :: l1,l2,info - integer, intent(inout) :: lja(:),lirp(:),uja(:),uirp(:) - real(psb_dpk_), intent(inout) :: lval(:),uval(:),d(:) + integer(psb_ipk_), intent(in) :: ialg + type(psb_dspmat_type),intent(in) :: a,b + integer(psb_ipk_),intent(inout) :: l1,l2,info + integer(psb_ipk_), intent(inout) :: lja(:),lirp(:),uja(:),uirp(:) + real(psb_dpk_), intent(inout) :: lval(:),uval(:),d(:) character, intent(in) :: upd ! Local variables - integer :: i,j,k,l,low1,low2,kk,jj,ll, ktrw,err_act, m - integer :: ma,mb + integer(psb_ipk_) :: i,j,k,l,low1,low2,kk,jj,ll, ktrw,err_act, m + integer(psb_ipk_) :: ma,mb real(psb_dpk_) :: dia,temp - integer, parameter :: nrb=16 + integer(psb_ipk_), parameter :: nrb=16 type(psb_d_coo_sparse_mat) :: trw - integer :: int_err(5) + integer(psb_ipk_) :: int_err(5) character(len=20) :: name, ch_err name='mld_dilu0_factint' @@ -320,11 +320,12 @@ contains ! Ok case default info=psb_err_input_asize_invalid_i_ - call psb_errpush(info,name,i_err=(/1,ialg,0,0,0/)) + call psb_errpush(info,name,& + & i_err=(/ione,ialg,izero,izero,izero/)) goto 9999 end select - call trw%allocate(0,0,1) + call trw%allocate(izero,izero,ione) if(info /= psb_success_) then info=psb_err_from_subroutine_ ch_err='psb_sp_all' @@ -344,21 +345,21 @@ contains ! do i = 1, m - d(i) = dzero + d(i) = dzero if (i <= ma) then ! ! Copy the i-th local row of the matrix, stored in a, ! into lval/d(i)/uval ! - call ilu_copyin(i,ma,a,i,1,m,l1,lja,lval,& + call ilu_copyin(i,ma,a,i,ione,m,l1,lja,lval,& & d(i),l2,uja,uval,ktrw,trw,upd) else ! ! Copy the i-th local row of the matrix, stored in b ! (as (i-ma)-th row), into lval/d(i)/uval ! - call ilu_copyin(i-ma,mb,b,i,1,m,l1,lja,lval,& + call ilu_copyin(i-ma,mb,b,i,ione,m,l1,lja,lval,& & d(i),l2,uja,uval,ktrw,trw,upd) endif @@ -463,7 +464,8 @@ contains else write(0,*) 'Update not implemented ' info = 31 - call psb_errpush(info,name,i_err=(/13,0,0,0,0/),a_err=upd) + call psb_errpush(info,name,& + & i_err=(/ione*13,izero,izero,izero,izero/),a_err=upd) goto 9999 end if @@ -564,14 +566,14 @@ contains ! Arguments type(psb_dspmat_type), intent(in) :: a type(psb_d_coo_sparse_mat), intent(inout) :: trw - integer, intent(in) :: i,m,jd,jmin,jmax - integer, intent(inout) :: ktrw,l1,l2 - integer, intent(inout) :: lja(:), uja(:) - real(psb_dpk_), intent(inout) :: lval(:), uval(:), dia + integer(psb_ipk_), intent(in) :: i,m,jd,jmin,jmax + integer(psb_ipk_), intent(inout) :: ktrw,l1,l2 + integer(psb_ipk_), intent(inout) :: lja(:), uja(:) + real(psb_dpk_), intent(inout) :: lval(:), uval(:), dia character, intent(in) :: upd ! Local variables - integer :: k,j,info,irb, nz - integer, parameter :: nrb=40 + integer(psb_ipk_) :: k,j,info,irb, nz + integer(psb_ipk_), parameter :: nrb=40 character(len=20), parameter :: name='ilu_copyin' character(len=20) :: ch_err @@ -650,7 +652,8 @@ contains write(0,*) 'Update not implemented ' info = 31 - call psb_errpush(info,name,i_err=(/13,0,0,0,0/),a_err=upd) + call psb_errpush(info,name,& + & i_err=(/ione*13,izero,izero,izero,izero/),a_err=upd) goto 9999 end if diff --git a/mlprec/impl/mld_diluk_fact.f90 b/mlprec/impl/mld_diluk_fact.f90 index 9955bf25..2fdcfa7a 100644 --- a/mlprec/impl/mld_diluk_fact.f90 +++ b/mlprec/impl/mld_diluk_fact.f90 @@ -104,17 +104,17 @@ subroutine mld_diluk_fact(fill_in,ialg,a,l,u,d,info,blck) implicit none ! Arguments - integer, intent(in) :: fill_in, ialg - integer, intent(out) :: info + 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(:) ! Local Variables - integer :: l1, l2, m, err_act + integer(psb_ipk_) :: l1, l2, m, err_act type(psb_dspmat_type), pointer :: blck_ - type(psb_d_csr_sparse_mat) :: ll, uu + type(psb_d_csr_sparse_mat) :: ll, uu character(len=20) :: name, ch_err name='mld_diluk_fact' @@ -128,7 +128,7 @@ subroutine mld_diluk_fact(fill_in,ialg,a,l,u,d,info,blck) blck_ => blck else allocate(blck_,stat=info) - if (info == psb_success_) call blck_%csall(0,0,info,1) + if (info == psb_success_) call blck_%csall(izero,izero,info,ione) if (info /= psb_success_) then info=psb_err_from_subroutine_ ch_err='csall' @@ -242,7 +242,7 @@ contains ! distributed matrix, that have been retrieved by mld_as_bld ! to build an Additive Schwarz base preconditioner with overlap ! greater than 0. If the overlap is 0 or the matrix has been reordered - ! (see mld_fact_bld), then b does not contain any row. + ! (see mld_fact_bld), then b does not contain any row. ! d - real(psb_dpk_), dimension(:), output. ! The inverse of the diagonal entries of the U factor in the incomplete ! factorization. @@ -254,10 +254,10 @@ contains ! lia2 - integer, dimension(:), input/output. ! The indices identifying the first nonzero entry of each row ! of the L factor in laspk, according to the CSR storage format. - ! uval - real(psb_dpk_), dimension(:), input/output. + ! uval - real(psb_dpk_), dimension(:), input/output. ! The U factor in the incomplete factorization. ! The entries of U are stored according to the CSR format. - ! uja - integer, dimension(:), input/output. + ! uja - integer, dimension(:), input/output. ! The column indices of the nonzero entries of the U factor, ! according to the CSR storage format. ! uirp - integer, dimension(:), input/output. @@ -278,21 +278,21 @@ contains implicit none ! Arguments - integer, intent(in) :: fill_in, ialg - type(psb_dspmat_type),intent(in) :: a,b - integer,intent(inout) :: l1,l2,info - integer, allocatable, intent(inout) :: lja(:),lirp(:),uja(:),uirp(:) + integer(psb_ipk_), intent(in) :: fill_in, ialg + type(psb_dspmat_type),intent(in) :: a,b + integer(psb_ipk_),intent(inout) :: l1,l2,info + integer(psb_ipk_), allocatable, intent(inout) :: lja(:),lirp(:),uja(:),uirp(:) real(psb_dpk_), allocatable, intent(inout) :: lval(:),uval(:) real(psb_dpk_), intent(inout) :: d(:) ! Local variables - integer :: ma,mb,i, ktrw,err_act,nidx, m - integer, allocatable :: uplevs(:), rowlevs(:),idxs(:) + integer(psb_ipk_) :: ma,mb,i, ktrw,err_act,nidx, m + integer(psb_ipk_), allocatable :: uplevs(:), rowlevs(:),idxs(:) real(psb_dpk_), allocatable :: row(:) type(psb_int_heap) :: heap - type(psb_d_coo_sparse_mat) :: trw - character(len=20), parameter :: name='mld_diluk_factint' - character(len=20) :: ch_err + type(psb_d_coo_sparse_mat) :: trw + character(len=20), parameter :: name='mld_diluk_factint' + character(len=20) :: ch_err if (psb_get_errstatus() /= 0) return info=psb_success_ @@ -304,12 +304,14 @@ contains ! Ok case default info=psb_err_input_asize_invalid_i_ - call psb_errpush(info,name,i_err=(/2,ialg,0,0,0/)) + call psb_errpush(info,name,& + & i_err=(/itwo,ialg,izero,izero,izero/)) goto 9999 end select if (fill_in < 0) then info=psb_err_input_asize_invalid_i_ - call psb_errpush(info,name,i_err=(/1,fill_in,0,0,0/)) + call psb_errpush(info,name, & + & i_err=(/ione,fill_in,izero,izero,izero/)) goto 9999 end if @@ -321,7 +323,7 @@ contains ! Allocate a temporary buffer for the iluk_copyin function ! - call trw%allocate(0,0,1) + call trw%allocate(izero,izero,ione) if (info == psb_success_) call psb_ensure_size(m+1,lirp,info) if (info == psb_success_) call psb_ensure_size(m+1,uirp,info) @@ -369,13 +371,13 @@ contains ! ! Copy into trw the i-th local row of the matrix, stored in a ! - call iluk_copyin(i,ma,a,1,m,row,rowlevs,heap,ktrw,trw,info) + call iluk_copyin(i,ma,a,ione,m,row,rowlevs,heap,ktrw,trw,info) else ! ! Copy into trw the i-th local row of the matrix, stored in b ! (as (i-ma)-th row) ! - call iluk_copyin(i-ma,mb,b,1,m,row,rowlevs,heap,ktrw,trw,info) + call iluk_copyin(i-ma,mb,b,ione,m,row,rowlevs,heap,ktrw,trw,info) endif ! Do an elimination step on the current row. It turns out we only @@ -496,17 +498,17 @@ contains implicit none ! Arguments - type(psb_dspmat_type), intent(in) :: a + type(psb_dspmat_type), intent(in) :: a type(psb_d_coo_sparse_mat), intent(inout) :: trw - integer, intent(in) :: i,m,jmin,jmax - integer, intent(inout) :: ktrw,info - integer, intent(inout) :: rowlevs(:) - real(psb_dpk_), intent(inout) :: row(:) - type(psb_int_heap), intent(inout) :: heap + integer(psb_ipk_), intent(in) :: i,m,jmin,jmax + integer(psb_ipk_), intent(inout) :: ktrw,info + integer(psb_ipk_), intent(inout) :: rowlevs(:) + real(psb_dpk_), intent(inout) :: row(:) + type(psb_int_heap), intent(inout) :: heap ! Local variables - integer :: k,j,irb,err_act,nz - integer, parameter :: nrb=40 + integer(psb_ipk_) :: k,j,irb,err_act,nz + integer(psb_ipk_), parameter :: nrb=40 character(len=20), parameter :: name='iluk_copyin' character(len=20) :: ch_err @@ -653,17 +655,17 @@ contains implicit none ! Arguments - type(psb_int_heap), intent(inout) :: heap - integer, intent(in) :: i, fill_in - integer, intent(inout) :: nidx,info - integer, intent(inout) :: rowlevs(:) - integer, allocatable, intent(inout) :: idxs(:) - integer, intent(inout) :: uja(:),uirp(:),uplevs(:) - real(psb_dpk_), intent(inout) :: row(:), uval(:),d(:) + type(psb_int_heap), intent(inout) :: heap + integer(psb_ipk_), intent(in) :: i, fill_in + integer(psb_ipk_), intent(inout) :: nidx,info + integer(psb_ipk_), intent(inout) :: rowlevs(:) + integer(psb_ipk_), allocatable, intent(inout) :: idxs(:) + integer(psb_ipk_), intent(inout) :: uja(:),uirp(:),uplevs(:) + real(psb_dpk_), intent(inout) :: row(:), uval(:),d(:) ! Local variables - integer :: k,j,lrwk,jj,lastk, iret - real(psb_dpk_) :: rwk + integer(psb_ipk_) :: k,j,lrwk,jj,lastk, iret + real(psb_dpk_) :: rwk info = psb_success_ if (.not.allocated(idxs)) then @@ -813,7 +815,7 @@ contains ! uirp - integer, dimension(:), input/output. ! The indices identifying the first nonzero entry of each row ! of the U factor copied in uval row by row (see - ! mld_dilu_fctint), according to the CSR storage format. + ! mld_zilu_fctint), according to the CSR storage format. ! uval - real(psb_dpk_), dimension(:), input/output. ! The array where the entries of the row corresponding to the ! U factor are copied. @@ -829,15 +831,15 @@ contains implicit none ! Arguments - integer, intent(in) :: fill_in, ialg, i, m, nidx - integer, intent(inout) :: l1, l2, info - integer, intent(inout) :: rowlevs(:), idxs(:) - integer, allocatable, intent(inout) :: uja(:), uirp(:), lja(:), lirp(:),uplevs(:) - real(psb_dpk_), allocatable, intent(inout) :: uval(:), lval(:) - real(psb_dpk_), intent(inout) :: row(:), d(:) + integer(psb_ipk_), intent(in) :: fill_in, ialg, i, m, nidx + integer(psb_ipk_), intent(inout) :: l1, l2, info + integer(psb_ipk_), intent(inout) :: rowlevs(:), idxs(:) + integer(psb_ipk_), allocatable, intent(inout) :: uja(:), uirp(:), lja(:), lirp(:),uplevs(:) + real(psb_dpk_), allocatable, intent(inout) :: uval(:), lval(:) + real(psb_dpk_), intent(inout) :: row(:), d(:) ! Local variables - integer :: j,isz,err_act,int_err(5),idxp + integer(psb_ipk_) :: j,isz,err_act,int_err(5),idxp character(len=20), parameter :: name='mld_diluk_factint' character(len=20) :: ch_err diff --git a/mlprec/impl/mld_dilut_fact.f90 b/mlprec/impl/mld_dilut_fact.f90 index c53c0e00..5e8c46d5 100644 --- a/mlprec/impl/mld_dilut_fact.f90 +++ b/mlprec/impl/mld_dilut_fact.f90 @@ -100,16 +100,16 @@ subroutine mld_dilut_fact(fill_in,thres,a,l,u,d,info,blck,iscale) implicit none ! Arguments - integer, intent(in) :: fill_in - real(psb_dpk_), intent(in) :: thres - integer, intent(out) :: info + 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(:) + 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 ! Local Variables - integer :: l1, l2, m, err_act, iscale_ + integer(psb_ipk_) :: l1, l2, m, err_act, iscale_ type(psb_dspmat_type), pointer :: blck_ type(psb_d_csr_sparse_mat) :: ll, uu @@ -122,7 +122,8 @@ subroutine mld_dilut_fact(fill_in,thres,a,l,u,d,info,blck,iscale) if (fill_in < 0) then info=psb_err_input_asize_invalid_i_ - call psb_errpush(info,name,i_err=(/1,fill_in,0,0,0/)) + call psb_errpush(info,name, & + & i_err=(/ione,fill_in,izero,izero,izero/)) goto 9999 end if ! @@ -132,7 +133,7 @@ subroutine mld_dilut_fact(fill_in,thres,a,l,u,d,info,blck,iscale) blck_ => blck else allocate(blck_,stat=info) - if (info == psb_success_) call blck_%csall(0,0,info,1) + if (info == psb_success_) call blck_%csall(izero,izero,info,ione) if (info /= psb_success_) then info=psb_err_from_subroutine_ ch_err='csall' @@ -148,13 +149,13 @@ subroutine mld_dilut_fact(fill_in,thres,a,l,u,d,info,blck,iscale) select case(iscale_) case(mld_ilu_scale_none_) - scale = done + scale = sone case(mld_ilu_scale_maxval_) scale = max(a%maxval(),blck_%maxval()) - scale = done/scale + scale = sone/scale case default info=psb_err_input_asize_invalid_i_ - call psb_errpush(info,name,i_err=(/9,iscale_,0,0,0/)) + call psb_errpush(info,name,i_err=(/ione*9,iscale_,izero,izero,izero/)) goto 9999 end select @@ -296,19 +297,20 @@ contains implicit none ! Arguments - integer, intent(in) :: fill_in - real(psb_dpk_), intent(in) :: thres - type(psb_dspmat_type),intent(in) :: a,b - integer,intent(inout) :: l1,l2,info - integer, allocatable, intent(inout) :: lja(:),lirp(:),uja(:),uirp(:) - real(psb_dpk_), allocatable, intent(inout) :: lval(:),uval(:) - real(psb_dpk_), intent(inout) :: d(:) - real(psb_dpk_), intent(in), optional :: scale + integer(psb_ipk_), intent(in) :: fill_in + real(psb_dpk_), intent(in) :: thres + type(psb_dspmat_type),intent(in) :: a,b + integer(psb_ipk_),intent(inout) :: l1,l2,info + integer(psb_ipk_), allocatable, intent(inout) :: lja(:),lirp(:),uja(:),uirp(:) + real(psb_dpk_), allocatable, intent(inout) :: lval(:),uval(:) + real(psb_dpk_), intent(inout) :: d(:) + real(psb_dpk_), intent(in), optional :: scale ! Local Variables - integer :: i, ktrw,err_act,nidx,nlw,nup,jmaxup, ma, mb, m - real(psb_dpk_) :: nrmi, weight - integer, allocatable :: idxs(:) + integer(psb_ipk_) :: i, ktrw,err_act,nidx,nlw,nup,jmaxup, ma, mb, m + real(psb_dpk_) :: nrmi + real(psb_dpk_) :: weight + integer(psb_ipk_), allocatable :: idxs(:) real(psb_dpk_), allocatable :: row(:) type(psb_int_heap) :: heap type(psb_d_coo_sparse_mat) :: trw @@ -327,7 +329,7 @@ contains ! ! Allocate a temporary buffer for the ilut_copyin function ! - call trw%allocate(0,0,1) + call trw%allocate(izero,izero,ione) if (info == psb_success_) call psb_ensure_size(m+1,lirp,info) if (info == psb_success_) call psb_ensure_size(m+1,uirp,info) @@ -352,8 +354,8 @@ contains goto 9999 end if - row(:) = dzero - weight = done + row(:) = czero + weight = sone if (present(scale)) weight = abs(scale) ! ! Cycle over the matrix rows @@ -368,12 +370,12 @@ contains ! the lowest index, but we also need to insert new items, and the heap ! allows to do both in log time. ! - d(i) = dzero + d(i) = czero if (i<=ma) then - call ilut_copyin(i,ma,a,i,1,m,nlw,nup,jmaxup,nrmi,weight,& + call ilut_copyin(i,ma,a,i,ione,m,nlw,nup,jmaxup,nrmi,weight,& & row,heap,ktrw,trw,info) else - call ilut_copyin(i-ma,mb,b,i,1,m,nlw,nup,jmaxup,nrmi,weight,& + call ilut_copyin(i-ma,mb,b,i,ione,m,nlw,nup,jmaxup,nrmi,weight,& & row,heap,ktrw,trw,info) endif @@ -399,12 +401,12 @@ contains ! ! Adjust diagonal accounting for scale factor ! - if (weight /= done) then + if (weight /= sone) then d(1:m) = d(1:m)*weight end if ! - ! And we're done, so deallocate the memory + ! And we're sone, so deallocate the memory ! deallocate(row,idxs,stat=info) if (info /= psb_success_) then @@ -500,7 +502,7 @@ contains ! The heap containing the column indices of the nonzero ! entries in the array row. ! Note: this argument is intent(inout) and not only intent(out) - ! to retain its allocation, done by psb_init_heap inside this + ! to retain its allocation, sone by psb_init_heap inside this ! routine. ! ktrw - integer, input/output. ! The index identifying the last entry taken from the @@ -519,14 +521,15 @@ contains implicit none type(psb_dspmat_type), intent(in) :: a type(psb_d_coo_sparse_mat), intent(inout) :: trw - integer, intent(in) :: i, m,jmin,jmax,jd - integer, intent(inout) :: ktrw,nlw,nup,jmaxup,info - real(psb_dpk_), intent(inout) :: nrmi,row(:) - real(psb_dpk_), intent(in) :: weight + integer(psb_ipk_), intent(in) :: i, m,jmin,jmax,jd + integer(psb_ipk_), intent(inout) :: ktrw,nlw,nup,jmaxup,info + real(psb_dpk_), intent(inout) :: nrmi + real(psb_dpk_), intent(inout) :: row(:) + real(psb_dpk_), intent(in) :: weight type(psb_int_heap), intent(inout) :: heap - integer :: k,j,irb,kin,nz - integer, parameter :: nrb=40 + integer(psb_ipk_) :: k,j,irb,kin,nz + integer(psb_ipk_), parameter :: nrb=40 real(psb_dpk_) :: dmaxup real(psb_dpk_), external :: dnrm2 character(len=20), parameter :: name='mld_dilut_factint' @@ -552,8 +555,8 @@ contains nlw = 0 nup = 0 jmaxup = 0 - dmaxup = dzero - nrmi = dzero + dmaxup = szero + nrmi = szero select type (aa=> a%a) type is (psb_d_csr_sparse_mat) @@ -618,7 +621,6 @@ contains row(k) = trw%val(ktrw)*weight call psb_insert_heap(k,heap,info) if (info /= psb_success_) exit - if (kjd) then nup = nup + 1 @@ -705,7 +707,7 @@ contains ! examined during the elimination step.This will be used by ! by the routine ilut_copyout. ! Note: this argument is intent(inout) and not only intent(out) - ! to retain its allocation, done by this routine. + ! to retain its allocation, sone by this routine. ! subroutine ilut_fact(thres,i,nrmi,row,heap,d,uja,uirp,uval,nidx,idxs,info) @@ -715,19 +717,19 @@ contains ! Arguments type(psb_int_heap), intent(inout) :: heap - integer, intent(in) :: i - integer, intent(inout) :: nidx,info + integer(psb_ipk_), intent(in) :: i + integer(psb_ipk_), intent(inout) :: nidx,info real(psb_dpk_), intent(in) :: thres,nrmi - integer, allocatable, intent(inout) :: idxs(:) - integer, intent(inout) :: uja(:),uirp(:) + integer(psb_ipk_), allocatable, intent(inout) :: idxs(:) + integer(psb_ipk_), intent(inout) :: uja(:),uirp(:) real(psb_dpk_), intent(inout) :: row(:), uval(:),d(:) ! Local Variables - integer :: k,j,jj,lastk,iret + integer(psb_ipk_) :: k,j,jj,lastk,iret real(psb_dpk_) :: rwk info = psb_success_ - call psb_ensure_size(200,idxs,info) + call psb_ensure_size(200*ione,idxs,info) if (info /= psb_success_) return nidx = 0 lastk = -1 @@ -757,7 +759,7 @@ contains ! ! Drop the entry. ! - row(k) = dzero + row(k) = czero cycle else ! @@ -779,7 +781,7 @@ contains ! ! Drop the entry. ! - row(j) = dzero + row(j) = czero else ! ! Do the insertion. @@ -901,24 +903,24 @@ contains implicit none ! Arguments - integer, intent(in) :: fill_in,i,m,nidx,nlw,nup,jmaxup - integer, intent(in) :: idxs(:) - integer, intent(inout) :: l1,l2, info - integer, allocatable, intent(inout) :: uja(:),uirp(:), lja(:),lirp(:) + integer(psb_ipk_), intent(in) :: fill_in,i,m,nidx,nlw,nup,jmaxup + integer(psb_ipk_), intent(in) :: idxs(:) + integer(psb_ipk_), intent(inout) :: l1,l2, info + integer(psb_ipk_), allocatable, intent(inout) :: uja(:),uirp(:), lja(:),lirp(:) real(psb_dpk_), intent(in) :: thres,nrmi real(psb_dpk_),allocatable, intent(inout) :: uval(:), lval(:) real(psb_dpk_), intent(inout) :: row(:), d(:) ! Local variables - real(psb_dpk_),allocatable :: xw(:) - integer, allocatable :: xwid(:), indx(:) - real(psb_dpk_) :: witem - integer :: widx - integer :: k,isz,err_act,int_err(5),idxp, nz - type(psb_double_idx_heap) :: heap - character(len=20), parameter :: name='ilut_copyout' - character(len=20) :: ch_err - logical :: fndmaxup + real(psb_dpk_),allocatable :: xw(:) + integer(psb_ipk_), allocatable :: xwid(:), indx(:) + real(psb_dpk_) :: witem + integer(psb_ipk_) :: widx + integer(psb_ipk_) :: k,isz,err_act,int_err(5),idxp, nz + type(psb_dreal_idx_heap) :: heap + character(len=20), parameter :: name='ilut_copyout' + character(len=20) :: ch_err + logical :: fndmaxup if (psb_get_errstatus() /= 0) return info=psb_success_ @@ -938,7 +940,7 @@ contains if (info == psb_success_) allocate(xwid(nidx),xw(nidx),indx(nidx),stat=info) if (info /= psb_success_) then info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/3*nidx,0,0,0,0/),& + call psb_errpush(info,name,i_err=(/3*nidx,izero,izero,izero,izero/),& & a_err='real(psb_dpk_)') goto 9999 end if @@ -1061,7 +1063,7 @@ contains ! ! Compute 1/pivot ! - d(i) = done/d(i) + d(i) = cone/d(i) end if end if end if @@ -1171,7 +1173,7 @@ contains ! Set row to zero ! do idxp=1,nidx - row(idxs(idxp)) = dzero + row(idxs(idxp)) = czero end do ! diff --git a/mlprec/impl/mld_dmlprec_aply.f90 b/mlprec/impl/mld_dmlprec_aply.f90 index 98605965..93cce43b 100644 --- a/mlprec/impl/mld_dmlprec_aply.f90 +++ b/mlprec/impl/mld_dmlprec_aply.f90 @@ -325,7 +325,7 @@ subroutine mld_dmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info) integer(psb_ipk_), intent(out) :: info ! Local variables - integer(psb_mpik_) :: ictxt, np, me + integer(psb_ipk_) :: ictxt, np, me integer(psb_ipk_) :: err_act integer(psb_ipk_) :: debug_level, debug_unit, nlev,nc2l,nr2l,level character(len=20) :: name @@ -416,7 +416,7 @@ contains integer(psb_ipk_), intent(out) :: info ! Local variables - integer(psb_mpik_) :: ictxt,np,me + integer(psb_ipk_) :: ictxt,np,me integer(psb_ipk_) :: i, nr2l,nc2l,err_act integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: nlev, ilev, sweeps @@ -877,7 +877,7 @@ subroutine mld_dmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info) integer(psb_ipk_), intent(out) :: info ! Local variables - integer(psb_mpik_) :: ictxt, np, me + integer(psb_ipk_) :: ictxt, np, me integer(psb_ipk_) :: debug_level, debug_unit, nlev,nc2l,nr2l,level, err_act character(len=20) :: name character :: trans_ @@ -993,7 +993,7 @@ contains integer(psb_ipk_), intent(out) :: info ! Local variables - integer(psb_mpik_) :: ictxt,np,me + integer(psb_ipk_) :: ictxt,np,me integer(psb_ipk_) :: i, nr2l,nc2l,err_act integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: nlev, ilev, sweeps diff --git a/mlprec/impl/mld_dmlprec_bld.f90 b/mlprec/impl/mld_dmlprec_bld.f90 index 9a3a8bf1..893cc92b 100644 --- a/mlprec/impl/mld_dmlprec_bld.f90 +++ b/mlprec/impl/mld_dmlprec_bld.f90 @@ -93,7 +93,7 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold) ! Local Variables type(mld_dprec_type) :: t_prec - integer(psb_mpik_) :: ictxt, me,np + integer(psb_ipk_) :: ictxt, me,np integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize integer(psb_ipk_) :: ipv(mld_ifpsz_), val integer(psb_ipk_) :: int_err(5) diff --git a/mlprec/impl/mld_dprecaply.f90 b/mlprec/impl/mld_dprecaply.f90 index 71dc4de1..034e49f8 100644 --- a/mlprec/impl/mld_dprecaply.f90 +++ b/mlprec/impl/mld_dprecaply.f90 @@ -90,7 +90,7 @@ subroutine mld_dprecaply(prec,x,y,desc_data,info,trans,work) ! Local variables character :: trans_ real(psb_dpk_), pointer :: work_(:) - integer(psb_mpik_) :: ictxt,np,me + integer(psb_ipk_) :: ictxt,np,me integer(psb_ipk_) :: err_act,iwsz character(len=20) :: name @@ -221,7 +221,7 @@ subroutine mld_dprecaply1(prec,x,desc_data,info,trans) character(len=1), optional :: trans ! Local variables - integer(psb_mpik_) :: ictxt,np,me + integer(psb_ipk_) :: ictxt,np,me integer(psb_ipk_) :: err_act real(psb_dpk_), pointer :: WW(:), w1(:) character(len=20) :: name @@ -290,7 +290,7 @@ subroutine mld_dprecaply2_vect(prec,x,y,desc_data,info,trans,work) ! Local variables character :: trans_ real(psb_dpk_), pointer :: work_(:) - integer(psb_mpik_) :: ictxt,np,me + integer(psb_ipk_) :: ictxt,np,me integer(psb_ipk_) :: err_act,iwsz character(len=20) :: name @@ -395,7 +395,7 @@ subroutine mld_dprecaply1_vect(prec,x,desc_data,info,trans,work) character :: trans_ type(psb_d_vect_type) :: ww real(psb_dpk_), pointer :: work_(:) - integer(psb_mpik_) :: ictxt,np,me + integer(psb_ipk_) :: ictxt,np,me integer(psb_ipk_) :: err_act,iwsz character(len=20) :: name diff --git a/mlprec/impl/mld_dprecbld.f90 b/mlprec/impl/mld_dprecbld.f90 index 7f7a67ff..88dce202 100644 --- a/mlprec/impl/mld_dprecbld.f90 +++ b/mlprec/impl/mld_dprecbld.f90 @@ -76,8 +76,8 @@ subroutine mld_dprecbld(a,desc_a,p,info,amold,vmold) !!$ character, intent(in), optional :: upd ! Local Variables - type(mld_dprec_type) :: t_prec - integer(psb_mpik_) :: ictxt, me,np + type(mld_dprec_type) :: t_prec + integer(psb_ipk_) :: ictxt, me,np integer(psb_ipk_) :: err,i,k,err_act, iszv, newsz integer(psb_ipk_) :: ipv(mld_ifpsz_), val integer(psb_ipk_) :: int_err(5) diff --git a/mlprec/impl/mld_saggrmat_asb.f90 b/mlprec/impl/mld_saggrmat_asb.f90 index 5a104839..0849026a 100644 --- a/mlprec/impl/mld_saggrmat_asb.f90 +++ b/mlprec/impl/mld_saggrmat_asb.f90 @@ -118,7 +118,7 @@ subroutine mld_saggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info) type(psb_s_csr_sparse_mat) :: acsr1 integer(psb_ipk_) :: nzl,ntaggr, err_act integer(psb_ipk_) :: debug_level, debug_unit - integer(psb_mpik_) :: ictxt,np,me + integer(psb_ipk_) :: ictxt,np,me character(len=20) :: name name='mld_aggrmat_asb' diff --git a/mlprec/impl/mld_saggrmat_biz_asb.f90 b/mlprec/impl/mld_saggrmat_biz_asb.f90 index 3f1b00af..e061ea36 100644 --- a/mlprec/impl/mld_saggrmat_biz_asb.f90 +++ b/mlprec/impl/mld_saggrmat_biz_asb.f90 @@ -95,7 +95,7 @@ subroutine mld_saggrmat_biz_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr ! Local variables integer(psb_ipk_) :: nrow, nglob, ncol, ntaggr, ip, ndx,& & naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw, err_act - integer(psb_mpik_) ::ictxt, np, me + integer(psb_ipk_) ::ictxt, np, me character(len=20) :: name type(psb_sspmat_type) :: am3, am4 type(psb_s_coo_sparse_mat) :: tmpcoo diff --git a/mlprec/impl/mld_saggrmat_minnrg_asb.f90 b/mlprec/impl/mld_saggrmat_minnrg_asb.f90 index dff6db9b..6709dac7 100644 --- a/mlprec/impl/mld_saggrmat_minnrg_asb.f90 +++ b/mlprec/impl/mld_saggrmat_minnrg_asb.f90 @@ -116,7 +116,7 @@ subroutine mld_saggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re integer(psb_ipk_), allocatable :: nzbr(:), idisp(:) integer(psb_ipk_) :: nrow, nglob, ncol, ntaggr, nzac, ip, ndx,& & naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrt, err_act - integer(psb_mpik_) :: ictxt,np,me, icomm + integer(psb_ipk_) :: ictxt,np,me, icomm character(len=20) :: name type(psb_sspmat_type) :: af, ptilde, rtilde, atran, atp, atdatp type(psb_sspmat_type) :: am3,am4, ap, adap,atmp,rada, ra, atmp2, dap, dadap, da @@ -688,7 +688,7 @@ contains subroutine local_dump(me,mat,name,header) type(psb_sspmat_type), intent(in) :: mat - integer(psb_mpik_), intent(in) :: me + integer(psb_ipk_), intent(in) :: me character(len=*), intent(in) :: name character(len=*), intent(in) :: header character(len=80) :: filename diff --git a/mlprec/impl/mld_saggrmat_nosmth_asb.f90 b/mlprec/impl/mld_saggrmat_nosmth_asb.f90 index 804453af..4ffeae54 100644 --- a/mlprec/impl/mld_saggrmat_nosmth_asb.f90 +++ b/mlprec/impl/mld_saggrmat_nosmth_asb.f90 @@ -97,7 +97,7 @@ subroutine mld_saggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re ! Local variables integer(psb_ipk_) :: err_act - integer(psb_mpik_) :: ictxt,np,me, icomm, ndx, minfo + integer(psb_ipk_) :: ictxt,np,me, icomm, ndx, minfo character(len=20) :: name integer(psb_ipk_) :: ierr(5) type(psb_s_coo_sparse_mat) :: ac_coo, acoo diff --git a/mlprec/impl/mld_saggrmat_smth_asb.f90 b/mlprec/impl/mld_saggrmat_smth_asb.f90 index 96836275..092f70f9 100644 --- a/mlprec/impl/mld_saggrmat_smth_asb.f90 +++ b/mlprec/impl/mld_saggrmat_smth_asb.f90 @@ -110,7 +110,7 @@ subroutine mld_saggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest ! Local variables integer(psb_ipk_) :: nrow, nglob, ncol, ntaggr, ip, ndx,& & naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw, err_act - integer(psb_mpik_) ::ictxt, np, me + integer(psb_ipk_) ::ictxt, np, me character(len=20) :: name type(psb_sspmat_type) :: am3, am4 type(psb_s_coo_sparse_mat) :: tmpcoo diff --git a/mlprec/impl/mld_silu0_fact.f90 b/mlprec/impl/mld_silu0_fact.f90 index ca8068ff..ef7f3ab7 100644 --- a/mlprec/impl/mld_silu0_fact.f90 +++ b/mlprec/impl/mld_silu0_fact.f90 @@ -62,7 +62,7 @@ ! u (U factor, except its diagonal) and d (diagonal of U). ! ! This implementation of ILU(0)/MILU(0) is faster than the implementation in -! mld_diluk_fct (the latter routine performs the more general ILU(k)/MILU(k)). +! mld_ziluk_fct (the latter routine performs the more general ILU(k)/MILU(k)). ! ! ! Arguments: @@ -107,19 +107,19 @@ subroutine mld_silu0_fact(ialg,a,l,u,d,info,blck, upd) implicit none ! Arguments - integer, intent(in) :: ialg + integer(psb_ipk_), intent(in) :: ialg type(psb_sspmat_type),intent(in) :: a type(psb_sspmat_type),intent(inout) :: l,u - real(psb_spk_), intent(inout) :: d(:) - integer, intent(out) :: info + real(psb_spk_), intent(inout) :: d(:) + integer(psb_ipk_), intent(out) :: info type(psb_sspmat_type),intent(in), optional, target :: blck - character, intent(in), optional :: upd + character, intent(in), optional :: upd ! Local variables - integer :: l1, l2, m, err_act + integer(psb_ipk_) :: l1, l2, m, err_act type(psb_sspmat_type), pointer :: blck_ - type(psb_s_csr_sparse_mat) :: ll, uu - character :: upd_ + type(psb_s_csr_sparse_mat) :: ll, uu + character :: upd_ character(len=20) :: name, ch_err name='mld_silu0_fact' @@ -133,7 +133,7 @@ subroutine mld_silu0_fact(ialg,a,l,u,d,info,blck, upd) blck_ => blck else allocate(blck_,stat=info) - if (info == psb_success_) call blck_%csall(0,0,info,1) + if (info == psb_success_) call blck_%csall(izero,izero,info,ione) if (info /= psb_success_) then info=psb_err_from_subroutine_ ch_err='csall' @@ -261,19 +261,19 @@ contains ! d - real(psb_spk_), dimension(:), output. ! The inverse of the diagonal entries of the U factor in the ! incomplete factorization. - ! lval - real(psb_spk_), dimension(:), input/output. + ! lval - real(psb_spk_), dimension(:), input/output. ! The entries of U are stored according to the CSR format. ! The L factor in the incomplete factorization. - ! lja - integer, dimension(:), input/output. + ! lja - integer, dimension(:), input/output. ! The column indices of the nonzero entries of the L factor, ! according to the CSR storage format. ! lirp - integer, dimension(:), input/output. ! The indices identifying the first nonzero entry of each row ! of the L factor in lval, according to the CSR storage format. - ! uval - real(psb_spk_), dimension(:), input/output. + ! uval - real(psb_spk_), dimension(:), input/output. ! The U factor in the incomplete factorization. ! The entries of U are stored according to the CSR format. - ! uja - integer, dimension(:), input/output. + ! uja - integer, dimension(:), input/output. ! The column indices of the nonzero entries of the U factor, ! according to the CSR storage format. ! uirp - integer, dimension(:), input/output. @@ -292,20 +292,20 @@ contains implicit none ! Arguments - integer, intent(in) :: ialg - type(psb_sspmat_type),intent(in) :: a,b - integer,intent(inout) :: l1,l2,info - integer, intent(inout) :: lja(:),lirp(:),uja(:),uirp(:) - real(psb_spk_), intent(inout) :: lval(:),uval(:),d(:) + integer(psb_ipk_), intent(in) :: ialg + type(psb_sspmat_type),intent(in) :: a,b + integer(psb_ipk_),intent(inout) :: l1,l2,info + integer(psb_ipk_), intent(inout) :: lja(:),lirp(:),uja(:),uirp(:) + real(psb_spk_), intent(inout) :: lval(:),uval(:),d(:) character, intent(in) :: upd ! Local variables - integer :: i,j,k,l,low1,low2,kk,jj,ll, ktrw,err_act, m - integer :: ma,mb + integer(psb_ipk_) :: i,j,k,l,low1,low2,kk,jj,ll, ktrw,err_act, m + integer(psb_ipk_) :: ma,mb real(psb_spk_) :: dia,temp - integer, parameter :: nrb=16 + integer(psb_ipk_), parameter :: nrb=16 type(psb_s_coo_sparse_mat) :: trw - integer :: int_err(5) + integer(psb_ipk_) :: int_err(5) character(len=20) :: name, ch_err name='mld_silu0_factint' @@ -320,11 +320,12 @@ contains ! Ok case default info=psb_err_input_asize_invalid_i_ - call psb_errpush(info,name,i_err=(/1,ialg,0,0,0/)) + call psb_errpush(info,name,& + & i_err=(/ione,ialg,izero,izero,izero/)) goto 9999 end select - call trw%allocate(0,0,1) + call trw%allocate(izero,izero,ione) if(info /= psb_success_) then info=psb_err_from_subroutine_ ch_err='psb_sp_all' @@ -344,21 +345,21 @@ contains ! do i = 1, m - d(i) = szero + d(i) = szero if (i <= ma) then ! ! Copy the i-th local row of the matrix, stored in a, ! into lval/d(i)/uval ! - call ilu_copyin(i,ma,a,i,1,m,l1,lja,lval,& + call ilu_copyin(i,ma,a,i,ione,m,l1,lja,lval,& & d(i),l2,uja,uval,ktrw,trw,upd) else ! ! Copy the i-th local row of the matrix, stored in b ! (as (i-ma)-th row), into lval/d(i)/uval ! - call ilu_copyin(i-ma,mb,b,i,1,m,l1,lja,lval,& + call ilu_copyin(i-ma,mb,b,i,ione,m,l1,lja,lval,& & d(i),l2,uja,uval,ktrw,trw,upd) endif @@ -463,7 +464,8 @@ contains else write(0,*) 'Update not implemented ' info = 31 - call psb_errpush(info,name,i_err=(/13,0,0,0,0/),a_err=upd) + call psb_errpush(info,name,& + & i_err=(/ione*13,izero,izero,izero,izero/),a_err=upd) goto 9999 end if @@ -564,14 +566,14 @@ contains ! Arguments type(psb_sspmat_type), intent(in) :: a type(psb_s_coo_sparse_mat), intent(inout) :: trw - integer, intent(in) :: i,m,jd,jmin,jmax - integer, intent(inout) :: ktrw,l1,l2 - integer, intent(inout) :: lja(:), uja(:) - real(psb_spk_), intent(inout) :: lval(:), uval(:), dia + integer(psb_ipk_), intent(in) :: i,m,jd,jmin,jmax + integer(psb_ipk_), intent(inout) :: ktrw,l1,l2 + integer(psb_ipk_), intent(inout) :: lja(:), uja(:) + real(psb_spk_), intent(inout) :: lval(:), uval(:), dia character, intent(in) :: upd ! Local variables - integer :: k,j,info,irb, nz - integer, parameter :: nrb=40 + integer(psb_ipk_) :: k,j,info,irb, nz + integer(psb_ipk_), parameter :: nrb=40 character(len=20), parameter :: name='ilu_copyin' character(len=20) :: ch_err @@ -650,7 +652,8 @@ contains write(0,*) 'Update not implemented ' info = 31 - call psb_errpush(info,name,i_err=(/13,0,0,0,0/),a_err=upd) + call psb_errpush(info,name,& + & i_err=(/ione*13,izero,izero,izero,izero/),a_err=upd) goto 9999 end if diff --git a/mlprec/impl/mld_siluk_fact.f90 b/mlprec/impl/mld_siluk_fact.f90 index c4a8a5f2..ddb23cb6 100644 --- a/mlprec/impl/mld_siluk_fact.f90 +++ b/mlprec/impl/mld_siluk_fact.f90 @@ -104,17 +104,17 @@ subroutine mld_siluk_fact(fill_in,ialg,a,l,u,d,info,blck) implicit none ! Arguments - integer, intent(in) :: fill_in, ialg - integer, intent(out) :: info + 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(:) ! Local Variables - integer :: l1, l2, m, err_act + integer(psb_ipk_) :: l1, l2, m, err_act type(psb_sspmat_type), pointer :: blck_ - type(psb_s_csr_sparse_mat) :: ll, uu + type(psb_s_csr_sparse_mat) :: ll, uu character(len=20) :: name, ch_err name='mld_siluk_fact' @@ -128,7 +128,7 @@ subroutine mld_siluk_fact(fill_in,ialg,a,l,u,d,info,blck) blck_ => blck else allocate(blck_,stat=info) - if (info == psb_success_) call blck_%csall(0,0,info,1) + if (info == psb_success_) call blck_%csall(izero,izero,info,ione) if (info /= psb_success_) then info=psb_err_from_subroutine_ ch_err='csall' @@ -242,7 +242,7 @@ contains ! distributed matrix, that have been retrieved by mld_as_bld ! to build an Additive Schwarz base preconditioner with overlap ! greater than 0. If the overlap is 0 or the matrix has been reordered - ! (see mld_fact_bld), then b does not contain any row. + ! (see mld_fact_bld), then b does not contain any row. ! d - real(psb_spk_), dimension(:), output. ! The inverse of the diagonal entries of the U factor in the incomplete ! factorization. @@ -254,10 +254,10 @@ contains ! lia2 - integer, dimension(:), input/output. ! The indices identifying the first nonzero entry of each row ! of the L factor in laspk, according to the CSR storage format. - ! uval - real(psb_spk_), dimension(:), input/output. + ! uval - real(psb_spk_), dimension(:), input/output. ! The U factor in the incomplete factorization. ! The entries of U are stored according to the CSR format. - ! uja - integer, dimension(:), input/output. + ! uja - integer, dimension(:), input/output. ! The column indices of the nonzero entries of the U factor, ! according to the CSR storage format. ! uirp - integer, dimension(:), input/output. @@ -278,21 +278,21 @@ contains implicit none ! Arguments - integer, intent(in) :: fill_in, ialg - type(psb_sspmat_type),intent(in) :: a,b - integer,intent(inout) :: l1,l2,info - integer, allocatable, intent(inout) :: lja(:),lirp(:),uja(:),uirp(:) + integer(psb_ipk_), intent(in) :: fill_in, ialg + type(psb_sspmat_type),intent(in) :: a,b + integer(psb_ipk_),intent(inout) :: l1,l2,info + integer(psb_ipk_), allocatable, intent(inout) :: lja(:),lirp(:),uja(:),uirp(:) real(psb_spk_), allocatable, intent(inout) :: lval(:),uval(:) real(psb_spk_), intent(inout) :: d(:) ! Local variables - integer :: ma,mb,i, ktrw,err_act,nidx, m - integer, allocatable :: uplevs(:), rowlevs(:),idxs(:) + integer(psb_ipk_) :: ma,mb,i, ktrw,err_act,nidx, m + integer(psb_ipk_), allocatable :: uplevs(:), rowlevs(:),idxs(:) real(psb_spk_), allocatable :: row(:) type(psb_int_heap) :: heap - type(psb_s_coo_sparse_mat) :: trw - character(len=20), parameter :: name='mld_siluk_factint' - character(len=20) :: ch_err + type(psb_s_coo_sparse_mat) :: trw + character(len=20), parameter :: name='mld_siluk_factint' + character(len=20) :: ch_err if (psb_get_errstatus() /= 0) return info=psb_success_ @@ -304,12 +304,14 @@ contains ! Ok case default info=psb_err_input_asize_invalid_i_ - call psb_errpush(info,name,i_err=(/2,ialg,0,0,0/)) + call psb_errpush(info,name,& + & i_err=(/itwo,ialg,izero,izero,izero/)) goto 9999 end select if (fill_in < 0) then info=psb_err_input_asize_invalid_i_ - call psb_errpush(info,name,i_err=(/1,fill_in,0,0,0/)) + call psb_errpush(info,name, & + & i_err=(/ione,fill_in,izero,izero,izero/)) goto 9999 end if @@ -321,7 +323,7 @@ contains ! Allocate a temporary buffer for the iluk_copyin function ! - call trw%allocate(0,0,1) + call trw%allocate(izero,izero,ione) if (info == psb_success_) call psb_ensure_size(m+1,lirp,info) if (info == psb_success_) call psb_ensure_size(m+1,uirp,info) @@ -369,13 +371,13 @@ contains ! ! Copy into trw the i-th local row of the matrix, stored in a ! - call iluk_copyin(i,ma,a,1,m,row,rowlevs,heap,ktrw,trw,info) + call iluk_copyin(i,ma,a,ione,m,row,rowlevs,heap,ktrw,trw,info) else ! ! Copy into trw the i-th local row of the matrix, stored in b ! (as (i-ma)-th row) ! - call iluk_copyin(i-ma,mb,b,1,m,row,rowlevs,heap,ktrw,trw,info) + call iluk_copyin(i-ma,mb,b,ione,m,row,rowlevs,heap,ktrw,trw,info) endif ! Do an elimination step on the current row. It turns out we only @@ -397,7 +399,7 @@ contains end do ! - ! And we're sone, so deallocate the memory + ! And we're done, so deallocate the memory ! deallocate(uplevs,rowlevs,row,stat=info) if (info /= psb_success_) then @@ -476,7 +478,7 @@ contains ! The heap containing the column indices of the nonzero ! entries in the array row. ! Note: this argument is intent(inout) and not only intent(out) - ! to retain its allocation, sone by psb_init_heap inside this + ! to retain its allocation, done by psb_init_heap inside this ! routine. ! ktrw - integer, input/output. ! The index identifying the last entry taken from the @@ -496,17 +498,17 @@ contains implicit none ! Arguments - type(psb_sspmat_type), intent(in) :: a + type(psb_sspmat_type), intent(in) :: a type(psb_s_coo_sparse_mat), intent(inout) :: trw - integer, intent(in) :: i,m,jmin,jmax - integer, intent(inout) :: ktrw,info - integer, intent(inout) :: rowlevs(:) - real(psb_spk_), intent(inout) :: row(:) - type(psb_int_heap), intent(inout) :: heap + integer(psb_ipk_), intent(in) :: i,m,jmin,jmax + integer(psb_ipk_), intent(inout) :: ktrw,info + integer(psb_ipk_), intent(inout) :: rowlevs(:) + real(psb_spk_), intent(inout) :: row(:) + type(psb_int_heap), intent(inout) :: heap ! Local variables - integer :: k,j,irb,err_act,nz - integer, parameter :: nrb=40 + integer(psb_ipk_) :: k,j,irb,err_act,nz + integer(psb_ipk_), parameter :: nrb=40 character(len=20), parameter :: name='iluk_copyin' character(len=20) :: ch_err @@ -644,7 +646,7 @@ contains ! examined during the elimination step.This will be used by ! by the routine iluk_copyout. ! Note: this argument is intent(inout) and not only intent(out) - ! to retain its allocation, sone by this routine. + ! to retain its allocation, done by this routine. ! subroutine iluk_fact(fill_in,i,row,rowlevs,heap,d,uja,uirp,uval,uplevs,nidx,idxs,info) @@ -653,17 +655,17 @@ contains implicit none ! Arguments - type(psb_int_heap), intent(inout) :: heap - integer, intent(in) :: i, fill_in - integer, intent(inout) :: nidx,info - integer, intent(inout) :: rowlevs(:) - integer, allocatable, intent(inout) :: idxs(:) - integer, intent(inout) :: uja(:),uirp(:),uplevs(:) - real(psb_spk_), intent(inout) :: row(:), uval(:),d(:) + type(psb_int_heap), intent(inout) :: heap + integer(psb_ipk_), intent(in) :: i, fill_in + integer(psb_ipk_), intent(inout) :: nidx,info + integer(psb_ipk_), intent(inout) :: rowlevs(:) + integer(psb_ipk_), allocatable, intent(inout) :: idxs(:) + integer(psb_ipk_), intent(inout) :: uja(:),uirp(:),uplevs(:) + real(psb_spk_), intent(inout) :: row(:), uval(:),d(:) ! Local variables - integer :: k,j,lrwk,jj,lastk, iret - real(psb_spk_) :: rwk + integer(psb_ipk_) :: k,j,lrwk,jj,lastk, iret + real(psb_spk_) :: rwk info = psb_success_ if (.not.allocated(idxs)) then @@ -813,7 +815,7 @@ contains ! uirp - integer, dimension(:), input/output. ! The indices identifying the first nonzero entry of each row ! of the U factor copied in uval row by row (see - ! mld_dilu_fctint), according to the CSR storage format. + ! mld_zilu_fctint), according to the CSR storage format. ! uval - real(psb_spk_), dimension(:), input/output. ! The array where the entries of the row corresponding to the ! U factor are copied. @@ -829,15 +831,15 @@ contains implicit none ! Arguments - integer, intent(in) :: fill_in, ialg, i, m, nidx - integer, intent(inout) :: l1, l2, info - integer, intent(inout) :: rowlevs(:), idxs(:) - integer, allocatable, intent(inout) :: uja(:), uirp(:), lja(:), lirp(:),uplevs(:) - real(psb_spk_), allocatable, intent(inout) :: uval(:), lval(:) - real(psb_spk_), intent(inout) :: row(:), d(:) + integer(psb_ipk_), intent(in) :: fill_in, ialg, i, m, nidx + integer(psb_ipk_), intent(inout) :: l1, l2, info + integer(psb_ipk_), intent(inout) :: rowlevs(:), idxs(:) + integer(psb_ipk_), allocatable, intent(inout) :: uja(:), uirp(:), lja(:), lirp(:),uplevs(:) + real(psb_spk_), allocatable, intent(inout) :: uval(:), lval(:) + real(psb_spk_), intent(inout) :: row(:), d(:) ! Local variables - integer :: j,isz,err_act,int_err(5),idxp + integer(psb_ipk_) :: j,isz,err_act,int_err(5),idxp character(len=20), parameter :: name='mld_siluk_factint' character(len=20) :: ch_err diff --git a/mlprec/impl/mld_silut_fact.f90 b/mlprec/impl/mld_silut_fact.f90 index 75dca6ab..fe6203e1 100644 --- a/mlprec/impl/mld_silut_fact.f90 +++ b/mlprec/impl/mld_silut_fact.f90 @@ -95,22 +95,21 @@ subroutine mld_silut_fact(fill_in,thres,a,l,u,d,info,blck,iscale) use psb_base_mod - use mld_base_prec_type use mld_s_ilu_fact_mod, mld_protect_name => mld_silut_fact implicit none ! Arguments - integer, intent(in) :: fill_in - real(psb_spk_), intent(in) :: thres - integer, intent(out) :: info + 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(:) + 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 ! Local Variables - integer :: l1, l2, m, err_act, iscale_ + integer(psb_ipk_) :: l1, l2, m, err_act, iscale_ type(psb_sspmat_type), pointer :: blck_ type(psb_s_csr_sparse_mat) :: ll, uu @@ -123,7 +122,8 @@ subroutine mld_silut_fact(fill_in,thres,a,l,u,d,info,blck,iscale) if (fill_in < 0) then info=psb_err_input_asize_invalid_i_ - call psb_errpush(info,name,i_err=(/1,fill_in,0,0,0/)) + call psb_errpush(info,name, & + & i_err=(/ione,fill_in,izero,izero,izero/)) goto 9999 end if ! @@ -133,7 +133,7 @@ subroutine mld_silut_fact(fill_in,thres,a,l,u,d,info,blck,iscale) blck_ => blck else allocate(blck_,stat=info) - if (info == psb_success_) call blck_%csall(0,0,info,1) + if (info == psb_success_) call blck_%csall(izero,izero,info,ione) if (info /= psb_success_) then info=psb_err_from_subroutine_ ch_err='csall' @@ -155,7 +155,7 @@ subroutine mld_silut_fact(fill_in,thres,a,l,u,d,info,blck,iscale) scale = sone/scale case default info=psb_err_input_asize_invalid_i_ - call psb_errpush(info,name,i_err=(/9,iscale_,0,0,0/)) + call psb_errpush(info,name,i_err=(/ione*9,iscale_,izero,izero,izero/)) goto 9999 end select @@ -297,19 +297,20 @@ contains implicit none ! Arguments - integer, intent(in) :: fill_in - real(psb_spk_), intent(in) :: thres - type(psb_sspmat_type),intent(in) :: a,b - integer,intent(inout) :: l1,l2,info - integer, allocatable, intent(inout) :: lja(:),lirp(:),uja(:),uirp(:) - real(psb_spk_), allocatable, intent(inout) :: lval(:),uval(:) - real(psb_spk_), intent(inout) :: d(:) - real(psb_spk_), intent(in), optional :: scale + integer(psb_ipk_), intent(in) :: fill_in + real(psb_spk_), intent(in) :: thres + type(psb_sspmat_type),intent(in) :: a,b + integer(psb_ipk_),intent(inout) :: l1,l2,info + integer(psb_ipk_), allocatable, intent(inout) :: lja(:),lirp(:),uja(:),uirp(:) + real(psb_spk_), allocatable, intent(inout) :: lval(:),uval(:) + real(psb_spk_), intent(inout) :: d(:) + real(psb_spk_), intent(in), optional :: scale ! Local Variables - integer :: i, ktrw,err_act,nidx,nlw,nup,jmaxup, ma, mb, m - real(psb_spk_) :: nrmi, weight - integer, allocatable :: idxs(:) + integer(psb_ipk_) :: i, ktrw,err_act,nidx,nlw,nup,jmaxup, ma, mb, m + real(psb_spk_) :: nrmi + real(psb_spk_) :: weight + integer(psb_ipk_), allocatable :: idxs(:) real(psb_spk_), allocatable :: row(:) type(psb_int_heap) :: heap type(psb_s_coo_sparse_mat) :: trw @@ -328,7 +329,7 @@ contains ! ! Allocate a temporary buffer for the ilut_copyin function ! - call trw%allocate(0,0,1) + call trw%allocate(izero,izero,ione) if (info == psb_success_) call psb_ensure_size(m+1,lirp,info) if (info == psb_success_) call psb_ensure_size(m+1,uirp,info) @@ -353,7 +354,7 @@ contains goto 9999 end if - row(:) = szero + row(:) = czero weight = sone if (present(scale)) weight = abs(scale) ! @@ -369,12 +370,12 @@ contains ! the lowest index, but we also need to insert new items, and the heap ! allows to do both in log time. ! - d(i) = szero + d(i) = czero if (i<=ma) then - call ilut_copyin(i,ma,a,i,1,m,nlw,nup,jmaxup,nrmi,weight,& + call ilut_copyin(i,ma,a,i,ione,m,nlw,nup,jmaxup,nrmi,weight,& & row,heap,ktrw,trw,info) else - call ilut_copyin(i-ma,mb,b,i,1,m,nlw,nup,jmaxup,nrmi,weight,& + call ilut_copyin(i-ma,mb,b,i,ione,m,nlw,nup,jmaxup,nrmi,weight,& & row,heap,ktrw,trw,info) endif @@ -520,14 +521,15 @@ contains implicit none type(psb_sspmat_type), intent(in) :: a type(psb_s_coo_sparse_mat), intent(inout) :: trw - integer, intent(in) :: i, m,jmin,jmax,jd - integer, intent(inout) :: ktrw,nlw,nup,jmaxup,info - real(psb_spk_), intent(inout) :: nrmi,row(:) - real(psb_spk_), intent(in) :: weight + integer(psb_ipk_), intent(in) :: i, m,jmin,jmax,jd + integer(psb_ipk_), intent(inout) :: ktrw,nlw,nup,jmaxup,info + real(psb_spk_), intent(inout) :: nrmi + real(psb_spk_), intent(inout) :: row(:) + real(psb_spk_), intent(in) :: weight type(psb_int_heap), intent(inout) :: heap - integer :: k,j,irb,kin,nz - integer, parameter :: nrb=40 + integer(psb_ipk_) :: k,j,irb,kin,nz + integer(psb_ipk_), parameter :: nrb=40 real(psb_spk_) :: dmaxup real(psb_spk_), external :: dnrm2 character(len=20), parameter :: name='mld_silut_factint' @@ -597,7 +599,7 @@ contains ! rows are copied one by one into the array row, through successive ! calls to ilut_copyin. ! - + if ((mod(i,nrb) == 1).or.(nrb == 1)) then irb = min(m-i+1,nrb) call aa%csget(i,i+irb-1,trw,info) @@ -608,7 +610,7 @@ contains end if ktrw=1 end if - + kin = ktrw nz = trw%get_nzeros() do @@ -715,19 +717,19 @@ contains ! Arguments type(psb_int_heap), intent(inout) :: heap - integer, intent(in) :: i - integer, intent(inout) :: nidx,info + integer(psb_ipk_), intent(in) :: i + integer(psb_ipk_), intent(inout) :: nidx,info real(psb_spk_), intent(in) :: thres,nrmi - integer, allocatable, intent(inout) :: idxs(:) - integer, intent(inout) :: uja(:),uirp(:) + integer(psb_ipk_), allocatable, intent(inout) :: idxs(:) + integer(psb_ipk_), intent(inout) :: uja(:),uirp(:) real(psb_spk_), intent(inout) :: row(:), uval(:),d(:) ! Local Variables - integer :: k,j,jj,lastk,iret + integer(psb_ipk_) :: k,j,jj,lastk,iret real(psb_spk_) :: rwk info = psb_success_ - call psb_ensure_size(200,idxs,info) + call psb_ensure_size(200*ione,idxs,info) if (info /= psb_success_) return nidx = 0 lastk = -1 @@ -757,7 +759,7 @@ contains ! ! Drop the entry. ! - row(k) = szero + row(k) = czero cycle else ! @@ -779,7 +781,7 @@ contains ! ! Drop the entry. ! - row(j) = szero + row(j) = czero else ! ! Do the insertion. @@ -901,24 +903,24 @@ contains implicit none ! Arguments - integer, intent(in) :: fill_in,i,m,nidx,nlw,nup,jmaxup - integer, intent(in) :: idxs(:) - integer, intent(inout) :: l1,l2, info - integer, allocatable, intent(inout) :: uja(:),uirp(:), lja(:),lirp(:) + integer(psb_ipk_), intent(in) :: fill_in,i,m,nidx,nlw,nup,jmaxup + integer(psb_ipk_), intent(in) :: idxs(:) + integer(psb_ipk_), intent(inout) :: l1,l2, info + integer(psb_ipk_), allocatable, intent(inout) :: uja(:),uirp(:), lja(:),lirp(:) real(psb_spk_), intent(in) :: thres,nrmi real(psb_spk_),allocatable, intent(inout) :: uval(:), lval(:) real(psb_spk_), intent(inout) :: row(:), d(:) ! Local variables - real(psb_spk_),allocatable :: xw(:) - integer, allocatable :: xwid(:), indx(:) - real(psb_spk_) :: witem - integer :: widx - integer :: k,isz,err_act,int_err(5),idxp, nz - type(psb_real_idx_heap) :: heap - character(len=20), parameter :: name='ilut_copyout' - character(len=20) :: ch_err - logical :: fndmaxup + real(psb_spk_),allocatable :: xw(:) + integer(psb_ipk_), allocatable :: xwid(:), indx(:) + real(psb_spk_) :: witem + integer(psb_ipk_) :: widx + integer(psb_ipk_) :: k,isz,err_act,int_err(5),idxp, nz + type(psb_sreal_idx_heap) :: heap + character(len=20), parameter :: name='ilut_copyout' + character(len=20) :: ch_err + logical :: fndmaxup if (psb_get_errstatus() /= 0) return info=psb_success_ @@ -938,7 +940,7 @@ contains if (info == psb_success_) allocate(xwid(nidx),xw(nidx),indx(nidx),stat=info) if (info /= psb_success_) then info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/3*nidx,0,0,0,0/),& + call psb_errpush(info,name,i_err=(/3*nidx,izero,izero,izero,izero/),& & a_err='real(psb_spk_)') goto 9999 end if @@ -1061,7 +1063,7 @@ contains ! ! Compute 1/pivot ! - d(i) = sone/d(i) + d(i) = cone/d(i) end if end if end if @@ -1171,7 +1173,7 @@ contains ! Set row to zero ! do idxp=1,nidx - row(idxs(idxp)) = szero + row(idxs(idxp)) = czero end do ! diff --git a/mlprec/impl/mld_smlprec_aply.f90 b/mlprec/impl/mld_smlprec_aply.f90 index 87e85c94..1258f339 100644 --- a/mlprec/impl/mld_smlprec_aply.f90 +++ b/mlprec/impl/mld_smlprec_aply.f90 @@ -325,7 +325,7 @@ subroutine mld_smlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info) integer(psb_ipk_), intent(out) :: info ! Local variables - integer(psb_mpik_) :: ictxt, np, me + integer(psb_ipk_) :: ictxt, np, me integer(psb_ipk_) :: err_act integer(psb_ipk_) :: debug_level, debug_unit, nlev,nc2l,nr2l,level character(len=20) :: name @@ -416,7 +416,7 @@ contains integer(psb_ipk_), intent(out) :: info ! Local variables - integer(psb_mpik_) :: ictxt,np,me + integer(psb_ipk_) :: ictxt,np,me integer(psb_ipk_) :: i, nr2l,nc2l,err_act integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: nlev, ilev, sweeps @@ -877,7 +877,7 @@ subroutine mld_smlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info) integer(psb_ipk_), intent(out) :: info ! Local variables - integer(psb_mpik_) :: ictxt, np, me + integer(psb_ipk_) :: ictxt, np, me integer(psb_ipk_) :: debug_level, debug_unit, nlev,nc2l,nr2l,level, err_act character(len=20) :: name character :: trans_ @@ -993,7 +993,7 @@ contains integer(psb_ipk_), intent(out) :: info ! Local variables - integer(psb_mpik_) :: ictxt,np,me + integer(psb_ipk_) :: ictxt,np,me integer(psb_ipk_) :: i, nr2l,nc2l,err_act integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: nlev, ilev, sweeps diff --git a/mlprec/impl/mld_smlprec_bld.f90 b/mlprec/impl/mld_smlprec_bld.f90 index 1f4b8ecf..fea041b3 100644 --- a/mlprec/impl/mld_smlprec_bld.f90 +++ b/mlprec/impl/mld_smlprec_bld.f90 @@ -93,7 +93,7 @@ subroutine mld_smlprec_bld(a,desc_a,p,info,amold,vmold) ! Local Variables type(mld_sprec_type) :: t_prec - integer(psb_mpik_) :: ictxt, me,np + integer(psb_ipk_) :: ictxt, me,np integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize integer(psb_ipk_) :: ipv(mld_ifpsz_), val integer(psb_ipk_) :: int_err(5) diff --git a/mlprec/impl/mld_sprecaply.f90 b/mlprec/impl/mld_sprecaply.f90 index 834dfffd..6de418fc 100644 --- a/mlprec/impl/mld_sprecaply.f90 +++ b/mlprec/impl/mld_sprecaply.f90 @@ -90,7 +90,7 @@ subroutine mld_sprecaply(prec,x,y,desc_data,info,trans,work) ! Local variables character :: trans_ real(psb_spk_), pointer :: work_(:) - integer(psb_mpik_) :: ictxt,np,me + integer(psb_ipk_) :: ictxt,np,me integer(psb_ipk_) :: err_act,iwsz character(len=20) :: name @@ -221,7 +221,7 @@ subroutine mld_sprecaply1(prec,x,desc_data,info,trans) character(len=1), optional :: trans ! Local variables - integer(psb_mpik_) :: ictxt,np,me + integer(psb_ipk_) :: ictxt,np,me integer(psb_ipk_) :: err_act real(psb_spk_), pointer :: WW(:), w1(:) character(len=20) :: name @@ -290,7 +290,7 @@ subroutine mld_sprecaply2_vect(prec,x,y,desc_data,info,trans,work) ! Local variables character :: trans_ real(psb_spk_), pointer :: work_(:) - integer(psb_mpik_) :: ictxt,np,me + integer(psb_ipk_) :: ictxt,np,me integer(psb_ipk_) :: err_act,iwsz character(len=20) :: name @@ -395,7 +395,7 @@ subroutine mld_sprecaply1_vect(prec,x,desc_data,info,trans,work) character :: trans_ type(psb_s_vect_type) :: ww real(psb_spk_), pointer :: work_(:) - integer(psb_mpik_) :: ictxt,np,me + integer(psb_ipk_) :: ictxt,np,me integer(psb_ipk_) :: err_act,iwsz character(len=20) :: name diff --git a/mlprec/impl/mld_sprecbld.f90 b/mlprec/impl/mld_sprecbld.f90 index 4b459c2a..11574977 100644 --- a/mlprec/impl/mld_sprecbld.f90 +++ b/mlprec/impl/mld_sprecbld.f90 @@ -76,8 +76,8 @@ subroutine mld_sprecbld(a,desc_a,p,info,amold,vmold) !!$ character, intent(in), optional :: upd ! Local Variables - type(mld_sprec_type) :: t_prec - integer(psb_mpik_) :: ictxt, me,np + type(mld_sprec_type) :: t_prec + integer(psb_ipk_) :: ictxt, me,np integer(psb_ipk_) :: err,i,k,err_act, iszv, newsz integer(psb_ipk_) :: ipv(mld_ifpsz_), val integer(psb_ipk_) :: int_err(5) diff --git a/mlprec/impl/mld_zaggrmat_asb.f90 b/mlprec/impl/mld_zaggrmat_asb.f90 index 5344ce9e..4d5c083d 100644 --- a/mlprec/impl/mld_zaggrmat_asb.f90 +++ b/mlprec/impl/mld_zaggrmat_asb.f90 @@ -118,7 +118,7 @@ subroutine mld_zaggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info) type(psb_z_csr_sparse_mat) :: acsr1 integer(psb_ipk_) :: nzl,ntaggr, err_act integer(psb_ipk_) :: debug_level, debug_unit - integer(psb_mpik_) :: ictxt,np,me + integer(psb_ipk_) :: ictxt,np,me character(len=20) :: name name='mld_aggrmat_asb' diff --git a/mlprec/impl/mld_zaggrmat_biz_asb.f90 b/mlprec/impl/mld_zaggrmat_biz_asb.f90 index ea7d2bd6..326e218e 100644 --- a/mlprec/impl/mld_zaggrmat_biz_asb.f90 +++ b/mlprec/impl/mld_zaggrmat_biz_asb.f90 @@ -95,7 +95,7 @@ subroutine mld_zaggrmat_biz_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr ! Local variables integer(psb_ipk_) :: nrow, nglob, ncol, ntaggr, ip, ndx,& & naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw, err_act - integer(psb_mpik_) ::ictxt, np, me + integer(psb_ipk_) ::ictxt, np, me character(len=20) :: name type(psb_zspmat_type) :: am3, am4 type(psb_z_coo_sparse_mat) :: tmpcoo diff --git a/mlprec/impl/mld_zaggrmat_minnrg_asb.f90 b/mlprec/impl/mld_zaggrmat_minnrg_asb.f90 index 6adb1c66..87bb18e4 100644 --- a/mlprec/impl/mld_zaggrmat_minnrg_asb.f90 +++ b/mlprec/impl/mld_zaggrmat_minnrg_asb.f90 @@ -116,7 +116,7 @@ subroutine mld_zaggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re integer(psb_ipk_), allocatable :: nzbr(:), idisp(:) integer(psb_ipk_) :: nrow, nglob, ncol, ntaggr, nzac, ip, ndx,& & naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrt, err_act - integer(psb_mpik_) :: ictxt,np,me, icomm + integer(psb_ipk_) :: ictxt,np,me, icomm character(len=20) :: name type(psb_zspmat_type) :: af, ptilde, rtilde, atran, atp, atdatp type(psb_zspmat_type) :: am3,am4, ap, adap,atmp,rada, ra, atmp2, dap, dadap, da @@ -688,7 +688,7 @@ contains subroutine local_dump(me,mat,name,header) type(psb_zspmat_type), intent(in) :: mat - integer(psb_mpik_), intent(in) :: me + integer(psb_ipk_), intent(in) :: me character(len=*), intent(in) :: name character(len=*), intent(in) :: header character(len=80) :: filename diff --git a/mlprec/impl/mld_zaggrmat_nosmth_asb.f90 b/mlprec/impl/mld_zaggrmat_nosmth_asb.f90 index 8d37a8cb..802a92ae 100644 --- a/mlprec/impl/mld_zaggrmat_nosmth_asb.f90 +++ b/mlprec/impl/mld_zaggrmat_nosmth_asb.f90 @@ -97,7 +97,7 @@ subroutine mld_zaggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re ! Local variables integer(psb_ipk_) :: err_act - integer(psb_mpik_) :: ictxt,np,me, icomm, ndx, minfo + integer(psb_ipk_) :: ictxt,np,me, icomm, ndx, minfo character(len=20) :: name integer(psb_ipk_) :: ierr(5) type(psb_z_coo_sparse_mat) :: ac_coo, acoo diff --git a/mlprec/impl/mld_zaggrmat_smth_asb.f90 b/mlprec/impl/mld_zaggrmat_smth_asb.f90 index c8872ed8..e286c27c 100644 --- a/mlprec/impl/mld_zaggrmat_smth_asb.f90 +++ b/mlprec/impl/mld_zaggrmat_smth_asb.f90 @@ -110,7 +110,7 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest ! Local variables integer(psb_ipk_) :: nrow, nglob, ncol, ntaggr, ip, ndx,& & naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw, err_act - integer(psb_mpik_) ::ictxt, np, me + integer(psb_ipk_) ::ictxt, np, me character(len=20) :: name type(psb_zspmat_type) :: am3, am4 type(psb_z_coo_sparse_mat) :: tmpcoo diff --git a/mlprec/impl/mld_zilu0_fact.f90 b/mlprec/impl/mld_zilu0_fact.f90 index ec06ee38..f42fd4ce 100644 --- a/mlprec/impl/mld_zilu0_fact.f90 +++ b/mlprec/impl/mld_zilu0_fact.f90 @@ -107,19 +107,19 @@ subroutine mld_zilu0_fact(ialg,a,l,u,d,info,blck, upd) implicit none ! Arguments - integer, intent(in) :: ialg + integer(psb_ipk_), intent(in) :: ialg type(psb_zspmat_type),intent(in) :: a type(psb_zspmat_type),intent(inout) :: l,u - complex(psb_dpk_), intent(inout) :: d(:) - integer, intent(out) :: info + complex(psb_dpk_), intent(inout) :: d(:) + integer(psb_ipk_), intent(out) :: info type(psb_zspmat_type),intent(in), optional, target :: blck - character, intent(in), optional :: upd + character, intent(in), optional :: upd ! Local variables - integer :: l1, l2, m, err_act + integer(psb_ipk_) :: l1, l2, m, err_act type(psb_zspmat_type), pointer :: blck_ - type(psb_z_csr_sparse_mat) :: ll, uu - character :: upd_ + type(psb_z_csr_sparse_mat) :: ll, uu + character :: upd_ character(len=20) :: name, ch_err name='mld_zilu0_fact' @@ -133,7 +133,7 @@ subroutine mld_zilu0_fact(ialg,a,l,u,d,info,blck, upd) blck_ => blck else allocate(blck_,stat=info) - if (info == psb_success_) call blck_%csall(0,0,info,1) + if (info == psb_success_) call blck_%csall(izero,izero,info,ione) if (info /= psb_success_) then info=psb_err_from_subroutine_ ch_err='csall' @@ -292,20 +292,20 @@ contains implicit none ! Arguments - integer, intent(in) :: ialg + integer(psb_ipk_), intent(in) :: ialg type(psb_zspmat_type),intent(in) :: a,b - integer,intent(inout) :: l1,l2,info - integer, intent(inout) :: lja(:),lirp(:),uja(:),uirp(:) + integer(psb_ipk_),intent(inout) :: l1,l2,info + integer(psb_ipk_), intent(inout) :: lja(:),lirp(:),uja(:),uirp(:) complex(psb_dpk_), intent(inout) :: lval(:),uval(:),d(:) character, intent(in) :: upd ! Local variables - integer :: i,j,k,l,low1,low2,kk,jj,ll, ktrw,err_act, m - integer :: ma,mb + integer(psb_ipk_) :: i,j,k,l,low1,low2,kk,jj,ll, ktrw,err_act, m + integer(psb_ipk_) :: ma,mb complex(psb_dpk_) :: dia,temp - integer, parameter :: nrb=16 + integer(psb_ipk_), parameter :: nrb=16 type(psb_z_coo_sparse_mat) :: trw - integer :: int_err(5) + integer(psb_ipk_) :: int_err(5) character(len=20) :: name, ch_err name='mld_zilu0_factint' @@ -320,11 +320,12 @@ contains ! Ok case default info=psb_err_input_asize_invalid_i_ - call psb_errpush(info,name,i_err=(/1,ialg,0,0,0/)) + call psb_errpush(info,name,& + & i_err=(/ione,ialg,izero,izero,izero/)) goto 9999 end select - call trw%allocate(0,0,1) + call trw%allocate(izero,izero,ione) if(info /= psb_success_) then info=psb_err_from_subroutine_ ch_err='psb_sp_all' @@ -351,14 +352,14 @@ contains ! Copy the i-th local row of the matrix, stored in a, ! into lval/d(i)/uval ! - call ilu_copyin(i,ma,a,i,1,m,l1,lja,lval,& + call ilu_copyin(i,ma,a,i,ione,m,l1,lja,lval,& & d(i),l2,uja,uval,ktrw,trw,upd) else ! ! Copy the i-th local row of the matrix, stored in b ! (as (i-ma)-th row), into lval/d(i)/uval ! - call ilu_copyin(i-ma,mb,b,i,1,m,l1,lja,lval,& + call ilu_copyin(i-ma,mb,b,i,ione,m,l1,lja,lval,& & d(i),l2,uja,uval,ktrw,trw,upd) endif @@ -463,7 +464,8 @@ contains else write(0,*) 'Update not implemented ' info = 31 - call psb_errpush(info,name,i_err=(/13,0,0,0,0/),a_err=upd) + call psb_errpush(info,name,& + & i_err=(/ione*13,izero,izero,izero,izero/),a_err=upd) goto 9999 end if @@ -564,14 +566,14 @@ contains ! Arguments type(psb_zspmat_type), intent(in) :: a type(psb_z_coo_sparse_mat), intent(inout) :: trw - integer, intent(in) :: i,m,jd,jmin,jmax - integer, intent(inout) :: ktrw,l1,l2 - integer, intent(inout) :: lja(:), uja(:) - complex(psb_dpk_), intent(inout) :: lval(:), uval(:), dia + integer(psb_ipk_), intent(in) :: i,m,jd,jmin,jmax + integer(psb_ipk_), intent(inout) :: ktrw,l1,l2 + integer(psb_ipk_), intent(inout) :: lja(:), uja(:) + complex(psb_dpk_), intent(inout) :: lval(:), uval(:), dia character, intent(in) :: upd ! Local variables - integer :: k,j,info,irb, nz - integer, parameter :: nrb=40 + integer(psb_ipk_) :: k,j,info,irb, nz + integer(psb_ipk_), parameter :: nrb=40 character(len=20), parameter :: name='ilu_copyin' character(len=20) :: ch_err @@ -650,7 +652,8 @@ contains write(0,*) 'Update not implemented ' info = 31 - call psb_errpush(info,name,i_err=(/13,0,0,0,0/),a_err=upd) + call psb_errpush(info,name,& + & i_err=(/ione*13,izero,izero,izero,izero/),a_err=upd) goto 9999 end if diff --git a/mlprec/impl/mld_ziluk_fact.f90 b/mlprec/impl/mld_ziluk_fact.f90 index ed886d6e..ca531ddd 100644 --- a/mlprec/impl/mld_ziluk_fact.f90 +++ b/mlprec/impl/mld_ziluk_fact.f90 @@ -104,17 +104,17 @@ subroutine mld_ziluk_fact(fill_in,ialg,a,l,u,d,info,blck) implicit none ! Arguments - integer, intent(in) :: fill_in, ialg - integer, intent(out) :: info + 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(:) ! Local Variables - integer :: l1, l2, m, err_act + integer(psb_ipk_) :: l1, l2, m, err_act type(psb_zspmat_type), pointer :: blck_ - type(psb_z_csr_sparse_mat) :: ll, uu + type(psb_z_csr_sparse_mat) :: ll, uu character(len=20) :: name, ch_err name='mld_ziluk_fact' @@ -128,7 +128,7 @@ subroutine mld_ziluk_fact(fill_in,ialg,a,l,u,d,info,blck) blck_ => blck else allocate(blck_,stat=info) - if (info == psb_success_) call blck_%csall(0,0,info,1) + if (info == psb_success_) call blck_%csall(izero,izero,info,ione) if (info /= psb_success_) then info=psb_err_from_subroutine_ ch_err='csall' @@ -278,21 +278,21 @@ contains implicit none ! Arguments - integer, intent(in) :: fill_in, ialg - type(psb_zspmat_type),intent(in) :: a,b - integer,intent(inout) :: l1,l2,info - integer, allocatable, intent(inout) :: lja(:),lirp(:),uja(:),uirp(:) + integer(psb_ipk_), intent(in) :: fill_in, ialg + type(psb_zspmat_type),intent(in) :: a,b + integer(psb_ipk_),intent(inout) :: l1,l2,info + integer(psb_ipk_), allocatable, intent(inout) :: lja(:),lirp(:),uja(:),uirp(:) complex(psb_dpk_), allocatable, intent(inout) :: lval(:),uval(:) complex(psb_dpk_), intent(inout) :: d(:) ! Local variables - integer :: ma,mb,i, ktrw,err_act,nidx, m - integer, allocatable :: uplevs(:), rowlevs(:),idxs(:) + integer(psb_ipk_) :: ma,mb,i, ktrw,err_act,nidx, m + integer(psb_ipk_), allocatable :: uplevs(:), rowlevs(:),idxs(:) complex(psb_dpk_), allocatable :: row(:) type(psb_int_heap) :: heap - type(psb_z_coo_sparse_mat) :: trw - character(len=20), parameter :: name='mld_ziluk_factint' - character(len=20) :: ch_err + type(psb_z_coo_sparse_mat) :: trw + character(len=20), parameter :: name='mld_ziluk_factint' + character(len=20) :: ch_err if (psb_get_errstatus() /= 0) return info=psb_success_ @@ -304,12 +304,14 @@ contains ! Ok case default info=psb_err_input_asize_invalid_i_ - call psb_errpush(info,name,i_err=(/2,ialg,0,0,0/)) + call psb_errpush(info,name,& + & i_err=(/itwo,ialg,izero,izero,izero/)) goto 9999 end select if (fill_in < 0) then info=psb_err_input_asize_invalid_i_ - call psb_errpush(info,name,i_err=(/1,fill_in,0,0,0/)) + call psb_errpush(info,name, & + & i_err=(/ione,fill_in,izero,izero,izero/)) goto 9999 end if @@ -321,7 +323,7 @@ contains ! Allocate a temporary buffer for the iluk_copyin function ! - call trw%allocate(0,0,1) + call trw%allocate(izero,izero,ione) if (info == psb_success_) call psb_ensure_size(m+1,lirp,info) if (info == psb_success_) call psb_ensure_size(m+1,uirp,info) @@ -369,13 +371,13 @@ contains ! ! Copy into trw the i-th local row of the matrix, stored in a ! - call iluk_copyin(i,ma,a,1,m,row,rowlevs,heap,ktrw,trw,info) + call iluk_copyin(i,ma,a,ione,m,row,rowlevs,heap,ktrw,trw,info) else ! ! Copy into trw the i-th local row of the matrix, stored in b ! (as (i-ma)-th row) ! - call iluk_copyin(i-ma,mb,b,1,m,row,rowlevs,heap,ktrw,trw,info) + call iluk_copyin(i-ma,mb,b,ione,m,row,rowlevs,heap,ktrw,trw,info) endif ! Do an elimination step on the current row. It turns out we only @@ -496,17 +498,17 @@ contains implicit none ! Arguments - type(psb_zspmat_type), intent(in) :: a + type(psb_zspmat_type), intent(in) :: a type(psb_z_coo_sparse_mat), intent(inout) :: trw - integer, intent(in) :: i,m,jmin,jmax - integer, intent(inout) :: ktrw,info - integer, intent(inout) :: rowlevs(:) - complex(psb_dpk_), intent(inout) :: row(:) - type(psb_int_heap), intent(inout) :: heap + integer(psb_ipk_), intent(in) :: i,m,jmin,jmax + integer(psb_ipk_), intent(inout) :: ktrw,info + integer(psb_ipk_), intent(inout) :: rowlevs(:) + complex(psb_dpk_), intent(inout) :: row(:) + type(psb_int_heap), intent(inout) :: heap ! Local variables - integer :: k,j,irb,err_act,nz - integer, parameter :: nrb=40 + integer(psb_ipk_) :: k,j,irb,err_act,nz + integer(psb_ipk_), parameter :: nrb=40 character(len=20), parameter :: name='iluk_copyin' character(len=20) :: ch_err @@ -653,16 +655,16 @@ contains implicit none ! Arguments - type(psb_int_heap), intent(inout) :: heap - integer, intent(in) :: i, fill_in - integer, intent(inout) :: nidx,info - integer, intent(inout) :: rowlevs(:) - integer, allocatable, intent(inout) :: idxs(:) - integer, intent(inout) :: uja(:),uirp(:),uplevs(:) - complex(psb_dpk_), intent(inout) :: row(:), uval(:),d(:) + type(psb_int_heap), intent(inout) :: heap + integer(psb_ipk_), intent(in) :: i, fill_in + integer(psb_ipk_), intent(inout) :: nidx,info + integer(psb_ipk_), intent(inout) :: rowlevs(:) + integer(psb_ipk_), allocatable, intent(inout) :: idxs(:) + integer(psb_ipk_), intent(inout) :: uja(:),uirp(:),uplevs(:) + complex(psb_dpk_), intent(inout) :: row(:), uval(:),d(:) ! Local variables - integer :: k,j,lrwk,jj,lastk, iret + integer(psb_ipk_) :: k,j,lrwk,jj,lastk, iret complex(psb_dpk_) :: rwk info = psb_success_ @@ -829,15 +831,15 @@ contains implicit none ! Arguments - integer, intent(in) :: fill_in, ialg, i, m, nidx - integer, intent(inout) :: l1, l2, info - integer, intent(inout) :: rowlevs(:), idxs(:) - integer, allocatable, intent(inout) :: uja(:), uirp(:), lja(:), lirp(:),uplevs(:) - complex(psb_dpk_), allocatable, intent(inout) :: uval(:), lval(:) + integer(psb_ipk_), intent(in) :: fill_in, ialg, i, m, nidx + integer(psb_ipk_), intent(inout) :: l1, l2, info + integer(psb_ipk_), intent(inout) :: rowlevs(:), idxs(:) + integer(psb_ipk_), allocatable, intent(inout) :: uja(:), uirp(:), lja(:), lirp(:),uplevs(:) + complex(psb_dpk_), allocatable, intent(inout) :: uval(:), lval(:) complex(psb_dpk_), intent(inout) :: row(:), d(:) ! Local variables - integer :: j,isz,err_act,int_err(5),idxp + integer(psb_ipk_) :: j,isz,err_act,int_err(5),idxp character(len=20), parameter :: name='mld_ziluk_factint' character(len=20) :: ch_err diff --git a/mlprec/impl/mld_zilut_fact.f90 b/mlprec/impl/mld_zilut_fact.f90 index bb7a4b6c..94bfba20 100644 --- a/mlprec/impl/mld_zilut_fact.f90 +++ b/mlprec/impl/mld_zilut_fact.f90 @@ -100,16 +100,16 @@ subroutine mld_zilut_fact(fill_in,thres,a,l,u,d,info,blck,iscale) implicit none ! Arguments - integer, intent(in) :: fill_in - real(psb_dpk_), intent(in) :: thres - integer, intent(out) :: info + 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(:) + 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 ! Local Variables - integer :: l1, l2, m, err_act, iscale_ + integer(psb_ipk_) :: l1, l2, m, err_act, iscale_ type(psb_zspmat_type), pointer :: blck_ type(psb_z_csr_sparse_mat) :: ll, uu @@ -122,7 +122,8 @@ subroutine mld_zilut_fact(fill_in,thres,a,l,u,d,info,blck,iscale) if (fill_in < 0) then info=psb_err_input_asize_invalid_i_ - call psb_errpush(info,name,i_err=(/1,fill_in,0,0,0/)) + call psb_errpush(info,name, & + & i_err=(/ione,fill_in,izero,izero,izero/)) goto 9999 end if ! @@ -132,7 +133,7 @@ subroutine mld_zilut_fact(fill_in,thres,a,l,u,d,info,blck,iscale) blck_ => blck else allocate(blck_,stat=info) - if (info == psb_success_) call blck_%csall(0,0,info,1) + if (info == psb_success_) call blck_%csall(izero,izero,info,ione) if (info /= psb_success_) then info=psb_err_from_subroutine_ ch_err='csall' @@ -148,13 +149,13 @@ subroutine mld_zilut_fact(fill_in,thres,a,l,u,d,info,blck,iscale) select case(iscale_) case(mld_ilu_scale_none_) - scale = done + scale = sone case(mld_ilu_scale_maxval_) scale = max(a%maxval(),blck_%maxval()) - scale = done/scale + scale = sone/scale case default info=psb_err_input_asize_invalid_i_ - call psb_errpush(info,name,i_err=(/9,iscale_,0,0,0/)) + call psb_errpush(info,name,i_err=(/ione*9,iscale_,izero,izero,izero/)) goto 9999 end select @@ -296,20 +297,20 @@ contains implicit none ! Arguments - integer, intent(in) :: fill_in - real(psb_dpk_), intent(in) :: thres - type(psb_zspmat_type),intent(in) :: a,b - integer,intent(inout) :: l1,l2,info - integer, allocatable, intent(inout) :: lja(:),lirp(:),uja(:),uirp(:) - complex(psb_dpk_), allocatable, intent(inout) :: lval(:),uval(:) - complex(psb_dpk_), intent(inout) :: d(:) - real(psb_dpk_), intent(in), optional :: scale + integer(psb_ipk_), intent(in) :: fill_in + real(psb_dpk_), intent(in) :: thres + type(psb_zspmat_type),intent(in) :: a,b + integer(psb_ipk_),intent(inout) :: l1,l2,info + integer(psb_ipk_), allocatable, intent(inout) :: lja(:),lirp(:),uja(:),uirp(:) + complex(psb_dpk_), allocatable, intent(inout) :: lval(:),uval(:) + complex(psb_dpk_), intent(inout) :: d(:) + real(psb_dpk_), intent(in), optional :: scale ! Local Variables - integer :: i, ktrw,err_act,nidx,nlw,nup,jmaxup, ma, mb, m + integer(psb_ipk_) :: i, ktrw,err_act,nidx,nlw,nup,jmaxup, ma, mb, m real(psb_dpk_) :: nrmi real(psb_dpk_) :: weight - integer, allocatable :: idxs(:) + integer(psb_ipk_), allocatable :: idxs(:) complex(psb_dpk_), allocatable :: row(:) type(psb_int_heap) :: heap type(psb_z_coo_sparse_mat) :: trw @@ -328,7 +329,7 @@ contains ! ! Allocate a temporary buffer for the ilut_copyin function ! - call trw%allocate(0,0,1) + call trw%allocate(izero,izero,ione) if (info == psb_success_) call psb_ensure_size(m+1,lirp,info) if (info == psb_success_) call psb_ensure_size(m+1,uirp,info) @@ -353,8 +354,8 @@ contains goto 9999 end if - row(:) = zzero - weight = done + row(:) = czero + weight = sone if (present(scale)) weight = abs(scale) ! ! Cycle over the matrix rows @@ -369,12 +370,12 @@ contains ! the lowest index, but we also need to insert new items, and the heap ! allows to do both in log time. ! - d(i) = zzero + d(i) = czero if (i<=ma) then - call ilut_copyin(i,ma,a,i,1,m,nlw,nup,jmaxup,nrmi,weight,& + call ilut_copyin(i,ma,a,i,ione,m,nlw,nup,jmaxup,nrmi,weight,& & row,heap,ktrw,trw,info) else - call ilut_copyin(i-ma,mb,b,i,1,m,nlw,nup,jmaxup,nrmi,weight,& + call ilut_copyin(i-ma,mb,b,i,ione,m,nlw,nup,jmaxup,nrmi,weight,& & row,heap,ktrw,trw,info) endif @@ -400,12 +401,12 @@ contains ! ! Adjust diagonal accounting for scale factor ! - if (weight /= done) then + if (weight /= sone) then d(1:m) = d(1:m)*weight end if ! - ! And we're done, so deallocate the memory + ! And we're sone, so deallocate the memory ! deallocate(row,idxs,stat=info) if (info /= psb_success_) then @@ -501,7 +502,7 @@ contains ! The heap containing the column indices of the nonzero ! entries in the array row. ! Note: this argument is intent(inout) and not only intent(out) - ! to retain its allocation, done by psb_init_heap inside this + ! to retain its allocation, sone by psb_init_heap inside this ! routine. ! ktrw - integer, input/output. ! The index identifying the last entry taken from the @@ -520,15 +521,15 @@ contains implicit none type(psb_zspmat_type), intent(in) :: a type(psb_z_coo_sparse_mat), intent(inout) :: trw - integer, intent(in) :: i, m,jmin,jmax,jd - integer, intent(inout) :: ktrw,nlw,nup,jmaxup,info - real(psb_dpk_), intent(inout) :: nrmi - complex(psb_dpk_), intent(inout) :: row(:) - real(psb_dpk_), intent(in) :: weight + integer(psb_ipk_), intent(in) :: i, m,jmin,jmax,jd + integer(psb_ipk_), intent(inout) :: ktrw,nlw,nup,jmaxup,info + real(psb_dpk_), intent(inout) :: nrmi + complex(psb_dpk_), intent(inout) :: row(:) + real(psb_dpk_), intent(in) :: weight type(psb_int_heap), intent(inout) :: heap - integer :: k,j,irb,kin,nz - integer, parameter :: nrb=40 + integer(psb_ipk_) :: k,j,irb,kin,nz + integer(psb_ipk_), parameter :: nrb=40 real(psb_dpk_) :: dmaxup real(psb_dpk_), external :: dnrm2 character(len=20), parameter :: name='mld_zilut_factint' @@ -554,8 +555,8 @@ contains nlw = 0 nup = 0 jmaxup = 0 - dmaxup = dzero - nrmi = dzero + dmaxup = szero + nrmi = szero select type (aa=> a%a) type is (psb_z_csr_sparse_mat) @@ -584,20 +585,20 @@ contains call psb_errpush(info,name,a_err='psb_insert_heap') goto 9999 end if - + nz = aa%irp(i+1) - aa%irp(i) nrmi = weight*dnrm2(nz,aa%val(aa%irp(i)),ione) - - - class default - ! - ! Otherwise use psb_sp_getblk, slower but able (in principle) of - ! handling any format. In this case, a block of rows is extracted - ! instead of a single row, for performance reasons, and these - ! rows are copied one by one into the array row, through successive - ! calls to ilut_copyin. - ! + + class default + + ! + ! Otherwise use psb_sp_getblk, slower but able (in principle) of + ! handling any format. In this case, a block of rows is extracted + ! instead of a single row, for performance reasons, and these + ! rows are copied one by one into the array row, through successive + ! calls to ilut_copyin. + ! if ((mod(i,nrb) == 1).or.(nrb == 1)) then irb = min(m-i+1,nrb) @@ -706,7 +707,7 @@ contains ! examined during the elimination step.This will be used by ! by the routine ilut_copyout. ! Note: this argument is intent(inout) and not only intent(out) - ! to retain its allocation, done by this routine. + ! to retain its allocation, sone by this routine. ! subroutine ilut_fact(thres,i,nrmi,row,heap,d,uja,uirp,uval,nidx,idxs,info) @@ -716,19 +717,19 @@ contains ! Arguments type(psb_int_heap), intent(inout) :: heap - integer, intent(in) :: i - integer, intent(inout) :: nidx,info + integer(psb_ipk_), intent(in) :: i + integer(psb_ipk_), intent(inout) :: nidx,info real(psb_dpk_), intent(in) :: thres,nrmi - integer, allocatable, intent(inout) :: idxs(:) - integer, intent(inout) :: uja(:),uirp(:) + integer(psb_ipk_), allocatable, intent(inout) :: idxs(:) + integer(psb_ipk_), intent(inout) :: uja(:),uirp(:) complex(psb_dpk_), intent(inout) :: row(:), uval(:),d(:) ! Local Variables - integer :: k,j,jj,lastk,iret + integer(psb_ipk_) :: k,j,jj,lastk,iret complex(psb_dpk_) :: rwk info = psb_success_ - call psb_ensure_size(200,idxs,info) + call psb_ensure_size(200*ione,idxs,info) if (info /= psb_success_) return nidx = 0 lastk = -1 @@ -758,7 +759,7 @@ contains ! ! Drop the entry. ! - row(k) = zzero + row(k) = czero cycle else ! @@ -780,7 +781,7 @@ contains ! ! Drop the entry. ! - row(j) = zzero + row(j) = czero else ! ! Do the insertion. @@ -902,20 +903,20 @@ contains implicit none ! Arguments - integer, intent(in) :: fill_in,i,m,nidx,nlw,nup,jmaxup - integer, intent(in) :: idxs(:) - integer, intent(inout) :: l1,l2, info - integer, allocatable, intent(inout) :: uja(:),uirp(:), lja(:),lirp(:) + integer(psb_ipk_), intent(in) :: fill_in,i,m,nidx,nlw,nup,jmaxup + integer(psb_ipk_), intent(in) :: idxs(:) + integer(psb_ipk_), intent(inout) :: l1,l2, info + integer(psb_ipk_), allocatable, intent(inout) :: uja(:),uirp(:), lja(:),lirp(:) real(psb_dpk_), intent(in) :: thres,nrmi complex(psb_dpk_),allocatable, intent(inout) :: uval(:), lval(:) complex(psb_dpk_), intent(inout) :: row(:), d(:) ! Local variables complex(psb_dpk_),allocatable :: xw(:) - integer, allocatable :: xwid(:), indx(:) + integer(psb_ipk_), allocatable :: xwid(:), indx(:) complex(psb_dpk_) :: witem - integer :: widx - integer :: k,isz,err_act,int_err(5),idxp, nz + integer(psb_ipk_) :: widx + integer(psb_ipk_) :: k,isz,err_act,int_err(5),idxp, nz type(psb_dcomplex_idx_heap) :: heap character(len=20), parameter :: name='ilut_copyout' character(len=20) :: ch_err @@ -939,7 +940,7 @@ contains if (info == psb_success_) allocate(xwid(nidx),xw(nidx),indx(nidx),stat=info) if (info /= psb_success_) then info=psb_err_alloc_request_ - call psb_errpush(info,name,i_err=(/3*nidx,0,0,0,0/),& + call psb_errpush(info,name,i_err=(/3*nidx,izero,izero,izero,izero/),& & a_err='complex(psb_dpk_)') goto 9999 end if @@ -1062,7 +1063,7 @@ contains ! ! Compute 1/pivot ! - d(i) = zone/d(i) + d(i) = cone/d(i) end if end if end if @@ -1172,7 +1173,7 @@ contains ! Set row to zero ! do idxp=1,nidx - row(idxs(idxp)) = zzero + row(idxs(idxp)) = czero end do ! diff --git a/mlprec/impl/mld_zmlprec_aply.f90 b/mlprec/impl/mld_zmlprec_aply.f90 index 53a775d9..a37bcd6b 100644 --- a/mlprec/impl/mld_zmlprec_aply.f90 +++ b/mlprec/impl/mld_zmlprec_aply.f90 @@ -325,7 +325,7 @@ subroutine mld_zmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info) integer(psb_ipk_), intent(out) :: info ! Local variables - integer(psb_mpik_) :: ictxt, np, me + integer(psb_ipk_) :: ictxt, np, me integer(psb_ipk_) :: err_act integer(psb_ipk_) :: debug_level, debug_unit, nlev,nc2l,nr2l,level character(len=20) :: name @@ -416,7 +416,7 @@ contains integer(psb_ipk_), intent(out) :: info ! Local variables - integer(psb_mpik_) :: ictxt,np,me + integer(psb_ipk_) :: ictxt,np,me integer(psb_ipk_) :: i, nr2l,nc2l,err_act integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: nlev, ilev, sweeps @@ -877,7 +877,7 @@ subroutine mld_zmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info) integer(psb_ipk_), intent(out) :: info ! Local variables - integer(psb_mpik_) :: ictxt, np, me + integer(psb_ipk_) :: ictxt, np, me integer(psb_ipk_) :: debug_level, debug_unit, nlev,nc2l,nr2l,level, err_act character(len=20) :: name character :: trans_ @@ -993,7 +993,7 @@ contains integer(psb_ipk_), intent(out) :: info ! Local variables - integer(psb_mpik_) :: ictxt,np,me + integer(psb_ipk_) :: ictxt,np,me integer(psb_ipk_) :: i, nr2l,nc2l,err_act integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: nlev, ilev, sweeps diff --git a/mlprec/impl/mld_zmlprec_bld.f90 b/mlprec/impl/mld_zmlprec_bld.f90 index a4cf1a54..a747246d 100644 --- a/mlprec/impl/mld_zmlprec_bld.f90 +++ b/mlprec/impl/mld_zmlprec_bld.f90 @@ -93,7 +93,7 @@ subroutine mld_zmlprec_bld(a,desc_a,p,info,amold,vmold) ! Local Variables type(mld_zprec_type) :: t_prec - integer(psb_mpik_) :: ictxt, me,np + integer(psb_ipk_) :: ictxt, me,np integer(psb_ipk_) :: err,i,k, err_act, iszv, newsz, casize integer(psb_ipk_) :: ipv(mld_ifpsz_), val integer(psb_ipk_) :: int_err(5) diff --git a/mlprec/impl/mld_zprecaply.f90 b/mlprec/impl/mld_zprecaply.f90 index f97b8c87..9e20a514 100644 --- a/mlprec/impl/mld_zprecaply.f90 +++ b/mlprec/impl/mld_zprecaply.f90 @@ -90,7 +90,7 @@ subroutine mld_zprecaply(prec,x,y,desc_data,info,trans,work) ! Local variables character :: trans_ complex(psb_dpk_), pointer :: work_(:) - integer(psb_mpik_) :: ictxt,np,me + integer(psb_ipk_) :: ictxt,np,me integer(psb_ipk_) :: err_act,iwsz character(len=20) :: name @@ -221,7 +221,7 @@ subroutine mld_zprecaply1(prec,x,desc_data,info,trans) character(len=1), optional :: trans ! Local variables - integer(psb_mpik_) :: ictxt,np,me + integer(psb_ipk_) :: ictxt,np,me integer(psb_ipk_) :: err_act complex(psb_dpk_), pointer :: WW(:), w1(:) character(len=20) :: name @@ -290,7 +290,7 @@ subroutine mld_zprecaply2_vect(prec,x,y,desc_data,info,trans,work) ! Local variables character :: trans_ complex(psb_dpk_), pointer :: work_(:) - integer(psb_mpik_) :: ictxt,np,me + integer(psb_ipk_) :: ictxt,np,me integer(psb_ipk_) :: err_act,iwsz character(len=20) :: name @@ -395,7 +395,7 @@ subroutine mld_zprecaply1_vect(prec,x,desc_data,info,trans,work) character :: trans_ type(psb_z_vect_type) :: ww complex(psb_dpk_), pointer :: work_(:) - integer(psb_mpik_) :: ictxt,np,me + integer(psb_ipk_) :: ictxt,np,me integer(psb_ipk_) :: err_act,iwsz character(len=20) :: name diff --git a/mlprec/impl/mld_zprecbld.f90 b/mlprec/impl/mld_zprecbld.f90 index 8e24980b..8b1e69fc 100644 --- a/mlprec/impl/mld_zprecbld.f90 +++ b/mlprec/impl/mld_zprecbld.f90 @@ -76,8 +76,8 @@ subroutine mld_zprecbld(a,desc_a,p,info,amold,vmold) !!$ character, intent(in), optional :: upd ! Local Variables - type(mld_zprec_type) :: t_prec - integer(psb_mpik_) :: ictxt, me,np + type(mld_zprec_type) :: t_prec + integer(psb_ipk_) :: ictxt, me,np integer(psb_ipk_) :: err,i,k,err_act, iszv, newsz integer(psb_ipk_) :: ipv(mld_ifpsz_), val integer(psb_ipk_) :: int_err(5) diff --git a/mlprec/mld_base_prec_type.F90 b/mlprec/mld_base_prec_type.F90 index 64d140de..c537e1e3 100644 --- a/mlprec/mld_base_prec_type.F90 +++ b/mlprec/mld_base_prec_type.F90 @@ -66,7 +66,7 @@ module mld_base_prec_type use psb_const_mod use psb_base_mod, only :& & psb_desc_type,& - & psb_ipk_, psb_mpik_, psb_dpk_, psb_spk_, psb_long_int_k_, & + & psb_ipk_, psb_dpk_, psb_spk_, psb_long_int_k_, & & psb_cdfree, psb_halo_, psb_none_, psb_sum_, psb_avg_, & & psb_nohalo_, psb_square_root_, psb_toupper, psb_root_,& & psb_sizeof_int, psb_sizeof_long_int, psb_sizeof_sp, psb_sizeof_dp, psb_sizeof,& @@ -917,9 +917,9 @@ contains subroutine mld_ml_bcast(ictxt,dat,root) implicit none - integer(psb_mpik_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt type(mld_ml_parms), intent(inout) :: dat - integer(psb_mpik_), intent(in), optional :: root + integer(psb_ipk_), intent(in), optional :: root call psb_bcast(ictxt,dat%sweeps,root) call psb_bcast(ictxt,dat%sweeps_pre,root) @@ -939,9 +939,9 @@ contains subroutine mld_sml_bcast(ictxt,dat,root) implicit none - integer(psb_mpik_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt type(mld_sml_parms), intent(inout) :: dat - integer(psb_mpik_), intent(in), optional :: root + integer(psb_ipk_), intent(in), optional :: root call psb_bcast(ictxt,dat%mld_ml_parms,root) call psb_bcast(ictxt,dat%aggr_omega_val,root) @@ -950,9 +950,9 @@ contains subroutine mld_dml_bcast(ictxt,dat,root) implicit none - integer(psb_mpik_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt type(mld_dml_parms), intent(inout) :: dat - integer(psb_mpik_), intent(in), optional :: root + integer(psb_ipk_), intent(in), optional :: root call psb_bcast(ictxt,dat%mld_ml_parms,root) call psb_bcast(ictxt,dat%aggr_omega_val,root) diff --git a/mlprec/mld_c_as_smoother.f90 b/mlprec/mld_c_as_smoother.f90 index 30cd417a..a5ff974c 100644 --- a/mlprec/mld_c_as_smoother.f90 +++ b/mlprec/mld_c_as_smoother.f90 @@ -190,10 +190,10 @@ module mld_c_as_smoother subroutine mld_c_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver) import :: psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & & psb_spk_, mld_c_as_smoother_type, psb_long_int_k_, psb_desc_type, & - & psb_ipk_, psb_mpik_ + & psb_ipk_ implicit none class(mld_c_as_smoother_type), intent(in) :: sm - integer(psb_mpik_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(out) :: info character(len=*), intent(in), optional :: prefix, head diff --git a/mlprec/mld_c_base_smoother_mod.f90 b/mlprec/mld_c_base_smoother_mod.f90 index 3eb5eaca..094e576e 100644 --- a/mlprec/mld_c_base_smoother_mod.f90 +++ b/mlprec/mld_c_base_smoother_mod.f90 @@ -243,9 +243,9 @@ module mld_c_base_smoother_mod subroutine mld_c_base_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver) import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, & - & mld_c_base_smoother_type, psb_ipk_, psb_mpik_ + & mld_c_base_smoother_type, psb_ipk_ class(mld_c_base_smoother_type), intent(in) :: sm - integer(psb_mpik_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(out) :: info character(len=*), intent(in), optional :: prefix, head diff --git a/mlprec/mld_c_base_solver_mod.f90 b/mlprec/mld_c_base_solver_mod.f90 index 5217c014..7fba8a20 100644 --- a/mlprec/mld_c_base_solver_mod.f90 +++ b/mlprec/mld_c_base_solver_mod.f90 @@ -249,10 +249,10 @@ module mld_c_base_solver_mod subroutine mld_c_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver) import :: psb_desc_type, psb_cspmat_type, psb_c_base_sparse_mat, & & psb_c_vect_type, psb_c_base_vect_type, psb_spk_, & - & mld_c_base_solver_type, psb_ipk_, psb_mpik_ + & mld_c_base_solver_type, psb_ipk_ implicit none class(mld_c_base_solver_type), intent(in) :: sv - integer(psb_mpik_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(out) :: info character(len=*), intent(in), optional :: prefix, head diff --git a/mlprec/mld_c_ilu_solver.f90 b/mlprec/mld_c_ilu_solver.f90 index b0c19e56..48c7ae51 100644 --- a/mlprec/mld_c_ilu_solver.f90 +++ b/mlprec/mld_c_ilu_solver.f90 @@ -139,10 +139,10 @@ module mld_c_ilu_solver subroutine mld_c_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver) import :: psb_desc_type, mld_c_ilu_solver_type, psb_c_vect_type, psb_spk_, & & psb_cspmat_type, psb_c_base_sparse_mat, psb_c_base_vect_type, & - & psb_ipk_, psb_mpik_ + & psb_ipk_ implicit none class(mld_c_ilu_solver_type), intent(in) :: sv - integer(psb_mpik_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(out) :: info character(len=*), intent(in), optional :: prefix, head diff --git a/mlprec/mld_c_onelev_mod.f90 b/mlprec/mld_c_onelev_mod.f90 index bd560261..7ab57344 100644 --- a/mlprec/mld_c_onelev_mod.f90 +++ b/mlprec/mld_c_onelev_mod.f90 @@ -57,7 +57,7 @@ module mld_c_onelev_mod use mld_base_prec_type use mld_c_base_smoother_mod use psb_base_mod, only : psb_cspmat_type, psb_c_vect_type, psb_c_base_vect_type, & - & psb_clinmap_type, psb_spk_, psb_mpik_, psb_ipk_, psb_long_int_k_, psb_desc_type + & psb_clinmap_type, psb_spk_, psb_ipk_, psb_long_int_k_, psb_desc_type ! ! ! Type: mld_Tonelev_type. diff --git a/mlprec/mld_c_prec_type.f90 b/mlprec/mld_c_prec_type.f90 index 7878eced..20faddbb 100644 --- a/mlprec/mld_c_prec_type.f90 +++ b/mlprec/mld_c_prec_type.f90 @@ -80,7 +80,7 @@ module mld_c_prec_type ! type, extends(psb_cprec_type) :: mld_cprec_type - integer(psb_mpik_) :: ictxt + integer(psb_ipk_) :: ictxt integer(psb_ipk_) :: coarse_aggr_size real(psb_spk_) :: op_complexity=szero type(mld_c_onelev_type), allocatable :: precv(:) @@ -218,7 +218,7 @@ contains class(mld_cprec_type), intent(inout) :: prec real(psb_spk_) :: num,den - integer(psb_mpik_) :: ictxt + integer(psb_ipk_) :: ictxt integer(psb_ipk_) :: il num = -done @@ -271,7 +271,7 @@ contains ! Local variables integer(psb_ipk_) :: ilev, nlev - integer(psb_mpik_) :: ictxt, me, np + integer(psb_ipk_) :: ictxt, me, np character(len=20), parameter :: name='mld_file_prec_descr' integer(psb_ipk_) :: iout_ @@ -560,7 +560,7 @@ contains character(len=*), intent(in), optional :: prefix, head logical, optional, intent(in) :: smoother, solver,ac, rp integer(psb_ipk_) :: i, j, il1, iln, lname, lev - integer(psb_mpik_) :: icontxt,iam, np + integer(psb_ipk_) :: icontxt,iam, np character(len=80) :: prefix_ character(len=120) :: fname ! len should be at least 20 more than ! len of prefix_ diff --git a/mlprec/mld_d_as_smoother.f90 b/mlprec/mld_d_as_smoother.f90 index 74ddee2f..50ed56b2 100644 --- a/mlprec/mld_d_as_smoother.f90 +++ b/mlprec/mld_d_as_smoother.f90 @@ -190,10 +190,10 @@ module mld_d_as_smoother subroutine mld_d_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver) import :: psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & & psb_dpk_, mld_d_as_smoother_type, psb_long_int_k_, psb_desc_type, & - & psb_ipk_, psb_mpik_ + & psb_ipk_ implicit none class(mld_d_as_smoother_type), intent(in) :: sm - integer(psb_mpik_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(out) :: info character(len=*), intent(in), optional :: prefix, head diff --git a/mlprec/mld_d_base_smoother_mod.f90 b/mlprec/mld_d_base_smoother_mod.f90 index 1c65572e..94b410b2 100644 --- a/mlprec/mld_d_base_smoother_mod.f90 +++ b/mlprec/mld_d_base_smoother_mod.f90 @@ -243,9 +243,9 @@ module mld_d_base_smoother_mod subroutine mld_d_base_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver) import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & - & mld_d_base_smoother_type, psb_ipk_, psb_mpik_ + & mld_d_base_smoother_type, psb_ipk_ class(mld_d_base_smoother_type), intent(in) :: sm - integer(psb_mpik_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(out) :: info character(len=*), intent(in), optional :: prefix, head diff --git a/mlprec/mld_d_base_solver_mod.f90 b/mlprec/mld_d_base_solver_mod.f90 index 62a79fef..3a946c0d 100644 --- a/mlprec/mld_d_base_solver_mod.f90 +++ b/mlprec/mld_d_base_solver_mod.f90 @@ -249,10 +249,10 @@ module mld_d_base_solver_mod subroutine mld_d_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver) import :: psb_desc_type, psb_dspmat_type, psb_d_base_sparse_mat, & & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, & - & mld_d_base_solver_type, psb_ipk_, psb_mpik_ + & mld_d_base_solver_type, psb_ipk_ implicit none class(mld_d_base_solver_type), intent(in) :: sv - integer(psb_mpik_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(out) :: info character(len=*), intent(in), optional :: prefix, head diff --git a/mlprec/mld_d_ilu_solver.f90 b/mlprec/mld_d_ilu_solver.f90 index 55a35ca9..c706d350 100644 --- a/mlprec/mld_d_ilu_solver.f90 +++ b/mlprec/mld_d_ilu_solver.f90 @@ -139,10 +139,10 @@ module mld_d_ilu_solver subroutine mld_d_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver) import :: psb_desc_type, mld_d_ilu_solver_type, psb_d_vect_type, psb_dpk_, & & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, & - & psb_ipk_, psb_mpik_ + & psb_ipk_ implicit none class(mld_d_ilu_solver_type), intent(in) :: sv - integer(psb_mpik_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(out) :: info character(len=*), intent(in), optional :: prefix, head diff --git a/mlprec/mld_d_onelev_mod.f90 b/mlprec/mld_d_onelev_mod.f90 index 19ff8f56..a5b020e5 100644 --- a/mlprec/mld_d_onelev_mod.f90 +++ b/mlprec/mld_d_onelev_mod.f90 @@ -57,7 +57,7 @@ module mld_d_onelev_mod use mld_base_prec_type use mld_d_base_smoother_mod use psb_base_mod, only : psb_dspmat_type, psb_d_vect_type, psb_d_base_vect_type, & - & psb_dlinmap_type, psb_dpk_, psb_mpik_, psb_ipk_, psb_long_int_k_, psb_desc_type + & psb_dlinmap_type, psb_dpk_, psb_ipk_, psb_long_int_k_, psb_desc_type ! ! ! Type: mld_Tonelev_type. diff --git a/mlprec/mld_d_prec_type.f90 b/mlprec/mld_d_prec_type.f90 index c7f7916e..d27edcb0 100644 --- a/mlprec/mld_d_prec_type.f90 +++ b/mlprec/mld_d_prec_type.f90 @@ -80,7 +80,7 @@ module mld_d_prec_type ! type, extends(psb_dprec_type) :: mld_dprec_type - integer(psb_mpik_) :: ictxt + integer(psb_ipk_) :: ictxt integer(psb_ipk_) :: coarse_aggr_size real(psb_dpk_) :: op_complexity=dzero type(mld_d_onelev_type), allocatable :: precv(:) @@ -218,7 +218,7 @@ contains class(mld_dprec_type), intent(inout) :: prec real(psb_dpk_) :: num,den - integer(psb_mpik_) :: ictxt + integer(psb_ipk_) :: ictxt integer(psb_ipk_) :: il num = -done @@ -271,7 +271,7 @@ contains ! Local variables integer(psb_ipk_) :: ilev, nlev - integer(psb_mpik_) :: ictxt, me, np + integer(psb_ipk_) :: ictxt, me, np character(len=20), parameter :: name='mld_file_prec_descr' integer(psb_ipk_) :: iout_ @@ -560,7 +560,7 @@ contains character(len=*), intent(in), optional :: prefix, head logical, optional, intent(in) :: smoother, solver,ac, rp integer(psb_ipk_) :: i, j, il1, iln, lname, lev - integer(psb_mpik_) :: icontxt,iam, np + integer(psb_ipk_) :: icontxt,iam, np character(len=80) :: prefix_ character(len=120) :: fname ! len should be at least 20 more than ! len of prefix_ diff --git a/mlprec/mld_s_as_smoother.f90 b/mlprec/mld_s_as_smoother.f90 index f96e620f..cf1064e5 100644 --- a/mlprec/mld_s_as_smoother.f90 +++ b/mlprec/mld_s_as_smoother.f90 @@ -190,10 +190,10 @@ module mld_s_as_smoother subroutine mld_s_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver) import :: psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & & psb_spk_, mld_s_as_smoother_type, psb_long_int_k_, psb_desc_type, & - & psb_ipk_, psb_mpik_ + & psb_ipk_ implicit none class(mld_s_as_smoother_type), intent(in) :: sm - integer(psb_mpik_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(out) :: info character(len=*), intent(in), optional :: prefix, head diff --git a/mlprec/mld_s_base_smoother_mod.f90 b/mlprec/mld_s_base_smoother_mod.f90 index 79e0c49b..87268898 100644 --- a/mlprec/mld_s_base_smoother_mod.f90 +++ b/mlprec/mld_s_base_smoother_mod.f90 @@ -243,9 +243,9 @@ module mld_s_base_smoother_mod subroutine mld_s_base_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver) import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, & - & mld_s_base_smoother_type, psb_ipk_, psb_mpik_ + & mld_s_base_smoother_type, psb_ipk_ class(mld_s_base_smoother_type), intent(in) :: sm - integer(psb_mpik_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(out) :: info character(len=*), intent(in), optional :: prefix, head diff --git a/mlprec/mld_s_base_solver_mod.f90 b/mlprec/mld_s_base_solver_mod.f90 index 12c95a13..3b606fe3 100644 --- a/mlprec/mld_s_base_solver_mod.f90 +++ b/mlprec/mld_s_base_solver_mod.f90 @@ -249,10 +249,10 @@ module mld_s_base_solver_mod subroutine mld_s_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver) import :: psb_desc_type, psb_sspmat_type, psb_s_base_sparse_mat, & & psb_s_vect_type, psb_s_base_vect_type, psb_spk_, & - & mld_s_base_solver_type, psb_ipk_, psb_mpik_ + & mld_s_base_solver_type, psb_ipk_ implicit none class(mld_s_base_solver_type), intent(in) :: sv - integer(psb_mpik_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(out) :: info character(len=*), intent(in), optional :: prefix, head diff --git a/mlprec/mld_s_ilu_solver.f90 b/mlprec/mld_s_ilu_solver.f90 index eed44776..d70415d2 100644 --- a/mlprec/mld_s_ilu_solver.f90 +++ b/mlprec/mld_s_ilu_solver.f90 @@ -139,10 +139,10 @@ module mld_s_ilu_solver subroutine mld_s_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver) import :: psb_desc_type, mld_s_ilu_solver_type, psb_s_vect_type, psb_spk_, & & psb_sspmat_type, psb_s_base_sparse_mat, psb_s_base_vect_type, & - & psb_ipk_, psb_mpik_ + & psb_ipk_ implicit none class(mld_s_ilu_solver_type), intent(in) :: sv - integer(psb_mpik_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(out) :: info character(len=*), intent(in), optional :: prefix, head diff --git a/mlprec/mld_s_onelev_mod.f90 b/mlprec/mld_s_onelev_mod.f90 index 997f3aab..2c46dd96 100644 --- a/mlprec/mld_s_onelev_mod.f90 +++ b/mlprec/mld_s_onelev_mod.f90 @@ -57,7 +57,7 @@ module mld_s_onelev_mod use mld_base_prec_type use mld_s_base_smoother_mod use psb_base_mod, only : psb_sspmat_type, psb_s_vect_type, psb_s_base_vect_type, & - & psb_slinmap_type, psb_spk_, psb_mpik_, psb_ipk_, psb_long_int_k_, psb_desc_type + & psb_slinmap_type, psb_spk_, psb_ipk_, psb_long_int_k_, psb_desc_type ! ! ! Type: mld_Tonelev_type. diff --git a/mlprec/mld_s_prec_type.f90 b/mlprec/mld_s_prec_type.f90 index 0c9f4382..7f80dd7d 100644 --- a/mlprec/mld_s_prec_type.f90 +++ b/mlprec/mld_s_prec_type.f90 @@ -80,7 +80,7 @@ module mld_s_prec_type ! type, extends(psb_sprec_type) :: mld_sprec_type - integer(psb_mpik_) :: ictxt + integer(psb_ipk_) :: ictxt integer(psb_ipk_) :: coarse_aggr_size real(psb_spk_) :: op_complexity=szero type(mld_s_onelev_type), allocatable :: precv(:) @@ -218,7 +218,7 @@ contains class(mld_sprec_type), intent(inout) :: prec real(psb_spk_) :: num,den - integer(psb_mpik_) :: ictxt + integer(psb_ipk_) :: ictxt integer(psb_ipk_) :: il num = -done @@ -271,7 +271,7 @@ contains ! Local variables integer(psb_ipk_) :: ilev, nlev - integer(psb_mpik_) :: ictxt, me, np + integer(psb_ipk_) :: ictxt, me, np character(len=20), parameter :: name='mld_file_prec_descr' integer(psb_ipk_) :: iout_ @@ -560,7 +560,7 @@ contains character(len=*), intent(in), optional :: prefix, head logical, optional, intent(in) :: smoother, solver,ac, rp integer(psb_ipk_) :: i, j, il1, iln, lname, lev - integer(psb_mpik_) :: icontxt,iam, np + integer(psb_ipk_) :: icontxt,iam, np character(len=80) :: prefix_ character(len=120) :: fname ! len should be at least 20 more than ! len of prefix_ diff --git a/mlprec/mld_z_as_smoother.f90 b/mlprec/mld_z_as_smoother.f90 index f0e38134..2e638ce3 100644 --- a/mlprec/mld_z_as_smoother.f90 +++ b/mlprec/mld_z_as_smoother.f90 @@ -190,10 +190,10 @@ module mld_z_as_smoother subroutine mld_z_as_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver) import :: psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & & psb_dpk_, mld_z_as_smoother_type, psb_long_int_k_, psb_desc_type, & - & psb_ipk_, psb_mpik_ + & psb_ipk_ implicit none class(mld_z_as_smoother_type), intent(in) :: sm - integer(psb_mpik_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(out) :: info character(len=*), intent(in), optional :: prefix, head diff --git a/mlprec/mld_z_base_smoother_mod.f90 b/mlprec/mld_z_base_smoother_mod.f90 index 561b47d1..7730f8a3 100644 --- a/mlprec/mld_z_base_smoother_mod.f90 +++ b/mlprec/mld_z_base_smoother_mod.f90 @@ -243,9 +243,9 @@ module mld_z_base_smoother_mod subroutine mld_z_base_smoother_dmp(sm,ictxt,level,info,prefix,head,smoother,solver) import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, & - & mld_z_base_smoother_type, psb_ipk_, psb_mpik_ + & mld_z_base_smoother_type, psb_ipk_ class(mld_z_base_smoother_type), intent(in) :: sm - integer(psb_mpik_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(out) :: info character(len=*), intent(in), optional :: prefix, head diff --git a/mlprec/mld_z_base_solver_mod.f90 b/mlprec/mld_z_base_solver_mod.f90 index 1a6708de..27c7e4ce 100644 --- a/mlprec/mld_z_base_solver_mod.f90 +++ b/mlprec/mld_z_base_solver_mod.f90 @@ -249,10 +249,10 @@ module mld_z_base_solver_mod subroutine mld_z_base_solver_dmp(sv,ictxt,level,info,prefix,head,solver) import :: psb_desc_type, psb_zspmat_type, psb_z_base_sparse_mat, & & psb_z_vect_type, psb_z_base_vect_type, psb_dpk_, & - & mld_z_base_solver_type, psb_ipk_, psb_mpik_ + & mld_z_base_solver_type, psb_ipk_ implicit none class(mld_z_base_solver_type), intent(in) :: sv - integer(psb_mpik_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(out) :: info character(len=*), intent(in), optional :: prefix, head diff --git a/mlprec/mld_z_ilu_solver.f90 b/mlprec/mld_z_ilu_solver.f90 index 493a49a3..8a1e449d 100644 --- a/mlprec/mld_z_ilu_solver.f90 +++ b/mlprec/mld_z_ilu_solver.f90 @@ -139,10 +139,10 @@ module mld_z_ilu_solver subroutine mld_z_ilu_solver_dmp(sv,ictxt,level,info,prefix,head,solver) import :: psb_desc_type, mld_z_ilu_solver_type, psb_z_vect_type, psb_dpk_, & & psb_zspmat_type, psb_z_base_sparse_mat, psb_z_base_vect_type, & - & psb_ipk_, psb_mpik_ + & psb_ipk_ implicit none class(mld_z_ilu_solver_type), intent(in) :: sv - integer(psb_mpik_), intent(in) :: ictxt + integer(psb_ipk_), intent(in) :: ictxt integer(psb_ipk_), intent(in) :: level integer(psb_ipk_), intent(out) :: info character(len=*), intent(in), optional :: prefix, head diff --git a/mlprec/mld_z_onelev_mod.f90 b/mlprec/mld_z_onelev_mod.f90 index 4817f5a0..4dc1f1f8 100644 --- a/mlprec/mld_z_onelev_mod.f90 +++ b/mlprec/mld_z_onelev_mod.f90 @@ -57,7 +57,7 @@ module mld_z_onelev_mod use mld_base_prec_type use mld_z_base_smoother_mod use psb_base_mod, only : psb_zspmat_type, psb_z_vect_type, psb_z_base_vect_type, & - & psb_zlinmap_type, psb_dpk_, psb_mpik_, psb_ipk_, psb_long_int_k_, psb_desc_type + & psb_zlinmap_type, psb_dpk_, psb_ipk_, psb_long_int_k_, psb_desc_type ! ! ! Type: mld_Tonelev_type. diff --git a/mlprec/mld_z_prec_type.f90 b/mlprec/mld_z_prec_type.f90 index 1c3d4aba..92e25377 100644 --- a/mlprec/mld_z_prec_type.f90 +++ b/mlprec/mld_z_prec_type.f90 @@ -80,7 +80,7 @@ module mld_z_prec_type ! type, extends(psb_zprec_type) :: mld_zprec_type - integer(psb_mpik_) :: ictxt + integer(psb_ipk_) :: ictxt integer(psb_ipk_) :: coarse_aggr_size real(psb_dpk_) :: op_complexity=dzero type(mld_z_onelev_type), allocatable :: precv(:) @@ -218,7 +218,7 @@ contains class(mld_zprec_type), intent(inout) :: prec real(psb_dpk_) :: num,den - integer(psb_mpik_) :: ictxt + integer(psb_ipk_) :: ictxt integer(psb_ipk_) :: il num = -done @@ -271,7 +271,7 @@ contains ! Local variables integer(psb_ipk_) :: ilev, nlev - integer(psb_mpik_) :: ictxt, me, np + integer(psb_ipk_) :: ictxt, me, np character(len=20), parameter :: name='mld_file_prec_descr' integer(psb_ipk_) :: iout_ @@ -560,7 +560,7 @@ contains character(len=*), intent(in), optional :: prefix, head logical, optional, intent(in) :: smoother, solver,ac, rp integer(psb_ipk_) :: i, j, il1, iln, lname, lev - integer(psb_mpik_) :: icontxt,iam, np + integer(psb_ipk_) :: icontxt,iam, np character(len=80) :: prefix_ character(len=120) :: fname ! len should be at least 20 more than ! len of prefix_