Added sizeof for sparsematrix/descriptor, prec_sizeof for

preconditioner. Cannot reuse the same name because of a bug in
GFORTRAN; will it be fixed???
psblas3-type-indexed
Salvatore Filippone 18 years ago
parent 163bf3693d
commit 6d59769aef

@ -87,6 +87,7 @@
#define InitPairSearchTree initpairsearchtree_
#define FreePairSearchTree freepairsearchtree_
#define ClonePairSearchTree clonepairsearchtree_
#define SizeofPairSearchTree sizeofpairsearchtree_
#define SearchInsKeyVal searchinskeyval_
#define SearchKeyVal searchkeyval_
#define NPairs npairs_
@ -95,6 +96,7 @@
#define InitPairSearchTree initpairsearchtree_
#define FreePairSearchTree freepairsearchtree_
#define ClonePairSearchTree clonepairsearchtree_
#define SizeofPairSearchTree sizeofpairsearchtree_
#define SearchInsKeyVal searchinskeyval_
#define SearchKeyVal searchkeyval_
#define NPairs npairs_
@ -103,6 +105,7 @@
#define InitPairSearchTree initpairsearchtree
#define FreePairSearchTree freepairsearchtree
#define ClonePairSearchTree clonepairsearchtree
#define SizeofPairSearchTree sizeofpairsearchtree
#define SearchInsKeyVal searchinskeyval
#define SearchKeyVal searchkeyval
#define NPairs npairs
@ -201,6 +204,25 @@ void KeyUpdate( void *key1, void *key2, void *data)
*((int *) data)=((KeyPairPtr) key2)->val;
}
int SizeofPairSearchTree(fptr *ftree)
{
PairTreePtr PTree;
PairVectPtr current,next;
int sz;
PTree = (PairTreePtr) *ftree;
sz = 0;
if (PTree==NULL) return(sz);
current=PTree->PairPoolRoot;
while (current != NULL) {
sz += sizeof(PairVect);
next=current->next;
current=next;
}
return(sz);
}
void FreePairSearchTree(fptr *ftree)
{
PairTreePtr PTree;

@ -260,11 +260,46 @@ module psb_descriptor_type
integer, allocatable :: idx_space(:)
end type psb_desc_type
interface psb_sizeof
module procedure psb_cd_sizeof
end interface
integer, private, save :: cd_large_threshold=psb_default_large_threshold
contains
function psb_cd_sizeof(desc)
implicit none
!....Parameters...
Type(psb_desc_type), intent(in) :: desc
Integer :: psb_cd_sizeof
!locals
logical, parameter :: debug=.false.
integer :: val
integer, external :: SizeofPairSearchTree
val = 0
if (allocated(desc%matrix_data)) val = val + 4*size(desc%matrix_data)
if (allocated(desc%halo_index)) val = val + 4*size(desc%halo_index)
if (allocated(desc%ext_index)) val = val + 4*size(desc%ext_index)
if (allocated(desc%bnd_elem)) val = val + 4*size(desc%bnd_elem)
if (allocated(desc%ovrlap_index)) val = val + 4*size(desc%ovrlap_index)
if (allocated(desc%ovrlap_elem)) val = val + 4*size(desc%ovrlap_elem)
if (allocated(desc%loc_to_glob)) val = val + 4*size(desc%loc_to_glob)
if (allocated(desc%glob_to_loc)) val = val + 4*size(desc%glob_to_loc)
if (allocated(desc%hashv)) val = val + 4*size(desc%hashv)
if (allocated(desc%glb_lc)) val = val + 4*size(desc%glb_lc)
if (allocated(desc%lprm)) val = val + 4*size(desc%lprm)
if (allocated(desc%idx_space)) val = val + 4*size(desc%idx_space)
if (allocated(desc%ptree)) val = val + 4*size(desc%ptree) +&
& SizeofPairSearchTree(desc%ptree)
psb_cd_sizeof = val
end function psb_cd_sizeof
subroutine psb_cd_set_large_threshold(ith)
integer, intent(in) :: ith

@ -153,7 +153,7 @@ module psb_spmat_type
module procedure psb_dspreinit, psb_zspreinit
end interface
interface psb_sp_sizeof
interface psb_sizeof
module procedure psb_dspsizeof, psb_zspsizeof
end interface

@ -688,7 +688,7 @@ contains
else
flag_=0
endif
call psb_cdalv(vg, ictxt, desc_a, info, flag_)
call psb_cdalv(vg, ictxt, desc_a, info, flag=flag_)
else if (present(vl)) then
call psb_cd_inloc(vl,ictxt,desc_a,info)

@ -178,7 +178,7 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild)
end if
nrow = psb_cd_get_local_rows(desc_a)
ncol = psb_cd_get_local_cols(desc_a)
else if (psb_is_asb_desc(desc_a)) then
if (psb_is_large_desc(desc_a)) then

@ -103,6 +103,10 @@ module psb_prec_type
& psb_zout_prec_descr, psb_zfile_prec_descr
end interface
interface psb_prec_sizeof
module procedure psb_dprec_sizeof, psb_zprec_sizeof
end interface
contains
subroutine psb_out_prec_descr(p)
@ -375,4 +379,52 @@ contains
end function pr_to_str
function psb_dprec_sizeof(prec)
use psb_base_mod
type(psb_dprec_type), intent(in) :: prec
integer :: psb_dprec_sizeof
integer :: val,i
val = 0
if (allocated(prec%iprcparm)) val = val + 4 * size(prec%iprcparm)
if (allocated(prec%dprcparm)) val = val + 8 * size(prec%dprcparm)
if (allocated(prec%d)) val = val + 8 * size(prec%d)
if (allocated(prec%perm)) val = val + 4 * size(prec%perm)
if (allocated(prec%invperm)) val = val + 4 * size(prec%invperm)
val = val + psb_sizeof(prec%desc_data)
if (allocated(prec%av)) then
do i=1,size(prec%av)
val = val + psb_sizeof(prec%av(i))
end do
end if
psb_dprec_sizeof = val
end function psb_dprec_sizeof
function psb_zprec_sizeof(prec)
use psb_base_mod
type(psb_zprec_type), intent(in) :: prec
integer :: psb_zprec_sizeof
integer :: val,i
val = 0
if (allocated(prec%iprcparm)) val = val + 4 * size(prec%iprcparm)
if (allocated(prec%dprcparm)) val = val + 8 * size(prec%dprcparm)
if (allocated(prec%d)) val = val + 16 * size(prec%d)
if (allocated(prec%perm)) val = val + 4 * size(prec%perm)
if (allocated(prec%invperm)) val = val + 4 * size(prec%invperm)
val = val + psb_sizeof(prec%desc_data)
if (allocated(prec%av)) then
do i=1,size(prec%av)
val = val + psb_sizeof(prec%av(i))
end do
end if
psb_zprec_sizeof = val
end function psb_zprec_sizeof
end module psb_prec_type

@ -63,7 +63,7 @@ program df_sample
! solver paramters
integer :: iter, itmax, ierr, itrace, ircode, ipart,&
& methd, istopc, iprec, ml
& methd, istopc, iprec, ml,amatsize,precsize,descsize
real(kind(1.d0)) :: err, eps
character(len=5) :: afmt
@ -242,6 +242,12 @@ program df_sample
call psb_genrm2s(resmx,r_col,desc_a,info)
call psb_geamaxs(resmxp,r_col,desc_a,info)
amatsize = psb_sizeof(a)
descsize = psb_sizeof(desc_a)
precsize = psb_prec_sizeof(pre)
call psb_sum(ictxt,amatsize)
call psb_sum(ictxt,descsize)
call psb_sum(ictxt,precsize)
if (amroot) then
call psb_prec_descr(6,pre)
write(*,'("Matrix: ",a)')mtrx_file
@ -254,6 +260,9 @@ program df_sample
write(*,'("Total time : ",es10.4)')t2+tprec
write(*,'("Residual norm 2 = ",es10.4)')resmx
write(*,'("Residual norm inf = ",es10.4)')resmxp
write(*,'("Total memory occupation for A: ",i10)')amatsize
write(*,'("Total memory occupation for DESC_A: ",i10)')descsize
write(*,'("Total memory occupation for PRE: ",i10)')precsize
end if
allocate(x_col_glob(m_problem),r_col_glob(m_problem),stat=ierr)

Loading…
Cancel
Save