fileio_binary.f90

Go to the documentation of this file.

!#############################################################################
!#                                                                           #
!# fosite - 3D hydrodynamical simulation program                             #
!# module: fileio_binary.f90                                                 #
!#                                                                           #
!# Copyright (C) 2015 Manuel Jung <mjung@astrophysik.uni-kiel.de>            #
!#                                                                           #
!# 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, GOOD TITLE or        #
!# NON INFRINGEMENT.  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., 675 Mass Ave, Cambridge, MA 02139, USA.                 #
!#                                                                           #
!#############################################################################
!----------------------------------------------------------------------------!
!----------------------------------------------------------------------------!
#define HAVE_VTK
MODULE fileio_binary_mod
  USE fileio_base_mod
  USE geometry_base_mod
  USE mesh_base_mod
  USE physics_base_mod
  USE timedisc_base_mod
  USE fluxes_base_mod
  USE sources_base_mod
  USE common_dict
#ifdef PARALLEL
#ifdef HAVE_MPI_MOD
  USE mpi
#endif
#endif
  IMPLICIT NONE
#ifdef PARALLEL
#ifdef HAVE_MPIF_H
  include 'mpif.h'
#endif
#endif
#ifdef PARALLEL
#define OFFSET_TYPE INTEGER(KIND=MPI_OFFSET_KIND)
#else
#define OFFSET_TYPE INTEGER
#endif
  !--------------------------------------------------------------------------!
  PRIVATE
  CHARACTER, PARAMETER       :: lf = achar(10)        
  TYPE, EXTENDS(fileio_base) :: fileio_binary
  CONTAINS
    PROCEDURE :: initfileio_binary
    PROCEDURE :: writeheader
    !PROCEDURE :: ReadHeader
    !PROCEDURE :: WriteTimestamp
    !PROCEDURE :: ReadTimestamp
    PROCEDURE :: writedataset
    !PROCEDURE :: ReadDataset
    PROCEDURE :: setmeshdims
    PROCEDURE :: finalize
    !PRIVATE
    PROCEDURE :: hasmeshdims
    PROCEDURE :: hascornerdims
    PROCEDURE :: writenode
    PROCEDURE :: writekey
    PROCEDURE :: writedataattributes
    PROCEDURE :: getendianness
    PROCEDURE :: openfile
    PROCEDURE :: closefile
  END TYPE
  !--------------------------------------------------------------------------!
  PUBLIC :: &
       ! types
       fileio_binary
  !--------------------------------------------------------------------------!

CONTAINS
  SUBROUTINE initfileio_binary(this,Mesh,Physics,Timedisc,Sources,config,IO)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(fileio_binary), INTENT(INOUT) :: this
    CLASS(mesh_base),     INTENT(IN)    :: Mesh
    CLASS(physics_base),  INTENT(IN)    :: Physics
    CLASS(timedisc_base), INTENT(IN)    :: Timedisc
    CLASS(sources_base),  POINTER       :: Sources
    TYPE(Dict_TYP),       POINTER       :: config,IO
    !------------------------------------------------------------------------!
#ifdef PARALLEL
    INTEGER, DIMENSION(3)                 :: gsizes,lsizes,indices
#endif
    CHARACTER(LEN=1),DIMENSION(:),POINTER :: mold
    REAL                                  :: r
    INTEGER                               :: i,err
    !------------------------------------------------------------------------!
    this%extension= 'bin'
    CALL this%InitFileio(mesh,physics,timedisc,sources,config,io,"binary",this%extension)

    ! We mark the endianess similar to the TIFF format
    ! See: http://en.wikipedia.org/wiki/Endianness#Endianness_in_files_and_byte_swap
    ! II == Intel Format == Little Endian
    ! MM == Motorola Format == Big Endian
    CALL getendianness(this, this%endianness, 'II','MM')
    this%realsize = SIZE(transfer(r, mold))
    this%intsize = SIZE(transfer(i, mold))

    IF(this%realsize.GT.8) &
      CALL this%Error("InitFileIO_binary","Only single and double precision are allowed")

    WRITE(this%realfmt,'(A,I1,A)',iostat=err) '"',this%realsize,'"'

#ifdef PARALLEL
    IF(mesh%INUM.EQ.mesh%IMAX) THEN
      this%INUM = mesh%IMAX-mesh%IMIN+2
    ELSE
      this%INUM = mesh%IMAX-mesh%IMIN+1
    END IF
    IF(mesh%JNUM.EQ.mesh%JMAX) THEN
      this%JNUM = mesh%JMAX-mesh%JMIN+2
    ELSE
      this%JNUM = mesh%JMAX-mesh%JMIN+1
    END IF
    IF(mesh%KNUM.EQ.mesh%KMAX) THEN
      this%KNUM = mesh%KMAX-mesh%KMIN+2
    ELSE
      this%KNUM = mesh%KMAX-mesh%KMIN+1
    END IF

    ! create the data type for the distributed array of
    ! coordinates and simulation data
    gsizes(1)    = mesh%INUM
    gsizes(2)    = mesh%JNUM
    gsizes(3)    = mesh%KNUM
    lsizes(1)    = mesh%IMAX-mesh%IMIN+1
    lsizes(2)    = mesh%JMAX-mesh%JMIN+1
    lsizes(3)    = mesh%KMAX-mesh%KMIN+1
    indices(1)   = mesh%IMIN-1
    indices(2)   = mesh%JMIN-1
    indices(3)   = mesh%KMIN-1
    this%bufsize = product(lsizes)
    CALL mpi_type_create_subarray(3, gsizes, lsizes, indices, mpi_order_fortran,&
         default_mpi_real,this%filetype,this%error_io)
    CALL mpi_type_commit(this%filetype,this%error_io)

    ! create the data type for the distributed array of
    ! mesh corner positions
    gsizes(1)  = mesh%INUM+1
    gsizes(2)  = mesh%JNUM+1
    gsizes(3)  = mesh%KNUM+1
    lsizes(1)  = this%INUM
    lsizes(2)  = this%JNUM
    lsizes(3)  = this%KNUM
    indices(1) = mesh%IMIN-1
    indices(2) = mesh%JMIN-1
    indices(3)= mesh%KMIN-1
    this%cbufsize = product(lsizes)
    CALL mpi_type_create_subarray(3, gsizes, lsizes, indices, mpi_order_fortran,&
         default_mpi_real,this%cfiletype,this%error_io)
    CALL mpi_type_commit(this%cfiletype,this%error_io)

    this%first = .true.
#endif
  END SUBROUTINE initfileio_binary


  SUBROUTINE openfile(this,action)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(fileio_binary), INTENT(INOUT) :: this
    INTEGER                             :: action
    !------------------------------------------------------------------------!
#ifdef PARALLEL
    INTEGER(KIND=MPI_OFFSET_KIND) :: offset
#endif
    !------------------------------------------------------------------------!
    INTENT(IN)                    :: action
    !------------------------------------------------------------------------!
    SELECT CASE(action)
    CASE(readonly)
#ifdef PARALLEL
       CALL mpi_file_open(mpi_comm_world,this%GetFilename(),mpi_mode_rdonly, &
            mpi_info_null,this%handle,this%error_io)
        this%offset = 0
        CALL mpi_file_seek(this%handle,this%offset,mpi_seek_set,this%error_io)
#else
       OPEN(this%unit,file=this%GetFilename(),status="OLD", &
            access = 'STREAM' ,   &
            action="READ",position="REWIND",iostat=this%error_io)
#endif
    CASE(readend)
#ifdef PARALLEL
       CALL mpi_file_open(mpi_comm_world,this%GetFilename(),ior(mpi_mode_rdonly,&
            mpi_mode_append),mpi_info_null,this%handle,this%error_io)
       ! opening in append mode doesn't seem to work for pvfs2, hence ...
       offset = 0
       CALL mpi_file_seek(this%handle,offset,mpi_seek_end,this%error_io)
       CALL mpi_file_sync(this%handle,this%error_io)
#else
       OPEN(this%unit,file=this%GetFilename(),status="OLD", &
            access = 'STREAM' ,   &
            action="READ",position="APPEND",iostat=this%error_io)
#endif
    CASE(replace)
#ifdef PARALLEL
       CALL mpi_file_delete(this%GetFilename(),mpi_info_null,this%error_io)
       CALL mpi_file_open(mpi_comm_world,this%GetFilename(),ior(mpi_mode_wronly,&
            mpi_mode_create),mpi_info_null,this%handle,this%error_io)
#else
       OPEN(this%unit,file=this%GetFilename(),status="REPLACE",&
            access = 'STREAM' ,   &
            action="WRITE",position="REWIND",iostat=this%error_io)
#endif
    CASE(append)
#ifdef PARALLEL
       CALL mpi_file_open(mpi_comm_world,this%GetFilename(),ior(mpi_mode_rdwr,&
            mpi_mode_append),mpi_info_null,this%handle,this%error_io)
       ! opening in append mode doesn't seem to work for pvfs2, hence ...
       offset = 0
       CALL mpi_file_seek(this%handle,offset,mpi_seek_end,this%error_io)
       CALL mpi_file_sync(this%handle,this%error_io)
#else
       OPEN(this%unit,file=this%GetFilename(),status="OLD",&
            access = 'STREAM' ,   &
            action="READWRITE",position="APPEND",iostat=this%error_io)
#endif
    CASE DEFAULT
       CALL this%Error("OpenFile","Unknown access mode.")
    END SELECT
  END SUBROUTINE openfile

  SUBROUTINE writeheader(this,Mesh,Physics,Header,IO)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(fileio_binary), INTENT(INOUT) :: this
    CLASS(mesh_base), INTENT(IN)        :: Mesh
    CLASS(physics_base), INTENT(IN)     :: Physics
    TYPE(Dict_TYP), POINTER             :: Header,IO
    !------------------------------------------------------------------------!
    CHARACTER(LEN=6)  :: magic = "FOSITE"
    CHARACTER(LEN=1)  :: version = achar(0)
    CHARACTER(LEN=4)  :: sizes
    CHARACTER(LEN=13) :: sheader
    !------------------------------------------------------------------------!
    WRITE(sizes, '(I2,I2)') this%realsize, this%intsize
    sheader = magic // this%endianness(1:2) // version // sizes
    this%offset = 0
#ifndef PARALLEL
    WRITE(this%unit) sheader
#else
    CALL mpi_file_set_view(this%handle,this%offset,mpi_byte,&
         mpi_byte, 'native', mpi_info_null, this%error_io)
    IF(this%GetRank().EQ.0) &
      CALL mpi_file_write(this%handle,sheader,len(sheader),mpi_byte, &
        this%status,this%error_io)
#endif
    this%offset = this%offset + len(sheader)
  END SUBROUTINE writeheader

!  !> \public Reads the header of a file (not yet implemented)
!  !!
!  SUBROUTINE ReadHeader_binary(this,success)
!    IMPLICIT NONE
!    !------------------------------------------------------------------------!
!    TYPE(FileIO_TYP) :: this     !< \param [in,out] this fileio type
!    LOGICAL          :: success  !< \param [out] success
!    !------------------------------------------------------------------------!
!    INTENT(OUT)      :: success
!    INTENT(INOUT)    :: this
!    !------------------------------------------------------------------------!
!    success = .FALSE.
!  END SUBROUTINE ReadHeader_binary
!
!  !> \public Writes the timestep (not yet implemented)
!  !!
!  SUBROUTINE WriteTimestamp_binary(this,time)
!    IMPLICIT NONE
!    !------------------------------------------------------------------------!
!    TYPE(FileIO_TYP) :: this     !< \param [in,out] this fileio type
!    REAL             :: time     !< \param [in] time
!    !------------------------------------------------------------------------!
!    INTENT(IN)       :: time
!    INTENT(INOUT)    :: this
!    !------------------------------------------------------------------------!
!  END SUBROUTINE WriteTimestamp_binary
!
!  !> \public Writes the timestep (not yet implemented)
!  !!
!  SUBROUTINE ReadTimestamp_binary(this,time)
!    IMPLICIT NONE
!    !------------------------------------------------------------------------!
!    TYPE(FileIO_TYP) :: this     !< \param [in,out] this fileio type
!    REAL             :: time     !< \param [out] time
!    !------------------------------------------------------------------------!
!    INTENT(OUT)      :: time
!    INTENT(INOUT)    :: this
!    !------------------------------------------------------------------------!
!  END SUBROUTINE ReadTimestamp_binary


  SUBROUTINE writekey(this,key,type,bytes,dims)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(fileio_binary), INTENT(INOUT)         :: this
    CHARACTER(LEN=*)                            :: key
    INTEGER                                     :: type,bytes
    INTEGER, DIMENSION(5), OPTIONAL             :: dims
    INTEGER                                     :: bufsize
    CHARACTER(LEN=1), DIMENSION(:), ALLOCATABLE :: buf
    !------------------------------------------------------------------------!
    INTEGER                                     :: keylen,l,b,o
    !------------------------------------------------------------------------!
    INTENT(IN)                                  :: key,type,bytes
    !------------------------------------------------------------------------!
    keylen = len_trim(key)
    IF(PRESENT(dims)) THEN
      l = 3
      IF(dims(4).GT.1) l = 4
      IF(dims(5).GT.1) l = 5
    ELSE
      l = 0
    END IF
    b = bytes + l * this%intsize
    bufsize = (3+l) * this%intsize + keylen
    ALLOCATE(buf(bufsize))
    o = 1
    CALL append(buf,o,transfer(keylen,buf))
    CALL append(buf,o,transfer(trim(key),buf))
    CALL append(buf,o,transfer(type,buf))
    CALL append(buf,o,transfer(b,buf))
    IF(l.GT.0) THEN
      CALL append(buf,o,transfer(dims(1:l),buf))
    END IF
#ifndef PARALLEL
     WRITE(this%unit) buf
#else
    CALL mpi_file_set_view(this%handle,this%offset,mpi_byte,&
           mpi_byte, 'native', mpi_info_null, this%error_io)
    IF (this%GetRank().EQ.0) &
      CALL mpi_file_write(this%handle,buf,bufsize,mpi_byte, &
        this%status,this%error_io)
#endif
    DEALLOCATE(buf)
    this%offset = this%offset + bufsize

    CONTAINS
      SUBROUTINE append(buffer,i,d)
        IMPLICIT NONE
        !--------------------------------------------------------------------!
        CHARACTER(LEN=1), DIMENSION(:) :: buffer,d
        INTEGER                        :: i,s
        !--------------------------------------------------------------------!
        s = SIZE(d)
        buffer(i:i+s-1) = d
        o = o + s
      END SUBROUTINE
  END SUBROUTINE writekey


  RECURSIVE SUBROUTINE writedataattributes(this,Mesh,config,path)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(fileio_binary), INTENT(INOUT)     :: this
    CLASS(mesh_base), INTENT(IN)            :: mesh
    TYPE(dict_typ), POINTER                 :: config
    CHARACTER(LEN=*), OPTIONAL              :: path
    !------------------------------------------------------------------------!
    CHARACTER(LEN=MAX_CHAR_LEN)             :: str, key
    TYPE(dict_typ), POINTER                 :: node
    !------------------------------------------------------------------------!
    INTENT(IN)                              :: path
    !------------------------------------------------------------------------!
    IF(PRESENT(path)) THEN
        str = path
    ELSE
        str = ""
    ENDIF
    node => config
    DO WHILE(ASSOCIATED(node))
      key = trim(str)//"/"//trim(getkey(node))

      CALL this%WriteNode(mesh,key,node)

      IF(haschild(node)) THEN
        CALL this%WriteDataAttributes(mesh, getchild(node), key)
      END IF
      node=>getnext(node)
    END DO
  END SUBROUTINE writedataattributes

  SUBROUTINE writenode(this,Mesh,key,node)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(fileio_binary), INTENT(INOUT) :: this
    CLASS(mesh_base), INTENT(IN)        :: Mesh
    CHARACTER(LEN=MAX_CHAR_LEN)         :: key
    TYPE(Dict_TYP), POINTER             :: node
    !------------------------------------------------------------------------!
    TYPE(real_t)                            :: ptr0
    TYPE(int_t)                             :: ptrint
    REAL, DIMENSION(:,:), POINTER, CONTIGUOUS :: ptr2
    REAL, DIMENSION(:,:,:), POINTER         :: ptr3
    REAL, DIMENSION(:,:,:,:), POINTER       :: ptr4
    REAL, DIMENSION(:,:,:,:,:), POINTER     :: ptr5
    INTEGER, DIMENSION(5)                   :: dims
    INTEGER                                 :: bytes,k,l
    CHARACTER(LEN=1), DIMENSION(:), POINTER :: val
#ifdef PARALLEL
    offset_type                             :: omax,omin
#endif
    !------------------------------------------------------------------------!
    INTENT(IN)                              :: key
    !------------------------------------------------------------------------!
    dims(:) = 1
    NULLIFY(ptr2,ptr3,ptr4,ptr5)

    SELECT CASE(getdatatype(node))
    CASE(dict_real_twod)
      CALL getattr(node,key,ptr2)
      dims(1:2) = shape(ptr2)
    CASE(dict_real_threed)
      CALL getattr(node,key,ptr3)
      dims(1:3) = shape(ptr3)
    CASE(dict_real_fourd)
      CALL getattr(node,key,ptr4)
      dims(1:4) = shape(ptr4)
    CASE(dict_real_fived)
      CALL getattr(node,key,ptr5)
      dims(1:5) = shape(ptr5)
    END SELECT

    IF(product(dims).GT.1) THEN
      CALL this%SetMeshDims(mesh,dims)
      bytes = product(dims(1:3)) * this%realsize
      CALL this%WriteKey(key,getdatatype(node),&
        product(dims)*this%realsize,dims)
      DO l=1,dims(5)
        DO k=1,dims(4)
          IF(ASSOCIATED(ptr4)) THEN
            ptr3 => ptr4(:,:,:,k)
          ELSE IF(ASSOCIATED(ptr5)) THEN
            ptr3 => ptr5(:,:,:,k,l)
          ELSE IF(ASSOCIATED(ptr2)) THEN
            ptr3(1:dims(1),1:dims(2),1:1) => ptr2
          END IF
#ifdef PARALLEL
          IF(this%HasMeshDims(mesh,shape(ptr3))) THEN
            CALL mpi_file_set_view(this%handle,this%offset,default_mpi_real,&
                   this%filetype, 'native', mpi_info_null, this%error_io)
            CALL mpi_file_write_all(this%handle,ptr3,this%bufsize,&
                   default_mpi_real,this%status,this%error_io)

          ELSE IF(this%HasCornerDims(mesh,shape(ptr3))) THEN
            CALL mpi_file_set_view(this%handle,this%offset,default_mpi_real,&
                   this%cfiletype, 'native', mpi_info_null, this%error_io)
            CALL mpi_file_write_all(this%handle,ptr3(1:this%inum,1:this%jnum,1:this%knum),&
                   this%cbufsize,default_mpi_real,this%status,this%error_io)
          ELSE
            CALL mpi_file_set_view(this%handle,this%offset,mpi_byte,&
                 mpi_byte, 'native', mpi_info_null, this%error_io)
            IF(this%GetRank().EQ.0) THEN
              CALL mpi_file_write(this%handle,ptr3,bytes,mpi_byte, &
                   this%status,this%error_io)
            END IF
          END IF
#else
          WRITE(this%unit) ptr3
#endif
          this%offset = this%offset + bytes
        END DO
      END DO
    ELSE
      SELECT CASE(getdatatype(node))
      CASE(dict_real_p)
        CALL getattr(node,key,ptr0)
        bytes = this%realsize
        CALL this%WriteKey(key,dict_real,bytes)
#ifndef PARALLEL
          WRITE(this%unit) ptr0%p
#else
          CALL mpi_file_set_view(this%handle,this%offset,mpi_byte,&
               mpi_byte, 'native', mpi_info_null, this%error_io)
          IF(this%GetRank().EQ.0) THEN
            CALL mpi_file_write(this%handle,ptr0%p,bytes,mpi_byte, &
                 this%status,this%error_io)
          END IF
#endif
      CASE(dict_int_p)
        CALL getattr(node,key,ptrint)
        bytes = this%intsize
        CALL this%WriteKey(key,dict_int,bytes)
#ifndef PARALLEL
          WRITE(this%unit) ptrint%p
#else
          CALL mpi_file_set_view(this%handle,this%offset,mpi_byte,&
               mpi_byte, 'native', mpi_info_null, this%error_io)
          IF(this%GetRank().EQ.0) THEN
            CALL mpi_file_write(this%handle,ptrint%p,bytes,mpi_byte, &
                 this%status,this%error_io)
          END IF
#endif
      CASE DEFAULT
        val => getdata(node)
        IF(ASSOCIATED(val)) THEN
          bytes = SIZE(val)
        ELSE
          bytes = 0
        END IF
        CALL this%WriteKey(key,getdatatype(node),bytes)
        IF(bytes.GT.0) THEN
#ifndef PARALLEL
          WRITE(this%unit) val
#else
          CALL mpi_file_set_view(this%handle,this%offset,mpi_byte,&
               mpi_byte, 'native', mpi_info_null, this%error_io)
          IF(this%GetRank().EQ.0) THEN
            CALL mpi_file_write(this%handle,val,bytes,mpi_byte, &
                 this%status,this%error_io)
          END IF
#endif
        END IF
      END SELECT
      this%offset = this%offset + bytes
    END IF
#ifdef PARALLEL
    IF(this%first) THEN
      ! If MPI is used and this is the first output of the run,
      ! it is checked, if the offsets of the different nodes are still
      ! in sync. They can get easily out of sync is an output array is not
      ! a mesh or corner array, but still has a different size on some nodes.
      ! This easily happens, e.g. if one forgets to specify the subarray limits.
      ! output_array(Mesh%IMIN:Mesh%IMAX,Mesh%JMIN:Mesh%JMAX)
      ! The array would without them be interpreted as generic 2D array in
      ! this case and therefore the calculated size could be different on
      ! different nodes.
      CALL mpi_allreduce(this%offset,omax,1,mpi_offset,mpi_max,&
        mesh%comm_cart,this%error_io)
      CALL mpi_allreduce(this%offset,omin,1,mpi_offset,mpi_min,&
        mesh%comm_cart,this%error_io)
      IF((this%offset.NE.omax).OR.(this%offset.NE.omin)) &
        CALL this%Error("WriteNode_binary",&
          "The offsets on different nodes are not in sync anymore." // lf &
        //"The last key was '" // trim(key) // "'.")
    END IF
#endif
  END SUBROUTINE writenode

  FUNCTION hasmeshdims(this,Mesh,dims) RESULT(res)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(fileio_binary), INTENT(INOUT) :: this
    CLASS(mesh_base), INTENT(IN)        :: mesh
    INTEGER, DIMENSION(:)               :: dims
    LOGICAL                             :: res
    !------------------------------------------------------------------------!
    INTENT(IN)                          :: dims
    !------------------------------------------------------------------------!
    IF(SIZE(dims).GE.3) THEN
      res = (dims(1).EQ.(mesh%IMAX-mesh%IMIN+mesh%ip1).OR.mesh%INUM.EQ.1) &
            .AND.(dims(2).EQ.(mesh%JMAX-mesh%JMIN+mesh%jp1).OR.mesh%JNUM.EQ.1) &
            .AND.(dims(3).EQ.(mesh%KMAX-mesh%KMIN+mesh%kp1).OR.mesh%KNUM.EQ.1)
    ELSE
      res = .false.
    END IF
  END FUNCTION hasmeshdims


  FUNCTION hascornerdims(this,Mesh,dims) RESULT(res)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(fileio_binary), INTENT(INOUT) :: this
    CLASS(mesh_base), INTENT(IN)        :: mesh
    INTEGER, DIMENSION(:)               :: dims
    LOGICAL                             :: res
    !------------------------------------------------------------------------!
    INTENT(IN)                          :: dims
    !------------------------------------------------------------------------!
    IF(SIZE(dims).GE.3) THEN
      res = (dims(1).EQ.(mesh%IMAX-mesh%IMIN+mesh%ip2).OR.mesh%INUM.EQ.1) &
            .AND.(dims(2).EQ.(mesh%JMAX-mesh%JMIN+mesh%jp2).OR.mesh%JNUM.EQ.1) &
            .AND.(dims(3).EQ.(mesh%KMAX-mesh%KMIN+mesh%kp2).OR.mesh%KNUM.EQ.1)
    ELSE
      res = .false.
    END IF
  END FUNCTION hascornerdims


  SUBROUTINE setmeshdims(this,Mesh,dims)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(fileio_binary), INTENT(INOUT) :: this
    CLASS(mesh_base), INTENT(IN)        :: Mesh
    INTEGER, DIMENSION(:)               :: dims
    !------------------------------------------------------------------------!
    INTENT(INOUT)                       :: dims
    !------------------------------------------------------------------------!
    IF(this%HasMeshDims(mesh,dims)) THEN
      dims(1) = mesh%INUM
      dims(2) = mesh%JNUM
      dims(3) = mesh%KNUM
    ELSE IF(this%HasCornerDims(mesh,dims)) THEN
      dims(1) = mesh%INUM+mesh%ip1
      dims(2) = mesh%JNUM+mesh%jp1
      dims(3) = mesh%KNUM+mesh%kp1
    END IF
  END SUBROUTINE setmeshdims


  SUBROUTINE writedataset(this,Mesh,Physics,Fluxes,Timedisc,Header,IO)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(fileio_binary), INTENT(INOUT) :: this
    CLASS(mesh_base), INTENT(IN)        :: Mesh
    CLASS(physics_base), INTENT(INOUT)  :: Physics
    CLASS(fluxes_base), INTENT(IN)      :: Fluxes
    CLASS(timedisc_base), INTENT(IN)    :: Timedisc
    TYPE(Dict_TYP), POINTER             :: Header,IO
    !------------------------------------------------------------------------!
    IF (ASSOCIATED(timedisc%w)) THEN
      IF (mesh%FARGO.EQ.3.AND.mesh%shear_dir.EQ.1) THEN
        CALL physics%AddBackgroundVelocityX(mesh,timedisc%w,timedisc%pvar,timedisc%cvar)
      ELSE
        CALL physics%AddBackgroundVelocityY(mesh,timedisc%w,timedisc%pvar,timedisc%cvar)
      END IF
    END IF

    ! write data
    CALL this%OpenFile(replace)
    CALL this%WriteHeader(mesh,physics,header,io)
    CALL this%WriteDataAttributes(mesh,io)
    CALL this%CloseFile()
    CALL this%IncTime()

#ifdef PARALLEL
    this%first = .false.
#endif

  END SUBROUTINE writedataset

!  !> \public Reads the data arrays from file (not yet implemented)
!  !!
!  SUBROUTINE ReadDataset_binary(this,Mesh,Physics,Timedisc)
!    IMPLICIT NONE
!    !------------------------------------------------------------------------!
!    TYPE(FileIO_TYP)  :: this      !< \param [in,out] this fileio type
!    TYPE(Mesh_TYP)    :: Mesh      !< \param [in] mesh mesh type
!    TYPE(Physics_TYP) :: Physics   !< \param [in] physics physics type
!    TYPE(Timedisc_TYP):: Timedisc  !< \param [in,out] timedisc timedisc type
!    !------------------------------------------------------------------------!
!    INTENT(IN)        :: Mesh,Physics
!    INTENT(INOUT)     :: this,Timedisc
!    !------------------------------------------------------------------------!
!  END SUBROUTINE ReadDataset_binary

  SUBROUTINE getendianness(this, res, littlestr, bigstr)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(fileio_binary), INTENT(INOUT) :: this
    CHARACTER(LEN=*)                    :: res
    CHARACTER(LEN=*)                    :: littlestr
    CHARACTER(LEN=*)                    :: bigstr
    !------------------------------------------------------------------------!
    INTEGER                             :: k,err,iTIPO
    CHARACTER, POINTER                  :: cTIPO(:)
    !------------------------------------------------------------------------!
    INTENT(OUT)                         :: res
    !------------------------------------------------------------------------!

    !endianness
    k = bit_size(itipo)/8
    ALLOCATE(ctipo(k),stat = err)
       IF (err.NE.0) &
         CALL this%Error("GetEndianness_binary", "Unable to allocate memory.")
    ctipo(1)='A'
    !cTIPO(2:k-1) = That's of no importance.
    ctipo(k)='B'

    itipo = transfer(ctipo, itipo)
    DEALLOCATE(ctipo)
    !Test of 'B'=b'01000010' ('A'=b'01000001')
    IF (btest(itipo,1)) THEN ! big endian
       write(res,'(A)',iostat=err)bigstr
    ELSE ! little endian
       write(res,'(A)',iostat=err)littlestr
    END IF
  END SUBROUTINE getendianness

  SUBROUTINE closefile(this)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(fileio_binary), INTENT(INOUT) :: this
#ifndef PARALLEL
    INTEGER                             :: err
#endif
    !------------------------------------------------------------------------!
#ifdef PARALLEL
    CALL mpi_file_close(this%handle,this%error_io)
#else
    CLOSE(this%unit,iostat=err)
#endif
  END SUBROUTINE closefile

  SUBROUTINE finalize(this)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(fileio_binary), INTENT(INOUT) :: this
    !------------------------------------------------------------------------!
#ifdef PARALLEL
    CALL mpi_type_free(this%cfiletype,this%error_io)
    CALL mpi_type_free(this%filetype,this%error_io)
#endif
    CALL this%Finalize_base()
  END SUBROUTINE finalize

END MODULE fileio_binary_mod