silo_obj_WriteScalar1D Subroutine

private impure subroutine silo_obj_WriteScalar1D(this, name, array)

Writes 1D array to a hdf5 file with silo.

Type Bound

silo_obj

Arguments

Type IntentOptional Attributes Name
class(silo_obj), intent(inout) :: this

A silo object

character(len=*), intent(in) :: name

Variable name

class(*), intent(in) :: array(:)

3-D data array


Calls

proc~~silo_obj_writescalar1d~~CallsGraph proc~silo_obj_writescalar1d silo_obj%silo_obj_WriteScalar1D dbclose dbclose proc~silo_obj_writescalar1d->dbclose dbopen dbopen proc~silo_obj_writescalar1d->dbopen dbputmvar dbputmvar proc~silo_obj_writescalar1d->dbputmvar dbputpv1 dbputpv1 proc~silo_obj_writescalar1d->dbputpv1 dbsetdir dbsetdir proc~silo_obj_writescalar1d->dbsetdir mpi_barrier mpi_barrier proc~silo_obj_writescalar1d->mpi_barrier proc~parallel_obj_rankisroot parallel_obj%parallel_obj_RankIsRoot proc~silo_obj_writescalar1d->proc~parallel_obj_rankisroot

Source Code

    impure subroutine silo_obj_WriteScalar1D(this,name,array)
      !> Writes 1D array to a hdf5 file with silo.
      implicit none
      class(silo_obj), intent(inout) :: this                                   !! A silo object
      class(*),         intent(in)   :: array(:)                               !! 3-D data array
      character(len=*), intent(in)   :: name                                   !! Variable name
      ! Work variables
      integer :: ierr,status
      integer :: n
      character(len=7) :: mesh
      character(len=SILOstr), allocatable :: names(:)
      integer, allocatable :: lnames(:),types(:)

      mesh="LagMesh"

      ! Write using poor man's IO: sequential (serial) writes among a silo group
      do n=1,this%nproc_node
        if (n.eq.this%silo_rank) then

          ! Open file
          ierr=DBopen(this%siloname,len_trim(this%siloname),SILOdriver,DB_APPEND,this%fid_DAT)
          if (ierr.ne.0) call this%parallel%Stop('Error opening SILO file')

          ! Switch to appropriate directory
          ierr = DBsetdir(this%fid_DAT,trim(this%dirname),len_trim(this%dirname))

          ! Write data in Single Precision
          select type(array)
          type is (real(leapDP))
            ierr = DBputpv1(this%fid_DAT,name,len_trim(name), mesh, len_trim(mesh), &
              real(array,leapSP), size(array), DB_FLOAT, DB_F77NULL, status)
          type is (real(leapSP))
            ierr = DBputpv1(this%fid_DAT,name,len_trim(name), mesh, len_trim(mesh), &
              real(array,leapSP), size(array), DB_FLOAT, DB_F77NULL, status)
          type is (integer)
            ierr = DBputpv1(this%fid_DAT,name,len_trim(name), mesh, len_trim(mesh), &
              real(array,leapI4), size(array), DB_FLOAT, DB_F77NULL, status)
          type is (integer(leapI8))
            ierr = DBputpv1(this%fid_DAT,name,len_trim(name), mesh, len_trim(mesh), &
              real(array,leapI4), size(array), DB_FLOAT, DB_F77NULL, status)
          end select

          ! Close file so that next silo_rank can open it
          ierr =DBclose(this%fid_DAT)
          if (ierr.ne.0) call this%parallel%Stop('Error closing SILO file')
        end if

        call MPI_BARRIER(this%silo_comm)
      end do

      allocate (names(this%parallel%nproc))
      allocate (lnames(this%parallel%nproc))
      allocate (types(this%parallel%nproc))

      if (this%parallel%RankIsRoot()) then
        do n=1,this%parallel%nproc
          write(names(n), '(2A,I5.5,2A,I5.5,2A)') trim(adjustl(this%filename)),'_g_',&
                                                 this%group_ids(n),SILO_EXTENSION,':',mod(n-1,this%nproc_node)+1,'/',trim(name)
          lnames(n) = len_trim(names(n))
          types(n)  = DB_POINTVAR
        end do
        ierr = DBputmvar(this%fid_VDB, name, len_trim(name), this%parallel%nproc,names,lnames,types,DB_F77NULL,ierr)
      end if

      deallocate(names)
      deallocate(lnames)
      deallocate(types)

      return
    end subroutine silo_obj_WriteScalar1D