[cig-commits] r21992 - in seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS: DATA EXAMPLES/regional_Greece_small/DATA src/meshfem3D src/shared src/specfem3D
lefebvre at geodynamics.org
lefebvre at geodynamics.org
Mon May 6 11:42:20 PDT 2013
Author: lefebvre
Date: 2013-05-06 11:42:19 -0700 (Mon, 06 May 2013)
New Revision: 21992
Added:
seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/meshfem3D/save_arrays_solver_adios.F90
seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/shared/adios_helpers.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/shared/adios_manager.F90
seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/specfem3D/read_mesh_databases_adios.f90
Removed:
seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/specfem3D/adios_helpers.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/specfem3D/adios_manager.F90
Modified:
seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/DATA/Par_file
seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/EXAMPLES/regional_Greece_small/DATA/Par_file
seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/meshfem3D/Makefile.in
seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/meshfem3D/finalize_mesher.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/meshfem3D/initialize_mesher.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/meshfem3D/meshfem3D_par.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/meshfem3D/save_arrays_solver.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/shared/broadcast_compute_parameters.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/shared/create_name_database.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/shared/read_parameter_file.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/specfem3D/Makefile.in
seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/specfem3D/initialize_simulation.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/specfem3D/read_forward_arrays_adios.F90
seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/specfem3D/read_mesh_databases.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/specfem3D/save_forward_arrays_adios.F90
seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/specfem3D/specfem3D_par.F90
Log:
MPI arrays are written as adios files in the mesher and read as such in the solver.
New flags to allow the user to choose wether he wants regular or adios files.
Common routines moved in the src/shared/ directory.
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/DATA/Par_file
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/DATA/Par_file 2013-05-06 18:42:12 UTC (rev 21991)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/DATA/Par_file 2013-05-06 18:42:19 UTC (rev 21992)
@@ -122,4 +122,5 @@
# set to true to use GPUs
ADIOS_ENABLED = .true.
ADIOS_FOR_FORWARD_ARRAYS = .true.
+ADIOS_FOR_MPI_ARRAYS = .true.
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/EXAMPLES/regional_Greece_small/DATA/Par_file
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/EXAMPLES/regional_Greece_small/DATA/Par_file 2013-05-06 18:42:12 UTC (rev 21991)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/EXAMPLES/regional_Greece_small/DATA/Par_file 2013-05-06 18:42:19 UTC (rev 21992)
@@ -2,7 +2,7 @@
# forward or adjoint simulation
SIMULATION_TYPE = 1
NOISE_TOMOGRAPHY = 0 # flag of noise tomography, three steps (1,2,3). If earthquake simulation, set it to 0.
-SAVE_FORWARD = .true. # save last frame of forward simulation or not
+SAVE_FORWARD = .false. # save last frame of forward simulation or not
# number of chunks (1,2,3 or 6)
NCHUNKS = 1
@@ -122,4 +122,5 @@
# set to true to use GPUs
ADIOS_ENABLED = .true.
ADIOS_FOR_FORWARD_ARRAYS = .true.
+ADIOS_FOR_MPI_ARRAYS = .true.
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/meshfem3D/Makefile.in
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/meshfem3D/Makefile.in 2013-05-06 18:42:12 UTC (rev 21991)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/meshfem3D/Makefile.in 2013-05-06 18:42:19 UTC (rev 21992)
@@ -194,7 +194,30 @@
$(EMPTY_MACRO)
LIBSPECFEM_MESHER = $O/libspecfem_mesher.a
+#
+# using ADIOS files
+ADIOS_OBJECTS= \
+ $O/adios_manager.shared_adios.o \
+ $O/adios_helpers.shared_adios.o \
+ $O/save_arrays_solver_adios.adios.o
+ADIOS_STUBS = \
+ $O/adios_empty_stubs.noadios.o
+ at COND_ADIOS_FALSE@ADIOS_OBJECTS = $(ADIOS_STUBS)
+
+# ADIOS
+# with configure: ./configure --with-cuda ADIOS_LIB=.. ADIOS_INC=.. MPI_INC=..
+ at COND_ADIOS_TRUE@ADIOS_LIBS = -ladiosf -lmxml
+ at COND_ADIOS_FALSE@ADIOS_LIBS =
+
+ADIOS_LIB_LOCATION = @ADIOS_LIB@ @MXML_LIB@
+ADIOS_LINK = $(ADIOS_LIB_LOCATION) $(ADIOS_LIBS)
+ADIOS_INC = @ADIOS_INC@ -I../../setup -I../../
+
+#@COND_ADIOS_TRUE at CPPFLAGS = -I../../setup @CPPFLAGS@
+ at COND_ADIOS_TRUE@MPIFCCOMPILE_CHECK =@FCENV@ ${MPIFC} ${FCFLAGS} $(ADIOS_INC) $(FLAGS_CHECK)
+ at COND_ADIOS_TRUE@MPIFCCOMPILE_NO_CHECK =@FCENV@ ${MPIFC} ${FCFLAGS} $(ADIOS_INC) $(FLAGS_NO_CHECK)
+
#######################################
####
@@ -223,11 +246,11 @@
####
# rules for the main programs
-XMESHFEM_OBJECTS = $(MESHER_ARRAY_OBJECTS) $O/exit_mpi.sharedmpi.o $(LIBSPECFEM_MESHER)
+XMESHFEM_OBJECTS = $(MESHER_ARRAY_OBJECTS) $(ADIOS_OBJECTS) $O/exit_mpi.sharedmpi.o $(LIBSPECFEM_MESHER)
xmeshfem3D: $(XMESHFEM_OBJECTS)
## use MPI here
- ${MPIFCCOMPILE_CHECK} -o ${E}/xmeshfem3D $(XMESHFEM_OBJECTS) $(MPILIBS)
+ ${MPIFCCOMPILE_CHECK} -o ${E}/xmeshfem3D $(XMESHFEM_OBJECTS) $(MPILIBS) $(ADIOS_LINK)
clean:
@@ -264,7 +287,29 @@
$O/%.cc.o: ${SHARED}/%.c ${SETUP}/config.h
${CC} -c $(CPPFLAGS) $(CFLAGS) -o $@ $<
+#######################################
+###
+### ADIOS compilation
+###
+
+$O/%.adios.o: %.F90 ${SETUP}/config.h
+ ${MPIFC} -c $(ADIOS_INC) $(FCFLAGS) $(MPI_INC) -o $@ $<
+
+$O/%.adios.o: %.f90 ${SETUP}/config.h
+ ${MPIFC} -c $(ADIOS_INC) $(FCFLAGS) $(MPI_INC) -o $@ $<
+
+$O/%.noadios.o: %.F90
+ ${FC} -c -o $@ $<
+
+$O/%.noadios.o: %.f90
+ ${FC} -c -o $@ $<
+
+$O/%.shared_adios.o: ${SHARED}/%.f90 ${SETUP}/constants.h
+ ${MPIFC} -c $(ADIOS_INC) $(FCFLAGS) $(MPI_INC) -o $@ $<
+
+$O/%.shared_adios.o: ${SHARED}/%.F90 ${SETUP}/constants.h
+ ${MPIFC} -c $(ADIOS_INC) $(FCFLAGS) $(MPI_INC) -o $@ $<
#######################################
###
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/meshfem3D/finalize_mesher.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/meshfem3D/finalize_mesher.f90 2013-05-06 18:42:12 UTC (rev 21991)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/meshfem3D/finalize_mesher.f90 2013-05-06 18:42:19 UTC (rev 21992)
@@ -170,5 +170,9 @@
! synchronize all the processes to make sure everybody has finished
call sync_all()
+ if (ADIOS_ENABLED) then
+ call adios_cleanup()
+ endif
+
end subroutine finalize_mesher
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/meshfem3D/initialize_mesher.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/meshfem3D/initialize_mesher.f90 2013-05-06 18:42:12 UTC (rev 21991)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/meshfem3D/initialize_mesher.f90 2013-05-06 18:42:19 UTC (rev 21992)
@@ -102,6 +102,10 @@
if(err_occurred() /= 0) &
call exit_MPI(myrank,'an error occurred while reading the parameter file')
+ ! ADIOS_ENABLED: parameter is optional, may not be in the Par_file
+ call read_adios_parameters(ADIOS_ENABLED, ADIOS_FOR_FORWARD_ARRAYS, &
+ ADIOS_FOR_MPI_ARRAYS)
+
endif
! distributes parameters from master to all processes
@@ -137,6 +141,9 @@
HONOR_1D_SPHERICAL_MOHO,CRUSTAL,ONE_CRUST,CASE_3D,TRANSVERSE_ISOTROPY, &
ISOTROPIC_3D_MANTLE,ANISOTROPIC_3D_MANTLE,HETEROGEN_3D_MANTLE, &
ATTENUATION,ATTENUATION_NEW,ATTENUATION_3D,ANISOTROPIC_INNER_CORE,NOISE_TOMOGRAPHY)
+ ! broadcasts optional ADIOS_ENABLED
+ call broadcast_adios_parameters(myrank,ADIOS_ENABLED, &
+ ADIOS_FOR_FORWARD_ARRAYS, ADIOS_FOR_MPI_ARRAYS)
! check that the code is running with the requested number of processes
if(sizeprocs /= NPROCTOT) call exit_MPI(myrank,'wrong number of MPI processes')
@@ -147,4 +154,8 @@
if(NCHUNKS /= 6) call euler_angles(rotation_matrix,CENTER_LONGITUDE_IN_DEGREES,CENTER_LATITUDE_IN_DEGREES,GAMMA_ROTATION_AZIMUTH)
+ if (ADIOS_ENABLED) then
+ call adios_setup()
+ endif
+
end subroutine initialize_mesher
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/meshfem3D/meshfem3D_par.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/meshfem3D/meshfem3D_par.f90 2013-05-06 18:42:12 UTC (rev 21991)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/meshfem3D/meshfem3D_par.f90 2013-05-06 18:42:19 UTC (rev 21992)
@@ -264,7 +264,12 @@
! this for non blocking MPI
logical, dimension(:), allocatable :: is_on_a_slice_edge
+ !-----------------------------------------------------------------
+ ! ADIOS
+ !-----------------------------------------------------------------
+ logical :: ADIOS_ENABLED, ADIOS_FOR_FORWARD_ARRAYS, ADIOS_FOR_MPI_ARRAYS
+
end module meshfem3D_par
!
@@ -392,7 +397,7 @@
logical, dimension(:), allocatable :: ispec_is_tiso
! name of the database file
- character(len=150) :: prname
+ character(len=150) :: prname, prname_adios
end module create_regions_mesh_par2
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/meshfem3D/save_arrays_solver.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/meshfem3D/save_arrays_solver.f90 2013-05-06 18:42:12 UTC (rev 21991)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/meshfem3D/save_arrays_solver.f90 2013-05-06 18:42:19 UTC (rev 21992)
@@ -474,7 +474,8 @@
use meshfem3D_par,only: &
myrank,LOCAL_PATH, &
- IREGION_CRUST_MANTLE,IREGION_OUTER_CORE,IREGION_INNER_CORE
+ IREGION_CRUST_MANTLE,IREGION_OUTER_CORE,IREGION_INNER_CORE, &
+ ADIOS_FOR_MPI_ARRAYS
! use create_MPI_interfaces_par
@@ -488,39 +489,72 @@
select case( iregion_code )
case( IREGION_CRUST_MANTLE )
+ print *, myrank, " region crust mantle"
! crust mantle
- call save_MPI_arrays(myrank,IREGION_CRUST_MANTLE,LOCAL_PATH, &
- num_interfaces_crust_mantle,max_nibool_interfaces_cm, &
- my_neighbours_crust_mantle,nibool_interfaces_crust_mantle, &
- ibool_interfaces_crust_mantle, &
- nspec_inner_crust_mantle,nspec_outer_crust_mantle, &
- num_phase_ispec_crust_mantle,phase_ispec_inner_crust_mantle, &
- num_colors_outer_crust_mantle,num_colors_inner_crust_mantle, &
- num_elem_colors_crust_mantle)
+ if (ADIOS_FOR_MPI_ARRAYS) then
+ call save_MPI_arrays_adios(myrank,IREGION_CRUST_MANTLE,LOCAL_PATH, &
+ num_interfaces_crust_mantle,max_nibool_interfaces_cm, &
+ my_neighbours_crust_mantle,nibool_interfaces_crust_mantle, &
+ ibool_interfaces_crust_mantle, &
+ nspec_inner_crust_mantle,nspec_outer_crust_mantle, &
+ num_phase_ispec_crust_mantle,phase_ispec_inner_crust_mantle, &
+ num_colors_outer_crust_mantle,num_colors_inner_crust_mantle, &
+ num_elem_colors_crust_mantle)
+ print *, myrank, "adios crust passed"
+ else
+ call save_MPI_arrays(myrank,IREGION_CRUST_MANTLE,LOCAL_PATH, &
+ num_interfaces_crust_mantle,max_nibool_interfaces_cm, &
+ my_neighbours_crust_mantle,nibool_interfaces_crust_mantle, &
+ ibool_interfaces_crust_mantle, &
+ nspec_inner_crust_mantle,nspec_outer_crust_mantle, &
+ num_phase_ispec_crust_mantle,phase_ispec_inner_crust_mantle, &
+ num_colors_outer_crust_mantle,num_colors_inner_crust_mantle, &
+ num_elem_colors_crust_mantle)
+ endif
-
case( IREGION_OUTER_CORE )
! outer core
- call save_MPI_arrays(myrank,IREGION_OUTER_CORE,LOCAL_PATH, &
- num_interfaces_outer_core,max_nibool_interfaces_oc, &
- my_neighbours_outer_core,nibool_interfaces_outer_core, &
- ibool_interfaces_outer_core, &
- nspec_inner_outer_core,nspec_outer_outer_core, &
- num_phase_ispec_outer_core,phase_ispec_inner_outer_core, &
- num_colors_outer_outer_core,num_colors_inner_outer_core, &
- num_elem_colors_outer_core)
+ if (ADIOS_FOR_MPI_ARRAYS) then
+ call save_MPI_arrays_adios(myrank,IREGION_OUTER_CORE,LOCAL_PATH, &
+ num_interfaces_outer_core,max_nibool_interfaces_oc, &
+ my_neighbours_outer_core,nibool_interfaces_outer_core, &
+ ibool_interfaces_outer_core, &
+ nspec_inner_outer_core,nspec_outer_outer_core, &
+ num_phase_ispec_outer_core,phase_ispec_inner_outer_core, &
+ num_colors_outer_outer_core,num_colors_inner_outer_core, &
+ num_elem_colors_outer_core)
+ else
+ call save_MPI_arrays(myrank,IREGION_OUTER_CORE,LOCAL_PATH, &
+ num_interfaces_outer_core,max_nibool_interfaces_oc, &
+ my_neighbours_outer_core,nibool_interfaces_outer_core, &
+ ibool_interfaces_outer_core, &
+ nspec_inner_outer_core,nspec_outer_outer_core, &
+ num_phase_ispec_outer_core,phase_ispec_inner_outer_core, &
+ num_colors_outer_outer_core,num_colors_inner_outer_core, &
+ num_elem_colors_outer_core)
+ endif
case( IREGION_INNER_CORE )
! inner core
- call save_MPI_arrays(myrank,IREGION_INNER_CORE,LOCAL_PATH, &
- num_interfaces_inner_core,max_nibool_interfaces_ic, &
- my_neighbours_inner_core,nibool_interfaces_inner_core, &
- ibool_interfaces_inner_core, &
- nspec_inner_inner_core,nspec_outer_inner_core, &
- num_phase_ispec_inner_core,phase_ispec_inner_inner_core, &
- num_colors_outer_inner_core,num_colors_inner_inner_core, &
- num_elem_colors_inner_core)
-
+ if (ADIOS_FOR_MPI_ARRAYS) then
+ call save_MPI_arrays_adios(myrank,IREGION_INNER_CORE,LOCAL_PATH, &
+ num_interfaces_inner_core,max_nibool_interfaces_ic, &
+ my_neighbours_inner_core,nibool_interfaces_inner_core, &
+ ibool_interfaces_inner_core, &
+ nspec_inner_inner_core,nspec_outer_inner_core, &
+ num_phase_ispec_inner_core,phase_ispec_inner_inner_core, &
+ num_colors_outer_inner_core,num_colors_inner_inner_core, &
+ num_elem_colors_inner_core)
+ else
+ call save_MPI_arrays(myrank,IREGION_INNER_CORE,LOCAL_PATH, &
+ num_interfaces_inner_core,max_nibool_interfaces_ic, &
+ my_neighbours_inner_core,nibool_interfaces_inner_core, &
+ ibool_interfaces_inner_core, &
+ nspec_inner_inner_core,nspec_outer_inner_core, &
+ num_phase_ispec_inner_core,phase_ispec_inner_inner_core, &
+ num_colors_outer_inner_core,num_colors_inner_inner_core, &
+ num_elem_colors_inner_core)
+ endif
end select
end subroutine save_arrays_solver_MPI
Copied: seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/meshfem3D/save_arrays_solver_adios.F90 (from rev 21991, seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/meshfem3D/save_arrays_solver.f90)
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/meshfem3D/save_arrays_solver_adios.F90 (rev 0)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/meshfem3D/save_arrays_solver_adios.F90 2013-05-06 18:42:19 UTC (rev 21992)
@@ -0,0 +1,710 @@
+!=====================================================================
+!
+! S p e c f e m 3 D G l o b e V e r s i o n 5 . 1
+! --------------------------------------------------
+!
+! Main authors: Dimitri Komatitsch and Jeroen Tromp
+! Princeton University, USA
+! and University of Pau / CNRS / INRIA, France
+! (c) Princeton University / California Institute of Technology and University of Pau / CNRS / INRIA
+! April 2011
+!
+! 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.
+!
+!=====================================================================
+
+ subroutine save_arrays_solver_adios(myrank,nspec,nglob,idoubling,ibool, &
+ iregion_code,xstore,ystore,zstore, &
+ NSPEC2D_TOP,NSPEC2D_BOTTOM)
+
+ use constants
+
+ use meshfem3D_models_par,only: &
+ OCEANS,TRANSVERSE_ISOTROPY,HETEROGEN_3D_MANTLE,ANISOTROPIC_3D_MANTLE, &
+ ANISOTROPIC_INNER_CORE,ATTENUATION
+
+ use meshfem3D_par,only: &
+ NCHUNKS,ABSORBING_CONDITIONS,SAVE_MESH_FILES
+
+ use create_regions_mesh_par2,only: &
+ xixstore,xiystore,xizstore,etaxstore,etaystore,etazstore, &
+ gammaxstore,gammaystore,gammazstore, &
+ rhostore,dvpstore,kappavstore,kappahstore,muvstore,muhstore,eta_anisostore, &
+ c11store,c12store,c13store,c14store,c15store,c16store,c22store, &
+ c23store,c24store,c25store,c26store,c33store,c34store,c35store, &
+ c36store,c44store,c45store,c46store,c55store,c56store,c66store, &
+ rmassx,rmassy,rmassz,rmass_ocean_load, &
+ ibelm_xmin,ibelm_xmax,ibelm_ymin,ibelm_ymax,ibelm_bottom,ibelm_top, &
+ normal_xmin,normal_xmax,normal_ymin,normal_ymax,normal_bottom,normal_top, &
+ jacobian2D_xmin,jacobian2D_xmax,jacobian2D_ymin,jacobian2D_ymax, &
+ jacobian2D_bottom,jacobian2D_top, &
+ rho_vp,rho_vs, &
+ nspec2D_xmin,nspec2D_xmax,nspec2D_ymin,nspec2D_ymax, &
+ ispec_is_tiso,tau_s,T_c_source,tau_e_store,Qmu_store, &
+ prname
+
+ implicit none
+
+ integer :: myrank
+ integer :: nspec,nglob
+
+ ! doubling mesh flag
+ integer, dimension(nspec) :: idoubling
+ integer,dimension(NGLLX,NGLLY,NGLLZ,nspec) :: ibool
+
+ integer :: iregion_code
+
+ ! arrays with the mesh in double precision
+ double precision,dimension(NGLLX,NGLLY,NGLLZ,nspec) :: xstore,ystore,zstore
+
+ ! boundary parameters locator
+ integer :: NSPEC2D_TOP,NSPEC2D_BOTTOM
+
+ ! local parameters
+ integer :: i,j,k,ispec,iglob,ier
+ real(kind=CUSTOM_REAL),dimension(:),allocatable :: tmp_array
+
+ ! mesh databases
+ open(unit=27,file=prname(1:len_trim(prname))//'solver_data.bin', &
+ status='unknown',form='unformatted',action='write',iostat=ier)
+ if( ier /= 0 ) call exit_mpi(myrank,'error opening solver_data.bin file')
+
+ ! save nspec and nglob, to be used in combine_paraview_data
+ write(27) nspec
+ write(27) nglob
+
+ ! mesh topology
+
+ ! mesh arrays used in the solver to locate source and receivers
+ ! and for anisotropy and gravity, save in single precision
+ ! use tmp_array for temporary storage to perform conversion
+ allocate(tmp_array(nglob),stat=ier)
+ if( ier /=0 ) call exit_MPI(myrank,'error allocating temporary array for mesh topology')
+
+ !--- x coordinate
+ tmp_array(:) = 0._CUSTOM_REAL
+ do ispec = 1,nspec
+ do k = 1,NGLLZ
+ do j = 1,NGLLY
+ do i = 1,NGLLX
+ iglob = ibool(i,j,k,ispec)
+ ! distinguish between single and double precision for reals
+ if(CUSTOM_REAL == SIZE_REAL) then
+ tmp_array(iglob) = sngl(xstore(i,j,k,ispec))
+ else
+ tmp_array(iglob) = xstore(i,j,k,ispec)
+ endif
+ enddo
+ enddo
+ enddo
+ enddo
+ write(27) tmp_array ! xstore
+
+ !--- y coordinate
+ tmp_array(:) = 0._CUSTOM_REAL
+ do ispec = 1,nspec
+ do k = 1,NGLLZ
+ do j = 1,NGLLY
+ do i = 1,NGLLX
+ iglob = ibool(i,j,k,ispec)
+ ! distinguish between single and double precision for reals
+ if(CUSTOM_REAL == SIZE_REAL) then
+ tmp_array(iglob) = sngl(ystore(i,j,k,ispec))
+ else
+ tmp_array(iglob) = ystore(i,j,k,ispec)
+ endif
+ enddo
+ enddo
+ enddo
+ enddo
+ write(27) tmp_array ! ystore
+
+ !--- z coordinate
+ tmp_array(:) = 0._CUSTOM_REAL
+ do ispec = 1,nspec
+ do k = 1,NGLLZ
+ do j = 1,NGLLY
+ do i = 1,NGLLX
+ iglob = ibool(i,j,k,ispec)
+ ! distinguish between single and double precision for reals
+ if(CUSTOM_REAL == SIZE_REAL) then
+ tmp_array(iglob) = sngl(zstore(i,j,k,ispec))
+ else
+ tmp_array(iglob) = zstore(i,j,k,ispec)
+ endif
+ enddo
+ enddo
+ enddo
+ enddo
+ write(27) tmp_array ! zstore
+
+ deallocate(tmp_array)
+
+ ! local to global indexing
+ write(27) ibool
+ write(27) idoubling
+ write(27) ispec_is_tiso
+
+ ! local GLL points
+ write(27) xixstore
+ write(27) xiystore
+ write(27) xizstore
+ write(27) etaxstore
+ write(27) etaystore
+ write(27) etazstore
+ write(27) gammaxstore
+ write(27) gammaystore
+ write(27) gammazstore
+
+ write(27) rhostore
+ write(27) kappavstore
+
+ ! other terms needed in the solid regions only
+ if(iregion_code /= IREGION_OUTER_CORE) then
+
+ ! note: muvstore needed for Q_mu shear attenuation in inner core
+ if(.not. (ANISOTROPIC_3D_MANTLE .and. iregion_code == IREGION_CRUST_MANTLE)) then
+ write(27) muvstore
+ endif
+
+ ! save anisotropy in the mantle only
+ if(TRANSVERSE_ISOTROPY) then
+ if(iregion_code == IREGION_CRUST_MANTLE .and. .not. ANISOTROPIC_3D_MANTLE) then
+ write(27) kappahstore
+ write(27) muhstore
+ write(27) eta_anisostore
+ endif
+ endif
+
+ ! save anisotropy in the inner core only
+ if(ANISOTROPIC_INNER_CORE .and. iregion_code == IREGION_INNER_CORE) then
+ write(27) c11store
+ write(27) c33store
+ write(27) c12store
+ write(27) c13store
+ write(27) c44store
+ endif
+
+ if(ANISOTROPIC_3D_MANTLE .and. iregion_code == IREGION_CRUST_MANTLE) then
+ write(27) c11store
+ write(27) c12store
+ write(27) c13store
+ write(27) c14store
+ write(27) c15store
+ write(27) c16store
+ write(27) c22store
+ write(27) c23store
+ write(27) c24store
+ write(27) c25store
+ write(27) c26store
+ write(27) c33store
+ write(27) c34store
+ write(27) c35store
+ write(27) c36store
+ write(27) c44store
+ write(27) c45store
+ write(27) c46store
+ write(27) c55store
+ write(27) c56store
+ write(27) c66store
+ endif
+
+ endif
+
+ ! Stacey
+ if(ABSORBING_CONDITIONS) then
+
+ if(iregion_code == IREGION_CRUST_MANTLE) then
+ write(27) rho_vp
+ write(27) rho_vs
+ else if(iregion_code == IREGION_OUTER_CORE) then
+ write(27) rho_vp
+ endif
+
+ endif
+
+ ! mass matrices
+ !
+ ! in the case of stacey boundary conditions, add C*deltat/2 contribution to the mass matrix
+ ! on Stacey edges for the crust_mantle and outer_core regions but not for the inner_core region
+ ! thus the mass matrix must be replaced by three mass matrices including the "C" damping matrix
+ !
+ ! if absorbing_conditions are not set or if NCHUNKS=6, only one mass matrix is needed
+ ! for the sake of performance, only "rmassz" array will be filled and "rmassx" & "rmassy" will be obsolete
+ if(NCHUNKS /= 6 .and. ABSORBING_CONDITIONS .and. iregion_code == IREGION_CRUST_MANTLE) then
+ write(27) rmassx
+ write(27) rmassy
+ endif
+
+ write(27) rmassz
+
+ ! additional ocean load mass matrix if oceans and if we are in the crust
+ if(OCEANS .and. iregion_code == IREGION_CRUST_MANTLE) write(27) rmass_ocean_load
+
+ close(27) ! solver_data.bin
+
+
+ ! absorbing boundary parameters
+ open(unit=27,file=prname(1:len_trim(prname))//'boundary.bin', &
+ status='unknown',form='unformatted',action='write',iostat=ier)
+ if( ier /= 0 ) call exit_mpi(myrank,'error opening boundary.bin file')
+
+ write(27) nspec2D_xmin
+ write(27) nspec2D_xmax
+ write(27) nspec2D_ymin
+ write(27) nspec2D_ymax
+ write(27) NSPEC2D_BOTTOM
+ write(27) NSPEC2D_TOP
+
+ write(27) ibelm_xmin
+ write(27) ibelm_xmax
+ write(27) ibelm_ymin
+ write(27) ibelm_ymax
+ write(27) ibelm_bottom
+ write(27) ibelm_top
+
+ write(27) normal_xmin
+ write(27) normal_xmax
+ write(27) normal_ymin
+ write(27) normal_ymax
+ write(27) normal_bottom
+ write(27) normal_top
+
+ write(27) jacobian2D_xmin
+ write(27) jacobian2D_xmax
+ write(27) jacobian2D_ymin
+ write(27) jacobian2D_ymax
+ write(27) jacobian2D_bottom
+ write(27) jacobian2D_top
+
+ close(27)
+
+ if(ATTENUATION) then
+ open(unit=27, file=prname(1:len_trim(prname))//'attenuation.bin', &
+ status='unknown', form='unformatted',action='write',iostat=ier)
+ if( ier /= 0 ) call exit_mpi(myrank,'error opening attenuation.bin file')
+
+ write(27) tau_s
+ write(27) tau_e_store
+ write(27) Qmu_store
+ write(27) T_c_source
+ close(27)
+ endif
+
+ if(HETEROGEN_3D_MANTLE .and. iregion_code == IREGION_CRUST_MANTLE) then
+ open(unit=27,file=prname(1:len_trim(prname))//'dvp.bin', &
+ status='unknown',form='unformatted',action='write',iostat=ier)
+ if( ier /= 0 ) call exit_mpi(myrank,'error opening dvp.bin file')
+
+ write(27) dvpstore
+ close(27)
+ endif
+
+
+ ! uncomment for vp & vs model storage
+ if( SAVE_MESH_FILES ) then
+ ! outputs model files in binary format
+ call save_arrays_solver_meshfiles(myrank,nspec)
+ endif
+
+ end subroutine save_arrays_solver_adios
+
+!
+!-------------------------------------------------------------------------------------------------
+!
+
+ subroutine save_arrays_solver_meshfiles_adios(myrank,nspec)
+
+! outputs model files in binary format
+
+ use constants
+
+ use meshfem3D_models_par,only: &
+ TRANSVERSE_ISOTROPY,ATTENUATION
+
+ use create_regions_mesh_par2,only: &
+ rhostore,kappavstore,kappahstore,muvstore,muhstore,eta_anisostore, &
+ Qmu_store, &
+ prname
+
+ implicit none
+
+ integer :: myrank
+ integer :: nspec
+
+ ! local parameters
+ integer :: i,j,k,ispec,ier
+ real(kind=CUSTOM_REAL) :: scaleval1,scaleval2
+ real(kind=CUSTOM_REAL),dimension(:,:,:,:),allocatable :: temp_store
+
+ ! scaling factors to re-dimensionalize units
+ scaleval1 = sngl( sqrt(PI*GRAV*RHOAV)*(R_EARTH/1000.0d0) )
+ scaleval2 = sngl( RHOAV/1000.0d0 )
+
+ ! isotropic model
+ ! vp
+ open(unit=27,file=prname(1:len_trim(prname))//'vp.bin', &
+ status='unknown',form='unformatted',action='write',iostat=ier)
+ if( ier /= 0 ) call exit_mpi(myrank,'error opening vp.bin file')
+
+ write(27) sqrt( (kappavstore+4.*muvstore/3.)/rhostore )*scaleval1
+ close(27)
+ ! vs
+ open(unit=27,file=prname(1:len_trim(prname))//'vs.bin', &
+ status='unknown',form='unformatted',action='write',iostat=ier)
+ if( ier /= 0 ) call exit_mpi(myrank,'error opening vs.bin file')
+
+ write(27) sqrt( muvstore/rhostore )*scaleval1
+ close(27)
+ ! rho
+ open(unit=27,file=prname(1:len_trim(prname))//'rho.bin', &
+ status='unknown',form='unformatted',action='write',iostat=ier)
+ if( ier /= 0 ) call exit_mpi(myrank,'error opening rho.bin file')
+
+ write(27) rhostore*scaleval2
+ close(27)
+
+ ! transverse isotropic model
+ if( TRANSVERSE_ISOTROPY ) then
+ ! vpv
+ open(unit=27,file=prname(1:len_trim(prname))//'vpv.bin', &
+ status='unknown',form='unformatted',action='write',iostat=ier)
+ if( ier /= 0 ) call exit_mpi(myrank,'error opening vpv.bin file')
+
+ write(27) sqrt( (kappavstore+4.*muvstore/3.)/rhostore )*scaleval1
+ close(27)
+ ! vph
+ open(unit=27,file=prname(1:len_trim(prname))//'vph.bin', &
+ status='unknown',form='unformatted',action='write',iostat=ier)
+ if( ier /= 0 ) call exit_mpi(myrank,'error opening vph.bin file')
+
+ write(27) sqrt( (kappahstore+4.*muhstore/3.)/rhostore )*scaleval1
+ close(27)
+ ! vsv
+ open(unit=27,file=prname(1:len_trim(prname))//'vsv.bin', &
+ status='unknown',form='unformatted',action='write',iostat=ier)
+ if( ier /= 0 ) call exit_mpi(myrank,'error opening vsv.bin file')
+
+ write(27) sqrt( muvstore/rhostore )*scaleval1
+ close(27)
+ ! vsh
+ open(unit=27,file=prname(1:len_trim(prname))//'vsh.bin', &
+ status='unknown',form='unformatted',action='write',iostat=ier)
+ if( ier /= 0 ) call exit_mpi(myrank,'error opening vsh.bin file')
+
+ write(27) sqrt( muhstore/rhostore )*scaleval1
+ close(27)
+ ! rho
+ open(unit=27,file=prname(1:len_trim(prname))//'rho.bin', &
+ status='unknown',form='unformatted',action='write',iostat=ier)
+ if( ier /= 0 ) call exit_mpi(myrank,'error opening rho.bin file')
+
+ write(27) rhostore*scaleval2
+ close(27)
+ ! eta
+ open(unit=27,file=prname(1:len_trim(prname))//'eta.bin', &
+ status='unknown',form='unformatted',action='write',iostat=ier)
+ if( ier /= 0 ) call exit_mpi(myrank,'error opening eta.bin file')
+
+ write(27) eta_anisostore
+ close(27)
+ endif ! TRANSVERSE_ISOTROPY
+
+ ! shear attenuation
+ if( ATTENUATION ) then
+ ! saves Qmu_store to full custom_real array
+ ! uses temporary array
+ allocate(temp_store(NGLLX,NGLLY,NGLLZ,nspec))
+ if (USE_3D_ATTENUATION_ARRAYS) then
+ ! attenuation arrays are fully 3D
+ if(CUSTOM_REAL == SIZE_REAL) then
+ temp_store(:,:,:,:) = sngl(Qmu_store(:,:,:,:))
+ else
+ temp_store(:,:,:,:) = Qmu_store(:,:,:,:)
+ endif
+ else
+ ! attenuation array dimensions: Q_mustore(1,1,1,nspec)
+ do ispec = 1,nspec
+ do k = 1,NGLLZ
+ do j = 1,NGLLY
+ do i = 1,NGLLX
+ ! distinguish between single and double precision for reals
+ if(CUSTOM_REAL == SIZE_REAL) then
+ temp_store(i,j,k,ispec) = sngl(Qmu_store(1,1,1,ispec))
+ else
+ temp_store(i,j,k,ispec) = Qmu_store(1,1,1,ispec)
+ endif
+ enddo
+ enddo
+ enddo
+ enddo
+ endif
+
+ ! Qmu
+ open(unit=27,file=prname(1:len_trim(prname))//'qmu.bin', &
+ status='unknown',form='unformatted',action='write',iostat=ier)
+ if( ier /= 0 ) call exit_mpi(myrank,'error opening qmu.bin file')
+
+ write(27) temp_store
+ close(27)
+
+ ! frees temporary memory
+ deallocate(temp_store)
+ endif ! ATTENUATION
+
+ end subroutine save_arrays_solver_meshfiles_adios
+
+!
+!------------------------------------------------------------------------------
+!
+subroutine save_MPI_arrays_adios(myrank,iregion_code,LOCAL_PATH, &
+ num_interfaces,max_nibool_interfaces, my_neighbours,nibool_interfaces, &
+ ibool_interfaces, nspec_inner,nspec_outer, num_phase_ispec, &
+ phase_ispec_inner, num_colors_outer,num_colors_inner, num_elem_colors)
+
+ use mpi
+ use adios_write_mod
+ implicit none
+
+ include "constants.h"
+
+ integer :: iregion_code,myrank
+ character(len=150) :: LOCAL_PATH
+ ! MPI interfaces
+ integer :: num_interfaces,max_nibool_interfaces
+ integer, dimension(num_interfaces) :: my_neighbours
+ integer, dimension(num_interfaces) :: nibool_interfaces
+ integer, dimension(max_nibool_interfaces,num_interfaces) :: &
+ ibool_interfaces
+ ! inner/outer elements
+ integer :: nspec_inner,nspec_outer
+ integer :: num_phase_ispec
+ integer,dimension(num_phase_ispec,2) :: phase_ispec_inner
+ ! mesh coloring
+ integer :: num_colors_outer,num_colors_inner
+ integer, dimension(num_colors_outer + num_colors_inner) :: &
+ num_elem_colors
+
+ ! local parameters
+ character(len=150) :: prname, outputname, group_name
+ integer :: ierr, sizeprocs, comm, local_dim
+ integer(kind=8) :: group_size_inc
+ ! ADIOS variables
+ integer :: adios_err
+ integer(kind=8) :: adios_group, adios_handle, varid
+ integer(kind=8) :: adios_groupsize, adios_totalsize
+
+ ! create the name for the database of the current slide and region
+ call create_name_database_adios(prname,iregion_code,LOCAL_PATH)
+
+ outputname = trim(prname) // "solver_data_mpi.bp"
+ write(group_name,"('SPECFEM3D_GLOBE_MPI_ARRAYS_reg',i1)") iregion_code
+ call world_size(sizeprocs) ! TODO keep it in parameters
+ call MPI_Comm_dup (MPI_COMM_WORLD, comm, ierr)
+ group_size_inc = 0
+ call adios_declare_group(adios_group, group_name, &
+ "", 0, adios_err)
+ call adios_select_method(adios_group, "MPI", "", "", adios_err)
+
+ !! MPI interfaces
+ call define_adios_integer_scalar (adios_group, "num_interfaces", "", &
+ group_size_inc)
+ if( num_interfaces > 0 ) then
+ call define_adios_integer_scalar(adios_group, "max_nibool_interfaces", &
+ "", group_size_inc)
+ call define_adios_global_integer_1d_array(adios_group, "my_neighbours", &
+ num_interfaces, group_size_inc)
+ call define_adios_global_integer_1d_array(adios_group, "nibool_interfaces",&
+ num_interfaces, group_size_inc)
+ local_dim = max_nibool_interfaces*num_interfaces
+ call define_adios_global_integer_1d_array(adios_group, "ibool_interfaces", &
+ local_dim, group_size_inc)
+ endif
+
+ ! inner/outer elements
+ call define_adios_integer_scalar (adios_group, "nspec_inner", "", &
+ group_size_inc)
+ call define_adios_integer_scalar (adios_group, "nspec_outer", "", &
+ group_size_inc)
+ call define_adios_integer_scalar (adios_group, "num_phase_ispec", "", &
+ group_size_inc)
+ if(num_phase_ispec > 0 ) then
+ local_dim = num_phase_ispec * 2
+ call define_adios_global_integer_1d_array(adios_group, "phase_ispec_inner", &
+ local_dim, group_size_inc)
+ endif
+
+ ! mesh coloring
+ if( USE_MESH_COLORING_GPU ) then
+ call define_adios_integer_scalar (adios_group, "num_colors_outer", "", &
+ group_size_inc)
+ call define_adios_integer_scalar (adios_group, "num_colors_inner", "", &
+ group_size_inc)
+ call define_adios_global_integer_1d_array(adios_group, "num_elem_colors", &
+ num_colors_outer + num_colors_inner, group_size_inc)
+ endif
+
+ ! Open an ADIOS handler to the restart file.
+ call adios_open (adios_handle, group_name, &
+ outputname, "w", comm, adios_err);
+ call adios_group_size (adios_handle, group_size_inc, &
+ adios_totalsize, adios_err)
+
+ ! MPI interfaces
+ call adios_write(adios_handle, "num_interfaces", num_interfaces, adios_err)
+ if( num_interfaces > 0 ) then
+ call adios_write(adios_handle, "max_nibool_interfaces", &
+ max_nibool_interfaces, adios_err)
+
+ local_dim = num_interfaces
+
+ call adios_set_path (adios_handle, "my_neighbours", adios_err)
+ call write_1D_global_array_adios_dims(adios_handle, myrank, &
+ local_dim, sizeprocs)
+ call adios_write(adios_handle, "array", my_neighbours, adios_err)
+
+ call adios_set_path (adios_handle, "nibool_interfaces", adios_err)
+ call write_1D_global_array_adios_dims(adios_handle, myrank, &
+ local_dim, sizeprocs)
+ call adios_write(adios_handle, "array", nibool_interfaces, adios_err)
+
+ local_dim = max_nibool_interfaces * num_interfaces
+
+ call adios_set_path (adios_handle, "ibool_interfaces", adios_err)
+ call write_1D_global_array_adios_dims(adios_handle, myrank, &
+ local_dim, sizeprocs)
+ call adios_write(adios_handle, "array", &
+ ibool_interfaces, adios_err)
+ call adios_set_path (adios_handle, "", adios_err)
+ endif
+
+ ! inner/outer elements
+ call adios_write(adios_handle, "nspec_inner", nspec_inner, adios_err)
+ call adios_write(adios_handle, "nspec_outer", nspec_outer, adios_err)
+ call adios_write(adios_handle, "num_phase_ispec", num_phase_ispec, adios_err)
+
+ if(num_phase_ispec > 0 ) then
+ local_dim = num_phase_ispec * 2
+ call adios_set_path (adios_handle, "phase_ispec_inner", adios_err)
+ call write_1D_global_array_adios_dims(adios_handle, myrank, &
+ local_dim, sizeprocs)
+ call adios_write(adios_handle, "array", &
+ phase_ispec_inner, adios_err)
+ call adios_set_path (adios_handle, "", adios_err)
+ endif
+
+ ! mesh coloring
+ if( USE_MESH_COLORING_GPU ) then
+ call adios_write(adios_handle, "num_colors_outer", nspec_inner, adios_err)
+ call adios_write(adios_handle, "num_colors_inner", nspec_inner, adios_err)
+ local_dim = num_colors_outer + num_colors_inner
+ call adios_set_path (adios_handle, "num_elem_colors", adios_err)
+ call write_1D_global_array_adios_dims(adios_handle, myrank, &
+ local_dim, sizeprocs)
+ call adios_write(adios_handle, "array", &
+ num_elem_colors, adios_err)
+ call adios_set_path (adios_handle, "", adios_err)
+ endif
+
+ call adios_close(adios_handle, adios_err)
+
+ end subroutine save_MPI_arrays_adios
+
+
+!
+!-------------------------------------------------------------------------------------------------
+!
+
+ subroutine save_arrays_solver_boundary_adios()
+
+! saves arrays for boundaries such as MOHO, 400 and 670 discontinuities
+
+ use meshfem3d_par,only: &
+ myrank
+
+ use meshfem3D_models_par,only: &
+ SAVE_BOUNDARY_MESH,HONOR_1D_SPHERICAL_MOHO,SUPPRESS_CRUSTAL_MESH
+
+ use create_regions_mesh_par2, only: &
+ NSPEC2D_MOHO, NSPEC2D_400, NSPEC2D_670, &
+ ibelm_moho_top,ibelm_moho_bot,ibelm_400_top,ibelm_400_bot, &
+ ibelm_670_top,ibelm_670_bot,normal_moho,normal_400,normal_670, &
+ ispec2D_moho_top,ispec2D_moho_bot,ispec2D_400_top,ispec2D_400_bot, &
+ ispec2D_670_top,ispec2D_670_bot, &
+ prname
+
+ implicit none
+
+ ! local parameters
+ integer :: ier
+
+ ! first check the number of surface elements are the same for Moho, 400, 670
+ if (.not. SUPPRESS_CRUSTAL_MESH .and. HONOR_1D_SPHERICAL_MOHO) then
+ if (ispec2D_moho_top /= NSPEC2D_MOHO .or. ispec2D_moho_bot /= NSPEC2D_MOHO) &
+ call exit_mpi(myrank, 'Not the same number of Moho surface elements')
+ endif
+ if (ispec2D_400_top /= NSPEC2D_400 .or. ispec2D_400_bot /= NSPEC2D_400) &
+ call exit_mpi(myrank,'Not the same number of 400 surface elements')
+ if (ispec2D_670_top /= NSPEC2D_670 .or. ispec2D_670_bot /= NSPEC2D_670) &
+ call exit_mpi(myrank,'Not the same number of 670 surface elements')
+
+ ! writing surface topology databases
+ open(unit=27,file=prname(1:len_trim(prname))//'boundary_disc.bin', &
+ status='unknown',form='unformatted',iostat=ier)
+ if( ier /= 0 ) call exit_mpi(myrank,'error opening boundary_disc.bin file')
+
+ write(27) NSPEC2D_MOHO, NSPEC2D_400, NSPEC2D_670
+
+ write(27) ibelm_moho_top
+ write(27) ibelm_moho_bot
+
+ write(27) ibelm_400_top
+ write(27) ibelm_400_bot
+
+ write(27) ibelm_670_top
+ write(27) ibelm_670_bot
+
+ write(27) normal_moho
+ write(27) normal_400
+ write(27) normal_670
+
+ close(27)
+
+ end subroutine save_arrays_solver_boundary_adios
+
+!-------------------------------------------------------------------------------
+!> Write local, global and offset dimensions to ADIOS
+!! \param adios_handle Handle to the adios file
+!! \param local_dim Number of elements to be written by one process
+!! \param sizeprocs Number of MPI processes
+subroutine write_1D_global_array_adios_dims(adios_handle, myrank, &
+ local_dim, sizeprocs)
+ use adios_write_mod
+
+ implicit none
+
+ integer(kind=8), intent(in) :: adios_handle
+ integer, intent(in) :: sizeprocs, local_dim, myrank
+
+ integer :: adios_err
+
+ call adios_write(adios_handle, "local_dim", local_dim, adios_err)
+ call check_adios_err(myrank,adios_err)
+ call adios_write(adios_handle, "global_dim", local_dim*sizeprocs, adios_err)
+ call check_adios_err(myrank,adios_err)
+ call adios_write(adios_handle, "offset", local_dim*myrank, adios_err)
+ call check_adios_err(myrank,adios_err)
+end subroutine write_1D_global_array_adios_dims
+
Copied: seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/shared/adios_helpers.f90 (from rev 21991, seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/specfem3D/adios_helpers.f90)
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/shared/adios_helpers.f90 (rev 0)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/shared/adios_helpers.f90 2013-05-06 18:42:19 UTC (rev 21992)
@@ -0,0 +1,284 @@
+!=====================================================================
+!
+! S p e c f e m 3 D G l o b e V e r s i o n 5 . 1
+! --------------------------------------------------
+!
+! Main authors: Dimitri Komatitsch and Jeroen Tromp
+! Princeton University, USA
+! and University of Pau / CNRS / INRIA, France
+! (c) Princeton University / California Institute of Technology and University of Pau / CNRS / INRIA
+! April 2011
+!
+! 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.
+!
+!=====================================================================
+
+
+!-------------------------------------------------------------------------------
+!> \file adios_helpers.f90
+!! \brief Helpers to set up adios features.
+!! \author MPBL
+!-------------------------------------------------------------------------------
+
+!-------------------------------------------------------------------------------
+!> Get the ADIOS error message from an adios error number if there is an error.
+!! \param adios_err The error code considered.
+subroutine check_adios_err(myrank, adios_err)
+ use adios_read_mod
+ implicit none
+ integer, intent(in) :: myrank, adios_err
+ character(len=1024) :: msg
+
+ if (adios_err /= 0) then
+ call adios_errmsg(msg)
+ print *, "process: ", myrank, ", error: ", msg
+ stop
+ endif
+end subroutine check_adios_err
+
+
+!-------------------------------------------------------------------------------
+!> Define an ADIOS scalar double precision variable and autoincrement
+!! the adios group size by (8).
+!! \param adios_group The adios group where the variables belongs
+!! \param name The variable to be defined
+!! \param path The logical path structuring the data and containing
+!! the variable
+!! \param group_size_inc The inout adios group size to increment
+!! with the size of the variable
+subroutine define_adios_double_scalar (adios_group, name, path, group_size_inc)
+ use adios_write_mod
+ implicit none
+ ! Arguments
+ integer(kind=8), intent(in) :: adios_group
+ character(len=*), intent(in) :: name, path
+ integer(kind=8), intent(inout) :: group_size_inc
+ ! Local Variables
+ integer(kind=8) :: varid ! dummy variable, adios use var name
+
+ ! adios: 6 == real(kind=8)
+ call adios_define_var (adios_group, name, path, 6, "", "", "", varid)
+ group_size_inc = group_size_inc + 8
+end subroutine define_adios_double_scalar
+
+!-------------------------------------------------------------------------------
+!> Define an ADIOS scalar integer variable and autoincrement the adios
+!! group size by (4).
+!! \param adios_group The adios group where the variables belongs
+!! \param name The variable to be defined
+!! \param path The logical path structuring the data and containing
+!! the variable
+!! \param group_size_inc The inout adios group size to increment
+!! with the size of the variable
+subroutine define_adios_integer_scalar (adios_group, name, path, group_size_inc)
+ use adios_write_mod
+ implicit none
+ ! Arguments
+ integer(kind=8), intent(in) :: adios_group
+ character(len=*), intent(in) :: name, path
+ integer(kind=8), intent(inout) :: group_size_inc
+ ! Local Variables
+ integer(kind=8) :: varid ! dummy variable, adios use var name
+
+ ! adios: 2 == integer(kind=4)
+ call adios_define_var (adios_group, name, path, adios_integer, "", "", "", varid)
+ group_size_inc = group_size_inc + 4
+end subroutine define_adios_integer_scalar
+
+!-------------------------------------------------------------------------------
+!> Define an ADIOS scalar byte variable and autoincrement the adios
+!! group size by (1).
+!! \param adios_group The adios group where the variables belongs
+!! \param name The variable to be defined
+!! \param path The logical path structuring the data and containing
+!! the variable
+!! \param group_size_inc The inout adios group size to increment
+!! with the size of the variable
+subroutine define_adios_byte_scalar (adios_group, name, path, group_size_inc)
+ use adios_write_mod
+ implicit none
+ ! Arguments
+ integer(kind=8), intent(in) :: adios_group
+ character(len=*), intent(in) :: name, path
+ integer(kind=8), intent(inout) :: group_size_inc
+ ! Local Variables
+ integer(kind=8) :: varid ! dummy variable, adios use var name
+
+ ! adios: 0 == byte == any_data_type(kind=1)
+ call adios_define_var (adios_group, name, path, 0, "", "", "", varid)
+ group_size_inc = group_size_inc + 1
+end subroutine define_adios_byte_scalar
+
+!-------------------------------------------------------------------------------
+!> Define a local ADIOS array of integers and autoincrement the adios
+!! group size by (4 * number of elements).
+!! \param adios_group The adios group where the variables belongs
+!! \param name The variable to be defined
+!! \param path The logical path structuring the data and containing
+!! the variable
+!! \param dim The number of elements in the 1D array. Required to
+!! correctly increment adios group size.
+!! \param dim_str The "stringified" version of dim. Needed by adios
+!! to define variables
+!! \param group_size_inc The inout adios group size to increment
+!! with the size of the variable
+subroutine define_adios_integer_local_array1D (adios_group, name, path, dim, dim_str, group_size_inc)
+ use adios_write_mod
+ implicit none
+ ! Arguments
+ integer(kind=8), intent(in) :: adios_group
+ character(len=*), intent(in) :: name, path, dim_str
+ integer(kind=8), intent(inout) :: group_size_inc
+ integer, intent(in) :: dim
+ ! Local Variables
+ integer(kind=8) :: varid ! dummy variable, adios use var name
+
+ ! adios: 2 == integer
+ call adios_define_var (adios_group, name, path, 2, dim_str, "", "", varid)
+ group_size_inc = group_size_inc + 4*dim
+end subroutine define_adios_integer_local_array1D
+
+!-------------------------------------------------------------------------------
+!> Define a local ADIOS array of doubles and autoincrement the adios
+!! group size by (8 * number of elements).
+!! \param adios_group The adios group where the variables belongs
+!! \param name The variable to be defined
+!! \param path The logical path structuring the data and containing
+!! the variable
+!! \param dim The number of elements in the 1D array. Required to
+!! correctly increment adios group size.
+!! \param dim_str The "stringified" version of dim. Needed by adios
+!! to define variables
+!! \param group_size_inc The inout adios group size to increment
+!! with the size of the variable
+subroutine define_adios_double_local_array1D (adios_group, name, path, dim, dim_str, group_size_inc)
+ use adios_write_mod
+ implicit none
+ ! Arguments
+ integer(kind=8), intent(in) :: adios_group
+ character(len=*), intent(in) :: name, path, dim_str
+ integer(kind=8), intent(inout) :: group_size_inc
+ integer, intent(in) :: dim
+ ! Local Variables
+ integer(kind=8) :: varid ! dummy variable, adios use var name
+
+ ! adios: 6 == real(kind=8)
+ call adios_define_var (adios_group, name, path, 6, dim_str, "", "", varid)
+ group_size_inc = group_size_inc + 8*dim
+end subroutine define_adios_double_local_array1D
+
+!-------------------------------------------------------------------------------
+!> Define a local ADIOS string and autoincrement the adios
+!! group size by (1 * string's length).
+!! \param adios_group The adios group where the variables belongs
+!! \param name The variable to be defined
+!! \param path The logical path structuring the data and containing
+!! the variable
+!! \param len The length of the string(number of character. in Fortran
+!! it does not include a final '\0' -- null -- character)
+!! \param group_size_inc The inout adios group size to increment
+!! with the size of the variable
+!! \note Adios string are scalar values counting for (1) byte. It is
+!! mandatory to increase the group size by the length of the
+!! string in order not to overlap 'data regions'.
+subroutine define_adios_string (adios_group, name, path, length, group_size_inc)
+ use adios_write_mod
+ implicit none
+ ! Arguments
+ integer(kind=8), intent(in) :: adios_group
+ character(len=*), intent(in) :: name, path
+ integer(kind=8), intent(inout) :: group_size_inc
+ integer :: length
+ ! Local Variables
+ integer(kind=8) :: varid ! dummy variable, adios use var name
+
+ ! adios: 9 == string
+ call adios_define_var (adios_group, name, path, 9, "", "", "", varid)
+ group_size_inc = group_size_inc + 1*length
+end subroutine define_adios_string
+
+!-------------------------------------------------------------------------------
+!> Define a global ADIOS 1D real array and autoincrement the adios
+!! group size.
+!! \param adios_group The adios group where the variables belongs
+!! \param array_name The variable to be defined. This is actually the path for
+!! ADIOS. The values are stored in array_name/array
+!! \param len The local dimension of the array.
+!! \param group_size_inc The inout adios group size to increment
+!! with the size of the variable
+!! \note This function define local, global and offset sizes as well as the
+!! array to store the values in.
+subroutine define_adios_global_real_1d_array(adios_group, array_name, &
+ local_dim, group_size_inc)
+ use adios_write_mod
+ implicit none
+ ! Parameters
+ integer(kind=8), intent(in) :: adios_group
+ character(len=*), intent(in) :: array_name
+ integer, intent(in) :: local_dim
+ integer(kind=8), intent(inout) :: group_size_inc
+ ! Variables
+ integer(kind=8) :: var_id
+
+ call define_adios_integer_scalar (adios_group, "local_dim", array_name, &
+ group_size_inc)
+ call define_adios_integer_scalar (adios_group, "global_dim", array_name, &
+ group_size_inc)
+ call define_adios_integer_scalar (adios_group, "offset", array_name, &
+ group_size_inc)
+! call adios_define_var(adios_group, "array", array_name, 6, &
+! "local_dim", "global_dim", "offset", var_id)
+ call adios_define_var(adios_group, "array", array_name, 5, &
+ array_name // "/local_dim", array_name // "/global_dim", &
+ array_name // "/offset", var_id)
+ group_size_inc = group_size_inc + local_dim*4
+end subroutine define_adios_global_real_1d_array
+
+!-------------------------------------------------------------------------------
+!> Define a global ADIOS 1D integer array and autoincrement the adios
+!! group size.
+!! \param adios_group The adios group where the variables belongs
+!! \param array_name The variable to be defined. This is actually the path for
+!! ADIOS. The values are stored in array_name/array
+!! \param len The local dimension of the array.
+!! \param group_size_inc The inout adios group size to increment
+!! with the size of the variable
+!! \note This function define local, global and offset sizes as well as the
+!! array to store the values in.
+subroutine define_adios_global_integer_1d_array(adios_group, array_name, &
+ local_dim, group_size_inc)
+ use adios_write_mod
+ implicit none
+ ! Parameters
+ integer(kind=8), intent(in) :: adios_group
+ character(len=*), intent(in) :: array_name
+ integer, intent(in) :: local_dim
+ integer(kind=8), intent(inout) :: group_size_inc
+ ! Variables
+ integer(kind=8) :: var_id
+
+ call define_adios_integer_scalar (adios_group, "local_dim", array_name, &
+ group_size_inc)
+ call define_adios_integer_scalar (adios_group, "global_dim", array_name, &
+ group_size_inc)
+ call define_adios_integer_scalar (adios_group, "offset", array_name, &
+ group_size_inc)
+! call adios_define_var(adios_group, "array", array_name, 6, &
+! "local_dim", "global_dim", "offset", var_id)
+ call adios_define_var(adios_group, "array", array_name, 2, &
+ array_name // "/local_dim", array_name // "/global_dim", &
+ array_name // "/offset", var_id)
+ group_size_inc = group_size_inc + local_dim*4
+end subroutine define_adios_global_integer_1d_array
Copied: seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/shared/adios_manager.F90 (from rev 21991, seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/specfem3D/adios_manager.F90)
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/shared/adios_manager.F90 (rev 0)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/shared/adios_manager.F90 2013-05-06 18:42:19 UTC (rev 21992)
@@ -0,0 +1,51 @@
+!=====================================================================
+!
+! S p e c f e m 3 D G l o b e V e r s i o n 5 . 1
+! --------------------------------------------------
+!
+! Main authors: Dimitri Komatitsch and Jeroen Tromp
+! Princeton University, USA
+! and University of Pau / CNRS / INRIA, France
+! (c) Princeton University / California Institute of Technology and University of Pau / CNRS / INRIA
+! April 2011
+!
+! 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.
+!
+!=====================================================================
+
+!> @brief Initialize ADIOS and setup the xml output file
+subroutine adios_setup()
+ use adios_write_mod, only: adios_init
+
+ implicit none
+ integer :: adios_err, sizeMB
+
+ call adios_init_noxml (adios_err);
+ sizeMB = 200 ! TODO 200MB is surely not the right size for the adios buffer
+ call adios_allocate_buffer (sizeMB , adios_err)
+end subroutine adios_setup
+
+!> @brief Finalize ADIOS. Must be called once everything is written down.
+subroutine adios_cleanup()
+ use mpi
+ use adios_write_mod, only: adios_finalize
+
+ implicit none
+ integer :: myrank
+ integer :: adios_err, ierr
+
+ call MPI_Comm_rank(MPI_COMM_WORLD, myrank, ierr)
+ call adios_finalize (myrank, adios_err)
+end subroutine adios_cleanup
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/shared/broadcast_compute_parameters.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/shared/broadcast_compute_parameters.f90 2013-05-06 18:42:12 UTC (rev 21991)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/shared/broadcast_compute_parameters.f90 2013-05-06 18:42:19 UTC (rev 21992)
@@ -351,7 +351,7 @@
!! \param ADIOS_FOR_FORWARD_ARRAYS Flag to indicate that intermediate and
!1 forward arrays are stored with the help of ADIOS.
subroutine broadcast_adios_parameters(myrank,ADIOS_ENABLED, &
- ADIOS_FOR_FORWARD_ARRAYS)
+ ADIOS_FOR_FORWARD_ARRAYS, ADIOS_FOR_MPI_ARRAYS)
implicit none
@@ -361,7 +361,7 @@
include "precision.h"
integer:: myrank
- logical:: ADIOS_ENABLED, ADIOS_FOR_FORWARD_ARRAYS
+ logical:: ADIOS_ENABLED, ADIOS_FOR_FORWARD_ARRAYS, ADIOS_FOR_MPI_ARRAYS
! local parameters
integer :: ier
@@ -370,5 +370,8 @@
call MPI_BCAST(ADIOS_FOR_FORWARD_ARRAYS,1,MPI_LOGICAL,0,MPI_COMM_WORLD,ier)
if( ier /= 0 ) call exit_MPI(myrank, &
'error broadcasting ADIOS_FOR_FORWARD_ARRAYS')
+ call MPI_BCAST(ADIOS_FOR_MPI_ARRAYS,1,MPI_LOGICAL,0,MPI_COMM_WORLD,ier)
+ if( ier /= 0 ) call exit_MPI(myrank, &
+ 'error broadcasting ADIOS_FOR_MPI_ARRAYS')
end subroutine broadcast_adios_parameters
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/shared/create_name_database.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/shared/create_name_database.f90 2013-05-06 18:42:12 UTC (rev 21991)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/shared/create_name_database.f90 2013-05-06 18:42:19 UTC (rev 21992)
@@ -25,12 +25,11 @@
!
!=====================================================================
- subroutine create_name_database(prname,iproc,iregion_code,LOCAL_PATH)
+subroutine create_name_database(prname,iproc,iregion_code,LOCAL_PATH)
! create the name of the database for the mesher and the solver
implicit none
-
integer iproc,iregion_code
! name of the database file
@@ -38,9 +37,26 @@
! create the name for the database of the current slide and region
write(procname,"('/proc',i6.6,'_reg',i1,'_')") iproc,iregion_code
+! create full name with path
+ prname = trim(LOCAL_PATH) // procname
+end subroutine create_name_database
+
+subroutine create_name_database_adios(prname,iregion_code,LOCAL_PATH)
+
+ ! create the name of the database for the mesher and the solver
+
+ implicit none
+
+ integer iregion_code
+
+! name of the database file
+ character(len=150) prname,procname,LOCAL_PATH
+
+! create the name for the database of the current slide and region
+ write(procname,"('/reg',i1,'_')") iregion_code
+
! create full name with path
prname = trim(LOCAL_PATH) // procname
- end subroutine create_name_database
-
+end subroutine create_name_database_adios
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/shared/read_parameter_file.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/shared/read_parameter_file.f90 2013-05-06 18:42:12 UTC (rev 21991)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/shared/read_parameter_file.f90 2013-05-06 18:42:19 UTC (rev 21992)
@@ -236,37 +236,26 @@
!-------------------------------------------------------------------------------------------------
!
- subroutine read_adios_enabled(ADIOS_ENABLED)
+ subroutine read_adios_parameters(ADIOS_ENABLED, ADIOS_FOR_FORWARD_ARRAYS, &
+ ADIOS_FOR_MPI_ARRAYS)
implicit none
include "constants.h"
- logical :: ADIOS_ENABLED
+ logical :: ADIOS_ENABLED, ADIOS_FOR_FORWARD_ARRAYS, ADIOS_FOR_MPI_ARRAYS
! initializes flags
ADIOS_ENABLED = .false.
- ! opens file Par_file
- call open_parameter_file()
- call read_value_logical(ADIOS_ENABLED, 'solver.ADIOS_ENABLED')
- call close_parameter_file()
-
- end subroutine read_adios_enabled
-
-!-------------------------------------------------------------------------------------------------
-!
- subroutine read_adios_for_forward_arrays(ADIOS_FOR_FORWARD_ARRAYS)
-
- implicit none
- include "constants.h"
-
- logical :: ADIOS_FOR_FORWARD_ARRAYS
-
- ! initializes flags
ADIOS_FOR_FORWARD_ARRAYS = .false.
+ ADIOS_FOR_MPI_ARRAYS = .false.
! opens file Par_file
call open_parameter_file()
+ call read_value_logical(ADIOS_ENABLED, 'solver.ADIOS_ENABLED')
call read_value_logical(ADIOS_FOR_FORWARD_ARRAYS, &
'solver.ADIOS_FOR_FORWARD_ARRAYS')
+ call read_value_logical(ADIOS_FOR_MPI_ARRAYS, &
+ 'solver.ADIOS_FOR_MPI_ARRAYS')
call close_parameter_file()
- end subroutine read_adios_for_forward_arrays
+ end subroutine read_adios_parameters
+
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/specfem3D/Makefile.in
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/specfem3D/Makefile.in 2013-05-06 18:42:12 UTC (rev 21991)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/specfem3D/Makefile.in 2013-05-06 18:42:19 UTC (rev 21992)
@@ -249,11 +249,12 @@
# using ADIOS files
ADIOS_OBJECTS= \
+ $O/read_mesh_databases_adios.adios.o \
$O/save_forward_arrays_adios.adios.o \
$O/read_forward_arrays_adios.adios.o \
$O/write_specfem_adios_header.adios.o \
- $O/adios_manager.adios.o \
- $O/adios_helpers.adios.o
+ $O/adios_manager.shared_adios.o \
+ $O/adios_helpers.shared_adios.o
ADIOS_STUBS = \
$O/adios_empty_stubs.noadios.o
@@ -429,6 +430,11 @@
$O/%.noadios.o: %.f90
${FC} -c -o $@ $<
+$O/%.shared_adios.o: ${SHARED}/%.f90 ${SETUP}/constants.h
+ ${MPIFC} -c $(ADIOS_INC) $(FCFLAGS) $(MPI_INC) -o $@ $<
+
+$O/%.shared_adios.o: ${SHARED}/%.F90 ${SETUP}/constants.h
+ ${MPIFC} -c $(ADIOS_INC) $(FCFLAGS) $(MPI_INC) -o $@ $<
#######################################
###
Deleted: seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/specfem3D/adios_helpers.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/specfem3D/adios_helpers.f90 2013-05-06 18:42:12 UTC (rev 21991)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/specfem3D/adios_helpers.f90 2013-05-06 18:42:19 UTC (rev 21992)
@@ -1,249 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D G l o b e V e r s i o n 5 . 1
-! --------------------------------------------------
-!
-! Main authors: Dimitri Komatitsch and Jeroen Tromp
-! Princeton University, USA
-! and University of Pau / CNRS / INRIA, France
-! (c) Princeton University / California Institute of Technology and University of Pau / CNRS / INRIA
-! April 2011
-!
-! 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.
-!
-!=====================================================================
-
-
-!-------------------------------------------------------------------------------
-!> \file adios_helpers.f90
-!! \brief Helpers to set up adios features.
-!! \author MPBL
-!-------------------------------------------------------------------------------
-
-!-------------------------------------------------------------------------------
-!> Get the ADIOS error message from an adios error number if there is an error.
-!! \param adios_err The error code considered.
-subroutine check_adios_err(adios_err)
- use adios_read_mod
- use specfem_par
- implicit none
- integer, intent(in) :: adios_err
- character(len=1024) :: msg
-
- if (adios_err /= 0) then
- call adios_errmsg(msg)
- print *, "process: ", myrank, ", error: ", msg
- stop
- endif
-end subroutine check_adios_err
-
-
-!-------------------------------------------------------------------------------
-!> Define an ADIOS scalar double precision variable and autoincrement
-!! the adios group size by (8).
-!! \param adios_group The adios group where the variables belongs
-!! \param name The variable to be defined
-!! \param path The logical path structuring the data and containing
-!! the variable
-!! \param group_size_inc The inout adios group size to increment
-!! with the size of the variable
-subroutine define_adios_double_scalar (adios_group, name, path, group_size_inc)
- use adios_write_mod
- implicit none
- ! Arguments
- integer(kind=8), intent(in) :: adios_group
- character(len=*), intent(in) :: name, path
- integer(kind=8), intent(inout) :: group_size_inc
- ! Local Variables
- integer(kind=8) :: varid ! dummy variable, adios use var name
-
- ! adios: 6 == real(kind=8)
- call adios_define_var (adios_group, name, path, 6, "", "", "", varid)
- group_size_inc = group_size_inc + 8
-end subroutine define_adios_double_scalar
-
-!-------------------------------------------------------------------------------
-!> Define an ADIOS scalar integer variable and autoincrement the adios
-!! group size by (4).
-!! \param adios_group The adios group where the variables belongs
-!! \param name The variable to be defined
-!! \param path The logical path structuring the data and containing
-!! the variable
-!! \param group_size_inc The inout adios group size to increment
-!! with the size of the variable
-subroutine define_adios_integer_scalar (adios_group, name, path, group_size_inc)
- use adios_write_mod
- implicit none
- ! Arguments
- integer(kind=8), intent(in) :: adios_group
- character(len=*), intent(in) :: name, path
- integer(kind=8), intent(inout) :: group_size_inc
- ! Local Variables
- integer(kind=8) :: varid ! dummy variable, adios use var name
-
- ! adios: 2 == integer(kind=4)
- call adios_define_var (adios_group, name, path, adios_integer, "", "", "", varid)
- group_size_inc = group_size_inc + 4
-end subroutine define_adios_integer_scalar
-
-!-------------------------------------------------------------------------------
-!> Define an ADIOS scalar byte variable and autoincrement the adios
-!! group size by (1).
-!! \param adios_group The adios group where the variables belongs
-!! \param name The variable to be defined
-!! \param path The logical path structuring the data and containing
-!! the variable
-!! \param group_size_inc The inout adios group size to increment
-!! with the size of the variable
-subroutine define_adios_byte_scalar (adios_group, name, path, group_size_inc)
- use adios_write_mod
- implicit none
- ! Arguments
- integer(kind=8), intent(in) :: adios_group
- character(len=*), intent(in) :: name, path
- integer(kind=8), intent(inout) :: group_size_inc
- ! Local Variables
- integer(kind=8) :: varid ! dummy variable, adios use var name
-
- ! adios: 0 == byte == any_data_type(kind=1)
- call adios_define_var (adios_group, name, path, 0, "", "", "", varid)
- group_size_inc = group_size_inc + 1
-end subroutine define_adios_byte_scalar
-
-!-------------------------------------------------------------------------------
-!> Define a local ADIOS array of integers and autoincrement the adios
-!! group size by (4 * number of elements).
-!! \param adios_group The adios group where the variables belongs
-!! \param name The variable to be defined
-!! \param path The logical path structuring the data and containing
-!! the variable
-!! \param dim The number of elements in the 1D array. Required to
-!! correctly increment adios group size.
-!! \param dim_str The "stringified" version of dim. Needed by adios
-!! to define variables
-!! \param group_size_inc The inout adios group size to increment
-!! with the size of the variable
-subroutine define_adios_integer_local_array1D (adios_group, name, path, dim, dim_str, group_size_inc)
- use adios_write_mod
- implicit none
- ! Arguments
- integer(kind=8), intent(in) :: adios_group
- character(len=*), intent(in) :: name, path, dim_str
- integer(kind=8), intent(inout) :: group_size_inc
- integer, intent(in) :: dim
- ! Local Variables
- integer(kind=8) :: varid ! dummy variable, adios use var name
-
- ! adios: 2 == integer
- call adios_define_var (adios_group, name, path, 2, dim_str, "", "", varid)
- group_size_inc = group_size_inc + 4*dim
-end subroutine define_adios_integer_local_array1D
-
-!-------------------------------------------------------------------------------
-!> Define a local ADIOS array of doubles and autoincrement the adios
-!! group size by (8 * number of elements).
-!! \param adios_group The adios group where the variables belongs
-!! \param name The variable to be defined
-!! \param path The logical path structuring the data and containing
-!! the variable
-!! \param dim The number of elements in the 1D array. Required to
-!! correctly increment adios group size.
-!! \param dim_str The "stringified" version of dim. Needed by adios
-!! to define variables
-!! \param group_size_inc The inout adios group size to increment
-!! with the size of the variable
-subroutine define_adios_double_local_array1D (adios_group, name, path, dim, dim_str, group_size_inc)
- use adios_write_mod
- implicit none
- ! Arguments
- integer(kind=8), intent(in) :: adios_group
- character(len=*), intent(in) :: name, path, dim_str
- integer(kind=8), intent(inout) :: group_size_inc
- integer, intent(in) :: dim
- ! Local Variables
- integer(kind=8) :: varid ! dummy variable, adios use var name
-
- ! adios: 6 == real(kind=8)
- call adios_define_var (adios_group, name, path, 6, dim_str, "", "", varid)
- group_size_inc = group_size_inc + 8*dim
-end subroutine define_adios_double_local_array1D
-
-!-------------------------------------------------------------------------------
-!> Define a local ADIOS string and autoincrement the adios
-!! group size by (1 * string's length).
-!! \param adios_group The adios group where the variables belongs
-!! \param name The variable to be defined
-!! \param path The logical path structuring the data and containing
-!! the variable
-!! \param len The length of the string(number of character. in Fortran
-!! it does not include a final '\0' -- null -- character)
-!! \param group_size_inc The inout adios group size to increment
-!! with the size of the variable
-!! \note Adios string are scalar values counting for (1) byte. It is
-!! mandatory to increase the group size by the length of the
-!! string in order not to overlap 'data regions'.
-subroutine define_adios_string (adios_group, name, path, length, group_size_inc)
- use adios_write_mod
- implicit none
- ! Arguments
- integer(kind=8), intent(in) :: adios_group
- character(len=*), intent(in) :: name, path
- integer(kind=8), intent(inout) :: group_size_inc
- integer :: length
- ! Local Variables
- integer(kind=8) :: varid ! dummy variable, adios use var name
-
- ! adios: 9 == string
- call adios_define_var (adios_group, name, path, 9, "", "", "", varid)
- group_size_inc = group_size_inc + 1*length
-end subroutine define_adios_string
-
-!-------------------------------------------------------------------------------
-!> Define a global ADIOS 1D real array and autoincrement the adios
-!! group size.
-!! \param adios_group The adios group where the variables belongs
-!! \param array_name The variable to be defined. This is actually the path for
-!! ADIOS. The values are stored in array_name/array
-!! \param len The local dimension of the array.
-!! \param group_size_inc The inout adios group size to increment
-!! with the size of the variable
-!! \note This function define local, global and offset sizes as well as the
-!! array to store the values in.
-subroutine define_adios_global_real_1d_array(adios_group, array_name, &
- local_dim, group_size_inc)
- use adios_write_mod
- implicit none
- ! Parameters
- integer(kind=8), intent(in) :: adios_group
- character(len=*), intent(in) :: array_name
- integer, intent(in) :: local_dim
- integer(kind=8), intent(inout) :: group_size_inc
- ! Variables
- integer(kind=8) :: var_id
-
- call define_adios_integer_scalar (adios_group, "local_dim", array_name, &
- group_size_inc)
- call define_adios_integer_scalar (adios_group, "global_dim", array_name, &
- group_size_inc)
- call define_adios_integer_scalar (adios_group, "offset", array_name, &
- group_size_inc)
-! call adios_define_var(adios_group, "array", array_name, 6, &
-! "local_dim", "global_dim", "offset", var_id)
- call adios_define_var(adios_group, "array", array_name, 5, &
- array_name // "/local_dim", array_name // "/global_dim", &
- array_name // "/offset", var_id)
- group_size_inc = group_size_inc + local_dim*4
-end subroutine define_adios_global_real_1d_array
-
Deleted: seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/specfem3D/adios_manager.F90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/specfem3D/adios_manager.F90 2013-05-06 18:42:12 UTC (rev 21991)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/specfem3D/adios_manager.F90 2013-05-06 18:42:19 UTC (rev 21992)
@@ -1,49 +0,0 @@
-!=====================================================================
-!
-! S p e c f e m 3 D G l o b e V e r s i o n 5 . 1
-! --------------------------------------------------
-!
-! Main authors: Dimitri Komatitsch and Jeroen Tromp
-! Princeton University, USA
-! and University of Pau / CNRS / INRIA, France
-! (c) Princeton University / California Institute of Technology and University of Pau / CNRS / INRIA
-! April 2011
-!
-! 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.
-!
-!=====================================================================
-
-!> @brief Initialize ADIOS and setup the xml output file
-subroutine adios_setup()
- use adios_write_mod, only: adios_init
-
- implicit none
- integer :: adios_err, sizeMB
-
- call adios_init_noxml (adios_err);
- sizeMB = 200 ! TODO 200MB is surely not the right size for the adios buffer
- call adios_allocate_buffer (sizeMB , adios_err)
-end subroutine adios_setup
-
-!> @brief Finalize ADIOS. Must be called once everything is written down.
-subroutine adios_cleanup()
- use adios_write_mod, only: adios_finalize
- use specfem_par
-
- implicit none
- integer :: adios_err
-
- call adios_finalize (myrank, adios_err)
-end subroutine adios_cleanup
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/specfem3D/initialize_simulation.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/specfem3D/initialize_simulation.f90 2013-05-06 18:42:12 UTC (rev 21991)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/specfem3D/initialize_simulation.f90 2013-05-06 18:42:19 UTC (rev 21992)
@@ -108,8 +108,8 @@
! GPU_MODE: parameter is optional, may not be in the Par_file
call read_gpu_mode(GPU_MODE)
! ADIOS_ENABLED: parameter is optional, may not be in the Par_file
- call read_adios_enabled(ADIOS_ENABLED)
- call read_adios_for_forward_arrays(ADIOS_FOR_FORWARD_ARRAYS)
+ call read_adios_parameters(ADIOS_ENABLED, ADIOS_FOR_FORWARD_ARRAYS, &
+ ADIOS_FOR_MPI_ARRAYS)
endif
! distributes parameters from master to all processes
@@ -150,7 +150,8 @@
! broadcasts optional GPU_MODE
call broadcast_gpu_parameters(myrank,GPU_MODE)
! broadcasts optional ADIOS_ENABLED
- call broadcast_adios_parameters(myrank,ADIOS_ENABLED, ADIOS_FOR_FORWARD_ARRAYS)
+ call broadcast_adios_parameters(myrank,ADIOS_ENABLED, &
+ ADIOS_FOR_FORWARD_ARRAYS, ADIOS_FOR_MPI_ARRAYS)
! get the base pathname for output files
call get_value_string(OUTPUT_FILES, 'OUTPUT_FILES', 'OUTPUT_FILES')
@@ -319,7 +320,6 @@
if(myrank == 0 ) call initialize_vtkwindow(GPU_MODE)
endif
- ! save simulation info to ADIOS header
if (ADIOS_ENABLED) then
call adios_setup()
endif
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/specfem3D/read_forward_arrays_adios.F90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/specfem3D/read_forward_arrays_adios.F90 2013-05-06 18:42:12 UTC (rev 21991)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/specfem3D/read_forward_arrays_adios.F90 2013-05-06 18:42:19 UTC (rev 21992)
@@ -63,15 +63,15 @@
integer(kind=8), dimension(1) :: start, count
- file_name = "OUTPUT_FILES/dump_all_arrays_adios.bp"
+ file_name = trim(LOCAL_TMP_PATH) // "/dump_all_arrays_adios.bp"
call world_size(sizeprocs)
call MPI_Comm_dup (MPI_COMM_WORLD, comm, ierr)
call adios_read_init_method (ADIOS_READ_METHOD_BP, comm, &
"verbose=1", adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_read_open_file (adios_handle, file_name, 0, comm, ierr)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
local_dim = NDIM * NGLOB_CRUST_MANTLE
@@ -79,157 +79,157 @@
call adios_selection_boundingbox (sel , 1, start, count)
call adios_schedule_read(adios_handle, sel, "displ_crust_mantle/array", 0, 1, &
displ_crust_mantle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "veloc_crust_mantle/array", 0, 1, &
veloc_crust_mantle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "accel_crust_mantle/array", 0, 1, &
accel_crust_mantle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
! NOTE: perform reads before changing selection, otherwise it will segfault
call adios_perform_reads(adios_handle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
local_dim = NDIM * NGLOB_INNER_CORE
start(1) = local_dim*myrank; count(1) = local_dim
call adios_selection_boundingbox (sel , 1, start, count)
call adios_schedule_read(adios_handle, sel, "displ_inner_core/array", 0, 1, &
displ_inner_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "veloc_inner_core/array", 0, 1, &
veloc_inner_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "accel_inner_core/array", 0, 1, &
accel_inner_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_perform_reads(adios_handle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
local_dim = NGLOB_OUTER_CORE
start(1) = local_dim*myrank; count(1) = local_dim
call adios_selection_boundingbox (sel , 1, start, count)
call adios_schedule_read(adios_handle, sel, "displ_outer_core/array", 0, 1, &
displ_outer_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "veloc_outer_core/array", 0, 1, &
veloc_outer_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "accel_outer_core/array", 0, 1, &
accel_outer_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_perform_reads(adios_handle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
local_dim = NGLLX * NGLLY * NGLLZ * NSPEC_CRUST_MANTLE_STR_OR_ATT
start(1) = local_dim*myrank; count(1) = local_dim
call adios_selection_boundingbox (sel , 1, start, count)
call adios_schedule_read(adios_handle, sel, "epsilondev_xx_crust_mantle/array",&
0, 1, epsilondev_xx_crust_mantle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "epsilondev_yy_crust_mantle/array",&
0, 1, epsilondev_yy_crust_mantle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "epsilondev_xy_crust_mantle/array",&
0, 1, epsilondev_xy_crust_mantle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "epsilondev_xz_crust_mantle/array",&
0, 1, epsilondev_xz_crust_mantle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "epsilondev_yz_crust_mantle/array",&
0, 1, epsilondev_yz_crust_mantle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_perform_reads(adios_handle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
local_dim = NGLLX * NGLLY * NGLLZ * NSPEC_INNER_CORE_STR_OR_ATT
start(1) = local_dim*myrank; count(1) = local_dim
call adios_selection_boundingbox (sel , 1, start, count)
call adios_schedule_read(adios_handle, sel, "epsilondev_xx_inner_core/array",&
0, 1, epsilondev_xx_inner_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "epsilondev_yy_inner_core/array",&
0, 1, epsilondev_yy_inner_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "epsilondev_xy_inner_core/array",&
0, 1, epsilondev_xy_inner_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "epsilondev_xz_inner_core/array",&
0, 1, epsilondev_xz_inner_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "epsilondev_yz_inner_core/array",&
0, 1, epsilondev_yz_inner_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_perform_reads(adios_handle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
local_dim = NGLLX * NGLLY * NGLLZ * NSPEC_OUTER_CORE_ROTATION
start(1) = local_dim*myrank; count(1) = local_dim
call adios_selection_boundingbox (sel , 1, start, count)
call adios_schedule_read(adios_handle, sel, "A_array_rotation/array", 0, 1, &
A_array_rotation, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "B_array_rotation/array", 0, 1, &
B_array_rotation, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_perform_reads(adios_handle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
local_dim = N_SLS*NGLLX*NGLLY*NGLLZ*NSPEC_CRUST_MANTLE_ATTENUAT
start(1) = local_dim*myrank; count(1) = local_dim
call adios_selection_boundingbox (sel , 1, start, count)
call adios_schedule_read(adios_handle, sel, "R_xx_crust_mantle/array", 0, 1, &
R_xx_crust_mantle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "R_yy_crust_mantle/array", 0, 1, &
R_yy_crust_mantle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "R_xy_crust_mantle/array", 0, 1, &
R_xy_crust_mantle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "R_xz_crust_mantle/array", 0, 1, &
R_xz_crust_mantle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "R_yz_crust_mantle/array", 0, 1, &
R_yz_crust_mantle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_perform_reads(adios_handle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
local_dim = N_SLS*NGLLX*NGLLY*NGLLZ*NSPEC_INNER_CORE_ATTENUATION
start(1) = local_dim*myrank; count(1) = local_dim
call adios_selection_boundingbox (sel , 1, start, count)
call adios_schedule_read(adios_handle, sel, "R_xx_inner_core/array", 0, 1, &
R_xx_inner_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "R_yy_inner_core/array", 0, 1, &
R_yy_inner_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "R_xy_inner_core/array", 0, 1, &
R_xy_inner_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "R_xz_inner_core/array", 0, 1, &
R_xz_inner_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "R_yz_inner_core/array", 0, 1, &
R_yz_inner_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_perform_reads(adios_handle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
! Close ADIOS handler to the restart file.
call adios_selection_delete(sel)
call adios_read_close(adios_handle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_read_finalize_method(ADIOS_READ_METHOD_BP, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call MPI_Barrier(comm, ierr)
@@ -256,9 +256,6 @@
character(len=150) :: file_name
integer(kind=8) :: group_size_inc
integer :: local_dim, global_dim, offset
-! integer, parameter :: num_arrays = 9 ! TODO correct number
-! character(len=256), dimension(num_arrays) :: local_dims1, local_dims2, &
-! global_dims1, global_dims2, offsets1, offsets2, array_name
! ADIOS variables
integer :: adios_err
integer(kind=8) :: adios_group, adios_handle, varid, sel
@@ -268,15 +265,15 @@
integer(kind=8), dimension(1) :: start, count
- file_name = "OUTPUT_FILES/save_forward_arrays.bp"
+ file_name = trim(LOCAL_TMP_PATH) // "/save_forward_arrays.bp"
call world_size(sizeprocs)
call MPI_Comm_dup (MPI_COMM_WORLD, comm, ierr)
call adios_read_init_method (ADIOS_READ_METHOD_BP, comm, &
"verbose=1", adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_read_open_file (adios_handle, file_name, 0, comm, ierr)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
local_dim = NDIM * NGLOB_CRUST_MANTLE
@@ -284,93 +281,93 @@
call adios_selection_boundingbox (sel , 1, start, count)
call adios_schedule_read(adios_handle, sel, "displ_crust_mantle/array", 0, 1, &
b_displ_crust_mantle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "veloc_crust_mantle/array", 0, 1, &
b_veloc_crust_mantle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "accel_crust_mantle/array", 0, 1, &
b_accel_crust_mantle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
! NOTE: perform reads before changing selection, otherwise it will segfault
call adios_perform_reads(adios_handle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
local_dim = NDIM * NGLOB_INNER_CORE
start(1) = local_dim*myrank; count(1) = local_dim
call adios_selection_boundingbox (sel , 1, start, count)
call adios_schedule_read(adios_handle, sel, "displ_inner_core/array", 0, 1, &
b_displ_inner_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "veloc_inner_core/array", 0, 1, &
b_veloc_inner_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "accel_inner_core/array", 0, 1, &
b_accel_inner_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_perform_reads(adios_handle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
local_dim = NGLOB_OUTER_CORE
start(1) = local_dim*myrank; count(1) = local_dim
call adios_selection_boundingbox (sel , 1, start, count)
call adios_schedule_read(adios_handle, sel, "displ_outer_core/array", 0, 1, &
b_displ_outer_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "veloc_outer_core/array", 0, 1, &
b_veloc_outer_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "accel_outer_core/array", 0, 1, &
b_accel_outer_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_perform_reads(adios_handle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
local_dim = NGLLX * NGLLY * NGLLZ * NSPEC_CRUST_MANTLE_STR_OR_ATT
start(1) = local_dim*myrank; count(1) = local_dim
call adios_selection_boundingbox (sel , 1, start, count)
call adios_schedule_read(adios_handle, sel, "epsilondev_xx_crust_mantle/array",&
0, 1, b_epsilondev_xx_crust_mantle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "epsilondev_yy_crust_mantle/array",&
0, 1, b_epsilondev_yy_crust_mantle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "epsilondev_xy_crust_mantle/array",&
0, 1, b_epsilondev_xy_crust_mantle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "epsilondev_xz_crust_mantle/array",&
0, 1, b_epsilondev_xz_crust_mantle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "epsilondev_yz_crust_mantle/array",&
0, 1, b_epsilondev_yz_crust_mantle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_perform_reads(adios_handle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
local_dim = NGLLX * NGLLY * NGLLZ * NSPEC_INNER_CORE_STR_OR_ATT
start(1) = local_dim*myrank; count(1) = local_dim
call adios_selection_boundingbox (sel , 1, start, count)
call adios_schedule_read(adios_handle, sel, "epsilondev_xx_inner_core/array",&
0, 1, b_epsilondev_xx_inner_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "epsilondev_yy_inner_core/array",&
0, 1, b_epsilondev_yy_inner_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "epsilondev_xy_inner_core/array",&
0, 1, b_epsilondev_xy_inner_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "epsilondev_xz_inner_core/array",&
0, 1, b_epsilondev_xz_inner_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "epsilondev_yz_inner_core/array",&
0, 1, b_epsilondev_yz_inner_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_perform_reads(adios_handle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
if (ROTATION_VAL) then
local_dim = NGLLX * NGLLY * NGLLZ * NSPEC_OUTER_CORE_ROTATION
@@ -378,13 +375,13 @@
call adios_selection_boundingbox (sel , 1, start, count)
call adios_schedule_read(adios_handle, sel, "A_array_rotation/array", 0, 1, &
b_A_array_rotation, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "B_array_rotation/array", 0, 1, &
b_B_array_rotation, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_perform_reads(adios_handle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
endif
if (ATTENUATION_VAL) then
@@ -393,52 +390,52 @@
call adios_selection_boundingbox (sel , 1, start, count)
call adios_schedule_read(adios_handle, sel, "R_xx_crust_mantle/array", 0, 1, &
b_R_xx_crust_mantle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "R_yy_crust_mantle/array", 0, 1, &
b_R_yy_crust_mantle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "R_xy_crust_mantle/array", 0, 1, &
b_R_xy_crust_mantle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "R_xz_crust_mantle/array", 0, 1, &
b_R_xz_crust_mantle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "R_yz_crust_mantle/array", 0, 1, &
b_R_yz_crust_mantle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_perform_reads(adios_handle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
local_dim = N_SLS*NGLLX*NGLLY*NGLLZ*NSPEC_INNER_CORE_ATTENUATION
start(1) = local_dim*myrank; count(1) = local_dim
call adios_selection_boundingbox (sel , 1, start, count)
call adios_schedule_read(adios_handle, sel, "R_xx_inner_core/array", 0, 1, &
b_R_xx_inner_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "R_yy_inner_core/array", 0, 1, &
b_R_yy_inner_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "R_xy_inner_core/array", 0, 1, &
b_R_xy_inner_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "R_xz_inner_core/array", 0, 1, &
b_R_xz_inner_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_schedule_read(adios_handle, sel, "R_yz_inner_core/array", 0, 1, &
b_R_yz_inner_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_perform_reads(adios_handle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
endif
! Close ADIOS handler to the restart file.
call adios_selection_delete(sel)
call adios_read_close(adios_handle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_read_finalize_method(ADIOS_READ_METHOD_BP, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call MPI_Barrier(comm, ierr)
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/specfem3D/read_mesh_databases.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/specfem3D/read_mesh_databases.f90 2013-05-06 18:42:12 UTC (rev 21991)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/specfem3D/read_mesh_databases.f90 2013-05-06 18:42:19 UTC (rev 21992)
@@ -636,7 +636,11 @@
! read MPI interfaces from file
! crust mantle
- call read_mesh_databases_MPI_CM()
+ if (ADIOS_FOR_MPI_ARRAYS) then
+ call read_mesh_databases_MPI_CM_adios()
+ else
+ call read_mesh_databases_MPI_CM()
+ endif
allocate(buffer_send_vector_crust_mantle(NDIM,max_nibool_interfaces_cm,num_interfaces_crust_mantle), &
buffer_recv_vector_crust_mantle(NDIM,max_nibool_interfaces_cm,num_interfaces_crust_mantle), &
Copied: seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/specfem3D/read_mesh_databases_adios.f90 (from rev 21991, seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/specfem3D/read_mesh_databases.f90)
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/specfem3D/read_mesh_databases_adios.f90 (rev 0)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/specfem3D/read_mesh_databases_adios.f90 2013-05-06 18:42:19 UTC (rev 21992)
@@ -0,0 +1,946 @@
+!=====================================================================
+!
+! S p e c f e m 3 D G l o b e V e r s i o n 5 . 1
+! --------------------------------------------------
+!
+! Main authors: Dimitri Komatitsch and Jeroen Tromp
+! Princeton University, USA
+! and University of Pau / CNRS / INRIA, France
+! (c) Princeton University / California Institute of Technology and University of Pau / CNRS / INRIA
+! April 2011
+!
+! 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.
+!
+!=====================================================================
+
+!-------------------------------------------------------------------------------------------------
+
+ subroutine read_mesh_databases_CM_adios()
+
+! mesh for CRUST MANTLE region
+
+ use specfem_par
+ use specfem_par_crustmantle
+ implicit none
+
+ ! local parameters
+ integer :: nspec_iso,nspec_tiso,nspec_ani
+ logical :: READ_KAPPA_MU,READ_TISO
+ ! dummy array that does not need to be actually read
+ integer, dimension(:),allocatable :: dummy_idoubling
+ integer :: ierr
+
+ ! crust and mantle
+
+ if(ANISOTROPIC_3D_MANTLE_VAL) then
+ READ_KAPPA_MU = .false.
+ READ_TISO = .false.
+ nspec_iso = NSPECMAX_ISO_MANTLE ! 1
+ nspec_tiso = NSPECMAX_TISO_MANTLE ! 1
+ nspec_ani = NSPEC_CRUST_MANTLE
+ else
+ READ_KAPPA_MU = .true.
+ nspec_iso = NSPEC_CRUST_MANTLE
+ if(TRANSVERSE_ISOTROPY_VAL) then
+ nspec_tiso = NSPECMAX_TISO_MANTLE
+ else
+ nspec_tiso = 1
+ endif
+ nspec_ani = NSPECMAX_ANISO_MANTLE ! 1
+ READ_TISO = .true.
+ endif
+
+ ! sets number of top elements for surface movies & noise tomography
+ NSPEC_TOP = NSPEC2D_TOP(IREGION_CRUST_MANTLE)
+
+ ! allocates mass matrices in this slice (will be fully assembled in the solver)
+ !
+ ! in the case of stacey boundary conditions, add C*deltat/2 contribution to the mass matrix
+ ! on Stacey edges for the crust_mantle and outer_core regions but not for the inner_core region
+ ! thus the mass matrix must be replaced by three mass matrices including the "C" damping matrix
+ !
+ ! if absorbing_conditions are not set or if NCHUNKS=6, only one mass matrix is needed
+ ! for the sake of performance, only "rmassz" array will be filled and "rmassx" & "rmassy" will be obsolete
+ if(NCHUNKS_VAL /= 6 .and. ABSORBING_CONDITIONS) then
+ NGLOB_XY_CM = NGLOB_CRUST_MANTLE
+ else
+ NGLOB_XY_CM = 1
+ endif
+
+ ! allocates dummy array
+ allocate(dummy_idoubling(NSPEC_CRUST_MANTLE),stat=ierr)
+ if( ierr /= 0 ) call exit_mpi(myrank,'error allocating dummy idoubling in crust_mantle')
+
+ ! allocates mass matrices
+ allocate(rmassx_crust_mantle(NGLOB_XY_CM), &
+ rmassy_crust_mantle(NGLOB_XY_CM),stat=ierr)
+ if(ierr /= 0) stop 'error allocating dummy rmassx, rmassy in crust_mantle'
+ allocate(rmassz_crust_mantle(NGLOB_CRUST_MANTLE),stat=ierr)
+ if(ierr /= 0) stop 'error allocating rmassz in crust_mantle'
+
+ ! reads databases file
+ call read_arrays_solver(IREGION_CRUST_MANTLE,myrank, &
+ NSPEC_CRUST_MANTLE,NGLOB_CRUST_MANTLE,NGLOB_XY_CM, &
+ nspec_iso,nspec_tiso,nspec_ani, &
+ rho_vp_crust_mantle,rho_vs_crust_mantle, &
+ xstore_crust_mantle,ystore_crust_mantle,zstore_crust_mantle, &
+ xix_crust_mantle,xiy_crust_mantle,xiz_crust_mantle, &
+ etax_crust_mantle,etay_crust_mantle,etaz_crust_mantle, &
+ gammax_crust_mantle,gammay_crust_mantle,gammaz_crust_mantle, &
+ rhostore_crust_mantle,kappavstore_crust_mantle,muvstore_crust_mantle, &
+ kappahstore_crust_mantle,muhstore_crust_mantle,eta_anisostore_crust_mantle, &
+ c11store_crust_mantle,c12store_crust_mantle,c13store_crust_mantle, &
+ c14store_crust_mantle,c15store_crust_mantle,c16store_crust_mantle, &
+ c22store_crust_mantle,c23store_crust_mantle,c24store_crust_mantle, &
+ c25store_crust_mantle,c26store_crust_mantle,c33store_crust_mantle, &
+ c34store_crust_mantle,c35store_crust_mantle,c36store_crust_mantle, &
+ c44store_crust_mantle,c45store_crust_mantle,c46store_crust_mantle, &
+ c55store_crust_mantle,c56store_crust_mantle,c66store_crust_mantle, &
+ ibool_crust_mantle,dummy_idoubling,ispec_is_tiso_crust_mantle, &
+ rmassx_crust_mantle,rmassy_crust_mantle,rmassz_crust_mantle,rmass_ocean_load, &
+ READ_KAPPA_MU,READ_TISO, &
+ ABSORBING_CONDITIONS,LOCAL_PATH)
+
+ ! check that the number of points in this slice is correct
+ if(minval(ibool_crust_mantle(:,:,:,:)) /= 1 .or. &
+ maxval(ibool_crust_mantle(:,:,:,:)) /= NGLOB_CRUST_MANTLE) &
+ call exit_MPI(myrank,'incorrect global numbering: iboolmax does not equal nglob in crust and mantle')
+
+ deallocate(dummy_idoubling)
+
+ end subroutine read_mesh_databases_CM_adios
+
+!
+!-------------------------------------------------------------------------------------------------
+!
+
+ subroutine read_mesh_databases_OC_adios()
+
+! mesh for OUTER CORE region
+
+ use specfem_par
+ use specfem_par_outercore
+ implicit none
+
+ ! local parameters
+ integer :: nspec_iso,nspec_tiso,nspec_ani,NGLOB_XY_dummy
+ logical :: READ_KAPPA_MU,READ_TISO
+ integer :: ierr
+
+ ! dummy array that does not need to be actually read
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,1) :: dummy_array
+ real(kind=CUSTOM_REAL), dimension(:), allocatable :: dummy_rmass
+
+ logical, dimension(:), allocatable :: dummy_ispec_is_tiso
+ integer, dimension(:), allocatable :: dummy_idoubling_outer_core
+
+ ! outer core (no anisotropy nor S velocity)
+ ! rmass_ocean_load is not used in this routine because it is meaningless in the outer core
+ READ_KAPPA_MU = .false.
+ READ_TISO = .false.
+ nspec_iso = NSPEC_OUTER_CORE
+ nspec_tiso = 1
+ nspec_ani = 1
+
+ ! dummy allocation
+ NGLOB_XY_dummy = 1
+
+ allocate(dummy_rmass(NGLOB_XY_dummy), &
+ dummy_ispec_is_tiso(NSPEC_OUTER_CORE), &
+ dummy_idoubling_outer_core(NSPEC_OUTER_CORE), &
+ stat=ierr)
+ if(ierr /= 0) stop 'error allocating dummy rmass and dummy ispec/idoubling in outer core'
+
+ ! allocates mass matrices in this slice (will be fully assembled in the solver)
+ !
+ ! in the case of stacey boundary conditions, add C*deltat/2 contribution to the mass matrix
+ ! on Stacey edges for the crust_mantle and outer_core regions but not for the inner_core region
+ ! thus the mass matrix must be replaced by three mass matrices including the "C" damping matrix
+ !
+ ! if absorbing_conditions are not set or if NCHUNKS=6, only one mass matrix is needed
+ ! for the sake of performance, only "rmassz" array will be filled and "rmassx" & "rmassy" will be obsolete
+ allocate(rmass_outer_core(NGLOB_OUTER_CORE),stat=ierr)
+ if(ierr /= 0) stop 'error allocating rmass in outer core'
+
+ call read_arrays_solver(IREGION_OUTER_CORE,myrank, &
+ NSPEC_OUTER_CORE,NGLOB_OUTER_CORE,NGLOB_XY_dummy, &
+ nspec_iso,nspec_tiso,nspec_ani, &
+ vp_outer_core,dummy_array, &
+ xstore_outer_core,ystore_outer_core,zstore_outer_core, &
+ xix_outer_core,xiy_outer_core,xiz_outer_core, &
+ etax_outer_core,etay_outer_core,etaz_outer_core, &
+ gammax_outer_core,gammay_outer_core,gammaz_outer_core, &
+ rhostore_outer_core,kappavstore_outer_core,dummy_array, &
+ dummy_array,dummy_array,dummy_array, &
+ dummy_array,dummy_array,dummy_array, &
+ dummy_array,dummy_array,dummy_array, &
+ dummy_array,dummy_array,dummy_array, &
+ dummy_array,dummy_array,dummy_array, &
+ dummy_array,dummy_array,dummy_array, &
+ dummy_array,dummy_array,dummy_array, &
+ dummy_array,dummy_array,dummy_array, &
+ ibool_outer_core,dummy_idoubling_outer_core,dummy_ispec_is_tiso, &
+ dummy_rmass,dummy_rmass,rmass_outer_core,rmass_ocean_load, &
+ READ_KAPPA_MU,READ_TISO, &
+ ABSORBING_CONDITIONS,LOCAL_PATH)
+
+ deallocate(dummy_idoubling_outer_core,dummy_ispec_is_tiso,dummy_rmass)
+
+ ! check that the number of points in this slice is correct
+ if(minval(ibool_outer_core(:,:,:,:)) /= 1 .or. &
+ maxval(ibool_outer_core(:,:,:,:)) /= NGLOB_OUTER_CORE) &
+ call exit_MPI(myrank,'incorrect global numbering: iboolmax does not equal nglob in outer core')
+
+ end subroutine read_mesh_databases_OC_adios
+
+!
+!-------------------------------------------------------------------------------------------------
+!
+
+ subroutine read_mesh_databases_IC_adios()
+
+! mesh for INNER CORE region
+
+ use specfem_par
+ use specfem_par_innercore
+ implicit none
+
+ ! local parameters
+ integer :: nspec_iso,nspec_tiso,nspec_ani,NGLOB_XY_dummy
+ logical :: READ_KAPPA_MU,READ_TISO
+ integer :: ierr
+
+ ! dummy array that does not need to be actually read
+ real(kind=CUSTOM_REAL), dimension(NGLLX,NGLLY,NGLLZ,1) :: dummy_array
+ real(kind=CUSTOM_REAL), dimension(:), allocatable :: dummy_rmass
+ logical, dimension(:),allocatable:: dummy_ispec_is_tiso
+
+ ! inner core (no anisotropy)
+ ! rmass_ocean_load is not used in this routine because it is meaningless in the inner core
+ READ_KAPPA_MU = .true. ! (muvstore needed for attenuation)
+ READ_TISO = .false.
+ nspec_iso = NSPEC_INNER_CORE
+ nspec_tiso = 1
+ if(ANISOTROPIC_INNER_CORE_VAL) then
+ nspec_ani = NSPEC_INNER_CORE
+ else
+ nspec_ani = 1
+ endif
+
+ ! dummy allocation
+ NGLOB_XY_dummy = 1
+
+ allocate(dummy_rmass(NGLOB_XY_dummy), &
+ dummy_ispec_is_tiso(NSPEC_INNER_CORE), &
+ stat=ierr)
+ if(ierr /= 0) stop 'error allocating dummy rmass and dummy ispec in inner core'
+
+ ! allocates mass matrices in this slice (will be fully assembled in the solver)
+ !
+ ! in the case of stacey boundary conditions, add C*deltat/2 contribution to the mass matrix
+ ! on Stacey edges for the crust_mantle and outer_core regions but not for the inner_core region
+ ! thus the mass matrix must be replaced by three mass matrices including the "C" damping matrix
+ !
+ ! if absorbing_conditions are not set or if NCHUNKS=6, only one mass matrix is needed
+ ! for the sake of performance, only "rmassz" array will be filled and "rmassx" & "rmassy" will be obsolete
+ allocate(rmass_inner_core(NGLOB_INNER_CORE),stat=ierr)
+ if(ierr /= 0) stop 'error allocating rmass in inner core'
+
+ call read_arrays_solver(IREGION_INNER_CORE,myrank, &
+ NSPEC_INNER_CORE,NGLOB_INNER_CORE,NGLOB_XY_dummy, &
+ nspec_iso,nspec_tiso,nspec_ani, &
+ dummy_array,dummy_array, &
+ xstore_inner_core,ystore_inner_core,zstore_inner_core, &
+ xix_inner_core,xiy_inner_core,xiz_inner_core, &
+ etax_inner_core,etay_inner_core,etaz_inner_core, &
+ gammax_inner_core,gammay_inner_core,gammaz_inner_core, &
+ rhostore_inner_core,kappavstore_inner_core,muvstore_inner_core, &
+ dummy_array,dummy_array,dummy_array, &
+ c11store_inner_core,c12store_inner_core,c13store_inner_core, &
+ dummy_array,dummy_array,dummy_array, &
+ dummy_array,dummy_array,dummy_array, &
+ dummy_array,dummy_array,c33store_inner_core, &
+ dummy_array,dummy_array,dummy_array, &
+ c44store_inner_core,dummy_array,dummy_array, &
+ dummy_array,dummy_array,dummy_array, &
+ ibool_inner_core,idoubling_inner_core,dummy_ispec_is_tiso, &
+ dummy_rmass,dummy_rmass,rmass_inner_core,rmass_ocean_load, &
+ READ_KAPPA_MU,READ_TISO, &
+ ABSORBING_CONDITIONS,LOCAL_PATH)
+
+ deallocate(dummy_ispec_is_tiso,dummy_rmass)
+
+ ! check that the number of points in this slice is correct
+ if(minval(ibool_inner_core(:,:,:,:)) /= 1 .or. maxval(ibool_inner_core(:,:,:,:)) /= NGLOB_INNER_CORE) &
+ call exit_MPI(myrank,'incorrect global numbering: iboolmax does not equal nglob in inner core')
+
+ end subroutine read_mesh_databases_IC_adios
+
+!
+!-------------------------------------------------------------------------------------------------
+!
+
+ subroutine read_mesh_databases_coupling_adios()
+
+! to couple mantle with outer core
+
+ use specfem_par
+ use specfem_par_crustmantle
+ use specfem_par_innercore
+ use specfem_par_outercore
+
+ implicit none
+
+ include 'mpif.h'
+
+ ! local parameters
+ integer :: njunk1,njunk2,njunk3
+ integer :: ierr
+
+ ! crust and mantle
+ ! create name of database
+ call create_name_database(prname,myrank,IREGION_CRUST_MANTLE,LOCAL_PATH)
+
+ ! Stacey put back
+ open(unit=27,file=prname(1:len_trim(prname))//'boundary.bin', &
+ status='old',form='unformatted',action='read',iostat=ierr)
+ if( ierr /= 0 ) call exit_mpi(myrank,'error opening crust_mantle boundary.bin file')
+
+ read(27) nspec2D_xmin_crust_mantle
+ read(27) nspec2D_xmax_crust_mantle
+ read(27) nspec2D_ymin_crust_mantle
+ read(27) nspec2D_ymax_crust_mantle
+ read(27) njunk1
+ read(27) njunk2
+
+! boundary parameters
+ read(27) ibelm_xmin_crust_mantle
+ read(27) ibelm_xmax_crust_mantle
+ read(27) ibelm_ymin_crust_mantle
+ read(27) ibelm_ymax_crust_mantle
+ read(27) ibelm_bottom_crust_mantle
+ read(27) ibelm_top_crust_mantle
+
+ read(27) normal_xmin_crust_mantle
+ read(27) normal_xmax_crust_mantle
+ read(27) normal_ymin_crust_mantle
+ read(27) normal_ymax_crust_mantle
+ read(27) normal_bottom_crust_mantle
+ read(27) normal_top_crust_mantle
+
+ read(27) jacobian2D_xmin_crust_mantle
+ read(27) jacobian2D_xmax_crust_mantle
+ read(27) jacobian2D_ymin_crust_mantle
+ read(27) jacobian2D_ymax_crust_mantle
+ read(27) jacobian2D_bottom_crust_mantle
+ read(27) jacobian2D_top_crust_mantle
+ close(27)
+
+
+ ! read parameters to couple fluid and solid regions
+ !
+ ! outer core
+
+ ! create name of database
+ call create_name_database(prname,myrank,IREGION_OUTER_CORE,LOCAL_PATH)
+
+ ! boundary parameters
+
+ ! Stacey put back
+ open(unit=27,file=prname(1:len_trim(prname))//'boundary.bin', &
+ status='old',form='unformatted',action='read',iostat=ierr)
+ if( ierr /= 0 ) call exit_mpi(myrank,'error opening outer_core boundary.bin file')
+
+ read(27) nspec2D_xmin_outer_core
+ read(27) nspec2D_xmax_outer_core
+ read(27) nspec2D_ymin_outer_core
+ read(27) nspec2D_ymax_outer_core
+ read(27) njunk1
+ read(27) njunk2
+
+ nspec2D_zmin_outer_core = NSPEC2D_BOTTOM(IREGION_OUTER_CORE)
+
+ read(27) ibelm_xmin_outer_core
+ read(27) ibelm_xmax_outer_core
+ read(27) ibelm_ymin_outer_core
+ read(27) ibelm_ymax_outer_core
+ read(27) ibelm_bottom_outer_core
+ read(27) ibelm_top_outer_core
+
+ read(27) normal_xmin_outer_core
+ read(27) normal_xmax_outer_core
+ read(27) normal_ymin_outer_core
+ read(27) normal_ymax_outer_core
+ read(27) normal_bottom_outer_core
+ read(27) normal_top_outer_core
+
+ read(27) jacobian2D_xmin_outer_core
+ read(27) jacobian2D_xmax_outer_core
+ read(27) jacobian2D_ymin_outer_core
+ read(27) jacobian2D_ymax_outer_core
+ read(27) jacobian2D_bottom_outer_core
+ read(27) jacobian2D_top_outer_core
+ close(27)
+
+
+ !
+ ! inner core
+ !
+
+ ! create name of database
+ call create_name_database(prname,myrank,IREGION_INNER_CORE,LOCAL_PATH)
+
+ ! read info for vertical edges for central cube matching in inner core
+ open(unit=27,file=prname(1:len_trim(prname))//'boundary.bin', &
+ status='old',form='unformatted',action='read',iostat=ierr)
+ if( ierr /= 0 ) call exit_mpi(myrank,'error opening inner_core boundary.bin file')
+
+ read(27) nspec2D_xmin_inner_core
+ read(27) nspec2D_xmax_inner_core
+ read(27) nspec2D_ymin_inner_core
+ read(27) nspec2D_ymax_inner_core
+ read(27) njunk1
+ read(27) njunk2
+
+ ! boundary parameters
+ read(27) ibelm_xmin_inner_core
+ read(27) ibelm_xmax_inner_core
+ read(27) ibelm_ymin_inner_core
+ read(27) ibelm_ymax_inner_core
+ read(27) ibelm_bottom_inner_core
+ read(27) ibelm_top_inner_core
+ close(27)
+
+
+ ! -- Boundary Mesh for crust and mantle ---
+ if (SAVE_BOUNDARY_MESH .and. SIMULATION_TYPE == 3) then
+
+ call create_name_database(prname,myrank,IREGION_CRUST_MANTLE,LOCAL_PATH)
+
+ open(unit=27,file=prname(1:len_trim(prname))//'boundary_disc.bin', &
+ status='old',form='unformatted',action='read',iostat=ierr)
+ if( ierr /= 0 ) call exit_mpi(myrank,'error opening boundary_disc.bin file')
+
+ read(27) njunk1,njunk2,njunk3
+ if (njunk1 /= NSPEC2D_MOHO .and. njunk2 /= NSPEC2D_400 .and. njunk3 /= NSPEC2D_670) &
+ call exit_mpi(myrank, 'Error reading ibelm_disc.bin file')
+ read(27) ibelm_moho_top
+ read(27) ibelm_moho_bot
+ read(27) ibelm_400_top
+ read(27) ibelm_400_bot
+ read(27) ibelm_670_top
+ read(27) ibelm_670_bot
+ read(27) normal_moho
+ read(27) normal_400
+ read(27) normal_670
+ close(27)
+
+ k_top = 1
+ k_bot = NGLLZ
+
+ ! initialization
+ moho_kl = 0.; d400_kl = 0.; d670_kl = 0.; cmb_kl = 0.; icb_kl = 0.
+ endif
+
+ end subroutine read_mesh_databases_coupling_adios
+
+!
+!-------------------------------------------------------------------------------------------------
+!
+
+ subroutine read_mesh_databases_addressing_adios()
+
+ use specfem_par
+ use specfem_par_crustmantle
+ use specfem_par_innercore
+ use specfem_par_outercore
+
+ implicit none
+
+ include 'mpif.h'
+
+ ! local parameters
+ integer, dimension(NCHUNKS_VAL,0:NPROC_XI_VAL-1,0:NPROC_ETA_VAL-1) :: addressing
+ integer, dimension(0:NPROCTOT_VAL-1) :: ichunk_slice,iproc_xi_slice,iproc_eta_slice
+ integer :: ierr,iproc,iproc_read,iproc_xi,iproc_eta
+
+ ! open file with global slice number addressing
+ if(myrank == 0) then
+ open(unit=IIN,file=trim(OUTPUT_FILES)//'/addressing.txt',status='old',action='read',iostat=ierr)
+ if( ierr /= 0 ) call exit_mpi(myrank,'error opening addressing.txt')
+
+ do iproc = 0,NPROCTOT_VAL-1
+ read(IIN,*) iproc_read,ichunk,iproc_xi,iproc_eta
+
+ if(iproc_read /= iproc) call exit_MPI(myrank,'incorrect slice number read')
+
+ addressing(ichunk,iproc_xi,iproc_eta) = iproc
+ ichunk_slice(iproc) = ichunk
+ iproc_xi_slice(iproc) = iproc_xi
+ iproc_eta_slice(iproc) = iproc_eta
+ enddo
+ close(IIN)
+ endif
+
+ ! broadcast the information read on the master to the nodes
+ call MPI_BCAST(addressing,NCHUNKS_VAL*NPROC_XI_VAL*NPROC_ETA_VAL,MPI_INTEGER,0,MPI_COMM_WORLD,ierr)
+ call MPI_BCAST(ichunk_slice,NPROCTOT_VAL,MPI_INTEGER,0,MPI_COMM_WORLD,ierr)
+ call MPI_BCAST(iproc_xi_slice,NPROCTOT_VAL,MPI_INTEGER,0,MPI_COMM_WORLD,ierr)
+ call MPI_BCAST(iproc_eta_slice,NPROCTOT_VAL,MPI_INTEGER,0,MPI_COMM_WORLD,ierr)
+
+ ! output a topology map of slices - fix 20x by nproc
+ if (myrank == 0 ) then
+ if( NCHUNKS_VAL == 6 .and. NPROCTOT_VAL < 1000 ) then
+ write(IMAIN,*) 'Spatial distribution of the slices'
+ do iproc_xi = NPROC_XI_VAL-1, 0, -1
+ write(IMAIN,'(20x)',advance='no')
+ do iproc_eta = NPROC_ETA_VAL -1, 0, -1
+ ichunk = CHUNK_AB
+ write(IMAIN,'(i5)',advance='no') addressing(ichunk,iproc_xi,iproc_eta)
+ enddo
+ write(IMAIN,'(1x)',advance='yes')
+ enddo
+ write(IMAIN, *) ' '
+ do iproc_xi = NPROC_XI_VAL-1, 0, -1
+ write(IMAIN,'(1x)',advance='no')
+ do iproc_eta = NPROC_ETA_VAL -1, 0, -1
+ ichunk = CHUNK_BC
+ write(IMAIN,'(i5)',advance='no') addressing(ichunk,iproc_xi,iproc_eta)
+ enddo
+ write(IMAIN,'(3x)',advance='no')
+ do iproc_eta = NPROC_ETA_VAL -1, 0, -1
+ ichunk = CHUNK_AC
+ write(IMAIN,'(i5)',advance='no') addressing(ichunk,iproc_xi,iproc_eta)
+ enddo
+ write(IMAIN,'(3x)',advance='no')
+ do iproc_eta = NPROC_ETA_VAL -1, 0, -1
+ ichunk = CHUNK_BC_ANTIPODE
+ write(IMAIN,'(i5)',advance='no') addressing(ichunk,iproc_xi,iproc_eta)
+ enddo
+ write(IMAIN,'(1x)',advance='yes')
+ enddo
+ write(IMAIN, *) ' '
+ do iproc_xi = NPROC_XI_VAL-1, 0, -1
+ write(IMAIN,'(20x)',advance='no')
+ do iproc_eta = NPROC_ETA_VAL -1, 0, -1
+ ichunk = CHUNK_AB_ANTIPODE
+ write(IMAIN,'(i5)',advance='no') addressing(ichunk,iproc_xi,iproc_eta)
+ enddo
+ write(IMAIN,'(1x)',advance='yes')
+ enddo
+ write(IMAIN, *) ' '
+ do iproc_xi = NPROC_XI_VAL-1, 0, -1
+ write(IMAIN,'(20x)',advance='no')
+ do iproc_eta = NPROC_ETA_VAL -1, 0, -1
+ ichunk = CHUNK_AC_ANTIPODE
+ write(IMAIN,'(i5)',advance='no') addressing(ichunk,iproc_xi,iproc_eta)
+ enddo
+ write(IMAIN,'(1x)',advance='yes')
+ enddo
+ write(IMAIN, *) ' '
+ endif
+ endif
+
+ ! determine chunk number and local slice coordinates using addressing
+ ! (needed for stacey conditions)
+ ichunk = ichunk_slice(myrank)
+
+ end subroutine read_mesh_databases_addressing_adios
+
+
+!-------------------------------------------------------------------------------
+!> \brief Read crust mantle MPI arrays from an ADIOS file.
+ subroutine read_mesh_databases_MPI_CM_adios()
+ ! External imports
+ use mpi
+ use adios_read_mod
+ ! Internal imports
+ use specfem_par
+ use specfem_par_crustmantle
+
+ use specfem_par
+ use specfem_par_crustmantle
+ implicit none
+
+ ! local parameters
+ integer :: sizeprocs, comm, ierr
+ character(len=150) :: file_name
+ integer(kind=8) :: group_size_inc
+ integer :: local_dim, global_dim, offset
+ ! ADIOS variables
+ integer :: adios_err
+ integer(kind=8) :: adios_group, adios_handle, varid, sel
+ integer(kind=8) :: adios_groupsize, adios_totalsize
+ integer :: vars_count, attrs_count, current_step, last_step, vsteps
+ character(len=128), dimension(:), allocatable :: adios_names
+ integer(kind=8), dimension(1) :: start, count
+
+ ! create the name for the database of the current slide and region
+ call create_name_database_adios(prname, IREGION_CRUST_MANTLE, LOCAL_PATH)
+
+ file_name= trim(prname) // "solver_data_mpi.bp"
+ call MPI_Comm_dup (MPI_COMM_WORLD, comm, ierr)
+
+ call adios_read_init_method (ADIOS_READ_METHOD_BP, comm, &
+ "verbose=1", adios_err)
+ call check_adios_err(myrank,adios_err)
+ call adios_read_open_file (adios_handle, file_name, 0, comm, ierr)
+ call check_adios_err(myrank,adios_err)
+
+ ! MPI interfaces
+ call adios_get_scalar(adios_handle, "num_interfaces", &
+ num_interfaces_crust_mantle, adios_err)
+
+ allocate(my_neighbours_crust_mantle(num_interfaces_crust_mantle), &
+ nibool_interfaces_crust_mantle(num_interfaces_crust_mantle), &
+ stat=ierr)
+ if( ierr /= 0 ) call exit_mpi(myrank, &
+ 'error allocating array my_neighbours_crust_mantle etc.')
+
+ if( num_interfaces_crust_mantle > 0 ) then
+ call adios_get_scalar(adios_handle, "max_nibool_interfaces", &
+ max_nibool_interfaces_cm, adios_err)
+ allocate(ibool_interfaces_crust_mantle(max_nibool_interfaces_cm, &
+ num_interfaces_crust_mantle), stat=ierr)
+ if( ierr /= 0 ) call exit_mpi(myrank, &
+ 'error allocating array ibool_interfaces_crust_mantle')
+
+ local_dim = num_interfaces_crust_mantle
+ start(1) = local_dim*myrank; count(1) = local_dim
+ call adios_selection_boundingbox (sel , 1, start, count)
+ call adios_schedule_read(adios_handle, sel, "my_neighbours/array", 0, 1, &
+ my_neighbours_crust_mantle, adios_err)
+ call check_adios_err(myrank,adios_err)
+ call adios_schedule_read(adios_handle, sel, "nibool_interfaces/array", &
+ 0, 1, nibool_interfaces_crust_mantle, adios_err)
+ call check_adios_err(myrank,adios_err)
+
+ call adios_perform_reads(adios_handle, adios_err)
+ call check_adios_err(myrank,adios_err)
+
+ local_dim = max_nibool_interfaces_cm * num_interfaces_crust_mantle
+ start(1) = local_dim*myrank; count(1) = local_dim
+ call adios_selection_boundingbox (sel , 1, start, count)
+ call adios_schedule_read(adios_handle, sel, &
+ "ibool_interfaces/array", 0, 1, &
+ ibool_interfaces_crust_mantle, adios_err)
+ call check_adios_err(myrank,adios_err)
+
+ call adios_perform_reads(adios_handle, adios_err)
+ call check_adios_err(myrank,adios_err)
+ else
+ ! dummy array
+ max_nibool_interfaces_cm = 0
+ allocate(ibool_interfaces_crust_mantle(0,0),stat=ierr)
+ if( ierr /= 0 ) call exit_mpi(myrank, &
+ 'error allocating array dummy ibool_interfaces_crust_mantle')
+ endif
+
+ ! inner / outer elements
+ call adios_get_scalar(adios_handle, "nspec_inner", &
+ nspec_inner_crust_mantle, adios_err)
+ call adios_get_scalar(adios_handle, "nspec_outer", &
+ nspec_outer_crust_mantle, adios_err)
+ call adios_get_scalar(adios_handle, "num_phase_ispec", &
+ num_phase_ispec_crust_mantle, adios_err)
+ if( num_phase_ispec_crust_mantle < 0 ) &
+ call exit_mpi(myrank,'error num_phase_ispec_crust_mantle is < zero')
+
+ allocate(phase_ispec_inner_crust_mantle(num_phase_ispec_crust_mantle,2),&
+ stat=ierr)
+ if( ierr /= 0 ) call exit_mpi(myrank, &
+ 'error allocating array phase_ispec_inner_crust_mantle')
+
+ if(num_phase_ispec_crust_mantle > 0 ) then
+ local_dim = num_phase_ispec_crust_mantle * 2
+ start(1) = local_dim*myrank; count(1) = local_dim
+ call adios_selection_boundingbox (sel , 1, start, count)
+ call adios_schedule_read(adios_handle, sel, &
+ "phase_ispec_inner/array", 0, 1, &
+ phase_ispec_inner_crust_mantle, adios_err)
+ call check_adios_err(myrank,adios_err)
+
+ call adios_perform_reads(adios_handle, adios_err)
+ call check_adios_err(myrank,adios_err)
+ endif
+
+ ! mesh coloring for GPUs
+ if( USE_MESH_COLORING_GPU ) then
+ call adios_get_scalar(adios_handle, "num_colors_outer", &
+ num_colors_outer_crust_mantle, adios_err)
+ call adios_get_scalar(adios_handle, "num_colors_inner", &
+ num_colors_inner_crust_mantle, adios_err)
+ ! colors
+
+ allocate(num_elem_colors_crust_mantle(num_colors_outer_crust_mantle +&
+ num_colors_inner_crust_mantle), stat=ierr)
+ if( ierr /= 0 ) &
+ call exit_mpi(myrank,'error allocating num_elem_colors_crust_mantle array')
+
+ local_dim = num_colors_outer_crust_mantle + num_colors_inner_crust_mantle
+ start(1) = local_dim*myrank; count(1) = local_dim
+ call adios_selection_boundingbox (sel , 1, start, count)
+ call adios_schedule_read(adios_handle, sel, &
+ "num_elem_colors/array", 0, 1, &
+ num_elem_colors_crust_mantle, adios_err)
+ call check_adios_err(myrank,adios_err)
+
+ call adios_perform_reads(adios_handle, adios_err)
+ call check_adios_err(myrank,adios_err)
+ else
+ ! allocates dummy arrays
+ num_colors_outer_crust_mantle = 0
+ num_colors_inner_crust_mantle = 0
+ allocate(num_elem_colors_crust_mantle(num_colors_outer_crust_mantle + &
+ num_colors_inner_crust_mantle), stat=ierr)
+ if( ierr /= 0 ) &
+ call exit_mpi(myrank, &
+ 'error allocating num_elem_colors_crust_mantle array')
+ endif
+ ! Close ADIOS handler to the restart file.
+ call adios_selection_delete(sel)
+ call adios_read_close(adios_handle, adios_err)
+ call check_adios_err(myrank,adios_err)
+ call adios_read_finalize_method(ADIOS_READ_METHOD_BP, adios_err)
+ call check_adios_err(myrank,adios_err)
+
+ call MPI_Barrier(comm, ierr)
+
+ end subroutine read_mesh_databases_MPI_CM_adios
+
+
+!
+!-------------------------------------------------------------------------------------------------
+!
+
+ subroutine read_mesh_databases_MPI_OC_adios()
+
+ use specfem_par
+ use specfem_par_outercore
+ implicit none
+
+ ! local parameters
+ integer :: ierr
+
+ ! crust mantle region
+
+ ! create the name for the database of the current slide and region
+ call create_name_database(prname,myrank,IREGION_OUTER_CORE,LOCAL_PATH)
+
+ open(unit=IIN,file=prname(1:len_trim(prname))//'solver_data_mpi.bin', &
+ status='old',action='read',form='unformatted',iostat=ierr)
+ if( ierr /= 0 ) call exit_mpi(myrank,'error opening solver_data_mpi.bin')
+
+ ! MPI interfaces
+ read(IIN) num_interfaces_outer_core
+ allocate(my_neighbours_outer_core(num_interfaces_outer_core), &
+ nibool_interfaces_outer_core(num_interfaces_outer_core), &
+ stat=ierr)
+ if( ierr /= 0 ) &
+ call exit_mpi(myrank,'error allocating array my_neighbours_outer_core etc.')
+
+ if( num_interfaces_outer_core > 0 ) then
+ read(IIN) max_nibool_interfaces_oc
+ allocate(ibool_interfaces_outer_core(max_nibool_interfaces_oc,num_interfaces_outer_core), &
+ stat=ierr)
+ if( ierr /= 0 ) call exit_mpi(myrank,'error allocating array ibool_interfaces_outer_core')
+
+ read(IIN) my_neighbours_outer_core
+ read(IIN) nibool_interfaces_outer_core
+ read(IIN) ibool_interfaces_outer_core
+ else
+ ! dummy array
+ max_nibool_interfaces_oc = 0
+ allocate(ibool_interfaces_outer_core(0,0),stat=ierr)
+ if( ierr /= 0 ) call exit_mpi(myrank,'error allocating array dummy ibool_interfaces_outer_core')
+ endif
+
+ ! inner / outer elements
+ read(IIN) nspec_inner_outer_core,nspec_outer_outer_core
+ read(IIN) num_phase_ispec_outer_core
+ if( num_phase_ispec_outer_core < 0 ) &
+ call exit_mpi(myrank,'error num_phase_ispec_outer_core is < zero')
+
+ allocate(phase_ispec_inner_outer_core(num_phase_ispec_outer_core,2),&
+ stat=ierr)
+ if( ierr /= 0 ) &
+ call exit_mpi(myrank,'error allocating array phase_ispec_inner_outer_core')
+
+ if(num_phase_ispec_outer_core > 0 ) read(IIN) phase_ispec_inner_outer_core
+
+ ! mesh coloring for GPUs
+ if( USE_MESH_COLORING_GPU ) then
+ ! colors
+ read(IIN) num_colors_outer_outer_core,num_colors_inner_outer_core
+
+ allocate(num_elem_colors_outer_core(num_colors_outer_outer_core + num_colors_inner_outer_core), &
+ stat=ierr)
+ if( ierr /= 0 ) &
+ call exit_mpi(myrank,'error allocating num_elem_colors_outer_core array')
+
+ read(IIN) num_elem_colors_outer_core
+ else
+ ! allocates dummy arrays
+ num_colors_outer_outer_core = 0
+ num_colors_inner_outer_core = 0
+ allocate(num_elem_colors_outer_core(num_colors_outer_outer_core + num_colors_inner_outer_core), &
+ stat=ierr)
+ if( ierr /= 0 ) &
+ call exit_mpi(myrank,'error allocating num_elem_colors_outer_core array')
+ endif
+
+ close(IIN)
+
+ end subroutine read_mesh_databases_MPI_OC_adios
+
+!
+!-------------------------------------------------------------------------------------------------
+!
+
+ subroutine read_mesh_databases_MPI_IC_adios()
+
+ use specfem_par
+ use specfem_par_innercore
+ implicit none
+
+ ! local parameters
+ integer :: ierr
+
+ ! crust mantle region
+
+ ! create the name for the database of the current slide and region
+ call create_name_database(prname,myrank,IREGION_INNER_CORE,LOCAL_PATH)
+
+ open(unit=IIN,file=prname(1:len_trim(prname))//'solver_data_mpi.bin', &
+ status='old',action='read',form='unformatted',iostat=ierr)
+ if( ierr /= 0 ) call exit_mpi(myrank,'error opening solver_data_mpi.bin')
+
+ ! MPI interfaces
+ read(IIN) num_interfaces_inner_core
+ allocate(my_neighbours_inner_core(num_interfaces_inner_core), &
+ nibool_interfaces_inner_core(num_interfaces_inner_core), &
+ stat=ierr)
+ if( ierr /= 0 ) &
+ call exit_mpi(myrank,'error allocating array my_neighbours_inner_core etc.')
+
+ if( num_interfaces_inner_core > 0 ) then
+ read(IIN) max_nibool_interfaces_ic
+ allocate(ibool_interfaces_inner_core(max_nibool_interfaces_ic,num_interfaces_inner_core), &
+ stat=ierr)
+ if( ierr /= 0 ) call exit_mpi(myrank,'error allocating array ibool_interfaces_inner_core')
+
+ read(IIN) my_neighbours_inner_core
+ read(IIN) nibool_interfaces_inner_core
+ read(IIN) ibool_interfaces_inner_core
+ else
+ ! dummy array
+ max_nibool_interfaces_ic = 0
+ allocate(ibool_interfaces_inner_core(0,0),stat=ierr)
+ if( ierr /= 0 ) call exit_mpi(myrank,'error allocating array dummy ibool_interfaces_inner_core')
+ endif
+
+ ! inner / outer elements
+ read(IIN) nspec_inner_inner_core,nspec_outer_inner_core
+ read(IIN) num_phase_ispec_inner_core
+ if( num_phase_ispec_inner_core < 0 ) &
+ call exit_mpi(myrank,'error num_phase_ispec_inner_core is < zero')
+
+ allocate(phase_ispec_inner_inner_core(num_phase_ispec_inner_core,2),&
+ stat=ierr)
+ if( ierr /= 0 ) &
+ call exit_mpi(myrank,'error allocating array phase_ispec_inner_inner_core')
+
+ if(num_phase_ispec_inner_core > 0 ) read(IIN) phase_ispec_inner_inner_core
+
+ ! mesh coloring for GPUs
+ if( USE_MESH_COLORING_GPU ) then
+ ! colors
+ read(IIN) num_colors_outer_inner_core,num_colors_inner_inner_core
+
+ allocate(num_elem_colors_inner_core(num_colors_outer_inner_core + num_colors_inner_inner_core), &
+ stat=ierr)
+ if( ierr /= 0 ) &
+ call exit_mpi(myrank,'error allocating num_elem_colors_inner_core array')
+
+ read(IIN) num_elem_colors_inner_core
+ else
+ ! allocates dummy arrays
+ num_colors_outer_inner_core = 0
+ num_colors_inner_inner_core = 0
+ allocate(num_elem_colors_inner_core(num_colors_outer_inner_core + num_colors_inner_inner_core), &
+ stat=ierr)
+ if( ierr /= 0 ) &
+ call exit_mpi(myrank,'error allocating num_elem_colors_inner_core array')
+ endif
+
+ close(IIN)
+
+ end subroutine read_mesh_databases_MPI_IC_adios
+
+
+!
+!-------------------------------------------------------------------------------------------------
+!
+
+ subroutine read_mesh_databases_stacey_adios()
+
+ use specfem_par
+ use specfem_par_crustmantle
+ use specfem_par_innercore
+ use specfem_par_outercore
+
+ implicit none
+
+ ! local parameters
+ integer :: ierr
+
+ ! crust and mantle
+
+ ! create name of database
+ call create_name_database(prname,myrank,IREGION_CRUST_MANTLE,LOCAL_PATH)
+
+ ! read arrays for Stacey conditions
+ open(unit=27,file=prname(1:len_trim(prname))//'stacey.bin', &
+ status='old',form='unformatted',action='read',iostat=ierr)
+ if( ierr /= 0 ) call exit_MPI(myrank,'error opening stacey.bin file for crust mantle')
+
+ read(27) nimin_crust_mantle
+ read(27) nimax_crust_mantle
+ read(27) njmin_crust_mantle
+ read(27) njmax_crust_mantle
+ read(27) nkmin_xi_crust_mantle
+ read(27) nkmin_eta_crust_mantle
+ close(27)
+
+ ! outer core
+
+ ! create name of database
+ call create_name_database(prname,myrank,IREGION_OUTER_CORE,LOCAL_PATH)
+
+ ! read arrays for Stacey conditions
+ open(unit=27,file=prname(1:len_trim(prname))//'stacey.bin', &
+ status='old',form='unformatted',action='read',iostat=ierr)
+ if( ierr /= 0 ) call exit_MPI(myrank,'error opening stacey.bin file for outer core')
+
+ read(27) nimin_outer_core
+ read(27) nimax_outer_core
+ read(27) njmin_outer_core
+ read(27) njmax_outer_core
+ read(27) nkmin_xi_outer_core
+ read(27) nkmin_eta_outer_core
+ close(27)
+
+ end subroutine read_mesh_databases_stacey_adios
+
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/specfem3D/save_forward_arrays_adios.F90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/specfem3D/save_forward_arrays_adios.F90 2013-05-06 18:42:12 UTC (rev 21991)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/specfem3D/save_forward_arrays_adios.F90 2013-05-06 18:42:19 UTC (rev 21992)
@@ -52,23 +52,20 @@
character(len=150) :: outputname
integer(kind=8) :: group_size_inc
integer :: local_dim, global_dim, offset
-! integer, parameter :: num_arrays = 9 ! TODO correct number
-! character(len=256), dimension(num_arrays) :: local_dims1, local_dims2, &
-! global_dims1, global_dims2, offsets1, offsets2, array_name
! ADIOS variables
integer :: adios_err
integer(kind=8) :: adios_group, adios_handle, varid
integer(kind=8) :: adios_groupsize, adios_totalsize
- outputname = "OUTPUT_FILES/dump_all_arrays_adios.bp"
- call world_size(sizeprocs)
+ outputname = trim(LOCAL_TMP_PATH) // "/dump_all_arrays_adios.bp"
+ call world_size(sizeprocs) ! TODO keep it in parameters
call MPI_Comm_dup (MPI_COMM_WORLD, comm, ierr)
group_size_inc = 0
call adios_declare_group(adios_group, "SPECFEM3D_GLOBE_FORWARD_ARRAYS", &
"", 1, adios_err)
-! call check_adios_err(adios_err)
+! call check_adios_err(myrank,adios_err)
call adios_select_method(adios_group, "MPI", "", "", adios_err)
-! call check_adios_err(adios_err)
+! call check_adios_err(myrank,adios_err)
! Define ADIOS variables
call define_common_forward_arrays_adios(adios_group, group_size_inc)
@@ -78,10 +75,10 @@
! Open an ADIOS handler to the restart file.
call adios_open (adios_handle, "SPECFEM3D_GLOBE_FORWARD_ARRAYS", &
outputname, "w", comm, adios_err);
-! call check_adios_err(adios_err)
+! call check_adios_err(myrank,adios_err)
call adios_group_size (adios_handle, group_size_inc, &
adios_totalsize, adios_err)
-! call check_adios_err(adios_err)
+! call check_adios_err(myrank,adios_err)
! Issue the order to write the previously defined variable to the ADIOS file
call write_common_forward_arrays_adios(adios_handle, sizeprocs)
@@ -89,11 +86,11 @@
call write_attenuation_forward_arrays_adios(adios_handle, sizeprocs)
! Reset the path to its original value to avoid bugs.
call adios_set_path (adios_handle, "", adios_err)
-! call check_adios_err(adios_err)
+! call check_adios_err(myrank,adios_err)
! Close ADIOS handler to the restart file.
call adios_close(adios_handle, adios_err)
-! call check_adios_err(adios_err)
+! call check_adios_err(myrank,adios_err)
end subroutine save_intermediate_forward_arrays_adios
!-------------------------------------------------------------------------------
@@ -127,16 +124,16 @@
integer(kind=8) :: adios_group, adios_handle, varid
integer(kind=8) :: adios_groupsize, adios_totalsize
- outputname = "OUTPUT_FILES/save_forward_arrays.bp"
+ outputname = trim(LOCAL_TMP_PATH) // "/save_forward_arrays.bp"
call world_size(sizeprocs)
call MPI_Comm_dup (MPI_COMM_WORLD, comm, ierr)
group_size_inc = 0
call adios_declare_group(adios_group, "SPECFEM3D_GLOBE_FORWARD_ARRAYS", &
"", 1, adios_err)
-! call check_adios_err(adios_err)
+! call check_adios_err(myrank,adios_err)
call adios_select_method(adios_group, "MPI", "", "", adios_err)
-! call check_adios_err(adios_err)
+! call check_adios_err(myrank,adios_err)
! Define ADIOS variables
call define_common_forward_arrays_adios(adios_group, group_size_inc)
@@ -152,10 +149,10 @@
! Open an ADIOS handler to the restart file.
call adios_open (adios_handle, "SPECFEM3D_GLOBE_FORWARD_ARRAYS", &
outputname, "w", comm, adios_err);
-! call check_adios_err(adios_err)
+! call check_adios_err(myrank,adios_err)
call adios_group_size (adios_handle, group_size_inc, &
adios_totalsize, adios_err)
-! call check_adios_err(adios_err)
+! call check_adios_err(myrank,adios_err)
! Issue the order to write the previously defined variable to the ADIOS file
call write_common_forward_arrays_adios(adios_handle, sizeprocs)
@@ -167,11 +164,11 @@
endif
! Reset the path to its original value to avoid bugs.
call adios_set_path (adios_handle, "", adios_err)
-! call check_adios_err(adios_err)
+! call check_adios_err(myrank,adios_err)
! Close ADIOS handler to the restart file.
call adios_close(adios_handle, adios_err)
-! call check_adios_err(adios_err)
+! call check_adios_err(myrank,adios_err)
end subroutine save_forward_arrays_adios
!-------------------------------------------------------------------------------
@@ -332,124 +329,124 @@
local_dim = NDIM * NGLOB_CRUST_MANTLE
call adios_set_path (adios_handle, "displ_crust_mantle", adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call write_1D_global_array_adios_dims(adios_handle, local_dim, sizeprocs)
call adios_write(adios_handle, "array", displ_crust_mantle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_set_path (adios_handle, "veloc_crust_mantle", adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call write_1D_global_array_adios_dims(adios_handle, local_dim, sizeprocs)
call adios_write(adios_handle, "array", veloc_crust_mantle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_set_path (adios_handle, "accel_crust_mantle", adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call write_1D_global_array_adios_dims(adios_handle, local_dim, sizeprocs)
call adios_write(adios_handle, "array", accel_crust_mantle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
local_dim = NDIM * NGLOB_INNER_CORE
call adios_set_path (adios_handle, "displ_inner_core", adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call write_1D_global_array_adios_dims(adios_handle, local_dim, sizeprocs)
call adios_write(adios_handle, "array", displ_inner_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_set_path (adios_handle, "veloc_inner_core", adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call write_1D_global_array_adios_dims(adios_handle, local_dim, sizeprocs)
call adios_write(adios_handle, "array", veloc_inner_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_set_path (adios_handle, "accel_inner_core", adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call write_1D_global_array_adios_dims(adios_handle, local_dim, sizeprocs)
call adios_write(adios_handle, "array", accel_inner_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_set_path (adios_handle, "", adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
local_dim = NGLOB_OUTER_CORE
call adios_set_path (adios_handle, "displ_outer_core", adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call write_1D_global_array_adios_dims(adios_handle, local_dim, sizeprocs)
call adios_write(adios_handle, "array", displ_outer_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_set_path (adios_handle, "veloc_outer_core", adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call write_1D_global_array_adios_dims(adios_handle, local_dim, sizeprocs)
call adios_write(adios_handle, "array", veloc_outer_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_set_path (adios_handle, "accel_outer_core", adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call write_1D_global_array_adios_dims(adios_handle, local_dim, sizeprocs)
call adios_write(adios_handle, "array", accel_outer_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
local_dim = NGLLX * NGLLY * NGLLZ * NSPEC_CRUST_MANTLE_STR_OR_ATT
call adios_set_path (adios_handle, "epsilondev_xx_crust_mantle", adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call write_1D_global_array_adios_dims(adios_handle, local_dim, sizeprocs)
call adios_write(adios_handle, "array", epsilondev_xx_crust_mantle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_set_path (adios_handle, "epsilondev_yy_crust_mantle", adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call write_1D_global_array_adios_dims(adios_handle, local_dim, sizeprocs)
call adios_write(adios_handle, "array", epsilondev_yy_crust_mantle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_set_path (adios_handle, "epsilondev_xy_crust_mantle", adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call write_1D_global_array_adios_dims(adios_handle, local_dim, sizeprocs)
call adios_write(adios_handle, "array", epsilondev_xy_crust_mantle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_set_path (adios_handle, "epsilondev_xz_crust_mantle", adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call write_1D_global_array_adios_dims(adios_handle, local_dim, sizeprocs)
call adios_write(adios_handle, "array", epsilondev_xz_crust_mantle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_set_path (adios_handle, "epsilondev_yz_crust_mantle", adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call write_1D_global_array_adios_dims(adios_handle, local_dim, sizeprocs)
call adios_write(adios_handle, "array", epsilondev_yz_crust_mantle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
local_dim = NGLLX * NGLLY * NGLLZ * NSPEC_INNER_CORE_STR_OR_ATT
call adios_set_path (adios_handle, "epsilondev_xx_inner_core", adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call write_1D_global_array_adios_dims(adios_handle, local_dim, sizeprocs)
call adios_write(adios_handle, "array", epsilondev_xx_inner_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_set_path (adios_handle, "epsilondev_yy_inner_core", adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call write_1D_global_array_adios_dims(adios_handle, local_dim, sizeprocs)
call adios_write(adios_handle, "array", epsilondev_yy_inner_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_set_path (adios_handle, "epsilondev_xy_inner_core", adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call write_1D_global_array_adios_dims(adios_handle, local_dim, sizeprocs)
call adios_write(adios_handle, "array", epsilondev_xy_inner_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_set_path (adios_handle, "epsilondev_xz_inner_core", adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call write_1D_global_array_adios_dims(adios_handle, local_dim, sizeprocs)
call adios_write(adios_handle, "array", epsilondev_xz_inner_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_set_path (adios_handle, "epsilondev_yz_inner_core", adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call write_1D_global_array_adios_dims(adios_handle, local_dim, sizeprocs)
call adios_write(adios_handle, "array", epsilondev_yz_inner_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
end subroutine write_common_forward_arrays_adios
!-------------------------------------------------------------------------------
@@ -472,16 +469,16 @@
local_dim = NGLLX * NGLLY * NGLLZ * NSPEC_OUTER_CORE_ROTATION
call adios_set_path (adios_handle, "A_array_rotation", adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call write_1D_global_array_adios_dims(adios_handle, local_dim, sizeprocs)
call adios_write(adios_handle, "array", A_array_rotation, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_set_path (adios_handle, "B_array_rotation", adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call write_1D_global_array_adios_dims(adios_handle, local_dim, sizeprocs)
call adios_write(adios_handle, "array", B_array_rotation, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
end subroutine write_rotation_forward_arrays_adios
!-------------------------------------------------------------------------------
@@ -505,65 +502,65 @@
local_dim = N_SLS*NGLLX*NGLLY*NGLLZ*NSPEC_CRUST_MANTLE_ATTENUAT
call adios_set_path (adios_handle, "R_xx_crust_mantle", adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call write_1D_global_array_adios_dims(adios_handle, local_dim, sizeprocs)
call adios_write(adios_handle, "array", R_xx_crust_mantle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_set_path (adios_handle, "R_yy_crust_mantle", adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call write_1D_global_array_adios_dims(adios_handle, local_dim, sizeprocs)
call adios_write(adios_handle, "array", R_yy_crust_mantle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_set_path (adios_handle, "R_xy_crust_mantle", adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call write_1D_global_array_adios_dims(adios_handle, local_dim, sizeprocs)
call adios_write(adios_handle, "array", R_xy_crust_mantle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_set_path (adios_handle, "R_xz_crust_mantle", adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call write_1D_global_array_adios_dims(adios_handle, local_dim, sizeprocs)
call adios_write(adios_handle, "array", R_xz_crust_mantle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_set_path (adios_handle, "R_yz_crust_mantle", adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call write_1D_global_array_adios_dims(adios_handle, local_dim, sizeprocs)
call adios_write(adios_handle, "array", R_yz_crust_mantle, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
local_dim = N_SLS*NGLLX*NGLLY*NGLLZ*NSPEC_INNER_CORE_ATTENUATION
call adios_set_path (adios_handle, "R_xx_inner_core", adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call write_1D_global_array_adios_dims(adios_handle, local_dim, sizeprocs)
call adios_write(adios_handle, "array", R_xx_inner_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_set_path (adios_handle, "R_yy_inner_core", adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call write_1D_global_array_adios_dims(adios_handle, local_dim, sizeprocs)
call adios_write(adios_handle, "array", R_yy_inner_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_set_path (adios_handle, "R_xy_inner_core", adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call write_1D_global_array_adios_dims(adios_handle, local_dim, sizeprocs)
call adios_write(adios_handle, "array", R_xy_inner_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_set_path (adios_handle, "R_xz_inner_core", adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call write_1D_global_array_adios_dims(adios_handle, local_dim, sizeprocs)
call adios_write(adios_handle, "array", R_xz_inner_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_set_path (adios_handle, "R_yz_inner_core", adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call write_1D_global_array_adios_dims(adios_handle, local_dim, sizeprocs)
call adios_write(adios_handle, "array", R_yz_inner_core, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
end subroutine write_attenuation_forward_arrays_adios
!-------------------------------------------------------------------------------
@@ -586,10 +583,10 @@
integer :: adios_err
call adios_write(adios_handle, "local_dim", local_dim, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_write(adios_handle, "global_dim", local_dim*sizeprocs, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
call adios_write(adios_handle, "offset", local_dim*myrank, adios_err)
- call check_adios_err(adios_err)
+ call check_adios_err(myrank,adios_err)
end subroutine write_1D_global_array_adios_dims
Modified: seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/specfem3D/specfem3D_par.F90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/specfem3D/specfem3D_par.F90 2013-05-06 18:42:12 UTC (rev 21991)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/specfem3D/specfem3D_par.F90 2013-05-06 18:42:19 UTC (rev 21992)
@@ -307,7 +307,7 @@
! ADIOS
!-----------------------------------------------------------------
- logical :: ADIOS_ENABLED, ADIOS_FOR_FORWARD_ARRAYS
+ logical :: ADIOS_ENABLED, ADIOS_FOR_FORWARD_ARRAYS, ADIOS_FOR_MPI_ARRAYS
!-----------------------------------------------------------------
! time scheme
More information about the CIG-COMMITS
mailing list