[cig-commits] [commit] devel: small updates for file names of source derivatives for adjoint simulations (0ada5f3)
cig_noreply at geodynamics.org
cig_noreply at geodynamics.org
Thu Nov 6 08:33:21 PST 2014
Repository : https://github.com/geodynamics/specfem3d_globe
On branch : devel
Link : https://github.com/geodynamics/specfem3d_globe/compare/bc58e579b3b0838a0968725a076f5904845437ca...be63f20cbb6f462104e949894dbe205d2398cd7f
>---------------------------------------------------------------
commit 0ada5f31167bfa82adbd1dad7f550632015f5697
Author: daniel peter <peterda at ethz.ch>
Date: Tue Nov 4 15:32:43 2014 +0100
small updates for file names of source derivatives for adjoint simulations
>---------------------------------------------------------------
0ada5f31167bfa82adbd1dad7f550632015f5697
src/specfem3D/finalize_simulation.f90 | 8 ++--
src/specfem3D/initialize_simulation.f90 | 1 +
src/specfem3D/save_kernels.F90 | 6 ++-
src/specfem3D/setup_sources_receivers.f90 | 68 +++++++++++++++++--------------
src/specfem3D/specfem3D_par.F90 | 3 +-
5 files changed, 48 insertions(+), 38 deletions(-)
diff --git a/src/specfem3D/finalize_simulation.f90 b/src/specfem3D/finalize_simulation.f90
index 191e854..1117acf 100644
--- a/src/specfem3D/finalize_simulation.f90
+++ b/src/specfem3D/finalize_simulation.f90
@@ -239,14 +239,14 @@
! receivers
deallocate(islice_selected_rec,ispec_selected_rec, &
- xi_receiver,eta_receiver,gamma_receiver)
+ xi_receiver,eta_receiver,gamma_receiver)
deallocate(station_name,network_name, &
- stlat,stlon,stele,stbur)
+ stlat,stlon,stele,stbur)
deallocate(nu,number_receiver_global)
if (nrec_local > 0) then
deallocate(hxir_store, &
- hetar_store, &
- hgammar_store)
+ hetar_store, &
+ hgammar_store)
if (SIMULATION_TYPE == 2) then
deallocate(moment_der,stshift_der)
endif
diff --git a/src/specfem3D/initialize_simulation.f90 b/src/specfem3D/initialize_simulation.f90
index 85e1dee..3771015 100644
--- a/src/specfem3D/initialize_simulation.f90
+++ b/src/specfem3D/initialize_simulation.f90
@@ -375,6 +375,7 @@
if (SIMULATION_TYPE /= 1 .and. SIMULATION_TYPE /= 2 .and. SIMULATION_TYPE /= 3) &
call exit_MPI(myrank, 'SIMULATION_TYPE can only be 1, 2, or 3')
+ ! checks number of sources for adjoint simulations
if (SIMULATION_TYPE /= 1 .and. NSOURCES > 999999) &
call exit_MPI(myrank,'for adjoint simulations, NSOURCES <= 999999, if you need more change i6.6 in write_seismograms.f90')
diff --git a/src/specfem3D/save_kernels.F90 b/src/specfem3D/save_kernels.F90
index 8ee1994..6e6a7f6 100644
--- a/src/specfem3D/save_kernels.F90
+++ b/src/specfem3D/save_kernels.F90
@@ -732,7 +732,7 @@
! local parameters
real(kind=CUSTOM_REAL),parameter :: scale_mass = RHOAV * (R_EARTH**3)
integer :: irec_local
- character(len=MAX_STRING_LEN) outputname
+ character(len=MAX_STRING_LEN) :: outputname
!scale_mass = RHOAV * (R_EARTH**3)
@@ -751,7 +751,7 @@
! writes out kernels to file
if (.not. ( ADIOS_ENABLED .and. ADIOS_FOR_KERNELS )) then
- write(outputname,'(a,i5.5)') 'OUTPUT_FILES/src_frechet.',number_receiver_global(irec_local)
+ write(outputname,'(a,i6.6)') 'OUTPUT_FILES/src_frechet.',number_receiver_global(irec_local)
open(unit=IOUT,file=trim(outputname),status='unknown',action='write')
!
! r -> z, theta -> -n, phi -> e, plus factor 2 for Mrt,Mrp,Mtp, and 1e-7 to dyne.cm
@@ -772,8 +772,10 @@
write(IOUT,'(g16.5)') sloc_der(2,irec_local)
write(IOUT,'(g16.5)') sloc_der(1,irec_local)
write(IOUT,'(g16.5)') -sloc_der(3,irec_local)
+
write(IOUT,'(g16.5)') stshift_der(irec_local)
write(IOUT,'(g16.5)') shdur_der(irec_local)
+
close(IOUT)
endif
enddo
diff --git a/src/specfem3D/setup_sources_receivers.f90 b/src/specfem3D/setup_sources_receivers.f90
index ddcb10b..c3a319d 100644
--- a/src/specfem3D/setup_sources_receivers.f90
+++ b/src/specfem3D/setup_sources_receivers.f90
@@ -178,7 +178,8 @@
! define t0 as the earliest start time
t0 = - 1.5d0*minval( tshift_cmt(:) - hdur(:) )
- if ( EXTERNAL_SOURCE_TIME_FUNCTION ) then
+ ! uses an external file for source time function, which starts at time 0.0
+ if (EXTERNAL_SOURCE_TIME_FUNCTION) then
hdur(:) = 0._CUSTOM_REAL
t0 = 0.d0
endif
@@ -337,6 +338,7 @@
! local parameters
integer :: irec,isource,nrec_tot_found
+ integer :: nrec_simulation
integer :: nadj_files_found,nadj_files_found_tot
integer :: ier
integer,dimension(:),allocatable :: tmp_rec_local_all
@@ -411,11 +413,12 @@
! temporary counter to check if any files are found at all
nadj_files_found = 0
do irec = 1,nrec
- if (myrank == islice_selected_rec(irec)) then
- ! adjoint receiver station in this process slice
- if (islice_selected_rec(irec) < 0 .or. islice_selected_rec(irec) > NPROCTOT_VAL-1) &
- call exit_MPI(myrank,'something is wrong with the source slice number in adjoint simulation')
+ ! checks if slice is valid
+ if (islice_selected_rec(irec) < 0 .or. islice_selected_rec(irec) > NPROCTOT_VAL-1) &
+ call exit_MPI(myrank,'something is wrong with the source slice number in adjoint simulation')
+ ! adjoint receiver station in this process slice
+ if (myrank == islice_selected_rec(irec)) then
! updates counter
nadj_rec_local = nadj_rec_local + 1
@@ -455,6 +458,7 @@
if (myrank == 0 .and. nrec_tot_found /= nrec) &
call exit_MPI(myrank,'total number of receivers is incorrect')
endif
+ call synchronize_all()
! statistics about allocation memory for seismograms & adj_sourcearrays
! gathers info about receivers on master
@@ -855,6 +859,7 @@
! local parameters
integer :: ier
+ integer :: nadj_hprec_local
! define local to global receiver numbering mapping
! needs to be allocated for subroutine calls (even if nrec_local == 0)
@@ -865,8 +870,8 @@
if (nrec_local > 0) then
! allocates Lagrange interpolators for receivers
allocate(hxir_store(nrec_local,NGLLX), &
- hetar_store(nrec_local,NGLLY), &
- hgammar_store(nrec_local,NGLLZ),stat=ier)
+ hetar_store(nrec_local,NGLLY), &
+ hgammar_store(nrec_local,NGLLZ),stat=ier)
if (ier /= 0 ) call exit_MPI(myrank,'Error allocating receiver interpolators')
! defines and stores Lagrange interpolators at all the receivers
@@ -876,8 +881,8 @@
nadj_hprec_local = 1
endif
allocate(hpxir_store(nadj_hprec_local,NGLLX), &
- hpetar_store(nadj_hprec_local,NGLLY), &
- hpgammar_store(nadj_hprec_local,NGLLZ),stat=ier)
+ hpetar_store(nadj_hprec_local,NGLLY), &
+ hpgammar_store(nadj_hprec_local,NGLLZ),stat=ier)
if (ier /= 0 ) call exit_MPI(myrank,'Error allocating derivative interpolators')
! stores interpolators for receiver positions
@@ -899,16 +904,16 @@
! adjoint seismograms
allocate(seismograms(NDIM*NDIM,nrec_local,NTSTEP_BETWEEN_OUTPUT_SEISMOS),stat=ier)
if (ier /= 0) stop 'Error while allocating adjoint seismograms'
+
! allocates Frechet derivatives array
allocate(moment_der(NDIM,NDIM,nrec_local),sloc_der(NDIM,nrec_local), &
- stshift_der(nrec_local),shdur_der(nrec_local),stat=ier)
+ stshift_der(nrec_local),shdur_der(nrec_local),stat=ier)
if (ier /= 0 ) call exit_MPI(myrank,'Error allocating Frechet derivatives arrays')
moment_der(:,:,:) = 0._CUSTOM_REAL
sloc_der(:,:) = 0._CUSTOM_REAL
stshift_der(:) = 0._CUSTOM_REAL
shdur_der(:) = 0._CUSTOM_REAL
-
endif
! initializes seismograms
seismograms(:,:,:) = 0._CUSTOM_REAL
@@ -940,7 +945,7 @@
implicit none
- integer NSOURCES,myrank
+ integer :: NSOURCES,myrank
integer, dimension(NSOURCES) :: islice_selected_source
@@ -950,9 +955,9 @@
double precision, dimension(NGLLZ) :: zigll
- integer SIMULATION_TYPE
+ integer :: SIMULATION_TYPE
- integer nrec,nrec_local
+ integer :: nrec,nrec_local
integer, dimension(nrec) :: islice_selected_rec
integer, dimension(nrec_local) :: number_receiver_global
double precision, dimension(nrec) :: xi_receiver,eta_receiver,gamma_receiver
@@ -961,7 +966,7 @@
double precision, dimension(nrec_local,NGLLY) :: hetar_store
double precision, dimension(nrec_local,NGLLZ) :: hgammar_store
- integer nadj_hprec_local
+ integer :: nadj_hprec_local
double precision, dimension(nadj_hprec_local,NGLLX) :: hpxir_store
double precision, dimension(nadj_hprec_local,NGLLY) :: hpetar_store
double precision, dimension(nadj_hprec_local,NGLLZ) :: hpgammar_store
@@ -995,30 +1000,33 @@
endif
! define and store Lagrange interpolators at all the receivers
- if (SIMULATION_TYPE == 1 .or. SIMULATION_TYPE == 3) then
- do irec_local = 1,nrec_local
- irec = number_receiver_global(irec_local)
+ do irec_local = 1,nrec_local
+ irec = number_receiver_global(irec_local)
+
+ if (SIMULATION_TYPE == 1 .or. SIMULATION_TYPE == 3) then
+ ! receiver positions
call lagrange_any(xi_receiver(irec),NGLLX,xigll,hxir,hpxir)
call lagrange_any(eta_receiver(irec),NGLLY,yigll,hetar,hpetar)
call lagrange_any(gamma_receiver(irec),NGLLZ,zigll,hgammar,hpgammar)
- hxir_store(irec_local,:) = hxir(:)
- hetar_store(irec_local,:) = hetar(:)
- hgammar_store(irec_local,:) = hgammar(:)
- enddo
- else
- do irec_local = 1,nrec_local
- irec = number_receiver_global(irec_local)
+ else
+ ! source positions
call lagrange_any(xi_source(irec),NGLLX,xigll,hxir,hpxir)
call lagrange_any(eta_source(irec),NGLLY,yigll,hetar,hpetar)
call lagrange_any(gamma_source(irec),NGLLZ,zigll,hgammar,hpgammar)
- hxir_store(irec_local,:) = hxir(:)
- hetar_store(irec_local,:) = hetar(:)
- hgammar_store(irec_local,:) = hgammar(:)
+ endif
+
+ ! stores interpolators
+ hxir_store(irec_local,:) = hxir(:)
+ hetar_store(irec_local,:) = hetar(:)
+ hgammar_store(irec_local,:) = hgammar(:)
+
+ ! stores derivatives
+ if (SIMULATION_TYPE == 2) then
hpxir_store(irec_local,:) = hpxir(:)
hpetar_store(irec_local,:) = hpetar(:)
hpgammar_store(irec_local,:) = hpgammar(:)
- enddo
- endif
+ endif
+ enddo
end subroutine setup_sources_receivers_intp
diff --git a/src/specfem3D/specfem3D_par.F90 b/src/specfem3D/specfem3D_par.F90
index 7da5b42..c28b604 100644
--- a/src/specfem3D/specfem3D_par.F90
+++ b/src/specfem3D/specfem3D_par.F90
@@ -174,7 +174,7 @@ module specfem_par
! asynchronous read buffer when IO_ASYNC_COPY is set
real(kind=CUSTOM_REAL), dimension(:,:,:,:,:,:), allocatable :: buffer_sourcearrays
- integer :: nrec_simulation, nadj_rec_local
+ integer :: nadj_rec_local
integer :: NSTEP_SUB_ADJ ! to read input in chunks
integer, dimension(:,:), allocatable :: iadjsrc ! to read input in chunks
@@ -185,7 +185,6 @@ module specfem_par
real(kind=CUSTOM_REAL), dimension(:,:), allocatable :: sloc_der
real(kind=CUSTOM_REAL), dimension(:), allocatable :: stshift_der, shdur_der
double precision, dimension(:,:), allocatable :: hpxir_store,hpetar_store,hpgammar_store
- integer :: nadj_hprec_local
!-----------------------------------------------------------------
More information about the CIG-COMMITS
mailing list