[cig-commits] r12814 - in seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta: setup src
dkomati1 at geodynamics.org
dkomati1 at geodynamics.org
Thu Sep 4 19:10:33 PDT 2008
Author: dkomati1
Date: 2008-09-04 19:10:32 -0700 (Thu, 04 Sep 2008)
New Revision: 12814
Modified:
seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/setup/constants.h
seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/main_program.F90
seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/meshfem3D.F90
seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/read_compute_parameters.F90
seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/save_header_file.f90
seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/specfem3D.F90
Log:
now use "equivalence" statements to reuse memory between the mesher and the solver
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/setup/constants.h
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/setup/constants.h 2008-09-04 22:46:39 UTC (rev 12813)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/setup/constants.h 2008-09-05 02:10:32 UTC (rev 12814)
@@ -51,7 +51,8 @@
!! DK DK for Gordon Bell
! integer, parameter :: AMM_V_DIM1 = 14, AMM_V_DIM2 = 34, AMM_V_DIM3 = 37, AMM_V_DIM4 = 73
- integer, parameter :: AMM_V_DIM1 = 1, AMM_V_DIM2 = 1, AMM_V_DIM3 = 1, AMM_V_DIM4 = 1
+! use 6 for first index to avoid a warning when compiling
+ integer, parameter :: AMM_V_DIM1 = 6, AMM_V_DIM2 = 1, AMM_V_DIM3 = 1, AMM_V_DIM4 = 1
!
! solver in single or double precision depending on the machine (4 or 8 bytes)
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/main_program.F90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/main_program.F90 2008-09-04 22:46:39 UTC (rev 12813)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/main_program.F90 2008-09-05 02:10:32 UTC (rev 12814)
@@ -361,6 +361,44 @@
type (attenuation_model_variables) AM_V
! attenuation_model_variables
+! use equivalence statements to reduce total memory size
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_CRUST_MANTLE) :: &
+ xix_crust_mantle,xiy_crust_mantle,xiz_crust_mantle,&
+ etax_crust_mantle,etay_crust_mantle,etaz_crust_mantle, &
+ gammax_crust_mantle,gammay_crust_mantle,gammaz_crust_mantle
+
+ integer, dimension(NSPEC_CRUST_MANTLE * NGLLX * NGLLY * NGLLZ) :: locval
+ logical, dimension(NSPEC_CRUST_MANTLE * NGLLX * NGLLY * NGLLZ) :: ifseg
+
+ integer, dimension(NGLLX,NGLLY,NGLLZ,NSPEC_CRUST_MANTLE) :: copy_ibool_ori
+
+ integer, dimension(NGLOB_CRUST_MANTLE) :: mask_ibool
+
+ double precision, dimension(NGLLX,NGLLY,NGLLZ,NSPEC_CRUST_MANTLE) :: xstore,ystore,zstore
+
+! displacement, velocity, acceleration
+ real(kind=CUSTOM_REAL), dimension(NDIM,NGLOB_CRUST_MANTLE) :: displ_crust_mantle
+
+ equivalence(locval, xix_crust_mantle)
+ equivalence(ifseg, xiy_crust_mantle)
+ equivalence(copy_ibool_ori, xiz_crust_mantle)
+
+ equivalence(xstore, etax_crust_mantle)
+ equivalence(ystore, etay_crust_mantle)
+ equivalence(zstore, etaz_crust_mantle)
+
+ equivalence(mask_ibool, displ_crust_mantle)
+
+! because NSPEC_OUTER_CORE is always an even number, we can put
+! two single-precision arrays in each double-precision array.
+! this does *NOT* work if double precision is turned on because
+! the size of an integer does not correspond to the size of a double.
+! but if one comments out the three lines below the other equivalence statements
+! above will work fine even in double precision.
+ equivalence(xstore(1,1,1,NSPEC_CRUST_MANTLE/2+1), gammax_crust_mantle)
+ equivalence(ystore(1,1,1,NSPEC_CRUST_MANTLE/2+1), gammay_crust_mantle)
+ equivalence(zstore(1,1,1,NSPEC_CRUST_MANTLE/2+1), gammaz_crust_mantle)
+
! ************** PROGRAM STARTS HERE **************
! initialize the MPI communicator and start the NPROCTOT MPI processes.
@@ -384,6 +422,9 @@
sizeprocs = NPROCTOT_VAL
#endif
+ if(CUSTOM_REAL /= 4) &
+ stop 'some of the equivalence statements used to save memory do not work in double precision, please edit and recompile'
+
! YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYY
!! DK DK for the merged version, mesher inserted here
@@ -407,7 +448,8 @@
npoin2D_faces_outer_core,npoin2D_xi_outer_core,npoin2D_eta_outer_core, &
npoin2D_faces_inner_core,npoin2D_xi_inner_core,npoin2D_eta_inner_core, &
#endif
- rmass_ocean_load,normal_top_crust_mantle,ibelm_top_crust_mantle,AM_V)
+ rmass_ocean_load,normal_top_crust_mantle,ibelm_top_crust_mantle,AM_V, &
+ locval,ifseg,copy_ibool_ori,mask_ibool,xstore,ystore,zstore)
! synchronize all the processes to make sure everybody has finished creating the mesh
#ifdef USE_MPI
@@ -482,7 +524,9 @@
npoin2D_faces_inner_core,npoin2D_xi_inner_core,npoin2D_eta_inner_core, &
normal_top_crust_mantle,ibelm_top_crust_mantle, &
#endif
- AM_V)
+ AM_V,xix_crust_mantle,xiy_crust_mantle,xiz_crust_mantle,&
+ etax_crust_mantle,etay_crust_mantle,etaz_crust_mantle, &
+ gammax_crust_mantle,gammay_crust_mantle,gammaz_crust_mantle,displ_crust_mantle)
! synchronize all the processes to make sure everybody has finished
#ifdef USE_MPI
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/meshfem3D.F90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/meshfem3D.F90 2008-09-04 22:46:39 UTC (rev 12813)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/meshfem3D.F90 2008-09-05 02:10:32 UTC (rev 12814)
@@ -54,7 +54,8 @@
npoin2D_faces_outer_core,npoin2D_xi_outer_core,npoin2D_eta_outer_core, &
npoin2D_faces_inner_core,npoin2D_xi_inner_core,npoin2D_eta_inner_core, &
#endif
- rmass_ocean_load,normal_top_crust_mantle,ibelm_top_crust_mantle,AM_V)
+ rmass_ocean_load,normal_top_crust_mantle,ibelm_top_crust_mantle,AM_V, &
+ locval,ifseg,copy_ibool_ori,mask_ibool,xstore,ystore,zstore)
use dyn_array
@@ -526,8 +527,8 @@
real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_CRUST_MANTLE_STACEY) :: rho_vp,rho_vs
- double precision, dimension(NGLLX,NGLLY,NGLLZ,NSPEC_CRUST_MANTLE_ATTENUAT) :: Qmu_store
- double precision, dimension(N_SLS,NGLLX,NGLLY,NGLLZ,NSPEC_CRUST_MANTLE_ATTENUAT) :: tau_e_store
+ double precision, dimension(NGLLX,NGLLY,NGLLZ,NSPEC_CRUST_MANTLE_ATTENUAT3D) :: Qmu_store
+ double precision, dimension(N_SLS,NGLLX,NGLLY,NGLLZ,NSPEC_CRUST_MANTLE_ATTENUAT3D) :: tau_e_store
!!!!! DK DK for merged version, all the arrays below are allocated statically instead
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/read_compute_parameters.F90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/read_compute_parameters.F90 2008-09-04 22:46:39 UTC (rev 12813)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/read_compute_parameters.F90 2008-09-05 02:10:32 UTC (rev 12814)
@@ -142,6 +142,9 @@
integer :: tmp_sum_nglob2D_xi, tmp_sum_nglob2D_eta,divider,nglob_edges_h,nglob_edge_v,to_remove
+ if(CUSTOM_REAL /= 4) &
+ stop 'some of the equivalence statements used to save memory do not work in double precision, please edit and recompile'
+
! get the base pathname for output files
call get_value_string(OUTPUT_FILES, 'OUTPUT_FILES', 'OUTPUT_FILES')
@@ -1248,12 +1251,22 @@
REFERENCE_1D_MODEL == REFERENCE_MODEL_SEA1D) .and. TRANSVERSE_ISOTROPY) &
stop 'models IASP91, AK135, 1066A, JP1D and SEA1D are currently isotropic'
- ELEMENT_WIDTH = ANGULAR_WIDTH_XI_IN_DEGREES/dble(NEX_MAX) * DEGREES_TO_RADIANS
+ if(TOPOGRAPHY .and. (NX_BATHY == 1 .or. NY_BATHY == 1)) &
+ stop 'topography model has been turned off, please edit and recompile'
+ if(ANISOTROPIC_3D_MANTLE .and. (AMM_V_DIM2 == 1 .or. AMM_V_DIM3 == 1 .or. AMM_V_DIM4 == 1)) &
+ stop 'anisotropic mantle model has been turned off, please edit and recompile'
+
+ if(REFERENCE_1D_MODEL == REFERENCE_MODEL_SEA1D .and. &
+ (SEA99_VS_DIM1 == 1 .or. SEA99_VS_DIM2 == 1 .or. SEA99_VS_DIM3 == 1)) &
+ stop 'model SEA99 has been turned off, please edit and recompile'
+
!
!--- compute additional parameters
!
+ ELEMENT_WIDTH = ANGULAR_WIDTH_XI_IN_DEGREES/dble(NEX_MAX) * DEGREES_TO_RADIANS
+
! number of elements horizontally in each slice (i.e. per processor)
! these two values MUST be equal in all cases
NEX_PER_PROC_XI = NEX_XI / NPROC_XI
@@ -2458,6 +2471,9 @@
if(minval(NSPEC) <= 0) stop 'negative NSPEC, there is a problem somewhere'
+ if(mod(NSPEC(IREGION_CRUST_MANTLE),2) /= 0) &
+ stop 'some of the equivalence statements used to save memory require an even NSPEC(IREGION_CRUST_MANTLE)'
+
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!
!!!!!! calculation of number of points (NGLOB) below
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/save_header_file.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/save_header_file.f90 2008-09-04 22:46:39 UTC (rev 12813)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/save_header_file.f90 2008-09-05 02:10:32 UTC (rev 12814)
@@ -287,6 +287,13 @@
write(IOUT,*)
write(IOUT,*) 'integer, parameter :: NSPEC_CRUST_MANTLE_ATTENUAT = ',NSPEC_CRUST_MANTLE_ATTENUAT
+
+ if(ATTENUATION_3D) then
+ write(IOUT,*) 'integer, parameter :: NSPEC_CRUST_MANTLE_ATTENUAT3D = ',NSPEC_CRUST_MANTLE_ATTENUAT
+ else
+ write(IOUT,*) 'integer, parameter :: NSPEC_CRUST_MANTLE_ATTENUAT3D = 1'
+ endif
+
write(IOUT,*) 'integer, parameter :: NSPEC_INNER_CORE_ATTENUATION = ',NSPEC_INNER_CORE_ATTENUATION
write(IOUT,*)
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/specfem3D.F90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/specfem3D.F90 2008-09-04 22:46:39 UTC (rev 12813)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/specfem3D.F90 2008-09-05 02:10:32 UTC (rev 12814)
@@ -53,7 +53,9 @@
npoin2D_faces_inner_core,npoin2D_xi_inner_core,npoin2D_eta_inner_core, &
normal_top_crust_mantle,ibelm_top_crust_mantle, &
#endif
- AM_V)
+ AM_V,xix_crust_mantle,xiy_crust_mantle,xiz_crust_mantle,&
+ etax_crust_mantle,etay_crust_mantle,etaz_crust_mantle, &
+ gammax_crust_mantle,gammay_crust_mantle,gammaz_crust_mantle,displ_crust_mantle)
use dyn_array
More information about the cig-commits
mailing list