[cig-commits] r12568 - seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src
dkomati1 at geodynamics.org
dkomati1 at geodynamics.org
Wed Aug 6 17:09:06 PDT 2008
Author: dkomati1
Date: 2008-08-06 17:09:06 -0700 (Wed, 06 Aug 2008)
New Revision: 12568
Added:
seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/declarations_mesher.f90
Removed:
seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/declar.f90
Modified:
seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/call1.f90
seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/call2.f90
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/meshfem3D.f90
seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/read_compute_parameters.f90
seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/specfem3D.f90
Log:
suppressed writing of disk files in create_list_files_chunks.f90;
use memory instead to send the arguments to create_chunk_buffers.f90;
also converted create_list_files_chunks.f90 from heap to stack
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/call1.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/call1.f90 2008-08-06 22:57:19 UTC (rev 12567)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/call1.f90 2008-08-07 00:09:06 UTC (rev 12568)
@@ -7,7 +7,7 @@
one_minus_sum_beta_crust_mantle,factor_scale_crust_mantle, one_minus_sum_beta_inner_core,factor_scale_inner_core, &
factor_common_crust_mantle,factor_common_inner_core,factor_common_crust_mantle_dble, factor_common_inner_core_dble, &
!! DK DK already computed
- myrank,sizeprocs,addressing,ichunk_slice,iproc_xi_slice,iproc_eta_slice,ibathy_topo,NSOURCES,npoin2D_max_all,NDIM_smaller_buffers, &
+ myrank,sizeprocs,addressing,ichunk_slice,iproc_xi_slice,iproc_eta_slice,ibathy_topo,NSOURCES,npoin2D_max_all,NDIM_smaller_buffers,nrec, &
NTSTEP_BETWEEN_OUTPUT_SEISMOS,ibool_crust_mantle, ibool_outer_core, ibool_inner_core, idoubling_crust_mantle,idoubling_inner_core, &
ibelm_bottom_crust_mantle, ibelm_bottom_outer_core, ibelm_top_outer_core, &
ibelm_xmin_inner_core,ibelm_xmax_inner_core,ibelm_ymin_inner_core,ibelm_ymax_inner_core,ibelm_bottom_inner_core, &
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/call2.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/call2.f90 2008-08-06 22:57:19 UTC (rev 12567)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/call2.f90 2008-08-07 00:09:06 UTC (rev 12568)
@@ -7,7 +7,7 @@
one_minus_sum_beta_crust_mantle,factor_scale_crust_mantle, one_minus_sum_beta_inner_core,factor_scale_inner_core, &
factor_common_crust_mantle,factor_common_inner_core,factor_common_crust_mantle_dble, factor_common_inner_core_dble, &
!! DK DK already computed
- myrank,sizeprocs,addressing,ichunk_slice,iproc_xi_slice,iproc_eta_slice,ibathy_topo,NSOURCES,npoin2D_max_all,NDIM_smaller_buffers, &
+ myrank,sizeprocs,addressing,ichunk_slice,iproc_xi_slice,iproc_eta_slice,ibathy_topo,NSOURCES,npoin2D_max_all,NDIM_smaller_buffers,nrec, &
NTSTEP_BETWEEN_OUTPUT_SEISMOS,ibool_crust_mantle, ibool_outer_core, ibool_inner_core, idoubling_crust_mantle,idoubling_inner_core, &
ibelm_bottom_crust_mantle, ibelm_bottom_outer_core, ibelm_top_outer_core, &
ibelm_xmin_inner_core,ibelm_xmax_inner_core,ibelm_ymin_inner_core,ibelm_ymax_inner_core,ibelm_bottom_inner_core, &
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-06 22:57:19 UTC (rev 12567)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/create_chunk_buffers.f90 2008-08-07 00:09:06 UTC (rev 12568)
@@ -32,7 +32,7 @@
NSPEC2DMAX_XMIN_XMAX,NSPEC2DMAX_YMIN_YMAX, &
NPROC_XI,NPROC_ETA,NPROC,NPROCTOT,NGLOB1D_RADIAL_CORNER,NGLOB1D_RADIAL_MAX, &
NGLOB2DMAX_XMIN_XMAX,NGLOB2DMAX_YMIN_YMAX, &
- myrank,LOCAL_PATH, &
+ myrank, &
addressing,ichunk_slice,iproc_xi_slice,iproc_eta_slice,NCHUNKS, &
ibool1D_leftxi_lefteta,ibool1D_rightxi_lefteta, &
ibool1D_leftxi_righteta,ibool1D_rightxi_righteta, &
@@ -88,7 +88,7 @@
double precision ystore(NGLLX,NGLLY,NGLLZ,nspec)
double precision zstore(NGLLX,NGLLY,NGLLZ,nspec)
- character(len=150) OUTPUT_FILES,LOCAL_PATH,ERR_MSG
+ character(len=150) ERR_MSG
! array with the local to global mapping per slice
integer ibool(NGLLX,NGLLY,NGLLZ,nspec)
@@ -154,9 +154,6 @@
! current message number
integer imsg
-! names of the data files for all the processors in MPI
- character(len=150) prname
-
! for addressing of the slices
integer ichunk,iproc_xi,iproc_eta,iproc
integer addressing(NCHUNKS,0:NPROC_XI-1,0:NPROC_ETA-1)
@@ -264,16 +261,6 @@
imsg = 0
- if(myrank == 0) then
-
-! get the base pathname for output files
- call get_value_string(OUTPUT_FILES, 'OUTPUT_FILES', 'OUTPUT_FILES')
-
-! file to store the list of processors for each message for faces
-!!! DK DK for merged open(unit=IOUT,file=trim(OUTPUT_FILES)//'/list_messages_faces.txt',status='unknown')
-
- endif
-
!!!!!!!!!! DK DK for merged version: beginning of "faces" section here
!!!!!!!!!! DK DK for merged version: beginning of "faces" section here
!!!!!!!!!! DK DK for merged version: beginning of "faces" section here
@@ -509,13 +496,6 @@
!---------------------------------------------------------------------
-! create the name of the database for each slice
- call create_name_database(prname,iproc,iregion_code,LOCAL_PATH)
-
-! open file for 2D buffer
-!! DK DK suppressed in the merged version
-! open(unit=IOUT_BUFFERS,file=prname(1:len_trim(prname))//filename_out,status='unknown')
-
! determine chunk number and local slice coordinates using addressing
ichunk = ichunk_slice(iproc)
iproc_xi = iproc_xi_slice(iproc)
@@ -533,51 +513,6 @@
! $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
-! read boundary parameters
-!! DK DK suppressed in the merged version
-! open(unit=IIN,file=prname(1:len_trim(prname))//'boundary.bin',status='old',action='read',form='unformatted')
-!! DK DK suppressed in the merged version read(IIN) nspec2D_xmin
-!! DK DK suppressed in the merged version read(IIN) nspec2D_xmax
-!! DK DK suppressed in the merged version read(IIN) nspec2D_ymin
-!! DK DK suppressed in the merged version read(IIN) nspec2D_ymax
-!! DK DK suppressed in the merged version read(IIN) njunk
-!! DK DK suppressed in the merged version read(IIN) njunk
-!! DK DK suppressed in the merged version
-!! DK DK suppressed in the merged version read(IIN) ibelm_xmin
-!! DK DK suppressed in the merged version read(IIN) ibelm_xmax
-!! DK DK suppressed in the merged version read(IIN) ibelm_ymin
-!! DK DK suppressed in the merged version read(IIN) ibelm_ymax
-!! DK DK suppressed in the merged version close(IIN)
-
-! read 1D buffers to remove corner points
-!! DK DK suppressed in the merged version
-! open(unit=IIN,file=prname(1:len_trim(prname))//'ibool1D_leftxi_lefteta.txt',status='old',action='read')
-!! DK DK suppressed in the merged version do ipoin1D = 1,NGLOB1D_RADIAL_CORNER(iregion_code,1)
-!! DK DK suppressed in the merged version read(IIN,*) ibool1D_leftxi_lefteta(ipoin1D),xdummy,ydummy,zdummy
-!! DK DK suppressed in the merged version enddo
-!! DK DK suppressed in the merged version close(IIN)
-
-!! DK DK suppressed in the merged version
-! open(unit=IIN,file=prname(1:len_trim(prname))//'ibool1D_rightxi_lefteta.txt',status='old',action='read')
-!! DK DK suppressed in the merged version do ipoin1D = 1,NGLOB1D_RADIAL_CORNER(iregion_code,2)
-!! DK DK suppressed in the merged version read(IIN,*) ibool1D_rightxi_lefteta(ipoin1D),xdummy,ydummy,zdummy
-!! DK DK suppressed in the merged version enddo
-!! DK DK suppressed in the merged version close(IIN)
-
-!! DK DK suppressed in the merged version
-! open(unit=IIN,file=prname(1:len_trim(prname))//'ibool1D_leftxi_righteta.txt',status='old',action='read')
-!! DK DK suppressed in the merged version do ipoin1D = 1,NGLOB1D_RADIAL_CORNER(iregion_code,4)
-!! DK DK suppressed in the merged version read(IIN,*) ibool1D_leftxi_righteta(ipoin1D),xdummy,ydummy,zdummy
-!! DK DK suppressed in the merged version enddo
-!! DK DK suppressed in the merged version close(IIN)
-
-!! DK DK suppressed in the merged version
-! open(unit=IIN,file=prname(1:len_trim(prname))//'ibool1D_rightxi_righteta.txt',status='old',action='read')
-!! DK DK suppressed in the merged version do ipoin1D = 1,NGLOB1D_RADIAL_CORNER(iregion_code,3)
-!! DK DK suppressed in the merged version read(IIN,*) ibool1D_rightxi_righteta(ipoin1D),xdummy,ydummy,zdummy
-!! DK DK suppressed in the merged version enddo
-!! DK DK suppressed in the merged version close(IIN)
-
! erase logical mask
mask_ibool(:) = .false.
@@ -956,9 +891,6 @@
endif
-! file to store the list of processors for each message for corners
-!!! DK DK for merged if(myrank == 0) open(unit=IOUT,file=trim(OUTPUT_FILES)//'/list_messages_corners.txt',status='unknown')
-
! loop over all the messages to create the addressing
do imsg = 1,NCORNERSCHUNKS
@@ -1015,26 +947,19 @@
! pick the correct 1D buffer
! this scheme works fine even if NPROC_XI = NPROC_ETA = 1
if(itypecorner(imember_corner,imsg) == ILOWERLOWER) then
-!! DK DK suppressed for merged filename_in = prname(1:len_trim(prname))//'ibool1D_leftxi_lefteta.txt'
NGLOB1D_RADIAL_my_corner = NGLOB1D_RADIAL_CORNER(iregion_code,1)
else if(itypecorner(imember_corner,imsg) == ILOWERUPPER) then
-!! DK DK suppressed for merged filename_in = prname(1:len_trim(prname))//'ibool1D_leftxi_righteta.txt'
NGLOB1D_RADIAL_my_corner = NGLOB1D_RADIAL_CORNER(iregion_code,4)
else if(itypecorner(imember_corner,imsg) == IUPPERLOWER) then
-!! DK DK suppressed for merged filename_in = prname(1:len_trim(prname))//'ibool1D_rightxi_lefteta.txt'
NGLOB1D_RADIAL_my_corner = NGLOB1D_RADIAL_CORNER(iregion_code,2)
else if(itypecorner(imember_corner,imsg) == IUPPERUPPER) then
-!! DK DK suppressed for merged filename_in = prname(1:len_trim(prname))//'ibool1D_rightxi_righteta.txt'
NGLOB1D_RADIAL_my_corner = NGLOB1D_RADIAL_CORNER(iregion_code,3)
else
call exit_MPI(myrank,'incorrect corner coordinates')
endif
-! read 1D buffer for corner
-!! DK DK suppressed in the merged version open(unit=IIN,file=filename_in,status='old',action='read')
+! 1D buffer for corner
do ipoin1D = 1,NGLOB1D_RADIAL_my_corner
-!! DK DK suppressed in the merged version read(IIN,*) ibool1D(ipoin1D), &
-!! DK DK suppressed in the merged version xread1D(ipoin1D),yread1D(ipoin1D),zread1D(ipoin1D)
!! DK DK added this for merged
! pick the correct 1D buffer
@@ -1074,18 +999,11 @@
! check that no duplicates have been found
if(nglob /= NGLOB1D_RADIAL_my_corner) call exit_MPI(myrank,'duplicates found for corners')
-! write file with 1D buffer for corner
-!! DK DK suppressed in the merged version open(unit=IOUT_BUFFERS,file=prname(1:len_trim(prname))//filename_out,status='unknown')
-!! DK DK suppressed in the merged version write(IOUT_BUFFERS,*) NGLOB1D_RADIAL_my_corner
+! 1D buffer for corner
do ipoin1D = 1,NGLOB1D_RADIAL_my_corner
-!! DK DK suppressed in the merged version write(IOUT_BUFFERS,*) ibool1D(ipoin1D), &
-!! DK DK suppressed in the merged version xread1D(ipoin1D),yread1D(ipoin1D),zread1D(ipoin1D)
-
!! DK DK added this for merged version
iboolcorner(ipoin1D,icount_corners) = ibool1D(ipoin1D)
-
enddo
-!! DK DK suppressed in the merged version close(IOUT_BUFFERS)
! end of section done only if right processor for MPI
endif
@@ -1094,8 +1012,6 @@
enddo
-!!! DK DK for merged if(myrank == 0) close(IOUT)
-
! deallocate arrays
deallocate(iproc_sender)
deallocate(iproc_receiver)
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-06 22:57:19 UTC (rev 12567)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/create_list_files_chunks.f90 2008-08-07 00:09:06 UTC (rev 12568)
@@ -27,12 +27,14 @@
! subroutine to create the list of messages to assemble between chunks in files if more than one chunk
-!! DK DK for merged version: a lot of useless code / useless lines car probably be suppressed
-!! DK DK in this new routine below
+!! 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
subroutine create_list_files_chunks(iregion_code, &
- nglob_ori,NPROC_XI,NPROC_ETA,NPROCTOT,NGLOB1D_RADIAL_CORNER, &
- myrank,addressing,ichunk_slice,iproc_xi_slice,iproc_eta_slice,NCHUNKS)
+ nglob_ori,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)
implicit none
@@ -52,14 +54,13 @@
integer NPROC_XI,NPROC_ETA,NPROCTOT,NGLOB1D_RADIAL_my_corner
integer myrank,NCHUNKS
- character(len=150) OUTPUT_FILES
-
! 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(NUMMSGS_FACES_VAL) :: imsg_type,iprocfrom_faces,iprocto_faces,npoin2D_send,npoin2D_receive
! arrays to assemble the corners (3 processors for each corner)
- integer, dimension(:,:), allocatable :: iprocscorners,itypecorner
+ integer, dimension(3,NCORNERSCHUNKS_VAL) :: iprocscorners,itypecorner
+ integer, dimension(NCORNERSCHUNKS_VAL) :: iproc_master_corners,iproc_worker1_corners,iproc_worker2_corners
integer ichunk_send,iproc_xi_send,iproc_eta_send
integer ichunk_receive,iproc_xi_receive,iproc_eta_receive
@@ -70,7 +71,7 @@
integer iregion_code
integer iproc_edge_send,iproc_edge_receive
- integer imsg_type,iside,imode_comm,iedge
+ integer iside,imode_comm,iedge,imsg_type_loop
integer ier
@@ -130,19 +131,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
@@ -155,16 +146,6 @@
imsg = 0
- if(myrank == 0) then
-
-! get the base pathname for output files
- call get_value_string(OUTPUT_FILES, 'OUTPUT_FILES', 'OUTPUT_FILES')
-
-! file to store the list of processors for each message for faces
- open(unit=IOUT,file=trim(OUTPUT_FILES)//'/list_messages_faces.txt',status='unknown',action='write')
-
- endif
-
!!!!!!!!!! DK DK for merged version: beginning of "faces" section here
!!!!!!!!!! DK DK for merged version: beginning of "faces" section here
!!!!!!!!!! DK DK for merged version: beginning of "faces" section here
@@ -174,7 +155,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
@@ -200,7 +181,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
@@ -249,7 +230,7 @@
endif
! message type M2
- if(imsg_type == 2) then
+ if(imsg_type_loop == 2) then
if(iside == 1) then
ichunk_send = CHUNK_AB
@@ -298,7 +279,7 @@
endif
! message type M3
- if(imsg_type == 3) then
+ if(imsg_type_loop == 3) then
if(iside == 1) then
ichunk_send = CHUNK_AC
@@ -346,26 +327,26 @@
endif
-
! 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
- if(myrank == 0) write(IOUT,*) imsg_type,iproc_sender(imsg),iproc_receiver(imsg)
+!!!!!!!! DK DK merged version 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
else if(imode_comm == 2) then
- iproc = iproc_receiver(imsg)
+ iproc = iprocto_faces(imsg)
iedge = iproc_edge_receive
else
@@ -398,8 +379,6 @@
enddo
enddo
- if(myrank == 0) close(IOUT)
-
! check that total number of messages is correct
if(imsg /= NUMMSGS_FACES) call exit_MPI(myrank,'incorrect total number of messages')
@@ -509,16 +488,17 @@
endif
-! file to store the list of processors for each message for corners
- if(myrank == 0) open(unit=IOUT,file=trim(OUTPUT_FILES)//'/list_messages_corners.txt',status='unknown',action='write')
-
! loop over all the messages to create the addressing
do imsg = 1,NCORNERSCHUNKS
if(myrank == 0) write(IMAIN,*) 'Generating message ',imsg,' for corners out of ',NCORNERSCHUNKS
! save triplet of processors in list of messages
- if(myrank == 0) write(IOUT,*) iprocscorners(1,imsg),iprocscorners(2,imsg),iprocscorners(3,imsg)
+!!!!!!!! DK DK merged version if(myrank == 0) write(IOUT,*) iprocscorners(1,imsg),iprocscorners(2,imsg),iprocscorners(3,imsg)
+!!!!!!!! DK DK merged version
+ iproc_master_corners(imsg) = iprocscorners(1,imsg)
+ iproc_worker1_corners(imsg) = iprocscorners(2,imsg)
+ iproc_worker2_corners(imsg) = iprocscorners(3,imsg)
! loop on the three processors of a given corner
do imember_corner = 1,3
@@ -530,16 +510,12 @@
! pick the correct 1D buffer
! this scheme works fine even if NPROC_XI = NPROC_ETA = 1
if(itypecorner(imember_corner,imsg) == ILOWERLOWER) then
-!! DK DK suppressed for merged filename_in = prname(1:len_trim(prname))//'ibool1D_leftxi_lefteta.txt'
NGLOB1D_RADIAL_my_corner = NGLOB1D_RADIAL_CORNER(iregion_code,1)
else if(itypecorner(imember_corner,imsg) == ILOWERUPPER) then
-!! DK DK suppressed for merged filename_in = prname(1:len_trim(prname))//'ibool1D_leftxi_righteta.txt'
NGLOB1D_RADIAL_my_corner = NGLOB1D_RADIAL_CORNER(iregion_code,4)
else if(itypecorner(imember_corner,imsg) == IUPPERLOWER) then
-!! DK DK suppressed for merged filename_in = prname(1:len_trim(prname))//'ibool1D_rightxi_lefteta.txt'
NGLOB1D_RADIAL_my_corner = NGLOB1D_RADIAL_CORNER(iregion_code,2)
else if(itypecorner(imember_corner,imsg) == IUPPERUPPER) then
-!! DK DK suppressed for merged filename_in = prname(1:len_trim(prname))//'ibool1D_rightxi_righteta.txt'
NGLOB1D_RADIAL_my_corner = NGLOB1D_RADIAL_CORNER(iregion_code,3)
else
call exit_MPI(myrank,'incorrect corner coordinates')
@@ -552,7 +528,5 @@
enddo
- if(myrank == 0) close(IOUT)
-
end subroutine create_list_files_chunks
Deleted: seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/declar.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/declar.f90 2008-08-06 22:57:19 UTC (rev 12567)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/declar.f90 2008-08-07 00:09:06 UTC (rev 12568)
@@ -1,143 +0,0 @@
-
-!! DK DK added this for merged version
-!! DK DK stored in single precision for merged version, check if it precise enough (probably yes)
- real(kind=CUSTOM_REAL), dimension(:,:), allocatable :: &
- xelm_store_crust_mantle,yelm_store_crust_mantle,zelm_store_crust_mantle, &
- xelm_store_outer_core,yelm_store_outer_core,zelm_store_outer_core, &
- xelm_store_inner_core,yelm_store_inner_core,zelm_store_inner_core
-
-!!!!!!!!!!!!!!!! DK DK for merged version, all the arrays below are allocated statically instead
-!!!!!!!!!!!!!!!! DK DK for merged version, all the arrays below are allocated statically instead
-!!!!!!!!!!!!!!!! DK DK for merged version, all the arrays below are allocated statically instead
-!!!!!!!!!!!!!!!! DK DK for merged version, all the arrays below are allocated statically instead
-!!!!!!!!!!!!!!!! DK DK for merged version, all the arrays below are allocated statically instead
-!!!!!!!!!!!!!!!! DK DK for merged version, all the arrays below are allocated statically instead
-!!!!!!!!!!!!!!!! DK DK for merged version, all the arrays below are allocated statically instead
-
- integer npoin2D_faces_crust_mantle(NUMFACES_SHARED)
- integer npoin2D_faces_outer_core(NUMFACES_SHARED)
- integer npoin2D_faces_inner_core(NUMFACES_SHARED)
-
- integer, dimension(NB_SQUARE_EDGES_ONEDIR) :: npoin2D_xi_crust_mantle,npoin2D_eta_crust_mantle, &
- npoin2D_xi_outer_core,npoin2D_eta_outer_core, &
- npoin2D_xi_inner_core,npoin2D_eta_inner_core
-
-! number of elements on the boundaries
- integer :: nspec2D_xmin_crust_mantle,nspec2D_xmax_crust_mantle,nspec2D_ymin_crust_mantle,nspec2D_ymax_crust_mantle
- integer :: nspec2D_xmin_outer_core,nspec2D_xmax_outer_core,nspec2D_ymin_outer_core,nspec2D_ymax_outer_core
- integer :: nspec2D_xmin_inner_core,nspec2D_xmax_inner_core,nspec2D_ymin_inner_core,nspec2D_ymax_inner_core
-
- real(kind=CUSTOM_REAL), dimension(NGLOB_CRUST_MANTLE) :: rmass_crust_mantle
- real(kind=CUSTOM_REAL), dimension(NGLOB_OUTER_CORE) :: rmass_outer_core
- real(kind=CUSTOM_REAL), dimension(NGLOB_INNER_CORE) :: rmass_inner_core
-
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPECMAX_ISO_MANTLE) :: kappavstore_crust_mantle,muvstore_crust_mantle
-
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPECMAX_TISO_MANTLE) :: &
- kappahstore_crust_mantle,muhstore_crust_mantle,eta_anisostore_crust_mantle
-
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_INNER_CORE) :: kappavstore_inner_core,muvstore_inner_core
-
-!! DK DK added this for the merged version
-!! DK DK these arrays are useless in the solver and will therefore be allocated with a dummy size of 1
- real(kind=CUSTOM_REAL), dimension(1,1,1,1) :: kappahstore_inner_core,muhstore_inner_core,eta_anisostore_inner_core
- real(kind=CUSTOM_REAL), dimension(1,1,1,1) :: kappavstore_outer_core,muvstore_outer_core
- real(kind=CUSTOM_REAL), dimension(1,1,1,1) :: kappahstore_outer_core,muhstore_outer_core,eta_anisostore_outer_core
-
-! 2-D jacobians and normals
- real(kind=CUSTOM_REAL), dimension(NGLLY,NGLLZ,NSPEC2DMAX_XMIN_XMAX_IC) :: jacobian2D_xmin_inner_core,jacobian2D_xmax_inner_core
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLZ,NSPEC2DMAX_YMIN_YMAX_IC) :: jacobian2D_ymin_inner_core,jacobian2D_ymax_inner_core
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NSPEC2D_BOTTOM_IC) :: jacobian2D_bottom_inner_core
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NSPEC2D_TOP_IC) :: jacobian2D_top_inner_core
-
- real(kind=CUSTOM_REAL), dimension(NDIM,NGLLY,NGLLZ,NSPEC2DMAX_XMIN_XMAX_IC) :: normal_xmin_inner_core,normal_xmax_inner_core
- real(kind=CUSTOM_REAL), dimension(NDIM,NGLLX,NGLLZ,NSPEC2DMAX_YMIN_YMAX_IC) :: normal_ymin_inner_core,normal_ymax_inner_core
- real(kind=CUSTOM_REAL), dimension(NDIM,NGLLX,NGLLY,NSPEC2D_BOTTOM_IC) :: normal_bottom_inner_core
- real(kind=CUSTOM_REAL), dimension(NDIM,NGLLX,NGLLY,NSPEC2D_TOP_IC) :: normal_top_inner_core
-
- integer, dimension(NSPEC2DMAX_XMIN_XMAX_CM) :: ibelm_xmin_crust_mantle,ibelm_xmax_crust_mantle
- integer, dimension(NSPEC2DMAX_YMIN_YMAX_CM) :: ibelm_ymin_crust_mantle,ibelm_ymax_crust_mantle
- integer, dimension(NSPEC2D_BOTTOM_CM) :: ibelm_bottom_crust_mantle
- integer, dimension(NSPEC2D_TOP_CM) :: ibelm_top_crust_mantle
-
- real(kind=CUSTOM_REAL), dimension(NGLLY,NGLLZ,NSPEC2DMAX_XMIN_XMAX_CM) :: &
- jacobian2D_xmin_crust_mantle,jacobian2D_xmax_crust_mantle
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLZ,NSPEC2DMAX_YMIN_YMAX_CM) :: &
- jacobian2D_ymin_crust_mantle,jacobian2D_ymax_crust_mantle
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NSPEC2D_BOTTOM_CM) :: jacobian2D_bottom_crust_mantle
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NSPEC2D_TOP_CM) :: jacobian2D_top_crust_mantle
-
- real(kind=CUSTOM_REAL), dimension(NDIM,NGLLY,NGLLZ,NSPEC2DMAX_XMIN_XMAX_CM) :: normal_xmin_crust_mantle,normal_xmax_crust_mantle
- real(kind=CUSTOM_REAL), dimension(NDIM,NGLLX,NGLLY,NSPEC2DMAX_YMIN_YMAX_CM) :: normal_ymin_crust_mantle,normal_ymax_crust_mantle
- real(kind=CUSTOM_REAL), dimension(NDIM,NGLLX,NGLLY,NSPEC2D_BOTTOM_CM) :: normal_bottom_crust_mantle
- real(kind=CUSTOM_REAL), dimension(NDIM,NGLLX,NGLLY,NSPEC2D_TOP_CM) :: normal_top_crust_mantle
-
- integer, dimension(NSPEC2DMAX_XMIN_XMAX_OC) :: ibelm_xmin_outer_core,ibelm_xmax_outer_core
- integer, dimension(NSPEC2DMAX_YMIN_YMAX_OC) :: ibelm_ymin_outer_core,ibelm_ymax_outer_core
- integer, dimension(NSPEC2D_BOTTOM_OC) :: ibelm_bottom_outer_core
- integer, dimension(NSPEC2D_TOP_OC) :: ibelm_top_outer_core
-
- real(kind=CUSTOM_REAL), dimension(NDIM,NGLLY,NGLLZ,NSPEC2DMAX_XMIN_XMAX_OC) :: normal_xmin_outer_core,normal_xmax_outer_core
- real(kind=CUSTOM_REAL), dimension(NDIM,NGLLX,NGLLZ,NSPEC2DMAX_YMIN_YMAX_OC) :: normal_ymin_outer_core,normal_ymax_outer_core
- real(kind=CUSTOM_REAL), dimension(NDIM,NGLLX,NGLLY,NSPEC2D_BOTTOM_OC) :: normal_bottom_outer_core
- real(kind=CUSTOM_REAL), dimension(NDIM,NGLLX,NGLLY,NSPEC2D_TOP_OC) :: normal_top_outer_core
-
- real(kind=CUSTOM_REAL), dimension(NGLLY,NGLLZ,NSPEC2DMAX_XMIN_XMAX_OC) :: jacobian2D_xmin_outer_core,jacobian2D_xmax_outer_core
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLZ,NSPEC2DMAX_YMIN_YMAX_OC) :: jacobian2D_ymin_outer_core,jacobian2D_ymax_outer_core
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NSPEC2D_BOTTOM_OC) :: jacobian2D_bottom_outer_core
- real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NSPEC2D_TOP_OC) :: jacobian2D_top_outer_core
-
- integer, dimension(NSPEC2DMAX_XMIN_XMAX_IC) :: ibelm_xmin_inner_core,ibelm_xmax_inner_core
- integer, dimension(NSPEC2DMAX_YMIN_YMAX_IC) :: ibelm_ymin_inner_core,ibelm_ymax_inner_core
- integer, dimension(NSPEC2D_BOTTOM_IC) :: ibelm_bottom_inner_core
- integer, dimension(NSPEC2D_TOP_IC) :: ibelm_top_inner_core
-
- integer, dimension(NGLOB2DMAX_XY_VAL_CM,NUMFACES_SHARED) :: iboolfaces_crust_mantle
- integer, dimension(NGLOB2DMAX_XY_VAL_OC,NUMFACES_SHARED) :: iboolfaces_outer_core
- integer, dimension(NGLOB2DMAX_XY_VAL_IC,NUMFACES_SHARED) :: iboolfaces_inner_core
-
- integer, dimension(NGLLX,NGLLY,NGLLZ,NSPEC_CRUST_MANTLE) :: ibool_crust_mantle
-
- integer, dimension(NSPEC_CRUST_MANTLE) :: idoubling_crust_mantle
-
-!! DK DK this array is useless in the solver and is therefore allocated with a dummy size of 1
- integer, dimension(1) :: idoubling_outer_core
-
- integer, dimension(NSPEC_INNER_CORE) :: idoubling_inner_core
-
- integer, dimension(NGLLX,NGLLY,NGLLZ,NSPEC_OUTER_CORE) :: ibool_outer_core
-
- integer, dimension(NGLLX,NGLLY,NGLLZ,NSPEC_INNER_CORE) :: ibool_inner_core
-
- integer, dimension(NGLOB1D_RADIAL_CM,NUMCORNERS_SHARED) :: iboolcorner_crust_mantle
- integer, dimension(NGLOB1D_RADIAL_OC,NUMCORNERS_SHARED) :: iboolcorner_outer_core
- integer, dimension(NGLOB1D_RADIAL_IC,NUMCORNERS_SHARED) :: iboolcorner_inner_core
-
- real(kind=CUSTOM_REAL), dimension(NGLOB1D_RADIAL_CM) :: buffer_send_chunkcorners_scalar,buffer_recv_chunkcorners_scalar
-
- real(kind=CUSTOM_REAL), dimension(NDIM,NGLOB1D_RADIAL_CM + NGLOB1D_RADIAL_IC) :: &
- buffer_send_chunkcorners_vector,buffer_recv_chunkcorners_vector
-
- integer, dimension(NGLOB2DMAX_XMIN_XMAX_CM) :: iboolleft_xi_crust_mantle,iboolright_xi_crust_mantle
- integer, dimension(NGLOB2DMAX_YMIN_YMAX_CM) :: iboolleft_eta_crust_mantle,iboolright_eta_crust_mantle
- integer, dimension(NGLOB2DMAX_XMIN_XMAX_OC) :: iboolleft_xi_outer_core,iboolright_xi_outer_core
- integer, dimension(NGLOB2DMAX_YMIN_YMAX_OC) :: iboolleft_eta_outer_core,iboolright_eta_outer_core
- integer, dimension(NGLOB2DMAX_XMIN_XMAX_IC) :: iboolleft_xi_inner_core,iboolright_xi_inner_core
- integer, dimension(NGLOB2DMAX_YMIN_YMAX_IC) :: iboolleft_eta_inner_core,iboolright_eta_inner_core
-
- double precision, dimension(ATT1,ATT2,ATT3,ATT4) :: omsb_crust_mantle_dble, factor_scale_crust_mantle_dble
-
- double precision, dimension(ATT1,ATT2,ATT3,ATT5) :: omsb_inner_core_dble, factor_scale_inner_core_dble
-
- real(kind=CUSTOM_REAL), dimension(ATT1,ATT2,ATT3,ATT4) :: one_minus_sum_beta_crust_mantle, factor_scale_crust_mantle
-
- real(kind=CUSTOM_REAL), dimension(ATT1,ATT2,ATT3,ATT5) :: one_minus_sum_beta_inner_core, factor_scale_inner_core
-
- real(kind=CUSTOM_REAL), dimension(N_SLS,ATT1,ATT2,ATT3,ATT4) :: factor_common_crust_mantle
-
- real(kind=CUSTOM_REAL), dimension(N_SLS,ATT1,ATT2,ATT3,ATT5) :: factor_common_inner_core
-
- double precision, dimension(N_SLS,ATT1,ATT2,ATT3,ATT4) :: factor_common_crust_mantle_dble
-
- double precision, dimension(N_SLS,ATT1,ATT2,ATT3,ATT5) :: factor_common_inner_core_dble
-
Copied: seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/declarations_mesher.f90 (from rev 12565, seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/declar.f90)
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/declarations_mesher.f90 (rev 0)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/declarations_mesher.f90 2008-08-07 00:09:06 UTC (rev 12568)
@@ -0,0 +1,149 @@
+
+!! DK DK added this for merged version
+!! DK DK stored in single precision for merged version, check if it precise enough (probably yes)
+ real(kind=CUSTOM_REAL), dimension(:,:), allocatable :: &
+ xelm_store_crust_mantle,yelm_store_crust_mantle,zelm_store_crust_mantle, &
+ xelm_store_outer_core,yelm_store_outer_core,zelm_store_outer_core, &
+ xelm_store_inner_core,yelm_store_inner_core,zelm_store_inner_core
+
+!!!!!!!!!!!!!!!! DK DK for merged version, all the arrays below are allocated statically instead
+!!!!!!!!!!!!!!!! DK DK for merged version, all the arrays below are allocated statically instead
+!!!!!!!!!!!!!!!! DK DK for merged version, all the arrays below are allocated statically instead
+!!!!!!!!!!!!!!!! DK DK for merged version, all the arrays below are allocated statically instead
+!!!!!!!!!!!!!!!! DK DK for merged version, all the arrays below are allocated statically instead
+!!!!!!!!!!!!!!!! DK DK for merged version, all the arrays below are allocated statically instead
+!!!!!!!!!!!!!!!! DK DK for merged version, all the arrays below are allocated statically instead
+
+ integer npoin2D_faces_crust_mantle(NUMFACES_SHARED)
+ integer npoin2D_faces_outer_core(NUMFACES_SHARED)
+ integer npoin2D_faces_inner_core(NUMFACES_SHARED)
+
+ integer, dimension(NB_SQUARE_EDGES_ONEDIR) :: npoin2D_xi_crust_mantle,npoin2D_eta_crust_mantle, &
+ npoin2D_xi_outer_core,npoin2D_eta_outer_core, &
+ npoin2D_xi_inner_core,npoin2D_eta_inner_core
+
+! number of elements on the boundaries
+ integer :: nspec2D_xmin_crust_mantle,nspec2D_xmax_crust_mantle,nspec2D_ymin_crust_mantle,nspec2D_ymax_crust_mantle
+ integer :: nspec2D_xmin_outer_core,nspec2D_xmax_outer_core,nspec2D_ymin_outer_core,nspec2D_ymax_outer_core
+ integer :: nspec2D_xmin_inner_core,nspec2D_xmax_inner_core,nspec2D_ymin_inner_core,nspec2D_ymax_inner_core
+
+ real(kind=CUSTOM_REAL), dimension(NGLOB_CRUST_MANTLE) :: rmass_crust_mantle
+ real(kind=CUSTOM_REAL), dimension(NGLOB_OUTER_CORE) :: rmass_outer_core
+ real(kind=CUSTOM_REAL), dimension(NGLOB_INNER_CORE) :: rmass_inner_core
+
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPECMAX_ISO_MANTLE) :: kappavstore_crust_mantle,muvstore_crust_mantle
+
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPECMAX_TISO_MANTLE) :: &
+ kappahstore_crust_mantle,muhstore_crust_mantle,eta_anisostore_crust_mantle
+
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,NSPEC_INNER_CORE) :: kappavstore_inner_core,muvstore_inner_core
+
+!! DK DK added this for the merged version
+!! DK DK these arrays are useless in the solver and will therefore be allocated with a dummy size of 1
+ real(kind=CUSTOM_REAL), dimension(1,1,1,1) :: kappahstore_inner_core,muhstore_inner_core,eta_anisostore_inner_core
+ real(kind=CUSTOM_REAL), dimension(1,1,1,1) :: kappavstore_outer_core,muvstore_outer_core
+ real(kind=CUSTOM_REAL), dimension(1,1,1,1) :: kappahstore_outer_core,muhstore_outer_core,eta_anisostore_outer_core
+
+! 2-D jacobians and normals
+ real(kind=CUSTOM_REAL), dimension(NGLLY,NGLLZ,NSPEC2DMAX_XMIN_XMAX_IC) :: jacobian2D_xmin_inner_core,jacobian2D_xmax_inner_core
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLZ,NSPEC2DMAX_YMIN_YMAX_IC) :: jacobian2D_ymin_inner_core,jacobian2D_ymax_inner_core
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NSPEC2D_BOTTOM_IC) :: jacobian2D_bottom_inner_core
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NSPEC2D_TOP_IC) :: jacobian2D_top_inner_core
+
+ real(kind=CUSTOM_REAL), dimension(NDIM,NGLLY,NGLLZ,NSPEC2DMAX_XMIN_XMAX_IC) :: normal_xmin_inner_core,normal_xmax_inner_core
+ real(kind=CUSTOM_REAL), dimension(NDIM,NGLLX,NGLLZ,NSPEC2DMAX_YMIN_YMAX_IC) :: normal_ymin_inner_core,normal_ymax_inner_core
+ real(kind=CUSTOM_REAL), dimension(NDIM,NGLLX,NGLLY,NSPEC2D_BOTTOM_IC) :: normal_bottom_inner_core
+ real(kind=CUSTOM_REAL), dimension(NDIM,NGLLX,NGLLY,NSPEC2D_TOP_IC) :: normal_top_inner_core
+
+ integer, dimension(NSPEC2DMAX_XMIN_XMAX_CM) :: ibelm_xmin_crust_mantle,ibelm_xmax_crust_mantle
+ integer, dimension(NSPEC2DMAX_YMIN_YMAX_CM) :: ibelm_ymin_crust_mantle,ibelm_ymax_crust_mantle
+ integer, dimension(NSPEC2D_BOTTOM_CM) :: ibelm_bottom_crust_mantle
+ integer, dimension(NSPEC2D_TOP_CM) :: ibelm_top_crust_mantle
+
+ real(kind=CUSTOM_REAL), dimension(NGLLY,NGLLZ,NSPEC2DMAX_XMIN_XMAX_CM) :: &
+ jacobian2D_xmin_crust_mantle,jacobian2D_xmax_crust_mantle
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLZ,NSPEC2DMAX_YMIN_YMAX_CM) :: &
+ jacobian2D_ymin_crust_mantle,jacobian2D_ymax_crust_mantle
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NSPEC2D_BOTTOM_CM) :: jacobian2D_bottom_crust_mantle
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NSPEC2D_TOP_CM) :: jacobian2D_top_crust_mantle
+
+ real(kind=CUSTOM_REAL), dimension(NDIM,NGLLY,NGLLZ,NSPEC2DMAX_XMIN_XMAX_CM) :: normal_xmin_crust_mantle,normal_xmax_crust_mantle
+ real(kind=CUSTOM_REAL), dimension(NDIM,NGLLX,NGLLY,NSPEC2DMAX_YMIN_YMAX_CM) :: normal_ymin_crust_mantle,normal_ymax_crust_mantle
+ real(kind=CUSTOM_REAL), dimension(NDIM,NGLLX,NGLLY,NSPEC2D_BOTTOM_CM) :: normal_bottom_crust_mantle
+ real(kind=CUSTOM_REAL), dimension(NDIM,NGLLX,NGLLY,NSPEC2D_TOP_CM) :: normal_top_crust_mantle
+
+ integer, dimension(NSPEC2DMAX_XMIN_XMAX_OC) :: ibelm_xmin_outer_core,ibelm_xmax_outer_core
+ integer, dimension(NSPEC2DMAX_YMIN_YMAX_OC) :: ibelm_ymin_outer_core,ibelm_ymax_outer_core
+ integer, dimension(NSPEC2D_BOTTOM_OC) :: ibelm_bottom_outer_core
+ integer, dimension(NSPEC2D_TOP_OC) :: ibelm_top_outer_core
+
+ real(kind=CUSTOM_REAL), dimension(NDIM,NGLLY,NGLLZ,NSPEC2DMAX_XMIN_XMAX_OC) :: normal_xmin_outer_core,normal_xmax_outer_core
+ real(kind=CUSTOM_REAL), dimension(NDIM,NGLLX,NGLLZ,NSPEC2DMAX_YMIN_YMAX_OC) :: normal_ymin_outer_core,normal_ymax_outer_core
+ real(kind=CUSTOM_REAL), dimension(NDIM,NGLLX,NGLLY,NSPEC2D_BOTTOM_OC) :: normal_bottom_outer_core
+ real(kind=CUSTOM_REAL), dimension(NDIM,NGLLX,NGLLY,NSPEC2D_TOP_OC) :: normal_top_outer_core
+
+ real(kind=CUSTOM_REAL), dimension(NGLLY,NGLLZ,NSPEC2DMAX_XMIN_XMAX_OC) :: jacobian2D_xmin_outer_core,jacobian2D_xmax_outer_core
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLZ,NSPEC2DMAX_YMIN_YMAX_OC) :: jacobian2D_ymin_outer_core,jacobian2D_ymax_outer_core
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NSPEC2D_BOTTOM_OC) :: jacobian2D_bottom_outer_core
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NSPEC2D_TOP_OC) :: jacobian2D_top_outer_core
+
+ integer, dimension(NSPEC2DMAX_XMIN_XMAX_IC) :: ibelm_xmin_inner_core,ibelm_xmax_inner_core
+ integer, dimension(NSPEC2DMAX_YMIN_YMAX_IC) :: ibelm_ymin_inner_core,ibelm_ymax_inner_core
+ integer, dimension(NSPEC2D_BOTTOM_IC) :: ibelm_bottom_inner_core
+ integer, dimension(NSPEC2D_TOP_IC) :: ibelm_top_inner_core
+
+ integer, dimension(NGLOB2DMAX_XY_VAL_CM,NUMFACES_SHARED) :: iboolfaces_crust_mantle
+ integer, dimension(NGLOB2DMAX_XY_VAL_OC,NUMFACES_SHARED) :: iboolfaces_outer_core
+ integer, dimension(NGLOB2DMAX_XY_VAL_IC,NUMFACES_SHARED) :: iboolfaces_inner_core
+
+ integer, dimension(NGLLX,NGLLY,NGLLZ,NSPEC_CRUST_MANTLE) :: ibool_crust_mantle
+
+ integer, dimension(NSPEC_CRUST_MANTLE) :: idoubling_crust_mantle
+
+!! DK DK this array is useless in the solver and is therefore allocated with a dummy size of 1
+ integer, dimension(1) :: idoubling_outer_core
+
+ integer, dimension(NSPEC_INNER_CORE) :: idoubling_inner_core
+
+ integer, dimension(NGLLX,NGLLY,NGLLZ,NSPEC_OUTER_CORE) :: ibool_outer_core
+
+ integer, dimension(NGLLX,NGLLY,NGLLZ,NSPEC_INNER_CORE) :: ibool_inner_core
+
+ integer, dimension(NGLOB1D_RADIAL_CM,NUMCORNERS_SHARED) :: iboolcorner_crust_mantle
+ integer, dimension(NGLOB1D_RADIAL_OC,NUMCORNERS_SHARED) :: iboolcorner_outer_core
+ integer, dimension(NGLOB1D_RADIAL_IC,NUMCORNERS_SHARED) :: iboolcorner_inner_core
+
+ real(kind=CUSTOM_REAL), dimension(NGLOB1D_RADIAL_CM) :: buffer_send_chunkcorners_scalar,buffer_recv_chunkcorners_scalar
+
+ real(kind=CUSTOM_REAL), dimension(NDIM,NGLOB1D_RADIAL_CM + NGLOB1D_RADIAL_IC) :: &
+ buffer_send_chunkcorners_vector,buffer_recv_chunkcorners_vector
+
+ integer, dimension(NGLOB2DMAX_XMIN_XMAX_CM) :: iboolleft_xi_crust_mantle,iboolright_xi_crust_mantle
+ integer, dimension(NGLOB2DMAX_YMIN_YMAX_CM) :: iboolleft_eta_crust_mantle,iboolright_eta_crust_mantle
+ integer, dimension(NGLOB2DMAX_XMIN_XMAX_OC) :: iboolleft_xi_outer_core,iboolright_xi_outer_core
+ integer, dimension(NGLOB2DMAX_YMIN_YMAX_OC) :: iboolleft_eta_outer_core,iboolright_eta_outer_core
+ integer, dimension(NGLOB2DMAX_XMIN_XMAX_IC) :: iboolleft_xi_inner_core,iboolright_xi_inner_core
+ integer, dimension(NGLOB2DMAX_YMIN_YMAX_IC) :: iboolleft_eta_inner_core,iboolright_eta_inner_core
+
+ double precision, dimension(ATT1,ATT2,ATT3,ATT4) :: omsb_crust_mantle_dble, factor_scale_crust_mantle_dble
+
+ double precision, dimension(ATT1,ATT2,ATT3,ATT5) :: omsb_inner_core_dble, factor_scale_inner_core_dble
+
+ real(kind=CUSTOM_REAL), dimension(ATT1,ATT2,ATT3,ATT4) :: one_minus_sum_beta_crust_mantle, factor_scale_crust_mantle
+
+ real(kind=CUSTOM_REAL), dimension(ATT1,ATT2,ATT3,ATT5) :: one_minus_sum_beta_inner_core, factor_scale_inner_core
+
+ real(kind=CUSTOM_REAL), dimension(N_SLS,ATT1,ATT2,ATT3,ATT4) :: factor_common_crust_mantle
+
+ real(kind=CUSTOM_REAL), dimension(N_SLS,ATT1,ATT2,ATT3,ATT5) :: factor_common_inner_core
+
+ double precision, dimension(N_SLS,ATT1,ATT2,ATT3,ATT4) :: factor_common_crust_mantle_dble
+
+ double precision, dimension(N_SLS,ATT1,ATT2,ATT3,ATT5) :: factor_common_inner_core_dble
+
+ integer :: npoin2D_max_all,NDIM_smaller_buffers
+
+! receiver information
+ integer :: nrec,ios
+ character(len=150) :: STATIONS,rec_filename,dummystring
+
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/meshfem3D.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/meshfem3D.f90 2008-08-06 22:57:19 UTC (rev 12567)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/meshfem3D.f90 2008-08-07 00:09:06 UTC (rev 12568)
@@ -620,7 +620,7 @@
! integer, dimension(MAX_NUM_REGIONS) :: NGLOB1D_RADIAL_TEMP
!! DK DK for the merged version
- include 'declar.f90'
+ include 'declarations_mesher.f90'
!! DK DK added this for the merged version
!---- arrays to assemble between chunks
@@ -633,10 +633,6 @@
! communication pattern for corners between chunks
integer, dimension(NCORNERSCHUNKS_VAL) :: iproc_master_corners,iproc_worker1_corners,iproc_worker2_corners
- logical :: not_done_yet
-
- integer :: npoin2D_max_all,NDIM_smaller_buffers
-
! ************** PROGRAM STARTS HERE **************
! initialize the MPI communicator and start the NPROCTOT MPI processes.
@@ -968,9 +964,6 @@
!! DK DK suppressed this for merged
!! DK DK suppressed this for merged if(myrank == 0) close(IOUT)
-!! DK DK added this for the merged version
- not_done_yet = .true.
-
! this for the different counters (which are now different if the superbrick is cut in the outer core)
do iregion=1,MAX_NUM_REGIONS
NSPEC1D_RADIAL_CORNER(iregion,:) = NSPEC1D_RADIAL(iregion)
@@ -1738,29 +1731,28 @@
!! 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 stored in disk files
-!! DK DK this could probably be simplified or merged with create_chunk_buffers, but no time to do it for now
- if(NCHUNKS > 1 .and. iregion_code == IREGION_CRUST_MANTLE) &
-! crust_mantle
+! 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)
+ 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)
-!! $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
-!! DK DK added this for merged version
+ 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)
-! read chunk messages only if more than one chunk
- if(NCHUNKS_VAL /= 1 .and. myrank == 0 .and. not_done_yet) then
+ 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
-! do this only once in the mesher, because these arrays do not change
- not_done_yet = .false.
+! check chunk messages only if more than one chunk
+ if(NCHUNKS_VAL /= 1) then
-! read messages to assemble between chunks with MPI
-
-! file with the list of processors for each message for faces
- open(unit=IIN,file=trim(OUTPUT_FILES)//'/list_messages_faces.txt',status='old',action='read')
+! check messages to assemble between chunks with MPI
do imsg = 1,NUMMSGS_FACES_VAL
- read(IIN,*) imsg_type(imsg),iprocfrom_faces(imsg),iprocto_faces(imsg)
if (iprocfrom_faces(imsg) < 0 &
.or. iprocto_faces(imsg) < 0 &
.or. iprocfrom_faces(imsg) > NPROCTOT-1 &
@@ -1769,13 +1761,9 @@
if (imsg_type(imsg) < 1 .or. imsg_type(imsg) > 3) &
call exit_MPI(myrank,'incorrect message type labeling')
enddo
- close(IIN)
-! file with the list of processors for each message for corners
- open(unit=IIN,file=trim(OUTPUT_FILES)//'/list_messages_corners.txt',status='old',action='read')
+! check the list of processors for each message for corners
do imsg = 1,NCORNERSCHUNKS_VAL
- read(IIN,*) iproc_master_corners(imsg),iproc_worker1_corners(imsg), &
- iproc_worker2_corners(imsg)
if (iproc_master_corners(imsg) < 0 &
.or. iproc_worker1_corners(imsg) < 0 &
.or. iproc_worker2_corners(imsg) < 0 &
@@ -1784,21 +1772,9 @@
.or. iproc_worker2_corners(imsg) > NPROCTOT-1) &
call exit_MPI(myrank,'incorrect chunk corner numbering')
enddo
- close(IIN)
endif
-! broadcast the information read on the master to the nodes
- if(NCHUNKS_VAL /= 1) then
- 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
-
!! $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
! create chunk buffers if more than one chunk
@@ -1812,7 +1788,7 @@
NSPEC2DMAX_XMIN_XMAX(iregion_code),NSPEC2DMAX_YMIN_YMAX(iregion_code), &
NPROC_XI,NPROC_ETA,NPROC,NPROCTOT,NGLOB1D_RADIAL_CORNER,maxval(NGLOB1D_RADIAL_CORNER(iregion_code,:)), &
NGLOB2DMAX_XMIN_XMAX(iregion_code),NGLOB2DMAX_YMIN_YMAX(iregion_code), &
- myrank,LOCAL_PATH,addressing,ichunk_slice,iproc_xi_slice,iproc_eta_slice,NCHUNKS, &
+ myrank,addressing,ichunk_slice,iproc_xi_slice,iproc_eta_slice,NCHUNKS, &
ibool1D_leftxi_lefteta,ibool1D_rightxi_lefteta, &
ibool1D_leftxi_righteta,ibool1D_rightxi_righteta, &
nspec2D_xmin_crust_mantle,nspec2D_xmax_crust_mantle,nspec2D_ymin_crust_mantle,nspec2D_ymax_crust_mantle, &
@@ -1831,7 +1807,7 @@
NSPEC2DMAX_XMIN_XMAX(iregion_code),NSPEC2DMAX_YMIN_YMAX(iregion_code), &
NPROC_XI,NPROC_ETA,NPROC,NPROCTOT,NGLOB1D_RADIAL_CORNER,maxval(NGLOB1D_RADIAL_CORNER(iregion_code,:)), &
NGLOB2DMAX_XMIN_XMAX(iregion_code),NGLOB2DMAX_YMIN_YMAX(iregion_code), &
- myrank,LOCAL_PATH,addressing,ichunk_slice,iproc_xi_slice,iproc_eta_slice,NCHUNKS, &
+ myrank,addressing,ichunk_slice,iproc_xi_slice,iproc_eta_slice,NCHUNKS, &
ibool1D_leftxi_lefteta,ibool1D_rightxi_lefteta, &
ibool1D_leftxi_righteta,ibool1D_rightxi_righteta, &
nspec2D_xmin_outer_core,nspec2D_xmax_outer_core,nspec2D_ymin_outer_core,nspec2D_ymax_outer_core, &
@@ -1850,7 +1826,7 @@
NSPEC2DMAX_XMIN_XMAX(iregion_code),NSPEC2DMAX_YMIN_YMAX(iregion_code), &
NPROC_XI,NPROC_ETA,NPROC,NPROCTOT,NGLOB1D_RADIAL_CORNER,maxval(NGLOB1D_RADIAL_CORNER(iregion_code,:)), &
NGLOB2DMAX_XMIN_XMAX(iregion_code),NGLOB2DMAX_YMIN_YMAX(iregion_code), &
- myrank,LOCAL_PATH,addressing,ichunk_slice,iproc_xi_slice,iproc_eta_slice,NCHUNKS, &
+ myrank,addressing,ichunk_slice,iproc_xi_slice,iproc_eta_slice,NCHUNKS, &
ibool1D_leftxi_lefteta,ibool1D_rightxi_lefteta, &
ibool1D_leftxi_righteta,ibool1D_rightxi_righteta, &
nspec2D_xmin_inner_core,nspec2D_xmax_inner_core,nspec2D_ymin_inner_core,nspec2D_ymax_inner_core, &
@@ -2060,6 +2036,32 @@
NDIM_smaller_buffers = 1
endif
+! --------- receivers ---------------
+
+ rec_filename = 'DATA/STATIONS'
+ call get_value_string(STATIONS, 'solver.STATIONS', rec_filename)
+
+! get total number of receivers
+ if(myrank == 0) then
+ open(unit=IIN,file=STATIONS,iostat=ios,status='old',action='read')
+ nrec = 0
+ do while(ios == 0)
+ read(IIN,"(a)",iostat=ios) dummystring
+ if(ios == 0) nrec = nrec + 1
+ enddo
+ close(IIN)
+ endif
+! broadcast the information read on the master to the nodes
+ call MPI_BCAST(nrec,1,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
+
+ if(myrank == 0) then
+ write(IMAIN,*)
+ write(IMAIN,*) 'Total number of receivers = ', nrec
+ write(IMAIN,*)
+ endif
+
+ if(nrec < 1) call exit_MPI(myrank,'need at least one receiver')
+
!! DK DK for the merged version
include 'call1.f90'
!! DK DK for now use variables just to make sure we don't get warning about unused variables
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-08-06 22:57:19 UTC (rev 12567)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/read_compute_parameters.f90 2008-08-07 00:09:06 UTC (rev 12568)
@@ -209,7 +209,7 @@
! support for only one slice per chunk has been discontinued when there is more than one chunk
! because it induces topological problems, and we are not interested in using small meshes
- if(NCHUNKS == 1 .and. (NPROC_XI == 1 .or. NPROC_ETA == 1)) stop 'support for only one slice per chunk has been discontinued'
+ if(NCHUNKS > 1 .and. (NPROC_XI == 1 .or. NPROC_ETA == 1)) stop 'support for only one slice per chunk has been discontinued'
! define the velocity model
call read_value_string(MODEL, 'model.name')
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/specfem3D.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/specfem3D.f90 2008-08-06 22:57:19 UTC (rev 12567)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/version41_beta/src/specfem3D.f90 2008-08-07 00:09:06 UTC (rev 12568)
@@ -435,16 +435,19 @@
double precision, dimension(NDIM,NDIM,NSOURCES) :: nu_source
! receiver information
- integer nrec,nrec_local,nrec_tot_found,irec_local,ios
- integer, dimension(:), allocatable :: islice_selected_rec,ispec_selected_rec,number_receiver_global
- double precision, dimension(:), allocatable :: xi_receiver,eta_receiver,gamma_receiver
- double precision hlagrange
- character(len=150) :: STATIONS,rec_filename,dummystring
- double precision, dimension(:,:,:), allocatable :: nu
- double precision, allocatable, dimension(:) :: stlat,stlon,stele
- character(len=MAX_LENGTH_STATION_NAME), dimension(:), allocatable :: station_name
- character(len=MAX_LENGTH_NETWORK_NAME), dimension(:), allocatable :: network_name
+ integer :: nrec,nrec_local,nrec_tot_found,irec_local
+ double precision :: hlagrange
+ integer, dimension(:), allocatable :: number_receiver_global
+ character(len=150) :: STATIONS,rec_filename
+! allocate these automatic arrays in the memory stack to avoid memory fragmentation with "allocate()"
+ integer, dimension(nrec) :: islice_selected_rec,ispec_selected_rec
+ double precision, dimension(nrec) :: xi_receiver,eta_receiver,gamma_receiver
+ double precision, dimension(NDIM,NDIM,nrec) :: nu
+ double precision, dimension(nrec) :: stlat,stlon,stele
+ character(len=MAX_LENGTH_STATION_NAME), dimension(nrec) :: station_name
+ character(len=MAX_LENGTH_NETWORK_NAME), dimension(nrec) :: network_name
+
! seismograms
integer it_begin,it_end,nit_written
double precision uxd, uyd, uzd
@@ -1160,96 +1163,10 @@
t0 = - 1.5d0*minval(t_cmt-hdur)
! --------- receivers ---------------
- rec_filename = 'DATA/STATIONS'
+
+ rec_filename = 'DATA/STATIONS'
call get_value_string(STATIONS, 'solver.STATIONS', rec_filename)
-! get total number of receivers
- if(myrank == 0) then
- open(unit=IIN,file=STATIONS,iostat=ios,status='old',action='read')
- nrec = 0
- do while(ios == 0)
- read(IIN,"(a)",iostat=ios) dummystring
- if(ios == 0) nrec = nrec + 1
- enddo
- close(IIN)
- endif
-! broadcast the information read on the master to the nodes
- call MPI_BCAST(nrec,1,MPI_INTEGER,0,MPI_COMM_WORLD,ier)
- if(myrank == 0) then
- write(IMAIN,*)
- write(IMAIN,*) 'Total number of receivers = ', nrec
- write(IMAIN,*)
- endif
-
- if(nrec < 1) call exit_MPI(myrank,'need at least one receiver')
-
-! allocate memory for receiver arrays
- allocate(islice_selected_rec(nrec),STAT=ier)
- if (ier /= 0 ) then
- print *,"ABORTING can not allocate in specfem3D ier=",ier
- call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
- endif
-
- allocate(ispec_selected_rec(nrec),STAT=ier)
- if (ier /= 0 ) then
- print *,"ABORTING can not allocate in specfem3D ier=",ier
- call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
- endif
-
- allocate(xi_receiver(nrec),STAT=ier)
- if (ier /= 0 ) then
- print *,"ABORTING can not allocate in specfem3D ier=",ier
- call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
- endif
-
- allocate(eta_receiver(nrec),STAT=ier)
- if (ier /= 0 ) then
- print *,"ABORTING can not allocate in specfem3D ier=",ier
- call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
- endif
-
- allocate(gamma_receiver(nrec),STAT=ier)
- if (ier /= 0 ) then
- print *,"ABORTING can not allocate in specfem3D ier=",ier
- call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
- endif
-
- allocate(station_name(nrec),STAT=ier)
- if (ier /= 0 ) then
- print *,"ABORTING can not allocate in specfem3D ier=",ier
- call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
- endif
-
- allocate(network_name(nrec),STAT=ier)
- if (ier /= 0 ) then
- print *,"ABORTING can not allocate in specfem3D ier=",ier
- call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
- endif
-
- allocate(stlat(nrec),STAT=ier)
- if (ier /= 0 ) then
- print *,"ABORTING can not allocate in specfem3D ier=",ier
- call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
- endif
-
- allocate(stlon(nrec),STAT=ier)
- if (ier /= 0 ) then
- print *,"ABORTING can not allocate in specfem3D ier=",ier
- call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
- endif
-
- allocate(stele(nrec),STAT=ier)
- if (ier /= 0 ) then
- print *,"ABORTING can not allocate in specfem3D ier=",ier
- call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
- endif
-
- allocate(nu(NDIM,NDIM,nrec),STAT=ier)
- if (ier /= 0 ) then
- print *,"ABORTING can not allocate in specfem3D ier=",ier
- call MPI_Abort(MPI_COMM_WORLD,errorcode,ier)
- endif
-
! locate receivers in the crust in the mesh
call locate_receivers(myrank,DT,NSTEP,NSPEC_CRUST_MANTLE,NGLOB_CRUST_MANTLE,ibool_crust_mantle, &
xstore_crust_mantle,ystore_crust_mantle,zstore_crust_mantle, &
More information about the cig-commits
mailing list