Removed orphan subroutines for matrix info

merge-paraggr-newops
Cirdans-Home 5 years ago
parent 01f4f718de
commit 9e347fae90

@ -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

@ -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

@ -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

@ -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

Loading…
Cancel
Save