From e7b0041574c13acc79dd30711e5952c5f43f7cab Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Tue, 14 Feb 2012 17:34:54 +0000 Subject: [PATCH] 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. --- base/modules/Makefile | 1 + base/modules/psb_gen_block_map_mod.f90 | 94 ++++++++++++++++---------- base/modules/psb_hash_mod.f90 | 2 +- test/pargen/ppde.f90 | 61 +++++++++-------- test/pargen/spde.f90 | 60 ++++++++-------- 5 files changed, 122 insertions(+), 96 deletions(-) diff --git a/base/modules/Makefile b/base/modules/Makefile index 717f4249..7b0137fc 100644 --- a/base/modules/Makefile +++ b/base/modules/Makefile @@ -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 diff --git a/base/modules/psb_gen_block_map_mod.f90 b/base/modules/psb_gen_block_map_mod.f90 index b6613559..415dcde8 100644 --- a/base/modules/psb_gen_block_map_mod.f90 +++ b/base/modules/psb_gen_block_map_mod.f90 @@ -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 diff --git a/base/modules/psb_hash_mod.f90 b/base/modules/psb_hash_mod.f90 index cb9d5b9d..649537e3 100644 --- a/base/modules/psb_hash_mod.f90 +++ b/base/modules/psb_hash_mod.f90 @@ -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 diff --git a/test/pargen/ppde.f90 b/test/pargen/ppde.f90 index 7dc23689..9f807fac 100644 --- a/test/pargen/ppde.f90 +++ b/test/pargen/ppde.f90 @@ -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 diff --git a/test/pargen/spde.f90 b/test/pargen/spde.f90 index 6dad711c..dc04cd5a 100644 --- a/test/pargen/spde.f90 +++ b/test/pargen/spde.f90 @@ -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