Define and test GLOBTRIL/GLOBTRIU in template

This commit is contained in:
sfilippone
2026-09-14 14:01:31 +02:00
parent 6263059751
commit e255d401bc
15 changed files with 2247 additions and 38 deletions
+87 -1
View File
@@ -375,6 +375,8 @@ module psb_c_base_mat_mod
procedure, pass(a) :: mv_from_fmt => psb_lc_mv_coo_from_fmt
procedure, pass(a) :: cp_to_icoo => psb_lc_cp_coo_to_icoo
procedure, pass(a) :: cp_from_icoo => psb_lc_cp_coo_from_icoo
procedure, pass(a) :: tril => psb_lc_coo_tril
procedure, pass(a) :: triu => psb_lc_coo_triu
procedure, pass(a) :: csput_a => psb_lc_coo_csput_a
procedure, pass(a) :: get_diag => psb_lc_coo_get_diag
@@ -1798,7 +1800,6 @@ module psb_c_base_mat_mod
end subroutine psb_c_coo_mold
end interface
!
!> Function print.
!! \memberof psb_c_coo_sparse_mat
@@ -3548,7 +3549,92 @@ module psb_c_base_mat_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lc_coo_mold
end interface
!
!> Function tril:
!! \memberof psb_d_coo_sparse_mat
!! \brief Copy the lower triangle, i.e. all entries
!! A(I,J) such that J-I <= DIAG
!! default value is DIAG=0, i.e. lower triangle up to
!! the main diagonal.
!! DIAG=-1 means copy the strictly lower triangle
!! DIAG= 1 means copy the lower triangle plus the first diagonal
!! of the upper triangle.
!! Moreover, apply a clipping by copying entries A(I,J) only if
!! IMIN<=I<=IMAX
!! JMIN<=J<=JMAX
!!
!! \param l the output (sub)matrix
!! \param info return code
!! \param diag [0] the last diagonal (J-I) to be considered.
!! \param imin [1] the minimum row index we are interested in
!! \param imax [a\%get_nrows()] the minimum row index we are interested in
!! \param jmin [1] minimum col index
!! \param jmax [a\%get_ncols()] maximum col index
!! \param iren(:) [none] an array to return renumbered indices (iren(ia(:)),iren(ja(:))
!! \param rscale [false] map [min(ia(:)):max(ia(:))] onto [1:max(ia(:))-min(ia(:))+1]
!! \param cscale [false] map [min(ja(:)):max(ja(:))] onto [1:max(ja(:))-min(ja(:))+1]
!! ( iren cannot be specified with rscale/cscale)
!! \param append [false] append to ia,ja
!! \param nzin [none] if append, then first new entry should go in entry nzin+1
!! \param u [none] copy of the complementary triangle
!!
!
interface
subroutine psb_lc_coo_tril(a,l,info,diag,imin,imax,&
& jmin,jmax,rscale,cscale,u)
import
class(psb_lc_coo_sparse_mat), intent(in) :: a
class(psb_lc_coo_sparse_mat), intent(out) :: l
integer(psb_ipk_),intent(out) :: info
integer(psb_lpk_), intent(in), optional :: diag,imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
class(psb_lc_coo_sparse_mat), optional, intent(out) :: u
end subroutine psb_lc_coo_tril
end interface
!
!> Function triu:
!! \memberof psb_d_coo_sparse_mat
!! \brief Copy the upper triangle, i.e. all entries
!! A(I,J) such that DIAG <= J-I
!! default value is DIAG=0, i.e. upper triangle from
!! the main diagonal up.
!! DIAG= 1 means copy the strictly upper triangle
!! DIAG=-1 means copy the upper triangle plus the first diagonal
!! of the lower triangle.
!! Moreover, apply a clipping by copying entries A(I,J) only if
!! IMIN<=I<=IMAX
!! JMIN<=J<=JMAX
!! Optionally copies the lower triangle at the same time
!!
!! \param u the output (sub)matrix
!! \param info return code
!! \param diag [0] the last diagonal (J-I) to be considered.
!! \param imin [1] the minimum row index we are interested in
!! \param imax [a\%get_nrows()] the minimum row index we are interested in
!! \param jmin [1] minimum col index
!! \param jmax [a\%get_ncols()] maximum col index
!! \param iren(:) [none] an array to return renumbered indices (iren(ia(:)),iren(ja(:))
!! \param rscale [false] map [min(ia(:)):max(ia(:))] onto [1:max(ia(:))-min(ia(:))+1]
!! \param cscale [false] map [min(ja(:)):max(ja(:))] onto [1:max(ja(:))-min(ja(:))+1]
!! ( iren cannot be specified with rscale/cscale)
!! \param append [false] append to ia,ja
!! \param nzin [none] if append, then first new entry should go in entry nzin+1
!! \param l [none] copy of the complementary triangle
!!
!
interface
subroutine psb_lc_coo_triu(a,u,info,diag,imin,imax,&
& jmin,jmax,rscale,cscale,l)
import
class(psb_lc_coo_sparse_mat), intent(in) :: a
class(psb_lc_coo_sparse_mat), intent(out) :: u
integer(psb_ipk_),intent(out) :: info
integer(psb_lpk_), intent(in), optional :: diag,imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
class(psb_lc_coo_sparse_mat), optional, intent(out) :: l
end subroutine psb_lc_coo_triu
end interface
!
!> Function print.
+2 -4
View File
@@ -375,8 +375,8 @@ module psb_d_base_mat_mod
procedure, pass(a) :: mv_from_fmt => psb_ld_mv_coo_from_fmt
procedure, pass(a) :: cp_to_icoo => psb_ld_cp_coo_to_icoo
procedure, pass(a) :: cp_from_icoo => psb_ld_cp_coo_from_icoo
procedure, pass(a) :: tril => psb_ld_coo_tril
procedure, pass(a) :: triu => psb_ld_coo_triu
procedure, pass(a) :: tril => psb_ld_coo_tril
procedure, pass(a) :: triu => psb_ld_coo_triu
procedure, pass(a) :: csput_a => psb_ld_coo_csput_a
procedure, pass(a) :: get_diag => psb_ld_coo_get_diag
@@ -1800,7 +1800,6 @@ module psb_d_base_mat_mod
end subroutine psb_d_coo_mold
end interface
!
!> Function print.
!! \memberof psb_d_coo_sparse_mat
@@ -3637,7 +3636,6 @@ module psb_d_base_mat_mod
end subroutine psb_ld_coo_triu
end interface
!
!> Function print.
!! \memberof psb_ld_coo_sparse_mat
+87 -1
View File
@@ -375,6 +375,8 @@ module psb_s_base_mat_mod
procedure, pass(a) :: mv_from_fmt => psb_ls_mv_coo_from_fmt
procedure, pass(a) :: cp_to_icoo => psb_ls_cp_coo_to_icoo
procedure, pass(a) :: cp_from_icoo => psb_ls_cp_coo_from_icoo
procedure, pass(a) :: tril => psb_ls_coo_tril
procedure, pass(a) :: triu => psb_ls_coo_triu
procedure, pass(a) :: csput_a => psb_ls_coo_csput_a
procedure, pass(a) :: get_diag => psb_ls_coo_get_diag
@@ -1798,7 +1800,6 @@ module psb_s_base_mat_mod
end subroutine psb_s_coo_mold
end interface
!
!> Function print.
!! \memberof psb_s_coo_sparse_mat
@@ -3548,7 +3549,92 @@ module psb_s_base_mat_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psb_ls_coo_mold
end interface
!
!> Function tril:
!! \memberof psb_d_coo_sparse_mat
!! \brief Copy the lower triangle, i.e. all entries
!! A(I,J) such that J-I <= DIAG
!! default value is DIAG=0, i.e. lower triangle up to
!! the main diagonal.
!! DIAG=-1 means copy the strictly lower triangle
!! DIAG= 1 means copy the lower triangle plus the first diagonal
!! of the upper triangle.
!! Moreover, apply a clipping by copying entries A(I,J) only if
!! IMIN<=I<=IMAX
!! JMIN<=J<=JMAX
!!
!! \param l the output (sub)matrix
!! \param info return code
!! \param diag [0] the last diagonal (J-I) to be considered.
!! \param imin [1] the minimum row index we are interested in
!! \param imax [a\%get_nrows()] the minimum row index we are interested in
!! \param jmin [1] minimum col index
!! \param jmax [a\%get_ncols()] maximum col index
!! \param iren(:) [none] an array to return renumbered indices (iren(ia(:)),iren(ja(:))
!! \param rscale [false] map [min(ia(:)):max(ia(:))] onto [1:max(ia(:))-min(ia(:))+1]
!! \param cscale [false] map [min(ja(:)):max(ja(:))] onto [1:max(ja(:))-min(ja(:))+1]
!! ( iren cannot be specified with rscale/cscale)
!! \param append [false] append to ia,ja
!! \param nzin [none] if append, then first new entry should go in entry nzin+1
!! \param u [none] copy of the complementary triangle
!!
!
interface
subroutine psb_ls_coo_tril(a,l,info,diag,imin,imax,&
& jmin,jmax,rscale,cscale,u)
import
class(psb_ls_coo_sparse_mat), intent(in) :: a
class(psb_ls_coo_sparse_mat), intent(out) :: l
integer(psb_ipk_),intent(out) :: info
integer(psb_lpk_), intent(in), optional :: diag,imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
class(psb_ls_coo_sparse_mat), optional, intent(out) :: u
end subroutine psb_ls_coo_tril
end interface
!
!> Function triu:
!! \memberof psb_d_coo_sparse_mat
!! \brief Copy the upper triangle, i.e. all entries
!! A(I,J) such that DIAG <= J-I
!! default value is DIAG=0, i.e. upper triangle from
!! the main diagonal up.
!! DIAG= 1 means copy the strictly upper triangle
!! DIAG=-1 means copy the upper triangle plus the first diagonal
!! of the lower triangle.
!! Moreover, apply a clipping by copying entries A(I,J) only if
!! IMIN<=I<=IMAX
!! JMIN<=J<=JMAX
!! Optionally copies the lower triangle at the same time
!!
!! \param u the output (sub)matrix
!! \param info return code
!! \param diag [0] the last diagonal (J-I) to be considered.
!! \param imin [1] the minimum row index we are interested in
!! \param imax [a\%get_nrows()] the minimum row index we are interested in
!! \param jmin [1] minimum col index
!! \param jmax [a\%get_ncols()] maximum col index
!! \param iren(:) [none] an array to return renumbered indices (iren(ia(:)),iren(ja(:))
!! \param rscale [false] map [min(ia(:)):max(ia(:))] onto [1:max(ia(:))-min(ia(:))+1]
!! \param cscale [false] map [min(ja(:)):max(ja(:))] onto [1:max(ja(:))-min(ja(:))+1]
!! ( iren cannot be specified with rscale/cscale)
!! \param append [false] append to ia,ja
!! \param nzin [none] if append, then first new entry should go in entry nzin+1
!! \param l [none] copy of the complementary triangle
!!
!
interface
subroutine psb_ls_coo_triu(a,u,info,diag,imin,imax,&
& jmin,jmax,rscale,cscale,l)
import
class(psb_ls_coo_sparse_mat), intent(in) :: a
class(psb_ls_coo_sparse_mat), intent(out) :: u
integer(psb_ipk_),intent(out) :: info
integer(psb_lpk_), intent(in), optional :: diag,imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
class(psb_ls_coo_sparse_mat), optional, intent(out) :: l
end subroutine psb_ls_coo_triu
end interface
!
!> Function print.
+87 -1
View File
@@ -375,6 +375,8 @@ module psb_z_base_mat_mod
procedure, pass(a) :: mv_from_fmt => psb_lz_mv_coo_from_fmt
procedure, pass(a) :: cp_to_icoo => psb_lz_cp_coo_to_icoo
procedure, pass(a) :: cp_from_icoo => psb_lz_cp_coo_from_icoo
procedure, pass(a) :: tril => psb_lz_coo_tril
procedure, pass(a) :: triu => psb_lz_coo_triu
procedure, pass(a) :: csput_a => psb_lz_coo_csput_a
procedure, pass(a) :: get_diag => psb_lz_coo_get_diag
@@ -1798,7 +1800,6 @@ module psb_z_base_mat_mod
end subroutine psb_z_coo_mold
end interface
!
!> Function print.
!! \memberof psb_z_coo_sparse_mat
@@ -3548,7 +3549,92 @@ module psb_z_base_mat_mod
integer(psb_ipk_), intent(out) :: info
end subroutine psb_lz_coo_mold
end interface
!
!> Function tril:
!! \memberof psb_d_coo_sparse_mat
!! \brief Copy the lower triangle, i.e. all entries
!! A(I,J) such that J-I <= DIAG
!! default value is DIAG=0, i.e. lower triangle up to
!! the main diagonal.
!! DIAG=-1 means copy the strictly lower triangle
!! DIAG= 1 means copy the lower triangle plus the first diagonal
!! of the upper triangle.
!! Moreover, apply a clipping by copying entries A(I,J) only if
!! IMIN<=I<=IMAX
!! JMIN<=J<=JMAX
!!
!! \param l the output (sub)matrix
!! \param info return code
!! \param diag [0] the last diagonal (J-I) to be considered.
!! \param imin [1] the minimum row index we are interested in
!! \param imax [a\%get_nrows()] the minimum row index we are interested in
!! \param jmin [1] minimum col index
!! \param jmax [a\%get_ncols()] maximum col index
!! \param iren(:) [none] an array to return renumbered indices (iren(ia(:)),iren(ja(:))
!! \param rscale [false] map [min(ia(:)):max(ia(:))] onto [1:max(ia(:))-min(ia(:))+1]
!! \param cscale [false] map [min(ja(:)):max(ja(:))] onto [1:max(ja(:))-min(ja(:))+1]
!! ( iren cannot be specified with rscale/cscale)
!! \param append [false] append to ia,ja
!! \param nzin [none] if append, then first new entry should go in entry nzin+1
!! \param u [none] copy of the complementary triangle
!!
!
interface
subroutine psb_lz_coo_tril(a,l,info,diag,imin,imax,&
& jmin,jmax,rscale,cscale,u)
import
class(psb_lz_coo_sparse_mat), intent(in) :: a
class(psb_lz_coo_sparse_mat), intent(out) :: l
integer(psb_ipk_),intent(out) :: info
integer(psb_lpk_), intent(in), optional :: diag,imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
class(psb_lz_coo_sparse_mat), optional, intent(out) :: u
end subroutine psb_lz_coo_tril
end interface
!
!> Function triu:
!! \memberof psb_d_coo_sparse_mat
!! \brief Copy the upper triangle, i.e. all entries
!! A(I,J) such that DIAG <= J-I
!! default value is DIAG=0, i.e. upper triangle from
!! the main diagonal up.
!! DIAG= 1 means copy the strictly upper triangle
!! DIAG=-1 means copy the upper triangle plus the first diagonal
!! of the lower triangle.
!! Moreover, apply a clipping by copying entries A(I,J) only if
!! IMIN<=I<=IMAX
!! JMIN<=J<=JMAX
!! Optionally copies the lower triangle at the same time
!!
!! \param u the output (sub)matrix
!! \param info return code
!! \param diag [0] the last diagonal (J-I) to be considered.
!! \param imin [1] the minimum row index we are interested in
!! \param imax [a\%get_nrows()] the minimum row index we are interested in
!! \param jmin [1] minimum col index
!! \param jmax [a\%get_ncols()] maximum col index
!! \param iren(:) [none] an array to return renumbered indices (iren(ia(:)),iren(ja(:))
!! \param rscale [false] map [min(ia(:)):max(ia(:))] onto [1:max(ia(:))-min(ia(:))+1]
!! \param cscale [false] map [min(ja(:)):max(ja(:))] onto [1:max(ja(:))-min(ja(:))+1]
!! ( iren cannot be specified with rscale/cscale)
!! \param append [false] append to ia,ja
!! \param nzin [none] if append, then first new entry should go in entry nzin+1
!! \param l [none] copy of the complementary triangle
!!
!
interface
subroutine psb_lz_coo_triu(a,u,info,diag,imin,imax,&
& jmin,jmax,rscale,cscale,l)
import
class(psb_lz_coo_sparse_mat), intent(in) :: a
class(psb_lz_coo_sparse_mat), intent(out) :: u
integer(psb_ipk_),intent(out) :: info
integer(psb_lpk_), intent(in), optional :: diag,imin,imax,jmin,jmax
logical, intent(in), optional :: rscale,cscale
class(psb_lz_coo_sparse_mat), optional, intent(out) :: l
end subroutine psb_lz_coo_triu
end interface
!
!> Function print.
+24
View File
@@ -435,6 +435,30 @@ Module psb_c_tools_mod
end subroutine psb_c_simple_glob_transpose_ip
end interface psb_glob_transpose
interface psb_globtril
Subroutine psb_cglobtril(a,desc_a,b,info,diag,imin,imax,jmin,jmax)
import
implicit none
Type(psb_cspmat_type), Intent(inout) :: a
Type(psb_desc_type), Intent(inout), target :: desc_a
Type(psb_cspmat_type), Intent(out) :: b
integer(psb_ipk_), intent(out) :: info
integer(psb_lpk_), intent(in), optional :: diag,imin,imax,jmin,jmax
end Subroutine psb_cglobtril
end interface psb_globtril
interface psb_globtriu
Subroutine psb_cglobtriu(a,desc_a,b,info,diag,imin,imax,jmin,jmax)
import
implicit none
Type(psb_cspmat_type), Intent(inout) :: a
Type(psb_desc_type), Intent(inout), target :: desc_a
Type(psb_cspmat_type), Intent(out) :: b
integer(psb_ipk_), intent(out) :: info
integer(psb_lpk_), intent(in), optional :: diag,imin,imax,jmin,jmax
end Subroutine psb_cglobtriu
end interface psb_globtriu
interface psb_getelem
function psb_c_getelem(x,index,desc_a,info) result(res)
import
+24
View File
@@ -435,6 +435,30 @@ Module psb_s_tools_mod
end subroutine psb_s_simple_glob_transpose_ip
end interface psb_glob_transpose
interface psb_globtril
Subroutine psb_sglobtril(a,desc_a,b,info,diag,imin,imax,jmin,jmax)
import
implicit none
Type(psb_sspmat_type), Intent(inout) :: a
Type(psb_desc_type), Intent(inout), target :: desc_a
Type(psb_sspmat_type), Intent(out) :: b
integer(psb_ipk_), intent(out) :: info
integer(psb_lpk_), intent(in), optional :: diag,imin,imax,jmin,jmax
end Subroutine psb_sglobtril
end interface psb_globtril
interface psb_globtriu
Subroutine psb_sglobtriu(a,desc_a,b,info,diag,imin,imax,jmin,jmax)
import
implicit none
Type(psb_sspmat_type), Intent(inout) :: a
Type(psb_desc_type), Intent(inout), target :: desc_a
Type(psb_sspmat_type), Intent(out) :: b
integer(psb_ipk_), intent(out) :: info
integer(psb_lpk_), intent(in), optional :: diag,imin,imax,jmin,jmax
end Subroutine psb_sglobtriu
end interface psb_globtriu
interface psb_getelem
function psb_s_getelem(x,index,desc_a,info) result(res)
import
+24
View File
@@ -435,6 +435,30 @@ Module psb_z_tools_mod
end subroutine psb_z_simple_glob_transpose_ip
end interface psb_glob_transpose
interface psb_globtril
Subroutine psb_zglobtril(a,desc_a,b,info,diag,imin,imax,jmin,jmax)
import
implicit none
Type(psb_zspmat_type), Intent(inout) :: a
Type(psb_desc_type), Intent(inout), target :: desc_a
Type(psb_zspmat_type), Intent(out) :: b
integer(psb_ipk_), intent(out) :: info
integer(psb_lpk_), intent(in), optional :: diag,imin,imax,jmin,jmax
end Subroutine psb_zglobtril
end interface psb_globtril
interface psb_globtriu
Subroutine psb_zglobtriu(a,desc_a,b,info,diag,imin,imax,jmin,jmax)
import
implicit none
Type(psb_zspmat_type), Intent(inout) :: a
Type(psb_desc_type), Intent(inout), target :: desc_a
Type(psb_zspmat_type), Intent(out) :: b
integer(psb_ipk_), intent(out) :: info
integer(psb_lpk_), intent(in), optional :: diag,imin,imax,jmin,jmax
end Subroutine psb_zglobtriu
end interface psb_globtriu
interface psb_getelem
function psb_z_getelem(x,index,desc_a,info) result(res)
import