From 386e97051260a7f606b15b0203139297e5fa4000 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Tue, 19 Jun 2018 14:22:10 +0100 Subject: [PATCH] Changes for compilation --- .../mld_c_dec_aggregator_mat_asb.f90 | 6 +- .../aggregator/mld_c_dec_aggregator_tprol.f90 | 10 +- .../mld_c_symdec_aggregator_tprol.f90 | 10 +- .../mld_d_dec_aggregator_mat_asb.f90 | 6 +- .../aggregator/mld_d_dec_aggregator_tprol.f90 | 10 +- .../mld_d_symdec_aggregator_tprol.f90 | 10 +- .../mld_s_dec_aggregator_mat_asb.f90 | 6 +- .../aggregator/mld_s_dec_aggregator_tprol.f90 | 10 +- .../mld_s_symdec_aggregator_tprol.f90 | 10 +- .../mld_z_dec_aggregator_mat_asb.f90 | 6 +- .../aggregator/mld_z_dec_aggregator_tprol.f90 | 10 +- .../mld_z_symdec_aggregator_tprol.f90 | 10 +- .../impl/level/mld_c_base_onelev_mat_asb.f90 | 16 +- .../impl/level/mld_d_base_onelev_mat_asb.f90 | 16 +- .../impl/level/mld_s_base_onelev_mat_asb.f90 | 16 +- .../impl/level/mld_z_base_onelev_mat_asb.f90 | 16 +- mlprec/impl/mld_c_extprol_bld.f90 | 286 +++++++++--------- mlprec/impl/mld_d_extprol_bld.f90 | 286 +++++++++--------- mlprec/impl/mld_s_extprol_bld.f90 | 286 +++++++++--------- mlprec/impl/mld_z_extprol_bld.f90 | 286 +++++++++--------- .../impl/solver/mld_c_mumps_solver_apply.F90 | 2 +- .../solver/mld_c_mumps_solver_apply_vect.F90 | 2 +- mlprec/impl/solver/mld_c_mumps_solver_bld.F90 | 2 +- .../impl/solver/mld_d_mumps_solver_apply.F90 | 2 +- .../solver/mld_d_mumps_solver_apply_vect.F90 | 2 +- mlprec/impl/solver/mld_d_mumps_solver_bld.F90 | 2 +- .../impl/solver/mld_s_mumps_solver_apply.F90 | 2 +- .../solver/mld_s_mumps_solver_apply_vect.F90 | 2 +- mlprec/impl/solver/mld_s_mumps_solver_bld.F90 | 2 +- .../impl/solver/mld_z_mumps_solver_apply.F90 | 2 +- .../solver/mld_z_mumps_solver_apply_vect.F90 | 2 +- mlprec/impl/solver/mld_z_mumps_solver_bld.F90 | 2 +- mlprec/mld_c_mumps_solver.F90 | 4 +- mlprec/mld_c_slu_solver.F90 | 2 +- mlprec/mld_d_mumps_solver.F90 | 4 +- mlprec/mld_d_slu_solver.F90 | 2 +- mlprec/mld_d_sludist_solver.F90 | 2 +- mlprec/mld_d_umf_solver.F90 | 2 +- mlprec/mld_s_mumps_solver.F90 | 4 +- mlprec/mld_s_slu_solver.F90 | 2 +- mlprec/mld_z_mumps_solver.F90 | 4 +- mlprec/mld_z_slu_solver.F90 | 2 +- mlprec/mld_z_sludist_solver.F90 | 2 +- mlprec/mld_z_umf_solver.F90 | 2 +- .../mld_d_bcmatch_aggregator_mat_asb.f90 | 10 +- .../mld_d_bcmatch_aggregator_tprol.f90 | 10 +- 46 files changed, 698 insertions(+), 690 deletions(-) diff --git a/mlprec/impl/aggregator/mld_c_dec_aggregator_mat_asb.f90 b/mlprec/impl/aggregator/mld_c_dec_aggregator_mat_asb.f90 index 0cce1101..7aac8cd9 100644 --- a/mlprec/impl/aggregator/mld_c_dec_aggregator_mat_asb.f90 +++ b/mlprec/impl/aggregator/mld_c_dec_aggregator_mat_asb.f90 @@ -146,12 +146,12 @@ subroutine mld_c_dec_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,ac,op_p integer(psb_ipk_), intent(out) :: info ! Local variables - character(len=20) :: name - integer(psb_mpik_) :: ictxt, np, me + character(len=20) :: name + integer(psb_mpk_) :: ictxt, np, me type(psb_c_coo_sparse_mat) :: acoo, bcoo type(psb_c_csr_sparse_mat) :: acsr1 integer(psb_ipk_) :: nzl,ntaggr - integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: err_act integer(psb_ipk_) :: debug_level, debug_unit name='mld_c_dec_aggregator_mat_asb' diff --git a/mlprec/impl/aggregator/mld_c_dec_aggregator_tprol.f90 b/mlprec/impl/aggregator/mld_c_dec_aggregator_tprol.f90 index efe66b9a..ae7ed737 100644 --- a/mlprec/impl/aggregator/mld_c_dec_aggregator_tprol.f90 +++ b/mlprec/impl/aggregator/mld_c_dec_aggregator_tprol.f90 @@ -86,11 +86,11 @@ subroutine mld_c_dec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_ integer(psb_ipk_), intent(out) :: info ! Local variables - character(len=20) :: name - integer(psb_mpik_) :: ictxt, np, me - integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ntaggr - integer(psb_ipk_) :: debug_level, debug_unit + character(len=20) :: name + integer(psb_mpk_) :: ictxt, np, me + integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: ntaggr + integer(psb_ipk_) :: debug_level, debug_unit name='mld_c_dec_aggregator_tprol' if (psb_get_errstatus().ne.0) return diff --git a/mlprec/impl/aggregator/mld_c_symdec_aggregator_tprol.f90 b/mlprec/impl/aggregator/mld_c_symdec_aggregator_tprol.f90 index 594831f4..e210baed 100644 --- a/mlprec/impl/aggregator/mld_c_symdec_aggregator_tprol.f90 +++ b/mlprec/impl/aggregator/mld_c_symdec_aggregator_tprol.f90 @@ -90,11 +90,11 @@ subroutine mld_c_symdec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr, ! Local variables type(psb_cspmat_type) :: atmp, atrans - character(len=20) :: name - integer(psb_mpik_) :: ictxt, np, me - integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ntaggr, nr - integer(psb_ipk_) :: debug_level, debug_unit + character(len=20) :: name + integer(psb_mpk_) :: ictxt, np, me + integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: ntaggr, nr + integer(psb_ipk_) :: debug_level, debug_unit name='mld_c_symdec_aggregator_tprol' if (psb_get_errstatus().ne.0) return diff --git a/mlprec/impl/aggregator/mld_d_dec_aggregator_mat_asb.f90 b/mlprec/impl/aggregator/mld_d_dec_aggregator_mat_asb.f90 index 9f14fad1..024c66bf 100644 --- a/mlprec/impl/aggregator/mld_d_dec_aggregator_mat_asb.f90 +++ b/mlprec/impl/aggregator/mld_d_dec_aggregator_mat_asb.f90 @@ -146,12 +146,12 @@ subroutine mld_d_dec_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,ac,op_p integer(psb_ipk_), intent(out) :: info ! Local variables - character(len=20) :: name - integer(psb_mpik_) :: ictxt, np, me + character(len=20) :: name + integer(psb_mpk_) :: ictxt, np, me type(psb_d_coo_sparse_mat) :: acoo, bcoo type(psb_d_csr_sparse_mat) :: acsr1 integer(psb_ipk_) :: nzl,ntaggr - integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: err_act integer(psb_ipk_) :: debug_level, debug_unit name='mld_d_dec_aggregator_mat_asb' diff --git a/mlprec/impl/aggregator/mld_d_dec_aggregator_tprol.f90 b/mlprec/impl/aggregator/mld_d_dec_aggregator_tprol.f90 index 15a5c2c7..38420cb3 100644 --- a/mlprec/impl/aggregator/mld_d_dec_aggregator_tprol.f90 +++ b/mlprec/impl/aggregator/mld_d_dec_aggregator_tprol.f90 @@ -86,11 +86,11 @@ subroutine mld_d_dec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_ integer(psb_ipk_), intent(out) :: info ! Local variables - character(len=20) :: name - integer(psb_mpik_) :: ictxt, np, me - integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ntaggr - integer(psb_ipk_) :: debug_level, debug_unit + character(len=20) :: name + integer(psb_mpk_) :: ictxt, np, me + integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: ntaggr + integer(psb_ipk_) :: debug_level, debug_unit name='mld_d_dec_aggregator_tprol' if (psb_get_errstatus().ne.0) return diff --git a/mlprec/impl/aggregator/mld_d_symdec_aggregator_tprol.f90 b/mlprec/impl/aggregator/mld_d_symdec_aggregator_tprol.f90 index b3079bdf..e17b6447 100644 --- a/mlprec/impl/aggregator/mld_d_symdec_aggregator_tprol.f90 +++ b/mlprec/impl/aggregator/mld_d_symdec_aggregator_tprol.f90 @@ -90,11 +90,11 @@ subroutine mld_d_symdec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr, ! Local variables type(psb_dspmat_type) :: atmp, atrans - character(len=20) :: name - integer(psb_mpik_) :: ictxt, np, me - integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ntaggr, nr - integer(psb_ipk_) :: debug_level, debug_unit + character(len=20) :: name + integer(psb_mpk_) :: ictxt, np, me + integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: ntaggr, nr + integer(psb_ipk_) :: debug_level, debug_unit name='mld_d_symdec_aggregator_tprol' if (psb_get_errstatus().ne.0) return diff --git a/mlprec/impl/aggregator/mld_s_dec_aggregator_mat_asb.f90 b/mlprec/impl/aggregator/mld_s_dec_aggregator_mat_asb.f90 index e632f8fa..039ea897 100644 --- a/mlprec/impl/aggregator/mld_s_dec_aggregator_mat_asb.f90 +++ b/mlprec/impl/aggregator/mld_s_dec_aggregator_mat_asb.f90 @@ -146,12 +146,12 @@ subroutine mld_s_dec_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,ac,op_p integer(psb_ipk_), intent(out) :: info ! Local variables - character(len=20) :: name - integer(psb_mpik_) :: ictxt, np, me + character(len=20) :: name + integer(psb_mpk_) :: ictxt, np, me type(psb_s_coo_sparse_mat) :: acoo, bcoo type(psb_s_csr_sparse_mat) :: acsr1 integer(psb_ipk_) :: nzl,ntaggr - integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: err_act integer(psb_ipk_) :: debug_level, debug_unit name='mld_s_dec_aggregator_mat_asb' diff --git a/mlprec/impl/aggregator/mld_s_dec_aggregator_tprol.f90 b/mlprec/impl/aggregator/mld_s_dec_aggregator_tprol.f90 index 02552a10..7523ddd2 100644 --- a/mlprec/impl/aggregator/mld_s_dec_aggregator_tprol.f90 +++ b/mlprec/impl/aggregator/mld_s_dec_aggregator_tprol.f90 @@ -86,11 +86,11 @@ subroutine mld_s_dec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_ integer(psb_ipk_), intent(out) :: info ! Local variables - character(len=20) :: name - integer(psb_mpik_) :: ictxt, np, me - integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ntaggr - integer(psb_ipk_) :: debug_level, debug_unit + character(len=20) :: name + integer(psb_mpk_) :: ictxt, np, me + integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: ntaggr + integer(psb_ipk_) :: debug_level, debug_unit name='mld_s_dec_aggregator_tprol' if (psb_get_errstatus().ne.0) return diff --git a/mlprec/impl/aggregator/mld_s_symdec_aggregator_tprol.f90 b/mlprec/impl/aggregator/mld_s_symdec_aggregator_tprol.f90 index a19f5344..da250d58 100644 --- a/mlprec/impl/aggregator/mld_s_symdec_aggregator_tprol.f90 +++ b/mlprec/impl/aggregator/mld_s_symdec_aggregator_tprol.f90 @@ -90,11 +90,11 @@ subroutine mld_s_symdec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr, ! Local variables type(psb_sspmat_type) :: atmp, atrans - character(len=20) :: name - integer(psb_mpik_) :: ictxt, np, me - integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ntaggr, nr - integer(psb_ipk_) :: debug_level, debug_unit + character(len=20) :: name + integer(psb_mpk_) :: ictxt, np, me + integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: ntaggr, nr + integer(psb_ipk_) :: debug_level, debug_unit name='mld_s_symdec_aggregator_tprol' if (psb_get_errstatus().ne.0) return diff --git a/mlprec/impl/aggregator/mld_z_dec_aggregator_mat_asb.f90 b/mlprec/impl/aggregator/mld_z_dec_aggregator_mat_asb.f90 index 6d85871b..9400044b 100644 --- a/mlprec/impl/aggregator/mld_z_dec_aggregator_mat_asb.f90 +++ b/mlprec/impl/aggregator/mld_z_dec_aggregator_mat_asb.f90 @@ -146,12 +146,12 @@ subroutine mld_z_dec_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,ac,op_p integer(psb_ipk_), intent(out) :: info ! Local variables - character(len=20) :: name - integer(psb_mpik_) :: ictxt, np, me + character(len=20) :: name + integer(psb_mpk_) :: ictxt, np, me type(psb_z_coo_sparse_mat) :: acoo, bcoo type(psb_z_csr_sparse_mat) :: acsr1 integer(psb_ipk_) :: nzl,ntaggr - integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: err_act integer(psb_ipk_) :: debug_level, debug_unit name='mld_z_dec_aggregator_mat_asb' diff --git a/mlprec/impl/aggregator/mld_z_dec_aggregator_tprol.f90 b/mlprec/impl/aggregator/mld_z_dec_aggregator_tprol.f90 index aeac2317..fe90b75b 100644 --- a/mlprec/impl/aggregator/mld_z_dec_aggregator_tprol.f90 +++ b/mlprec/impl/aggregator/mld_z_dec_aggregator_tprol.f90 @@ -86,11 +86,11 @@ subroutine mld_z_dec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_ integer(psb_ipk_), intent(out) :: info ! Local variables - character(len=20) :: name - integer(psb_mpik_) :: ictxt, np, me - integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ntaggr - integer(psb_ipk_) :: debug_level, debug_unit + character(len=20) :: name + integer(psb_mpk_) :: ictxt, np, me + integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: ntaggr + integer(psb_ipk_) :: debug_level, debug_unit name='mld_z_dec_aggregator_tprol' if (psb_get_errstatus().ne.0) return diff --git a/mlprec/impl/aggregator/mld_z_symdec_aggregator_tprol.f90 b/mlprec/impl/aggregator/mld_z_symdec_aggregator_tprol.f90 index eb619419..22fb34c6 100644 --- a/mlprec/impl/aggregator/mld_z_symdec_aggregator_tprol.f90 +++ b/mlprec/impl/aggregator/mld_z_symdec_aggregator_tprol.f90 @@ -90,11 +90,11 @@ subroutine mld_z_symdec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr, ! Local variables type(psb_zspmat_type) :: atmp, atrans - character(len=20) :: name - integer(psb_mpik_) :: ictxt, np, me - integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: ntaggr, nr - integer(psb_ipk_) :: debug_level, debug_unit + character(len=20) :: name + integer(psb_mpk_) :: ictxt, np, me + integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: ntaggr, nr + integer(psb_ipk_) :: debug_level, debug_unit name='mld_z_symdec_aggregator_tprol' if (psb_get_errstatus().ne.0) return diff --git a/mlprec/impl/level/mld_c_base_onelev_mat_asb.f90 b/mlprec/impl/level/mld_c_base_onelev_mat_asb.f90 index 0985cb35..00232512 100644 --- a/mlprec/impl/level/mld_c_base_onelev_mat_asb.f90 +++ b/mlprec/impl/level/mld_c_base_onelev_mat_asb.f90 @@ -95,8 +95,9 @@ subroutine mld_c_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info) class(mld_c_onelev_type), intent(inout), target :: lv type(psb_cspmat_type), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(inout) :: ilaggr(:),nlaggr(:) - type(psb_cspmat_type), intent(inout) :: op_prol + integer(psb_ipk_), intent(inout) :: nlaggr(:) + integer(psb_lpk_), intent(inout) :: ilaggr(:) + type(psb_lcspmat_type), intent(inout) :: op_prol integer(psb_ipk_), intent(out) :: info @@ -104,10 +105,11 @@ subroutine mld_c_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info) character(len=24) :: name integer(psb_mpk_) :: ictxt, np, me integer(psb_ipk_) :: err_act - type(psb_cspmat_type) :: ac, op_restr - type(psb_c_coo_sparse_mat) :: acoo, bcoo - type(psb_c_csr_sparse_mat) :: acsr1 - integer(psb_ipk_) :: nzl, ntaggr + type(psb_lcspmat_type) :: lac, op_restr + type(psb_cspmat_type) :: ac + type(psb_lc_coo_sparse_mat) :: acoo, bcoo + type(psb_lc_csr_sparse_mat) :: acsr1 + integer(psb_lpk_) :: nzl, ntaggr integer(psb_ipk_) :: debug_level, debug_unit name='mld_c_onelev_mat_asb' @@ -137,7 +139,7 @@ subroutine mld_c_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info) ! the mapping defined by mld_aggrmap_bld and applying the aggregation ! algorithm specified by lv%iprcparm(mld_aggr_prol_) ! - call lv%aggr%mat_asb(lv%parms,a,desc_a,ilaggr,nlaggr,ac,op_prol,op_restr,info) + ! call lv%aggr%mat_asb(lv%parms,a,desc_a,ilaggr,nlaggr,ac,op_prol,op_restr,info) if(info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_aggrmat_asb') diff --git a/mlprec/impl/level/mld_d_base_onelev_mat_asb.f90 b/mlprec/impl/level/mld_d_base_onelev_mat_asb.f90 index 381a3225..90b91bd9 100644 --- a/mlprec/impl/level/mld_d_base_onelev_mat_asb.f90 +++ b/mlprec/impl/level/mld_d_base_onelev_mat_asb.f90 @@ -95,8 +95,9 @@ subroutine mld_d_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info) class(mld_d_onelev_type), intent(inout), target :: lv type(psb_dspmat_type), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(inout) :: ilaggr(:),nlaggr(:) - type(psb_dspmat_type), intent(inout) :: op_prol + integer(psb_ipk_), intent(inout) :: nlaggr(:) + integer(psb_lpk_), intent(inout) :: ilaggr(:) + type(psb_ldspmat_type), intent(inout) :: op_prol integer(psb_ipk_), intent(out) :: info @@ -104,10 +105,11 @@ subroutine mld_d_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info) character(len=24) :: name integer(psb_mpk_) :: ictxt, np, me integer(psb_ipk_) :: err_act - type(psb_dspmat_type) :: ac, op_restr - type(psb_d_coo_sparse_mat) :: acoo, bcoo - type(psb_d_csr_sparse_mat) :: acsr1 - integer(psb_ipk_) :: nzl, ntaggr + type(psb_ldspmat_type) :: lac, op_restr + type(psb_dspmat_type) :: ac + type(psb_ld_coo_sparse_mat) :: acoo, bcoo + type(psb_ld_csr_sparse_mat) :: acsr1 + integer(psb_lpk_) :: nzl, ntaggr integer(psb_ipk_) :: debug_level, debug_unit name='mld_d_onelev_mat_asb' @@ -137,7 +139,7 @@ subroutine mld_d_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info) ! the mapping defined by mld_aggrmap_bld and applying the aggregation ! algorithm specified by lv%iprcparm(mld_aggr_prol_) ! - call lv%aggr%mat_asb(lv%parms,a,desc_a,ilaggr,nlaggr,ac,op_prol,op_restr,info) + ! call lv%aggr%mat_asb(lv%parms,a,desc_a,ilaggr,nlaggr,ac,op_prol,op_restr,info) if(info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_aggrmat_asb') diff --git a/mlprec/impl/level/mld_s_base_onelev_mat_asb.f90 b/mlprec/impl/level/mld_s_base_onelev_mat_asb.f90 index 7f6319cb..ac37a44d 100644 --- a/mlprec/impl/level/mld_s_base_onelev_mat_asb.f90 +++ b/mlprec/impl/level/mld_s_base_onelev_mat_asb.f90 @@ -95,8 +95,9 @@ subroutine mld_s_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info) class(mld_s_onelev_type), intent(inout), target :: lv type(psb_sspmat_type), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(inout) :: ilaggr(:),nlaggr(:) - type(psb_sspmat_type), intent(inout) :: op_prol + integer(psb_ipk_), intent(inout) :: nlaggr(:) + integer(psb_lpk_), intent(inout) :: ilaggr(:) + type(psb_lsspmat_type), intent(inout) :: op_prol integer(psb_ipk_), intent(out) :: info @@ -104,10 +105,11 @@ subroutine mld_s_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info) character(len=24) :: name integer(psb_mpk_) :: ictxt, np, me integer(psb_ipk_) :: err_act - type(psb_sspmat_type) :: ac, op_restr - type(psb_s_coo_sparse_mat) :: acoo, bcoo - type(psb_s_csr_sparse_mat) :: acsr1 - integer(psb_ipk_) :: nzl, ntaggr + type(psb_lsspmat_type) :: lac, op_restr + type(psb_sspmat_type) :: ac + type(psb_ls_coo_sparse_mat) :: acoo, bcoo + type(psb_ls_csr_sparse_mat) :: acsr1 + integer(psb_lpk_) :: nzl, ntaggr integer(psb_ipk_) :: debug_level, debug_unit name='mld_s_onelev_mat_asb' @@ -137,7 +139,7 @@ subroutine mld_s_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info) ! the mapping defined by mld_aggrmap_bld and applying the aggregation ! algorithm specified by lv%iprcparm(mld_aggr_prol_) ! - call lv%aggr%mat_asb(lv%parms,a,desc_a,ilaggr,nlaggr,ac,op_prol,op_restr,info) + ! call lv%aggr%mat_asb(lv%parms,a,desc_a,ilaggr,nlaggr,ac,op_prol,op_restr,info) if(info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_aggrmat_asb') diff --git a/mlprec/impl/level/mld_z_base_onelev_mat_asb.f90 b/mlprec/impl/level/mld_z_base_onelev_mat_asb.f90 index 190896fa..4e9f19aa 100644 --- a/mlprec/impl/level/mld_z_base_onelev_mat_asb.f90 +++ b/mlprec/impl/level/mld_z_base_onelev_mat_asb.f90 @@ -95,8 +95,9 @@ subroutine mld_z_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info) class(mld_z_onelev_type), intent(inout), target :: lv type(psb_zspmat_type), intent(in) :: a type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(inout) :: ilaggr(:),nlaggr(:) - type(psb_zspmat_type), intent(inout) :: op_prol + integer(psb_ipk_), intent(inout) :: nlaggr(:) + integer(psb_lpk_), intent(inout) :: ilaggr(:) + type(psb_lzspmat_type), intent(inout) :: op_prol integer(psb_ipk_), intent(out) :: info @@ -104,10 +105,11 @@ subroutine mld_z_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info) character(len=24) :: name integer(psb_mpk_) :: ictxt, np, me integer(psb_ipk_) :: err_act - type(psb_zspmat_type) :: ac, op_restr - type(psb_z_coo_sparse_mat) :: acoo, bcoo - type(psb_z_csr_sparse_mat) :: acsr1 - integer(psb_ipk_) :: nzl, ntaggr + type(psb_lzspmat_type) :: lac, op_restr + type(psb_zspmat_type) :: ac + type(psb_lz_coo_sparse_mat) :: acoo, bcoo + type(psb_lz_csr_sparse_mat) :: acsr1 + integer(psb_lpk_) :: nzl, ntaggr integer(psb_ipk_) :: debug_level, debug_unit name='mld_z_onelev_mat_asb' @@ -137,7 +139,7 @@ subroutine mld_z_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info) ! the mapping defined by mld_aggrmap_bld and applying the aggregation ! algorithm specified by lv%iprcparm(mld_aggr_prol_) ! - call lv%aggr%mat_asb(lv%parms,a,desc_a,ilaggr,nlaggr,ac,op_prol,op_restr,info) + ! call lv%aggr%mat_asb(lv%parms,a,desc_a,ilaggr,nlaggr,ac,op_prol,op_restr,info) if(info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_aggrmat_asb') diff --git a/mlprec/impl/mld_c_extprol_bld.f90 b/mlprec/impl/mld_c_extprol_bld.f90 index f28e1556..e2994423 100644 --- a/mlprec/impl/mld_c_extprol_bld.f90 +++ b/mlprec/impl/mld_c_extprol_bld.f90 @@ -363,149 +363,149 @@ contains allocate(nlaggr(np),ilaggr(1)) nlaggr = 0 ilaggr = 0 - p%parms%par_aggr_alg = mld_ext_aggr_ - call mld_check_def(p%parms%ml_cycle,'Multilevel cycle',& - & mld_mult_ml_,is_legal_ml_cycle) - call mld_check_def(p%parms%coarse_mat,'Coarse matrix',& - & mld_distr_mat_,is_legal_ml_coarse_mat) - - nlaggr(me+1) = op_restr%get_nrows() - if (op_restr%get_nrows() /= op_prol%get_ncols()) then - info=psb_err_internal_error_ - call psb_errpush(info,name,a_err='Inconsistent restr/prol sizes') - goto 9999 - end if - call psb_sum(ictxt,nlaggr) - ntaggr = sum(nlaggr) - ncol = desc_a%get_local_cols() - if (debug) write(0,*)me,' Sizes:',op_restr%get_nrows(),op_restr%get_ncols(),& - & op_prol%get_nrows(),op_prol%get_ncols(), a%get_nrows(),a%get_ncols() - ! - ! Compute local part of AC - ! - call op_prol%clone(am2,info) - if (info == psb_success_) call psb_sphalo(am2,desc_a,am4,info,& - & colcnv=.false.,rowscale=.true.) - if (info == psb_success_) call psb_rwextd(ncol,am2,info,b=am4) - if (info == psb_success_) call am4%free() - call psb_spspmm(a,am2,am3,info) - if(info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2') - goto 9999 - end if - call psb_sphalo(am3,desc_a,am4,info,& - & colcnv=.false.,rowscale=.true.) - if (info == psb_success_) call psb_rwextd(ncol,am3,info,b=am4) - if (info == psb_success_) call am4%free() - if(info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,a_err='Extend am3') - goto 9999 - end if - call psb_spspmm(op_restr,am3,ac,info) - if (info == psb_success_) call am3%free() - if (info == psb_success_) call ac%cscnv(info,type='csr',dupl=psb_dupl_add_) - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,a_err='Build ac = op_restr x am3') - goto 9999 - end if - - select case(p%parms%coarse_mat) - - case(mld_distr_mat_) - - call ac%mv_to(bcoo) - nzl = bcoo%get_nzeros() - - if (info == psb_success_) call psb_cdall(ictxt,p%desc_ac,info,nl=nlaggr(me+1)) - if (info == psb_success_) call psb_cdins(nzl,bcoo%ia,bcoo%ja,p%desc_ac,info) - if (info == psb_success_) call psb_cdasb(p%desc_ac,info) - if (info == psb_success_) call psb_glob_to_loc(bcoo%ia(1:nzl),p%desc_ac,info,iact='I') - if (info == psb_success_) call psb_glob_to_loc(bcoo%ja(1:nzl),p%desc_ac,info,iact='I') - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Creating p%desc_ac and converting ac') - goto 9999 - end if - if (debug_level >= psb_debug_outer_) & - & write(debug_unit,*) me,' ',trim(name),& - & 'Assembld aux descr. distr.' - call p%ac%mv_from(bcoo) - - call p%ac%set_nrows(p%desc_ac%get_local_rows()) - call p%ac%set_ncols(p%desc_ac%get_local_cols()) - call p%ac%set_asb() - - if (info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_sp_free') - goto 9999 - end if - - if (np>1) then - call op_prol%mv_to(acsr1) - nzl = acsr1%get_nzeros() - call psb_glob_to_loc(acsr1%ja(1:nzl),p%desc_ac,info,'I') - if(info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_glob_to_loc') - goto 9999 - end if - call op_prol%mv_from(acsr1) - endif - call op_prol%set_ncols(p%desc_ac%get_local_cols()) - - if (np>1) then - call op_restr%cscnv(info,type='coo',dupl=psb_dupl_add_) - call op_restr%mv_to(acoo) - nzl = acoo%get_nzeros() - if (info == psb_success_) call psb_glob_to_loc(acoo%ia(1:nzl),p%desc_ac,info,'I') - call acoo%set_dupl(psb_dupl_add_) - if (info == psb_success_) call op_restr%mv_from(acoo) - if (info == psb_success_) call op_restr%cscnv(info,type='csr') - if(info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Converting op_restr to local') - goto 9999 - end if - end if - call op_restr%set_nrows(p%desc_ac%get_local_cols()) - - if (debug_level >= psb_debug_outer_) & - & write(debug_unit,*) me,' ',trim(name),& - & 'Done ac ' - - case(mld_repl_mat_) - ! - ! - call psb_cdall(ictxt,p%desc_ac,info,mg=ntaggr,repl=.true.) - if (info == psb_success_) call psb_cdasb(p%desc_ac,info) - if (info == psb_success_) & - & call psb_gather(p%ac,ac,p%desc_ac,info,dupl=psb_dupl_add_,keeploc=.false.) - - if (info /= psb_success_) goto 9999 - - case default - info = psb_err_internal_error_ - call psb_errpush(info,name,a_err='invalid mld_coarse_mat_') - goto 9999 - end select - - call p%ac%cscnv(info,type='csr',dupl=psb_dupl_add_) - if(info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv') - goto 9999 - end if - - ! - ! Copy the prolongation/restriction matrices into the descriptor map. - ! op_restr => PR^T i.e. restriction operator - ! op_prol => PR i.e. prolongation operator - ! - - p%map = psb_linmap(psb_map_aggr_,desc_a,& - & p%desc_ac,op_restr,op_prol,ilaggr,nlaggr) - if(info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_Free') - goto 9999 - end if +!!$ p%parms%par_aggr_alg = mld_ext_aggr_ +!!$ call mld_check_def(p%parms%ml_cycle,'Multilevel cycle',& +!!$ & mld_mult_ml_,is_legal_ml_cycle) +!!$ call mld_check_def(p%parms%coarse_mat,'Coarse matrix',& +!!$ & mld_distr_mat_,is_legal_ml_coarse_mat) +!!$ +!!$ nlaggr(me+1) = op_restr%get_nrows() +!!$ if (op_restr%get_nrows() /= op_prol%get_ncols()) then +!!$ info=psb_err_internal_error_ +!!$ call psb_errpush(info,name,a_err='Inconsistent restr/prol sizes') +!!$ goto 9999 +!!$ end if +!!$ call psb_sum(ictxt,nlaggr) +!!$ ntaggr = sum(nlaggr) +!!$ ncol = desc_a%get_local_cols() +!!$ if (debug) write(0,*)me,' Sizes:',op_restr%get_nrows(),op_restr%get_ncols(),& +!!$ & op_prol%get_nrows(),op_prol%get_ncols(), a%get_nrows(),a%get_ncols() +!!$ ! +!!$ ! Compute local part of AC +!!$ ! +!!$ call op_prol%clone(am2,info) +!!$ if (info == psb_success_) call psb_sphalo(am2,desc_a,am4,info,& +!!$ & colcnv=.false.,rowscale=.true.) +!!$ if (info == psb_success_) call psb_rwextd(ncol,am2,info,b=am4) +!!$ if (info == psb_success_) call am4%free() +!!$ call psb_spspmm(a,am2,am3,info) +!!$ if(info /= psb_success_) then +!!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2') +!!$ goto 9999 +!!$ end if +!!$ call psb_sphalo(am3,desc_a,am4,info,& +!!$ & colcnv=.false.,rowscale=.true.) +!!$ if (info == psb_success_) call psb_rwextd(ncol,am3,info,b=am4) +!!$ if (info == psb_success_) call am4%free() +!!$ if(info /= psb_success_) then +!!$ call psb_errpush(psb_err_internal_error_,name,a_err='Extend am3') +!!$ goto 9999 +!!$ end if +!!$ call psb_spspmm(op_restr,am3,ac,info) +!!$ if (info == psb_success_) call am3%free() +!!$ if (info == psb_success_) call ac%cscnv(info,type='csr',dupl=psb_dupl_add_) +!!$ if (info /= psb_success_) then +!!$ call psb_errpush(psb_err_internal_error_,name,a_err='Build ac = op_restr x am3') +!!$ goto 9999 +!!$ end if +!!$ +!!$ select case(p%parms%coarse_mat) +!!$ +!!$ case(mld_distr_mat_) +!!$ +!!$ call ac%mv_to(bcoo) +!!$ nzl = bcoo%get_nzeros() +!!$ +!!$ if (info == psb_success_) call psb_cdall(ictxt,p%desc_ac,info,nl=nlaggr(me+1)) +!!$ if (info == psb_success_) call psb_cdins(nzl,bcoo%ia,bcoo%ja,p%desc_ac,info) +!!$ if (info == psb_success_) call psb_cdasb(p%desc_ac,info) +!!$ if (info == psb_success_) call psb_glob_to_loc(bcoo%ia(1:nzl),p%desc_ac,info,iact='I') +!!$ if (info == psb_success_) call psb_glob_to_loc(bcoo%ja(1:nzl),p%desc_ac,info,iact='I') +!!$ if (info /= psb_success_) then +!!$ call psb_errpush(psb_err_internal_error_,name,& +!!$ & a_err='Creating p%desc_ac and converting ac') +!!$ goto 9999 +!!$ end if +!!$ if (debug_level >= psb_debug_outer_) & +!!$ & write(debug_unit,*) me,' ',trim(name),& +!!$ & 'Assembld aux descr. distr.' +!!$ call p%ac%mv_from(bcoo) +!!$ +!!$ call p%ac%set_nrows(p%desc_ac%get_local_rows()) +!!$ call p%ac%set_ncols(p%desc_ac%get_local_cols()) +!!$ call p%ac%set_asb() +!!$ +!!$ if (info /= psb_success_) then +!!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_sp_free') +!!$ goto 9999 +!!$ end if +!!$ +!!$ if (np>1) then +!!$ call op_prol%mv_to(acsr1) +!!$ nzl = acsr1%get_nzeros() +!!$ call psb_glob_to_loc(acsr1%ja(1:nzl),p%desc_ac,info,'I') +!!$ if(info /= psb_success_) then +!!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_glob_to_loc') +!!$ goto 9999 +!!$ end if +!!$ call op_prol%mv_from(acsr1) +!!$ endif +!!$ call op_prol%set_ncols(p%desc_ac%get_local_cols()) +!!$ +!!$ if (np>1) then +!!$ call op_restr%cscnv(info,type='coo',dupl=psb_dupl_add_) +!!$ call op_restr%mv_to(acoo) +!!$ nzl = acoo%get_nzeros() +!!$ if (info == psb_success_) call psb_glob_to_loc(acoo%ia(1:nzl),p%desc_ac,info,'I') +!!$ call acoo%set_dupl(psb_dupl_add_) +!!$ if (info == psb_success_) call op_restr%mv_from(acoo) +!!$ if (info == psb_success_) call op_restr%cscnv(info,type='csr') +!!$ if(info /= psb_success_) then +!!$ call psb_errpush(psb_err_internal_error_,name,& +!!$ & a_err='Converting op_restr to local') +!!$ goto 9999 +!!$ end if +!!$ end if +!!$ call op_restr%set_nrows(p%desc_ac%get_local_cols()) +!!$ +!!$ if (debug_level >= psb_debug_outer_) & +!!$ & write(debug_unit,*) me,' ',trim(name),& +!!$ & 'Done ac ' +!!$ +!!$ case(mld_repl_mat_) +!!$ ! +!!$ ! +!!$ call psb_cdall(ictxt,p%desc_ac,info,mg=ntaggr,repl=.true.) +!!$ if (info == psb_success_) call psb_cdasb(p%desc_ac,info) +!!$ if (info == psb_success_) & +!!$ & call psb_gather(p%ac,ac,p%desc_ac,info,dupl=psb_dupl_add_,keeploc=.false.) +!!$ +!!$ if (info /= psb_success_) goto 9999 +!!$ +!!$ case default +!!$ info = psb_err_internal_error_ +!!$ call psb_errpush(info,name,a_err='invalid mld_coarse_mat_') +!!$ goto 9999 +!!$ end select +!!$ +!!$ call p%ac%cscnv(info,type='csr',dupl=psb_dupl_add_) +!!$ if(info /= psb_success_) then +!!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv') +!!$ goto 9999 +!!$ end if +!!$ +!!$ ! +!!$ ! Copy the prolongation/restriction matrices into the descriptor map. +!!$ ! op_restr => PR^T i.e. restriction operator +!!$ ! op_prol => PR i.e. prolongation operator +!!$ ! +!!$ +!!$ p%map = psb_linmap(psb_map_aggr_,desc_a,& +!!$ & p%desc_ac,op_restr,op_prol,ilaggr,nlaggr) +!!$ if(info /= psb_success_) then +!!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_Free') +!!$ goto 9999 +!!$ end if call psb_erractionrestore(err_act) return diff --git a/mlprec/impl/mld_d_extprol_bld.f90 b/mlprec/impl/mld_d_extprol_bld.f90 index e7a13942..3a9ae05d 100644 --- a/mlprec/impl/mld_d_extprol_bld.f90 +++ b/mlprec/impl/mld_d_extprol_bld.f90 @@ -363,149 +363,149 @@ contains allocate(nlaggr(np),ilaggr(1)) nlaggr = 0 ilaggr = 0 - p%parms%par_aggr_alg = mld_ext_aggr_ - call mld_check_def(p%parms%ml_cycle,'Multilevel cycle',& - & mld_mult_ml_,is_legal_ml_cycle) - call mld_check_def(p%parms%coarse_mat,'Coarse matrix',& - & mld_distr_mat_,is_legal_ml_coarse_mat) - - nlaggr(me+1) = op_restr%get_nrows() - if (op_restr%get_nrows() /= op_prol%get_ncols()) then - info=psb_err_internal_error_ - call psb_errpush(info,name,a_err='Inconsistent restr/prol sizes') - goto 9999 - end if - call psb_sum(ictxt,nlaggr) - ntaggr = sum(nlaggr) - ncol = desc_a%get_local_cols() - if (debug) write(0,*)me,' Sizes:',op_restr%get_nrows(),op_restr%get_ncols(),& - & op_prol%get_nrows(),op_prol%get_ncols(), a%get_nrows(),a%get_ncols() - ! - ! Compute local part of AC - ! - call op_prol%clone(am2,info) - if (info == psb_success_) call psb_sphalo(am2,desc_a,am4,info,& - & colcnv=.false.,rowscale=.true.) - if (info == psb_success_) call psb_rwextd(ncol,am2,info,b=am4) - if (info == psb_success_) call am4%free() - call psb_spspmm(a,am2,am3,info) - if(info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2') - goto 9999 - end if - call psb_sphalo(am3,desc_a,am4,info,& - & colcnv=.false.,rowscale=.true.) - if (info == psb_success_) call psb_rwextd(ncol,am3,info,b=am4) - if (info == psb_success_) call am4%free() - if(info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,a_err='Extend am3') - goto 9999 - end if - call psb_spspmm(op_restr,am3,ac,info) - if (info == psb_success_) call am3%free() - if (info == psb_success_) call ac%cscnv(info,type='csr',dupl=psb_dupl_add_) - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,a_err='Build ac = op_restr x am3') - goto 9999 - end if - - select case(p%parms%coarse_mat) - - case(mld_distr_mat_) - - call ac%mv_to(bcoo) - nzl = bcoo%get_nzeros() - - if (info == psb_success_) call psb_cdall(ictxt,p%desc_ac,info,nl=nlaggr(me+1)) - if (info == psb_success_) call psb_cdins(nzl,bcoo%ia,bcoo%ja,p%desc_ac,info) - if (info == psb_success_) call psb_cdasb(p%desc_ac,info) - if (info == psb_success_) call psb_glob_to_loc(bcoo%ia(1:nzl),p%desc_ac,info,iact='I') - if (info == psb_success_) call psb_glob_to_loc(bcoo%ja(1:nzl),p%desc_ac,info,iact='I') - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Creating p%desc_ac and converting ac') - goto 9999 - end if - if (debug_level >= psb_debug_outer_) & - & write(debug_unit,*) me,' ',trim(name),& - & 'Assembld aux descr. distr.' - call p%ac%mv_from(bcoo) - - call p%ac%set_nrows(p%desc_ac%get_local_rows()) - call p%ac%set_ncols(p%desc_ac%get_local_cols()) - call p%ac%set_asb() - - if (info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_sp_free') - goto 9999 - end if - - if (np>1) then - call op_prol%mv_to(acsr1) - nzl = acsr1%get_nzeros() - call psb_glob_to_loc(acsr1%ja(1:nzl),p%desc_ac,info,'I') - if(info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_glob_to_loc') - goto 9999 - end if - call op_prol%mv_from(acsr1) - endif - call op_prol%set_ncols(p%desc_ac%get_local_cols()) - - if (np>1) then - call op_restr%cscnv(info,type='coo',dupl=psb_dupl_add_) - call op_restr%mv_to(acoo) - nzl = acoo%get_nzeros() - if (info == psb_success_) call psb_glob_to_loc(acoo%ia(1:nzl),p%desc_ac,info,'I') - call acoo%set_dupl(psb_dupl_add_) - if (info == psb_success_) call op_restr%mv_from(acoo) - if (info == psb_success_) call op_restr%cscnv(info,type='csr') - if(info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Converting op_restr to local') - goto 9999 - end if - end if - call op_restr%set_nrows(p%desc_ac%get_local_cols()) - - if (debug_level >= psb_debug_outer_) & - & write(debug_unit,*) me,' ',trim(name),& - & 'Done ac ' - - case(mld_repl_mat_) - ! - ! - call psb_cdall(ictxt,p%desc_ac,info,mg=ntaggr,repl=.true.) - if (info == psb_success_) call psb_cdasb(p%desc_ac,info) - if (info == psb_success_) & - & call psb_gather(p%ac,ac,p%desc_ac,info,dupl=psb_dupl_add_,keeploc=.false.) - - if (info /= psb_success_) goto 9999 - - case default - info = psb_err_internal_error_ - call psb_errpush(info,name,a_err='invalid mld_coarse_mat_') - goto 9999 - end select - - call p%ac%cscnv(info,type='csr',dupl=psb_dupl_add_) - if(info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv') - goto 9999 - end if - - ! - ! Copy the prolongation/restriction matrices into the descriptor map. - ! op_restr => PR^T i.e. restriction operator - ! op_prol => PR i.e. prolongation operator - ! - - p%map = psb_linmap(psb_map_aggr_,desc_a,& - & p%desc_ac,op_restr,op_prol,ilaggr,nlaggr) - if(info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_Free') - goto 9999 - end if +!!$ p%parms%par_aggr_alg = mld_ext_aggr_ +!!$ call mld_check_def(p%parms%ml_cycle,'Multilevel cycle',& +!!$ & mld_mult_ml_,is_legal_ml_cycle) +!!$ call mld_check_def(p%parms%coarse_mat,'Coarse matrix',& +!!$ & mld_distr_mat_,is_legal_ml_coarse_mat) +!!$ +!!$ nlaggr(me+1) = op_restr%get_nrows() +!!$ if (op_restr%get_nrows() /= op_prol%get_ncols()) then +!!$ info=psb_err_internal_error_ +!!$ call psb_errpush(info,name,a_err='Inconsistent restr/prol sizes') +!!$ goto 9999 +!!$ end if +!!$ call psb_sum(ictxt,nlaggr) +!!$ ntaggr = sum(nlaggr) +!!$ ncol = desc_a%get_local_cols() +!!$ if (debug) write(0,*)me,' Sizes:',op_restr%get_nrows(),op_restr%get_ncols(),& +!!$ & op_prol%get_nrows(),op_prol%get_ncols(), a%get_nrows(),a%get_ncols() +!!$ ! +!!$ ! Compute local part of AC +!!$ ! +!!$ call op_prol%clone(am2,info) +!!$ if (info == psb_success_) call psb_sphalo(am2,desc_a,am4,info,& +!!$ & colcnv=.false.,rowscale=.true.) +!!$ if (info == psb_success_) call psb_rwextd(ncol,am2,info,b=am4) +!!$ if (info == psb_success_) call am4%free() +!!$ call psb_spspmm(a,am2,am3,info) +!!$ if(info /= psb_success_) then +!!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2') +!!$ goto 9999 +!!$ end if +!!$ call psb_sphalo(am3,desc_a,am4,info,& +!!$ & colcnv=.false.,rowscale=.true.) +!!$ if (info == psb_success_) call psb_rwextd(ncol,am3,info,b=am4) +!!$ if (info == psb_success_) call am4%free() +!!$ if(info /= psb_success_) then +!!$ call psb_errpush(psb_err_internal_error_,name,a_err='Extend am3') +!!$ goto 9999 +!!$ end if +!!$ call psb_spspmm(op_restr,am3,ac,info) +!!$ if (info == psb_success_) call am3%free() +!!$ if (info == psb_success_) call ac%cscnv(info,type='csr',dupl=psb_dupl_add_) +!!$ if (info /= psb_success_) then +!!$ call psb_errpush(psb_err_internal_error_,name,a_err='Build ac = op_restr x am3') +!!$ goto 9999 +!!$ end if +!!$ +!!$ select case(p%parms%coarse_mat) +!!$ +!!$ case(mld_distr_mat_) +!!$ +!!$ call ac%mv_to(bcoo) +!!$ nzl = bcoo%get_nzeros() +!!$ +!!$ if (info == psb_success_) call psb_cdall(ictxt,p%desc_ac,info,nl=nlaggr(me+1)) +!!$ if (info == psb_success_) call psb_cdins(nzl,bcoo%ia,bcoo%ja,p%desc_ac,info) +!!$ if (info == psb_success_) call psb_cdasb(p%desc_ac,info) +!!$ if (info == psb_success_) call psb_glob_to_loc(bcoo%ia(1:nzl),p%desc_ac,info,iact='I') +!!$ if (info == psb_success_) call psb_glob_to_loc(bcoo%ja(1:nzl),p%desc_ac,info,iact='I') +!!$ if (info /= psb_success_) then +!!$ call psb_errpush(psb_err_internal_error_,name,& +!!$ & a_err='Creating p%desc_ac and converting ac') +!!$ goto 9999 +!!$ end if +!!$ if (debug_level >= psb_debug_outer_) & +!!$ & write(debug_unit,*) me,' ',trim(name),& +!!$ & 'Assembld aux descr. distr.' +!!$ call p%ac%mv_from(bcoo) +!!$ +!!$ call p%ac%set_nrows(p%desc_ac%get_local_rows()) +!!$ call p%ac%set_ncols(p%desc_ac%get_local_cols()) +!!$ call p%ac%set_asb() +!!$ +!!$ if (info /= psb_success_) then +!!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_sp_free') +!!$ goto 9999 +!!$ end if +!!$ +!!$ if (np>1) then +!!$ call op_prol%mv_to(acsr1) +!!$ nzl = acsr1%get_nzeros() +!!$ call psb_glob_to_loc(acsr1%ja(1:nzl),p%desc_ac,info,'I') +!!$ if(info /= psb_success_) then +!!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_glob_to_loc') +!!$ goto 9999 +!!$ end if +!!$ call op_prol%mv_from(acsr1) +!!$ endif +!!$ call op_prol%set_ncols(p%desc_ac%get_local_cols()) +!!$ +!!$ if (np>1) then +!!$ call op_restr%cscnv(info,type='coo',dupl=psb_dupl_add_) +!!$ call op_restr%mv_to(acoo) +!!$ nzl = acoo%get_nzeros() +!!$ if (info == psb_success_) call psb_glob_to_loc(acoo%ia(1:nzl),p%desc_ac,info,'I') +!!$ call acoo%set_dupl(psb_dupl_add_) +!!$ if (info == psb_success_) call op_restr%mv_from(acoo) +!!$ if (info == psb_success_) call op_restr%cscnv(info,type='csr') +!!$ if(info /= psb_success_) then +!!$ call psb_errpush(psb_err_internal_error_,name,& +!!$ & a_err='Converting op_restr to local') +!!$ goto 9999 +!!$ end if +!!$ end if +!!$ call op_restr%set_nrows(p%desc_ac%get_local_cols()) +!!$ +!!$ if (debug_level >= psb_debug_outer_) & +!!$ & write(debug_unit,*) me,' ',trim(name),& +!!$ & 'Done ac ' +!!$ +!!$ case(mld_repl_mat_) +!!$ ! +!!$ ! +!!$ call psb_cdall(ictxt,p%desc_ac,info,mg=ntaggr,repl=.true.) +!!$ if (info == psb_success_) call psb_cdasb(p%desc_ac,info) +!!$ if (info == psb_success_) & +!!$ & call psb_gather(p%ac,ac,p%desc_ac,info,dupl=psb_dupl_add_,keeploc=.false.) +!!$ +!!$ if (info /= psb_success_) goto 9999 +!!$ +!!$ case default +!!$ info = psb_err_internal_error_ +!!$ call psb_errpush(info,name,a_err='invalid mld_coarse_mat_') +!!$ goto 9999 +!!$ end select +!!$ +!!$ call p%ac%cscnv(info,type='csr',dupl=psb_dupl_add_) +!!$ if(info /= psb_success_) then +!!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv') +!!$ goto 9999 +!!$ end if +!!$ +!!$ ! +!!$ ! Copy the prolongation/restriction matrices into the descriptor map. +!!$ ! op_restr => PR^T i.e. restriction operator +!!$ ! op_prol => PR i.e. prolongation operator +!!$ ! +!!$ +!!$ p%map = psb_linmap(psb_map_aggr_,desc_a,& +!!$ & p%desc_ac,op_restr,op_prol,ilaggr,nlaggr) +!!$ if(info /= psb_success_) then +!!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_Free') +!!$ goto 9999 +!!$ end if call psb_erractionrestore(err_act) return diff --git a/mlprec/impl/mld_s_extprol_bld.f90 b/mlprec/impl/mld_s_extprol_bld.f90 index 4feb6d82..0b745d31 100644 --- a/mlprec/impl/mld_s_extprol_bld.f90 +++ b/mlprec/impl/mld_s_extprol_bld.f90 @@ -363,149 +363,149 @@ contains allocate(nlaggr(np),ilaggr(1)) nlaggr = 0 ilaggr = 0 - p%parms%par_aggr_alg = mld_ext_aggr_ - call mld_check_def(p%parms%ml_cycle,'Multilevel cycle',& - & mld_mult_ml_,is_legal_ml_cycle) - call mld_check_def(p%parms%coarse_mat,'Coarse matrix',& - & mld_distr_mat_,is_legal_ml_coarse_mat) - - nlaggr(me+1) = op_restr%get_nrows() - if (op_restr%get_nrows() /= op_prol%get_ncols()) then - info=psb_err_internal_error_ - call psb_errpush(info,name,a_err='Inconsistent restr/prol sizes') - goto 9999 - end if - call psb_sum(ictxt,nlaggr) - ntaggr = sum(nlaggr) - ncol = desc_a%get_local_cols() - if (debug) write(0,*)me,' Sizes:',op_restr%get_nrows(),op_restr%get_ncols(),& - & op_prol%get_nrows(),op_prol%get_ncols(), a%get_nrows(),a%get_ncols() - ! - ! Compute local part of AC - ! - call op_prol%clone(am2,info) - if (info == psb_success_) call psb_sphalo(am2,desc_a,am4,info,& - & colcnv=.false.,rowscale=.true.) - if (info == psb_success_) call psb_rwextd(ncol,am2,info,b=am4) - if (info == psb_success_) call am4%free() - call psb_spspmm(a,am2,am3,info) - if(info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2') - goto 9999 - end if - call psb_sphalo(am3,desc_a,am4,info,& - & colcnv=.false.,rowscale=.true.) - if (info == psb_success_) call psb_rwextd(ncol,am3,info,b=am4) - if (info == psb_success_) call am4%free() - if(info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,a_err='Extend am3') - goto 9999 - end if - call psb_spspmm(op_restr,am3,ac,info) - if (info == psb_success_) call am3%free() - if (info == psb_success_) call ac%cscnv(info,type='csr',dupl=psb_dupl_add_) - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,a_err='Build ac = op_restr x am3') - goto 9999 - end if - - select case(p%parms%coarse_mat) - - case(mld_distr_mat_) - - call ac%mv_to(bcoo) - nzl = bcoo%get_nzeros() - - if (info == psb_success_) call psb_cdall(ictxt,p%desc_ac,info,nl=nlaggr(me+1)) - if (info == psb_success_) call psb_cdins(nzl,bcoo%ia,bcoo%ja,p%desc_ac,info) - if (info == psb_success_) call psb_cdasb(p%desc_ac,info) - if (info == psb_success_) call psb_glob_to_loc(bcoo%ia(1:nzl),p%desc_ac,info,iact='I') - if (info == psb_success_) call psb_glob_to_loc(bcoo%ja(1:nzl),p%desc_ac,info,iact='I') - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Creating p%desc_ac and converting ac') - goto 9999 - end if - if (debug_level >= psb_debug_outer_) & - & write(debug_unit,*) me,' ',trim(name),& - & 'Assembld aux descr. distr.' - call p%ac%mv_from(bcoo) - - call p%ac%set_nrows(p%desc_ac%get_local_rows()) - call p%ac%set_ncols(p%desc_ac%get_local_cols()) - call p%ac%set_asb() - - if (info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_sp_free') - goto 9999 - end if - - if (np>1) then - call op_prol%mv_to(acsr1) - nzl = acsr1%get_nzeros() - call psb_glob_to_loc(acsr1%ja(1:nzl),p%desc_ac,info,'I') - if(info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_glob_to_loc') - goto 9999 - end if - call op_prol%mv_from(acsr1) - endif - call op_prol%set_ncols(p%desc_ac%get_local_cols()) - - if (np>1) then - call op_restr%cscnv(info,type='coo',dupl=psb_dupl_add_) - call op_restr%mv_to(acoo) - nzl = acoo%get_nzeros() - if (info == psb_success_) call psb_glob_to_loc(acoo%ia(1:nzl),p%desc_ac,info,'I') - call acoo%set_dupl(psb_dupl_add_) - if (info == psb_success_) call op_restr%mv_from(acoo) - if (info == psb_success_) call op_restr%cscnv(info,type='csr') - if(info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Converting op_restr to local') - goto 9999 - end if - end if - call op_restr%set_nrows(p%desc_ac%get_local_cols()) - - if (debug_level >= psb_debug_outer_) & - & write(debug_unit,*) me,' ',trim(name),& - & 'Done ac ' - - case(mld_repl_mat_) - ! - ! - call psb_cdall(ictxt,p%desc_ac,info,mg=ntaggr,repl=.true.) - if (info == psb_success_) call psb_cdasb(p%desc_ac,info) - if (info == psb_success_) & - & call psb_gather(p%ac,ac,p%desc_ac,info,dupl=psb_dupl_add_,keeploc=.false.) - - if (info /= psb_success_) goto 9999 - - case default - info = psb_err_internal_error_ - call psb_errpush(info,name,a_err='invalid mld_coarse_mat_') - goto 9999 - end select - - call p%ac%cscnv(info,type='csr',dupl=psb_dupl_add_) - if(info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv') - goto 9999 - end if - - ! - ! Copy the prolongation/restriction matrices into the descriptor map. - ! op_restr => PR^T i.e. restriction operator - ! op_prol => PR i.e. prolongation operator - ! - - p%map = psb_linmap(psb_map_aggr_,desc_a,& - & p%desc_ac,op_restr,op_prol,ilaggr,nlaggr) - if(info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_Free') - goto 9999 - end if +!!$ p%parms%par_aggr_alg = mld_ext_aggr_ +!!$ call mld_check_def(p%parms%ml_cycle,'Multilevel cycle',& +!!$ & mld_mult_ml_,is_legal_ml_cycle) +!!$ call mld_check_def(p%parms%coarse_mat,'Coarse matrix',& +!!$ & mld_distr_mat_,is_legal_ml_coarse_mat) +!!$ +!!$ nlaggr(me+1) = op_restr%get_nrows() +!!$ if (op_restr%get_nrows() /= op_prol%get_ncols()) then +!!$ info=psb_err_internal_error_ +!!$ call psb_errpush(info,name,a_err='Inconsistent restr/prol sizes') +!!$ goto 9999 +!!$ end if +!!$ call psb_sum(ictxt,nlaggr) +!!$ ntaggr = sum(nlaggr) +!!$ ncol = desc_a%get_local_cols() +!!$ if (debug) write(0,*)me,' Sizes:',op_restr%get_nrows(),op_restr%get_ncols(),& +!!$ & op_prol%get_nrows(),op_prol%get_ncols(), a%get_nrows(),a%get_ncols() +!!$ ! +!!$ ! Compute local part of AC +!!$ ! +!!$ call op_prol%clone(am2,info) +!!$ if (info == psb_success_) call psb_sphalo(am2,desc_a,am4,info,& +!!$ & colcnv=.false.,rowscale=.true.) +!!$ if (info == psb_success_) call psb_rwextd(ncol,am2,info,b=am4) +!!$ if (info == psb_success_) call am4%free() +!!$ call psb_spspmm(a,am2,am3,info) +!!$ if(info /= psb_success_) then +!!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2') +!!$ goto 9999 +!!$ end if +!!$ call psb_sphalo(am3,desc_a,am4,info,& +!!$ & colcnv=.false.,rowscale=.true.) +!!$ if (info == psb_success_) call psb_rwextd(ncol,am3,info,b=am4) +!!$ if (info == psb_success_) call am4%free() +!!$ if(info /= psb_success_) then +!!$ call psb_errpush(psb_err_internal_error_,name,a_err='Extend am3') +!!$ goto 9999 +!!$ end if +!!$ call psb_spspmm(op_restr,am3,ac,info) +!!$ if (info == psb_success_) call am3%free() +!!$ if (info == psb_success_) call ac%cscnv(info,type='csr',dupl=psb_dupl_add_) +!!$ if (info /= psb_success_) then +!!$ call psb_errpush(psb_err_internal_error_,name,a_err='Build ac = op_restr x am3') +!!$ goto 9999 +!!$ end if +!!$ +!!$ select case(p%parms%coarse_mat) +!!$ +!!$ case(mld_distr_mat_) +!!$ +!!$ call ac%mv_to(bcoo) +!!$ nzl = bcoo%get_nzeros() +!!$ +!!$ if (info == psb_success_) call psb_cdall(ictxt,p%desc_ac,info,nl=nlaggr(me+1)) +!!$ if (info == psb_success_) call psb_cdins(nzl,bcoo%ia,bcoo%ja,p%desc_ac,info) +!!$ if (info == psb_success_) call psb_cdasb(p%desc_ac,info) +!!$ if (info == psb_success_) call psb_glob_to_loc(bcoo%ia(1:nzl),p%desc_ac,info,iact='I') +!!$ if (info == psb_success_) call psb_glob_to_loc(bcoo%ja(1:nzl),p%desc_ac,info,iact='I') +!!$ if (info /= psb_success_) then +!!$ call psb_errpush(psb_err_internal_error_,name,& +!!$ & a_err='Creating p%desc_ac and converting ac') +!!$ goto 9999 +!!$ end if +!!$ if (debug_level >= psb_debug_outer_) & +!!$ & write(debug_unit,*) me,' ',trim(name),& +!!$ & 'Assembld aux descr. distr.' +!!$ call p%ac%mv_from(bcoo) +!!$ +!!$ call p%ac%set_nrows(p%desc_ac%get_local_rows()) +!!$ call p%ac%set_ncols(p%desc_ac%get_local_cols()) +!!$ call p%ac%set_asb() +!!$ +!!$ if (info /= psb_success_) then +!!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_sp_free') +!!$ goto 9999 +!!$ end if +!!$ +!!$ if (np>1) then +!!$ call op_prol%mv_to(acsr1) +!!$ nzl = acsr1%get_nzeros() +!!$ call psb_glob_to_loc(acsr1%ja(1:nzl),p%desc_ac,info,'I') +!!$ if(info /= psb_success_) then +!!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_glob_to_loc') +!!$ goto 9999 +!!$ end if +!!$ call op_prol%mv_from(acsr1) +!!$ endif +!!$ call op_prol%set_ncols(p%desc_ac%get_local_cols()) +!!$ +!!$ if (np>1) then +!!$ call op_restr%cscnv(info,type='coo',dupl=psb_dupl_add_) +!!$ call op_restr%mv_to(acoo) +!!$ nzl = acoo%get_nzeros() +!!$ if (info == psb_success_) call psb_glob_to_loc(acoo%ia(1:nzl),p%desc_ac,info,'I') +!!$ call acoo%set_dupl(psb_dupl_add_) +!!$ if (info == psb_success_) call op_restr%mv_from(acoo) +!!$ if (info == psb_success_) call op_restr%cscnv(info,type='csr') +!!$ if(info /= psb_success_) then +!!$ call psb_errpush(psb_err_internal_error_,name,& +!!$ & a_err='Converting op_restr to local') +!!$ goto 9999 +!!$ end if +!!$ end if +!!$ call op_restr%set_nrows(p%desc_ac%get_local_cols()) +!!$ +!!$ if (debug_level >= psb_debug_outer_) & +!!$ & write(debug_unit,*) me,' ',trim(name),& +!!$ & 'Done ac ' +!!$ +!!$ case(mld_repl_mat_) +!!$ ! +!!$ ! +!!$ call psb_cdall(ictxt,p%desc_ac,info,mg=ntaggr,repl=.true.) +!!$ if (info == psb_success_) call psb_cdasb(p%desc_ac,info) +!!$ if (info == psb_success_) & +!!$ & call psb_gather(p%ac,ac,p%desc_ac,info,dupl=psb_dupl_add_,keeploc=.false.) +!!$ +!!$ if (info /= psb_success_) goto 9999 +!!$ +!!$ case default +!!$ info = psb_err_internal_error_ +!!$ call psb_errpush(info,name,a_err='invalid mld_coarse_mat_') +!!$ goto 9999 +!!$ end select +!!$ +!!$ call p%ac%cscnv(info,type='csr',dupl=psb_dupl_add_) +!!$ if(info /= psb_success_) then +!!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv') +!!$ goto 9999 +!!$ end if +!!$ +!!$ ! +!!$ ! Copy the prolongation/restriction matrices into the descriptor map. +!!$ ! op_restr => PR^T i.e. restriction operator +!!$ ! op_prol => PR i.e. prolongation operator +!!$ ! +!!$ +!!$ p%map = psb_linmap(psb_map_aggr_,desc_a,& +!!$ & p%desc_ac,op_restr,op_prol,ilaggr,nlaggr) +!!$ if(info /= psb_success_) then +!!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_Free') +!!$ goto 9999 +!!$ end if call psb_erractionrestore(err_act) return diff --git a/mlprec/impl/mld_z_extprol_bld.f90 b/mlprec/impl/mld_z_extprol_bld.f90 index 95a1ff27..e91e861f 100644 --- a/mlprec/impl/mld_z_extprol_bld.f90 +++ b/mlprec/impl/mld_z_extprol_bld.f90 @@ -363,149 +363,149 @@ contains allocate(nlaggr(np),ilaggr(1)) nlaggr = 0 ilaggr = 0 - p%parms%par_aggr_alg = mld_ext_aggr_ - call mld_check_def(p%parms%ml_cycle,'Multilevel cycle',& - & mld_mult_ml_,is_legal_ml_cycle) - call mld_check_def(p%parms%coarse_mat,'Coarse matrix',& - & mld_distr_mat_,is_legal_ml_coarse_mat) - - nlaggr(me+1) = op_restr%get_nrows() - if (op_restr%get_nrows() /= op_prol%get_ncols()) then - info=psb_err_internal_error_ - call psb_errpush(info,name,a_err='Inconsistent restr/prol sizes') - goto 9999 - end if - call psb_sum(ictxt,nlaggr) - ntaggr = sum(nlaggr) - ncol = desc_a%get_local_cols() - if (debug) write(0,*)me,' Sizes:',op_restr%get_nrows(),op_restr%get_ncols(),& - & op_prol%get_nrows(),op_prol%get_ncols(), a%get_nrows(),a%get_ncols() - ! - ! Compute local part of AC - ! - call op_prol%clone(am2,info) - if (info == psb_success_) call psb_sphalo(am2,desc_a,am4,info,& - & colcnv=.false.,rowscale=.true.) - if (info == psb_success_) call psb_rwextd(ncol,am2,info,b=am4) - if (info == psb_success_) call am4%free() - call psb_spspmm(a,am2,am3,info) - if(info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2') - goto 9999 - end if - call psb_sphalo(am3,desc_a,am4,info,& - & colcnv=.false.,rowscale=.true.) - if (info == psb_success_) call psb_rwextd(ncol,am3,info,b=am4) - if (info == psb_success_) call am4%free() - if(info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,a_err='Extend am3') - goto 9999 - end if - call psb_spspmm(op_restr,am3,ac,info) - if (info == psb_success_) call am3%free() - if (info == psb_success_) call ac%cscnv(info,type='csr',dupl=psb_dupl_add_) - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,a_err='Build ac = op_restr x am3') - goto 9999 - end if - - select case(p%parms%coarse_mat) - - case(mld_distr_mat_) - - call ac%mv_to(bcoo) - nzl = bcoo%get_nzeros() - - if (info == psb_success_) call psb_cdall(ictxt,p%desc_ac,info,nl=nlaggr(me+1)) - if (info == psb_success_) call psb_cdins(nzl,bcoo%ia,bcoo%ja,p%desc_ac,info) - if (info == psb_success_) call psb_cdasb(p%desc_ac,info) - if (info == psb_success_) call psb_glob_to_loc(bcoo%ia(1:nzl),p%desc_ac,info,iact='I') - if (info == psb_success_) call psb_glob_to_loc(bcoo%ja(1:nzl),p%desc_ac,info,iact='I') - if (info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Creating p%desc_ac and converting ac') - goto 9999 - end if - if (debug_level >= psb_debug_outer_) & - & write(debug_unit,*) me,' ',trim(name),& - & 'Assembld aux descr. distr.' - call p%ac%mv_from(bcoo) - - call p%ac%set_nrows(p%desc_ac%get_local_rows()) - call p%ac%set_ncols(p%desc_ac%get_local_cols()) - call p%ac%set_asb() - - if (info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_sp_free') - goto 9999 - end if - - if (np>1) then - call op_prol%mv_to(acsr1) - nzl = acsr1%get_nzeros() - call psb_glob_to_loc(acsr1%ja(1:nzl),p%desc_ac,info,'I') - if(info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_glob_to_loc') - goto 9999 - end if - call op_prol%mv_from(acsr1) - endif - call op_prol%set_ncols(p%desc_ac%get_local_cols()) - - if (np>1) then - call op_restr%cscnv(info,type='coo',dupl=psb_dupl_add_) - call op_restr%mv_to(acoo) - nzl = acoo%get_nzeros() - if (info == psb_success_) call psb_glob_to_loc(acoo%ia(1:nzl),p%desc_ac,info,'I') - call acoo%set_dupl(psb_dupl_add_) - if (info == psb_success_) call op_restr%mv_from(acoo) - if (info == psb_success_) call op_restr%cscnv(info,type='csr') - if(info /= psb_success_) then - call psb_errpush(psb_err_internal_error_,name,& - & a_err='Converting op_restr to local') - goto 9999 - end if - end if - call op_restr%set_nrows(p%desc_ac%get_local_cols()) - - if (debug_level >= psb_debug_outer_) & - & write(debug_unit,*) me,' ',trim(name),& - & 'Done ac ' - - case(mld_repl_mat_) - ! - ! - call psb_cdall(ictxt,p%desc_ac,info,mg=ntaggr,repl=.true.) - if (info == psb_success_) call psb_cdasb(p%desc_ac,info) - if (info == psb_success_) & - & call psb_gather(p%ac,ac,p%desc_ac,info,dupl=psb_dupl_add_,keeploc=.false.) - - if (info /= psb_success_) goto 9999 - - case default - info = psb_err_internal_error_ - call psb_errpush(info,name,a_err='invalid mld_coarse_mat_') - goto 9999 - end select - - call p%ac%cscnv(info,type='csr',dupl=psb_dupl_add_) - if(info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv') - goto 9999 - end if - - ! - ! Copy the prolongation/restriction matrices into the descriptor map. - ! op_restr => PR^T i.e. restriction operator - ! op_prol => PR i.e. prolongation operator - ! - - p%map = psb_linmap(psb_map_aggr_,desc_a,& - & p%desc_ac,op_restr,op_prol,ilaggr,nlaggr) - if(info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_Free') - goto 9999 - end if +!!$ p%parms%par_aggr_alg = mld_ext_aggr_ +!!$ call mld_check_def(p%parms%ml_cycle,'Multilevel cycle',& +!!$ & mld_mult_ml_,is_legal_ml_cycle) +!!$ call mld_check_def(p%parms%coarse_mat,'Coarse matrix',& +!!$ & mld_distr_mat_,is_legal_ml_coarse_mat) +!!$ +!!$ nlaggr(me+1) = op_restr%get_nrows() +!!$ if (op_restr%get_nrows() /= op_prol%get_ncols()) then +!!$ info=psb_err_internal_error_ +!!$ call psb_errpush(info,name,a_err='Inconsistent restr/prol sizes') +!!$ goto 9999 +!!$ end if +!!$ call psb_sum(ictxt,nlaggr) +!!$ ntaggr = sum(nlaggr) +!!$ ncol = desc_a%get_local_cols() +!!$ if (debug) write(0,*)me,' Sizes:',op_restr%get_nrows(),op_restr%get_ncols(),& +!!$ & op_prol%get_nrows(),op_prol%get_ncols(), a%get_nrows(),a%get_ncols() +!!$ ! +!!$ ! Compute local part of AC +!!$ ! +!!$ call op_prol%clone(am2,info) +!!$ if (info == psb_success_) call psb_sphalo(am2,desc_a,am4,info,& +!!$ & colcnv=.false.,rowscale=.true.) +!!$ if (info == psb_success_) call psb_rwextd(ncol,am2,info,b=am4) +!!$ if (info == psb_success_) call am4%free() +!!$ call psb_spspmm(a,am2,am3,info) +!!$ if(info /= psb_success_) then +!!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2') +!!$ goto 9999 +!!$ end if +!!$ call psb_sphalo(am3,desc_a,am4,info,& +!!$ & colcnv=.false.,rowscale=.true.) +!!$ if (info == psb_success_) call psb_rwextd(ncol,am3,info,b=am4) +!!$ if (info == psb_success_) call am4%free() +!!$ if(info /= psb_success_) then +!!$ call psb_errpush(psb_err_internal_error_,name,a_err='Extend am3') +!!$ goto 9999 +!!$ end if +!!$ call psb_spspmm(op_restr,am3,ac,info) +!!$ if (info == psb_success_) call am3%free() +!!$ if (info == psb_success_) call ac%cscnv(info,type='csr',dupl=psb_dupl_add_) +!!$ if (info /= psb_success_) then +!!$ call psb_errpush(psb_err_internal_error_,name,a_err='Build ac = op_restr x am3') +!!$ goto 9999 +!!$ end if +!!$ +!!$ select case(p%parms%coarse_mat) +!!$ +!!$ case(mld_distr_mat_) +!!$ +!!$ call ac%mv_to(bcoo) +!!$ nzl = bcoo%get_nzeros() +!!$ +!!$ if (info == psb_success_) call psb_cdall(ictxt,p%desc_ac,info,nl=nlaggr(me+1)) +!!$ if (info == psb_success_) call psb_cdins(nzl,bcoo%ia,bcoo%ja,p%desc_ac,info) +!!$ if (info == psb_success_) call psb_cdasb(p%desc_ac,info) +!!$ if (info == psb_success_) call psb_glob_to_loc(bcoo%ia(1:nzl),p%desc_ac,info,iact='I') +!!$ if (info == psb_success_) call psb_glob_to_loc(bcoo%ja(1:nzl),p%desc_ac,info,iact='I') +!!$ if (info /= psb_success_) then +!!$ call psb_errpush(psb_err_internal_error_,name,& +!!$ & a_err='Creating p%desc_ac and converting ac') +!!$ goto 9999 +!!$ end if +!!$ if (debug_level >= psb_debug_outer_) & +!!$ & write(debug_unit,*) me,' ',trim(name),& +!!$ & 'Assembld aux descr. distr.' +!!$ call p%ac%mv_from(bcoo) +!!$ +!!$ call p%ac%set_nrows(p%desc_ac%get_local_rows()) +!!$ call p%ac%set_ncols(p%desc_ac%get_local_cols()) +!!$ call p%ac%set_asb() +!!$ +!!$ if (info /= psb_success_) then +!!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_sp_free') +!!$ goto 9999 +!!$ end if +!!$ +!!$ if (np>1) then +!!$ call op_prol%mv_to(acsr1) +!!$ nzl = acsr1%get_nzeros() +!!$ call psb_glob_to_loc(acsr1%ja(1:nzl),p%desc_ac,info,'I') +!!$ if(info /= psb_success_) then +!!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='psb_glob_to_loc') +!!$ goto 9999 +!!$ end if +!!$ call op_prol%mv_from(acsr1) +!!$ endif +!!$ call op_prol%set_ncols(p%desc_ac%get_local_cols()) +!!$ +!!$ if (np>1) then +!!$ call op_restr%cscnv(info,type='coo',dupl=psb_dupl_add_) +!!$ call op_restr%mv_to(acoo) +!!$ nzl = acoo%get_nzeros() +!!$ if (info == psb_success_) call psb_glob_to_loc(acoo%ia(1:nzl),p%desc_ac,info,'I') +!!$ call acoo%set_dupl(psb_dupl_add_) +!!$ if (info == psb_success_) call op_restr%mv_from(acoo) +!!$ if (info == psb_success_) call op_restr%cscnv(info,type='csr') +!!$ if(info /= psb_success_) then +!!$ call psb_errpush(psb_err_internal_error_,name,& +!!$ & a_err='Converting op_restr to local') +!!$ goto 9999 +!!$ end if +!!$ end if +!!$ call op_restr%set_nrows(p%desc_ac%get_local_cols()) +!!$ +!!$ if (debug_level >= psb_debug_outer_) & +!!$ & write(debug_unit,*) me,' ',trim(name),& +!!$ & 'Done ac ' +!!$ +!!$ case(mld_repl_mat_) +!!$ ! +!!$ ! +!!$ call psb_cdall(ictxt,p%desc_ac,info,mg=ntaggr,repl=.true.) +!!$ if (info == psb_success_) call psb_cdasb(p%desc_ac,info) +!!$ if (info == psb_success_) & +!!$ & call psb_gather(p%ac,ac,p%desc_ac,info,dupl=psb_dupl_add_,keeploc=.false.) +!!$ +!!$ if (info /= psb_success_) goto 9999 +!!$ +!!$ case default +!!$ info = psb_err_internal_error_ +!!$ call psb_errpush(info,name,a_err='invalid mld_coarse_mat_') +!!$ goto 9999 +!!$ end select +!!$ +!!$ call p%ac%cscnv(info,type='csr',dupl=psb_dupl_add_) +!!$ if(info /= psb_success_) then +!!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='spcnv') +!!$ goto 9999 +!!$ end if +!!$ +!!$ ! +!!$ ! Copy the prolongation/restriction matrices into the descriptor map. +!!$ ! op_restr => PR^T i.e. restriction operator +!!$ ! op_prol => PR i.e. prolongation operator +!!$ ! +!!$ +!!$ p%map = psb_linmap(psb_map_aggr_,desc_a,& +!!$ & p%desc_ac,op_restr,op_prol,ilaggr,nlaggr) +!!$ if(info /= psb_success_) then +!!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_Free') +!!$ goto 9999 +!!$ end if call psb_erractionrestore(err_act) return diff --git a/mlprec/impl/solver/mld_c_mumps_solver_apply.F90 b/mlprec/impl/solver/mld_c_mumps_solver_apply.F90 index 436c3bf9..103a04bc 100644 --- a/mlprec/impl/solver/mld_c_mumps_solver_apply.F90 +++ b/mlprec/impl/solver/mld_c_mumps_solver_apply.F90 @@ -64,7 +64,7 @@ subroutine c_mumps_solver_apply(alpha,sv,x,beta,y,desc_data,& call psb_erractionsave(err_act) -#if defined(HAVE_MUMPS_) +#if defined(HAVE_MUMPS_) && !defined(LPK8) info = psb_success_ trans_ = psb_toupper(trans) select case(trans_) diff --git a/mlprec/impl/solver/mld_c_mumps_solver_apply_vect.F90 b/mlprec/impl/solver/mld_c_mumps_solver_apply_vect.F90 index 185970d5..501c1091 100644 --- a/mlprec/impl/solver/mld_c_mumps_solver_apply_vect.F90 +++ b/mlprec/impl/solver/mld_c_mumps_solver_apply_vect.F90 @@ -59,7 +59,7 @@ subroutine c_mumps_solver_apply_vect(alpha,sv,x,beta,y,desc_data,& integer(psb_ipk_) :: err_act character(len=20) :: name='c_mumps_solver_apply_vect' -#if defined(HAVE_MUMPS_) +#if defined(HAVE_MUMPS_) && !defined(LPK8) call psb_erractionsave(err_act) diff --git a/mlprec/impl/solver/mld_c_mumps_solver_bld.F90 b/mlprec/impl/solver/mld_c_mumps_solver_bld.F90 index 8a4fc85b..bf6eca7f 100644 --- a/mlprec/impl/solver/mld_c_mumps_solver_bld.F90 +++ b/mlprec/impl/solver/mld_c_mumps_solver_bld.F90 @@ -63,7 +63,7 @@ integer(psb_ipk_) :: ictxt, ictxt1, icomm, np, me, i, err_act, debug_unit, debug_level character(len=20) :: name='c_mumps_solver_bld', ch_err -#if defined(HAVE_MUMPS_) +#if defined(HAVE_MUMPS_) && !defined(LPK8) info=psb_success_ diff --git a/mlprec/impl/solver/mld_d_mumps_solver_apply.F90 b/mlprec/impl/solver/mld_d_mumps_solver_apply.F90 index 3900d211..d153995d 100644 --- a/mlprec/impl/solver/mld_d_mumps_solver_apply.F90 +++ b/mlprec/impl/solver/mld_d_mumps_solver_apply.F90 @@ -64,7 +64,7 @@ subroutine d_mumps_solver_apply(alpha,sv,x,beta,y,desc_data,& call psb_erractionsave(err_act) -#if defined(HAVE_MUMPS_) +#if defined(HAVE_MUMPS_) && !defined(LPK8) info = psb_success_ trans_ = psb_toupper(trans) select case(trans_) diff --git a/mlprec/impl/solver/mld_d_mumps_solver_apply_vect.F90 b/mlprec/impl/solver/mld_d_mumps_solver_apply_vect.F90 index 56013ba7..10986d9d 100644 --- a/mlprec/impl/solver/mld_d_mumps_solver_apply_vect.F90 +++ b/mlprec/impl/solver/mld_d_mumps_solver_apply_vect.F90 @@ -59,7 +59,7 @@ subroutine d_mumps_solver_apply_vect(alpha,sv,x,beta,y,desc_data,& integer(psb_ipk_) :: err_act character(len=20) :: name='d_mumps_solver_apply_vect' -#if defined(HAVE_MUMPS_) +#if defined(HAVE_MUMPS_) && !defined(LPK8) call psb_erractionsave(err_act) diff --git a/mlprec/impl/solver/mld_d_mumps_solver_bld.F90 b/mlprec/impl/solver/mld_d_mumps_solver_bld.F90 index 3f51d193..8cabf43c 100644 --- a/mlprec/impl/solver/mld_d_mumps_solver_bld.F90 +++ b/mlprec/impl/solver/mld_d_mumps_solver_bld.F90 @@ -63,7 +63,7 @@ integer(psb_ipk_) :: ictxt, ictxt1, icomm, np, me, i, err_act, debug_unit, debug_level character(len=20) :: name='d_mumps_solver_bld', ch_err -#if defined(HAVE_MUMPS_) +#if defined(HAVE_MUMPS_) && !defined(LPK8) info=psb_success_ diff --git a/mlprec/impl/solver/mld_s_mumps_solver_apply.F90 b/mlprec/impl/solver/mld_s_mumps_solver_apply.F90 index f0fae77d..ae8717f0 100644 --- a/mlprec/impl/solver/mld_s_mumps_solver_apply.F90 +++ b/mlprec/impl/solver/mld_s_mumps_solver_apply.F90 @@ -64,7 +64,7 @@ subroutine s_mumps_solver_apply(alpha,sv,x,beta,y,desc_data,& call psb_erractionsave(err_act) -#if defined(HAVE_MUMPS_) +#if defined(HAVE_MUMPS_) && !defined(LPK8) info = psb_success_ trans_ = psb_toupper(trans) select case(trans_) diff --git a/mlprec/impl/solver/mld_s_mumps_solver_apply_vect.F90 b/mlprec/impl/solver/mld_s_mumps_solver_apply_vect.F90 index 59fad283..600f8da0 100644 --- a/mlprec/impl/solver/mld_s_mumps_solver_apply_vect.F90 +++ b/mlprec/impl/solver/mld_s_mumps_solver_apply_vect.F90 @@ -59,7 +59,7 @@ subroutine s_mumps_solver_apply_vect(alpha,sv,x,beta,y,desc_data,& integer(psb_ipk_) :: err_act character(len=20) :: name='s_mumps_solver_apply_vect' -#if defined(HAVE_MUMPS_) +#if defined(HAVE_MUMPS_) && !defined(LPK8) call psb_erractionsave(err_act) diff --git a/mlprec/impl/solver/mld_s_mumps_solver_bld.F90 b/mlprec/impl/solver/mld_s_mumps_solver_bld.F90 index 664823f5..aff6ffd1 100644 --- a/mlprec/impl/solver/mld_s_mumps_solver_bld.F90 +++ b/mlprec/impl/solver/mld_s_mumps_solver_bld.F90 @@ -63,7 +63,7 @@ integer(psb_ipk_) :: ictxt, ictxt1, icomm, np, me, i, err_act, debug_unit, debug_level character(len=20) :: name='s_mumps_solver_bld', ch_err -#if defined(HAVE_MUMPS_) +#if defined(HAVE_MUMPS_) && !defined(LPK8) info=psb_success_ diff --git a/mlprec/impl/solver/mld_z_mumps_solver_apply.F90 b/mlprec/impl/solver/mld_z_mumps_solver_apply.F90 index 252e4c3a..a1a25f0c 100644 --- a/mlprec/impl/solver/mld_z_mumps_solver_apply.F90 +++ b/mlprec/impl/solver/mld_z_mumps_solver_apply.F90 @@ -64,7 +64,7 @@ subroutine z_mumps_solver_apply(alpha,sv,x,beta,y,desc_data,& call psb_erractionsave(err_act) -#if defined(HAVE_MUMPS_) +#if defined(HAVE_MUMPS_) && !defined(LPK8) info = psb_success_ trans_ = psb_toupper(trans) select case(trans_) diff --git a/mlprec/impl/solver/mld_z_mumps_solver_apply_vect.F90 b/mlprec/impl/solver/mld_z_mumps_solver_apply_vect.F90 index 29db13b8..810c51f4 100644 --- a/mlprec/impl/solver/mld_z_mumps_solver_apply_vect.F90 +++ b/mlprec/impl/solver/mld_z_mumps_solver_apply_vect.F90 @@ -59,7 +59,7 @@ subroutine z_mumps_solver_apply_vect(alpha,sv,x,beta,y,desc_data,& integer(psb_ipk_) :: err_act character(len=20) :: name='z_mumps_solver_apply_vect' -#if defined(HAVE_MUMPS_) +#if defined(HAVE_MUMPS_) && !defined(LPK8) call psb_erractionsave(err_act) diff --git a/mlprec/impl/solver/mld_z_mumps_solver_bld.F90 b/mlprec/impl/solver/mld_z_mumps_solver_bld.F90 index 77bc4682..f03f84a0 100644 --- a/mlprec/impl/solver/mld_z_mumps_solver_bld.F90 +++ b/mlprec/impl/solver/mld_z_mumps_solver_bld.F90 @@ -63,7 +63,7 @@ integer(psb_ipk_) :: ictxt, ictxt1, icomm, np, me, i, err_act, debug_unit, debug_level character(len=20) :: name='z_mumps_solver_bld', ch_err -#if defined(HAVE_MUMPS_) +#if defined(HAVE_MUMPS_) && !defined(LPK8) info=psb_success_ diff --git a/mlprec/mld_c_mumps_solver.F90 b/mlprec/mld_c_mumps_solver.F90 index 0e59552c..3cd0fdda 100644 --- a/mlprec/mld_c_mumps_solver.F90 +++ b/mlprec/mld_c_mumps_solver.F90 @@ -55,7 +55,7 @@ module mld_c_mumps_solver #endif use mld_c_base_solver_mod -#if defined(LONG_INTEGERS) +#if defined(LPK8) type, extends(mld_c_base_solver_type) :: mld_c_mumps_solver_type @@ -480,7 +480,6 @@ contains ! val = val + sv%numsize return end function c_mumps_solver_sizeof -#endif function c_mumps_get_fmt() result(val) implicit none @@ -495,6 +494,7 @@ contains val = mld_mumps_ end function c_mumps_get_id +#endif end module mld_c_mumps_solver diff --git a/mlprec/mld_c_slu_solver.F90 b/mlprec/mld_c_slu_solver.F90 index fd7b69a0..4802728c 100644 --- a/mlprec/mld_c_slu_solver.F90 +++ b/mlprec/mld_c_slu_solver.F90 @@ -51,7 +51,7 @@ module mld_c_slu_solver use iso_c_binding use mld_c_base_solver_mod -#if defined(LONG_INTEGERS) +#if defined(LPK8) type, extends(mld_c_base_solver_type) :: mld_c_slu_solver_type diff --git a/mlprec/mld_d_mumps_solver.F90 b/mlprec/mld_d_mumps_solver.F90 index 37de156f..c032da4f 100644 --- a/mlprec/mld_d_mumps_solver.F90 +++ b/mlprec/mld_d_mumps_solver.F90 @@ -55,7 +55,7 @@ module mld_d_mumps_solver #endif use mld_d_base_solver_mod -#if defined(LONG_INTEGERS) +#if defined(LPK8) type, extends(mld_d_base_solver_type) :: mld_d_mumps_solver_type @@ -480,7 +480,6 @@ contains ! val = val + sv%numsize return end function d_mumps_solver_sizeof -#endif function d_mumps_get_fmt() result(val) implicit none @@ -495,6 +494,7 @@ contains val = mld_mumps_ end function d_mumps_get_id +#endif end module mld_d_mumps_solver diff --git a/mlprec/mld_d_slu_solver.F90 b/mlprec/mld_d_slu_solver.F90 index fa267f5a..b92937a3 100644 --- a/mlprec/mld_d_slu_solver.F90 +++ b/mlprec/mld_d_slu_solver.F90 @@ -51,7 +51,7 @@ module mld_d_slu_solver use iso_c_binding use mld_d_base_solver_mod -#if defined(LONG_INTEGERS) +#if defined(LPK8) type, extends(mld_d_base_solver_type) :: mld_d_slu_solver_type diff --git a/mlprec/mld_d_sludist_solver.F90 b/mlprec/mld_d_sludist_solver.F90 index 442ab913..633e9b99 100644 --- a/mlprec/mld_d_sludist_solver.F90 +++ b/mlprec/mld_d_sludist_solver.F90 @@ -52,7 +52,7 @@ module mld_d_sludist_solver use iso_c_binding use mld_d_base_solver_mod -#if defined(LONG_INTEGERS) +#if defined(LPK8) type, extends(mld_d_base_solver_type) :: mld_d_sludist_solver_type diff --git a/mlprec/mld_d_umf_solver.F90 b/mlprec/mld_d_umf_solver.F90 index 54891e5d..24d0fb95 100644 --- a/mlprec/mld_d_umf_solver.F90 +++ b/mlprec/mld_d_umf_solver.F90 @@ -51,7 +51,7 @@ module mld_d_umf_solver use iso_c_binding use mld_d_base_solver_mod -#if defined(LONG_INTEGERS) +#if defined(LPK8) type, extends(mld_d_base_solver_type) :: mld_d_umf_solver_type end type mld_d_umf_solver_type diff --git a/mlprec/mld_s_mumps_solver.F90 b/mlprec/mld_s_mumps_solver.F90 index a4974808..7d4986bd 100644 --- a/mlprec/mld_s_mumps_solver.F90 +++ b/mlprec/mld_s_mumps_solver.F90 @@ -55,7 +55,7 @@ module mld_s_mumps_solver #endif use mld_s_base_solver_mod -#if defined(LONG_INTEGERS) +#if defined(LPK8) type, extends(mld_s_base_solver_type) :: mld_s_mumps_solver_type @@ -480,7 +480,6 @@ contains ! val = val + sv%numsize return end function s_mumps_solver_sizeof -#endif function s_mumps_get_fmt() result(val) implicit none @@ -495,6 +494,7 @@ contains val = mld_mumps_ end function s_mumps_get_id +#endif end module mld_s_mumps_solver diff --git a/mlprec/mld_s_slu_solver.F90 b/mlprec/mld_s_slu_solver.F90 index 75663fb0..d28b6124 100644 --- a/mlprec/mld_s_slu_solver.F90 +++ b/mlprec/mld_s_slu_solver.F90 @@ -51,7 +51,7 @@ module mld_s_slu_solver use iso_c_binding use mld_s_base_solver_mod -#if defined(LONG_INTEGERS) +#if defined(LPK8) type, extends(mld_s_base_solver_type) :: mld_s_slu_solver_type diff --git a/mlprec/mld_z_mumps_solver.F90 b/mlprec/mld_z_mumps_solver.F90 index efa51b33..e697d1f5 100644 --- a/mlprec/mld_z_mumps_solver.F90 +++ b/mlprec/mld_z_mumps_solver.F90 @@ -55,7 +55,7 @@ module mld_z_mumps_solver #endif use mld_z_base_solver_mod -#if defined(LONG_INTEGERS) +#if defined(LPK8) type, extends(mld_z_base_solver_type) :: mld_z_mumps_solver_type @@ -480,7 +480,6 @@ contains ! val = val + sv%numsize return end function z_mumps_solver_sizeof -#endif function z_mumps_get_fmt() result(val) implicit none @@ -495,6 +494,7 @@ contains val = mld_mumps_ end function z_mumps_get_id +#endif end module mld_z_mumps_solver diff --git a/mlprec/mld_z_slu_solver.F90 b/mlprec/mld_z_slu_solver.F90 index c2ae2a2e..3f0da8b8 100644 --- a/mlprec/mld_z_slu_solver.F90 +++ b/mlprec/mld_z_slu_solver.F90 @@ -51,7 +51,7 @@ module mld_z_slu_solver use iso_c_binding use mld_z_base_solver_mod -#if defined(LONG_INTEGERS) +#if defined(LPK8) type, extends(mld_z_base_solver_type) :: mld_z_slu_solver_type diff --git a/mlprec/mld_z_sludist_solver.F90 b/mlprec/mld_z_sludist_solver.F90 index 0f19bad0..1ddc6b2b 100644 --- a/mlprec/mld_z_sludist_solver.F90 +++ b/mlprec/mld_z_sludist_solver.F90 @@ -52,7 +52,7 @@ module mld_z_sludist_solver use iso_c_binding use mld_z_base_solver_mod -#if defined(LONG_INTEGERS) +#if defined(LPK8) type, extends(mld_z_base_solver_type) :: mld_z_sludist_solver_type diff --git a/mlprec/mld_z_umf_solver.F90 b/mlprec/mld_z_umf_solver.F90 index f5818e1d..cd88f6d9 100644 --- a/mlprec/mld_z_umf_solver.F90 +++ b/mlprec/mld_z_umf_solver.F90 @@ -51,7 +51,7 @@ module mld_z_umf_solver use iso_c_binding use mld_z_base_solver_mod -#if defined(LONG_INTEGERS) +#if defined(LPK8) type, extends(mld_z_base_solver_type) :: mld_z_umf_solver_type end type mld_z_umf_solver_type diff --git a/tests/Bcmatch/mld_d_bcmatch_aggregator_mat_asb.f90 b/tests/Bcmatch/mld_d_bcmatch_aggregator_mat_asb.f90 index 750c068b..770248a1 100644 --- a/tests/Bcmatch/mld_d_bcmatch_aggregator_mat_asb.f90 +++ b/tests/Bcmatch/mld_d_bcmatch_aggregator_mat_asb.f90 @@ -146,13 +146,13 @@ subroutine mld_d_bcmatch_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,ac, integer(psb_ipk_), intent(out) :: info ! Local variables - character(len=20) :: name - integer(psb_mpik_) :: ictxt, np, me + character(len=20) :: name + integer(psb_mpk_) :: ictxt, np, me type(psb_d_coo_sparse_mat) :: acoo, bcoo type(psb_d_csr_sparse_mat) :: acsr1 - integer(psb_ipk_) :: nzl,ntaggr - integer(psb_ipk_) :: err_act - integer(psb_ipk_) :: debug_level, debug_unit + integer(psb_ipk_) :: nzl,ntaggr + integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: debug_level, debug_unit name='mld_d_base_aggregator_mat_asb' if (psb_get_errstatus().ne.0) return diff --git a/tests/Bcmatch/mld_d_bcmatch_aggregator_tprol.f90 b/tests/Bcmatch/mld_d_bcmatch_aggregator_tprol.f90 index d6b511fe..c4f42a12 100644 --- a/tests/Bcmatch/mld_d_bcmatch_aggregator_tprol.f90 +++ b/tests/Bcmatch/mld_d_bcmatch_aggregator_tprol.f90 @@ -226,11 +226,11 @@ subroutine mld_d_bcmatch_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr type(psb_dspmat_type) :: a_tmp type(bcm_CSRMatrix) :: C, P integer(c_int) :: match_algorithm, n_sweeps, max_csize, max_nlevels - character(len=20) :: name, ch_err - integer(psb_mpik_) :: ictxt, np, me - integer(psb_ipk_) :: err_act, ierr - integer(psb_ipk_) :: debug_level, debug_unit - integer(psb_ipk_) :: i, j, k, nr, nc, isz, num_pcols + character(len=20) :: name, ch_err + integer(psb_mpk_) :: ictxt, np, me + integer(psb_ipk_) :: err_act, ierr + integer(psb_ipk_) :: debug_level, debug_unit + integer(psb_ipk_) :: i, j, k, nr, nc, isz, num_pcols type(psb_d_csr_sparse_mat), target :: acsr integer(psb_ipk_), allocatable, target :: csr_ia(:), csr_ja(:) integer(psb_ipk_), allocatable :: aux(:)