From cab98295e28263a46ad8cf0562017125d5f6e1c6 Mon Sep 17 00:00:00 2001 From: sfilippone Date: Tue, 6 Aug 2024 10:28:02 +0200 Subject: [PATCH] Improve handling of pointers in hierarchy_bld --- amgprec/impl/amg_c_hierarchy_bld.F90 | 11 ++++++++--- amgprec/impl/amg_d_hierarchy_bld.F90 | 11 ++++++++--- amgprec/impl/amg_s_hierarchy_bld.F90 | 11 ++++++++--- amgprec/impl/amg_z_hierarchy_bld.F90 | 11 ++++++++--- 4 files changed, 32 insertions(+), 12 deletions(-) diff --git a/amgprec/impl/amg_c_hierarchy_bld.F90 b/amgprec/impl/amg_c_hierarchy_bld.F90 index e81e2868..22da0636 100644 --- a/amgprec/impl/amg_c_hierarchy_bld.F90 +++ b/amgprec/impl/amg_c_hierarchy_bld.F90 @@ -451,11 +451,16 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info) if (.not.associated(prec%precv(1)%base_desc,desc_a)) then prec%precv(1)%base_desc => prec%precv(1)%desc_ac end if - do i=2, iszv + 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)%linmap%p_desc_U => prec%precv(i-1)%base_desc - prec%precv(i)%linmap%p_desc_V => prec%precv(i)%base_desc + ! This is needed when the linmap object has been built + ! reusing the base_desc descriptor through a pointer. + ! With PSBLAS 4 we will have a better solution + if (associated(prec%precv(i)%linmap%p_desc_U)) & + & prec%precv(i)%linmap%p_desc_U => prec%precv(i-1)%base_desc + if (associated(prec%precv(i)%linmap%p_desc_V))& + & prec%precv(i)%linmap%p_desc_V => prec%precv(i)%base_desc end do end if diff --git a/amgprec/impl/amg_d_hierarchy_bld.F90 b/amgprec/impl/amg_d_hierarchy_bld.F90 index 649362c8..6a3d865a 100644 --- a/amgprec/impl/amg_d_hierarchy_bld.F90 +++ b/amgprec/impl/amg_d_hierarchy_bld.F90 @@ -451,11 +451,16 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info) if (.not.associated(prec%precv(1)%base_desc,desc_a)) then prec%precv(1)%base_desc => prec%precv(1)%desc_ac end if - do i=2, iszv + 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)%linmap%p_desc_U => prec%precv(i-1)%base_desc - prec%precv(i)%linmap%p_desc_V => prec%precv(i)%base_desc + ! This is needed when the linmap object has been built + ! reusing the base_desc descriptor through a pointer. + ! With PSBLAS 4 we will have a better solution + if (associated(prec%precv(i)%linmap%p_desc_U)) & + & prec%precv(i)%linmap%p_desc_U => prec%precv(i-1)%base_desc + if (associated(prec%precv(i)%linmap%p_desc_V))& + & prec%precv(i)%linmap%p_desc_V => prec%precv(i)%base_desc end do end if diff --git a/amgprec/impl/amg_s_hierarchy_bld.F90 b/amgprec/impl/amg_s_hierarchy_bld.F90 index b7b1d4a7..7aa022b4 100644 --- a/amgprec/impl/amg_s_hierarchy_bld.F90 +++ b/amgprec/impl/amg_s_hierarchy_bld.F90 @@ -451,11 +451,16 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info) if (.not.associated(prec%precv(1)%base_desc,desc_a)) then prec%precv(1)%base_desc => prec%precv(1)%desc_ac end if - do i=2, iszv + 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)%linmap%p_desc_U => prec%precv(i-1)%base_desc - prec%precv(i)%linmap%p_desc_V => prec%precv(i)%base_desc + ! This is needed when the linmap object has been built + ! reusing the base_desc descriptor through a pointer. + ! With PSBLAS 4 we will have a better solution + if (associated(prec%precv(i)%linmap%p_desc_U)) & + & prec%precv(i)%linmap%p_desc_U => prec%precv(i-1)%base_desc + if (associated(prec%precv(i)%linmap%p_desc_V))& + & prec%precv(i)%linmap%p_desc_V => prec%precv(i)%base_desc end do end if diff --git a/amgprec/impl/amg_z_hierarchy_bld.F90 b/amgprec/impl/amg_z_hierarchy_bld.F90 index 9da2736a..a432d881 100644 --- a/amgprec/impl/amg_z_hierarchy_bld.F90 +++ b/amgprec/impl/amg_z_hierarchy_bld.F90 @@ -451,11 +451,16 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info) if (.not.associated(prec%precv(1)%base_desc,desc_a)) then prec%precv(1)%base_desc => prec%precv(1)%desc_ac end if - do i=2, iszv + 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)%linmap%p_desc_U => prec%precv(i-1)%base_desc - prec%precv(i)%linmap%p_desc_V => prec%precv(i)%base_desc + ! This is needed when the linmap object has been built + ! reusing the base_desc descriptor through a pointer. + ! With PSBLAS 4 we will have a better solution + if (associated(prec%precv(i)%linmap%p_desc_U)) & + & prec%precv(i)%linmap%p_desc_U => prec%precv(i-1)%base_desc + if (associated(prec%precv(i)%linmap%p_desc_V))& + & prec%precv(i)%linmap%p_desc_V => prec%precv(i)%base_desc end do end if