fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

psblas3-integer8:

Browse Source 
base/modules/Makefile
 base/modules/psb_gen_block_map_mod.f90
 base/modules/psb_hash_mod.f90
 test/pargen/ppde.f90
 test/pargen/spde.f90

Merged fixes to gen_block from trunk.
psblas3-type-indexed
Salvatore Filippone 13 years ago
parent 2bc9249c1a
commit e7b0041574
5 changed files with 122 additions and 96 deletions
Show Stats Download Patch File Download Diff File

1
base/modules/Makefile
Unescape Escape View File

@ -93,6 +93,7 @@ psb_hash_map_mod.o psb_list_map_mod.o psb_repl_map_mod.o psb_gen_block_map_mod.o
psb_glist_map_mod.o: psb_list_map_mod.o
psb_hash_map_mod.o: psb_hash_mod.o psb_sort_mod.o
psb_hash_mod.o: psb_realloc_mod.o psb_const_mod.o
psb_gen_block_map_mod.o: psb_hash_mod.o
psb_linmap_mod.o: psb_s_linmap_mod.o psb_d_linmap_mod.o psb_c_linmap_mod.o psb_z_linmap_mod.o
psb_s_linmap_mod.o: psb_base_linmap_mod.o psb_s_mat_mod.o psb_s_vect_mod.o
psb_d_linmap_mod.o: psb_base_linmap_mod.o psb_d_mat_mod.o psb_d_vect_mod.o

80
base/modules/psb_gen_block_map_mod.f90
Unescape Escape View File

@ -49,11 +49,13 @@ module psb_gen_block_map_mod
use psb_const_mod
use psb_desc_const_mod
use psb_indx_map_mod
use psb_hash_mod
type, extends(psb_indx_map) :: psb_gen_block_map
integer(psb_ipk_) :: min_glob_row = -1
integer(psb_ipk_) :: max_glob_row = -1
integer(psb_ipk_), allocatable :: loc_to_glob(:), srt_l2g(:,:), vnl(:)
type(psb_hash_type) :: hash
contains
procedure, pass(idxmap) :: gen_block_map_init => block_init
@ -107,14 +109,14 @@ contains
& val = val + size(idxmap%srt_l2g)*psb_sizeof_int
if (allocated(idxmap%vnl)) &
& val = val + size(idxmap%vnl)*psb_sizeof_int
val = val + psb_sizeof(idxmap%hash)
end function block_sizeof
subroutine block_free(idxmap)
implicit none
class(psb_gen_block_map), intent(inout) :: idxmap
integer(psb_ipk_) :: info
if (allocated(idxmap%loc_to_glob)) &
& deallocate(idxmap%loc_to_glob)
if (allocated(idxmap%srt_l2g)) &
@ -122,7 +124,7 @@ contains
if (allocated(idxmap%srt_l2g)) &
& deallocate(idxmap%vnl)
call psb_free(idxmap%hash,info)
call idxmap%psb_indx_map%free()
end subroutine block_free
@ -284,7 +286,7 @@ contains
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask(:)
logical, intent(in), optional :: owned
integer(psb_ipk_) :: i, nv, is
integer(psb_ipk_) :: i, nv, is, ip, lip
integer(psb_mpik_) :: ictxt, iam, np
logical :: owned_
@ -330,9 +332,9 @@ contains
idx(i) = idx(i) - idxmap%min_glob_row + 1
else if ((1<= idx(i)).and.(idx(i) <= idxmap%global_rows)&
&.and.(.not.owned_)) then
nv = idxmap%local_cols-idxmap%local_rows
idx(i) = psb_issrch(idx(i),nv,idxmap%loc_to_glob)
if (idx(i) > 0) idx(i) = idx(i) + idxmap%local_rows
ip = idx(i)
call psb_hash_searchkey(ip,lip,idxmap%hash,info)
if (lip > 0) idx(i) = lip + idxmap%local_rows
else
idx(i) = -1
end if
@ -366,9 +368,9 @@ contains
idx(i) = idx(i) - idxmap%min_glob_row + 1
else if ((1<= idx(i)).and.(idx(i) <= idxmap%global_rows)&
&.and.(.not.owned_)) then
nv = idxmap%local_cols-idxmap%local_rows
idx(i) = psb_issrch(idx(i),nv,idxmap%loc_to_glob)
if (idx(i) > 0) idx(i) = idx(i) + idxmap%local_rows
ip = idx(i)
call psb_hash_searchkey(ip,lip,idxmap%hash,info)
if (lip > 0) idx(i) = lip + idxmap%local_rows
else
idx(i) = -1
end if
@ -448,6 +450,8 @@ contains
integer(psb_ipk_), intent(out) :: info
logical, intent(in), optional :: mask(:)
integer(psb_ipk_) :: i, nv, is, ix
integer(psb_ipk_) :: ip, lip, nxt
info = 0
is = size(idx)
@ -474,20 +478,26 @@ contains
idx(i) = idx(i) - idxmap%min_glob_row + 1
else if ((1<= idx(i)).and.(idx(i) <= idxmap%global_rows)) then
nv = idxmap%local_cols-idxmap%local_rows
ix = psb_issrch(idx(i),nv,idxmap%loc_to_glob)
if (ix < 0) then
ix = idxmap%local_cols + 1
call psb_ensure_size(ix,idxmap%loc_to_glob,info,addsz=laddsz)
nxt = nv + 1
ip = idx(i)
call psb_hash_searchinskey(ip,lip,nxt,idxmap%hash,info)
if (info >= 0) then
if (lip == nxt) then
! We have added one item
call psb_ensure_size(nxt,idxmap%loc_to_glob,info,addsz=laddsz)
if (info /= 0) then
info = -4
return
end if
idxmap%local_cols = ix
ix = ix - idxmap%local_rows
idxmap%loc_to_glob(ix) = idx(i)
idxmap%local_cols = nxt + idxmap%local_rows
idxmap%loc_to_glob(nxt) = idx(i)
end if
info = psb_success_
else
info = -5
return
end if
ix = ix + idxmap%local_rows
idx(i) = ix
idx(i) = lip + idxmap%local_rows
else
idx(i) = -1
info = -1
@ -503,20 +513,27 @@ contains
idx(i) = idx(i) - idxmap%min_glob_row + 1
else if ((1<= idx(i)).and.(idx(i) <= idxmap%global_rows)) then
nv = idxmap%local_cols-idxmap%local_rows
ix = psb_issrch(idx(i),nv,idxmap%loc_to_glob)
if (ix < 0) then
ix = idxmap%local_cols + 1
call psb_ensure_size(ix,idxmap%loc_to_glob,info,addsz=laddsz)
nxt = nv + 1
ip = idx(i)
call psb_hash_searchinskey(ip,lip,nxt,idxmap%hash,info)
if (info >= 0) then
if (lip == nxt) then
! We have added one item
call psb_ensure_size(nxt,idxmap%loc_to_glob,info,addsz=laddsz)
if (info /= 0) then
info = -4
return
end if
idxmap%local_cols = ix
ix = ix - idxmap%local_rows
idxmap%loc_to_glob(ix) = idx(i)
idxmap%local_cols = nxt + idxmap%local_rows
idxmap%loc_to_glob(nxt) = idx(i)
end if
info = psb_success_
else
info = -5
return
end if
ix = ix + idxmap%local_rows
idx(i) = ix
idx(i) = lip + idxmap%local_rows
else
idx(i) = -1
info = -1
@ -632,9 +649,9 @@ contains
info = -2
return
end if
call psb_hash_init(nl,idxmap%hash,info)
call idxmap%set_state(psb_desc_bld_)
end subroutine block_init
@ -663,8 +680,8 @@ contains
call psb_msort(idxmap%srt_l2g(:,1),&
& ix=idxmap%srt_l2g(:,2),dir=psb_sort_up_)
call psb_free(idxmap%hash,info)
call idxmap%set_state(psb_desc_asb_)
end subroutine block_asb
function block_get_fmt() result(res)
@ -714,6 +731,9 @@ contains
& call psb_safe_ab_cpy(idxmap%vnl,outmap%vnl,info)
if (info == psb_success_)&
& call psb_safe_ab_cpy(idxmap%srt_l2g,outmap%srt_l2g,info)
if (info == psb_success_)&
& call psb_hash_copy(idxmap%hash,outmap%hash,info)
class default
! This should be impossible
info = -1

2
base/modules/psb_hash_mod.f90
Unescape Escape View File

@ -370,7 +370,7 @@ contains
end if
if (hash%table(hk,1) == HashFreeEntry) then
val = HashFreeEntry
!!$ info = HashNotFound
! !$ info = HashNotFound
return
end if
hk = hk - hd

55
test/pargen/ppde.f90
Unescape Escape View File

@ -39,7 +39,7 @@
! The PDE is a general second order equation in 3d
!
! b1 dd(u) b2 dd(u) b3 dd(u) a1 d(u) a2 d(u) a3 d(u)
! - ------ - ------ - ------ - ----- - ------ - ------ + a4 u = 0
! - ------ - ------ - ------ + ----- + ------ + ------ + a4 u = 0
! dxdx dydy dzdz dx dy dz
!
! with Dirichlet boundary conditions, on the unit cube 0<=x,y,z<=1.
@ -194,8 +194,8 @@ program ppde
call psb_barrier(ictxt)
t2 = psb_wtime() - t1
call psb_amx(ictxt,t2)
amatsize = psb_sizeof(a)
descsize = psb_sizeof(desc_a)
amatsize = a%sizeof()
descsize = desc_a%sizeof()
precsize = psb_sizeof(prec)
call psb_sum(ictxt,amatsize)
call psb_sum(ictxt,descsize)
@ -364,7 +364,7 @@ contains
! discretize the partial diferential equation
!
! b1 dd(u) b2 dd(u) b3 dd(u) a1 d(u) a2 d(u) a3 d(u)
! - ------ - ------ - ------ - ----- - ------ - ------ + a4 u
! - ------ - ------ - ------ + ----- + ------ + ------ + a4 u
! dxdx dydy dzdz dx dy dz
!
! with Dirichlet boundary conditions, on the unit cube 0<=x,y,z<=1.
@ -398,7 +398,7 @@ contains
real(psb_dpk_), allocatable :: val(:)
! deltah dimension of each grid cell
! deltat discretization time
real(psb_dpk_) :: deltah, deltah2
real(psb_dpk_) :: deltah, sqdeltah, deltah2
real(psb_dpk_), parameter :: rhs=0.d0,one=1.d0,zero=0.d0
real(psb_dpk_) :: t0, t1, t2, t3, tasb, talc, ttot, tgen
real(psb_dpk_) :: a1, a2, a3, a4, b1, b2, b3
@ -414,7 +414,8 @@ contains
call psb_info(ictxt, iam, np)
deltah = 1.d0/(idim-1)
deltah2 = deltah*deltah
sqdeltah = deltah*deltah
deltah2 = 2.d0* deltah
! initialize array descriptor and sparse matrix storage. provide an
! estimate of the number of non zeroes
@ -506,66 +507,66 @@ contains
! term depending on (x-1,y,z)
!
if (ix == 1) then
val(element) = -b1(x,y,z)/deltah2-a1(x,y,z)/deltah
val(element) = -b1(x,y,z)/sqdeltah-a1(x,y,z)/deltah2
zt(k) = exp(-x**2-y**2-z**2)*(-val(element))
else
val(element) = -b1(x,y,z)/deltah2-a1(x,y,z)/deltah
val(element) = -b1(x,y,z)/sqdeltah-a1(x,y,z)/deltah2
icol(element) = (ix-2)*idim*idim+(iy-1)*idim+(iz)
irow(element) = glob_row
element = element+1
endif
! term depending on (x,y-1,z)
if (iy == 1) then
val(element) = -b2(x,y,z)/deltah2-a2(x,y,z)/deltah
val(element) = -b2(x,y,z)/sqdeltah-a2(x,y,z)/deltah2
zt(k) = exp(-x**2-y**2-z**2)*exp(-x)*(-val(element))
else
val(element) = -b2(x,y,z)/deltah2-a2(x,y,z)/deltah
val(element) = -b2(x,y,z)/sqdeltah-a2(x,y,z)/deltah2
icol(element) = (ix-1)*idim*idim+(iy-2)*idim+(iz)
irow(element) = glob_row
element = element+1
endif
! term depending on (x,y,z-1)
if (iz == 1) then
val(element)=-b3(x,y,z)/deltah2-a3(x,y,z)/deltah
val(element)=-b3(x,y,z)/sqdeltah-a3(x,y,z)/deltah2
zt(k) = exp(-x**2-y**2-z**2)*exp(-x)*(-val(element))
else
val(element)=-b3(x,y,z)/deltah2-a3(x,y,z)/deltah
val(element)=-b3(x,y,z)/sqdeltah-a3(x,y,z)/deltah2
icol(element) = (ix-1)*idim*idim+(iy-1)*idim+(iz-1)
irow(element) = glob_row
element = element+1
endif
! term depending on (x,y,z)
val(element)=(2*b1(x,y,z) + 2*b2(x,y,z) + 2*b3(x,y,z))/deltah2&
& + (a1(x,y,z) + a2(x,y,z) + a3(x,y,z)+ a4(x,y,z))/deltah
val(element)=(2*b1(x,y,z) + 2*b2(x,y,z) + 2*b3(x,y,z))/sqdeltah&
& +a4(x,y,z)
icol(element) = (ix-1)*idim*idim+(iy-1)*idim+(iz)
irow(element) = glob_row
element = element+1
! term depending on (x,y,z+1)
if (iz == idim) then
val(element)=-b1(x,y,z)/deltah2
val(element)=-b3(x,y,z)/sqdeltah+a3(x,y,z)/deltah2
zt(k) = exp(-x**2-y**2-z**2)*exp(-x)*(-val(element))
else
val(element)=-b1(x,y,z)/deltah2
val(element)=-b3(x,y,z)/sqdeltah+a3(x,y,z)/deltah2
icol(element) = (ix-1)*idim*idim+(iy-1)*idim+(iz+1)
irow(element) = glob_row
element = element+1
endif
! term depending on (x,y+1,z)
if (iy == idim) then
val(element)=-b2(x,y,z)/deltah2
val(element)=-b2(x,y,z)/sqdeltah+a2(x,y,z)/deltah2
zt(k) = exp(-x**2-y**2-z**2)*exp(-x)*(-val(element))
else
val(element)=-b2(x,y,z)/deltah2
val(element)=-b2(x,y,z)/sqdeltah+a2(x,y,z)/deltah2
icol(element) = (ix-1)*idim*idim+(iy)*idim+(iz)
irow(element) = glob_row
element = element+1
endif
! term depending on (x+1,y,z)
if (ix==idim) then
val(element)=-b3(x,y,z)/deltah2
val(element)=-b1(x,y,z)/sqdeltah+a1(x,y,z)/deltah2
zt(k) = exp(-y**2-z**2)*exp(-x)*(-val(element))
else
val(element)=-b3(x,y,z)/deltah2
val(element)=-b1(x,y,z)/sqdeltah+a1(x,y,z)/deltah2
icol(element) = (ix)*idim*idim+(iy-1)*idim+(iz)
irow(element) = glob_row
element = element+1
@ -648,43 +649,43 @@ function a1(x,y,z)
use psb_base_mod, only : psb_dpk_
real(psb_dpk_) :: a1
real(psb_dpk_) :: x,y,z
a1=1.d0
a1=1.414d0
end function a1
function a2(x,y,z)
use psb_base_mod, only : psb_dpk_
real(psb_dpk_) :: a2
real(psb_dpk_) :: x,y,z
a2=2.d1*y
a2=1.414d0
end function a2
function a3(x,y,z)
use psb_base_mod, only : psb_dpk_
real(psb_dpk_) :: a3
real(psb_dpk_) :: x,y,z
a3=1.d0
a3=1.414d0
end function a3
function a4(x,y,z)
use psb_base_mod, only : psb_dpk_
real(psb_dpk_) :: a4
real(psb_dpk_) :: x,y,z
a4=1.d0
a4=0.d0
end function a4
function b1(x,y,z)
use psb_base_mod, only : psb_dpk_
real(psb_dpk_) :: b1
real(psb_dpk_) :: x,y,z
b1=1.d0
b1=1.d0/80
end function b1
function b2(x,y,z)
use psb_base_mod, only : psb_dpk_
real(psb_dpk_) :: b2
real(psb_dpk_) :: x,y,z
b2=1.d0
b2=1.d0/80
end function b2
function b3(x,y,z)
use psb_base_mod, only : psb_dpk_
real(psb_dpk_) :: b3
real(psb_dpk_) :: x,y,z
b3=1.d0
b3=1.d0/80
end function b3

56
test/pargen/spde.f90
Unescape Escape View File

@ -39,7 +39,7 @@
! The PDE is a general second order equation in 3d
!
! b1 dd(u) b2 dd(u) b3 dd(u) a1 d(u) a2 d(u) a3 d(u)
! - ------ - ------ - ------ - ----- - ------ - ------ + a4 u = 0
! - ------ - ------ - ------ + ----- + ------ + ------ + a4 u = 0
! dxdx dydy dzdz dx dy dz
!
! with Dirichlet boundary conditions, on the unit cube 0<=x,y,z<=1.
@ -365,7 +365,7 @@ contains
! discretize the partial diferential equation
!
! b1 dd(u) b2 dd(u) b3 dd(u) a1 d(u) a2 d(u) a3 d(u)
! - ------ - ------ - ------ - ----- - ------ - ------ + a4 u
! - ------ - ------ - ------ + ----- + ------ + ------ + a4 u
! dxdx dydy dzdz dx dy dz
!
! with Dirichlet boundary conditions, on the unit cube 0<=x,y,z<=1.
@ -399,7 +399,7 @@ contains
real(psb_spk_), allocatable :: val(:)
! deltah dimension of each grid cell
! deltat discretization time
real(psb_spk_) :: deltah, deltah2
real(psb_spk_) :: deltah, sqdeltah, deltah2
real(psb_spk_),parameter :: rhs=0.0,one=1.0,zero=0.0
real(psb_dpk_) :: t0, t1, t2, t3, tasb, talc, ttot, tgen
real(psb_spk_) :: a1, a2, a3, a4, b1, b2, b3
@ -414,8 +414,9 @@ contains
call psb_info(ictxt, iam, np)
deltah = 1.d0/(idim-1)
deltah2 = deltah*deltah
deltah = 1.0/(idim-1)
sqdeltah = deltah*deltah
deltah2 = 2.0* deltah
! initialize array descriptor and sparse matrix storage. provide an
! estimate of the number of non zeroes
@ -507,63 +508,66 @@ contains
! term depending on (x-1,y,z)
!
if (ix == 1) then
val(element) = -b1(x,y,z)/deltah2-a1(x,y,z)/deltah
val(element) = -b1(x,y,z)/sqdeltah-a1(x,y,z)/deltah2
zt(k) = exp(-x**2-y**2-z**2)*(-val(element))
else
val(element) = -b1(x,y,z)/deltah2-a1(x,y,z)/deltah
val(element) = -b1(x,y,z)/sqdeltah-a1(x,y,z)/deltah2
icol(element) = (ix-2)*idim*idim+(iy-1)*idim+(iz)
irow(element) = glob_row
element = element+1
endif
! term depending on (x,y-1,z)
if (iy == 1) then
val(element) = -b2(x,y,z)/deltah2-a2(x,y,z)/deltah
val(element) = -b2(x,y,z)/sqdeltah-a2(x,y,z)/deltah2
zt(k) = exp(-x**2-y**2-z**2)*exp(-x)*(-val(element))
else
val(element) = -b2(x,y,z)/deltah2-a2(x,y,z)/deltah
val(element) = -b2(x,y,z)/sqdeltah-a2(x,y,z)/deltah2
icol(element) = (ix-1)*idim*idim+(iy-2)*idim+(iz)
irow(element) = glob_row
element = element+1
endif
! term depending on (x,y,z-1)
if (iz == 1) then
val(element)=-b3(x,y,z)/deltah2-a3(x,y,z)/deltah
val(element)=-b3(x,y,z)/sqdeltah-a3(x,y,z)/deltah2
zt(k) = exp(-x**2-y**2-z**2)*exp(-x)*(-val(element))
else
val(element)=-b3(x,y,z)/deltah2-a3(x,y,z)/deltah
val(element)=-b3(x,y,z)/sqdeltah-a3(x,y,z)/deltah2
icol(element) = (ix-1)*idim*idim+(iy-1)*idim+(iz-1)
irow(element) = glob_row
element = element+1
endif
! term depending on (x,y,z)
val(element)=(2*b1(x,y,z) + 2*b2(x,y,z) + 2*b3(x,y,z))/deltah2&
& + (a1(x,y,z) + a2(x,y,z) + a3(x,y,z)+ a4(x,y,z))/deltah
val(element)=(2*b1(x,y,z) + 2*b2(x,y,z) + 2*b3(x,y,z))/sqdeltah&
& +a4(x,y,z)
icol(element) = (ix-1)*idim*idim+(iy-1)*idim+(iz)
irow(element) = glob_row
element = element+1
! term depending on (x,y,z+1)
if (iz == idim) then
val(element)=-b1(x,y,z)/deltah2
val(element)=-b3(x,y,z)/sqdeltah+a3(x,y,z)/deltah2
zt(k) = exp(-x**2-y**2-z**2)*exp(-x)*(-val(element))
else
val(element)=-b1(x,y,z)/deltah2
val(element)=-b3(x,y,z)/sqdeltah+a3(x,y,z)/deltah2
icol(element) = (ix-1)*idim*idim+(iy-1)*idim+(iz+1)
irow(element) = glob_row
element = element+1
endif
! term depending on (x,y+1,z)
if (iy == idim) then
val(element)=-b2(x,y,z)/deltah2
val(element)=-b2(x,y,z)/sqdeltah+a2(x,y,z)/deltah2
zt(k) = exp(-x**2-y**2-z**2)*exp(-x)*(-val(element))
else
val(element)=-b2(x,y,z)/deltah2
val(element)=-b2(x,y,z)/sqdeltah+a2(x,y,z)/deltah2
icol(element) = (ix-1)*idim*idim+(iy)*idim+(iz)
irow(element) = glob_row
element = element+1
endif
! term depending on (x+1,y,z)
if (ix<idim) then
val(element)=-b3(x,y,z)/deltah2
if (ix==idim) then
val(element)=-b1(x,y,z)/sqdeltah+a1(x,y,z)/deltah2
zt(k) = exp(-y**2-z**2)*exp(-x)*(-val(element))
else
val(element)=-b1(x,y,z)/sqdeltah+a1(x,y,z)/deltah2
icol(element) = (ix)*idim*idim+(iy-1)*idim+(iz)
irow(element) = glob_row
element = element+1
@ -646,43 +650,43 @@ function a1(x,y,z)
use psb_base_mod, only : psb_spk_
real(psb_spk_) :: a1
real(psb_spk_) :: x,y,z
a1=1.e0
a1=1.414e0
end function a1
function a2(x,y,z)
use psb_base_mod, only : psb_spk_
real(psb_spk_) :: a2
real(psb_spk_) :: x,y,z
a2=2.e1*y
a2=1.414e0
end function a2
function a3(x,y,z)
use psb_base_mod, only : psb_spk_
real(psb_spk_) :: a3
real(psb_spk_) :: x,y,z
a3=1.e0
a3=1.414e0
end function a3
function a4(x,y,z)
use psb_base_mod, only : psb_spk_
real(psb_spk_) :: a4
real(psb_spk_) :: x,y,z
a4=1.e0
a4=0.e0
end function a4
function b1(x,y,z)
use psb_base_mod, only : psb_spk_
real(psb_spk_) :: b1
real(psb_spk_) :: x,y,z
b1=1.e0
b1=1.e0/60
end function b1
function b2(x,y,z)
use psb_base_mod, only : psb_spk_
real(psb_spk_) :: b2
real(psb_spk_) :: x,y,z
b2=1.e0
b2=1.e0/60
end function b2
function b3(x,y,z)
use psb_base_mod, only : psb_spk_
real(psb_spk_) :: b3
real(psb_spk_) :: x,y,z
b3=1.e0
b3=1.e0/60
end function b3

Write Preview
Loading…
Cancel
Save