[cig-commits] r20911 - in seismo/3D/FAULT_SOURCE/branches/new_fault_db: START_UP src
surendra at geodynamics.org
surendra at geodynamics.org
Wed Oct 24 12:43:46 PDT 2012
Author: surendra
Date: 2012-10-24 12:43:46 -0700 (Wed, 24 Oct 2012)
New Revision: 20911
Modified:
seismo/3D/FAULT_SOURCE/branches/new_fault_db/START_UP/Makefile.in
seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/fault_solver.f90
seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/fault_solver_common.f90
seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/fault_solver_kinematic.f90
Log:
Finished refactoring fault routines
Modified: seismo/3D/FAULT_SOURCE/branches/new_fault_db/START_UP/Makefile.in
===================================================================
--- seismo/3D/FAULT_SOURCE/branches/new_fault_db/START_UP/Makefile.in 2012-10-24 19:42:31 UTC (rev 20910)
+++ seismo/3D/FAULT_SOURCE/branches/new_fault_db/START_UP/Makefile.in 2012-10-24 19:43:46 UTC (rev 20911)
@@ -154,6 +154,7 @@
$O/compute_stacey_elastic.o \
$O/compute_gradient.o \
$O/compute_interpolated_dva.o \
+ $O/fault_solver_common.o \
$O/fault_solver.o \
$O/fault_solver_kinematic.o \
$O/initialize_simulation.o \
@@ -305,10 +306,13 @@
$O/compute_forces_elastic_Dev.o: constants.h compute_forces_elastic_Dev.f90
${FCCOMPILE_NO_CHECK} -c -o $O/compute_forces_elastic_Dev.o compute_forces_elastic_Dev.f90
-$O/fault_solver.o: fault_solver.f90 constants.h $O/specfem3D_par.o
+$O/fault_solver_common.o: fault_solver_common.f90 constants.h $O/specfem3D_par.o
+ ${FCCOMPILE_NO_CHECK} -c -o $O/fault_solver_common.o fault_solver_common.f90
+
+$O/fault_solver.o: fault_solver.f90 constants.h $O/specfem3D_par.o $O/fault_solver_common.o
${FCCOMPILE_NO_CHECK} -c -o $O/fault_solver.o fault_solver.f90
-$O/fault_solver_kinematic.o: fault_solver_kinematic.f90 constants.h $O/specfem3D_par.o
+$O/fault_solver_kinematic.o: fault_solver_kinematic.f90 constants.h $O/specfem3D_par.o $O/fault_solver_common.o
${FCCOMPILE_NO_CHECK} -c -o $O/fault_solver_kinematic.o fault_solver_kinematic.f90
$O/compute_forces_elastic.o: constants.h compute_forces_elastic.f90 $O/fault_solver.o $O/fault_solver_kinematic.o
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-10-24 19:42:31 UTC (rev 20910)
+++ seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/fault_solver.f90 2012-10-24 19:43:46 UTC (rev 20911)
@@ -31,6 +31,8 @@
module fault_solver
+ use fault_solver_common
+
implicit none
include 'constants.h'
@@ -120,7 +122,7 @@
real(kind=CUSTOM_REAL), allocatable, save :: Kelvin_Voigt_eta(:)
public :: BC_DYNFLT_init, BC_DYNFLT_set3d_all, Kelvin_Voigt_eta, &
- SIMULATION_TYPE_DYN,,RATE_AND_STATE
+ SIMULATION_TYPE_DYN,RATE_AND_STATE
contains
@@ -220,8 +222,6 @@
subroutine init_one_fault(bc,IIN_BIN,IIN_PAR,Minv,dt_tmp,NT,vel,iflt,accel)
- use specfem_par
-
real(kind=CUSTOM_REAL) :: accel(:,:)
real(kind=CUSTOM_REAL), intent(inout) :: vel(:,:)
@@ -277,7 +277,7 @@
NAMELIST / RSF / V0,f0,a,b,L,V_init,theta_init,nV0,nf0,na,nb,nL,nV_init,ntheta_init,C,T,nC,nForcedRup,Vw,fw,nVw,nfw
NAMELIST / ASP / Fload,nFload
- call initialize_simulation(bc,IIN_BIN,Minv,dt)
+ call initialize_fault(bc,IIN_BIN,Minv,dt_tmp)
if (bc%nspec>0) then
@@ -857,39 +857,7 @@
end subroutine BC_DYNFLT_set3d
!===============================================================
-function get_jump (bc,v) result(dv)
- type(bc_dynflt_type), intent(in) :: bc
- real(kind=CUSTOM_REAL), intent(in) :: v(:,:)
- real(kind=CUSTOM_REAL) :: dv(3,bc%nglob)
-
- ! diference between side 2 and side 1 of fault nodes. dv
- dv(1,:) = v(1,bc%ibulk2)-v(1,bc%ibulk1)
- dv(2,:) = v(2,bc%ibulk2)-v(2,bc%ibulk1)
- dv(3,:) = v(3,bc%ibulk2)-v(3,bc%ibulk1)
-
-end function get_jump
-
-!---------------------------------------------------------------------
-function get_weighted_jump (bc,f) result(da)
-
- type(bc_dynflt_type), intent(in) :: bc
- real(kind=CUSTOM_REAL), intent(in) :: f(:,:)
-
- real(kind=CUSTOM_REAL) :: da(3,bc%nglob)
-
- ! diference between side 2 and side 1 of fault nodes. M-1 * F
- da(1,:) = bc%invM2*f(1,bc%ibulk2)-bc%invM1*f(1,bc%ibulk1)
- da(2,:) = bc%invM2*f(2,bc%ibulk2)-bc%invM1*f(2,bc%ibulk1)
- da(3,:) = bc%invM2*f(3,bc%ibulk2)-bc%invM1*f(3,bc%ibulk1)
-
- ! NOTE: In non-split nodes at fault edges M and f are assembled across the fault.
- ! Hence, f1=f2, invM1=invM2=1/(M1+M2) instead of invMi=1/Mi, and da=0.
-
-end function get_weighted_jump
-
-
-!=====================================================================
subroutine swf_update_state(dold,dnew,vold,f)
real(kind=CUSTOM_REAL), dimension(:,:), intent(in) :: vold,dold,dnew
Modified: seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/fault_solver_common.f90
===================================================================
--- seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/fault_solver_common.f90 2012-10-24 19:42:31 UTC (rev 20910)
+++ seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/fault_solver_common.f90 2012-10-24 19:43:46 UTC (rev 20911)
@@ -5,10 +5,12 @@
module fault_solver_common
implicit none
+
+ include 'constants.h'
+
private
type fault_type
- private
integer :: nspec=0, nglob=0
real(kind=CUSTOM_REAL), dimension(:,:), pointer :: T=>null(),V=>null(),D=>null()
real(kind=CUSTOM_REAL), dimension(:,:), pointer :: coord=>null()
@@ -23,20 +25,20 @@
logical, save :: PARALLEL_FAULT = .false.
- public :: initialize_fault,PARALLEL_FAULT
+ public :: initialize_fault,compute_R,get_jump,get_weighted_jump,rotate,PARALLEL_FAULT,fault_type
contains
!---------------------------------------------------------------------
-subroutine initialize_fault (bc,IIN_BIN,Minv,dt)
+subroutine initialize_fault (bc,IIN_BIN,Minv,dt_tmp)
use specfem_par
- type(fault_type), intent(inout) :: bc
+ class(fault_type), intent(inout) :: bc
real(kind=CUSTOM_REAL), intent(in) :: Minv(:)
integer, intent(in) :: IIN_BIN
- real(kind=CUSTOM_REAL), intent(in) :: dt
+ real(kind=CUSTOM_REAL), intent(in) :: dt_tmp
real(kind=CUSTOM_REAL) :: tmp_vec(3,NGLOB_AB)
real(kind=CUSTOM_REAL), dimension(:,:), allocatable :: jacobian2Dw
@@ -144,7 +146,7 @@
endif
-end subroutine initialize
+end subroutine initialize_fault
!---------------------------------------------------------------------
subroutine compute_R(R,nglob,nx,ny,nz)
@@ -185,7 +187,7 @@
!===============================================================
function get_jump (bc,v) result(dv)
- type(fault_type), intent(in) :: bc
+ class(fault_type), intent(in) :: bc
real(kind=CUSTOM_REAL), intent(in) :: v(:,:)
real(kind=CUSTOM_REAL) :: dv(3,bc%nglob)
@@ -199,7 +201,7 @@
!---------------------------------------------------------------------
function get_weighted_jump (bc,f) result(da)
- type(fault_type), intent(in) :: bc
+ class(fault_type), intent(in) :: bc
real(kind=CUSTOM_REAL), intent(in) :: f(:,:)
real(kind=CUSTOM_REAL) :: da(3,bc%nglob)
@@ -217,7 +219,7 @@
!----------------------------------------------------------------------
function rotate(bc,v,fb) result(vr)
- type(fault_type), intent(in) :: bc
+ class(fault_type), intent(in) :: bc
real(kind=CUSTOM_REAL), intent(in) :: v(3,bc%nglob)
integer, intent(in) :: fb
real(kind=CUSTOM_REAL) :: vr(3,bc%nglob)
Modified: seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/fault_solver_kinematic.f90
===================================================================
--- seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/fault_solver_kinematic.f90 2012-10-24 19:42:31 UTC (rev 20910)
+++ seismo/3D/FAULT_SOURCE/branches/new_fault_db/src/fault_solver_kinematic.f90 2012-10-24 19:43:46 UTC (rev 20911)
@@ -29,6 +29,8 @@
module fault_solver_kinematic
+ use fault_solver_common
+
implicit none
include 'constants.h'
@@ -171,7 +173,7 @@
NAMELIST / KINPAR / kindt
- call initialize_simulation(bc,IIN_BIN,Minv,dt)
+ call initialize_fault(bc,IIN_BIN,Minv,dt)
if (bc%nspec>0) then
@@ -509,7 +511,6 @@
allocate(DataT%v2(NT,DataT%npoin))
allocate(DataT%t2(NT,DataT%npoin))
allocate(DataT%t3(NT,DataT%npoin))
- allocate(DataT%theta(NT,DataT%npoin))
DataT%d1 = 0e0_CUSTOM_REAL
DataT%v1 = 0e0_CUSTOM_REAL
DataT%t1 = 0e0_CUSTOM_REAL
@@ -517,18 +518,16 @@
DataT%v2 = 0e0_CUSTOM_REAL
DataT%t2 = 0e0_CUSTOM_REAL
DataT%t3 = 0e0_CUSTOM_REAL
- DataT%theta = 0e0_CUSTOM_REAL
close(IIN)
end subroutine init_dataT
!---------------------------------------------------------------
-subroutine store_dataT(dataT,d,v,t,theta,itime)
+subroutine store_dataT(dataT,d,v,t,itime)
type(dataT_type), intent(inout) :: dataT
real(kind=CUSTOM_REAL), dimension(:,:), intent(in) :: d,v,t
- real(kind=CUSTOM_REAL), dimension(:), intent(in) :: theta
integer, intent(in) :: itime
integer :: i,k,ipoin
@@ -547,33 +546,30 @@
dataT%t1(itime,i) = t(1,k)
dataT%t2(itime,i) = t(2,k)
dataT%t3(itime,i) = t(3,k)
- dataT%theta(itime,i) = theta(k)
enddo
end subroutine store_dataT
!-----------------------------------------------------------------
-subroutine write_dataT_all(nt,statelaw)
+subroutine write_dataT_all(nt)
integer, intent(in) :: nt
- integer, intent(in) :: statelaw
integer :: i
if (.not.allocated(faults)) return
do i = 1,size(faults)
- call SCEC_write_dataT(faults(i)%dataT,faults(i)%dt,nt,statelaw)
+ call SCEC_write_dataT(faults(i)%dataT,faults(i)%dt,nt)
enddo
end subroutine write_dataT_all
!------------------------------------------------------------------------
-subroutine SCEC_write_dataT(dataT,DT,NT,statelaw)
+subroutine SCEC_write_dataT(dataT,DT,NT)
type(dataT_type), intent(in) :: dataT
real(kind=CUSTOM_REAL), intent(in) :: DT
integer, intent(in) :: NT
- integer, intent(in) :: statelaw
integer :: i,k,IOUT,ipoin
character :: NTchar*5
More information about the CIG-COMMITS
mailing list