[cig-commits] r12571 - seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src
dkomati1 at geodynamics.org
dkomati1 at geodynamics.org
Wed Aug 6 17:52:00 PDT 2008
Author: dkomati1
Date: 2008-08-06 17:51:59 -0700 (Wed, 06 Aug 2008)
New Revision: 12571
Modified:
seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/create_chunk_buffers.f90
seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/create_list_files_chunks.f90
seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/declarations_mesher.f90
seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/meshfem3D.f90
Log:
converted create_chunk_buffers.f90 from heap to stack, and merged create_list_files_chunks.f90 with create_chunk_buffers.f90
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/create_chunk_buffers.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/create_chunk_buffers.f90 2008-08-07 00:09:55 UTC (rev 12570)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/create_chunk_buffers.f90 2008-08-07 00:51:59 UTC (rev 12571)
@@ -41,7 +41,7 @@
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, &
- iprocfrom_faces,iprocto_faces,iproc_master_corners,iproc_worker1_corners,iproc_worker2_corners, &
+ iprocfrom_faces,iprocto_faces,imsg_type,iproc_master_corners,iproc_worker1_corners,iproc_worker2_corners, &
iboolfaces,npoin2D_faces,iboolcorner,NGLOB1D_RADIAL,NGLOB2DMAX_XY)
implicit none
@@ -68,12 +68,11 @@
!---- arrays to assemble between chunks
! communication pattern for faces between chunks
- integer, dimension(NUMMSGS_FACES_VAL) :: iprocfrom_faces,iprocto_faces
+ integer, dimension(NUMMSGS_FACES_VAL) :: imsg_type,iprocfrom_faces,iprocto_faces
! communication pattern for corners between chunks
integer, dimension(NCORNERSCHUNKS_VAL) :: iproc_master_corners,iproc_worker1_corners,iproc_worker2_corners
-
integer, dimension(MAX_NUM_REGIONS,NB_SQUARE_CORNERS) :: NGLOB1D_RADIAL_CORNER
integer nglob,nglob_ori
@@ -95,22 +94,24 @@
integer idoubling(nspec)
+! allocate these automatic arrays in the memory stack to avoid memory fragmentation with "allocate()"
+
! mask for ibool to mark points already found
- logical, dimension(:), allocatable :: mask_ibool
+ logical, dimension(nglob_ori) :: mask_ibool
! array to store points selected for the chunk face buffer
- integer, dimension(:), allocatable :: ibool_selected
+ integer, dimension(NGLOB2DMAX_XY) :: ibool_selected
- double precision, dimension(:), allocatable :: xstore_selected,ystore_selected,zstore_selected
+ double precision, dimension(NGLOB2DMAX_XY) :: xstore_selected,ystore_selected,zstore_selected
! arrays for sorting routine
- integer, dimension(:), allocatable :: ind,ninseg,iglob,locval,iwork
- logical, dimension(:), allocatable :: ifseg
- double precision, dimension(:), allocatable :: work
+ integer, dimension(NGLOB2DMAX_XY) :: ind,ninseg,iglob,locval,iwork
+ logical, dimension(NGLOB2DMAX_XY) :: ifseg
+ double precision, dimension(NGLOB2DMAX_XY) :: work
! pairs generated theoretically
! four sides for each of the three types of messages
- integer, dimension(:), allocatable :: iproc_sender,iproc_receiver,npoin2D_send,npoin2D_receive
+ integer, dimension(:), allocatable :: npoin2D_send,npoin2D_receive
! 1D buffers to remove points belonging to corners
integer ibool1D_leftxi_lefteta(NGLOB1D_RADIAL_MAX)
@@ -140,7 +141,7 @@
integer iregion_code
integer iproc_edge_send,iproc_edge_receive
- integer imsg_type,iside,imode_comm,iedge
+ integer imsg_type_loop,iside,imode_comm,iedge
! boundary parameters per slice
integer nspec2D_xmin,nspec2D_xmax,nspec2D_ymin,nspec2D_ymax
@@ -219,19 +220,9 @@
! same number of GLL points in each direction for several chunks
if(NGLLY /= NGLLX) call exit_MPI(myrank,'must have NGLLY = NGLLX for several chunks')
-! allocate arrays for faces
- allocate(iproc_sender(NUMMSGS_FACES))
- allocate(iproc_receiver(NUMMSGS_FACES))
- allocate(npoin2D_send(NUMMSGS_FACES))
- allocate(npoin2D_receive(NUMMSGS_FACES))
-
-! allocate array for corners
- allocate(iprocscorners(3,NCORNERSCHUNKS))
- allocate(itypecorner(3,NCORNERSCHUNKS))
-
-! clear arrays allocated
- iproc_sender(:) = 0
- iproc_receiver(:) = 0
+! clear arrays
+ iprocfrom_faces(:) = 0
+ iprocto_faces(:) = 0
npoin2D_send(:) = 0
npoin2D_receive(:) = 0
iprocscorners(:,:) = 0
@@ -242,23 +233,6 @@
write(IMAIN,*)
endif
-! allocate arrays for message buffers with maximum size
- allocate(ibool_selected(NGLOB2DMAX_XY))
- allocate(xstore_selected(NGLOB2DMAX_XY))
- allocate(ystore_selected(NGLOB2DMAX_XY))
- allocate(zstore_selected(NGLOB2DMAX_XY))
- allocate(ind(NGLOB2DMAX_XY))
- allocate(ninseg(NGLOB2DMAX_XY))
- allocate(iglob(NGLOB2DMAX_XY))
- allocate(locval(NGLOB2DMAX_XY))
- allocate(ifseg(NGLOB2DMAX_XY))
- allocate(iwork(NGLOB2DMAX_XY))
- allocate(work(NGLOB2DMAX_XY))
-
-
-! allocate mask for ibool
- allocate(mask_ibool(nglob_ori))
-
imsg = 0
!!!!!!!!!! DK DK for merged version: beginning of "faces" section here
@@ -270,7 +244,7 @@
!!!!!!!!!! DK DK for merged version: beginning of "faces" section here
! create theoretical communication pattern
- do imsg_type = 1,NUM_MSG_TYPES
+ do imsg_type_loop = 1,NUM_MSG_TYPES
do iside = 1,NUM_FACES
do iproc_loop = 0,NPROC_ONE_DIRECTION-1
@@ -296,7 +270,7 @@
! define the 12 different messages
! message type M1
- if(imsg_type == 1) then
+ if(imsg_type_loop == 1) then
if(iside == 1) then
ichunk_send = CHUNK_AB
@@ -345,7 +319,7 @@
endif
! message type M2
- if(imsg_type == 2) then
+ if(imsg_type_loop == 2) then
if(iside == 1) then
ichunk_send = CHUNK_AB
@@ -394,7 +368,7 @@
endif
! message type M3
- if(imsg_type == 3) then
+ if(imsg_type_loop == 3) then
if(iside == 1) then
ichunk_send = CHUNK_AC
@@ -444,26 +418,27 @@
! store addressing generated
- iproc_sender(imsg) = addressing(ichunk_send,iproc_xi_send,iproc_eta_send)
- iproc_receiver(imsg) = addressing(ichunk_receive,iproc_xi_receive,iproc_eta_receive)
+ iprocfrom_faces(imsg) = addressing(ichunk_send,iproc_xi_send,iproc_eta_send)
+ iprocto_faces(imsg) = addressing(ichunk_receive,iproc_xi_receive,iproc_eta_receive)
+ imsg_type(imsg) = imsg_type_loop
! check that sender/receiver pair is ordered
- if(iproc_sender(imsg) > iproc_receiver(imsg)) call exit_MPI(myrank,'incorrect order in sender/receiver pair')
+ if(iprocfrom_faces(imsg) > iprocto_faces(imsg)) call exit_MPI(myrank,'incorrect order in sender/receiver pair')
! save message type and pair of processors in list of messages
-!!! DK DK for merged if(myrank == 0) write(IOUT,*) imsg_type,iproc_sender(imsg),iproc_receiver(imsg)
+!!! DK DK for merged if(myrank == 0) write(IOUT,*) imsg_type(imsg),iprocfrom_faces(imsg),iprocto_faces(imsg)
! loop on sender/receiver (1=sender 2=receiver)
do imode_comm=1,2
if(imode_comm == 1) then
- iproc = iproc_sender(imsg)
+ iproc = iprocfrom_faces(imsg)
iedge = iproc_edge_send
!! DK DK commented this out for the merged version
! write(filename_out,"('buffer_faces_chunks_sender_msg',i6.6,'.txt')") imsg
else if(imode_comm == 2) then
- iproc = iproc_receiver(imsg)
+ iproc = iprocto_faces(imsg)
iedge = iproc_edge_receive
!! DK DK commented this out for the merged version
! write(filename_out,"('buffer_faces_chunks_receiver_msg',i6.6,'.txt')") imsg
@@ -771,13 +746,13 @@
! gather number of points for sender
npoin2D_send_local = npoin2D_send(imsg)
- call MPI_BCAST(npoin2D_send_local,1,MPI_INTEGER,iproc_sender(imsg),MPI_COMM_WORLD,ier)
- if(myrank /= iproc_sender(imsg)) npoin2D_send(imsg) = npoin2D_send_local
+ call MPI_BCAST(npoin2D_send_local,1,MPI_INTEGER,iprocfrom_faces(imsg),MPI_COMM_WORLD,ier)
+ if(myrank /= iprocfrom_faces(imsg)) npoin2D_send(imsg) = npoin2D_send_local
! gather number of points for receiver
npoin2D_receive_local = npoin2D_receive(imsg)
- call MPI_BCAST(npoin2D_receive_local,1,MPI_INTEGER,iproc_receiver(imsg),MPI_COMM_WORLD,ier)
- if(myrank /= iproc_receiver(imsg)) npoin2D_receive(imsg) = npoin2D_receive_local
+ call MPI_BCAST(npoin2D_receive_local,1,MPI_INTEGER,iprocto_faces(imsg),MPI_COMM_WORLD,ier)
+ if(myrank /= iprocto_faces(imsg)) npoin2D_receive(imsg) = npoin2D_receive_local
enddo
@@ -902,13 +877,13 @@
! loop on the three processors of a given corner
do imember_corner = 1,3
- if(imember_corner == 1) then
+! if(imember_corner == 1) then
! write(filename_out,"('buffer_corners_chunks_master_msg',i6.6,'.txt')") imsg
- else if(imember_corner == 2) then
+! else if(imember_corner == 2) then
! write(filename_out,"('buffer_corners_chunks_worker1_msg',i6.6,'.txt')") imsg
- else
+! else
! write(filename_out,"('buffer_corners_chunks_worker2_msg',i6.6,'.txt')") imsg
- endif
+! endif
! only do this if current processor is the right one for MPI version
! this line is ok even for NCHUNKS = 2
@@ -922,14 +897,14 @@
!---- read indirect addressing for each message for corners of the chunks
!---- a given slice can belong to at most one corner
! check that we have found the right correspondance
- if(imember_corner == 1 .and. myrank /= iproc_master_corners(imsg)) call exit_MPI(myrank,'this message should be for a master')
- if(imember_corner == 2 .and. myrank /= iproc_worker1_corners(imsg)) call exit_MPI(myrank,'this message should be for a worker1')
- if(imember_corner == 3 .and. myrank /= iproc_worker2_corners(imsg)) call exit_MPI(myrank,'this message should be for a worker2')
+ if(imember_corner == 1 .and. myrank /= iprocscorners(1,imsg)) call exit_MPI(myrank,'this message should be for a master')
+ if(imember_corner == 2 .and. myrank /= iprocscorners(2,imsg)) call exit_MPI(myrank,'this message should be for a worker1')
+ if(imember_corner == 3 .and. myrank /= iprocscorners(3,imsg)) call exit_MPI(myrank,'this message should be for a worker2')
icount_corners = 0
do imsg2 = 1,imsg
- if(myrank == iproc_master_corners(imsg2) .or. &
- myrank == iproc_worker1_corners(imsg2) .or. &
- myrank == iproc_worker2_corners(imsg2)) then
+ if(myrank == iprocscorners(1,imsg2) .or. &
+ myrank == iprocscorners(2,imsg2) .or. &
+ myrank == iprocscorners(3,imsg2)) then
icount_corners = icount_corners + 1
if(icount_corners>1 .and. (NPROC_XI > 1 .or. NPROC_ETA > 1)) &
call exit_MPI(myrank,'more than one corner for this slice')
@@ -1012,28 +987,10 @@
enddo
-! deallocate arrays
- deallocate(iproc_sender)
- deallocate(iproc_receiver)
- deallocate(npoin2D_send)
- deallocate(npoin2D_receive)
+! save arrays in a slightly different format for historical reasons
+ iproc_master_corners(:) = iprocscorners(1,:)
+ iproc_worker1_corners(:) = iprocscorners(2,:)
+ iproc_worker2_corners(:) = iprocscorners(3,:)
- deallocate(iprocscorners)
- deallocate(itypecorner)
-
- deallocate(ibool_selected)
- deallocate(xstore_selected)
- deallocate(ystore_selected)
- deallocate(zstore_selected)
- deallocate(ind)
- deallocate(ninseg)
- deallocate(iglob)
- deallocate(locval)
- deallocate(ifseg)
- deallocate(iwork)
- deallocate(work)
-
- deallocate(mask_ibool)
-
end subroutine create_chunk_buffers
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/create_list_files_chunks.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/create_list_files_chunks.f90 2008-08-07 00:09:55 UTC (rev 12570)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/create_list_files_chunks.f90 2008-08-07 00:51:59 UTC (rev 12571)
@@ -29,6 +29,7 @@
!! DK DK for merged version: the code below was merged from several routines
!! DK DK from the old mesher; it could therefore probably be cleaned and simplified
+!! DK DK or even probably be merged with create_chunk_buffers.f90
subroutine create_list_files_chunks(iregion_code, &
nglob_ori,NPROC_XI,NPROC_ETA,NPROCTOT,NGLOB1D_RADIAL_CORNER, &
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/declarations_mesher.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/declarations_mesher.f90 2008-08-07 00:09:55 UTC (rev 12570)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/declarations_mesher.f90 2008-08-07 00:51:59 UTC (rev 12571)
@@ -147,3 +147,12 @@
integer :: nrec,ios
character(len=150) :: STATIONS,rec_filename,dummystring
+!! DK DK added this for the merged version
+!---- arrays to assemble between chunks
+
+! communication pattern for faces between chunks
+ integer, dimension(NUMMSGS_FACES_VAL) :: imsg_type,iprocfrom_faces,iprocto_faces
+
+! communication pattern for corners between chunks
+ integer, dimension(NCORNERSCHUNKS_VAL) :: iproc_master_corners,iproc_worker1_corners,iproc_worker2_corners
+
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/meshfem3D.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/meshfem3D.f90 2008-08-07 00:09:55 UTC (rev 12570)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/meshfem3D.f90 2008-08-07 00:51:59 UTC (rev 12571)
@@ -622,17 +622,6 @@
!! DK DK for the merged version
include 'declarations_mesher.f90'
-!! DK DK added this for the merged version
-!---- arrays to assemble between chunks
-
- integer :: imsg
-
-! communication pattern for faces between chunks
- integer, dimension(NUMMSGS_FACES_VAL) :: iprocfrom_faces,iprocto_faces,imsg_type
-
-! communication pattern for corners between chunks
- integer, dimension(NCORNERSCHUNKS_VAL) :: iproc_master_corners,iproc_worker1_corners,iproc_worker2_corners
-
! ************** PROGRAM STARTS HERE **************
! initialize the MPI communicator and start the NPROCTOT MPI processes.
@@ -1728,55 +1717,7 @@
endif
!! $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
-!! DK DK added this for merged version
-! create the list of messages in files to assemble between chunks if more than one chunk
-! create it only once (and for all) therefore for first region only, because constant
- if(NCHUNKS > 1 .and. iregion_code == IREGION_CRUST_MANTLE) then
- call create_list_files_chunks(iregion_code, &
- nglob(iregion_code),NPROC_XI,NPROC_ETA,NPROCTOT,NGLOB1D_RADIAL_CORNER, &
- myrank,addressing,ichunk_slice,iproc_xi_slice,iproc_eta_slice,NCHUNKS, &
- imsg_type,iprocfrom_faces,iprocto_faces, &
- iproc_master_corners,iproc_worker1_corners,iproc_worker2_corners)
-
- call MPI_BCAST(imsg_type,NUMMSGS_FACES_VAL,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(iprocfrom_faces,NUMMSGS_FACES_VAL,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(iprocto_faces,NUMMSGS_FACES_VAL,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
-
- call MPI_BCAST(iproc_master_corners,NCORNERSCHUNKS_VAL,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(iproc_worker1_corners,NCORNERSCHUNKS_VAL,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- call MPI_BCAST(iproc_worker2_corners,NCORNERSCHUNKS_VAL,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- endif
-
-! check chunk messages only if more than one chunk
- if(NCHUNKS_VAL /= 1) then
-
-! check messages to assemble between chunks with MPI
- do imsg = 1,NUMMSGS_FACES_VAL
- if (iprocfrom_faces(imsg) < 0 &
- .or. iprocto_faces(imsg) < 0 &
- .or. iprocfrom_faces(imsg) > NPROCTOT-1 &
- .or. iprocto_faces(imsg) > NPROCTOT-1) &
- call exit_MPI(myrank,'incorrect chunk faces numbering')
- if (imsg_type(imsg) < 1 .or. imsg_type(imsg) > 3) &
- call exit_MPI(myrank,'incorrect message type labeling')
- enddo
-
-! check the list of processors for each message for corners
- do imsg = 1,NCORNERSCHUNKS_VAL
- if (iproc_master_corners(imsg) < 0 &
- .or. iproc_worker1_corners(imsg) < 0 &
- .or. iproc_worker2_corners(imsg) < 0 &
- .or. iproc_master_corners(imsg) > NPROCTOT-1 &
- .or. iproc_worker1_corners(imsg) > NPROCTOT-1 &
- .or. iproc_worker2_corners(imsg) > NPROCTOT-1) &
- call exit_MPI(myrank,'incorrect chunk corner numbering')
- enddo
-
- endif
-
-!! $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
-
! create chunk buffers if more than one chunk
if(NCHUNKS > 1) then
@@ -1796,7 +1737,7 @@
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, &
- iprocfrom_faces,iprocto_faces,iproc_master_corners,iproc_worker1_corners,iproc_worker2_corners, &
+ iprocfrom_faces,iprocto_faces,imsg_type,iproc_master_corners,iproc_worker1_corners,iproc_worker2_corners, &
iboolfaces_crust_mantle,npoin2D_faces_crust_mantle,iboolcorner_crust_mantle,NGLOB1D_RADIAL(IREGION_CRUST_MANTLE), &
NGLOB2DMAX_XY_VAL_CM)
@@ -1815,7 +1756,7 @@
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, &
- iprocfrom_faces,iprocto_faces,iproc_master_corners,iproc_worker1_corners,iproc_worker2_corners, &
+ iprocfrom_faces,iprocto_faces,imsg_type,iproc_master_corners,iproc_worker1_corners,iproc_worker2_corners, &
iboolfaces_outer_core,npoin2D_faces_outer_core,iboolcorner_outer_core,NGLOB1D_RADIAL(IREGION_OUTER_CORE), &
NGLOB2DMAX_XY_VAL_OC)
@@ -1834,7 +1775,7 @@
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, &
- iprocfrom_faces,iprocto_faces,iproc_master_corners,iproc_worker1_corners,iproc_worker2_corners, &
+ iprocfrom_faces,iprocto_faces,imsg_type,iproc_master_corners,iproc_worker1_corners,iproc_worker2_corners, &
iboolfaces_inner_core,npoin2D_faces_inner_core,iboolcorner_inner_core,NGLOB1D_RADIAL(IREGION_INNER_CORE), &
NGLOB2DMAX_XY_VAL_IC)
More information about the cig-commits
mailing list