fosite.f90

Go to the documentation of this file.

!#############################################################################
!#                                                                           #
!# fosite - 3D hydrodynamical simulation program                             #
!# program file: fosite.f90                                                  #
!#                                                                           #
!# Copyright (C) 2006-2024                                                   #
!# Tobias Illenseer <tillense@astrophysik.uni-kiel.de>                       #
!# Manuel Jung      <mjung@astrophysik.uni-kiel.de>                          #
!# Björn Sperling   <sperling@astrophysik.uni-kiel.de>                       #
!# Jannes Klee      <jklee@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.                 #
!#                                                                           #
!#############################################################################
 
!----------------------------------------------------------------------------!
!----------------------------------------------------------------------------!
MODULE fosite_mod
  USE logging_base_mod
  USE sources_generic_mod
  USE gravity_generic_mod
  USE physics_generic_mod
  USE fluxes_generic_mod
  USE reconstruction_generic_mod
  USE mesh_generic_mod
  USE boundary_generic_mod
  USE timedisc_generic_mod
  USE fileio_generic_mod
  USE integration
  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
  !--------------------------------------------------------------------------!
  INTEGER, PRIVATE, PARAMETER           :: maxlen = 500
  INTEGER, PRIVATE, PARAMETER           :: simtype = 1
  CHARACTER(LEN=32), PRIVATE, PARAMETER :: simname = "fosite"
 
  TYPE, EXTENDS(logging_base) :: fosite
    TYPE(dict_typ),POINTER :: config => null()    
    TYPE(dict_typ),POINTER :: io => null()        
    CLASS(mesh_base),ALLOCATABLE     :: mesh
    CLASS(fluxes_base),ALLOCATABLE   :: fluxes
    CLASS(physics_base),ALLOCATABLE  :: physics
    CLASS(fileio_base),ALLOCATABLE   :: datafile
    CLASS(timedisc_base),ALLOCATABLE :: timedisc
    CLASS(fileio_base),ALLOCATABLE   :: logfile
    CLASS(sources_list),ALLOCATABLE  :: sources
    INTEGER                :: iter
    LOGICAL                :: aborted = .true.    
    DOUBLE PRECISION       :: wall_time  = 0.0
    DOUBLE PRECISION       :: log_time   = 0.0
    DOUBLE PRECISION       :: start_time = 0.0
    DOUBLE PRECISION       :: end_time   = 0.0
    DOUBLE PRECISION       :: run_time   = 0.0
    INTEGER                :: start_count
    CHARACTER(MAXLEN)      :: buffer
#ifdef PARALLEL
    INTEGER                :: ierror
    REAL                   :: dt_all
#endif
 
  CONTAINS
    PROCEDURE :: initfosite
    PROCEDURE :: setup
    PROCEDURE :: firststep
    PROCEDURE :: step
    PROCEDURE :: run
    PROCEDURE :: printinfo
    PROCEDURE :: printboundaryfluxes
    PROCEDURE :: printsummary
    PROCEDURE :: computeruntime
    PROCEDURE :: finalize
  END TYPE fosite
  !--------------------------------------------------------------------------!
  PUBLIC  :: fosite
  PRIVATE :: initfosite, setup, run, step, printinfo, printboundaryfluxes, &
             printsummary, firststep, finalize, computeruntime
  !--------------------------------------------------------------------------!
 
 
CONTAINS
 
  SUBROUTINE initfosite(this)
    IMPLICIT NONE
    !--------------------------------------------------------------------------!
    CLASS(fosite), INTENT(INOUT) :: this
    !--------------------------------------------------------------------------!
#ifdef PARALLEL
    LOGICAL            :: already_initialized = .false.
#endif
    !--------------------------------------------------------------------------!
    IF (this%Initialized()) THEN
      CALL this%Warning("InitFosite","already initialized, trying to reset")
      ! finalize fosite without finalizing MPI
      CALL this%Finalize(.false.)
    END IF
#ifdef PARALLEL
    ! check whether MPI is already initialized
    CALL mpi_initialized(already_initialized,this%ierror)
    IF (.NOT.already_initialized) &
      CALL mpi_init(this%ierror)
#endif
 
    CALL this%InitLogging(simtype,simname)
 
    CALL initdict()
    this%iter = -1
  END SUBROUTINE initfosite
 
  SUBROUTINE setup(this)
    IMPLICIT NONE
    !--------------------------------------------------------------------------!
    CLASS(fosite),  INTENT(INOUT) :: this
    TYPE(dict_typ), POINTER       :: dir, iodir, config_copy
    TYPE(dict_typ), POINTER       :: boundary
    !--------------------------------------------------------------------------!
    IF (.NOT.this%Initialized()) &
      CALL this%Error("Setup","Sim is uninitialized")
 
    CALL deletedict(this%IO)
 
    IF (this%GetRank().EQ.0) THEN
        ! print some information
        WRITE(this%buffer, "(A)")&
            "+---------------------------------------------------------+"
        CALL this%Info(this%buffer)
        WRITE(this%buffer, "(A1,A29,A28,A1)")&
            "|",trim(simname),"","|"
        CALL this%Info(this%buffer)
        WRITE(this%buffer, "(A1,A35,A22,A1)")&
            "|",trim(version),"","|"
        CALL this%Info(this%buffer)
        WRITE(this%buffer, "(A)")&
            "|          Solution of 3D advection problems              |"
        CALL this%Info(this%buffer)
        WRITE(this%buffer, "(A)")&
            "+---------------------------------------------------------+"
        CALL this%Info(this%buffer)
        CALL this%Info("Initializing simulation:")
    END IF
 
    CALL getattr(this%config, "mesh", dir)
    IF(ASSOCIATED(dir)) THEN
      NULLIFY(iodir)
      CALL new_mesh(this%Mesh, dir, iodir)
      IF(ASSOCIATED(iodir)) CALL setattr(this%IO, "mesh", iodir)
      IF (this%Mesh%shear_dir.GT.0) THEN
        ! add shearing box source term to the config
        CALL setattr(this%config,"sources/shearing/stype",shearbox)
      END IF
    END IF
 
    CALL getattr(this%config, "physics", dir)
    IF(ASSOCIATED(dir)) THEN
      NULLIFY(iodir)
      CALL new_physics(this%Physics, this%Mesh, dir, iodir)
      IF(ASSOCIATED(iodir)) CALL setattr(this%IO, "physics", iodir)
    END IF
 
    CALL getattr(this%config, "fluxes", dir)
    IF(ASSOCIATED(dir)) THEN
      NULLIFY(iodir)
      CALL new_fluxes(this%Fluxes, this%Mesh, this%Physics, dir, iodir)
      IF(ASSOCIATED(iodir)) CALL setattr(this%IO, "fluxes", iodir)
    END IF
 
    CALL getattr(this%config, "timedisc", dir)
    IF(ASSOCIATED(dir)) THEN
      NULLIFY(iodir)
      CALL new_timedisc(this%Timedisc, this%Mesh,this%Physics,dir,iodir)
      IF(ASSOCIATED(iodir)) CALL setattr(this%IO, "timedisc", iodir)
    END IF
 
    CALL getattr(this%config, "boundary", dir)
    IF(.NOT.ASSOCIATED(dir)) THEN
      boundary => dict("empty"/ 0)
      CALL setattr(this%config, "boundary", boundary)
      CALL getattr(this%config, "boundary", dir)
    END IF
    IF(ASSOCIATED(dir)) THEN
      NULLIFY(iodir)
      CALL new_boundary(this%Timedisc%Boundary, this%Mesh, this%Physics, dir,iodir)
      IF(ASSOCIATED(iodir)) CALL setattr(this%IO, "boundary", iodir)
    END IF
 
    CALL getattr(this%config, "sources", dir)
    IF(ASSOCIATED(dir)) THEN
      IF(haschild(dir)) THEN
        NULLIFY(iodir)
        ALLOCATE(sources_list::this%Sources)
        CALL this%Sources%InitSources(this%Mesh,this%Physics,this%Fluxes,dir,iodir)
        IF(ASSOCIATED(iodir)) CALL setattr(this%IO, "sources", iodir)
      END IF
    END IF
 
    CALL getattr(this%config, "datafile", dir)
    IF(ASSOCIATED(dir)) THEN
      CALL new_fileio(this%Datafile, this%Mesh, this%Physics, this%Timedisc,&
                      this%Sources, dir,this%IO)
    END IF
 
    CALL getattr(this%config, "logfile", dir)
    IF(ASSOCIATED(dir)) THEN
      CALL new_fileio(this%Logfile, this%Mesh, this%Physics, this%Timedisc,&
                      this%Sources,dir,this%IO)
    END IF
 
    CALL setattr(this%config, "version", trim(version))
    CALL copydict(this%config, config_copy)
 
    CALL setattr(this%IO, "config", config_copy)
 
  END SUBROUTINE setup
 
 
  SUBROUTINE firststep(this)
    USE geometry_spherical_mod, ONLY: geometry_spherical
    IMPLICIT NONE
    !--------------------------------------------------------------------------!
    CLASS(fosite), INTENT(INOUT) :: this
    INTEGER                      :: datetime(8),dir
    !--------------------------------------------------------------------------!
    IF(.NOT.this%Initialized()) &
      CALL this%Error("fosite::FirstStep","Sim is uninitialized")
 
    ! this%iter = -1 initially (see InitFosite)
    ! it is set to 0 here to make sure FirstStep is only called once
    IF (this%iter.GT.-1) &
      CALL this%Error("fosite::FirstStep","FirstStep should only be called once.")
    this%iter = 0
 
#ifdef PARALLEL
    CALL mpi_barrier(mpi_comm_world,this%ierror)
    this%start_time = mpi_wtime()
    CALL mpi_allreduce(mpi_in_place,this%start_time,1,mpi_double_precision,mpi_max,&
        mpi_comm_world,this%ierror)
#else
    CALL cpu_time(this%start_time)
#endif
 
    CALL system_clock(this%start_count)
 
    ! make sure that the initial data is written to the log file
    this%wall_time = this%start_time
    this%log_time  = this%wall_time
 
    IF (this%GetRank().EQ.0) THEN
        CALL this%Info( &
            "===================================================================")
        CALL this%Info("Starting calculation...")
        CALL date_and_time(values = datetime)
        WRITE(this%buffer,"(A,I2.2,A,I2.2,A,I4.4,A,I2.2,A,I2.2,A,I2.2)")&
              "Time: ", &
              datetime(3), ".", datetime(2), ".", datetime(1), " ",&
              datetime(5), ":", datetime(6), ":", datetime(7)
       CALL this%Info(this%buffer)
       CALL this%Info( &
            "step     time        n           t     min(dt) due to    adj.")
       CALL this%Info( &
            "-------------------------------------------------------------------")
    END IF
 
    ! determine the background velocity if fargo advection type 1 is enabled
    IF (this%Mesh%fargo%GetType().EQ.1) THEN
       ! make sure there is valid data in the ghost cells
       CALL this%Timedisc%Boundary%CenterBoundary(this%Mesh,this%Physics,&
                             0.0,this%Timedisc%pvar,this%Timedisc%cvar)
       CALL this%Timedisc%CalcBackgroundVelocity(this%Mesh,this%Physics, &
                             this%Timedisc%pvar,this%Timedisc%cvar)
    END IF
 
    ! do a complete update of all data
    CALL this%Timedisc%ComputeRHS(this%Mesh,this%Physics,this%Sources,this%Fluxes, &
         this%Timedisc%time,0.0,this%Timedisc%pvar,this%Timedisc%cvar, &
         check_all,this%Timedisc%rhs)
 
    ! calculate timestep
    this%Timedisc%dt = this%Timedisc%CalcTimestep(this%Mesh,this%Physics,this%Sources,&
                            this%Fluxes,this%Timedisc%time,this%Timedisc%dtcause)
 
    SELECT TYPE(phys => this%Physics)
    CLASS IS(physics_eulerisotherm)
      IF(phys%csiso.GT.0.) THEN
        IF(any(phys%bccsound%data1d(:).NE.phys%csiso)) THEN
            CALL this%Error("FirstStep","isothermal sound speed set, but "&
            // "arrays bccsound and/or fcsound have been overwritten.")
        END IF
      END IF
    CLASS DEFAULT
      ! do nothing
    END SELECT
 
 
    ! store old values
    this%Timedisc%cold = this%Timedisc%cvar
 
    ! store initial data
    IF (this%Timedisc%time.EQ.0.0) THEN
      CALL this%Datafile%WriteDataset(this%Mesh,this%Physics,this%Fluxes,&
                          this%Timedisc,this%config,this%IO)
      CALL this%PrintInfo(0,0,0.0,0.0,0,this%Timedisc%n_adj)
    END IF
 
    IF(this%Timedisc%break) &
      CALL this%Error("FirstStep","Initial data invalid!")
  END SUBROUTINE firststep
 
 
  SUBROUTINE run(this)
    IMPLICIT NONE
    !--------------------------------------------------------------------------!
    CLASS(fosite), INTENT(INOUT) :: this
    !--------------------------------------------------------------------------!
    CHARACTER(LEN=32)  :: str
    !--------------------------------------------------------------------------!
    ! main loop
    DO WHILE((this%Timedisc%maxiter.LE.0).OR.(this%iter.LE.this%Timedisc%maxiter))
      IF(this%Step()) EXIT
    END DO
    IF (this%iter.GE.this%Timedisc%maxiter) &
      CALL this%Warning("fosite::Run","number of iterations exceeds limit")
  END SUBROUTINE run
 
 
  FUNCTION step(this) RESULT(break)
    IMPLICIT NONE
    !--------------------------------------------------------------------------!
    CLASS(fosite), INTENT(INOUT) :: this
    LOGICAL                      :: break
#ifdef PARALLEL
    REAL,DIMENSION(2)            :: dt_buf
#endif
!    TYPE(Gravity_TYP), POINTER   :: pmass
    !--------------------------------------------------------------------------!
    break = .false.
 
    IF (this%iter.EQ.-1) &
        CALL this%FirstStep()
 
    ! finish simulation if stop time is reached
    IF (abs(this%Timedisc%stoptime-this%Timedisc%time)&
            .LE.1.0e-05*this%Timedisc%stoptime) THEN
      break = .true.
      this%aborted = .false.
      RETURN
    END IF
 
#ifdef PARALLEL
    ! In Fortran MPI_MINLOC is only able to have two values of the same kind!
    dt_buf(1) = this%Timedisc%dt
    dt_buf(2) = this%Timedisc%dtcause
    CALL mpi_allreduce(mpi_in_place,dt_buf,1,default_mpi_2real,mpi_minloc,&
         this%Mesh%comm_cart,this%ierror)
    this%Timedisc%dt = dt_buf(1)
    this%Timedisc%dtcause = dt_buf(2)
 
    this%run_time = mpi_wtime() - this%log_time
    CALL mpi_allreduce(this%run_time,this%wall_time,1,mpi_double_precision,&
                       mpi_min,this%Mesh%comm_cart,this%ierror)
#else
    CALL cpu_time(this%wall_time)
    this%wall_time = this%wall_time - this%log_time
#endif
 
    ! adjust timestep for output and calculate the wall clock time
    CALL this%Datafile%AdjustTimestep(this%Timedisc%time,&
                        this%Timedisc%dt,this%Timedisc%dtcause)
 
#ifdef PARALLEL
    ! In Fortran MPI_MINLOC is only able to have two values of the same kind!
    dt_buf(1) = this%Timedisc%dt
    dt_buf(2) = this%Timedisc%dtcause
    CALL mpi_allreduce(mpi_in_place,dt_buf,1,default_mpi_2real,mpi_minloc,&
         this%Mesh%comm_cart,this%ierror)
    this%Timedisc%dt = dt_buf(1)
    this%Timedisc%dtcause = dt_buf(2)
#endif
 
    ! advance the solution in time
    CALL this%Timedisc%IntegrationStep(this%Mesh,this%Physics,this%Sources, &
                                       this%Fluxes,this%iter,this%config,this%IO)
 
    ! write output to data file
    IF ((abs(this%Datafile%time-this%Timedisc%time)&
            .LE.1.0e-5*this%Datafile%time).OR.&
        this%Timedisc%break.OR.(this%Datafile%walltime.LE.this%wall_time)) THEN
       CALL this%Datafile%WriteDataset(this%Mesh,this%Physics,this%Fluxes,&
                         this%Timedisc,this%config,this%IO)
       CALL this%PrintInfo(this%Datafile%step-1, this%iter,this%Timedisc%time,&
               this%Timedisc%dtmin,this%Timedisc%dtmincause,this%Timedisc%n_adj)
 
       ! Stop program if a break is requested from SolveODE
       IF(this%Timedisc%break.AND.this%GetRank().EQ.0) THEN
         CALL this%Warning("SolveODE", "Time step too small, aborting.",0)
         break = .true.
         RETURN
       END IF
 
       ! only give one additional output at before walltime
       IF (this%Datafile%walltime.LE.this%wall_time) THEN
         this%Datafile%walltime = huge(1.0)
       END IF
 
       ! reset dt_min,dtmincause and n_adj
       this%Timedisc%dtmin = this%Timedisc%stoptime
       this%Timedisc%dtmincause = -99
       this%Timedisc%n_adj = 0
       !IF(GetRank(this).EQ.0) &
       !  WRITE(*,"(A,ES10.4,A,ES10.4)") "dtmean: ", this%Timedisc%dtmean, " +- ",&
       !    SQRT(this%Timedisc%dtstddev/(this%Timedisc%dtaccept-1))/this%Timedisc%dtmean
       this%Timedisc%dtmean = 0.
       this%Timedisc%dtstddev = 0.
       this%Timedisc%dtaccept = 0
       ! reset max error of cvar
       IF(this%Timedisc%write_error) &
         this%Timedisc%cerr_max%data1d(:) = 0.
    END IF
 
    ! calculate next timestep
    this%Timedisc%dt = this%Timedisc%CalcTimestep(this%Mesh,this%Physics,this%Sources, &
                            this%Fluxes,this%Timedisc%time,this%Timedisc%dtcause)
  END FUNCTION step
 
  SUBROUTINE finalize(this,mpifinalize_)
    IMPLICIT NONE
    !--------------------------------------------------------------------------!
    CLASS(fosite), INTENT(INOUT) :: this
    LOGICAL,OPTIONAL, INTENT(IN) :: mpifinalize_
    !--------------------------------------------------------------------------!
#ifdef PARALLEL
    LOGICAL                      :: mpifinalize
#endif
    !--------------------------------------------------------------------------!
    CALL this%ComputeRunTime()
    CALL this%PrintBoundaryFluxes()
    CALL this%PrintSummary()
 
!     CALL this%Datafile%Finalize()
    DEALLOCATE(this%Datafile)  ! should call finalizer automatically
    IF (ALLOCATED(this%Logfile)) THEN
!       CALL this%Logfile%Finalize()
      DEALLOCATE(this%Logfile)  ! should call finalizer automatically
    END IF
    CALL this%Timedisc%Finalize()
    DEALLOCATE(this%Timedisc)
 
    IF (ALLOCATED(this%Sources)) DEALLOCATE(this%Sources)
 
    CALL this%Fluxes%Finalize()
    DEALLOCATE(this%Fluxes)
 
    CALL this%Physics%Finalize()
    DEALLOCATE(this%Physics)
 
    CALL this%Mesh%Finalize()
    DEALLOCATE(this%Mesh)
 
    CALL deletedict(this%IO)
    CALL deletedict(this%config)
    CALL closedict()
 
#ifdef PARALLEL
    IF(PRESENT(mpifinalize_)) THEN
      mpifinalize = mpifinalize_
    ELSE
      mpifinalize = .true.
    END IF
    IF(mpifinalize) &
      CALL mpi_finalize(this%ierror)
#endif
  END SUBROUTINE finalize
 
  SUBROUTINE computeruntime(this)
    IMPLICIT NONE
    !--------------------------------------------------------------------------!
    CLASS(fosite), INTENT(INOUT)   :: this
    !--------------------------------------------------------------------------!
 
#ifdef PARALLEL
    CALL mpi_barrier(mpi_comm_world,this%ierror)
    this%end_time = mpi_wtime()
    CALL mpi_allreduce(mpi_in_place,this%end_time,1,mpi_double_precision,mpi_min,&
        mpi_comm_world,this%ierror)
#else
    CALL cpu_time(this%end_time)
#endif
    this%run_time = this%end_time - this%start_time
  END SUBROUTINE computeruntime
 
 
  SUBROUTINE printinfo(this,step,i,t,d,dc,na)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(fosite), INTENT(INOUT) :: this
    INTEGER            :: step, i, dc, na
    CHARACTER(LEN=9)   :: dtcause
    REAL               :: t, d
    !------------------------------------------------------------------------!
    INTEGER            :: drt, c, c_rate, c_max
    !------------------------------------------------------------------------!
    INTENT(IN)         :: i,t,d
    !------------------------------------------------------------------------!
    IF (this%GetRank().EQ.0) THEN
 
       SELECT CASE (dc)
        ! positive values represent source terms
        CASE(1:)
          WRITE(dtcause, "(A,I2.2,A)") " S",dc," "
        CASE(dtcause_cfl)
          WRITE(dtcause, "(A)") " cfl "
        CASE(dtcause_erradj)
           WRITE(dtcause, "(A)") " err_adj "
        CASE(dtcause_smallerr)
           WRITE(dtcause, "(A)") " err "
        CASE(dtcause_fileio)
           ! output by this reason is suppressed by default
           WRITE(dtcause, "(A)") " fileio "
        CASE DEFAULT
           WRITE(dtcause, "(A,I3.2,A)") " ?", dc, "? "
       END SELECT
 
       CALL system_clock(c,c_rate, c_max)
       ! overflow every 24days => assumption: max one per simulation
       drt = (c - this%start_count)/c_rate
       IF (drt .LT. 0) THEN
         drt = c_max/c_rate + drt
       END IF
       WRITE(this%buffer,"(I4.4,A,I2.2,A,I2.2,A,I2.2,A,I8,A,ES11.3,A,ES11.3,A,I5)")&
             step, " ", drt/3600, ":", mod(drt,3600)/60, ":", mod(drt,60),&
             " ", i, " ", t, " ", d, dtcause, na
       CALL this%Info(this%buffer)
    END IF
  END SUBROUTINE printinfo
 
  SUBROUTINE printboundaryfluxes(this)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(fosite), INTENT(INOUT)         :: this
    INTEGER                              :: k
    REAL, DIMENSION(this%Physics%VNUM,6) :: bflux
    !--------------------------------------------------------------------------!
    DO k=1,6
       bflux(:,k) = this%Fluxes%GetBoundaryFlux(this%Mesh,this%Physics,k)
    END DO
    IF (this%GetRank().EQ.0) THEN
       CALL this%Info("-------------------------------------------------------------------")
       CALL this%Info("total boundary fluxes:")
      SELECT CASE(this%Physics%VDIM)
      CASE(1)
        IF(this%Mesh%INUM.GT.1) THEN
          CALL this%Info("                      west        east")
          DO k=1,this%Physics%VNUM
              WRITE(this%buffer,"(T2,A,T21,2(ES12.3))")trim(this%Physics%cvarname(k)), &
                  bflux(k,west), bflux(k,east)
              CALL this%Info(this%buffer)
          END DO
        ELSEIF(this%Mesh%JNUM.GT.1) THEN
          CALL this%Info("                      south        north")
          DO k=1,this%Physics%VNUM
              WRITE(this%buffer,"(T2,A,T21,2(ES12.3))")trim(this%Physics%cvarname(k)), &
                  bflux(k,south), bflux(k,north)
              CALL this%Info(this%buffer)
          END DO
        ELSEIF(this%Mesh%KNUM.GT.1) THEN
          CALL this%Info("                      bottom        top")
          DO k=1,this%Physics%VNUM
              WRITE(this%buffer,"(T2,A,T21,2(ES12.3))")trim(this%Physics%cvarname(k)), &
                  bflux(k,bottom), bflux(k,top)
              CALL this%Info(this%buffer)
          END DO
        END IF
      CASE(2)
        IF(this%Mesh%INUM.EQ.1) THEN
          CALL this%Info("                      south        north")
          DO k=1,this%Physics%VNUM
              WRITE(this%buffer,"(T2,A,T21,2(ES12.3))")trim(this%Physics%cvarname(k)), &
                  bflux(k,south), bflux(k,north)
              CALL this%Info(this%buffer)
          END DO
          CALL this%Info("                      bottom        top")
          DO k=1,this%Physics%VNUM
              WRITE(this%buffer,"(T2,A,T21,2(ES12.3))")trim(this%Physics%cvarname(k)), &
                  bflux(k,bottom), bflux(k,top)
              CALL this%Info(this%buffer)
          END DO
        ELSEIF(this%Mesh%JNUM.EQ.1) THEN
          CALL this%Info("                      west        east")
           DO k=1,this%Physics%VNUM
              WRITE(this%buffer,"(T2,A,T21,2(ES12.3))")trim(this%Physics%cvarname(k)), &
                  bflux(k,west), bflux(k,east)
              CALL this%Info(this%buffer)
          END DO
          CALL this%Info("                      bottom        top")
          DO k=1,this%Physics%VNUM
              WRITE(this%buffer,"(T2,A,T21,2(ES12.3))")trim(this%Physics%cvarname(k)), &
                  bflux(k,bottom), bflux(k,top)
              CALL this%Info(this%buffer)
          END DO
        ELSEIF(this%Mesh%KNUM.EQ.1) THEN
           CALL this%Info("                      west        east")
           DO k=1,this%Physics%VNUM
              WRITE(this%buffer,"(T2,A,T21,2(ES12.3))")trim(this%Physics%cvarname(k)), &
                  bflux(k,west), bflux(k,east)
              CALL this%Info(this%buffer)
          END DO
          CALL this%Info("                      south        north")
          DO k=1,this%Physics%VNUM
              WRITE(this%buffer,"(T2,A,T21,2(ES12.3))")trim(this%Physics%cvarname(k)), &
                  bflux(k,south), bflux(k,north)
              CALL this%Info(this%buffer)
          END DO
        END IF
     CASE(3)
       CALL this%Info("                      west        east        south")
       DO k=1,this%Physics%VNUM
          WRITE(this%buffer,"(T2,A,T21,3(ES12.3))")trim(this%Physics%cvarname(k)), &
               bflux(k,west), bflux(k,east), bflux(k,south)
          CALL this%Info(this%buffer)
       END DO
       CALL this%Info("                      north       bottom      top")
       DO k=1,this%Physics%VNUM
          WRITE(this%buffer,"(T2,A,T21,3(ES12.3))")trim(this%Physics%cvarname(k)), &
               bflux(k,north), bflux(k,bottom), bflux(k,top)
          CALL this%Info(this%buffer)
       END DO
      END SELECT
    END IF
  END SUBROUTINE printboundaryfluxes
 
  SUBROUTINE printsummary(this)
    IMPLICIT NONE
    !------------------------------------------------------------------------!
    CLASS(fosite), INTENT(INOUT) :: this
    !--------------------------------------------------------------------------!
    IF (this%GetRank().EQ.0) THEN
       CALL this%Info("===================================================================")
       IF (this%aborted) THEN
          CALL this%Info("time integration aborted due to errors!")
       ELSE IF ((this%Timedisc%maxiter.LE.0).OR.(this%iter.LT.this%Timedisc%maxiter)) THEN
          CALL this%Info("calculation finished correctly.")
       ELSE
          CALL this%Info("too many iterations, aborting!")
       END IF
       WRITE(this%buffer,"(A,F10.2,A)")" main loop runtime: ", this%run_time, " sec."
       CALL this%Info(this%buffer)
    END IF
  END SUBROUTINE printsummary
 
END MODULE fosite_mod