From 1a61bd04d4b6931295ba22a4a3d3acb452c3ad1f Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Fri, 27 Nov 2020 14:33:56 +0100 Subject: [PATCH] Updates in RENUM for fileread. To be completed. --- util/psb_c_renum_impl.F90 | 50 ++++++++++++++++++++++++++++++++++++++- util/psb_d_renum_impl.F90 | 50 ++++++++++++++++++++++++++++++++++++++- util/psb_renum_mod.f90 | 28 ++++++++++++++++++++++ util/psb_s_renum_impl.F90 | 50 ++++++++++++++++++++++++++++++++++++++- util/psb_z_renum_impl.F90 | 50 ++++++++++++++++++++++++++++++++++++++- 5 files changed, 224 insertions(+), 4 deletions(-) diff --git a/util/psb_c_renum_impl.F90 b/util/psb_c_renum_impl.F90 index 4a1cf220..d73d0e50 100644 --- a/util/psb_c_renum_impl.F90 +++ b/util/psb_c_renum_impl.F90 @@ -336,7 +336,6 @@ contains end subroutine psb_c_mat_renum - subroutine psb_c_cmp_bwpf(mat,bwl,bwu,prf,info) use psb_base_mod use psb_renum_mod, psb_protect_name => psb_c_cmp_bwpf @@ -386,3 +385,52 @@ subroutine psb_c_cmp_bwpf(mat,bwl,bwu,prf,info) end select end subroutine psb_c_cmp_bwpf + +subroutine psb_lc_cmp_bwpf(mat,bwl,bwu,prf,info) + use psb_base_mod + use psb_renum_mod, psb_protect_name => psb_lc_cmp_bwpf + implicit none + type(psb_lcspmat_type), intent(in) :: mat + integer(psb_lpk_), intent(out) :: bwl, bwu + integer(psb_lpk_), intent(out) :: prf + integer(psb_ipk_), intent(out) :: info + ! + integer(psb_lpk_), allocatable :: irow(:), icol(:) + complex(psb_spk_), allocatable :: val(:) + integer(psb_lpk_) :: nz, i, j, lrbu, lrbl + + info = psb_success_ + bwl = 0 + bwu = 0 + prf = 0 + select type (aa=>mat%a) + class is (psb_lc_csr_sparse_mat) + do i=1, aa%get_nrows() + lrbl = 0 + lrbu = 0 + do j = aa%irp(i), aa%irp(i+1) - 1 + lrbl = max(lrbl,i-aa%ja(j)) + lrbu = max(lrbu,aa%ja(j)-i) + end do + prf = prf + lrbl+lrbu + bwu = max(bwu,lrbu) + bwl = max(bwl,lrbu) + end do + + class default + do i=1, aa%get_nrows() + lrbl = 0 + lrbu = 0 + call aa%csget(i,i,nz,irow,icol,val,info) + if (info /= psb_success_) return + do j=1, nz + lrbl = max(lrbl,i-icol(j)) + lrbu = max(lrbu,icol(j)-i) + end do + prf = prf + lrbl+lrbu + bwu = max(bwu,lrbu) + bwl = max(bwl,lrbu) + end do + end select + +end subroutine psb_lc_cmp_bwpf diff --git a/util/psb_d_renum_impl.F90 b/util/psb_d_renum_impl.F90 index bd4664d8..8e896756 100644 --- a/util/psb_d_renum_impl.F90 +++ b/util/psb_d_renum_impl.F90 @@ -335,7 +335,6 @@ contains end subroutine psb_d_mat_renum - subroutine psb_d_cmp_bwpf(mat,bwl,bwu,prf,info) use psb_base_mod use psb_renum_mod, psb_protect_name => psb_d_cmp_bwpf @@ -385,3 +384,52 @@ subroutine psb_d_cmp_bwpf(mat,bwl,bwu,prf,info) end select end subroutine psb_d_cmp_bwpf + +subroutine psb_ld_cmp_bwpf(mat,bwl,bwu,prf,info) + use psb_base_mod + use psb_renum_mod, psb_protect_name => psb_ld_cmp_bwpf + implicit none + type(psb_ldspmat_type), intent(in) :: mat + integer(psb_lpk_), intent(out) :: bwl, bwu + integer(psb_lpk_), intent(out) :: prf + integer(psb_ipk_), intent(out) :: info + ! + integer(psb_lpk_), allocatable :: irow(:), icol(:) + real(psb_dpk_), allocatable :: val(:) + integer(psb_lpk_) :: nz, i, j, lrbu, lrbl + + info = psb_success_ + bwl = 0 + bwu = 0 + prf = 0 + select type (aa=>mat%a) + class is (psb_ld_csr_sparse_mat) + do i=1, aa%get_nrows() + lrbl = 0 + lrbu = 0 + do j = aa%irp(i), aa%irp(i+1) - 1 + lrbl = max(lrbl,i-aa%ja(j)) + lrbu = max(lrbu,aa%ja(j)-i) + end do + prf = prf + lrbl+lrbu + bwu = max(bwu,lrbu) + bwl = max(bwl,lrbu) + end do + + class default + do i=1, aa%get_nrows() + lrbl = 0 + lrbu = 0 + call aa%csget(i,i,nz,irow,icol,val,info) + if (info /= psb_success_) return + do j=1, nz + lrbl = max(lrbl,i-icol(j)) + lrbu = max(lrbu,icol(j)-i) + end do + prf = prf + lrbl+lrbu + bwu = max(bwu,lrbu) + bwl = max(bwl,lrbu) + end do + end select + +end subroutine psb_ld_cmp_bwpf diff --git a/util/psb_renum_mod.f90 b/util/psb_renum_mod.f90 index 82d51712..8200871a 100644 --- a/util/psb_renum_mod.f90 +++ b/util/psb_renum_mod.f90 @@ -126,6 +126,34 @@ module psb_renum_mod integer(psb_ipk_), intent(out) :: prf integer(psb_ipk_), intent(out) :: info end subroutine psb_z_cmp_bwpf + subroutine psb_ls_cmp_bwpf(mat,bwl,bwu,prf,info) + import :: psb_ipk_, psb_lpk_, psb_lsspmat_type + type(psb_lsspmat_type), intent(in) :: mat + integer(psb_lpk_), intent(out) :: bwl, bwu + integer(psb_lpk_), intent(out) :: prf + integer(psb_ipk_), intent(out) :: info + end subroutine psb_ls_cmp_bwpf + subroutine psb_ld_cmp_bwpf(mat,bwl,bwu,prf,info) + import :: psb_ipk_, psb_lpk_, psb_ldspmat_type + type(psb_ldspmat_type), intent(in) :: mat + integer(psb_lpk_), intent(out) :: bwl, bwu + integer(psb_lpk_), intent(out) :: prf + integer(psb_ipk_), intent(out) :: info + end subroutine psb_ld_cmp_bwpf + subroutine psb_lc_cmp_bwpf(mat,bwl,bwu,prf,info) + import :: psb_ipk_, psb_lpk_, psb_lcspmat_type + type(psb_lcspmat_type), intent(in) :: mat + integer(psb_lpk_), intent(out) :: bwl, bwu + integer(psb_lpk_), intent(out) :: prf + integer(psb_ipk_), intent(out) :: info + end subroutine psb_lc_cmp_bwpf + subroutine psb_lz_cmp_bwpf(mat,bwl,bwu,prf,info) + import :: psb_ipk_, psb_lpk_, psb_lzspmat_type + type(psb_lzspmat_type), intent(in) :: mat + integer(psb_lpk_), intent(out) :: bwl, bwu + integer(psb_lpk_), intent(out) :: prf + integer(psb_ipk_), intent(out) :: info + end subroutine psb_lz_cmp_bwpf end interface psb_cmp_bwpf diff --git a/util/psb_s_renum_impl.F90 b/util/psb_s_renum_impl.F90 index 008bbbb0..e7dd3a9c 100644 --- a/util/psb_s_renum_impl.F90 +++ b/util/psb_s_renum_impl.F90 @@ -337,7 +337,6 @@ contains end subroutine psb_s_mat_renum - subroutine psb_s_cmp_bwpf(mat,bwl,bwu,prf,info) use psb_base_mod use psb_renum_mod, psb_protect_name => psb_s_cmp_bwpf @@ -387,3 +386,52 @@ subroutine psb_s_cmp_bwpf(mat,bwl,bwu,prf,info) end select end subroutine psb_s_cmp_bwpf + +subroutine psb_ls_cmp_bwpf(mat,bwl,bwu,prf,info) + use psb_base_mod + use psb_renum_mod, psb_protect_name => psb_ls_cmp_bwpf + implicit none + type(psb_lsspmat_type), intent(in) :: mat + integer(psb_lpk_), intent(out) :: bwl, bwu + integer(psb_lpk_), intent(out) :: prf + integer(psb_ipk_), intent(out) :: info + ! + integer(psb_lpk_), allocatable :: irow(:), icol(:) + real(psb_spk_), allocatable :: val(:) + integer(psb_lpk_) :: nz, i, j, lrbu, lrbl + + info = psb_success_ + bwl = 0 + bwu = 0 + prf = 0 + select type (aa=>mat%a) + class is (psb_ls_csr_sparse_mat) + do i=1, aa%get_nrows() + lrbl = 0 + lrbu = 0 + do j = aa%irp(i), aa%irp(i+1) - 1 + lrbl = max(lrbl,i-aa%ja(j)) + lrbu = max(lrbu,aa%ja(j)-i) + end do + prf = prf + lrbl+lrbu + bwu = max(bwu,lrbu) + bwl = max(bwl,lrbu) + end do + + class default + do i=1, aa%get_nrows() + lrbl = 0 + lrbu = 0 + call aa%csget(i,i,nz,irow,icol,val,info) + if (info /= psb_success_) return + do j=1, nz + lrbl = max(lrbl,i-icol(j)) + lrbu = max(lrbu,icol(j)-i) + end do + prf = prf + lrbl+lrbu + bwu = max(bwu,lrbu) + bwl = max(bwl,lrbu) + end do + end select + +end subroutine psb_ls_cmp_bwpf diff --git a/util/psb_z_renum_impl.F90 b/util/psb_z_renum_impl.F90 index aa8f6b72..956243be 100644 --- a/util/psb_z_renum_impl.F90 +++ b/util/psb_z_renum_impl.F90 @@ -335,7 +335,6 @@ contains end subroutine psb_z_mat_renum - subroutine psb_z_cmp_bwpf(mat,bwl,bwu,prf,info) use psb_base_mod use psb_renum_mod, psb_protect_name => psb_z_cmp_bwpf @@ -385,3 +384,52 @@ subroutine psb_z_cmp_bwpf(mat,bwl,bwu,prf,info) end select end subroutine psb_z_cmp_bwpf + +subroutine psb_lz_cmp_bwpf(mat,bwl,bwu,prf,info) + use psb_base_mod + use psb_renum_mod, psb_protect_name => psb_lz_cmp_bwpf + implicit none + type(psb_lzspmat_type), intent(in) :: mat + integer(psb_lpk_), intent(out) :: bwl, bwu + integer(psb_lpk_), intent(out) :: prf + integer(psb_ipk_), intent(out) :: info + ! + integer(psb_lpk_), allocatable :: irow(:), icol(:) + complex(psb_dpk_), allocatable :: val(:) + integer(psb_lpk_) :: nz, i, j, lrbu, lrbl + + info = psb_success_ + bwl = 0 + bwu = 0 + prf = 0 + select type (aa=>mat%a) + class is (psb_lz_csr_sparse_mat) + do i=1, aa%get_nrows() + lrbl = 0 + lrbu = 0 + do j = aa%irp(i), aa%irp(i+1) - 1 + lrbl = max(lrbl,i-aa%ja(j)) + lrbu = max(lrbu,aa%ja(j)-i) + end do + prf = prf + lrbl+lrbu + bwu = max(bwu,lrbu) + bwl = max(bwl,lrbu) + end do + + class default + do i=1, aa%get_nrows() + lrbl = 0 + lrbu = 0 + call aa%csget(i,i,nz,irow,icol,val,info) + if (info /= psb_success_) return + do j=1, nz + lrbl = max(lrbl,i-icol(j)) + lrbu = max(lrbu,icol(j)-i) + end do + prf = prf + lrbl+lrbu + bwu = max(bwu,lrbu) + bwl = max(bwl,lrbu) + end do + end select + +end subroutine psb_lz_cmp_bwpf