Merge branch 'smoothed-parm' into unify_aggr_bld

stopcriterion
Salvatore Filippone 5 years ago
commit f68f281089

@ -92,7 +92,7 @@ subroutine mld_c_dec_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,&
class(mld_c_dec_aggregator_type), target, intent(inout) :: ag
type(mld_sml_parms), intent(inout) :: parms
type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(psb_lcspmat_type), intent(inout) :: op_prol, ac,op_restr
type(psb_desc_type), intent(inout) :: desc_ac

@ -142,7 +142,7 @@ subroutine mld_c_dec_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,ac,op_p
class(mld_c_dec_aggregator_type), target, intent(inout) :: ag
type(mld_sml_parms), intent(inout) :: parms
type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(psb_lcspmat_type), intent(inout) :: op_prol
type(psb_lcspmat_type), intent(out) :: ac,op_restr

@ -62,7 +62,7 @@ subroutine mld_c_spmm_bld_inner(a_csr,desc_a,nlaggr,parms,ac,&
integer(psb_ipk_) :: debug_level, debug_unit, naggr
integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzl, ip, &
& nzt, naggrm1, naggrp1, i, k
integer(psb_lpk_) :: nrsave, ncsave, nzsave, nza, nrpsave, ncpsave, nzpsave
integer(psb_lpk_) :: nrsave, ncsave, nzsave, nza
logical, parameter :: do_timings=.true., oldstyle=.false., debug=.false.
integer(psb_ipk_), save :: idx_spspmm=-1
@ -89,10 +89,6 @@ subroutine mld_c_spmm_bld_inner(a_csr,desc_a,nlaggr,parms,ac,&
naggrm1 = sum(nlaggr(1:me))
naggrp1 = sum(nlaggr(1:me+1))
!write(0,*)me,' ',name,' input sizes',nlaggr(:),':',naggr
nrpsave = coo_prol%get_nrows()
ncpsave = coo_prol%get_ncols()
nzpsave = coo_prol%get_nzeros()
!write(0,*)me,' ',name,' input coo_prol ',nrpsave,ncpsave,nzpsave
!
! Here COO_PROL should be with GLOBAL indices on the cols
@ -205,7 +201,7 @@ subroutine mld_c_spmm_bld_inner(a_csr,desc_a,nlaggr,parms,ac,&
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Done smooth_aggregate '
& 'Done spmm_bld_inner '
call psb_erractionrestore(err_act)
return

@ -92,7 +92,7 @@ subroutine mld_d_dec_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,&
class(mld_d_dec_aggregator_type), target, intent(inout) :: ag
type(mld_dml_parms), intent(inout) :: parms
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(psb_ldspmat_type), intent(inout) :: op_prol, ac,op_restr
type(psb_desc_type), intent(inout) :: desc_ac

@ -142,7 +142,7 @@ subroutine mld_d_dec_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,ac,op_p
class(mld_d_dec_aggregator_type), target, intent(inout) :: ag
type(mld_dml_parms), intent(inout) :: parms
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(psb_ldspmat_type), intent(inout) :: op_prol
type(psb_ldspmat_type), intent(out) :: ac,op_restr

@ -62,7 +62,7 @@ subroutine mld_d_spmm_bld_inner(a_csr,desc_a,nlaggr,parms,ac,&
integer(psb_ipk_) :: debug_level, debug_unit, naggr
integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzl, ip, &
& nzt, naggrm1, naggrp1, i, k
integer(psb_lpk_) :: nrsave, ncsave, nzsave, nza, nrpsave, ncpsave, nzpsave
integer(psb_lpk_) :: nrsave, ncsave, nzsave, nza
logical, parameter :: do_timings=.true., oldstyle=.false., debug=.false.
integer(psb_ipk_), save :: idx_spspmm=-1
@ -89,10 +89,6 @@ subroutine mld_d_spmm_bld_inner(a_csr,desc_a,nlaggr,parms,ac,&
naggrm1 = sum(nlaggr(1:me))
naggrp1 = sum(nlaggr(1:me+1))
!write(0,*)me,' ',name,' input sizes',nlaggr(:),':',naggr
nrpsave = coo_prol%get_nrows()
ncpsave = coo_prol%get_ncols()
nzpsave = coo_prol%get_nzeros()
!write(0,*)me,' ',name,' input coo_prol ',nrpsave,ncpsave,nzpsave
!
! Here COO_PROL should be with GLOBAL indices on the cols
@ -205,7 +201,7 @@ subroutine mld_d_spmm_bld_inner(a_csr,desc_a,nlaggr,parms,ac,&
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Done smooth_aggregate '
& 'Done spmm_bld_inner '
call psb_erractionrestore(err_act)
return

@ -92,7 +92,7 @@ subroutine mld_s_dec_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,&
class(mld_s_dec_aggregator_type), target, intent(inout) :: ag
type(mld_sml_parms), intent(inout) :: parms
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(psb_lsspmat_type), intent(inout) :: op_prol, ac,op_restr
type(psb_desc_type), intent(inout) :: desc_ac

@ -142,7 +142,7 @@ subroutine mld_s_dec_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,ac,op_p
class(mld_s_dec_aggregator_type), target, intent(inout) :: ag
type(mld_sml_parms), intent(inout) :: parms
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(psb_lsspmat_type), intent(inout) :: op_prol
type(psb_lsspmat_type), intent(out) :: ac,op_restr

@ -62,7 +62,7 @@ subroutine mld_s_spmm_bld_inner(a_csr,desc_a,nlaggr,parms,ac,&
integer(psb_ipk_) :: debug_level, debug_unit, naggr
integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzl, ip, &
& nzt, naggrm1, naggrp1, i, k
integer(psb_lpk_) :: nrsave, ncsave, nzsave, nza, nrpsave, ncpsave, nzpsave
integer(psb_lpk_) :: nrsave, ncsave, nzsave, nza
logical, parameter :: do_timings=.true., oldstyle=.false., debug=.false.
integer(psb_ipk_), save :: idx_spspmm=-1
@ -89,10 +89,6 @@ subroutine mld_s_spmm_bld_inner(a_csr,desc_a,nlaggr,parms,ac,&
naggrm1 = sum(nlaggr(1:me))
naggrp1 = sum(nlaggr(1:me+1))
!write(0,*)me,' ',name,' input sizes',nlaggr(:),':',naggr
nrpsave = coo_prol%get_nrows()
ncpsave = coo_prol%get_ncols()
nzpsave = coo_prol%get_nzeros()
!write(0,*)me,' ',name,' input coo_prol ',nrpsave,ncpsave,nzpsave
!
! Here COO_PROL should be with GLOBAL indices on the cols
@ -205,7 +201,7 @@ subroutine mld_s_spmm_bld_inner(a_csr,desc_a,nlaggr,parms,ac,&
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Done smooth_aggregate '
& 'Done spmm_bld_inner '
call psb_erractionrestore(err_act)
return

@ -92,7 +92,7 @@ subroutine mld_z_dec_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,&
class(mld_z_dec_aggregator_type), target, intent(inout) :: ag
type(mld_dml_parms), intent(inout) :: parms
type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(psb_lzspmat_type), intent(inout) :: op_prol, ac,op_restr
type(psb_desc_type), intent(inout) :: desc_ac

@ -142,7 +142,7 @@ subroutine mld_z_dec_aggregator_mat_bld(ag,parms,a,desc_a,ilaggr,nlaggr,ac,op_p
class(mld_z_dec_aggregator_type), target, intent(inout) :: ag
type(mld_dml_parms), intent(inout) :: parms
type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(psb_lzspmat_type), intent(inout) :: op_prol
type(psb_lzspmat_type), intent(out) :: ac,op_restr

@ -62,7 +62,7 @@ subroutine mld_z_spmm_bld_inner(a_csr,desc_a,nlaggr,parms,ac,&
integer(psb_ipk_) :: debug_level, debug_unit, naggr
integer(psb_lpk_) :: nrow, nglob, ncol, ntaggr, nzl, ip, &
& nzt, naggrm1, naggrp1, i, k
integer(psb_lpk_) :: nrsave, ncsave, nzsave, nza, nrpsave, ncpsave, nzpsave
integer(psb_lpk_) :: nrsave, ncsave, nzsave, nza
logical, parameter :: do_timings=.true., oldstyle=.false., debug=.false.
integer(psb_ipk_), save :: idx_spspmm=-1
@ -89,10 +89,6 @@ subroutine mld_z_spmm_bld_inner(a_csr,desc_a,nlaggr,parms,ac,&
naggrm1 = sum(nlaggr(1:me))
naggrp1 = sum(nlaggr(1:me+1))
!write(0,*)me,' ',name,' input sizes',nlaggr(:),':',naggr
nrpsave = coo_prol%get_nrows()
ncpsave = coo_prol%get_ncols()
nzpsave = coo_prol%get_nzeros()
!write(0,*)me,' ',name,' input coo_prol ',nrpsave,ncpsave,nzpsave
!
! Here COO_PROL should be with GLOBAL indices on the cols
@ -205,7 +201,7 @@ subroutine mld_z_spmm_bld_inner(a_csr,desc_a,nlaggr,parms,ac,&
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Done smooth_aggregate '
& 'Done spmm_bld_inner '
call psb_erractionrestore(err_act)
return

@ -94,7 +94,7 @@ subroutine mld_c_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
! Arguments
class(mld_c_onelev_type), intent(inout), target :: lv
type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(inout) :: nlaggr(:)
integer(psb_lpk_), intent(inout) :: ilaggr(:)
type(psb_lcspmat_type), intent(inout) :: op_prol

@ -94,7 +94,7 @@ subroutine mld_d_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
! Arguments
class(mld_d_onelev_type), intent(inout), target :: lv
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(inout) :: nlaggr(:)
integer(psb_lpk_), intent(inout) :: ilaggr(:)
type(psb_ldspmat_type), intent(inout) :: op_prol

@ -94,7 +94,7 @@ subroutine mld_s_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
! Arguments
class(mld_s_onelev_type), intent(inout), target :: lv
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(inout) :: nlaggr(:)
integer(psb_lpk_), intent(inout) :: ilaggr(:)
type(psb_lsspmat_type), intent(inout) :: op_prol

@ -94,7 +94,7 @@ subroutine mld_z_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
! Arguments
class(mld_z_onelev_type), intent(inout), target :: lv
type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(inout) :: nlaggr(:)
integer(psb_lpk_), intent(inout) :: ilaggr(:)
type(psb_lzspmat_type), intent(inout) :: op_prol

@ -57,6 +57,7 @@ subroutine c_mumps_solver_apply(alpha,sv,x,beta,y,desc_data,&
integer(psb_ipk_) :: n_row, n_col
integer(psb_lpk_) :: nglob
integer(psb_epk_) :: eng
complex(psb_spk_), allocatable :: ww(:)
complex(psb_spk_), allocatable, target :: gx(:)
integer(psb_ipk_) :: ictxt,np,me,i, err_act
@ -101,8 +102,8 @@ subroutine c_mumps_solver_apply(alpha,sv,x,beta,y,desc_data,&
end if
allocate(gx(nglob),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
call psb_errpush(info,name,e_err=(/nglob/),&
info=psb_err_alloc_request_; eng = nglob
call psb_errpush(info,name,e_err=(/eng/),&
& a_err='complex(psb_spk_)')
goto 9999
end if

@ -57,6 +57,7 @@ subroutine d_mumps_solver_apply(alpha,sv,x,beta,y,desc_data,&
integer(psb_ipk_) :: n_row, n_col
integer(psb_lpk_) :: nglob
integer(psb_epk_) :: eng
real(psb_dpk_), allocatable :: ww(:)
real(psb_dpk_), allocatable, target :: gx(:)
integer(psb_ipk_) :: ictxt,np,me,i, err_act
@ -101,8 +102,8 @@ subroutine d_mumps_solver_apply(alpha,sv,x,beta,y,desc_data,&
end if
allocate(gx(nglob),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
call psb_errpush(info,name,e_err=(/nglob/),&
info=psb_err_alloc_request_; eng = nglob
call psb_errpush(info,name,e_err=(/eng/),&
& a_err='real(psb_dpk_)')
goto 9999
end if

@ -57,6 +57,7 @@ subroutine s_mumps_solver_apply(alpha,sv,x,beta,y,desc_data,&
integer(psb_ipk_) :: n_row, n_col
integer(psb_lpk_) :: nglob
integer(psb_epk_) :: eng
real(psb_spk_), allocatable :: ww(:)
real(psb_spk_), allocatable, target :: gx(:)
integer(psb_ipk_) :: ictxt,np,me,i, err_act
@ -101,8 +102,8 @@ subroutine s_mumps_solver_apply(alpha,sv,x,beta,y,desc_data,&
end if
allocate(gx(nglob),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
call psb_errpush(info,name,e_err=(/nglob/),&
info=psb_err_alloc_request_; eng = nglob
call psb_errpush(info,name,e_err=(/eng/),&
& a_err='real(psb_spk_)')
goto 9999
end if

@ -57,6 +57,7 @@ subroutine z_mumps_solver_apply(alpha,sv,x,beta,y,desc_data,&
integer(psb_ipk_) :: n_row, n_col
integer(psb_lpk_) :: nglob
integer(psb_epk_) :: eng
complex(psb_dpk_), allocatable :: ww(:)
complex(psb_dpk_), allocatable, target :: gx(:)
integer(psb_ipk_) :: ictxt,np,me,i, err_act
@ -101,8 +102,8 @@ subroutine z_mumps_solver_apply(alpha,sv,x,beta,y,desc_data,&
end if
allocate(gx(nglob),stat=info)
if (info /= psb_success_) then
info=psb_err_alloc_request_
call psb_errpush(info,name,e_err=(/nglob/),&
info=psb_err_alloc_request_; eng = nglob
call psb_errpush(info,name,e_err=(/eng/),&
& a_err='complex(psb_dpk_)')
goto 9999
end if

@ -375,7 +375,7 @@ contains
class(mld_c_base_aggregator_type), target, intent(inout) :: ag
type(mld_sml_parms), intent(inout) :: parms
type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(psb_lcspmat_type), intent(inout) :: op_prol
type(psb_lcspmat_type), intent(out) :: ac,op_restr
@ -423,7 +423,7 @@ contains
class(mld_c_base_aggregator_type), target, intent(inout) :: ag
type(mld_sml_parms), intent(inout) :: parms
type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(psb_lcspmat_type), intent(inout) :: op_prol,ac,op_restr
type(psb_desc_type), intent(inout) :: desc_ac

@ -117,7 +117,7 @@ module mld_c_dec_aggregator_mod
class(mld_c_dec_aggregator_type), target, intent(inout) :: ag
type(mld_sml_parms), intent(inout) :: parms
type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(psb_lcspmat_type), intent(inout) :: op_prol
type(psb_lcspmat_type), intent(out) :: ac,op_restr
@ -134,7 +134,7 @@ module mld_c_dec_aggregator_mod
class(mld_c_dec_aggregator_type), target, intent(inout) :: ag
type(mld_sml_parms), intent(inout) :: parms
type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(psb_lcspmat_type), intent(inout) :: op_prol,ac,op_restr
type(psb_desc_type), intent(inout) :: desc_ac

@ -217,7 +217,7 @@ module mld_c_onelev_mod
implicit none
class(mld_c_onelev_type), intent(inout), target :: lv
type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:),nlaggr(:)
type(psb_lcspmat_type), intent(inout) :: op_prol
integer(psb_ipk_), intent(out) :: info

@ -375,7 +375,7 @@ contains
class(mld_d_base_aggregator_type), target, intent(inout) :: ag
type(mld_dml_parms), intent(inout) :: parms
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(psb_ldspmat_type), intent(inout) :: op_prol
type(psb_ldspmat_type), intent(out) :: ac,op_restr
@ -423,7 +423,7 @@ contains
class(mld_d_base_aggregator_type), target, intent(inout) :: ag
type(mld_dml_parms), intent(inout) :: parms
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(psb_ldspmat_type), intent(inout) :: op_prol,ac,op_restr
type(psb_desc_type), intent(inout) :: desc_ac

@ -117,7 +117,7 @@ module mld_d_dec_aggregator_mod
class(mld_d_dec_aggregator_type), target, intent(inout) :: ag
type(mld_dml_parms), intent(inout) :: parms
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(psb_ldspmat_type), intent(inout) :: op_prol
type(psb_ldspmat_type), intent(out) :: ac,op_restr
@ -134,7 +134,7 @@ module mld_d_dec_aggregator_mod
class(mld_d_dec_aggregator_type), target, intent(inout) :: ag
type(mld_dml_parms), intent(inout) :: parms
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(psb_ldspmat_type), intent(inout) :: op_prol,ac,op_restr
type(psb_desc_type), intent(inout) :: desc_ac

@ -217,7 +217,7 @@ module mld_d_onelev_mod
implicit none
class(mld_d_onelev_type), intent(inout), target :: lv
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:),nlaggr(:)
type(psb_ldspmat_type), intent(inout) :: op_prol
integer(psb_ipk_), intent(out) :: info

@ -375,7 +375,7 @@ contains
class(mld_s_base_aggregator_type), target, intent(inout) :: ag
type(mld_sml_parms), intent(inout) :: parms
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(psb_lsspmat_type), intent(inout) :: op_prol
type(psb_lsspmat_type), intent(out) :: ac,op_restr
@ -423,7 +423,7 @@ contains
class(mld_s_base_aggregator_type), target, intent(inout) :: ag
type(mld_sml_parms), intent(inout) :: parms
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(psb_lsspmat_type), intent(inout) :: op_prol,ac,op_restr
type(psb_desc_type), intent(inout) :: desc_ac

@ -117,7 +117,7 @@ module mld_s_dec_aggregator_mod
class(mld_s_dec_aggregator_type), target, intent(inout) :: ag
type(mld_sml_parms), intent(inout) :: parms
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(psb_lsspmat_type), intent(inout) :: op_prol
type(psb_lsspmat_type), intent(out) :: ac,op_restr
@ -134,7 +134,7 @@ module mld_s_dec_aggregator_mod
class(mld_s_dec_aggregator_type), target, intent(inout) :: ag
type(mld_sml_parms), intent(inout) :: parms
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(psb_lsspmat_type), intent(inout) :: op_prol,ac,op_restr
type(psb_desc_type), intent(inout) :: desc_ac

@ -217,7 +217,7 @@ module mld_s_onelev_mod
implicit none
class(mld_s_onelev_type), intent(inout), target :: lv
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:),nlaggr(:)
type(psb_lsspmat_type), intent(inout) :: op_prol
integer(psb_ipk_), intent(out) :: info

@ -375,7 +375,7 @@ contains
class(mld_z_base_aggregator_type), target, intent(inout) :: ag
type(mld_dml_parms), intent(inout) :: parms
type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(psb_lzspmat_type), intent(inout) :: op_prol
type(psb_lzspmat_type), intent(out) :: ac,op_restr
@ -423,7 +423,7 @@ contains
class(mld_z_base_aggregator_type), target, intent(inout) :: ag
type(mld_dml_parms), intent(inout) :: parms
type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(psb_lzspmat_type), intent(inout) :: op_prol,ac,op_restr
type(psb_desc_type), intent(inout) :: desc_ac

@ -117,7 +117,7 @@ module mld_z_dec_aggregator_mod
class(mld_z_dec_aggregator_type), target, intent(inout) :: ag
type(mld_dml_parms), intent(inout) :: parms
type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(psb_lzspmat_type), intent(inout) :: op_prol
type(psb_lzspmat_type), intent(out) :: ac,op_restr
@ -134,7 +134,7 @@ module mld_z_dec_aggregator_mod
class(mld_z_dec_aggregator_type), target, intent(inout) :: ag
type(mld_dml_parms), intent(inout) :: parms
type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(psb_lzspmat_type), intent(inout) :: op_prol,ac,op_restr
type(psb_desc_type), intent(inout) :: desc_ac

@ -217,7 +217,7 @@ module mld_z_onelev_mod
implicit none
class(mld_z_onelev_type), intent(inout), target :: lv
type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(psb_desc_type), intent(inout) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:),nlaggr(:)
type(psb_lzspmat_type), intent(inout) :: op_prol
integer(psb_ipk_), intent(out) :: info

Loading…
Cancel
Save