fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-23 22:31:47 +00:00
Code Issues Packages Projects Releases Wiki Activity

psblas:

Browse Source 
base/comm/psb_dhalo.f90
base/comm/psb_ihalo.f90
base/comm/psb_zhalo.f90
base/internals/psi_crea_ovr_elem.f90
base/internals/psi_dswapdata.F90
base/internals/psi_dswaptran.F90
base/internals/psi_iswapdata.F90
base/internals/psi_iswaptran.F90
base/internals/psi_zswapdata.F90
base/internals/psi_zswaptran.F90
base/modules/psb_desc_type.f90
base/modules/psi_mod.f90
base/tools/psb_cdcpy.f90
base/tools/psb_cdfree.f90
base/tools/psb_cdtransfer.f90
prec/psb_dbjac_aply.f90
prec/psb_dprc_aply.f90
prec/psb_zbjac_aply.f90
prec/psb_zprc_aply.f90

Merged new ovr_mst_idx into desc derived data type to handle overlap,
in from psblas-ovtrans branch.
This commit is contained in:
Salvatore Filippone
2008-01-29 15:26:40 +00:00
parent 38dfcc9c83
commit b60d842b22
19 changed files with 244 additions and 21 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/modules/psb_desc_type.f90
+19 -4
View File
@@ -46,13 +46,15 @@ module psb_descriptor_type
! For overlap update.
integer, parameter :: psb_none_=0, psb_sum_=1
integer, parameter :: psb_avg_=2, psb_square_root_=3
integer, parameter :: psb_zero_=999
integer, parameter :: psb_setzero_=4
! The following are bit fields.
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_=1, psb_comm_ovr_=2, psb_comm_ext_=3
integer, parameter :: psb_comm_halo_=1, psb_comm_ovr_=2
integer, parameter :: psb_comm_ext_=3, psb_comm_mov_=4
integer, parameter :: psb_ovt_xhal_ = 123, psb_ovt_asov_=psb_ovt_xhal_+1
!
@@ -71,7 +73,10 @@ module psb_descriptor_type
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_tmov_xch_=20
integer, parameter :: psb_tmov_snd_=21
integer, parameter :: psb_tmov_rcv_=22
integer, parameter :: psb_mdata_size_=24
integer, parameter :: psb_desc_asb_=3099
integer, parameter :: psb_desc_bld_=psb_desc_asb_+1
integer, parameter :: psb_desc_repl_=3199
@@ -111,6 +116,7 @@ module psb_descriptor_type
!| integer, allocatable :: bnd_elem(:)
!| integer, allocatable :: ovrlap_index(:)
!| integer, allocatable :: ovrlap_elem(:,:)
!| integer, allocatable :: ovr_mst_idx(:)
!| integer, allocatable :: loc_to_glob(:)
!| integer, allocatable :: glob_to_loc (:)
!| integer, allocatable :: hashv(:), glb_lc(:,:), ptree(:)
@@ -253,7 +259,14 @@ module psb_descriptor_type
! it only contains the end-of-list marker -1).
!
! 10. ovrlap_elem contains a list of overlap indices together with their degree
! of overlap, i.e. the number of processes "owning" them.
! of overlap, i.e. the number of processes "owning" the, and the "master"
! process whose value has to be considered authoritative when the need arises.
!
! 11. ovr_mst_idx is a list defining a retrieve of a copy of the values for
! overlap entries from their respecitve "master" processes by means of
! an halo exchange call. This is used for those cases where there is
! an overlap in the base data distribution.
!
! It is complex, but it does the following:
! 1. Allows a purely local matrix/stencil buildup phase, requiring only
! one synch point at the end (CDASB)
@@ -272,6 +285,7 @@ module psb_descriptor_type
integer, allocatable :: bnd_elem(:)
integer, allocatable :: ovrlap_index(:)
integer, allocatable :: ovrlap_elem(:,:)
integer, allocatable :: ovr_mst_idx(:)
integer, allocatable :: loc_to_glob(:)
integer, allocatable :: glob_to_loc (:)
integer, allocatable :: hashv(:), glb_lc(:,:), ptree(:)
@@ -305,6 +319,7 @@ contains
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%ovr_mst_idx)) val = val + 4*size(desc%ovr_mst_idx)
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)
base/modules/psi_mod.f90
+116 -8
View File
@@ -377,7 +377,7 @@ contains
integer :: np,me
integer :: ictxt, err_act,nxch,nsnd,nrcv,j,k
! ...local array...
integer, allocatable :: idx_out(:)
integer, allocatable :: idx_out(:), tmp_mst_idx(:)
! ...parameters
integer :: debug_level, debug_unit
@@ -403,7 +403,7 @@ contains
! first the halo index
if (debug_level>0) write(debug_unit,*) me,'Calling crea_index on halo'
call psi_crea_index(cdesc,halo_in, idx_out,.false.,nxch,nsnd,nrcv,info)
if(info /= 0) then
if (info /= 0) then
call psb_errpush(4010,name,a_err='psi_crea_index')
goto 9999
end if
@@ -419,7 +419,7 @@ contains
! then ext index
if (debug_level>0) write(debug_unit,*) me,'Calling crea_index on ext'
call psi_crea_index(cdesc,ext_in, idx_out,.false.,nxch,nsnd,nrcv,info)
if(info /= 0) then
if (info /= 0) then
call psb_errpush(4010,name,a_err='psi_crea_index')
goto 9999
end if
@@ -433,12 +433,12 @@ contains
! then the overlap index
call psi_crea_index(cdesc,ovrlap_in, idx_out,.true.,nxch,nsnd,nrcv,info)
if(info /= 0) then
if (info /= 0) then
call psb_errpush(4010,name,a_err='psi_crea_index')
goto 9999
end if
call psb_transfer(idx_out,cdesc%ovrlap_index,info)
if(info /= 0) then
if (info /= 0) then
call psb_errpush(4010,name,a_err='psb_transfer')
goto 9999
end if
@@ -447,20 +447,39 @@ contains
cdesc%matrix_data(psb_tovr_snd_) = nsnd
cdesc%matrix_data(psb_tovr_rcv_) = nrcv
if (debug_level>0) write(debug_unit,*) me,'Calling crea_ovr_elem'
! next ovrlap_elem
if (debug_level>0) write(debug_unit,*) me,'Calling crea_ovr_elem'
call psi_crea_ovr_elem(me,cdesc%ovrlap_index,cdesc%ovrlap_elem,info)
if (debug_level>0) write(debug_unit,*) me,'Done crea_ovr_elem'
if(info /= 0) then
if (info /= 0) then
call psb_errpush(4010,name,a_err='psi_crea_ovr_elem')
goto 9999
end if
! Extract ovr_mst_idx from ovrlap_elem
if (debug_level>0) write(debug_unit,*) me,'Calling bld_ovr_mst'
call psi_bld_ovr_mst(me,cdesc%ovrlap_elem,tmp_mst_idx,info)
if (info == 0) call psi_crea_index(cdesc,&
& tmp_mst_idx,idx_out,.false.,nxch,nsnd,nrcv,info)
if (debug_level>0) write(debug_unit,*) me,'Done crea_indx'
if (info /= 0) then
call psb_errpush(4010,name,a_err='psi_bld_ovr_mst')
goto 9999
end if
call psb_transfer(idx_out,cdesc%ovr_mst_idx,info)
if (info /= 0) then
call psb_errpush(4010,name,a_err='psb_transfer')
goto 9999
end if
cdesc%matrix_data(psb_tmov_xch_) = nxch
cdesc%matrix_data(psb_tmov_snd_) = nsnd
cdesc%matrix_data(psb_tmov_rcv_) = nrcv
! finally bnd_elem
call psi_crea_bnd_elem(idx_out,cdesc,info)
if (info == 0) call psb_transfer(idx_out,cdesc%bnd_elem,info)
if(info /= 0) then
if (info /= 0) then
call psb_errpush(4010,name,a_err='psi_crea_bnd_elem')
goto 9999
end if
@@ -618,6 +637,12 @@ contains
ndm = desc_a%ovrlap_elem(i,2)
x(idx) = x(idx)/real(ndm)
end do
case(psb_setzero_)
do i=1,size(desc_a%ovrlap_elem,1)
idx = desc_a%ovrlap_elem(i,1)
if (me /= desc_a%ovrlap_elem(i,3))&
& x(idx) = dzero
end do
case(psb_sum_)
! do nothing
@@ -684,6 +709,12 @@ contains
ndm = desc_a%ovrlap_elem(i,2)
x(idx,:) = x(idx,:)/real(ndm)
end do
case(psb_setzero_)
do i=1,size(desc_a%ovrlap_elem,1)
idx = desc_a%ovrlap_elem(i,1)
if (me /= desc_a%ovrlap_elem(i,3))&
& x(idx,:) = dzero
end do
case(psb_sum_)
! do nothing
@@ -749,6 +780,12 @@ contains
ndm = desc_a%ovrlap_elem(i,2)
x(idx) = x(idx)/real(ndm)
end do
case(psb_setzero_)
do i=1,size(desc_a%ovrlap_elem,1)
idx = desc_a%ovrlap_elem(i,1)
if (me /= desc_a%ovrlap_elem(i,3))&
& x(idx) = zzero
end do
case(psb_sum_)
! do nothing
@@ -815,6 +852,12 @@ contains
ndm = desc_a%ovrlap_elem(i,2)
x(idx,:) = x(idx,:)/real(ndm)
end do
case(psb_setzero_)
do i=1,size(desc_a%ovrlap_elem,1)
idx = desc_a%ovrlap_elem(i,1)
if (me /= desc_a%ovrlap_elem(i,3))&
& x(idx,:) = zzero
end do
case(psb_sum_)
! do nothing
@@ -881,6 +924,12 @@ contains
ndm = desc_a%ovrlap_elem(i,2)
x(idx) = x(idx)/real(ndm)
end do
case(psb_setzero_)
do i=1,size(desc_a%ovrlap_elem,1)
idx = desc_a%ovrlap_elem(i,1)
if (me /= desc_a%ovrlap_elem(i,3))&
& x(idx) = izero
end do
case(psb_sum_)
! do nothing
@@ -948,6 +997,12 @@ contains
ndm = desc_a%ovrlap_elem(i,2)
x(idx,:) = x(idx,:)/real(ndm)
end do
case(psb_setzero_)
do i=1,size(desc_a%ovrlap_elem,1)
idx = desc_a%ovrlap_elem(i,1)
if (me /= desc_a%ovrlap_elem(i,3))&
& x(idx,:) = izero
end do
case(psb_sum_)
! do nothing
@@ -1935,6 +1990,59 @@ contains
end do
end if
end subroutine psi_zsctv
subroutine psi_bld_ovr_mst(me,ovrlap_elem,mst_idx,info)
use psb_const_mod
use psb_error_mod
use psb_penv_mod
use psb_descriptor_type
use psb_realloc_mod
implicit none
! ....scalars parameters....
integer, intent(in) :: me, ovrlap_elem(:,:)
integer, allocatable, intent(out) :: mst_idx(:)
integer, intent(out) :: info
integer :: i, j, proc, nov,isz, ip, err_act, idx
character(len=20) :: name
name='psi_bld_ovr_mst'
call psb_get_erraction(err_act)
nov = size(ovrlap_elem,1)
isz = 3*nov+1
call psb_realloc(isz,mst_idx,info)
if (info /= 0) then
call psb_errpush(4001,name,a_err='reallocate')
goto 9999
end if
mst_idx = -1
j = 1
do i=1, nov
proc = ovrlap_elem(i,3)
if (me /= proc) then
idx = ovrlap_elem(i,1)
mst_idx(j+0) = proc
mst_idx(j+1) = 1
mst_idx(j+2) = idx
j = j + 3
end if
end do
mst_idx(j) = -1
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psi_bld_ovr_mst
end module psi_mod