From 281c5531dadbb109a2096606585558d44b92561f Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Wed, 27 Jun 2018 17:14:50 +0100 Subject: [PATCH] More conversions. --- .../impl/aggregator/mld_caggrmat_smth_asb.f90 | 35 ++++++++++--------- .../impl/aggregator/mld_daggrmat_smth_asb.f90 | 35 ++++++++++--------- .../impl/aggregator/mld_saggrmat_smth_asb.f90 | 35 ++++++++++--------- .../impl/aggregator/mld_zaggrmat_smth_asb.f90 | 35 ++++++++++--------- 4 files changed, 76 insertions(+), 64 deletions(-) diff --git a/mlprec/impl/aggregator/mld_caggrmat_smth_asb.f90 b/mlprec/impl/aggregator/mld_caggrmat_smth_asb.f90 index c4ee3bcc..b083b827 100644 --- a/mlprec/impl/aggregator/mld_caggrmat_smth_asb.f90 +++ b/mlprec/impl/aggregator/mld_caggrmat_smth_asb.f90 @@ -117,33 +117,35 @@ subroutine mld_caggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest implicit none ! Arguments - type(psb_cspmat_type), intent(in) :: a - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(inout) :: ilaggr(:), nlaggr(:) - type(mld_sml_parms), intent(inout) :: parms - type(psb_cspmat_type), intent(inout) :: op_prol - type(psb_cspmat_type), intent(out) :: ac,op_restr - integer(psb_ipk_), intent(out) :: info + type(psb_cspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:) + type(mld_sml_parms), intent(inout) :: parms + type(psb_lcspmat_type), intent(inout) :: op_prol + type(psb_lcspmat_type), intent(out) :: ac,op_restr + integer(psb_ipk_), intent(out) :: info ! Local variables - integer(psb_ipk_) :: nrow, nglob, ncol, ntaggr, ip, ndx,& - & naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw, err_act + integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, ip, ndx,& + & naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw integer(psb_ipk_) ::ictxt, np, me character(len=20) :: name - type(psb_cspmat_type) :: am3, am4, tmp_prol - type(psb_c_coo_sparse_mat) :: tmpcoo - type(psb_c_csr_sparse_mat) :: acsr1, acsr2, acsr3, acsrf, ptilde + type(psb_lcspmat_type) :: la, am3, am4, tmp_prol + type(psb_lc_coo_sparse_mat) :: tmpcoo + type(psb_lc_csr_sparse_mat) :: acsr1, acsr2, acsr3, acsrf, ptilde complex(psb_spk_), allocatable :: adiag(:) integer(psb_ipk_) :: ierr(5) logical :: filter_mat - integer(psb_ipk_) :: debug_level, debug_unit + integer(psb_ipk_) :: debug_level, debug_unit, err_act integer(psb_ipk_), parameter :: ncmax=16 real(psb_spk_) :: anorm, omega, tmp, dg, theta name='mld_aggrmat_smth_asb' - if(psb_get_errstatus().ne.0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_; goto 9999 + end if debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() @@ -176,6 +178,7 @@ subroutine mld_caggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest & call psb_realloc(ncol,adiag,info) if (info == psb_success_) & & call psb_halo(adiag,desc_a,info) + if (info == psb_success_) call a%cp_to_l(la) if(info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_getdiag') @@ -185,7 +188,7 @@ subroutine mld_caggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest ! 1. Allocate Ptilde in sparse matrix form call op_prol%mv_to(tmpcoo) call ptilde%mv_from_coo(tmpcoo,info) - if (info == psb_success_) call a%cscnv(acsr3,info,dupl=psb_dupl_add_) + if (info == psb_success_) call la%cscnv(acsr3,info,dupl=psb_dupl_add_) if (info /= psb_success_) goto 9999 if (debug_level >= psb_debug_outer_) & @@ -342,7 +345,7 @@ subroutine mld_caggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest goto 9999 end if - call psb_spspmm(a,tmp_prol,am3,info) + call psb_spspmm(la,tmp_prol,am3,info) if(info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2') goto 9999 diff --git a/mlprec/impl/aggregator/mld_daggrmat_smth_asb.f90 b/mlprec/impl/aggregator/mld_daggrmat_smth_asb.f90 index 7a147832..774f9222 100644 --- a/mlprec/impl/aggregator/mld_daggrmat_smth_asb.f90 +++ b/mlprec/impl/aggregator/mld_daggrmat_smth_asb.f90 @@ -117,33 +117,35 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest implicit none ! Arguments - type(psb_dspmat_type), intent(in) :: a - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(inout) :: ilaggr(:), nlaggr(:) - type(mld_dml_parms), intent(inout) :: parms - type(psb_dspmat_type), intent(inout) :: op_prol - type(psb_dspmat_type), intent(out) :: ac,op_restr - integer(psb_ipk_), intent(out) :: info + type(psb_dspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:) + type(mld_dml_parms), intent(inout) :: parms + type(psb_ldspmat_type), intent(inout) :: op_prol + type(psb_ldspmat_type), intent(out) :: ac,op_restr + integer(psb_ipk_), intent(out) :: info ! Local variables - integer(psb_ipk_) :: nrow, nglob, ncol, ntaggr, ip, ndx,& - & naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw, err_act + integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, ip, ndx,& + & naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw integer(psb_ipk_) ::ictxt, np, me character(len=20) :: name - type(psb_dspmat_type) :: am3, am4, tmp_prol - type(psb_d_coo_sparse_mat) :: tmpcoo - type(psb_d_csr_sparse_mat) :: acsr1, acsr2, acsr3, acsrf, ptilde + type(psb_ldspmat_type) :: la, am3, am4, tmp_prol + type(psb_ld_coo_sparse_mat) :: tmpcoo + type(psb_ld_csr_sparse_mat) :: acsr1, acsr2, acsr3, acsrf, ptilde real(psb_dpk_), allocatable :: adiag(:) integer(psb_ipk_) :: ierr(5) logical :: filter_mat - integer(psb_ipk_) :: debug_level, debug_unit + integer(psb_ipk_) :: debug_level, debug_unit, err_act integer(psb_ipk_), parameter :: ncmax=16 real(psb_dpk_) :: anorm, omega, tmp, dg, theta name='mld_aggrmat_smth_asb' - if(psb_get_errstatus().ne.0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_; goto 9999 + end if debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() @@ -176,6 +178,7 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest & call psb_realloc(ncol,adiag,info) if (info == psb_success_) & & call psb_halo(adiag,desc_a,info) + if (info == psb_success_) call a%cp_to_l(la) if(info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_getdiag') @@ -185,7 +188,7 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest ! 1. Allocate Ptilde in sparse matrix form call op_prol%mv_to(tmpcoo) call ptilde%mv_from_coo(tmpcoo,info) - if (info == psb_success_) call a%cscnv(acsr3,info,dupl=psb_dupl_add_) + if (info == psb_success_) call la%cscnv(acsr3,info,dupl=psb_dupl_add_) if (info /= psb_success_) goto 9999 if (debug_level >= psb_debug_outer_) & @@ -342,7 +345,7 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest goto 9999 end if - call psb_spspmm(a,tmp_prol,am3,info) + call psb_spspmm(la,tmp_prol,am3,info) if(info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2') goto 9999 diff --git a/mlprec/impl/aggregator/mld_saggrmat_smth_asb.f90 b/mlprec/impl/aggregator/mld_saggrmat_smth_asb.f90 index e2c52d7f..b0557fea 100644 --- a/mlprec/impl/aggregator/mld_saggrmat_smth_asb.f90 +++ b/mlprec/impl/aggregator/mld_saggrmat_smth_asb.f90 @@ -117,33 +117,35 @@ subroutine mld_saggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest implicit none ! Arguments - type(psb_sspmat_type), intent(in) :: a - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(inout) :: ilaggr(:), nlaggr(:) - type(mld_sml_parms), intent(inout) :: parms - type(psb_sspmat_type), intent(inout) :: op_prol - type(psb_sspmat_type), intent(out) :: ac,op_restr - integer(psb_ipk_), intent(out) :: info + type(psb_sspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:) + type(mld_sml_parms), intent(inout) :: parms + type(psb_lsspmat_type), intent(inout) :: op_prol + type(psb_lsspmat_type), intent(out) :: ac,op_restr + integer(psb_ipk_), intent(out) :: info ! Local variables - integer(psb_ipk_) :: nrow, nglob, ncol, ntaggr, ip, ndx,& - & naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw, err_act + integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, ip, ndx,& + & naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw integer(psb_ipk_) ::ictxt, np, me character(len=20) :: name - type(psb_sspmat_type) :: am3, am4, tmp_prol - type(psb_s_coo_sparse_mat) :: tmpcoo - type(psb_s_csr_sparse_mat) :: acsr1, acsr2, acsr3, acsrf, ptilde + type(psb_lsspmat_type) :: la, am3, am4, tmp_prol + type(psb_ls_coo_sparse_mat) :: tmpcoo + type(psb_ls_csr_sparse_mat) :: acsr1, acsr2, acsr3, acsrf, ptilde real(psb_spk_), allocatable :: adiag(:) integer(psb_ipk_) :: ierr(5) logical :: filter_mat - integer(psb_ipk_) :: debug_level, debug_unit + integer(psb_ipk_) :: debug_level, debug_unit, err_act integer(psb_ipk_), parameter :: ncmax=16 real(psb_spk_) :: anorm, omega, tmp, dg, theta name='mld_aggrmat_smth_asb' - if(psb_get_errstatus().ne.0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_; goto 9999 + end if debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() @@ -176,6 +178,7 @@ subroutine mld_saggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest & call psb_realloc(ncol,adiag,info) if (info == psb_success_) & & call psb_halo(adiag,desc_a,info) + if (info == psb_success_) call a%cp_to_l(la) if(info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_getdiag') @@ -185,7 +188,7 @@ subroutine mld_saggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest ! 1. Allocate Ptilde in sparse matrix form call op_prol%mv_to(tmpcoo) call ptilde%mv_from_coo(tmpcoo,info) - if (info == psb_success_) call a%cscnv(acsr3,info,dupl=psb_dupl_add_) + if (info == psb_success_) call la%cscnv(acsr3,info,dupl=psb_dupl_add_) if (info /= psb_success_) goto 9999 if (debug_level >= psb_debug_outer_) & @@ -342,7 +345,7 @@ subroutine mld_saggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest goto 9999 end if - call psb_spspmm(a,tmp_prol,am3,info) + call psb_spspmm(la,tmp_prol,am3,info) if(info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2') goto 9999 diff --git a/mlprec/impl/aggregator/mld_zaggrmat_smth_asb.f90 b/mlprec/impl/aggregator/mld_zaggrmat_smth_asb.f90 index 02f2ebe6..afee18ca 100644 --- a/mlprec/impl/aggregator/mld_zaggrmat_smth_asb.f90 +++ b/mlprec/impl/aggregator/mld_zaggrmat_smth_asb.f90 @@ -117,33 +117,35 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest implicit none ! Arguments - type(psb_zspmat_type), intent(in) :: a - type(psb_desc_type), intent(in) :: desc_a - integer(psb_ipk_), intent(inout) :: ilaggr(:), nlaggr(:) - type(mld_dml_parms), intent(inout) :: parms - type(psb_zspmat_type), intent(inout) :: op_prol - type(psb_zspmat_type), intent(out) :: ac,op_restr - integer(psb_ipk_), intent(out) :: info + type(psb_zspmat_type), intent(in) :: a + type(psb_desc_type), intent(in) :: desc_a + integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:) + type(mld_dml_parms), intent(inout) :: parms + type(psb_lzspmat_type), intent(inout) :: op_prol + type(psb_lzspmat_type), intent(out) :: ac,op_restr + integer(psb_ipk_), intent(out) :: info ! Local variables - integer(psb_ipk_) :: nrow, nglob, ncol, ntaggr, ip, ndx,& - & naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw, err_act + integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, ip, ndx,& + & naggr, nzl,naggrm1,naggrp1, i, j, k, jd, icolF, nrw integer(psb_ipk_) ::ictxt, np, me character(len=20) :: name - type(psb_zspmat_type) :: am3, am4, tmp_prol - type(psb_z_coo_sparse_mat) :: tmpcoo - type(psb_z_csr_sparse_mat) :: acsr1, acsr2, acsr3, acsrf, ptilde + type(psb_lzspmat_type) :: la, am3, am4, tmp_prol + type(psb_lz_coo_sparse_mat) :: tmpcoo + type(psb_lz_csr_sparse_mat) :: acsr1, acsr2, acsr3, acsrf, ptilde complex(psb_dpk_), allocatable :: adiag(:) integer(psb_ipk_) :: ierr(5) logical :: filter_mat - integer(psb_ipk_) :: debug_level, debug_unit + integer(psb_ipk_) :: debug_level, debug_unit, err_act integer(psb_ipk_), parameter :: ncmax=16 real(psb_dpk_) :: anorm, omega, tmp, dg, theta name='mld_aggrmat_smth_asb' - if(psb_get_errstatus().ne.0) return info=psb_success_ call psb_erractionsave(err_act) + if (psb_errstatus_fatal()) then + info = psb_err_internal_error_; goto 9999 + end if debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() @@ -176,6 +178,7 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest & call psb_realloc(ncol,adiag,info) if (info == psb_success_) & & call psb_halo(adiag,desc_a,info) + if (info == psb_success_) call a%cp_to_l(la) if(info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_getdiag') @@ -185,7 +188,7 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest ! 1. Allocate Ptilde in sparse matrix form call op_prol%mv_to(tmpcoo) call ptilde%mv_from_coo(tmpcoo,info) - if (info == psb_success_) call a%cscnv(acsr3,info,dupl=psb_dupl_add_) + if (info == psb_success_) call la%cscnv(acsr3,info,dupl=psb_dupl_add_) if (info /= psb_success_) goto 9999 if (debug_level >= psb_debug_outer_) & @@ -342,7 +345,7 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_rest goto 9999 end if - call psb_spspmm(a,tmp_prol,am3,info) + call psb_spspmm(la,tmp_prol,am3,info) if(info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='spspmm 2') goto 9999