[cig-commits] r22162 - seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/meshfem3D
lefebvre at geodynamics.org
lefebvre at geodynamics.org
Wed May 29 11:20:36 PDT 2013
Author: lefebvre
Date: 2013-05-29 11:20:35 -0700 (Wed, 29 May 2013)
New Revision: 22162
Added:
seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/meshfem3D/create_regions_mesh_adios.f90
seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/meshfem3D/write_AVS_DX_global_data_adios.f90
Log:
ADIOS for points and elements AVS/DX Data.
Added: seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/meshfem3D/create_regions_mesh_adios.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/meshfem3D/create_regions_mesh_adios.f90 (rev 0)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/meshfem3D/create_regions_mesh_adios.f90 2013-05-29 18:20:35 UTC (rev 22162)
@@ -0,0 +1,101 @@
+!=====================================================================
+!
+! 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 crm_save_mesh_files_adios(nspec,npointot,iregion_code, &
+ num_ibool_AVS_DX, mask_ibool)
+ use mpi
+ use adios_write_mod
+
+ use meshfem3d_par,only: &
+ ibool,idoubling, &
+ xstore,ystore,zstore, &
+ myrank,NGLLX,NGLLY,NGLLZ, &
+ RICB,RCMB,RTOPDDOUBLEPRIME,R600,R670,R220,R771,R400,R120,R80,RMOHO, &
+ RMIDDLE_CRUST,ROCEAN, &
+ ADIOS_FOR_AVS_DX, LOCAL_PATH
+
+
+ use meshfem3D_models_par,only: &
+ ELLIPTICITY,ISOTROPIC_3D_MANTLE, &
+ nspl,rspl,espl,espl2
+
+ use create_regions_mesh_par2
+
+ ! Modules for temporary AVS/DX data
+ use AVS_DX_global_mod
+
+ implicit none
+
+ ! number of spectral elements in each block
+ integer,intent(in) :: nspec,npointot,iregion_code
+
+ ! local parameters
+ ! arrays used for AVS or DX files
+ integer, dimension(npointot), intent(inout) :: num_ibool_AVS_DX
+ logical, dimension(npointot), intent(inout) :: mask_ibool
+ ! structures used for ADIOS AVS/DX files
+ type(avs_dx_global_t) :: avs_dx_global_vars
+
+ character(len=150) :: reg_name, outputname, group_name
+ integer :: comm, sizeprocs, ier
+ integer(kind=8) :: adios_group, group_size_inc, adios_totalsize, adios_handle
+
+ ! create a prefix for the file name such as LOCAL_PATH/regX_
+ call create_name_database_adios(reg_name,iregion_code,LOCAL_PATH)
+ outputname = trim(reg_name) // "AVS_DX.bp"
+ write(group_name,"('SPECFEM3D_GLOBE_AVS_DX_reg',i1)") iregion_code
+ call world_size(sizeprocs) ! TODO keep it in parameters
+ ! Alias COMM_WORLD to use ADIOS
+ call MPI_Comm_dup (MPI_COMM_WORLD, comm, ier)
+ group_size_inc = 0
+ call adios_declare_group(adios_group, group_name, &
+ "", 0, ier)
+ ! We set the transport method to 'MPI'. This seems to be the correct choice
+ ! for now. We might want to move this to the constant.h file later on.
+ call adios_select_method(adios_group, "MPI", "", "", ier)
+ !--- Define ADIOS variables -----------------------------
+ call define_AVS_DX_global_data_adios(adios_group, myrank, nspec, ibool, &
+ npointot, mask_ibool, group_size_inc, avs_dx_global_vars)
+ !--- Open an ADIOS handler to the AVS_DX file. ---------
+ call adios_open (adios_handle, group_name, &
+ outputname, "w", comm, ier);
+ call adios_group_size (adios_handle, group_size_inc, &
+ adios_totalsize, ier)
+ !--- Schedule writes for the previously defined ADIOS variables
+ call prepare_AVS_DX_global_data_adios(adios_handle, myrank, &
+ nspec, ibool, idoubling, xstore, ystore, zstore, num_ibool_AVS_DX, &
+ mask_ibool, npointot, avs_dx_global_vars)
+ call write_AVS_DX_global_data_adios(adios_handle, myrank, &
+ sizeprocs, avs_dx_global_vars)
+ !--- Reset the path to zero and perform the actual write to disk
+ call adios_set_path (adios_handle, "", ier)
+ call adios_close(adios_handle, ier)
+ !--- Clean up temporary arrays -------------------------
+ call free_AVS_DX_global_data_adios(myrank, avs_dx_global_vars)
+
+end subroutine crm_save_mesh_files_adios
Added: seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/meshfem3D/write_AVS_DX_global_data_adios.f90
===================================================================
--- seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/meshfem3D/write_AVS_DX_global_data_adios.f90 (rev 0)
+++ seismo/3D/SPECFEM3D_GLOBE/branches/SUNFLOWER_ADIOS/src/meshfem3D/write_AVS_DX_global_data_adios.f90 2013-05-29 18:20:35 UTC (rev 22162)
@@ -0,0 +1,469 @@
+!=====================================================================
+!
+! 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 write_AVS_DX_global_adios.f90
+!! \brief Define a module to hold global AVS/DX data (points and elements) and
+!! provides function to deal with them.
+!! \author MPBL
+!-------------------------------------------------------------------------------
+
+!===============================================================================
+!> AVS_DX_global_mod module. Hold and write to ADIOS file global data (points
+!! and elements).
+module AVS_DX_global_mod
+
+ implicit none
+
+ ! ADIOS Arrays to write down
+ type avs_dx_global_t
+ integer(kind=4) :: npoin, nspec
+ real(kind=4), dimension(:), allocatable :: x_adios, y_adios, z_adios
+ integer(kind=4), dimension(:), allocatable :: idoubling, iglob1, iglob2, &
+ iglob3, iglob4, iglob5, iglob6, iglob7, iglob8
+ endtype
+
+contains
+
+!===============================================================================
+!> Allocate the structure that hold data to be written; initialize adios vars.
+!! \param adios_group ADIOS group where the variables belong
+!! \param group_size_inc The size of the ADIOS group to increment
+!! \param avs_dx_adios The structure holding the data to be allocated
+subroutine define_AVS_DX_global_data_adios(adios_group, myrank, nspec, ibool, &
+ npointot, mask_ibool, group_size_inc, avs_dx_adios)
+ use mpi
+ use adios_write_mod
+ implicit none
+ include "constants.h"
+ !--- Arguments -------------------------------------------
+ integer(kind=8), intent(in) :: adios_group
+ integer(kind=4), intent(in) :: nspec, npointot, myrank
+ integer(kind=4), intent(in) :: ibool(NGLLX,NGLLY,NGLLZ,nspec)
+ logical, intent(inout) :: mask_ibool(npointot)
+ integer(kind=8), intent(inout) :: group_size_inc
+ type(avs_dx_global_t), intent(inout) :: avs_dx_adios
+ !--- Variables -------------------------------------------
+ integer ispec, npoin, ierr
+ integer iglob1,iglob2,iglob3,iglob4,iglob5,iglob6,iglob7,iglob8
+
+ mask_ibool(:) = .false.
+
+ ! mark global AVS or DX points
+ do ispec=1,nspec
+ iglob1=ibool(1,1,1,ispec)
+ iglob2=ibool(NGLLX,1,1,ispec)
+ iglob3=ibool(NGLLX,NGLLY,1,ispec)
+ iglob4=ibool(1,NGLLY,1,ispec)
+ iglob5=ibool(1,1,NGLLZ,ispec)
+ iglob6=ibool(NGLLX,1,NGLLZ,ispec)
+ iglob7=ibool(NGLLX,NGLLY,NGLLZ,ispec)
+ iglob8=ibool(1,NGLLY,NGLLZ,ispec)
+ mask_ibool(iglob1) = .true.
+ mask_ibool(iglob2) = .true.
+ mask_ibool(iglob3) = .true.
+ mask_ibool(iglob4) = .true.
+ mask_ibool(iglob5) = .true.
+ mask_ibool(iglob6) = .true.
+ mask_ibool(iglob7) = .true.
+ mask_ibool(iglob8) = .true.
+ enddo
+
+ ! count global number of AVS or DX points
+ npoin = count(mask_ibool(:))
+
+ avs_dx_adios%npoin = npoin
+ avs_dx_adios%nspec = nspec
+ ! Allocate temporary arrays for AVS/DX points
+ allocate(avs_dx_adios%x_adios(npoin), stat=ierr)
+ if (ierr /= 0) call exit_MPI(myrank, "Error allocating x_adios.")
+ allocate(avs_dx_adios%y_adios(npoin), stat=ierr)
+ if (ierr /= 0) call exit_MPI(myrank, "Error allocating y_adios.")
+ allocate(avs_dx_adios%z_adios(npoin), stat=ierr)
+ if (ierr /= 0) call exit_MPI(myrank, "Error allocating z_adios.")
+
+ ! Allocate temporary arrays for AVS/DX elements.
+ allocate(avs_dx_adios%idoubling(nspec), stat=ierr)
+ if (ierr /= 0) call exit_MPI(myrank, "Error allocating idoubling.")
+ allocate(avs_dx_adios%iglob1(nspec), stat=ierr)
+ if (ierr /= 0) call exit_MPI(myrank, "Error allocating iglob1.")
+ allocate(avs_dx_adios%iglob2(nspec), stat=ierr)
+ if (ierr /= 0) call exit_MPI(myrank, "Error allocating iglob2.")
+ allocate(avs_dx_adios%iglob3(nspec), stat=ierr)
+ if (ierr /= 0) call exit_MPI(myrank, "Error allocating iglob3.")
+ allocate(avs_dx_adios%iglob4(nspec), stat=ierr)
+ if (ierr /= 0) call exit_MPI(myrank, "Error allocating iglob4.")
+ allocate(avs_dx_adios%iglob5(nspec), stat=ierr)
+ if (ierr /= 0) call exit_MPI(myrank, "Error allocating iglob5.")
+ allocate(avs_dx_adios%iglob6(nspec), stat=ierr)
+ if (ierr /= 0) call exit_MPI(myrank, "Error allocating iglob6.")
+ allocate(avs_dx_adios%iglob7(nspec), stat=ierr)
+ if (ierr /= 0) call exit_MPI(myrank, "Error allocating iglob7.")
+ allocate(avs_dx_adios%iglob8(nspec), stat=ierr)
+ if (ierr /= 0) call exit_MPI(myrank, "Error allocating iglob8.")
+
+ !--- Variables for '...AVS_DXpoints.txt'
+ call define_adios_global_real_1d_array(adios_group, "points/x_value", &
+ npoin, group_size_inc)
+ call define_adios_global_real_1d_array(adios_group, "points/y_value", &
+ npoin, group_size_inc)
+ call define_adios_global_real_1d_array(adios_group, "points/z_value", &
+ npoin, group_size_inc)
+ !--- Variables for AVS_DXelements.txt
+ call define_adios_global_real_1d_array(adios_group, "elements/idoubling", &
+ nspec, group_size_inc)
+ call define_adios_global_real_1d_array(adios_group, &
+ "elements/num_ibool_AVS_DX_iglob1", nspec, group_size_inc)
+ call define_adios_global_real_1d_array(adios_group, &
+ "elements/num_ibool_AVS_DX_iglob2", nspec, group_size_inc)
+ call define_adios_global_real_1d_array(adios_group, &
+ "elements/num_ibool_AVS_DX_iglob3", nspec, group_size_inc)
+ call define_adios_global_real_1d_array(adios_group, &
+ "elements/num_ibool_AVS_DX_iglob4", nspec, group_size_inc)
+ call define_adios_global_real_1d_array(adios_group, &
+ "elements/num_ibool_AVS_DX_iglob5", nspec, group_size_inc)
+ call define_adios_global_real_1d_array(adios_group, &
+ "elements/num_ibool_AVS_DX_iglob6", nspec, group_size_inc)
+ call define_adios_global_real_1d_array(adios_group, &
+ "elements/num_ibool_AVS_DX_iglob7", nspec, group_size_inc)
+ call define_adios_global_real_1d_array(adios_group, &
+ "elements/num_ibool_AVS_DX_iglob8", nspec, group_size_inc)
+
+end subroutine define_AVS_DX_global_data_adios
+
+
+!===============================================================================
+!> Prepare the global AVS/DX data to be written; fill the structure.
+!! \param adios_handle The handle to the ADIOS file to be written.
+!! \param myrank The MPI rank of the current process.
+!! \param avs_dx_adios The structure to be filled.
+!!
+!! Create AVS or DX 3D data for the slice, to be recombined in postprocessing.
+subroutine prepare_AVS_DX_global_data_adios(adios_handle, myrank, &
+ nspec, ibool, idoubling, xstore, ystore, zstore, num_ibool_AVS_DX, &
+ mask_ibool, npointot, avs_dx_adios)
+ use mpi
+ use adios_write_mod
+
+ implicit none
+
+ include "constants.h"
+
+ integer(kind=8), intent(in) :: adios_handle
+ integer nspec,myrank
+ integer ibool(NGLLX,NGLLY,NGLLZ,nspec)
+
+ integer idoubling(nspec)
+
+ double precision xstore(NGLLX,NGLLY,NGLLZ,nspec)
+ double precision ystore(NGLLX,NGLLY,NGLLZ,nspec)
+ double precision zstore(NGLLX,NGLLY,NGLLZ,nspec)
+
+ ! logical mask used to output global points only once
+ integer npointot
+ logical mask_ibool(npointot)
+
+ ! numbering of global AVS or DX points
+ integer num_ibool_AVS_DX(npointot)
+
+ integer ispec
+ integer iglob1,iglob2,iglob3,iglob4,iglob5,iglob6,iglob7,iglob8
+ integer npoin,numpoin
+
+ type(avs_dx_global_t), intent(inout) :: avs_dx_adios
+
+ integer :: ierr
+
+! erase the logical mask used to mark points already found
+ mask_ibool(:) = .false.
+
+! mark global AVS or DX points
+ do ispec=1,nspec
+ iglob1=ibool(1,1,1,ispec)
+ iglob2=ibool(NGLLX,1,1,ispec)
+ iglob3=ibool(NGLLX,NGLLY,1,ispec)
+ iglob4=ibool(1,NGLLY,1,ispec)
+ iglob5=ibool(1,1,NGLLZ,ispec)
+ iglob6=ibool(NGLLX,1,NGLLZ,ispec)
+ iglob7=ibool(NGLLX,NGLLY,NGLLZ,ispec)
+ iglob8=ibool(1,NGLLY,NGLLZ,ispec)
+ mask_ibool(iglob1) = .true.
+ mask_ibool(iglob2) = .true.
+ mask_ibool(iglob3) = .true.
+ mask_ibool(iglob4) = .true.
+ mask_ibool(iglob5) = .true.
+ mask_ibool(iglob6) = .true.
+ mask_ibool(iglob7) = .true.
+ mask_ibool(iglob8) = .true.
+ enddo
+
+ ! count global number of AVS or DX points
+ npoin = count(mask_ibool(:))
+
+ ! erase the logical mask used to mark points already found
+ mask_ibool(:) = .false.
+
+ ! fill the structure with global AVS or DX points
+ numpoin = 0
+ do ispec=1,nspec
+ iglob1=ibool(1,1,1,ispec)
+ iglob2=ibool(NGLLX,1,1,ispec)
+ iglob3=ibool(NGLLX,NGLLY,1,ispec)
+ iglob4=ibool(1,NGLLY,1,ispec)
+ iglob5=ibool(1,1,NGLLZ,ispec)
+ iglob6=ibool(NGLLX,1,NGLLZ,ispec)
+ iglob7=ibool(NGLLX,NGLLY,NGLLZ,ispec)
+ iglob8=ibool(1,NGLLY,NGLLZ,ispec)
+ if(.not. mask_ibool(iglob1)) then
+ numpoin = numpoin + 1
+ num_ibool_AVS_DX(iglob1) = numpoin
+ avs_dx_adios%x_adios(numpoin) = sngl(xstore(1,1,1,ispec))
+ avs_dx_adios%y_adios(numpoin) = sngl(ystore(1,1,1,ispec))
+ avs_dx_adios%z_adios(numpoin) = sngl(zstore(1,1,1,ispec))
+ endif
+ if(.not. mask_ibool(iglob2)) then
+ numpoin = numpoin + 1
+ num_ibool_AVS_DX(iglob2) = numpoin
+ avs_dx_adios%x_adios(numpoin) = sngl(xstore(NGLLX,1,1,ispec))
+ avs_dx_adios%y_adios(numpoin) = sngl(ystore(NGLLX,1,1,ispec))
+ avs_dx_adios%z_adios(numpoin) = sngl(zstore(NGLLX,1,1,ispec))
+ endif
+ if(.not. mask_ibool(iglob3)) then
+ numpoin = numpoin + 1
+ num_ibool_AVS_DX(iglob3) = numpoin
+ write(10,*) numpoin,sngl(xstore(NGLLX,NGLLY,1,ispec)), &
+ sngl(ystore(NGLLX,NGLLY,1,ispec)),sngl(zstore(NGLLX,NGLLY,1,ispec))
+ endif
+ if(.not. mask_ibool(iglob4)) then
+ numpoin = numpoin + 1
+ num_ibool_AVS_DX(iglob4) = numpoin
+ avs_dx_adios%x_adios(numpoin) = sngl(xstore(1,NGLLY,1,ispec))
+ avs_dx_adios%y_adios(numpoin) = sngl(ystore(1,NGLLY,1,ispec))
+ avs_dx_adios%z_adios(numpoin) = sngl(zstore(1,NGLLY,1,ispec))
+ endif
+ if(.not. mask_ibool(iglob5)) then
+ numpoin = numpoin + 1
+ num_ibool_AVS_DX(iglob5) = numpoin
+ avs_dx_adios%x_adios(numpoin) = sngl(xstore(1,1,NGLLZ,ispec))
+ avs_dx_adios%y_adios(numpoin) = sngl(ystore(1,1,NGLLZ,ispec))
+ avs_dx_adios%z_adios(numpoin) = sngl(zstore(1,1,NGLLZ,ispec))
+ endif
+ if(.not. mask_ibool(iglob6)) then
+ numpoin = numpoin + 1
+ num_ibool_AVS_DX(iglob6) = numpoin
+ avs_dx_adios%x_adios(numpoin) = sngl(xstore(NGLLX,1,NGLLZ,ispec))
+ avs_dx_adios%y_adios(numpoin) = sngl(ystore(NGLLX,1,NGLLZ,ispec))
+ avs_dx_adios%z_adios(numpoin) = sngl(zstore(NGLLX,1,NGLLZ,ispec))
+ endif
+ if(.not. mask_ibool(iglob7)) then
+ numpoin = numpoin + 1
+ num_ibool_AVS_DX(iglob7) = numpoin
+ avs_dx_adios%x_adios(numpoin) = sngl(xstore(NGLLX,NGLLY,NGLLZ,ispec))
+ avs_dx_adios%y_adios(numpoin) = sngl(ystore(NGLLX,NGLLY,NGLLZ,ispec))
+ avs_dx_adios%z_adios(numpoin) = sngl(zstore(NGLLX,NGLLY,NGLLZ,ispec))
+ endif
+ if(.not. mask_ibool(iglob8)) then
+ numpoin = numpoin + 1
+ num_ibool_AVS_DX(iglob8) = numpoin
+ avs_dx_adios%x_adios(numpoin) = sngl(xstore(1,NGLLY,NGLLZ,ispec))
+ avs_dx_adios%y_adios(numpoin) = sngl(ystore(1,NGLLY,NGLLZ,ispec))
+ avs_dx_adios%z_adios(numpoin) = sngl(zstore(1,NGLLY,NGLLZ,ispec))
+ endif
+ mask_ibool(iglob1) = .true.
+ mask_ibool(iglob2) = .true.
+ mask_ibool(iglob3) = .true.
+ mask_ibool(iglob4) = .true.
+ mask_ibool(iglob5) = .true.
+ mask_ibool(iglob6) = .true.
+ mask_ibool(iglob7) = .true.
+ mask_ibool(iglob8) = .true.
+ enddo
+
+ ! check that number of global points output is okay
+ if(numpoin /= npoin) &
+ call exit_MPI(myrank, &
+ 'incorrect number of global points in AVS or DX file creation')
+
+ ! AVS or DX elements
+ do ispec=1,nspec
+ iglob1=ibool(1,1,1,ispec)
+ iglob2=ibool(NGLLX,1,1,ispec)
+ iglob3=ibool(NGLLX,NGLLY,1,ispec)
+ iglob4=ibool(1,NGLLY,1,ispec)
+ iglob5=ibool(1,1,NGLLZ,ispec)
+ iglob6=ibool(NGLLX,1,NGLLZ,ispec)
+ iglob7=ibool(NGLLX,NGLLY,NGLLZ,ispec)
+ iglob8=ibool(1,NGLLY,NGLLZ,ispec)
+
+ avs_dx_adios%iglob1 = num_ibool_AVS_DX(iglob1)
+ avs_dx_adios%iglob2 = num_ibool_AVS_DX(iglob2)
+ avs_dx_adios%iglob3 = num_ibool_AVS_DX(iglob3)
+ avs_dx_adios%iglob4 = num_ibool_AVS_DX(iglob4)
+ avs_dx_adios%iglob5 = num_ibool_AVS_DX(iglob5)
+ avs_dx_adios%iglob6 = num_ibool_AVS_DX(iglob6)
+ avs_dx_adios%iglob7 = num_ibool_AVS_DX(iglob7)
+ avs_dx_adios%iglob8 = num_ibool_AVS_DX(iglob8)
+ enddo
+ avs_dx_adios%idoubling = idoubling
+end subroutine prepare_AVS_DX_global_data_adios
+
+!===============================================================================
+!> Schedule write to ADIOS file for global AVS/DX data
+!! \param adios_handle The handle to the ADIOS file we want to write into
+!! \param nspec Number of spectral elements
+!! \avs_dx_adios Structure with the data that have to be wrtten
+subroutine write_AVS_DX_global_data_adios(adios_handle, myrank, &
+ sizeprocs, avs_dx_adios)
+ use mpi
+ use adios_write_mod
+ implicit none
+ !--- Arguments
+ integer(kind=8), intent(in) :: adios_handle
+ integer, intent(in) :: myrank, sizeprocs
+ type(avs_dx_global_t), intent(inout) :: avs_dx_adios ! out for adios_write
+ !--- Variables
+ integer :: npoin, nspec
+ integer :: ierr
+
+ npoin = avs_dx_adios%npoin
+ nspec = avs_dx_adios%nspec
+
+ call adios_set_path(adios_handle, "points/x_value", ierr)
+ call write_1D_global_array_adios_dims(adios_handle, myrank, &
+ npoin, sizeprocs)
+ call adios_write(adios_handle, "array", avs_dx_adios%x_adios, ierr)
+
+ call adios_set_path(adios_handle, "points/y_value", ierr)
+ call write_1D_global_array_adios_dims(adios_handle, myrank, &
+ npoin, sizeprocs)
+ call adios_write(adios_handle, "array", avs_dx_adios%y_adios, ierr)
+
+ call adios_set_path(adios_handle, "points/z_value", ierr)
+ call write_1D_global_array_adios_dims(adios_handle, myrank, &
+ npoin, sizeprocs)
+ call adios_write(adios_handle, "array", avs_dx_adios%z_adios, ierr)
+
+
+ call adios_set_path(adios_handle, "elements/idoubling", ierr)
+ call write_1D_global_array_adios_dims(adios_handle, myrank, &
+ nspec, sizeprocs)
+ call adios_write(adios_handle, "array", avs_dx_adios%idoubling, ierr)
+
+
+ call adios_set_path(adios_handle, "elements/num_ibool_AVS_DX_iglob1", ierr)
+ call write_1D_global_array_adios_dims(adios_handle, myrank, &
+ nspec, sizeprocs)
+ call adios_write(adios_handle, "array", avs_dx_adios%iglob1, ierr)
+
+ call adios_set_path(adios_handle, "elements/num_ibool_AVS_DX_iglob2", ierr)
+ call write_1D_global_array_adios_dims(adios_handle, myrank, &
+ nspec, sizeprocs)
+ call adios_write(adios_handle, "array", avs_dx_adios%iglob2, ierr)
+
+ call adios_set_path(adios_handle, "elements/num_ibool_AVS_DX_iglob3", ierr)
+ call write_1D_global_array_adios_dims(adios_handle, myrank, &
+ nspec, sizeprocs)
+ call adios_write(adios_handle, "array", avs_dx_adios%iglob3, ierr)
+
+ call adios_set_path(adios_handle, "elements/num_ibool_AVS_DX_iglob4", ierr)
+ call write_1D_global_array_adios_dims(adios_handle, myrank, &
+ nspec, sizeprocs)
+ call adios_write(adios_handle, "array", avs_dx_adios%iglob4, ierr)
+
+ call adios_set_path(adios_handle, "elements/num_ibool_AVS_DX_iglob5", ierr)
+ call write_1D_global_array_adios_dims(adios_handle, myrank, &
+ nspec, sizeprocs)
+ call adios_write(adios_handle, "array", avs_dx_adios%iglob5, ierr)
+
+ call adios_set_path(adios_handle, "elements/num_ibool_AVS_DX_iglob6", ierr)
+ call write_1D_global_array_adios_dims(adios_handle, myrank, &
+ nspec, sizeprocs)
+ call adios_write(adios_handle, "array", avs_dx_adios%iglob6, ierr)
+
+ call adios_set_path(adios_handle, "elements/num_ibool_AVS_DX_iglob7", ierr)
+ call write_1D_global_array_adios_dims(adios_handle, myrank, &
+ nspec, sizeprocs)
+ call adios_write(adios_handle, "array", avs_dx_adios%iglob7, ierr)
+
+ call adios_set_path(adios_handle, "elements/num_ibool_AVS_DX_iglob1", ierr)
+ call write_1D_global_array_adios_dims(adios_handle, myrank, &
+ nspec, sizeprocs)
+ call adios_write(adios_handle, "array", avs_dx_adios%iglob8, ierr)
+end subroutine write_AVS_DX_global_data_adios
+
+!===============================================================================
+!> Free temporary structure filled to write AVS/DX global variable to file.
+!! \param myrank The MPI rank of the process
+!! \param avs_dx_adios The structure holding AVS/DX information
+subroutine free_AVS_DX_global_data_adios(myrank, avs_dx_adios)
+ implicit none
+ !--- Arguments
+ integer, intent(in) :: myrank
+ type(avs_dx_global_t), intent(inout) :: avs_dx_adios
+ !--- Variables
+ integer :: ierr
+
+ deallocate(avs_dx_adios%x_adios, stat=ierr)
+ if (ierr /= 0) call exit_MPI(myrank, "Error deallocating x_adios.")
+ deallocate(avs_dx_adios%y_adios, stat=ierr)
+ if (ierr /= 0) call exit_MPI(myrank, "Error deallocating y_adios.")
+ deallocate(avs_dx_adios%z_adios, stat=ierr)
+ if (ierr /= 0) call exit_MPI(myrank, "Error deallocating z_adios.")
+
+ deallocate(avs_dx_adios%idoubling, stat=ierr)
+ if (ierr /= 0) call exit_MPI(myrank, &
+ "Error deallocating num_ibool_AVS_DX_iglob1.")
+ deallocate(avs_dx_adios%iglob1, stat=ierr)
+ if (ierr /= 0) call exit_MPI(myrank, &
+ "Error deallocating num_ibool_AVS_DX_iglob1.")
+ deallocate(avs_dx_adios%iglob2, stat=ierr)
+ if (ierr /= 0) call exit_MPI(myrank, &
+ "Error deallocating num_ibool_AVS_DX_iglob2.")
+ deallocate(avs_dx_adios%iglob3, stat=ierr)
+ if (ierr /= 0) call exit_MPI(myrank, &
+ "Error deallocating num_ibool_AVS_DX_iglob3.")
+ deallocate(avs_dx_adios%iglob4, stat=ierr)
+ if (ierr /= 0) call exit_MPI(myrank, &
+ "Error deallocating num_ibool_AVS_DX_iglob4.")
+ deallocate(avs_dx_adios%iglob5, stat=ierr)
+ if (ierr /= 0) call exit_MPI(myrank, &
+ "Error deallocating num_ibool_AVS_DX_iglob5.")
+ deallocate(avs_dx_adios%iglob6, stat=ierr)
+ if (ierr /= 0) call exit_MPI(myrank, &
+ "Error deallocating num_ibool_AVS_DX_iglob6.")
+ deallocate(avs_dx_adios%iglob7, stat=ierr)
+ if (ierr /= 0) call exit_MPI(myrank, &
+ "Error deallocating num_ibool_AVS_DX_iglob7.")
+ deallocate(avs_dx_adios%iglob8, stat=ierr)
+ if (ierr /= 0) call exit_MPI(myrank, &
+ "Error deallocating num_ibool_AVS_DX_iglob8.")
+
+ avs_dx_adios%npoin = 0
+ avs_dx_adios%nspec = 0
+end subroutine free_AVS_DX_global_data_adios
+
+end module AVS_DX_global_mod
More information about the CIG-COMMITS
mailing list