!#################################################################
!
! TM5 as a library ...
!
!### macro's #####################################################
!
#define TRACEBACK write (gol,'("in ",a," (",a,", line",i5,")")') rname, __FILE__, __LINE__; call goErr
#define IF_NOTOK_RETURN(action) if (status/=0) then; TRACEBACK; action; return; end if
#define IF_ERROR_RETURN(action) if (status> 0) then; TRACEBACK; action; return; end if
!
#include "tm5.inc"
!
#define PRISM_ERR call prism_error(status,gol); call goErr
#define IF_PRISM_NOTOK_RETURN(action) if (status/=0) then; PRISM_ERR; TRACEBACK; action; return; end if
!
!#################################################################

module TM5

  use GO, only : gol, goPr, goErr
  use GO, only : GO_Timer_Init, GO_Timer_Done, GO_Timer_Def, GO_Timer_Start, GO_Timer_End
#ifdef with_prism
  use PRISM    , only : prism_error
  use TM5_Prism, only : appl_name, comp_name, comp_id
#endif

  implicit none
  
  
  ! --- in/out -----------------------------------
  
  private
  
  public  ::  TM5_Comm_Init, TM5_Comm_Done, TM5_Comm_Abort
  public  ::  TM5_Messages_Init, TM5_Messages_Done
  public  ::  TM5_Model_Init, TM5_Model_Run, TM5_Model_Done
  
#ifdef with_prism
  public  ::  appl_name, comp_name, comp_id
#endif

  ! --- const --------------------------------------

  character(len=*), parameter  ::  mname = 'TM5'


  ! --- var ----------------------------------------
  
  integer     ::  itim_init, itim_done
  integer     ::  itim_run_init, itim_run_step, itim_run_done

  
contains


  ! ===================================================================
  ! === 
  ! === communication
  ! === 
  ! ===================================================================
  
  !
  ! Setup communication:
  !   o MPI_Init
  !   o fill npes and myid
  !
  
  subroutine TM5_Comm_Init( status, comm )
  
    use ParTools, only : TM5_MPI_Init
    use OMP_ParTools, only : TM5_OMP_Init
  
    ! --- in/out ----------------------------------
    
    integer, intent(out)            ::  status
    integer, intent(in), optional   ::  comm
    
    ! --- const ------------------------------

    character(len=*), parameter ::  rname = mname//'/TM5_Comm_Init'
    
    ! --- begin -----------------------------------
    
    ! setup mpi stuff if necessary:
    call TM5_MPI_Init( status, comm )
    IF_NOTOK_RETURN(status=1)

    ! setup OpenMP stuff if necessary:
    call TM5_OMP_Init( status )
    IF_NOTOK_RETURN(status=1)

    ! ok
    status = 0
    
  end subroutine TM5_Comm_Init


  !
  ! Stop communication:
  !   o MPI_Finalize
  !
  
  subroutine TM5_Comm_Done( status, comm )
  
    use ParTools, only : TM5_MPI_Done
  
    ! --- in/out ----------------------------------
    
    integer, intent(out)            ::  status
    integer, intent(in), optional   ::  comm
    
    ! --- const ------------------------------

    character(len=*), parameter ::  rname = mname//'/TM5_Comm_Done'
    
    ! --- begin -----------------------------------

    ! finalize mpi stuff if necessary:
    call TM5_MPI_Done( status, comm )
    IF_NOTOK_RETURN(status=1)

    ! ok
    status = 0
    
  end subroutine TM5_Comm_Done


  !
  ! Abort communication:
  !   o MPI_Abort
  !
  
  subroutine TM5_Comm_Abort( errorcode, status ) 
  
    use ParTools, only : TM5_MPI_Abort
  
    ! --- in/out ----------------------------------
    
    integer, intent(in)             ::  errorcode
    integer, intent(out)            ::  status
    
    ! --- const ------------------------------

    character(len=*), parameter ::  rname = mname//'/TM5_Comm_Abort'
    
    ! --- begin -----------------------------------

    ! finalize mpi stuff if necessary:
    call TM5_MPI_Abort( errorcode, status )
    IF_NOTOK_RETURN(status=1)

    ! ok
    status = 0
    
  end subroutine TM5_Comm_Abort


#ifdef with_pycasso
  ! ===================================================================
  ! === 
  ! === arguments
  ! === 
  ! ===================================================================
  

  subroutine TM5_Arguments( status )
  
    use GO         , only : goArgCount, goGetArg
    use global_data, only : rcfile
    use partools   , only : myid, root, Par_Broadcast_Status, Par_Broadcast

    ! --- in/out ----------------------------------
    
    integer, intent(out)          ::  status
    
    ! --- const ----------------------------------

    character(len=*), parameter ::  rname = mname//'/TM5_Arguments'
    
    ! --- local -----------------------------------
    
    integer               ::  narg
    integer               ::  iarg
    character(len=1024)   ::  line
    
    ! --- begin -----------------------------------
    
    ! on root only, since some mpirun version do not parse
    ! all arguments to each executable:

    ! number of arguments:
    if (myid==root) call goArgCount( narg, status )
    call Par_Broadcast_Status(status,root)
    IF_NOTOK_RETURN(status=1)
    call Par_Broadcast( narg, root, status )
    IF_NOTOK_RETURN(status=1)

    ! check ...
    if ( narg == 0 ) then
      write (gol,'("no arguments found ...")'); call goErr
      TRACEBACK; status=1; return
    end if

    ! defaults:
    rcfile = 'None'

    ! loop over arguments:
    iarg = 0
    do
      ! next:
      iarg = iarg + 1
      ! get argument:
      if (myid==root) call goGetArg( iarg, line, status )
      call Par_Broadcast_Status(status,root)
      IF_NOTOK_RETURN(status=1)
      call Par_Broadcast( line, root, status )
      IF_NOTOK_RETURN(status=1)
      ! specials ...
      select case ( trim(line) )
        ! arguments added by MPICH/mpirun :
        case ( '-p4pg', '-p4wd' )
          ! skip next argument:
          iarg = iarg + 1
        ! other ...
        case default
          ! not filled yet ?
          if ( trim(rcfile) == 'None' ) then
            rcfile = trim(line)
          else
            write (gol,'("unsupported argument : ",a)') trim(line); call goErr
            TRACEBACK; status=1; return
          end if
      end select
      ! last one is processed now ?
      if ( iarg == narg ) exit
    end do
      
    ! ok
    status = 0
    
  end subroutine TM5_Arguments
  
  
  ! ***
  
  
  subroutine TM5_Print_Usage( status )
  
    ! --- in/out ---------------------------------
    
    integer, intent(out)        ::  status
    
    ! --- begin ----------------------------------
    
    ! display usage line:
    write (*,'("Usage: tm5.x <rcfile>")')
    
    ! ok
    status = 0
    
  end subroutine TM5_Print_Usage
#endif
  


  ! ===================================================================
  ! === 
  ! === messages init/done
  ! === 
  ! ===================================================================
  

  subroutine TM5_Messages_Init( status )
  
    use GO         , only : GO_Print_Init, gol, goPr
    use GO         , only : TrcFile, Init, Done, ReadRc
    use partools   , only : npes, myid, root
    use global_data, only : rcfile

    ! --- in/out ----------------------------------
    
    integer, intent(out)          ::  status
    
    ! --- const ----------------------------------

    character(len=*), parameter ::  rname = mname//'/TM5_Messages_Init'
    
    ! --- local -----------------------------------
    
    type(TrcFile)         ::  rcF
    logical               ::  go_print_all
    logical               ::  go_print_apply
    logical               ::  go_print_trace
    logical               ::  go_print_prompt_pe
    logical               ::  go_print_file
    character(len=256)    ::  go_print_file_base, fname

    ! --- begin -----------------------------------
    
    ! read settings:

    call Init( rcF, rcfile, status )
    IF_NOTOK_RETURN(status=1)

    call ReadRc( rcF, 'go.print.all', go_print_all, status, default=.false. )
    IF_ERROR_RETURN(status=1)

    call ReadRc( rcF, 'go.print.prompt.pe', go_print_prompt_pe, status, default=npes>1 )
    IF_ERROR_RETURN(status=1)

    call ReadRc( rcF, 'go.print.trace', go_print_trace, status, default=.false. )
    IF_ERROR_RETURN(status=1)

    call ReadRc( rcF, 'go.print.file', go_print_file, status, default=.false. )
    IF_ERROR_RETURN(status=1)
    call ReadRc( rcF, 'go.print.file.base', go_print_file_base, status, default='go.out' )
    IF_ERROR_RETURN(status=1)

    call Done( rcF, status )
    IF_NOTOK_RETURN(status=1)

    ! standard output by root only:
    go_print_apply = go_print_all .or. (myid==root)
    
    ! write to file ?
    if ( go_print_file ) then
      if ( myid < 10 ) then
        write (fname,'(a,".",i1.1)') trim(go_print_file_base), myid
      else if ( myid < 100 ) then
        write (fname,'(a,".",i2.2)') trim(go_print_file_base), myid
      else if ( myid < 1000 ) then
        write (fname,'(a,".",i3.3)') trim(go_print_file_base), myid
      else
        write (fname,'(a,".",i6.6)') trim(go_print_file_base), myid
      end if
    else
      fname = 'stdout'
    end if

    ! setup standard output processing:
    call GO_Print_Init( status, &
                          apply=go_print_apply, trace=go_print_trace, &
                          prompt_pe=go_print_prompt_pe, pe=myid, &
                          file=go_print_file, file_name=fname )
    IF_NOTOK_RETURN(status=1)

    ! intro message ...
    write (gol,'(" ")'); call goPr
    write (gol,'("*************************************************************")'); call goPr
    write (gol,'("***                                                       ***")'); call goPr
    write (gol,'("***                                                       ***")'); call goPr
    write (gol,'("***        Global Atmospheric Tracer Model TM5            ***")'); call goPr
    write (gol,'("***                                                       ***")'); call goPr
    write (gol,'("***                   message log                         ***")'); call goPr
    write (gol,'("***                                                       ***")'); call goPr
    write (gol,'("*************************************************************")'); call goPr
    write (gol,'(" ")'); call goPr

    ! ok
    status = 0
    
  end subroutine TM5_Messages_Init
  

  ! ***
  
    
  subroutine TM5_Messages_Done( status )
  
    use GO, only : GO_Print_Done

    ! --- in/out ----------------------------------
    
    integer, intent(out)          ::  status
    
    ! --- const ------------------------------

    character(len=*), parameter ::  rname = mname//'/TM5_Messages_Done'
    
    ! --- begin -----------------------------------
    
    ! final message ...
    write (gol,'(" ")'); call goPr
    write (gol,'("*************************************************************")'); call goPr
    write (gol,'("***                                                       ***")'); call goPr
    write (gol,'("***                 end message log                       ***")'); call goPr
    write (gol,'("***                                                       ***")'); call goPr
    write (gol,'("*************************************************************")'); call goPr
    write (gol,'(" ")'); call goPr

    call GO_Print_Done( status )
    IF_NOTOK_RETURN(status=1)
    
    ! ok
    status = 0
    
  end subroutine TM5_Messages_Done


  ! ====================================================================
  ! ===
  ! === Timing
  ! ===
  ! ====================================================================
  

  subroutine TM5_Timing_Init( status )

    use GO, only : GO_Timer_Init, GO_Timer_Def

    ! --- in/out ---------------------------------

    integer, intent(inout)              ::  status
    
    ! --- const ----------------------------------
    
    character(len=*), parameter   ::  rname = mname//'/TM5_Timing_Init'
    
    ! --- local ----------------------------------

    ! --- begin ----------------------------------
    
    write (gol,'(a,":   init timers ...")') rname; call goPr

    call GO_Timer_Init( status )
    IF_NOTOK_RETURN(status=1)

    ! define ...
    call GO_Timer_Def( itim_init, 'init', status )
    IF_NOTOK_RETURN(status=1)
    call GO_Timer_Def( itim_done, 'done', status )
    IF_NOTOK_RETURN(status=1)
    call GO_Timer_Def( itim_run_init, 'step init', status )
    IF_NOTOK_RETURN(status=1)
    call GO_Timer_Def( itim_run_step, 'step run' , status )
    IF_NOTOK_RETURN(status=1)
    call GO_Timer_Def( itim_run_done, 'step done', status )
    IF_NOTOK_RETURN(status=1)

    ! ok
    status = 0
    
  end subroutine TM5_Timing_Init
  
  
  ! ***
  
  
  !--------------------------------------------------------------------------
  !                    TM5                                                  !
  !--------------------------------------------------------------------------
  !BOP
  !
  ! !IROUTINE:  TM5_Timing_Done
  !
  ! !DESCRIPTION: Interface to write profiling output. Get filename and call
  !               timer (profiler).
  !\\
  !\\
  ! !INTERFACE:
  !
  subroutine TM5_Timing_Done( status )
    !
    ! !USES:
    !
    use GO,          only : pathsep
    use GO,          only : TrcFile, Init, Done, ReadRc
    use GO,          only : GO_Timer_Done
    use Global_Data, only : rcfile
    use Partools,    only : myid
    !
    ! !INPUT/OUTPUT PARAMETERS:
    !
    integer, intent(inout)      ::  status
    !
    ! !REVISION HISTORY: 
    !   21 Sep 2010 - P. Le Sager - uses output.dir instead of outputdir
    !                 (to follow pycasso std) 
    !
    ! !REMARKS:
    !
    !EOP
    !------------------------------------------------------------------------
    !BOC

    ! --- const ----------------------------------

    character(len=*), parameter   ::  rname = mname//'/TM5_Timing_Done'
    
    ! --- local ----------------------------------

    integer               ::  l
    character(len=1024)   ::  outdir
    character(len=256)    ::  subdir
    character(len=1024)   ::  timing_file
    type(TrcFile)         ::  rcF
    logical               ::  putout

    ! --- begin ----------------------------------
    
    ! first open rcfile:
    call Init( rcF, rcfile, status )
    IF_NOTOK_RETURN(status=1)

    ! read flag; by default false to avoid problems with uncreated directories etc:
    call ReadRc( rcF, 'timing.output', putout, status, default=.false. )
    IF_ERROR_RETURN(status=1)

    ! putout ?
    if ( putout ) then

      ! output directory:
      call ReadRc( rcF, 'output.dir', outdir, status )
      IF_NOTOK_RETURN(status=1)

      ! timing subdirectory:
      call ReadRc( rcF, 'timing.output.subdir', subdir, status, default='' )
      IF_ERROR_RETURN(status=1)

      ! filename to output time profile:
      l = len_trim(rcfile)
      write (timing_file,'(5a,"_",i2.2,".prf")') &
                              trim(outdir), pathsep, trim(subdir), pathsep, &
                              rcfile(1:l-3), myid

      ! done with timers; write profile to standard output and file:
      call GO_Timer_Done( status, file=trim(timing_file) )
      IF_NOTOK_RETURN(status=1)

    end if  ! putout

    ! close:
    call Done( rcF, status )
    IF_ERROR_RETURN(status=1)

    ! ok
    status = 0
    
  end subroutine TM5_Timing_Done
  !EOC


  ! ===================================================================
  ! === 
  ! === ok file
  ! === 
  ! ===================================================================

  
  ! Write dummy file 'tm5.ok'.
  ! Existence of this file is used by the scripts to check
  ! if a run ended properly.
  ! Checking exit status would be better, but this does
  ! not trap 'stop' statements and other obscure endings.

  subroutine TM5_Write_OkFile( status )

    use GO, only : goGetFU

    ! --- in/out ----------------------------------
    
    integer, intent(out)          ::  status
    
    ! --- const ------------------------------

    character(len=*), parameter ::  rname = mname//'/TM5_Write_OkFile'
    
    ! --- local ----------------------------------
    
    integer           ::  fu

    ! --- begin -----------------------------------

    ! get free file unit:
    call goGetFU( fu, status )
    IF_NOTOK_RETURN(status=1)
    ! open file:
    open( unit=fu, file='tm5.ok', form='formatted', status='unknown', iostat=status )
    if ( status/=0 ) then
      write (gol,'("from opening okfile")'); call goErr
    else
      ! write happy message:
      write (fu,'("Program terminated normally")',iostat=status)
      if ( status/=0 ) then
        write (gol,'("from writing to okfile")'); call goErr
      else
        ! close:
        close( fu, iostat=status )
        if ( status/=0 ) then
          write (gol,'("from closing okfile")'); call goErr
        end if
      end if
    end if

    ! ok
    status = 0
    
  end subroutine TM5_Write_OkFile


  ! ===================================================================
  ! === 
  ! === model init/done
  ! === 
  ! ===================================================================
  

  subroutine TM5_Model_Init( status )
  
    use GO              , only : TDate, NewDate
    use GO              , only : TrcFile, Init, Done, ReadRc
    use MDF             , only : MDF_Init
    use dims            , only : nregions
    use global_data     , only : rcfile
    use ModelIntegration, only : Proces_Init
    use Meteo           , only : Meteo_Init, Meteo_Init_Grids
    use ParTools        , only : Par_Init
#ifdef with_prism
    use dims            , only : nregions_all,iglbsfc
    use MeteoData       , only : lli, levi
    use TM5_Prism       , only : TM5_Prism_Init, TM5_Prism_Init2
#endif
#ifdef with_tendencies
    use tracer_data     , only : PLC_Init
#endif
    use restart         , only : Restart_Init
  
    ! --- in/out ----------------------------------
    
    integer, intent(out)          ::  status
    
    ! --- const ------------------------------

    character(len=*), parameter ::  rname = mname//'/TM5_Model_Init'
    
    ! --- local ----------------------------------
    
    type(TrcFile)      ::  rcF

    ! --- begin -----------------------------------

#ifdef with_pycasso
    ! extract arguments:
    call TM5_Arguments( status )
    if (status/=0) then
      call TM5_Print_Usage( status )
      status=1; return
    end if
#endif

    ! setup messages
    call TM5_Messages_Init( status )
    IF_NOTOK_RETURN(status=1)

    write (gol,'(a,": init model ...")') rname; call goPr

    ! init parallelisation
    write (gol,'(a,":   init parallelisation ...")') rname; call goPr
    call Par_Init( status )
    IF_NOTOK_RETURN(status=1)

    ! init timers:
    call TM5_Timing_Init( status )
    IF_NOTOK_RETURN(status=1)
    
    ! start timing ...
    call GO_Timer_Start( itim_init, status )
    IF_NOTOK_RETURN(status=1)

    ! init MDF interface to HDF/NetCDF:
    call MDF_Init( status )
    IF_NOTOK_RETURN(status=1)

#ifdef with_prism
    ! init prism coupler: array sizes etc
    write (gol,'(a,":   init prism ...")') rname; call goPr
    call TM5_Prism_Init( rcfile, status )
    IF_NOTOK_RETURN(status=1)
#endif
    
    ! setup restart:
    write (gol,'(a,":   init restart ...")') rname; call goPr
    call Restart_Init( status )
    IF_NOTOK_RETURN(status=1)
    
    ! setup meteo input:
    write (gol,'(a,":   init grids ...")') rname; call goPr
    call Meteo_Init_Grids( status )
    IF_NOTOK_RETURN(status=1)

#ifdef with_prism
    ! init prism coupler: grids
    write (gol,'(a,":   init prism 2 ...")') rname; call goPr
    call TM5_Prism_Init2( nregions, lli(1:nregions), lli(iglbsfc), levi, status )
    IF_NOTOK_RETURN(status=1)
#endif

#ifdef with_tendencies    
    ! init concentration, production, loss rates:
    write (gol,'(a,":   init production/loss/chemistry ...")') rname; call goPr
    call PLC_Init( rcfile, status )
    IF_NOTOK_RETURN(status=1)
#endif
    
    ! setup meteo input:
    write (gol,'(a,":   init meteo (be patient) ...")') rname; call goPr
    call Meteo_Init( status )
    IF_NOTOK_RETURN(status=1)

    ! init processes
    write (gol,'(a,":   init processes ...")') rname; call goPr
    call Proces_Init( status )
    IF_NOTOK_RETURN(status=1)

    write (gol,'(a,":   ok")') rname; call goPr

    ! end timing ...
    call GO_Timer_End( itim_init, status )
    IF_NOTOK_RETURN(status=1)

    ! ok
    status = 0
    
  end subroutine TM5_Model_Init
  
  
  ! ***


  subroutine TM5_Model_Done( status )

    use MDF             , only : MDF_Done
    use ModelIntegration, only : Proces_Done
    use Meteo           , only : Meteo_Done, Meteo_Done_Grids
    use ParTools        , only : Par_Done
#ifdef with_prism
    use TM5_Prism       , only : TM5_Prism_Done
#endif
#ifdef with_tendencies
    use tracer_data     , only : PLC_Done
#endif
    use restart         , only : Restart_Done
  
    ! --- in/out ----------------------------------
    
    integer, intent(out)          ::  status
    
    ! --- const ------------------------------

    character(len=*), parameter ::  rname = mname//'/TM5_Model_Done'
    
    ! --- local -----------------------------------

    integer           ::  errstat
    
    ! --- begin -----------------------------------
    
    write (gol,'(a,": ")') rname; call goPr

    ! start timing ...
    call GO_Timer_Start( itim_done, status )
    IF_NOTOK_RETURN(status=1)

    ! done with restart:
    call Restart_Done( status )
    IF_NOTOK_RETURN(status=1)

#ifdef with_tendencies   
    ! done with production/loss rates
    call PLC_Done( status )
    IF_NOTOK_RETURN(status=1)
#endif

#ifdef with_prism    
    ! done  with prism coupler
    call TM5_Prism_Done( status )
    IF_NOTOK_RETURN(status=1)
#endif

    ! do not break on error from the following routines,
    ! to rescue what could be rescued;
    ! by default, return status is ok:
    errstat = 0
    
    ! done processes
    call Proces_Done( status )
    if (status/=0) then; TRACEBACK; errstat=1; end if

    ! close meteo files etc
    call Meteo_Done( status )
    if (status/=0) then; TRACEBACK; errstat=1; end if

    ! close meteo files etc
    call Meteo_Done_Grids( status )
    if (status/=0) then; TRACEBACK; errstat=1; end if

    ! done with MDF interface to HDF/NetCDF:
    call MDF_Done( status )
    if (status/=0) then; TRACEBACK; errstat=1; end if

    ! end timing ...
    call GO_Timer_End( itim_done, status )
    if (status/=0) then; TRACEBACK; errstat=1; end if
    
    ! done with timing ...
    call TM5_Timing_Done( status )
    if (status/=0) then; TRACEBACK; errstat=1; end if

    ! done parallelisation
    call Par_Done( status )
    if (status/=0) then; TRACEBACK; errstat=1; end if

    ! done with standard output:
    call TM5_Messages_Done( status )
    if (status/=0) then; TRACEBACK; errstat=1; end if

    ! write dummy file to indicate proper end:
    if ( errstat == 0 ) then
      call TM5_Write_OkFile( status )
      if (status/=0) then; TRACEBACK; errstat=1; end if
    end if

    write (gol,'(a,": end")') rname; call goPr

    ! return with error status if some routines failed:
    status = errstat
    
  end subroutine TM5_Model_Done


  ! ===================================================================
  ! === 
  ! === model run
  ! === 
  ! ===================================================================
  

  subroutine TM5_Model_Run( status )
  
    use GO              , only : TrcFile, Init, Done, ReadRc
    use GO              , only : TDate, NewDate, IncrDate, wrtgol
    use GO              , only : rTotal, operator(+), operator(-), operator(>), operator(==)
    use dims            , only : nregions
    use dims            , only : region_status => status
    use dims            , only : nread
    use dims            , only : idate, idatee, idatei
    use dims            , only : itau , itaue, itaur
    use dims            , only : ndyn_max
    use dims            , only : nread, ndyn, nconv, nsrce, nchem
    use dims            , only : revert
    use dims            , only : newsrun, newmonth
    use dims            , only : nread, idate
    use global_data     , only : rcfile
    use ParTools        , only : Par_Barrier
    use datetime        , only : inctime
    use tracer_data     , only : Par_Check_Domain
    use Meteo           , only : Meteo_Setup_Other
    use Meteo           , only : Meteo_Setup_Mass
#ifndef without_advection
    use AdvectM_CFL     , only : Check_CFL, Setup_MassFlow
#endif
    use ModelIntegration, only : Proces_Update, Proces_Region
    use InitExit        , only : Start
    use InitExit        , only : Exitus
    use sources_sinks   , only : trace0
    use user_output     , only : user_output_init, user_output_done, user_output_mean, user_output_step
#ifdef with_tendencies
    use tracer_data      , only : plc_reset_period
    use tm5_tendency_eval, only : apply_tendency, reset_tendency
#endif
    use restart         , only : Restart_Save
#ifdef with_GFED_8day
    use emission        , only : declare_emission_GFED
#endif
    use datetime,    only : tau2date,date2tau

    ! --- in/out ----------------------------------
    
    integer, intent(out)          ::  status
    
    ! --- const ----------------------------------

    character(len=*), parameter ::  rname = mname//'/TM5_Model_Run'
    
    ! --- local ----------------------------------
    
    type(TrcFile)     ::  rcF
    type(TDate)       ::  tread1, tread2
    type(TDate)       ::  tdyn, tend, tr(2)
    logical           ::  isfirst
    integer           ::  nhalf
    logical           ::  this_is_the_end
    logical           ::  check_pressure
    integer           ::  region
    integer           ::  n
#ifdef with_GFED_8day    
    type(TDate)       ::  tt_beginyear,tt_day
    integer           ::  dt_day
#endif
    ! CarbonTracker-specific restart quantities; not used unless
    ! the rcfile contains a "jobstep.step" key.
    integer,dimension(6) :: ct_restart_special = (/0,0,0,0,0,0/)
    integer :: ct_itau,jobstep_step
    ! --- begin -----------------------------------
    
    write (gol,'(a,": begin")') rname; call goPr

    ! ~~~ rc file settings ~~~

    write (gol,'(a,": read settings ...")') rname; call goPr

    ! open rcfile:
    call Init( rcF, rcfile, status )
    IF_NOTOK_RETURN(status=1)

    ! ensure that every 'nread' seconds is at the end of a dynamic time step:
    call ReadRc( rcF, 'time.ntimestep', nread, status )
    IF_NOTOK_RETURN(status=1)

    ! a CarbonTracker-specific setting; no error if is it missing
    call ReadRc( rcF, 'jobstep.step' ,jobstep_step, status ,default=0)
    IF_ERROR_RETURN(status=1)
    
    ! close rcfile:
    call Done( rcF, status )
    IF_NOTOK_RETURN(status=1)
    
    ! ~~~~~~~~~~~~~~~~~~~~~~~~

    write (gol,'(a,": call start ..")') rname; call goPr

    ! set-up and read user input; 
    ! return time interval for which meteo was read:
    call Start( tread1, tread2, status )
    IF_NOTOK_RETURN(status=1)

    write (gol,'(a,": init user output ..")') rname; call goPr

    ! initialise user-specified output:
    call user_output_init( status )
    IF_NOTOK_RETURN(status=1)

    write (gol,'(a,": setup times ..")') rname; call goPr

    ! current time (begin of dynamics step)
    tdyn = NewDate( time6=idate  )
    tend = NewDate( time6=idatee )

    !synchronize time-count regions....
    itaur(:) = itau 

    write (gol,'(a,": start time loop ...")') rname; call goPr

    ! first step in time loop ?
    isfirst = .true.
    nhalf   = 0

    if(jobstep_step .gt. 0) then
       call date2tau(idatei,ct_itau)
       ct_itau=ct_itau + 86400*jobstep_step
       call tau2date(ct_itau,ct_restart_special)
    end if

    ! time loop over steps ndyn/2 (!)
    do 

      ! start timing ...
      call GO_Timer_Start( itim_run_init, status )
      IF_NOTOK_RETURN(status=1)

      ! is this the end time ?
      this_is_the_end = (revert*itau) >= (revert*itaue)

      ! next half step
      nhalf = modulo(nhalf,2) + 1

      !
      ! *** exchange coupled fields ***
      !

      ! exchange fields at begin of dynamic time step (or end time):
      if ( nhalf == 1 ) then
      
#ifdef with_tendencies
        ! time to post-proces tendencies ?
        if ( (modulo(tdyn%hour,plc_reset_period)==0) .and. all((/tdyn%min,tdyn%sec,tdyn%mili/)==0) ) then
          call apply_tendency( isfirst ,tdyn, status )
        end if
#endif

        ! eventually save extra restart file, or final save file:
        if (all((ct_restart_special - idate) .eq. 0)) then
           write (gol,'(a,": Writing restart files for CarbonTracker jobstep.step.")') rname; call goPr
           call Restart_Save( status, extra=.false., isfirst=isfirst )
        else
           ! restart file gets written when extra is .false.  
           call Restart_Save( status, extra=(.not. this_is_the_end ), isfirst=isfirst )
        endif
        IF_NOTOK_RETURN(status=1)

#ifdef with_tendencies    
        ! reset tendencies at exchange times:
        if ( (modulo(tdyn%hour,plc_reset_period)==0) .and. all((/tdyn%min,tdyn%sec,tdyn%mili/)==0) ) then
          call reset_tendency ( status )
        end if
#endif

      end if

      ! write output for this time:
      !cmk: replaced this in the modelintegration.
      !cmk:do region = 1,nregions
      !cmk:  call user_output_step( region, status )
      !cmk:  IF_NOTOK_RETURN(status=1)
      !cmk:end do

      !
      ! *** new time interval ? ***
      !

      ! end timing ...
      call GO_Timer_End( itim_run_init, status )
      IF_NOTOK_RETURN(status=1)

      ! end time reached ? then leave
      if ( this_is_the_end ) exit

      ! start timing ...
      call GO_Timer_Start( itim_run_init, status )
      IF_NOTOK_RETURN(status=1)

      ! display current time interval:
      if ( nhalf == 1 ) then
        write (gol,'(" ")'); call goPr
        call wrtgol( '>>> dynamics step from : ', tdyn ); call goPr
        write (gol,'(" ")'); call goPr
      end if

      !
      ! *** setup data ***
      !

      ! first set-up of chemistry related work...repeated if newmonth
      if ( newmonth .and. (.not. newsrun) ) then
        call trace0( status )
        IF_NOTOK_RETURN(status=1)
      end if

#ifdef with_GFED_8day
      tt_beginyear = NewDate(year=tdyn%year) 
      tt_day = NewDate(year = tdyn%year, month = tdyn%month, day = tdyn%day )
      dt_day = rTotal( tt_day - tt_beginyear, 'day' )   
      if ( modulo( dt_day, 8 ) == 0 .and. &
              all( (/tdyn%hour,tdyn%min,tdyn%sec,tdyn%mili/) == 0 ) ) then
        call declare_emission_GFED( status )
      endif
#endif

      ! reached end of time interval for which meteo is valid ? then setup new meteo:
      if ( tdyn == tread2 ) then

        ! reset possible reduced timestep due to CFL:
        ndyn =  ndyn_max
        nsrce = ndyn_max
        nconv = ndyn_max
        nchem = ndyn_max

        !in zoom DO this for all zoom regions,now for only one!
        do region = 1,nregions
           call Par_Check_Domain( region, 'n', 'tracer' )
        end do

        ! setup meteo data for next interval;
        ! nread is the length (in seconds) of the interval in which 
        ! surface pressure is interpolated (and mass fluxes are constant)
        tread1 = tdyn
        tread2 = tdyn + IncrDate(sec=nread)
        if ( tread2 > tend ) tread2 = tend

        ! n is the number of dynamic intervals within the
        ! time interval for which the meteo has been setup:
        n = ceiling( rTotal(tread2-tread1,'sec') / real(ndyn) )
        ndyn = nint( rTotal(tread2-tread1,'sec') / n )

        ! setup mass and mass fluxes:
        !  o skip first time; already called in 'initexit/start'
        !  o check pressure implied by advection if advection is applied
#ifdef without_advection
        check_pressure = .false.
#else
        check_pressure = .true.
#endif
        call Meteo_Setup_Mass( tread1, tread2, status, check_pressure=check_pressure )
        IF_NOTOK_RETURN(status=1)

#ifndef without_advection
        ! determine dynamic timestep ndyn for this interval [tread1,tread2] ;
        ! the initial number of time steps n is increased until no cfl
        ! violations occure
        call Check_CFL( tread1, tread2, n, status )
        IF_NOTOK_RETURN(status=1)
#endif

      end if

      ! setup meteo for dynamic step tdyn+[0,ndyn]
      if ( nhalf == 1 ) then
        ! time range of dynamic step:
        tr(1) = tdyn
        tr(2) = tdyn + IncrDate( sec=ndyn )
#ifndef without_advection
        ! convert pu/pv to am/bm/cm, eventually time interpolated
        call Setup_MassFlow( tr, status )
        IF_NOTOK_RETURN(status=1)
#endif
        ! setup (interpolate?) other meteo:
        call Meteo_Setup_Other( tr(1), tr(2), status )
        IF_NOTOK_RETURN(status=1)

        ! recalculate proces dependend fields if necessary
        call Proces_Update( status )
        IF_NOTOK_RETURN(status=1)

      end if

      ! end timing ...
      call GO_Timer_End( itim_run_init, status )
      IF_NOTOK_RETURN(status=1)

      !
      ! *** processes ***
      !

      ! start timing ...
      call GO_Timer_Start( itim_run_step, status )
      IF_NOTOK_RETURN(status=1)

      if ( ndyn > 0 ) then

        ! reset the process status counters:
        if ( nhalf == 1 ) region_status(1:nregions) = 0

        ! info ...
        !if (myid==root) write (*,'(a,": Start processing main region")') pname

        tr(1) = tdyn
        tr(2) = tdyn + IncrDate(sec=ndyn/2)
        if ( nhalf == 1 ) then
          write (gol,'(" ")'); call goPr
          call wrtgol( '--> first  half : ', tr(1), ' - ', tr(2) ); call goPr
          write (gol,'(" ")'); call goPr
        end if
        if ( nhalf == 2 ) then
          write (gol,'(" ")'); call goPr
          call wrtgol( '--> second half : ', tr(1), ' - ', tr(2) ); call goPr
          write (gol,'(" ")'); call goPr
        end if

        !synchronize time-count regions....
        itaur(:) = itau 
        call Par_Barrier

        !
        ! start recursive process for the main region = 1
        ! Within the advection, all the other processes are incorporated...
        ! Also the regions 'below' are called recursively....
        !

        ! start processing main region
        call Proces_Region( 1, tr, status )
        IF_NOTOK_RETURN(status=1)

        ! check times ...
        do region = 2, nregions
          if ( itaur(region) /= itaur(1) ) then
            write (gol,'("exit of routine proces_region with non-synchronized clocks:")'); call goErr
            write (gol,'("  region          : ",i2)') region; call goErr
            write (gol,'("  itaur(region)   : ",i12)') itaur(region); call goErr
            write (gol,'("  itaur(     1)   : ",i12)') itaur(1); call goErr
            TRACEBACK; status=1; return
          end if
        end do

      end if

      ! end timing ...
      call GO_Timer_End( itim_run_step, status )
      IF_NOTOK_RETURN(status=1)

      !
      ! *** next ***
      !

      ! start timing ...
      call GO_Timer_Start( itim_run_done, status )
      IF_NOTOK_RETURN(status=1)

      ! advance the model time with ndyn/2 seconds:
      call inctime
      tdyn = tdyn + IncrDate( sec=nint(ndyn/2.0) )

      ! update mean outputs:
      if ( mod(itau,ndyn_max) == 0) then
        call user_output_mean( status )
        IF_NOTOK_RETURN(status=1)
      end if
      
      ! end timing ...
      call GO_Timer_End( itim_run_done, status )
      IF_NOTOK_RETURN(status=1)

      ! end of first time loop step:
      isfirst = .false.

    end do   ! main loop 

    ! complete user-specified output:
    call user_output_done( status )
    if (status/=0) then; write (gol,'("in ",a,"; continue")') rname; call goErr; end if

    ! store save file etc
    call exitus

    write (gol,'(a,": end")') rname; call goPr

    ! ok
    status = 0
    
  end subroutine TM5_Model_Run


end module TM5
