[cig-commits] r22219 - seismo/3D/SPECFEM3D_GLOBE/branches/undo_att/src/specfem3D
xie.zhinan at geodynamics.org
xie.zhinan at geodynamics.org
Tue Jun 11 10:56:24 PDT 2013
Author: xie.zhinan
Date: 2013-06-11 10:56:24 -0700 (Tue, 11 Jun 2013)
New Revision: 22219
Modified:
seismo/3D/SPECFEM3D_GLOBE/branches/undo_att/src/specfem3D/save_forward_arrays.f90
seismo/3D/SPECFEM3D_GLOBE/branches/undo_att/src/specfem3D/specfem3D.F90
Log:
modify the time loop
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/undo_att/src/specfem3D/save_forward_arrays.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/undo_att/src/specfem3D/save_forward_arrays.f90 2013-06-11 16:36:40 UTC (rev 22218)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/undo_att/src/specfem3D/save_forward_arrays.f90 2013-06-11 17:56:24 UTC (rev 22219)
@@ -120,3 +120,85 @@
endif
end subroutine save_forward_arrays
+!
+!=====================================================================
+
+ subroutine save_forward_arrays_undoatt(myrank,SIMULATION_TYPE,SAVE_FORWARD, &
+ NUMBER_OF_RUNS,NUMBER_OF_THIS_RUN, &
+ displ_crust_mantle,veloc_crust_mantle,accel_crust_mantle, &
+ displ_inner_core,veloc_inner_core,accel_inner_core, &
+ displ_outer_core,veloc_outer_core,accel_outer_core, &
+ R_memory_crust_mantle,R_memory_inner_core, &
+ epsilondev_crust_mantle,epsilondev_inner_core, &
+ A_array_rotation,B_array_rotation, &
+ LOCAL_PATH,iteration_on_subset)
+
+ implicit none
+
+ include "constants.h"
+ include "OUTPUT_FILES/values_from_mesher.h"
+
+ integer myrank
+
+ integer SIMULATION_TYPE
+ logical SAVE_FORWARD
+ integer NUMBER_OF_RUNS,NUMBER_OF_THIS_RUN
+
+ real(kind=CUSTOM_REAL), dimension(NDIM,NGLOB_CRUST_MANTLE) :: &
+ displ_crust_mantle,veloc_crust_mantle,accel_crust_mantle
+ real(kind=CUSTOM_REAL), dimension(NDIM,NGLOB_INNER_CORE) :: &
+ displ_inner_core,veloc_inner_core,accel_inner_core
+ real(kind=CUSTOM_REAL), dimension(NGLOB_OUTER_CORE) :: &
+ displ_outer_core,veloc_outer_core,accel_outer_core
+
+ real(kind=CUSTOM_REAL), dimension(5,N_SLS,NGLLX,NGLLY,NGLLZ,NSPEC_CRUST_MANTLE_ATTENUAT) :: &
+ R_memory_crust_mantle
+ real(kind=CUSTOM_REAL), dimension(5,NGLLX,NGLLY,NGLLZ,NSPEC_CRUST_MANTLE_STR_OR_ATT) :: &
+ epsilondev_crust_mantle
+ real(kind=CUSTOM_REAL), dimension(5,N_SLS,NGLLX,NGLLY,NGLLZ,NSPEC_INNER_CORE_ATTENUATION) :: &
+ R_memory_inner_core
+ real(kind=CUSTOM_REAL), dimension(5,NGLLX,NGLLY,NGLLZ,NSPEC_INNER_CORE_STR_OR_ATT) :: &
+ epsilondev_inner_core
+
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_OUTER_CORE_ROTATION) :: &
+ A_array_rotation,B_array_rotation
+
+ character(len=150) LOCAL_PATH
+
+ integer iteration_on_subset
+
+ ! local parameters
+ character(len=150) outputname
+
+
+ ! save files to local disk or tape system if restart file
+ if(NUMBER_OF_RUNS > 1) stop 'NUMBER_OF_RUNS > 1 is not support for undoing attenuation'
+
+ ! save last frame of the forward simulation
+ if (SIMULATION_TYPE == 1 .and. SAVE_FORWARD) then
+ write(outputname,'(a,i6.6,a,i6.6)') 'proc',myrank,'_save_frame_at',iteration_on_subset
+ open(unit=55,file=trim(LOCAL_PATH)//'/'//outputname,status='unknown',form='unformatted',action='write')
+ write(55) displ_crust_mantle
+ write(55) veloc_crust_mantle
+ write(55) accel_crust_mantle
+ write(55) displ_inner_core
+ write(55) veloc_inner_core
+ write(55) accel_inner_core
+ write(55) displ_outer_core
+ write(55) veloc_outer_core
+ write(55) accel_outer_core
+ write(55) epsilondev_crust_mantle
+ write(55) epsilondev_inner_core
+ if (ROTATION_VAL) then
+ write(55) A_array_rotation
+ write(55) B_array_rotation
+ endif
+ if (ATTENUATION_VAL) then
+ write(55) R_memory_crust_mantle
+ write(55) R_memory_inner_core
+ endif
+ close(55)
+ endif
+
+ end subroutine save_forward_arrays_undoatt
+
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-11 16:36:40 UTC (rev 22218)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/undo_att/src/specfem3D/specfem3D.F90 2013-06-11 17:56:24 UTC (rev 22219)
@@ -918,15 +918,15 @@
integer msg_status(MPI_STATUS_SIZE)
- include "declaration_part_for_backward_wavefield_simulation.f90"
-
-#ifdef UNDO_ATT
- integer :: iteration_on_subset,it_of_this_subset
+#ifdef UNDO_ATT_SIM3
real(kind=CUSTOM_REAL), dimension(NDIM,NGLOB_CRUST_MANTLE,NT_500) :: displ_crust_mantle_store_as_bwf
real(kind=CUSTOM_REAL), dimension(NGLOB_OUTER_CORE,NT_500) :: displ_outer_core_store_store_as_bwf
real(kind=CUSTOM_REAL), dimension(NDIM,NGLOB_INNER_CORE,NT_500) :: displ_inner_core_store_as_bwf
#endif
+ integer :: iteration_on_subset,it_of_this_subset
+
+ include "declaration_part_for_backward_wavefield_simulation.f90"
! *************************************************
@@ -1175,9 +1175,8 @@
!ZN allocate(b_buffer_send_faces(1,1,1), &
!ZN b_buffer_received_faces(1,1,1),stat=ier)
!ZN endif
+!ZN if( ier /= 0 ) call exit_MPI(myrank,'error allocating mpi b_buffer')
- if( ier /= 0 ) call exit_MPI(myrank,'error allocating mpi b_buffer')
-
call fix_non_blocking_slices(is_on_a_slice_edge_crust_mantle,iboolright_xi_crust_mantle, &
iboolleft_xi_crust_mantle,iboolright_eta_crust_mantle,iboolleft_eta_crust_mantle, &
npoin2D_xi_crust_mantle,npoin2D_eta_crust_mantle,ibool_crust_mantle, &
@@ -2154,35 +2153,94 @@
!! DK DK this should not be difficult to fix and test, but not done yet by lack of time
if(NUMBER_OF_RUNS /= 1) stop 'NUMBER_OF_RUNS should be == 1 for now when using compile flag UNDO_ATT'
- it = 0
- do iteration_on_subset = 1, NSTEP / NT_500
- do it_of_this_subset = 1, NT_500
-
- it = it + 1
-! if(myrank == 0) print *,'doing time step ',it
-
- ! update position in seismograms
- seismo_current = seismo_current + 1
-
+!
+!-------------------------------------------------------------------------------
+!
+!Old part of Dimitri
+!! DK DK it = 0
+!! DK DK do iteration_on_subset = 1, NSTEP / NT_500
+!! DK DK do it_of_this_subset = 1, NT_500
!! DK DK
-!! DK DK this first part handles the cases SIMULATION_TYPE == 1 and SIMULATION_TYPE == 2
-!! DK DK it also handles the cases NOISE_TOMOGRAPHY == 1 and NOISE_TOMOGRAPHY == 2
+!! DK DK it = it + 1
+!! DK DK! if(myrank == 0) print *,'doing time step ',it
!! DK DK
- include "part1_undo_att.F90"
-
+!! DK DK ! update position in seismograms
+!! DK DK seismo_current = seismo_current + 1
!! DK DK
-!! DK DK this first part handles the case SIMULATION_TYPE == 3
-!! DK DK it also handles the case NOISE_TOMOGRAPHY == 3
+!! DK DK!! DK DK
+!! DK DK!! DK DK this first part handles the cases SIMULATION_TYPE == 1 and SIMULATION_TYPE == 2
+!! DK DK!! DK DK it also handles the cases NOISE_TOMOGRAPHY == 1 and NOISE_TOMOGRAPHY == 2
+!! DK DK!! DK DK
+!! DK DK include "part1_undo_att.F90"
!! DK DK
- include "part2_undo_att.F90"
+!! DK DK!! DK DK
+!! DK DK!! DK DK this first part handles the case SIMULATION_TYPE == 3
+!! DK DK!! DK DK it also handles the case NOISE_TOMOGRAPHY == 3
+!! DK DK!! DK DK
+!! DK DK include "part2_undo_att.F90"
+!! DK DK
+!! DK DK include "part3_kernel_computation.F90"
+!! DK DK
+!!! DK DK
+!! DK DK!---- end of time iteration loop
+!! DK DK!
+!! DK DK enddo
+!! DK DK enddo ! end of main time loop
+!
+!-------------------------------------------------------------------------------
+!
+!New part of ZN
+ if(SIMULATION_TYPE == 1)then
+ it = 0
+ do iteration_on_subset = 1, NSTEP / NT_500
+ ! save files to local disk or tape system if restart file
+ if(iteration_on_subset /= NT_500)then
+ call save_forward_arrays_undoatt(myrank,SIMULATION_TYPE,SAVE_FORWARD, &
+ NUMBER_OF_RUNS,NUMBER_OF_THIS_RUN, &
+ displ_crust_mantle,veloc_crust_mantle,accel_crust_mantle, &
+ displ_inner_core,veloc_inner_core,accel_inner_core, &
+ displ_outer_core,veloc_outer_core,accel_outer_core, &
+ R_memory_crust_mantle,R_memory_inner_core, &
+ epsilondev_crust_mantle,epsilondev_inner_core, &
+ A_array_rotation,B_array_rotation,LOCAL_PATH,iteration_on_subset)
+ endif
- include "part3_kernel_computation.F90"
+ do it_of_this_subset = 1, NT_500
+ it = it + 1
+! if(myrank == 0) print *,'doing time step ',it
+
+ ! update position in seismograms
+ seismo_current = seismo_current + 1
+
+ include "part1_undo_att.F90"
+
+ enddo
+ enddo ! end of main time loop
+
+ endif
+
+ if(SIMULATION_TYPE == 3)then
+ it = 0
+ do iteration_on_subset = 1, NSTEP / NT_500
+ do it_of_this_subset = 1, NT_500
+
+ it = it + 1
+! if(myrank == 0) print *,'doing time step ',it
+
+ ! update position in seismograms
+ seismo_current = seismo_current + 1
+
+ include "part1_undo_att.F90"
+
+ include "part3_kernel_computation.F90"
+
!
!---- end of time iteration loop
!
- enddo
- enddo ! end of main time loop
+ enddo
+ enddo ! end of main time loop
+ endif
#endif
@@ -2268,6 +2326,9 @@
call MPI_BARRIER(MPI_COMM_WORLD,ier)
if( ier /= 0 ) call exit_mpi(myrank,'error synchronize closing snapshots')
+#ifdef UNDO_ATT
+ !ZN we move this part of code inside the time loop above
+#else
! save files to local disk or tape system if restart file
call save_forward_arrays(myrank,SIMULATION_TYPE,SAVE_FORWARD, &
NUMBER_OF_RUNS,NUMBER_OF_THIS_RUN, &
@@ -2277,6 +2338,7 @@
R_memory_crust_mantle,R_memory_inner_core, &
epsilondev_crust_mantle,epsilondev_inner_core, &
A_array_rotation,B_array_rotation,LOCAL_PATH)
+#endif
! synchronize all processes
call MPI_BARRIER(MPI_COMM_WORLD,ier)
More information about the CIG-COMMITS
mailing list