sll_m_xdmf_serial_blocks.F90

Go to the documentation of this file.

!**************************************************************
!  Copyright INRIA
!  Authors :
!     Pierre Navaro
!
!  This code SeLaLib (for Semi-Lagrangian-Library)
!  is a parallel library for simulating the plasma turbulence
!  in a tokamak.
!
!  This software is governed by the CeCILL-B license
!  under French law and abiding by the rules of distribution
!  of free software.  You can  use, modify and redistribute
!  the software under the terms of the CeCILL-B license as
!  circulated by CEA, CNRS and INRIA at the following URL
!  "http://www.cecill.info".
!**************************************************************
 
module sll_m_xdmf_serial_blocks
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
#include "sll_assert.h"
#include "sll_working_precision.h"
 
   use sll_m_utilities, only: &
      sll_s_int2string
 
   use sll_m_xml_io, only: &
      sll_s_xml_file_close, &
      sll_s_xml_file_create
 
   use mpi, only: &
      mpi_comm_rank, &
      mpi_comm_size, &
      mpi_comm_world, &
      mpi_integer, &
      mpi_recv, &
      mpi_send, &
      mpi_status_size
 
#ifndef NOHDF5
   use sll_m_hdf5_io_serial, only: &
      sll_t_hdf5_ser_handle, &
      sll_s_hdf5_ser_file_create, &
      sll_s_hdf5_ser_file_close, &
      sll_o_hdf5_ser_write_array
 
#endif
   implicit none
 
   public :: &
      sll_s_xdmf_array_2d_serial_blocks, &
      sll_s_xdmf_close_serial_blocks, &
      sll_s_xdmf_open_serial_blocks
 
   private
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 
   interface sll_xdmf_open
      module procedure sll_s_xdmf_open_serial_blocks
   end interface
 
   interface sll_xdmf_write_array
      module procedure sll_s_xdmf_array_2d_serial_blocks
   end interface
 
   interface sll_xdmf_close
      module procedure sll_s_xdmf_close_serial_blocks
   end interface
 
contains
 
   subroutine sll_s_xdmf_open_serial_blocks(prefix, &
                                            x1, &
                                            x2, &
                                            xmf, &
                                            error)
 
      character(len=*), intent(in) :: prefix
      sll_real64, intent(in)       :: x1(:, :) 
      sll_real64, intent(in)       :: x2(:, :) 
      sll_int32, intent(out)       :: xmf     
      sll_int32                    :: error   
      sll_int32                    :: prank   
      character(len=4)             :: crank
#ifndef NOHDF5
      type(sll_t_hdf5_ser_handle)  :: h5file_id
#endif
 
      call mpi_comm_rank(mpi_comm_world, prank, error)
      call sll_s_int2string(prank, crank)
      if (prank == 0) then
         call sll_s_xml_file_create(trim(prefix)//".xmf", xmf, error)
      end if
#ifndef NOHDF5
      call sll_s_hdf5_ser_file_create(trim(prefix)//"-mesh-"//crank//".h5", h5file_id, error)
      call sll_o_hdf5_ser_write_array(h5file_id, x1, "/x1", error)
      call sll_o_hdf5_ser_write_array(h5file_id, x2, "/x2", error)
      call sll_s_hdf5_ser_file_close(h5file_id, error)
#endif
 
   end subroutine sll_s_xdmf_open_serial_blocks
 
   subroutine sll_s_xdmf_array_2d_serial_blocks(xmf, prefix, &
                                                array, array_name, error, &
                                                center)
 
      sll_int32, intent(in)           :: xmf        
      character(len=*), intent(in)    :: prefix
      sll_real64, intent(in)          :: array(:, :) 
      character(len=*), intent(in)    :: array_name
#ifndef NOHDF5
      type(sll_t_hdf5_ser_handle)     :: h5file_id
#endif
      sll_int32                       :: npts_x1    
      sll_int32                       :: npts_x2    
      sll_int32, intent(out)          :: error      
      character(len=4), optional      :: center
      sll_int32                       :: prank
      sll_int32                       :: psize
      character(len=4)                :: crank
      sll_int32                       :: iproc
      character(len=4)                :: cproc
      sll_int32, parameter            :: tag = 1111
      sll_int32                       :: statut(mpi_status_size)
 
      call mpi_comm_rank(mpi_comm_world, prank, error)
      call mpi_comm_size(mpi_comm_world, psize, error)
      call sll_s_int2string(prank, crank)
 
#ifndef NOHDF5
      call sll_s_hdf5_ser_file_create(trim(prefix)//"-"//crank//".h5", h5file_id, error)
      call sll_o_hdf5_ser_write_array(h5file_id, array, "/"//trim(array_name), error)
      call sll_s_hdf5_ser_file_close(h5file_id, error)
#endif
 
      npts_x1 = size(array, 1)
      npts_x2 = size(array, 2)
 
      if (prank == 0) then
         write (xmf, '(a)') &
            "<Grid Name=""AllDomain"" GridType=""Collection"" CollectionType=""Spatial"">"
         do iproc = 0, psize - 1
            call sll_s_int2string(iproc, cproc)
            if (iproc > 0) then
               call mpi_recv(npts_x1, 1, mpi_integer, iproc, tag, mpi_comm_world, statut, error)
               call mpi_recv(npts_x2, 1, mpi_integer, iproc, tag, mpi_comm_world, statut, error)
            end if
 
            write (xmf, '(a)') "<Grid Name=""SubDomain"" GridType=""Uniform"">"
            write (xmf, '(a,2i6,a)') &
               "<Topology TopologyType=""2DSMesh"" NumberOfElements='", npts_x2, npts_x1, "'/>"
            write (xmf, '(a)') "<Geometry GeometryType=""X_Y"">"
            write (xmf, '(a,2i6,a)') "<DataItem Dimensions='", npts_x2, npts_x1, &
               "' NumberType=""Float"" Precision=""4"" Format=""HDF"">"
            write (xmf, '(a)') trim(prefix)//"-mesh-"//cproc//".h5:/x1"
            write (xmf, '(a)') "</DataItem>"
            write (xmf, '(a,2i6,a)') "<DataItem Dimensions='", npts_x2, npts_x1, &
               "' NumberType=""Float"" Precision=""4"" Format=""HDF"">"
            write (xmf, '(a)') trim(prefix)//"-mesh-"//cproc//".h5:/x2"
            write (xmf, '(a)') "</DataItem>"
            write (xmf, '(a)') "</Geometry>"
            write (xmf, '(a)') &
               "<Attribute Name='"//trim(array_name)//"' AttributeType=""Scalar"" Center=""Node"">"
            write (xmf, '(a,2i6,a)') "<DataItem Dimensions='", npts_x2, npts_x1, &
               "' NumberType=""Float"" Precision=""8"" Format=""HDF"">"
            write (xmf, '(a)') trim(prefix)//"-"//cproc//".h5:/"//trim(array_name)
            write (xmf, '(a)') "</DataItem>"
            write (xmf, '(a)') "</Attribute>"
            write (xmf, '(a)') "</Grid>"
         end do
      else
         call mpi_send(npts_x1, 1, mpi_integer, 0, tag, mpi_comm_world, error)
         call mpi_send(npts_x2, 1, mpi_integer, 0, tag, mpi_comm_world, error)
      end if
 
      return
      sll_assert_always(present(center))
 
   end subroutine sll_s_xdmf_array_2d_serial_blocks
 
   subroutine sll_s_xdmf_close_serial_blocks(file_id, error)
      sll_int32, intent(in) :: file_id 
      sll_int32, intent(out) :: error  
      sll_int32 :: prank
      logical   :: i_opened, i_exist
      character(len=255) :: i_name
 
      call mpi_comm_rank(mpi_comm_world, prank, error)
      if (prank == 0) then
         INQUIRE (file_id, opened=i_opened, name=i_name, exist=i_exist)
         call sll_s_xml_file_close(file_id, error)
      end if
   end subroutine sll_s_xdmf_close_serial_blocks
 
end module sll_m_xdmf_serial_blocks