mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-24 14:51:49 +00:00
psblas3:
Changelog base/modules/psb_i_base_vect_mod.f90 base/modules/psb_i_tools_mod.f90 base/modules/psb_i_vect_mod.F90 base/modules/psb_s_tools_mod.f90 base/tools/Makefile base/tools/psb_cd_inloc.f90 base/tools/psb_cd_lstext.f90 base/tools/psb_cd_reinit.f90 base/tools/psb_cd_set_bld.f90 base/tools/psb_cd_switch_ovl_indxmap.f90 base/tools/psb_cdall.f90 base/tools/psb_cdals.f90 base/tools/psb_cdalv.f90 base/tools/psb_cdcpy.F90 base/tools/psb_cdins.f90 base/tools/psb_cdren.f90 base/tools/psb_cdrep.f90 base/tools/psb_csprn.f90 base/tools/psb_dsprn.f90 base/tools/psb_get_overlap.f90 base/tools/psb_glob_to_loc.f90 base/tools/psb_ialloc.f90 base/tools/psb_iasb.f90 base/tools/psb_icdasb.F90 base/tools/psb_ifree.f90 base/tools/psb_iins.f90 base/tools/psb_loc_to_glob.f90 base/tools/psb_ssprn.f90 base/tools/psb_zsprn.f90 New error handling
This commit is contained in:
@@ -75,7 +75,9 @@ module psb_i_base_vect_mod
|
||||
! Assembly does almost nothing here, but is important
|
||||
! in derived classes.
|
||||
!
|
||||
procedure, pass(x) :: ins => i_base_ins
|
||||
procedure, pass(x) :: ins_a => i_base_ins_a
|
||||
procedure, pass(x) :: ins_v => i_base_ins_v
|
||||
generic, public :: ins => ins_a, ins_v
|
||||
procedure, pass(x) :: zero => i_base_zero
|
||||
procedure, pass(x) :: asb => i_base_asb
|
||||
procedure, pass(x) :: free => i_base_free
|
||||
@@ -295,7 +297,7 @@ contains
|
||||
!! \param info return code
|
||||
!!
|
||||
!
|
||||
subroutine i_base_ins(n,irl,val,dupl,x,info)
|
||||
subroutine i_base_ins_a(n,irl,val,dupl,x,info)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_i_base_vect_type), intent(inout) :: x
|
||||
@@ -346,12 +348,41 @@ contains
|
||||
! !$ goto 9999
|
||||
end select
|
||||
end if
|
||||
call x%set_host()
|
||||
if (info /= 0) then
|
||||
call psb_errpush(info,'base_vect_ins')
|
||||
return
|
||||
end if
|
||||
|
||||
end subroutine i_base_ins
|
||||
end subroutine i_base_ins_a
|
||||
|
||||
|
||||
subroutine i_base_ins_v(n,irl,val,dupl,x,info)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_i_base_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: n, dupl
|
||||
class(psb_i_base_vect_type), intent(inout) :: irl
|
||||
class(psb_i_base_vect_type), intent(inout) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: i, isz
|
||||
|
||||
info = 0
|
||||
if (psb_errstatus_fatal()) return
|
||||
|
||||
if (irl%is_dev()) call irl%sync()
|
||||
if (val%is_dev()) call val%sync()
|
||||
if (x%is_dev()) call x%sync()
|
||||
call x%ins(n,irl%v,val%v,dupl,info)
|
||||
|
||||
if (info /= 0) then
|
||||
call psb_errpush(info,'base_vect_ins')
|
||||
return
|
||||
end if
|
||||
|
||||
end subroutine i_base_ins_v
|
||||
|
||||
|
||||
!
|
||||
!> Function base_zero
|
||||
|
||||
@@ -57,6 +57,14 @@ module psb_i_tools_mod
|
||||
integer(psb_ipk_),intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: n
|
||||
end subroutine psb_ialloc_vect
|
||||
subroutine psb_ialloc_vect_r2(x, desc_a,info,n,lb)
|
||||
import :: psb_desc_type, psb_ipk_, &
|
||||
& psb_i_base_vect_type, psb_i_vect_type
|
||||
type(psb_i_vect_type), allocatable, intent(out) :: x(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer(psb_ipk_),intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: n, lb
|
||||
end subroutine psb_ialloc_vect_r2
|
||||
end interface
|
||||
|
||||
|
||||
@@ -82,6 +90,15 @@ module psb_i_tools_mod
|
||||
class(psb_i_base_vect_type), intent(in), optional :: mold
|
||||
logical, intent(in), optional :: scratch
|
||||
end subroutine psb_iasb_vect
|
||||
subroutine psb_iasb_vect_r2(x, desc_a, info,mold, scratch)
|
||||
import :: psb_desc_type, psb_ipk_, &
|
||||
& psb_i_base_vect_type, psb_i_vect_type
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_i_vect_type), intent(inout) :: x(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
class(psb_i_base_vect_type), intent(in), optional :: mold
|
||||
logical, intent(in), optional :: scratch
|
||||
end subroutine psb_iasb_vect_r2
|
||||
end interface
|
||||
|
||||
|
||||
@@ -105,6 +122,13 @@ module psb_i_tools_mod
|
||||
type(psb_i_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_ifree_vect
|
||||
subroutine psb_ifree_vect_r2(x, desc_a, info)
|
||||
import :: psb_desc_type, psb_ipk_, &
|
||||
& psb_i_base_vect_type, psb_i_vect_type
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_i_vect_type), allocatable, intent(inout) :: x(:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
end subroutine psb_ifree_vect_r2
|
||||
end interface
|
||||
|
||||
interface psb_geins
|
||||
@@ -142,6 +166,30 @@ module psb_i_tools_mod
|
||||
integer(psb_ipk_), optional, intent(in) :: dupl
|
||||
logical, intent(in), optional :: local
|
||||
end subroutine psb_iins_vect
|
||||
subroutine psb_iins_vect_v(m,irw,val,x,desc_a,info,dupl,local)
|
||||
import :: psb_desc_type, psb_ipk_, &
|
||||
& psb_i_base_vect_type, psb_i_vect_type
|
||||
integer(psb_ipk_), intent(in) :: m
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_i_vect_type), intent(inout) :: x
|
||||
type(psb_i_vect_type), intent(inout) :: irw
|
||||
type(psb_i_vect_type), intent(inout) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: dupl
|
||||
logical, intent(in), optional :: local
|
||||
end subroutine psb_iins_vect_v
|
||||
subroutine psb_iins_vect_r2(m,irw,val,x,desc_a,info,dupl,local)
|
||||
import :: psb_desc_type, psb_ipk_, &
|
||||
& psb_i_base_vect_type, psb_i_vect_type
|
||||
integer(psb_ipk_), intent(in) :: m
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
type(psb_i_vect_type), intent(inout) :: x(:)
|
||||
integer(psb_ipk_), intent(in) :: irw(:)
|
||||
integer(psb_ipk_), intent(in) :: val(:,:)
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_), optional, intent(in) :: dupl
|
||||
logical, intent(in), optional :: local
|
||||
end subroutine psb_iins_vect_r2
|
||||
end interface
|
||||
|
||||
|
||||
|
||||
@@ -76,7 +76,9 @@ module psb_i_vect_mod
|
||||
procedure, pass(y) :: sctb => i_vect_sctb
|
||||
generic, public :: sct => sctb
|
||||
procedure, pass(x) :: free => i_vect_free
|
||||
procedure, pass(x) :: ins => i_vect_ins
|
||||
procedure, pass(x) :: ins_a => i_vect_ins_a
|
||||
procedure, pass(x) :: ins_v => i_vect_ins_v
|
||||
generic, public :: ins => ins_v, ins_a
|
||||
procedure, pass(x) :: bld_x => i_vect_bld_x
|
||||
procedure, pass(x) :: bld_n => i_vect_bld_n
|
||||
generic, public :: bld => bld_x, bld_n
|
||||
@@ -609,7 +611,7 @@ contains
|
||||
|
||||
end subroutine i_vect_free
|
||||
|
||||
subroutine i_vect_ins(n,irl,val,dupl,x,info)
|
||||
subroutine i_vect_ins_a(n,irl,val,dupl,x,info)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_i_vect_type), intent(inout) :: x
|
||||
@@ -628,8 +630,28 @@ contains
|
||||
|
||||
call x%v%ins(n,irl,val,dupl,info)
|
||||
|
||||
end subroutine i_vect_ins
|
||||
end subroutine i_vect_ins_a
|
||||
|
||||
subroutine i_vect_ins_v(n,irl,val,dupl,x,info)
|
||||
use psi_serial_mod
|
||||
implicit none
|
||||
class(psb_i_vect_type), intent(inout) :: x
|
||||
integer(psb_ipk_), intent(in) :: n, dupl
|
||||
class(psb_i_vect_type), intent(inout) :: irl
|
||||
class(psb_i_vect_type), intent(inout) :: val
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
info = 0
|
||||
if (.not.(allocated(x%v).and.allocated(irl%v).and.allocated(val%v))) then
|
||||
info = psb_err_invalid_vect_state_
|
||||
return
|
||||
end if
|
||||
|
||||
call x%v%ins(n,irl%v,val%v,dupl,info)
|
||||
|
||||
end subroutine i_vect_ins_v
|
||||
|
||||
subroutine i_vect_cnv(x,mold)
|
||||
class(psb_i_vect_type), intent(inout) :: x
|
||||
|
||||
@@ -22,7 +22,7 @@
|
||||
!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
|
||||
!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
|
||||
!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
|
||||
!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
|
||||
!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSIESS
|
||||
!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
|
||||
!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
|
||||
!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
|
||||
|
||||
Reference in New Issue
Block a user