enkf_cosmo.F90 Source File


Source Code

subroutine cosmo_init(pdaf_id)  bind(C,name="cosmo_init")

use iso_C_binding  
use enkf_cosmo_mod

integer(c_int), intent(in) :: pdaf_id

! Set suffix for INPUT_IO from input
cosmo_input_suffix = pdaf_id

!------------------------------------------------------------------------------
!- End of Header
!------------------------------------------------------------------------------
#ifdef FPEABORT
! Floating point exception trapping
      CALL initialize_fpe_trap(.TRUE., ierrstat)
      IF ( ierrstat /= 0 ) THEN
        STOP 'Error initializing ftp_trap'
      END IF
#endif

  ierrstat = 0_iintegers
  izerror  = 0_iintegers
  yroutine = 'lmorg'

!------------------------------------------------------------------------------
!- Section 1: Setup of the model and Namelist Input for all components
!------------------------------------------------------------------------------

  ! Section 1 has to be computed by all PEs (Compute and IO-PEs)
  ! After Section 1 the PEs for computing and IO are splitted

  CALL organize_setup

  IF (my_cart_id == 0) THEN
    ! Print the default information to stdout:
    CALL info_define ('lmparbin')          ! Pre-define the program name
    CALL info_readnl ('INPUT_COSMO')       ! Read additional information from namelist file
    CALL info_print ()                     ! Print the information to stdout
  ENDIF

  ! Initialize, whether debug output shall be done
  IF (lprintdeb_all) THEN
    izdebug = idbg_level
  ELSE
    IF (my_cart_id == 0) THEN
      izdebug = idbg_level
    ELSE
      izdebug = 0
    ENDIF
  ENDIF

  ! Input of the dynamics namelist
  CALL organize_dynamics ('input', izerror, yzerrmsg, dt, .FALSE.)
  IF (izerror /= 0_iintegers) THEN
    CALL model_abort (my_world_id, 100+izerror, yzerrmsg,               &
                                   'organize_dynamics: input')
  ENDIF

  ! Input of the physics namelist
  CALL organize_physics ('input', izerror, yzerrmsg)
  IF (izerror /= 0_iintegers) THEN
    CALL model_abort (my_world_id, 100+izerror, yzerrmsg,             &
                                   'organize_physics: input')
  ENDIF

#ifdef COSMOART
! AF Save the value of l_cosmo_art in l_cosmo_art_nl
  IF (l_cosmo_art) THEN
    l_cosmo_art_nl=l_cosmo_art
  ENDIF

  ! Input of the COSMO_ART namelist
  IF (l_cosmo_art) THEN
    CALL organize_cosmo_art ('input', ydate_ini, izerror, yzerrmsg)
    IF (izerror /= 0_iintegers) THEN
      CALL model_abort (my_world_id, 100+izerror, yzerrmsg,             &
                                   'organize_cosmo_art: input')
    ENDIF
  ENDIF
#endif

#ifdef POLLEN
  ! Input of the Pollen namelist
  IF (l_pollen) THEN
    CALL organize_pollen ('input', ydate_ini, izerror, yzerrmsg)
    IF (izerror /= 0_iintegers) THEN
      CALL model_abort (my_world_id, 100+izerror, yzerrmsg,             &
                                   'organize_pollen: input')
    ENDIF
  ENDIF
#endif

  IF (ltraj) THEN
    CALL organize_traj('input', izerror, yzerrmsg)
    IF (izerror /= 0_iintegers) THEN
      CALL model_abort(my_world_id, 100+izerror, yzerrmsg,'organize_traj: input')
    ENDIF
  ENDIF

  ! Input of the diagnosis namelist
  CALL organize_diagnosis ('input', izerror, yzerrmsg)
  IF (izerror /= 0_iintegers) THEN
    CALL model_abort (my_world_id, 100+izerror, yzerrmsg,             &
                                   'organize_diagnosis: input')
  ENDIF

#ifdef NUDGING
  ! Input of the assimilation namelist
  IF (luseobs) THEN
    CALL organize_assimilation ('input', izerror, yzerrmsg)
    IF (izerror /= 0_iintegers) THEN
      CALL model_abort (my_world_id, 100+izerror, yzerrmsg,             &
                                     'organize_assimilation: input')
    ENDIF
  ENDIF
#endif

  ! Input of the EPS namelist
  IF (leps .OR. lsppt) THEN
    CALL organize_eps ('input', izerror, yzerrmsg)
    IF (izerror /= 0_iintegers) THEN
      CALL model_abort (my_world_id, 100+izerror, yzerrmsg,             &
                                      'organize_eps: input')
    ENDIF
  ENDIF

#ifdef RADARFWO
  ! Initialize parameters in data_radar.f90, which have to do with the model
  !  configuration (cartesian grid, PEs, MPI), with the respective parameters of the COSMO-model.
  ! This is done in any case, because it also concerns the "normal" DBZ gridpoint output
  !  defined in the GRIBOUT namelists, which is possible also in case of luse_radarfwo = .FALSE.
  ! This has to be done BEFORE the GRIBOUT-namelist(s) is/are read.
  CALL get_model_config_for_radar ()
#endif

  ! Input of the namelists for the I/O-package
  CALL organize_data ('input', 0, izerror, yzerrmsg)
  IF (izerror /= 0_iintegers) THEN
    CALL model_abort (my_world_id, 100+izerror, yzerrmsg,               &
                                   'organize_data: input')
  ENDIF

#if defined RTTOV7 || defined RTTOV9 || defined RTTOV10
  IF (luse_rttov) THEN
    ! Input of the namelists for the RTTOV-package
    CALL organize_satellites ('input', izerror, yzerrmsg)
    IF (izerror /= 0_iintegers) THEN
      CALL model_abort (my_world_id, 100+izerror, yzerrmsg,             &
                                     'organize_satellites: input')
    ENDIF
  ENDIF
#endif

  ! Initialize I/O (must be called by all PEs)
  CALL organize_data ('init', 0, izerror, yzerrmsg)
  IF (izerror /= 0_iintegers) THEN
    CALL model_abort (my_world_id, 100+izerror, yzerrmsg,               &
                                   'organize_data: init')
  ENDIF

  ! Initialize tracer module
  CALL trcr_init( izerror )
  IF ( izerror /= 0_iintegers ) THEN
    yzerrmsg = trcr_errorstr( izerror )
    CALL model_abort( my_world_id, izerror, yzerrmsg, 'trcr_init' )
  ENDIF

  ! Initialize the timings
  CALL get_free_unit (nutiming)
  CALL init_timings (nstart, nstop, dt, itype_timing, ldfi,             &
                     lphys, luseobs, l2tls, lsemi_imp, l_cosmo_art,     &
                     l_2mom, luse_radarfwo, izerror)
  IF (izerror /= 0) THEN
    ! no system clock present
    ltime = .FALSE.
  ENDIF

#ifdef MESSY
  CALL messy_initialize
  CALL messy_new_tracer
#endif

!------------------------------------------------------------------------------
! Section 2: Allocation of space and computation of constant fields
!------------------------------------------------------------------------------

! Now comes the part for the compute PEs. The part for the IO-PEs is in
! the ELSE-part at the end of the program.

! comp_pe: IF (lcompute_pe) THEN

  !------------------------------------------------------------------------------
  ! 2.1:  Tracer definition
  !------------------------------------------------------------------------------

  ! Setup tracers for the physics (e.g. microphysics)
  CALL organize_physics( 'tracer', izerror, yzerrmsg )
  IF ( izerror /= 0_iintegers ) THEN
    CALL model_abort( my_world_id, 100+izerror, yzerrmsg,                     &
                                   'organize_physics: tracer' )
  ENDIF

  ! Setup other artificial tracer substances
  CALL gen_trcr_data( 'define', izerror, yzerrmsg )
  IF ( izerror /= 0_iintegers ) THEN
    CALL model_abort( my_world_id, 101+izerror, yzerrmsg,                     &
                                   'gen_trcr_data: define' )
  ENDIF

  !------------------------------------------------------------------------------
  ! 2.2:  Space allocation
  !------------------------------------------------------------------------------

  ! allocate space
  IF (izdebug > 0) THEN
    PRINT *,'    ALLOCATE SPACE'
  ENDIF

#ifdef NETCDF
  IF( lasync_io .AND. nc_asyn_io>0 ) THEN 
    CALL allocate_io_sendbuffer(yzerrmsg, izerror)
    IF (izerror /= 0) THEN
      ierrstat = 3321
      yzerrmsg = ' ERROR    *** Allocation of space for isend_buffer failed *** ' // yzerrmsg(1:100)
      CALL model_abort(my_cart_id, ierrstat, yzerrmsg,'allocate_io_sendbuffer' )
    ENDIF
  ENDIF
#endif

  ! fields for the meteorological variables
  CALL organize_allocation ('default', izerror)

  IF (izerror /= 0) THEN
    ierrstat = 1004
    yzerrmsg  = ' ERROR    *** Allocation of space for meteofields failed ***'
    CALL model_abort (my_cart_id, ierrstat, yzerrmsg, 'allocation: default')
  ENDIF

#ifdef COSMOART
  IF (l_cosmo_art) THEN
    CALL organize_cosmo_art ('allocate', ydate_ini, izerror, yzerrmsg)

    IF (izerror /= 0) THEN
      ierrstat = 1005
      yzerrmsg  = ' ERROR    *** Allocation of space for COSMO_ART failed ***'
      CALL model_abort (my_cart_id, ierrstat, yzerrmsg,             &
                                    'organize_cosmo_art: allocate')
    ENDIF
  ENDIF
#endif

#ifdef POLLEN
  IF (l_pollen) THEN
    CALL organize_pollen ('allocate', ydate_ini, izerror, yzerrmsg)

    IF (izerror /= 0) THEN
      ierrstat = 1005
      yzerrmsg  = ' ERROR    *** Allocation of space for Pollen failed ***'
      CALL model_abort (my_cart_id, ierrstat, yzerrmsg,             &
                                    'organize_pollen: allocate')
    ENDIF
  ENDIF
#endif

  ! tracer fields
  CALL trcr_alloc( izerror )
  IF ( izerror /= 0 ) THEN
    ierrstat = izerror
    yzerrmsg = trcr_errorstr( izerror )
    CALL model_abort( my_cart_id, ierrstat, yzerrmsg, 'allocation: tracers' )
  ENDIF

  ! block fields allocation
  IF (lphys) THEN
     CALL block_fields_allocate( izerror)
     IF ( izerror /= 0 ) THEN
        ierrstat = 1006
        yzerrmsg = 'block field allocation failed'
        CALL model_abort( my_cart_id, ierrstat, yzerrmsg, &
             'src_block_fields_org: block_fields_allocate' )
     ENDIF
  END IF

  !------------------------------------------------------------------------------
  ! 2.3:  Computation of constant fields
  !------------------------------------------------------------------------------

  CALL constant_fields

#ifdef RADARFWO

  IF (ltime) CALL get_timings (i_initializations, ntstep, dt, izerror)

  !------------------------------------------------------------------------------
  ! 2.4:  Initialization of radar forward operator on all compute PEs:
  !         - reading the namelist
  !         - reading radar meta informations from Radar data files
  !         - initializing lookup tables for Mie scattering if necessary
  !         - setting up auxiliary grids ("azimutal slices" for online propag.)
  !         - in case of not using the full 3D polar operator (luse_radarfwo=.false.),
  !           the COSMO model uses still the gridpoint reflectivity calculation
  !           of EMRADSCOPE. This needs an extra initialization "init_only_radar_gridpoint_calc"
  !------------------------------------------------------------------------------

  IF (luse_radarfwo) THEN
    CALL organize_radar ('init', nnew)
  END IF

  IF (ltime) CALL get_timings (i_radarsim, ntstep, dt, izerror)

#endif

!------------------------------------------------------------------------------
!- Section 3: Input of first data sets
!------------------------------------------------------------------------------

  ! Read or generate initial data and the first boundary data sets
  CALL organize_data ('start', 0, izerror, yzerrmsg)
  IF (izerror /= 0_iintegers) THEN
    CALL model_abort (my_cart_id, 100+izerror, yzerrmsg,                &
                                   'start: input-init')
  ENDIF

#ifdef MESSY
  ! messy_init_memory is called inside organize_data
#endif

  !------------------------------------------------------------------------------
  ! 3.1:  Tracer summary and retrieval of metadata
  !------------------------------------------------------------------------------

  IF (izdebug > 2) THEN
    ! Print tracer list
    CALL trcr_print( izerror )
    IF ( izerror /= 0_iintegers ) THEN
      yzerrmsg = trcr_errorstr( izerror )
      CALL model_abort( my_world_id, izerror, yzerrmsg, 'trcr_print' )
    ENDIF
  ENDIF

  ! Retrieve the required metadata
  ALLOCATE (izlbc(trcr_get_ntrcr()), STAT=izerror)
  CALL trcr_meta_get(izerror, T_LBC_ID, izlbc)
  IF (izerror /= 0) THEN
    yzerrmsg = trcr_errorstr(izerror)
    CALL model_abort(my_cart_id, izerror, yzerrmsg, yroutine)
  ENDIF

  ALLOCATE (izclp(trcr_get_ntrcr()), STAT=izerror)
  CALL trcr_meta_get(izerror, T_CLP_ID, izclp)
  IF (izerror /= 0) THEN
    yzerrmsg = trcr_errorstr(izerror)
    CALL model_abort(my_cart_id, izerror, yzerrmsg, yroutine)
  ENDIF

  ALLOCATE (izbd_forced(trcr_get_ntrcr()), STAT=izerror)
  CALL trcr_meta_get(izerror, "BD_SET_FORCED", izbd_forced)
  IF (izerror /= 0) THEN
    yzerrmsg = trcr_errorstr(izerror)
    CALL model_abort(my_cart_id, izerror, yzerrmsg, yroutine)
  ENDIF

!------------------------------------------------------------------------------
!- Section 4: Initializations and allocation of extra space
!------------------------------------------------------------------------------

  IF (izdebug > 0) THEN
    PRINT *, '  INITIALIZATIONS'
  ENDIF

  !------------------------------------------------------------------------------
  ! 4.1:  Initialization of different packages
  !------------------------------------------------------------------------------

  CALL organize_dynamics ('init', izerror, yzerrmsg, dt, .FALSE.)
  IF (izerror /= 0_iintegers) THEN
    CALL model_abort (my_cart_id, 100+izerror, yzerrmsg,                &
                                   'organize_dynamics: init')
  ENDIF

  ! Initialization of the physics
  IF (lphys) THEN
    CALL organize_physics ('init', izerror, yzerrmsg)
    IF (izerror /= 0_iintegers) THEN
      CALL model_abort (my_cart_id, 100+izerror, yzerrmsg,              &
                                     'organize_physics: init')
    ENDIF

    ! allocate fields for meteorological variables concerned to the canopy
    CALL organize_allocation ('canopy', izerror)
    IF (izerror /= 0) THEN
      ierrstat = 1004
      yzerrmsg  = ' ERROR    *** Allocation of extra space failed ***'
      CALL model_abort (my_cart_id, ierrstat, yzerrmsg, 'allocation: canopy')
    ENDIF

    ! Initialization of the stochastics physics
    IF (lsppt) THEN
      CALL organize_eps ('init', izerror, yzerrmsg)
      IF ( izerror /= 0 ) THEN
        CALL model_abort (my_cart_id, 100+izerror, yzerrmsg,               &
                                       'organize_eps: init')
      ENDIF
    ENDIF
  ENDIF
  
#ifdef COSMOART
  ! Initialization of COSMO_ART
  IF (l_cosmo_art) THEN
    CALL organize_cosmo_art ('init', ydate_ini, izerror, yzerrmsg)
    IF (izerror /= 0_iintegers) THEN
      CALL model_abort (my_cart_id, 100+izerror, yzerrmsg,              &
                                    'organize_cosmo_art: init')
    ENDIF

    ! Initial profiles of gas phase species of LM_ART
    IF (lgas) THEN
      CALL organize_cosmo_art ('start_gas', ydate_ini, izerror, yzerrmsg)
      IF (izerror /= 0_iintegers) THEN
        CALL model_abort (my_cart_id, 100+izerror, yzerrmsg,              &
                                    'organize_cosmo_art: start_gas')
      ENDIF
    ENDIF
  ENDIF
#endif

#ifdef POLLEN
  ! Initialization of the pollen
  IF (l_pollen) THEN
    CALL organize_pollen ('init', ydate_ini, izerror, yzerrmsg)
    IF (izerror /= 0_iintegers) THEN
      CALL model_abort (my_cart_id, 100+izerror, yzerrmsg,              &
                                     'organize_pollen: init')
    ENDIF
  ENDIF
#endif

  IF (ltraj) THEN
    CALL organize_traj('init',izerror,yzerrmsg)
    IF (izerror /= 0_iintegers) THEN
      CALL model_abort(my_world_id, 100+izerror, yzerrmsg,'organize_traj: init')
    ENDIF
  ENDIF

  ! Initialization of the diagnosis
  IF (ldiagnos) THEN
    CALL organize_diagnosis ('init', izerror, yzerrmsg)
    IF (izerror /= 0_iintegers) THEN
      CALL model_abort (my_cart_id, 100+izerror, yzerrmsg,              &
                                     'organize_diagnosis: init')
    ENDIF
  ENDIF

#ifdef NUDGING
  ! Initialization of the assimilation
  IF (luseobs) THEN
    CALL organize_assimilation ('init', izerror, yzerrmsg)
    IF (izerror /= 0_iintegers) THEN
      CALL model_abort (my_cart_id, 100+izerror, yzerrmsg,              &
                                     'organize_assimilation: init')
    ENDIF
  ENDIF
#endif

  IF (luse_rttov) THEN
#ifdef RTTOV10
    IF (lobsrad) THEN
      ! Read satpp files
      CALL organize_satellites('input-satpp',izerror, yzerrmsg)
      IF (izerror /= 0_iintegers) THEN
        CALL model_abort (my_world_id, 100+izerror, yzerrmsg,             &
                          'organize_satellites: input-satpp')
      ENDIF
    ENDIF
#endif

#if defined RTTOV7 || defined RTTOV9 || defined RTTOV10
    IF (lsynsat) THEN
      ! initialization of variables for the synthetic satellite computations
      CALL organize_satellites ('init', izerror, yzerrmsg)
      IF (izerror /= 0_iintegers) THEN
        CALL model_abort (my_cart_id, 100+izerror, yzerrmsg,              &
                                       'organize_satellites: init')
      ENDIF
    ENDIF
#endif
  ENDIF

  ! Initialization of blocks fields 
  ! This needs to be done after all arrays have been allocated
  IF (lphys) THEN
     ! Register block fields
     CALL block_fields_register_all( izerror )
     IF (izerror /= 0_iintegers) THEN
        yzerrmsg = 'Block field registration failed'
        CALL model_abort (my_cart_id, izerror, yzerrmsg,           &
             'src_block_fields_org: block_fields_register_all')
     ENDIF

     ! Initialize copy for each physics scheme
     CALL organize_physics ('init_copy', izerror, yzerrmsg)
     IF (izerror /= 0_iintegers) THEN
        CALL model_abort (my_cart_id, 100+izerror, yzerrmsg,              &
             'organize_physics: init_copy')
     ENDIF
  END IF

!------------------------------------------------------------------------------
! Section 5: Model initialization by digital filtering
!------------------------------------------------------------------------------

  IF (ldfi) THEN
    IF (izdebug > 0) THEN
      PRINT *, '    DIGITAL FILTERING'
    ENDIF
    IF(l2tls) THEN
      IF (izdebug > 0) THEN
        PRINT *, ' **** CAUTION **** CAUTION **** CAUTION **** CAUTION ****'
        PRINT *, ' ****   DIGITAL FILTERING not tested for 2TL-scheme  ****'
        PRINT *, ' **** **** ****  Proceed on your own risk  **** **** ****'
      ENDIF
    ENDIF
    !   switch off SPPT during DFI (as DFI calls organize_dynamics, "_physics)
    lzspptd = lsppt
    lsppt   = .FALSE.
    CALL dfi_initialization (lbd_frame, undef, izerror, yzerrmsg)
    IF (izerror /= 0_iintegers) THEN
      CALL model_abort (my_cart_id, 100+izerror, yzerrmsg,            &
                                     'dfi_initialization')
    ENDIF
    lsppt   = lzspptd
  ENDIF
  
  ! Close file for control output
  IF (my_cart_id == 0) THEN
    CLOSE (nuspecif, STATUS='KEEP')
  ENDIF

  ! halve the time step, if ntstep = 0
  ! (in src_setup: nstep = nstart)
  IF (.NOT. l2tls) THEN
    IF (ntstep == 0) THEN
      zforecasttime = 0.0_wp
      dt = 0.5_wp * dt
    ELSE
      zforecasttime = 0.5_wp*dt + (ntstep-1)*dt
      nzdiv         = INT (zforecasttime / 3600.0_wp, iintegers)
      zforecasttime = zforecasttime - nzdiv * 3600.0_wp
    ENDIF
  ELSE
    IF (ntstep == 0) THEN
      zforecasttime = 0.0_wp
    ELSE
      zforecasttime = ntstep*dt
      nzdiv         = INT (zforecasttime / 3600.0_wp, iintegers)
      zforecasttime = zforecasttime - nzdiv * 3600.0_wp
    ENDIF
  ENDIF

  IF (lbdclim) THEN
    ynote         = '...... FORECAST TIME IS NOW xxxxxx DAYS ......'
  ELSE
    ynote         = '...... FORECAST TIME IS NOW xxx HOURS   ......'
  ENDIF

  !------------------------------------------------------------------------------
  ! 5a. Temperature disturbance(s) (either in the air or at the soil surface
  !    or within the soil) in the initial conditions
  !------------------------------------------------------------------------------

  ! There are different types of possible disturbances, see the documentation
  ! of the corresponding namelist parameters in INPUT_IDEAL, and there is the possibility
  ! to specify more than one disturbance (up to 50 right now).
  
  IF (lartif_data) THEN
    CALL set_tempdist(nnew)

    ! Copy the modified fields T and QV into timelevel nnow for leapfrog integration:
    IF (.NOT. l2tls) THEN
      CALL trcr_get(izerror, 'QV', ptr_tlev = nnew, ptr = qv_new)
      IF (izerror /= 0) THEN
        yzerrmsg = trcr_errorstr(izerror)
        CALL model_abort(my_cart_id, izerror, yzerrmsg, 'lmorg: T/QV disturbance(s) at model start')
      ENDIF
      IF (izerror /= 0) THEN
      CALL trcr_get(izerror, 'QV', ptr_tlev = nnow, ptr = qv_now)
        yzerrmsg = trcr_errorstr(izerror)
        CALL model_abort(my_cart_id, izerror, yzerrmsg, 'lmorg: T/QV disturbance(s) at model start')
      ENDIF
      t(:,:,:,nnow) = t(:,:,:,nnew)
      qv_now(:,:,:) = qv_new(:,:,:)
    END IF

    ! Initial condition on t_so (takes only effect if lsoil=.true.)
    CALL set_tempdist_tso(nnew)

    ! Copy soil temperatures into timelevel nnow for leapfrog integration:
    IF (.NOT. l2tls) THEN
      t_s   (:,:,nnow) = t_s (:,: ,nnew)
      t_g   (:,:,nnow) = t_g (:,: ,nnew)
      IF (lmulti_layer) THEN
        t_so(:,:,:,nnow) = t_so(:,:,:,nnew)
      ELSE
        t_m(:,:,nnow)  = t_m(:,:,nnew)
      ENDIF
    END IF
  ENDIF

#if defined COUP_OAS
  CALL oas_cos_define
!OASIS4 only
!  CALL oas_cos_update_time(0)
#endif

#ifdef MESSY
 CALL messy_init_coupling
 IF (nstart /= 0) CALL messy_channel_read_restart
 CALL messy_init_tracer
#endif

  IF (ltime) CALL get_timings (i_initializations, ntstep, dt, izerror)

  !------------------------------------------------------------------------------
  ! 5b. For periodic BCs we may need an exchange here, otherwise some fields
  !     might not be periodic in the first timestep:
  !------------------------------------------------------------------------------

  IF (lperi_x .OR. lperi_y) THEN

    ! Check, whether additional communication for the convection is
    ! necessary
    lzconv = lconv .AND. lconf_avg .AND.                         &
         ((ntstep < 1) .OR. (MOD(ntstep+2,nincconv)==0))

    IF (ltime_barrier) THEN
      CALL comm_barrier (icomm_cart, ierrstat, yzerrmsg)
      IF (ltime) CALL get_timings (i_barrier_waiting_dyn, ntstep, dt, izerror)
    ENDIF

    IF     ( l2tls ) THEN
      CALL exchange_runge_kutta
    ELSE ! Leapfrog:
      CALL exchange_leapfrog
    ENDIF

    IF (ltime) CALL get_timings (i_communications_dyn, ntstep, dt, izerror)

  ENDIF

!kuw initialize cos_start
cos_start = nstart
!kuw end

end subroutine cosmo_init


subroutine cosmo_advance(cos_dt)  bind(C,name="cosmo_advance")

use iso_C_binding
use enkf_cosmo_mod
integer(c_int),intent(in) :: cos_dt  
  
!------------------------------------------------------------------------------
!- Section 6: Time stepping
!------------------------------------------------------------------------------

  IF (izdebug > 0) THEN
    PRINT *, '  TIME STEPPING'
  ENDIF

  ! timeloop: DO ntstep = nstart , nstop
  write(*,*)'advancing cosmo from ',cos_start,' to ',(cos_start+cos_dt-1)

  timeloop: DO ntstep = cos_start,(cos_start+cos_dt-1)
    IF ( (izdebug > 1) .AND. (.NOT. lbdclim)) THEN
      PRINT *, '    STEP ',ntstep
    ENDIF

#ifdef COSMOART
! AF Put l_cosmo_art to false if you don't want to calculate the ART part
    IF (l_cosmo_art_nl) THEN
      l_cosmo_art=(l_cosmo_art_nl .AND. ((ntstep*dt/3600.0_wp) >= artstart ))
    ENDIF
#endif

    !--------------------------------------------------------------------------
    !- Section 6.1: Initialization of this time step
    !--------------------------------------------------------------------------

    ! Set nexch_tag dependend on the time step
    nexch_tag = MOD (ntstep, INT(24.0_wp*3600.0_wp/dt))

    IF (l2tls) THEN
      nnow = 3 - nnow
      nnew = 3 - nnew
    ELSE
      nsp    = nold
      nold   = nnow
      nnow   = nnew
      nnew   = nsp
    ENDIF

    CALL initialize_loop (ntstep, nbd1, nbd2, nold, nnow, nnew)

    IF (ltime) CALL get_timings (i_add_computations, ntstep, dt, izerror)

    !--------------------------------------------------------------------------
    !- Section 6.2.1: physics 
    !--------------------------------------------------------------------------

#ifdef COSMOART
    IF (l_cosmo_art) THEN
      CALL organize_cosmo_art ('prepare_physics', ydate_ini, izerror, yzerrmsg)
      IF (izerror /= 0_iintegers) THEN
        CALL model_abort (my_cart_id, 100+izerror, yzerrmsg,               &
                                       'organize_cosmo_art: prepare_physics')
      ENDIF
    ENDIF
#endif

#ifdef POLLEN
    ! Preparations for Pollen
    IF (l_pollen) THEN
      CALL organize_pollen ('prepare_transport', ydate_ini, izerror, yzerrmsg)
      IF (izerror /= 0_iintegers) THEN
        CALL model_abort (my_cart_id, 100+izerror, yzerrmsg,               &
                                       'organize_pollen: prepare_transport')
      ENDIF
    ENDIF
#endif

#ifdef MESSY
    CALL messy_global_start
    CALL messy_local_start
    CALL messy_vdiff
#endif

    IF (lsppt .AND. lphys) THEN
      CALL organize_eps ('compute', izerror, yzerrmsg)
      IF ( izerror /= 0 ) THEN
        CALL model_abort (my_cart_id, 100+izerror, yzerrmsg,               &
                                         'organize_eps: compute')
      END IF
    END IF

    IF (lphys) CALL organize_physics ('compute', izerror, yzerrmsg)
    IF (izerror /= 0_iintegers) THEN
      CALL model_abort (my_cart_id, 100+izerror, yzerrmsg,               &
                                     'organize_physics: compute')
    ENDIF

    IF (ltime) CALL get_timings (i_phy_computations, ntstep, dt, izerror)

    !--------------------------------------------------------------------------
    !- Section 6.2.1a: After the call to the soil model, add extra
    !  artificial heating rate disturbances on the soil temperature if desired
    !  (formulated as Euler forward updates of the temperatures)
    !--------------------------------------------------------------------------

    IF (lartif_data) THEN
      ! Set possible artificial heating rate disturbance(s) in the soil 
      ! (affects t_so or t_s/t_m/t_cl depending on soil model
      ! and takes effect only IF lsoil=.TRUE.). 
      ! Because the soil model has already done the time integration,
      ! the artificial disturbances have to be imposed on
      ! timelevel nnew:
      CALL artif_heatrate_dist_tso(nnew)
    END IF

#ifdef COSMOART
    IF (l_cosmo_art) THEN
      CALL organize_cosmo_art ('finalize_physics', ydate_ini, izerror, yzerrmsg)
      IF (izerror /= 0_iintegers) THEN
        CALL model_abort (my_cart_id, 100+izerror, yzerrmsg,               &
                                       'organize_cosmo_art: finalize_physics')
      ENDIF
    ENDIF
#endif

!#ifdef POLLEN
!    ! Clean up after Pollen
!    IF (l_pollen) THEN
!      CALL organize_pollen ('finalize_physics', ydate_ini, izerror, yzerrmsg)
!      IF (izerror /= 0_iintegers) THEN
!        CALL model_abort (my_cart_id, 100+izerror, yzerrmsg,               &
!                                       'organize_pollen: finalize_physics')
!      ENDIF
!    ENDIF
!#endif

#ifdef COSMOART
    !--------------------------------------------------------------------------
    !- Section 6.2.2: emissions for COSMO_ART
    !--------------------------------------------------------------------------

    IF (l_cosmo_art) THEN
      CALL organize_cosmo_art ('emiss', ydate_ini, izerror, yzerrmsg)
      IF (izerror /= 0_iintegers) THEN
        CALL model_abort (my_cart_id, 100+izerror, yzerrmsg,               &
                                       'organize_cosmo_art: emiss')
      ENDIF
    ENDIF
#endif

#ifdef POLLEN
    IF (l_pollen) THEN
      CALL organize_pollen ('emiss', ydate_ini, izerror, yzerrmsg)
      IF (izerror /= 0_iintegers) THEN
        CALL model_abort (my_cart_id, 100+izerror, yzerrmsg,               &
                                       'organize_pollen: emiss')
      ENDIF
    ENDIF
#endif

    !--------------------------------------------------------------------------
    !- Section 6.3.1: dynamics
    !--------------------------------------------------------------------------

#ifdef COSMOART
    ! CK 20101204 unit conversion necessary before dynamics
    ! more universal approach: get a general injection point for ART
    IF (l_cosmo_art) THEN
      CALL organize_cosmo_art ('prepare_dynamics', ydate_ini, izerror, yzerrmsg)
      IF (izerror /= 0_iintegers) THEN
        CALL model_abort (my_cart_id, 100+izerror, yzerrmsg,               &
                                       'organize_cosmo_art: prepare_dynamics')
      ENDIF
    ENDIF
#endif

!#ifdef POLLEN
!    ! Preparations for Pollen
!    IF (l_pollen) THEN
!      CALL organize_pollen ('prepare_dynamics', ydate_ini, izerror, yzerrmsg)
!      IF (izerror /= 0_iintegers) THEN
!        CALL model_abort (my_cart_id, 100+izerror, yzerrmsg,               &
!                                       'organize_pollen: prepare_dynamics')
!      ENDIF
!    ENDIF
!#endif

#ifdef MESSY
    ! must be called here and not later than organize_dynamics
    ! (otherwise tendencies must be applied "by-hand"
    CALL messy_physc
    CALL messy_local_end
    CALL messy_global_end(1)

! moved into organize dynamics
!    CALL main_tracer_beforeadv
! NOTE: IN ORGANIZE DYNAMICS THE "FINAL INTEGRATION" takes place !!!!
#endif

    CALL organize_dynamics ('compute', izerror, yzerrmsg, dt, .FALSE.)
    IF (izerror /= 0_iintegers) THEN
      CALL model_abort (my_cart_id, 100+izerror, yzerrmsg,               &
                                    'organize_dynamics: compute')
    ENDIF

#ifdef COSMOART
    ! CK 20101204 unit conversion necessary after dynamics
    ! more universal approach: get a general injection point for ART
    IF (l_cosmo_art) THEN
      CALL organize_cosmo_art ('finalize_dynamics', ydate_ini, izerror, yzerrmsg)
      IF (izerror /= 0_iintegers) THEN
        CALL model_abort (my_cart_id, 100+izerror, yzerrmsg,               &
                                       'organize_cosmo_art: finalize_dynamics')
      ENDIF
    ENDIF
#endif

#ifdef POLLEN
    ! Clean up after Pollen and washout
    IF (l_pollen) THEN
      CALL organize_pollen ('washout', ydate_ini, izerror, yzerrmsg)
      IF (izerror /= 0_iintegers) THEN
        CALL model_abort (my_cart_id, 100+izerror, yzerrmsg,               &
                                       'organize_pollen: washout')
      ENDIF
    ENDIF
#endif

    CALL set_trcr_special_bc

    IF (ltime) CALL get_timings (i_dyn_computations, ntstep, dt, izerror)

#ifdef COSMOART
    !--------------------------------------------------------------------------
    !- Section 6.3a: chemistry and aerosol dynamics, COSMO_ART; Pollen
    !--------------------------------------------------------------------------

    IF (l_cosmo_art) THEN

      IF (laero) THEN
        CALL organize_cosmo_art ('init_aero', ydate_ini,izerror, yzerrmsg)
      ENDIF

      CALL organize_cosmo_art ('compute', ydate_ini, izerror, yzerrmsg)

      IF (izerror /= 0_iintegers) THEN
        CALL model_abort (my_cart_id, 100+izerror, yzerrmsg,               &
                                       'organize_cosmo_art: chemie')
      ENDIF

    ENDIF
#endif

    !--------------------------------------------------------------------------
    !- Section 6.4: nudging
    !--------------------------------------------------------------------------

#ifdef NUDGING
    IF (luseobs) CALL organize_assimilation ('nudge', izerror, yzerrmsg)
    IF (izerror /= 0_iintegers) THEN
      CALL model_abort (my_cart_id, 100+izerror, yzerrmsg,               &
                                    'organize_assimilation: nudge')
    ENDIF

    IF (ltime) CALL get_timings (i_nud_computations, ntstep, dt, izerror)
#endif

    !--------------------------------------------------------------------------
    !- Section 6.4a: latent heat nudging (LHN)
    !--------------------------------------------------------------------------

#ifdef NUDGING
    IF (luseobs) CALL organize_assimilation ('lhn', izerror, yzerrmsg)
    IF (izerror /= 0_iintegers) THEN
      CALL model_abort (my_cart_id, 100+izerror, yzerrmsg,               &
                                    'organize_assimilation: lhn')
    ENDIF

    IF (ltime) CALL get_timings (i_lhn_computations, ntstep, dt, izerror)
#endif

    !--------------------------------------------------------------------------
    !- Section 6.5: water budget
    !--------------------------------------------------------------------------
 
    IF (ldiagnos .AND. (l2tls .OR. (ntstep > 0))) THEN
      ! for the leapfrog scheme the summations in diagbudget must not be done
      ! in the first intermediate step ntstep==0. These calculations are done
      ! again for ntstep==1.
      CALL organize_diagnosis ('diagbudget', izerror, yzerrmsg)
      IF (izerror /= 0_iintegers) THEN
        CALL model_abort (my_cart_id, 100+izerror, yzerrmsg,             &
                                     'organize_diagnosis: diagbudget')
      ENDIF

      IF (ltime) CALL get_timings (i_add_computations, ntstep, dt, izerror)
    ENDIF

    !--------------------------------------------------------------------------
    !- Section 6.6: spectral nudging and relaxation
    !--------------------------------------------------------------------------

    IF (lspecnudge .AND. ((ntstep < 2) .OR. (MOD(ntstep+1,nincsn) == 0))) THEN
      CALL organize_dynamics ('specnudge', izerror, yzerrmsg, dt, .FALSE.)
      IF (izerror /= 0_iintegers) THEN
        CALL model_abort (my_cart_id, 100+izerror, yzerrmsg,               &
                                      'organize_dynamics: specnudge')
      ENDIF
      IF (ltime) CALL get_timings (i_spectr_nudging, ntstep, dt, izerror)
    ENDIF

#ifdef COSMOART
    ! CK 20101204 unit conversion necessary before relaxation
    ! more universal approach: get a general injection point for ART
    IF (l_cosmo_art) THEN
      CALL organize_cosmo_art ('prepare_relaxation', ydate_ini, izerror, yzerrmsg)
      IF (izerror /= 0_iintegers) THEN
        CALL model_abort (my_cart_id, 100+izerror, yzerrmsg,               &
                                       'organize_cosmo_art: prepare_relaxation')
      ENDIF
    ENDIF
#endif

!#ifdef POLLEN
!    ! Preparations for Pollen
!    IF (l_pollen) THEN
!      CALL organize_pollen ('prepare_relaxation', ydate_ini, izerror, yzerrmsg)
!      IF (izerror /= 0_iintegers) THEN
!        CALL model_abort (my_cart_id, 100+izerror, yzerrmsg,               &
!                                       'organize_pollen: prepare_relaxation')
!      ENDIF
!    ENDIF
!#endif

    CALL organize_dynamics ('relaxation', izerror, yzerrmsg, dt, .FALSE.)
    IF (izerror /= 0_iintegers) THEN
      CALL model_abort (my_cart_id, 100+izerror, yzerrmsg,               &
                                    'organize_dynamics: relaxation')
    ENDIF

    IF (ltime) CALL get_timings (i_relaxation, ntstep, dt, izerror)

#ifdef COSMOART
    ! CK 20101204 unit conversion necessary after dynamics
    ! more universal approach: get a general injection point for ART
    IF (l_cosmo_art) THEN
      CALL organize_cosmo_art ('finalize_relaxation', ydate_ini, izerror, yzerrmsg)
      IF (izerror /= 0_iintegers) THEN
        CALL model_abort (my_cart_id, 100+izerror, yzerrmsg,               &
                                       'organize_cosmo_art: finalize_relaxation')
      ENDIF
    ENDIF
#endif

#ifdef POLLEN
    ! Clean up after Pollen
    IF (l_pollen) THEN
      CALL organize_pollen ('finalize_transport', ydate_ini, izerror, yzerrmsg)
      IF (izerror /= 0_iintegers) THEN
        CALL model_abort (my_cart_id, 100+izerror, yzerrmsg,               &
                                       'organize_pollen: finalize_transport')
      ENDIF
    ENDIF
#endif

    ! Final update of temperature and humidity variables due to
    ! cloud microphysics in case of the cloud ice scheme
    IF (lphys) CALL organize_physics ('finish_compute', izerror, yzerrmsg)

    IF (izerror /= 0_iintegers) THEN
      CALL model_abort (my_cart_id, 100+izerror, yzerrmsg,               &
                                     'organize_physics: finish_compute')
    ENDIF

    CALL nullify_tracers

#ifdef COSMOART
    ! CK 20101204 setting minima for tracers
    ! more universal approach: get a general injection point for ART
    IF (l_cosmo_art) THEN
      CALL organize_cosmo_art ('finalize', ydate_ini, izerror, yzerrmsg)
      IF (izerror /= 0_iintegers) THEN
        CALL model_abort (my_cart_id, 100+izerror, yzerrmsg,               &
                                       'organize_cosmo_art: finalize')
      ENDIF
    ENDIF
#endif

    IF (ltime) CALL get_timings (i_phy_computations, ntstep, dt, izerror)

    !--------------------------------------------------------------------------
    !- Section 6.7: Exchange of boundary data
    !--------------------------------------------------------------------------
 
      ! The calls to exchg_boundaries have to be here in any case, even for a
      ! sequential version, because of possible periodic boundary conditions 
      ! the check, which kind of communication is necessary, is done within 
      ! the subroutine now.

      ! Check, whether additional communication for the convection is
      ! necessary
      lzconv = lconv .AND. lconf_avg .AND.                         &
                ((ntstep < 1) .OR. (MOD(ntstep+2,nincconv)==0))

      IF (ltime_barrier) THEN
        CALL comm_barrier (icomm_cart, ierrstat, yzerrmsg)
        IF (ltime) CALL get_timings (i_barrier_waiting_dyn, ntstep, dt, izerror)
      ENDIF

      IF     ( l2tls ) THEN
        CALL exchange_runge_kutta
      ELSE ! Leapfrog:
        CALL exchange_leapfrog
      ENDIF

      IF (ltime) CALL get_timings (i_communications_dyn, ntstep, dt, izerror)

    !--------------------------------------------------------------------------
    !- Section 6.8: diagnostics
    !--------------------------------------------------------------------------

    CALL near_surface (nnow)
    IF (ltime) CALL get_timings (i_add_computations, ntstep, dt, izerror)

    !   Analysis of near surface parameters
    !   -----------------------------------

#ifdef NUDGING
    IF (luseobs) THEN
      CALL organize_assimilation ('surface', izerror, yzerrmsg)
      IF (izerror /= 0_iintegers) THEN
        CALL model_abort (my_cart_id, 100+izerror, yzerrmsg,               &
                                      'organize_assimilation: surface')
      ENDIF
      IF (ltime) CALL get_timings (i_nud_computations, ntstep, dt, izerror)
    ENDIF
#endif

    IF (ldiagnos) THEN
      CALL organize_diagnosis ('compute', izerror, yzerrmsg)
      IF (izerror /= 0_iintegers) THEN
        CALL model_abort (my_cart_id, 100+izerror, yzerrmsg,             &
                                       'organize_diagnosis: compute')
      ENDIF
    ENDIF

#if defined RTTOV7 || defined RTTOV9 || defined RTTOV10
    IF (luse_rttov) THEN
      CALL organize_satellites ('compute', izerror, yzerrmsg)
      IF (izerror /= 0_iintegers) THEN
        CALL model_abort (my_cart_id, 100+izerror, yzerrmsg,             &
                                       'organize_satellites: compute')
      ENDIF
    ENDIF
#endif

    !   Trajectories computation
    !   ------------------------

    IF (ltraj) THEN
      CALL organize_traj('compute',izerror,yzerrmsg)
      IF (izerror /= 0_iintegers) THEN
        CALL model_abort(my_world_id, 100+izerror, yzerrmsg,'organize_traj: compute')
      ENDIF
    ENDIF

    ! put a barrier here to have a clean separation for the timing
    CALL comm_barrier (icomm_cart, ierrstat, yzerrmsg)
    IF (ltime) CALL get_timings (i_add_computations, ntstep, dt, izerror)

#ifdef RADARFWO
    !--------------------------------------------------------------------------
    !- Section 6.8b: radar forward operator and optionally preparing 
    !                of radar feedback files for radar data assimilation
    !                (the latter needs radar observation files)
    !--------------------------------------------------------------------------

    IF (luse_radarfwo) THEN

      CALL organize_radar ('compute', nnow)

      IF (ltime) CALL get_timings (i_radarsim, ntstep, dt, izerror)

    END IF
#endif

    !--------------------------------------------------------------------------
    !- Section 6.9: output of results
    !--------------------------------------------------------------------------

#ifdef MESSY
    CALL messy_global_end(2)
    CALL messy_write_output(1)
#endif

#ifdef COSMOART
! AF Put l_cosmo_art back to initial value for output
    IF (l_cosmo_art_nl) THEN
      l_cosmo_art=l_cosmo_art_nl
    ENDIF
#endif 

    CALL organize_data ('result', ntstep, izerror, yzerrmsg)
    IF (izerror /= 0_iintegers) THEN
      CALL model_abort (my_cart_id, 100+izerror, yzerrmsg,               &
                                     'result: input-init')
    ENDIF

#ifdef MESSY
    IF ( (l2tls) .OR.  (.NOT. lstop .AND. .NOT. lbreak) ) &
         CALL messy_write_output(2)
#endif

#ifdef COSMOART
! AF Put l_cosmo_art to false if you don't want to calculate the ART part
    IF (l_cosmo_art_nl) THEN
      l_cosmo_art=(l_cosmo_art_nl .AND. ((ntstep*dt/3600.0_wp) >= artstart ))
    ENDIF

    ! more universal approach: get a general injection point for ART
    IF (l_cosmo_art) THEN
      CALL organize_cosmo_art ('endoftimestep', ydate_ini, izerror, yzerrmsg)
      IF (izerror /= 0_iintegers) THEN
        CALL model_abort (my_cart_id, 100+izerror, yzerrmsg,               &
                                       'organize_cosmo_art: endoftimestep')
      ENDIF
    ENDIF
#endif

    IF (ltime) CALL get_timings (i_output, ntstep, dt, izerror)

    !--------------------------------------------------------------------------
    !- Section 6.10: Finalization of this time step
    !--------------------------------------------------------------------------
 
#if defined RTTOV7 || defined RTTOV9 || defined RTTOV10
    ! deallocate the satellite variables
    IF (luse_rttov) THEN
      CALL organize_satellites ('dealloc', izerror, yzerrmsg)
      IF (izerror /= 0_iintegers) THEN
        CALL model_abort (my_cart_id, 100+izerror, yzerrmsg,             &
                                       'organize_satellites: dealloc')
      ENDIF
    ENDIF
#endif

    IF (lbdclim) THEN
      ! record a forecast day
      IF (my_cart_id ==  0) THEN
        zforecasttime = zforecasttime + dt
        IF (zforecasttime >= 86400.0_wp) THEN
          nzdays  = NINT ((ntstep+1)*dt) / 86400
          WRITE (ynote(29:34),'(I6.6)') nzdays
          PRINT *, ynote
          zforecasttime = zforecasttime - 86400.0_wp
        ENDIF
      ENDIF
    ELSE
      ! record a forecast hour
      IF (my_cart_id ==  0) THEN
        zforecasttime = zforecasttime + dt
        IF (zforecasttime >= 3600.0_wp) THEN
          nzhours = NINT ((ntstep+1)*dt) / 3600
          WRITE (ynote(29:31),'(I3.3)') nzhours
          PRINT *, ynote
          zforecasttime = zforecasttime - 3600.0_wp
        ENDIF
      ENDIF
    ENDIF

    ! Reset the time step for leapfrog integration
    IF ( ntstep == 0 .AND. (.NOT.l2tls) ) THEN
      dt = 2.0_wp * dt
    ENDIF

#if defined COUP_OAS
! OASIS4 only
!    CALL oas_cos_update_time(ntstep+1)
#endif

#ifdef MESSY
    IF (lbreak .OR. lstop) EXIT
    CALL messy_timer_reset_time
#endif

  ENDDO timeloop

#ifdef COSMOART
! AF Put l_cosmo_art back to initial value for final clean-up
  IF (l_cosmo_art_nl) THEN
    l_cosmo_art=l_cosmo_art_nl
  ENDIF
#endif

  IF (izdebug > 0) THEN
    ! PRINT *, 'END OF TIME STEPPING'
    write(*,*) 'advancing cosmo finished'
  ENDIF


  cos_start = cos_start + cos_dt
end subroutine cosmo_advance

subroutine cosmo_finalize() bind(C,name="cosmo_finalize")

use iso_C_binding
use enkf_cosmo_mod

  
!------------------------------------------------------------------------------
!- Section 7: Final clean up
!------------------------------------------------------------------------------

  IF (izdebug > 0) THEN
    PRINT *, 'CLEAN UP'
  ENDIF

#ifdef MESSY
  CALL messy_free_memory
#endif

  CALL organize_allocation ('dealloc', ierrstat)

  CALL organize_dynamics   ('cleanup', izerror, yzerrmsg, dt, .FALSE.)

  IF (ldiagnos) THEN
    CALL organize_diagnosis ('dealloc', izerror, yzerrmsg)
    IF (izerror /= 0_iintegers) THEN
      CALL model_abort (my_cart_id, 100+izerror, yzerrmsg,             &
                                     'organize_diagnosis: dealloc')
    ENDIF
  ENDIF

  ! Deallocate tracers and metadata
  DEALLOCATE ( izlbc    )
  DEALLOCATE ( izclp    )
  DEALLOCATE ( izbd_forced )

  CALL trcr_cleanup(izerror)
  IF ( izerror /= 0_iintegers ) THEN
    yzerrmsg = trcr_errorstr(izerror)
    CALL model_abort(my_cart_id, izerror, yzerrmsg, 'trcr_cleanup:')
  ENDIF

  ! Block physics cleanup
  CALL block_fields_cleanup(izerror)

#if defined RTTOV7 || defined RTTOV9 || defined RTTOV10
  IF (luse_rttov) THEN
    CALL organize_satellites ('cleanup', izerror, yzerrmsg)
    IF (izerror /= 0_iintegers) THEN
       CALL model_abort (my_cart_id, 100+izerror, yzerrmsg,             &
          'organize_satellites: cleanup')
    ENDIF
  ENDIF
#endif

#ifdef COSMOART
  IF (l_cosmo_art) THEN
    CALL organize_cosmo_art ('deallocate', ydate_ini, izerror, yzerrmsg)

    IF (izerror /= 0) THEN
      ierrstat = 1005
      yzerrmsg  = ' ERROR    *** Deallocation of space for COSMO_ART failed ***'
      CALL model_abort (my_cart_id, ierrstat, yzerrmsg,             &
                                    'organize_cosmo_art: deallocate')
    ENDIF
  ENDIF
#endif

#ifdef POLLEN
  IF (l_pollen) THEN
    CALL organize_pollen ('deallocate', ydate_ini, izerror, yzerrmsg)

    IF (izerror /= 0) THEN
      ierrstat = 1005
      yzerrmsg  = ' ERROR    *** Deallocation of space for Pollen failed ***'
      CALL model_abort (my_cart_id, ierrstat, yzerrmsg,             &
                                    'organize_pollen: deallocate')
    ENDIF
  ENDIF
#endif

  IF (ltraj) THEN
    CALL organize_traj('finalize', izerror, yzerrmsg)
    IF (izerror /= 0_iintegers) THEN
      CALL model_abort(my_world_id, 100+izerror, yzerrmsg,'organize_traj: finalize')
    ENDIF
  ENDIF

  IF (ltime) THEN
    CALL get_timings (i_cleanup, nstop, dt, izerror)
  ENDIF

#ifdef NETCDF
  IF ( nc_asyn_io > 0 .AND. lasync_io ) THEN
    CALL shutdown_netcdfio_sendbuffers()
    IF (ltime) THEN
      CALL get_timings (i_asynio_wait, ntstep, dt, izerror)
    ENDIF
  ENDIF
#endif

  IF (ltime) THEN
    CALL collect_timings
  ENDIF

  IF ( (lasync_io .OR. (num_compute > 1)) .AND. (nc_asyn_io < 1) ) THEN
    CALL mpe_io_shutdown(izerror)
  ENDIF

!------------------------------------------------------------------------------
!- Section 8: Part of the IO-PEs
!------------------------------------------------------------------------------

! ELSE comp_pe

!   IF( nc_asyn_io > 0 ) THEN
! #ifdef NETCDF
!     CALL start_ionode( yzerrmsg, izerror)
!     IF( izerror /= 0 ) THEN
!       CALL model_abort(my_cart_id, izerror, yzerrmsg,  &
!               'start_ionode')
!     ENDIF
!     CALL shutdown_io()
! #endif
!   ELSE
!    CALL mpe_io_node(izerror)
!    IF (izerror /= 0) THEN
!      ierrstat = 1015
!      yzerrmsg  = ' ERROR    *** Running the asynchronous I/O failed ***'
!      CALL model_abort (my_cart_id, ierrstat, yzerrmsg, 'start mpe_io_node')
!    ENDIF
!  ENDIF

! ENDIF comp_pe

!------------------------------------------------------------------------------
!- Section 9: Final MPI-cleanup
!------------------------------------------------------------------------------

#ifdef MESSY
   IF (lstop) THEN
    ! WRITE file 'END' to break rerun chain
    CALL messy_blather_endfile_bi('Simulation finished.', ' ')
  ELSE
    CALL info_bi('Simulation stopped.', ' ')
    ! Notes:
    !    - simulation is stopped (lbreak) and a rerun is started
    !      (continue rerun chain)
  END IF
#endif

  CALL final_environment (ierrstat, yzerrmsg)

!------------------------------------------------------------------------------
!- End of the main program
!------------------------------------------------------------------------------

end subroutine cosmo_finalize