fileio_base.f90

Go to the documentation of this file.

!#############################################################################
!#                                                                           #
!# fosite - 3D hydrodynamical simulation program                             #
!# module: fileio_base.f90                                                   #
!#                                                                           #
!# Copyright (C) 2008-2024                                                   #
!# Tobias Illenseer <tillense@astrophysik.uni-kiel.de>                       #
!# Björn Sperling   <sperling@astrophysik.uni-kiel.de>                       #
!# 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.                 #
!#                                                                           #
!#############################################################################
#ifdef HAVE_NETCDF
!! \key{ncfmt,INTEGER,netcdf format type}
#endif
!----------------------------------------------------------------------------!
!----------------------------------------------------------------------------!
MODULE fileio_base_mod
  USE logging_base_mod
  USE common_dict
  USE fluxes_base_mod
  USE physics_base_mod
  USE sources_generic_mod
  USE mesh_base_mod
  USE timedisc_base_mod
#ifdef PARALLEL
#ifdef HAVE_MPI_MOD
  USE mpi
#endif
#endif
  IMPLICIT NONE
#ifdef PARALLEL
#ifdef HAVE_MPIF_H
  include 'mpif.h'
#endif
#endif
  !--------------------------------------------------------------------------!
  PRIVATE
  !--------------------------------------------------------------------------!
  ! Private Attributes section starts here:
  INTEGER, PARAMETER :: fextlen = 4
  INTEGER, PARAMETER :: fcyclen = 5
  INTEGER, PARAMETER :: fnamlen = 256
  INTEGER, PARAMETER :: fpatlen = 1024
  INTEGER, PARAMETER           :: maxcycles = 10000
  !--------------------------------------------------------------------------!
  TYPE, EXTENDS(logging_base), abstract :: filehandle_base
  CONTAINS
    procedure(initfilehandle_deferred), DEFERRED :: initfilehandle
    procedure(openfile_deferred), DEFERRED       :: openfile
    procedure(closefile_deferred), DEFERRED      :: closefile
    procedure(getbasename_deferred), DEFERRED    :: getbasename
    procedure(getfilename_deferred), DEFERRED    :: getfilename
    procedure(getstatus_deferred), DEFERRED      :: getstatus
  END TYPE filehandle_base
  TYPE, EXTENDS(filehandle_base) :: filehandle_fortran
    INTEGER   :: fid
    LOGICAL   :: textfile
    LOGICAL   :: onefile
    INTEGER   :: cycles
    CHARACTER(LEN=FNAMLEN) :: filename
    CHARACTER(LEN=FPATLEN) :: path
    CHARACTER(LEN=FEXTLEN) :: extension
  CONTAINS
    PROCEDURE :: initfilehandle
    PROCEDURE :: openfile
    PROCEDURE :: closefile
    PROCEDURE :: getfilename
    PROCEDURE :: getbasename
    PROCEDURE :: getunitnumber
    PROCEDURE :: getformat
    PROCEDURE :: getstatus
    PROCEDURE :: getstepstring
    final :: finalize_fortran
  END TYPE filehandle_fortran
 
  TYPE, EXTENDS(filehandle_fortran) :: filehandle_mpi
#ifdef PARALLEL
    INTEGER                :: basictype,& !< basic MPI data type
                              cfiletype,& !< data types for MPI i/o
                              filetype
    INTEGER, DIMENSION(MPI_STATUS_SIZE) :: status
  CONTAINS
    PROCEDURE :: initfilehandle => initfilehandle_mpi
    PROCEDURE :: openfile => openfile_mpi
    PROCEDURE :: closefile => closefile_mpi
    PROCEDURE :: getstatus => getstatus_mpi
    final :: finalize_mpi
#endif
  END TYPE filehandle_mpi
 
  TYPE, ABSTRACT,EXTENDS(logging_base) :: fileio_base
     CLASS(filehandle_fortran), ALLOCATABLE &
                            :: datafile
     LOGICAL                :: cartcoords
!      INTEGER                :: unit        !< i/o unit
     INTEGER                :: step
     INTEGER                :: count
     INTEGER                :: dtwall
     INTEGER                :: inum,jnum,& !< local mesh extent
                               knum
     INTEGER                :: bufsize
     REAL                   :: stoptime
     REAL                   :: starttime
     REAL                   :: time
     REAL                   :: walltime
!      REAL, DIMENSION(:,:,:,:), POINTER :: &
!                                binout      !< binary data output buffer
!      REAL, DIMENSION(:,:) , POINTER  :: &
!                                bflux       !< boundary flux output buffer
#ifdef PARALLEL
 
#endif
  CONTAINS
    procedure(initfileio_deferred), DEFERRED   :: initfileio_deferred
    PROCEDURE :: initfileio_base
    generic   :: initfileio => initfileio_base, initfileio_deferred
    procedure(writeheader), DEFERRED  :: writeheader
    PROCEDURE :: writedataset
    procedure(writedataset_deferred), DEFERRED :: writedataset_deferred
    PROCEDURE :: adjusttimestep
    PROCEDURE :: finalize_base
    PROCEDURE :: getendianness
!     PROCEDURE :: MakeMultstr
    PROCEDURE :: inctime
  END TYPE fileio_base
 
  ! Interfaces
  abstract INTERFACE
    SUBROUTINE initfilehandle_deferred(this,filename,path,extension,textfile,onefile,cycles,unit)
      IMPORT filehandle_base
      IMPLICIT NONE
      !------------------------------------------------------------------------!
      CLASS(filehandle_base), INTENT(INOUT) :: this
      CHARACTER(LEN=*), INTENT(IN) :: filename
      CHARACTER(LEN=*), INTENT(IN) :: path
      CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: extension
      LOGICAL, OPTIONAL, INTENT(IN)      :: textfile
      LOGICAL, OPTIONAL, INTENT(IN)      :: onefile
      INTEGER, OPTIONAL, INTENT(IN)      :: cycles
      INTEGER, OPTIONAL, INTENT(IN)      :: unit
    END SUBROUTINE
    SUBROUTINE openfile_deferred(this,action,step)
      IMPORT filehandle_base
      IMPLICIT NONE
      !------------------------------------------------------------------------!
      CLASS(filehandle_base), INTENT(INOUT)   :: this
      INTEGER,           INTENT(IN)           :: action
      INTEGER,           INTENT(IN)           :: step
    END SUBROUTINE
    SUBROUTINE closefile_deferred(this,step)
      IMPORT filehandle_base
      IMPLICIT NONE
      !------------------------------------------------------------------------!
      CLASS(filehandle_base), INTENT(INOUT) :: this
      INTEGER, INTENT(IN)                      :: step
    END SUBROUTINE
    FUNCTION getbasename_deferred(this,step) RESULT (fname)
      IMPORT filehandle_base
      IMPLICIT NONE
      !------------------------------------------------------------------------!
      CLASS(filehandle_base), INTENT(IN)  :: this
      INTEGER, INTENT(IN)                 :: step
      CHARACTER(LEN=256)                  :: fname
    END FUNCTION
    FUNCTION getfilename_deferred(this,step) RESULT (fname)
      IMPORT filehandle_base
      IMPLICIT NONE
      !------------------------------------------------------------------------!
      CLASS(filehandle_base), INTENT(IN)  :: this
      INTEGER, INTENT(IN)                 :: step
      CHARACTER(LEN=256)                  :: fname
    END FUNCTION
    FUNCTION getstatus_deferred(this,step) RESULT(fstatus)
      IMPORT filehandle_base
      IMPLICIT NONE
      !------------------------------------------------------------------------!
      CLASS(filehandle_base), INTENT(INOUT) :: this
      INTEGER, INTENT(IN)                      :: step
      INTEGER :: fstatus
    END FUNCTION
    SUBROUTINE initfileio_deferred(this,Mesh,Physics,Timedisc,Sources,config,IO)
      IMPORT fileio_base,mesh_base,physics_base,fluxes_base,timedisc_base,sources_list,dict_typ
      IMPLICIT NONE
      !------------------------------------------------------------------------!
      CLASS(fileio_base),  INTENT(INOUT) :: this
      CLASS(mesh_base),    INTENT(IN)    :: Mesh
      CLASS(physics_base), INTENT(IN)    :: Physics
      CLASS(timedisc_base),INTENT(IN)    :: Timedisc
      CLASS(sources_list), ALLOCATABLE, INTENT(IN)    :: Sources
      TYPE(dict_typ),      INTENT(IN), POINTER :: config
      TYPE(dict_typ),      INTENT(IN), POINTER :: IO
    END SUBROUTINE
    SUBROUTINE writedataset_deferred(this,Mesh,Physics,Fluxes,Timedisc,Header,IO)
      IMPORT fileio_base,mesh_base,physics_base,fluxes_base,timedisc_base,dict_typ
      IMPLICIT NONE
      CLASS(fileio_base),   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
    END SUBROUTINE
    SUBROUTINE writeheader(this,Mesh,Physics,Header,IO)
      IMPORT fileio_base,mesh_base,physics_base,dict_typ
      IMPLICIT NONE
      CLASS(fileio_base),  INTENT(INOUT)  :: this
      CLASS(mesh_base),    INTENT(IN)     :: Mesh
      CLASS(physics_base), INTENT(IN)     :: Physics
      TYPE(dict_typ), POINTER             :: Header,IO
    END SUBROUTINE
    SUBROUTINE finalize(this)
      IMPORT fileio_base
      IMPLICIT NONE
      CLASS(fileio_base),  INTENT(INOUT)  :: this
    END SUBROUTINE
  END INTERFACE
  !--------------------------------------------------------------------------!
 
!  INTEGER, PARAMETER :: FILE_EXISTS = B'00000001' !< file status for existing files
  INTEGER, PARAMETER :: closed   = 0
  INTEGER, PARAMETER :: readonly = 1
  INTEGER, PARAMETER :: readend  = 2
  INTEGER, PARAMETER :: replace  = 3
  INTEGER, PARAMETER :: append   = 4
  INTEGER, PARAMETER :: open_undef = 5
 
  INTEGER, PARAMETER :: fortranfile = 1
  INTEGER, PARAMETER :: mpifile = 2
  INTEGER, PARAMETER :: binary  = 1
  INTEGER, PARAMETER :: gnuplot = 2
  INTEGER, PARAMETER :: vtk     = 4
!  INTEGER, PARAMETER :: NPY     = 5
!  INTEGER, PARAMETER :: HDF     = 6
  INTEGER, PARAMETER :: xdmf    = 7
  !--------------------------------------------------------------------------!
  INTEGER, SAVE :: lastunit = 10
 
  INTERFACE filehandle_fortran
    MODULE PROCEDURE createfilehandle
  END INTERFACE
    !--------------------------------------------------------------------------!
  PUBLIC :: &
       ! types
       fileio_base, &
       filehandle_fortran, &
       ! constants
       binary, gnuplot, vtk, xdmf, &
#ifdef PARALLEL
       filehandle_mpi, &
       default_mpi_real,&
#endif
       closed, readonly, readend, replace, append
 
 
CONTAINS
 
 
  FUNCTION createfilehandle(filename,path,extension,textfile) RESULT(new_fh)
    IMPLICIT NONE
    !-------------------------------------------------------------------!
    TYPE(filehandle_fortran) :: new_fh
    CHARACTER(LEN=*), INTENT(IN) :: filename
    CHARACTER(LEN=*), INTENT(IN) :: path
    CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: extension
    LOGICAL, OPTIONAL, INTENT(IN)      :: textfile
    !-------------------------------------------------------------------!
    CALL new_fh%InitFilehandle(filename,path,extension,textfile)
  END FUNCTION createfilehandle
 
  SUBROUTINE initfilehandle(this,filename,path,extension,textfile,onefile,cycles,unit)
    IMPLICIT NONE
    !-------------------------------------------------------------------!
    CLASS(filehandle_fortran), INTENT(INOUT) :: this
    CHARACTER(LEN=*), INTENT(IN) :: filename
    CHARACTER(LEN=*), INTENT(IN) :: path
    CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: extension
    LOGICAL, OPTIONAL, INTENT(IN)      :: textfile
    LOGICAL, OPTIONAL, INTENT(IN)      :: onefile
    INTEGER, OPTIONAL, INTENT(IN)      :: cycles
    INTEGER, OPTIONAL, INTENT(IN)      :: unit
    !-------------------------------------------------------------------!
    IF (.NOT.this%Initialized()) CALL this%InitLogging(fortranfile,"fortran")
    ! check file name length
    IF (len_trim(filename).GT.fnamlen) &
       CALL this%Error("fileio_base::InitFilehandle","file name too long")
    this%filename = filename
    ! check file path length
    IF (len_trim(path).GT.fpatlen) &
       CALL this%Error("fileio_base::InitFilehandle","file path too long")
    this%path = path
    IF (PRESENT(textfile)) THEN
      this%textfile = textfile
    ELSE
      this%textfile = .true. ! default is textfile
    END IF
    ! check file name extension
    IF (PRESENT(extension)) THEN
      IF (len_trim(extension).GT.fextlen) &
        CALL this%Error("fileio_base::InitFilehandle","file name extension too long")
      this%extension = extension
    ELSE
      IF (this%textfile) THEN
        this%extension = "txt"
      ELSE
        this%extension = "bin"
      END IF
    END IF
    IF (PRESENT(onefile)) THEN
      this%onefile = onefile
    ELSE
      this%onefile = .false. ! default is multiple data files (one for each time step)
    END IF
    IF (PRESENT(cycles)) THEN
      this%cycles = cycles
    ELSE
      this%cycles = maxcycles
    END IF
    IF (PRESENT(unit)) THEN
      IF (unit.EQ.lastunit) &
         CALL this%Error("filehandle_fortran::InitFilehandle","fortran i/o unit number already assigned")
      this%fid = unit
    ELSE
      this%fid = lastunit + 1
    END IF
    lastunit = this%fid
  END SUBROUTINE initfilehandle
 
  SUBROUTINE initfileio_base(this,Mesh,Physics,Timedisc,Sources,config,IO,fmtname,fext,textfile)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(fileio_base),  INTENT(INOUT) :: this
    CLASS(mesh_base),    INTENT(IN)    :: Mesh
    CLASS(physics_base), INTENT(IN)    :: Physics
    CLASS(timedisc_base),INTENT(IN)    :: Timedisc
    CLASS(sources_list), ALLOCATABLE, INTENT(IN) :: Sources
    TYPE(dict_typ),      INTENT(IN), POINTER :: config
    TYPE(dict_typ),      INTENT(IN), POINTER :: IO
    CHARACTER(LEN=*),    INTENT(IN)    :: fmtname
    CHARACTER(LEN=*),    INTENT(IN)    :: fext
    LOGICAL, OPTIONAL, INTENT(IN)      :: textfile
    !------------------------------------------------------------------------!
    INTEGER                        :: fileformat
    CHARACTER(LEN=MAX_CHAR_LEN)    :: fname
    CHARACTER(LEN=MAX_CHAR_LEN)    :: fpath
    INTEGER                        :: unit
    LOGICAL                        :: onefile
    CHARACTER(LEN=32)              :: timestamp
    INTEGER                        :: cycles,dtwall,cartcoords
    REAL                           :: stoptime
    REAL                           :: time
    !------------------------------------------------------------------------!
    CALL getattr(config, "fileformat", fileformat)
    ! InitLogging after reading fileformat from config
    CALL this%InitLogging(fileformat,fmtname)
 
    ! get file name and path from dictionary
    CALL getattr(config, "filename"  , fname)
    fpath = ""
    CALL getattr(config, "filepath"  , fpath, fpath)
 
    ! number of output steps
    CALL getattr(config, "count" , this%count, 1)
 
    ! number of data files
    ! cycles = 0     : one data file, append data
    ! cycles = 1     : one data file, overwrite data
    ! cycles = X > 1 : X data files
    CALL getattr(config, "filecycles", cycles, this%count+1)
    ! check cycles
    IF (cycles.GT.maxcycles) &
       CALL this%Error("fileio_base::InitFileIO_base","file cycles exceed limits")
 
    IF (cycles.GT.1) THEN
       onefile = .false.
    ELSE
       onefile = .true.
    END IF
    ! fortran i/o unit
    CALL getattr(config, "unit"      , unit , lastunit+1)
 
    ! wall clock time between successive outputs
    ! this is mainly intended for log file outputs
    CALL getattr(config, "dtwall" , this%dtwall, 3600) !default is one hour
 
    ! stop time for output defaults to simulation stop time
    CALL getattr(config, "stoptime"  , this%stoptime, timedisc%stoptime)
    CALL getattr(config, "walltime"  , this%walltime, huge(1.0))
 
    ! initial step, usually 0 except for restarted simulations
    CALL getattr(config, "step", this%step, 0)
 
    ! mesh coordinates are cartesian by default (cartcoords == 1)
    ! set to 0 for curvilinear coordinates (currently supported in gnuplot and vtk)
    CALL getattr(config, "cartcoords", cartcoords, 1)
    IF (cartcoords.EQ.0) THEN
      this%cartcoords = .false.
    ELSE
      this%cartcoords = .true.
    END IF
 
    ! initialize file handle for the data file
    IF (.NOT.ALLOCATED(this%datafile)) THEN
      ! this is the default if the datafile has not been allocated within the calling scope
#ifdef PARALLEL
      ALLOCATE(filehandle_mpi::this%datafile)
#else
      ALLOCATE(filehandle_fortran::this%datafile)
#endif
    END IF
    CALL this%datafile%InitFilehandle(fname,fpath,fext,textfile,onefile,cycles,unit)
 
    this%starttime = timedisc%time  ! set to initial time defined in Timedisc
    this%time      = this%starttime
    this%err       = 0
 
    ! print some information
    CALL this%Info(" FILEIO---> file type:         " // trim(this%GetName()))
    CALL this%Info("            file name:         " // trim(this%datafile%GetFilename(this%step)))
    WRITE (timestamp,'(ES12.4)') timedisc%time
    CALL this%Info("            time stamp:        " // trim(timestamp))
    IF (.NOT.this%cartcoords) &
      CALL this%Info("    cruvilinear coords:        yes")
 
    ! time for next output
    IF (timedisc%time.GT.0.0) CALL this%IncTime()
 
 
!!!!! old fosite code, may be obsolete
! #ifdef PARALLEL
!     ! check data type extents in files
!     ! first try to create a new dummy file
!     CALL MPI_File_open(MPI_COMM_WORLD,GetFilename(this),IOR(IOR(MPI_MODE_RDWR,&
!          MPI_MODE_CREATE),IOR(MPI_MODE_EXCL,MPI_MODE_DELETE_ON_CLOSE)),&
!          MPI_INFO_NULL,this%handle,this%error)
!     ! maybe file exists
!     IF (this%error.NE.0) CALL MPI_File_open(MPI_COMM_WORLD,GetFilename(this),&
!          MPI_MODE_RDONLY,MPI_INFO_NULL,this%handle,this%error)
!     ! then check the data type sizes
!     ! extent of integer in file
!     IF (this%error.EQ.0) CALL MPI_File_get_type_extent(this%handle,MPI_INTEGER,&
!          this%intext,this%error)
!     ! extent of real in file
!     IF (this%error.EQ.0) CALL MPI_File_get_type_extent(this%handle,DEFAULT_MPI_REAL,&
!          this%realext,this%error)
!     IF (this%error.NE.0) CALL Error(this,"InitFileIO","unable to check file properties")
!     CALL MPI_File_close(this%handle,this%error)
! #endif
  END SUBROUTINE initfileio_base
 
  SUBROUTINE writedataset(this,Mesh,Physics,Fluxes,Timedisc,Header,IO)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(fileio_base), 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
    !------------------------------------------------------------------------!
    ! transform to true velocities if fargo is enabled
    IF (ASSOCIATED(timedisc%w)) THEN
      SELECT CASE(mesh%fargo%GetDirection())
      CASE(1)
        CALL physics%AddBackgroundVelocityX(mesh,timedisc%w,timedisc%pvar,timedisc%cvar)
      CASE(2)
        CALL physics%AddBackgroundVelocityY(mesh,timedisc%w,timedisc%pvar,timedisc%cvar)
      CASE(3)
        CALL physics%AddBackgroundVelocityZ(mesh,timedisc%w,timedisc%pvar,timedisc%cvar)
      END SELECT
    END IF
 
    ! open data file and write header if necessary
    IF ((.NOT.this%datafile%onefile).OR.this%step.EQ.0) THEN
      CALL this%datafile%OpenFile(replace,this%step)
      CALL this%WriteHeader(mesh,physics,header,io)
    ELSE
      CALL this%datafile%OpenFile(append,this%step)
    END IF
 
    ! write data
    CALL this%WriteDataset_deferred(mesh,physics,fluxes,timedisc,header,io)
 
    ! close data file and increment output time for next output
    CALL this%datafile%CloseFile(this%step)
    CALL this%IncTime()
  END SUBROUTINE writedataset
 
 
  SUBROUTINE getendianness(this, res, littlestr, bigstr)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(fileio_base), INTENT(INOUT):: this
    CHARACTER(LEN=*)                 :: res
    CHARACTER(LEN=*)                 :: littlestr
    CHARACTER(LEN=*)                 :: bigstr
    !------------------------------------------------------------------------!
    INTEGER                          :: k,iTIPO
    CHARACTER, POINTER               :: cTIPO(:)
    !------------------------------------------------------------------------!
    INTENT(IN)                       :: littlestr, bigstr
    INTENT(OUT)                      :: res
    !------------------------------------------------------------------------!
    !endianness
    k = bit_size(itipo)/8
    ALLOCATE(ctipo(k),stat = this%err)
       IF (this%err.NE.0) &
         CALL this%Error("GetEndianness", "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
       write(res,'(A)',iostat=this%err)bigstr
    ELSE
       write(res,'(A)',iostat=this%err)littlestr
    END IF
  END SUBROUTINE getendianness
 
  PURE SUBROUTINE inctime(this)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(fileio_base), INTENT(INOUT) :: this
    !------------------------------------------------------------------------!
    this%time = this%time + abs(this%stoptime - this%starttime) / this%count
    this%step = this%step + 1
  END SUBROUTINE inctime
 
 
  PURE SUBROUTINE adjusttimestep(this,time,dt,dtcause)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(fileio_base), INTENT(IN) :: this
    REAL                           :: time
    REAL                           :: dt
    INTEGER                        :: dtcause
    !------------------------------------------------------------------------!
    INTENT(INOUT)    :: time,dt,dtcause
    !------------------------------------------------------------------------!
    IF ((time+dt)/this%time.GT.1.0) THEN
       dt = this%time - time
       dtcause = dtcause_fileio
    ELSE IF((time+1.5*dt)/this%time.GT.1.0) THEN
       dt = 0.5*(this%time - time)
       dtcause = dtcause_fileio
    END IF
  END SUBROUTINE adjusttimestep
 
 
  SUBROUTINE finalize_base(this)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(fileio_base),INTENT(INOUT) :: this
    !------------------------------------------------------------------------!
    IF (.NOT.this%Initialized()) &
        CALL this%Error("fileio_base::Finalize_base","FileIO not initialized")
    IF (ALLOCATED(this%datafile)) DEALLOCATE(this%datafile)
  END SUBROUTINE finalize_base
 
  SUBROUTINE openfile(this,action,step)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(filehandle_fortran), INTENT(INOUT):: this
    INTEGER,           INTENT(IN)           :: action
    INTEGER,           INTENT(IN)           :: step
    !------------------------------------------------------------------------!
    CHARACTER(LEN=32)  :: sta,act,pos,frm
    !------------------------------------------------------------------------!
    SELECT CASE(action)
    CASE(readonly)
       sta = 'OLD'
       act = 'READ'
       pos = 'REWIND'
    CASE(readend)
       sta = 'OLD'
       act = 'READ'
       pos = 'APPEND'
    CASE(replace)
       sta = 'REPLACE'
       act = 'WRITE'
       pos = 'REWIND'
    CASE(append)
       sta = 'OLD'
       act = 'READWRITE'
       pos = 'APPEND'
    CASE DEFAULT
       CALL this%Error("fileio_base::OpenFile","Unknown access mode.")
    END SELECT
    this%err = 0
    CALL this%CloseFile(step) ! make sure we don't open an already opened file
    IF (this%err.EQ.0) &
      OPEN(unit=this%GetUnitNumber(),file=trim(this%GetFilename(step)),status=trim(sta), &
           access='STREAM',action=trim(act),position=trim(pos),form=trim(this%GetFormat()), &
           iostat=this%err)
    IF (this%err.NE.0) &
      CALL this%Error("fileio_base::OpenFile","File opening failed for: " // &
        trim(this%GetFilename(step)))
  END SUBROUTINE openfile
 
  FUNCTION getunitnumber(this)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(filehandle_fortran), INTENT(INOUT) :: this
    !------------------------------------------------------------------------!
    INTEGER :: getunitnumber
    !------------------------------------------------------------------------!
    getunitnumber = this%fid
  END FUNCTION getunitnumber
 
  FUNCTION getstatus(this,step)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(filehandle_fortran), INTENT(INOUT) :: this
    INTEGER, INTENT(IN)                      :: step
    !------------------------------------------------------------------------!
    INTEGER :: getstatus
    LOGICAL :: ex,op
    CHARACTER(LEN=64) :: act,pos
    !------------------------------------------------------------------------!
#if DEBUG > 2
      print *,"DEBUG INFO in fileio_base::GetStatus: called for " // trim(this%GetFilename(step)), &
        ", unit:", this%GetUnitNumber()
#endif
    getstatus = -1 ! unknown / undefined / does not exist
    ! check if file exist
    act="NO-RETURN-VALUE"
    pos="NO-RETURN-VALUE"
    INQUIRE(file=trim(this%GetFilename(step)),exist=ex,opened=op,action=act,position=pos,iostat=this%err)
#if DEBUG > 2
    print *,"DEBUG INFO in fileio_base::GetStatus: inquire results (ex,op,act,pos): ", &
      ex, op, " " // trim(act) // " " // trim(pos)
#endif
    IF (this%err.NE.0) &
       CALL this%Error("filehandle_fortran::GetStatus","serious failure during file inquiry")
    IF (ex) THEN
       ! file exists
       IF (op) THEN
          ! file is open
          getstatus = open_undef
          SELECT CASE(trim(act))
          CASE("READ")
            SELECT CASE(trim(pos))
            CASE("REWIND")
               getstatus = readonly
            CASE("APPEND")
               getstatus = readend
            END SELECT
          CASE("WRITE","READWRITE")
            SELECT CASE(trim(pos))
            CASE("REWIND")
               getstatus = replace
            CASE("APPEND")
               getstatus = append
            END SELECT
          END SELECT
       ELSE
          ! file exists, but is closed
          getstatus = closed
       END IF
    ELSE
       ! file doesn't exist -> return negative number
    END IF
  END FUNCTION getstatus
 
  FUNCTION getformat(this)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(filehandle_fortran), INTENT(INOUT) :: this
    !------------------------------------------------------------------------!
    CHARACTER(LEN=16) :: getformat
    !------------------------------------------------------------------------!
    IF (this%textfile) THEN
      getformat = "FORMATTED"
    ELSE
      getformat = "UNFORMATTED"
    END IF
  END FUNCTION getformat
 
  PURE FUNCTION getstepstring(this,step)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(filehandle_fortran), INTENT(IN) :: this
    INTEGER, INTENT(IN)                   :: step
    CHARACTER(LEN=FCYCLEN)                :: getstepstring
    !------------------------------------------------------------------------!
    CHARACTER(LEN=16)                 :: fmtstr
    !-------------------------------------------------------------------!
    WRITE (fmtstr ,'(A,I1,A)') "(A1,I0.",fcyclen-1,")"
    IF (step.LT.0.OR.step.GE.maxcycles) THEN
      ! return _X...X if step is invalid, i.e. negative or exceeds maximum
      getstepstring = "_" // repeat("X",fcyclen-1)
    ELSE IF (step.EQ.0) THEN
      WRITE(getstepstring, fmt=trim(fmtstr)) "_",0
    ELSE
      ! determine file number based on current step and number of files,
      ! i.e. cycles, and generate the file name with these extensions
      WRITE(getstepstring, fmt=trim(fmtstr)) "_",modulo(step,this%cycles)
    END IF
  END FUNCTION getstepstring
 
  FUNCTION getbasename(this,step) RESULT (fname)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(filehandle_fortran), INTENT(IN) :: this
    INTEGER, INTENT(IN)                   :: step
    CHARACTER(LEN=256)                    :: fname
    !------------------------------------------------------------------------!
    IF (this%onefile) THEN
       ! all data goes into one file -> no extra string indicating time step
       fname = trim(this%filename)
    ELSE
       ! insert extra string for each time step before the extension
       fname = trim(this%filename) // trim(this%GetStepString(step))
    END IF
  END FUNCTION getbasename
 
  FUNCTION getfilename(this,step)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(filehandle_fortran), INTENT(IN) :: this
    INTEGER, INTENT(IN)                   :: step
    !------------------------------------------------------------------------!
    CHARACTER(LEN=256) :: getfilename
    !------------------------------------------------------------------------!
    getfilename = trim(this%path) // trim(this%GetBasename(step)) // "." // trim(this%extension)
  END FUNCTION getfilename
 
  SUBROUTINE closefile(this,step)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(filehandle_fortran), INTENT(INOUT) :: this
    INTEGER, INTENT(IN)                      :: step
    !------------------------------------------------------------------------!
#if DEBUG > 2
      print *,"DEBUG INFO in fileio_base::CloseFile: called for " // trim(this%GetFilename(step)), &
        ", unit:", this%GetUnitNumber()
#endif
    this%err = 0
    IF (this%GetStatus(step).GT.0) THEN
      IF (this%err.EQ.0) THEN
#if DEBUG > 2
        print *,"DEBUG INFO in fileio_base::CloseFile: closing file ..."
#endif
        CLOSE(unit=this%GetUnitNumber(),iostat=this%err)
      END IF
    END IF
    IF (this%err.NE.0) THEN
#if DEBUG > 2
      print *,"DEBUG INFO in fileio_base::CloseFile: Fatal error IOSTAT=",this%err
#endif
      CALL this%Error("filehandle_fortran::CloseFile","Cannot close file " // &
        trim(this%GetFilename(step)))
    END IF
  END SUBROUTINE closefile
 
  SUBROUTINE finalize_fortran(this)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(filehandle_fortran), INTENT(INOUT) :: this
    !------------------------------------------------------------------------!
    LOGICAL :: op
    !------------------------------------------------------------------------!
    INQUIRE(unit=this%GetUnitNumber(),opened=op,iostat=this%err)
    IF (this%err.EQ.0) CLOSE(unit=this%GetUnitNumber(),iostat=this%err)
  END SUBROUTINE finalize_fortran
  
#ifdef PARALLEL
 
  SUBROUTINE openfile_mpi(this,action,step)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(filehandle_mpi), INTENT(INOUT)    :: this
    INTEGER,           INTENT(IN)           :: action
    INTEGER,           INTENT(IN)           :: step
    !------------------------------------------------------------------------!
    INTEGER(KIND=MPI_OFFSET_KIND)       :: offset
    INTEGER                             :: amode,smode,fstatus
    !------------------------------------------------------------------------!
    this%err = mpi_success
    CALL this%CloseFile(step) ! make sure the file is closed
    IF (this%err.EQ.mpi_success) THEN
      ! delete file if it exists and should be replaced
      SELECT CASE(action)
      CASE(readonly)
        amode  = mpi_mode_rdonly
        smode  = mpi_seek_set
        offset = 0
      CASE(readend)
        amode  = ior(mpi_mode_rdonly,mpi_mode_append)
        smode  = mpi_seek_end
        offset = 0
      CASE(replace)
        fstatus = this%GetStatus(step)
        IF (fstatus.EQ.closed) THEN
           ! delete the file only on rank 0, otherwise this%err > 0 if another
           ! process tries to delete an already deleted file
           IF (this%GetRank().EQ.0) &
              CALL mpi_file_delete(trim(this%GetFilename(step)),fstatus,this%err)
           IF (this%err.NE.mpi_success) &
              CALL this%Error("fileio_base::OpenFile_mpi","cannot delete file " // &
                   trim(this%GetFilename(step)))
        END IF
        amode  = ior(mpi_mode_wronly,mpi_mode_create)
        smode  = mpi_seek_end
        offset = 0
      CASE(append)
        amode  = ior(mpi_mode_rdwr,mpi_mode_append)
        smode  = mpi_seek_end
        offset = 0
      CASE DEFAULT
        ! abort with error if either the access mode is wrong or someone tries parallel i/o in serial mode
        CALL this%Error("fileio_base::OpenFile_mpi","Unknown access mode.")
      END SELECT
      IF (this%err.EQ.mpi_success) THEN
         CALL mpi_file_open(mpi_comm_world,trim(this%GetFilename(step)),amode, &
                            mpi_info_null,this%fid,this%err)
         IF (this%err.EQ.mpi_success) CALL mpi_file_seek(this%GetUnitNumber(),offset,smode,this%err)
         IF (this%err.EQ.mpi_success) CALL mpi_file_sync(this%GetUnitNumber(),this%err)
      END IF
    END IF
    IF (this%err.NE.mpi_success) &
       CALL this%Error("fileio_base::OpenFile_mpi","file open failed, aborting")
  END SUBROUTINE openfile_mpi
 
  SUBROUTINE initfilehandle_mpi(this,filename,path,extension,textfile,onefile,cycles,unit)
    IMPLICIT NONE
    !-------------------------------------------------------------------!
    CLASS(filehandle_mpi), INTENT(INOUT) :: this
    CHARACTER(LEN=*), INTENT(IN) :: filename
    CHARACTER(LEN=*), INTENT(IN) :: path
    CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: extension
    LOGICAL, OPTIONAL, INTENT(IN)      :: textfile
    LOGICAL, OPTIONAL, INTENT(IN)      :: onefile
    INTEGER, OPTIONAL, INTENT(IN)      :: cycles
    INTEGER, OPTIONAL, INTENT(IN)      :: unit
    !-------------------------------------------------------------------!
    IF (.NOT.this%Initialized()) CALL this%InitLogging(mpifile,"mpi")
    CALL this%filehandle_fortran%InitFilehandle(filename,path,extension,textfile,onefile,cycles,unit)
    ! set the fid explicitly to MPI_File_NULL, because the fortran default is some number >= 10
    this%fid = mpi_file_null
  END SUBROUTINE initfilehandle_mpi
 
  FUNCTION getstatus_mpi(this,step) RESULT(FileStatus)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(filehandle_mpi), INTENT(INOUT) :: this
    INTEGER, INTENT(IN)                  :: step
    !------------------------------------------------------------------------!
    INTEGER :: filestatus
    INTEGER :: amode
    !------------------------------------------------------------------------!
    filestatus = -1 ! unknown / undefined / does not exist
    this%err = mpi_success
    ! check if file handle is associated
    IF (this%GetUnitNumber().NE.mpi_file_null) THEN
       ! file handle has been associated -> check access mode
       CALL mpi_file_get_amode(this%GetUnitnumber(),amode,this%err)
       IF (this%err.NE.mpi_success) &
          CALL this%Error("filehandle_mpi::GetStatus","cannot determine file access mode")
       ! file exists
       IF (iand(amode,mpi_mode_rdonly).GT.0) THEN
          IF (iand(amode,mpi_mode_append).GT.0) THEN
             filestatus = readend
          ELSE
             filestatus = readonly
          END IF
       ELSE IF (iand(amode,ior(mpi_mode_wronly,mpi_mode_create)).GT.0) THEN
          filestatus = replace
       ELSE IF (iand(amode,ior(mpi_mode_rdwr,mpi_mode_append)).GT.0) THEN
          filestatus = append
       ELSE
          ! undefined
       END IF
    ELSE
       ! file handle not associated:
       ! There is no MPI file inquiry to test whether the file exists.
       ! Therefore we try to open the file RO and check for success.
       CALL mpi_file_open(mpi_comm_world,trim(this%GetFilename(step)),mpi_mode_rdonly, &
            mpi_info_null,this%fid,this%err)
 
       IF (this%err.EQ.mpi_success) THEN
          CALL mpi_file_sync(this%GetUnitNumber(),this%err)
          IF (this%err.EQ.mpi_success.AND.this%GetUnitnumber().NE.mpi_file_null) THEN
             CALL mpi_file_close(this%fid,this%err)
             IF (this%err.NE.mpi_success) &
                CALL this%Error("filehandle_mpi::GetStatus","cannot close file")
          END IF
          this%fid = mpi_file_null
          filestatus=closed
       ELSE
          ! undefined
       END IF
       this%err = mpi_success
    END IF
  END FUNCTION getstatus_mpi
 
  SUBROUTINE closefile_mpi(this,step)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(filehandle_mpi), INTENT(INOUT) :: this
    INTEGER, INTENT(IN)                  :: step
    !------------------------------------------------------------------------!
    this%err = mpi_success
    IF (this%GetStatus(step).GT.0) THEN
      IF (this%err.EQ.mpi_success) CALL mpi_file_close(this%fid,this%err)
      this%fid = mpi_file_null
    END IF
    IF (this%err.NE.mpi_success) &
      CALL this%Error("filehandle_mpi::CloseFile","Cannot close file " // trim(this%GetFilename(step)))
  END SUBROUTINE closefile_mpi
 
  SUBROUTINE finalize_mpi(this)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    TYPE(filehandle_mpi), INTENT(INOUT) :: this
    !------------------------------------------------------------------------!
    LOGICAL :: op
    !------------------------------------------------------------------------!
    IF (this%GetUnitNumber().NE.mpi_file_null) &
       CALL mpi_file_close(this%fid,this%err)
    IF (this%err.NE.mpi_success) &
       CALL this%Error("filehandle_mpi::Finalize","serious error occured while close file")
  END SUBROUTINE finalize_mpi
#endif
END MODULE fileio_base_mod