From 22b37fa6d31654f2ca501b3647ee16e8376b9956 Mon Sep 17 00:00:00 2001 From: sfilippone Date: Wed, 16 Apr 2025 15:02:52 +0200 Subject: [PATCH 1/4] Fix REPL with MATCHBOXP --- .../amg_d_parmatch_aggregator_mat_asb.F90 | 13 ++++++------- .../amg_s_parmatch_aggregator_mat_asb.F90 | 13 ++++++------- 2 files changed, 12 insertions(+), 14 deletions(-) diff --git a/amgprec/impl/aggregator/amg_d_parmatch_aggregator_mat_asb.F90 b/amgprec/impl/aggregator/amg_d_parmatch_aggregator_mat_asb.F90 index 6a5698a6..67f9814f 100644 --- a/amgprec/impl/aggregator/amg_d_parmatch_aggregator_mat_asb.F90 +++ b/amgprec/impl/aggregator/amg_d_parmatch_aggregator_mat_asb.F90 @@ -108,7 +108,7 @@ subroutine amg_d_parmatch_aggregator_mat_asb(ag,parms,a,desc_a,& type(psb_desc_type), intent(inout) :: desc_ac integer(psb_ipk_), intent(out) :: info ! - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me type(psb_ld_coo_sparse_mat) :: tmpcoo type(psb_ldspmat_type) :: tmp_ac @@ -124,8 +124,8 @@ subroutine amg_d_parmatch_aggregator_mat_asb(ag,parms,a,desc_a,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() info = psb_success_ - ictxt = desc_a%get_context() - call psb_info(ictxt,me,np) + ctxt = desc_a%get_context() + call psb_info(ctxt,me,np) if (psb_get_errstatus().ne.0) then write(0,*) me,' From:',trim(name),':',psb_get_errstatus() return @@ -163,22 +163,21 @@ subroutine amg_d_parmatch_aggregator_mat_asb(ag,parms,a,desc_a,& call op_prol%mv_to(tmpcoo) nzl = tmpcoo%get_nzeros() call psb_loc_to_glob(tmpcoo%ja(1:nzl),desc_ac,info,'I') + call tmpcoo%set_ncols(i_nr) call op_prol%mv_from(tmpcoo) call op_restr%mv_to(tmpcoo) nzl = tmpcoo%get_nzeros() call psb_loc_to_glob(tmpcoo%ia(1:nzl),desc_ac,info,'I') + call tmpcoo%set_nrows(i_nr) call op_restr%mv_from(tmpcoo) - call op_prol%set_ncols(i_nr) - call op_restr%set_nrows(i_nr) - call psb_gather(tmp_ac,ac,desc_ac,info,root=-ione,& & dupl=psb_dupl_add_,keeploc=.false.) call tmp_ac%mv_to(tmpcoo) call ac%mv_from(tmpcoo) - call psb_cdall(ictxt,desc_ac,info,mg=ntaggr,repl=.true.) + call psb_cdall(ctxt,desc_ac,info,mg=ntaggr,repl=.true.) if (info == psb_success_) call psb_cdasb(desc_ac,info) ! ! Now that we have the descriptors and the restrictor, we should diff --git a/amgprec/impl/aggregator/amg_s_parmatch_aggregator_mat_asb.F90 b/amgprec/impl/aggregator/amg_s_parmatch_aggregator_mat_asb.F90 index edd187ad..bfde163c 100644 --- a/amgprec/impl/aggregator/amg_s_parmatch_aggregator_mat_asb.F90 +++ b/amgprec/impl/aggregator/amg_s_parmatch_aggregator_mat_asb.F90 @@ -108,7 +108,7 @@ subroutine amg_s_parmatch_aggregator_mat_asb(ag,parms,a,desc_a,& type(psb_desc_type), intent(inout) :: desc_ac integer(psb_ipk_), intent(out) :: info ! - type(psb_ctxt_type) :: ictxt + type(psb_ctxt_type) :: ctxt integer(psb_ipk_) :: np, me type(psb_ls_coo_sparse_mat) :: tmpcoo type(psb_lsspmat_type) :: tmp_ac @@ -124,8 +124,8 @@ subroutine amg_s_parmatch_aggregator_mat_asb(ag,parms,a,desc_a,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() info = psb_success_ - ictxt = desc_a%get_context() - call psb_info(ictxt,me,np) + ctxt = desc_a%get_context() + call psb_info(ctxt,me,np) if (psb_get_errstatus().ne.0) then write(0,*) me,' From:',trim(name),':',psb_get_errstatus() return @@ -163,22 +163,21 @@ subroutine amg_s_parmatch_aggregator_mat_asb(ag,parms,a,desc_a,& call op_prol%mv_to(tmpcoo) nzl = tmpcoo%get_nzeros() call psb_loc_to_glob(tmpcoo%ja(1:nzl),desc_ac,info,'I') + call tmpcoo%set_ncols(i_nr) call op_prol%mv_from(tmpcoo) call op_restr%mv_to(tmpcoo) nzl = tmpcoo%get_nzeros() call psb_loc_to_glob(tmpcoo%ia(1:nzl),desc_ac,info,'I') + call tmpcoo%set_nrows(i_nr) call op_restr%mv_from(tmpcoo) - call op_prol%set_ncols(i_nr) - call op_restr%set_nrows(i_nr) - call psb_gather(tmp_ac,ac,desc_ac,info,root=-ione,& & dupl=psb_dupl_add_,keeploc=.false.) call tmp_ac%mv_to(tmpcoo) call ac%mv_from(tmpcoo) - call psb_cdall(ictxt,desc_ac,info,mg=ntaggr,repl=.true.) + call psb_cdall(ctxt,desc_ac,info,mg=ntaggr,repl=.true.) if (info == psb_success_) call psb_cdasb(desc_ac,info) ! ! Now that we have the descriptors and the restrictor, we should From 2f4c9dd579e6d579fd6498907ff23c3a711b8839 Mon Sep 17 00:00:00 2001 From: sfilippone Date: Mon, 26 May 2025 12:00:49 +0200 Subject: [PATCH 2/4] Improve diagnostic printout in samples --- samples/advanced/pdegen/amg_d_pde2d.F90 | 10 +++++----- samples/advanced/pdegen/amg_d_pde3d.F90 | 10 +++++----- samples/advanced/pdegen/amg_s_pde2d.F90 | 10 +++++----- samples/advanced/pdegen/amg_s_pde3d.F90 | 10 +++++----- 4 files changed, 20 insertions(+), 20 deletions(-) diff --git a/samples/advanced/pdegen/amg_d_pde2d.F90 b/samples/advanced/pdegen/amg_d_pde2d.F90 index 1eeeabab..23f9f117 100644 --- a/samples/advanced/pdegen/amg_d_pde2d.F90 +++ b/samples/advanced/pdegen/amg_d_pde2d.F90 @@ -568,11 +568,11 @@ program amg_d_pde2d write(psb_out_unit,'("Total time : ",es12.5)') tslv+tprec+thier write(psb_out_unit,'("Residual 2-norm : ",es12.5)') resmx write(psb_out_unit,'("Residual inf-norm : ",es12.5)') resmxp - write(psb_out_unit,'("Total memory occupation for X : ",i12)') vecsize - write(psb_out_unit,'("Total memory occupation for A : ",i12)') amatsize - write(psb_out_unit,'("Total memory occupation for DESC_A : ",i12)') descsize - write(psb_out_unit,'("Total memory occupation for PREC : ",i12)') precsize - write(psb_out_unit,'("Total memory occupation : ",i12)') & + write(psb_out_unit,'("Total memory occupation for X : ",i16)') vecsize + write(psb_out_unit,'("Total memory occupation for A : ",i16)') amatsize + write(psb_out_unit,'("Total memory occupation for DESC_A : ",i16)') descsize + write(psb_out_unit,'("Total memory occupation for PREC : ",i16)') precsize + write(psb_out_unit,'("Total memory occupation : ",i16)') & & amatsize + descsize+precsize+2*vecsize write(psb_out_unit,'("Storage format for A : ",a )') a%get_fmt() write(psb_out_unit,'("Storage format for DESC_A : ",a )') desc_a%get_fmt() diff --git a/samples/advanced/pdegen/amg_d_pde3d.F90 b/samples/advanced/pdegen/amg_d_pde3d.F90 index 3cbb8fa8..fe51c67e 100644 --- a/samples/advanced/pdegen/amg_d_pde3d.F90 +++ b/samples/advanced/pdegen/amg_d_pde3d.F90 @@ -572,11 +572,11 @@ program amg_d_pde3d write(psb_out_unit,'("Total time : ",es12.5)') tslv+tprec+thier write(psb_out_unit,'("Residual 2-norm : ",es12.5)') resmx write(psb_out_unit,'("Residual inf-norm : ",es12.5)') resmxp - write(psb_out_unit,'("Total memory occupation for X : ",i12)') vecsize - write(psb_out_unit,'("Total memory occupation for A : ",i12)') amatsize - write(psb_out_unit,'("Total memory occupation for DESC_A : ",i12)') descsize - write(psb_out_unit,'("Total memory occupation for PREC : ",i12)') precsize - write(psb_out_unit,'("Total memory occupation : ",i12)') & + write(psb_out_unit,'("Total memory occupation for X : ",i16)') vecsize + write(psb_out_unit,'("Total memory occupation for A : ",i16)') amatsize + write(psb_out_unit,'("Total memory occupation for DESC_A : ",i16)') descsize + write(psb_out_unit,'("Total memory occupation for PREC : ",i16)') precsize + write(psb_out_unit,'("Total memory occupation : ",i16)') & & amatsize + descsize+precsize+2*vecsize write(psb_out_unit,'("Storage format for A : ",a )') a%get_fmt() write(psb_out_unit,'("Storage format for DESC_A : ",a )') desc_a%get_fmt() diff --git a/samples/advanced/pdegen/amg_s_pde2d.F90 b/samples/advanced/pdegen/amg_s_pde2d.F90 index 8c3173c1..9b325d79 100644 --- a/samples/advanced/pdegen/amg_s_pde2d.F90 +++ b/samples/advanced/pdegen/amg_s_pde2d.F90 @@ -568,11 +568,11 @@ program amg_s_pde2d write(psb_out_unit,'("Total time : ",es12.5)') tslv+tprec+thier write(psb_out_unit,'("Residual 2-norm : ",es12.5)') resmx write(psb_out_unit,'("Residual inf-norm : ",es12.5)') resmxp - write(psb_out_unit,'("Total memory occupation for X : ",i12)') vecsize - write(psb_out_unit,'("Total memory occupation for A : ",i12)') amatsize - write(psb_out_unit,'("Total memory occupation for DESC_A : ",i12)') descsize - write(psb_out_unit,'("Total memory occupation for PREC : ",i12)') precsize - write(psb_out_unit,'("Total memory occupation : ",i12)') & + write(psb_out_unit,'("Total memory occupation for X : ",i16)') vecsize + write(psb_out_unit,'("Total memory occupation for A : ",i16)') amatsize + write(psb_out_unit,'("Total memory occupation for DESC_A : ",i16)') descsize + write(psb_out_unit,'("Total memory occupation for PREC : ",i16)') precsize + write(psb_out_unit,'("Total memory occupation : ",i16)') & & amatsize + descsize+precsize+2*vecsize write(psb_out_unit,'("Storage format for A : ",a )') a%get_fmt() write(psb_out_unit,'("Storage format for DESC_A : ",a )') desc_a%get_fmt() diff --git a/samples/advanced/pdegen/amg_s_pde3d.F90 b/samples/advanced/pdegen/amg_s_pde3d.F90 index e06a8fc5..d7621d1e 100644 --- a/samples/advanced/pdegen/amg_s_pde3d.F90 +++ b/samples/advanced/pdegen/amg_s_pde3d.F90 @@ -572,11 +572,11 @@ program amg_s_pde3d write(psb_out_unit,'("Total time : ",es12.5)') tslv+tprec+thier write(psb_out_unit,'("Residual 2-norm : ",es12.5)') resmx write(psb_out_unit,'("Residual inf-norm : ",es12.5)') resmxp - write(psb_out_unit,'("Total memory occupation for X : ",i12)') vecsize - write(psb_out_unit,'("Total memory occupation for A : ",i12)') amatsize - write(psb_out_unit,'("Total memory occupation for DESC_A : ",i12)') descsize - write(psb_out_unit,'("Total memory occupation for PREC : ",i12)') precsize - write(psb_out_unit,'("Total memory occupation : ",i12)') & + write(psb_out_unit,'("Total memory occupation for X : ",i16)') vecsize + write(psb_out_unit,'("Total memory occupation for A : ",i16)') amatsize + write(psb_out_unit,'("Total memory occupation for DESC_A : ",i16)') descsize + write(psb_out_unit,'("Total memory occupation for PREC : ",i16)') precsize + write(psb_out_unit,'("Total memory occupation : ",i16)') & & amatsize + descsize+precsize+2*vecsize write(psb_out_unit,'("Storage format for A : ",a )') a%get_fmt() write(psb_out_unit,'("Storage format for DESC_A : ",a )') desc_a%get_fmt() From b2462235976ad4b09f908ea6f49d07411e161326 Mon Sep 17 00:00:00 2001 From: sfilippone Date: Sun, 1 Jun 2025 20:57:09 +0200 Subject: [PATCH 3/4] Fixes for IPK8 --- amgprec/amg_base_prec_type.F90 | 12 ++++-- amgprec/amg_d_matchboxp_mod.F90 | 5 ++- amgprec/amg_s_matchboxp_mod.F90 | 5 ++- .../impl/level/amg_c_base_onelev_map_prol.F90 | 4 +- .../impl/level/amg_c_base_onelev_map_rstr.F90 | 4 +- .../impl/level/amg_d_base_onelev_map_prol.F90 | 4 +- .../impl/level/amg_d_base_onelev_map_rstr.F90 | 4 +- .../impl/level/amg_s_base_onelev_map_prol.F90 | 4 +- .../impl/level/amg_s_base_onelev_map_rstr.F90 | 4 +- .../impl/level/amg_z_base_onelev_map_prol.F90 | 4 +- .../impl/level/amg_z_base_onelev_map_rstr.F90 | 4 +- .../amg_c_jac_smoother_apply_vect.f90 | 4 +- .../amg_d_jac_smoother_apply_vect.f90 | 4 +- .../amg_s_jac_smoother_apply_vect.f90 | 4 +- .../amg_z_jac_smoother_apply_vect.f90 | 4 +- amgprec/impl/solver/amg_c_krm_solver_impl.f90 | 11 ++++-- amgprec/impl/solver/amg_d_krm_solver_impl.f90 | 11 ++++-- amgprec/impl/solver/amg_s_krm_solver_impl.f90 | 11 ++++-- amgprec/impl/solver/amg_z_krm_solver_impl.f90 | 11 ++++-- cbind/amgprec/amg_c_dprec.c | 2 +- cbind/amgprec/amg_c_zprec.c | 2 +- cbind/amgprec/amg_dprec_cbind_mod.F90 | 18 ++++----- cbind/amgprec/amg_zprec_cbind_mod.F90 | 18 ++++----- samples/advanced/fileread/amg_cf_sample.f90 | 6 +-- samples/advanced/fileread/amg_df_sample.f90 | 6 +-- samples/advanced/fileread/amg_sf_sample.f90 | 6 +-- samples/advanced/fileread/amg_zf_sample.f90 | 6 +-- samples/advanced/pdegen/amg_d_genpde_mod.F90 | 28 ++++++------- samples/advanced/pdegen/amg_s_genpde_mod.F90 | 28 ++++++------- samples/newslv/amg_d_tlu_solver_impl.f90 | 7 ++-- samples/newslv/amg_pde3d_newslv.f90 | 30 +++++++------- samples/simple/fileread/amg_cexample_1lev.f90 | 33 ++++++++-------- samples/simple/fileread/amg_cexample_ml.f90 | 39 ++++++++++--------- samples/simple/fileread/amg_dexample_1lev.f90 | 33 ++++++++-------- samples/simple/fileread/amg_dexample_ml.f90 | 39 ++++++++++--------- samples/simple/fileread/amg_sexample_1lev.f90 | 33 ++++++++-------- samples/simple/fileread/amg_sexample_ml.f90 | 39 ++++++++++--------- samples/simple/fileread/amg_zexample_1lev.f90 | 33 ++++++++-------- samples/simple/fileread/amg_zexample_ml.f90 | 39 ++++++++++--------- samples/simple/fileread/data_input.f90 | 17 ++++---- samples/simple/pdegen/amg_dexample_1lev.f90 | 19 ++++----- samples/simple/pdegen/amg_dexample_ml.f90 | 33 ++++++++-------- samples/simple/pdegen/amg_dpde_mod.f90 | 16 ++++---- samples/simple/pdegen/amg_sexample_1lev.f90 | 19 ++++----- samples/simple/pdegen/amg_sexample_ml.f90 | 33 ++++++++-------- samples/simple/pdegen/amg_spde_mod.f90 | 16 ++++---- samples/simple/pdegen/data_input.f90 | 14 +++---- 47 files changed, 377 insertions(+), 349 deletions(-) diff --git a/amgprec/amg_base_prec_type.F90 b/amgprec/amg_base_prec_type.F90 index 58c919bf..47b41e35 100644 --- a/amgprec/amg_base_prec_type.F90 +++ b/amgprec/amg_base_prec_type.F90 @@ -621,9 +621,13 @@ contains subroutine amg_warn_coarse_mat(val,expected) integer(psb_ipk_) :: val, expected + integer(psb_mpk_) :: mval, mexp if (val /= expected) then + mval = val + mexp = expected write(0,*) 'Warning: resetting COARSE_MAT on an existing hierarchy from ',& - & amg_get_coarse_mat_name(val), ' to ',amg_get_coarse_mat_name(expected) + & amg_get_coarse_mat_name(mval), & + & ' to ',amg_get_coarse_mat_name(mexp) end if end subroutine amg_warn_coarse_mat @@ -1207,7 +1211,7 @@ contains implicit none type(psb_ctxt_type), intent(in) :: ctxt type(amg_ml_parms), intent(inout) :: dat - integer(psb_ipk_), intent(in), optional :: root + integer(psb_mpk_), intent(in), optional :: root call psb_bcast(ctxt,dat%sweeps_pre,root) call psb_bcast(ctxt,dat%sweeps_post,root) @@ -1229,7 +1233,7 @@ contains implicit none type(psb_ctxt_type), intent(in) :: ctxt type(amg_sml_parms), intent(inout) :: dat - integer(psb_ipk_), intent(in), optional :: root + integer(psb_mpk_), intent(in), optional :: root call psb_bcast(ctxt,dat%amg_ml_parms,root) call psb_bcast(ctxt,dat%aggr_omega_val,root) @@ -1240,7 +1244,7 @@ contains implicit none type(psb_ctxt_type), intent(in) :: ctxt type(amg_dml_parms), intent(inout) :: dat - integer(psb_ipk_), intent(in), optional :: root + integer(psb_mpk_), intent(in), optional :: root call psb_bcast(ctxt,dat%amg_ml_parms,root) call psb_bcast(ctxt,dat%aggr_omega_val,root) diff --git a/amgprec/amg_d_matchboxp_mod.F90 b/amgprec/amg_d_matchboxp_mod.F90 index ea94fab3..b97b478c 100644 --- a/amgprec/amg_d_matchboxp_mod.F90 +++ b/amgprec/amg_d_matchboxp_mod.F90 @@ -879,7 +879,7 @@ contains nr = tcoo1%get_nrows() nc = tcoo1%get_ncols() nz = tcoo1%get_nzeros() - call tcoo2%allocate(nr,nc,int(1.25*nz)) + call tcoo2%allocate(nr,nc,int(1.25*nz,psb_ipk_)) k2 = 0 ! ! Build the entries of \^A for matching @@ -1056,7 +1056,8 @@ contains integer(psb_c_lpk_) :: ph1_card(*),ph2_card(*) real(c_double) :: edgelocweight(:) real(c_double) :: msgpercent(*) - integer(psb_ipk_) :: info, me, np + integer(psb_ipk_) :: info + integer(psb_mpk_) :: me, np integer(psb_c_mpk_) :: icomm, mrank, mnp logical, optional :: display_inp ! diff --git a/amgprec/amg_s_matchboxp_mod.F90 b/amgprec/amg_s_matchboxp_mod.F90 index 9a3f3356..2d6fa95e 100644 --- a/amgprec/amg_s_matchboxp_mod.F90 +++ b/amgprec/amg_s_matchboxp_mod.F90 @@ -879,7 +879,7 @@ contains nr = tcoo1%get_nrows() nc = tcoo1%get_ncols() nz = tcoo1%get_nzeros() - call tcoo2%allocate(nr,nc,int(1.25*nz)) + call tcoo2%allocate(nr,nc,int(1.25*nz,psb_ipk_)) k2 = 0 ! ! Build the entries of \^A for matching @@ -1056,7 +1056,8 @@ contains integer(psb_c_lpk_) :: ph1_card(*),ph2_card(*) real(c_float) :: edgelocweight(:) real(c_double) :: msgpercent(*) - integer(psb_ipk_) :: info, me, np + integer(psb_ipk_) :: info + integer(psb_mpk_) :: me, np integer(psb_c_mpk_) :: icomm, mrank, mnp logical, optional :: display_inp ! diff --git a/amgprec/impl/level/amg_c_base_onelev_map_prol.F90 b/amgprec/impl/level/amg_c_base_onelev_map_prol.F90 index 775ac381..e38bb78f 100644 --- a/amgprec/impl/level/amg_c_base_onelev_map_prol.F90 +++ b/amgprec/impl/level/amg_c_base_onelev_map_prol.F90 @@ -55,8 +55,8 @@ subroutine amg_c_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vt !!$ write(0,*) 'Remap handling ' block type(psb_ctxt_type) :: ctxt, nctxt - integer(psb_ipk_) :: i,j,ip,idest, nsrc, nrl, nrc, kp - integer(psb_ipk_) :: me, np, rme, rnp + integer(psb_mpk_) :: i,j,ip,idest, nsrc, nrl, nrc, kp + integer(psb_mpk_) :: me, np, rme, rnp complex(psb_spk_), allocatable :: rsnd(:), rrcv(:) type(psb_c_vect_type) :: tv diff --git a/amgprec/impl/level/amg_c_base_onelev_map_rstr.F90 b/amgprec/impl/level/amg_c_base_onelev_map_rstr.F90 index 253efe47..b725a1f1 100644 --- a/amgprec/impl/level/amg_c_base_onelev_map_rstr.F90 +++ b/amgprec/impl/level/amg_c_base_onelev_map_rstr.F90 @@ -56,8 +56,8 @@ subroutine amg_c_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,& !!$ write(0,*) 'Remap handling not implemented yet ' block type(psb_ctxt_type) :: ctxt, nctxt - integer(psb_ipk_) :: i,j,ip, idest, nsrc, nrl, kp - integer(psb_ipk_) :: me, np, rme, rnp + integer(psb_mpk_) :: i,j,ip, idest, nsrc, nrl, kp + integer(psb_mpk_) :: me, np, rme, rnp complex(psb_spk_), allocatable :: rsnd(:), rrcv(:) type(psb_c_vect_type) :: tv diff --git a/amgprec/impl/level/amg_d_base_onelev_map_prol.F90 b/amgprec/impl/level/amg_d_base_onelev_map_prol.F90 index c4e8ea7f..1c2c9faf 100644 --- a/amgprec/impl/level/amg_d_base_onelev_map_prol.F90 +++ b/amgprec/impl/level/amg_d_base_onelev_map_prol.F90 @@ -55,8 +55,8 @@ subroutine amg_d_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vt !!$ write(0,*) 'Remap handling ' block type(psb_ctxt_type) :: ctxt, nctxt - integer(psb_ipk_) :: i,j,ip,idest, nsrc, nrl, nrc, kp - integer(psb_ipk_) :: me, np, rme, rnp + integer(psb_mpk_) :: i,j,ip,idest, nsrc, nrl, nrc, kp + integer(psb_mpk_) :: me, np, rme, rnp real(psb_dpk_), allocatable :: rsnd(:), rrcv(:) type(psb_d_vect_type) :: tv diff --git a/amgprec/impl/level/amg_d_base_onelev_map_rstr.F90 b/amgprec/impl/level/amg_d_base_onelev_map_rstr.F90 index 4502ee0c..f0799f48 100644 --- a/amgprec/impl/level/amg_d_base_onelev_map_rstr.F90 +++ b/amgprec/impl/level/amg_d_base_onelev_map_rstr.F90 @@ -56,8 +56,8 @@ subroutine amg_d_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,& !!$ write(0,*) 'Remap handling not implemented yet ' block type(psb_ctxt_type) :: ctxt, nctxt - integer(psb_ipk_) :: i,j,ip, idest, nsrc, nrl, kp - integer(psb_ipk_) :: me, np, rme, rnp + integer(psb_mpk_) :: i,j,ip, idest, nsrc, nrl, kp + integer(psb_mpk_) :: me, np, rme, rnp real(psb_dpk_), allocatable :: rsnd(:), rrcv(:) type(psb_d_vect_type) :: tv diff --git a/amgprec/impl/level/amg_s_base_onelev_map_prol.F90 b/amgprec/impl/level/amg_s_base_onelev_map_prol.F90 index 739ed250..a0a699fd 100644 --- a/amgprec/impl/level/amg_s_base_onelev_map_prol.F90 +++ b/amgprec/impl/level/amg_s_base_onelev_map_prol.F90 @@ -55,8 +55,8 @@ subroutine amg_s_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vt !!$ write(0,*) 'Remap handling ' block type(psb_ctxt_type) :: ctxt, nctxt - integer(psb_ipk_) :: i,j,ip,idest, nsrc, nrl, nrc, kp - integer(psb_ipk_) :: me, np, rme, rnp + integer(psb_mpk_) :: i,j,ip,idest, nsrc, nrl, nrc, kp + integer(psb_mpk_) :: me, np, rme, rnp real(psb_spk_), allocatable :: rsnd(:), rrcv(:) type(psb_s_vect_type) :: tv diff --git a/amgprec/impl/level/amg_s_base_onelev_map_rstr.F90 b/amgprec/impl/level/amg_s_base_onelev_map_rstr.F90 index de1bb173..9bc3e455 100644 --- a/amgprec/impl/level/amg_s_base_onelev_map_rstr.F90 +++ b/amgprec/impl/level/amg_s_base_onelev_map_rstr.F90 @@ -56,8 +56,8 @@ subroutine amg_s_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,& !!$ write(0,*) 'Remap handling not implemented yet ' block type(psb_ctxt_type) :: ctxt, nctxt - integer(psb_ipk_) :: i,j,ip, idest, nsrc, nrl, kp - integer(psb_ipk_) :: me, np, rme, rnp + integer(psb_mpk_) :: i,j,ip, idest, nsrc, nrl, kp + integer(psb_mpk_) :: me, np, rme, rnp real(psb_spk_), allocatable :: rsnd(:), rrcv(:) type(psb_s_vect_type) :: tv diff --git a/amgprec/impl/level/amg_z_base_onelev_map_prol.F90 b/amgprec/impl/level/amg_z_base_onelev_map_prol.F90 index decc0b0e..83711f54 100644 --- a/amgprec/impl/level/amg_z_base_onelev_map_prol.F90 +++ b/amgprec/impl/level/amg_z_base_onelev_map_prol.F90 @@ -55,8 +55,8 @@ subroutine amg_z_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vt !!$ write(0,*) 'Remap handling ' block type(psb_ctxt_type) :: ctxt, nctxt - integer(psb_ipk_) :: i,j,ip,idest, nsrc, nrl, nrc, kp - integer(psb_ipk_) :: me, np, rme, rnp + integer(psb_mpk_) :: i,j,ip,idest, nsrc, nrl, nrc, kp + integer(psb_mpk_) :: me, np, rme, rnp complex(psb_dpk_), allocatable :: rsnd(:), rrcv(:) type(psb_z_vect_type) :: tv diff --git a/amgprec/impl/level/amg_z_base_onelev_map_rstr.F90 b/amgprec/impl/level/amg_z_base_onelev_map_rstr.F90 index 09667435..c86caafb 100644 --- a/amgprec/impl/level/amg_z_base_onelev_map_rstr.F90 +++ b/amgprec/impl/level/amg_z_base_onelev_map_rstr.F90 @@ -56,8 +56,8 @@ subroutine amg_z_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,& !!$ write(0,*) 'Remap handling not implemented yet ' block type(psb_ctxt_type) :: ctxt, nctxt - integer(psb_ipk_) :: i,j,ip, idest, nsrc, nrl, kp - integer(psb_ipk_) :: me, np, rme, rnp + integer(psb_mpk_) :: i,j,ip, idest, nsrc, nrl, kp + integer(psb_mpk_) :: me, np, rme, rnp complex(psb_dpk_), allocatable :: rsnd(:), rrcv(:) type(psb_z_vect_type) :: tv diff --git a/amgprec/impl/smoother/amg_c_jac_smoother_apply_vect.f90 b/amgprec/impl/smoother/amg_c_jac_smoother_apply_vect.f90 index 6d32e2e2..4a6572b8 100644 --- a/amgprec/impl/smoother/amg_c_jac_smoother_apply_vect.f90 +++ b/amgprec/impl/smoother/amg_c_jac_smoother_apply_vect.f90 @@ -183,7 +183,7 @@ subroutine amg_c_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& end if if ( res < sm%tol*resdenum ) then if( (sm%printres).and.(mod(sm%printiter,sm%checkiter)/=0) ) & - & call log_conv("BJAC",me,i,1,res,resdenum,sm%tol) + & call log_conv("BJAC",me,i,ione,res,resdenum,sm%tol) exit end if end if @@ -275,7 +275,7 @@ subroutine amg_c_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& end if if (res < sm%tol*resdenum ) then if( (sm%printres).and.( mod(sm%printiter,sm%checkiter) /=0 ) ) & - & call log_conv("BJAC",me,i,1,res,resdenum,sm%tol) + & call log_conv("BJAC",me,i,ione,res,resdenum,sm%tol) exit end if end if diff --git a/amgprec/impl/smoother/amg_d_jac_smoother_apply_vect.f90 b/amgprec/impl/smoother/amg_d_jac_smoother_apply_vect.f90 index b1148119..fa0bf272 100644 --- a/amgprec/impl/smoother/amg_d_jac_smoother_apply_vect.f90 +++ b/amgprec/impl/smoother/amg_d_jac_smoother_apply_vect.f90 @@ -183,7 +183,7 @@ subroutine amg_d_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& end if if ( res < sm%tol*resdenum ) then if( (sm%printres).and.(mod(sm%printiter,sm%checkiter)/=0) ) & - & call log_conv("BJAC",me,i,1,res,resdenum,sm%tol) + & call log_conv("BJAC",me,i,ione,res,resdenum,sm%tol) exit end if end if @@ -275,7 +275,7 @@ subroutine amg_d_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& end if if (res < sm%tol*resdenum ) then if( (sm%printres).and.( mod(sm%printiter,sm%checkiter) /=0 ) ) & - & call log_conv("BJAC",me,i,1,res,resdenum,sm%tol) + & call log_conv("BJAC",me,i,ione,res,resdenum,sm%tol) exit end if end if diff --git a/amgprec/impl/smoother/amg_s_jac_smoother_apply_vect.f90 b/amgprec/impl/smoother/amg_s_jac_smoother_apply_vect.f90 index 1bbb390f..8a68fc23 100644 --- a/amgprec/impl/smoother/amg_s_jac_smoother_apply_vect.f90 +++ b/amgprec/impl/smoother/amg_s_jac_smoother_apply_vect.f90 @@ -183,7 +183,7 @@ subroutine amg_s_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& end if if ( res < sm%tol*resdenum ) then if( (sm%printres).and.(mod(sm%printiter,sm%checkiter)/=0) ) & - & call log_conv("BJAC",me,i,1,res,resdenum,sm%tol) + & call log_conv("BJAC",me,i,ione,res,resdenum,sm%tol) exit end if end if @@ -275,7 +275,7 @@ subroutine amg_s_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& end if if (res < sm%tol*resdenum ) then if( (sm%printres).and.( mod(sm%printiter,sm%checkiter) /=0 ) ) & - & call log_conv("BJAC",me,i,1,res,resdenum,sm%tol) + & call log_conv("BJAC",me,i,ione,res,resdenum,sm%tol) exit end if end if diff --git a/amgprec/impl/smoother/amg_z_jac_smoother_apply_vect.f90 b/amgprec/impl/smoother/amg_z_jac_smoother_apply_vect.f90 index 03bc6095..f73458dd 100644 --- a/amgprec/impl/smoother/amg_z_jac_smoother_apply_vect.f90 +++ b/amgprec/impl/smoother/amg_z_jac_smoother_apply_vect.f90 @@ -183,7 +183,7 @@ subroutine amg_z_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& end if if ( res < sm%tol*resdenum ) then if( (sm%printres).and.(mod(sm%printiter,sm%checkiter)/=0) ) & - & call log_conv("BJAC",me,i,1,res,resdenum,sm%tol) + & call log_conv("BJAC",me,i,ione,res,resdenum,sm%tol) exit end if end if @@ -275,7 +275,7 @@ subroutine amg_z_jac_smoother_apply_vect(alpha,sm,x,beta,y,desc_data,trans,& end if if (res < sm%tol*resdenum ) then if( (sm%printres).and.( mod(sm%printiter,sm%checkiter) /=0 ) ) & - & call log_conv("BJAC",me,i,1,res,resdenum,sm%tol) + & call log_conv("BJAC",me,i,ione,res,resdenum,sm%tol) exit end if end if diff --git a/amgprec/impl/solver/amg_c_krm_solver_impl.f90 b/amgprec/impl/solver/amg_c_krm_solver_impl.f90 index fe3cb53a..6df8190c 100644 --- a/amgprec/impl/solver/amg_c_krm_solver_impl.f90 +++ b/amgprec/impl/solver/amg_c_krm_solver_impl.f90 @@ -96,7 +96,8 @@ subroutine amg_c_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) ! Local variables integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota integer(psb_lpk_) :: lnr - integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level + integer(psb_ipk_) :: i, err_act, debug_unit, debug_level + integer(psb_mpk_) :: np,me type(psb_ctxt_type) :: ctxt, l_ctxt character(len=20) :: name='@Z@_krm_solver_bld', ch_err @@ -123,7 +124,7 @@ subroutine amg_c_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) call sv%prec%smoothers_build(a,desc_a,info,amold=amold,vmold=vmold) sv%a => a else - call psb_init(l_ctxt,np=1_psb_ipk_,basectxt=ctxt,ids=(/me/)) + call psb_init(l_ctxt,np=1_psb_mpk_,basectxt=ctxt,ids=(/me/)) n_row = desc_a%get_local_rows() lnr = n_row call psb_cdall(l_ctxt,sv%desc_local,info,mg=lnr,repl=.true.) @@ -186,7 +187,8 @@ subroutine amg_c_krm_solver_apply_vect(alpha,sv,x,beta,y,desc_data,& type(psb_c_vect_type),intent(inout), optional :: initu type(psb_c_vect_type) :: z - integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level + integer(psb_ipk_) :: i, err_act, debug_unit, debug_level + integer(psb_mpk_) :: np,me type(psb_ctxt_type) :: ctxt character(len=20) :: name='@Z@_krm_solver_apply_v', ch_err @@ -247,7 +249,8 @@ subroutine amg_c_krm_solver_apply(alpha,sv,x,beta,y,desc_data,& character, intent(in), optional :: init complex(psb_spk_),intent(inout), optional :: initu(:) complex(psb_spk_), allocatable :: z(:) - integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level + integer(psb_ipk_) :: i, err_act, debug_unit, debug_level + integer(psb_mpk_) :: np,me type(psb_ctxt_type) :: ctxt character(len=20) :: name='@Z@_krm_solver_apply', ch_err diff --git a/amgprec/impl/solver/amg_d_krm_solver_impl.f90 b/amgprec/impl/solver/amg_d_krm_solver_impl.f90 index b955a8d6..412aa4c8 100644 --- a/amgprec/impl/solver/amg_d_krm_solver_impl.f90 +++ b/amgprec/impl/solver/amg_d_krm_solver_impl.f90 @@ -96,7 +96,8 @@ subroutine amg_d_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) ! Local variables integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota integer(psb_lpk_) :: lnr - integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level + integer(psb_ipk_) :: i, err_act, debug_unit, debug_level + integer(psb_mpk_) :: np,me type(psb_ctxt_type) :: ctxt, l_ctxt character(len=20) :: name='@Z@_krm_solver_bld', ch_err @@ -123,7 +124,7 @@ subroutine amg_d_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) call sv%prec%smoothers_build(a,desc_a,info,amold=amold,vmold=vmold) sv%a => a else - call psb_init(l_ctxt,np=1_psb_ipk_,basectxt=ctxt,ids=(/me/)) + call psb_init(l_ctxt,np=1_psb_mpk_,basectxt=ctxt,ids=(/me/)) n_row = desc_a%get_local_rows() lnr = n_row call psb_cdall(l_ctxt,sv%desc_local,info,mg=lnr,repl=.true.) @@ -186,7 +187,8 @@ subroutine amg_d_krm_solver_apply_vect(alpha,sv,x,beta,y,desc_data,& type(psb_d_vect_type),intent(inout), optional :: initu type(psb_d_vect_type) :: z - integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level + integer(psb_ipk_) :: i, err_act, debug_unit, debug_level + integer(psb_mpk_) :: np,me type(psb_ctxt_type) :: ctxt character(len=20) :: name='@Z@_krm_solver_apply_v', ch_err @@ -247,7 +249,8 @@ subroutine amg_d_krm_solver_apply(alpha,sv,x,beta,y,desc_data,& character, intent(in), optional :: init real(psb_dpk_),intent(inout), optional :: initu(:) real(psb_dpk_), allocatable :: z(:) - integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level + integer(psb_ipk_) :: i, err_act, debug_unit, debug_level + integer(psb_mpk_) :: np,me type(psb_ctxt_type) :: ctxt character(len=20) :: name='@Z@_krm_solver_apply', ch_err diff --git a/amgprec/impl/solver/amg_s_krm_solver_impl.f90 b/amgprec/impl/solver/amg_s_krm_solver_impl.f90 index b2d3d0e5..df4c1648 100644 --- a/amgprec/impl/solver/amg_s_krm_solver_impl.f90 +++ b/amgprec/impl/solver/amg_s_krm_solver_impl.f90 @@ -96,7 +96,8 @@ subroutine amg_s_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) ! Local variables integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota integer(psb_lpk_) :: lnr - integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level + integer(psb_ipk_) :: i, err_act, debug_unit, debug_level + integer(psb_mpk_) :: np,me type(psb_ctxt_type) :: ctxt, l_ctxt character(len=20) :: name='@Z@_krm_solver_bld', ch_err @@ -123,7 +124,7 @@ subroutine amg_s_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) call sv%prec%smoothers_build(a,desc_a,info,amold=amold,vmold=vmold) sv%a => a else - call psb_init(l_ctxt,np=1_psb_ipk_,basectxt=ctxt,ids=(/me/)) + call psb_init(l_ctxt,np=1_psb_mpk_,basectxt=ctxt,ids=(/me/)) n_row = desc_a%get_local_rows() lnr = n_row call psb_cdall(l_ctxt,sv%desc_local,info,mg=lnr,repl=.true.) @@ -186,7 +187,8 @@ subroutine amg_s_krm_solver_apply_vect(alpha,sv,x,beta,y,desc_data,& type(psb_s_vect_type),intent(inout), optional :: initu type(psb_s_vect_type) :: z - integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level + integer(psb_ipk_) :: i, err_act, debug_unit, debug_level + integer(psb_mpk_) :: np,me type(psb_ctxt_type) :: ctxt character(len=20) :: name='@Z@_krm_solver_apply_v', ch_err @@ -247,7 +249,8 @@ subroutine amg_s_krm_solver_apply(alpha,sv,x,beta,y,desc_data,& character, intent(in), optional :: init real(psb_spk_),intent(inout), optional :: initu(:) real(psb_spk_), allocatable :: z(:) - integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level + integer(psb_ipk_) :: i, err_act, debug_unit, debug_level + integer(psb_mpk_) :: np,me type(psb_ctxt_type) :: ctxt character(len=20) :: name='@Z@_krm_solver_apply', ch_err diff --git a/amgprec/impl/solver/amg_z_krm_solver_impl.f90 b/amgprec/impl/solver/amg_z_krm_solver_impl.f90 index ca5d7125..55d55ba1 100644 --- a/amgprec/impl/solver/amg_z_krm_solver_impl.f90 +++ b/amgprec/impl/solver/amg_z_krm_solver_impl.f90 @@ -96,7 +96,8 @@ subroutine amg_z_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) ! Local variables integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota integer(psb_lpk_) :: lnr - integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level + integer(psb_ipk_) :: i, err_act, debug_unit, debug_level + integer(psb_mpk_) :: np,me type(psb_ctxt_type) :: ctxt, l_ctxt character(len=20) :: name='@Z@_krm_solver_bld', ch_err @@ -123,7 +124,7 @@ subroutine amg_z_krm_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) call sv%prec%smoothers_build(a,desc_a,info,amold=amold,vmold=vmold) sv%a => a else - call psb_init(l_ctxt,np=1_psb_ipk_,basectxt=ctxt,ids=(/me/)) + call psb_init(l_ctxt,np=1_psb_mpk_,basectxt=ctxt,ids=(/me/)) n_row = desc_a%get_local_rows() lnr = n_row call psb_cdall(l_ctxt,sv%desc_local,info,mg=lnr,repl=.true.) @@ -186,7 +187,8 @@ subroutine amg_z_krm_solver_apply_vect(alpha,sv,x,beta,y,desc_data,& type(psb_z_vect_type),intent(inout), optional :: initu type(psb_z_vect_type) :: z - integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level + integer(psb_ipk_) :: i, err_act, debug_unit, debug_level + integer(psb_mpk_) :: np,me type(psb_ctxt_type) :: ctxt character(len=20) :: name='@Z@_krm_solver_apply_v', ch_err @@ -247,7 +249,8 @@ subroutine amg_z_krm_solver_apply(alpha,sv,x,beta,y,desc_data,& character, intent(in), optional :: init complex(psb_dpk_),intent(inout), optional :: initu(:) complex(psb_dpk_), allocatable :: z(:) - integer(psb_ipk_) :: np,me,i, err_act, debug_unit, debug_level + integer(psb_ipk_) :: i, err_act, debug_unit, debug_level + integer(psb_mpk_) :: np,me type(psb_ctxt_type) :: ctxt character(len=20) :: name='@Z@_krm_solver_apply', ch_err diff --git a/cbind/amgprec/amg_c_dprec.c b/cbind/amgprec/amg_c_dprec.c index 0b07ee68..296d667b 100644 --- a/cbind/amgprec/amg_c_dprec.c +++ b/cbind/amgprec/amg_c_dprec.c @@ -11,7 +11,7 @@ amg_c_dprec* amg_c_dprec_new() } -int amg_c_dprec_delete(amg_c_dprec* p) +psb_i_t amg_c_dprec_delete(amg_c_dprec* p) { int iret; iret=amg_c_dprecfree(p); diff --git a/cbind/amgprec/amg_c_zprec.c b/cbind/amgprec/amg_c_zprec.c index 101a158f..2bdf2c68 100644 --- a/cbind/amgprec/amg_c_zprec.c +++ b/cbind/amgprec/amg_c_zprec.c @@ -11,7 +11,7 @@ amg_c_dprec* amg_c_new_dprec() } -int amg_c_delete_dprec(amg_c_dprec* p) +psb_i_t amg_c_delete_dprec(amg_c_dprec* p) { int iret; iret=amg_c_dprecfree(p); diff --git a/cbind/amgprec/amg_dprec_cbind_mod.F90 b/cbind/amgprec/amg_dprec_cbind_mod.F90 index f6db13c9..1c2ca8bd 100644 --- a/cbind/amgprec/amg_dprec_cbind_mod.F90 +++ b/cbind/amgprec/amg_dprec_cbind_mod.F90 @@ -31,7 +31,7 @@ contains type(amg_c_dprec) :: ph type(psb_c_object_type), value :: cctxt character(c_char) :: ptype(*) - integer :: info + integer(psb_ipk_) :: info type(amg_dprec_type), pointer :: precp character(len=80) :: fptype @@ -64,7 +64,7 @@ contains type(psb_c_object_type) :: ph character(c_char) :: what(*) integer(psb_c_ipk_), value :: val - integer :: info + integer(psb_ipk_) :: info character(len=80) :: fwhat type(amg_dprec_type), pointer :: precp @@ -94,7 +94,7 @@ contains type(psb_c_object_type) :: ph character(c_char) :: what(*) real(c_double), value :: val - integer :: info + integer(psb_ipk_) :: info character(len=80) :: fwhat type(amg_dprec_type), pointer :: precp @@ -122,7 +122,7 @@ contains integer(psb_c_ipk_) :: res type(psb_c_object_type) :: ph character(c_char) :: what(*), val(*) - integer :: info + integer(psb_ipk_) :: info character(len=80) :: fwhat,fval type(amg_dprec_type), pointer :: precp @@ -150,7 +150,7 @@ contains integer(psb_c_ipk_) :: res type(psb_c_object_type) :: ph,ah,cdh - integer :: info + integer(psb_ipk_) :: info type(amg_dprec_type), pointer :: precp type(psb_dspmat_type), pointer :: ap type(psb_desc_type), pointer :: descp @@ -189,7 +189,7 @@ contains integer(psb_c_ipk_) :: res type(psb_c_object_type) :: ph,ah,cdh - integer :: info + integer(psb_ipk_) :: info type(amg_dprec_type), pointer :: precp type(psb_dspmat_type), pointer :: ap type(psb_desc_type), pointer :: descp @@ -228,7 +228,7 @@ contains integer(psb_c_ipk_) :: res type(psb_c_object_type) :: ph,ah,cdh - integer :: info + integer(psb_ipk_) :: info type(amg_dprec_type), pointer :: precp type(psb_dspmat_type), pointer :: ap type(psb_desc_type), pointer :: descp @@ -302,7 +302,7 @@ contains type(amg_dprec_type), pointer :: precp type(psb_d_vect_type), pointer :: xp, bp - integer :: info,fitmax,fitrace,first,fistop,fiter + integer(psb_ipk_) :: info,fitmax,fitrace,first,fistop,fiter character(len=20) :: fmethd real(kind(1.d0)) :: feps,ferr @@ -358,7 +358,7 @@ contains integer(psb_c_ipk_) :: res type(psb_c_object_type) :: ph - integer :: info + integer(psb_ipk_) :: info type(amg_dprec_type), pointer :: precp character(len=80) :: fptype diff --git a/cbind/amgprec/amg_zprec_cbind_mod.F90 b/cbind/amgprec/amg_zprec_cbind_mod.F90 index 8ae1c964..a58dd4d1 100644 --- a/cbind/amgprec/amg_zprec_cbind_mod.F90 +++ b/cbind/amgprec/amg_zprec_cbind_mod.F90 @@ -31,7 +31,7 @@ contains type(amg_c_zprec) :: ph type(psb_c_object_type), value :: cctxt character(c_char) :: ptype(*) - integer :: info + integer(psb_ipk_) :: info type(amg_zprec_type), pointer :: precp character(len=80) :: fptype @@ -64,7 +64,7 @@ contains type(psb_c_object_type) :: ph character(c_char) :: what(*) integer(psb_c_ipk_), value :: val - integer :: info + integer(psb_ipk_) :: info character(len=80) :: fwhat type(amg_zprec_type), pointer :: precp @@ -94,7 +94,7 @@ contains type(psb_c_object_type) :: ph character(c_char) :: what(*) real(c_double), value :: val - integer :: info + integer(psb_ipk_) :: info character(len=80) :: fwhat type(amg_zprec_type), pointer :: precp @@ -122,7 +122,7 @@ contains integer(psb_c_ipk_) :: res type(psb_c_object_type) :: ph character(c_char) :: what(*), val(*) - integer :: info + integer(psb_ipk_) :: info character(len=80) :: fwhat,fval type(amg_zprec_type), pointer :: precp @@ -150,7 +150,7 @@ contains integer(psb_c_ipk_) :: res type(psb_c_object_type) :: ph,ah,cdh - integer :: info + integer(psb_ipk_) :: info type(amg_zprec_type), pointer :: precp type(psb_zspmat_type), pointer :: ap type(psb_desc_type), pointer :: descp @@ -189,7 +189,7 @@ contains integer(psb_c_ipk_) :: res type(psb_c_object_type) :: ph,ah,cdh - integer :: info + integer(psb_ipk_) :: info type(amg_zprec_type), pointer :: precp type(psb_zspmat_type), pointer :: ap type(psb_desc_type), pointer :: descp @@ -228,7 +228,7 @@ contains integer(psb_c_ipk_) :: res type(psb_c_object_type) :: ph,ah,cdh - integer :: info + integer(psb_ipk_) :: info type(amg_zprec_type), pointer :: precp type(psb_zspmat_type), pointer :: ap type(psb_desc_type), pointer :: descp @@ -302,7 +302,7 @@ contains type(amg_zprec_type), pointer :: precp type(psb_z_vect_type), pointer :: xp, bp - integer :: info,fitmax,fitrace,first,fistop,fiter + integer(psb_ipk_) :: info,fitmax,fitrace,first,fistop,fiter character(len=20) :: fmethd real(kind(1.d0)) :: feps,ferr @@ -358,7 +358,7 @@ contains integer(psb_c_ipk_) :: res type(psb_c_object_type) :: ph - integer :: info + integer(psb_ipk_) :: info type(amg_zprec_type), pointer :: precp character(len=80) :: fptype diff --git a/samples/advanced/fileread/amg_cf_sample.f90 b/samples/advanced/fileread/amg_cf_sample.f90 index 60b84fcd..26544d6e 100644 --- a/samples/advanced/fileread/amg_cf_sample.f90 +++ b/samples/advanced/fileread/amg_cf_sample.f90 @@ -342,7 +342,7 @@ program amg_cf_sample call build_mtpart(aux_a,lnp) endif - call distr_mtpart(psb_root_,ctxt) + call distr_mtpart(ione*psb_root_,ctxt) call getv_mtpart(ivg) call psb_matdist(aux_a, a, ctxt,desc_a,info,fmt=afmt,vg=ivg) case default @@ -589,9 +589,9 @@ program amg_cf_sample end if - call psb_gather(x_col_glob,x_col,desc_a,info,root=psb_root_) + call psb_gather(x_col_glob,x_col,desc_a,info,root=ione*psb_root_) if (info == psb_success_) & - & call psb_gather(r_col_glob,r_col,desc_a,info,root=psb_root_) + & call psb_gather(r_col_glob,r_col,desc_a,info,root=ione*psb_root_) if (info /= psb_success_) goto 9999 if (iam == psb_root_) then write(psb_err_unit,'(" ")') diff --git a/samples/advanced/fileread/amg_df_sample.f90 b/samples/advanced/fileread/amg_df_sample.f90 index a4160955..ad3b72ba 100644 --- a/samples/advanced/fileread/amg_df_sample.f90 +++ b/samples/advanced/fileread/amg_df_sample.f90 @@ -342,7 +342,7 @@ program amg_df_sample call build_mtpart(aux_a,lnp) endif - call distr_mtpart(psb_root_,ctxt) + call distr_mtpart(ione*psb_root_,ctxt) call getv_mtpart(ivg) call psb_matdist(aux_a, a, ctxt,desc_a,info,fmt=afmt,vg=ivg) case default @@ -589,9 +589,9 @@ program amg_df_sample end if - call psb_gather(x_col_glob,x_col,desc_a,info,root=psb_root_) + call psb_gather(x_col_glob,x_col,desc_a,info,root=ione*psb_root_) if (info == psb_success_) & - & call psb_gather(r_col_glob,r_col,desc_a,info,root=psb_root_) + & call psb_gather(r_col_glob,r_col,desc_a,info,root=ione*psb_root_) if (info /= psb_success_) goto 9999 if (iam == psb_root_) then write(psb_err_unit,'(" ")') diff --git a/samples/advanced/fileread/amg_sf_sample.f90 b/samples/advanced/fileread/amg_sf_sample.f90 index f371215a..d9a6378c 100644 --- a/samples/advanced/fileread/amg_sf_sample.f90 +++ b/samples/advanced/fileread/amg_sf_sample.f90 @@ -342,7 +342,7 @@ program amg_sf_sample call build_mtpart(aux_a,lnp) endif - call distr_mtpart(psb_root_,ctxt) + call distr_mtpart(ione*psb_root_,ctxt) call getv_mtpart(ivg) call psb_matdist(aux_a, a, ctxt,desc_a,info,fmt=afmt,vg=ivg) case default @@ -589,9 +589,9 @@ program amg_sf_sample end if - call psb_gather(x_col_glob,x_col,desc_a,info,root=psb_root_) + call psb_gather(x_col_glob,x_col,desc_a,info,root=ione*psb_root_) if (info == psb_success_) & - & call psb_gather(r_col_glob,r_col,desc_a,info,root=psb_root_) + & call psb_gather(r_col_glob,r_col,desc_a,info,root=ione*psb_root_) if (info /= psb_success_) goto 9999 if (iam == psb_root_) then write(psb_err_unit,'(" ")') diff --git a/samples/advanced/fileread/amg_zf_sample.f90 b/samples/advanced/fileread/amg_zf_sample.f90 index 5dd96f83..7575cb39 100644 --- a/samples/advanced/fileread/amg_zf_sample.f90 +++ b/samples/advanced/fileread/amg_zf_sample.f90 @@ -342,7 +342,7 @@ program amg_zf_sample call build_mtpart(aux_a,lnp) endif - call distr_mtpart(psb_root_,ctxt) + call distr_mtpart(ione*psb_root_,ctxt) call getv_mtpart(ivg) call psb_matdist(aux_a, a, ctxt,desc_a,info,fmt=afmt,vg=ivg) case default @@ -589,9 +589,9 @@ program amg_zf_sample end if - call psb_gather(x_col_glob,x_col,desc_a,info,root=psb_root_) + call psb_gather(x_col_glob,x_col,desc_a,info,root=ione*psb_root_) if (info == psb_success_) & - & call psb_gather(r_col_glob,r_col,desc_a,info,root=psb_root_) + & call psb_gather(r_col_glob,r_col,desc_a,info,root=ione*psb_root_) if (info /= psb_success_) goto 9999 if (iam == psb_root_) then write(psb_err_unit,'(" ")') diff --git a/samples/advanced/pdegen/amg_d_genpde_mod.F90 b/samples/advanced/pdegen/amg_d_genpde_mod.F90 index 535c281a..d5c176d3 100644 --- a/samples/advanced/pdegen/amg_d_genpde_mod.F90 +++ b/samples/advanced/pdegen/amg_d_genpde_mod.F90 @@ -275,7 +275,7 @@ contains allocate(bndx(0:npx),bndy(0:npy),bndz(0:npz)) ! We can reuse idx2ijk for process indices as well. - call idx2ijk(iamx,iamy,iamz,iam,npx,npy,npz,base=0) + call idx2ijk(iamx,iamy,iamz,iam,npx,npy,npz,base=mzero) ! Now let's split the 3D cube in hexahedra call dist1Didx(bndx,idim,npx) mynx = bndx(iamx+1)-bndx(iamx) @@ -319,7 +319,7 @@ contains ! ! Use adjcncy methods ! - integer(psb_mpk_), allocatable :: neighbours(:) + integer(psb_ipk_), allocatable :: neighbours(:) integer(psb_mpk_) :: cnt logical, parameter :: debug_adj=.true. if (debug_adj.and.(np > 1)) then @@ -327,27 +327,27 @@ contains allocate(neighbours(np)) if (iamx < npx-1) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx+1,iamy,iamz,npx,npy,npz,base=0) + call ijk2idx(neighbours(cnt),iamx+1,iamy,iamz,npx,npy,npz,base=mzero) end if if (iamy < npy-1) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx,iamy+1,iamz,npx,npy,npz,base=0) + call ijk2idx(neighbours(cnt),iamx,iamy+1,iamz,npx,npy,npz,base=mzero) end if if (iamz < npz-1) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx,iamy,iamz+1,npx,npy,npz,base=0) + call ijk2idx(neighbours(cnt),iamx,iamy,iamz+1,npx,npy,npz,base=mzero) end if if (iamx >0) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx-1,iamy,iamz,npx,npy,npz,base=0) + call ijk2idx(neighbours(cnt),iamx-1,iamy,iamz,npx,npy,npz,base=mzero) end if if (iamy >0) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx,iamy-1,iamz,npx,npy,npz,base=0) + call ijk2idx(neighbours(cnt),iamx,iamy-1,iamz,npx,npy,npz,base=mzero) end if if (iamz >0) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx,iamy,iamz-1,npx,npy,npz,base=0) + call ijk2idx(neighbours(cnt),iamx,iamy,iamz-1,npx,npy,npz,base=mzero) end if call psb_realloc(cnt, neighbours,info) call desc_a%set_p_adjcncy(neighbours) @@ -741,7 +741,7 @@ contains allocate(bndx(0:npx),bndy(0:npy)) ! We can reuse idx2ijk for process indices as well. - call idx2ijk(iamx,iamy,iam,npx,npy,base=0) + call idx2ijk(iamx,iamy,iam,npx,npy,base=mzero) ! Now let's split the 2D square in rectangles call dist1Didx(bndx,idim,npx) mynx = bndx(iamx+1)-bndx(iamx) @@ -781,7 +781,7 @@ contains ! ! Use adjcncy methods ! - integer(psb_mpk_), allocatable :: neighbours(:) + integer(psb_ipk_), allocatable :: neighbours(:) integer(psb_mpk_) :: cnt logical, parameter :: debug_adj=.true. if (debug_adj.and.(np > 1)) then @@ -789,19 +789,19 @@ contains allocate(neighbours(np)) if (iamx < npx-1) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx+1,iamy,npx,npy,base=0) + call ijk2idx(neighbours(cnt),iamx+1,iamy,npx,npy,base=mzero) end if if (iamy < npy-1) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx,iamy+1,npx,npy,base=0) + call ijk2idx(neighbours(cnt),iamx,iamy+1,npx,npy,base=mzero) end if if (iamx >0) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx-1,iamy,npx,npy,base=0) + call ijk2idx(neighbours(cnt),iamx-1,iamy,npx,npy,base=mzero) end if if (iamy >0) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx,iamy-1,npx,npy,base=0) + call ijk2idx(neighbours(cnt),iamx,iamy-1,npx,npy,base=mzero) end if call psb_realloc(cnt, neighbours,info) call desc_a%set_p_adjcncy(neighbours) diff --git a/samples/advanced/pdegen/amg_s_genpde_mod.F90 b/samples/advanced/pdegen/amg_s_genpde_mod.F90 index ac7c3ab7..7062be41 100644 --- a/samples/advanced/pdegen/amg_s_genpde_mod.F90 +++ b/samples/advanced/pdegen/amg_s_genpde_mod.F90 @@ -275,7 +275,7 @@ contains allocate(bndx(0:npx),bndy(0:npy),bndz(0:npz)) ! We can reuse idx2ijk for process indices as well. - call idx2ijk(iamx,iamy,iamz,iam,npx,npy,npz,base=0) + call idx2ijk(iamx,iamy,iamz,iam,npx,npy,npz,base=mzero) ! Now let's split the 3D cube in hexahedra call dist1Didx(bndx,idim,npx) mynx = bndx(iamx+1)-bndx(iamx) @@ -319,7 +319,7 @@ contains ! ! Use adjcncy methods ! - integer(psb_mpk_), allocatable :: neighbours(:) + integer(psb_ipk_), allocatable :: neighbours(:) integer(psb_mpk_) :: cnt logical, parameter :: debug_adj=.true. if (debug_adj.and.(np > 1)) then @@ -327,27 +327,27 @@ contains allocate(neighbours(np)) if (iamx < npx-1) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx+1,iamy,iamz,npx,npy,npz,base=0) + call ijk2idx(neighbours(cnt),iamx+1,iamy,iamz,npx,npy,npz,base=mzero) end if if (iamy < npy-1) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx,iamy+1,iamz,npx,npy,npz,base=0) + call ijk2idx(neighbours(cnt),iamx,iamy+1,iamz,npx,npy,npz,base=mzero) end if if (iamz < npz-1) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx,iamy,iamz+1,npx,npy,npz,base=0) + call ijk2idx(neighbours(cnt),iamx,iamy,iamz+1,npx,npy,npz,base=mzero) end if if (iamx >0) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx-1,iamy,iamz,npx,npy,npz,base=0) + call ijk2idx(neighbours(cnt),iamx-1,iamy,iamz,npx,npy,npz,base=mzero) end if if (iamy >0) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx,iamy-1,iamz,npx,npy,npz,base=0) + call ijk2idx(neighbours(cnt),iamx,iamy-1,iamz,npx,npy,npz,base=mzero) end if if (iamz >0) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx,iamy,iamz-1,npx,npy,npz,base=0) + call ijk2idx(neighbours(cnt),iamx,iamy,iamz-1,npx,npy,npz,base=mzero) end if call psb_realloc(cnt, neighbours,info) call desc_a%set_p_adjcncy(neighbours) @@ -741,7 +741,7 @@ contains allocate(bndx(0:npx),bndy(0:npy)) ! We can reuse idx2ijk for process indices as well. - call idx2ijk(iamx,iamy,iam,npx,npy,base=0) + call idx2ijk(iamx,iamy,iam,npx,npy,base=mzero) ! Now let's split the 2D square in rectangles call dist1Didx(bndx,idim,npx) mynx = bndx(iamx+1)-bndx(iamx) @@ -781,7 +781,7 @@ contains ! ! Use adjcncy methods ! - integer(psb_mpk_), allocatable :: neighbours(:) + integer(psb_ipk_), allocatable :: neighbours(:) integer(psb_mpk_) :: cnt logical, parameter :: debug_adj=.true. if (debug_adj.and.(np > 1)) then @@ -789,19 +789,19 @@ contains allocate(neighbours(np)) if (iamx < npx-1) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx+1,iamy,npx,npy,base=0) + call ijk2idx(neighbours(cnt),iamx+1,iamy,npx,npy,base=mzero) end if if (iamy < npy-1) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx,iamy+1,npx,npy,base=0) + call ijk2idx(neighbours(cnt),iamx,iamy+1,npx,npy,base=mzero) end if if (iamx >0) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx-1,iamy,npx,npy,base=0) + call ijk2idx(neighbours(cnt),iamx-1,iamy,npx,npy,base=mzero) end if if (iamy >0) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx,iamy-1,npx,npy,base=0) + call ijk2idx(neighbours(cnt),iamx,iamy-1,npx,npy,base=mzero) end if call psb_realloc(cnt, neighbours,info) call desc_a%set_p_adjcncy(neighbours) diff --git a/samples/newslv/amg_d_tlu_solver_impl.f90 b/samples/newslv/amg_d_tlu_solver_impl.f90 index fe039227..da46c810 100644 --- a/samples/newslv/amg_d_tlu_solver_impl.f90 +++ b/samples/newslv/amg_d_tlu_solver_impl.f90 @@ -55,15 +55,16 @@ subroutine amg_d_tlu_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) type(psb_dspmat_type), intent(in), target :: a Type(psb_desc_type), Intent(inout) :: desc_a class(amg_d_tlu_solver_type), intent(inout) :: sv - integer, intent(out) :: info + integer(psb_ipk_), intent(out) :: info type(psb_dspmat_type), intent(in), target, optional :: b class(psb_d_base_sparse_mat), intent(in), optional :: amold class(psb_d_base_vect_type), intent(in), optional :: vmold class(psb_i_base_vect_type), intent(in), optional :: imold ! Local variables - integer :: n_row,n_col, nrow_a, nztota - integer :: np,me,i, err_act, debug_unit, debug_level + integer(psb_ipk_) :: n_row, n_col, nrow_a, nztota + integer(psb_ipk_) :: np,me + integer(psb_ipk_) :: i, err_act, debug_unit, debug_level type(psb_ctxt_type) :: ctxt character(len=20) :: name='d_tlu_solver_bld', ch_err diff --git a/samples/newslv/amg_pde3d_newslv.f90 b/samples/newslv/amg_pde3d_newslv.f90 index 52902a13..9d2b1f1c 100644 --- a/samples/newslv/amg_pde3d_newslv.f90 +++ b/samples/newslv/amg_pde3d_newslv.f90 @@ -330,7 +330,7 @@ contains allocate(bndx(0:npx),bndy(0:npy),bndz(0:npz)) ! We can reuse idx2ijk for process indices as well. - call idx2ijk(iamx,iamy,iamz,iam,npx,npy,npz,base=0) + call idx2ijk(iamx,iamy,iamz,iam,npx,npy,npz,base=mzero) ! Now let's split the 3D cube in hexahedra call dist1Didx(bndx,idim,npx) mynx = bndx(iamx+1)-bndx(iamx) @@ -373,7 +373,7 @@ contains ! ! Use adjcncy methods ! - integer(psb_mpk_), allocatable :: neighbours(:) + integer(psb_ipk_), allocatable :: neighbours(:) integer(psb_mpk_) :: cnt logical, parameter :: debug_adj=.true. if (debug_adj.and.(np > 1)) then @@ -381,27 +381,27 @@ contains allocate(neighbours(np)) if (iamx < npx-1) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx+1,iamy,iamz,npx,npy,npz,base=0) + call ijk2idx(neighbours(cnt),iamx+1,iamy,iamz,npx,npy,npz,base=mzero) end if if (iamy < npy-1) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx,iamy+1,iamz,npx,npy,npz,base=0) + call ijk2idx(neighbours(cnt),iamx,iamy+1,iamz,npx,npy,npz,base=mzero) end if if (iamz < npz-1) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx,iamy,iamz+1,npx,npy,npz,base=0) + call ijk2idx(neighbours(cnt),iamx,iamy,iamz+1,npx,npy,npz,base=mzero) end if if (iamx >0) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx-1,iamy,iamz,npx,npy,npz,base=0) + call ijk2idx(neighbours(cnt),iamx-1,iamy,iamz,npx,npy,npz,base=mzero) end if if (iamy >0) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx,iamy-1,iamz,npx,npy,npz,base=0) + call ijk2idx(neighbours(cnt),iamx,iamy-1,iamz,npx,npy,npz,base=mzero) end if if (iamz >0) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx,iamy,iamz-1,npx,npy,npz,base=0) + call ijk2idx(neighbours(cnt),iamx,iamy,iamz-1,npx,npy,npz,base=mzero) end if call psb_realloc(cnt, neighbours,info) call desc_a%set_p_adjcncy(neighbours) @@ -780,7 +780,7 @@ contains allocate(bndx(0:npx),bndy(0:npy)) ! We can reuse idx2ijk for process indices as well. - call idx2ijk(iamx,iamy,iam,npx,npy,base=0) + call idx2ijk(iamx,iamy,iam,npx,npy,base=mzero) ! Now let's split the 2D square in rectangles call dist1Didx(bndx,idim,npx) mynx = bndx(iamx+1)-bndx(iamx) @@ -819,7 +819,7 @@ contains ! ! Use adjcncy methods ! - integer(psb_mpk_), allocatable :: neighbours(:) + integer(psb_ipk_), allocatable :: neighbours(:) integer(psb_mpk_) :: cnt logical, parameter :: debug_adj=.true. if (debug_adj.and.(np > 1)) then @@ -827,19 +827,19 @@ contains allocate(neighbours(np)) if (iamx < npx-1) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx+1,iamy,npx,npy,base=0) + call ijk2idx(neighbours(cnt),iamx+1,iamy,npx,npy,base=mzero) end if if (iamy < npy-1) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx,iamy+1,npx,npy,base=0) + call ijk2idx(neighbours(cnt),iamx,iamy+1,npx,npy,base=mzero) end if if (iamx >0) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx-1,iamy,npx,npy,base=0) + call ijk2idx(neighbours(cnt),iamx-1,iamy,npx,npy,base=mzero) end if if (iamy >0) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx,iamy-1,npx,npy,base=0) + call ijk2idx(neighbours(cnt),iamx,iamy-1,npx,npy,base=mzero) end if call psb_realloc(cnt, neighbours,info) call desc_a%set_p_adjcncy(neighbours) @@ -1144,7 +1144,7 @@ program amg_d_pde3d end if thier = psb_wtime()-t1 nlv = prec%get_nlevs() - call prec%set(tlusv, info,ilev=1,ilmax=max(1,nlv-1)) + call prec%set(tlusv, info,ilev=1_psb_ipk_,ilmax=ione*max(1,nlv-1)) call psb_barrier(ctxt) t1 = psb_wtime() diff --git a/samples/simple/fileread/amg_cexample_1lev.f90 b/samples/simple/fileread/amg_cexample_1lev.f90 index 30dcd46c..aa55ba7a 100644 --- a/samples/simple/fileread/amg_cexample_1lev.f90 +++ b/samples/simple/fileread/amg_cexample_1lev.f90 @@ -73,21 +73,21 @@ program amg_cexample_1lev ! solver and preconditioner parameters real(psb_spk_) :: tol, err - integer :: itmax, iter, istop - integer :: nlev + integer(psb_ipk_) :: itmax, iter, istop + integer(psb_ipk_) :: nlev ! parallel environment parameters type(psb_ctxt_type) :: ctxt - integer :: iam, np + integer(psb_ipk_) :: iam, np ! other variables - integer :: i,info,j,m_problem + integer(psb_ipk_) :: i,info,j,m_problem integer(psb_epk_) :: amatsize, precsize, descsize - integer :: ierr, ircode + integer(psb_ipk_) :: ierr, ircode real(psb_spk_) :: resmx, resmxp real(psb_dpk_) :: t1, t2, tprec character(len=20) :: name, kmethod - integer, parameter :: iunit=12 + integer(psb_ipk_), parameter :: iunit=12 ! initialize the parallel environment @@ -103,7 +103,7 @@ program amg_cexample_1lev name='amg_cexample_ml' if(psb_get_errstatus() /= 0) goto 9999 info=psb_success_ - call psb_set_errverbosity(2) + call psb_set_errverbosity(itwo) ! ! Hello world ! @@ -152,14 +152,14 @@ program amg_cexample_1lev call psb_bcast(ctxt,m_problem) ! At this point aux_b may still be unallocated - if (psb_size(aux_b,1) == m_problem) then + if (psb_size(aux_b,ione) == m_problem) then ! if any rhs were present, broadcast the first one write(0,'("Ok, got an rhs ")') b_glob =>aux_b(:,1) else write(*,'("Generating an rhs...")') write(*,'(" ")') - call psb_realloc(m_problem,1,aux_b,ircode) + call psb_realloc(m_problem,ione,aux_b,ircode) if (ircode /= 0) then call psb_errpush(psb_err_alloc_dealloc_,name) goto 9999 @@ -177,7 +177,7 @@ program amg_cexample_1lev call psb_barrier(ctxt) if (iam == psb_root_) write(*,'("Partition type: block")') call psb_matdist(aux_A, A, ctxt, desc_A,info,parts=part_block) - call psb_scatter(b_glob,b,desc_a,info,root=psb_root_) + call psb_scatter(b_glob,b,desc_a,info,root=ione*psb_root_) t2 = psb_wtime() - t1 @@ -198,7 +198,7 @@ program amg_cexample_1lev ! set number of overlaps - call P%set('SUB_OVR',2,info) + call P%set('SUB_OVR',itwo,info) ! build the preconditioner @@ -226,7 +226,7 @@ program amg_cexample_1lev call psb_barrier(ctxt) t1 = psb_wtime() - call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,istop=2) + call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,istop=itwo) t2 = psb_wtime() - t1 call psb_amx(ctxt,t2) @@ -263,9 +263,9 @@ program amg_cexample_1lev write(*,'("Total memory occupation for PREC : ",i12)')precsize end if - call psb_gather(x_glob,x,desc_a,info,root=psb_root_) + call psb_gather(x_glob,x,desc_a,info,root=ione*psb_root_) if (info == psb_success_) & - & call psb_gather(r_glob,r,desc_a,info,root=psb_root_) + & call psb_gather(r_glob,r,desc_a,info,root=ione*psb_root_) if (info /= psb_success_) goto 9999 if (iam == psb_root_) then write(0,'(" ")') @@ -306,10 +306,11 @@ contains implicit none type(psb_ctxt_type) :: ctxt - integer :: itmax + integer(psb_ipk_) :: itmax real(psb_spk_) :: tol character(len=*) :: mtrx, rhs,filefmt - integer :: iam, np, inp_unit + integer(psb_ipk_) :: inp_unit + integer(psb_mpk_) :: iam, np character(len=1024) :: filename call psb_info(ctxt,iam,np) diff --git a/samples/simple/fileread/amg_cexample_ml.f90 b/samples/simple/fileread/amg_cexample_ml.f90 index f5f3d927..b5c6ec80 100644 --- a/samples/simple/fileread/amg_cexample_ml.f90 +++ b/samples/simple/fileread/amg_cexample_ml.f90 @@ -89,23 +89,23 @@ program amg_cexample_ml ! solver and preconditioner parameters real(psb_spk_) :: tol, err - integer :: itmax, iter, istop - integer :: nlev + integer(psb_ipk_) :: itmax, iter, istop + integer(psb_ipk_) :: nlev ! parallel environment parameters type(psb_ctxt_type) :: ctxt - integer :: iam, np + integer(psb_ipk_) :: iam, np ! other variables - integer :: choice - integer :: i,info,j,m_problem + integer(psb_ipk_) :: choice + integer(psb_ipk_) :: i,info,j,m_problem integer(psb_epk_) :: amatsize, precsize, descsize - integer :: ierr, ircode + integer(psb_ipk_) :: ierr, ircode real(psb_spk_) :: resmx, resmxp real(psb_dpk_) :: t1, t2, tprec character(len=20) :: name character(len=20), parameter :: kmethod='FCG' - integer, parameter :: iunit=12 + integer(psb_ipk_), parameter :: iunit=12 ! initialize the parallel environment @@ -121,7 +121,7 @@ program amg_cexample_ml name='amg_cexample_ml' if(psb_get_errstatus() /= 0) goto 9999 info=psb_success_ - call psb_set_errverbosity(2) + call psb_set_errverbosity(itwo) ! ! Hello world ! @@ -170,14 +170,14 @@ program amg_cexample_ml call psb_bcast(ctxt,m_problem) ! At this point aux_b may still be unallocated - if (psb_size(aux_b,1) == m_problem) then + if (psb_size(aux_b,ione) == m_problem) then ! if any rhs were present, broadcast the first one write(0,'("Ok, got an rhs ")') b_glob =>aux_b(:,1) else write(*,'("Generating an rhs...")') write(*,'(" ")') - call psb_realloc(m_problem,1,aux_b,ircode) + call psb_realloc(m_problem,ione,aux_b,ircode) if (ircode /= 0) then call psb_errpush(psb_err_alloc_dealloc_,name) goto 9999 @@ -195,7 +195,7 @@ program amg_cexample_ml call psb_barrier(ctxt) if (iam == psb_root_) write(*,'("Partition type: block")') call psb_matdist(aux_A, A, ctxt, desc_A,info,parts=part_block) - call psb_scatter(b_glob,b,desc_a,info,root=psb_root_) + call psb_scatter(b_glob,b,desc_a,info,root=ione*psb_root_) t2 = psb_wtime() - t1 @@ -228,7 +228,7 @@ program amg_cexample_ml call P%set('SMOOTHER_TYPE','BJAC',info) call P%set('COARSE_SOLVE','BJAC',info) call P%set('COARSE_SUBSOLVE','ILU',info) - call P%set('COARSE_SWEEPS',8,info) + call P%set('COARSE_SWEEPS',8_psb_ipk_,info) case(3) @@ -241,9 +241,9 @@ program amg_cexample_ml call P%init(ctxt,'ML',info) call P%set('PAR_AGGR_ALG','COUPLED',info) call P%set('AGGR_TYPE','MATCHBOXP',info) - call P%set('AGGR_SIZE',8,info) + call P%set('AGGR_SIZE',8_psb_ipk_,info) call P%set('ML_CYCLE','WCYCLE',info) - call P%set('SMOOTHER_SWEEPS',2,info) + call P%set('SMOOTHER_SWEEPS',itwo,info) call P%set('COARSE_SOLVE','KRM',info) call P%set('COARSE_MAT','DIST',info) call P%set('KRM_METHOD','FCG',info) @@ -275,7 +275,7 @@ program amg_cexample_ml call psb_barrier(ctxt) t1 = psb_wtime() - call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,itrace=1,istop=2) + call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,itrace=ione,istop=itwo) t2 = psb_wtime() - t1 call psb_amx(ctxt,t2) @@ -313,9 +313,9 @@ program amg_cexample_ml write(*,'("Total memory occupation for PREC : ",i12)')precsize end if - call psb_gather(x_glob,x,desc_a,info,root=psb_root_) + call psb_gather(x_glob,x,desc_a,info,root=ione*psb_root_) if (info == psb_success_) & - & call psb_gather(r_glob,r,desc_a,info,root=psb_root_) + & call psb_gather(r_glob,r,desc_a,info,root=ione*psb_root_) if (info /= psb_success_) goto 9999 if (iam == psb_root_) then write(0,'(" ")') @@ -356,10 +356,11 @@ contains implicit none type(psb_ctxt_type) :: ctxt - integer :: choice, itmax + integer(psb_ipk_) :: choice, itmax real(psb_spk_) :: tol character(len=*) :: mtrx, rhs,filefmt - integer :: iam, np, inp_unit + integer(psb_ipk_) :: inp_unit + integer(psb_mpk_) :: iam, np character(len=1024) :: filename call psb_info(ctxt,iam,np) diff --git a/samples/simple/fileread/amg_dexample_1lev.f90 b/samples/simple/fileread/amg_dexample_1lev.f90 index 86831925..a9584959 100644 --- a/samples/simple/fileread/amg_dexample_1lev.f90 +++ b/samples/simple/fileread/amg_dexample_1lev.f90 @@ -73,21 +73,21 @@ program amg_dexample_1lev ! solver and preconditioner parameters real(psb_dpk_) :: tol, err - integer :: itmax, iter, istop - integer :: nlev + integer(psb_ipk_) :: itmax, iter, istop + integer(psb_ipk_) :: nlev ! parallel environment parameters type(psb_ctxt_type) :: ctxt - integer :: iam, np + integer(psb_ipk_) :: iam, np ! other variables - integer :: i,info,j,m_problem + integer(psb_ipk_) :: i,info,j,m_problem integer(psb_epk_) :: amatsize, precsize, descsize - integer :: ierr, ircode + integer(psb_ipk_) :: ierr, ircode real(psb_dpk_) :: resmx, resmxp real(psb_dpk_) :: t1, t2, tprec character(len=20) :: name, kmethod - integer, parameter :: iunit=12 + integer(psb_ipk_), parameter :: iunit=12 ! initialize the parallel environment @@ -103,7 +103,7 @@ program amg_dexample_1lev name='amg_dexample_ml' if(psb_get_errstatus() /= 0) goto 9999 info=psb_success_ - call psb_set_errverbosity(2) + call psb_set_errverbosity(itwo) ! ! Hello world ! @@ -152,14 +152,14 @@ program amg_dexample_1lev call psb_bcast(ctxt,m_problem) ! At this point aux_b may still be unallocated - if (psb_size(aux_b,1) == m_problem) then + if (psb_size(aux_b,ione) == m_problem) then ! if any rhs were present, broadcast the first one write(0,'("Ok, got an rhs ")') b_glob =>aux_b(:,1) else write(*,'("Generating an rhs...")') write(*,'(" ")') - call psb_realloc(m_problem,1,aux_b,ircode) + call psb_realloc(m_problem,ione,aux_b,ircode) if (ircode /= 0) then call psb_errpush(psb_err_alloc_dealloc_,name) goto 9999 @@ -177,7 +177,7 @@ program amg_dexample_1lev call psb_barrier(ctxt) if (iam == psb_root_) write(*,'("Partition type: block")') call psb_matdist(aux_A, A, ctxt, desc_A,info,parts=part_block) - call psb_scatter(b_glob,b,desc_a,info,root=psb_root_) + call psb_scatter(b_glob,b,desc_a,info,root=ione*psb_root_) t2 = psb_wtime() - t1 @@ -198,7 +198,7 @@ program amg_dexample_1lev ! set number of overlaps - call P%set('SUB_OVR',2,info) + call P%set('SUB_OVR',itwo,info) ! build the preconditioner @@ -226,7 +226,7 @@ program amg_dexample_1lev call psb_barrier(ctxt) t1 = psb_wtime() - call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,istop=2) + call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,istop=itwo) t2 = psb_wtime() - t1 call psb_amx(ctxt,t2) @@ -263,9 +263,9 @@ program amg_dexample_1lev write(*,'("Total memory occupation for PREC : ",i12)')precsize end if - call psb_gather(x_glob,x,desc_a,info,root=psb_root_) + call psb_gather(x_glob,x,desc_a,info,root=ione*psb_root_) if (info == psb_success_) & - & call psb_gather(r_glob,r,desc_a,info,root=psb_root_) + & call psb_gather(r_glob,r,desc_a,info,root=ione*psb_root_) if (info /= psb_success_) goto 9999 if (iam == psb_root_) then write(0,'(" ")') @@ -306,10 +306,11 @@ contains implicit none type(psb_ctxt_type) :: ctxt - integer :: itmax + integer(psb_ipk_) :: itmax real(psb_dpk_) :: tol character(len=*) :: mtrx, rhs,filefmt - integer :: iam, np, inp_unit + integer(psb_ipk_) :: inp_unit + integer(psb_mpk_) :: iam, np character(len=1024) :: filename call psb_info(ctxt,iam,np) diff --git a/samples/simple/fileread/amg_dexample_ml.f90 b/samples/simple/fileread/amg_dexample_ml.f90 index 5a97f590..b84fd400 100644 --- a/samples/simple/fileread/amg_dexample_ml.f90 +++ b/samples/simple/fileread/amg_dexample_ml.f90 @@ -89,23 +89,23 @@ program amg_dexample_ml ! solver and preconditioner parameters real(psb_dpk_) :: tol, err - integer :: itmax, iter, istop - integer :: nlev + integer(psb_ipk_) :: itmax, iter, istop + integer(psb_ipk_) :: nlev ! parallel environment parameters type(psb_ctxt_type) :: ctxt - integer :: iam, np + integer(psb_ipk_) :: iam, np ! other variables - integer :: choice - integer :: i,info,j,m_problem + integer(psb_ipk_) :: choice + integer(psb_ipk_) :: i,info,j,m_problem integer(psb_epk_) :: amatsize, precsize, descsize - integer :: ierr, ircode + integer(psb_ipk_) :: ierr, ircode real(psb_dpk_) :: resmx, resmxp real(psb_dpk_) :: t1, t2, tprec character(len=20) :: name character(len=20), parameter :: kmethod='FCG' - integer, parameter :: iunit=12 + integer(psb_ipk_), parameter :: iunit=12 ! initialize the parallel environment @@ -121,7 +121,7 @@ program amg_dexample_ml name='amg_dexample_ml' if(psb_get_errstatus() /= 0) goto 9999 info=psb_success_ - call psb_set_errverbosity(2) + call psb_set_errverbosity(itwo) ! ! Hello world ! @@ -170,14 +170,14 @@ program amg_dexample_ml call psb_bcast(ctxt,m_problem) ! At this point aux_b may still be unallocated - if (psb_size(aux_b,1) == m_problem) then + if (psb_size(aux_b,ione) == m_problem) then ! if any rhs were present, broadcast the first one write(0,'("Ok, got an rhs ")') b_glob =>aux_b(:,1) else write(*,'("Generating an rhs...")') write(*,'(" ")') - call psb_realloc(m_problem,1,aux_b,ircode) + call psb_realloc(m_problem,ione,aux_b,ircode) if (ircode /= 0) then call psb_errpush(psb_err_alloc_dealloc_,name) goto 9999 @@ -195,7 +195,7 @@ program amg_dexample_ml call psb_barrier(ctxt) if (iam == psb_root_) write(*,'("Partition type: block")') call psb_matdist(aux_A, A, ctxt, desc_A,info,parts=part_block) - call psb_scatter(b_glob,b,desc_a,info,root=psb_root_) + call psb_scatter(b_glob,b,desc_a,info,root=ione*psb_root_) t2 = psb_wtime() - t1 @@ -228,7 +228,7 @@ program amg_dexample_ml call P%set('SMOOTHER_TYPE','BJAC',info) call P%set('COARSE_SOLVE','BJAC',info) call P%set('COARSE_SUBSOLVE','ILU',info) - call P%set('COARSE_SWEEPS',8,info) + call P%set('COARSE_SWEEPS',8_psb_ipk_,info) case(3) @@ -241,9 +241,9 @@ program amg_dexample_ml call P%init(ctxt,'ML',info) call P%set('PAR_AGGR_ALG','COUPLED',info) call P%set('AGGR_TYPE','MATCHBOXP',info) - call P%set('AGGR_SIZE',8,info) + call P%set('AGGR_SIZE',8_psb_ipk_,info) call P%set('ML_CYCLE','WCYCLE',info) - call P%set('SMOOTHER_SWEEPS',2,info) + call P%set('SMOOTHER_SWEEPS',itwo,info) call P%set('COARSE_SOLVE','KRM',info) call P%set('COARSE_MAT','DIST',info) call P%set('KRM_METHOD','FCG',info) @@ -275,7 +275,7 @@ program amg_dexample_ml call psb_barrier(ctxt) t1 = psb_wtime() - call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,itrace=1,istop=2) + call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,itrace=ione,istop=itwo) t2 = psb_wtime() - t1 call psb_amx(ctxt,t2) @@ -313,9 +313,9 @@ program amg_dexample_ml write(*,'("Total memory occupation for PREC : ",i12)')precsize end if - call psb_gather(x_glob,x,desc_a,info,root=psb_root_) + call psb_gather(x_glob,x,desc_a,info,root=ione*psb_root_) if (info == psb_success_) & - & call psb_gather(r_glob,r,desc_a,info,root=psb_root_) + & call psb_gather(r_glob,r,desc_a,info,root=ione*psb_root_) if (info /= psb_success_) goto 9999 if (iam == psb_root_) then write(0,'(" ")') @@ -356,10 +356,11 @@ contains implicit none type(psb_ctxt_type) :: ctxt - integer :: choice, itmax + integer(psb_ipk_) :: choice, itmax real(psb_dpk_) :: tol character(len=*) :: mtrx, rhs,filefmt - integer :: iam, np, inp_unit + integer(psb_ipk_) :: inp_unit + integer(psb_mpk_) :: iam, np character(len=1024) :: filename call psb_info(ctxt,iam,np) diff --git a/samples/simple/fileread/amg_sexample_1lev.f90 b/samples/simple/fileread/amg_sexample_1lev.f90 index 03015c8d..f7ad7582 100644 --- a/samples/simple/fileread/amg_sexample_1lev.f90 +++ b/samples/simple/fileread/amg_sexample_1lev.f90 @@ -73,21 +73,21 @@ program amg_sexample_1lev ! solver and preconditioner parameters real(psb_spk_) :: tol, err - integer :: itmax, iter, istop - integer :: nlev + integer(psb_ipk_) :: itmax, iter, istop + integer(psb_ipk_) :: nlev ! parallel environment parameters type(psb_ctxt_type) :: ctxt - integer :: iam, np + integer(psb_ipk_) :: iam, np ! other variables - integer :: i,info,j,m_problem + integer(psb_ipk_) :: i,info,j,m_problem integer(psb_epk_) :: amatsize, precsize, descsize - integer :: ierr, ircode + integer(psb_ipk_) :: ierr, ircode real(psb_spk_) :: resmx, resmxp real(psb_dpk_) :: t1, t2, tprec character(len=20) :: name, kmethod - integer, parameter :: iunit=12 + integer(psb_ipk_), parameter :: iunit=12 ! initialize the parallel environment @@ -103,7 +103,7 @@ program amg_sexample_1lev name='amg_sexample_ml' if(psb_get_errstatus() /= 0) goto 9999 info=psb_success_ - call psb_set_errverbosity(2) + call psb_set_errverbosity(itwo) ! ! Hello world ! @@ -152,14 +152,14 @@ program amg_sexample_1lev call psb_bcast(ctxt,m_problem) ! At this point aux_b may still be unallocated - if (psb_size(aux_b,1) == m_problem) then + if (psb_size(aux_b,ione) == m_problem) then ! if any rhs were present, broadcast the first one write(0,'("Ok, got an rhs ")') b_glob =>aux_b(:,1) else write(*,'("Generating an rhs...")') write(*,'(" ")') - call psb_realloc(m_problem,1,aux_b,ircode) + call psb_realloc(m_problem,ione,aux_b,ircode) if (ircode /= 0) then call psb_errpush(psb_err_alloc_dealloc_,name) goto 9999 @@ -177,7 +177,7 @@ program amg_sexample_1lev call psb_barrier(ctxt) if (iam == psb_root_) write(*,'("Partition type: block")') call psb_matdist(aux_A, A, ctxt, desc_A,info,parts=part_block) - call psb_scatter(b_glob,b,desc_a,info,root=psb_root_) + call psb_scatter(b_glob,b,desc_a,info,root=ione*psb_root_) t2 = psb_wtime() - t1 @@ -198,7 +198,7 @@ program amg_sexample_1lev ! set number of overlaps - call P%set('SUB_OVR',2,info) + call P%set('SUB_OVR',itwo,info) ! build the preconditioner @@ -226,7 +226,7 @@ program amg_sexample_1lev call psb_barrier(ctxt) t1 = psb_wtime() - call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,istop=2) + call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,istop=itwo) t2 = psb_wtime() - t1 call psb_amx(ctxt,t2) @@ -263,9 +263,9 @@ program amg_sexample_1lev write(*,'("Total memory occupation for PREC : ",i12)')precsize end if - call psb_gather(x_glob,x,desc_a,info,root=psb_root_) + call psb_gather(x_glob,x,desc_a,info,root=ione*psb_root_) if (info == psb_success_) & - & call psb_gather(r_glob,r,desc_a,info,root=psb_root_) + & call psb_gather(r_glob,r,desc_a,info,root=ione*psb_root_) if (info /= psb_success_) goto 9999 if (iam == psb_root_) then write(0,'(" ")') @@ -306,10 +306,11 @@ contains implicit none type(psb_ctxt_type) :: ctxt - integer :: itmax + integer(psb_ipk_) :: itmax real(psb_spk_) :: tol character(len=*) :: mtrx, rhs,filefmt - integer :: iam, np, inp_unit + integer(psb_ipk_) :: inp_unit + integer(psb_mpk_) :: iam, np character(len=1024) :: filename call psb_info(ctxt,iam,np) diff --git a/samples/simple/fileread/amg_sexample_ml.f90 b/samples/simple/fileread/amg_sexample_ml.f90 index f0f0e77f..46b4816e 100644 --- a/samples/simple/fileread/amg_sexample_ml.f90 +++ b/samples/simple/fileread/amg_sexample_ml.f90 @@ -89,23 +89,23 @@ program amg_sexample_ml ! solver and preconditioner parameters real(psb_spk_) :: tol, err - integer :: itmax, iter, istop - integer :: nlev + integer(psb_ipk_) :: itmax, iter, istop + integer(psb_ipk_) :: nlev ! parallel environment parameters type(psb_ctxt_type) :: ctxt - integer :: iam, np + integer(psb_ipk_) :: iam, np ! other variables - integer :: choice - integer :: i,info,j,m_problem + integer(psb_ipk_) :: choice + integer(psb_ipk_) :: i,info,j,m_problem integer(psb_epk_) :: amatsize, precsize, descsize - integer :: ierr, ircode + integer(psb_ipk_) :: ierr, ircode real(psb_spk_) :: resmx, resmxp real(psb_dpk_) :: t1, t2, tprec character(len=20) :: name character(len=20), parameter :: kmethod='FCG' - integer, parameter :: iunit=12 + integer(psb_ipk_), parameter :: iunit=12 ! initialize the parallel environment @@ -121,7 +121,7 @@ program amg_sexample_ml name='amg_sexample_ml' if(psb_get_errstatus() /= 0) goto 9999 info=psb_success_ - call psb_set_errverbosity(2) + call psb_set_errverbosity(itwo) ! ! Hello world ! @@ -170,14 +170,14 @@ program amg_sexample_ml call psb_bcast(ctxt,m_problem) ! At this point aux_b may still be unallocated - if (psb_size(aux_b,1) == m_problem) then + if (psb_size(aux_b,ione) == m_problem) then ! if any rhs were present, broadcast the first one write(0,'("Ok, got an rhs ")') b_glob =>aux_b(:,1) else write(*,'("Generating an rhs...")') write(*,'(" ")') - call psb_realloc(m_problem,1,aux_b,ircode) + call psb_realloc(m_problem,ione,aux_b,ircode) if (ircode /= 0) then call psb_errpush(psb_err_alloc_dealloc_,name) goto 9999 @@ -195,7 +195,7 @@ program amg_sexample_ml call psb_barrier(ctxt) if (iam == psb_root_) write(*,'("Partition type: block")') call psb_matdist(aux_A, A, ctxt, desc_A,info,parts=part_block) - call psb_scatter(b_glob,b,desc_a,info,root=psb_root_) + call psb_scatter(b_glob,b,desc_a,info,root=ione*psb_root_) t2 = psb_wtime() - t1 @@ -228,7 +228,7 @@ program amg_sexample_ml call P%set('SMOOTHER_TYPE','BJAC',info) call P%set('COARSE_SOLVE','BJAC',info) call P%set('COARSE_SUBSOLVE','ILU',info) - call P%set('COARSE_SWEEPS',8,info) + call P%set('COARSE_SWEEPS',8_psb_ipk_,info) case(3) @@ -241,9 +241,9 @@ program amg_sexample_ml call P%init(ctxt,'ML',info) call P%set('PAR_AGGR_ALG','COUPLED',info) call P%set('AGGR_TYPE','MATCHBOXP',info) - call P%set('AGGR_SIZE',8,info) + call P%set('AGGR_SIZE',8_psb_ipk_,info) call P%set('ML_CYCLE','WCYCLE',info) - call P%set('SMOOTHER_SWEEPS',2,info) + call P%set('SMOOTHER_SWEEPS',itwo,info) call P%set('COARSE_SOLVE','KRM',info) call P%set('COARSE_MAT','DIST',info) call P%set('KRM_METHOD','FCG',info) @@ -275,7 +275,7 @@ program amg_sexample_ml call psb_barrier(ctxt) t1 = psb_wtime() - call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,itrace=1,istop=2) + call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,itrace=ione,istop=itwo) t2 = psb_wtime() - t1 call psb_amx(ctxt,t2) @@ -313,9 +313,9 @@ program amg_sexample_ml write(*,'("Total memory occupation for PREC : ",i12)')precsize end if - call psb_gather(x_glob,x,desc_a,info,root=psb_root_) + call psb_gather(x_glob,x,desc_a,info,root=ione*psb_root_) if (info == psb_success_) & - & call psb_gather(r_glob,r,desc_a,info,root=psb_root_) + & call psb_gather(r_glob,r,desc_a,info,root=ione*psb_root_) if (info /= psb_success_) goto 9999 if (iam == psb_root_) then write(0,'(" ")') @@ -356,10 +356,11 @@ contains implicit none type(psb_ctxt_type) :: ctxt - integer :: choice, itmax + integer(psb_ipk_) :: choice, itmax real(psb_spk_) :: tol character(len=*) :: mtrx, rhs,filefmt - integer :: iam, np, inp_unit + integer(psb_ipk_) :: inp_unit + integer(psb_mpk_) :: iam, np character(len=1024) :: filename call psb_info(ctxt,iam,np) diff --git a/samples/simple/fileread/amg_zexample_1lev.f90 b/samples/simple/fileread/amg_zexample_1lev.f90 index 86cf8caf..273fefe7 100644 --- a/samples/simple/fileread/amg_zexample_1lev.f90 +++ b/samples/simple/fileread/amg_zexample_1lev.f90 @@ -73,21 +73,21 @@ program amg_zexample_1lev ! solver and preconditioner parameters real(psb_dpk_) :: tol, err - integer :: itmax, iter, istop - integer :: nlev + integer(psb_ipk_) :: itmax, iter, istop + integer(psb_ipk_) :: nlev ! parallel environment parameters type(psb_ctxt_type) :: ctxt - integer :: iam, np + integer(psb_ipk_) :: iam, np ! other variables - integer :: i,info,j,m_problem + integer(psb_ipk_) :: i,info,j,m_problem integer(psb_epk_) :: amatsize, precsize, descsize - integer :: ierr, ircode + integer(psb_ipk_) :: ierr, ircode real(psb_dpk_) :: resmx, resmxp real(psb_dpk_) :: t1, t2, tprec character(len=20) :: name, kmethod - integer, parameter :: iunit=12 + integer(psb_ipk_), parameter :: iunit=12 ! initialize the parallel environment @@ -103,7 +103,7 @@ program amg_zexample_1lev name='amg_zexample_ml' if(psb_get_errstatus() /= 0) goto 9999 info=psb_success_ - call psb_set_errverbosity(2) + call psb_set_errverbosity(itwo) ! ! Hello world ! @@ -152,14 +152,14 @@ program amg_zexample_1lev call psb_bcast(ctxt,m_problem) ! At this point aux_b may still be unallocated - if (psb_size(aux_b,1) == m_problem) then + if (psb_size(aux_b,ione) == m_problem) then ! if any rhs were present, broadcast the first one write(0,'("Ok, got an rhs ")') b_glob =>aux_b(:,1) else write(*,'("Generating an rhs...")') write(*,'(" ")') - call psb_realloc(m_problem,1,aux_b,ircode) + call psb_realloc(m_problem,ione,aux_b,ircode) if (ircode /= 0) then call psb_errpush(psb_err_alloc_dealloc_,name) goto 9999 @@ -177,7 +177,7 @@ program amg_zexample_1lev call psb_barrier(ctxt) if (iam == psb_root_) write(*,'("Partition type: block")') call psb_matdist(aux_A, A, ctxt, desc_A,info,parts=part_block) - call psb_scatter(b_glob,b,desc_a,info,root=psb_root_) + call psb_scatter(b_glob,b,desc_a,info,root=ione*psb_root_) t2 = psb_wtime() - t1 @@ -198,7 +198,7 @@ program amg_zexample_1lev ! set number of overlaps - call P%set('SUB_OVR',2,info) + call P%set('SUB_OVR',itwo,info) ! build the preconditioner @@ -226,7 +226,7 @@ program amg_zexample_1lev call psb_barrier(ctxt) t1 = psb_wtime() - call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,istop=2) + call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,istop=itwo) t2 = psb_wtime() - t1 call psb_amx(ctxt,t2) @@ -263,9 +263,9 @@ program amg_zexample_1lev write(*,'("Total memory occupation for PREC : ",i12)')precsize end if - call psb_gather(x_glob,x,desc_a,info,root=psb_root_) + call psb_gather(x_glob,x,desc_a,info,root=ione*psb_root_) if (info == psb_success_) & - & call psb_gather(r_glob,r,desc_a,info,root=psb_root_) + & call psb_gather(r_glob,r,desc_a,info,root=ione*psb_root_) if (info /= psb_success_) goto 9999 if (iam == psb_root_) then write(0,'(" ")') @@ -306,10 +306,11 @@ contains implicit none type(psb_ctxt_type) :: ctxt - integer :: itmax + integer(psb_ipk_) :: itmax real(psb_dpk_) :: tol character(len=*) :: mtrx, rhs,filefmt - integer :: iam, np, inp_unit + integer(psb_ipk_) :: inp_unit + integer(psb_mpk_) :: iam, np character(len=1024) :: filename call psb_info(ctxt,iam,np) diff --git a/samples/simple/fileread/amg_zexample_ml.f90 b/samples/simple/fileread/amg_zexample_ml.f90 index 369e2a33..d0ce4e66 100644 --- a/samples/simple/fileread/amg_zexample_ml.f90 +++ b/samples/simple/fileread/amg_zexample_ml.f90 @@ -89,23 +89,23 @@ program amg_zexample_ml ! solver and preconditioner parameters real(psb_dpk_) :: tol, err - integer :: itmax, iter, istop - integer :: nlev + integer(psb_ipk_) :: itmax, iter, istop + integer(psb_ipk_) :: nlev ! parallel environment parameters type(psb_ctxt_type) :: ctxt - integer :: iam, np + integer(psb_ipk_) :: iam, np ! other variables - integer :: choice - integer :: i,info,j,m_problem + integer(psb_ipk_) :: choice + integer(psb_ipk_) :: i,info,j,m_problem integer(psb_epk_) :: amatsize, precsize, descsize - integer :: ierr, ircode + integer(psb_ipk_) :: ierr, ircode real(psb_dpk_) :: resmx, resmxp real(psb_dpk_) :: t1, t2, tprec character(len=20) :: name character(len=20), parameter :: kmethod='FCG' - integer, parameter :: iunit=12 + integer(psb_ipk_), parameter :: iunit=12 ! initialize the parallel environment @@ -121,7 +121,7 @@ program amg_zexample_ml name='amg_zexample_ml' if(psb_get_errstatus() /= 0) goto 9999 info=psb_success_ - call psb_set_errverbosity(2) + call psb_set_errverbosity(itwo) ! ! Hello world ! @@ -170,14 +170,14 @@ program amg_zexample_ml call psb_bcast(ctxt,m_problem) ! At this point aux_b may still be unallocated - if (psb_size(aux_b,1) == m_problem) then + if (psb_size(aux_b,ione) == m_problem) then ! if any rhs were present, broadcast the first one write(0,'("Ok, got an rhs ")') b_glob =>aux_b(:,1) else write(*,'("Generating an rhs...")') write(*,'(" ")') - call psb_realloc(m_problem,1,aux_b,ircode) + call psb_realloc(m_problem,ione,aux_b,ircode) if (ircode /= 0) then call psb_errpush(psb_err_alloc_dealloc_,name) goto 9999 @@ -195,7 +195,7 @@ program amg_zexample_ml call psb_barrier(ctxt) if (iam == psb_root_) write(*,'("Partition type: block")') call psb_matdist(aux_A, A, ctxt, desc_A,info,parts=part_block) - call psb_scatter(b_glob,b,desc_a,info,root=psb_root_) + call psb_scatter(b_glob,b,desc_a,info,root=ione*psb_root_) t2 = psb_wtime() - t1 @@ -228,7 +228,7 @@ program amg_zexample_ml call P%set('SMOOTHER_TYPE','BJAC',info) call P%set('COARSE_SOLVE','BJAC',info) call P%set('COARSE_SUBSOLVE','ILU',info) - call P%set('COARSE_SWEEPS',8,info) + call P%set('COARSE_SWEEPS',8_psb_ipk_,info) case(3) @@ -241,9 +241,9 @@ program amg_zexample_ml call P%init(ctxt,'ML',info) call P%set('PAR_AGGR_ALG','COUPLED',info) call P%set('AGGR_TYPE','MATCHBOXP',info) - call P%set('AGGR_SIZE',8,info) + call P%set('AGGR_SIZE',8_psb_ipk_,info) call P%set('ML_CYCLE','WCYCLE',info) - call P%set('SMOOTHER_SWEEPS',2,info) + call P%set('SMOOTHER_SWEEPS',itwo,info) call P%set('COARSE_SOLVE','KRM',info) call P%set('COARSE_MAT','DIST',info) call P%set('KRM_METHOD','FCG',info) @@ -275,7 +275,7 @@ program amg_zexample_ml call psb_barrier(ctxt) t1 = psb_wtime() - call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,itrace=1,istop=2) + call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,itrace=ione,istop=itwo) t2 = psb_wtime() - t1 call psb_amx(ctxt,t2) @@ -313,9 +313,9 @@ program amg_zexample_ml write(*,'("Total memory occupation for PREC : ",i12)')precsize end if - call psb_gather(x_glob,x,desc_a,info,root=psb_root_) + call psb_gather(x_glob,x,desc_a,info,root=ione*psb_root_) if (info == psb_success_) & - & call psb_gather(r_glob,r,desc_a,info,root=psb_root_) + & call psb_gather(r_glob,r,desc_a,info,root=ione*psb_root_) if (info /= psb_success_) goto 9999 if (iam == psb_root_) then write(0,'(" ")') @@ -356,10 +356,11 @@ contains implicit none type(psb_ctxt_type) :: ctxt - integer :: choice, itmax + integer(psb_ipk_) :: choice, itmax real(psb_dpk_) :: tol character(len=*) :: mtrx, rhs,filefmt - integer :: iam, np, inp_unit + integer(psb_ipk_) :: inp_unit + integer(psb_mpk_) :: iam, np character(len=1024) :: filename call psb_info(ctxt,iam,np) diff --git a/samples/simple/fileread/data_input.f90 b/samples/simple/fileread/data_input.f90 index 4e91498b..5ee69438 100644 --- a/samples/simple/fileread/data_input.f90 +++ b/samples/simple/fileread/data_input.f90 @@ -32,11 +32,8 @@ ! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE ! POSSIBILITY OF SUCH DAMAGE. -! -! -! module data_input - + use psb_base_mod, only : psb_ipk_ interface read_data module procedure read_char, read_int,& & read_double, read_single,& @@ -54,7 +51,7 @@ contains subroutine read_char(val,file,marker) character(len=*), intent(out) :: val - integer, intent(in) :: file + integer(psb_ipk_), intent(in) :: file character(len=1), optional, intent(in) :: marker read(file,'(a)')charbuf @@ -63,8 +60,8 @@ contains end subroutine read_char subroutine read_int(val,file,marker) - integer, intent(out) :: val - integer, intent(in) :: file + integer(psb_ipk_), intent(out) :: val + integer(psb_ipk_), intent(in) :: file character(len=1), optional, intent(in) :: marker read(file,'(a)')charbuf @@ -74,7 +71,7 @@ contains subroutine read_single(val,file,marker) use psb_base_mod real(psb_spk_), intent(out) :: val - integer, intent(in) :: file + integer(psb_ipk_), intent(in) :: file character(len=1), optional, intent(in) :: marker read(file,'(a)')charbuf @@ -84,7 +81,7 @@ contains subroutine read_double(val,file,marker) use psb_base_mod real(psb_dpk_), intent(out) :: val - integer, intent(in) :: file + integer(psb_ipk_), intent(in) :: file character(len=1), optional, intent(in) :: marker read(file,'(a)')charbuf @@ -112,7 +109,7 @@ contains end subroutine string_read_char subroutine string_read_int(val,file,marker) - integer, intent(out) :: val + integer(psb_ipk_), intent(out) :: val character(len=*), intent(in) :: file character(len=1), optional, intent(in) :: marker character(len=1) :: marker_ diff --git a/samples/simple/pdegen/amg_dexample_1lev.f90 b/samples/simple/pdegen/amg_dexample_1lev.f90 index 05158ab1..5667f0ab 100644 --- a/samples/simple/pdegen/amg_dexample_1lev.f90 +++ b/samples/simple/pdegen/amg_dexample_1lev.f90 @@ -81,17 +81,17 @@ program amg_dexample_1lev ! solver parameters real(psb_dpk_) :: tol, err - integer :: itmax, iter, itrace, istop + integer(psb_ipk_) :: itmax, iter, itrace, istop ! parallel environment parameters type(psb_ctxt_type) :: ctxt - integer :: iam, np + integer(psb_ipk_) :: iam, np ! other variables - integer :: i,info,j + integer(psb_ipk_) :: i,info,j integer(psb_epk_) :: amatsize, precsize, descsize integer(psb_epk_) :: system_size - integer :: idim, nlev, ierr, ircode + integer(psb_ipk_) :: idim, nlev, ierr, ircode real(psb_dpk_) :: resmx, resmxp real(psb_dpk_) :: t1, t2, tprec character(len=5) :: afmt='CSR' @@ -110,7 +110,7 @@ program amg_dexample_1lev name='amg_dexample_ml' if(psb_get_errstatus() /= 0) goto 9999 info=psb_success_ - call psb_set_errverbosity(2) + call psb_set_errverbosity(itwo) ! ! Hello world ! @@ -146,7 +146,7 @@ program amg_dexample_1lev ! set number of overlaps - call P%set('SUB_OVR',2,info) + call P%set('SUB_OVR',itwo,info) ! build the preconditioner @@ -174,7 +174,7 @@ program amg_dexample_1lev call psb_barrier(ctxt) t1 = psb_wtime() - call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,itrace=1,istop=2) + call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,itrace=ione,istop=itwo) t2 = psb_wtime() - t1 call psb_amx(ctxt,t2) @@ -236,9 +236,10 @@ contains implicit none type(psb_ctxt_type) :: ctxt - integer :: idim, itmax + integer(psb_ipk_) :: idim, itmax real(psb_dpk_) :: tol - integer :: iam, np, inp_unit + integer(psb_mpk_) :: iam, np + integer(psb_ipk_) :: inp_unit character(len=1024) :: filename call psb_info(ctxt,iam,np) diff --git a/samples/simple/pdegen/amg_dexample_ml.f90 b/samples/simple/pdegen/amg_dexample_ml.f90 index 36ada4f5..1ed41f4d 100644 --- a/samples/simple/pdegen/amg_dexample_ml.f90 +++ b/samples/simple/pdegen/amg_dexample_ml.f90 @@ -105,20 +105,20 @@ program amg_dexample_ml ! solver and preconditioner parameters real(psb_dpk_) :: tol, err - integer :: itmax, iter, istop - integer :: nlev + integer(psb_ipk_) :: itmax, iter, istop + integer(psb_ipk_) :: nlev ! parallel environment parameters type(psb_ctxt_type) :: ctxt - integer :: iam, np + integer(psb_ipk_) :: iam, np ! other variables - integer :: choice - integer :: i,info,j - integer(psb_epk_) :: amatsize, precsize, descsize - integer(psb_epk_) :: system_size - integer :: idim, ierr, ircode - real(psb_dpk_) :: resmx, resmxp + integer(psb_ipk_) :: choice + integer(psb_ipk_) :: i,info,j + integer(psb_epk_) :: amatsize, precsize, descsize + integer(psb_epk_) :: system_size + integer(psb_ipk_) :: idim, ierr, ircode + real(psb_dpk_) :: resmx, resmxp real(psb_dpk_) :: t1, t2, tprec character(len=5) :: afmt='CSR' character(len=20) :: name @@ -138,7 +138,7 @@ program amg_dexample_ml name='amg_dexample_ml' if(psb_get_errstatus() /= 0) goto 9999 info=psb_success_ - call psb_set_errverbosity(2) + call psb_set_errverbosity(itwo) ! ! Hello world ! @@ -189,7 +189,7 @@ program amg_dexample_ml call P%set('SMOOTHER_TYPE','BJAC',info) call P%set('COARSE_SOLVE','BJAC',info) call P%set('COARSE_SUBSOLVE','ILU',info) - call P%set('COARSE_SWEEPS',8,info) + call P%set('COARSE_SWEEPS',8_psb_ipk_,info) case(3) @@ -202,9 +202,9 @@ program amg_dexample_ml call P%init(ctxt,'ML',info) call P%set('PAR_AGGR_ALG','COUPLED',info) call P%set('AGGR_TYPE','MATCHBOXP',info) - call P%set('AGGR_SIZE',8,info) + call P%set('AGGR_SIZE',8_psb_ipk_,info) call P%set('ML_CYCLE','WCYCLE',info) - call P%set('SMOOTHER_SWEEPS',2,info) + call P%set('SMOOTHER_SWEEPS',itwo,info) call P%set('COARSE_SOLVE','KRM',info) call P%set('COARSE_MAT','DIST',info) call P%set('KRM_METHOD','FCG',info) @@ -237,7 +237,7 @@ program amg_dexample_ml call psb_barrier(ctxt) t1 = psb_wtime() - call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,itrace=1,istop=2) + call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,itrace=ione,istop=itwo) t2 = psb_wtime() - t1 call psb_amx(ctxt,t2) @@ -299,9 +299,10 @@ contains implicit none type(psb_ctxt_type) :: ctxt - integer :: choice, idim, itmax + integer(psb_ipk_) :: choice, idim, itmax real(psb_dpk_) :: tol - integer :: iam, np, inp_unit + integer(psb_mpk_) :: iam, np + integer(psb_ipk_) :: inp_unit character(len=1024) :: filename call psb_info(ctxt,iam,np) diff --git a/samples/simple/pdegen/amg_dpde_mod.f90 b/samples/simple/pdegen/amg_dpde_mod.f90 index 821d57f0..692a79bd 100644 --- a/samples/simple/pdegen/amg_dpde_mod.f90 +++ b/samples/simple/pdegen/amg_dpde_mod.f90 @@ -237,7 +237,7 @@ contains allocate(bndx(0:npx),bndy(0:npy),bndz(0:npz)) ! We can reuse idx2ijk for process indices as well. - call idx2ijk(iamx,iamy,iamz,iam,npx,npy,npz,base=0) + call idx2ijk(iamx,iamy,iamz,iam,npx,npy,npz,base=mzero) ! Now let's split the 3D cube in hexahedra call dist1Didx(bndx,idim,npx) mynx = bndx(iamx+1)-bndx(iamx) @@ -280,7 +280,7 @@ contains ! ! Use adjcncy methods ! - integer(psb_mpk_), allocatable :: neighbours(:) + integer(psb_ipk_), allocatable :: neighbours(:) integer(psb_mpk_) :: cnt logical, parameter :: debug_adj=.true. if (debug_adj.and.(np > 1)) then @@ -288,27 +288,27 @@ contains allocate(neighbours(np)) if (iamx < npx-1) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx+1,iamy,iamz,npx,npy,npz,base=0) + call ijk2idx(neighbours(cnt),iamx+1,iamy,iamz,npx,npy,npz,base=mzero) end if if (iamy < npy-1) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx,iamy+1,iamz,npx,npy,npz,base=0) + call ijk2idx(neighbours(cnt),iamx,iamy+1,iamz,npx,npy,npz,base=mzero) end if if (iamz < npz-1) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx,iamy,iamz+1,npx,npy,npz,base=0) + call ijk2idx(neighbours(cnt),iamx,iamy,iamz+1,npx,npy,npz,base=mzero) end if if (iamx >0) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx-1,iamy,iamz,npx,npy,npz,base=0) + call ijk2idx(neighbours(cnt),iamx-1,iamy,iamz,npx,npy,npz,base=mzero) end if if (iamy >0) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx,iamy-1,iamz,npx,npy,npz,base=0) + call ijk2idx(neighbours(cnt),iamx,iamy-1,iamz,npx,npy,npz,base=mzero) end if if (iamz >0) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx,iamy,iamz-1,npx,npy,npz,base=0) + call ijk2idx(neighbours(cnt),iamx,iamy,iamz-1,npx,npy,npz,base=mzero) end if call psb_realloc(cnt, neighbours,info) call desc_a%set_p_adjcncy(neighbours) diff --git a/samples/simple/pdegen/amg_sexample_1lev.f90 b/samples/simple/pdegen/amg_sexample_1lev.f90 index cbfe691b..4e023221 100644 --- a/samples/simple/pdegen/amg_sexample_1lev.f90 +++ b/samples/simple/pdegen/amg_sexample_1lev.f90 @@ -81,17 +81,17 @@ program amg_sexample_1lev ! solver parameters real(psb_spk_) :: tol, err - integer :: itmax, iter, itrace, istop + integer(psb_ipk_) :: itmax, iter, itrace, istop ! parallel environment parameters type(psb_ctxt_type) :: ctxt - integer :: iam, np + integer(psb_ipk_) :: iam, np ! other variables - integer :: i,info,j + integer(psb_ipk_) :: i,info,j integer(psb_epk_) :: amatsize, precsize, descsize integer(psb_epk_) :: system_size - integer :: idim, nlev, ierr, ircode + integer(psb_ipk_) :: idim, nlev, ierr, ircode real(psb_spk_) :: resmx, resmxp real(psb_dpk_) :: t1, t2, tprec character(len=5) :: afmt='CSR' @@ -110,7 +110,7 @@ program amg_sexample_1lev name='amg_sexample_ml' if(psb_get_errstatus() /= 0) goto 9999 info=psb_success_ - call psb_set_errverbosity(2) + call psb_set_errverbosity(itwo) ! ! Hello world ! @@ -146,7 +146,7 @@ program amg_sexample_1lev ! set number of overlaps - call P%set('SUB_OVR',2,info) + call P%set('SUB_OVR',itwo,info) ! build the preconditioner @@ -174,7 +174,7 @@ program amg_sexample_1lev call psb_barrier(ctxt) t1 = psb_wtime() - call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,itrace=1,istop=2) + call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,itrace=ione,istop=itwo) t2 = psb_wtime() - t1 call psb_amx(ctxt,t2) @@ -236,9 +236,10 @@ contains implicit none type(psb_ctxt_type) :: ctxt - integer :: idim, itmax + integer(psb_ipk_) :: idim, itmax real(psb_spk_) :: tol - integer :: iam, np, inp_unit + integer(psb_mpk_) :: iam, np + integer(psb_ipk_) :: inp_unit character(len=1024) :: filename call psb_info(ctxt,iam,np) diff --git a/samples/simple/pdegen/amg_sexample_ml.f90 b/samples/simple/pdegen/amg_sexample_ml.f90 index 9ae25e6b..03d59633 100644 --- a/samples/simple/pdegen/amg_sexample_ml.f90 +++ b/samples/simple/pdegen/amg_sexample_ml.f90 @@ -105,20 +105,20 @@ program amg_sexample_ml ! solver and preconditioner parameters real(psb_spk_) :: tol, err - integer :: itmax, iter, istop - integer :: nlev + integer(psb_ipk_) :: itmax, iter, istop + integer(psb_ipk_) :: nlev ! parallel environment parameters type(psb_ctxt_type) :: ctxt - integer :: iam, np + integer(psb_ipk_) :: iam, np ! other variables - integer :: choice - integer :: i,info,j - integer(psb_epk_) :: amatsize, precsize, descsize - integer(psb_epk_) :: system_size - integer :: idim, ierr, ircode - real(psb_spk_) :: resmx, resmxp + integer(psb_ipk_) :: choice + integer(psb_ipk_) :: i,info,j + integer(psb_epk_) :: amatsize, precsize, descsize + integer(psb_epk_) :: system_size + integer(psb_ipk_) :: idim, ierr, ircode + real(psb_spk_) :: resmx, resmxp real(psb_dpk_) :: t1, t2, tprec character(len=5) :: afmt='CSR' character(len=20) :: name @@ -138,7 +138,7 @@ program amg_sexample_ml name='amg_sexample_ml' if(psb_get_errstatus() /= 0) goto 9999 info=psb_success_ - call psb_set_errverbosity(2) + call psb_set_errverbosity(itwo) ! ! Hello world ! @@ -189,7 +189,7 @@ program amg_sexample_ml call P%set('SMOOTHER_TYPE','BJAC',info) call P%set('COARSE_SOLVE','BJAC',info) call P%set('COARSE_SUBSOLVE','ILU',info) - call P%set('COARSE_SWEEPS',8,info) + call P%set('COARSE_SWEEPS',8_psb_ipk_,info) case(3) @@ -202,9 +202,9 @@ program amg_sexample_ml call P%init(ctxt,'ML',info) call P%set('PAR_AGGR_ALG','COUPLED',info) call P%set('AGGR_TYPE','MATCHBOXP',info) - call P%set('AGGR_SIZE',8,info) + call P%set('AGGR_SIZE',8_psb_ipk_,info) call P%set('ML_CYCLE','WCYCLE',info) - call P%set('SMOOTHER_SWEEPS',2,info) + call P%set('SMOOTHER_SWEEPS',itwo,info) call P%set('COARSE_SOLVE','KRM',info) call P%set('COARSE_MAT','DIST',info) call P%set('KRM_METHOD','FCG',info) @@ -237,7 +237,7 @@ program amg_sexample_ml call psb_barrier(ctxt) t1 = psb_wtime() - call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,itrace=1,istop=2) + call psb_krylov(kmethod,A,P,b,x,tol,desc_A,info,itmax,iter,err,itrace=ione,istop=itwo) t2 = psb_wtime() - t1 call psb_amx(ctxt,t2) @@ -299,9 +299,10 @@ contains implicit none type(psb_ctxt_type) :: ctxt - integer :: choice, idim, itmax + integer(psb_ipk_) :: choice, idim, itmax real(psb_spk_) :: tol - integer :: iam, np, inp_unit + integer(psb_mpk_) :: iam, np + integer(psb_ipk_) :: inp_unit character(len=1024) :: filename call psb_info(ctxt,iam,np) diff --git a/samples/simple/pdegen/amg_spde_mod.f90 b/samples/simple/pdegen/amg_spde_mod.f90 index 505e1e96..e734e6b9 100644 --- a/samples/simple/pdegen/amg_spde_mod.f90 +++ b/samples/simple/pdegen/amg_spde_mod.f90 @@ -237,7 +237,7 @@ contains allocate(bndx(0:npx),bndy(0:npy),bndz(0:npz)) ! We can reuse idx2ijk for process indices as well. - call idx2ijk(iamx,iamy,iamz,iam,npx,npy,npz,base=0) + call idx2ijk(iamx,iamy,iamz,iam,npx,npy,npz,base=mzero) ! Now let's split the 3D cube in hexahedra call dist1Didx(bndx,idim,npx) mynx = bndx(iamx+1)-bndx(iamx) @@ -280,7 +280,7 @@ contains ! ! Use adjcncy methods ! - integer(psb_mpk_), allocatable :: neighbours(:) + integer(psb_ipk_), allocatable :: neighbours(:) integer(psb_mpk_) :: cnt logical, parameter :: debug_adj=.true. if (debug_adj.and.(np > 1)) then @@ -288,27 +288,27 @@ contains allocate(neighbours(np)) if (iamx < npx-1) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx+1,iamy,iamz,npx,npy,npz,base=0) + call ijk2idx(neighbours(cnt),iamx+1,iamy,iamz,npx,npy,npz,base=mzero) end if if (iamy < npy-1) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx,iamy+1,iamz,npx,npy,npz,base=0) + call ijk2idx(neighbours(cnt),iamx,iamy+1,iamz,npx,npy,npz,base=mzero) end if if (iamz < npz-1) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx,iamy,iamz+1,npx,npy,npz,base=0) + call ijk2idx(neighbours(cnt),iamx,iamy,iamz+1,npx,npy,npz,base=mzero) end if if (iamx >0) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx-1,iamy,iamz,npx,npy,npz,base=0) + call ijk2idx(neighbours(cnt),iamx-1,iamy,iamz,npx,npy,npz,base=mzero) end if if (iamy >0) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx,iamy-1,iamz,npx,npy,npz,base=0) + call ijk2idx(neighbours(cnt),iamx,iamy-1,iamz,npx,npy,npz,base=mzero) end if if (iamz >0) then cnt = cnt + 1 - call ijk2idx(neighbours(cnt),iamx,iamy,iamz-1,npx,npy,npz,base=0) + call ijk2idx(neighbours(cnt),iamx,iamy,iamz-1,npx,npy,npz,base=mzero) end if call psb_realloc(cnt, neighbours,info) call desc_a%set_p_adjcncy(neighbours) diff --git a/samples/simple/pdegen/data_input.f90 b/samples/simple/pdegen/data_input.f90 index fe95b557..b17b3f0d 100644 --- a/samples/simple/pdegen/data_input.f90 +++ b/samples/simple/pdegen/data_input.f90 @@ -33,7 +33,7 @@ ! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE ! POSSIBILITY OF SUCH DAMAGE. module data_input - + use psb_base_mod, only : psb_ipk_ interface read_data module procedure read_char, read_int,& & read_double, read_single,& @@ -51,7 +51,7 @@ contains subroutine read_char(val,file,marker) character(len=*), intent(out) :: val - integer, intent(in) :: file + integer(psb_ipk_), intent(in) :: file character(len=1), optional, intent(in) :: marker read(file,'(a)')charbuf @@ -60,8 +60,8 @@ contains end subroutine read_char subroutine read_int(val,file,marker) - integer, intent(out) :: val - integer, intent(in) :: file + integer(psb_ipk_), intent(out) :: val + integer(psb_ipk_), intent(in) :: file character(len=1), optional, intent(in) :: marker read(file,'(a)')charbuf @@ -71,7 +71,7 @@ contains subroutine read_single(val,file,marker) use psb_base_mod real(psb_spk_), intent(out) :: val - integer, intent(in) :: file + integer(psb_ipk_), intent(in) :: file character(len=1), optional, intent(in) :: marker read(file,'(a)')charbuf @@ -81,7 +81,7 @@ contains subroutine read_double(val,file,marker) use psb_base_mod real(psb_dpk_), intent(out) :: val - integer, intent(in) :: file + integer(psb_ipk_), intent(in) :: file character(len=1), optional, intent(in) :: marker read(file,'(a)')charbuf @@ -109,7 +109,7 @@ contains end subroutine string_read_char subroutine string_read_int(val,file,marker) - integer, intent(out) :: val + integer(psb_ipk_), intent(out) :: val character(len=*), intent(in) :: file character(len=1), optional, intent(in) :: marker character(len=1) :: marker_ From 21b85bc5338766dff44500a13684d4116b10ca7a Mon Sep 17 00:00:00 2001 From: sfilippone Date: Thu, 5 Jun 2025 09:39:50 +0200 Subject: [PATCH 4/4] Update contributor list --- README.md | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/README.md b/README.md index 954abb8b..05766e26 100644 --- a/README.md +++ b/README.md @@ -74,3 +74,9 @@ In the European project “Energy oriented Center of Excellence: toward exascale - Fabio Durastante (University of Pisa and IAC-CNR, IT) - Salvatore Filippone (University of Rome Tor Vergata and IAC-CNR, IT) +**Contributors** (_roughly reverse cronological order_): + +- Luca Pepè Sciarria +- Andea Di Iorio +- Ambra Abdullahi Hassan +- Alfredo Buttari