[cig-commits] r22229 - in seismo/3D/SPECFEM3D_GLOBE/branches/undo_att: . src/specfem3D
xie.zhinan at geodynamics.org
xie.zhinan at geodynamics.org
Wed Jun 12 02:49:51 PDT 2013
Author: xie.zhinan
Date: 2013-06-12 02:49:51 -0700 (Wed, 12 Jun 2013)
New Revision: 22229
Modified:
seismo/3D/SPECFEM3D_GLOBE/branches/undo_att/part2_undo_att.F90
seismo/3D/SPECFEM3D_GLOBE/branches/undo_att/src/specfem3D/compute_stacey_crust_mantle.f90
seismo/3D/SPECFEM3D_GLOBE/branches/undo_att/src/specfem3D/specfem3D.F90
Log:
the second edition of restructuring.
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/undo_att/part2_undo_att.F90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/undo_att/part2_undo_att.F90 2013-06-12 09:09:37 UTC (rev 22228)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/undo_att/part2_undo_att.F90 2013-06-12 09:49:51 UTC (rev 22229)
@@ -116,6 +116,32 @@
! Stacey absorbing boundaries
if(NCHUNKS_VAL /= 6 .and. ABSORBING_CONDITIONS) then
if (SIMULATION_TYPE == 3) then
+#ifdef UNDO_ATT
+ call compute_stacey_outer_core_forward(ichunk,SAVE_FORWARD, &
+ it,ibool_outer_core, &
+ b_veloc_outer_core,b_accel_outer_core, &
+ vp_outer_core,wgllwgll_xz,wgllwgll_yz,wgllwgll_xy, &
+ jacobian2D_bottom_outer_core, &
+ jacobian2D_xmin_outer_core,jacobian2D_xmax_outer_core, &
+ jacobian2D_ymin_outer_core,jacobian2D_ymax_outer_core, &
+ ibelm_bottom_outer_core, &
+ ibelm_xmin_outer_core,ibelm_xmax_outer_core, &
+ ibelm_ymin_outer_core,ibelm_ymax_outer_core, &
+ nimin_outer_core,nimax_outer_core, &
+ njmin_outer_core,njmax_outer_core, &
+ nkmin_xi_outer_core,nkmin_eta_outer_core, &
+ NSPEC2D_BOTTOM, &
+ nspec2D_xmin_outer_core,nspec2D_xmax_outer_core, &
+ nspec2D_ymin_outer_core,nspec2D_ymax_outer_core, &
+ reclen_zmin, &
+ reclen_xmin_outer_core,reclen_xmax_outer_core, &
+ reclen_ymin_outer_core,reclen_ymax_outer_core, &
+ nabs_zmin_oc, &
+ nabs_xmin_oc,nabs_xmax_oc,nabs_ymin_oc,nabs_ymax_oc, &
+ absorb_zmin_outer_core, &
+ absorb_xmin_outer_core,absorb_xmax_outer_core, &
+ absorb_ymin_outer_core,absorb_ymax_outer_core)
+#else
call compute_stacey_outer_core_backward(ichunk, &
NSTEP,it,ibool_outer_core, &
b_accel_outer_core, &
@@ -136,6 +162,7 @@
absorb_zmin_outer_core, &
absorb_xmin_outer_core,absorb_xmax_outer_core, &
absorb_ymin_outer_core,absorb_ymax_outer_core)
+#endif
! call compute_stacey_outer_core(ichunk,SIMULATION_TYPE,SAVE_FORWARD, &
! NSTEP,it,ibool_outer_core, &
! veloc_outer_core,accel_outer_core,b_accel_outer_core, &
@@ -469,6 +496,29 @@
! Stacey
if(NCHUNKS_VAL /= 6 .and. ABSORBING_CONDITIONS) then
if(SIMULATION_TYPE == 3) then
+#ifdef UNDO_ATT
+ call compute_stacey_crust_mantle_forward(ichunk, &
+ it,SAVE_FORWARD,ibool_crust_mantle, &
+ b_veloc_crust_mantle,b_accel_crust_mantle, &
+ jacobian2D_xmin_crust_mantle,jacobian2D_xmax_crust_mantle, &
+ jacobian2D_ymin_crust_mantle,jacobian2D_ymax_crust_mantle, &
+ wgllwgll_xz,wgllwgll_yz, &
+ normal_xmin_crust_mantle,normal_xmax_crust_mantle, &
+ normal_ymin_crust_mantle,normal_ymax_crust_mantle, &
+ rho_vp_crust_mantle,rho_vs_crust_mantle, &
+ ibelm_xmin_crust_mantle,ibelm_xmax_crust_mantle, &
+ ibelm_ymin_crust_mantle,ibelm_ymax_crust_mantle, &
+ nimin_crust_mantle,nimax_crust_mantle, &
+ njmin_crust_mantle,njmax_crust_mantle, &
+ nkmin_xi_crust_mantle,nkmin_eta_crust_mantle, &
+ nspec2D_xmin_crust_mantle,nspec2D_xmax_crust_mantle, &
+ nspec2D_ymin_crust_mantle,nspec2D_ymax_crust_mantle, &
+ reclen_xmin_crust_mantle,reclen_xmax_crust_mantle, &
+ reclen_ymin_crust_mantle,reclen_ymax_crust_mantle, &
+ nabs_xmin_cm,nabs_xmax_cm,nabs_ymin_cm,nabs_ymax_cm, &
+ absorb_xmin_crust_mantle5,absorb_xmax_crust_mantle5, &
+ absorb_ymin_crust_mantle5,absorb_ymax_crust_mantle5)
+#else
call compute_stacey_crust_mantle_backward(ichunk, &
NSTEP,it,ibool_crust_mantle, &
b_accel_crust_mantle, &
@@ -484,6 +534,7 @@
nabs_xmin_cm,nabs_xmax_cm,nabs_ymin_cm,nabs_ymax_cm, &
absorb_xmin_crust_mantle5,absorb_xmax_crust_mantle5, &
absorb_ymin_crust_mantle5,absorb_ymax_crust_mantle5)
+#endif
! call compute_stacey_crust_mantle(ichunk, &
! NSTEP,it,SAVE_FORWARD,ibool_crust_mantle, &
! veloc_crust_mantle,b_accel_crust_mantle, &
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/undo_att/src/specfem3D/compute_stacey_crust_mantle.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/undo_att/src/specfem3D/compute_stacey_crust_mantle.f90 2013-06-12 09:09:37 UTC (rev 22228)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/undo_att/src/specfem3D/compute_stacey_crust_mantle.f90 2013-06-12 09:49:51 UTC (rev 22229)
@@ -47,6 +47,7 @@
absorb_xmin_crust_mantle,absorb_xmax_crust_mantle, &
absorb_ymin_crust_mantle,absorb_ymax_crust_mantle)
+
implicit none
include "constants.h"
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/undo_att/src/specfem3D/specfem3D.F90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/undo_att/src/specfem3D/specfem3D.F90 2013-06-12 09:09:37 UTC (rev 22228)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/undo_att/src/specfem3D/specfem3D.F90 2013-06-12 09:49:51 UTC (rev 22229)
@@ -918,9 +918,9 @@
integer msg_status(MPI_STATUS_SIZE)
- real(kind=CUSTOM_REAL), dimension(:,:,:) :: displ_crust_mantle_store_as_bwf
- real(kind=CUSTOM_REAL), dimension(:,:) :: displ_outer_core_store_store_as_bwf
- real(kind=CUSTOM_REAL), dimension(:,:,:) :: displ_inner_core_store_as_bwf
+ real(kind=CUSTOM_REAL), dimension(:,:,:), allocatable :: displ_crust_mantle_store_as_bwf
+ real(kind=CUSTOM_REAL), dimension(:,:), allocatable :: displ_outer_core_store_store_as_bwf
+ real(kind=CUSTOM_REAL), dimension(:,:,:), allocatable :: displ_inner_core_store_as_bwf
integer :: iteration_on_subset,it_of_this_subset,j
integer :: it_temp,seismo_current_temp
@@ -1861,7 +1861,6 @@
endif ! MOVIE_VOLUME
! sets up time increments and rotation constants
- ! we keep the b_deltat,b_deltatover2,b_deltatsqover2,b_two_omega_earth which are just scalar variables
call prepare_timerun_constants(myrank,NSTEP, &
DT,t0,scale_t,scale_t_inv,scale_displ,scale_veloc, &
deltat,deltatover2,deltatsqover2, &
@@ -1869,6 +1868,13 @@
two_omega_earth,A_array_rotation,B_array_rotation, &
b_two_omega_earth, SIMULATION_TYPE)
+#ifdef UNDO_ATT
+ b_deltat = deltat
+ b_deltatover2 = deltatover2
+ b_deltatsqover2 = deltatsqover2
+ b_two_omega_earth = two_omega_earth
+#endif
+
! precomputes gravity factors
call prepare_timerun_gravity(myrank, &
minus_g_cmb,minus_g_icb, &
@@ -1879,7 +1885,6 @@
! precomputes attenuation factors
if(ATTENUATION_VAL) then
- ! we keep the b_alphaval,b_betaval,b_gammaval which are just scalar variables
call prepare_timerun_attenuation(myrank, &
factor_scale_crust_mantle,one_minus_sum_beta_crust_mantle,factor_common_crust_mantle, &
factor_scale_inner_core,one_minus_sum_beta_inner_core,factor_common_inner_core, &
@@ -1894,6 +1899,13 @@
c33store_inner_core,c44store_inner_core, &
alphaval,betaval,gammaval,b_alphaval,b_betaval,b_gammaval, &
deltat,b_deltat,LOCAL_PATH)
+
+#ifdef UNDO_ATT
+ b_alphaval = alphaval
+ b_betaval = betaval
+ b_gammaval = gammaval
+#endif
+
endif
if(myrank == 0) then
@@ -2217,11 +2229,26 @@
if(SIMULATION_TYPE == 2)then
!!add this part
!ZN !ZN we need to be careful to arrange this part
-!ZN ! save source derivatives for adjoint simulations
-!ZN if (SIMULATION_TYPE == 2 .and. nrec_local > 0) then
-!ZN call save_kernels_source_derivatives(nrec_local,NSOURCES,scale_displ,scale_t, &
-!ZN nu_source,moment_der,sloc_der,stshift_der,shdur_der,number_receiver_global)
-!ZN endif
+
+ it = 0
+ do iteration_on_subset = 1, NSTEP / NT_500
+
+ do it_of_this_subset = 1, NT_500
+
+ it = it + 1
+
+ seismo_current = seismo_current + 1
+
+ include "part1_undo_att.F90"
+
+ ! save source derivatives for adjoint simulations
+ if (SIMULATION_TYPE == 2 .and. nrec_local > 0) then
+ call save_kernels_source_derivatives(nrec_local,NSOURCES,scale_displ,scale_t, &
+ nu_source,moment_der,sloc_der,stshift_der,shdur_der,number_receiver_global)
+ endif
+
+ enddo
+ enddo
endif
if(SIMULATION_TYPE == 3)then
@@ -2478,7 +2505,6 @@
endif
endif
- !ZN we need to be careful to arrange this part
! save source derivatives for adjoint simulations
if (SIMULATION_TYPE == 2 .and. nrec_local > 0) then
call save_kernels_source_derivatives(nrec_local,NSOURCES,scale_displ,scale_t, &
More information about the CIG-COMMITS
mailing list