mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-20 12:52:14 +00:00
Implement clip_diag for LX
This commit is contained in:
Salvatore Filippone
@@ -370,6 +370,9 @@ module psb_c_mat_mod
|
||||
generic, public :: cp_from => cp_from_b
|
||||
procedure, pass(a) :: cp_to_b => psb_lc_cp_to
|
||||
generic, public :: cp_to => cp_to_b
|
||||
procedure, pass(a) :: clip_d_ip => psb_lc_clip_d_ip
|
||||
procedure, pass(a) :: clip_d => psb_lc_clip_d
|
||||
generic, public :: clip_diag => clip_d_ip, clip_d
|
||||
procedure, pass(a) :: cscnv_np => psb_lc_cscnv
|
||||
procedure, pass(a) :: cscnv_ip => psb_lc_cscnv_ip
|
||||
procedure, pass(a) :: cscnv_base => psb_lc_cscnv_base
|
||||
@@ -1553,6 +1556,28 @@ module psb_c_mat_mod
|
||||
end interface
|
||||
|
||||
|
||||
!
|
||||
! Produce a version of the matrix with diagonal cut
|
||||
! out; passes through a COO buffer.
|
||||
!
|
||||
interface
|
||||
subroutine psb_lc_clip_d(a,b,info)
|
||||
import :: psb_ipk_, psb_lpk_, psb_lcspmat_type
|
||||
class(psb_lcspmat_type), intent(in) :: a
|
||||
class(psb_lcspmat_type), intent(inout) :: b
|
||||
integer(psb_ipk_),intent(out) :: info
|
||||
end subroutine psb_lc_clip_d
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine psb_lc_clip_d_ip(a,info)
|
||||
import :: psb_ipk_, psb_lpk_, psb_lcspmat_type
|
||||
class(psb_lcspmat_type), intent(inout) :: a
|
||||
integer(psb_ipk_),intent(out) :: info
|
||||
end subroutine psb_lc_clip_d_ip
|
||||
end interface
|
||||
|
||||
|
||||
!
|
||||
! These four interfaces cut through the
|
||||
! encapsulation between spmat_type and base_sparse_mat.
|
||||
|
||||
@@ -370,6 +370,9 @@ module psb_d_mat_mod
|
||||
generic, public :: cp_from => cp_from_b
|
||||
procedure, pass(a) :: cp_to_b => psb_ld_cp_to
|
||||
generic, public :: cp_to => cp_to_b
|
||||
procedure, pass(a) :: clip_d_ip => psb_ld_clip_d_ip
|
||||
procedure, pass(a) :: clip_d => psb_ld_clip_d
|
||||
generic, public :: clip_diag => clip_d_ip, clip_d
|
||||
procedure, pass(a) :: cscnv_np => psb_ld_cscnv
|
||||
procedure, pass(a) :: cscnv_ip => psb_ld_cscnv_ip
|
||||
procedure, pass(a) :: cscnv_base => psb_ld_cscnv_base
|
||||
@@ -1553,6 +1556,28 @@ module psb_d_mat_mod
|
||||
end interface
|
||||
|
||||
|
||||
!
|
||||
! Produce a version of the matrix with diagonal cut
|
||||
! out; passes through a COO buffer.
|
||||
!
|
||||
interface
|
||||
subroutine psb_ld_clip_d(a,b,info)
|
||||
import :: psb_ipk_, psb_lpk_, psb_ldspmat_type
|
||||
class(psb_ldspmat_type), intent(in) :: a
|
||||
class(psb_ldspmat_type), intent(inout) :: b
|
||||
integer(psb_ipk_),intent(out) :: info
|
||||
end subroutine psb_ld_clip_d
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine psb_ld_clip_d_ip(a,info)
|
||||
import :: psb_ipk_, psb_lpk_, psb_ldspmat_type
|
||||
class(psb_ldspmat_type), intent(inout) :: a
|
||||
integer(psb_ipk_),intent(out) :: info
|
||||
end subroutine psb_ld_clip_d_ip
|
||||
end interface
|
||||
|
||||
|
||||
!
|
||||
! These four interfaces cut through the
|
||||
! encapsulation between spmat_type and base_sparse_mat.
|
||||
|
||||
@@ -370,6 +370,9 @@ module psb_s_mat_mod
|
||||
generic, public :: cp_from => cp_from_b
|
||||
procedure, pass(a) :: cp_to_b => psb_ls_cp_to
|
||||
generic, public :: cp_to => cp_to_b
|
||||
procedure, pass(a) :: clip_d_ip => psb_ls_clip_d_ip
|
||||
procedure, pass(a) :: clip_d => psb_ls_clip_d
|
||||
generic, public :: clip_diag => clip_d_ip, clip_d
|
||||
procedure, pass(a) :: cscnv_np => psb_ls_cscnv
|
||||
procedure, pass(a) :: cscnv_ip => psb_ls_cscnv_ip
|
||||
procedure, pass(a) :: cscnv_base => psb_ls_cscnv_base
|
||||
@@ -1553,6 +1556,28 @@ module psb_s_mat_mod
|
||||
end interface
|
||||
|
||||
|
||||
!
|
||||
! Produce a version of the matrix with diagonal cut
|
||||
! out; passes through a COO buffer.
|
||||
!
|
||||
interface
|
||||
subroutine psb_ls_clip_d(a,b,info)
|
||||
import :: psb_ipk_, psb_lpk_, psb_lsspmat_type
|
||||
class(psb_lsspmat_type), intent(in) :: a
|
||||
class(psb_lsspmat_type), intent(inout) :: b
|
||||
integer(psb_ipk_),intent(out) :: info
|
||||
end subroutine psb_ls_clip_d
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine psb_ls_clip_d_ip(a,info)
|
||||
import :: psb_ipk_, psb_lpk_, psb_lsspmat_type
|
||||
class(psb_lsspmat_type), intent(inout) :: a
|
||||
integer(psb_ipk_),intent(out) :: info
|
||||
end subroutine psb_ls_clip_d_ip
|
||||
end interface
|
||||
|
||||
|
||||
!
|
||||
! These four interfaces cut through the
|
||||
! encapsulation between spmat_type and base_sparse_mat.
|
||||
|
||||
@@ -370,6 +370,9 @@ module psb_z_mat_mod
|
||||
generic, public :: cp_from => cp_from_b
|
||||
procedure, pass(a) :: cp_to_b => psb_lz_cp_to
|
||||
generic, public :: cp_to => cp_to_b
|
||||
procedure, pass(a) :: clip_d_ip => psb_lz_clip_d_ip
|
||||
procedure, pass(a) :: clip_d => psb_lz_clip_d
|
||||
generic, public :: clip_diag => clip_d_ip, clip_d
|
||||
procedure, pass(a) :: cscnv_np => psb_lz_cscnv
|
||||
procedure, pass(a) :: cscnv_ip => psb_lz_cscnv_ip
|
||||
procedure, pass(a) :: cscnv_base => psb_lz_cscnv_base
|
||||
@@ -1553,6 +1556,28 @@ module psb_z_mat_mod
|
||||
end interface
|
||||
|
||||
|
||||
!
|
||||
! Produce a version of the matrix with diagonal cut
|
||||
! out; passes through a COO buffer.
|
||||
!
|
||||
interface
|
||||
subroutine psb_lz_clip_d(a,b,info)
|
||||
import :: psb_ipk_, psb_lpk_, psb_lzspmat_type
|
||||
class(psb_lzspmat_type), intent(in) :: a
|
||||
class(psb_lzspmat_type), intent(inout) :: b
|
||||
integer(psb_ipk_),intent(out) :: info
|
||||
end subroutine psb_lz_clip_d
|
||||
end interface
|
||||
|
||||
interface
|
||||
subroutine psb_lz_clip_d_ip(a,info)
|
||||
import :: psb_ipk_, psb_lpk_, psb_lzspmat_type
|
||||
class(psb_lzspmat_type), intent(inout) :: a
|
||||
integer(psb_ipk_),intent(out) :: info
|
||||
end subroutine psb_lz_clip_d_ip
|
||||
end interface
|
||||
|
||||
|
||||
!
|
||||
! These four interfaces cut through the
|
||||
! encapsulation between spmat_type and base_sparse_mat.
|
||||
|
||||
+117
-117
@@ -3933,123 +3933,123 @@ end subroutine psb_lc_cscnv_base
|
||||
|
||||
|
||||
|
||||
!!$subroutine psb_lc_clip_d(a,b,info)
|
||||
!!$ ! Output is always in COO format
|
||||
!!$ use psb_error_mod
|
||||
!!$ use psb_const_mod
|
||||
!!$ use psb_c_base_mat_mod
|
||||
!!$ use psb_c_mat_mod, psb_protect_name => psb_lc_clip_d
|
||||
!!$ implicit none
|
||||
!!$
|
||||
!!$ class(psb_lcspmat_type), intent(in) :: a
|
||||
!!$ class(psb_lcspmat_type), intent(inout) :: b
|
||||
!!$ integer(psb_ipk_),intent(out) :: info
|
||||
!!$
|
||||
!!$ integer(psb_ipk_) :: err_act
|
||||
!!$ character(len=20) :: name='clip_diag'
|
||||
!!$ logical, parameter :: debug=.false.
|
||||
!!$ type(psb_lc_coo_sparse_mat), allocatable :: acoo
|
||||
!!$ integer(psb_lpk_) :: i, j, nz
|
||||
!!$
|
||||
!!$ info = psb_success_
|
||||
!!$ call psb_erractionsave(err_act)
|
||||
!!$ if (a%is_null()) then
|
||||
!!$ info = psb_err_invalid_mat_state_
|
||||
!!$ call psb_errpush(info,name)
|
||||
!!$ goto 9999
|
||||
!!$ endif
|
||||
!!$
|
||||
!!$ allocate(acoo,stat=info)
|
||||
!!$ if (info == psb_success_) call a%a%cp_to_coo(acoo,info)
|
||||
!!$ if (info /= psb_success_) then
|
||||
!!$ info = psb_err_alloc_dealloc_
|
||||
!!$ call psb_errpush(info,name)
|
||||
!!$ goto 9999
|
||||
!!$ endif
|
||||
!!$
|
||||
!!$ nz = acoo%get_nzeros()
|
||||
!!$ j = 0
|
||||
!!$ do i=1, nz
|
||||
!!$ if (acoo%ia(i) /= acoo%ja(i)) then
|
||||
!!$ j = j + 1
|
||||
!!$ acoo%ia(j) = acoo%ia(i)
|
||||
!!$ acoo%ja(j) = acoo%ja(i)
|
||||
!!$ acoo%val(j) = acoo%val(i)
|
||||
!!$ end if
|
||||
!!$ end do
|
||||
!!$ call acoo%set_nzeros(j)
|
||||
!!$ call acoo%trim()
|
||||
!!$ call b%mv_from(acoo)
|
||||
!!$
|
||||
!!$ call psb_erractionrestore(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$
|
||||
!!$9999 call psb_error_handler(err_act)
|
||||
!!$
|
||||
!!$ return
|
||||
!!$
|
||||
!!$end subroutine psb_lc_clip_d
|
||||
!!$
|
||||
!!$
|
||||
!!$
|
||||
!!$subroutine psb_lc_clip_d_ip(a,info)
|
||||
!!$ ! Output is always in COO format
|
||||
!!$ use psb_error_mod
|
||||
!!$ use psb_const_mod
|
||||
!!$ use psb_c_base_mat_mod
|
||||
!!$ use psb_c_mat_mod, psb_protect_name => psb_lc_clip_d_ip
|
||||
!!$ implicit none
|
||||
!!$
|
||||
!!$ class(psb_lcspmat_type), intent(inout) :: a
|
||||
!!$ integer(psb_ipk_),intent(out) :: info
|
||||
!!$
|
||||
!!$ integer(psb_ipk_) :: err_act
|
||||
!!$ character(len=20) :: name='clip_diag'
|
||||
!!$ logical, parameter :: debug=.false.
|
||||
!!$ type(psb_lc_coo_sparse_mat), allocatable :: acoo
|
||||
!!$ integer(psb_lpk_) :: i, j, nz
|
||||
!!$
|
||||
!!$ info = psb_success_
|
||||
!!$ call psb_erractionsave(err_act)
|
||||
!!$ if (a%is_null()) then
|
||||
!!$ info = psb_err_invalid_mat_state_
|
||||
!!$ call psb_errpush(info,name)
|
||||
!!$ goto 9999
|
||||
!!$ endif
|
||||
!!$
|
||||
!!$ allocate(acoo,stat=info)
|
||||
!!$ if (info == psb_success_) call a%a%mv_to_coo(acoo,info)
|
||||
!!$ if (info /= psb_success_) then
|
||||
!!$ info = psb_err_alloc_dealloc_
|
||||
!!$ call psb_errpush(info,name)
|
||||
!!$ goto 9999
|
||||
!!$ endif
|
||||
!!$
|
||||
!!$ nz = acoo%get_nzeros()
|
||||
!!$ j = 0
|
||||
!!$ do i=1, nz
|
||||
!!$ if (acoo%ia(i) /= acoo%ja(i)) then
|
||||
!!$ j = j + 1
|
||||
!!$ acoo%ia(j) = acoo%ia(i)
|
||||
!!$ acoo%ja(j) = acoo%ja(i)
|
||||
!!$ acoo%val(j) = acoo%val(i)
|
||||
!!$ end if
|
||||
!!$ end do
|
||||
!!$ call acoo%set_nzeros(j)
|
||||
!!$ call acoo%trim()
|
||||
!!$ call a%mv_from(acoo)
|
||||
!!$
|
||||
!!$ call psb_erractionrestore(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$
|
||||
!!$9999 call psb_error_handler(err_act)
|
||||
!!$
|
||||
!!$ return
|
||||
!!$
|
||||
!!$end subroutine psb_lc_clip_d_ip
|
||||
!!$
|
||||
subroutine psb_lc_clip_d(a,b,info)
|
||||
! Output is always in COO format
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
use psb_c_base_mat_mod
|
||||
use psb_c_mat_mod, psb_protect_name => psb_lc_clip_d
|
||||
implicit none
|
||||
|
||||
class(psb_lcspmat_type), intent(in) :: a
|
||||
class(psb_lcspmat_type), intent(inout) :: b
|
||||
integer(psb_ipk_),intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='clip_diag'
|
||||
logical, parameter :: debug=.false.
|
||||
type(psb_lc_coo_sparse_mat), allocatable :: acoo
|
||||
integer(psb_lpk_) :: i, j, nz
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
if (a%is_null()) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
allocate(acoo,stat=info)
|
||||
if (info == psb_success_) call a%a%cp_to_coo(acoo,info)
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_alloc_dealloc_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
nz = acoo%get_nzeros()
|
||||
j = 0
|
||||
do i=1, nz
|
||||
if (acoo%ia(i) /= acoo%ja(i)) then
|
||||
j = j + 1
|
||||
acoo%ia(j) = acoo%ia(i)
|
||||
acoo%ja(j) = acoo%ja(i)
|
||||
acoo%val(j) = acoo%val(i)
|
||||
end if
|
||||
end do
|
||||
call acoo%set_nzeros(j)
|
||||
call acoo%trim()
|
||||
call b%mv_from(acoo)
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
|
||||
end subroutine psb_lc_clip_d
|
||||
|
||||
|
||||
|
||||
subroutine psb_lc_clip_d_ip(a,info)
|
||||
! Output is always in COO format
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
use psb_c_base_mat_mod
|
||||
use psb_c_mat_mod, psb_protect_name => psb_lc_clip_d_ip
|
||||
implicit none
|
||||
|
||||
class(psb_lcspmat_type), intent(inout) :: a
|
||||
integer(psb_ipk_),intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='clip_diag'
|
||||
logical, parameter :: debug=.false.
|
||||
type(psb_lc_coo_sparse_mat), allocatable :: acoo
|
||||
integer(psb_lpk_) :: i, j, nz
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
if (a%is_null()) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
allocate(acoo,stat=info)
|
||||
if (info == psb_success_) call a%a%mv_to_coo(acoo,info)
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_alloc_dealloc_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
nz = acoo%get_nzeros()
|
||||
j = 0
|
||||
do i=1, nz
|
||||
if (acoo%ia(i) /= acoo%ja(i)) then
|
||||
j = j + 1
|
||||
acoo%ia(j) = acoo%ia(i)
|
||||
acoo%ja(j) = acoo%ja(i)
|
||||
acoo%val(j) = acoo%val(i)
|
||||
end if
|
||||
end do
|
||||
call acoo%set_nzeros(j)
|
||||
call acoo%trim()
|
||||
call a%mv_from(acoo)
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
|
||||
end subroutine psb_lc_clip_d_ip
|
||||
|
||||
|
||||
subroutine psb_lc_mv_from(a,b)
|
||||
use psb_error_mod
|
||||
|
||||
+117
-117
@@ -3933,123 +3933,123 @@ end subroutine psb_ld_cscnv_base
|
||||
|
||||
|
||||
|
||||
!!$subroutine psb_ld_clip_d(a,b,info)
|
||||
!!$ ! Output is always in COO format
|
||||
!!$ use psb_error_mod
|
||||
!!$ use psb_const_mod
|
||||
!!$ use psb_d_base_mat_mod
|
||||
!!$ use psb_d_mat_mod, psb_protect_name => psb_ld_clip_d
|
||||
!!$ implicit none
|
||||
!!$
|
||||
!!$ class(psb_ldspmat_type), intent(in) :: a
|
||||
!!$ class(psb_ldspmat_type), intent(inout) :: b
|
||||
!!$ integer(psb_ipk_),intent(out) :: info
|
||||
!!$
|
||||
!!$ integer(psb_ipk_) :: err_act
|
||||
!!$ character(len=20) :: name='clip_diag'
|
||||
!!$ logical, parameter :: debug=.false.
|
||||
!!$ type(psb_ld_coo_sparse_mat), allocatable :: acoo
|
||||
!!$ integer(psb_lpk_) :: i, j, nz
|
||||
!!$
|
||||
!!$ info = psb_success_
|
||||
!!$ call psb_erractionsave(err_act)
|
||||
!!$ if (a%is_null()) then
|
||||
!!$ info = psb_err_invalid_mat_state_
|
||||
!!$ call psb_errpush(info,name)
|
||||
!!$ goto 9999
|
||||
!!$ endif
|
||||
!!$
|
||||
!!$ allocate(acoo,stat=info)
|
||||
!!$ if (info == psb_success_) call a%a%cp_to_coo(acoo,info)
|
||||
!!$ if (info /= psb_success_) then
|
||||
!!$ info = psb_err_alloc_dealloc_
|
||||
!!$ call psb_errpush(info,name)
|
||||
!!$ goto 9999
|
||||
!!$ endif
|
||||
!!$
|
||||
!!$ nz = acoo%get_nzeros()
|
||||
!!$ j = 0
|
||||
!!$ do i=1, nz
|
||||
!!$ if (acoo%ia(i) /= acoo%ja(i)) then
|
||||
!!$ j = j + 1
|
||||
!!$ acoo%ia(j) = acoo%ia(i)
|
||||
!!$ acoo%ja(j) = acoo%ja(i)
|
||||
!!$ acoo%val(j) = acoo%val(i)
|
||||
!!$ end if
|
||||
!!$ end do
|
||||
!!$ call acoo%set_nzeros(j)
|
||||
!!$ call acoo%trim()
|
||||
!!$ call b%mv_from(acoo)
|
||||
!!$
|
||||
!!$ call psb_erractionrestore(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$
|
||||
!!$9999 call psb_error_handler(err_act)
|
||||
!!$
|
||||
!!$ return
|
||||
!!$
|
||||
!!$end subroutine psb_ld_clip_d
|
||||
!!$
|
||||
!!$
|
||||
!!$
|
||||
!!$subroutine psb_ld_clip_d_ip(a,info)
|
||||
!!$ ! Output is always in COO format
|
||||
!!$ use psb_error_mod
|
||||
!!$ use psb_const_mod
|
||||
!!$ use psb_d_base_mat_mod
|
||||
!!$ use psb_d_mat_mod, psb_protect_name => psb_ld_clip_d_ip
|
||||
!!$ implicit none
|
||||
!!$
|
||||
!!$ class(psb_ldspmat_type), intent(inout) :: a
|
||||
!!$ integer(psb_ipk_),intent(out) :: info
|
||||
!!$
|
||||
!!$ integer(psb_ipk_) :: err_act
|
||||
!!$ character(len=20) :: name='clip_diag'
|
||||
!!$ logical, parameter :: debug=.false.
|
||||
!!$ type(psb_ld_coo_sparse_mat), allocatable :: acoo
|
||||
!!$ integer(psb_lpk_) :: i, j, nz
|
||||
!!$
|
||||
!!$ info = psb_success_
|
||||
!!$ call psb_erractionsave(err_act)
|
||||
!!$ if (a%is_null()) then
|
||||
!!$ info = psb_err_invalid_mat_state_
|
||||
!!$ call psb_errpush(info,name)
|
||||
!!$ goto 9999
|
||||
!!$ endif
|
||||
!!$
|
||||
!!$ allocate(acoo,stat=info)
|
||||
!!$ if (info == psb_success_) call a%a%mv_to_coo(acoo,info)
|
||||
!!$ if (info /= psb_success_) then
|
||||
!!$ info = psb_err_alloc_dealloc_
|
||||
!!$ call psb_errpush(info,name)
|
||||
!!$ goto 9999
|
||||
!!$ endif
|
||||
!!$
|
||||
!!$ nz = acoo%get_nzeros()
|
||||
!!$ j = 0
|
||||
!!$ do i=1, nz
|
||||
!!$ if (acoo%ia(i) /= acoo%ja(i)) then
|
||||
!!$ j = j + 1
|
||||
!!$ acoo%ia(j) = acoo%ia(i)
|
||||
!!$ acoo%ja(j) = acoo%ja(i)
|
||||
!!$ acoo%val(j) = acoo%val(i)
|
||||
!!$ end if
|
||||
!!$ end do
|
||||
!!$ call acoo%set_nzeros(j)
|
||||
!!$ call acoo%trim()
|
||||
!!$ call a%mv_from(acoo)
|
||||
!!$
|
||||
!!$ call psb_erractionrestore(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$
|
||||
!!$9999 call psb_error_handler(err_act)
|
||||
!!$
|
||||
!!$ return
|
||||
!!$
|
||||
!!$end subroutine psb_ld_clip_d_ip
|
||||
!!$
|
||||
subroutine psb_ld_clip_d(a,b,info)
|
||||
! Output is always in COO format
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
use psb_d_base_mat_mod
|
||||
use psb_d_mat_mod, psb_protect_name => psb_ld_clip_d
|
||||
implicit none
|
||||
|
||||
class(psb_ldspmat_type), intent(in) :: a
|
||||
class(psb_ldspmat_type), intent(inout) :: b
|
||||
integer(psb_ipk_),intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='clip_diag'
|
||||
logical, parameter :: debug=.false.
|
||||
type(psb_ld_coo_sparse_mat), allocatable :: acoo
|
||||
integer(psb_lpk_) :: i, j, nz
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
if (a%is_null()) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
allocate(acoo,stat=info)
|
||||
if (info == psb_success_) call a%a%cp_to_coo(acoo,info)
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_alloc_dealloc_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
nz = acoo%get_nzeros()
|
||||
j = 0
|
||||
do i=1, nz
|
||||
if (acoo%ia(i) /= acoo%ja(i)) then
|
||||
j = j + 1
|
||||
acoo%ia(j) = acoo%ia(i)
|
||||
acoo%ja(j) = acoo%ja(i)
|
||||
acoo%val(j) = acoo%val(i)
|
||||
end if
|
||||
end do
|
||||
call acoo%set_nzeros(j)
|
||||
call acoo%trim()
|
||||
call b%mv_from(acoo)
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
|
||||
end subroutine psb_ld_clip_d
|
||||
|
||||
|
||||
|
||||
subroutine psb_ld_clip_d_ip(a,info)
|
||||
! Output is always in COO format
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
use psb_d_base_mat_mod
|
||||
use psb_d_mat_mod, psb_protect_name => psb_ld_clip_d_ip
|
||||
implicit none
|
||||
|
||||
class(psb_ldspmat_type), intent(inout) :: a
|
||||
integer(psb_ipk_),intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='clip_diag'
|
||||
logical, parameter :: debug=.false.
|
||||
type(psb_ld_coo_sparse_mat), allocatable :: acoo
|
||||
integer(psb_lpk_) :: i, j, nz
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
if (a%is_null()) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
allocate(acoo,stat=info)
|
||||
if (info == psb_success_) call a%a%mv_to_coo(acoo,info)
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_alloc_dealloc_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
nz = acoo%get_nzeros()
|
||||
j = 0
|
||||
do i=1, nz
|
||||
if (acoo%ia(i) /= acoo%ja(i)) then
|
||||
j = j + 1
|
||||
acoo%ia(j) = acoo%ia(i)
|
||||
acoo%ja(j) = acoo%ja(i)
|
||||
acoo%val(j) = acoo%val(i)
|
||||
end if
|
||||
end do
|
||||
call acoo%set_nzeros(j)
|
||||
call acoo%trim()
|
||||
call a%mv_from(acoo)
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
|
||||
end subroutine psb_ld_clip_d_ip
|
||||
|
||||
|
||||
subroutine psb_ld_mv_from(a,b)
|
||||
use psb_error_mod
|
||||
|
||||
+117
-117
@@ -3933,123 +3933,123 @@ end subroutine psb_ls_cscnv_base
|
||||
|
||||
|
||||
|
||||
!!$subroutine psb_ls_clip_d(a,b,info)
|
||||
!!$ ! Output is always in COO format
|
||||
!!$ use psb_error_mod
|
||||
!!$ use psb_const_mod
|
||||
!!$ use psb_s_base_mat_mod
|
||||
!!$ use psb_s_mat_mod, psb_protect_name => psb_ls_clip_d
|
||||
!!$ implicit none
|
||||
!!$
|
||||
!!$ class(psb_lsspmat_type), intent(in) :: a
|
||||
!!$ class(psb_lsspmat_type), intent(inout) :: b
|
||||
!!$ integer(psb_ipk_),intent(out) :: info
|
||||
!!$
|
||||
!!$ integer(psb_ipk_) :: err_act
|
||||
!!$ character(len=20) :: name='clip_diag'
|
||||
!!$ logical, parameter :: debug=.false.
|
||||
!!$ type(psb_ls_coo_sparse_mat), allocatable :: acoo
|
||||
!!$ integer(psb_lpk_) :: i, j, nz
|
||||
!!$
|
||||
!!$ info = psb_success_
|
||||
!!$ call psb_erractionsave(err_act)
|
||||
!!$ if (a%is_null()) then
|
||||
!!$ info = psb_err_invalid_mat_state_
|
||||
!!$ call psb_errpush(info,name)
|
||||
!!$ goto 9999
|
||||
!!$ endif
|
||||
!!$
|
||||
!!$ allocate(acoo,stat=info)
|
||||
!!$ if (info == psb_success_) call a%a%cp_to_coo(acoo,info)
|
||||
!!$ if (info /= psb_success_) then
|
||||
!!$ info = psb_err_alloc_dealloc_
|
||||
!!$ call psb_errpush(info,name)
|
||||
!!$ goto 9999
|
||||
!!$ endif
|
||||
!!$
|
||||
!!$ nz = acoo%get_nzeros()
|
||||
!!$ j = 0
|
||||
!!$ do i=1, nz
|
||||
!!$ if (acoo%ia(i) /= acoo%ja(i)) then
|
||||
!!$ j = j + 1
|
||||
!!$ acoo%ia(j) = acoo%ia(i)
|
||||
!!$ acoo%ja(j) = acoo%ja(i)
|
||||
!!$ acoo%val(j) = acoo%val(i)
|
||||
!!$ end if
|
||||
!!$ end do
|
||||
!!$ call acoo%set_nzeros(j)
|
||||
!!$ call acoo%trim()
|
||||
!!$ call b%mv_from(acoo)
|
||||
!!$
|
||||
!!$ call psb_erractionrestore(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$
|
||||
!!$9999 call psb_error_handler(err_act)
|
||||
!!$
|
||||
!!$ return
|
||||
!!$
|
||||
!!$end subroutine psb_ls_clip_d
|
||||
!!$
|
||||
!!$
|
||||
!!$
|
||||
!!$subroutine psb_ls_clip_d_ip(a,info)
|
||||
!!$ ! Output is always in COO format
|
||||
!!$ use psb_error_mod
|
||||
!!$ use psb_const_mod
|
||||
!!$ use psb_s_base_mat_mod
|
||||
!!$ use psb_s_mat_mod, psb_protect_name => psb_ls_clip_d_ip
|
||||
!!$ implicit none
|
||||
!!$
|
||||
!!$ class(psb_lsspmat_type), intent(inout) :: a
|
||||
!!$ integer(psb_ipk_),intent(out) :: info
|
||||
!!$
|
||||
!!$ integer(psb_ipk_) :: err_act
|
||||
!!$ character(len=20) :: name='clip_diag'
|
||||
!!$ logical, parameter :: debug=.false.
|
||||
!!$ type(psb_ls_coo_sparse_mat), allocatable :: acoo
|
||||
!!$ integer(psb_lpk_) :: i, j, nz
|
||||
!!$
|
||||
!!$ info = psb_success_
|
||||
!!$ call psb_erractionsave(err_act)
|
||||
!!$ if (a%is_null()) then
|
||||
!!$ info = psb_err_invalid_mat_state_
|
||||
!!$ call psb_errpush(info,name)
|
||||
!!$ goto 9999
|
||||
!!$ endif
|
||||
!!$
|
||||
!!$ allocate(acoo,stat=info)
|
||||
!!$ if (info == psb_success_) call a%a%mv_to_coo(acoo,info)
|
||||
!!$ if (info /= psb_success_) then
|
||||
!!$ info = psb_err_alloc_dealloc_
|
||||
!!$ call psb_errpush(info,name)
|
||||
!!$ goto 9999
|
||||
!!$ endif
|
||||
!!$
|
||||
!!$ nz = acoo%get_nzeros()
|
||||
!!$ j = 0
|
||||
!!$ do i=1, nz
|
||||
!!$ if (acoo%ia(i) /= acoo%ja(i)) then
|
||||
!!$ j = j + 1
|
||||
!!$ acoo%ia(j) = acoo%ia(i)
|
||||
!!$ acoo%ja(j) = acoo%ja(i)
|
||||
!!$ acoo%val(j) = acoo%val(i)
|
||||
!!$ end if
|
||||
!!$ end do
|
||||
!!$ call acoo%set_nzeros(j)
|
||||
!!$ call acoo%trim()
|
||||
!!$ call a%mv_from(acoo)
|
||||
!!$
|
||||
!!$ call psb_erractionrestore(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$
|
||||
!!$9999 call psb_error_handler(err_act)
|
||||
!!$
|
||||
!!$ return
|
||||
!!$
|
||||
!!$end subroutine psb_ls_clip_d_ip
|
||||
!!$
|
||||
subroutine psb_ls_clip_d(a,b,info)
|
||||
! Output is always in COO format
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
use psb_s_base_mat_mod
|
||||
use psb_s_mat_mod, psb_protect_name => psb_ls_clip_d
|
||||
implicit none
|
||||
|
||||
class(psb_lsspmat_type), intent(in) :: a
|
||||
class(psb_lsspmat_type), intent(inout) :: b
|
||||
integer(psb_ipk_),intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='clip_diag'
|
||||
logical, parameter :: debug=.false.
|
||||
type(psb_ls_coo_sparse_mat), allocatable :: acoo
|
||||
integer(psb_lpk_) :: i, j, nz
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
if (a%is_null()) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
allocate(acoo,stat=info)
|
||||
if (info == psb_success_) call a%a%cp_to_coo(acoo,info)
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_alloc_dealloc_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
nz = acoo%get_nzeros()
|
||||
j = 0
|
||||
do i=1, nz
|
||||
if (acoo%ia(i) /= acoo%ja(i)) then
|
||||
j = j + 1
|
||||
acoo%ia(j) = acoo%ia(i)
|
||||
acoo%ja(j) = acoo%ja(i)
|
||||
acoo%val(j) = acoo%val(i)
|
||||
end if
|
||||
end do
|
||||
call acoo%set_nzeros(j)
|
||||
call acoo%trim()
|
||||
call b%mv_from(acoo)
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
|
||||
end subroutine psb_ls_clip_d
|
||||
|
||||
|
||||
|
||||
subroutine psb_ls_clip_d_ip(a,info)
|
||||
! Output is always in COO format
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
use psb_s_base_mat_mod
|
||||
use psb_s_mat_mod, psb_protect_name => psb_ls_clip_d_ip
|
||||
implicit none
|
||||
|
||||
class(psb_lsspmat_type), intent(inout) :: a
|
||||
integer(psb_ipk_),intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='clip_diag'
|
||||
logical, parameter :: debug=.false.
|
||||
type(psb_ls_coo_sparse_mat), allocatable :: acoo
|
||||
integer(psb_lpk_) :: i, j, nz
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
if (a%is_null()) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
allocate(acoo,stat=info)
|
||||
if (info == psb_success_) call a%a%mv_to_coo(acoo,info)
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_alloc_dealloc_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
nz = acoo%get_nzeros()
|
||||
j = 0
|
||||
do i=1, nz
|
||||
if (acoo%ia(i) /= acoo%ja(i)) then
|
||||
j = j + 1
|
||||
acoo%ia(j) = acoo%ia(i)
|
||||
acoo%ja(j) = acoo%ja(i)
|
||||
acoo%val(j) = acoo%val(i)
|
||||
end if
|
||||
end do
|
||||
call acoo%set_nzeros(j)
|
||||
call acoo%trim()
|
||||
call a%mv_from(acoo)
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
|
||||
end subroutine psb_ls_clip_d_ip
|
||||
|
||||
|
||||
subroutine psb_ls_mv_from(a,b)
|
||||
use psb_error_mod
|
||||
|
||||
+117
-117
@@ -3933,123 +3933,123 @@ end subroutine psb_lz_cscnv_base
|
||||
|
||||
|
||||
|
||||
!!$subroutine psb_lz_clip_d(a,b,info)
|
||||
!!$ ! Output is always in COO format
|
||||
!!$ use psb_error_mod
|
||||
!!$ use psb_const_mod
|
||||
!!$ use psb_z_base_mat_mod
|
||||
!!$ use psb_z_mat_mod, psb_protect_name => psb_lz_clip_d
|
||||
!!$ implicit none
|
||||
!!$
|
||||
!!$ class(psb_lzspmat_type), intent(in) :: a
|
||||
!!$ class(psb_lzspmat_type), intent(inout) :: b
|
||||
!!$ integer(psb_ipk_),intent(out) :: info
|
||||
!!$
|
||||
!!$ integer(psb_ipk_) :: err_act
|
||||
!!$ character(len=20) :: name='clip_diag'
|
||||
!!$ logical, parameter :: debug=.false.
|
||||
!!$ type(psb_lz_coo_sparse_mat), allocatable :: acoo
|
||||
!!$ integer(psb_lpk_) :: i, j, nz
|
||||
!!$
|
||||
!!$ info = psb_success_
|
||||
!!$ call psb_erractionsave(err_act)
|
||||
!!$ if (a%is_null()) then
|
||||
!!$ info = psb_err_invalid_mat_state_
|
||||
!!$ call psb_errpush(info,name)
|
||||
!!$ goto 9999
|
||||
!!$ endif
|
||||
!!$
|
||||
!!$ allocate(acoo,stat=info)
|
||||
!!$ if (info == psb_success_) call a%a%cp_to_coo(acoo,info)
|
||||
!!$ if (info /= psb_success_) then
|
||||
!!$ info = psb_err_alloc_dealloc_
|
||||
!!$ call psb_errpush(info,name)
|
||||
!!$ goto 9999
|
||||
!!$ endif
|
||||
!!$
|
||||
!!$ nz = acoo%get_nzeros()
|
||||
!!$ j = 0
|
||||
!!$ do i=1, nz
|
||||
!!$ if (acoo%ia(i) /= acoo%ja(i)) then
|
||||
!!$ j = j + 1
|
||||
!!$ acoo%ia(j) = acoo%ia(i)
|
||||
!!$ acoo%ja(j) = acoo%ja(i)
|
||||
!!$ acoo%val(j) = acoo%val(i)
|
||||
!!$ end if
|
||||
!!$ end do
|
||||
!!$ call acoo%set_nzeros(j)
|
||||
!!$ call acoo%trim()
|
||||
!!$ call b%mv_from(acoo)
|
||||
!!$
|
||||
!!$ call psb_erractionrestore(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$
|
||||
!!$9999 call psb_error_handler(err_act)
|
||||
!!$
|
||||
!!$ return
|
||||
!!$
|
||||
!!$end subroutine psb_lz_clip_d
|
||||
!!$
|
||||
!!$
|
||||
!!$
|
||||
!!$subroutine psb_lz_clip_d_ip(a,info)
|
||||
!!$ ! Output is always in COO format
|
||||
!!$ use psb_error_mod
|
||||
!!$ use psb_const_mod
|
||||
!!$ use psb_z_base_mat_mod
|
||||
!!$ use psb_z_mat_mod, psb_protect_name => psb_lz_clip_d_ip
|
||||
!!$ implicit none
|
||||
!!$
|
||||
!!$ class(psb_lzspmat_type), intent(inout) :: a
|
||||
!!$ integer(psb_ipk_),intent(out) :: info
|
||||
!!$
|
||||
!!$ integer(psb_ipk_) :: err_act
|
||||
!!$ character(len=20) :: name='clip_diag'
|
||||
!!$ logical, parameter :: debug=.false.
|
||||
!!$ type(psb_lz_coo_sparse_mat), allocatable :: acoo
|
||||
!!$ integer(psb_lpk_) :: i, j, nz
|
||||
!!$
|
||||
!!$ info = psb_success_
|
||||
!!$ call psb_erractionsave(err_act)
|
||||
!!$ if (a%is_null()) then
|
||||
!!$ info = psb_err_invalid_mat_state_
|
||||
!!$ call psb_errpush(info,name)
|
||||
!!$ goto 9999
|
||||
!!$ endif
|
||||
!!$
|
||||
!!$ allocate(acoo,stat=info)
|
||||
!!$ if (info == psb_success_) call a%a%mv_to_coo(acoo,info)
|
||||
!!$ if (info /= psb_success_) then
|
||||
!!$ info = psb_err_alloc_dealloc_
|
||||
!!$ call psb_errpush(info,name)
|
||||
!!$ goto 9999
|
||||
!!$ endif
|
||||
!!$
|
||||
!!$ nz = acoo%get_nzeros()
|
||||
!!$ j = 0
|
||||
!!$ do i=1, nz
|
||||
!!$ if (acoo%ia(i) /= acoo%ja(i)) then
|
||||
!!$ j = j + 1
|
||||
!!$ acoo%ia(j) = acoo%ia(i)
|
||||
!!$ acoo%ja(j) = acoo%ja(i)
|
||||
!!$ acoo%val(j) = acoo%val(i)
|
||||
!!$ end if
|
||||
!!$ end do
|
||||
!!$ call acoo%set_nzeros(j)
|
||||
!!$ call acoo%trim()
|
||||
!!$ call a%mv_from(acoo)
|
||||
!!$
|
||||
!!$ call psb_erractionrestore(err_act)
|
||||
!!$ return
|
||||
!!$
|
||||
!!$
|
||||
!!$9999 call psb_error_handler(err_act)
|
||||
!!$
|
||||
!!$ return
|
||||
!!$
|
||||
!!$end subroutine psb_lz_clip_d_ip
|
||||
!!$
|
||||
subroutine psb_lz_clip_d(a,b,info)
|
||||
! Output is always in COO format
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
use psb_z_base_mat_mod
|
||||
use psb_z_mat_mod, psb_protect_name => psb_lz_clip_d
|
||||
implicit none
|
||||
|
||||
class(psb_lzspmat_type), intent(in) :: a
|
||||
class(psb_lzspmat_type), intent(inout) :: b
|
||||
integer(psb_ipk_),intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='clip_diag'
|
||||
logical, parameter :: debug=.false.
|
||||
type(psb_lz_coo_sparse_mat), allocatable :: acoo
|
||||
integer(psb_lpk_) :: i, j, nz
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
if (a%is_null()) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
allocate(acoo,stat=info)
|
||||
if (info == psb_success_) call a%a%cp_to_coo(acoo,info)
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_alloc_dealloc_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
nz = acoo%get_nzeros()
|
||||
j = 0
|
||||
do i=1, nz
|
||||
if (acoo%ia(i) /= acoo%ja(i)) then
|
||||
j = j + 1
|
||||
acoo%ia(j) = acoo%ia(i)
|
||||
acoo%ja(j) = acoo%ja(i)
|
||||
acoo%val(j) = acoo%val(i)
|
||||
end if
|
||||
end do
|
||||
call acoo%set_nzeros(j)
|
||||
call acoo%trim()
|
||||
call b%mv_from(acoo)
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
|
||||
end subroutine psb_lz_clip_d
|
||||
|
||||
|
||||
|
||||
subroutine psb_lz_clip_d_ip(a,info)
|
||||
! Output is always in COO format
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
use psb_z_base_mat_mod
|
||||
use psb_z_mat_mod, psb_protect_name => psb_lz_clip_d_ip
|
||||
implicit none
|
||||
|
||||
class(psb_lzspmat_type), intent(inout) :: a
|
||||
integer(psb_ipk_),intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: err_act
|
||||
character(len=20) :: name='clip_diag'
|
||||
logical, parameter :: debug=.false.
|
||||
type(psb_lz_coo_sparse_mat), allocatable :: acoo
|
||||
integer(psb_lpk_) :: i, j, nz
|
||||
|
||||
info = psb_success_
|
||||
call psb_erractionsave(err_act)
|
||||
if (a%is_null()) then
|
||||
info = psb_err_invalid_mat_state_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
allocate(acoo,stat=info)
|
||||
if (info == psb_success_) call a%a%mv_to_coo(acoo,info)
|
||||
if (info /= psb_success_) then
|
||||
info = psb_err_alloc_dealloc_
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
nz = acoo%get_nzeros()
|
||||
j = 0
|
||||
do i=1, nz
|
||||
if (acoo%ia(i) /= acoo%ja(i)) then
|
||||
j = j + 1
|
||||
acoo%ia(j) = acoo%ia(i)
|
||||
acoo%ja(j) = acoo%ja(i)
|
||||
acoo%val(j) = acoo%val(i)
|
||||
end if
|
||||
end do
|
||||
call acoo%set_nzeros(j)
|
||||
call acoo%trim()
|
||||
call a%mv_from(acoo)
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
|
||||
9999 call psb_error_handler(err_act)
|
||||
|
||||
return
|
||||
|
||||
end subroutine psb_lz_clip_d_ip
|
||||
|
||||
|
||||
subroutine psb_lz_mv_from(a,b)
|
||||
use psb_error_mod
|
||||
|
||||
Reference in New Issue
Block a user