mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-19 20:32:12 +00:00
Aligned to new names for internal constants.
Fixed ext field of descriptors. First version; to be further fixed storing force_hv into the descriptor itself.
This commit is contained in:
Salvatore Filippone
@@ -18,7 +18,7 @@ INCDIRS = -I .
|
||||
|
||||
|
||||
psb_realloc_mod.o : psb_error_mod.o
|
||||
psb_spmat_type.o : psb_realloc_mod.o psb_const_mod.o psb_string_mod.o
|
||||
psb_spmat_type.o : psb_realloc_mod.o psb_error_mod.o psb_const_mod.o psb_string_mod.o
|
||||
psb_error_mod.o: psb_const_mod.o
|
||||
psb_penv_mod.o: psb_const_mod.o psb_error_mod.o
|
||||
psi_mod.o: psb_penv_mod.o psb_error_mod.o psb_desc_type.o
|
||||
@@ -34,6 +34,7 @@ lib: mpfobjs $(MODULES) $(OBJS)
|
||||
$(AR) $(LIBDIR)/$(LIBNAME) $(MODULES) $(OBJS) $(MPFOBJS)
|
||||
$(RANLIB) $(LIBDIR)/$(LIBNAME)
|
||||
/bin/cp -p $(LIBMOD) ./parts.fh $(LIBDIR)
|
||||
/bin/cp -p *$(.mod) $(LIBDIR)
|
||||
|
||||
|
||||
mpfobjs:
|
||||
|
||||
@@ -164,7 +164,7 @@ contains
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
if (err_act == act_abort) then
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
@@ -284,7 +284,7 @@ contains
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
if (err_act == act_abort) then
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
@@ -425,7 +425,7 @@ contains
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
if (err_act == act_abort) then
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
|
||||
@@ -66,24 +66,24 @@ module psb_comm_mod
|
||||
end interface
|
||||
|
||||
interface psb_halo
|
||||
subroutine psb_dhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
|
||||
subroutine psb_dhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
|
||||
use psb_descriptor_type
|
||||
real(kind(1.d0)), intent(inout) :: x(:,:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer, intent(out) :: info
|
||||
real(kind(1.d0)), intent(in), optional :: alpha
|
||||
real(kind(1.d0)), target, optional :: work(:)
|
||||
integer, intent(in), optional :: mode,jx,ik
|
||||
integer, intent(in), optional :: mode,jx,ik,data
|
||||
character, intent(in), optional :: tran
|
||||
end subroutine psb_dhalom
|
||||
subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode)
|
||||
subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode,data)
|
||||
use psb_descriptor_type
|
||||
real(kind(1.d0)), intent(inout) :: x(:)
|
||||
type(psb_desc_type), intent(in) :: desc_a
|
||||
integer, intent(out) :: info
|
||||
real(kind(1.d0)), intent(in), optional :: alpha
|
||||
real(kind(1.d0)), target, optional :: work(:)
|
||||
integer, intent(in), optional :: mode
|
||||
integer, intent(in), optional :: mode,data
|
||||
character, intent(in), optional :: tran
|
||||
end subroutine psb_dhalov
|
||||
subroutine psb_ihalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
|
||||
|
||||
@@ -30,106 +30,6 @@
|
||||
!!$
|
||||
|
||||
module psb_const_mod
|
||||
|
||||
!
|
||||
! Communication, prolongation & restriction
|
||||
!
|
||||
integer, parameter :: psb_nohalo_=0, psb_halo_=4
|
||||
integer, parameter :: psb_none_=0, psb_sum_=1
|
||||
integer, parameter :: psb_avg_=2, psb_square_root_=3
|
||||
integer, parameter :: psb_swap_send_=1, psb_swap_recv_=2
|
||||
integer, parameter :: psb_swap_sync_=4, psb_swap_mpi_=8
|
||||
|
||||
!
|
||||
! Data checks
|
||||
!
|
||||
integer, parameter :: psb_deadlock_check_=0
|
||||
integer, parameter :: psb_local_mtrx_check_=1
|
||||
integer, parameter :: psb_local_comm_check_=2
|
||||
integer, parameter :: psb_consistency_check_=3
|
||||
integer, parameter :: psb_global_check_=4
|
||||
integer, parameter :: psb_order_communication_=5
|
||||
integer, parameter :: psb_change_represent_=6
|
||||
integer, parameter :: psb_loc_to_glob_check_=7
|
||||
integer, parameter :: psb_convert_halo_=1, psb_convert_ovrlap_=2
|
||||
integer, parameter :: psb_act_ret_=0, psb_act_abort_=1, no_err_=0
|
||||
!
|
||||
! Entries and values in desc%matrix_data
|
||||
!
|
||||
integer, parameter :: psb_dec_type_=1, psb_m_=2,psb_n_=3
|
||||
integer, parameter :: psb_n_row_=4, psb_n_col_=5,psb_ctxt_=6
|
||||
integer, parameter :: psb_desc_size_=7
|
||||
integer, parameter :: psb_ovl_state_=8
|
||||
integer, parameter :: psb_mpi_c_=9
|
||||
integer, parameter :: psb_thal_xch_=11
|
||||
integer, parameter :: psb_thal_snd_=12
|
||||
integer, parameter :: psb_thal_rcv_=13
|
||||
integer, parameter :: psb_tovr_xch_=14
|
||||
integer, parameter :: psb_tovr_snd_=15
|
||||
integer, parameter :: psb_tovr_rcv_=16
|
||||
integer, parameter :: psb_mdata_size_=20
|
||||
integer, parameter :: psb_desc_asb_=3099
|
||||
integer, parameter :: psb_desc_bld_=psb_desc_asb_+1
|
||||
integer, parameter :: psb_desc_repl_=3199
|
||||
integer, parameter :: psb_desc_upd_=psb_desc_bld_+1
|
||||
integer, parameter :: psb_desc_normal_=3299
|
||||
integer, parameter :: psb_desc_large_=psb_desc_normal_+1
|
||||
integer, parameter :: psb_cd_ovl_bld_=3399
|
||||
integer, parameter :: psb_cd_ovl_asb_=psb_cd_ovl_bld_+1
|
||||
integer, parameter :: nbits=14
|
||||
integer, parameter :: hashsize=2**nbits, hashmask=hashsize-1
|
||||
integer, parameter :: psb_default_large_threshold=4*1024*1024 ! to be reviewed
|
||||
integer, parameter :: psb_hpnt_nentries_=7
|
||||
|
||||
!
|
||||
! Constants for desc_a handling
|
||||
!
|
||||
|
||||
integer, parameter :: psb_upd_glbnum_=998
|
||||
integer, parameter :: psb_upd_locnum_=997
|
||||
integer, parameter :: psb_proc_id_=0, psb_n_elem_recv_=1
|
||||
integer, parameter :: psb_elem_recv_=2, psb_n_elem_send_=2
|
||||
integer, parameter :: psb_elem_send_=3, psb_n_ovrlp_elem_=1
|
||||
integer, parameter :: psb_ovrlp_elem_to_=2, psb_ovrlp_elem_=0
|
||||
integer, parameter :: psb_n_dom_ovr_=1
|
||||
integer, parameter :: psb_no_comm_=-1
|
||||
integer, parameter :: psb_comm_halo_=0, psb_comm_ovr_=1
|
||||
|
||||
!
|
||||
! Queries into spmat%info
|
||||
!
|
||||
integer, parameter :: psb_nztotreq_=1, psb_nzrowreq_=2
|
||||
integer, parameter :: psb_nzsizereq_=3
|
||||
!
|
||||
! Entries and values for spmat%info
|
||||
!
|
||||
|
||||
integer, parameter :: psb_nnz_=1
|
||||
integer, parameter :: psb_del_bnd_=7, psb_srtd_=8
|
||||
integer, parameter :: psb_state_=9
|
||||
integer, parameter :: psb_upd_pnt_=10
|
||||
integer, parameter :: psb_dupl_=11, psb_upd_=12
|
||||
integer, parameter :: psb_ifasize_=16
|
||||
integer, parameter :: psb_spmat_null_=0, psb_spmat_bld_=1
|
||||
integer, parameter :: psb_spmat_asb_=2, psb_spmat_upd_=4
|
||||
integer, parameter :: psb_ireg_flgs_=10, psb_ip2_=0
|
||||
integer, parameter :: psb_iflag_=2, psb_ichk_=3
|
||||
integer, parameter :: psb_nnzt_=4, psb_zero_=5,psb_ipc_=6
|
||||
integer, parameter :: psb_dupl_ovwrt_ = 0
|
||||
integer, parameter :: psb_dupl_add_ = 1
|
||||
integer, parameter :: psb_dupl_err_ = 2
|
||||
integer, parameter :: psb_dupl_def_ = psb_dupl_ovwrt_
|
||||
integer, parameter :: psb_upd_dflt_ = 0
|
||||
integer, parameter :: psb_upd_srch_ = 98764
|
||||
integer, parameter :: psb_upd_perm_ = 98765
|
||||
integer, parameter :: psb_isrtdcoo_ = 98761
|
||||
integer, parameter :: psb_maxjdrows_=8, psb_minjdrows_=4
|
||||
integer, parameter :: psb_dbleint_=2
|
||||
!
|
||||
! Error handling
|
||||
!
|
||||
integer, parameter :: act_ret=0, act_abort=1, no_err=0
|
||||
|
||||
!
|
||||
! Handy & miscellaneous constants
|
||||
!
|
||||
@@ -142,6 +42,5 @@ module psb_const_mod
|
||||
real(kind(1.d0)), parameter :: epstol=1.d-32
|
||||
|
||||
character, parameter :: psb_all_='A', psb_topdef_=' '
|
||||
character(len=5) :: psb_fidef_='CSR'
|
||||
|
||||
end module psb_const_mod
|
||||
|
||||
@@ -38,14 +38,71 @@
|
||||
|
||||
module psb_descriptor_type
|
||||
use psb_const_mod
|
||||
|
||||
implicit none
|
||||
|
||||
!
|
||||
! Communication, prolongation & restriction
|
||||
!
|
||||
integer, parameter :: psb_nohalo_=0, psb_halo_=4
|
||||
integer, parameter :: psb_none_=0, psb_sum_=1
|
||||
integer, parameter :: psb_avg_=2, psb_square_root_=3
|
||||
integer, parameter :: psb_swap_send_=1, psb_swap_recv_=2
|
||||
integer, parameter :: psb_swap_sync_=4, psb_swap_mpi_=8
|
||||
|
||||
integer, parameter :: psb_no_comm_=-1
|
||||
integer, parameter :: psb_comm_halo_=0, psb_comm_ovr_=1, psb_comm_ext_=2
|
||||
integer, parameter :: psb_ovt_xhal_ = 123, psb_ovt_asov_=psb_ovt_xhal_+1
|
||||
|
||||
!
|
||||
! Entries and values in desc%matrix_data
|
||||
!
|
||||
integer, parameter :: psb_dec_type_=1, psb_m_=2,psb_n_=3
|
||||
integer, parameter :: psb_n_row_=4, psb_n_col_=5,psb_ctxt_=6
|
||||
integer, parameter :: psb_desc_size_=7
|
||||
integer, parameter :: psb_mpi_c_=9
|
||||
integer, parameter :: psb_thal_xch_=11
|
||||
integer, parameter :: psb_thal_snd_=12
|
||||
integer, parameter :: psb_thal_rcv_=13
|
||||
integer, parameter :: psb_tovr_xch_=14
|
||||
integer, parameter :: psb_tovr_snd_=15
|
||||
integer, parameter :: psb_tovr_rcv_=16
|
||||
integer, parameter :: psb_text_xch_=17
|
||||
integer, parameter :: psb_text_snd_=18
|
||||
integer, parameter :: psb_text_rcv_=19
|
||||
integer, parameter :: psb_mdata_size_=20
|
||||
integer, parameter :: psb_desc_asb_=3099
|
||||
integer, parameter :: psb_desc_bld_=psb_desc_asb_+1
|
||||
integer, parameter :: psb_desc_repl_=3199
|
||||
integer, parameter :: psb_desc_upd_=psb_desc_bld_+1
|
||||
integer, parameter :: psb_desc_normal_=3299
|
||||
integer, parameter :: psb_desc_large_=psb_desc_normal_+1
|
||||
integer, parameter :: psb_cd_ovl_bld_=3399
|
||||
integer, parameter :: psb_cd_ovl_asb_=psb_cd_ovl_bld_+1
|
||||
integer, parameter :: nbits=14
|
||||
integer, parameter :: hashsize=2**nbits, hashmask=hashsize-1
|
||||
integer, parameter :: psb_default_large_threshold=4*1024*1024 ! to be reviewed
|
||||
integer, parameter :: psb_hpnt_nentries_=7
|
||||
|
||||
!
|
||||
! Constants for desc_a handling
|
||||
!
|
||||
|
||||
integer, parameter :: psb_upd_glbnum_=998
|
||||
integer, parameter :: psb_upd_locnum_=997
|
||||
integer, parameter :: psb_proc_id_=0, psb_n_elem_recv_=1
|
||||
integer, parameter :: psb_elem_recv_=2, psb_n_elem_send_=2
|
||||
integer, parameter :: psb_elem_send_=3, psb_n_ovrlp_elem_=1
|
||||
integer, parameter :: psb_ovrlp_elem_to_=2, psb_ovrlp_elem_=0
|
||||
integer, parameter :: psb_n_dom_ovr_=1
|
||||
|
||||
|
||||
! desc_type contains data for communications.
|
||||
type psb_desc_type
|
||||
! contain decomposition informations
|
||||
integer, allocatable :: matrix_data(:)
|
||||
! contain index of halo elements to send/receive
|
||||
integer, allocatable :: halo_index(:)
|
||||
integer, allocatable :: halo_index(:), ext_index(:)
|
||||
! contain indices of boundary elements
|
||||
integer, allocatable :: bnd_elem(:)
|
||||
! contain index of overlap elements to send/receive
|
||||
@@ -265,7 +322,7 @@ contains
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
if (err_act == act_ret) then
|
||||
if (err_act == psb_act_ret_) then
|
||||
return
|
||||
else
|
||||
call psb_error(ictxt)
|
||||
|
||||
@@ -30,7 +30,10 @@
|
||||
!!$
|
||||
module psb_error_mod
|
||||
|
||||
use psb_const_mod
|
||||
integer, parameter, public :: psb_act_ret_=0, psb_act_abort_=1, psb_no_err_=0
|
||||
!
|
||||
! Error handling
|
||||
!
|
||||
public psb_errpush, psb_error, psb_get_errstatus,&
|
||||
& psb_get_errverbosity, psb_set_errverbosity,psb_errcomm, &
|
||||
& psb_erractionsave, psb_erractionrestore, &
|
||||
@@ -41,7 +44,6 @@ module psb_error_mod
|
||||
module procedure psb_perror
|
||||
end interface
|
||||
|
||||
!!$ integer, parameter :: act_ret=0, act_abort=1, no_err=0
|
||||
|
||||
private
|
||||
|
||||
|
||||
@@ -75,7 +75,8 @@ Contains
|
||||
use psb_error_mod
|
||||
|
||||
! ...Subroutine Arguments
|
||||
Integer,allocatable :: vin(:),vout(:)
|
||||
Integer,allocatable,intent(in) :: vin(:)
|
||||
Integer,allocatable,intent(out) :: vout(:)
|
||||
integer :: info
|
||||
! ...Local Variables
|
||||
|
||||
@@ -107,7 +108,7 @@ Contains
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
if (err_act.eq.act_ret) then
|
||||
if (err_act.eq.psb_act_ret_) then
|
||||
return
|
||||
else
|
||||
call psb_error()
|
||||
@@ -153,7 +154,7 @@ Contains
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
if (err_act.eq.act_ret) then
|
||||
if (err_act.eq.psb_act_ret_) then
|
||||
return
|
||||
else
|
||||
call psb_error()
|
||||
@@ -198,7 +199,7 @@ Contains
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
if (err_act.eq.act_ret) then
|
||||
if (err_act.eq.psb_act_ret_) then
|
||||
return
|
||||
else
|
||||
call psb_error()
|
||||
@@ -244,7 +245,7 @@ Contains
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
if (err_act.eq.act_ret) then
|
||||
if (err_act.eq.psb_act_ret_) then
|
||||
return
|
||||
else
|
||||
call psb_error()
|
||||
@@ -289,7 +290,7 @@ Contains
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
if (err_act.eq.act_ret) then
|
||||
if (err_act.eq.psb_act_ret_) then
|
||||
return
|
||||
else
|
||||
call psb_error()
|
||||
@@ -335,7 +336,7 @@ Contains
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
if (err_act.eq.act_ret) then
|
||||
if (err_act.eq.psb_act_ret_) then
|
||||
return
|
||||
else
|
||||
call psb_error()
|
||||
@@ -464,7 +465,7 @@ Contains
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
if (err_act.eq.act_ret) then
|
||||
if (err_act.eq.psb_act_ret_) then
|
||||
return
|
||||
else
|
||||
call psb_error()
|
||||
@@ -514,7 +515,7 @@ Contains
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
if (err_act.eq.act_ret) then
|
||||
if (err_act.eq.psb_act_ret_) then
|
||||
return
|
||||
else
|
||||
call psb_error()
|
||||
@@ -564,7 +565,7 @@ Contains
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
if (err_act.eq.act_ret) then
|
||||
if (err_act.eq.psb_act_ret_) then
|
||||
return
|
||||
else
|
||||
call psb_error()
|
||||
@@ -586,26 +587,31 @@ Contains
|
||||
integer, optional, intent(in) :: lb
|
||||
! ...Local Variables
|
||||
Integer,allocatable :: tmp(:)
|
||||
Integer :: dim, err_act, err,i,lb_
|
||||
Integer :: dim, err_act, err,i,lb_
|
||||
character(len=20) :: name
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
name='psb_dreallocate1i'
|
||||
name='psb_dreallocate1i'
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
if(psb_get_errstatus().ne.0) return
|
||||
info=0
|
||||
if (debug) write(0,*) 'reallocate I',len
|
||||
if (psb_get_errstatus().ne.0) return
|
||||
info=0
|
||||
if (present(lb)) then
|
||||
lb_ = lb
|
||||
else
|
||||
lb_ = 1
|
||||
endif
|
||||
if ((len<0).or.(len>25*1024*1024)) then
|
||||
err=2025
|
||||
call psb_errpush(err,name,i_err=(/len,0,0,0,0/))
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (allocated(rrax)) then
|
||||
dim=size(rrax)
|
||||
If (dim /= len) Then
|
||||
Allocate(tmp(lb_:len),stat=info)
|
||||
Allocate(tmp(len),stat=info)
|
||||
if (info /= 0) then
|
||||
err=4000
|
||||
call psb_errpush(err,name)
|
||||
@@ -618,7 +624,7 @@ Contains
|
||||
end if
|
||||
else
|
||||
dim = 0
|
||||
allocate(rrax(lb_:len),stat=info)
|
||||
allocate(rrax(len),stat=info)
|
||||
if (info /= 0) then
|
||||
err=4000
|
||||
call psb_errpush(err,name)
|
||||
@@ -635,7 +641,7 @@ Contains
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
if (err_act.eq.act_ret) then
|
||||
if (err_act.eq.psb_act_ret_) then
|
||||
return
|
||||
else
|
||||
call psb_error()
|
||||
@@ -672,6 +678,12 @@ Contains
|
||||
else
|
||||
lb_ = 1
|
||||
endif
|
||||
if ((len<0).or.(len>25*1024*1024)) then
|
||||
err=2025
|
||||
call psb_errpush(err,name,i_err=(/len,0,0,0,0/))
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
|
||||
if (allocated(rrax)) then
|
||||
dim=size(rrax)
|
||||
@@ -707,7 +719,7 @@ Contains
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
if (err_act.eq.act_ret) then
|
||||
if (err_act.eq.psb_act_ret_) then
|
||||
return
|
||||
else
|
||||
call psb_error()
|
||||
@@ -736,6 +748,12 @@ Contains
|
||||
call psb_erractionsave(err_act)
|
||||
info = 0
|
||||
if (debug) write(0,*) 'reallocate Z',len
|
||||
if ((len<0).or.(len>25*1024*1024)) then
|
||||
err=2025
|
||||
call psb_errpush(err,name,i_err=(/len,0,0,0,0/))
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
|
||||
if (allocated(rrax)) then
|
||||
dim=size(rrax)
|
||||
@@ -771,7 +789,7 @@ Contains
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
if (err_act.eq.act_ret) then
|
||||
if (err_act.eq.psb_act_ret_) then
|
||||
return
|
||||
else
|
||||
call psb_error()
|
||||
@@ -837,7 +855,7 @@ Contains
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
if (err_act.eq.act_ret) then
|
||||
if (err_act.eq.psb_act_ret_) then
|
||||
return
|
||||
else
|
||||
call psb_error()
|
||||
@@ -902,7 +920,7 @@ Contains
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
if (err_act.eq.act_ret) then
|
||||
if (err_act.eq.psb_act_ret_) then
|
||||
return
|
||||
else
|
||||
call psb_error()
|
||||
@@ -966,7 +984,7 @@ Contains
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
if (err_act.eq.act_ret) then
|
||||
if (err_act.eq.psb_act_ret_) then
|
||||
return
|
||||
else
|
||||
call psb_error()
|
||||
@@ -1009,7 +1027,7 @@ Contains
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
if (err_act.eq.act_ret) then
|
||||
if (err_act.eq.psb_act_ret_) then
|
||||
return
|
||||
else
|
||||
call psb_error()
|
||||
@@ -1060,7 +1078,7 @@ Contains
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
if (err_act.eq.act_ret) then
|
||||
if (err_act.eq.psb_act_ret_) then
|
||||
return
|
||||
else
|
||||
call psb_error()
|
||||
@@ -1109,7 +1127,7 @@ Contains
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
if (err_act.eq.act_ret) then
|
||||
if (err_act.eq.psb_act_ret_) then
|
||||
return
|
||||
else
|
||||
call psb_error()
|
||||
|
||||
@@ -32,13 +32,48 @@
|
||||
!! Module to define D_SPMAT, structure !!
|
||||
!! for sparse matrix. !!
|
||||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
module psb_spmat_type
|
||||
use psb_error_mod
|
||||
use psb_realloc_mod
|
||||
use psb_const_mod
|
||||
implicit none
|
||||
! Typedef: psb_dspmat_type
|
||||
! Contains a sparse matrix
|
||||
|
||||
!
|
||||
! Queries into spmat%info
|
||||
!
|
||||
integer, parameter :: psb_nztotreq_=1, psb_nzrowreq_=2
|
||||
integer, parameter :: psb_nzsizereq_=3
|
||||
!
|
||||
! Entries and values for spmat%info
|
||||
!
|
||||
|
||||
integer, parameter :: psb_nnz_=1
|
||||
integer, parameter :: psb_del_bnd_=7, psb_srtd_=8
|
||||
integer, parameter :: psb_state_=9
|
||||
integer, parameter :: psb_upd_pnt_=10
|
||||
integer, parameter :: psb_dupl_=11, psb_upd_=12
|
||||
integer, parameter :: psb_ifasize_=16
|
||||
integer, parameter :: psb_spmat_null_=0, psb_spmat_bld_=1
|
||||
integer, parameter :: psb_spmat_asb_=2, psb_spmat_upd_=4
|
||||
integer, parameter :: psb_ireg_flgs_=10, psb_ip2_=0
|
||||
integer, parameter :: psb_iflag_=2, psb_ichk_=3
|
||||
integer, parameter :: psb_nnzt_=4, psb_zero_=5,psb_ipc_=6
|
||||
integer, parameter :: psb_dupl_ovwrt_ = 0
|
||||
integer, parameter :: psb_dupl_add_ = 1
|
||||
integer, parameter :: psb_dupl_err_ = 2
|
||||
integer, parameter :: psb_dupl_def_ = psb_dupl_ovwrt_
|
||||
integer, parameter :: psb_upd_dflt_ = 0
|
||||
integer, parameter :: psb_upd_srch_ = 98764
|
||||
integer, parameter :: psb_upd_perm_ = 98765
|
||||
integer, parameter :: psb_isrtdcoo_ = 98761
|
||||
integer, parameter :: psb_maxjdrows_=8, psb_minjdrows_=4
|
||||
integer, parameter :: psb_dbleint_=2
|
||||
character(len=5) :: psb_fidef_='CSR'
|
||||
|
||||
|
||||
|
||||
type psb_dspmat_type
|
||||
! Rows & columns
|
||||
integer :: m, k
|
||||
@@ -499,16 +534,25 @@ contains
|
||||
logical, parameter :: debug=.false.
|
||||
|
||||
info = 0
|
||||
if (debug) write(0,*) 'Before realloc',nd,size(a%aspk)
|
||||
if (debug) write(0,*) 'Before realloc',nd,size(a%aspk),ni1,ni2
|
||||
call psb_realloc(nd,a%aspk,info)
|
||||
if (debug) write(0,*) 'After realloc',nd,size(a%aspk),info
|
||||
!!$ call flush(0)
|
||||
if (info /= 0) return
|
||||
if (debug) write(0,*) 'Before realloc2',ni2,allocated(a%ia2),size(a%ia2)
|
||||
!!$ call flush(0)
|
||||
call psb_realloc(ni2,a%ia2,info)
|
||||
if (info /= 0) return
|
||||
if (debug) write(0,*) 'Before realloc3',ni1,allocated(a%ia1),size(a%ia1)
|
||||
!!$ call flush(0)
|
||||
call psb_realloc(ni1,a%ia1,info)
|
||||
if (info /= 0) return
|
||||
if (debug) write(0,*) 'Before realloc4',max(1,a%m),allocated(a%pl),size(a%pl)
|
||||
!!$ call flush(0)
|
||||
call psb_realloc(max(1,a%m),a%pl,info)
|
||||
if (info /= 0) return
|
||||
if (debug) write(0,*) 'Before realloc5',max(1,a%k),allocated(a%pr),size(a%pr)
|
||||
!!$ call flush(0)
|
||||
call psb_realloc(max(1,a%k),a%pr,info)
|
||||
if (info /= 0) return
|
||||
|
||||
@@ -1398,7 +1442,7 @@ contains
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act.eq.act_abort) then
|
||||
if (err_act.eq.psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
@@ -1553,7 +1597,7 @@ contains
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act.eq.act_abort) then
|
||||
if (err_act.eq.psb_act_abort_) then
|
||||
call psb_error()
|
||||
return
|
||||
end if
|
||||
|
||||
+491
-477
File diff suppressed because it is too large
Load Diff
@@ -278,9 +278,10 @@ module psi_mod
|
||||
end interface
|
||||
|
||||
interface psi_ldsc_pre_halo
|
||||
subroutine psi_ldsc_pre_halo(desc,info)
|
||||
subroutine psi_ldsc_pre_halo(desc,ext_hv,info)
|
||||
use psb_descriptor_type
|
||||
type(psb_desc_type), intent(inout) :: desc
|
||||
logical, intent(in) :: ext_hv
|
||||
integer, intent(out) :: info
|
||||
end subroutine psi_ldsc_pre_halo
|
||||
end interface
|
||||
@@ -344,7 +345,7 @@ module psi_mod
|
||||
|
||||
contains
|
||||
|
||||
subroutine psi_cnv_dsc(halo_in,ovrlap_in,cdesc, info)
|
||||
subroutine psi_cnv_dsc(halo_in,ovrlap_in,ext_in,cdesc, info)
|
||||
|
||||
use psb_const_mod
|
||||
use psb_error_mod
|
||||
@@ -354,7 +355,7 @@ contains
|
||||
implicit none
|
||||
|
||||
! ....scalars parameters....
|
||||
integer, intent(in) :: halo_in(:), ovrlap_in(:)
|
||||
integer, intent(in) :: halo_in(:), ovrlap_in(:),ext_in(:)
|
||||
type(psb_desc_type), intent(inout) :: cdesc
|
||||
integer, intent(out) :: info
|
||||
|
||||
@@ -396,6 +397,22 @@ contains
|
||||
cdesc%matrix_data(psb_thal_rcv_) = nrcv
|
||||
|
||||
if (debug) write(0,*) me,'Done crea_index on halo'
|
||||
if (debug) write(0,*) me,'Calling crea_index on ext'
|
||||
|
||||
|
||||
! then ext index
|
||||
if (debug) write(0,*) me,'Calling crea_index on ext'
|
||||
call psi_crea_index(cdesc,ext_in, idx_out,.false.,nxch,nsnd,nrcv,info)
|
||||
if(info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='psi_crea_index')
|
||||
goto 9999
|
||||
end if
|
||||
call psb_transfer(idx_out,cdesc%ext_index,info)
|
||||
cdesc%matrix_data(psb_text_xch_) = nxch
|
||||
cdesc%matrix_data(psb_text_snd_) = nsnd
|
||||
cdesc%matrix_data(psb_text_rcv_) = nrcv
|
||||
|
||||
if (debug) write(0,*) me,'Done crea_index on ext'
|
||||
if (debug) write(0,*) me,'Calling crea_index on ovrlap'
|
||||
|
||||
! then the overlap index
|
||||
@@ -439,7 +456,7 @@ contains
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == act_abort) then
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error(ictxt)
|
||||
return
|
||||
end if
|
||||
|
||||
Reference in New Issue
Block a user