[cig-commits] r20765 - seismo/3D/FAULT_SOURCE/branches/new_fault_db/src
ampuero at geodynamics.org
ampuero at geodynamics.org
Sat Sep 22 08:11:22 PDT 2012
Author: ampuero
Date: 2012-09-22 08:11:22 -0700 (Sat, 22 Sep 2012)
New Revision: 20765
Modified:
seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/fault_solver.f90
Log:
nullified pointers and cleaned up init_dataXZ
Modified: seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/fault_solver.f90
===================================================================
--- seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/fault_solver.f90 2012-09-22 14:03:40 UTC (rev 20764)
+++ seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/fault_solver.f90 2012-09-22 15:11:22 UTC (rev 20765)
@@ -27,6 +27,7 @@
! Percy Galvez, Jean-Paul Ampuero and Tarje Nissen-Meyer
! Surendra Nadh Somala : Added Heterogenous initial stress capabilities (based on TPV16)
! Surendra Nadh Somala : Added Rate and State Friction
+! Somala/Ampuero : fault parallelization
module fault_solver
@@ -39,14 +40,16 @@
! outputs on selected fault nodes at every time step:
! slip, slip velocity, fault stresses
type dataT_type
- integer :: npoin,npoin_local
- integer, dimension(:), pointer :: iglob=>null() ! on-fault global index of output nodes
- integer, dimension(:,:), pointer :: iglob_all=>null()
- integer, dimension(:), pointer :: islice=>null(),glob_indx=>null()
+ integer :: npoin,npoin_local
+ integer, dimension(:), pointer :: iglob=>null() ! on-fault global index of output nodes
+ integer, dimension(:,:), pointer :: iglob_all=>null()
+ integer, dimension(:), pointer :: islice=>null(),glob_indx=>null()
real(kind=CUSTOM_REAL), dimension(:), pointer :: dist=>null()
real(kind=CUSTOM_REAL), dimension(:,:), pointer :: dist_all=>null()
- real(kind=CUSTOM_REAL), dimension(:,:), pointer :: d1=>null(),v1=>null(),t1=>null(),d2=>null(),v2=>null(),t2=>null(),t3=>null(),theta=>null()
- character(len=70), dimension(:), pointer :: name
+ real(kind=CUSTOM_REAL), dimension(:,:), pointer :: d1=>null(),v1=>null(),t1=>null(), &
+ d2=>null(),v2=>null(),t2=>null(), &
+ t3=>null(),theta=>null()
+ character(len=70), dimension(:), pointer :: name=>null()
end type dataT_type
@@ -86,19 +89,19 @@
type bc_dynflt_type
private
integer :: nspec,nglob,nglob_all,npoin_all
- real(kind=CUSTOM_REAL), dimension(:,:), pointer :: T0,T,V,D
- real(kind=CUSTOM_REAL), dimension(:,:), pointer :: coord
- real(kind=CUSTOM_REAL), dimension(:,:,:), pointer :: R
- real(kind=CUSTOM_REAL), dimension(:), pointer :: MU,B,invM1,invM2,Z
+ real(kind=CUSTOM_REAL), dimension(:,:), pointer :: T0=>null(),T=>null(),V=>null(),D=>null()
+ real(kind=CUSTOM_REAL), dimension(:,:), pointer :: coord=>null()
+ real(kind=CUSTOM_REAL), dimension(:,:,:), pointer :: R=>null()
+ real(kind=CUSTOM_REAL), dimension(:), pointer :: MU=>null(),B=>null(),invM1=>null(),invM2=>null(),Z=>null()
real(kind=CUSTOM_REAL) :: dt
- integer, dimension(:), pointer :: ibulk1, ibulk2
+ integer, dimension(:), pointer :: ibulk1=>null(), ibulk2=>null()
type(swf_type), pointer :: swf => null()
type(rsf_type), pointer :: rsf => null()
type(asperity_type), pointer :: asp => null()
logical :: allow_opening = .false. ! default : do not allow opening
type(dataT_type) :: dataT
type(dataXZ_type) :: dataXZ,dataXZ_all
- integer, dimension(:), pointer :: poin_offset,npoin_perproc
+ integer, dimension(:), pointer :: poin_offset=>null(),npoin_perproc=>null()
end type bc_dynflt_type
type(bc_dynflt_type), allocatable, save :: faults(:)
@@ -119,7 +122,7 @@
logical, save :: TPV16 = .false.
- logical, save :: Rate_AND_State = .false.
+ logical, save :: RATE_AND_STATE = .false.
real(kind=CUSTOM_REAL), allocatable, save :: Kelvin_Voigt_eta(:)
@@ -282,21 +285,20 @@
read(IIN_BIN) bc%nspec,bc%nglob
if (.NOT.PARALLEL_FAULT .and. bc%nspec==0) return
if (bc%nspec>0) then
- allocate( bc%ibulk1(bc%nglob) )
- allocate( bc%ibulk2(bc%nglob) )
- allocate( ibool1(NGLLSQUARE,bc%nspec) )
- allocate(normal(NDIM,NGLLSQUARE,bc%nspec))
- allocate(jacobian2Dw(NGLLSQUARE,bc%nspec))
-
- allocate(bc%coord(3,(bc%nglob)))
- read(IIN_BIN) ibool1
- read(IIN_BIN) jacobian2Dw
- read(IIN_BIN) normal
- read(IIN_BIN) bc%ibulk1
- read(IIN_BIN) bc%ibulk2
- read(IIN_BIN) bc%coord(1,:)
- read(IIN_BIN) bc%coord(2,:)
- read(IIN_BIN) bc%coord(3,:)
+ allocate( bc%ibulk1(bc%nglob) )
+ allocate( bc%ibulk2(bc%nglob) )
+ allocate( ibool1(NGLLSQUARE,bc%nspec) )
+ allocate(normal(NDIM,NGLLSQUARE,bc%nspec))
+ allocate(jacobian2Dw(NGLLSQUARE,bc%nspec))
+ allocate(bc%coord(3,(bc%nglob)))
+ read(IIN_BIN) ibool1
+ read(IIN_BIN) jacobian2Dw
+ read(IIN_BIN) normal
+ read(IIN_BIN) bc%ibulk1
+ read(IIN_BIN) bc%ibulk2
+ read(IIN_BIN) bc%coord(1,:)
+ read(IIN_BIN) bc%coord(2,:)
+ read(IIN_BIN) bc%coord(3,:)
bc%dt = dt_tmp
allocate( bc%B(bc%nglob) )
@@ -316,16 +318,15 @@
enddo
endif
- if(PARALLEL_FAULT) then
+ if (PARALLEL_FAULT) then
+
accel=0._CUSTOM_REAL
if (bc%nspec>0) accel(1,bc%ibulk1) = bc%B(:)
-
! assembles with other MPI processes
call assemble_MPI_vector_ext_mesh(NPROC,NGLOB_AB,accel, &
num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh, &
my_neighbours_ext_mesh)
-
if (bc%nspec>0) bc%B(:) = accel(1,bc%ibulk1)
accel=0._CUSTOM_REAL
@@ -334,18 +335,17 @@
accel(2,bc%ibulk1) = ny(:)
accel(3,bc%ibulk1) = nz(:)
endif
-
! assembles with other MPI processes
call assemble_MPI_vector_ext_mesh(NPROC,NGLOB_AB,accel, &
num_interfaces_ext_mesh,max_nibool_interfaces_ext_mesh, &
nibool_interfaces_ext_mesh,ibool_interfaces_ext_mesh, &
my_neighbours_ext_mesh)
-
if (bc%nspec>0) then
nx(:) = accel(1,bc%ibulk1)
ny(:) = accel(2,bc%ibulk1)
nz(:) = accel(3,bc%ibulk1)
endif
+
endif
if (bc%nspec>0) then
@@ -404,7 +404,6 @@
! if (abs(bc%zcoord(k)-0.e0_CUSTOM_REAL) <= SMALLVAL) bc%T0(2,k) = 0
! end do
-
if (TPV16) then
allocate(inp_nx(bc%nglob))
@@ -791,7 +790,7 @@
real(kind=CUSTOM_REAL) :: time
real(kind=CUSTOM_REAL) :: psi
- if(bc%nspec > 0) then !Surendra : for parallel faults
+ if (bc%nspec > 0) then !Surendra : for parallel faults
half_dt = 0.5e0_CUSTOM_REAL*bc%dt
Vnorm_old = sqrt(bc%V(1,:)*bc%V(1,:)+bc%V(2,:)*bc%V(2,:))
@@ -939,15 +938,16 @@
! write dataT every NTOUT time step or at the end of simulation
if ( mod(it,NTOUT) == 0 .or. it==NSTEP) call SCEC_write_dataT(bc%dataT,bc%dt,it)
if ( it == NSTEP) call SCEC_Write_RuptureTime(bc%dataXZ,bc%dt,NSTEP,iflt)
+
endif
! write dataXZ every NSNAP time step
if ( mod(it,NSNAP) == 0) then
- if(.NOT. PARALLEL_FAULT) then
- if(bc%nspec > 0) call write_dataXZ(bc%dataXZ,it,iflt)
+ if (.NOT. PARALLEL_FAULT) then
+ if (bc%nspec > 0) call write_dataXZ(bc%dataXZ,it,iflt)
else
call gather_dataXZ(bc)
- if(myrank==0) call write_dataXZ(bc%dataXZ_all,it,iflt)
+ if (myrank==0) call write_dataXZ(bc%dataXZ_all,it,iflt)
endif
endif
@@ -1152,6 +1152,7 @@
!===============================================================
! OUTPUTS
subroutine init_dataT(DataT,coord,nglob,NT,iflt)
+
use specfem_par, only : NPROC,myrank
! NT = total number of time steps
@@ -1437,35 +1438,37 @@
DataXZ%npoin = nglob !Surendra
npoin = DataXZ%npoin
- allocate(DataXZ%stg(nglob))
if(bc%nglob > 0) then
+
+ allocate(DataXZ%stg(nglob))
if(.not. Rate_AND_State) then
DataXZ%sta => bc%swf%theta
else
DataXZ%sta => bc%rsf%theta
endif
+ DataXZ%d1 => bc%d(1,:)
+ DataXZ%d2 => bc%d(2,:)
+ DataXZ%v1 => bc%v(1,:)
+ DataXZ%v2 => bc%v(2,:)
+ DataXZ%t1 => bc%t(1,:)
+ DataXZ%t2 => bc%t(2,:)
+ DataXZ%t3 => bc%t(3,:)
+ DataXZ%xcoord => bc%coord(1,:)
+ DataXZ%ycoord => bc%coord(2,:)
+ DataXZ%zcoord => bc%coord(3,:)
+ allocate(DataXZ%tRUP(nglob))
+ allocate(DataXZ%tPZ(nglob))
+
+ !Percy , setting up initial rupture time null for all faults.
+ DataXZ%tRUP = 0e0_CUSTOM_REAL
+ DataXZ%tPZ = 0e0_CUSTOM_REAL
+
endif
- DataXZ%d1 => bc%d(1,:)
- DataXZ%d2 => bc%d(2,:)
- DataXZ%v1 => bc%v(1,:)
- DataXZ%v2 => bc%v(2,:)
- DataXZ%t1 => bc%t(1,:)
- DataXZ%t2 => bc%t(2,:)
- DataXZ%t3 => bc%t(3,:)
- DataXZ%xcoord => bc%coord(1,:)
- DataXZ%ycoord => bc%coord(2,:)
- DataXZ%zcoord => bc%coord(3,:)
- allocate(DataXZ%tRUP(nglob))
- allocate(DataXZ%tPZ(nglob))
- !Percy , setting up initial rupture time null for all faults.
- DataXZ%tRUP = 0e0_CUSTOM_REAL
- DataXZ%tPZ = 0e0_CUSTOM_REAL
-
!Surendra : for parallel fault
- if(PARALLEL_FAULT) then
+ if (PARALLEL_FAULT) then
call sum_all_i(bc%nglob,bc%nglob_all)
- if(myrank==0) then
+ if (myrank==0 .and. bc%nglob_all>0) then
npoin_all=bc%nglob_all
!bc%DataXZ_all%npoin=npoin_all
bc%npoin_all=npoin_all
@@ -1504,6 +1507,7 @@
!---------------------------------------------------------------
subroutine gather_dataXZ(bc)
+
use specfem_par, only : NPROC
type(bc_dynflt_type) :: bc
More information about the CIG-COMMITS
mailing list