mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-06 22:55:08 +00:00
psblas3-integer8:
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.
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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)
|
||||
if (info /= 0) then
|
||||
info = -4
|
||||
return
|
||||
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 = nxt + idxmap%local_rows
|
||||
idxmap%loc_to_glob(nxt) = idx(i)
|
||||
end if
|
||||
idxmap%local_cols = ix
|
||||
ix = ix - idxmap%local_rows
|
||||
idxmap%loc_to_glob(ix) = idx(i)
|
||||
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
|
||||
@@ -498,25 +508,32 @@ contains
|
||||
else if (.not.present(mask)) then
|
||||
|
||||
do i=1, is
|
||||
|
||||
|
||||
if ((idxmap%min_glob_row <= idx(i)).and.(idx(i) <= idxmap%max_glob_row)) then
|
||||
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)
|
||||
if (info /= 0) then
|
||||
info = -4
|
||||
return
|
||||
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 = nxt + idxmap%local_rows
|
||||
idxmap%loc_to_glob(nxt) = idx(i)
|
||||
end if
|
||||
idxmap%local_cols = ix
|
||||
ix = ix - idxmap%local_rows
|
||||
idxmap%loc_to_glob(ix) = idx(i)
|
||||
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
|
||||
|
||||
@@ -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
|
||||
|
||||
+31
-30
@@ -38,9 +38,9 @@
|
||||
!
|
||||
! 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
|
||||
! dxdx dydy dzdz dx dy dz
|
||||
! b1 dd(u) b2 dd(u) b3 dd(u) a1 d(u) a2 d(u) a3 d(u)
|
||||
! - ------ - ------ - ------ + ----- + ------ + ------ + 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
|
||||
@@ -413,8 +413,9 @@ contains
|
||||
|
||||
call psb_info(ictxt, iam, np)
|
||||
|
||||
deltah = 1.d0/(idim-1)
|
||||
deltah2 = deltah*deltah
|
||||
deltah = 1.d0/(idim-1)
|
||||
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
|
||||
|
||||
|
||||
|
||||
+32
-28
@@ -38,9 +38,9 @@
|
||||
!
|
||||
! 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
|
||||
! dxdx dydy dzdz dx dy dz
|
||||
! b1 dd(u) b2 dd(u) b3 dd(u) a1 d(u) a2 d(u) a3 d(u)
|
||||
! - ------ - ------ - ------ + ----- + ------ + ------ + 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
|
||||
|
||||
|
||||
|
||||
Reference in New Issue
Block a user