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:
Salvatore Filippone
2014-12-21 11:56:07 +00:00
parent d4406cc6cf
commit b8ed1439d0
30 changed files with 806 additions and 858 deletions
+34 -3
View File
@@ -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
+48
View File
@@ -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
+25 -3
View File
@@ -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
+1 -1
View File
@@ -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