fdurastante
/
amg4psblas
mirror of https://github.com/sfilippone/amg4psblas.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

mld2p4:

Browse Source 
mlprec/mld_caggr_bld.f90
 mlprec/mld_caggrmat_asb.f90
 mlprec/mld_caggrmat_raw_asb.F90
 mlprec/mld_caggrmat_smth_asb.F90
 mlprec/mld_cmlprec_aply.f90
 mlprec/mld_cprecbld.f90
 mlprec/mld_daggr_bld.f90
 mlprec/mld_daggrmat_asb.f90
 mlprec/mld_daggrmat_raw_asb.F90
 mlprec/mld_daggrmat_smth_asb.F90
 mlprec/mld_dmlprec_aply.f90
 mlprec/mld_dprecbld.f90
 mlprec/mld_inner_mod.f90
 mlprec/mld_move_alloc_mod.F90
 mlprec/mld_prec_type.f90
 mlprec/mld_saggr_bld.f90
 mlprec/mld_saggrmat_asb.f90
 mlprec/mld_saggrmat_raw_asb.F90
 mlprec/mld_saggrmat_smth_asb.F90
 mlprec/mld_smlprec_aply.f90
 mlprec/mld_sprecbld.f90
 mlprec/mld_zaggr_bld.f90
 mlprec/mld_zaggrmat_asb.f90
 mlprec/mld_zaggrmat_raw_asb.F90
 mlprec/mld_zaggrmat_smth_asb.F90
 mlprec/mld_zmlprec_aply.f90
 mlprec/mld_zprecbld.f90

moved ilaggr/nlaggr inside the map object.
stopcriterion
Salvatore Filippone 16 years ago
parent c9fa1ca44b
commit a8e13e2c18
27 changed files with 369 additions and 371 deletions
Show Stats Download Patch File Download Diff File

17
mlprec/mld_caggr_bld.f90
Unescape Escape View File

@ -49,7 +49,7 @@
!
!
! Arguments:
! a - type(psb_dspmat_type).
! a - type(psb_cspmat_type).
! The sparse matrix structure containing the local part of the
! matrix to be preconditioned.
! desc_a - type(psb_desc_type), input.
@ -70,14 +70,15 @@ subroutine mld_caggr_bld(a,desc_a,p,info)
! Arguments
type(psb_cspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_c_interlev_prec_type), intent(inout),target :: p
type(mld_c_onelev_type), intent(inout),target :: p
integer, intent(out) :: info
! Local variables
type(psb_desc_type) :: desc_ac
type(psb_cspmat_type) :: ac
character(len=20) :: name
integer :: ictxt, np, me, err_act
type(psb_desc_type) :: desc_ac
type(psb_cspmat_type) :: ac
character(len=20) :: name
integer :: ictxt, np, me, err_act
integer, allocatable :: ilaggr(:), nlaggr(:)
name='mld_caggr_bld'
if (psb_get_errstatus().ne.0) return
@ -116,7 +117,7 @@ subroutine mld_caggr_bld(a,desc_a,p,info)
! the coarse to the fine level.
!
call mld_aggrmap_bld(p%iprcparm(mld_aggr_alg_),p%rprcparm(mld_aggr_thresh_),&
& a,desc_a,p%nlaggr,p%mlia,info)
& a,desc_a,nlaggr,ilaggr,info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='mld_aggrmap_bld')
goto 9999
@ -127,7 +128,7 @@ subroutine mld_caggr_bld(a,desc_a,p,info)
! the mapping defined by mld_aggrmap_bld and applying the aggregation
! algorithm specified by p%iprcparm(mld_aggr_kind_)
!
call mld_aggrmat_asb(a,desc_a,p,info)
call mld_aggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='mld_aggrmat_asb')
goto 9999

11
mlprec/mld_caggrmat_asb.f90
Unescape Escape View File

@ -83,14 +83,14 @@
! the fine-level matrix.
! desc_a - type(psb_desc_type), input.
! The communication descriptor of the fine-level matrix.
! p - type(mld_c_interlev_prec_type), input/output.
! p - type(mld_c_onelev_type), input/output.
! The one-level preconditioner data structure containing the local
! part of the base preconditioner to be built as well as the
! aggregate matrices.
! info - integer, output.
! Error code.
!
subroutine mld_caggrmat_asb(a,desc_a,p,info)
subroutine mld_caggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info)
use psb_base_mod
use mld_inner_mod, mld_protect_name => mld_caggrmat_asb
@ -100,7 +100,8 @@ subroutine mld_caggrmat_asb(a,desc_a,p,info)
! Arguments
type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_c_interlev_prec_type), intent(inout), target :: p
integer, intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_c_onelev_type), intent(inout), target :: p
integer, intent(out) :: info
! Local variables
@ -120,7 +121,7 @@ subroutine mld_caggrmat_asb(a,desc_a,p,info)
select case (p%iprcparm(mld_aggr_kind_))
case (mld_no_smooth_)
call mld_aggrmat_raw_asb(a,desc_a,p,info)
call mld_aggrmat_raw_asb(a,desc_a,ilaggr,nlaggr,p,info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='mld_aggrmat_raw_asb')
goto 9999
@ -128,7 +129,7 @@ subroutine mld_caggrmat_asb(a,desc_a,p,info)
case(mld_smooth_prol_,mld_biz_prol_)
call mld_aggrmat_smth_asb(a,desc_a,p,info)
call mld_aggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,p,info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='mld_aggrmat_smth_asb')
goto 9999

27
mlprec/mld_caggrmat_raw_asb.F90
Unescape Escape View File

@ -66,14 +66,14 @@
! the fine-level matrix.
! desc_a - type(psb_desc_type), input.
! The communication descriptor of the fine-level matrix.
! p - type(mld_c_interlev_prec_type), input/output.
! p - type(mld_c_onelev_type), input/output.
! The one-level preconditioner data structure containing the local
! part of the base preconditioner to be built as well as the
! aggregate matrices.
! info - integer, output.
! Error code.
!
subroutine mld_caggrmat_raw_asb(a,desc_a,p,info)
subroutine mld_caggrmat_raw_asb(a,desc_a,ilaggr,nlaggr,p,info)
use psb_base_mod
use mld_inner_mod, mld_protect_name => mld_caggrmat_raw_asb
@ -88,7 +88,8 @@ subroutine mld_caggrmat_raw_asb(a,desc_a,p,info)
! Arguments
type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_c_interlev_prec_type), intent(inout), target :: p
integer, intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_c_onelev_type), intent(inout), target :: p
integer, intent(out) :: info
! Local variables
@ -118,8 +119,8 @@ subroutine mld_caggrmat_raw_asb(a,desc_a,p,info)
call psb_nullify_sp(am2)
naggr = p%nlaggr(me+1)
ntaggr = sum(p%nlaggr)
naggr = nlaggr(me+1)
ntaggr = sum(nlaggr)
allocate(nzbr(np), idisp(np),stat=info)
if (info /= 0) then
info=4025
@ -128,13 +129,13 @@ subroutine mld_caggrmat_raw_asb(a,desc_a,p,info)
goto 9999
end if
naggrm1=sum(p%nlaggr(1:me))
naggrm1=sum(nlaggr(1:me))
if (p%iprcparm(mld_coarse_mat_) == mld_repl_mat_) then
do i=1, nrow
p%mlia(i) = p%mlia(i) + naggrm1
ilaggr(i) = ilaggr(i) + naggrm1
end do
call psb_halo(p%mlia,desc_a,info)
call psb_halo(ilaggr,desc_a,info)
end if
if(info /= 0) then
@ -156,7 +157,7 @@ subroutine mld_caggrmat_raw_asb(a,desc_a,p,info)
do i=1,nrow
am1%aspk(i) = cone
am1%ia1(i) = i
am1%ia2(i) = p%mlia(i)
am1%ia2(i) = ilaggr(i)
end do
am1%infoa(psb_nnz_) = nrow
@ -177,8 +178,8 @@ subroutine mld_caggrmat_raw_asb(a,desc_a,p,info)
nzt = psb_sp_get_nnzeros(b)
do i=1, nzt
b%ia1(i) = p%mlia(b%ia1(i))
b%ia2(i) = p%mlia(b%ia2(i))
b%ia1(i) = ilaggr(b%ia1(i))
b%ia2(i) = ilaggr(b%ia2(i))
enddo
b%m = naggr
b%k = naggr
@ -266,8 +267,8 @@ subroutine mld_caggrmat_raw_asb(a,desc_a,p,info)
! am2 => PR^T i.e. restriction operator
! am1 => PR i.e. prolongation operator
!
p%map = psb_linear_map(psb_map_aggr_,desc_a,&
& p%desc_ac,am2,am1)
p%map = psb_linmap(psb_map_aggr_,desc_a,&
& p%desc_ac,am2,am1,ilaggr,nlaggr)
if (info == 0) call psb_sp_free(am1,info)
if (info == 0) call psb_sp_free(am2,info)
if(info /= 0) then

31
mlprec/mld_caggrmat_smth_asb.F90
Unescape Escape View File

@ -83,14 +83,14 @@
! the fine-level matrix.
! desc_a - type(psb_desc_type), input.
! The communication descriptor of the fine-level matrix.
! p - type(mld_c_interlev_prec_type), input/output.
! p - type(mld_c_onelev_type), input/output.
! The one-level preconditioner data structure containing the local
! part of the base preconditioner to be built as well as the
! aggregate matrices.
! info - integer, output.
! Error code.
!
subroutine mld_caggrmat_smth_asb(a,desc_a,p,info)
subroutine mld_caggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,p,info)
use psb_base_mod
use mld_inner_mod, mld_protect_name => mld_caggrmat_smth_asb
@ -105,7 +105,8 @@ subroutine mld_caggrmat_smth_asb(a,desc_a,p,info)
! Arguments
type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_c_interlev_prec_type), intent(inout), target :: p
integer, intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_c_onelev_type), intent(inout), target :: p
integer, intent(out) :: info
! Local variables
@ -147,8 +148,8 @@ subroutine mld_caggrmat_smth_asb(a,desc_a,p,info)
nrow = psb_cd_get_local_rows(desc_a)
ncol = psb_cd_get_local_cols(desc_a)
naggr = p%nlaggr(me+1)
ntaggr = sum(p%nlaggr)
naggr = nlaggr(me+1)
ntaggr = sum(nlaggr)
allocate(nzbr(np), idisp(np),stat=info)
if (info /= 0) then
@ -158,15 +159,15 @@ subroutine mld_caggrmat_smth_asb(a,desc_a,p,info)
goto 9999
end if
naggrm1 = sum(p%nlaggr(1:me))
naggrp1 = sum(p%nlaggr(1:me+1))
naggrm1 = sum(nlaggr(1:me))
naggrp1 = sum(nlaggr(1:me+1))
ml_global_nmb = ( (p%iprcparm(mld_aggr_kind_) == mld_smooth_prol_).or.&
& ( (p%iprcparm(mld_aggr_kind_) == mld_biz_prol_).and.&
& (p%iprcparm(mld_coarse_mat_) == mld_repl_mat_)) )
if (ml_global_nmb) then
p%mlia(1:nrow) = p%mlia(1:nrow) + naggrm1
call psb_halo(p%mlia,desc_a,info)
ilaggr(1:nrow) = ilaggr(1:nrow) + naggrm1
call psb_halo(ilaggr,desc_a,info)
if (info /= 0) then
call psb_errpush(4010,name,a_err='psb_halo')
@ -221,14 +222,14 @@ subroutine mld_caggrmat_smth_asb(a,desc_a,p,info)
do i=1,ncol
am4%aspk(i) = cone
am4%ia1(i) = i
am4%ia2(i) = p%mlia(i)
am4%ia2(i) = ilaggr(i)
end do
am4%infoa(psb_nnz_) = ncol
else
do i=1,nrow
am4%aspk(i) = cone
am4%ia1(i) = i
am4%ia2(i) = p%mlia(i)
am4%ia2(i) = ilaggr(i)
end do
am4%infoa(psb_nnz_) = nrow
endif
@ -387,7 +388,7 @@ subroutine mld_caggrmat_smth_asb(a,desc_a,p,info)
i=0
!
! Now we have to fix this. The only rows of B that are correct
! are those corresponding to "local" aggregates, i.e. indices in p%mlia(:)
! are those corresponding to "local" aggregates, i.e. indices in ilaggr(:)
!
do k=1, nzl
if ((naggrm1 < am2%ia1(k)) .and.(am2%ia1(k) <= naggrp1)) then
@ -450,7 +451,7 @@ subroutine mld_caggrmat_smth_asb(a,desc_a,p,info)
call psb_sp_clone(b,p%ac,info)
nzac = p%ac%infoa(psb_nnz_)
nzl = p%ac%infoa(psb_nnz_)
if (info == 0) call psb_cdall(ictxt,p%desc_ac,info,nl=p%nlaggr(me+1))
if (info == 0) call psb_cdall(ictxt,p%desc_ac,info,nl=nlaggr(me+1))
if (info == 0) call psb_cdins(nzl,p%ac%ia1,p%ac%ia2,p%desc_ac,info)
if (info == 0) call psb_cdasb(p%desc_ac,info)
if (info == 0) call psb_glob_to_loc(p%ac%ia1(1:nzl),p%desc_ac,info,iact='I')
@ -653,8 +654,8 @@ subroutine mld_caggrmat_smth_asb(a,desc_a,p,info)
! am2 => PR^T i.e. restriction operator
! am1 => PR i.e. prolongation operator
!
p%map = psb_linear_map(psb_map_aggr_,desc_a,&
& p%desc_ac,am2,am1)
p%map = psb_linmap(psb_map_aggr_,desc_a,&
& p%desc_ac,am2,am1,ilaggr,nlaggr)
if (info == 0) call psb_sp_free(am1,info)
if (info == 0) call psb_sp_free(am2,info)
if(info /= 0) then

12
mlprec/mld_cmlprec_aply.f90
Unescape Escape View File

@ -78,7 +78,7 @@
! Arguments:
! alpha - complex(psb_spk_), input.
! The scalar alpha.
! precv - type(mld_c_interlev_prec_type), dimension(:), input.
! precv - type(mld_c_onelev_type), dimension(:), input.
! The array of one-level preconditioner data structures containing the
! local parts of the preconditioners to be applied at each level.
! Note that nlev = size(precv) = number of levels.
@ -148,7 +148,7 @@ subroutine mld_cmlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info)
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_c_interlev_prec_type), intent(in) :: precv(:)
type(mld_c_onelev_type), intent(in) :: precv(:)
complex(psb_spk_),intent(in) :: alpha,beta
complex(psb_spk_),intent(in) :: x(:)
complex(psb_spk_),intent(inout) :: y(:)
@ -341,7 +341,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_c_interlev_prec_type), intent(in) :: precv(:)
type(mld_c_onelev_type), intent(in) :: precv(:)
complex(psb_spk_),intent(in) :: alpha,beta
complex(psb_spk_),intent(in) :: x(:)
complex(psb_spk_),intent(inout) :: y(:)
@ -577,7 +577,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_c_interlev_prec_type), intent(in) :: precv(:)
type(mld_c_onelev_type), intent(in) :: precv(:)
complex(psb_spk_),intent(in) :: alpha,beta
complex(psb_spk_),intent(in) :: x(:)
complex(psb_spk_),intent(inout) :: y(:)
@ -837,7 +837,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_c_interlev_prec_type), intent(in) :: precv(:)
type(mld_c_onelev_type), intent(in) :: precv(:)
complex(psb_spk_),intent(in) :: alpha,beta
complex(psb_spk_),intent(in) :: x(:)
complex(psb_spk_),intent(inout) :: y(:)
@ -1135,7 +1135,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_c_interlev_prec_type), intent(in) :: precv(:)
type(mld_c_onelev_type), intent(in) :: precv(:)
complex(psb_spk_),intent(in) :: alpha,beta
complex(psb_spk_),intent(in) :: x(:)
complex(psb_spk_),intent(inout) :: y(:)

4
mlprec/mld_cprecbld.f90
Unescape Escape View File

@ -225,7 +225,7 @@ subroutine mld_cprecbld(a,desc_a,p,info)
& 'Return from ',i,' call to mlprcbld ',info
if (i>2) then
if (all(p%precv(i)%nlaggr == p%precv(i-1)%nlaggr)) then
if (all(p%precv(i)%map%naggr == p%precv(i-1)%map%naggr)) then
newsz=i-1
end if
call psb_bcast(ictxt,newsz)
@ -348,7 +348,7 @@ contains
end subroutine init_baseprec_av
subroutine check_coarse_lev(prec)
type(mld_c_interlev_prec_type) :: prec
type(mld_c_onelev_type) :: prec
!
! At the coarsest level, check mld_coarse_solve_

15
mlprec/mld_daggr_bld.f90
Unescape Escape View File

@ -70,14 +70,15 @@ subroutine mld_daggr_bld(a,desc_a,p,info)
! Arguments
type(psb_dspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_d_interlev_prec_type), intent(inout),target :: p
type(mld_d_onelev_type), intent(inout),target :: p
integer, intent(out) :: info
! Local variables
type(psb_desc_type) :: desc_ac
type(psb_dspmat_type) :: ac
character(len=20) :: name
integer :: ictxt, np, me, err_act
type(psb_desc_type) :: desc_ac
type(psb_dspmat_type) :: ac
character(len=20) :: name
integer :: ictxt, np, me, err_act
integer, allocatable :: ilaggr(:), nlaggr(:)
name='mld_daggr_bld'
if (psb_get_errstatus().ne.0) return
@ -116,7 +117,7 @@ subroutine mld_daggr_bld(a,desc_a,p,info)
! the coarse to the fine level.
!
call mld_aggrmap_bld(p%iprcparm(mld_aggr_alg_),p%rprcparm(mld_aggr_thresh_),&
& a,desc_a,p%nlaggr,p%mlia,info)
& a,desc_a,nlaggr,ilaggr,info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='mld_aggrmap_bld')
goto 9999
@ -127,7 +128,7 @@ subroutine mld_daggr_bld(a,desc_a,p,info)
! the mapping defined by mld_aggrmap_bld and applying the aggregation
! algorithm specified by p%iprcparm(mld_aggr_kind_)
!
call mld_aggrmat_asb(a,desc_a,p,info)
call mld_aggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='mld_aggrmat_asb')
goto 9999

11
mlprec/mld_daggrmat_asb.f90
Unescape Escape View File

@ -83,14 +83,14 @@
! the fine-level matrix.
! desc_a - type(psb_desc_type), input.
! The communication descriptor of the fine-level matrix.
! p - type(mld_d_interlev_prec_type), input/output.
! p - type(mld_d_onelev_type), input/output.
! The one-level preconditioner data structure containing the local
! part of the base preconditioner to be built as well as the
! aggregate matrices.
! info - integer, output.
! Error code.
!
subroutine mld_daggrmat_asb(a,desc_a,p,info)
subroutine mld_daggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info)
use psb_base_mod
use mld_inner_mod, mld_protect_name => mld_daggrmat_asb
@ -100,7 +100,8 @@ subroutine mld_daggrmat_asb(a,desc_a,p,info)
! Arguments
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_d_interlev_prec_type), intent(inout), target :: p
integer, intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_d_onelev_type), intent(inout), target :: p
integer, intent(out) :: info
! Local variables
@ -120,7 +121,7 @@ subroutine mld_daggrmat_asb(a,desc_a,p,info)
select case (p%iprcparm(mld_aggr_kind_))
case (mld_no_smooth_)
call mld_aggrmat_raw_asb(a,desc_a,p,info)
call mld_aggrmat_raw_asb(a,desc_a,ilaggr,nlaggr,p,info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='mld_aggrmat_raw_asb')
goto 9999
@ -128,7 +129,7 @@ subroutine mld_daggrmat_asb(a,desc_a,p,info)
case(mld_smooth_prol_,mld_biz_prol_)
call mld_aggrmat_smth_asb(a,desc_a,p,info)
call mld_aggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,p,info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='mld_aggrmat_smth_asb')
goto 9999

31
mlprec/mld_daggrmat_raw_asb.F90
Unescape Escape View File

@ -66,14 +66,14 @@
! the fine-level matrix.
! desc_a - type(psb_desc_type), input.
! The communication descriptor of the fine-level matrix.
! p - type(mld_d_interlev_prec_type), input/output.
! p - type(mld_d_onelev_type), input/output.
! The one-level preconditioner data structure containing the local
! part of the base preconditioner to be built as well as the
! aggregate matrices.
! info - integer, output.
! Error code.
!
subroutine mld_daggrmat_raw_asb(a,desc_a,p,info)
subroutine mld_daggrmat_raw_asb(a,desc_a,ilaggr,nlaggr,p,info)
use psb_base_mod
use mld_inner_mod, mld_protect_name => mld_daggrmat_raw_asb
@ -86,9 +86,10 @@ subroutine mld_daggrmat_raw_asb(a,desc_a,p,info)
#endif
! Arguments
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_d_interlev_prec_type), intent(inout), target :: p
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer, intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_d_onelev_type), intent(inout), target :: p
integer, intent(out) :: info
! Local variables
@ -118,8 +119,8 @@ subroutine mld_daggrmat_raw_asb(a,desc_a,p,info)
call psb_nullify_sp(am2)
naggr = p%nlaggr(me+1)
ntaggr = sum(p%nlaggr)
naggr = nlaggr(me+1)
ntaggr = sum(nlaggr)
allocate(nzbr(np), idisp(np),stat=info)
if (info /= 0) then
info=4025
@ -128,13 +129,13 @@ subroutine mld_daggrmat_raw_asb(a,desc_a,p,info)
goto 9999
end if
naggrm1=sum(p%nlaggr(1:me))
naggrm1=sum(nlaggr(1:me))
if (p%iprcparm(mld_coarse_mat_) == mld_repl_mat_) then
do i=1, nrow
p%mlia(i) = p%mlia(i) + naggrm1
ilaggr(i) = ilaggr(i) + naggrm1
end do
call psb_halo(p%mlia,desc_a,info)
call psb_halo(ilaggr,desc_a,info)
end if
if(info /= 0) then
@ -156,7 +157,7 @@ subroutine mld_daggrmat_raw_asb(a,desc_a,p,info)
do i=1,nrow
am1%aspk(i) = done
am1%ia1(i) = i
am1%ia2(i) = p%mlia(i)
am1%ia2(i) = ilaggr(i)
end do
am1%infoa(psb_nnz_) = nrow
@ -177,8 +178,8 @@ subroutine mld_daggrmat_raw_asb(a,desc_a,p,info)
nzt = psb_sp_get_nnzeros(b)
do i=1, nzt
b%ia1(i) = p%mlia(b%ia1(i))
b%ia2(i) = p%mlia(b%ia2(i))
b%ia1(i) = ilaggr(b%ia1(i))
b%ia2(i) = ilaggr(b%ia2(i))
enddo
b%m = naggr
b%k = naggr
@ -266,8 +267,8 @@ subroutine mld_daggrmat_raw_asb(a,desc_a,p,info)
! am2 => PR^T i.e. restriction operator
! am1 => PR i.e. prolongation operator
!
p%map = psb_linear_map(psb_map_aggr_,desc_a,&
& p%desc_ac,am2,am1)
p%map = psb_linmap(psb_map_aggr_,desc_a,&
& p%desc_ac,am2,am1,ilaggr,nlaggr)
if (info == 0) call psb_sp_free(am1,info)
if (info == 0) call psb_sp_free(am2,info)
if(info /= 0) then

31
mlprec/mld_daggrmat_smth_asb.F90
Unescape Escape View File

@ -83,14 +83,14 @@
! the fine-level matrix.
! desc_a - type(psb_desc_type), input.
! The communication descriptor of the fine-level matrix.
! p - type(mld_d_interlev_prec_type), input/output.
! p - type(mld_d_onelev_type), input/output.
! The one-level preconditioner data structure containing the local
! part of the base preconditioner to be built as well as the
! aggregate matrices.
! info - integer, output.
! Error code.
!
subroutine mld_daggrmat_smth_asb(a,desc_a,p,info)
subroutine mld_daggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,p,info)
use psb_base_mod
use mld_inner_mod, mld_protect_name => mld_daggrmat_smth_asb
@ -105,7 +105,8 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,p,info)
! Arguments
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_d_interlev_prec_type), intent(inout), target :: p
integer, intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_d_onelev_type), intent(inout), target :: p
integer, intent(out) :: info
! Local variables
@ -147,8 +148,8 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,p,info)
nrow = psb_cd_get_local_rows(desc_a)
ncol = psb_cd_get_local_cols(desc_a)
naggr = p%nlaggr(me+1)
ntaggr = sum(p%nlaggr)
naggr = nlaggr(me+1)
ntaggr = sum(nlaggr)
allocate(nzbr(np), idisp(np),stat=info)
if (info /= 0) then
@ -158,15 +159,15 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,p,info)
goto 9999
end if
naggrm1 = sum(p%nlaggr(1:me))
naggrp1 = sum(p%nlaggr(1:me+1))
naggrm1 = sum(nlaggr(1:me))
naggrp1 = sum(nlaggr(1:me+1))
ml_global_nmb = ( (p%iprcparm(mld_aggr_kind_) == mld_smooth_prol_).or.&
& ( (p%iprcparm(mld_aggr_kind_) == mld_biz_prol_).and.&
& (p%iprcparm(mld_coarse_mat_) == mld_repl_mat_)) )
if (ml_global_nmb) then
p%mlia(1:nrow) = p%mlia(1:nrow) + naggrm1
call psb_halo(p%mlia,desc_a,info)
ilaggr(1:nrow) = ilaggr(1:nrow) + naggrm1
call psb_halo(ilaggr,desc_a,info)
if (info /= 0) then
call psb_errpush(4010,name,a_err='psb_halo')
@ -221,14 +222,14 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,p,info)
do i=1,ncol
am4%aspk(i) = done
am4%ia1(i) = i
am4%ia2(i) = p%mlia(i)
am4%ia2(i) = ilaggr(i)
end do
am4%infoa(psb_nnz_) = ncol
else
do i=1,nrow
am4%aspk(i) = done
am4%ia1(i) = i
am4%ia2(i) = p%mlia(i)
am4%ia2(i) = ilaggr(i)
end do
am4%infoa(psb_nnz_) = nrow
endif
@ -387,7 +388,7 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,p,info)
i=0
!
! Now we have to fix this. The only rows of B that are correct
! are those corresponding to "local" aggregates, i.e. indices in p%mlia(:)
! are those corresponding to "local" aggregates, i.e. indices in ilaggr(:)
!
do k=1, nzl
if ((naggrm1 < am2%ia1(k)) .and.(am2%ia1(k) <= naggrp1)) then
@ -450,7 +451,7 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,p,info)
call psb_sp_clone(b,p%ac,info)
nzac = p%ac%infoa(psb_nnz_)
nzl = p%ac%infoa(psb_nnz_)
if (info == 0) call psb_cdall(ictxt,p%desc_ac,info,nl=p%nlaggr(me+1))
if (info == 0) call psb_cdall(ictxt,p%desc_ac,info,nl=nlaggr(me+1))
if (info == 0) call psb_cdins(nzl,p%ac%ia1,p%ac%ia2,p%desc_ac,info)
if (info == 0) call psb_cdasb(p%desc_ac,info)
if (info == 0) call psb_glob_to_loc(p%ac%ia1(1:nzl),p%desc_ac,info,iact='I')
@ -653,8 +654,8 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,p,info)
! am2 => PR^T i.e. restriction operator
! am1 => PR i.e. prolongation operator
!
p%map = psb_linear_map(psb_map_aggr_,desc_a,&
& p%desc_ac,am2,am1)
p%map = psb_linmap(psb_map_aggr_,desc_a,&
& p%desc_ac,am2,am1,ilaggr,nlaggr)
if (info == 0) call psb_sp_free(am1,info)
if (info == 0) call psb_sp_free(am2,info)
if(info /= 0) then

12
mlprec/mld_dmlprec_aply.f90
Unescape Escape View File

@ -78,7 +78,7 @@
! Arguments:
! alpha - real(psb_dpk_), input.
! The scalar alpha.
! precv - type(mld_d_interlev_prec_type), dimension(:), input.
! precv - type(mld_d_onelev_type), dimension(:), input.
! The array of one-level preconditioner data structures containing the
! local parts of the preconditioners to be applied at each level.
! Note that nlev = size(precv) = number of levels.
@ -148,7 +148,7 @@ subroutine mld_dmlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info)
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_d_interlev_prec_type), intent(in) :: precv(:)
type(mld_d_onelev_type), intent(in) :: precv(:)
real(psb_dpk_),intent(in) :: alpha,beta
real(psb_dpk_),intent(in) :: x(:)
real(psb_dpk_),intent(inout) :: y(:)
@ -340,7 +340,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_d_interlev_prec_type), intent(in) :: precv(:)
type(mld_d_onelev_type), intent(in) :: precv(:)
real(psb_dpk_),intent(in) :: alpha,beta
real(psb_dpk_),intent(in) :: x(:)
real(psb_dpk_),intent(inout) :: y(:)
@ -575,7 +575,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_d_interlev_prec_type), intent(in) :: precv(:)
type(mld_d_onelev_type), intent(in) :: precv(:)
real(psb_dpk_),intent(in) :: alpha,beta
real(psb_dpk_),intent(in) :: x(:)
real(psb_dpk_),intent(inout) :: y(:)
@ -834,7 +834,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_d_interlev_prec_type), intent(in) :: precv(:)
type(mld_d_onelev_type), intent(in) :: precv(:)
real(psb_dpk_),intent(in) :: alpha,beta
real(psb_dpk_),intent(in) :: x(:)
real(psb_dpk_),intent(inout) :: y(:)
@ -1131,7 +1131,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_d_interlev_prec_type), intent(in) :: precv(:)
type(mld_d_onelev_type), intent(in) :: precv(:)
real(psb_dpk_),intent(in) :: alpha,beta
real(psb_dpk_),intent(in) :: x(:)
real(psb_dpk_),intent(inout) :: y(:)

4
mlprec/mld_dprecbld.f90
Unescape Escape View File

@ -225,7 +225,7 @@ subroutine mld_dprecbld(a,desc_a,p,info)
& 'Return from ',i,' call to mlprcbld ',info
if (i>2) then
if (all(p%precv(i)%nlaggr == p%precv(i-1)%nlaggr)) then
if (all(p%precv(i)%map%naggr == p%precv(i-1)%map%naggr)) then
newsz=i-1
end if
call psb_bcast(ictxt,newsz)
@ -348,7 +348,7 @@ contains
end subroutine init_baseprec_av
subroutine check_coarse_lev(prec)
type(mld_d_interlev_prec_type) :: prec
type(mld_d_onelev_type) :: prec
!
! At the coarsest level, check mld_coarse_solve_

116
mlprec/mld_inner_mod.f90
Unescape Escape View File

@ -145,9 +145,9 @@ module mld_inner_mod
interface mld_mlprec_aply
subroutine mld_smlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info)
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_sbaseprec_type, mld_s_interlev_prec_type
use mld_prec_type, only : mld_sbaseprec_type, mld_s_onelev_type
type(psb_desc_type),intent(in) :: desc_data
type(mld_s_interlev_prec_type), intent(in) :: precv(:)
type(mld_s_onelev_type), intent(in) :: precv(:)
real(psb_spk_),intent(in) :: alpha,beta
real(psb_spk_),intent(in) :: x(:)
real(psb_spk_),intent(inout) :: y(:)
@ -157,9 +157,9 @@ module mld_inner_mod
end subroutine mld_smlprec_aply
subroutine mld_dmlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info)
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_dbaseprec_type, mld_d_interlev_prec_type
use mld_prec_type, only : mld_dbaseprec_type, mld_d_onelev_type
type(psb_desc_type),intent(in) :: desc_data
type(mld_d_interlev_prec_type), intent(in) :: precv(:)
type(mld_d_onelev_type), intent(in) :: precv(:)
real(psb_dpk_),intent(in) :: alpha,beta
real(psb_dpk_),intent(in) :: x(:)
real(psb_dpk_),intent(inout) :: y(:)
@ -169,9 +169,9 @@ module mld_inner_mod
end subroutine mld_dmlprec_aply
subroutine mld_cmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_cbaseprec_type, mld_c_interlev_prec_type
use mld_prec_type, only : mld_cbaseprec_type, mld_c_onelev_type
type(psb_desc_type),intent(in) :: desc_data
type(mld_c_interlev_prec_type), intent(in) :: baseprecv(:)
type(mld_c_onelev_type), intent(in) :: baseprecv(:)
complex(psb_spk_),intent(in) :: alpha,beta
complex(psb_spk_),intent(in) :: x(:)
complex(psb_spk_),intent(inout) :: y(:)
@ -181,9 +181,9 @@ module mld_inner_mod
end subroutine mld_cmlprec_aply
subroutine mld_zmlprec_aply(alpha,baseprecv,x,beta,y,desc_data,trans,work,info)
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_zbaseprec_type, mld_z_interlev_prec_type
use mld_prec_type, only : mld_zbaseprec_type, mld_z_onelev_type
type(psb_desc_type),intent(in) :: desc_data
type(mld_z_interlev_prec_type), intent(in) :: baseprecv(:)
type(mld_z_onelev_type), intent(in) :: baseprecv(:)
complex(psb_dpk_),intent(in) :: alpha,beta
complex(psb_dpk_),intent(in) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:)
@ -387,34 +387,34 @@ module mld_inner_mod
interface mld_aggr_bld
subroutine mld_saggr_bld(a,desc_a,p,info)
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_sbaseprec_type, mld_s_interlev_prec_type
use mld_prec_type, only : mld_sbaseprec_type, mld_s_onelev_type
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_s_interlev_prec_type), intent(inout), target :: p
type(mld_s_onelev_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_saggr_bld
subroutine mld_daggr_bld(a,desc_a,p,info)
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_dbaseprec_type, mld_d_interlev_prec_type
use mld_prec_type, only : mld_dbaseprec_type, mld_d_onelev_type
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_d_interlev_prec_type), intent(inout), target :: p
type(mld_d_onelev_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_daggr_bld
subroutine mld_caggr_bld(a,desc_a,p,info)
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_cbaseprec_type, mld_c_interlev_prec_type
use mld_prec_type, only : mld_cbaseprec_type, mld_c_onelev_type
type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_c_interlev_prec_type), intent(inout), target :: p
type(mld_c_onelev_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_caggr_bld
subroutine mld_zaggr_bld(a,desc_a,p,info)
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_zbaseprec_type, mld_z_interlev_prec_type
use mld_prec_type, only : mld_zbaseprec_type, mld_z_onelev_type
type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_z_interlev_prec_type), intent(inout), target :: p
type(mld_z_onelev_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_zaggr_bld
end interface
@ -463,106 +463,118 @@ module mld_inner_mod
end interface
interface mld_aggrmat_asb
subroutine mld_saggrmat_asb(a,desc_a,p,info)
subroutine mld_saggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info)
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_sbaseprec_type, mld_s_interlev_prec_type
use mld_prec_type, only : mld_sbaseprec_type, mld_s_onelev_type
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_s_interlev_prec_type), intent(inout), target :: p
integer, intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_s_onelev_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_saggrmat_asb
subroutine mld_daggrmat_asb(a,desc_a,p,info)
subroutine mld_daggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info)
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_dbaseprec_type, mld_d_interlev_prec_type
use mld_prec_type, only : mld_dbaseprec_type, mld_d_onelev_type
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_d_interlev_prec_type), intent(inout), target :: p
integer, intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_d_onelev_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_daggrmat_asb
subroutine mld_caggrmat_asb(a,desc_a,p,info)
subroutine mld_caggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info)
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_cbaseprec_type, mld_c_interlev_prec_type
use mld_prec_type, only : mld_cbaseprec_type, mld_c_onelev_type
type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_c_interlev_prec_type), intent(inout), target :: p
integer, intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_c_onelev_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_caggrmat_asb
subroutine mld_zaggrmat_asb(a,desc_a,p,info)
subroutine mld_zaggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info)
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_zbaseprec_type, mld_z_interlev_prec_type
use mld_prec_type, only : mld_zbaseprec_type, mld_z_onelev_type
type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_z_interlev_prec_type), intent(inout), target :: p
integer, intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_z_onelev_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_zaggrmat_asb
end interface
interface mld_aggrmat_raw_asb
subroutine mld_saggrmat_raw_asb(a,desc_a,p,info)
subroutine mld_saggrmat_raw_asb(a,desc_a,ilaggr,nlaggr,p,info)
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_sbaseprec_type, mld_s_interlev_prec_type
use mld_prec_type, only : mld_sbaseprec_type, mld_s_onelev_type
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_s_interlev_prec_type), intent(inout), target :: p
integer, intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_s_onelev_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_saggrmat_raw_asb
subroutine mld_daggrmat_raw_asb(a,desc_a,p,info)
subroutine mld_daggrmat_raw_asb(a,desc_a,ilaggr,nlaggr,p,info)
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_dbaseprec_type, mld_d_interlev_prec_type
use mld_prec_type, only : mld_dbaseprec_type, mld_d_onelev_type
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_d_interlev_prec_type), intent(inout), target :: p
integer, intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_d_onelev_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_daggrmat_raw_asb
subroutine mld_caggrmat_raw_asb(a,desc_a,p,info)
subroutine mld_caggrmat_raw_asb(a,desc_a,ilaggr,nlaggr,p,info)
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_cbaseprec_type, mld_c_interlev_prec_type
use mld_prec_type, only : mld_cbaseprec_type, mld_c_onelev_type
type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_c_interlev_prec_type), intent(inout), target :: p
integer, intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_c_onelev_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_caggrmat_raw_asb
subroutine mld_zaggrmat_raw_asb(a,desc_a,p,info)
subroutine mld_zaggrmat_raw_asb(a,desc_a,ilaggr,nlaggr,p,info)
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_zbaseprec_type, mld_z_interlev_prec_type
use mld_prec_type, only : mld_zbaseprec_type, mld_z_onelev_type
type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_z_interlev_prec_type), intent(inout), target :: p
integer, intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_z_onelev_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_zaggrmat_raw_asb
end interface
interface mld_aggrmat_smth_asb
subroutine mld_saggrmat_smth_asb(a,desc_a,p,info)
subroutine mld_saggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,p,info)
use psb_base_mod, only : psb_sspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_sbaseprec_type, mld_s_interlev_prec_type
use mld_prec_type, only : mld_sbaseprec_type, mld_s_onelev_type
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_s_interlev_prec_type), intent(inout), target :: p
integer, intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_s_onelev_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_saggrmat_smth_asb
subroutine mld_daggrmat_smth_asb(a,desc_a,p,info)
subroutine mld_daggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,p,info)
use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_dbaseprec_type, mld_d_interlev_prec_type
use mld_prec_type, only : mld_dbaseprec_type, mld_d_onelev_type
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_d_interlev_prec_type), intent(inout), target :: p
integer, intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_d_onelev_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_daggrmat_smth_asb
subroutine mld_caggrmat_smth_asb(a,desc_a,p,info)
subroutine mld_caggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,p,info)
use psb_base_mod, only : psb_cspmat_type, psb_desc_type, psb_spk_
use mld_prec_type, only : mld_cbaseprec_type, mld_c_interlev_prec_type
use mld_prec_type, only : mld_cbaseprec_type, mld_c_onelev_type
type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_c_interlev_prec_type), intent(inout), target :: p
integer, intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_c_onelev_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_caggrmat_smth_asb
subroutine mld_zaggrmat_smth_asb(a,desc_a,p,info)
subroutine mld_zaggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,p,info)
use psb_base_mod, only : psb_zspmat_type, psb_desc_type, psb_dpk_
use mld_prec_type, only : mld_zbaseprec_type, mld_z_interlev_prec_type
use mld_prec_type, only : mld_zbaseprec_type, mld_z_onelev_type
type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_z_interlev_prec_type), intent(inout), target :: p
integer, intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_z_onelev_type), intent(inout), target :: p
integer, intent(out) :: info
end subroutine mld_zaggrmat_smth_asb
end interface

24
mlprec/mld_move_alloc_mod.F90
Unescape Escape View File

@ -110,7 +110,7 @@ contains
subroutine mld_sonelev_prec_move_alloc(a, b,info)
use psb_base_mod
implicit none
type(mld_s_interlev_prec_type), intent(inout) :: a, b
type(mld_s_onelev_type), intent(inout) :: a, b
integer, intent(out) :: info
call mld_precfree(b,info)
@ -119,8 +119,8 @@ contains
if (info == 0) call psb_move_alloc(a%rprcparm,b%rprcparm,info)
if (info == 0) call psb_move_alloc(a%ac,b%ac,info)
if (info == 0) call psb_move_alloc(a%desc_ac,b%desc_ac,info)
if (info == 0) call psb_move_alloc(a%mlia,b%mlia,info)
if (info == 0) call psb_move_alloc(a%nlaggr,b%nlaggr,info)
!!$ if (info == 0) call psb_move_alloc(a%mlia,b%mlia,info)
!!$ if (info == 0) call psb_move_alloc(a%nlaggr,b%nlaggr,info)
if (info == 0) call psb_move_alloc(a%map,b%map,info)
b%base_a => a%base_a
b%base_desc => a%base_desc
@ -205,7 +205,7 @@ contains
subroutine mld_donelev_prec_move_alloc(a, b,info)
use psb_base_mod
implicit none
type(mld_d_interlev_prec_type), intent(inout) :: a, b
type(mld_d_onelev_type), intent(inout) :: a, b
integer, intent(out) :: info
call mld_precfree(b,info)
@ -214,8 +214,8 @@ contains
if (info == 0) call psb_move_alloc(a%rprcparm,b%rprcparm,info)
if (info == 0) call psb_move_alloc(a%ac,b%ac,info)
if (info == 0) call psb_move_alloc(a%desc_ac,b%desc_ac,info)
if (info == 0) call psb_move_alloc(a%mlia,b%mlia,info)
if (info == 0) call psb_move_alloc(a%nlaggr,b%nlaggr,info)
!!$ if (info == 0) call psb_move_alloc(a%mlia,b%mlia,info)
!!$ if (info == 0) call psb_move_alloc(a%nlaggr,b%nlaggr,info)
if (info == 0) call psb_move_alloc(a%map,b%map,info)
b%base_a => a%base_a
b%base_desc => a%base_desc
@ -300,7 +300,7 @@ contains
subroutine mld_conelev_prec_move_alloc(a, b,info)
use psb_base_mod
implicit none
type(mld_c_interlev_prec_type), intent(inout) :: a, b
type(mld_c_onelev_type), intent(inout) :: a, b
integer, intent(out) :: info
call mld_precfree(b,info)
@ -309,8 +309,8 @@ contains
if (info == 0) call psb_move_alloc(a%rprcparm,b%rprcparm,info)
if (info == 0) call psb_move_alloc(a%ac,b%ac,info)
if (info == 0) call psb_move_alloc(a%desc_ac,b%desc_ac,info)
if (info == 0) call psb_move_alloc(a%mlia,b%mlia,info)
if (info == 0) call psb_move_alloc(a%nlaggr,b%nlaggr,info)
!!$ if (info == 0) call psb_move_alloc(a%mlia,b%mlia,info)
!!$ if (info == 0) call psb_move_alloc(a%nlaggr,b%nlaggr,info)
if (info == 0) call psb_move_alloc(a%map,b%map,info)
b%base_a => a%base_a
b%base_desc => a%base_desc
@ -395,7 +395,7 @@ contains
subroutine mld_zonelev_prec_move_alloc(a, b,info)
use psb_base_mod
implicit none
type(mld_z_interlev_prec_type), intent(inout) :: a, b
type(mld_z_onelev_type), intent(inout) :: a, b
integer, intent(out) :: info
call mld_precfree(b,info)
@ -404,8 +404,8 @@ contains
if (info == 0) call psb_move_alloc(a%rprcparm,b%rprcparm,info)
if (info == 0) call psb_move_alloc(a%ac,b%ac,info)
if (info == 0) call psb_move_alloc(a%desc_ac,b%desc_ac,info)
if (info == 0) call psb_move_alloc(a%mlia,b%mlia,info)
if (info == 0) call psb_move_alloc(a%nlaggr,b%nlaggr,info)
!!$ if (info == 0) call psb_move_alloc(a%mlia,b%mlia,info)
!!$ if (info == 0) call psb_move_alloc(a%nlaggr,b%nlaggr,info)
if (info == 0) call psb_move_alloc(a%map,b%map,info)
b%base_a => a%base_a
b%base_desc => a%base_desc

189
mlprec/mld_prec_type.f90
Unescape Escape View File

@ -65,7 +65,7 @@ module mld_prec_type
use psb_base_mod, only :&
& psb_dspmat_type, psb_zspmat_type,&
& psb_sspmat_type, psb_cspmat_type,&
& psb_desc_type, psb_linear_map_type,&
& psb_desc_type, psb_linmap_type,&
& psb_dpk_, psb_spk_, psb_long_int_k_, &
& psb_sp_free, psb_cdfree, psb_halo_, psb_none_, psb_sum_, psb_avg_, &
& psb_nohalo_, psb_square_root_, psb_toupper, psb_root_,&
@ -91,14 +91,14 @@ module mld_prec_type
! one, i.e. level 1 is the finest level and A(1) is the matrix A.
!
!| type mld_Xprec_type
!| type(mld_X_interlev_prec_type), allocatable :: precv(:)
!| type(mld_X_onelev_type), allocatable :: precv(:)
!| end type mld_Xprec_type
!|
!
! precv(ilev) is the preconditioner at level ilev.
! The number of levels is given by size(precv(:)).
!
! Type: mld_X_interlev_prec_type.
! Type: mld_X_onelev_type.
! The data type containing necessary items for the current level.
!
! type(mld_Xbaseprec_type) - prec
@ -175,20 +175,19 @@ module mld_prec_type
integer, allocatable :: perm(:), invperm(:)
end type mld_sbaseprec_type
type mld_s_interlev_prec_type
type(mld_sbaseprec_type) :: prec
integer, allocatable :: iprcparm(:)
real(psb_spk_), allocatable :: rprcparm(:)
type(psb_sspmat_type) :: ac
type(psb_desc_type) :: desc_ac
integer, allocatable :: mlia(:), nlaggr(:)
type(psb_sspmat_type), pointer :: base_a => null()
type(psb_desc_type), pointer :: base_desc => null()
type(psb_linear_map_type) :: map
end type mld_s_interlev_prec_type
type mld_s_onelev_type
type(mld_sbaseprec_type) :: prec
integer, allocatable :: iprcparm(:)
real(psb_spk_), allocatable :: rprcparm(:)
type(psb_sspmat_type) :: ac
type(psb_desc_type) :: desc_ac
type(psb_sspmat_type), pointer :: base_a => null()
type(psb_desc_type), pointer :: base_desc => null()
type(psb_linmap_type) :: map
end type mld_s_onelev_type
type mld_sprec_type
type(mld_s_interlev_prec_type), allocatable :: precv(:)
type(mld_s_onelev_type), allocatable :: precv(:)
end type mld_sprec_type
type mld_dbaseprec_type
@ -200,20 +199,20 @@ module mld_prec_type
integer, allocatable :: perm(:), invperm(:)
end type mld_dbaseprec_type
type mld_d_interlev_prec_type
type(mld_dbaseprec_type) :: prec
integer, allocatable :: iprcparm(:)
real(psb_dpk_), allocatable :: rprcparm(:)
type(psb_dspmat_type) :: ac
type(psb_desc_type) :: desc_ac
integer, allocatable :: mlia(:), nlaggr(:)
type(psb_dspmat_type), pointer :: base_a => null()
type(psb_desc_type), pointer :: base_desc => null()
type(psb_linear_map_type) :: map
end type mld_d_interlev_prec_type
type mld_d_onelev_type
type(mld_dbaseprec_type) :: prec
integer, allocatable :: iprcparm(:)
real(psb_dpk_), allocatable :: rprcparm(:)
type(psb_dspmat_type) :: ac
type(psb_desc_type) :: desc_ac
!integer, allocatable :: mlia(:), nlaggr(:)
type(psb_dspmat_type), pointer :: base_a => null()
type(psb_desc_type), pointer :: base_desc => null()
type(psb_linmap_type) :: map
end type mld_d_onelev_type
type mld_dprec_type
type(mld_d_interlev_prec_type), allocatable :: precv(:)
type(mld_d_onelev_type), allocatable :: precv(:)
end type mld_dprec_type
@ -226,20 +225,19 @@ module mld_prec_type
integer, allocatable :: perm(:), invperm(:)
end type mld_cbaseprec_type
type mld_c_interlev_prec_type
type(mld_cbaseprec_type) :: prec
integer, allocatable :: iprcparm(:)
real(psb_spk_), allocatable :: rprcparm(:)
type(psb_cspmat_type) :: ac
type(psb_desc_type) :: desc_ac
integer, allocatable :: mlia(:), nlaggr(:)
type(psb_cspmat_type), pointer :: base_a => null()
type(psb_desc_type), pointer :: base_desc => null()
type(psb_linear_map_type) :: map
end type mld_c_interlev_prec_type
type mld_c_onelev_type
type(mld_cbaseprec_type) :: prec
integer, allocatable :: iprcparm(:)
real(psb_spk_), allocatable :: rprcparm(:)
type(psb_cspmat_type) :: ac
type(psb_desc_type) :: desc_ac
type(psb_cspmat_type), pointer :: base_a => null()
type(psb_desc_type), pointer :: base_desc => null()
type(psb_linmap_type) :: map
end type mld_c_onelev_type
type mld_cprec_type
type(mld_c_interlev_prec_type), allocatable :: precv(:)
type(mld_c_onelev_type), allocatable :: precv(:)
end type mld_cprec_type
type mld_zbaseprec_type
@ -251,20 +249,19 @@ module mld_prec_type
integer, allocatable :: perm(:), invperm(:)
end type mld_zbaseprec_type
type mld_z_interlev_prec_type
type(mld_zbaseprec_type) :: prec
integer, allocatable :: iprcparm(:)
real(psb_dpk_), allocatable :: rprcparm(:)
type(psb_zspmat_type) :: ac
type(psb_desc_type) :: desc_ac
integer, allocatable :: mlia(:), nlaggr(:)
type(psb_zspmat_type), pointer :: base_a => null()
type(psb_desc_type), pointer :: base_desc => null()
type(psb_linear_map_type) :: map
end type mld_z_interlev_prec_type
type mld_z_onelev_type
type(mld_zbaseprec_type) :: prec
integer, allocatable :: iprcparm(:)
real(psb_dpk_), allocatable :: rprcparm(:)
type(psb_zspmat_type) :: ac
type(psb_desc_type) :: desc_ac
type(psb_zspmat_type), pointer :: base_a => null()
type(psb_desc_type), pointer :: base_desc => null()
type(psb_linmap_type) :: map
end type mld_z_onelev_type
type mld_zprec_type
type(mld_z_interlev_prec_type), allocatable :: precv(:)
type(mld_z_onelev_type), allocatable :: precv(:)
end type mld_zprec_type
@ -754,7 +751,7 @@ contains
function mld_s_onelev_prec_sizeof(prec) result(val)
implicit none
type(mld_s_interlev_prec_type), intent(in) :: prec
type(mld_s_onelev_type), intent(in) :: prec
integer(psb_long_int_k_) :: val
integer :: i
@ -771,7 +768,7 @@ contains
function mld_d_onelev_prec_sizeof(prec) result(val)
implicit none
type(mld_d_interlev_prec_type), intent(in) :: prec
type(mld_d_onelev_type), intent(in) :: prec
integer(psb_long_int_k_) :: val
integer :: i
@ -788,7 +785,7 @@ contains
function mld_c_onelev_prec_sizeof(prec) result(val)
implicit none
type(mld_c_interlev_prec_type), intent(in) :: prec
type(mld_c_onelev_type), intent(in) :: prec
integer(psb_long_int_k_) :: val
integer :: i
@ -805,7 +802,7 @@ contains
function mld_z_onelev_prec_sizeof(prec) result(val)
implicit none
type(mld_z_interlev_prec_type), intent(in) :: prec
type(mld_z_onelev_type), intent(in) :: prec
integer(psb_long_int_k_) :: val
integer :: i
@ -1152,7 +1149,7 @@ contains
write(iout_,*)
do ilev = 2, nlev-1
call mld_ml_level_descr(iout_,ilev,p%precv(ilev)%iprcparm,&
& p%precv(ilev)%nlaggr,info,&
& p%precv(ilev)%map%naggr,info,&
& dprcparm=p%precv(ilev)%rprcparm)
end do
@ -1164,7 +1161,7 @@ contains
write(iout_,*)
call mld_ml_coarse_descr(iout_,ilev,&
& p%precv(ilev)%iprcparm,p%precv(ilev)%prec%iprcparm,&
& p%precv(ilev)%nlaggr,info,&
& p%precv(ilev)%map%naggr,info,&
& dprcparm=p%precv(ilev)%rprcparm,&
& dprcparm2=p%precv(ilev)%prec%rprcparm)
end if
@ -1272,7 +1269,7 @@ contains
write(iout_,*)
do ilev = 2, nlev-1
call mld_ml_level_descr(iout_,ilev,p%precv(ilev)%iprcparm,&
& p%precv(ilev)%nlaggr,info,&
& p%precv(ilev)%map%naggr,info,&
& rprcparm=p%precv(ilev)%rprcparm)
end do
@ -1284,7 +1281,7 @@ contains
write(iout_,*)
call mld_ml_coarse_descr(iout_,ilev,&
& p%precv(ilev)%iprcparm,p%precv(ilev)%prec%iprcparm,&
& p%precv(ilev)%nlaggr,info,&
& p%precv(ilev)%map%naggr,info,&
& rprcparm=p%precv(ilev)%rprcparm, &
& rprcparm2=p%precv(ilev)%prec%rprcparm)
@ -1416,7 +1413,7 @@ contains
write(iout_,*)
do ilev = 2, nlev-1
call mld_ml_level_descr(iout_,ilev,p%precv(ilev)%iprcparm,&
& p%precv(ilev)%nlaggr,info,&
& p%precv(ilev)%map%naggr,info,&
& dprcparm=p%precv(ilev)%rprcparm)
end do
@ -1428,7 +1425,7 @@ contains
write(iout_,*)
call mld_ml_coarse_descr(iout_,ilev,&
& p%precv(ilev)%iprcparm,p%precv(ilev)%prec%iprcparm,&
& p%precv(ilev)%nlaggr,info,&
& p%precv(ilev)%map%naggr,info,&
& dprcparm=p%precv(ilev)%rprcparm,&
& dprcparm2=p%precv(ilev)%prec%rprcparm)
end if
@ -1535,7 +1532,7 @@ contains
do ilev = 2, nlev-1
call mld_ml_level_descr(iout_,ilev,p%precv(ilev)%iprcparm,&
& p%precv(ilev)%nlaggr,info,&
& p%precv(ilev)%map%naggr,info,&
& rprcparm=p%precv(ilev)%rprcparm)
end do
@ -1547,7 +1544,7 @@ contains
write(iout_,*)
call mld_ml_coarse_descr(iout_,ilev,&
& p%precv(ilev)%iprcparm,p%precv(ilev)%prec%iprcparm,&
& p%precv(ilev)%nlaggr,info,&
& p%precv(ilev)%map%naggr,info,&
& rprcparm=p%precv(ilev)%rprcparm,&
& rprcparm2=p%precv(ilev)%prec%rprcparm)
end if
@ -1872,7 +1869,7 @@ contains
subroutine mld_s_onelev_precfree(p,info)
implicit none
type(mld_s_interlev_prec_type), intent(inout) :: p
type(mld_s_onelev_type), intent(inout) :: p
integer, intent(out) :: info
integer :: i
@ -1894,14 +1891,6 @@ contains
! This is a pointer to something else, must not free it here.
nullify(p%base_desc)
if (allocated(p%mlia)) then
deallocate(p%mlia,stat=info)
endif
if (allocated(p%nlaggr)) then
deallocate(p%nlaggr,stat=info)
endif
!
! free explicitly map???
! For now thanks to allocatable semantics
@ -1915,7 +1904,7 @@ contains
subroutine mld_nullify_s_onelevprec(p)
implicit none
type(mld_s_interlev_prec_type), intent(inout) :: p
type(mld_s_onelev_type), intent(inout) :: p
nullify(p%base_a)
nullify(p%base_desc)
@ -1927,8 +1916,8 @@ contains
type(mld_sbaseprec_type), intent(inout) :: p
!!$ nullify(p%base_a)
!!$ nullify(p%base_desc)
nullify(p%base_a)
nullify(p%base_desc)
end subroutine mld_nullify_sbaseprec
@ -1997,7 +1986,7 @@ contains
subroutine mld_d_onelev_precfree(p,info)
implicit none
type(mld_d_interlev_prec_type), intent(inout) :: p
type(mld_d_onelev_type), intent(inout) :: p
integer, intent(out) :: info
integer :: i
@ -2019,14 +2008,6 @@ contains
! This is a pointer to something else, must not free it here.
nullify(p%base_desc)
if (allocated(p%mlia)) then
deallocate(p%mlia,stat=info)
endif
if (allocated(p%nlaggr)) then
deallocate(p%nlaggr,stat=info)
endif
!
! free explicitly map???
! For now thanks to allocatable semantics
@ -2040,16 +2021,16 @@ contains
implicit none
type(mld_dbaseprec_type), intent(inout) :: p
!!$
!!$ nullify(p%base_a)
!!$ nullify(p%base_desc)
nullify(p%base_a)
nullify(p%base_desc)
end subroutine mld_nullify_dbaseprec
subroutine mld_nullify_d_onelevprec(p)
implicit none
type(mld_d_interlev_prec_type), intent(inout) :: p
type(mld_d_onelev_type), intent(inout) :: p
nullify(p%base_a)
nullify(p%base_desc)
@ -2109,7 +2090,7 @@ contains
subroutine mld_c_onelev_precfree(p,info)
implicit none
type(mld_c_interlev_prec_type), intent(inout) :: p
type(mld_c_onelev_type), intent(inout) :: p
integer, intent(out) :: info
integer :: i
@ -2131,14 +2112,6 @@ contains
! This is a pointer to something else, must not free it here.
nullify(p%base_desc)
if (allocated(p%mlia)) then
deallocate(p%mlia,stat=info)
endif
if (allocated(p%nlaggr)) then
deallocate(p%nlaggr,stat=info)
endif
!
! free explicitly map???
! For now thanks to allocatable semantics
@ -2151,7 +2124,7 @@ contains
subroutine mld_nullify_c_onelevprec(p)
implicit none
type(mld_c_interlev_prec_type), intent(inout) :: p
type(mld_c_onelev_type), intent(inout) :: p
nullify(p%base_a)
nullify(p%base_desc)
@ -2163,8 +2136,8 @@ contains
type(mld_cbaseprec_type), intent(inout) :: p
!!$ nullify(p%base_a)
!!$ nullify(p%base_desc)
nullify(p%base_a)
nullify(p%base_desc)
end subroutine mld_nullify_cbaseprec
@ -2225,7 +2198,7 @@ contains
subroutine mld_z_onelev_precfree(p,info)
implicit none
type(mld_z_interlev_prec_type), intent(inout) :: p
type(mld_z_onelev_type), intent(inout) :: p
integer, intent(out) :: info
integer :: i
@ -2247,14 +2220,6 @@ contains
! This is a pointer to something else, must not free it here.
nullify(p%base_desc)
if (allocated(p%mlia)) then
deallocate(p%mlia,stat=info)
endif
if (allocated(p%nlaggr)) then
deallocate(p%nlaggr,stat=info)
endif
!
! free explicitly map???
! For now thanks to allocatable semantics
@ -2267,7 +2232,7 @@ contains
subroutine mld_nullify_z_onelevprec(p)
implicit none
type(mld_z_interlev_prec_type), intent(inout) :: p
type(mld_z_onelev_type), intent(inout) :: p
nullify(p%base_a)
nullify(p%base_desc)
@ -2280,8 +2245,8 @@ contains
type(mld_zbaseprec_type), intent(inout) :: p
!!$ nullify(p%base_a)
!!$ nullify(p%base_desc)
nullify(p%base_a)
nullify(p%base_desc)
end subroutine mld_nullify_zbaseprec

20
mlprec/mld_saggr_bld.f90
Unescape Escape View File

@ -49,6 +49,11 @@
!
!
! Arguments:
! a - type(psb_sspmat_type).
! The sparse matrix structure containing the local part of the
! matrix to be preconditioned.
! desc_a - type(psb_desc_type), input.
! The communication descriptor of a.
! p - type(mld_s_onelev_type), input/output.
! The preconditioner data structure containing the local
! part of the one-level preconditioner to be built.
@ -65,14 +70,15 @@ subroutine mld_saggr_bld(a,desc_a,p,info)
! Arguments
type(psb_sspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_s_interlev_prec_type), intent(inout),target :: p
type(mld_s_onelev_type), intent(inout),target :: p
integer, intent(out) :: info
! Local variables
type(psb_desc_type) :: desc_ac
type(psb_sspmat_type) :: ac
character(len=20) :: name
integer :: ictxt, np, me, err_act
type(psb_desc_type) :: desc_ac
type(psb_sspmat_type) :: ac
character(len=20) :: name
integer :: ictxt, np, me, err_act
integer, allocatable :: ilaggr(:), nlaggr(:)
name='mld_saggr_bld'
if (psb_get_errstatus().ne.0) return
@ -111,7 +117,7 @@ subroutine mld_saggr_bld(a,desc_a,p,info)
! the coarse to the fine level.
!
call mld_aggrmap_bld(p%iprcparm(mld_aggr_alg_),p%rprcparm(mld_aggr_thresh_),&
& a,desc_a,p%nlaggr,p%mlia,info)
& a,desc_a,nlaggr,ilaggr,info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='mld_aggrmap_bld')
goto 9999
@ -122,7 +128,7 @@ subroutine mld_saggr_bld(a,desc_a,p,info)
! the mapping defined by mld_aggrmap_bld and applying the aggregation
! algorithm specified by p%iprcparm(mld_aggr_kind_)
!
call mld_aggrmat_asb(a,desc_a,p,info)
call mld_aggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='mld_aggrmat_asb')
goto 9999

11
mlprec/mld_saggrmat_asb.f90
Unescape Escape View File

@ -83,14 +83,14 @@
! the fine-level matrix.
! desc_a - type(psb_desc_type), input.
! The communication descriptor of the fine-level matrix.
! p - type(mld_s_interlev_prec_type), input/output.
! p - type(mld_s_onelev_type), input/output.
! The one-level preconditioner data structure containing the local
! part of the base preconditioner to be built as well as the
! aggregate matrices.
! info - integer, output.
! Error code.
!
subroutine mld_saggrmat_asb(a,desc_a,p,info)
subroutine mld_saggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info)
use psb_base_mod
use mld_inner_mod, mld_protect_name => mld_saggrmat_asb
@ -100,7 +100,8 @@ subroutine mld_saggrmat_asb(a,desc_a,p,info)
! Arguments
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_s_interlev_prec_type), intent(inout), target :: p
integer, intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_s_onelev_type), intent(inout), target :: p
integer, intent(out) :: info
! Local variables
@ -120,7 +121,7 @@ subroutine mld_saggrmat_asb(a,desc_a,p,info)
select case (p%iprcparm(mld_aggr_kind_))
case (mld_no_smooth_)
call mld_aggrmat_raw_asb(a,desc_a,p,info)
call mld_aggrmat_raw_asb(a,desc_a,ilaggr,nlaggr,p,info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='mld_aggrmat_raw_asb')
goto 9999
@ -128,7 +129,7 @@ subroutine mld_saggrmat_asb(a,desc_a,p,info)
case(mld_smooth_prol_,mld_biz_prol_)
call mld_aggrmat_smth_asb(a,desc_a,p,info)
call mld_aggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,p,info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='mld_aggrmat_smth_asb')
goto 9999

27
mlprec/mld_saggrmat_raw_asb.F90
Unescape Escape View File

@ -66,14 +66,14 @@
! the fine-level matrix.
! desc_a - type(psb_desc_type), input.
! The communication descriptor of the fine-level matrix.
! p - type(mld_s_interlev_prec_type), input/output.
! p - type(mld_s_onelev_type), input/output.
! The one-level preconditioner data structure containing the local
! part of the base preconditioner to be built as well as the
! aggregate matrices.
! info - integer, output.
! Error code.
!
subroutine mld_saggrmat_raw_asb(a,desc_a,p,info)
subroutine mld_saggrmat_raw_asb(a,desc_a,ilaggr,nlaggr,p,info)
use psb_base_mod
use mld_inner_mod, mld_protect_name => mld_saggrmat_raw_asb
@ -88,7 +88,8 @@ subroutine mld_saggrmat_raw_asb(a,desc_a,p,info)
! Arguments
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_s_interlev_prec_type), intent(inout), target :: p
integer, intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_s_onelev_type), intent(inout), target :: p
integer, intent(out) :: info
! Local variables
@ -118,8 +119,8 @@ subroutine mld_saggrmat_raw_asb(a,desc_a,p,info)
call psb_nullify_sp(am2)
naggr = p%nlaggr(me+1)
ntaggr = sum(p%nlaggr)
naggr = nlaggr(me+1)
ntaggr = sum(nlaggr)
allocate(nzbr(np), idisp(np),stat=info)
if (info /= 0) then
info=4025
@ -128,13 +129,13 @@ subroutine mld_saggrmat_raw_asb(a,desc_a,p,info)
goto 9999
end if
naggrm1=sum(p%nlaggr(1:me))
naggrm1=sum(nlaggr(1:me))
if (p%iprcparm(mld_coarse_mat_) == mld_repl_mat_) then
do i=1, nrow
p%mlia(i) = p%mlia(i) + naggrm1
ilaggr(i) = ilaggr(i) + naggrm1
end do
call psb_halo(p%mlia,desc_a,info)
call psb_halo(ilaggr,desc_a,info)
end if
if(info /= 0) then
@ -156,7 +157,7 @@ subroutine mld_saggrmat_raw_asb(a,desc_a,p,info)
do i=1,nrow
am1%aspk(i) = sone
am1%ia1(i) = i
am1%ia2(i) = p%mlia(i)
am1%ia2(i) = ilaggr(i)
end do
am1%infoa(psb_nnz_) = nrow
@ -177,8 +178,8 @@ subroutine mld_saggrmat_raw_asb(a,desc_a,p,info)
nzt = psb_sp_get_nnzeros(b)
do i=1, nzt
b%ia1(i) = p%mlia(b%ia1(i))
b%ia2(i) = p%mlia(b%ia2(i))
b%ia1(i) = ilaggr(b%ia1(i))
b%ia2(i) = ilaggr(b%ia2(i))
enddo
b%m = naggr
b%k = naggr
@ -266,8 +267,8 @@ subroutine mld_saggrmat_raw_asb(a,desc_a,p,info)
! am2 => PR^T i.e. restriction operator
! am1 => PR i.e. prolongation operator
!
p%map = psb_linear_map(psb_map_aggr_,desc_a,&
& p%desc_ac,am2,am1)
p%map = psb_linmap(psb_map_aggr_,desc_a,&
& p%desc_ac,am2,am1,ilaggr,nlaggr)
if (info == 0) call psb_sp_free(am1,info)
if (info == 0) call psb_sp_free(am2,info)
if(info /= 0) then

31
mlprec/mld_saggrmat_smth_asb.F90
Unescape Escape View File

@ -83,14 +83,14 @@
! the fine-level matrix.
! desc_a - type(psb_desc_type), input.
! The communication descriptor of the fine-level matrix.
! p - type(mld_s_interlev_prec_type), input/output.
! p - type(mld_s_onelev_type), input/output.
! The one-level preconditioner data structure containing the local
! part of the base preconditioner to be built as well as the
! aggregate matrices.
! info - integer, output.
! Error code.
!
subroutine mld_saggrmat_smth_asb(a,desc_a,p,info)
subroutine mld_saggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,p,info)
use psb_base_mod
use mld_inner_mod, mld_protect_name => mld_saggrmat_smth_asb
@ -105,7 +105,8 @@ subroutine mld_saggrmat_smth_asb(a,desc_a,p,info)
! Arguments
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_s_interlev_prec_type), intent(inout), target :: p
integer, intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_s_onelev_type), intent(inout), target :: p
integer, intent(out) :: info
! Local variables
@ -147,8 +148,8 @@ subroutine mld_saggrmat_smth_asb(a,desc_a,p,info)
nrow = psb_cd_get_local_rows(desc_a)
ncol = psb_cd_get_local_cols(desc_a)
naggr = p%nlaggr(me+1)
ntaggr = sum(p%nlaggr)
naggr = nlaggr(me+1)
ntaggr = sum(nlaggr)
allocate(nzbr(np), idisp(np),stat=info)
if (info /= 0) then
@ -158,15 +159,15 @@ subroutine mld_saggrmat_smth_asb(a,desc_a,p,info)
goto 9999
end if
naggrm1 = sum(p%nlaggr(1:me))
naggrp1 = sum(p%nlaggr(1:me+1))
naggrm1 = sum(nlaggr(1:me))
naggrp1 = sum(nlaggr(1:me+1))
ml_global_nmb = ( (p%iprcparm(mld_aggr_kind_) == mld_smooth_prol_).or.&
& ( (p%iprcparm(mld_aggr_kind_) == mld_biz_prol_).and.&
& (p%iprcparm(mld_coarse_mat_) == mld_repl_mat_)) )
if (ml_global_nmb) then
p%mlia(1:nrow) = p%mlia(1:nrow) + naggrm1
call psb_halo(p%mlia,desc_a,info)
ilaggr(1:nrow) = ilaggr(1:nrow) + naggrm1
call psb_halo(ilaggr,desc_a,info)
if (info /= 0) then
call psb_errpush(4010,name,a_err='psb_halo')
@ -221,14 +222,14 @@ subroutine mld_saggrmat_smth_asb(a,desc_a,p,info)
do i=1,ncol
am4%aspk(i) = sone
am4%ia1(i) = i
am4%ia2(i) = p%mlia(i)
am4%ia2(i) = ilaggr(i)
end do
am4%infoa(psb_nnz_) = ncol
else
do i=1,nrow
am4%aspk(i) = sone
am4%ia1(i) = i
am4%ia2(i) = p%mlia(i)
am4%ia2(i) = ilaggr(i)
end do
am4%infoa(psb_nnz_) = nrow
endif
@ -387,7 +388,7 @@ subroutine mld_saggrmat_smth_asb(a,desc_a,p,info)
i=0
!
! Now we have to fix this. The only rows of B that are correct
! are those corresponding to "local" aggregates, i.e. indices in p%mlia(:)
! are those corresponding to "local" aggregates, i.e. indices in ilaggr(:)
!
do k=1, nzl
if ((naggrm1 < am2%ia1(k)) .and.(am2%ia1(k) <= naggrp1)) then
@ -450,7 +451,7 @@ subroutine mld_saggrmat_smth_asb(a,desc_a,p,info)
call psb_sp_clone(b,p%ac,info)
nzac = p%ac%infoa(psb_nnz_)
nzl = p%ac%infoa(psb_nnz_)
if (info == 0) call psb_cdall(ictxt,p%desc_ac,info,nl=p%nlaggr(me+1))
if (info == 0) call psb_cdall(ictxt,p%desc_ac,info,nl=nlaggr(me+1))
if (info == 0) call psb_cdins(nzl,p%ac%ia1,p%ac%ia2,p%desc_ac,info)
if (info == 0) call psb_cdasb(p%desc_ac,info)
if (info == 0) call psb_glob_to_loc(p%ac%ia1(1:nzl),p%desc_ac,info,iact='I')
@ -653,8 +654,8 @@ subroutine mld_saggrmat_smth_asb(a,desc_a,p,info)
! am2 => PR^T i.e. restriction operator
! am1 => PR i.e. prolongation operator
!
p%map = psb_linear_map(psb_map_aggr_,desc_a,&
& p%desc_ac,am2,am1)
p%map = psb_linmap(psb_map_aggr_,desc_a,&
& p%desc_ac,am2,am1,ilaggr,nlaggr)
if (info == 0) call psb_sp_free(am1,info)
if (info == 0) call psb_sp_free(am2,info)
if(info /= 0) then

12
mlprec/mld_smlprec_aply.f90
Unescape Escape View File

@ -78,7 +78,7 @@
! Arguments:
! alpha - real(psb_spk_), input.
! The scalar alpha.
! precv - type(mld_s_interlev_prec_type), dimension(:), input.
! precv - type(mld_s_onelev_type), dimension(:), input.
! The array of one-level preconditioner data structures containing the
! local parts of the preconditioners to be applied at each level.
! Note that nlev = size(precv) = number of levels.
@ -148,7 +148,7 @@ subroutine mld_smlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info)
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_s_interlev_prec_type), intent(in) :: precv(:)
type(mld_s_onelev_type), intent(in) :: precv(:)
real(psb_spk_),intent(in) :: alpha,beta
real(psb_spk_),intent(in) :: x(:)
real(psb_spk_),intent(inout) :: y(:)
@ -340,7 +340,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_s_interlev_prec_type), intent(in) :: precv(:)
type(mld_s_onelev_type), intent(in) :: precv(:)
real(psb_spk_),intent(in) :: alpha,beta
real(psb_spk_),intent(in) :: x(:)
real(psb_spk_),intent(inout) :: y(:)
@ -575,7 +575,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_s_interlev_prec_type), intent(in) :: precv(:)
type(mld_s_onelev_type), intent(in) :: precv(:)
real(psb_spk_),intent(in) :: alpha,beta
real(psb_spk_),intent(in) :: x(:)
real(psb_spk_),intent(inout) :: y(:)
@ -834,7 +834,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_s_interlev_prec_type), intent(in) :: precv(:)
type(mld_s_onelev_type), intent(in) :: precv(:)
real(psb_spk_),intent(in) :: alpha,beta
real(psb_spk_),intent(in) :: x(:)
real(psb_spk_),intent(inout) :: y(:)
@ -1131,7 +1131,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_s_interlev_prec_type), intent(in) :: precv(:)
type(mld_s_onelev_type), intent(in) :: precv(:)
real(psb_spk_),intent(in) :: alpha,beta
real(psb_spk_),intent(in) :: x(:)
real(psb_spk_),intent(inout) :: y(:)

4
mlprec/mld_sprecbld.f90
Unescape Escape View File

@ -225,7 +225,7 @@ subroutine mld_sprecbld(a,desc_a,p,info)
& 'Return from ',i,' call to mlprcbld ',info
if (i>2) then
if (all(p%precv(i)%nlaggr == p%precv(i-1)%nlaggr)) then
if (all(p%precv(i)%map%naggr == p%precv(i-1)%map%naggr)) then
newsz=i-1
end if
call psb_bcast(ictxt,newsz)
@ -348,7 +348,7 @@ contains
end subroutine init_baseprec_av
subroutine check_coarse_lev(prec)
type(mld_s_interlev_prec_type) :: prec
type(mld_s_onelev_type) :: prec
!
! At the coarsest level, check mld_coarse_solve_

15
mlprec/mld_zaggr_bld.f90
Unescape Escape View File

@ -70,14 +70,15 @@ subroutine mld_zaggr_bld(a,desc_a,p,info)
! Arguments
type(psb_zspmat_type), intent(in), target :: a
type(psb_desc_type), intent(in), target :: desc_a
type(mld_z_interlev_prec_type), intent(inout),target :: p
type(mld_z_onelev_type), intent(inout),target :: p
integer, intent(out) :: info
! Local variables
type(psb_desc_type) :: desc_ac
type(psb_zspmat_type) :: ac
character(len=20) :: name
integer :: ictxt, np, me, err_act
type(psb_desc_type) :: desc_ac
type(psb_zspmat_type) :: ac
character(len=20) :: name
integer :: ictxt, np, me, err_act
integer, allocatable :: ilaggr(:), nlaggr(:)
name='mld_zaggr_bld'
if (psb_get_errstatus().ne.0) return
@ -116,7 +117,7 @@ subroutine mld_zaggr_bld(a,desc_a,p,info)
! the coarse to the fine level.
!
call mld_aggrmap_bld(p%iprcparm(mld_aggr_alg_),p%rprcparm(mld_aggr_thresh_),&
& a,desc_a,p%nlaggr,p%mlia,info)
& a,desc_a,nlaggr,ilaggr,info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='mld_aggrmap_bld')
goto 9999
@ -127,7 +128,7 @@ subroutine mld_zaggr_bld(a,desc_a,p,info)
! the mapping defined by mld_aggrmap_bld and applying the aggregation
! algorithm specified by p%iprcparm(mld_aggr_kind_)
!
call mld_aggrmat_asb(a,desc_a,p,info)
call mld_aggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='mld_aggrmat_asb')
goto 9999

11
mlprec/mld_zaggrmat_asb.f90
Unescape Escape View File

@ -83,14 +83,14 @@
! the fine-level matrix.
! desc_a - type(psb_desc_type), input.
! The communication descriptor of the fine-level matrix.
! p - type(mld_z_interlev_prec_type), input/output.
! p - type(mld_z_onelev_type), input/output.
! The one-level preconditioner data structure containing the local
! part of the base preconditioner to be built as well as the
! aggregate matrices.
! info - integer, output.
! Error code.
!
subroutine mld_zaggrmat_asb(a,desc_a,p,info)
subroutine mld_zaggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info)
use psb_base_mod
use mld_inner_mod, mld_protect_name => mld_zaggrmat_asb
@ -100,7 +100,8 @@ subroutine mld_zaggrmat_asb(a,desc_a,p,info)
! Arguments
type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_z_interlev_prec_type), intent(inout), target :: p
integer, intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_z_onelev_type), intent(inout), target :: p
integer, intent(out) :: info
! Local variables
@ -120,7 +121,7 @@ subroutine mld_zaggrmat_asb(a,desc_a,p,info)
select case (p%iprcparm(mld_aggr_kind_))
case (mld_no_smooth_)
call mld_aggrmat_raw_asb(a,desc_a,p,info)
call mld_aggrmat_raw_asb(a,desc_a,ilaggr,nlaggr,p,info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='mld_aggrmat_raw_asb')
goto 9999
@ -128,7 +129,7 @@ subroutine mld_zaggrmat_asb(a,desc_a,p,info)
case(mld_smooth_prol_,mld_biz_prol_)
call mld_aggrmat_smth_asb(a,desc_a,p,info)
call mld_aggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,p,info)
if(info /= 0) then
call psb_errpush(4010,name,a_err='mld_aggrmat_smth_asb')
goto 9999

27
mlprec/mld_zaggrmat_raw_asb.F90
Unescape Escape View File

@ -66,14 +66,14 @@
! the fine-level matrix.
! desc_a - type(psb_desc_type), input.
! The communication descriptor of the fine-level matrix.
! p - type(mld_z_interlev_prec_type), input/output.
! p - type(mld_z_onelev_type), input/output.
! The one-level preconditioner data structure containing the local
! part of the base preconditioner to be built as well as the
! aggregate matrices.
! info - integer, output.
! Error code.
!
subroutine mld_zaggrmat_raw_asb(a,desc_a,p,info)
subroutine mld_zaggrmat_raw_asb(a,desc_a,ilaggr,nlaggr,p,info)
use psb_base_mod
use mld_inner_mod, mld_protect_name => mld_zaggrmat_raw_asb
@ -88,7 +88,8 @@ subroutine mld_zaggrmat_raw_asb(a,desc_a,p,info)
! Arguments
type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_z_interlev_prec_type), intent(inout), target :: p
integer, intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_z_onelev_type), intent(inout), target :: p
integer, intent(out) :: info
! Local variables
@ -118,8 +119,8 @@ subroutine mld_zaggrmat_raw_asb(a,desc_a,p,info)
call psb_nullify_sp(am2)
naggr = p%nlaggr(me+1)
ntaggr = sum(p%nlaggr)
naggr = nlaggr(me+1)
ntaggr = sum(nlaggr)
allocate(nzbr(np), idisp(np),stat=info)
if (info /= 0) then
info=4025
@ -128,13 +129,13 @@ subroutine mld_zaggrmat_raw_asb(a,desc_a,p,info)
goto 9999
end if
naggrm1=sum(p%nlaggr(1:me))
naggrm1=sum(nlaggr(1:me))
if (p%iprcparm(mld_coarse_mat_) == mld_repl_mat_) then
do i=1, nrow
p%mlia(i) = p%mlia(i) + naggrm1
ilaggr(i) = ilaggr(i) + naggrm1
end do
call psb_halo(p%mlia,desc_a,info)
call psb_halo(ilaggr,desc_a,info)
end if
if(info /= 0) then
@ -156,7 +157,7 @@ subroutine mld_zaggrmat_raw_asb(a,desc_a,p,info)
do i=1,nrow
am1%aspk(i) = zone
am1%ia1(i) = i
am1%ia2(i) = p%mlia(i)
am1%ia2(i) = ilaggr(i)
end do
am1%infoa(psb_nnz_) = nrow
@ -177,8 +178,8 @@ subroutine mld_zaggrmat_raw_asb(a,desc_a,p,info)
nzt = psb_sp_get_nnzeros(b)
do i=1, nzt
b%ia1(i) = p%mlia(b%ia1(i))
b%ia2(i) = p%mlia(b%ia2(i))
b%ia1(i) = ilaggr(b%ia1(i))
b%ia2(i) = ilaggr(b%ia2(i))
enddo
b%m = naggr
b%k = naggr
@ -266,8 +267,8 @@ subroutine mld_zaggrmat_raw_asb(a,desc_a,p,info)
! am2 => PR^T i.e. restriction operator
! am1 => PR i.e. prolongation operator
!
p%map = psb_linear_map(psb_map_aggr_,desc_a,&
& p%desc_ac,am2,am1)
p%map = psb_linmap(psb_map_aggr_,desc_a,&
& p%desc_ac,am2,am1,ilaggr,nlaggr)
if (info == 0) call psb_sp_free(am1,info)
if (info == 0) call psb_sp_free(am2,info)
if(info /= 0) then

31
mlprec/mld_zaggrmat_smth_asb.F90
Unescape Escape View File

@ -83,14 +83,14 @@
! the fine-level matrix.
! desc_a - type(psb_desc_type), input.
! The communication descriptor of the fine-level matrix.
! p - type(mld_z_interlev_prec_type), input/output.
! p - type(mld_z_onelev_type), input/output.
! The one-level preconditioner data structure containing the local
! part of the base preconditioner to be built as well as the
! aggregate matrices.
! info - integer, output.
! Error code.
!
subroutine mld_zaggrmat_smth_asb(a,desc_a,p,info)
subroutine mld_zaggrmat_smth_asb(a,desc_a,ilaggr,nlaggr,p,info)
use psb_base_mod
use mld_inner_mod, mld_protect_name => mld_zaggrmat_smth_asb
@ -105,7 +105,8 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,p,info)
! Arguments
type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
type(mld_z_interlev_prec_type), intent(inout), target :: p
integer, intent(inout) :: ilaggr(:), nlaggr(:)
type(mld_z_onelev_type), intent(inout), target :: p
integer, intent(out) :: info
! Local variables
@ -147,8 +148,8 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,p,info)
nrow = psb_cd_get_local_rows(desc_a)
ncol = psb_cd_get_local_cols(desc_a)
naggr = p%nlaggr(me+1)
ntaggr = sum(p%nlaggr)
naggr = nlaggr(me+1)
ntaggr = sum(nlaggr)
allocate(nzbr(np), idisp(np),stat=info)
if (info /= 0) then
@ -158,15 +159,15 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,p,info)
goto 9999
end if
naggrm1 = sum(p%nlaggr(1:me))
naggrp1 = sum(p%nlaggr(1:me+1))
naggrm1 = sum(nlaggr(1:me))
naggrp1 = sum(nlaggr(1:me+1))
ml_global_nmb = ( (p%iprcparm(mld_aggr_kind_) == mld_smooth_prol_).or.&
& ( (p%iprcparm(mld_aggr_kind_) == mld_biz_prol_).and.&
& (p%iprcparm(mld_coarse_mat_) == mld_repl_mat_)) )
if (ml_global_nmb) then
p%mlia(1:nrow) = p%mlia(1:nrow) + naggrm1
call psb_halo(p%mlia,desc_a,info)
ilaggr(1:nrow) = ilaggr(1:nrow) + naggrm1
call psb_halo(ilaggr,desc_a,info)
if (info /= 0) then
call psb_errpush(4010,name,a_err='psb_halo')
@ -221,14 +222,14 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,p,info)
do i=1,ncol
am4%aspk(i) = zone
am4%ia1(i) = i
am4%ia2(i) = p%mlia(i)
am4%ia2(i) = ilaggr(i)
end do
am4%infoa(psb_nnz_) = ncol
else
do i=1,nrow
am4%aspk(i) = zone
am4%ia1(i) = i
am4%ia2(i) = p%mlia(i)
am4%ia2(i) = ilaggr(i)
end do
am4%infoa(psb_nnz_) = nrow
endif
@ -387,7 +388,7 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,p,info)
i=0
!
! Now we have to fix this. The only rows of B that are correct
! are those corresponding to "local" aggregates, i.e. indices in p%mlia(:)
! are those corresponding to "local" aggregates, i.e. indices in ilaggr(:)
!
do k=1, nzl
if ((naggrm1 < am2%ia1(k)) .and.(am2%ia1(k) <= naggrp1)) then
@ -450,7 +451,7 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,p,info)
call psb_sp_clone(b,p%ac,info)
nzac = p%ac%infoa(psb_nnz_)
nzl = p%ac%infoa(psb_nnz_)
if (info == 0) call psb_cdall(ictxt,p%desc_ac,info,nl=p%nlaggr(me+1))
if (info == 0) call psb_cdall(ictxt,p%desc_ac,info,nl=nlaggr(me+1))
if (info == 0) call psb_cdins(nzl,p%ac%ia1,p%ac%ia2,p%desc_ac,info)
if (info == 0) call psb_cdasb(p%desc_ac,info)
if (info == 0) call psb_glob_to_loc(p%ac%ia1(1:nzl),p%desc_ac,info,iact='I')
@ -653,8 +654,8 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,p,info)
! am2 => PR^T i.e. restriction operator
! am1 => PR i.e. prolongation operator
!
p%map = psb_linear_map(psb_map_aggr_,desc_a,&
& p%desc_ac,am2,am1)
p%map = psb_linmap(psb_map_aggr_,desc_a,&
& p%desc_ac,am2,am1,ilaggr,nlaggr)
if (info == 0) call psb_sp_free(am1,info)
if (info == 0) call psb_sp_free(am2,info)
if(info /= 0) then

12
mlprec/mld_zmlprec_aply.f90
Unescape Escape View File

@ -78,7 +78,7 @@
! Arguments:
! alpha - complex(psb_dpk_), input.
! The scalar alpha.
! precv - type(mld_z_interlev_prec_type), dimension(:), input.
! precv - type(mld_z_onelev_type), dimension(:), input.
! The array of one-level preconditioner data structures containing the
! local parts of the preconditioners to be applied at each level.
! Note that nlev = size(precv) = number of levels.
@ -148,7 +148,7 @@ subroutine mld_zmlprec_aply(alpha,precv,x,beta,y,desc_data,trans,work,info)
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_z_interlev_prec_type), intent(in) :: precv(:)
type(mld_z_onelev_type), intent(in) :: precv(:)
complex(psb_dpk_),intent(in) :: alpha,beta
complex(psb_dpk_),intent(in) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:)
@ -341,7 +341,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_z_interlev_prec_type), intent(in) :: precv(:)
type(mld_z_onelev_type), intent(in) :: precv(:)
complex(psb_dpk_),intent(in) :: alpha,beta
complex(psb_dpk_),intent(in) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:)
@ -577,7 +577,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_z_interlev_prec_type), intent(in) :: precv(:)
type(mld_z_onelev_type), intent(in) :: precv(:)
complex(psb_dpk_),intent(in) :: alpha,beta
complex(psb_dpk_),intent(in) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:)
@ -837,7 +837,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_z_interlev_prec_type), intent(in) :: precv(:)
type(mld_z_onelev_type), intent(in) :: precv(:)
complex(psb_dpk_),intent(in) :: alpha,beta
complex(psb_dpk_),intent(in) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:)
@ -1135,7 +1135,7 @@ contains
! Arguments
type(psb_desc_type),intent(in) :: desc_data
type(mld_z_interlev_prec_type), intent(in) :: precv(:)
type(mld_z_onelev_type), intent(in) :: precv(:)
complex(psb_dpk_),intent(in) :: alpha,beta
complex(psb_dpk_),intent(in) :: x(:)
complex(psb_dpk_),intent(inout) :: y(:)

4
mlprec/mld_zprecbld.f90
Unescape Escape View File

@ -225,7 +225,7 @@ subroutine mld_zprecbld(a,desc_a,p,info)
& 'Return from ',i,' call to mlprcbld ',info
if (i>2) then
if (all(p%precv(i)%nlaggr == p%precv(i-1)%nlaggr)) then
if (all(p%precv(i)%map%naggr == p%precv(i-1)%map%naggr)) then
newsz=i-1
end if
call psb_bcast(ictxt,newsz)
@ -348,7 +348,7 @@ contains
end subroutine init_baseprec_av
subroutine check_coarse_lev(prec)
type(mld_z_interlev_prec_type) :: prec
type(mld_z_onelev_type) :: prec
!
! At the coarsest level, check mld_coarse_solve_

Write Preview
Loading…
Cancel
Save