[cig-commits] [commit] devel: fixed the "hdur_tiny" bug detected by Alexis Bottero in the case of FORCE_SOURCESOLUTION with a Dirac source time function (hdur_tiny was not sent as a subroutine argument) (2f28100)

cig_noreply at geodynamics.org cig_noreply at geodynamics.org
Fri Oct 3 08:32:46 PDT 2014


Repository : https://github.com/geodynamics/specfem3d

On branch  : devel
Link       : https://github.com/geodynamics/specfem3d/compare/e0b7c32c2be8739824d62f655af795bab5c732be...2f281008845e767e0fac82a7a11351e1fa0171ce

>---------------------------------------------------------------

commit 2f281008845e767e0fac82a7a11351e1fa0171ce
Author: Dimitri Komatitsch <komatitsch at lma.cnrs-mrs.fr>
Date:   Fri Oct 3 17:27:21 2014 +0200

    fixed the "hdur_tiny" bug detected by Alexis Bottero in the case of FORCE_SOURCESOLUTION with a Dirac source time function (hdur_tiny was not sent as a subroutine argument)


>---------------------------------------------------------------

2f281008845e767e0fac82a7a11351e1fa0171ce
 src/specfem3D/compute_add_sources_acoustic.f90            |  6 +++---
 src/specfem3D/compute_add_sources_poroelastic.f90         |  8 ++++----
 src/specfem3D/compute_add_sources_viscoelastic.f90        | 15 ++++-----------
 src/specfem3D/compute_forces_acoustic_calling_routine.f90 |  6 +++---
 .../compute_forces_poroelastic_calling_routine.f90        |  2 +-
 .../compute_forces_viscoelastic_calling_routine.F90       |  6 +++---
 src/specfem3D/setup_sources_receivers.f90                 | 11 ++++-------
 7 files changed, 22 insertions(+), 32 deletions(-)

diff --git a/src/specfem3D/compute_add_sources_acoustic.f90 b/src/specfem3D/compute_add_sources_acoustic.f90
index 14192e8..268981b 100644
--- a/src/specfem3D/compute_add_sources_acoustic.f90
+++ b/src/specfem3D/compute_add_sources_acoustic.f90
@@ -30,7 +30,7 @@
   subroutine compute_add_sources_acoustic(NSPEC_AB,NGLOB_AB,potential_dot_dot_acoustic, &
                                   ibool,ispec_is_inner,phase_is_inner, &
                                   NSOURCES,myrank,it,islice_selected_source,ispec_selected_source,&
-                                  hdur,hdur_gaussian,tshift_src,dt,t0, &
+                                  hdur,hdur_gaussian,hdur_tiny,tshift_src,dt,t0, &
                                   sourcearrays,kappastore,ispec_is_acoustic,&
                                   SIMULATION_TYPE,NSTEP, &
                                   nrec,islice_selected_rec,ispec_selected_rec, &
@@ -365,7 +365,7 @@
   subroutine compute_add_sources_acoustic_bpwf(NSPEC_AB, &
                                   ibool,ispec_is_inner,phase_is_inner, &
                                   NSOURCES,myrank,it,islice_selected_source,ispec_selected_source,&
-                                  hdur,hdur_gaussian,tshift_src,dt,t0, &
+                                  hdur,hdur_gaussian,hdur_tiny,tshift_src,dt,t0, &
                                   sourcearrays,kappastore,ispec_is_acoustic,&
                                   SIMULATION_TYPE,NSTEP,NGLOB_ADJOINT, &
                                   b_potential_dot_dot_acoustic)
@@ -552,7 +552,7 @@
 ! for acoustic solver on GPU
   subroutine compute_add_sources_acoustic_GPU(NSPEC_AB,ispec_is_inner,phase_is_inner, &
                                   NSOURCES,myrank,it,&
-                                  hdur,hdur_gaussian,tshift_src,dt,t0, &
+                                  hdur,hdur_gaussian,hdur_tiny,tshift_src,dt,t0, &
                                   ispec_is_acoustic,SIMULATION_TYPE,NSTEP, &
                                   nrec,islice_selected_rec,ispec_selected_rec, &
                                   nadj_rec_local,adj_sourcearrays, &
diff --git a/src/specfem3D/compute_add_sources_poroelastic.f90 b/src/specfem3D/compute_add_sources_poroelastic.f90
index 559e2e7..299fa7a 100644
--- a/src/specfem3D/compute_add_sources_poroelastic.f90
+++ b/src/specfem3D/compute_add_sources_poroelastic.f90
@@ -28,12 +28,12 @@
 
 ! for poroelastic solver
 
-  subroutine compute_add_sources_poroelastic( NSPEC_AB,NGLOB_AB, &
+  subroutine compute_add_sources_poroelastic(NSPEC_AB,NGLOB_AB, &
                         accels,accelw,&
                         rhoarraystore,phistore,tortstore,&
                         ibool,ispec_is_inner,phase_is_inner, &
                         NSOURCES,myrank,it,islice_selected_source,ispec_selected_source,&
-                        hdur,hdur_gaussian,tshift_src,dt,t0,sourcearrays, &
+                        hdur,hdur_gaussian,hdur_tiny,tshift_src,dt,t0,sourcearrays, &
                         ispec_is_poroelastic,SIMULATION_TYPE,NSTEP,NGLOB_ADJOINT, &
                         nrec,islice_selected_rec,ispec_selected_rec, &
                         nadj_rec_local,adj_sourcearrays,b_accels,b_accelw, &
@@ -42,7 +42,7 @@
   use constants
   use specfem_par,only: PRINT_SOURCE_TIME_FUNCTION,stf_used_total, &
                         xigll,yigll,zigll,xi_receiver,eta_receiver,gamma_receiver,&
-                        station_name,network_name,adj_source_file,hdur_tiny, &
+                        station_name,network_name,adj_source_file, &
                         USE_RICKER_TIME_FUNCTION,USE_FORCE_POINT_SOURCE
 
   implicit none
@@ -65,7 +65,7 @@
 ! source
   integer :: NSOURCES,myrank,it
   integer, dimension(NSOURCES) :: islice_selected_source,ispec_selected_source
-  double precision, dimension(NSOURCES) :: hdur,hdur_gaussian,tshift_src
+  double precision, dimension(NSOURCES) :: hdur,hdur_gaussian,hdur_tiny,tshift_src
   double precision :: dt,t0
   real(kind=CUSTOM_REAL), dimension(NSOURCES,NDIM,NGLLX,NGLLY,NGLLZ) :: sourcearrays
 
diff --git a/src/specfem3D/compute_add_sources_viscoelastic.f90 b/src/specfem3D/compute_add_sources_viscoelastic.f90
index aa8c895..e4f23f9 100644
--- a/src/specfem3D/compute_add_sources_viscoelastic.f90
+++ b/src/specfem3D/compute_add_sources_viscoelastic.f90
@@ -27,10 +27,10 @@
 
 ! for elastic solver
 
-  subroutine compute_add_sources_viscoelastic( NSPEC_AB,NGLOB_AB,accel, &
+  subroutine compute_add_sources_viscoelastic(NSPEC_AB,NGLOB_AB,accel, &
                         ibool,ispec_is_inner,phase_is_inner, &
                         NSOURCES,myrank,it,islice_selected_source,ispec_selected_source,&
-                        hdur,hdur_gaussian,tshift_src,dt,t0,sourcearrays, &
+                        hdur,hdur_gaussian,hdur_tiny,tshift_src,dt,t0,sourcearrays, &
                         ispec_is_elastic,SIMULATION_TYPE,NSTEP, &
                         nrec,islice_selected_rec,ispec_selected_rec, &
                         nadj_rec_local,adj_sourcearrays, &
@@ -129,13 +129,6 @@
 
             if (USE_FORCE_POINT_SOURCE) then
 
-              !f0 = hdur(isource) !! using hdur as a FREQUENCY
-              !if (it == 1 .and. myrank == 0) then
-              !  write(IMAIN,*) 'using a source of dominant frequency ',f0
-              !  write(IMAIN,*) 'lambda_S at dominant frequency = ',3000./sqrt(3.)/f0
-              !  write(IMAIN,*) 'lambda_S at highest significant frequency = ',3000./sqrt(3.)/(2.5*f0)
-              !endif
-
               if (USE_RICKER_TIME_FUNCTION) then
                 stf = comp_source_time_function_rickr(dble(it-1)*DT-t0-tshift_src(isource),hdur(isource))
               else
@@ -402,7 +395,7 @@
   subroutine compute_add_sources_viscoelastic_bpwf( NSPEC_AB,NGLOB_AB, &
                         ibool,ispec_is_inner,phase_is_inner, &
                         NSOURCES,myrank,it,islice_selected_source,ispec_selected_source,&
-                        hdur,hdur_gaussian,tshift_src,dt,t0,sourcearrays, &
+                        hdur,hdur_gaussian,hdur_tiny,tshift_src,dt,t0,sourcearrays, &
                         ispec_is_elastic,SIMULATION_TYPE,NSTEP,NGLOB_ADJOINT, &
                         b_accel,NOISE_TOMOGRAPHY)
 
@@ -601,7 +594,7 @@
 
   subroutine compute_add_sources_viscoelastic_GPU(NSPEC_AB, &
                         ispec_is_inner,phase_is_inner,NSOURCES,myrank,it,&
-                        hdur,hdur_gaussian,tshift_src,dt,t0, &
+                        hdur,hdur_gaussian,hdur_tiny,tshift_src,dt,t0, &
                         ispec_is_elastic,SIMULATION_TYPE,NSTEP, &
                         nrec,islice_selected_rec,ispec_selected_rec, &
                         nadj_rec_local,adj_sourcearrays, &
diff --git a/src/specfem3D/compute_forces_acoustic_calling_routine.f90 b/src/specfem3D/compute_forces_acoustic_calling_routine.f90
index 6d092d7..27e5627 100644
--- a/src/specfem3D/compute_forces_acoustic_calling_routine.f90
+++ b/src/specfem3D/compute_forces_acoustic_calling_routine.f90
@@ -175,7 +175,7 @@ subroutine compute_forces_acoustic()
     call compute_add_sources_acoustic(NSPEC_AB,NGLOB_AB,potential_dot_dot_acoustic, &
                         ibool,ispec_is_inner,phase_is_inner, &
                         NSOURCES,myrank,it,islice_selected_source,ispec_selected_source,&
-                        hdur,hdur_gaussian,tshift_src,dt,t0, &
+                        hdur,hdur_gaussian,hdur_tiny,tshift_src,dt,t0, &
                         sourcearrays,kappastore,ispec_is_acoustic,&
                         SIMULATION_TYPE,NSTEP, &
                         nrec,islice_selected_rec,ispec_selected_rec, &
@@ -410,7 +410,7 @@ subroutine compute_forces_acoustic_bpwf()
     call compute_add_sources_acoustic_bpwf(NSPEC_AB, &
                                   ibool,ispec_is_inner,phase_is_inner, &
                                   NSOURCES,myrank,it,islice_selected_source,ispec_selected_source,&
-                                  hdur,hdur_gaussian,tshift_src,dt,t0, &
+                                  hdur,hdur_gaussian,hdur_tiny,tshift_src,dt,t0, &
                                   sourcearrays,kappastore,ispec_is_acoustic,&
                                   SIMULATION_TYPE,NSTEP,NGLOB_ADJOINT, &
                                   b_potential_dot_dot_acoustic)
@@ -543,7 +543,7 @@ subroutine compute_forces_acoustic_GPU()
     ! sources
     call compute_add_sources_acoustic_GPU(NSPEC_AB,ispec_is_inner,phase_is_inner, &
                                   NSOURCES,myrank,it,&
-                                  hdur,hdur_gaussian,tshift_src,dt,t0, &
+                                  hdur,hdur_gaussian,hdur_tiny,tshift_src,dt,t0, &
                                   ispec_is_acoustic,SIMULATION_TYPE,NSTEP, &
                                   nrec,islice_selected_rec,ispec_selected_rec, &
                                   nadj_rec_local,adj_sourcearrays, &
diff --git a/src/specfem3D/compute_forces_poroelastic_calling_routine.f90 b/src/specfem3D/compute_forces_poroelastic_calling_routine.f90
index d9df188..d667de1 100644
--- a/src/specfem3D/compute_forces_poroelastic_calling_routine.f90
+++ b/src/specfem3D/compute_forces_poroelastic_calling_routine.f90
@@ -204,7 +204,7 @@ subroutine compute_forces_poroelastic()
                         rhoarraystore,phistore,tortstore,&
                         ibool,ispec_is_inner,phase_is_inner, &
                         NSOURCES,myrank,it,islice_selected_source,ispec_selected_source,&
-                        hdur,hdur_gaussian,tshift_src,dt,t0,sourcearrays, &
+                        hdur,hdur_gaussian,hdur_tiny,tshift_src,dt,t0,sourcearrays, &
                         ispec_is_poroelastic,SIMULATION_TYPE,NSTEP,NGLOB_ADJOINT, &
                         nrec,islice_selected_rec,ispec_selected_rec, &
                         nadj_rec_local,adj_sourcearrays,b_accels_poroelastic,b_accelw_poroelastic, &
diff --git a/src/specfem3D/compute_forces_viscoelastic_calling_routine.F90 b/src/specfem3D/compute_forces_viscoelastic_calling_routine.F90
index 01ad5f1..50d2fb9 100644
--- a/src/specfem3D/compute_forces_viscoelastic_calling_routine.F90
+++ b/src/specfem3D/compute_forces_viscoelastic_calling_routine.F90
@@ -192,7 +192,7 @@ subroutine compute_forces_viscoelastic()
       call compute_add_sources_viscoelastic(NSPEC_AB,NGLOB_AB,accel, &
                                             ibool,ispec_is_inner,phase_is_inner, &
                                             NSOURCES,myrank,it,islice_selected_source,ispec_selected_source,&
-                                            hdur,hdur_gaussian,tshift_src,dt,t0,sourcearrays, &
+                                            hdur,hdur_gaussian,hdur_tiny,tshift_src,dt,t0,sourcearrays, &
                                             ispec_is_elastic,SIMULATION_TYPE,NSTEP, &
                                             nrec,islice_selected_rec,ispec_selected_rec, &
                                             nadj_rec_local,adj_sourcearrays, &
@@ -411,7 +411,7 @@ subroutine compute_forces_viscoelastic_bpwf()
     call compute_add_sources_viscoelastic_bpwf( NSPEC_AB,NGLOB_AB, &
                         ibool,ispec_is_inner,phase_is_inner, &
                         NSOURCES,myrank,it,islice_selected_source,ispec_selected_source,&
-                        hdur,hdur_gaussian,tshift_src,dt,t0,sourcearrays, &
+                        hdur,hdur_gaussian,hdur_tiny,tshift_src,dt,t0,sourcearrays, &
                         ispec_is_elastic,SIMULATION_TYPE,NSTEP,NGLOB_ADJOINT, &
                         b_accel,NOISE_TOMOGRAPHY)
 
@@ -747,7 +747,7 @@ subroutine compute_forces_viscoelastic_GPU()
     ! adds source term (single-force/moment-tensor solution)
     call compute_add_sources_viscoelastic_GPU(NSPEC_AB, &
                         ispec_is_inner,phase_is_inner,NSOURCES,myrank,it,&
-                        hdur,hdur_gaussian,tshift_src,dt,t0, &
+                        hdur,hdur_gaussian,hdur_tiny,tshift_src,dt,t0, &
                         ispec_is_elastic,SIMULATION_TYPE,NSTEP, &
                         nrec,islice_selected_rec,ispec_selected_rec, &
                         nadj_rec_local,adj_sourcearrays, &
diff --git a/src/specfem3D/setup_sources_receivers.f90 b/src/specfem3D/setup_sources_receivers.f90
index 50d9655..1924d16 100644
--- a/src/specfem3D/setup_sources_receivers.f90
+++ b/src/specfem3D/setup_sources_receivers.f90
@@ -106,12 +106,11 @@
              comp_dir_vect_source_N(NSOURCES), &
              comp_dir_vect_source_Z_UP(NSOURCES),stat=ier)
     if (ier /= 0) stop 'error allocating arrays for force point sources'
-    if (.not. USE_RICKER_TIME_FUNCTION) then
-      allocate(hdur_tiny(NSOURCES),stat=ier)
-      if (ier /= 0) stop 'error allocating arrays for force point sources'
-    endif
   endif
 
+  allocate(hdur_tiny(NSOURCES),stat=ier)
+  if (ier /= 0) stop 'error allocating arrays for force point sources'
+
   ! for source encoding (acoustic sources so far only)
   allocate(pm1_source_encoding(NSOURCES),stat=ier)
   if( ier /= 0 ) stop 'error allocating arrays for sources'
@@ -146,9 +145,7 @@
   hdur_gaussian(:) = hdur(:)/SOURCE_DECAY_MIMIC_TRIANGLE
 
   ! initialize a very short (but non-zero) half duration to use a pseudo-Dirac function
-  if(USE_FORCE_POINT_SOURCE .and. .not. USE_RICKER_TIME_FUNCTION) then
-    hdur_tiny(:) = 5*DT
-  endif
+  hdur_tiny(:) = 5*DT
 
   ! define t0 as the earliest start time
   ! note: an earlier start time also reduces numerical noise due to a



More information about the CIG-COMMITS mailing list