[cig-commits] [commit] devel: Fix allocation of regular kernel arrays. (32686e3)

[cig_noreply at geodynamics.org]

Repository : ssh://geoshell/specfem3d_globe

On branch  : devel
Link       : https://github.com/geodynamics/specfem3d_globe/compare/811ae11b80604736d2845c4e5a062755069fc9a6...fedf291c8257de6ffc3151362afcb814578beb7e

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

commit 32686e351459db13af0fd6dba8ab3fc856755f87
Author: Elliott Sales de Andrade <esalesde at physics.utoronto.ca>
Date:   Fri Aug 23 16:25:28 2013 -0400

    Fix allocation of regular kernel arrays.
    
    Depending on certain flags, some of these arrays were not allocated at
    the necessary time.


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

32686e351459db13af0fd6dba8ab3fc856755f87
 src/specfem3D/save_regular_kernels.f90 | 85 ++++++++++++++++------------------
 1 file changed, 39 insertions(+), 46 deletions(-)

diff --git a/src/specfem3D/save_regular_kernels.f90 b/src/specfem3D/save_regular_kernels.f90
index 0ebe45b..5387db1 100644
--- a/src/specfem3D/save_regular_kernels.f90
+++ b/src/specfem3D/save_regular_kernels.f90
@@ -72,65 +72,59 @@
   scale_kl_rho = scale_t / scale_displ / RHOAV * 1.d9
 
   ! allocates temporary arrays
-  allocate(cijkl_kl_crust_mantle_reg(21,npoints_slice), &
-           rho_kl_crust_mantle_reg(npoints_slice), &
+  allocate(rho_kl_crust_mantle_reg(npoints_slice), &
            beta_kl_crust_mantle_reg(npoints_slice), &
            alpha_kl_crust_mantle_reg(npoints_slice))
 
-  if( SAVE_TRANSVERSE_KL_ONLY ) then
-    ! transverse isotropic kernel arrays for file output
-    allocate(alphav_kl_crust_mantle(npoints_slice), &
-             alphah_kl_crust_mantle(npoints_slice), &
-             betav_kl_crust_mantle(npoints_slice), &
-             betah_kl_crust_mantle(npoints_slice), &
-             eta_kl_crust_mantle(npoints_slice))
-
-    ! isotropic kernel arrays for file output
-    allocate(bulk_c_kl_crust_mantle(npoints_slice), &
-             bulk_betav_kl_crust_mantle(npoints_slice), &
-             bulk_betah_kl_crust_mantle(npoints_slice), &
-             bulk_beta_kl_crust_mantle(npoints_slice))
-  endif
-
-  if( .not. ANISOTROPIC_KL ) then
+  if (ANISOTROPIC_KL) then
+    allocate(cijkl_kl_crust_mantle_reg(21, npoints_slice))
+    if (SAVE_TRANSVERSE_KL_ONLY) then
+      ! transverse isotropic kernel arrays for file output
+      allocate(alphav_kl_crust_mantle(npoints_slice), &
+               alphah_kl_crust_mantle(npoints_slice), &
+               betav_kl_crust_mantle(npoints_slice), &
+               betah_kl_crust_mantle(npoints_slice), &
+               eta_kl_crust_mantle(npoints_slice))
+
+      ! isotropic kernel arrays for file output
+      allocate(bulk_c_kl_crust_mantle(npoints_slice), &
+               bulk_betav_kl_crust_mantle(npoints_slice), &
+               bulk_betah_kl_crust_mantle(npoints_slice), &
+               bulk_beta_kl_crust_mantle(npoints_slice))
+    endif
+  else
     ! allocates temporary isotropic kernel arrays for file output
     allocate(bulk_c_kl_crust_mantle(npoints_slice), &
              bulk_beta_kl_crust_mantle(npoints_slice))
-
-    allocate(kappa_kl_crust_mantle(npoints_slice), &
-             mu_kl_crust_mantle(npoints_slice), &
+    allocate(mu_kl_crust_mantle(npoints_slice), &
+             kappa_kl_crust_mantle(npoints_slice), &
              rhonotprime_kl_crust_mantle(npoints_slice))
   endif
 
   ! crust_mantle
   do ipoint = 1, npoints_slice
     ispec = ispec_reg(ipoint)
+    rho_kl_crust_mantle_reg(ipoint) = 0.0
+    alpha_kl_crust_mantle_reg(ipoint) = 0.0
+    beta_kl_crust_mantle_reg(ipoint) = 0.0
     if (ANISOTROPIC_KL) then
-      if ( SAVE_TRANSVERSE_KL_ONLY ) then
+      cijkl_kl_crust_mantle_reg(:,ipoint) = 0.0
+      if (SAVE_TRANSVERSE_KL_ONLY) then
         alphav_kl_crust_mantle(ipoint) = 0.0
         alphah_kl_crust_mantle(ipoint) = 0.0
         betav_kl_crust_mantle(ipoint) = 0.0
         betah_kl_crust_mantle(ipoint) = 0.0
         eta_kl_crust_mantle(ipoint) = 0.0
-        rho_kl_crust_mantle_reg(ipoint) = 0.0
         bulk_c_kl_crust_mantle(ipoint) = 0.0
         bulk_betav_kl_crust_mantle(ipoint) = 0.0
         bulk_betah_kl_crust_mantle(ipoint) = 0.0
-        alpha_kl_crust_mantle_reg(ipoint) = 0.0
-        beta_kl_crust_mantle_reg(ipoint) = 0.0
         bulk_beta_kl_crust_mantle(ipoint) = 0.0
-      else
-        rho_kl_crust_mantle_reg(ipoint) = 0.0
-        cijkl_kl_crust_mantle_reg(:,ipoint) = 0.0
       endif
     else
       rhonotprime_kl_crust_mantle(ipoint) = 0.0
       kappa_kl_crust_mantle(ipoint) = 0.0
       mu_kl_crust_mantle(ipoint) = 0.0
 
-      rho_kl_crust_mantle_reg(ipoint) = 0.0
-      alpha_kl_crust_mantle_reg(ipoint) = 0.0
-      beta_kl_crust_mantle_reg(ipoint) = 0.0
       bulk_c_kl_crust_mantle(ipoint) = 0.0
       bulk_beta_kl_crust_mantle(ipoint) = 0.0
     endif
@@ -497,24 +491,23 @@
   endif ! ADIOS_FOR_KERNELS
 
   ! cleans up temporary kernel arrays
-  if (SAVE_TRANSVERSE_KL_ONLY) then
-    deallocate(alphav_kl_crust_mantle,alphah_kl_crust_mantle, &
-               betav_kl_crust_mantle,betah_kl_crust_mantle, &
-               eta_kl_crust_mantle)
-    deallocate(bulk_c_kl_crust_mantle,bulk_betah_kl_crust_mantle, &
-               bulk_betav_kl_crust_mantle,bulk_beta_kl_crust_mantle)
-  endif
-
-  if (.not. ANISOTROPIC_KL) then
-    deallocate(bulk_c_kl_crust_mantle,bulk_beta_kl_crust_mantle)
-    deallocate(kappa_kl_crust_mantle,mu_kl_crust_mantle,rhonotprime_kl_crust_mantle)
+  if (ANISOTROPIC_KL) then
+    deallocate(cijkl_kl_crust_mantle_reg)
+    if (SAVE_TRANSVERSE_KL_ONLY) then
+      deallocate(alphav_kl_crust_mantle,alphah_kl_crust_mantle, &
+                 betav_kl_crust_mantle,betah_kl_crust_mantle, &
+                 eta_kl_crust_mantle)
+      deallocate(bulk_c_kl_crust_mantle,bulk_betah_kl_crust_mantle, &
+                 bulk_betav_kl_crust_mantle,bulk_beta_kl_crust_mantle)
+    endif
+  else
+    deallocate(bulk_c_kl_crust_mantle,bulk_beta_kl_crust_mantle, &
+               mu_kl_crust_mantle,kappa_kl_crust_mantle, &
+               rhonotprime_kl_crust_mantle)
   endif
-
-  deallocate(cijkl_kl_crust_mantle_reg, &
-             rho_kl_crust_mantle_reg, &
+  deallocate(rho_kl_crust_mantle_reg, &
              beta_kl_crust_mantle_reg, &
              alpha_kl_crust_mantle_reg)
 
   end subroutine save_regular_kernels_crust_mantle
 
-