From 9e347fae90cc6a9cb89cfc6b91abcf71ca7ce186 Mon Sep 17 00:00:00 2001 From: Cirdans-Home Date: Tue, 14 Apr 2020 19:10:44 +0200 Subject: [PATCH] Removed orphan subroutines for matrix info --- base/psblas/psb_cgetmatinfo.f90 | 162 -------------------------------- base/psblas/psb_dgetmatinfo.f90 | 162 -------------------------------- base/psblas/psb_sgetmatinfo.f90 | 162 -------------------------------- base/psblas/psb_zgetmatinfo.f90 | 162 -------------------------------- 4 files changed, 648 deletions(-) diff --git a/base/psblas/psb_cgetmatinfo.f90 b/base/psblas/psb_cgetmatinfo.f90 index 296bae9d..788a591e 100644 --- a/base/psblas/psb_cgetmatinfo.f90 +++ b/base/psblas/psb_cgetmatinfo.f90 @@ -90,165 +90,3 @@ function psb_cget_nnz(a,desc_a,info) result(res) return end function - -function psb_c_is_matupd(a,desc_a,info) result(res) - use psb_base_mod, psb_protect_name => psb_c_is_matupd - use psi_mod - - implicit none - - logical :: res - type(psb_cspmat_type), intent(in) :: a - type(psb_desc_type), intent (in) :: desc_a - integer(psb_ipk_), intent(out) :: info - - ! locals - integer(psb_ipk_) :: ictxt, np, me,& - & err_act, iia, jja - integer(psb_lpk_) :: m,n,ia,ja,localnnz - character(len=20) :: name, ch_err - ! - name='psb_cis_matupd' - info=psb_success_ - call psb_erractionsave(err_act) - if (psb_errstatus_fatal()) then - info = psb_err_internal_error_ ; goto 9999 - end if - - ictxt=desc_a%get_context() - call psb_info(ictxt, me, np) - if (np == -1) then - info = psb_err_context_error_ - call psb_errpush(info,name) - goto 9999 - endif - - m = desc_a%get_global_rows() - n = desc_a%get_global_cols() - - ! Check for matrix correctness - call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja) - if(info /= psb_success_) then - info=psb_err_from_subroutine_ - ch_err='psb_chkmat' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - - res = a%is_upd() - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(ictxt,err_act) - - return -end function - -function psb_c_is_matasb(a,desc_a,info) result(res) - use psb_base_mod, psb_protect_name => psb_c_is_matasb - use psi_mod - - implicit none - - logical :: res - type(psb_cspmat_type), intent(in) :: a - type(psb_desc_type), intent (in) :: desc_a - integer(psb_ipk_), intent(out) :: info - - ! locals - integer(psb_ipk_) :: ictxt, np, me,& - & err_act, iia, jja - integer(psb_lpk_) :: m,n,ia,ja,localnnz - character(len=20) :: name, ch_err - ! - name='psb_cis_matasb' - info=psb_success_ - call psb_erractionsave(err_act) - if (psb_errstatus_fatal()) then - info = psb_err_internal_error_ ; goto 9999 - end if - - ictxt=desc_a%get_context() - call psb_info(ictxt, me, np) - if (np == -1) then - info = psb_err_context_error_ - call psb_errpush(info,name) - goto 9999 - endif - - m = desc_a%get_global_rows() - n = desc_a%get_global_cols() - - ! Check for matrix correctness - call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja) - if(info /= psb_success_) then - info=psb_err_from_subroutine_ - ch_err='psb_chkmat' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - - res = a%is_asb() - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(ictxt,err_act) - - return -end function - -function psb_c_is_matbld(a,desc_a,info) result(res) - use psb_base_mod, psb_protect_name => psb_c_is_matbld - use psi_mod - - implicit none - - logical :: res - type(psb_cspmat_type), intent(in) :: a - type(psb_desc_type), intent (in) :: desc_a - integer(psb_ipk_), intent(out) :: info - - ! locals - integer(psb_ipk_) :: ictxt, np, me,& - & err_act, iia, jja - integer(psb_lpk_) :: m,n,ia,ja,localnnz - character(len=20) :: name, ch_err - ! - name='psb_cis_matbld' - info=psb_success_ - call psb_erractionsave(err_act) - if (psb_errstatus_fatal()) then - info = psb_err_internal_error_ ; goto 9999 - end if - - ictxt=desc_a%get_context() - call psb_info(ictxt, me, np) - if (np == -1) then - info = psb_err_context_error_ - call psb_errpush(info,name) - goto 9999 - endif - - m = desc_a%get_global_rows() - n = desc_a%get_global_cols() - - ! Check for matrix correctness - call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja) - if(info /= psb_success_) then - info=psb_err_from_subroutine_ - ch_err='psb_chkmat' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - - res = a%is_bld() - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(ictxt,err_act) - - return -end function diff --git a/base/psblas/psb_dgetmatinfo.f90 b/base/psblas/psb_dgetmatinfo.f90 index 1dd24c7a..c574a2e4 100644 --- a/base/psblas/psb_dgetmatinfo.f90 +++ b/base/psblas/psb_dgetmatinfo.f90 @@ -90,165 +90,3 @@ function psb_dget_nnz(a,desc_a,info) result(res) return end function - -function psb_d_is_matupd(a,desc_a,info) result(res) - use psb_base_mod, psb_protect_name => psb_d_is_matupd - use psi_mod - - implicit none - - logical :: res - type(psb_dspmat_type), intent(in) :: a - type(psb_desc_type), intent (in) :: desc_a - integer(psb_ipk_), intent(out) :: info - - ! locals - integer(psb_ipk_) :: ictxt, np, me,& - & err_act, iia, jja - integer(psb_lpk_) :: m,n,ia,ja,localnnz - character(len=20) :: name, ch_err - ! - name='psb_dis_matupd' - info=psb_success_ - call psb_erractionsave(err_act) - if (psb_errstatus_fatal()) then - info = psb_err_internal_error_ ; goto 9999 - end if - - ictxt=desc_a%get_context() - call psb_info(ictxt, me, np) - if (np == -1) then - info = psb_err_context_error_ - call psb_errpush(info,name) - goto 9999 - endif - - m = desc_a%get_global_rows() - n = desc_a%get_global_cols() - - ! Check for matrix correctness - call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja) - if(info /= psb_success_) then - info=psb_err_from_subroutine_ - ch_err='psb_chkmat' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - - res = a%is_upd() - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(ictxt,err_act) - - return -end function - -function psb_d_is_matasb(a,desc_a,info) result(res) - use psb_base_mod, psb_protect_name => psb_d_is_matasb - use psi_mod - - implicit none - - logical :: res - type(psb_dspmat_type), intent(in) :: a - type(psb_desc_type), intent (in) :: desc_a - integer(psb_ipk_), intent(out) :: info - - ! locals - integer(psb_ipk_) :: ictxt, np, me,& - & err_act, iia, jja - integer(psb_lpk_) :: m,n,ia,ja,localnnz - character(len=20) :: name, ch_err - ! - name='psb_dis_matasb' - info=psb_success_ - call psb_erractionsave(err_act) - if (psb_errstatus_fatal()) then - info = psb_err_internal_error_ ; goto 9999 - end if - - ictxt=desc_a%get_context() - call psb_info(ictxt, me, np) - if (np == -1) then - info = psb_err_context_error_ - call psb_errpush(info,name) - goto 9999 - endif - - m = desc_a%get_global_rows() - n = desc_a%get_global_cols() - - ! Check for matrix correctness - call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja) - if(info /= psb_success_) then - info=psb_err_from_subroutine_ - ch_err='psb_chkmat' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - - res = a%is_asb() - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(ictxt,err_act) - - return -end function - -function psb_d_is_matbld(a,desc_a,info) result(res) - use psb_base_mod, psb_protect_name => psb_d_is_matbld - use psi_mod - - implicit none - - logical :: res - type(psb_dspmat_type), intent(in) :: a - type(psb_desc_type), intent (in) :: desc_a - integer(psb_ipk_), intent(out) :: info - - ! locals - integer(psb_ipk_) :: ictxt, np, me,& - & err_act, iia, jja - integer(psb_lpk_) :: m,n,ia,ja,localnnz - character(len=20) :: name, ch_err - ! - name='psb_dis_matbld' - info=psb_success_ - call psb_erractionsave(err_act) - if (psb_errstatus_fatal()) then - info = psb_err_internal_error_ ; goto 9999 - end if - - ictxt=desc_a%get_context() - call psb_info(ictxt, me, np) - if (np == -1) then - info = psb_err_context_error_ - call psb_errpush(info,name) - goto 9999 - endif - - m = desc_a%get_global_rows() - n = desc_a%get_global_cols() - - ! Check for matrix correctness - call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja) - if(info /= psb_success_) then - info=psb_err_from_subroutine_ - ch_err='psb_chkmat' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - - res = a%is_bld() - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(ictxt,err_act) - - return -end function diff --git a/base/psblas/psb_sgetmatinfo.f90 b/base/psblas/psb_sgetmatinfo.f90 index 47684d8f..b1368cc7 100644 --- a/base/psblas/psb_sgetmatinfo.f90 +++ b/base/psblas/psb_sgetmatinfo.f90 @@ -90,165 +90,3 @@ function psb_sget_nnz(a,desc_a,info) result(res) return end function - -function psb_s_is_matupd(a,desc_a,info) result(res) - use psb_base_mod, psb_protect_name => psb_s_is_matupd - use psi_mod - - implicit none - - logical :: res - type(psb_sspmat_type), intent(in) :: a - type(psb_desc_type), intent (in) :: desc_a - integer(psb_ipk_), intent(out) :: info - - ! locals - integer(psb_ipk_) :: ictxt, np, me,& - & err_act, iia, jja - integer(psb_lpk_) :: m,n,ia,ja,localnnz - character(len=20) :: name, ch_err - ! - name='psb_sis_matupd' - info=psb_success_ - call psb_erractionsave(err_act) - if (psb_errstatus_fatal()) then - info = psb_err_internal_error_ ; goto 9999 - end if - - ictxt=desc_a%get_context() - call psb_info(ictxt, me, np) - if (np == -1) then - info = psb_err_context_error_ - call psb_errpush(info,name) - goto 9999 - endif - - m = desc_a%get_global_rows() - n = desc_a%get_global_cols() - - ! Check for matrix correctness - call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja) - if(info /= psb_success_) then - info=psb_err_from_subroutine_ - ch_err='psb_chkmat' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - - res = a%is_upd() - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(ictxt,err_act) - - return -end function - -function psb_s_is_matasb(a,desc_a,info) result(res) - use psb_base_mod, psb_protect_name => psb_s_is_matasb - use psi_mod - - implicit none - - logical :: res - type(psb_sspmat_type), intent(in) :: a - type(psb_desc_type), intent (in) :: desc_a - integer(psb_ipk_), intent(out) :: info - - ! locals - integer(psb_ipk_) :: ictxt, np, me,& - & err_act, iia, jja - integer(psb_lpk_) :: m,n,ia,ja,localnnz - character(len=20) :: name, ch_err - ! - name='psb_sis_matasb' - info=psb_success_ - call psb_erractionsave(err_act) - if (psb_errstatus_fatal()) then - info = psb_err_internal_error_ ; goto 9999 - end if - - ictxt=desc_a%get_context() - call psb_info(ictxt, me, np) - if (np == -1) then - info = psb_err_context_error_ - call psb_errpush(info,name) - goto 9999 - endif - - m = desc_a%get_global_rows() - n = desc_a%get_global_cols() - - ! Check for matrix correctness - call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja) - if(info /= psb_success_) then - info=psb_err_from_subroutine_ - ch_err='psb_chkmat' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - - res = a%is_asb() - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(ictxt,err_act) - - return -end function - -function psb_s_is_matbld(a,desc_a,info) result(res) - use psb_base_mod, psb_protect_name => psb_s_is_matbld - use psi_mod - - implicit none - - logical :: res - type(psb_sspmat_type), intent(in) :: a - type(psb_desc_type), intent (in) :: desc_a - integer(psb_ipk_), intent(out) :: info - - ! locals - integer(psb_ipk_) :: ictxt, np, me,& - & err_act, iia, jja - integer(psb_lpk_) :: m,n,ia,ja,localnnz - character(len=20) :: name, ch_err - ! - name='psb_sis_matbld' - info=psb_success_ - call psb_erractionsave(err_act) - if (psb_errstatus_fatal()) then - info = psb_err_internal_error_ ; goto 9999 - end if - - ictxt=desc_a%get_context() - call psb_info(ictxt, me, np) - if (np == -1) then - info = psb_err_context_error_ - call psb_errpush(info,name) - goto 9999 - endif - - m = desc_a%get_global_rows() - n = desc_a%get_global_cols() - - ! Check for matrix correctness - call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja) - if(info /= psb_success_) then - info=psb_err_from_subroutine_ - ch_err='psb_chkmat' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - - res = a%is_bld() - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(ictxt,err_act) - - return -end function diff --git a/base/psblas/psb_zgetmatinfo.f90 b/base/psblas/psb_zgetmatinfo.f90 index 1dfa7525..d3e3562b 100644 --- a/base/psblas/psb_zgetmatinfo.f90 +++ b/base/psblas/psb_zgetmatinfo.f90 @@ -90,165 +90,3 @@ function psb_zget_nnz(a,desc_a,info) result(res) return end function - -function psb_z_is_matupd(a,desc_a,info) result(res) - use psb_base_mod, psb_protect_name => psb_z_is_matupd - use psi_mod - - implicit none - - logical :: res - type(psb_zspmat_type), intent(in) :: a - type(psb_desc_type), intent (in) :: desc_a - integer(psb_ipk_), intent(out) :: info - - ! locals - integer(psb_ipk_) :: ictxt, np, me,& - & err_act, iia, jja - integer(psb_lpk_) :: m,n,ia,ja,localnnz - character(len=20) :: name, ch_err - ! - name='psb_zis_matupd' - info=psb_success_ - call psb_erractionsave(err_act) - if (psb_errstatus_fatal()) then - info = psb_err_internal_error_ ; goto 9999 - end if - - ictxt=desc_a%get_context() - call psb_info(ictxt, me, np) - if (np == -1) then - info = psb_err_context_error_ - call psb_errpush(info,name) - goto 9999 - endif - - m = desc_a%get_global_rows() - n = desc_a%get_global_cols() - - ! Check for matrix correctness - call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja) - if(info /= psb_success_) then - info=psb_err_from_subroutine_ - ch_err='psb_chkmat' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - - res = a%is_upd() - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(ictxt,err_act) - - return -end function - -function psb_z_is_matasb(a,desc_a,info) result(res) - use psb_base_mod, psb_protect_name => psb_z_is_matasb - use psi_mod - - implicit none - - logical :: res - type(psb_zspmat_type), intent(in) :: a - type(psb_desc_type), intent (in) :: desc_a - integer(psb_ipk_), intent(out) :: info - - ! locals - integer(psb_ipk_) :: ictxt, np, me,& - & err_act, iia, jja - integer(psb_lpk_) :: m,n,ia,ja,localnnz - character(len=20) :: name, ch_err - ! - name='psb_zis_matasb' - info=psb_success_ - call psb_erractionsave(err_act) - if (psb_errstatus_fatal()) then - info = psb_err_internal_error_ ; goto 9999 - end if - - ictxt=desc_a%get_context() - call psb_info(ictxt, me, np) - if (np == -1) then - info = psb_err_context_error_ - call psb_errpush(info,name) - goto 9999 - endif - - m = desc_a%get_global_rows() - n = desc_a%get_global_cols() - - ! Check for matrix correctness - call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja) - if(info /= psb_success_) then - info=psb_err_from_subroutine_ - ch_err='psb_chkmat' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - - res = a%is_asb() - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(ictxt,err_act) - - return -end function - -function psb_z_is_matbld(a,desc_a,info) result(res) - use psb_base_mod, psb_protect_name => psb_z_is_matbld - use psi_mod - - implicit none - - logical :: res - type(psb_zspmat_type), intent(in) :: a - type(psb_desc_type), intent (in) :: desc_a - integer(psb_ipk_), intent(out) :: info - - ! locals - integer(psb_ipk_) :: ictxt, np, me,& - & err_act, iia, jja - integer(psb_lpk_) :: m,n,ia,ja,localnnz - character(len=20) :: name, ch_err - ! - name='psb_zis_matbld' - info=psb_success_ - call psb_erractionsave(err_act) - if (psb_errstatus_fatal()) then - info = psb_err_internal_error_ ; goto 9999 - end if - - ictxt=desc_a%get_context() - call psb_info(ictxt, me, np) - if (np == -1) then - info = psb_err_context_error_ - call psb_errpush(info,name) - goto 9999 - endif - - m = desc_a%get_global_rows() - n = desc_a%get_global_cols() - - ! Check for matrix correctness - call psb_chkmat(m,n,ia,ja,desc_a,info,iia,jja) - if(info /= psb_success_) then - info=psb_err_from_subroutine_ - ch_err='psb_chkmat' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - - res = a%is_bld() - - call psb_erractionrestore(err_act) - return - -9999 call psb_error_handler(ictxt,err_act) - - return -end function