[cig-commits] r20772 - seismo/3D/FAULT_SOURCE/branches/new_fault_db/src
ampuero at geodynamics.org
ampuero at geodynamics.org
Mon Sep 24 11:35:28 PDT 2012
Author: ampuero
Date: 2012-09-24 11:35:28 -0700 (Mon, 24 Sep 2012)
New Revision: 20772
Modified:
seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/fault_solver.f90
Log:
cleaned up 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-24 17:58:21 UTC (rev 20771)
+++ seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/fault_solver.f90 2012-09-24 18:35:28 UTC (rev 20772)
@@ -88,7 +88,7 @@
type bc_dynflt_type
private
- integer :: nspec,nglob,nglob_all,npoin_all
+ integer :: nspec=0, nglob=0
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()
@@ -101,7 +101,7 @@
logical :: allow_opening = .false. ! default : do not allow opening
type(dataT_type) :: dataT
type(dataXZ_type) :: dataXZ,dataXZ_all
- integer, dimension(:), pointer :: poin_offset=>null(),npoin_perproc=>null()
+ integer, dimension(:), pointer :: poin_offset=>null(),npoin_perproc=>null()
end type bc_dynflt_type
type(bc_dynflt_type), allocatable, save :: faults(:)
@@ -460,7 +460,7 @@
! Set friction parameters and initialize friction variables
! Slip weakening friction
- if(.not. Rate_AND_State) then
+ if(.not. RATE_AND_STATE) then
allocate( bc%swf )
allocate( bc%swf%mus(bc%nglob) )
allocate( bc%swf%mud(bc%nglob) )
@@ -620,7 +620,7 @@
! call init_dataT(bc%dataT,bc%coord,bc%nglob,NT,iflt)
- call init_dataXZ(bc%dataXZ,bc,bc%nglob)
+ call init_dataXZ(bc%dataXZ,bc)
end subroutine init_one_fault
@@ -824,7 +824,7 @@
! Opening implies free stress
if (bc%allow_opening) T(3,:) = min(T(3,:),0.e0_CUSTOM_REAL)
- if(.not. Rate_AND_State) then ! Update slip weakening friction:
+ if(.not. RATE_AND_STATE) then ! Update slip weakening friction:
! Update slip state variable
! WARNING: during opening the friction state variable should not evolve
theta_old = bc%swf%theta
@@ -922,7 +922,7 @@
!-- intermediate storage of outputs --
Vnorm = sqrt(bc%V(1,:)*bc%V(1,:)+bc%V(2,:)*bc%V(2,:))
- if(.not. Rate_AND_State) then
+ if(.not. RATE_AND_STATE) then
theta_new = bc%swf%theta
dc = bc%swf%dc
else
@@ -1353,10 +1353,10 @@
write(IOUT,*) "# Column #6 = vertical up-dip slip rate (m/s)"
write(IOUT,*) "# Column #7 = vertical up-dip shear stress (MPa)"
write(IOUT,*) "# Column #8 = normal stress (MPa)"
- if(Rate_AND_State) write(IOUT,*) "# Column #9 = log10 of state variable (log-seconds)"
+ if (RATE_AND_STATE) write(IOUT,*) "# Column #9 = log10 of state variable (log-seconds)"
write(IOUT,*) "#"
write(IOUT,*) "# The line below lists the names of the data fields:"
- if(.not. Rate_AND_State) then
+ if (.not. RATE_AND_STATE) then
write(IOUT,*) "t h-slip h-slip-rate h-shear-stress v-slip v-slip-rate v-shear-stress n-stress"
write(IOUT,*) "#"
do k=1,NT
@@ -1425,23 +1425,21 @@
end subroutine SCEC_Write_RuptureTime
!-------------------------------------------------------------------------------------------------
-subroutine init_dataXZ(DataXZ,bc,nglob)
+subroutine init_dataXZ(DataXZ,bc)
use specfem_par, only : NPROC,myrank
type(dataXZ_type), intent(inout) :: DataXZ
type(bc_dynflt_type) :: bc
- integer, intent(in) :: nglob
- integer :: npoin_all,npoin,iproc,ier
+ integer :: npoin_all,iproc
- DataXZ%npoin = nglob !Surendra
- npoin = DataXZ%npoin
+ DataXZ%npoin = bc%nglob
if(bc%nglob > 0) then
- allocate(DataXZ%stg(nglob))
- if(.not. Rate_AND_State) then
+ allocate(DataXZ%stg(bc%nglob))
+ if(.not. RATE_AND_STATE) then
DataXZ%sta => bc%swf%theta
else
DataXZ%sta => bc%rsf%theta
@@ -1456,8 +1454,8 @@
DataXZ%xcoord => bc%coord(1,:)
DataXZ%ycoord => bc%coord(2,:)
DataXZ%zcoord => bc%coord(3,:)
- allocate(DataXZ%tRUP(nglob))
- allocate(DataXZ%tPZ(nglob))
+ allocate(DataXZ%tRUP(bc%nglob))
+ allocate(DataXZ%tPZ(bc%nglob))
!Percy , setting up initial rupture time null for all faults.
DataXZ%tRUP = 0e0_CUSTOM_REAL
@@ -1467,11 +1465,10 @@
!Surendra : for parallel fault
if (PARALLEL_FAULT) then
- call sum_all_i(bc%nglob,bc%nglob_all)
- 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
+ npoin_all = 0
+ call sum_all_i(bc%nglob,npoin_all)
+ if (myrank==0 .and. npoin_all>0) then
+ bc%DataXZ_all%npoin = npoin_all
allocate(bc%DataXZ_all%xcoord(npoin_all))
allocate(bc%DataXZ_all%ycoord(npoin_all))
allocate(bc%DataXZ_all%zcoord(npoin_all))
@@ -1491,16 +1488,16 @@
allocate(bc%npoin_perproc(NPROC))
allocate(bc%poin_offset(NPROC))
bc%npoin_perproc=0
- call gather_all_i(npoin,1,bc%npoin_perproc,1,NPROC)
+ call gather_all_i(DataXZ%npoin,1,bc%npoin_perproc,1,NPROC)
bc%poin_offset(1)=0
do iproc=2,NPROC
bc%poin_offset(iproc) = sum(bc%npoin_perproc(1:iproc-1))
enddo
- call gatherv_all_cr(DataXZ%xcoord,DataXZ%npoin,bc%DataXZ_all%xcoord,bc%npoin_perproc,bc%poin_offset,bc%npoin_all,NPROC)
- call gatherv_all_cr(DataXZ%ycoord,DataXZ%npoin,bc%DataXZ_all%ycoord,bc%npoin_perproc,bc%poin_offset,bc%npoin_all,NPROC)
- call gatherv_all_cr(DataXZ%zcoord,DataXZ%npoin,bc%DataXZ_all%zcoord,bc%npoin_perproc,bc%poin_offset,bc%npoin_all,NPROC)
+ call gatherv_all_cr(DataXZ%xcoord,DataXZ%npoin,bc%DataXZ_all%xcoord,bc%npoin_perproc,bc%poin_offset,bc%DataXZ_all%npoin,NPROC)
+ call gatherv_all_cr(DataXZ%ycoord,DataXZ%npoin,bc%DataXZ_all%ycoord,bc%npoin_perproc,bc%poin_offset,bc%DataXZ_all%npoin,NPROC)
+ call gatherv_all_cr(DataXZ%zcoord,DataXZ%npoin,bc%DataXZ_all%zcoord,bc%npoin_perproc,bc%poin_offset,bc%DataXZ_all%npoin,NPROC)
endif
end subroutine init_dataXZ
@@ -1510,19 +1507,19 @@
use specfem_par, only : NPROC
- type(bc_dynflt_type) :: bc
+ type(bc_dynflt_type), intent(inout) :: bc
- call gatherv_all_cr(bc%DataXZ%t1,bc%DataXZ%npoin,bc%DataXZ_all%t1,bc%npoin_perproc,bc%poin_offset,bc%npoin_all,NPROC)
- call gatherv_all_cr(bc%DataXZ%t2,bc%DataXZ%npoin,bc%DataXZ_all%t2,bc%npoin_perproc,bc%poin_offset,bc%npoin_all,NPROC)
- call gatherv_all_cr(bc%DataXZ%t3,bc%DataXZ%npoin,bc%DataXZ_all%t3,bc%npoin_perproc,bc%poin_offset,bc%npoin_all,NPROC)
- call gatherv_all_cr(bc%DataXZ%d1,bc%DataXZ%npoin,bc%DataXZ_all%d1,bc%npoin_perproc,bc%poin_offset,bc%npoin_all,NPROC)
- call gatherv_all_cr(bc%DataXZ%d2,bc%DataXZ%npoin,bc%DataXZ_all%d2,bc%npoin_perproc,bc%poin_offset,bc%npoin_all,NPROC)
- call gatherv_all_cr(bc%DataXZ%v1,bc%DataXZ%npoin,bc%DataXZ_all%v1,bc%npoin_perproc,bc%poin_offset,bc%npoin_all,NPROC)
- call gatherv_all_cr(bc%DataXZ%v2,bc%DataXZ%npoin,bc%DataXZ_all%v2,bc%npoin_perproc,bc%poin_offset,bc%npoin_all,NPROC)
- call gatherv_all_cr(bc%DataXZ%tRUP,bc%DataXZ%npoin,bc%DataXZ_all%tRUP,bc%npoin_perproc,bc%poin_offset,bc%npoin_all,NPROC)
- call gatherv_all_cr(bc%DataXZ%tPZ,bc%DataXZ%npoin,bc%DataXZ_all%tPZ,bc%npoin_perproc,bc%poin_offset,bc%npoin_all,NPROC)
- call gatherv_all_cr(bc%DataXZ%stg,bc%DataXZ%npoin,bc%DataXZ_all%stg,bc%npoin_perproc,bc%poin_offset,bc%npoin_all,NPROC)
- call gatherv_all_cr(bc%DataXZ%sta,bc%DataXZ%npoin,bc%DataXZ_all%sta,bc%npoin_perproc,bc%poin_offset,bc%npoin_all,NPROC)
+ call gatherv_all_cr(bc%DataXZ%t1,bc%DataXZ%npoin,bc%DataXZ_all%t1,bc%npoin_perproc,bc%poin_offset,bc%DataXZ_all%npoin,NPROC)
+ call gatherv_all_cr(bc%DataXZ%t2,bc%DataXZ%npoin,bc%DataXZ_all%t2,bc%npoin_perproc,bc%poin_offset,bc%DataXZ_all%npoin,NPROC)
+ call gatherv_all_cr(bc%DataXZ%t3,bc%DataXZ%npoin,bc%DataXZ_all%t3,bc%npoin_perproc,bc%poin_offset,bc%DataXZ_all%npoin,NPROC)
+ call gatherv_all_cr(bc%DataXZ%d1,bc%DataXZ%npoin,bc%DataXZ_all%d1,bc%npoin_perproc,bc%poin_offset,bc%DataXZ_all%npoin,NPROC)
+ call gatherv_all_cr(bc%DataXZ%d2,bc%DataXZ%npoin,bc%DataXZ_all%d2,bc%npoin_perproc,bc%poin_offset,bc%DataXZ_all%npoin,NPROC)
+ call gatherv_all_cr(bc%DataXZ%v1,bc%DataXZ%npoin,bc%DataXZ_all%v1,bc%npoin_perproc,bc%poin_offset,bc%DataXZ_all%npoin,NPROC)
+ call gatherv_all_cr(bc%DataXZ%v2,bc%DataXZ%npoin,bc%DataXZ_all%v2,bc%npoin_perproc,bc%poin_offset,bc%DataXZ_all%npoin,NPROC)
+ call gatherv_all_cr(bc%DataXZ%tRUP,bc%DataXZ%npoin,bc%DataXZ_all%tRUP,bc%npoin_perproc,bc%poin_offset,bc%DataXZ_all%npoin,NPROC)
+ call gatherv_all_cr(bc%DataXZ%tPZ,bc%DataXZ%npoin,bc%DataXZ_all%tPZ,bc%npoin_perproc,bc%poin_offset,bc%DataXZ_all%npoin,NPROC)
+ call gatherv_all_cr(bc%DataXZ%stg,bc%DataXZ%npoin,bc%DataXZ_all%stg,bc%npoin_perproc,bc%poin_offset,bc%DataXZ_all%npoin,NPROC)
+ call gatherv_all_cr(bc%DataXZ%sta,bc%DataXZ%npoin,bc%DataXZ_all%sta,bc%npoin_perproc,bc%poin_offset,bc%DataXZ_all%npoin,NPROC)
end subroutine gather_dataXZ
More information about the CIG-COMMITS
mailing list