[cig-commits] [commit] devel: fixed a bug I had introduced in src/specfem2D/enforce_acoustic_free_surface.f90 when I added a logical flag to check that the edge does not also belong to a periodic interface: the array was declared of size 1 but used with size NGLOB when periodic conditions were off (5bc7e3a)

[cig_noreply at geodynamics.org]

Repository : ssh://geoshell/specfem2d

On branch  : devel
Link       : https://github.com/geodynamics/specfem2d/compare/e4fa9d03bf2b0fc1837c42aa51eeb63f360575fe...fc67e6fd7ad890705b2b72b4b3c509accb22249e

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

commit 5bc7e3a6d8cdc651886f9cb7d81e8809fd980030
Author: Dimitri Komatitsch <komatitsch at lma.cnrs-mrs.fr>
Date:   Tue Mar 11 17:36:48 2014 +0100

    fixed a bug I had introduced in src/specfem2D/enforce_acoustic_free_surface.f90 when I added a logical flag to check that the edge does not also belong to a periodic interface: the array was declared of size 1 but used with size NGLOB when periodic conditions were off


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

5bc7e3a6d8cdc651886f9cb7d81e8809fd980030
 src/specfem2D/enforce_acoustic_free_surface.f90 |  6 +++---
 src/specfem2D/specfem2D.F90                     | 13 ++++---------
 2 files changed, 7 insertions(+), 12 deletions(-)

diff --git a/src/specfem2D/enforce_acoustic_free_surface.f90 b/src/specfem2D/enforce_acoustic_free_surface.f90
index cb8ee7d..c24950e 100644
--- a/src/specfem2D/enforce_acoustic_free_surface.f90
+++ b/src/specfem2D/enforce_acoustic_free_surface.f90
@@ -80,9 +80,9 @@
         iglob = ibool(i,j,ispec)
         ! make sure that an acoustic free surface is not enforced on periodic edges
         if(.not. this_ibool_is_a_periodic_edge(iglob)) then
-          potential_acoustic(iglob) = ZERO
-          potential_dot_acoustic(iglob) = ZERO
-          potential_dot_dot_acoustic(iglob) = ZERO
+          potential_acoustic(iglob) = 0._CUSTOM_REAL
+          potential_dot_acoustic(iglob) = 0._CUSTOM_REAL
+          potential_dot_dot_acoustic(iglob) = 0._CUSTOM_REAL
         endif
       enddo
     enddo
diff --git a/src/specfem2D/specfem2D.F90 b/src/specfem2D/specfem2D.F90
index 50fdf94..ca41285 100644
--- a/src/specfem2D/specfem2D.F90
+++ b/src/specfem2D/specfem2D.F90
@@ -1950,6 +1950,10 @@
   x_center_spring = (xmax + xmin)/2.d0
   z_center_spring = (zmax + zmin)/2.d0
 
+! allocate an array to make sure that an acoustic free surface is not enforced on periodic edges
+  allocate(this_ibool_is_a_periodic_edge(NGLOB))
+  this_ibool_is_a_periodic_edge(:) = .false.
+
 ! periodic conditions: detect common points between left and right edges and replace one of them with the other
     if(ADD_PERIODIC_CONDITIONS) then
 
@@ -1968,9 +1972,6 @@
         write(IOUT,*)
       endif
 
-! allocate an array to make sure that an acoustic free surface is not enforced on periodic edges
-  allocate(this_ibool_is_a_periodic_edge(NGLOB))
-
 ! set up a local geometric tolerance
 
   xtypdist = +HUGEVAL
@@ -2016,7 +2017,6 @@
       if (myrank == 0) write(IOUT,*) &
         'start detecting points for periodic boundary conditions (the current algorithm can be slow and could be improved)...'
       counter = 0
-      this_ibool_is_a_periodic_edge(:) = .false.
       do iglob = 1,NGLOB-1
         do iglob2 = iglob + 1,NGLOB
           ! check if the two points have the exact same Z coordinate
@@ -2048,11 +2048,6 @@
 
       if(counter > 0) write(IOUT,*) 'implemented periodic conditions on ',counter,' grid points on proc ',myrank
 
-    else
-
-      ! dummy allocation just to be able to use this array as a subroutine argument later
-      allocate(this_ibool_is_a_periodic_edge(1))
-
     endif ! of if(ADD_PERIODIC_CONDITIONS)
 
 !