[cig-commits] r12586 - in seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta: OUTPUT_FILES src

dkomati1 at geodynamics.org dkomati1 at geodynamics.org
Thu Aug 7 16:22:15 PDT 2008


Author: dkomati1
Date: 2008-08-07 16:22:15 -0700 (Thu, 07 Aug 2008)
New Revision: 12586

Modified:
   seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/OUTPUT_FILES/values_from_mesher.h
   seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/meshfem3D.f90
Log:
converted the new version of meshfem3D.f90 (called as a subroutine from
main_program.f90) from heap to stack memory


Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/OUTPUT_FILES/values_from_mesher.h
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/OUTPUT_FILES/values_from_mesher.h	2008-08-07 23:02:22 UTC (rev 12585)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/OUTPUT_FILES/values_from_mesher.h	2008-08-07 23:22:15 UTC (rev 12586)
@@ -6,11 +6,11 @@
  ! ---------------
  !
  !
- ! number of chunks =            3
+ ! number of chunks =            1
  !
  ! these statistics do not include the central cube
  !
- ! number of processors =           12
+ ! number of processors =            4
  !
  ! maximum number of points per region =       576013
  !
@@ -83,8 +83,8 @@
  !   (if significantly more, the job will not run by lack of memory)
  !   (if significantly less, you waste a significant amount of memory)
  !
- ! size of static arrays for all slices =   0.976158142089844       GB
- !                                      =   9.532794356346130E-004  TB
+ ! size of static arrays for all slices =   0.325386047363281       GB
+ !                                      =   3.177598118782043E-004  TB
  !
  
  integer, parameter :: NEX_XI_VAL =           64
@@ -157,12 +157,12 @@
  integer, parameter :: NGLOB2DMAX_YMIN_YMAX_IC =          178
  integer, parameter :: NPROC_XI_VAL =            2
  integer, parameter :: NPROC_ETA_VAL =            2
- integer, parameter :: NCHUNKS_VAL =            3
- integer, parameter :: NPROCTOT_VAL =           12
+ integer, parameter :: NCHUNKS_VAL =            1
+ integer, parameter :: NPROCTOT_VAL =            4
  integer, parameter :: NGLOB2DMAX_XY_VAL_CM =         8574
  integer, parameter :: NGLOB2DMAX_XY_VAL_OC =         2134
  integer, parameter :: NGLOB2DMAX_XY_VAL_IC =          178
- integer, parameter :: NUMMSGS_FACES_VAL =            6
+ integer, parameter :: NUMMSGS_FACES_VAL =            2
  integer, parameter :: NCORNERSCHUNKS_VAL =            1
  integer, parameter :: ATT1 =            1
  integer, parameter :: ATT2 =            1

Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/meshfem3D.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/meshfem3D.f90	2008-08-07 23:02:22 UTC (rev 12585)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/meshfem3D.f90	2008-08-07 23:22:15 UTC (rev 12586)
@@ -290,11 +290,13 @@
 
   integer nspec_aniso,npointot
 
+! allocate these automatic arrays in the memory stack to avoid memory fragmentation with "allocate()"
+! use the size of the largest region (crust_mantle) and therefore largest possible array
 ! arrays with the mesh in double precision
-  double precision, dimension(:,:,:,:), allocatable :: xstore,ystore,zstore
+  double precision, dimension(NGLLX,NGLLY,NGLLZ,NSPEC_CRUST_MANTLE) :: xstore,ystore,zstore
 
 ! proc numbers for MPI
-  integer myrank,sizeprocs,ier,errorcode
+  integer myrank,sizeprocs,ier
 
 ! check area and volume of the final mesh
   double precision area_local_bottom,area_total_bottom
@@ -308,13 +310,17 @@
   integer iproc_xi,iproc_eta,ichunk
 
 !! DK DK for the merged version
-  integer, dimension(:), allocatable :: ibool1D_leftxi_lefteta,ibool1D_rightxi_lefteta, &
+! allocate these automatic arrays in the memory stack to avoid memory fragmentation with "allocate()"
+! use the size of the largest region (crust_mantle) and therefore largest possible array
+  integer, dimension(NGLOB1D_RADIAL_CM) :: ibool1D_leftxi_lefteta,ibool1D_rightxi_lefteta, &
              ibool1D_leftxi_righteta,ibool1D_rightxi_righteta
-  double precision, dimension(:), allocatable :: xread1D_leftxi_lefteta,xread1D_rightxi_lefteta, &
-             xread1D_leftxi_righteta,xread1D_rightxi_righteta
-  double precision, dimension(:), allocatable :: yread1D_leftxi_lefteta,yread1D_rightxi_lefteta, &
-             yread1D_leftxi_righteta,yread1D_rightxi_righteta
-  double precision, dimension(:), allocatable :: zread1D_leftxi_lefteta,zread1D_rightxi_lefteta, &
+
+  double precision, dimension(NGLOB1D_RADIAL_CM) :: &
+             xread1D_leftxi_lefteta,xread1D_rightxi_lefteta, &
+             xread1D_leftxi_righteta,xread1D_rightxi_righteta, &
+             yread1D_leftxi_lefteta,yread1D_rightxi_lefteta, &
+             yread1D_leftxi_righteta,yread1D_rightxi_righteta, &
+             zread1D_leftxi_lefteta,zread1D_rightxi_lefteta, &
              zread1D_leftxi_righteta,zread1D_rightxi_righteta
 
 ! rotation matrix from Euler angles
@@ -1136,91 +1142,6 @@
   volume_total = ZERO
 
 !! DK DK for the merged version
-  allocate(ibool1D_leftxi_lefteta(maxval(NGLOB1D_RADIAL_CORNER)),STAT=ier)
-  if (ier /= 0) then
-    print *,"ABORTING can not allocate in meshfem3D ier=",ier
-    call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
-  endif
-  allocate(ibool1D_rightxi_lefteta(maxval(NGLOB1D_RADIAL_CORNER)),STAT=ier)
-  if (ier /= 0) then
-    print *,"ABORTING can not allocate in meshfem3D ier=",ier
-    call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
-  endif
-  allocate(ibool1D_leftxi_righteta(maxval(NGLOB1D_RADIAL_CORNER)),STAT=ier)
-  if (ier /= 0) then
-    print *,"ABORTING can not allocate in meshfem3D ier=",ier
-    call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
-  endif
-  allocate(ibool1D_rightxi_righteta(maxval(NGLOB1D_RADIAL_CORNER)),STAT=ier)
-  if (ier /= 0) then
-    print *,"ABORTING can not allocate in meshfem3D ier=",ier
-    call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
-  endif
-
-  allocate(xread1D_leftxi_lefteta(maxval(NGLOB1D_RADIAL_CORNER)),STAT=ier)
-  if (ier /= 0) then
-    print *,"ABORTING can not allocate in meshfem3D ier=",ier
-    call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
-  endif
-  allocate(xread1D_rightxi_lefteta(maxval(NGLOB1D_RADIAL_CORNER)),STAT=ier)
-  if (ier /= 0) then
-    print *,"ABORTING can not allocate in meshfem3D ier=",ier
-    call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
-  endif
-  allocate(xread1D_leftxi_righteta(maxval(NGLOB1D_RADIAL_CORNER)),STAT=ier)
-  if (ier /= 0) then
-    print *,"ABORTING can not allocate in meshfem3D ier=",ier
-    call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
-  endif
-  allocate(xread1D_rightxi_righteta(maxval(NGLOB1D_RADIAL_CORNER)),STAT=ier)
-  if (ier /= 0) then
-    print *,"ABORTING can not allocate in meshfem3D ier=",ier
-    call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
-  endif
-
-  allocate(yread1D_leftxi_lefteta(maxval(NGLOB1D_RADIAL_CORNER)),STAT=ier)
-  if (ier /= 0) then
-    print *,"ABORTING can not allocate in meshfem3D ier=",ier
-    call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
-  endif
-  allocate(yread1D_rightxi_lefteta(maxval(NGLOB1D_RADIAL_CORNER)),STAT=ier)
-  if (ier /= 0) then
-    print *,"ABORTING can not allocate in meshfem3D ier=",ier
-    call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
-  endif
-  allocate(yread1D_leftxi_righteta(maxval(NGLOB1D_RADIAL_CORNER)),STAT=ier)
-  if (ier /= 0) then
-    print *,"ABORTING can not allocate in meshfem3D ier=",ier
-    call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
-  endif
-  allocate(yread1D_rightxi_righteta(maxval(NGLOB1D_RADIAL_CORNER)),STAT=ier)
-  if (ier /= 0) then
-    print *,"ABORTING can not allocate in meshfem3D ier=",ier
-    call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
-  endif
-
-  allocate(zread1D_leftxi_lefteta(maxval(NGLOB1D_RADIAL_CORNER)),STAT=ier)
-  if (ier /= 0) then
-    print *,"ABORTING can not allocate in meshfem3D ier=",ier
-    call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
-  endif
-  allocate(zread1D_rightxi_lefteta(maxval(NGLOB1D_RADIAL_CORNER)),STAT=ier)
-  if (ier /= 0) then
-    print *,"ABORTING can not allocate in meshfem3D ier=",ier
-    call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
-  endif
-  allocate(zread1D_leftxi_righteta(maxval(NGLOB1D_RADIAL_CORNER)),STAT=ier)
-  if (ier /= 0) then
-    print *,"ABORTING can not allocate in meshfem3D ier=",ier
-    call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
-  endif
-  allocate(zread1D_rightxi_righteta(maxval(NGLOB1D_RADIAL_CORNER)),STAT=ier)
-  if (ier /= 0) then
-    print *,"ABORTING can not allocate in meshfem3D ier=",ier
-    call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
-  endif
-
-!! DK DK for the merged version
   include 'allocate_before.f90'
 
 !----
@@ -1256,23 +1177,6 @@
 ! compute maximum number of points
   npointot = NSPEC(iregion_code) * NGLLX * NGLLY * NGLLZ
 
-! use dynamic allocation to allocate memory for arrays
-  allocate(xstore(NGLLX,NGLLY,NGLLZ,NSPEC(iregion_code)),STAT=ier)
-  if (ier /= 0) then
-    print *,"ABORTING can not allocate in meshfem3D ier=",ier
-    call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
-  endif
-  allocate(ystore(NGLLX,NGLLY,NGLLZ,NSPEC(iregion_code)),STAT=ier)
-  if (ier /= 0) then
-    print *,"ABORTING can not allocate in meshfem3D ier=",ier
-    call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
-  endif
-  allocate(zstore(NGLLX,NGLLY,NGLLZ,NSPEC(iregion_code)),STAT=ier)
-  if (ier /= 0) then
-    print *,"ABORTING can not allocate in meshfem3D ier=",ier
-    call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
-  endif
-
 ! create all the regions of the mesh
 ! perform two passes in this part to be able to save memory
   do ipass = 1,2
@@ -1542,35 +1446,9 @@
     endif
   endif
 
-! deallocate arrays used for that region
-  deallocate(xstore)
-  deallocate(ystore)
-  deallocate(zstore)
-
 ! end of loop on all the regions
   enddo
 
-!! DK DK for the merged version
-  deallocate(ibool1D_leftxi_lefteta)
-  deallocate(ibool1D_rightxi_lefteta)
-  deallocate(ibool1D_leftxi_righteta)
-  deallocate(ibool1D_rightxi_righteta)
-
-  deallocate(xread1D_leftxi_lefteta)
-  deallocate(xread1D_rightxi_lefteta)
-  deallocate(xread1D_leftxi_righteta)
-  deallocate(xread1D_rightxi_righteta)
-
-  deallocate(yread1D_leftxi_lefteta)
-  deallocate(yread1D_rightxi_lefteta)
-  deallocate(yread1D_leftxi_righteta)
-  deallocate(yread1D_rightxi_righteta)
-
-  deallocate(zread1D_leftxi_lefteta)
-  deallocate(zread1D_rightxi_lefteta)
-  deallocate(zread1D_leftxi_righteta)
-  deallocate(zread1D_rightxi_righteta)
-
   if(myrank == 0) then
 ! check volume of chunk
       write(IMAIN,*)



More information about the cig-commits mailing list