[cig-commits] r22554 - seismo/3D/SPECFEM3D_GLOBE/trunk/src/specfem3D
dkomati1 at geodynamics.org
dkomati1 at geodynamics.org
Mon Jul 8 16:31:36 PDT 2013
Author: dkomati1
Date: 2013-07-08 16:31:35 -0700 (Mon, 08 Jul 2013)
New Revision: 22554
Modified:
seismo/3D/SPECFEM3D_GLOBE/trunk/src/specfem3D/save_kernels.f90
seismo/3D/SPECFEM3D_GLOBE/trunk/src/specfem3D/specfem3D.F90
Log:
switched to static memory allocation with equivalence() statements for final temporary arrays used for isotropic kernel calculations
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/src/specfem3D/save_kernels.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/src/specfem3D/save_kernels.f90 2013-07-08 23:12:34 UTC (rev 22553)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/src/specfem3D/save_kernels.f90 2013-07-08 23:31:35 UTC (rev 22554)
@@ -28,7 +28,8 @@
subroutine save_kernels_crust_mantle_iso(myrank,scale_t,scale_displ, &
rho_kl_crust_mantle, &
alpha_kl_crust_mantle,beta_kl_crust_mantle, &
- mu_kl_crust_mantle, kappa_kl_crust_mantle, rhonotprime_kl_crust_mantle, &
+ mu_kl_crust_mantle,kappa_kl_crust_mantle,rhonotprime_kl_crust_mantle, &
+ bulk_c_kl_crust_mantle,bulk_beta_kl_crust_mantle, &
rhostore_crust_mantle,muvstore_crust_mantle, &
kappavstore_crust_mantle, &
LOCAL_PATH)
@@ -45,8 +46,12 @@
real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_CRUST_MANTLE_ADJOINT) :: &
rho_kl_crust_mantle, beta_kl_crust_mantle, alpha_kl_crust_mantle
+! additional kernels computed locally here from the other ones
real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_CRUST_MANTLE_ADJOINT) :: &
mu_kl_crust_mantle, kappa_kl_crust_mantle, rhonotprime_kl_crust_mantle
+ ! bulk parameterization
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_CRUST_MANTLE_ADJOINT) :: &
+ bulk_c_kl_crust_mantle,bulk_beta_kl_crust_mantle
real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPECMAX_ISO_MANTLE) :: &
rhostore_crust_mantle,kappavstore_crust_mantle,muvstore_crust_mantle
@@ -59,17 +64,9 @@
integer :: ispec,i,j,k
character(len=150) prname
- ! bulk parameterization
- real(kind=CUSTOM_REAL), dimension(:,:,:,:),allocatable :: &
- bulk_c_kl_crust_mantle,bulk_beta_kl_crust_mantle
-
! scaling factors
scale_kl = scale_t/scale_displ * 1.d9
- ! allocates temporary isotropic kernel arrays for file output
- allocate(bulk_c_kl_crust_mantle(NGLLX,NGLLY,NGLLZ,NSPEC_CRUST_MANTLE_ADJOINT), &
- bulk_beta_kl_crust_mantle(NGLLX,NGLLY,NGLLZ,NSPEC_CRUST_MANTLE_ADJOINT))
-
! crust_mantle
do ispec = 1, NSPEC_CRUST_MANTLE
do k = 1, NGLLZ
@@ -104,7 +101,7 @@
! where bulk wave speed is c = sqrt( kappa / rho)
! note: rhoprime is the same as for (rho,alpha,beta) parameterization
bulk_c_kl_crust_mantle(i,j,k,ispec) = 2._CUSTOM_REAL * alpha_kl * scale_kl
- bulk_beta_kl_crust_mantle(i,j,k,ispec ) = 2._CUSTOM_REAL * beta_kl * scale_kl
+ bulk_beta_kl_crust_mantle(i,j,k,ispec) = 2._CUSTOM_REAL * beta_kl * scale_kl
enddo
enddo
@@ -143,9 +140,6 @@
write(27) bulk_beta_kl_crust_mantle
close(27)
- ! cleans up temporary kernel arrays
- deallocate(bulk_c_kl_crust_mantle,bulk_beta_kl_crust_mantle)
-
end subroutine save_kernels_crust_mantle_iso
!
@@ -403,11 +397,11 @@
bulk_sq / alphav_sq * alphav_kl_crust_mantle(i,j,k,ispec) + &
bulk_sq / alphah_sq * alphah_kl_crust_mantle(i,j,k,ispec)
- bulk_betah_kl_crust_mantle(i,j,k,ispec ) = &
+ bulk_betah_kl_crust_mantle(i,j,k,ispec) = &
betah_kl_crust_mantle(i,j,k,ispec) + &
FOUR_THIRDS * betah_sq / alphah_sq * alphah_kl_crust_mantle(i,j,k,ispec)
- bulk_betav_kl_crust_mantle(i,j,k,ispec ) = &
+ bulk_betav_kl_crust_mantle(i,j,k,ispec) = &
betav_kl_crust_mantle(i,j,k,ispec) + &
FOUR_THIRDS * betav_sq / alphav_sq * alphav_kl_crust_mantle(i,j,k,ispec)
! the rest, K_eta and K_rho are the same as above
@@ -420,8 +414,8 @@
!rho_kl_crust_mantle(i,j,k,ispec) = rhonotprime_kl_crust_mantle(i,j,k,ispec) &
! + alpha_kl_crust_mantle(i,j,k,ispec) &
! + beta_kl_crust_mantle(i,j,k,ispec)
- bulk_beta_kl_crust_mantle(i,j,k,ispec) = bulk_betah_kl_crust_mantle(i,j,k,ispec ) &
- + bulk_betav_kl_crust_mantle(i,j,k,ispec )
+ bulk_beta_kl_crust_mantle(i,j,k,ispec) = bulk_betah_kl_crust_mantle(i,j,k,ispec) &
+ + bulk_betav_kl_crust_mantle(i,j,k,ispec)
enddo
enddo
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/src/specfem3D/specfem3D.F90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/src/specfem3D/specfem3D.F90 2013-07-08 23:12:34 UTC (rev 22553)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/src/specfem3D/specfem3D.F90 2013-07-08 23:31:35 UTC (rev 22554)
@@ -633,14 +633,21 @@
real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_CRUST_MANTLE_ADJOINT) :: rho_kl_crust_mantle, &
beta_kl_crust_mantle, alpha_kl_crust_mantle
+! additional kernels computed locally here from the other ones
real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_CRUST_MANTLE_ADJOINT) :: &
mu_kl_crust_mantle, kappa_kl_crust_mantle, rhonotprime_kl_crust_mantle
+ ! bulk parameterization
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_CRUST_MANTLE_ADJOINT) :: &
+ bulk_c_kl_crust_mantle,bulk_beta_kl_crust_mantle
! can equivalence the above arrays to save a significant amount of memory because they are used only once at the end to save
! the final kernels in save_kernels_crust_mantle(), once the Jacobian matrix elements xix xiy xiz are never needed any more
equivalence(mu_kl_crust_mantle, xix_crust_mantle)
equivalence(kappa_kl_crust_mantle, xiy_crust_mantle)
equivalence(rhonotprime_kl_crust_mantle, xiz_crust_mantle)
+ equivalence(bulk_c_kl_crust_mantle, etax_crust_mantle)
+ equivalence(bulk_beta_kl_crust_mantle, etay_crust_mantle)
+!!!!!!!!!!! equivalence(rhonotprime_kl_crust_mantle, etaz_crust_mantle)
! For anisotropic kernels (see compute_kernels.f90 for a definition of the array)
real(kind=CUSTOM_REAL), dimension(21,NGLLX,NGLLY,NGLLZ,NSPEC_CRUST_MANTLE_ADJOINT) :: cijkl_kl_crust_mantle
@@ -2549,7 +2556,8 @@
call save_kernels_crust_mantle_iso(myrank,scale_t,scale_displ, &
rho_kl_crust_mantle, &
alpha_kl_crust_mantle,beta_kl_crust_mantle, &
- mu_kl_crust_mantle, kappa_kl_crust_mantle, rhonotprime_kl_crust_mantle, &
+ mu_kl_crust_mantle,kappa_kl_crust_mantle,rhonotprime_kl_crust_mantle, &
+ bulk_c_kl_crust_mantle,bulk_beta_kl_crust_mantle, &
rhostore_crust_mantle,muvstore_crust_mantle, &
kappavstore_crust_mantle, &
LOCAL_PATH)
More information about the CIG-COMMITS
mailing list