[cig-commits] [commit] devel: updates naming convention for adjoint seismograms and NSOURCES limit to 999, 999 for adjoint simulations (cb7bfc5)
cig_noreply at geodynamics.org
cig_noreply at geodynamics.org
Tue Nov 4 06:02:51 PST 2014
Repository : https://github.com/geodynamics/specfem3d
On branch : devel
Link : https://github.com/geodynamics/specfem3d/compare/c7475fd92655192fa2da88247549f99195ce5352...cb7bfc51f679e2435b93e9ea71851c0ca59e7e6e
>---------------------------------------------------------------
commit cb7bfc51f679e2435b93e9ea71851c0ca59e7e6e
Author: daniel peter <peterda at ethz.ch>
Date: Tue Nov 4 14:42:12 2014 +0100
updates naming convention for adjoint seismograms and NSOURCES limit to 999,999 for adjoint simulations
>---------------------------------------------------------------
cb7bfc51f679e2435b93e9ea71851c0ca59e7e6e
src/cuda/specfem3D_gpu_cuda_method_stubs.c | 64 +++++++-------
src/specfem3D/check_stability.f90 | 2 +
src/specfem3D/finalize_simulation.f90 | 65 ++++----------
src/specfem3D/initialize_simulation.f90 | 5 +-
src/specfem3D/iterate_time.F90 | 1 +
src/specfem3D/prepare_timerun.F90 | 1 +
src/specfem3D/save_adjoint_kernels.f90 | 112 ++++++++++++++++++++----
src/specfem3D/setup_sources_receivers.f90 | 71 ++++++++-------
src/specfem3D/specfem3D_par.f90 | 4 -
src/specfem3D/write_movie_output.f90 | 3 +
src/specfem3D/write_seismograms.f90 | 70 +++++++--------
utils/create_specfem3D_gpu_cuda_method_stubs.pl | 9 +-
12 files changed, 233 insertions(+), 174 deletions(-)
diff --git a/src/cuda/specfem3D_gpu_cuda_method_stubs.c b/src/cuda/specfem3D_gpu_cuda_method_stubs.c
index 61d35cb..be08e1f 100644
--- a/src/cuda/specfem3D_gpu_cuda_method_stubs.c
+++ b/src/cuda/specfem3D_gpu_cuda_method_stubs.c
@@ -1,31 +1,31 @@
/*
- !=====================================================================
- !
- ! S p e c f e m 3 D V e r s i o n 2 . 1
- ! ---------------------------------------
- !
- ! Main historical authors: Dimitri Komatitsch and Jeroen Tromp
- ! Princeton University, USA
- ! and CNRS / University of Marseille, France
- ! (there are currently many more authors!)
- ! (c) Princeton University and CNRS / University of Marseille, July 2012
- !
- ! This program is free software; you can redistribute it and/or modify
- ! it under the terms of the GNU General Public License as published by
- ! the Free Software Foundation; either version 2 of the License, or
- ! (at your option) any later version.
- !
- ! This program is distributed in the hope that it will be useful,
- ! but WITHOUT ANY WARRANTY; without even the implied warranty of
- ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- ! GNU General Public License for more details.
- !
- ! You should have received a copy of the GNU General Public License along
- ! with this program; if not, write to the Free Software Foundation, Inc.,
- ! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
- !
- !=====================================================================
- */
+!=====================================================================
+!
+! S p e c f e m 3 D V e r s i o n 2 . 1
+! ---------------------------------------
+!
+! Main historical authors: Dimitri Komatitsch and Jeroen Tromp
+! Princeton University, USA
+! and CNRS / University of Marseille, France
+! (there are currently many more authors!)
+! (c) Princeton University and CNRS / University of Marseille, July 2012
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 2 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along
+! with this program; if not, write to the Free Software Foundation, Inc.,
+! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+!
+!=====================================================================
+*/
#include <stdio.h>
#include <stdlib.h>
@@ -91,6 +91,11 @@ void FC_FUNC_(transfer_asmbl_accel_to_device,
// int* ibool_interfaces_ext_mesh,
// int* FORWARD_OR_ADJOINT) {}
+void FC_FUNC_(sync_copy_from_device,
+ SYNC_copy_FROM_DEVICE)(long* Mesh_pointer,
+ int* iphase,
+ realw* send_buffer) {}
+
//
// src/cuda/check_fields_cuda.cu
@@ -256,11 +261,6 @@ void FC_FUNC_(compute_forces_viscoelastic_cuda,
int* ATTENUATION,
int* ANISOTROPY) {}
-void FC_FUNC_(sync_copy_from_device,
- SYNC_copy_FROM_DEVICE)(long* Mesh_pointer,
- int* iphase,
- realw* send_buffer) {}
-
//
// src/cuda/compute_kernels_cuda.cu
diff --git a/src/specfem3D/check_stability.f90 b/src/specfem3D/check_stability.f90
index 30dd262..2cff5cd 100644
--- a/src/specfem3D/check_stability.f90
+++ b/src/specfem3D/check_stability.f90
@@ -63,6 +63,8 @@
character(len=5) :: zone
integer, dimension(8) :: time_values
+ character(len=MAX_STRING_LEN) :: outputname
+
character(len=3), dimension(12) :: month_name
character(len=3), dimension(0:6) :: weekday_name
data month_name /'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', 'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'/
diff --git a/src/specfem3D/finalize_simulation.f90 b/src/specfem3D/finalize_simulation.f90
index d880c43..f1a8f2d 100644
--- a/src/specfem3D/finalize_simulation.f90
+++ b/src/specfem3D/finalize_simulation.f90
@@ -39,7 +39,6 @@
implicit none
- integer :: irec_local
integer :: ier
! write gravity perturbations
@@ -97,22 +96,31 @@
close(IOUT)
endif
+ endif
-! adjoint simulations
- else if (SIMULATION_TYPE == 3) then
-
+ ! adjoint simulations
+ if (SIMULATION_TYPE == 3) then
! adjoint kernels
call save_adjoint_kernels()
+ endif
+ ! seismograms and source parameter gradients for (pure type=2) adjoint simulation runs
+ if (SIMULATION_TYPE == 2) then
+ if (nrec_local > 0) then
+ ! seismograms (strain)
+ call write_adj_seismograms2_to_file(myrank,seismograms_eps,number_receiver_global,nrec_local,it,DT,NSTEP,t0)
+ ! source gradients (for sources in elastic domains)
+ call save_kernels_source_derivatives()
+ endif
endif
-! closing source time function file
+ ! closing source time function file
if(PRINT_SOURCE_TIME_FUNCTION .and. myrank == 0) then
close(IOSTF)
endif
-! stacey absorbing fields will be reconstructed for adjoint simulations
-! using snapshot files of wavefields
+ ! stacey absorbing fields will be reconstructed for adjoint simulations
+ ! using snapshot files of wavefields
if( STACEY_ABSORBING_CONDITIONS ) then
! closes absorbing wavefield saved/to-be-saved by forward simulations
if( num_abs_boundary_faces > 0 .and. (SIMULATION_TYPE == 3 .or. &
@@ -124,46 +132,7 @@
endif
endif
-! seismograms and source parameter gradients for (pure type=2) adjoint simulation runs
- if (nrec_local > 0) then
- if (.not. (SIMULATION_TYPE == 1 .or. SIMULATION_TYPE == 3)) then
- ! seismograms
- call write_adj_seismograms2_to_file(myrank,seismograms_eps,number_receiver_global,nrec_local,it,DT,NSTEP,t0)
-
- ! source gradients (for sources in elastic domains)
- do irec_local = 1, nrec_local
- write(outputname,'(a,i5.5)') OUTPUT_FILES_PATH(1:len_trim(OUTPUT_FILES_PATH)) // &
- '/src_frechet.',number_receiver_global(irec_local)
- open(unit=IOUT,file=trim(outputname),status='unknown',iostat=ier)
- if( ier /= 0 ) then
- print*,'error opening file: ',trim(outputname)
- call exit_mpi(myrank,'error opening file src_frechet.**')
- endif
- !
- ! r -> z, theta -> -y, phi -> x
- !
- ! Mrr = Mzz
- ! Mtt = Myy
- ! Mpp = Mxx
- ! Mrt = -Myz
- ! Mrp = Mxz
- ! Mtp = -Mxy
- write(IOUT,*) Mzz_der(irec_local)
- write(IOUT,*) Myy_der(irec_local)
- write(IOUT,*) Mxx_der(irec_local)
- write(IOUT,*) -Myz_der(irec_local)
- write(IOUT,*) Mxz_der(irec_local)
- write(IOUT,*) -Mxy_der(irec_local)
- write(IOUT,*) sloc_der(1,irec_local)
- write(IOUT,*) sloc_der(2,irec_local)
- write(IOUT,*) sloc_der(3,irec_local)
- close(IOUT)
- enddo
- endif
- endif
-
! frees dynamically allocated memory
-
if (USE_FORCE_POINT_SOURCE) then
deallocate(factor_force_source)
deallocate(comp_dir_vect_source_E)
@@ -292,7 +261,7 @@
call adios_cleanup()
endif
-! close the main output file
+ ! close the main output file
if(myrank == 0) then
write(IMAIN,*)
write(IMAIN,*) 'End of the simulation'
@@ -300,7 +269,7 @@
close(IMAIN)
endif
-! synchronize all the processes to make sure everybody has finished
+ ! synchronize all the processes to make sure everybody has finished
call synchronize_all()
end subroutine finalize_simulation
diff --git a/src/specfem3D/initialize_simulation.f90 b/src/specfem3D/initialize_simulation.f90
index 5298b99..49ae073 100644
--- a/src/specfem3D/initialize_simulation.f90
+++ b/src/specfem3D/initialize_simulation.f90
@@ -391,7 +391,10 @@
implicit none
! check simulation parameters
- if (SIMULATION_TYPE /= 1 .and. NSOURCES > 1000) call exit_mpi(myrank, 'for adjoint simulations, NSOURCES <= 1000')
+
+ ! 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')
! snapshot file names: ADJOINT attenuation
if (ATTENUATION .and. ((SIMULATION_TYPE == 1 .and. SAVE_FORWARD) .or. SIMULATION_TYPE == 3)) &
diff --git a/src/specfem3D/iterate_time.F90 b/src/specfem3D/iterate_time.F90
index daf7f17..b66cb2f 100644
--- a/src/specfem3D/iterate_time.F90
+++ b/src/specfem3D/iterate_time.F90
@@ -324,6 +324,7 @@
implicit none
integer :: ier
+ character(len=MAX_STRING_LEN) :: outputname
if( it > 1 .and. it < NSTEP) then
! adjoint simulations
diff --git a/src/specfem3D/prepare_timerun.F90 b/src/specfem3D/prepare_timerun.F90
index 9fb6e7c..67e05de 100644
--- a/src/specfem3D/prepare_timerun.F90
+++ b/src/specfem3D/prepare_timerun.F90
@@ -1643,6 +1643,7 @@
double precision :: common_multiplying_factor,common_mult_times_one_over,common_mult_times_three_over
integer :: iobservation
+ character(len=MAX_STRING_LEN) :: outputname
! read the observation surface
x_observation(:) = 0.d0
diff --git a/src/specfem3D/save_adjoint_kernels.f90 b/src/specfem3D/save_adjoint_kernels.f90
index 9c73085..a506421 100644
--- a/src/specfem3D/save_adjoint_kernels.f90
+++ b/src/specfem3D/save_adjoint_kernels.f90
@@ -36,9 +36,9 @@
!==============================================================================
-!==============================================================================
!> Save kernels.
-subroutine save_adjoint_kernels()
+
+ subroutine save_adjoint_kernels()
use constants, only: CUSTOM_REAL, SAVE_TRANSVERSE_KL, ANISOTROPIC_KL, &
APPROXIMATE_HESS_KL, NGLLX, NGLLY, NGLLZ
@@ -172,12 +172,17 @@ subroutine save_adjoint_kernels()
endif
endif
-end subroutine save_adjoint_kernels
+ end subroutine save_adjoint_kernels
+
+!
+!-------------------------------------------------------------------------------------------------
+!
-!==============================================================================
!> Save weights for volume integration,
!! in order to benchmark the kernels with analytical expressions.
+
subroutine save_weights_kernel()
+
use specfem_par
use specfem_par_acoustic
use specfem_par_elastic
@@ -208,10 +213,15 @@ subroutine save_weights_kernel()
deallocate(weights_kernel,stat=ier)
if( ier /= 0 ) stop 'error allocating array weights_kernel'
-end subroutine save_weights_kernel
-!==============================================================================
+ end subroutine save_weights_kernel
+
+!
+!-------------------------------------------------------------------------------------------------
+!
+
!> Save acoustic related kernels
+
subroutine save_kernels_acoustic(adios_handle)
use specfem_par
@@ -272,11 +282,16 @@ subroutine save_kernels_acoustic(adios_handle)
close(IOUT)
endif
-end subroutine save_kernels_acoustic
-!==============================================================================
+ end subroutine save_kernels_acoustic
+
+!
+!-------------------------------------------------------------------------------------------------
+!
+
!> Save elastic related kernels
-subroutine save_kernels_elastic(adios_handle, alphav_kl, alphah_kl, &
+
+ subroutine save_kernels_elastic(adios_handle, alphav_kl, alphah_kl, &
betav_kl, betah_kl, eta_kl, &
rhop_kl, alpha_kl, beta_kl)
@@ -521,11 +536,15 @@ subroutine save_kernels_elastic(adios_handle, alphav_kl, alphah_kl, &
endif
endif
-end subroutine save_kernels_elastic
+ end subroutine save_kernels_elastic
-!==============================================================================
-!> Save poroelastic related kernels
-subroutine save_kernels_poroelastic(adios_handle)
+!
+!-------------------------------------------------------------------------------------------------
+!
+
+ !> Save poroelastic related kernels
+
+ subroutine save_kernels_poroelastic(adios_handle)
use specfem_par
use specfem_par_poroelastic
@@ -860,11 +879,16 @@ subroutine save_kernels_poroelastic(adios_handle)
close(IOUT)
endif
-end subroutine save_kernels_poroelastic
-!==============================================================================
+ end subroutine save_kernels_poroelastic
+
+!
+!-------------------------------------------------------------------------------------------------
+!
+
!> Save hessians
-subroutine save_kernels_hessian(adios_handle)
+
+ subroutine save_kernels_hessian(adios_handle)
use specfem_par
use specfem_par_elastic
@@ -911,5 +935,59 @@ subroutine save_kernels_hessian(adios_handle)
close(IOUT)
endif
endif
-end subroutine save_kernels_hessian
+
+ end subroutine save_kernels_hessian
+
+!
+!-------------------------------------------------------------------------------------------------
+!
+
+
+ subroutine save_kernels_source_derivatives()
+
+ use specfem_par
+
+ implicit none
+
+ ! local parameters
+ integer :: irec_local,ier
+ character(len=MAX_STRING_LEN) :: outputname
+
+ ! checks
+ if (ADIOS_FOR_KERNELS ) stop 'Source derivative kernels not implemented yet for ADIOS'
+
+ ! writes out derivative kernels
+ do irec_local = 1, nrec_local
+ write(outputname,'(a,i6.6)') OUTPUT_FILES_PATH(1:len_trim(OUTPUT_FILES_PATH)) // &
+ '/src_frechet.',number_receiver_global(irec_local)
+
+ open(unit=IOUT,file=trim(outputname),status='unknown',iostat=ier)
+ if( ier /= 0 ) then
+ print*,'error opening file: ',trim(outputname)
+ call exit_mpi(myrank,'error opening file src_frechet.**')
+ endif
+
+ !
+ ! r -> z, theta -> -y, phi -> x
+ !
+ ! Mrr = Mzz
+ ! Mtt = Myy
+ ! Mpp = Mxx
+ ! Mrt = -Myz
+ ! Mrp = Mxz
+ ! Mtp = -Mxy
+ write(IOUT,*) Mzz_der(irec_local)
+ write(IOUT,*) Myy_der(irec_local)
+ write(IOUT,*) Mxx_der(irec_local)
+ write(IOUT,*) -Myz_der(irec_local)
+ write(IOUT,*) Mxz_der(irec_local)
+ write(IOUT,*) -Mxy_der(irec_local)
+ write(IOUT,*) sloc_der(1,irec_local)
+ write(IOUT,*) sloc_der(2,irec_local)
+ write(IOUT,*) sloc_der(3,irec_local)
+
+ close(IOUT)
+ enddo
+
+ end subroutine save_kernels_source_derivatives
diff --git a/src/specfem3D/setup_sources_receivers.f90 b/src/specfem3D/setup_sources_receivers.f90
index 29e7d43..56bc8d4 100644
--- a/src/specfem3D/setup_sources_receivers.f90
+++ b/src/specfem3D/setup_sources_receivers.f90
@@ -349,8 +349,9 @@
implicit none
+ ! local parameters
+ integer :: nrec_simulation
integer :: irec,isource,ier
-
character(len=MAX_STRING_LEN) :: path_to_add
! reads in station file
@@ -440,6 +441,15 @@
enddo
endif
+! check that the sum of the number of receivers in each slice is nrec
+ call sum_all_i(nrec_local,nrec_tot_found)
+ if( myrank == 0 ) then
+ if(nrec_tot_found /= nrec_simulation) then
+ call exit_MPI(myrank,'problem when dispatching the receivers')
+ endif
+ endif
+ call synchronize_all()
+
! checks if acoustic receiver is exactly on the free surface because pressure is zero there
call setup_receivers_check_acoustic()
@@ -744,8 +754,8 @@
adj_sourcearrays = 0._CUSTOM_REAL
else
! skip counting, because only one file per component per proc in SU_FORMAT
- nadj_rec_local=nrec_local
- nadj_files_found=nrec_local
+ nadj_rec_local = nrec_local
+ nadj_files_found = nrec_local
allocate(adj_sourcearrays(nadj_rec_local,NTSTEP_BETWEEN_READ_ADJSRC,NDIM,NGLLX,NGLLY,NGLLZ),stat=ier)
if (ier /= 0) stop 'error allocating array adj_sourcearrays'
adj_sourcearrays = 0._CUSTOM_REAL
@@ -787,6 +797,14 @@
hgammar_store(nrec_local,NGLLZ),stat=ier)
if( ier /= 0 ) stop 'error allocating array hxir_store etc.'
+ ! allocates derivatives
+ if (SIMULATION_TYPE == 2 ) then
+ allocate(hpxir_store(nrec_local,NGLLX), &
+ hpetar_store(nrec_local,NGLLY), &
+ hpgammar_store(nrec_local,NGLLZ),stat=ier)
+ if( ier /= 0 ) stop 'error allocating array hpxir_store'
+ endif
+
! define local to global receiver numbering mapping
irec_local = 0
if (SIMULATION_TYPE == 1 .or. SIMULATION_TYPE == 3) then
@@ -805,45 +823,36 @@
enddo
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)
+ ! define and store Lagrange interpolators at all the receivers
+ 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
- allocate(hpxir_store(nrec_local,NGLLX), &
- hpetar_store(nrec_local,NGLLY), &
- hpgammar_store(nrec_local,NGLLZ),stat=ier)
- if( ier /= 0 ) stop 'error allocating array hpxir_store'
- 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
endif ! nrec_local > 0
-! check that the sum of the number of receivers in each slice is nrec
- call sum_all_i(nrec_local,nrec_tot_found)
- if( myrank == 0 ) then
- if(nrec_tot_found /= nrec_simulation) then
- call exit_MPI(myrank,'problem when dispatching the receivers')
- endif
- endif
-
end subroutine setup_receivers_precompute_intp
!
diff --git a/src/specfem3D/specfem3D_par.f90 b/src/specfem3D/specfem3D_par.f90
index a7b2743..f7d2409 100644
--- a/src/specfem3D/specfem3D_par.f90
+++ b/src/specfem3D/specfem3D_par.f90
@@ -119,7 +119,6 @@ module specfem_par
! receiver information
character(len=MAX_STRING_LEN) :: rec_filename,filtered_rec_filename,dummystring
integer :: nrec,nrec_local,nrec_tot_found
- integer :: nrec_simulation
integer, dimension(:), allocatable :: islice_selected_rec,ispec_selected_rec
integer, dimension(:), allocatable :: number_receiver_global
double precision, dimension(:), allocatable :: xi_receiver,eta_receiver,gamma_receiver
@@ -201,9 +200,6 @@ module specfem_par
logical :: ADIOS_ENABLED
logical :: ADIOS_FOR_DATABASES, ADIOS_FOR_MESH, ADIOS_FOR_FORWARD_ARRAYS, ADIOS_FOR_KERNELS
-! names of the data files for all the processors in MPI
- character(len=MAX_STRING_LEN) :: outputname
-
! for assembling in case of external mesh
integer :: num_interfaces_ext_mesh
integer :: max_nibool_interfaces_ext_mesh
diff --git a/src/specfem3D/write_movie_output.f90 b/src/specfem3D/write_movie_output.f90
index a9c4690..6a76057 100644
--- a/src/specfem3D/write_movie_output.f90
+++ b/src/specfem3D/write_movie_output.f90
@@ -355,6 +355,7 @@
real(kind=CUSTOM_REAL),dimension(:,:,:,:),allocatable:: val_element
real(kind=CUSTOM_REAL),dimension(1):: dummy
integer :: ispec2D,ispec,ipoin,iglob,ier
+ character(len=MAX_STRING_LEN) :: outputname
! allocate array for single elements
allocate( val_element(NDIM,NGLLX,NGLLY,NGLLZ),stat=ier)
@@ -571,6 +572,7 @@
real(kind=CUSTOM_REAL),dimension(1) :: dummy
integer :: ispec,ipoin,iglob,i,j,k,ier
integer :: imin,imax,jmin,jmax,kmin,kmax,iface,igll,iloc
+ character(len=MAX_STRING_LEN) :: outputname
! allocate array for single elements
allocate(val_element(NDIM,NGLLX,NGLLY,NGLLZ),stat=ier)
@@ -1005,6 +1007,7 @@
integer :: ispec,ier
character(len=3) :: channel
character(len=1) :: compx,compy,compz
+ character(len=MAX_STRING_LEN) :: outputname
! gets component characters: X/Y/Z or E/N/Z
call write_channel_name(1,channel)
diff --git a/src/specfem3D/write_seismograms.f90 b/src/specfem3D/write_seismograms.f90
index 380b71f..7bd29aa 100644
--- a/src/specfem3D/write_seismograms.f90
+++ b/src/specfem3D/write_seismograms.f90
@@ -295,7 +295,7 @@
call write_seismograms_to_file(seismograms_a,3)
else
call write_adj_seismograms_to_file(myrank,seismograms_d,number_receiver_global, &
- nrec_local,it,DT,NSTEP,t0,1)
+ nrec_local,it,DT,NSTEP,t0,1)
endif
endif
@@ -369,9 +369,9 @@
one_seismogram = seismograms(:,irec_local,:)
call write_one_seismogram(one_seismogram,irec, &
- station_name,network_name,nrec, &
- DT,t0,it,NSTEP,SIMULATION_TYPE, &
- myrank,irecord,component)
+ station_name,network_name,nrec, &
+ DT,t0,it,NSTEP,SIMULATION_TYPE, &
+ myrank,irecord,component)
enddo ! nrec_local
@@ -433,9 +433,9 @@
! writes out this seismogram
call write_one_seismogram(one_seismogram,irec, &
- station_name,network_name,nrec, &
- DT,t0,it,NSTEP,SIMULATION_TYPE, &
- myrank,irecord,component)
+ station_name,network_name,nrec, &
+ DT,t0,it,NSTEP,SIMULATION_TYPE, &
+ myrank,irecord,component)
enddo ! nrec_local_received
endif ! if(nrec_local_received > 0 )
@@ -526,8 +526,8 @@
! ASCII output format
call write_output_ASCII(one_seismogram, &
- NSTEP,it,SIMULATION_TYPE,DT,t0,myrank, &
- iorientation,irecord,sisname,final_LOCAL_PATH)
+ NSTEP,it,SIMULATION_TYPE,DT,t0,myrank, &
+ iorientation,irecord,sisname,final_LOCAL_PATH)
enddo ! do iorientation
@@ -538,23 +538,25 @@
! write adjoint seismograms (displacement) to text files
subroutine write_adj_seismograms_to_file(myrank,seismograms,number_receiver_global, &
- nrec_local,it,DT,NSTEP,t0,istore)
+ nrec_local,it,DT,NSTEP,t0,istore)
use constants
implicit none
- integer nrec_local,NSTEP,it,myrank,istore
+ integer :: myrank
+ integer :: nrec_local,NSTEP,it,istore
integer, dimension(nrec_local) :: number_receiver_global
real(kind=CUSTOM_REAL), dimension(NDIM,nrec_local,NSTEP) :: seismograms
- double precision t0,DT
+ double precision :: t0,DT
- integer irec,irec_local
- integer iorientation,irecord,isample
+ ! local parameters
+ integer :: irec,irec_local
+ integer :: iorientation,irecord,isample
- character(len=3) channel
- character(len=1) component
- character(len=MAX_STRING_LEN) :: sisname,final_LOCAL_PATH
+ character(len=3) :: channel
+ character(len=1) :: component
+ character(len=MAX_STRING_LEN) :: sisname
! save displacement, velocity or acceleration
if(istore == 1) then
@@ -582,18 +584,14 @@
! create the name of the seismogram file for each slice
! file name includes the name of the station, the network and the component
- write(sisname,"(a,i5.5,'.',a,'.',a3,'.sem',a1)") 'S',irec_local,&
- 'NT',channel,component
-
- ! directory to store seismograms
- final_LOCAL_PATH = OUTPUT_FILES_PATH(1:len_trim(OUTPUT_FILES_PATH)) // '/'
+ write(sisname,"(a2,i6.6,'.',a,'.',a3,'.sem',a1)") '/S',irec,'NT',channel,component
! save seismograms in text format with no subsampling.
! Because we do not subsample the output, this can result in large files
! if the simulation uses many time steps. However, subsampling the output
! here would result in a loss of accuracy when one later convolves
! the results with the source time function
- open(unit=IOUT,file=final_LOCAL_PATH(1:len_trim(final_LOCAL_PATH))//sisname(1:len_trim(sisname)),status='unknown')
+ open(unit=IOUT,file=OUTPUT_FILES_PATH(1:len_trim(OUTPUT_FILES_PATH))//sisname(1:len_trim(sisname)),status='unknown')
! make sure we never write more than the maximum number of time steps
! subtract half duration of the source to make sure travel time is correct
@@ -627,18 +625,19 @@
use constants
implicit none
-
- integer nrec_local,NSTEP,it,myrank
+ integer :: myrank
+ integer :: nrec_local,NSTEP,it
integer, dimension(nrec_local) :: number_receiver_global
real(kind=CUSTOM_REAL), dimension(NDIM,NDIM,nrec_local,NSTEP) :: seismograms
- double precision t0,DT
+ double precision :: t0,DT
- integer irec,irec_local
- integer idimval,jdimval,irecord,isample
+ ! local parameters
+ integer :: irec,irec_local
+ integer :: idimval,jdimval,irecord,isample
character(len=4) :: chn
character(len=1) :: component
- character(len=MAX_STRING_LEN) :: sisname,final_LOCAL_PATH
+ character(len=MAX_STRING_LEN) :: sisname
component = 'd'
@@ -650,9 +649,10 @@
! save three components of displacement vector
irecord = 1
- do idimval = 1, 3
- do jdimval = idimval, 3
+ do idimval = 1, NDIM
+ do jdimval = idimval, NDIM
+ ! strain channel name
if(idimval == 1 .and. jdimval == 1) then
chn = 'SNN'
else if(idimval == 1 .and. jdimval == 2) then
@@ -671,18 +671,14 @@
! create the name of the seismogram file for each slice
! file name includes the name of the station, the network and the component
- write(sisname,"(a,i5.5,'.',a,'.',a3,'.sem',a1)") 'S',irec_local,&
- 'NT',chn,component
-
- ! directory to store seismograms
- final_LOCAL_PATH = OUTPUT_FILES_PATH(1:len_trim(OUTPUT_FILES_PATH)) // '/'
+ write(sisname,"(a2,i6.6,'.',a,'.',a3,'.sem',a1)") '/S',irec,'NT',chn,component
! save seismograms in text format with no subsampling.
! Because we do not subsample the output, this can result in large files
! if the simulation uses many time steps. However, subsampling the output
! here would result in a loss of accuracy when one later convolves
! the results with the source time function
- open(unit=IOUT,file=final_LOCAL_PATH(1:len_trim(final_LOCAL_PATH))//sisname(1:len_trim(sisname)),status='unknown')
+ open(unit=IOUT,file=OUTPUT_FILES_PATH(1:len_trim(OUTPUT_FILES_PATH))//sisname(1:len_trim(sisname)),status='unknown')
! make sure we never write more than the maximum number of time steps
! subtract half duration of the source to make sure travel time is correct
diff --git a/utils/create_specfem3D_gpu_cuda_method_stubs.pl b/utils/create_specfem3D_gpu_cuda_method_stubs.pl
index 6ec4533..1b17365 100755
--- a/utils/create_specfem3D_gpu_cuda_method_stubs.pl
+++ b/utils/create_specfem3D_gpu_cuda_method_stubs.pl
@@ -20,10 +20,11 @@ $header = <<END;
! S p e c f e m 3 D V e r s i o n 2 . 1
! ---------------------------------------
!
-! Main authors: Dimitri Komatitsch and Jeroen Tromp
-! Princeton University, USA and University of Pau / CNRS / INRIA
-! (c) Princeton University / California Institute of Technology and University of Pau / CNRS / INRIA
-! April 2011
+! Main historical authors: Dimitri Komatitsch and Jeroen Tromp
+! Princeton University, USA
+! and CNRS / University of Marseille, France
+! (there are currently many more authors!)
+! (c) Princeton University and CNRS / University of Marseille, July 2012
!
! This program is free software; you can redistribute it and/or modify
! it under the terms of the GNU General Public License as published by
More information about the CIG-COMMITS
mailing list