[cig-commits] r22858 - in seismo/3D/SPECFEM3D_GLOBE/trunk: . doc/USER_MANUAL src/auxiliaries utils/oldstuff
dkomati1 at geodynamics.org
dkomati1 at geodynamics.org
Thu Sep 26 09:03:46 PDT 2013
Author: dkomati1
Date: 2013-09-26 09:03:46 -0700 (Thu, 26 Sep 2013)
New Revision: 22858
Added:
seismo/3D/SPECFEM3D_GLOBE/trunk/utils/oldstuff/check_buffers_1D.f90
seismo/3D/SPECFEM3D_GLOBE/trunk/utils/oldstuff/check_buffers_2D.f90
seismo/3D/SPECFEM3D_GLOBE/trunk/utils/oldstuff/check_buffers_corners_chunks.f90
seismo/3D/SPECFEM3D_GLOBE/trunk/utils/oldstuff/check_buffers_faces_chunks.f90
Removed:
seismo/3D/SPECFEM3D_GLOBE/trunk/src/auxiliaries/check_buffers_1D.f90
seismo/3D/SPECFEM3D_GLOBE/trunk/src/auxiliaries/check_buffers_2D.f90
seismo/3D/SPECFEM3D_GLOBE/trunk/src/auxiliaries/check_buffers_corners_chunks.f90
seismo/3D/SPECFEM3D_GLOBE/trunk/src/auxiliaries/check_buffers_faces_chunks.f90
seismo/3D/SPECFEM3D_GLOBE/trunk/yyyyyyyyy_we_can_get_rid_of_all_the_check_buffers_programs_when_new_version_is_released
Modified:
seismo/3D/SPECFEM3D_GLOBE/trunk/Makefile.in
seismo/3D/SPECFEM3D_GLOBE/trunk/doc/USER_MANUAL/manual_SPECFEM3D_GLOBE.tex
seismo/3D/SPECFEM3D_GLOBE/trunk/src/auxiliaries/rules.mk
Log:
removed all check_buffers_* programs, which are now unused in the new merged GPU and MPI version
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/Makefile.in
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/Makefile.in 2013-09-26 15:31:37 UTC (rev 22857)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/Makefile.in 2013-09-26 16:03:46 UTC (rev 22858)
@@ -196,10 +196,6 @@
xcompute_optimized_dumping_undo_att \
xmeshfem3D \
xspecfem3D \
- xcheck_buffers_1D \
- xcheck_buffers_2D \
- xcheck_buffers_corners_chunks \
- xcheck_buffers_faces_chunks \
xcombine_vol_data \
xcombine_vol_data_vtk \
xcombine_surf_data \
@@ -247,10 +243,6 @@
@echo " xspecfem3D"
@echo " xcreate_header_file"
@echo " xcompute_optimized_dumping_undo_att"
- @echo " xcheck_buffers_1D"
- @echo " xcheck_buffers_2D"
- @echo " xcheck_buffers_corners_chunks"
- @echo " xcheck_buffers_faces_chunks"
@echo " xcombine_vol_data"
@echo " xcombine_vol_data_vtk"
@echo " xcombine_surf_data"
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/doc/USER_MANUAL/manual_SPECFEM3D_GLOBE.tex
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/doc/USER_MANUAL/manual_SPECFEM3D_GLOBE.tex 2013-09-26 15:31:37 UTC (rev 22857)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/doc/USER_MANUAL/manual_SPECFEM3D_GLOBE.tex 2013-09-26 16:03:46 UTC (rev 22858)
@@ -322,12 +322,21 @@
You can do this for instance with the example given in EXAMPLES/small\_benchmark\_run\_to\_test\_a\_new\_machine.\\
If you run very large meshes on a relatively small number
-of processors, the memory size needed on each processor might become
-greater than 2 gigabytes, which is the upper limit for 32-bit addressing.
-In this case, on some compilers you may need to add \texttt{``-mcmodel=medium}'' or \texttt{``-mcmodel=medium -shared-intel}''
+of processors, the static memory size needed on each processor might become
+greater than 2 gigabytes, which is the upper limit for 32-bit addressing
+(dynamic memory allocation is always OK, even beyond the 2 GB limit; only static memory has a problem).
+In this case, on some compilers you may need to add \texttt{``-mcmodel=medium}'' (if you do not use the Intel ifort / icc compiler)
+or \texttt{``-mcmodel=medium -shared-intel}'' (if you use the Intel ifort / icc compiler)
to the configure options of CFLAGS, FCFLAGS and LDFLAGS otherwise the compiler will display an error
message (for instance \texttt{``relocation truncated to fit: R\_X86\_64\_PC32 against .bss''} or something similar);
-on an IBM machine with the \texttt{xlf} and \texttt{xlc} compilers, using \texttt{-q64} is usually sufficient.\\
+on an IBM machine with the \texttt{xlf} and \texttt{xlc} compilers, using \texttt{-q64} is usually sufficient.
+\textbf{BEWARE that using \texttt{``-mcmodel=medium -shared-intel}'' is known for currently leading to incorrect seismograms,
+at least when flag ATTENUATION is on (and maybe even without), at least in the case of the Intel ifort / icc compiler.
+This likely comes from intrinsic functions such as size() that return and integer8 instead of an integer4, thus leading
+to incorrect results when used in function calls is the -i8 flag is not added to the compiler options;
+however, when adding -i8 the code does not compile because the MPI calls then refuse to compile (they need integer4 as arguments).
+Since most current users run the code with less than 2 GB of static memory per core, we have not investigated that problem carefully for now,
+and thus recommend that you do NOT use these compiler flags.}\\
A summary of the most important configuration variables follows.
@@ -1294,34 +1303,7 @@
details about the future simulation.
-\section{Checking the MPI Buffers (Optional)}
-The mesher writes MPI communication tables in the \texttt{OUTPUT\_FILES}
-subdirectory in the files \texttt{addressing.txt}, \texttt{list\_messages\_corners.txt}
-and \texttt{list\_messages\_faces.txt}, and MPI communication buffers
-to the local disks. Use the four serial codes
-
-\begin{lyxcode}
-check\_buffers\_2D.f90
-
-check\_buffers\_1D.f90
-
-check\_buffers\_faces\_chunks.f90
-
-check\_buffers\_corners\_chunks.f90~
-\end{lyxcode}
-to check that all the MPI buffers created by the mesher have been
-generated correctly. For example, typing `\texttt{make check\_buffers\_2D}'
-and then `\texttt{xcheck\_buffers\_2D}' checks the communication buffers
-between faces common to the mesh slices. `\texttt{xcheck\_buffers\_1D}'
-checks the communication buffers between edges common to the mesh
-slices. `\texttt{xcheck\_buffers\_faces\_chunks}' checks the communication
-buffers between faces common to the mesh chunks, i.e., the faces of
-the six blocks of the cubed-sphere mesh. `\texttt{xcheck\_buffers\_corners\_chunks}'
-checks the communication buffers between edges common to the mesh
-chunks, which must be treated separately in MPI because they are of
-valence 3 (i.e., they are shared between three chunks).
-
Please note that running these codes is optional because no information
needed by the solver is generated.
Deleted: seismo/3D/SPECFEM3D_GLOBE/trunk/src/auxiliaries/check_buffers_1D.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/src/auxiliaries/check_buffers_1D.f90 2013-09-26 15:31:37 UTC (rev 22857)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/src/auxiliaries/check_buffers_1D.f90 2013-09-26 16:03:46 UTC (rev 22858)
@@ -1,501 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D G l o b e V e r s i o n 6 . 0
-! --------------------------------------------------
-!
-! Main authors: Dimitri Komatitsch and Jeroen Tromp
-! Princeton University, USA
-! and CNRS / INRIA / University of Pau, France
-! (c) Princeton University and CNRS / INRIA / University of Pau
-! August 2013
-!
-! This program is free software; you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation; either version 2 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along
-! with this program; if not, write to the Free Software Foundation, Inc.,
-! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-!
-!=====================================================================
-
-! code to check that all the internal MPI 1D buffers are okay
-! inside any given chunk, along both xi and eta
-! we compare the coordinates of the points in the buffers
-
- program check_buffers_1D
-
- use constants
- use shared_parameters
-
- implicit none
-
- integer ithisproc,iotherproc
- integer ipoin
-
- double precision diff
-
- integer npoin1D_mesher,npoin1D
-
-! for addressing of the slices
- integer ichunk,iproc_xi,iproc_eta,iproc,icorners,iregion_code
- integer iproc_read
- integer, dimension(:,:,:), allocatable :: addressing
-
-! 1D addressing for copy of edges between slices
-! we add one to the size of the array for the final flag
- integer, dimension(:), allocatable :: iboolleft,iboolright
- double precision, dimension(:), allocatable :: xleft,yleft,zleft,xright,yright,zright
-
-! processor identification
- character(len=150) prname,prname_other
-
- integer :: NGLOB1D_RADIAL_MAX
- integer, dimension(MAX_NUM_REGIONS,NB_SQUARE_CORNERS) :: NGLOB1D_RADIAL_CORNER
- integer, dimension(NB_SQUARE_CORNERS) :: NGLOB1D_RADIAL_SPEC_THIS
- integer, dimension(NB_SQUARE_CORNERS) :: NGLOB1D_RADIAL_SPEC_OTHER
-
-! ************** PROGRAM STARTS HERE **************
-
- print *
- print *,'Check all MPI buffers along xi and eta inside each chunk'
- print *
-
-! read the parameter file and compute additional parameters
- call read_compute_parameters()
-
-! get the base pathname for output files
- call get_value_string(OUTPUT_FILES, 'OUTPUT_FILES', 'OUTPUT_FILES')
-
- print *
- print *,'There are ',NPROCTOT,' slices numbered from 0 to ',NPROCTOT-1
- print *,'There are ',NCHUNKS,' chunks'
- print *,'There are ',NPROC_XI,' slices along xi in each chunk'
- print *,'There are ',NPROC_ETA,' slices along eta in each chunk'
- print *
-
-! dynamic memory allocation for arrays
- allocate(addressing(NCHUNKS,0:NPROC_XI-1,0:NPROC_ETA-1))
-
-! open file with global slice number addressing
- print *,'reading slice addressing'
- open(unit=34,file=trim(OUTPUT_FILES)//'/addressing.txt',status='old',action='read')
- do iproc = 0,NPROCTOT-1
- read(34,*) iproc_read,ichunk,iproc_xi,iproc_eta
- if(iproc_read /= iproc) stop 'incorrect slice number read'
- addressing(ichunk,iproc_xi,iproc_eta) = iproc
- enddo
- close(34)
-
-! loop over all the regions of the mesh
- do iregion_code = 1,MAX_NUM_REGIONS
-
- print *
- print *,' ********* checking region ',iregion_code,' *********'
- print *
-
- NGLOB1D_RADIAL_CORNER(iregion_code,:) = NGLOB1D_RADIAL(iregion_code)
- NGLOB1D_RADIAL_MAX = NGLOB1D_RADIAL(iregion_code)
- if (iregion_code == IREGION_OUTER_CORE .and. (CUT_SUPERBRICK_XI .or. CUT_SUPERBRICK_ETA)) then
- NGLOB1D_RADIAL_MAX = NGLOB1D_RADIAL_MAX + maxval(DIFF_NSPEC1D_RADIAL(:,:))*(NGLLZ-1)
- endif
-
-! dynamic memory allocation for arrays
- allocate(iboolleft(NGLOB1D_RADIAL_MAX+1))
- allocate(iboolright(NGLOB1D_RADIAL_MAX+1))
- allocate(xleft(NGLOB1D_RADIAL_MAX+1))
- allocate(yleft(NGLOB1D_RADIAL_MAX+1))
- allocate(zleft(NGLOB1D_RADIAL_MAX+1))
- allocate(xright(NGLOB1D_RADIAL_MAX+1))
- allocate(yright(NGLOB1D_RADIAL_MAX+1))
- allocate(zright(NGLOB1D_RADIAL_MAX+1))
-
-! ********************************************************
-! *************** check along xi
-! ********************************************************
-
-! loop for both corners for 1D buffers
- do icorners=1,2
-
- print *
- print *,'Checking for xi in set of corners # ',icorners
- print *
-
-! loop on the chunks
- do ichunk = 1,NCHUNKS
-
- print *
- print *,'Checking xi in chunk ',ichunk
- print *
-
-! double loop on NPROC_XI and NPROC_ETA
- do iproc_eta=0,NPROC_ETA-1
-
- print *,'checking row ',iproc_eta
-
- do iproc_xi=0,NPROC_XI-2
-
- print *,'checking slice ixi = ',iproc_xi,' in that row'
-
- ithisproc = addressing(ichunk,iproc_xi,iproc_eta)
- iotherproc = addressing(ichunk,iproc_xi+1,iproc_eta)
-
- NGLOB1D_RADIAL_SPEC_THIS(:) = NGLOB1D_RADIAL_CORNER(iregion_code,:)
- if (iregion_code==IREGION_OUTER_CORE) then
- if (CUT_SUPERBRICK_XI) then
- if (CUT_SUPERBRICK_ETA) then
- if (mod(iproc_xi,2) == 0) then
- if (mod(iproc_eta,2) == 0) then
- NGLOB1D_RADIAL_SPEC_THIS(:) = NGLOB1D_RADIAL_SPEC_THIS(:) + (DIFF_NSPEC1D_RADIAL(:,1)*(NGLLZ-1))
- else
- NGLOB1D_RADIAL_SPEC_THIS(:) = NGLOB1D_RADIAL_SPEC_THIS(:) + (DIFF_NSPEC1D_RADIAL(:,2)*(NGLLZ-1))
- endif
- else
- if (mod(iproc_eta,2) == 0) then
- NGLOB1D_RADIAL_SPEC_THIS(:) = NGLOB1D_RADIAL_SPEC_THIS(:) + (DIFF_NSPEC1D_RADIAL(:,3)*(NGLLZ-1))
- else
- NGLOB1D_RADIAL_SPEC_THIS(:) = NGLOB1D_RADIAL_SPEC_THIS(:) + (DIFF_NSPEC1D_RADIAL(:,4)*(NGLLZ-1))
- endif
- endif
- else
- if (mod(iproc_xi,2) == 0) then
- NGLOB1D_RADIAL_SPEC_THIS(:) = NGLOB1D_RADIAL_SPEC_THIS(:) + (DIFF_NSPEC1D_RADIAL(:,1)*(NGLLZ-1))
- else
- NGLOB1D_RADIAL_SPEC_THIS(:) = NGLOB1D_RADIAL_SPEC_THIS(:) + (DIFF_NSPEC1D_RADIAL(:,2)*(NGLLZ-1))
- endif
- endif
- else
- if (CUT_SUPERBRICK_ETA) then
- if (mod(iproc_eta,2) == 0) then
- NGLOB1D_RADIAL_SPEC_THIS(:) = NGLOB1D_RADIAL_SPEC_THIS(:) + (DIFF_NSPEC1D_RADIAL(:,1)*(NGLLZ-1))
- else
- NGLOB1D_RADIAL_SPEC_THIS(:) = NGLOB1D_RADIAL_SPEC_THIS(:) + (DIFF_NSPEC1D_RADIAL(:,2)*(NGLLZ-1))
- endif
- endif
- endif
- endif
- NGLOB1D_RADIAL_SPEC_OTHER(:) = NGLOB1D_RADIAL_CORNER(iregion_code,:)
- if (iregion_code==IREGION_OUTER_CORE) then
- if (CUT_SUPERBRICK_XI) then
- if (CUT_SUPERBRICK_ETA) then
- if (mod(iproc_xi+1,2) == 0) then
- if (mod(iproc_eta,2) == 0) then
- NGLOB1D_RADIAL_SPEC_OTHER(:) = NGLOB1D_RADIAL_SPEC_OTHER(:) + (DIFF_NSPEC1D_RADIAL(:,1)*(NGLLZ-1))
- else
- NGLOB1D_RADIAL_SPEC_OTHER(:) = NGLOB1D_RADIAL_SPEC_OTHER(:) + (DIFF_NSPEC1D_RADIAL(:,2)*(NGLLZ-1))
- endif
- else
- if (mod(iproc_eta,2) == 0) then
- NGLOB1D_RADIAL_SPEC_OTHER(:) = NGLOB1D_RADIAL_SPEC_OTHER(:) + (DIFF_NSPEC1D_RADIAL(:,3)*(NGLLZ-1))
- else
- NGLOB1D_RADIAL_SPEC_OTHER(:) = NGLOB1D_RADIAL_SPEC_OTHER(:) + (DIFF_NSPEC1D_RADIAL(:,4)*(NGLLZ-1))
- endif
- endif
- else
- if (mod(iproc_xi+1,2) == 0) then
- NGLOB1D_RADIAL_SPEC_OTHER(:) = NGLOB1D_RADIAL_SPEC_OTHER(:) + (DIFF_NSPEC1D_RADIAL(:,1)*(NGLLZ-1))
- else
- NGLOB1D_RADIAL_SPEC_OTHER(:) = NGLOB1D_RADIAL_SPEC_OTHER(:) + (DIFF_NSPEC1D_RADIAL(:,2)*(NGLLZ-1))
- endif
- endif
- else
- if (CUT_SUPERBRICK_ETA) then
- if (mod(iproc_eta,2) == 0) then
- NGLOB1D_RADIAL_SPEC_OTHER(:) = NGLOB1D_RADIAL_SPEC_OTHER(:) + (DIFF_NSPEC1D_RADIAL(:,1)*(NGLLZ-1))
- else
- NGLOB1D_RADIAL_SPEC_OTHER(:) = NGLOB1D_RADIAL_SPEC_OTHER(:) + (DIFF_NSPEC1D_RADIAL(:,2)*(NGLLZ-1))
- endif
- endif
- endif
- endif
-! create the name for the database of the current slide
- call create_serial_name_database(prname,ithisproc,iregion_code, &
- LOCAL_PATH,NPROCTOT,OUTPUT_FILES)
- call create_serial_name_database(prname_other,iotherproc,iregion_code, &
- LOCAL_PATH,NPROCTOT,OUTPUT_FILES)
-
-! read 1D addressing buffers for copy between slices along xi with MPI
-
- if(icorners == 1) then
-! read ibool1D_rightxi_lefteta of this slice
- write(*,*) 'reading MPI 1D buffer ibool1D_rightxi_lefteta slice ',ithisproc
- open(unit=34,file=prname(1:len_trim(prname))//'ibool1D_rightxi_lefteta.txt',status='old',action='read')
- else if(icorners == 2) then
-! read ibool1D_rightxi_righteta of this slice
- write(*,*) 'reading MPI 1D buffer ibool1D_rightxi_righteta slice ',ithisproc
- open(unit=34,file=prname(1:len_trim(prname))//'ibool1D_rightxi_righteta.txt',status='old',action='read')
- else
- stop 'incorrect corner number'
- endif
-
- npoin1D = 1
- 360 continue
- read(34,*) iboolright(npoin1D),xright(npoin1D),yright(npoin1D),zright(npoin1D)
- if(iboolright(npoin1D) > 0) then
- npoin1D = npoin1D + 1
- goto 360
- endif
- npoin1D = npoin1D - 1
- write(*,*) 'found ',npoin1D,' points in iboolright slice ',ithisproc
- read(34,*) npoin1D_mesher
- if(icorners == 1) then
- if(npoin1D /= NGLOB1D_RADIAL_SPEC_THIS(2)) stop 'incorrect iboolright read'
- else
- if(npoin1D /= NGLOB1D_RADIAL_SPEC_THIS(3)) stop 'incorrect iboolright read'
- endif
- close(34)
-
- if(icorners == 1) then
-! read ibool1D_leftxi_lefteta of other slice
- write(*,*) 'reading MPI 1D buffer ibool1D_leftxi_lefteta slice ',iotherproc
- open(unit=34,file=prname_other(1:len_trim(prname_other))//'ibool1D_leftxi_lefteta.txt',status='old',action='read')
- else if(icorners == 2) then
-! read ibool1D_leftxi_righteta of other slice
- write(*,*) 'reading MPI 1D buffer ibool1D_leftxi_righteta slice ',iotherproc
- open(unit=34,file=prname_other(1:len_trim(prname_other))//'ibool1D_leftxi_righteta.txt',status='old',action='read')
- else
- stop 'incorrect corner number'
- endif
-
- npoin1D = 1
- 350 continue
- read(34,*) iboolleft(npoin1D),xleft(npoin1D),yleft(npoin1D),zleft(npoin1D)
- if(iboolleft(npoin1D) > 0) then
- npoin1D = npoin1D + 1
- goto 350
- endif
- npoin1D = npoin1D - 1
- write(*,*) 'found ',npoin1D,' points in iboolleft slice ',iotherproc
- read(34,*) npoin1D_mesher
- if(icorners == 1) then
- if(npoin1D /= NGLOB1D_RADIAL_SPEC_OTHER(1)) stop 'incorrect iboolleft read'
- else
- if(npoin1D /= NGLOB1D_RADIAL_SPEC_OTHER(4)) stop 'incorrect iboolleft read'
- endif
- close(34)
-
-! check the coordinates of all the points in the buffer
-! to see if it is correctly sorted
- do ipoin = 1,npoin1D
- diff = dmax1(dabs(xleft(ipoin)-xright(ipoin)), &
- dabs(yleft(ipoin)-yright(ipoin)),dabs(zleft(ipoin)-zright(ipoin)))
- if(diff > 0.0000001d0) then
- print *,'different: ',ipoin,iboolleft(ipoin),iboolright(ipoin),diff
- stop 'error: different'
- endif
- enddo
-
- enddo
- enddo
- enddo
-
- enddo
-
-
-! ********************************************************
-! *************** check along eta
-! ********************************************************
-
-! added loop for both corners for 1D buffers
- do icorners=1,2
-
- print *
- print *,'Checking for eta in set of corners # ',icorners
- print *
-
-! loop on the chunks
- do ichunk = 1,NCHUNKS
-
- print *
- print *,'Checking eta in chunk ',ichunk
- print *
-
-! double loop on NPROC_XI and NPROC_ETA
- do iproc_xi=0,NPROC_XI-1
-
- print *,'checking row ',iproc_xi
-
- do iproc_eta=0,NPROC_ETA-2
-
- print *,'checking slice ieta = ',iproc_eta,' in that row'
-
- ithisproc = addressing(ichunk,iproc_xi,iproc_eta)
- iotherproc = addressing(ichunk,iproc_xi,iproc_eta+1)
-
- NGLOB1D_RADIAL_SPEC_THIS(:) = NGLOB1D_RADIAL_CORNER(iregion_code,:)
- if (iregion_code==IREGION_OUTER_CORE) then
- if (CUT_SUPERBRICK_XI) then
- if (CUT_SUPERBRICK_ETA) then
- if (mod(iproc_xi,2) == 0) then
- if (mod(iproc_eta,2) == 0) then
- NGLOB1D_RADIAL_SPEC_THIS(:) = NGLOB1D_RADIAL_SPEC_THIS(:) + (DIFF_NSPEC1D_RADIAL(:,1)*(NGLLZ-1))
- else
- NGLOB1D_RADIAL_SPEC_THIS(:) = NGLOB1D_RADIAL_SPEC_THIS(:) + (DIFF_NSPEC1D_RADIAL(:,2)*(NGLLZ-1))
- endif
- else
- if (mod(iproc_eta,2) == 0) then
- NGLOB1D_RADIAL_SPEC_THIS(:) = NGLOB1D_RADIAL_SPEC_THIS(:) + (DIFF_NSPEC1D_RADIAL(:,3)*(NGLLZ-1))
- else
- NGLOB1D_RADIAL_SPEC_THIS(:) = NGLOB1D_RADIAL_SPEC_THIS(:) + (DIFF_NSPEC1D_RADIAL(:,4)*(NGLLZ-1))
- endif
- endif
- else
- if (mod(iproc_xi,2) == 0) then
- NGLOB1D_RADIAL_SPEC_THIS(:) = NGLOB1D_RADIAL_SPEC_THIS(:) + (DIFF_NSPEC1D_RADIAL(:,1)*(NGLLZ-1))
- else
- NGLOB1D_RADIAL_SPEC_THIS(:) = NGLOB1D_RADIAL_SPEC_THIS(:) + (DIFF_NSPEC1D_RADIAL(:,2)*(NGLLZ-1))
- endif
- endif
- else
- if (CUT_SUPERBRICK_ETA) then
- if (mod(iproc_eta,2) == 0) then
- NGLOB1D_RADIAL_SPEC_THIS(:) = NGLOB1D_RADIAL_SPEC_THIS(:) + (DIFF_NSPEC1D_RADIAL(:,1)*(NGLLZ-1))
- else
- NGLOB1D_RADIAL_SPEC_THIS(:) = NGLOB1D_RADIAL_SPEC_THIS(:) + (DIFF_NSPEC1D_RADIAL(:,2)*(NGLLZ-1))
- endif
- endif
- endif
- endif
- NGLOB1D_RADIAL_SPEC_OTHER(:) = NGLOB1D_RADIAL_CORNER(iregion_code,:)
- if (iregion_code==IREGION_OUTER_CORE) then
- if (CUT_SUPERBRICK_XI) then
- if (CUT_SUPERBRICK_ETA) then
- if (mod(iproc_xi,2) == 0) then
- if (mod(iproc_eta+1,2) == 0) then
- NGLOB1D_RADIAL_SPEC_OTHER(:) = NGLOB1D_RADIAL_SPEC_OTHER(:) + (DIFF_NSPEC1D_RADIAL(:,1)*(NGLLZ-1))
- else
- NGLOB1D_RADIAL_SPEC_OTHER(:) = NGLOB1D_RADIAL_SPEC_OTHER(:) + (DIFF_NSPEC1D_RADIAL(:,2)*(NGLLZ-1))
- endif
- else
- if (mod(iproc_eta+1,2) == 0) then
- NGLOB1D_RADIAL_SPEC_OTHER(:) = NGLOB1D_RADIAL_SPEC_OTHER(:) + (DIFF_NSPEC1D_RADIAL(:,3)*(NGLLZ-1))
- else
- NGLOB1D_RADIAL_SPEC_OTHER(:) = NGLOB1D_RADIAL_SPEC_OTHER(:) + (DIFF_NSPEC1D_RADIAL(:,4)*(NGLLZ-1))
- endif
- endif
- else
- if (mod(iproc_xi,2) == 0) then
- NGLOB1D_RADIAL_SPEC_OTHER(:) = NGLOB1D_RADIAL_SPEC_OTHER(:) + (DIFF_NSPEC1D_RADIAL(:,1)*(NGLLZ-1))
- else
- NGLOB1D_RADIAL_SPEC_OTHER(:) = NGLOB1D_RADIAL_SPEC_OTHER(:) + (DIFF_NSPEC1D_RADIAL(:,2)*(NGLLZ-1))
- endif
- endif
- else
- if (CUT_SUPERBRICK_ETA) then
- if (mod(iproc_eta+1,2) == 0) then
- NGLOB1D_RADIAL_SPEC_OTHER(:) = NGLOB1D_RADIAL_SPEC_OTHER(:) + (DIFF_NSPEC1D_RADIAL(:,1)*(NGLLZ-1))
- else
- NGLOB1D_RADIAL_SPEC_OTHER(:) = NGLOB1D_RADIAL_SPEC_OTHER(:) + (DIFF_NSPEC1D_RADIAL(:,2)*(NGLLZ-1))
- endif
- endif
- endif
- endif
-! create the name for the database of the current slide
- call create_serial_name_database(prname,ithisproc,iregion_code, &
- LOCAL_PATH,NPROCTOT,OUTPUT_FILES)
- call create_serial_name_database(prname_other,iotherproc,iregion_code, &
- LOCAL_PATH,NPROCTOT,OUTPUT_FILES)
-
-! read 1D addressing buffers for copy between slices along xi with MPI
-
- if(icorners == 1) then
-! read ibool1D_leftxi_righteta of this slice
- write(*,*) 'reading MPI 1D buffer ibool1D_leftxi_righteta slice ',ithisproc
- open(unit=34,file=prname(1:len_trim(prname))//'ibool1D_leftxi_righteta.txt',status='old',action='read')
- else if(icorners == 2) then
-! read ibool1D_rightxi_righteta of this slice
- write(*,*) 'reading MPI 1D buffer ibool1D_rightxi_righteta slice ',ithisproc
- open(unit=34,file=prname(1:len_trim(prname))//'ibool1D_rightxi_righteta.txt',status='old',action='read')
- else
- stop 'incorrect corner number'
- endif
-
- npoin1D = 1
- 460 continue
- read(34,*) iboolright(npoin1D),xright(npoin1D),yright(npoin1D),zright(npoin1D)
- if(iboolright(npoin1D) > 0) then
- npoin1D = npoin1D + 1
- goto 460
- endif
- npoin1D = npoin1D - 1
- write(*,*) 'found ',npoin1D,' points in iboolright slice ',ithisproc
- read(34,*) npoin1D_mesher
-
- if(icorners == 1) then
- if(npoin1D /= NGLOB1D_RADIAL_SPEC_THIS(4)) stop 'incorrect iboolright read'
- else
- if(npoin1D /= NGLOB1D_RADIAL_SPEC_THIS(3)) stop 'incorrect iboolright read'
- endif
- close(34)
-
- if(icorners == 1) then
-! read ibool1D_leftxi_lefteta of other slice
- write(*,*) 'reading MPI 1D buffer ibool1D_leftxi_lefteta slice ',iotherproc
- open(unit=34,file=prname_other(1:len_trim(prname_other))//'ibool1D_leftxi_lefteta.txt',status='old',action='read')
- else if(icorners == 2) then
-! read ibool1D_rightxi_lefteta of other slice
- write(*,*) 'reading MPI 1D buffer ibool1D_rightxi_lefteta slice ',iotherproc
- open(unit=34,file=prname_other(1:len_trim(prname_other))//'ibool1D_rightxi_lefteta.txt',status='old',action='read')
- else
- stop 'incorrect corner number'
- endif
-
- npoin1D = 1
- 450 continue
- read(34,*) iboolleft(npoin1D),xleft(npoin1D),yleft(npoin1D),zleft(npoin1D)
- if(iboolleft(npoin1D) > 0) then
- npoin1D = npoin1D + 1
- goto 450
- endif
- npoin1D = npoin1D - 1
- write(*,*) 'found ',npoin1D,' points in iboolleft slice ',iotherproc
- read(34,*) npoin1D_mesher
-
- if(icorners == 1) then
- if(npoin1D /= NGLOB1D_RADIAL_SPEC_OTHER(1)) stop 'incorrect iboolleft read'
- else
- if(npoin1D /= NGLOB1D_RADIAL_SPEC_OTHER(2)) stop 'incorrect iboolleft read'
- endif
- close(34)
-
-! check the coordinates of all the points in the buffer
-! to see if it is correctly sorted
- do ipoin = 1,npoin1D
- diff = dmax1(dabs(xleft(ipoin)-xright(ipoin)), &
- dabs(yleft(ipoin)-yright(ipoin)),dabs(zleft(ipoin)-zright(ipoin)))
- if(diff > 0.0000001d0) then
- print *,'different: ',ipoin,iboolleft(ipoin),iboolright(ipoin),diff
- stop 'error: different'
- endif
- enddo
-
- enddo
- enddo
- enddo
-
- enddo
-
-! deallocate arrays
- deallocate(iboolleft)
- deallocate(iboolright)
- deallocate(xleft)
- deallocate(yleft)
- deallocate(zleft)
- deallocate(xright)
- deallocate(yright)
- deallocate(zright)
-
- enddo
-
- print *
- print *,'done'
- print *
-
- end program check_buffers_1D
-
Deleted: seismo/3D/SPECFEM3D_GLOBE/trunk/src/auxiliaries/check_buffers_2D.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/src/auxiliaries/check_buffers_2D.f90 2013-09-26 15:31:37 UTC (rev 22857)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/src/auxiliaries/check_buffers_2D.f90 2013-09-26 16:03:46 UTC (rev 22858)
@@ -1,320 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D G l o b e V e r s i o n 6 . 0
-! --------------------------------------------------
-!
-! Main authors: Dimitri Komatitsch and Jeroen Tromp
-! Princeton University, USA
-! and CNRS / INRIA / University of Pau, France
-! (c) Princeton University and CNRS / INRIA / University of Pau
-! August 2013
-!
-! This program is free software; you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation; either version 2 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along
-! with this program; if not, write to the Free Software Foundation, Inc.,
-! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-!
-!=====================================================================
-
-! code to check that all the internal MPI buffers are okay
-! inside any given chunk, along both xi and eta
-! we compare the coordinates of the points in the buffers
-
- program check_buffers_2D
-
- use constants
- use shared_parameters
-
- implicit none
-
- integer ithisproc,iotherproc
-
- integer ipoin
-
- integer npoin2d_xi_save,npoin2d_xi_mesher,npoin2d_xi
- integer npoin2d_eta_save,npoin2d_eta_mesher,npoin2d_eta
-
-! for addressing of the slices
- integer ichunk,iproc_xi,iproc_eta,iproc
- integer iproc_read,iregion_code
- integer, dimension(:,:,:), allocatable :: addressing
-
- double precision diff
-
-! 2-D addressing and buffers for summation between slices
- integer, dimension(:), allocatable :: iboolleft_xi,iboolright_xi, &
- iboolleft_eta,iboolright_eta
-
-! coordinates of the points to compare
- double precision, dimension(:), allocatable :: xleft_xi,yleft_xi,zleft_xi, &
- xright_xi,yright_xi,zright_xi,xleft_eta,yleft_eta,zleft_eta, &
- xright_eta,yright_eta,zright_eta
-
-! processor identification
- character(len=150) prname,prname_other
-
-! ************** PROGRAM STARTS HERE **************
-
- print *
- print *,'Check all MPI buffers along xi and eta inside each chunk'
- print *
-
-! read the parameter file and compute additional parameters
- call read_compute_parameters()
-
-! get the base pathname for output files
- call get_value_string(OUTPUT_FILES, 'OUTPUT_FILES', 'OUTPUT_FILES')
-
- print *
- print *,'There are ',NPROCTOT,' slices numbered from 0 to ',NPROCTOT-1
- print *,'There are ',NCHUNKS,' chunks'
- print *,'There are ',NPROC_XI,' slices along xi in each chunk'
- print *,'There are ',NPROC_ETA,' slices along eta in each chunk'
- print *
-
-! dynamic memory allocation for arrays
- allocate(addressing(NCHUNKS,0:NPROC_XI-1,0:NPROC_ETA-1))
-
-! open file with global slice number addressing
- print *,'reading slice addressing'
- open(unit=34,file=trim(OUTPUT_FILES)//'/addressing.txt',status='old',action='read')
- do iproc = 0,NPROCTOT-1
- read(34,*) iproc_read,ichunk,iproc_xi,iproc_eta
- if(iproc_read /= iproc) stop 'incorrect slice number read'
- addressing(ichunk,iproc_xi,iproc_eta) = iproc
- enddo
- close(34)
-
-! loop over all the regions of the mesh
- do iregion_code = 1,MAX_NUM_REGIONS
-
- print *
- print *,' ********* checking region ',iregion_code,' *********'
- print *
-
-! dynamic memory allocation for arrays
- allocate(iboolleft_xi(NGLOB2DMAX_XMIN_XMAX(iregion_code)))
- allocate(iboolright_xi(NGLOB2DMAX_XMIN_XMAX(iregion_code)))
- allocate(iboolleft_eta(NGLOB2DMAX_YMIN_YMAX(iregion_code)))
- allocate(iboolright_eta(NGLOB2DMAX_YMIN_YMAX(iregion_code)))
- allocate(xleft_xi(NGLOB2DMAX_XMIN_XMAX(iregion_code)))
- allocate(yleft_xi(NGLOB2DMAX_XMIN_XMAX(iregion_code)))
- allocate(zleft_xi(NGLOB2DMAX_XMIN_XMAX(iregion_code)))
- allocate(xright_xi(NGLOB2DMAX_XMIN_XMAX(iregion_code)))
- allocate(yright_xi(NGLOB2DMAX_XMIN_XMAX(iregion_code)))
- allocate(zright_xi(NGLOB2DMAX_XMIN_XMAX(iregion_code)))
- allocate(xleft_eta(NGLOB2DMAX_YMIN_YMAX(iregion_code)))
- allocate(yleft_eta(NGLOB2DMAX_YMIN_YMAX(iregion_code)))
- allocate(zleft_eta(NGLOB2DMAX_YMIN_YMAX(iregion_code)))
- allocate(xright_eta(NGLOB2DMAX_YMIN_YMAX(iregion_code)))
- allocate(yright_eta(NGLOB2DMAX_YMIN_YMAX(iregion_code)))
- allocate(zright_eta(NGLOB2DMAX_YMIN_YMAX(iregion_code)))
-
-! loop on the chunks
- do ichunk = 1,NCHUNKS
-
- print *
- print *,'Checking xi in chunk ',ichunk
- print *
-
-! double loop on NPROC_XI and NPROC_ETA
- do iproc_eta=0,NPROC_ETA-1
-
- print *,'checking row ',iproc_eta
-
- do iproc_xi=0,NPROC_XI-2
-
- print *,'checking slice ixi = ',iproc_xi,' in that row'
-
- ithisproc = addressing(ichunk,iproc_xi,iproc_eta)
- iotherproc = addressing(ichunk,iproc_xi+1,iproc_eta)
-
-! create the name for the database of the current slide
- call create_serial_name_database(prname,ithisproc,iregion_code, &
- LOCAL_PATH,NPROCTOT,OUTPUT_FILES)
- call create_serial_name_database(prname_other,iotherproc,iregion_code, &
- LOCAL_PATH,NPROCTOT,OUTPUT_FILES)
-
-! read 2-D addressing for summation between slices along xi with MPI
-
-! read iboolright_xi of this slice
- write(*,*) 'reading MPI buffer iboolright_xi slice ',ithisproc
- open(unit=34,file=prname(1:len_trim(prname))//'iboolright_xi.txt',status='old',action='read')
- npoin2D_xi = 1
- 360 continue
- read(34,*) iboolright_xi(npoin2D_xi), &
- xright_xi(npoin2D_xi),yright_xi(npoin2D_xi),zright_xi(npoin2D_xi)
- if(iboolright_xi(npoin2D_xi) > 0) then
- npoin2D_xi = npoin2D_xi + 1
- goto 360
- endif
- npoin2D_xi = npoin2D_xi - 1
- write(*,*) 'found ',npoin2D_xi,' points in iboolright_xi slice ',ithisproc
- read(34,*) npoin2D_xi_mesher
- if(npoin2D_xi > NGLOB2DMAX_XMIN_XMAX(iregion_code) .or. npoin2D_xi /= npoin2D_xi_mesher) then
- stop 'incorrect iboolright_xi read'
- endif
- close(34)
-
-! save to compare to other side
- npoin2D_xi_save = npoin2D_xi
-
-! read iboolleft_xi of other slice
- write(*,*) 'reading MPI buffer iboolleft_xi slice ',iotherproc
- open(unit=34,file=prname_other(1:len_trim(prname_other))//'iboolleft_xi.txt',status='old',action='read')
- npoin2D_xi = 1
- 350 continue
- read(34,*) iboolleft_xi(npoin2D_xi), &
- xleft_xi(npoin2D_xi),yleft_xi(npoin2D_xi),zleft_xi(npoin2D_xi)
- if(iboolleft_xi(npoin2D_xi) > 0) then
- npoin2D_xi = npoin2D_xi + 1
- goto 350
- endif
- npoin2D_xi = npoin2D_xi - 1
- write(*,*) 'found ',npoin2D_xi,' points in iboolleft_xi slice ',iotherproc
- read(34,*) npoin2D_xi_mesher
- if(npoin2D_xi > NGLOB2DMAX_XMIN_XMAX(iregion_code) .or. npoin2D_xi /= npoin2D_xi_mesher) then
- stop 'incorrect iboolleft_xi read'
- endif
- close(34)
-
- if(npoin2D_xi_save == npoin2D_xi) then
- print *,'okay, same size for both buffers'
- else
- stop 'wrong buffer size'
- endif
-
-! check the coordinates of all the points in the buffer
-! to see if it is correctly sorted
- do ipoin = 1,npoin2D_xi
- diff = dmax1(dabs(xleft_xi(ipoin)-xright_xi(ipoin)), &
- dabs(yleft_xi(ipoin)-yright_xi(ipoin)),dabs(zleft_xi(ipoin)-zright_xi(ipoin)))
- if(diff > 0.0000001d0) print *,'different: ',ipoin,iboolleft_xi(ipoin),iboolright_xi(ipoin),diff
- enddo
-
- enddo
- enddo
- enddo
-
-
-! loop on the chunks
- do ichunk = 1,NCHUNKS
-
- print *
- print *,'Checking eta in chunk ',ichunk
- print *
-
-! double loop on NPROC_XI and NPROC_ETA
- do iproc_xi=0,NPROC_XI-1
-
- print *,'checking row ',iproc_xi
-
- do iproc_eta=0,NPROC_ETA-2
-
- print *,'checking slice ieta = ',iproc_eta,' in that row'
-
- ithisproc = addressing(ichunk,iproc_xi,iproc_eta)
- iotherproc = addressing(ichunk,iproc_xi,iproc_eta+1)
-
-! create the name for the database of the current slide
- call create_serial_name_database(prname,ithisproc,iregion_code, &
- LOCAL_PATH,NPROCTOT,OUTPUT_FILES)
- call create_serial_name_database(prname_other,iotherproc,iregion_code, &
- LOCAL_PATH,NPROCTOT,OUTPUT_FILES)
-
-! read 2-D addressing for summation between slices along xi with MPI
-
-! read iboolright_eta of this slice
- write(*,*) 'reading MPI buffer iboolright_eta slice ',ithisproc
- open(unit=34,file=prname(1:len_trim(prname))//'iboolright_eta.txt',status='old',action='read')
- npoin2D_eta = 1
- 460 continue
- read(34,*) iboolright_eta(npoin2D_eta), &
- xright_eta(npoin2D_eta),yright_eta(npoin2D_eta),zright_eta(npoin2D_eta)
- if(iboolright_eta(npoin2D_eta) > 0) then
- npoin2D_eta = npoin2D_eta + 1
- goto 460
- endif
- npoin2D_eta = npoin2D_eta - 1
- write(*,*) 'found ',npoin2D_eta,' points in iboolright_eta slice ',ithisproc
- read(34,*) npoin2D_eta_mesher
- if(npoin2D_eta > NGLOB2DMAX_YMIN_YMAX(iregion_code) .or. npoin2D_eta /= npoin2D_eta_mesher) then
- stop 'incorrect iboolright_eta read'
- endif
- close(34)
-
-! save to compare to other side
- npoin2D_eta_save = npoin2D_eta
-
-! read iboolleft_eta of other slice
- write(*,*) 'reading MPI buffer iboolleft_eta slice ',iotherproc
- open(unit=34,file=prname_other(1:len_trim(prname_other))//'iboolleft_eta.txt',status='old',action='read')
- npoin2D_eta = 1
- 450 continue
- read(34,*) iboolleft_eta(npoin2D_eta), &
- xleft_eta(npoin2D_eta),yleft_eta(npoin2D_eta),zleft_eta(npoin2D_eta)
- if(iboolleft_eta(npoin2D_eta) > 0) then
- npoin2D_eta = npoin2D_eta + 1
- goto 450
- endif
- npoin2D_eta = npoin2D_eta - 1
- write(*,*) 'found ',npoin2D_eta,' points in iboolleft_eta slice ',iotherproc
- read(34,*) npoin2D_eta_mesher
- if(npoin2D_eta > NGLOB2DMAX_YMIN_YMAX(iregion_code) .or. npoin2D_eta /= npoin2D_eta_mesher) then
- stop 'incorrect iboolleft_eta read'
- endif
- close(34)
-
- if(npoin2D_eta_save == npoin2D_eta) then
- print *,'okay, same size for both buffers'
- else
- stop 'wrong buffer size'
- endif
-
-! check the coordinates of all the points in the buffer
-! to see if it is correctly sorted
- do ipoin = 1,npoin2D_eta
- diff = dmax1(dabs(xleft_eta(ipoin)-xright_eta(ipoin)), &
- dabs(yleft_eta(ipoin)-yright_eta(ipoin)),dabs(zleft_eta(ipoin)-zright_eta(ipoin)))
- if(diff > 0.0000001d0) print *,'different: ',ipoin,iboolleft_eta(ipoin),iboolright_eta(ipoin),diff
- enddo
-
- enddo
- enddo
- enddo
-
-! deallocate arrays
- deallocate(iboolleft_xi)
- deallocate(iboolright_xi)
- deallocate(iboolleft_eta)
- deallocate(iboolright_eta)
- deallocate(xleft_xi)
- deallocate(yleft_xi)
- deallocate(zleft_xi)
- deallocate(xright_xi)
- deallocate(yright_xi)
- deallocate(zright_xi)
- deallocate(xleft_eta)
- deallocate(yleft_eta)
- deallocate(zleft_eta)
- deallocate(xright_eta)
- deallocate(yright_eta)
- deallocate(zright_eta)
-
- enddo
-
- print *
- print *,'done'
- print *
-
- end program check_buffers_2D
-
Deleted: seismo/3D/SPECFEM3D_GLOBE/trunk/src/auxiliaries/check_buffers_corners_chunks.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/src/auxiliaries/check_buffers_corners_chunks.f90 2013-09-26 15:31:37 UTC (rev 22857)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/src/auxiliaries/check_buffers_corners_chunks.f90 2013-09-26 16:03:46 UTC (rev 22858)
@@ -1,212 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D G l o b e V e r s i o n 6 . 0
-! --------------------------------------------------
-!
-! Main authors: Dimitri Komatitsch and Jeroen Tromp
-! Princeton University, USA
-! and CNRS / INRIA / University of Pau, France
-! (c) Princeton University and CNRS / INRIA / University of Pau
-! August 2013
-!
-! This program is free software; you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation; either version 2 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along
-! with this program; if not, write to the Free Software Foundation, Inc.,
-! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-!
-!=====================================================================
-
-! code to check that all the 1D buffers between chunk corners are okay
-
- program check_buffers_corners_chunks
-
- use constants
- use shared_parameters
-
- implicit none
-
- integer imsg
- integer ipoin1D
- integer iboolmaster,iboolworker1,iboolworker2
- integer npoin1D_master,npoin1D_worker1,npoin1D_worker2
- integer iregion_code,iproc
-
-! number of corners between chunks
- integer NCORNERSCHUNKS
-
- double precision xmaster,ymaster,zmaster
- double precision xworker1,yworker1,zworker1
- double precision xworker2,yworker2,zworker2
- double precision diff1,diff2
-
-! communication pattern for corners between chunks
- integer, dimension(:), allocatable :: iproc_master_corners,iproc_worker1_corners,iproc_worker2_corners
-
- character(len=150) filename,prname
-
-! ************** PROGRAM STARTS HERE **************
-
- print *
- print *,'Check all MPI buffers between chunk corners'
- print *
-
-! read the parameter file and compute additional parameters
- call read_compute_parameters()
-
- print *
- print *,'There are ',NPROCTOT,' slices numbered from 0 to ',NPROCTOT-1
- print *,'There are ',NCHUNKS,' chunks'
- print *,'There are ',NPROC_XI,' slices along xi in each chunk'
- print *,'There are ',NPROC_ETA,' slices along eta in each chunk'
- print *
-
-! number of corners shared between chunks
- if(NCHUNKS == 1 .or. NCHUNKS == 2 .or. NCHUNKS == 3) then
- NCORNERSCHUNKS = 1
- else if(NCHUNKS == 6) then
- NCORNERSCHUNKS = 8
- else
- stop 'number of chunks must be either 1, 2, 3 or 6'
- endif
-
- if(NCHUNKS == 1) stop 'only one chunk, nothing to check'
-
- print *,'There are ',NCORNERSCHUNKS,' messages to assemble all the corners'
- print *
-
-! allocate array for messages for corners
- allocate(iproc_master_corners(NCORNERSCHUNKS))
- allocate(iproc_worker1_corners(NCORNERSCHUNKS))
- allocate(iproc_worker2_corners(NCORNERSCHUNKS))
-
-! get the base pathname for output files
- call get_value_string(OUTPUT_FILES, 'OUTPUT_FILES', 'OUTPUT_FILES')
-
-! 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')
- do imsg = 1,NCORNERSCHUNKS
- 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 &
- .or. iproc_master_corners(imsg) > NPROCTOT-1 &
- .or. iproc_worker1_corners(imsg) > NPROCTOT-1 &
- .or. iproc_worker2_corners(imsg) > NPROCTOT-1) &
- stop 'incorrect chunk corner numbering'
- enddo
- close(IIN)
-
-! loop over all the regions of the mesh
- do iregion_code = 1,MAX_NUM_REGIONS
-
- print *
- print *,' ********* checking region ',iregion_code,' *********'
- print *
-
-! loop on all the messages between corners
- do imsg = 1,NCORNERSCHUNKS
-
- print *
- print *,'Checking message ',imsg,' out of ',NCORNERSCHUNKS
-
-! read 1-D buffers for the corners
-
-! master
- write(filename,"('buffer_corners_chunks_master_msg',i6.6,'.txt')") imsg
- iproc = iproc_master_corners(imsg)
- call create_serial_name_database(prname,iproc,iregion_code, &
- LOCAL_PATH,NPROCTOT,OUTPUT_FILES)
- open(unit=34,file=prname(1:len_trim(prname))//filename,status='old',action='read')
-
-! first worker
- write(filename,"('buffer_corners_chunks_worker1_msg',i6.6,'.txt')") imsg
- iproc = iproc_worker1_corners(imsg)
- call create_serial_name_database(prname,iproc,iregion_code, &
- LOCAL_PATH,NPROCTOT,OUTPUT_FILES)
- open(unit=35,file=prname(1:len_trim(prname))//filename,status='old',action='read')
-
-! second worker
-! if only two chunks then there is no second worker
- if(NCHUNKS /= 2) then
- write(filename,"('buffer_corners_chunks_worker2_msg',i6.6,'.txt')") imsg
- iproc = iproc_worker2_corners(imsg)
- call create_serial_name_database(prname,iproc,iregion_code, &
- LOCAL_PATH,NPROCTOT,OUTPUT_FILES)
- open(unit=36,file=prname(1:len_trim(prname))//filename,status='old',action='read')
- endif
-
- write(*,*) 'reading MPI 1D buffers for 3 procs corner'
-
- read(34,*) npoin1D_master
- read(35,*) npoin1D_worker1
-! if only two chunks then there is no second worker
- if(NCHUNKS /= 2) then
- read(36,*) npoin1D_worker2
- else
- npoin1D_worker2 = npoin1D_worker1
- endif
-
- if(npoin1D_master /= NGLOB1D_RADIAL(iregion_code) .or. &
- npoin1D_worker1 /= NGLOB1D_RADIAL(iregion_code) .or. &
- npoin1D_worker2 /= NGLOB1D_RADIAL(iregion_code)) then
- stop 'incorrect total number of points'
- else
- print *,'number of points is correct: ',NGLOB1D_RADIAL(iregion_code)
- endif
-
-! check all the points based upon their coordinates
- do ipoin1D = 1, NGLOB1D_RADIAL(iregion_code)
-
- read(34,*) iboolmaster,xmaster,ymaster,zmaster
- read(35,*) iboolworker1,xworker1,yworker1,zworker1
-! if only two chunks then there is no second worker
- if(NCHUNKS /= 2) read(36,*) iboolworker2,xworker2,yworker2,zworker2
-
- diff1 = dmax1(dabs(xmaster-xworker1),dabs(ymaster-yworker1),dabs(zmaster-zworker1))
- if(diff1 > 0.0000001d0) then
- print *,'different : ',ipoin1D,iboolmaster,iboolworker1,diff1
- print *,'xmaster,xworker1 = ',xmaster,xworker1
- print *,'ymaster,yworker1 = ',ymaster,yworker1
- print *,'zmaster,zworker1 = ',zmaster,zworker1
- stop 'error: different'
- endif
-
-! if only two chunks then there is no second worker
- if(NCHUNKS /= 2) then
- diff2 = dmax1(dabs(xmaster-xworker2),dabs(ymaster-yworker2),dabs(zmaster-zworker2))
- if(diff2 > 0.0000001d0) then
- print *,'different : ',ipoin1D,iboolmaster,iboolworker2,diff2
- print *,'xmaster,xworker2 = ',xmaster,xworker2
- print *,'ymaster,yworker2 = ',ymaster,yworker2
- print *,'zmaster,zworker2 = ',zmaster,zworker2
- stop 'error: different'
- endif
- endif
-
- enddo
-
- close(34)
- close(35)
-! if only two chunks then there is no second worker
- if(NCHUNKS /= 2) close(36)
-
- enddo
-
- enddo
-
- print *
- print *,'done'
- print *
-
- end program check_buffers_corners_chunks
-
Deleted: seismo/3D/SPECFEM3D_GLOBE/trunk/src/auxiliaries/check_buffers_faces_chunks.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/src/auxiliaries/check_buffers_faces_chunks.f90 2013-09-26 15:31:37 UTC (rev 22857)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/src/auxiliaries/check_buffers_faces_chunks.f90 2013-09-26 16:03:46 UTC (rev 22858)
@@ -1,184 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D G l o b e V e r s i o n 6 . 0
-! --------------------------------------------------
-!
-! Main authors: Dimitri Komatitsch and Jeroen Tromp
-! Princeton University, USA
-! and CNRS / INRIA / University of Pau, France
-! (c) Princeton University and CNRS / INRIA / University of Pau
-! August 2013
-!
-! This program is free software; you can redistribute it and/or modify
-! it under the terms of the GNU General Public License as published by
-! the Free Software Foundation; either version 2 of the License, or
-! (at your option) any later version.
-!
-! This program is distributed in the hope that it will be useful,
-! but WITHOUT ANY WARRANTY; without even the implied warranty of
-! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-! GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along
-! with this program; if not, write to the Free Software Foundation, Inc.,
-! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
-!
-!=====================================================================
-
-! code to check that all the 2D buffers between chunk faces are okay
-
- program check_buffers_faces_chunks
-
- use constants
- use shared_parameters
-
- implicit none
-
- integer imsg
-
- integer npoin2D_sender,npoin2D_receiver
- integer iboolsend,iboolreceive,ipoin2D
- integer iregion_code,iproc
-
-! number of faces between chunks
- integer NUM_FACES,NUMMSGS_FACES
-
-! number of message types
- integer NUM_MSG_TYPES
-
- double precision xsend,ysend,zsend
- double precision xreceive,yreceive,zreceive
- double precision diff
-
- integer NPROC_ONE_DIRECTION
-
-! communication pattern for faces between chunks
- integer, dimension(:), allocatable :: iprocfrom_faces,iprocto_faces,imsg_type
-
- character(len=150) filename,prname
-
-! ************** PROGRAM STARTS HERE **************
-
- print *
- print *,'Check all MPI buffers between chunk faces'
- print *
-
-! read the parameter file and compute additional parameters
- call read_compute_parameters()
-
-! get the base pathname for output files
- call get_value_string(OUTPUT_FILES, 'OUTPUT_FILES', 'OUTPUT_FILES')
-
- print *
- print *,'There are ',NPROCTOT,' slices numbered from 0 to ',NPROCTOT-1
- print *,'There are ',NCHUNKS,' chunks'
- print *,'There are ',NPROC_XI,' slices along xi in each chunk'
- print *,'There are ',NPROC_ETA,' slices along eta in each chunk'
- print *
-
-! number of corners and faces shared between chunks and number of message types
- if(NCHUNKS == 1 .or. NCHUNKS == 2) then
- NUM_FACES = 1
- NUM_MSG_TYPES = 1
- else if(NCHUNKS == 3) then
- NUM_FACES = 1
- NUM_MSG_TYPES = 3
- else if(NCHUNKS == 6) then
- NUM_FACES = 4
- NUM_MSG_TYPES = 3
- else
- stop 'number of chunks must be either 1, 2, 3 or 6'
- endif
-
-! if more than one chunk then same number of processors in each direction
- NPROC_ONE_DIRECTION = NPROC_XI
-
-! total number of messages corresponding to these common faces
- NUMMSGS_FACES = NPROC_ONE_DIRECTION*NUM_FACES*NUM_MSG_TYPES
-
- if(NCHUNKS == 1) stop 'only one chunk, nothing to check'
-
- print *,'There are ',NUMMSGS_FACES,' messages to assemble all the faces'
- print *
-
-! allocate array for messages for faces
- allocate(iprocfrom_faces(NUMMSGS_FACES))
- allocate(iprocto_faces(NUMMSGS_FACES))
- allocate(imsg_type(NUMMSGS_FACES))
-
-! 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')
- do imsg = 1,NUMMSGS_FACES
- 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 &
- .or. iprocto_faces(imsg) > NPROCTOT-1) &
- stop 'incorrect chunk faces numbering'
- if (imsg_type(imsg) < 1 .or. imsg_type(imsg) > 3) &
- stop 'incorrect message type labeling'
- enddo
- close(IIN)
-
-! loop over all the regions of the mesh
- do iregion_code = 1,MAX_NUM_REGIONS
-
- print *
- print *,' ********* checking region ',iregion_code,' *********'
- print *
-
-! loop on all the messages between faces
- do imsg = 1,NUMMSGS_FACES
-
- print *
- print *,'Checking message ',imsg,' out of ',NUMMSGS_FACES
-
-! read 2-D buffer for the sender and the receiver
- write(filename,"('buffer_faces_chunks_sender_msg',i6.6,'.txt')") imsg
- iproc = iprocfrom_faces(imsg)
- call create_serial_name_database(prname,iproc,iregion_code, &
- LOCAL_PATH,NPROCTOT,OUTPUT_FILES)
- open(unit=34,file=prname(1:len_trim(prname))//filename,status='old',action='read')
-
- write(filename,"('buffer_faces_chunks_receiver_msg',i6.6,'.txt')") imsg
- iproc = iprocto_faces(imsg)
- call create_serial_name_database(prname,iproc,iregion_code, &
- LOCAL_PATH,NPROCTOT,OUTPUT_FILES)
- open(unit=35,file=prname(1:len_trim(prname))//filename,status='old',action='read')
-
- write(*,*) 'reading MPI 2D buffer for sender'
- read(34,*) npoin2D_sender
- read(35,*) npoin2D_receiver
-
-! check that number of points is the same in both buffers
- if(npoin2D_sender /= npoin2D_receiver) &
- stop 'different number of points in the two buffers'
-
- print *,'this message contains ',npoin2D_sender,' points'
-
-! check all the points based upon their coordinates
- do ipoin2D = 1,npoin2D_sender
- read(34,*) iboolsend,xsend,ysend,zsend
- read(35,*) iboolreceive,xreceive,yreceive,zreceive
-
- diff = dmax1(dabs(xsend-xreceive),dabs(ysend-yreceive),dabs(zsend-zreceive))
- if(diff > 0.0000001d0) then
- print *,'different : ',ipoin2D,iboolsend,iboolreceive,diff
- print *,'xsend,xreceive = ',xsend,xreceive
- print *,'ysend,yreceive = ',ysend,yreceive
- print *,'zsend,zreceive = ',zsend,zreceive
- stop 'error: different'
- endif
-
- enddo
-
- enddo
-
- enddo
-
- print *
- print *,'done'
- print *
-
- end program check_buffers_faces_chunks
-
Modified: seismo/3D/SPECFEM3D_GLOBE/trunk/src/auxiliaries/rules.mk
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/src/auxiliaries/rules.mk 2013-09-26 15:31:37 UTC (rev 22857)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/src/auxiliaries/rules.mk 2013-09-26 16:03:46 UTC (rev 22858)
@@ -28,10 +28,6 @@
#######################################
auxiliaries_TARGETS = \
- $E/xcheck_buffers_1D \
- $E/xcheck_buffers_2D \
- $E/xcheck_buffers_corners_chunks \
- $E/xcheck_buffers_faces_chunks \
$E/xconvolve_source_timefunction \
$E/xcombine_AVS_DX \
$E/xcombine_paraview_strain_data \
@@ -44,10 +40,6 @@
$(EMPTY_MACRO)
auxiliaries_OBJECTS = \
- $O/check_buffers_1D.aux.o \
- $O/check_buffers_2D.aux.o \
- $O/check_buffers_corners_chunks.aux.o \
- $O/check_buffers_faces_chunks.aux.o \
$O/combine_AVS_DX.aux.o \
$O/combine_paraview_strain_data.auxsolver.o \
$O/combine_surf_data.auxsolver.o \
@@ -90,18 +82,6 @@
aux: required $(auxiliaries_TARGETS)
-${E}/xcheck_buffers_1D: $(auxiliaries_SHARED_OBJECTS) $O/check_buffers_1D.aux.o
- ${FCCOMPILE_CHECK} -o ${E}/xcheck_buffers_1D $(auxiliaries_SHARED_OBJECTS) $O/check_buffers_1D.aux.o
-
-${E}/xcheck_buffers_2D: $(auxiliaries_SHARED_OBJECTS) $O/check_buffers_2D.aux.o
- ${FCCOMPILE_CHECK} -o ${E}/xcheck_buffers_2D $(auxiliaries_SHARED_OBJECTS) $O/check_buffers_2D.aux.o
-
-${E}/xcheck_buffers_corners_chunks: $(auxiliaries_SHARED_OBJECTS) $O/check_buffers_corners_chunks.aux.o
- ${FCCOMPILE_CHECK} -o ${E}/xcheck_buffers_corners_chunks $(auxiliaries_SHARED_OBJECTS) $O/check_buffers_corners_chunks.aux.o
-
-${E}/xcheck_buffers_faces_chunks: $(auxiliaries_SHARED_OBJECTS) $O/check_buffers_faces_chunks.aux.o
- ${FCCOMPILE_CHECK} -o ${E}/xcheck_buffers_faces_chunks $(auxiliaries_SHARED_OBJECTS) $O/check_buffers_faces_chunks.aux.o
-
${E}/xconvolve_source_timefunction: $O/convolve_source_timefunction.aux.o
${FCCOMPILE_CHECK} -o ${E}/xconvolve_source_timefunction $O/convolve_source_timefunction.aux.o
Copied: seismo/3D/SPECFEM3D_GLOBE/trunk/utils/oldstuff/check_buffers_1D.f90 (from rev 22856, seismo/3D/SPECFEM3D_GLOBE/trunk/src/auxiliaries/check_buffers_1D.f90)
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/utils/oldstuff/check_buffers_1D.f90 (rev 0)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/utils/oldstuff/check_buffers_1D.f90 2013-09-26 16:03:46 UTC (rev 22858)
@@ -0,0 +1,501 @@
+!=====================================================================
+!
+! S p e c f e m 3 D G l o b e V e r s i o n 6 . 0
+! --------------------------------------------------
+!
+! Main authors: Dimitri Komatitsch and Jeroen Tromp
+! Princeton University, USA
+! and CNRS / INRIA / University of Pau, France
+! (c) Princeton University and CNRS / INRIA / University of Pau
+! August 2013
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 2 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along
+! with this program; if not, write to the Free Software Foundation, Inc.,
+! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+!
+!=====================================================================
+
+! code to check that all the internal MPI 1D buffers are okay
+! inside any given chunk, along both xi and eta
+! we compare the coordinates of the points in the buffers
+
+ program check_buffers_1D
+
+ use constants
+ use shared_parameters
+
+ implicit none
+
+ integer ithisproc,iotherproc
+ integer ipoin
+
+ double precision diff
+
+ integer npoin1D_mesher,npoin1D
+
+! for addressing of the slices
+ integer ichunk,iproc_xi,iproc_eta,iproc,icorners,iregion_code
+ integer iproc_read
+ integer, dimension(:,:,:), allocatable :: addressing
+
+! 1D addressing for copy of edges between slices
+! we add one to the size of the array for the final flag
+ integer, dimension(:), allocatable :: iboolleft,iboolright
+ double precision, dimension(:), allocatable :: xleft,yleft,zleft,xright,yright,zright
+
+! processor identification
+ character(len=150) prname,prname_other
+
+ integer :: NGLOB1D_RADIAL_MAX
+ integer, dimension(MAX_NUM_REGIONS,NB_SQUARE_CORNERS) :: NGLOB1D_RADIAL_CORNER
+ integer, dimension(NB_SQUARE_CORNERS) :: NGLOB1D_RADIAL_SPEC_THIS
+ integer, dimension(NB_SQUARE_CORNERS) :: NGLOB1D_RADIAL_SPEC_OTHER
+
+! ************** PROGRAM STARTS HERE **************
+
+ print *
+ print *,'Check all MPI buffers along xi and eta inside each chunk'
+ print *
+
+! read the parameter file and compute additional parameters
+ call read_compute_parameters()
+
+! get the base pathname for output files
+ call get_value_string(OUTPUT_FILES, 'OUTPUT_FILES', 'OUTPUT_FILES')
+
+ print *
+ print *,'There are ',NPROCTOT,' slices numbered from 0 to ',NPROCTOT-1
+ print *,'There are ',NCHUNKS,' chunks'
+ print *,'There are ',NPROC_XI,' slices along xi in each chunk'
+ print *,'There are ',NPROC_ETA,' slices along eta in each chunk'
+ print *
+
+! dynamic memory allocation for arrays
+ allocate(addressing(NCHUNKS,0:NPROC_XI-1,0:NPROC_ETA-1))
+
+! open file with global slice number addressing
+ print *,'reading slice addressing'
+ open(unit=34,file=trim(OUTPUT_FILES)//'/addressing.txt',status='old',action='read')
+ do iproc = 0,NPROCTOT-1
+ read(34,*) iproc_read,ichunk,iproc_xi,iproc_eta
+ if(iproc_read /= iproc) stop 'incorrect slice number read'
+ addressing(ichunk,iproc_xi,iproc_eta) = iproc
+ enddo
+ close(34)
+
+! loop over all the regions of the mesh
+ do iregion_code = 1,MAX_NUM_REGIONS
+
+ print *
+ print *,' ********* checking region ',iregion_code,' *********'
+ print *
+
+ NGLOB1D_RADIAL_CORNER(iregion_code,:) = NGLOB1D_RADIAL(iregion_code)
+ NGLOB1D_RADIAL_MAX = NGLOB1D_RADIAL(iregion_code)
+ if (iregion_code == IREGION_OUTER_CORE .and. (CUT_SUPERBRICK_XI .or. CUT_SUPERBRICK_ETA)) then
+ NGLOB1D_RADIAL_MAX = NGLOB1D_RADIAL_MAX + maxval(DIFF_NSPEC1D_RADIAL(:,:))*(NGLLZ-1)
+ endif
+
+! dynamic memory allocation for arrays
+ allocate(iboolleft(NGLOB1D_RADIAL_MAX+1))
+ allocate(iboolright(NGLOB1D_RADIAL_MAX+1))
+ allocate(xleft(NGLOB1D_RADIAL_MAX+1))
+ allocate(yleft(NGLOB1D_RADIAL_MAX+1))
+ allocate(zleft(NGLOB1D_RADIAL_MAX+1))
+ allocate(xright(NGLOB1D_RADIAL_MAX+1))
+ allocate(yright(NGLOB1D_RADIAL_MAX+1))
+ allocate(zright(NGLOB1D_RADIAL_MAX+1))
+
+! ********************************************************
+! *************** check along xi
+! ********************************************************
+
+! loop for both corners for 1D buffers
+ do icorners=1,2
+
+ print *
+ print *,'Checking for xi in set of corners # ',icorners
+ print *
+
+! loop on the chunks
+ do ichunk = 1,NCHUNKS
+
+ print *
+ print *,'Checking xi in chunk ',ichunk
+ print *
+
+! double loop on NPROC_XI and NPROC_ETA
+ do iproc_eta=0,NPROC_ETA-1
+
+ print *,'checking row ',iproc_eta
+
+ do iproc_xi=0,NPROC_XI-2
+
+ print *,'checking slice ixi = ',iproc_xi,' in that row'
+
+ ithisproc = addressing(ichunk,iproc_xi,iproc_eta)
+ iotherproc = addressing(ichunk,iproc_xi+1,iproc_eta)
+
+ NGLOB1D_RADIAL_SPEC_THIS(:) = NGLOB1D_RADIAL_CORNER(iregion_code,:)
+ if (iregion_code==IREGION_OUTER_CORE) then
+ if (CUT_SUPERBRICK_XI) then
+ if (CUT_SUPERBRICK_ETA) then
+ if (mod(iproc_xi,2) == 0) then
+ if (mod(iproc_eta,2) == 0) then
+ NGLOB1D_RADIAL_SPEC_THIS(:) = NGLOB1D_RADIAL_SPEC_THIS(:) + (DIFF_NSPEC1D_RADIAL(:,1)*(NGLLZ-1))
+ else
+ NGLOB1D_RADIAL_SPEC_THIS(:) = NGLOB1D_RADIAL_SPEC_THIS(:) + (DIFF_NSPEC1D_RADIAL(:,2)*(NGLLZ-1))
+ endif
+ else
+ if (mod(iproc_eta,2) == 0) then
+ NGLOB1D_RADIAL_SPEC_THIS(:) = NGLOB1D_RADIAL_SPEC_THIS(:) + (DIFF_NSPEC1D_RADIAL(:,3)*(NGLLZ-1))
+ else
+ NGLOB1D_RADIAL_SPEC_THIS(:) = NGLOB1D_RADIAL_SPEC_THIS(:) + (DIFF_NSPEC1D_RADIAL(:,4)*(NGLLZ-1))
+ endif
+ endif
+ else
+ if (mod(iproc_xi,2) == 0) then
+ NGLOB1D_RADIAL_SPEC_THIS(:) = NGLOB1D_RADIAL_SPEC_THIS(:) + (DIFF_NSPEC1D_RADIAL(:,1)*(NGLLZ-1))
+ else
+ NGLOB1D_RADIAL_SPEC_THIS(:) = NGLOB1D_RADIAL_SPEC_THIS(:) + (DIFF_NSPEC1D_RADIAL(:,2)*(NGLLZ-1))
+ endif
+ endif
+ else
+ if (CUT_SUPERBRICK_ETA) then
+ if (mod(iproc_eta,2) == 0) then
+ NGLOB1D_RADIAL_SPEC_THIS(:) = NGLOB1D_RADIAL_SPEC_THIS(:) + (DIFF_NSPEC1D_RADIAL(:,1)*(NGLLZ-1))
+ else
+ NGLOB1D_RADIAL_SPEC_THIS(:) = NGLOB1D_RADIAL_SPEC_THIS(:) + (DIFF_NSPEC1D_RADIAL(:,2)*(NGLLZ-1))
+ endif
+ endif
+ endif
+ endif
+ NGLOB1D_RADIAL_SPEC_OTHER(:) = NGLOB1D_RADIAL_CORNER(iregion_code,:)
+ if (iregion_code==IREGION_OUTER_CORE) then
+ if (CUT_SUPERBRICK_XI) then
+ if (CUT_SUPERBRICK_ETA) then
+ if (mod(iproc_xi+1,2) == 0) then
+ if (mod(iproc_eta,2) == 0) then
+ NGLOB1D_RADIAL_SPEC_OTHER(:) = NGLOB1D_RADIAL_SPEC_OTHER(:) + (DIFF_NSPEC1D_RADIAL(:,1)*(NGLLZ-1))
+ else
+ NGLOB1D_RADIAL_SPEC_OTHER(:) = NGLOB1D_RADIAL_SPEC_OTHER(:) + (DIFF_NSPEC1D_RADIAL(:,2)*(NGLLZ-1))
+ endif
+ else
+ if (mod(iproc_eta,2) == 0) then
+ NGLOB1D_RADIAL_SPEC_OTHER(:) = NGLOB1D_RADIAL_SPEC_OTHER(:) + (DIFF_NSPEC1D_RADIAL(:,3)*(NGLLZ-1))
+ else
+ NGLOB1D_RADIAL_SPEC_OTHER(:) = NGLOB1D_RADIAL_SPEC_OTHER(:) + (DIFF_NSPEC1D_RADIAL(:,4)*(NGLLZ-1))
+ endif
+ endif
+ else
+ if (mod(iproc_xi+1,2) == 0) then
+ NGLOB1D_RADIAL_SPEC_OTHER(:) = NGLOB1D_RADIAL_SPEC_OTHER(:) + (DIFF_NSPEC1D_RADIAL(:,1)*(NGLLZ-1))
+ else
+ NGLOB1D_RADIAL_SPEC_OTHER(:) = NGLOB1D_RADIAL_SPEC_OTHER(:) + (DIFF_NSPEC1D_RADIAL(:,2)*(NGLLZ-1))
+ endif
+ endif
+ else
+ if (CUT_SUPERBRICK_ETA) then
+ if (mod(iproc_eta,2) == 0) then
+ NGLOB1D_RADIAL_SPEC_OTHER(:) = NGLOB1D_RADIAL_SPEC_OTHER(:) + (DIFF_NSPEC1D_RADIAL(:,1)*(NGLLZ-1))
+ else
+ NGLOB1D_RADIAL_SPEC_OTHER(:) = NGLOB1D_RADIAL_SPEC_OTHER(:) + (DIFF_NSPEC1D_RADIAL(:,2)*(NGLLZ-1))
+ endif
+ endif
+ endif
+ endif
+! create the name for the database of the current slide
+ call create_serial_name_database(prname,ithisproc,iregion_code, &
+ LOCAL_PATH,NPROCTOT,OUTPUT_FILES)
+ call create_serial_name_database(prname_other,iotherproc,iregion_code, &
+ LOCAL_PATH,NPROCTOT,OUTPUT_FILES)
+
+! read 1D addressing buffers for copy between slices along xi with MPI
+
+ if(icorners == 1) then
+! read ibool1D_rightxi_lefteta of this slice
+ write(*,*) 'reading MPI 1D buffer ibool1D_rightxi_lefteta slice ',ithisproc
+ open(unit=34,file=prname(1:len_trim(prname))//'ibool1D_rightxi_lefteta.txt',status='old',action='read')
+ else if(icorners == 2) then
+! read ibool1D_rightxi_righteta of this slice
+ write(*,*) 'reading MPI 1D buffer ibool1D_rightxi_righteta slice ',ithisproc
+ open(unit=34,file=prname(1:len_trim(prname))//'ibool1D_rightxi_righteta.txt',status='old',action='read')
+ else
+ stop 'incorrect corner number'
+ endif
+
+ npoin1D = 1
+ 360 continue
+ read(34,*) iboolright(npoin1D),xright(npoin1D),yright(npoin1D),zright(npoin1D)
+ if(iboolright(npoin1D) > 0) then
+ npoin1D = npoin1D + 1
+ goto 360
+ endif
+ npoin1D = npoin1D - 1
+ write(*,*) 'found ',npoin1D,' points in iboolright slice ',ithisproc
+ read(34,*) npoin1D_mesher
+ if(icorners == 1) then
+ if(npoin1D /= NGLOB1D_RADIAL_SPEC_THIS(2)) stop 'incorrect iboolright read'
+ else
+ if(npoin1D /= NGLOB1D_RADIAL_SPEC_THIS(3)) stop 'incorrect iboolright read'
+ endif
+ close(34)
+
+ if(icorners == 1) then
+! read ibool1D_leftxi_lefteta of other slice
+ write(*,*) 'reading MPI 1D buffer ibool1D_leftxi_lefteta slice ',iotherproc
+ open(unit=34,file=prname_other(1:len_trim(prname_other))//'ibool1D_leftxi_lefteta.txt',status='old',action='read')
+ else if(icorners == 2) then
+! read ibool1D_leftxi_righteta of other slice
+ write(*,*) 'reading MPI 1D buffer ibool1D_leftxi_righteta slice ',iotherproc
+ open(unit=34,file=prname_other(1:len_trim(prname_other))//'ibool1D_leftxi_righteta.txt',status='old',action='read')
+ else
+ stop 'incorrect corner number'
+ endif
+
+ npoin1D = 1
+ 350 continue
+ read(34,*) iboolleft(npoin1D),xleft(npoin1D),yleft(npoin1D),zleft(npoin1D)
+ if(iboolleft(npoin1D) > 0) then
+ npoin1D = npoin1D + 1
+ goto 350
+ endif
+ npoin1D = npoin1D - 1
+ write(*,*) 'found ',npoin1D,' points in iboolleft slice ',iotherproc
+ read(34,*) npoin1D_mesher
+ if(icorners == 1) then
+ if(npoin1D /= NGLOB1D_RADIAL_SPEC_OTHER(1)) stop 'incorrect iboolleft read'
+ else
+ if(npoin1D /= NGLOB1D_RADIAL_SPEC_OTHER(4)) stop 'incorrect iboolleft read'
+ endif
+ close(34)
+
+! check the coordinates of all the points in the buffer
+! to see if it is correctly sorted
+ do ipoin = 1,npoin1D
+ diff = dmax1(dabs(xleft(ipoin)-xright(ipoin)), &
+ dabs(yleft(ipoin)-yright(ipoin)),dabs(zleft(ipoin)-zright(ipoin)))
+ if(diff > 0.0000001d0) then
+ print *,'different: ',ipoin,iboolleft(ipoin),iboolright(ipoin),diff
+ stop 'error: different'
+ endif
+ enddo
+
+ enddo
+ enddo
+ enddo
+
+ enddo
+
+
+! ********************************************************
+! *************** check along eta
+! ********************************************************
+
+! added loop for both corners for 1D buffers
+ do icorners=1,2
+
+ print *
+ print *,'Checking for eta in set of corners # ',icorners
+ print *
+
+! loop on the chunks
+ do ichunk = 1,NCHUNKS
+
+ print *
+ print *,'Checking eta in chunk ',ichunk
+ print *
+
+! double loop on NPROC_XI and NPROC_ETA
+ do iproc_xi=0,NPROC_XI-1
+
+ print *,'checking row ',iproc_xi
+
+ do iproc_eta=0,NPROC_ETA-2
+
+ print *,'checking slice ieta = ',iproc_eta,' in that row'
+
+ ithisproc = addressing(ichunk,iproc_xi,iproc_eta)
+ iotherproc = addressing(ichunk,iproc_xi,iproc_eta+1)
+
+ NGLOB1D_RADIAL_SPEC_THIS(:) = NGLOB1D_RADIAL_CORNER(iregion_code,:)
+ if (iregion_code==IREGION_OUTER_CORE) then
+ if (CUT_SUPERBRICK_XI) then
+ if (CUT_SUPERBRICK_ETA) then
+ if (mod(iproc_xi,2) == 0) then
+ if (mod(iproc_eta,2) == 0) then
+ NGLOB1D_RADIAL_SPEC_THIS(:) = NGLOB1D_RADIAL_SPEC_THIS(:) + (DIFF_NSPEC1D_RADIAL(:,1)*(NGLLZ-1))
+ else
+ NGLOB1D_RADIAL_SPEC_THIS(:) = NGLOB1D_RADIAL_SPEC_THIS(:) + (DIFF_NSPEC1D_RADIAL(:,2)*(NGLLZ-1))
+ endif
+ else
+ if (mod(iproc_eta,2) == 0) then
+ NGLOB1D_RADIAL_SPEC_THIS(:) = NGLOB1D_RADIAL_SPEC_THIS(:) + (DIFF_NSPEC1D_RADIAL(:,3)*(NGLLZ-1))
+ else
+ NGLOB1D_RADIAL_SPEC_THIS(:) = NGLOB1D_RADIAL_SPEC_THIS(:) + (DIFF_NSPEC1D_RADIAL(:,4)*(NGLLZ-1))
+ endif
+ endif
+ else
+ if (mod(iproc_xi,2) == 0) then
+ NGLOB1D_RADIAL_SPEC_THIS(:) = NGLOB1D_RADIAL_SPEC_THIS(:) + (DIFF_NSPEC1D_RADIAL(:,1)*(NGLLZ-1))
+ else
+ NGLOB1D_RADIAL_SPEC_THIS(:) = NGLOB1D_RADIAL_SPEC_THIS(:) + (DIFF_NSPEC1D_RADIAL(:,2)*(NGLLZ-1))
+ endif
+ endif
+ else
+ if (CUT_SUPERBRICK_ETA) then
+ if (mod(iproc_eta,2) == 0) then
+ NGLOB1D_RADIAL_SPEC_THIS(:) = NGLOB1D_RADIAL_SPEC_THIS(:) + (DIFF_NSPEC1D_RADIAL(:,1)*(NGLLZ-1))
+ else
+ NGLOB1D_RADIAL_SPEC_THIS(:) = NGLOB1D_RADIAL_SPEC_THIS(:) + (DIFF_NSPEC1D_RADIAL(:,2)*(NGLLZ-1))
+ endif
+ endif
+ endif
+ endif
+ NGLOB1D_RADIAL_SPEC_OTHER(:) = NGLOB1D_RADIAL_CORNER(iregion_code,:)
+ if (iregion_code==IREGION_OUTER_CORE) then
+ if (CUT_SUPERBRICK_XI) then
+ if (CUT_SUPERBRICK_ETA) then
+ if (mod(iproc_xi,2) == 0) then
+ if (mod(iproc_eta+1,2) == 0) then
+ NGLOB1D_RADIAL_SPEC_OTHER(:) = NGLOB1D_RADIAL_SPEC_OTHER(:) + (DIFF_NSPEC1D_RADIAL(:,1)*(NGLLZ-1))
+ else
+ NGLOB1D_RADIAL_SPEC_OTHER(:) = NGLOB1D_RADIAL_SPEC_OTHER(:) + (DIFF_NSPEC1D_RADIAL(:,2)*(NGLLZ-1))
+ endif
+ else
+ if (mod(iproc_eta+1,2) == 0) then
+ NGLOB1D_RADIAL_SPEC_OTHER(:) = NGLOB1D_RADIAL_SPEC_OTHER(:) + (DIFF_NSPEC1D_RADIAL(:,3)*(NGLLZ-1))
+ else
+ NGLOB1D_RADIAL_SPEC_OTHER(:) = NGLOB1D_RADIAL_SPEC_OTHER(:) + (DIFF_NSPEC1D_RADIAL(:,4)*(NGLLZ-1))
+ endif
+ endif
+ else
+ if (mod(iproc_xi,2) == 0) then
+ NGLOB1D_RADIAL_SPEC_OTHER(:) = NGLOB1D_RADIAL_SPEC_OTHER(:) + (DIFF_NSPEC1D_RADIAL(:,1)*(NGLLZ-1))
+ else
+ NGLOB1D_RADIAL_SPEC_OTHER(:) = NGLOB1D_RADIAL_SPEC_OTHER(:) + (DIFF_NSPEC1D_RADIAL(:,2)*(NGLLZ-1))
+ endif
+ endif
+ else
+ if (CUT_SUPERBRICK_ETA) then
+ if (mod(iproc_eta+1,2) == 0) then
+ NGLOB1D_RADIAL_SPEC_OTHER(:) = NGLOB1D_RADIAL_SPEC_OTHER(:) + (DIFF_NSPEC1D_RADIAL(:,1)*(NGLLZ-1))
+ else
+ NGLOB1D_RADIAL_SPEC_OTHER(:) = NGLOB1D_RADIAL_SPEC_OTHER(:) + (DIFF_NSPEC1D_RADIAL(:,2)*(NGLLZ-1))
+ endif
+ endif
+ endif
+ endif
+! create the name for the database of the current slide
+ call create_serial_name_database(prname,ithisproc,iregion_code, &
+ LOCAL_PATH,NPROCTOT,OUTPUT_FILES)
+ call create_serial_name_database(prname_other,iotherproc,iregion_code, &
+ LOCAL_PATH,NPROCTOT,OUTPUT_FILES)
+
+! read 1D addressing buffers for copy between slices along xi with MPI
+
+ if(icorners == 1) then
+! read ibool1D_leftxi_righteta of this slice
+ write(*,*) 'reading MPI 1D buffer ibool1D_leftxi_righteta slice ',ithisproc
+ open(unit=34,file=prname(1:len_trim(prname))//'ibool1D_leftxi_righteta.txt',status='old',action='read')
+ else if(icorners == 2) then
+! read ibool1D_rightxi_righteta of this slice
+ write(*,*) 'reading MPI 1D buffer ibool1D_rightxi_righteta slice ',ithisproc
+ open(unit=34,file=prname(1:len_trim(prname))//'ibool1D_rightxi_righteta.txt',status='old',action='read')
+ else
+ stop 'incorrect corner number'
+ endif
+
+ npoin1D = 1
+ 460 continue
+ read(34,*) iboolright(npoin1D),xright(npoin1D),yright(npoin1D),zright(npoin1D)
+ if(iboolright(npoin1D) > 0) then
+ npoin1D = npoin1D + 1
+ goto 460
+ endif
+ npoin1D = npoin1D - 1
+ write(*,*) 'found ',npoin1D,' points in iboolright slice ',ithisproc
+ read(34,*) npoin1D_mesher
+
+ if(icorners == 1) then
+ if(npoin1D /= NGLOB1D_RADIAL_SPEC_THIS(4)) stop 'incorrect iboolright read'
+ else
+ if(npoin1D /= NGLOB1D_RADIAL_SPEC_THIS(3)) stop 'incorrect iboolright read'
+ endif
+ close(34)
+
+ if(icorners == 1) then
+! read ibool1D_leftxi_lefteta of other slice
+ write(*,*) 'reading MPI 1D buffer ibool1D_leftxi_lefteta slice ',iotherproc
+ open(unit=34,file=prname_other(1:len_trim(prname_other))//'ibool1D_leftxi_lefteta.txt',status='old',action='read')
+ else if(icorners == 2) then
+! read ibool1D_rightxi_lefteta of other slice
+ write(*,*) 'reading MPI 1D buffer ibool1D_rightxi_lefteta slice ',iotherproc
+ open(unit=34,file=prname_other(1:len_trim(prname_other))//'ibool1D_rightxi_lefteta.txt',status='old',action='read')
+ else
+ stop 'incorrect corner number'
+ endif
+
+ npoin1D = 1
+ 450 continue
+ read(34,*) iboolleft(npoin1D),xleft(npoin1D),yleft(npoin1D),zleft(npoin1D)
+ if(iboolleft(npoin1D) > 0) then
+ npoin1D = npoin1D + 1
+ goto 450
+ endif
+ npoin1D = npoin1D - 1
+ write(*,*) 'found ',npoin1D,' points in iboolleft slice ',iotherproc
+ read(34,*) npoin1D_mesher
+
+ if(icorners == 1) then
+ if(npoin1D /= NGLOB1D_RADIAL_SPEC_OTHER(1)) stop 'incorrect iboolleft read'
+ else
+ if(npoin1D /= NGLOB1D_RADIAL_SPEC_OTHER(2)) stop 'incorrect iboolleft read'
+ endif
+ close(34)
+
+! check the coordinates of all the points in the buffer
+! to see if it is correctly sorted
+ do ipoin = 1,npoin1D
+ diff = dmax1(dabs(xleft(ipoin)-xright(ipoin)), &
+ dabs(yleft(ipoin)-yright(ipoin)),dabs(zleft(ipoin)-zright(ipoin)))
+ if(diff > 0.0000001d0) then
+ print *,'different: ',ipoin,iboolleft(ipoin),iboolright(ipoin),diff
+ stop 'error: different'
+ endif
+ enddo
+
+ enddo
+ enddo
+ enddo
+
+ enddo
+
+! deallocate arrays
+ deallocate(iboolleft)
+ deallocate(iboolright)
+ deallocate(xleft)
+ deallocate(yleft)
+ deallocate(zleft)
+ deallocate(xright)
+ deallocate(yright)
+ deallocate(zright)
+
+ enddo
+
+ print *
+ print *,'done'
+ print *
+
+ end program check_buffers_1D
+
Copied: seismo/3D/SPECFEM3D_GLOBE/trunk/utils/oldstuff/check_buffers_2D.f90 (from rev 22856, seismo/3D/SPECFEM3D_GLOBE/trunk/src/auxiliaries/check_buffers_2D.f90)
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/utils/oldstuff/check_buffers_2D.f90 (rev 0)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/utils/oldstuff/check_buffers_2D.f90 2013-09-26 16:03:46 UTC (rev 22858)
@@ -0,0 +1,320 @@
+!=====================================================================
+!
+! S p e c f e m 3 D G l o b e V e r s i o n 6 . 0
+! --------------------------------------------------
+!
+! Main authors: Dimitri Komatitsch and Jeroen Tromp
+! Princeton University, USA
+! and CNRS / INRIA / University of Pau, France
+! (c) Princeton University and CNRS / INRIA / University of Pau
+! August 2013
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 2 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along
+! with this program; if not, write to the Free Software Foundation, Inc.,
+! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+!
+!=====================================================================
+
+! code to check that all the internal MPI buffers are okay
+! inside any given chunk, along both xi and eta
+! we compare the coordinates of the points in the buffers
+
+ program check_buffers_2D
+
+ use constants
+ use shared_parameters
+
+ implicit none
+
+ integer ithisproc,iotherproc
+
+ integer ipoin
+
+ integer npoin2d_xi_save,npoin2d_xi_mesher,npoin2d_xi
+ integer npoin2d_eta_save,npoin2d_eta_mesher,npoin2d_eta
+
+! for addressing of the slices
+ integer ichunk,iproc_xi,iproc_eta,iproc
+ integer iproc_read,iregion_code
+ integer, dimension(:,:,:), allocatable :: addressing
+
+ double precision diff
+
+! 2-D addressing and buffers for summation between slices
+ integer, dimension(:), allocatable :: iboolleft_xi,iboolright_xi, &
+ iboolleft_eta,iboolright_eta
+
+! coordinates of the points to compare
+ double precision, dimension(:), allocatable :: xleft_xi,yleft_xi,zleft_xi, &
+ xright_xi,yright_xi,zright_xi,xleft_eta,yleft_eta,zleft_eta, &
+ xright_eta,yright_eta,zright_eta
+
+! processor identification
+ character(len=150) prname,prname_other
+
+! ************** PROGRAM STARTS HERE **************
+
+ print *
+ print *,'Check all MPI buffers along xi and eta inside each chunk'
+ print *
+
+! read the parameter file and compute additional parameters
+ call read_compute_parameters()
+
+! get the base pathname for output files
+ call get_value_string(OUTPUT_FILES, 'OUTPUT_FILES', 'OUTPUT_FILES')
+
+ print *
+ print *,'There are ',NPROCTOT,' slices numbered from 0 to ',NPROCTOT-1
+ print *,'There are ',NCHUNKS,' chunks'
+ print *,'There are ',NPROC_XI,' slices along xi in each chunk'
+ print *,'There are ',NPROC_ETA,' slices along eta in each chunk'
+ print *
+
+! dynamic memory allocation for arrays
+ allocate(addressing(NCHUNKS,0:NPROC_XI-1,0:NPROC_ETA-1))
+
+! open file with global slice number addressing
+ print *,'reading slice addressing'
+ open(unit=34,file=trim(OUTPUT_FILES)//'/addressing.txt',status='old',action='read')
+ do iproc = 0,NPROCTOT-1
+ read(34,*) iproc_read,ichunk,iproc_xi,iproc_eta
+ if(iproc_read /= iproc) stop 'incorrect slice number read'
+ addressing(ichunk,iproc_xi,iproc_eta) = iproc
+ enddo
+ close(34)
+
+! loop over all the regions of the mesh
+ do iregion_code = 1,MAX_NUM_REGIONS
+
+ print *
+ print *,' ********* checking region ',iregion_code,' *********'
+ print *
+
+! dynamic memory allocation for arrays
+ allocate(iboolleft_xi(NGLOB2DMAX_XMIN_XMAX(iregion_code)))
+ allocate(iboolright_xi(NGLOB2DMAX_XMIN_XMAX(iregion_code)))
+ allocate(iboolleft_eta(NGLOB2DMAX_YMIN_YMAX(iregion_code)))
+ allocate(iboolright_eta(NGLOB2DMAX_YMIN_YMAX(iregion_code)))
+ allocate(xleft_xi(NGLOB2DMAX_XMIN_XMAX(iregion_code)))
+ allocate(yleft_xi(NGLOB2DMAX_XMIN_XMAX(iregion_code)))
+ allocate(zleft_xi(NGLOB2DMAX_XMIN_XMAX(iregion_code)))
+ allocate(xright_xi(NGLOB2DMAX_XMIN_XMAX(iregion_code)))
+ allocate(yright_xi(NGLOB2DMAX_XMIN_XMAX(iregion_code)))
+ allocate(zright_xi(NGLOB2DMAX_XMIN_XMAX(iregion_code)))
+ allocate(xleft_eta(NGLOB2DMAX_YMIN_YMAX(iregion_code)))
+ allocate(yleft_eta(NGLOB2DMAX_YMIN_YMAX(iregion_code)))
+ allocate(zleft_eta(NGLOB2DMAX_YMIN_YMAX(iregion_code)))
+ allocate(xright_eta(NGLOB2DMAX_YMIN_YMAX(iregion_code)))
+ allocate(yright_eta(NGLOB2DMAX_YMIN_YMAX(iregion_code)))
+ allocate(zright_eta(NGLOB2DMAX_YMIN_YMAX(iregion_code)))
+
+! loop on the chunks
+ do ichunk = 1,NCHUNKS
+
+ print *
+ print *,'Checking xi in chunk ',ichunk
+ print *
+
+! double loop on NPROC_XI and NPROC_ETA
+ do iproc_eta=0,NPROC_ETA-1
+
+ print *,'checking row ',iproc_eta
+
+ do iproc_xi=0,NPROC_XI-2
+
+ print *,'checking slice ixi = ',iproc_xi,' in that row'
+
+ ithisproc = addressing(ichunk,iproc_xi,iproc_eta)
+ iotherproc = addressing(ichunk,iproc_xi+1,iproc_eta)
+
+! create the name for the database of the current slide
+ call create_serial_name_database(prname,ithisproc,iregion_code, &
+ LOCAL_PATH,NPROCTOT,OUTPUT_FILES)
+ call create_serial_name_database(prname_other,iotherproc,iregion_code, &
+ LOCAL_PATH,NPROCTOT,OUTPUT_FILES)
+
+! read 2-D addressing for summation between slices along xi with MPI
+
+! read iboolright_xi of this slice
+ write(*,*) 'reading MPI buffer iboolright_xi slice ',ithisproc
+ open(unit=34,file=prname(1:len_trim(prname))//'iboolright_xi.txt',status='old',action='read')
+ npoin2D_xi = 1
+ 360 continue
+ read(34,*) iboolright_xi(npoin2D_xi), &
+ xright_xi(npoin2D_xi),yright_xi(npoin2D_xi),zright_xi(npoin2D_xi)
+ if(iboolright_xi(npoin2D_xi) > 0) then
+ npoin2D_xi = npoin2D_xi + 1
+ goto 360
+ endif
+ npoin2D_xi = npoin2D_xi - 1
+ write(*,*) 'found ',npoin2D_xi,' points in iboolright_xi slice ',ithisproc
+ read(34,*) npoin2D_xi_mesher
+ if(npoin2D_xi > NGLOB2DMAX_XMIN_XMAX(iregion_code) .or. npoin2D_xi /= npoin2D_xi_mesher) then
+ stop 'incorrect iboolright_xi read'
+ endif
+ close(34)
+
+! save to compare to other side
+ npoin2D_xi_save = npoin2D_xi
+
+! read iboolleft_xi of other slice
+ write(*,*) 'reading MPI buffer iboolleft_xi slice ',iotherproc
+ open(unit=34,file=prname_other(1:len_trim(prname_other))//'iboolleft_xi.txt',status='old',action='read')
+ npoin2D_xi = 1
+ 350 continue
+ read(34,*) iboolleft_xi(npoin2D_xi), &
+ xleft_xi(npoin2D_xi),yleft_xi(npoin2D_xi),zleft_xi(npoin2D_xi)
+ if(iboolleft_xi(npoin2D_xi) > 0) then
+ npoin2D_xi = npoin2D_xi + 1
+ goto 350
+ endif
+ npoin2D_xi = npoin2D_xi - 1
+ write(*,*) 'found ',npoin2D_xi,' points in iboolleft_xi slice ',iotherproc
+ read(34,*) npoin2D_xi_mesher
+ if(npoin2D_xi > NGLOB2DMAX_XMIN_XMAX(iregion_code) .or. npoin2D_xi /= npoin2D_xi_mesher) then
+ stop 'incorrect iboolleft_xi read'
+ endif
+ close(34)
+
+ if(npoin2D_xi_save == npoin2D_xi) then
+ print *,'okay, same size for both buffers'
+ else
+ stop 'wrong buffer size'
+ endif
+
+! check the coordinates of all the points in the buffer
+! to see if it is correctly sorted
+ do ipoin = 1,npoin2D_xi
+ diff = dmax1(dabs(xleft_xi(ipoin)-xright_xi(ipoin)), &
+ dabs(yleft_xi(ipoin)-yright_xi(ipoin)),dabs(zleft_xi(ipoin)-zright_xi(ipoin)))
+ if(diff > 0.0000001d0) print *,'different: ',ipoin,iboolleft_xi(ipoin),iboolright_xi(ipoin),diff
+ enddo
+
+ enddo
+ enddo
+ enddo
+
+
+! loop on the chunks
+ do ichunk = 1,NCHUNKS
+
+ print *
+ print *,'Checking eta in chunk ',ichunk
+ print *
+
+! double loop on NPROC_XI and NPROC_ETA
+ do iproc_xi=0,NPROC_XI-1
+
+ print *,'checking row ',iproc_xi
+
+ do iproc_eta=0,NPROC_ETA-2
+
+ print *,'checking slice ieta = ',iproc_eta,' in that row'
+
+ ithisproc = addressing(ichunk,iproc_xi,iproc_eta)
+ iotherproc = addressing(ichunk,iproc_xi,iproc_eta+1)
+
+! create the name for the database of the current slide
+ call create_serial_name_database(prname,ithisproc,iregion_code, &
+ LOCAL_PATH,NPROCTOT,OUTPUT_FILES)
+ call create_serial_name_database(prname_other,iotherproc,iregion_code, &
+ LOCAL_PATH,NPROCTOT,OUTPUT_FILES)
+
+! read 2-D addressing for summation between slices along xi with MPI
+
+! read iboolright_eta of this slice
+ write(*,*) 'reading MPI buffer iboolright_eta slice ',ithisproc
+ open(unit=34,file=prname(1:len_trim(prname))//'iboolright_eta.txt',status='old',action='read')
+ npoin2D_eta = 1
+ 460 continue
+ read(34,*) iboolright_eta(npoin2D_eta), &
+ xright_eta(npoin2D_eta),yright_eta(npoin2D_eta),zright_eta(npoin2D_eta)
+ if(iboolright_eta(npoin2D_eta) > 0) then
+ npoin2D_eta = npoin2D_eta + 1
+ goto 460
+ endif
+ npoin2D_eta = npoin2D_eta - 1
+ write(*,*) 'found ',npoin2D_eta,' points in iboolright_eta slice ',ithisproc
+ read(34,*) npoin2D_eta_mesher
+ if(npoin2D_eta > NGLOB2DMAX_YMIN_YMAX(iregion_code) .or. npoin2D_eta /= npoin2D_eta_mesher) then
+ stop 'incorrect iboolright_eta read'
+ endif
+ close(34)
+
+! save to compare to other side
+ npoin2D_eta_save = npoin2D_eta
+
+! read iboolleft_eta of other slice
+ write(*,*) 'reading MPI buffer iboolleft_eta slice ',iotherproc
+ open(unit=34,file=prname_other(1:len_trim(prname_other))//'iboolleft_eta.txt',status='old',action='read')
+ npoin2D_eta = 1
+ 450 continue
+ read(34,*) iboolleft_eta(npoin2D_eta), &
+ xleft_eta(npoin2D_eta),yleft_eta(npoin2D_eta),zleft_eta(npoin2D_eta)
+ if(iboolleft_eta(npoin2D_eta) > 0) then
+ npoin2D_eta = npoin2D_eta + 1
+ goto 450
+ endif
+ npoin2D_eta = npoin2D_eta - 1
+ write(*,*) 'found ',npoin2D_eta,' points in iboolleft_eta slice ',iotherproc
+ read(34,*) npoin2D_eta_mesher
+ if(npoin2D_eta > NGLOB2DMAX_YMIN_YMAX(iregion_code) .or. npoin2D_eta /= npoin2D_eta_mesher) then
+ stop 'incorrect iboolleft_eta read'
+ endif
+ close(34)
+
+ if(npoin2D_eta_save == npoin2D_eta) then
+ print *,'okay, same size for both buffers'
+ else
+ stop 'wrong buffer size'
+ endif
+
+! check the coordinates of all the points in the buffer
+! to see if it is correctly sorted
+ do ipoin = 1,npoin2D_eta
+ diff = dmax1(dabs(xleft_eta(ipoin)-xright_eta(ipoin)), &
+ dabs(yleft_eta(ipoin)-yright_eta(ipoin)),dabs(zleft_eta(ipoin)-zright_eta(ipoin)))
+ if(diff > 0.0000001d0) print *,'different: ',ipoin,iboolleft_eta(ipoin),iboolright_eta(ipoin),diff
+ enddo
+
+ enddo
+ enddo
+ enddo
+
+! deallocate arrays
+ deallocate(iboolleft_xi)
+ deallocate(iboolright_xi)
+ deallocate(iboolleft_eta)
+ deallocate(iboolright_eta)
+ deallocate(xleft_xi)
+ deallocate(yleft_xi)
+ deallocate(zleft_xi)
+ deallocate(xright_xi)
+ deallocate(yright_xi)
+ deallocate(zright_xi)
+ deallocate(xleft_eta)
+ deallocate(yleft_eta)
+ deallocate(zleft_eta)
+ deallocate(xright_eta)
+ deallocate(yright_eta)
+ deallocate(zright_eta)
+
+ enddo
+
+ print *
+ print *,'done'
+ print *
+
+ end program check_buffers_2D
+
Copied: seismo/3D/SPECFEM3D_GLOBE/trunk/utils/oldstuff/check_buffers_corners_chunks.f90 (from rev 22856, seismo/3D/SPECFEM3D_GLOBE/trunk/src/auxiliaries/check_buffers_corners_chunks.f90)
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/utils/oldstuff/check_buffers_corners_chunks.f90 (rev 0)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/utils/oldstuff/check_buffers_corners_chunks.f90 2013-09-26 16:03:46 UTC (rev 22858)
@@ -0,0 +1,212 @@
+!=====================================================================
+!
+! S p e c f e m 3 D G l o b e V e r s i o n 6 . 0
+! --------------------------------------------------
+!
+! Main authors: Dimitri Komatitsch and Jeroen Tromp
+! Princeton University, USA
+! and CNRS / INRIA / University of Pau, France
+! (c) Princeton University and CNRS / INRIA / University of Pau
+! August 2013
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 2 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along
+! with this program; if not, write to the Free Software Foundation, Inc.,
+! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+!
+!=====================================================================
+
+! code to check that all the 1D buffers between chunk corners are okay
+
+ program check_buffers_corners_chunks
+
+ use constants
+ use shared_parameters
+
+ implicit none
+
+ integer imsg
+ integer ipoin1D
+ integer iboolmaster,iboolworker1,iboolworker2
+ integer npoin1D_master,npoin1D_worker1,npoin1D_worker2
+ integer iregion_code,iproc
+
+! number of corners between chunks
+ integer NCORNERSCHUNKS
+
+ double precision xmaster,ymaster,zmaster
+ double precision xworker1,yworker1,zworker1
+ double precision xworker2,yworker2,zworker2
+ double precision diff1,diff2
+
+! communication pattern for corners between chunks
+ integer, dimension(:), allocatable :: iproc_master_corners,iproc_worker1_corners,iproc_worker2_corners
+
+ character(len=150) filename,prname
+
+! ************** PROGRAM STARTS HERE **************
+
+ print *
+ print *,'Check all MPI buffers between chunk corners'
+ print *
+
+! read the parameter file and compute additional parameters
+ call read_compute_parameters()
+
+ print *
+ print *,'There are ',NPROCTOT,' slices numbered from 0 to ',NPROCTOT-1
+ print *,'There are ',NCHUNKS,' chunks'
+ print *,'There are ',NPROC_XI,' slices along xi in each chunk'
+ print *,'There are ',NPROC_ETA,' slices along eta in each chunk'
+ print *
+
+! number of corners shared between chunks
+ if(NCHUNKS == 1 .or. NCHUNKS == 2 .or. NCHUNKS == 3) then
+ NCORNERSCHUNKS = 1
+ else if(NCHUNKS == 6) then
+ NCORNERSCHUNKS = 8
+ else
+ stop 'number of chunks must be either 1, 2, 3 or 6'
+ endif
+
+ if(NCHUNKS == 1) stop 'only one chunk, nothing to check'
+
+ print *,'There are ',NCORNERSCHUNKS,' messages to assemble all the corners'
+ print *
+
+! allocate array for messages for corners
+ allocate(iproc_master_corners(NCORNERSCHUNKS))
+ allocate(iproc_worker1_corners(NCORNERSCHUNKS))
+ allocate(iproc_worker2_corners(NCORNERSCHUNKS))
+
+! get the base pathname for output files
+ call get_value_string(OUTPUT_FILES, 'OUTPUT_FILES', 'OUTPUT_FILES')
+
+! 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')
+ do imsg = 1,NCORNERSCHUNKS
+ 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 &
+ .or. iproc_master_corners(imsg) > NPROCTOT-1 &
+ .or. iproc_worker1_corners(imsg) > NPROCTOT-1 &
+ .or. iproc_worker2_corners(imsg) > NPROCTOT-1) &
+ stop 'incorrect chunk corner numbering'
+ enddo
+ close(IIN)
+
+! loop over all the regions of the mesh
+ do iregion_code = 1,MAX_NUM_REGIONS
+
+ print *
+ print *,' ********* checking region ',iregion_code,' *********'
+ print *
+
+! loop on all the messages between corners
+ do imsg = 1,NCORNERSCHUNKS
+
+ print *
+ print *,'Checking message ',imsg,' out of ',NCORNERSCHUNKS
+
+! read 1-D buffers for the corners
+
+! master
+ write(filename,"('buffer_corners_chunks_master_msg',i6.6,'.txt')") imsg
+ iproc = iproc_master_corners(imsg)
+ call create_serial_name_database(prname,iproc,iregion_code, &
+ LOCAL_PATH,NPROCTOT,OUTPUT_FILES)
+ open(unit=34,file=prname(1:len_trim(prname))//filename,status='old',action='read')
+
+! first worker
+ write(filename,"('buffer_corners_chunks_worker1_msg',i6.6,'.txt')") imsg
+ iproc = iproc_worker1_corners(imsg)
+ call create_serial_name_database(prname,iproc,iregion_code, &
+ LOCAL_PATH,NPROCTOT,OUTPUT_FILES)
+ open(unit=35,file=prname(1:len_trim(prname))//filename,status='old',action='read')
+
+! second worker
+! if only two chunks then there is no second worker
+ if(NCHUNKS /= 2) then
+ write(filename,"('buffer_corners_chunks_worker2_msg',i6.6,'.txt')") imsg
+ iproc = iproc_worker2_corners(imsg)
+ call create_serial_name_database(prname,iproc,iregion_code, &
+ LOCAL_PATH,NPROCTOT,OUTPUT_FILES)
+ open(unit=36,file=prname(1:len_trim(prname))//filename,status='old',action='read')
+ endif
+
+ write(*,*) 'reading MPI 1D buffers for 3 procs corner'
+
+ read(34,*) npoin1D_master
+ read(35,*) npoin1D_worker1
+! if only two chunks then there is no second worker
+ if(NCHUNKS /= 2) then
+ read(36,*) npoin1D_worker2
+ else
+ npoin1D_worker2 = npoin1D_worker1
+ endif
+
+ if(npoin1D_master /= NGLOB1D_RADIAL(iregion_code) .or. &
+ npoin1D_worker1 /= NGLOB1D_RADIAL(iregion_code) .or. &
+ npoin1D_worker2 /= NGLOB1D_RADIAL(iregion_code)) then
+ stop 'incorrect total number of points'
+ else
+ print *,'number of points is correct: ',NGLOB1D_RADIAL(iregion_code)
+ endif
+
+! check all the points based upon their coordinates
+ do ipoin1D = 1, NGLOB1D_RADIAL(iregion_code)
+
+ read(34,*) iboolmaster,xmaster,ymaster,zmaster
+ read(35,*) iboolworker1,xworker1,yworker1,zworker1
+! if only two chunks then there is no second worker
+ if(NCHUNKS /= 2) read(36,*) iboolworker2,xworker2,yworker2,zworker2
+
+ diff1 = dmax1(dabs(xmaster-xworker1),dabs(ymaster-yworker1),dabs(zmaster-zworker1))
+ if(diff1 > 0.0000001d0) then
+ print *,'different : ',ipoin1D,iboolmaster,iboolworker1,diff1
+ print *,'xmaster,xworker1 = ',xmaster,xworker1
+ print *,'ymaster,yworker1 = ',ymaster,yworker1
+ print *,'zmaster,zworker1 = ',zmaster,zworker1
+ stop 'error: different'
+ endif
+
+! if only two chunks then there is no second worker
+ if(NCHUNKS /= 2) then
+ diff2 = dmax1(dabs(xmaster-xworker2),dabs(ymaster-yworker2),dabs(zmaster-zworker2))
+ if(diff2 > 0.0000001d0) then
+ print *,'different : ',ipoin1D,iboolmaster,iboolworker2,diff2
+ print *,'xmaster,xworker2 = ',xmaster,xworker2
+ print *,'ymaster,yworker2 = ',ymaster,yworker2
+ print *,'zmaster,zworker2 = ',zmaster,zworker2
+ stop 'error: different'
+ endif
+ endif
+
+ enddo
+
+ close(34)
+ close(35)
+! if only two chunks then there is no second worker
+ if(NCHUNKS /= 2) close(36)
+
+ enddo
+
+ enddo
+
+ print *
+ print *,'done'
+ print *
+
+ end program check_buffers_corners_chunks
+
Copied: seismo/3D/SPECFEM3D_GLOBE/trunk/utils/oldstuff/check_buffers_faces_chunks.f90 (from rev 22856, seismo/3D/SPECFEM3D_GLOBE/trunk/src/auxiliaries/check_buffers_faces_chunks.f90)
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/trunk/utils/oldstuff/check_buffers_faces_chunks.f90 (rev 0)
+++ seismo/3D/SPECFEM3D_GLOBE/trunk/utils/oldstuff/check_buffers_faces_chunks.f90 2013-09-26 16:03:46 UTC (rev 22858)
@@ -0,0 +1,184 @@
+!=====================================================================
+!
+! S p e c f e m 3 D G l o b e V e r s i o n 6 . 0
+! --------------------------------------------------
+!
+! Main authors: Dimitri Komatitsch and Jeroen Tromp
+! Princeton University, USA
+! and CNRS / INRIA / University of Pau, France
+! (c) Princeton University and CNRS / INRIA / University of Pau
+! August 2013
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 2 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along
+! with this program; if not, write to the Free Software Foundation, Inc.,
+! 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+!
+!=====================================================================
+
+! code to check that all the 2D buffers between chunk faces are okay
+
+ program check_buffers_faces_chunks
+
+ use constants
+ use shared_parameters
+
+ implicit none
+
+ integer imsg
+
+ integer npoin2D_sender,npoin2D_receiver
+ integer iboolsend,iboolreceive,ipoin2D
+ integer iregion_code,iproc
+
+! number of faces between chunks
+ integer NUM_FACES,NUMMSGS_FACES
+
+! number of message types
+ integer NUM_MSG_TYPES
+
+ double precision xsend,ysend,zsend
+ double precision xreceive,yreceive,zreceive
+ double precision diff
+
+ integer NPROC_ONE_DIRECTION
+
+! communication pattern for faces between chunks
+ integer, dimension(:), allocatable :: iprocfrom_faces,iprocto_faces,imsg_type
+
+ character(len=150) filename,prname
+
+! ************** PROGRAM STARTS HERE **************
+
+ print *
+ print *,'Check all MPI buffers between chunk faces'
+ print *
+
+! read the parameter file and compute additional parameters
+ call read_compute_parameters()
+
+! get the base pathname for output files
+ call get_value_string(OUTPUT_FILES, 'OUTPUT_FILES', 'OUTPUT_FILES')
+
+ print *
+ print *,'There are ',NPROCTOT,' slices numbered from 0 to ',NPROCTOT-1
+ print *,'There are ',NCHUNKS,' chunks'
+ print *,'There are ',NPROC_XI,' slices along xi in each chunk'
+ print *,'There are ',NPROC_ETA,' slices along eta in each chunk'
+ print *
+
+! number of corners and faces shared between chunks and number of message types
+ if(NCHUNKS == 1 .or. NCHUNKS == 2) then
+ NUM_FACES = 1
+ NUM_MSG_TYPES = 1
+ else if(NCHUNKS == 3) then
+ NUM_FACES = 1
+ NUM_MSG_TYPES = 3
+ else if(NCHUNKS == 6) then
+ NUM_FACES = 4
+ NUM_MSG_TYPES = 3
+ else
+ stop 'number of chunks must be either 1, 2, 3 or 6'
+ endif
+
+! if more than one chunk then same number of processors in each direction
+ NPROC_ONE_DIRECTION = NPROC_XI
+
+! total number of messages corresponding to these common faces
+ NUMMSGS_FACES = NPROC_ONE_DIRECTION*NUM_FACES*NUM_MSG_TYPES
+
+ if(NCHUNKS == 1) stop 'only one chunk, nothing to check'
+
+ print *,'There are ',NUMMSGS_FACES,' messages to assemble all the faces'
+ print *
+
+! allocate array for messages for faces
+ allocate(iprocfrom_faces(NUMMSGS_FACES))
+ allocate(iprocto_faces(NUMMSGS_FACES))
+ allocate(imsg_type(NUMMSGS_FACES))
+
+! 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')
+ do imsg = 1,NUMMSGS_FACES
+ 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 &
+ .or. iprocto_faces(imsg) > NPROCTOT-1) &
+ stop 'incorrect chunk faces numbering'
+ if (imsg_type(imsg) < 1 .or. imsg_type(imsg) > 3) &
+ stop 'incorrect message type labeling'
+ enddo
+ close(IIN)
+
+! loop over all the regions of the mesh
+ do iregion_code = 1,MAX_NUM_REGIONS
+
+ print *
+ print *,' ********* checking region ',iregion_code,' *********'
+ print *
+
+! loop on all the messages between faces
+ do imsg = 1,NUMMSGS_FACES
+
+ print *
+ print *,'Checking message ',imsg,' out of ',NUMMSGS_FACES
+
+! read 2-D buffer for the sender and the receiver
+ write(filename,"('buffer_faces_chunks_sender_msg',i6.6,'.txt')") imsg
+ iproc = iprocfrom_faces(imsg)
+ call create_serial_name_database(prname,iproc,iregion_code, &
+ LOCAL_PATH,NPROCTOT,OUTPUT_FILES)
+ open(unit=34,file=prname(1:len_trim(prname))//filename,status='old',action='read')
+
+ write(filename,"('buffer_faces_chunks_receiver_msg',i6.6,'.txt')") imsg
+ iproc = iprocto_faces(imsg)
+ call create_serial_name_database(prname,iproc,iregion_code, &
+ LOCAL_PATH,NPROCTOT,OUTPUT_FILES)
+ open(unit=35,file=prname(1:len_trim(prname))//filename,status='old',action='read')
+
+ write(*,*) 'reading MPI 2D buffer for sender'
+ read(34,*) npoin2D_sender
+ read(35,*) npoin2D_receiver
+
+! check that number of points is the same in both buffers
+ if(npoin2D_sender /= npoin2D_receiver) &
+ stop 'different number of points in the two buffers'
+
+ print *,'this message contains ',npoin2D_sender,' points'
+
+! check all the points based upon their coordinates
+ do ipoin2D = 1,npoin2D_sender
+ read(34,*) iboolsend,xsend,ysend,zsend
+ read(35,*) iboolreceive,xreceive,yreceive,zreceive
+
+ diff = dmax1(dabs(xsend-xreceive),dabs(ysend-yreceive),dabs(zsend-zreceive))
+ if(diff > 0.0000001d0) then
+ print *,'different : ',ipoin2D,iboolsend,iboolreceive,diff
+ print *,'xsend,xreceive = ',xsend,xreceive
+ print *,'ysend,yreceive = ',ysend,yreceive
+ print *,'zsend,zreceive = ',zsend,zreceive
+ stop 'error: different'
+ endif
+
+ enddo
+
+ enddo
+
+ enddo
+
+ print *
+ print *,'done'
+ print *
+
+ end program check_buffers_faces_chunks
+
Deleted: seismo/3D/SPECFEM3D_GLOBE/trunk/yyyyyyyyy_we_can_get_rid_of_all_the_check_buffers_programs_when_new_version_is_released
===================================================================
More information about the CIG-COMMITS
mailing list