[cig-commits] r18725 - seismo/3D/FAULT_SOURCE/branches/new_fault_db/decompose_mesh_SCOTCH
ampuero at geodynamics.org
ampuero at geodynamics.org
Sun Jul 10 10:34:29 PDT 2011
Author: ampuero
Date: 2011-07-10 10:34:29 -0700 (Sun, 10 Jul 2011)
New Revision: 18725
Modified:
seismo/3D/FAULT_SOURCE/branches/new_fault_db/decompose_mesh_SCOTCH/decompose_mesh_SCOTCH.f90
seismo/3D/FAULT_SOURCE/branches/new_fault_db/decompose_mesh_SCOTCH/fault_scotch.f90
Log:
cleaned up fault_scotch
Modified: seismo/3D/FAULT_SOURCE/branches/new_fault_db/decompose_mesh_SCOTCH/decompose_mesh_SCOTCH.f90
===================================================================
--- seismo/3D/FAULT_SOURCE/branches/new_fault_db/decompose_mesh_SCOTCH/decompose_mesh_SCOTCH.f90 2011-07-10 17:19:29 UTC (rev 18724)
+++ seismo/3D/FAULT_SOURCE/branches/new_fault_db/decompose_mesh_SCOTCH/decompose_mesh_SCOTCH.f90 2011-07-10 17:34:29 UTC (rev 18725)
@@ -531,8 +531,8 @@
! nparts, part, nfaces_coupled, faces_coupled)
! move all fault elements to the same partition (proc=0)
- call fault_collect_elements(nspec,nnodes,elmnts, &
- sup_neighbour,esize,nsize,nparts,part)
+ call fault_repartition (nelmnts, nnodes, elmnts, nsize, nproc, part, esize)
+
! re-partitioning puts moho-surface coupled elements into same partition
call moho_surface_repartitioning (nspec, nnodes, elmnts, &
Modified: seismo/3D/FAULT_SOURCE/branches/new_fault_db/decompose_mesh_SCOTCH/fault_scotch.f90
===================================================================
--- seismo/3D/FAULT_SOURCE/branches/new_fault_db/decompose_mesh_SCOTCH/fault_scotch.f90 2011-07-10 17:19:29 UTC (rev 18724)
+++ seismo/3D/FAULT_SOURCE/branches/new_fault_db/decompose_mesh_SCOTCH/fault_scotch.f90 2011-07-10 17:34:29 UTC (rev 18725)
@@ -18,7 +18,7 @@
double precision, parameter :: FAULT_GAP_TOLERANCE = 1.0d0
- public :: read_fault_files, fault_collect_elements, close_faults, write_fault_database, &
+ public :: read_fault_files, fault_repartition, close_faults, write_fault_database, &
save_nodes_coords, nodes_coords_open, faults
CONTAINS
@@ -208,58 +208,25 @@
! Repartitioning : two coupled faultside1/side2 elements are transfered to the same partition
!--------------------------------------------------
- Subroutine fault_collect_elements(nelmnts,nnodes,elmnts, &
- sup_neighbour,esize,nsize,nproc,part)
+ Subroutine fault_repartition (nelmnts, nnodes, elmnts, nsize, &
+ nproc, part, esize)
-! INPUTS
- integer(long), intent(in) :: nelmnts,nsize,sup_neighbour
- integer, dimension(0:esize*nelmnts-1),intent(in) :: elmnts
- integer, intent(in) :: nnodes, nproc, esize
-! OUTPUTS :
- integer, dimension(0:nelmnts-1),intent(inout) :: part
-! VARIABLES:
- logical, dimension(nelmnts) :: is_on_fault
- integer :: iflt
-
- is_on_fault = .false.
- do iflt=1,size(faults)
- is_on_fault(faults(iflt)%ispec1) = .true.
- is_on_fault(faults(iflt)%ispec2) = .true.
- end do
- call fault_repartition (nelmnts, nnodes, elmnts, sup_neighbour, nsize, &
- nproc, part, is_on_fault,esize)
-
- end Subroutine fault_collect_elements
-
-! ---------------------------------------------------------------------------------------------------
-
- Subroutine fault_repartition (nelmnts, nnodes, elmnts, sup_neighbour, nsize, &
- nproc, part, is_on_fault, esize)
-
-! INDIVIDUAL FAULT REPARTITION
-
! part : iproc number of processor partioned. It will altered patching fault elements into the same partion.
! Part, once is altered , will be input for write_partition_database.
!INPUTS
- integer(long), intent(in) :: nelmnts,sup_neighbour,nsize
+ integer(long), intent(in) :: nelmnts,nsize
integer, intent(in) :: nnodes, nproc, esize
integer, dimension(0:esize*nelmnts-1), intent(in) :: elmnts
- logical , dimension(nelmnts), intent(in) :: is_on_fault
!OUTPUTS :
integer, dimension(0:nelmnts-1), intent(inout) :: part
-!LOCAL VARIABLES :
- integer, dimension(0:nelmnts) :: xadj
- integer, dimension(0:sup_neighbour*nelmnts-1) :: adjncy
integer, dimension(0:nnodes-1) :: nnodes_elmnts
integer, dimension(0:nsize*nnodes-1) :: nodes_elmnts
integer :: max_neighbour
-!SHILDING
integer :: i,j, ipart,nproc_null,nproc_null_final
- integer :: el, el_1, el_2, k1, k2, k,e,iflt,inode
- logical :: is_repartitioned
+ integer :: k1, k2, k,e,iflt,inode
integer, dimension(:), allocatable :: elem_proc_null
! downloading processor 0
@@ -280,12 +247,6 @@
end if
end do
! Redistributing proc-0 elements on the rest of processors
- !jpa: why do this? does it always help balancing ?
- !pgb: Yes, bulk elements in processor 0 are taken out and redistributed.
- !pgb: leaving more space for fault elements.
- !jpa: But if the number of fault elements is much smaller than nproc_null
- ! we will end up with a very UNbalanced proc 0 !
- !pgb: Solution , fault parellelization .
ipart=1
if (nproc > 1) then
do i = 1, nproc_null
@@ -296,41 +257,6 @@
end if
deallocate(elem_proc_null)
endif
-! call mesh2dual_ncommonnodes_fault(nelmnts, nnodes, nsize, sup_neighbour, &
-! elmnts, xadj, adjncy, nnodes_elmnts, &
-! nodes_elmnts, max_neighbour, 4, esize)
-
- ! coupled elements
- ! ---------------
- ! Allocating neighbours with shared fault faces.
- ! This is done in order to not break MPI interfaces.
- ! Dirty implementation.
- ! Fault faces are shield by double coarse neighbours.
- !
- ! 1 2
- ! 1 1 2 2
- ! 1 1 [1] [2] 2 2
- ! 1 1 2 2
- ! 1 2
-
- ! Allocating elements with double shield layer
-!
-! =========== FAULT SHIELD double-layer =========== !
-! print *, "Fault shield double-layer :"
-! do el = 0, nelmnts-1
-! if ( is_on_fault(el+1) ) then
-! part(el) = 0
-! do k1 = xadj(el), xadj(el+1) - 1
-! el_1 = adjncy(k1)
-! part(el_1) = 0
-! do k2 = xadj(el_1), xadj(el_1+1) - 1
-! el_2 = adjncy(k2)
-! part(el_2) = 0
-! enddo
-! enddo
-! endif
-! enddo
-! ===================================================== !
! Fault zone layer = the set of elements that contain at least one fault node
print *, "Fault zone layer :"
@@ -449,174 +375,4 @@
end subroutine write_fault_database
-
-! ---------------------------------------------------------------------------------------------------
-! Creating dual graph (adjacency is defined by 'ncommonnodes' between two elements).
-! Taken from part_decomposition_SCOTCH.f90 routine.
-!----------------------------------------------------------------------------------------------------
- subroutine mesh2dual_ncommonnodes_fault(nelmnts, nnodes, nsize, sup_neighbour, elmnts,&
- xadj, adjncy, &
- nnodes_elmnts, nodes_elmnts, &
- max_neighbour, ncommonnodes,esize)
-
- integer(long), intent(in) :: nelmnts
- integer, intent(in) :: nnodes
- integer(long), intent(in) :: nsize
- integer(long), intent(in) :: sup_neighbour
- integer, dimension(0:esize*nelmnts-1), intent(in) :: elmnts
-
- integer, dimension(0:nelmnts) :: xadj
- integer, dimension(0:sup_neighbour*nelmnts-1) :: adjncy
- integer, dimension(0:nnodes-1) :: nnodes_elmnts
- integer, dimension(0:nsize*nnodes-1) :: nodes_elmnts
- integer, intent(out) :: max_neighbour
- integer, intent(in) :: ncommonnodes,esize
-
- ! local parameters
- integer :: i, j, k, l, m, nb_edges
- logical :: is_neighbour
- integer :: num_node, n
- integer :: elem_base, elem_target
- integer :: connectivity
-
-
- ! initializes
- xadj(:) = 0
- adjncy(:) = 0
- nnodes_elmnts(:) = 0
- nodes_elmnts(:) = 0
- nb_edges = 0
-
- ! list of elements per node
- do i = 0, esize*nelmnts-1
- nodes_elmnts(elmnts(i)*nsize+nnodes_elmnts(elmnts(i))) = i/esize
- nnodes_elmnts(elmnts(i)) = nnodes_elmnts(elmnts(i)) + 1
- end do
-
- ! checking which elements are neighbours ('ncommonnodes' criteria)
- do j = 0, nnodes-1
- do k = 0, nnodes_elmnts(j)-1
- do l = k+1, nnodes_elmnts(j)-1
-
- connectivity = 0
- elem_base = nodes_elmnts(k+j*nsize)
- elem_target = nodes_elmnts(l+j*nsize)
- do n = 1, esize
- num_node = elmnts(esize*elem_base+n-1)
- do m = 0, nnodes_elmnts(num_node)-1
- if ( nodes_elmnts(m+num_node*nsize) == elem_target ) then
- connectivity = connectivity + 1
- end if
- end do
- end do
-
- if ( connectivity >= ncommonnodes) then
-
- is_neighbour = .false.
-
- do m = 0, xadj(nodes_elmnts(k+j*nsize))
- if ( .not.is_neighbour ) then
- if ( adjncy(nodes_elmnts(k+j*nsize)*sup_neighbour+m) == nodes_elmnts(l+j*nsize) ) then
- is_neighbour = .true.
-
- end if
- end if
- end do
- if ( .not.is_neighbour ) then
- adjncy(nodes_elmnts(k+j*nsize)*sup_neighbour+xadj(nodes_elmnts(k+j*nsize))) = nodes_elmnts(l+j*nsize)
-
- xadj(nodes_elmnts(k+j*nsize)) = xadj(nodes_elmnts(k+j*nsize)) + 1
- if (xadj(nodes_elmnts(k+j*nsize))>sup_neighbour) stop 'ERROR : too much neighbours per element, modify the mesh.'
-
- adjncy(nodes_elmnts(l+j*nsize)*sup_neighbour+xadj(nodes_elmnts(l+j*nsize))) = nodes_elmnts(k+j*nsize)
-
- xadj(nodes_elmnts(l+j*nsize)) = xadj(nodes_elmnts(l+j*nsize)) + 1
- if (xadj(nodes_elmnts(l+j*nsize))>sup_neighbour) stop 'ERROR : too much neighbours per element, modify the mesh.'
- end if
- end if
- end do
- end do
- end do
-
- max_neighbour = maxval(xadj)
-
- ! making adjacency arrays compact (to be used for partitioning)
- do i = 0, nelmnts-1
- k = xadj(i)
- xadj(i) = nb_edges
- do j = 0, k-1
- adjncy(nb_edges) = adjncy(i*sup_neighbour+j)
- nb_edges = nb_edges + 1
- end do
- end do
-
- xadj(nelmnts) = nb_edges
-
-
- end subroutine mesh2dual_ncommonnodes_fault
-
-!-----------
-! subroutine write_fault_database_iface(IIN_database, iproc, nelmnts, &
-! glob2loc_elmnts, part)
-!
-! integer, intent(in) :: IIN_database
-! integer, intent(in) :: iproc
-! integer(long), intent(in) :: nelmnts
-! integer, dimension(0:nelmnts-1), intent(in) :: part,glob2loc_elmnts
-!
-! integer, dimension(:), allocatable :: ispec1, ispec2, iface1, iface2
-! integer :: i,iflt,ispec_fault
-! integer :: nspec_fault_1,nspec_fault_2,nspec_fault
-! integer :: k1,k2
-!
-! do iflt=1,size(faults)
-!
-! ! check number of fault elements in this partition
-! nspec_fault_1 = count( part(faults(iflt)%ispec1-1) == iproc )
-! nspec_fault_2 = count( part(faults(iflt)%ispec2-1) == iproc )
-! print *, 'Fault # ',iflt
-! print *, ' ispec1 : ', nspec_fault_1
-! print *, ' ispec2 : ', nspec_fault_2
-! if (nspec_fault_1 /= nspec_fault_2) then
-! print *, 'Fatal error: Number of fault elements on ',iproc,' do not coincide. Abort.'
-! stop
-! end if
-! nspec_fault = nspec_fault_1
-!
-! write(IIN_database,*) nspec_fault
-!
-! if (nspec_fault==0) cycle
-!
-! allocate(ispec1(nspec_fault))
-! allocate(iface1(nspec_fault))
-! allocate(ispec2(nspec_fault))
-! allocate(iface2(nspec_fault))
-! k1 = 0
-! k2 = 0
-! do i = 1,faults(iflt)%nspec
-! if ( part(faults(iflt)%ispec1(i)-1) == iproc ) then
-! k1 = k1 + 1
-! ispec1(k1)=glob2loc_elmnts(faults(iflt)%ispec1(i))
-! iface1(k1)=faults(iflt)%iface1(i)
-! endif
-! if ( part(faults(iflt)%ispec2(i)-1) == iproc ) then
-! k2 = k2 + 1
-! ispec2(k2)=glob2loc_elmnts(faults(iflt)%ispec2(i))
-! iface2(k2)=faults(iflt)%iface2(i)
-! endif
-! enddo
-!
-! ! Writes ispec1 , ispec2 , iface1 , iface2
-! do i = 1,nspec_fault
-! write(IIN_database,*) ispec1(i), ispec2(i), iface1(i), iface2(i)
-! enddo
-! ! NOTE: the solver does not need ispec1 and ispec2 to be facing each other across the fault
-! deallocate(ispec1,ispec2,iface1,iface2)
-!
-! enddo
-!
-! end subroutine write_fault_database_iface
-
-
-
end module fault_scotch
More information about the CIG-COMMITS
mailing list