fdurastante/amg4psblas
1
0
Fork 0
mirror of https://github.com/sfilippone/amg4psblas.git synced 2026-10-06 14:44:55 +00:00
Code Issues Packages Projects Releases Wiki Activity

Renaming level%linmap and methods.

Browse Source
This commit is contained in:
Salvatore Filippone
2020-11-09 14:11:08 +01:00
parent 3a0c5428d6
commit 9e3eb0fdeb
40 changed files with 348 additions and 264 deletions
Download Patch File Download Diff File Expand all files Collapse all files
amgprec/amg_c_onelev_mod.f90
+46 -25
View File
@@ -156,10 +156,10 @@ module amg_c_onelev_mod
type amg_c_remap_data_type
type(psb_cspmat_type) :: ac_pre_remap
type(psb_desc_type) :: desc_ac_pre_remap
integer(psb_ipk_) :: ipdest
integer(psb_ipk_) :: idest
integer(psb_ipk_), allocatable :: isrc(:), nrsrc(:)
!!$ contains
!!$ procedure, pass(rmp) :: clone => c_remap_data_clone
contains
procedure, pass(rmp) :: clone => c_remap_data_clone
end type amg_c_remap_data_type
type amg_c_onelev_type
@@ -175,7 +175,7 @@ module amg_c_onelev_mod
type(psb_cspmat_type), pointer :: base_a => null()
type(psb_desc_type), pointer :: base_desc => null()
type(psb_lcspmat_type) :: tprol
type(psb_clinmap_type) :: map
type(psb_clinmap_type) :: linmap
type(amg_c_remap_data_type) :: remap_data
real(psb_spk_) :: szratio
contains
@@ -207,12 +207,12 @@ module amg_c_onelev_mod
procedure, pass(lv) :: move_alloc => c_base_onelev_move_alloc
procedure, pass(lv) :: map_up_a => amg_c_base_onelev_map_up_a
procedure, pass(lv) :: map_dw_a => amg_c_base_onelev_map_dw_a
procedure, pass(lv) :: map_up_v => amg_c_base_onelev_map_up_v
procedure, pass(lv) :: map_dw_v => amg_c_base_onelev_map_dw_v
generic, public :: map_up => map_up_a, map_up_v
generic, public :: map_dw => map_dw_a, map_dw_v
procedure, pass(lv) :: map_rstr_a => amg_c_base_onelev_map_rstr_a
procedure, pass(lv) :: map_prol_a => amg_c_base_onelev_map_prol_a
procedure, pass(lv) :: map_rstr_v => amg_c_base_onelev_map_rstr_v
procedure, pass(lv) :: map_prol_v => amg_c_base_onelev_map_prol_v
generic, public :: map_rstr => map_rstr_a, map_rstr_v
generic, public :: map_prol => map_prol_a, map_prol_v
end type amg_c_onelev_type
type amg_c_onelev_node
@@ -440,7 +440,7 @@ contains
val = val + lv%desc_ac%sizeof()
val = val + lv%ac%sizeof()
val = val + lv%tprol%sizeof()
val = val + lv%map%sizeof()
val = val + lv%linmap%sizeof()
if (allocated(lv%sm)) val = val + lv%sm%sizeof()
if (allocated(lv%sm2a)) val = val + lv%sm2a%sizeof()
if (allocated(lv%aggr)) val = val + lv%aggr%sizeof()
@@ -570,7 +570,8 @@ contains
if (info == psb_success_) call lv%ac%clone(lvout%ac,info)
if (info == psb_success_) call lv%tprol%clone(lvout%tprol,info)
if (info == psb_success_) call lv%desc_ac%clone(lvout%desc_ac,info)
if (info == psb_success_) call lv%map%clone(lvout%map,info)
if (info == psb_success_) call lv%linmap%clone(lvout%linmap,info)
if (info == psb_success_) call lv%remap_data%clone(lvout%remap_data,info)
lvout%base_a => lv%base_a
lvout%base_desc => lv%base_desc
@@ -601,7 +602,7 @@ contains
if (info == psb_success_) call psb_move_alloc(lv%ac,b%ac,info)
if (info == psb_success_) call psb_move_alloc(lv%tprol,b%tprol,info)
if (info == psb_success_) call psb_move_alloc(lv%desc_ac,b%desc_ac,info)
if (info == psb_success_) call psb_move_alloc(lv%map,b%map,info)
if (info == psb_success_) call psb_move_alloc(lv%linmap,b%linmap,info)
b%base_a => lv%base_a
b%base_desc => lv%base_desc
@@ -838,7 +839,7 @@ contains
end if
end function c_wrk_sizeof
subroutine amg_c_base_onelev_map_up_a(lv,alpha,u,beta,v,info,work)
subroutine amg_c_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work)
implicit none
class(amg_c_onelev_type), target, intent(inout) :: lv
complex(psb_spk_), intent(in) :: alpha, beta
@@ -854,13 +855,13 @@ contains
write(0,*) 'Remap handling not implemented yet '
else
! Default transfer
call lv%map%map_U2V(alpha,u,beta,v,info,&
call lv%linmap%map_U2V(alpha,u,beta,v,info,&
& work=work)
end if
end subroutine amg_c_base_onelev_map_up_a
end subroutine amg_c_base_onelev_map_rstr_a
subroutine amg_c_base_onelev_map_dw_a(lv,alpha,v,beta,u,info,work)
subroutine amg_c_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work)
implicit none
class(amg_c_onelev_type), target, intent(inout) :: lv
complex(psb_spk_), intent(in) :: alpha, beta
@@ -876,13 +877,13 @@ contains
write(0,*) 'Remap handling not implemented yet '
else
! Default transfer
call lv%map%map_V2U(alpha,v,beta,u,info,&
call lv%linmap%map_V2U(alpha,v,beta,u,info,&
& work=work)
end if
end subroutine amg_c_base_onelev_map_dw_a
end subroutine amg_c_base_onelev_map_prol_a
subroutine amg_c_base_onelev_map_up_v(lv,alpha,vect_u,beta,vect_v,info,work,vtx,vty)
subroutine amg_c_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,work,vtx,vty)
implicit none
class(amg_c_onelev_type), target, intent(inout) :: lv
complex(psb_spk_), intent(in) :: alpha, beta
@@ -898,13 +899,13 @@ contains
write(0,*) 'Remap handling not implemented yet '
else
! Default transfer
call lv%map%map_U2V(alpha,vect_u,beta,vect_v,info,&
call lv%linmap%map_U2V(alpha,vect_u,beta,vect_v,info,&
& work=work,vtx=vtx,vty=vty)
end if
end subroutine amg_c_base_onelev_map_up_v
end subroutine amg_c_base_onelev_map_rstr_v
subroutine amg_c_base_onelev_map_dw_v(lv,alpha,vect_v,beta,vect_u,info,work,vtx,vty)
subroutine amg_c_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vtx,vty)
implicit none
class(amg_c_onelev_type), target, intent(inout) :: lv
complex(psb_spk_), intent(in) :: alpha, beta
@@ -920,10 +921,30 @@ contains
write(0,*) 'Remap handling not implemented yet '
else
! Default transfer
call lv%map%map_V2U(alpha,vect_v,beta,vect_u,info,&
call lv%linmap%map_V2U(alpha,vect_v,beta,vect_u,info,&
& work=work,vtx=vtx,vty=vty)
end if
end subroutine amg_c_base_onelev_map_dw_v
end subroutine amg_c_base_onelev_map_prol_v
subroutine c_remap_data_clone(rmp, remap_out, info)
use psb_base_mod
implicit none
! Arguments
class(amg_c_remap_data_type), target, intent(inout) :: rmp
class(amg_c_remap_data_type), target, intent(inout) :: remap_out
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: i
info = psb_success_
call rmp%ac_pre_remap%clone(remap_out%ac_pre_remap,info)
if (info == psb_success_) &
& call rmp%desc_ac_pre_remap%clone(remap_out%desc_ac_pre_remap,info)
remap_out%idest = rmp%idest
call psb_safe_ab_cpy(rmp%isrc,remap_out%isrc,info)
call psb_safe_ab_cpy(rmp%nrsrc,remap_out%nrsrc,info)
end subroutine c_remap_data_clone
end module amg_c_onelev_mod
amgprec/amg_c_prec_type.f90
+4 -4
View File
@@ -832,8 +832,8 @@ contains
if (info == psb_success_) then
pout%precv(lev)%base_a => pout%precv(lev)%ac
pout%precv(lev)%base_desc => pout%precv(lev)%desc_ac
pout%precv(lev)%map%p_desc_U => pout%precv(lev-1)%base_desc
pout%precv(lev)%map%p_desc_V => pout%precv(lev)%base_desc
pout%precv(lev)%linmap%p_desc_U => pout%precv(lev-1)%base_desc
pout%precv(lev)%linmap%p_desc_V => pout%precv(lev)%base_desc
end if
end do
end if
@@ -873,8 +873,8 @@ contains
do i=2, size(b%precv)
b%precv(i)%base_a => b%precv(i)%ac
b%precv(i)%base_desc => b%precv(i)%desc_ac
b%precv(i)%map%p_desc_U => b%precv(i-1)%base_desc
b%precv(i)%map%p_desc_V => b%precv(i)%base_desc
b%precv(i)%linmap%p_desc_U => b%precv(i-1)%base_desc
b%precv(i)%linmap%p_desc_V => b%precv(i)%base_desc
end do
else
amgprec/amg_d_onelev_mod.f90
+46 -25
View File
@@ -156,10 +156,10 @@ module amg_d_onelev_mod
type amg_d_remap_data_type
type(psb_dspmat_type) :: ac_pre_remap
type(psb_desc_type) :: desc_ac_pre_remap
integer(psb_ipk_) :: ipdest
integer(psb_ipk_) :: idest
integer(psb_ipk_), allocatable :: isrc(:), nrsrc(:)
!!$ contains
!!$ procedure, pass(rmp) :: clone => d_remap_data_clone
contains
procedure, pass(rmp) :: clone => d_remap_data_clone
end type amg_d_remap_data_type
type amg_d_onelev_type
@@ -175,7 +175,7 @@ module amg_d_onelev_mod
type(psb_dspmat_type), pointer :: base_a => null()
type(psb_desc_type), pointer :: base_desc => null()
type(psb_ldspmat_type) :: tprol
type(psb_dlinmap_type) :: map
type(psb_dlinmap_type) :: linmap
type(amg_d_remap_data_type) :: remap_data
real(psb_dpk_) :: szratio
contains
@@ -207,12 +207,12 @@ module amg_d_onelev_mod
procedure, pass(lv) :: move_alloc => d_base_onelev_move_alloc
procedure, pass(lv) :: map_up_a => amg_d_base_onelev_map_up_a
procedure, pass(lv) :: map_dw_a => amg_d_base_onelev_map_dw_a
procedure, pass(lv) :: map_up_v => amg_d_base_onelev_map_up_v
procedure, pass(lv) :: map_dw_v => amg_d_base_onelev_map_dw_v
generic, public :: map_up => map_up_a, map_up_v
generic, public :: map_dw => map_dw_a, map_dw_v
procedure, pass(lv) :: map_rstr_a => amg_d_base_onelev_map_rstr_a
procedure, pass(lv) :: map_prol_a => amg_d_base_onelev_map_prol_a
procedure, pass(lv) :: map_rstr_v => amg_d_base_onelev_map_rstr_v
procedure, pass(lv) :: map_prol_v => amg_d_base_onelev_map_prol_v
generic, public :: map_rstr => map_rstr_a, map_rstr_v
generic, public :: map_prol => map_prol_a, map_prol_v
end type amg_d_onelev_type
type amg_d_onelev_node
@@ -440,7 +440,7 @@ contains
val = val + lv%desc_ac%sizeof()
val = val + lv%ac%sizeof()
val = val + lv%tprol%sizeof()
val = val + lv%map%sizeof()
val = val + lv%linmap%sizeof()
if (allocated(lv%sm)) val = val + lv%sm%sizeof()
if (allocated(lv%sm2a)) val = val + lv%sm2a%sizeof()
if (allocated(lv%aggr)) val = val + lv%aggr%sizeof()
@@ -570,7 +570,8 @@ contains
if (info == psb_success_) call lv%ac%clone(lvout%ac,info)
if (info == psb_success_) call lv%tprol%clone(lvout%tprol,info)
if (info == psb_success_) call lv%desc_ac%clone(lvout%desc_ac,info)
if (info == psb_success_) call lv%map%clone(lvout%map,info)
if (info == psb_success_) call lv%linmap%clone(lvout%linmap,info)
if (info == psb_success_) call lv%remap_data%clone(lvout%remap_data,info)
lvout%base_a => lv%base_a
lvout%base_desc => lv%base_desc
@@ -601,7 +602,7 @@ contains
if (info == psb_success_) call psb_move_alloc(lv%ac,b%ac,info)
if (info == psb_success_) call psb_move_alloc(lv%tprol,b%tprol,info)
if (info == psb_success_) call psb_move_alloc(lv%desc_ac,b%desc_ac,info)
if (info == psb_success_) call psb_move_alloc(lv%map,b%map,info)
if (info == psb_success_) call psb_move_alloc(lv%linmap,b%linmap,info)
b%base_a => lv%base_a
b%base_desc => lv%base_desc
@@ -838,7 +839,7 @@ contains
end if
end function d_wrk_sizeof
subroutine amg_d_base_onelev_map_up_a(lv,alpha,u,beta,v,info,work)
subroutine amg_d_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work)
implicit none
class(amg_d_onelev_type), target, intent(inout) :: lv
real(psb_dpk_), intent(in) :: alpha, beta
@@ -854,13 +855,13 @@ contains
write(0,*) 'Remap handling not implemented yet '
else
! Default transfer
call lv%map%map_U2V(alpha,u,beta,v,info,&
call lv%linmap%map_U2V(alpha,u,beta,v,info,&
& work=work)
end if
end subroutine amg_d_base_onelev_map_up_a
end subroutine amg_d_base_onelev_map_rstr_a
subroutine amg_d_base_onelev_map_dw_a(lv,alpha,v,beta,u,info,work)
subroutine amg_d_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work)
implicit none
class(amg_d_onelev_type), target, intent(inout) :: lv
real(psb_dpk_), intent(in) :: alpha, beta
@@ -876,13 +877,13 @@ contains
write(0,*) 'Remap handling not implemented yet '
else
! Default transfer
call lv%map%map_V2U(alpha,v,beta,u,info,&
call lv%linmap%map_V2U(alpha,v,beta,u,info,&
& work=work)
end if
end subroutine amg_d_base_onelev_map_dw_a
end subroutine amg_d_base_onelev_map_prol_a
subroutine amg_d_base_onelev_map_up_v(lv,alpha,vect_u,beta,vect_v,info,work,vtx,vty)
subroutine amg_d_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,work,vtx,vty)
implicit none
class(amg_d_onelev_type), target, intent(inout) :: lv
real(psb_dpk_), intent(in) :: alpha, beta
@@ -898,13 +899,13 @@ contains
write(0,*) 'Remap handling not implemented yet '
else
! Default transfer
call lv%map%map_U2V(alpha,vect_u,beta,vect_v,info,&
call lv%linmap%map_U2V(alpha,vect_u,beta,vect_v,info,&
& work=work,vtx=vtx,vty=vty)
end if
end subroutine amg_d_base_onelev_map_up_v
end subroutine amg_d_base_onelev_map_rstr_v
subroutine amg_d_base_onelev_map_dw_v(lv,alpha,vect_v,beta,vect_u,info,work,vtx,vty)
subroutine amg_d_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vtx,vty)
implicit none
class(amg_d_onelev_type), target, intent(inout) :: lv
real(psb_dpk_), intent(in) :: alpha, beta
@@ -920,10 +921,30 @@ contains
write(0,*) 'Remap handling not implemented yet '
else
! Default transfer
call lv%map%map_V2U(alpha,vect_v,beta,vect_u,info,&
call lv%linmap%map_V2U(alpha,vect_v,beta,vect_u,info,&
& work=work,vtx=vtx,vty=vty)
end if
end subroutine amg_d_base_onelev_map_dw_v
end subroutine amg_d_base_onelev_map_prol_v
subroutine d_remap_data_clone(rmp, remap_out, info)
use psb_base_mod
implicit none
! Arguments
class(amg_d_remap_data_type), target, intent(inout) :: rmp
class(amg_d_remap_data_type), target, intent(inout) :: remap_out
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: i
info = psb_success_
call rmp%ac_pre_remap%clone(remap_out%ac_pre_remap,info)
if (info == psb_success_) &
& call rmp%desc_ac_pre_remap%clone(remap_out%desc_ac_pre_remap,info)
remap_out%idest = rmp%idest
call psb_safe_ab_cpy(rmp%isrc,remap_out%isrc,info)
call psb_safe_ab_cpy(rmp%nrsrc,remap_out%nrsrc,info)
end subroutine d_remap_data_clone
end module amg_d_onelev_mod
amgprec/amg_d_prec_type.f90
+4 -4
View File
@@ -832,8 +832,8 @@ contains
if (info == psb_success_) then
pout%precv(lev)%base_a => pout%precv(lev)%ac
pout%precv(lev)%base_desc => pout%precv(lev)%desc_ac
pout%precv(lev)%map%p_desc_U => pout%precv(lev-1)%base_desc
pout%precv(lev)%map%p_desc_V => pout%precv(lev)%base_desc
pout%precv(lev)%linmap%p_desc_U => pout%precv(lev-1)%base_desc
pout%precv(lev)%linmap%p_desc_V => pout%precv(lev)%base_desc
end if
end do
end if
@@ -873,8 +873,8 @@ contains
do i=2, size(b%precv)
b%precv(i)%base_a => b%precv(i)%ac
b%precv(i)%base_desc => b%precv(i)%desc_ac
b%precv(i)%map%p_desc_U => b%precv(i-1)%base_desc
b%precv(i)%map%p_desc_V => b%precv(i)%base_desc
b%precv(i)%linmap%p_desc_U => b%precv(i-1)%base_desc
b%precv(i)%linmap%p_desc_V => b%precv(i)%base_desc
end do
else
amgprec/amg_s_onelev_mod.f90
+46 -25
View File
@@ -156,10 +156,10 @@ module amg_s_onelev_mod
type amg_s_remap_data_type
type(psb_sspmat_type) :: ac_pre_remap
type(psb_desc_type) :: desc_ac_pre_remap
integer(psb_ipk_) :: ipdest
integer(psb_ipk_) :: idest
integer(psb_ipk_), allocatable :: isrc(:), nrsrc(:)
!!$ contains
!!$ procedure, pass(rmp) :: clone => s_remap_data_clone
contains
procedure, pass(rmp) :: clone => s_remap_data_clone
end type amg_s_remap_data_type
type amg_s_onelev_type
@@ -175,7 +175,7 @@ module amg_s_onelev_mod
type(psb_sspmat_type), pointer :: base_a => null()
type(psb_desc_type), pointer :: base_desc => null()
type(psb_lsspmat_type) :: tprol
type(psb_slinmap_type) :: map
type(psb_slinmap_type) :: linmap
type(amg_s_remap_data_type) :: remap_data
real(psb_spk_) :: szratio
contains
@@ -207,12 +207,12 @@ module amg_s_onelev_mod
procedure, pass(lv) :: move_alloc => s_base_onelev_move_alloc
procedure, pass(lv) :: map_up_a => amg_s_base_onelev_map_up_a
procedure, pass(lv) :: map_dw_a => amg_s_base_onelev_map_dw_a
procedure, pass(lv) :: map_up_v => amg_s_base_onelev_map_up_v
procedure, pass(lv) :: map_dw_v => amg_s_base_onelev_map_dw_v
generic, public :: map_up => map_up_a, map_up_v
generic, public :: map_dw => map_dw_a, map_dw_v
procedure, pass(lv) :: map_rstr_a => amg_s_base_onelev_map_rstr_a
procedure, pass(lv) :: map_prol_a => amg_s_base_onelev_map_prol_a
procedure, pass(lv) :: map_rstr_v => amg_s_base_onelev_map_rstr_v
procedure, pass(lv) :: map_prol_v => amg_s_base_onelev_map_prol_v
generic, public :: map_rstr => map_rstr_a, map_rstr_v
generic, public :: map_prol => map_prol_a, map_prol_v
end type amg_s_onelev_type
type amg_s_onelev_node
@@ -440,7 +440,7 @@ contains
val = val + lv%desc_ac%sizeof()
val = val + lv%ac%sizeof()
val = val + lv%tprol%sizeof()
val = val + lv%map%sizeof()
val = val + lv%linmap%sizeof()
if (allocated(lv%sm)) val = val + lv%sm%sizeof()
if (allocated(lv%sm2a)) val = val + lv%sm2a%sizeof()
if (allocated(lv%aggr)) val = val + lv%aggr%sizeof()
@@ -570,7 +570,8 @@ contains
if (info == psb_success_) call lv%ac%clone(lvout%ac,info)
if (info == psb_success_) call lv%tprol%clone(lvout%tprol,info)
if (info == psb_success_) call lv%desc_ac%clone(lvout%desc_ac,info)
if (info == psb_success_) call lv%map%clone(lvout%map,info)
if (info == psb_success_) call lv%linmap%clone(lvout%linmap,info)
if (info == psb_success_) call lv%remap_data%clone(lvout%remap_data,info)
lvout%base_a => lv%base_a
lvout%base_desc => lv%base_desc
@@ -601,7 +602,7 @@ contains
if (info == psb_success_) call psb_move_alloc(lv%ac,b%ac,info)
if (info == psb_success_) call psb_move_alloc(lv%tprol,b%tprol,info)
if (info == psb_success_) call psb_move_alloc(lv%desc_ac,b%desc_ac,info)
if (info == psb_success_) call psb_move_alloc(lv%map,b%map,info)
if (info == psb_success_) call psb_move_alloc(lv%linmap,b%linmap,info)
b%base_a => lv%base_a
b%base_desc => lv%base_desc
@@ -838,7 +839,7 @@ contains
end if
end function s_wrk_sizeof
subroutine amg_s_base_onelev_map_up_a(lv,alpha,u,beta,v,info,work)
subroutine amg_s_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work)
implicit none
class(amg_s_onelev_type), target, intent(inout) :: lv
real(psb_spk_), intent(in) :: alpha, beta
@@ -854,13 +855,13 @@ contains
write(0,*) 'Remap handling not implemented yet '
else
! Default transfer
call lv%map%map_U2V(alpha,u,beta,v,info,&
call lv%linmap%map_U2V(alpha,u,beta,v,info,&
& work=work)
end if
end subroutine amg_s_base_onelev_map_up_a
end subroutine amg_s_base_onelev_map_rstr_a
subroutine amg_s_base_onelev_map_dw_a(lv,alpha,v,beta,u,info,work)
subroutine amg_s_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work)
implicit none
class(amg_s_onelev_type), target, intent(inout) :: lv
real(psb_spk_), intent(in) :: alpha, beta
@@ -876,13 +877,13 @@ contains
write(0,*) 'Remap handling not implemented yet '
else
! Default transfer
call lv%map%map_V2U(alpha,v,beta,u,info,&
call lv%linmap%map_V2U(alpha,v,beta,u,info,&
& work=work)
end if
end subroutine amg_s_base_onelev_map_dw_a
end subroutine amg_s_base_onelev_map_prol_a
subroutine amg_s_base_onelev_map_up_v(lv,alpha,vect_u,beta,vect_v,info,work,vtx,vty)
subroutine amg_s_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,work,vtx,vty)
implicit none
class(amg_s_onelev_type), target, intent(inout) :: lv
real(psb_spk_), intent(in) :: alpha, beta
@@ -898,13 +899,13 @@ contains
write(0,*) 'Remap handling not implemented yet '
else
! Default transfer
call lv%map%map_U2V(alpha,vect_u,beta,vect_v,info,&
call lv%linmap%map_U2V(alpha,vect_u,beta,vect_v,info,&
& work=work,vtx=vtx,vty=vty)
end if
end subroutine amg_s_base_onelev_map_up_v
end subroutine amg_s_base_onelev_map_rstr_v
subroutine amg_s_base_onelev_map_dw_v(lv,alpha,vect_v,beta,vect_u,info,work,vtx,vty)
subroutine amg_s_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vtx,vty)
implicit none
class(amg_s_onelev_type), target, intent(inout) :: lv
real(psb_spk_), intent(in) :: alpha, beta
@@ -920,10 +921,30 @@ contains
write(0,*) 'Remap handling not implemented yet '
else
! Default transfer
call lv%map%map_V2U(alpha,vect_v,beta,vect_u,info,&
call lv%linmap%map_V2U(alpha,vect_v,beta,vect_u,info,&
& work=work,vtx=vtx,vty=vty)
end if
end subroutine amg_s_base_onelev_map_dw_v
end subroutine amg_s_base_onelev_map_prol_v
subroutine s_remap_data_clone(rmp, remap_out, info)
use psb_base_mod
implicit none
! Arguments
class(amg_s_remap_data_type), target, intent(inout) :: rmp
class(amg_s_remap_data_type), target, intent(inout) :: remap_out
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: i
info = psb_success_
call rmp%ac_pre_remap%clone(remap_out%ac_pre_remap,info)
if (info == psb_success_) &
& call rmp%desc_ac_pre_remap%clone(remap_out%desc_ac_pre_remap,info)
remap_out%idest = rmp%idest
call psb_safe_ab_cpy(rmp%isrc,remap_out%isrc,info)
call psb_safe_ab_cpy(rmp%nrsrc,remap_out%nrsrc,info)
end subroutine s_remap_data_clone
end module amg_s_onelev_mod
amgprec/amg_s_prec_type.f90
+4 -4
View File
@@ -832,8 +832,8 @@ contains
if (info == psb_success_) then
pout%precv(lev)%base_a => pout%precv(lev)%ac
pout%precv(lev)%base_desc => pout%precv(lev)%desc_ac
pout%precv(lev)%map%p_desc_U => pout%precv(lev-1)%base_desc
pout%precv(lev)%map%p_desc_V => pout%precv(lev)%base_desc
pout%precv(lev)%linmap%p_desc_U => pout%precv(lev-1)%base_desc
pout%precv(lev)%linmap%p_desc_V => pout%precv(lev)%base_desc
end if
end do
end if
@@ -873,8 +873,8 @@ contains
do i=2, size(b%precv)
b%precv(i)%base_a => b%precv(i)%ac
b%precv(i)%base_desc => b%precv(i)%desc_ac
b%precv(i)%map%p_desc_U => b%precv(i-1)%base_desc
b%precv(i)%map%p_desc_V => b%precv(i)%base_desc
b%precv(i)%linmap%p_desc_U => b%precv(i-1)%base_desc
b%precv(i)%linmap%p_desc_V => b%precv(i)%base_desc
end do
else
amgprec/amg_z_onelev_mod.f90
+46 -25
View File
@@ -156,10 +156,10 @@ module amg_z_onelev_mod
type amg_z_remap_data_type
type(psb_zspmat_type) :: ac_pre_remap
type(psb_desc_type) :: desc_ac_pre_remap
integer(psb_ipk_) :: ipdest
integer(psb_ipk_) :: idest
integer(psb_ipk_), allocatable :: isrc(:), nrsrc(:)
!!$ contains
!!$ procedure, pass(rmp) :: clone => z_remap_data_clone
contains
procedure, pass(rmp) :: clone => z_remap_data_clone
end type amg_z_remap_data_type
type amg_z_onelev_type
@@ -175,7 +175,7 @@ module amg_z_onelev_mod
type(psb_zspmat_type), pointer :: base_a => null()
type(psb_desc_type), pointer :: base_desc => null()
type(psb_lzspmat_type) :: tprol
type(psb_zlinmap_type) :: map
type(psb_zlinmap_type) :: linmap
type(amg_z_remap_data_type) :: remap_data
real(psb_dpk_) :: szratio
contains
@@ -207,12 +207,12 @@ module amg_z_onelev_mod
procedure, pass(lv) :: move_alloc => z_base_onelev_move_alloc
procedure, pass(lv) :: map_up_a => amg_z_base_onelev_map_up_a
procedure, pass(lv) :: map_dw_a => amg_z_base_onelev_map_dw_a
procedure, pass(lv) :: map_up_v => amg_z_base_onelev_map_up_v
procedure, pass(lv) :: map_dw_v => amg_z_base_onelev_map_dw_v
generic, public :: map_up => map_up_a, map_up_v
generic, public :: map_dw => map_dw_a, map_dw_v
procedure, pass(lv) :: map_rstr_a => amg_z_base_onelev_map_rstr_a
procedure, pass(lv) :: map_prol_a => amg_z_base_onelev_map_prol_a
procedure, pass(lv) :: map_rstr_v => amg_z_base_onelev_map_rstr_v
procedure, pass(lv) :: map_prol_v => amg_z_base_onelev_map_prol_v
generic, public :: map_rstr => map_rstr_a, map_rstr_v
generic, public :: map_prol => map_prol_a, map_prol_v
end type amg_z_onelev_type
type amg_z_onelev_node
@@ -440,7 +440,7 @@ contains
val = val + lv%desc_ac%sizeof()
val = val + lv%ac%sizeof()
val = val + lv%tprol%sizeof()
val = val + lv%map%sizeof()
val = val + lv%linmap%sizeof()
if (allocated(lv%sm)) val = val + lv%sm%sizeof()
if (allocated(lv%sm2a)) val = val + lv%sm2a%sizeof()
if (allocated(lv%aggr)) val = val + lv%aggr%sizeof()
@@ -570,7 +570,8 @@ contains
if (info == psb_success_) call lv%ac%clone(lvout%ac,info)
if (info == psb_success_) call lv%tprol%clone(lvout%tprol,info)
if (info == psb_success_) call lv%desc_ac%clone(lvout%desc_ac,info)
if (info == psb_success_) call lv%map%clone(lvout%map,info)
if (info == psb_success_) call lv%linmap%clone(lvout%linmap,info)
if (info == psb_success_) call lv%remap_data%clone(lvout%remap_data,info)
lvout%base_a => lv%base_a
lvout%base_desc => lv%base_desc
@@ -601,7 +602,7 @@ contains
if (info == psb_success_) call psb_move_alloc(lv%ac,b%ac,info)
if (info == psb_success_) call psb_move_alloc(lv%tprol,b%tprol,info)
if (info == psb_success_) call psb_move_alloc(lv%desc_ac,b%desc_ac,info)
if (info == psb_success_) call psb_move_alloc(lv%map,b%map,info)
if (info == psb_success_) call psb_move_alloc(lv%linmap,b%linmap,info)
b%base_a => lv%base_a
b%base_desc => lv%base_desc
@@ -838,7 +839,7 @@ contains
end if
end function z_wrk_sizeof
subroutine amg_z_base_onelev_map_up_a(lv,alpha,u,beta,v,info,work)
subroutine amg_z_base_onelev_map_rstr_a(lv,alpha,u,beta,v,info,work)
implicit none
class(amg_z_onelev_type), target, intent(inout) :: lv
complex(psb_dpk_), intent(in) :: alpha, beta
@@ -854,13 +855,13 @@ contains
write(0,*) 'Remap handling not implemented yet '
else
! Default transfer
call lv%map%map_U2V(alpha,u,beta,v,info,&
call lv%linmap%map_U2V(alpha,u,beta,v,info,&
& work=work)
end if
end subroutine amg_z_base_onelev_map_up_a
end subroutine amg_z_base_onelev_map_rstr_a
subroutine amg_z_base_onelev_map_dw_a(lv,alpha,v,beta,u,info,work)
subroutine amg_z_base_onelev_map_prol_a(lv,alpha,v,beta,u,info,work)
implicit none
class(amg_z_onelev_type), target, intent(inout) :: lv
complex(psb_dpk_), intent(in) :: alpha, beta
@@ -876,13 +877,13 @@ contains
write(0,*) 'Remap handling not implemented yet '
else
! Default transfer
call lv%map%map_V2U(alpha,v,beta,u,info,&
call lv%linmap%map_V2U(alpha,v,beta,u,info,&
& work=work)
end if
end subroutine amg_z_base_onelev_map_dw_a
end subroutine amg_z_base_onelev_map_prol_a
subroutine amg_z_base_onelev_map_up_v(lv,alpha,vect_u,beta,vect_v,info,work,vtx,vty)
subroutine amg_z_base_onelev_map_rstr_v(lv,alpha,vect_u,beta,vect_v,info,work,vtx,vty)
implicit none
class(amg_z_onelev_type), target, intent(inout) :: lv
complex(psb_dpk_), intent(in) :: alpha, beta
@@ -898,13 +899,13 @@ contains
write(0,*) 'Remap handling not implemented yet '
else
! Default transfer
call lv%map%map_U2V(alpha,vect_u,beta,vect_v,info,&
call lv%linmap%map_U2V(alpha,vect_u,beta,vect_v,info,&
& work=work,vtx=vtx,vty=vty)
end if
end subroutine amg_z_base_onelev_map_up_v
end subroutine amg_z_base_onelev_map_rstr_v
subroutine amg_z_base_onelev_map_dw_v(lv,alpha,vect_v,beta,vect_u,info,work,vtx,vty)
subroutine amg_z_base_onelev_map_prol_v(lv,alpha,vect_v,beta,vect_u,info,work,vtx,vty)
implicit none
class(amg_z_onelev_type), target, intent(inout) :: lv
complex(psb_dpk_), intent(in) :: alpha, beta
@@ -920,10 +921,30 @@ contains
write(0,*) 'Remap handling not implemented yet '
else
! Default transfer
call lv%map%map_V2U(alpha,vect_v,beta,vect_u,info,&
call lv%linmap%map_V2U(alpha,vect_v,beta,vect_u,info,&
& work=work,vtx=vtx,vty=vty)
end if
end subroutine amg_z_base_onelev_map_dw_v
end subroutine amg_z_base_onelev_map_prol_v
subroutine z_remap_data_clone(rmp, remap_out, info)
use psb_base_mod
implicit none
! Arguments
class(amg_z_remap_data_type), target, intent(inout) :: rmp
class(amg_z_remap_data_type), target, intent(inout) :: remap_out
integer(psb_ipk_), intent(out) :: info
!
integer(psb_ipk_) :: i
info = psb_success_
call rmp%ac_pre_remap%clone(remap_out%ac_pre_remap,info)
if (info == psb_success_) &
& call rmp%desc_ac_pre_remap%clone(remap_out%desc_ac_pre_remap,info)
remap_out%idest = rmp%idest
call psb_safe_ab_cpy(rmp%isrc,remap_out%isrc,info)
call psb_safe_ab_cpy(rmp%nrsrc,remap_out%nrsrc,info)
end subroutine z_remap_data_clone
end module amg_z_onelev_mod
amgprec/amg_z_prec_type.f90
+4 -4
View File
@@ -832,8 +832,8 @@ contains
if (info == psb_success_) then
pout%precv(lev)%base_a => pout%precv(lev)%ac
pout%precv(lev)%base_desc => pout%precv(lev)%desc_ac
pout%precv(lev)%map%p_desc_U => pout%precv(lev-1)%base_desc
pout%precv(lev)%map%p_desc_V => pout%precv(lev)%base_desc
pout%precv(lev)%linmap%p_desc_U => pout%precv(lev-1)%base_desc
pout%precv(lev)%linmap%p_desc_V => pout%precv(lev)%base_desc
end if
end do
end if
@@ -873,8 +873,8 @@ contains
do i=2, size(b%precv)
b%precv(i)%base_a => b%precv(i)%ac
b%precv(i)%base_desc => b%precv(i)%desc_ac
b%precv(i)%map%p_desc_U => b%precv(i-1)%base_desc
b%precv(i)%map%p_desc_V => b%precv(i)%base_desc
b%precv(i)%linmap%p_desc_U => b%precv(i-1)%base_desc
b%precv(i)%linmap%p_desc_V => b%precv(i)%base_desc
end do
else
amgprec/impl/amg_c_hierarchy_bld.f90
+6 -6
View File
@@ -333,7 +333,7 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info)
if (i==2) then
sizeratio = desc_a%get_global_rows()/sizeratio
else
sizeratio = sum(prec%precv(i-1)%map%naggr)/sizeratio
sizeratio = sum(prec%precv(i-1)%linmap%naggr)/sizeratio
end if
prec%precv(i)%szratio = sizeratio
@@ -352,7 +352,7 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info)
end if
end if
if (all(nlaggr == prec%precv(i-1)%map%naggr)) then
if (all(nlaggr == prec%precv(i-1)%linmap%naggr)) then
newsz=i-1
if (me == 0) then
write(debug_unit,*) trim(name),&
@@ -387,8 +387,8 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info)
! We are going back and revisit a previous leve;
! recover the aggregation.
!
ilaggr = prec%precv(newsz)%map%iaggr
nlaggr = prec%precv(newsz)%map%naggr
ilaggr = prec%precv(newsz)%linmap%iaggr
nlaggr = prec%precv(newsz)%linmap%naggr
call prec%precv(newsz)%tprol%clone(op_prol,info)
end if
if (do_timings) call psb_tic(idx_matasb)
@@ -449,8 +449,8 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info)
do i=2, iszv
prec%precv(i)%base_a => prec%precv(i)%ac
prec%precv(i)%base_desc => prec%precv(i)%desc_ac
prec%precv(i)%map%p_desc_U => prec%precv(i-1)%base_desc
prec%precv(i)%map%p_desc_V => prec%precv(i)%base_desc
prec%precv(i)%linmap%p_desc_U => prec%precv(i-1)%base_desc
prec%precv(i)%linmap%p_desc_V => prec%precv(i)%base_desc
end do
end if
amgprec/impl/amg_c_hierarchy_rebld.f90
+3 -3
View File
@@ -126,9 +126,9 @@ subroutine amg_c_hierarchy_rebld(a,desc_a,prec,info)
do i=2, iszv
call prec%precv(i-1)%base_a%cp_to(acsr)
p_desc_a => prec%precv(i-1)%base_desc
call prec%precv(i)%map%mat_V2U%cp_to(coo_prol)
call prec%precv(i)%map%mat_U2V%cp_to(coo_restr)
call amg_rap(acsr,p_desc_a,prec%precv(i)%map%naggr,&
call prec%precv(i)%linmap%mat_V2U%cp_to(coo_prol)
call prec%precv(i)%linmap%mat_U2V%cp_to(coo_restr)
call amg_rap(acsr,p_desc_a,prec%precv(i)%linmap%naggr,&
& prec%precv(i)%parms,prec%precv(i)%ac,&
& coo_prol,prec%precv(i)%desc_ac,coo_restr,info)
amgprec/impl/amg_cmlprec_aply.f90
+14 -14
View File
@@ -520,7 +520,7 @@ contains
if (level < nlev) then
! Apply the restriction
call p%precv(level+1)%map_up(cone,vx2l,&
call p%precv(level+1)%map_rstr(cone,vx2l,&
& czero,p%precv(level+1)%wrk%vx2l,&
& info,work=work,&
& vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
@@ -540,7 +540,7 @@ contains
!
! Apply the prolongator
!
call p%precv(level+1)%map_dw(cone,&
call p%precv(level+1)%map_prol(cone,&
& p%precv(level+1)%wrk%vy2l, cone,vy2l,&
& info,work=work,&
& vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1))
@@ -653,7 +653,7 @@ contains
& a_err='Error during residue')
goto 9999
end if
call p%precv(level+1)%map_up(cone,vty,&
call p%precv(level+1)%map_rstr(cone,vty,&
& czero,p%precv(level+1)%wrk%vx2l,&
& info,work=work,&
& vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
@@ -664,7 +664,7 @@ contains
end if
else
! Shortcut: just transfer x2l.
call p%precv(level+1)%map_up(cone,vx2l,&
call p%precv(level+1)%map_rstr(cone,vx2l,&
& czero,p%precv(level+1)%wrk%vx2l,&
& info,work=work,&
& vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
@@ -680,7 +680,7 @@ contains
!
! Apply the prolongator
!
call p%precv(level+1)%map_dw(cone,&
call p%precv(level+1)%map_prol(cone,&
& p%precv(level+1)%wrk%vy2l,cone,vy2l,&
& info,work=work,&
& vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1))
@@ -698,7 +698,7 @@ contains
& vy2l,cone,vty,&
& base_desc,info,work=work,trans=trans)
if (info == psb_success_) &
& call p%precv(level+1)%map_up(cone,vty,&
& call p%precv(level+1)%map_rstr(cone,vty,&
& czero,p%precv(level+1)%wrk%vx2l,info,work=work,&
& vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
if (info /= psb_success_) then
@@ -709,7 +709,7 @@ contains
call inner_ml_aply(level+1,p,trans,work,info)
if (info == psb_success_) call p%precv(level+1)%map_dw(cone, &
if (info == psb_success_) call p%precv(level+1)%map_prol(cone, &
& p%precv(level+1)%wrk%vy2l,cone,vy2l,&
& info,work=work,&
& vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1))
@@ -889,7 +889,7 @@ contains
end if
! Apply the restriction
call p%precv(level + 1)%map_up(cone,vty,&
call p%precv(level + 1)%map_rstr(cone,vty,&
& czero,p%precv(level + 1)%wrk%vx2l,&
&info,work=work,&
& vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
@@ -925,7 +925,7 @@ contains
!
! Apply the prolongator
!
call p%precv(level+1)%map_dw(cone,&
call p%precv(level+1)%map_prol(cone,&
& p%precv(level+1)%wrk%vy2l,cone,vy2l,&
& info,work=work,&
& vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1))
@@ -1415,7 +1415,7 @@ contains
if (level < nlev) then
! Apply the restriction
call p%precv(level+1)%map_up(cone,mlwrk(level)%x2l,&
call p%precv(level+1)%map_rstr(cone,mlwrk(level)%x2l,&
& czero,mlwrk(level+1)%x2l,&
& info,work=work)
mlwrk(level+1)%y2l(:) = czero
@@ -1435,7 +1435,7 @@ contains
!
! Apply the prolongator and add correction.
!
call p%precv(level+1)%map_dw(cone,&
call p%precv(level+1)%map_prol(cone,&
& mlwrk(level+1)%y2l,cone,mlwrk(level)%y2l,&
& info,work=work)
if (info /= psb_success_) then
@@ -1555,7 +1555,7 @@ contains
& a_err='Error during residue')
goto 9999
end if
call p%precv(level+1)%map_up(cone,mlwrk(level)%ty,&
call p%precv(level+1)%map_rstr(cone,mlwrk(level)%ty,&
& czero,mlwrk(level+1)%x2l,info,work=work)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
@@ -1564,7 +1564,7 @@ contains
end if
else
! Shortcut: just transfer x2l.
call p%precv(level+1)%map_up(cone,mlwrk(level)%x2l,&
call p%precv(level+1)%map_rstr(cone,mlwrk(level)%x2l,&
& czero,mlwrk(level+1)%x2l,info,work=work)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
@@ -1593,7 +1593,7 @@ contains
!
! Apply the prolongator
!
call p%precv(level+1)%map_dw(cone,mlwrk(level+1)%y2l,&
call p%precv(level+1)%map_prol(cone,mlwrk(level+1)%y2l,&
& cone,mlwrk(level)%y2l,info,work=work)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
amgprec/impl/amg_d_hierarchy_bld.f90
+6 -6
View File
@@ -333,7 +333,7 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info)
if (i==2) then
sizeratio = desc_a%get_global_rows()/sizeratio
else
sizeratio = sum(prec%precv(i-1)%map%naggr)/sizeratio
sizeratio = sum(prec%precv(i-1)%linmap%naggr)/sizeratio
end if
prec%precv(i)%szratio = sizeratio
@@ -352,7 +352,7 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info)
end if
end if
if (all(nlaggr == prec%precv(i-1)%map%naggr)) then
if (all(nlaggr == prec%precv(i-1)%linmap%naggr)) then
newsz=i-1
if (me == 0) then
write(debug_unit,*) trim(name),&
@@ -387,8 +387,8 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info)
! We are going back and revisit a previous leve;
! recover the aggregation.
!
ilaggr = prec%precv(newsz)%map%iaggr
nlaggr = prec%precv(newsz)%map%naggr
ilaggr = prec%precv(newsz)%linmap%iaggr
nlaggr = prec%precv(newsz)%linmap%naggr
call prec%precv(newsz)%tprol%clone(op_prol,info)
end if
if (do_timings) call psb_tic(idx_matasb)
@@ -449,8 +449,8 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info)
do i=2, iszv
prec%precv(i)%base_a => prec%precv(i)%ac
prec%precv(i)%base_desc => prec%precv(i)%desc_ac
prec%precv(i)%map%p_desc_U => prec%precv(i-1)%base_desc
prec%precv(i)%map%p_desc_V => prec%precv(i)%base_desc
prec%precv(i)%linmap%p_desc_U => prec%precv(i-1)%base_desc
prec%precv(i)%linmap%p_desc_V => prec%precv(i)%base_desc
end do
end if
amgprec/impl/amg_d_hierarchy_rebld.f90
+3 -3
View File
@@ -126,9 +126,9 @@ subroutine amg_d_hierarchy_rebld(a,desc_a,prec,info)
do i=2, iszv
call prec%precv(i-1)%base_a%cp_to(acsr)
p_desc_a => prec%precv(i-1)%base_desc
call prec%precv(i)%map%mat_V2U%cp_to(coo_prol)
call prec%precv(i)%map%mat_U2V%cp_to(coo_restr)
call amg_rap(acsr,p_desc_a,prec%precv(i)%map%naggr,&
call prec%precv(i)%linmap%mat_V2U%cp_to(coo_prol)
call prec%precv(i)%linmap%mat_U2V%cp_to(coo_restr)
call amg_rap(acsr,p_desc_a,prec%precv(i)%linmap%naggr,&
& prec%precv(i)%parms,prec%precv(i)%ac,&
& coo_prol,prec%precv(i)%desc_ac,coo_restr,info)
amgprec/impl/amg_dmlprec_aply.f90
+14 -14
View File
@@ -520,7 +520,7 @@ contains
if (level < nlev) then
! Apply the restriction
call p%precv(level+1)%map_up(done,vx2l,&
call p%precv(level+1)%map_rstr(done,vx2l,&
& dzero,p%precv(level+1)%wrk%vx2l,&
& info,work=work,&
& vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
@@ -540,7 +540,7 @@ contains
!
! Apply the prolongator
!
call p%precv(level+1)%map_dw(done,&
call p%precv(level+1)%map_prol(done,&
& p%precv(level+1)%wrk%vy2l, done,vy2l,&
& info,work=work,&
& vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1))
@@ -653,7 +653,7 @@ contains
& a_err='Error during residue')
goto 9999
end if
call p%precv(level+1)%map_up(done,vty,&
call p%precv(level+1)%map_rstr(done,vty,&
& dzero,p%precv(level+1)%wrk%vx2l,&
& info,work=work,&
& vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
@@ -664,7 +664,7 @@ contains
end if
else
! Shortcut: just transfer x2l.
call p%precv(level+1)%map_up(done,vx2l,&
call p%precv(level+1)%map_rstr(done,vx2l,&
& dzero,p%precv(level+1)%wrk%vx2l,&
& info,work=work,&
& vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
@@ -680,7 +680,7 @@ contains
!
! Apply the prolongator
!
call p%precv(level+1)%map_dw(done,&
call p%precv(level+1)%map_prol(done,&
& p%precv(level+1)%wrk%vy2l,done,vy2l,&
& info,work=work,&
& vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1))
@@ -698,7 +698,7 @@ contains
& vy2l,done,vty,&
& base_desc,info,work=work,trans=trans)
if (info == psb_success_) &
& call p%precv(level+1)%map_up(done,vty,&
& call p%precv(level+1)%map_rstr(done,vty,&
& dzero,p%precv(level+1)%wrk%vx2l,info,work=work,&
& vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
if (info /= psb_success_) then
@@ -709,7 +709,7 @@ contains
call inner_ml_aply(level+1,p,trans,work,info)
if (info == psb_success_) call p%precv(level+1)%map_dw(done, &
if (info == psb_success_) call p%precv(level+1)%map_prol(done, &
& p%precv(level+1)%wrk%vy2l,done,vy2l,&
& info,work=work,&
& vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1))
@@ -889,7 +889,7 @@ contains
end if
! Apply the restriction
call p%precv(level + 1)%map_up(done,vty,&
call p%precv(level + 1)%map_rstr(done,vty,&
& dzero,p%precv(level + 1)%wrk%vx2l,&
&info,work=work,&
& vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
@@ -925,7 +925,7 @@ contains
!
! Apply the prolongator
!
call p%precv(level+1)%map_dw(done,&
call p%precv(level+1)%map_prol(done,&
& p%precv(level+1)%wrk%vy2l,done,vy2l,&
& info,work=work,&
& vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1))
@@ -1415,7 +1415,7 @@ contains
if (level < nlev) then
! Apply the restriction
call p%precv(level+1)%map_up(done,mlwrk(level)%x2l,&
call p%precv(level+1)%map_rstr(done,mlwrk(level)%x2l,&
& dzero,mlwrk(level+1)%x2l,&
& info,work=work)
mlwrk(level+1)%y2l(:) = dzero
@@ -1435,7 +1435,7 @@ contains
!
! Apply the prolongator and add correction.
!
call p%precv(level+1)%map_dw(done,&
call p%precv(level+1)%map_prol(done,&
& mlwrk(level+1)%y2l,done,mlwrk(level)%y2l,&
& info,work=work)
if (info /= psb_success_) then
@@ -1555,7 +1555,7 @@ contains
& a_err='Error during residue')
goto 9999
end if
call p%precv(level+1)%map_up(done,mlwrk(level)%ty,&
call p%precv(level+1)%map_rstr(done,mlwrk(level)%ty,&
& dzero,mlwrk(level+1)%x2l,info,work=work)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
@@ -1564,7 +1564,7 @@ contains
end if
else
! Shortcut: just transfer x2l.
call p%precv(level+1)%map_up(done,mlwrk(level)%x2l,&
call p%precv(level+1)%map_rstr(done,mlwrk(level)%x2l,&
& dzero,mlwrk(level+1)%x2l,info,work=work)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
@@ -1593,7 +1593,7 @@ contains
!
! Apply the prolongator
!
call p%precv(level+1)%map_dw(done,mlwrk(level+1)%y2l,&
call p%precv(level+1)%map_prol(done,mlwrk(level+1)%y2l,&
& done,mlwrk(level)%y2l,info,work=work)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
amgprec/impl/amg_s_hierarchy_bld.f90
+6 -6
View File
@@ -333,7 +333,7 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info)
if (i==2) then
sizeratio = desc_a%get_global_rows()/sizeratio
else
sizeratio = sum(prec%precv(i-1)%map%naggr)/sizeratio
sizeratio = sum(prec%precv(i-1)%linmap%naggr)/sizeratio
end if
prec%precv(i)%szratio = sizeratio
@@ -352,7 +352,7 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info)
end if
end if
if (all(nlaggr == prec%precv(i-1)%map%naggr)) then
if (all(nlaggr == prec%precv(i-1)%linmap%naggr)) then
newsz=i-1
if (me == 0) then
write(debug_unit,*) trim(name),&
@@ -387,8 +387,8 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info)
! We are going back and revisit a previous leve;
! recover the aggregation.
!
ilaggr = prec%precv(newsz)%map%iaggr
nlaggr = prec%precv(newsz)%map%naggr
ilaggr = prec%precv(newsz)%linmap%iaggr
nlaggr = prec%precv(newsz)%linmap%naggr
call prec%precv(newsz)%tprol%clone(op_prol,info)
end if
if (do_timings) call psb_tic(idx_matasb)
@@ -449,8 +449,8 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info)
do i=2, iszv
prec%precv(i)%base_a => prec%precv(i)%ac
prec%precv(i)%base_desc => prec%precv(i)%desc_ac
prec%precv(i)%map%p_desc_U => prec%precv(i-1)%base_desc
prec%precv(i)%map%p_desc_V => prec%precv(i)%base_desc
prec%precv(i)%linmap%p_desc_U => prec%precv(i-1)%base_desc
prec%precv(i)%linmap%p_desc_V => prec%precv(i)%base_desc
end do
end if
amgprec/impl/amg_s_hierarchy_rebld.f90
+3 -3
View File
@@ -126,9 +126,9 @@ subroutine amg_s_hierarchy_rebld(a,desc_a,prec,info)
do i=2, iszv
call prec%precv(i-1)%base_a%cp_to(acsr)
p_desc_a => prec%precv(i-1)%base_desc
call prec%precv(i)%map%mat_V2U%cp_to(coo_prol)
call prec%precv(i)%map%mat_U2V%cp_to(coo_restr)
call amg_rap(acsr,p_desc_a,prec%precv(i)%map%naggr,&
call prec%precv(i)%linmap%mat_V2U%cp_to(coo_prol)
call prec%precv(i)%linmap%mat_U2V%cp_to(coo_restr)
call amg_rap(acsr,p_desc_a,prec%precv(i)%linmap%naggr,&
& prec%precv(i)%parms,prec%precv(i)%ac,&
& coo_prol,prec%precv(i)%desc_ac,coo_restr,info)
amgprec/impl/amg_smlprec_aply.f90
+14 -14
View File
@@ -520,7 +520,7 @@ contains
if (level < nlev) then
! Apply the restriction
call p%precv(level+1)%map_up(sone,vx2l,&
call p%precv(level+1)%map_rstr(sone,vx2l,&
& szero,p%precv(level+1)%wrk%vx2l,&
& info,work=work,&
& vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
@@ -540,7 +540,7 @@ contains
!
! Apply the prolongator
!
call p%precv(level+1)%map_dw(sone,&
call p%precv(level+1)%map_prol(sone,&
& p%precv(level+1)%wrk%vy2l, sone,vy2l,&
& info,work=work,&
& vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1))
@@ -653,7 +653,7 @@ contains
& a_err='Error during residue')
goto 9999
end if
call p%precv(level+1)%map_up(sone,vty,&
call p%precv(level+1)%map_rstr(sone,vty,&
& szero,p%precv(level+1)%wrk%vx2l,&
& info,work=work,&
& vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
@@ -664,7 +664,7 @@ contains
end if
else
! Shortcut: just transfer x2l.
call p%precv(level+1)%map_up(sone,vx2l,&
call p%precv(level+1)%map_rstr(sone,vx2l,&
& szero,p%precv(level+1)%wrk%vx2l,&
& info,work=work,&
& vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
@@ -680,7 +680,7 @@ contains
!
! Apply the prolongator
!
call p%precv(level+1)%map_dw(sone,&
call p%precv(level+1)%map_prol(sone,&
& p%precv(level+1)%wrk%vy2l,sone,vy2l,&
& info,work=work,&
& vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1))
@@ -698,7 +698,7 @@ contains
& vy2l,sone,vty,&
& base_desc,info,work=work,trans=trans)
if (info == psb_success_) &
& call p%precv(level+1)%map_up(sone,vty,&
& call p%precv(level+1)%map_rstr(sone,vty,&
& szero,p%precv(level+1)%wrk%vx2l,info,work=work,&
& vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
if (info /= psb_success_) then
@@ -709,7 +709,7 @@ contains
call inner_ml_aply(level+1,p,trans,work,info)
if (info == psb_success_) call p%precv(level+1)%map_dw(sone, &
if (info == psb_success_) call p%precv(level+1)%map_prol(sone, &
& p%precv(level+1)%wrk%vy2l,sone,vy2l,&
& info,work=work,&
& vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1))
@@ -889,7 +889,7 @@ contains
end if
! Apply the restriction
call p%precv(level + 1)%map_up(sone,vty,&
call p%precv(level + 1)%map_rstr(sone,vty,&
& szero,p%precv(level + 1)%wrk%vx2l,&
&info,work=work,&
& vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
@@ -925,7 +925,7 @@ contains
!
! Apply the prolongator
!
call p%precv(level+1)%map_dw(sone,&
call p%precv(level+1)%map_prol(sone,&
& p%precv(level+1)%wrk%vy2l,sone,vy2l,&
& info,work=work,&
& vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1))
@@ -1415,7 +1415,7 @@ contains
if (level < nlev) then
! Apply the restriction
call p%precv(level+1)%map_up(sone,mlwrk(level)%x2l,&
call p%precv(level+1)%map_rstr(sone,mlwrk(level)%x2l,&
& szero,mlwrk(level+1)%x2l,&
& info,work=work)
mlwrk(level+1)%y2l(:) = szero
@@ -1435,7 +1435,7 @@ contains
!
! Apply the prolongator and add correction.
!
call p%precv(level+1)%map_dw(sone,&
call p%precv(level+1)%map_prol(sone,&
& mlwrk(level+1)%y2l,sone,mlwrk(level)%y2l,&
& info,work=work)
if (info /= psb_success_) then
@@ -1555,7 +1555,7 @@ contains
& a_err='Error during residue')
goto 9999
end if
call p%precv(level+1)%map_up(sone,mlwrk(level)%ty,&
call p%precv(level+1)%map_rstr(sone,mlwrk(level)%ty,&
& szero,mlwrk(level+1)%x2l,info,work=work)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
@@ -1564,7 +1564,7 @@ contains
end if
else
! Shortcut: just transfer x2l.
call p%precv(level+1)%map_up(sone,mlwrk(level)%x2l,&
call p%precv(level+1)%map_rstr(sone,mlwrk(level)%x2l,&
& szero,mlwrk(level+1)%x2l,info,work=work)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
@@ -1593,7 +1593,7 @@ contains
!
! Apply the prolongator
!
call p%precv(level+1)%map_dw(sone,mlwrk(level+1)%y2l,&
call p%precv(level+1)%map_prol(sone,mlwrk(level+1)%y2l,&
& sone,mlwrk(level)%y2l,info,work=work)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
amgprec/impl/amg_z_hierarchy_bld.f90
+6 -6
View File
@@ -333,7 +333,7 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info)
if (i==2) then
sizeratio = desc_a%get_global_rows()/sizeratio
else
sizeratio = sum(prec%precv(i-1)%map%naggr)/sizeratio
sizeratio = sum(prec%precv(i-1)%linmap%naggr)/sizeratio
end if
prec%precv(i)%szratio = sizeratio
@@ -352,7 +352,7 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info)
end if
end if
if (all(nlaggr == prec%precv(i-1)%map%naggr)) then
if (all(nlaggr == prec%precv(i-1)%linmap%naggr)) then
newsz=i-1
if (me == 0) then
write(debug_unit,*) trim(name),&
@@ -387,8 +387,8 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info)
! We are going back and revisit a previous leve;
! recover the aggregation.
!
ilaggr = prec%precv(newsz)%map%iaggr
nlaggr = prec%precv(newsz)%map%naggr
ilaggr = prec%precv(newsz)%linmap%iaggr
nlaggr = prec%precv(newsz)%linmap%naggr
call prec%precv(newsz)%tprol%clone(op_prol,info)
end if
if (do_timings) call psb_tic(idx_matasb)
@@ -449,8 +449,8 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info)
do i=2, iszv
prec%precv(i)%base_a => prec%precv(i)%ac
prec%precv(i)%base_desc => prec%precv(i)%desc_ac
prec%precv(i)%map%p_desc_U => prec%precv(i-1)%base_desc
prec%precv(i)%map%p_desc_V => prec%precv(i)%base_desc
prec%precv(i)%linmap%p_desc_U => prec%precv(i-1)%base_desc
prec%precv(i)%linmap%p_desc_V => prec%precv(i)%base_desc
end do
end if
amgprec/impl/amg_z_hierarchy_rebld.f90
+3 -3
View File
@@ -126,9 +126,9 @@ subroutine amg_z_hierarchy_rebld(a,desc_a,prec,info)
do i=2, iszv
call prec%precv(i-1)%base_a%cp_to(acsr)
p_desc_a => prec%precv(i-1)%base_desc
call prec%precv(i)%map%mat_V2U%cp_to(coo_prol)
call prec%precv(i)%map%mat_U2V%cp_to(coo_restr)
call amg_rap(acsr,p_desc_a,prec%precv(i)%map%naggr,&
call prec%precv(i)%linmap%mat_V2U%cp_to(coo_prol)
call prec%precv(i)%linmap%mat_U2V%cp_to(coo_restr)
call amg_rap(acsr,p_desc_a,prec%precv(i)%linmap%naggr,&
& prec%precv(i)%parms,prec%precv(i)%ac,&
& coo_prol,prec%precv(i)%desc_ac,coo_restr,info)
amgprec/impl/amg_zmlprec_aply.f90
+14 -14
View File
@@ -520,7 +520,7 @@ contains
if (level < nlev) then
! Apply the restriction
call p%precv(level+1)%map_up(zone,vx2l,&
call p%precv(level+1)%map_rstr(zone,vx2l,&
& zzero,p%precv(level+1)%wrk%vx2l,&
& info,work=work,&
& vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
@@ -540,7 +540,7 @@ contains
!
! Apply the prolongator
!
call p%precv(level+1)%map_dw(zone,&
call p%precv(level+1)%map_prol(zone,&
& p%precv(level+1)%wrk%vy2l, zone,vy2l,&
& info,work=work,&
& vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1))
@@ -653,7 +653,7 @@ contains
& a_err='Error during residue')
goto 9999
end if
call p%precv(level+1)%map_up(zone,vty,&
call p%precv(level+1)%map_rstr(zone,vty,&
& zzero,p%precv(level+1)%wrk%vx2l,&
& info,work=work,&
& vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
@@ -664,7 +664,7 @@ contains
end if
else
! Shortcut: just transfer x2l.
call p%precv(level+1)%map_up(zone,vx2l,&
call p%precv(level+1)%map_rstr(zone,vx2l,&
& zzero,p%precv(level+1)%wrk%vx2l,&
& info,work=work,&
& vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
@@ -680,7 +680,7 @@ contains
!
! Apply the prolongator
!
call p%precv(level+1)%map_dw(zone,&
call p%precv(level+1)%map_prol(zone,&
& p%precv(level+1)%wrk%vy2l,zone,vy2l,&
& info,work=work,&
& vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1))
@@ -698,7 +698,7 @@ contains
& vy2l,zone,vty,&
& base_desc,info,work=work,trans=trans)
if (info == psb_success_) &
& call p%precv(level+1)%map_up(zone,vty,&
& call p%precv(level+1)%map_rstr(zone,vty,&
& zzero,p%precv(level+1)%wrk%vx2l,info,work=work,&
& vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
if (info /= psb_success_) then
@@ -709,7 +709,7 @@ contains
call inner_ml_aply(level+1,p,trans,work,info)
if (info == psb_success_) call p%precv(level+1)%map_dw(zone, &
if (info == psb_success_) call p%precv(level+1)%map_prol(zone, &
& p%precv(level+1)%wrk%vy2l,zone,vy2l,&
& info,work=work,&
& vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1))
@@ -889,7 +889,7 @@ contains
end if
! Apply the restriction
call p%precv(level + 1)%map_up(zone,vty,&
call p%precv(level + 1)%map_rstr(zone,vty,&
& zzero,p%precv(level + 1)%wrk%vx2l,&
&info,work=work,&
& vtx=wv(1),vty=p%precv(level+1)%wrk%wv(1))
@@ -925,7 +925,7 @@ contains
!
! Apply the prolongator
!
call p%precv(level+1)%map_dw(zone,&
call p%precv(level+1)%map_prol(zone,&
& p%precv(level+1)%wrk%vy2l,zone,vy2l,&
& info,work=work,&
& vtx=p%precv(level+1)%wrk%wv(1),vty=wv(1))
@@ -1415,7 +1415,7 @@ contains
if (level < nlev) then
! Apply the restriction
call p%precv(level+1)%map_up(zone,mlwrk(level)%x2l,&
call p%precv(level+1)%map_rstr(zone,mlwrk(level)%x2l,&
& zzero,mlwrk(level+1)%x2l,&
& info,work=work)
mlwrk(level+1)%y2l(:) = zzero
@@ -1435,7 +1435,7 @@ contains
!
! Apply the prolongator and add correction.
!
call p%precv(level+1)%map_dw(zone,&
call p%precv(level+1)%map_prol(zone,&
& mlwrk(level+1)%y2l,zone,mlwrk(level)%y2l,&
& info,work=work)
if (info /= psb_success_) then
@@ -1555,7 +1555,7 @@ contains
& a_err='Error during residue')
goto 9999
end if
call p%precv(level+1)%map_up(zone,mlwrk(level)%ty,&
call p%precv(level+1)%map_rstr(zone,mlwrk(level)%ty,&
& zzero,mlwrk(level+1)%x2l,info,work=work)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
@@ -1564,7 +1564,7 @@ contains
end if
else
! Shortcut: just transfer x2l.
call p%precv(level+1)%map_up(zone,mlwrk(level)%x2l,&
call p%precv(level+1)%map_rstr(zone,mlwrk(level)%x2l,&
& zzero,mlwrk(level+1)%x2l,info,work=work)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
@@ -1593,7 +1593,7 @@ contains
!
! Apply the prolongator
!
call p%precv(level+1)%map_dw(zone,mlwrk(level+1)%y2l,&
call p%precv(level+1)%map_prol(zone,mlwrk(level+1)%y2l,&
& zone,mlwrk(level)%y2l,info,work=work)
if (info /= psb_success_) then
call psb_errpush(psb_err_internal_error_,name,&
amgprec/impl/level/amg_c_base_onelev_cnv.f90
+1 -1
View File
@@ -62,6 +62,6 @@ subroutine amg_c_base_onelev_cnv(lv,info,amold,vmold,imold)
& call lv%ac%cscnv(info,mold=amold)
if (info == psb_success_ .and. lv%desc_ac%is_ok() &
& .and. present(imold)) call lv%desc_ac%cnv(imold)
if (info == psb_success_) call lv%map%cnv(info,mold=amold,imold=imold)
if (info == psb_success_) call lv%linmap%cnv(info,mold=amold,imold=imold)
end if
end subroutine amg_c_base_onelev_cnv
amgprec/impl/level/amg_c_base_onelev_descr.f90
+3 -3
View File
@@ -89,11 +89,11 @@ subroutine amg_c_base_onelev_descr(lv,il,nl,ilmin,info,iout)
call lv%parms%descr(iout_,info,coarse=coarse)
if (nl > 1) then
if (allocated(lv%map%naggr)) then
if (allocated(lv%linmap%naggr)) then
write(iout_,*) ' Coarse Matrix: Global size: ', &
& sum((1_psb_lpk_*lv%map%naggr(:))),' Nonzeros: ',lv%ac_nz_tot
& sum((1_psb_lpk_*lv%linmap%naggr(:))),' Nonzeros: ',lv%ac_nz_tot
write(iout_,*) ' Local matrix sizes: ', &
& lv%map%naggr(:)
& lv%linmap%naggr(:)
write(iout_,*) ' Aggregation ratio: ', &
& lv%szratio
end if
amgprec/impl/level/amg_c_base_onelev_dump.f90
+7 -7
View File
@@ -108,17 +108,17 @@ subroutine amg_c_base_onelev_dump(lv,level,info,prefix,head,ac,rp,&
call lv%ac%print(fname,head=head,iv=ivr)
end if
if (rp_) then
ivr = lv%map%p_desc_U%get_global_indices(owned=.false.)
ivc = lv%map%p_desc_V%get_global_indices(owned=.false.)
ivr = lv%linmap%p_desc_U%get_global_indices(owned=.false.)
ivc = lv%linmap%p_desc_V%get_global_indices(owned=.false.)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_r.mtx'
call lv%map%mat_U2V%print(fname,head=head,ivr=ivc,ivc=ivr)
call lv%linmap%mat_U2V%print(fname,head=head,ivr=ivc,ivc=ivr)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_p.mtx'
call lv%map%mat_V2U%print(fname,head=head,ivr=ivr,ivc=ivc)
call lv%linmap%mat_V2U%print(fname,head=head,ivr=ivr,ivc=ivc)
end if
if (tprol_) then
! Tentative prolongator is stored with column indices already
! in global numbering, so only IVR is needed.
ivr = lv%map%p_desc_U%get_global_indices(owned=.false.)
ivr = lv%linmap%p_desc_U%get_global_indices(owned=.false.)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_tprol.mtx'
!
! This is not implemented yet.
@@ -133,9 +133,9 @@ subroutine amg_c_base_onelev_dump(lv,level,info,prefix,head,ac,rp,&
end if
if (rp_) then
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_r.mtx'
call lv%map%mat_U2V%print(fname,head=head)
call lv%linmap%mat_U2V%print(fname,head=head)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_p.mtx'
call lv%map%mat_V2U%print(fname,head=head)
call lv%linmap%mat_V2U%print(fname,head=head)
end if
if (tprol_) then
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_tprol.mtx'
amgprec/impl/level/amg_c_base_onelev_free.f90
+1 -1
View File
@@ -63,7 +63,7 @@ subroutine amg_c_base_onelev_free(lv,info)
call lv%ac%free()
if (lv%desc_ac%is_ok()) &
& call lv%desc_ac%free(info)
call lv%map%free(info)
call lv%linmap%free(info)
! This is a pointer to something else, must not free it here.
nullify(lv%base_a)
amgprec/impl/level/amg_c_base_onelev_mat_asb.f90
+2 -2
View File
@@ -53,7 +53,7 @@
! 2. Call amg_Xaggrmat_asb to compute prolongator/restrictor/AC
! 3. According to the choice of DIST/REPL for AC, build a descriptor DESC_AC,
! and adjust the column numbering of AC/OP_PROL/OP_RESTR
! 4. Pack restrictor and prolongator into p%map
! 4. Pack restrictor and prolongator into p%linmap
! 5. Fix base_a and base_desc pointers.
!
!
@@ -157,7 +157,7 @@ subroutine amg_c_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
if (info == psb_success_) call lv%ac%cscnv(info,type='csr',dupl=psb_dupl_add_)
if (info == psb_success_) call lv%aggr%bld_map(desc_a, lv%desc_ac,&
& ilaggr,nlaggr,op_restr,op_prol,lv%map,info)
& ilaggr,nlaggr,op_restr,op_prol,lv%linmap,info)
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='mat_asb/map_bld')
goto 9999
amgprec/impl/level/amg_d_base_onelev_cnv.f90
+1 -1
View File
@@ -62,6 +62,6 @@ subroutine amg_d_base_onelev_cnv(lv,info,amold,vmold,imold)
& call lv%ac%cscnv(info,mold=amold)
if (info == psb_success_ .and. lv%desc_ac%is_ok() &
& .and. present(imold)) call lv%desc_ac%cnv(imold)
if (info == psb_success_) call lv%map%cnv(info,mold=amold,imold=imold)
if (info == psb_success_) call lv%linmap%cnv(info,mold=amold,imold=imold)
end if
end subroutine amg_d_base_onelev_cnv
amgprec/impl/level/amg_d_base_onelev_descr.f90
+3 -3
View File
@@ -89,11 +89,11 @@ subroutine amg_d_base_onelev_descr(lv,il,nl,ilmin,info,iout)
call lv%parms%descr(iout_,info,coarse=coarse)
if (nl > 1) then
if (allocated(lv%map%naggr)) then
if (allocated(lv%linmap%naggr)) then
write(iout_,*) ' Coarse Matrix: Global size: ', &
& sum((1_psb_lpk_*lv%map%naggr(:))),' Nonzeros: ',lv%ac_nz_tot
& sum((1_psb_lpk_*lv%linmap%naggr(:))),' Nonzeros: ',lv%ac_nz_tot
write(iout_,*) ' Local matrix sizes: ', &
& lv%map%naggr(:)
& lv%linmap%naggr(:)
write(iout_,*) ' Aggregation ratio: ', &
& lv%szratio
end if
amgprec/impl/level/amg_d_base_onelev_dump.f90
+7 -7
View File
@@ -108,17 +108,17 @@ subroutine amg_d_base_onelev_dump(lv,level,info,prefix,head,ac,rp,&
call lv%ac%print(fname,head=head,iv=ivr)
end if
if (rp_) then
ivr = lv%map%p_desc_U%get_global_indices(owned=.false.)
ivc = lv%map%p_desc_V%get_global_indices(owned=.false.)
ivr = lv%linmap%p_desc_U%get_global_indices(owned=.false.)
ivc = lv%linmap%p_desc_V%get_global_indices(owned=.false.)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_r.mtx'
call lv%map%mat_U2V%print(fname,head=head,ivr=ivc,ivc=ivr)
call lv%linmap%mat_U2V%print(fname,head=head,ivr=ivc,ivc=ivr)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_p.mtx'
call lv%map%mat_V2U%print(fname,head=head,ivr=ivr,ivc=ivc)
call lv%linmap%mat_V2U%print(fname,head=head,ivr=ivr,ivc=ivc)
end if
if (tprol_) then
! Tentative prolongator is stored with column indices already
! in global numbering, so only IVR is needed.
ivr = lv%map%p_desc_U%get_global_indices(owned=.false.)
ivr = lv%linmap%p_desc_U%get_global_indices(owned=.false.)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_tprol.mtx'
!
! This is not implemented yet.
@@ -133,9 +133,9 @@ subroutine amg_d_base_onelev_dump(lv,level,info,prefix,head,ac,rp,&
end if
if (rp_) then
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_r.mtx'
call lv%map%mat_U2V%print(fname,head=head)
call lv%linmap%mat_U2V%print(fname,head=head)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_p.mtx'
call lv%map%mat_V2U%print(fname,head=head)
call lv%linmap%mat_V2U%print(fname,head=head)
end if
if (tprol_) then
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_tprol.mtx'
amgprec/impl/level/amg_d_base_onelev_free.f90
+1 -1
View File
@@ -63,7 +63,7 @@ subroutine amg_d_base_onelev_free(lv,info)
call lv%ac%free()
if (lv%desc_ac%is_ok()) &
& call lv%desc_ac%free(info)
call lv%map%free(info)
call lv%linmap%free(info)
! This is a pointer to something else, must not free it here.
nullify(lv%base_a)
amgprec/impl/level/amg_d_base_onelev_mat_asb.f90
+2 -2
View File
@@ -53,7 +53,7 @@
! 2. Call amg_Xaggrmat_asb to compute prolongator/restrictor/AC
! 3. According to the choice of DIST/REPL for AC, build a descriptor DESC_AC,
! and adjust the column numbering of AC/OP_PROL/OP_RESTR
! 4. Pack restrictor and prolongator into p%map
! 4. Pack restrictor and prolongator into p%linmap
! 5. Fix base_a and base_desc pointers.
!
!
@@ -157,7 +157,7 @@ subroutine amg_d_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
if (info == psb_success_) call lv%ac%cscnv(info,type='csr',dupl=psb_dupl_add_)
if (info == psb_success_) call lv%aggr%bld_map(desc_a, lv%desc_ac,&
& ilaggr,nlaggr,op_restr,op_prol,lv%map,info)
& ilaggr,nlaggr,op_restr,op_prol,lv%linmap,info)
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='mat_asb/map_bld')
goto 9999
amgprec/impl/level/amg_s_base_onelev_cnv.f90
+1 -1
View File
@@ -62,6 +62,6 @@ subroutine amg_s_base_onelev_cnv(lv,info,amold,vmold,imold)
& call lv%ac%cscnv(info,mold=amold)
if (info == psb_success_ .and. lv%desc_ac%is_ok() &
& .and. present(imold)) call lv%desc_ac%cnv(imold)
if (info == psb_success_) call lv%map%cnv(info,mold=amold,imold=imold)
if (info == psb_success_) call lv%linmap%cnv(info,mold=amold,imold=imold)
end if
end subroutine amg_s_base_onelev_cnv
amgprec/impl/level/amg_s_base_onelev_descr.f90
+3 -3
View File
@@ -89,11 +89,11 @@ subroutine amg_s_base_onelev_descr(lv,il,nl,ilmin,info,iout)
call lv%parms%descr(iout_,info,coarse=coarse)
if (nl > 1) then
if (allocated(lv%map%naggr)) then
if (allocated(lv%linmap%naggr)) then
write(iout_,*) ' Coarse Matrix: Global size: ', &
& sum((1_psb_lpk_*lv%map%naggr(:))),' Nonzeros: ',lv%ac_nz_tot
& sum((1_psb_lpk_*lv%linmap%naggr(:))),' Nonzeros: ',lv%ac_nz_tot
write(iout_,*) ' Local matrix sizes: ', &
& lv%map%naggr(:)
& lv%linmap%naggr(:)
write(iout_,*) ' Aggregation ratio: ', &
& lv%szratio
end if
amgprec/impl/level/amg_s_base_onelev_dump.f90
+7 -7
View File
@@ -108,17 +108,17 @@ subroutine amg_s_base_onelev_dump(lv,level,info,prefix,head,ac,rp,&
call lv%ac%print(fname,head=head,iv=ivr)
end if
if (rp_) then
ivr = lv%map%p_desc_U%get_global_indices(owned=.false.)
ivc = lv%map%p_desc_V%get_global_indices(owned=.false.)
ivr = lv%linmap%p_desc_U%get_global_indices(owned=.false.)
ivc = lv%linmap%p_desc_V%get_global_indices(owned=.false.)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_r.mtx'
call lv%map%mat_U2V%print(fname,head=head,ivr=ivc,ivc=ivr)
call lv%linmap%mat_U2V%print(fname,head=head,ivr=ivc,ivc=ivr)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_p.mtx'
call lv%map%mat_V2U%print(fname,head=head,ivr=ivr,ivc=ivc)
call lv%linmap%mat_V2U%print(fname,head=head,ivr=ivr,ivc=ivc)
end if
if (tprol_) then
! Tentative prolongator is stored with column indices already
! in global numbering, so only IVR is needed.
ivr = lv%map%p_desc_U%get_global_indices(owned=.false.)
ivr = lv%linmap%p_desc_U%get_global_indices(owned=.false.)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_tprol.mtx'
!
! This is not implemented yet.
@@ -133,9 +133,9 @@ subroutine amg_s_base_onelev_dump(lv,level,info,prefix,head,ac,rp,&
end if
if (rp_) then
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_r.mtx'
call lv%map%mat_U2V%print(fname,head=head)
call lv%linmap%mat_U2V%print(fname,head=head)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_p.mtx'
call lv%map%mat_V2U%print(fname,head=head)
call lv%linmap%mat_V2U%print(fname,head=head)
end if
if (tprol_) then
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_tprol.mtx'
amgprec/impl/level/amg_s_base_onelev_free.f90
+1 -1
View File
@@ -63,7 +63,7 @@ subroutine amg_s_base_onelev_free(lv,info)
call lv%ac%free()
if (lv%desc_ac%is_ok()) &
& call lv%desc_ac%free(info)
call lv%map%free(info)
call lv%linmap%free(info)
! This is a pointer to something else, must not free it here.
nullify(lv%base_a)
amgprec/impl/level/amg_s_base_onelev_mat_asb.f90
+2 -2
View File
@@ -53,7 +53,7 @@
! 2. Call amg_Xaggrmat_asb to compute prolongator/restrictor/AC
! 3. According to the choice of DIST/REPL for AC, build a descriptor DESC_AC,
! and adjust the column numbering of AC/OP_PROL/OP_RESTR
! 4. Pack restrictor and prolongator into p%map
! 4. Pack restrictor and prolongator into p%linmap
! 5. Fix base_a and base_desc pointers.
!
!
@@ -157,7 +157,7 @@ subroutine amg_s_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
if (info == psb_success_) call lv%ac%cscnv(info,type='csr',dupl=psb_dupl_add_)
if (info == psb_success_) call lv%aggr%bld_map(desc_a, lv%desc_ac,&
& ilaggr,nlaggr,op_restr,op_prol,lv%map,info)
& ilaggr,nlaggr,op_restr,op_prol,lv%linmap,info)
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='mat_asb/map_bld')
goto 9999
amgprec/impl/level/amg_z_base_onelev_cnv.f90
+1 -1
View File
@@ -62,6 +62,6 @@ subroutine amg_z_base_onelev_cnv(lv,info,amold,vmold,imold)
& call lv%ac%cscnv(info,mold=amold)
if (info == psb_success_ .and. lv%desc_ac%is_ok() &
& .and. present(imold)) call lv%desc_ac%cnv(imold)
if (info == psb_success_) call lv%map%cnv(info,mold=amold,imold=imold)
if (info == psb_success_) call lv%linmap%cnv(info,mold=amold,imold=imold)
end if
end subroutine amg_z_base_onelev_cnv
amgprec/impl/level/amg_z_base_onelev_descr.f90
+3 -3
View File
@@ -89,11 +89,11 @@ subroutine amg_z_base_onelev_descr(lv,il,nl,ilmin,info,iout)
call lv%parms%descr(iout_,info,coarse=coarse)
if (nl > 1) then
if (allocated(lv%map%naggr)) then
if (allocated(lv%linmap%naggr)) then
write(iout_,*) ' Coarse Matrix: Global size: ', &
& sum((1_psb_lpk_*lv%map%naggr(:))),' Nonzeros: ',lv%ac_nz_tot
& sum((1_psb_lpk_*lv%linmap%naggr(:))),' Nonzeros: ',lv%ac_nz_tot
write(iout_,*) ' Local matrix sizes: ', &
& lv%map%naggr(:)
& lv%linmap%naggr(:)
write(iout_,*) ' Aggregation ratio: ', &
& lv%szratio
end if
amgprec/impl/level/amg_z_base_onelev_dump.f90
+7 -7
View File
@@ -108,17 +108,17 @@ subroutine amg_z_base_onelev_dump(lv,level,info,prefix,head,ac,rp,&
call lv%ac%print(fname,head=head,iv=ivr)
end if
if (rp_) then
ivr = lv%map%p_desc_U%get_global_indices(owned=.false.)
ivc = lv%map%p_desc_V%get_global_indices(owned=.false.)
ivr = lv%linmap%p_desc_U%get_global_indices(owned=.false.)
ivc = lv%linmap%p_desc_V%get_global_indices(owned=.false.)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_r.mtx'
call lv%map%mat_U2V%print(fname,head=head,ivr=ivc,ivc=ivr)
call lv%linmap%mat_U2V%print(fname,head=head,ivr=ivc,ivc=ivr)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_p.mtx'
call lv%map%mat_V2U%print(fname,head=head,ivr=ivr,ivc=ivc)
call lv%linmap%mat_V2U%print(fname,head=head,ivr=ivr,ivc=ivc)
end if
if (tprol_) then
! Tentative prolongator is stored with column indices already
! in global numbering, so only IVR is needed.
ivr = lv%map%p_desc_U%get_global_indices(owned=.false.)
ivr = lv%linmap%p_desc_U%get_global_indices(owned=.false.)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_tprol.mtx'
!
! This is not implemented yet.
@@ -133,9 +133,9 @@ subroutine amg_z_base_onelev_dump(lv,level,info,prefix,head,ac,rp,&
end if
if (rp_) then
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_r.mtx'
call lv%map%mat_U2V%print(fname,head=head)
call lv%linmap%mat_U2V%print(fname,head=head)
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_p.mtx'
call lv%map%mat_V2U%print(fname,head=head)
call lv%linmap%mat_V2U%print(fname,head=head)
end if
if (tprol_) then
write(fname(lname+1:),'(a,i3.3,a)')'_l',level,'_tprol.mtx'
amgprec/impl/level/amg_z_base_onelev_free.f90
+1 -1
View File
@@ -63,7 +63,7 @@ subroutine amg_z_base_onelev_free(lv,info)
call lv%ac%free()
if (lv%desc_ac%is_ok()) &
& call lv%desc_ac%free(info)
call lv%map%free(info)
call lv%linmap%free(info)
! This is a pointer to something else, must not free it here.
nullify(lv%base_a)
amgprec/impl/level/amg_z_base_onelev_mat_asb.f90
+2 -2
View File
@@ -53,7 +53,7 @@
! 2. Call amg_Xaggrmat_asb to compute prolongator/restrictor/AC
! 3. According to the choice of DIST/REPL for AC, build a descriptor DESC_AC,
! and adjust the column numbering of AC/OP_PROL/OP_RESTR
! 4. Pack restrictor and prolongator into p%map
! 4. Pack restrictor and prolongator into p%linmap
! 5. Fix base_a and base_desc pointers.
!
!
@@ -157,7 +157,7 @@ subroutine amg_z_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,t_prol,info)
if (info == psb_success_) call lv%ac%cscnv(info,type='csr',dupl=psb_dupl_add_)
if (info == psb_success_) call lv%aggr%bld_map(desc_a, lv%desc_ac,&
& ilaggr,nlaggr,op_restr,op_prol,lv%map,info)
& ilaggr,nlaggr,op_restr,op_prol,lv%linmap,info)
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='mat_asb/map_bld')
goto 9999