[cig-commits] r18498 - seismo/3D/FAULT_SOURCE/branches/new_fault_db/decompose_mesh_SCOTCH
ampuero at geodynamics.org
ampuero at geodynamics.org
Mon May 30 23:04:27 PDT 2011
Author: ampuero
Date: 2011-05-30 23:04:26 -0700 (Mon, 30 May 2011)
New Revision: 18498
Modified:
seismo/3D/FAULT_SOURCE/branches/new_fault_db/decompose_mesh_SCOTCH/fault_scotch.f90
Log:
redefined fault zone layer in scotch, now based on fault%inodes# to keep it thin
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-05-31 05:27:02 UTC (rev 18497)
+++ seismo/3D/FAULT_SOURCE/branches/new_fault_db/decompose_mesh_SCOTCH/fault_scotch.f90 2011-05-31 06:04:26 UTC (rev 18498)
@@ -16,8 +16,7 @@
integer, parameter :: long = SELECTED_INT_KIND(18)
- double precision, parameter :: FAULT_GAP_TOLERANCE = 1.0d0 ! JPA: are you sure 1 meter is small enough?
- ! PGB: for a simple test is fine .For SCEC lower values.
+ double precision, parameter :: FAULT_GAP_TOLERANCE = 0.01d0
public :: read_fault_files, fault_collect_elements, close_faults, write_fault_database, &
save_nodes_coords, nodes_coords_open, faults
@@ -253,15 +252,15 @@
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: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
+! integer :: max_neighbour
!SHILDING
integer :: i,j, ipart,nproc_null,nproc_null_final
- integer :: el, el_1, el_2, k1, k2
+ integer :: el, el_1, el_2, k1, k2, k,e,iflt,inode
logical :: is_repartitioned
integer, dimension(:), allocatable :: elem_proc_null
@@ -296,9 +295,9 @@
end do
endif
- call mesh2dual_ncommonnodes_fault(nelmnts, nnodes, nsize, sup_neighbour, &
- elmnts, xadj, adjncy, nnodes_elmnts, &
- nodes_elmnts, max_neighbour, 4, esize)
+ ! call mesh2dual_ncommonnodes_fault(nelmnts, nnodes, nsize, sup_neighbour, &
+ ! elmnts, xadj, adjncy, nnodes_elmnts, &
+ ! nodes_elmnts, max_neighbour, 4, esize)
! coupled elements
! ---------------
@@ -314,21 +313,52 @@
! 1 2
! Allocating elements with double shield 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
+! 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
+ ! list of elements per node
+ ! nnodes_elmnts(i) = number of elements containing node #i (i=0:nnodes-1)
+ ! nodes_elmnts(nsize*i:nsize*i+nnodes_elmnts(i)-1) = index of elements containing node #i (k=0:nsize*nnodes-1)
+ nnodes_elmnts(:) = 0
+ nodes_elmnts(:) = 0
+ 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
+
+ ! fault zone layer = the set of elements that contain at least one fault node
+ print *, "Fault zone layer :"
+ do iflt=1,size(faults)
+ do e=1,faults(iflt)%nspec
+ do k=1,4
+
+ inode = faults(iflt)%inodes1(k,e)-1 ! node index, starting at 0
+ k1 = nsize*inode
+ k2 = k1 + nnodes_elmts(inode) -1
+ part( nodes_elmnts(k1:k2) ) = 0
+
+ inode = faults(iflt)%inodes2(k,e)-1
+ k1 = nsize*inode
+ k2 = k1 + nnodes_elmts(inode) -1
+ part( nodes_elmnts(k1:k2) ) = 0
+
+ end do
+ end do
+ end do
+! jpa: if the previous section works then clean up obsolete stuff
+
nproc_null_final = count( part == 0 )
print *, nproc_null_final
More information about the CIG-COMMITS
mailing list