fileio_base.f90

Go to the documentation of this file.

!#############################################################################
!#                                                                           #
!# fosite - 3D hydrodynamical simulation program                             #
!# module: fileio_generic.f90                                                #
!#                                                                           #
!# Copyright (C) 2008-2014                                                   #
!# 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_base_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 :: fmltlen = 5
  INTEGER, PARAMETER :: fcyclen = 5
  INTEGER, PARAMETER :: fnamlen = 256
  INTEGER, PARAMETER :: fpatlen = 1024
#ifdef PARALLEL
  CHARACTER(LEN=FMLTLEN), SAVE :: fmextstr = ""
#endif
  INTEGER, PARAMETER           :: maxmltfiles = 1000
  INTEGER, PARAMETER           :: maxcycles = 10000
  CHARACTER(LEN=32), SAVE      :: cycfmt
  !--------------------------------------------------------------------------!
  TYPE valptr_typ
    REAL, DIMENSION(:,:,:), POINTER :: val
  END TYPE

  TYPE output_typ
    REAL, DIMENSION(:,:), POINTER           :: val
    TYPE(valptr_typ), DIMENSION(:), POINTER :: p
    CHARACTER(LEN=128)                      :: key
    INTEGER(KIND=4)                         :: numbytes
  END TYPE output_typ

  TYPE tsoutput_typ
    REAL, POINTER           :: val
    CHARACTER(LEN=128)      :: key
  END TYPE tsoutput_typ

  TYPE, ABSTRACT,EXTENDS(logging_base) :: fileio_base
     TYPE(logging_base)     :: format
     CHARACTER(LEN=512)     :: linebuf
     CHARACTER(LEN=512)     :: tslinebuf
     CHARACTER(LEN=FNAMLEN) :: filename
     CHARACTER(LEN=FPATLEN) :: path
     CHARACTER(LEN=FEXTLEN) :: extension
     LOGICAL                :: cartcoords
     INTEGER                :: unit
     INTEGER                :: error_io
     INTEGER                :: step
     INTEGER                :: count
     INTEGER                :: cycles
     INTEGER                :: dtwall
     INTEGER                :: realsize
     INTEGER                :: intsize
     INTEGER                :: inum,jnum,& !< mesh extent
                               knum
#ifndef PARALLEL
     INTEGER(KIND=8)        :: offset
#endif
     REAL                   :: stoptime
     REAL                   :: starttime
     REAL                   :: time
     REAL, DIMENSION(:,:,:,:), POINTER :: &
                               binout
     CHARACTER(LEN=32)      :: buf
     CHARACTER(LEN=12)      :: realfmt
     CHARACTER(LEN=14)      :: endianness
     CHARACTER(LEN=14)      :: endian
     REAL, DIMENSION(:,:,:,:), POINTER :: &
                                vtkcoords
     CHARACTER(LEN=512)     :: heading
     CHARACTER(LEN=512)     :: tsheading
     CHARACTER(LEN=64)      :: fmtstr
     CHARACTER(LEN=64)      :: linefmt
     INTEGER                :: cols
     INTEGER                :: tscols
     INTEGER                :: maxcols
     INTEGER                :: decs
     INTEGER                :: flen
     INTEGER                :: linelen
     INTEGER                :: tslinelen
#ifdef HAVE_HDF5_MOD

     INTEGER(HID_T)         :: fid
     INTEGER(HID_T)         :: xferid
#endif
     TYPE(output_typ),DIMENSION(:), POINTER :: &
                               output
     TYPE(tsoutput_typ),DIMENSION(:), POINTER :: &
                               tsoutput
     REAL, DIMENSION(:,:) , POINTER  :: &
                               bflux
     REAL                   :: walltime
#ifdef PARALLEL

     LOGICAL                :: multfiles
     INTEGER                :: handle
     INTEGER                :: bufsize
     INTEGER                :: cbufsize
     INTEGER                :: basictype
     INTEGER                :: filetype
     INTEGER, DIMENSION(MPI_STATUS_SIZE) :: &
                               status
     INTEGER(KIND=MPI_OFFSET_KIND) :: offset
     INTEGER                :: blocknum
     INTEGER(KIND=MPI_ADDRESS_KIND) :: &
                               realext, &  !< real data type extent
                               intext
     CHARACTER, DIMENSION(:,:), POINTER :: &
                               outbuf
     LOGICAL                :: first
     CHARACTER(LEN=64), DIMENSION(:), POINTER :: &
                               extent
     INTEGER                :: cfiletype
     INTEGER, DIMENSION(:), POINTER :: &
                               disp
#endif
  CONTAINS
    ! methods
    PROCEDURE :: initfileio
    procedure(writeheader), DEFERRED :: writeheader
    procedure(writedataset), DEFERRED:: writedataset
    PROCEDURE :: adjusttimestep
    PROCEDURE :: finalize_base
    procedure(finalize), DEFERRED    :: finalize
    PROCEDURE :: getfilename
    PROCEDURE :: getbasename
    PROCEDURE :: makemultstr
    PROCEDURE :: inctime
  END TYPE fileio_base

  ! Interfaces
  abstract INTERFACE
    SUBROUTINE writedataset(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 :: readonly = 1
  INTEGER, PARAMETER :: readend  = 2
  INTEGER, PARAMETER :: replace  = 3
  INTEGER, PARAMETER :: append   = 4
  CHARACTER(LEN=9), PARAMETER :: ascii = "formatted"
  CHARACTER(LEN=11), PARAMETER :: bin  = "unformatted"

  ! file formats
  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

  !--------------------------------------------------------------------------!
  PUBLIC :: &
       ! types
       fileio_base, output_typ, tsoutput_typ, valptr_typ, &
       ! constants
       binary, gnuplot, vtk, xdmf, &
       readonly, readend, replace, append, &
#ifdef PARALLEL
       default_mpi_real,&
#endif
!       FILE_EXISTS, &
       ascii, bin


CONTAINS


  SUBROUTINE initfileio(this,Mesh,Physics,Timedisc,Sources,config,IO, &
                        fmtname,fext)
    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_base), INTENT(IN), POINTER :: 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
    !------------------------------------------------------------------------!
    INTEGER                        :: fileformat
    CHARACTER(LEN=MAX_CHAR_LEN)    :: fname
    CHARACTER(LEN=MAX_CHAR_LEN)    :: fpath
    !INTEGER                        :: fcycles    !< fcycles number of file cycles
    INTEGER                        :: unit
    LOGICAL                        :: success
    CHARACTER(LEN=32)              :: timestamp
    INTEGER                        :: count_def, fcycles_def, dtwall_def
    INTEGER                        :: cartcoords
    REAL                           :: stoptime_def
    REAL                           :: time
    TYPE(Dict_TYP),POINTER         :: oldconfig => null()
    !------------------------------------------------------------------------!
    ! wall clock time between successive outputs
    ! this is mainly intended for log file outputs
    CALL getattr(config, "dtwall" , dtwall_def, 3600) !default is one hour

    ! number of output steps
    CALL getattr(config, "count" , count_def, 1)

    ! number of data files
    ! fcycles = 0     : one data file, append data
    ! fcycles = 1     : one data file, overwrite data
    ! fcycles = X > 1 : X data files
    CALL getattr(config, "filecycles", fcycles_def, count_def+1)

    ! stop time for output defaults to simulation stop time
    CALL getattr(config, "stoptime"  , stoptime_def, timedisc%stoptime)
    CALL getattr(config, "fileformat", fileformat)
    CALL getattr(config, "filename"  , fname)
    fpath = ""
    CALL getattr(config, "filepath"  , fpath, fpath)
    CALL getattr(config, "unit"      , unit , lastunit+1)
    lastunit = unit
    CALL getattr(config, "walltime"  , this%walltime, huge(1.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

    ! InitLogging after reading fileformat from config
    CALL this%InitLogging(fileformat,fmtname)

    ! check cycles
    IF (fcycles_def.GT.maxcycles) &
       CALL this%Error("InitFileIO","file cycles exceed limits")
    ! check file name length
    IF (len_trim(fname).GT.fnamlen) &
       CALL this%Error("InitFileIO","file name too long")
    ! check file path length
    IF (len_trim(fpath).GT.fpatlen) &
       CALL this%Error("InitFileIO","file path too long")
    ! check file name extension
    IF (len_trim(fext).GT.fextlen-1) &
       CALL this%Error("InitFileIO","file name extension too long")

    ! format string for writing file names with explicit time step
    WRITE (cycfmt, "('(A,I',I1,'.',I1,',A)')") fcyclen-1,fcyclen-1

#ifdef PARALLEL
    ! turn on multiple file output if requested
    IF (this%multfiles) THEN
       ! check number of parallel processes
       IF (this%GetNumProcs().GT.maxmltfiles) &
          CALL this%Error("InitFileIO","number of processes for multiple file output exceeds limits")
       fmextstr = this%MakeMultstr()
    END IF
#endif

    this%path      = trim(fpath)
    this%filename  = trim(fname)
    this%extension = trim(fext)
    this%cycles    = fcycles_def
    this%unit      = unit
    this%stoptime  = stoptime_def
    this%starttime = timedisc%time  ! from beginning of simulation
    this%dtwall    = dtwall_def
    this%count     = count_def
    this%offset    = 0
    this%error_io  = 0

    CALL getattr(config, "step", this%step, 0)

    ! compute the (actual) output time
    this%time = timedisc%time

    ! print some information
    CALL this%Info(" FILEIO---> file name:         " // trim(this%GetFilename()))
    IF (success) THEN
       WRITE (timestamp,'(ES10.4)') timedisc%time
       CALL this%Info("            time stamp:        " // trim(timestamp))
    END IF

    ! time for next output
    IF (timedisc%time.GT.0.0) CALL this%IncTime()
    IF (ASSOCIATED(oldconfig)) CALL deletedict(oldconfig)
  END SUBROUTINE initfileio

  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


  FUNCTION makemultstr(this,fn) RESULT (multstr)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(fileio_base), INTENT(IN) :: this
    INTEGER, OPTIONAL,  INTENT(IN) :: fn
    CHARACTER(LEN=FMLTLEN)         :: multstr
    !------------------------------------------------------------------------!
#ifdef PARALLEL
    INTEGER                        :: fn_l
    CHARACTER(LEN=32)              :: mextfmt
#endif
    !------------------------------------------------------------------------!
#ifdef PARALLEL
    IF (PRESENT(fn)) THEN
      fn_l = fn
    ELSE
      fn_l = this%GetRank()
    END IF
    ! with fn < 0 you can suppress a label
    IF (this%multfiles .AND. fn_l .GE. 0) THEN
        WRITE (mextfmt, "('(A2,I',I1,'.',I1,')')") fmltlen-2,fmltlen-2

        WRITE (multstr, mextfmt) "-r", fn_l
    ELSE
      multstr = ""
    END IF
#else
    multstr = ""
#endif
  END FUNCTION makemultstr


  FUNCTION getbasename(this,fn) RESULT (fname)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(fileio_base), INTENT(IN) :: this
    INTEGER, OPTIONAL, INTENT(IN)  :: fn
    CHARACTER(LEN=256)             :: fname
    !------------------------------------------------------------------------!
    CHARACTER(LEN=FCYCLEN+2)       :: cycstr
    !------------------------------------------------------------------------!
    IF (this%cycles.GT.0) THEN
       ! generate a file name with time step
       WRITE (cycstr, fmt=trim(cycfmt)) "_", modulo(this%step,this%cycles), "."
       WRITE (fname,"(A,A,A,A)")  trim(this%filename),&
              trim(makemultstr(this,fn)),trim(cycstr),trim(this%extension)
    ELSE
       ! file name + extension
       WRITE (fname,"(A,A,A,A)") trim(this%filename),&
              trim(makemultstr(this,fn)),".",trim(this%extension)
    END IF
  END FUNCTION getbasename

  FUNCTION getfilename(this,fn) RESULT (fname)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(fileio_base), INTENT(IN) :: this
    INTEGER, OPTIONAL, INTENT(IN)  :: fn
    CHARACTER(LEN=256)             :: fname
    !------------------------------------------------------------------------!
    fname = trim(this%path) // trim(getbasename(this,fn))
  END FUNCTION getfilename

  SUBROUTINE finalize_base(this)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(fileio_base),INTENT(INOUT) :: this
    !------------------------------------------------------------------------!
    IF (.NOT.this%Initialized()) &
        CALL this%Error("CloseFileIO","not initialized")
  END SUBROUTINE finalize_base

END MODULE fileio_base_mod