diff --git a/src/adv_adv_above_pbl.f90 b/src/adv_adv_above_pbl.f90
new file mode 100644
index 0000000000000000000000000000000000000000..24b38829ea3a00d33b437b25f2faaa1dc1ad348e
--- /dev/null
+++ b/src/adv_adv_above_pbl.f90
@@ -0,0 +1,118 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine adv_above_pbl(itime,itimec,dxsave,dysave,ux,vy,tropop,nrand,ipart)
+
+  implicit none
+  integer, intent(in) ::          &
+    itime,                        & ! time index
+    ipart                           ! particle index
+  integer, intent(inout) ::       &
+    itimec,                       & ! next timestep
+    nrand                           ! random number used for turbulence
+  real, intent(in) ::             &
+    tropop                          ! height of troposphere
+  real, intent(inout) ::          &
+    ux,vy,                        & ! random turbulent velocities above PBL
+    dxsave,dysave                   ! accumulated displacement in long and lat
+  real ::                         &
+    dt,                           & ! real(ldt)
+    xts,yts,zts,ztseta,           & ! local 'real' copy of the particle position
+    weta_settling,                & ! settling velocity in eta coordinates
+    wp                              ! random turbulence velocities
+  integer ::                      &
+    insp,nsp                        ! loop variables for number of species
+
+  zts=real(part(ipart)%z)
+  ztseta=real(part(ipart)%zeta)
+  xts=real(part(ipart)%xlon)
+  yts=real(part(ipart)%ylat)
+  if (lsettling) part(ipart)%settling=0.
+
+  call interpol_wind(itime,xts,yts,zts,ztseta,ipart)
+
+  ! Compute everything for above the PBL
+
+  ! Assume constant, uncorrelated, turbulent perturbations
+  ! In the stratosphere, use a small vertical diffusivity d_strat,
+  ! in the troposphere, use a larger horizontal diffusivity d_trop.
+  ! Turbulent velocity scales are determined based on sqrt(d_trop/dt)
+  !******************************************************************
+
+  part(ipart)%idt=abs(lsynctime-itimec+itime)
+  dt=real(part(ipart)%idt)
+
+  if (.not.turboff) then
+    call turb_stratosph(dt,nrand,ux,vy,wp,tropop,zts)
+  else
+    !sec switch off turbulence
+    ux=0.0
+    vy=0.0
+    wp=0.0
+  endif
+
+  ! If particle represents only a single species, add gravitational settling
+  ! velocity. The settling velocity is zero for gases
+  !*************************************************************************
+  ! Does not work in eta coordinates yet
+  if (mdomainfill.eq.0) then
+    if (lsettling) then
+      if ((ipin.ne.3).and.(ipin.ne.4)) then
+        do insp=1,nspec
+          nsp=insp
+          if (xmass(part(ipart)%npoint,nsp).gt.eps3) exit
+        end do
+      else
+        nsp=1
+      endif
+      ! LB change to eta coords?
+      if (density(nsp).gt.0.) then
+        call get_settling(itime,xts,yts,zts,nsp,part(ipart)%settling)
+        select case (wind_coord_type)
+          case ('ETA')
+            call update_zeta_to_z(itime,ipart)
+            call w_to_weta(itime,dt,part(ipart)%xlon,part(ipart)%ylat, &
+              part(ipart)%z,part(ipart)%zeta,part(ipart)%settling,weta_settling)
+            weta=weta+weta_settling
+          case ('METER')
+            w=w+part(ipart)%settling
+          case default
+            w=w+part(ipart)%settling
+        end select
+      end if
+    endif
+  end if
+
+  ! Calculate position at time step itime+lsynctime
+  !************************************************
+  dxsave=dxsave+(u+ux)*dt
+  dysave=dysave+(v+vy)*dt
+
+  select case (wind_coord_type)
+
+    case ('ETA')
+
+      if (wp.ne.0.) then
+        call update_zeta_to_z(itime,ipart)
+        call update_z(ipart,wp*dt*real(ldirect))
+        if (part(ipart)%z.lt.0.) call set_z(ipart,min(h-eps2,-1.*part(ipart)%z))
+          ! if particle below ground -> reflection
+        call update_z_to_zeta(itime,ipart)
+      endif
+      call update_zeta(ipart,weta*dt*real(ldirect))
+      if (part(ipart)%zeta.ge.1.) call set_zeta(ipart,1.-(part(ipart)%zeta-1.))
+      if (part(ipart)%zeta.eq.1.) call update_zeta(ipart,-eps_eta)
+
+    case ('METER')
+
+      call update_z(ipart,(w+wp)*dt*real(ldirect))
+      if (part(ipart)%z.lt.0.) call set_z(ipart,min(h-eps2,-1.*part(ipart)%z))
+
+    case default
+
+      call update_z(ipart,(w+wp)*dt*real(ldirect))
+      if (part(ipart)%z.lt.0.) call set_z(ipart,min(h-eps2,-1.*part(ipart)%z))
+
+  end select
+
+end subroutine adv_above_pbl
diff --git a/src/adv_adv_in_pbl.f90 b/src/adv_adv_in_pbl.f90
new file mode 100644
index 0000000000000000000000000000000000000000..c30bdd059a3abaa345b728492424cd24e28962b4
--- /dev/null
+++ b/src/adv_adv_in_pbl.f90
@@ -0,0 +1,204 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine adv_in_pbl(itime,itimec, dxsave,dysave,dawsave,dcwsave, abovePBL,  &
+  nrand,ipart,thread)
+
+  use drydepo_mod, only: drydepo_probability
+
+  implicit none
+
+  logical, intent(inout) ::       &
+    abovePBL
+  ! flag will be set to 'true' if computation needs to be completed above PBL
+  integer, intent(in) ::          &
+    itime,                        & ! time index
+    ipart,                        & ! particle index
+    thread                          ! number of the omp thread
+  real, intent(inout) ::          &
+    dxsave,dysave,                & ! accumulated displacement in long and lat
+    dawsave,dcwsave               ! accumulated displacement in wind directions
+  integer, intent(inout) ::       &
+    itimec,                       & ! next timestep
+    nrand                           ! random number used for turbulence
+  real ::                         &
+    dt,                           & ! real(ldt)
+    xts,yts,zts,ztseta,           & ! local 'real' copy of the particle position
+    rhoa,                         & ! air density, used in CBL
+    rhograd                     ! vertical gradient of air density, used in CBL
+  integer ::                      &
+    loop,                         & ! loop variable for time in the PBL
+    nsp,insp                        ! loop variable for species
+  real :: vdepo(maxspec)  ! deposition velocities for all species
+
+  eps=nxmax/3.e5
+  if (lsettling) part(ipart)%settling=0.
+
+  ! BEGIN TIME LOOP
+  !================
+  ! For wind_coord_type=ETA:
+  ! Within this loop, only METER coordinates are used, and the new z value will
+  ! be updated to ETA coordinates at the end
+  !****************************************************************************
+
+  call update_zeta_to_z(itime,ipart)
+
+  loop=0
+  pbl_loop: do
+
+    loop=loop+1
+    if (method.eq.1) then
+      part(ipart)%idt=min(part(ipart)%idt,abs(lsynctime-itimec+itime))
+      itimec=itimec+part(ipart)%idt*ldirect
+    else
+      part(ipart)%idt=abs(lsynctime)
+      itimec=itime+lsynctime
+    endif
+    dt=real(part(ipart)%idt)
+    xts=real(part(ipart)%xlon)
+    yts=real(part(ipart)%ylat)
+    zts=real(part(ipart)%z)
+
+    zeta=zts/h
+    if (loop.eq.1) then ! Temporal interpolation only for the first iteration
+
+      if (ngrid.le.0) then
+        xts=real(part(ipart)%xlon)
+        yts=real(part(ipart)%ylat)
+        call interpol_pbl(itime,xts,yts,zts,real(part(ipart)%zeta))
+      else
+        call interpol_pbl(itime,xtn,ytn,zts,real(part(ipart)%zeta))
+      endif
+
+    else
+
+      ! Determine the level below the current position for u,v,rho
+      !***********************************************************
+      call find_z_level_meters(zts)
+
+      ! If one of the levels necessary is not yet available,
+      ! calculate it
+      !*****************************************************
+      call interpol_pbl_misslev()
+
+    endif
+
+  ! Vertical interpolation of u,v,w,rho and drhodz
+  !***********************************************
+
+  ! Vertical distance to the level below and above current position
+  ! both in terms of (u,v) and (w) fields
+  !****************************************************************
+
+    call interpol_pbl_short(zts,rhoa,rhograd) ! Vertical interpolation
+
+  ! Compute the turbulent disturbances
+  ! Determine the sigmas and the timescales
+  !****************************************
+
+    if (.not.turboff) then
+      call turb_pbl(ipart,nrand,dt,zts,rhoa,rhograd,thread)
+      ! Note: zts and nrand get updated
+
+      ! Determine time step for next integration
+      !*****************************************
+      if (turbswitch) then
+        part(ipart)%idt = int( &
+          min( tlw, &
+               h/max( 2.*abs(part(ipart)%turbvel%w*sigw), 1.e-5 ), &
+               0.5/abs(dsigwdz) &
+             ) *ctl)
+      else
+        part(ipart)%idt = int( &
+          min( tlw, &
+               h/max( 2.*abs(part(ipart)%turbvel%w), 1.e-5) &
+              ) *ctl)
+      endif
+    else
+      part(ipart)%turbvel%u=0.
+      part(ipart)%turbvel%v=0.
+      part(ipart)%turbvel%w=0.
+    endif
+
+    part(ipart)%idt=max(part(ipart)%idt,mintime)
+
+
+  ! If particle represents only a single species, add gravitational settling
+  ! velocity. The settling velocity is zero for gases, or if particle
+  ! represents more than one species
+  !*************************************************************************
+
+    if (mdomainfill.eq.0) then
+      if (lsettling) then
+        if ((ipin.ne.3).and.(ipin.ne.4)) then
+          do insp=1,nspec
+            nsp=insp
+            if (xmass(part(ipart)%npoint,nsp).gt.eps3) exit
+          end do
+        else
+          nsp=1
+        endif
+        if (density(nsp).gt.0.) then
+          call get_settling(itime,xts,yts,zts,nsp,part(ipart)%settling)  !bugfix
+          w=w+part(ipart)%settling
+        end if
+      end if
+    endif
+
+  ! Horizontal displacements during time step dt are small real values compared
+  ! to the position; adding the two, would result in large numerical errors.
+  ! Thus, displacements are accumulated during lsynctime and are added to the
+  ! position at the end
+  !****************************************************************************
+
+    dxsave=dxsave+u*dt
+    dysave=dysave+v*dt
+    dawsave=dawsave+part(ipart)%turbvel%u*dt
+    dcwsave=dcwsave+part(ipart)%turbvel%v*dt
+    ! How can I change the w to w(eta) efficiently?
+
+    select case (wind_coord_type)
+
+      case ('ETA')
+
+        call update_z(ipart,w*dt*real(ldirect))
+        zts=real(part(ipart)%z)
+        ! HSO/AL: Particle managed to go over highest level -> interpolation
+        ! error in goto 700
+        !          alias interpol_wind (division by zero)
+        if (zts.ge.height(nz)) call set_z(ipart,height(nz)-100.*eps)
+         ! Manually for z instead
+
+      case ('METER')
+
+        call update_z(ipart,w*dt*real(ldirect))
+        call pushpartdown(ipart)
+
+    end select
+    zts=real(part(ipart)%z)
+
+    if (zts.gt.h) then
+      call update_z_to_zeta(itime,ipart)
+      if (itimec.ne.itime+lsynctime) abovePBL=.true.
+        ! complete the current interval above PBL
+      return
+    endif
+
+  ! Determine probability of deposition
+  !************************************
+    call drydepo_probability(part(ipart)%prob,dt,zts,vdepo)
+
+    if (zts.lt.0.) call set_z(ipart,min(h-eps2,-1.*part(ipart)%z))
+      ! if particle below ground -> reflection
+
+    if (itimec.eq.(itime+lsynctime)) then
+      ! Convert z position that changed by turbulent motions to eta coords
+      call update_z_to_zeta(itime,ipart)
+      return  ! finished
+    endif
+
+  end do pbl_loop
+
+  call update_z_to_zeta(itime,ipart)
+
+end subroutine adv_in_pbl
diff --git a/src/adv_advance.f90 b/src/adv_advance.f90
new file mode 100644
index 0000000000000000000000000000000000000000..4c3e398e3e022c110576c078d77a3d2445a72ada
--- /dev/null
+++ b/src/adv_advance.f90
@@ -0,0 +1,293 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine advance(itime,ipart,thread)
+
+  !*****************************************************************************
+  !                                                                            *
+  !  Calculation of turbulent particle trajectories utilizing a                *
+  !  zero-acceleration scheme, which is corrected by a numerically more        *
+  !  accurate Petterssen scheme whenever possible.                             *
+  !                                                                            *
+  !  Particle positions are read in, incremented, and returned to the calling  *
+  !  program.                                                                  *
+  !                                                                            *
+  !  In different regions of the atmosphere (PBL vs. free troposphere),        *
+  !  different parameters are needed for advection, parameterizing turbulent   *
+  !  velocities, etc. For efficiency, different interpolation routines have    *
+  !  been written for these different cases, with the disadvantage that there  *
+  !  exist several routines doing almost the same. They all share the          *
+  !  included file 'interpol_mod'. The following                               *
+  !  interpolation routines are used:                                          *
+  !                                                                            *
+  !  interpol_all(_nest)     interpolates everything (called inside the PBL)  *
+  !  interpol_misslev(_nest) if a particle moves vertically in the PBL,       *
+  !                           additional parameters are interpolated if it     *
+  !                           crosses a model level                            *
+  !  interpol_wind(_nest)    interpolates the wind and determines the         *
+  !                           standard deviation of the wind (called outside   *
+  !                           PBL) also interpolates potential vorticity       *
+  !  interpol_wind_short(_nest) only interpolates the wind (needed for the    *
+  !                           Petterssen scheme)                               *
+  !  interpol_vdep(_nest)    interpolates deposition velocities               *
+  !                                                                            *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     16 December 1997                                                       *
+  !                                                                            *
+  !  Changes:                                                                  *
+  !                                                                            *
+  !  8 April 2000: Deep convection parameterization                            *
+  !                                                                            *
+  !  May 2002: Petterssen scheme introduced                                    *
+  !                                                                            *
+  !  2021, L. Bakels:                                                          *
+  !         - Separated PBL and above PBL computations in different            *
+  !           subroutines                                                      *
+  !         - Moved all turbulence computations to turbulence_mod.f90          *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! icbt               1 if particle not transferred to forbidden state,       *
+  !                    else -1                                                 *
+  ! dawsave            accumulated displacement in along-wind direction        *
+  ! dcwsave            accumulated displacement in cross-wind direction        *
+  ! dxsave             accumulated displacement in longitude                   *
+  ! dysave             accumulated displacement in latitude                    *
+  ! h [m]              Mixing height                                           *
+  ! lwindinterv [s]    time interval between two wind fields                   *
+  ! itime [s]          time at which this subroutine is entered                *
+  ! itimec [s]         actual time, which is incremented in this subroutine    *
+  ! href [m]           height for which dry deposition velocity is calculated  *
+  ! ladvance [s]       Total integration time period                           *
+  ! ldirect            1 forward, -1 backward                                  *
+  ! ldt [s]            Time step for the next integration                      *
+  ! lsynctime [s]      Synchronisation interval of FLEXPART                    *
+  ! ngrid              index which grid is to be used                          *
+  ! nrand              index for a variable to be picked from rannumb          *
+  ! nstop              if > 1 particle has left domain and must be stopped     *
+  ! prob               probability of absorption due to dry deposition         *
+  ! rannumb(maxrand)   normally distributed random variables                   *
+  ! rhoa               air density                                             *
+  ! rhograd            vertical gradient of the air density                    *
+  ! up,vp,wp           random velocities due to turbulence (along wind, cross  *
+  !                    wind, vertical wind                                     *
+  ! usig,vsig,wsig     mesoscale wind fluctuations                             *
+  ! xt,yt,zt           Particle position                                       *
+  !                                                                            *
+  !*****************************************************************************
+
+  ! openmp change
+  use omp_lib, only: OMP_GET_THREAD_NUM
+  ! openmp change end
+
+  implicit none
+  integer, intent(in) ::          &
+    itime,                        & ! time index
+    ipart,                        & ! particle index
+    thread                          ! OMP thread
+  integer ::                      &
+    itimec,                       &
+    i,j,k,                        & ! loop variables
+    nrand,                        & ! random number used for turbulence
+    memindnext,                   & ! seems useless
+    ngr,                          & ! temporary new grid index of moved particle
+    nsp                             ! loop variables for number of species
+  real ::                         &
+    ux,vy,                        & ! random turbulent velocities above PBL
+    weta_settling,                & ! Settling velocity in eta coordinates
+    tropop,                       & ! height of troposphere
+    dxsave,dysave,                & ! accumulated displacement in long and lat
+    dawsave,dcwsave                ! accumulated displacement in wind directions
+  logical ::                      &
+    abovePBL
+    ! flag will be set to 'true' if computation needs to be completed above PBL
+
+  eps=nxmax/3.e5
+
+  part(ipart)%nstop=.false.
+  do i=1,nmixz
+    indzindicator(i)=.true.
+  end do
+
+  if (DRYDEP) then    ! reset probability for deposition
+    depoindicator=.true.
+    part(ipart)%prob=0.
+  endif
+
+  if (lsettling) part(ipart)%settling=0.
+
+  !if (ipart.eq.1) write(*,*) 'Mass: ', part(ipart)%mass(:), itime
+  dxsave=0.           ! reset position displacements
+  dysave=0.           ! due to mean wind
+  dawsave=0.          ! and turbulent wind
+  dcwsave=0.
+
+  itimec=itime
+
+  nrand=int(ran3(iseed1(thread),thread)*real(maxrand-1))+1
+
+  ! Determine whether lat/long grid or polarstereographic projection
+  ! is to be used
+  ! Furthermore, determine which nesting level to be used
+  !*****************************************************************
+  call find_ngrid(part(ipart)%xlon,part(ipart)%ylat)
+
+  !***************************
+  ! Interpolate necessary data
+  !***************************
+
+  if (abs(itime-memtime(1)).lt.abs(itime-memtime(2))) then
+    memindnext=1
+  else
+    memindnext=2
+  endif
+
+  ! Convert z(eta) to z(m) for the turbulence scheme, w(m/s)
+  ! is computed in verttransform_ecmwf.f90
+
+  call update_zeta_to_z(itime,ipart)
+
+  ! Determine nested grid coordinates
+  ! Determine the lower left corner and its distance to the current position
+  ! Calculate variables for time interpolation
+  !*******************************************
+  call init_interpol(itime, &
+    real(part(ipart)%xlon),real(part(ipart)%ylat),&
+    real(part(ipart)%z),   real(part(ipart)%zeta))
+
+  ! Compute maximum mixing height around particle position
+  !*******************************************************
+
+  ! Compute height of troposphere and PBL at x-y location of particle
+  call interpol_htropo_hmix(tropop,h)
+  zeta=real(part(ipart)%z)/h
+
+  !*************************************************************
+  ! If particle is in the PBL, interpolate once and then make a
+  ! time loop until end of interval is reached
+  !*************************************************************
+  ! In the PBL we use meters instead of eta coordinates for vertical transport
+
+  abovePBL=.true.
+  if (zeta.le.1.) then
+
+    abovePBL=.false.
+    call adv_in_pbl(itime,itimec,&
+      dxsave,dysave,dawsave,dcwsave,abovePBL,nrand,ipart,thread)
+    if (wind_coord_type.eq.'ETA' .and. lsettling) then
+      call w_to_weta(itime,real(part(ipart)%idt),part(ipart)%xlon, &
+        part(ipart)%ylat,part(ipart)%z,part(ipart)%zeta, &
+        part(ipart)%settling,weta_settling)
+      weta=weta+weta_settling
+    endif
+
+  endif
+
+  !**********************************************************
+  ! For all particles that are outside the PBL, make a single
+  ! time step. Only horizontal turbulent disturbances are
+  ! calculated. Vertical disturbances are reset.
+  !**********************************************************
+
+  ! Interpolate the wind
+  !*********************
+
+  if (abovePBL) call adv_above_pbl(itime,itimec,dxsave,dysave, &
+    ux,vy,tropop,nrand,ipart)
+    ! Above PBL computation
+
+  !****************************************************************
+  ! Add mesoscale random disturbances
+  ! This is done only once for the whole lsynctime interval to save
+  ! computation time
+  !****************************************************************
+
+  ! Mesoscale wind velocity fluctuations are obtained by scaling
+  ! with the standard deviation of the grid-scale winds surrounding
+  ! the particle location, multiplied by a factor fturbmeso.
+  ! The autocorrelation time constant is taken as half the
+  ! time interval between wind fields
+  !****************************************************************
+
+  if (.not. turboff) then
+    ! mesoscale turbulence is found to give issues, so turned off
+    if (lmesoscale_turb) then
+      call interpol_mesoscale(itime, &
+        real(part(ipart)%xlon),real(part(ipart)%ylat), &
+        real(part(ipart)%z),real(part(ipart)%zeta))
+      call turb_mesoscale(nrand,dxsave,dysave,ipart, &
+        usig,vsig,wsig,wsigeta,eps_eta)
+    endif
+
+    !*************************************************************
+    ! Transform along and cross wind components to xy coordinates,
+    ! add them to u and v, transform u,v to grid units/second
+    ! and calculate new position
+    !*************************************************************
+
+    call windalign(dxsave,dysave,dawsave,dcwsave,ux,vy)
+    dxsave=dxsave+ux
+     ! comment by MC: comment this line to stop particles horizontally for tests
+    dysave=dysave+vy
+  endif
+
+  call update_xy(dxsave,dysave,ipart)
+  if (part(ipart)%nstop) return
+
+  ! If particle above highest model level, set it back into the domain
+  !*******************************************************************
+  call pushpartdown(ipart)
+
+  !************************************************************************
+  ! Now we could finish, as this was done in FLEXPART versions up to 4.0.
+  ! However, truncation errors of the advection can be significantly
+  ! reduced by doing one iteration of the Petterssen scheme, if this is
+  ! possible.
+  ! Note that this is applied only to the grid-scale winds, not to
+  ! the turbulent winds.
+  !************************************************************************
+
+  ! The Petterssen scheme can only applied with long time steps (only then u
+  ! is the "old" wind as required by the scheme); otherwise do nothing
+  !*************************************************************************
+
+  if (part(ipart)%idt .ne. abs(lsynctime)) return
+
+ ! The Petterssen scheme can only be applied if the ending time of the time step
+ ! (itime+ldt*ldirect) is still between the two wind fields held in memory;
+ ! otherwise do nothing
+ !******************************************************************************
+
+  if (abs(itime+part(ipart)%idt*ldirect).gt.abs(memtime(2))) return
+
+  ! Apply it also only if starting and ending point of current time step are on
+  ! the same grid; otherwise do nothing
+  !*****************************************************************************
+  ! ngr = ngrid
+  ! call find_ngrid(part(ipart)%xlon,part(ipart)%ylat)
+
+  if (nglobal .and. real(part(ipart)%ylat).gt.switchnorthg) then
+    ngr=-1
+  else if (sglobal.and. real(part(ipart)%ylat).lt.switchsouthg) then
+    ngr=-2
+  else
+    ngr=0
+    ! Temporary fix for nested layer edges: replaced eps with dxn and dyn (LB)
+    do j=numbnests,1,-1
+      if (real(part(ipart)%xlon).gt.xln(j)+dxn(j) .and. &
+          real(part(ipart)%xlon).lt.xrn(j)-dxn(j) .and. &
+          real(part(ipart)%ylat).gt.yln(j)+dyn(j) .and. &
+          real(part(ipart)%ylat).lt.yrn(j)-dyn(j)) then
+        ngr=j
+        exit
+      endif
+    end do
+  endif
+
+  if (ngr.ne.ngrid) return
+
+  call petterson_corr(itime,ipart)
+
+end subroutine advance
diff --git a/src/adv_petterson_corr.f90 b/src/adv_petterson_corr.f90
new file mode 100644
index 0000000000000000000000000000000000000000..b1c11a0fd31104142d840578ff034ab7619c9cf2
--- /dev/null
+++ b/src/adv_petterson_corr.f90
@@ -0,0 +1,131 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine petterson_corr(itime,ipart)
+
+  implicit none
+
+  integer, intent(in) ::          &
+    itime,                        & ! time index
+    ipart                           ! particle index
+  integer ::                      &
+    nsp,insp                        ! loop variables for number of species
+  real ::                         &
+    xts,yts,zts,ztseta,           & ! local 'real' copy of the particle position
+    uold,vold,wold,woldeta,       &
+    weta_settling
+  real(kind=dp) ::                &
+    ztemp                           ! temporarily storing z position
+
+
+  xts=real(part(ipart)%xlon)
+  yts=real(part(ipart)%ylat)
+  zts=real(part(ipart)%z)
+  ztseta=real(part(ipart)%zeta)
+  if (lsettling) part(ipart)%settling=0.
+
+  ! Memorize the old wind
+  !**********************
+
+  uold=u
+  vold=v
+
+  select case (wind_coord_type)
+    case ('ETA')
+      woldeta=weta
+    case ('METER')
+      wold=w
+    case default
+      wold=w
+  end select
+
+  ! Interpolate wind at new position and time
+  !******************************************
+  call interpol_wind_short(itime+part(ipart)%idt*ldirect,xts,yts,zts,ztseta)
+
+  if (mdomainfill.eq.0) then
+    if (lsettling) then
+      if ((ipin.ne.3).and.(ipin.ne.4)) then
+        do insp=1,nspec
+          nsp=insp
+          if (xmass(part(ipart)%npoint,nsp).gt.eps3) exit
+        end do
+      else
+        nsp=1
+      endif
+      if (density(nsp).gt.0.) then
+        select case (wind_coord_type)
+
+          case ('ETA')
+
+            call update_zeta_to_z(itime+part(ipart)%idt,ipart)
+            call update_z_to_zeta(itime+part(ipart)%idt,ipart)
+            zts=real(part(ipart)%z)
+            call get_settling( &
+             itime+part(ipart)%idt,xts,yts,zts,nsp,part(ipart)%settling) !bugfix
+            call w_to_weta( &
+              itime+part(ipart)%idt, real(part(ipart)%idt), part(ipart)%xlon, &
+              part(ipart)%ylat, part(ipart)%z, part(ipart)%zeta, &
+              part(ipart)%settling, weta_settling)
+            weta=weta+weta_settling
+           !woldeta=
+     !real(part(ipart)%zeta-part(ipart)%zeta_prev)/real(part(ipart)%idt*ldirect)
+
+          case ('METER')
+
+            call get_settling( &
+              itime+part(ipart)%idt,xts,yts,zts,nsp,part(ipart)%settling)
+            w=w+part(ipart)%settling
+
+          case default
+
+            call get_settling( &
+              itime+part(ipart)%idt,xts,yts,zts,nsp,part(ipart)%settling)
+            w=w+part(ipart)%settling
+
+        end select
+      end if
+    endif
+  end if
+
+  ! Determine the difference vector between new and old wind
+  ! (use half of it to correct position according to Petterssen)
+  !*************************************************************
+
+  u=(u-uold)*0.5
+  v=(v-vold)*0.5
+
+  select case (wind_coord_type)
+
+    case ('ETA')
+
+      weta=(weta-woldeta)/2.
+      call update_zeta(ipart,weta*real(part(ipart)%idt*ldirect))
+      if (part(ipart)%zeta.ge.1.) call set_zeta(ipart,1.-(part(ipart)%zeta-1.))
+      if (part(ipart)%zeta.eq.1.) call update_zeta(ipart,-eps_eta)
+
+    case ('METER')
+
+      w=(w-wold)/2.
+      call update_z(ipart,w*real(part(ipart)%idt*ldirect))
+      if (part(ipart)%z.lt.0.) call set_z(ipart,min(h-eps2,-1.*part(ipart)%z))          ! if particle below ground -> reflection
+
+    case default
+
+      w=(w-wold)/2.
+      call update_z(ipart,w*real(part(ipart)%idt*ldirect))
+      if (part(ipart)%z.lt.0.) call set_z(ipart,min(h-eps2,-1.*part(ipart)%z))
+
+  end select
+
+  ! Finally, correct the old position
+  !**********************************
+
+  call update_xy(u*part(ipart)%idt,v*part(ipart)%idt,ipart)
+
+  ! If particle above highest model level, set it back into the domain
+  !*******************************************************************
+
+  call pushpartdown(ipart)
+
+end subroutine petterson_corr
diff --git a/src/adv_pushpartdown.f90 b/src/adv_pushpartdown.f90
new file mode 100644
index 0000000000000000000000000000000000000000..1bb8238675ab17f9bf23891158f7a13121922bcc
--- /dev/null
+++ b/src/adv_pushpartdown.f90
@@ -0,0 +1,32 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine pushpartdown(ipart)
+
+  implicit none
+
+  integer, intent(in) ::          &
+    ipart                           ! particle index
+
+  eps=nxmax/3.e5
+
+  select case (wind_coord_type)
+
+    case ('ETA')
+
+      if (part(ipart)%zeta.le.real(uvheight(nz),kind=dp)) &
+        call set_zeta(ipart,uvheight(nz)+eps_eta)
+
+    case ('METER')
+
+      if (part(ipart)%z.ge.real(height(nz),kind=dp)) &
+        call set_z(ipart,height(nz)-100.*eps)
+
+    case default
+
+      if (part(ipart)%z.ge.real(height(nz),kind=dp)) &
+      call set_z(ipart,height(nz)-100.*eps)
+
+  end select
+
+end subroutine pushpartdown
diff --git a/src/adv_update_xy.f90 b/src/adv_update_xy.f90
new file mode 100644
index 0000000000000000000000000000000000000000..4803d57ca57129334261057f4c7950efff486b88
--- /dev/null
+++ b/src/adv_update_xy.f90
@@ -0,0 +1,97 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine update_xy(xchange,ychange,ipart)
+
+  implicit none
+
+  integer, intent(in) ::          &
+    ipart                           ! particle number
+  real, intent(in) ::             &
+    xchange,ychange                 ! change in position
+  real ::                         &
+    xlon,ylat,xpol,ypol,          & ! temporarily storing new particle positions
+    gridsize,cosfact                ! used to compute new positions of particles
+
+  eps=nxmax/3.e5
+
+  if (ngrid.ge.0) then
+
+    cosfact=dxconst/cos((real(part(ipart)%ylat)*dy+ylat0)*pi180)
+    call update_xlon(ipart,real(xchange*cosfact*real(ldirect),kind=dp))
+    call update_ylat(ipart,real(ychange*dyconst*real(ldirect),kind=dp))
+
+  else if (ngrid.eq.-1) then      ! around north pole
+
+    xlon=xlon0+real(part(ipart)%xlon)*dx !comment by MC: compute old part pos.
+    ylat=ylat0+real(part(ipart)%ylat)*dy
+    call cll2xy(northpolemap,ylat,xlon,xpol,ypol)
+      !convert old particle position in polar stereographic
+    gridsize=1000.*cgszll(northpolemap,ylat,xlon)
+      !calculate size in m of grid element in polar stereographic coordinate
+    xpol=xpol+xchange/gridsize*real(ldirect)
+      !position in grid unit polar stereographic
+    ypol=ypol+ychange/gridsize*real(ldirect)
+    call cxy2ll(northpolemap,xpol,ypol,ylat,xlon)
+      !convert to lat long coordinate
+    call set_xlon(ipart,real((xlon-xlon0)/dx,kind=dp))
+      !convert to grid units in lat long coordinate, comment by mc
+    call set_ylat(ipart,real((ylat-ylat0)/dy,kind=dp))
+
+  else if (ngrid.eq.-2) then    ! around south pole
+
+    xlon=xlon0+real(part(ipart)%xlon)*dx
+    ylat=ylat0+real(part(ipart)%ylat)*dy
+    call cll2xy(southpolemap,ylat,xlon,xpol,ypol)
+    gridsize=1000.*cgszll(southpolemap,ylat,xlon)
+    xpol=xpol+xchange/gridsize*real(ldirect)
+    ypol=ypol+ychange/gridsize*real(ldirect)
+    call cxy2ll(southpolemap,xpol,ypol,ylat,xlon)
+    call set_xlon(ipart,real((xlon-xlon0)/dx,kind=dp))
+    call set_ylat(ipart,real((ylat-ylat0)/dy,kind=dp))
+
+  endif
+
+  ! If global data are available, use cyclic boundary condition
+  !************************************************************
+
+  if (xglobal) then
+    if (part(ipart)%xlon .ge. real(nxmin1, kind=dp)) &
+      call update_xlon(ipart,-real(nxmin1, kind=dp))
+    if (part(ipart)%xlon .lt. 0.) call update_xlon(ipart,real(nxmin1, kind=dp))
+    if (part(ipart)%xlon .le. real(eps, kind=dp)) &
+      call set_xlon(ipart,real(eps, kind=dp))
+    if (abs( part(ipart)%xlon - real(nxmin1, kind=dp)) .le. eps) &
+      call set_xlon(ipart,real(nxmin1-eps,kind=dp))
+  endif
+
+  ! HSO/AL: Prevent particles from disappearing at the pole
+  !******************************************************************
+  if (sglobal .and. part(ipart)%ylat.lt.0. ) then
+    call set_xlon(ipart, &
+      mod( part(ipart)%xlon + real(nxmin1*0.5, kind=dp), real(nxmin1, kind=dp)))
+    call set_ylat(ipart,-part(ipart)%ylat)
+   ! In extremely rare cases, the ylat exceeds the bounds,
+   ! so we set it back into the domain here
+    if ( part(ipart)%ylat.gt.real(nymin1,kind=dp) ) &
+      call set_ylat(ipart, &
+        real(nymin1, kind=dp) - mod( part(ipart)%ylat, real(nymin1, kind=dp)))
+  else if (nglobal .and. part(ipart)%ylat .gt. real(nymin1, kind=dp) ) then
+    call set_xlon(ipart, &
+      mod( part(ipart)%xlon + real(nxmin1*0.5, kind=dp), real(nxmin1, kind=dp)))
+    call set_ylat(ipart,2.*real(nymin1,kind=dp) - part(ipart)%ylat)
+  endif
+
+  ! Check position: If trajectory outside model domain, terminate it
+  !*****************************************************************
+  ! Not necessary to check when using global domain, but some problems in the
+  ! meteo data could cause particles to go crazy.
+  ! if (gdomainfill) return
+
+  if (part(ipart)%xlon.lt.0. .or. part(ipart)%xlon.ge.real(nxmin1,kind=dp) &
+ .or. part(ipart)%ylat.lt.0. .or. part(ipart)%ylat.gt.real(nymin1,kind=dp)) then
+    part(ipart)%nstop=.true.
+    return
+  endif
+
+end subroutine update_xy
diff --git a/src/advance_mod.f90 b/src/advance_mod.f90
index 2cb3a8e9e2c00df906967320c6af04b21d9c221a..cd8300720d542c11bb8a63b13afa15e024ff7272 100644
--- a/src/advance_mod.f90
+++ b/src/advance_mod.f90
@@ -20,7 +20,7 @@ module advance_mod
   use turbulence_mod
   use settling_mod
 
-  implicit none 
+  implicit none
     real, parameter ::              &
       eps2=1.e-9,                   &
       eps3=tiny(1.0),               &
@@ -29,868 +29,17 @@ module advance_mod
       eps
   private :: adv_above_pbl, adv_in_pbl, petterson_corr, update_xy, pushpartdown
 contains
-  
-subroutine advance(itime,ipart,thread)
-
-  !*****************************************************************************
-  !                                                                            *
-  !  Calculation of turbulent particle trajectories utilizing a                *
-  !  zero-acceleration scheme, which is corrected by a numerically more        *
-  !  accurate Petterssen scheme whenever possible.                             *
-  !                                                                            *
-  !  Particle positions are read in, incremented, and returned to the calling  *
-  !  program.                                                                  *
-  !                                                                            *
-  !  In different regions of the atmosphere (PBL vs. free troposphere),        *
-  !  different parameters are needed for advection, parameterizing turbulent   *
-  !  velocities, etc. For efficiency, different interpolation routines have    *
-  !  been written for these different cases, with the disadvantage that there  *
-  !  exist several routines doing almost the same. They all share the          *
-  !  included file 'interpol_mod'. The following                               *
-  !  interpolation routines are used:                                          *
-  !                                                                            *
-  !  interpol_all(_nest)     interpolates everything (called inside the PBL)  *
-  !  interpol_misslev(_nest) if a particle moves vertically in the PBL,       *
-  !                           additional parameters are interpolated if it     *
-  !                           crosses a model level                            *
-  !  interpol_wind(_nest)    interpolates the wind and determines the         *
-  !                           standard deviation of the wind (called outside   *
-  !                           PBL) also interpolates potential vorticity       *
-  !  interpol_wind_short(_nest) only interpolates the wind (needed for the    *
-  !                           Petterssen scheme)                               *
-  !  interpol_vdep(_nest)    interpolates deposition velocities               *
-  !                                                                            *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     16 December 1997                                                       *
-  !                                                                            *
-  !  Changes:                                                                  *
-  !                                                                            *
-  !  8 April 2000: Deep convection parameterization                            *
-  !                                                                            *
-  !  May 2002: Petterssen scheme introduced                                    *
-  !                                                                            *
-  !  2021, L. Bakels:                                                          *
-  !         - Separated PBL and above PBL computations in different            *
-  !           subroutines                                                      *
-  !         - Moved all turbulence computations to turbulence_mod.f90          *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! icbt               1 if particle not transferred to forbidden state,       *
-  !                    else -1                                                 *
-  ! dawsave            accumulated displacement in along-wind direction        *
-  ! dcwsave            accumulated displacement in cross-wind direction        *
-  ! dxsave             accumulated displacement in longitude                   *
-  ! dysave             accumulated displacement in latitude                    *
-  ! h [m]              Mixing height                                           *
-  ! lwindinterv [s]    time interval between two wind fields                   *
-  ! itime [s]          time at which this subroutine is entered                *
-  ! itimec [s]         actual time, which is incremented in this subroutine    *
-  ! href [m]           height for which dry deposition velocity is calculated  *
-  ! ladvance [s]       Total integration time period                           *
-  ! ldirect            1 forward, -1 backward                                  *
-  ! ldt [s]            Time step for the next integration                      *
-  ! lsynctime [s]      Synchronisation interval of FLEXPART                    *
-  ! ngrid              index which grid is to be used                          *
-  ! nrand              index for a variable to be picked from rannumb          *
-  ! nstop              if > 1 particle has left domain and must be stopped     *
-  ! prob               probability of absorption due to dry deposition         *
-  ! rannumb(maxrand)   normally distributed random variables                   *
-  ! rhoa               air density                                             *
-  ! rhograd            vertical gradient of the air density                    *
-  ! up,vp,wp           random velocities due to turbulence (along wind, cross  *
-  !                    wind, vertical wind                                     *
-  ! usig,vsig,wsig     mesoscale wind fluctuations                             *
-  ! xt,yt,zt           Particle position                                       *
-  !                                                                            *
-  !*****************************************************************************
-
-  ! openmp change
-  use omp_lib, only: OMP_GET_THREAD_NUM
-  ! openmp change end
-
-  implicit none
-  integer, intent(in) ::          &
-    itime,                        & ! time index
-    ipart,                        & ! particle index
-    thread                          ! OMP thread
-  integer ::                      &
-    itimec,                       &
-    i,j,k,                        & ! loop variables
-    nrand,                        & ! random number used for turbulence
-    memindnext,                   & ! seems useless
-    ngr,                          & ! temporary new grid index of moved particle
-    nsp                             ! loop variables for number of species
-  real ::                         &
-    ux,vy,                        & ! random turbulent velocities above PBL
-    weta_settling,                & ! Settling velocity in eta coordinates
-    tropop,                       & ! height of troposphere
-    dxsave,dysave,                & ! accumulated displacement in long and lat
-    dawsave,dcwsave                ! accumulated displacement in wind directions
-  logical ::                      &
-    abovePBL 
-    ! flag will be set to 'true' if computation needs to be completed above PBL
-
-  eps=nxmax/3.e5
-
-  part(ipart)%nstop=.false.
-  do i=1,nmixz
-    indzindicator(i)=.true.
-  end do
-  
-  if (DRYDEP) then    ! reset probability for deposition
-    depoindicator=.true.
-    part(ipart)%prob=0.
-  endif
-  
-  if (lsettling) part(ipart)%settling=0.
-
-  !if (ipart.eq.1) write(*,*) 'Mass: ', part(ipart)%mass(:), itime
-  dxsave=0.           ! reset position displacements
-  dysave=0.           ! due to mean wind
-  dawsave=0.          ! and turbulent wind
-  dcwsave=0.
-
-  itimec=itime
-
-  nrand=int(ran3(iseed1(thread),thread)*real(maxrand-1))+1
-
-  ! Determine whether lat/long grid or polarstereographic projection
-  ! is to be used
-  ! Furthermore, determine which nesting level to be used
-  !*****************************************************************
-  call find_ngrid(part(ipart)%xlon,part(ipart)%ylat)
-
-  !***************************
-  ! Interpolate necessary data
-  !***************************
-
-  if (abs(itime-memtime(1)).lt.abs(itime-memtime(2))) then
-    memindnext=1
-  else
-    memindnext=2
-  endif
-
-  ! Convert z(eta) to z(m) for the turbulence scheme, w(m/s) 
-  ! is computed in verttransform_ecmwf.f90
-
-  call update_zeta_to_z(itime,ipart)
-
-  ! Determine nested grid coordinates
-  ! Determine the lower left corner and its distance to the current position
-  ! Calculate variables for time interpolation
-  !*******************************************
-  call init_interpol(itime, &
-    real(part(ipart)%xlon),real(part(ipart)%ylat),&
-    real(part(ipart)%z),   real(part(ipart)%zeta))
-
-  ! Compute maximum mixing height around particle position
-  !*******************************************************
-
-  ! Compute height of troposphere and PBL at x-y location of particle
-  call interpol_htropo_hmix(tropop,h)
-  zeta=real(part(ipart)%z)/h
-
-  !*************************************************************
-  ! If particle is in the PBL, interpolate once and then make a
-  ! time loop until end of interval is reached
-  !*************************************************************
-  ! In the PBL we use meters instead of eta coordinates for vertical transport
-  
-  abovePBL=.true.
-  if (zeta.le.1.) then
-  
-    abovePBL=.false.
-    call adv_in_pbl(itime,itimec,&
-      dxsave,dysave,dawsave,dcwsave,abovePBL,nrand,ipart,thread)
-    if (wind_coord_type.eq.'ETA' .and. lsettling) then
-      call w_to_weta(itime,real(part(ipart)%idt),part(ipart)%xlon, &
-        part(ipart)%ylat,part(ipart)%z,part(ipart)%zeta, &
-        part(ipart)%settling,weta_settling)
-      weta=weta+weta_settling
-    endif
-
-  endif 
-
-  !**********************************************************
-  ! For all particles that are outside the PBL, make a single
-  ! time step. Only horizontal turbulent disturbances are
-  ! calculated. Vertical disturbances are reset.
-  !**********************************************************
-
-  ! Interpolate the wind
-  !*********************
-  
-  if (abovePBL) call adv_above_pbl(itime,itimec,dxsave,dysave, &
-    ux,vy,tropop,nrand,ipart)
-    ! Above PBL computation
-
-  !****************************************************************
-  ! Add mesoscale random disturbances
-  ! This is done only once for the whole lsynctime interval to save
-  ! computation time
-  !****************************************************************
-
-  ! Mesoscale wind velocity fluctuations are obtained by scaling
-  ! with the standard deviation of the grid-scale winds surrounding
-  ! the particle location, multiplied by a factor fturbmeso.
-  ! The autocorrelation time constant is taken as half the
-  ! time interval between wind fields
-  !****************************************************************
-
-  if (.not. turboff) then 
-    ! mesoscale turbulence is found to give issues, so turned off
-    if (lmesoscale_turb) then
-      call interpol_mesoscale(itime, &
-        real(part(ipart)%xlon),real(part(ipart)%ylat), &
-        real(part(ipart)%z),real(part(ipart)%zeta))
-      call turb_mesoscale(nrand,dxsave,dysave,ipart, &
-        usig,vsig,wsig,wsigeta,eps_eta)
-    endif
-
-    !*************************************************************
-    ! Transform along and cross wind components to xy coordinates,
-    ! add them to u and v, transform u,v to grid units/second
-    ! and calculate new position
-    !*************************************************************
-
-    call windalign(dxsave,dysave,dawsave,dcwsave,ux,vy)
-    dxsave=dxsave+ux   
-     ! comment by MC: comment this line to stop particles horizontally for tests
-    dysave=dysave+vy
-  endif
-
-  call update_xy(dxsave,dysave,ipart)
-  if (part(ipart)%nstop) return
-
-  ! If particle above highest model level, set it back into the domain
-  !*******************************************************************
-  call pushpartdown(ipart)
-  
-  !************************************************************************
-  ! Now we could finish, as this was done in FLEXPART versions up to 4.0.
-  ! However, truncation errors of the advection can be significantly
-  ! reduced by doing one iteration of the Petterssen scheme, if this is
-  ! possible.
-  ! Note that this is applied only to the grid-scale winds, not to
-  ! the turbulent winds.
-  !************************************************************************
-
-  ! The Petterssen scheme can only applied with long time steps (only then u
-  ! is the "old" wind as required by the scheme); otherwise do nothing
-  !*************************************************************************
-
-  if (part(ipart)%idt .ne. abs(lsynctime)) return
-
- ! The Petterssen scheme can only be applied if the ending time of the time step
- ! (itime+ldt*ldirect) is still between the two wind fields held in memory;
- ! otherwise do nothing
- !******************************************************************************
-
-  if (abs(itime+part(ipart)%idt*ldirect).gt.abs(memtime(2))) return
-
-  ! Apply it also only if starting and ending point of current time step are on
-  ! the same grid; otherwise do nothing
-  !*****************************************************************************
-  ! ngr = ngrid 
-  ! call find_ngrid(part(ipart)%xlon,part(ipart)%ylat)
-
-  if (nglobal .and. real(part(ipart)%ylat).gt.switchnorthg) then
-    ngr=-1
-  else if (sglobal.and. real(part(ipart)%ylat).lt.switchsouthg) then
-    ngr=-2
-  else
-    ngr=0
-    ! Temporary fix for nested layer edges: replaced eps with dxn and dyn (LB)
-    do j=numbnests,1,-1
-      if (real(part(ipart)%xlon).gt.xln(j)+dxn(j) .and. &
-          real(part(ipart)%xlon).lt.xrn(j)-dxn(j) .and. &
-          real(part(ipart)%ylat).gt.yln(j)+dyn(j) .and. &
-          real(part(ipart)%ylat).lt.yrn(j)-dyn(j)) then
-        ngr=j
-        exit
-      endif
-    end do
-  endif
-
-  if (ngr.ne.ngrid) return
-
-  call petterson_corr(itime,ipart)
-
-end subroutine advance
-
-subroutine adv_above_pbl(itime,itimec,dxsave,dysave,ux,vy,tropop,nrand,ipart)
-
-  implicit none
-  integer, intent(in) ::          &
-    itime,                        & ! time index
-    ipart                           ! particle index
-  integer, intent(inout) ::       &
-    itimec,                       & ! next timestep
-    nrand                           ! random number used for turbulence
-  real, intent(in) ::             &
-    tropop                          ! height of troposphere
-  real, intent(inout) ::          &
-    ux,vy,                        & ! random turbulent velocities above PBL
-    dxsave,dysave                   ! accumulated displacement in long and lat
-  real ::                         &
-    dt,                           & ! real(ldt)
-    xts,yts,zts,ztseta,           & ! local 'real' copy of the particle position
-    weta_settling,                & ! settling velocity in eta coordinates
-    wp                              ! random turbulence velocities
-  integer ::                      &
-    insp,nsp                        ! loop variables for number of species
-
-  zts=real(part(ipart)%z)
-  ztseta=real(part(ipart)%zeta)
-  xts=real(part(ipart)%xlon)
-  yts=real(part(ipart)%ylat)
-  if (lsettling) part(ipart)%settling=0.
-
-  call interpol_wind(itime,xts,yts,zts,ztseta,ipart)
-
-  ! Compute everything for above the PBL
-
-  ! Assume constant, uncorrelated, turbulent perturbations
-  ! In the stratosphere, use a small vertical diffusivity d_strat,
-  ! in the troposphere, use a larger horizontal diffusivity d_trop.
-  ! Turbulent velocity scales are determined based on sqrt(d_trop/dt)
-  !******************************************************************
-
-  part(ipart)%idt=abs(lsynctime-itimec+itime)
-  dt=real(part(ipart)%idt)
-
-  if (.not.turboff) then
-    call turb_stratosph(dt,nrand,ux,vy,wp,tropop,zts)
-  else
-    !sec switch off turbulence
-    ux=0.0
-    vy=0.0
-    wp=0.0
-  endif
-
-  ! If particle represents only a single species, add gravitational settling
-  ! velocity. The settling velocity is zero for gases
-  !*************************************************************************
-  ! Does not work in eta coordinates yet
-  if (mdomainfill.eq.0) then
-    if (lsettling) then
-      if ((ipin.ne.3).and.(ipin.ne.4)) then
-        do insp=1,nspec
-          nsp=insp
-          if (xmass(part(ipart)%npoint,nsp).gt.eps3) exit
-        end do
-      else
-        nsp=1
-      endif
-      ! LB change to eta coords?
-      if (density(nsp).gt.0.) then
-        call get_settling(itime,xts,yts,zts,nsp,part(ipart)%settling)
-        select case (wind_coord_type)
-          case ('ETA')
-            call update_zeta_to_z(itime,ipart)
-            call w_to_weta(itime,dt,part(ipart)%xlon,part(ipart)%ylat, &
-              part(ipart)%z,part(ipart)%zeta,part(ipart)%settling,weta_settling)
-            weta=weta+weta_settling
-          case ('METER')
-            w=w+part(ipart)%settling
-          case default
-            w=w+part(ipart)%settling
-        end select
-      end if
-    endif
-  end if
-
-  ! Calculate position at time step itime+lsynctime
-  !************************************************
-  dxsave=dxsave+(u+ux)*dt
-  dysave=dysave+(v+vy)*dt
- 
-  select case (wind_coord_type)
-
-    case ('ETA')
-
-      if (wp.ne.0.) then
-        call update_zeta_to_z(itime,ipart)
-        call update_z(ipart,wp*dt*real(ldirect))
-        if (part(ipart)%z.lt.0.) call set_z(ipart,min(h-eps2,-1.*part(ipart)%z))
-          ! if particle below ground -> reflection
-        call update_z_to_zeta(itime,ipart)
-      endif
-      call update_zeta(ipart,weta*dt*real(ldirect))
-      if (part(ipart)%zeta.ge.1.) call set_zeta(ipart,1.-(part(ipart)%zeta-1.))
-      if (part(ipart)%zeta.eq.1.) call update_zeta(ipart,-eps_eta)
-
-    case ('METER')
-
-      call update_z(ipart,(w+wp)*dt*real(ldirect))
-      if (part(ipart)%z.lt.0.) call set_z(ipart,min(h-eps2,-1.*part(ipart)%z))
-
-    case default
-
-      call update_z(ipart,(w+wp)*dt*real(ldirect))
-      if (part(ipart)%z.lt.0.) call set_z(ipart,min(h-eps2,-1.*part(ipart)%z))
-
-  end select
-
-end subroutine adv_above_pbl
-
-subroutine adv_in_pbl(itime,itimec, dxsave,dysave,dawsave,dcwsave, abovePBL,  &
-  nrand,ipart,thread)
-
-  use drydepo_mod, only: drydepo_probability
-
-  implicit none
-
-  logical, intent(inout) ::       &
-    abovePBL                      
-  ! flag will be set to 'true' if computation needs to be completed above PBL
-  integer, intent(in) ::          &
-    itime,                        & ! time index
-    ipart,                        & ! particle index
-    thread                          ! number of the omp thread
-  real, intent(inout) ::          &
-    dxsave,dysave,                & ! accumulated displacement in long and lat
-    dawsave,dcwsave               ! accumulated displacement in wind directions
-  integer, intent(inout) ::       &
-    itimec,                       & ! next timestep
-    nrand                           ! random number used for turbulence
-  real ::                         &
-    dt,                           & ! real(ldt)
-    xts,yts,zts,ztseta,           & ! local 'real' copy of the particle position
-    rhoa,                         & ! air density, used in CBL
-    rhograd                     ! vertical gradient of air density, used in CBL
-  integer ::                      &
-    loop,                         & ! loop variable for time in the PBL
-    nsp,insp                        ! loop variable for species
-  real :: vdepo(maxspec)  ! deposition velocities for all species
-
-  eps=nxmax/3.e5
-  if (lsettling) part(ipart)%settling=0.
-
-  ! BEGIN TIME LOOP
-  !================
-  ! For wind_coord_type=ETA:
-  ! Within this loop, only METER coordinates are used, and the new z value will
-  ! be updated to ETA coordinates at the end
-  !****************************************************************************
-  
-  call update_zeta_to_z(itime,ipart)
-
-  loop=0
-  pbl_loop: do
-  
-    loop=loop+1
-    if (method.eq.1) then
-      part(ipart)%idt=min(part(ipart)%idt,abs(lsynctime-itimec+itime))
-      itimec=itimec+part(ipart)%idt*ldirect
-    else
-      part(ipart)%idt=abs(lsynctime)
-      itimec=itime+lsynctime
-    endif
-    dt=real(part(ipart)%idt)
-    xts=real(part(ipart)%xlon)
-    yts=real(part(ipart)%ylat)
-    zts=real(part(ipart)%z)
-
-    zeta=zts/h
-    if (loop.eq.1) then ! Temporal interpolation only for the first iteration
-
-      if (ngrid.le.0) then
-        xts=real(part(ipart)%xlon)
-        yts=real(part(ipart)%ylat)
-        call interpol_pbl(itime,xts,yts,zts,real(part(ipart)%zeta))
-      else
-        call interpol_pbl(itime,xtn,ytn,zts,real(part(ipart)%zeta))
-      endif
-
-    else
-
-      ! Determine the level below the current position for u,v,rho
-      !***********************************************************
-      call find_z_level_meters(zts)
-
-      ! If one of the levels necessary is not yet available,
-      ! calculate it
-      !*****************************************************
-      call interpol_pbl_misslev()
-
-    endif
-
-  ! Vertical interpolation of u,v,w,rho and drhodz
-  !***********************************************
-
-  ! Vertical distance to the level below and above current position
-  ! both in terms of (u,v) and (w) fields
-  !****************************************************************
-
-    call interpol_pbl_short(zts,rhoa,rhograd) ! Vertical interpolation
-
-  ! Compute the turbulent disturbances
-  ! Determine the sigmas and the timescales 
-  !****************************************
-
-    if (.not.turboff) then
-      call turb_pbl(ipart,nrand,dt,zts,rhoa,rhograd,thread) 
-      ! Note: zts and nrand get updated
-      
-      ! Determine time step for next integration
-      !*****************************************
-      if (turbswitch) then
-        part(ipart)%idt = int( &
-          min( tlw, &
-               h/max( 2.*abs(part(ipart)%turbvel%w*sigw), 1.e-5 ), &
-               0.5/abs(dsigwdz) &
-             ) *ctl)
-      else
-        part(ipart)%idt = int( &
-          min( tlw, & 
-               h/max( 2.*abs(part(ipart)%turbvel%w), 1.e-5) &
-              ) *ctl)
-      endif
-    else
-      part(ipart)%turbvel%u=0.
-      part(ipart)%turbvel%v=0.
-      part(ipart)%turbvel%w=0.
-    endif
-
-    part(ipart)%idt=max(part(ipart)%idt,mintime)
-
-
-  ! If particle represents only a single species, add gravitational settling
-  ! velocity. The settling velocity is zero for gases, or if particle
-  ! represents more than one species
-  !*************************************************************************
-
-    if (mdomainfill.eq.0) then
-      if (lsettling) then
-        if ((ipin.ne.3).and.(ipin.ne.4)) then
-          do insp=1,nspec
-            nsp=insp
-            if (xmass(part(ipart)%npoint,nsp).gt.eps3) exit
-          end do
-        else
-          nsp=1
-        endif
-        if (density(nsp).gt.0.) then
-          call get_settling(itime,xts,yts,zts,nsp,part(ipart)%settling)  !bugfix
-          w=w+part(ipart)%settling
-        end if
-      end if
-    endif
-
-  ! Horizontal displacements during time step dt are small real values compared
-  ! to the position; adding the two, would result in large numerical errors.
-  ! Thus, displacements are accumulated during lsynctime and are added to the
-  ! position at the end
-  !****************************************************************************
-
-    dxsave=dxsave+u*dt
-    dysave=dysave+v*dt
-    dawsave=dawsave+part(ipart)%turbvel%u*dt
-    dcwsave=dcwsave+part(ipart)%turbvel%v*dt
-    ! How can I change the w to w(eta) efficiently?
-
-    select case (wind_coord_type)
-
-      case ('ETA')
-
-        call update_z(ipart,w*dt*real(ldirect))
-        zts=real(part(ipart)%z)
-        ! HSO/AL: Particle managed to go over highest level -> interpolation
-        ! error in goto 700
-        !          alias interpol_wind (division by zero)
-        if (zts.ge.height(nz)) call set_z(ipart,height(nz)-100.*eps) 
-         ! Manually for z instead
-
-      case ('METER')
-
-        call update_z(ipart,w*dt*real(ldirect))
-        call pushpartdown(ipart)
-
-    end select
-    zts=real(part(ipart)%z)
-    
-    if (zts.gt.h) then
-      call update_z_to_zeta(itime,ipart)
-      if (itimec.ne.itime+lsynctime) abovePBL=.true. 
-        ! complete the current interval above PBL
-      return 
-    endif
-    
-  ! Determine probability of deposition
-  !************************************
-    call drydepo_probability(part(ipart)%prob,dt,zts,vdepo)
-
-    if (zts.lt.0.) call set_z(ipart,min(h-eps2,-1.*part(ipart)%z))    
-      ! if particle below ground -> reflection
-
-    if (itimec.eq.(itime+lsynctime)) then
-      ! Convert z position that changed by turbulent motions to eta coords
-      call update_z_to_zeta(itime,ipart)
-      return  ! finished
-    endif
-
-  end do pbl_loop
-
-  call update_z_to_zeta(itime,ipart)
-
-end subroutine adv_in_pbl
-
-subroutine petterson_corr(itime,ipart)
-
-  implicit none 
-
-  integer, intent(in) ::          &
-    itime,                        & ! time index
-    ipart                           ! particle index
-  integer ::                      &
-    nsp,insp                        ! loop variables for number of species
-  real ::                         &
-    xts,yts,zts,ztseta,           & ! local 'real' copy of the particle position
-    uold,vold,wold,woldeta,       &
-    weta_settling       
-  real(kind=dp) ::                &
-    ztemp                           ! temporarily storing z position
-
-
-  xts=real(part(ipart)%xlon)
-  yts=real(part(ipart)%ylat)
-  zts=real(part(ipart)%z)
-  ztseta=real(part(ipart)%zeta)
-  if (lsettling) part(ipart)%settling=0.
-
-  ! Memorize the old wind
-  !**********************
-
-  uold=u
-  vold=v
-
-  select case (wind_coord_type)
-    case ('ETA')
-      woldeta=weta
-    case ('METER')
-      wold=w
-    case default
-      wold=w
-  end select
-
-  ! Interpolate wind at new position and time
-  !******************************************
-  call interpol_wind_short(itime+part(ipart)%idt*ldirect,xts,yts,zts,ztseta)
-
-  if (mdomainfill.eq.0) then
-    if (lsettling) then
-      if ((ipin.ne.3).and.(ipin.ne.4)) then
-        do insp=1,nspec
-          nsp=insp
-          if (xmass(part(ipart)%npoint,nsp).gt.eps3) exit
-        end do
-      else
-        nsp=1
-      endif
-      if (density(nsp).gt.0.) then
-        select case (wind_coord_type)
-
-          case ('ETA')
-
-            call update_zeta_to_z(itime+part(ipart)%idt,ipart)
-            call update_z_to_zeta(itime+part(ipart)%idt,ipart)
-            zts=real(part(ipart)%z)
-            call get_settling( &
-             itime+part(ipart)%idt,xts,yts,zts,nsp,part(ipart)%settling) !bugfix
-            call w_to_weta( &
-              itime+part(ipart)%idt, real(part(ipart)%idt), part(ipart)%xlon, &
-              part(ipart)%ylat, part(ipart)%z, part(ipart)%zeta, &
-              part(ipart)%settling, weta_settling)
-            weta=weta+weta_settling
-           !woldeta=
-     !real(part(ipart)%zeta-part(ipart)%zeta_prev)/real(part(ipart)%idt*ldirect)
-
-          case ('METER')
-
-            call get_settling( &
-              itime+part(ipart)%idt,xts,yts,zts,nsp,part(ipart)%settling)
-            w=w+part(ipart)%settling
-
-          case default 
-
-            call get_settling( &
-              itime+part(ipart)%idt,xts,yts,zts,nsp,part(ipart)%settling)
-            w=w+part(ipart)%settling
-
-        end select            
-      end if
-    endif
-  end if
-
-  ! Determine the difference vector between new and old wind
-  ! (use half of it to correct position according to Petterssen)
-  !*************************************************************
-
-  u=(u-uold)*0.5
-  v=(v-vold)*0.5
-
-  select case (wind_coord_type)
-
-    case ('ETA')
-
-      weta=(weta-woldeta)/2.
-      call update_zeta(ipart,weta*real(part(ipart)%idt*ldirect))
-      if (part(ipart)%zeta.ge.1.) call set_zeta(ipart,1.-(part(ipart)%zeta-1.))
-      if (part(ipart)%zeta.eq.1.) call update_zeta(ipart,-eps_eta)
-
-    case ('METER')
-
-      w=(w-wold)/2.
-      call update_z(ipart,w*real(part(ipart)%idt*ldirect))
-      if (part(ipart)%z.lt.0.) call set_z(ipart,min(h-eps2,-1.*part(ipart)%z))          ! if particle below ground -> reflection
-
-    case default 
-
-      w=(w-wold)/2.
-      call update_z(ipart,w*real(part(ipart)%idt*ldirect))
-      if (part(ipart)%z.lt.0.) call set_z(ipart,min(h-eps2,-1.*part(ipart)%z)) 
-
-  end select  
-
-  ! Finally, correct the old position
-  !**********************************
-
-  call update_xy(u*part(ipart)%idt,v*part(ipart)%idt,ipart)
-
-  ! If particle above highest model level, set it back into the domain
-  !*******************************************************************
-
-  call pushpartdown(ipart)
-  
-end subroutine petterson_corr
-
-subroutine update_xy(xchange,ychange,ipart)
-
-  implicit none
-
-  integer, intent(in) ::          &
-    ipart                           ! particle number
-  real, intent(in) ::             &
-    xchange,ychange                 ! change in position
-  real ::                         &
-    xlon,ylat,xpol,ypol,          & ! temporarily storing new particle positions
-    gridsize,cosfact                ! used to compute new positions of particles
-
-  eps=nxmax/3.e5
-
-  if (ngrid.ge.0) then
-
-    cosfact=dxconst/cos((real(part(ipart)%ylat)*dy+ylat0)*pi180)
-    call update_xlon(ipart,real(xchange*cosfact*real(ldirect),kind=dp))
-    call update_ylat(ipart,real(ychange*dyconst*real(ldirect),kind=dp))
-
-  else if (ngrid.eq.-1) then      ! around north pole
-
-    xlon=xlon0+real(part(ipart)%xlon)*dx !comment by MC: compute old part pos.
-    ylat=ylat0+real(part(ipart)%ylat)*dy
-    call cll2xy(northpolemap,ylat,xlon,xpol,ypol)   
-      !convert old particle position in polar stereographic
-    gridsize=1000.*cgszll(northpolemap,ylat,xlon)   
-      !calculate size in m of grid element in polar stereographic coordinate
-    xpol=xpol+xchange/gridsize*real(ldirect)        
-      !position in grid unit polar stereographic
-    ypol=ypol+ychange/gridsize*real(ldirect)
-    call cxy2ll(northpolemap,xpol,ypol,ylat,xlon)   
-      !convert to lat long coordinate
-    call set_xlon(ipart,real((xlon-xlon0)/dx,kind=dp))
-      !convert to grid units in lat long coordinate, comment by mc
-    call set_ylat(ipart,real((ylat-ylat0)/dy,kind=dp))
-
-  else if (ngrid.eq.-2) then    ! around south pole
-
-    xlon=xlon0+real(part(ipart)%xlon)*dx
-    ylat=ylat0+real(part(ipart)%ylat)*dy
-    call cll2xy(southpolemap,ylat,xlon,xpol,ypol)
-    gridsize=1000.*cgszll(southpolemap,ylat,xlon)
-    xpol=xpol+xchange/gridsize*real(ldirect)
-    ypol=ypol+ychange/gridsize*real(ldirect)
-    call cxy2ll(southpolemap,xpol,ypol,ylat,xlon)
-    call set_xlon(ipart,real((xlon-xlon0)/dx,kind=dp))
-    call set_ylat(ipart,real((ylat-ylat0)/dy,kind=dp))
-
-  endif
-
-  ! If global data are available, use cyclic boundary condition
-  !************************************************************
-
-  if (xglobal) then
-    if (part(ipart)%xlon .ge. real(nxmin1, kind=dp)) &
-      call update_xlon(ipart,-real(nxmin1, kind=dp))
-    if (part(ipart)%xlon .lt. 0.) call update_xlon(ipart,real(nxmin1, kind=dp))
-    if (part(ipart)%xlon .le. real(eps, kind=dp)) &
-      call set_xlon(ipart,real(eps, kind=dp))
-    if (abs( part(ipart)%xlon - real(nxmin1, kind=dp)) .le. eps) &
-      call set_xlon(ipart,real(nxmin1-eps,kind=dp))
-  endif
-
-  ! HSO/AL: Prevent particles from disappearing at the pole
-  !******************************************************************
-  if (sglobal .and. part(ipart)%ylat.lt.0. ) then
-    call set_xlon(ipart, &
-      mod( part(ipart)%xlon + real(nxmin1*0.5, kind=dp), real(nxmin1, kind=dp)))
-    call set_ylat(ipart,-part(ipart)%ylat)
-   ! In extremely rare cases, the ylat exceeds the bounds, 
-   ! so we set it back into the domain here
-    if ( part(ipart)%ylat.gt.real(nymin1,kind=dp) ) &
-      call set_ylat(ipart, &
-        real(nymin1, kind=dp) - mod( part(ipart)%ylat, real(nymin1, kind=dp)))
-  else if (nglobal .and. part(ipart)%ylat .gt. real(nymin1, kind=dp) ) then
-    call set_xlon(ipart, &
-      mod( part(ipart)%xlon + real(nxmin1*0.5, kind=dp), real(nxmin1, kind=dp)))
-    call set_ylat(ipart,2.*real(nymin1,kind=dp) - part(ipart)%ylat)
-  endif
-
-  ! Check position: If trajectory outside model domain, terminate it
-  !*****************************************************************
-  ! Not necessary to check when using global domain, but some problems in the
-  ! meteo data could cause particles to go crazy.
-  ! if (gdomainfill) return 
-
-  if (part(ipart)%xlon.lt.0. .or. part(ipart)%xlon.ge.real(nxmin1,kind=dp) &
- .or. part(ipart)%ylat.lt.0. .or. part(ipart)%ylat.gt.real(nymin1,kind=dp)) then
-    part(ipart)%nstop=.true.
-    return
-  endif
-  
-end subroutine update_xy
-
-subroutine pushpartdown(ipart)
-
-  implicit none 
-
-  integer, intent(in) ::          &
-    ipart                           ! particle index
 
-  eps=nxmax/3.e5
+#include "adv_advance.f90"
 
-  select case (wind_coord_type)
-  
-    case ('ETA')
-    
-      if (part(ipart)%zeta.le.real(uvheight(nz),kind=dp)) &
-        call set_zeta(ipart,uvheight(nz)+eps_eta)
+#include "adv_adv_above_pbl.f90"
 
-    case ('METER')
-    
-      if (part(ipart)%z.ge.real(height(nz),kind=dp)) &
-        call set_z(ipart,height(nz)-100.*eps)
+#include "adv_adv_in_pbl.f90"
 
-    case default
+#include "adv_petterson_corr.f90"
 
-      if (part(ipart)%z.ge.real(height(nz),kind=dp)) &
-      call set_z(ipart,height(nz)-100.*eps)
+#include "adv_update_xy.f90"
 
-  end select
-  
-end subroutine pushpartdown
+#include "adv_pushpartdown.f90"
 
 end module advance_mod
diff --git a/src/bin_concoutput.f90 b/src/bin_concoutput.f90
new file mode 100644
index 0000000000000000000000000000000000000000..e534902abd7ed9257f5268e361b81cd38d65fb10
--- /dev/null
+++ b/src/bin_concoutput.f90
@@ -0,0 +1,644 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, &
+     drygridtotalunc)
+  !                        i     i          o             o
+  !       o
+  !*****************************************************************************
+  !                                                                            *
+  !     Output of the concentration grid and the receptor concentrations.      *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     24 May 1995                                                            *
+  !                                                                            *
+  !     13 April 1999, Major update: if output size is smaller, dump output    *
+  !                    in sparse matrix format; additional output of           *
+  !                    uncertainty                                             *
+  !                                                                            *
+  !     05 April 2000, Major update: output of age classes; output for backward*
+  !                    runs is time spent in grid cell times total mass of     *
+  !                    species.                                                *
+  !                                                                            *
+  !     17 February 2002, Appropriate dimensions for backward and forward runs *
+  !                       are now specified in file par_mod                    *
+  !                                                                            *
+  !     June 2006, write grid in sparse matrix with a single write command     *
+  !                in order to save disk space                                 *
+  !                                                                            *
+  !     2008 new sparse matrix format                                          *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! outnum          number of samples                                          *
+  ! ncells          number of cells with non-zero concentrations               *
+  ! sparse          .true. if in sparse matrix format, else .false.            *
+  ! tot_mu          1 for forward, initial mass mixing ration for backw. runs  *
+  !                                                                            *
+  !*****************************************************************************
+
+  use unc_mod
+  use mean_mod
+
+  implicit none
+
+  real(kind=dp) :: jul
+  integer :: itime,i,ix,jy,kz,ks,kp,l,iix,jjy,kzz,nage,jjjjmmdd,ihmmss
+  integer :: sp_count_i,sp_count_r
+  real :: sp_fact
+  real :: outnum,densityoutrecept(maxreceptor),xl,yl
+  ! RLT
+  real :: densitydryrecept(maxreceptor)
+  real :: factor_dryrecept(maxreceptor)
+
+  real(dep_prec) :: auxgrid(nclassunc)
+  real(sp) :: gridtotal,gridsigmatotal,gridtotalunc
+  real(dep_prec) :: wetgridtotal,wetgridsigmatotal,wetgridtotalunc
+  real(dep_prec) :: drygridtotal,drygridsigmatotal,drygridtotalunc
+  real :: halfheight,dz,dz1,dz2,tot_mu(maxspec,maxpointspec_act)
+  real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
+  real,parameter :: weightair=28.97
+  logical :: sp_zer
+  logical,save :: init=.true.
+  character :: adate*8,atime*6
+  character(len=3) :: anspec
+  integer :: mind
+  character(LEN=8),save :: file_stat='REPLACE'
+  logical :: ldates_file
+  logical :: lexist
+  integer :: ierr
+  character(LEN=100) :: dates_char
+
+  ! Determine current calendar date, needed for the file name
+  !**********************************************************
+
+  jul=bdate+real(itime,kind=dp)/86400._dp
+  call caldate(jul,jjjjmmdd,ihmmss)
+  write(adate,'(i8.8)') jjjjmmdd
+  write(atime,'(i6.6)') ihmmss
+
+  ! Overwrite existing dates file on first call, later append to it
+  ! This fixes a bug where the dates file kept growing across multiple runs
+
+  ! If 'dates' file exists in output directory, make a backup
+  inquire(file=path(2)(1:length(2))//'dates', exist=ldates_file)
+  if (ldates_file.and.init) then
+    open(unit=unitdates, file=path(2)(1:length(2))//'dates',form='formatted', &
+         &access='sequential', status='old', action='read', iostat=ierr)
+    open(unit=unittmp, file=path(2)(1:length(2))//'dates.bak', access='sequential', &
+         &status='replace', action='write', form='formatted', iostat=ierr)
+    do while (.true.)
+      read(unitdates, '(a)', iostat=ierr) dates_char
+      if (ierr.ne.0) exit
+      write(unit=unittmp, fmt='(a)', iostat=ierr, advance='yes') trim(dates_char)
+    end do
+    close(unit=unitdates)
+    close(unit=unittmp)
+  end if
+
+  open(unitdates,file=path(2)(1:length(2))//'dates', ACCESS='APPEND', STATUS=file_stat)
+  write(unitdates,'(a)') adate//atime
+  close(unitdates)
+
+  ! Overwrite existing dates file on first call, later append to it
+  ! This fixes a bug where the dates file kept growing across multiple runs
+  IF (init) THEN
+    file_stat='OLD'
+    init=.false.
+  END IF
+
+
+  ! For forward simulations, output fields have dimension MAXSPEC,
+  ! for backward simulations, output fields have dimension MAXPOINT.
+  ! Thus, make loops either about nspec, or about numpoint
+  !*****************************************************************
+
+
+  if (ldirect.eq.1) then
+    do ks=1,nspec
+      do kp=1,maxpointspec_act
+        tot_mu(ks,kp)=1
+      end do
+    end do
+  else
+    do ks=1,nspec
+      do kp=1,maxpointspec_act
+        tot_mu(ks,kp)=xmass(kp,ks)
+      end do
+    end do
+  endif
+
+
+  !*******************************************************************
+  ! Compute air density: sufficiently accurate to take it
+  ! from coarse grid at some time
+  ! Determine center altitude of output layer, and interpolate density
+  ! data to that altitude
+  !*******************************************************************
+
+  mind=memind(2)
+  do kz=1,numzgrid
+    if (kz.eq.1) then
+      halfheight=outheight(1)/2.
+    else
+      halfheight=(outheight(kz)+outheight(kz-1))/2.
+    endif
+    do kzz=2,nz
+      if ((height(kzz-1).lt.halfheight).and. &
+           (height(kzz).gt.halfheight)) goto 46
+    end do
+46  kzz=max(min(kzz,nz),2)
+    dz1=halfheight-height(kzz-1)
+    dz2=height(kzz)-halfheight
+    dz=dz1+dz2
+    do jy=0,numygrid-1
+      do ix=0,numxgrid-1
+        xl=outlon0+real(ix)*dxout
+        yl=outlat0+real(jy)*dyout
+        xl=(xl-xlon0)/dx
+        yl=(yl-ylat0)/dy !v9.1.1
+        iix=max(min(nint(xl),nxmin1),0)
+        jjy=max(min(nint(yl),nymin1),0)
+  ! densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,2)*dz1+ &
+  !      rho(iix,jjy,kzz-1,2)*dz2)/dz
+        densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,mind)*dz1+ &
+             rho(iix,jjy,kzz-1,mind)*dz2)/dz
+  ! RLT
+        densitydrygrid(ix,jy,kz)=(rho_dry(iix,jjy,kzz,mind)*dz1+ &
+             rho_dry(iix,jjy,kzz-1,mind)*dz2)/dz
+      end do
+    end do
+  end do
+
+  do i=1,numreceptor
+    xl=xreceptor(i)
+    yl=yreceptor(i)
+    iix=max(min(nint(xl),nxmin1),0)
+    jjy=max(min(nint(yl),nymin1),0)
+  !densityoutrecept(i)=rho(iix,jjy,1,2)
+    densityoutrecept(i)=rho(iix,jjy,1,mind)
+  ! RLT
+    densitydryrecept(i)=rho_dry(iix,jjy,1,mind)
+  end do
+
+  ! RLT
+  ! conversion factor for output relative to dry air
+  factor_drygrid=densityoutgrid/densitydrygrid
+  factor_dryrecept=densityoutrecept/densitydryrecept
+
+  ! Output is different for forward and backward simulations
+  do kz=1,numzgrid
+    do jy=0,numygrid-1
+      do ix=0,numxgrid-1
+        if (ldirect.eq.1) then
+          factor3d(ix,jy,kz)=1.e12/volume(ix,jy,kz)/outnum
+        else
+          factor3d(ix,jy,kz)=real(abs(loutaver))/outnum
+        endif
+      end do
+    end do
+  end do
+
+  !*********************************************************************
+  ! Determine the standard deviation of the mean concentration or mixing
+  ! ratio (uncertainty of the output) and the dry and wet deposition
+  !*********************************************************************
+
+  gridtotal=0.
+  gridsigmatotal=0.
+  gridtotalunc=0.
+  wetgridtotal=0.
+  wetgridsigmatotal=0.
+  wetgridtotalunc=0.
+  drygridtotal=0.
+  drygridsigmatotal=0.
+  drygridtotalunc=0.
+
+  do ks=1,nspec
+
+    write(anspec,'(i3.3)') ks
+
+    if (DRYBKDEP.or.WETBKDEP) then !scavdep output
+      if (DRYBKDEP) &
+      open(unitoutgrid,file=path(2)(1:length(2))//'grid_drydep_'//adate// &
+           atime//'_'//anspec,form='unformatted')
+      if (WETBKDEP) &
+      open(unitoutgrid,file=path(2)(1:length(2))//'grid_wetdep_'//adate// &
+           atime//'_'//anspec,form='unformatted')
+      write(unitoutgrid) itime
+    else
+      if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
+        if (ldirect.eq.1) then
+          open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_'//adate// &
+             atime//'_'//anspec,form='unformatted')
+        else
+          open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_'//adate// &
+             atime//'_'//anspec,form='unformatted')
+        endif
+        write(unitoutgrid) itime
+      endif
+      if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
+        open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_'//adate// &
+           atime//'_'//anspec,form='unformatted')
+        write(unitoutgridppt) itime
+      endif
+    endif ! if deposition output
+
+    do kp=1,maxpointspec_act
+      do nage=1,nageclass
+
+        do jy=0,numygrid-1
+          do ix=0,numxgrid-1
+
+  ! WET DEPOSITION
+            if ((WETDEP).and.(ldirect.gt.0)) then
+              do l=1,nclassunc
+                auxgrid(l)=wetgridunc(ix,jy,ks,kp,l,nage)
+              end do
+              call mean(auxgrid,wetgrid(ix,jy), &
+                   wetgridsigma(ix,jy),nclassunc)
+  ! Multiply by number of classes to get total concentration
+              wetgrid(ix,jy)=wetgrid(ix,jy) &
+                   *nclassunc
+              wetgridtotal=wetgridtotal+wetgrid(ix,jy)
+  ! Calculate standard deviation of the mean
+              wetgridsigma(ix,jy)= &
+                   wetgridsigma(ix,jy)* &
+                   sqrt(real(nclassunc))
+              wetgridsigmatotal=wetgridsigmatotal+ &
+                   wetgridsigma(ix,jy)
+            endif
+
+  ! DRY DEPOSITION
+            if ((DRYDEP).and.(ldirect.gt.0)) then
+              do l=1,nclassunc
+                auxgrid(l)=drygridunc(ix,jy,ks,kp,l,nage)
+              end do
+              call mean(auxgrid,drygrid(ix,jy), &
+                   drygridsigma(ix,jy),nclassunc)
+  ! Multiply by number of classes to get total concentration
+              drygrid(ix,jy)=drygrid(ix,jy)* &
+                   nclassunc
+              drygridtotal=drygridtotal+drygrid(ix,jy)
+  ! Calculate standard deviation of the mean
+              drygridsigma(ix,jy)= &
+                   drygridsigma(ix,jy)* &
+                   sqrt(real(nclassunc))
+              drygridsigmatotal=drygridsigmatotal+ &
+                   drygridsigma(ix,jy)
+            endif
+
+  ! CONCENTRATION OR MIXING RATIO
+            do kz=1,numzgrid
+              do l=1,nclassunc
+                auxgrid(l)=gridunc(ix,jy,kz,ks,kp,l,nage)
+              end do
+              call mean(auxgrid,grid(ix,jy,kz), &
+                   gridsigma(ix,jy,kz),nclassunc)
+  ! Multiply by number of classes to get total concentration
+              grid(ix,jy,kz)= &
+                   grid(ix,jy,kz)*nclassunc
+              gridtotal=gridtotal+grid(ix,jy,kz)
+  ! Calculate standard deviation of the mean
+              gridsigma(ix,jy,kz)= &
+                   gridsigma(ix,jy,kz)* &
+                   sqrt(real(nclassunc))
+              gridsigmatotal=gridsigmatotal+ &
+                   gridsigma(ix,jy,kz)
+            end do
+          end do
+        end do
+
+  !*******************************************************************
+  ! Generate output: may be in concentration (ng/m3) or in mixing
+  ! ratio (ppt) or both
+  ! Output the position and the values alternated multiplied by
+  ! 1 or -1, first line is number of values, number of positions
+  ! For backward simulations, the unit is seconds, stored in grid_time
+  !*******************************************************************
+
+  ! Concentration output
+  !*********************
+        if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
+
+  ! Wet deposition
+          sp_count_i=0
+          sp_count_r=0
+          sp_fact=-1.
+          sp_zer=.true.
+          if ((ldirect.eq.1).and.(WETDEP)) then
+            do jy=0,numygrid-1
+              do ix=0,numxgrid-1
+  !oncentraion greater zero
+                if (wetgrid(ix,jy).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)=ix+jy*numxgrid
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                  endif
+                  sp_count_r=sp_count_r+1
+                  sparse_dump_r(sp_count_r)= &
+                       sp_fact*1.e12*wetgrid(ix,jy)/area(ix,jy)
+                else ! concentration is zero
+                  sp_zer=.true.
+                endif
+              end do
+            end do
+          else
+            sp_count_i=0
+            sp_count_r=0
+          endif
+          write(unitoutgrid) sp_count_i
+          write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
+          write(unitoutgrid) sp_count_r
+          write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
+
+  ! Dry deposition
+          sp_count_i=0
+          sp_count_r=0
+          sp_fact=-1.
+          sp_zer=.true.
+          if ((ldirect.eq.1).and.(DRYDEP)) then
+            do jy=0,numygrid-1
+              do ix=0,numxgrid-1
+                if (drygrid(ix,jy).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)=ix+jy*numxgrid
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                  endif
+                  sp_count_r=sp_count_r+1
+                  sparse_dump_r(sp_count_r)= &
+                       sp_fact* &
+                       1.e12*drygrid(ix,jy)/area(ix,jy)
+                else ! concentration is zero
+                  sp_zer=.true.
+                endif
+              end do
+            end do
+          else
+            sp_count_i=0
+            sp_count_r=0
+          endif
+          write(unitoutgrid) sp_count_i
+          write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
+          write(unitoutgrid) sp_count_r
+          write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
+
+
+
+  ! Concentrations
+          sp_count_i=0
+          sp_count_r=0
+          sp_fact=-1.
+          sp_zer=.true.
+          do kz=1,numzgrid
+            do jy=0,numygrid-1
+              do ix=0,numxgrid-1
+                if (grid(ix,jy,kz).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)= &
+                         ix+jy*numxgrid+kz*numxgrid*numygrid
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                  endif
+                  sp_count_r=sp_count_r+1
+                  if (lparticlecountoutput) then
+                    sparse_dump_r(sp_count_r)= &
+                         sp_fact* &
+                         grid(ix,jy,kz)
+                  else
+                    sparse_dump_r(sp_count_r)= &
+                         sp_fact* &
+                         grid(ix,jy,kz)* &
+                         factor3d(ix,jy,kz)/tot_mu(ks,kp)
+                  end if
+
+                else ! concentration is zero
+                  sp_zer=.true.
+                endif
+              end do
+            end do
+          end do
+          write(unitoutgrid) sp_count_i
+          write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
+          write(unitoutgrid) sp_count_r
+          write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
+
+
+
+        endif !  concentration output
+
+  ! Mixing ratio output
+  !********************
+
+        if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
+
+  ! Wet deposition
+          sp_count_i=0
+          sp_count_r=0
+          sp_fact=-1.
+          sp_zer=.true.
+          if ((ldirect.eq.1).and.(WETDEP)) then
+            do jy=0,numygrid-1
+              do ix=0,numxgrid-1
+                if (wetgrid(ix,jy).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)= &
+                         ix+jy*numxgrid
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                  endif
+                  sp_count_r=sp_count_r+1
+                  sparse_dump_r(sp_count_r)= &
+                       sp_fact* &
+                       1.e12*wetgrid(ix,jy)/area(ix,jy)
+                else ! concentration is zero
+                  sp_zer=.true.
+                endif
+              end do
+            end do
+          else
+            sp_count_i=0
+            sp_count_r=0
+          endif
+          write(unitoutgridppt) sp_count_i
+          write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
+          write(unitoutgridppt) sp_count_r
+          write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
+
+
+  ! Dry deposition
+          sp_count_i=0
+          sp_count_r=0
+          sp_fact=-1.
+          sp_zer=.true.
+          if ((ldirect.eq.1).and.(DRYDEP)) then
+            do jy=0,numygrid-1
+              do ix=0,numxgrid-1
+                if (drygrid(ix,jy).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)= &
+                         ix+jy*numxgrid
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1)
+                  endif
+                  sp_count_r=sp_count_r+1
+                  sparse_dump_r(sp_count_r)= &
+                       sp_fact* &
+                       1.e12*drygrid(ix,jy)/area(ix,jy)
+                else ! concentration is zero
+                  sp_zer=.true.
+                endif
+              end do
+            end do
+          else
+            sp_count_i=0
+            sp_count_r=0
+          endif
+          write(unitoutgridppt) sp_count_i
+          write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
+          write(unitoutgridppt) sp_count_r
+          write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
+
+
+  ! Mixing ratios
+          sp_count_i=0
+          sp_count_r=0
+          sp_fact=-1.
+          sp_zer=.true.
+          do kz=1,numzgrid
+            do jy=0,numygrid-1
+              do ix=0,numxgrid-1
+                if (grid(ix,jy,kz).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)= &
+                         ix+jy*numxgrid+kz*numxgrid*numygrid
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                  endif
+                  sp_count_r=sp_count_r+1
+                  sparse_dump_r(sp_count_r)= &
+                       sp_fact* &
+                       1.e12*grid(ix,jy,kz) &
+                       /volume(ix,jy,kz)/outnum* &
+                       weightair/weightmolar(ks)/densityoutgrid(ix,jy,kz)
+                else ! concentration is zero
+                  sp_zer=.true.
+                endif
+              end do
+            end do
+          end do
+          write(unitoutgridppt) sp_count_i
+          write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
+          write(unitoutgridppt) sp_count_r
+          write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
+
+        endif ! output for ppt
+
+      end do
+    end do
+
+    close(unitoutgridppt)
+    close(unitoutgrid)
+
+  end do
+
+  ! RLT Aug 2017
+  ! Write out conversion factor for dry air
+  inquire(file=path(2)(1:length(2))//'factor_drygrid',exist=lexist)
+  if (lexist) then
+    ! open and append
+    open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid',form='unformatted',&
+            status='old',action='write',access='append')
+  else
+    ! create new
+    open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid',form='unformatted',&
+            status='new',action='write')
+  endif
+  sp_count_i=0
+  sp_count_r=0
+  sp_fact=-1.
+  sp_zer=.true.
+  do kz=1,numzgrid
+    do jy=0,numygrid-1
+      do ix=0,numxgrid-1
+        if (factor_drygrid(ix,jy,kz).gt.(1.+smallnum).or.factor_drygrid(ix,jy,kz).lt.(1.-smallnum)) then
+          if (sp_zer.eqv..true.) then ! first value not equal to one
+            sp_count_i=sp_count_i+1
+            sparse_dump_i(sp_count_i)= &
+                  ix+jy*numxgrid+kz*numxgrid*numygrid
+            sp_zer=.false.
+            sp_fact=sp_fact*(-1.)
+          endif
+          sp_count_r=sp_count_r+1
+          sparse_dump_r(sp_count_r)= &
+               sp_fact*factor_drygrid(ix,jy,kz)
+        else ! factor is one
+          sp_zer=.true.
+        endif
+      end do
+    end do
+  end do
+  write(unitoutfactor) sp_count_i
+  write(unitoutfactor) (sparse_dump_i(i),i=1,sp_count_i)
+  write(unitoutfactor) sp_count_r
+  write(unitoutfactor) (sparse_dump_r(i),i=1,sp_count_r)
+  close(unitoutfactor)
+
+
+  if (gridtotal.gt.0.) gridtotalunc=gridsigmatotal/gridtotal
+  if (wetgridtotal.gt.0.) wetgridtotalunc=wetgridsigmatotal/ &
+       wetgridtotal
+  if (drygridtotal.gt.0.) drygridtotalunc=drygridsigmatotal/ &
+       drygridtotal
+
+  ! Dump of receptor concentrations
+
+  if (numreceptor.gt.0 .and. (iout.eq.2 .or. iout.eq.3)  ) then
+    write(unitoutreceptppt) itime
+    do ks=1,nspec
+      write(unitoutreceptppt) (1.e12*creceptor(i,ks)/outnum* &
+           weightair/weightmolar(ks)/densityoutrecept(i),i=1,numreceptor)
+    end do
+  endif
+
+  ! Dump of receptor concentrations
+
+  if (numreceptor.gt.0) then
+    write(unitoutrecept) itime
+    do ks=1,nspec
+      write(unitoutrecept) (1.e12*creceptor(i,ks)/outnum, &
+           i=1,numreceptor)
+    end do
+  endif
+
+  ! RLT Aug 2017
+  ! Write out conversion factor for dry air
+  if (numreceptor.gt.0) then
+    inquire(file=path(2)(1:length(2))//'factor_dryreceptor',exist=lexist)
+     if (lexist) then
+     ! open and append
+      open(unitoutfactor,file=path(2)(1:length(2))//'factor_dryreceptor',form='unformatted',&
+              status='old',action='write',access='append')
+    else
+      ! create new
+      open(unitoutfactor,file=path(2)(1:length(2))//'factor_dryreceptor',form='unformatted',&
+              status='new',action='write')
+    endif
+    write(unitoutfactor) itime
+    write(unitoutfactor) (factor_dryrecept(i),i=1,numreceptor)
+    close(unitoutfactor)
+  endif
+
+  creceptor(:,:)=0.
+  gridunc(:,:,:,:,:,:,:)=0.
+end subroutine concoutput
diff --git a/src/bin_concoutput_inv.f90 b/src/bin_concoutput_inv.f90
new file mode 100644
index 0000000000000000000000000000000000000000..8c9266ba86181d68369cfb12e2b41e268045d956
--- /dev/null
+++ b/src/bin_concoutput_inv.f90
@@ -0,0 +1,611 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine concoutput_inv(itime,outnum,gridtotalunc,wetgridtotalunc, &
+     drygridtotalunc)
+  !                        i     i          o             o
+  !       o
+  !*****************************************************************************
+  !                                                                            *
+  !     Output of the concentration grid and the receptor concentrations.      *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     24 May 1995                                                            *
+  !                                                                            *
+  !     13 April 1999, Major update: if output size is smaller, dump output    *
+  !                    in sparse matrix format; additional output of           *
+  !                    uncertainty                                             *
+  !                                                                            *
+  !     05 April 2000, Major update: output of age classes; output for backward*
+  !                    runs is time spent in grid cell times total mass of     *
+  !                    species.                                                *
+  !                                                                            *
+  !     17 February 2002, Appropriate dimensions for backward and forward runs *
+  !                       are now specified in file par_mod                    *
+  !                                                                            *
+  !     June 2006, write grid in sparse matrix with a single write command     *
+  !                in order to save disk space                                 *
+  !                                                                            *
+  !     2008 new sparse matrix format                                          *
+  !
+  !     January 2017,  Separate files by release but include all timesteps
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! outnum          number of samples                                          *
+  ! ncells          number of cells with non-zero concentrations               *
+  ! sparse          .true. if in sparse matrix format, else .false.            *
+  ! tot_mu          1 for forward, initial mass mixing ration for backw. runs  *
+  !                                                                            *
+  !*****************************************************************************
+
+  use unc_mod
+  use mean_mod
+
+  implicit none
+
+  real(kind=dp) :: jul
+  integer :: itime,i,ix,jy,kz,ks,kp,l,iix,jjy,kzz,nage,jjjjmmdd,ihmmss
+  integer :: sp_count_i,sp_count_r
+  real :: sp_fact
+  real :: outnum,densityoutrecept(maxreceptor),xl,yl
+  ! RLT
+  real :: densitydryrecept(maxreceptor)
+  real :: factor_dryrecept(maxreceptor)
+
+
+  real(dep_prec) :: auxgrid(nclassunc)
+  real(sp) :: gridtotal,gridsigmatotal,gridtotalunc
+  real(dep_prec) :: wetgridtotal,wetgridsigmatotal,wetgridtotalunc
+  real(dep_prec) :: drygridtotal,drygridsigmatotal,drygridtotalunc
+  real :: halfheight,dz,dz1,dz2,tot_mu(maxspec,maxpointspec_act)
+  real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
+  real,parameter :: weightair=28.97
+  logical :: sp_zer
+  character :: adate*8,atime*6
+  character(len=3) :: anspec
+  logical :: lexist
+  character :: areldate*8,areltime*6
+  logical,save :: lstart=.true.
+  logical,save,allocatable,dimension(:) :: lstartrel
+  integer :: ierr
+  character(LEN=100) :: dates_char
+  integer, parameter :: unitrelnames=654
+
+
+  if(lstart) then
+    allocate(lstartrel(maxpointspec_act))
+    lstartrel(:)=.true.
+  endif
+  print*, 'lstartrel = ',lstartrel
+
+  if (verbosity.eq.1) then
+    print*,'inside concoutput_inv '
+    CALL SYSTEM_CLOCK(count_clock)
+    WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0
+  endif
+
+  ! Determine current calendar date
+  !**********************************************************
+
+  jul=bdate+real(itime,kind=dp)/86400._dp
+  call caldate(jul,jjjjmmdd,ihmmss)
+  write(adate,'(i8.8)') jjjjmmdd
+  write(atime,'(i6.6)') ihmmss
+
+
+  ! Prepare output files for dates
+  !**********************************************************
+
+  ! Overwrite existing dates file on first call, later append to it
+  ! If 'dates' file exists in output directory, copy to new file dates.old
+  inquire(file=path(2)(1:length(2))//'dates', exist=lexist)
+  if (lexist.and.lstart) then
+    ! copy contents of existing dates file to dates.old
+    print*, 'warning: replacing old dates file'
+    open(unit=unitdates, file=path(2)(1:length(2))//'dates',form='formatted', &
+         &access='sequential', status='old', action='read', iostat=ierr)
+    open(unit=unittmp, file=path(2)(1:length(2))//'dates.old', access='sequential', &
+         &status='replace', action='write', form='formatted', iostat=ierr)
+    do while (.true.)
+      read(unitdates, '(a)', iostat=ierr) dates_char
+      if (ierr.ne.0) exit
+      write(unit=unittmp, fmt='(a)', iostat=ierr, advance='yes') trim(dates_char)
+    end do
+    close(unit=unitdates)
+    close(unit=unittmp)
+    ! create new dates file
+    open(unit=unitdates, file=path(2)(1:length(2))//'dates',form='formatted', &
+         &access='sequential', status='replace', iostat=ierr)
+    close(unit=unitdates)
+  endif
+
+  open(unitdates,file=path(2)(1:length(2))//'dates', ACCESS='APPEND')
+  write(unitdates,'(a)') adate//atime
+  close(unitdates)
+
+  !CGZ: Make a filename with names of releases
+  if (lstart) then
+    open(unit=unitrelnames, file=path(2)(1:length(2))//'releases_out',form='formatted', &
+         &access='sequential', status='replace', iostat=ierr)
+    close(unitrelnames)
+  endif
+
+  print*, 'after creating dates files: lstart = ',lstart
+  !  print*, 'outnum:',outnum
+  !  print*, 'datetime:',adate//atime
+
+
+  ! For forward simulations, output fields have dimension MAXSPEC,
+  ! for backward simulations, output fields have dimension MAXPOINT.
+  ! Thus, make loops either about nspec, or about numpoint
+  !*****************************************************************
+
+
+  if (ldirect.eq.1) then
+    do ks=1,nspec
+      do kp=1,maxpointspec_act
+        tot_mu(ks,kp)=1
+      end do
+    end do
+  else
+    do ks=1,nspec
+      do kp=1,maxpointspec_act
+        tot_mu(ks,kp)=xmass(kp,ks)
+      end do
+    end do
+  endif
+
+
+  if (verbosity.eq.1) then
+    print*,'concoutput_inv 2'
+    CALL SYSTEM_CLOCK(count_clock)
+    WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0
+  endif
+
+  !*******************************************************************
+  ! Compute air density: sufficiently accurate to take it
+  ! from coarse grid at some time
+  ! Determine center altitude of output layer, and interpolate density
+  ! data to that altitude
+  !*******************************************************************
+
+  do kz=1,numzgrid
+    if (kz.eq.1) then
+      halfheight=outheight(1)/2.
+    else
+      halfheight=(outheight(kz)+outheight(kz-1))/2.
+    endif
+    do kzz=2,nz
+      if ((height(kzz-1).lt.halfheight).and. &
+           (height(kzz).gt.halfheight)) goto 46
+    end do
+46  kzz=max(min(kzz,nz),2)
+    dz1=halfheight-height(kzz-1)
+    dz2=height(kzz)-halfheight
+    dz=dz1+dz2
+    do jy=0,numygrid-1
+      do ix=0,numxgrid-1
+        xl=outlon0+real(ix)*dxout
+        yl=outlat0+real(jy)*dyout
+        xl=(xl-xlon0)/dx
+        yl=(yl-ylat0)/dy
+        iix=max(min(nint(xl),nxmin1),0)
+        jjy=max(min(nint(yl),nymin1),0)
+        densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,2)*dz1+ &
+             rho(iix,jjy,kzz-1,2)*dz2)/dz
+  ! RLT
+        densitydrygrid(ix,jy,kz)=(rho_dry(iix,jjy,kzz,2)*dz1+ &
+             rho_dry(iix,jjy,kzz-1,2)*dz2)/dz
+      end do
+    end do
+  end do
+
+  do i=1,numreceptor
+    xl=xreceptor(i)
+    yl=yreceptor(i)
+    iix=max(min(nint(xl),nxmin1),0)
+    jjy=max(min(nint(yl),nymin1),0)
+    densityoutrecept(i)=rho(iix,jjy,1,2)
+  ! RLT
+    densitydryrecept(i)=rho_dry(iix,jjy,1,2)
+  end do
+
+  ! RLT
+  ! conversion factor for output relative to dry air
+  factor_drygrid=densityoutgrid/densitydrygrid
+  factor_dryrecept=densityoutrecept/densitydryrecept
+
+  ! Output is different for forward and backward simulations
+  do kz=1,numzgrid
+    do jy=0,numygrid-1
+      do ix=0,numxgrid-1
+        if (ldirect.eq.1) then
+          factor3d(ix,jy,kz)=1.e12/volume(ix,jy,kz)/outnum
+        else
+          factor3d(ix,jy,kz)=real(abs(loutaver))/outnum
+        endif
+      end do
+    end do
+  end do
+
+  !*********************************************************************
+  ! Determine the standard deviation of the mean concentration or mixing
+  ! ratio (uncertainty of the output) and the dry and wet deposition
+  !*********************************************************************
+
+  if (verbosity.eq.1) then
+    print*,'concoutput_inv 3 (sd)'
+    CALL SYSTEM_CLOCK(count_clock)
+    WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0
+  endif
+  gridtotal=0.
+  gridsigmatotal=0.
+  gridtotalunc=0.
+  wetgridtotal=0.
+  wetgridsigmatotal=0.
+  wetgridtotalunc=0.
+  drygridtotal=0.
+  drygridsigmatotal=0.
+  drygridtotalunc=0.
+
+  do ks=1,nspec
+
+    write(anspec,'(i3.3)') ks
+
+    ! loop over releases
+    do kp=1,maxpointspec_act
+
+      print*, 'itime = ',itime
+      !print*, 'lage(1) = ',lage(1)
+      print*, 'ireleasestart(kp) = ',ireleasestart(kp)
+      print*, 'ireleaseend(kp) = ',ireleaseend(kp)
+
+      ! check itime is within release and backward trajectory length
+      if (nageclass.eq.1) then
+        if ((itime.gt.ireleaseend(kp)).or.(itime.lt.(ireleasestart(kp)-lage(1)))) then
+          go to 10
+        endif
+      endif
+
+      ! calculate date of release for filename
+      jul=bdate+real(ireleasestart(kp),kind=dp)/86400._dp    ! this is the current day
+      call caldate(jul,jjjjmmdd,ihmmss)
+      write(areldate,'(i8.8)') jjjjmmdd
+      write(areltime,'(i6.6)') ihmmss
+      print*, 'areldate/areltime = ',areldate//areltime
+
+      ! calculate date of field
+      jul=bdate+real(itime,kind=dp)/86400._dp
+      call caldate(jul,jjjjmmdd,ihmmss)
+      write(adate,'(i8.8)') jjjjmmdd
+      write(atime,'(i6.6)') ihmmss
+
+      if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
+        if (ldirect.eq.1) then
+          ! concentrations
+          inquire(file=path(2)(1:length(2))//'grid_conc_'//areldate// &
+                  areltime//'_'//anspec,exist=lexist)
+          if(lexist.and..not.lstartrel(kp)) then
+            ! open and append to existing file
+            open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_'//areldate// &
+                 areltime//'_'//anspec,form='unformatted',status='old',action='write',access='append')
+          else
+            ! open new file
+            open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_'//areldate// &
+                 areltime//'_'//anspec,form='unformatted',status='replace',action='write')
+          endif
+        else
+          ! residence times
+          inquire(file=path(2)(1:length(2))//'grid_time_'//areldate// &
+                  areltime//'_'//anspec,exist=lexist)
+          if(lexist.and..not.lstartrel(kp)) then
+            ! open and append to existing file
+            open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_'//areldate// &
+                 areltime//'_'//anspec,form='unformatted',status='old',action='write',access='append')
+          else
+            ! open new file
+            open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_'//areldate// &
+                 areltime//'_'//anspec,form='unformatted',status='replace',action='write')
+            ! add part of the filename to a file (similar to dates) for easier post-processing
+            open(unit=unitrelnames, file=path(2)(1:length(2))//'releases_out',form='formatted', &
+                 & access='APPEND', iostat=ierr)
+            write(unitrelnames,'(a)') areldate//areltime//'_'//anspec
+            close(unitrelnames)
+          endif
+        endif
+        write(unitoutgrid) jjjjmmdd
+        write(unitoutgrid) ihmmss
+      endif
+
+      if ((iout.eq.2).or.(iout.eq.3)) then
+        ! mixing ratio
+        inquire(file=path(2)(1:length(2))//'grid_pptv_'//areldate// &
+                areltime//'_'//anspec,exist=lexist)
+        if(lexist.and..not.lstartrel(kp)) then
+          ! open and append to existing file
+          open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_'//areldate// &
+               areltime//'_'//anspec,form='unformatted',status='old',action='write',access='append')
+        else
+          ! open new file
+          open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_'//areldate// &
+               areltime//'_'//anspec,form='unformatted',status='replace',action='write')
+        endif
+        write(unitoutgridppt) jjjjmmdd
+        write(unitoutgridppt) ihmmss
+      endif
+
+      lstartrel(kp)=.false.
+
+      do nage=1,nageclass
+
+        do jy=0,numygrid-1
+          do ix=0,numxgrid-1
+
+  ! CONCENTRATION OR MIXING RATIO
+            do kz=1,numzgrid
+              do l=1,nclassunc
+                auxgrid(l)=gridunc(ix,jy,kz,ks,kp,l,nage)
+              end do
+              call mean(auxgrid,grid(ix,jy,kz), &
+                   gridsigma(ix,jy,kz),nclassunc)
+  ! Multiply by number of classes to get total concentration
+              grid(ix,jy,kz)= &
+                   grid(ix,jy,kz)*nclassunc
+              gridtotal=gridtotal+grid(ix,jy,kz)
+  ! Calculate standard deviation of the mean
+              gridsigma(ix,jy,kz)= &
+                   gridsigma(ix,jy,kz)* &
+                   sqrt(real(nclassunc))
+              gridsigmatotal=gridsigmatotal+ &
+                   gridsigma(ix,jy,kz)
+            end do
+          end do
+        end do
+
+
+  !*******************************************************************
+  ! Generate output: may be in concentration (ng/m3) or in mixing
+  ! ratio (ppt) or both
+  ! Output the position and the values alternated multiplied by
+  ! 1 or -1, first line is number of values, number of positions
+  ! For backward simulations, the unit is seconds, stored in grid_time
+  !*******************************************************************
+
+        if (verbosity.eq.1) then
+          print*,'concoutput_inv 4 (output)'
+          CALL SYSTEM_CLOCK(count_clock)
+          WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0
+        endif
+
+  ! Concentration output
+  !*********************
+
+        if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
+
+          if (verbosity.eq.1) then
+            print*,'concoutput_inv (Wet deposition)'
+            CALL SYSTEM_CLOCK(count_clock)
+            WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0
+          endif
+
+          if (verbosity.eq.1) then
+            print*,'concoutput_inv (Concentrations)'
+            CALL SYSTEM_CLOCK(count_clock)
+            WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0
+          endif
+
+  ! Concentrations
+
+  ! surf_only write only 1st layer
+
+          sp_count_i=0
+          sp_count_r=0
+          sp_fact=-1.
+          sp_zer=.true.
+          do kz=1,1
+            do jy=0,numygrid-1
+              do ix=0,numxgrid-1
+                if (grid(ix,jy,kz).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)= &
+                         ix+jy*numxgrid+kz*numxgrid*numygrid
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                  endif
+                  sp_count_r=sp_count_r+1
+                  sparse_dump_r(sp_count_r)= &
+                       sp_fact* &
+                       grid(ix,jy,kz)* &
+                       factor3d(ix,jy,kz)/tot_mu(ks,kp)
+                  sparse_dump_u(sp_count_r)= &
+                       gridsigma(ix,jy,kz)* &
+                       factor3d(ix,jy,kz)/tot_mu(ks,kp)
+
+                else ! concentration is zero
+                  sp_zer=.true.
+                endif
+              end do
+            end do
+          end do
+          write(unitoutgrid) sp_count_i
+          write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
+          write(unitoutgrid) sp_count_r
+          write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
+
+        endif !  concentration output
+
+  ! Mixing ratio output
+  !********************
+
+        if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
+
+  ! Mixing ratios
+
+  ! surf_only write only 1st layer
+
+          sp_count_i=0
+          sp_count_r=0
+          sp_fact=-1.
+          sp_zer=.true.
+          do kz=1,1
+            do jy=0,numygrid-1
+              do ix=0,numxgrid-1
+                if (grid(ix,jy,kz).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)= &
+                         ix+jy*numxgrid+kz*numxgrid*numygrid
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                  endif
+                  sp_count_r=sp_count_r+1
+                  sparse_dump_r(sp_count_r)= &
+                       sp_fact* &
+                       1.e12*grid(ix,jy,kz) &
+                       /volume(ix,jy,kz)/outnum* &
+                       weightair/weightmolar(ks)/densityoutgrid(ix,jy,kz)
+                  sparse_dump_u(sp_count_r)= &
+                       1.e12*gridsigma(ix,jy,kz)/volume(ix,jy,kz)/ &
+                       outnum*weightair/weightmolar(ks)/ &
+                       densityoutgrid(ix,jy,kz)
+                else ! concentration is zero
+                  sp_zer=.true.
+                endif
+              end do
+            end do
+          end do
+          write(unitoutgridppt) sp_count_i
+          write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
+          write(unitoutgridppt) sp_count_r
+          write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
+
+        endif ! output for ppt
+
+      end do  ! nageclass
+
+      close(unitoutgridppt)
+      close(unitoutgrid)
+
+      ! itime is outside range
+10    continue
+
+    end do  ! maxpointspec_act
+
+  end do  ! nspec
+
+  ! RLT Aug 2017
+  ! Write out conversion factor for dry air
+  inquire(file=path(2)(1:length(2))//'factor_drygrid',exist=lexist)
+  if (lexist.and..not.lstart) then
+    ! open and append
+    open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid',form='unformatted',&
+            status='old',action='write',access='append')
+  else
+    ! create new
+    open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid',form='unformatted',&
+            status='replace',action='write')
+  endif
+  sp_count_i=0
+  sp_count_r=0
+  sp_fact=-1.
+  sp_zer=.true.
+  do kz=1,1
+    do jy=0,numygrid-1
+      do ix=0,numxgrid-1
+        if (factor_drygrid(ix,jy,kz).gt.(1.+smallnum).or.factor_drygrid(ix,jy,kz).lt.(1.-smallnum)) then
+          if (sp_zer.eqv..true.) then ! first value not equal to one
+            sp_count_i=sp_count_i+1
+            sparse_dump_i(sp_count_i)= &
+                  ix+jy*numxgrid+kz*numxgrid*numygrid
+            sp_zer=.false.
+            sp_fact=sp_fact*(-1.)
+          endif
+          sp_count_r=sp_count_r+1
+          sparse_dump_r(sp_count_r)= &
+               sp_fact*factor_drygrid(ix,jy,kz)
+        else ! factor is one
+          sp_zer=.true.
+        endif
+      end do
+    end do
+  end do
+  write(unitoutfactor) sp_count_i
+  write(unitoutfactor) (sparse_dump_i(i),i=1,sp_count_i)
+  write(unitoutfactor) sp_count_r
+  write(unitoutfactor) (sparse_dump_r(i),i=1,sp_count_r)
+  close(unitoutfactor)
+
+
+  if (gridtotal.gt.0.) gridtotalunc=gridsigmatotal/gridtotal
+
+  ! Dump of receptor concentrations
+
+  if (numreceptor.gt.0 .and. (iout.eq.2 .or. iout.eq.3)  ) then
+    write(unitoutreceptppt) itime
+    do ks=1,nspec
+      write(unitoutreceptppt) (1.e12*creceptor(i,ks)/outnum* &
+           weightair/weightmolar(ks)/densityoutrecept(i),i=1,numreceptor)
+    end do
+  endif
+
+  ! Dump of receptor concentrations
+
+  if (numreceptor.gt.0) then
+    write(unitoutrecept) itime
+    do ks=1,nspec
+      write(unitoutrecept) (1.e12*creceptor(i,ks)/outnum, &
+           i=1,numreceptor)
+    end do
+  endif
+
+  ! RLT Aug 2017
+  ! Write out conversion factor for dry air
+  if (numreceptor.gt.0) then
+    inquire(file=path(2)(1:length(2))//'factor_dryreceptor',exist=lexist)
+     if (lexist.and..not.lstart) then
+     ! open and append
+      open(unitoutfactor,file=path(2)(1:length(2))//'factor_dryreceptor',form='unformatted',&
+              status='old',action='write',access='append')
+    else
+      ! create new
+      open(unitoutfactor,file=path(2)(1:length(2))//'factor_dryreceptor',form='unformatted',&
+              status='replace',action='write')
+    endif
+    write(unitoutfactor) itime
+    write(unitoutfactor) (factor_dryrecept(i),i=1,numreceptor)
+    close(unitoutfactor)
+  endif
+
+  ! reset lstart
+  if (lstart) then
+    lstart=.false.
+  endif
+  print*, 'after writing output files: lstart = ',lstart
+
+
+  ! Reinitialization of grid
+  !*************************
+
+  do ks=1,nspec
+    do kp=1,maxpointspec_act
+      do i=1,numreceptor
+        creceptor(i,ks)=0.
+      end do
+      do jy=0,numygrid-1
+        do ix=0,numxgrid-1
+          do l=1,nclassunc
+            do nage=1,nageclass
+              do kz=1,numzgrid
+                gridunc(ix,jy,kz,ks,kp,l,nage)=0.
+              end do
+            end do
+          end do
+        end do
+      end do
+    end do
+  end do
+end subroutine concoutput_inv
diff --git a/src/bin_concoutput_inv_nest.f90 b/src/bin_concoutput_inv_nest.f90
new file mode 100644
index 0000000000000000000000000000000000000000..6fb2175d07c52f44a25f46fee1a8577aa4e86fb4
--- /dev/null
+++ b/src/bin_concoutput_inv_nest.f90
@@ -0,0 +1,468 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine concoutput_inv_nest(itime,outnum)
+  !                        i     i
+  !*****************************************************************************
+  !                                                                            *
+  !     Output of the concentration grid and the receptor concentrations.      *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     24 May 1995                                                            *
+  !                                                                            *
+  !     13 April 1999, Major update: if output size is smaller, dump output    *
+  !                    in sparse matrix format; additional output of           *
+  !                    uncertainty                                             *
+  !                                                                            *
+  !     05 April 2000, Major update: output of age classes; output for backward*
+  !                    runs is time spent in grid cell times total mass of     *
+  !                    species.                                                *
+  !                                                                            *
+  !     17 February 2002, Appropriate dimensions for backward and forward runs *
+  !                       are now specified in file par_mod                    *
+  !                                                                            *
+  !     June 2006, write grid in sparse matrix with a single write command     *
+  !                in order to save disk space                                 *
+  !                                                                            *
+  !     2008 new sparse matrix format                                          *
+  !
+  !     January 2017,  Separate files by release but include all timesteps     *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! outnum          number of samples                                          *
+  ! ncells          number of cells with non-zero concentrations               *
+  ! sparse          .true. if in sparse matrix format, else .false.            *
+  ! tot_mu          1 for forward, initial mass mixing ration for backw. runs  *
+  !                                                                            *
+  !*****************************************************************************
+
+  use unc_mod
+  use mean_mod
+
+  implicit none
+
+  real(kind=dp) :: jul
+  integer :: itime,i,ix,jy,kz,ks,kp,l,iix,jjy,kzz,nage,jjjjmmdd,ihmmss
+  integer :: sp_count_i,sp_count_r
+  real :: sp_fact
+  real :: outnum,densityoutrecept(maxreceptor),xl,yl
+  ! RLT
+  real :: densitydryrecept(maxreceptor)
+  real :: factor_dryrecept(maxreceptor)
+
+  real(dep_prec) :: auxgrid(nclassunc)
+  real :: halfheight,dz,dz1,dz2,tot_mu(maxspec,maxpointspec_act)
+  real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
+  real,parameter :: weightair=28.97
+  logical :: sp_zer
+  logical,save :: lnstart=.true.
+  logical,save,allocatable,dimension(:) :: lnstartrel
+  character :: adate*8,atime*6
+  character(len=3) :: anspec
+  logical :: lexist
+  character :: areldate*8,areltime*6
+
+  if(lnstart) then
+    allocate(lnstartrel(maxpointspec_act))
+    lnstartrel(:)=.true.
+  endif
+  print*, 'lnstartrel = ',lnstartrel
+
+  ! Determine current calendar date, needed for the file name
+  !**********************************************************
+
+  jul=bdate+real(itime,kind=dp)/86400._dp
+  call caldate(jul,jjjjmmdd,ihmmss)
+  write(adate,'(i8.8)') jjjjmmdd
+  write(atime,'(i6.6)') ihmmss
+
+  print*, 'outnum:',outnum
+  print*, 'datetime:',adate//atime
+
+  ! For forward simulations, output fields have dimension MAXSPEC,
+  ! for backward simulations, output fields have dimension MAXPOINT.
+  ! Thus, make loops either about nspec, or about numpoint
+  !*****************************************************************
+
+
+    if (ldirect.eq.1) then
+       do ks=1,nspec
+         do kp=1,maxpointspec_act
+           tot_mu(ks,kp)=1
+         end do
+       end do
+   else
+      do ks=1,nspec
+             do kp=1,maxpointspec_act
+               tot_mu(ks,kp)=xmass(kp,ks)
+             end do
+      end do
+    endif
+
+
+  !*******************************************************************
+  ! Compute air density: sufficiently accurate to take it
+  ! from coarse grid at some time
+  ! Determine center altitude of output layer, and interpolate density
+  ! data to that altitude
+  !*******************************************************************
+
+  do kz=1,numzgrid
+    if (kz.eq.1) then
+      halfheight=outheight(1)/2.
+    else
+      halfheight=(outheight(kz)+outheight(kz-1))/2.
+    endif
+    do kzz=2,nz
+      if ((height(kzz-1).lt.halfheight).and. &
+           (height(kzz).gt.halfheight)) goto 46
+    end do
+46   kzz=max(min(kzz,nz),2)
+    dz1=halfheight-height(kzz-1)
+    dz2=height(kzz)-halfheight
+    dz=dz1+dz2
+    do jy=0,numygridn-1
+      do ix=0,numxgridn-1
+        xl=outlon0n+real(ix)*dxoutn
+        yl=outlat0n+real(jy)*dyoutn
+        xl=(xl-xlon0)/dx
+        yl=(yl-ylat0)/dy
+        iix=max(min(nint(xl),nxmin1),0)
+        jjy=max(min(nint(yl),nymin1),0)
+        densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,2)*dz1+ &
+             rho(iix,jjy,kzz-1,2)*dz2)/dz
+  ! RLT
+        densitydrygrid(ix,jy,kz)=(rho_dry(iix,jjy,kzz,2)*dz1+ &
+             rho_dry(iix,jjy,kzz-1,2)*dz2)/dz
+      end do
+    end do
+  end do
+
+  do i=1,numreceptor
+    xl=xreceptor(i)
+    yl=yreceptor(i)
+    iix=max(min(nint(xl),nxmin1),0)
+    jjy=max(min(nint(yl),nymin1),0)
+    densityoutrecept(i)=rho(iix,jjy,1,2)
+  ! RLT
+    densitydryrecept(i)=rho_dry(iix,jjy,1,2)
+  end do
+
+  ! RLT
+  ! conversion factor for output relative to dry air
+  factor_drygrid=densityoutgrid/densitydrygrid
+  factor_dryrecept=densityoutrecept/densitydryrecept
+
+  ! Output is different for forward and backward simulations
+    do kz=1,numzgrid
+      do jy=0,numygridn-1
+        do ix=0,numxgridn-1
+          if (ldirect.eq.1) then
+            factor3d(ix,jy,kz)=1.e12/volumen(ix,jy,kz)/outnum
+          else
+            factor3d(ix,jy,kz)=real(abs(loutaver))/outnum
+          endif
+        end do
+      end do
+    end do
+
+  !*********************************************************************
+  ! Determine the standard deviation of the mean concentration or mixing
+  ! ratio (uncertainty of the output) and the dry and wet deposition
+  !*********************************************************************
+
+  do ks=1,nspec
+
+  write(anspec,'(i3.3)') ks
+
+    do kp=1,maxpointspec_act
+
+      print*, 'itime = ',itime
+      print*, 'lage(1) = ',lage(1)
+      print*, 'ireleasestart(kp) = ',ireleasestart(kp)
+      print*, 'ireleaseend(kp) = ',ireleaseend(kp)
+
+      ! check itime is within release and backward trajectory length
+      if (nageclass.eq.1) then
+        if ((itime.gt.ireleaseend(kp)).or.(itime.lt.(ireleasestart(kp)-lage(1)))) then
+          go to 10
+        endif
+      endif
+
+      ! calculate date of release
+      jul=bdate+real(ireleasestart(kp),kind=dp)/86400._dp    ! this is the current day
+      call caldate(jul,jjjjmmdd,ihmmss)
+      write(areldate,'(i8.8)') jjjjmmdd
+      write(areltime,'(i6.6)') ihmmss
+      print*, areldate//areltime
+
+      ! calculate date of field
+      jul=bdate+real(itime,kind=dp)/86400._dp
+      call caldate(jul,jjjjmmdd,ihmmss)
+      write(adate,'(i8.8)') jjjjmmdd
+      write(atime,'(i6.6)') ihmmss
+      print*, adate//atime
+
+      if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
+        if (ldirect.eq.1) then
+          ! concentrations
+          inquire(file=path(2)(1:length(2))//'grid_conc_nest_'//areldate// &
+                  areltime//'_'//anspec,exist=lexist)
+          if(lexist.and..not.lnstartrel(kp)) then
+            ! open and append to existing file
+            open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_nest_'//areldate// &
+                 areltime//'_'//anspec,form='unformatted',status='old',action='write',access='append')
+          else
+            ! open new file
+            open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_nest_'//areldate// &
+                 areltime//'_'//anspec,form='unformatted',status='replace',action='write')
+          endif
+        else
+          ! residence times
+          inquire(file=path(2)(1:length(2))//'grid_time_nest_'//areldate// &
+                  areltime//'_'//anspec,exist=lexist)
+          if(lexist.and..not.lnstartrel(kp)) then
+            ! open and append to existing file
+            open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_nest_'//areldate// &
+                 areltime//'_'//anspec,form='unformatted',status='old',action='write',access='append')
+          else
+            ! open new file
+            open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_nest_'//areldate// &
+                 areltime//'_'//anspec,form='unformatted',status='replace',action='write')
+          endif
+        endif
+        write(unitoutgrid) jjjjmmdd
+        write(unitoutgrid) ihmmss
+      endif
+
+      if ((iout.eq.2).or.(iout.eq.3)) then
+        ! mixing ratio
+        inquire(file=path(2)(1:length(2))//'grid_pptv_nest_'//areldate// &
+                areltime//'_'//anspec,exist=lexist)
+        if(lexist.and..not.lnstartrel(kp)) then
+          ! open and append to existing file
+          open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_nest_'//areldate// &
+               areltime//'_'//anspec,form='unformatted',status='old',action='write',access='append')
+        else
+          ! open new file
+          open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_nest_'//areldate// &
+               areltime//'_'//anspec,form='unformatted',status='replace',action='write')
+        endif
+        write(unitoutgridppt) jjjjmmdd
+        write(unitoutgridppt) ihmmss
+      endif
+
+      lnstartrel(kp)=.false.
+
+      do nage=1,nageclass
+
+        do jy=0,numygridn-1
+          do ix=0,numxgridn-1
+
+  ! CONCENTRATION OR MIXING RATIO
+            do kz=1,numzgrid
+              do l=1,nclassunc
+                auxgrid(l)=griduncn(ix,jy,kz,ks,kp,l,nage)
+              end do
+              call mean(auxgrid,grid(ix,jy,kz), &
+                     gridsigma(ix,jy,kz),nclassunc)
+  ! Multiply by number of classes to get total concentration
+              grid(ix,jy,kz)= &
+                   grid(ix,jy,kz)*nclassunc
+  ! Calculate standard deviation of the mean
+              gridsigma(ix,jy,kz)= &
+                   gridsigma(ix,jy,kz)* &
+                   sqrt(real(nclassunc))
+            end do
+          end do
+        end do
+
+
+  !*******************************************************************
+  ! Generate output: may be in concentration (ng/m3) or in mixing
+  ! ratio (ppt) or both
+  ! Output the position and the values alternated multiplied by
+  ! 1 or -1, first line is number of values, number of positions
+  ! For backward simulations, the unit is seconds, stored in grid_time
+  !*******************************************************************
+
+  ! Concentration output
+  !*********************
+
+        if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
+
+  ! Concentrations
+
+  ! surf_only write only 1st layer
+
+         sp_count_i=0
+         sp_count_r=0
+         sp_fact=-1.
+         sp_zer=.true.
+          do kz=1,1
+            do jy=0,numygridn-1
+              do ix=0,numxgridn-1
+                if (grid(ix,jy,kz).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)= &
+                         ix+jy*numxgridn+kz*numxgridn*numygridn
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                   endif
+                   sp_count_r=sp_count_r+1
+                   sparse_dump_r(sp_count_r)= &
+                        sp_fact* &
+                        grid(ix,jy,kz)* &
+                        factor3d(ix,jy,kz)/tot_mu(ks,kp)
+  !                 if ((factor(ix,jy,kz)/tot_mu(ks,kp)).eq.0)
+  !    +              write (*,*) factor(ix,jy,kz),tot_mu(ks,kp),ks,kp
+                   sparse_dump_u(sp_count_r)= &
+                        gridsigma(ix,jy,kz)* &
+                        factor3d(ix,jy,kz)/tot_mu(ks,kp)
+              else ! concentration is zero
+                  sp_zer=.true.
+              endif
+              end do
+            end do
+          end do
+         write(unitoutgrid) sp_count_i
+         write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
+         write(unitoutgrid) sp_count_r
+         write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
+
+      endif !  concentration output
+
+  ! Mixing ratio output
+  !********************
+
+      if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
+
+
+  ! Mixing ratios
+
+    ! surf_only write only 1st layer
+
+         sp_count_i=0
+         sp_count_r=0
+         sp_fact=-1.
+         sp_zer=.true.
+          do kz=1,1
+            do jy=0,numygridn-1
+              do ix=0,numxgridn-1
+                if (grid(ix,jy,kz).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)= &
+                         ix+jy*numxgridn+kz*numxgridn*numygridn
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                 endif
+                 sp_count_r=sp_count_r+1
+                 sparse_dump_r(sp_count_r)= &
+                      sp_fact* &
+                      1.e12*grid(ix,jy,kz) &
+                      /volumen(ix,jy,kz)/outnum* &
+                      weightair/weightmolar(ks)/densityoutgrid(ix,jy,kz)
+                 sparse_dump_u(sp_count_r)= &
+                      1.e12*gridsigma(ix,jy,kz)/volumen(ix,jy,kz)/ &
+                      outnum*weightair/weightmolar(ks)/ &
+                      densityoutgrid(ix,jy,kz)
+              else ! concentration is zero
+                  sp_zer=.true.
+              endif
+              end do
+            end do
+          end do
+          write(unitoutgridppt) sp_count_i
+          write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
+          write(unitoutgridppt) sp_count_r
+          write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
+
+        endif ! output for ppt
+
+      end do ! nageclass
+
+      close(unitoutgridppt)
+      close(unitoutgrid)
+
+      ! itime is outside range
+10    continue
+
+    end do ! maxpointspec_act
+
+  end do ! nspec
+
+
+  ! RLT Aug 2017
+  ! Write out conversion factor for dry air
+  inquire(file=path(2)(1:length(2))//'factor_drygrid_nest',exist=lexist)
+  if (lexist.and..not.lnstart) then
+    ! open and append
+    open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid_nest',form='unformatted',&
+            status='old',action='write',access='append')
+  else
+    ! create new
+    open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid_nest',form='unformatted',&
+            status='replace',action='write')
+  endif
+  sp_count_i=0
+  sp_count_r=0
+  sp_fact=-1.
+  sp_zer=.true.
+  do kz=1,1
+    do jy=0,numygridn-1
+      do ix=0,numxgridn-1
+        if (factor_drygrid(ix,jy,kz).gt.(1.+smallnum).or.factor_drygrid(ix,jy,kz).lt.(1.-smallnum)) then
+          if (sp_zer.eqv..true.) then ! first value not equal to one
+            sp_count_i=sp_count_i+1
+            sparse_dump_i(sp_count_i)= &
+                  ix+jy*numxgridn+kz*numxgridn*numygridn
+            sp_zer=.false.
+            sp_fact=sp_fact*(-1.)
+          endif
+          sp_count_r=sp_count_r+1
+          sparse_dump_r(sp_count_r)= &
+               sp_fact*factor_drygrid(ix,jy,kz)
+        else ! factor is one
+          sp_zer=.true.
+        endif
+      end do
+    end do
+  end do
+  write(unitoutfactor) sp_count_i
+  write(unitoutfactor) (sparse_dump_i(i),i=1,sp_count_i)
+  write(unitoutfactor) sp_count_r
+  write(unitoutfactor) (sparse_dump_r(i),i=1,sp_count_r)
+  close(unitoutfactor)
+
+  ! reset lnstart
+  if (lnstart) then
+    lnstart=.false.
+  endif
+
+  ! Reinitialization of grid
+  !*************************
+
+  do ks=1,nspec
+  do kp=1,maxpointspec_act
+    do i=1,numreceptor
+      creceptor(i,ks)=0.
+    end do
+    do jy=0,numygridn-1
+      do ix=0,numxgridn-1
+        do l=1,nclassunc
+          do nage=1,nageclass
+            do kz=1,numzgrid
+              griduncn(ix,jy,kz,ks,kp,l,nage)=0.
+            end do
+          end do
+        end do
+      end do
+    end do
+  end do
+  end do
+end subroutine concoutput_inv_nest
diff --git a/src/bin_concoutput_nest.f90 b/src/bin_concoutput_nest.f90
new file mode 100644
index 0000000000000000000000000000000000000000..edfd98621c4bc0b21ad0cf64b8e863b90bc38f04
--- /dev/null
+++ b/src/bin_concoutput_nest.f90
@@ -0,0 +1,586 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine concoutput_nest(itime,outnum)
+  !                        i     i
+  !*****************************************************************************
+  !                                                                            *
+  !     Output of the concentration grid and the receptor concentrations.      *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     24 May 1995                                                            *
+  !                                                                            *
+  !     13 April 1999, Major update: if output size is smaller, dump output    *
+  !                    in sparse matrix format; additional output of           *
+  !                    uncertainty                                             *
+  !                                                                            *
+  !     05 April 2000, Major update: output of age classes; output for backward*
+  !                    runs is time spent in grid cell times total mass of     *
+  !                    species.                                                *
+  !                                                                            *
+  !     17 February 2002, Appropriate dimensions for backward and forward runs *
+  !                       are now specified in file par_mod                    *
+  !                                                                            *
+  !     June 2006, write grid in sparse matrix with a single write command     *
+  !                in order to save disk space                                 *
+  !                                                                            *
+  !     2008 new sparse matrix format                                          *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! outnum          number of samples                                          *
+  ! ncells          number of cells with non-zero concentrations               *
+  ! sparse          .true. if in sparse matrix format, else .false.            *
+  ! tot_mu          1 for forward, initial mass mixing ration for backw. runs  *
+  !                                                                            *
+  !*****************************************************************************
+  use unc_mod
+  use mean_mod
+
+  implicit none
+
+  real(kind=dp) :: jul
+  integer :: itime,i,ix,jy,kz,ks,kp,l,iix,jjy,kzz,nage,jjjjmmdd,ihmmss
+  integer :: sp_count_i,sp_count_r
+  real :: sp_fact
+  real :: outnum,densityoutrecept(maxreceptor),xl,yl
+  ! RLT
+  real :: densitydryrecept(maxreceptor)
+  real :: factor_dryrecept(maxreceptor)
+
+  !real densityoutgrid(0:numxgrid-1,0:numygrid-1,numzgrid),
+  !    +grid(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec,maxpointspec_act,
+  !    +    maxageclass)
+  !real wetgrid(0:numxgrid-1,0:numygrid-1,maxspec,maxpointspec_act,
+  !    +       maxageclass)
+  !real drygrid(0:numxgrid-1,0:numygrid-1,maxspec,
+  !    +       maxpointspec_act,maxageclass)
+  !real gridsigma(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec,
+  !    +       maxpointspec_act,maxageclass),
+  !    +     drygridsigma(0:numxgrid-1,0:numygrid-1,maxspec,
+  !    +     maxpointspec_act,maxageclass),
+  !    +     wetgridsigma(0:numxgrid-1,0:numygrid-1,maxspec,
+  !    +     maxpointspec_act,maxageclass)
+  !real factor(0:numxgrid-1,0:numygrid-1,numzgrid)
+  !real sparse_dump_r(numxgrid*numygrid*numzgrid)
+  !integer sparse_dump_i(numxgrid*numygrid*numzgrid)
+
+  !real sparse_dump_u(numxgrid*numygrid*numzgrid)
+  real(dep_prec) :: auxgrid(nclassunc)
+  real :: halfheight,dz,dz1,dz2,tot_mu(maxspec,maxpointspec_act)
+  real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
+  real,parameter :: weightair=28.97
+  logical :: sp_zer
+  character :: adate*8,atime*6
+  character(len=3) :: anspec
+  logical :: lexist
+  integer :: mind
+
+
+  ! Determine current calendar date, needed for the file name
+  !**********************************************************
+
+  jul=bdate+real(itime,kind=dp)/86400._dp
+  call caldate(jul,jjjjmmdd,ihmmss)
+  write(adate,'(i8.8)') jjjjmmdd
+  write(atime,'(i6.6)') ihmmss
+
+
+  ! For forward simulations, output fields have dimension MAXSPEC,
+  ! for backward simulations, output fields have dimension MAXPOINT.
+  ! Thus, make loops either about nspec, or about numpoint
+  !*****************************************************************
+
+
+    if (ldirect.eq.1) then
+       do ks=1,nspec
+         do kp=1,maxpointspec_act
+           tot_mu(ks,kp)=1
+         end do
+       end do
+   else
+      do ks=1,nspec
+             do kp=1,maxpointspec_act
+               tot_mu(ks,kp)=xmass(kp,ks)
+             end do
+      end do
+    endif
+
+
+  !*******************************************************************
+  ! Compute air density: sufficiently accurate to take it
+  ! from coarse grid at some time
+  ! Determine center altitude of output layer, and interpolate density
+  ! data to that altitude
+  !*******************************************************************
+
+  mind=memind(2)
+  do kz=1,numzgrid
+    if (kz.eq.1) then
+      halfheight=outheight(1)/2.
+    else
+      halfheight=(outheight(kz)+outheight(kz-1))/2.
+    endif
+    do kzz=2,nz
+      if ((height(kzz-1).lt.halfheight).and. &
+           (height(kzz).gt.halfheight)) goto 46
+    end do
+46   kzz=max(min(kzz,nz),2)
+    dz1=halfheight-height(kzz-1)
+    dz2=height(kzz)-halfheight
+    dz=dz1+dz2
+    do jy=0,numygridn-1
+      do ix=0,numxgridn-1
+        xl=outlon0n+real(ix)*dxoutn
+        yl=outlat0n+real(jy)*dyoutn
+        xl=(xl-xlon0)/dx
+        yl=(yl-ylat0)/dy
+        iix=max(min(nint(xl),nxmin1),0)
+        jjy=max(min(nint(yl),nymin1),0)
+        ! densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,2)*dz1+ &
+        !      rho(iix,jjy,kzz-1,2)*dz2)/dz
+        densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,mind)*dz1+ &
+             rho(iix,jjy,kzz-1,mind)*dz2)/dz
+  ! RLT
+        densitydrygrid(ix,jy,kz)=(rho_dry(iix,jjy,kzz,mind)*dz1+ &
+             rho_dry(iix,jjy,kzz-1,mind)*dz2)/dz
+      end do
+    end do
+  end do
+
+  do i=1,numreceptor
+    xl=xreceptor(i)
+    yl=yreceptor(i)
+    iix=max(min(nint(xl),nxmin1),0)
+    jjy=max(min(nint(yl),nymin1),0)
+    !densityoutrecept(i)=rho(iix,jjy,1,2)
+    densityoutrecept(i)=rho(iix,jjy,1,mind)
+  ! RLT
+    densitydryrecept(i)=rho_dry(iix,jjy,1,mind)
+  end do
+
+  ! RLT
+  ! conversion factor for output relative to dry air
+  factor_drygrid=densityoutgrid/densitydrygrid
+  factor_dryrecept=densityoutrecept/densitydryrecept
+
+  ! Output is different for forward and backward simulations
+    do kz=1,numzgrid
+      do jy=0,numygridn-1
+        do ix=0,numxgridn-1
+          if (ldirect.eq.1) then
+            factor3d(ix,jy,kz)=1.e12/volumen(ix,jy,kz)/outnum
+          else
+            factor3d(ix,jy,kz)=real(abs(loutaver))/outnum
+          endif
+        end do
+      end do
+    end do
+
+  !*********************************************************************
+  ! Determine the standard deviation of the mean concentration or mixing
+  ! ratio (uncertainty of the output) and the dry and wet deposition
+  !*********************************************************************
+
+  do ks=1,nspec
+
+  write(anspec,'(i3.3)') ks
+
+  if (DRYBKDEP.or.WETBKDEP) then !scavdep output
+      if (DRYBKDEP) &
+      open(unitoutgrid,file=path(2)(1:length(2))//'grid_drydep_nest_'//adate// &
+           atime//'_'//anspec,form='unformatted')
+      if (WETBKDEP) &
+      open(unitoutgrid,file=path(2)(1:length(2))//'grid_wetdep_nest_'//adate// &
+           atime//'_'//anspec,form='unformatted')
+      write(unitoutgrid) itime
+  else
+     if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
+       if (ldirect.eq.1) then
+         open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_nest_' &
+           //adate// &
+           atime//'_'//anspec,form='unformatted')
+       else
+         open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_nest_' &
+           //adate// &
+           atime//'_'//anspec,form='unformatted')
+       endif
+       write(unitoutgrid) itime
+     endif
+  endif
+
+  if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
+   open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_nest_' &
+        //adate// &
+        atime//'_'//anspec,form='unformatted')
+
+    write(unitoutgridppt) itime
+  endif
+
+  do kp=1,maxpointspec_act
+  do nage=1,nageclass
+
+    do jy=0,numygridn-1
+      do ix=0,numxgridn-1
+
+  ! WET DEPOSITION
+        if ((WETDEP).and.(ldirect.gt.0)) then
+            do l=1,nclassunc
+              auxgrid(l)=wetgriduncn(ix,jy,ks,kp,l,nage)
+            end do
+            call mean(auxgrid,wetgrid(ix,jy), &
+                 wetgridsigma(ix,jy),nclassunc)
+  ! Multiply by number of classes to get total concentration
+            wetgrid(ix,jy)=wetgrid(ix,jy) &
+                 *nclassunc
+  ! Calculate standard deviation of the mean
+            wetgridsigma(ix,jy)= &
+                 wetgridsigma(ix,jy)* &
+                 sqrt(real(nclassunc))
+        endif
+
+  ! DRY DEPOSITION
+        if ((DRYDEP).and.(ldirect.gt.0)) then
+            do l=1,nclassunc
+              auxgrid(l)=drygriduncn(ix,jy,ks,kp,l,nage)
+            end do
+            call mean(auxgrid,drygrid(ix,jy), &
+                 drygridsigma(ix,jy),nclassunc)
+  ! Multiply by number of classes to get total concentration
+            drygrid(ix,jy)=drygrid(ix,jy)* &
+                 nclassunc
+  ! Calculate standard deviation of the mean
+            drygridsigma(ix,jy)= &
+                 drygridsigma(ix,jy)* &
+                 sqrt(real(nclassunc))
+        endif
+
+  ! CONCENTRATION OR MIXING RATIO
+        do kz=1,numzgrid
+            do l=1,nclassunc
+              auxgrid(l)=griduncn(ix,jy,kz,ks,kp,l,nage)
+            end do
+            call mean(auxgrid,grid(ix,jy,kz), &
+                 gridsigma(ix,jy,kz),nclassunc)
+  ! Multiply by number of classes to get total concentration
+            grid(ix,jy,kz)= &
+                 grid(ix,jy,kz)*nclassunc
+  ! Calculate standard deviation of the mean
+            gridsigma(ix,jy,kz)= &
+                 gridsigma(ix,jy,kz)* &
+                 sqrt(real(nclassunc))
+        end do
+      end do
+    end do
+
+
+  !*******************************************************************
+  ! Generate output: may be in concentration (ng/m3) or in mixing
+  ! ratio (ppt) or both
+  ! Output the position and the values alternated multiplied by
+  ! 1 or -1, first line is number of values, number of positions
+  ! For backward simulations, the unit is seconds, stored in grid_time
+  !*******************************************************************
+
+  ! Concentration output
+  !*********************
+  if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
+
+  ! Wet deposition
+         sp_count_i=0
+         sp_count_r=0
+         sp_fact=-1.
+         sp_zer=.true.
+         if ((ldirect.eq.1).and.(WETDEP)) then
+         do jy=0,numygridn-1
+            do ix=0,numxgridn-1
+  !oncentraion greater zero
+              if (wetgrid(ix,jy).gt.smallnum) then
+                 if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)=ix+jy*numxgridn
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                 endif
+                 sp_count_r=sp_count_r+1
+                 sparse_dump_r(sp_count_r)= &
+                      sp_fact*1.e12*wetgrid(ix,jy)/arean(ix,jy)
+  !                sparse_dump_u(sp_count_r)=
+  !+                1.e12*wetgridsigma(ix,jy,ks,kp,nage)/area(ix,jy)
+              else ! concentration is zero
+                  sp_zer=.true.
+              endif
+            end do
+         end do
+         else
+            sp_count_i=0
+            sp_count_r=0
+         endif
+         write(unitoutgrid) sp_count_i
+         write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
+         write(unitoutgrid) sp_count_r
+         write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
+  !       write(unitoutgrid) sp_count_u
+  !       write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)
+
+  ! Dry deposition
+         sp_count_i=0
+         sp_count_r=0
+         sp_fact=-1.
+         sp_zer=.true.
+         if ((ldirect.eq.1).and.(DRYDEP)) then
+          do jy=0,numygridn-1
+            do ix=0,numxgridn-1
+              if (drygrid(ix,jy).gt.smallnum) then
+                 if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)=ix+jy*numxgridn
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                 endif
+                 sp_count_r=sp_count_r+1
+                 sparse_dump_r(sp_count_r)= &
+                      sp_fact* &
+                      1.e12*drygrid(ix,jy)/arean(ix,jy)
+  !                sparse_dump_u(sp_count_r)=
+  !+                1.e12*drygridsigma(ix,jy,ks,kp,nage)/area(ix,jy)
+              else ! concentration is zero
+                  sp_zer=.true.
+              endif
+            end do
+          end do
+         else
+            sp_count_i=0
+            sp_count_r=0
+         endif
+         write(unitoutgrid) sp_count_i
+         write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
+         write(unitoutgrid) sp_count_r
+         write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
+  !       write(*,*) sp_count_u
+  !       write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)
+
+
+
+  ! Concentrations
+         sp_count_i=0
+         sp_count_r=0
+         sp_fact=-1.
+         sp_zer=.true.
+          do kz=1,numzgrid
+            do jy=0,numygridn-1
+              do ix=0,numxgridn-1
+                if (grid(ix,jy,kz).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)= &
+                         ix+jy*numxgridn+kz*numxgridn*numygridn
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                   endif
+                   sp_count_r=sp_count_r+1
+                   sparse_dump_r(sp_count_r)= &
+                        sp_fact* &
+                        grid(ix,jy,kz)* &
+                        factor3d(ix,jy,kz)/tot_mu(ks,kp)
+  !                 if ((factor(ix,jy,kz)/tot_mu(ks,kp)).eq.0)
+  !    +              write (*,*) factor(ix,jy,kz),tot_mu(ks,kp),ks,kp
+  !                sparse_dump_u(sp_count_r)=
+  !+               ,gridsigma(ix,jy,kz,ks,kp,nage)*
+  !+               factor(ix,jy,kz)/tot_mu(ks,kp)
+              else ! concentration is zero
+                  sp_zer=.true.
+              endif
+              end do
+            end do
+          end do
+         write(unitoutgrid) sp_count_i
+         write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
+         write(unitoutgrid) sp_count_r
+         write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
+  !       write(unitoutgrid) sp_count_u
+  !       write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)
+
+
+
+    endif !  concentration output
+
+  ! Mixing ratio output
+  !********************
+
+  if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
+
+  ! Wet deposition
+         sp_count_i=0
+         sp_count_r=0
+         sp_fact=-1.
+         sp_zer=.true.
+         if ((ldirect.eq.1).and.(WETDEP)) then
+          do jy=0,numygridn-1
+            do ix=0,numxgridn-1
+                if (wetgrid(ix,jy).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)= &
+                         ix+jy*numxgridn
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                 endif
+                 sp_count_r=sp_count_r+1
+                 sparse_dump_r(sp_count_r)= &
+                      sp_fact* &
+                      1.e12*wetgrid(ix,jy)/arean(ix,jy)
+  !                sparse_dump_u(sp_count_r)=
+  !    +            ,1.e12*wetgridsigma(ix,jy,ks,kp,nage)/area(ix,jy)
+              else ! concentration is zero
+                  sp_zer=.true.
+              endif
+            end do
+          end do
+         else
+           sp_count_i=0
+           sp_count_r=0
+         endif
+         write(unitoutgridppt) sp_count_i
+         write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
+         write(unitoutgridppt) sp_count_r
+         write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
+  !       write(unitoutgridppt) sp_count_u
+  !       write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
+
+
+  ! Dry deposition
+         sp_count_i=0
+         sp_count_r=0
+         sp_fact=-1.
+         sp_zer=.true.
+         if ((ldirect.eq.1).and.(DRYDEP)) then
+          do jy=0,numygridn-1
+            do ix=0,numxgridn-1
+                if (drygrid(ix,jy).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)= &
+                         ix+jy*numxgridn
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1)
+                 endif
+                 sp_count_r=sp_count_r+1
+                 sparse_dump_r(sp_count_r)= &
+                      sp_fact* &
+                      1.e12*drygrid(ix,jy)/arean(ix,jy)
+  !                sparse_dump_u(sp_count_r)=
+  !    +            ,1.e12*drygridsigma(ix,jy,ks,kp,nage)/area(ix,jy)
+              else ! concentration is zero
+                  sp_zer=.true.
+              endif
+            end do
+          end do
+         else
+           sp_count_i=0
+           sp_count_r=0
+         endif
+         write(unitoutgridppt) sp_count_i
+         write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
+         write(unitoutgridppt) sp_count_r
+         write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
+  !       write(unitoutgridppt) sp_count_u
+  !       write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
+
+
+  ! Mixing ratios
+         sp_count_i=0
+         sp_count_r=0
+         sp_fact=-1.
+         sp_zer=.true.
+          do kz=1,numzgrid
+            do jy=0,numygridn-1
+              do ix=0,numxgridn-1
+                if (grid(ix,jy,kz).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)= &
+                         ix+jy*numxgridn+kz*numxgridn*numygridn
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                 endif
+                 sp_count_r=sp_count_r+1
+                 sparse_dump_r(sp_count_r)= &
+                      sp_fact* &
+                      1.e12*grid(ix,jy,kz) &
+                      /volumen(ix,jy,kz)/outnum* &
+                      weightair/weightmolar(ks)/densityoutgrid(ix,jy,kz)
+  !                sparse_dump_u(sp_count_r)=
+  !+              ,1.e12*gridsigma(ix,jy,kz,ks,kp,nage)/volume(ix,jy,kz)/
+  !+              outnum*weightair/weightmolar(ks)/
+  !+              densityoutgrid(ix,jy,kz)
+              else ! concentration is zero
+                  sp_zer=.true.
+              endif
+              end do
+            end do
+          end do
+         write(unitoutgridppt) sp_count_i
+         write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
+         write(unitoutgridppt) sp_count_r
+         write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
+  !       write(unitoutgridppt) sp_count_u
+  !       write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
+
+      endif ! output for ppt
+
+  end do
+  end do
+
+    close(unitoutgridppt)
+    close(unitoutgrid)
+
+  end do
+
+  ! RLT Aug 2017
+  ! Write out conversion factor for dry air
+  inquire(file=path(2)(1:length(2))//'factor_drygrid_nest',exist=lexist)
+  if (lexist) then
+    ! open and append
+    open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid_nest',form='unformatted',&
+            status='old',action='write',access='append')
+  else
+    ! create new
+    open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid_nest',form='unformatted',&
+            status='new',action='write')
+  endif
+  sp_count_i=0
+  sp_count_r=0
+  sp_fact=-1.
+  sp_zer=.true.
+  do kz=1,numzgrid
+    do jy=0,numygridn-1
+      do ix=0,numxgridn-1
+        if (factor_drygrid(ix,jy,kz).gt.(1.+smallnum).or.factor_drygrid(ix,jy,kz).lt.(1.-smallnum)) then
+          if (sp_zer.eqv..true.) then ! first value not equal to one
+            sp_count_i=sp_count_i+1
+            sparse_dump_i(sp_count_i)= &
+                  ix+jy*numxgridn+kz*numxgridn*numygridn
+            sp_zer=.false.
+            sp_fact=sp_fact*(-1.)
+          endif
+          sp_count_r=sp_count_r+1
+          sparse_dump_r(sp_count_r)= &
+               sp_fact*factor_drygrid(ix,jy,kz)
+        else ! factor is one
+          sp_zer=.true.
+        endif
+      end do
+    end do
+  end do
+  write(unitoutfactor) sp_count_i
+  write(unitoutfactor) (sparse_dump_i(i),i=1,sp_count_i)
+  write(unitoutfactor) sp_count_r
+  write(unitoutfactor) (sparse_dump_r(i),i=1,sp_count_r)
+  close(unitoutfactor)
+
+  creceptor(:,:)=0.
+  griduncn(:,:,:,:,:,:,:)=0.
+end subroutine concoutput_nest
diff --git a/src/bin_concoutput_sfc.f90 b/src/bin_concoutput_sfc.f90
new file mode 100644
index 0000000000000000000000000000000000000000..257e46601f83f9e2ef22115829194793a6fe2864
--- /dev/null
+++ b/src/bin_concoutput_sfc.f90
@@ -0,0 +1,666 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine concoutput_sfc(itime,outnum,gridtotalunc,wetgridtotalunc, &
+     drygridtotalunc)
+  !                        i     i          o             o
+  !       o
+  !*****************************************************************************
+  !                                                                            *
+  !     Output of the concentration grid and the receptor concentrations.      *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     24 May 1995                                                            *
+  !                                                                            *
+  !     13 April 1999, Major update: if output size is smaller, dump output    *
+  !                    in sparse matrix format; additional output of           *
+  !                    uncertainty                                             *
+  !                                                                            *
+  !     05 April 2000, Major update: output of age classes; output for backward*
+  !                    runs is time spent in grid cell times total mass of     *
+  !                    species.                                                *
+  !                                                                            *
+  !     17 February 2002, Appropriate dimensions for backward and forward runs *
+  !                       are now specified in file par_mod                    *
+  !                                                                            *
+  !     June 2006, write grid in sparse matrix with a single write command     *
+  !                in order to save disk space                                 *
+  !                                                                            *
+  !     2008 new sparse matrix format                                          *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! outnum          number of samples                                          *
+  ! ncells          number of cells with non-zero concentrations               *
+  ! sparse          .true. if in sparse matrix format, else .false.            *
+  ! tot_mu          1 for forward, initial mass mixing ration for backw. runs  *
+  !                                                                            *
+  !*****************************************************************************
+
+  use unc_mod
+  use mean_mod
+
+  implicit none
+
+  real(kind=dp) :: jul
+  integer :: itime,i,ix,jy,kz,ks,kp,l,iix,jjy,kzz,nage,jjjjmmdd,ihmmss
+  integer :: sp_count_i,sp_count_r
+  real :: sp_fact
+  real :: outnum,densityoutrecept(maxreceptor),xl,yl
+  ! RLT
+  real :: densitydryrecept(maxreceptor)
+  real :: factor_dryrecept(maxreceptor)
+
+  real(dep_prec) :: auxgrid(nclassunc)
+  real(sp) :: gridtotal,gridsigmatotal,gridtotalunc
+  real(dep_prec) :: wetgridtotal,wetgridsigmatotal,wetgridtotalunc
+  real(dep_prec) :: drygridtotal,drygridsigmatotal,drygridtotalunc
+  real :: halfheight,dz,dz1,dz2,tot_mu(maxspec,maxpointspec_act)
+  real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
+  real,parameter :: weightair=28.97
+  logical :: sp_zer
+  character :: adate*8,atime*6
+  character(len=3) :: anspec
+  logical :: lexist
+
+
+  if (verbosity.eq.1) then
+    print*,'inside concoutput_sfc '
+    CALL SYSTEM_CLOCK(count_clock)
+    WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0
+  endif
+
+  ! Determine current calendar date, needed for the file name
+  !**********************************************************
+
+  jul=bdate+real(itime,kind=dp)/86400._dp
+  call caldate(jul,jjjjmmdd,ihmmss)
+  write(adate,'(i8.8)') jjjjmmdd
+  write(atime,'(i6.6)') ihmmss
+
+  open(unitdates,file=path(2)(1:length(2))//'dates', ACCESS='APPEND')
+  write(unitdates,'(a)') adate//atime
+  close(unitdates)
+
+  ! For forward simulations, output fields have dimension MAXSPEC,
+  ! for backward simulations, output fields have dimension MAXPOINT.
+  ! Thus, make loops either about nspec, or about numpoint
+  !*****************************************************************
+
+
+  if (ldirect.eq.1) then
+    do ks=1,nspec
+      do kp=1,maxpointspec_act
+        tot_mu(ks,kp)=1
+      end do
+    end do
+  else
+    do ks=1,nspec
+      do kp=1,maxpointspec_act
+        tot_mu(ks,kp)=xmass(kp,ks)
+      end do
+    end do
+  endif
+
+
+  if (verbosity.eq.1) then
+    print*,'concoutput_sfc 2'
+    CALL SYSTEM_CLOCK(count_clock)
+    WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0
+  endif
+
+  !*******************************************************************
+  ! Compute air density: sufficiently accurate to take it
+  ! from coarse grid at some time
+  ! Determine center altitude of output layer, and interpolate density
+  ! data to that altitude
+  !*******************************************************************
+
+  do kz=1,numzgrid
+    if (kz.eq.1) then
+      halfheight=outheight(1)/2.
+    else
+      halfheight=(outheight(kz)+outheight(kz-1))/2.
+    endif
+    do kzz=2,nz
+      if ((height(kzz-1).lt.halfheight).and. &
+           (height(kzz).gt.halfheight)) goto 46
+    end do
+46  kzz=max(min(kzz,nz),2)
+    dz1=halfheight-height(kzz-1)
+    dz2=height(kzz)-halfheight
+    dz=dz1+dz2
+    do jy=0,numygrid-1
+      do ix=0,numxgrid-1
+        xl=outlon0+real(ix)*dxout
+        yl=outlat0+real(jy)*dyout
+        xl=(xl-xlon0)/dx
+        yl=(yl-ylat0)/dy
+        iix=max(min(nint(xl),nxmin1),0)
+        jjy=max(min(nint(yl),nymin1),0)
+        densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,2)*dz1+ &
+             rho(iix,jjy,kzz-1,2)*dz2)/dz
+  ! RLT
+        densitydrygrid(ix,jy,kz)=(rho_dry(iix,jjy,kzz,2)*dz1+ &
+             rho_dry(iix,jjy,kzz-1,2)*dz2)/dz
+      end do
+    end do
+  end do
+
+  do i=1,numreceptor
+    xl=xreceptor(i)
+    yl=yreceptor(i)
+    iix=max(min(nint(xl),nxmin1),0)
+    jjy=max(min(nint(yl),nymin1),0)
+    densityoutrecept(i)=rho(iix,jjy,1,2)
+  ! RLT
+    densitydryrecept(i)=rho_dry(iix,jjy,1,2)
+  end do
+
+  ! RLT
+  ! conversion factor for output relative to dry air
+  factor_drygrid=densityoutgrid/densitydrygrid
+  factor_dryrecept=densityoutrecept/densitydryrecept
+
+  ! Output is different for forward and backward simulations
+  do kz=1,numzgrid
+    do jy=0,numygrid-1
+      do ix=0,numxgrid-1
+        if (ldirect.eq.1) then
+          factor3d(ix,jy,kz)=1.e12/volume(ix,jy,kz)/outnum
+        else
+          factor3d(ix,jy,kz)=real(abs(loutaver))/outnum
+        endif
+      end do
+    end do
+  end do
+
+  !*********************************************************************
+  ! Determine the standard deviation of the mean concentration or mixing
+  ! ratio (uncertainty of the output) and the dry and wet deposition
+  !*********************************************************************
+
+  if (verbosity.eq.1) then
+    print*,'concoutput_sfc 3 (sd)'
+    CALL SYSTEM_CLOCK(count_clock)
+    WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0
+  endif
+  gridtotal=0.
+  gridsigmatotal=0.
+  gridtotalunc=0.
+  wetgridtotal=0.
+  wetgridsigmatotal=0.
+  wetgridtotalunc=0.
+  drygridtotal=0.
+  drygridsigmatotal=0.
+  drygridtotalunc=0.
+
+  do ks=1,nspec
+
+    write(anspec,'(i3.3)') ks
+    if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
+      if (ldirect.eq.1) then
+        open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_'//adate// &
+             atime//'_'//anspec,form='unformatted')
+      else
+        open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_'//adate// &
+             atime//'_'//anspec,form='unformatted')
+      endif
+      write(unitoutgrid) itime
+    endif
+
+    if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
+      open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_'//adate// &
+           atime//'_'//anspec,form='unformatted')
+
+      write(unitoutgridppt) itime
+    endif
+
+    do kp=1,maxpointspec_act
+      do nage=1,nageclass
+
+        do jy=0,numygrid-1
+          do ix=0,numxgrid-1
+
+  ! WET DEPOSITION
+            if ((WETDEP).and.(ldirect.gt.0)) then
+              do l=1,nclassunc
+                auxgrid(l)=wetgridunc(ix,jy,ks,kp,l,nage)
+              end do
+              call mean(auxgrid,wetgrid(ix,jy), &
+                   wetgridsigma(ix,jy),nclassunc)
+  ! Multiply by number of classes to get total concentration
+              wetgrid(ix,jy)=wetgrid(ix,jy) &
+                   *nclassunc
+              wetgridtotal=wetgridtotal+wetgrid(ix,jy)
+  ! Calculate standard deviation of the mean
+              wetgridsigma(ix,jy)= &
+                   wetgridsigma(ix,jy)* &
+                   sqrt(real(nclassunc))
+              wetgridsigmatotal=wetgridsigmatotal+ &
+                   wetgridsigma(ix,jy)
+            endif
+
+  ! DRY DEPOSITION
+            if ((DRYDEP).and.(ldirect.gt.0)) then
+              do l=1,nclassunc
+                auxgrid(l)=drygridunc(ix,jy,ks,kp,l,nage)
+              end do
+              call mean(auxgrid,drygrid(ix,jy), &
+                   drygridsigma(ix,jy),nclassunc)
+  ! Multiply by number of classes to get total concentration
+              drygrid(ix,jy)=drygrid(ix,jy)* &
+                   nclassunc
+              drygridtotal=drygridtotal+drygrid(ix,jy)
+  ! Calculate standard deviation of the mean
+              drygridsigma(ix,jy)= &
+                   drygridsigma(ix,jy)* &
+                   sqrt(real(nclassunc))
+125           drygridsigmatotal=drygridsigmatotal+ &
+                   drygridsigma(ix,jy)
+            endif
+
+  ! CONCENTRATION OR MIXING RATIO
+            do kz=1,numzgrid
+              do l=1,nclassunc
+                auxgrid(l)=gridunc(ix,jy,kz,ks,kp,l,nage)
+              end do
+              call mean(auxgrid,grid(ix,jy,kz), &
+                   gridsigma(ix,jy,kz),nclassunc)
+  ! Multiply by number of classes to get total concentration
+              grid(ix,jy,kz)= &
+                   grid(ix,jy,kz)*nclassunc
+              gridtotal=gridtotal+grid(ix,jy,kz)
+  ! Calculate standard deviation of the mean
+              gridsigma(ix,jy,kz)= &
+                   gridsigma(ix,jy,kz)* &
+                   sqrt(real(nclassunc))
+              gridsigmatotal=gridsigmatotal+ &
+                   gridsigma(ix,jy,kz)
+            end do
+          end do
+        end do
+
+
+  !*******************************************************************
+  ! Generate output: may be in concentration (ng/m3) or in mixing
+  ! ratio (ppt) or both
+  ! Output the position and the values alternated multiplied by
+  ! 1 or -1, first line is number of values, number of positions
+  ! For backward simulations, the unit is seconds, stored in grid_time
+  !*******************************************************************
+
+        if (verbosity.eq.1) then
+          print*,'concoutput_sfc 4 (output)'
+          CALL SYSTEM_CLOCK(count_clock)
+          WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0
+        endif
+
+  ! Concentration output
+  !*********************
+
+        if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
+
+          if (verbosity.eq.1) then
+            print*,'concoutput_sfc (Wet deposition)'
+            CALL SYSTEM_CLOCK(count_clock)
+            WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0
+          endif
+
+  ! Wet deposition
+          sp_count_i=0
+          sp_count_r=0
+          sp_fact=-1.
+          sp_zer=.true.
+          if ((ldirect.eq.1).and.(WETDEP)) then
+            do jy=0,numygrid-1
+              do ix=0,numxgrid-1
+  ! concentraion greater zero
+                if (wetgrid(ix,jy).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)=ix+jy*numxgrid
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                  endif
+                  sp_count_r=sp_count_r+1
+                  sparse_dump_r(sp_count_r)= &
+                       sp_fact*1.e12*wetgrid(ix,jy)/area(ix,jy)
+                  sparse_dump_u(sp_count_r)= &
+                       1.e12*wetgridsigma(ix,jy)/area(ix,jy)
+                else ! concentration is zero
+                  sp_zer=.true.
+                endif
+              end do
+            end do
+          else
+            sp_count_i=0
+            sp_count_r=0
+          endif
+          write(unitoutgrid) sp_count_i
+          write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
+          write(unitoutgrid) sp_count_r
+          write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
+
+          if (verbosity.eq.1) then
+            print*,'concoutput_sfc (Dry deposition)'
+            CALL SYSTEM_CLOCK(count_clock)
+            WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0
+          endif
+  ! Dry deposition
+          sp_count_i=0
+          sp_count_r=0
+          sp_fact=-1.
+          sp_zer=.true.
+          if ((ldirect.eq.1).and.(DRYDEP)) then
+            do jy=0,numygrid-1
+              do ix=0,numxgrid-1
+                if (drygrid(ix,jy).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)=ix+jy*numxgrid
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                  endif
+                  sp_count_r=sp_count_r+1
+                  sparse_dump_r(sp_count_r)= &
+                       sp_fact* &
+                       1.e12*drygrid(ix,jy)/area(ix,jy)
+                  sparse_dump_u(sp_count_r)= &
+                       1.e12*drygridsigma(ix,jy)/area(ix,jy)
+                else ! concentration is zero
+                  sp_zer=.true.
+                endif
+              end do
+            end do
+          else
+            sp_count_i=0
+            sp_count_r=0
+          endif
+          write(unitoutgrid) sp_count_i
+          write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
+          write(unitoutgrid) sp_count_r
+          write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
+
+          if (verbosity.eq.1) then
+            print*,'concoutput_sfc (Concentrations)'
+            CALL SYSTEM_CLOCK(count_clock)
+            WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0
+          endif
+
+  ! Concentrations
+
+  ! surf_only write only 1st layer
+
+          sp_count_i=0
+          sp_count_r=0
+          sp_fact=-1.
+          sp_zer=.true.
+          do kz=1,1
+            do jy=0,numygrid-1
+              do ix=0,numxgrid-1
+                if (grid(ix,jy,kz).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)= &
+                         ix+jy*numxgrid+kz*numxgrid*numygrid
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                  endif
+                  sp_count_r=sp_count_r+1
+                  sparse_dump_r(sp_count_r)= &
+                       sp_fact* &
+                       grid(ix,jy,kz)* &
+                       factor3d(ix,jy,kz)/tot_mu(ks,kp)
+                  sparse_dump_u(sp_count_r)= &
+                       gridsigma(ix,jy,kz)* &
+                       factor3d(ix,jy,kz)/tot_mu(ks,kp)
+                else ! concentration is zero
+                  sp_zer=.true.
+                endif
+              end do
+            end do
+          end do
+          write(unitoutgrid) sp_count_i
+          write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
+          write(unitoutgrid) sp_count_r
+          write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
+        endif !  concentration output
+
+  ! Mixing ratio output
+  !********************
+
+        if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
+
+  ! Wet deposition
+          sp_count_i=0
+          sp_count_r=0
+          sp_fact=-1.
+          sp_zer=.true.
+          if ((ldirect.eq.1).and.(WETDEP)) then
+            do jy=0,numygrid-1
+              do ix=0,numxgrid-1
+                if (wetgrid(ix,jy).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)= &
+                         ix+jy*numxgrid
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                  endif
+                  sp_count_r=sp_count_r+1
+                  sparse_dump_r(sp_count_r)= &
+                       sp_fact* &
+                       1.e12*wetgrid(ix,jy)/area(ix,jy)
+                  sparse_dump_u(sp_count_r)= &
+                       1.e12*wetgridsigma(ix,jy)/area(ix,jy)
+                else ! concentration is zero
+                  sp_zer=.true.
+                endif
+              end do
+            end do
+          else
+            sp_count_i=0
+            sp_count_r=0
+          endif
+          write(unitoutgridppt) sp_count_i
+          write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
+          write(unitoutgridppt) sp_count_r
+          write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
+
+  ! Dry deposition
+          sp_count_i=0
+          sp_count_r=0
+          sp_fact=-1.
+          sp_zer=.true.
+          if ((ldirect.eq.1).and.(DRYDEP)) then
+            do jy=0,numygrid-1
+              do ix=0,numxgrid-1
+                if (drygrid(ix,jy).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)= &
+                         ix+jy*numxgrid
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1)
+                  endif
+                  sp_count_r=sp_count_r+1
+                  sparse_dump_r(sp_count_r)= &
+                       sp_fact* &
+                       1.e12*drygrid(ix,jy)/area(ix,jy)
+                  sparse_dump_u(sp_count_r)= &
+                       1.e12*drygridsigma(ix,jy)/area(ix,jy)
+                else ! concentration is zero
+                  sp_zer=.true.
+                endif
+              end do
+            end do
+          else
+            sp_count_i=0
+            sp_count_r=0
+          endif
+          write(unitoutgridppt) sp_count_i
+          write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
+          write(unitoutgridppt) sp_count_r
+          write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
+
+  ! Mixing ratios
+
+  ! surf_only write only 1st layer
+
+          sp_count_i=0
+          sp_count_r=0
+          sp_fact=-1.
+          sp_zer=.true.
+          do kz=1,1
+            do jy=0,numygrid-1
+              do ix=0,numxgrid-1
+                if (grid(ix,jy,kz).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)= &
+                         ix+jy*numxgrid+kz*numxgrid*numygrid
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                  endif
+                  sp_count_r=sp_count_r+1
+                  sparse_dump_r(sp_count_r)= &
+                       sp_fact* &
+                       1.e12*grid(ix,jy,kz) &
+                       /volume(ix,jy,kz)/outnum* &
+                       weightair/weightmolar(ks)/densityoutgrid(ix,jy,kz)
+                  sparse_dump_u(sp_count_r)= &
+                       1.e12*gridsigma(ix,jy,kz)/volume(ix,jy,kz)/ &
+                       outnum*weightair/weightmolar(ks)/ &
+                       densityoutgrid(ix,jy,kz)
+                else ! concentration is zero
+                  sp_zer=.true.
+                endif
+              end do
+            end do
+          end do
+          write(unitoutgridppt) sp_count_i
+          write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
+          write(unitoutgridppt) sp_count_r
+          write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
+        endif ! output for ppt
+
+      end do
+    end do
+
+    close(unitoutgridppt)
+    close(unitoutgrid)
+
+  end do
+
+  ! RLT Aug 2017
+  ! Write out conversion factor for dry air
+  inquire(file=path(2)(1:length(2))//'factor_drygrid',exist=lexist)
+  if (lexist) then
+    ! open and append
+    open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid',form='unformatted',&
+            status='old',action='write',access='append')
+  else
+    ! create new
+    open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid',form='unformatted',&
+            status='new',action='write')
+  endif
+  sp_count_i=0
+  sp_count_r=0
+  sp_fact=-1.
+  sp_zer=.true.
+  do kz=1,1
+    do jy=0,numygrid-1
+      do ix=0,numxgrid-1
+        if (factor_drygrid(ix,jy,kz).gt.(1.+smallnum).or.factor_drygrid(ix,jy,kz).lt.(1.-smallnum)) then
+          if (sp_zer.eqv..true.) then ! first value not equal to one
+            sp_count_i=sp_count_i+1
+            sparse_dump_i(sp_count_i)= &
+                  ix+jy*numxgrid+kz*numxgrid*numygrid
+            sp_zer=.false.
+            sp_fact=sp_fact*(-1.)
+          endif
+          sp_count_r=sp_count_r+1
+          sparse_dump_r(sp_count_r)= &
+               sp_fact*factor_drygrid(ix,jy,kz)
+        else ! factor is one
+          sp_zer=.true.
+        endif
+      end do
+    end do
+  end do
+  write(unitoutfactor) sp_count_i
+  write(unitoutfactor) (sparse_dump_i(i),i=1,sp_count_i)
+  write(unitoutfactor) sp_count_r
+  write(unitoutfactor) (sparse_dump_r(i),i=1,sp_count_r)
+  close(unitoutfactor)
+
+
+  if (gridtotal.gt.0.) gridtotalunc=gridsigmatotal/gridtotal
+  if (wetgridtotal.gt.0.) wetgridtotalunc=wetgridsigmatotal/ &
+       wetgridtotal
+  if (drygridtotal.gt.0.) drygridtotalunc=drygridsigmatotal/ &
+       drygridtotal
+
+  ! Dump of receptor concentrations
+
+  if (numreceptor.gt.0 .and. (iout.eq.2 .or. iout.eq.3)  ) then
+    write(unitoutreceptppt) itime
+    do ks=1,nspec
+      write(unitoutreceptppt) (1.e12*creceptor(i,ks)/outnum* &
+           weightair/weightmolar(ks)/densityoutrecept(i),i=1,numreceptor)
+    end do
+  endif
+
+  ! Dump of receptor concentrations
+
+  if (numreceptor.gt.0) then
+    write(unitoutrecept) itime
+    do ks=1,nspec
+      write(unitoutrecept) (1.e12*creceptor(i,ks)/outnum, &
+           i=1,numreceptor)
+    end do
+  endif
+
+  ! RLT Aug 2017
+  ! Write out conversion factor for dry air
+  if (numreceptor.gt.0) then
+    inquire(file=path(2)(1:length(2))//'factor_dryreceptor',exist=lexist)
+     if (lexist) then
+     ! open and append
+      open(unitoutfactor,file=path(2)(1:length(2))//'factor_dryreceptor',form='unformatted',&
+              status='old',action='write',access='append')
+    else
+      ! create new
+      open(unitoutfactor,file=path(2)(1:length(2))//'factor_dryreceptor',form='unformatted',&
+              status='new',action='write')
+    endif
+    write(unitoutfactor) itime
+    write(unitoutfactor) (factor_dryrecept(i),i=1,numreceptor)
+    close(unitoutfactor)
+  endif
+
+  ! Reinitialization of grid
+  !*************************
+
+  do ks=1,nspec
+    do kp=1,maxpointspec_act
+      do i=1,numreceptor
+        creceptor(i,ks)=0.
+      end do
+      do jy=0,numygrid-1
+        do ix=0,numxgrid-1
+          do l=1,nclassunc
+            do nage=1,nageclass
+              do kz=1,numzgrid
+                gridunc(ix,jy,kz,ks,kp,l,nage)=0.
+              end do
+            end do
+          end do
+        end do
+      end do
+    end do
+  end do
+end subroutine concoutput_sfc
diff --git a/src/bin_concoutput_sfc_nest.f90 b/src/bin_concoutput_sfc_nest.f90
new file mode 100644
index 0000000000000000000000000000000000000000..cd2d81e18a6f06afd6ffba1e35f7ad219d3d849f
--- /dev/null
+++ b/src/bin_concoutput_sfc_nest.f90
@@ -0,0 +1,641 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine concoutput_sfc_nest(itime,outnum)
+  !                        i     i
+  !*****************************************************************************
+  !                                                                            *
+  !     Output of the concentration grid and the receptor concentrations.      *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     24 May 1995                                                            *
+  !                                                                            *
+  !     13 April 1999, Major update: if output size is smaller, dump output    *
+  !                    in sparse matrix format; additional output of           *
+  !                    uncertainty                                             *
+  !                                                                            *
+  !     05 April 2000, Major update: output of age classes; output for backward*
+  !                    runs is time spent in grid cell times total mass of     *
+  !                    species.                                                *
+  !                                                                            *
+  !     17 February 2002, Appropriate dimensions for backward and forward runs *
+  !                       are now specified in file par_mod                    *
+  !                                                                            *
+  !     June 2006, write grid in sparse matrix with a single write command     *
+  !                in order to save disk space                                 *
+  !                                                                            *
+  !     2008 new sparse matrix format                                          *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! outnum          number of samples                                          *
+  ! ncells          number of cells with non-zero concentrations               *
+  ! sparse          .true. if in sparse matrix format, else .false.            *
+  ! tot_mu          1 for forward, initial mass mixing ration for backw. runs  *
+  !                                                                            *
+  !*****************************************************************************
+
+  use unc_mod
+  use mean_mod
+
+  implicit none
+
+  real(kind=dp) :: jul
+  integer :: itime,i,ix,jy,kz,ks,kp,l,iix,jjy,kzz,nage,jjjjmmdd,ihmmss
+  integer :: sp_count_i,sp_count_r
+  real :: sp_fact
+  real :: outnum,densityoutrecept(maxreceptor),xl,yl
+  ! RLT
+  real :: densitydryrecept(maxreceptor)
+  real :: factor_dryrecept(maxreceptor)
+
+  real(dep_prec) :: auxgrid(nclassunc)
+  real :: halfheight,dz,dz1,dz2,tot_mu(maxspec,maxpointspec_act)
+  real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
+  real,parameter :: weightair=28.97
+  logical :: sp_zer
+  character :: adate*8,atime*6
+  character(len=3) :: anspec
+  logical :: lexist
+
+  ! Determine current calendar date, needed for the file name
+  !**********************************************************
+
+  jul=bdate+real(itime,kind=dp)/86400._dp
+  call caldate(jul,jjjjmmdd,ihmmss)
+  write(adate,'(i8.8)') jjjjmmdd
+  write(atime,'(i6.6)') ihmmss
+
+
+  ! For forward simulations, output fields have dimension MAXSPEC,
+  ! for backward simulations, output fields have dimension MAXPOINT.
+  ! Thus, make loops either about nspec, or about numpoint
+  !*****************************************************************
+
+
+    if (ldirect.eq.1) then
+       do ks=1,nspec
+         do kp=1,maxpointspec_act
+           tot_mu(ks,kp)=1
+         end do
+       end do
+   else
+      do ks=1,nspec
+             do kp=1,maxpointspec_act
+               tot_mu(ks,kp)=xmass(kp,ks)
+             end do
+      end do
+    endif
+
+
+  !*******************************************************************
+  ! Compute air density: sufficiently accurate to take it
+  ! from coarse grid at some time
+  ! Determine center altitude of output layer, and interpolate density
+  ! data to that altitude
+  !*******************************************************************
+
+  do kz=1,numzgrid
+    if (kz.eq.1) then
+      halfheight=outheight(1)/2.
+    else
+      halfheight=(outheight(kz)+outheight(kz-1))/2.
+    endif
+    do kzz=2,nz
+      if ((height(kzz-1).lt.halfheight).and. &
+           (height(kzz).gt.halfheight)) goto 46
+    end do
+46   kzz=max(min(kzz,nz),2)
+    dz1=halfheight-height(kzz-1)
+    dz2=height(kzz)-halfheight
+    dz=dz1+dz2
+    do jy=0,numygridn-1
+      do ix=0,numxgridn-1
+        xl=outlon0n+real(ix)*dxoutn
+        yl=outlat0n+real(jy)*dyoutn
+        xl=(xl-xlon0)/dx
+        yl=(yl-ylat0)/dy
+        iix=max(min(nint(xl),nxmin1),0)
+        jjy=max(min(nint(yl),nymin1),0)
+        densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,2)*dz1+ &
+             rho(iix,jjy,kzz-1,2)*dz2)/dz
+  ! RLT
+        densitydrygrid(ix,jy,kz)=(rho_dry(iix,jjy,kzz,2)*dz1+ &
+             rho_dry(iix,jjy,kzz-1,2)*dz2)/dz
+      end do
+    end do
+  end do
+
+    do i=1,numreceptor
+      xl=xreceptor(i)
+      yl=yreceptor(i)
+      iix=max(min(nint(xl),nxmin1),0)
+      jjy=max(min(nint(yl),nymin1),0)
+      densityoutrecept(i)=rho(iix,jjy,1,2)
+  ! RLT
+    densitydryrecept(i)=rho_dry(iix,jjy,1,2)
+    end do
+
+  ! RLT
+  ! conversion factor for output relative to dry air
+  factor_drygrid=densityoutgrid/densitydrygrid
+  factor_dryrecept=densityoutrecept/densitydryrecept
+
+  ! Output is different for forward and backward simulations
+    do kz=1,numzgrid
+      do jy=0,numygridn-1
+        do ix=0,numxgridn-1
+          if (ldirect.eq.1) then
+            factor3d(ix,jy,kz)=1.e12/volumen(ix,jy,kz)/outnum
+          else
+            factor3d(ix,jy,kz)=real(abs(loutaver))/outnum
+          endif
+        end do
+      end do
+    end do
+
+  !*********************************************************************
+  ! Determine the standard deviation of the mean concentration or mixing
+  ! ratio (uncertainty of the output) and the dry and wet deposition
+  !*********************************************************************
+
+  do ks=1,nspec
+
+  write(anspec,'(i3.3)') ks
+  if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
+    if (ldirect.eq.1) then
+      open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_nest_' &
+           //adate// &
+           atime//'_'//anspec,form='unformatted')
+    else
+      open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_nest_' &
+           //adate// &
+           atime//'_'//anspec,form='unformatted')
+    endif
+     write(unitoutgrid) itime
+   endif
+
+  if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
+   open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_nest_' &
+        //adate// &
+        atime//'_'//anspec,form='unformatted')
+
+    write(unitoutgridppt) itime
+  endif
+
+  do kp=1,maxpointspec_act
+  do nage=1,nageclass
+
+    do jy=0,numygridn-1
+      do ix=0,numxgridn-1
+
+  ! WET DEPOSITION
+        if ((WETDEP).and.(ldirect.gt.0)) then
+            do l=1,nclassunc
+              auxgrid(l)=wetgriduncn(ix,jy,ks,kp,l,nage)
+            end do
+            call mean(auxgrid,wetgrid(ix,jy), &
+                 wetgridsigma(ix,jy),nclassunc)
+  ! Multiply by number of classes to get total concentration
+            wetgrid(ix,jy)=wetgrid(ix,jy) &
+                 *nclassunc
+  ! Calculate standard deviation of the mean
+            wetgridsigma(ix,jy)= &
+                 wetgridsigma(ix,jy)* &
+                 sqrt(real(nclassunc))
+        endif
+
+  ! DRY DEPOSITION
+        if ((DRYDEP).and.(ldirect.gt.0)) then
+            do l=1,nclassunc
+              auxgrid(l)=drygriduncn(ix,jy,ks,kp,l,nage)
+            end do
+            call mean(auxgrid,drygrid(ix,jy), &
+                 drygridsigma(ix,jy),nclassunc)
+  ! Multiply by number of classes to get total concentration
+            drygrid(ix,jy)=drygrid(ix,jy)* &
+                 nclassunc
+  ! Calculate standard deviation of the mean
+            drygridsigma(ix,jy)= &
+                 drygridsigma(ix,jy)* &
+                 sqrt(real(nclassunc))
+        endif
+
+  ! CONCENTRATION OR MIXING RATIO
+        do kz=1,numzgrid
+            do l=1,nclassunc
+              auxgrid(l)=griduncn(ix,jy,kz,ks,kp,l,nage)
+            end do
+            call mean(auxgrid,grid(ix,jy,kz), &
+                 gridsigma(ix,jy,kz),nclassunc)
+  ! Multiply by number of classes to get total concentration
+            grid(ix,jy,kz)= &
+                 grid(ix,jy,kz)*nclassunc
+  ! Calculate standard deviation of the mean
+            gridsigma(ix,jy,kz)= &
+                 gridsigma(ix,jy,kz)* &
+                 sqrt(real(nclassunc))
+        end do
+      end do
+    end do
+
+
+  !*******************************************************************
+  ! Generate output: may be in concentration (ng/m3) or in mixing
+  ! ratio (ppt) or both
+  ! Output the position and the values alternated multiplied by
+  ! 1 or -1, first line is number of values, number of positions
+  ! For backward simulations, the unit is seconds, stored in grid_time
+  !*******************************************************************
+
+  ! Concentration output
+  !*********************
+  if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
+
+  ! Wet deposition
+         sp_count_i=0
+         sp_count_r=0
+         sp_fact=-1.
+         sp_zer=.true.
+         if ((ldirect.eq.1).and.(WETDEP)) then
+         do jy=0,numygridn-1
+            do ix=0,numxgridn-1
+  !oncentraion greater zero
+              if (wetgrid(ix,jy).gt.smallnum) then
+                 if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)=ix+jy*numxgridn
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                 endif
+                 sp_count_r=sp_count_r+1
+                 sparse_dump_r(sp_count_r)= &
+                      sp_fact*1.e12*wetgrid(ix,jy)/arean(ix,jy)
+                 sparse_dump_u(sp_count_r)= &
+                      1.e12*wetgridsigma(ix,jy)/area(ix,jy)
+              else ! concentration is zero
+                  sp_zer=.true.
+              endif
+            end do
+         end do
+         else
+            sp_count_i=0
+            sp_count_r=0
+         endif
+         write(unitoutgrid) sp_count_i
+         write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
+         write(unitoutgrid) sp_count_r
+         write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
+  ! Dry deposition
+         sp_count_i=0
+         sp_count_r=0
+         sp_fact=-1.
+         sp_zer=.true.
+         if ((ldirect.eq.1).and.(DRYDEP)) then
+          do jy=0,numygridn-1
+            do ix=0,numxgridn-1
+              if (drygrid(ix,jy).gt.smallnum) then
+                 if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)=ix+jy*numxgridn
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                 endif
+                 sp_count_r=sp_count_r+1
+                 sparse_dump_r(sp_count_r)= &
+                      sp_fact* &
+                      1.e12*drygrid(ix,jy)/arean(ix,jy)
+                 sparse_dump_u(sp_count_r)= &
+                      1.e12*drygridsigma(ix,jy)/area(ix,jy)
+              else ! concentration is zero
+                  sp_zer=.true.
+              endif
+            end do
+          end do
+         else
+            sp_count_i=0
+            sp_count_r=0
+         endif
+         write(unitoutgrid) sp_count_i
+         write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
+         write(unitoutgrid) sp_count_r
+         write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
+
+  ! Concentrations
+
+  ! if surf_only write only 1st layer
+
+         if(surf_only.eq.1) then
+         sp_count_i=0
+         sp_count_r=0
+         sp_fact=-1.
+         sp_zer=.true.
+          do kz=1,1
+            do jy=0,numygridn-1
+              do ix=0,numxgridn-1
+                if (grid(ix,jy,kz).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)= &
+                         ix+jy*numxgridn+kz*numxgridn*numygridn
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                   endif
+                   sp_count_r=sp_count_r+1
+                   sparse_dump_r(sp_count_r)= &
+                        sp_fact* &
+                        grid(ix,jy,kz)* &
+                        factor3d(ix,jy,kz)/tot_mu(ks,kp)
+  !                 if ((factor(ix,jy,kz)/tot_mu(ks,kp)).eq.0)
+  !    +              write (*,*) factor(ix,jy,kz),tot_mu(ks,kp),ks,kp
+                   sparse_dump_u(sp_count_r)= &
+                        gridsigma(ix,jy,kz)* &
+                        factor3d(ix,jy,kz)/tot_mu(ks,kp)
+              else ! concentration is zero
+                  sp_zer=.true.
+              endif
+              end do
+            end do
+          end do
+         write(unitoutgrid) sp_count_i
+         write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
+         write(unitoutgrid) sp_count_r
+         write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
+         else
+
+  ! write full vertical resolution
+
+         sp_count_i=0
+         sp_count_r=0
+         sp_fact=-1.
+         sp_zer=.true.
+          do kz=1,numzgrid
+            do jy=0,numygridn-1
+              do ix=0,numxgridn-1
+                if (grid(ix,jy,kz).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)= &
+                         ix+jy*numxgridn+kz*numxgridn*numygridn
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                   endif
+                   sp_count_r=sp_count_r+1
+                   sparse_dump_r(sp_count_r)= &
+                        sp_fact* &
+                        grid(ix,jy,kz)* &
+                        factor3d(ix,jy,kz)/tot_mu(ks,kp)
+                   sparse_dump_u(sp_count_r)= &
+                        gridsigma(ix,jy,kz)* &
+                        factor3d(ix,jy,kz)/tot_mu(ks,kp)
+              else ! concentration is zero
+                  sp_zer=.true.
+              endif
+              end do
+            end do
+          end do
+         write(unitoutgrid) sp_count_i
+         write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
+         write(unitoutgrid) sp_count_r
+         write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
+         endif ! surf_only
+
+
+    endif !  concentration output
+
+  ! Mixing ratio output
+  !********************
+
+  if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
+
+  ! Wet deposition
+         sp_count_i=0
+         sp_count_r=0
+         sp_fact=-1.
+         sp_zer=.true.
+         if ((ldirect.eq.1).and.(WETDEP)) then
+          do jy=0,numygridn-1
+            do ix=0,numxgridn-1
+                if (wetgrid(ix,jy).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)= &
+                         ix+jy*numxgridn
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                 endif
+                 sp_count_r=sp_count_r+1
+                 sparse_dump_r(sp_count_r)= &
+                      sp_fact* &
+                      1.e12*wetgrid(ix,jy)/arean(ix,jy)
+                 sparse_dump_u(sp_count_r)= &
+                      1.e12*wetgridsigma(ix,jy)/area(ix,jy)
+              else ! concentration is zero
+                  sp_zer=.true.
+              endif
+            end do
+          end do
+         else
+           sp_count_i=0
+           sp_count_r=0
+         endif
+         write(unitoutgridppt) sp_count_i
+         write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
+         write(unitoutgridppt) sp_count_r
+         write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
+
+  ! Dry deposition
+         sp_count_i=0
+         sp_count_r=0
+         sp_fact=-1.
+         sp_zer=.true.
+         if ((ldirect.eq.1).and.(DRYDEP)) then
+          do jy=0,numygridn-1
+            do ix=0,numxgridn-1
+                if (drygrid(ix,jy).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)= &
+                         ix+jy*numxgridn
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1)
+                 endif
+                 sp_count_r=sp_count_r+1
+                 sparse_dump_r(sp_count_r)= &
+                      sp_fact* &
+                      1.e12*drygrid(ix,jy)/arean(ix,jy)
+                 sparse_dump_u(sp_count_r)= &
+                      1.e12*drygridsigma(ix,jy)/area(ix,jy)
+              else ! concentration is zero
+                  sp_zer=.true.
+              endif
+            end do
+          end do
+         else
+           sp_count_i=0
+           sp_count_r=0
+         endif
+         write(unitoutgridppt) sp_count_i
+         write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
+         write(unitoutgridppt) sp_count_r
+         write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
+
+  ! Mixing ratios
+
+    ! if surf_only write only 1st layer
+
+         if(surf_only.eq.1) then
+         sp_count_i=0
+         sp_count_r=0
+         sp_fact=-1.
+         sp_zer=.true.
+          do kz=1,1
+            do jy=0,numygridn-1
+              do ix=0,numxgridn-1
+                if (grid(ix,jy,kz).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)= &
+                         ix+jy*numxgridn+kz*numxgridn*numygridn
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                 endif
+                 sp_count_r=sp_count_r+1
+                 sparse_dump_r(sp_count_r)= &
+                      sp_fact* &
+                      1.e12*grid(ix,jy,kz) &
+                      /volumen(ix,jy,kz)/outnum* &
+                      weightair/weightmolar(ks)/densityoutgrid(ix,jy,kz)
+                 sparse_dump_u(sp_count_r)= &
+                      1.e12*gridsigma(ix,jy,kz)/volumen(ix,jy,kz)/ &
+                      outnum*weightair/weightmolar(ks)/ &
+                      densityoutgrid(ix,jy,kz)
+              else ! concentration is zero
+                  sp_zer=.true.
+              endif
+              end do
+            end do
+          end do
+         write(unitoutgridppt) sp_count_i
+         write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
+         write(unitoutgridppt) sp_count_r
+         write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
+         else
+
+  ! write full vertical resolution
+
+         sp_count_i=0
+         sp_count_r=0
+         sp_fact=-1.
+         sp_zer=.true.
+          do kz=1,numzgrid
+            do jy=0,numygridn-1
+              do ix=0,numxgridn-1
+                if (grid(ix,jy,kz).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)= &
+                         ix+jy*numxgridn+kz*numxgridn*numygridn
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                 endif
+                 sp_count_r=sp_count_r+1
+                 sparse_dump_r(sp_count_r)= &
+                      sp_fact* &
+                      1.e12*grid(ix,jy,kz) &
+                      /volumen(ix,jy,kz)/outnum* &
+                      weightair/weightmolar(ks)/densityoutgrid(ix,jy,kz)
+                 sparse_dump_u(sp_count_r)= &
+                      1.e12*gridsigma(ix,jy,kz)/volumen(ix,jy,kz)/ &
+                      outnum*weightair/weightmolar(ks)/ &
+                      densityoutgrid(ix,jy,kz)
+              else ! concentration is zero
+                  sp_zer=.true.
+              endif
+              end do
+            end do
+          end do
+         write(unitoutgridppt) sp_count_i
+         write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
+         write(unitoutgridppt) sp_count_r
+         write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
+         endif ! surf_only
+
+      endif ! output for ppt
+
+  end do
+  end do
+
+    close(unitoutgridppt)
+    close(unitoutgrid)
+
+  end do
+
+  ! RLT Aug 2017
+  ! Write out conversion factor for dry air
+  inquire(file=path(2)(1:length(2))//'factor_drygrid_nest',exist=lexist)
+  if (lexist) then
+    ! open and append
+    open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid_nest',form='unformatted',&
+            status='old',action='write',access='append')
+  else
+    ! create new
+    open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid_nest',form='unformatted',&
+            status='new',action='write')
+  endif
+  sp_count_i=0
+  sp_count_r=0
+  sp_fact=-1.
+  sp_zer=.true.
+  do kz=1,1
+    do jy=0,numygridn-1
+      do ix=0,numxgridn-1
+        if (factor_drygrid(ix,jy,kz).gt.(1.+smallnum).or.factor_drygrid(ix,jy,kz).lt.(1.-smallnum)) then
+          if (sp_zer.eqv..true.) then ! first value not equal to one
+            sp_count_i=sp_count_i+1
+            sparse_dump_i(sp_count_i)= &
+                  ix+jy*numxgridn+kz*numxgridn*numygridn
+            sp_zer=.false.
+            sp_fact=sp_fact*(-1.)
+          endif
+          sp_count_r=sp_count_r+1
+          sparse_dump_r(sp_count_r)= &
+               sp_fact*factor_drygrid(ix,jy,kz)
+        else ! factor is one
+          sp_zer=.true.
+        endif
+      end do
+    end do
+  end do
+  write(unitoutfactor) sp_count_i
+  write(unitoutfactor) (sparse_dump_i(i),i=1,sp_count_i)
+  write(unitoutfactor) sp_count_r
+  write(unitoutfactor) (sparse_dump_r(i),i=1,sp_count_r)
+  close(unitoutfactor)
+
+
+
+  ! Reinitialization of grid
+  !*************************
+
+  do ks=1,nspec
+  do kp=1,maxpointspec_act
+    do i=1,numreceptor
+      creceptor(i,ks)=0.
+    end do
+    do jy=0,numygridn-1
+      do ix=0,numxgridn-1
+        do l=1,nclassunc
+          do nage=1,nageclass
+            do kz=1,numzgrid
+              griduncn(ix,jy,kz,ks,kp,l,nage)=0.
+            end do
+          end do
+        end do
+      end do
+    end do
+  end do
+  end do
+end subroutine concoutput_sfc_nest
diff --git a/src/bin_initcond_output.f90 b/src/bin_initcond_output.f90
new file mode 100644
index 0000000000000000000000000000000000000000..81caa203f2a0664953518625f80c9f7a08e32d59
--- /dev/null
+++ b/src/bin_initcond_output.f90
@@ -0,0 +1,127 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine initcond_output(itime)
+  !                                 i
+  !*****************************************************************************
+  !                                                                            *
+  !     Output of the initial condition sensitivity field.                     *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     24 May 1995                                                            *
+  !                                                                            *
+  !     13 April 1999, Major update: if output size is smaller, dump output    *
+  !                    in sparse matrix format; additional output of           *
+  !                    uncertainty                                             *
+  !                                                                            *
+  !     05 April 2000, Major update: output of age classes; output for backward*
+  !                    runs is time spent in grid cell times total mass of     *
+  !                    species.                                                *
+  !                                                                            *
+  !     17 February 2002, Appropriate dimensions for backward and forward runs *
+  !                       are now specified in file par_mod                    *
+  !                                                                            *
+  !     June 2006, write grid in sparse matrix with a single write command     *
+  !                in order to save disk space                                 *
+  !                                                                            *
+  !     2008 new sparse matrix format                                          *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! ncells          number of cells with non-zero concentrations               *
+  ! sparse          .true. if in sparse matrix format, else .false.            *
+  !                                                                            *
+  !*****************************************************************************
+
+  use unc_mod
+
+  implicit none
+
+  integer :: itime,i,ix,jy,kz,ks,kp,sp_count_i,sp_count_r
+  real :: sp_fact,fact_recept
+  real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
+  logical :: sp_zer
+  character(len=3) :: anspec
+
+
+  !*********************************************************************
+  ! Determine the standard deviation of the mean concentration or mixing
+  ! ratio (uncertainty of the output) and the dry and wet deposition
+  !*********************************************************************
+
+  do ks=1,nspec
+
+    write(anspec,'(i3.3)') ks
+    open(97,file=path(2)(1:length(2))//'grid_initial'// &
+         '_'//anspec,form='unformatted')
+    write(97) itime
+
+    do kp=1,maxpointspec_act
+
+      if (ind_rel.eq.1) then
+        fact_recept=rho_rel(kp)
+      else
+        fact_recept=1.
+      endif
+
+  !*******************************************************************
+  ! Generate output: may be in concentration (ng/m3) or in mixing
+  ! ratio (ppt) or both
+  ! Output the position and the values alternated multiplied by
+  ! 1 or -1, first line is number of values, number of positions
+  ! For backward simulations, the unit is seconds, stored in grid_time
+  !*******************************************************************
+
+  ! Write out dummy "wet and dry deposition" fields, to keep same format
+  ! as for concentration output
+      sp_count_i=0
+      sp_count_r=0
+      write(97) sp_count_i
+      write(97) (sparse_dump_i(i),i=1,sp_count_i)
+      write(97) sp_count_r
+      write(97) (sparse_dump_r(i),i=1,sp_count_r)
+      write(97) sp_count_i
+      write(97) (sparse_dump_i(i),i=1,sp_count_i)
+      write(97) sp_count_r
+      write(97) (sparse_dump_r(i),i=1,sp_count_r)
+
+
+  ! Write out sensitivity to initial conditions
+      sp_count_i=0
+      sp_count_r=0
+      sp_fact=-1.
+      sp_zer=.true.
+      do kz=1,numzgrid
+        do jy=0,numygrid-1
+          do ix=0,numxgrid-1
+            if (init_cond(ix,jy,kz,ks,kp).gt.smallnum) then
+              if (sp_zer.eqv..true.) then ! first non zero value
+                sp_count_i=sp_count_i+1
+                sparse_dump_i(sp_count_i)= &
+                     ix+jy*numxgrid+kz*numxgrid*numygrid
+                sp_zer=.false.
+                sp_fact=sp_fact*(-1.)
+              endif
+              sp_count_r=sp_count_r+1
+              sparse_dump_r(sp_count_r)=sp_fact* &
+                   init_cond(ix,jy,kz,ks,kp)/xmass(kp,ks)*fact_recept
+            else ! concentration is zero
+              sp_zer=.true.
+            endif
+          end do
+        end do
+      end do
+      write(97) sp_count_i
+      write(97) (sparse_dump_i(i),i=1,sp_count_i)
+      write(97) sp_count_r
+      write(97) (sparse_dump_r(i),i=1,sp_count_r)
+
+
+    end do
+
+    close(97)
+
+  end do
+end subroutine initcond_output
diff --git a/src/bin_initcond_output_inv.f90 b/src/bin_initcond_output_inv.f90
new file mode 100644
index 0000000000000000000000000000000000000000..65dd799b19e2e6cea66115fec7c08087de515865
--- /dev/null
+++ b/src/bin_initcond_output_inv.f90
@@ -0,0 +1,158 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine initcond_output_inv(itime)
+  !                                 i
+  !*****************************************************************************
+  !                                                                            *
+  !     Output of the initial condition sensitivity field.                     *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     24 May 1995                                                            *
+  !                                                                            *
+  !     13 April 1999, Major update: if output size is smaller, dump output    *
+  !                    in sparse matrix format; additional output of           *
+  !                    uncertainty                                             *
+  !                                                                            *
+  !     05 April 2000, Major update: output of age classes; output for backward*
+  !                    runs is time spent in grid cell times total mass of     *
+  !                    species.                                                *
+  !                                                                            *
+  !     17 February 2002, Appropriate dimensions for backward and forward runs *
+  !                       are now specified in file par_mod                    *
+  !                                                                            *
+  !     June 2006, write grid in sparse matrix with a single write command     *
+  !                in order to save disk space                                 *
+  !                                                                            *
+  !     2008 new sparse matrix format                                          *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! ncells          number of cells with non-zero concentrations               *
+  ! sparse          .true. if in sparse matrix format, else .false.            *
+  !                                                                            *
+  !*****************************************************************************
+
+  use unc_mod
+
+  implicit none
+
+  integer :: itime,i,ix,jy,kz,ks,kp,sp_count_i,sp_count_r
+  integer :: jjjjmmdd, ihmmss
+  real(kind=dp) :: jul
+  real :: sp_fact,fact_recept
+  real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
+  logical :: sp_zer,lexist
+  logical,save :: listart=.true.
+  logical,save,allocatable,dimension(:) :: listartrel
+  character :: adate*8,atime*6
+  character :: areldate*8,areltime*6
+  character(len=3) :: anspec
+
+  if(listart) then
+    allocate(listartrel(maxpointspec_act))
+    listartrel(:)=.true.
+  endif
+  print*, 'listartrel = ',listartrel
+
+  !*********************************************************************
+  ! Determine the standard deviation of the mean concentration or mixing
+  ! ratio (uncertainty of the output) and the dry and wet deposition
+  !*********************************************************************
+
+  do ks=1,nspec
+
+    write(anspec,'(i3.3)') ks
+
+    do kp=1,maxpointspec_act
+
+      ! calculate date of release
+      jul=bdate+real(ireleasestart(kp),kind=dp)/86400._dp    ! this is the current day
+      call caldate(jul,jjjjmmdd,ihmmss)
+      write(areldate,'(i8.8)') jjjjmmdd
+      write(areltime,'(i6.6)') ihmmss
+      print*, areldate//areltime
+
+      ! calculate date of field
+      jul=bdate+real(itime,kind=dp)/86400._dp
+      call caldate(jul,jjjjmmdd,ihmmss)
+      write(adate,'(i8.8)') jjjjmmdd
+      write(atime,'(i6.6)') ihmmss
+      print*, adate//atime
+
+      inquire(file=path(2)(1:length(2))//'grid_initial_'//areldate// &
+         areltime//'_'//anspec,exist=lexist)
+      if(lexist.and..not.listartrel(kp)) then
+        ! open and append to existing file
+        open(97,file=path(2)(1:length(2))//'grid_initial_'//areldate// &
+             areltime//'_'//anspec,form='unformatted',status='old',action='write',access='append')
+      else
+        ! open new file
+        open(97,file=path(2)(1:length(2))//'grid_initial_'//areldate// &
+             areltime//'_'//anspec,form='unformatted',status='replace',action='write')
+      endif
+      write(97) jjjjmmdd
+      write(97) ihmmss
+
+      listartrel(kp)=.false.
+
+      if (ind_rel.eq.1) then
+        fact_recept=rho_rel(kp)
+      else
+        fact_recept=1.
+      endif
+
+  !*******************************************************************
+  ! Generate output: may be in concentration (ng/m3) or in mixing
+  ! ratio (ppt) or both
+  ! Output the position and the values alternated multiplied by
+  ! 1 or -1, first line is number of values, number of positions
+  ! For backward simulations, the unit is seconds, stored in grid_time
+  !*******************************************************************
+
+  ! Write out dummy "wet and dry deposition" fields, to keep same format
+  ! as for concentration output
+
+  ! Write out sensitivity to initial conditions
+      sp_count_i=0
+      sp_count_r=0
+      sp_fact=-1.
+      sp_zer=.true.
+      do kz=1,numzgrid
+        do jy=0,numygrid-1
+          do ix=0,numxgrid-1
+            if (init_cond(ix,jy,kz,ks,kp).gt.smallnum) then
+              if (sp_zer.eqv..true.) then ! first non zero value
+                sp_count_i=sp_count_i+1
+                sparse_dump_i(sp_count_i)= &
+                     ix+jy*numxgrid+kz*numxgrid*numygrid
+                sp_zer=.false.
+                sp_fact=sp_fact*(-1.)
+              endif
+              sp_count_r=sp_count_r+1
+              sparse_dump_r(sp_count_r)=sp_fact* &
+                   init_cond(ix,jy,kz,ks,kp)/xmass(kp,ks)*fact_recept
+            else ! concentration is zero
+              sp_zer=.true.
+            endif
+          end do
+        end do
+      end do
+      write(97) sp_count_i
+      write(97) (sparse_dump_i(i),i=1,sp_count_i)
+      write(97) sp_count_r
+      write(97) (sparse_dump_r(i),i=1,sp_count_r)
+
+      close(97)
+
+    end do
+
+  end do
+
+  ! reset listart
+  if (listart) then
+    listart=.false.
+  endif
+end subroutine initcond_output_inv
diff --git a/src/bin_openreceptors.f90 b/src/bin_openreceptors.f90
new file mode 100644
index 0000000000000000000000000000000000000000..3d8dc7e62efedcd4a0f838b5e28f82b46251aa02
--- /dev/null
+++ b/src/bin_openreceptors.f90
@@ -0,0 +1,72 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine openreceptors
+
+  !*****************************************************************************
+  !                                                                            *
+  !  This routine opens the receptor output files and writes out the receptor  *
+  !  names and the receptor locations. The receptor output files are not       *
+  !  closed, but kept open throughout the simulation. Concentrations are       *
+  !  continuously  dumped to these files.                                      *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     7 August 2002                                                          *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! numreceptor            actual number of receptor points specified          *
+  ! receptornames          names of the receptor points                        *
+  ! xreceptor,yreceptor    coordinates of the receptor points                  *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  integer :: j
+
+  ! Open output file for receptor points and write out a short header
+  ! containing receptor names and locations
+  !******************************************************************
+
+  if (numreceptor.ge.1) then           ! do it only if receptors are specified
+
+  ! Concentration output
+  !*********************
+
+    if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
+      open(unitoutrecept,file=path(2)(1:length(2))//'receptor_conc', &
+           form='unformatted',err=997)
+      write(unitoutrecept) (receptorname(j),j=1,numreceptor)
+      write(unitoutrecept) (xreceptor(j)*dx+xlon0, &
+           yreceptor(j)*dy+ylat0,j=1,numreceptor)
+    endif
+
+  ! Mixing ratio output
+  !********************
+
+    if ((iout.eq.2).or.(iout.eq.3)) then
+      open(unitoutreceptppt,file=path(2)(1:length(2))//'receptor_pptv', &
+           form='unformatted',err=998)
+      write(unitoutreceptppt) (receptorname(j),j=1,numreceptor)
+      write(unitoutreceptppt) (xreceptor(j)*dx+xlon0, &
+           yreceptor(j)*dy+ylat0,j=1,numreceptor)
+    endif
+  endif
+
+  return
+997   write(*,*) ' #### FLEXPART MODEL ERROR! THE FILE           #### '
+  write(*,*) ' ####              receptor_conc               #### '
+  write(*,*) ' #### CANNOT BE OPENED.                        #### '
+  stop
+
+998   write(*,*) ' #### FLEXPART MODEL ERROR! THE FILE           #### '
+  write(*,*) ' ####              receptor_pptv               #### '
+  write(*,*) ' #### CANNOT BE OPENED.                        #### '
+  stop
+end subroutine openreceptors
diff --git a/src/bin_writeheader_bin.f90 b/src/bin_writeheader_bin.f90
new file mode 100644
index 0000000000000000000000000000000000000000..1eba0fafcd119ec4b816dc07095a81e94dffd4f9
--- /dev/null
+++ b/src/bin_writeheader_bin.f90
@@ -0,0 +1,146 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine writeheader_bin
+
+  !*****************************************************************************
+  !                                                                            *
+  !  This routine produces a file header containing basic information on the   *
+  !  settings of the FLEXPART run.                                             *
+  !  The header file is essential and must be read in by any postprocessing    *
+  !  program before reading in the output data.                                *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     7 August 2002                                                          *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  !  Modified to remove TRIM around the output of flexversion so that          *
+  !  it will be a constant length (defined in com_mod.f90) in output header    *
+  !                                                                            *
+  !     Don Morton, Boreal Scientific Computing                                *
+  !     07 May 2017                                                            *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  ! xlon                   longitude                                           *
+  ! xl                     model x coordinate                                  *
+  ! ylat                   latitude                                            *
+  ! yl                     model y coordinate                                  *
+  !                                                                            *
+  !*****************************************************************************
+
+  use point_mod
+  use prepoutgrid_mod
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  integer :: jjjjmmdd,ihmmss,i,ix,jy,j
+  real :: xp1,yp1,xp2,yp2
+
+
+  !************************
+  ! Open header output file
+  !************************
+
+  open(unitheader,file=path(2)(1:length(2))//'header', &
+       form='unformatted',err=998)
+
+
+  ! Write the header information
+  !*****************************
+
+  if (ldirect.eq.1) then
+    write(unitheader) ibdate,ibtime, flexversion
+  else
+    write(unitheader) iedate,ietime, flexversion
+  endif
+
+  ! Write info on output interval, averaging time, sampling time
+  !*************************************************************
+
+  write(unitheader) loutstep,loutaver,loutsample
+
+  ! Write information on output grid setup
+  !***************************************
+
+  write(unitheader) outlon0,outlat0,numxgrid,numygrid, &
+       dxout,dyout
+  write(unitheader) numzgrid,(outheight(i),i=1,numzgrid)
+
+  call caldate(bdate,jjjjmmdd,ihmmss)
+  write(unitheader) jjjjmmdd,ihmmss
+
+  ! Write number of species, and name for each species (+extra name for depositions)
+  ! Indicate the dimension of the fields (i.e., 1 for deposition fields, numzgrid for
+  ! concentration fields
+  !*****************************************************************************
+
+  write(unitheader) 3*nspec,maxpointspec_act
+  do i=1,nspec
+    write(unitheader) 1,'WD_'//species(i)(1:7)
+    write(unitheader) 1,'DD_'//species(i)(1:7)
+    write(unitheader) numzgrid,species(i)
+  end do
+
+  ! Write information on release points: total number, then for each point:
+  ! start, end, coordinates, # of particles, name, mass
+  !************************************************************************
+
+  write(unitheader) numpoint
+  do i=1,numpoint
+    write(unitheader) ireleasestart(i),ireleaseend(i),kindz(i)
+    xp1=xpoint1(i)*dx+xlon0
+    yp1=ypoint1(i)*dy+ylat0
+    xp2=xpoint2(i)*dx+xlon0
+    yp2=ypoint2(i)*dy+ylat0
+    write(unitheader) xp1,yp1,xp2,yp2,zpoint1(i),zpoint2(i)
+    write(unitheader) npart(i),1
+    if (numpoint.le.1000) then
+      write(unitheader) compoint(i)
+    else
+      write(unitheader) compoint(1001)
+    endif
+    do j=1,nspec
+      write(unitheader) xmass(i,j)
+      write(unitheader) xmass(i,j)
+      write(unitheader) xmass(i,j)
+    end do
+  end do
+
+  ! Write information on some model switches
+  !*****************************************
+
+  write(unitheader) method,lsubgrid,lconvection, &
+       ind_source,ind_receptor
+
+  ! Write age class information
+  !****************************
+
+  write(unitheader) nageclass,(lage(i),i=1,nageclass)
+
+
+  ! Write topography to output file
+  !********************************
+
+  do ix=0,numxgrid-1
+    write(unitheader) (oroout(ix,jy),jy=0,numygrid-1)
+  end do
+  close(unitheader)
+
+  return
+
+
+998   write(*,*) ' #### FLEXPART MODEL ERROR!   THE FILE         #### '
+  write(*,*) ' #### '//path(2)(1:length(2))//'header'//' #### '
+  write(*,*) ' #### CANNOT BE OPENED. IF A FILE WITH THIS    #### '
+  write(*,*) ' #### NAME ALREADY EXISTS, DELETE IT AND START #### '
+  write(*,*) ' #### THE PROGRAM AGAIN.                       #### '
+  stop
+
+end subroutine writeheader_bin
diff --git a/src/bin_writeheader_bin_nest.f90 b/src/bin_writeheader_bin_nest.f90
new file mode 100644
index 0000000000000000000000000000000000000000..6e4a59421c024ca30faa8bedb6c54f1116b9127e
--- /dev/null
+++ b/src/bin_writeheader_bin_nest.f90
@@ -0,0 +1,141 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine writeheader_bin_nest
+
+  !*****************************************************************************
+  !                                                                            *
+  !  This routine produces a file header containing basic information on the   *
+  !  settings of the FLEXPART run.                                             *
+  !  The header file is essential and must be read in by any postprocessing    *
+  !  program before reading in the output data.                                *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     7 August 2002                                                          *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  !  Modified to remove TRIM around the output of flexversion so that          *
+  !  it will be a constant length (defined in com_mod.f90) in output header    *
+  !                                                                            *
+  !     Don Morton, Boreal Scientific Computing                                *
+  !     07 May 2017                                                            *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  ! xlon                   longitude                                           *
+  ! xl                     model x coordinate                                  *
+  ! ylat                   latitude                                            *
+  ! yl                     model y coordinate                                  *
+  !                                                                            *
+  !*****************************************************************************
+
+  implicit none
+
+  integer :: jjjjmmdd,ihmmss,i,ix,jy,j
+  real :: xp1,yp1,xp2,yp2
+
+
+  !************************
+  ! Open header output file
+  !************************
+
+  open(unitheader,file=path(2)(1:length(2))//'header_nest', &
+       form='unformatted',err=998)
+
+
+  ! Write the header information
+  !*****************************
+
+  if (ldirect.eq.1) then
+    write(unitheader) ibdate,ibtime, flexversion
+  else
+    write(unitheader) iedate,ietime, flexversion
+  endif
+
+  ! Write info on output interval, averaging time, sampling time
+  !*************************************************************
+
+  write(unitheader) loutstep,loutaver,loutsample
+
+  ! Write information on output grid setup
+  !***************************************
+
+  write(unitheader) outlon0n,outlat0n,numxgridn,numygridn, &
+       dxoutn,dyoutn
+  write(unitheader) numzgrid,(outheight(i),i=1,numzgrid)
+
+  call caldate(bdate,jjjjmmdd,ihmmss)
+  write(unitheader) jjjjmmdd,ihmmss
+
+  ! Write number of species, and name for each species (+extra name for depositions)
+  ! Indicate the dimension of the fields (i.e., 1 for deposition fields, numzgrid for
+  ! concentration fields
+  !*****************************************************************************
+
+  write(unitheader) 3*nspec,maxpointspec_act
+  do i=1,nspec
+    write(unitheader) 1,'WD_'//species(i)(1:7)
+    write(unitheader) 1,'DD_'//species(i)(1:7)
+    write(unitheader) numzgrid,species(i)
+  end do
+
+  ! Write information on release points: total number, then for each point:
+  ! start, end, coordinates, # of particles, name, mass
+  !************************************************************************
+
+  write(unitheader) numpoint
+  do i=1,numpoint
+    write(unitheader) ireleasestart(i),ireleaseend(i),kindz(i)
+    xp1=xpoint1(i)*dx+xlon0
+    yp1=ypoint1(i)*dy+ylat0
+    xp2=xpoint2(i)*dx+xlon0
+    yp2=ypoint2(i)*dy+ylat0
+    write(unitheader) xp1,yp1,xp2,yp2,zpoint1(i),zpoint2(i)
+    write(unitheader) npart(i),1
+    if (numpoint.le.1000) then
+      write(unitheader) compoint(i)
+    else
+      write(unitheader) compoint(1001)
+   endif
+    do j=1,nspec
+      write(unitheader) xmass(i,j)
+      write(unitheader) xmass(i,j)
+      write(unitheader) xmass(i,j)
+    end do
+  end do
+
+  ! Write information on some model switches
+  !*****************************************
+
+  write(unitheader) method,lsubgrid,lconvection, &
+       ind_source,ind_receptor
+
+  ! Write age class information
+  !****************************
+
+  write(unitheader) nageclass,(lage(i),i=1,nageclass)
+
+
+  ! Write topography to output file
+  !********************************
+
+  do ix=0,numxgridn-1
+    write(unitheader) (orooutn(ix,jy),jy=0,numygridn-1)
+  end do
+  close(unitheader)
+
+  return
+
+
+998   write(*,*) ' #### FLEXPART MODEL ERROR!   THE FILE         #### '
+  write(*,*) ' #### '//path(2)(1:length(2))//'header'//' #### '
+  write(*,*) ' #### CANNOT BE OPENED. IF A FILE WITH THIS    #### '
+  write(*,*) ' #### NAME ALREADY EXISTS, DELETE IT AND START #### '
+  write(*,*) ' #### THE PROGRAM AGAIN.                       #### '
+  stop
+
+end subroutine writeheader_bin_nest
diff --git a/src/bin_writeheader_bin_sfc.f90 b/src/bin_writeheader_bin_sfc.f90
new file mode 100644
index 0000000000000000000000000000000000000000..de2ecab7110961427013e3600f6fa5962e65d0fc
--- /dev/null
+++ b/src/bin_writeheader_bin_sfc.f90
@@ -0,0 +1,141 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine writeheader_bin_sfc
+
+  !*****************************************************************************
+  !                                                                            *
+  !  This routine produces a file header containing basic information on the   *
+  !  settings of the FLEXPART run.                                             *
+  !  The header file is essential and must be read in by any postprocessing    *
+  !  program before reading in the output data.                                *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     7 August 2002                                                          *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  !  Modified to remove TRIM around the output of flexversion so that          *
+  !  it will be a constant length (defined in com_mod.f90) in output header    *
+  !                                                                            *
+  !     Don Morton, Boreal Scientific Computing                                *
+  !     07 May 2017                                                            *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  ! xlon                   longitude                                           *
+  ! xl                     model x coordinate                                  *
+  ! ylat                   latitude                                            *
+  ! yl                     model y coordinate                                  *
+  !                                                                            *
+  !*****************************************************************************
+
+  implicit none
+
+  integer :: jjjjmmdd,ihmmss,i,ix,jy,j
+  real :: xp1,yp1,xp2,yp2
+
+
+  !************************
+  ! Open header output file
+  !************************
+
+  open(unitheader,file=path(2)(1:length(2))//'header_grid_time', &
+       form='unformatted',err=998)
+
+
+  ! Write the header information
+  !*****************************
+
+  if (ldirect.eq.1) then
+    write(unitheader) ibdate,ibtime, flexversion
+  else
+    write(unitheader) iedate,ietime, flexversion
+  endif
+
+  ! Write info on output interval, averaging time, sampling time
+  !*************************************************************
+
+  write(unitheader) loutstep,loutaver,loutsample
+
+  ! Write information on output grid setup
+  !***************************************
+
+  write(unitheader) outlon0,outlat0,numxgrid,numygrid, &
+       dxout,dyout
+  write(unitheader) 1,(outheight(1),i=1,1)
+
+  call caldate(bdate,jjjjmmdd,ihmmss)
+  write(unitheader) jjjjmmdd,ihmmss
+
+  ! Write number of species, and name for each species (+extra name for depositions)
+  ! Indicate the dimension of the fields (i.e., 1 for deposition fields, numzgrid for
+  ! concentration fields
+  !*****************************************************************************
+
+  write(unitheader) 3*nspec,maxpointspec_act
+  do i=1,nspec
+    write(unitheader) 1,'WD_'//species(i)(1:7)
+    write(unitheader) 1,'DD_'//species(i)(1:7)
+    write(unitheader) 1,species(i)
+  end do
+
+  ! Write information on release points: total number, then for each point:
+  ! start, end, coordinates, # of particles, name, mass
+  !************************************************************************
+
+  write(unitheader) numpoint
+  do i=1,numpoint
+    write(unitheader) ireleasestart(i),ireleaseend(i),kindz(i)
+    xp1=xpoint1(i)*dx+xlon0
+    yp1=ypoint1(i)*dy+ylat0
+    xp2=xpoint2(i)*dx+xlon0
+    yp2=ypoint2(i)*dy+ylat0
+    write(unitheader) xp1,yp1,xp2,yp2,zpoint1(i),zpoint2(i)
+    write(unitheader) npart(i),1
+    if (numpoint.le.1000) then
+      write(unitheader) compoint(i)
+    else
+      write(unitheader) compoint(1001)
+    endif
+    do j=1,nspec
+      write(unitheader) xmass(i,j)
+      write(unitheader) xmass(i,j)
+      write(unitheader) xmass(i,j)
+    end do
+  end do
+
+  ! Write information on some model switches
+  !*****************************************
+
+  write(unitheader) method,lsubgrid,lconvection, &
+       ind_source,ind_receptor
+
+  ! Write age class information
+  !****************************
+
+  write(unitheader) nageclass,(lage(i),i=1,nageclass)
+
+
+  ! Write topography to output file
+  !********************************
+
+  do ix=0,numxgrid-1
+    write(unitheader) (oroout(ix,jy),jy=0,numygrid-1)
+  end do
+  close(unitheader)
+
+  return
+
+
+998   write(*,*) ' #### FLEXPART MODEL ERROR!   THE FILE         #### '
+  write(*,*) ' #### '//path(2)(1:length(2))//'header'//' #### '
+  write(*,*) ' #### CANNOT BE OPENED. IF A FILE WITH THIS    #### '
+  write(*,*) ' #### NAME ALREADY EXISTS, DELETE IT AND START #### '
+  write(*,*) ' #### THE PROGRAM AGAIN.                       #### '
+  stop
+
+end subroutine writeheader_bin_sfc
diff --git a/src/bin_writeheader_bin_sfc_nest.f90 b/src/bin_writeheader_bin_sfc_nest.f90
new file mode 100644
index 0000000000000000000000000000000000000000..169248883a0477332ae6e1284fe2df52d92ab654
--- /dev/null
+++ b/src/bin_writeheader_bin_sfc_nest.f90
@@ -0,0 +1,141 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine writeheader_bin_sfc_nest
+
+  !*****************************************************************************
+  !                                                                            *
+  !  This routine produces a file header containing basic information on the   *
+  !  settings of the FLEXPART run.                                             *
+  !  The header file is essential and must be read in by any postprocessing    *
+  !  program before reading in the output data.                                *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     7 August 2002                                                          *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  !  Modified to remove TRIM around the output of flexversion so that          *
+  !  it will be a constant length (defined in com_mod.f90) in output header    *
+  !                                                                            *
+  !     Don Morton, Boreal Scientific Computing                                *
+  !     07 May 2017                                                            *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  ! xlon                   longitude                                           *
+  ! xl                     model x coordinate                                  *
+  ! ylat                   latitude                                            *
+  ! yl                     model y coordinate                                  *
+  !                                                                            *
+  !*****************************************************************************
+
+  implicit none
+
+  integer :: jjjjmmdd,ihmmss,i,ix,jy,j
+  real :: xp1,yp1,xp2,yp2
+
+
+  !************************
+  ! Open header output file
+  !************************
+
+  open(unitheader,file=path(2)(1:length(2))//'header_nest_grid_time', &
+       form='unformatted',err=998)
+
+
+  ! Write the header information
+  !*****************************
+
+  if (ldirect.eq.1) then
+    write(unitheader) ibdate,ibtime,flexversion
+  else
+    write(unitheader) iedate,ietime,flexversion
+  endif
+
+  ! Write info on output interval, averaging time, sampling time
+  !*************************************************************
+
+  write(unitheader) loutstep,loutaver,loutsample
+
+  ! Write information on output grid setup
+  !***************************************
+
+  write(unitheader) outlon0n,outlat0n,numxgridn,numygridn, &
+       dxoutn,dyoutn
+  write(unitheader) 1,(outheight(1),i=1,1)
+
+  call caldate(bdate,jjjjmmdd,ihmmss)
+  write(unitheader) jjjjmmdd,ihmmss
+
+  ! Write number of species, and name for each species (+extra name for depositions)
+  ! Indicate the dimension of the fields (i.e., 1 for deposition fields, numzgrid for
+  ! concentration fields
+  !*****************************************************************************
+
+  write(unitheader) 3*nspec,maxpointspec_act
+  do i=1,nspec
+    write(unitheader) 1,'WD_'//species(i)(1:7)
+    write(unitheader) 1,'DD_'//species(i)(1:7)
+    write(unitheader) 1,species(i)
+  end do
+
+  ! Write information on release points: total number, then for each point:
+  ! start, end, coordinates, # of particles, name, mass
+  !************************************************************************
+
+  write(unitheader) numpoint
+  do i=1,numpoint
+    write(unitheader) ireleasestart(i),ireleaseend(i),kindz(i)
+    xp1=xpoint1(i)*dx+xlon0
+    yp1=ypoint1(i)*dy+ylat0
+    xp2=xpoint2(i)*dx+xlon0
+    yp2=ypoint2(i)*dy+ylat0
+    write(unitheader) xp1,yp1,xp2,yp2,zpoint1(i),zpoint2(i)
+    write(unitheader) npart(i),1
+    if (numpoint.le.1000) then
+      write(unitheader) compoint(i)
+    else
+      write(unitheader) compoint(1001)
+   endif
+    do j=1,nspec
+      write(unitheader) xmass(i,j)
+      write(unitheader) xmass(i,j)
+      write(unitheader) xmass(i,j)
+    end do
+  end do
+
+  ! Write information on some model switches
+  !*****************************************
+
+  write(unitheader) method,lsubgrid,lconvection, &
+       ind_source,ind_receptor
+
+  ! Write age class information
+  !****************************
+
+  write(unitheader) nageclass,(lage(i),i=1,nageclass)
+
+
+  ! Write topography to output file
+  !********************************
+
+  do ix=0,numxgridn-1
+    write(unitheader) (orooutn(ix,jy),jy=0,numygridn-1)
+  end do
+  close(unitheader)
+
+  return
+
+
+998   write(*,*) ' #### FLEXPART MODEL ERROR!   THE FILE         #### '
+  write(*,*) ' #### '//path(2)(1:length(2))//'header'//' #### '
+  write(*,*) ' #### CANNOT BE OPENED. IF A FILE WITH THIS    #### '
+  write(*,*) ' #### NAME ALREADY EXISTS, DELETE IT AND START #### '
+  write(*,*) ' #### THE PROGRAM AGAIN.                       #### '
+  stop
+
+end subroutine writeheader_bin_sfc_nest
diff --git a/src/binary_output_mod.f90 b/src/binary_output_mod.f90
index 0a194f56e9786d8f4dec1d2a3e8c5bb1bad66fa5..174e62933c7a6caafafbc29b3b242ee31aeb9987 100644
--- a/src/binary_output_mod.f90
+++ b/src/binary_output_mod.f90
@@ -13,7 +13,7 @@
   !   L. Bakels 2022                                                           *
   !                                                                            *
   !*****************************************************************************
-  
+
 module binary_output_mod
 
   use point_mod
@@ -27,4521 +27,31 @@ module binary_output_mod
 
 contains
 
-subroutine writeheader_bin
-
-  !*****************************************************************************
-  !                                                                            *
-  !  This routine produces a file header containing basic information on the   *
-  !  settings of the FLEXPART run.                                             *
-  !  The header file is essential and must be read in by any postprocessing    *
-  !  program before reading in the output data.                                *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     7 August 2002                                                          *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  !  Modified to remove TRIM around the output of flexversion so that          *
-  !  it will be a constant length (defined in com_mod.f90) in output header    *
-  !                                                                            *
-  !     Don Morton, Boreal Scientific Computing                                *
-  !     07 May 2017                                                            *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  !                                                                            *
-  ! xlon                   longitude                                           *
-  ! xl                     model x coordinate                                  *
-  ! ylat                   latitude                                            *
-  ! yl                     model y coordinate                                  *
-  !                                                                            *
-  !*****************************************************************************
-
-  use point_mod
-  use prepoutgrid_mod
-  use par_mod
-  use com_mod
-
-  implicit none
-
-  integer :: jjjjmmdd,ihmmss,i,ix,jy,j
-  real :: xp1,yp1,xp2,yp2
-
-
-  !************************
-  ! Open header output file
-  !************************
-
-  open(unitheader,file=path(2)(1:length(2))//'header', &
-       form='unformatted',err=998)
-
-
-  ! Write the header information
-  !*****************************
-
-  if (ldirect.eq.1) then
-    write(unitheader) ibdate,ibtime, flexversion
-  else
-    write(unitheader) iedate,ietime, flexversion
-  endif
-
-  ! Write info on output interval, averaging time, sampling time
-  !*************************************************************
-
-  write(unitheader) loutstep,loutaver,loutsample
-
-  ! Write information on output grid setup
-  !***************************************
-
-  write(unitheader) outlon0,outlat0,numxgrid,numygrid, &
-       dxout,dyout
-  write(unitheader) numzgrid,(outheight(i),i=1,numzgrid)
-
-  call caldate(bdate,jjjjmmdd,ihmmss)
-  write(unitheader) jjjjmmdd,ihmmss
-
-  ! Write number of species, and name for each species (+extra name for depositions)
-  ! Indicate the dimension of the fields (i.e., 1 for deposition fields, numzgrid for
-  ! concentration fields
-  !*****************************************************************************
-
-  write(unitheader) 3*nspec,maxpointspec_act
-  do i=1,nspec
-    write(unitheader) 1,'WD_'//species(i)(1:7)
-    write(unitheader) 1,'DD_'//species(i)(1:7)
-    write(unitheader) numzgrid,species(i)
-  end do
-
-  ! Write information on release points: total number, then for each point:
-  ! start, end, coordinates, # of particles, name, mass
-  !************************************************************************
-
-  write(unitheader) numpoint
-  do i=1,numpoint
-    write(unitheader) ireleasestart(i),ireleaseend(i),kindz(i)
-    xp1=xpoint1(i)*dx+xlon0
-    yp1=ypoint1(i)*dy+ylat0
-    xp2=xpoint2(i)*dx+xlon0
-    yp2=ypoint2(i)*dy+ylat0
-    write(unitheader) xp1,yp1,xp2,yp2,zpoint1(i),zpoint2(i)
-    write(unitheader) npart(i),1
-    if (numpoint.le.1000) then
-      write(unitheader) compoint(i)
-    else
-      write(unitheader) compoint(1001)
-    endif
-    do j=1,nspec
-      write(unitheader) xmass(i,j)
-      write(unitheader) xmass(i,j)
-      write(unitheader) xmass(i,j)
-    end do
-  end do
-
-  ! Write information on some model switches
-  !*****************************************
-
-  write(unitheader) method,lsubgrid,lconvection, &
-       ind_source,ind_receptor
-
-  ! Write age class information
-  !****************************
-
-  write(unitheader) nageclass,(lage(i),i=1,nageclass)
-
-
-  ! Write topography to output file
-  !********************************
-
-  do ix=0,numxgrid-1
-    write(unitheader) (oroout(ix,jy),jy=0,numygrid-1)
-  end do
-  close(unitheader)
-
-  return
-
-
-998   write(*,*) ' #### FLEXPART MODEL ERROR!   THE FILE         #### '
-  write(*,*) ' #### '//path(2)(1:length(2))//'header'//' #### '
-  write(*,*) ' #### CANNOT BE OPENED. IF A FILE WITH THIS    #### '
-  write(*,*) ' #### NAME ALREADY EXISTS, DELETE IT AND START #### '
-  write(*,*) ' #### THE PROGRAM AGAIN.                       #### '
-  stop
-
-end subroutine writeheader_bin
-
-subroutine writeheader_bin_nest
-
-  !*****************************************************************************
-  !                                                                            *
-  !  This routine produces a file header containing basic information on the   *
-  !  settings of the FLEXPART run.                                             *
-  !  The header file is essential and must be read in by any postprocessing    *
-  !  program before reading in the output data.                                *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     7 August 2002                                                          *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  !  Modified to remove TRIM around the output of flexversion so that          *
-  !  it will be a constant length (defined in com_mod.f90) in output header    *
-  !                                                                            *
-  !     Don Morton, Boreal Scientific Computing                                *
-  !     07 May 2017                                                            *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  !                                                                            *
-  ! xlon                   longitude                                           *
-  ! xl                     model x coordinate                                  *
-  ! ylat                   latitude                                            *
-  ! yl                     model y coordinate                                  *
-  !                                                                            *
-  !*****************************************************************************
-
-  implicit none
-
-  integer :: jjjjmmdd,ihmmss,i,ix,jy,j
-  real :: xp1,yp1,xp2,yp2
-
-
-  !************************
-  ! Open header output file
-  !************************
-
-  open(unitheader,file=path(2)(1:length(2))//'header_nest', &
-       form='unformatted',err=998)
-
-
-  ! Write the header information
-  !*****************************
-
-  if (ldirect.eq.1) then
-    write(unitheader) ibdate,ibtime, flexversion
-  else
-    write(unitheader) iedate,ietime, flexversion
-  endif
-
-  ! Write info on output interval, averaging time, sampling time
-  !*************************************************************
-
-  write(unitheader) loutstep,loutaver,loutsample
-
-  ! Write information on output grid setup
-  !***************************************
-
-  write(unitheader) outlon0n,outlat0n,numxgridn,numygridn, &
-       dxoutn,dyoutn
-  write(unitheader) numzgrid,(outheight(i),i=1,numzgrid)
-
-  call caldate(bdate,jjjjmmdd,ihmmss)
-  write(unitheader) jjjjmmdd,ihmmss
-
-  ! Write number of species, and name for each species (+extra name for depositions)
-  ! Indicate the dimension of the fields (i.e., 1 for deposition fields, numzgrid for
-  ! concentration fields
-  !*****************************************************************************
-
-  write(unitheader) 3*nspec,maxpointspec_act
-  do i=1,nspec
-    write(unitheader) 1,'WD_'//species(i)(1:7)
-    write(unitheader) 1,'DD_'//species(i)(1:7)
-    write(unitheader) numzgrid,species(i)
-  end do
-
-  ! Write information on release points: total number, then for each point:
-  ! start, end, coordinates, # of particles, name, mass
-  !************************************************************************
-
-  write(unitheader) numpoint
-  do i=1,numpoint
-    write(unitheader) ireleasestart(i),ireleaseend(i),kindz(i)
-    xp1=xpoint1(i)*dx+xlon0
-    yp1=ypoint1(i)*dy+ylat0
-    xp2=xpoint2(i)*dx+xlon0
-    yp2=ypoint2(i)*dy+ylat0
-    write(unitheader) xp1,yp1,xp2,yp2,zpoint1(i),zpoint2(i)
-    write(unitheader) npart(i),1
-    if (numpoint.le.1000) then
-      write(unitheader) compoint(i)
-    else
-      write(unitheader) compoint(1001)
-   endif
-    do j=1,nspec
-      write(unitheader) xmass(i,j)
-      write(unitheader) xmass(i,j)
-      write(unitheader) xmass(i,j)
-    end do
-  end do
-
-  ! Write information on some model switches
-  !*****************************************
-
-  write(unitheader) method,lsubgrid,lconvection, &
-       ind_source,ind_receptor
-
-  ! Write age class information
-  !****************************
-
-  write(unitheader) nageclass,(lage(i),i=1,nageclass)
-
-
-  ! Write topography to output file
-  !********************************
-
-  do ix=0,numxgridn-1
-    write(unitheader) (orooutn(ix,jy),jy=0,numygridn-1)
-  end do
-  close(unitheader)
-
-  return
-
-
-998   write(*,*) ' #### FLEXPART MODEL ERROR!   THE FILE         #### '
-  write(*,*) ' #### '//path(2)(1:length(2))//'header'//' #### '
-  write(*,*) ' #### CANNOT BE OPENED. IF A FILE WITH THIS    #### '
-  write(*,*) ' #### NAME ALREADY EXISTS, DELETE IT AND START #### '
-  write(*,*) ' #### THE PROGRAM AGAIN.                       #### '
-  stop
-
-end subroutine writeheader_bin_nest
-
-subroutine writeheader_bin_sfc_nest
-
-  !*****************************************************************************
-  !                                                                            *
-  !  This routine produces a file header containing basic information on the   *
-  !  settings of the FLEXPART run.                                             *
-  !  The header file is essential and must be read in by any postprocessing    *
-  !  program before reading in the output data.                                *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     7 August 2002                                                          *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  !  Modified to remove TRIM around the output of flexversion so that          *
-  !  it will be a constant length (defined in com_mod.f90) in output header    *
-  !                                                                            *
-  !     Don Morton, Boreal Scientific Computing                                *
-  !     07 May 2017                                                            *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  !                                                                            *
-  ! xlon                   longitude                                           *
-  ! xl                     model x coordinate                                  *
-  ! ylat                   latitude                                            *
-  ! yl                     model y coordinate                                  *
-  !                                                                            *
-  !*****************************************************************************
-
-  implicit none
-
-  integer :: jjjjmmdd,ihmmss,i,ix,jy,j
-  real :: xp1,yp1,xp2,yp2
-
-
-  !************************
-  ! Open header output file
-  !************************
-
-  open(unitheader,file=path(2)(1:length(2))//'header_nest_grid_time', &
-       form='unformatted',err=998)
-
-
-  ! Write the header information
-  !*****************************
-
-  if (ldirect.eq.1) then
-    write(unitheader) ibdate,ibtime,flexversion
-  else
-    write(unitheader) iedate,ietime,flexversion
-  endif
-
-  ! Write info on output interval, averaging time, sampling time
-  !*************************************************************
-
-  write(unitheader) loutstep,loutaver,loutsample
-
-  ! Write information on output grid setup
-  !***************************************
-
-  write(unitheader) outlon0n,outlat0n,numxgridn,numygridn, &
-       dxoutn,dyoutn
-  write(unitheader) 1,(outheight(1),i=1,1)
-
-  call caldate(bdate,jjjjmmdd,ihmmss)
-  write(unitheader) jjjjmmdd,ihmmss
-
-  ! Write number of species, and name for each species (+extra name for depositions)
-  ! Indicate the dimension of the fields (i.e., 1 for deposition fields, numzgrid for
-  ! concentration fields
-  !*****************************************************************************
-
-  write(unitheader) 3*nspec,maxpointspec_act
-  do i=1,nspec
-    write(unitheader) 1,'WD_'//species(i)(1:7)
-    write(unitheader) 1,'DD_'//species(i)(1:7)
-    write(unitheader) 1,species(i)
-  end do
-
-  ! Write information on release points: total number, then for each point:
-  ! start, end, coordinates, # of particles, name, mass
-  !************************************************************************
-
-  write(unitheader) numpoint
-  do i=1,numpoint
-    write(unitheader) ireleasestart(i),ireleaseend(i),kindz(i)
-    xp1=xpoint1(i)*dx+xlon0
-    yp1=ypoint1(i)*dy+ylat0
-    xp2=xpoint2(i)*dx+xlon0
-    yp2=ypoint2(i)*dy+ylat0
-    write(unitheader) xp1,yp1,xp2,yp2,zpoint1(i),zpoint2(i)
-    write(unitheader) npart(i),1
-    if (numpoint.le.1000) then
-      write(unitheader) compoint(i)
-    else
-      write(unitheader) compoint(1001)
-   endif
-    do j=1,nspec
-      write(unitheader) xmass(i,j)
-      write(unitheader) xmass(i,j)
-      write(unitheader) xmass(i,j)
-    end do
-  end do
-
-  ! Write information on some model switches
-  !*****************************************
-
-  write(unitheader) method,lsubgrid,lconvection, &
-       ind_source,ind_receptor
-
-  ! Write age class information
-  !****************************
-
-  write(unitheader) nageclass,(lage(i),i=1,nageclass)
-
-
-  ! Write topography to output file
-  !********************************
-
-  do ix=0,numxgridn-1
-    write(unitheader) (orooutn(ix,jy),jy=0,numygridn-1)
-  end do
-  close(unitheader)
-
-  return
-
-
-998   write(*,*) ' #### FLEXPART MODEL ERROR!   THE FILE         #### '
-  write(*,*) ' #### '//path(2)(1:length(2))//'header'//' #### '
-  write(*,*) ' #### CANNOT BE OPENED. IF A FILE WITH THIS    #### '
-  write(*,*) ' #### NAME ALREADY EXISTS, DELETE IT AND START #### '
-  write(*,*) ' #### THE PROGRAM AGAIN.                       #### '
-  stop
-
-end subroutine writeheader_bin_sfc_nest
-
-subroutine writeheader_bin_sfc
-
-  !*****************************************************************************
-  !                                                                            *
-  !  This routine produces a file header containing basic information on the   *
-  !  settings of the FLEXPART run.                                             *
-  !  The header file is essential and must be read in by any postprocessing    *
-  !  program before reading in the output data.                                *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     7 August 2002                                                          *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  !  Modified to remove TRIM around the output of flexversion so that          *
-  !  it will be a constant length (defined in com_mod.f90) in output header    *
-  !                                                                            *
-  !     Don Morton, Boreal Scientific Computing                                *
-  !     07 May 2017                                                            *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  !                                                                            *
-  ! xlon                   longitude                                           *
-  ! xl                     model x coordinate                                  *
-  ! ylat                   latitude                                            *
-  ! yl                     model y coordinate                                  *
-  !                                                                            *
-  !*****************************************************************************
-
-  implicit none
-
-  integer :: jjjjmmdd,ihmmss,i,ix,jy,j
-  real :: xp1,yp1,xp2,yp2
-
-
-  !************************
-  ! Open header output file
-  !************************
-
-  open(unitheader,file=path(2)(1:length(2))//'header_grid_time', &
-       form='unformatted',err=998)
-
-
-  ! Write the header information
-  !*****************************
-
-  if (ldirect.eq.1) then
-    write(unitheader) ibdate,ibtime, flexversion
-  else
-    write(unitheader) iedate,ietime, flexversion
-  endif
-
-  ! Write info on output interval, averaging time, sampling time
-  !*************************************************************
-
-  write(unitheader) loutstep,loutaver,loutsample
-
-  ! Write information on output grid setup
-  !***************************************
-
-  write(unitheader) outlon0,outlat0,numxgrid,numygrid, &
-       dxout,dyout
-  write(unitheader) 1,(outheight(1),i=1,1)
-
-  call caldate(bdate,jjjjmmdd,ihmmss)
-  write(unitheader) jjjjmmdd,ihmmss
-
-  ! Write number of species, and name for each species (+extra name for depositions)
-  ! Indicate the dimension of the fields (i.e., 1 for deposition fields, numzgrid for
-  ! concentration fields
-  !*****************************************************************************
-
-  write(unitheader) 3*nspec,maxpointspec_act
-  do i=1,nspec
-    write(unitheader) 1,'WD_'//species(i)(1:7)
-    write(unitheader) 1,'DD_'//species(i)(1:7)
-    write(unitheader) 1,species(i)
-  end do
-
-  ! Write information on release points: total number, then for each point:
-  ! start, end, coordinates, # of particles, name, mass
-  !************************************************************************
-
-  write(unitheader) numpoint
-  do i=1,numpoint
-    write(unitheader) ireleasestart(i),ireleaseend(i),kindz(i)
-    xp1=xpoint1(i)*dx+xlon0
-    yp1=ypoint1(i)*dy+ylat0
-    xp2=xpoint2(i)*dx+xlon0
-    yp2=ypoint2(i)*dy+ylat0
-    write(unitheader) xp1,yp1,xp2,yp2,zpoint1(i),zpoint2(i)
-    write(unitheader) npart(i),1
-    if (numpoint.le.1000) then
-      write(unitheader) compoint(i)
-    else
-      write(unitheader) compoint(1001)
-    endif
-    do j=1,nspec
-      write(unitheader) xmass(i,j)
-      write(unitheader) xmass(i,j)
-      write(unitheader) xmass(i,j)
-    end do
-  end do
-
-  ! Write information on some model switches
-  !*****************************************
-
-  write(unitheader) method,lsubgrid,lconvection, &
-       ind_source,ind_receptor
-
-  ! Write age class information
-  !****************************
-
-  write(unitheader) nageclass,(lage(i),i=1,nageclass)
-
-
-  ! Write topography to output file
-  !********************************
-
-  do ix=0,numxgrid-1
-    write(unitheader) (oroout(ix,jy),jy=0,numygrid-1)
-  end do
-  close(unitheader)
-
-  return
-
-
-998   write(*,*) ' #### FLEXPART MODEL ERROR!   THE FILE         #### '
-  write(*,*) ' #### '//path(2)(1:length(2))//'header'//' #### '
-  write(*,*) ' #### CANNOT BE OPENED. IF A FILE WITH THIS    #### '
-  write(*,*) ' #### NAME ALREADY EXISTS, DELETE IT AND START #### '
-  write(*,*) ' #### THE PROGRAM AGAIN.                       #### '
-  stop
-
-end subroutine writeheader_bin_sfc
-
-subroutine openreceptors
-
-  !*****************************************************************************
-  !                                                                            *
-  !  This routine opens the receptor output files and writes out the receptor  *
-  !  names and the receptor locations. The receptor output files are not       *
-  !  closed, but kept open throughout the simulation. Concentrations are       *
-  !  continuously  dumped to these files.                                      *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     7 August 2002                                                          *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! numreceptor            actual number of receptor points specified          *
-  ! receptornames          names of the receptor points                        *
-  ! xreceptor,yreceptor    coordinates of the receptor points                  *
-  !                                                                            *
-  !*****************************************************************************
-
-  use par_mod
-  use com_mod
-
-  implicit none
-
-  integer :: j
-
-  ! Open output file for receptor points and write out a short header
-  ! containing receptor names and locations
-  !******************************************************************
-
-  if (numreceptor.ge.1) then           ! do it only if receptors are specified
-
-  ! Concentration output
-  !*********************
-
-    if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
-      open(unitoutrecept,file=path(2)(1:length(2))//'receptor_conc', &
-           form='unformatted',err=997)
-      write(unitoutrecept) (receptorname(j),j=1,numreceptor)
-      write(unitoutrecept) (xreceptor(j)*dx+xlon0, &
-           yreceptor(j)*dy+ylat0,j=1,numreceptor)
-    endif
-
-  ! Mixing ratio output
-  !********************
-
-    if ((iout.eq.2).or.(iout.eq.3)) then
-      open(unitoutreceptppt,file=path(2)(1:length(2))//'receptor_pptv', &
-           form='unformatted',err=998)
-      write(unitoutreceptppt) (receptorname(j),j=1,numreceptor)
-      write(unitoutreceptppt) (xreceptor(j)*dx+xlon0, &
-           yreceptor(j)*dy+ylat0,j=1,numreceptor)
-    endif
-  endif
-
-  return
-997   write(*,*) ' #### FLEXPART MODEL ERROR! THE FILE           #### '
-  write(*,*) ' ####              receptor_conc               #### '
-  write(*,*) ' #### CANNOT BE OPENED.                        #### '
-  stop
-
-998   write(*,*) ' #### FLEXPART MODEL ERROR! THE FILE           #### '
-  write(*,*) ' ####              receptor_pptv               #### '
-  write(*,*) ' #### CANNOT BE OPENED.                        #### '
-  stop
-end subroutine openreceptors
-
-
-subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, &
-     drygridtotalunc)
-  !                        i     i          o             o
-  !       o
-  !*****************************************************************************
-  !                                                                            *
-  !     Output of the concentration grid and the receptor concentrations.      *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     24 May 1995                                                            *
-  !                                                                            *
-  !     13 April 1999, Major update: if output size is smaller, dump output    *
-  !                    in sparse matrix format; additional output of           *
-  !                    uncertainty                                             *
-  !                                                                            *
-  !     05 April 2000, Major update: output of age classes; output for backward*
-  !                    runs is time spent in grid cell times total mass of     *
-  !                    species.                                                *
-  !                                                                            *
-  !     17 February 2002, Appropriate dimensions for backward and forward runs *
-  !                       are now specified in file par_mod                    *
-  !                                                                            *
-  !     June 2006, write grid in sparse matrix with a single write command     *
-  !                in order to save disk space                                 *
-  !                                                                            *
-  !     2008 new sparse matrix format                                          *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! outnum          number of samples                                          *
-  ! ncells          number of cells with non-zero concentrations               *
-  ! sparse          .true. if in sparse matrix format, else .false.            *
-  ! tot_mu          1 for forward, initial mass mixing ration for backw. runs  *
-  !                                                                            *
-  !*****************************************************************************
-
-  use unc_mod
-  use mean_mod
-
-  implicit none
-
-  real(kind=dp) :: jul
-  integer :: itime,i,ix,jy,kz,ks,kp,l,iix,jjy,kzz,nage,jjjjmmdd,ihmmss
-  integer :: sp_count_i,sp_count_r
-  real :: sp_fact
-  real :: outnum,densityoutrecept(maxreceptor),xl,yl
-  ! RLT
-  real :: densitydryrecept(maxreceptor)
-  real :: factor_dryrecept(maxreceptor)
-
-  real(dep_prec) :: auxgrid(nclassunc)
-  real(sp) :: gridtotal,gridsigmatotal,gridtotalunc
-  real(dep_prec) :: wetgridtotal,wetgridsigmatotal,wetgridtotalunc
-  real(dep_prec) :: drygridtotal,drygridsigmatotal,drygridtotalunc
-  real :: halfheight,dz,dz1,dz2,tot_mu(maxspec,maxpointspec_act)
-  real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
-  real,parameter :: weightair=28.97
-  logical :: sp_zer
-  logical,save :: init=.true.
-  character :: adate*8,atime*6
-  character(len=3) :: anspec
-  integer :: mind
-  character(LEN=8),save :: file_stat='REPLACE'
-  logical :: ldates_file
-  logical :: lexist
-  integer :: ierr
-  character(LEN=100) :: dates_char
-
-  ! Determine current calendar date, needed for the file name
-  !**********************************************************
-
-  jul=bdate+real(itime,kind=dp)/86400._dp
-  call caldate(jul,jjjjmmdd,ihmmss)
-  write(adate,'(i8.8)') jjjjmmdd
-  write(atime,'(i6.6)') ihmmss
-
-  ! Overwrite existing dates file on first call, later append to it
-  ! This fixes a bug where the dates file kept growing across multiple runs
-
-  ! If 'dates' file exists in output directory, make a backup
-  inquire(file=path(2)(1:length(2))//'dates', exist=ldates_file)
-  if (ldates_file.and.init) then
-    open(unit=unitdates, file=path(2)(1:length(2))//'dates',form='formatted', &
-         &access='sequential', status='old', action='read', iostat=ierr)
-    open(unit=unittmp, file=path(2)(1:length(2))//'dates.bak', access='sequential', &
-         &status='replace', action='write', form='formatted', iostat=ierr)
-    do while (.true.)
-      read(unitdates, '(a)', iostat=ierr) dates_char
-      if (ierr.ne.0) exit
-      write(unit=unittmp, fmt='(a)', iostat=ierr, advance='yes') trim(dates_char)
-    end do
-    close(unit=unitdates)
-    close(unit=unittmp)
-  end if
-
-  open(unitdates,file=path(2)(1:length(2))//'dates', ACCESS='APPEND', STATUS=file_stat)
-  write(unitdates,'(a)') adate//atime
-  close(unitdates)  
-
-  ! Overwrite existing dates file on first call, later append to it
-  ! This fixes a bug where the dates file kept growing across multiple runs
-  IF (init) THEN
-    file_stat='OLD'
-    init=.false.
-  END IF
-
-
-  ! For forward simulations, output fields have dimension MAXSPEC,
-  ! for backward simulations, output fields have dimension MAXPOINT.
-  ! Thus, make loops either about nspec, or about numpoint
-  !*****************************************************************
-
-
-  if (ldirect.eq.1) then
-    do ks=1,nspec
-      do kp=1,maxpointspec_act
-        tot_mu(ks,kp)=1
-      end do
-    end do
-  else
-    do ks=1,nspec
-      do kp=1,maxpointspec_act
-        tot_mu(ks,kp)=xmass(kp,ks)
-      end do
-    end do
-  endif
-
-
-  !*******************************************************************
-  ! Compute air density: sufficiently accurate to take it
-  ! from coarse grid at some time
-  ! Determine center altitude of output layer, and interpolate density
-  ! data to that altitude
-  !*******************************************************************
-
-  mind=memind(2)
-  do kz=1,numzgrid
-    if (kz.eq.1) then
-      halfheight=outheight(1)/2.
-    else
-      halfheight=(outheight(kz)+outheight(kz-1))/2.
-    endif
-    do kzz=2,nz
-      if ((height(kzz-1).lt.halfheight).and. &
-           (height(kzz).gt.halfheight)) goto 46
-    end do
-46  kzz=max(min(kzz,nz),2)
-    dz1=halfheight-height(kzz-1)
-    dz2=height(kzz)-halfheight
-    dz=dz1+dz2
-    do jy=0,numygrid-1
-      do ix=0,numxgrid-1
-        xl=outlon0+real(ix)*dxout
-        yl=outlat0+real(jy)*dyout
-        xl=(xl-xlon0)/dx
-        yl=(yl-ylat0)/dy !v9.1.1 
-        iix=max(min(nint(xl),nxmin1),0)
-        jjy=max(min(nint(yl),nymin1),0)
-  ! densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,2)*dz1+ &
-  !      rho(iix,jjy,kzz-1,2)*dz2)/dz
-        densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,mind)*dz1+ &
-             rho(iix,jjy,kzz-1,mind)*dz2)/dz
-  ! RLT
-        densitydrygrid(ix,jy,kz)=(rho_dry(iix,jjy,kzz,mind)*dz1+ &
-             rho_dry(iix,jjy,kzz-1,mind)*dz2)/dz  
-      end do
-    end do
-  end do
-
-  do i=1,numreceptor
-    xl=xreceptor(i)
-    yl=yreceptor(i)
-    iix=max(min(nint(xl),nxmin1),0)
-    jjy=max(min(nint(yl),nymin1),0)
-  !densityoutrecept(i)=rho(iix,jjy,1,2)
-    densityoutrecept(i)=rho(iix,jjy,1,mind)
-  ! RLT
-    densitydryrecept(i)=rho_dry(iix,jjy,1,mind)
-  end do
-
-  ! RLT
-  ! conversion factor for output relative to dry air
-  factor_drygrid=densityoutgrid/densitydrygrid
-  factor_dryrecept=densityoutrecept/densitydryrecept
-
-  ! Output is different for forward and backward simulations
-  do kz=1,numzgrid
-    do jy=0,numygrid-1
-      do ix=0,numxgrid-1
-        if (ldirect.eq.1) then
-          factor3d(ix,jy,kz)=1.e12/volume(ix,jy,kz)/outnum
-        else
-          factor3d(ix,jy,kz)=real(abs(loutaver))/outnum
-        endif
-      end do
-    end do
-  end do
-
-  !*********************************************************************
-  ! Determine the standard deviation of the mean concentration or mixing
-  ! ratio (uncertainty of the output) and the dry and wet deposition
-  !*********************************************************************
-
-  gridtotal=0.
-  gridsigmatotal=0.
-  gridtotalunc=0.
-  wetgridtotal=0.
-  wetgridsigmatotal=0.
-  wetgridtotalunc=0.
-  drygridtotal=0.
-  drygridsigmatotal=0.
-  drygridtotalunc=0.
-
-  do ks=1,nspec
-
-    write(anspec,'(i3.3)') ks
-
-    if (DRYBKDEP.or.WETBKDEP) then !scavdep output
-      if (DRYBKDEP) & 
-      open(unitoutgrid,file=path(2)(1:length(2))//'grid_drydep_'//adate// &
-           atime//'_'//anspec,form='unformatted')
-      if (WETBKDEP) & 
-      open(unitoutgrid,file=path(2)(1:length(2))//'grid_wetdep_'//adate// &
-           atime//'_'//anspec,form='unformatted')
-      write(unitoutgrid) itime
-    else
-      if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
-        if (ldirect.eq.1) then
-          open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_'//adate// &
-             atime//'_'//anspec,form='unformatted')
-        else
-          open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_'//adate// &
-             atime//'_'//anspec,form='unformatted')
-        endif
-        write(unitoutgrid) itime
-      endif
-      if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
-        open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_'//adate// &
-           atime//'_'//anspec,form='unformatted')
-        write(unitoutgridppt) itime
-      endif
-    endif ! if deposition output
-
-    do kp=1,maxpointspec_act
-      do nage=1,nageclass
-
-        do jy=0,numygrid-1
-          do ix=0,numxgrid-1
-
-  ! WET DEPOSITION
-            if ((WETDEP).and.(ldirect.gt.0)) then
-              do l=1,nclassunc
-                auxgrid(l)=wetgridunc(ix,jy,ks,kp,l,nage)
-              end do
-              call mean(auxgrid,wetgrid(ix,jy), &
-                   wetgridsigma(ix,jy),nclassunc)
-  ! Multiply by number of classes to get total concentration
-              wetgrid(ix,jy)=wetgrid(ix,jy) &
-                   *nclassunc
-              wetgridtotal=wetgridtotal+wetgrid(ix,jy)
-  ! Calculate standard deviation of the mean
-              wetgridsigma(ix,jy)= &
-                   wetgridsigma(ix,jy)* &
-                   sqrt(real(nclassunc))
-              wetgridsigmatotal=wetgridsigmatotal+ &
-                   wetgridsigma(ix,jy)
-            endif
-
-  ! DRY DEPOSITION
-            if ((DRYDEP).and.(ldirect.gt.0)) then
-              do l=1,nclassunc
-                auxgrid(l)=drygridunc(ix,jy,ks,kp,l,nage)
-              end do
-              call mean(auxgrid,drygrid(ix,jy), &
-                   drygridsigma(ix,jy),nclassunc)
-  ! Multiply by number of classes to get total concentration
-              drygrid(ix,jy)=drygrid(ix,jy)* &
-                   nclassunc
-              drygridtotal=drygridtotal+drygrid(ix,jy)
-  ! Calculate standard deviation of the mean
-              drygridsigma(ix,jy)= &
-                   drygridsigma(ix,jy)* &
-                   sqrt(real(nclassunc))
-              drygridsigmatotal=drygridsigmatotal+ &
-                   drygridsigma(ix,jy)
-            endif
-
-  ! CONCENTRATION OR MIXING RATIO
-            do kz=1,numzgrid
-              do l=1,nclassunc
-                auxgrid(l)=gridunc(ix,jy,kz,ks,kp,l,nage)
-              end do
-              call mean(auxgrid,grid(ix,jy,kz), &
-                   gridsigma(ix,jy,kz),nclassunc)
-  ! Multiply by number of classes to get total concentration
-              grid(ix,jy,kz)= &
-                   grid(ix,jy,kz)*nclassunc
-              gridtotal=gridtotal+grid(ix,jy,kz)
-  ! Calculate standard deviation of the mean
-              gridsigma(ix,jy,kz)= &
-                   gridsigma(ix,jy,kz)* &
-                   sqrt(real(nclassunc))
-              gridsigmatotal=gridsigmatotal+ &
-                   gridsigma(ix,jy,kz)
-            end do
-          end do
-        end do
-
-  !*******************************************************************
-  ! Generate output: may be in concentration (ng/m3) or in mixing
-  ! ratio (ppt) or both
-  ! Output the position and the values alternated multiplied by
-  ! 1 or -1, first line is number of values, number of positions
-  ! For backward simulations, the unit is seconds, stored in grid_time
-  !*******************************************************************
-
-  ! Concentration output
-  !*********************
-        if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
-
-  ! Wet deposition
-          sp_count_i=0
-          sp_count_r=0
-          sp_fact=-1.
-          sp_zer=.true.
-          if ((ldirect.eq.1).and.(WETDEP)) then
-            do jy=0,numygrid-1
-              do ix=0,numxgrid-1
-  !oncentraion greater zero
-                if (wetgrid(ix,jy).gt.smallnum) then
-                  if (sp_zer.eqv..true.) then ! first non zero value
-                    sp_count_i=sp_count_i+1
-                    sparse_dump_i(sp_count_i)=ix+jy*numxgrid
-                    sp_zer=.false.
-                    sp_fact=sp_fact*(-1.)
-                  endif
-                  sp_count_r=sp_count_r+1
-                  sparse_dump_r(sp_count_r)= &
-                       sp_fact*1.e12*wetgrid(ix,jy)/area(ix,jy)
-                else ! concentration is zero
-                  sp_zer=.true.
-                endif
-              end do
-            end do
-          else
-            sp_count_i=0
-            sp_count_r=0
-          endif
-          write(unitoutgrid) sp_count_i
-          write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
-          write(unitoutgrid) sp_count_r
-          write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
-
-  ! Dry deposition
-          sp_count_i=0
-          sp_count_r=0
-          sp_fact=-1.
-          sp_zer=.true.
-          if ((ldirect.eq.1).and.(DRYDEP)) then
-            do jy=0,numygrid-1
-              do ix=0,numxgrid-1
-                if (drygrid(ix,jy).gt.smallnum) then
-                  if (sp_zer.eqv..true.) then ! first non zero value
-                    sp_count_i=sp_count_i+1
-                    sparse_dump_i(sp_count_i)=ix+jy*numxgrid
-                    sp_zer=.false.
-                    sp_fact=sp_fact*(-1.)
-                  endif
-                  sp_count_r=sp_count_r+1
-                  sparse_dump_r(sp_count_r)= &
-                       sp_fact* &
-                       1.e12*drygrid(ix,jy)/area(ix,jy)
-                else ! concentration is zero
-                  sp_zer=.true.
-                endif
-              end do
-            end do
-          else
-            sp_count_i=0
-            sp_count_r=0
-          endif
-          write(unitoutgrid) sp_count_i
-          write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
-          write(unitoutgrid) sp_count_r
-          write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
-
-
-
-  ! Concentrations
-          sp_count_i=0
-          sp_count_r=0
-          sp_fact=-1.
-          sp_zer=.true.
-          do kz=1,numzgrid
-            do jy=0,numygrid-1
-              do ix=0,numxgrid-1
-                if (grid(ix,jy,kz).gt.smallnum) then
-                  if (sp_zer.eqv..true.) then ! first non zero value
-                    sp_count_i=sp_count_i+1
-                    sparse_dump_i(sp_count_i)= &
-                         ix+jy*numxgrid+kz*numxgrid*numygrid
-                    sp_zer=.false.
-                    sp_fact=sp_fact*(-1.)
-                  endif
-                  sp_count_r=sp_count_r+1
-                  if (lparticlecountoutput) then
-                    sparse_dump_r(sp_count_r)= &
-                         sp_fact* &
-                         grid(ix,jy,kz)
-                  else
-                    sparse_dump_r(sp_count_r)= &
-                         sp_fact* &
-                         grid(ix,jy,kz)* &
-                         factor3d(ix,jy,kz)/tot_mu(ks,kp)
-                  end if
-
-                else ! concentration is zero
-                  sp_zer=.true.
-                endif
-              end do
-            end do
-          end do
-          write(unitoutgrid) sp_count_i
-          write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
-          write(unitoutgrid) sp_count_r
-          write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
-
-
-
-        endif !  concentration output
-
-  ! Mixing ratio output
-  !********************
-
-        if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
-
-  ! Wet deposition
-          sp_count_i=0
-          sp_count_r=0
-          sp_fact=-1.
-          sp_zer=.true.
-          if ((ldirect.eq.1).and.(WETDEP)) then
-            do jy=0,numygrid-1
-              do ix=0,numxgrid-1
-                if (wetgrid(ix,jy).gt.smallnum) then
-                  if (sp_zer.eqv..true.) then ! first non zero value
-                    sp_count_i=sp_count_i+1
-                    sparse_dump_i(sp_count_i)= &
-                         ix+jy*numxgrid
-                    sp_zer=.false.
-                    sp_fact=sp_fact*(-1.)
-                  endif
-                  sp_count_r=sp_count_r+1
-                  sparse_dump_r(sp_count_r)= &
-                       sp_fact* &
-                       1.e12*wetgrid(ix,jy)/area(ix,jy)
-                else ! concentration is zero
-                  sp_zer=.true.
-                endif
-              end do
-            end do
-          else
-            sp_count_i=0
-            sp_count_r=0
-          endif
-          write(unitoutgridppt) sp_count_i
-          write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
-          write(unitoutgridppt) sp_count_r
-          write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
-
-
-  ! Dry deposition
-          sp_count_i=0
-          sp_count_r=0
-          sp_fact=-1.
-          sp_zer=.true.
-          if ((ldirect.eq.1).and.(DRYDEP)) then
-            do jy=0,numygrid-1
-              do ix=0,numxgrid-1
-                if (drygrid(ix,jy).gt.smallnum) then
-                  if (sp_zer.eqv..true.) then ! first non zero value
-                    sp_count_i=sp_count_i+1
-                    sparse_dump_i(sp_count_i)= &
-                         ix+jy*numxgrid
-                    sp_zer=.false.
-                    sp_fact=sp_fact*(-1)
-                  endif
-                  sp_count_r=sp_count_r+1
-                  sparse_dump_r(sp_count_r)= &
-                       sp_fact* &
-                       1.e12*drygrid(ix,jy)/area(ix,jy)
-                else ! concentration is zero
-                  sp_zer=.true.
-                endif
-              end do
-            end do
-          else
-            sp_count_i=0
-            sp_count_r=0
-          endif
-          write(unitoutgridppt) sp_count_i
-          write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
-          write(unitoutgridppt) sp_count_r
-          write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
-
-
-  ! Mixing ratios
-          sp_count_i=0
-          sp_count_r=0
-          sp_fact=-1.
-          sp_zer=.true.
-          do kz=1,numzgrid
-            do jy=0,numygrid-1
-              do ix=0,numxgrid-1
-                if (grid(ix,jy,kz).gt.smallnum) then
-                  if (sp_zer.eqv..true.) then ! first non zero value
-                    sp_count_i=sp_count_i+1
-                    sparse_dump_i(sp_count_i)= &
-                         ix+jy*numxgrid+kz*numxgrid*numygrid
-                    sp_zer=.false.
-                    sp_fact=sp_fact*(-1.)
-                  endif
-                  sp_count_r=sp_count_r+1
-                  sparse_dump_r(sp_count_r)= &
-                       sp_fact* &
-                       1.e12*grid(ix,jy,kz) &
-                       /volume(ix,jy,kz)/outnum* &
-                       weightair/weightmolar(ks)/densityoutgrid(ix,jy,kz)
-                else ! concentration is zero
-                  sp_zer=.true.
-                endif
-              end do
-            end do
-          end do
-          write(unitoutgridppt) sp_count_i
-          write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
-          write(unitoutgridppt) sp_count_r
-          write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
-
-        endif ! output for ppt
-
-      end do
-    end do
-
-    close(unitoutgridppt)
-    close(unitoutgrid)
-
-  end do
-
-  ! RLT Aug 2017
-  ! Write out conversion factor for dry air
-  inquire(file=path(2)(1:length(2))//'factor_drygrid',exist=lexist)
-  if (lexist) then
-    ! open and append
-    open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid',form='unformatted',&
-            status='old',action='write',access='append')
-  else
-    ! create new
-    open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid',form='unformatted',&
-            status='new',action='write')
-  endif
-  sp_count_i=0
-  sp_count_r=0
-  sp_fact=-1.
-  sp_zer=.true.
-  do kz=1,numzgrid
-    do jy=0,numygrid-1
-      do ix=0,numxgrid-1
-        if (factor_drygrid(ix,jy,kz).gt.(1.+smallnum).or.factor_drygrid(ix,jy,kz).lt.(1.-smallnum)) then
-          if (sp_zer.eqv..true.) then ! first value not equal to one
-            sp_count_i=sp_count_i+1
-            sparse_dump_i(sp_count_i)= &
-                  ix+jy*numxgrid+kz*numxgrid*numygrid
-            sp_zer=.false.
-            sp_fact=sp_fact*(-1.)
-          endif
-          sp_count_r=sp_count_r+1
-          sparse_dump_r(sp_count_r)= &
-               sp_fact*factor_drygrid(ix,jy,kz)
-        else ! factor is one
-          sp_zer=.true.
-        endif
-      end do
-    end do
-  end do
-  write(unitoutfactor) sp_count_i
-  write(unitoutfactor) (sparse_dump_i(i),i=1,sp_count_i)
-  write(unitoutfactor) sp_count_r
-  write(unitoutfactor) (sparse_dump_r(i),i=1,sp_count_r)
-  close(unitoutfactor)
-
-
-  if (gridtotal.gt.0.) gridtotalunc=gridsigmatotal/gridtotal
-  if (wetgridtotal.gt.0.) wetgridtotalunc=wetgridsigmatotal/ &
-       wetgridtotal
-  if (drygridtotal.gt.0.) drygridtotalunc=drygridsigmatotal/ &
-       drygridtotal
-
-  ! Dump of receptor concentrations
-
-  if (numreceptor.gt.0 .and. (iout.eq.2 .or. iout.eq.3)  ) then
-    write(unitoutreceptppt) itime
-    do ks=1,nspec
-      write(unitoutreceptppt) (1.e12*creceptor(i,ks)/outnum* &
-           weightair/weightmolar(ks)/densityoutrecept(i),i=1,numreceptor)
-    end do
-  endif
-
-  ! Dump of receptor concentrations
-
-  if (numreceptor.gt.0) then
-    write(unitoutrecept) itime
-    do ks=1,nspec
-      write(unitoutrecept) (1.e12*creceptor(i,ks)/outnum, &
-           i=1,numreceptor)
-    end do
-  endif
-
-  ! RLT Aug 2017
-  ! Write out conversion factor for dry air
-  if (numreceptor.gt.0) then
-    inquire(file=path(2)(1:length(2))//'factor_dryreceptor',exist=lexist)
-     if (lexist) then
-     ! open and append
-      open(unitoutfactor,file=path(2)(1:length(2))//'factor_dryreceptor',form='unformatted',&
-              status='old',action='write',access='append')
-    else
-      ! create new
-      open(unitoutfactor,file=path(2)(1:length(2))//'factor_dryreceptor',form='unformatted',&
-              status='new',action='write')
-    endif
-    write(unitoutfactor) itime
-    write(unitoutfactor) (factor_dryrecept(i),i=1,numreceptor)
-    close(unitoutfactor)
-  endif
-
-  creceptor(:,:)=0.
-  gridunc(:,:,:,:,:,:,:)=0.
-end subroutine concoutput
-
-subroutine concoutput_nest(itime,outnum)
-  !                        i     i
-  !*****************************************************************************
-  !                                                                            *
-  !     Output of the concentration grid and the receptor concentrations.      *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     24 May 1995                                                            *
-  !                                                                            *
-  !     13 April 1999, Major update: if output size is smaller, dump output    *
-  !                    in sparse matrix format; additional output of           *
-  !                    uncertainty                                             *
-  !                                                                            *
-  !     05 April 2000, Major update: output of age classes; output for backward*
-  !                    runs is time spent in grid cell times total mass of     *
-  !                    species.                                                *
-  !                                                                            *
-  !     17 February 2002, Appropriate dimensions for backward and forward runs *
-  !                       are now specified in file par_mod                    *
-  !                                                                            *
-  !     June 2006, write grid in sparse matrix with a single write command     *
-  !                in order to save disk space                                 *
-  !                                                                            *
-  !     2008 new sparse matrix format                                          *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! outnum          number of samples                                          *
-  ! ncells          number of cells with non-zero concentrations               *
-  ! sparse          .true. if in sparse matrix format, else .false.            *
-  ! tot_mu          1 for forward, initial mass mixing ration for backw. runs  *
-  !                                                                            *
-  !*****************************************************************************
-  use unc_mod
-  use mean_mod
-
-  implicit none
-
-  real(kind=dp) :: jul
-  integer :: itime,i,ix,jy,kz,ks,kp,l,iix,jjy,kzz,nage,jjjjmmdd,ihmmss
-  integer :: sp_count_i,sp_count_r
-  real :: sp_fact
-  real :: outnum,densityoutrecept(maxreceptor),xl,yl
-  ! RLT
-  real :: densitydryrecept(maxreceptor)
-  real :: factor_dryrecept(maxreceptor)
-
-  !real densityoutgrid(0:numxgrid-1,0:numygrid-1,numzgrid),
-  !    +grid(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec,maxpointspec_act,
-  !    +    maxageclass)
-  !real wetgrid(0:numxgrid-1,0:numygrid-1,maxspec,maxpointspec_act,
-  !    +       maxageclass)
-  !real drygrid(0:numxgrid-1,0:numygrid-1,maxspec,
-  !    +       maxpointspec_act,maxageclass)
-  !real gridsigma(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec,
-  !    +       maxpointspec_act,maxageclass),
-  !    +     drygridsigma(0:numxgrid-1,0:numygrid-1,maxspec,
-  !    +     maxpointspec_act,maxageclass),
-  !    +     wetgridsigma(0:numxgrid-1,0:numygrid-1,maxspec,
-  !    +     maxpointspec_act,maxageclass)
-  !real factor(0:numxgrid-1,0:numygrid-1,numzgrid)
-  !real sparse_dump_r(numxgrid*numygrid*numzgrid)
-  !integer sparse_dump_i(numxgrid*numygrid*numzgrid)
-
-  !real sparse_dump_u(numxgrid*numygrid*numzgrid)
-  real(dep_prec) :: auxgrid(nclassunc)
-  real :: halfheight,dz,dz1,dz2,tot_mu(maxspec,maxpointspec_act)
-  real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
-  real,parameter :: weightair=28.97
-  logical :: sp_zer
-  character :: adate*8,atime*6
-  character(len=3) :: anspec
-  logical :: lexist
-  integer :: mind 
-
-
-  ! Determine current calendar date, needed for the file name
-  !**********************************************************
-
-  jul=bdate+real(itime,kind=dp)/86400._dp
-  call caldate(jul,jjjjmmdd,ihmmss)
-  write(adate,'(i8.8)') jjjjmmdd
-  write(atime,'(i6.6)') ihmmss
-
-
-  ! For forward simulations, output fields have dimension MAXSPEC,
-  ! for backward simulations, output fields have dimension MAXPOINT.
-  ! Thus, make loops either about nspec, or about numpoint
-  !*****************************************************************
-
-
-    if (ldirect.eq.1) then
-       do ks=1,nspec
-         do kp=1,maxpointspec_act
-           tot_mu(ks,kp)=1
-         end do
-       end do
-   else
-      do ks=1,nspec
-             do kp=1,maxpointspec_act
-               tot_mu(ks,kp)=xmass(kp,ks)
-             end do
-      end do
-    endif
-
-
-  !*******************************************************************
-  ! Compute air density: sufficiently accurate to take it
-  ! from coarse grid at some time
-  ! Determine center altitude of output layer, and interpolate density
-  ! data to that altitude
-  !*******************************************************************
-
-  mind=memind(2)
-  do kz=1,numzgrid
-    if (kz.eq.1) then
-      halfheight=outheight(1)/2.
-    else
-      halfheight=(outheight(kz)+outheight(kz-1))/2.
-    endif
-    do kzz=2,nz
-      if ((height(kzz-1).lt.halfheight).and. &
-           (height(kzz).gt.halfheight)) goto 46
-    end do
-46   kzz=max(min(kzz,nz),2)
-    dz1=halfheight-height(kzz-1)
-    dz2=height(kzz)-halfheight
-    dz=dz1+dz2
-    do jy=0,numygridn-1
-      do ix=0,numxgridn-1
-        xl=outlon0n+real(ix)*dxoutn
-        yl=outlat0n+real(jy)*dyoutn
-        xl=(xl-xlon0)/dx
-        yl=(yl-ylat0)/dy
-        iix=max(min(nint(xl),nxmin1),0)
-        jjy=max(min(nint(yl),nymin1),0)
-        ! densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,2)*dz1+ &
-        !      rho(iix,jjy,kzz-1,2)*dz2)/dz
-        densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,mind)*dz1+ &
-             rho(iix,jjy,kzz-1,mind)*dz2)/dz
-  ! RLT
-        densitydrygrid(ix,jy,kz)=(rho_dry(iix,jjy,kzz,mind)*dz1+ &
-             rho_dry(iix,jjy,kzz-1,mind)*dz2)/dz
-      end do
-    end do
-  end do
-
-  do i=1,numreceptor
-    xl=xreceptor(i)
-    yl=yreceptor(i)
-    iix=max(min(nint(xl),nxmin1),0)
-    jjy=max(min(nint(yl),nymin1),0)
-    !densityoutrecept(i)=rho(iix,jjy,1,2)
-    densityoutrecept(i)=rho(iix,jjy,1,mind)
-  ! RLT
-    densitydryrecept(i)=rho_dry(iix,jjy,1,mind)
-  end do
-
-  ! RLT
-  ! conversion factor for output relative to dry air
-  factor_drygrid=densityoutgrid/densitydrygrid
-  factor_dryrecept=densityoutrecept/densitydryrecept
-
-  ! Output is different for forward and backward simulations
-    do kz=1,numzgrid
-      do jy=0,numygridn-1
-        do ix=0,numxgridn-1
-          if (ldirect.eq.1) then
-            factor3d(ix,jy,kz)=1.e12/volumen(ix,jy,kz)/outnum
-          else
-            factor3d(ix,jy,kz)=real(abs(loutaver))/outnum
-          endif
-        end do
-      end do
-    end do
-
-  !*********************************************************************
-  ! Determine the standard deviation of the mean concentration or mixing
-  ! ratio (uncertainty of the output) and the dry and wet deposition
-  !*********************************************************************
-
-  do ks=1,nspec
-
-  write(anspec,'(i3.3)') ks
- 
-  if (DRYBKDEP.or.WETBKDEP) then !scavdep output
-      if (DRYBKDEP) &
-      open(unitoutgrid,file=path(2)(1:length(2))//'grid_drydep_nest_'//adate// &
-           atime//'_'//anspec,form='unformatted')
-      if (WETBKDEP) &
-      open(unitoutgrid,file=path(2)(1:length(2))//'grid_wetdep_nest_'//adate// &
-           atime//'_'//anspec,form='unformatted')
-      write(unitoutgrid) itime
-  else
-     if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
-       if (ldirect.eq.1) then
-         open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_nest_' &
-           //adate// &
-           atime//'_'//anspec,form='unformatted')
-       else
-         open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_nest_' &
-           //adate// &
-           atime//'_'//anspec,form='unformatted')
-       endif
-       write(unitoutgrid) itime
-     endif
-  endif
-
-  if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
-   open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_nest_' &
-        //adate// &
-        atime//'_'//anspec,form='unformatted')
-
-    write(unitoutgridppt) itime
-  endif
-
-  do kp=1,maxpointspec_act
-  do nage=1,nageclass
-
-    do jy=0,numygridn-1
-      do ix=0,numxgridn-1
-
-  ! WET DEPOSITION
-        if ((WETDEP).and.(ldirect.gt.0)) then
-            do l=1,nclassunc
-              auxgrid(l)=wetgriduncn(ix,jy,ks,kp,l,nage)
-            end do
-            call mean(auxgrid,wetgrid(ix,jy), &
-                 wetgridsigma(ix,jy),nclassunc)
-  ! Multiply by number of classes to get total concentration
-            wetgrid(ix,jy)=wetgrid(ix,jy) &
-                 *nclassunc
-  ! Calculate standard deviation of the mean
-            wetgridsigma(ix,jy)= &
-                 wetgridsigma(ix,jy)* &
-                 sqrt(real(nclassunc))
-        endif
-
-  ! DRY DEPOSITION
-        if ((DRYDEP).and.(ldirect.gt.0)) then
-            do l=1,nclassunc
-              auxgrid(l)=drygriduncn(ix,jy,ks,kp,l,nage)
-            end do
-            call mean(auxgrid,drygrid(ix,jy), &
-                 drygridsigma(ix,jy),nclassunc)
-  ! Multiply by number of classes to get total concentration
-            drygrid(ix,jy)=drygrid(ix,jy)* &
-                 nclassunc
-  ! Calculate standard deviation of the mean
-            drygridsigma(ix,jy)= &
-                 drygridsigma(ix,jy)* &
-                 sqrt(real(nclassunc))
-        endif
-
-  ! CONCENTRATION OR MIXING RATIO
-        do kz=1,numzgrid
-            do l=1,nclassunc
-              auxgrid(l)=griduncn(ix,jy,kz,ks,kp,l,nage)
-            end do
-            call mean(auxgrid,grid(ix,jy,kz), &
-                 gridsigma(ix,jy,kz),nclassunc)
-  ! Multiply by number of classes to get total concentration
-            grid(ix,jy,kz)= &
-                 grid(ix,jy,kz)*nclassunc
-  ! Calculate standard deviation of the mean
-            gridsigma(ix,jy,kz)= &
-                 gridsigma(ix,jy,kz)* &
-                 sqrt(real(nclassunc))
-        end do
-      end do
-    end do
-
-
-  !*******************************************************************
-  ! Generate output: may be in concentration (ng/m3) or in mixing
-  ! ratio (ppt) or both
-  ! Output the position and the values alternated multiplied by
-  ! 1 or -1, first line is number of values, number of positions
-  ! For backward simulations, the unit is seconds, stored in grid_time
-  !*******************************************************************
-
-  ! Concentration output
-  !*********************
-  if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
-
-  ! Wet deposition
-         sp_count_i=0
-         sp_count_r=0
-         sp_fact=-1.
-         sp_zer=.true.
-         if ((ldirect.eq.1).and.(WETDEP)) then
-         do jy=0,numygridn-1
-            do ix=0,numxgridn-1
-  !oncentraion greater zero
-              if (wetgrid(ix,jy).gt.smallnum) then
-                 if (sp_zer.eqv..true.) then ! first non zero value
-                    sp_count_i=sp_count_i+1
-                    sparse_dump_i(sp_count_i)=ix+jy*numxgridn
-                    sp_zer=.false.
-                    sp_fact=sp_fact*(-1.)
-                 endif
-                 sp_count_r=sp_count_r+1
-                 sparse_dump_r(sp_count_r)= &
-                      sp_fact*1.e12*wetgrid(ix,jy)/arean(ix,jy)
-  !                sparse_dump_u(sp_count_r)=
-  !+                1.e12*wetgridsigma(ix,jy,ks,kp,nage)/area(ix,jy)
-              else ! concentration is zero
-                  sp_zer=.true.
-              endif
-            end do
-         end do
-         else
-            sp_count_i=0
-            sp_count_r=0
-         endif
-         write(unitoutgrid) sp_count_i
-         write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
-         write(unitoutgrid) sp_count_r
-         write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
-  !       write(unitoutgrid) sp_count_u
-  !       write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)
-
-  ! Dry deposition
-         sp_count_i=0
-         sp_count_r=0
-         sp_fact=-1.
-         sp_zer=.true.
-         if ((ldirect.eq.1).and.(DRYDEP)) then
-          do jy=0,numygridn-1
-            do ix=0,numxgridn-1
-              if (drygrid(ix,jy).gt.smallnum) then
-                 if (sp_zer.eqv..true.) then ! first non zero value
-                    sp_count_i=sp_count_i+1
-                    sparse_dump_i(sp_count_i)=ix+jy*numxgridn
-                    sp_zer=.false.
-                    sp_fact=sp_fact*(-1.)
-                 endif
-                 sp_count_r=sp_count_r+1
-                 sparse_dump_r(sp_count_r)= &
-                      sp_fact* &
-                      1.e12*drygrid(ix,jy)/arean(ix,jy)
-  !                sparse_dump_u(sp_count_r)=
-  !+                1.e12*drygridsigma(ix,jy,ks,kp,nage)/area(ix,jy)
-              else ! concentration is zero
-                  sp_zer=.true.
-              endif
-            end do
-          end do
-         else
-            sp_count_i=0
-            sp_count_r=0
-         endif
-         write(unitoutgrid) sp_count_i
-         write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
-         write(unitoutgrid) sp_count_r
-         write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
-  !       write(*,*) sp_count_u
-  !       write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)
-
-
-
-  ! Concentrations
-         sp_count_i=0
-         sp_count_r=0
-         sp_fact=-1.
-         sp_zer=.true.
-          do kz=1,numzgrid
-            do jy=0,numygridn-1
-              do ix=0,numxgridn-1
-                if (grid(ix,jy,kz).gt.smallnum) then
-                  if (sp_zer.eqv..true.) then ! first non zero value
-                    sp_count_i=sp_count_i+1
-                    sparse_dump_i(sp_count_i)= &
-                         ix+jy*numxgridn+kz*numxgridn*numygridn
-                    sp_zer=.false.
-                    sp_fact=sp_fact*(-1.)
-                   endif
-                   sp_count_r=sp_count_r+1
-                   sparse_dump_r(sp_count_r)= &
-                        sp_fact* &
-                        grid(ix,jy,kz)* &
-                        factor3d(ix,jy,kz)/tot_mu(ks,kp)
-  !                 if ((factor(ix,jy,kz)/tot_mu(ks,kp)).eq.0)
-  !    +              write (*,*) factor(ix,jy,kz),tot_mu(ks,kp),ks,kp
-  !                sparse_dump_u(sp_count_r)=
-  !+               ,gridsigma(ix,jy,kz,ks,kp,nage)*
-  !+               factor(ix,jy,kz)/tot_mu(ks,kp)
-              else ! concentration is zero
-                  sp_zer=.true.
-              endif
-              end do
-            end do
-          end do
-         write(unitoutgrid) sp_count_i
-         write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
-         write(unitoutgrid) sp_count_r
-         write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
-  !       write(unitoutgrid) sp_count_u
-  !       write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)
-
-
-
-    endif !  concentration output
-
-  ! Mixing ratio output
-  !********************
-
-  if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
-
-  ! Wet deposition
-         sp_count_i=0
-         sp_count_r=0
-         sp_fact=-1.
-         sp_zer=.true.
-         if ((ldirect.eq.1).and.(WETDEP)) then
-          do jy=0,numygridn-1
-            do ix=0,numxgridn-1
-                if (wetgrid(ix,jy).gt.smallnum) then
-                  if (sp_zer.eqv..true.) then ! first non zero value
-                    sp_count_i=sp_count_i+1
-                    sparse_dump_i(sp_count_i)= &
-                         ix+jy*numxgridn
-                    sp_zer=.false.
-                    sp_fact=sp_fact*(-1.)
-                 endif
-                 sp_count_r=sp_count_r+1
-                 sparse_dump_r(sp_count_r)= &
-                      sp_fact* &
-                      1.e12*wetgrid(ix,jy)/arean(ix,jy)
-  !                sparse_dump_u(sp_count_r)=
-  !    +            ,1.e12*wetgridsigma(ix,jy,ks,kp,nage)/area(ix,jy)
-              else ! concentration is zero
-                  sp_zer=.true.
-              endif
-            end do
-          end do
-         else
-           sp_count_i=0
-           sp_count_r=0
-         endif
-         write(unitoutgridppt) sp_count_i
-         write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
-         write(unitoutgridppt) sp_count_r
-         write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
-  !       write(unitoutgridppt) sp_count_u
-  !       write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
-
-
-  ! Dry deposition
-         sp_count_i=0
-         sp_count_r=0
-         sp_fact=-1.
-         sp_zer=.true.
-         if ((ldirect.eq.1).and.(DRYDEP)) then
-          do jy=0,numygridn-1
-            do ix=0,numxgridn-1
-                if (drygrid(ix,jy).gt.smallnum) then
-                  if (sp_zer.eqv..true.) then ! first non zero value
-                    sp_count_i=sp_count_i+1
-                    sparse_dump_i(sp_count_i)= &
-                         ix+jy*numxgridn
-                    sp_zer=.false.
-                    sp_fact=sp_fact*(-1)
-                 endif
-                 sp_count_r=sp_count_r+1
-                 sparse_dump_r(sp_count_r)= &
-                      sp_fact* &
-                      1.e12*drygrid(ix,jy)/arean(ix,jy)
-  !                sparse_dump_u(sp_count_r)=
-  !    +            ,1.e12*drygridsigma(ix,jy,ks,kp,nage)/area(ix,jy)
-              else ! concentration is zero
-                  sp_zer=.true.
-              endif
-            end do
-          end do
-         else
-           sp_count_i=0
-           sp_count_r=0
-         endif
-         write(unitoutgridppt) sp_count_i
-         write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
-         write(unitoutgridppt) sp_count_r
-         write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
-  !       write(unitoutgridppt) sp_count_u
-  !       write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
-
-
-  ! Mixing ratios
-         sp_count_i=0
-         sp_count_r=0
-         sp_fact=-1.
-         sp_zer=.true.
-          do kz=1,numzgrid
-            do jy=0,numygridn-1
-              do ix=0,numxgridn-1
-                if (grid(ix,jy,kz).gt.smallnum) then
-                  if (sp_zer.eqv..true.) then ! first non zero value
-                    sp_count_i=sp_count_i+1
-                    sparse_dump_i(sp_count_i)= &
-                         ix+jy*numxgridn+kz*numxgridn*numygridn
-                    sp_zer=.false.
-                    sp_fact=sp_fact*(-1.)
-                 endif
-                 sp_count_r=sp_count_r+1
-                 sparse_dump_r(sp_count_r)= &
-                      sp_fact* &
-                      1.e12*grid(ix,jy,kz) &
-                      /volumen(ix,jy,kz)/outnum* &
-                      weightair/weightmolar(ks)/densityoutgrid(ix,jy,kz)
-  !                sparse_dump_u(sp_count_r)=
-  !+              ,1.e12*gridsigma(ix,jy,kz,ks,kp,nage)/volume(ix,jy,kz)/
-  !+              outnum*weightair/weightmolar(ks)/
-  !+              densityoutgrid(ix,jy,kz)
-              else ! concentration is zero
-                  sp_zer=.true.
-              endif
-              end do
-            end do
-          end do
-         write(unitoutgridppt) sp_count_i
-         write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
-         write(unitoutgridppt) sp_count_r
-         write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
-  !       write(unitoutgridppt) sp_count_u
-  !       write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
-
-      endif ! output for ppt
-
-  end do
-  end do
-
-    close(unitoutgridppt)
-    close(unitoutgrid)
-
-  end do
-
-  ! RLT Aug 2017
-  ! Write out conversion factor for dry air
-  inquire(file=path(2)(1:length(2))//'factor_drygrid_nest',exist=lexist)
-  if (lexist) then
-    ! open and append
-    open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid_nest',form='unformatted',&
-            status='old',action='write',access='append')
-  else
-    ! create new
-    open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid_nest',form='unformatted',&
-            status='new',action='write')
-  endif
-  sp_count_i=0
-  sp_count_r=0
-  sp_fact=-1.
-  sp_zer=.true.
-  do kz=1,numzgrid
-    do jy=0,numygridn-1
-      do ix=0,numxgridn-1
-        if (factor_drygrid(ix,jy,kz).gt.(1.+smallnum).or.factor_drygrid(ix,jy,kz).lt.(1.-smallnum)) then
-          if (sp_zer.eqv..true.) then ! first value not equal to one
-            sp_count_i=sp_count_i+1
-            sparse_dump_i(sp_count_i)= &
-                  ix+jy*numxgridn+kz*numxgridn*numygridn
-            sp_zer=.false.
-            sp_fact=sp_fact*(-1.)
-          endif
-          sp_count_r=sp_count_r+1
-          sparse_dump_r(sp_count_r)= &
-               sp_fact*factor_drygrid(ix,jy,kz)
-        else ! factor is one
-          sp_zer=.true.
-        endif
-      end do
-    end do
-  end do
-  write(unitoutfactor) sp_count_i
-  write(unitoutfactor) (sparse_dump_i(i),i=1,sp_count_i)
-  write(unitoutfactor) sp_count_r
-  write(unitoutfactor) (sparse_dump_r(i),i=1,sp_count_r)
-  close(unitoutfactor)
-
-  creceptor(:,:)=0.
-  griduncn(:,:,:,:,:,:,:)=0.
-end subroutine concoutput_nest
-
-subroutine concoutput_inv(itime,outnum,gridtotalunc,wetgridtotalunc, &
-     drygridtotalunc)
-  !                        i     i          o             o
-  !       o
-  !*****************************************************************************
-  !                                                                            *
-  !     Output of the concentration grid and the receptor concentrations.      *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     24 May 1995                                                            *
-  !                                                                            *
-  !     13 April 1999, Major update: if output size is smaller, dump output    *
-  !                    in sparse matrix format; additional output of           *
-  !                    uncertainty                                             *
-  !                                                                            *
-  !     05 April 2000, Major update: output of age classes; output for backward*
-  !                    runs is time spent in grid cell times total mass of     *
-  !                    species.                                                *
-  !                                                                            *
-  !     17 February 2002, Appropriate dimensions for backward and forward runs *
-  !                       are now specified in file par_mod                    *
-  !                                                                            *
-  !     June 2006, write grid in sparse matrix with a single write command     *
-  !                in order to save disk space                                 *
-  !                                                                            *
-  !     2008 new sparse matrix format                                          *
-  !
-  !     January 2017,  Separate files by release but include all timesteps
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! outnum          number of samples                                          *
-  ! ncells          number of cells with non-zero concentrations               *
-  ! sparse          .true. if in sparse matrix format, else .false.            *
-  ! tot_mu          1 for forward, initial mass mixing ration for backw. runs  *
-  !                                                                            *
-  !*****************************************************************************
-
-  use unc_mod
-  use mean_mod
-
-  implicit none
-
-  real(kind=dp) :: jul
-  integer :: itime,i,ix,jy,kz,ks,kp,l,iix,jjy,kzz,nage,jjjjmmdd,ihmmss
-  integer :: sp_count_i,sp_count_r
-  real :: sp_fact
-  real :: outnum,densityoutrecept(maxreceptor),xl,yl
-  ! RLT
-  real :: densitydryrecept(maxreceptor)
-  real :: factor_dryrecept(maxreceptor)
-
-
-  real(dep_prec) :: auxgrid(nclassunc)
-  real(sp) :: gridtotal,gridsigmatotal,gridtotalunc
-  real(dep_prec) :: wetgridtotal,wetgridsigmatotal,wetgridtotalunc
-  real(dep_prec) :: drygridtotal,drygridsigmatotal,drygridtotalunc
-  real :: halfheight,dz,dz1,dz2,tot_mu(maxspec,maxpointspec_act)
-  real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
-  real,parameter :: weightair=28.97
-  logical :: sp_zer
-  character :: adate*8,atime*6
-  character(len=3) :: anspec
-  logical :: lexist
-  character :: areldate*8,areltime*6
-  logical,save :: lstart=.true.
-  logical,save,allocatable,dimension(:) :: lstartrel
-  integer :: ierr
-  character(LEN=100) :: dates_char
-  integer, parameter :: unitrelnames=654
-
-
-  if(lstart) then
-    allocate(lstartrel(maxpointspec_act))
-    lstartrel(:)=.true.
-  endif
-  print*, 'lstartrel = ',lstartrel
-
-  if (verbosity.eq.1) then
-    print*,'inside concoutput_inv '
-    CALL SYSTEM_CLOCK(count_clock)
-    WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0   
-  endif
-
-  ! Determine current calendar date
-  !**********************************************************
-
-  jul=bdate+real(itime,kind=dp)/86400._dp
-  call caldate(jul,jjjjmmdd,ihmmss)
-  write(adate,'(i8.8)') jjjjmmdd
-  write(atime,'(i6.6)') ihmmss
-
-
-  ! Prepare output files for dates
-  !**********************************************************
-
-  ! Overwrite existing dates file on first call, later append to it
-  ! If 'dates' file exists in output directory, copy to new file dates.old
-  inquire(file=path(2)(1:length(2))//'dates', exist=lexist)
-  if (lexist.and.lstart) then
-    ! copy contents of existing dates file to dates.old
-    print*, 'warning: replacing old dates file'
-    open(unit=unitdates, file=path(2)(1:length(2))//'dates',form='formatted', &
-         &access='sequential', status='old', action='read', iostat=ierr)
-    open(unit=unittmp, file=path(2)(1:length(2))//'dates.old', access='sequential', &
-         &status='replace', action='write', form='formatted', iostat=ierr)
-    do while (.true.)
-      read(unitdates, '(a)', iostat=ierr) dates_char
-      if (ierr.ne.0) exit
-      write(unit=unittmp, fmt='(a)', iostat=ierr, advance='yes') trim(dates_char)
-    end do
-    close(unit=unitdates)
-    close(unit=unittmp)
-    ! create new dates file
-    open(unit=unitdates, file=path(2)(1:length(2))//'dates',form='formatted', &
-         &access='sequential', status='replace', iostat=ierr)
-    close(unit=unitdates)
-  endif
-
-  open(unitdates,file=path(2)(1:length(2))//'dates', ACCESS='APPEND')
-  write(unitdates,'(a)') adate//atime
-  close(unitdates)
-
-  !CGZ: Make a filename with names of releases
-  if (lstart) then
-    open(unit=unitrelnames, file=path(2)(1:length(2))//'releases_out',form='formatted', &
-         &access='sequential', status='replace', iostat=ierr)
-    close(unitrelnames)
-  endif
-
-  print*, 'after creating dates files: lstart = ',lstart
-  !  print*, 'outnum:',outnum
-  !  print*, 'datetime:',adate//atime
-
-
-  ! For forward simulations, output fields have dimension MAXSPEC,
-  ! for backward simulations, output fields have dimension MAXPOINT.
-  ! Thus, make loops either about nspec, or about numpoint
-  !*****************************************************************
-
-
-  if (ldirect.eq.1) then
-    do ks=1,nspec
-      do kp=1,maxpointspec_act
-        tot_mu(ks,kp)=1
-      end do
-    end do
-  else
-    do ks=1,nspec
-      do kp=1,maxpointspec_act
-        tot_mu(ks,kp)=xmass(kp,ks)
-      end do
-    end do
-  endif
-
-
-  if (verbosity.eq.1) then
-    print*,'concoutput_inv 2'
-    CALL SYSTEM_CLOCK(count_clock)
-    WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0   
-  endif
-
-  !*******************************************************************
-  ! Compute air density: sufficiently accurate to take it
-  ! from coarse grid at some time
-  ! Determine center altitude of output layer, and interpolate density
-  ! data to that altitude
-  !*******************************************************************
-
-  do kz=1,numzgrid
-    if (kz.eq.1) then
-      halfheight=outheight(1)/2.
-    else
-      halfheight=(outheight(kz)+outheight(kz-1))/2.
-    endif
-    do kzz=2,nz
-      if ((height(kzz-1).lt.halfheight).and. &
-           (height(kzz).gt.halfheight)) goto 46
-    end do
-46  kzz=max(min(kzz,nz),2)
-    dz1=halfheight-height(kzz-1)
-    dz2=height(kzz)-halfheight
-    dz=dz1+dz2
-    do jy=0,numygrid-1
-      do ix=0,numxgrid-1
-        xl=outlon0+real(ix)*dxout
-        yl=outlat0+real(jy)*dyout
-        xl=(xl-xlon0)/dx
-        yl=(yl-ylat0)/dy
-        iix=max(min(nint(xl),nxmin1),0)
-        jjy=max(min(nint(yl),nymin1),0)
-        densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,2)*dz1+ &
-             rho(iix,jjy,kzz-1,2)*dz2)/dz
-  ! RLT
-        densitydrygrid(ix,jy,kz)=(rho_dry(iix,jjy,kzz,2)*dz1+ &
-             rho_dry(iix,jjy,kzz-1,2)*dz2)/dz
-      end do
-    end do
-  end do
-
-  do i=1,numreceptor
-    xl=xreceptor(i)
-    yl=yreceptor(i)
-    iix=max(min(nint(xl),nxmin1),0)
-    jjy=max(min(nint(yl),nymin1),0)
-    densityoutrecept(i)=rho(iix,jjy,1,2)
-  ! RLT
-    densitydryrecept(i)=rho_dry(iix,jjy,1,2)
-  end do
-
-  ! RLT
-  ! conversion factor for output relative to dry air
-  factor_drygrid=densityoutgrid/densitydrygrid
-  factor_dryrecept=densityoutrecept/densitydryrecept
-
-  ! Output is different for forward and backward simulations
-  do kz=1,numzgrid
-    do jy=0,numygrid-1
-      do ix=0,numxgrid-1
-        if (ldirect.eq.1) then
-          factor3d(ix,jy,kz)=1.e12/volume(ix,jy,kz)/outnum
-        else
-          factor3d(ix,jy,kz)=real(abs(loutaver))/outnum
-        endif
-      end do
-    end do
-  end do
-
-  !*********************************************************************
-  ! Determine the standard deviation of the mean concentration or mixing
-  ! ratio (uncertainty of the output) and the dry and wet deposition
-  !*********************************************************************
-
-  if (verbosity.eq.1) then
-    print*,'concoutput_inv 3 (sd)'
-    CALL SYSTEM_CLOCK(count_clock)
-    WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0   
-  endif
-  gridtotal=0.
-  gridsigmatotal=0.
-  gridtotalunc=0.
-  wetgridtotal=0.
-  wetgridsigmatotal=0.
-  wetgridtotalunc=0.
-  drygridtotal=0.
-  drygridsigmatotal=0.
-  drygridtotalunc=0.
-
-  do ks=1,nspec
-
-    write(anspec,'(i3.3)') ks
-
-    ! loop over releases
-    do kp=1,maxpointspec_act
-
-      print*, 'itime = ',itime
-      !print*, 'lage(1) = ',lage(1)
-      print*, 'ireleasestart(kp) = ',ireleasestart(kp)
-      print*, 'ireleaseend(kp) = ',ireleaseend(kp)
-
-      ! check itime is within release and backward trajectory length
-      if (nageclass.eq.1) then
-        if ((itime.gt.ireleaseend(kp)).or.(itime.lt.(ireleasestart(kp)-lage(1)))) then
-          go to 10
-        endif
-      endif
-
-      ! calculate date of release for filename
-      jul=bdate+real(ireleasestart(kp),kind=dp)/86400._dp    ! this is the current day
-      call caldate(jul,jjjjmmdd,ihmmss)     
-      write(areldate,'(i8.8)') jjjjmmdd
-      write(areltime,'(i6.6)') ihmmss
-      print*, 'areldate/areltime = ',areldate//areltime
-
-      ! calculate date of field
-      jul=bdate+real(itime,kind=dp)/86400._dp
-      call caldate(jul,jjjjmmdd,ihmmss)
-      write(adate,'(i8.8)') jjjjmmdd
-      write(atime,'(i6.6)') ihmmss
-
-      if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
-        if (ldirect.eq.1) then
-          ! concentrations
-          inquire(file=path(2)(1:length(2))//'grid_conc_'//areldate// &
-                  areltime//'_'//anspec,exist=lexist)
-          if(lexist.and..not.lstartrel(kp)) then
-            ! open and append to existing file
-            open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_'//areldate// &
-                 areltime//'_'//anspec,form='unformatted',status='old',action='write',access='append')
-          else
-            ! open new file
-            open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_'//areldate// &
-                 areltime//'_'//anspec,form='unformatted',status='replace',action='write')
-          endif
-        else
-          ! residence times
-          inquire(file=path(2)(1:length(2))//'grid_time_'//areldate// &
-                  areltime//'_'//anspec,exist=lexist)
-          if(lexist.and..not.lstartrel(kp)) then
-            ! open and append to existing file
-            open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_'//areldate// &
-                 areltime//'_'//anspec,form='unformatted',status='old',action='write',access='append')
-          else
-            ! open new file
-            open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_'//areldate// &
-                 areltime//'_'//anspec,form='unformatted',status='replace',action='write')
-            ! add part of the filename to a file (similar to dates) for easier post-processing
-            open(unit=unitrelnames, file=path(2)(1:length(2))//'releases_out',form='formatted', &
-                 & access='APPEND', iostat=ierr)
-            write(unitrelnames,'(a)') areldate//areltime//'_'//anspec
-            close(unitrelnames)
-          endif
-        endif
-        write(unitoutgrid) jjjjmmdd
-        write(unitoutgrid) ihmmss
-      endif
-
-      if ((iout.eq.2).or.(iout.eq.3)) then      
-        ! mixing ratio
-        inquire(file=path(2)(1:length(2))//'grid_pptv_'//areldate// &
-                areltime//'_'//anspec,exist=lexist)
-        if(lexist.and..not.lstartrel(kp)) then
-          ! open and append to existing file
-          open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_'//areldate// &
-               areltime//'_'//anspec,form='unformatted',status='old',action='write',access='append')
-        else
-          ! open new file
-          open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_'//areldate// &
-               areltime//'_'//anspec,form='unformatted',status='replace',action='write')
-        endif   
-        write(unitoutgridppt) jjjjmmdd
-        write(unitoutgridppt) ihmmss
-      endif
-
-      lstartrel(kp)=.false.
-
-      do nage=1,nageclass
-
-        do jy=0,numygrid-1
-          do ix=0,numxgrid-1
-
-  ! CONCENTRATION OR MIXING RATIO
-            do kz=1,numzgrid
-              do l=1,nclassunc
-                auxgrid(l)=gridunc(ix,jy,kz,ks,kp,l,nage)
-              end do
-              call mean(auxgrid,grid(ix,jy,kz), &
-                   gridsigma(ix,jy,kz),nclassunc)
-  ! Multiply by number of classes to get total concentration
-              grid(ix,jy,kz)= &
-                   grid(ix,jy,kz)*nclassunc
-              gridtotal=gridtotal+grid(ix,jy,kz)
-  ! Calculate standard deviation of the mean
-              gridsigma(ix,jy,kz)= &
-                   gridsigma(ix,jy,kz)* &
-                   sqrt(real(nclassunc))
-              gridsigmatotal=gridsigmatotal+ &
-                   gridsigma(ix,jy,kz)
-            end do
-          end do
-        end do
-
-
-  !*******************************************************************
-  ! Generate output: may be in concentration (ng/m3) or in mixing
-  ! ratio (ppt) or both
-  ! Output the position and the values alternated multiplied by
-  ! 1 or -1, first line is number of values, number of positions
-  ! For backward simulations, the unit is seconds, stored in grid_time
-  !*******************************************************************
-
-        if (verbosity.eq.1) then
-          print*,'concoutput_inv 4 (output)'
-          CALL SYSTEM_CLOCK(count_clock)
-          WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0   
-        endif
-
-  ! Concentration output
-  !*********************
-
-        if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
-
-          if (verbosity.eq.1) then
-            print*,'concoutput_inv (Wet deposition)'
-            CALL SYSTEM_CLOCK(count_clock)
-            WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0   
-          endif
-
-          if (verbosity.eq.1) then
-            print*,'concoutput_inv (Concentrations)'
-            CALL SYSTEM_CLOCK(count_clock)
-            WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0   
-          endif
-
-  ! Concentrations
-
-  ! surf_only write only 1st layer 
-
-          sp_count_i=0
-          sp_count_r=0
-          sp_fact=-1.
-          sp_zer=.true.
-          do kz=1,1
-            do jy=0,numygrid-1
-              do ix=0,numxgrid-1
-                if (grid(ix,jy,kz).gt.smallnum) then
-                  if (sp_zer.eqv..true.) then ! first non zero value
-                    sp_count_i=sp_count_i+1
-                    sparse_dump_i(sp_count_i)= &
-                         ix+jy*numxgrid+kz*numxgrid*numygrid
-                    sp_zer=.false.
-                    sp_fact=sp_fact*(-1.)
-                  endif
-                  sp_count_r=sp_count_r+1
-                  sparse_dump_r(sp_count_r)= &
-                       sp_fact* &
-                       grid(ix,jy,kz)* &
-                       factor3d(ix,jy,kz)/tot_mu(ks,kp)
-                  sparse_dump_u(sp_count_r)= &
-                       gridsigma(ix,jy,kz)* &
-                       factor3d(ix,jy,kz)/tot_mu(ks,kp)
-
-                else ! concentration is zero
-                  sp_zer=.true.
-                endif
-              end do
-            end do
-          end do
-          write(unitoutgrid) sp_count_i
-          write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
-          write(unitoutgrid) sp_count_r
-          write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
-
-        endif !  concentration output
-
-  ! Mixing ratio output
-  !********************
-
-        if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
-
-  ! Mixing ratios
-
-  ! surf_only write only 1st layer 
-
-          sp_count_i=0
-          sp_count_r=0
-          sp_fact=-1.
-          sp_zer=.true.
-          do kz=1,1
-            do jy=0,numygrid-1
-              do ix=0,numxgrid-1
-                if (grid(ix,jy,kz).gt.smallnum) then
-                  if (sp_zer.eqv..true.) then ! first non zero value
-                    sp_count_i=sp_count_i+1
-                    sparse_dump_i(sp_count_i)= &
-                         ix+jy*numxgrid+kz*numxgrid*numygrid
-                    sp_zer=.false.
-                    sp_fact=sp_fact*(-1.)
-                  endif
-                  sp_count_r=sp_count_r+1
-                  sparse_dump_r(sp_count_r)= &
-                       sp_fact* &
-                       1.e12*grid(ix,jy,kz) &
-                       /volume(ix,jy,kz)/outnum* &
-                       weightair/weightmolar(ks)/densityoutgrid(ix,jy,kz)
-                  sparse_dump_u(sp_count_r)= &
-                       1.e12*gridsigma(ix,jy,kz)/volume(ix,jy,kz)/ &
-                       outnum*weightair/weightmolar(ks)/ &
-                       densityoutgrid(ix,jy,kz)
-                else ! concentration is zero
-                  sp_zer=.true.
-                endif
-              end do
-            end do
-          end do
-          write(unitoutgridppt) sp_count_i
-          write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
-          write(unitoutgridppt) sp_count_r
-          write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
-
-        endif ! output for ppt
-
-      end do  ! nageclass
-
-      close(unitoutgridppt)
-      close(unitoutgrid)
-
-      ! itime is outside range
-10    continue
-
-    end do  ! maxpointspec_act
-
-  end do  ! nspec
-
-  ! RLT Aug 2017
-  ! Write out conversion factor for dry air
-  inquire(file=path(2)(1:length(2))//'factor_drygrid',exist=lexist)
-  if (lexist.and..not.lstart) then
-    ! open and append
-    open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid',form='unformatted',&
-            status='old',action='write',access='append')
-  else
-    ! create new
-    open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid',form='unformatted',&
-            status='replace',action='write')
-  endif
-  sp_count_i=0
-  sp_count_r=0
-  sp_fact=-1.
-  sp_zer=.true.
-  do kz=1,1
-    do jy=0,numygrid-1
-      do ix=0,numxgrid-1
-        if (factor_drygrid(ix,jy,kz).gt.(1.+smallnum).or.factor_drygrid(ix,jy,kz).lt.(1.-smallnum)) then
-          if (sp_zer.eqv..true.) then ! first value not equal to one
-            sp_count_i=sp_count_i+1
-            sparse_dump_i(sp_count_i)= &
-                  ix+jy*numxgrid+kz*numxgrid*numygrid
-            sp_zer=.false.
-            sp_fact=sp_fact*(-1.)
-          endif
-          sp_count_r=sp_count_r+1
-          sparse_dump_r(sp_count_r)= &
-               sp_fact*factor_drygrid(ix,jy,kz)
-        else ! factor is one
-          sp_zer=.true.
-        endif
-      end do
-    end do
-  end do
-  write(unitoutfactor) sp_count_i
-  write(unitoutfactor) (sparse_dump_i(i),i=1,sp_count_i)
-  write(unitoutfactor) sp_count_r
-  write(unitoutfactor) (sparse_dump_r(i),i=1,sp_count_r)
-  close(unitoutfactor)
-
-
-  if (gridtotal.gt.0.) gridtotalunc=gridsigmatotal/gridtotal
-
-  ! Dump of receptor concentrations
-
-  if (numreceptor.gt.0 .and. (iout.eq.2 .or. iout.eq.3)  ) then
-    write(unitoutreceptppt) itime
-    do ks=1,nspec
-      write(unitoutreceptppt) (1.e12*creceptor(i,ks)/outnum* &
-           weightair/weightmolar(ks)/densityoutrecept(i),i=1,numreceptor)
-    end do
-  endif
-
-  ! Dump of receptor concentrations
-
-  if (numreceptor.gt.0) then
-    write(unitoutrecept) itime
-    do ks=1,nspec
-      write(unitoutrecept) (1.e12*creceptor(i,ks)/outnum, &
-           i=1,numreceptor)
-    end do
-  endif
-
-  ! RLT Aug 2017
-  ! Write out conversion factor for dry air
-  if (numreceptor.gt.0) then
-    inquire(file=path(2)(1:length(2))//'factor_dryreceptor',exist=lexist)
-     if (lexist.and..not.lstart) then
-     ! open and append
-      open(unitoutfactor,file=path(2)(1:length(2))//'factor_dryreceptor',form='unformatted',&
-              status='old',action='write',access='append')
-    else
-      ! create new
-      open(unitoutfactor,file=path(2)(1:length(2))//'factor_dryreceptor',form='unformatted',&
-              status='replace',action='write')
-    endif
-    write(unitoutfactor) itime
-    write(unitoutfactor) (factor_dryrecept(i),i=1,numreceptor)
-    close(unitoutfactor)
-  endif
-
-  ! reset lstart
-  if (lstart) then
-    lstart=.false.
-  endif
-  print*, 'after writing output files: lstart = ',lstart
-
-
-  ! Reinitialization of grid
-  !*************************
-
-  do ks=1,nspec
-    do kp=1,maxpointspec_act
-      do i=1,numreceptor
-        creceptor(i,ks)=0.
-      end do
-      do jy=0,numygrid-1
-        do ix=0,numxgrid-1
-          do l=1,nclassunc
-            do nage=1,nageclass
-              do kz=1,numzgrid
-                gridunc(ix,jy,kz,ks,kp,l,nage)=0.
-              end do
-            end do
-          end do
-        end do
-      end do
-    end do
-  end do
-end subroutine concoutput_inv
-
-subroutine concoutput_inv_nest(itime,outnum)
-  !                        i     i
-  !*****************************************************************************
-  !                                                                            *
-  !     Output of the concentration grid and the receptor concentrations.      *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     24 May 1995                                                            *
-  !                                                                            *
-  !     13 April 1999, Major update: if output size is smaller, dump output    *
-  !                    in sparse matrix format; additional output of           *
-  !                    uncertainty                                             *
-  !                                                                            *
-  !     05 April 2000, Major update: output of age classes; output for backward*
-  !                    runs is time spent in grid cell times total mass of     *
-  !                    species.                                                *
-  !                                                                            *
-  !     17 February 2002, Appropriate dimensions for backward and forward runs *
-  !                       are now specified in file par_mod                    *
-  !                                                                            *
-  !     June 2006, write grid in sparse matrix with a single write command     *
-  !                in order to save disk space                                 *
-  !                                                                            *
-  !     2008 new sparse matrix format                                          *
-  !
-  !     January 2017,  Separate files by release but include all timesteps     *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! outnum          number of samples                                          *
-  ! ncells          number of cells with non-zero concentrations               *
-  ! sparse          .true. if in sparse matrix format, else .false.            *
-  ! tot_mu          1 for forward, initial mass mixing ration for backw. runs  *
-  !                                                                            *
-  !*****************************************************************************
-
-  use unc_mod
-  use mean_mod
-
-  implicit none
-
-  real(kind=dp) :: jul
-  integer :: itime,i,ix,jy,kz,ks,kp,l,iix,jjy,kzz,nage,jjjjmmdd,ihmmss
-  integer :: sp_count_i,sp_count_r
-  real :: sp_fact
-  real :: outnum,densityoutrecept(maxreceptor),xl,yl
-  ! RLT
-  real :: densitydryrecept(maxreceptor)
-  real :: factor_dryrecept(maxreceptor)
-
-  real(dep_prec) :: auxgrid(nclassunc)
-  real :: halfheight,dz,dz1,dz2,tot_mu(maxspec,maxpointspec_act)
-  real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
-  real,parameter :: weightair=28.97
-  logical :: sp_zer
-  logical,save :: lnstart=.true.
-  logical,save,allocatable,dimension(:) :: lnstartrel
-  character :: adate*8,atime*6
-  character(len=3) :: anspec
-  logical :: lexist
-  character :: areldate*8,areltime*6
-
-  if(lnstart) then
-    allocate(lnstartrel(maxpointspec_act))
-    lnstartrel(:)=.true.
-  endif
-  print*, 'lnstartrel = ',lnstartrel
-
-  ! Determine current calendar date, needed for the file name
-  !**********************************************************
-
-  jul=bdate+real(itime,kind=dp)/86400._dp
-  call caldate(jul,jjjjmmdd,ihmmss)
-  write(adate,'(i8.8)') jjjjmmdd
-  write(atime,'(i6.6)') ihmmss
-
-  print*, 'outnum:',outnum
-  print*, 'datetime:',adate//atime
-
-  ! For forward simulations, output fields have dimension MAXSPEC,
-  ! for backward simulations, output fields have dimension MAXPOINT.
-  ! Thus, make loops either about nspec, or about numpoint
-  !*****************************************************************
-
-
-    if (ldirect.eq.1) then
-       do ks=1,nspec
-         do kp=1,maxpointspec_act
-           tot_mu(ks,kp)=1
-         end do
-       end do
-   else
-      do ks=1,nspec
-             do kp=1,maxpointspec_act
-               tot_mu(ks,kp)=xmass(kp,ks)
-             end do
-      end do
-    endif
-
-
-  !*******************************************************************
-  ! Compute air density: sufficiently accurate to take it
-  ! from coarse grid at some time
-  ! Determine center altitude of output layer, and interpolate density
-  ! data to that altitude
-  !*******************************************************************
-
-  do kz=1,numzgrid
-    if (kz.eq.1) then
-      halfheight=outheight(1)/2.
-    else
-      halfheight=(outheight(kz)+outheight(kz-1))/2.
-    endif
-    do kzz=2,nz
-      if ((height(kzz-1).lt.halfheight).and. &
-           (height(kzz).gt.halfheight)) goto 46
-    end do
-46   kzz=max(min(kzz,nz),2)
-    dz1=halfheight-height(kzz-1)
-    dz2=height(kzz)-halfheight
-    dz=dz1+dz2
-    do jy=0,numygridn-1
-      do ix=0,numxgridn-1
-        xl=outlon0n+real(ix)*dxoutn
-        yl=outlat0n+real(jy)*dyoutn
-        xl=(xl-xlon0)/dx
-        yl=(yl-ylat0)/dy
-        iix=max(min(nint(xl),nxmin1),0)
-        jjy=max(min(nint(yl),nymin1),0)
-        densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,2)*dz1+ &
-             rho(iix,jjy,kzz-1,2)*dz2)/dz
-  ! RLT
-        densitydrygrid(ix,jy,kz)=(rho_dry(iix,jjy,kzz,2)*dz1+ &
-             rho_dry(iix,jjy,kzz-1,2)*dz2)/dz
-      end do
-    end do
-  end do
-
-  do i=1,numreceptor
-    xl=xreceptor(i)
-    yl=yreceptor(i)
-    iix=max(min(nint(xl),nxmin1),0)
-    jjy=max(min(nint(yl),nymin1),0)
-    densityoutrecept(i)=rho(iix,jjy,1,2)
-  ! RLT
-    densitydryrecept(i)=rho_dry(iix,jjy,1,2)
-  end do
-
-  ! RLT
-  ! conversion factor for output relative to dry air
-  factor_drygrid=densityoutgrid/densitydrygrid
-  factor_dryrecept=densityoutrecept/densitydryrecept
-
-  ! Output is different for forward and backward simulations
-    do kz=1,numzgrid
-      do jy=0,numygridn-1
-        do ix=0,numxgridn-1
-          if (ldirect.eq.1) then
-            factor3d(ix,jy,kz)=1.e12/volumen(ix,jy,kz)/outnum
-          else
-            factor3d(ix,jy,kz)=real(abs(loutaver))/outnum
-          endif
-        end do
-      end do
-    end do
-
-  !*********************************************************************
-  ! Determine the standard deviation of the mean concentration or mixing
-  ! ratio (uncertainty of the output) and the dry and wet deposition
-  !*********************************************************************
-
-  do ks=1,nspec
-
-  write(anspec,'(i3.3)') ks
-
-    do kp=1,maxpointspec_act
-
-      print*, 'itime = ',itime
-      print*, 'lage(1) = ',lage(1)
-      print*, 'ireleasestart(kp) = ',ireleasestart(kp)
-      print*, 'ireleaseend(kp) = ',ireleaseend(kp)
-
-      ! check itime is within release and backward trajectory length
-      if (nageclass.eq.1) then
-        if ((itime.gt.ireleaseend(kp)).or.(itime.lt.(ireleasestart(kp)-lage(1)))) then
-          go to 10
-        endif
-      endif
-
-      ! calculate date of release
-      jul=bdate+real(ireleasestart(kp),kind=dp)/86400._dp    ! this is the current day
-      call caldate(jul,jjjjmmdd,ihmmss)
-      write(areldate,'(i8.8)') jjjjmmdd
-      write(areltime,'(i6.6)') ihmmss
-      print*, areldate//areltime
-
-      ! calculate date of field
-      jul=bdate+real(itime,kind=dp)/86400._dp
-      call caldate(jul,jjjjmmdd,ihmmss)
-      write(adate,'(i8.8)') jjjjmmdd
-      write(atime,'(i6.6)') ihmmss
-      print*, adate//atime
-
-      if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
-        if (ldirect.eq.1) then
-          ! concentrations
-          inquire(file=path(2)(1:length(2))//'grid_conc_nest_'//areldate// &
-                  areltime//'_'//anspec,exist=lexist)
-          if(lexist.and..not.lnstartrel(kp)) then
-            ! open and append to existing file
-            open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_nest_'//areldate// &
-                 areltime//'_'//anspec,form='unformatted',status='old',action='write',access='append')
-          else
-            ! open new file
-            open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_nest_'//areldate// &
-                 areltime//'_'//anspec,form='unformatted',status='replace',action='write')
-          endif
-        else
-          ! residence times
-          inquire(file=path(2)(1:length(2))//'grid_time_nest_'//areldate// &
-                  areltime//'_'//anspec,exist=lexist)
-          if(lexist.and..not.lnstartrel(kp)) then
-            ! open and append to existing file
-            open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_nest_'//areldate// &
-                 areltime//'_'//anspec,form='unformatted',status='old',action='write',access='append')
-          else
-            ! open new file
-            open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_nest_'//areldate// &
-                 areltime//'_'//anspec,form='unformatted',status='replace',action='write')
-          endif
-        endif
-        write(unitoutgrid) jjjjmmdd
-        write(unitoutgrid) ihmmss
-      endif
-
-      if ((iout.eq.2).or.(iout.eq.3)) then
-        ! mixing ratio
-        inquire(file=path(2)(1:length(2))//'grid_pptv_nest_'//areldate// &
-                areltime//'_'//anspec,exist=lexist)
-        if(lexist.and..not.lnstartrel(kp)) then
-          ! open and append to existing file
-          open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_nest_'//areldate// &
-               areltime//'_'//anspec,form='unformatted',status='old',action='write',access='append')
-        else
-          ! open new file
-          open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_nest_'//areldate// &
-               areltime//'_'//anspec,form='unformatted',status='replace',action='write')
-        endif
-        write(unitoutgridppt) jjjjmmdd
-        write(unitoutgridppt) ihmmss
-      endif
-
-      lnstartrel(kp)=.false.
-
-      do nage=1,nageclass
-
-        do jy=0,numygridn-1
-          do ix=0,numxgridn-1
-
-  ! CONCENTRATION OR MIXING RATIO
-            do kz=1,numzgrid
-              do l=1,nclassunc
-                auxgrid(l)=griduncn(ix,jy,kz,ks,kp,l,nage)
-              end do
-              call mean(auxgrid,grid(ix,jy,kz), &
-                     gridsigma(ix,jy,kz),nclassunc)
-  ! Multiply by number of classes to get total concentration
-              grid(ix,jy,kz)= &
-                   grid(ix,jy,kz)*nclassunc
-  ! Calculate standard deviation of the mean
-              gridsigma(ix,jy,kz)= &
-                   gridsigma(ix,jy,kz)* &
-                   sqrt(real(nclassunc))
-            end do
-          end do
-        end do
-
-
-  !*******************************************************************
-  ! Generate output: may be in concentration (ng/m3) or in mixing
-  ! ratio (ppt) or both
-  ! Output the position and the values alternated multiplied by
-  ! 1 or -1, first line is number of values, number of positions
-  ! For backward simulations, the unit is seconds, stored in grid_time
-  !*******************************************************************
-
-  ! Concentration output
-  !*********************
-
-        if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
-
-  ! Concentrations
-
-  ! surf_only write only 1st layer 
-
-         sp_count_i=0
-         sp_count_r=0
-         sp_fact=-1.
-         sp_zer=.true.
-          do kz=1,1
-            do jy=0,numygridn-1
-              do ix=0,numxgridn-1
-                if (grid(ix,jy,kz).gt.smallnum) then
-                  if (sp_zer.eqv..true.) then ! first non zero value
-                    sp_count_i=sp_count_i+1
-                    sparse_dump_i(sp_count_i)= &
-                         ix+jy*numxgridn+kz*numxgridn*numygridn
-                    sp_zer=.false.
-                    sp_fact=sp_fact*(-1.)
-                   endif
-                   sp_count_r=sp_count_r+1
-                   sparse_dump_r(sp_count_r)= &
-                        sp_fact* &
-                        grid(ix,jy,kz)* &
-                        factor3d(ix,jy,kz)/tot_mu(ks,kp)
-  !                 if ((factor(ix,jy,kz)/tot_mu(ks,kp)).eq.0)
-  !    +              write (*,*) factor(ix,jy,kz),tot_mu(ks,kp),ks,kp
-                   sparse_dump_u(sp_count_r)= &
-                        gridsigma(ix,jy,kz)* &
-                        factor3d(ix,jy,kz)/tot_mu(ks,kp)
-              else ! concentration is zero
-                  sp_zer=.true.
-              endif
-              end do
-            end do
-          end do
-         write(unitoutgrid) sp_count_i
-         write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
-         write(unitoutgrid) sp_count_r
-         write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
-
-      endif !  concentration output
-
-  ! Mixing ratio output
-  !********************
-
-      if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
-
-
-  ! Mixing ratios
-
-    ! surf_only write only 1st layer 
-
-         sp_count_i=0
-         sp_count_r=0
-         sp_fact=-1.
-         sp_zer=.true.
-          do kz=1,1
-            do jy=0,numygridn-1
-              do ix=0,numxgridn-1
-                if (grid(ix,jy,kz).gt.smallnum) then
-                  if (sp_zer.eqv..true.) then ! first non zero value
-                    sp_count_i=sp_count_i+1
-                    sparse_dump_i(sp_count_i)= &
-                         ix+jy*numxgridn+kz*numxgridn*numygridn
-                    sp_zer=.false.
-                    sp_fact=sp_fact*(-1.)
-                 endif
-                 sp_count_r=sp_count_r+1
-                 sparse_dump_r(sp_count_r)= &
-                      sp_fact* &
-                      1.e12*grid(ix,jy,kz) &
-                      /volumen(ix,jy,kz)/outnum* &
-                      weightair/weightmolar(ks)/densityoutgrid(ix,jy,kz)
-                 sparse_dump_u(sp_count_r)= &
-                      1.e12*gridsigma(ix,jy,kz)/volumen(ix,jy,kz)/ &
-                      outnum*weightair/weightmolar(ks)/ &
-                      densityoutgrid(ix,jy,kz)
-              else ! concentration is zero
-                  sp_zer=.true.
-              endif
-              end do
-            end do
-          end do
-          write(unitoutgridppt) sp_count_i
-          write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
-          write(unitoutgridppt) sp_count_r
-          write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
-
-        endif ! output for ppt
- 
-      end do ! nageclass
-
-      close(unitoutgridppt)
-      close(unitoutgrid)
-
-      ! itime is outside range
-10    continue
-
-    end do ! maxpointspec_act
-
-  end do ! nspec
-
-
-  ! RLT Aug 2017
-  ! Write out conversion factor for dry air
-  inquire(file=path(2)(1:length(2))//'factor_drygrid_nest',exist=lexist)
-  if (lexist.and..not.lnstart) then
-    ! open and append
-    open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid_nest',form='unformatted',&
-            status='old',action='write',access='append')
-  else
-    ! create new
-    open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid_nest',form='unformatted',&
-            status='replace',action='write')
-  endif
-  sp_count_i=0
-  sp_count_r=0
-  sp_fact=-1.
-  sp_zer=.true.
-  do kz=1,1
-    do jy=0,numygridn-1
-      do ix=0,numxgridn-1
-        if (factor_drygrid(ix,jy,kz).gt.(1.+smallnum).or.factor_drygrid(ix,jy,kz).lt.(1.-smallnum)) then
-          if (sp_zer.eqv..true.) then ! first value not equal to one
-            sp_count_i=sp_count_i+1
-            sparse_dump_i(sp_count_i)= &
-                  ix+jy*numxgridn+kz*numxgridn*numygridn
-            sp_zer=.false.
-            sp_fact=sp_fact*(-1.)
-          endif
-          sp_count_r=sp_count_r+1
-          sparse_dump_r(sp_count_r)= &
-               sp_fact*factor_drygrid(ix,jy,kz)
-        else ! factor is one
-          sp_zer=.true.
-        endif
-      end do
-    end do
-  end do
-  write(unitoutfactor) sp_count_i
-  write(unitoutfactor) (sparse_dump_i(i),i=1,sp_count_i)
-  write(unitoutfactor) sp_count_r
-  write(unitoutfactor) (sparse_dump_r(i),i=1,sp_count_r)
-  close(unitoutfactor)
-
-  ! reset lnstart
-  if (lnstart) then
-    lnstart=.false.
-  endif
-
-  ! Reinitialization of grid
-  !*************************
-
-  do ks=1,nspec
-  do kp=1,maxpointspec_act
-    do i=1,numreceptor
-      creceptor(i,ks)=0.
-    end do
-    do jy=0,numygridn-1
-      do ix=0,numxgridn-1
-        do l=1,nclassunc
-          do nage=1,nageclass
-            do kz=1,numzgrid
-              griduncn(ix,jy,kz,ks,kp,l,nage)=0.
-            end do
-          end do
-        end do
-      end do
-    end do
-  end do
-  end do
-end subroutine concoutput_inv_nest
-
-subroutine concoutput_sfc(itime,outnum,gridtotalunc,wetgridtotalunc, &
-     drygridtotalunc)
-  !                        i     i          o             o
-  !       o
-  !*****************************************************************************
-  !                                                                            *
-  !     Output of the concentration grid and the receptor concentrations.      *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     24 May 1995                                                            *
-  !                                                                            *
-  !     13 April 1999, Major update: if output size is smaller, dump output    *
-  !                    in sparse matrix format; additional output of           *
-  !                    uncertainty                                             *
-  !                                                                            *
-  !     05 April 2000, Major update: output of age classes; output for backward*
-  !                    runs is time spent in grid cell times total mass of     *
-  !                    species.                                                *
-  !                                                                            *
-  !     17 February 2002, Appropriate dimensions for backward and forward runs *
-  !                       are now specified in file par_mod                    *
-  !                                                                            *
-  !     June 2006, write grid in sparse matrix with a single write command     *
-  !                in order to save disk space                                 *
-  !                                                                            *
-  !     2008 new sparse matrix format                                          *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! outnum          number of samples                                          *
-  ! ncells          number of cells with non-zero concentrations               *
-  ! sparse          .true. if in sparse matrix format, else .false.            *
-  ! tot_mu          1 for forward, initial mass mixing ration for backw. runs  *
-  !                                                                            *
-  !*****************************************************************************
-
-  use unc_mod
-  use mean_mod
-
-  implicit none
-
-  real(kind=dp) :: jul
-  integer :: itime,i,ix,jy,kz,ks,kp,l,iix,jjy,kzz,nage,jjjjmmdd,ihmmss
-  integer :: sp_count_i,sp_count_r
-  real :: sp_fact
-  real :: outnum,densityoutrecept(maxreceptor),xl,yl
-  ! RLT
-  real :: densitydryrecept(maxreceptor)
-  real :: factor_dryrecept(maxreceptor)
-
-  real(dep_prec) :: auxgrid(nclassunc)
-  real(sp) :: gridtotal,gridsigmatotal,gridtotalunc
-  real(dep_prec) :: wetgridtotal,wetgridsigmatotal,wetgridtotalunc
-  real(dep_prec) :: drygridtotal,drygridsigmatotal,drygridtotalunc
-  real :: halfheight,dz,dz1,dz2,tot_mu(maxspec,maxpointspec_act)
-  real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
-  real,parameter :: weightair=28.97
-  logical :: sp_zer
-  character :: adate*8,atime*6
-  character(len=3) :: anspec
-  logical :: lexist
-
-
-  if (verbosity.eq.1) then
-    print*,'inside concoutput_sfc '
-    CALL SYSTEM_CLOCK(count_clock)
-    WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0   
-  endif
-
-  ! Determine current calendar date, needed for the file name
-  !**********************************************************
-
-  jul=bdate+real(itime,kind=dp)/86400._dp
-  call caldate(jul,jjjjmmdd,ihmmss)
-  write(adate,'(i8.8)') jjjjmmdd
-  write(atime,'(i6.6)') ihmmss
-
-  open(unitdates,file=path(2)(1:length(2))//'dates', ACCESS='APPEND')
-  write(unitdates,'(a)') adate//atime
-  close(unitdates)
-
-  ! For forward simulations, output fields have dimension MAXSPEC,
-  ! for backward simulations, output fields have dimension MAXPOINT.
-  ! Thus, make loops either about nspec, or about numpoint
-  !*****************************************************************
-
-
-  if (ldirect.eq.1) then
-    do ks=1,nspec
-      do kp=1,maxpointspec_act
-        tot_mu(ks,kp)=1
-      end do
-    end do
-  else
-    do ks=1,nspec
-      do kp=1,maxpointspec_act
-        tot_mu(ks,kp)=xmass(kp,ks)
-      end do
-    end do
-  endif
-
-
-  if (verbosity.eq.1) then
-    print*,'concoutput_sfc 2'
-    CALL SYSTEM_CLOCK(count_clock)
-    WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0   
-  endif
-
-  !*******************************************************************
-  ! Compute air density: sufficiently accurate to take it
-  ! from coarse grid at some time
-  ! Determine center altitude of output layer, and interpolate density
-  ! data to that altitude
-  !*******************************************************************
-
-  do kz=1,numzgrid
-    if (kz.eq.1) then
-      halfheight=outheight(1)/2.
-    else
-      halfheight=(outheight(kz)+outheight(kz-1))/2.
-    endif
-    do kzz=2,nz
-      if ((height(kzz-1).lt.halfheight).and. &
-           (height(kzz).gt.halfheight)) goto 46
-    end do
-46  kzz=max(min(kzz,nz),2)
-    dz1=halfheight-height(kzz-1)
-    dz2=height(kzz)-halfheight
-    dz=dz1+dz2
-    do jy=0,numygrid-1
-      do ix=0,numxgrid-1
-        xl=outlon0+real(ix)*dxout
-        yl=outlat0+real(jy)*dyout
-        xl=(xl-xlon0)/dx
-        yl=(yl-ylat0)/dy
-        iix=max(min(nint(xl),nxmin1),0)
-        jjy=max(min(nint(yl),nymin1),0)
-        densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,2)*dz1+ &
-             rho(iix,jjy,kzz-1,2)*dz2)/dz
-  ! RLT
-        densitydrygrid(ix,jy,kz)=(rho_dry(iix,jjy,kzz,2)*dz1+ &
-             rho_dry(iix,jjy,kzz-1,2)*dz2)/dz
-      end do
-    end do
-  end do
-
-  do i=1,numreceptor
-    xl=xreceptor(i)
-    yl=yreceptor(i)
-    iix=max(min(nint(xl),nxmin1),0)
-    jjy=max(min(nint(yl),nymin1),0)
-    densityoutrecept(i)=rho(iix,jjy,1,2)
-  ! RLT
-    densitydryrecept(i)=rho_dry(iix,jjy,1,2)
-  end do
-
-  ! RLT
-  ! conversion factor for output relative to dry air
-  factor_drygrid=densityoutgrid/densitydrygrid
-  factor_dryrecept=densityoutrecept/densitydryrecept
-
-  ! Output is different for forward and backward simulations
-  do kz=1,numzgrid
-    do jy=0,numygrid-1
-      do ix=0,numxgrid-1
-        if (ldirect.eq.1) then
-          factor3d(ix,jy,kz)=1.e12/volume(ix,jy,kz)/outnum
-        else
-          factor3d(ix,jy,kz)=real(abs(loutaver))/outnum
-        endif
-      end do
-    end do
-  end do
-
-  !*********************************************************************
-  ! Determine the standard deviation of the mean concentration or mixing
-  ! ratio (uncertainty of the output) and the dry and wet deposition
-  !*********************************************************************
-
-  if (verbosity.eq.1) then
-    print*,'concoutput_sfc 3 (sd)'
-    CALL SYSTEM_CLOCK(count_clock)
-    WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0   
-  endif
-  gridtotal=0.
-  gridsigmatotal=0.
-  gridtotalunc=0.
-  wetgridtotal=0.
-  wetgridsigmatotal=0.
-  wetgridtotalunc=0.
-  drygridtotal=0.
-  drygridsigmatotal=0.
-  drygridtotalunc=0.
-
-  do ks=1,nspec
-
-    write(anspec,'(i3.3)') ks
-    if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
-      if (ldirect.eq.1) then
-        open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_'//adate// &
-             atime//'_'//anspec,form='unformatted')
-      else
-        open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_'//adate// &
-             atime//'_'//anspec,form='unformatted')
-      endif
-      write(unitoutgrid) itime
-    endif
-
-    if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
-      open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_'//adate// &
-           atime//'_'//anspec,form='unformatted')
-
-      write(unitoutgridppt) itime
-    endif
-
-    do kp=1,maxpointspec_act
-      do nage=1,nageclass
-
-        do jy=0,numygrid-1
-          do ix=0,numxgrid-1
-
-  ! WET DEPOSITION
-            if ((WETDEP).and.(ldirect.gt.0)) then
-              do l=1,nclassunc
-                auxgrid(l)=wetgridunc(ix,jy,ks,kp,l,nage)
-              end do
-              call mean(auxgrid,wetgrid(ix,jy), &
-                   wetgridsigma(ix,jy),nclassunc)
-  ! Multiply by number of classes to get total concentration
-              wetgrid(ix,jy)=wetgrid(ix,jy) &
-                   *nclassunc
-              wetgridtotal=wetgridtotal+wetgrid(ix,jy)
-  ! Calculate standard deviation of the mean
-              wetgridsigma(ix,jy)= &
-                   wetgridsigma(ix,jy)* &
-                   sqrt(real(nclassunc))
-              wetgridsigmatotal=wetgridsigmatotal+ &
-                   wetgridsigma(ix,jy)
-            endif
-
-  ! DRY DEPOSITION
-            if ((DRYDEP).and.(ldirect.gt.0)) then
-              do l=1,nclassunc
-                auxgrid(l)=drygridunc(ix,jy,ks,kp,l,nage)
-              end do
-              call mean(auxgrid,drygrid(ix,jy), &
-                   drygridsigma(ix,jy),nclassunc)
-  ! Multiply by number of classes to get total concentration
-              drygrid(ix,jy)=drygrid(ix,jy)* &
-                   nclassunc
-              drygridtotal=drygridtotal+drygrid(ix,jy)
-  ! Calculate standard deviation of the mean
-              drygridsigma(ix,jy)= &
-                   drygridsigma(ix,jy)* &
-                   sqrt(real(nclassunc))
-125           drygridsigmatotal=drygridsigmatotal+ &
-                   drygridsigma(ix,jy)
-            endif
-
-  ! CONCENTRATION OR MIXING RATIO
-            do kz=1,numzgrid
-              do l=1,nclassunc
-                auxgrid(l)=gridunc(ix,jy,kz,ks,kp,l,nage)
-              end do
-              call mean(auxgrid,grid(ix,jy,kz), &
-                   gridsigma(ix,jy,kz),nclassunc)
-  ! Multiply by number of classes to get total concentration
-              grid(ix,jy,kz)= &
-                   grid(ix,jy,kz)*nclassunc
-              gridtotal=gridtotal+grid(ix,jy,kz)
-  ! Calculate standard deviation of the mean
-              gridsigma(ix,jy,kz)= &
-                   gridsigma(ix,jy,kz)* &
-                   sqrt(real(nclassunc))
-              gridsigmatotal=gridsigmatotal+ &
-                   gridsigma(ix,jy,kz)
-            end do
-          end do
-        end do
-
-
-  !*******************************************************************
-  ! Generate output: may be in concentration (ng/m3) or in mixing
-  ! ratio (ppt) or both
-  ! Output the position and the values alternated multiplied by
-  ! 1 or -1, first line is number of values, number of positions
-  ! For backward simulations, the unit is seconds, stored in grid_time
-  !*******************************************************************
-
-        if (verbosity.eq.1) then
-          print*,'concoutput_sfc 4 (output)'
-          CALL SYSTEM_CLOCK(count_clock)
-          WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0   
-        endif
-
-  ! Concentration output
-  !*********************
-
-        if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
-
-          if (verbosity.eq.1) then
-            print*,'concoutput_sfc (Wet deposition)'
-            CALL SYSTEM_CLOCK(count_clock)
-            WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0   
-          endif
-
-  ! Wet deposition
-          sp_count_i=0
-          sp_count_r=0
-          sp_fact=-1.
-          sp_zer=.true.
-          if ((ldirect.eq.1).and.(WETDEP)) then
-            do jy=0,numygrid-1
-              do ix=0,numxgrid-1
-  ! concentraion greater zero
-                if (wetgrid(ix,jy).gt.smallnum) then
-                  if (sp_zer.eqv..true.) then ! first non zero value
-                    sp_count_i=sp_count_i+1
-                    sparse_dump_i(sp_count_i)=ix+jy*numxgrid
-                    sp_zer=.false.
-                    sp_fact=sp_fact*(-1.)
-                  endif
-                  sp_count_r=sp_count_r+1
-                  sparse_dump_r(sp_count_r)= &
-                       sp_fact*1.e12*wetgrid(ix,jy)/area(ix,jy)
-                  sparse_dump_u(sp_count_r)= &
-                       1.e12*wetgridsigma(ix,jy)/area(ix,jy)
-                else ! concentration is zero
-                  sp_zer=.true.
-                endif
-              end do
-            end do
-          else
-            sp_count_i=0
-            sp_count_r=0
-          endif
-          write(unitoutgrid) sp_count_i
-          write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
-          write(unitoutgrid) sp_count_r
-          write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
-
-          if (verbosity.eq.1) then
-            print*,'concoutput_sfc (Dry deposition)'
-            CALL SYSTEM_CLOCK(count_clock)
-            WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0   
-          endif
-  ! Dry deposition
-          sp_count_i=0
-          sp_count_r=0
-          sp_fact=-1.
-          sp_zer=.true.
-          if ((ldirect.eq.1).and.(DRYDEP)) then
-            do jy=0,numygrid-1
-              do ix=0,numxgrid-1
-                if (drygrid(ix,jy).gt.smallnum) then
-                  if (sp_zer.eqv..true.) then ! first non zero value
-                    sp_count_i=sp_count_i+1
-                    sparse_dump_i(sp_count_i)=ix+jy*numxgrid
-                    sp_zer=.false.
-                    sp_fact=sp_fact*(-1.)
-                  endif
-                  sp_count_r=sp_count_r+1
-                  sparse_dump_r(sp_count_r)= &
-                       sp_fact* &
-                       1.e12*drygrid(ix,jy)/area(ix,jy)
-                  sparse_dump_u(sp_count_r)= &
-                       1.e12*drygridsigma(ix,jy)/area(ix,jy)
-                else ! concentration is zero
-                  sp_zer=.true.
-                endif
-              end do
-            end do
-          else
-            sp_count_i=0
-            sp_count_r=0
-          endif
-          write(unitoutgrid) sp_count_i
-          write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
-          write(unitoutgrid) sp_count_r
-          write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
-
-          if (verbosity.eq.1) then
-            print*,'concoutput_sfc (Concentrations)'
-            CALL SYSTEM_CLOCK(count_clock)
-            WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0   
-          endif
-
-  ! Concentrations
-
-  ! surf_only write only 1st layer 
-
-          sp_count_i=0
-          sp_count_r=0
-          sp_fact=-1.
-          sp_zer=.true.
-          do kz=1,1
-            do jy=0,numygrid-1
-              do ix=0,numxgrid-1
-                if (grid(ix,jy,kz).gt.smallnum) then
-                  if (sp_zer.eqv..true.) then ! first non zero value
-                    sp_count_i=sp_count_i+1
-                    sparse_dump_i(sp_count_i)= &
-                         ix+jy*numxgrid+kz*numxgrid*numygrid
-                    sp_zer=.false.
-                    sp_fact=sp_fact*(-1.)
-                  endif
-                  sp_count_r=sp_count_r+1
-                  sparse_dump_r(sp_count_r)= &
-                       sp_fact* &
-                       grid(ix,jy,kz)* &
-                       factor3d(ix,jy,kz)/tot_mu(ks,kp)
-                  sparse_dump_u(sp_count_r)= &
-                       gridsigma(ix,jy,kz)* &
-                       factor3d(ix,jy,kz)/tot_mu(ks,kp)
-                else ! concentration is zero
-                  sp_zer=.true.
-                endif
-              end do
-            end do
-          end do
-          write(unitoutgrid) sp_count_i
-          write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
-          write(unitoutgrid) sp_count_r
-          write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
-        endif !  concentration output
-
-  ! Mixing ratio output
-  !********************
-
-        if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
-
-  ! Wet deposition
-          sp_count_i=0
-          sp_count_r=0
-          sp_fact=-1.
-          sp_zer=.true.
-          if ((ldirect.eq.1).and.(WETDEP)) then
-            do jy=0,numygrid-1
-              do ix=0,numxgrid-1
-                if (wetgrid(ix,jy).gt.smallnum) then
-                  if (sp_zer.eqv..true.) then ! first non zero value
-                    sp_count_i=sp_count_i+1
-                    sparse_dump_i(sp_count_i)= &
-                         ix+jy*numxgrid
-                    sp_zer=.false.
-                    sp_fact=sp_fact*(-1.)
-                  endif
-                  sp_count_r=sp_count_r+1
-                  sparse_dump_r(sp_count_r)= &
-                       sp_fact* &
-                       1.e12*wetgrid(ix,jy)/area(ix,jy)
-                  sparse_dump_u(sp_count_r)= &
-                       1.e12*wetgridsigma(ix,jy)/area(ix,jy)
-                else ! concentration is zero
-                  sp_zer=.true.
-                endif
-              end do
-            end do
-          else
-            sp_count_i=0
-            sp_count_r=0
-          endif
-          write(unitoutgridppt) sp_count_i
-          write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
-          write(unitoutgridppt) sp_count_r
-          write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
-
-  ! Dry deposition
-          sp_count_i=0
-          sp_count_r=0
-          sp_fact=-1.
-          sp_zer=.true.
-          if ((ldirect.eq.1).and.(DRYDEP)) then
-            do jy=0,numygrid-1
-              do ix=0,numxgrid-1
-                if (drygrid(ix,jy).gt.smallnum) then
-                  if (sp_zer.eqv..true.) then ! first non zero value
-                    sp_count_i=sp_count_i+1
-                    sparse_dump_i(sp_count_i)= &
-                         ix+jy*numxgrid
-                    sp_zer=.false.
-                    sp_fact=sp_fact*(-1)
-                  endif
-                  sp_count_r=sp_count_r+1
-                  sparse_dump_r(sp_count_r)= &
-                       sp_fact* &
-                       1.e12*drygrid(ix,jy)/area(ix,jy)
-                  sparse_dump_u(sp_count_r)= &
-                       1.e12*drygridsigma(ix,jy)/area(ix,jy)
-                else ! concentration is zero
-                  sp_zer=.true.
-                endif
-              end do
-            end do
-          else
-            sp_count_i=0
-            sp_count_r=0
-          endif
-          write(unitoutgridppt) sp_count_i
-          write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
-          write(unitoutgridppt) sp_count_r
-          write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
-
-  ! Mixing ratios
-
-  ! surf_only write only 1st layer 
-
-          sp_count_i=0
-          sp_count_r=0
-          sp_fact=-1.
-          sp_zer=.true.
-          do kz=1,1
-            do jy=0,numygrid-1
-              do ix=0,numxgrid-1
-                if (grid(ix,jy,kz).gt.smallnum) then
-                  if (sp_zer.eqv..true.) then ! first non zero value
-                    sp_count_i=sp_count_i+1
-                    sparse_dump_i(sp_count_i)= &
-                         ix+jy*numxgrid+kz*numxgrid*numygrid
-                    sp_zer=.false.
-                    sp_fact=sp_fact*(-1.)
-                  endif
-                  sp_count_r=sp_count_r+1
-                  sparse_dump_r(sp_count_r)= &
-                       sp_fact* &
-                       1.e12*grid(ix,jy,kz) &
-                       /volume(ix,jy,kz)/outnum* &
-                       weightair/weightmolar(ks)/densityoutgrid(ix,jy,kz)
-                  sparse_dump_u(sp_count_r)= &
-                       1.e12*gridsigma(ix,jy,kz)/volume(ix,jy,kz)/ &
-                       outnum*weightair/weightmolar(ks)/ &
-                       densityoutgrid(ix,jy,kz)
-                else ! concentration is zero
-                  sp_zer=.true.
-                endif
-              end do
-            end do
-          end do
-          write(unitoutgridppt) sp_count_i
-          write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
-          write(unitoutgridppt) sp_count_r
-          write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
-        endif ! output for ppt
-
-      end do
-    end do
-
-    close(unitoutgridppt)
-    close(unitoutgrid)
-
-  end do
-
-  ! RLT Aug 2017
-  ! Write out conversion factor for dry air
-  inquire(file=path(2)(1:length(2))//'factor_drygrid',exist=lexist)
-  if (lexist) then
-    ! open and append
-    open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid',form='unformatted',&
-            status='old',action='write',access='append')
-  else
-    ! create new
-    open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid',form='unformatted',&
-            status='new',action='write')
-  endif
-  sp_count_i=0
-  sp_count_r=0
-  sp_fact=-1.
-  sp_zer=.true.
-  do kz=1,1
-    do jy=0,numygrid-1
-      do ix=0,numxgrid-1
-        if (factor_drygrid(ix,jy,kz).gt.(1.+smallnum).or.factor_drygrid(ix,jy,kz).lt.(1.-smallnum)) then
-          if (sp_zer.eqv..true.) then ! first value not equal to one
-            sp_count_i=sp_count_i+1
-            sparse_dump_i(sp_count_i)= &
-                  ix+jy*numxgrid+kz*numxgrid*numygrid
-            sp_zer=.false.
-            sp_fact=sp_fact*(-1.)
-          endif
-          sp_count_r=sp_count_r+1
-          sparse_dump_r(sp_count_r)= &
-               sp_fact*factor_drygrid(ix,jy,kz)
-        else ! factor is one
-          sp_zer=.true.
-        endif
-      end do
-    end do
-  end do
-  write(unitoutfactor) sp_count_i
-  write(unitoutfactor) (sparse_dump_i(i),i=1,sp_count_i)
-  write(unitoutfactor) sp_count_r
-  write(unitoutfactor) (sparse_dump_r(i),i=1,sp_count_r)
-  close(unitoutfactor)
-
-
-  if (gridtotal.gt.0.) gridtotalunc=gridsigmatotal/gridtotal
-  if (wetgridtotal.gt.0.) wetgridtotalunc=wetgridsigmatotal/ &
-       wetgridtotal
-  if (drygridtotal.gt.0.) drygridtotalunc=drygridsigmatotal/ &
-       drygridtotal
-
-  ! Dump of receptor concentrations
-
-  if (numreceptor.gt.0 .and. (iout.eq.2 .or. iout.eq.3)  ) then
-    write(unitoutreceptppt) itime
-    do ks=1,nspec
-      write(unitoutreceptppt) (1.e12*creceptor(i,ks)/outnum* &
-           weightair/weightmolar(ks)/densityoutrecept(i),i=1,numreceptor)
-    end do
-  endif
-
-  ! Dump of receptor concentrations
-
-  if (numreceptor.gt.0) then
-    write(unitoutrecept) itime
-    do ks=1,nspec
-      write(unitoutrecept) (1.e12*creceptor(i,ks)/outnum, &
-           i=1,numreceptor)
-    end do
-  endif
-
-  ! RLT Aug 2017
-  ! Write out conversion factor for dry air
-  if (numreceptor.gt.0) then
-    inquire(file=path(2)(1:length(2))//'factor_dryreceptor',exist=lexist)
-     if (lexist) then
-     ! open and append
-      open(unitoutfactor,file=path(2)(1:length(2))//'factor_dryreceptor',form='unformatted',&
-              status='old',action='write',access='append')
-    else
-      ! create new
-      open(unitoutfactor,file=path(2)(1:length(2))//'factor_dryreceptor',form='unformatted',&
-              status='new',action='write')
-    endif
-    write(unitoutfactor) itime
-    write(unitoutfactor) (factor_dryrecept(i),i=1,numreceptor)
-    close(unitoutfactor)
-  endif
-
-  ! Reinitialization of grid
-  !*************************
-
-  do ks=1,nspec
-    do kp=1,maxpointspec_act
-      do i=1,numreceptor
-        creceptor(i,ks)=0.
-      end do
-      do jy=0,numygrid-1
-        do ix=0,numxgrid-1
-          do l=1,nclassunc
-            do nage=1,nageclass
-              do kz=1,numzgrid
-                gridunc(ix,jy,kz,ks,kp,l,nage)=0.
-              end do
-            end do
-          end do
-        end do
-      end do
-    end do
-  end do
-end subroutine concoutput_sfc
-
-subroutine concoutput_sfc_nest(itime,outnum)
-  !                        i     i
-  !*****************************************************************************
-  !                                                                            *
-  !     Output of the concentration grid and the receptor concentrations.      *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     24 May 1995                                                            *
-  !                                                                            *
-  !     13 April 1999, Major update: if output size is smaller, dump output    *
-  !                    in sparse matrix format; additional output of           *
-  !                    uncertainty                                             *
-  !                                                                            *
-  !     05 April 2000, Major update: output of age classes; output for backward*
-  !                    runs is time spent in grid cell times total mass of     *
-  !                    species.                                                *
-  !                                                                            *
-  !     17 February 2002, Appropriate dimensions for backward and forward runs *
-  !                       are now specified in file par_mod                    *
-  !                                                                            *
-  !     June 2006, write grid in sparse matrix with a single write command     *
-  !                in order to save disk space                                 *
-  !                                                                            *
-  !     2008 new sparse matrix format                                          *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! outnum          number of samples                                          *
-  ! ncells          number of cells with non-zero concentrations               *
-  ! sparse          .true. if in sparse matrix format, else .false.            *
-  ! tot_mu          1 for forward, initial mass mixing ration for backw. runs  *
-  !                                                                            *
-  !*****************************************************************************
-
-  use unc_mod
-  use mean_mod
-
-  implicit none
-
-  real(kind=dp) :: jul
-  integer :: itime,i,ix,jy,kz,ks,kp,l,iix,jjy,kzz,nage,jjjjmmdd,ihmmss
-  integer :: sp_count_i,sp_count_r
-  real :: sp_fact
-  real :: outnum,densityoutrecept(maxreceptor),xl,yl
-  ! RLT
-  real :: densitydryrecept(maxreceptor)
-  real :: factor_dryrecept(maxreceptor)
-
-  real(dep_prec) :: auxgrid(nclassunc)
-  real :: halfheight,dz,dz1,dz2,tot_mu(maxspec,maxpointspec_act)
-  real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
-  real,parameter :: weightair=28.97
-  logical :: sp_zer
-  character :: adate*8,atime*6
-  character(len=3) :: anspec
-  logical :: lexist
-
-  ! Determine current calendar date, needed for the file name
-  !**********************************************************
-
-  jul=bdate+real(itime,kind=dp)/86400._dp
-  call caldate(jul,jjjjmmdd,ihmmss)
-  write(adate,'(i8.8)') jjjjmmdd
-  write(atime,'(i6.6)') ihmmss
-
-
-  ! For forward simulations, output fields have dimension MAXSPEC,
-  ! for backward simulations, output fields have dimension MAXPOINT.
-  ! Thus, make loops either about nspec, or about numpoint
-  !*****************************************************************
-
-
-    if (ldirect.eq.1) then
-       do ks=1,nspec
-         do kp=1,maxpointspec_act
-           tot_mu(ks,kp)=1
-         end do
-       end do
-   else
-      do ks=1,nspec
-             do kp=1,maxpointspec_act
-               tot_mu(ks,kp)=xmass(kp,ks)
-             end do
-      end do
-    endif
-
-
-  !*******************************************************************
-  ! Compute air density: sufficiently accurate to take it
-  ! from coarse grid at some time
-  ! Determine center altitude of output layer, and interpolate density
-  ! data to that altitude
-  !*******************************************************************
-
-  do kz=1,numzgrid
-    if (kz.eq.1) then
-      halfheight=outheight(1)/2.
-    else
-      halfheight=(outheight(kz)+outheight(kz-1))/2.
-    endif
-    do kzz=2,nz
-      if ((height(kzz-1).lt.halfheight).and. &
-           (height(kzz).gt.halfheight)) goto 46
-    end do
-46   kzz=max(min(kzz,nz),2)
-    dz1=halfheight-height(kzz-1)
-    dz2=height(kzz)-halfheight
-    dz=dz1+dz2
-    do jy=0,numygridn-1
-      do ix=0,numxgridn-1
-        xl=outlon0n+real(ix)*dxoutn
-        yl=outlat0n+real(jy)*dyoutn
-        xl=(xl-xlon0)/dx
-        yl=(yl-ylat0)/dy
-        iix=max(min(nint(xl),nxmin1),0)
-        jjy=max(min(nint(yl),nymin1),0)
-        densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,2)*dz1+ &
-             rho(iix,jjy,kzz-1,2)*dz2)/dz
-  ! RLT
-        densitydrygrid(ix,jy,kz)=(rho_dry(iix,jjy,kzz,2)*dz1+ &
-             rho_dry(iix,jjy,kzz-1,2)*dz2)/dz
-      end do
-    end do
-  end do
-
-    do i=1,numreceptor
-      xl=xreceptor(i)
-      yl=yreceptor(i)
-      iix=max(min(nint(xl),nxmin1),0)
-      jjy=max(min(nint(yl),nymin1),0)
-      densityoutrecept(i)=rho(iix,jjy,1,2)
-  ! RLT
-    densitydryrecept(i)=rho_dry(iix,jjy,1,2)
-    end do
-
-  ! RLT
-  ! conversion factor for output relative to dry air
-  factor_drygrid=densityoutgrid/densitydrygrid
-  factor_dryrecept=densityoutrecept/densitydryrecept
-
-  ! Output is different for forward and backward simulations
-    do kz=1,numzgrid
-      do jy=0,numygridn-1
-        do ix=0,numxgridn-1
-          if (ldirect.eq.1) then
-            factor3d(ix,jy,kz)=1.e12/volumen(ix,jy,kz)/outnum
-          else
-            factor3d(ix,jy,kz)=real(abs(loutaver))/outnum
-          endif
-        end do
-      end do
-    end do
-
-  !*********************************************************************
-  ! Determine the standard deviation of the mean concentration or mixing
-  ! ratio (uncertainty of the output) and the dry and wet deposition
-  !*********************************************************************
-
-  do ks=1,nspec
-
-  write(anspec,'(i3.3)') ks
-  if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
-    if (ldirect.eq.1) then
-      open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_nest_' &
-           //adate// &
-           atime//'_'//anspec,form='unformatted')
-    else
-      open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_nest_' &
-           //adate// &
-           atime//'_'//anspec,form='unformatted')
-    endif
-     write(unitoutgrid) itime
-   endif
-
-  if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
-   open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_nest_' &
-        //adate// &
-        atime//'_'//anspec,form='unformatted')
-
-    write(unitoutgridppt) itime
-  endif
-
-  do kp=1,maxpointspec_act
-  do nage=1,nageclass
-
-    do jy=0,numygridn-1
-      do ix=0,numxgridn-1
-
-  ! WET DEPOSITION
-        if ((WETDEP).and.(ldirect.gt.0)) then
-            do l=1,nclassunc
-              auxgrid(l)=wetgriduncn(ix,jy,ks,kp,l,nage)
-            end do
-            call mean(auxgrid,wetgrid(ix,jy), &
-                 wetgridsigma(ix,jy),nclassunc)
-  ! Multiply by number of classes to get total concentration
-            wetgrid(ix,jy)=wetgrid(ix,jy) &
-                 *nclassunc
-  ! Calculate standard deviation of the mean
-            wetgridsigma(ix,jy)= &
-                 wetgridsigma(ix,jy)* &
-                 sqrt(real(nclassunc))
-        endif
-
-  ! DRY DEPOSITION
-        if ((DRYDEP).and.(ldirect.gt.0)) then
-            do l=1,nclassunc
-              auxgrid(l)=drygriduncn(ix,jy,ks,kp,l,nage)
-            end do
-            call mean(auxgrid,drygrid(ix,jy), &
-                 drygridsigma(ix,jy),nclassunc)
-  ! Multiply by number of classes to get total concentration
-            drygrid(ix,jy)=drygrid(ix,jy)* &
-                 nclassunc
-  ! Calculate standard deviation of the mean
-            drygridsigma(ix,jy)= &
-                 drygridsigma(ix,jy)* &
-                 sqrt(real(nclassunc))
-        endif
-
-  ! CONCENTRATION OR MIXING RATIO
-        do kz=1,numzgrid
-            do l=1,nclassunc
-              auxgrid(l)=griduncn(ix,jy,kz,ks,kp,l,nage)
-            end do
-            call mean(auxgrid,grid(ix,jy,kz), &
-                 gridsigma(ix,jy,kz),nclassunc)
-  ! Multiply by number of classes to get total concentration
-            grid(ix,jy,kz)= &
-                 grid(ix,jy,kz)*nclassunc
-  ! Calculate standard deviation of the mean
-            gridsigma(ix,jy,kz)= &
-                 gridsigma(ix,jy,kz)* &
-                 sqrt(real(nclassunc))
-        end do
-      end do
-    end do
-
-
-  !*******************************************************************
-  ! Generate output: may be in concentration (ng/m3) or in mixing
-  ! ratio (ppt) or both
-  ! Output the position and the values alternated multiplied by
-  ! 1 or -1, first line is number of values, number of positions
-  ! For backward simulations, the unit is seconds, stored in grid_time
-  !*******************************************************************
-
-  ! Concentration output
-  !*********************
-  if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
-
-  ! Wet deposition
-         sp_count_i=0
-         sp_count_r=0
-         sp_fact=-1.
-         sp_zer=.true.
-         if ((ldirect.eq.1).and.(WETDEP)) then
-         do jy=0,numygridn-1
-            do ix=0,numxgridn-1
-  !oncentraion greater zero
-              if (wetgrid(ix,jy).gt.smallnum) then
-                 if (sp_zer.eqv..true.) then ! first non zero value
-                    sp_count_i=sp_count_i+1
-                    sparse_dump_i(sp_count_i)=ix+jy*numxgridn
-                    sp_zer=.false.
-                    sp_fact=sp_fact*(-1.)
-                 endif
-                 sp_count_r=sp_count_r+1
-                 sparse_dump_r(sp_count_r)= &
-                      sp_fact*1.e12*wetgrid(ix,jy)/arean(ix,jy)
-                 sparse_dump_u(sp_count_r)= &
-                      1.e12*wetgridsigma(ix,jy)/area(ix,jy)
-              else ! concentration is zero
-                  sp_zer=.true.
-              endif
-            end do
-         end do
-         else
-            sp_count_i=0
-            sp_count_r=0
-         endif
-         write(unitoutgrid) sp_count_i
-         write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
-         write(unitoutgrid) sp_count_r
-         write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
-  ! Dry deposition
-         sp_count_i=0
-         sp_count_r=0
-         sp_fact=-1.
-         sp_zer=.true.
-         if ((ldirect.eq.1).and.(DRYDEP)) then
-          do jy=0,numygridn-1
-            do ix=0,numxgridn-1
-              if (drygrid(ix,jy).gt.smallnum) then
-                 if (sp_zer.eqv..true.) then ! first non zero value
-                    sp_count_i=sp_count_i+1
-                    sparse_dump_i(sp_count_i)=ix+jy*numxgridn
-                    sp_zer=.false.
-                    sp_fact=sp_fact*(-1.)
-                 endif
-                 sp_count_r=sp_count_r+1
-                 sparse_dump_r(sp_count_r)= &
-                      sp_fact* &
-                      1.e12*drygrid(ix,jy)/arean(ix,jy)
-                 sparse_dump_u(sp_count_r)= &
-                      1.e12*drygridsigma(ix,jy)/area(ix,jy)
-              else ! concentration is zero
-                  sp_zer=.true.
-              endif
-            end do
-          end do
-         else
-            sp_count_i=0
-            sp_count_r=0
-         endif
-         write(unitoutgrid) sp_count_i
-         write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
-         write(unitoutgrid) sp_count_r
-         write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
-
-  ! Concentrations
-
-  ! if surf_only write only 1st layer 
-
-         if(surf_only.eq.1) then
-         sp_count_i=0
-         sp_count_r=0
-         sp_fact=-1.
-         sp_zer=.true.
-          do kz=1,1
-            do jy=0,numygridn-1
-              do ix=0,numxgridn-1
-                if (grid(ix,jy,kz).gt.smallnum) then
-                  if (sp_zer.eqv..true.) then ! first non zero value
-                    sp_count_i=sp_count_i+1
-                    sparse_dump_i(sp_count_i)= &
-                         ix+jy*numxgridn+kz*numxgridn*numygridn
-                    sp_zer=.false.
-                    sp_fact=sp_fact*(-1.)
-                   endif
-                   sp_count_r=sp_count_r+1
-                   sparse_dump_r(sp_count_r)= &
-                        sp_fact* &
-                        grid(ix,jy,kz)* &
-                        factor3d(ix,jy,kz)/tot_mu(ks,kp)
-  !                 if ((factor(ix,jy,kz)/tot_mu(ks,kp)).eq.0)
-  !    +              write (*,*) factor(ix,jy,kz),tot_mu(ks,kp),ks,kp
-                   sparse_dump_u(sp_count_r)= &
-                        gridsigma(ix,jy,kz)* &
-                        factor3d(ix,jy,kz)/tot_mu(ks,kp)
-              else ! concentration is zero
-                  sp_zer=.true.
-              endif
-              end do
-            end do
-          end do
-         write(unitoutgrid) sp_count_i
-         write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
-         write(unitoutgrid) sp_count_r
-         write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
-         else
-
-  ! write full vertical resolution
-
-         sp_count_i=0
-         sp_count_r=0
-         sp_fact=-1.
-         sp_zer=.true.
-          do kz=1,numzgrid
-            do jy=0,numygridn-1
-              do ix=0,numxgridn-1
-                if (grid(ix,jy,kz).gt.smallnum) then
-                  if (sp_zer.eqv..true.) then ! first non zero value
-                    sp_count_i=sp_count_i+1
-                    sparse_dump_i(sp_count_i)= &
-                         ix+jy*numxgridn+kz*numxgridn*numygridn
-                    sp_zer=.false.
-                    sp_fact=sp_fact*(-1.)
-                   endif
-                   sp_count_r=sp_count_r+1
-                   sparse_dump_r(sp_count_r)= &
-                        sp_fact* &
-                        grid(ix,jy,kz)* &
-                        factor3d(ix,jy,kz)/tot_mu(ks,kp)
-                   sparse_dump_u(sp_count_r)= &
-                        gridsigma(ix,jy,kz)* &
-                        factor3d(ix,jy,kz)/tot_mu(ks,kp)
-              else ! concentration is zero
-                  sp_zer=.true.
-              endif
-              end do
-            end do
-          end do
-         write(unitoutgrid) sp_count_i
-         write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
-         write(unitoutgrid) sp_count_r
-         write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
-         endif ! surf_only
-
-
-    endif !  concentration output
-
-  ! Mixing ratio output
-  !********************
-
-  if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
-
-  ! Wet deposition
-         sp_count_i=0
-         sp_count_r=0
-         sp_fact=-1.
-         sp_zer=.true.
-         if ((ldirect.eq.1).and.(WETDEP)) then
-          do jy=0,numygridn-1
-            do ix=0,numxgridn-1
-                if (wetgrid(ix,jy).gt.smallnum) then
-                  if (sp_zer.eqv..true.) then ! first non zero value
-                    sp_count_i=sp_count_i+1
-                    sparse_dump_i(sp_count_i)= &
-                         ix+jy*numxgridn
-                    sp_zer=.false.
-                    sp_fact=sp_fact*(-1.)
-                 endif
-                 sp_count_r=sp_count_r+1
-                 sparse_dump_r(sp_count_r)= &
-                      sp_fact* &
-                      1.e12*wetgrid(ix,jy)/arean(ix,jy)
-                 sparse_dump_u(sp_count_r)= &
-                      1.e12*wetgridsigma(ix,jy)/area(ix,jy)
-              else ! concentration is zero
-                  sp_zer=.true.
-              endif
-            end do
-          end do
-         else
-           sp_count_i=0
-           sp_count_r=0
-         endif
-         write(unitoutgridppt) sp_count_i
-         write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
-         write(unitoutgridppt) sp_count_r
-         write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
-
-  ! Dry deposition
-         sp_count_i=0
-         sp_count_r=0
-         sp_fact=-1.
-         sp_zer=.true.
-         if ((ldirect.eq.1).and.(DRYDEP)) then
-          do jy=0,numygridn-1
-            do ix=0,numxgridn-1
-                if (drygrid(ix,jy).gt.smallnum) then
-                  if (sp_zer.eqv..true.) then ! first non zero value
-                    sp_count_i=sp_count_i+1
-                    sparse_dump_i(sp_count_i)= &
-                         ix+jy*numxgridn
-                    sp_zer=.false.
-                    sp_fact=sp_fact*(-1)
-                 endif
-                 sp_count_r=sp_count_r+1
-                 sparse_dump_r(sp_count_r)= &
-                      sp_fact* &
-                      1.e12*drygrid(ix,jy)/arean(ix,jy)
-                 sparse_dump_u(sp_count_r)= &
-                      1.e12*drygridsigma(ix,jy)/area(ix,jy)
-              else ! concentration is zero
-                  sp_zer=.true.
-              endif
-            end do
-          end do
-         else
-           sp_count_i=0
-           sp_count_r=0
-         endif
-         write(unitoutgridppt) sp_count_i
-         write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
-         write(unitoutgridppt) sp_count_r
-         write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
-
-  ! Mixing ratios
-
-    ! if surf_only write only 1st layer 
-
-         if(surf_only.eq.1) then
-         sp_count_i=0
-         sp_count_r=0
-         sp_fact=-1.
-         sp_zer=.true.
-          do kz=1,1
-            do jy=0,numygridn-1
-              do ix=0,numxgridn-1
-                if (grid(ix,jy,kz).gt.smallnum) then
-                  if (sp_zer.eqv..true.) then ! first non zero value
-                    sp_count_i=sp_count_i+1
-                    sparse_dump_i(sp_count_i)= &
-                         ix+jy*numxgridn+kz*numxgridn*numygridn
-                    sp_zer=.false.
-                    sp_fact=sp_fact*(-1.)
-                 endif
-                 sp_count_r=sp_count_r+1
-                 sparse_dump_r(sp_count_r)= &
-                      sp_fact* &
-                      1.e12*grid(ix,jy,kz) &
-                      /volumen(ix,jy,kz)/outnum* &
-                      weightair/weightmolar(ks)/densityoutgrid(ix,jy,kz)
-                 sparse_dump_u(sp_count_r)= &
-                      1.e12*gridsigma(ix,jy,kz)/volumen(ix,jy,kz)/ &
-                      outnum*weightair/weightmolar(ks)/ &
-                      densityoutgrid(ix,jy,kz)
-              else ! concentration is zero
-                  sp_zer=.true.
-              endif
-              end do
-            end do
-          end do
-         write(unitoutgridppt) sp_count_i
-         write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
-         write(unitoutgridppt) sp_count_r
-         write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
-         else
-
-  ! write full vertical resolution
-
-         sp_count_i=0
-         sp_count_r=0
-         sp_fact=-1.
-         sp_zer=.true.
-          do kz=1,numzgrid
-            do jy=0,numygridn-1
-              do ix=0,numxgridn-1
-                if (grid(ix,jy,kz).gt.smallnum) then
-                  if (sp_zer.eqv..true.) then ! first non zero value
-                    sp_count_i=sp_count_i+1
-                    sparse_dump_i(sp_count_i)= &
-                         ix+jy*numxgridn+kz*numxgridn*numygridn
-                    sp_zer=.false.
-                    sp_fact=sp_fact*(-1.)
-                 endif
-                 sp_count_r=sp_count_r+1
-                 sparse_dump_r(sp_count_r)= &
-                      sp_fact* &
-                      1.e12*grid(ix,jy,kz) &
-                      /volumen(ix,jy,kz)/outnum* &
-                      weightair/weightmolar(ks)/densityoutgrid(ix,jy,kz)
-                 sparse_dump_u(sp_count_r)= &
-                      1.e12*gridsigma(ix,jy,kz)/volumen(ix,jy,kz)/ &
-                      outnum*weightair/weightmolar(ks)/ &
-                      densityoutgrid(ix,jy,kz)
-              else ! concentration is zero
-                  sp_zer=.true.
-              endif
-              end do
-            end do
-          end do
-         write(unitoutgridppt) sp_count_i
-         write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
-         write(unitoutgridppt) sp_count_r
-         write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
-         endif ! surf_only
-
-      endif ! output for ppt
-
-  end do
-  end do
-
-    close(unitoutgridppt)
-    close(unitoutgrid)
-
-  end do
-
-  ! RLT Aug 2017
-  ! Write out conversion factor for dry air
-  inquire(file=path(2)(1:length(2))//'factor_drygrid_nest',exist=lexist)
-  if (lexist) then
-    ! open and append
-    open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid_nest',form='unformatted',&
-            status='old',action='write',access='append')
-  else
-    ! create new
-    open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid_nest',form='unformatted',&
-            status='new',action='write')
-  endif
-  sp_count_i=0
-  sp_count_r=0
-  sp_fact=-1.
-  sp_zer=.true.
-  do kz=1,1
-    do jy=0,numygridn-1
-      do ix=0,numxgridn-1
-        if (factor_drygrid(ix,jy,kz).gt.(1.+smallnum).or.factor_drygrid(ix,jy,kz).lt.(1.-smallnum)) then
-          if (sp_zer.eqv..true.) then ! first value not equal to one
-            sp_count_i=sp_count_i+1
-            sparse_dump_i(sp_count_i)= &
-                  ix+jy*numxgridn+kz*numxgridn*numygridn
-            sp_zer=.false.
-            sp_fact=sp_fact*(-1.)
-          endif
-          sp_count_r=sp_count_r+1
-          sparse_dump_r(sp_count_r)= &
-               sp_fact*factor_drygrid(ix,jy,kz)
-        else ! factor is one
-          sp_zer=.true.
-        endif
-      end do
-    end do
-  end do
-  write(unitoutfactor) sp_count_i
-  write(unitoutfactor) (sparse_dump_i(i),i=1,sp_count_i)
-  write(unitoutfactor) sp_count_r
-  write(unitoutfactor) (sparse_dump_r(i),i=1,sp_count_r)
-  close(unitoutfactor)
-
-
-
-  ! Reinitialization of grid
-  !*************************
-
-  do ks=1,nspec
-  do kp=1,maxpointspec_act
-    do i=1,numreceptor
-      creceptor(i,ks)=0.
-    end do
-    do jy=0,numygridn-1
-      do ix=0,numxgridn-1
-        do l=1,nclassunc
-          do nage=1,nageclass
-            do kz=1,numzgrid
-              griduncn(ix,jy,kz,ks,kp,l,nage)=0.
-            end do
-          end do
-        end do
-      end do
-    end do
-  end do
-  end do
-end subroutine concoutput_sfc_nest
-
-subroutine initcond_output(itime)
-  !                                 i
-  !*****************************************************************************
-  !                                                                            *
-  !     Output of the initial condition sensitivity field.                     *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     24 May 1995                                                            *
-  !                                                                            *
-  !     13 April 1999, Major update: if output size is smaller, dump output    *
-  !                    in sparse matrix format; additional output of           *
-  !                    uncertainty                                             *
-  !                                                                            *
-  !     05 April 2000, Major update: output of age classes; output for backward*
-  !                    runs is time spent in grid cell times total mass of     *
-  !                    species.                                                *
-  !                                                                            *
-  !     17 February 2002, Appropriate dimensions for backward and forward runs *
-  !                       are now specified in file par_mod                    *
-  !                                                                            *
-  !     June 2006, write grid in sparse matrix with a single write command     *
-  !                in order to save disk space                                 *
-  !                                                                            *
-  !     2008 new sparse matrix format                                          *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! ncells          number of cells with non-zero concentrations               *
-  ! sparse          .true. if in sparse matrix format, else .false.            *
-  !                                                                            *
-  !*****************************************************************************
-
-  use unc_mod
-
-  implicit none
-
-  integer :: itime,i,ix,jy,kz,ks,kp,sp_count_i,sp_count_r
-  real :: sp_fact,fact_recept
-  real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
-  logical :: sp_zer
-  character(len=3) :: anspec
-
-
-  !*********************************************************************
-  ! Determine the standard deviation of the mean concentration or mixing
-  ! ratio (uncertainty of the output) and the dry and wet deposition
-  !*********************************************************************
-
-  do ks=1,nspec
-
-    write(anspec,'(i3.3)') ks
-    open(97,file=path(2)(1:length(2))//'grid_initial'// &
-         '_'//anspec,form='unformatted')
-    write(97) itime
-
-    do kp=1,maxpointspec_act
-
-      if (ind_rel.eq.1) then
-        fact_recept=rho_rel(kp)
-      else
-        fact_recept=1.
-      endif
-
-  !*******************************************************************
-  ! Generate output: may be in concentration (ng/m3) or in mixing
-  ! ratio (ppt) or both
-  ! Output the position and the values alternated multiplied by
-  ! 1 or -1, first line is number of values, number of positions
-  ! For backward simulations, the unit is seconds, stored in grid_time
-  !*******************************************************************
-
-  ! Write out dummy "wet and dry deposition" fields, to keep same format
-  ! as for concentration output
-      sp_count_i=0
-      sp_count_r=0
-      write(97) sp_count_i
-      write(97) (sparse_dump_i(i),i=1,sp_count_i)
-      write(97) sp_count_r
-      write(97) (sparse_dump_r(i),i=1,sp_count_r)
-      write(97) sp_count_i
-      write(97) (sparse_dump_i(i),i=1,sp_count_i)
-      write(97) sp_count_r
-      write(97) (sparse_dump_r(i),i=1,sp_count_r)
-
-
-  ! Write out sensitivity to initial conditions
-      sp_count_i=0
-      sp_count_r=0
-      sp_fact=-1.
-      sp_zer=.true.
-      do kz=1,numzgrid
-        do jy=0,numygrid-1
-          do ix=0,numxgrid-1
-            if (init_cond(ix,jy,kz,ks,kp).gt.smallnum) then
-              if (sp_zer.eqv..true.) then ! first non zero value
-                sp_count_i=sp_count_i+1
-                sparse_dump_i(sp_count_i)= &
-                     ix+jy*numxgrid+kz*numxgrid*numygrid
-                sp_zer=.false.
-                sp_fact=sp_fact*(-1.)
-              endif
-              sp_count_r=sp_count_r+1
-              sparse_dump_r(sp_count_r)=sp_fact* &
-                   init_cond(ix,jy,kz,ks,kp)/xmass(kp,ks)*fact_recept
-            else ! concentration is zero
-              sp_zer=.true.
-            endif
-          end do
-        end do
-      end do
-      write(97) sp_count_i
-      write(97) (sparse_dump_i(i),i=1,sp_count_i)
-      write(97) sp_count_r
-      write(97) (sparse_dump_r(i),i=1,sp_count_r)
-
-
-    end do
-
-    close(97)
-
-  end do
-end subroutine initcond_output
-
-subroutine initcond_output_inv(itime)
-  !                                 i
-  !*****************************************************************************
-  !                                                                            *
-  !     Output of the initial condition sensitivity field.                     *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     24 May 1995                                                            *
-  !                                                                            *
-  !     13 April 1999, Major update: if output size is smaller, dump output    *
-  !                    in sparse matrix format; additional output of           *
-  !                    uncertainty                                             *
-  !                                                                            *
-  !     05 April 2000, Major update: output of age classes; output for backward*
-  !                    runs is time spent in grid cell times total mass of     *
-  !                    species.                                                *
-  !                                                                            *
-  !     17 February 2002, Appropriate dimensions for backward and forward runs *
-  !                       are now specified in file par_mod                    *
-  !                                                                            *
-  !     June 2006, write grid in sparse matrix with a single write command     *
-  !                in order to save disk space                                 *
-  !                                                                            *
-  !     2008 new sparse matrix format                                          *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! ncells          number of cells with non-zero concentrations               *
-  ! sparse          .true. if in sparse matrix format, else .false.            *
-  !                                                                            *
-  !*****************************************************************************
-
-  use unc_mod
-
-  implicit none
-
-  integer :: itime,i,ix,jy,kz,ks,kp,sp_count_i,sp_count_r
-  integer :: jjjjmmdd, ihmmss
-  real(kind=dp) :: jul
-  real :: sp_fact,fact_recept
-  real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
-  logical :: sp_zer,lexist
-  logical,save :: listart=.true.
-  logical,save,allocatable,dimension(:) :: listartrel
-  character :: adate*8,atime*6
-  character :: areldate*8,areltime*6
-  character(len=3) :: anspec
-
-  if(listart) then
-    allocate(listartrel(maxpointspec_act))
-    listartrel(:)=.true.
-  endif
-  print*, 'listartrel = ',listartrel
-
-  !*********************************************************************
-  ! Determine the standard deviation of the mean concentration or mixing
-  ! ratio (uncertainty of the output) and the dry and wet deposition
-  !*********************************************************************
-
-  do ks=1,nspec
-
-    write(anspec,'(i3.3)') ks
+#include "bin_writeheader_bin.f90"
 
-    do kp=1,maxpointspec_act
+#include "bin_writeheader_bin_nest.f90"
 
-      ! calculate date of release
-      jul=bdate+real(ireleasestart(kp),kind=dp)/86400._dp    ! this is the current day
-      call caldate(jul,jjjjmmdd,ihmmss)
-      write(areldate,'(i8.8)') jjjjmmdd
-      write(areltime,'(i6.6)') ihmmss
-      print*, areldate//areltime
+#include "bin_writeheader_bin_sfc_nest.f90"
 
-      ! calculate date of field
-      jul=bdate+real(itime,kind=dp)/86400._dp
-      call caldate(jul,jjjjmmdd,ihmmss)
-      write(adate,'(i8.8)') jjjjmmdd
-      write(atime,'(i6.6)') ihmmss
-      print*, adate//atime
+#include "bin_writeheader_bin_sfc.f90"
 
-      inquire(file=path(2)(1:length(2))//'grid_initial_'//areldate// &
-         areltime//'_'//anspec,exist=lexist)
-      if(lexist.and..not.listartrel(kp)) then
-        ! open and append to existing file
-        open(97,file=path(2)(1:length(2))//'grid_initial_'//areldate// &
-             areltime//'_'//anspec,form='unformatted',status='old',action='write',access='append') 
-      else
-        ! open new file
-        open(97,file=path(2)(1:length(2))//'grid_initial_'//areldate// &
-             areltime//'_'//anspec,form='unformatted',status='replace',action='write')
-      endif
-      write(97) jjjjmmdd
-      write(97) ihmmss
+#include "bin_openreceptors.f90"
 
-      listartrel(kp)=.false.
 
-      if (ind_rel.eq.1) then
-        fact_recept=rho_rel(kp)
-      else
-        fact_recept=1.
-      endif
+#include "bin_concoutput.f90"
 
-  !*******************************************************************
-  ! Generate output: may be in concentration (ng/m3) or in mixing
-  ! ratio (ppt) or both
-  ! Output the position and the values alternated multiplied by
-  ! 1 or -1, first line is number of values, number of positions
-  ! For backward simulations, the unit is seconds, stored in grid_time
-  !*******************************************************************
+#include "bin_concoutput_nest.f90"
 
-  ! Write out dummy "wet and dry deposition" fields, to keep same format
-  ! as for concentration output
+#include "bin_concoutput_inv.f90"
 
-  ! Write out sensitivity to initial conditions
-      sp_count_i=0
-      sp_count_r=0
-      sp_fact=-1.
-      sp_zer=.true.
-      do kz=1,numzgrid
-        do jy=0,numygrid-1
-          do ix=0,numxgrid-1
-            if (init_cond(ix,jy,kz,ks,kp).gt.smallnum) then
-              if (sp_zer.eqv..true.) then ! first non zero value
-                sp_count_i=sp_count_i+1
-                sparse_dump_i(sp_count_i)= &
-                     ix+jy*numxgrid+kz*numxgrid*numygrid
-                sp_zer=.false.
-                sp_fact=sp_fact*(-1.)
-              endif
-              sp_count_r=sp_count_r+1
-              sparse_dump_r(sp_count_r)=sp_fact* &
-                   init_cond(ix,jy,kz,ks,kp)/xmass(kp,ks)*fact_recept
-            else ! concentration is zero
-              sp_zer=.true.
-            endif
-          end do
-        end do
-      end do
-      write(97) sp_count_i
-      write(97) (sparse_dump_i(i),i=1,sp_count_i)
-      write(97) sp_count_r
-      write(97) (sparse_dump_r(i),i=1,sp_count_r)
+#include "bin_concoutput_inv_nest.f90"
 
-      close(97)
+#include "bin_concoutput_sfc.f90"
 
-    end do
+#include "bin_concoutput_sfc_nest.f90"
 
-  end do
+#include "bin_initcond_output.f90"
 
-  ! reset listart
-  if (listart) then
-    listart=.false.
-  endif
-end subroutine initcond_output_inv
+#include "bin_initcond_output_inv.f90"
 
 end module binary_output_mod
diff --git a/src/cbl_cbl.f90 b/src/cbl_cbl.f90
new file mode 100644
index 0000000000000000000000000000000000000000..55a8b25b79b081cc616d17379d366ad201f9c378
--- /dev/null
+++ b/src/cbl_cbl.f90
@@ -0,0 +1,216 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine cbl(wp,zp,ust,wst,h,rhoa,rhograd,sigmaw,dsigmawdz,tlw,ptot,Q,phi,ath,bth,ol,flagrein)
+!                i  i i  i   i  i    i     i       i         i   o   o   o   o    o  i    o
+
+    use par_mod, only:pi
+    use com_mod, only:ldirect
+
+    implicit none
+
+!*******************************************************************************
+! CBL skewed vertical profiles and formulation of LHH 1996 with profile of w^3
+! from LHB 2000
+! LHH formulation has been modified to account for variable density profiles
+! and backward in time or forward in time simulations
+! see Cassiani et al. BLM 2014 doi  for explanations and references
+!*******************************************************************************
+
+    real :: usurad2,usurad2p,C0,costluar4,eps
+    parameter  (usurad2=0.7071067812,usurad2p=0.3989422804,C0=3,costluar4=0.66667,eps=0.000001)
+
+
+    integer :: flagrein
+    real :: wp,zp,ust,wst,h,dens,ddens,sigmaw,dsigmawdz,tlw,rhoa,rhograd
+    real ::fluarw,fluarw2
+    real ::w3,w2
+    real ::dw3,dw2
+    real ::wb,wa
+    real ::deltawa,deltawb
+    real ::wold,wold2,wold_z
+    real ::pa,pb,alfa
+    real ::Phi,Q,ptot
+    real :: timedir
+    real ::z0,ol,transition
+
+
+    real :: &
+    erf, &
+    aperfa, &
+    aperfb, &
+    ath, &
+    bth
+
+    real ::  &
+    pow, &
+    z, &
+    skew, &
+    skew2, &
+    radw2, &
+    rluarw, &
+    xluarw, &
+    aluarw, &
+    bluarw, &
+    sigmawa, &
+    sigmawb, &
+    dskew, &
+    dradw2, &
+    dfluarw, &
+    drluarw, &
+    dxluarw, &
+    daluarw, &
+    dbluarw, &
+    dsigmawa, &
+    dsigmawb, &
+    dwa, &
+    dwb, &
+    sigmawa2, &
+    sigmawb2
+
+
+    dens=rhoa      !put to 1 for test constant density simulation
+    ddens=rhograd  !put to 0 for test constant density simulation
+
+
+    timedir=ldirect !ldirect contains direction of time forward (1) or backward(-1)
+    ! assegnazione z
+    z=(zp/h)
+
+    ! stability transition function see Cassiani et al(2015) BLM
+    transition=1.
+    !if (ol.lt.-50) transition=((sin(((ol+100.)/100.)*pi))-1.)/2.
+    if (-h/ol.lt.15) transition=((sin((((-h/ol)+10.)/10.)*pi)))/2.+0.5
+
+    ! momento secondo
+
+    w2=(sigmaw*sigmaw)
+    dw2=(2.*sigmaw*dsigmawdz)
+
+
+    !=================== dissipazione =======================================
+
+    alfa=2.*w2/(C0*tlw)
+
+    !========================================================================
+
+    wold=timedir*wp
+
+    !=========================================================================
+    !------------------------------ momento terzo ============================
+
+    w3=((1.2*z*((1.-z)**(3./2.)))+eps)*(wst**3)*transition
+    dw3=(1.2*(((1.-z)**(3./2.))+z*1.5*((1.-z)**(1./2.))*(-1.)))*(wst**3)*(1./h)*transition
+
+!===========================================================================0
+
+    skew=w3/(w2**1.5)
+    skew2=skew*skew
+    dskew=(dw3*w2**(1.5)-w3*1.5*w2**0.5*dw2)/w2**3
+    radw2=w2**0.5
+    dradw2=0.5*w2**(-0.5)*dw2
+    !costluar4=0.66667  ! costante da LHH
+    fluarw=costluar4*(cuberoot(skew))   !skew**(1./3.)
+    fluarw2=fluarw*fluarw
+
+    if (skew.ne.0) then
+
+        dfluarw=costluar4*(1./3.)*cuberoot(skew**(-2.))*dskew
+
+        rluarw=(1.+fluarw2)**3.*skew2/((3.+fluarw2)**2.*fluarw2)  !-> r
+        xluarw=(1.+fluarw2)**1.5*skew/((3.+fluarw2)*fluarw)    !----> r^1/2
+
+        drluarw=( ((3.*(1.+fluarw2)**2*(2.*fluarw*dfluarw)*skew2)+ &
+            (1.+fluarw2)**3*2.*skew*dskew) *(3.+fluarw2)**2.*fluarw2 - &
+            (1.+fluarw2)**3*skew2* &
+            ( (2.*(3.+fluarw2)*(2.*fluarw*dfluarw)*fluarw2) + &
+            (3.+fluarw2)**2*2.*fluarw*dfluarw) )/ &
+            (((3.+fluarw2)**2.*fluarw2)**2)
+
+        dxluarw=( ((1.5*(1.+fluarw2)**0.5*(2.*fluarw*dfluarw)*skew)+ &
+            (1.+fluarw2)**1.5*dskew) *(3.+fluarw2)*fluarw - &
+            (1.+fluarw2)**1.5*skew* &
+            (3.*dfluarw+3*fluarw2*dfluarw) )/ &
+            (((3.+fluarw2)*fluarw)**2)
+
+    else
+        dfluarw=0.
+        rluarw=0.
+        drluarw=0.
+        xluarw=0.
+        dxluarw=0.
+    end if
+
+
+
+   aluarw=0.5*(1.-xluarw/(4.+rluarw)**0.5)
+   bluarw=1.-aluarw
+
+   daluarw=-0.5*(  (dxluarw*(4.+rluarw)**0.5) - &
+           (0.5*xluarw*(4.+rluarw)**(-0.5)*drluarw) ) &
+           /(4.+rluarw)
+   dbluarw=-daluarw
+
+   sigmawa=radw2*(bluarw/(aluarw*(1.+fluarw2)))**0.5
+   sigmawb=radw2*(aluarw/(bluarw*(1.+fluarw2)))**0.5
+
+   dsigmawa=dradw2*(bluarw/(aluarw*(1.+fluarw2)))**0.5+ &
+            radw2*( &
+            (0.5*(bluarw/(aluarw*(1.+fluarw2)))**(-0.5))      * &
+            ( &
+            (dbluarw*(aluarw*(1.+fluarw2))- &
+            bluarw*(daluarw*(1.+fluarw2)+aluarw*2.*fluarw*dfluarw)) &
+            /((aluarw*(1.+fluarw2))**2) &
+            ) &
+            )
+  dsigmawb=dradw2*(aluarw/(bluarw*(1.+fluarw2)))**0.5+ &
+           radw2*( &
+           (0.5*(aluarw/(bluarw*(1.+fluarw2)))**(-0.5))      * &
+           ( &
+           (daluarw*(bluarw*(1.+fluarw2))- &
+           aluarw*(dbluarw*(1.+fluarw2)+bluarw*2.*fluarw*dfluarw)) &
+           /((bluarw*(1.+fluarw2))**2) &
+           ) &
+           )
+
+           wa=(fluarw*sigmawa)
+           wb=(fluarw*sigmawb)
+           dwa=dfluarw*sigmawa+fluarw*dsigmawa
+           dwb=dfluarw*sigmawb+fluarw*dsigmawb
+
+           deltawa=wold-wa
+           deltawb=wold+wb
+           wold2=wold*wold
+           sigmawa2=sigmawa*sigmawa
+           sigmawb2=sigmawb*sigmawb
+
+           if (abs(deltawa).gt.6.*sigmawa.and.abs(deltawb).gt.6.*sigmawb) flagrein=1
+
+           pa=(usurad2p*(1./sigmawa))*(exp(-(0.5*((deltawa/sigmawa)**2.))))
+           pb=(usurad2p*(1./sigmawb))*(exp(-(0.5*((deltawb/sigmawb)**2.))))
+
+           ptot=dens*aluarw*pa+dens*bluarw*pb
+
+           aperfa=deltawa*usurad2/sigmawa
+           aperfb=deltawb*usurad2/sigmawb
+
+           Phi=-0.5* &
+               (aluarw*dens*dwa+dens*wa*daluarw+aluarw*wa*ddens)*erf(aperfa) &
+               +sigmawa*(aluarw*dens*dsigmawa*(wold2/sigmawa2+1.)+ &
+               sigmawa*dens*daluarw+sigmawa*ddens*aluarw+ &
+               aluarw*wold*dens/sigmawa2*(sigmawa*dwa-wa*dsigmawa))*pa &
+               +0.5* &
+               (bluarw*dens*dwb+wb*dens*dbluarw+wb*bluarw*ddens)*erf(aperfb) &
+               +sigmawb*(bluarw*dens*dsigmawb*(wold2/sigmawb2+1.)+ &
+               sigmawb*dens*dbluarw+sigmawb*ddens*bluarw+ &
+               bluarw*wold*dens/sigmawb2*(-sigmawb*dwb+wb*dsigmawb))*pb
+
+               Q=timedir*((aluarw*dens*deltawa/sigmawa2)*pa+ &
+               (bluarw*dens*deltawb/sigmawb2)*pb)
+
+               ath=(1./ptot)*(-(C0/2.)*alfa*Q+phi)
+               bth=sqrt(C0*alfa)
+              !bth=sngl(sigmaw*sqrt(2.*tlw))
+
+    return
+end subroutine cbl
diff --git a/src/cbl_cuberoot.f90 b/src/cbl_cuberoot.f90
new file mode 100644
index 0000000000000000000000000000000000000000..8593e590f23d5de0cff06455697782ae38aeddbc
--- /dev/null
+++ b/src/cbl_cuberoot.f90
@@ -0,0 +1,13 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+function cuberoot(x) result(y)
+
+    implicit none
+
+    real, intent(in) :: x
+    real :: y
+    real, parameter :: third=0.333333333
+
+    y=sign((abs(x))**third,x)
+end function cuberoot
diff --git a/src/cbl_init_cbl_vel.f90 b/src/cbl_init_cbl_vel.f90
new file mode 100644
index 0000000000000000000000000000000000000000..069c71f56688c63f5d601878cea8aac210d0d1cd
--- /dev/null
+++ b/src/cbl_init_cbl_vel.f90
@@ -0,0 +1,86 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine init_cbl_vel(idum,zp,ust,wst,h,sigmaw,wp,ol,ithread)
+  !                              i/o   i  i   i  i     i  o   i
+
+  use par_mod, only:pi
+  use com_mod, only:ldirect
+  use random_mod, only: gasdev, ran3
+
+  implicit none
+  !===============================================================================
+  ! CBL skewed vertical profiles and formulation of LHH 1996 with profile of w3
+  ! from LHB 2000
+  ! LHH formulation has been modified to account for variable density profiles and
+  ! backward in time or forward in time simulations
+  ! see Cassiani et al. BLM 2014 doi  for explanations and references
+  !===============================================================================
+
+  integer,intent(in) :: ithread
+  real :: usurad2,usurad2p,C0,costluar4,eps
+  parameter  (usurad2=0.7071067812,usurad2p=0.3989422804,C0=2,costluar4=0.66667,eps=0.000001)
+
+
+  real :: wp,zp,ust,wst,h,dens,ddens,sigmaw,dsigmawdz,tlw,dcas,dcas1!,ran3,gasdev
+  real :: w3,w2
+  real ::  z, &
+       skew, &
+       skew2, &
+       radw2, &
+       fluarw,fluarw2, &
+       rluarw, &
+       xluarw, &
+       aluarw, &
+       bluarw, &
+       sigmawa, &
+       sigmawb, &
+       ath, &
+       bth, &
+       wb,wa
+  real timedir
+  real ol, transition
+  integer :: idum
+
+  !---------------------------------------------------------------------------
+  timedir=ldirect !direction of time forward (1) or backward(-1)
+  z=zp/h
+
+
+  transition=1.
+  if (-h/ol.lt.15) transition=((sin((((-h/ol)+10.)/10.)*pi)))/2.+0.5  !see also in cbl.f90
+
+  w2=sigmaw*sigmaw
+  w3=(((1.2*z*((1.-z)**(3./2.)))+eps)*wst**3) *transition
+
+  skew=w3/(w2**1.5)
+  skew2=skew*skew
+
+  radw2=sqrt(w2) !sigmaw
+
+  fluarw=costluar4*skew**0.333333333333333
+  fluarw2=fluarw*fluarw
+  rluarw=(1.+fluarw2)**3.*skew2/((3.+fluarw2)**2.*fluarw2)  !-> r
+  xluarw=rluarw**0.5 !----> r^1/2
+
+  aluarw=0.5*(1.-xluarw/(4.+rluarw)**0.5)
+  bluarw=1.-aluarw
+
+  sigmawa=radw2*(bluarw/(aluarw*(1.+fluarw2)))**0.5
+  sigmawb=radw2*(aluarw/(bluarw*(1.+fluarw2)))**0.5
+
+  wa=(fluarw*sigmawa)
+  wb=(fluarw*sigmawb)
+
+  dcas=ran3(idum,ithread)
+
+  if (dcas.le.aluarw) then
+    dcas1=gasdev(idum,ithread)
+    wp=timedir*(dcas1*sigmawa+wa)
+  else
+    dcas1=gasdev(idum,ithread)
+    wp=timedir*(dcas1*sigmawb-wb)
+  end if
+
+  return
+end subroutine init_cbl_vel
diff --git a/src/cbl_mod.f90 b/src/cbl_mod.f90
index a618437bcfc5c636382c82eb901458a945f43323..0594ede740dacdc72b3ccb4bce850983bfa35176 100644
--- a/src/cbl_mod.f90
+++ b/src/cbl_mod.f90
@@ -1,419 +1,21 @@
 ! SPDX-FileCopyrightText: FLEXPART 1998-2019, see flexpart_license.txt
 ! SPDX-License-Identifier: GPL-3.0-or-later
 module cbl_mod
-    
+
     implicit none
 
     private :: cuberoot
 
     public :: cbl,reinit_particle,init_cbl_vel
-    
-contains
-
-subroutine cbl(wp,zp,ust,wst,h,rhoa,rhograd,sigmaw,dsigmawdz,tlw,ptot,Q,phi,ath,bth,ol,flagrein)
-!                i  i i  i   i  i    i     i       i         i   o   o   o   o    o  i    o
-     
-    use par_mod, only:pi
-    use com_mod, only:ldirect
-    
-    implicit none
-
-!*******************************************************************************
-! CBL skewed vertical profiles and formulation of LHH 1996 with profile of w^3
-! from LHB 2000 
-! LHH formulation has been modified to account for variable density profiles 
-! and backward in time or forward in time simulations 
-! see Cassiani et al. BLM 2014 doi  for explanations and references  
-!*******************************************************************************
-
-    real :: usurad2,usurad2p,C0,costluar4,eps 
-    parameter  (usurad2=0.7071067812,usurad2p=0.3989422804,C0=3,costluar4=0.66667,eps=0.000001)
-
-       
-    integer :: flagrein
-    real :: wp,zp,ust,wst,h,dens,ddens,sigmaw,dsigmawdz,tlw,rhoa,rhograd
-    real ::fluarw,fluarw2
-    real ::w3,w2
-    real ::dw3,dw2
-    real ::wb,wa
-    real ::deltawa,deltawb
-    real ::wold,wold2,wold_z
-    real ::pa,pb,alfa
-    real ::Phi,Q,ptot  
-    real :: timedir
-    real ::z0,ol,transition   
-    
-
-    real :: &
-    erf, &
-    aperfa, &
-    aperfb, &
-    ath, &
-    bth
-
-    real ::  &
-    pow, &
-    z, &    
-    skew, &
-    skew2, &
-    radw2, &
-    rluarw, &
-    xluarw, &
-    aluarw, &
-    bluarw, &
-    sigmawa, &
-    sigmawb, &
-    dskew, &
-    dradw2, &
-    dfluarw, &
-    drluarw, &
-    dxluarw, &
-    daluarw, &
-    dbluarw, &
-    dsigmawa, &
-    dsigmawb, &
-    dwa, &
-    dwb, &
-    sigmawa2, &
-    sigmawb2
-    
-    
-    dens=rhoa      !put to 1 for test constant density simulation
-    ddens=rhograd  !put to 0 for test constant density simulation
-             
-    
-    timedir=ldirect !ldirect contains direction of time forward (1) or backward(-1)
-    ! assegnazione z 
-    z=(zp/h)
-    
-    ! stability transition function see Cassiani et al(2015) BLM
-    transition=1.
-    !if (ol.lt.-50) transition=((sin(((ol+100.)/100.)*pi))-1.)/2.
-    if (-h/ol.lt.15) transition=((sin((((-h/ol)+10.)/10.)*pi)))/2.+0.5
-
-    ! momento secondo 
-    
-    w2=(sigmaw*sigmaw)
-    dw2=(2.*sigmaw*dsigmawdz)
-    
-
-    !=================== dissipazione =======================================
-    
-    alfa=2.*w2/(C0*tlw)
-
-    !========================================================================
-    
-    wold=timedir*wp
-    
-    !=========================================================================
-    !------------------------------ momento terzo ============================
-                                
-    w3=((1.2*z*((1.-z)**(3./2.)))+eps)*(wst**3)*transition
-    dw3=(1.2*(((1.-z)**(3./2.))+z*1.5*((1.-z)**(1./2.))*(-1.)))*(wst**3)*(1./h)*transition
-
-!===========================================================================0
-   
-    skew=w3/(w2**1.5)
-    skew2=skew*skew
-    dskew=(dw3*w2**(1.5)-w3*1.5*w2**0.5*dw2)/w2**3
-    radw2=w2**0.5
-    dradw2=0.5*w2**(-0.5)*dw2
-    !costluar4=0.66667  ! costante da LHH
-    fluarw=costluar4*(cuberoot(skew))   !skew**(1./3.)
-    fluarw2=fluarw*fluarw
-    
-    if (skew.ne.0) then
-      
-        dfluarw=costluar4*(1./3.)*cuberoot(skew**(-2.))*dskew
-    
-        rluarw=(1.+fluarw2)**3.*skew2/((3.+fluarw2)**2.*fluarw2)  !-> r
-        xluarw=(1.+fluarw2)**1.5*skew/((3.+fluarw2)*fluarw)    !----> r^1/2
-        
-        drluarw=( ((3.*(1.+fluarw2)**2*(2.*fluarw*dfluarw)*skew2)+ &
-            (1.+fluarw2)**3*2.*skew*dskew) *(3.+fluarw2)**2.*fluarw2 - &
-            (1.+fluarw2)**3*skew2* &
-            ( (2.*(3.+fluarw2)*(2.*fluarw*dfluarw)*fluarw2) + &
-            (3.+fluarw2)**2*2.*fluarw*dfluarw) )/ &
-            (((3.+fluarw2)**2.*fluarw2)**2)
-                                     
-        dxluarw=( ((1.5*(1.+fluarw2)**0.5*(2.*fluarw*dfluarw)*skew)+ &
-            (1.+fluarw2)**1.5*dskew) *(3.+fluarw2)*fluarw - &
-            (1.+fluarw2)**1.5*skew* &
-            (3.*dfluarw+3*fluarw2*dfluarw) )/ &
-            (((3.+fluarw2)*fluarw)**2)
-    
-    else        
-        dfluarw=0.
-        rluarw=0.
-        drluarw=0.
-        xluarw=0.
-        dxluarw=0.
-    end if
-
-
-
-   aluarw=0.5*(1.-xluarw/(4.+rluarw)**0.5)
-   bluarw=1.-aluarw
-
-   daluarw=-0.5*(  (dxluarw*(4.+rluarw)**0.5) - &
-           (0.5*xluarw*(4.+rluarw)**(-0.5)*drluarw) ) &
-           /(4.+rluarw) 
-   dbluarw=-daluarw
-   
-   sigmawa=radw2*(bluarw/(aluarw*(1.+fluarw2)))**0.5
-   sigmawb=radw2*(aluarw/(bluarw*(1.+fluarw2)))**0.5
-
-   dsigmawa=dradw2*(bluarw/(aluarw*(1.+fluarw2)))**0.5+ &
-            radw2*( &
-            (0.5*(bluarw/(aluarw*(1.+fluarw2)))**(-0.5))      * &
-            ( &
-            (dbluarw*(aluarw*(1.+fluarw2))- &
-            bluarw*(daluarw*(1.+fluarw2)+aluarw*2.*fluarw*dfluarw)) &
-            /((aluarw*(1.+fluarw2))**2) &
-            ) &
-            )
-  dsigmawb=dradw2*(aluarw/(bluarw*(1.+fluarw2)))**0.5+ &
-           radw2*( &
-           (0.5*(aluarw/(bluarw*(1.+fluarw2)))**(-0.5))      * &
-           ( &
-           (daluarw*(bluarw*(1.+fluarw2))- &
-           aluarw*(dbluarw*(1.+fluarw2)+bluarw*2.*fluarw*dfluarw)) &
-           /((bluarw*(1.+fluarw2))**2) &
-           ) &
-           )
-    
-           wa=(fluarw*sigmawa)
-           wb=(fluarw*sigmawb)
-           dwa=dfluarw*sigmawa+fluarw*dsigmawa
-           dwb=dfluarw*sigmawb+fluarw*dsigmawb
-
-           deltawa=wold-wa
-           deltawb=wold+wb
-           wold2=wold*wold
-           sigmawa2=sigmawa*sigmawa
-           sigmawb2=sigmawb*sigmawb
-                            
-           if (abs(deltawa).gt.6.*sigmawa.and.abs(deltawb).gt.6.*sigmawb) flagrein=1
-
-           pa=(usurad2p*(1./sigmawa))*(exp(-(0.5*((deltawa/sigmawa)**2.))))
-           pb=(usurad2p*(1./sigmawb))*(exp(-(0.5*((deltawb/sigmawb)**2.))))
-                                    
-           ptot=dens*aluarw*pa+dens*bluarw*pb
-                               
-           aperfa=deltawa*usurad2/sigmawa
-           aperfb=deltawb*usurad2/sigmawb
-
-           Phi=-0.5* &
-               (aluarw*dens*dwa+dens*wa*daluarw+aluarw*wa*ddens)*erf(aperfa) &
-               +sigmawa*(aluarw*dens*dsigmawa*(wold2/sigmawa2+1.)+ &
-               sigmawa*dens*daluarw+sigmawa*ddens*aluarw+ &
-               aluarw*wold*dens/sigmawa2*(sigmawa*dwa-wa*dsigmawa))*pa &
-               +0.5* &
-               (bluarw*dens*dwb+wb*dens*dbluarw+wb*bluarw*ddens)*erf(aperfb) &
-               +sigmawb*(bluarw*dens*dsigmawb*(wold2/sigmawb2+1.)+ &
-               sigmawb*dens*dbluarw+sigmawb*ddens*bluarw+ &
-               bluarw*wold*dens/sigmawb2*(-sigmawb*dwb+wb*dsigmawb))*pb
-
-               Q=timedir*((aluarw*dens*deltawa/sigmawa2)*pa+ &
-               (bluarw*dens*deltawb/sigmawb2)*pb)
-
-               ath=(1./ptot)*(-(C0/2.)*alfa*Q+phi)
-               bth=sqrt(C0*alfa)
-              !bth=sngl(sigmaw*sqrt(2.*tlw))
-
-    return
-end subroutine cbl
-
-function cuberoot(x) result(y)
-    
-    implicit none
-
-    real, intent(in) :: x
-    real :: y 
-    real, parameter :: third=0.333333333
-
-    y=sign((abs(x))**third,x)
-end function cuberoot
-
-subroutine reinit_particle(zp,ust,wst,h,sigmaw,wp,nrand,ol)
-!                                      i   i  i   i  i    io  io    i 
 
-!******************************************************************************
-! CBL skewed vertical profiles and formulation of LHH 1996 with profile of w^3
-! from lHB 2000 
-! LHH formulation has been modified to account for variable density profiles 
-! and backward in time or forward in time simulations
-! This routine re-initialize particle velocity if a numerical instability 
-! in the cbl scheme generated a NaN value 
-! The particle velocity is extracted from the updraft and downdraft 
-! distribution as required  
-! The re-initialization si not perfect 
-! See e.g. Cassiani et al(2015) BLM           
-!******************************************************************************
-  use par_mod, only:pi
-  use com_mod, only:ldirect,rannumb
-
-  implicit none
-
-
-  real :: usurad2,usurad2p,C0,costluar4,eps 
-  parameter  (usurad2=0.7071067812,usurad2p=0.3989422804,C0=2,costluar4=0.66667,eps=0.000001)
-
-  integer idum,nrand
-  real :: wp,zp,ust,wst,h,dens,ddens,sigmaw,dsigmawdz,tlw,dcas,dcas1 !,ran3,gasdev
-  real :: w3,w2
-  real ::  z, &    
-       skew, &
-       skew2, &
-       radw2, &
-       fluarw,fluarw2, &
-       rluarw, &
-       xluarw, &
-       aluarw, &
-       bluarw, &
-       sigmawa, &
-       sigmawb, &  
-       ath, &
-       bth, &
-       wb,wa 
-  real timedir
-  real ol,transition
-
-!---------------------------------------------------------------------------  
-!timedir direction of time forward (1) or backward(-1)
-  nrand=nrand+1
-  dcas1=rannumb(nrand)
-  timedir=ldirect 
-  z=zp/h
-  transition=1.
-
-  if (-h/ol.lt.15) transition=((sin((((-h/ol)+10.)/10.)*pi)))/2.+0.5
-
-  w2=sigmaw*sigmaw  
-  w3=(((1.2*z*((1.-z)**(3./2.)))+eps)*wst**3)*transition 
-  skew=w3/(w2**1.5)
-  skew2=skew*skew
-  radw2=sqrt(w2) !sigmaw
-
-  fluarw=costluar4*skew**0.333333333333333
-  fluarw2=fluarw*fluarw
-  rluarw=(1.+fluarw2)**3.*skew2/((3.+fluarw2)**2.*fluarw2)  !-> r
-  xluarw=rluarw**0.5 !(1.+fluarw2)**1.5*skew/((3.+fluarw2)*fluarw)    !----> r^1/2
-
-  aluarw=0.5*(1.-xluarw/(4.+rluarw)**0.5)
-  bluarw=1.-aluarw
-
-  sigmawa=radw2*(bluarw/(aluarw*(1.+fluarw2)))**0.5
-  sigmawb=radw2*(aluarw/(bluarw*(1.+fluarw2)))**0.5
-
-  wa=(fluarw*sigmawa)
-  wb=(fluarw*sigmawb)
-
-
-
-  if ((sign(1.,wp)*timedir).gt.0) then !updraft   
-100 wp=(dcas1*sigmawa+wa)
-    if (wp.lt.0)  then
-      nrand=nrand+1
-      dcas1=rannumb(nrand)
-      goto 100
-    end if
-    wp=wp*timedir
-  else if ((sign(1.,wp)*timedir).lt.0) then !downdraft    
-101 wp=(dcas1*sigmawb-wb)
-    if (wp.gt.0)  then 
-      nrand=nrand+1
-      dcas1=rannumb(nrand)
-      goto 101
-    end if
-    wp=wp*timedir
-  end if
-
-  return
-end subroutine reinit_particle
-
-subroutine init_cbl_vel(idum,zp,ust,wst,h,sigmaw,wp,ol,ithread)
-  !                              i/o   i  i   i  i     i  o   i  
-
-  use par_mod, only:pi
-  use com_mod, only:ldirect
-  use random_mod, only: gasdev, ran3
-
-  implicit none
-  !===============================================================================
-  ! CBL skewed vertical profiles and formulation of LHH 1996 with profile of w3
-  ! from LHB 2000
-  ! LHH formulation has been modified to account for variable density profiles and
-  ! backward in time or forward in time simulations
-  ! see Cassiani et al. BLM 2014 doi  for explanations and references
-  !===============================================================================
-
-  integer,intent(in) :: ithread
-  real :: usurad2,usurad2p,C0,costluar4,eps 
-  parameter  (usurad2=0.7071067812,usurad2p=0.3989422804,C0=2,costluar4=0.66667,eps=0.000001)
-
-  
-  real :: wp,zp,ust,wst,h,dens,ddens,sigmaw,dsigmawdz,tlw,dcas,dcas1!,ran3,gasdev
-  real :: w3,w2
-  real ::  z, &    
-       skew, &
-       skew2, &
-       radw2, &
-       fluarw,fluarw2, &
-       rluarw, &
-       xluarw, &
-       aluarw, &
-       bluarw, &
-       sigmawa, &
-       sigmawb, &  
-       ath, &
-       bth, &
-       wb,wa 
-  real timedir
-  real ol, transition
-  integer :: idum
-  
-  !---------------------------------------------------------------------------  
-  timedir=ldirect !direction of time forward (1) or backward(-1)
-  z=zp/h
-
-
-  transition=1.
-  if (-h/ol.lt.15) transition=((sin((((-h/ol)+10.)/10.)*pi)))/2.+0.5  !see also in cbl.f90
-
-  w2=sigmaw*sigmaw
-  w3=(((1.2*z*((1.-z)**(3./2.)))+eps)*wst**3) *transition
-
-  skew=w3/(w2**1.5)
-  skew2=skew*skew
-
-  radw2=sqrt(w2) !sigmaw
-
-  fluarw=costluar4*skew**0.333333333333333
-  fluarw2=fluarw*fluarw
-  rluarw=(1.+fluarw2)**3.*skew2/((3.+fluarw2)**2.*fluarw2)  !-> r
-  xluarw=rluarw**0.5 !----> r^1/2
-
-  aluarw=0.5*(1.-xluarw/(4.+rluarw)**0.5)
-  bluarw=1.-aluarw
-
-  sigmawa=radw2*(bluarw/(aluarw*(1.+fluarw2)))**0.5
-  sigmawb=radw2*(aluarw/(bluarw*(1.+fluarw2)))**0.5
+contains
 
-  wa=(fluarw*sigmawa)
-  wb=(fluarw*sigmawb)
+#include "cbl_cbl.f90"
 
-  dcas=ran3(idum,ithread) 
+#include "cbl_cuberoot.f90"
 
-  if (dcas.le.aluarw) then
-    dcas1=gasdev(idum,ithread)
-    wp=timedir*(dcas1*sigmawa+wa)
-  else
-    dcas1=gasdev(idum,ithread)
-    wp=timedir*(dcas1*sigmawb-wb)
-  end if
+#include "cbl_reinit_particle.f90"
 
-  return
-end subroutine init_cbl_vel
+#include "cbl_init_cbl_vel.f90"
 
 end module cbl_mod
diff --git a/src/cbl_reinit_particle.f90 b/src/cbl_reinit_particle.f90
new file mode 100644
index 0000000000000000000000000000000000000000..9d8228242143d7b1fca7defd299fe8af95d1ec31
--- /dev/null
+++ b/src/cbl_reinit_particle.f90
@@ -0,0 +1,99 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine reinit_particle(zp,ust,wst,h,sigmaw,wp,nrand,ol)
+!                                      i   i  i   i  i    io  io    i
+
+!******************************************************************************
+! CBL skewed vertical profiles and formulation of LHH 1996 with profile of w^3
+! from lHB 2000
+! LHH formulation has been modified to account for variable density profiles
+! and backward in time or forward in time simulations
+! This routine re-initialize particle velocity if a numerical instability
+! in the cbl scheme generated a NaN value
+! The particle velocity is extracted from the updraft and downdraft
+! distribution as required
+! The re-initialization si not perfect
+! See e.g. Cassiani et al(2015) BLM
+!******************************************************************************
+  use par_mod, only:pi
+  use com_mod, only:ldirect,rannumb
+
+  implicit none
+
+
+  real :: usurad2,usurad2p,C0,costluar4,eps
+  parameter  (usurad2=0.7071067812,usurad2p=0.3989422804,C0=2,costluar4=0.66667,eps=0.000001)
+
+  integer idum,nrand
+  real :: wp,zp,ust,wst,h,dens,ddens,sigmaw,dsigmawdz,tlw,dcas,dcas1 !,ran3,gasdev
+  real :: w3,w2
+  real ::  z, &
+       skew, &
+       skew2, &
+       radw2, &
+       fluarw,fluarw2, &
+       rluarw, &
+       xluarw, &
+       aluarw, &
+       bluarw, &
+       sigmawa, &
+       sigmawb, &
+       ath, &
+       bth, &
+       wb,wa
+  real timedir
+  real ol,transition
+
+!---------------------------------------------------------------------------
+!timedir direction of time forward (1) or backward(-1)
+  nrand=nrand+1
+  dcas1=rannumb(nrand)
+  timedir=ldirect
+  z=zp/h
+  transition=1.
+
+  if (-h/ol.lt.15) transition=((sin((((-h/ol)+10.)/10.)*pi)))/2.+0.5
+
+  w2=sigmaw*sigmaw
+  w3=(((1.2*z*((1.-z)**(3./2.)))+eps)*wst**3)*transition
+  skew=w3/(w2**1.5)
+  skew2=skew*skew
+  radw2=sqrt(w2) !sigmaw
+
+  fluarw=costluar4*skew**0.333333333333333
+  fluarw2=fluarw*fluarw
+  rluarw=(1.+fluarw2)**3.*skew2/((3.+fluarw2)**2.*fluarw2)  !-> r
+  xluarw=rluarw**0.5 !(1.+fluarw2)**1.5*skew/((3.+fluarw2)*fluarw)    !----> r^1/2
+
+  aluarw=0.5*(1.-xluarw/(4.+rluarw)**0.5)
+  bluarw=1.-aluarw
+
+  sigmawa=radw2*(bluarw/(aluarw*(1.+fluarw2)))**0.5
+  sigmawb=radw2*(aluarw/(bluarw*(1.+fluarw2)))**0.5
+
+  wa=(fluarw*sigmawa)
+  wb=(fluarw*sigmawb)
+
+
+
+  if ((sign(1.,wp)*timedir).gt.0) then !updraft
+100 wp=(dcas1*sigmawa+wa)
+    if (wp.lt.0)  then
+      nrand=nrand+1
+      dcas1=rannumb(nrand)
+      goto 100
+    end if
+    wp=wp*timedir
+  else if ((sign(1.,wp)*timedir).lt.0) then !downdraft
+101 wp=(dcas1*sigmawb-wb)
+    if (wp.gt.0)  then
+      nrand=nrand+1
+      dcas1=rannumb(nrand)
+      goto 101
+    end if
+    wp=wp*timedir
+  end if
+
+  return
+end subroutine reinit_particle
diff --git a/src/cla_get_3d_u_dims.f90 b/src/cla_get_3d_u_dims.f90
new file mode 100644
index 0000000000000000000000000000000000000000..43b9a03ecb62ff9a63cc279d8c47508359db1a81
--- /dev/null
+++ b/src/cla_get_3d_u_dims.f90
@@ -0,0 +1,128 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+    SUBROUTINE get_3d_u_dims(filepath, gribfile_type, xlon, ylat, zlev)
+
+        ! Looks at the 3d u fields in the GRIBFILE to get x and y dims, as well as number of levels
+        USE grib_api
+
+        IMPLICIT NONE
+
+        CHARACTER(LEN=*), INTENT(IN) :: filepath  ! full path to GRIB file
+        INTEGER, INTENT(IN) :: gribfile_type
+        INTEGER, INTENT(OUT) :: xlon, ylat, zlev
+
+        INTEGER :: ifile, iret, igrib, grib_centre
+        LOGICAL :: end_of_file
+
+        ! These will be assigned according to type of grib file, then used to filter
+        ! for the 3d messages
+        ! Name of the key being sought
+        CHARACTER(LEN=64) :: keyname_leveltype, keyname_shortname, keyname_level, &
+                             keyname_xlon, keyname_ylat
+
+        ! The key value being filtered for
+        CHARACTER(LEN=64) :: keyvalue_leveltype, keyvalue_shortname
+
+        ! Actual values read in from the grib file
+        CHARACTER(LEN=64) :: value_leveltype, value_shortname
+        INTEGER :: value_level
+
+        INTEGER :: num_levels
+
+        ! Get the field names to read, based on the type of grib file
+
+        !!! Note that ALL of these have the same key names, except that
+        !!! leveltype is 'hybrid' in ECMWF and 'isobaricInhPa' in NCEP.
+        !!! This could probably be consolidated, but because these are
+        !!! files that go through some preprocessing, and aren't
+        !!! necessarily standard (at least for ECMWF), I'm going to be
+        !!! safe and leave it as is for now, so it would be easier to
+        !!! modify for one type, if necessary.
+        IF (gribfile_type == GRIBFILE_TYPE_ECMWF_GRIB1) THEN
+            keyname_leveltype = 'typeOfLevel'
+            keyname_shortname = 'shortName'
+            keyname_level = 'level'
+            keyvalue_leveltype = 'hybrid'
+            keyvalue_shortname = 'u'
+            keyname_xlon = 'Ni'
+            keyname_ylat = 'Nj'
+        ELSE IF (gribfile_type == GRIBFILE_TYPE_ECMWF_GRIB1_2) THEN
+            keyname_leveltype = 'typeOfLevel'
+            keyname_shortname = 'shortName'
+            keyname_level = 'level'
+            keyvalue_leveltype = 'hybrid'
+            keyvalue_shortname = 'u'
+            keyname_xlon = 'Ni'
+            keyname_ylat = 'Nj'
+        ELSE IF (gribfile_type == GRIBFILE_TYPE_ECMWF_GRIB2) THEN
+            keyname_leveltype = 'typeOfLevel'
+            keyname_shortname = 'shortName'
+            keyname_level = 'level'
+            keyvalue_leveltype = 'hybrid'
+            keyvalue_shortname = 'u'
+            keyname_xlon = 'Ni'
+            keyname_ylat = 'Nj'
+        ELSE IF (gribfile_type == GRIBFILE_TYPE_NCEP_GRIB1) THEN
+            keyname_leveltype = 'typeOfLevel'
+            keyname_shortname = 'shortName'
+            keyname_level = 'level'
+            keyvalue_leveltype = 'isobaricInhPa'
+            keyvalue_shortname = 'u'
+            keyname_xlon = 'Ni'
+            keyname_ylat = 'Nj'
+        ELSE IF (gribfile_type == GRIBFILE_TYPE_NCEP_GRIB2) THEN
+            keyname_leveltype = 'typeOfLevel'
+            keyname_shortname = 'shortName'
+            keyname_level = 'level'
+            keyvalue_leveltype = 'isobaricInhPa'
+            keyvalue_shortname = 'u'
+            keyname_xlon = 'Ni'
+            keyname_ylat = 'Nj'
+        ELSE
+            PRINT *, 'class_gribfile:get_3d_u_dims(): Unsupported gribfile type: ', gribfile_type
+            STOP
+        ENDIF
+
+        CALL grib_open_file(ifile, filepath, 'r', iret)
+        IF (iret == 0) THEN
+
+            ! Iterate through all messages to count 3d u messages (levels) and get x,y dimensions
+            end_of_file = .FALSE.
+            num_levels = 0
+            DO WHILE (.NOT. end_of_file)
+                CALL grib_new_from_file(ifile, igrib, iret)
+                IF (iret .eq. GRIB_END_OF_FILE) THEN
+                    end_of_file = .TRUE.
+                ELSE
+
+                    ! Get relevant keys and filter for the 3d U wind
+                    CALL grib_get(igrib, keyname_shortname, value_shortname)
+                    CALL grib_get(igrib, keyname_leveltype, value_leveltype)
+                    CALL grib_get(igrib, keyname_level, value_level)
+                    IF ( TRIM(value_leveltype) == TRIM(keyvalue_leveltype) .AND. &
+                         TRIM(value_shortname) == TRIM(keyvalue_shortname) ) THEN
+
+                        ! If this is first 3d U wind message, get dimensions
+                        IF (num_levels == 0) THEN
+                            CONTINUE
+                            CALL grib_get(igrib, keyname_xlon, xlon)
+                            CALL grib_get(igrib, keyname_ylat, ylat)
+                        ENDIF
+                        !PRINT *, TRIM(value_shortname), '  ', TRIM(value_leveltype), '  ', value_level
+                        num_levels = num_levels + 1
+                    END IF
+                END IF
+            END DO
+
+
+        ELSE
+            PRINT *, "ERROR: class_gribfile::get_3d_u_dims(): problem opening GRIB file: ", filepath
+            STOP
+        END IF
+
+        CALL grib_close_file(ifile)
+
+        zlev = num_levels
+
+    END SUBROUTINE get_3d_u_dims
diff --git a/src/cla_get_centre_and_type.f90 b/src/cla_get_centre_and_type.f90
new file mode 100644
index 0000000000000000000000000000000000000000..64cb95d9c92044d5d8fc72fb1cc1c1f346971a5e
--- /dev/null
+++ b/src/cla_get_centre_and_type.f90
@@ -0,0 +1,84 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+    SUBROUTINE get_centre_and_type(filepath, grib_centre, gribfile_type)
+        ! Given specified grib file, passes back centre and gribfile
+        ! type to the calling program.  Numeric codes are defined as integer parameters
+        ! in this module
+
+        ! To get this information, we have to iterate through the entire file in order to
+        ! determine if it is hybrid or not
+        !
+
+        USE grib_api
+        IMPLICIT NONE
+        CHARACTER(LEN=*), INTENT(IN) :: filepath  ! full path to GRIB file
+        INTEGER, INTENT(OUT) :: grib_centre, gribfile_type
+
+        INTEGER :: fileptr, iret, igrib, centre, grib_edition
+        LOGICAL :: end_of_file
+        LOGICAL :: grib1_detected, grib2_detected
+
+
+        grib1_detected = .FALSE.
+        grib2_detected = .FALSE.
+
+        CALL grib_open_file(fileptr, filepath, 'r', iret)
+        IF (iret /= 0) THEN
+            PRINT *, 'class_gributils:get_centre_and_type()...'
+            PRINT *, '     unable to open filepath: ', filepath
+            STOP
+        END IF
+
+
+        ! Use first record to detect centre and and grib version of first messages.  We will
+        ! then assume that all following messages have same centre, but not necessarily same
+        ! GRIB version
+        CALL grib_new_from_file(fileptr, igrib, iret)
+        CALL grib_get(igrib, 'centre', grib_centre)
+        CALL grib_get(igrib, 'edition', grib_edition)
+
+        IF (grib_edition == 1) grib1_detected = .TRUE.
+        IF (grib_edition == 2) grib2_detected = .TRUE.
+
+        ! Now, iterate through the rest of records to determine if this is a mixed edition file
+        end_of_file = .FALSE.
+        DO WHILE (.NOT. end_of_file)
+            CALL grib_new_from_file(fileptr, igrib, iret)
+            IF (iret .eq. GRIB_END_OF_FILE) THEN
+                end_of_file = .TRUE.
+            ELSE
+
+                ! Get edition from file
+                CALL grib_get(igrib, 'edition', grib_edition)
+                IF (grib_edition .eq. 1) grib1_detected = .TRUE.
+                IF (grib_edition .eq. 2) grib2_detected = .TRUE.
+            END IF
+        END DO
+
+    CALL grib_close_file(fileptr)
+
+    ! Determine the gribfile type depending on centre and edition(s)
+    IF (grib_centre == CENTRE_ECMWF) THEN
+        IF (grib1_detected .AND. grib2_detected) THEN
+            gribfile_type = GRIBFILE_TYPE_ECMWF_GRIB1_2
+        ELSE IF (grib1_detected .AND. .NOT. grib2_detected) THEN
+            gribfile_type = GRIBFILE_TYPE_ECMWF_GRIB1
+        ELSE IF (.NOT. grib1_detected .AND. grib2_detected) THEN
+            gribfile_type = GRIBFILE_TYPE_ECMWF_GRIB2
+        ELSE
+            gribfile_type = GRIBFILE_TYPE_UNKNOWN
+        ENDIF
+    ELSE IF (grib_centre == CENTRE_NCEP) THEN
+        IF (grib1_detected .AND. .NOT. grib2_detected) THEN
+             gribfile_type = GRIBFILE_TYPE_NCEP_GRIB1
+        ELSE IF (.NOT. grib1_detected .AND. grib2_detected) THEN
+            gribfile_type = GRIBFILE_TYPE_NCEP_GRIB2
+        ELSE
+            gribfile_type = GRIBFILE_TYPE_UNKNOWN
+        ENDIF
+    ELSE
+        gribfile_type = GRIBFILE_TYPE_UNKNOWN
+    ENDIF
+
+    END SUBROUTINE get_centre_and_type
diff --git a/src/cla_gribfile_centre.f90 b/src/cla_gribfile_centre.f90
new file mode 100644
index 0000000000000000000000000000000000000000..34a7b979d40066aaf8f80d928b77b3f6ec1ad2a1
--- /dev/null
+++ b/src/cla_gribfile_centre.f90
@@ -0,0 +1,45 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+    INTEGER FUNCTION gribfile_centre(filepath)
+
+        ! Returns an integer constant denoting the grib centre (currently either ECMWF, NCEP or UNKNOWN)
+        ! for the specified filepath.  Returns one of the GRIBFILE_CENTRE_ constants defined at top of this
+        ! module.
+
+
+        USE grib_api
+
+        IMPLICIT NONE
+
+        CHARACTER(LEN=*), INTENT(IN) :: filepath ! full path to GRIB file
+
+
+
+        INTEGER :: ifile, iret, igrib, grib_centre
+
+        CALL grib_open_file(ifile, filepath, 'r', iret)
+        IF (iret == 0) THEN
+            ! Use first record to detect centre, which is assumed constant
+            ! amongst all messages
+            CALL grib_new_from_file(ifile, igrib, iret)
+            CALL grib_get(igrib, 'centre', grib_centre)
+            CALL grib_close_file(ifile)
+        ELSE
+            PRINT *, "WARNING: problem opening GRIB file: ", filepath
+            grib_centre = -999
+        END IF
+
+
+
+
+
+        IF (grib_centre == CENTRE_NCEP) THEN
+            gribfile_centre = GRIBFILE_CENTRE_NCEP
+        ELSE IF (grib_centre == CENTRE_ECMWF) THEN
+            gribfile_centre = GRIBFILE_CENTRE_ECMWF
+        ELSE
+            gribfile_centre = GRIBFILE_CENTRE_UNKNOWN
+        END IF
+
+    END FUNCTION gribfile_centre
diff --git a/src/cla_gribfile_num_xlon.f90 b/src/cla_gribfile_num_xlon.f90
new file mode 100644
index 0000000000000000000000000000000000000000..ca93aed96110cf80c824c86db5c17873883fefc3
--- /dev/null
+++ b/src/cla_gribfile_num_xlon.f90
@@ -0,0 +1,14 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+    INTEGER FUNCTION gribfile_num_xlon(gribfile_obj)
+
+        ! Returns x (lon) dimension of met data
+        TYPE(gribfile_object), INTENT(IN) :: gribfile_obj
+
+        IF (.NOT. gribfile_obj%is_instantiated) THEN
+            PRINT *, 'ERROR: class_gribfile: gribfile_obj not instantiated'
+        ENDIF
+        gribfile_num_xlon = gribfile_obj%num_xlon
+
+    END FUNCTION gribfile_num_xlon
diff --git a/src/cla_gribfile_num_ylat.f90 b/src/cla_gribfile_num_ylat.f90
new file mode 100644
index 0000000000000000000000000000000000000000..21f702952d38cddcc3c35d3e977db562c10e6b6a
--- /dev/null
+++ b/src/cla_gribfile_num_ylat.f90
@@ -0,0 +1,14 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+    INTEGER FUNCTION gribfile_num_ylat(gribfile_obj)
+
+        ! Returns y (lat) dimension of met data
+        TYPE(gribfile_object), INTENT(IN) :: gribfile_obj
+
+        IF (.NOT. gribfile_obj%is_instantiated) THEN
+            PRINT *, 'ERROR: class_gribfile: gribfile_obj not instantiated'
+        ENDIF
+        gribfile_num_ylat = gribfile_obj%num_ylat
+
+    END FUNCTION gribfile_num_ylat
diff --git a/src/cla_gribfile_num_zlevel.f90 b/src/cla_gribfile_num_zlevel.f90
new file mode 100644
index 0000000000000000000000000000000000000000..0b4d3392dfb371953eb697071f3ffb7300dd88f1
--- /dev/null
+++ b/src/cla_gribfile_num_zlevel.f90
@@ -0,0 +1,14 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+    INTEGER FUNCTION gribfile_num_zlevel(gribfile_obj)
+
+        ! Returns z (level) dimension of met data
+        TYPE(gribfile_object), INTENT(IN) :: gribfile_obj
+
+        IF (.NOT. gribfile_obj%is_instantiated) THEN
+            PRINT *, 'ERROR: class_gribfile: gribfile_obj not instantiated'
+        ENDIF
+        gribfile_num_zlevel = gribfile_obj%num_zlevel
+
+    END FUNCTION gribfile_num_zlevel
diff --git a/src/cla_gribfile_printobj.f90 b/src/cla_gribfile_printobj.f90
new file mode 100644
index 0000000000000000000000000000000000000000..b6f229ff666041fcb9d699f496e94bc6783ab75f
--- /dev/null
+++ b/src/cla_gribfile_printobj.f90
@@ -0,0 +1,17 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+    SUBROUTINE gribfile_printobj(gribfile_obj)
+
+        ! Pretty prints the attributes of the gribfile pseudo-object
+        TYPE(gribfile_object), INTENT(IN) :: gribfile_obj
+
+        PRINT *, 'is_instantiated: ', gribfile_obj%is_instantiated
+        PRINT *, 'filepath: ', TRIM(gribfile_obj%file_path)
+        PRINT *, 'grib_centre: ', gribfile_obj%grib_centre
+        PRINT *, 'gribfile_type: ', gribfile_obj%gribfile_type
+        PRINT *, 'num_xlon: ', gribfile_obj%num_xlon
+        PRINT *, 'num_ylat: ', gribfile_obj%num_ylat
+        PRINT *, 'num_zlevel: ', gribfile_obj%num_zlevel
+
+    END SUBROUTINE gribfile_printobj
diff --git a/src/cla_gribfile_testhello.f90 b/src/cla_gribfile_testhello.f90
new file mode 100644
index 0000000000000000000000000000000000000000..4a7d536cd1c4ca1160b293985d72fa516edb02cc
--- /dev/null
+++ b/src/cla_gribfile_testhello.f90
@@ -0,0 +1,6 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+    SUBROUTINE gribfile_testhello()
+        PRINT *, 'Hello gribfile'
+    END SUBROUTINE gribfile_testhello
diff --git a/src/class_gribfile_mod.f90 b/src/class_gribfile_mod.f90
index 928b95bd2039fd6bc670195a4e81a55ac9cf3a75..be7b1a6b04b54c561b222a720318e1f625f84b5a 100644
--- a/src/class_gribfile_mod.f90
+++ b/src/class_gribfile_mod.f90
@@ -34,7 +34,7 @@ MODULE class_gribfile_mod
               GRIBFILE_CENTRE_ECMWF,          &
               GRIBFILE_CENTRE_UNKNOWN
 
-    ! These are codes for designating the type of GRIB file  
+    ! These are codes for designating the type of GRIB file
     ! being looked at
     INTEGER, PARAMETER :: GRIBFILE_TYPE_ECMWF_GRIB1 = 1,     &
                           GRIBFILE_TYPE_ECMWF_GRIB2 = 2,     &
@@ -65,9 +65,7 @@ MODULE class_gribfile_mod
 
 CONTAINS
 
-    SUBROUTINE gribfile_testhello()
-        PRINT *, 'Hello gribfile'
-    END SUBROUTINE gribfile_testhello
+#include "cla_gribfile_testhello.f90"
 
 
 
@@ -108,312 +106,24 @@ CONTAINS
     END FUNCTION gribfile_object_create
 
 
-    SUBROUTINE gribfile_printobj(gribfile_obj)
+#include "cla_gribfile_printobj.f90"
 
-        ! Pretty prints the attributes of the gribfile pseudo-object
-        TYPE(gribfile_object), INTENT(IN) :: gribfile_obj
-
-        PRINT *, 'is_instantiated: ', gribfile_obj%is_instantiated
-        PRINT *, 'filepath: ', TRIM(gribfile_obj%file_path)
-        PRINT *, 'grib_centre: ', gribfile_obj%grib_centre
-        PRINT *, 'gribfile_type: ', gribfile_obj%gribfile_type
-        PRINT *, 'num_xlon: ', gribfile_obj%num_xlon
-        PRINT *, 'num_ylat: ', gribfile_obj%num_ylat
-        PRINT *, 'num_zlevel: ', gribfile_obj%num_zlevel
-
-    END SUBROUTINE gribfile_printobj
-
-    INTEGER FUNCTION gribfile_centre(filepath)
-
-        ! Returns an integer constant denoting the grib centre (currently either ECMWF, NCEP or UNKNOWN)
-        ! for the specified filepath.  Returns one of the GRIBFILE_CENTRE_ constants defined at top of this
-        ! module.
-
-
-        USE grib_api
-
-        IMPLICIT NONE
-
-        CHARACTER(LEN=*), INTENT(IN) :: filepath ! full path to GRIB file
-
-
-
-        INTEGER :: ifile, iret, igrib, grib_centre
-
-        CALL grib_open_file(ifile, filepath, 'r', iret)
-        IF (iret == 0) THEN
-            ! Use first record to detect centre, which is assumed constant
-            ! amongst all messages
-            CALL grib_new_from_file(ifile, igrib, iret)
-            CALL grib_get(igrib, 'centre', grib_centre)
-            CALL grib_close_file(ifile)
-        ELSE
-            PRINT *, "WARNING: problem opening GRIB file: ", filepath
-            grib_centre = -999
-        END IF
-
-
-
-
-
-        IF (grib_centre == CENTRE_NCEP) THEN
-            gribfile_centre = GRIBFILE_CENTRE_NCEP
-        ELSE IF (grib_centre == CENTRE_ECMWF) THEN
-            gribfile_centre = GRIBFILE_CENTRE_ECMWF
-        ELSE
-            gribfile_centre = GRIBFILE_CENTRE_UNKNOWN
-        END IF
-
-    END FUNCTION gribfile_centre
+#include "cla_gribfile_centre.f90"
 
 
     ! This is currently a PRIVATE subroutine
-    SUBROUTINE get_centre_and_type(filepath, grib_centre, gribfile_type)
-        ! Given specified grib file, passes back centre and gribfile
-        ! type to the calling program.  Numeric codes are defined as integer parameters
-        ! in this module
+#include "cla_get_centre_and_type.f90"
 
-        ! To get this information, we have to iterate through the entire file in order to
-        ! determine if it is hybrid or not
-        !
 
-        USE grib_api
-        IMPLICIT NONE
-        CHARACTER(LEN=*), INTENT(IN) :: filepath  ! full path to GRIB file
-        INTEGER, INTENT(OUT) :: grib_centre, gribfile_type
-
-        INTEGER :: fileptr, iret, igrib, centre, grib_edition
-        LOGICAL :: end_of_file
-        LOGICAL :: grib1_detected, grib2_detected
-
-
-        grib1_detected = .FALSE.
-        grib2_detected = .FALSE.
-
-        CALL grib_open_file(fileptr, filepath, 'r', iret)
-        IF (iret /= 0) THEN
-            PRINT *, 'class_gributils:get_centre_and_type()...'
-            PRINT *, '     unable to open filepath: ', filepath
-            STOP
-        END IF
-
-
-        ! Use first record to detect centre and and grib version of first messages.  We will
-        ! then assume that all following messages have same centre, but not necessarily same
-        ! GRIB version
-        CALL grib_new_from_file(fileptr, igrib, iret)
-        CALL grib_get(igrib, 'centre', grib_centre)
-        CALL grib_get(igrib, 'edition', grib_edition)
-
-        IF (grib_edition == 1) grib1_detected = .TRUE.
-        IF (grib_edition == 2) grib2_detected = .TRUE.
-
-        ! Now, iterate through the rest of records to determine if this is a mixed edition file
-        end_of_file = .FALSE.
-        DO WHILE (.NOT. end_of_file)
-            CALL grib_new_from_file(fileptr, igrib, iret)
-            IF (iret .eq. GRIB_END_OF_FILE) THEN
-                end_of_file = .TRUE.
-            ELSE
-
-                ! Get edition from file
-                CALL grib_get(igrib, 'edition', grib_edition)
-                IF (grib_edition .eq. 1) grib1_detected = .TRUE.
-                IF (grib_edition .eq. 2) grib2_detected = .TRUE.
-            END IF
-        END DO
-
-    CALL grib_close_file(fileptr)
-
-    ! Determine the gribfile type depending on centre and edition(s)
-    IF (grib_centre == CENTRE_ECMWF) THEN
-        IF (grib1_detected .AND. grib2_detected) THEN
-            gribfile_type = GRIBFILE_TYPE_ECMWF_GRIB1_2
-        ELSE IF (grib1_detected .AND. .NOT. grib2_detected) THEN
-            gribfile_type = GRIBFILE_TYPE_ECMWF_GRIB1
-        ELSE IF (.NOT. grib1_detected .AND. grib2_detected) THEN
-            gribfile_type = GRIBFILE_TYPE_ECMWF_GRIB2
-        ELSE
-            gribfile_type = GRIBFILE_TYPE_UNKNOWN
-        ENDIF
-    ELSE IF (grib_centre == CENTRE_NCEP) THEN
-        IF (grib1_detected .AND. .NOT. grib2_detected) THEN
-             gribfile_type = GRIBFILE_TYPE_NCEP_GRIB1
-        ELSE IF (.NOT. grib1_detected .AND. grib2_detected) THEN
-            gribfile_type = GRIBFILE_TYPE_NCEP_GRIB2
-        ELSE
-            gribfile_type = GRIBFILE_TYPE_UNKNOWN
-        ENDIF
-    ELSE
-        gribfile_type = GRIBFILE_TYPE_UNKNOWN
-    ENDIF
-
-    END SUBROUTINE get_centre_and_type
-
-
-    SUBROUTINE get_3d_u_dims(filepath, gribfile_type, xlon, ylat, zlev)
-
-        ! Looks at the 3d u fields in the GRIBFILE to get x and y dims, as well as number of levels
-        USE grib_api
-
-        IMPLICIT NONE
-
-        CHARACTER(LEN=*), INTENT(IN) :: filepath  ! full path to GRIB file
-        INTEGER, INTENT(IN) :: gribfile_type
-        INTEGER, INTENT(OUT) :: xlon, ylat, zlev
-
-        INTEGER :: ifile, iret, igrib, grib_centre
-        LOGICAL :: end_of_file
-
-        ! These will be assigned according to type of grib file, then used to filter
-        ! for the 3d messages
-        ! Name of the key being sought
-        CHARACTER(LEN=64) :: keyname_leveltype, keyname_shortname, keyname_level, &
-                             keyname_xlon, keyname_ylat
-
-        ! The key value being filtered for
-        CHARACTER(LEN=64) :: keyvalue_leveltype, keyvalue_shortname
-
-        ! Actual values read in from the grib file
-        CHARACTER(LEN=64) :: value_leveltype, value_shortname
-        INTEGER :: value_level
-
-        INTEGER :: num_levels
-
-        ! Get the field names to read, based on the type of grib file
-
-        !!! Note that ALL of these have the same key names, except that
-        !!! leveltype is 'hybrid' in ECMWF and 'isobaricInhPa' in NCEP.
-        !!! This could probably be consolidated, but because these are
-        !!! files that go through some preprocessing, and aren't 
-        !!! necessarily standard (at least for ECMWF), I'm going to be
-        !!! safe and leave it as is for now, so it would be easier to
-        !!! modify for one type, if necessary.
-        IF (gribfile_type == GRIBFILE_TYPE_ECMWF_GRIB1) THEN
-            keyname_leveltype = 'typeOfLevel'
-            keyname_shortname = 'shortName'
-            keyname_level = 'level'
-            keyvalue_leveltype = 'hybrid'
-            keyvalue_shortname = 'u'
-            keyname_xlon = 'Ni'
-            keyname_ylat = 'Nj'
-        ELSE IF (gribfile_type == GRIBFILE_TYPE_ECMWF_GRIB1_2) THEN
-            keyname_leveltype = 'typeOfLevel'
-            keyname_shortname = 'shortName'
-            keyname_level = 'level'
-            keyvalue_leveltype = 'hybrid'
-            keyvalue_shortname = 'u'
-            keyname_xlon = 'Ni'
-            keyname_ylat = 'Nj'
-        ELSE IF (gribfile_type == GRIBFILE_TYPE_ECMWF_GRIB2) THEN
-            keyname_leveltype = 'typeOfLevel'
-            keyname_shortname = 'shortName'
-            keyname_level = 'level'
-            keyvalue_leveltype = 'hybrid'
-            keyvalue_shortname = 'u'
-            keyname_xlon = 'Ni'
-            keyname_ylat = 'Nj'
-        ELSE IF (gribfile_type == GRIBFILE_TYPE_NCEP_GRIB1) THEN
-            keyname_leveltype = 'typeOfLevel'
-            keyname_shortname = 'shortName'
-            keyname_level = 'level'
-            keyvalue_leveltype = 'isobaricInhPa'
-            keyvalue_shortname = 'u'
-            keyname_xlon = 'Ni'
-            keyname_ylat = 'Nj'
-        ELSE IF (gribfile_type == GRIBFILE_TYPE_NCEP_GRIB2) THEN
-            keyname_leveltype = 'typeOfLevel'
-            keyname_shortname = 'shortName'
-            keyname_level = 'level'
-            keyvalue_leveltype = 'isobaricInhPa'
-            keyvalue_shortname = 'u'
-            keyname_xlon = 'Ni'
-            keyname_ylat = 'Nj'
-        ELSE
-            PRINT *, 'class_gribfile:get_3d_u_dims(): Unsupported gribfile type: ', gribfile_type
-            STOP
-        ENDIF
-
-        CALL grib_open_file(ifile, filepath, 'r', iret)
-        IF (iret == 0) THEN
-
-            ! Iterate through all messages to count 3d u messages (levels) and get x,y dimensions
-            end_of_file = .FALSE.
-            num_levels = 0
-            DO WHILE (.NOT. end_of_file)
-                CALL grib_new_from_file(ifile, igrib, iret)
-                IF (iret .eq. GRIB_END_OF_FILE) THEN
-                    end_of_file = .TRUE.
-                ELSE
-
-                    ! Get relevant keys and filter for the 3d U wind
-                    CALL grib_get(igrib, keyname_shortname, value_shortname)
-                    CALL grib_get(igrib, keyname_leveltype, value_leveltype)
-                    CALL grib_get(igrib, keyname_level, value_level)
-                    IF ( TRIM(value_leveltype) == TRIM(keyvalue_leveltype) .AND. &
-                         TRIM(value_shortname) == TRIM(keyvalue_shortname) ) THEN
-
-                        ! If this is first 3d U wind message, get dimensions
-                        IF (num_levels == 0) THEN
-                            CONTINUE
-                            CALL grib_get(igrib, keyname_xlon, xlon)
-                            CALL grib_get(igrib, keyname_ylat, ylat)
-                        ENDIF
-                        !PRINT *, TRIM(value_shortname), '  ', TRIM(value_leveltype), '  ', value_level
-                        num_levels = num_levels + 1
-                    END IF
-                END IF
-            END DO
-
-
-        ELSE
-            PRINT *, "ERROR: class_gribfile::get_3d_u_dims(): problem opening GRIB file: ", filepath
-            STOP
-        END IF
-
-        CALL grib_close_file(ifile)
-
-        zlev = num_levels
-
-    END SUBROUTINE get_3d_u_dims
+#include "cla_get_3d_u_dims.f90"
 
 
 
     !!! Getter methods
-    INTEGER FUNCTION gribfile_num_xlon(gribfile_obj)
-
-        ! Returns x (lon) dimension of met data
-        TYPE(gribfile_object), INTENT(IN) :: gribfile_obj
-
-        IF (.NOT. gribfile_obj%is_instantiated) THEN
-            PRINT *, 'ERROR: class_gribfile: gribfile_obj not instantiated'
-        ENDIF
-        gribfile_num_xlon = gribfile_obj%num_xlon
-
-    END FUNCTION gribfile_num_xlon
-
-    INTEGER FUNCTION gribfile_num_ylat(gribfile_obj)
-
-        ! Returns y (lat) dimension of met data
-        TYPE(gribfile_object), INTENT(IN) :: gribfile_obj
-
-        IF (.NOT. gribfile_obj%is_instantiated) THEN
-            PRINT *, 'ERROR: class_gribfile: gribfile_obj not instantiated'
-        ENDIF
-        gribfile_num_ylat = gribfile_obj%num_ylat
-
-    END FUNCTION gribfile_num_ylat
-
-    INTEGER FUNCTION gribfile_num_zlevel(gribfile_obj)
-
-        ! Returns z (level) dimension of met data
-        TYPE(gribfile_object), INTENT(IN) :: gribfile_obj
+#include "cla_gribfile_num_xlon.f90"
 
-        IF (.NOT. gribfile_obj%is_instantiated) THEN
-            PRINT *, 'ERROR: class_gribfile: gribfile_obj not instantiated'
-        ENDIF
-        gribfile_num_zlevel = gribfile_obj%num_zlevel
+#include "cla_gribfile_num_ylat.f90"
 
-    END FUNCTION gribfile_num_zlevel
+#include "cla_gribfile_num_zlevel.f90"
 
 END MODULE class_gribfile_mod
diff --git a/src/cma_cc2gll.f90 b/src/cma_cc2gll.f90
new file mode 100644
index 0000000000000000000000000000000000000000..6bb57133cf377c3c7ba67d0206a37ae268f792b4
--- /dev/null
+++ b/src/cma_cc2gll.f90
@@ -0,0 +1,32 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine cc2gll (strcmp, xlat,xlong, ue,vn, ug,vg)
+  !*  Written on 3/31/94 by Dr. Albion Taylor  NOAA / OAR / ARL
+
+  use par_mod, only: dp
+
+  implicit none
+
+  real :: strcmp(9), xlat, xlong, ue, vn, ug, vg
+
+  real(kind=dp) :: xpolg,ypolg,along,slong,clong,rot
+
+  along = cspanf( xlong - strcmp(2), -180., 180.)
+  if (xlat.gt.89.985) then
+  !*  North polar meteorological orientation: "north" along prime meridian
+    rot = - strcmp(1) * along + xlong - 180.
+  elseif (xlat.lt.-89.985) then
+  !*  South polar meteorological orientation: "north" along prime meridian
+    rot = - strcmp(1) * along - xlong
+  else
+    rot = - strcmp(1) * along
+  endif
+  slong = sin( radpdg * rot )
+  clong = cos( radpdg * rot )
+  xpolg = slong * strcmp(5) + clong * strcmp(6)
+  ypolg = clong * strcmp(5) - slong * strcmp(6)
+  ug = ypolg * ue + xpolg * vn
+  vg = ypolg * vn - xpolg * ue
+  return
+end subroutine cc2gll
diff --git a/src/cma_ccrvll.f90 b/src/cma_ccrvll.f90
new file mode 100644
index 0000000000000000000000000000000000000000..2511f626a0bea26bd489a20ffe0b11fcde3aa35e
--- /dev/null
+++ b/src/cma_ccrvll.f90
@@ -0,0 +1,25 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine ccrvll (strcmp, xlat,xlong, gx,gy)
+  !*  Written on 9/20/94 by Dr. Albion Taylor  NOAA / OAR / ARL
+
+  use par_mod, only: dp
+
+  implicit none
+
+  real(kind=dp) :: xpolg,ypolg,temp,along,slong,clong,ctemp, curv
+  real :: strcmp(9), xlat, xlong, gx, gy
+
+  along = cspanf( xlong - strcmp(2), -180., 180.)
+  slong = sin( radpdg * strcmp(1) * along)
+  clong = cos( radpdg * strcmp(1) * along)
+  xpolg = - slong * strcmp(5) + clong * strcmp(6)
+  ypolg = clong * strcmp(5) + slong * strcmp(6)
+  temp = sin(radpdg * xlat)
+  ctemp = cos(radpdg * xlat)
+  curv = (strcmp(1) - temp) / ctemp / rearth
+  gx = curv * xpolg
+  gy = curv * ypolg
+  return
+end subroutine ccrvll
diff --git a/src/cma_ccrvxy.f90 b/src/cma_ccrvxy.f90
new file mode 100644
index 0000000000000000000000000000000000000000..3857c73d4cb5b5c5507e325ead57ca3a2998a2ac
--- /dev/null
+++ b/src/cma_ccrvxy.f90
@@ -0,0 +1,36 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine ccrvxy (strcmp, x,y, gx,gy)
+  !*  Written on 9/20/94 by Dr. Albion Taylor  NOAA / OAR / ARL
+
+  use par_mod, only: dp
+
+  implicit none
+
+  real :: strcmp(9), x, y, gx, gy
+  real(kind=dp) :: xpolg,ypolg,temp,ymerc,efact,curv
+
+  temp = strcmp(1) * strcmp(7) /rearth
+  xpolg = strcmp(6) + temp * (strcmp(3) - x)
+  ypolg = strcmp(5) + temp * (strcmp(4) - y)
+  temp = sqrt ( xpolg ** 2 + ypolg ** 2 )
+  if (temp.gt.0.) then
+    ymerc = - log( temp) /strcmp(1)
+    efact = exp(ymerc)
+    curv = ( (strcmp(1) - 1.d0) * efact + &
+         (strcmp(1) + 1.d0) / efact ) &
+         * .5d0 / rearth
+    gx = xpolg * curv / temp
+    gy = ypolg * curv / temp
+  else
+    if (abs(strcmp(1)) .eq. 1.) then
+      gx = 0.
+      gy = 0.
+    else
+      gx = 1./rearth
+      gy = 1./rearth
+    endif
+  endif
+  return
+end subroutine ccrvxy
diff --git a/src/cma_cg2cll.f90 b/src/cma_cg2cll.f90
new file mode 100644
index 0000000000000000000000000000000000000000..db645625e41d7a6b453029b62e3c6d49cbdd35cf
--- /dev/null
+++ b/src/cma_cg2cll.f90
@@ -0,0 +1,31 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine cg2cll (strcmp, xlat,xlong, ug,vg, ue,vn)
+  !*  Written on 3/31/94 by Dr. Albion Taylor  NOAA / OAR / ARL
+
+  use par_mod, only: dp
+
+  implicit none
+
+  real(kind=dp) :: xpolg,ypolg,along,slong,clong,rot
+  real :: strcmp(9), xlat, xlong, ug, vg, ue, vn
+
+  along = cspanf( xlong - strcmp(2), -180., 180.)
+  if (xlat.gt.89.985) then
+  !*  North polar meteorological orientation: "north" along prime meridian
+    rot = - strcmp(1) * along + xlong - 180.
+  elseif (xlat.lt.-89.985) then
+  !*  South polar meteorological orientation: "north" along prime meridian
+    rot = - strcmp(1) * along - xlong
+  else
+    rot = - strcmp(1) * along
+  endif
+  slong = sin( radpdg * rot )
+  clong = cos( radpdg * rot )
+  xpolg = slong * strcmp(5) + clong * strcmp(6)
+  ypolg = clong * strcmp(5) - slong * strcmp(6)
+  ue = ypolg * ug - xpolg * vg
+  vn = ypolg * vg + xpolg * ug
+  return
+end subroutine cg2cll
diff --git a/src/cma_cg2cxy.f90 b/src/cma_cg2cxy.f90
new file mode 100644
index 0000000000000000000000000000000000000000..674b7837814c3ebbc0fbe6b6197c6542dd37aca0
--- /dev/null
+++ b/src/cma_cg2cxy.f90
@@ -0,0 +1,52 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine cg2cxy (strcmp, x,y, ug,vg, ue,vn)
+  !*  Written on 3/31/94 by Dr. Albion Taylor  NOAA / OAR / ARL
+
+  use par_mod, only: dp
+
+  implicit none
+
+  real :: strcmp(9) , x, y, ug, vg, ue, vn
+
+  real :: clong, radial, rot, slong, xlat, xlong
+  real(kind=dp) :: xpolg,ypolg,temp,xi0,eta0,xi,eta
+
+  xi0 = ( x - strcmp(3) ) * strcmp(7) / rearth
+  eta0 = ( y - strcmp(4) ) * strcmp(7) /rearth
+  xi = xi0 * strcmp(5) - eta0 * strcmp(6)
+  eta = eta0 * strcmp(5) + xi0 * strcmp(6)
+  radial = 2. * eta - strcmp(1) * (xi*xi + eta*eta)
+  if (radial.gt.strcmp(8)) then
+  !*  Case north of 89 degrees. Meteorological wind direction definition
+  !*      changes.
+    call cnxyll(strcmp, xi,eta, xlat,xlong)
+  !*  North polar meteorological orientation: "north" along prime meridian
+    rot = strcmp(1) * (xlong - strcmp(2)) - xlong - 180.
+    slong = - sin( radpdg * rot )
+    clong = cos( radpdg * rot )
+    xpolg = slong * strcmp(5) + clong * strcmp(6)
+    ypolg = clong * strcmp(5) - slong * strcmp(6)
+  else if (radial.lt.strcmp(9)) then
+  !*  Case south of -89 degrees. Meteorological wind direction definition
+  !*      changes.
+    call cnxyll(strcmp, xi,eta, xlat,xlong)
+  !*  South polar meteorological orientation: "north" along prime meridian
+    rot = strcmp(1) * (xlong - strcmp(2)) + xlong
+    slong = - sin( radpdg * rot )
+    clong = cos( radpdg * rot )
+    xpolg = slong * strcmp(5) + clong * strcmp(6)
+    ypolg = clong * strcmp(5) - slong * strcmp(6)
+  else
+  !* Normal case. Meteorological direction of wind related to true north.
+    xpolg = strcmp(6) - strcmp(1) * xi0
+    ypolg = strcmp(5) - strcmp(1) * eta0
+    temp = sqrt ( xpolg ** 2 + ypolg ** 2 )
+    xpolg = xpolg / temp
+    ypolg = ypolg / temp
+  end if
+  ue = ( ypolg * ug - xpolg * vg )
+  vn = ( ypolg * vg + xpolg * ug )
+  return
+end subroutine cg2cxy
diff --git a/src/cma_cgszll.f90 b/src/cma_cgszll.f90
new file mode 100644
index 0000000000000000000000000000000000000000..19f12674fd15fb9e23fce1f52e0da9904f19a9ad
--- /dev/null
+++ b/src/cma_cgszll.f90
@@ -0,0 +1,52 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+real function cgszll (strcmp, xlat,xlong)
+  !*  Written on 3/31/94 by Dr. Albion Taylor  NOAA / OAR / ARL
+
+  use par_mod, only: dp
+
+  implicit none
+
+  real :: strcmp(9), xlat, xlong
+
+  real(kind=dp) :: slat,ymerc,efact
+
+  if (xlat .gt. 89.985) then
+  !* Close to north pole
+    if (strcmp(1) .gt. 0.9999) then
+  !* and to gamma == 1.
+      cgszll = 2. * strcmp(7)
+      return
+    endif
+    efact = cos(radpdg * xlat)
+    if (efact .le. 0.) then
+      cgszll = 0.
+      return
+    else
+      ymerc = - log( efact /(1. + sin(radpdg * xlat)))
+    endif
+  else if (xlat .lt. -89.985) then
+  !* Close to south pole
+    if (strcmp(1) .lt. -0.9999) then
+  !* and to gamma == -1.0
+      cgszll = 2. * strcmp(7)
+      return
+    endif
+    efact = cos(radpdg * xlat)
+    if (efact .le. 0.) then
+      cgszll = 0.
+      return
+    else
+      ymerc = log( efact /(1. - sin(radpdg * xlat)))
+    endif
+  else
+  slat = sin(radpdg * xlat)
+  ymerc = log((1. + slat) / (1. - slat))/2.
+  !efact = exp(ymerc)
+  !cgszll = 2. * strcmp(7) * exp (strcmp(1) * ymerc)
+  !c             / (efact + 1./efact)
+  endif
+  cgszll = strcmp(7) * cos(radpdg * xlat) * exp(strcmp(1) *ymerc)
+  return
+end function cgszll
diff --git a/src/cma_cgszxy.f90 b/src/cma_cgszxy.f90
new file mode 100644
index 0000000000000000000000000000000000000000..1e385764f9df52271022d1abac55e34bfcc5c36d
--- /dev/null
+++ b/src/cma_cgszxy.f90
@@ -0,0 +1,57 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+real function cgszxy (strcmp, x,y)
+  !*  Written on 3/31/94 by Dr. Albion Taylor  NOAA / OAR / ARL
+
+  use par_mod, only: dp
+
+  implicit none
+
+  real :: strcmp(9) , x, y
+  real(kind=dp) :: ymerc,efact, radial, temp
+  real(kind=dp) :: xi0,eta0,xi,eta
+
+
+  xi0 = ( x - strcmp(3) ) * strcmp(7) / rearth
+  eta0 = ( y - strcmp(4) ) * strcmp(7) /rearth
+  xi = xi0 * strcmp(5) - eta0 * strcmp(6)
+  eta = eta0 * strcmp(5) + xi0 * strcmp(6)
+  radial = 2. * eta - strcmp(1) * (xi*xi + eta*eta)
+  efact = strcmp(1) * radial
+  if (efact .gt. almst1) then
+    if (strcmp(1).gt.almst1) then
+      cgszxy = 2. * strcmp(7)
+    else
+      cgszxy = 0.
+    endif
+    return
+  endif
+  if (abs(efact) .lt. 1.e-2) then
+    temp = (efact / (2. - efact) )**2
+    ymerc = radial / (2. - efact) * (1.    + temp * &
+         (1./3. + temp * &
+         (1./5. + temp * &
+         (1./7. ))))
+  else
+    ymerc = - log( 1. - efact ) /2. /strcmp(1)
+  endif
+  if (ymerc .gt. 6.) then
+    if (strcmp(1) .gt. almst1) then
+      cgszxy = 2. * strcmp(7)
+    else
+      cgszxy = 0.
+    endif
+  else if (ymerc .lt. -6.) then
+    if (strcmp(1) .lt. -almst1) then
+      cgszxy = 2. * strcmp(7)
+    else
+      cgszxy = 0.
+    endif
+  else
+    efact = exp(ymerc)
+    cgszxy = 2. * strcmp(7) * exp (strcmp(1) * ymerc) &
+         / (efact + 1./efact)
+  endif
+  return
+end function cgszxy
diff --git a/src/cma_cll2xy.f90 b/src/cma_cll2xy.f90
new file mode 100644
index 0000000000000000000000000000000000000000..2f92b19b2c3fa40836f6aed847fe65f93aa0d5ac
--- /dev/null
+++ b/src/cma_cll2xy.f90
@@ -0,0 +1,17 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine cll2xy (strcmp, xlat,xlong, x,y)
+  !*  Written on 3/31/94 by Dr. Albion Taylor  NOAA / OAR / ARL
+
+  implicit none
+
+  real :: strcmp(9) , xlat, xlong, x, y, xi, eta
+
+  call cnllxy(strcmp, xlat,xlong, xi,eta)
+  x = strcmp(3) + rearth/strcmp(7) * &
+       (xi * strcmp(5) + eta * strcmp(6) )
+  y = strcmp(4) + rearth/strcmp(7) * &
+       (eta * strcmp(5) - xi * strcmp(6) )
+  return
+end subroutine cll2xy
diff --git a/src/cma_cnllxy.f90 b/src/cma_cnllxy.f90
new file mode 100644
index 0000000000000000000000000000000000000000..601b62493b405a52c44aac8051908f1e02ea2fe0
--- /dev/null
+++ b/src/cma_cnllxy.f90
@@ -0,0 +1,59 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine cnllxy (strcmp, xlat,xlong, xi,eta)
+  !*  Written on 3/31/94 by Dr. Albion Taylor  NOAA / OAR / ARL
+  !  main transformation routine from latitude-longitude to
+  !  canonical (equator-centered, radian unit) coordinates
+
+  use par_mod, only: dp
+
+  implicit none
+
+  real :: strcmp(9), xlat, xlong, xi, eta, &
+       gdlong, sndgam, csdgam, rhog1
+  real(kind=dp) :: gamma
+  real(kind=dp) :: dlong,dlat,slat,mercy,gmercy
+
+  gamma = strcmp(1)
+  dlat = xlat
+  dlong = cspanf(xlong - strcmp(2), -180., 180.)
+  dlong = dlong * radpdg
+  gdlong = gamma * dlong
+  if (abs(gdlong) .lt. .01) then
+  !  Code for gamma small or zero.  This avoids round-off error or divide-
+  !  by zero in the case of mercator or near-mercator projections.
+    gdlong = gdlong * gdlong
+    sndgam = dlong * (1. - 1./6. * gdlong * &
+         (1. - 1./20. * gdlong * &
+         (1. - 1./42. * gdlong )))
+    csdgam = dlong * dlong * .5 * &
+         (1. - 1./12. * gdlong * &
+         (1. - 1./30. * gdlong * &
+         (1. - 1./56. * gdlong )))
+  else
+  ! Code for moderate values of gamma
+    sndgam = sin (gdlong) /gamma
+    csdgam = (1. - cos(gdlong) )/gamma /gamma
+  endif
+  slat = sin(radpdg * dlat)
+  if ((slat .ge. almst1) .or. (slat .le. -almst1)) then
+    eta = 1./strcmp(1)
+    xi = 0.
+    return
+  endif
+  mercy = .5 * log( (1. + slat) / (1. - slat) )
+  gmercy = gamma * mercy
+  if (abs(gmercy) .lt. .001) then
+  !  Code for gamma small or zero.  This avoids round-off error or divide-
+  !  by zero in the case of mercator or near-mercator projections.
+    rhog1 = mercy * (1. - .5 * gmercy * &
+         (1. - 1./3. * gmercy * &
+         (1. - 1./4. * gmercy ) ) )
+  else
+  ! Code for moderate values of gamma
+    rhog1 = (1. - exp(-gmercy)) / gamma
+  endif
+  eta = rhog1 + (1. - gamma * rhog1) * gamma * csdgam
+  xi = (1. - gamma * rhog1 ) * sndgam
+end subroutine cnllxy
diff --git a/src/cma_cnxyll.f90 b/src/cma_cnxyll.f90
new file mode 100644
index 0000000000000000000000000000000000000000..a9909897a1ab6b4a8462161da9311fb35df6259f
--- /dev/null
+++ b/src/cma_cnxyll.f90
@@ -0,0 +1,62 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine cnxyll (strcmp, xi,eta, xlat,xlong)
+  !*  Written on 3/31/94 by Dr. Albion Taylor  NOAA / OAR / ARL
+  !  main transformation routine from canonical (equator-centered,
+  !  radian unit) coordinates
+
+  use par_mod, only: dp
+
+  implicit none
+
+  real :: strcmp(9), xlat, xlong, odist
+  real(kind=dp) :: gamma,temp,arg1,arg2,ymerc,along,gxi,cgeta
+  real(kind=dp) :: xi,eta
+
+  gamma = strcmp(1)
+  !  Calculate equivalent mercator coordinate
+  odist = xi*xi + eta*eta
+  arg2 = 2. * eta - gamma * (xi*xi + eta*eta)
+  arg1 = gamma * arg2
+  ! Change by A. Stohl to avoid problems close to the poles
+  ! if (arg1 .ge. almst1) then
+  !  distance to north (or south) pole is zero (or imaginary ;) )
+  ! xlat = sign(90.,strcmp(1))
+  ! xlong = strcmp(2)
+  ! return
+  ! endif
+  if (abs(arg1) .lt. .01) then
+  !  Code for gamma small or zero.  This avoids round-off error or divide-
+  !  by zero in the case of mercator or near-mercator projections.
+    temp = (arg1 / (2. - arg1) )**2
+    ymerc = arg2 / (2. - arg1) * (1.    + temp * &
+         (1./3. + temp * &
+         (1./5. + temp * &
+         (1./7. ))))
+  else
+  ! Code for moderate values of gamma
+    ymerc = - log ( 1. - arg1 ) /2. / gamma
+  endif
+  ! Convert ymerc to latitude
+  temp = exp( - abs(ymerc) )
+  xlat = sign(atan2((1. - temp) * (1. + temp), 2. * temp), ymerc)
+  ! Find longitudes
+  gxi = gamma*xi
+  cgeta = 1. - gamma * eta
+  if ( abs(gxi) .lt. .01*cgeta ) then
+  !  Code for gamma small or zero.  This avoids round-off error or divide-
+  !  by zero in the case of mercator or near-mercator projections.
+    temp = ( gxi /cgeta )**2
+    along = xi / cgeta * (1.    - temp * &
+         (1./3. - temp * &
+         (1./5. - temp * &
+         (1./7.   ))))
+  else
+  ! Code for moderate values of gamma
+    along = atan2( gxi, cgeta) / gamma
+  endif
+  xlong = sngl(strcmp(2) + dgprad * along)
+  xlat = xlat * dgprad
+  return
+end subroutine cnxyll
diff --git a/src/cma_cpolll.f90 b/src/cma_cpolll.f90
new file mode 100644
index 0000000000000000000000000000000000000000..9e2d2be9676ed70ab5e224fd3933665e00dab158
--- /dev/null
+++ b/src/cma_cpolll.f90
@@ -0,0 +1,25 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine cpolll (strcmp, xlat,xlong, enx,eny,enz)
+  !*  Written on 11/23/94 by Dr. Albion Taylor  NOAA / OAR / ARL
+
+  use par_mod, only: dp
+
+  implicit none
+
+  real(kind=dp) :: xpolg,ypolg,along,slong,clong,rot
+  real :: strcmp(9), xlat, xlong, enx, eny, enz, clat
+
+  along = cspanf( xlong - strcmp(2), -180., 180.)
+  rot = - strcmp(1) * along
+  slong = sin( radpdg * rot )
+  clong = cos( radpdg * rot )
+  xpolg = slong * strcmp(5) + clong * strcmp(6)
+  ypolg = clong * strcmp(5) - slong * strcmp(6)
+  clat = cos(radpdg * xlat)
+  enx = clat * xpolg
+  eny = clat * ypolg
+  enz = sin(radpdg * xlat)
+  return
+end subroutine cpolll
diff --git a/src/cma_cpolxy.f90 b/src/cma_cpolxy.f90
new file mode 100644
index 0000000000000000000000000000000000000000..3c78af136144067beec0e93ce317022f6e62df2a
--- /dev/null
+++ b/src/cma_cpolxy.f90
@@ -0,0 +1,46 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine cpolxy (strcmp, x,y, enx,eny,enz)
+  !*  Written on 11/26/94 by Dr. Albion Taylor  NOAA / OAR / ARL
+
+  use par_mod, only: dp
+
+  implicit none
+
+  real :: strcmp(9) , x, y, enx, eny, enz
+  real(kind=dp) :: xpol,ypol,temp,xi0,eta0,xi,eta,radial
+  real(kind=dp) :: temp2,ymerc,arg,oarg,clat
+
+  xi0 = ( x - strcmp(3) ) * strcmp(7) / rearth
+  eta0 = ( y - strcmp(4) ) * strcmp(7) /rearth
+  xi = xi0 * strcmp(5) - eta0 * strcmp(6)
+  eta = eta0 * strcmp(5) + xi0 * strcmp(6)
+  radial = 2. * eta -  strcmp(1) * (xi*xi + eta*eta)
+  temp = strcmp(1) * radial
+  if (temp .ge. 1.) then
+    enx = 0.
+    eny = 0.
+    enz = sign(1.,strcmp(1))
+    return
+  endif
+  if (abs(temp).lt.1.e-2) then
+    temp2 = (temp / (2. - temp))**2
+    ymerc = radial / (2. - temp) * (1. + temp2 * &
+         (1./3. + temp2 * &
+         (1./5. + temp2 * &
+         (1./7.))))
+  else
+    ymerc = -.5 * log(1. - temp) / strcmp(1)
+  endif
+  arg = exp( ymerc )
+  oarg = 1./arg
+  clat = 2./(arg + oarg)
+  enz = (arg - oarg) * clat /2.
+  temp = clat / sqrt(1. - temp)
+  xpol = - xi * strcmp(1) * temp
+  ypol = (1. - eta * strcmp(1) ) * temp
+  enx = xpol * strcmp(5) + ypol * strcmp(6)
+  eny = ypol * strcmp(5) - xpol * strcmp(6)
+  return
+end subroutine cpolxy
diff --git a/src/cma_cspanf.f90 b/src/cma_cspanf.f90
new file mode 100644
index 0000000000000000000000000000000000000000..1f5b6aed25a89b32dd84293aca3712d6a4026ea2
--- /dev/null
+++ b/src/cma_cspanf.f90
@@ -0,0 +1,34 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+real function cspanf (value, begin, end)
+  !*  Written on 3/31/94 by Dr. Albion Taylor  NOAA / OAR / ARL
+  !* real function cspanf returns a value in the interval (begin,end]
+  !* which is equivalent to value, mod (end - begin).  It is used to
+  !* reduce periodic variables to a standard range.  It adjusts for the
+  !* behavior of the mod function which provides positive results for
+  !* positive input, and negative results for negative input
+  !* input:
+  !*       value - real number to be reduced to the span
+  !*       begin - first value of the span
+  !*       end   - last value of the span
+  !* returns:
+  !*       the reduced value
+  !* examples:
+  !*      along = cspanf(xlong, -180., +180.)
+  !*      dir  = cspanf(angle, 0., 360.)
+
+  implicit none
+
+  real :: first,last, value, begin, end, val
+
+  first = min(begin,end)
+  last = max(begin,end)
+  val = mod( value - first , last - first)
+  if ( val .le. 0.) then
+    cspanf = val + last
+  else
+    cspanf = val + first
+  endif
+  return
+end function cspanf
diff --git a/src/cma_cxy2ll.f90 b/src/cma_cxy2ll.f90
new file mode 100644
index 0000000000000000000000000000000000000000..503e40e4a3d48331f01bc2bb610ec8e7ea43662b
--- /dev/null
+++ b/src/cma_cxy2ll.f90
@@ -0,0 +1,21 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine cxy2ll (strcmp, x,y, xlat,xlong)
+  !*  Written on 3/31/94 by Dr. Albion Taylor  NOAA / OAR / ARL
+
+  use par_mod, only: dp
+
+  implicit none
+
+  real(kind=dp) :: xi0,eta0,xi,eta
+  real :: strcmp(9), x, y, xlat, xlong
+
+  xi0 = ( x - strcmp(3) ) * strcmp(7) / rearth
+  eta0 = ( y - strcmp(4) ) * strcmp(7) /rearth
+  xi = xi0 * strcmp(5) - eta0 * strcmp(6)
+  eta = eta0 * strcmp(5) + xi0 * strcmp(6)
+  call cnxyll(strcmp, xi,eta, xlat,xlong)
+  xlong = cspanf(xlong, -180., 180.)
+  return
+end subroutine cxy2ll
diff --git a/src/cma_eqvlat.f90 b/src/cma_eqvlat.f90
new file mode 100644
index 0000000000000000000000000000000000000000..a0ef12f4200c0e9fabaca9f00c9735b5f7405cdf
--- /dev/null
+++ b/src/cma_eqvlat.f90
@@ -0,0 +1,34 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+real function eqvlat (xlat1,xlat2)
+  !*  Written on 3/31/94 by Dr. Albion Taylor  NOAA / OAR / ARL
+
+  implicit none
+
+  real :: xlat1, xlat2, x, ssind, sinl1, sinl2, al1, al2, tau
+
+  ssind(x) = sin (radpdg*x)
+  sinl1 = ssind (xlat1)
+  sinl2 = ssind (xlat2)
+  if (abs(sinl1 - sinl2) .gt. .001) then
+    al1 = log((1. - sinl1)/(1. - sinl2))
+    al2 = log((1. + sinl1)/(1. + sinl2))
+  else
+  !  Case lat1 near or equal to lat2
+    tau = - (sinl1 - sinl2)/(2. - sinl1 - sinl2)
+    tau = tau*tau
+    al1  = 2. / (2. - sinl1 - sinl2) * (1.    + tau * &
+         (1./3. + tau * &
+         (1./5. + tau * &
+         (1./7.))))
+    tau =   (sinl1 - sinl2)/(2. + sinl1 + sinl2)
+    tau = tau*tau
+    al2  = -2. / (2. + sinl1 + sinl2) * (1.    + tau * &
+         (1./3. + tau * &
+         (1./5. + tau * &
+         (1./7.))))
+  endif
+  eqvlat = asin((al1 + al2) / (al1 - al2))/radpdg
+  return
+end function eqvlat
diff --git a/src/cma_stcm1p.f90 b/src/cma_stcm1p.f90
new file mode 100644
index 0000000000000000000000000000000000000000..827c09a17f11a21dd90fdf78a0fed47a51922594
--- /dev/null
+++ b/src/cma_stcm1p.f90
@@ -0,0 +1,28 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine stcm1p(strcmp, x1,y1, xlat1,xlong1, &
+       xlatg,xlongg, gridsz, orient)
+  !*  Written on 3/31/94 by Dr. Albion Taylor  NOAA / OAR / ARL
+
+  implicit none
+
+  integer :: k
+  real :: strcmp(9), x1, y1, xlat1, xlong1, turn, orient, &
+       xlatg, xlongg, gridsz, x1a, y1a
+
+  do k=3,4
+    strcmp (k) = 0.
+  enddo
+    turn = radpdg * (orient - strcmp(1) * &
+         cspanf(xlongg - strcmp(2), -180., 180.) )
+  strcmp (5) = cos (turn)
+  strcmp (6) = - sin (turn)
+  strcmp (7) = 1.
+  strcmp (7) = gridsz * strcmp(7) &
+       / cgszll(strcmp, xlatg, strcmp(2))
+  call cll2xy (strcmp, xlat1,xlong1, x1a,y1a)
+  strcmp(3) = strcmp(3) + x1 - x1a
+  strcmp(4) = strcmp(4) + y1 - y1a
+  return
+end subroutine stcm1p
diff --git a/src/cma_stcm2p.f90 b/src/cma_stcm2p.f90
new file mode 100644
index 0000000000000000000000000000000000000000..aff2789ab5d927a2c5ab5e150fd0832678ab0f79
--- /dev/null
+++ b/src/cma_stcm2p.f90
@@ -0,0 +1,34 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine stcm2p(strcmp, x1,y1, xlat1,xlong1, &
+       x2,y2, xlat2,xlong2)
+  !*  Written on 3/31/94 by Dr. Albion Taylor  NOAA / OAR / ARL
+
+  implicit none
+
+  real :: strcmp(9), x1, y1, xlat1, xlong1, &
+       x2, y2, xlat2, xlong2
+
+  integer :: k
+  real    :: x1a, y1a, x2a, y2a, den, dena
+
+  do k=3,6
+    strcmp (k) = 0.
+  enddo
+  strcmp (5) = 1.
+  strcmp (7) = 1.
+  call cll2xy (strcmp, xlat1,xlong1, x1a,y1a)
+  call cll2xy (strcmp, xlat2,xlong2, x2a,y2a)
+  den = sqrt( (x1 - x2)**2 + (y1 - y2)**2 )
+  dena = sqrt( (x1a - x2a)**2 + (y1a - y2a)**2 )
+  strcmp(5) = ((x1a - x2a)*(x1 - x2) + (y1a - y2a) * (y1 - y2)) &
+       /den /dena
+  strcmp(6) = ((y1a - y2a)*(x1 - x2) - (x1a - x2a) * (y1 - y2)) &
+       /den /dena
+  strcmp (7) = strcmp(7) * dena / den
+  call cll2xy (strcmp, xlat1,xlong1, x1a,y1a)
+  strcmp(3) = strcmp(3) + x1 - x1a
+  strcmp(4) = strcmp(4) + y1 - y1a
+  return
+end subroutine stcm2p
diff --git a/src/cma_stlmbr.f90 b/src/cma_stlmbr.f90
new file mode 100644
index 0000000000000000000000000000000000000000..0cda4b90a4ec734a41b0182bdcd024540933df66
--- /dev/null
+++ b/src/cma_stlmbr.f90
@@ -0,0 +1,34 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine stlmbr(strcmp, tnglat, xlong)
+  !*  Written on 3/31/94 by Dr. Albion Taylor  NOAA / OAR / ARL
+
+  implicit none
+
+  real :: strcmp(9), tnglat, xlong
+
+  real :: eta, xi
+
+  strcmp(1) = sin(radpdg * tnglat)
+  !*  gamma = sine of the tangent latitude
+  strcmp(2) = cspanf( xlong, -180., +180.)
+  !* lambda_0 = reference longitude
+  strcmp(3) = 0.
+  !* x_0 = x- grid coordinate of origin (xi,eta) = (0.,0.)
+  strcmp(4) = 0.
+  !* y_0 = y-grid coordinate of origin (xi,eta) = (0.,0.)
+  strcmp(5) = 1.
+  !* Cosine of rotation angle from xi,eta to x,y
+  strcmp(6) = 0.
+  !* Sine of rotation angle from xi,eta to x,y
+  strcmp(7) = rearth
+  !* Gridsize in kilometers at the equator
+  call cnllxy(strcmp, 89.,xlong, xi,eta)
+  strcmp(8) = 2. * eta - strcmp(1) * eta * eta
+  !* Radial coordinate for 1 degree from north pole
+  call cnllxy(strcmp, -89.,xlong, xi,eta)
+  strcmp(9) = 2. * eta - strcmp(1) * eta * eta
+  !* Radial coordinate for 1 degree from south pole
+  return
+end subroutine stlmbr
diff --git a/src/cmapf_mod.f90 b/src/cmapf_mod.f90
index b57e8059207f6e1317894039fb515c57c01ba487..9bb0316566201072e9b04f6a0acfc419302c3334 100644
--- a/src/cmapf_mod.f90
+++ b/src/cmapf_mod.f90
@@ -21,616 +21,39 @@ module cmapf_mod
 
 contains
 
-subroutine cc2gll (strcmp, xlat,xlong, ue,vn, ug,vg)
-  !*  Written on 3/31/94 by Dr. Albion Taylor  NOAA / OAR / ARL
+#include "cma_cc2gll.f90"
 
-  use par_mod, only: dp
-
-  implicit none
-
-  real :: strcmp(9), xlat, xlong, ue, vn, ug, vg
-
-  real(kind=dp) :: xpolg,ypolg,along,slong,clong,rot
-
-  along = cspanf( xlong - strcmp(2), -180., 180.)
-  if (xlat.gt.89.985) then
-  !*  North polar meteorological orientation: "north" along prime meridian
-    rot = - strcmp(1) * along + xlong - 180.
-  elseif (xlat.lt.-89.985) then
-  !*  South polar meteorological orientation: "north" along prime meridian
-    rot = - strcmp(1) * along - xlong
-  else
-    rot = - strcmp(1) * along
-  endif
-  slong = sin( radpdg * rot )
-  clong = cos( radpdg * rot )
-  xpolg = slong * strcmp(5) + clong * strcmp(6)
-  ypolg = clong * strcmp(5) - slong * strcmp(6)
-  ug = ypolg * ue + xpolg * vn
-  vg = ypolg * vn - xpolg * ue
-  return
-end subroutine cc2gll
-
-subroutine ccrvll (strcmp, xlat,xlong, gx,gy)
-  !*  Written on 9/20/94 by Dr. Albion Taylor  NOAA / OAR / ARL
-
-  use par_mod, only: dp
-
-  implicit none
-
-  real(kind=dp) :: xpolg,ypolg,temp,along,slong,clong,ctemp, curv
-  real :: strcmp(9), xlat, xlong, gx, gy
-
-  along = cspanf( xlong - strcmp(2), -180., 180.)
-  slong = sin( radpdg * strcmp(1) * along)
-  clong = cos( radpdg * strcmp(1) * along)
-  xpolg = - slong * strcmp(5) + clong * strcmp(6)
-  ypolg = clong * strcmp(5) + slong * strcmp(6)
-  temp = sin(radpdg * xlat)
-  ctemp = cos(radpdg * xlat)
-  curv = (strcmp(1) - temp) / ctemp / rearth
-  gx = curv * xpolg
-  gy = curv * ypolg
-  return
-end subroutine ccrvll
-
-subroutine ccrvxy (strcmp, x,y, gx,gy)
-  !*  Written on 9/20/94 by Dr. Albion Taylor  NOAA / OAR / ARL
-
-  use par_mod, only: dp
-
-  implicit none
-
-  real :: strcmp(9), x, y, gx, gy
-  real(kind=dp) :: xpolg,ypolg,temp,ymerc,efact,curv
-
-  temp = strcmp(1) * strcmp(7) /rearth
-  xpolg = strcmp(6) + temp * (strcmp(3) - x)
-  ypolg = strcmp(5) + temp * (strcmp(4) - y)
-  temp = sqrt ( xpolg ** 2 + ypolg ** 2 )
-  if (temp.gt.0.) then
-    ymerc = - log( temp) /strcmp(1)
-    efact = exp(ymerc)
-    curv = ( (strcmp(1) - 1.d0) * efact + &
-         (strcmp(1) + 1.d0) / efact ) &
-         * .5d0 / rearth
-    gx = xpolg * curv / temp
-    gy = ypolg * curv / temp
-  else
-    if (abs(strcmp(1)) .eq. 1.) then
-      gx = 0.
-      gy = 0.
-    else
-      gx = 1./rearth
-      gy = 1./rearth
-    endif
-  endif
-  return
-end subroutine ccrvxy
-
-subroutine cg2cll (strcmp, xlat,xlong, ug,vg, ue,vn)
-  !*  Written on 3/31/94 by Dr. Albion Taylor  NOAA / OAR / ARL
-
-  use par_mod, only: dp
-
-  implicit none
-
-  real(kind=dp) :: xpolg,ypolg,along,slong,clong,rot
-  real :: strcmp(9), xlat, xlong, ug, vg, ue, vn
-
-  along = cspanf( xlong - strcmp(2), -180., 180.)
-  if (xlat.gt.89.985) then
-  !*  North polar meteorological orientation: "north" along prime meridian
-    rot = - strcmp(1) * along + xlong - 180.
-  elseif (xlat.lt.-89.985) then
-  !*  South polar meteorological orientation: "north" along prime meridian
-    rot = - strcmp(1) * along - xlong
-  else
-    rot = - strcmp(1) * along
-  endif
-  slong = sin( radpdg * rot )
-  clong = cos( radpdg * rot )
-  xpolg = slong * strcmp(5) + clong * strcmp(6)
-  ypolg = clong * strcmp(5) - slong * strcmp(6)
-  ue = ypolg * ug - xpolg * vg
-  vn = ypolg * vg + xpolg * ug
-  return
-end subroutine cg2cll
-
-subroutine cg2cxy (strcmp, x,y, ug,vg, ue,vn)
-  !*  Written on 3/31/94 by Dr. Albion Taylor  NOAA / OAR / ARL
-
-  use par_mod, only: dp
-
-  implicit none
-
-  real :: strcmp(9) , x, y, ug, vg, ue, vn
-
-  real :: clong, radial, rot, slong, xlat, xlong
-  real(kind=dp) :: xpolg,ypolg,temp,xi0,eta0,xi,eta
-
-  xi0 = ( x - strcmp(3) ) * strcmp(7) / rearth
-  eta0 = ( y - strcmp(4) ) * strcmp(7) /rearth
-  xi = xi0 * strcmp(5) - eta0 * strcmp(6)
-  eta = eta0 * strcmp(5) + xi0 * strcmp(6)
-  radial = 2. * eta - strcmp(1) * (xi*xi + eta*eta)
-  if (radial.gt.strcmp(8)) then
-  !*  Case north of 89 degrees. Meteorological wind direction definition
-  !*      changes.
-    call cnxyll(strcmp, xi,eta, xlat,xlong)
-  !*  North polar meteorological orientation: "north" along prime meridian
-    rot = strcmp(1) * (xlong - strcmp(2)) - xlong - 180.
-    slong = - sin( radpdg * rot )
-    clong = cos( radpdg * rot )
-    xpolg = slong * strcmp(5) + clong * strcmp(6)
-    ypolg = clong * strcmp(5) - slong * strcmp(6)
-  else if (radial.lt.strcmp(9)) then
-  !*  Case south of -89 degrees. Meteorological wind direction definition
-  !*      changes.
-    call cnxyll(strcmp, xi,eta, xlat,xlong)
-  !*  South polar meteorological orientation: "north" along prime meridian
-    rot = strcmp(1) * (xlong - strcmp(2)) + xlong
-    slong = - sin( radpdg * rot )
-    clong = cos( radpdg * rot )
-    xpolg = slong * strcmp(5) + clong * strcmp(6)
-    ypolg = clong * strcmp(5) - slong * strcmp(6)
-  else
-  !* Normal case. Meteorological direction of wind related to true north.
-    xpolg = strcmp(6) - strcmp(1) * xi0
-    ypolg = strcmp(5) - strcmp(1) * eta0
-    temp = sqrt ( xpolg ** 2 + ypolg ** 2 )
-    xpolg = xpolg / temp
-    ypolg = ypolg / temp
-  end if
-  ue = ( ypolg * ug - xpolg * vg )
-  vn = ( ypolg * vg + xpolg * ug )
-  return
-end subroutine cg2cxy
-
-real function cgszll (strcmp, xlat,xlong)
-  !*  Written on 3/31/94 by Dr. Albion Taylor  NOAA / OAR / ARL
-
-  use par_mod, only: dp
-
-  implicit none
-
-  real :: strcmp(9), xlat, xlong
-
-  real(kind=dp) :: slat,ymerc,efact
-
-  if (xlat .gt. 89.985) then
-  !* Close to north pole
-    if (strcmp(1) .gt. 0.9999) then
-  !* and to gamma == 1.
-      cgszll = 2. * strcmp(7)
-      return
-    endif
-    efact = cos(radpdg * xlat)
-    if (efact .le. 0.) then
-      cgszll = 0.
-      return
-    else
-      ymerc = - log( efact /(1. + sin(radpdg * xlat)))
-    endif
-  else if (xlat .lt. -89.985) then
-  !* Close to south pole
-    if (strcmp(1) .lt. -0.9999) then
-  !* and to gamma == -1.0
-      cgszll = 2. * strcmp(7)
-      return
-    endif
-    efact = cos(radpdg * xlat)
-    if (efact .le. 0.) then
-      cgszll = 0.
-      return
-    else
-      ymerc = log( efact /(1. - sin(radpdg * xlat)))
-    endif
-  else
-  slat = sin(radpdg * xlat)
-  ymerc = log((1. + slat) / (1. - slat))/2.
-  !efact = exp(ymerc)
-  !cgszll = 2. * strcmp(7) * exp (strcmp(1) * ymerc)
-  !c             / (efact + 1./efact)
-  endif
-  cgszll = strcmp(7) * cos(radpdg * xlat) * exp(strcmp(1) *ymerc)
-  return
-end function cgszll
-
-real function cgszxy (strcmp, x,y)
-  !*  Written on 3/31/94 by Dr. Albion Taylor  NOAA / OAR / ARL
-
-  use par_mod, only: dp
-
-  implicit none
-
-  real :: strcmp(9) , x, y
-  real(kind=dp) :: ymerc,efact, radial, temp
-  real(kind=dp) :: xi0,eta0,xi,eta
-
-
-  xi0 = ( x - strcmp(3) ) * strcmp(7) / rearth
-  eta0 = ( y - strcmp(4) ) * strcmp(7) /rearth
-  xi = xi0 * strcmp(5) - eta0 * strcmp(6)
-  eta = eta0 * strcmp(5) + xi0 * strcmp(6)
-  radial = 2. * eta - strcmp(1) * (xi*xi + eta*eta)
-  efact = strcmp(1) * radial
-  if (efact .gt. almst1) then
-    if (strcmp(1).gt.almst1) then
-      cgszxy = 2. * strcmp(7)
-    else
-      cgszxy = 0.
-    endif
-    return
-  endif
-  if (abs(efact) .lt. 1.e-2) then
-    temp = (efact / (2. - efact) )**2
-    ymerc = radial / (2. - efact) * (1.    + temp * &
-         (1./3. + temp * &
-         (1./5. + temp * &
-         (1./7. ))))
-  else
-    ymerc = - log( 1. - efact ) /2. /strcmp(1)
-  endif
-  if (ymerc .gt. 6.) then
-    if (strcmp(1) .gt. almst1) then
-      cgszxy = 2. * strcmp(7)
-    else
-      cgszxy = 0.
-    endif
-  else if (ymerc .lt. -6.) then
-    if (strcmp(1) .lt. -almst1) then
-      cgszxy = 2. * strcmp(7)
-    else
-      cgszxy = 0.
-    endif
-  else
-    efact = exp(ymerc)
-    cgszxy = 2. * strcmp(7) * exp (strcmp(1) * ymerc) &
-         / (efact + 1./efact)
-  endif
-  return
-end function cgszxy
-
-subroutine cll2xy (strcmp, xlat,xlong, x,y)
-  !*  Written on 3/31/94 by Dr. Albion Taylor  NOAA / OAR / ARL
+#include "cma_ccrvll.f90"
 
-  implicit none
-
-  real :: strcmp(9) , xlat, xlong, x, y, xi, eta
-
-  call cnllxy(strcmp, xlat,xlong, xi,eta)
-  x = strcmp(3) + rearth/strcmp(7) * &
-       (xi * strcmp(5) + eta * strcmp(6) )
-  y = strcmp(4) + rearth/strcmp(7) * &
-       (eta * strcmp(5) - xi * strcmp(6) )
-  return
-end subroutine cll2xy
-
-subroutine cnllxy (strcmp, xlat,xlong, xi,eta)
-  !*  Written on 3/31/94 by Dr. Albion Taylor  NOAA / OAR / ARL
-  !  main transformation routine from latitude-longitude to
-  !  canonical (equator-centered, radian unit) coordinates
-
-  use par_mod, only: dp
-
-  implicit none
-
-  real :: strcmp(9), xlat, xlong, xi, eta, &
-       gdlong, sndgam, csdgam, rhog1
-  real(kind=dp) :: gamma
-  real(kind=dp) :: dlong,dlat,slat,mercy,gmercy
-
-  gamma = strcmp(1)
-  dlat = xlat
-  dlong = cspanf(xlong - strcmp(2), -180., 180.)
-  dlong = dlong * radpdg
-  gdlong = gamma * dlong
-  if (abs(gdlong) .lt. .01) then
-  !  Code for gamma small or zero.  This avoids round-off error or divide-
-  !  by zero in the case of mercator or near-mercator projections.
-    gdlong = gdlong * gdlong
-    sndgam = dlong * (1. - 1./6. * gdlong * &
-         (1. - 1./20. * gdlong * &
-         (1. - 1./42. * gdlong )))
-    csdgam = dlong * dlong * .5 * &
-         (1. - 1./12. * gdlong * &
-         (1. - 1./30. * gdlong * &
-         (1. - 1./56. * gdlong )))
-  else
-  ! Code for moderate values of gamma
-    sndgam = sin (gdlong) /gamma
-    csdgam = (1. - cos(gdlong) )/gamma /gamma
-  endif
-  slat = sin(radpdg * dlat)
-  if ((slat .ge. almst1) .or. (slat .le. -almst1)) then
-    eta = 1./strcmp(1)
-    xi = 0.
-    return
-  endif
-  mercy = .5 * log( (1. + slat) / (1. - slat) )
-  gmercy = gamma * mercy
-  if (abs(gmercy) .lt. .001) then
-  !  Code for gamma small or zero.  This avoids round-off error or divide-
-  !  by zero in the case of mercator or near-mercator projections.
-    rhog1 = mercy * (1. - .5 * gmercy * &
-         (1. - 1./3. * gmercy * &
-         (1. - 1./4. * gmercy ) ) )
-  else
-  ! Code for moderate values of gamma
-    rhog1 = (1. - exp(-gmercy)) / gamma
-  endif
-  eta = rhog1 + (1. - gamma * rhog1) * gamma * csdgam
-  xi = (1. - gamma * rhog1 ) * sndgam
-end subroutine cnllxy
-
-subroutine cnxyll (strcmp, xi,eta, xlat,xlong)
-  !*  Written on 3/31/94 by Dr. Albion Taylor  NOAA / OAR / ARL
-  !  main transformation routine from canonical (equator-centered,
-  !  radian unit) coordinates
-
-  use par_mod, only: dp
-
-  implicit none
-
-  real :: strcmp(9), xlat, xlong, odist
-  real(kind=dp) :: gamma,temp,arg1,arg2,ymerc,along,gxi,cgeta
-  real(kind=dp) :: xi,eta
-
-  gamma = strcmp(1)
-  !  Calculate equivalent mercator coordinate
-  odist = xi*xi + eta*eta
-  arg2 = 2. * eta - gamma * (xi*xi + eta*eta)
-  arg1 = gamma * arg2
-  ! Change by A. Stohl to avoid problems close to the poles
-  ! if (arg1 .ge. almst1) then
-  !  distance to north (or south) pole is zero (or imaginary ;) )
-  ! xlat = sign(90.,strcmp(1))
-  ! xlong = strcmp(2)
-  ! return
-  ! endif
-  if (abs(arg1) .lt. .01) then
-  !  Code for gamma small or zero.  This avoids round-off error or divide-
-  !  by zero in the case of mercator or near-mercator projections.
-    temp = (arg1 / (2. - arg1) )**2
-    ymerc = arg2 / (2. - arg1) * (1.    + temp * &
-         (1./3. + temp * &
-         (1./5. + temp * &
-         (1./7. ))))
-  else
-  ! Code for moderate values of gamma
-    ymerc = - log ( 1. - arg1 ) /2. / gamma
-  endif
-  ! Convert ymerc to latitude
-  temp = exp( - abs(ymerc) )
-  xlat = sign(atan2((1. - temp) * (1. + temp), 2. * temp), ymerc)
-  ! Find longitudes
-  gxi = gamma*xi
-  cgeta = 1. - gamma * eta
-  if ( abs(gxi) .lt. .01*cgeta ) then
-  !  Code for gamma small or zero.  This avoids round-off error or divide-
-  !  by zero in the case of mercator or near-mercator projections.
-    temp = ( gxi /cgeta )**2
-    along = xi / cgeta * (1.    - temp * &
-         (1./3. - temp * &
-         (1./5. - temp * &
-         (1./7.   ))))
-  else
-  ! Code for moderate values of gamma
-    along = atan2( gxi, cgeta) / gamma
-  endif
-  xlong = sngl(strcmp(2) + dgprad * along)
-  xlat = xlat * dgprad
-  return
-end subroutine cnxyll
-
-subroutine cpolll (strcmp, xlat,xlong, enx,eny,enz)
-  !*  Written on 11/23/94 by Dr. Albion Taylor  NOAA / OAR / ARL
-
-  use par_mod, only: dp
-
-  implicit none
+#include "cma_ccrvxy.f90"
 
-  real(kind=dp) :: xpolg,ypolg,along,slong,clong,rot
-  real :: strcmp(9), xlat, xlong, enx, eny, enz, clat
-
-  along = cspanf( xlong - strcmp(2), -180., 180.)
-  rot = - strcmp(1) * along
-  slong = sin( radpdg * rot )
-  clong = cos( radpdg * rot )
-  xpolg = slong * strcmp(5) + clong * strcmp(6)
-  ypolg = clong * strcmp(5) - slong * strcmp(6)
-  clat = cos(radpdg * xlat)
-  enx = clat * xpolg
-  eny = clat * ypolg
-  enz = sin(radpdg * xlat)
-  return
-end subroutine cpolll
-
-subroutine cpolxy (strcmp, x,y, enx,eny,enz)
-  !*  Written on 11/26/94 by Dr. Albion Taylor  NOAA / OAR / ARL
+#include "cma_cg2cll.f90"
 
-  use par_mod, only: dp
+#include "cma_cg2cxy.f90"
 
-  implicit none
+#include "cma_cgszll.f90"
 
-  real :: strcmp(9) , x, y, enx, eny, enz
-  real(kind=dp) :: xpol,ypol,temp,xi0,eta0,xi,eta,radial
-  real(kind=dp) :: temp2,ymerc,arg,oarg,clat
-
-  xi0 = ( x - strcmp(3) ) * strcmp(7) / rearth
-  eta0 = ( y - strcmp(4) ) * strcmp(7) /rearth
-  xi = xi0 * strcmp(5) - eta0 * strcmp(6)
-  eta = eta0 * strcmp(5) + xi0 * strcmp(6)
-  radial = 2. * eta -  strcmp(1) * (xi*xi + eta*eta)
-  temp = strcmp(1) * radial
-  if (temp .ge. 1.) then
-    enx = 0.
-    eny = 0.
-    enz = sign(1.,strcmp(1))
-    return
-  endif
-  if (abs(temp).lt.1.e-2) then
-    temp2 = (temp / (2. - temp))**2
-    ymerc = radial / (2. - temp) * (1. + temp2 * &
-         (1./3. + temp2 * &
-         (1./5. + temp2 * &
-         (1./7.))))
-  else
-    ymerc = -.5 * log(1. - temp) / strcmp(1)
-  endif
-  arg = exp( ymerc )
-  oarg = 1./arg
-  clat = 2./(arg + oarg)
-  enz = (arg - oarg) * clat /2.
-  temp = clat / sqrt(1. - temp)
-  xpol = - xi * strcmp(1) * temp
-  ypol = (1. - eta * strcmp(1) ) * temp
-  enx = xpol * strcmp(5) + ypol * strcmp(6)
-  eny = ypol * strcmp(5) - xpol * strcmp(6)
-  return
-end subroutine cpolxy
-
-real function cspanf (value, begin, end)
-  !*  Written on 3/31/94 by Dr. Albion Taylor  NOAA / OAR / ARL
-  !* real function cspanf returns a value in the interval (begin,end]
-  !* which is equivalent to value, mod (end - begin).  It is used to
-  !* reduce periodic variables to a standard range.  It adjusts for the
-  !* behavior of the mod function which provides positive results for
-  !* positive input, and negative results for negative input
-  !* input:
-  !*       value - real number to be reduced to the span
-  !*       begin - first value of the span
-  !*       end   - last value of the span
-  !* returns:
-  !*       the reduced value
-  !* examples:
-  !*      along = cspanf(xlong, -180., +180.)
-  !*      dir  = cspanf(angle, 0., 360.)
+#include "cma_cgszxy.f90"
 
-  implicit none
+#include "cma_cll2xy.f90"
 
-  real :: first,last, value, begin, end, val
+#include "cma_cnllxy.f90"
 
-  first = min(begin,end)
-  last = max(begin,end)
-  val = mod( value - first , last - first)
-  if ( val .le. 0.) then
-    cspanf = val + last
-  else
-    cspanf = val + first
-  endif
-  return
-end function cspanf
+#include "cma_cnxyll.f90"
 
-subroutine cxy2ll (strcmp, x,y, xlat,xlong)
-  !*  Written on 3/31/94 by Dr. Albion Taylor  NOAA / OAR / ARL
+#include "cma_cpolll.f90"
 
-  use par_mod, only: dp
+#include "cma_cpolxy.f90"
 
-  implicit none
-
-  real(kind=dp) :: xi0,eta0,xi,eta
-  real :: strcmp(9), x, y, xlat, xlong
+#include "cma_cspanf.f90"
 
-  xi0 = ( x - strcmp(3) ) * strcmp(7) / rearth
-  eta0 = ( y - strcmp(4) ) * strcmp(7) /rearth
-  xi = xi0 * strcmp(5) - eta0 * strcmp(6)
-  eta = eta0 * strcmp(5) + xi0 * strcmp(6)
-  call cnxyll(strcmp, xi,eta, xlat,xlong)
-  xlong = cspanf(xlong, -180., 180.)
-  return
-end subroutine cxy2ll
+#include "cma_cxy2ll.f90"
 
-real function eqvlat (xlat1,xlat2)
-  !*  Written on 3/31/94 by Dr. Albion Taylor  NOAA / OAR / ARL
+#include "cma_eqvlat.f90"
 
-  implicit none
+#include "cma_stcm1p.f90"
 
-  real :: xlat1, xlat2, x, ssind, sinl1, sinl2, al1, al2, tau
-
-  ssind(x) = sin (radpdg*x)
-  sinl1 = ssind (xlat1)
-  sinl2 = ssind (xlat2)
-  if (abs(sinl1 - sinl2) .gt. .001) then
-    al1 = log((1. - sinl1)/(1. - sinl2))
-    al2 = log((1. + sinl1)/(1. + sinl2))
-  else
-  !  Case lat1 near or equal to lat2
-    tau = - (sinl1 - sinl2)/(2. - sinl1 - sinl2)
-    tau = tau*tau
-    al1  = 2. / (2. - sinl1 - sinl2) * (1.    + tau * &
-         (1./3. + tau * &
-         (1./5. + tau * &
-         (1./7.))))
-    tau =   (sinl1 - sinl2)/(2. + sinl1 + sinl2)
-    tau = tau*tau
-    al2  = -2. / (2. + sinl1 + sinl2) * (1.    + tau * &
-         (1./3. + tau * &
-         (1./5. + tau * &
-         (1./7.))))
-  endif
-  eqvlat = asin((al1 + al2) / (al1 - al2))/radpdg
-  return
-end function eqvlat
-
-subroutine stcm1p(strcmp, x1,y1, xlat1,xlong1, &
-       xlatg,xlongg, gridsz, orient)
-  !*  Written on 3/31/94 by Dr. Albion Taylor  NOAA / OAR / ARL
-
-  implicit none
-
-  integer :: k
-  real :: strcmp(9), x1, y1, xlat1, xlong1, turn, orient, &
-       xlatg, xlongg, gridsz, x1a, y1a
-
-  do k=3,4
-    strcmp (k) = 0.
-  enddo
-    turn = radpdg * (orient - strcmp(1) * &
-         cspanf(xlongg - strcmp(2), -180., 180.) )
-  strcmp (5) = cos (turn)
-  strcmp (6) = - sin (turn)
-  strcmp (7) = 1.
-  strcmp (7) = gridsz * strcmp(7) &
-       / cgszll(strcmp, xlatg, strcmp(2))
-  call cll2xy (strcmp, xlat1,xlong1, x1a,y1a)
-  strcmp(3) = strcmp(3) + x1 - x1a
-  strcmp(4) = strcmp(4) + y1 - y1a
-  return
-end subroutine stcm1p
-
-subroutine stcm2p(strcmp, x1,y1, xlat1,xlong1, &
-       x2,y2, xlat2,xlong2)
-  !*  Written on 3/31/94 by Dr. Albion Taylor  NOAA / OAR / ARL
-
-  implicit none
-
-  real :: strcmp(9), x1, y1, xlat1, xlong1, &
-       x2, y2, xlat2, xlong2
-
-  integer :: k
-  real    :: x1a, y1a, x2a, y2a, den, dena
-
-  do k=3,6
-    strcmp (k) = 0.
-  enddo
-  strcmp (5) = 1.
-  strcmp (7) = 1.
-  call cll2xy (strcmp, xlat1,xlong1, x1a,y1a)
-  call cll2xy (strcmp, xlat2,xlong2, x2a,y2a)
-  den = sqrt( (x1 - x2)**2 + (y1 - y2)**2 )
-  dena = sqrt( (x1a - x2a)**2 + (y1a - y2a)**2 )
-  strcmp(5) = ((x1a - x2a)*(x1 - x2) + (y1a - y2a) * (y1 - y2)) &
-       /den /dena
-  strcmp(6) = ((y1a - y2a)*(x1 - x2) - (x1a - x2a) * (y1 - y2)) &
-       /den /dena
-  strcmp (7) = strcmp(7) * dena / den
-  call cll2xy (strcmp, xlat1,xlong1, x1a,y1a)
-  strcmp(3) = strcmp(3) + x1 - x1a
-  strcmp(4) = strcmp(4) + y1 - y1a
-  return
-end subroutine stcm2p
+#include "cma_stcm2p.f90"
 
 !*  General conformal map routines for meteorological modelers
 !*  written on 3/31/94 by
@@ -781,36 +204,6 @@ end subroutine stcm2p
 !*    the proper range.  It adds to value whatever multiple of
 !*    (end - begin) is needed to return a number begin < cspanf <= end
 
-subroutine stlmbr(strcmp, tnglat, xlong)
-  !*  Written on 3/31/94 by Dr. Albion Taylor  NOAA / OAR / ARL
-
-  implicit none
-
-  real :: strcmp(9), tnglat, xlong
-
-  real :: eta, xi
-
-  strcmp(1) = sin(radpdg * tnglat)
-  !*  gamma = sine of the tangent latitude
-  strcmp(2) = cspanf( xlong, -180., +180.)
-  !* lambda_0 = reference longitude
-  strcmp(3) = 0.
-  !* x_0 = x- grid coordinate of origin (xi,eta) = (0.,0.)
-  strcmp(4) = 0.
-  !* y_0 = y-grid coordinate of origin (xi,eta) = (0.,0.)
-  strcmp(5) = 1.
-  !* Cosine of rotation angle from xi,eta to x,y
-  strcmp(6) = 0.
-  !* Sine of rotation angle from xi,eta to x,y
-  strcmp(7) = rearth
-  !* Gridsize in kilometers at the equator
-  call cnllxy(strcmp, 89.,xlong, xi,eta)
-  strcmp(8) = 2. * eta - strcmp(1) * eta * eta
-  !* Radial coordinate for 1 degree from north pole
-  call cnllxy(strcmp, -89.,xlong, xi,eta)
-  strcmp(9) = 2. * eta - strcmp(1) * eta * eta
-  !* Radial coordinate for 1 degree from south pole
-  return
-end subroutine stlmbr
+#include "cma_stlmbr.f90"
 
 end module cmapf_mod
diff --git a/src/com_mod.f90 b/src/com_mod.f90
index 29c51cddfb6742a64a1494f872030dada862334d..0021a80a98edff390d0d58bc4c8638e973e0fe22 100644
--- a/src/com_mod.f90
+++ b/src/com_mod.f90
@@ -40,7 +40,7 @@ module com_mod
   integer :: length(numpath+2*maxnests)
   character(len=256) :: pathfile, flexversion, flexversion_major, arg1, arg2
   character(len=256) :: ohfields_path
-  
+
   ! path                    path names needed for trajectory model
   ! length                  length of path names needed for trajectory model
   ! pathfile                file where pathnames are stored
@@ -165,7 +165,7 @@ module com_mod
   logical :: lsettling=.true.
 
   logical,dimension(maxnests) :: readclouds_nest, sumclouds_nest
-  
+
 
 !NIK 16.02.2015
   integer(selected_int_kind(16)), dimension(maxspec) :: tot_blc_count=0, &
@@ -265,7 +265,7 @@ module com_mod
   ! Variables associated with the ECMWF meteorological input data ("wind fields")
   !******************************************************************************
 
-  integer :: memtime(numwfmem),memind(3),lwindinterv ! eso: or memind(numwfmem) 
+  integer :: memtime(numwfmem),memind(3),lwindinterv ! eso: or memind(numwfmem)
 
   ! memtime [s]             validation times of wind fields in memory
   ! memind                  pointer to wind field, in order to avoid shuffling
@@ -419,7 +419,7 @@ module com_mod
   ! xtra1,ytra1,ztra1       spatial positions of the particles
   ! xmass1 [kg]             particle masses
   ! xscav_frac1             fraction of particle masse which has been scavenged at receptor
- 
+
 
 
   !*******************************************************
@@ -453,10 +453,10 @@ module com_mod
   real :: rannumb(maxrand+2)
 
   ! rannumb                 field of normally distributed random numbers
-  
+
   !********************************************************************
-  ! variables to control stability of CBL scheme under variation 
-  ! of statistics in time and space 
+  ! variables to control stability of CBL scheme under variation
+  ! of statistics in time and space
   !********************************************************************
   integer :: sum_nan_count(3600),maxtl=1200
   integer,allocatable,dimension(:) :: nan_count
@@ -465,12 +465,12 @@ module com_mod
   !********************************************************************
   ! variables to test well-mixed state of CBL scheme not to be included in final release
   !********************************************************************
-  real :: well_mixed_vector(50),h_well,well_mixed_norm,avg_air_dens(50),avg_ol,avg_wst,avg_h 
+  real :: well_mixed_vector(50),h_well,well_mixed_norm,avg_air_dens(50),avg_ol,avg_wst,avg_h
   ! modified by mc to test well-mixed for cbl
 
   !********************
   ! Verbosity, testing flags, namelist I/O
-  !********************   
+  !********************
   logical :: debug_mode=.false.
   integer :: verbosity=0
   integer :: info_flag=0
@@ -484,13 +484,13 @@ module com_mod
   !*****************************************************************
   integer :: mpi_mode=0 ! .gt. 0 if running MPI version
   logical :: lroot=.true. ! true if serial version, or if MPI .and. root process
-  
+
   logical, parameter :: interpolhmix=.false. ! true if the hmix shall be interpolated
   logical, parameter :: turboff=.false.       ! true if the turbulence shall be switched off
 
   integer :: numthreads,numthreads_grid  ! number of available threads in parallel sections
   !integer :: nclassunc2, nrecclunc, ngriclunc
-  
+
   !*********************************************************
   !LB 04.05.2021, simple timing of IO and total running time
   !*********************************************************
@@ -499,28 +499,6 @@ module com_mod
 
 
 contains
-  subroutine mpi_alloc_part(nmpart)
-  !*******************************************************************************    
-  ! Dynamic allocation of arrays
-  !
-  ! For FLEXPART version 9.2 and earlier these arrays were statically declared
-  ! with size maxpart. This function is introduced so that the MPI version
-  ! can declare these arrays with smaller size ("maxpart per process"), while
-  ! the serial version allocate at run-time with size maxpart 
-  !
-  !*******************************************************************************
-    implicit none 
-
-    integer, intent(in) :: nmpart ! maximum number of particles (per process)
-
-    if (ipout.eq.3) then
-      allocate(npart_av(nmpart),part_av_cartx(nmpart),part_av_carty(nmpart),&
-           & part_av_cartz(nmpart),part_av_z(nmpart),part_av_topo(nmpart))
-      allocate(part_av_pv(nmpart),part_av_qv(nmpart),part_av_tt(nmpart),&
-           & part_av_rho(nmpart),part_av_tro(nmpart),part_av_hmix(nmpart))
-      allocate(part_av_uu(nmpart),part_av_vv(nmpart),part_av_energy(nmpart))
-    end if
-
-  end subroutine mpi_alloc_part
+#include "com_mpi_alloc_part.f90"
 
 end module com_mod
diff --git a/src/com_mpi_alloc_part.f90 b/src/com_mpi_alloc_part.f90
new file mode 100644
index 0000000000000000000000000000000000000000..174ffa72bf021a6a60faf63a66063b12eefcc9ae
--- /dev/null
+++ b/src/com_mpi_alloc_part.f90
@@ -0,0 +1,26 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+  subroutine mpi_alloc_part(nmpart)
+  !*******************************************************************************
+  ! Dynamic allocation of arrays
+  !
+  ! For FLEXPART version 9.2 and earlier these arrays were statically declared
+  ! with size maxpart. This function is introduced so that the MPI version
+  ! can declare these arrays with smaller size ("maxpart per process"), while
+  ! the serial version allocate at run-time with size maxpart
+  !
+  !*******************************************************************************
+    implicit none
+
+    integer, intent(in) :: nmpart ! maximum number of particles (per process)
+
+    if (ipout.eq.3) then
+      allocate(npart_av(nmpart),part_av_cartx(nmpart),part_av_carty(nmpart),&
+           & part_av_cartz(nmpart),part_av_z(nmpart),part_av_topo(nmpart))
+      allocate(part_av_pv(nmpart),part_av_qv(nmpart),part_av_tt(nmpart),&
+           & part_av_rho(nmpart),part_av_tro(nmpart),part_av_hmix(nmpart))
+      allocate(part_av_uu(nmpart),part_av_vv(nmpart),part_av_energy(nmpart))
+    end if
+
+  end subroutine mpi_alloc_part
diff --git a/src/con_CONVECT.f90 b/src/con_CONVECT.f90
new file mode 100644
index 0000000000000000000000000000000000000000..501d4005720d74200875c7def1e5eacb2e3afa2c
--- /dev/null
+++ b/src/con_CONVECT.f90
@@ -0,0 +1,1023 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+  SUBROUTINE CONVECT( &
+         ND,  NL,   DELT, IFLAG, &
+         PRECIP, WD,   TPRIME, QPRIME, CBMF    )
+  !
+  !-cv *************************************************************************
+  !-cv C. Forster, November 2003 - May 2004:
+  !-cv
+  !-cv The subroutine has been downloaded from Kerry Emanuel's homepage,
+  !-cv where further infos on the convection scheme can be found
+  !-cv http://www-paoc.mit.edu/~emanuel/home.html
+  !-cv
+  !-cv The following changes have been made to integrate this subroutine
+  !-cv into FLEXPART
+  !-cv
+  !-cv Putting most of the variables in a new common block
+  !-cv renaming eps to eps0 because there is some eps already in includepar
+  !-cv
+  !-cv removing the arrays U,V,TRA and related arrays
+  !-cv
+  !-cv renaming the original arrays T,Q,QS,P,PH to
+  !-cv TCONV,QCONV,QSCONV,PCONV_HPA,PHCONV_HPA
+  !-cv
+  !-cv Initialization of variables has been put into parameter statements
+  !-cv instead of assignment of values at each call, in order to save
+  !-cv computation time.
+  !***************************************************************************
+  !
+  !-----------------------------------------------------------------------------
+  !    *** On input:      ***
+  !
+  !T:   Array of absolute temperature (K) of dimension ND, with first
+  !      index corresponding to lowest model level. Note that this array
+  !      will be altered by the subroutine if dry convective adjustment
+  !      occurs and if IPBL is not equal to 0.
+  !
+  !Q:   Array of specific humidity (gm/gm) of dimension ND, with first
+  !       index corresponding to lowest model level. Must be defined
+  !       at same grid levels as T. Note that this array will be altered
+  !       if dry convective adjustment occurs and if IPBL is not equal to 0.
+  !
+  !QS:  Array of saturation specific humidity of dimension ND, with first
+  !       index corresponding to lowest model level. Must be defined
+  !       at same grid levels as T. Note that this array will be altered
+  !       if dry convective adjustment occurs and if IPBL is not equal to 0.
+  !
+  !U:   Array of zonal wind velocity (m/s) of dimension ND, witth first
+  !       index corresponding with the lowest model level. Defined at
+  !       same levels as T. Note that this array will be altered if
+  !       dry convective adjustment occurs and if IPBL is not equal to 0.
+  !
+  !V:   Same as U but for meridional velocity.
+  !
+  !TRA: Array of passive tracer mixing ratio, of dimensions (ND,NTRA),
+  !       where NTRA is the number of different tracers. If no
+  !       convective tracer transport is needed, define a dummy
+  !       input array of dimension (ND,1). Tracers are defined at
+  !       same vertical levels as T. Note that this array will be altered
+  !       if dry convective adjustment occurs and if IPBL is not equal to 0.
+  !
+  !P:   Array of pressure (mb) of dimension ND, with first
+  !       index corresponding to lowest model level. Must be defined
+  !       at same grid levels as T.
+  !
+  !PH:  Array of pressure (mb) of dimension ND+1, with first index
+  !       corresponding to lowest level. These pressures are defined at
+  !       levels intermediate between those of P, T, Q and QS. The first
+  !       value of PH should be greater than (i.e. at a lower level than)
+  !       the first value of the array P.
+  !
+  !ND:  The dimension of the arrays T,Q,QS,P,PH,FT and FQ
+  !
+  !NL:  The maximum number of levels to which convection can
+  !       penetrate, plus 1.
+  !       NL MUST be less than or equal to ND-1.
+  !
+  !NTRA:The number of different tracers. If no tracer transport
+  !       is needed, set this equal to 1. (On most compilers, setting
+  !       NTRA to 0 will bypass tracer calculation, saving some CPU.)
+  !
+  !DELT: The model time step (sec) between calls to CONVECT
+  !
+  !----------------------------------------------------------------------------
+  !    ***   On Output:         ***
+  !
+  !IFLAG: An output integer whose value denotes the following:
+  !
+  !           VALUE                        INTERPRETATION
+  !           -----                        --------------
+  !             0               No moist convection; atmosphere is not
+  !                             unstable, or surface temperature is less
+  !                             than 250 K or surface specific humidity
+  !                             is non-positive.
+  !
+  !             1               Moist convection occurs.
+  !
+  !             2               No moist convection: lifted condensation
+  !                             level is above the 200 mb level.
+  !
+  !             3               No moist convection: cloud base is higher
+  !                             then the level NL-1.
+  !
+  !             4               Moist convection occurs, but a CFL condition
+  !                             on the subsidence warming is violated. This
+  !                             does not cause the scheme to terminate.
+  !
+  !FT:   Array of temperature tendency (K/s) of dimension ND, defined at same
+  !        grid levels as T, Q, QS and P.
+  !
+  !FQ:   Array of specific humidity tendencies ((gm/gm)/s) of dimension ND,
+  !        defined at same grid levels as T, Q, QS and P.
+  !
+  !FU:   Array of forcing of zonal velocity (m/s^2) of dimension ND,
+  !        defined at same grid levels as T.
+  !
+  !FV:   Same as FU, but for forcing of meridional velocity.
+  !
+  !FTRA: Array of forcing of tracer content, in tracer mixing ratio per
+  !        second, defined at same levels as T. Dimensioned (ND,NTRA).
+  !
+  !PRECIP: Scalar convective precipitation rate (mm/day).
+  !
+  !WD:    A convective downdraft velocity scale. For use in surface
+  !        flux parameterizations. See convect.ps file for details.
+  !
+  !TPRIME: A convective downdraft temperature perturbation scale (K).
+  !         For use in surface flux parameterizations. See convect.ps
+  !         file for details.
+  !
+  !QPRIME: A convective downdraft specific humidity
+  !         perturbation scale (gm/gm).
+  !         For use in surface flux parameterizations. See convect.ps
+  !         file for details.
+  !
+  !CBMF:   The cloud base mass flux ((kg/m**2)/s). THIS SCALAR VALUE MUST
+  !         BE STORED BY THE CALLING PROGRAM AND RETURNED TO CONVECT AT
+  !         ITS NEXT CALL. That is, the value of CBMF must be "remembered"
+  !         by the calling program between calls to CONVECT.
+  !
+  !-----------------------------------------------------------------------------
+  !
+  !    ***  THE PARAMETER NA SHOULD IN GENERAL BE GREATER THAN   ***
+  !    ***                OR EQUAL TO  ND + 1                    ***
+  !
+  !
+  use par_mod
+
+  implicit none
+  !
+  !-cv====>Begin Module CONVECT    File convect.f      Undeclared variables
+  !
+  !Argument variables
+  !
+  integer :: iflag, nd, nl
+  !
+  real :: cbmf, delt, precip, qprime, tprime, wd
+  !
+  !Local variables
+  !
+  integer :: i, icb, ihmin, inb, inb1, j, jtt, k
+  integer :: nk
+  !
+  real :: ad, afac, ahmax, ahmin, alt, altem
+  real :: am, amp1, anum, asij, awat, b6, bf2, bsum, by
+  real :: byp, c6, cape, capem, cbmfold, chi, coeff
+  real :: cpinv, cwat, damps, dbo, dbosum
+  real :: defrac, dei, delm, delp, delt0, delti, denom, dhdp
+  real :: dpinv, dtma, dtmin, dtpbl, elacrit, ents
+  real :: epmax, fac, fqold, frac, ftold
+  real :: plcl, qp1, qsm, qstm, qti, rat
+  real :: rdcp, revap, rh, scrit, sigt, sjmax
+  real :: sjmin, smid, smin, stemp, tca
+  real :: tvaplcl, tvpplcl, tvx, tvy, wdtrain
+
+  !integer jc,jn
+  !real alvnew,a2,ahm,alv,rm,sum,qnew,dphinv,tc,thbar,tnew,x
+  !REAL TOLD(NA)
+
+  real :: FUP(NA),FDOWN(NA)
+  !
+  !-cv====>End Module   CONVECT    File convect.f
+
+  INTEGER :: NENT(NA)
+  REAL :: M(NA),MP(NA),MENT(NA,NA),QENT(NA,NA),ELIJ(NA,NA)
+  REAL :: SIJ(NA,NA),TVP(NA),TV(NA),WATER(NA)
+  REAL :: QP(NA),EP(NA),TH(NA),WT(NA),EVAP(NA),CLW(NA)
+  REAL :: SIGP(NA),TP(NA),CPN(NA)
+  REAL :: LV(NA),LVCP(NA),H(NA),HP(NA),GZ(NA),HM(NA)
+  !
+  ! -----------------------------------------------------------------------
+  !
+  !   ***                     Specify Switches                         ***
+  !
+  !   ***   IPBL: Set to zero to bypass dry adiabatic adjustment       ***
+  !   ***    Any other value results in dry adiabatic adjustment       ***
+  !   ***     (Zero value recommended for use in models with           ***
+  !   ***                   boundary layer schemes)                    ***
+  !
+  !   ***   MINORIG: Lowest level from which convection may originate  ***
+  !   ***     (Should be first model level at which T is defined       ***
+  !   ***      for models using bulk PBL schemes; otherwise, it should ***
+  !   ***      be the first model level at which T is defined above    ***
+  !   ***                      the surface layer)                      ***
+  !
+  INTEGER,PARAMETER :: IPBL=0
+  INTEGER,PARAMETER :: MINORIG=1
+  !
+  !------------------------------------------------------------------------------
+  !
+  !   ***                    SPECIFY PARAMETERS                        ***
+  !
+  !   *** ELCRIT IS THE AUTOCONVERSION THERSHOLD WATER CONTENT (gm/gm) ***
+  !   ***  TLCRIT IS CRITICAL TEMPERATURE BELOW WHICH THE AUTO-        ***
+  !   ***       CONVERSION THRESHOLD IS ASSUMED TO BE ZERO             ***
+  !   ***     (THE AUTOCONVERSION THRESHOLD VARIES LINEARLY            ***
+  !   ***               BETWEEN 0 C AND TLCRIT)                        ***
+  !   ***   ENTP IS THE COEFFICIENT OF MIXING IN THE ENTRAINMENT       ***
+  !   ***                       FORMULATION                            ***
+  !   ***  SIGD IS THE FRACTIONAL AREA COVERED BY UNSATURATED DNDRAFT  ***
+  !   ***  SIGS IS THE FRACTION OF PRECIPITATION FALLING OUTSIDE       ***
+  !   ***                        OF CLOUD                              ***
+  !   ***        OMTRAIN IS THE ASSUMED FALL SPEED (P/s) OF RAIN       ***
+  !   ***     OMTSNOW IS THE ASSUMED FALL SPEED (P/s) OF SNOW          ***
+  !   ***  COEFFR IS A COEFFICIENT GOVERNING THE RATE OF EVAPORATION   ***
+  !   ***                          OF RAIN                             ***
+  !   ***  COEFFS IS A COEFFICIENT GOVERNING THE RATE OF EVAPORATION   ***
+  !   ***                          OF SNOW                             ***
+  !   ***     CU IS THE COEFFICIENT GOVERNING CONVECTIVE MOMENTUM      ***
+  !   ***                         TRANSPORT                            ***
+  !   ***    DTMAX IS THE MAXIMUM NEGATIVE TEMPERATURE PERTURBATION    ***
+  !   ***        A LIFTED PARCEL IS ALLOWED TO HAVE BELOW ITS LFC      ***
+  !   ***    ALPHA AND DAMP ARE PARAMETERS THAT CONTROL THE RATE OF    ***
+  !   ***                 APPROACH TO QUASI-EQUILIBRIUM                ***
+  !   ***   (THEIR STANDARD VALUES ARE  0.20 AND 0.1, RESPECTIVELY)    ***
+  !   ***                   (DAMP MUST BE LESS THAN 1)                 ***
+  !
+  REAL,PARAMETER :: ELCRIT=.0011
+  REAL,PARAMETER :: TLCRIT=-55.0
+  REAL,PARAMETER :: ENTP=1.5
+  REAL,PARAMETER :: SIGD=0.05
+  REAL,PARAMETER :: SIGS=0.12
+  REAL,PARAMETER :: OMTRAIN=50.0
+  REAL,PARAMETER :: OMTSNOW=5.5
+  REAL,PARAMETER :: COEFFR=1.0
+  REAL,PARAMETER :: COEFFS=0.8
+  REAL,PARAMETER :: CU=0.7
+  REAL,PARAMETER :: BETA=10.0
+  REAL,PARAMETER :: DTMAX=0.9
+  REAL,PARAMETER :: ALPHA=0.025  !original 0.2
+  REAL,PARAMETER :: DAMP=0.1
+  !
+  !   ***        ASSIGN VALUES OF THERMODYNAMIC CONSTANTS,        ***
+  !   ***            GRAVITY, AND LIQUID WATER DENSITY.           ***
+  !   ***             THESE SHOULD BE CONSISTENT WITH             ***
+  !   ***              THOSE USED IN CALLING PROGRAM              ***
+  !   ***     NOTE: THESE ARE ALSO SPECIFIED IN SUBROUTINE TLIFT  ***
+  !
+  REAL,PARAMETER :: CPD=1005.7
+  REAL,PARAMETER :: CPV=1870.0
+  REAL,PARAMETER :: CL=2500.0
+  REAL,PARAMETER :: RV=461.5
+  REAL,PARAMETER :: RD=287.04
+  REAL,PARAMETER :: LV0=2.501E6
+  REAL,PARAMETER :: G=9.81
+  REAL,PARAMETER :: ROWL=1000.0
+  !
+  REAL,PARAMETER :: CPVMCL=CL-CPV
+  REAL,PARAMETER :: EPS0=RD/RV
+  REAL,PARAMETER :: EPSI=1./EPS0
+  REAL,PARAMETER :: GINV=1.0/G
+  REAL,PARAMETER :: EPSILON=1.e-20
+
+  ! EPSILON IS A SMALL NUMBER USED TO EXCLUDE MASS FLUXES OF ZERO
+  !
+  DELTI=1.0/DELT
+  !
+  !      ***  INITIALIZE OUTPUT ARRAYS AND PARAMETERS  ***
+  !
+
+  FT(:NL+1)=0.0
+  FQ(:NL+1)=0.0
+  FDOWN(:NL+1)=0.0
+  SUB(:NL+1)=0.0
+  FUP(:NL+1)=0.0
+  M(:NL+1)=0.0
+  MP(:NL+1)=0.0
+  FMASS(:NL+1,:NL+1)=0.0
+  MENT(:NL+1,:NL+1)=0.0
+  ! DO I=1,NL+1
+  !   RDCP=(RD*(1.-QCONV(I))+QCONV(I)*RV)/ &
+  !       (CPD*(1.-QCONV(I))+QCONV(I)*CPV)
+  !   TH(I)=TCONV(I)*(1000.0/PCONV_HPA(I))**RDCP
+  ! END DO
+  ! LB 04.05.2021, below is not mentioned anywhere, so I commented it
+  ! TH(:NL+1)=TCONV(:NL+1)*(1000.0/PCONV_HPA(:NL+1))** &
+  !     (RD*(1.-QCONV(:NL+1))+QCONV(:NL+1)*RV)/ (CPD*(1.-QCONV(:NL+1))+QCONV(:NL+1)*CPV)
+  PRECIP=0.0
+  WD=0.0
+  TPRIME=0.0
+  QPRIME=0.0
+  IFLAG=0
+  !
+  !  IF(IPBL.NE.0)THEN
+  !
+  !***            PERFORM DRY ADIABATIC ADJUSTMENT            ***
+  !
+  !  JC=0
+  !  DO 30 I=NL-1,1,-1
+  !   JN=0
+  !    SUM=TH(I)*(1.+QCONV(I)*EPSI-QCONV(I))
+  !   DO 10 J=I+1,NL
+  !    SUM=SUM+TH(J)*(1.+QCONV(J)*EPSI-QCONV(J))
+  !    THBAR=SUM/REAL(J+1-I)
+  !    IF((TH(J)*(1.+QCONV(J)*EPSI-QCONV(J))).LT.THBAR)JN=J
+  !  10    CONTINUE
+  !   IF(I.EQ.1)JN=MAX(JN,2)
+  !   IF(JN.EQ.0)GOTO 30
+  !  12    CONTINUE
+  !   AHM=0.0
+  !   RM=0.0
+  !   DO 15 J=I,JN
+  !    AHM=AHM+(CPD*(1.-QCONV(J))+QCONV(J)*CPV)*TCONV(J)*
+  !    +   (PHCONV_HPA(J)-PHCONV_HPA(J+1))
+  !    RM=RM+QCONV(J)*(PHCONV_HPA(J)-PHCONV_HPA(J+1))
+  !  15    CONTINUE
+  !   DPHINV=1./(PHCONV_HPA(I)-PHCONV_HPA(JN+1))
+  !   RM=RM*DPHINV
+  !   A2=0.0
+  !   DO 20 J=I,JN
+  !    QCONV(J)=RM
+  !    RDCP=(RD*(1.-QCONV(J))+QCONV(J)*RV)/
+  !    1     (CPD*(1.-QCONV(J))+QCONV(J)*CPV)
+  !    X=(0.001*PCONV_HPA(J))**RDCP
+  !    TOLD(J)=TCONV(J)
+  !    TCONV(J)=X
+  !    A2=A2+(CPD*(1.-QCONV(J))+QCONV(J)*CPV)*X*
+  !    1    (PHCONV_HPA(J)-PHCONV_HPA(J+1))
+  !  20    CONTINUE
+  !   DO 25 J=I,JN
+  !    TH(J)=AHM/A2
+  !    TCONV(J)=TCONV(J)*TH(J)
+  !    TC=TOLD(J)-273.15
+  !    ALV=LV0-CPVMCL*TC
+  !    QSCONV(J)=QSCONV(J)+QSCONV(J)*(1.+QSCONV(J)*(EPSI-1.))*ALV*
+  !    1    (TCONV(J)- TOLD(J))/(RV*TOLD(J)*TOLD(J))
+  ! if (qslev(j) .lt. 0.) then
+  !   write(*,*) 'qslev.lt.0 ',j,qslev
+  ! endif
+  !  25    CONTINUE
+  !   IF((TH(JN+1)*(1.+QCONV(JN+1)*EPSI-QCONV(JN+1))).LT.
+  !    1    (TH(JN)*(1.+QCONV(JN)*EPSI-QCONV(JN))))THEN
+  !    JN=JN+1
+  !    GOTO 12
+  !   END IF
+  !   IF(I.EQ.1)JC=JN
+  !  30   CONTINUE
+  !
+  !   ***   Remove any supersaturation that results from adjustment ***
+  !
+  !IF(JC.GT.1)THEN
+  ! DO 38 J=1,JC
+  !    IF(QSCONV(J).LT.QCONV(J))THEN
+  !     ALV=LV0-CPVMCL*(TCONV(J)-273.15)
+  !     TNEW=TCONV(J)+ALV*(QCONV(J)-QSCONV(J))/(CPD*(1.-QCONV(J))+
+  !    1      CL*QCONV(J)+QSCONV(J)*(CPV-CL+ALV*ALV/(RV*TCONV(J)*TCONV(J))))
+  !     ALVNEW=LV0-CPVMCL*(TNEW-273.15)
+  !     QNEW=(ALV*QCONV(J)-(TNEW-TCONV(J))*(CPD*(1.-QCONV(J))
+  !    1     +CL*QCONV(J)))/ALVNEW
+  !     PRECIP=PRECIP+24.*3600.*1.0E5*(PHCONV_HPA(J)-PHCONV_HPA(J+1))*
+  !    1      (QCONV(J)-QNEW)/(G*DELT*ROWL)
+  !     TCONV(J)=TNEW
+  !     QCONV(J)=QNEW
+  !     QSCONV(J)=QNEW
+  !    END IF
+  !  38  CONTINUE
+  !END IF
+  !
+  !END IF
+  !
+  !  *** CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY AND STATIC ENERGY
+  !
+  GZ(1)=0.0
+  CPN(1)=CPD*(1.-QCONV(1))+QCONV(1)*CPV
+  H(1)=TCONV(1)*CPN(1)
+  LV(1)=LV0-CPVMCL*(TCONV(1)-273.15)
+  HM(1)=LV(1)*QCONV(1)
+  TV(1)=TCONV(1)*(1.+QCONV(1)*EPSI-QCONV(1))
+  AHMIN=1.0E12
+  IHMIN=NL
+
+  DO I=2,NL+1
+    TVX=TCONV(I)*(1.+QCONV(I)*EPSI-QCONV(I))
+    TVY=TCONV(I-1)*(1.+QCONV(I-1)*EPSI-QCONV(I-1))
+    GZ(I)=GZ(I-1)+0.5*RD*(TVX+TVY)*(PCONV_HPA(I-1)-PCONV_HPA(I))/ &
+         PHCONV_HPA(I)
+    CPN(I)=CPD*(1.-QCONV(I))+CPV*QCONV(I)
+    H(I)=TCONV(I)*CPN(I)+GZ(I)
+    LV(I)=LV0-CPVMCL*(TCONV(I)-273.15)
+    HM(I)=(CPD*(1.-QCONV(I))+CL*QCONV(I))*(TCONV(I)-TCONV(1))+ &
+         LV(I)*QCONV(I)+GZ(I)
+    TV(I)=TCONV(I)*(1.+QCONV(I)*EPSI-QCONV(I))
+!
+!  ***  Find level of minimum moist static energy    ***
+!
+    IF(I.GE.MINORIG.AND.HM(I).LT.AHMIN.AND.HM(I).LT.HM(I-1))THEN
+      AHMIN=HM(I)
+      IHMIN=I
+    END IF
+  END DO
+  IHMIN=MIN(IHMIN, NL-1)
+  !
+  !  ***     Find that model level below the level of minimum moist       ***
+  !  ***  static energy that has the maximum value of moist static energy ***
+  !
+  AHMAX=0.0
+  !  ***  bug fixed: need to assign an initial value to NK
+  !  HSO, 05.08.2009
+  NK=MINORIG
+  DO I=MINORIG,IHMIN
+    IF(HM(I).GT.AHMAX)THEN
+      NK=I
+      AHMAX=HM(I)
+    END IF
+  END DO
+  ! LB 04.05.2021, replace above with array operations (maxloc not working)
+  ! NK=MINORIG+maxloc(HM(MINORIG:IHMIN))-1
+
+  !
+  !  ***  CHECK WHETHER PARCEL LEVEL TEMPERATURE AND SPECIFIC HUMIDITY   ***
+  !  ***                          ARE REASONABLE                         ***
+  !  ***      Skip convection if HM increases monotonically upward       ***
+  !
+  IF(TCONV(NK).LT.250.0.OR.QCONV(NK).LE.0.0.OR.IHMIN.EQ.(NL-1)) THEN
+    IFLAG=0
+    CBMF=0.0
+    RETURN
+  END IF
+  !
+  !   ***  CALCULATE LIFTED CONDENSATION LEVEL OF AIR AT PARCEL ORIGIN LEVEL ***
+  !   ***       (WITHIN 0.2% OF FORMULA OF BOLTON, MON. WEA. REV.,1980)      ***
+  !
+  RH=QCONV(NK)/QSCONV(NK)
+  CHI=TCONV(NK)/(1669.0-122.0*RH-TCONV(NK))
+  PLCL=PCONV_HPA(NK)*(RH**CHI)
+  IF(PLCL.LT.200.0.OR.PLCL.GE.2000.0)THEN
+    IFLAG=2
+    CBMF=0.0
+    RETURN
+  END IF
+  !
+  !   ***  CALCULATE FIRST LEVEL ABOVE LCL (=ICB)  ***
+  !
+  ICB=NL-1
+  DO I=NK+1,NL
+    IF(PCONV_HPA(I).LT.PLCL)THEN
+      ICB=MIN(ICB,I)
+    END IF
+  END DO
+  IF(ICB.GE.(NL-1))THEN
+    IFLAG=3
+    CBMF=0.0
+    RETURN
+  END IF
+  !
+  !   *** FIND TEMPERATURE UP THROUGH ICB AND TEST FOR INSTABILITY           ***
+  !
+  !   *** SUBROUTINE TLIFT CALCULATES PART OF THE LIFTED PARCEL VIRTUAL      ***
+  !   ***  TEMPERATURE, THE ACTUAL TEMPERATURE AND THE ADIABATIC             ***
+  !   ***                   LIQUID WATER CONTENT                             ***
+  !
+  CALL TLIFT(GZ,ICB,NK,TVP,TP,CLW,ND,NL,1)
+  TVP(NK:ICB)=TVP(NK:ICB)-TP(NK:ICB)*QCONV(NK)
+  !
+  !   ***  If there was no convection at last time step and parcel    ***
+  !   ***       is stable at ICB then skip rest of calculation        ***
+  !
+  IF(CBMF.EQ.0.0.AND.TVP(ICB).LE.(TV(ICB)-DTMAX))THEN
+    IFLAG=0
+    RETURN
+  END IF
+  !
+  !   ***  IF THIS POINT IS REACHED, MOIST CONVECTIVE ADJUSTMENT IS NECESSARY ***
+  !
+  IF(IFLAG.NE.4)IFLAG=1
+  !
+  !   ***  FIND THE REST OF THE LIFTED PARCEL TEMPERATURES          ***
+  !
+  CALL TLIFT(GZ,ICB,NK,TVP,TP,CLW,ND,NL,2)
+  !
+  !   ***  SET THE PRECIPITATION EFFICIENCIES AND THE FRACTION OF   ***
+  !   ***          PRECIPITATION FALLING OUTSIDE OF CLOUD           ***
+  !   ***      THESE MAY BE FUNCTIONS OF TP(I), PCONV_HPA(I) AND CLW(I)     ***
+  !
+  EP(1:NK)=0.0
+  SIGP(1:NL)=SIGS
+
+  DO I=NK+1,NL
+    TCA=TP(I)-273.15
+    IF(TCA.GE.0.0)THEN
+      ELACRIT=ELCRIT
+    ELSE
+      ELACRIT=ELCRIT*(1.0-TCA/TLCRIT)
+    END IF
+    ELACRIT=MAX(ELACRIT,0.0)
+    EPMAX=0.999
+    EP(I)=EPMAX*(1.0-ELACRIT/MAX(CLW(I),1.0E-8))
+    EP(I)=MAX(EP(I),0.0)
+    EP(I)=MIN(EP(I),EPMAX)
+    SIGP(I)=SIGS
+  END DO
+  ! LB 04.05.2021, replace above with array operations
+  ! (this makes it less readable, and not any faster)
+  ! PROBLEM 1 is within the statement below
+  ! EPMAX=0.999
+  ! where ((TP(NK+1:NL)-273.15).ge.0.0)
+  !   EP(NK+1:NL)=EPMAX*(1.0-max(ELCRIT, 0.0)/MAX(CLW(NK+1:NL),1.0E-8))
+  ! elsewhere
+  !   EP(NK+1:NL)=EPMAX*(1.0-max(ELCRIT*(1.0-TCA/TLCRIT), 0.0)/MAX(CLW(NK+1:NL),1.0E-8))
+  ! end where
+  ! where (EP(NK+1:NL).lt.0.0)
+  !   EP(NK+1:NL)=0.0
+  ! elsewhere (EP(NK+1:NL).gt.EPMAX)
+  !   EP(NK+1:NL)=EPMAX
+  ! end where
+
+  !
+  !   ***       CALCULATE VIRTUAL TEMPERATURE AND LIFTED PARCEL     ***
+  !   ***                    VIRTUAL TEMPERATURE                    ***
+  ! !
+  TVP(ICB+1:NL)=TVP(ICB+1:NL)-TP(ICB+1:NL)*QCONV(NK)
+  TVP(NL+1)=TVP(NL)-(GZ(NL+1)-GZ(NL))/CPD
+  !
+  !   ***        NOW INITIALIZE VARIOUS ARRAYS USED IN THE COMPUTATIONS       ***
+
+  HP(:NL+1)=H(:NL+1)
+  NENT(:NL+1)=0
+  WATER(:NL+1)=0.0
+  EVAP(:NL+1)=0.0
+  WT(:NL+1)=OMTSNOW
+  LVCP(:NL+1)=LV(:NL+1)/CPN(:NL+1)
+  ELIJ(:NL+1,:NL+1)=0.0
+  SIJ(:NL+1,:NL+1)=0.0
+  DO I=1,NL+1
+    QENT(I,:NL+1)=QCONV(:NL+1)
+  END DO
+  QP(1)=QCONV(1)
+  QP(2:NL+1)=QCONV(:NL)
+
+  !
+  !  ***  FIND THE FIRST MODEL LEVEL (INB1) ABOVE THE PARCEL'S      ***
+  !  ***          HIGHEST LEVEL OF NEUTRAL BUOYANCY                 ***
+  !  ***     AND THE HIGHEST LEVEL OF POSITIVE CAPE (INB)           ***
+  !
+  CAPE=0.0
+  CAPEM=0.0
+  INB=ICB+1
+  INB1=INB
+  BYP=0.0
+  DO I=ICB+1,NL-1
+    BY=(TVP(I)-TV(I))*(PHCONV_HPA(I)-PHCONV_HPA(I+1))/PCONV_HPA(I)
+    CAPE=CAPE+BY
+    IF(BY.GE.0.0)INB1=I+1
+    IF(CAPE.GT.0.0)THEN
+      INB=I+1
+      BYP=(TVP(I+1)-TV(I+1))*(PHCONV_HPA(I+1)-PHCONV_HPA(I+2))/ &
+           PCONV_HPA(I+1)
+      CAPEM=CAPE
+    END IF
+  END DO
+  INB=MAX(INB,INB1)
+  CAPE=CAPEM+BYP
+  DEFRAC=CAPEM-CAPE
+  DEFRAC=MAX(DEFRAC,0.001)
+  FRAC=-CAPE/DEFRAC
+  FRAC=MIN(FRAC,1.0)
+  FRAC=MAX(FRAC,0.0)
+  !
+  !   ***   CALCULATE LIQUID WATER STATIC ENERGY OF LIFTED PARCEL   ***
+  !
+  HP(ICB:INB)=H(NK)+(LV(ICB:INB)+(CPD-CPV)*TCONV(ICB:INB))*EP(ICB:INB)*CLW(ICB:INB)
+  !
+  !   ***  CALCULATE CLOUD BASE MASS FLUX AND RATES OF MIXING, M(I),  ***
+  !   ***                   AT EACH MODEL LEVEL                       ***
+  !
+
+  !
+  !   ***     INTERPOLATE DIFFERENCE BETWEEN LIFTED PARCEL AND      ***
+  !   ***  ENVIRONMENTAL TEMPERATURES TO LIFTED CONDENSATION LEVEL  ***
+  !
+  TVPPLCL=TVP(ICB-1)-RD*TVP(ICB-1)*(PCONV_HPA(ICB-1)-PLCL)/ &
+       (CPN(ICB-1)*PCONV_HPA(ICB-1))
+  TVAPLCL=TV(ICB)+(TVP(ICB)-TVP(ICB+1))*(PLCL-PCONV_HPA(ICB))/ &
+       (PCONV_HPA(ICB)-PCONV_HPA(ICB+1))
+  DTPBL=0.0
+
+  DTPBL=sum((TVP(NK:ICB-1)-TV(NK:ICB-1))*(PHCONV_HPA(NK:ICB-1)-PHCONV_HPA(NK+1:ICB)))/ &
+        (PHCONV_HPA(NK)-PHCONV_HPA(ICB))
+  DTMIN=TVPPLCL-TVAPLCL+DTMAX+DTPBL
+  DTMA=DTMIN
+  !
+  !   ***  ADJUST CLOUD BASE MASS FLUX   ***
+  !
+  CBMFOLD=CBMF
+  ! *** C. Forster: adjustment of CBMF is not allowed to depend on FLEXPART timestep
+  DELT0=DELT/3.
+  DAMPS=DAMP*DELT/DELT0
+  CBMF=(1.-DAMPS)*CBMF+0.1*ALPHA*DTMA
+  CBMF=MAX(CBMF,0.0)
+  !
+  !   *** If cloud base mass flux is zero, skip rest of calculation  ***
+  !
+  IF(CBMF.EQ.0.0.AND.CBMFOLD.EQ.0.0)THEN
+    RETURN
+  END IF
+
+  !
+  !   ***   CALCULATE RATES OF MIXING,  M(I)   ***
+  M(ICB)=0.0
+  M(ICB+1:INB1)=ABS(TV(ICB+1:INB1)-TVP(ICB+1:INB1))+ &
+        ENTP*0.02*(PHCONV_HPA(ICB+1:INB1)-PHCONV_HPA(ICB+2:INB1+1))
+  M(INB1:INB)=ABS(TV(INB1)-TVP(INB1))+ &
+        ENTP*0.02*(PHCONV_HPA(INB1)-PHCONV_HPA(INB1+1))
+  M(ICB+1:INB)=CBMF*M(ICB+1:INB)/sum(M(ICB+1:INB))
+
+  !
+  !   ***  CALCULATE ENTRAINED AIR MASS FLUX (MENT), TOTAL WATER MIXING  ***
+  !   ***     RATIO (QENT), TOTAL CONDENSED WATER (ELIJ), AND MIXING     ***
+  !   ***                        FRACTION (SIJ)                          ***
+  !
+  DO I=ICB+1,INB
+    QTI=QCONV(NK)-EP(I)*CLW(I)
+    DO J=ICB,INB
+      BF2=1.+LV(J)*LV(J)*QSCONV(J)/(RV*TCONV(J)*TCONV(J)*CPD)
+      ANUM=H(J)-HP(I)+(CPV-CPD)*TCONV(J)*(QTI-QCONV(J))
+      DENOM=H(I)-HP(I)+(CPD-CPV)*(QCONV(I)-QTI)*TCONV(J)
+      DEI=DENOM
+      IF(ABS(DEI).LT.0.01)DEI=0.01
+      SIJ(I,J)=ANUM/DEI
+      SIJ(I,I)=1.0
+      ALTEM=SIJ(I,J)*QCONV(I)+(1.-SIJ(I,J))*QTI-QSCONV(J)
+      ALTEM=ALTEM/BF2
+      CWAT=CLW(J)*(1.-EP(J))
+      STEMP=SIJ(I,J)
+      IF((STEMP.LT.0.0.OR.STEMP.GT.1.0.OR. &
+            ALTEM.GT.CWAT).AND.J.GT.I)THEN
+        ANUM=ANUM-LV(J)*(QTI-QSCONV(J)-CWAT*BF2)
+        DENOM=DENOM+LV(J)*(QCONV(I)-QTI)
+        IF(ABS(DENOM).LT.0.01)DENOM=0.01
+        SIJ(I,J)=ANUM/DENOM
+        ALTEM=SIJ(I,J)*QCONV(I)+(1.-SIJ(I,J))*QTI-QSCONV(J)
+        ALTEM=ALTEM-(BF2-1.)*CWAT
+      END IF
+      IF(SIJ(I,J).GT.0.0.AND.SIJ(I,J).LT.0.9)THEN
+        QENT(I,J)=SIJ(I,J)*QCONV(I)+(1.-SIJ(I,J))*QTI
+        ELIJ(I,J)=ALTEM
+        ELIJ(I,J)=MAX(0.0,ELIJ(I,J))
+        MENT(I,J)=M(I)/(1.-SIJ(I,J))
+        NENT(I)=NENT(I)+1
+      END IF
+      SIJ(I,J)=MAX(0.0,SIJ(I,J))
+      SIJ(I,J)=MIN(1.0,SIJ(I,J))
+    END DO
+  !
+  !   ***   IF NO AIR CAN ENTRAIN AT LEVEL I ASSUME THAT UPDRAFT DETRAINS  ***
+  !   ***   AT THAT LEVEL AND CALCULATE DETRAINED AIR FLUX AND PROPERTIES  ***
+  !
+    IF(NENT(I).EQ.0)THEN
+      MENT(I,I)=M(I)
+      QENT(I,I)=QCONV(NK)-EP(I)*CLW(I)
+      ELIJ(I,I)=CLW(I)
+      SIJ(I,I)=1.0
+    END IF
+  END DO
+  SIJ(INB,INB)=1.0
+  ! LB 04.05.2021, Attempt to array the loop above: PROBLEM 2 is here
+  ! DO J=ICB,INB
+  !   BF2=1.+LV(J)*LV(J)*QSCONV(J)/(RV*TCONV(J)*TCONV(J)*CPD)
+  !   CWAT=CLW(J)*(1.-EP(J))
+  !   DO I=ICB+1,INB
+  !     QTI=QCONV(NK)-EP(I)*CLW(I)
+  !     ANUM=H(J)-HP(I)+(CPV-CPD)*TCONV(J)*(QTI-QCONV(J))
+  !     DENOM=H(I)-HP(I)+(CPD-CPV)*(QCONV(I)-QTI)*TCONV(J)
+  !     DEI=DENOM
+  !     IF(I.EQ.J)THEN
+  !       SIJ(I,I)=1.0
+  !     ELSE IF(ABS(DENOM).LT.0.01)THEN
+  !       SIJ(I,J)=ANUM/0.01
+  !     ELSE
+  !       SIJ(I,J)=ANUM/DENOM
+  !     END IF
+  !     ALTEM=(SIJ(I,J)*QCONV(I)+(1.-SIJ(I,J))*QTI-QSCONV(J))/BF2
+  !     IF((SIJ(I,J).LT.0.0.OR.SIJ(I,J).GT.1.0.OR. &
+  !           ALTEM.GT.CWAT).AND.J.GT.I)THEN
+  !       ANUM=ANUM-LV(J)*(QTI-QSCONV(J)-CWAT*BF2)
+  !       DENOM=DENOM+LV(J)*(QCONV(I)-QTI)
+  !       IF(ABS(DENOM).LT.0.01)DENOM=0.01
+  !       SIJ(I,J)=ANUM/DENOM
+  !       ALTEM=SIJ(I,J)*QCONV(I)+(1.-SIJ(I,J))*QTI-QSCONV(J)
+  !       ALTEM=ALTEM-(BF2-1.)*CWAT
+  !     END IF
+  !     IF(SIJ(I,J).GT.0.0.AND.SIJ(I,J).LT.0.9)THEN
+  !       QENT(I,J)=SIJ(I,J)*QCONV(I)+(1.-SIJ(I,J))*QTI
+  !       ELIJ(I,J)=ALTEM
+  !       ELIJ(I,J)=MAX(0.0,ELIJ(I,J))
+  !       MENT(I,J)=M(I)/(1.-SIJ(I,J))
+  !       NENT(I)=NENT(I)+1
+  !     END IF
+  !     SIJ(I,J)=MAX(0.0,SIJ(I,J))
+  !     SIJ(I,J)=MIN(1.0,SIJ(I,J))
+  !   END DO
+  ! END DO
+  ! !
+  ! !   ***   IF NO AIR CAN ENTRAIN AT LEVEL I ASSUME THAT UPDRAFT DETRAINS  ***
+  ! !   ***   AT THAT LEVEL AND CALCULATE DETRAINED AIR FLUX AND PROPERTIES  ***
+  ! !
+  ! do I=ICB+1,INB
+  !   IF(NENT(I).EQ.0)THEN
+  !     MENT(I,I)=M(I)
+  !     QENT(I,I)=QCONV(NK)-EP(I)*CLW(I)
+  !     ELIJ(I,I)=CLW(I)
+  !     SIJ(I,I)=1.0
+  !   END IF
+  ! END DO
+  ! SIJ(INB,INB)=1.0
+
+
+  !
+  !   ***  NORMALIZE ENTRAINED AIR MASS FLUXES TO REPRESENT EQUAL  ***
+  !   ***              PROBABILITIES OF MIXING                     ***
+  !
+  ! LB 04.05.2021, depending on how often NENT.ne.0, reversing the loop could
+  ! speed it up...
+  DO I=ICB+1,INB
+    IF(NENT(I).NE.0)THEN
+      QP1=QCONV(NK)-EP(I)*CLW(I)
+      ANUM=H(I)-HP(I)-LV(I)*(QP1-QSCONV(I))
+      DENOM=H(I)-HP(I)+LV(I)*(QCONV(I)-QP1)
+      IF(ABS(DENOM).LT.0.01)DENOM=0.01
+      SCRIT=ANUM/DENOM
+      ALT=QP1-QSCONV(I)+SCRIT*(QCONV(I)-QP1)
+      IF(ALT.LT.0.0)SCRIT=1.0
+      SCRIT=MAX(SCRIT,0.0)
+      ASIJ=0.0
+      SMIN=1.0
+      DO J=ICB,INB
+        IF(SIJ(I,J).GT.0.0.AND.SIJ(I,J).LT.0.9)THEN
+          IF(J.GT.I)THEN
+            SMID=MIN(SIJ(I,J),SCRIT)
+            SJMAX=SMID
+            SJMIN=SMID
+            IF(SMID.LT.SMIN.AND.SIJ(I,J+1).LT.SMID)THEN
+              SMIN=SMID
+              SJMAX=MIN(SIJ(I,J+1),SIJ(I,J),SCRIT)
+              SJMIN=MAX(SIJ(I,J-1),SIJ(I,J))
+              SJMIN=MIN(SJMIN,SCRIT)
+            END IF
+          ELSE
+            SJMAX=MAX(SIJ(I,J+1),SCRIT)
+            SMID=MAX(SIJ(I,J),SCRIT)
+            SJMIN=0.0
+            IF(J.GT.1)SJMIN=SIJ(I,J-1)
+            SJMIN=MAX(SJMIN,SCRIT)
+          END IF
+          DELP=ABS(SJMAX-SMID)
+          DELM=ABS(SJMIN-SMID)
+          ASIJ=ASIJ+(DELP+DELM)*(PHCONV_HPA(J)-PHCONV_HPA(J+1))
+          MENT(I,J)=MENT(I,J)*(DELP+DELM)* &
+               (PHCONV_HPA(J)-PHCONV_HPA(J+1))
+        END IF
+      END DO
+      ASIJ=MAX(1.0E-21,ASIJ)
+      ASIJ=1.0/ASIJ
+      DO J=ICB,INB
+        MENT(I,J)=MENT(I,J)*ASIJ
+      END DO
+      BSUM=0.0
+      DO J=ICB,INB
+        BSUM=BSUM+MENT(I,J)
+      END DO
+      IF(BSUM.LT.1.0E-18)THEN
+        NENT(I)=0
+        MENT(I,I)=M(I)
+        QENT(I,I)=QCONV(NK)-EP(I)*CLW(I)
+        ELIJ(I,I)=CLW(I)
+        SIJ(I,I)=1.0
+      END IF
+    END IF
+  END DO
+
+  !
+  !   ***  CHECK WHETHER EP(INB)=0, IF SO, SKIP PRECIPITATING    ***
+  !   ***             DOWNDRAFT CALCULATION                      ***
+  !
+  if (EP(INB).ge.0.0001) then
+    !
+    !   ***  INTEGRATE LIQUID WATER EQUATION TO FIND CONDENSED WATER   ***
+    !   ***                AND CONDENSED WATER FLUX                    ***
+    !
+    JTT=2
+    !
+    !    ***                    BEGIN DOWNDRAFT LOOP                    ***
+    !
+    DO I=INB,1,-1
+    !
+    !    ***              CALCULATE DETRAINED PRECIPITATION             ***
+    !
+      WDTRAIN=G*EP(I)*M(I)*CLW(I)
+      IF(I.GT.1)THEN
+        DO J=1,I-1
+          AWAT=ELIJ(J,I)-(1.-EP(I))*CLW(I)
+          AWAT=MAX(0.0,AWAT)
+          WDTRAIN=WDTRAIN+G*AWAT*MENT(J,I)
+        END DO
+      END IF
+    !
+    !    ***    FIND RAIN WATER AND EVAPORATION USING PROVISIONAL   ***
+    !    ***              ESTIMATES OF QP(I)AND QP(I-1)             ***
+    !
+    !
+    !  ***  Value of terminal velocity and coefficient of evaporation for snow   ***
+    !
+      COEFF=COEFFS
+      WT(I)=OMTSNOW
+    !
+    !  ***  Value of terminal velocity and coefficient of evaporation for rain   ***
+    !
+      IF(TCONV(I).GT.273.0)THEN
+        COEFF=COEFFR
+        WT(I)=OMTRAIN
+      END IF
+      QSM=0.5*(QCONV(I)+QP(I+1))
+      AFAC=COEFF*PHCONV_HPA(I)*(QSCONV(I)-QSM)/ &
+           (1.0E4+2.0E3*PHCONV_HPA(I)*QSCONV(I))
+      AFAC=MAX(AFAC,0.0)
+      SIGT=SIGP(I)
+      SIGT=MAX(0.0,SIGT)
+      SIGT=MIN(1.0,SIGT)
+      B6=100.*(PHCONV_HPA(I)-PHCONV_HPA(I+1))*SIGT*AFAC/WT(I)
+      C6=(WATER(I+1)*WT(I+1)+WDTRAIN/SIGD)/WT(I)
+      REVAP=0.5*(-B6+SQRT(B6*B6+4.*C6))
+      EVAP(I)=SIGT*AFAC*REVAP
+      WATER(I)=REVAP*REVAP
+    !
+    !    ***  CALCULATE PRECIPITATING DOWNDRAFT MASS FLUX UNDER     ***
+    !    ***              HYDROSTATIC APPROXIMATION                 ***
+    !
+      if (.not. I.eq.1) then
+        DHDP=(H(I)-H(I-1))/(PCONV_HPA(I-1)-PCONV_HPA(I))
+        DHDP=MAX(DHDP,10.0)
+        MP(I)=100.*GINV*LV(I)*SIGD*EVAP(I)/DHDP
+        MP(I)=MAX(MP(I),0.0)
+      !
+      !   ***   ADD SMALL AMOUNT OF INERTIA TO DOWNDRAFT              ***
+      !
+        FAC=20.0/(PHCONV_HPA(I-1)-PHCONV_HPA(I))
+        MP(I)=(FAC*MP(I+1)+MP(I))/(1.+FAC)
+      !
+      !    ***      FORCE MP TO DECREASE LINEARLY TO ZERO                 ***
+      !    ***      BETWEEN ABOUT 950 MB AND THE SURFACE                  ***
+      !
+        IF(PCONV_HPA(I).GT.(0.949*PCONV_HPA(1)))THEN
+          JTT=MAX(JTT,I)
+          MP(I)=MP(JTT)*(PCONV_HPA(1)-PCONV_HPA(I))/(PCONV_HPA(1)- &
+              PCONV_HPA(JTT))
+        END IF
+      endif
+    !
+    !    ***       FIND MIXING RATIO OF PRECIPITATING DOWNDRAFT     ***
+    !
+      if (.not. I.eq.INB) then
+        IF(I.EQ.1)THEN
+          QSTM=QSCONV(1)
+        ELSE
+          QSTM=QSCONV(I-1)
+        END IF
+        IF(MP(I).GT.MP(I+1))THEN
+          RAT=MP(I+1)/MP(I)
+          QP(I)=QP(I+1)*RAT+QCONV(I)*(1.0-RAT)+100.*GINV* &
+               SIGD*(PHCONV_HPA(I)-PHCONV_HPA(I+1))*(EVAP(I)/MP(I))
+         ELSE
+          IF(MP(I+1).GT.0.0)THEN
+            QP(I)=(GZ(I+1)-GZ(I)+QP(I+1)*(LV(I+1)+TCONV(I+1)*(CL-CPD))+ &
+                 CPD*(TCONV(I+1)-TCONV(I)))/(LV(I)+TCONV(I)*(CL-CPD))
+          END IF
+        END IF
+        QP(I)=MIN(QP(I),QSTM)
+        QP(I)=MAX(QP(I),0.0)
+      endif
+    END DO
+    !
+    !   ***  CALCULATE SURFACE PRECIPITATION IN MM/DAY     ***
+    !
+    PRECIP=PRECIP+WT(1)*SIGD*WATER(1)*3600.*24000./(ROWL*G)
+    !
+  endif ! Downdraft calculation
+  !
+  !   ***  CALCULATE DOWNDRAFT VELOCITY SCALE AND SURFACE TEMPERATURE AND  ***
+  !   ***                    WATER VAPOR FLUCTUATIONS                      ***
+  !
+  WD=BETA*ABS(MP(ICB))*0.01*RD*TCONV(ICB)/(SIGD*PCONV_HPA(ICB))
+  QPRIME=0.5*(QP(1)-QCONV(1))
+  TPRIME=LV0*QPRIME/CPD
+  !
+  !   ***  CALCULATE TENDENCIES OF LOWEST LEVEL POTENTIAL TEMPERATURE  ***
+  !   ***                      AND MIXING RATIO                        ***
+  !
+
+  DPINV=0.01/(PHCONV_HPA(1)-PHCONV_HPA(2))
+  AM=0.0
+  IF(NK.EQ.1)THEN
+    AM = sum(M(2:INB))
+  END IF
+  ! save saturated upward mass flux for first level
+  FUP(1)=AM
+  IF((2.*G*DPINV*AM).GE.DELTI)IFLAG=4
+  FT(1)=FT(1)+G*DPINV*AM*(TCONV(2)-TCONV(1)+(GZ(2)-GZ(1))/CPN(1))
+  FT(1)=FT(1)-LVCP(1)*SIGD*EVAP(1)
+  FT(1)=FT(1)+SIGD*WT(2)*(CL-CPD)*WATER(2)*(TCONV(2)- &
+       TCONV(1))*DPINV/CPN(1)
+  FQ(1)=FQ(1)+G*MP(2)*(QP(2)-QCONV(1))* &
+       DPINV+SIGD*EVAP(1)
+  FQ(1)=FQ(1)+G*AM*(QCONV(2)-QCONV(1))*DPINV
+
+  FQ(1)=FQ(1)+G*DPINV*sum(MENT(2:INB,1)*(QENT(2:INB,1)-QCONV(1)))
+  !
+  !   ***  CALCULATE TENDENCIES OF POTENTIAL TEMPERATURE AND MIXING RATIO  ***
+  !   ***               AT LEVELS ABOVE THE LOWEST LEVEL                   ***
+  !
+  !   ***  FIRST FIND THE NET SATURATED UPDRAFT AND DOWNDRAFT MASS FLUXES  ***
+  !   ***                      THROUGH EACH LEVEL                          ***
+  !
+  DO I=2,INB
+    DPINV=0.01/(PHCONV_HPA(I)-PHCONV_HPA(I+1))
+    CPINV=1.0/CPN(I)
+    AMP1=0.0
+    AD=0.0
+    IF(I.GE.NK)THEN
+      AMP1 = sum(M(I+1:INB+1))
+    END IF
+    AMP1 = AMP1 + sum(MENT(1:I,I+1:INB+1))
+  ! save saturated upward mass flux
+    FUP(I)=AMP1
+    IF((2.*G*DPINV*AMP1).GE.DELTI)IFLAG=4
+
+    AD = sum(MENT(I:INB,1:I-1))
+  ! save saturated downward mass flux
+    FDOWN(I)=AD
+    FT(I)=FT(I)+G*DPINV*(AMP1*(TCONV(I+1)-TCONV(I)+(GZ(I+1)-GZ(I))* &
+         CPINV)-AD*(TCONV(I)-TCONV(I-1)+(GZ(I)-GZ(I-1))*CPINV)) &
+         -SIGD*LVCP(I)*EVAP(I)
+    FT(I)=FT(I)+G*DPINV*MENT(I,I)*(HP(I)-H(I)+ &
+         TCONV(I)*(CPV-CPD)*(QCONV(I)-QENT(I,I)))*CPINV
+    FT(I)=FT(I)+SIGD*WT(I+1)*(CL-CPD)*WATER(I+1)* &
+         (TCONV(I+1)-TCONV(I))*DPINV*CPINV
+    FQ(I)=FQ(I)+G*DPINV*(AMP1*(QCONV(I+1)-QCONV(I))- &
+         AD*(QCONV(I)-QCONV(I-1)))
+    DO K=1,I-1
+      AWAT=ELIJ(K,I)-(1.-EP(I))*CLW(I)
+      AWAT=MAX(AWAT,0.0)
+      FQ(I)=FQ(I)+G*DPINV*MENT(K,I)*(QENT(K,I)-AWAT-QCONV(I))
+    END DO
+
+    FQ(I)=FQ(I)+G*DPINV*sum(MENT(I:INB,I)*(QENT(I:INB,I)-QCONV(I)))
+    FQ(I)=FQ(I)+SIGD*EVAP(I)+G*(MP(I+1)* &
+         (QP(I+1)-QCONV(I))-MP(I)*(QP(I)-QCONV(I-1)))*DPINV
+  END DO
+  !
+  !   *** Adjust tendencies at top of convection layer to reflect  ***
+  !   ***       actual position of the level zero CAPE             ***
+  !
+  FQOLD=FQ(INB)
+  FQ(INB)=FQ(INB)*(1.-FRAC)
+  FQ(INB-1)=FQ(INB-1)+FRAC*FQOLD*((PHCONV_HPA(INB)- &
+       PHCONV_HPA(INB+1))/ &
+       (PHCONV_HPA(INB-1)-PHCONV_HPA(INB)))*LV(INB)/LV(INB-1)
+  FTOLD=FT(INB)
+  FT(INB)=FT(INB)*(1.-FRAC)
+  FT(INB-1)=FT(INB-1)+FRAC*FTOLD*((PHCONV_HPA(INB)- &
+       PHCONV_HPA(INB+1))/ &
+       (PHCONV_HPA(INB-1)-PHCONV_HPA(INB)))*CPN(INB)/CPN(INB-1)
+!
+!   ***   Very slightly adjust tendencies to force exact   ***
+!   ***     enthalpy, momentum and tracer conservation     ***
+!
+  ENTS=0.0
+
+  ENTS = sum((CPN(1:INB)*FT(1:INB)+LV(1:INB)*FQ(1:INB))* &
+        (PHCONV_HPA(1:INB)-PHCONV_HPA(2:INB+1)))
+
+  ENTS=ENTS/(PHCONV_HPA(1)-PHCONV_HPA(INB+1))
+
+  FT(1:INB)=FT(1:INB) - ENTS/CPN(1:INB)
+
+  ! ************************************************
+  ! **** DETERMINE MASS DISPLACEMENT MATRIX
+  ! ***** AND COMPENSATING SUBSIDENCE
+  ! ************************************************
+
+  ! mass displacement matrix due to saturated up-and downdrafts
+  ! inside the cloud and determine compensating subsidence
+  ! FUP(I) (saturated updrafts), FDOWN(I) (saturated downdrafts) are assumed to be
+  ! balanced by  compensating subsidence (SUB(I))
+  ! FDOWN(I) and SUB(I) defined positive downwards
+
+  ! NCONVTOP IS THE TOP LEVEL AT WHICH CONVECTIVE MASS FLUXES ARE DIAGNOSED
+  ! EPSILON IS A SMALL NUMBER
+
+  FMASS(NK, :INB+1) = FMASS(NK,:INB+1)+M(:INB+1)
+  FMASS(:INB+1,:INB+1) = FMASS(:INB+1,:INB+1)+MENT(:INB+1,:INB+1)
+  SUB(1) = 0.
+  SUB(2:INB+1) = FUP(1:INB) - FDOWN(2:INB+1)
+  NCONVTOP=1
+  do i=1,INB+1
+    do j=1,INB+1
+      if (FMASS(j,i).gt.EPSILON) NCONVTOP=MAX(NCONVTOP,i,j)
+    end do
+  end do
+  NCONVTOP=NCONVTOP+1
+  RETURN
+  !
+END SUBROUTINE CONVECT
diff --git a/src/con_TLIFT.f90 b/src/con_TLIFT.f90
new file mode 100644
index 0000000000000000000000000000000000000000..d98acb285bd7f56e916c27f5e9b0a3d96a804971
--- /dev/null
+++ b/src/con_TLIFT.f90
@@ -0,0 +1,94 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+SUBROUTINE TLIFT(GZ,ICB,NK,TVP,TPK,CLW,ND,NL,KK)
+  !
+  !-cv
+  use par_mod
+
+  implicit none
+  !-cv
+  !====>Begin Module TLIFT      File convect.f      Undeclared variables
+  !
+  !Argument variables
+  !
+  integer :: icb, kk, nd, nk, nl
+  !
+  !Local variables
+  !
+  integer :: i, j, nsb, nst
+  !
+  real :: ah0, ahg, alv, cpinv, cpp, denom
+  real :: es, qg, rg, s, tc, tg
+  !
+  !====>End Module   TLIFT      File convect.f
+
+  REAL :: GZ(ND),TPK(ND),CLW(ND)
+  REAL :: TVP(ND)
+  !
+  !   ***   ASSIGN VALUES OF THERMODYNAMIC CONSTANTS     ***
+  !
+  REAL,PARAMETER :: CPD=1005.7
+  REAL,PARAMETER :: CPV=1870.0
+  REAL,PARAMETER :: CL=2500.0
+  REAL,PARAMETER :: RV=461.5
+  REAL,PARAMETER :: RD=287.04
+  REAL,PARAMETER :: LV0=2.501E6
+  !
+  REAL,PARAMETER :: CPVMCL=CL-CPV
+  REAL,PARAMETER :: EPS0=RD/RV
+  REAL,PARAMETER :: EPSI=1./EPS0
+  !
+  !   ***  CALCULATE CERTAIN PARCEL QUANTITIES, INCLUDING STATIC ENERGY   ***
+  !
+  AH0=(CPD*(1.-QCONV(NK))+CL*QCONV(NK))*TCONV(NK)+QCONV(NK)* &
+       (LV0-CPVMCL*( &
+       TCONV(NK)-273.15))+GZ(NK)
+  CPP=CPD*(1.-QCONV(NK))+QCONV(NK)*CPV
+  CPINV=1./CPP
+  !
+  IF(KK.EQ.1)THEN
+  !
+  !   ***   CALCULATE LIFTED PARCEL QUANTITIES BELOW CLOUD BASE   ***
+  !
+    CLW(1:ICB-1) = 0.0
+    TPK(NK:ICB-1)=TCONV(NK)-(GZ(NK:ICB-1)-GZ(NK))*CPINV
+    TVP(NK:ICB-1)=TPK(NK:ICB-1)*(1.+QCONV(NK)*EPSI)
+  END IF
+  !
+  !    ***  FIND LIFTED PARCEL QUANTITIES ABOVE CLOUD BASE    ***
+  !
+  NST=ICB
+  NSB=ICB
+  IF(KK.EQ.2)THEN
+    NST=NL
+    NSB=ICB+1
+  END IF
+  DO I=NSB,NST
+    TG=TCONV(I)
+    QG=QSCONV(I)
+    ALV=LV0-CPVMCL*(TCONV(I)-273.15)
+    DO J=1,2
+      S=CPD+ALV*ALV*QG/(RV*TCONV(I)*TCONV(I))
+      S=1./S
+      AHG=CPD*TG+(CL-CPD)*QCONV(NK)*TCONV(I)+ALV*QG+GZ(I)
+      TG=TG+S*(AH0-AHG)
+      TG=MAX(TG,35.0)
+      TC=TG-273.15
+      DENOM=243.5+TC
+      IF(TC.GE.0.0)THEN
+        ES=6.112*EXP(17.67*TC/DENOM)
+      ELSE
+        ES=EXP(23.33086-6111.72784/TG+0.15215*LOG(TG))
+      END IF
+      QG=EPS0*ES/(PCONV_HPA(I)-ES*(1.-EPS0))
+    END DO
+    ALV=LV0-CPVMCL*(TCONV(I)-273.15)
+    TPK(I)=(AH0-(CL-CPD)*QCONV(NK)*TCONV(I)-GZ(I)-ALV*QG)/CPD
+    CLW(I)=QCONV(NK)-QG
+    CLW(I)=MAX(0.0,CLW(I))
+    RG=QG/(1.-QCONV(NK))
+    TVP(I)=TPK(I)*(1.+RG*EPSI)
+  END DO
+  RETURN
+END SUBROUTINE TLIFT
diff --git a/src/con_alloc_convect.f90 b/src/con_alloc_convect.f90
new file mode 100644
index 0000000000000000000000000000000000000000..63d82d5ba5a261de4a7fc5c8c3a33d29e2ae5712
--- /dev/null
+++ b/src/con_alloc_convect.f90
@@ -0,0 +1,25 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine alloc_convect
+  implicit none
+  if (.not.lconvection.eq.1) return
+  ! ! nconvlevmax=nuvzmax-1
+  ! ! na=nconvlevmax+1
+  ! allocate(pconv(nconvlevmax),phconv(na),dpr(nconvlevmax), &
+  !   pconv_hpa(nconvlevmax),phconv_hpa(na),ft(nconvlevmax), &
+  !   fq(nconvlevmax),fmass(nconvlevmax,nconvlevmax),        &
+  !   sub(nconvlevmax),fmassfrac(nconvlevmax,nconvlevmax),   &
+  !   cbaseflux(0:nxmax-1,0:nymax-1),                        &
+  !   cbasefluxn(0:nxmaxn-1,0:nymaxn-1,maxnests),            &
+  !   tconv(na),qconv(na),qsconv(na))
+
+  ! allocate(uvzlev(nuvzmax),wsub(nuvzmax))
+
+  ! allocate(FUP(NA),FDOWN(NA),NENT(NA),                     &
+  !   M(NA),MP(NA),MENT(NA,NA),QENT(NA,NA),ELIJ(NA,NA),      &
+  !   SIJ(NA,NA),TVP(NA),TV(NA),WATER(NA),                   &
+  !   QP(NA),EP(NA),TH(NA),WT(NA),EVAP(NA),CLW(NA),          &
+  !   SIGP(NA),TP(NA),CPN(NA),                               &
+  !   LV(NA),LVCP(NA),H(NA),HP(NA),GZ(NA),HM(NA))
+end subroutine alloc_convect
diff --git a/src/con_calcmatrix.f90 b/src/con_calcmatrix.f90
new file mode 100644
index 0000000000000000000000000000000000000000..9cb1550646a1353a1ac98d34182188e430ef4611
--- /dev/null
+++ b/src/con_calcmatrix.f90
@@ -0,0 +1,158 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine calcmatrix(lconv,delt,cbmf)
+  !                        o    i    o
+  !*****************************************************************************
+  !                                                                            *
+  !  This subroutine calculates the matrix describing convective               *
+  !  redistribution of mass in a grid column, using the subroutine             *
+  !  convect43c.f provided by Kerry Emanuel.                                   *
+  !                                                                            *
+  !  Petra Seibert, Bernd C. Krueger, 2000-2001                                *
+  !                                                                            *
+  !*****************************************************************************
+  ! Changes:                                                                   *
+  !  changed by C. Forster, November 2003 - February 2004                      *
+  !  array fmassfrac(nconvlevmax,nconvlevmax) represents                       *
+  !  the convective redistribution matrix for the particles                    *
+  !                                                                            *
+  !   Unified ECMWF and GFS builds                                             *
+  !   Marian Harustak, 12.5.2017                                               *
+  !     - Merged calcmatrix and calcmatrix_gfs into one routine using if-then  *
+  !       for meteo-type dependent code                                        *
+  !*****************************************************************************
+  !                                                                            *
+  !  lconv        indicates whether there is convection in this cell, or not   *
+  !  delt         time step for convection [s]                                 *
+  !  cbmf         cloud base mass flux                                         *
+  !  metdata_format format of metdata (ecmwf/gfs)                              *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+  use class_gribfile_mod
+  use qvsat_mod
+
+  implicit none
+
+  real :: rlevmass,summe
+
+  integer :: iflag, k, kk, kuvz
+
+  !1-d variables for convection
+  !variables for redistribution matrix
+  real :: cbmfold, precip, qprime
+  real :: tprime, wd
+  real :: delt,cbmf
+  logical :: lconv
+
+  lconv = .false.
+
+
+  ! calculate pressure at eta levels for use in convect
+  ! and assign temp & spec. hum. to 1D workspace
+  ! -------------------------------------------------------
+
+  ! pconv(1) is the pressure at the first level above ground
+  ! phconv(k) is the pressure between levels k-1 and k
+  ! dpr(k) is the pressure difference "around" tconv(k)
+  ! phconv(kmax) must also be defined 1/2 level above pconv(kmax)
+  ! Therefore, we define k = kuvz-1 and let kuvz start from 2
+  ! top layer cannot be used for convection because p at top of this layer is
+  ! not given
+
+
+  phconv(1) = psconv
+  ! Emanuel subroutine needs pressure in hPa, therefore convert all pressures
+  ! do kuvz = 2,nuvz
+  !   k = kuvz-1
+  !   if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
+  !     pconv(k) = (akz(kuvz) + bkz(kuvz)*psconv)
+  !     phconv(kuvz) = (akm(kuvz) + bkm(kuvz)*psconv)
+  !   else
+  !     phconv(kuvz) =  0.5*(pconv(kuvz)+pconv(k))
+  !   endif
+  !   dpr(k) = phconv(k) - phconv(kuvz)
+  !   qsconv(k) = f_qvsat( pconv(k), tconv(k) )
+
+  ! initialize mass fractions
+    ! do kk=1,nconvlev
+    !   fmassfrac(k,kk)=0.
+    ! end do
+  ! end do
+  ! LB 04.05.2021, replace above with array operations
+  if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
+    pconv(1:nuvz-1) = (akz(2:nuvz) + bkz(2:nuvz)*psconv)
+    phconv(2:nuvz) = (akm(2:nuvz) + bkm(2:nuvz)*psconv)
+  else
+    phconv(2:nuvz) =  0.5*(pconv(2:nuvz)+pconv(1:nuvz-1))
+  endif
+  dpr(1:nuvz-1) = phconv(1:nuvz-1) - phconv(2:nuvz)
+  do k = 1,nuvz-1
+    qsconv(k) = f_qvsat( pconv(k), tconv(k) )
+  end do
+  fmassfrac(1:nuvz-1,1:nconvlev)=0.
+  ! LB end
+
+  !note that Emanuel says it is important
+  !a. to set this =0. every grid point
+  !b. to keep this value in the calling programme in the iteration
+
+  ! CALL CONVECTION
+  !******************
+
+  cbmfold = cbmf
+  ! Convert pressures to hPa, as required by Emanuel scheme
+  !********************************************************
+  !!$    do k=1,nconvlev     !old
+  ! do k=1,nconvlev+1      !bugfix
+  !   pconv_hpa(k)=pconv(k)/100.
+  !   phconv_hpa(k)=phconv(k)/100.
+  ! end do
+  ! phconv_hpa(nconvlev+1)=phconv(nconvlev+1)/100.
+  ! LB 04.05.2021, replace above with array operations
+  pconv_hpa(1:nconvlev+1)=pconv(1:nconvlev+1)/100.
+  phconv_hpa(1:nconvlev+1)=phconv(1:nconvlev+1)/100.
+  ! LB end
+
+  call convect(nconvlevmax, nconvlev, delt, iflag, &
+       precip, wd, tprime, qprime, cbmf)
+
+  ! do not update fmassfrac and cloudbase massflux
+  ! if no convection takes place or
+  ! if a CFL criterion is violated in convect43c.f
+  if (iflag .ne. 1 .and. iflag .ne. 4) then
+   cbmf=cbmfold
+   return
+  endif
+
+  ! do not update fmassfrac and cloudbase massflux
+  ! if the old and the new cloud base mass
+  ! fluxes are zero
+  if (cbmf.le.0..and.cbmfold.le.0.) then
+   cbmf=cbmfold
+   return
+  endif
+
+  ! Update fmassfrac
+  ! account for mass displaced from level k to level k
+
+  lconv = .true.
+  do k=1,nconvtop
+    rlevmass = dpr(k)/ga
+    summe = 0.
+    do kk=1,nconvtop
+      fmassfrac(k,kk) = delt*fmass(k,kk)
+      summe = summe + fmassfrac(k,kk)
+    end do
+    fmassfrac(k,k)=fmassfrac(k,k) + rlevmass - summe
+  end do
+  ! LB 04.05.2021, replace above with array operations (not the problem)
+  ! fmassfrac(1:nconvtop,1:nconvtop) = delt*fmass(1:nconvtop,1:nconvtop)
+  ! do k=1, nconvtop
+  !     fmassfrac(k, k) = fmassfrac(k, k) + dpr(k)/ga - sum(fmassfrac(k, 1:nconvtop))
+  ! end do
+  ! LB end
+end subroutine calcmatrix
diff --git a/src/con_convmix.f90 b/src/con_convmix.f90
new file mode 100644
index 0000000000000000000000000000000000000000..b9f2c3ffdd320aad6c4e414ad8f0361b4acdfa57
--- /dev/null
+++ b/src/con_convmix.f90
@@ -0,0 +1,375 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine convmix(itime)
+  !                     i
+  !**************************************************************
+  !handles all the calculations related to convective mixing
+  !Petra Seibert, Bernd C. Krueger, Feb 2001
+  !nested grids included, Bernd C. Krueger, May 2001
+  !
+  !Changes by Caroline Forster, April 2004 - February 2005:
+  !  convmix called every lsynctime seconds
+  !CHANGES by A. Stohl:
+  !  various run-time optimizations - February 2005
+  ! CHANGES by C. Forster, November 2005, NCEP GFS version
+  !      in the ECMWF version convection is calculated on the
+  !      original eta-levels
+  !      in the GFS version convection is calculated on the
+  !      FLEXPART levels
+  !
+  !   Unified ECMWF and GFS builds
+  !   Marian Harustak, 12.5.2017
+  !     - Merged convmix and convmix_gfs into one routine using if-then
+  !       for meteo-type dependent code
+  !**************************************************************
+  use omp_lib
+  use flux_mod
+  use par_mod
+  use com_mod
+  use class_gribfile_mod
+  use particle_mod
+
+  implicit none
+
+  integer :: igr,igrold, ipart, itime, ix, j, inest
+  integer :: ipconv,thread,ithread
+  integer :: jy, kpart, ktop, ngrid,kz
+  integer,allocatable :: igrid(:), ipoint(:), igridn(:,:)
+
+  ! itime [s]                 current time
+  ! igrid(maxpart)            horizontal grid position of each particle
+  ! igridn(maxpart,maxnests)  dto. for nested grids
+  ! ipoint(maxpart)           pointer to access particles according to grid position
+
+  logical :: lconv
+  real :: x, y, xtn,ytn, ztold, delt
+  real :: dt1,dt2,dtt
+  integer :: mind1,mind2
+  ! dt1,dt2,dtt,mind1,mind2       variables used for time interpolation
+  integer :: itage,nage,inage
+
+  ! OMP changes
+  integer :: cnt,kk
+  integer,allocatable,dimension(:) :: frst
+  double precision :: tmarray(2)
+
+  integer :: totpart,alivepart
+  real:: eps
+  eps=nxmax/3.e5
+  ! Calculate auxiliary variables for time interpolation
+  !*****************************************************
+
+  dt1=real(itime-memtime(1))
+  dt2=real(memtime(2)-itime)
+  dtt=1./(dt1+dt2)
+  mind1=memind(1)
+  mind2=memind(2)
+  delt=real(abs(lsynctime))
+
+  lconv = .false.
+
+  ! if no particles are present return after initialization
+  !********************************************************
+  call get_alivepart_num(alivepart)
+  if (alivepart.le.0 ) return
+
+  call get_totalpart_num(totpart)
+  allocate( igrid(totpart) )
+  allocate( ipoint(totpart) )
+  allocate( igridn(totpart,maxnests) )
+
+  ! Assign igrid and igridn, which are pseudo grid numbers indicating particles
+  ! that are outside the part of the grid under consideration
+  ! (e.g. particles near the poles or particles in other nests).
+  ! Do this for all nests but use only the innermost nest; for all others
+  ! igrid shall be -1
+  ! Also, initialize index vector ipoint
+  !************************************************************************
+!$OMP PARALLEL PRIVATE(ipart, j, x, y, ngrid, xtn, ytn, ix, jy)
+!$OMP DO
+  do ipart=1,numpart
+    igrid(ipart)=-1
+    do j=numbnests,1,-1
+      igridn(ipart,j)=-1
+    end do
+    ipoint(ipart)=ipart
+  ! do not consider particles that are not (yet) part of simulation
+    if (.not. part(ipart)%alive) cycle
+    x = part(ipart)%xlon
+    y = part(ipart)%ylat
+
+  ! Determine which nesting level to be used
+  !**********************************************************
+
+    ngrid=0
+    if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
+      do j=numbnests,1,-1
+        ! Temporary fix for nested layer edges: replaced eps with dxn and dyn (LB)
+        if ( x.gt.xln(j)+dxn(j) .and. x.lt.xrn(j)-dxn(j) .and. &
+             y.gt.yln(j)+dyn(j) .and. y.lt.yrn(j)-dyn(j) ) then
+          ngrid=j
+          exit
+        endif
+      end do
+    else
+      do j=numbnests,1,-1
+        if ( x.gt.xln(j) .and. x.lt.xrn(j) .and. &
+             y.gt.yln(j) .and. y.lt.yrn(j) ) then
+          ngrid=j
+          exit
+        endif
+      end do
+    endif
+ ! 23   continue
+
+  ! Determine nested grid coordinates
+  !**********************************
+
+    if (ngrid.gt.0) then
+  ! nested grids
+      xtn=(x-xln(ngrid))*xresoln(ngrid)
+      ytn=(y-yln(ngrid))*yresoln(ngrid)
+      ix=nint(xtn)
+      jy=nint(ytn)
+      ! igridn(ipart,ngrid) = 1 + jy*nxn(ngrid) + ix
+      igridn(ipart,ngrid) = 1 + ix*nyn(ngrid) + jy
+    else if(ngrid.eq.0) then
+  ! mother grid
+      ix=nint(x)
+      jy=nint(y)
+      !igrid(ipart) = 1 + jy*nx + ix
+      igrid(ipart) = 1 + ix*ny + jy
+    endif
+  end do
+!$OMP END DO
+!$OMP END PARALLEL
+
+  ! sumall = 0.
+  ! sumconv = 0.
+
+  !*****************************************************************************
+  ! 1. Now, do everything for the mother domain and, later, for all of the nested domains
+  ! While all particles have to be considered for redistribution, the Emanuel convection
+  ! scheme only needs to be called once for every grid column where particles are present.
+  ! Therefore, particles are sorted according to their grid position. Whenever a new grid
+  ! cell is encountered by looping through the sorted particles, the convection scheme is called.
+  !*****************************************************************************
+
+  ! sort particles according to horizontal position and calculate index vector IPOINT
+
+  call sort2(numpart,igrid,ipoint)
+
+  ! Now visit all grid columns where particles are present
+  ! by going through the sorted particles
+
+  !LB changes following the CTM version
+  allocate(frst(nx*(ny+1)+1))
+  frst(1) = 1
+  cnt = 2
+  igrold = igrid(1)
+  ! Looping over all particles and counting how many in each igrid reside.
+  ! This is saved in frst. The number of consecutive particles in igrid is saved in frst(i)
+  do kpart=1,numpart
+    if (igrold.ne.igrid(kpart)) then
+      frst(cnt) = kpart
+      igrold=igrid(kpart)
+      cnt=cnt+1
+    endif
+  end do
+  frst(cnt) = numpart+1
+
+!$OMP PARALLEL PRIVATE(kk,jy,ix,tmarray,j,kz,ktop,lconv,kpart,ipart,&
+!$OMP ztold,nage,ipconv,itage,thread)
+
+#if (defined _OPENMP)
+    thread = OMP_GET_THREAD_NUM() ! Starts at 0
+#else
+    thread = 0
+#endif
+
+!$OMP DO SCHEDULE(static)
+  do kk=1,cnt-1
+    ! Only consider grids that have particles inside
+    if (igrid(frst(kk)).eq.-1) cycle
+
+    ! Find horizontal location of grid column
+    ix = (igrid(frst(kk))-1)/ny
+    jy = igrid(frst(kk)) - ix*ny - 1
+    ! jy = (igrid(frst(kk))-1)/nx
+    ! ix = igrid(frst(kk)) - jy*nx - 1
+
+  ! Interpolate all meteorological data needed for the convection scheme
+    psconv=(ps(ix,jy,1,mind1)*dt2+ps(ix,jy,1,mind2)*dt1)*dtt
+    tt2conv=(tt2(ix,jy,1,mind1)*dt2+tt2(ix,jy,1,mind2)*dt1)*dtt
+    td2conv=(td2(ix,jy,1,mind1)*dt2+td2(ix,jy,1,mind2)*dt1)*dtt
+
+    if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
+      do kz=1,nuvz-1           !bugfix
+        tconv(kz)=(tth(ix,jy,kz+1,mind1)*dt2+ &
+             tth(ix,jy,kz+1,mind2)*dt1)*dtt
+        qconv(kz)=(qvh(ix,jy,kz+1,mind1)*dt2+ &
+             qvh(ix,jy,kz+1,mind2)*dt1)*dtt
+      end do
+    else
+      do kz=1,nuvz-1           !bugfix
+        pconv(kz)=(pplev(ix,jy,kz,mind1)*dt2+ &
+            pplev(ix,jy,kz,mind2)*dt1)*dtt
+        tconv(kz)=(tt(ix,jy,kz,mind1)*dt2+ &
+            tt(ix,jy,kz,mind2)*dt1)*dtt
+        qconv(kz)=(qv(ix,jy,kz,mind1)*dt2+ &
+            qv(ix,jy,kz,mind2)*dt1)*dtt
+      end do
+    end if
+
+  ! Calculate translocation matrix
+    call calcmatrix(lconv,delt,cbaseflux(ix,jy))
+
+  ! treat particle only if column has convection
+    if (lconv .eqv. .true.) then
+      ktop = 0
+  ! assign new vertical position to particle
+      do kpart=frst(kk), frst(kk+1)-1
+        ipart = ipoint(kpart)
+        ztold=real(part(ipart)%z)
+        call redist(itime,ipart,ktop,ipconv)
+  !    if (ipconv.le.0) sumconv = sumconv+1
+
+  ! Calculate the gross fluxes across layer interfaces
+  !***************************************************
+
+        if (iflux.eq.1) then
+          itage=abs(itime-part(ipart)%tstart)
+          nage=1
+          do inage=1,nageclass
+            nage=inage
+            if ((itage.lt.lage(nage)).or.(.not.part(ipart)%alive)) exit
+          end do
+
+          if (nage.le.nageclass) &
+            call calcfluxes(itime,nage,ipart,real(part(ipart)%xlon), &
+               real(part(ipart)%ylat),ztold,thread+1)
+        endif
+      enddo
+
+    endif   !(lconv .eqv. .true)
+  end do
+!$OMP END DO
+!$OMP END PARALLEL
+
+  deallocate(frst)
+
+  ! OpenMP Reduction for dynamically allocated arrays. This is done manually since this
+  ! is not yet supported in most OpenMP versions
+  !************************************************************************************
+  if (iflux.eq.1) then
+    do ithread=1,numthreads
+      flux(:,:,:,:,:,:,:)=flux(:,:,:,:,:,:,:)+flux_omp(:,:,:,:,:,:,:,ithread)
+    end do
+  endif
+
+  !*****************************************************************************
+  ! 2. Nested domains
+  !*****************************************************************************
+
+  ! sort particles according to horizontal position and calculate index vector IPOINT
+  do inest=1,numbnests
+    do ipart=1,numpart
+      ipoint(ipart)=ipart
+      igrid(ipart) = igridn(ipart,inest)
+    enddo
+    call sort2(numpart,igrid,ipoint)
+
+  ! Now visit all grid columns where particles are present
+  ! by going through the sorted particles
+!$OMP PARALLEL PRIVATE (igrold,kpart,ipart,igr,jy,ix,kz,lconv, &
+!$OMP ktop,ztold,nage,ipconv,itage)
+    igrold = -1
+!$OMP DO
+    do kpart=1,numpart
+      igr = igrid(kpart)
+      if (igr .eq. -1) cycle
+      ipart = ipoint(kpart)
+      ! sumall = sumall + 1
+      if (igr .ne. igrold) then
+  ! we are in a new grid column
+        jy = (igr-1)/nxn(inest)
+        ix = igr - jy*nxn(inest) - 1
+
+  ! Interpolate all meteorological data needed for the convection scheme
+        psconv=(psn(ix,jy,1,mind1,inest)*dt2+ &
+             psn(ix,jy,1,mind2,inest)*dt1)*dtt
+        tt2conv=(tt2n(ix,jy,1,mind1,inest)*dt2+ &
+             tt2n(ix,jy,1,mind2,inest)*dt1)*dtt
+        td2conv=(td2n(ix,jy,1,mind1,inest)*dt2+ &
+             td2n(ix,jy,1,mind2,inest)*dt1)*dtt
+!!$        do kz=1,nconvlev+1    !old
+        do kz=1,nuvz-1           !bugfix
+          tconv(kz)=(tthn(ix,jy,kz+1,mind1,inest)*dt2+ &
+               tthn(ix,jy,kz+1,mind2,inest)*dt1)*dtt
+          qconv(kz)=(qvhn(ix,jy,kz+1,mind1,inest)*dt2+ &
+               qvhn(ix,jy,kz+1,mind2,inest)*dt1)*dtt
+        end do
+
+  ! calculate translocation matrix
+  !*******************************
+        call calcmatrix(lconv,delt,cbasefluxn(ix,jy,inest))
+        igrold = igr
+        ktop = 0
+      endif
+
+  ! treat particle only if column has convection
+      if (lconv .eqv. .true.) then
+  ! assign new vertical position to particle
+        ztold=part(ipart)%z
+        call redist(itime,ipart,ktop,ipconv)
+  !      if (ipconv.le.0) sumconv = sumconv+1
+
+  ! Calculate the gross fluxes across layer interfaces
+  !***************************************************
+
+        if (iflux.eq.1) then
+          itage=abs(itime-part(ipart)%tstart)
+          nage=1
+          do inage=1,nageclass
+            nage=inage
+            if ((itage.lt.lage(nage)).or.(.not.part(ipart)%alive)) exit
+          end do
+
+          if (nage.le.nageclass) &
+               call calcfluxes(itime,nage,ipart,real(part(ipart)%xlon), &
+               real(part(ipart)%ylat),ztold,1)
+        endif
+
+      endif !(lconv .eqv. .true.)
+
+    end do
+!$OMP END DO
+!$OMP END PARALLEL
+  end do
+  ! OpenMP Reduction for dynamically allocated arrays. This is done manually since this
+  ! is not yet supported in most OpenMP versions
+  !************************************************************************************
+  if (iflux.eq.1) then
+    do ithread=1,numthreads
+      flux(:,:,:,:,:,:,:)=flux(:,:,:,:,:,:,:)+flux_omp(:,:,:,:,:,:,:,ithread)
+    end do
+  endif
+  !--------------------------------------------------------------------------
+  ! write(*,*)'############################################'
+  ! write(*,*)'TIME=',&
+  !    &  itime
+  ! write(*,*)'fraction of particles under convection',&
+  !    &  sumconv/(sumall+0.001)
+  ! write(*,*)'total number of particles',&
+  !    &  sumall
+  ! write(*,*)'number of particles under convection',&
+  !    &  sumconv
+  ! write(*,*)'############################################'
+
+  deallocate( igrid )
+  deallocate( ipoint )
+  deallocate( igridn )
+
+  return
+end subroutine convmix
diff --git a/src/con_dealloc_convect.f90 b/src/con_dealloc_convect.f90
new file mode 100644
index 0000000000000000000000000000000000000000..01b31085a2f803666e9327d80e31e6dd13203620
--- /dev/null
+++ b/src/con_dealloc_convect.f90
@@ -0,0 +1,13 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine dealloc_convect
+  implicit none
+  if (.not.lconvection.eq.1) return
+  ! deallocate(pconv,phconv,dpr,pconv_hpa,phconv_hpa,ft,fq,sub, &
+  !   tconv,qconv,qsconv,fmass,fmassfrac,cbaseflux,cbasefluxn)
+  ! deallocate(uvzlev,wsub)
+  ! deallocate(fup,fdown,ment,M,MP,QENT,ELIJ,SIJ,TVP,TV, &
+  !   WATER,QP,EP,TH,WT,EVAP,CLW,SIGP,TP,CPN,LV,LVCP, &
+  !   H,HP,GZ,HM)
+end subroutine dealloc_convect
diff --git a/src/con_redist.f90 b/src/con_redist.f90
new file mode 100644
index 0000000000000000000000000000000000000000..a93d477bbe6c719de990f9c2a38360f6ff8c3e71
--- /dev/null
+++ b/src/con_redist.f90
@@ -0,0 +1,308 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine redist(itime,ipart,ktop,ipconv)
+
+  !**************************************************************************
+  ! Do the redistribution of particles due to convection
+  ! This subroutine is called for each particle which is assigned
+  ! a new vertical position randomly, based on the convective redistribution
+  ! matrix
+  !**************************************************************************
+
+  ! Petra Seibert, Feb 2001, Apr 2001, May 2001, Jan 2002, Nov 2002 and
+  ! Andreas Frank, Nov 2002
+
+  ! Caroline Forster:  November 2004 - February 2005
+
+  use par_mod
+  use com_mod
+  use random_mod
+  use omp_lib
+  use interpol_mod
+  use coord_ec_mod
+  use particle_mod
+  use qvsat_mod
+
+  implicit none
+
+  real,parameter :: const=r_air/ga
+  integer :: ipart, ktop,ipconv,itime
+  integer :: k, kz, levnew, levold,ithread
+
+  real :: totlevmass, wsubpart
+  real :: temp_levold,temp_levold1
+  real :: sub_levold,sub_levold1
+  real :: pint, pold, rn, tv, tvold, dlevfrac
+  real :: ztold,ffraction
+  real :: tv1, tv2, dlogp, dz, dz1, dz2
+
+#ifdef _OPENMP
+  ithread = OMP_GET_THREAD_NUM() ! Starts at 0
+#else
+  ithread=0
+#endif
+
+  ! ipart   ... number of particle to be treated
+
+  ipconv=1
+
+  ! !  determine vertical grid position of particle in the eta system
+  ! !****************************************************************
+  select case (wind_coord_type)
+
+    case ('ETA')
+      ztold = real(part(abs(ipart))%zeta)
+      ! find old particle grid position
+      levold = nconvtop
+      do kz = 2, nconvtop
+        if (wheight(kz) .le. ztold ) then
+          levold = kz-1
+          exit
+        endif
+      end do
+
+    case ('METER')
+
+      ! determine height of the eta half-levels (uvzlev)
+      ! do that only once for each grid column
+      ! i.e. when ktop.eq.1
+      !**************************************************************
+
+      if (ktop .le. 1) then
+
+        tvold=tt2conv*(1.+0.378*ew(td2conv,psconv)/psconv)
+        pold=psconv
+        uvzlev(1)=0.
+
+        pint = phconv(2)
+      !  determine next virtual temperatures
+        tv1 = tconv(1)*(1.+0.608*qconv(1))
+        tv2 = tconv(2)*(1.+0.608*qconv(2))
+      !  interpolate virtual temperature to half-level
+        tv = tv1 + (tv2-tv1)*(pconv(1)-phconv(2))/(pconv(1)-pconv(2))
+        tv = tv1 + (tv2-tv1)*(pconv(1)-phconv(2))/(pconv(1)-pconv(2))
+        if (abs(tv-tvold).gt.0.2) then
+          uvzlev(2) = uvzlev(1) + &
+               const*log(pold/pint)* &
+               (tv-tvold)/log(tv/tvold)
+        else
+          uvzlev(2) = uvzlev(1)+ &
+               const*log(pold/pint)*tv
+        endif
+        tvold=tv
+        tv1=tv2
+        pold=pint
+
+      ! integrate profile (calculation of height agl of eta layers) as required
+        do kz = 3, nconvtop+1
+      !    note that variables defined in calcmatrix.f (pconv,tconv,qconv)
+      !    start at the first real ECMWF model level whereas kz and
+      !    thus uvzlev(kz) starts at the surface. uvzlev is defined at the
+      !    half-levels (between the tconv, qconv etc. values !)
+      !    Thus, uvzlev(kz) is the lower boundary of the tconv(kz) cell.
+          pint = phconv(kz)
+      !    determine next virtual temperatures
+          tv2 = tconv(kz)*(1.+0.608*qconv(kz))
+      !    interpolate virtual temperature to half-level
+          tv = tv1 + (tv2-tv1)*(pconv(kz-1)-phconv(kz))/ &
+               (pconv(kz-1)-pconv(kz))
+          tv = tv1 + (tv2-tv1)*(pconv(kz-1)-phconv(kz))/ &
+               (pconv(kz-1)-pconv(kz))
+          if (abs(tv-tvold).gt.0.2) then
+            uvzlev(kz) = uvzlev(kz-1) + &
+                 const*log(pold/pint)* &
+                 (tv-tvold)/log(tv/tvold)
+          else
+            uvzlev(kz) = uvzlev(kz-1)+ &
+                 const*log(pold/pint)*tv
+          endif
+          tvold=tv
+          tv1=tv2
+          pold=pint
+
+
+        end do
+
+        ktop = 2
+
+      endif
+
+      ztold = real(part(abs(ipart))%z)
+      ! find old particle grid position
+      levold = nconvtop
+      do kz = 2, nconvtop
+        if (uvzlev(kz) .ge. ztold ) then
+          levold = kz-1
+          exit
+        endif
+      end do
+    case default
+      write(*,*) 'The wind_coord_type is not defined in redist.f90'
+      stop
+
+  end select
+
+  ! If the particle is above the potentially convective domain, it will be skipped
+  if (levold.ne.nconvtop) then
+
+    ! now redistribute particles
+    !****************************
+
+    !  Choose a random number and find corresponding level of destination
+    !  Random numbers to be evenly distributed in [0,1]
+
+    rn = ran3(iseed2(ithread),ithread)
+
+    ! initialize levnew
+
+    levnew = levold
+
+    ffraction = 0.
+    totlevmass=dpr(levold)/ga
+    loop1: do k = 1,nconvtop
+    ! for backward runs use the transposed matrix
+     if (ldirect.eq.1) then
+       ffraction=ffraction+fmassfrac(levold,k) &
+            /totlevmass
+     else
+       ffraction=ffraction+fmassfrac(k,levold) &
+            /totlevmass
+     endif
+     if (rn.le.ffraction) then
+       levnew=k
+    ! avoid division by zero or a too small number
+    ! if division by zero or a too small number happens the
+    ! particle is assigned to the center of the grid cell
+       if (ffraction.gt.1.e-20) then
+        if (ldirect.eq.1) then
+          dlevfrac = (ffraction-rn) / fmassfrac(levold,k) * totlevmass
+        else
+          dlevfrac = (ffraction-rn) / fmassfrac(k,levold) * totlevmass
+        endif
+       else
+         dlevfrac = 0.5
+       endif
+       exit loop1
+     endif
+    end do loop1
+
+    ! now assign new position to particle
+    select case (wind_coord_type)
+
+      case ('ETA')
+        if ((levnew.le.nconvtop).and.(levnew.ne.levold)) then
+          dlogp = (1.-dlevfrac) * (wheight(levnew+1)-wheight(levnew))
+          call set_zeta(ipart,wheight(levnew)+dlogp)
+          if (part(abs(ipart))%zeta.ge.1.) call set_zeta(ipart,1.-(part(abs(ipart))%zeta-1.))
+          if (part(abs(ipart))%zeta.eq.1.) call update_zeta(ipart,-1.e-4)
+          if (ipconv.gt.0) ipconv=-1
+        endif
+
+      case ('METER')
+        if ((levnew.le.nconvtop).and.(levnew.ne.levold)) then
+          dlogp = (1.-dlevfrac)* (log(phconv(levnew+1))-log(phconv(levnew)))
+          pint = log(phconv(levnew))+dlogp
+          dz1 = pint - log(phconv(levnew))
+          dz2 = log(phconv(levnew+1)) - pint
+          dz = dz1 + dz2
+          call set_z(ipart,(uvzlev(levnew)*dz2+uvzlev(levnew+1)*dz1)/dz)
+          if (part(abs(ipart))%z.lt.0.) call set_z(ipart,-1.*part(abs(ipart))%z)
+          if (ipconv.gt.0) ipconv=-1
+        endif
+
+      case default
+        write(*,*) 'The chosen wind_coord_type is not defined in redist.f90'
+        stop
+
+    end select
+
+    ! displace particle according to compensating subsidence
+    ! this is done to those particles, that were not redistributed
+    ! by the matrix
+    !**************************************************************
+
+    if ((levnew.le.nconvtop).and.(levnew.eq.levold)) then
+
+      ! determine compensating vertical velocity at the levels
+      ! above and below the particel position
+      ! increase compensating subsidence by the fraction that
+      ! is displaced by convection to this level
+
+      if (levold.gt.1) then
+        temp_levold = tconv(levold-1) + &
+            (tconv(levold)-tconv(levold-1)) &
+            *(pconv(levold-1)-phconv(levold))/ &
+            (pconv(levold-1)-pconv(levold))
+        ! Bug fix: Added lsynctime to make units correct
+        sub_levold = sub(levold)/(1.-ga*sub(levold)*lsynctime/dpr(levold))
+        wsub(levold)=-1.*sub_levold*r_air*temp_levold/(phconv(levold))
+      else
+        wsub(levold)=0.
+      endif
+
+      temp_levold1 = tconv(levold) + &
+          (tconv(levold+1)-tconv(levold)) &
+          *(pconv(levold)-phconv(levold+1))/ &
+          (pconv(levold)-pconv(levold+1))
+      ! Bug fix: Added lsynctime to make units correct
+      sub_levold1 = sub(levold+1)/(1.-ga*sub(levold+1)*lsynctime/dpr(levold+1))
+      wsub(levold+1)=-1.*sub_levold1*r_air*temp_levold1/ &
+          (phconv(levold+1))
+
+      ! interpolate wsub to the vertical particle position
+      select case (wind_coord_type)
+        case ('ETA')
+          ztold = real(part(abs(ipart))%zeta)
+          dz1 = ztold - wheight(levold)
+          dz2 = wheight(levold+1) - ztold
+          dz = dz1 + dz2
+
+          ! Convert z(eta) to z(m) in order to add subsidence
+          call update_zeta_to_z(itime, ipart)
+          ! call zeta_to_z(itime,part(abs(ipart))%xlon,part(abs(ipart))%ylat, &
+          !   part(abs(ipart))%zeta,part(abs(ipart))%z)
+
+          wsubpart = (dz2*wsub(levold)+dz1*wsub(levold+1))/dz
+
+          call update_z(ipart,wsubpart*real(lsynctime))
+
+          if (part(abs(ipart))%z.lt.0.) call set_z(ipart,-1.*part(abs(ipart))%z)
+
+          ! Convert new z(m) back to z(eta)
+          call update_z_to_zeta(itime, ipart)
+
+        case ('METER')
+          ztold = real(part(abs(ipart))%z)
+          dz1 = ztold - uvzlev(levold)
+          dz2 = uvzlev(levold+1) - ztold
+          dz = dz1 + dz2
+
+          wsubpart = (dz2*wsub(levold)+dz1*wsub(levold+1))/dz
+
+          call update_z(ipart,wsubpart*real(lsynctime))
+
+          if (part(abs(ipart))%z.lt.0.) call set_z(ipart,-1.*part(abs(ipart))%z)
+
+        case default
+          write(*,*) 'The wind_coord_type is not defined in redist.f90'
+          stop
+      end select
+    endif      !(levnew.le.nconvtop.and.levnew.eq.levold)
+  endif
+  ! Maximum altitude .5 meter below uppermost model level
+  !*******************************************************
+
+  select case (wind_coord_type)
+    case ('ETA')
+      if (part(abs(ipart))%zeta .lt. uvheight(nz)) call set_zeta(ipart,uvheight(nz)+1.e-4)
+      if (part(abs(ipart))%zeta.ge.1.) call set_zeta(ipart,1.-(part(abs(ipart))%zeta-1.))
+      if (part(abs(ipart))%zeta.eq.1.) call update_zeta(ipart,-1.e-4)
+    case ('METER')
+      if (part(abs(ipart))%z .gt. height(nz)-0.5) call set_z(ipart,height(nz)-0.5)
+    case default
+      write(*,*) 'The wind_coord_type is not defined in redist.f90'
+      stop
+  end select
+
+end subroutine redist
diff --git a/src/con_set_conv_top.f90 b/src/con_set_conv_top.f90
new file mode 100644
index 0000000000000000000000000000000000000000..7c0bc69eb9922439d1220353ed137aadea89b3ce
--- /dev/null
+++ b/src/con_set_conv_top.f90
@@ -0,0 +1,23 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine set_conv_top()
+! Determine the uppermost level for which the convection scheme shall be applied
+! by assuming that there is no convection above 50 hPa (for standard SLP)
+!*****************************************************************************
+
+  integer :: i
+  real :: pint
+
+  do i=1,nuvz-2
+    pint=akz(i)+bkz(i)*101325.
+    if (pint.lt.5000.) exit
+  end do
+  nconvlev=i
+  if (nconvlev.gt.nconvlevmax-1) then
+    nconvlev=nconvlevmax-1
+    write(*,*) 'INFORMATION: Convection only calculated up to ', &
+         akz(nconvlev)+bkz(nconvlev)*1013.25,' hPa'
+  endif
+
+end subroutine set_conv_top
diff --git a/src/con_sort2.f90 b/src/con_sort2.f90
new file mode 100644
index 0000000000000000000000000000000000000000..28e4c40a02d136f2e0052f7a8494c9542c2f573e
--- /dev/null
+++ b/src/con_sort2.f90
@@ -0,0 +1,110 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine sort2(n,arr,brr)
+  ! From numerical recipes
+  ! Change by A. Stohl: Use of integer instead of real values
+  implicit none
+
+  integer, intent(in) :: n
+  integer, intent(inout) :: arr(n),brr(n)
+  integer,parameter :: m=7,nstack=50
+  integer :: i,ir,j,jstack,k,l,istack(nstack)
+  integer :: a,b,temp
+  jstack=0
+  l=1
+  ir=n
+  do
+    if(ir-l.lt.m)then
+      do j=l+1,ir
+        a=arr(j)
+        b=brr(j)
+        i=j-1
+        do while(i.gt.0)
+          if (arr(i).le.a) exit
+          arr(i+1)=arr(i)
+          brr(i+1)=brr(i)
+          i=i-1
+        end do
+        arr(i+1)=a
+        brr(i+1)=b
+      end do
+      if(jstack.eq.0)return
+      ir=istack(jstack)
+      l=istack(jstack-1)
+      jstack=jstack-2
+    else
+      k=(l+ir)/2
+      temp=arr(k)
+      arr(k)=arr(l+1)
+      arr(l+1)=temp
+      temp=brr(k)
+      brr(k)=brr(l+1)
+      brr(l+1)=temp
+      if(arr(l+1).gt.arr(ir))then
+        temp=arr(l+1)
+        arr(l+1)=arr(ir)
+        arr(ir)=temp
+        temp=brr(l+1)
+        brr(l+1)=brr(ir)
+        brr(ir)=temp
+      endif
+      if(arr(l).gt.arr(ir))then
+        temp=arr(l)
+        arr(l)=arr(ir)
+        arr(ir)=temp
+        temp=brr(l)
+        brr(l)=brr(ir)
+        brr(ir)=temp
+      endif
+      if(arr(l+1).gt.arr(l))then
+        temp=arr(l+1)
+        arr(l+1)=arr(l)
+        arr(l)=temp
+        temp=brr(l+1)
+        brr(l+1)=brr(l)
+        brr(l)=temp
+      endif
+      i=l+1
+      j=ir
+      a=arr(l)
+      b=brr(l)
+      do
+        do
+          i=i+1
+          if(arr(i).ge.a) exit
+        end do
+        do
+          j=j-1
+          if(arr(j).le.a) exit
+        end do
+        if(j.lt.i) exit
+        temp=arr(i)
+        arr(i)=arr(j)
+        arr(j)=temp
+        temp=brr(i)
+        brr(i)=brr(j)
+        brr(j)=temp
+      end do
+      arr(l)=arr(j)
+      arr(j)=a
+      brr(l)=brr(j)
+      brr(j)=b
+      jstack=jstack+2
+      if(jstack.gt.nstack) then
+         print*, 'nstack too small in sort2'
+         stop
+      end if
+      if(ir-i+1.ge.j-l)then
+        istack(jstack)=ir
+        istack(jstack-1)=i
+        ir=j-1
+      else
+        istack(jstack)=j-1
+        istack(jstack-1)=l
+        l=i
+      endif
+    endif
+  end do
+!  (C) Copr. 1986-92 Numerical Recipes Software us.
+end subroutine sort2
diff --git a/src/conv_mod.f90 b/src/conv_mod.f90
index b295c2ebc9a2a2e78865b5de72935e3a911211f4..0c623b3ac9f5b67541d4ac1acf32b27b64a2a02e 100644
--- a/src/conv_mod.f90
+++ b/src/conv_mod.f90
@@ -29,7 +29,7 @@ module conv_mod
   !these parameters are defined in par_mod now!
   ! I do not know how to allocate each array for each thread, not automaticaly done...
   real :: &!,allocatable,dimension(:) ::     &
-    pconv(nconvlevmax),                & ! 
+    pconv(nconvlevmax),                & !
     phconv(na),                        & !
     dpr(nconvlevmax),                  & !
     pconv_hpa(nconvlevmax),            & !
@@ -39,11 +39,11 @@ module conv_mod
     sub(nconvlevmax),                  & ! subsidence
     tconv(na),                         & !
     qconv(na),                         & !
-    qsconv(na)                            
+    qsconv(na)
   real :: &!,allocatable,dimension(:,:) ::    & !
     fmass(nconvlevmax,nconvlevmax),     & !
     fmassfrac(nconvlevmax,nconvlevmax), & !
-    cbaseflux(0:nxmax-1,0:nymax-1)                         
+    cbaseflux(0:nxmax-1,0:nymax-1)
   real :: &!,allocatable,dimension(:,:,:) :: &
     cbasefluxn(0:nxmaxn-1,0:nymaxn-1,maxnests)
   ! integer,dimension(na) :: &
@@ -58,7 +58,7 @@ module conv_mod
   real,dimension(na) ::    &
     uvzlev(nuvzmax),wsub(nuvzmax)
   real :: psconv,tt2conv,td2conv
-  
+
   integer :: nconvlev,nconvtop
 
   save :: uvzlev
@@ -74,895 +74,17 @@ module conv_mod
 
 contains
 
-subroutine alloc_convect
-  implicit none
-  if (.not.lconvection.eq.1) return
-  ! ! nconvlevmax=nuvzmax-1
-  ! ! na=nconvlevmax+1
-  ! allocate(pconv(nconvlevmax),phconv(na),dpr(nconvlevmax), &
-  !   pconv_hpa(nconvlevmax),phconv_hpa(na),ft(nconvlevmax), &
-  !   fq(nconvlevmax),fmass(nconvlevmax,nconvlevmax),        &
-  !   sub(nconvlevmax),fmassfrac(nconvlevmax,nconvlevmax),   &
-  !   cbaseflux(0:nxmax-1,0:nymax-1),                        &
-  !   cbasefluxn(0:nxmaxn-1,0:nymaxn-1,maxnests),            &
-  !   tconv(na),qconv(na),qsconv(na))
-
-  ! allocate(uvzlev(nuvzmax),wsub(nuvzmax))
-
-  ! allocate(FUP(NA),FDOWN(NA),NENT(NA),                     &
-  !   M(NA),MP(NA),MENT(NA,NA),QENT(NA,NA),ELIJ(NA,NA),      &
-  !   SIJ(NA,NA),TVP(NA),TV(NA),WATER(NA),                   &
-  !   QP(NA),EP(NA),TH(NA),WT(NA),EVAP(NA),CLW(NA),          &
-  !   SIGP(NA),TP(NA),CPN(NA),                               &
-  !   LV(NA),LVCP(NA),H(NA),HP(NA),GZ(NA),HM(NA))
-end subroutine alloc_convect
-
-subroutine dealloc_convect
-  implicit none
-  if (.not.lconvection.eq.1) return
-  ! deallocate(pconv,phconv,dpr,pconv_hpa,phconv_hpa,ft,fq,sub, &
-  !   tconv,qconv,qsconv,fmass,fmassfrac,cbaseflux,cbasefluxn)
-  ! deallocate(uvzlev,wsub)
-  ! deallocate(fup,fdown,ment,M,MP,QENT,ELIJ,SIJ,TVP,TV, &
-  !   WATER,QP,EP,TH,WT,EVAP,CLW,SIGP,TP,CPN,LV,LVCP, &
-  !   H,HP,GZ,HM)
-end subroutine dealloc_convect
-
-subroutine set_conv_top()
-! Determine the uppermost level for which the convection scheme shall be applied
-! by assuming that there is no convection above 50 hPa (for standard SLP)
-!*****************************************************************************  
-
-  integer :: i
-  real :: pint
-
-  do i=1,nuvz-2
-    pint=akz(i)+bkz(i)*101325.
-    if (pint.lt.5000.) exit
-  end do
-  nconvlev=i
-  if (nconvlev.gt.nconvlevmax-1) then
-    nconvlev=nconvlevmax-1
-    write(*,*) 'INFORMATION: Convection only calculated up to ', &
-         akz(nconvlev)+bkz(nconvlev)*1013.25,' hPa'
-  endif  
-
-end subroutine set_conv_top
-
-subroutine convmix(itime)
-  !                     i
-  !**************************************************************
-  !handles all the calculations related to convective mixing
-  !Petra Seibert, Bernd C. Krueger, Feb 2001
-  !nested grids included, Bernd C. Krueger, May 2001
-  !
-  !Changes by Caroline Forster, April 2004 - February 2005:
-  !  convmix called every lsynctime seconds
-  !CHANGES by A. Stohl:
-  !  various run-time optimizations - February 2005
-  ! CHANGES by C. Forster, November 2005, NCEP GFS version
-  !      in the ECMWF version convection is calculated on the
-  !      original eta-levels
-  !      in the GFS version convection is calculated on the
-  !      FLEXPART levels
-  !
-  !   Unified ECMWF and GFS builds                                             
-  !   Marian Harustak, 12.5.2017                                              
-  !     - Merged convmix and convmix_gfs into one routine using if-then           
-  !       for meteo-type dependent code                                        
-  !**************************************************************
-  use omp_lib
-  use flux_mod
-  use par_mod
-  use com_mod
-  use class_gribfile_mod
-  use particle_mod
-
-  implicit none
-
-  integer :: igr,igrold, ipart, itime, ix, j, inest
-  integer :: ipconv,thread,ithread
-  integer :: jy, kpart, ktop, ngrid,kz
-  integer,allocatable :: igrid(:), ipoint(:), igridn(:,:)
-
-  ! itime [s]                 current time
-  ! igrid(maxpart)            horizontal grid position of each particle
-  ! igridn(maxpart,maxnests)  dto. for nested grids
-  ! ipoint(maxpart)           pointer to access particles according to grid position
-
-  logical :: lconv
-  real :: x, y, xtn,ytn, ztold, delt
-  real :: dt1,dt2,dtt
-  integer :: mind1,mind2
-  ! dt1,dt2,dtt,mind1,mind2       variables used for time interpolation
-  integer :: itage,nage,inage
-
-  ! OMP changes
-  integer :: cnt,kk
-  integer,allocatable,dimension(:) :: frst
-  double precision :: tmarray(2)
-
-  integer :: totpart,alivepart
-  real:: eps
-  eps=nxmax/3.e5
-  ! Calculate auxiliary variables for time interpolation
-  !*****************************************************
-
-  dt1=real(itime-memtime(1))
-  dt2=real(memtime(2)-itime)
-  dtt=1./(dt1+dt2)
-  mind1=memind(1)
-  mind2=memind(2)
-  delt=real(abs(lsynctime))
-
-  lconv = .false.
-
-  ! if no particles are present return after initialization
-  !********************************************************
-  call get_alivepart_num(alivepart)
-  if (alivepart.le.0 ) return
-
-  call get_totalpart_num(totpart)
-  allocate( igrid(totpart) )
-  allocate( ipoint(totpart) )
-  allocate( igridn(totpart,maxnests) )
-
-  ! Assign igrid and igridn, which are pseudo grid numbers indicating particles
-  ! that are outside the part of the grid under consideration
-  ! (e.g. particles near the poles or particles in other nests).
-  ! Do this for all nests but use only the innermost nest; for all others
-  ! igrid shall be -1
-  ! Also, initialize index vector ipoint
-  !************************************************************************
-!$OMP PARALLEL PRIVATE(ipart, j, x, y, ngrid, xtn, ytn, ix, jy)
-!$OMP DO
-  do ipart=1,numpart
-    igrid(ipart)=-1
-    do j=numbnests,1,-1
-      igridn(ipart,j)=-1
-    end do
-    ipoint(ipart)=ipart
-  ! do not consider particles that are not (yet) part of simulation
-    if (.not. part(ipart)%alive) cycle
-    x = part(ipart)%xlon
-    y = part(ipart)%ylat
-
-  ! Determine which nesting level to be used
-  !**********************************************************
-
-    ngrid=0
-    if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
-      do j=numbnests,1,-1
-        ! Temporary fix for nested layer edges: replaced eps with dxn and dyn (LB)
-        if ( x.gt.xln(j)+dxn(j) .and. x.lt.xrn(j)-dxn(j) .and. &
-             y.gt.yln(j)+dyn(j) .and. y.lt.yrn(j)-dyn(j) ) then
-          ngrid=j
-          exit
-        endif
-      end do
-    else
-      do j=numbnests,1,-1
-        if ( x.gt.xln(j) .and. x.lt.xrn(j) .and. &
-             y.gt.yln(j) .and. y.lt.yrn(j) ) then
-          ngrid=j
-          exit
-        endif
-      end do
-    endif
- ! 23   continue
-
-  ! Determine nested grid coordinates
-  !**********************************
-
-    if (ngrid.gt.0) then
-  ! nested grids
-      xtn=(x-xln(ngrid))*xresoln(ngrid)
-      ytn=(y-yln(ngrid))*yresoln(ngrid)
-      ix=nint(xtn)
-      jy=nint(ytn)
-      ! igridn(ipart,ngrid) = 1 + jy*nxn(ngrid) + ix
-      igridn(ipart,ngrid) = 1 + ix*nyn(ngrid) + jy
-    else if(ngrid.eq.0) then
-  ! mother grid
-      ix=nint(x)
-      jy=nint(y)
-      !igrid(ipart) = 1 + jy*nx + ix
-      igrid(ipart) = 1 + ix*ny + jy
-    endif
-  end do
-!$OMP END DO
-!$OMP END PARALLEL
-
-  ! sumall = 0.
-  ! sumconv = 0.
-
-  !*****************************************************************************
-  ! 1. Now, do everything for the mother domain and, later, for all of the nested domains
-  ! While all particles have to be considered for redistribution, the Emanuel convection
-  ! scheme only needs to be called once for every grid column where particles are present.
-  ! Therefore, particles are sorted according to their grid position. Whenever a new grid
-  ! cell is encountered by looping through the sorted particles, the convection scheme is called.
-  !*****************************************************************************
-
-  ! sort particles according to horizontal position and calculate index vector IPOINT
-
-  call sort2(numpart,igrid,ipoint)
-
-  ! Now visit all grid columns where particles are present
-  ! by going through the sorted particles
-
-  !LB changes following the CTM version
-  allocate(frst(nx*(ny+1)+1))
-  frst(1) = 1
-  cnt = 2
-  igrold = igrid(1)
-  ! Looping over all particles and counting how many in each igrid reside.
-  ! This is saved in frst. The number of consecutive particles in igrid is saved in frst(i)
-  do kpart=1,numpart
-    if (igrold.ne.igrid(kpart)) then
-      frst(cnt) = kpart
-      igrold=igrid(kpart)
-      cnt=cnt+1
-    endif
-  end do 
-  frst(cnt) = numpart+1
-
-!$OMP PARALLEL PRIVATE(kk,jy,ix,tmarray,j,kz,ktop,lconv,kpart,ipart,&
-!$OMP ztold,nage,ipconv,itage,thread)
-
-#if (defined _OPENMP)
-    thread = OMP_GET_THREAD_NUM() ! Starts at 0
-#else
-    thread = 0
-#endif
-
-!$OMP DO SCHEDULE(static)
-  do kk=1,cnt-1
-    ! Only consider grids that have particles inside
-    if (igrid(frst(kk)).eq.-1) cycle
-
-    ! Find horizontal location of grid column
-    ix = (igrid(frst(kk))-1)/ny
-    jy = igrid(frst(kk)) - ix*ny - 1
-    ! jy = (igrid(frst(kk))-1)/nx
-    ! ix = igrid(frst(kk)) - jy*nx - 1
-
-  ! Interpolate all meteorological data needed for the convection scheme
-    psconv=(ps(ix,jy,1,mind1)*dt2+ps(ix,jy,1,mind2)*dt1)*dtt
-    tt2conv=(tt2(ix,jy,1,mind1)*dt2+tt2(ix,jy,1,mind2)*dt1)*dtt
-    td2conv=(td2(ix,jy,1,mind1)*dt2+td2(ix,jy,1,mind2)*dt1)*dtt
-
-    if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
-      do kz=1,nuvz-1           !bugfix
-        tconv(kz)=(tth(ix,jy,kz+1,mind1)*dt2+ &
-             tth(ix,jy,kz+1,mind2)*dt1)*dtt
-        qconv(kz)=(qvh(ix,jy,kz+1,mind1)*dt2+ &
-             qvh(ix,jy,kz+1,mind2)*dt1)*dtt
-      end do
-    else
-      do kz=1,nuvz-1           !bugfix
-        pconv(kz)=(pplev(ix,jy,kz,mind1)*dt2+ &
-            pplev(ix,jy,kz,mind2)*dt1)*dtt
-        tconv(kz)=(tt(ix,jy,kz,mind1)*dt2+ &
-            tt(ix,jy,kz,mind2)*dt1)*dtt
-        qconv(kz)=(qv(ix,jy,kz,mind1)*dt2+ &
-            qv(ix,jy,kz,mind2)*dt1)*dtt
-      end do
-    end if
-
-  ! Calculate translocation matrix
-    call calcmatrix(lconv,delt,cbaseflux(ix,jy))
-    
-  ! treat particle only if column has convection
-    if (lconv .eqv. .true.) then
-      ktop = 0
-  ! assign new vertical position to particle
-      do kpart=frst(kk), frst(kk+1)-1
-        ipart = ipoint(kpart)
-        ztold=real(part(ipart)%z)
-        call redist(itime,ipart,ktop,ipconv)
-  !    if (ipconv.le.0) sumconv = sumconv+1
-
-  ! Calculate the gross fluxes across layer interfaces
-  !***************************************************
-
-        if (iflux.eq.1) then
-          itage=abs(itime-part(ipart)%tstart)
-          nage=1
-          do inage=1,nageclass
-            nage=inage
-            if ((itage.lt.lage(nage)).or.(.not.part(ipart)%alive)) exit
-          end do
+#include "con_alloc_convect.f90"
 
-          if (nage.le.nageclass) &
-            call calcfluxes(itime,nage,ipart,real(part(ipart)%xlon), &
-               real(part(ipart)%ylat),ztold,thread+1)
-        endif
-      enddo
+#include "con_dealloc_convect.f90"
 
-    endif   !(lconv .eqv. .true)
-  end do
-!$OMP END DO
-!$OMP END PARALLEL
+#include "con_set_conv_top.f90"
 
-  deallocate(frst)
-
-  ! OpenMP Reduction for dynamically allocated arrays. This is done manually since this
-  ! is not yet supported in most OpenMP versions
-  !************************************************************************************
-  if (iflux.eq.1) then
-    do ithread=1,numthreads
-      flux(:,:,:,:,:,:,:)=flux(:,:,:,:,:,:,:)+flux_omp(:,:,:,:,:,:,:,ithread)
-    end do
-  endif
-
-  !*****************************************************************************
-  ! 2. Nested domains
-  !*****************************************************************************
-
-  ! sort particles according to horizontal position and calculate index vector IPOINT
-  do inest=1,numbnests
-    do ipart=1,numpart
-      ipoint(ipart)=ipart
-      igrid(ipart) = igridn(ipart,inest)
-    enddo
-    call sort2(numpart,igrid,ipoint)
-
-  ! Now visit all grid columns where particles are present
-  ! by going through the sorted particles
-!$OMP PARALLEL PRIVATE (igrold,kpart,ipart,igr,jy,ix,kz,lconv, &
-!$OMP ktop,ztold,nage,ipconv,itage)
-    igrold = -1
-!$OMP DO
-    do kpart=1,numpart
-      igr = igrid(kpart)
-      if (igr .eq. -1) cycle
-      ipart = ipoint(kpart)
-      ! sumall = sumall + 1
-      if (igr .ne. igrold) then
-  ! we are in a new grid column
-        jy = (igr-1)/nxn(inest)
-        ix = igr - jy*nxn(inest) - 1
-
-  ! Interpolate all meteorological data needed for the convection scheme
-        psconv=(psn(ix,jy,1,mind1,inest)*dt2+ &
-             psn(ix,jy,1,mind2,inest)*dt1)*dtt
-        tt2conv=(tt2n(ix,jy,1,mind1,inest)*dt2+ &
-             tt2n(ix,jy,1,mind2,inest)*dt1)*dtt
-        td2conv=(td2n(ix,jy,1,mind1,inest)*dt2+ &
-             td2n(ix,jy,1,mind2,inest)*dt1)*dtt
-!!$        do kz=1,nconvlev+1    !old
-        do kz=1,nuvz-1           !bugfix
-          tconv(kz)=(tthn(ix,jy,kz+1,mind1,inest)*dt2+ &
-               tthn(ix,jy,kz+1,mind2,inest)*dt1)*dtt
-          qconv(kz)=(qvhn(ix,jy,kz+1,mind1,inest)*dt2+ &
-               qvhn(ix,jy,kz+1,mind2,inest)*dt1)*dtt
-        end do
-
-  ! calculate translocation matrix
-  !*******************************
-        call calcmatrix(lconv,delt,cbasefluxn(ix,jy,inest))
-        igrold = igr
-        ktop = 0
-      endif
-
-  ! treat particle only if column has convection
-      if (lconv .eqv. .true.) then
-  ! assign new vertical position to particle
-        ztold=part(ipart)%z
-        call redist(itime,ipart,ktop,ipconv)
-  !      if (ipconv.le.0) sumconv = sumconv+1
-
-  ! Calculate the gross fluxes across layer interfaces
-  !***************************************************
-
-        if (iflux.eq.1) then
-          itage=abs(itime-part(ipart)%tstart)
-          nage=1
-          do inage=1,nageclass
-            nage=inage
-            if ((itage.lt.lage(nage)).or.(.not.part(ipart)%alive)) exit
-          end do
-
-          if (nage.le.nageclass) &
-               call calcfluxes(itime,nage,ipart,real(part(ipart)%xlon), &
-               real(part(ipart)%ylat),ztold,1)
-        endif
-
-      endif !(lconv .eqv. .true.)
-
-    end do
-!$OMP END DO
-!$OMP END PARALLEL
-  end do
-  ! OpenMP Reduction for dynamically allocated arrays. This is done manually since this
-  ! is not yet supported in most OpenMP versions
-  !************************************************************************************
-  if (iflux.eq.1) then
-    do ithread=1,numthreads
-      flux(:,:,:,:,:,:,:)=flux(:,:,:,:,:,:,:)+flux_omp(:,:,:,:,:,:,:,ithread)
-    end do
-  endif
-  !--------------------------------------------------------------------------
-  ! write(*,*)'############################################'
-  ! write(*,*)'TIME=',&
-  !    &  itime
-  ! write(*,*)'fraction of particles under convection',&
-  !    &  sumconv/(sumall+0.001)
-  ! write(*,*)'total number of particles',&
-  !    &  sumall
-  ! write(*,*)'number of particles under convection',&
-  !    &  sumconv
-  ! write(*,*)'############################################'
-
-  deallocate( igrid )
-  deallocate( ipoint )
-  deallocate( igridn )
-
-  return
-end subroutine convmix
-
-subroutine calcmatrix(lconv,delt,cbmf)
-  !                        o    i    o
-  !*****************************************************************************
-  !                                                                            *
-  !  This subroutine calculates the matrix describing convective               *
-  !  redistribution of mass in a grid column, using the subroutine             *
-  !  convect43c.f provided by Kerry Emanuel.                                   *
-  !                                                                            *
-  !  Petra Seibert, Bernd C. Krueger, 2000-2001                                *
-  !                                                                            *
-  !*****************************************************************************
-  ! Changes:                                                                   *
-  !  changed by C. Forster, November 2003 - February 2004                      *
-  !  array fmassfrac(nconvlevmax,nconvlevmax) represents                       *
-  !  the convective redistribution matrix for the particles                    *
-  !                                                                            *
-  !   Unified ECMWF and GFS builds                                             *
-  !   Marian Harustak, 12.5.2017                                               *
-  !     - Merged calcmatrix and calcmatrix_gfs into one routine using if-then  *
-  !       for meteo-type dependent code                                        *
-  !*****************************************************************************
-  !                                                                            *
-  !  lconv        indicates whether there is convection in this cell, or not   *
-  !  delt         time step for convection [s]                                 *
-  !  cbmf         cloud base mass flux                                         *
-  !  metdata_format format of metdata (ecmwf/gfs)                              *
-  !                                                                            *
-  !*****************************************************************************
-
-  use par_mod
-  use com_mod
-  use class_gribfile_mod
-  use qvsat_mod
-
-  implicit none
-
-  real :: rlevmass,summe
-
-  integer :: iflag, k, kk, kuvz
-
-  !1-d variables for convection
-  !variables for redistribution matrix
-  real :: cbmfold, precip, qprime
-  real :: tprime, wd
-  real :: delt,cbmf
-  logical :: lconv
-
-  lconv = .false.
-
-
-  ! calculate pressure at eta levels for use in convect
-  ! and assign temp & spec. hum. to 1D workspace
-  ! -------------------------------------------------------
-
-  ! pconv(1) is the pressure at the first level above ground
-  ! phconv(k) is the pressure between levels k-1 and k
-  ! dpr(k) is the pressure difference "around" tconv(k)
-  ! phconv(kmax) must also be defined 1/2 level above pconv(kmax)
-  ! Therefore, we define k = kuvz-1 and let kuvz start from 2
-  ! top layer cannot be used for convection because p at top of this layer is
-  ! not given
-
-
-  phconv(1) = psconv
-  ! Emanuel subroutine needs pressure in hPa, therefore convert all pressures
-  ! do kuvz = 2,nuvz
-  !   k = kuvz-1
-  !   if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
-  !     pconv(k) = (akz(kuvz) + bkz(kuvz)*psconv)
-  !     phconv(kuvz) = (akm(kuvz) + bkm(kuvz)*psconv)
-  !   else
-  !     phconv(kuvz) =  0.5*(pconv(kuvz)+pconv(k))
-  !   endif
-  !   dpr(k) = phconv(k) - phconv(kuvz)
-  !   qsconv(k) = f_qvsat( pconv(k), tconv(k) )
-
-  ! initialize mass fractions
-    ! do kk=1,nconvlev
-    !   fmassfrac(k,kk)=0.
-    ! end do
-  ! end do
-  ! LB 04.05.2021, replace above with array operations
-  if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
-    pconv(1:nuvz-1) = (akz(2:nuvz) + bkz(2:nuvz)*psconv)
-    phconv(2:nuvz) = (akm(2:nuvz) + bkm(2:nuvz)*psconv)
-  else
-    phconv(2:nuvz) =  0.5*(pconv(2:nuvz)+pconv(1:nuvz-1))
-  endif
-  dpr(1:nuvz-1) = phconv(1:nuvz-1) - phconv(2:nuvz)
-  do k = 1,nuvz-1
-    qsconv(k) = f_qvsat( pconv(k), tconv(k) )
-  end do
-  fmassfrac(1:nuvz-1,1:nconvlev)=0.
-  ! LB end
-
-  !note that Emanuel says it is important
-  !a. to set this =0. every grid point
-  !b. to keep this value in the calling programme in the iteration
-
-  ! CALL CONVECTION
-  !******************
-
-  cbmfold = cbmf
-  ! Convert pressures to hPa, as required by Emanuel scheme
-  !********************************************************
-  !!$    do k=1,nconvlev     !old
-  ! do k=1,nconvlev+1      !bugfix
-  !   pconv_hpa(k)=pconv(k)/100.
-  !   phconv_hpa(k)=phconv(k)/100.
-  ! end do
-  ! phconv_hpa(nconvlev+1)=phconv(nconvlev+1)/100.
-  ! LB 04.05.2021, replace above with array operations
-  pconv_hpa(1:nconvlev+1)=pconv(1:nconvlev+1)/100.
-  phconv_hpa(1:nconvlev+1)=phconv(1:nconvlev+1)/100.
-  ! LB end
-    
-  call convect(nconvlevmax, nconvlev, delt, iflag, &
-       precip, wd, tprime, qprime, cbmf)
-
-  ! do not update fmassfrac and cloudbase massflux
-  ! if no convection takes place or
-  ! if a CFL criterion is violated in convect43c.f
-  if (iflag .ne. 1 .and. iflag .ne. 4) then
-   cbmf=cbmfold
-   return
-  endif
-
-  ! do not update fmassfrac and cloudbase massflux
-  ! if the old and the new cloud base mass
-  ! fluxes are zero
-  if (cbmf.le.0..and.cbmfold.le.0.) then
-   cbmf=cbmfold
-   return
-  endif
-
-  ! Update fmassfrac
-  ! account for mass displaced from level k to level k
-
-  lconv = .true.
-  do k=1,nconvtop
-    rlevmass = dpr(k)/ga
-    summe = 0.
-    do kk=1,nconvtop
-      fmassfrac(k,kk) = delt*fmass(k,kk)
-      summe = summe + fmassfrac(k,kk)
-    end do
-    fmassfrac(k,k)=fmassfrac(k,k) + rlevmass - summe
-  end do
-  ! LB 04.05.2021, replace above with array operations (not the problem)
-  ! fmassfrac(1:nconvtop,1:nconvtop) = delt*fmass(1:nconvtop,1:nconvtop)
-  ! do k=1, nconvtop
-  !     fmassfrac(k, k) = fmassfrac(k, k) + dpr(k)/ga - sum(fmassfrac(k, 1:nconvtop))
-  ! end do
-  ! LB end
-end subroutine calcmatrix
-
-subroutine redist(itime,ipart,ktop,ipconv)
-
-  !**************************************************************************
-  ! Do the redistribution of particles due to convection
-  ! This subroutine is called for each particle which is assigned
-  ! a new vertical position randomly, based on the convective redistribution
-  ! matrix
-  !**************************************************************************
-
-  ! Petra Seibert, Feb 2001, Apr 2001, May 2001, Jan 2002, Nov 2002 and
-  ! Andreas Frank, Nov 2002
-
-  ! Caroline Forster:  November 2004 - February 2005
-
-  use par_mod
-  use com_mod
-  use random_mod
-  use omp_lib
-  use interpol_mod
-  use coord_ec_mod
-  use particle_mod
-  use qvsat_mod
-
-  implicit none
+#include "con_convmix.f90"
 
-  real,parameter :: const=r_air/ga
-  integer :: ipart, ktop,ipconv,itime
-  integer :: k, kz, levnew, levold,ithread
+#include "con_calcmatrix.f90"
 
-  real :: totlevmass, wsubpart
-  real :: temp_levold,temp_levold1
-  real :: sub_levold,sub_levold1
-  real :: pint, pold, rn, tv, tvold, dlevfrac
-  real :: ztold,ffraction
-  real :: tv1, tv2, dlogp, dz, dz1, dz2
-  
-#ifdef _OPENMP
-  ithread = OMP_GET_THREAD_NUM() ! Starts at 0
-#else
-  ithread=0
-#endif
-
-  ! ipart   ... number of particle to be treated
-
-  ipconv=1
-
-  ! !  determine vertical grid position of particle in the eta system
-  ! !****************************************************************
-  select case (wind_coord_type)
-
-    case ('ETA')
-      ztold = real(part(abs(ipart))%zeta)
-      ! find old particle grid position
-      levold = nconvtop
-      do kz = 2, nconvtop
-        if (wheight(kz) .le. ztold ) then
-          levold = kz-1
-          exit
-        endif
-      end do
-
-    case ('METER')
-
-      ! determine height of the eta half-levels (uvzlev)
-      ! do that only once for each grid column
-      ! i.e. when ktop.eq.1
-      !**************************************************************
-
-      if (ktop .le. 1) then
-
-        tvold=tt2conv*(1.+0.378*ew(td2conv,psconv)/psconv)
-        pold=psconv
-        uvzlev(1)=0.
-
-        pint = phconv(2)
-      !  determine next virtual temperatures
-        tv1 = tconv(1)*(1.+0.608*qconv(1))
-        tv2 = tconv(2)*(1.+0.608*qconv(2))
-      !  interpolate virtual temperature to half-level
-        tv = tv1 + (tv2-tv1)*(pconv(1)-phconv(2))/(pconv(1)-pconv(2))
-        tv = tv1 + (tv2-tv1)*(pconv(1)-phconv(2))/(pconv(1)-pconv(2))
-        if (abs(tv-tvold).gt.0.2) then
-          uvzlev(2) = uvzlev(1) + &
-               const*log(pold/pint)* &
-               (tv-tvold)/log(tv/tvold)
-        else
-          uvzlev(2) = uvzlev(1)+ &
-               const*log(pold/pint)*tv
-        endif
-        tvold=tv
-        tv1=tv2
-        pold=pint
-
-      ! integrate profile (calculation of height agl of eta layers) as required
-        do kz = 3, nconvtop+1
-      !    note that variables defined in calcmatrix.f (pconv,tconv,qconv)
-      !    start at the first real ECMWF model level whereas kz and
-      !    thus uvzlev(kz) starts at the surface. uvzlev is defined at the
-      !    half-levels (between the tconv, qconv etc. values !)
-      !    Thus, uvzlev(kz) is the lower boundary of the tconv(kz) cell.
-          pint = phconv(kz)
-      !    determine next virtual temperatures
-          tv2 = tconv(kz)*(1.+0.608*qconv(kz))
-      !    interpolate virtual temperature to half-level
-          tv = tv1 + (tv2-tv1)*(pconv(kz-1)-phconv(kz))/ &
-               (pconv(kz-1)-pconv(kz))
-          tv = tv1 + (tv2-tv1)*(pconv(kz-1)-phconv(kz))/ &
-               (pconv(kz-1)-pconv(kz))
-          if (abs(tv-tvold).gt.0.2) then
-            uvzlev(kz) = uvzlev(kz-1) + &
-                 const*log(pold/pint)* &
-                 (tv-tvold)/log(tv/tvold)
-          else
-            uvzlev(kz) = uvzlev(kz-1)+ &
-                 const*log(pold/pint)*tv
-          endif
-          tvold=tv
-          tv1=tv2
-          pold=pint
-
-
-        end do
-
-        ktop = 2
-
-      endif
-      
-      ztold = real(part(abs(ipart))%z)
-      ! find old particle grid position
-      levold = nconvtop
-      do kz = 2, nconvtop
-        if (uvzlev(kz) .ge. ztold ) then
-          levold = kz-1
-          exit
-        endif
-      end do
-    case default
-      write(*,*) 'The wind_coord_type is not defined in redist.f90'
-      stop
-
-  end select
-
-  ! If the particle is above the potentially convective domain, it will be skipped
-  if (levold.ne.nconvtop) then
-
-    ! now redistribute particles
-    !****************************
-
-    !  Choose a random number and find corresponding level of destination
-    !  Random numbers to be evenly distributed in [0,1]
-
-    rn = ran3(iseed2(ithread),ithread)
-
-    ! initialize levnew
-
-    levnew = levold
-
-    ffraction = 0.
-    totlevmass=dpr(levold)/ga
-    loop1: do k = 1,nconvtop
-    ! for backward runs use the transposed matrix
-     if (ldirect.eq.1) then
-       ffraction=ffraction+fmassfrac(levold,k) &
-            /totlevmass
-     else
-       ffraction=ffraction+fmassfrac(k,levold) &
-            /totlevmass
-     endif
-     if (rn.le.ffraction) then
-       levnew=k
-    ! avoid division by zero or a too small number
-    ! if division by zero or a too small number happens the
-    ! particle is assigned to the center of the grid cell
-       if (ffraction.gt.1.e-20) then
-        if (ldirect.eq.1) then
-          dlevfrac = (ffraction-rn) / fmassfrac(levold,k) * totlevmass
-        else
-          dlevfrac = (ffraction-rn) / fmassfrac(k,levold) * totlevmass
-        endif
-       else
-         dlevfrac = 0.5
-       endif
-       exit loop1
-     endif
-    end do loop1
-
-    ! now assign new position to particle
-    select case (wind_coord_type)
-
-      case ('ETA')
-        if ((levnew.le.nconvtop).and.(levnew.ne.levold)) then
-          dlogp = (1.-dlevfrac) * (wheight(levnew+1)-wheight(levnew))
-          call set_zeta(ipart,wheight(levnew)+dlogp)
-          if (part(abs(ipart))%zeta.ge.1.) call set_zeta(ipart,1.-(part(abs(ipart))%zeta-1.))
-          if (part(abs(ipart))%zeta.eq.1.) call update_zeta(ipart,-1.e-4)
-          if (ipconv.gt.0) ipconv=-1
-        endif
-
-      case ('METER')
-        if ((levnew.le.nconvtop).and.(levnew.ne.levold)) then
-          dlogp = (1.-dlevfrac)* (log(phconv(levnew+1))-log(phconv(levnew)))
-          pint = log(phconv(levnew))+dlogp
-          dz1 = pint - log(phconv(levnew))
-          dz2 = log(phconv(levnew+1)) - pint
-          dz = dz1 + dz2
-          call set_z(ipart,(uvzlev(levnew)*dz2+uvzlev(levnew+1)*dz1)/dz)
-          if (part(abs(ipart))%z.lt.0.) call set_z(ipart,-1.*part(abs(ipart))%z)
-          if (ipconv.gt.0) ipconv=-1
-        endif
-
-      case default
-        write(*,*) 'The chosen wind_coord_type is not defined in redist.f90'
-        stop
-
-    end select
-
-    ! displace particle according to compensating subsidence
-    ! this is done to those particles, that were not redistributed
-    ! by the matrix
-    !**************************************************************
-
-    if ((levnew.le.nconvtop).and.(levnew.eq.levold)) then
-
-      ! determine compensating vertical velocity at the levels
-      ! above and below the particel position
-      ! increase compensating subsidence by the fraction that
-      ! is displaced by convection to this level
-
-      if (levold.gt.1) then
-        temp_levold = tconv(levold-1) + &
-            (tconv(levold)-tconv(levold-1)) &
-            *(pconv(levold-1)-phconv(levold))/ &
-            (pconv(levold-1)-pconv(levold))
-        ! Bug fix: Added lsynctime to make units correct
-        sub_levold = sub(levold)/(1.-ga*sub(levold)*lsynctime/dpr(levold))
-        wsub(levold)=-1.*sub_levold*r_air*temp_levold/(phconv(levold))
-      else
-        wsub(levold)=0.
-      endif
-
-      temp_levold1 = tconv(levold) + &
-          (tconv(levold+1)-tconv(levold)) &
-          *(pconv(levold)-phconv(levold+1))/ &
-          (pconv(levold)-pconv(levold+1))
-      ! Bug fix: Added lsynctime to make units correct
-      sub_levold1 = sub(levold+1)/(1.-ga*sub(levold+1)*lsynctime/dpr(levold+1))
-      wsub(levold+1)=-1.*sub_levold1*r_air*temp_levold1/ &
-          (phconv(levold+1))
-
-      ! interpolate wsub to the vertical particle position
-      select case (wind_coord_type)
-        case ('ETA')
-          ztold = real(part(abs(ipart))%zeta)
-          dz1 = ztold - wheight(levold)
-          dz2 = wheight(levold+1) - ztold
-          dz = dz1 + dz2
-
-          ! Convert z(eta) to z(m) in order to add subsidence
-          call update_zeta_to_z(itime, ipart)
-          ! call zeta_to_z(itime,part(abs(ipart))%xlon,part(abs(ipart))%ylat, &
-          !   part(abs(ipart))%zeta,part(abs(ipart))%z)
-
-          wsubpart = (dz2*wsub(levold)+dz1*wsub(levold+1))/dz
-
-          call update_z(ipart,wsubpart*real(lsynctime))
-
-          if (part(abs(ipart))%z.lt.0.) call set_z(ipart,-1.*part(abs(ipart))%z)
-
-          ! Convert new z(m) back to z(eta)
-          call update_z_to_zeta(itime, ipart)
-          
-        case ('METER')
-          ztold = real(part(abs(ipart))%z)
-          dz1 = ztold - uvzlev(levold)
-          dz2 = uvzlev(levold+1) - ztold
-          dz = dz1 + dz2
-
-          wsubpart = (dz2*wsub(levold)+dz1*wsub(levold+1))/dz
-
-          call update_z(ipart,wsubpart*real(lsynctime))
-
-          if (part(abs(ipart))%z.lt.0.) call set_z(ipart,-1.*part(abs(ipart))%z)
-
-        case default
-          write(*,*) 'The wind_coord_type is not defined in redist.f90'
-          stop
-      end select
-    endif      !(levnew.le.nconvtop.and.levnew.eq.levold)
-  endif
-  ! Maximum altitude .5 meter below uppermost model level
-  !*******************************************************
-
-  select case (wind_coord_type)
-    case ('ETA')
-      if (part(abs(ipart))%zeta .lt. uvheight(nz)) call set_zeta(ipart,uvheight(nz)+1.e-4)
-      if (part(abs(ipart))%zeta.ge.1.) call set_zeta(ipart,1.-(part(abs(ipart))%zeta-1.))
-      if (part(abs(ipart))%zeta.eq.1.) call update_zeta(ipart,-1.e-4)
-    case ('METER')
-      if (part(abs(ipart))%z .gt. height(nz)-0.5) call set_z(ipart,height(nz)-0.5)
-    case default
-      write(*,*) 'The wind_coord_type is not defined in redist.f90'
-      stop
-  end select
-
-end subroutine redist
+#include "con_redist.f90"
 
 !**************************************************************************
 !****                       SUBROUTINE CONVECT                        *****
@@ -971,1227 +93,12 @@ end subroutine redist
 !****                          Kerry Emanuel                          *****
 !**************************************************************************
 !
-  SUBROUTINE CONVECT &
-         (ND,  NL,   DELT, IFLAG, &
-         PRECIP, WD,   TPRIME, QPRIME, CBMF    )
-  !
-  !-cv *************************************************************************
-  !-cv C. Forster, November 2003 - May 2004:
-  !-cv
-  !-cv The subroutine has been downloaded from Kerry Emanuel's homepage,
-  !-cv where further infos on the convection scheme can be found
-  !-cv http://www-paoc.mit.edu/~emanuel/home.html
-  !-cv
-  !-cv The following changes have been made to integrate this subroutine
-  !-cv into FLEXPART
-  !-cv
-  !-cv Putting most of the variables in a new common block
-  !-cv renaming eps to eps0 because there is some eps already in includepar
-  !-cv
-  !-cv removing the arrays U,V,TRA and related arrays
-  !-cv
-  !-cv renaming the original arrays T,Q,QS,P,PH to
-  !-cv TCONV,QCONV,QSCONV,PCONV_HPA,PHCONV_HPA
-  !-cv
-  !-cv Initialization of variables has been put into parameter statements
-  !-cv instead of assignment of values at each call, in order to save 
-  !-cv computation time.
-  !***************************************************************************
-  !
-  !-----------------------------------------------------------------------------
-  !    *** On input:      ***
-  !
-  !T:   Array of absolute temperature (K) of dimension ND, with first
-  !      index corresponding to lowest model level. Note that this array
-  !      will be altered by the subroutine if dry convective adjustment
-  !      occurs and if IPBL is not equal to 0.
-  !
-  !Q:   Array of specific humidity (gm/gm) of dimension ND, with first
-  !       index corresponding to lowest model level. Must be defined
-  !       at same grid levels as T. Note that this array will be altered
-  !       if dry convective adjustment occurs and if IPBL is not equal to 0.
-  !
-  !QS:  Array of saturation specific humidity of dimension ND, with first
-  !       index corresponding to lowest model level. Must be defined
-  !       at same grid levels as T. Note that this array will be altered
-  !       if dry convective adjustment occurs and if IPBL is not equal to 0.
-  !
-  !U:   Array of zonal wind velocity (m/s) of dimension ND, witth first
-  !       index corresponding with the lowest model level. Defined at
-  !       same levels as T. Note that this array will be altered if
-  !       dry convective adjustment occurs and if IPBL is not equal to 0.
-  !
-  !V:   Same as U but for meridional velocity.
-  !
-  !TRA: Array of passive tracer mixing ratio, of dimensions (ND,NTRA),
-  !       where NTRA is the number of different tracers. If no
-  !       convective tracer transport is needed, define a dummy
-  !       input array of dimension (ND,1). Tracers are defined at
-  !       same vertical levels as T. Note that this array will be altered
-  !       if dry convective adjustment occurs and if IPBL is not equal to 0.
-  !
-  !P:   Array of pressure (mb) of dimension ND, with first
-  !       index corresponding to lowest model level. Must be defined
-  !       at same grid levels as T.
-  !
-  !PH:  Array of pressure (mb) of dimension ND+1, with first index
-  !       corresponding to lowest level. These pressures are defined at
-  !       levels intermediate between those of P, T, Q and QS. The first
-  !       value of PH should be greater than (i.e. at a lower level than)
-  !       the first value of the array P.
-  !
-  !ND:  The dimension of the arrays T,Q,QS,P,PH,FT and FQ
-  !
-  !NL:  The maximum number of levels to which convection can
-  !       penetrate, plus 1.
-  !       NL MUST be less than or equal to ND-1.
-  !
-  !NTRA:The number of different tracers. If no tracer transport
-  !       is needed, set this equal to 1. (On most compilers, setting
-  !       NTRA to 0 will bypass tracer calculation, saving some CPU.)
-  !
-  !DELT: The model time step (sec) between calls to CONVECT
-  !
-  !----------------------------------------------------------------------------
-  !    ***   On Output:         ***
-  !
-  !IFLAG: An output integer whose value denotes the following:
-  !
-  !           VALUE                        INTERPRETATION
-  !           -----                        --------------
-  !             0               No moist convection; atmosphere is not
-  !                             unstable, or surface temperature is less
-  !                             than 250 K or surface specific humidity
-  !                             is non-positive.
-  !
-  !             1               Moist convection occurs.
-  !
-  !             2               No moist convection: lifted condensation
-  !                             level is above the 200 mb level.
-  !
-  !             3               No moist convection: cloud base is higher
-  !                             then the level NL-1.
-  !
-  !             4               Moist convection occurs, but a CFL condition
-  !                             on the subsidence warming is violated. This
-  !                             does not cause the scheme to terminate.
-  !
-  !FT:   Array of temperature tendency (K/s) of dimension ND, defined at same
-  !        grid levels as T, Q, QS and P.
-  !
-  !FQ:   Array of specific humidity tendencies ((gm/gm)/s) of dimension ND,
-  !        defined at same grid levels as T, Q, QS and P.
-  !
-  !FU:   Array of forcing of zonal velocity (m/s^2) of dimension ND,
-  !        defined at same grid levels as T.
-  !
-  !FV:   Same as FU, but for forcing of meridional velocity.
-  !
-  !FTRA: Array of forcing of tracer content, in tracer mixing ratio per
-  !        second, defined at same levels as T. Dimensioned (ND,NTRA).
-  !
-  !PRECIP: Scalar convective precipitation rate (mm/day).
-  !
-  !WD:    A convective downdraft velocity scale. For use in surface
-  !        flux parameterizations. See convect.ps file for details.
-  !
-  !TPRIME: A convective downdraft temperature perturbation scale (K).
-  !         For use in surface flux parameterizations. See convect.ps
-  !         file for details.
-  !
-  !QPRIME: A convective downdraft specific humidity
-  !         perturbation scale (gm/gm).
-  !         For use in surface flux parameterizations. See convect.ps
-  !         file for details.
-  !
-  !CBMF:   The cloud base mass flux ((kg/m**2)/s). THIS SCALAR VALUE MUST
-  !         BE STORED BY THE CALLING PROGRAM AND RETURNED TO CONVECT AT
-  !         ITS NEXT CALL. That is, the value of CBMF must be "remembered"
-  !         by the calling program between calls to CONVECT.
-  !
-  !-----------------------------------------------------------------------------
-  !
-  !    ***  THE PARAMETER NA SHOULD IN GENERAL BE GREATER THAN   ***
-  !    ***                OR EQUAL TO  ND + 1                    ***
-  !
-  !
-  use par_mod
-
-  implicit none
-  !
-  !-cv====>Begin Module CONVECT    File convect.f      Undeclared variables
-  !
-  !Argument variables
-  !
-  integer :: iflag, nd, nl
-  !
-  real :: cbmf, delt, precip, qprime, tprime, wd
-  !
-  !Local variables
-  !
-  integer :: i, icb, ihmin, inb, inb1, j, jtt, k
-  integer :: nk
-  !
-  real :: ad, afac, ahmax, ahmin, alt, altem
-  real :: am, amp1, anum, asij, awat, b6, bf2, bsum, by
-  real :: byp, c6, cape, capem, cbmfold, chi, coeff
-  real :: cpinv, cwat, damps, dbo, dbosum
-  real :: defrac, dei, delm, delp, delt0, delti, denom, dhdp
-  real :: dpinv, dtma, dtmin, dtpbl, elacrit, ents
-  real :: epmax, fac, fqold, frac, ftold
-  real :: plcl, qp1, qsm, qstm, qti, rat
-  real :: rdcp, revap, rh, scrit, sigt, sjmax
-  real :: sjmin, smid, smin, stemp, tca
-  real :: tvaplcl, tvpplcl, tvx, tvy, wdtrain
-
-  !integer jc,jn
-  !real alvnew,a2,ahm,alv,rm,sum,qnew,dphinv,tc,thbar,tnew,x
-  !REAL TOLD(NA)
-
-  real :: FUP(NA),FDOWN(NA)
-  !
-  !-cv====>End Module   CONVECT    File convect.f
-
-  INTEGER :: NENT(NA)
-  REAL :: M(NA),MP(NA),MENT(NA,NA),QENT(NA,NA),ELIJ(NA,NA)
-  REAL :: SIJ(NA,NA),TVP(NA),TV(NA),WATER(NA)
-  REAL :: QP(NA),EP(NA),TH(NA),WT(NA),EVAP(NA),CLW(NA)
-  REAL :: SIGP(NA),TP(NA),CPN(NA)
-  REAL :: LV(NA),LVCP(NA),H(NA),HP(NA),GZ(NA),HM(NA)
-  !
-  ! -----------------------------------------------------------------------
-  !
-  !   ***                     Specify Switches                         ***
-  !
-  !   ***   IPBL: Set to zero to bypass dry adiabatic adjustment       ***
-  !   ***    Any other value results in dry adiabatic adjustment       ***
-  !   ***     (Zero value recommended for use in models with           ***
-  !   ***                   boundary layer schemes)                    ***
-  !
-  !   ***   MINORIG: Lowest level from which convection may originate  ***
-  !   ***     (Should be first model level at which T is defined       ***
-  !   ***      for models using bulk PBL schemes; otherwise, it should ***
-  !   ***      be the first model level at which T is defined above    ***
-  !   ***                      the surface layer)                      ***
-  !
-  INTEGER,PARAMETER :: IPBL=0
-  INTEGER,PARAMETER :: MINORIG=1
-  !
-  !------------------------------------------------------------------------------
-  !
-  !   ***                    SPECIFY PARAMETERS                        ***
-  !
-  !   *** ELCRIT IS THE AUTOCONVERSION THERSHOLD WATER CONTENT (gm/gm) ***
-  !   ***  TLCRIT IS CRITICAL TEMPERATURE BELOW WHICH THE AUTO-        ***
-  !   ***       CONVERSION THRESHOLD IS ASSUMED TO BE ZERO             ***
-  !   ***     (THE AUTOCONVERSION THRESHOLD VARIES LINEARLY            ***
-  !   ***               BETWEEN 0 C AND TLCRIT)                        ***
-  !   ***   ENTP IS THE COEFFICIENT OF MIXING IN THE ENTRAINMENT       ***
-  !   ***                       FORMULATION                            ***
-  !   ***  SIGD IS THE FRACTIONAL AREA COVERED BY UNSATURATED DNDRAFT  ***
-  !   ***  SIGS IS THE FRACTION OF PRECIPITATION FALLING OUTSIDE       ***
-  !   ***                        OF CLOUD                              ***
-  !   ***        OMTRAIN IS THE ASSUMED FALL SPEED (P/s) OF RAIN       ***
-  !   ***     OMTSNOW IS THE ASSUMED FALL SPEED (P/s) OF SNOW          ***
-  !   ***  COEFFR IS A COEFFICIENT GOVERNING THE RATE OF EVAPORATION   ***
-  !   ***                          OF RAIN                             ***
-  !   ***  COEFFS IS A COEFFICIENT GOVERNING THE RATE OF EVAPORATION   ***
-  !   ***                          OF SNOW                             ***
-  !   ***     CU IS THE COEFFICIENT GOVERNING CONVECTIVE MOMENTUM      ***
-  !   ***                         TRANSPORT                            ***
-  !   ***    DTMAX IS THE MAXIMUM NEGATIVE TEMPERATURE PERTURBATION    ***
-  !   ***        A LIFTED PARCEL IS ALLOWED TO HAVE BELOW ITS LFC      ***
-  !   ***    ALPHA AND DAMP ARE PARAMETERS THAT CONTROL THE RATE OF    ***
-  !   ***                 APPROACH TO QUASI-EQUILIBRIUM                ***
-  !   ***   (THEIR STANDARD VALUES ARE  0.20 AND 0.1, RESPECTIVELY)    ***
-  !   ***                   (DAMP MUST BE LESS THAN 1)                 ***
-  !
-  REAL,PARAMETER :: ELCRIT=.0011
-  REAL,PARAMETER :: TLCRIT=-55.0
-  REAL,PARAMETER :: ENTP=1.5
-  REAL,PARAMETER :: SIGD=0.05
-  REAL,PARAMETER :: SIGS=0.12
-  REAL,PARAMETER :: OMTRAIN=50.0
-  REAL,PARAMETER :: OMTSNOW=5.5
-  REAL,PARAMETER :: COEFFR=1.0
-  REAL,PARAMETER :: COEFFS=0.8
-  REAL,PARAMETER :: CU=0.7
-  REAL,PARAMETER :: BETA=10.0
-  REAL,PARAMETER :: DTMAX=0.9
-  REAL,PARAMETER :: ALPHA=0.025  !original 0.2
-  REAL,PARAMETER :: DAMP=0.1
-  !
-  !   ***        ASSIGN VALUES OF THERMODYNAMIC CONSTANTS,        ***
-  !   ***            GRAVITY, AND LIQUID WATER DENSITY.           ***
-  !   ***             THESE SHOULD BE CONSISTENT WITH             ***
-  !   ***              THOSE USED IN CALLING PROGRAM              ***
-  !   ***     NOTE: THESE ARE ALSO SPECIFIED IN SUBROUTINE TLIFT  ***
-  !
-  REAL,PARAMETER :: CPD=1005.7
-  REAL,PARAMETER :: CPV=1870.0
-  REAL,PARAMETER :: CL=2500.0
-  REAL,PARAMETER :: RV=461.5
-  REAL,PARAMETER :: RD=287.04
-  REAL,PARAMETER :: LV0=2.501E6
-  REAL,PARAMETER :: G=9.81
-  REAL,PARAMETER :: ROWL=1000.0
-  !
-  REAL,PARAMETER :: CPVMCL=CL-CPV
-  REAL,PARAMETER :: EPS0=RD/RV
-  REAL,PARAMETER :: EPSI=1./EPS0
-  REAL,PARAMETER :: GINV=1.0/G
-  REAL,PARAMETER :: EPSILON=1.e-20
-
-  ! EPSILON IS A SMALL NUMBER USED TO EXCLUDE MASS FLUXES OF ZERO
-  !
-  DELTI=1.0/DELT
-  !
-  !      ***  INITIALIZE OUTPUT ARRAYS AND PARAMETERS  ***
-  !
-
-  FT(:NL+1)=0.0
-  FQ(:NL+1)=0.0
-  FDOWN(:NL+1)=0.0
-  SUB(:NL+1)=0.0
-  FUP(:NL+1)=0.0
-  M(:NL+1)=0.0
-  MP(:NL+1)=0.0
-  FMASS(:NL+1,:NL+1)=0.0
-  MENT(:NL+1,:NL+1)=0.0
-  ! DO I=1,NL+1
-  !   RDCP=(RD*(1.-QCONV(I))+QCONV(I)*RV)/ &
-  !       (CPD*(1.-QCONV(I))+QCONV(I)*CPV)
-  !   TH(I)=TCONV(I)*(1000.0/PCONV_HPA(I))**RDCP
-  ! END DO
-  ! LB 04.05.2021, below is not mentioned anywhere, so I commented it
-  ! TH(:NL+1)=TCONV(:NL+1)*(1000.0/PCONV_HPA(:NL+1))** &
-  !     (RD*(1.-QCONV(:NL+1))+QCONV(:NL+1)*RV)/ (CPD*(1.-QCONV(:NL+1))+QCONV(:NL+1)*CPV)
-  PRECIP=0.0
-  WD=0.0
-  TPRIME=0.0
-  QPRIME=0.0
-  IFLAG=0
-  !
-  !  IF(IPBL.NE.0)THEN
-  !
-  !***            PERFORM DRY ADIABATIC ADJUSTMENT            ***
-  !
-  !  JC=0
-  !  DO 30 I=NL-1,1,-1
-  !   JN=0
-  !    SUM=TH(I)*(1.+QCONV(I)*EPSI-QCONV(I))
-  !   DO 10 J=I+1,NL
-  !    SUM=SUM+TH(J)*(1.+QCONV(J)*EPSI-QCONV(J))
-  !    THBAR=SUM/REAL(J+1-I)
-  !    IF((TH(J)*(1.+QCONV(J)*EPSI-QCONV(J))).LT.THBAR)JN=J
-  !  10    CONTINUE
-  !   IF(I.EQ.1)JN=MAX(JN,2)
-  !   IF(JN.EQ.0)GOTO 30
-  !  12    CONTINUE
-  !   AHM=0.0
-  !   RM=0.0
-  !   DO 15 J=I,JN
-  !    AHM=AHM+(CPD*(1.-QCONV(J))+QCONV(J)*CPV)*TCONV(J)*
-  !    +   (PHCONV_HPA(J)-PHCONV_HPA(J+1))
-  !    RM=RM+QCONV(J)*(PHCONV_HPA(J)-PHCONV_HPA(J+1))
-  !  15    CONTINUE
-  !   DPHINV=1./(PHCONV_HPA(I)-PHCONV_HPA(JN+1))
-  !   RM=RM*DPHINV
-  !   A2=0.0
-  !   DO 20 J=I,JN
-  !    QCONV(J)=RM
-  !    RDCP=(RD*(1.-QCONV(J))+QCONV(J)*RV)/
-  !    1     (CPD*(1.-QCONV(J))+QCONV(J)*CPV)
-  !    X=(0.001*PCONV_HPA(J))**RDCP
-  !    TOLD(J)=TCONV(J)
-  !    TCONV(J)=X
-  !    A2=A2+(CPD*(1.-QCONV(J))+QCONV(J)*CPV)*X*
-  !    1    (PHCONV_HPA(J)-PHCONV_HPA(J+1))
-  !  20    CONTINUE
-  !   DO 25 J=I,JN
-  !    TH(J)=AHM/A2
-  !    TCONV(J)=TCONV(J)*TH(J)
-  !    TC=TOLD(J)-273.15
-  !    ALV=LV0-CPVMCL*TC
-  !    QSCONV(J)=QSCONV(J)+QSCONV(J)*(1.+QSCONV(J)*(EPSI-1.))*ALV*
-  !    1    (TCONV(J)- TOLD(J))/(RV*TOLD(J)*TOLD(J))
-  ! if (qslev(j) .lt. 0.) then
-  !   write(*,*) 'qslev.lt.0 ',j,qslev
-  ! endif
-  !  25    CONTINUE
-  !   IF((TH(JN+1)*(1.+QCONV(JN+1)*EPSI-QCONV(JN+1))).LT.
-  !    1    (TH(JN)*(1.+QCONV(JN)*EPSI-QCONV(JN))))THEN
-  !    JN=JN+1
-  !    GOTO 12
-  !   END IF
-  !   IF(I.EQ.1)JC=JN
-  !  30   CONTINUE
-  !
-  !   ***   Remove any supersaturation that results from adjustment ***
-  !
-  !IF(JC.GT.1)THEN
-  ! DO 38 J=1,JC
-  !    IF(QSCONV(J).LT.QCONV(J))THEN
-  !     ALV=LV0-CPVMCL*(TCONV(J)-273.15)
-  !     TNEW=TCONV(J)+ALV*(QCONV(J)-QSCONV(J))/(CPD*(1.-QCONV(J))+
-  !    1      CL*QCONV(J)+QSCONV(J)*(CPV-CL+ALV*ALV/(RV*TCONV(J)*TCONV(J))))
-  !     ALVNEW=LV0-CPVMCL*(TNEW-273.15)
-  !     QNEW=(ALV*QCONV(J)-(TNEW-TCONV(J))*(CPD*(1.-QCONV(J))
-  !    1     +CL*QCONV(J)))/ALVNEW
-  !     PRECIP=PRECIP+24.*3600.*1.0E5*(PHCONV_HPA(J)-PHCONV_HPA(J+1))*
-  !    1      (QCONV(J)-QNEW)/(G*DELT*ROWL)
-  !     TCONV(J)=TNEW
-  !     QCONV(J)=QNEW
-  !     QSCONV(J)=QNEW
-  !    END IF
-  !  38  CONTINUE
-  !END IF
-  !
-  !END IF
-  !
-  !  *** CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY AND STATIC ENERGY
-  !
-  GZ(1)=0.0
-  CPN(1)=CPD*(1.-QCONV(1))+QCONV(1)*CPV
-  H(1)=TCONV(1)*CPN(1)
-  LV(1)=LV0-CPVMCL*(TCONV(1)-273.15)
-  HM(1)=LV(1)*QCONV(1)
-  TV(1)=TCONV(1)*(1.+QCONV(1)*EPSI-QCONV(1))
-  AHMIN=1.0E12
-  IHMIN=NL
-
-  DO I=2,NL+1
-    TVX=TCONV(I)*(1.+QCONV(I)*EPSI-QCONV(I))
-    TVY=TCONV(I-1)*(1.+QCONV(I-1)*EPSI-QCONV(I-1))
-    GZ(I)=GZ(I-1)+0.5*RD*(TVX+TVY)*(PCONV_HPA(I-1)-PCONV_HPA(I))/ &
-         PHCONV_HPA(I)
-    CPN(I)=CPD*(1.-QCONV(I))+CPV*QCONV(I)
-    H(I)=TCONV(I)*CPN(I)+GZ(I)
-    LV(I)=LV0-CPVMCL*(TCONV(I)-273.15)
-    HM(I)=(CPD*(1.-QCONV(I))+CL*QCONV(I))*(TCONV(I)-TCONV(1))+ &
-         LV(I)*QCONV(I)+GZ(I)
-    TV(I)=TCONV(I)*(1.+QCONV(I)*EPSI-QCONV(I))
-!
-!  ***  Find level of minimum moist static energy    ***
-!
-    IF(I.GE.MINORIG.AND.HM(I).LT.AHMIN.AND.HM(I).LT.HM(I-1))THEN
-      AHMIN=HM(I)
-      IHMIN=I
-    END IF
-  END DO
-  IHMIN=MIN(IHMIN, NL-1)
-  !
-  !  ***     Find that model level below the level of minimum moist       ***
-  !  ***  static energy that has the maximum value of moist static energy ***
-  !
-  AHMAX=0.0
-  !  ***  bug fixed: need to assign an initial value to NK
-  !  HSO, 05.08.2009
-  NK=MINORIG
-  DO I=MINORIG,IHMIN
-    IF(HM(I).GT.AHMAX)THEN
-      NK=I
-      AHMAX=HM(I)
-    END IF
-  END DO
-  ! LB 04.05.2021, replace above with array operations (maxloc not working)
-  ! NK=MINORIG+maxloc(HM(MINORIG:IHMIN))-1
-
-  !
-  !  ***  CHECK WHETHER PARCEL LEVEL TEMPERATURE AND SPECIFIC HUMIDITY   ***
-  !  ***                          ARE REASONABLE                         ***
-  !  ***      Skip convection if HM increases monotonically upward       ***
-  !
-  IF(TCONV(NK).LT.250.0.OR.QCONV(NK).LE.0.0.OR.IHMIN.EQ.(NL-1)) THEN
-    IFLAG=0
-    CBMF=0.0
-    RETURN
-  END IF
-  !
-  !   ***  CALCULATE LIFTED CONDENSATION LEVEL OF AIR AT PARCEL ORIGIN LEVEL ***
-  !   ***       (WITHIN 0.2% OF FORMULA OF BOLTON, MON. WEA. REV.,1980)      ***
-  !
-  RH=QCONV(NK)/QSCONV(NK)
-  CHI=TCONV(NK)/(1669.0-122.0*RH-TCONV(NK))
-  PLCL=PCONV_HPA(NK)*(RH**CHI)
-  IF(PLCL.LT.200.0.OR.PLCL.GE.2000.0)THEN
-    IFLAG=2
-    CBMF=0.0
-    RETURN
-  END IF
-  !
-  !   ***  CALCULATE FIRST LEVEL ABOVE LCL (=ICB)  ***
-  !
-  ICB=NL-1
-  DO I=NK+1,NL
-    IF(PCONV_HPA(I).LT.PLCL)THEN
-      ICB=MIN(ICB,I)
-    END IF
-  END DO
-  IF(ICB.GE.(NL-1))THEN
-    IFLAG=3
-    CBMF=0.0
-    RETURN
-  END IF
-  !
-  !   *** FIND TEMPERATURE UP THROUGH ICB AND TEST FOR INSTABILITY           ***
-  !
-  !   *** SUBROUTINE TLIFT CALCULATES PART OF THE LIFTED PARCEL VIRTUAL      ***
-  !   ***  TEMPERATURE, THE ACTUAL TEMPERATURE AND THE ADIABATIC             ***
-  !   ***                   LIQUID WATER CONTENT                             ***
-  !
-  CALL TLIFT(GZ,ICB,NK,TVP,TP,CLW,ND,NL,1)
-  TVP(NK:ICB)=TVP(NK:ICB)-TP(NK:ICB)*QCONV(NK)
-  !
-  !   ***  If there was no convection at last time step and parcel    ***
-  !   ***       is stable at ICB then skip rest of calculation        ***
-  !
-  IF(CBMF.EQ.0.0.AND.TVP(ICB).LE.(TV(ICB)-DTMAX))THEN
-    IFLAG=0
-    RETURN
-  END IF
-  !
-  !   ***  IF THIS POINT IS REACHED, MOIST CONVECTIVE ADJUSTMENT IS NECESSARY ***
-  !
-  IF(IFLAG.NE.4)IFLAG=1
-  !
-  !   ***  FIND THE REST OF THE LIFTED PARCEL TEMPERATURES          ***
-  !
-  CALL TLIFT(GZ,ICB,NK,TVP,TP,CLW,ND,NL,2)
-  !
-  !   ***  SET THE PRECIPITATION EFFICIENCIES AND THE FRACTION OF   ***
-  !   ***          PRECIPITATION FALLING OUTSIDE OF CLOUD           ***
-  !   ***      THESE MAY BE FUNCTIONS OF TP(I), PCONV_HPA(I) AND CLW(I)     ***
-  !
-  EP(1:NK)=0.0
-  SIGP(1:NL)=SIGS
-
-  DO I=NK+1,NL
-    TCA=TP(I)-273.15
-    IF(TCA.GE.0.0)THEN
-      ELACRIT=ELCRIT
-    ELSE
-      ELACRIT=ELCRIT*(1.0-TCA/TLCRIT)
-    END IF
-    ELACRIT=MAX(ELACRIT,0.0)
-    EPMAX=0.999
-    EP(I)=EPMAX*(1.0-ELACRIT/MAX(CLW(I),1.0E-8))
-    EP(I)=MAX(EP(I),0.0)
-    EP(I)=MIN(EP(I),EPMAX)
-    SIGP(I)=SIGS
-  END DO
-  ! LB 04.05.2021, replace above with array operations 
-  ! (this makes it less readable, and not any faster)
-  ! PROBLEM 1 is within the statement below
-  ! EPMAX=0.999
-  ! where ((TP(NK+1:NL)-273.15).ge.0.0)
-  !   EP(NK+1:NL)=EPMAX*(1.0-max(ELCRIT, 0.0)/MAX(CLW(NK+1:NL),1.0E-8))
-  ! elsewhere
-  !   EP(NK+1:NL)=EPMAX*(1.0-max(ELCRIT*(1.0-TCA/TLCRIT), 0.0)/MAX(CLW(NK+1:NL),1.0E-8))
-  ! end where
-  ! where (EP(NK+1:NL).lt.0.0)
-  !   EP(NK+1:NL)=0.0
-  ! elsewhere (EP(NK+1:NL).gt.EPMAX)
-  !   EP(NK+1:NL)=EPMAX
-  ! end where
-
-  !
-  !   ***       CALCULATE VIRTUAL TEMPERATURE AND LIFTED PARCEL     ***
-  !   ***                    VIRTUAL TEMPERATURE                    ***
-  ! !
-  TVP(ICB+1:NL)=TVP(ICB+1:NL)-TP(ICB+1:NL)*QCONV(NK)
-  TVP(NL+1)=TVP(NL)-(GZ(NL+1)-GZ(NL))/CPD
-  !
-  !   ***        NOW INITIALIZE VARIOUS ARRAYS USED IN THE COMPUTATIONS       ***
-
-  HP(:NL+1)=H(:NL+1)
-  NENT(:NL+1)=0
-  WATER(:NL+1)=0.0
-  EVAP(:NL+1)=0.0
-  WT(:NL+1)=OMTSNOW
-  LVCP(:NL+1)=LV(:NL+1)/CPN(:NL+1)
-  ELIJ(:NL+1,:NL+1)=0.0
-  SIJ(:NL+1,:NL+1)=0.0
-  DO I=1,NL+1
-    QENT(I,:NL+1)=QCONV(:NL+1)
-  END DO  
-  QP(1)=QCONV(1)
-  QP(2:NL+1)=QCONV(:NL)
-
-  !
-  !  ***  FIND THE FIRST MODEL LEVEL (INB1) ABOVE THE PARCEL'S      ***
-  !  ***          HIGHEST LEVEL OF NEUTRAL BUOYANCY                 ***
-  !  ***     AND THE HIGHEST LEVEL OF POSITIVE CAPE (INB)           ***
-  !
-  CAPE=0.0
-  CAPEM=0.0
-  INB=ICB+1
-  INB1=INB
-  BYP=0.0
-  DO I=ICB+1,NL-1
-    BY=(TVP(I)-TV(I))*(PHCONV_HPA(I)-PHCONV_HPA(I+1))/PCONV_HPA(I)
-    CAPE=CAPE+BY
-    IF(BY.GE.0.0)INB1=I+1
-    IF(CAPE.GT.0.0)THEN
-      INB=I+1
-      BYP=(TVP(I+1)-TV(I+1))*(PHCONV_HPA(I+1)-PHCONV_HPA(I+2))/ &
-           PCONV_HPA(I+1)
-      CAPEM=CAPE
-    END IF
-  END DO
-  INB=MAX(INB,INB1)
-  CAPE=CAPEM+BYP
-  DEFRAC=CAPEM-CAPE
-  DEFRAC=MAX(DEFRAC,0.001)
-  FRAC=-CAPE/DEFRAC
-  FRAC=MIN(FRAC,1.0)
-  FRAC=MAX(FRAC,0.0)
-  !
-  !   ***   CALCULATE LIQUID WATER STATIC ENERGY OF LIFTED PARCEL   ***
-  !
-  HP(ICB:INB)=H(NK)+(LV(ICB:INB)+(CPD-CPV)*TCONV(ICB:INB))*EP(ICB:INB)*CLW(ICB:INB)
-  !
-  !   ***  CALCULATE CLOUD BASE MASS FLUX AND RATES OF MIXING, M(I),  ***
-  !   ***                   AT EACH MODEL LEVEL                       ***
-  !
-  
-  !
-  !   ***     INTERPOLATE DIFFERENCE BETWEEN LIFTED PARCEL AND      ***
-  !   ***  ENVIRONMENTAL TEMPERATURES TO LIFTED CONDENSATION LEVEL  ***
-  !
-  TVPPLCL=TVP(ICB-1)-RD*TVP(ICB-1)*(PCONV_HPA(ICB-1)-PLCL)/ &
-       (CPN(ICB-1)*PCONV_HPA(ICB-1))
-  TVAPLCL=TV(ICB)+(TVP(ICB)-TVP(ICB+1))*(PLCL-PCONV_HPA(ICB))/ &
-       (PCONV_HPA(ICB)-PCONV_HPA(ICB+1))
-  DTPBL=0.0
-
-  DTPBL=sum((TVP(NK:ICB-1)-TV(NK:ICB-1))*(PHCONV_HPA(NK:ICB-1)-PHCONV_HPA(NK+1:ICB)))/ &
-        (PHCONV_HPA(NK)-PHCONV_HPA(ICB))
-  DTMIN=TVPPLCL-TVAPLCL+DTMAX+DTPBL
-  DTMA=DTMIN
-  !
-  !   ***  ADJUST CLOUD BASE MASS FLUX   ***
-  !
-  CBMFOLD=CBMF
-  ! *** C. Forster: adjustment of CBMF is not allowed to depend on FLEXPART timestep
-  DELT0=DELT/3.
-  DAMPS=DAMP*DELT/DELT0
-  CBMF=(1.-DAMPS)*CBMF+0.1*ALPHA*DTMA
-  CBMF=MAX(CBMF,0.0)
-  !
-  !   *** If cloud base mass flux is zero, skip rest of calculation  ***
-  !
-  IF(CBMF.EQ.0.0.AND.CBMFOLD.EQ.0.0)THEN
-    RETURN
-  END IF
-
-  !
-  !   ***   CALCULATE RATES OF MIXING,  M(I)   ***
-  M(ICB)=0.0
-  M(ICB+1:INB1)=ABS(TV(ICB+1:INB1)-TVP(ICB+1:INB1))+ &
-        ENTP*0.02*(PHCONV_HPA(ICB+1:INB1)-PHCONV_HPA(ICB+2:INB1+1))
-  M(INB1:INB)=ABS(TV(INB1)-TVP(INB1))+ &
-        ENTP*0.02*(PHCONV_HPA(INB1)-PHCONV_HPA(INB1+1))
-  M(ICB+1:INB)=CBMF*M(ICB+1:INB)/sum(M(ICB+1:INB))
-
-  !
-  !   ***  CALCULATE ENTRAINED AIR MASS FLUX (MENT), TOTAL WATER MIXING  ***
-  !   ***     RATIO (QENT), TOTAL CONDENSED WATER (ELIJ), AND MIXING     ***
-  !   ***                        FRACTION (SIJ)                          ***
-  !
-  DO I=ICB+1,INB
-    QTI=QCONV(NK)-EP(I)*CLW(I)
-    DO J=ICB,INB
-      BF2=1.+LV(J)*LV(J)*QSCONV(J)/(RV*TCONV(J)*TCONV(J)*CPD)
-      ANUM=H(J)-HP(I)+(CPV-CPD)*TCONV(J)*(QTI-QCONV(J))
-      DENOM=H(I)-HP(I)+(CPD-CPV)*(QCONV(I)-QTI)*TCONV(J)
-      DEI=DENOM
-      IF(ABS(DEI).LT.0.01)DEI=0.01
-      SIJ(I,J)=ANUM/DEI
-      SIJ(I,I)=1.0
-      ALTEM=SIJ(I,J)*QCONV(I)+(1.-SIJ(I,J))*QTI-QSCONV(J)
-      ALTEM=ALTEM/BF2
-      CWAT=CLW(J)*(1.-EP(J))
-      STEMP=SIJ(I,J)
-      IF((STEMP.LT.0.0.OR.STEMP.GT.1.0.OR. &
-            ALTEM.GT.CWAT).AND.J.GT.I)THEN
-        ANUM=ANUM-LV(J)*(QTI-QSCONV(J)-CWAT*BF2)
-        DENOM=DENOM+LV(J)*(QCONV(I)-QTI)
-        IF(ABS(DENOM).LT.0.01)DENOM=0.01
-        SIJ(I,J)=ANUM/DENOM
-        ALTEM=SIJ(I,J)*QCONV(I)+(1.-SIJ(I,J))*QTI-QSCONV(J)
-        ALTEM=ALTEM-(BF2-1.)*CWAT
-      END IF
-      IF(SIJ(I,J).GT.0.0.AND.SIJ(I,J).LT.0.9)THEN
-        QENT(I,J)=SIJ(I,J)*QCONV(I)+(1.-SIJ(I,J))*QTI
-        ELIJ(I,J)=ALTEM
-        ELIJ(I,J)=MAX(0.0,ELIJ(I,J))
-        MENT(I,J)=M(I)/(1.-SIJ(I,J))
-        NENT(I)=NENT(I)+1
-      END IF
-      SIJ(I,J)=MAX(0.0,SIJ(I,J))
-      SIJ(I,J)=MIN(1.0,SIJ(I,J))
-    END DO
-  !
-  !   ***   IF NO AIR CAN ENTRAIN AT LEVEL I ASSUME THAT UPDRAFT DETRAINS  ***
-  !   ***   AT THAT LEVEL AND CALCULATE DETRAINED AIR FLUX AND PROPERTIES  ***
-  !
-    IF(NENT(I).EQ.0)THEN
-      MENT(I,I)=M(I)
-      QENT(I,I)=QCONV(NK)-EP(I)*CLW(I)
-      ELIJ(I,I)=CLW(I)
-      SIJ(I,I)=1.0
-    END IF
-  END DO
-  SIJ(INB,INB)=1.0
-  ! LB 04.05.2021, Attempt to array the loop above: PROBLEM 2 is here
-  ! DO J=ICB,INB
-  !   BF2=1.+LV(J)*LV(J)*QSCONV(J)/(RV*TCONV(J)*TCONV(J)*CPD)
-  !   CWAT=CLW(J)*(1.-EP(J))
-  !   DO I=ICB+1,INB
-  !     QTI=QCONV(NK)-EP(I)*CLW(I)
-  !     ANUM=H(J)-HP(I)+(CPV-CPD)*TCONV(J)*(QTI-QCONV(J))
-  !     DENOM=H(I)-HP(I)+(CPD-CPV)*(QCONV(I)-QTI)*TCONV(J)
-  !     DEI=DENOM
-  !     IF(I.EQ.J)THEN
-  !       SIJ(I,I)=1.0
-  !     ELSE IF(ABS(DENOM).LT.0.01)THEN
-  !       SIJ(I,J)=ANUM/0.01
-  !     ELSE
-  !       SIJ(I,J)=ANUM/DENOM
-  !     END IF
-  !     ALTEM=(SIJ(I,J)*QCONV(I)+(1.-SIJ(I,J))*QTI-QSCONV(J))/BF2
-  !     IF((SIJ(I,J).LT.0.0.OR.SIJ(I,J).GT.1.0.OR. &
-  !           ALTEM.GT.CWAT).AND.J.GT.I)THEN
-  !       ANUM=ANUM-LV(J)*(QTI-QSCONV(J)-CWAT*BF2)
-  !       DENOM=DENOM+LV(J)*(QCONV(I)-QTI)
-  !       IF(ABS(DENOM).LT.0.01)DENOM=0.01
-  !       SIJ(I,J)=ANUM/DENOM
-  !       ALTEM=SIJ(I,J)*QCONV(I)+(1.-SIJ(I,J))*QTI-QSCONV(J)
-  !       ALTEM=ALTEM-(BF2-1.)*CWAT
-  !     END IF
-  !     IF(SIJ(I,J).GT.0.0.AND.SIJ(I,J).LT.0.9)THEN
-  !       QENT(I,J)=SIJ(I,J)*QCONV(I)+(1.-SIJ(I,J))*QTI
-  !       ELIJ(I,J)=ALTEM
-  !       ELIJ(I,J)=MAX(0.0,ELIJ(I,J))
-  !       MENT(I,J)=M(I)/(1.-SIJ(I,J))
-  !       NENT(I)=NENT(I)+1
-  !     END IF
-  !     SIJ(I,J)=MAX(0.0,SIJ(I,J))
-  !     SIJ(I,J)=MIN(1.0,SIJ(I,J))
-  !   END DO
-  ! END DO
-  ! !
-  ! !   ***   IF NO AIR CAN ENTRAIN AT LEVEL I ASSUME THAT UPDRAFT DETRAINS  ***
-  ! !   ***   AT THAT LEVEL AND CALCULATE DETRAINED AIR FLUX AND PROPERTIES  ***
-  ! !
-  ! do I=ICB+1,INB
-  !   IF(NENT(I).EQ.0)THEN
-  !     MENT(I,I)=M(I)
-  !     QENT(I,I)=QCONV(NK)-EP(I)*CLW(I)
-  !     ELIJ(I,I)=CLW(I)
-  !     SIJ(I,I)=1.0
-  !   END IF
-  ! END DO
-  ! SIJ(INB,INB)=1.0
-
-
-  !
-  !   ***  NORMALIZE ENTRAINED AIR MASS FLUXES TO REPRESENT EQUAL  ***
-  !   ***              PROBABILITIES OF MIXING                     ***
-  !
-  ! LB 04.05.2021, depending on how often NENT.ne.0, reversing the loop could
-  ! speed it up...
-  DO I=ICB+1,INB
-    IF(NENT(I).NE.0)THEN
-      QP1=QCONV(NK)-EP(I)*CLW(I)
-      ANUM=H(I)-HP(I)-LV(I)*(QP1-QSCONV(I))
-      DENOM=H(I)-HP(I)+LV(I)*(QCONV(I)-QP1)
-      IF(ABS(DENOM).LT.0.01)DENOM=0.01
-      SCRIT=ANUM/DENOM
-      ALT=QP1-QSCONV(I)+SCRIT*(QCONV(I)-QP1)
-      IF(ALT.LT.0.0)SCRIT=1.0
-      SCRIT=MAX(SCRIT,0.0)
-      ASIJ=0.0
-      SMIN=1.0
-      DO J=ICB,INB
-        IF(SIJ(I,J).GT.0.0.AND.SIJ(I,J).LT.0.9)THEN
-          IF(J.GT.I)THEN
-            SMID=MIN(SIJ(I,J),SCRIT)
-            SJMAX=SMID
-            SJMIN=SMID
-            IF(SMID.LT.SMIN.AND.SIJ(I,J+1).LT.SMID)THEN
-              SMIN=SMID
-              SJMAX=MIN(SIJ(I,J+1),SIJ(I,J),SCRIT)
-              SJMIN=MAX(SIJ(I,J-1),SIJ(I,J))
-              SJMIN=MIN(SJMIN,SCRIT)
-            END IF
-          ELSE
-            SJMAX=MAX(SIJ(I,J+1),SCRIT)
-            SMID=MAX(SIJ(I,J),SCRIT)
-            SJMIN=0.0
-            IF(J.GT.1)SJMIN=SIJ(I,J-1)
-            SJMIN=MAX(SJMIN,SCRIT)
-          END IF
-          DELP=ABS(SJMAX-SMID)
-          DELM=ABS(SJMIN-SMID)
-          ASIJ=ASIJ+(DELP+DELM)*(PHCONV_HPA(J)-PHCONV_HPA(J+1))
-          MENT(I,J)=MENT(I,J)*(DELP+DELM)* &
-               (PHCONV_HPA(J)-PHCONV_HPA(J+1))
-        END IF
-      END DO
-      ASIJ=MAX(1.0E-21,ASIJ)
-      ASIJ=1.0/ASIJ
-      DO J=ICB,INB
-        MENT(I,J)=MENT(I,J)*ASIJ
-      END DO
-      BSUM=0.0
-      DO J=ICB,INB
-        BSUM=BSUM+MENT(I,J)
-      END DO
-      IF(BSUM.LT.1.0E-18)THEN
-        NENT(I)=0
-        MENT(I,I)=M(I)
-        QENT(I,I)=QCONV(NK)-EP(I)*CLW(I)
-        ELIJ(I,I)=CLW(I)
-        SIJ(I,I)=1.0
-      END IF
-    END IF
-  END DO
-
-  !
-  !   ***  CHECK WHETHER EP(INB)=0, IF SO, SKIP PRECIPITATING    ***
-  !   ***             DOWNDRAFT CALCULATION                      ***
-  !
-  if (EP(INB).ge.0.0001) then
-    !
-    !   ***  INTEGRATE LIQUID WATER EQUATION TO FIND CONDENSED WATER   ***
-    !   ***                AND CONDENSED WATER FLUX                    ***
-    !
-    JTT=2
-    !
-    !    ***                    BEGIN DOWNDRAFT LOOP                    ***
-    !
-    DO I=INB,1,-1
-    !
-    !    ***              CALCULATE DETRAINED PRECIPITATION             ***
-    !
-      WDTRAIN=G*EP(I)*M(I)*CLW(I)
-      IF(I.GT.1)THEN
-        DO J=1,I-1
-          AWAT=ELIJ(J,I)-(1.-EP(I))*CLW(I)
-          AWAT=MAX(0.0,AWAT)
-          WDTRAIN=WDTRAIN+G*AWAT*MENT(J,I)
-        END DO
-      END IF
-    !
-    !    ***    FIND RAIN WATER AND EVAPORATION USING PROVISIONAL   ***
-    !    ***              ESTIMATES OF QP(I)AND QP(I-1)             ***
-    !
-    !
-    !  ***  Value of terminal velocity and coefficient of evaporation for snow   ***
-    !
-      COEFF=COEFFS
-      WT(I)=OMTSNOW
-    !
-    !  ***  Value of terminal velocity and coefficient of evaporation for rain   ***
-    !
-      IF(TCONV(I).GT.273.0)THEN
-        COEFF=COEFFR
-        WT(I)=OMTRAIN
-      END IF
-      QSM=0.5*(QCONV(I)+QP(I+1))
-      AFAC=COEFF*PHCONV_HPA(I)*(QSCONV(I)-QSM)/ &
-           (1.0E4+2.0E3*PHCONV_HPA(I)*QSCONV(I))
-      AFAC=MAX(AFAC,0.0)
-      SIGT=SIGP(I)
-      SIGT=MAX(0.0,SIGT)
-      SIGT=MIN(1.0,SIGT)
-      B6=100.*(PHCONV_HPA(I)-PHCONV_HPA(I+1))*SIGT*AFAC/WT(I)
-      C6=(WATER(I+1)*WT(I+1)+WDTRAIN/SIGD)/WT(I)
-      REVAP=0.5*(-B6+SQRT(B6*B6+4.*C6))
-      EVAP(I)=SIGT*AFAC*REVAP
-      WATER(I)=REVAP*REVAP
-    !
-    !    ***  CALCULATE PRECIPITATING DOWNDRAFT MASS FLUX UNDER     ***
-    !    ***              HYDROSTATIC APPROXIMATION                 ***
-    !
-      if (.not. I.eq.1) then
-        DHDP=(H(I)-H(I-1))/(PCONV_HPA(I-1)-PCONV_HPA(I))
-        DHDP=MAX(DHDP,10.0)
-        MP(I)=100.*GINV*LV(I)*SIGD*EVAP(I)/DHDP
-        MP(I)=MAX(MP(I),0.0)
-      !
-      !   ***   ADD SMALL AMOUNT OF INERTIA TO DOWNDRAFT              ***
-      !
-        FAC=20.0/(PHCONV_HPA(I-1)-PHCONV_HPA(I))
-        MP(I)=(FAC*MP(I+1)+MP(I))/(1.+FAC)
-      !
-      !    ***      FORCE MP TO DECREASE LINEARLY TO ZERO                 ***
-      !    ***      BETWEEN ABOUT 950 MB AND THE SURFACE                  ***
-      !
-        IF(PCONV_HPA(I).GT.(0.949*PCONV_HPA(1)))THEN
-          JTT=MAX(JTT,I)
-          MP(I)=MP(JTT)*(PCONV_HPA(1)-PCONV_HPA(I))/(PCONV_HPA(1)- &
-              PCONV_HPA(JTT))
-        END IF
-      endif
-    !
-    !    ***       FIND MIXING RATIO OF PRECIPITATING DOWNDRAFT     ***
-    !
-      if (.not. I.eq.INB) then
-        IF(I.EQ.1)THEN
-          QSTM=QSCONV(1)
-        ELSE
-          QSTM=QSCONV(I-1)
-        END IF
-        IF(MP(I).GT.MP(I+1))THEN
-          RAT=MP(I+1)/MP(I)
-          QP(I)=QP(I+1)*RAT+QCONV(I)*(1.0-RAT)+100.*GINV* &
-               SIGD*(PHCONV_HPA(I)-PHCONV_HPA(I+1))*(EVAP(I)/MP(I))
-         ELSE
-          IF(MP(I+1).GT.0.0)THEN
-            QP(I)=(GZ(I+1)-GZ(I)+QP(I+1)*(LV(I+1)+TCONV(I+1)*(CL-CPD))+ &
-                 CPD*(TCONV(I+1)-TCONV(I)))/(LV(I)+TCONV(I)*(CL-CPD))
-          END IF
-        END IF
-        QP(I)=MIN(QP(I),QSTM)
-        QP(I)=MAX(QP(I),0.0)
-      endif
-    END DO
-    !
-    !   ***  CALCULATE SURFACE PRECIPITATION IN MM/DAY     ***
-    !
-    PRECIP=PRECIP+WT(1)*SIGD*WATER(1)*3600.*24000./(ROWL*G)
-    !
-  endif ! Downdraft calculation
-  !
-  !   ***  CALCULATE DOWNDRAFT VELOCITY SCALE AND SURFACE TEMPERATURE AND  ***
-  !   ***                    WATER VAPOR FLUCTUATIONS                      ***
-  !
-  WD=BETA*ABS(MP(ICB))*0.01*RD*TCONV(ICB)/(SIGD*PCONV_HPA(ICB))
-  QPRIME=0.5*(QP(1)-QCONV(1))
-  TPRIME=LV0*QPRIME/CPD
-  !
-  !   ***  CALCULATE TENDENCIES OF LOWEST LEVEL POTENTIAL TEMPERATURE  ***
-  !   ***                      AND MIXING RATIO                        ***
-  !
-
-  DPINV=0.01/(PHCONV_HPA(1)-PHCONV_HPA(2))
-  AM=0.0
-  IF(NK.EQ.1)THEN
-    AM = sum(M(2:INB))
-  END IF
-  ! save saturated upward mass flux for first level
-  FUP(1)=AM
-  IF((2.*G*DPINV*AM).GE.DELTI)IFLAG=4
-  FT(1)=FT(1)+G*DPINV*AM*(TCONV(2)-TCONV(1)+(GZ(2)-GZ(1))/CPN(1))
-  FT(1)=FT(1)-LVCP(1)*SIGD*EVAP(1)
-  FT(1)=FT(1)+SIGD*WT(2)*(CL-CPD)*WATER(2)*(TCONV(2)- &
-       TCONV(1))*DPINV/CPN(1)
-  FQ(1)=FQ(1)+G*MP(2)*(QP(2)-QCONV(1))* &
-       DPINV+SIGD*EVAP(1)
-  FQ(1)=FQ(1)+G*AM*(QCONV(2)-QCONV(1))*DPINV
-
-  FQ(1)=FQ(1)+G*DPINV*sum(MENT(2:INB,1)*(QENT(2:INB,1)-QCONV(1)))
-  !
-  !   ***  CALCULATE TENDENCIES OF POTENTIAL TEMPERATURE AND MIXING RATIO  ***
-  !   ***               AT LEVELS ABOVE THE LOWEST LEVEL                   ***
-  !
-  !   ***  FIRST FIND THE NET SATURATED UPDRAFT AND DOWNDRAFT MASS FLUXES  ***
-  !   ***                      THROUGH EACH LEVEL                          ***
-  !
-  DO I=2,INB
-    DPINV=0.01/(PHCONV_HPA(I)-PHCONV_HPA(I+1))
-    CPINV=1.0/CPN(I)
-    AMP1=0.0
-    AD=0.0
-    IF(I.GE.NK)THEN
-      AMP1 = sum(M(I+1:INB+1))
-    END IF
-    AMP1 = AMP1 + sum(MENT(1:I,I+1:INB+1))
-  ! save saturated upward mass flux
-    FUP(I)=AMP1
-    IF((2.*G*DPINV*AMP1).GE.DELTI)IFLAG=4
-
-    AD = sum(MENT(I:INB,1:I-1))
-  ! save saturated downward mass flux
-    FDOWN(I)=AD
-    FT(I)=FT(I)+G*DPINV*(AMP1*(TCONV(I+1)-TCONV(I)+(GZ(I+1)-GZ(I))* &
-         CPINV)-AD*(TCONV(I)-TCONV(I-1)+(GZ(I)-GZ(I-1))*CPINV)) &
-         -SIGD*LVCP(I)*EVAP(I)
-    FT(I)=FT(I)+G*DPINV*MENT(I,I)*(HP(I)-H(I)+ &
-         TCONV(I)*(CPV-CPD)*(QCONV(I)-QENT(I,I)))*CPINV
-    FT(I)=FT(I)+SIGD*WT(I+1)*(CL-CPD)*WATER(I+1)* &
-         (TCONV(I+1)-TCONV(I))*DPINV*CPINV
-    FQ(I)=FQ(I)+G*DPINV*(AMP1*(QCONV(I+1)-QCONV(I))- &
-         AD*(QCONV(I)-QCONV(I-1)))
-    DO K=1,I-1
-      AWAT=ELIJ(K,I)-(1.-EP(I))*CLW(I)
-      AWAT=MAX(AWAT,0.0)
-      FQ(I)=FQ(I)+G*DPINV*MENT(K,I)*(QENT(K,I)-AWAT-QCONV(I))
-    END DO
-
-    FQ(I)=FQ(I)+G*DPINV*sum(MENT(I:INB,I)*(QENT(I:INB,I)-QCONV(I)))
-    FQ(I)=FQ(I)+SIGD*EVAP(I)+G*(MP(I+1)* &
-         (QP(I+1)-QCONV(I))-MP(I)*(QP(I)-QCONV(I-1)))*DPINV
-  END DO
-  !
-  !   *** Adjust tendencies at top of convection layer to reflect  ***
-  !   ***       actual position of the level zero CAPE             ***
-  !
-  FQOLD=FQ(INB)
-  FQ(INB)=FQ(INB)*(1.-FRAC)
-  FQ(INB-1)=FQ(INB-1)+FRAC*FQOLD*((PHCONV_HPA(INB)- &
-       PHCONV_HPA(INB+1))/ &
-       (PHCONV_HPA(INB-1)-PHCONV_HPA(INB)))*LV(INB)/LV(INB-1)
-  FTOLD=FT(INB)
-  FT(INB)=FT(INB)*(1.-FRAC)
-  FT(INB-1)=FT(INB-1)+FRAC*FTOLD*((PHCONV_HPA(INB)- &
-       PHCONV_HPA(INB+1))/ &
-       (PHCONV_HPA(INB-1)-PHCONV_HPA(INB)))*CPN(INB)/CPN(INB-1)
-!
-!   ***   Very slightly adjust tendencies to force exact   ***
-!   ***     enthalpy, momentum and tracer conservation     ***
-!
-  ENTS=0.0
-
-  ENTS = sum((CPN(1:INB)*FT(1:INB)+LV(1:INB)*FQ(1:INB))* &
-        (PHCONV_HPA(1:INB)-PHCONV_HPA(2:INB+1)))
-
-  ENTS=ENTS/(PHCONV_HPA(1)-PHCONV_HPA(INB+1))
-
-  FT(1:INB)=FT(1:INB) - ENTS/CPN(1:INB)
-
-  ! ************************************************
-  ! **** DETERMINE MASS DISPLACEMENT MATRIX
-  ! ***** AND COMPENSATING SUBSIDENCE
-  ! ************************************************
-
-  ! mass displacement matrix due to saturated up-and downdrafts
-  ! inside the cloud and determine compensating subsidence
-  ! FUP(I) (saturated updrafts), FDOWN(I) (saturated downdrafts) are assumed to be
-  ! balanced by  compensating subsidence (SUB(I))
-  ! FDOWN(I) and SUB(I) defined positive downwards
-
-  ! NCONVTOP IS THE TOP LEVEL AT WHICH CONVECTIVE MASS FLUXES ARE DIAGNOSED
-  ! EPSILON IS A SMALL NUMBER
-
-  FMASS(NK, :INB+1) = FMASS(NK,:INB+1)+M(:INB+1)
-  FMASS(:INB+1,:INB+1) = FMASS(:INB+1,:INB+1)+MENT(:INB+1,:INB+1)
-  SUB(1) = 0.
-  SUB(2:INB+1) = FUP(1:INB) - FDOWN(2:INB+1)
-  NCONVTOP=1
-  do i=1,INB+1
-    do j=1,INB+1
-      if (FMASS(j,i).gt.EPSILON) NCONVTOP=MAX(NCONVTOP,i,j)
-    end do
-  end do
-  NCONVTOP=NCONVTOP+1
-  RETURN
-  !
-END SUBROUTINE CONVECT
+#include "con_CONVECT.f90"
 !
 ! ---------------------------------------------------------------------------
 !
-SUBROUTINE TLIFT(GZ,ICB,NK,TVP,TPK,CLW,ND,NL,KK)
-  !
-  !-cv
-  use par_mod
-
-  implicit none
-  !-cv
-  !====>Begin Module TLIFT      File convect.f      Undeclared variables
-  !
-  !Argument variables
-  !
-  integer :: icb, kk, nd, nk, nl
-  !
-  !Local variables
-  !
-  integer :: i, j, nsb, nst
-  !
-  real :: ah0, ahg, alv, cpinv, cpp, denom
-  real :: es, qg, rg, s, tc, tg
-  !
-  !====>End Module   TLIFT      File convect.f
-
-  REAL :: GZ(ND),TPK(ND),CLW(ND)
-  REAL :: TVP(ND)
-  !
-  !   ***   ASSIGN VALUES OF THERMODYNAMIC CONSTANTS     ***
-  !
-  REAL,PARAMETER :: CPD=1005.7
-  REAL,PARAMETER :: CPV=1870.0
-  REAL,PARAMETER :: CL=2500.0
-  REAL,PARAMETER :: RV=461.5
-  REAL,PARAMETER :: RD=287.04
-  REAL,PARAMETER :: LV0=2.501E6
-  !
-  REAL,PARAMETER :: CPVMCL=CL-CPV
-  REAL,PARAMETER :: EPS0=RD/RV
-  REAL,PARAMETER :: EPSI=1./EPS0
-  !
-  !   ***  CALCULATE CERTAIN PARCEL QUANTITIES, INCLUDING STATIC ENERGY   ***
-  !
-  AH0=(CPD*(1.-QCONV(NK))+CL*QCONV(NK))*TCONV(NK)+QCONV(NK)* &
-       (LV0-CPVMCL*( &
-       TCONV(NK)-273.15))+GZ(NK)
-  CPP=CPD*(1.-QCONV(NK))+QCONV(NK)*CPV
-  CPINV=1./CPP
-  !
-  IF(KK.EQ.1)THEN
-  !
-  !   ***   CALCULATE LIFTED PARCEL QUANTITIES BELOW CLOUD BASE   ***
-  !
-    CLW(1:ICB-1) = 0.0
-    TPK(NK:ICB-1)=TCONV(NK)-(GZ(NK:ICB-1)-GZ(NK))*CPINV
-    TVP(NK:ICB-1)=TPK(NK:ICB-1)*(1.+QCONV(NK)*EPSI)
-  END IF
-  !
-  !    ***  FIND LIFTED PARCEL QUANTITIES ABOVE CLOUD BASE    ***
-  !
-  NST=ICB
-  NSB=ICB
-  IF(KK.EQ.2)THEN
-    NST=NL
-    NSB=ICB+1
-  END IF
-  DO I=NSB,NST
-    TG=TCONV(I)
-    QG=QSCONV(I)
-    ALV=LV0-CPVMCL*(TCONV(I)-273.15)
-    DO J=1,2
-      S=CPD+ALV*ALV*QG/(RV*TCONV(I)*TCONV(I))
-      S=1./S
-      AHG=CPD*TG+(CL-CPD)*QCONV(NK)*TCONV(I)+ALV*QG+GZ(I)
-      TG=TG+S*(AH0-AHG)
-      TG=MAX(TG,35.0)
-      TC=TG-273.15
-      DENOM=243.5+TC
-      IF(TC.GE.0.0)THEN
-        ES=6.112*EXP(17.67*TC/DENOM)
-      ELSE
-        ES=EXP(23.33086-6111.72784/TG+0.15215*LOG(TG))
-      END IF
-      QG=EPS0*ES/(PCONV_HPA(I)-ES*(1.-EPS0))
-    END DO
-    ALV=LV0-CPVMCL*(TCONV(I)-273.15)
-    TPK(I)=(AH0-(CL-CPD)*QCONV(NK)*TCONV(I)-GZ(I)-ALV*QG)/CPD
-    CLW(I)=QCONV(NK)-QG
-    CLW(I)=MAX(0.0,CLW(I))
-    RG=QG/(1.-QCONV(NK))
-    TVP(I)=TPK(I)*(1.+RG*EPSI)
-  END DO
-  RETURN
-END SUBROUTINE TLIFT
-
-subroutine sort2(n,arr,brr)
-  ! From numerical recipes
-  ! Change by A. Stohl: Use of integer instead of real values
-  implicit none
+#include "con_TLIFT.f90"
 
-  integer, intent(in) :: n
-  integer, intent(inout) :: arr(n),brr(n)
-  integer,parameter :: m=7,nstack=50
-  integer :: i,ir,j,jstack,k,l,istack(nstack)
-  integer :: a,b,temp
-  jstack=0
-  l=1
-  ir=n
-  do
-    if(ir-l.lt.m)then
-      do j=l+1,ir
-        a=arr(j)
-        b=brr(j)
-        i=j-1
-        do while(i.gt.0)
-          if (arr(i).le.a) exit
-          arr(i+1)=arr(i)
-          brr(i+1)=brr(i)
-          i=i-1
-        end do
-        arr(i+1)=a
-        brr(i+1)=b
-      end do
-      if(jstack.eq.0)return
-      ir=istack(jstack)
-      l=istack(jstack-1)
-      jstack=jstack-2
-    else
-      k=(l+ir)/2
-      temp=arr(k)
-      arr(k)=arr(l+1)
-      arr(l+1)=temp
-      temp=brr(k)
-      brr(k)=brr(l+1)
-      brr(l+1)=temp
-      if(arr(l+1).gt.arr(ir))then
-        temp=arr(l+1)
-        arr(l+1)=arr(ir)
-        arr(ir)=temp
-        temp=brr(l+1)
-        brr(l+1)=brr(ir)
-        brr(ir)=temp
-      endif
-      if(arr(l).gt.arr(ir))then
-        temp=arr(l)
-        arr(l)=arr(ir)
-        arr(ir)=temp
-        temp=brr(l)
-        brr(l)=brr(ir)
-        brr(ir)=temp
-      endif
-      if(arr(l+1).gt.arr(l))then
-        temp=arr(l+1)
-        arr(l+1)=arr(l)
-        arr(l)=temp
-        temp=brr(l+1)
-        brr(l+1)=brr(l)
-        brr(l)=temp
-      endif
-      i=l+1
-      j=ir
-      a=arr(l)
-      b=brr(l)
-      do
-        do
-          i=i+1
-          if(arr(i).ge.a) exit
-        end do
-        do
-          j=j-1
-          if(arr(j).le.a) exit
-        end do
-        if(j.lt.i) exit
-        temp=arr(i)
-        arr(i)=arr(j)
-        arr(j)=temp
-        temp=brr(i)
-        brr(i)=brr(j)
-        brr(j)=temp
-      end do
-      arr(l)=arr(j)
-      arr(j)=a
-      brr(l)=brr(j)
-      brr(j)=b
-      jstack=jstack+2
-      if(jstack.gt.nstack) then
-         print*, 'nstack too small in sort2'
-         stop
-      end if
-      if(ir-i+1.ge.j-l)then
-        istack(jstack)=ir
-        istack(jstack-1)=i
-        ir=j-1
-      else
-        istack(jstack)=j-1
-        istack(jstack-1)=l
-        l=i
-      endif
-    endif
-  end do
-!  (C) Copr. 1986-92 Numerical Recipes Software us.
-end subroutine sort2
+#include "con_sort2.f90"
 
 end module conv_mod
diff --git a/src/coo_update_z_to_zeta.f90 b/src/coo_update_z_to_zeta.f90
new file mode 100644
index 0000000000000000000000000000000000000000..e5530111b8fdd39f5d06b95b45eaa0ab1ed8b907
--- /dev/null
+++ b/src/coo_update_z_to_zeta.f90
@@ -0,0 +1,20 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine update_z_to_zeta(itime, ipart)
+  use particle_mod
+  implicit none
+
+  integer, intent(in) ::          &
+    itime,                        & ! time index
+    ipart                           ! particle index
+
+  if (.not. wind_coord_type.eq.'ETA') return
+  if (.not. part(ipart)%alive) return
+  if (part(ipart)%meterupdate) return
+
+  call z_to_zeta(itime,part(ipart)%xlon,part(ipart)%ylat, &
+      part(ipart)%z,part(ipart)%zeta)
+  part(ipart)%etaupdate = .true.
+  part(ipart)%meterupdate = .true.
+end subroutine update_z_to_zeta
diff --git a/src/coo_update_zeta_to_z.f90 b/src/coo_update_zeta_to_z.f90
new file mode 100644
index 0000000000000000000000000000000000000000..4953e999fc7eff7bd31a6736e3f91b484cd8e075
--- /dev/null
+++ b/src/coo_update_zeta_to_z.f90
@@ -0,0 +1,20 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine update_zeta_to_z(itime, ipart)
+  use particle_mod
+  implicit none
+
+  integer, intent(in) ::          &
+    itime,                        & ! time index
+    ipart                           ! particle index
+
+  if (.not. wind_coord_type.eq.'ETA') return
+  if (.not. part(ipart)%alive) return
+  if (part(ipart)%etaupdate) return
+
+  call zeta_to_z(itime,part(ipart)%xlon,part(ipart)%ylat, &
+    part(ipart)%zeta,part(ipart)%z)
+  part(ipart)%etaupdate = .true.
+  part(ipart)%meterupdate = .true.
+end subroutine update_zeta_to_z
diff --git a/src/coo_w_to_weta.f90 b/src/coo_w_to_weta.f90
new file mode 100644
index 0000000000000000000000000000000000000000..73b71e21bccbc15ff4d30750ae162f41b57745e2
--- /dev/null
+++ b/src/coo_w_to_weta.f90
@@ -0,0 +1,41 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine w_to_weta(itime,dt,xt,yt,z_old,zeta_old,w_in,weta_out)
+  !*****************************************************************************
+  ! Converting z from meter coordinates to eta using logarithmic vertical      *
+  ! interpolation                                                              *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! itime [s]          current temporal position                               *
+  ! xt,yt,zold,zold    spatial positions of trajectory (meters)                *
+  ! zteta              vertical position in eta coordinates (output)           *
+  !                                                                            *
+  ! etauvheight defined in windfields: half model heights for ETA coordinates  *
+  ! Constants:                                                                 *
+  !                                                                            *
+  !*****************************************************************************
+  use interpol_mod
+
+  implicit none
+  integer, intent(in)          ::  &
+    itime                            ! time index
+  integer                      ::  &
+    i,m,k,n                          ! loop indices
+  real, intent(in)             ::  &
+    dt                               ! time step
+  real(kind=dp), intent(in)    ::  &
+    xt,yt,z_old,zeta_old              ! particle position
+  real, intent(in)             ::  &
+    w_in                             ! w in meters/s
+  real, intent(inout)          ::  &
+    weta_out                         ! converted output w in meters to eta
+  real(kind=dp)                ::  &
+    znew
+
+  call z_to_zeta(itime,xt,yt,z_old+real(w_in*dt,kind=dp),znew)
+
+  weta_out=real(znew-zeta_old)/dt
+
+end subroutine w_to_weta
diff --git a/src/coo_z_to_zeta.f90 b/src/coo_z_to_zeta.f90
new file mode 100644
index 0000000000000000000000000000000000000000..abba465cd586159d1e899a54e060331893a52d62
--- /dev/null
+++ b/src/coo_z_to_zeta.f90
@@ -0,0 +1,121 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine z_to_zeta(itime,xt,yt,zold,zteta)
+  !*****************************************************************************
+  ! Converting z from meter coordinates to eta using logarithmic vertical      *
+  ! interpolation                                                              *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! itime [s]          current temporal position                               *
+  ! xt,yt,zold,zold    spatial positions of trajectory (meters)                *
+  ! zteta              vertical position in eta coordinates (output)           *
+  !                                                                            *
+  ! etauvheight defined in windfields: half model heights for ETA coordinates  *
+  ! Constants:                                                                 *
+  !                                                                            *
+  !*****************************************************************************
+  use interpol_mod
+
+  implicit none
+  integer, intent(in) ::          &
+    itime                           ! time index
+  integer ::                      &
+    i,m,k,n                         ! loop indices
+  real(kind=dp), intent(in) ::    &
+    xt,yt                           ! particle position
+  real(kind=dp), intent(in) ::    &
+    zold                            ! particle verticle position in eta coordinates
+  real(kind=dp), intent(inout) :: &
+    zteta                           ! converted output z in meters
+  real ::                         &
+    frac,                         & ! fraction between z levels
+    ztemp1,ztemp2,                & ! z positions of the two encompassing levels
+    ttemp1(2),                    & ! storing virtual temperature
+    psint1(2),psint                 ! pressure of encompassing levels
+  real ::                         &
+    prx,pr1,pr2     ! pressure of encompassing levels
+
+  if (.not. log_interpol) then
+    call z_to_zeta_lin(itime,xt,yt,zold,zteta)
+    return
+  endif
+
+  call find_ngrid(xt,yt)
+  call find_grid_indices(real(xt),real(yt))
+  call find_grid_distances(real(xt),real(yt))
+  call find_time_vars(itime)
+
+  ! Integration method as used in the original verttransform_ecmwf.f90
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  ! First estimate the level it is at, to reduce computation time
+  n=nz-3
+  if (ngrid.le.0) then
+    do i=2,nz-1
+      if ((etauvheight(ix,jy,i,memind(1)).gt.real(zold)) .or. &
+          (etauvheight(ixp,jy,i,memind(1)).gt.real(zold)) .or. &
+          (etauvheight(ix,jyp,i,memind(1)).gt.real(zold)) .or. &
+          (etauvheight(ixp,jyp,i,memind(1)).gt.real(zold))) then
+        n=i-2
+        exit
+      endif
+    end do
+  else
+    do i=2,nz-1
+      if ((etauvheightn(ix,jy,i,memind(1),ngrid).gt.real(zold)) .or. &
+          (etauvheightn(ixp,jy,i,memind(1),ngrid).gt.real(zold)) .or. &
+          (etauvheightn(ix,jyp,i,memind(1),ngrid).gt.real(zold)) .or. &
+          (etauvheightn(ixp,jyp,i,memind(1),ngrid).gt.real(zold))) then
+        n=i-2
+        exit
+      endif
+    end do
+  endif
+  n=max(n,2)
+
+  ztemp1 = 0.
+  do i=n,nz-1
+    k=i
+    if (ngrid.le.0) then
+      do m=1,2
+        call hor_interpol(etauvheight,ttemp1(m),i,memind(m),nzmax)
+      end do
+    else
+      do m=1,2
+        call hor_interpol_nest(etauvheightn,ttemp1(m),i,memind(m),nzmax)
+      end do
+    endif
+    call temp_interpol(ttemp1(1),ttemp1(2),ztemp2)
+
+    if (ztemp2.gt.real(zold)) then
+      !frac = (real(zold)-ztemp1)/(ztemp2-ztemp1)
+      exit
+    else if (i.eq.nz-1) then
+      frac = 1.
+      exit
+    endif
+    ztemp1=ztemp2
+  end do
+
+  if (k.lt.nz-1) then
+    if (ngrid.le.0) then
+      do m=1,2
+        call hor_interpol(ps,psint1(m),1,memind(m),1)
+      end do
+    else
+      do m=1,2
+        call hor_interpol_nest(psn,psint1(m),1,memind(m),1)
+      end do
+    endif
+    call temp_interpol(psint1(1),psint1(2),psint)
+    pr1=akz(k-1) + bkz(k-1)*psint
+    pr2=akz(k) + bkz(k)*psint
+
+    prx=pr1/exp(log(pr2/pr1)/(ztemp2-ztemp1)*ztemp1) * &
+      exp(log(pr2/pr1)/(ztemp2-ztemp1)*real(zold))
+    frac=(prx-pr1)/(pr2 - pr1)
+  endif
+
+  zteta=real(uvheight(k-1)*(1.-frac)+uvheight(k)*frac,kind=dp)
+end subroutine z_to_zeta
diff --git a/src/coo_z_to_zeta_lin.f90 b/src/coo_z_to_zeta_lin.f90
new file mode 100644
index 0000000000000000000000000000000000000000..855f1b7bcf534ff79abca7ed83caaa4b0e081170
--- /dev/null
+++ b/src/coo_z_to_zeta_lin.f90
@@ -0,0 +1,97 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine z_to_zeta_lin(itime,xt,yt,zold,zteta)
+  !*****************************************************************************
+  ! Converting z from meter coordinates to eta using linear interpolation      *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! itime [s]          current temporal position                               *
+  ! xt,yt,zold,zold    spatial positions of trajectory (meters)                *
+  ! zteta              vertical position in eta coordinates (output)           *
+  !                                                                            *
+  ! etauvheight defined in windfields: half model heights for ETA coordinates  *
+  ! Constants:                                                                 *
+  !                                                                            *
+  !*****************************************************************************
+  use interpol_mod
+
+  implicit none
+  integer, intent(in) ::          &
+    itime                           ! time index
+  integer ::                      &
+    i,m,k,n                         ! loop indices
+  real(kind=dp), intent(in) ::    &
+    xt,yt                           ! particle position
+  real(kind=dp), intent(in) ::    &
+    zold                            ! particle verticle position in eta coordinates
+  real(kind=dp), intent(inout) :: &
+    zteta                           ! converted output z in meters
+  real ::                         &
+    frac,                         & ! fraction between z levels
+    ztemp1,ztemp2,                & ! z positions of the two encompassing levels
+    ttemp1(2),                    & ! storing virtual temperature
+    psint1(2),psint                 ! pressure of encompassing levels
+  real ::                         &
+    prx,pr1,pr2     ! pressure of encompassing levels
+
+  call find_ngrid(xt,yt)
+  call find_grid_indices(real(xt),real(yt))
+  call find_grid_distances(real(xt),real(yt))
+  call find_time_vars(itime)
+
+  ! Integration method as used in the original verttransform_ecmwf.f90
+  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  ! First estimate the level it is at, to reduce computation time
+  n=nz-3
+  if (ngrid.le.0) then
+    do i=2,nz-1
+      if ((etauvheight(ix,jy,i,memind(1)).gt.real(zold)) .or. &
+          (etauvheight(ixp,jy,i,memind(1)).gt.real(zold)) .or. &
+          (etauvheight(ix,jyp,i,memind(1)).gt.real(zold)) .or. &
+          (etauvheight(ixp,jyp,i,memind(1)).gt.real(zold))) then
+        n=i-2
+        exit
+      endif
+    end do
+  else
+    do i=2,nz-1
+      if ((etauvheightn(ix,jy,i,memind(1),ngrid).gt.real(zold)) .or. &
+          (etauvheightn(ixp,jy,i,memind(1),ngrid).gt.real(zold)) .or. &
+          (etauvheightn(ix,jyp,i,memind(1),ngrid).gt.real(zold)) .or. &
+          (etauvheightn(ixp,jyp,i,memind(1),ngrid).gt.real(zold))) then
+        n=i-2
+        exit
+      endif
+    end do
+  endif
+  n=max(n,2)
+
+  ztemp1 = 0.
+  do i=n,nz-1
+    k=i
+    if (ngrid.le.0) then
+      do m=1,2
+        call hor_interpol(etauvheight,ttemp1(m),i,memind(m),nzmax)
+      end do
+    else
+      do m=1,2
+        call hor_interpol_nest(etauvheightn,ttemp1(m),i,memind(m),nzmax)
+      end do
+    endif
+    call temp_interpol(ttemp1(1),ttemp1(2),ztemp2)
+
+    if (ztemp2.gt.real(zold)) then
+      frac = (real(zold)-ztemp1)/(ztemp2-ztemp1)
+      exit
+    else if (i.eq.nz-1) then
+      frac = 1.
+      exit
+    endif
+    ztemp1=ztemp2
+  end do
+
+  zteta=real(uvheight(k-1)*(1.-frac)+uvheight(k)*frac,kind=dp)
+end subroutine z_to_zeta_lin
diff --git a/src/coo_zeta_to_z.f90 b/src/coo_zeta_to_z.f90
new file mode 100644
index 0000000000000000000000000000000000000000..3a619ca30e2be01b5d70c27bed754a92578a8278
--- /dev/null
+++ b/src/coo_zeta_to_z.f90
@@ -0,0 +1,97 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine zeta_to_z(itime,xt,yt,zteta,ztout)
+  !*****************************************************************************
+  ! Converting z from eta coordinates to meters using logarithmic              *
+  ! vertical interpolation                                                     *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! itime [s]          current temporal position                               *
+  ! xt,yt,zteta        spatial position of trajectory                          *
+  ! ztout              vertical postion in meter (output)                      *
+  !                                                                            *
+  !                                                                            *
+  !*****************************************************************************
+  use interpol_mod
+
+  implicit none
+  integer, intent(in) ::          &
+    itime                           ! time index
+  integer ::                      &
+    i,j,k,m,ii,indexh               ! loop indices
+  real(kind=dp), intent(in) ::    &
+    xt,yt                           ! particle position
+  real(kind=dp), intent(in) ::    &
+    zteta                           ! particle verticle position in eta coordinates
+  real(kind=dp), intent(inout) :: &
+    ztout                           ! converted output z in meters
+  real(kind=dp) ::                &
+    frac                            ! fraction between z levels
+  real ::                         &
+    ztemp1(2),                    & ! z positions of the two encompassing levels
+    ttemp1(2),                    & ! storing virtual temperature
+    psint1(2),psint,prx,pr1,pr2     ! pressure of encompassing levels
+
+  if (.not. log_interpol) then
+    call zeta_to_z_lin(itime,xt,yt,zteta,ztout)
+    return
+  endif
+
+  ! Convert eta z coordinate to meters
+  !***********************************
+  call find_ngrid(xt,yt)
+  call find_grid_indices(real(xt),real(yt))
+  call find_grid_distances(real(xt),real(yt))
+  call find_time_vars(itime)
+
+  k=nz-1
+  frac=1.
+  do i=2,nz-1
+    k=i
+    if (zteta.ge.real(uvheight(k),kind=dp)) then
+      frac=(zteta-real(uvheight(k-1),kind=dp))/(real(uvheight(k)-uvheight(k-1),kind=dp))
+      exit
+    endif
+  end do
+
+  if (ngrid.le.0) then
+    do m=1,2
+      call hor_interpol(ps,psint1(m),1,memind(m),1)
+    end do
+  else
+    do m=1,2
+      call hor_interpol_nest(psn,psint1(m),1,memind(m),1)
+    end do
+  endif
+
+  call temp_interpol(psint1(1),psint1(2),psint)
+  pr1=akz(k-1) + bkz(k-1)*psint
+  pr2=akz(k) + bkz(k)*psint
+  prx=pr1*(1.-frac) + pr2*frac
+
+  if (ngrid.le.0) then
+    do ii=1,2
+      do m=1,2
+        call hor_interpol(etauvheight,ttemp1(m),k+ii-2,memind(m),nzmax)
+      end do
+      call temp_interpol(ttemp1(1),ttemp1(2),ztemp1(ii))
+    end do
+  else
+    do ii=1,2
+      do m=1,2
+        call hor_interpol_nest(etauvheightn, &
+          ttemp1(m),k+ii-2,memind(m),nzmax)
+      end do
+      call temp_interpol(ttemp1(1),ttemp1(2),ztemp1(ii))
+    end do
+  endif
+
+  if ((pr2.eq.0).or.(pr1.eq.0)) then
+    ztout = real(ztemp1(1),kind=dp)*(1.-frac)+real(ztemp1(2),kind=dp)*frac
+    return
+  endif
+
+  ztout = ztemp1(1) + (ztemp1(2)-ztemp1(1))/log(pr2/pr1)*log(prx/pr1)
+end subroutine zeta_to_z
diff --git a/src/coo_zeta_to_z_lin.f90 b/src/coo_zeta_to_z_lin.f90
new file mode 100644
index 0000000000000000000000000000000000000000..2850c08f31e67e3c13812a98563302a56ba3d236
--- /dev/null
+++ b/src/coo_zeta_to_z_lin.f90
@@ -0,0 +1,73 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine zeta_to_z_lin(itime,xt,yt,zteta,ztout)
+
+  !*****************************************************************************
+  ! Converting z from eta coordinates to meters using linear interpolation     *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! itime [s]          current temporal position                               *
+  ! xt,yt,zteta        spatial position of trajectory                          *
+  ! ztout              vertical postion in meter (output)                      *
+  !                                                                            *
+  !                                                                            *
+  !*****************************************************************************
+  use interpol_mod
+
+  implicit none
+  integer, intent(in) ::          &
+    itime                           ! time index
+  integer ::                      &
+    i,j,k,m,ii,indexh               ! loop indices
+  real(kind=dp), intent(in) ::    &
+    xt,yt                           ! particle position
+  real(kind=dp), intent(in) ::    &
+    zteta                           ! particle verticle position in eta coordinates
+  real(kind=dp), intent(inout) :: &
+    ztout                           ! converted output z in meters
+  real(kind=dp) ::                &
+    frac                            ! fraction between z levels
+  real ::                         &
+    ztemp1(2),                    & ! z positions of the two encompassing levels
+    ttemp1(2),                    & ! storing virtual temperature
+    psint1(2),psint                 ! pressure of encompassing levels
+
+
+  ! Convert eta z coordinate to meters
+  !***********************************
+  call find_ngrid(xt,yt)
+  call find_grid_indices(real(xt),real(yt))
+  call find_grid_distances(real(xt),real(yt))
+  call find_time_vars(itime)
+
+  k=nz-1
+  frac=1.
+  do i=2,nz-1
+    k=i
+    if (zteta.ge.real(uvheight(k),kind=dp)) then
+      frac=(zteta-real(uvheight(k-1),kind=dp))/(real(uvheight(k)-uvheight(k-1),kind=dp))
+      exit
+    endif
+  end do
+
+  if (ngrid.le.0) then
+    do ii=1,2
+      do m=1,2
+        call hor_interpol(etauvheight,ttemp1(m),k+ii-2,memind(m),nzmax)
+      end do
+      call temp_interpol(ttemp1(1),ttemp1(2),ztemp1(ii))
+    end do
+  else
+    do ii=1,2
+      do m=1,2
+        call hor_interpol_nest(etauvheightn,ttemp1(m),k+ii-2,memind(m),nzmax)
+      end do
+      call temp_interpol(ttemp1(1),ttemp1(2),ztemp1(ii))
+    end do
+  endif
+
+  ztout = real(ztemp1(1),kind=dp)*(1.-frac)+real(ztemp1(2),kind=dp)*frac
+end subroutine zeta_to_z_lin
diff --git a/src/coord_ec_mod.f90 b/src/coord_ec_mod.f90
index 5bdfc0035f1c6714ccf572b9289f7bd2c6b134d9..e2fd0398293b1965554be0b350e42123272c21da 100644
--- a/src/coord_ec_mod.f90
+++ b/src/coord_ec_mod.f90
@@ -17,459 +17,18 @@ module coord_ec_mod
 
 contains
 
-subroutine update_zeta_to_z(itime, ipart)
-  use particle_mod
-  implicit none 
+#include "coo_update_zeta_to_z.f90"
 
-  integer, intent(in) ::          &
-    itime,                        & ! time index
-    ipart                           ! particle index
+#include "coo_update_z_to_zeta.f90"
 
-  if (.not. wind_coord_type.eq.'ETA') return
-  if (.not. part(ipart)%alive) return  
-  if (part(ipart)%etaupdate) return
+#include "coo_z_to_zeta.f90"
 
-  call zeta_to_z(itime,part(ipart)%xlon,part(ipart)%ylat, &
-    part(ipart)%zeta,part(ipart)%z)
-  part(ipart)%etaupdate = .true.
-  part(ipart)%meterupdate = .true.
-end subroutine update_zeta_to_z
+#include "coo_zeta_to_z.f90"
 
-subroutine update_z_to_zeta(itime, ipart)
-  use particle_mod
-  implicit none 
+#include "coo_w_to_weta.f90"
 
-  integer, intent(in) ::          &
-    itime,                        & ! time index
-    ipart                           ! particle index
+#include "coo_z_to_zeta_lin.f90"
 
-  if (.not. wind_coord_type.eq.'ETA') return
-  if (.not. part(ipart)%alive) return
-  if (part(ipart)%meterupdate) return
-
-  call z_to_zeta(itime,part(ipart)%xlon,part(ipart)%ylat, &
-      part(ipart)%z,part(ipart)%zeta)
-  part(ipart)%etaupdate = .true.
-  part(ipart)%meterupdate = .true.
-end subroutine update_z_to_zeta
-
-subroutine z_to_zeta(itime,xt,yt,zold,zteta)
-  !*****************************************************************************
-  ! Converting z from meter coordinates to eta using logarithmic vertical      *
-  ! interpolation                                                              *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! itime [s]          current temporal position                               *
-  ! xt,yt,zold,zold    spatial positions of trajectory (meters)                *
-  ! zteta              vertical position in eta coordinates (output)           *
-  !                                                                            *
-  ! etauvheight defined in windfields: half model heights for ETA coordinates  *
-  ! Constants:                                                                 *
-  !                                                                            *
-  !*****************************************************************************
-  use interpol_mod
-
-  implicit none
-  integer, intent(in) ::          &
-    itime                           ! time index
-  integer ::                      &
-    i,m,k,n                         ! loop indices
-  real(kind=dp), intent(in) ::    &
-    xt,yt                           ! particle position
-  real(kind=dp), intent(in) ::    &
-    zold                            ! particle verticle position in eta coordinates
-  real(kind=dp), intent(inout) :: &
-    zteta                           ! converted output z in meters
-  real ::                         &
-    frac,                         & ! fraction between z levels
-    ztemp1,ztemp2,                & ! z positions of the two encompassing levels
-    ttemp1(2),                    & ! storing virtual temperature
-    psint1(2),psint                 ! pressure of encompassing levels
-  real ::                         &
-    prx,pr1,pr2     ! pressure of encompassing levels
-
-  if (.not. log_interpol) then
-    call z_to_zeta_lin(itime,xt,yt,zold,zteta)
-    return
-  endif
-
-  call find_ngrid(xt,yt)
-  call find_grid_indices(real(xt),real(yt))
-  call find_grid_distances(real(xt),real(yt))
-  call find_time_vars(itime)
-
-  ! Integration method as used in the original verttransform_ecmwf.f90
-  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-  ! First estimate the level it is at, to reduce computation time
-  n=nz-3
-  if (ngrid.le.0) then
-    do i=2,nz-1
-      if ((etauvheight(ix,jy,i,memind(1)).gt.real(zold)) .or. &
-          (etauvheight(ixp,jy,i,memind(1)).gt.real(zold)) .or. & 
-          (etauvheight(ix,jyp,i,memind(1)).gt.real(zold)) .or. &
-          (etauvheight(ixp,jyp,i,memind(1)).gt.real(zold))) then
-        n=i-2
-        exit
-      endif
-    end do
-  else
-    do i=2,nz-1
-      if ((etauvheightn(ix,jy,i,memind(1),ngrid).gt.real(zold)) .or. &
-          (etauvheightn(ixp,jy,i,memind(1),ngrid).gt.real(zold)) .or. & 
-          (etauvheightn(ix,jyp,i,memind(1),ngrid).gt.real(zold)) .or. &
-          (etauvheightn(ixp,jyp,i,memind(1),ngrid).gt.real(zold))) then
-        n=i-2
-        exit
-      endif
-    end do
-  endif
-  n=max(n,2)
-
-  ztemp1 = 0.
-  do i=n,nz-1
-    k=i
-    if (ngrid.le.0) then
-      do m=1,2
-        call hor_interpol(etauvheight,ttemp1(m),i,memind(m),nzmax)
-      end do
-    else
-      do m=1,2
-        call hor_interpol_nest(etauvheightn,ttemp1(m),i,memind(m),nzmax)
-      end do
-    endif
-    call temp_interpol(ttemp1(1),ttemp1(2),ztemp2)
-
-    if (ztemp2.gt.real(zold)) then
-      !frac = (real(zold)-ztemp1)/(ztemp2-ztemp1)
-      exit
-    else if (i.eq.nz-1) then
-      frac = 1.
-      exit
-    endif
-    ztemp1=ztemp2
-  end do
-
-  if (k.lt.nz-1) then
-    if (ngrid.le.0) then
-      do m=1,2
-        call hor_interpol(ps,psint1(m),1,memind(m),1)
-      end do
-    else
-      do m=1,2
-        call hor_interpol_nest(psn,psint1(m),1,memind(m),1)
-      end do
-    endif
-    call temp_interpol(psint1(1),psint1(2),psint)  
-    pr1=akz(k-1) + bkz(k-1)*psint
-    pr2=akz(k) + bkz(k)*psint
-
-    prx=pr1/exp(log(pr2/pr1)/(ztemp2-ztemp1)*ztemp1) * &
-      exp(log(pr2/pr1)/(ztemp2-ztemp1)*real(zold))
-    frac=(prx-pr1)/(pr2 - pr1)
-  endif
-
-  zteta=real(uvheight(k-1)*(1.-frac)+uvheight(k)*frac,kind=dp)
-end subroutine z_to_zeta
-
-subroutine zeta_to_z(itime,xt,yt,zteta,ztout)
-  !*****************************************************************************
-  ! Converting z from eta coordinates to meters using logarithmic              *
-  ! vertical interpolation                                                     *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! itime [s]          current temporal position                               *
-  ! xt,yt,zteta        spatial position of trajectory                          *
-  ! ztout              vertical postion in meter (output)                      *
-  !                                                                            *
-  !                                                                            *
-  !*****************************************************************************
-  use interpol_mod
-
-  implicit none
-  integer, intent(in) ::          &
-    itime                           ! time index
-  integer ::                      &
-    i,j,k,m,ii,indexh               ! loop indices
-  real(kind=dp), intent(in) ::    &
-    xt,yt                           ! particle position
-  real(kind=dp), intent(in) ::    &
-    zteta                           ! particle verticle position in eta coordinates
-  real(kind=dp), intent(inout) :: &
-    ztout                           ! converted output z in meters
-  real(kind=dp) ::                &
-    frac                            ! fraction between z levels
-  real ::                         &
-    ztemp1(2),                    & ! z positions of the two encompassing levels
-    ttemp1(2),                    & ! storing virtual temperature
-    psint1(2),psint,prx,pr1,pr2     ! pressure of encompassing levels
- 
-  if (.not. log_interpol) then
-    call zeta_to_z_lin(itime,xt,yt,zteta,ztout)
-    return
-  endif
-
-  ! Convert eta z coordinate to meters
-  !***********************************
-  call find_ngrid(xt,yt)
-  call find_grid_indices(real(xt),real(yt))
-  call find_grid_distances(real(xt),real(yt))
-  call find_time_vars(itime)
-
-  k=nz-1
-  frac=1.
-  do i=2,nz-1
-    k=i
-    if (zteta.ge.real(uvheight(k),kind=dp)) then
-      frac=(zteta-real(uvheight(k-1),kind=dp))/(real(uvheight(k)-uvheight(k-1),kind=dp))
-      exit
-    endif
-  end do
-
-  if (ngrid.le.0) then
-    do m=1,2
-      call hor_interpol(ps,psint1(m),1,memind(m),1)
-    end do
-  else
-    do m=1,2
-      call hor_interpol_nest(psn,psint1(m),1,memind(m),1)
-    end do
-  endif
-
-  call temp_interpol(psint1(1),psint1(2),psint)  
-  pr1=akz(k-1) + bkz(k-1)*psint
-  pr2=akz(k) + bkz(k)*psint
-  prx=pr1*(1.-frac) + pr2*frac
-  
-  if (ngrid.le.0) then
-    do ii=1,2
-      do m=1,2
-        call hor_interpol(etauvheight,ttemp1(m),k+ii-2,memind(m),nzmax)
-      end do
-      call temp_interpol(ttemp1(1),ttemp1(2),ztemp1(ii))
-    end do
-  else
-    do ii=1,2
-      do m=1,2
-        call hor_interpol_nest(etauvheightn, &
-          ttemp1(m),k+ii-2,memind(m),nzmax)
-      end do
-      call temp_interpol(ttemp1(1),ttemp1(2),ztemp1(ii))
-    end do
-  endif
-
-  if ((pr2.eq.0).or.(pr1.eq.0)) then
-    ztout = real(ztemp1(1),kind=dp)*(1.-frac)+real(ztemp1(2),kind=dp)*frac
-    return
-  endif
-  
-  ztout = ztemp1(1) + (ztemp1(2)-ztemp1(1))/log(pr2/pr1)*log(prx/pr1)
-end subroutine zeta_to_z
-
-subroutine w_to_weta(itime,dt,xt,yt,z_old,zeta_old,w_in,weta_out)
-  !*****************************************************************************
-  ! Converting z from meter coordinates to eta using logarithmic vertical      *
-  ! interpolation                                                              *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! itime [s]          current temporal position                               *
-  ! xt,yt,zold,zold    spatial positions of trajectory (meters)                *
-  ! zteta              vertical position in eta coordinates (output)           *
-  !                                                                            *
-  ! etauvheight defined in windfields: half model heights for ETA coordinates  *
-  ! Constants:                                                                 *
-  !                                                                            *
-  !*****************************************************************************
-  use interpol_mod
-
-  implicit none
-  integer, intent(in)          ::  &
-    itime                            ! time index
-  integer                      ::  &
-    i,m,k,n                          ! loop indices
-  real, intent(in)             ::  &
-    dt                               ! time step
-  real(kind=dp), intent(in)    ::  &
-    xt,yt,z_old,zeta_old              ! particle position
-  real, intent(in)             ::  &
-    w_in                             ! w in meters/s
-  real, intent(inout)          ::  &
-    weta_out                         ! converted output w in meters to eta
-  real(kind=dp)                ::  &
-    znew
-
-  call z_to_zeta(itime,xt,yt,z_old+real(w_in*dt,kind=dp),znew)
-
-  weta_out=real(znew-zeta_old)/dt
-
-end subroutine w_to_weta
-
-subroutine z_to_zeta_lin(itime,xt,yt,zold,zteta)
-  !*****************************************************************************
-  ! Converting z from meter coordinates to eta using linear interpolation      *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! itime [s]          current temporal position                               *
-  ! xt,yt,zold,zold    spatial positions of trajectory (meters)                *
-  ! zteta              vertical position in eta coordinates (output)           *
-  !                                                                            *
-  ! etauvheight defined in windfields: half model heights for ETA coordinates  *
-  ! Constants:                                                                 *
-  !                                                                            *
-  !*****************************************************************************
-  use interpol_mod
-
-  implicit none
-  integer, intent(in) ::          &
-    itime                           ! time index
-  integer ::                      &
-    i,m,k,n                         ! loop indices
-  real(kind=dp), intent(in) ::    &
-    xt,yt                           ! particle position
-  real(kind=dp), intent(in) ::    &
-    zold                            ! particle verticle position in eta coordinates
-  real(kind=dp), intent(inout) :: &
-    zteta                           ! converted output z in meters
-  real ::                         &
-    frac,                         & ! fraction between z levels
-    ztemp1,ztemp2,                & ! z positions of the two encompassing levels
-    ttemp1(2),                    & ! storing virtual temperature
-    psint1(2),psint                 ! pressure of encompassing levels
-  real ::                         &
-    prx,pr1,pr2     ! pressure of encompassing levels
-
-  call find_ngrid(xt,yt)
-  call find_grid_indices(real(xt),real(yt))
-  call find_grid_distances(real(xt),real(yt))
-  call find_time_vars(itime)
-
-  ! Integration method as used in the original verttransform_ecmwf.f90
-  !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
-  ! First estimate the level it is at, to reduce computation time
-  n=nz-3
-  if (ngrid.le.0) then
-    do i=2,nz-1
-      if ((etauvheight(ix,jy,i,memind(1)).gt.real(zold)) .or. &
-          (etauvheight(ixp,jy,i,memind(1)).gt.real(zold)) .or. &
-          (etauvheight(ix,jyp,i,memind(1)).gt.real(zold)) .or. &
-          (etauvheight(ixp,jyp,i,memind(1)).gt.real(zold))) then
-        n=i-2
-        exit
-      endif
-    end do
-  else
-    do i=2,nz-1
-      if ((etauvheightn(ix,jy,i,memind(1),ngrid).gt.real(zold)) .or. &
-          (etauvheightn(ixp,jy,i,memind(1),ngrid).gt.real(zold)) .or. &
-          (etauvheightn(ix,jyp,i,memind(1),ngrid).gt.real(zold)) .or. &
-          (etauvheightn(ixp,jyp,i,memind(1),ngrid).gt.real(zold))) then
-        n=i-2
-        exit
-      endif
-    end do
-  endif
-  n=max(n,2)
-
-  ztemp1 = 0.
-  do i=n,nz-1
-    k=i
-    if (ngrid.le.0) then
-      do m=1,2
-        call hor_interpol(etauvheight,ttemp1(m),i,memind(m),nzmax)
-      end do
-    else
-      do m=1,2
-        call hor_interpol_nest(etauvheightn,ttemp1(m),i,memind(m),nzmax)
-      end do
-    endif    
-    call temp_interpol(ttemp1(1),ttemp1(2),ztemp2)
-
-    if (ztemp2.gt.real(zold)) then
-      frac = (real(zold)-ztemp1)/(ztemp2-ztemp1)
-      exit
-    else if (i.eq.nz-1) then
-      frac = 1.
-      exit
-    endif
-    ztemp1=ztemp2
-  end do
-
-  zteta=real(uvheight(k-1)*(1.-frac)+uvheight(k)*frac,kind=dp)
-end subroutine z_to_zeta_lin
-
-subroutine zeta_to_z_lin(itime,xt,yt,zteta,ztout)
-
-  !*****************************************************************************
-  ! Converting z from eta coordinates to meters using linear interpolation     *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! itime [s]          current temporal position                               *
-  ! xt,yt,zteta        spatial position of trajectory                          *
-  ! ztout              vertical postion in meter (output)                      *
-  !                                                                            *
-  !                                                                            *
-  !*****************************************************************************
-  use interpol_mod
-
-  implicit none
-  integer, intent(in) ::          &
-    itime                           ! time index
-  integer ::                      &
-    i,j,k,m,ii,indexh               ! loop indices
-  real(kind=dp), intent(in) ::    &
-    xt,yt                           ! particle position
-  real(kind=dp), intent(in) ::    &
-    zteta                           ! particle verticle position in eta coordinates
-  real(kind=dp), intent(inout) :: &
-    ztout                           ! converted output z in meters
-  real(kind=dp) ::                &
-    frac                            ! fraction between z levels
-  real ::                         &
-    ztemp1(2),                    & ! z positions of the two encompassing levels
-    ttemp1(2),                    & ! storing virtual temperature
-    psint1(2),psint                 ! pressure of encompassing levels
- 
-
-  ! Convert eta z coordinate to meters
-  !***********************************
-  call find_ngrid(xt,yt)
-  call find_grid_indices(real(xt),real(yt))
-  call find_grid_distances(real(xt),real(yt))
-  call find_time_vars(itime)
-
-  k=nz-1
-  frac=1.
-  do i=2,nz-1
-    k=i
-    if (zteta.ge.real(uvheight(k),kind=dp)) then
-      frac=(zteta-real(uvheight(k-1),kind=dp))/(real(uvheight(k)-uvheight(k-1),kind=dp))
-      exit
-    endif
-  end do
-  
-  if (ngrid.le.0) then
-    do ii=1,2
-      do m=1,2
-        call hor_interpol(etauvheight,ttemp1(m),k+ii-2,memind(m),nzmax)
-      end do
-      call temp_interpol(ttemp1(1),ttemp1(2),ztemp1(ii))
-    end do
-  else
-    do ii=1,2
-      do m=1,2
-        call hor_interpol_nest(etauvheightn,ttemp1(m),k+ii-2,memind(m),nzmax)
-      end do
-      call temp_interpol(ttemp1(1),ttemp1(2),ztemp1(ii))
-    end do
-  endif
-  
-  ztout = real(ztemp1(1),kind=dp)*(1.-frac)+real(ztemp1(2),kind=dp)*frac
-end subroutine zeta_to_z_lin
+#include "coo_zeta_to_z_lin.f90"
 
 end module coord_ec_mod
diff --git a/src/dat_caldate.f90 b/src/dat_caldate.f90
new file mode 100644
index 0000000000000000000000000000000000000000..2bbf3761b30b94d7dbcc8287b843b1cc15c972fa
--- /dev/null
+++ b/src/dat_caldate.f90
@@ -0,0 +1,75 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine caldate(juliandate,yyyymmdd,hhmiss)
+  !                      i       o       o
+  !*****************************************************************************
+  !                                                                            *
+  !     Calculates the Gregorian date from the Julian date                     *
+  !                                                                            *
+  !     AUTHOR: Andreas Stohl (21 January 1994), adapted from Numerical Recipes*
+  !                                                                            *
+  !     Variables:                                                             *
+  !     dd             Day                                                     *
+  !     hh             Hour                                                    *
+  !     hhmiss         Hour, Minute, Second                                    *
+  !     ja,jb,jc,jd,je help variables                                          *
+  !     jalpha         help variable                                           *
+  !     juliandate        Julian Date                                          *
+  !     julday         help variable                                           *
+  !     mi             Minute                                                  *
+  !     mm             Month                                                   *
+  !     ss             Seconds                                                 *
+  !     yyyy           Year                                                    *
+  !     yyyymmdd       Year, Month, Day                                        *
+  !                                                                            *
+  !     Constants:                                                             *
+  !     igreg          help constant                                           *
+  !                                                                            *
+  !*****************************************************************************
+
+  implicit none
+
+  integer           :: yyyymmdd,yyyy,mm,dd,hhmiss,hh,mi,ss
+  integer           :: julday,ja,jb,jc,jd,je,jalpha
+  real(kind=dp)     :: juliandate
+  integer,parameter :: igreg=2299161
+
+  julday=int(juliandate)
+  if ((juliandate-julday)*86400._dp .ge. 86399.5_dp) then
+    juliandate = juliandate + juliandate-julday-86399.5_dp/86400._dp
+    julday=int(juliandate)
+  endif
+  if(julday.ge.igreg)then
+    jalpha=int(((julday-1867216)-0.25)/36524.25)
+    ja=julday+1+jalpha-int(0.25*jalpha)
+  else
+    ja=julday
+  endif
+  jb=ja+1524
+  jc=int(6680.+((jb-2439870)-122.1)/365.25)
+  jd=365*jc+int(0.25*jc)
+  je=int((jb-jd)/30.6001)
+  dd=jb-jd-int(30.6001*je)
+  mm=je-1
+  if (mm.gt.12) mm=mm-12
+  yyyy=jc-4715
+  if (mm.gt.2) yyyy=yyyy-1
+  if (yyyy.le.0) yyyy=yyyy-1
+
+  yyyymmdd=10000*yyyy+100*mm+dd
+  hh=int(24._dp*(juliandate-real(julday,kind=dp)))
+  mi=int(1440._dp*(juliandate-real(julday,kind=dp))-60._dp*real(hh,kind=dp))
+  ss=nint(86400._dp*(juliandate-real(julday,kind=dp))-3600._dp*real(hh,kind=dp)- &
+       60._dp*real(mi,kind=dp))
+  if (ss.eq.60) then  ! 60 seconds = 1 minute
+    ss=0
+    mi=mi+1
+  endif
+  if (mi.eq.60) then
+    mi=0
+    hh=hh+1
+  endif
+  hhmiss=10000*hh+100*mi+ss
+
+end subroutine caldate
diff --git a/src/date_mod.f90 b/src/date_mod.f90
index eadf4951051cab498b07c44241d9d0f7fa98f50b..015eb31a52a4c223b5d7ff39a02b6c02be85d1f5 100644
--- a/src/date_mod.f90
+++ b/src/date_mod.f90
@@ -10,83 +10,12 @@
 
 module date_mod
   use par_mod, only: dp
-  
-  implicit none
-
-contains
-
-subroutine caldate(juliandate,yyyymmdd,hhmiss)
-  !                      i       o       o
-  !*****************************************************************************
-  !                                                                            *
-  !     Calculates the Gregorian date from the Julian date                     *
-  !                                                                            *
-  !     AUTHOR: Andreas Stohl (21 January 1994), adapted from Numerical Recipes*
-  !                                                                            *
-  !     Variables:                                                             *
-  !     dd             Day                                                     *
-  !     hh             Hour                                                    *
-  !     hhmiss         Hour, Minute, Second                                    *
-  !     ja,jb,jc,jd,je help variables                                          *
-  !     jalpha         help variable                                           *
-  !     juliandate        Julian Date                                          *
-  !     julday         help variable                                           *
-  !     mi             Minute                                                  *
-  !     mm             Month                                                   *
-  !     ss             Seconds                                                 *
-  !     yyyy           Year                                                    *
-  !     yyyymmdd       Year, Month, Day                                        *
-  !                                                                            *
-  !     Constants:                                                             *
-  !     igreg          help constant                                           *
-  !                                                                            *
-  !*****************************************************************************
 
   implicit none
 
-  integer           :: yyyymmdd,yyyy,mm,dd,hhmiss,hh,mi,ss
-  integer           :: julday,ja,jb,jc,jd,je,jalpha
-  real(kind=dp)     :: juliandate
-  integer,parameter :: igreg=2299161
-
-  julday=int(juliandate)
-  if ((juliandate-julday)*86400._dp .ge. 86399.5_dp) then
-    juliandate = juliandate + juliandate-julday-86399.5_dp/86400._dp
-    julday=int(juliandate)
-  endif
-  if(julday.ge.igreg)then
-    jalpha=int(((julday-1867216)-0.25)/36524.25)
-    ja=julday+1+jalpha-int(0.25*jalpha)
-  else
-    ja=julday
-  endif
-  jb=ja+1524
-  jc=int(6680.+((jb-2439870)-122.1)/365.25)
-  jd=365*jc+int(0.25*jc)
-  je=int((jb-jd)/30.6001)
-  dd=jb-jd-int(30.6001*je)
-  mm=je-1
-  if (mm.gt.12) mm=mm-12
-  yyyy=jc-4715
-  if (mm.gt.2) yyyy=yyyy-1
-  if (yyyy.le.0) yyyy=yyyy-1
-
-  yyyymmdd=10000*yyyy+100*mm+dd
-  hh=int(24._dp*(juliandate-real(julday,kind=dp)))
-  mi=int(1440._dp*(juliandate-real(julday,kind=dp))-60._dp*real(hh,kind=dp))
-  ss=nint(86400._dp*(juliandate-real(julday,kind=dp))-3600._dp*real(hh,kind=dp)- &
-       60._dp*real(mi,kind=dp))
-  if (ss.eq.60) then  ! 60 seconds = 1 minute
-    ss=0
-    mi=mi+1
-  endif
-  if (mi.eq.60) then
-    mi=0
-    hh=hh+1
-  endif
-  hhmiss=10000*hh+100*mi+ss
+contains
 
-end subroutine caldate
+#include "dat_caldate.f90"
 
 real(kind=dp) function juldate(yyyymmdd,hhmiss)
 
diff --git a/src/dry_alloc_drydepo.f90 b/src/dry_alloc_drydepo.f90
new file mode 100644
index 0000000000000000000000000000000000000000..714e41dca7aecfc646fbe90addbf944c4d22149f
--- /dev/null
+++ b/src/dry_alloc_drydepo.f90
@@ -0,0 +1,14 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine alloc_drydepo
+
+  implicit none
+
+  if (.not. drydep) return
+  write(*,*) 'allocate drydepo fields'
+  allocate(xlanduse(0:nxmax-1,0:nymax-1,numclass),      &
+           xlandusen(0:nxmaxn-1,0:nymaxn-1,numclass,maxnests), &
+           vdep(0:nxmax-1,0:nymax-1,maxspec,numwfmem))
+
+end subroutine alloc_drydepo
diff --git a/src/dry_assignland.f90 b/src/dry_assignland.f90
new file mode 100644
index 0000000000000000000000000000000000000000..699587f1e995bdc973485fa0758f8bbd1bd9cefd
--- /dev/null
+++ b/src/dry_assignland.f90
@@ -0,0 +1,218 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine assignland
+
+  !*****************************************************************************
+  !                                                                            *
+  !     This routine assigns fractions of the 13 landuse classes to each ECMWF *
+  !     grid point.                                                            *
+  !     The landuse inventory of                                               *
+  !                                                                            *
+  ! Belward, A.S., Estes, J.E., and Kline, K.D., 1999,                         *
+  ! The IGBP-DIS 1-Km Land-Cover Data Set DISCover:                            *
+  ! A Project Overview: Photogrammetric Engineering and Remote Sensing ,       *
+  ! v. 65, no. 9, p. 1013-1020                                                 *
+  !                                                                            *
+  !     if there are no data in the inventory                                  *
+  !     the ECMWF land/sea mask is used to distinguish                         *
+  !     between sea (-> ocean) and land (-> grasslands).                       *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     5 December 1996                                                        *
+  !     8 February 1999 Additional use of nests, A. Stohl                      *
+  !    29 December 2006 new landuse inventory, S. Eckhardt                     *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! xlanduse          fractions of numclass landuses for each model grid point *
+  ! landinvent       landuse inventory (0.3 deg resolution)                    *
+  !                                                                            *
+  !*****************************************************************************
+
+  implicit none
+
+  integer :: ix,jy,k,l,li,nrefine,iix,jjy
+  integer,parameter :: lumaxx=1200,lumaxy=600
+  integer,parameter :: xlon0lu=-180,ylat0lu=-90
+  real,parameter :: dxlu=0.3
+  real :: xlon,ylat,sumperc,p,xi,yj
+  real :: xlandusep(lumaxx,lumaxy,numclass)
+  ! character*2 ck
+
+  if (.not.DRYDEP) return
+
+  do ix=1,lumaxx
+    do jy=1,lumaxy
+       do k=1,numclass
+         xlandusep(ix,jy,k)=0.
+       end do
+       sumperc=0.
+       do li=1,3
+         sumperc=sumperc+landinvent(ix,jy,li+3)
+       end do
+       do li=1,3
+         k=landinvent(ix,jy,li)
+       if (sumperc.gt.0) then
+         p=landinvent(ix,jy,li+3)/sumperc
+       else
+         p=0
+       endif
+! p has values between 0 and 1
+         xlandusep(ix,jy,k)=p
+       end do
+    end do
+  end do
+
+  ! do 13 k=1,11
+  ! write (ck,'(i2.2)') k
+  ! open(4,file='xlandusetest'//ck,form='formatted')
+  ! do 11 ix=1,lumaxx
+  !11       write (4,*) (xlandusep(ix,jy,k),jy=1,lumaxy)
+  !11       write (4,*) (landinvent(ix,jy,k),jy=1,lumaxy)
+  !13     close(4)
+
+  ! write (*,*) xlon0,ylat0,xlon0n(1),ylat0n(1),nxmin1,nymin1
+  ! write (*,*) dx, dy, dxout, dyout, ylat0, xlon0
+  nrefine=10
+  do ix=0,nxmin1
+    do jy=0,nymin1
+      do k=1,numclass
+        sumperc=0.
+        xlanduse(ix,jy,k)=0.
+      end do
+        do iix=1, nrefine
+          xlon=(ix+(iix-1)/real(nrefine))*dx+xlon0        ! longitude, should be between -180 and 179
+          if (xlon.ge.(xlon0lu+lumaxx*dxlu))  then
+               xlon=xlon-lumaxx*dxlu
+          endif
+          do jjy=1, nrefine
+           ylat=(jy+(jjy-1)/real(nrefine))*dy+ylat0       ! and lat. of each gridpoint
+           xi=int((xlon-xlon0lu)/dxlu)+1
+           yj=int((ylat-ylat0lu)/dxlu)+1
+           if (xi.gt.lumaxx) xi=xi-lumaxx
+           if (yj.gt.lumaxy) yj=yj-lumaxy
+           if (xi.lt.0) then
+              write (*,*) 'problem with landuseinv sampling: ', &
+                   xlon,xlon0lu,ix,iix,xlon0,dx,nxmax
+              stop
+           endif
+           do k=1,numclass
+              xlanduse(ix,jy,k)= &
+                   xlanduse(ix,jy,k)+xlandusep(int(xi),int(yj),k)
+             sumperc=sumperc+xlanduse(ix,jy,k)  ! just for the check if landuseinv. is available
+           end do
+          end do
+        end do
+          if (sumperc.gt.0) then                       ! detailed landuse available
+          sumperc=0.
+          do k=1,numclass
+              xlanduse(ix,jy,k)= &
+                   xlanduse(ix,jy,k)/real(nrefine*nrefine)
+            sumperc=sumperc+xlanduse(ix,jy,k)
+          end do
+  !cc the sum of all categories should be 1 ... 100 percent ... in order to get vdep right!
+          if (sumperc.lt.1-1E-5) then
+            do k=1,numclass
+              xlanduse(ix,jy,k)= &
+                   xlanduse(ix,jy,k)/sumperc
+            end do
+          endif
+          else
+            if (lsm(ix,jy).lt.0.1) then           ! over sea  -> ocean
+              xlanduse(ix,jy,3)=1.
+            else                                  ! over land -> rangeland
+              xlanduse(ix,jy,7)=1.
+            endif
+          endif
+
+
+    end do
+  end do
+
+  !***********************************
+  ! for test: write out xlanduse
+
+  ! open(4,file='landusetest',form='formatted')
+  ! do 56 k=1,13
+  ! do 55 ix=0,nxmin1
+  !55    write (4,*) (xlanduse(ix,jy,k),jy=0,nymin1)
+  !56    continue
+  ! close(4)
+  ! write (*,*) 'landuse written'
+  !stop
+  !  open(4,file='landseatest'//ck,form='formatted')
+  ! do 57 ix=0,nxmin1
+  !57       write (4,*) (lsm(ix,jy),jy=0,nymin1)
+  !  write (*,*) 'landseamask written'
+
+  !****************************************
+  ! Same as above, but for the nested grids
+  !****************************************
+
+  !************** TEST ********************
+  ! dyn(1)=dyn(1)/40
+  ! dxn(1)=dxn(1)/40
+  ! xlon0n(1)=1
+  ! ylat0n(1)=50
+  !************** TEST ********************
+
+  do l=1,numbnests
+    do ix=0,nxn(l)-1
+      do jy=0,nyn(l)-1
+        do k=1,numclass
+          sumperc=0.
+          xlandusen(ix,jy,k,l)=0.
+        end do
+          do iix=1, nrefine
+           xlon=(ix+(iix-1)/real(nrefine))*dxn(l)+xlon0n(l)
+           do jjy=1, nrefine
+             ylat=(jy+(jjy-1)/real(nrefine))*dyn(l)+ylat0n(l)
+             xi=int((xlon-xlon0lu)/dxlu)+1
+             yj=int((ylat-ylat0lu)/dxlu)+1
+             if (xi.gt.lumaxx) xi=xi-lumaxx
+             if (yj.gt.lumaxy) yj=yj-lumaxy
+             do k=1,numclass
+                xlandusen(ix,jy,k,l)=xlandusen(ix,jy,k,l)+ &
+                     xlandusep(int(xi),int(yj),k)
+               sumperc=sumperc+xlandusen(ix,jy,k,l)
+             end do
+           end do
+          end do
+          if (sumperc.gt.0) then                     ! detailed landuse available
+          sumperc=0.
+            do k=1,numclass
+               xlandusen(ix,jy,k,l)= &
+                    xlandusen(ix,jy,k,l)/real(nrefine*nrefine)
+              sumperc=sumperc+xlandusen(ix,jy,k,l)
+            end do
+  !cc the sum of all categories should be 1 ... 100 percent ... in order to get vdep right!
+            if (sumperc.lt.1-1E-5) then
+              do k=1,numclass
+                xlandusen(ix,jy,k,l)=xlandusen(ix,jy,k,l)/sumperc
+              end do
+            endif
+          else                                    ! check land/sea mask
+            if (lsmn(ix,jy,l).lt.0.1) then   ! over sea  -> ocean
+              xlandusen(ix,jy,3,l)=1.
+            else                        ! over land -> grasslands
+              xlandusen(ix,jy,7,l)=1.
+            endif
+          endif
+      end do
+    end do
+  end do
+
+  !***********************************
+  ! for test: write out xlanduse
+
+  ! do 66 k=1,11
+  ! write (ck,'(i2.2)') k
+  ! open(4,file='nlandusetest'//ck,form='formatted')
+  ! do 65 ix=0,nxn(1)-1
+  !65       write (4,*) (xlandusen(ix,jy,k,1),jy=0,nyn(1)-1)
+  !66      close(4)
+
+  ! write (*,*) 'landuse nested written'
+end subroutine assignland
diff --git a/src/dry_dealloc_drydepo.f90 b/src/dry_dealloc_drydepo.f90
new file mode 100644
index 0000000000000000000000000000000000000000..f934fa45ebc353e317682ace92b1c0c2c6469235
--- /dev/null
+++ b/src/dry_dealloc_drydepo.f90
@@ -0,0 +1,9 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine dealloc_drydepo
+
+  if (.not. drydep) return
+  deallocate(xlanduse,xlandusen,vdep)
+
+end subroutine dealloc_drydepo
diff --git a/src/dry_drydepo_massloss.f90 b/src/dry_drydepo_massloss.f90
new file mode 100644
index 0000000000000000000000000000000000000000..5c91f42339374cb5ff57cfd015f95ee2b00eddf6
--- /dev/null
+++ b/src/dry_drydepo_massloss.f90
@@ -0,0 +1,33 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine drydepo_massloss(ipart,ks,ldeltat,drydepopart)
+  use particle_mod
+
+  implicit none
+
+  integer,intent(in) ::  &
+    ipart,               & ! particle index
+    ks,                  & ! species index
+    ldeltat                ! radioactive decay time
+  real(dep_prec),intent(out) ::  &
+    drydepopart            ! drydeposit for particle ipart
+  real decfact             ! radioactive decay factor
+
+  if (decay(ks).gt.0.) then             ! radioactive decay
+    decfact=exp(-real(abs(lsynctime))*decay(ks))
+  else
+    decfact=1.
+  endif
+  drydepopart=part(ipart)%mass(ks)*part(ipart)%prob(ks)*decfact
+
+  part(ipart)%drydepo(ks)=part(ipart)%drydepo(ks)+ &
+    part(ipart)%mass(ks)*part(ipart)%prob(ks)*decfact
+
+  part(ipart)%mass(ks)=part(ipart)%mass(ks)*(1.-part(ipart)%prob(ks))*decfact
+
+  if (decay(ks).gt.0.) then   ! correct for decay (see wetdepo)
+    drydepopart=drydepopart*exp(real(abs(ldeltat))*decay(ks))
+  endif
+
+end subroutine drydepo_massloss
diff --git a/src/dry_drydepo_probability.f90 b/src/dry_drydepo_probability.f90
new file mode 100644
index 0000000000000000000000000000000000000000..c56eb5dc0c3031faca01c4789787bf3fb0e061e0
--- /dev/null
+++ b/src/dry_drydepo_probability.f90
@@ -0,0 +1,40 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine drydepo_probability(prob,dt,zts,vdepo)
+  use par_mod
+  use com_mod
+  use interpol_mod
+
+  implicit none
+
+  real,intent(inout) :: prob(maxspec)
+  real,intent(inout) :: vdepo(maxspec)  ! deposition velocities for all species
+  real,intent(in) :: dt,zts             ! real(ldt), real(zt)
+  integer :: ns,m                      ! loop variable over species
+  real :: vdeptemp(2)
+
+  if ((DRYDEP).and.(zts.lt.2.*href)) then
+    do ns=1,nspec
+      if (DRYDEPSPEC(ns)) then
+        if (depoindicator(ns)) then
+          if (ngrid.le.0) then
+            do m=1,2
+              call hor_interpol(vdep,vdeptemp(m),ns,memind(m),maxspec)
+            end do
+          else
+            do m=1,2
+              call hor_interpol_nest(vdepn,vdeptemp(m),ns,memind(m),maxspec)
+            end do
+          endif
+          call temp_interpol(vdeptemp(1),vdeptemp(2),vdepo(ns))
+        endif
+  ! correction by Petra Seibert, 10 April 2001
+  !   this formulation means that prob(n) = 1 - f(0)*...*f(n)
+  !   where f(n) is the exponential term
+        prob(ns)=1.+(prob(ns)-1.)*exp(-vdepo(ns)*abs(dt)/(2.*href))
+        !if (pp.eq.535) write(*,*) 'advance1', ks,dtt,p1,vdep(ix,jy,ks,1)
+      endif
+    end do
+  endif
+end subroutine drydepo_probability
diff --git a/src/dry_drydepokernel.f90 b/src/dry_drydepokernel.f90
new file mode 100644
index 0000000000000000000000000000000000000000..cbcd572fd014589f62a38789c94542a4e8849d8c
--- /dev/null
+++ b/src/dry_drydepokernel.f90
@@ -0,0 +1,138 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine drydepokernel(nunc,deposit,x,y,nage,kp,thread)
+  !                          i      i    i i  i
+  !*****************************************************************************
+  !                                                                            *
+  !     Attribution of the deposition to the grid using a uniform kernel with  *
+  !     bandwidths dx and dy.                                                  *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     26 December 1996                                                       *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  ! nunc             uncertainty class of the respective particle              *
+  ! nage             age class of the respective particle                      *
+  ! deposit          amount (kg) to be deposited                               *
+  !                                                                            *
+  !*****************************************************************************
+  ! Changes:
+  ! eso 10/2016: Added option to disregard kernel
+  !
+  !*****************************************************************************
+
+  implicit none
+
+  integer,intent(in) :: thread
+  real(dep_prec), dimension(maxspec) :: deposit
+  real :: x,y,ddx,ddy,xl,yl,wx,wy,w
+  integer :: ix,jy,ixp,jyp,ks,nunc,nage,kp
+
+
+  xl=(x*dx+xoutshift)/dxout
+  yl=(y*dy+youtshift)/dyout
+  ix=int(xl)
+  jy=int(yl)
+  ddx=xl-real(ix)                   ! distance to left cell border
+  ddy=yl-real(jy)                   ! distance to lower cell border
+
+  if (ddx.gt.0.5) then
+    ixp=ix+1
+    wx=1.5-ddx
+  else
+    ixp=ix-1
+    wx=0.5+ddx
+  endif
+
+  if (ddy.gt.0.5) then
+    jyp=jy+1
+    wy=1.5-ddy
+  else
+    jyp=jy-1
+    wy=0.5+ddy
+  endif
+
+  ! If no kernel is used, direct attribution to grid cell
+  !******************************************************
+
+  if (.not.lusekerneloutput) then
+    do ks=1,nspec
+      if ((abs(deposit(ks)).gt.0).and.DRYDEPSPEC(ks)) then
+        if ((ix.ge.0).and.(jy.ge.0).and.(ix.le.numxgrid-1).and. &
+             (jy.le.numygrid-1)) then
+#ifdef _OPENMP
+          gridunc_omp(ix,jy,1,ks,kp,nunc,nage,thread)= &
+               gridunc_omp(ix,jy,1,ks,kp,nunc,nage,thread)+deposit(ks)
+#else
+          drygridunc(ix,jy,ks,kp,nunc,nage)= &
+               drygridunc(ix,jy,ks,kp,nunc,nage)+deposit(ks)
+#endif
+        end if
+      end if
+    end do
+  else ! use kernel
+
+
+  ! Determine mass fractions for four grid points
+  !**********************************************
+    do ks=1,nspec
+
+     if ((abs(deposit(ks)).gt.0).and.DRYDEPSPEC(ks)) then
+
+        if ((ix.ge.0).and.(jy.ge.0).and.(ix.le.numxgrid-1).and. &
+          (jy.le.numygrid-1)) then
+          w=wx*wy
+#ifdef _OPENMP
+          gridunc_omp(ix,jy,1,ks,kp,nunc,nage,thread)= &
+             gridunc_omp(ix,jy,1,ks,kp,nunc,nage,thread)+deposit(ks)*w
+#else
+          drygridunc(ix,jy,ks,kp,nunc,nage)= &
+             drygridunc(ix,jy,ks,kp,nunc,nage)+deposit(ks)*w
+#endif
+       endif
+
+      if ((ixp.ge.0).and.(jyp.ge.0).and.(ixp.le.numxgrid-1).and. &
+         (jyp.le.numygrid-1)) then
+        w=(1.-wx)*(1.-wy)
+#ifdef _OPENMP
+        gridunc_omp(ixp,jyp,1,ks,kp,nunc,nage,thread)= &
+             gridunc_omp(ixp,jyp,1,ks,kp,nunc,nage,thread)+deposit(ks)*w
+#else
+        drygridunc(ixp,jyp,ks,kp,nunc,nage)= &
+             drygridunc(ixp,jyp,ks,kp,nunc,nage)+deposit(ks)*w
+#endif
+      endif
+
+      if ((ixp.ge.0).and.(jy.ge.0).and.(ixp.le.numxgrid-1).and. &
+         (jy.le.numygrid-1)) then
+        w=(1.-wx)*wy
+#ifdef _OPENMP
+        gridunc_omp(ixp,jy,1,ks,kp,nunc,nage,thread)= &
+             gridunc_omp(ixp,jy,1,ks,kp,nunc,nage,thread)+deposit(ks)*w
+#else
+        drygridunc(ixp,jy,ks,kp,nunc,nage)= &
+             drygridunc(ixp,jy,ks,kp,nunc,nage)+deposit(ks)*w
+#endif
+      endif
+
+      if ((ix.ge.0).and.(jyp.ge.0).and.(ix.le.numxgrid-1).and. &
+         (jyp.le.numygrid-1)) then
+        w=wx*(1.-wy)
+#ifdef _OPENMP
+        gridunc_omp(ix,jyp,1,ks,kp,nunc,nage,thread)= &
+             gridunc_omp(ix,jyp,1,ks,kp,nunc,nage,thread)+deposit(ks)*w
+#else
+        drygridunc(ix,jyp,ks,kp,nunc,nage)= &
+             drygridunc(ix,jyp,ks,kp,nunc,nage)+deposit(ks)*w
+#endif
+      endif
+
+      endif ! deposit>0
+    end do
+  end if
+end subroutine drydepokernel
diff --git a/src/dry_drydepokernel_nest.f90 b/src/dry_drydepokernel_nest.f90
new file mode 100644
index 0000000000000000000000000000000000000000..b52e02e64b99024f0b05dab111191b530e409a40
--- /dev/null
+++ b/src/dry_drydepokernel_nest.f90
@@ -0,0 +1,118 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine drydepokernel_nest(nunc,deposit,x,y,nage,kp,thread)
+  !                               i      i    i i  i
+  !*****************************************************************************
+  !                                                                            *
+  !     Attribution of the deposition from an individual particle to the       *
+  !     nested deposition fields using a uniform kernel with bandwidths        *
+  !     dxoutn and dyoutn.                                                     *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     26 December 1996                                                       *
+  !                                                                            *
+  !      2 September 2004: Adaptation from drydepokernel.                      *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  ! nunc             uncertainty class of the respective particle              *
+  ! nage             age class of the respective particle                      *
+  ! deposit          amount (kg) to be deposited                               *
+  !                                                                            *
+  !*****************************************************************************
+
+  implicit none
+
+  integer,intent(in) :: thread
+  real(dep_prec), dimension(maxspec) :: deposit
+  real :: x,y,ddx,ddy,xl,yl,wx,wy,w
+  integer :: ix,jy,ixp,jyp,ks,kp,nunc,nage
+
+
+
+  xl=(x*dx+xoutshiftn)/dxoutn
+  yl=(y*dy+youtshiftn)/dyoutn
+  ix=int(xl)
+  jy=int(yl)
+  ddx=xl-real(ix)                   ! distance to left cell border
+  ddy=yl-real(jy)                   ! distance to lower cell border
+
+  if (ddx.gt.0.5) then
+    ixp=ix+1
+    wx=1.5-ddx
+  else
+    ixp=ix-1
+    wx=0.5+ddx
+  endif
+
+  if (ddy.gt.0.5) then
+    jyp=jy+1
+    wy=1.5-ddy
+  else
+    jyp=jy-1
+    wy=0.5+ddy
+  endif
+
+
+  ! Determine mass fractions for four grid points
+  !**********************************************
+  do ks=1,nspec
+
+    if (DRYDEPSPEC(ks).and.(abs(deposit(ks)).gt.0)) then
+
+      if ((ix.ge.0).and.(jy.ge.0).and.(ix.le.numxgridn-1).and. &
+           (jy.le.numygridn-1)) then
+        w=wx*wy
+#ifdef _OPENMP
+        griduncn_omp(ix,jy,1,ks,kp,nunc,nage,thread)= &
+             griduncn_omp(ix,jy,1,ks,kp,nunc,nage,thread)+deposit(ks)*w
+#else
+        drygriduncn(ix,jy,ks,kp,nunc,nage)= &
+             drygriduncn(ix,jy,ks,kp,nunc,nage)+deposit(ks)*w
+#endif
+      endif
+
+      if ((ixp.ge.0).and.(jyp.ge.0).and.(ixp.le.numxgridn-1).and. &
+           (jyp.le.numygridn-1)) then
+        w=(1.-wx)*(1.-wy)
+#ifdef _OPENMP
+        griduncn_omp(ixp,jyp,1,ks,kp,nunc,nage,thread)= &
+             griduncn_omp(ixp,jyp,1,ks,kp,nunc,nage,thread)+deposit(ks)*w
+#else
+        drygriduncn(ixp,jyp,ks,kp,nunc,nage)= &
+             drygriduncn(ixp,jyp,ks,kp,nunc,nage)+deposit(ks)*w
+#endif
+      endif
+
+      if ((ixp.ge.0).and.(jy.ge.0).and.(ixp.le.numxgridn-1).and. &
+           (jy.le.numygridn-1)) then
+        w=(1.-wx)*wy
+#ifdef _OPENMP
+        griduncn_omp(ixp,jy,1,ks,kp,nunc,nage,thread)= &
+             griduncn_omp(ixp,jy,1,ks,kp,nunc,nage,thread)+deposit(ks)*w
+#else
+        drygriduncn(ixp,jy,ks,kp,nunc,nage)= &
+             drygriduncn(ixp,jy,ks,kp,nunc,nage)+deposit(ks)*w
+#endif
+      endif
+
+      if ((ix.ge.0).and.(jyp.ge.0).and.(ix.le.numxgridn-1).and. &
+           (jyp.le.numygridn-1)) then
+        w=wx*(1.-wy)
+#ifdef _OPENMP
+        griduncn_omp(ix,jyp,1,ks,kp,nunc,nage,thread)= &
+             griduncn_omp(ix,jyp,1,ks,kp,nunc,nage,thread)+deposit(ks)*w
+#else
+        drygriduncn(ix,jyp,ks,kp,nunc,nage)= &
+             drygriduncn(ix,jyp,ks,kp,nunc,nage)+deposit(ks)*w
+#endif
+      endif
+
+    endif
+
+  end do
+end subroutine drydepokernel_nest
diff --git a/src/dry_get_vdep_prob.f90 b/src/dry_get_vdep_prob.f90
new file mode 100644
index 0000000000000000000000000000000000000000..8b2bf7bd2c6eb97e9c2cddfbeef5f0c0fbe6ffe1
--- /dev/null
+++ b/src/dry_get_vdep_prob.f90
@@ -0,0 +1,98 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine get_vdep_prob(itime,xt,yt,zt,prob)
+  !                    i     i  i  i  o
+  !*****************************************************************************
+  !                                                                            *
+  !  Calculation of the probability for dry deposition                         *
+  !                                                                            *
+  !  Particle positions are read in - prob returned                            *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! itime [s]          time at which this subroutine is entered                *
+  ! itimec [s]         actual time, which is incremented in this subroutine    *
+  ! href [m]           height for which dry deposition velocity is calculated  *
+  ! ldirect            1 forward, -1 backward                                  *
+  ! ldt [s]            Time step for the next integration                      *
+  ! lsynctime [s]      Synchronisation interval of FLEXPART                    *
+  ! ngrid              index which grid is to be used                          *
+  ! prob               probability of absorption due to dry deposition         *
+  ! vdepo              Deposition velocities for all species                   *
+  ! xt,yt,zt           Particle position                                       *
+  !                                                                            *
+  !*****************************************************************************
+
+  use point_mod
+  use par_mod
+  use com_mod
+  use interpol_mod
+
+  implicit none
+
+  real :: xt,yt,zt
+  integer :: itime,i,j,k,memindnext
+  integer :: ks,m!nix,njy,
+  real :: prob(maxspec),vdepo(maxspec),vdeptemp(2)
+  real :: eps
+
+  eps=nxmax/3.e5
+
+  if (DRYDEP) then    ! reset probability for deposition
+    do ks=1,nspec
+      depoindicator(ks)=.true.
+      prob(ks)=0.
+    end do
+  endif
+
+
+  ! Determine whether lat/long grid or polarstereographic projection
+  ! is to be used
+  ! Furthermore, determine which nesting level to be used
+  !*****************************************************************
+  call find_ngrid(xt,yt)
+
+  !***************************
+  ! Interpolate necessary data
+  !***************************
+
+  if (abs(itime-memtime(1)).lt.abs(itime-memtime(2))) then
+    memindnext=1
+  else
+    memindnext=2
+  endif
+
+  ! Determine nested grid coordinates
+  !**********************************
+  call find_grid_indices(xt,yt)
+
+  ! Determine probability of deposition
+  !************************************
+
+  if ((DRYDEP).and.(real(zt).lt.2.*href)) then
+    do ks=1,nspec
+      if (DRYDEPSPEC(ks)) then
+        if (depoindicator(ks)) then
+          if (ngrid.le.0) then
+            do m=1,2
+              call hor_interpol(vdep,vdeptemp(m),ks,memind(m),maxspec)
+            end do
+          else
+            do m=1,2
+              call hor_interpol_nest(vdepn,vdeptemp(m),ks,memind(m),maxspec)
+            end do
+          endif
+          call temp_interpol(vdeptemp(1),vdeptemp(2),vdepo(ks))
+        endif
+  ! correction by Petra Seibert, 10 April 2001
+  !   this formulation means that prob(n) = 1 - f(0)*...*f(n)
+  !   where f(n) is the exponential term
+        prob(ks)=vdepo(ks)
+  !               prob(ks)=vdepo(ks)/2./href
+  ! instead of prob - return vdepo -> result kg/m2/s
+      endif
+    end do
+  endif
+end subroutine get_vdep_prob
diff --git a/src/dry_getrb.f90 b/src/dry_getrb.f90
new file mode 100644
index 0000000000000000000000000000000000000000..2fbbd6f3961481497dec14e857a723d213358cea
--- /dev/null
+++ b/src/dry_getrb.f90
@@ -0,0 +1,40 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine getrb(nc,ustar,nyl,diffh2o,reldiff,rb)
+  !                 i    i    i     i       i    o
+  !*****************************************************************************
+  !                                                                            *
+  !  Calculation of the quasilaminar sublayer resistance to dry deposition.    *
+  !                                                                            *
+  !      AUTHOR: Andreas Stohl, 20 May 1995                                    *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! rb(ncmax)       sublayer resistance                                        *
+  ! schmidt         Schmidt number                                             *
+  ! ustar [m/s]     friction velocity                                          *
+  ! diffh20 [m2/s]  diffusivity of water vapor in air                          *
+  ! reldiff         diffusivity relative to H2O                                *
+  !                                                                            *
+  ! Constants:                                                                 *
+  ! karman          von Karman constant                                        *
+  ! pr              Prandtl number                                             *
+  !                                                                            *
+  !*****************************************************************************
+
+  implicit none
+
+  real :: ustar,diffh2o,rb(maxspec),schmidt,nyl
+  real :: reldiff(maxspec)
+  integer :: ic,nc
+  real,parameter :: pr=0.72
+
+  do ic=1,nc
+    if (reldiff(ic).gt.0.) then
+      schmidt=nyl/diffh2o*reldiff(ic)
+      rb(ic)=2.0*(schmidt/pr)**0.67/(karman*ustar)
+    endif
+  end do
+end subroutine getrb
diff --git a/src/dry_getrc.f90 b/src/dry_getrc.f90
new file mode 100644
index 0000000000000000000000000000000000000000..2a4d42413b0926ad9cb5a0a755f843e668d387c5
--- /dev/null
+++ b/src/dry_getrc.f90
@@ -0,0 +1,100 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine getrc(nc,i,j,t,gr,rh,rr,rc)
+  !                 i  i i i i  i  i  o
+  !*****************************************************************************
+  !                                                                            *
+  !  Calculation of the surface resistance according to the procedure given    *
+  !  in:                                                                       *
+  !  Wesely (1989): Parameterization of surface resistances to gaseous         *
+  !  dry deposition in regional-scale numerical models.                        *
+  !  Atmos. Environ. 23, 1293-1304.                                            *
+  !                                                                            *
+  !                                                                            *
+  !      AUTHOR: Andreas Stohl, 19 May 1995                                    *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  ! reldiff(maxspec)  diffusivity of H2O/diffusivity of component i            *
+  ! gr [W/m2]       global radiation                                           *
+  ! i               index of seasonal category                                 *
+  ! j               index of landuse class                                     *
+  ! ldep(maxspec)          1, if deposition shall be calculated for species i  *
+  ! nc                   actual number of chemical components                  *
+  ! rcl(maxspec,5,8) [s/m] Lower canopy resistance                             *
+  ! rgs(maxspec,5,8) [s/m] Ground resistance                                   *
+  ! rlu(maxspec,5,8) [s/m] Leaf cuticular resistance                           *
+  ! rm(maxspec) [s/m]      Mesophyll resistance                                *
+  ! t [C]           temperature                                                *
+  !                                                                            *
+  !*****************************************************************************
+
+  implicit none
+
+  integer :: i,j,ic,nc
+  real :: gr,rh,rr,t,rs,rsm,corr,rluc,rclc,rgsc,rdc,rluo
+  real :: rc(maxspec)
+
+
+  ! Compute stomatal resistance
+  !****************************
+  ! Sabine Eckhardt, Dec 06: use 1E25 instead of 99999. for infinite res.
+
+  if ((t.gt.0.).and.(t.lt.40.)) then
+    rs=ri(i,j)*(1.+(200./(gr+0.1))**2)*(400./(t*(40.-t)))
+  else
+    rs=1.E25
+  !  rs=99999.
+  endif
+
+
+  ! Correct stomatal resistance for effect of dew and rain
+  !*******************************************************
+
+  if ((rh.gt.0.9).or.(rr.gt.0.)) rs=rs*3.
+
+  ! Compute the lower canopy resistance
+  !************************************
+
+  rdc=100.*(1.+1000./(gr+10.))
+
+
+  corr=1000.*exp(-1.*t-4.)
+  do ic=1,nc
+    if (reldiff(ic).gt.0.) then
+
+  ! Compute combined stomatal and mesophyll resistance
+  !***************************************************
+
+      rsm=rs*reldiff(ic)+rm(ic)
+
+  ! Correct leaf cuticular, lower canopy and ground resistance
+  !***********************************************************
+
+      rluc=rlu(ic,i,j)+corr
+      rclc=rcl(ic,i,j)+corr
+      rgsc=rgs(ic,i,j)+corr
+
+  ! Correct leaf cuticular resistance for effect of dew and rain
+  !*************************************************************
+
+      if (rr.gt.0.) then
+        rluo=1./(1./1000.+1./(3.*rluc))
+        rluc=1./(1./(3.*rluc)+1.e-7*henry(ic)+f0(ic)/rluo)
+      else if (rh.gt.0.9) then
+        rluo=1./(1./3000.+1./(3.*rluc))
+        rluc=1./(1./(3.*rluc)+1.e-7*henry(ic)+f0(ic)/rluo)
+      endif
+
+  ! Combine resistances to give total resistance
+  !*********************************************
+
+      rc(ic)=1./(1./rsm+1./rluc+1./(rdc+rclc)+1./(rac(i,j)+rgsc))
+  ! Sabine Eckhardt, Dec 06: avoid possible excessively high vdep
+      if (rc(ic).lt.10.) rc(ic)=10.
+    endif
+  end do
+end subroutine getrc
diff --git a/src/dry_getvdep.f90 b/src/dry_getvdep.f90
new file mode 100644
index 0000000000000000000000000000000000000000..3b1a764f186b191a779d0d3a451dc2e22b30f488
--- /dev/null
+++ b/src/dry_getvdep.f90
@@ -0,0 +1,185 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine getvdep(n,ix,jy,ust,temp,pa,L,gr,rh,rr,snow,vdepo)
+  !                   i i  i   i   i   i  i i  i  i    i o
+  !*****************************************************************************
+  !                                                                            *
+  !  This routine calculates the dry deposition velocities.                    *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     20 December 1996                                                       *
+  !     Sabine Eckhardt, Jan 07                                                *
+  !     if the latitude is negative: add half a year to the julian day         *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! gr [W/m2]         global radiation                                         *
+  ! L [m]             Obukhov length                                           *
+  ! nyl               kinematic viscosity                                      *
+  ! pa [Pa]           surface air pressure                                     *
+  ! ra [s/m]          aerodynamic resistance                                   *
+  ! raquer [s/m]      average aerodynamic resistance                           *
+  ! rh [0-1]          relative humidity                                        *
+  ! rhoa              density of the air                                       *
+  ! rr [mm/h]         precipitation rate                                       *
+  ! temp [K]          2m temperature                                           *
+  ! tc [C]            2m temperature                                           *
+  ! ust [m/s]         friction velocity                                        *
+  ! snow [m of water equivalent] snow depth                                    *
+  ! xlanduse          fractions of numclasS landuses for each model grid point *
+  !                                                                            *
+  !*****************************************************************************
+  use date_mod
+
+  implicit none
+
+  integer :: yyyymmdd,hhmmss,yyyy,mmdd,n,lseason,i,j,ix,jy
+  real :: vdepo(maxspec),vd,rb(maxspec),rc(maxspec),raquer,ylat
+  real :: ra,ust,temp,tc,pa,L,gr,rh,rr,myl,nyl,rhoa,diffh2o,snow
+  real :: slanduse(numclass)
+  real,parameter :: eps=1.e-5
+  real(kind=dp) :: jul
+
+  ! Calculate month and determine the seasonal category
+  !****************************************************
+
+  jul=bdate+real(wftime(n),kind=dp)/86400._dp
+
+  ylat=jy*dy+ylat0
+  if (ylat.lt.0) then
+      jul=jul+365/2
+  endif
+
+
+  call caldate(jul,yyyymmdd,hhmmss)
+  yyyy=yyyymmdd/10000
+  mmdd=yyyymmdd-10000*yyyy
+
+  if ((ylat.gt.-20).and.(ylat.lt.20)) then
+     mmdd=600 ! summer
+  endif
+
+  if ((mmdd.ge.1201).or.(mmdd.le.301)) then
+    lseason=4
+  else if ((mmdd.ge.1101).or.(mmdd.le.331)) then
+    lseason=3
+  else if ((mmdd.ge.401).and.(mmdd.le.515)) then
+    lseason=5
+  else if ((mmdd.ge.516).and.(mmdd.le.915)) then
+    lseason=1
+  else
+    lseason=2
+  endif
+
+  ! Calculate diffusivity of water vapor
+  !************************************
+  diffh2o=2.11e-5*(temp/273.15)**1.94*(101325/pa)
+
+  ! Conversion of temperature from K to C
+  !**************************************
+
+  tc=temp-273.15
+
+  ! Calculate dynamic viscosity
+  !****************************
+
+  ! Why is this different from the viscosity funtion???
+
+  if (tc.lt.0) then
+    myl=(1.718+0.0049*tc-1.2e-05*tc**2)*1.e-05
+  else
+    myl=(1.718+0.0049*tc)*1.e-05
+  endif
+
+  ! Calculate kinematic viscosity
+  !******************************
+
+  rhoa=pa/(287.*temp)
+  nyl=myl/rhoa
+
+
+  ! 0. Set all deposition velocities zero
+  !**************************************
+
+  do i=1,nspec
+    vdepo(i)=0.
+  end do
+
+
+  ! 1. Compute surface layer resistances rb
+  !****************************************
+
+  call getrb(nspec,ust,nyl,diffh2o,reldiff,rb)
+
+  ! change for snow
+  do j=1,numclass
+    if (snow.gt.0.001) then ! 10 mm
+       if (j.eq.12) then
+         slanduse(j)=1.
+       else
+         slanduse(j)=0.
+       endif
+    else
+       slanduse(j)=xlanduse(ix,jy,j)
+    endif
+  end do
+
+  raquer=0.
+  do j=1,numclass            ! loop over all landuse classes
+
+    if (slanduse(j).gt.eps)  then
+
+  ! 2. Calculate aerodynamic resistance ra
+  !***************************************
+
+      ra=raerod(L,ust,z0(j))
+      raquer=raquer+ra*slanduse(j)
+
+  ! 3. Calculate surface resistance for gases
+  !******************************************
+
+      call getrc(nspec,lseason,j,tc,gr,rh,rr,rc)
+
+  ! 4. Calculate deposition velocities for gases and ...
+  ! 5. ... sum deposition velocities for all landuse classes
+  !*********************************************************
+
+      do i=1,nspec
+        if (reldiff(i).gt.0.) then
+          if ((ra+rb(i)+rc(i)).gt.0.) then
+            vd=1./(ra+rb(i)+rc(i))
+          else
+            vd=9.999
+          endif
+          vdepo(i)=vdepo(i)+vd*slanduse(j)
+        endif
+      end do
+    endif
+  end do
+
+
+  ! 6. Calculate deposition velocities for particles
+  !*************************************************
+
+  call partdep(nspec,density,fract,schmi,vset,raquer,ust,nyl, &
+    rhoa,vdepo)
+
+  !if (debug_mode) then
+  !  print*,'getvdep:188: vdepo=', vdepo
+    !stop
+  !endif
+
+  ! 7. If no detailed parameterization available, take constant deposition
+  !    velocity if that is available
+  !***********************************************************************
+
+  do i=1,nspec
+    if ((reldiff(i).lt.0.).and.(density(i).lt.0.).and. &
+         (dryvel(i).gt.0.)) then
+      vdepo(i)=dryvel(i)
+    endif
+  end do
+end subroutine getvdep
diff --git a/src/dry_getvdep_nest.f90 b/src/dry_getvdep_nest.f90
new file mode 100644
index 0000000000000000000000000000000000000000..484a0a6e45930e5aa63b6af693daad37c69a11f8
--- /dev/null
+++ b/src/dry_getvdep_nest.f90
@@ -0,0 +1,182 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine getvdep_nest(n,ix,jy,ust,temp,pa, &
+       L,gr,rh,rr,snow,vdepo,lnest)
+  !                   i i  i   i   i   i  i i  i  i    i o i
+  !*****************************************************************************
+  !                                                                            *
+  !  This routine calculates the dry deposition velocities.                    *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     20 December 1996                                                       *
+  !     Sabine Eckhardt, Jan 07                                                *
+  !     if the latitude is negative: add half a year to the julian day         *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! gr [W/m2]         global radiation                                         *
+  ! L [m]             Obukhov length                                           *
+  ! nyl               kinematic viscosity                                      *
+  ! pa [Pa]           surface air pressure                                     *
+  ! ra [s/m]          aerodynamic resistance                                   *
+  ! raquer [s/m]      average aerodynamic resistance                           *
+  ! rh [0-1]          relative humidity                                        *
+  ! rhoa              density of the air                                       *
+  ! rr [mm/h]         precipitation rate                                       *
+  ! temp [K]          2m temperature                                           *
+  ! tc [C]            2m temperature                                           *
+  ! ust [m/s]         friction velocity                                        *
+  ! snow [m of water equivalent] snow depth                                    *
+  ! xlanduse          fractions of numclasS landuses for each model grid point *
+  !                                                                            *
+  !*****************************************************************************
+  use date_mod
+
+  implicit none
+
+  integer :: yyyymmdd,hhmmss,yyyy,mmdd,n,lseason,i,j,ix,jy,lnest
+  real :: vdepo(maxspec),vd,rb(maxspec),rc(maxspec),raquer,ylat
+  real :: ra,ust,temp,tc,pa,L,gr,rh,rr,myl,nyl,rhoa,diffh2o,snow
+  real :: slanduse(numclass)
+  real,parameter :: eps=1.e-5
+  real(kind=dp) :: jul
+
+  ! Calculate month and determine the seasonal category
+  !****************************************************
+
+  jul=bdate+real(wftime(n),kind=dp)/86400._dp
+
+  ylat=jy*dy+ylat0
+  if (ylat.lt.0) then
+      jul=jul+365/2
+  endif
+
+
+  call caldate(jul,yyyymmdd,hhmmss)
+  yyyy=yyyymmdd/10000
+  mmdd=yyyymmdd-10000*yyyy
+
+  if ((ylat.gt.-20).and.(ylat.lt.20)) then
+     mmdd=600 ! summer
+  endif
+
+  if ((mmdd.ge.1201).or.(mmdd.le.301)) then
+    lseason=4
+  else if ((mmdd.ge.1101).or.(mmdd.le.331)) then
+    lseason=3
+  else if ((mmdd.ge.401).and.(mmdd.le.515)) then
+    lseason=5
+  else if ((mmdd.ge.516).and.(mmdd.le.915)) then
+    lseason=1
+  else
+    lseason=2
+  endif
+
+  ! Calculate diffusivity of water vapor
+  !************************************
+  diffh2o=2.11e-5*(temp/273.15)**1.94*(101325/pa)
+
+  ! Conversion of temperature from K to C
+  !**************************************
+
+  tc=temp-273.15
+
+  ! Calculate dynamic viscosity
+  !****************************
+
+  if (tc.lt.0) then
+    myl=(1.718+0.0049*tc-1.2e-05*tc**2)*1.e-05
+  else
+    myl=(1.718+0.0049*tc)*1.e-05
+  endif
+
+  ! Calculate kinematic viscosity
+  !******************************
+
+  rhoa=pa/(287.*temp)
+  nyl=myl/rhoa
+
+
+  ! 0. Set all deposition velocities zero
+  !**************************************
+
+  do i=1,nspec
+    vdepo(i)=0.
+  end do
+
+
+  ! 1. Compute surface layer resistances rb
+  !****************************************
+
+  call getrb(nspec,ust,nyl,diffh2o,reldiff,rb)
+
+  ! change for snow
+  do j=1,numclass
+    if (snow.gt.0.001) then ! 10 mm
+       if (j.eq.12) then
+         slanduse(j)=1.
+       else
+         slanduse(j)=0.
+       endif
+    else
+       slanduse(j)=xlandusen(ix,jy,j,lnest)
+    endif
+  end do
+
+  raquer=0.
+  do j=1,numclass            ! loop over all landuse classes
+
+    if (slanduse(j).gt.eps)  then
+
+  ! 2. Calculate aerodynamic resistance ra
+  !***************************************
+
+      ra=raerod(L,ust,z0(j))
+      raquer=raquer+ra*slanduse(j)
+
+  ! 3. Calculate surface resistance for gases
+  !******************************************
+
+      call getrc(nspec,lseason,j,tc,gr,rh,rr,rc)
+
+  ! 4. Calculate deposition velocities for gases and ...
+  ! 5. ... sum deposition velocities for all landuse classes
+  !*********************************************************
+
+      do i=1,nspec
+        if (reldiff(i).gt.0.) then
+          if ((ra+rb(i)+rc(i)).gt.0.) then
+            vd=1./(ra+rb(i)+rc(i))
+  ! XXXXXXXXXXXXXXXXXXXXXXXXXX TEST
+  !         vd=1./rc(i)
+  ! XXXXXXXXXXXXXXXXXXXXXXXXXX TEST
+          else
+            vd=9.999
+          endif
+          vdepo(i)=vdepo(i)+vd*slanduse(j)
+        endif
+      end do
+    endif
+  end do
+
+
+  ! 6. Calculate deposition velocities for particles
+  !*************************************************
+
+  call partdep(nspec,density,fract,schmi,vset,raquer,ust,nyl, &
+    rhoa,vdepo)
+
+  ! 7. If no detailed parameterization available, take constant deposition
+  !    velocity if that is available
+  !***********************************************************************
+
+  do i=1,nspec
+    if ((reldiff(i).lt.0.).and.(density(i).lt.0.).and. &
+         (dryvel(i).gt.0.)) then
+      vdepo(i)=dryvel(i)
+    endif
+  end do
+end subroutine getvdep_nest
diff --git a/src/dry_part0.f90 b/src/dry_part0.f90
new file mode 100644
index 0000000000000000000000000000000000000000..d1be653e64be14a144b37259885ae369ad783b02
--- /dev/null
+++ b/src/dry_part0.f90
@@ -0,0 +1,125 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine part0(dquer,dsigma,density,ni,fract,schmi,cun,vsh)
+  !                  i      i       i   i   o     o    o   o
+  !*****************************************************************************
+  !                                                                            *
+  !      Calculation of time independent factors of the dry deposition of      *
+  !      particles:                                                            *
+  !      Log-Normal-distribution of mass [dM/dlog(dp)], unimodal               *
+  !                                                                            *
+  !      AUTHOR: Matthias Langer, adapted by Andreas Stohl, 13 November 1993   *
+  !                                                                            *
+  !      Literature:                                                           *
+  !      [1]  Scire/Yamartino/Carmichael/Chang (1989),                         *
+  !             CALGRID: A Mesoscale Photochemical Grid Model.                 *
+  !             Vol II: User's Guide. (Report No.A049-1, June, 1989)           *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! alpha            help variable                                             *
+  ! cun              'slip-flow' correction after Cunningham                   *
+  ! d01 [um]         upper diameter                                            *
+  ! d02 [um]         lower diameter                                            *
+  ! dc [m2/s]        coefficient of Brownian diffusion                         *
+  ! delta            distance given in standard deviation units                *
+  ! density [kg/m3]  density of the particle                                   *
+  ! dmean            geometric mean diameter of interval                       *
+  ! dquer [um]       geometric mass mean particle diameter                     *
+  ! dsigma           e.g. dsigma=10 or dsigma=0.1 means that 68% of the mass   *
+  !                  are between 0.1*dquer and 10*dquer                        *
+  ! fract(ni)        mass fraction of each diameter interval                   *
+  ! kn               Knudsen number                                            *
+  ! ni               number of diameter intervals, for which deposition        *
+  !                  is calculated                                             *
+  ! schmidt          Schmidt number                                            *
+  ! schmi            schmidt**2/3                                              *
+  ! vsh [m/s]        gravitational settling velocity of the particle           *
+  ! x01              normalized upper diameter                                 *
+  ! x02              normalized lower diameter                                 *
+  !                                                                            *
+  ! Constants:                                                                 *
+  ! g [m/s2]         Acceleration of gravity                                   *
+  ! kb [J/K]         Stefan-Boltzmann constant                                 *
+  ! lam [m]          mean free path of air molecules                           *
+  ! myl [kg/m/s]     dynamical viscosity of air                                *
+  ! nyl [m2/s]       kinematic viscosity of air                                *
+  ! tr               reference temperature                                     *
+  !                                                                            *
+  ! Function:                                                                  *
+  ! erf              calculates the integral of the Gauss function             *
+  !                                                                            *
+  !*****************************************************************************
+
+  implicit none
+
+  real,parameter :: tr=293.15
+
+  integer :: i,ni
+  real :: dquer,dsigma,density,xdummy,d01,d02,delta,x01,x02
+  real :: dmean,alpha,cun,dc,schmidt,kn,erf,fract_norm
+  real,dimension(ni),intent(inout) :: fract,schmi,vsh
+  real,parameter :: myl=1.81e-5,nyl=0.15e-4
+  real,parameter :: lam=6.53e-8,kb=1.38e-23,eps=1.2e-38
+
+  ! xdummy constant for all intervals
+  !**********************************
+
+  xdummy=sqrt(2.)*alog(dsigma)
+
+
+  ! particles diameters are split up to ni intervals between
+  ! dquer-3*dsigma and dquer+3*dsigma
+  !*********************************************************
+  ! Normalisation. Why was it not normalised?
+  !******************************************
+  x01=alog(dsigma**3)/xdummy
+  x02=alog(dsigma**(-3))/xdummy
+  fract_norm=0.5*(erf(x01)-erf(x02))
+
+  delta=6./real(ni)
+
+  d01=dquer*dsigma**(-3)
+  do i=1,ni
+    d02=d01
+    d01=dquer*dsigma**(-3.+delta*real(i))
+    x01=alog(d01/dquer)/xdummy
+    x02=alog(d02/dquer)/xdummy
+    !print*,'part0:: d02=' , d02 , 'd01=', d01
+
+  ! Area under Gauss-function is calculated and gives mass fraction of interval
+  !****************************************************************************
+
+    fract(i)=0.5*(erf(x01)-erf(x02))/fract_norm
+    !print*,'part0:: fract(',i,')', fract(i)
+    !print*,'part0:: fract', fract(i), x01, x02, erf(x01), erf(x02)
+
+  ! Geometric mean diameter of interval in [m]
+  !*******************************************
+
+    dmean=1.E-6*exp(0.5*alog(d01*d02))
+    !print*,'part0:: dmean=', dmean
+
+  ! Calculation of time independent parameters of each interval
+  !************************************************************
+
+    kn=2.*lam/dmean
+    if ((-1.1/kn).le.log10(eps)*log(10.)) then
+      alpha=1.257
+    else
+      alpha=1.257+0.4*exp(-1.1/kn)
+    endif
+    cun=1.+alpha*kn
+    dc=kb*tr*cun/(3.*pi*myl*dmean)
+    schmidt=nyl/dc
+    schmi(i)=schmidt**(-2./3.)
+    vsh(i)=ga*density*dmean*dmean*cun/(18.*myl)
+
+    !print*,'part0:: vsh(',i,')', vsh(i)
+
+  end do
+
+  !stop 'part0'
+end subroutine part0
diff --git a/src/dry_partdep.f90 b/src/dry_partdep.f90
new file mode 100644
index 0000000000000000000000000000000000000000..f68d8a0405b113935a68c26fce890c3e100b29a3
--- /dev/null
+++ b/src/dry_partdep.f90
@@ -0,0 +1,183 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine partdep(nc,density,fract,schmi,vset,ra,ustar,nyl,rhoa,vdep)
+  !                   i     i      i     i    i   i    i    i  i, i, i/o
+  !*****************************************************************************
+  !                                                                            *
+  !      Calculation of the dry deposition velocities of particles.            *
+  !      This routine is based on Stokes' law for considering settling and     *
+  !      assumes constant dynamic viscosity of the air.                        *
+  !                                                                            *
+  !     AUTHOR: Andreas Stohl, 12 November 1993                                *
+  !                            Update: 20 December 1996                        *
+  !                                                                            *
+  !     Literature:                                                            *
+  !     [1]  Hicks/Baldocchi/Meyers/Hosker/Matt (1987), A Preliminary          *
+  !             Multiple Resistance Routine for Deriving Dry Deposition        *
+  !             Velocities from Measured Quantities.                           *
+  !             Water, Air and Soil Pollution 36 (1987), pp.311-330.           *
+  !     [2]  Slinn (1982), Predictions for Particle Deposition to              *
+  !             Vegetative Canopies. Atm.Env.16-7 (1982), pp.1785-1794.        *
+  !     [3]  Slinn/Slinn (1980),  Predictions for Particle Deposition on       *
+  !             Natural Waters. Atm.Env.14 (1980), pp.1013-1016.               *
+  !     [4]  Scire/Yamartino/Carmichael/Chang (1989),                          *
+  !             CALGRID: A Mesoscale Photochemical Grid Model.                 *
+  !             Vol II: User's Guide. (Report No.A049-1, June, 1989)           *
+  !     [5]  Langer M. (1992): Ein einfaches Modell zur Abschaetzung der       *
+  !             Depositionsgeschwindigkeit von Teilchen und Gasen.             *
+  !             Internal report.                                               *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! alpha                help variable                                         *
+  ! fract(nc,ni)         mass fraction of each diameter interval               *
+  ! lpdep(nc)            1 for particle deposition, 0 else                     *
+  ! nc                   actual number of chemical components                  *
+  ! ni                   number of diameter intervals, for which vdepj is calc.*
+  ! rdp [s/m]            deposition layer resistance                           *
+  ! ra [s/m]             aerodynamical resistance                              *
+  ! schmi(nc,ni)         Schmidt number**2/3 of each diameter interval         *
+  ! stokes               Stokes number                                         *
+  ! ustar [m/s]          friction velocity                                     *
+  ! vdep(nc) [m/s]       deposition velocities of all components               *
+  ! vdepj [m/s]          help, deposition velocity of 1 interval               *
+  ! vset(nc,ni)          gravitational settling velocity of each interval      *
+  !                                                                            *
+  ! Constants:                                                                 *
+  ! nc                   number of chemical species                            *
+  ! ni                   number of diameter intervals, for which deposition    *
+  !                      is calculated                                         *
+  !                                                                            *
+  !*****************************************************************************
+
+  implicit none
+
+  real, intent(in) ::       &
+    nyl,                    & ! kinematic viscosity
+    rhoa,                   & ! air density
+    ustar,                  & ! friction velocity
+    ra,                     & ! aerodynamical resistance
+    vset(maxspec,maxndia),  & ! gravitational settling velocity of each interval
+    density(maxspec),       & ! density of the particle
+    fract(maxspec,maxndia)    ! mass fraction of each diameter interval
+  real, intent(inout) ::    &
+    vdep(maxspec)
+  real :: schmi(maxspec,maxndia)
+  real :: stokes,vdepj,rdp,alpha
+  real :: & ! Variables related to shape
+    dfdr, alpha1, alpha2, beta1, beta2, ks, kn, c_d, &
+    settling, settling_old, reynolds, ks1, ks2, kn1, kn2
+
+  real,parameter :: eps=1.e-5
+  integer :: ic,j,nc,i
+
+
+  do ic=1,nc                  ! loop over all species
+    if (density(ic).gt.0.) then
+      do j=1,ndia(ic)         ! loop over all diameter intervals
+        if (ustar.gt.eps) then
+          if (shape(ic).eq.0) then
+
+            ! Stokes number for each diameter interval
+            !*****************************************
+            ! Use this stokes number for different shapes
+            stokes=vset(ic,j)/ga*ustar*ustar/nyl
+            alpha=-3./stokes
+
+            ! Deposition layer resistance
+            !****************************
+
+            if (alpha.le.log10(eps)) then
+              rdp=1./(schmi(ic,j)*ustar)
+            else
+              rdp=1./((schmi(ic,j)+10.**alpha)*ustar)
+            endif
+
+            vdepj=vset(ic,j)+1./(ra+rdp+ra*rdp*vset(ic,j))
+
+          else ! Daria Tatsii: Drag coefficient scheme by Bagheri & Bonadonna 2016
+               ! Settling velocities of other shapes
+            dfdr=density(ic)/rhoa
+
+            reynolds=dquer(ic)/1.e6*vset(ic,j)/nyl
+            settling_old=-1.0*vset(ic,j)
+
+            ! Orientation of particles
+            !*************************
+            if (orient(ic).eq.0) then
+              ! Horizontal orientation
+              alpha2=0.77 ! B&B: eq. 32
+              beta2=0.63
+              ks=0.5*((Fs(ic)**0.05)+(Fs(ic)**(-0.36)))  ! B&B Figure 12 k_(s,max)
+              kn=10.**(alpha2*(-log10(Fn(ic)))**beta2)
+            else if (orient(ic).eq.1) then
+              ! Random orientation
+              alpha1=0.45+10.0/(exp(2.5*log10(dfdr))+30.0)
+              beta1=1.-37.0/(exp(3.0*log10(dfdr))+100.0)
+              ks=(Fs(ic)**(1./3.) + Fs(ic)**(-1./3))/2.
+              kn=10.**(alpha1*(-log10(Fn(ic)))**beta1)
+            else
+              ! The average of random and horizontal orientation
+              alpha1=0.45+10.0/(exp(2.5*log10(dfdr))+30.0)
+              beta1=1.-37.0/(exp(3.0*log10(dfdr))+100.0)
+              alpha2=0.77 ! B&B: eq. 32
+              beta2=0.63
+              ks1=(Fs(ic)**(1./3.) + Fs(ic)**(-1./3))/2.
+              kn1=10.**(alpha1*(-log10(Fn(ic)))**beta1)
+              ks2=0.5*((Fs(ic)**0.05)+(Fs(ic)**(-0.36)))  ! B&B Figure 12 k_(s,max)
+              kn2=10.**(alpha2*(-log10(Fn(ic)))**beta2)
+              ks=(ks1+ks2)/2.
+              kn=(kn1+kn2)/2.
+            endif
+
+            do i=1,20
+              c_d=(24.*ks/reynolds)*(1.+0.125*((reynolds*kn/ks)**(2./3.)))+ &
+                (0.46*kn/(1.+5330./(reynolds*kn/ks)))
+
+              ! Settling velocity of a particle is defined by the Newton's impact law:
+              settling=-1.* &
+                      sqrt(4.*ga*dquer(ic)/1.e6*density(ic)*cunningham(ic)/ &
+                      (3.*c_d*rhoa))
+
+              if (abs((settling-settling_old)/settling).lt.0.01) exit
+
+              reynolds=dquer(ic)/1.e6*abs(settling)/nyl
+              settling_old=settling
+            end do
+            ! We assume aerodynamic resistance ra and quasi-laminar sub-layer resistance rdp
+            ! Stokes number for each diameter interval
+            !*****************************************
+            ! Use this stokes number for different shapes
+            stokes=abs(settling)/ga*ustar*ustar/nyl
+            alpha=-3./stokes
+
+            ! Deposition layer resistance
+            !****************************
+
+            if (alpha.le.log10(eps)) then
+              rdp=1./(schmi(ic,j)*ustar)
+            else
+              rdp=1./((schmi(ic,j)+10.**alpha)*ustar)
+            endif
+
+
+            vdepj=abs(settling)+1./(ra+rdp+ra*rdp*abs(settling))
+
+          endif
+
+        else
+          vdepj=vset(ic,j)
+        endif
+
+        ! deposition velocities of each interval are weighted with mass fraction
+        !***********************************************************************
+
+        vdep(ic)=vdep(ic)+vdepj*fract(ic,j)
+
+      end do
+    endif
+  end do
+
+end subroutine partdep
diff --git a/src/dry_raerod.f90 b/src/dry_raerod.f90
new file mode 100644
index 0000000000000000000000000000000000000000..407abe2684cac0bc8e08111425bb5c05acd087db
--- /dev/null
+++ b/src/dry_raerod.f90
@@ -0,0 +1,44 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+real function raerod (l,ust,z0)
+  !*****************************************************************************
+  !                                                                            *
+  !     Calculation of the aerodynamical resistance ra from ground up to href  *
+  !                                                                            *
+  !     AUTHOR: Matthias Langer, modified by Andreas Stohl (6 August 1993)     *
+  !                                                                            *
+  !     Literature:                                                            *
+  !     [1]  Hicks/Baldocchi/Meyers/Hosker/Matt (1987), A Preliminary          *
+  !             Multiple Resistance Routine for Deriving Dry Deposition        *
+  !             Velocities from Measured Quantities.                           *
+  !             Water, Air and Soil Pollution 36 (1987), pp.311-330.           *
+  !     [2]  Scire/Yamartino/Carmichael/Chang (1989),                          *
+  !             CALGRID: A Mesoscale Photochemical Grid Model.                 *
+  !             Vol II: User's Guide. (Report No.A049-1, June, 1989)           *
+  !                                                                            *
+  !     Variable list:                                                         *
+  !     L     = Monin-Obukhov-length [m]                                       *
+  !     ust   = friction velocity [m/sec]                                      *
+  !     z0    = surface roughness length [m]                                   *
+  !     href  = reference height [m], for which deposition velocity is         *
+  !             calculated                                                     *
+  !                                                                            *
+  !     Constants:                                                             *
+  !     karman    = von Karman-constant (~0.4)                                 *
+  !     ramin = minimum resistence of ra (1 s/m)                               *
+  !                                                                            *
+  !     Subprograms and functions:                                             *
+  !     function psih (z/L)                                                    *
+  !                                                                            *
+  !*****************************************************************************
+
+  use turbulence_mod, only: psih
+
+  implicit none
+
+  real :: l,ust,z0
+
+  raerod=(alog(href/z0)-psih(href,l)+psih(z0,l))/(karman*ust)
+
+end function raerod
diff --git a/src/drydepo_mod.f90 b/src/drydepo_mod.f90
index 231348cfce9f134540664f32f20255692d56b19e..f473a70901a1dc40fef8f9ec03891268874f5146 100644
--- a/src/drydepo_mod.f90
+++ b/src/drydepo_mod.f90
@@ -14,10 +14,10 @@ module drydepo_mod
   use unc_mod
   use windfields_mod
   use erf_mod
-  
+
   implicit none
 
-  real,allocatable,dimension(:,:,:) :: xlanduse 
+  real,allocatable,dimension(:,:,:) :: xlanduse
    ! area fractions in percent [0-1]
   real,allocatable,dimension(:,:,:,:) :: xlandusen
    ! nested area fractions in percent [0-1]
@@ -25,1501 +25,34 @@ module drydepo_mod
 
 contains
 
-subroutine alloc_drydepo
-
-  implicit none
-
-  if (.not. drydep) return
-  write(*,*) 'allocate drydepo fields'
-  allocate(xlanduse(0:nxmax-1,0:nymax-1,numclass),      &
-           xlandusen(0:nxmaxn-1,0:nymaxn-1,numclass,maxnests), &
-           vdep(0:nxmax-1,0:nymax-1,maxspec,numwfmem))
-           
-end subroutine alloc_drydepo
-
-subroutine dealloc_drydepo
-
-  if (.not. drydep) return
-  deallocate(xlanduse,xlandusen,vdep)
-
-end subroutine dealloc_drydepo
-
-subroutine assignland
-
-  !*****************************************************************************
-  !                                                                            *
-  !     This routine assigns fractions of the 13 landuse classes to each ECMWF *
-  !     grid point.                                                            *
-  !     The landuse inventory of                                               *
-  !                                                                            *
-  ! Belward, A.S., Estes, J.E., and Kline, K.D., 1999,                         *
-  ! The IGBP-DIS 1-Km Land-Cover Data Set DISCover:                            *
-  ! A Project Overview: Photogrammetric Engineering and Remote Sensing ,       *
-  ! v. 65, no. 9, p. 1013-1020                                                 *
-  !                                                                            *
-  !     if there are no data in the inventory                                  *
-  !     the ECMWF land/sea mask is used to distinguish                         *
-  !     between sea (-> ocean) and land (-> grasslands).                       *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     5 December 1996                                                        *
-  !     8 February 1999 Additional use of nests, A. Stohl                      *
-  !    29 December 2006 new landuse inventory, S. Eckhardt                     *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! xlanduse          fractions of numclass landuses for each model grid point *
-  ! landinvent       landuse inventory (0.3 deg resolution)                    *
-  !                                                                            *
-  !*****************************************************************************
-
-  implicit none
-
-  integer :: ix,jy,k,l,li,nrefine,iix,jjy
-  integer,parameter :: lumaxx=1200,lumaxy=600
-  integer,parameter :: xlon0lu=-180,ylat0lu=-90
-  real,parameter :: dxlu=0.3
-  real :: xlon,ylat,sumperc,p,xi,yj
-  real :: xlandusep(lumaxx,lumaxy,numclass)
-  ! character*2 ck
-
-  if (.not.DRYDEP) return
-  
-  do ix=1,lumaxx
-    do jy=1,lumaxy
-       do k=1,numclass
-         xlandusep(ix,jy,k)=0.
-       end do
-       sumperc=0.
-       do li=1,3
-         sumperc=sumperc+landinvent(ix,jy,li+3)
-       end do
-       do li=1,3
-         k=landinvent(ix,jy,li)
-       if (sumperc.gt.0) then
-         p=landinvent(ix,jy,li+3)/sumperc
-       else
-         p=0
-       endif
-! p has values between 0 and 1
-         xlandusep(ix,jy,k)=p
-       end do
-    end do
-  end do
-
-  ! do 13 k=1,11
-  ! write (ck,'(i2.2)') k
-  ! open(4,file='xlandusetest'//ck,form='formatted')
-  ! do 11 ix=1,lumaxx
-  !11       write (4,*) (xlandusep(ix,jy,k),jy=1,lumaxy)
-  !11       write (4,*) (landinvent(ix,jy,k),jy=1,lumaxy)
-  !13     close(4)
-
-  ! write (*,*) xlon0,ylat0,xlon0n(1),ylat0n(1),nxmin1,nymin1
-  ! write (*,*) dx, dy, dxout, dyout, ylat0, xlon0
-  nrefine=10
-  do ix=0,nxmin1
-    do jy=0,nymin1
-      do k=1,numclass
-        sumperc=0.
-        xlanduse(ix,jy,k)=0.
-      end do
-        do iix=1, nrefine
-          xlon=(ix+(iix-1)/real(nrefine))*dx+xlon0        ! longitude, should be between -180 and 179
-          if (xlon.ge.(xlon0lu+lumaxx*dxlu))  then
-               xlon=xlon-lumaxx*dxlu
-          endif
-          do jjy=1, nrefine
-           ylat=(jy+(jjy-1)/real(nrefine))*dy+ylat0       ! and lat. of each gridpoint
-           xi=int((xlon-xlon0lu)/dxlu)+1
-           yj=int((ylat-ylat0lu)/dxlu)+1
-           if (xi.gt.lumaxx) xi=xi-lumaxx
-           if (yj.gt.lumaxy) yj=yj-lumaxy
-           if (xi.lt.0) then
-              write (*,*) 'problem with landuseinv sampling: ', &
-                   xlon,xlon0lu,ix,iix,xlon0,dx,nxmax
-              stop
-           endif
-           do k=1,numclass
-              xlanduse(ix,jy,k)= &
-                   xlanduse(ix,jy,k)+xlandusep(int(xi),int(yj),k)
-             sumperc=sumperc+xlanduse(ix,jy,k)  ! just for the check if landuseinv. is available
-           end do
-          end do
-        end do
-          if (sumperc.gt.0) then                       ! detailed landuse available
-          sumperc=0.
-          do k=1,numclass
-              xlanduse(ix,jy,k)= &
-                   xlanduse(ix,jy,k)/real(nrefine*nrefine)
-            sumperc=sumperc+xlanduse(ix,jy,k)
-          end do
-  !cc the sum of all categories should be 1 ... 100 percent ... in order to get vdep right!
-          if (sumperc.lt.1-1E-5) then
-            do k=1,numclass
-              xlanduse(ix,jy,k)= &
-                   xlanduse(ix,jy,k)/sumperc
-            end do
-          endif
-          else
-            if (lsm(ix,jy).lt.0.1) then           ! over sea  -> ocean
-              xlanduse(ix,jy,3)=1.
-            else                                  ! over land -> rangeland
-              xlanduse(ix,jy,7)=1.
-            endif
-          endif
-
-
-    end do
-  end do
-
-  !***********************************
-  ! for test: write out xlanduse
-
-  ! open(4,file='landusetest',form='formatted')
-  ! do 56 k=1,13
-  ! do 55 ix=0,nxmin1
-  !55    write (4,*) (xlanduse(ix,jy,k),jy=0,nymin1)
-  !56    continue
-  ! close(4)
-  ! write (*,*) 'landuse written'
-  !stop
-  !  open(4,file='landseatest'//ck,form='formatted')
-  ! do 57 ix=0,nxmin1
-  !57       write (4,*) (lsm(ix,jy),jy=0,nymin1)
-  !  write (*,*) 'landseamask written'
-
-  !****************************************
-  ! Same as above, but for the nested grids
-  !****************************************
-
-  !************** TEST ********************
-  ! dyn(1)=dyn(1)/40
-  ! dxn(1)=dxn(1)/40
-  ! xlon0n(1)=1
-  ! ylat0n(1)=50
-  !************** TEST ********************
-
-  do l=1,numbnests
-    do ix=0,nxn(l)-1
-      do jy=0,nyn(l)-1
-        do k=1,numclass
-          sumperc=0.
-          xlandusen(ix,jy,k,l)=0.
-        end do
-          do iix=1, nrefine
-           xlon=(ix+(iix-1)/real(nrefine))*dxn(l)+xlon0n(l)
-           do jjy=1, nrefine
-             ylat=(jy+(jjy-1)/real(nrefine))*dyn(l)+ylat0n(l)
-             xi=int((xlon-xlon0lu)/dxlu)+1
-             yj=int((ylat-ylat0lu)/dxlu)+1
-             if (xi.gt.lumaxx) xi=xi-lumaxx
-             if (yj.gt.lumaxy) yj=yj-lumaxy
-             do k=1,numclass
-                xlandusen(ix,jy,k,l)=xlandusen(ix,jy,k,l)+ &
-                     xlandusep(int(xi),int(yj),k)
-               sumperc=sumperc+xlandusen(ix,jy,k,l)
-             end do
-           end do
-          end do
-          if (sumperc.gt.0) then                     ! detailed landuse available
-          sumperc=0.
-            do k=1,numclass
-               xlandusen(ix,jy,k,l)= &
-                    xlandusen(ix,jy,k,l)/real(nrefine*nrefine)
-              sumperc=sumperc+xlandusen(ix,jy,k,l)
-            end do
-  !cc the sum of all categories should be 1 ... 100 percent ... in order to get vdep right!
-            if (sumperc.lt.1-1E-5) then
-              do k=1,numclass
-                xlandusen(ix,jy,k,l)=xlandusen(ix,jy,k,l)/sumperc
-              end do
-            endif
-          else                                    ! check land/sea mask
-            if (lsmn(ix,jy,l).lt.0.1) then   ! over sea  -> ocean
-              xlandusen(ix,jy,3,l)=1.
-            else                        ! over land -> grasslands
-              xlandusen(ix,jy,7,l)=1.
-            endif
-          endif
-      end do
-    end do
-  end do
-
-  !***********************************
-  ! for test: write out xlanduse
-
-  ! do 66 k=1,11
-  ! write (ck,'(i2.2)') k
-  ! open(4,file='nlandusetest'//ck,form='formatted')
-  ! do 65 ix=0,nxn(1)-1
-  !65       write (4,*) (xlandusen(ix,jy,k,1),jy=0,nyn(1)-1)
-  !66      close(4)
-
-  ! write (*,*) 'landuse nested written'
-end subroutine assignland
-
-real function raerod (l,ust,z0)
-  !*****************************************************************************
-  !                                                                            *
-  !     Calculation of the aerodynamical resistance ra from ground up to href  *
-  !                                                                            *
-  !     AUTHOR: Matthias Langer, modified by Andreas Stohl (6 August 1993)     *
-  !                                                                            *
-  !     Literature:                                                            *
-  !     [1]  Hicks/Baldocchi/Meyers/Hosker/Matt (1987), A Preliminary          *
-  !             Multiple Resistance Routine for Deriving Dry Deposition        *
-  !             Velocities from Measured Quantities.                           *
-  !             Water, Air and Soil Pollution 36 (1987), pp.311-330.           *
-  !     [2]  Scire/Yamartino/Carmichael/Chang (1989),                          *
-  !             CALGRID: A Mesoscale Photochemical Grid Model.                 *
-  !             Vol II: User's Guide. (Report No.A049-1, June, 1989)           *
-  !                                                                            *
-  !     Variable list:                                                         *
-  !     L     = Monin-Obukhov-length [m]                                       *
-  !     ust   = friction velocity [m/sec]                                      *
-  !     z0    = surface roughness length [m]                                   *
-  !     href  = reference height [m], for which deposition velocity is         *
-  !             calculated                                                     *
-  !                                                                            *
-  !     Constants:                                                             *
-  !     karman    = von Karman-constant (~0.4)                                 *
-  !     ramin = minimum resistence of ra (1 s/m)                               *
-  !                                                                            *
-  !     Subprograms and functions:                                             *
-  !     function psih (z/L)                                                    *
-  !                                                                            *
-  !*****************************************************************************
-
-  use turbulence_mod, only: psih
-
-  implicit none
-
-  real :: l,ust,z0
-
-  raerod=(alog(href/z0)-psih(href,l)+psih(z0,l))/(karman*ust)
-
-end function raerod
-
-subroutine drydepo_massloss(ipart,ks,ldeltat,drydepopart)
-  use particle_mod
-
-  implicit none
-
-  integer,intent(in) ::  &
-    ipart,               & ! particle index
-    ks,                  & ! species index
-    ldeltat                ! radioactive decay time
-  real(dep_prec),intent(out) ::  &
-    drydepopart            ! drydeposit for particle ipart
-  real decfact             ! radioactive decay factor
-
-  if (decay(ks).gt.0.) then             ! radioactive decay
-    decfact=exp(-real(abs(lsynctime))*decay(ks))
-  else
-    decfact=1.
-  endif
-  drydepopart=part(ipart)%mass(ks)*part(ipart)%prob(ks)*decfact
-  
-  part(ipart)%drydepo(ks)=part(ipart)%drydepo(ks)+ &
-    part(ipart)%mass(ks)*part(ipart)%prob(ks)*decfact
-
-  part(ipart)%mass(ks)=part(ipart)%mass(ks)*(1.-part(ipart)%prob(ks))*decfact
-
-  if (decay(ks).gt.0.) then   ! correct for decay (see wetdepo)
-    drydepopart=drydepopart*exp(real(abs(ldeltat))*decay(ks))
-  endif
-
-end subroutine drydepo_massloss
-
-subroutine drydepokernel(nunc,deposit,x,y,nage,kp,thread)
-  !                          i      i    i i  i
-  !*****************************************************************************
-  !                                                                            *
-  !     Attribution of the deposition to the grid using a uniform kernel with  *
-  !     bandwidths dx and dy.                                                  *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     26 December 1996                                                       *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  !                                                                            *
-  ! nunc             uncertainty class of the respective particle              *
-  ! nage             age class of the respective particle                      *
-  ! deposit          amount (kg) to be deposited                               *
-  !                                                                            *
-  !*****************************************************************************
-  ! Changes:
-  ! eso 10/2016: Added option to disregard kernel 
-  ! 
-  !*****************************************************************************
-
-  implicit none
-
-  integer,intent(in) :: thread
-  real(dep_prec), dimension(maxspec) :: deposit
-  real :: x,y,ddx,ddy,xl,yl,wx,wy,w
-  integer :: ix,jy,ixp,jyp,ks,nunc,nage,kp
-
-
-  xl=(x*dx+xoutshift)/dxout
-  yl=(y*dy+youtshift)/dyout
-  ix=int(xl)
-  jy=int(yl)
-  ddx=xl-real(ix)                   ! distance to left cell border
-  ddy=yl-real(jy)                   ! distance to lower cell border
-
-  if (ddx.gt.0.5) then
-    ixp=ix+1
-    wx=1.5-ddx
-  else
-    ixp=ix-1
-    wx=0.5+ddx
-  endif
-
-  if (ddy.gt.0.5) then
-    jyp=jy+1
-    wy=1.5-ddy
-  else
-    jyp=jy-1
-    wy=0.5+ddy
-  endif
-
-  ! If no kernel is used, direct attribution to grid cell
-  !******************************************************
-
-  if (.not.lusekerneloutput) then
-    do ks=1,nspec
-      if ((abs(deposit(ks)).gt.0).and.DRYDEPSPEC(ks)) then
-        if ((ix.ge.0).and.(jy.ge.0).and.(ix.le.numxgrid-1).and. &
-             (jy.le.numygrid-1)) then
-#ifdef _OPENMP
-          gridunc_omp(ix,jy,1,ks,kp,nunc,nage,thread)= &
-               gridunc_omp(ix,jy,1,ks,kp,nunc,nage,thread)+deposit(ks)
-#else
-          drygridunc(ix,jy,ks,kp,nunc,nage)= &
-               drygridunc(ix,jy,ks,kp,nunc,nage)+deposit(ks)
-#endif
-        end if
-      end if
-    end do
-  else ! use kernel 
-
-
-  ! Determine mass fractions for four grid points
-  !**********************************************
-    do ks=1,nspec
-
-     if ((abs(deposit(ks)).gt.0).and.DRYDEPSPEC(ks)) then
-
-        if ((ix.ge.0).and.(jy.ge.0).and.(ix.le.numxgrid-1).and. &
-          (jy.le.numygrid-1)) then
-          w=wx*wy
-#ifdef _OPENMP
-          gridunc_omp(ix,jy,1,ks,kp,nunc,nage,thread)= &
-             gridunc_omp(ix,jy,1,ks,kp,nunc,nage,thread)+deposit(ks)*w
-#else
-          drygridunc(ix,jy,ks,kp,nunc,nage)= &
-             drygridunc(ix,jy,ks,kp,nunc,nage)+deposit(ks)*w
-#endif
-       endif
-
-      if ((ixp.ge.0).and.(jyp.ge.0).and.(ixp.le.numxgrid-1).and. &
-         (jyp.le.numygrid-1)) then
-        w=(1.-wx)*(1.-wy)
-#ifdef _OPENMP
-        gridunc_omp(ixp,jyp,1,ks,kp,nunc,nage,thread)= &
-             gridunc_omp(ixp,jyp,1,ks,kp,nunc,nage,thread)+deposit(ks)*w
-#else
-        drygridunc(ixp,jyp,ks,kp,nunc,nage)= &
-             drygridunc(ixp,jyp,ks,kp,nunc,nage)+deposit(ks)*w
-#endif
-      endif
-
-      if ((ixp.ge.0).and.(jy.ge.0).and.(ixp.le.numxgrid-1).and. &
-         (jy.le.numygrid-1)) then
-        w=(1.-wx)*wy
-#ifdef _OPENMP
-        gridunc_omp(ixp,jy,1,ks,kp,nunc,nage,thread)= &
-             gridunc_omp(ixp,jy,1,ks,kp,nunc,nage,thread)+deposit(ks)*w
-#else
-        drygridunc(ixp,jy,ks,kp,nunc,nage)= &
-             drygridunc(ixp,jy,ks,kp,nunc,nage)+deposit(ks)*w
-#endif
-      endif
-
-      if ((ix.ge.0).and.(jyp.ge.0).and.(ix.le.numxgrid-1).and. &
-         (jyp.le.numygrid-1)) then
-        w=wx*(1.-wy)
-#ifdef _OPENMP
-        gridunc_omp(ix,jyp,1,ks,kp,nunc,nage,thread)= &
-             gridunc_omp(ix,jyp,1,ks,kp,nunc,nage,thread)+deposit(ks)*w
-#else
-        drygridunc(ix,jyp,ks,kp,nunc,nage)= &
-             drygridunc(ix,jyp,ks,kp,nunc,nage)+deposit(ks)*w
-#endif
-      endif
-
-      endif ! deposit>0
-    end do
-  end if
-end subroutine drydepokernel
-
-subroutine drydepokernel_nest(nunc,deposit,x,y,nage,kp,thread)
-  !                               i      i    i i  i
-  !*****************************************************************************
-  !                                                                            *
-  !     Attribution of the deposition from an individual particle to the       *
-  !     nested deposition fields using a uniform kernel with bandwidths        *
-  !     dxoutn and dyoutn.                                                     *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     26 December 1996                                                       *
-  !                                                                            *
-  !      2 September 2004: Adaptation from drydepokernel.                      *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  !                                                                            *
-  ! nunc             uncertainty class of the respective particle              *
-  ! nage             age class of the respective particle                      *
-  ! deposit          amount (kg) to be deposited                               *
-  !                                                                            *
-  !*****************************************************************************
-
-  implicit none
-
-  integer,intent(in) :: thread
-  real(dep_prec), dimension(maxspec) :: deposit
-  real :: x,y,ddx,ddy,xl,yl,wx,wy,w
-  integer :: ix,jy,ixp,jyp,ks,kp,nunc,nage
-
-
-
-  xl=(x*dx+xoutshiftn)/dxoutn
-  yl=(y*dy+youtshiftn)/dyoutn
-  ix=int(xl)
-  jy=int(yl)
-  ddx=xl-real(ix)                   ! distance to left cell border
-  ddy=yl-real(jy)                   ! distance to lower cell border
-
-  if (ddx.gt.0.5) then
-    ixp=ix+1
-    wx=1.5-ddx
-  else
-    ixp=ix-1
-    wx=0.5+ddx
-  endif
-
-  if (ddy.gt.0.5) then
-    jyp=jy+1
-    wy=1.5-ddy
-  else
-    jyp=jy-1
-    wy=0.5+ddy
-  endif
-
-
-  ! Determine mass fractions for four grid points
-  !**********************************************
-  do ks=1,nspec
-
-    if (DRYDEPSPEC(ks).and.(abs(deposit(ks)).gt.0)) then
-
-      if ((ix.ge.0).and.(jy.ge.0).and.(ix.le.numxgridn-1).and. &
-           (jy.le.numygridn-1)) then
-        w=wx*wy
-#ifdef _OPENMP
-        griduncn_omp(ix,jy,1,ks,kp,nunc,nage,thread)= &
-             griduncn_omp(ix,jy,1,ks,kp,nunc,nage,thread)+deposit(ks)*w
-#else
-        drygriduncn(ix,jy,ks,kp,nunc,nage)= &
-             drygriduncn(ix,jy,ks,kp,nunc,nage)+deposit(ks)*w
-#endif
-      endif
-
-      if ((ixp.ge.0).and.(jyp.ge.0).and.(ixp.le.numxgridn-1).and. &
-           (jyp.le.numygridn-1)) then
-        w=(1.-wx)*(1.-wy)
-#ifdef _OPENMP
-        griduncn_omp(ixp,jyp,1,ks,kp,nunc,nage,thread)= &
-             griduncn_omp(ixp,jyp,1,ks,kp,nunc,nage,thread)+deposit(ks)*w
-#else
-        drygriduncn(ixp,jyp,ks,kp,nunc,nage)= &
-             drygriduncn(ixp,jyp,ks,kp,nunc,nage)+deposit(ks)*w
-#endif
-      endif
-
-      if ((ixp.ge.0).and.(jy.ge.0).and.(ixp.le.numxgridn-1).and. &
-           (jy.le.numygridn-1)) then
-        w=(1.-wx)*wy
-#ifdef _OPENMP
-        griduncn_omp(ixp,jy,1,ks,kp,nunc,nage,thread)= &
-             griduncn_omp(ixp,jy,1,ks,kp,nunc,nage,thread)+deposit(ks)*w
-#else
-        drygriduncn(ixp,jy,ks,kp,nunc,nage)= &
-             drygriduncn(ixp,jy,ks,kp,nunc,nage)+deposit(ks)*w
-#endif
-      endif
-
-      if ((ix.ge.0).and.(jyp.ge.0).and.(ix.le.numxgridn-1).and. &
-           (jyp.le.numygridn-1)) then
-        w=wx*(1.-wy)
-#ifdef _OPENMP
-        griduncn_omp(ix,jyp,1,ks,kp,nunc,nage,thread)= &
-             griduncn_omp(ix,jyp,1,ks,kp,nunc,nage,thread)+deposit(ks)*w
-#else
-        drygriduncn(ix,jyp,ks,kp,nunc,nage)= &
-             drygriduncn(ix,jyp,ks,kp,nunc,nage)+deposit(ks)*w
-#endif
-      endif
-
-    endif
-
-  end do
-end subroutine drydepokernel_nest
-
-subroutine part0(dquer,dsigma,density,ni,fract,schmi,cun,vsh)
-  !                  i      i       i   i   o     o    o   o
-  !*****************************************************************************
-  !                                                                            *
-  !      Calculation of time independent factors of the dry deposition of      *
-  !      particles:                                                            *
-  !      Log-Normal-distribution of mass [dM/dlog(dp)], unimodal               *
-  !                                                                            *
-  !      AUTHOR: Matthias Langer, adapted by Andreas Stohl, 13 November 1993   *
-  !                                                                            *
-  !      Literature:                                                           *
-  !      [1]  Scire/Yamartino/Carmichael/Chang (1989),                         *
-  !             CALGRID: A Mesoscale Photochemical Grid Model.                 *
-  !             Vol II: User's Guide. (Report No.A049-1, June, 1989)           *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! alpha            help variable                                             *
-  ! cun              'slip-flow' correction after Cunningham                   *
-  ! d01 [um]         upper diameter                                            *
-  ! d02 [um]         lower diameter                                            *
-  ! dc [m2/s]        coefficient of Brownian diffusion                         *
-  ! delta            distance given in standard deviation units                *
-  ! density [kg/m3]  density of the particle                                   *
-  ! dmean            geometric mean diameter of interval                       *
-  ! dquer [um]       geometric mass mean particle diameter                     *
-  ! dsigma           e.g. dsigma=10 or dsigma=0.1 means that 68% of the mass   *
-  !                  are between 0.1*dquer and 10*dquer                        *
-  ! fract(ni)        mass fraction of each diameter interval                   *
-  ! kn               Knudsen number                                            *
-  ! ni               number of diameter intervals, for which deposition        *
-  !                  is calculated                                             *
-  ! schmidt          Schmidt number                                            *
-  ! schmi            schmidt**2/3                                              *
-  ! vsh [m/s]        gravitational settling velocity of the particle           *
-  ! x01              normalized upper diameter                                 *
-  ! x02              normalized lower diameter                                 *
-  !                                                                            *
-  ! Constants:                                                                 *
-  ! g [m/s2]         Acceleration of gravity                                   *
-  ! kb [J/K]         Stefan-Boltzmann constant                                 *
-  ! lam [m]          mean free path of air molecules                           *
-  ! myl [kg/m/s]     dynamical viscosity of air                                *
-  ! nyl [m2/s]       kinematic viscosity of air                                *
-  ! tr               reference temperature                                     *
-  !                                                                            *
-  ! Function:                                                                  *
-  ! erf              calculates the integral of the Gauss function             *
-  !                                                                            *
-  !*****************************************************************************
-
-  implicit none
-
-  real,parameter :: tr=293.15
-
-  integer :: i,ni
-  real :: dquer,dsigma,density,xdummy,d01,d02,delta,x01,x02
-  real :: dmean,alpha,cun,dc,schmidt,kn,erf,fract_norm
-  real,dimension(ni),intent(inout) :: fract,schmi,vsh
-  real,parameter :: myl=1.81e-5,nyl=0.15e-4
-  real,parameter :: lam=6.53e-8,kb=1.38e-23,eps=1.2e-38
-
-  ! xdummy constant for all intervals
-  !**********************************
-
-  xdummy=sqrt(2.)*alog(dsigma)
-
-
-  ! particles diameters are split up to ni intervals between
-  ! dquer-3*dsigma and dquer+3*dsigma
-  !*********************************************************
-  ! Normalisation. Why was it not normalised?
-  !******************************************
-  x01=alog(dsigma**3)/xdummy
-  x02=alog(dsigma**(-3))/xdummy
-  fract_norm=0.5*(erf(x01)-erf(x02))
-
-  delta=6./real(ni)
-
-  d01=dquer*dsigma**(-3)
-  do i=1,ni
-    d02=d01
-    d01=dquer*dsigma**(-3.+delta*real(i))
-    x01=alog(d01/dquer)/xdummy
-    x02=alog(d02/dquer)/xdummy
-    !print*,'part0:: d02=' , d02 , 'd01=', d01
-
-  ! Area under Gauss-function is calculated and gives mass fraction of interval
-  !****************************************************************************
-
-    fract(i)=0.5*(erf(x01)-erf(x02))/fract_norm
-    !print*,'part0:: fract(',i,')', fract(i)
-    !print*,'part0:: fract', fract(i), x01, x02, erf(x01), erf(x02)
-
-  ! Geometric mean diameter of interval in [m]
-  !*******************************************
-
-    dmean=1.E-6*exp(0.5*alog(d01*d02))
-    !print*,'part0:: dmean=', dmean
-
-  ! Calculation of time independent parameters of each interval
-  !************************************************************
-
-    kn=2.*lam/dmean
-    if ((-1.1/kn).le.log10(eps)*log(10.)) then
-      alpha=1.257
-    else
-      alpha=1.257+0.4*exp(-1.1/kn)
-    endif
-    cun=1.+alpha*kn
-    dc=kb*tr*cun/(3.*pi*myl*dmean)
-    schmidt=nyl/dc
-    schmi(i)=schmidt**(-2./3.)
-    vsh(i)=ga*density*dmean*dmean*cun/(18.*myl)
-
-    !print*,'part0:: vsh(',i,')', vsh(i)
-
-  end do
-
-  !stop 'part0' 
-end subroutine part0
-
-subroutine get_vdep_prob(itime,xt,yt,zt,prob)
-  !                    i     i  i  i  o
-  !*****************************************************************************
-  !                                                                            *
-  !  Calculation of the probability for dry deposition                         * 
-  !                                                                            *
-  !  Particle positions are read in - prob returned                            *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! itime [s]          time at which this subroutine is entered                *
-  ! itimec [s]         actual time, which is incremented in this subroutine    *
-  ! href [m]           height for which dry deposition velocity is calculated  *
-  ! ldirect            1 forward, -1 backward                                  *
-  ! ldt [s]            Time step for the next integration                      *
-  ! lsynctime [s]      Synchronisation interval of FLEXPART                    *
-  ! ngrid              index which grid is to be used                          *
-  ! prob               probability of absorption due to dry deposition         *
-  ! vdepo              Deposition velocities for all species                   *
-  ! xt,yt,zt           Particle position                                       *
-  !                                                                            *
-  !*****************************************************************************
-
-  use point_mod
-  use par_mod
-  use com_mod
-  use interpol_mod
-
-  implicit none
-
-  real :: xt,yt,zt
-  integer :: itime,i,j,k,memindnext
-  integer :: ks,m!nix,njy,
-  real :: prob(maxspec),vdepo(maxspec),vdeptemp(2)
-  real :: eps
-
-  eps=nxmax/3.e5
-
-  if (DRYDEP) then    ! reset probability for deposition
-    do ks=1,nspec
-      depoindicator(ks)=.true.
-      prob(ks)=0.
-    end do
-  endif
-
-
-  ! Determine whether lat/long grid or polarstereographic projection
-  ! is to be used
-  ! Furthermore, determine which nesting level to be used
-  !*****************************************************************
-  call find_ngrid(xt,yt)
-
-  !***************************
-  ! Interpolate necessary data
-  !***************************
-
-  if (abs(itime-memtime(1)).lt.abs(itime-memtime(2))) then
-    memindnext=1
-  else
-    memindnext=2
-  endif
-
-  ! Determine nested grid coordinates
-  !**********************************
-  call find_grid_indices(xt,yt)
-
-  ! Determine probability of deposition
-  !************************************
-
-  if ((DRYDEP).and.(real(zt).lt.2.*href)) then
-    do ks=1,nspec
-      if (DRYDEPSPEC(ks)) then
-        if (depoindicator(ks)) then
-          if (ngrid.le.0) then
-            do m=1,2
-              call hor_interpol(vdep,vdeptemp(m),ks,memind(m),maxspec)
-            end do
-          else
-            do m=1,2
-              call hor_interpol_nest(vdepn,vdeptemp(m),ks,memind(m),maxspec)
-            end do
-          endif
-          call temp_interpol(vdeptemp(1),vdeptemp(2),vdepo(ks))
-        endif
-  ! correction by Petra Seibert, 10 April 2001
-  !   this formulation means that prob(n) = 1 - f(0)*...*f(n)
-  !   where f(n) is the exponential term
-        prob(ks)=vdepo(ks)
-  !               prob(ks)=vdepo(ks)/2./href
-  ! instead of prob - return vdepo -> result kg/m2/s
-      endif
-    end do
-  endif
-end subroutine get_vdep_prob
-
-subroutine drydepo_probability(prob,dt,zts,vdepo)
-  use par_mod
-  use com_mod
-  use interpol_mod
-
-  implicit none
-
-  real,intent(inout) :: prob(maxspec)
-  real,intent(inout) :: vdepo(maxspec)  ! deposition velocities for all species
-  real,intent(in) :: dt,zts             ! real(ldt), real(zt)
-  integer :: ns,m                      ! loop variable over species
-  real :: vdeptemp(2)
-
-  if ((DRYDEP).and.(zts.lt.2.*href)) then
-    do ns=1,nspec
-      if (DRYDEPSPEC(ns)) then
-        if (depoindicator(ns)) then
-          if (ngrid.le.0) then
-            do m=1,2
-              call hor_interpol(vdep,vdeptemp(m),ns,memind(m),maxspec)
-            end do
-          else
-            do m=1,2
-              call hor_interpol_nest(vdepn,vdeptemp(m),ns,memind(m),maxspec)
-            end do
-          endif
-          call temp_interpol(vdeptemp(1),vdeptemp(2),vdepo(ns))
-        endif
-  ! correction by Petra Seibert, 10 April 2001
-  !   this formulation means that prob(n) = 1 - f(0)*...*f(n)
-  !   where f(n) is the exponential term
-        prob(ns)=1.+(prob(ns)-1.)*exp(-vdepo(ns)*abs(dt)/(2.*href))
-        !if (pp.eq.535) write(*,*) 'advance1', ks,dtt,p1,vdep(ix,jy,ks,1)
-      endif
-    end do
-  endif
-end subroutine drydepo_probability
-
-subroutine getvdep(n,ix,jy,ust,temp,pa,L,gr,rh,rr,snow,vdepo)
-  !                   i i  i   i   i   i  i i  i  i    i o
-  !*****************************************************************************
-  !                                                                            *
-  !  This routine calculates the dry deposition velocities.                    *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     20 December 1996                                                       *
-  !     Sabine Eckhardt, Jan 07                                                *
-  !     if the latitude is negative: add half a year to the julian day         *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! gr [W/m2]         global radiation                                         *
-  ! L [m]             Obukhov length                                           *
-  ! nyl               kinematic viscosity                                      *
-  ! pa [Pa]           surface air pressure                                     *
-  ! ra [s/m]          aerodynamic resistance                                   *
-  ! raquer [s/m]      average aerodynamic resistance                           *
-  ! rh [0-1]          relative humidity                                        *
-  ! rhoa              density of the air                                       *
-  ! rr [mm/h]         precipitation rate                                       *
-  ! temp [K]          2m temperature                                           *
-  ! tc [C]            2m temperature                                           *
-  ! ust [m/s]         friction velocity                                        *
-  ! snow [m of water equivalent] snow depth                                    *
-  ! xlanduse          fractions of numclasS landuses for each model grid point *
-  !                                                                            *
-  !*****************************************************************************
-  use date_mod
-  
-  implicit none
-
-  integer :: yyyymmdd,hhmmss,yyyy,mmdd,n,lseason,i,j,ix,jy
-  real :: vdepo(maxspec),vd,rb(maxspec),rc(maxspec),raquer,ylat
-  real :: ra,ust,temp,tc,pa,L,gr,rh,rr,myl,nyl,rhoa,diffh2o,snow
-  real :: slanduse(numclass)
-  real,parameter :: eps=1.e-5
-  real(kind=dp) :: jul
-
-  ! Calculate month and determine the seasonal category
-  !****************************************************
-
-  jul=bdate+real(wftime(n),kind=dp)/86400._dp
-
-  ylat=jy*dy+ylat0
-  if (ylat.lt.0) then
-      jul=jul+365/2
-  endif
-
-
-  call caldate(jul,yyyymmdd,hhmmss)
-  yyyy=yyyymmdd/10000
-  mmdd=yyyymmdd-10000*yyyy
-
-  if ((ylat.gt.-20).and.(ylat.lt.20)) then
-     mmdd=600 ! summer
-  endif
-
-  if ((mmdd.ge.1201).or.(mmdd.le.301)) then
-    lseason=4
-  else if ((mmdd.ge.1101).or.(mmdd.le.331)) then
-    lseason=3
-  else if ((mmdd.ge.401).and.(mmdd.le.515)) then
-    lseason=5
-  else if ((mmdd.ge.516).and.(mmdd.le.915)) then
-    lseason=1
-  else
-    lseason=2
-  endif
-
-  ! Calculate diffusivity of water vapor
-  !************************************
-  diffh2o=2.11e-5*(temp/273.15)**1.94*(101325/pa)
-
-  ! Conversion of temperature from K to C
-  !**************************************
-
-  tc=temp-273.15
-
-  ! Calculate dynamic viscosity
-  !****************************
-
-  ! Why is this different from the viscosity funtion???
-
-  if (tc.lt.0) then
-    myl=(1.718+0.0049*tc-1.2e-05*tc**2)*1.e-05
-  else
-    myl=(1.718+0.0049*tc)*1.e-05
-  endif
-
-  ! Calculate kinematic viscosity
-  !******************************
-
-  rhoa=pa/(287.*temp)
-  nyl=myl/rhoa
-
-
-  ! 0. Set all deposition velocities zero
-  !**************************************
-
-  do i=1,nspec
-    vdepo(i)=0.
-  end do
-
-
-  ! 1. Compute surface layer resistances rb
-  !****************************************
-
-  call getrb(nspec,ust,nyl,diffh2o,reldiff,rb)
-
-  ! change for snow
-  do j=1,numclass
-    if (snow.gt.0.001) then ! 10 mm
-       if (j.eq.12) then
-         slanduse(j)=1.
-       else
-         slanduse(j)=0.
-       endif
-    else
-       slanduse(j)=xlanduse(ix,jy,j)
-    endif
-  end do
-
-  raquer=0.
-  do j=1,numclass            ! loop over all landuse classes
-
-    if (slanduse(j).gt.eps)  then
-
-  ! 2. Calculate aerodynamic resistance ra
-  !***************************************
-
-      ra=raerod(L,ust,z0(j))
-      raquer=raquer+ra*slanduse(j)
-
-  ! 3. Calculate surface resistance for gases
-  !******************************************
-
-      call getrc(nspec,lseason,j,tc,gr,rh,rr,rc)
-
-  ! 4. Calculate deposition velocities for gases and ...
-  ! 5. ... sum deposition velocities for all landuse classes
-  !*********************************************************
-
-      do i=1,nspec
-        if (reldiff(i).gt.0.) then
-          if ((ra+rb(i)+rc(i)).gt.0.) then
-            vd=1./(ra+rb(i)+rc(i))
-          else
-            vd=9.999
-          endif
-          vdepo(i)=vdepo(i)+vd*slanduse(j)
-        endif
-      end do
-    endif
-  end do
-
-
-  ! 6. Calculate deposition velocities for particles
-  !*************************************************
-
-  call partdep(nspec,density,fract,schmi,vset,raquer,ust,nyl, &
-    rhoa,vdepo)
-
-  !if (debug_mode) then
-  !  print*,'getvdep:188: vdepo=', vdepo
-    !stop
-  !endif
-
-  ! 7. If no detailed parameterization available, take constant deposition
-  !    velocity if that is available
-  !***********************************************************************
-
-  do i=1,nspec
-    if ((reldiff(i).lt.0.).and.(density(i).lt.0.).and. &
-         (dryvel(i).gt.0.)) then
-      vdepo(i)=dryvel(i)
-    endif
-  end do
-end subroutine getvdep
-
-subroutine getvdep_nest(n,ix,jy,ust,temp,pa, &
-       L,gr,rh,rr,snow,vdepo,lnest)
-  !                   i i  i   i   i   i  i i  i  i    i o i
-  !*****************************************************************************
-  !                                                                            *
-  !  This routine calculates the dry deposition velocities.                    *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     20 December 1996                                                       *
-  !     Sabine Eckhardt, Jan 07                                                *
-  !     if the latitude is negative: add half a year to the julian day         *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! gr [W/m2]         global radiation                                         *
-  ! L [m]             Obukhov length                                           *
-  ! nyl               kinematic viscosity                                      *
-  ! pa [Pa]           surface air pressure                                     *
-  ! ra [s/m]          aerodynamic resistance                                   *
-  ! raquer [s/m]      average aerodynamic resistance                           *
-  ! rh [0-1]          relative humidity                                        *
-  ! rhoa              density of the air                                       *
-  ! rr [mm/h]         precipitation rate                                       *
-  ! temp [K]          2m temperature                                           *
-  ! tc [C]            2m temperature                                           *
-  ! ust [m/s]         friction velocity                                        *
-  ! snow [m of water equivalent] snow depth                                    *
-  ! xlanduse          fractions of numclasS landuses for each model grid point *
-  !                                                                            *
-  !*****************************************************************************
-  use date_mod
-
-  implicit none
-
-  integer :: yyyymmdd,hhmmss,yyyy,mmdd,n,lseason,i,j,ix,jy,lnest
-  real :: vdepo(maxspec),vd,rb(maxspec),rc(maxspec),raquer,ylat
-  real :: ra,ust,temp,tc,pa,L,gr,rh,rr,myl,nyl,rhoa,diffh2o,snow
-  real :: slanduse(numclass)
-  real,parameter :: eps=1.e-5
-  real(kind=dp) :: jul
-
-  ! Calculate month and determine the seasonal category
-  !****************************************************
-
-  jul=bdate+real(wftime(n),kind=dp)/86400._dp
-
-  ylat=jy*dy+ylat0
-  if (ylat.lt.0) then
-      jul=jul+365/2
-  endif
-
-
-  call caldate(jul,yyyymmdd,hhmmss)
-  yyyy=yyyymmdd/10000
-  mmdd=yyyymmdd-10000*yyyy
-
-  if ((ylat.gt.-20).and.(ylat.lt.20)) then
-     mmdd=600 ! summer
-  endif
-
-  if ((mmdd.ge.1201).or.(mmdd.le.301)) then
-    lseason=4
-  else if ((mmdd.ge.1101).or.(mmdd.le.331)) then
-    lseason=3
-  else if ((mmdd.ge.401).and.(mmdd.le.515)) then
-    lseason=5
-  else if ((mmdd.ge.516).and.(mmdd.le.915)) then
-    lseason=1
-  else
-    lseason=2
-  endif
-
-  ! Calculate diffusivity of water vapor
-  !************************************
-  diffh2o=2.11e-5*(temp/273.15)**1.94*(101325/pa)
-
-  ! Conversion of temperature from K to C
-  !**************************************
-
-  tc=temp-273.15
-
-  ! Calculate dynamic viscosity
-  !****************************
-
-  if (tc.lt.0) then
-    myl=(1.718+0.0049*tc-1.2e-05*tc**2)*1.e-05
-  else
-    myl=(1.718+0.0049*tc)*1.e-05
-  endif
-
-  ! Calculate kinematic viscosity
-  !******************************
-
-  rhoa=pa/(287.*temp)
-  nyl=myl/rhoa
-
-
-  ! 0. Set all deposition velocities zero
-  !**************************************
-
-  do i=1,nspec
-    vdepo(i)=0.
-  end do
-
-
-  ! 1. Compute surface layer resistances rb
-  !****************************************
-
-  call getrb(nspec,ust,nyl,diffh2o,reldiff,rb)
-
-  ! change for snow
-  do j=1,numclass
-    if (snow.gt.0.001) then ! 10 mm
-       if (j.eq.12) then
-         slanduse(j)=1.
-       else
-         slanduse(j)=0.
-       endif
-    else
-       slanduse(j)=xlandusen(ix,jy,j,lnest)
-    endif
-  end do
-
-  raquer=0.
-  do j=1,numclass            ! loop over all landuse classes
-
-    if (slanduse(j).gt.eps)  then
-
-  ! 2. Calculate aerodynamic resistance ra
-  !***************************************
-
-      ra=raerod(L,ust,z0(j))
-      raquer=raquer+ra*slanduse(j)
-
-  ! 3. Calculate surface resistance for gases
-  !******************************************
-
-      call getrc(nspec,lseason,j,tc,gr,rh,rr,rc)
-
-  ! 4. Calculate deposition velocities for gases and ...
-  ! 5. ... sum deposition velocities for all landuse classes
-  !*********************************************************
-
-      do i=1,nspec
-        if (reldiff(i).gt.0.) then
-          if ((ra+rb(i)+rc(i)).gt.0.) then
-            vd=1./(ra+rb(i)+rc(i))
-  ! XXXXXXXXXXXXXXXXXXXXXXXXXX TEST
-  !         vd=1./rc(i)
-  ! XXXXXXXXXXXXXXXXXXXXXXXXXX TEST
-          else
-            vd=9.999
-          endif
-          vdepo(i)=vdepo(i)+vd*slanduse(j)
-        endif
-      end do
-    endif
-  end do
-
-
-  ! 6. Calculate deposition velocities for particles
-  !*************************************************
-
-  call partdep(nspec,density,fract,schmi,vset,raquer,ust,nyl, &
-    rhoa,vdepo)
-
-  ! 7. If no detailed parameterization available, take constant deposition
-  !    velocity if that is available
-  !***********************************************************************
-
-  do i=1,nspec
-    if ((reldiff(i).lt.0.).and.(density(i).lt.0.).and. &
-         (dryvel(i).gt.0.)) then
-      vdepo(i)=dryvel(i)
-    endif
-  end do
-end subroutine getvdep_nest
-
-subroutine partdep(nc,density,fract,schmi,vset,ra,ustar,nyl,rhoa,vdep)
-  !                   i     i      i     i    i   i    i    i  i, i, i/o
-  !*****************************************************************************
-  !                                                                            *
-  !      Calculation of the dry deposition velocities of particles.            *
-  !      This routine is based on Stokes' law for considering settling and     *
-  !      assumes constant dynamic viscosity of the air.                        *
-  !                                                                            *
-  !     AUTHOR: Andreas Stohl, 12 November 1993                                *
-  !                            Update: 20 December 1996                        *
-  !                                                                            *
-  !     Literature:                                                            *
-  !     [1]  Hicks/Baldocchi/Meyers/Hosker/Matt (1987), A Preliminary          *
-  !             Multiple Resistance Routine for Deriving Dry Deposition        *
-  !             Velocities from Measured Quantities.                           *
-  !             Water, Air and Soil Pollution 36 (1987), pp.311-330.           *
-  !     [2]  Slinn (1982), Predictions for Particle Deposition to              *
-  !             Vegetative Canopies. Atm.Env.16-7 (1982), pp.1785-1794.        *
-  !     [3]  Slinn/Slinn (1980),  Predictions for Particle Deposition on       *
-  !             Natural Waters. Atm.Env.14 (1980), pp.1013-1016.               *
-  !     [4]  Scire/Yamartino/Carmichael/Chang (1989),                          *
-  !             CALGRID: A Mesoscale Photochemical Grid Model.                 *
-  !             Vol II: User's Guide. (Report No.A049-1, June, 1989)           *
-  !     [5]  Langer M. (1992): Ein einfaches Modell zur Abschaetzung der       *
-  !             Depositionsgeschwindigkeit von Teilchen und Gasen.             *
-  !             Internal report.                                               *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! alpha                help variable                                         *
-  ! fract(nc,ni)         mass fraction of each diameter interval               *
-  ! lpdep(nc)            1 for particle deposition, 0 else                     *
-  ! nc                   actual number of chemical components                  *
-  ! ni                   number of diameter intervals, for which vdepj is calc.*
-  ! rdp [s/m]            deposition layer resistance                           *
-  ! ra [s/m]             aerodynamical resistance                              *
-  ! schmi(nc,ni)         Schmidt number**2/3 of each diameter interval         *
-  ! stokes               Stokes number                                         *
-  ! ustar [m/s]          friction velocity                                     *
-  ! vdep(nc) [m/s]       deposition velocities of all components               *
-  ! vdepj [m/s]          help, deposition velocity of 1 interval               *
-  ! vset(nc,ni)          gravitational settling velocity of each interval      *
-  !                                                                            *
-  ! Constants:                                                                 *
-  ! nc                   number of chemical species                            *
-  ! ni                   number of diameter intervals, for which deposition    *
-  !                      is calculated                                         *
-  !                                                                            *
-  !*****************************************************************************
-
-  implicit none
-
-  real, intent(in) ::       &
-    nyl,                    & ! kinematic viscosity
-    rhoa,                   & ! air density
-    ustar,                  & ! friction velocity
-    ra,                     & ! aerodynamical resistance
-    vset(maxspec,maxndia),  & ! gravitational settling velocity of each interval
-    density(maxspec),       & ! density of the particle
-    fract(maxspec,maxndia)    ! mass fraction of each diameter interval
-  real, intent(inout) ::    &
-    vdep(maxspec)
-  real :: schmi(maxspec,maxndia)
-  real :: stokes,vdepj,rdp,alpha
-  real :: & ! Variables related to shape
-    dfdr, alpha1, alpha2, beta1, beta2, ks, kn, c_d, &
-    settling, settling_old, reynolds, ks1, ks2, kn1, kn2
-
-  real,parameter :: eps=1.e-5
-  integer :: ic,j,nc,i
-
-
-  do ic=1,nc                  ! loop over all species
-    if (density(ic).gt.0.) then
-      do j=1,ndia(ic)         ! loop over all diameter intervals
-        if (ustar.gt.eps) then          
-          if (shape(ic).eq.0) then
-                  
-            ! Stokes number for each diameter interval
-            !*****************************************
-            ! Use this stokes number for different shapes
-            stokes=vset(ic,j)/ga*ustar*ustar/nyl
-            alpha=-3./stokes
-
-            ! Deposition layer resistance
-            !****************************
-
-            if (alpha.le.log10(eps)) then
-              rdp=1./(schmi(ic,j)*ustar)
-            else
-              rdp=1./((schmi(ic,j)+10.**alpha)*ustar)
-            endif
-
-            vdepj=vset(ic,j)+1./(ra+rdp+ra*rdp*vset(ic,j))
-
-          else ! Daria Tatsii: Drag coefficient scheme by Bagheri & Bonadonna 2016
-               ! Settling velocities of other shapes
-            dfdr=density(ic)/rhoa
-
-            reynolds=dquer(ic)/1.e6*vset(ic,j)/nyl
-            settling_old=-1.0*vset(ic,j)
-
-            ! Orientation of particles
-            !*************************
-            if (orient(ic).eq.0) then
-              ! Horizontal orientation
-              alpha2=0.77 ! B&B: eq. 32
-              beta2=0.63
-              ks=0.5*((Fs(ic)**0.05)+(Fs(ic)**(-0.36)))  ! B&B Figure 12 k_(s,max)
-              kn=10.**(alpha2*(-log10(Fn(ic)))**beta2)
-            else if (orient(ic).eq.1) then 
-              ! Random orientation
-              alpha1=0.45+10.0/(exp(2.5*log10(dfdr))+30.0)
-              beta1=1.-37.0/(exp(3.0*log10(dfdr))+100.0)
-              ks=(Fs(ic)**(1./3.) + Fs(ic)**(-1./3))/2.
-              kn=10.**(alpha1*(-log10(Fn(ic)))**beta1)
-            else
-              ! The average of random and horizontal orientation
-              alpha1=0.45+10.0/(exp(2.5*log10(dfdr))+30.0)
-              beta1=1.-37.0/(exp(3.0*log10(dfdr))+100.0)
-              alpha2=0.77 ! B&B: eq. 32
-              beta2=0.63
-              ks1=(Fs(ic)**(1./3.) + Fs(ic)**(-1./3))/2.
-              kn1=10.**(alpha1*(-log10(Fn(ic)))**beta1)
-              ks2=0.5*((Fs(ic)**0.05)+(Fs(ic)**(-0.36)))  ! B&B Figure 12 k_(s,max)
-              kn2=10.**(alpha2*(-log10(Fn(ic)))**beta2)
-              ks=(ks1+ks2)/2.
-              kn=(kn1+kn2)/2.
-            endif
-
-            do i=1,20
-              c_d=(24.*ks/reynolds)*(1.+0.125*((reynolds*kn/ks)**(2./3.)))+ &
-                (0.46*kn/(1.+5330./(reynolds*kn/ks)))
-
-              ! Settling velocity of a particle is defined by the Newton's impact law:
-              settling=-1.* &
-                      sqrt(4.*ga*dquer(ic)/1.e6*density(ic)*cunningham(ic)/ &
-                      (3.*c_d*rhoa))
-
-              if (abs((settling-settling_old)/settling).lt.0.01) exit
-
-              reynolds=dquer(ic)/1.e6*abs(settling)/nyl
-              settling_old=settling
-            end do
-            ! We assume aerodynamic resistance ra and quasi-laminar sub-layer resistance rdp
-            ! Stokes number for each diameter interval
-            !*****************************************
-            ! Use this stokes number for different shapes
-            stokes=abs(settling)/ga*ustar*ustar/nyl
-            alpha=-3./stokes
-
-            ! Deposition layer resistance
-            !****************************
-
-            if (alpha.le.log10(eps)) then
-              rdp=1./(schmi(ic,j)*ustar)
-            else
-              rdp=1./((schmi(ic,j)+10.**alpha)*ustar)
-            endif
-            
-            
-            vdepj=abs(settling)+1./(ra+rdp+ra*rdp*abs(settling))
-
-          endif
-
-        else
-          vdepj=vset(ic,j)
-        endif
-
-        ! deposition velocities of each interval are weighted with mass fraction
-        !***********************************************************************
-
-        vdep(ic)=vdep(ic)+vdepj*fract(ic,j)
-          
-      end do
-    endif
-  end do
-
-end subroutine partdep
-
-subroutine getrb(nc,ustar,nyl,diffh2o,reldiff,rb)
-  !                 i    i    i     i       i    o
-  !*****************************************************************************
-  !                                                                            *
-  !  Calculation of the quasilaminar sublayer resistance to dry deposition.    *
-  !                                                                            *
-  !      AUTHOR: Andreas Stohl, 20 May 1995                                    *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! rb(ncmax)       sublayer resistance                                        *
-  ! schmidt         Schmidt number                                             *
-  ! ustar [m/s]     friction velocity                                          *
-  ! diffh20 [m2/s]  diffusivity of water vapor in air                          *
-  ! reldiff         diffusivity relative to H2O                                *
-  !                                                                            *
-  ! Constants:                                                                 *
-  ! karman          von Karman constant                                        *
-  ! pr              Prandtl number                                             *
-  !                                                                            *
-  !*****************************************************************************
-
-  implicit none
-
-  real :: ustar,diffh2o,rb(maxspec),schmidt,nyl
-  real :: reldiff(maxspec)
-  integer :: ic,nc
-  real,parameter :: pr=0.72
-
-  do ic=1,nc
-    if (reldiff(ic).gt.0.) then
-      schmidt=nyl/diffh2o*reldiff(ic)
-      rb(ic)=2.0*(schmidt/pr)**0.67/(karman*ustar)
-    endif
-  end do
-end subroutine getrb
-
-subroutine getrc(nc,i,j,t,gr,rh,rr,rc)
-  !                 i  i i i i  i  i  o
-  !*****************************************************************************
-  !                                                                            *
-  !  Calculation of the surface resistance according to the procedure given    *
-  !  in:                                                                       *
-  !  Wesely (1989): Parameterization of surface resistances to gaseous         *
-  !  dry deposition in regional-scale numerical models.                        *
-  !  Atmos. Environ. 23, 1293-1304.                                            *
-  !                                                                            *
-  !                                                                            *
-  !      AUTHOR: Andreas Stohl, 19 May 1995                                    *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  !                                                                            *
-  ! reldiff(maxspec)  diffusivity of H2O/diffusivity of component i            *
-  ! gr [W/m2]       global radiation                                           *
-  ! i               index of seasonal category                                 *
-  ! j               index of landuse class                                     *
-  ! ldep(maxspec)          1, if deposition shall be calculated for species i  *
-  ! nc                   actual number of chemical components                  *
-  ! rcl(maxspec,5,8) [s/m] Lower canopy resistance                             *
-  ! rgs(maxspec,5,8) [s/m] Ground resistance                                   *
-  ! rlu(maxspec,5,8) [s/m] Leaf cuticular resistance                           *
-  ! rm(maxspec) [s/m]      Mesophyll resistance                                *
-  ! t [C]           temperature                                                *
-  !                                                                            *
-  !*****************************************************************************
-
-  implicit none
-
-  integer :: i,j,ic,nc
-  real :: gr,rh,rr,t,rs,rsm,corr,rluc,rclc,rgsc,rdc,rluo
-  real :: rc(maxspec)
-
-
-  ! Compute stomatal resistance
-  !****************************
-  ! Sabine Eckhardt, Dec 06: use 1E25 instead of 99999. for infinite res.
-
-  if ((t.gt.0.).and.(t.lt.40.)) then
-    rs=ri(i,j)*(1.+(200./(gr+0.1))**2)*(400./(t*(40.-t)))
-  else
-    rs=1.E25
-  !  rs=99999.
-  endif
-
+#include "dry_alloc_drydepo.f90"
 
-  ! Correct stomatal resistance for effect of dew and rain
-  !*******************************************************
+#include "dry_dealloc_drydepo.f90"
 
-  if ((rh.gt.0.9).or.(rr.gt.0.)) rs=rs*3.
+#include "dry_assignland.f90"
 
-  ! Compute the lower canopy resistance
-  !************************************
+#include "dry_raerod.f90"
 
-  rdc=100.*(1.+1000./(gr+10.))
+#include "dry_drydepo_massloss.f90"
 
+#include "dry_drydepokernel.f90"
 
-  corr=1000.*exp(-1.*t-4.)
-  do ic=1,nc
-    if (reldiff(ic).gt.0.) then
+#include "dry_drydepokernel_nest.f90"
 
-  ! Compute combined stomatal and mesophyll resistance
-  !***************************************************
+#include "dry_part0.f90"
 
-      rsm=rs*reldiff(ic)+rm(ic)
+#include "dry_get_vdep_prob.f90"
 
-  ! Correct leaf cuticular, lower canopy and ground resistance
-  !***********************************************************
+#include "dry_drydepo_probability.f90"
 
-      rluc=rlu(ic,i,j)+corr
-      rclc=rcl(ic,i,j)+corr
-      rgsc=rgs(ic,i,j)+corr
+#include "dry_getvdep.f90"
 
-  ! Correct leaf cuticular resistance for effect of dew and rain
-  !*************************************************************
+#include "dry_getvdep_nest.f90"
 
-      if (rr.gt.0.) then
-        rluo=1./(1./1000.+1./(3.*rluc))
-        rluc=1./(1./(3.*rluc)+1.e-7*henry(ic)+f0(ic)/rluo)
-      else if (rh.gt.0.9) then
-        rluo=1./(1./3000.+1./(3.*rluc))
-        rluc=1./(1./(3.*rluc)+1.e-7*henry(ic)+f0(ic)/rluo)
-      endif
+#include "dry_partdep.f90"
 
-  ! Combine resistances to give total resistance
-  !*********************************************
+#include "dry_getrb.f90"
 
-      rc(ic)=1./(1./rsm+1./rluc+1./(rdc+rclc)+1./(rac(i,j)+rgsc))
-  ! Sabine Eckhardt, Dec 06: avoid possible excessively high vdep
-      if (rc(ic).lt.10.) rc(ic)=10.
-    endif
-  end do
-end subroutine getrc
+#include "dry_getrc.f90"
 
 end module drydepo_mod
diff --git a/src/erf_erf.f90 b/src/erf_erf.f90
new file mode 100644
index 0000000000000000000000000000000000000000..040ac64a7d0ffcc7dfb98bd1ebcef7d4dd9af478
--- /dev/null
+++ b/src/erf_erf.f90
@@ -0,0 +1,16 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+function erf(x)
+
+  implicit none
+
+  real :: x, erf
+  !real, external :: gammp
+
+  if(x.lt.0.)then
+    erf=-gammp(.5,x**2)
+  else
+    erf=gammp(.5,x**2)
+  endif
+end function erf
diff --git a/src/erf_erfc.f90 b/src/erf_erfc.f90
new file mode 100644
index 0000000000000000000000000000000000000000..6da3862fe59692f363fc5b1fe173e153aa2dbbf5
--- /dev/null
+++ b/src/erf_erfc.f90
@@ -0,0 +1,16 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+function erfc(x)
+
+  implicit none
+
+  real :: x, erfc
+  !real, external :: gammp, gammq
+
+  if(x.lt.0.)then
+    erfc=1.+gammp(.5,x**2)
+  else
+    erfc=gammq(.5,x**2)
+  endif
+end function erfc
diff --git a/src/erf_erfcc.f90 b/src/erf_erfcc.f90
new file mode 100644
index 0000000000000000000000000000000000000000..f486f77e129ffb72b9a61dba208a7e854b005e9c
--- /dev/null
+++ b/src/erf_erfcc.f90
@@ -0,0 +1,16 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+function erfcc(x)
+
+  implicit none
+
+  real :: x, z, t, erfcc
+
+  z=abs(x)
+  t=1./(1.+0.5*z)
+  erfcc=t*exp(-z*z-1.26551223+t*(1.00002368+t*(.37409196+ &
+       t*(.09678418+t*(-.18628806+t*(.27886807+t*(-1.13520398+ &
+       t*(1.48851587+t*(-.82215223+t*.17087277)))))))))
+  if (x.lt.0.) erfcc=2.-erfcc
+end function erfcc
diff --git a/src/erf_flexpart.f90 b/src/erf_flexpart.f90
new file mode 100644
index 0000000000000000000000000000000000000000..75a2520b418d8de6436f6279380994c016aca394
--- /dev/null
+++ b/src/erf_flexpart.f90
@@ -0,0 +1,147 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+program flexpart
+
+  !*****************************************************************************
+  !                                                                            *
+  !     This is the Lagrangian Particle Dispersion Model FLEXPART.             *
+  !     The main program manages the reading of model run specifications, etc. *
+  !     All actual computing is done within subroutine timemanager.            *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     18 May 1996                                                            *
+  !                                                                            *
+  !*****************************************************************************
+  ! Changes:                                                                   *
+  !   Unified ECMWF and GFS builds                                             *
+  !   Marian Harustak, 12.5.2017                                               *
+  !     (moved to read_options_and_initialise_flexpart by LB)                  *
+  !     - Added detection of metdata format using gributils routines           *
+  !     - Distinguished calls to ecmwf/gfs gridcheck versions based on         *
+  !       detected metdata format                                              *
+  !     - Passed metdata format down to timemanager                            *
+  !   L. Bakels 2022                                                           *
+  !     - OpenMP parallelisation                                               *
+  !     - Added input options                                                  *
+  !     - Restructuring into subroutines (below)                               *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  ! Constants:                                                                 *
+  !                                                                            *
+  !*****************************************************************************
+  use omp_lib, only: OMP_GET_MAX_THREADS
+  use par_mod
+  use com_mod
+  use timemanager_mod
+  use output_mod
+
+  implicit none
+
+  real :: s_timemanager
+  character(len=256) ::   &
+    inline_options          ! pathfile, flexversion, arg2
+
+  ! Keeping track of the total running time of FLEXPART, printed out at the end.
+  !*****************************************************************************
+  CALL SYSTEM_CLOCK(count_clock, count_rate, count_max)
+  s_total = (count_clock - count_clock0)/real(count_rate)
+
+
+  ! FLEXPART version string
+  flexversion_major = '10' ! Major version number, also used for species file names
+  flexversion='Version '//trim(flexversion_major)//'.4 (2019-11-12)'
+  verbosity=0
+
+  ! Read the pathnames where input/output files are stored
+  !*******************************************************
+
+  inline_options='none'
+  select case (iargc())
+  case (2)
+    call getarg(1,arg1)
+    pathfile=arg1
+    call getarg(2,arg2)
+    inline_options=arg2
+  case (1)
+    call getarg(1,arg1)
+    pathfile=arg1
+    if (arg1(1:1).eq.'-') then
+      write(pathfile,'(a11)') './pathnames'
+      inline_options=arg1
+    endif
+  case (0)
+    write(pathfile,'(a11)') './pathnames'
+  end select
+
+  ! Print the GPL License statement
+  !*******************************************************
+  print*,'Welcome to FLEXPART ', trim(flexversion)
+  print*,'FLEXPART is free software released under the GNU General Public License.'
+  write(*,*) 'FLEXPART is running with ', trim(wind_coord_type), 'coordinates.'
+  ! Reading the number of threads available and print them for user
+  !****************************************************************
+#ifdef _OPENMP
+    numthreads = OMP_GET_MAX_THREADS()
+    numthreads_grid = min(numthreads,max_numthreads_grid)
+    !numthreads = min(40,numthreads)
+#else
+    numthreads = 1
+    numthreads_grid = 1
+#endif
+
+  if (numthreads.gt.1) then
+    write(*,*)
+    write(*,*) "*********** WARNING  **********************************"
+    write(*,*) "* FLEXPART running in parallel mode                   *"
+    write(*,*) "* Number of uncertainty classes in                    *"
+    write(*,901) " * set to number of threads:            ", &
+      numthreads_grid, "          *"
+    write(*,901) " * All other computations are done with ",&
+      numthreads, " threads. *"
+    write(*,*) "*******************************************************"
+    write(*,*)
+901 format (a,i5,a)
+  endif
+
+  ! Reading user specified options, allocating fields and checking bounds
+  !**********************************************************************
+  call read_options_and_initialise_flexpart
+
+  ! Inform whether output kernel is used or not
+  !*********************************************
+  if (lroot) then
+    if (.not.lusekerneloutput) then
+      write(*,*) "Concentrations are calculated without using kernel"
+    else
+      write(*,*) "Concentrations are calculated using kernel"
+    end if
+  end if
+
+  if (turboff) write(*,*) 'Turbulence switched off'
+
+  ! Calculate particle trajectories
+  !********************************
+  CALL SYSTEM_CLOCK(count_clock, count_rate, count_max)
+  s_timemanager = (count_clock - count_clock0)/real(count_rate)
+
+  call timemanager
+
+  CALL SYSTEM_CLOCK(count_clock, count_rate, count_max)
+  s_timemanager = (count_clock - count_clock0)/real(count_rate) - s_timemanager
+
+  CALL SYSTEM_CLOCK(count_clock, count_rate, count_max)
+  s_total = (count_clock - count_clock0)/real(count_rate) - s_total
+
+  write(*,*) 'Read wind fields: ', s_readwind, ' seconds'
+  write(*,*) 'Timemanager: ', s_timemanager, ' seconds,', 'first timestep: ',s_firstt, 'seconds'
+  write(*,*) 'Write particle files: ', s_writepart, ' seconds'
+  write(*,*) 'Total running time: ', s_total, ' seconds'
+  write(*,*) 'tps,io,tot: ', (s_timemanager-s_firstt)/4.,(s_readwind+s_writepart)/5.,s_total
+  write(*,*) 'CONGRATULATIONS: YOU HAVE SUCCESSFULLY COMPLETED A FLE&
+       &XPART MODEL RUN!'
+
+end program flexpart
diff --git a/src/erf_gammln.f90 b/src/erf_gammln.f90
new file mode 100644
index 0000000000000000000000000000000000000000..5b0f2eac70d76115eb6859a8502ed98e15a2041a
--- /dev/null
+++ b/src/erf_gammln.f90
@@ -0,0 +1,27 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+function gammln(xx)
+
+  use par_mod, only: dp
+
+  implicit none
+
+  integer :: j
+  real :: x,tmp,ser,xx,gammln
+  real :: cof(6) = (/ &
+       76.18009173_dp, -86.50532033_dp, 24.01409822_dp, &
+       -1.231739516_dp, .120858003e-2_dp, -.536382e-5_dp    /)
+  real :: stp = 2.50662827465_dp
+  real :: half = 0.5_dp, one = 1.0_dp, fpf = 5.5_dp
+
+  x=xx-one
+  tmp=x+fpf
+  tmp=(x+half)*log(tmp)-tmp
+  ser=one
+  do j=1,6
+    x=x+one
+    ser=ser+cof(j)/x
+  end do
+  gammln=tmp+log(stp*ser)
+end function gammln
diff --git a/src/erf_gammp.f90 b/src/erf_gammp.f90
new file mode 100644
index 0000000000000000000000000000000000000000..cec23d3ab866ad9b3103c8a27049150c00a1f480
--- /dev/null
+++ b/src/erf_gammp.f90
@@ -0,0 +1,21 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+function gammp(a,x)
+
+  implicit none
+
+  real :: a, x, gln, gamser, gammp, gammcf
+
+  if(x .lt. 0. .or. a .le. 0.) then
+     print*, 'gammp'
+     stop
+  end if
+  if(x.lt.a+1.)then
+    call gser(gamser,a,x,gln)
+    gammp=gamser
+  else
+    call gcf(gammcf,a,x,gln)
+    gammp=1.-gammcf
+  endif
+end function gammp
diff --git a/src/erf_gammq.f90 b/src/erf_gammq.f90
new file mode 100644
index 0000000000000000000000000000000000000000..ff260d0e6ccf8656ea2c4c14595c1c8b75d631e7
--- /dev/null
+++ b/src/erf_gammq.f90
@@ -0,0 +1,21 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+function gammq(a,x)
+
+  implicit none
+
+  real :: a, x, gln, gamser, gammq, gammcf
+
+  if(x.lt.0..or.a.le.0.) then
+     print*, 'gammq'
+     stop
+  end if
+  if(x.lt.a+1.)then
+    call gser(gamser,a,x,gln)
+    gammq=1.-gamser
+  else
+    call gcf(gammcf,a,x,gln)
+    gammq=gammcf
+  endif
+end function gammq
diff --git a/src/erf_gcf.f90 b/src/erf_gcf.f90
new file mode 100644
index 0000000000000000000000000000000000000000..387301fa69d4a737b3af4ff688bf93674fb70148
--- /dev/null
+++ b/src/erf_gcf.f90
@@ -0,0 +1,40 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine gcf(gammcf,a,x,gln)
+
+  implicit none
+
+  integer :: n
+  real :: gammcf, a, x, gln, gold, a0, a1, b0, b1, fac, an, anf, ana, g
+  !real, external :: gammln
+
+  integer,parameter :: itmax=100
+  real,parameter    :: eps=3.e-7
+
+  gln=gammln(a)
+  gold=0.
+  a0=1.
+  a1=x
+  b0=0.
+  b1=1.
+  fac=1.
+  do n=1,itmax
+    an=real(n)
+    ana=an-a
+    a0=(a1+a0*ana)*fac
+    b0=(b1+b0*ana)*fac
+    anf=an*fac
+    a1=x*a0+anf*a1
+    b1=x*b0+anf*b1
+    if(a1.ne.0.)then
+      fac=1./a1
+      g=b1*fac
+      if(abs((g-gold)/g).lt.eps)go to 1
+      gold=g
+    endif
+  end do
+  print*, 'gcf: a too large, itmax too small'
+  stop
+1   gammcf=exp(-x+a*alog(x)-gln)*g
+end subroutine gcf
diff --git a/src/erf_gser.f90 b/src/erf_gser.f90
new file mode 100644
index 0000000000000000000000000000000000000000..a95ba09c4797d72469dc84d53c359f83117164e2
--- /dev/null
+++ b/src/erf_gser.f90
@@ -0,0 +1,36 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine gser(gamser,a,x,gln)
+
+  implicit none
+
+  integer :: n
+  real :: gamser, a, x, gln, ap, summ, del
+  !real, external :: gammln
+
+  integer,parameter :: itmax=100
+  real,parameter    :: eps=3.e-7
+
+  gln=gammln(a)
+  if(x.le.0.)then
+    if(x.lt.0.) then
+       print*, 'gser'
+       stop
+    end if
+    gamser=0.
+    return
+  endif
+  ap=a
+  summ=1./a
+  del=summ
+  do n=1,itmax
+    ap=ap+1.
+    del=del*x/ap
+    summ=summ+del
+    if(abs(del).lt.abs(summ)*eps)go to 1
+  end do
+  print*, 'gser: a too large, itmax too small'
+  stop
+1   gamser=summ*exp(-x+a*log(x)-gln)
+end subroutine gser
diff --git a/src/erf_initialise_particle.f90 b/src/erf_initialise_particle.f90
new file mode 100644
index 0000000000000000000000000000000000000000..4ff3cb7549f29a658e19eabb460ce73c336c04d3
--- /dev/null
+++ b/src/erf_initialise_particle.f90
@@ -0,0 +1,69 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine initialise_particle
+
+  !*****************************************************************************
+  !                                                                            *
+  !   This subroutine handles the different forms of starting FLEXPART         *
+  !   depending on IPIN (set in COMMAND)                                       *
+  !                                                                            *
+  !   IPIN=0: this routine is not called and particles are read from the       *
+  !           RELEASE option file                                              *
+  !   IPIN=1: restarting from a restart.bin file, written by a previous run    *
+  !   IPIN=2: restarting from a partoutput_xxx.nc file written by a previous   *
+  !           run, depending on what PARTOPTIONS the user has chosen, this     *
+  !           option might not be possible to use                              *
+  !   IPIN=3: starting a run from a user defined initial particle conditions,  *
+  !           more on how to create such a file can be found in the manual     *
+  !   IPIN=4: restarting a run, while also reading in the initial particle     *
+  !           conditions                                                       *
+  !                                                                            *
+  !   Author: L. Bakels 2022                                                   *
+  !                                                                            *
+  !*****************************************************************************
+
+  use point_mod
+  use com_mod
+  use initialise_mod
+#ifdef USE_NCF
+  use netcdf_output_mod !PS
+#endif
+  use readoptions_mod
+
+  implicit none
+
+  integer :: i
+
+  ! Read the coordinates of the release locations
+  !**********************************************
+  if (ipin.le.2) call readreleases ! CHECK ETA
+
+  itime_init=0
+  if ((ipin.eq.1).or.(ipin.eq.4)) then ! Restarting from restart.bin file
+    call readrestart
+  else if (ipin.eq.2) then ! Restarting from netcdf partoutput file
+#ifdef USE_NCF
+    call readpartpositions
+#else
+    stop 'Compile with netCDF if you want to use the ipin=2 option.'
+#endif
+  else if (ipin.eq.3) then ! User defined particle properties
+  ! Reading initial conditions from netcdf file
+#ifdef USE_NCF
+    call read_init_cond_nc
+#else
+    stop 'Compile with netCDF if you want to use the ipin=3 option.'
+#endif
+  else
+    ! Releases can only start and end at discrete times (multiples of lsynctime)
+    !***************************************************************************
+    do i=1,numpoint
+      ireleasestart(i)=nint(real(ireleasestart(i))/real(lsynctime))*lsynctime
+      ireleaseend(i)=nint(real(ireleaseend(i))/real(lsynctime))*lsynctime
+    end do
+    numpart=0
+    numparticlecount=0
+  endif
+
+end subroutine initialise_particle
diff --git a/src/erf_mod.f90 b/src/erf_mod.f90
index 9fc13a4452a0120984c80e3a438ffc5b3c9f42b4..32ff3d03697c9b1d8bfd4439ba2a06bb0069822c 100644
--- a/src/erf_mod.f90
+++ b/src/erf_mod.f90
@@ -26,181 +26,20 @@ contains
 !                       6.2:GCF/6.1:GAMMLN>
 !6.2  FUNCTION ERFCC
 
-function gammln(xx)
+#include "erf_gammln.f90"
 
-  use par_mod, only: dp
+#include "erf_gammp.f90"
 
-  implicit none
-
-  integer :: j
-  real :: x,tmp,ser,xx,gammln
-  real :: cof(6) = (/ &
-       76.18009173_dp, -86.50532033_dp, 24.01409822_dp, &
-       -1.231739516_dp, .120858003e-2_dp, -.536382e-5_dp    /)
-  real :: stp = 2.50662827465_dp
-  real :: half = 0.5_dp, one = 1.0_dp, fpf = 5.5_dp
-
-  x=xx-one
-  tmp=x+fpf
-  tmp=(x+half)*log(tmp)-tmp
-  ser=one
-  do j=1,6
-    x=x+one
-    ser=ser+cof(j)/x
-  end do
-  gammln=tmp+log(stp*ser)
-end function gammln
-
-function gammp(a,x)
-
-  implicit none
-
-  real :: a, x, gln, gamser, gammp, gammcf
-
-  if(x .lt. 0. .or. a .le. 0.) then
-     print*, 'gammp'
-     stop
-  end if
-  if(x.lt.a+1.)then
-    call gser(gamser,a,x,gln)
-    gammp=gamser
-  else
-    call gcf(gammcf,a,x,gln)
-    gammp=1.-gammcf
-  endif
-end function gammp
-
-function gammq(a,x)
-
-  implicit none
-
-  real :: a, x, gln, gamser, gammq, gammcf
-
-  if(x.lt.0..or.a.le.0.) then
-     print*, 'gammq'
-     stop
-  end if
-  if(x.lt.a+1.)then
-    call gser(gamser,a,x,gln)
-    gammq=1.-gamser
-  else
-    call gcf(gammcf,a,x,gln)
-    gammq=gammcf
-  endif
-end function gammq
-
-subroutine gser(gamser,a,x,gln)
-
-  implicit none
-
-  integer :: n
-  real :: gamser, a, x, gln, ap, summ, del
-  !real, external :: gammln
-
-  integer,parameter :: itmax=100
-  real,parameter    :: eps=3.e-7
+#include "erf_gammq.f90"
 
-  gln=gammln(a)
-  if(x.le.0.)then
-    if(x.lt.0.) then
-       print*, 'gser'
-       stop
-    end if
-    gamser=0.
-    return
-  endif
-  ap=a
-  summ=1./a
-  del=summ
-  do n=1,itmax
-    ap=ap+1.
-    del=del*x/ap
-    summ=summ+del
-    if(abs(del).lt.abs(summ)*eps)go to 1
-  end do
-  print*, 'gser: a too large, itmax too small'
-  stop
-1   gamser=summ*exp(-x+a*log(x)-gln)
-end subroutine gser
+#include "erf_gser.f90"
 
-subroutine gcf(gammcf,a,x,gln)
+#include "erf_gcf.f90"
 
-  implicit none
-
-  integer :: n
-  real :: gammcf, a, x, gln, gold, a0, a1, b0, b1, fac, an, anf, ana, g
-  !real, external :: gammln
-
-  integer,parameter :: itmax=100
-  real,parameter    :: eps=3.e-7
-
-  gln=gammln(a)
-  gold=0.
-  a0=1.
-  a1=x
-  b0=0.
-  b1=1.
-  fac=1.
-  do n=1,itmax
-    an=real(n)
-    ana=an-a
-    a0=(a1+a0*ana)*fac
-    b0=(b1+b0*ana)*fac
-    anf=an*fac
-    a1=x*a0+anf*a1
-    b1=x*b0+anf*b1
-    if(a1.ne.0.)then
-      fac=1./a1
-      g=b1*fac
-      if(abs((g-gold)/g).lt.eps)go to 1
-      gold=g
-    endif
-  end do
-  print*, 'gcf: a too large, itmax too small'
-  stop
-1   gammcf=exp(-x+a*alog(x)-gln)*g
-end subroutine gcf
-
-function erf(x)
-
-  implicit none
-
-  real :: x, erf
-  !real, external :: gammp
-
-  if(x.lt.0.)then
-    erf=-gammp(.5,x**2)
-  else
-    erf=gammp(.5,x**2)
-  endif
-end function erf
-
-function erfc(x)
-
-  implicit none
-
-  real :: x, erfc
-  !real, external :: gammp, gammq
-
-  if(x.lt.0.)then
-    erfc=1.+gammp(.5,x**2)
-  else
-    erfc=gammq(.5,x**2)
-  endif
-end function erfc
-
-function erfcc(x)
-
-  implicit none
+#include "erf_erf.f90"
 
-  real :: x, z, t, erfcc
+#include "erf_erfc.f90"
 
-  z=abs(x)
-  t=1./(1.+0.5*z)
-  erfcc=t*exp(-z*z-1.26551223+t*(1.00002368+t*(.37409196+ &
-       t*(.09678418+t*(-.18628806+t*(.27886807+t*(-1.13520398+ &
-       t*(1.48851587+t*(-.82215223+t*.17087277)))))))))
-  if (x.lt.0.) erfcc=2.-erfcc
-end function erfcc
+#include "erf_erfcc.f90"
 
 end module erf_mod
diff --git a/src/erf_read_options_and_initialise_flexpart.f90 b/src/erf_read_options_and_initialise_flexpart.f90
new file mode 100644
index 0000000000000000000000000000000000000000..ef864238145124108b1da0d258a3b77ee1800c9c
--- /dev/null
+++ b/src/erf_read_options_and_initialise_flexpart.f90
@@ -0,0 +1,191 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine read_options_and_initialise_flexpart
+
+  !*****************************************************************************
+  !                                                                            *
+  !   Moved from main flexpart program:                                        *
+  !   Reading all option files, initialisation of random numbers, and          *
+  !   allocating memory for windfields, grids, etc.                            *
+  !                                                                            *
+  !   L. Bakels 2022                                                           *
+  !                                                                            *
+  !*****************************************************************************
+
+  use point_mod
+  use random_mod
+  use par_mod
+  use com_mod
+  use conv_mod
+  use class_gribfile_mod
+  use readoptions_mod
+  use windfields_mod
+  use plume_mod
+  use initialise_mod
+  use drydepo_mod
+  use getfields_mod
+  use interpol_mod, only: alloc_interpol
+  use prepoutgrid_mod
+  use binary_output_mod
+
+  implicit none
+
+  integer ::              &
+    i,                    & ! loop variable for number of points
+    inest                   ! loop variable for nested gridcells
+  integer ::              &
+    j,                    & ! loop variable for random numbers
+    idummy=-320             ! dummy value used by the random routine
+
+  call alloc_random(numthreads)
+
+  ! Generate a large number of random numbers
+  !******************************************
+  do j=1,maxrand-1,2
+    call gasdev1(idummy,rannumb(j),rannumb(j+1))
+  end do
+  call gasdev1(idummy,rannumb(maxrand),rannumb(maxrand-1))
+
+  ! Read pathnames from file in working director that specify I/O directories
+  !**************************************************************************
+  call readpaths
+
+  ! Read the user specifications for the current model run
+  !*******************************************************
+  call readcommand
+
+  ! Read the age classes to be used
+  !********************************
+  call readageclasses
+
+
+  ! Allocate memory for windfields
+  !*******************************
+  call alloc_windf
+  if (numbnests.ge.1) then
+    ! If nested wind fields are used, allocate arrays
+    !************************************************
+    call alloc_windf_nest
+  endif
+
+  ! Read, which wind fields are available within the modelling period
+  !******************************************************************
+  call readavailable
+
+  if (ipout.ne.0) call readpartoptions
+
+  ! Detect metdata format
+  !**********************
+  call detectformat
+
+  if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
+    print *,'ECMWF metdata detected'
+    if (nxshift.eq.-9999) nxshift=359
+  elseif (metdata_format.eq.GRIBFILE_CENTRE_NCEP) then
+    print *,'NCEP metdata detected'
+    if (nxshift.eq.-9999) nxshift=0
+  else
+    print *,'Unknown metdata format'
+    stop
+  endif
+  write(*,*) 'NXSHIFT is set to', nxshift
+
+  ! Read the model grid specifications,
+  ! both for the mother domain and eventual nests
+  !**********************************************
+  if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
+    call gridcheck_ecmwf
+  else
+    call gridcheck_gfs
+  endif
+
+  ! Set the upper level for where the convection will be working
+  !*************************************************************
+  call set_conv_top
+
+  if (numbnests.ge.1) then
+  ! If nested wind fields are used, allocate arrays
+  !************************************************
+    call gridcheck_nest
+  endif
+
+  ! Read the output grid specifications if requested by user
+  !*********************************************************
+  if (iout.ne.0) then
+    call readoutgrid
+
+    if (nested_output.eq.1) then
+      call readoutgrid_nest
+    endif
+  endif
+
+  ! Read the receptor points for which extra concentrations are to be calculated
+  !*****************************************************************************
+  call readreceptors
+
+  ! Read the physico-chemical species property table
+  !*************************************************
+  !SEC: now only needed SPECIES are read in readreleases.f
+  !call readspecies
+
+  ! Read the landuse inventory
+  !***************************
+  call readlanduse ! CHECK ETA
+
+  ! For continuation of previous run or from user defined initial
+  ! conditions, read in particle positions
+  !*************************************************************************
+  call initialise_particle
+
+  ! Convert the release point coordinates from geografical to grid coordinates
+  !***************************************************************************
+  call coordtrafo(nxmin1,nymin1) ! CHECK ETA
+
+  ! Read and compute surface resistances to dry deposition of gases
+  !****************************************************************
+  call readdepo ! CHECK ETA
+
+  ! Allocate dry deposition fields if necessary
+  !*********************************************
+  call alloc_drydepo
+  call alloc_convect
+  call alloc_getfields
+  call alloc_interpol
+
+  ! Assign fractional cover of landuse classes to each ECMWF grid point
+  !********************************************************************
+  call assignland ! CHECK ETA
+
+  ! Calculate volume, surface area, etc., of all output grid cells
+  ! Allocate fluxes and OHfield if necessary
+  !***************************************************************
+  if (iout.ne.0) then
+    call outgrid_init ! CHECK ETA
+    if (nested_output.eq.1) call outgrid_init_nest ! CHECK ETA
+  endif
+
+  ! Read the OH field
+  !******************
+  if (OHREA) then
+    call readOHfield ! CHECK ETA
+  endif
+
+#ifndef USE_NCF
+  call openreceptors
+#endif
+  if ((iout.eq.4).or.(iout.eq.5)) call openouttraj ! CHECK ETA
+
+
+  ! Initialize cloud-base mass fluxes for the convection scheme
+  !************************************************************
+
+  cbaseflux(0:nxmin1,0:nymin1)=0.
+  do inest=1,numbnests
+    cbasefluxn(0:nxn(inest)-1,0:nyn(inest)-1,inest)=0.
+  end do
+
+  ! Allocating nan_count for CBL option
+  !************************************
+  allocate(nan_count(numthreads))
+end subroutine read_options_and_initialise_flexpart
diff --git a/src/flu_calcfluxes.f90 b/src/flu_calcfluxes.f90
new file mode 100644
index 0000000000000000000000000000000000000000..80be45eba1ccad613febb5525bd897f49e4aa801
--- /dev/null
+++ b/src/flu_calcfluxes.f90
@@ -0,0 +1,216 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine calcfluxes(itime,nage,jpart,xold,yold,zold,thread)
+  !                       i     i    i    i    i
+  !*****************************************************************************
+  !                                                                            *
+  !     Calculation of the gross fluxes across horizontal, eastward and        *
+  !     northward facing surfaces. The routine calculates the mass flux        *
+  !     due to the motion of only one particle. The fluxes of subsequent calls *
+  !     to this subroutine are accumulated until the next output is due.       *
+  !     Upon output, flux fields are re-set to zero in subroutine fluxoutput.f.*
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     04 April 2000                                                          *
+  !                                                                            *
+  !     Changes                                                                *
+  !        2021 L. Bakels: OpenMP parallelisation                              *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  ! nage                  Age class of the particle considered                 *
+  ! jpart                 Index of the particle considered                     *
+  ! xold,yold,zold        "Memorized" old positions of the particle            *
+  !                                                                            *
+  !*****************************************************************************
+
+  use particle_mod
+  use coord_ec_mod
+
+  implicit none
+  integer, intent(in) :: thread ! for OMP, number of thread
+  integer :: itime,jpart,nage,ixave,jyave,kz,kzave,kp
+  integer :: k,k1,k2,ix,ix1,ix2,ixs,jy,jy1,jy2
+  real :: xold,yold,zold,xmean,ymean
+
+
+  ! Determine average positions
+  !****************************
+
+  if ((ioutputforeachrelease.eq.1).and.(mdomainfill.eq.0)) then
+     kp=part(jpart)%npoint
+  else
+     kp=1
+  endif
+  call update_zeta_to_z(itime,jpart)
+  xmean=(xold+part(jpart)%xlon)/2.
+  ymean=(yold+part(jpart)%ylat)/2.
+
+  ixave=int((xmean*dx+xoutshift)/dxout)
+  jyave=int((ymean*dy+youtshift)/dyout)
+  do kz=1,numzgrid                ! determine height of cell
+    if (outheight(kz).gt.part(jpart)%z) exit
+  end do
+  kzave=kz
+
+
+  ! Determine vertical fluxes
+  !**************************
+
+  if ((ixave.ge.0).and.(jyave.ge.0).and.(ixave.le.numxgrid-1).and. &
+       (jyave.le.numygrid-1)) then
+    do kz=1,numzgrid                ! determine height of cell
+      if (outheighthalf(kz).gt.zold) exit
+    end do
+    k1=min(numzgrid,kz)
+    do kz=1,numzgrid                ! determine height of cell
+      if (outheighthalf(kz).gt.part(jpart)%z) exit
+    end do
+    k2=min(numzgrid,kz)
+
+    do k=1,nspec
+      do kz=k1,k2-1
+#ifdef _OPENMP
+        flux_omp(5,ixave,jyave,kz,k,kp,nage,thread)= &
+             flux_omp(5,ixave,jyave,kz,k,kp,nage,thread)+ &
+             part(jpart)%mass(k)
+#else
+        flux(5,ixave,jyave,kz,k,kp,nage)= &
+             flux(5,ixave,jyave,kz,k,kp,nage)+ &
+             part(jpart)%mass(k)
+#endif
+      end do
+      do kz=k2,k1-1
+#ifdef _OPENMP
+        flux_omp(6,ixave,jyave,kz,k,kp,nage,thread)= &
+             flux_omp(6,ixave,jyave,kz,k,kp,nage,thread)+ &
+             part(jpart)%mass(k)
+#else
+        flux(6,ixave,jyave,kz,k,kp,nage)= &
+             flux(6,ixave,jyave,kz,k,kp,nage)+ &
+             part(jpart)%mass(k)
+#endif
+      end do
+    end do
+  endif
+
+
+  ! Determine west-east fluxes (fluxw) and east-west fluxes (fluxe)
+  !****************************************************************
+
+  if ((kzave.le.numzgrid).and.(jyave.ge.0).and. &
+       (jyave.le.numygrid-1)) then
+
+  ! 1) Particle does not cross domain boundary
+
+    if (abs(xold-part(jpart)%xlon).lt.real(nx)/2.) then
+      ix1=int((xold*dx+xoutshift)/dxout+0.5)
+      ix2=int((part(jpart)%xlon*dx+xoutshift)/dxout+0.5)
+      do k=1,nspec
+        do ix=ix1,ix2-1
+          if ((ix.ge.0).and.(ix.le.numxgrid-1)) then
+#ifdef _OPENMP
+            flux_omp(1,ix,jyave,kzave,k,kp,nage,thread)= &
+                 flux_omp(1,ix,jyave,kzave,k,kp,nage,thread) &
+                 +part(jpart)%mass(k)
+#else
+            flux(1,ix,jyave,kzave,k,kp,nage)= &
+                 flux(1,ix,jyave,kzave,k,kp,nage) &
+                 +part(jpart)%mass(k)
+#endif
+          endif
+        end do
+        do ix=ix2,ix1-1
+          if ((ix.ge.0).and.(ix.le.numxgrid-1)) then
+#ifdef _OPENMP
+            flux_omp(2,ix,jyave,kzave,k,kp,nage,thread)= &
+                 flux_omp(2,ix,jyave,kzave,k,kp,nage,thread) &
+                 +part(jpart)%mass(k)
+#else
+            flux(2,ix,jyave,kzave,k,kp,nage)= &
+                 flux(2,ix,jyave,kzave,k,kp,nage) &
+                 +part(jpart)%mass(k)
+#endif
+          endif
+        end do
+      end do
+
+  ! 2) Particle crosses domain boundary: use cyclic boundary condition
+  !    and attribute flux to easternmost grid row only (approximation valid
+  !    for relatively slow motions compared to output grid cell size)
+
+    else
+      ixs=int(((real(nxmin1)-1.e5)*dx+xoutshift)/dxout)
+      if ((ixs.ge.0).and.(ixs.le.numxgrid-1)) then
+        if (xold.gt.part(jpart)%xlon) then       ! west-east flux
+          do k=1,nspec
+#ifdef _OPENMP
+            flux_omp(1,ixs,jyave,kzave,k,kp,nage,thread)= &
+                 flux_omp(1,ixs,jyave,kzave,k,kp,nage,thread) &
+                 +part(jpart)%mass(k)
+#else
+            flux(1,ixs,jyave,kzave,k,kp,nage)= &
+                 flux(1,ixs,jyave,kzave,k,kp,nage) &
+                 +part(jpart)%mass(k)
+#endif
+          end do
+        else                                 ! east-west flux
+          do k=1,nspec
+#ifdef _OPENMP
+            flux_omp(2,ixs,jyave,kzave,k,kp,nage,thread)= &
+                 flux_omp(2,ixs,jyave,kzave,k,kp,nage,thread) &
+                 +part(jpart)%mass(k)
+#else
+            flux(2,ixs,jyave,kzave,k,kp,nage)= &
+                 flux(2,ixs,jyave,kzave,k,kp,nage) &
+                 +part(jpart)%mass(k)
+#endif
+          end do
+        endif
+      endif
+    endif
+  endif
+
+
+  ! Determine south-north fluxes (fluxs) and north-south fluxes (fluxn)
+  !********************************************************************
+
+  if ((kzave.le.numzgrid).and.(ixave.ge.0).and. &
+       (ixave.le.numxgrid-1)) then
+    jy1=int((yold*dy+youtshift)/dyout+0.5)
+    jy2=int((part(jpart)%ylat*dy+youtshift)/dyout+0.5)
+
+    do k=1,nspec
+      do jy=jy1,jy2-1
+        if ((jy.ge.0).and.(jy.le.numygrid-1)) then
+#ifdef _OPENMP
+          flux_omp(3,ixave,jy,kzave,k,kp,nage,thread)= &
+               flux_omp(3,ixave,jy,kzave,k,kp,nage,thread) &
+               +part(jpart)%mass(k)
+#else
+          flux(3,ixave,jy,kzave,k,kp,nage)= &
+               flux(3,ixave,jy,kzave,k,kp,nage) &
+               +part(jpart)%mass(k)
+#endif
+        endif
+      end do
+      do jy=jy2,jy1-1
+        if ((jy.ge.0).and.(jy.le.numygrid-1)) then
+#ifdef _OPENMP
+          flux_omp(4,ixave,jy,kzave,k,kp,nage,thread)= &
+               flux_omp(4,ixave,jy,kzave,k,kp,nage,thread) &
+               +part(jpart)%mass(k)
+#else
+          flux(4,ixave,jy,kzave,k,kp,nage)= &
+               flux(4,ixave,jy,kzave,k,kp,nage) &
+               +part(jpart)%mass(k)
+#endif
+        endif
+      end do
+    end do
+  endif
+end subroutine calcfluxes
diff --git a/src/flu_fluxoutput.f90 b/src/flu_fluxoutput.f90
new file mode 100644
index 0000000000000000000000000000000000000000..8bdcb0e8a006f1c0a0f1e827627527ec5c31dc60
--- /dev/null
+++ b/src/flu_fluxoutput.f90
@@ -0,0 +1,303 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine fluxoutput(itime)
+  !                        i
+  !*****************************************************************************
+  !                                                                            *
+  !     Output of the gridded fluxes.                                          *
+  !     Eastward, westward, northward, southward, upward and downward gross    *
+  !     fluxes are written to output file in either sparse matrix or grid dump *
+  !     format, whichever is more efficient.                                   *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     04 April 2000                                                          *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! ncellse         number of cells with non-zero values for eastward fluxes   *
+  ! sparsee         .true. if in sparse matrix format, else .false.            *
+  !                                                                            *
+  !*****************************************************************************
+  use date_mod
+
+  implicit none
+
+  real(kind=dp) :: jul
+  integer :: itime,ix,jy,kz,k,nage,jjjjmmdd,ihmmss,kp,i
+  integer :: ncellse(maxspec,maxageclass),ncellsw(maxspec,maxageclass)
+  integer :: ncellss(maxspec,maxageclass),ncellsn(maxspec,maxageclass)
+  integer :: ncellsu(maxspec,maxageclass),ncellsd(maxspec,maxageclass)
+  logical :: sparsee(maxspec,maxageclass),sparsew(maxspec,maxageclass)
+  logical :: sparses(maxspec,maxageclass),sparsen(maxspec,maxageclass)
+  logical :: sparseu(maxspec,maxageclass),sparsed(maxspec,maxageclass)
+  character :: adate*8,atime*6
+
+
+  ! Determine current calendar date, needed for the file name
+  !**********************************************************
+
+  jul=bdate+real(itime,kind=dp)/86400._dp
+  call caldate(jul,jjjjmmdd,ihmmss)
+  write(adate,'(i8.8)') jjjjmmdd
+  write(atime,'(i6.6)') ihmmss
+
+
+  open(unitflux,file=path(2)(1:length(2))//'grid_flux_'//adate// &
+       atime,form='unformatted')
+
+  !**************************************************************
+  ! Check, whether output of full grid or sparse matrix format is
+  ! more efficient in terms of storage space. This is checked for
+  ! every species and for every age class
+  !**************************************************************
+
+  do k=1,nspec
+    do nage=1,nageclass
+      ncellse(k,nage)=0
+      ncellsw(k,nage)=0
+      ncellsn(k,nage)=0
+      ncellss(k,nage)=0
+      ncellsu(k,nage)=0
+      ncellsd(k,nage)=0
+    end do
+  end do
+
+  do k=1,nspec
+  do kp=1,maxpointspec_act
+    do nage=1,nageclass
+      do jy=0,numygrid-1
+        do ix=0,numxgrid-1
+          do kz=1,numzgrid
+            if (flux(2,ix,jy,kz,k,kp,nage).gt.0) ncellse(k,nage)= &
+                 ncellse(k,nage)+1
+            if (flux(1,ix,jy,kz,k,kp,nage).gt.0) ncellsw(k,nage)= &
+                 ncellsw(k,nage)+1
+            if (flux(4,ix,jy,kz,k,kp,nage).gt.0) ncellsn(k,nage)= &
+                 ncellsn(k,nage)+1
+            if (flux(3,ix,jy,kz,k,kp,nage).gt.0) ncellss(k,nage)= &
+                 ncellss(k,nage)+1
+            if (flux(5,ix,jy,kz,k,kp,nage).gt.0) ncellsu(k,nage)= &
+                 ncellsu(k,nage)+1
+            if (flux(6,ix,jy,kz,k,kp,nage).gt.0) ncellsd(k,nage)= &
+                 ncellsd(k,nage)+1
+          end do
+        end do
+      end do
+    end do
+  end do
+  end do
+
+  ! Output in sparse matrix format more efficient, if less than
+  ! 2/5 of all cells contains concentrations>0
+  !************************************************************
+
+  do k=1,nspec
+    do nage=1,nageclass
+      if (4*ncellse(k,nage).lt.numxgrid*numygrid*numzgrid) then
+        sparsee(k,nage)=.true.
+      else
+        sparsee(k,nage)=.false.
+      endif
+      if (4*ncellsw(k,nage).lt.numxgrid*numygrid*numzgrid) then
+        sparsew(k,nage)=.true.
+      else
+        sparsew(k,nage)=.false.
+      endif
+      if (4*ncellsn(k,nage).lt.numxgrid*numygrid*numzgrid) then
+        sparsen(k,nage)=.true.
+      else
+        sparsen(k,nage)=.false.
+      endif
+      if (4*ncellss(k,nage).lt.numxgrid*numygrid*numzgrid) then
+        sparses(k,nage)=.true.
+      else
+        sparses(k,nage)=.false.
+      endif
+      if (4*ncellsu(k,nage).lt.numxgrid*numygrid*numzgrid) then
+        sparseu(k,nage)=.true.
+      else
+        sparseu(k,nage)=.false.
+      endif
+      if (4*ncellsd(k,nage).lt.numxgrid*numygrid*numzgrid) then
+        sparsed(k,nage)=.true.
+      else
+        sparsed(k,nage)=.false.
+      endif
+    end do
+  end do
+
+
+
+  ! Flux output: divide by area and time to get flux in ng/m2/s
+  !************************************************************
+
+  write(unitflux) itime
+  do k=1,nspec
+  do kp=1,maxpointspec_act
+    do nage=1,nageclass
+
+      if (sparsee(k,nage)) then
+        write(unitflux) 1
+        do kz=1,numzgrid
+          do jy=0,numygrid-1
+            do ix=0,numxgrid-1
+              if (flux(2,ix,jy,kz,k,kp,nage).gt.0.) write(unitflux) &
+                   ix+jy*numxgrid+kz*numxgrid*numygrid,1.e12* &
+                   flux(2,ix,jy,kz,k,kp,nage)/areaeast(ix,jy,kz)/outstep
+            end do
+          end do
+        end do
+        write(unitflux) -999,999.
+      else
+        write(unitflux) 2
+        do kz=1,numzgrid
+          do ix=0,numxgrid-1
+            write(unitflux) (1.e12*flux(2,ix,jy,kz,k,kp,nage)/ &
+                 areaeast(ix,jy,kz)/outstep,jy=0,numygrid-1)
+          end do
+        end do
+      endif
+
+      if (sparsew(k,nage)) then
+        write(unitflux) 1
+        do kz=1,numzgrid
+          do jy=0,numygrid-1
+            do ix=0,numxgrid-1
+              if (flux(1,ix,jy,kz,k,kp,nage).gt.0.) write(unitflux) &
+                   ix+jy*numxgrid+kz*numxgrid*numygrid,1.e12* &
+                   flux(1,ix,jy,kz,k,kp,nage)/areaeast(ix,jy,kz)/outstep
+            end do
+          end do
+        end do
+        write(unitflux) -999,999.
+      else
+        write(unitflux) 2
+        do kz=1,numzgrid
+          do ix=0,numxgrid-1
+            write(unitflux) (1.e12*flux(1,ix,jy,kz,k,kp,nage)/ &
+                 areaeast(ix,jy,kz)/outstep,jy=0,numygrid-1)
+          end do
+        end do
+      endif
+
+      if (sparses(k,nage)) then
+        write(unitflux) 1
+        do kz=1,numzgrid
+          do jy=0,numygrid-1
+            do ix=0,numxgrid-1
+              if (flux(3,ix,jy,kz,k,kp,nage).gt.0.) write(unitflux) &
+                   ix+jy*numxgrid+kz*numxgrid*numygrid,1.e12* &
+                   flux(3,ix,jy,kz,k,kp,nage)/areanorth(ix,jy,kz)/outstep
+            end do
+          end do
+        end do
+        write(unitflux) -999,999.
+      else
+        write(unitflux) 2
+        do kz=1,numzgrid
+          do ix=0,numxgrid-1
+            write(unitflux) (1.e12*flux(3,ix,jy,kz,k,kp,nage)/ &
+                 areanorth(ix,jy,kz)/outstep,jy=0,numygrid-1)
+          end do
+        end do
+      endif
+
+      if (sparsen(k,nage)) then
+        write(unitflux) 1
+        do kz=1,numzgrid
+          do jy=0,numygrid-1
+            do ix=0,numxgrid-1 ! north
+              if (flux(4,ix,jy,kz,k,kp,nage).gt.0.) write(unitflux) &
+                   ix+jy*numxgrid+kz*numxgrid*numygrid,1.e12* &
+                   flux(4,ix,jy,kz,k,kp,nage)/areanorth(ix,jy,kz)/outstep
+            end do
+          end do
+        end do
+        write(unitflux) -999,999.
+      else
+        write(unitflux) 2
+        do kz=1,numzgrid
+          do ix=0,numxgrid-1
+            write(unitflux) (1.e12*flux(4,ix,jy,kz,k,kp,nage)/ &
+                 areanorth(ix,jy,kz)/outstep,jy=0,numygrid-1)
+          end do
+        end do
+      endif
+
+      if (sparseu(k,nage)) then
+        write(unitflux) 1
+        do kz=1,numzgrid
+          do jy=0,numygrid-1
+            do ix=0,numxgrid-1
+              if (flux(5,ix,jy,kz,k,kp,nage).gt.0.) write(unitflux) &
+                   ix+jy*numxgrid+kz*numxgrid*numygrid,1.e12* &
+                   flux(5,ix,jy,kz,k,kp,nage)/area(ix,jy)/outstep
+            end do
+          end do
+        end do
+        write(unitflux) -999,999.
+      else
+        write(unitflux) 2
+        do kz=1,numzgrid
+          do ix=0,numxgrid-1
+            write(unitflux) (1.e12*flux(5,ix,jy,kz,k,kp,nage)/ &
+                 area(ix,jy)/outstep,jy=0,numygrid-1)
+          end do
+        end do
+      endif
+
+      if (sparsed(k,nage)) then
+        write(unitflux) 1
+        do kz=1,numzgrid
+          do jy=0,numygrid-1
+            do ix=0,numxgrid-1
+              if (flux(6,ix,jy,kz,k,kp,nage).gt.0.) write(unitflux) &
+                   ix+jy*numxgrid+kz*numxgrid*numygrid,1.e12* &
+                   flux(6,ix,jy,kz,k,kp,nage)/area(ix,jy)/outstep
+            end do
+          end do
+        end do
+        write(unitflux) -999,999.
+      else
+        write(unitflux) 2
+        do kz=1,numzgrid
+          do ix=0,numxgrid-1
+            write(unitflux) (1.e12*flux(6,ix,jy,kz,k,kp,nage)/ &
+                 area(ix,jy)/outstep,jy=0,numygrid-1)
+          end do
+        end do
+      endif
+
+    end do
+  end do
+  end do
+
+
+  close(unitflux)
+
+  write(*,*) 'Flux:', itime, flux(:,1,1,1,1,1,1)
+  ! Reinitialization of grid
+  !*************************
+
+  do k=1,nspec
+  do kp=1,maxpointspec_act
+    do jy=0,numygrid-1
+      do ix=0,numxgrid-1
+          do kz=1,numzgrid
+            do nage=1,nageclass
+              do i=1,6
+                flux(i,ix,jy,kz,k,kp,nage)=0.
+#ifdef _OPENMP
+                flux_omp(i,ix,jy,kz,k,kp,nage,:)=0.
+#endif
+              end do
+            end do
+          end do
+      end do
+    end do
+  end do
+  end do
+end subroutine fluxoutput
diff --git a/src/flux_mod.f90 b/src/flux_mod.f90
index 10e52511388fe778300c9bdac181d35144105cbc..699a3c1be449d7e4f2da0dc1baa772be6f70adb1 100644
--- a/src/flux_mod.f90
+++ b/src/flux_mod.f90
@@ -14,7 +14,7 @@ module flux_mod
   implicit none
 
   !Moved to prepoutgrid_mod, because of dependencies
-  ! real,allocatable, dimension (:,:,:,:,:,:,:) :: flux 
+  ! real,allocatable, dimension (:,:,:,:,:,:,:) :: flux
 
   !1 fluxw west - east
   !2 fluxe east - west
@@ -27,519 +27,8 @@ module flux_mod
 
 contains
 
-subroutine calcfluxes(itime,nage,jpart,xold,yold,zold,thread)
-  !                       i     i    i    i    i
-  !*****************************************************************************
-  !                                                                            *
-  !     Calculation of the gross fluxes across horizontal, eastward and        *
-  !     northward facing surfaces. The routine calculates the mass flux        *
-  !     due to the motion of only one particle. The fluxes of subsequent calls *
-  !     to this subroutine are accumulated until the next output is due.       *
-  !     Upon output, flux fields are re-set to zero in subroutine fluxoutput.f.*
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     04 April 2000                                                          *
-  !                                                                            *
-  !     Changes                                                                *
-  !        2021 L. Bakels: OpenMP parallelisation                              *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  !                                                                            *
-  ! nage                  Age class of the particle considered                 *
-  ! jpart                 Index of the particle considered                     *
-  ! xold,yold,zold        "Memorized" old positions of the particle            *
-  !                                                                            *
-  !*****************************************************************************
-  
-  use particle_mod
-  use coord_ec_mod
+#include "flu_calcfluxes.f90"
 
-  implicit none
-  integer, intent(in) :: thread ! for OMP, number of thread
-  integer :: itime,jpart,nage,ixave,jyave,kz,kzave,kp
-  integer :: k,k1,k2,ix,ix1,ix2,ixs,jy,jy1,jy2
-  real :: xold,yold,zold,xmean,ymean
-
-
-  ! Determine average positions
-  !****************************
-
-  if ((ioutputforeachrelease.eq.1).and.(mdomainfill.eq.0)) then
-     kp=part(jpart)%npoint
-  else
-     kp=1
-  endif
-  call update_zeta_to_z(itime,jpart)
-  xmean=(xold+part(jpart)%xlon)/2.
-  ymean=(yold+part(jpart)%ylat)/2.
-
-  ixave=int((xmean*dx+xoutshift)/dxout)
-  jyave=int((ymean*dy+youtshift)/dyout)
-  do kz=1,numzgrid                ! determine height of cell
-    if (outheight(kz).gt.part(jpart)%z) exit
-  end do
-  kzave=kz
-
-
-  ! Determine vertical fluxes
-  !**************************
-
-  if ((ixave.ge.0).and.(jyave.ge.0).and.(ixave.le.numxgrid-1).and. &
-       (jyave.le.numygrid-1)) then
-    do kz=1,numzgrid                ! determine height of cell
-      if (outheighthalf(kz).gt.zold) exit
-    end do
-    k1=min(numzgrid,kz)
-    do kz=1,numzgrid                ! determine height of cell
-      if (outheighthalf(kz).gt.part(jpart)%z) exit
-    end do
-    k2=min(numzgrid,kz)
-
-    do k=1,nspec
-      do kz=k1,k2-1
-#ifdef _OPENMP
-        flux_omp(5,ixave,jyave,kz,k,kp,nage,thread)= &
-             flux_omp(5,ixave,jyave,kz,k,kp,nage,thread)+ &
-             part(jpart)%mass(k)
-#else
-        flux(5,ixave,jyave,kz,k,kp,nage)= &
-             flux(5,ixave,jyave,kz,k,kp,nage)+ &
-             part(jpart)%mass(k)
-#endif
-      end do
-      do kz=k2,k1-1
-#ifdef _OPENMP
-        flux_omp(6,ixave,jyave,kz,k,kp,nage,thread)= &
-             flux_omp(6,ixave,jyave,kz,k,kp,nage,thread)+ &
-             part(jpart)%mass(k)
-#else
-        flux(6,ixave,jyave,kz,k,kp,nage)= &
-             flux(6,ixave,jyave,kz,k,kp,nage)+ &
-             part(jpart)%mass(k)
-#endif
-      end do
-    end do
-  endif
-
-
-  ! Determine west-east fluxes (fluxw) and east-west fluxes (fluxe)
-  !****************************************************************
-
-  if ((kzave.le.numzgrid).and.(jyave.ge.0).and. &
-       (jyave.le.numygrid-1)) then
-
-  ! 1) Particle does not cross domain boundary
-
-    if (abs(xold-part(jpart)%xlon).lt.real(nx)/2.) then
-      ix1=int((xold*dx+xoutshift)/dxout+0.5)
-      ix2=int((part(jpart)%xlon*dx+xoutshift)/dxout+0.5)
-      do k=1,nspec
-        do ix=ix1,ix2-1
-          if ((ix.ge.0).and.(ix.le.numxgrid-1)) then
-#ifdef _OPENMP
-            flux_omp(1,ix,jyave,kzave,k,kp,nage,thread)= &
-                 flux_omp(1,ix,jyave,kzave,k,kp,nage,thread) &
-                 +part(jpart)%mass(k)
-#else
-            flux(1,ix,jyave,kzave,k,kp,nage)= &
-                 flux(1,ix,jyave,kzave,k,kp,nage) &
-                 +part(jpart)%mass(k)
-#endif
-          endif
-        end do
-        do ix=ix2,ix1-1
-          if ((ix.ge.0).and.(ix.le.numxgrid-1)) then
-#ifdef _OPENMP
-            flux_omp(2,ix,jyave,kzave,k,kp,nage,thread)= &
-                 flux_omp(2,ix,jyave,kzave,k,kp,nage,thread) &
-                 +part(jpart)%mass(k)
-#else
-            flux(2,ix,jyave,kzave,k,kp,nage)= &
-                 flux(2,ix,jyave,kzave,k,kp,nage) &
-                 +part(jpart)%mass(k)
-#endif
-          endif
-        end do
-      end do
-
-  ! 2) Particle crosses domain boundary: use cyclic boundary condition
-  !    and attribute flux to easternmost grid row only (approximation valid
-  !    for relatively slow motions compared to output grid cell size)
-
-    else
-      ixs=int(((real(nxmin1)-1.e5)*dx+xoutshift)/dxout)
-      if ((ixs.ge.0).and.(ixs.le.numxgrid-1)) then
-        if (xold.gt.part(jpart)%xlon) then       ! west-east flux
-          do k=1,nspec
-#ifdef _OPENMP
-            flux_omp(1,ixs,jyave,kzave,k,kp,nage,thread)= &
-                 flux_omp(1,ixs,jyave,kzave,k,kp,nage,thread) &
-                 +part(jpart)%mass(k)
-#else
-            flux(1,ixs,jyave,kzave,k,kp,nage)= &
-                 flux(1,ixs,jyave,kzave,k,kp,nage) &
-                 +part(jpart)%mass(k)
-#endif
-          end do
-        else                                 ! east-west flux
-          do k=1,nspec
-#ifdef _OPENMP
-            flux_omp(2,ixs,jyave,kzave,k,kp,nage,thread)= &
-                 flux_omp(2,ixs,jyave,kzave,k,kp,nage,thread) &
-                 +part(jpart)%mass(k)
-#else
-            flux(2,ixs,jyave,kzave,k,kp,nage)= &
-                 flux(2,ixs,jyave,kzave,k,kp,nage) &
-                 +part(jpart)%mass(k)
-#endif
-          end do
-        endif
-      endif
-    endif
-  endif
-
-
-  ! Determine south-north fluxes (fluxs) and north-south fluxes (fluxn)
-  !********************************************************************
-
-  if ((kzave.le.numzgrid).and.(ixave.ge.0).and. &
-       (ixave.le.numxgrid-1)) then
-    jy1=int((yold*dy+youtshift)/dyout+0.5)
-    jy2=int((part(jpart)%ylat*dy+youtshift)/dyout+0.5)
-
-    do k=1,nspec
-      do jy=jy1,jy2-1
-        if ((jy.ge.0).and.(jy.le.numygrid-1)) then
-#ifdef _OPENMP
-          flux_omp(3,ixave,jy,kzave,k,kp,nage,thread)= &
-               flux_omp(3,ixave,jy,kzave,k,kp,nage,thread) &
-               +part(jpart)%mass(k)
-#else
-          flux(3,ixave,jy,kzave,k,kp,nage)= &
-               flux(3,ixave,jy,kzave,k,kp,nage) &
-               +part(jpart)%mass(k)
-#endif
-        endif
-      end do
-      do jy=jy2,jy1-1
-        if ((jy.ge.0).and.(jy.le.numygrid-1)) then
-#ifdef _OPENMP
-          flux_omp(4,ixave,jy,kzave,k,kp,nage,thread)= &
-               flux_omp(4,ixave,jy,kzave,k,kp,nage,thread) &
-               +part(jpart)%mass(k)
-#else
-          flux(4,ixave,jy,kzave,k,kp,nage)= &
-               flux(4,ixave,jy,kzave,k,kp,nage) &
-               +part(jpart)%mass(k)
-#endif
-        endif
-      end do
-    end do
-  endif
-end subroutine calcfluxes
-
-subroutine fluxoutput(itime)
-  !                        i
-  !*****************************************************************************
-  !                                                                            *
-  !     Output of the gridded fluxes.                                          *
-  !     Eastward, westward, northward, southward, upward and downward gross    *
-  !     fluxes are written to output file in either sparse matrix or grid dump *
-  !     format, whichever is more efficient.                                   *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     04 April 2000                                                          *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! ncellse         number of cells with non-zero values for eastward fluxes   *
-  ! sparsee         .true. if in sparse matrix format, else .false.            *
-  !                                                                            *
-  !*****************************************************************************
-  use date_mod
-  
-  implicit none
-
-  real(kind=dp) :: jul
-  integer :: itime,ix,jy,kz,k,nage,jjjjmmdd,ihmmss,kp,i
-  integer :: ncellse(maxspec,maxageclass),ncellsw(maxspec,maxageclass)
-  integer :: ncellss(maxspec,maxageclass),ncellsn(maxspec,maxageclass)
-  integer :: ncellsu(maxspec,maxageclass),ncellsd(maxspec,maxageclass)
-  logical :: sparsee(maxspec,maxageclass),sparsew(maxspec,maxageclass)
-  logical :: sparses(maxspec,maxageclass),sparsen(maxspec,maxageclass)
-  logical :: sparseu(maxspec,maxageclass),sparsed(maxspec,maxageclass)
-  character :: adate*8,atime*6
-
-
-  ! Determine current calendar date, needed for the file name
-  !**********************************************************
-
-  jul=bdate+real(itime,kind=dp)/86400._dp
-  call caldate(jul,jjjjmmdd,ihmmss)
-  write(adate,'(i8.8)') jjjjmmdd
-  write(atime,'(i6.6)') ihmmss
-
-
-  open(unitflux,file=path(2)(1:length(2))//'grid_flux_'//adate// &
-       atime,form='unformatted')
-
-  !**************************************************************
-  ! Check, whether output of full grid or sparse matrix format is
-  ! more efficient in terms of storage space. This is checked for
-  ! every species and for every age class
-  !**************************************************************
-
-  do k=1,nspec
-    do nage=1,nageclass
-      ncellse(k,nage)=0
-      ncellsw(k,nage)=0
-      ncellsn(k,nage)=0
-      ncellss(k,nage)=0
-      ncellsu(k,nage)=0
-      ncellsd(k,nage)=0
-    end do
-  end do
-
-  do k=1,nspec
-  do kp=1,maxpointspec_act
-    do nage=1,nageclass
-      do jy=0,numygrid-1
-        do ix=0,numxgrid-1
-          do kz=1,numzgrid
-            if (flux(2,ix,jy,kz,k,kp,nage).gt.0) ncellse(k,nage)= &
-                 ncellse(k,nage)+1
-            if (flux(1,ix,jy,kz,k,kp,nage).gt.0) ncellsw(k,nage)= &
-                 ncellsw(k,nage)+1
-            if (flux(4,ix,jy,kz,k,kp,nage).gt.0) ncellsn(k,nage)= &
-                 ncellsn(k,nage)+1
-            if (flux(3,ix,jy,kz,k,kp,nage).gt.0) ncellss(k,nage)= &
-                 ncellss(k,nage)+1
-            if (flux(5,ix,jy,kz,k,kp,nage).gt.0) ncellsu(k,nage)= &
-                 ncellsu(k,nage)+1
-            if (flux(6,ix,jy,kz,k,kp,nage).gt.0) ncellsd(k,nage)= &
-                 ncellsd(k,nage)+1
-          end do
-        end do
-      end do
-    end do
-  end do
-  end do
-
-  ! Output in sparse matrix format more efficient, if less than
-  ! 2/5 of all cells contains concentrations>0
-  !************************************************************
-
-  do k=1,nspec
-    do nage=1,nageclass
-      if (4*ncellse(k,nage).lt.numxgrid*numygrid*numzgrid) then
-        sparsee(k,nage)=.true.
-      else
-        sparsee(k,nage)=.false.
-      endif
-      if (4*ncellsw(k,nage).lt.numxgrid*numygrid*numzgrid) then
-        sparsew(k,nage)=.true.
-      else
-        sparsew(k,nage)=.false.
-      endif
-      if (4*ncellsn(k,nage).lt.numxgrid*numygrid*numzgrid) then
-        sparsen(k,nage)=.true.
-      else
-        sparsen(k,nage)=.false.
-      endif
-      if (4*ncellss(k,nage).lt.numxgrid*numygrid*numzgrid) then
-        sparses(k,nage)=.true.
-      else
-        sparses(k,nage)=.false.
-      endif
-      if (4*ncellsu(k,nage).lt.numxgrid*numygrid*numzgrid) then
-        sparseu(k,nage)=.true.
-      else
-        sparseu(k,nage)=.false.
-      endif
-      if (4*ncellsd(k,nage).lt.numxgrid*numygrid*numzgrid) then
-        sparsed(k,nage)=.true.
-      else
-        sparsed(k,nage)=.false.
-      endif
-    end do
-  end do
-
-
-
-  ! Flux output: divide by area and time to get flux in ng/m2/s
-  !************************************************************
-
-  write(unitflux) itime
-  do k=1,nspec
-  do kp=1,maxpointspec_act
-    do nage=1,nageclass
-
-      if (sparsee(k,nage)) then
-        write(unitflux) 1
-        do kz=1,numzgrid
-          do jy=0,numygrid-1
-            do ix=0,numxgrid-1
-              if (flux(2,ix,jy,kz,k,kp,nage).gt.0.) write(unitflux) &
-                   ix+jy*numxgrid+kz*numxgrid*numygrid,1.e12* &
-                   flux(2,ix,jy,kz,k,kp,nage)/areaeast(ix,jy,kz)/outstep
-            end do
-          end do
-        end do
-        write(unitflux) -999,999.
-      else
-        write(unitflux) 2
-        do kz=1,numzgrid
-          do ix=0,numxgrid-1
-            write(unitflux) (1.e12*flux(2,ix,jy,kz,k,kp,nage)/ &
-                 areaeast(ix,jy,kz)/outstep,jy=0,numygrid-1)
-          end do
-        end do
-      endif
-
-      if (sparsew(k,nage)) then
-        write(unitflux) 1
-        do kz=1,numzgrid
-          do jy=0,numygrid-1
-            do ix=0,numxgrid-1
-              if (flux(1,ix,jy,kz,k,kp,nage).gt.0.) write(unitflux) &
-                   ix+jy*numxgrid+kz*numxgrid*numygrid,1.e12* &
-                   flux(1,ix,jy,kz,k,kp,nage)/areaeast(ix,jy,kz)/outstep
-            end do
-          end do
-        end do
-        write(unitflux) -999,999.
-      else
-        write(unitflux) 2
-        do kz=1,numzgrid
-          do ix=0,numxgrid-1
-            write(unitflux) (1.e12*flux(1,ix,jy,kz,k,kp,nage)/ &
-                 areaeast(ix,jy,kz)/outstep,jy=0,numygrid-1)
-          end do
-        end do
-      endif
-
-      if (sparses(k,nage)) then
-        write(unitflux) 1
-        do kz=1,numzgrid
-          do jy=0,numygrid-1
-            do ix=0,numxgrid-1
-              if (flux(3,ix,jy,kz,k,kp,nage).gt.0.) write(unitflux) &
-                   ix+jy*numxgrid+kz*numxgrid*numygrid,1.e12* &
-                   flux(3,ix,jy,kz,k,kp,nage)/areanorth(ix,jy,kz)/outstep
-            end do
-          end do
-        end do
-        write(unitflux) -999,999.
-      else
-        write(unitflux) 2
-        do kz=1,numzgrid
-          do ix=0,numxgrid-1
-            write(unitflux) (1.e12*flux(3,ix,jy,kz,k,kp,nage)/ &
-                 areanorth(ix,jy,kz)/outstep,jy=0,numygrid-1)
-          end do
-        end do
-      endif
-
-      if (sparsen(k,nage)) then
-        write(unitflux) 1
-        do kz=1,numzgrid
-          do jy=0,numygrid-1
-            do ix=0,numxgrid-1 ! north
-              if (flux(4,ix,jy,kz,k,kp,nage).gt.0.) write(unitflux) &
-                   ix+jy*numxgrid+kz*numxgrid*numygrid,1.e12* &
-                   flux(4,ix,jy,kz,k,kp,nage)/areanorth(ix,jy,kz)/outstep
-            end do
-          end do
-        end do
-        write(unitflux) -999,999.
-      else
-        write(unitflux) 2
-        do kz=1,numzgrid
-          do ix=0,numxgrid-1
-            write(unitflux) (1.e12*flux(4,ix,jy,kz,k,kp,nage)/ &
-                 areanorth(ix,jy,kz)/outstep,jy=0,numygrid-1)
-          end do
-        end do
-      endif
-
-      if (sparseu(k,nage)) then
-        write(unitflux) 1
-        do kz=1,numzgrid
-          do jy=0,numygrid-1
-            do ix=0,numxgrid-1
-              if (flux(5,ix,jy,kz,k,kp,nage).gt.0.) write(unitflux) &
-                   ix+jy*numxgrid+kz*numxgrid*numygrid,1.e12* &
-                   flux(5,ix,jy,kz,k,kp,nage)/area(ix,jy)/outstep
-            end do
-          end do
-        end do
-        write(unitflux) -999,999.
-      else
-        write(unitflux) 2
-        do kz=1,numzgrid
-          do ix=0,numxgrid-1
-            write(unitflux) (1.e12*flux(5,ix,jy,kz,k,kp,nage)/ &
-                 area(ix,jy)/outstep,jy=0,numygrid-1)
-          end do
-        end do
-      endif
-
-      if (sparsed(k,nage)) then
-        write(unitflux) 1
-        do kz=1,numzgrid
-          do jy=0,numygrid-1
-            do ix=0,numxgrid-1
-              if (flux(6,ix,jy,kz,k,kp,nage).gt.0.) write(unitflux) &
-                   ix+jy*numxgrid+kz*numxgrid*numygrid,1.e12* &
-                   flux(6,ix,jy,kz,k,kp,nage)/area(ix,jy)/outstep
-            end do
-          end do
-        end do
-        write(unitflux) -999,999.
-      else
-        write(unitflux) 2
-        do kz=1,numzgrid
-          do ix=0,numxgrid-1
-            write(unitflux) (1.e12*flux(6,ix,jy,kz,k,kp,nage)/ &
-                 area(ix,jy)/outstep,jy=0,numygrid-1)
-          end do
-        end do
-      endif
-
-    end do
-  end do
-  end do
-
-
-  close(unitflux)
-
-  write(*,*) 'Flux:', itime, flux(:,1,1,1,1,1,1)
-  ! Reinitialization of grid
-  !*************************
-
-  do k=1,nspec
-  do kp=1,maxpointspec_act
-    do jy=0,numygrid-1
-      do ix=0,numxgrid-1
-          do kz=1,numzgrid
-            do nage=1,nageclass
-              do i=1,6
-                flux(i,ix,jy,kz,k,kp,nage)=0.
-#ifdef _OPENMP
-                flux_omp(i,ix,jy,kz,k,kp,nage,:)=0.
-#endif
-              end do
-            end do
-          end do
-      end do
-    end do
-  end do
-  end do
-end subroutine fluxoutput
+#include "flu_fluxoutput.f90"
 
 end module flux_mod
diff --git a/src/get_alloc_getfields.f90 b/src/get_alloc_getfields.f90
new file mode 100644
index 0000000000000000000000000000000000000000..c5d08776f0092d7f6c58156b3ff9cab86832c188
--- /dev/null
+++ b/src/get_alloc_getfields.f90
@@ -0,0 +1,18 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine alloc_getfields
+  implicit none
+  allocate(uuh(0:nxmax-1,0:nymax-1,nuvzmax),      &
+    vvh(0:nxmax-1,0:nymax-1,nuvzmax),             &
+    pvh(0:nxmax-1,0:nymax-1,nuvzmax),             &
+    wwh(0:nxmax-1,0:nymax-1,nwzmax),              &
+    uuhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests), &
+    vvhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests), &
+    pvhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests), &
+    wwhn(0:nxmaxn-1,0:nymaxn-1,nwzmax,maxnests),  &
+    pwater(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
+
+  allocate(ppml(0:nxmax-1,0:nymax-1,nuvzmax),ppmk(0:nxmax-1,0:nymax-1,nuvzmax))
+  allocate(ttlev(nuvzmax),qvlev(nuvzmax),ulev(nuvzmax),vlev(nuvzmax),zlev(nuvzmax))
+end subroutine alloc_getfields
diff --git a/src/get_calcpar.f90 b/src/get_calcpar.f90
new file mode 100644
index 0000000000000000000000000000000000000000..273549b542a0e19d66330f97454839f230eeb730
--- /dev/null
+++ b/src/get_calcpar.f90
@@ -0,0 +1,277 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine calcpar(n)
+  !                   i  i   i   o
+  !*****************************************************************************
+  !                                                                            *
+  !     Computation of several boundary layer parameters needed for the        *
+  !     dispersion calculation and calculation of dry deposition velocities.   *
+  !     All parameters are calculated over the entire grid.                    *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     21 May 1995                                                            *
+  !                                                                            *
+  ! ------------------------------------------------------------------         *
+  !     Petra Seibert, Feb 2000:                                               *
+  !     convection scheme:                                                     *
+  !     new variables in call to richardson                                    *
+  !                                                                            *
+  !   CHANGE 17/11/2005 Caroline Forster NCEP GFS version                      *
+  !                                                                            *
+  !   Changes, Bernd C. Krueger, Feb. 2001:                                    *
+  !    Variables tth and qvh (on eta coordinates) in common block              *
+  !                                                                            *
+  !   Unified ECMWF and GFS builds                                             *
+  !   Marian Harustak, 12.5.2017                                               *
+  !     - Merged calcpar and calcpar_gfs into one routine using if-then        *
+  !       for meteo-type dependent code                                        *
+  !*****************************************************************************
+
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! n                  temporal index for meteorological fields (1 to 3)       *
+  ! metdata_format     format of metdata (ecmwf/gfs)                           *
+  !                                                                            *
+  ! Constants:                                                                 *
+  !                                                                            *
+  !                                                                            *
+  ! Functions:                                                                 *
+  ! scalev             computation of ustar                                    *
+  ! obukhov            computatio of Obukhov length                            *
+  !                                                                            *
+  !*****************************************************************************
+
+  use class_gribfile_mod
+  use drydepo_mod, global_ol => ol
+  use qvsat_mod
+
+  implicit none
+
+  integer :: n,ix,jy,i,kz,lz,kzmin,llev,loop_start,ierr
+  real :: ol,hmixplus
+  real :: rh,subsceff,ylat
+  real :: altmin,tvold,pold,zold,pint,tv,hmixdummy,akzdummy
+  real :: vd(maxspec)
+  real :: z0_tmp(numclass) ! temporary variable for z0 (shared between OMP threads)
+  real,parameter :: const=r_air/ga
+
+  !write(*,*) 'in calcpar writting snowheight'
+  !***********************************
+  ! for test: write out snow depths
+
+  ! open(4,file='slandusetest',form='formatted')
+  ! do 5 ix=0,nxmin1
+  !5       write (4,*) (sd(ix,jy,1,n),jy=0,nymin1)
+  !  close(4)
+
+
+  ! Loop over entire grid
+  !**********************
+
+  ! openmp change
+  z0_tmp = z0
+  !$OMP PARALLEL PRIVATE(jy,ix,ulev,vlev,ttlev,qvlev,llev,ylat,ol,i,hmixplus, &
+  !$OMP subsceff,vd,kz,lz,zlev,rh,kzmin,pold,zold,tvold,pint,tv,loop_start,ierr, &
+  !$OMP altmin)
+  z0 = z0_tmp
+
+  !$OMP DO
+  do jy=0,nymin1
+
+  ! Set minimum height for tropopause
+  !**********************************
+
+    ylat=ylat0+real(jy)*dy
+    if ((ylat.ge.-20.).and.(ylat.le.20.)) then
+      altmin = 5000.
+    else
+      if ((ylat.gt.20.).and.(ylat.lt.40.)) then
+        altmin=2500.+(40.-ylat)*125.
+      else if ((ylat.gt.-40.).and.(ylat.lt.-20.)) then
+        altmin=2500.+(40.+ylat)*125.
+      else
+        altmin=2500.
+      endif
+    endif
+
+    do ix=0,nxmin1
+
+  ! 1) Calculation of friction velocity
+  !************************************
+
+      ustar(ix,jy,1,n)=scalev(ps(ix,jy,1,n),tt2(ix,jy,1,n), &
+           td2(ix,jy,1,n),sfcstress(ix,jy,1,n))
+      if (ustar(ix,jy,1,n).le.1.e-8) ustar(ix,jy,1,n)=1.e-8
+
+  ! 2) Calculation of inverse Obukhov length scale
+  !***********************************************
+
+      if (metdata_format.eq.GRIBFILE_CENTRE_NCEP) then
+        ! NCEP version: find first level above ground
+        llev = 0
+        do i=1,nuvz
+          if (ps(ix,jy,1,n).lt.akz(i)) llev=i
+        end do
+        llev = llev+1
+        if (llev.gt.nuvz) llev = nuvz-1
+        ! NCEP version
+
+        ! calculate inverse Obukhov length scale with tth(llev)
+        ol=obukhov(ps(ix,jy,1,n),tt2(ix,jy,1,n),td2(ix,jy,1,n), &
+          tth(ix,jy,llev,n),ustar(ix,jy,1,n),sshf(ix,jy,1,n), &
+          akm,bkm,akz(llev))
+      else
+        llev=0
+        ol=obukhov(ps(ix,jy,1,n),tt2(ix,jy,1,n),td2(ix,jy,1,n), &
+          tth(ix,jy,2,n),ustar(ix,jy,1,n),sshf(ix,jy,1,n),akm,bkm,akzdummy)
+      end if
+
+      if (ol.ne.0.) then
+        oli(ix,jy,1,n)=1./ol
+      else
+        oli(ix,jy,1,n)=99999.
+      endif
+
+
+  ! 3) Calculation of convective velocity scale and mixing height
+  !**************************************************************
+
+      do i=1,nuvz
+        ulev(i)=uuh(ix,jy,i)
+        vlev(i)=vvh(ix,jy,i)
+        ttlev(i)=tth(ix,jy,i,n)
+        qvlev(i)=qvh(ix,jy,i,n)
+      end do
+
+      if (metdata_format.eq.GRIBFILE_CENTRE_NCEP) then
+        ! NCEP version hmix has been read in in readwind.f, is therefore not calculated here
+      call richardson(ps(ix,jy,1,n),ustar(ix,jy,1,n),ttlev,qvlev, &
+           ulev,vlev,nuvz,akz,bkz,sshf(ix,jy,1,n),tt2(ix,jy,1,n), &
+             td2(ix,jy,1,n),hmixdummy,wstar(ix,jy,1,n),hmixplus,ierr)
+      else
+        call richardson(ps(ix,jy,1,n),ustar(ix,jy,1,n),ttlev,qvlev, &
+             ulev,vlev,nuvz,akz,bkz,sshf(ix,jy,1,n),tt2(ix,jy,1,n), &
+             td2(ix,jy,1,n),hmix(ix,jy,1,n),wstar(ix,jy,1,n),hmixplus,ierr)
+      end if
+
+      if (ierr.lt.0) then
+        write(*,9500) 'failure', ix, jy
+        stop
+      endif
+9500      format( 'calcpar - richardson ', a, ' - ix,jy=', 2i5 )
+
+      if(lsubgrid.eq.1) then
+        subsceff=min(excessoro(ix,jy),hmixplus)
+      else
+        subsceff=0.0
+      endif
+  !
+  ! CALCULATE HMIX EXCESS ACCORDING TO SUBGRIDSCALE VARIABILITY AND STABILITY
+  !
+      hmix(ix,jy,1,n)=hmix(ix,jy,1,n)+subsceff
+      hmix(ix,jy,1,n)=max(hmixmin,hmix(ix,jy,1,n)) ! set minimum PBL height
+      hmix(ix,jy,1,n)=min(hmixmax,hmix(ix,jy,1,n)) ! set maximum PBL height
+
+  ! 4) Calculation of dry deposition velocities
+  !********************************************
+
+      if (DRYDEP) then
+  ! Sabine Eckhardt, Dec 06: use new index for z0 for water depending on
+  ! windspeed
+        z0(7)=0.016*ustar(ix,jy,1,n)*ustar(ix,jy,1,n)/ga
+
+  ! Calculate relative humidity at surface
+  !***************************************
+        rh=ew(td2(ix,jy,1,n),ps(ix,jy,1,n))/ew(tt2(ix,jy,1,n),ps(ix,jy,1,n))
+
+        call getvdep(n,ix,jy,ustar(ix,jy,1,n), &
+             tt2(ix,jy,1,n),ps(ix,jy,1,n),1./oli(ix,jy,1,n), &
+             ssr(ix,jy,1,n),rh,lsprec(ix,jy,1,n)+convprec(ix,jy,1,n), &
+             sd(ix,jy,1,n),vd)
+
+        do i=1,nspec
+          vdep(ix,jy,i,n)=vd(i)
+        end do
+
+      endif
+
+  !******************************************************
+  ! Calculate height of thermal tropopause (Hoinka, 1997)
+  !******************************************************
+
+  ! 1) Calculate altitudes of model levels
+  !***************************************
+
+      tvold=tt2(ix,jy,1,n)*(1.+0.378*ew(td2(ix,jy,1,n),ps(ix,jy,1,n))/ &
+           ps(ix,jy,1,n))
+      pold=ps(ix,jy,1,n)
+      zold=0.
+      if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
+        loop_start=2
+      else
+        loop_start=llev
+      end if
+      do kz=loop_start,nuvz
+        pint=akz(kz)+bkz(kz)*ps(ix,jy,1,n)  ! pressure on model layers
+        tv=tth(ix,jy,kz,n)*(1.+0.608*qvh(ix,jy,kz,n))
+
+        if (abs(tv-tvold).gt.0.2) then
+          zlev(kz)=zold+const*log(pold/pint)*(tv-tvold)/log(tv/tvold)
+        else
+          zlev(kz)=zold+const*log(pold/pint)*tv
+        endif
+        tvold=tv
+        pold=pint
+        zold=zlev(kz)
+      end do
+
+  ! 2) Define a minimum level kzmin, from which upward the tropopause is
+  !    searched for. This is to avoid inversions in the lower troposphere
+  !    to be identified as the tropopause
+  !************************************************************************
+
+      if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
+        !LB, The CTM version has 2 (as bugfix), so I changed it 2 from 1 to try out
+        loop_start=2
+      else
+        loop_start=llev
+      end if
+
+      do kz=loop_start,nuvz
+        if (zlev(kz).ge.altmin) then
+          kzmin=kz
+          exit
+        endif
+      end do
+
+  ! 3) Search for first stable layer above minimum height that fulfills the
+  !    thermal tropopause criterion
+  !************************************************************************
+
+      outer: do kz=kzmin,nuvz
+        inner: do lz=kz+1,nuvz
+          if ((zlev(lz)-zlev(kz)).gt.2000.) then
+            if (((tth(ix,jy,kz,n)-tth(ix,jy,lz,n))/ &
+                 (zlev(lz)-zlev(kz))).lt.0.002) then
+              tropopause(ix,jy,1,n)=zlev(kz)
+              exit outer
+            endif
+            exit inner
+          endif
+        end do inner
+      end do outer
+
+    end do
+  end do
+  !$OMP END DO
+  !$OMP END PARALLEL
+  ! openmp change end
+
+  ! Calculation of potential vorticity on 3-d grid
+  !***********************************************
+
+  call calcpv(n)
+end subroutine calcpar
diff --git a/src/get_calcpar_nest.f90 b/src/get_calcpar_nest.f90
new file mode 100644
index 0000000000000000000000000000000000000000..d2efd7cf573c023d3208f4994c6b643591ad4dfa
--- /dev/null
+++ b/src/get_calcpar_nest.f90
@@ -0,0 +1,234 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine calcpar_nest(n)
+  !                         i  i    i    o
+  !*****************************************************************************
+  !                                                                            *
+  !     Computation of several boundary layer parameters needed for the        *
+  !     dispersion calculation and calculation of dry deposition velocities.   *
+  !     All parameters are calculated over the entire grid.                    *
+  !     This routine is similar to calcpar, but is used for the nested grids.  *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     8 February 1999                                                        *
+  !                                                                            *
+  ! ------------------------------------------------------------------         *
+  !     Petra Seibert, Feb 2000:                                               *
+  !     convection scheme:                                                     *
+  !     new variables in call to richardson                                    *
+  !                                                                            *
+  !*****************************************************************************
+  !  Changes, Bernd C. Krueger, Feb. 2001:                                     *
+  !   Variables tth and qvh (on eta coordinates) in common block               *
+  !                                                                            *
+  !   Unified ECMWF and GFS builds                                             *
+  !   Marian Harustak, 12.5.2017                                               *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! n                  temporal index for meteorological fields (1 to 3)       *
+  ! metdata_format     format of metdata (ecmwf/gfs)                           *
+  !                                                                            *
+  ! Constants:                                                                 *
+  !                                                                            *
+  !                                                                            *
+  ! Functions:                                                                 *
+  ! scalev             computation of ustar                                    *
+  ! obukhov            computatio of Obukhov length                            *
+  !                                                                            *
+  !*****************************************************************************
+
+  use drydepo_mod, global_ol => ol
+  use qvsat_mod
+
+  implicit none
+
+  integer :: n,ix,jy,i,l,kz,lz,kzmin,ierr
+  real :: ol,hmixplus,dummyakzllev
+  real :: rh,subsceff,ylat
+  real :: altmin,tvold,pold,zold,pint,tv
+  real :: vd(maxspec)
+  real :: z0_tmp(numclass) ! temporary variable for z0 (shared between OMP threads)
+  real,parameter :: const=r_air/ga
+
+
+  ! Loop over all nests
+  !********************
+
+  do l=1,numbnests
+
+  ! Loop over entire grid
+  !**********************
+  z0_tmp = z0
+!$OMP PARALLEL DEFAULT(SHARED) &
+!$OMP PRIVATE(i,ix,jy,kz,lz,kzmin,tvold,pold,zold,zlev,tv,pint, &
+!$OMP rh,ierr,subsceff,ulev,vlev,ttlev,qvlev,ol,altmin,ylat,hmixplus, &
+!$OMP dummyakzllev,vd )
+  z0 = z0_tmp
+
+!$OMP DO
+  do jy=0,nyn(l)-1
+
+  ! Set minimum height for tropopause
+  !**********************************
+
+    ylat=ylat0n(l)+real(jy)*dyn(l)
+    if ((ylat.ge.-20.).and.(ylat.le.20.)) then
+      altmin = 5000.
+    else
+      if ((ylat.gt.20.).and.(ylat.lt.40.)) then
+        altmin=2500.+(40.-ylat)*125.
+      else if ((ylat.gt.-40.).and.(ylat.lt.-20.)) then
+        altmin=2500.+(40.+ylat)*125.
+      else
+        altmin=2500.
+      endif
+    endif
+
+    do ix=0,nxn(l)-1
+
+  ! 1) Calculation of friction velocity
+  !************************************
+
+      ustarn(ix,jy,1,n,l)=scalev(psn(ix,jy,1,n,l),tt2n(ix,jy,1,n,l), &
+           td2n(ix,jy,1,n,l),sfcstressn(ix,jy,1,n,l))
+      if (ustarn(ix,jy,1,n,l).le.1.e-8) ustarn(ix,jy,1,n,l)=1.e-8
+
+  ! 2) Calculation of inverse Obukhov length scale
+  !***********************************************
+
+      ol=obukhov(psn(ix,jy,1,n,l),tt2n(ix,jy,1,n,l), &
+           td2n(ix,jy,1,n,l),tthn(ix,jy,2,n,l),ustarn(ix,jy,1,n,l), &
+           sshfn(ix,jy,1,n,l),akm,bkm,dummyakzllev)
+      if (ol.ne.0.) then
+        olin(ix,jy,1,n,l)=1./ol
+      else
+        olin(ix,jy,1,n,l)=99999.
+      endif
+
+
+  ! 3) Calculation of convective velocity scale and mixing height
+  !**************************************************************
+
+      do i=1,nuvz
+        ulev(i)=uuhn(ix,jy,i,l)
+        vlev(i)=vvhn(ix,jy,i,l)
+        ttlev(i)=tthn(ix,jy,i,n,l)
+        qvlev(i)=qvhn(ix,jy,i,n,l)
+      end do
+
+      call richardson(psn(ix,jy,1,n,l),ustarn(ix,jy,1,n,l),ttlev, &
+           qvlev,ulev,vlev,nuvz,akz,bkz,sshfn(ix,jy,1,n,l), &
+           tt2n(ix,jy,1,n,l),td2n(ix,jy,1,n,l),hmixn(ix,jy,1,n,l), &
+           wstarn(ix,jy,1,n,l),hmixplus,ierr)
+      if (ierr.lt.0) then
+        write(*,9500) 'failure', ix, jy, l
+        stop
+      endif
+9500      format( 'calcparn - richardson ', a, ' - ix,jy=', 2i5 )
+
+      if(lsubgrid.eq.1) then
+        subsceff=min(excessoron(ix,jy,l),hmixplus)
+      else
+        subsceff=0.0
+      endif
+  !
+  ! CALCULATE HMIX EXCESS ACCORDING TO SUBGRIDSCALE VARIABILITY AND STABILITY
+  !
+      hmixn(ix,jy,1,n,l)=hmixn(ix,jy,1,n,l)+subsceff
+      hmixn(ix,jy,1,n,l)=max(hmixmin,hmixn(ix,jy,1,n,l)) ! minim PBL height
+      hmixn(ix,jy,1,n,l)=min(hmixmax,hmixn(ix,jy,1,n,l)) ! maxim PBL height
+
+
+  ! 4) Calculation of dry deposition velocities
+  !********************************************
+
+      if (DRYDEP) then
+        ! z0(4)=0.016*ustarn(ix,jy,1,n,l)*ustarn(ix,jy,1,n,l)/ga
+        ! z0(9)=0.016*ustarn(ix,jy,1,n,l)*ustarn(ix,jy,1,n,l)/ga
+        z0(7)=0.016*ustarn(ix,jy,1,n,l)*ustarn(ix,jy,1,n,l)/ga
+
+  ! Calculate relative humidity at surface
+  !***************************************
+        rh=ew(td2n(ix,jy,1,n,l),psn(ix,jy,1,n,l))/ew(tt2n(ix,jy,1,n,l),psn(ix,jy,1,n,l))
+
+        call getvdep_nest(n,ix,jy,ustarn(ix,jy,1,n,l), &
+             tt2n(ix,jy,1,n,l),psn(ix,jy,1,n,l),1./olin(ix,jy,1,n,l), &
+             ssrn(ix,jy,1,n,l),rh,lsprecn(ix,jy,1,n,l)+ &
+             convprecn(ix,jy,1,n,l),sdn(ix,jy,1,n,l),vd,l)
+
+        do i=1,nspec
+          vdepn(ix,jy,i,n,l)=vd(i)
+        end do
+
+      endif
+
+  !******************************************************
+  ! Calculate height of thermal tropopause (Hoinka, 1997)
+  !******************************************************
+
+  ! 1) Calculate altitudes of ECMWF model levels
+  !*********************************************
+
+      tvold=tt2n(ix,jy,1,n,l)*(1.+0.378*ew(td2n(ix,jy,1,n,l),psn(ix,jy,1,n,l))/ &
+           psn(ix,jy,1,n,l))
+      pold=psn(ix,jy,1,n,l)
+      zold=0.
+      do kz=2,nuvz
+        pint=akz(kz)+bkz(kz)*psn(ix,jy,1,n,l)  ! pressure on model layers
+        tv=tthn(ix,jy,kz,n,l)*(1.+0.608*qvhn(ix,jy,kz,n,l))
+
+        if (abs(tv-tvold).gt.0.2) then
+         zlev(kz)=zold+const*log(pold/pint)*(tv-tvold)/log(tv/tvold)
+        else
+          zlev(kz)=zold+const*log(pold/pint)*tv
+        endif
+        tvold=tv
+        pold=pint
+        zold=zlev(kz)
+      end do
+
+  ! 2) Define a minimum level kzmin, from which upward the tropopause is
+  !    searched for. This is to avoid inversions in the lower troposphere
+  !    to be identified as the tropopause
+  !************************************************************************
+
+      do kz=1,nuvz
+        if (zlev(kz).ge.altmin) then
+          kzmin=kz
+          exit
+        endif
+      end do
+
+  ! 3) Search for first stable layer above minimum height that fulfills the
+  !    thermal tropopause criterion
+  !************************************************************************
+
+      kzloop : do kz=kzmin,nuvz
+        lzloop : do lz=kz+1,nuvz
+          if ((zlev(lz)-zlev(kz)).gt.2000.) then
+            if (((tthn(ix,jy,kz,n,l)-tthn(ix,jy,lz,n,l))/ &
+                 (zlev(lz)-zlev(kz))).lt.0.002) then
+              tropopausen(ix,jy,1,n,l)=zlev(kz)
+              exit kzloop
+            endif
+            exit lzloop
+          endif
+        end do lzloop
+      end do kzloop
+
+    end do
+  end do
+
+!$OMP END DO
+!$OMP END PARALLEL
+
+  ! Calculation of potential vorticity on 3-d grid
+  !***********************************************
+
+  call calcpv_nest(l,n)
+
+  end do
+end subroutine calcpar_nest
diff --git a/src/get_calcpv.f90 b/src/get_calcpv.f90
new file mode 100644
index 0000000000000000000000000000000000000000..c7e347f65edd336166a325ac74bad094ff301f43
--- /dev/null
+++ b/src/get_calcpv.f90
@@ -0,0 +1,305 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine calcpv(n)
+  !               i  i   i   o
+  !*****************************************************************************
+  !                                                                            *
+  !  Calculation of potential vorticity on 3-d grid.                           *
+  !                                                                            *
+  !     Author: P. James                                                       *
+  !     3 February 2000                                                        *
+  !                                                                            *
+  !     Adaptation to FLEXPART, A. Stohl, 1 May 2000                           *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! n                  temporal index for meteorological fields (1 to 2)       *
+  !                                                                            *
+  ! Constants:                                                                 *
+  !                                                                            *
+  !*****************************************************************************
+
+  implicit none
+
+  integer :: n,ix,jy,i,j,k,kl,ii,jj,klvrp,klvrm,klpt,kup,kdn,kch
+  integer :: jyvp,jyvm,ixvp,ixvm,jumpx,jumpy,jux,juy,ivrm,ivrp,ivr
+  integer :: nlck
+  real :: vx(2),uy(2),phi,tanphi,cosphi,dvdx,dudy,f
+  real :: theta,thetap,thetam,dthetadp,dt1,dt2,dt
+  real :: pvavr
+  real :: thup,thdn
+  real,parameter :: eps=1.e-5, p0=101325
+
+  ! Set number of levels to check for adjacent theta
+  nlck=nuvz/3
+  !
+  ! Loop over entire grid
+  !**********************
+  do kl=1,nuvz
+    do jy=0,nymin1
+      do ix=0,nxmin1
+         ppml(ix,jy,kl)=akz(kl)+bkz(kl)*ps(ix,jy,1,n)
+      enddo
+    enddo
+  enddo
+
+!  ppmk(:,:,1:nuvz)=(100000./ppml(:,:,1:nuvz))**kappa
+  ppmk(0:nxmin1,0:nymin1,1:nuvz)=(100000./ppml(0:nxmin1,0:nymin1,1:nuvz))**kappa
+!$OMP PARALLEL PRIVATE(jy,ix,kl,phi,f,tanphi,cosphi,jyvp,jyvm,jumpy,juy, &
+!$OMP ixvp,ixvm,jumpx,ivrp,ivrm,jux,theta,klvrp,klvrm,klpt,thetap,thetam,dthetadp, &
+!$OMP ii,i,ivr,kdn,kch,kup,thdn,thup,dt1,dt2,dt,vx,k,dvdx, &
+!$OMP jj,j,uy,dudy)
+!$OMP DO
+  do jy=0,nymin1
+    if (sglobal.and.jy.eq.0) cycle
+    if (nglobal.and.jy.eq.nymin1) cycle
+    phi = (ylat0 + jy * dy) * pi / 180.
+    f = 0.00014585 * sin(phi)
+    tanphi = tan(phi)
+    cosphi = cos(phi)
+  ! Provide a virtual jy+1 and jy-1 in case we are on domain edge (Lat)
+    jyvp=jy+1
+    jyvm=jy-1
+    if (jy.eq.0) jyvm=0
+    if (jy.eq.nymin1) jyvp=nymin1
+  ! Define absolute gap length
+    jumpy=2
+    if (jy.eq.0.or.jy.eq.nymin1) jumpy=1
+    if (sglobal.and.jy.eq.1) then
+      jyvm=1
+      jumpy=1
+    end if
+    if (nglobal.and.jy.eq.ny-2) then
+      jyvp=ny-2
+      jumpy=1
+    end if
+    juy=jumpy
+  !
+    do ix=0,nxmin1
+  ! Provide a virtual ix+1 and ix-1 in case we are on domain edge (Long)
+      ixvp=ix+1
+      ixvm=ix-1
+      jumpx=2
+      if (xglobal) then
+         ivrp=ixvp
+         ivrm=ixvm
+         if (ixvm.lt.0) ivrm=ixvm+nxmin1
+         if (ixvp.ge.nx) ivrp=ixvp-nx+1
+      else
+        if (ix.eq.0) ixvm=0
+        if (ix.eq.nxmin1) ixvp=nxmin1
+        ivrp=ixvp
+        ivrm=ixvm
+  ! Define absolute gap length
+        if (ix.eq.0.or.ix.eq.nxmin1) jumpx=1
+      end if
+      jux=jumpx
+  !
+  ! Loop over the vertical
+  !***********************
+
+      do kl=1,nuvz
+        theta=tth(ix,jy,kl,n)*ppmk(ix,jy,kl)
+        klvrp=kl+1
+        klvrm=kl-1
+        klpt=kl
+  ! If top or bottom level, dthetadp is evaluated between the current
+  ! level and the level inside, otherwise between level+1 and level-1
+  !
+        if (klvrp.gt.nuvz) klvrp=nuvz
+        if (klvrm.lt.1) klvrm=1
+        thetap=tth(ix,jy,klvrp,n)*ppmk(ix,jy,klvrp)
+        thetam=tth(ix,jy,klvrm,n)*ppmk(ix,jy,klvrm)
+        dthetadp=(thetap-thetam)/(ppml(ix,jy,klvrp)-ppml(ix,jy,klvrm))
+
+  ! Compute vertical position at pot. temperature surface on subgrid
+  ! and the wind at that position
+  !*****************************************************************
+  ! a) in x direction
+        ii=0
+        x_loop: do i=ixvm,ixvp,jumpx
+          ivr=i
+          if (xglobal) then
+             if (i.lt.0) ivr=ivr+nxmin1
+             if (i.ge.nx) ivr=ivr-nx+1
+          end if
+          ii=ii+1
+  ! Search adjacent levels for current theta value
+  ! Spiral out from current level for efficiency
+          kup=klpt-1
+          kdn=klpt
+          kch=0
+          x_lev_loop: do while (kch.lt.nlck)
+  ! Upward branch
+            kup=kup+1
+            if (kup.lt.nuvz) then
+              kch=kch+1
+              k=kup
+              thdn=tth(ivr,jy,k,n)*ppmk(ivr,jy,k)
+              thup=tth(ivr,jy,k+1,n)*ppmk(ivr,jy,k+1)
+
+
+              if (((thdn.ge.theta).and.(thup.le.theta)).or. &
+              ((thdn.le.theta).and.(thup.ge.theta))) then
+                dt1=abs(theta-thdn)
+                dt2=abs(theta-thup)
+                dt=dt1+dt2
+                if (dt.lt.eps) then   ! Avoid division by zero error
+                  dt1=0.5             ! G.W., 10.4.1996
+                  dt2=0.5
+                  dt=1.0
+                endif
+                vx(ii)=(vvh(ivr,jy,k)*dt2+vvh(ivr,jy,k+1)*dt1)/dt
+                cycle x_loop
+              endif
+            endif
+    ! Downward branch
+            kdn=kdn-1
+            if (kdn.ge.1) then
+              kch=kch+1
+              k=kdn
+              thdn=tth(ivr,jy,k,n)*ppmk(ivr,jy,k)
+              thup=tth(ivr,jy,k+1,n)*ppmk(ivr,jy,k+1)
+
+              if (((thdn.ge.theta).and.(thup.le.theta)).or. &
+              ((thdn.le.theta).and.(thup.ge.theta))) then
+                dt1=abs(theta-thdn)
+                dt2=abs(theta-thup)
+                dt=dt1+dt2
+                if (dt.lt.eps) then   ! Avoid division by zero error
+                  dt1=0.5             ! G.W., 10.4.1996
+                  dt2=0.5
+                  dt=1.0
+                endif
+                vx(ii)=(vvh(ivr,jy,k)*dt2+vvh(ivr,jy,k+1)*dt1)/dt
+                cycle x_loop
+              endif
+            endif
+          end do x_lev_loop
+    ! This section used when no values were found
+  ! Must use vv at current level and long. jux becomes smaller by 1
+          vx(ii)=vvh(ix,jy,kl)
+          jux=jux-1
+  ! Otherwise OK
+        end do x_loop
+        if (jux.gt.0) then
+          dvdx=(vx(2)-vx(1))/real(jux)/(dx*pi/180.)
+        else
+          dvdx=vvh(ivrp,jy,kl)-vvh(ivrm,jy,kl)
+          dvdx=dvdx/real(jumpx)/(dx*pi/180.)
+  ! Only happens if no equivalent theta value
+  ! can be found on either side, hence must use values
+  ! from either side, same pressure level.
+        end if
+
+  ! b) in y direction
+
+        jj=0
+        y_loop: do j=jyvm,jyvp,jumpy
+          jj=jj+1
+  ! Search adjacent levels for current theta value
+  ! Spiral out from current level for efficiency
+          kup=klpt-1
+          kdn=klpt
+          kch=0
+          y_lev_loop: do while (kch.lt.nlck)
+  ! Upward branch
+            kup=kup+1
+            if (kup.lt.nuvz) then
+              kch=kch+1
+              k=kup
+              thdn=tth(ix,j,k,n)*ppmk(ix,j,k)
+              thup=tth(ix,j,k+1,n)*ppmk(ix,j,k+1)
+              if (((thdn.ge.theta).and.(thup.le.theta)).or. &
+              ((thdn.le.theta).and.(thup.ge.theta))) then
+                dt1=abs(theta-thdn)
+                dt2=abs(theta-thup)
+                dt=dt1+dt2
+                if (dt.lt.eps) then   ! Avoid division by zero error
+                  dt1=0.5             ! G.W., 10.4.1996
+                  dt2=0.5
+                  dt=1.0
+                endif
+                uy(jj)=(uuh(ix,j,k)*dt2+uuh(ix,j,k+1)*dt1)/dt
+                cycle y_loop
+              endif
+            endif
+    ! Downward branch
+            kdn=kdn-1
+            if (kdn.ge.1) then
+              kch=kch+1
+              k=kdn
+              thdn=tth(ix,j,k,n)*ppmk(ix,j,k)
+              thup=tth(ix,j,k+1,n)*ppmk(ix,j,k+1)
+              if (((thdn.ge.theta).and.(thup.le.theta)).or. &
+              ((thdn.le.theta).and.(thup.ge.theta))) then
+                dt1=abs(theta-thdn)
+                dt2=abs(theta-thup)
+                dt=dt1+dt2
+                if (dt.lt.eps) then   ! Avoid division by zero error
+                  dt1=0.5             ! G.W., 10.4.1996
+                  dt2=0.5
+                  dt=1.0
+                endif
+                uy(jj)=(uuh(ix,j,k)*dt2+uuh(ix,j,k+1)*dt1)/dt
+                cycle y_loop
+              endif
+            endif
+          end do y_lev_loop
+  ! This section used when no values were found
+  ! Must use uu at current level and lat. juy becomes smaller by 1
+          uy(jj)=uuh(ix,jy,kl)
+          juy=juy-1
+  ! Otherwise OK
+        end do y_loop
+        if (juy.gt.0) then
+          dudy=(uy(2)-uy(1))/real(juy)/(dy*pi/180.)
+        else
+          dudy=uuh(ix,jyvp,kl)-uuh(ix,jyvm,kl)
+          dudy=dudy/real(jumpy)/(dy*pi/180.)
+        end if
+    !
+        pvh(ix,jy,kl)=dthetadp*(f+(dvdx/cosphi-dudy &
+             +uuh(ix,jy,kl)*tanphi)/r_earth)*(-1.e6)*9.81
+  !
+  ! Resest jux and juy
+        jux=jumpx
+        juy=jumpy
+      end do
+    end do
+  end do
+!$OMP END DO
+!$OMP END PARALLEL
+  !
+  ! Fill in missing PV values on poles, if present
+  ! Use mean PV of surrounding latitude ring
+  !
+  if (sglobal) then
+     do kl=1,nuvz
+        pvavr=0.
+        do ix=0,nxmin1
+           pvavr=pvavr+pvh(ix,1,kl)
+        end do
+        pvavr=pvavr/real(nx)
+        jy=0
+        do ix=0,nxmin1
+           pvh(ix,jy,kl)=pvavr
+        end do
+     end do
+  end if
+  if (nglobal) then
+     do kl=1,nuvz
+        pvavr=0.
+        do ix=0,nxmin1
+           pvavr=pvavr+pvh(ix,ny-2,kl)
+        end do
+        pvavr=pvavr/real(nx)
+        jy=nymin1
+        do ix=0,nxmin1
+           pvh(ix,jy,kl)=pvavr
+        end do
+     end do
+  end if
+end subroutine calcpv
diff --git a/src/get_calcpv_nest.f90 b/src/get_calcpv_nest.f90
new file mode 100644
index 0000000000000000000000000000000000000000..74c1a1f1040e50f4756293a6dca31bde147ed6af
--- /dev/null
+++ b/src/get_calcpv_nest.f90
@@ -0,0 +1,244 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine calcpv_nest(l,n)
+  !                     i i  i    i    o
+  !*****************************************************************************
+  !                                                                            *
+  !  Calculation of potential vorticity on 3-d nested grid                     *
+  !                                                                            *
+  !     Author: P. James                                                       *
+  !     22 February 2000                                                       *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! n                  temporal index for meteorological fields (1 to 2)       *
+  ! l                  index of current nest                                   *
+  !                                                                            *
+  ! Constants:                                                                 *
+  !                                                                            *
+  !*****************************************************************************
+
+  implicit none
+
+  integer :: n,ix,jy,i,j,k,kl,ii,jj,klvrp,klvrm,klpt,kup,kdn,kch
+  integer :: jyvp,jyvm,ixvp,ixvm,jumpx,jumpy,jux,juy,ivrm,ivrp,ivr
+  integer :: nlck,l
+  real :: vx(2),uy(2),phi,tanphi,cosphi,dvdx,dudy,f
+  real :: theta,thetap,thetam,dthetadp,dt1,dt2,dt
+  real :: thup,thdn
+  real,parameter :: eps=1.e-5,p0=101325
+
+  ! Set number of levels to check for adjacent theta
+  nlck=nuvz/3
+  !
+  ! Loop over entire grid
+  !**********************
+  do kl=1,nuvz
+    do jy=0,nyn(l)-1
+      do ix=0,nxn(l)-1
+         ppml(ix,jy,kl)=akz(kl)+bkz(kl)*psn(ix,jy,1,n,l)
+      enddo
+    enddo
+  enddo
+  !  ppmk=(100000./ppml)**kappa
+  ppmk(0:nxn(l)-1,0:nyn(l)-1,1:nuvz)=(100000./ppml(0:nxn(l)-1,0:nyn(l)-1,1:nuvz))**kappa
+
+  do jy=0,nyn(l)-1
+    phi = (ylat0n(l) + jy * dyn(l)) * pi / 180.
+    f = 0.00014585 * sin(phi)
+    tanphi = tan(phi)
+    cosphi = cos(phi)
+  ! Provide a virtual jy+1 and jy-1 in case we are on domain edge (Lat)
+      jyvp=jy+1
+      jyvm=jy-1
+      if (jy.eq.0) jyvm=0
+      if (jy.eq.nyn(l)-1) jyvp=nyn(l)-1
+  ! Define absolute gap length
+      jumpy=2
+      if (jy.eq.0.or.jy.eq.nyn(l)-1) jumpy=1
+      juy=jumpy
+  !
+    do ix=0,nxn(l)-1
+  ! Provide a virtual ix+1 and ix-1 in case we are on domain edge (Long)
+      ixvp=ix+1
+      ixvm=ix-1
+      jumpx=2
+      if (ix.eq.0) ixvm=0
+      if (ix.eq.nxn(l)-1) ixvp=nxn(l)-1
+      ivrp=ixvp
+      ivrm=ixvm
+  ! Define absolute gap length
+      if (ix.eq.0.or.ix.eq.nxn(l)-1) jumpx=1
+      jux=jumpx
+  !
+  ! Loop over the vertical
+  !***********************
+
+      do kl=1,nuvz
+        theta=tthn(ix,jy,kl,n,l)*ppmk(ix,jy,kl)
+        klvrp=kl+1
+        klvrm=kl-1
+        klpt=kl
+  ! If top or bottom level, dthetadp is evaluated between the current
+  ! level and the level inside, otherwise between level+1 and level-1
+  !
+        if (klvrp.gt.nuvz) klvrp=nuvz
+        if (klvrm.lt.1) klvrm=1
+        thetap=tthn(ix,jy,klvrp,n,l)*ppmk(ix,jy,klvrp)
+        thetam=tthn(ix,jy,klvrm,n,l)*ppmk(ix,jy,klvrm)
+        dthetadp=(thetap-thetam)/(ppml(ix,jy,klvrp)-ppml(ix,jy,klvrm))
+
+  ! Compute vertical position at pot. temperature surface on subgrid
+  ! and the wind at that position
+  !*****************************************************************
+  ! a) in x direction
+        ii=0
+        x_loop: do i=ixvm,ixvp,jumpx
+          ivr=i
+          ii=ii+1
+  ! Search adjacent levels for current theta value
+  ! Spiral out from current level for efficiency
+          kup=klpt-1
+          kdn=klpt
+          kch=0
+          x_lev_loop: do while (kch.lt.nlck)
+  ! Upward branch
+            kup=kup+1
+            if (kup.lt.nuvz) then
+              kch=kch+1
+              k=kup
+              thdn=tthn(ivr,jy,k,n,l)*ppmk(ivr,jy,k)
+              thup=tthn(ivr,jy,k+1,n,l)*ppmk(ivr,jy,k+1)
+
+              if (((thdn.ge.theta).and.(thup.le.theta)).or. &
+              ((thdn.le.theta).and.(thup.ge.theta))) then
+                dt1=abs(theta-thdn)
+                dt2=abs(theta-thup)
+                dt=dt1+dt2
+                if (dt.lt.eps) then   ! Avoid division by zero error
+                  dt1=0.5             ! G.W., 10.4.1996
+                  dt2=0.5
+                  dt=1.0
+                endif
+                vx(ii)=(vvhn(ivr,jy,k,l)*dt2+vvhn(ivr,jy,k+1,l)*dt1)/dt
+                cycle x_loop
+              endif
+            endif
+  ! Downward branch
+            kdn=kdn-1
+            if (kdn.ge.1) then
+              kch=kch+1
+              k=kdn
+              thdn=tthn(ivr,jy,k,n,l)*ppmk(ivr,jy,k)
+              thup=tthn(ivr,jy,k+1,n,l)*ppmk(ivr,jy,k+1)
+
+              if (((thdn.ge.theta).and.(thup.le.theta)).or. &
+              ((thdn.le.theta).and.(thup.ge.theta))) then
+                dt1=abs(theta-thdn)
+                dt2=abs(theta-thup)
+                dt=dt1+dt2
+                if (dt.lt.eps) then   ! Avoid division by zero error
+                  dt1=0.5             ! G.W., 10.4.1996
+                  dt2=0.5
+                  dt=1.0
+                endif
+                vx(ii)=(vvhn(ivr,jy,k,l)*dt2+vvhn(ivr,jy,k+1,l)*dt1)/dt
+                cycle x_loop
+              endif
+            endif
+          end do x_lev_loop
+  ! This section used when no values were found
+  ! Must use vv at current level and long. jux becomes smaller by 1
+          vx(ii)=vvhn(ix,jy,kl,l)
+          jux=jux-1
+  ! Otherwise OK
+        end do x_loop
+        if (jux.gt.0) then
+          dvdx=(vx(2)-vx(1))/real(jux)/(dxn(l)*pi/180.)
+        else
+          dvdx=vvhn(ivrp,jy,kl,l)-vvhn(ivrm,jy,kl,l)
+          dvdx=dvdx/real(jumpx)/(dxn(l)*pi/180.)
+  ! Only happens if no equivalent theta value
+  ! can be found on either side, hence must use values
+  ! from either side, same pressure level.
+        end if
+
+  ! b) in y direction
+
+        jj=0
+        y_loop: do j=jyvm,jyvp,jumpy
+          jj=jj+1
+  ! Search adjacent levels for current theta value
+  ! Spiral out from current level for efficiency
+          kup=klpt-1
+          kdn=klpt
+          kch=0
+          y_lev_loop: do while (kch.lt.nlck)
+  ! Upward branch
+            kup=kup+1
+            if (kup.lt.nuvz) then
+              kch=kch+1
+              k=kup
+              thdn=tthn(ix,j,k,n,l)*ppmk(ix,j,k)
+              thup=tthn(ix,j,k+1,n,l)*ppmk(ix,j,k+1)
+              if (((thdn.ge.theta).and.(thup.le.theta)).or. &
+              ((thdn.le.theta).and.(thup.ge.theta))) then
+                dt1=abs(theta-thdn)
+                dt2=abs(theta-thup)
+                dt=dt1+dt2
+                if (dt.lt.eps) then   ! Avoid division by zero error
+                  dt1=0.5             ! G.W., 10.4.1996
+                  dt2=0.5
+                  dt=1.0
+                endif
+                uy(jj)=(uuhn(ix,j,k,l)*dt2+uuhn(ix,j,k+1,l)*dt1)/dt
+                cycle y_loop
+              endif
+            endif
+  ! Downward branch
+            kdn=kdn-1
+            if (kdn.ge.1) then
+              kch=kch+1
+              k=kdn
+              thdn=tthn(ix,j,k,n,l)*ppmk(ix,j,k)
+              thup=tthn(ix,j,k+1,n,l)*ppmk(ix,j,k+1)
+              if (((thdn.ge.theta).and.(thup.le.theta)).or. &
+              ((thdn.le.theta).and.(thup.ge.theta))) then
+                dt1=abs(theta-thdn)
+                dt2=abs(theta-thup)
+                dt=dt1+dt2
+                if (dt.lt.eps) then   ! Avoid division by zero error
+                  dt1=0.5             ! G.W., 10.4.1996
+                  dt2=0.5
+                  dt=1.0
+                endif
+                uy(jj)=(uuhn(ix,j,k,l)*dt2+uuhn(ix,j,k+1,l)*dt1)/dt
+                cycle y_loop
+              endif
+            endif
+          end do y_lev_loop
+  ! This section used when no values were found
+  ! Must use uu at current level and lat. juy becomes smaller by 1
+          uy(jj)=uuhn(ix,jy,kl,l)
+          juy=juy-1
+  ! Otherwise OK
+        end do y_loop
+        if (juy.gt.0) then
+          dudy=(uy(2)-uy(1))/real(juy)/(dyn(l)*pi/180.)
+        else
+          dudy=uuhn(ix,jyvp,kl,l)-uuhn(ix,jyvm,kl,l)
+          dudy=dudy/real(jumpy)/(dyn(l)*pi/180.)
+        end if
+
+        pvhn(ix,jy,kl,l)=dthetadp*(f+(dvdx/cosphi-dudy &
+             +uuhn(ix,jy,kl,l)*tanphi)/r_earth)*(-1.e6)*9.81
+
+  ! Resest jux and juy
+        jux=jumpx
+        juy=jumpy
+      end do
+    end do
+  end do
+end subroutine calcpv_nest
diff --git a/src/get_dealloc_getfields.f90 b/src/get_dealloc_getfields.f90
new file mode 100644
index 0000000000000000000000000000000000000000..aedc822e2f6bad4d74c4e99512bd50ae921bcb6f
--- /dev/null
+++ b/src/get_dealloc_getfields.f90
@@ -0,0 +1,11 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine dealloc_getfields
+
+  implicit none
+  deallocate(uuh,vvh,pvh,wwh,uuhn,vvhn,pvhn,wwhn,pwater)
+  deallocate(ppml,ppmk)
+  deallocate(ttlev,qvlev,ulev,vlev,zlev)
+
+end subroutine dealloc_getfields
diff --git a/src/get_getfields.f90 b/src/get_getfields.f90
new file mode 100644
index 0000000000000000000000000000000000000000..840b72c0b592aa55cc82ec5f381cef31201db9e8
--- /dev/null
+++ b/src/get_getfields.f90
@@ -0,0 +1,207 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine getfields(itime,nstop)
+  !                       i     o
+  !*****************************************************************************
+  !                                                                            *
+  !  This subroutine manages the 3 data fields to be kept in memory.           *
+  !  During the first time step of petterssen it has to be fulfilled that the  *
+  !  first data field must have |wftime|<itime, i.e. the absolute value of     *
+  !  wftime must be smaller than the absolute value of the current time in [s].*
+  !  The other 2 fields are the next in time after the first one.              *
+  !  Pointers (memind) are used, because otherwise one would have to resort the*
+  !  wind fields, which costs a lot of computing time. Here only the pointers  *
+  !  are resorted.                                                             *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     29 April 1994                                                          *
+  !                                                                            *
+  !*****************************************************************************
+  !  Changes, Bernd C. Krueger, Feb. 2001:                                     *
+  !   Variables tth,qvh,tthn,qvhn (on eta coordinates) in common block.        *
+  !   Function of nstop extended.                                              *
+  !                                                                            *
+  !   Unified ECMWF and GFS builds                                             *
+  !   Marian Harustak, 12.5.2017                                               *
+  !     - Added passing of metdata_format as it was needed by called routines  *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! lwindinterval [s]    time difference between the two wind fields read in   *
+  ! indj                 indicates the number of the wind field to be read in  *
+  ! indmin               remembers the number of wind fields already treated   *
+  ! memind(2)            pointer, on which place the wind fields are stored    *
+  ! memtime(2) [s]       times of the wind fields, which are kept in memory    *
+  ! itime [s]            current time since start date of trajectory calcu-    *
+  !                      lation                                                *
+  ! nstop                > 0, if trajectory has to be terminated               *
+  ! nx,ny,nuvz,nwz       field dimensions in x,y and z direction               *
+  ! uu(0:nxmax,0:nymax,nuvzmax,2)   wind components in x-direction [m/s]       *
+  ! vv(0:nxmax,0:nymax,nuvzmax,2)   wind components in y-direction [m/s]       *
+  ! ww(0:nxmax,0:nymax,nwzmax,2)    wind components in z-direction [deltaeta/s]*
+  ! tt(0:nxmax,0:nymax,nuvzmax,2)   temperature [K]                            *
+  ! ps(0:nxmax,0:nymax,2)           surface pressure [Pa]                      *
+  ! metdata_format     format of metdata (ecmwf/gfs)                           *
+  !                                                                            *
+  ! Constants:                                                                 *
+  ! idiffmax             maximum allowable time difference between 2 wind      *
+  !                      fields                                                *
+  !                                                                            *
+  !*****************************************************************************
+
+  use class_gribfile_mod
+  use wetdepo_mod
+
+  implicit none
+
+  integer :: indj,itime,nstop,memaux
+  integer :: kz, ix
+  character(len=100) :: rowfmt
+
+  integer :: indmin = 1
+
+  ! Check, if wind fields are available for the current time step
+  !**************************************************************
+
+  nstop=0
+  if ((ldirect*wftime(1).gt.ldirect*itime).or. &
+       (ldirect*wftime(numbwf).lt.ldirect*itime)) then
+    write(*,*) 'FLEXPART WARNING: NO WIND FIELDS ARE AVAILABLE.'
+    write(*,*) 'A TRAJECTORY HAS TO BE TERMINATED.'
+    nstop=4
+    return
+  endif
+
+  if ((ldirect*memtime(1).le.ldirect*itime).and. &
+       (ldirect*memtime(2).gt.ldirect*itime)) then
+
+  ! The right wind fields are already in memory -> don't do anything
+  !*****************************************************************
+
+    continue
+
+  else if ((ldirect*memtime(2).le.ldirect*itime).and. &
+       (memtime(2).ne.999999999)) then
+
+
+  ! Current time is after 2nd wind field
+  ! -> Resort wind field pointers, so that current time is between 1st and 2nd
+  !***************************************************************************
+
+    memaux=memind(1)
+    memind(1)=memind(2)
+    memind(2)=memaux
+    memtime(1)=memtime(2)
+
+
+  ! Read a new wind field and store it on place memind(2)
+  !******************************************************
+
+    do indj=indmin,numbwf-1
+      if (ldirect*wftime(indj+1).gt.ldirect*itime) then
+        if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
+          call SYSTEM_CLOCK(count_clock, count_rate, count_max)
+          s_temp = (count_clock - count_clock0)/real(count_rate)
+          call readwind_ecmwf(indj+1,memind(2),uuh,vvh,wwh)
+          call SYSTEM_CLOCK(count_clock, count_rate, count_max)
+          s_readwind = s_readwind + ((count_clock - count_clock0)/real(count_rate)-s_temp)
+        else
+          call readwind_gfs(indj+1,memind(2),uuh,vvh,wwh)
+        end if
+        call readwind_nest(indj+1,memind(2),uuhn,vvhn,wwhn)
+        call calcpar(memind(2))
+        call calcpar_nest(memind(2))
+        if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
+          call verttransform_ecmwf(memind(2),uuh,vvh,wwh,pvh)
+        else
+          call verttransform_gfs(memind(2),uuh,vvh,wwh,pvh)
+        end if
+        call verttransform_nest(memind(2),uuhn,vvhn,wwhn,pvhn)
+        memtime(2)=wftime(indj+1)
+        nstop = 1
+        exit
+      endif
+    end do
+    indmin=indj
+
+    if ((WETBKDEP).and.(ipin.ne.3).and.(ipin.ne.4)) then
+      call writeprecip(itime,memind(1))
+    endif
+
+  else
+
+  ! No wind fields, which can be used, are currently in memory
+  ! -> read both wind fields
+  !***********************************************************
+
+    do indj=indmin,numbwf-1
+      if ((ldirect*wftime(indj).le.ldirect*itime).and. &
+           (ldirect*wftime(indj+1).gt.ldirect*itime)) then
+        memind(1)=1
+        if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
+          call SYSTEM_CLOCK(count_clock, count_rate, count_max)
+          s_temp = (count_clock - count_clock0)/real(count_rate)
+          call readwind_ecmwf(indj,memind(1),uuh,vvh,wwh)
+          call SYSTEM_CLOCK(count_clock, count_rate, count_max)
+          s_readwind = s_readwind + ((count_clock - count_clock0)/real(count_rate)-s_temp)
+        else
+          call readwind_gfs(indj,memind(1),uuh,vvh,wwh)
+        end if
+        call readwind_nest(indj,memind(1),uuhn,vvhn,wwhn)
+        call calcpar(memind(1))
+        call calcpar_nest(memind(1))
+        if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
+          call verttransform_ecmwf(memind(1),uuh,vvh,wwh,pvh)
+        else
+          call verttransform_gfs(memind(1),uuh,vvh,wwh,pvh)
+        end if
+        call verttransform_nest(memind(1),uuhn,vvhn,wwhn,pvhn)
+        memtime(1)=wftime(indj)
+        memind(2)=2
+        if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
+          call SYSTEM_CLOCK(count_clock, count_rate, count_max)
+          s_temp = (count_clock - count_clock0)/real(count_rate)
+          call readwind_ecmwf(indj+1,memind(2),uuh,vvh,wwh)
+          call SYSTEM_CLOCK(count_clock, count_rate, count_max)
+          s_readwind = s_readwind + ((count_clock - count_clock0)/real(count_rate)-s_temp)
+        else
+          call readwind_gfs(indj+1,memind(2),uuh,vvh,wwh)
+        end if
+        call readwind_nest(indj+1,memind(2),uuhn,vvhn,wwhn)
+        call calcpar(memind(2))
+        call calcpar_nest(memind(2))
+        if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
+          call verttransform_ecmwf(memind(2),uuh,vvh,wwh,pvh)
+        else
+          call verttransform_gfs(memind(2),uuh,vvh,wwh,pvh)
+        end if
+        call verttransform_nest(memind(2),uuhn,vvhn,wwhn,pvhn)
+        memtime(2)=wftime(indj+1)
+        nstop = 1
+        exit
+      endif
+    end do
+    indmin=indj
+
+    if ((WETBKDEP).and.(ipin.ne.3).and.(ipin.ne.4)) then
+      call writeprecip(itime,memind(1))
+    endif
+
+  end if
+
+  ! RLT calculate dry air density
+  if (DRYDEP) then
+    pwater=qv*prs/((r_air/r_water)*(1.-qv)+qv)
+    rho_dry=(prs-pwater)/(r_air*tt)
+  endif
+#ifndef USE_NCF
+  pwater=qv*prs/((r_air/r_water)*(1.-qv)+qv)
+  rho_dry=(prs-pwater)/(r_air*tt)
+#endif
+
+  lwindinterv=abs(memtime(2)-memtime(1))
+
+  if (lwindinterv.gt.idiffmax) nstop=3
+end subroutine getfields
diff --git a/src/get_obukhov.f90 b/src/get_obukhov.f90
new file mode 100644
index 0000000000000000000000000000000000000000..a7ff35a944ec82651d8d82aae0d792fcfa866a19
--- /dev/null
+++ b/src/get_obukhov.f90
@@ -0,0 +1,70 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+real function obukhov(ps,tsurf,tdsurf,tlev,ustar,hf,akm,bkm,plev)
+
+  !********************************************************************
+  !                                                                   *
+  !                       Author: G. WOTAWA                           *
+  !                       Date:   1994-06-27                          *
+  !                                                                   *
+  !     This program calculates Obukhov scale height from surface     *
+  !     meteorological data and sensible heat flux.                   *
+  !                                                                   *
+  !********************************************************************
+  !                                                                   *
+  !  Update: A. Stohl, 2000-09-25, avoid division by zero by          *
+  !  setting ustar to minimum value                                   *
+  !  CHANGE: 17/11/2005 Caroline Forster NCEP GFS version             *
+  !                                                                   *
+  !   Unified ECMWF and GFS builds                                    *
+  !   Marian Harustak, 12.5.2017                                      *
+  !     - Merged obukhov and obukhov_gfs into one routine using       *
+  !       if-then for meteo-type dependent code                       *
+  !                                                                   *
+  !********************************************************************
+  !                                                                   *
+  !     INPUT:                                                        *
+  !                                                                   *
+  !     ps      surface pressure [Pa]                                 *
+  !     tsurf   surface temperature [K]                               *
+  !     tdsurf  surface dew point [K]                                 *
+  !     tlev    temperature first model level [K]                     *
+  !     ustar   scale velocity [m/s]                                  *
+  !     hf      surface sensible heat flux [W/m2]                     *
+  !     akm     ECMWF vertical discretization parameter               *
+  !     bkm     ECMWF vertical discretization parameter               *
+  !     plev                                                          *
+  !     metdata_format format of metdata (ecmwf/gfs)                  *
+  !                                                                   *
+  !********************************************************************
+
+  use class_gribfile_mod
+  use qvsat_mod
+
+  implicit none
+
+  real,dimension(:) :: akm,bkm
+  real :: ps,tsurf,tdsurf,tlev,ustar,hf,e,tv,rhoa,plev
+  real :: ak1,bk1,theta,thetastar
+
+
+  e=ew(tdsurf,ps)                           ! vapor pressure
+  tv=tsurf*(1.+0.378*e/ps)               ! virtual temperature
+  rhoa=ps/(r_air*tv)                      ! air density
+  if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
+  ak1=(akm(1)+akm(2))/2.
+  bk1=(bkm(1)+bkm(2))/2.
+  plev=ak1+bk1*ps                        ! Pressure level 1
+  end if
+  theta=tlev*(100000./plev)**(r_air/cpa) ! potential temperature
+  if (ustar.le.0.) ustar=1.e-8
+  thetastar=hf/(rhoa*cpa*ustar)           ! scale temperature
+  if(abs(thetastar).gt.1.e-10) then
+     obukhov=theta*ustar**2/(karman*ga*thetastar)
+  else
+     obukhov=9999                        ! zero heat flux
+  endif
+  if (obukhov.gt. 9999.) obukhov= 9999.
+  if (obukhov.lt.-9999.) obukhov=-9999.
+end function obukhov
diff --git a/src/get_richardson.f90 b/src/get_richardson.f90
new file mode 100644
index 0000000000000000000000000000000000000000..17712268f8cdee21d7f54439fe97cd5bdf078717
--- /dev/null
+++ b/src/get_richardson.f90
@@ -0,0 +1,253 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine richardson(psurf,ust,ttlev,qvlev,ulev,vlev,nuvz, &
+       akz,bkz,hf,tt2,td2,h,wst,hmixplus,ierr)
+  !                        i    i    i     i    i    i    i
+  ! i   i  i   i   i  o  o     o
+  !****************************************************************************
+  !                                                                           *
+  !     Calculation of mixing height based on the critical Richardson number. *
+  !     Calculation of convective time scale.                                 *
+  !     For unstable conditions, one iteration is performed. An excess        *
+  !     temperature (dependent on hf and wst) is calculated, added to the     *
+  !     temperature at the lowest model level. Then the procedure is repeated.*
+  !                                                                           *
+  !     Author: A. Stohl                                                      *
+  !                                                                           *
+  !     22 August 1996                                                        *
+  !                                                                           *
+  !     Literature:                                                           *
+  !     Vogelezang DHP and Holtslag AAM (1996): Evaluation and model impacts  *
+  !     of alternative boundary-layer height formulations. Boundary-Layer     *
+  !     Meteor. 81, 245-269.                                                  *
+  !                                                                           *
+  !****************************************************************************
+  !                                                                           *
+  !     Update: 1999-02-01 by G. Wotawa                                       *
+  !                                                                           *
+  !     Two meter level (temperature, humidity) is taken as reference level   *
+  !     instead of first model level.                                         *
+  !     New input variables tt2, td2 introduced.                              *
+  !                                                                           *
+  !     CHANGE: 17/11/2005 Caroline Forster NCEP GFS version                  *
+  !                                                                           *
+  !     Unified ECMWF and GFS builds                                          *
+  !     Marian Harustak, 12.5.2017                                            *
+  !       - Merged richardson and richardson_gfs into one routine using       *
+  !         if-then for meteo-type dependent code                             *
+  !                                                                           *
+  !****************************************************************************
+  !                                                                           *
+  ! Variables:                                                                *
+  ! h                          mixing height [m]                              *
+  ! hf                         sensible heat flux                             *
+  ! psurf                      surface pressure at point (xt,yt) [Pa]         *
+  ! tv                         virtual temperature                            *
+  ! wst                        convective velocity scale                      *
+  ! metdata_format             format of metdata (ecmwf/gfs)                  *
+  !                                                                           *
+  ! Constants:                                                                *
+  ! ric                        critical Richardson number                     *
+  !                                                                           *
+  !****************************************************************************
+
+  use class_gribfile_mod
+  use qvsat_mod
+
+  implicit none
+
+  integer,intent(out) ::            &
+    ierr                              ! Returns error when no richardson number can be found
+  real, intent(out) ::              &
+    h,                              & ! mixing height [m]
+    wst,                            & ! convective velocity scale
+    hmixplus                          !
+  integer,intent(in)  ::            &
+    nuvz                              ! Upper vertical level
+  real,intent(in) ::                &
+    psurf,                          & ! surface pressure at point (xt,yt) [Pa]
+    ust,                            & ! Scale velocity
+    hf,                             & ! Surface sensible heat flux
+    tt2,td2                           ! Temperature
+  real,intent(in),dimension(:) ::   &
+    ttlev,                          &
+    qvlev,                          &
+    ulev,                           &
+    vlev,                           &
+    akz,bkz
+  integer ::                        &
+    i,k,iter,llev,loop_start          ! Loop variables
+  real ::                           &
+    tv,tvold,                       & ! Virtual temperature
+    zref,z,zold,zl,zl1,zl2,         & ! Heights
+    pint,pold,                      & ! Pressures
+    theta,thetaold,thetaref,thetal, & ! Potential temperature
+    theta1,theta2,thetam,           &
+    ri,                             & ! Richardson number per level
+    ril,                            & ! Richardson number sub level
+    excess,                         & !
+    ul,vl,                          & ! Velocities sub level
+    wspeed,                         & ! Wind speed at z=hmix
+    bvfsq,                          & ! Brunt-Vaisala frequency
+    bvf,                            & ! square root of bvfsq
+    rh,rhold,rhl
+  real,parameter    :: const=r_air/ga, ric=0.25, b=100., bs=8.5
+  integer,parameter :: itmax=3
+
+  excess=0.0
+
+  if (metdata_format.eq.GRIBFILE_CENTRE_NCEP) then
+    ! NCEP version: find first model level above ground
+    !**************************************************
+
+     llev = 0
+     do i=1,nuvz
+       if (psurf.lt.akz(i)) llev=i
+     end do
+     llev = llev+1
+    ! sec llev should not be 1!
+     if (llev.eq.1) llev = 2
+     if (llev.gt.nuvz) llev = nuvz-1
+    ! NCEP version
+  end if
+
+
+  ! Compute virtual temperature and virtual potential temperature at
+  ! reference level (2 m)
+  !*****************************************************************
+
+  do iter=1,itmax,1
+
+    pold=psurf
+    tvold=tt2*(1.+0.378*ew(td2,psurf)/psurf)
+    zold=2.0
+    zref=zold
+    rhold=ew(td2,psurf)/ew(tt2,psurf)
+
+    thetaref=tvold*(100000./pold)**(r_air/cpa)+excess
+    thetaold=thetaref
+
+
+    ! Integrate z up to one level above zt
+    !*************************************
+    if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
+      loop_start=2
+    else
+      loop_start=llev
+    end if
+    do k=loop_start,nuvz
+      pint=akz(k)+bkz(k)*psurf  ! pressure on model layers
+      tv=ttlev(k)*(1.+0.608*qvlev(k))
+
+      if (abs(tv-tvold).gt.0.2) then
+        z=zold+const*log(pold/pint)*(tv-tvold)/log(tv/tvold)
+      else
+        z=zold+const*log(pold/pint)*tv
+      endif
+
+      theta=tv*(100000./pint)**(r_air/cpa)
+    ! Petra
+      rh = qvlev(k) / f_qvsat( pint, ttlev(k) )
+
+
+    ! Calculate Richardson number at each level
+    !****************************************
+
+      ri=ga/thetaref*(theta-thetaref)*(z-zref)/ &
+           max(((ulev(k)-ulev(2))**2+(vlev(k)-vlev(2))**2+b*ust**2),0.1)
+
+    !  addition of second condition: MH should not be placed in an
+    !  unstable layer (PS / Feb 2000)
+      if (ri.gt.ric .and. thetaold.lt.theta) exit
+
+      tvold=tv
+      pold=pint
+      rhold=rh
+      thetaold=theta
+      zold=z
+    end do
+    ! Check opied from FLEXPART-WRF, 2022 LB
+    if (k.ge.nuvz) then
+      write(*,*) 'richardson not working -- k = nuvz'
+      ierr = -10
+      goto 7000
+    endif
+    !k=min(k,nuvz) ! ESO: make sure k <= nuvz (ticket #139) !MD change to work without goto
+
+    ! Determine Richardson number between the critical levels
+    !********************************************************
+
+    zl1=zold
+    theta1=thetaold
+    do i=1,20
+      zl=zold+real(i)/20.*(z-zold)
+      ul=ulev(k-1)+real(i)/20.*(ulev(k)-ulev(k-1))
+      vl=vlev(k-1)+real(i)/20.*(vlev(k)-vlev(k-1))
+      thetal=thetaold+real(i)/20.*(theta-thetaold)
+      rhl=rhold+real(i)/20.*(rh-rhold)
+      ril=ga/thetaref*(thetal-thetaref)*(zl-zref)/ &
+           max(((ul-ulev(2))**2+(vl-vlev(2))**2+b*ust**2),0.1)
+      zl2=zl
+      theta2=thetal
+      if (ril.gt.ric) exit
+      if (i.eq.20) then
+        write(*,*) 'WARNING: NO RICHARDSON NUMBER GREATER THAN 0.25 FOUND', k,ril,ri
+        exit
+      endif
+      zl1=zl
+      theta1=thetal
+      !if (i.eq.20) stop 'RICHARDSON: NO RICHARDSON NUMBER GREATER THAN 0.25 FOUND'
+    end do
+
+    h=zl
+    thetam=0.5*(theta1+theta2)
+    wspeed=sqrt(ul**2+vl**2)                    ! Wind speed at z=hmix
+    bvfsq=(ga/thetam)*(theta2-theta1)/(zl2-zl1) ! Brunt-Vaisala frequency
+                                                ! at z=hmix
+
+    ! Under stable conditions, limit the maximum effect of the subgrid-scale topography
+    ! by the maximum lifting possible from the available kinetic energy
+    !*****************************************************************************
+
+    if(bvfsq.le.0.) then
+      hmixplus=9999.
+    else
+      bvf=sqrt(bvfsq)
+      hmixplus=wspeed/bvf*convke
+    endif
+
+
+    ! Calculate convective velocity scale
+    !************************************
+
+    if (hf.lt.0.) then
+      wst=(-h*ga/thetaref*hf/cpa)**0.333
+      excess=-bs*hf/cpa/wst
+    else
+      wst=0.
+      exit
+    endif
+  end do
+
+  ierr = 0
+  return
+
+! Fatal error -- print the inputs
+7000  continue
+  write(*,'(a         )') 'nuvz'
+  write(*,'(i5        )')  nuvz
+  write(*,'(a         )') 'psurf,ust,hf,tt2,td2,h,wst,hmixplus'
+  write(*,'(1p,4e18.10)')  psurf,ust,hf,tt2,td2,h,wst,hmixplus
+  write(*,'(a         )') 'ttlev'
+  write(*,'(1p,4e18.10)')  ttlev
+  write(*,'(a         )') 'qvlev'
+  write(*,'(1p,4e18.10)')  qvlev
+  write(*,'(a         )') 'ulev'
+  write(*,'(1p,4e18.10)')  ulev
+  write(*,'(a         )') 'vlev'
+  write(*,'(1p,4e18.10)')  vlev
+  write(*,'(a         )') 'pplev'
+  write(*,'(1p,4e18.10)')  pplev
+  return
+end subroutine richardson
diff --git a/src/get_scalev.f90 b/src/get_scalev.f90
new file mode 100644
index 0000000000000000000000000000000000000000..8db46359e36996140dafa0e2016f27ac39218ab0
--- /dev/null
+++ b/src/get_scalev.f90
@@ -0,0 +1,37 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+real function scalev(ps,t,td,stress)
+
+  !********************************************************************
+  !                                                                   *
+  !                       Author: G. WOTAWA                           *
+  !                       Date:   1994-06-27                          *
+  !                       Update: 1996-05-21 A. Stohl                 *
+  !                                                                   *
+  !********************************************************************
+  !                                                                   *
+  !     This Programm calculates scale velocity ustar from surface    *
+  !     stress and air density.                                       *
+  !                                                                   *
+  !********************************************************************
+  !                                                                   *
+  !     INPUT:                                                        *
+  !                                                                   *
+  !     ps      surface pressure [Pa]                                 *
+  !     t       surface temperature [K]                               *
+  !     td      surface dew point [K]                                 *
+  !     stress  surface stress [N/m2]                                 *
+  !                                                                   *
+  !********************************************************************
+  use qvsat_mod
+
+  implicit none
+
+  real :: ps,t,td,e,tv,rhoa,stress
+
+  e=ew(td,ps)                       ! vapor pressure
+  tv=t*(1.+0.378*e/ps)           ! virtual temperature
+  rhoa=ps/(r_air*tv)              ! air density
+  scalev=sqrt(abs(stress)/rhoa)
+end function scalev
diff --git a/src/getfields_mod.f90 b/src/getfields_mod.f90
index d0b3e71cbba03b00bb9be9db52f38aad8290bce3..662452fdc69fa93caa94045ca0e0b1020b9fed64 100644
--- a/src/getfields_mod.f90
+++ b/src/getfields_mod.f90
@@ -14,7 +14,7 @@
   !*****************************************************************************
 
 module getfields_mod
-  
+
   use par_mod
   use com_mod
   use windfields_mod
@@ -23,8 +23,8 @@ module getfields_mod
   implicit none
 
   real,allocatable,dimension(:,:,:) ::    &
-    uuh,                                  & ! wind components in x-direction [m/s] 
-    vvh,                                  & ! wind components in y-direction [m/s] 
+    uuh,                                  & ! wind components in x-direction [m/s]
+    vvh,                                  & ! wind components in y-direction [m/s]
     pvh,                                  & ! potential vorticity
     wwh                                     ! wind components in y-direction [m/s]
   real,allocatable,dimension(:,:,:,:) ::  & ! Same for nexted grids
@@ -32,7 +32,7 @@ module getfields_mod
     vvhn,                                 & !
     pvhn,                                 & !
     wwhn,                                 & !
-    pwater                                  ! RLT added partial pressure water vapor 
+    pwater                                  ! RLT added partial pressure water vapor
   real,allocatable,dimension(:,:,:) ::    & ! For calcpv
     ppml,                                 & !
     ppmk                                    !
@@ -48,1640 +48,24 @@ module getfields_mod
   public :: getfields
 contains
 
-subroutine alloc_getfields
-  implicit none
-  allocate(uuh(0:nxmax-1,0:nymax-1,nuvzmax),      &
-    vvh(0:nxmax-1,0:nymax-1,nuvzmax),             &
-    pvh(0:nxmax-1,0:nymax-1,nuvzmax),             &
-    wwh(0:nxmax-1,0:nymax-1,nwzmax),              &
-    uuhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests), &
-    vvhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests), &
-    pvhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests), &
-    wwhn(0:nxmaxn-1,0:nymaxn-1,nwzmax,maxnests),  &
-    pwater(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
-
-  allocate(ppml(0:nxmax-1,0:nymax-1,nuvzmax),ppmk(0:nxmax-1,0:nymax-1,nuvzmax))
-  allocate(ttlev(nuvzmax),qvlev(nuvzmax),ulev(nuvzmax),vlev(nuvzmax),zlev(nuvzmax))
-end subroutine alloc_getfields
-
-subroutine dealloc_getfields
-
-  implicit none
-  deallocate(uuh,vvh,pvh,wwh,uuhn,vvhn,pvhn,wwhn,pwater)
-  deallocate(ppml,ppmk)
-  deallocate(ttlev,qvlev,ulev,vlev,zlev)
-
-end subroutine dealloc_getfields
-
-subroutine getfields(itime,nstop)
-  !                       i     o
-  !*****************************************************************************
-  !                                                                            *
-  !  This subroutine manages the 3 data fields to be kept in memory.           *
-  !  During the first time step of petterssen it has to be fulfilled that the  *
-  !  first data field must have |wftime|<itime, i.e. the absolute value of     *
-  !  wftime must be smaller than the absolute value of the current time in [s].*
-  !  The other 2 fields are the next in time after the first one.              *
-  !  Pointers (memind) are used, because otherwise one would have to resort the*
-  !  wind fields, which costs a lot of computing time. Here only the pointers  *
-  !  are resorted.                                                             *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     29 April 1994                                                          *
-  !                                                                            *
-  !*****************************************************************************
-  !  Changes, Bernd C. Krueger, Feb. 2001:                                     *
-  !   Variables tth,qvh,tthn,qvhn (on eta coordinates) in common block.        *
-  !   Function of nstop extended.                                              *
-  !                                                                            *
-  !   Unified ECMWF and GFS builds                                             *
-  !   Marian Harustak, 12.5.2017                                               *
-  !     - Added passing of metdata_format as it was needed by called routines  *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! lwindinterval [s]    time difference between the two wind fields read in   *
-  ! indj                 indicates the number of the wind field to be read in  *
-  ! indmin               remembers the number of wind fields already treated   *
-  ! memind(2)            pointer, on which place the wind fields are stored    *
-  ! memtime(2) [s]       times of the wind fields, which are kept in memory    *
-  ! itime [s]            current time since start date of trajectory calcu-    *
-  !                      lation                                                *
-  ! nstop                > 0, if trajectory has to be terminated               *
-  ! nx,ny,nuvz,nwz       field dimensions in x,y and z direction               *
-  ! uu(0:nxmax,0:nymax,nuvzmax,2)   wind components in x-direction [m/s]       *
-  ! vv(0:nxmax,0:nymax,nuvzmax,2)   wind components in y-direction [m/s]       *
-  ! ww(0:nxmax,0:nymax,nwzmax,2)    wind components in z-direction [deltaeta/s]*
-  ! tt(0:nxmax,0:nymax,nuvzmax,2)   temperature [K]                            *
-  ! ps(0:nxmax,0:nymax,2)           surface pressure [Pa]                      *
-  ! metdata_format     format of metdata (ecmwf/gfs)                           *
-  !                                                                            *
-  ! Constants:                                                                 *
-  ! idiffmax             maximum allowable time difference between 2 wind      *
-  !                      fields                                                *
-  !                                                                            *
-  !*****************************************************************************
-
-  use class_gribfile_mod
-  use wetdepo_mod
-
-  implicit none
-
-  integer :: indj,itime,nstop,memaux
-  integer :: kz, ix
-  character(len=100) :: rowfmt
-
-  integer :: indmin = 1
-
-  ! Check, if wind fields are available for the current time step
-  !**************************************************************
-
-  nstop=0
-  if ((ldirect*wftime(1).gt.ldirect*itime).or. &
-       (ldirect*wftime(numbwf).lt.ldirect*itime)) then
-    write(*,*) 'FLEXPART WARNING: NO WIND FIELDS ARE AVAILABLE.'
-    write(*,*) 'A TRAJECTORY HAS TO BE TERMINATED.'
-    nstop=4
-    return
-  endif
-
-  if ((ldirect*memtime(1).le.ldirect*itime).and. &
-       (ldirect*memtime(2).gt.ldirect*itime)) then
-
-  ! The right wind fields are already in memory -> don't do anything
-  !*****************************************************************
-
-    continue
-
-  else if ((ldirect*memtime(2).le.ldirect*itime).and. &
-       (memtime(2).ne.999999999)) then
-
-
-  ! Current time is after 2nd wind field
-  ! -> Resort wind field pointers, so that current time is between 1st and 2nd
-  !***************************************************************************
-
-    memaux=memind(1)
-    memind(1)=memind(2)
-    memind(2)=memaux
-    memtime(1)=memtime(2)
-
-
-  ! Read a new wind field and store it on place memind(2)
-  !******************************************************
-
-    do indj=indmin,numbwf-1
-      if (ldirect*wftime(indj+1).gt.ldirect*itime) then
-        if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
-          call SYSTEM_CLOCK(count_clock, count_rate, count_max)
-          s_temp = (count_clock - count_clock0)/real(count_rate)
-          call readwind_ecmwf(indj+1,memind(2),uuh,vvh,wwh)
-          call SYSTEM_CLOCK(count_clock, count_rate, count_max)
-          s_readwind = s_readwind + ((count_clock - count_clock0)/real(count_rate)-s_temp)
-        else
-          call readwind_gfs(indj+1,memind(2),uuh,vvh,wwh)
-        end if
-        call readwind_nest(indj+1,memind(2),uuhn,vvhn,wwhn)
-        call calcpar(memind(2))
-        call calcpar_nest(memind(2))
-        if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
-          call verttransform_ecmwf(memind(2),uuh,vvh,wwh,pvh)
-        else
-          call verttransform_gfs(memind(2),uuh,vvh,wwh,pvh)
-        end if
-        call verttransform_nest(memind(2),uuhn,vvhn,wwhn,pvhn)
-        memtime(2)=wftime(indj+1)
-        nstop = 1
-        exit
-      endif
-    end do
-    indmin=indj
-
-    if ((WETBKDEP).and.(ipin.ne.3).and.(ipin.ne.4)) then
-      call writeprecip(itime,memind(1))
-    endif
-
-  else
-
-  ! No wind fields, which can be used, are currently in memory
-  ! -> read both wind fields
-  !***********************************************************
-
-    do indj=indmin,numbwf-1
-      if ((ldirect*wftime(indj).le.ldirect*itime).and. &
-           (ldirect*wftime(indj+1).gt.ldirect*itime)) then
-        memind(1)=1
-        if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
-          call SYSTEM_CLOCK(count_clock, count_rate, count_max)
-          s_temp = (count_clock - count_clock0)/real(count_rate)
-          call readwind_ecmwf(indj,memind(1),uuh,vvh,wwh)
-          call SYSTEM_CLOCK(count_clock, count_rate, count_max)
-          s_readwind = s_readwind + ((count_clock - count_clock0)/real(count_rate)-s_temp)
-        else
-          call readwind_gfs(indj,memind(1),uuh,vvh,wwh)
-        end if
-        call readwind_nest(indj,memind(1),uuhn,vvhn,wwhn)
-        call calcpar(memind(1))
-        call calcpar_nest(memind(1))
-        if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
-          call verttransform_ecmwf(memind(1),uuh,vvh,wwh,pvh)
-        else
-          call verttransform_gfs(memind(1),uuh,vvh,wwh,pvh)
-        end if
-        call verttransform_nest(memind(1),uuhn,vvhn,wwhn,pvhn)
-        memtime(1)=wftime(indj)
-        memind(2)=2
-        if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
-          call SYSTEM_CLOCK(count_clock, count_rate, count_max)
-          s_temp = (count_clock - count_clock0)/real(count_rate)
-          call readwind_ecmwf(indj+1,memind(2),uuh,vvh,wwh)
-          call SYSTEM_CLOCK(count_clock, count_rate, count_max)
-          s_readwind = s_readwind + ((count_clock - count_clock0)/real(count_rate)-s_temp)
-        else
-          call readwind_gfs(indj+1,memind(2),uuh,vvh,wwh)
-        end if
-        call readwind_nest(indj+1,memind(2),uuhn,vvhn,wwhn)
-        call calcpar(memind(2))
-        call calcpar_nest(memind(2))
-        if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
-          call verttransform_ecmwf(memind(2),uuh,vvh,wwh,pvh)
-        else
-          call verttransform_gfs(memind(2),uuh,vvh,wwh,pvh)
-        end if
-        call verttransform_nest(memind(2),uuhn,vvhn,wwhn,pvhn)
-        memtime(2)=wftime(indj+1)
-        nstop = 1
-        exit
-      endif
-    end do
-    indmin=indj
-
-    if ((WETBKDEP).and.(ipin.ne.3).and.(ipin.ne.4)) then
-      call writeprecip(itime,memind(1))
-    endif
-
-  end if
-
-  ! RLT calculate dry air density
-  if (DRYDEP) then
-    pwater=qv*prs/((r_air/r_water)*(1.-qv)+qv)
-    rho_dry=(prs-pwater)/(r_air*tt)
-  endif
-#ifndef USE_NCF
-  pwater=qv*prs/((r_air/r_water)*(1.-qv)+qv)
-  rho_dry=(prs-pwater)/(r_air*tt)
-#endif
-
-  lwindinterv=abs(memtime(2)-memtime(1))
-
-  if (lwindinterv.gt.idiffmax) nstop=3
-end subroutine getfields
-
-subroutine calcpv(n)
-  !               i  i   i   o
-  !*****************************************************************************
-  !                                                                            *
-  !  Calculation of potential vorticity on 3-d grid.                           *
-  !                                                                            *
-  !     Author: P. James                                                       *
-  !     3 February 2000                                                        *
-  !                                                                            *
-  !     Adaptation to FLEXPART, A. Stohl, 1 May 2000                           *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! n                  temporal index for meteorological fields (1 to 2)       *
-  !                                                                            *
-  ! Constants:                                                                 *
-  !                                                                            *
-  !*****************************************************************************
-
-  implicit none
-
-  integer :: n,ix,jy,i,j,k,kl,ii,jj,klvrp,klvrm,klpt,kup,kdn,kch
-  integer :: jyvp,jyvm,ixvp,ixvm,jumpx,jumpy,jux,juy,ivrm,ivrp,ivr
-  integer :: nlck
-  real :: vx(2),uy(2),phi,tanphi,cosphi,dvdx,dudy,f
-  real :: theta,thetap,thetam,dthetadp,dt1,dt2,dt
-  real :: pvavr
-  real :: thup,thdn
-  real,parameter :: eps=1.e-5, p0=101325
-
-  ! Set number of levels to check for adjacent theta
-  nlck=nuvz/3
-  !
-  ! Loop over entire grid
-  !**********************
-  do kl=1,nuvz
-    do jy=0,nymin1
-      do ix=0,nxmin1
-         ppml(ix,jy,kl)=akz(kl)+bkz(kl)*ps(ix,jy,1,n)
-      enddo
-    enddo
-  enddo
-
-!  ppmk(:,:,1:nuvz)=(100000./ppml(:,:,1:nuvz))**kappa
-  ppmk(0:nxmin1,0:nymin1,1:nuvz)=(100000./ppml(0:nxmin1,0:nymin1,1:nuvz))**kappa
-!$OMP PARALLEL PRIVATE(jy,ix,kl,phi,f,tanphi,cosphi,jyvp,jyvm,jumpy,juy, &
-!$OMP ixvp,ixvm,jumpx,ivrp,ivrm,jux,theta,klvrp,klvrm,klpt,thetap,thetam,dthetadp, &
-!$OMP ii,i,ivr,kdn,kch,kup,thdn,thup,dt1,dt2,dt,vx,k,dvdx, &
-!$OMP jj,j,uy,dudy)
-!$OMP DO
-  do jy=0,nymin1
-    if (sglobal.and.jy.eq.0) cycle
-    if (nglobal.and.jy.eq.nymin1) cycle
-    phi = (ylat0 + jy * dy) * pi / 180.
-    f = 0.00014585 * sin(phi)
-    tanphi = tan(phi)
-    cosphi = cos(phi)
-  ! Provide a virtual jy+1 and jy-1 in case we are on domain edge (Lat)
-    jyvp=jy+1
-    jyvm=jy-1
-    if (jy.eq.0) jyvm=0
-    if (jy.eq.nymin1) jyvp=nymin1
-  ! Define absolute gap length
-    jumpy=2
-    if (jy.eq.0.or.jy.eq.nymin1) jumpy=1
-    if (sglobal.and.jy.eq.1) then
-      jyvm=1
-      jumpy=1
-    end if
-    if (nglobal.and.jy.eq.ny-2) then
-      jyvp=ny-2
-      jumpy=1
-    end if
-    juy=jumpy
-  !
-    do ix=0,nxmin1
-  ! Provide a virtual ix+1 and ix-1 in case we are on domain edge (Long)
-      ixvp=ix+1
-      ixvm=ix-1
-      jumpx=2
-      if (xglobal) then
-         ivrp=ixvp
-         ivrm=ixvm
-         if (ixvm.lt.0) ivrm=ixvm+nxmin1
-         if (ixvp.ge.nx) ivrp=ixvp-nx+1
-      else
-        if (ix.eq.0) ixvm=0
-        if (ix.eq.nxmin1) ixvp=nxmin1
-        ivrp=ixvp
-        ivrm=ixvm
-  ! Define absolute gap length
-        if (ix.eq.0.or.ix.eq.nxmin1) jumpx=1
-      end if
-      jux=jumpx
-  !
-  ! Loop over the vertical
-  !***********************
-
-      do kl=1,nuvz
-        theta=tth(ix,jy,kl,n)*ppmk(ix,jy,kl)
-        klvrp=kl+1
-        klvrm=kl-1
-        klpt=kl
-  ! If top or bottom level, dthetadp is evaluated between the current
-  ! level and the level inside, otherwise between level+1 and level-1
-  !
-        if (klvrp.gt.nuvz) klvrp=nuvz
-        if (klvrm.lt.1) klvrm=1
-        thetap=tth(ix,jy,klvrp,n)*ppmk(ix,jy,klvrp)
-        thetam=tth(ix,jy,klvrm,n)*ppmk(ix,jy,klvrm)
-        dthetadp=(thetap-thetam)/(ppml(ix,jy,klvrp)-ppml(ix,jy,klvrm))
-
-  ! Compute vertical position at pot. temperature surface on subgrid
-  ! and the wind at that position
-  !*****************************************************************
-  ! a) in x direction
-        ii=0
-        x_loop: do i=ixvm,ixvp,jumpx
-          ivr=i
-          if (xglobal) then
-             if (i.lt.0) ivr=ivr+nxmin1
-             if (i.ge.nx) ivr=ivr-nx+1
-          end if
-          ii=ii+1
-  ! Search adjacent levels for current theta value
-  ! Spiral out from current level for efficiency
-          kup=klpt-1
-          kdn=klpt
-          kch=0
-          x_lev_loop: do while (kch.lt.nlck)
-  ! Upward branch
-            kup=kup+1
-            if (kup.lt.nuvz) then
-              kch=kch+1
-              k=kup
-              thdn=tth(ivr,jy,k,n)*ppmk(ivr,jy,k)
-              thup=tth(ivr,jy,k+1,n)*ppmk(ivr,jy,k+1)
-
-
-              if (((thdn.ge.theta).and.(thup.le.theta)).or. &
-              ((thdn.le.theta).and.(thup.ge.theta))) then
-                dt1=abs(theta-thdn)
-                dt2=abs(theta-thup)
-                dt=dt1+dt2
-                if (dt.lt.eps) then   ! Avoid division by zero error
-                  dt1=0.5             ! G.W., 10.4.1996
-                  dt2=0.5
-                  dt=1.0
-                endif
-                vx(ii)=(vvh(ivr,jy,k)*dt2+vvh(ivr,jy,k+1)*dt1)/dt
-                cycle x_loop
-              endif
-            endif
-    ! Downward branch
-            kdn=kdn-1
-            if (kdn.ge.1) then
-              kch=kch+1
-              k=kdn
-              thdn=tth(ivr,jy,k,n)*ppmk(ivr,jy,k)
-              thup=tth(ivr,jy,k+1,n)*ppmk(ivr,jy,k+1)
-
-              if (((thdn.ge.theta).and.(thup.le.theta)).or. &
-              ((thdn.le.theta).and.(thup.ge.theta))) then
-                dt1=abs(theta-thdn)
-                dt2=abs(theta-thup)
-                dt=dt1+dt2
-                if (dt.lt.eps) then   ! Avoid division by zero error
-                  dt1=0.5             ! G.W., 10.4.1996
-                  dt2=0.5
-                  dt=1.0
-                endif
-                vx(ii)=(vvh(ivr,jy,k)*dt2+vvh(ivr,jy,k+1)*dt1)/dt
-                cycle x_loop
-              endif
-            endif
-          end do x_lev_loop
-    ! This section used when no values were found
-  ! Must use vv at current level and long. jux becomes smaller by 1
-          vx(ii)=vvh(ix,jy,kl)
-          jux=jux-1
-  ! Otherwise OK
-        end do x_loop
-        if (jux.gt.0) then
-          dvdx=(vx(2)-vx(1))/real(jux)/(dx*pi/180.)
-        else
-          dvdx=vvh(ivrp,jy,kl)-vvh(ivrm,jy,kl)
-          dvdx=dvdx/real(jumpx)/(dx*pi/180.)
-  ! Only happens if no equivalent theta value
-  ! can be found on either side, hence must use values
-  ! from either side, same pressure level.
-        end if
-
-  ! b) in y direction
-
-        jj=0
-        y_loop: do j=jyvm,jyvp,jumpy
-          jj=jj+1
-  ! Search adjacent levels for current theta value
-  ! Spiral out from current level for efficiency
-          kup=klpt-1
-          kdn=klpt
-          kch=0
-          y_lev_loop: do while (kch.lt.nlck)
-  ! Upward branch
-            kup=kup+1
-            if (kup.lt.nuvz) then
-              kch=kch+1
-              k=kup
-              thdn=tth(ix,j,k,n)*ppmk(ix,j,k)
-              thup=tth(ix,j,k+1,n)*ppmk(ix,j,k+1)
-              if (((thdn.ge.theta).and.(thup.le.theta)).or. &
-              ((thdn.le.theta).and.(thup.ge.theta))) then
-                dt1=abs(theta-thdn)
-                dt2=abs(theta-thup)
-                dt=dt1+dt2
-                if (dt.lt.eps) then   ! Avoid division by zero error
-                  dt1=0.5             ! G.W., 10.4.1996
-                  dt2=0.5
-                  dt=1.0
-                endif
-                uy(jj)=(uuh(ix,j,k)*dt2+uuh(ix,j,k+1)*dt1)/dt
-                cycle y_loop
-              endif
-            endif
-    ! Downward branch
-            kdn=kdn-1
-            if (kdn.ge.1) then
-              kch=kch+1
-              k=kdn
-              thdn=tth(ix,j,k,n)*ppmk(ix,j,k)
-              thup=tth(ix,j,k+1,n)*ppmk(ix,j,k+1)
-              if (((thdn.ge.theta).and.(thup.le.theta)).or. &
-              ((thdn.le.theta).and.(thup.ge.theta))) then
-                dt1=abs(theta-thdn)
-                dt2=abs(theta-thup)
-                dt=dt1+dt2
-                if (dt.lt.eps) then   ! Avoid division by zero error
-                  dt1=0.5             ! G.W., 10.4.1996
-                  dt2=0.5
-                  dt=1.0
-                endif
-                uy(jj)=(uuh(ix,j,k)*dt2+uuh(ix,j,k+1)*dt1)/dt
-                cycle y_loop
-              endif
-            endif
-          end do y_lev_loop
-  ! This section used when no values were found
-  ! Must use uu at current level and lat. juy becomes smaller by 1
-          uy(jj)=uuh(ix,jy,kl)
-          juy=juy-1
-  ! Otherwise OK
-        end do y_loop
-        if (juy.gt.0) then
-          dudy=(uy(2)-uy(1))/real(juy)/(dy*pi/180.)
-        else
-          dudy=uuh(ix,jyvp,kl)-uuh(ix,jyvm,kl)
-          dudy=dudy/real(jumpy)/(dy*pi/180.)
-        end if
-    !
-        pvh(ix,jy,kl)=dthetadp*(f+(dvdx/cosphi-dudy &
-             +uuh(ix,jy,kl)*tanphi)/r_earth)*(-1.e6)*9.81
-  !
-  ! Resest jux and juy
-        jux=jumpx
-        juy=jumpy
-      end do
-    end do
-  end do
-!$OMP END DO 
-!$OMP END PARALLEL
-  !
-  ! Fill in missing PV values on poles, if present
-  ! Use mean PV of surrounding latitude ring
-  !
-  if (sglobal) then
-     do kl=1,nuvz
-        pvavr=0.
-        do ix=0,nxmin1
-           pvavr=pvavr+pvh(ix,1,kl)
-        end do
-        pvavr=pvavr/real(nx)
-        jy=0
-        do ix=0,nxmin1
-           pvh(ix,jy,kl)=pvavr
-        end do
-     end do
-  end if
-  if (nglobal) then
-     do kl=1,nuvz
-        pvavr=0.
-        do ix=0,nxmin1
-           pvavr=pvavr+pvh(ix,ny-2,kl)
-        end do
-        pvavr=pvavr/real(nx)
-        jy=nymin1
-        do ix=0,nxmin1
-           pvh(ix,jy,kl)=pvavr
-        end do
-     end do
-  end if
-end subroutine calcpv
-
-subroutine calcpv_nest(l,n)
-  !                     i i  i    i    o
-  !*****************************************************************************
-  !                                                                            *
-  !  Calculation of potential vorticity on 3-d nested grid                     *
-  !                                                                            *
-  !     Author: P. James                                                       *
-  !     22 February 2000                                                       *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! n                  temporal index for meteorological fields (1 to 2)       *
-  ! l                  index of current nest                                   *
-  !                                                                            *
-  ! Constants:                                                                 *
-  !                                                                            *
-  !*****************************************************************************
-  
-  implicit none
-
-  integer :: n,ix,jy,i,j,k,kl,ii,jj,klvrp,klvrm,klpt,kup,kdn,kch
-  integer :: jyvp,jyvm,ixvp,ixvm,jumpx,jumpy,jux,juy,ivrm,ivrp,ivr
-  integer :: nlck,l
-  real :: vx(2),uy(2),phi,tanphi,cosphi,dvdx,dudy,f
-  real :: theta,thetap,thetam,dthetadp,dt1,dt2,dt
-  real :: thup,thdn
-  real,parameter :: eps=1.e-5,p0=101325
-
-  ! Set number of levels to check for adjacent theta
-  nlck=nuvz/3
-  !
-  ! Loop over entire grid
-  !**********************
-  do kl=1,nuvz
-    do jy=0,nyn(l)-1
-      do ix=0,nxn(l)-1
-         ppml(ix,jy,kl)=akz(kl)+bkz(kl)*psn(ix,jy,1,n,l)
-      enddo
-    enddo
-  enddo
-  !  ppmk=(100000./ppml)**kappa
-  ppmk(0:nxn(l)-1,0:nyn(l)-1,1:nuvz)=(100000./ppml(0:nxn(l)-1,0:nyn(l)-1,1:nuvz))**kappa
-
-  do jy=0,nyn(l)-1
-    phi = (ylat0n(l) + jy * dyn(l)) * pi / 180.
-    f = 0.00014585 * sin(phi)
-    tanphi = tan(phi)
-    cosphi = cos(phi)
-  ! Provide a virtual jy+1 and jy-1 in case we are on domain edge (Lat)
-      jyvp=jy+1
-      jyvm=jy-1
-      if (jy.eq.0) jyvm=0
-      if (jy.eq.nyn(l)-1) jyvp=nyn(l)-1
-  ! Define absolute gap length
-      jumpy=2
-      if (jy.eq.0.or.jy.eq.nyn(l)-1) jumpy=1
-      juy=jumpy
-  !
-    do ix=0,nxn(l)-1
-  ! Provide a virtual ix+1 and ix-1 in case we are on domain edge (Long)
-      ixvp=ix+1
-      ixvm=ix-1
-      jumpx=2
-      if (ix.eq.0) ixvm=0
-      if (ix.eq.nxn(l)-1) ixvp=nxn(l)-1
-      ivrp=ixvp
-      ivrm=ixvm
-  ! Define absolute gap length
-      if (ix.eq.0.or.ix.eq.nxn(l)-1) jumpx=1
-      jux=jumpx
-  !
-  ! Loop over the vertical
-  !***********************
-
-      do kl=1,nuvz
-        theta=tthn(ix,jy,kl,n,l)*ppmk(ix,jy,kl)
-        klvrp=kl+1
-        klvrm=kl-1
-        klpt=kl
-  ! If top or bottom level, dthetadp is evaluated between the current
-  ! level and the level inside, otherwise between level+1 and level-1
-  !
-        if (klvrp.gt.nuvz) klvrp=nuvz
-        if (klvrm.lt.1) klvrm=1
-        thetap=tthn(ix,jy,klvrp,n,l)*ppmk(ix,jy,klvrp)
-        thetam=tthn(ix,jy,klvrm,n,l)*ppmk(ix,jy,klvrm)
-        dthetadp=(thetap-thetam)/(ppml(ix,jy,klvrp)-ppml(ix,jy,klvrm))
-
-  ! Compute vertical position at pot. temperature surface on subgrid
-  ! and the wind at that position
-  !*****************************************************************
-  ! a) in x direction
-        ii=0
-        x_loop: do i=ixvm,ixvp,jumpx
-          ivr=i
-          ii=ii+1
-  ! Search adjacent levels for current theta value
-  ! Spiral out from current level for efficiency
-          kup=klpt-1
-          kdn=klpt
-          kch=0
-          x_lev_loop: do while (kch.lt.nlck)
-  ! Upward branch
-            kup=kup+1
-            if (kup.lt.nuvz) then
-              kch=kch+1
-              k=kup
-              thdn=tthn(ivr,jy,k,n,l)*ppmk(ivr,jy,k)
-              thup=tthn(ivr,jy,k+1,n,l)*ppmk(ivr,jy,k+1)
-
-              if (((thdn.ge.theta).and.(thup.le.theta)).or. &
-              ((thdn.le.theta).and.(thup.ge.theta))) then
-                dt1=abs(theta-thdn)
-                dt2=abs(theta-thup)
-                dt=dt1+dt2
-                if (dt.lt.eps) then   ! Avoid division by zero error
-                  dt1=0.5             ! G.W., 10.4.1996
-                  dt2=0.5
-                  dt=1.0
-                endif
-                vx(ii)=(vvhn(ivr,jy,k,l)*dt2+vvhn(ivr,jy,k+1,l)*dt1)/dt
-                cycle x_loop
-              endif
-            endif
-  ! Downward branch
-            kdn=kdn-1
-            if (kdn.ge.1) then
-              kch=kch+1
-              k=kdn
-              thdn=tthn(ivr,jy,k,n,l)*ppmk(ivr,jy,k)
-              thup=tthn(ivr,jy,k+1,n,l)*ppmk(ivr,jy,k+1)
-              
-              if (((thdn.ge.theta).and.(thup.le.theta)).or. &
-              ((thdn.le.theta).and.(thup.ge.theta))) then
-                dt1=abs(theta-thdn)
-                dt2=abs(theta-thup)
-                dt=dt1+dt2
-                if (dt.lt.eps) then   ! Avoid division by zero error
-                  dt1=0.5             ! G.W., 10.4.1996
-                  dt2=0.5
-                  dt=1.0
-                endif
-                vx(ii)=(vvhn(ivr,jy,k,l)*dt2+vvhn(ivr,jy,k+1,l)*dt1)/dt
-                cycle x_loop
-              endif
-            endif
-          end do x_lev_loop
-  ! This section used when no values were found
-  ! Must use vv at current level and long. jux becomes smaller by 1
-          vx(ii)=vvhn(ix,jy,kl,l)
-          jux=jux-1
-  ! Otherwise OK
-        end do x_loop
-        if (jux.gt.0) then
-          dvdx=(vx(2)-vx(1))/real(jux)/(dxn(l)*pi/180.)
-        else
-          dvdx=vvhn(ivrp,jy,kl,l)-vvhn(ivrm,jy,kl,l)
-          dvdx=dvdx/real(jumpx)/(dxn(l)*pi/180.)
-  ! Only happens if no equivalent theta value
-  ! can be found on either side, hence must use values
-  ! from either side, same pressure level.
-        end if
-
-  ! b) in y direction
-
-        jj=0
-        y_loop: do j=jyvm,jyvp,jumpy
-          jj=jj+1
-  ! Search adjacent levels for current theta value
-  ! Spiral out from current level for efficiency
-          kup=klpt-1
-          kdn=klpt
-          kch=0
-          y_lev_loop: do while (kch.lt.nlck)
-  ! Upward branch
-            kup=kup+1
-            if (kup.lt.nuvz) then
-              kch=kch+1
-              k=kup
-              thdn=tthn(ix,j,k,n,l)*ppmk(ix,j,k)
-              thup=tthn(ix,j,k+1,n,l)*ppmk(ix,j,k+1)
-              if (((thdn.ge.theta).and.(thup.le.theta)).or. &
-              ((thdn.le.theta).and.(thup.ge.theta))) then
-                dt1=abs(theta-thdn)
-                dt2=abs(theta-thup)
-                dt=dt1+dt2
-                if (dt.lt.eps) then   ! Avoid division by zero error
-                  dt1=0.5             ! G.W., 10.4.1996
-                  dt2=0.5
-                  dt=1.0
-                endif
-                uy(jj)=(uuhn(ix,j,k,l)*dt2+uuhn(ix,j,k+1,l)*dt1)/dt
-                cycle y_loop
-              endif
-            endif
-  ! Downward branch
-            kdn=kdn-1
-            if (kdn.ge.1) then
-              kch=kch+1
-              k=kdn
-              thdn=tthn(ix,j,k,n,l)*ppmk(ix,j,k)
-              thup=tthn(ix,j,k+1,n,l)*ppmk(ix,j,k+1)
-              if (((thdn.ge.theta).and.(thup.le.theta)).or. &
-              ((thdn.le.theta).and.(thup.ge.theta))) then
-                dt1=abs(theta-thdn)
-                dt2=abs(theta-thup)
-                dt=dt1+dt2
-                if (dt.lt.eps) then   ! Avoid division by zero error
-                  dt1=0.5             ! G.W., 10.4.1996
-                  dt2=0.5
-                  dt=1.0
-                endif
-                uy(jj)=(uuhn(ix,j,k,l)*dt2+uuhn(ix,j,k+1,l)*dt1)/dt
-                cycle y_loop
-              endif
-            endif
-          end do y_lev_loop
-  ! This section used when no values were found
-  ! Must use uu at current level and lat. juy becomes smaller by 1
-          uy(jj)=uuhn(ix,jy,kl,l)
-          juy=juy-1
-  ! Otherwise OK
-        end do y_loop
-        if (juy.gt.0) then
-          dudy=(uy(2)-uy(1))/real(juy)/(dyn(l)*pi/180.)
-        else
-          dudy=uuhn(ix,jyvp,kl,l)-uuhn(ix,jyvm,kl,l)
-          dudy=dudy/real(jumpy)/(dyn(l)*pi/180.)
-        end if
-
-        pvhn(ix,jy,kl,l)=dthetadp*(f+(dvdx/cosphi-dudy &
-             +uuhn(ix,jy,kl,l)*tanphi)/r_earth)*(-1.e6)*9.81
-
-  ! Resest jux and juy
-        jux=jumpx
-        juy=jumpy
-      end do
-    end do
-  end do
-end subroutine calcpv_nest
-
-subroutine calcpar(n)
-  !                   i  i   i   o
-  !*****************************************************************************
-  !                                                                            *
-  !     Computation of several boundary layer parameters needed for the        *
-  !     dispersion calculation and calculation of dry deposition velocities.   *
-  !     All parameters are calculated over the entire grid.                    *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     21 May 1995                                                            *
-  !                                                                            *
-  ! ------------------------------------------------------------------         *
-  !     Petra Seibert, Feb 2000:                                               *
-  !     convection scheme:                                                     *
-  !     new variables in call to richardson                                    *
-  !                                                                            *
-  !   CHANGE 17/11/2005 Caroline Forster NCEP GFS version                      *
-  !                                                                            *
-  !   Changes, Bernd C. Krueger, Feb. 2001:                                    *
-  !    Variables tth and qvh (on eta coordinates) in common block              *
-  !                                                                            *
-  !   Unified ECMWF and GFS builds                                             *
-  !   Marian Harustak, 12.5.2017                                               *
-  !     - Merged calcpar and calcpar_gfs into one routine using if-then        *
-  !       for meteo-type dependent code                                        *
-  !*****************************************************************************
-
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! n                  temporal index for meteorological fields (1 to 3)       *
-  ! metdata_format     format of metdata (ecmwf/gfs)                           * 
-  !                                                                            *
-  ! Constants:                                                                 *
-  !                                                                            *
-  !                                                                            *
-  ! Functions:                                                                 *
-  ! scalev             computation of ustar                                    *
-  ! obukhov            computatio of Obukhov length                            *
-  !                                                                            *
-  !*****************************************************************************
-
-  use class_gribfile_mod
-  use drydepo_mod, global_ol => ol
-  use qvsat_mod
-
-  implicit none
-
-  integer :: n,ix,jy,i,kz,lz,kzmin,llev,loop_start,ierr
-  real :: ol,hmixplus
-  real :: rh,subsceff,ylat
-  real :: altmin,tvold,pold,zold,pint,tv,hmixdummy,akzdummy
-  real :: vd(maxspec)
-  real :: z0_tmp(numclass) ! temporary variable for z0 (shared between OMP threads)
-  real,parameter :: const=r_air/ga
-
-  !write(*,*) 'in calcpar writting snowheight'
-  !***********************************
-  ! for test: write out snow depths
-
-  ! open(4,file='slandusetest',form='formatted')
-  ! do 5 ix=0,nxmin1
-  !5       write (4,*) (sd(ix,jy,1,n),jy=0,nymin1)
-  !  close(4)
-
-
-  ! Loop over entire grid
-  !**********************
-
-  ! openmp change
-  z0_tmp = z0
-  !$OMP PARALLEL PRIVATE(jy,ix,ulev,vlev,ttlev,qvlev,llev,ylat,ol,i,hmixplus, &
-  !$OMP subsceff,vd,kz,lz,zlev,rh,kzmin,pold,zold,tvold,pint,tv,loop_start,ierr, &
-  !$OMP altmin)
-  z0 = z0_tmp
-
-  !$OMP DO
-  do jy=0,nymin1
-
-  ! Set minimum height for tropopause
-  !**********************************
-
-    ylat=ylat0+real(jy)*dy
-    if ((ylat.ge.-20.).and.(ylat.le.20.)) then
-      altmin = 5000.
-    else
-      if ((ylat.gt.20.).and.(ylat.lt.40.)) then
-        altmin=2500.+(40.-ylat)*125.
-      else if ((ylat.gt.-40.).and.(ylat.lt.-20.)) then
-        altmin=2500.+(40.+ylat)*125.
-      else
-        altmin=2500.
-      endif
-    endif
-
-    do ix=0,nxmin1
-
-  ! 1) Calculation of friction velocity
-  !************************************
+#include "get_alloc_getfields.f90"
 
-      ustar(ix,jy,1,n)=scalev(ps(ix,jy,1,n),tt2(ix,jy,1,n), &
-           td2(ix,jy,1,n),sfcstress(ix,jy,1,n))
-      if (ustar(ix,jy,1,n).le.1.e-8) ustar(ix,jy,1,n)=1.e-8
+#include "get_dealloc_getfields.f90"
 
-  ! 2) Calculation of inverse Obukhov length scale
-  !***********************************************
+#include "get_getfields.f90"
 
-      if (metdata_format.eq.GRIBFILE_CENTRE_NCEP) then
-        ! NCEP version: find first level above ground
-        llev = 0
-        do i=1,nuvz
-          if (ps(ix,jy,1,n).lt.akz(i)) llev=i
-        end do
-        llev = llev+1
-        if (llev.gt.nuvz) llev = nuvz-1
-        ! NCEP version
+#include "get_calcpv.f90"
 
-        ! calculate inverse Obukhov length scale with tth(llev)
-        ol=obukhov(ps(ix,jy,1,n),tt2(ix,jy,1,n),td2(ix,jy,1,n), &
-          tth(ix,jy,llev,n),ustar(ix,jy,1,n),sshf(ix,jy,1,n), &
-          akm,bkm,akz(llev))
-      else
-        llev=0
-        ol=obukhov(ps(ix,jy,1,n),tt2(ix,jy,1,n),td2(ix,jy,1,n), &
-          tth(ix,jy,2,n),ustar(ix,jy,1,n),sshf(ix,jy,1,n),akm,bkm,akzdummy)
-      end if
+#include "get_calcpv_nest.f90"
 
-      if (ol.ne.0.) then
-        oli(ix,jy,1,n)=1./ol
-      else
-        oli(ix,jy,1,n)=99999.
-      endif
+#include "get_calcpar.f90"
 
+#include "get_calcpar_nest.f90"
 
-  ! 3) Calculation of convective velocity scale and mixing height
-  !**************************************************************
-
-      do i=1,nuvz
-        ulev(i)=uuh(ix,jy,i)
-        vlev(i)=vvh(ix,jy,i)
-        ttlev(i)=tth(ix,jy,i,n)
-        qvlev(i)=qvh(ix,jy,i,n)
-      end do
-
-      if (metdata_format.eq.GRIBFILE_CENTRE_NCEP) then
-        ! NCEP version hmix has been read in in readwind.f, is therefore not calculated here
-      call richardson(ps(ix,jy,1,n),ustar(ix,jy,1,n),ttlev,qvlev, &
-           ulev,vlev,nuvz,akz,bkz,sshf(ix,jy,1,n),tt2(ix,jy,1,n), &
-             td2(ix,jy,1,n),hmixdummy,wstar(ix,jy,1,n),hmixplus,ierr)
-      else
-        call richardson(ps(ix,jy,1,n),ustar(ix,jy,1,n),ttlev,qvlev, &
-             ulev,vlev,nuvz,akz,bkz,sshf(ix,jy,1,n),tt2(ix,jy,1,n), &
-             td2(ix,jy,1,n),hmix(ix,jy,1,n),wstar(ix,jy,1,n),hmixplus,ierr)
-      end if
-
-      if (ierr.lt.0) then
-        write(*,9500) 'failure', ix, jy
-        stop
-      endif
-9500      format( 'calcpar - richardson ', a, ' - ix,jy=', 2i5 )
-      
-      if(lsubgrid.eq.1) then
-        subsceff=min(excessoro(ix,jy),hmixplus)
-      else
-        subsceff=0.0
-      endif
-  !
-  ! CALCULATE HMIX EXCESS ACCORDING TO SUBGRIDSCALE VARIABILITY AND STABILITY
-  !
-      hmix(ix,jy,1,n)=hmix(ix,jy,1,n)+subsceff
-      hmix(ix,jy,1,n)=max(hmixmin,hmix(ix,jy,1,n)) ! set minimum PBL height
-      hmix(ix,jy,1,n)=min(hmixmax,hmix(ix,jy,1,n)) ! set maximum PBL height
-
-  ! 4) Calculation of dry deposition velocities
-  !********************************************
-
-      if (DRYDEP) then
-  ! Sabine Eckhardt, Dec 06: use new index for z0 for water depending on
-  ! windspeed
-        z0(7)=0.016*ustar(ix,jy,1,n)*ustar(ix,jy,1,n)/ga
-
-  ! Calculate relative humidity at surface
-  !***************************************
-        rh=ew(td2(ix,jy,1,n),ps(ix,jy,1,n))/ew(tt2(ix,jy,1,n),ps(ix,jy,1,n))
-
-        call getvdep(n,ix,jy,ustar(ix,jy,1,n), &
-             tt2(ix,jy,1,n),ps(ix,jy,1,n),1./oli(ix,jy,1,n), &
-             ssr(ix,jy,1,n),rh,lsprec(ix,jy,1,n)+convprec(ix,jy,1,n), &
-             sd(ix,jy,1,n),vd)
-
-        do i=1,nspec
-          vdep(ix,jy,i,n)=vd(i)
-        end do
-
-      endif
-
-  !******************************************************
-  ! Calculate height of thermal tropopause (Hoinka, 1997)
-  !******************************************************
-
-  ! 1) Calculate altitudes of model levels
-  !***************************************
-
-      tvold=tt2(ix,jy,1,n)*(1.+0.378*ew(td2(ix,jy,1,n),ps(ix,jy,1,n))/ &
-           ps(ix,jy,1,n))
-      pold=ps(ix,jy,1,n)
-      zold=0.
-      if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
-        loop_start=2
-      else
-        loop_start=llev
-      end if
-      do kz=loop_start,nuvz
-        pint=akz(kz)+bkz(kz)*ps(ix,jy,1,n)  ! pressure on model layers
-        tv=tth(ix,jy,kz,n)*(1.+0.608*qvh(ix,jy,kz,n))
-
-        if (abs(tv-tvold).gt.0.2) then
-          zlev(kz)=zold+const*log(pold/pint)*(tv-tvold)/log(tv/tvold)
-        else
-          zlev(kz)=zold+const*log(pold/pint)*tv
-        endif
-        tvold=tv
-        pold=pint
-        zold=zlev(kz)
-      end do
-
-  ! 2) Define a minimum level kzmin, from which upward the tropopause is
-  !    searched for. This is to avoid inversions in the lower troposphere
-  !    to be identified as the tropopause
-  !************************************************************************
-
-      if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
-        !LB, The CTM version has 2 (as bugfix), so I changed it 2 from 1 to try out
-        loop_start=2
-      else
-        loop_start=llev
-      end if
-
-      do kz=loop_start,nuvz
-        if (zlev(kz).ge.altmin) then
-          kzmin=kz
-          exit
-        endif
-      end do
-
-  ! 3) Search for first stable layer above minimum height that fulfills the
-  !    thermal tropopause criterion
-  !************************************************************************
-
-      outer: do kz=kzmin,nuvz
-        inner: do lz=kz+1,nuvz
-          if ((zlev(lz)-zlev(kz)).gt.2000.) then
-            if (((tth(ix,jy,kz,n)-tth(ix,jy,lz,n))/ &
-                 (zlev(lz)-zlev(kz))).lt.0.002) then
-              tropopause(ix,jy,1,n)=zlev(kz)
-              exit outer
-            endif
-            exit inner
-          endif
-        end do inner
-      end do outer
-
-    end do
-  end do
-  !$OMP END DO
-  !$OMP END PARALLEL
-  ! openmp change end
-
-  ! Calculation of potential vorticity on 3-d grid
-  !***********************************************
-
-  call calcpv(n)
-end subroutine calcpar
-
-subroutine calcpar_nest(n)
-  !                         i  i    i    o
-  !*****************************************************************************
-  !                                                                            *
-  !     Computation of several boundary layer parameters needed for the        *
-  !     dispersion calculation and calculation of dry deposition velocities.   *
-  !     All parameters are calculated over the entire grid.                    *
-  !     This routine is similar to calcpar, but is used for the nested grids.  *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     8 February 1999                                                        *
-  !                                                                            *
-  ! ------------------------------------------------------------------         *
-  !     Petra Seibert, Feb 2000:                                               *
-  !     convection scheme:                                                     *
-  !     new variables in call to richardson                                    *
-  !                                                                            *
-  !*****************************************************************************
-  !  Changes, Bernd C. Krueger, Feb. 2001:                                     *
-  !   Variables tth and qvh (on eta coordinates) in common block               *
-  !                                                                            *
-  !   Unified ECMWF and GFS builds                                             *
-  !   Marian Harustak, 12.5.2017                                               *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! n                  temporal index for meteorological fields (1 to 3)       *
-  ! metdata_format     format of metdata (ecmwf/gfs)                           *
-  !                                                                            *
-  ! Constants:                                                                 *
-  !                                                                            *
-  !                                                                            *
-  ! Functions:                                                                 *
-  ! scalev             computation of ustar                                    *
-  ! obukhov            computatio of Obukhov length                            *
-  !                                                                            *
-  !*****************************************************************************
-
-  use drydepo_mod, global_ol => ol
-  use qvsat_mod
-
-  implicit none
-
-  integer :: n,ix,jy,i,l,kz,lz,kzmin,ierr
-  real :: ol,hmixplus,dummyakzllev
-  real :: rh,subsceff,ylat
-  real :: altmin,tvold,pold,zold,pint,tv
-  real :: vd(maxspec)
-  real :: z0_tmp(numclass) ! temporary variable for z0 (shared between OMP threads)
-  real,parameter :: const=r_air/ga
-
-
-  ! Loop over all nests
-  !********************
-
-  do l=1,numbnests
-
-  ! Loop over entire grid
-  !**********************
-  z0_tmp = z0
-!$OMP PARALLEL DEFAULT(SHARED) &
-!$OMP PRIVATE(i,ix,jy,kz,lz,kzmin,tvold,pold,zold,zlev,tv,pint, &
-!$OMP rh,ierr,subsceff,ulev,vlev,ttlev,qvlev,ol,altmin,ylat,hmixplus, &
-!$OMP dummyakzllev,vd )
-  z0 = z0_tmp
-
-!$OMP DO
-  do jy=0,nyn(l)-1
-
-  ! Set minimum height for tropopause
-  !**********************************
-
-    ylat=ylat0n(l)+real(jy)*dyn(l)
-    if ((ylat.ge.-20.).and.(ylat.le.20.)) then
-      altmin = 5000.
-    else
-      if ((ylat.gt.20.).and.(ylat.lt.40.)) then
-        altmin=2500.+(40.-ylat)*125.
-      else if ((ylat.gt.-40.).and.(ylat.lt.-20.)) then
-        altmin=2500.+(40.+ylat)*125.
-      else
-        altmin=2500.
-      endif
-    endif
-
-    do ix=0,nxn(l)-1
-
-  ! 1) Calculation of friction velocity
-  !************************************
-
-      ustarn(ix,jy,1,n,l)=scalev(psn(ix,jy,1,n,l),tt2n(ix,jy,1,n,l), &
-           td2n(ix,jy,1,n,l),sfcstressn(ix,jy,1,n,l))
-      if (ustarn(ix,jy,1,n,l).le.1.e-8) ustarn(ix,jy,1,n,l)=1.e-8
-
-  ! 2) Calculation of inverse Obukhov length scale
-  !***********************************************
-
-      ol=obukhov(psn(ix,jy,1,n,l),tt2n(ix,jy,1,n,l), &
-           td2n(ix,jy,1,n,l),tthn(ix,jy,2,n,l),ustarn(ix,jy,1,n,l), &
-           sshfn(ix,jy,1,n,l),akm,bkm,dummyakzllev)
-      if (ol.ne.0.) then
-        olin(ix,jy,1,n,l)=1./ol
-      else
-        olin(ix,jy,1,n,l)=99999.
-      endif
-
-
-  ! 3) Calculation of convective velocity scale and mixing height
-  !**************************************************************
-
-      do i=1,nuvz
-        ulev(i)=uuhn(ix,jy,i,l)
-        vlev(i)=vvhn(ix,jy,i,l)
-        ttlev(i)=tthn(ix,jy,i,n,l)
-        qvlev(i)=qvhn(ix,jy,i,n,l)
-      end do
-
-      call richardson(psn(ix,jy,1,n,l),ustarn(ix,jy,1,n,l),ttlev, &
-           qvlev,ulev,vlev,nuvz,akz,bkz,sshfn(ix,jy,1,n,l), &
-           tt2n(ix,jy,1,n,l),td2n(ix,jy,1,n,l),hmixn(ix,jy,1,n,l), &
-           wstarn(ix,jy,1,n,l),hmixplus,ierr)
-      if (ierr.lt.0) then
-        write(*,9500) 'failure', ix, jy, l
-        stop
-      endif
-9500      format( 'calcparn - richardson ', a, ' - ix,jy=', 2i5 )
-
-      if(lsubgrid.eq.1) then
-        subsceff=min(excessoron(ix,jy,l),hmixplus)
-      else
-        subsceff=0.0
-      endif
-  !
-  ! CALCULATE HMIX EXCESS ACCORDING TO SUBGRIDSCALE VARIABILITY AND STABILITY
-  !
-      hmixn(ix,jy,1,n,l)=hmixn(ix,jy,1,n,l)+subsceff
-      hmixn(ix,jy,1,n,l)=max(hmixmin,hmixn(ix,jy,1,n,l)) ! minim PBL height
-      hmixn(ix,jy,1,n,l)=min(hmixmax,hmixn(ix,jy,1,n,l)) ! maxim PBL height
-
-
-  ! 4) Calculation of dry deposition velocities
-  !********************************************
-
-      if (DRYDEP) then
-        ! z0(4)=0.016*ustarn(ix,jy,1,n,l)*ustarn(ix,jy,1,n,l)/ga
-        ! z0(9)=0.016*ustarn(ix,jy,1,n,l)*ustarn(ix,jy,1,n,l)/ga
-        z0(7)=0.016*ustarn(ix,jy,1,n,l)*ustarn(ix,jy,1,n,l)/ga
-
-  ! Calculate relative humidity at surface
-  !***************************************
-        rh=ew(td2n(ix,jy,1,n,l),psn(ix,jy,1,n,l))/ew(tt2n(ix,jy,1,n,l),psn(ix,jy,1,n,l))
-
-        call getvdep_nest(n,ix,jy,ustarn(ix,jy,1,n,l), &
-             tt2n(ix,jy,1,n,l),psn(ix,jy,1,n,l),1./olin(ix,jy,1,n,l), &
-             ssrn(ix,jy,1,n,l),rh,lsprecn(ix,jy,1,n,l)+ &
-             convprecn(ix,jy,1,n,l),sdn(ix,jy,1,n,l),vd,l)
-
-        do i=1,nspec
-          vdepn(ix,jy,i,n,l)=vd(i)
-        end do
-
-      endif
-
-  !******************************************************
-  ! Calculate height of thermal tropopause (Hoinka, 1997)
-  !******************************************************
-
-  ! 1) Calculate altitudes of ECMWF model levels
-  !*********************************************
-
-      tvold=tt2n(ix,jy,1,n,l)*(1.+0.378*ew(td2n(ix,jy,1,n,l),psn(ix,jy,1,n,l))/ &
-           psn(ix,jy,1,n,l))
-      pold=psn(ix,jy,1,n,l)
-      zold=0.
-      do kz=2,nuvz
-        pint=akz(kz)+bkz(kz)*psn(ix,jy,1,n,l)  ! pressure on model layers
-        tv=tthn(ix,jy,kz,n,l)*(1.+0.608*qvhn(ix,jy,kz,n,l))
-
-        if (abs(tv-tvold).gt.0.2) then
-         zlev(kz)=zold+const*log(pold/pint)*(tv-tvold)/log(tv/tvold)
-        else
-          zlev(kz)=zold+const*log(pold/pint)*tv
-        endif
-        tvold=tv
-        pold=pint
-        zold=zlev(kz)
-      end do
-
-  ! 2) Define a minimum level kzmin, from which upward the tropopause is
-  !    searched for. This is to avoid inversions in the lower troposphere
-  !    to be identified as the tropopause
-  !************************************************************************
-
-      do kz=1,nuvz
-        if (zlev(kz).ge.altmin) then
-          kzmin=kz
-          exit
-        endif
-      end do
-
-  ! 3) Search for first stable layer above minimum height that fulfills the
-  !    thermal tropopause criterion
-  !************************************************************************
-
-      kzloop : do kz=kzmin,nuvz
-        lzloop : do lz=kz+1,nuvz
-          if ((zlev(lz)-zlev(kz)).gt.2000.) then
-            if (((tthn(ix,jy,kz,n,l)-tthn(ix,jy,lz,n,l))/ &
-                 (zlev(lz)-zlev(kz))).lt.0.002) then
-              tropopausen(ix,jy,1,n,l)=zlev(kz)
-              exit kzloop
-            endif
-            exit lzloop
-          endif
-        end do lzloop
-      end do kzloop
-
-    end do
-  end do
-
-!$OMP END DO
-!$OMP END PARALLEL
-
-  ! Calculation of potential vorticity on 3-d grid
-  !***********************************************
-
-  call calcpv_nest(l,n)
-
-  end do
-end subroutine calcpar_nest
-
-real function obukhov(ps,tsurf,tdsurf,tlev,ustar,hf,akm,bkm,plev)
-
-  !********************************************************************
-  !                                                                   *
-  !                       Author: G. WOTAWA                           *
-  !                       Date:   1994-06-27                          *
-  !                                                                   *
-  !     This program calculates Obukhov scale height from surface     *
-  !     meteorological data and sensible heat flux.                   *
-  !                                                                   *
-  !********************************************************************
-  !                                                                   *
-  !  Update: A. Stohl, 2000-09-25, avoid division by zero by          *
-  !  setting ustar to minimum value                                   *
-  !  CHANGE: 17/11/2005 Caroline Forster NCEP GFS version             *
-  !                                                                   *
-  !   Unified ECMWF and GFS builds                                    *
-  !   Marian Harustak, 12.5.2017                                      *
-  !     - Merged obukhov and obukhov_gfs into one routine using       *
-  !       if-then for meteo-type dependent code                       *
-  !                                                                   *
-  !********************************************************************
-  !                                                                   *
-  !     INPUT:                                                        *
-  !                                                                   *
-  !     ps      surface pressure [Pa]                                 *
-  !     tsurf   surface temperature [K]                               *
-  !     tdsurf  surface dew point [K]                                 *
-  !     tlev    temperature first model level [K]                     *
-  !     ustar   scale velocity [m/s]                                  *
-  !     hf      surface sensible heat flux [W/m2]                     *
-  !     akm     ECMWF vertical discretization parameter               *
-  !     bkm     ECMWF vertical discretization parameter               *
-  !     plev                                                          *
-  !     metdata_format format of metdata (ecmwf/gfs)                  *
-  !                                                                   *
-  !********************************************************************
-
-  use class_gribfile_mod
-  use qvsat_mod
-
-  implicit none
-
-  real,dimension(:) :: akm,bkm
-  real :: ps,tsurf,tdsurf,tlev,ustar,hf,e,tv,rhoa,plev
-  real :: ak1,bk1,theta,thetastar
-
-
-  e=ew(tdsurf,ps)                           ! vapor pressure
-  tv=tsurf*(1.+0.378*e/ps)               ! virtual temperature
-  rhoa=ps/(r_air*tv)                      ! air density
-  if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
-  ak1=(akm(1)+akm(2))/2.
-  bk1=(bkm(1)+bkm(2))/2.
-  plev=ak1+bk1*ps                        ! Pressure level 1
-  end if
-  theta=tlev*(100000./plev)**(r_air/cpa) ! potential temperature
-  if (ustar.le.0.) ustar=1.e-8
-  thetastar=hf/(rhoa*cpa*ustar)           ! scale temperature
-  if(abs(thetastar).gt.1.e-10) then
-     obukhov=theta*ustar**2/(karman*ga*thetastar)
-  else
-     obukhov=9999                        ! zero heat flux
-  endif
-  if (obukhov.gt. 9999.) obukhov= 9999.
-  if (obukhov.lt.-9999.) obukhov=-9999.
-end function obukhov
-
-subroutine richardson(psurf,ust,ttlev,qvlev,ulev,vlev,nuvz, &
-       akz,bkz,hf,tt2,td2,h,wst,hmixplus,ierr)
-  !                        i    i    i     i    i    i    i
-  ! i   i  i   i   i  o  o     o
-  !****************************************************************************
-  !                                                                           *
-  !     Calculation of mixing height based on the critical Richardson number. *
-  !     Calculation of convective time scale.                                 *
-  !     For unstable conditions, one iteration is performed. An excess        *
-  !     temperature (dependent on hf and wst) is calculated, added to the     *
-  !     temperature at the lowest model level. Then the procedure is repeated.*
-  !                                                                           *
-  !     Author: A. Stohl                                                      *
-  !                                                                           *
-  !     22 August 1996                                                        *
-  !                                                                           *
-  !     Literature:                                                           *
-  !     Vogelezang DHP and Holtslag AAM (1996): Evaluation and model impacts  *
-  !     of alternative boundary-layer height formulations. Boundary-Layer     *
-  !     Meteor. 81, 245-269.                                                  *
-  !                                                                           *
-  !****************************************************************************
-  !                                                                           *
-  !     Update: 1999-02-01 by G. Wotawa                                       *
-  !                                                                           *
-  !     Two meter level (temperature, humidity) is taken as reference level   *
-  !     instead of first model level.                                         *
-  !     New input variables tt2, td2 introduced.                              *
-  !                                                                           *
-  !     CHANGE: 17/11/2005 Caroline Forster NCEP GFS version                  * 
-  !                                                                           *
-  !     Unified ECMWF and GFS builds                                          *
-  !     Marian Harustak, 12.5.2017                                            *
-  !       - Merged richardson and richardson_gfs into one routine using       *
-  !         if-then for meteo-type dependent code                             *
-  !                                                                           *
-  !****************************************************************************
-  !                                                                           *
-  ! Variables:                                                                *
-  ! h                          mixing height [m]                              *
-  ! hf                         sensible heat flux                             *
-  ! psurf                      surface pressure at point (xt,yt) [Pa]         *
-  ! tv                         virtual temperature                            *
-  ! wst                        convective velocity scale                      *
-  ! metdata_format             format of metdata (ecmwf/gfs)                  *
-  !                                                                           *
-  ! Constants:                                                                *
-  ! ric                        critical Richardson number                     *
-  !                                                                           *
-  !****************************************************************************
-
-  use class_gribfile_mod
-  use qvsat_mod
-
-  implicit none
-
-  integer,intent(out) ::            &
-    ierr                              ! Returns error when no richardson number can be found
-  real, intent(out) ::              &
-    h,                              & ! mixing height [m]
-    wst,                            & ! convective velocity scale
-    hmixplus                          !
-  integer,intent(in)  ::            &
-    nuvz                              ! Upper vertical level
-  real,intent(in) ::                &
-    psurf,                          & ! surface pressure at point (xt,yt) [Pa] 
-    ust,                            & ! Scale velocity
-    hf,                             & ! Surface sensible heat flux
-    tt2,td2                           ! Temperature
-  real,intent(in),dimension(:) ::   &
-    ttlev,                          &
-    qvlev,                          &
-    ulev,                           &
-    vlev,                           &
-    akz,bkz
-  integer ::                        &
-    i,k,iter,llev,loop_start          ! Loop variables
-  real ::                           &
-    tv,tvold,                       & ! Virtual temperature
-    zref,z,zold,zl,zl1,zl2,         & ! Heights
-    pint,pold,                      & ! Pressures
-    theta,thetaold,thetaref,thetal, & ! Potential temperature
-    theta1,theta2,thetam,           &
-    ri,                             & ! Richardson number per level
-    ril,                            & ! Richardson number sub level
-    excess,                         & !
-    ul,vl,                          & ! Velocities sub level
-    wspeed,                         & ! Wind speed at z=hmix
-    bvfsq,                          & ! Brunt-Vaisala frequency
-    bvf,                            & ! square root of bvfsq
-    rh,rhold,rhl
-  real,parameter    :: const=r_air/ga, ric=0.25, b=100., bs=8.5
-  integer,parameter :: itmax=3
-
-  excess=0.0
-
-  if (metdata_format.eq.GRIBFILE_CENTRE_NCEP) then
-    ! NCEP version: find first model level above ground
-    !**************************************************
-
-     llev = 0
-     do i=1,nuvz
-       if (psurf.lt.akz(i)) llev=i
-     end do
-     llev = llev+1
-    ! sec llev should not be 1!
-     if (llev.eq.1) llev = 2
-     if (llev.gt.nuvz) llev = nuvz-1
-    ! NCEP version
-  end if
-
-
-  ! Compute virtual temperature and virtual potential temperature at
-  ! reference level (2 m)
-  !*****************************************************************
-
-  do iter=1,itmax,1
-
-    pold=psurf
-    tvold=tt2*(1.+0.378*ew(td2,psurf)/psurf)
-    zold=2.0
-    zref=zold
-    rhold=ew(td2,psurf)/ew(tt2,psurf)
-
-    thetaref=tvold*(100000./pold)**(r_air/cpa)+excess
-    thetaold=thetaref
-
-
-    ! Integrate z up to one level above zt
-    !*************************************
-    if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then
-      loop_start=2
-    else
-      loop_start=llev
-    end if
-    do k=loop_start,nuvz
-      pint=akz(k)+bkz(k)*psurf  ! pressure on model layers
-      tv=ttlev(k)*(1.+0.608*qvlev(k))
-
-      if (abs(tv-tvold).gt.0.2) then
-        z=zold+const*log(pold/pint)*(tv-tvold)/log(tv/tvold)
-      else
-        z=zold+const*log(pold/pint)*tv
-      endif
-
-      theta=tv*(100000./pint)**(r_air/cpa)
-    ! Petra
-      rh = qvlev(k) / f_qvsat( pint, ttlev(k) )
-
-
-    ! Calculate Richardson number at each level
-    !****************************************
-
-      ri=ga/thetaref*(theta-thetaref)*(z-zref)/ &
-           max(((ulev(k)-ulev(2))**2+(vlev(k)-vlev(2))**2+b*ust**2),0.1)
-
-    !  addition of second condition: MH should not be placed in an
-    !  unstable layer (PS / Feb 2000)
-      if (ri.gt.ric .and. thetaold.lt.theta) exit
-
-      tvold=tv
-      pold=pint
-      rhold=rh
-      thetaold=theta
-      zold=z
-    end do
-    ! Check opied from FLEXPART-WRF, 2022 LB
-    if (k.ge.nuvz) then
-      write(*,*) 'richardson not working -- k = nuvz'
-      ierr = -10
-      goto 7000
-    endif
-    !k=min(k,nuvz) ! ESO: make sure k <= nuvz (ticket #139) !MD change to work without goto
-
-    ! Determine Richardson number between the critical levels
-    !********************************************************
-
-    zl1=zold
-    theta1=thetaold
-    do i=1,20
-      zl=zold+real(i)/20.*(z-zold)
-      ul=ulev(k-1)+real(i)/20.*(ulev(k)-ulev(k-1))
-      vl=vlev(k-1)+real(i)/20.*(vlev(k)-vlev(k-1))
-      thetal=thetaold+real(i)/20.*(theta-thetaold)
-      rhl=rhold+real(i)/20.*(rh-rhold)
-      ril=ga/thetaref*(thetal-thetaref)*(zl-zref)/ &
-           max(((ul-ulev(2))**2+(vl-vlev(2))**2+b*ust**2),0.1)
-      zl2=zl
-      theta2=thetal
-      if (ril.gt.ric) exit
-      if (i.eq.20) then
-        write(*,*) 'WARNING: NO RICHARDSON NUMBER GREATER THAN 0.25 FOUND', k,ril,ri
-        exit
-      endif
-      zl1=zl
-      theta1=thetal
-      !if (i.eq.20) stop 'RICHARDSON: NO RICHARDSON NUMBER GREATER THAN 0.25 FOUND'
-    end do
-
-    h=zl
-    thetam=0.5*(theta1+theta2)
-    wspeed=sqrt(ul**2+vl**2)                    ! Wind speed at z=hmix
-    bvfsq=(ga/thetam)*(theta2-theta1)/(zl2-zl1) ! Brunt-Vaisala frequency
-                                                ! at z=hmix
-
-    ! Under stable conditions, limit the maximum effect of the subgrid-scale topography
-    ! by the maximum lifting possible from the available kinetic energy
-    !*****************************************************************************
-
-    if(bvfsq.le.0.) then
-      hmixplus=9999.
-    else
-      bvf=sqrt(bvfsq)
-      hmixplus=wspeed/bvf*convke
-    endif
-
-
-    ! Calculate convective velocity scale
-    !************************************
-
-    if (hf.lt.0.) then
-      wst=(-h*ga/thetaref*hf/cpa)**0.333
-      excess=-bs*hf/cpa/wst
-    else
-      wst=0.
-      exit
-    endif
-  end do
-
-  ierr = 0
-  return
-
-! Fatal error -- print the inputs
-7000  continue
-  write(*,'(a         )') 'nuvz'
-  write(*,'(i5        )')  nuvz
-  write(*,'(a         )') 'psurf,ust,hf,tt2,td2,h,wst,hmixplus'
-  write(*,'(1p,4e18.10)')  psurf,ust,hf,tt2,td2,h,wst,hmixplus
-  write(*,'(a         )') 'ttlev'
-  write(*,'(1p,4e18.10)')  ttlev
-  write(*,'(a         )') 'qvlev'
-  write(*,'(1p,4e18.10)')  qvlev
-  write(*,'(a         )') 'ulev'
-  write(*,'(1p,4e18.10)')  ulev
-  write(*,'(a         )') 'vlev'
-  write(*,'(1p,4e18.10)')  vlev
-  write(*,'(a         )') 'pplev'
-  write(*,'(1p,4e18.10)')  pplev
-  return
-end subroutine richardson
-
-real function scalev(ps,t,td,stress)
-
-  !********************************************************************
-  !                                                                   *
-  !                       Author: G. WOTAWA                           *
-  !                       Date:   1994-06-27                          *
-  !                       Update: 1996-05-21 A. Stohl                 *
-  !                                                                   *
-  !********************************************************************
-  !                                                                   *
-  !     This Programm calculates scale velocity ustar from surface    *
-  !     stress and air density.                                       *
-  !                                                                   *
-  !********************************************************************
-  !                                                                   *
-  !     INPUT:                                                        *
-  !                                                                   *
-  !     ps      surface pressure [Pa]                                 *
-  !     t       surface temperature [K]                               *
-  !     td      surface dew point [K]                                 *
-  !     stress  surface stress [N/m2]                                 *
-  !                                                                   *
-  !********************************************************************
-  use qvsat_mod
-
-  implicit none
+#include "get_obukhov.f90"
 
-  real :: ps,t,td,e,tv,rhoa,stress
+#include "get_richardson.f90"
 
-  e=ew(td,ps)                       ! vapor pressure
-  tv=t*(1.+0.378*e/ps)           ! virtual temperature
-  rhoa=ps/(r_air*tv)              ! air density
-  scalev=sqrt(abs(stress)/rhoa)
-end function scalev
+#include "get_scalev.f90"
 
 end module getfields_mod
diff --git a/src/ini_alloc_domainfill.f90 b/src/ini_alloc_domainfill.f90
new file mode 100644
index 0000000000000000000000000000000000000000..355565a2db5c66181bc8ab1af8b6be96c491e06c
--- /dev/null
+++ b/src/ini_alloc_domainfill.f90
@@ -0,0 +1,9 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine alloc_domainfill
+
+  allocate(numcolumn_we(2,0:nymax-1),numcolumn_sn(2,0:nxmax-1))
+  allocate(zcolumn_we(2,0:nymax-1,maxcolumn),zcolumn_sn(2,0:nxmax-1,maxcolumn),&
+    acc_mass_we(2,0:nymax-1,maxcolumn),acc_mass_sn(2,0:nxmax-1,maxcolumn))
+end subroutine alloc_domainfill
diff --git a/src/ini_boundcond_domainfill.f90 b/src/ini_boundcond_domainfill.f90
new file mode 100644
index 0000000000000000000000000000000000000000..4b4207e1b1866f471f9129e56b39323b3d2b8b61
--- /dev/null
+++ b/src/ini_boundcond_domainfill.f90
@@ -0,0 +1,530 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine boundcond_domainfill(itime,loutend)
+  !                                  i      i
+  !*****************************************************************************
+  !                                                                            *
+  ! Particles are created by this subroutine continuously throughout the       *
+  ! simulation at the boundaries of the domain-filling box.                    *
+  ! All particles carry the same amount of mass which alltogether comprises the*
+  ! mass of air within the box, which remains (more or less) constant.         *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     16 October 2002                                                        *
+  !                                                                            *
+  !  Changes                                                                   *
+  !     2022, L. Bakels: OpenMP parallelisation                                *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  ! nx_we(2)       grid indices for western and eastern boundary of domain-    *
+  !                filling trajectory calculations                             *
+  ! ny_sn(2)       grid indices for southern and northern boundary of domain-  *
+  !                filling trajectory calculations                             *
+  !                                                                            *
+  !*****************************************************************************
+
+  use point_mod
+#ifdef _OPENMP
+  use omp_lib
+#endif
+  implicit none
+
+  real :: dz,dz1,dz2,dt1,dt2,dtt,ylat,xm,cosfact,accmasst
+  integer :: itime,in,indz,indzp,i,loutend,numparticlecount_tmp
+  integer :: j,k,ix,jy,m,indzh,indexh,minpart,ipart,mmass,ithread
+  integer :: numactiveparticles
+
+  real :: windl(2),rhol(2)
+  real :: windhl(2),rhohl(2)
+  real :: windx,rhox
+  real :: deltaz,boundarea,fluxofmass
+
+  integer :: ixm,ixp,jym,jyp,indzm,mm
+  real :: pvpart,ddx,ddy,rddx,rddy,p1,p2,p3,p4,y1(2),yh1(2)
+
+  integer :: idummy = -11
+
+
+  ! If domain-filling is global, no boundary conditions are needed
+  !***************************************************************
+
+  if (gdomainfill) return
+
+  ! Determine auxiliary variables for time interpolation
+  !*****************************************************
+
+  dt1=real(itime-memtime(1))
+  dt2=real(memtime(2)-itime)
+  dtt=1./(dt1+dt2)
+
+  numactiveparticles=0
+  numparticlecount_tmp=numparticlecount
+  accmasst=0.
+  ! Terminate trajectories that have left the domain, if domain-filling
+  ! trajectory calculation domain is not global
+  !********************************************************************
+
+  do i=1,numpart
+    if (.not. part(i)%alive) cycle
+
+    if ((part(i)%ylat.gt.real(ny_sn(2))).or. &
+         (part(i)%ylat.lt.real(ny_sn(1)))) call terminate_particle(i,itime)
+    if (((.not.xglobal).or.(nx_we(2).ne.(nx-2))).and. &
+         ((part(i)%xlon.lt.real(nx_we(1))).or. &
+         (part(i)%xlon.gt.real(nx_we(2))))) call terminate_particle(i,itime)
+    if (part(i)%alive) numactiveparticles = numactiveparticles+1
+  end do
+
+  !***************************************
+  ! Western and eastern boundary condition
+  !***************************************
+
+  ! Loop from south to north
+  !*************************
+!$OMP PARALLEL PRIVATE(i,jy,k,j,deltaz,boundarea,indz,indzp,indexh,windl,rhol, &
+!$OMP windhl,rhohl,windx,rhox,fluxofmass,mmass,ixm,jym,ixp,jyp,ddx,ddy,rddx, &
+!$OMP rddy,p1,p2,p3,p4,indzm,mm,indzh,pvpart,ylat,ix,cosfact,ipart) &
+!$OMP REDUCTION(+:numactiveparticles,numparticlecount_tmp,accmasst)
+
+#ifdef _OPENMP
+  ithread = OMP_GET_THREAD_NUM()
+#else
+  ithread = 0
+#endif
+
+!$OMP DO
+  do jy=ny_sn(1),ny_sn(2)
+
+  ! Loop over western (index 1) and eastern (index 2) boundary
+  !***********************************************************
+
+    do k=1,2
+
+  ! Loop over all release locations in a column
+  !********************************************
+
+      do j=1,numcolumn_we(k,jy)
+
+  ! Determine, for each release location, the area of the corresponding boundary
+  !*****************************************************************************
+
+        if (j.eq.1) then
+          deltaz=(zcolumn_we(k,jy,2)+zcolumn_we(k,jy,1))/2.
+        else if (j.eq.numcolumn_we(k,jy)) then
+  ! In order to avoid taking a very high column for very many particles,
+  ! use the deltaz from one particle below instead
+          deltaz=(zcolumn_we(k,jy,j)-zcolumn_we(k,jy,j-2))/2.
+        else
+          deltaz=(zcolumn_we(k,jy,j+1)-zcolumn_we(k,jy,j-1))/2.
+        endif
+        if ((jy.eq.ny_sn(1)).or.(jy.eq.ny_sn(2))) then
+          boundarea=deltaz*111198.5/2.*dy
+        else
+          boundarea=deltaz*111198.5*dy
+        endif
+
+
+  ! Interpolate the wind velocity and density to the release location
+  !******************************************************************
+
+  ! Determine the model level below the release position
+  !*****************************************************
+        indz=nz-1
+        indzp=nz
+        do i=2,nz
+          if (height(i).gt.zcolumn_we(k,jy,j)) then
+            indz=i-1
+            indzp=i
+            exit
+          endif
+        end do
+
+  ! Vertical distance to the level below and above current position
+  !****************************************************************
+
+        dz1=zcolumn_we(k,jy,j)-height(indz)
+        dz2=height(indzp)-zcolumn_we(k,jy,j)
+        dz=1./(dz1+dz2)
+
+  ! Vertical and temporal interpolation
+  !************************************
+
+        do m=1,2
+          indexh=memind(m)
+          do in=1,2
+            indzh=indz+in-1
+            windl(in)=uu(nx_we(k),jy,indzh,indexh)
+            rhol(in)=rho(nx_we(k),jy,indzh,indexh)
+          end do
+
+          windhl(m)=(dz2*windl(1)+dz1*windl(2))*dz
+          rhohl(m)=(dz2*rhol(1)+dz1*rhol(2))*dz
+        end do
+
+        windx=(windhl(1)*dt2+windhl(2)*dt1)*dtt
+        rhox=(rhohl(1)*dt2+rhohl(2)*dt1)*dtt
+
+  ! Calculate mass flux
+  !********************
+
+        fluxofmass=windx*rhox*boundarea*real(lsynctime)
+
+
+  ! If the mass flux is directed into the domain, add it to previous mass fluxes;
+  ! if it is out of the domain, set accumulated mass flux to zero
+  !******************************************************************************
+
+        if (k.eq.1) then
+          if (fluxofmass.ge.0.) then
+            acc_mass_we(k,jy,j)=acc_mass_we(k,jy,j)+fluxofmass
+          else
+            acc_mass_we(k,jy,j)=0.
+          endif
+        else
+          if (fluxofmass.le.0.) then
+            acc_mass_we(k,jy,j)=acc_mass_we(k,jy,j)+abs(fluxofmass)
+          else
+            acc_mass_we(k,jy,j)=0.
+          endif
+        endif
+        accmasst=accmasst+acc_mass_we(k,jy,j)
+
+  ! If the accumulated mass exceeds half the mass that each particle shall carry,
+  ! one (or more) particle(s) is (are) released and the accumulated mass is
+  ! reduced by the mass of this (these) particle(s)
+  !******************************************************************************
+
+        if (acc_mass_we(k,jy,j).ge.xmassperparticle/2.) then
+          mmass=int((acc_mass_we(k,jy,j)+xmassperparticle/2.)/ &
+               xmassperparticle)
+          acc_mass_we(k,jy,j)=acc_mass_we(k,jy,j)- &
+               real(mmass)*xmassperparticle
+        else
+          mmass=0
+        endif
+
+        do m=1,mmass
+          call get_newpart_index(ipart)
+          call spawn_particle(itime, ipart)
+
+  ! Assign particle positions
+  !**************************
+
+          call set_xlon(ipart,real(nx_we(k),kind=dp))
+          if (jy.eq.ny_sn(1)) then
+            call set_ylat(ipart,real(real(jy)+0.5*ran1(idummy,ithread),kind=dp))
+          else if (jy.eq.ny_sn(2)) then
+            call set_ylat(ipart,real(real(jy)-0.5*ran1(idummy,ithread),kind=dp))
+          else
+            call set_ylat(ipart,real(real(jy)+(ran1(idummy,ithread)-.5),kind=dp))
+          endif
+          if (j.eq.1) then
+            call set_z(ipart,zcolumn_we(k,jy,1)+(zcolumn_we(k,jy,2)- &
+                 zcolumn_we(k,jy,1))/4.)
+          else if (j.eq.numcolumn_we(k,jy)) then
+            call set_z(ipart,(2.*zcolumn_we(k,jy,j)+ &
+                 zcolumn_we(k,jy,j-1)+height(nz))/4.)
+          else
+            call set_z(ipart,zcolumn_we(k,jy,j-1)+ran1(idummy,ithread)* &
+                 (zcolumn_we(k,jy,j+1)-zcolumn_we(k,jy,j-1)))
+          endif
+
+          call update_z_to_zeta(itime, ipart)
+
+  ! Interpolate PV to the particle position
+  !****************************************
+          ixm=int(part(ipart)%xlon)
+          jym=int(part(ipart)%ylat)
+          ixp=ixm+1
+          jyp=jym+1
+          ddx=part(ipart)%xlon-real(ixm)
+          ddy=part(ipart)%ylat-real(jym)
+          rddx=1.-ddx
+          rddy=1.-ddy
+          p1=rddx*rddy
+          p2=ddx*rddy
+          p3=rddx*ddy
+          p4=ddx*ddy
+          indzm=nz-1
+          indzp=nz
+          do i=2,nz
+            if (real(height(i),kind=dp).gt.part(ipart)%z) then
+              indzm=i-1
+              indzp=i
+              exit
+            endif
+          end do
+          dz1=real(part(ipart)%z)-height(indzm)
+          dz2=height(indzp)-real(part(ipart)%z)
+          dz=1./(dz1+dz2)
+          do mm=1,2
+            indexh=memind(mm)
+            do in=1,2
+              indzh=indzm+in-1
+              y1(in)=p1*pv(ixm,jym,indzh,indexh) &
+                   +p2*pv(ixp,jym,indzh,indexh) &
+                   +p3*pv(ixm,jyp,indzh,indexh) &
+                   +p4*pv(ixp,jyp,indzh,indexh)
+            end do
+            yh1(mm)=(dz2*y1(1)+dz1*y1(2))*dz
+          end do
+          pvpart=(yh1(1)*dt2+yh1(2)*dt1)*dtt
+          ylat=ylat0+part(ipart)%ylat*dy
+          if (ylat.lt.0.) pvpart=-1.*pvpart
+
+
+  ! For domain-filling option 2 (stratospheric O3), do the rest only in the stratosphere
+  !*****************************************************************************
+
+          if (((part(ipart)%z.gt.3000.).and. &
+               (pvpart.gt.pvcrit)).or.(mdomainfill.eq.1)) then
+            part(ipart)%nclass=min(int(ran1(idummy,ithread)* &
+                 real(nclassunc))+1,nclassunc)
+            numactiveparticles=numactiveparticles+1
+            numparticlecount_tmp=numparticlecount_tmp+1
+            part(ipart)%npoint=numparticlecount_tmp
+            part(ipart)%idt=mintime
+            part(ipart)%tstart=itime
+            part(ipart)%mass(1)=xmassperparticle
+            if (mdomainfill.eq.2) part(ipart)%mass(1)= &
+                 part(ipart)%mass(1)*pvpart*48./29.*ozonescale/10.**9
+            part(ipart)%mass_init(1)=part(ipart)%mass(1)
+          else
+            stop 'boundcond_domainfill error: look into original to understand what should happen here'
+          endif
+        end do ! particles
+      end do ! release locations in column
+    end do ! western and eastern boundary
+  end do ! south to north
+!$OMP END DO
+
+  !*****************************************
+  ! Southern and northern boundary condition
+  !*****************************************
+
+  ! Loop from west to east
+  !***********************
+!$OMP DO
+  do ix=nx_we(1),nx_we(2)
+
+  ! Loop over southern (index 1) and northern (index 2) boundary
+  !*************************************************************
+
+    do k=1,2
+      ylat=ylat0+real(ny_sn(k))*dy
+      cosfact=cos(ylat*pi180)
+
+  ! Loop over all release locations in a column
+  !********************************************
+
+      do j=1,numcolumn_sn(k,ix)
+
+  ! Determine, for each release location, the area of the corresponding boundary
+  !*****************************************************************************
+
+        if (j.eq.1) then
+          deltaz=(zcolumn_sn(k,ix,2)+zcolumn_sn(k,ix,1))/2.
+        else if (j.eq.numcolumn_sn(k,ix)) then
+  !        deltaz=height(nz)-(zcolumn_sn(k,ix,j-1)+
+  !    +        zcolumn_sn(k,ix,j))/2.
+  ! In order to avoid taking a very high column for very many particles,
+  ! use the deltaz from one particle below instead
+          deltaz=(zcolumn_sn(k,ix,j)-zcolumn_sn(k,ix,j-2))/2.
+        else
+          deltaz=(zcolumn_sn(k,ix,j+1)-zcolumn_sn(k,ix,j-1))/2.
+        endif
+        if ((ix.eq.nx_we(1)).or.(ix.eq.nx_we(2))) then
+          boundarea=deltaz*111198.5/2.*cosfact*dx
+        else
+          boundarea=deltaz*111198.5*cosfact*dx
+        endif
+
+
+  ! Interpolate the wind velocity and density to the release location
+  !******************************************************************
+
+  ! Determine the model level below the release position
+  !*****************************************************
+        indz=nz-1
+        indzp=nz
+        do i=2,nz
+          if (height(i).gt.zcolumn_sn(k,ix,j)) then
+            indz=i-1
+            indzp=i
+            exit
+          endif
+        end do
+
+  ! Vertical distance to the level below and above current position
+  !****************************************************************
+
+        dz1=zcolumn_sn(k,ix,j)-height(indz)
+        dz2=height(indzp)-zcolumn_sn(k,ix,j)
+        dz=1./(dz1+dz2)
+
+  ! Vertical and temporal interpolation
+  !************************************
+
+        do m=1,2
+          indexh=memind(m)
+          do in=1,2
+            indzh=indz+in-1
+            windl(in)=vv(ix,ny_sn(k),indzh,indexh)
+            rhol(in)=rho(ix,ny_sn(k),indzh,indexh)
+          end do
+
+          windhl(m)=(dz2*windl(1)+dz1*windl(2))*dz
+          rhohl(m)=(dz2*rhol(1)+dz1*rhol(2))*dz
+        end do
+
+        windx=(windhl(1)*dt2+windhl(2)*dt1)*dtt
+        rhox=(rhohl(1)*dt2+rhohl(2)*dt1)*dtt
+
+  ! Calculate mass flux
+  !********************
+
+        fluxofmass=windx*rhox*boundarea*real(lsynctime)
+
+  ! If the mass flux is directed into the domain, add it to previous mass fluxes;
+  ! if it is out of the domain, set accumulated mass flux to zero
+  !******************************************************************************
+
+        if (k.eq.1) then
+          if (fluxofmass.ge.0.) then
+            acc_mass_sn(k,ix,j)=acc_mass_sn(k,ix,j)+fluxofmass
+          else
+            acc_mass_sn(k,ix,j)=0.
+          endif
+        else
+          if (fluxofmass.le.0.) then
+            acc_mass_sn(k,ix,j)=acc_mass_sn(k,ix,j)+abs(fluxofmass)
+          else
+            acc_mass_sn(k,ix,j)=0.
+          endif
+        endif
+        accmasst=accmasst+acc_mass_sn(k,ix,j)
+
+  ! If the accumulated mass exceeds half the mass that each particle shall carry,
+  ! one (or more) particle(s) is (are) released and the accumulated mass is
+  ! reduced by the mass of this (these) particle(s)
+  !******************************************************************************
+
+        if (acc_mass_sn(k,ix,j).ge.xmassperparticle/2.) then
+          mmass=int((acc_mass_sn(k,ix,j)+xmassperparticle/2.)/ &
+               xmassperparticle)
+          acc_mass_sn(k,ix,j)=acc_mass_sn(k,ix,j)- &
+               real(mmass)*xmassperparticle
+        else
+          mmass=0
+        endif
+
+        do m=1,mmass
+          call get_newpart_index(ipart)
+          call spawn_particle(itime, ipart)
+
+  ! Assign particle positions
+  !**************************
+          call set_ylat(ipart,real(ny_sn(k),kind=dp))
+          if (ix.eq.nx_we(1)) then
+            call set_xlon(ipart,real(real(ix)+0.5*ran1(idummy,ithread),kind=dp))
+          else if (ix.eq.nx_we(2)) then
+            call set_xlon(ipart,real(real(ix)-0.5*ran1(idummy,ithread),kind=dp))
+          else
+            call set_xlon(ipart,real(real(ix)+(ran1(idummy,ithread)-.5),kind=dp))
+          endif
+          if (j.eq.1) then
+            call set_z(ipart,zcolumn_sn(k,ix,1)+(zcolumn_sn(k,ix,2)- &
+                 zcolumn_sn(k,ix,1))/4.)
+          else if (j.eq.numcolumn_sn(k,ix)) then
+            call set_z(ipart,(2.*zcolumn_sn(k,ix,j)+ &
+                 zcolumn_sn(k,ix,j-1)+height(nz))/4.)
+          else
+            call set_z(ipart,zcolumn_sn(k,ix,j-1)+ran1(idummy,ithread)* &
+                 (zcolumn_sn(k,ix,j+1)-zcolumn_sn(k,ix,j-1)))
+          endif
+
+          call update_z_to_zeta(itime, ipart)
+
+  ! Interpolate PV to the particle position
+  !****************************************
+          ixm=int(part(ipart)%xlon)
+          jym=int(part(ipart)%ylat)
+          ixp=ixm+1
+          jyp=jym+1
+          ddx=part(ipart)%xlon-real(ixm)
+          ddy=part(ipart)%ylat-real(jym)
+          rddx=1.-ddx
+          rddy=1.-ddy
+          p1=rddx*rddy
+          p2=ddx*rddy
+          p3=rddx*ddy
+          p4=ddx*ddy
+          indzm=nz-1
+          indzp=nz
+          do i=2,nz
+            if (real(height(i),kind=dp).gt.part(ipart)%z) then
+              indzm=i-1
+              indzp=i
+              exit
+            endif
+          end do
+          dz1=real(part(ipart)%z)-height(indzm)
+          dz2=height(indzp)-real(part(ipart)%z)
+          dz=1./(dz1+dz2)
+          do mm=1,2
+            indexh=memind(mm)
+            do in=1,2
+              indzh=indzm+in-1
+              y1(in)=p1*pv(ixm,jym,indzh,indexh) &
+                   +p2*pv(ixp,jym,indzh,indexh) &
+                   +p3*pv(ixm,jyp,indzh,indexh) &
+                   +p4*pv(ixp,jyp,indzh,indexh)
+            end do
+            yh1(mm)=(dz2*y1(1)+dz1*y1(2))*dz
+          end do
+          pvpart=(yh1(1)*dt2+yh1(2)*dt1)*dtt
+          if (ylat.lt.0.) pvpart=-1.*pvpart
+
+
+  ! For domain-filling option 2 (stratospheric O3), do the rest only in the stratosphere
+  !*****************************************************************************
+
+          if (((part(ipart)%z.gt.3000.).and. &
+               (pvpart.gt.pvcrit)).or.(mdomainfill.eq.1)) then
+            part(ipart)%nclass=min(int(ran1(idummy,ithread)* &
+                 real(nclassunc))+1,nclassunc)
+            numactiveparticles=numactiveparticles+1
+            numparticlecount_tmp=numparticlecount_tmp+1
+            part(ipart)%npoint=numparticlecount_tmp
+            part(ipart)%idt=mintime
+            part(ipart)%mass(1)=xmassperparticle
+            if (mdomainfill.eq.2) part(ipart)%mass(1)= &
+                 part(ipart)%mass(1)*pvpart*48./29.*ozonescale/10.**9
+            part(ipart)%mass_init(1)=part(ipart)%mass(1)
+          else
+            stop 'boundcond_domainfill error: look into original to understand what should happen here'
+          endif
+        end do ! particles
+      end do ! releases per column
+    end do ! east west
+  end do ! north south
+!$OMP END DO
+!$OMP END PARALLEL
+  numparticlecount = numparticlecount_tmp
+  ! If particles shall be dumped, then accumulated masses at the domain boundaries
+  ! must be dumped, too, to be used for later runs
+  !*****************************************************************************
+
+  if ((ipout.gt.0).and.(itime.eq.loutend)) then
+    open(unitboundcond,file=path(2)(1:length(2))//'boundcond.bin', &
+         form='unformatted')
+    write(unitboundcond) numcolumn_we,numcolumn_sn, &
+         zcolumn_we,zcolumn_sn,acc_mass_we,acc_mass_sn
+    close(unitboundcond)
+  endif
+end subroutine boundcond_domainfill
diff --git a/src/ini_dealloc_domainfill.f90 b/src/ini_dealloc_domainfill.f90
new file mode 100644
index 0000000000000000000000000000000000000000..f0c2511514b66cc3b35a406b3f2a2d2c9512a690
--- /dev/null
+++ b/src/ini_dealloc_domainfill.f90
@@ -0,0 +1,10 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine dealloc_domainfill
+
+  if (mdomainfill.lt.1) return
+  deallocate(numcolumn_we,numcolumn_sn,zcolumn_sn,zcolumn_we,acc_mass_sn, &
+    acc_mass_we)
+
+end subroutine dealloc_domainfill
diff --git a/src/ini_init_domainfill.f90 b/src/ini_init_domainfill.f90
new file mode 100644
index 0000000000000000000000000000000000000000..ca4f4201eaad132f8253d3bba2c198fc378f0c58
--- /dev/null
+++ b/src/ini_init_domainfill.f90
@@ -0,0 +1,470 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine init_domainfill
+  !
+  !*****************************************************************************
+  !                                                                            *
+  ! Initializes particles equally distributed over the first release location  *
+  ! specified in file RELEASES. This box is assumed to be the domain for doing *
+  ! domain-filling trajectory calculations.                                    *
+  ! All particles carry the same amount of mass which alltogether comprises the*
+  ! mass of air within the box.                                                *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     15 October 2002                                                        *
+  !                                                                            *
+  !  Changes                                                                   *
+  !     2022, L. Bakels: OpenMP parallelisation                                *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  ! numparticlecount    consecutively counts the number of particles released  *
+  ! nx_we(2)       grid indices for western and eastern boundary of domain-    *
+  !                filling trajectory calculations                             *
+  ! ny_sn(2)       grid indices for southern and northern boundary of domain-  *
+  !                filling trajectory calculations                             *
+  !                                                                            *
+  !*****************************************************************************
+
+  use point_mod
+  use particle_mod
+
+  implicit none
+
+  integer :: j,kz,lix,ljy,ncolumn,numparttot
+  real :: pp(nzmax),ylat,ylatp,ylatm,hzone
+  real :: cosfactm,cosfactp,deltacol,dz1,dz2,dz,pnew,pnew_temp,fractus
+  real,parameter :: pih=pi/180.
+  real :: colmasstotal,zposition
+
+  integer :: ixm,ixp,jym,jyp,indzm,indzh,indzp,i,jj,ii
+  integer :: alive_tmp,allocated_tmp,spawned_tmp,terminated_tmp
+  real :: pvpart,ddx,ddy,rddx,rddy,p1,p2,p3,p4,y1(2)
+  integer :: idummy = -11
+
+  real :: frac,psint,zzlev,zzlev2,ttemp,height_tmp
+
+  logical :: deall
+
+  real,allocatable,dimension(:)   :: gridarea !
+  real,allocatable,dimension(:,:) :: colmass !
+
+  ! Determine the release region (only full grid cells), over which particles
+  ! shall be initialized
+  ! Use 2 fields for west/east and south/north boundary
+  !**************************************************************************
+  call alloc_domainfill
+
+  nx_we(1)=max(int(xpoint1(1)),0)
+  nx_we(2)=min((int(xpoint2(1))+1),nxmin1)
+  ny_sn(1)=max(int(ypoint1(1)),0)
+  ny_sn(2)=min((int(ypoint2(1))+1),nymin1)
+
+  ! For global simulations (both global wind data and global domain-filling),
+  ! set a switch, such that no boundary conditions are used
+  !**************************************************************************
+  if (xglobal.and.sglobal.and.nglobal) then
+    if ((nx_we(1).eq.0).and.(nx_we(2).eq.nxmin1).and. &
+         (ny_sn(1).eq.0).and.(ny_sn(2).eq.nymin1)) then
+      gdomainfill=.true.
+    else
+      gdomainfill=.false.
+    endif
+  endif
+  write(*,*) 'Global domain: ', gdomainfill
+
+  ! Exit here if resuming a run from particle dump
+  !***********************************************
+  if (gdomainfill.and.ipin.ne.0) return
+
+  ! Allocate grid and column mass
+  !*******************************
+  allocate(gridarea(0:nymax-1),colmass(0:nxmax-1,0:nymax-1))
+
+  ! Do not release particles twice (i.e., not at both in the leftmost and rightmost
+  ! grid cell) for a global domain
+  !*****************************************************************************
+  if (xglobal) nx_we(2)=min(nx_we(2),nx-2)
+
+
+  ! Calculate area of grid cell with formula M=2*pi*R*h*dx/360,
+  ! see Netz, Formeln der Mathematik, 5. Auflage (1983), p.90
+  !************************************************************
+  ! First for the south pole
+
+  if (sglobal) then
+    ylat=ylat0
+    ylatp=ylat+0.5*dy
+    ylatm=ylat
+    cosfactm=0.
+    cosfactp=cos(ylatp*pih)*r_earth
+    hzone=sqrt(r_earth**2-cosfactm**2)- &
+         sqrt(r_earth**2-cosfactp**2)
+    gridarea(0)=2.*pi*r_earth*hzone*dx/360.
+  endif
+
+  ! Do the same for the north pole
+
+  if (nglobal) then
+    ylat=ylat0+real(nymin1)*dy
+    ylatp=ylat
+    ylatm=ylat-0.5*dy
+    cosfactp=0.
+    cosfactm=cos(ylatm*pih)*r_earth
+    hzone=sqrt(r_earth**2-cosfactp**2)- &
+         sqrt(r_earth**2-cosfactm**2)
+    gridarea(nymin1)=2.*pi*r_earth*hzone*dx/360.
+  endif
+
+
+
+  ! Allocate memory for storing the particles
+  !******************************************
+  call alloc_particles(npart(1))
+
+  ! Initialise total particle number
+  numparttot=0
+  ! Initialise max column number
+  numcolumn=0
+
+  ! Initialise the sum over the total mass of the atmosphere
+  colmasstotal=0.
+
+!$OMP PARALLEL PRIVATE(ljy,ylat,ylatp,ylatm,hzone,cosfactp,cosfactm,pp,lix) &
+!$OMP REDUCTION(+:colmasstotal)
+!$OMP DO
+  do ljy=ny_sn(1),ny_sn(2)      ! loop about latitudes
+    ylat=ylat0+real(ljy)*dy
+    ylatp=ylat+0.5*dy
+    ylatm=ylat-0.5*dy
+    if ((ylatm.lt.0).and.(ylatp.gt.0.)) then
+      hzone=1./dyconst
+    else
+      cosfactp=cos(ylatp*pih)*r_earth
+      cosfactm=cos(ylatm*pih)*r_earth
+      if (cosfactp.lt.cosfactm) then
+        hzone=sqrt(r_earth**2-cosfactp**2)- &
+             sqrt(r_earth**2-cosfactm**2)
+      else
+        hzone=sqrt(r_earth**2-cosfactm**2)- &
+             sqrt(r_earth**2-cosfactp**2)
+      endif
+    endif
+    gridarea(ljy)=2.*pi*r_earth*hzone*dx/360.
+  end do
+!$OMP END DO
+!$OMP BARRIER
+
+  ! Calculate total mass of each grid column and of the whole atmosphere
+  !*********************************************************************
+!$OMP DO
+  do ljy=ny_sn(1),ny_sn(2)          ! loop about latitudes
+    do lix=nx_we(1),nx_we(2)      ! loop about longitudes
+      pp(1)=prs(lix,ljy,1,1) !rho(lix,ljy,1,1)*r_air*tt(lix,ljy,1,1)
+      pp(nz)=prs(lix,ljy,nz,1) !rho(lix,ljy,nz,1)*r_air*tt(lix,ljy,nz,1)
+      colmass(lix,ljy)=(pp(1)-pp(nz))/ga*gridarea(ljy)
+      colmasstotal=colmasstotal+colmass(lix,ljy)
+    end do
+  end do
+!$OMP END DO
+!$OMP END PARALLEL
+
+  write(*,*) 'Atm. mass: ',colmasstotal
+
+  if (ipin.eq.0) numpart=0
+
+  ! Determine the particle positions
+  !*********************************
+  do ljy=ny_sn(1),ny_sn(2)      ! loop about latitudes
+    ylat=ylat0+real(ljy)*dy
+    do lix=nx_we(1),nx_we(2)      ! loop about longitudes
+      ncolumn=nint(0.999*real(npart(1))*colmass(lix,ljy)/colmasstotal)
+      if (ncolumn.eq.0) cycle
+      if (ncolumn.gt.numcolumn) numcolumn=ncolumn
+
+  ! Calculate pressure at the altitudes of model surfaces, using the air density
+  ! information, which is stored as a 3-d field
+  !*****************************************************************************
+
+      do kz=1,nz
+        pp(kz)=prs(lix,ljy,kz,1)!rho(lix,ljy,kz,1)*r_air*tt(lix,ljy,kz,1)
+      end do
+
+      deltacol=(pp(1)-pp(nz))/real(ncolumn)
+      pnew=pp(1)+deltacol/2.
+      jj=0
+
+      do j=1,ncolumn ! looping over the number of particles within the column
+
+  ! For columns with many particles (i.e. around the equator), distribute
+  ! the particles equally (1 on a random position within the deltacol range),
+  ! for columns with few particles (i.e. around the poles),
+  ! distribute the particles randomly
+  !***********************************************************************
+
+        if ((ncolumn.gt.20).and.(ncolumn-j.gt.20)) then
+          pnew_temp=pnew-ran1(idummy,0)*deltacol
+          pnew=pnew-deltacol
+        else if ((ncolumn.gt.20).and.(ncolumn-j.le.20)) then
+         ! When only few particles are left, distribute them randomly above pnew
+          pnew_temp=pnew-ran1(idummy,0)*(pnew-pp(nz))
+        else
+          pnew_temp=pp(1)-ran1(idummy,0)*(pp(1)-pp(nz))
+        endif
+
+        do kz=1,nz-1
+          if ((pp(kz).ge.pnew_temp).and.(pp(kz+1).lt.pnew_temp)) then
+            dz1=log(pnew_temp)-log(pp(kz))
+            dz=1./log(pp(kz+1)/pp(kz))
+
+           ! Assign particle position
+           !*************************
+           ! Do the following steps only if particles are not read in
+           ! from previous model run
+
+            if (ipin.eq.0) then
+              ! First spawn the particle into existence
+              !****************************************
+              jj=jj+1
+              !THIS WILL CAUSE PROBLEMS WITH OMP! because of dynamical allocatio
+              call spawn_particle(0,numpart+jj)
+              if (allocated_tmp.lt.numpart+jj) allocated_tmp=numpart+jj
+              call set_xlon(numpart+jj, &
+                real( real(lix)-0.5+ran1(idummy,0), kind=dp ) )
+              if (lix.eq.0) call set_xlon(numpart+jj, &
+                real( ran1(idummy,0), kind=dp ) )
+              if (lix.eq.nxmin1) call set_xlon(numpart+jj, &
+                real( real(nxmin1)-ran1(idummy,0), kind=dp ) )
+              call set_ylat(numpart+jj, &
+                real( real(ljy)-0.5+ran1(idummy,0), kind=dp ) )
+              ! logarithmic distribution of particles along pressure levels:
+              ! hx=h1+(h2-h1)/log(p2/p1)*log(px/p1)
+              height_tmp=height(kz)+(height(kz+1)-height(kz))*dz*dz1
+              call set_z(numpart+jj,height_tmp)
+              if (real(part(numpart+jj)%z).gt.height(nz)-0.5) &
+                call set_z(numpart+jj, height(nz)-0.5)
+
+              call update_z_to_zeta(0, numpart+jj)
+
+  ! Interpolate PV to the particle position
+  !****************************************
+              ixm=int(part(numpart+jj)%xlon)
+              jym=int(part(numpart+jj)%ylat)
+              ixp=ixm+1
+              jyp=jym+1
+              ddx=part(numpart+jj)%xlon-real(ixm)
+              ddy=part(numpart+jj)%ylat-real(jym)
+              rddx=1.-ddx
+              rddy=1.-ddy
+              p1=rddx*rddy
+              p2=ddx*rddy
+              p3=rddx*ddy
+              p4=ddx*ddy
+
+  !***************************************************************************
+              indzm=nz-1
+              indzp=nz
+              do i=2,nz
+                if (real(height(i),kind=dp).gt.part(numpart+jj)%z) then
+                  indzm=i-1
+                  indzp=i
+                  exit
+                endif
+              end do
+              dz1=real(part(numpart+jj)%z)-height(indzm)
+              dz2=height(indzp)-real(part(numpart+jj)%z)
+              dz=1./(dz1+dz2)
+              do ii=1,2
+                indzh=indzm+ii-1
+                y1(ii)=p1*pv(ixm,jym,indzh,1) &
+                     + p2*pv(ixp,jym,indzh,1) &
+                     + p3*pv(ixm,jyp,indzh,1) &
+                     + p4*pv(ixp,jyp,indzh,1)
+              end do
+              pvpart=(dz2*y1(1)+dz1*y1(2))*dz
+              if (ylat.lt.0.) pvpart=-1.*pvpart
+
+  ! For domain-filling option 2 (stratospheric O3),
+  ! do the rest only in the stratosphere
+  !************************************************
+
+              if (( part(numpart+jj)%z .gt. 3000. .and. pvpart .gt. pvcrit ) &
+                .or. mdomainfill .eq. 1) then
+
+  ! Assign certain properties to the particle
+  !******************************************
+                part(numpart+jj)%nclass=min( &
+                  int(ran1(idummy,0)*real(nclassunc))+1, nclassunc )
+                numparticlecount=numparticlecount+1
+                part(numpart+jj)%npoint=numparticlecount
+                part(numpart+jj)%idt=mintime
+                part(numpart+jj)%mass(1)=colmass(lix,ljy)/real(ncolumn)
+                if (mdomainfill.eq.2) part(numpart+jj)%mass(1)= &
+                     part(numpart+jj)%mass(1)*pvpart*48./29.*ozonescale/10.**9
+                part(numpart+jj)%mass_init(1)=part(numpart+jj)%mass(1)
+              else
+                call terminate_particle(numpart+jj, 0)
+                jj=jj-1
+              endif
+            endif
+          endif
+        end do
+      end do
+      numparttot=numparttot+ncolumn
+      if (ipin.eq.0) numpart=numpart+jj
+    end do
+  end do
+
+
+  alive_tmp=count%alive
+  spawned_tmp=count%spawned
+  allocated_tmp=count%allocated
+  terminated_tmp=count%terminated
+
+!$OMP PARALLEL PRIVATE(j) REDUCTION(+:alive_tmp,spawned_tmp,allocated_tmp,terminated_tmp)
+
+  ! Make sure that all particles are within domain
+  !***********************************************
+!$OMP DO
+  do j=1,numpart
+    if ((part(j)%xlon.lt.0.).or.(part(j)%xlon.ge.real(nxmin1,kind=dp)).or. &
+         (part(j)%ylat.lt.0.).or.(part(j)%ylat.ge.real(nymin1,kind=dp))) then
+      call terminate_particle(j,0)
+      alive_tmp=alive_tmp-1
+      terminated_tmp=terminated_tmp+1
+    endif
+  end do
+!$OMP END DO
+!$OMP END PARALLEL
+
+  count%alive=alive_tmp
+  count%spawned=spawned_tmp
+  count%allocated=allocated_tmp
+  count%terminated=terminated_tmp
+  ! Check whether numpart is really smaller than maxpart
+  !*****************************************************
+
+  ! ! ESO :TODO: this warning need to be moved further up, else out-of-bounds error earlier
+  !   if (numpart.gt.maxpart) then
+  !     write(*,*) 'numpart too large: change source in init_atm_mass.f'
+  !     write(*,*) 'numpart: ',numpart,' maxpart: ',maxpart
+  !   endif
+
+
+  xmassperparticle=colmasstotal/real(numparttot)
+
+
+  ! For boundary conditions, we need fewer particle release heights per column,
+  ! because otherwise it takes too long until enough mass has accumulated to
+  ! release a particle at the boundary (would take dx/u seconds), leading to
+  ! relatively large position errors of the order of one grid distance.
+  ! It's better to release fewer particles per column, but to do so more often.
+  ! Thus, use on the order of nz starting heights per column.
+  ! We thus repeat the above to determine fewer starting heights, that are
+  ! used furtheron in subroutine boundcond_domainfill.f.
+  !****************************************************************************
+
+  fractus=real(numcolumn)/real(nz)
+  write(*,*) 'Total number of particles at model start: ',numpart
+  write(*,*) 'Maximum number of particles per column: ',numcolumn
+  write(*,*) 'If ',fractus,' <1, better use more particles'
+  fractus=sqrt(max(fractus,1.))/2.
+
+  do ljy=ny_sn(1),ny_sn(2)      ! loop about latitudes
+    do lix=nx_we(1),nx_we(2)      ! loop about longitudes
+      ncolumn=nint(0.999/fractus*real(npart(1))*colmass(lix,ljy) &
+           /colmasstotal)
+      if (ncolumn.gt.maxcolumn) stop 'maxcolumn too small'
+      if (ncolumn.eq.0) cycle
+
+
+  ! Memorize how many particles per column shall be used for all boundaries
+  ! This is further used in subroutine boundcond_domainfill.f
+  ! Use 2 fields for west/east and south/north boundary
+  !************************************************************************
+
+      if (lix.eq.nx_we(1)) numcolumn_we(1,ljy)=ncolumn
+      if (lix.eq.nx_we(2)) numcolumn_we(2,ljy)=ncolumn
+      if (ljy.eq.ny_sn(1)) numcolumn_sn(1,lix)=ncolumn
+      if (ljy.eq.ny_sn(2)) numcolumn_sn(2,lix)=ncolumn
+
+  ! Calculate pressure at the altitudes of model surfaces, using the air density
+  ! information, which is stored as a 3-d field
+  !*****************************************************************************
+
+      do kz=1,nz
+        pp(kz)=prs(lix,ljy,kz,1) !rho(lix,ljy,kz,1)*r_air*tt(lix,ljy,kz,1)
+      end do
+
+  ! Determine the reference starting altitudes
+  !*******************************************
+
+      deltacol=(pp(1)-pp(nz))/real(ncolumn)
+      pnew=pp(1)+deltacol/2.
+      do j=1,ncolumn
+        pnew=pnew-deltacol
+        do kz=1,nz-1
+          if ((pp(kz).ge.pnew).and.(pp(kz+1).lt.pnew)) then
+            dz1=pp(kz)-pnew
+            dz2=pnew-pp(kz+1)
+            dz=1./(dz1+dz2)
+            zposition=(height(kz)*dz2+height(kz+1)*dz1)*dz
+            if (zposition.gt.height(nz)-0.5) zposition=height(nz)-0.5
+
+  ! Memorize vertical positions where particles are introduced
+  ! This is further used in subroutine boundcond_domainfill.f
+  !***********************************************************
+
+            if (lix.eq.nx_we(1)) zcolumn_we(1,ljy,j)=zposition
+            if (lix.eq.nx_we(2)) zcolumn_we(2,ljy,j)=zposition
+            if (ljy.eq.ny_sn(1)) zcolumn_sn(1,lix,j)=zposition
+            if (ljy.eq.ny_sn(2)) zcolumn_sn(2,lix,j)=zposition
+
+  ! Initialize mass that has accumulated at boundary to zero
+  !*********************************************************
+
+            acc_mass_we(1,ljy,j)=0.
+            acc_mass_we(2,ljy,j)=0.
+            acc_mass_sn(1,ljy,j)=0.
+            acc_mass_sn(2,ljy,j)=0.
+          endif
+        end do
+      end do
+    end do
+  end do
+
+  ! If there were more particles allocated than used,
+  ! Deallocate unused memory and update numpart
+  !**************************************************
+  deall=.false.
+  do i=numpart, 1, -1
+    if (.not. part(i)%alive) then
+      deall=.true.
+      numpart = numpart - 1
+    else
+      exit
+    endif
+  end do
+
+  if (deall) call dealloc_particle(numpart) !Deallocates everything above numpart (F2008)
+
+
+  ! If particles shall be read in to continue an existing run,
+  ! then the accumulated masses at the domain boundaries must be read in, too.
+  ! This overrides any previous calculations.
+  !***************************************************************************
+
+  if ((ipin.eq.1).and.(.not.gdomainfill)) then
+    open(unitboundcond,file=path(2)(1:length(2))//'boundcond.bin', &
+         form='unformatted')
+    read(unitboundcond) numcolumn_we,numcolumn_sn, &
+         zcolumn_we,zcolumn_sn,acc_mass_we,acc_mass_sn
+    close(unitboundcond)
+  endif
+
+  deallocate(gridarea,colmass)
+end subroutine init_domainfill
diff --git a/src/ini_init_particle.f90 b/src/ini_init_particle.f90
new file mode 100644
index 0000000000000000000000000000000000000000..503728bf5abeaaa596efc02f60d15683bdddeff6
--- /dev/null
+++ b/src/ini_init_particle.f90
@@ -0,0 +1,236 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine init_particle(itime,ipart)
+  !                        i    i   o  o  o
+  !        o       o       o    i  i  i   o
+  !*****************************************************************************
+  !                                                                            *
+  !  Calculation of trajectories utilizing a zero-acceleration scheme. The time*
+  !  step is determined by the Courant-Friedrichs-Lewy (CFL) criterion. This   *
+  !  means that the time step must be so small that the displacement within    *
+  !  this time step is smaller than 1 grid distance. Additionally, a temporal  *
+  !  CFL criterion is introduced: the time step must be smaller than the time  *
+  !  interval of the wind fields used for interpolation.                       *
+  !  For random walk simulations, these are the only time step criteria.       *
+  !  For the other options, the time step is also limited by the Lagrangian    *
+  !  time scale.                                                               *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     16 December 1997                                                       *
+  !                                                                            *
+  !  Literature:                                                               *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! h [m]              Mixing height                                           *
+  ! lwindinterv [s]    time interval between two wind fields                   *
+  ! itime [s]          current temporal position                               *
+  ! ldt [s]            Suggested time step for next integration                *
+  ! ladvance [s]       Total integration time period                           *
+  ! rannumb(maxrand)   normally distributed random variables                   *
+  ! usig,vsig,wsig     uncertainties of wind velocities due to interpolation   *
+  ! xt,yt,zt           Next time step's spatial position of trajectory         *
+  !                                                                            *
+  !                                                                            *
+  ! Constants:                                                                 *
+  ! cfl                factor, by which the time step has to be smaller than   *
+  !                    the spatial CFL-criterion                               *
+  ! cflt               factor, by which the time step has to be smaller than   *
+  !                    the temporal CFL-criterion                              *
+  !                                                                            *
+  !*****************************************************************************
+
+  use turbulence_mod
+  use random_mod, only: ran3
+  use omp_lib
+  use interpol_mod
+  use cbl_mod
+
+  implicit none
+
+  integer,intent(in) ::  &
+    itime,  &
+    ipart
+  integer :: i,j,k,m,indexh
+  integer :: nrand
+  real :: dz,dz1,dz2,wp
+  real :: ttemp,dummy1,dummy2
+  real :: xt,yt,zt,zteta
+  integer :: thread
+
+#ifdef _OPENMP
+  thread = OMP_GET_THREAD_NUM()
+#else
+  thread = 0
+#endif
+
+  part(ipart)%icbt=1           ! initialize particle to no "reflection"
+
+  nrand=int(ran3(iseed1(thread),thread)*real(maxrand-1))+1
+
+  xt = real(part(ipart)%xlon)
+  yt = real(part(ipart)%ylat)
+  zt = real(part(ipart)%z)
+  zteta = real(part(ipart)%zeta)
+
+  !******************************
+  ! 2. Interpolate necessary data
+  !******************************
+
+  ! Where in the grid? Stereographic (ngrid<0) or nested (ngrid>0)
+  !***************************************************************
+  call find_ngrid(xt,yt)
+  ! Compute maximum mixing height around particle position
+  !*******************************************************
+  call find_grid_indices(xt,yt)
+
+  h=max(hmix(ix ,jy,1,memind(1)), &
+       hmix(ixp,jy ,1,memind(1)), &
+       hmix(ix ,jyp,1,memind(1)), &
+       hmix(ixp,jyp,1,memind(1)), &
+       hmix(ix ,jy ,1,memind(2)), &
+       hmix(ixp,jy ,1,memind(2)), &
+       hmix(ix ,jyp,1,memind(2)), &
+       hmix(ixp,jyp,1,memind(2)))
+
+  zeta=zt/h
+
+
+  !*************************************************************
+  ! If particle is in the PBL, interpolate once and then make a
+  ! time loop until end of interval is reached
+  !*************************************************************
+
+  if (zeta.le.1.) then
+
+    call interpol_pbl(itime,xt,yt,zt,zteta)
+
+  ! Vertical interpolation of u,v,w,rho and drhodz
+  !***********************************************
+
+  ! Vertical distance to the level below and above current position
+  ! both in terms of (u,v) and (w) fields
+  !****************************************************************
+    call interpol_pbl_short(zt,dummy1,dummy2)
+
+  ! Compute the turbulent disturbances
+
+  ! Determine the sigmas and the timescales
+  !****************************************
+
+    if (turbswitch) then
+      call hanna(zt)
+    else
+      call hanna1(zt)
+    endif
+
+
+  ! Determine the new diffusivity velocities
+  !*****************************************
+
+    if (nrand+2.gt.maxrand) nrand=1
+    part(ipart)%turbvel%u=rannumb(nrand)*sigu
+    part(ipart)%turbvel%v=rannumb(nrand+1)*sigv
+    part(ipart)%turbvel%w=rannumb(nrand+2)
+    if (.not.turbswitch) then     ! modified by mc
+      part(ipart)%turbvel%w=part(ipart)%turbvel%w*sigw
+    else if (cblflag.eq.1) then   ! modified by mc
+      if(-h/ol.gt.5) then
+  !if (ol.lt.0.) then
+  !if (ol.gt.0.) then !by mc : only for test correct is lt.0
+        call init_cbl_vel( &
+          iseed1(thread),zt,ust,wst,h,sigw,part(ipart)%turbvel%w,ol,thread)
+      else
+        part(ipart)%turbvel%w=part(ipart)%turbvel%w*sigw
+      end if
+    end if
+
+
+  ! Determine time step for next integration
+  !*****************************************
+
+    if (turbswitch) then
+      part(ipart)%idt = int( &
+        min( tlw, &
+             h / max( 2.*abs(part(ipart)%turbvel%w*sigw), 1.e-5 ), &
+             0.5/abs(dsigwdz), &
+             600.)&
+        *ctl )
+    else
+      part(ipart)%idt = int( &
+        min( tlw, &
+             h / max( 2.*abs(part(ipart)%turbvel%w), 1.e-5), &
+             600. ) &
+        *ctl)
+    endif
+    part(ipart)%idt=max(part(ipart)%idt,mintime)
+
+    ! call interpol_average()
+    ! usig=(usigprof(indzp)+usigprof(indz))/2.
+    ! vsig=(vsigprof(indzp)+vsigprof(indz))/2.
+    ! wsig=(wsigprof(indzp)+wsigprof(indz))/2.
+
+    ! wsigeta=(wsigprofeta(indzpeta)+wsigprofeta(indzeta))/2.
+
+  else
+
+
+
+  !**********************************************************
+  ! For all particles that are outside the PBL, make a single
+  ! time step. Only horizontal turbulent disturbances are
+  ! calculated. Vertical disturbances are reset.
+  !**********************************************************
+
+
+  ! Interpolate the wind
+  !*********************
+
+    call interpol_wind(itime,xt,yt,zt,zteta,10)
+
+
+  ! Compute everything for above the PBL
+
+  ! Assume constant turbulent perturbations
+  !****************************************
+
+    part(ipart)%idt=abs(lsynctime)
+
+    if (nrand+1.gt.maxrand) nrand=1
+    part(ipart)%turbvel%u=rannumb(nrand)*0.3
+    part(ipart)%turbvel%v=rannumb(nrand+1)*0.3
+    nrand=nrand+2
+    part(ipart)%turbvel%w=0.
+    sigw=0.
+
+  endif
+
+  !****************************************************************
+  ! Add mesoscale random disturbances
+  ! This is done only once for the whole lsynctime interval to save
+  ! computation time
+  !****************************************************************
+
+
+  ! It is assumed that the average interpolation error is 1/2 sigma
+  ! of the surrounding points, autocorrelation time constant is
+  ! 1/2 of time interval between wind fields
+  !****************************************************************
+  if (lmesoscale_turb) then
+    call interpol_mesoscale(itime,xt,yt,zt,zteta)
+    if (nrand+2.gt.maxrand) nrand=1
+    part(ipart)%mesovel%u=rannumb(nrand)*usig
+    part(ipart)%mesovel%v=rannumb(nrand+1)*vsig
+    select case (wind_coord_type)
+      case ('ETA')
+        part(ipart)%mesovel%w=rannumb(nrand+2)*wsigeta
+      case ('METER')
+        part(ipart)%mesovel%w=rannumb(nrand+2)*wsig
+      case default
+        part(ipart)%mesovel%w=rannumb(nrand+2)*wsig
+    end select
+  endif
+end subroutine init_particle
diff --git a/src/ini_read_heightlevels.f90 b/src/ini_read_heightlevels.f90
new file mode 100644
index 0000000000000000000000000000000000000000..05ec34cd97e65d879e55b1ddd33b8d96f8e954f6
--- /dev/null
+++ b/src/ini_read_heightlevels.f90
@@ -0,0 +1,32 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine read_heightlevels(height_tmp,nmixz_tmp)
+  implicit none
+
+  real,intent(out) :: height_tmp(nzmax)
+  integer,intent(out) :: nmixz_tmp
+  integer :: kz,ios
+  character(len=256) :: heightlevels_filename
+
+  heightlevels_filename = path(2)(1:length(2))//'heightlevels.bin'
+
+  write(*,*) 'Reading heightlevels from file:', trim(heightlevels_filename)
+
+  open(unitheightlevels,file=trim(heightlevels_filename),form='unformatted',err=9988)
+
+  read(unitheightlevels,iostat=ios) nmixz_tmp
+
+  do kz=1,nz
+    read(unitheightlevels) height_tmp(kz)
+  end do
+  close(unitheightlevels)
+
+  return
+
+9988   write(*,*) ' #### FLEXPART MODEL ERROR!   THE FILE             #### '
+  write(*,*) ' #### '//path(2)(1:length(2))//'heightlevels.bin'//'    #### '
+  write(*,*) ' #### CANNOT BE OPENED. IF A FILE WITH THIS        #### '
+  write(*,*) ' #### NAME DOES NOT EXISTS, REMOVE call read_heightlevels #### '
+  write(*,*) ' #### FROM VERTTRANSFORM_MOD.                 #### '
+end subroutine read_heightlevels
diff --git a/src/ini_readpartpositions.f90 b/src/ini_readpartpositions.f90
new file mode 100644
index 0000000000000000000000000000000000000000..cbee1c876719bb286a77702c1cc618d90121d8d2
--- /dev/null
+++ b/src/ini_readpartpositions.f90
@@ -0,0 +1,162 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine readpartpositions
+
+  !*****************************************************************************
+  !                                                                            *
+  !   This routine opens the particle dump file and reads all the particle     *
+  !   positions from a previous run to initialize the current run.             *
+  !                                                                            *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     24 March 2000                                                          *
+  !                                                                            *
+  !  Changes                                                                   *
+  !     2022, L. Bakels: NetCDF option for reading particle information        *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  !*****************************************************************************
+
+!  use netcdf_output_mod
+
+  implicit none
+
+  integer :: ibdatein,ibtimein,nspecin,itimein,numpointin,i,j,lix,ios
+  integer :: id1,id2,it1,it2
+  real :: xlonin,ylatin,topo,hmixi,pvi,qvi,rhoi,tri,tti
+  character :: specin*7
+  real(kind=dp) :: julin,julpartin
+
+  integer :: idummy = -8
+
+  numparticlecount=0
+
+  ! Open header file of dumped particle data
+  !*****************************************
+  if (lnetcdfout.eq.1) then
+#ifdef USE_NCF
+    call read_partpos_ncf(ibtime,ibdate)
+    call get_totalpart_num(numpart)
+    numparticlecount=numpart
+    return
+#endif
+  endif
+
+  open(unitpartin,file=path(2)(1:length(2))//'header', &
+       form='unformatted',err=998)
+
+  read(unitpartin) ibdatein,ibtimein
+  read(unitpartin)
+  read(unitpartin)
+
+  read(unitpartin)
+  read(unitpartin)
+  read(unitpartin) nspecin
+  nspecin=nspecin/3
+  if ((ldirect.eq.1).and.(nspec.ne.nspecin)) then
+    write(*,*) ' #### FLEXPART MODEL ERROR IN READPARTPOSITIONS#### '
+    write(*,*) ' #### THE NUMBER OF SPECIES TO BE READ IN DOES #### '
+    write(*,*) ' #### NOT AGREE WITH CURRENT SETTINGS!         #### '
+    stop
+  end if
+
+  do i=1,nspecin
+    read(unitpartin)
+    read(unitpartin)
+    read(unitpartin) j,specin
+    if ((ldirect.eq.1).and.(species(i)(1:7).ne.specin)) then
+      write(*,*) ' #### FLEXPART MODEL ERROR IN READPARTPOSITIONS#### '
+      write(*,*) ' #### SPECIES NAMES TO BE READ IN DO NOT       #### '
+      write(*,*) ' #### AGREE WITH CURRENT SETTINGS!             #### '
+      stop
+    end if
+  end do
+
+  read(unitpartin) numpointin
+  if (numpointin.ne.numpoint) then
+    write(*,*) ' #### FLEXPART MODEL WARNING IN READPARTPOSITIONS#### '
+    write(*,*) ' #### NUMBER OF RELEASE LOCATIONS DOES NOT     #### '
+    write(*,*) ' #### AGREE WITH CURRENT SETTINGS!             #### '
+  end if
+  do i=1,numpointin
+    read(unitpartin)
+    read(unitpartin)
+    read(unitpartin)
+    read(unitpartin)
+    do j=1,nspec
+      read(unitpartin)
+      read(unitpartin)
+      read(unitpartin)
+    end do
+  end do
+  read(unitpartin)
+  read(unitpartin)
+
+  do lix=0,numxgrid-1
+    read(unitpartin)
+  end do
+
+
+  ! Open data file of dumped particle data
+  !***************************************
+
+  close(unitpartin)
+  open(unitpartin,file=path(2)(1:length(2))//'partposit_end', &
+       form='unformatted',err=998)
+
+
+  do
+    read(unitpartin,iostat=ios) itimein
+    if (ios.lt.0) exit
+    i=0
+    do
+      i=i+1
+      read(unitpartin) part(i)%npoint,xlonin,ylatin,part(i)%z,part(i)%tstart, &
+           topo,pvi,qvi,rhoi,hmixi,tri,tti,(part(i)%mass(j),j=1,nspec)
+      ! For switching coordinates: this happens in timemanager.f90 after the first fields are read
+      if (xlonin.eq.-9999.9) exit
+      call set_xlon(i,real((xlonin-xlon0)/dx,kind=dp))
+      call set_ylat(i,real((ylatin-ylat0)/dy,kind=dp))
+      numparticlecount=max(numparticlecount,part(i)%npoint)
+    end do
+  end do
+
+  numpart=i-1
+
+  close(unitpartin)
+
+  julin=juldate(ibdatein,ibtimein)+real(itimein,kind=dp)/86400._dp
+  if (abs(julin-bdate).gt.1.e-5) then
+    write(*,*) ' #### FLEXPART MODEL ERROR IN READPARTPOSITIONS#### '
+    write(*,*) ' #### ENDING TIME OF PREVIOUS MODEL RUN DOES   #### '
+    write(*,*) ' #### NOT AGREE WITH STARTING TIME OF THIS RUN.#### '
+    call caldate(julin,id1,it1)
+    call caldate(bdate,id2,it2)
+    write(*,*) 'julin: ',julin,id1,it1
+    write(*,*) 'bdate: ',bdate,id2,it2
+    stop
+  end if
+  do i=1,numpart
+    julpartin=juldate(ibdatein,ibtimein)+ &
+         real(part(i)%tstart,kind=dp)/86400._dp
+    part(i)%nclass=min(int(ran1(idummy,0)*real(nclassunc))+1, &
+         nclassunc)
+    part(i)%idt=mintime
+    part(i)%tstart=nint((julpartin-bdate)*86400.)
+  end do
+
+  return
+
+998   write(*,*) ' #### FLEXPART MODEL ERROR!   THE FILE         #### '
+  write(*,*) ' #### '//path(2)(1:length(2))//'partposit'//' #### '
+  write(*,*) ' #### CANNOT BE OPENED. IF A FILE WITH THIS    #### '
+  write(*,*) ' #### NAME ALREADY EXISTS, DELETE IT AND START #### '
+  write(*,*) ' #### THE PROGRAM AGAIN.                       #### '
+  stop
+
+end subroutine readpartpositions
diff --git a/src/ini_readrestart.f90 b/src/ini_readrestart.f90
new file mode 100644
index 0000000000000000000000000000000000000000..d79dc6db238cf6a4f6b813cfd6b0a527b6299add
--- /dev/null
+++ b/src/ini_readrestart.f90
@@ -0,0 +1,132 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine readrestart
+
+  !*****************************************************************************
+  !                                                                            *
+  !   This routine opens the particle dump file and reads all the particle     *
+  !   positions and gridded information from a previous run to initialize      *
+  !   the current run.                                                         *
+  !                                                                            *
+  !     Author: L. Bakels 2022                                                 *
+  !                                                                            *
+  !*****************************************************************************
+
+!  use netcdf_output_mod
+  use unc_mod
+
+  implicit none
+
+  integer :: i,j,ios
+  integer :: id1,id2,it1,it2
+  integer :: ks,kp,kz,nage,jy,ix,l
+  real(kind=dp) :: julin,julpartin
+  integer :: idummy = -8
+
+  numparticlecount=0
+
+
+  open(unitpartin,file=path(2)(1:length(2))//'restart.bin', &
+       form='unformatted',err=9989)
+
+  write(*,*) 'Reading Restart file:', path(2)(1:length(2))//'restart.bin'
+
+  read(unitpartin,iostat=ios) itime_init
+  read(unitpartin) numpart
+  read(unitpartin) loutnext_init
+  read(unitpartin) outnum_init
+  call spawn_particles(itime_init, numpart)
+  do i=1,numpart
+    read(unitpartin) part(i)%xlon,part(i)%ylat,part(i)%z,part(i)%zeta, &
+      part(i)%npoint,part(i)%nclass,part(i)%idt,part(i)%tend, &
+      part(i)%tstart,part(i)%alive,part(i)%turbvel%u, &
+      part(i)%turbvel%v,part(i)%turbvel%w,part(i)%mesovel%u, &
+      part(i)%mesovel%v,part(i)%mesovel%w,(part(i)%mass(j),j=1,nspec), &
+      (part(i)%mass_init(j),j=1,nspec),(part(i)%wetdepo(j),j=1,nspec), &
+      (part(i)%drydepo(j),j=1,nspec)
+    part(i)%etaupdate=.true.
+    part(i)%meterupdate=.true.
+    if (.not. part(i)%alive) then
+      if (part(i)%tstart.le.itime_init) then
+        call terminate_particle(i,part(i)%tend)
+      else ! Particle is not spawned yet (original run with ipin=3)
+        count%alive = count%alive - 1
+        count%spawned = count%spawned -1
+      endif
+    endif
+  end do
+  if (iout.gt.0) then
+#ifdef USE_NCF
+    read(unitpartin) tpointer
+#endif
+    do ks=1,nspec
+      do kp=1,maxpointspec_act
+        do nage=1,nageclass
+          do jy=0,numygrid-1
+            do ix=0,numxgrid-1
+              do l=1,nclassunc
+                do kz=1,numzgrid
+                  read(unitpartin) gridunc(ix,jy,kz,ks,kp,l,nage)
+                end do
+                if ((wetdep).and.(ldirect.gt.0)) then
+                  read(unitpartin) wetgridunc(ix,jy,ks,kp,l,nage)
+                endif
+                if ((drydep).and.(ldirect.gt.0)) then
+                  read(unitpartin) drygridunc(ix,jy,ks,kp,l,nage)
+                endif
+              end do
+            end do
+          end do
+          if (nested_output.eq.1) then
+            do jy=0,numygridn-1
+              do ix=0,numxgridn-1
+                do l=1,nclassunc
+                  do kz=1,numzgrid
+                    read(unitpartin) griduncn(ix,jy,kz,ks,kp,l,nage)
+                  end do
+                  if ((wetdep).and.(ldirect.gt.0)) then
+                    read(unitpartin) wetgriduncn(ix,jy,ks,kp,l,nage)
+                  endif
+                  if ((drydep).and.(ldirect.gt.0)) then
+                    read(unitpartin) drygriduncn(ix,jy,ks,kp,l,nage)
+                  endif
+                end do
+              end do
+            end do
+          endif
+        end do
+      end do
+      if ((drybkdep).or.(wetbkdep)) then
+        do i=1,numpart
+          read(unitpartin) xscav_frac1(i,ks)
+        end do
+      endif
+    end do
+  endif
+  close(unitpartin)
+
+  numpart=count%spawned
+
+  julin=juldate(ibdate,ibtime)+real(itime_init,kind=dp)/86400._dp
+  if (abs(julin-bdate).le.1.e-5) then
+    write(*,*) ' #### FLEXPART ERROR: PLEASE KEEP IBDATE     #### '
+    write(*,*) ' #### AND IBTIME INTACT FROM THE INITIAL RUN!#### '
+    stop
+  endif
+  call caldate(julin,id1,it1)
+  call caldate(bdate,id2,it2)
+  write(*,*) ' #### Restarting Flexpart from restart.bin.    #### '
+  write(*,*) ' #### Original run started on                  #### '
+  write(*,*) 'bdate: ',bdate,id2,it2
+  write(*,*) ' #### Restarting run starts on                 #### '
+  write(*,*) 'julin: ',julin,id1,it1
+
+  return
+
+9989   write(*,*) ' #### FLEXPART MODEL ERROR!   THE FILE             #### '
+  write(*,*) ' #### '//path(2)(1:length(2))//'restart.bin'//'    #### '
+  write(*,*) ' #### CANNOT BE OPENED. IF A FILE WITH THIS        #### '
+  write(*,*) ' #### NAME DOES NOT EXISTS, RENAME THE APPROPRIATE #### '
+  write(*,*) ' #### RESTART FILE TO restart.bin.                 #### '
+end subroutine readrestart
diff --git a/src/ini_releaseparticle.f90 b/src/ini_releaseparticle.f90
new file mode 100644
index 0000000000000000000000000000000000000000..ac249b2859d30144211644342a0a0f1749eb801f
--- /dev/null
+++ b/src/ini_releaseparticle.f90
@@ -0,0 +1,416 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine releaseparticle(itime)
+  !                              o
+  !*****************************************************************************
+  !                                                                            *
+  !     This subroutine releases particles from the release locations.         *
+  !                                                                            *
+  !     It searches for a "vacant" storage space and assigns all particle      *
+  !     information to that space. A space is vacant either when no particle   *
+  !     is yet assigned to it, or when it's particle is expired and, thus,     *
+  !     the storage space is made available to a new particle.                 *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     29 June 2002                                                           *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! itime [s]            current time                                          *
+  ! ireleasestart, ireleaseend          start and end times of all releases    *
+  ! npart(maxpoint)      number of particles to be released in total           *
+  ! numrel               number of particles to be released during this time   *
+  !                      step                                                  *
+  !                                                                            *
+  !*****************************************************************************
+
+  use point_mod
+  use xmass_mod
+!  use netcdf_output_mod
+  use output_mod
+
+  implicit none
+
+  !real xaux,yaux,zaux,ran1,rfraction,xmasssave(maxpoint)
+  real :: xaux,yaux,zaux,rfraction
+  real :: topo,rhoaux(2),r,t,rhoout
+  real :: dz1,dz2,dz,xlonav,timecorrect(maxspec),press,pressold
+  real :: presspart,average_timecorrect
+  integer :: itime,numrel,i,j,k,n,ipart,minpart,ii
+  integer :: kz,istart,iend,totpart
+  integer :: nweeks,ndayofweek,nhour,jjjjmmdd,ihmmss,mm
+  real(kind=dp) :: julmonday,jul,jullocal,juldiff
+  real,parameter :: eps2=1.e-6
+
+  integer :: ngrid,ix,jy,ixp,jyp,indz,indzp
+  real :: ddx,ddy,rddx,rddy,p1,p2,p3,p4,xtn,ytn
+
+  integer :: idummy = -7
+  !save idummy,xmasssave
+  !data idummy/-7/,xmasssave/maxpoint*0./
+
+  real :: frac,psint,zzlev,zzlev2,ttemp
+
+  real :: eps
+  eps=nxmax/3.e5
+
+
+  ! Determine the actual date and time in Greenwich
+  ! (i.e., UTC + correction for daylight savings time)
+  !**************************************************
+
+  julmonday=juldate(19000101,0)          ! this is a Monday
+  jul=bdate+real(itime,kind=dp)/86400._dp    ! this is the current day
+  call caldate(jul,jjjjmmdd,ihmmss)
+  mm=(jjjjmmdd-10000*(jjjjmmdd/10000))/100
+  if ((mm.ge.4).and.(mm.le.9)) jul=jul+1._dp/24._dp   ! daylight saving time
+
+
+  ! For every release point, check whether we are in the release time interval
+  !***************************************************************************
+  ! First allocate all particles that are going to be in the simulation
+
+  if (itime.eq.0) then
+    totpart=0
+    do i=1,numpoint
+      totpart = totpart+npart(i)
+    end do
+    call alloc_particles(totpart)
+  else if (itime.eq.itime_init) then !From restart point only allocate particles that are yet to be born
+    totpart=0
+    do i=1,numpoint
+      totpart = totpart+npart(i)
+    end do
+    if (totpart.gt.count%allocated) call alloc_particles(totpart-count%allocated)
+  end if
+
+  call get_totalpart_num(istart)
+  minpart=1
+  do i=1,numpoint
+    if ((itime.ge.ireleasestart(i)).and. &! are we within release interval?
+         (itime.le.ireleaseend(i))) then
+
+  ! Determine the local day and time
+  !*********************************
+
+      xlonav=xlon0+(xpoint2(i)+xpoint1(i))/2.*dx  ! longitude needed to determine local time
+      if (xlonav.lt.-180.) xlonav=xlonav+360.
+      if (xlonav.gt.180.) xlonav=xlonav-360.
+      jullocal=jul+real(xlonav,kind=dp)/360._dp   ! correct approximately for time zone to obtain local time
+
+      juldiff=jullocal-julmonday
+      nweeks=int(juldiff/7._dp)
+      juldiff=juldiff-real(nweeks,kind=dp)*7._dp
+      ndayofweek=int(juldiff)+1              ! this is the current day of week, starting with Monday
+      nhour=nint((juldiff-real(ndayofweek-1,kind=dp))*24._dp)    ! this is the current hour
+      if (nhour.eq.0) then
+        nhour=24
+        ndayofweek=ndayofweek-1
+        if (ndayofweek.eq.0) ndayofweek=7
+      endif
+
+  ! Calculate a species- and time-dependent correction factor, distinguishing between
+  ! area (those with release starting at surface) and point (release starting above surface) sources
+  ! Also, calculate an average time correction factor (species independent)
+  !*****************************************************************************
+      average_timecorrect=0.
+      do k=1,nspec
+        if(abs(xpoint2(i)-xpoint1(i)).lt.1.E-4.and.abs(ypoint2(i)-ypoint1(i)).lt.1.E-4) then
+  !        if (zpoint1(i).gt.0.5) then      ! point source
+          timecorrect(k)=point_hour(k,nhour)*point_dow(k,ndayofweek)
+        else                             ! area source
+          timecorrect(k)=area_hour(k,nhour)*area_dow(k,ndayofweek)
+        endif
+        average_timecorrect=average_timecorrect+timecorrect(k)
+      end do
+      average_timecorrect=average_timecorrect/real(nspec)
+
+  ! Determine number of particles to be released this time; at start and at end of release,
+  ! only half the particles are released
+  !*****************************************************************************
+
+      if (ireleasestart(i).ne.ireleaseend(i)) then
+        rfraction=abs(real(npart(i))*real(lsynctime)/ &
+             real(ireleaseend(i)-ireleasestart(i)))
+        if ((itime.eq.ireleasestart(i)).or. &
+             (itime.eq.ireleaseend(i))) rfraction=rfraction/2.
+
+  ! Take the species-average time correction factor in order to scale the
+  ! number of particles released this time
+  !**********************************************************************
+        rfraction=rfraction*average_timecorrect
+
+        rfraction=rfraction+xmasssave(i)  ! number to be released at this time
+        numrel=int(rfraction)
+        xmasssave(i)=rfraction-real(numrel)
+      else
+        numrel=npart(i)
+      endif
+
+      xaux=xpoint2(i)-xpoint1(i)
+      yaux=ypoint2(i)-ypoint1(i)
+      zaux=zpoint2(i)-zpoint1(i)
+
+      do j=1,numrel             ! loop over particles to be released this time
+        call get_newpart_index(ipart)
+        call spawn_particle(itime, ipart)
+
+  ! Particle coordinates are determined by using a random position within the release volume
+  !*****************************************************************************
+
+  ! Determine horizontal particle position
+  !***************************************
+        call set_xlon(ipart,real(xpoint1(i)+ran1(idummy,0)*xaux,kind=dp))
+        if (xglobal) then
+          if (part(ipart)%xlon.gt.real(nxmin1,kind=dp)) &
+            call set_xlon(ipart,-real(nxmin1,kind=dp))
+          if (part(ipart)%xlon.lt.0.) &
+            call set_xlon(ipart,real(nxmin1,kind=dp))
+        endif
+        call set_ylat(ipart,real(ypoint1(i)+ran1(idummy,0)*yaux,kind=dp))
+
+  ! Assign mass to particle: Total mass divided by total number of particles.
+  ! Time variation has partly been taken into account already by a species-average
+  ! correction factor, by which the number of particles released this time has been
+  ! scaled. Adjust the mass per particle by the species-dependent time correction factor
+  ! divided by the species-average one
+  ! for the scavenging calculation the mass needs to be multiplied with rho of the particle layer and
+  ! divided by the sum of rho of all particles.
+  !*****************************************************************************
+        do k=1,nspec
+          part(ipart)%mass(k)=xmass(i,k)/real(npart(i)) &
+                *timecorrect(k)/average_timecorrect
+          part(ipart)%mass_init(k)=part(ipart)%mass(k)
+          if (DRYBKDEP.or.WETBKDEP) then ! if there is no scavenging in wetdepo it will be set to 0
+  !              if ( henry(k).gt.0 .or. &
+  !                   crain_aero(k).gt.0. .or. csnow_aero(k).gt.0. .or. &
+  !                   ccn_aero(k).gt.0. .or. in_aero(k).gt.0. )  then
+            xscav_frac1(ipart,k)=-1.
+          endif
+  ! Assign certain properties to particle
+  !**************************************
+        end do
+        part(ipart)%nclass=min(int(ran1(idummy,0)*real(nclassunc))+1, &
+             nclassunc)
+        numparticlecount=numparticlecount+1
+        if (mquasilag.eq.0) then
+          part(ipart)%npoint=i
+        else
+          part(ipart)%npoint=numparticlecount
+        endif
+        part(ipart)%idt=mintime               ! first time step
+
+  ! Determine vertical particle position
+  !*************************************
+        call set_z(ipart,zpoint1(i)+ran1(idummy,0)*zaux)
+  ! Interpolation of topography and density
+  !****************************************
+
+  ! Determine the nest we are in
+  !*****************************
+        ! Temporary fix for nested layer edges: replaced eps with dxn and dyn (LB)
+        ngrid=0
+        do k=numbnests,1,-1
+          if ((real(part(ipart)%xlon).gt.xln(k)+dxn(k)).and. &
+               (real(part(ipart)%xlon).lt.xrn(k)-dxn(k)).and. &
+               (real(part(ipart)%xlon).gt.yln(k)+dyn(k)).and. &
+               (real(part(ipart)%xlon).lt.yrn(k)-dyn(k))) then
+            ngrid=k
+            exit
+          endif
+        end do
+
+  ! Determine (nested) grid coordinates and auxiliary parameters used for interpolation
+  !*****************************************************************************
+
+        if (ngrid.gt.0) then
+          xtn=(real(part(ipart)%xlon)-xln(ngrid))*xresoln(ngrid)
+          ytn=(real(part(ipart)%ylat)-yln(ngrid))*yresoln(ngrid)
+          ! ix=int(xtn)
+          ! jy=int(ytn)
+          ix=max(min(nint(xtn),nxn(ngrid)-1),0)
+          jy=max(min(nint(ytn),nyn(ngrid)-1),0)
+          ddy=ytn-real(jy)
+          ddx=xtn-real(ix)
+        else
+          ix=int(part(ipart)%xlon)
+          jy=int(part(ipart)%ylat)
+          ddy=part(ipart)%ylat-real(jy)
+          ddx=part(ipart)%xlon-real(ix)
+        endif
+        ixp=ix+1
+        jyp=jy+1
+        rddx=1.-ddx
+        rddy=1.-ddy
+        p1=rddx*rddy
+        p2=ddx*rddy
+        p3=rddx*ddy
+        p4=ddx*ddy
+
+        if (ngrid.gt.0) then
+          topo=p1*oron(ix ,jy ,ngrid) &
+               + p2*oron(ixp,jy ,ngrid) &
+               + p3*oron(ix ,jyp,ngrid) &
+               + p4*oron(ixp,jyp,ngrid)
+        else
+          topo=p1*oro(ix ,jy) &
+               + p2*oro(ixp,jy) &
+               + p3*oro(ix ,jyp) &
+               + p4*oro(ixp,jyp)
+        endif
+
+  ! If starting height is in pressure coordinates, retrieve pressure profile and convert zpart1 to meters
+  !*****************************************************************************
+        if (kindz(i).eq.3) then
+          presspart=part(ipart)%z
+          do kz=1,nz
+            if (ngrid.gt.0) then
+              r=p1*rhon(ix ,jy ,kz,2,ngrid) &
+                   +p2*rhon(ixp,jy ,kz,2,ngrid) &
+                   +p3*rhon(ix ,jyp,kz,2,ngrid) &
+                   +p4*rhon(ixp,jyp,kz,2,ngrid)
+              t=p1*ttn(ix ,jy ,kz,2,ngrid) &
+                   +p2*ttn(ixp,jy ,kz,2,ngrid) &
+                   +p3*ttn(ix ,jyp,kz,2,ngrid) &
+                   +p4*ttn(ixp,jyp,kz,2,ngrid)
+            else
+              r=p1*rho(ix ,jy ,kz,2) &
+                   +p2*rho(ixp,jy ,kz,2) &
+                   +p3*rho(ix ,jyp,kz,2) &
+                   +p4*rho(ixp,jyp,kz,2)
+              t=p1*tt(ix ,jy ,kz,2) &
+                   +p2*tt(ixp,jy ,kz,2) &
+                   +p3*tt(ix ,jyp,kz,2) &
+                   +p4*tt(ixp,jyp,kz,2)
+            endif
+            press=r*r_air*t/100.
+            if (kz.eq.1) pressold=press
+
+            if (press.lt.presspart) then
+              if (kz.eq.1) then
+                call set_z(ipart,height(1)/2.)
+              else
+                dz1=pressold-presspart
+                dz2=presspart-press
+                call set_z(ipart,(height(kz-1)*dz2+height(kz)*dz1) &
+                     /(dz1+dz2))
+              endif
+              exit
+            endif
+            pressold=press
+          end do
+        endif
+
+
+  ! If release positions are given in meters above sea level, subtract the
+  ! topography from the starting height
+  !***********************************************************************
+
+        if (kindz(i).eq.2) call update_z(ipart,-topo)
+        if (part(ipart)%z.lt.eps2) call set_z(ipart,eps2)   ! Minimum starting height is eps2
+        if (part(ipart)%z.gt.height(nz)-0.5) &
+          call set_z(ipart,height(nz)-0.5) ! Maximum starting height is uppermost level - 0.5 meters
+
+        if (wind_coord_type.eq.'ETA') then
+          call z_to_zeta(itime,part(ipart)%xlon,part(ipart)%ylat,part(ipart)%z,part(ipart)%zeta)
+          part(ipart)%etaupdate = .true. ! The z(meter) coordinate is up to date
+        end if
+
+  ! For special simulations, multiply particle concentration air density;
+  ! Simply take the 2nd field in memory to do this (accurate enough)
+  !***********************************************************************
+  !AF IND_SOURCE switches between different units for concentrations at the source
+  !Af    NOTE that in backward simulations the release of particles takes place at the
+  !Af         receptor and the sampling at the source.
+  !Af          1="mass"
+  !Af          2="mass mixing ratio"
+  !Af IND_RECEPTOR switches between different units for concentrations at the receptor
+  !            0= no receptors
+  !Af          1="mass"
+  !Af          2="mass mixing ratio"
+  !            3 = wet deposition in outputfield
+  !            4 = dry deposition in outputfield
+
+  !Af switches for the releasefile:
+  !Af IND_REL =  1 : xmass * rho
+  !Af IND_REL =  0 : xmass * 1
+
+  !Af ind_rel is defined in readcommand.f
+
+        if ((ind_rel .eq. 1).or.(ind_rel .eq. 3).or.(ind_rel .eq. 4)) then
+
+  ! Interpolate the air density
+  !****************************
+
+          do ii=2,nz
+            if (height(ii).gt.part(ipart)%z) then
+              indz=ii-1
+              indzp=ii
+              exit
+            endif
+          end do
+
+          dz1=part(ipart)%z-height(indz)
+          dz2=height(indzp)-part(ipart)%z
+          dz=1./(dz1+dz2)
+
+          if (ngrid.gt.0) then
+            do n=1,2
+              rhoaux(n)=p1*rhon(ix ,jy ,indz+n-1,2,ngrid) &
+                   +p2*rhon(ixp,jy ,indz+n-1,2,ngrid) &
+                   +p3*rhon(ix ,jyp,indz+n-1,2,ngrid) &
+                   +p4*rhon(ixp,jyp,indz+n-1,2,ngrid)
+            end do
+          else
+            do n=1,2
+              rhoaux(n)=p1*rho(ix ,jy ,indz+n-1,2) &
+                   +p2*rho(ixp,jy ,indz+n-1,2) &
+                   +p3*rho(ix ,jyp,indz+n-1,2) &
+                   +p4*rho(ixp,jyp,indz+n-1,2)
+            end do
+          endif
+          rhoout=(dz2*rhoaux(1)+dz1*rhoaux(2))*dz
+          rho_rel(i)=rhoout
+
+
+  ! Multiply "mass" (i.e., mass mixing ratio in forward runs) with density
+  !********************************************************************
+
+          do k=1,nspec
+            part(ipart)%mass(k)=part(ipart)%mass(k)*rhoout
+            part(ipart)%mass_init(k)=part(ipart)%mass(k)
+          end do
+        endif
+
+        call get_totalpart_num(numpart)
+
+      end do  ! numrel
+    endif ! releasepoint
+  end do ! numpoint
+
+  call get_totalpart_num(iend)
+
+  ! NetCDF only: write initial positions of new particles
+#ifdef USE_NCF
+  if ((iend-istart.gt.0).and.(ipout.ge.1)) then
+    call wrt_part_initialpos(itime,istart,iend)
+    call output_particle(itime,.true.)
+  endif
+#endif
+  return
+
+996   continue
+  write(*,*) '#####################################################'
+  write(*,*) '#### FLEXPART MODEL SUBROUTINE RELEASEPARTICLES: ####'
+  write(*,*) '####                                             ####'
+  write(*,*) '#### ERROR - TOTAL NUMBER OF PARTICLES REQUIRED  ####'
+  write(*,*) '#### EXCEEDS THE MAXIMUM ALLOWED NUMBER. REDUCE  ####'
+  write(*,*) '#### EITHER NUMBER OF PARTICLES PER RELEASE POINT####'
+  write(*,*) '#### OR REDUCE NUMBER OF RELEASE POINTS.         ####'
+  write(*,*) '#####################################################'
+  stop
+
+end subroutine releaseparticle
diff --git a/src/initialise_mod.f90 b/src/initialise_mod.f90
index e9fe50988cfd1d0a12d27848d8016529154af596..94e92943de210170eb2b47027a2d0a9dca3dbcc7 100644
--- a/src/initialise_mod.f90
+++ b/src/initialise_mod.f90
@@ -19,7 +19,7 @@ module initialise_mod
   use coord_ec_mod
 #ifdef USE_NCF
   use netcdf_output_mod !PS
-#endif  
+#endif
   implicit none
 
   !**********************************************************
@@ -32,7 +32,7 @@ module initialise_mod
     numcolumn    ! Max number of particles to be released within a single column
   integer,allocatable,dimension(:,:) :: &
     numcolumn_we,  & ! Number of particles to be released within one col                              ! at the western and eastern boundary surfaces
-    numcolumn_sn     ! Same as numcolumn_we, but for southern and northern 
+    numcolumn_sn     ! Same as numcolumn_we, but for southern and northern
                      ! domain boundary.
   real,allocatable,dimension(:,:,:) ::  &
     zcolumn_we,            & ! Altitudes where particles are to be released
@@ -46,1983 +46,22 @@ module initialise_mod
 
 contains
 
-subroutine alloc_domainfill
-
-  allocate(numcolumn_we(2,0:nymax-1),numcolumn_sn(2,0:nxmax-1))
-  allocate(zcolumn_we(2,0:nymax-1,maxcolumn),zcolumn_sn(2,0:nxmax-1,maxcolumn),&
-    acc_mass_we(2,0:nymax-1,maxcolumn),acc_mass_sn(2,0:nxmax-1,maxcolumn))              
-end subroutine alloc_domainfill
-
-subroutine dealloc_domainfill
-
-  if (mdomainfill.lt.1) return
-  deallocate(numcolumn_we,numcolumn_sn,zcolumn_sn,zcolumn_we,acc_mass_sn, &
-    acc_mass_we)
-
-end subroutine dealloc_domainfill
-
-subroutine releaseparticle(itime)
-  !                              o
-  !*****************************************************************************
-  !                                                                            *
-  !     This subroutine releases particles from the release locations.         *
-  !                                                                            *
-  !     It searches for a "vacant" storage space and assigns all particle      *
-  !     information to that space. A space is vacant either when no particle   *
-  !     is yet assigned to it, or when it's particle is expired and, thus,     *
-  !     the storage space is made available to a new particle.                 *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     29 June 2002                                                           *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! itime [s]            current time                                          *
-  ! ireleasestart, ireleaseend          start and end times of all releases    *
-  ! npart(maxpoint)      number of particles to be released in total           *
-  ! numrel               number of particles to be released during this time   *
-  !                      step                                                  *
-  !                                                                            *
-  !*****************************************************************************
-
-  use point_mod
-  use xmass_mod
-!  use netcdf_output_mod
-  use output_mod
-
-  implicit none
-
-  !real xaux,yaux,zaux,ran1,rfraction,xmasssave(maxpoint)
-  real :: xaux,yaux,zaux,rfraction
-  real :: topo,rhoaux(2),r,t,rhoout
-  real :: dz1,dz2,dz,xlonav,timecorrect(maxspec),press,pressold
-  real :: presspart,average_timecorrect
-  integer :: itime,numrel,i,j,k,n,ipart,minpart,ii
-  integer :: kz,istart,iend,totpart
-  integer :: nweeks,ndayofweek,nhour,jjjjmmdd,ihmmss,mm
-  real(kind=dp) :: julmonday,jul,jullocal,juldiff
-  real,parameter :: eps2=1.e-6
-
-  integer :: ngrid,ix,jy,ixp,jyp,indz,indzp
-  real :: ddx,ddy,rddx,rddy,p1,p2,p3,p4,xtn,ytn
-
-  integer :: idummy = -7
-  !save idummy,xmasssave
-  !data idummy/-7/,xmasssave/maxpoint*0./
-
-  real :: frac,psint,zzlev,zzlev2,ttemp
-
-  real :: eps
-  eps=nxmax/3.e5
-
-
-  ! Determine the actual date and time in Greenwich 
-  ! (i.e., UTC + correction for daylight savings time)
-  !**************************************************
-
-  julmonday=juldate(19000101,0)          ! this is a Monday
-  jul=bdate+real(itime,kind=dp)/86400._dp    ! this is the current day
-  call caldate(jul,jjjjmmdd,ihmmss)
-  mm=(jjjjmmdd-10000*(jjjjmmdd/10000))/100
-  if ((mm.ge.4).and.(mm.le.9)) jul=jul+1._dp/24._dp   ! daylight saving time 
-
-
-  ! For every release point, check whether we are in the release time interval
-  !***************************************************************************
-  ! First allocate all particles that are going to be in the simulation
-
-  if (itime.eq.0) then
-    totpart=0
-    do i=1,numpoint
-      totpart = totpart+npart(i)
-    end do
-    call alloc_particles(totpart)
-  else if (itime.eq.itime_init) then !From restart point only allocate particles that are yet to be born
-    totpart=0
-    do i=1,numpoint
-      totpart = totpart+npart(i)
-    end do
-    if (totpart.gt.count%allocated) call alloc_particles(totpart-count%allocated)
-  end if 
-
-  call get_totalpart_num(istart)
-  minpart=1
-  do i=1,numpoint
-    if ((itime.ge.ireleasestart(i)).and. &! are we within release interval?
-         (itime.le.ireleaseend(i))) then
-
-  ! Determine the local day and time
-  !*********************************
-
-      xlonav=xlon0+(xpoint2(i)+xpoint1(i))/2.*dx  ! longitude needed to determine local time
-      if (xlonav.lt.-180.) xlonav=xlonav+360.
-      if (xlonav.gt.180.) xlonav=xlonav-360.
-      jullocal=jul+real(xlonav,kind=dp)/360._dp   ! correct approximately for time zone to obtain local time
-
-      juldiff=jullocal-julmonday
-      nweeks=int(juldiff/7._dp)
-      juldiff=juldiff-real(nweeks,kind=dp)*7._dp
-      ndayofweek=int(juldiff)+1              ! this is the current day of week, starting with Monday
-      nhour=nint((juldiff-real(ndayofweek-1,kind=dp))*24._dp)    ! this is the current hour
-      if (nhour.eq.0) then
-        nhour=24
-        ndayofweek=ndayofweek-1
-        if (ndayofweek.eq.0) ndayofweek=7
-      endif
-
-  ! Calculate a species- and time-dependent correction factor, distinguishing between
-  ! area (those with release starting at surface) and point (release starting above surface) sources
-  ! Also, calculate an average time correction factor (species independent)
-  !*****************************************************************************
-      average_timecorrect=0.
-      do k=1,nspec
-        if(abs(xpoint2(i)-xpoint1(i)).lt.1.E-4.and.abs(ypoint2(i)-ypoint1(i)).lt.1.E-4) then
-  !        if (zpoint1(i).gt.0.5) then      ! point source
-          timecorrect(k)=point_hour(k,nhour)*point_dow(k,ndayofweek)
-        else                             ! area source
-          timecorrect(k)=area_hour(k,nhour)*area_dow(k,ndayofweek)
-        endif
-        average_timecorrect=average_timecorrect+timecorrect(k)
-      end do
-      average_timecorrect=average_timecorrect/real(nspec)
-
-  ! Determine number of particles to be released this time; at start and at end of release,
-  ! only half the particles are released
-  !*****************************************************************************
-
-      if (ireleasestart(i).ne.ireleaseend(i)) then
-        rfraction=abs(real(npart(i))*real(lsynctime)/ &
-             real(ireleaseend(i)-ireleasestart(i)))
-        if ((itime.eq.ireleasestart(i)).or. &
-             (itime.eq.ireleaseend(i))) rfraction=rfraction/2.
-
-  ! Take the species-average time correction factor in order to scale the
-  ! number of particles released this time
-  !**********************************************************************
-        rfraction=rfraction*average_timecorrect
-
-        rfraction=rfraction+xmasssave(i)  ! number to be released at this time
-        numrel=int(rfraction)
-        xmasssave(i)=rfraction-real(numrel)
-      else
-        numrel=npart(i)
-      endif
-
-      xaux=xpoint2(i)-xpoint1(i)
-      yaux=ypoint2(i)-ypoint1(i)
-      zaux=zpoint2(i)-zpoint1(i)
-
-      do j=1,numrel             ! loop over particles to be released this time
-        call get_newpart_index(ipart)
-        call spawn_particle(itime, ipart)
-
-  ! Particle coordinates are determined by using a random position within the release volume
-  !*****************************************************************************
-
-  ! Determine horizontal particle position
-  !***************************************
-        call set_xlon(ipart,real(xpoint1(i)+ran1(idummy,0)*xaux,kind=dp))
-        if (xglobal) then
-          if (part(ipart)%xlon.gt.real(nxmin1,kind=dp)) &
-            call set_xlon(ipart,-real(nxmin1,kind=dp))
-          if (part(ipart)%xlon.lt.0.) &
-            call set_xlon(ipart,real(nxmin1,kind=dp))
-        endif
-        call set_ylat(ipart,real(ypoint1(i)+ran1(idummy,0)*yaux,kind=dp))
-
-  ! Assign mass to particle: Total mass divided by total number of particles.
-  ! Time variation has partly been taken into account already by a species-average
-  ! correction factor, by which the number of particles released this time has been
-  ! scaled. Adjust the mass per particle by the species-dependent time correction factor
-  ! divided by the species-average one
-  ! for the scavenging calculation the mass needs to be multiplied with rho of the particle layer and
-  ! divided by the sum of rho of all particles.
-  !*****************************************************************************
-        do k=1,nspec
-          part(ipart)%mass(k)=xmass(i,k)/real(npart(i)) &
-                *timecorrect(k)/average_timecorrect
-          part(ipart)%mass_init(k)=part(ipart)%mass(k)
-          if (DRYBKDEP.or.WETBKDEP) then ! if there is no scavenging in wetdepo it will be set to 0
-  !              if ( henry(k).gt.0 .or. &
-  !                   crain_aero(k).gt.0. .or. csnow_aero(k).gt.0. .or. &
-  !                   ccn_aero(k).gt.0. .or. in_aero(k).gt.0. )  then
-            xscav_frac1(ipart,k)=-1.
-          endif
-  ! Assign certain properties to particle
-  !**************************************
-        end do
-        part(ipart)%nclass=min(int(ran1(idummy,0)*real(nclassunc))+1, &
-             nclassunc)
-        numparticlecount=numparticlecount+1
-        if (mquasilag.eq.0) then
-          part(ipart)%npoint=i
-        else
-          part(ipart)%npoint=numparticlecount
-        endif
-        part(ipart)%idt=mintime               ! first time step
-
-  ! Determine vertical particle position
-  !*************************************
-        call set_z(ipart,zpoint1(i)+ran1(idummy,0)*zaux)
-  ! Interpolation of topography and density
-  !****************************************
-
-  ! Determine the nest we are in
-  !*****************************
-        ! Temporary fix for nested layer edges: replaced eps with dxn and dyn (LB)
-        ngrid=0
-        do k=numbnests,1,-1
-          if ((real(part(ipart)%xlon).gt.xln(k)+dxn(k)).and. &
-               (real(part(ipart)%xlon).lt.xrn(k)-dxn(k)).and. &
-               (real(part(ipart)%xlon).gt.yln(k)+dyn(k)).and. &
-               (real(part(ipart)%xlon).lt.yrn(k)-dyn(k))) then
-            ngrid=k
-            exit
-          endif
-        end do
-
-  ! Determine (nested) grid coordinates and auxiliary parameters used for interpolation
-  !*****************************************************************************
-
-        if (ngrid.gt.0) then
-          xtn=(real(part(ipart)%xlon)-xln(ngrid))*xresoln(ngrid)
-          ytn=(real(part(ipart)%ylat)-yln(ngrid))*yresoln(ngrid)
-          ! ix=int(xtn)
-          ! jy=int(ytn)
-          ix=max(min(nint(xtn),nxn(ngrid)-1),0)
-          jy=max(min(nint(ytn),nyn(ngrid)-1),0)
-          ddy=ytn-real(jy)
-          ddx=xtn-real(ix)
-        else
-          ix=int(part(ipart)%xlon)
-          jy=int(part(ipart)%ylat)
-          ddy=part(ipart)%ylat-real(jy)
-          ddx=part(ipart)%xlon-real(ix)
-        endif
-        ixp=ix+1
-        jyp=jy+1
-        rddx=1.-ddx
-        rddy=1.-ddy
-        p1=rddx*rddy
-        p2=ddx*rddy
-        p3=rddx*ddy
-        p4=ddx*ddy
-
-        if (ngrid.gt.0) then
-          topo=p1*oron(ix ,jy ,ngrid) &
-               + p2*oron(ixp,jy ,ngrid) &
-               + p3*oron(ix ,jyp,ngrid) &
-               + p4*oron(ixp,jyp,ngrid)
-        else
-          topo=p1*oro(ix ,jy) &
-               + p2*oro(ixp,jy) &
-               + p3*oro(ix ,jyp) &
-               + p4*oro(ixp,jyp)
-        endif
-
-  ! If starting height is in pressure coordinates, retrieve pressure profile and convert zpart1 to meters
-  !*****************************************************************************
-        if (kindz(i).eq.3) then
-          presspart=part(ipart)%z
-          do kz=1,nz
-            if (ngrid.gt.0) then
-              r=p1*rhon(ix ,jy ,kz,2,ngrid) &
-                   +p2*rhon(ixp,jy ,kz,2,ngrid) &
-                   +p3*rhon(ix ,jyp,kz,2,ngrid) &
-                   +p4*rhon(ixp,jyp,kz,2,ngrid)
-              t=p1*ttn(ix ,jy ,kz,2,ngrid) &
-                   +p2*ttn(ixp,jy ,kz,2,ngrid) &
-                   +p3*ttn(ix ,jyp,kz,2,ngrid) &
-                   +p4*ttn(ixp,jyp,kz,2,ngrid)
-            else
-              r=p1*rho(ix ,jy ,kz,2) &
-                   +p2*rho(ixp,jy ,kz,2) &
-                   +p3*rho(ix ,jyp,kz,2) &
-                   +p4*rho(ixp,jyp,kz,2)
-              t=p1*tt(ix ,jy ,kz,2) &
-                   +p2*tt(ixp,jy ,kz,2) &
-                   +p3*tt(ix ,jyp,kz,2) &
-                   +p4*tt(ixp,jyp,kz,2)
-            endif
-            press=r*r_air*t/100.
-            if (kz.eq.1) pressold=press
-
-            if (press.lt.presspart) then
-              if (kz.eq.1) then
-                call set_z(ipart,height(1)/2.)
-              else
-                dz1=pressold-presspart
-                dz2=presspart-press
-                call set_z(ipart,(height(kz-1)*dz2+height(kz)*dz1) &
-                     /(dz1+dz2))
-              endif
-              exit
-            endif
-            pressold=press
-          end do
-        endif
-
-
-  ! If release positions are given in meters above sea level, subtract the
-  ! topography from the starting height
-  !***********************************************************************
-
-        if (kindz(i).eq.2) call update_z(ipart,-topo)
-        if (part(ipart)%z.lt.eps2) call set_z(ipart,eps2)   ! Minimum starting height is eps2
-        if (part(ipart)%z.gt.height(nz)-0.5) &
-          call set_z(ipart,height(nz)-0.5) ! Maximum starting height is uppermost level - 0.5 meters
-
-        if (wind_coord_type.eq.'ETA') then
-          call z_to_zeta(itime,part(ipart)%xlon,part(ipart)%ylat,part(ipart)%z,part(ipart)%zeta)
-          part(ipart)%etaupdate = .true. ! The z(meter) coordinate is up to date
-        end if
-
-  ! For special simulations, multiply particle concentration air density;
-  ! Simply take the 2nd field in memory to do this (accurate enough)
-  !***********************************************************************
-  !AF IND_SOURCE switches between different units for concentrations at the source
-  !Af    NOTE that in backward simulations the release of particles takes place at the
-  !Af         receptor and the sampling at the source.
-  !Af          1="mass"
-  !Af          2="mass mixing ratio"
-  !Af IND_RECEPTOR switches between different units for concentrations at the receptor
-  !            0= no receptors
-  !Af          1="mass"
-  !Af          2="mass mixing ratio"
-  !            3 = wet deposition in outputfield
-  !            4 = dry deposition in outputfield
-
-  !Af switches for the releasefile:
-  !Af IND_REL =  1 : xmass * rho
-  !Af IND_REL =  0 : xmass * 1
-
-  !Af ind_rel is defined in readcommand.f
-
-        if ((ind_rel .eq. 1).or.(ind_rel .eq. 3).or.(ind_rel .eq. 4)) then
-
-  ! Interpolate the air density
-  !****************************
-
-          do ii=2,nz
-            if (height(ii).gt.part(ipart)%z) then
-              indz=ii-1
-              indzp=ii
-              exit
-            endif
-          end do
-
-          dz1=part(ipart)%z-height(indz)
-          dz2=height(indzp)-part(ipart)%z
-          dz=1./(dz1+dz2)
-
-          if (ngrid.gt.0) then
-            do n=1,2
-              rhoaux(n)=p1*rhon(ix ,jy ,indz+n-1,2,ngrid) &
-                   +p2*rhon(ixp,jy ,indz+n-1,2,ngrid) &
-                   +p3*rhon(ix ,jyp,indz+n-1,2,ngrid) &
-                   +p4*rhon(ixp,jyp,indz+n-1,2,ngrid)
-            end do
-          else
-            do n=1,2
-              rhoaux(n)=p1*rho(ix ,jy ,indz+n-1,2) &
-                   +p2*rho(ixp,jy ,indz+n-1,2) &
-                   +p3*rho(ix ,jyp,indz+n-1,2) &
-                   +p4*rho(ixp,jyp,indz+n-1,2)
-            end do
-          endif
-          rhoout=(dz2*rhoaux(1)+dz1*rhoaux(2))*dz
-          rho_rel(i)=rhoout
-
-
-  ! Multiply "mass" (i.e., mass mixing ratio in forward runs) with density
-  !********************************************************************
-
-          do k=1,nspec
-            part(ipart)%mass(k)=part(ipart)%mass(k)*rhoout
-            part(ipart)%mass_init(k)=part(ipart)%mass(k)
-          end do
-        endif
-
-        call get_totalpart_num(numpart)
-
-      end do  ! numrel 
-    endif ! releasepoint
-  end do ! numpoint
-
-  call get_totalpart_num(iend)
-
-  ! NetCDF only: write initial positions of new particles
-#ifdef USE_NCF
-  if ((iend-istart.gt.0).and.(ipout.ge.1)) then 
-    call wrt_part_initialpos(itime,istart,iend)
-    call output_particle(itime,.true.)
-  endif
-#endif
-  return
-
-996   continue
-  write(*,*) '#####################################################'
-  write(*,*) '#### FLEXPART MODEL SUBROUTINE RELEASEPARTICLES: ####'
-  write(*,*) '####                                             ####'
-  write(*,*) '#### ERROR - TOTAL NUMBER OF PARTICLES REQUIRED  ####'
-  write(*,*) '#### EXCEEDS THE MAXIMUM ALLOWED NUMBER. REDUCE  ####'
-  write(*,*) '#### EITHER NUMBER OF PARTICLES PER RELEASE POINT####'
-  write(*,*) '#### OR REDUCE NUMBER OF RELEASE POINTS.         ####'
-  write(*,*) '#####################################################'
-  stop
-
-end subroutine releaseparticle
-
-subroutine readpartpositions
-
-  !*****************************************************************************
-  !                                                                            *
-  !   This routine opens the particle dump file and reads all the particle     *
-  !   positions from a previous run to initialize the current run.             *
-  !                                                                            *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     24 March 2000                                                          *
-  !                                                                            *
-  !  Changes                                                                   *
-  !     2022, L. Bakels: NetCDF option for reading particle information        *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  !                                                                            *
-  !*****************************************************************************
-
-!  use netcdf_output_mod
-
-  implicit none
-
-  integer :: ibdatein,ibtimein,nspecin,itimein,numpointin,i,j,lix,ios
-  integer :: id1,id2,it1,it2
-  real :: xlonin,ylatin,topo,hmixi,pvi,qvi,rhoi,tri,tti
-  character :: specin*7
-  real(kind=dp) :: julin,julpartin
-
-  integer :: idummy = -8
-
-  numparticlecount=0
-
-  ! Open header file of dumped particle data
-  !*****************************************
-  if (lnetcdfout.eq.1) then
-#ifdef USE_NCF
-    call read_partpos_ncf(ibtime,ibdate)
-    call get_totalpart_num(numpart)
-    numparticlecount=numpart
-    return
-#endif
-  endif
-
-  open(unitpartin,file=path(2)(1:length(2))//'header', &
-       form='unformatted',err=998)
-
-  read(unitpartin) ibdatein,ibtimein
-  read(unitpartin)
-  read(unitpartin)
-
-  read(unitpartin)
-  read(unitpartin)
-  read(unitpartin) nspecin
-  nspecin=nspecin/3
-  if ((ldirect.eq.1).and.(nspec.ne.nspecin)) then
-    write(*,*) ' #### FLEXPART MODEL ERROR IN READPARTPOSITIONS#### '
-    write(*,*) ' #### THE NUMBER OF SPECIES TO BE READ IN DOES #### '
-    write(*,*) ' #### NOT AGREE WITH CURRENT SETTINGS!         #### '
-    stop
-  end if
-
-  do i=1,nspecin
-    read(unitpartin)
-    read(unitpartin)
-    read(unitpartin) j,specin
-    if ((ldirect.eq.1).and.(species(i)(1:7).ne.specin)) then
-      write(*,*) ' #### FLEXPART MODEL ERROR IN READPARTPOSITIONS#### '
-      write(*,*) ' #### SPECIES NAMES TO BE READ IN DO NOT       #### '
-      write(*,*) ' #### AGREE WITH CURRENT SETTINGS!             #### '
-      stop
-    end if
-  end do
-
-  read(unitpartin) numpointin
-  if (numpointin.ne.numpoint) then
-    write(*,*) ' #### FLEXPART MODEL WARNING IN READPARTPOSITIONS#### '
-    write(*,*) ' #### NUMBER OF RELEASE LOCATIONS DOES NOT     #### '
-    write(*,*) ' #### AGREE WITH CURRENT SETTINGS!             #### '
-  end if 
-  do i=1,numpointin
-    read(unitpartin)
-    read(unitpartin)
-    read(unitpartin)
-    read(unitpartin)
-    do j=1,nspec
-      read(unitpartin)
-      read(unitpartin)
-      read(unitpartin)
-    end do
-  end do
-  read(unitpartin)
-  read(unitpartin)
-
-  do lix=0,numxgrid-1
-    read(unitpartin)
-  end do
-
-
-  ! Open data file of dumped particle data
-  !***************************************
-
-  close(unitpartin)
-  open(unitpartin,file=path(2)(1:length(2))//'partposit_end', &
-       form='unformatted',err=998)
-  
-
-  do 
-    read(unitpartin,iostat=ios) itimein
-    if (ios.lt.0) exit
-    i=0
-    do
-      i=i+1
-      read(unitpartin) part(i)%npoint,xlonin,ylatin,part(i)%z,part(i)%tstart, &
-           topo,pvi,qvi,rhoi,hmixi,tri,tti,(part(i)%mass(j),j=1,nspec)
-      ! For switching coordinates: this happens in timemanager.f90 after the first fields are read
-      if (xlonin.eq.-9999.9) exit
-      call set_xlon(i,real((xlonin-xlon0)/dx,kind=dp))
-      call set_ylat(i,real((ylatin-ylat0)/dy,kind=dp))
-      numparticlecount=max(numparticlecount,part(i)%npoint)
-    end do
-  end do
-
-  numpart=i-1
-
-  close(unitpartin)
-
-  julin=juldate(ibdatein,ibtimein)+real(itimein,kind=dp)/86400._dp
-  if (abs(julin-bdate).gt.1.e-5) then
-    write(*,*) ' #### FLEXPART MODEL ERROR IN READPARTPOSITIONS#### '
-    write(*,*) ' #### ENDING TIME OF PREVIOUS MODEL RUN DOES   #### '
-    write(*,*) ' #### NOT AGREE WITH STARTING TIME OF THIS RUN.#### '
-    call caldate(julin,id1,it1)
-    call caldate(bdate,id2,it2)
-    write(*,*) 'julin: ',julin,id1,it1
-    write(*,*) 'bdate: ',bdate,id2,it2
-    stop
-  end if
-  do i=1,numpart
-    julpartin=juldate(ibdatein,ibtimein)+ &
-         real(part(i)%tstart,kind=dp)/86400._dp
-    part(i)%nclass=min(int(ran1(idummy,0)*real(nclassunc))+1, &
-         nclassunc)
-    part(i)%idt=mintime
-    part(i)%tstart=nint((julpartin-bdate)*86400.)
-  end do
-
-  return
-
-998   write(*,*) ' #### FLEXPART MODEL ERROR!   THE FILE         #### '
-  write(*,*) ' #### '//path(2)(1:length(2))//'partposit'//' #### '
-  write(*,*) ' #### CANNOT BE OPENED. IF A FILE WITH THIS    #### '
-  write(*,*) ' #### NAME ALREADY EXISTS, DELETE IT AND START #### '
-  write(*,*) ' #### THE PROGRAM AGAIN.                       #### '
-  stop
-
-end subroutine readpartpositions
-
-subroutine readrestart
-
-  !*****************************************************************************
-  !                                                                            *
-  !   This routine opens the particle dump file and reads all the particle     *
-  !   positions and gridded information from a previous run to initialize      *
-  !   the current run.                                                         *
-  !                                                                            *
-  !     Author: L. Bakels 2022                                                 *
-  !                                                                            *
-  !*****************************************************************************
-
-!  use netcdf_output_mod
-  use unc_mod
-
-  implicit none
-
-  integer :: i,j,ios
-  integer :: id1,id2,it1,it2
-  integer :: ks,kp,kz,nage,jy,ix,l
-  real(kind=dp) :: julin,julpartin
-  integer :: idummy = -8
-
-  numparticlecount=0
-
-
-  open(unitpartin,file=path(2)(1:length(2))//'restart.bin', &
-       form='unformatted',err=9989)
-
-  write(*,*) 'Reading Restart file:', path(2)(1:length(2))//'restart.bin'
-  
-  read(unitpartin,iostat=ios) itime_init
-  read(unitpartin) numpart
-  read(unitpartin) loutnext_init
-  read(unitpartin) outnum_init
-  call spawn_particles(itime_init, numpart)
-  do i=1,numpart
-    read(unitpartin) part(i)%xlon,part(i)%ylat,part(i)%z,part(i)%zeta, &
-      part(i)%npoint,part(i)%nclass,part(i)%idt,part(i)%tend, &
-      part(i)%tstart,part(i)%alive,part(i)%turbvel%u, &
-      part(i)%turbvel%v,part(i)%turbvel%w,part(i)%mesovel%u, &
-      part(i)%mesovel%v,part(i)%mesovel%w,(part(i)%mass(j),j=1,nspec), &
-      (part(i)%mass_init(j),j=1,nspec),(part(i)%wetdepo(j),j=1,nspec), &
-      (part(i)%drydepo(j),j=1,nspec)
-    part(i)%etaupdate=.true.
-    part(i)%meterupdate=.true.
-    if (.not. part(i)%alive) then
-      if (part(i)%tstart.le.itime_init) then
-        call terminate_particle(i,part(i)%tend)
-      else ! Particle is not spawned yet (original run with ipin=3)
-        count%alive = count%alive - 1
-        count%spawned = count%spawned -1
-      endif
-    endif
-  end do
-  if (iout.gt.0) then 
-#ifdef USE_NCF
-    read(unitpartin) tpointer
-#endif
-    do ks=1,nspec
-      do kp=1,maxpointspec_act
-        do nage=1,nageclass
-          do jy=0,numygrid-1
-            do ix=0,numxgrid-1
-              do l=1,nclassunc
-                do kz=1,numzgrid
-                  read(unitpartin) gridunc(ix,jy,kz,ks,kp,l,nage)
-                end do
-                if ((wetdep).and.(ldirect.gt.0)) then
-                  read(unitpartin) wetgridunc(ix,jy,ks,kp,l,nage)
-                endif
-                if ((drydep).and.(ldirect.gt.0)) then
-                  read(unitpartin) drygridunc(ix,jy,ks,kp,l,nage)
-                endif
-              end do
-            end do
-          end do
-          if (nested_output.eq.1) then
-            do jy=0,numygridn-1
-              do ix=0,numxgridn-1
-                do l=1,nclassunc
-                  do kz=1,numzgrid
-                    read(unitpartin) griduncn(ix,jy,kz,ks,kp,l,nage)
-                  end do
-                  if ((wetdep).and.(ldirect.gt.0)) then
-                    read(unitpartin) wetgriduncn(ix,jy,ks,kp,l,nage)
-                  endif
-                  if ((drydep).and.(ldirect.gt.0)) then
-                    read(unitpartin) drygriduncn(ix,jy,ks,kp,l,nage)
-                  endif
-                end do
-              end do
-            end do
-          endif
-        end do
-      end do
-      if ((drybkdep).or.(wetbkdep)) then
-        do i=1,numpart
-          read(unitpartin) xscav_frac1(i,ks)
-        end do
-      endif
-    end do
-  endif
-  close(unitpartin)
-
-  numpart=count%spawned
-  
-  julin=juldate(ibdate,ibtime)+real(itime_init,kind=dp)/86400._dp
-  if (abs(julin-bdate).le.1.e-5) then
-    write(*,*) ' #### FLEXPART ERROR: PLEASE KEEP IBDATE     #### '
-    write(*,*) ' #### AND IBTIME INTACT FROM THE INITIAL RUN!#### '
-    stop
-  endif
-  call caldate(julin,id1,it1)
-  call caldate(bdate,id2,it2)
-  write(*,*) ' #### Restarting Flexpart from restart.bin.    #### '
-  write(*,*) ' #### Original run started on                  #### '
-  write(*,*) 'bdate: ',bdate,id2,it2
-  write(*,*) ' #### Restarting run starts on                 #### '
-  write(*,*) 'julin: ',julin,id1,it1
-
-  return
-
-9989   write(*,*) ' #### FLEXPART MODEL ERROR!   THE FILE             #### '
-  write(*,*) ' #### '//path(2)(1:length(2))//'restart.bin'//'    #### '
-  write(*,*) ' #### CANNOT BE OPENED. IF A FILE WITH THIS        #### '
-  write(*,*) ' #### NAME DOES NOT EXISTS, RENAME THE APPROPRIATE #### '
-  write(*,*) ' #### RESTART FILE TO restart.bin.                 #### '
-end subroutine readrestart
-
-subroutine read_heightlevels(height_tmp,nmixz_tmp)
-  implicit none
-
-  real,intent(out) :: height_tmp(nzmax)
-  integer,intent(out) :: nmixz_tmp
-  integer :: kz,ios
-  character(len=256) :: heightlevels_filename
-
-  heightlevels_filename = path(2)(1:length(2))//'heightlevels.bin'
-
-  write(*,*) 'Reading heightlevels from file:', trim(heightlevels_filename)
-  
-  open(unitheightlevels,file=trim(heightlevels_filename),form='unformatted',err=9988)
-
-  read(unitheightlevels,iostat=ios) nmixz_tmp
-
-  do kz=1,nz
-    read(unitheightlevels) height_tmp(kz)
-  end do
-  close(unitheightlevels)
-
-  return
-
-9988   write(*,*) ' #### FLEXPART MODEL ERROR!   THE FILE             #### '
-  write(*,*) ' #### '//path(2)(1:length(2))//'heightlevels.bin'//'    #### '
-  write(*,*) ' #### CANNOT BE OPENED. IF A FILE WITH THIS        #### '
-  write(*,*) ' #### NAME DOES NOT EXISTS, REMOVE call read_heightlevels #### '
-  write(*,*) ' #### FROM VERTTRANSFORM_MOD.                 #### '
-end subroutine read_heightlevels
-
-subroutine init_particle(itime,ipart)
-  !                        i    i   o  o  o
-  !        o       o       o    i  i  i   o
-  !*****************************************************************************
-  !                                                                            *
-  !  Calculation of trajectories utilizing a zero-acceleration scheme. The time*
-  !  step is determined by the Courant-Friedrichs-Lewy (CFL) criterion. This   *
-  !  means that the time step must be so small that the displacement within    *
-  !  this time step is smaller than 1 grid distance. Additionally, a temporal  *
-  !  CFL criterion is introduced: the time step must be smaller than the time  *
-  !  interval of the wind fields used for interpolation.                       *
-  !  For random walk simulations, these are the only time step criteria.       *
-  !  For the other options, the time step is also limited by the Lagrangian    *
-  !  time scale.                                                               *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     16 December 1997                                                       *
-  !                                                                            *
-  !  Literature:                                                               *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! h [m]              Mixing height                                           *
-  ! lwindinterv [s]    time interval between two wind fields                   *
-  ! itime [s]          current temporal position                               *
-  ! ldt [s]            Suggested time step for next integration                *
-  ! ladvance [s]       Total integration time period                           *
-  ! rannumb(maxrand)   normally distributed random variables                   *
-  ! usig,vsig,wsig     uncertainties of wind velocities due to interpolation   *
-  ! xt,yt,zt           Next time step's spatial position of trajectory         *
-  !                                                                            *
-  !                                                                            *
-  ! Constants:                                                                 *
-  ! cfl                factor, by which the time step has to be smaller than   *
-  !                    the spatial CFL-criterion                               *
-  ! cflt               factor, by which the time step has to be smaller than   *
-  !                    the temporal CFL-criterion                              *
-  !                                                                            *
-  !*****************************************************************************
-
-  use turbulence_mod
-  use random_mod, only: ran3
-  use omp_lib
-  use interpol_mod
-  use cbl_mod
-
-  implicit none
-
-  integer,intent(in) ::  &
-    itime,  &
-    ipart
-  integer :: i,j,k,m,indexh
-  integer :: nrand
-  real :: dz,dz1,dz2,wp
-  real :: ttemp,dummy1,dummy2
-  real :: xt,yt,zt,zteta
-  integer :: thread
-
-#ifdef _OPENMP
-  thread = OMP_GET_THREAD_NUM()
-#else 
-  thread = 0
-#endif
-
-  part(ipart)%icbt=1           ! initialize particle to no "reflection"
-
-  nrand=int(ran3(iseed1(thread),thread)*real(maxrand-1))+1
-
-  xt = real(part(ipart)%xlon)
-  yt = real(part(ipart)%ylat)
-  zt = real(part(ipart)%z)
-  zteta = real(part(ipart)%zeta)
-
-  !******************************
-  ! 2. Interpolate necessary data
-  !******************************
-
-  ! Where in the grid? Stereographic (ngrid<0) or nested (ngrid>0)
-  !***************************************************************
-  call find_ngrid(xt,yt)
-  ! Compute maximum mixing height around particle position
-  !*******************************************************
-  call find_grid_indices(xt,yt)
-  
-  h=max(hmix(ix ,jy,1,memind(1)), &
-       hmix(ixp,jy ,1,memind(1)), &
-       hmix(ix ,jyp,1,memind(1)), &
-       hmix(ixp,jyp,1,memind(1)), &
-       hmix(ix ,jy ,1,memind(2)), &
-       hmix(ixp,jy ,1,memind(2)), &
-       hmix(ix ,jyp,1,memind(2)), &
-       hmix(ixp,jyp,1,memind(2)))
-
-  zeta=zt/h
-
-
-  !*************************************************************
-  ! If particle is in the PBL, interpolate once and then make a
-  ! time loop until end of interval is reached
-  !*************************************************************
-
-  if (zeta.le.1.) then
-
-    call interpol_pbl(itime,xt,yt,zt,zteta)
-
-  ! Vertical interpolation of u,v,w,rho and drhodz
-  !***********************************************
-
-  ! Vertical distance to the level below and above current position
-  ! both in terms of (u,v) and (w) fields
-  !****************************************************************
-    call interpol_pbl_short(zt,dummy1,dummy2)
-
-  ! Compute the turbulent disturbances
-
-  ! Determine the sigmas and the timescales
-  !****************************************
-
-    if (turbswitch) then
-      call hanna(zt)
-    else
-      call hanna1(zt)
-    endif
-
-
-  ! Determine the new diffusivity velocities
-  !*****************************************
-
-    if (nrand+2.gt.maxrand) nrand=1
-    part(ipart)%turbvel%u=rannumb(nrand)*sigu
-    part(ipart)%turbvel%v=rannumb(nrand+1)*sigv
-    part(ipart)%turbvel%w=rannumb(nrand+2)
-    if (.not.turbswitch) then     ! modified by mc
-      part(ipart)%turbvel%w=part(ipart)%turbvel%w*sigw
-    else if (cblflag.eq.1) then   ! modified by mc
-      if(-h/ol.gt.5) then
-  !if (ol.lt.0.) then
-  !if (ol.gt.0.) then !by mc : only for test correct is lt.0
-        call init_cbl_vel( &
-          iseed1(thread),zt,ust,wst,h,sigw,part(ipart)%turbvel%w,ol,thread)
-      else
-        part(ipart)%turbvel%w=part(ipart)%turbvel%w*sigw
-      end if
-    end if
-
-
-  ! Determine time step for next integration
-  !*****************************************
-
-    if (turbswitch) then
-      part(ipart)%idt = int( &
-        min( tlw, &
-             h / max( 2.*abs(part(ipart)%turbvel%w*sigw), 1.e-5 ), &
-             0.5/abs(dsigwdz), &
-             600.)&
-        *ctl )
-    else
-      part(ipart)%idt = int( &
-        min( tlw, &
-             h / max( 2.*abs(part(ipart)%turbvel%w), 1.e-5), &
-             600. ) &
-        *ctl)
-    endif
-    part(ipart)%idt=max(part(ipart)%idt,mintime)
-
-    ! call interpol_average()
-    ! usig=(usigprof(indzp)+usigprof(indz))/2.
-    ! vsig=(vsigprof(indzp)+vsigprof(indz))/2.
-    ! wsig=(wsigprof(indzp)+wsigprof(indz))/2.
-
-    ! wsigeta=(wsigprofeta(indzpeta)+wsigprofeta(indzeta))/2.
-
-  else
-
+#include "ini_alloc_domainfill.f90"
 
+#include "ini_dealloc_domainfill.f90"
 
-  !**********************************************************
-  ! For all particles that are outside the PBL, make a single
-  ! time step. Only horizontal turbulent disturbances are
-  ! calculated. Vertical disturbances are reset.
-  !**********************************************************
-
-
-  ! Interpolate the wind
-  !*********************
-
-    call interpol_wind(itime,xt,yt,zt,zteta,10)
-
-
-  ! Compute everything for above the PBL
-
-  ! Assume constant turbulent perturbations
-  !****************************************
-
-    part(ipart)%idt=abs(lsynctime)
-
-    if (nrand+1.gt.maxrand) nrand=1
-    part(ipart)%turbvel%u=rannumb(nrand)*0.3
-    part(ipart)%turbvel%v=rannumb(nrand+1)*0.3
-    nrand=nrand+2
-    part(ipart)%turbvel%w=0.
-    sigw=0.
-
-  endif
-
-  !****************************************************************
-  ! Add mesoscale random disturbances
-  ! This is done only once for the whole lsynctime interval to save
-  ! computation time
-  !****************************************************************
-
-
-  ! It is assumed that the average interpolation error is 1/2 sigma
-  ! of the surrounding points, autocorrelation time constant is
-  ! 1/2 of time interval between wind fields
-  !****************************************************************
-  if (lmesoscale_turb) then
-    call interpol_mesoscale(itime,xt,yt,zt,zteta)
-    if (nrand+2.gt.maxrand) nrand=1
-    part(ipart)%mesovel%u=rannumb(nrand)*usig
-    part(ipart)%mesovel%v=rannumb(nrand+1)*vsig
-    select case (wind_coord_type)
-      case ('ETA')
-        part(ipart)%mesovel%w=rannumb(nrand+2)*wsigeta
-      case ('METER')
-        part(ipart)%mesovel%w=rannumb(nrand+2)*wsig
-      case default
-        part(ipart)%mesovel%w=rannumb(nrand+2)*wsig
-    end select  
-  endif
-end subroutine init_particle
-
-subroutine init_domainfill
-  !
-  !*****************************************************************************
-  !                                                                            *
-  ! Initializes particles equally distributed over the first release location  *
-  ! specified in file RELEASES. This box is assumed to be the domain for doing *
-  ! domain-filling trajectory calculations.                                    *
-  ! All particles carry the same amount of mass which alltogether comprises the*
-  ! mass of air within the box.                                                *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     15 October 2002                                                        *
-  !                                                                            *
-  !  Changes                                                                   *
-  !     2022, L. Bakels: OpenMP parallelisation                                *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  !                                                                            *
-  ! numparticlecount    consecutively counts the number of particles released  *
-  ! nx_we(2)       grid indices for western and eastern boundary of domain-    *
-  !                filling trajectory calculations                             *
-  ! ny_sn(2)       grid indices for southern and northern boundary of domain-  *
-  !                filling trajectory calculations                             *
-  !                                                                            *
-  !*****************************************************************************
-
-  use point_mod
-  use particle_mod
-
-  implicit none
-
-  integer :: j,kz,lix,ljy,ncolumn,numparttot
-  real :: pp(nzmax),ylat,ylatp,ylatm,hzone
-  real :: cosfactm,cosfactp,deltacol,dz1,dz2,dz,pnew,pnew_temp,fractus
-  real,parameter :: pih=pi/180.
-  real :: colmasstotal,zposition
-
-  integer :: ixm,ixp,jym,jyp,indzm,indzh,indzp,i,jj,ii
-  integer :: alive_tmp,allocated_tmp,spawned_tmp,terminated_tmp
-  real :: pvpart,ddx,ddy,rddx,rddy,p1,p2,p3,p4,y1(2)
-  integer :: idummy = -11
-
-  real :: frac,psint,zzlev,zzlev2,ttemp,height_tmp
-
-  logical :: deall
-
-  real,allocatable,dimension(:)   :: gridarea !
-  real,allocatable,dimension(:,:) :: colmass !
-
-  ! Determine the release region (only full grid cells), over which particles
-  ! shall be initialized
-  ! Use 2 fields for west/east and south/north boundary
-  !**************************************************************************
-  call alloc_domainfill
-
-  nx_we(1)=max(int(xpoint1(1)),0)
-  nx_we(2)=min((int(xpoint2(1))+1),nxmin1)
-  ny_sn(1)=max(int(ypoint1(1)),0)
-  ny_sn(2)=min((int(ypoint2(1))+1),nymin1)
-
-  ! For global simulations (both global wind data and global domain-filling),
-  ! set a switch, such that no boundary conditions are used
-  !**************************************************************************
-  if (xglobal.and.sglobal.and.nglobal) then
-    if ((nx_we(1).eq.0).and.(nx_we(2).eq.nxmin1).and. &
-         (ny_sn(1).eq.0).and.(ny_sn(2).eq.nymin1)) then
-      gdomainfill=.true.
-    else
-      gdomainfill=.false.
-    endif
-  endif
-  write(*,*) 'Global domain: ', gdomainfill
-
-  ! Exit here if resuming a run from particle dump
-  !***********************************************
-  if (gdomainfill.and.ipin.ne.0) return
-
-  ! Allocate grid and column mass
-  !*******************************
-  allocate(gridarea(0:nymax-1),colmass(0:nxmax-1,0:nymax-1))
-
-  ! Do not release particles twice (i.e., not at both in the leftmost and rightmost
-  ! grid cell) for a global domain
-  !*****************************************************************************
-  if (xglobal) nx_we(2)=min(nx_we(2),nx-2)
-
-
-  ! Calculate area of grid cell with formula M=2*pi*R*h*dx/360,
-  ! see Netz, Formeln der Mathematik, 5. Auflage (1983), p.90
-  !************************************************************
-  ! First for the south pole
-  
-  if (sglobal) then
-    ylat=ylat0
-    ylatp=ylat+0.5*dy
-    ylatm=ylat
-    cosfactm=0.
-    cosfactp=cos(ylatp*pih)*r_earth
-    hzone=sqrt(r_earth**2-cosfactm**2)- &
-         sqrt(r_earth**2-cosfactp**2)
-    gridarea(0)=2.*pi*r_earth*hzone*dx/360.
-  endif
-
-  ! Do the same for the north pole
-
-  if (nglobal) then
-    ylat=ylat0+real(nymin1)*dy
-    ylatp=ylat
-    ylatm=ylat-0.5*dy
-    cosfactp=0.
-    cosfactm=cos(ylatm*pih)*r_earth
-    hzone=sqrt(r_earth**2-cosfactp**2)- &
-         sqrt(r_earth**2-cosfactm**2)
-    gridarea(nymin1)=2.*pi*r_earth*hzone*dx/360.
-  endif
-
-
-
-  ! Allocate memory for storing the particles
-  !******************************************
-  call alloc_particles(npart(1))
-
-  ! Initialise total particle number
-  numparttot=0
-  ! Initialise max column number
-  numcolumn=0
-
-  ! Initialise the sum over the total mass of the atmosphere
-  colmasstotal=0.
-
-!$OMP PARALLEL PRIVATE(ljy,ylat,ylatp,ylatm,hzone,cosfactp,cosfactm,pp,lix) &
-!$OMP REDUCTION(+:colmasstotal)
-!$OMP DO
-  do ljy=ny_sn(1),ny_sn(2)      ! loop about latitudes
-    ylat=ylat0+real(ljy)*dy
-    ylatp=ylat+0.5*dy
-    ylatm=ylat-0.5*dy
-    if ((ylatm.lt.0).and.(ylatp.gt.0.)) then
-      hzone=1./dyconst
-    else
-      cosfactp=cos(ylatp*pih)*r_earth
-      cosfactm=cos(ylatm*pih)*r_earth
-      if (cosfactp.lt.cosfactm) then
-        hzone=sqrt(r_earth**2-cosfactp**2)- &
-             sqrt(r_earth**2-cosfactm**2)
-      else
-        hzone=sqrt(r_earth**2-cosfactm**2)- &
-             sqrt(r_earth**2-cosfactp**2)
-      endif
-    endif
-    gridarea(ljy)=2.*pi*r_earth*hzone*dx/360.
-  end do
-!$OMP END DO
-!$OMP BARRIER
-
-  ! Calculate total mass of each grid column and of the whole atmosphere
-  !*********************************************************************
-!$OMP DO 
-  do ljy=ny_sn(1),ny_sn(2)          ! loop about latitudes
-    do lix=nx_we(1),nx_we(2)      ! loop about longitudes
-      pp(1)=prs(lix,ljy,1,1) !rho(lix,ljy,1,1)*r_air*tt(lix,ljy,1,1)
-      pp(nz)=prs(lix,ljy,nz,1) !rho(lix,ljy,nz,1)*r_air*tt(lix,ljy,nz,1)
-      colmass(lix,ljy)=(pp(1)-pp(nz))/ga*gridarea(ljy)
-      colmasstotal=colmasstotal+colmass(lix,ljy)
-    end do
-  end do
-!$OMP END DO
-!$OMP END PARALLEL
-
-  write(*,*) 'Atm. mass: ',colmasstotal
-
-  if (ipin.eq.0) numpart=0
-
-  ! Determine the particle positions
-  !*********************************
-  do ljy=ny_sn(1),ny_sn(2)      ! loop about latitudes
-    ylat=ylat0+real(ljy)*dy
-    do lix=nx_we(1),nx_we(2)      ! loop about longitudes
-      ncolumn=nint(0.999*real(npart(1))*colmass(lix,ljy)/colmasstotal)
-      if (ncolumn.eq.0) cycle
-      if (ncolumn.gt.numcolumn) numcolumn=ncolumn
-
-  ! Calculate pressure at the altitudes of model surfaces, using the air density
-  ! information, which is stored as a 3-d field
-  !*****************************************************************************
-
-      do kz=1,nz
-        pp(kz)=prs(lix,ljy,kz,1)!rho(lix,ljy,kz,1)*r_air*tt(lix,ljy,kz,1)
-      end do
-
-      deltacol=(pp(1)-pp(nz))/real(ncolumn)
-      pnew=pp(1)+deltacol/2.
-      jj=0
-
-      do j=1,ncolumn ! looping over the number of particles within the column
-
-  ! For columns with many particles (i.e. around the equator), distribute
-  ! the particles equally (1 on a random position within the deltacol range), 
-  ! for columns with few particles (i.e. around the poles), 
-  ! distribute the particles randomly
-  !***********************************************************************
-
-        if ((ncolumn.gt.20).and.(ncolumn-j.gt.20)) then
-          pnew_temp=pnew-ran1(idummy,0)*deltacol
-          pnew=pnew-deltacol
-        else if ((ncolumn.gt.20).and.(ncolumn-j.le.20)) then
-         ! When only few particles are left, distribute them randomly above pnew
-          pnew_temp=pnew-ran1(idummy,0)*(pnew-pp(nz))
-        else
-          pnew_temp=pp(1)-ran1(idummy,0)*(pp(1)-pp(nz))
-        endif
-
-        do kz=1,nz-1
-          if ((pp(kz).ge.pnew_temp).and.(pp(kz+1).lt.pnew_temp)) then
-            dz1=log(pnew_temp)-log(pp(kz))
-            dz=1./log(pp(kz+1)/pp(kz))
-
-           ! Assign particle position
-           !*************************
-           ! Do the following steps only if particles are not read in 
-           ! from previous model run
-
-            if (ipin.eq.0) then
-              ! First spawn the particle into existence
-              !****************************************
-              jj=jj+1
-              !THIS WILL CAUSE PROBLEMS WITH OMP! because of dynamical allocatio
-              call spawn_particle(0,numpart+jj)
-              if (allocated_tmp.lt.numpart+jj) allocated_tmp=numpart+jj
-              call set_xlon(numpart+jj, &
-                real( real(lix)-0.5+ran1(idummy,0), kind=dp ) )
-              if (lix.eq.0) call set_xlon(numpart+jj, &
-                real( ran1(idummy,0), kind=dp ) )
-              if (lix.eq.nxmin1) call set_xlon(numpart+jj, &
-                real( real(nxmin1)-ran1(idummy,0), kind=dp ) )
-              call set_ylat(numpart+jj, &
-                real( real(ljy)-0.5+ran1(idummy,0), kind=dp ) )
-              ! logarithmic distribution of particles along pressure levels:
-              ! hx=h1+(h2-h1)/log(p2/p1)*log(px/p1)
-              height_tmp=height(kz)+(height(kz+1)-height(kz))*dz*dz1
-              call set_z(numpart+jj,height_tmp)
-              if (real(part(numpart+jj)%z).gt.height(nz)-0.5) &
-                call set_z(numpart+jj, height(nz)-0.5)
-
-              call update_z_to_zeta(0, numpart+jj)
-              
-  ! Interpolate PV to the particle position
-  !****************************************
-              ixm=int(part(numpart+jj)%xlon)
-              jym=int(part(numpart+jj)%ylat)
-              ixp=ixm+1
-              jyp=jym+1
-              ddx=part(numpart+jj)%xlon-real(ixm)
-              ddy=part(numpart+jj)%ylat-real(jym)
-              rddx=1.-ddx
-              rddy=1.-ddy
-              p1=rddx*rddy
-              p2=ddx*rddy
-              p3=rddx*ddy
-              p4=ddx*ddy
-
-  !***************************************************************************
-              indzm=nz-1
-              indzp=nz
-              do i=2,nz
-                if (real(height(i),kind=dp).gt.part(numpart+jj)%z) then
-                  indzm=i-1
-                  indzp=i
-                  exit
-                endif
-              end do
-              dz1=real(part(numpart+jj)%z)-height(indzm)
-              dz2=height(indzp)-real(part(numpart+jj)%z)
-              dz=1./(dz1+dz2)
-              do ii=1,2
-                indzh=indzm+ii-1
-                y1(ii)=p1*pv(ixm,jym,indzh,1) &
-                     + p2*pv(ixp,jym,indzh,1) &
-                     + p3*pv(ixm,jyp,indzh,1) &
-                     + p4*pv(ixp,jyp,indzh,1)
-              end do
-              pvpart=(dz2*y1(1)+dz1*y1(2))*dz
-              if (ylat.lt.0.) pvpart=-1.*pvpart
-
-  ! For domain-filling option 2 (stratospheric O3), 
-  ! do the rest only in the stratosphere
-  !************************************************
-
-              if (( part(numpart+jj)%z .gt. 3000. .and. pvpart .gt. pvcrit ) &
-                .or. mdomainfill .eq. 1) then
-
-  ! Assign certain properties to the particle
-  !******************************************
-                part(numpart+jj)%nclass=min( &
-                  int(ran1(idummy,0)*real(nclassunc))+1, nclassunc )
-                numparticlecount=numparticlecount+1
-                part(numpart+jj)%npoint=numparticlecount
-                part(numpart+jj)%idt=mintime
-                part(numpart+jj)%mass(1)=colmass(lix,ljy)/real(ncolumn)
-                if (mdomainfill.eq.2) part(numpart+jj)%mass(1)= &
-                     part(numpart+jj)%mass(1)*pvpart*48./29.*ozonescale/10.**9
-                part(numpart+jj)%mass_init(1)=part(numpart+jj)%mass(1)
-              else
-                call terminate_particle(numpart+jj, 0)
-                jj=jj-1
-              endif
-            endif
-          endif
-        end do
-      end do
-      numparttot=numparttot+ncolumn
-      if (ipin.eq.0) numpart=numpart+jj
-    end do
-  end do
-
-
-  alive_tmp=count%alive
-  spawned_tmp=count%spawned
-  allocated_tmp=count%allocated
-  terminated_tmp=count%terminated
-
-!$OMP PARALLEL PRIVATE(j) REDUCTION(+:alive_tmp,spawned_tmp,allocated_tmp,terminated_tmp)
- 
-  ! Make sure that all particles are within domain
-  !***********************************************
-!$OMP DO
-  do j=1,numpart
-    if ((part(j)%xlon.lt.0.).or.(part(j)%xlon.ge.real(nxmin1,kind=dp)).or. &
-         (part(j)%ylat.lt.0.).or.(part(j)%ylat.ge.real(nymin1,kind=dp))) then
-      call terminate_particle(j,0)
-      alive_tmp=alive_tmp-1
-      terminated_tmp=terminated_tmp+1
-    endif
-  end do
-!$OMP END DO
-!$OMP END PARALLEL
-
-  count%alive=alive_tmp
-  count%spawned=spawned_tmp
-  count%allocated=allocated_tmp
-  count%terminated=terminated_tmp
-  ! Check whether numpart is really smaller than maxpart
-  !*****************************************************
-
-  ! ! ESO :TODO: this warning need to be moved further up, else out-of-bounds error earlier
-  !   if (numpart.gt.maxpart) then
-  !     write(*,*) 'numpart too large: change source in init_atm_mass.f'
-  !     write(*,*) 'numpart: ',numpart,' maxpart: ',maxpart
-  !   endif
-
-
-  xmassperparticle=colmasstotal/real(numparttot)
-
-
-  ! For boundary conditions, we need fewer particle release heights per column,
-  ! because otherwise it takes too long until enough mass has accumulated to
-  ! release a particle at the boundary (would take dx/u seconds), leading to
-  ! relatively large position errors of the order of one grid distance.
-  ! It's better to release fewer particles per column, but to do so more often.
-  ! Thus, use on the order of nz starting heights per column.
-  ! We thus repeat the above to determine fewer starting heights, that are
-  ! used furtheron in subroutine boundcond_domainfill.f.
-  !****************************************************************************
-
-  fractus=real(numcolumn)/real(nz)
-  write(*,*) 'Total number of particles at model start: ',numpart
-  write(*,*) 'Maximum number of particles per column: ',numcolumn
-  write(*,*) 'If ',fractus,' <1, better use more particles'
-  fractus=sqrt(max(fractus,1.))/2.
-
-  do ljy=ny_sn(1),ny_sn(2)      ! loop about latitudes
-    do lix=nx_we(1),nx_we(2)      ! loop about longitudes
-      ncolumn=nint(0.999/fractus*real(npart(1))*colmass(lix,ljy) &
-           /colmasstotal)
-      if (ncolumn.gt.maxcolumn) stop 'maxcolumn too small'
-      if (ncolumn.eq.0) cycle
-
-
-  ! Memorize how many particles per column shall be used for all boundaries
-  ! This is further used in subroutine boundcond_domainfill.f
-  ! Use 2 fields for west/east and south/north boundary
-  !************************************************************************
-
-      if (lix.eq.nx_we(1)) numcolumn_we(1,ljy)=ncolumn
-      if (lix.eq.nx_we(2)) numcolumn_we(2,ljy)=ncolumn
-      if (ljy.eq.ny_sn(1)) numcolumn_sn(1,lix)=ncolumn
-      if (ljy.eq.ny_sn(2)) numcolumn_sn(2,lix)=ncolumn
-
-  ! Calculate pressure at the altitudes of model surfaces, using the air density
-  ! information, which is stored as a 3-d field
-  !*****************************************************************************
-
-      do kz=1,nz
-        pp(kz)=prs(lix,ljy,kz,1) !rho(lix,ljy,kz,1)*r_air*tt(lix,ljy,kz,1)
-      end do
-
-  ! Determine the reference starting altitudes
-  !*******************************************
-
-      deltacol=(pp(1)-pp(nz))/real(ncolumn)
-      pnew=pp(1)+deltacol/2.
-      do j=1,ncolumn
-        pnew=pnew-deltacol
-        do kz=1,nz-1
-          if ((pp(kz).ge.pnew).and.(pp(kz+1).lt.pnew)) then
-            dz1=pp(kz)-pnew
-            dz2=pnew-pp(kz+1)
-            dz=1./(dz1+dz2)
-            zposition=(height(kz)*dz2+height(kz+1)*dz1)*dz
-            if (zposition.gt.height(nz)-0.5) zposition=height(nz)-0.5
-
-  ! Memorize vertical positions where particles are introduced
-  ! This is further used in subroutine boundcond_domainfill.f
-  !***********************************************************
-
-            if (lix.eq.nx_we(1)) zcolumn_we(1,ljy,j)=zposition
-            if (lix.eq.nx_we(2)) zcolumn_we(2,ljy,j)=zposition
-            if (ljy.eq.ny_sn(1)) zcolumn_sn(1,lix,j)=zposition
-            if (ljy.eq.ny_sn(2)) zcolumn_sn(2,lix,j)=zposition
-
-  ! Initialize mass that has accumulated at boundary to zero
-  !*********************************************************
-
-            acc_mass_we(1,ljy,j)=0.
-            acc_mass_we(2,ljy,j)=0.
-            acc_mass_sn(1,ljy,j)=0.
-            acc_mass_sn(2,ljy,j)=0.
-          endif
-        end do
-      end do
-    end do
-  end do
-
-  ! If there were more particles allocated than used,
-  ! Deallocate unused memory and update numpart
-  !**************************************************
-  deall=.false.
-  do i=numpart, 1, -1
-    if (.not. part(i)%alive) then
-      deall=.true.
-      numpart = numpart - 1
-    else
-      exit
-    endif
-  end do
-
-  if (deall) call dealloc_particle(numpart) !Deallocates everything above numpart (F2008)
+#include "ini_releaseparticle.f90"
 
+#include "ini_readpartpositions.f90"
 
-  ! If particles shall be read in to continue an existing run,
-  ! then the accumulated masses at the domain boundaries must be read in, too.
-  ! This overrides any previous calculations.
-  !***************************************************************************
+#include "ini_readrestart.f90"
 
-  if ((ipin.eq.1).and.(.not.gdomainfill)) then
-    open(unitboundcond,file=path(2)(1:length(2))//'boundcond.bin', &
-         form='unformatted')
-    read(unitboundcond) numcolumn_we,numcolumn_sn, &
-         zcolumn_we,zcolumn_sn,acc_mass_we,acc_mass_sn
-    close(unitboundcond)
-  endif
+#include "ini_read_heightlevels.f90"
 
-  deallocate(gridarea,colmass)
-end subroutine init_domainfill
+#include "ini_init_particle.f90"
 
-subroutine boundcond_domainfill(itime,loutend)
-  !                                  i      i
-  !*****************************************************************************
-  !                                                                            *
-  ! Particles are created by this subroutine continuously throughout the       *
-  ! simulation at the boundaries of the domain-filling box.                    *
-  ! All particles carry the same amount of mass which alltogether comprises the*
-  ! mass of air within the box, which remains (more or less) constant.         *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     16 October 2002                                                        *
-  !                                                                            *
-  !  Changes                                                                   *
-  !     2022, L. Bakels: OpenMP parallelisation                                *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  !                                                                            *
-  ! nx_we(2)       grid indices for western and eastern boundary of domain-    *
-  !                filling trajectory calculations                             *
-  ! ny_sn(2)       grid indices for southern and northern boundary of domain-  *
-  !                filling trajectory calculations                             *
-  !                                                                            *
-  !*****************************************************************************
-
-  use point_mod
-#ifdef _OPENMP
-  use omp_lib
-#endif
-  implicit none
-
-  real :: dz,dz1,dz2,dt1,dt2,dtt,ylat,xm,cosfact,accmasst
-  integer :: itime,in,indz,indzp,i,loutend,numparticlecount_tmp
-  integer :: j,k,ix,jy,m,indzh,indexh,minpart,ipart,mmass,ithread
-  integer :: numactiveparticles
-
-  real :: windl(2),rhol(2)
-  real :: windhl(2),rhohl(2)
-  real :: windx,rhox
-  real :: deltaz,boundarea,fluxofmass
-
-  integer :: ixm,ixp,jym,jyp,indzm,mm
-  real :: pvpart,ddx,ddy,rddx,rddy,p1,p2,p3,p4,y1(2),yh1(2)
-
-  integer :: idummy = -11
-
-
-  ! If domain-filling is global, no boundary conditions are needed
-  !***************************************************************
-
-  if (gdomainfill) return
-
-  ! Determine auxiliary variables for time interpolation
-  !*****************************************************
-
-  dt1=real(itime-memtime(1))
-  dt2=real(memtime(2)-itime)
-  dtt=1./(dt1+dt2)
-
-  numactiveparticles=0
-  numparticlecount_tmp=numparticlecount
-  accmasst=0.
-  ! Terminate trajectories that have left the domain, if domain-filling
-  ! trajectory calculation domain is not global
-  !********************************************************************
-
-  do i=1,numpart
-    if (.not. part(i)%alive) cycle
-
-    if ((part(i)%ylat.gt.real(ny_sn(2))).or. &
-         (part(i)%ylat.lt.real(ny_sn(1)))) call terminate_particle(i,itime)
-    if (((.not.xglobal).or.(nx_we(2).ne.(nx-2))).and. &
-         ((part(i)%xlon.lt.real(nx_we(1))).or. &
-         (part(i)%xlon.gt.real(nx_we(2))))) call terminate_particle(i,itime)
-    if (part(i)%alive) numactiveparticles = numactiveparticles+1
-  end do
-
-  !***************************************
-  ! Western and eastern boundary condition
-  !***************************************
-
-  ! Loop from south to north
-  !*************************
-!$OMP PARALLEL PRIVATE(i,jy,k,j,deltaz,boundarea,indz,indzp,indexh,windl,rhol, &
-!$OMP windhl,rhohl,windx,rhox,fluxofmass,mmass,ixm,jym,ixp,jyp,ddx,ddy,rddx, &
-!$OMP rddy,p1,p2,p3,p4,indzm,mm,indzh,pvpart,ylat,ix,cosfact,ipart) &
-!$OMP REDUCTION(+:numactiveparticles,numparticlecount_tmp,accmasst)
-
-#ifdef _OPENMP
-  ithread = OMP_GET_THREAD_NUM()
-#else
-  ithread = 0
-#endif
-
-!$OMP DO
-  do jy=ny_sn(1),ny_sn(2)
-
-  ! Loop over western (index 1) and eastern (index 2) boundary
-  !***********************************************************
-
-    do k=1,2
-
-  ! Loop over all release locations in a column
-  !********************************************
-
-      do j=1,numcolumn_we(k,jy)
-
-  ! Determine, for each release location, the area of the corresponding boundary
-  !*****************************************************************************
-
-        if (j.eq.1) then
-          deltaz=(zcolumn_we(k,jy,2)+zcolumn_we(k,jy,1))/2.
-        else if (j.eq.numcolumn_we(k,jy)) then
-  ! In order to avoid taking a very high column for very many particles,
-  ! use the deltaz from one particle below instead
-          deltaz=(zcolumn_we(k,jy,j)-zcolumn_we(k,jy,j-2))/2.
-        else
-          deltaz=(zcolumn_we(k,jy,j+1)-zcolumn_we(k,jy,j-1))/2.
-        endif
-        if ((jy.eq.ny_sn(1)).or.(jy.eq.ny_sn(2))) then
-          boundarea=deltaz*111198.5/2.*dy
-        else
-          boundarea=deltaz*111198.5*dy
-        endif
-
-
-  ! Interpolate the wind velocity and density to the release location
-  !******************************************************************
-
-  ! Determine the model level below the release position
-  !*****************************************************
-        indz=nz-1
-        indzp=nz
-        do i=2,nz
-          if (height(i).gt.zcolumn_we(k,jy,j)) then
-            indz=i-1
-            indzp=i
-            exit
-          endif
-        end do
-
-  ! Vertical distance to the level below and above current position
-  !****************************************************************
-
-        dz1=zcolumn_we(k,jy,j)-height(indz)
-        dz2=height(indzp)-zcolumn_we(k,jy,j)
-        dz=1./(dz1+dz2)
-
-  ! Vertical and temporal interpolation
-  !************************************
-
-        do m=1,2
-          indexh=memind(m)
-          do in=1,2
-            indzh=indz+in-1
-            windl(in)=uu(nx_we(k),jy,indzh,indexh)
-            rhol(in)=rho(nx_we(k),jy,indzh,indexh)
-          end do
-
-          windhl(m)=(dz2*windl(1)+dz1*windl(2))*dz
-          rhohl(m)=(dz2*rhol(1)+dz1*rhol(2))*dz
-        end do
-
-        windx=(windhl(1)*dt2+windhl(2)*dt1)*dtt
-        rhox=(rhohl(1)*dt2+rhohl(2)*dt1)*dtt
-
-  ! Calculate mass flux
-  !********************
-
-        fluxofmass=windx*rhox*boundarea*real(lsynctime)
-
-
-  ! If the mass flux is directed into the domain, add it to previous mass fluxes;
-  ! if it is out of the domain, set accumulated mass flux to zero
-  !******************************************************************************
-
-        if (k.eq.1) then
-          if (fluxofmass.ge.0.) then
-            acc_mass_we(k,jy,j)=acc_mass_we(k,jy,j)+fluxofmass
-          else
-            acc_mass_we(k,jy,j)=0.
-          endif
-        else
-          if (fluxofmass.le.0.) then
-            acc_mass_we(k,jy,j)=acc_mass_we(k,jy,j)+abs(fluxofmass)
-          else
-            acc_mass_we(k,jy,j)=0.
-          endif
-        endif
-        accmasst=accmasst+acc_mass_we(k,jy,j)
-
-  ! If the accumulated mass exceeds half the mass that each particle shall carry,
-  ! one (or more) particle(s) is (are) released and the accumulated mass is
-  ! reduced by the mass of this (these) particle(s)
-  !******************************************************************************
-
-        if (acc_mass_we(k,jy,j).ge.xmassperparticle/2.) then
-          mmass=int((acc_mass_we(k,jy,j)+xmassperparticle/2.)/ &
-               xmassperparticle)
-          acc_mass_we(k,jy,j)=acc_mass_we(k,jy,j)- &
-               real(mmass)*xmassperparticle
-        else
-          mmass=0
-        endif
-
-        do m=1,mmass
-          call get_newpart_index(ipart)
-          call spawn_particle(itime, ipart)
-
-  ! Assign particle positions
-  !**************************
-
-          call set_xlon(ipart,real(nx_we(k),kind=dp))
-          if (jy.eq.ny_sn(1)) then
-            call set_ylat(ipart,real(real(jy)+0.5*ran1(idummy,ithread),kind=dp))
-          else if (jy.eq.ny_sn(2)) then
-            call set_ylat(ipart,real(real(jy)-0.5*ran1(idummy,ithread),kind=dp))
-          else
-            call set_ylat(ipart,real(real(jy)+(ran1(idummy,ithread)-.5),kind=dp))
-          endif
-          if (j.eq.1) then
-            call set_z(ipart,zcolumn_we(k,jy,1)+(zcolumn_we(k,jy,2)- &
-                 zcolumn_we(k,jy,1))/4.)
-          else if (j.eq.numcolumn_we(k,jy)) then
-            call set_z(ipart,(2.*zcolumn_we(k,jy,j)+ &
-                 zcolumn_we(k,jy,j-1)+height(nz))/4.)
-          else
-            call set_z(ipart,zcolumn_we(k,jy,j-1)+ran1(idummy,ithread)* &
-                 (zcolumn_we(k,jy,j+1)-zcolumn_we(k,jy,j-1)))
-          endif
-
-          call update_z_to_zeta(itime, ipart)
-
-  ! Interpolate PV to the particle position
-  !****************************************
-          ixm=int(part(ipart)%xlon)
-          jym=int(part(ipart)%ylat)
-          ixp=ixm+1
-          jyp=jym+1
-          ddx=part(ipart)%xlon-real(ixm)
-          ddy=part(ipart)%ylat-real(jym)
-          rddx=1.-ddx
-          rddy=1.-ddy
-          p1=rddx*rddy
-          p2=ddx*rddy
-          p3=rddx*ddy
-          p4=ddx*ddy
-          indzm=nz-1
-          indzp=nz
-          do i=2,nz
-            if (real(height(i),kind=dp).gt.part(ipart)%z) then
-              indzm=i-1
-              indzp=i
-              exit
-            endif
-          end do
-          dz1=real(part(ipart)%z)-height(indzm)
-          dz2=height(indzp)-real(part(ipart)%z)
-          dz=1./(dz1+dz2)
-          do mm=1,2
-            indexh=memind(mm)
-            do in=1,2
-              indzh=indzm+in-1
-              y1(in)=p1*pv(ixm,jym,indzh,indexh) &
-                   +p2*pv(ixp,jym,indzh,indexh) &
-                   +p3*pv(ixm,jyp,indzh,indexh) &
-                   +p4*pv(ixp,jyp,indzh,indexh)
-            end do
-            yh1(mm)=(dz2*y1(1)+dz1*y1(2))*dz
-          end do
-          pvpart=(yh1(1)*dt2+yh1(2)*dt1)*dtt
-          ylat=ylat0+part(ipart)%ylat*dy
-          if (ylat.lt.0.) pvpart=-1.*pvpart
-
-
-  ! For domain-filling option 2 (stratospheric O3), do the rest only in the stratosphere
-  !*****************************************************************************
-
-          if (((part(ipart)%z.gt.3000.).and. &
-               (pvpart.gt.pvcrit)).or.(mdomainfill.eq.1)) then
-            part(ipart)%nclass=min(int(ran1(idummy,ithread)* &
-                 real(nclassunc))+1,nclassunc)
-            numactiveparticles=numactiveparticles+1
-            numparticlecount_tmp=numparticlecount_tmp+1
-            part(ipart)%npoint=numparticlecount_tmp
-            part(ipart)%idt=mintime
-            part(ipart)%tstart=itime
-            part(ipart)%mass(1)=xmassperparticle
-            if (mdomainfill.eq.2) part(ipart)%mass(1)= &
-                 part(ipart)%mass(1)*pvpart*48./29.*ozonescale/10.**9
-            part(ipart)%mass_init(1)=part(ipart)%mass(1)
-          else
-            stop 'boundcond_domainfill error: look into original to understand what should happen here'
-          endif
-        end do ! particles
-      end do ! release locations in column
-    end do ! western and eastern boundary
-  end do ! south to north
-!$OMP END DO
-
-  !*****************************************
-  ! Southern and northern boundary condition
-  !*****************************************
-
-  ! Loop from west to east
-  !***********************
-!$OMP DO
-  do ix=nx_we(1),nx_we(2)
-
-  ! Loop over southern (index 1) and northern (index 2) boundary
-  !*************************************************************
-
-    do k=1,2
-      ylat=ylat0+real(ny_sn(k))*dy
-      cosfact=cos(ylat*pi180)
-
-  ! Loop over all release locations in a column
-  !********************************************
-
-      do j=1,numcolumn_sn(k,ix)
-
-  ! Determine, for each release location, the area of the corresponding boundary
-  !*****************************************************************************
-
-        if (j.eq.1) then
-          deltaz=(zcolumn_sn(k,ix,2)+zcolumn_sn(k,ix,1))/2.
-        else if (j.eq.numcolumn_sn(k,ix)) then
-  !        deltaz=height(nz)-(zcolumn_sn(k,ix,j-1)+
-  !    +        zcolumn_sn(k,ix,j))/2.
-  ! In order to avoid taking a very high column for very many particles,
-  ! use the deltaz from one particle below instead
-          deltaz=(zcolumn_sn(k,ix,j)-zcolumn_sn(k,ix,j-2))/2.
-        else
-          deltaz=(zcolumn_sn(k,ix,j+1)-zcolumn_sn(k,ix,j-1))/2.
-        endif
-        if ((ix.eq.nx_we(1)).or.(ix.eq.nx_we(2))) then
-          boundarea=deltaz*111198.5/2.*cosfact*dx
-        else
-          boundarea=deltaz*111198.5*cosfact*dx
-        endif
-
-
-  ! Interpolate the wind velocity and density to the release location
-  !******************************************************************
-
-  ! Determine the model level below the release position
-  !*****************************************************
-        indz=nz-1
-        indzp=nz
-        do i=2,nz
-          if (height(i).gt.zcolumn_sn(k,ix,j)) then
-            indz=i-1
-            indzp=i
-            exit
-          endif
-        end do
-
-  ! Vertical distance to the level below and above current position
-  !****************************************************************
-
-        dz1=zcolumn_sn(k,ix,j)-height(indz)
-        dz2=height(indzp)-zcolumn_sn(k,ix,j)
-        dz=1./(dz1+dz2)
-
-  ! Vertical and temporal interpolation
-  !************************************
-
-        do m=1,2
-          indexh=memind(m)
-          do in=1,2
-            indzh=indz+in-1
-            windl(in)=vv(ix,ny_sn(k),indzh,indexh)
-            rhol(in)=rho(ix,ny_sn(k),indzh,indexh)
-          end do
-
-          windhl(m)=(dz2*windl(1)+dz1*windl(2))*dz
-          rhohl(m)=(dz2*rhol(1)+dz1*rhol(2))*dz
-        end do
-
-        windx=(windhl(1)*dt2+windhl(2)*dt1)*dtt
-        rhox=(rhohl(1)*dt2+rhohl(2)*dt1)*dtt
-
-  ! Calculate mass flux
-  !********************
-
-        fluxofmass=windx*rhox*boundarea*real(lsynctime)
-
-  ! If the mass flux is directed into the domain, add it to previous mass fluxes;
-  ! if it is out of the domain, set accumulated mass flux to zero
-  !******************************************************************************
-
-        if (k.eq.1) then
-          if (fluxofmass.ge.0.) then
-            acc_mass_sn(k,ix,j)=acc_mass_sn(k,ix,j)+fluxofmass
-          else
-            acc_mass_sn(k,ix,j)=0.
-          endif
-        else
-          if (fluxofmass.le.0.) then
-            acc_mass_sn(k,ix,j)=acc_mass_sn(k,ix,j)+abs(fluxofmass)
-          else
-            acc_mass_sn(k,ix,j)=0.
-          endif
-        endif
-        accmasst=accmasst+acc_mass_sn(k,ix,j)
-
-  ! If the accumulated mass exceeds half the mass that each particle shall carry,
-  ! one (or more) particle(s) is (are) released and the accumulated mass is
-  ! reduced by the mass of this (these) particle(s)
-  !******************************************************************************
-
-        if (acc_mass_sn(k,ix,j).ge.xmassperparticle/2.) then
-          mmass=int((acc_mass_sn(k,ix,j)+xmassperparticle/2.)/ &
-               xmassperparticle)
-          acc_mass_sn(k,ix,j)=acc_mass_sn(k,ix,j)- &
-               real(mmass)*xmassperparticle
-        else
-          mmass=0
-        endif
-
-        do m=1,mmass
-          call get_newpart_index(ipart)
-          call spawn_particle(itime, ipart)
-  
-  ! Assign particle positions
-  !**************************
-          call set_ylat(ipart,real(ny_sn(k),kind=dp))
-          if (ix.eq.nx_we(1)) then
-            call set_xlon(ipart,real(real(ix)+0.5*ran1(idummy,ithread),kind=dp))
-          else if (ix.eq.nx_we(2)) then
-            call set_xlon(ipart,real(real(ix)-0.5*ran1(idummy,ithread),kind=dp))
-          else
-            call set_xlon(ipart,real(real(ix)+(ran1(idummy,ithread)-.5),kind=dp))
-          endif
-          if (j.eq.1) then
-            call set_z(ipart,zcolumn_sn(k,ix,1)+(zcolumn_sn(k,ix,2)- &
-                 zcolumn_sn(k,ix,1))/4.)
-          else if (j.eq.numcolumn_sn(k,ix)) then
-            call set_z(ipart,(2.*zcolumn_sn(k,ix,j)+ &
-                 zcolumn_sn(k,ix,j-1)+height(nz))/4.)
-          else
-            call set_z(ipart,zcolumn_sn(k,ix,j-1)+ran1(idummy,ithread)* &
-                 (zcolumn_sn(k,ix,j+1)-zcolumn_sn(k,ix,j-1)))
-          endif
-
-          call update_z_to_zeta(itime, ipart)
-
-  ! Interpolate PV to the particle position
-  !****************************************
-          ixm=int(part(ipart)%xlon)
-          jym=int(part(ipart)%ylat)
-          ixp=ixm+1
-          jyp=jym+1
-          ddx=part(ipart)%xlon-real(ixm)
-          ddy=part(ipart)%ylat-real(jym)
-          rddx=1.-ddx
-          rddy=1.-ddy
-          p1=rddx*rddy
-          p2=ddx*rddy
-          p3=rddx*ddy
-          p4=ddx*ddy
-          indzm=nz-1
-          indzp=nz
-          do i=2,nz
-            if (real(height(i),kind=dp).gt.part(ipart)%z) then
-              indzm=i-1
-              indzp=i
-              exit
-            endif
-          end do
-          dz1=real(part(ipart)%z)-height(indzm)
-          dz2=height(indzp)-real(part(ipart)%z)
-          dz=1./(dz1+dz2)
-          do mm=1,2
-            indexh=memind(mm)
-            do in=1,2
-              indzh=indzm+in-1
-              y1(in)=p1*pv(ixm,jym,indzh,indexh) &
-                   +p2*pv(ixp,jym,indzh,indexh) &
-                   +p3*pv(ixm,jyp,indzh,indexh) &
-                   +p4*pv(ixp,jyp,indzh,indexh)
-            end do
-            yh1(mm)=(dz2*y1(1)+dz1*y1(2))*dz
-          end do
-          pvpart=(yh1(1)*dt2+yh1(2)*dt1)*dtt
-          if (ylat.lt.0.) pvpart=-1.*pvpart
-
-
-  ! For domain-filling option 2 (stratospheric O3), do the rest only in the stratosphere
-  !*****************************************************************************
-
-          if (((part(ipart)%z.gt.3000.).and. &
-               (pvpart.gt.pvcrit)).or.(mdomainfill.eq.1)) then
-            part(ipart)%nclass=min(int(ran1(idummy,ithread)* &
-                 real(nclassunc))+1,nclassunc)
-            numactiveparticles=numactiveparticles+1
-            numparticlecount_tmp=numparticlecount_tmp+1
-            part(ipart)%npoint=numparticlecount_tmp
-            part(ipart)%idt=mintime
-            part(ipart)%mass(1)=xmassperparticle
-            if (mdomainfill.eq.2) part(ipart)%mass(1)= &
-                 part(ipart)%mass(1)*pvpart*48./29.*ozonescale/10.**9
-            part(ipart)%mass_init(1)=part(ipart)%mass(1)
-          else
-            stop 'boundcond_domainfill error: look into original to understand what should happen here'
-          endif
-        end do ! particles
-      end do ! releases per column
-    end do ! east west
-  end do ! north south
-!$OMP END DO
-!$OMP END PARALLEL
-  numparticlecount = numparticlecount_tmp
-  ! If particles shall be dumped, then accumulated masses at the domain boundaries
-  ! must be dumped, too, to be used for later runs
-  !*****************************************************************************
+#include "ini_init_domainfill.f90"
 
-  if ((ipout.gt.0).and.(itime.eq.loutend)) then
-    open(unitboundcond,file=path(2)(1:length(2))//'boundcond.bin', &
-         form='unformatted')
-    write(unitboundcond) numcolumn_we,numcolumn_sn, &
-         zcolumn_we,zcolumn_sn,acc_mass_we,acc_mass_sn
-    close(unitboundcond)
-  endif
-end subroutine boundcond_domainfill
+#include "ini_boundcond_domainfill.f90"
 
 end module initialise_mod
diff --git a/src/int_alloc_interpol.f90 b/src/int_alloc_interpol.f90
new file mode 100644
index 0000000000000000000000000000000000000000..ccfaa4075661bf12d69bed22cba4a73f91640f11
--- /dev/null
+++ b/src/int_alloc_interpol.f90
@@ -0,0 +1,8 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine alloc_interpol
+  ! allocate(uprof(nzmax),vprof(nzmax),wprof(nzmax),wprofeta(nzmax),      &
+  !   usigprof(nzmax),vsigprof(nzmax),wsigprof(nzmax),wsigprofeta(nzmax), &
+  !   rhoprof(nzmax),rhogradprof(nzmax),indzindicator(nzmax))
+end subroutine alloc_interpol
diff --git a/src/int_bilin_spatial_interpol.f90 b/src/int_bilin_spatial_interpol.f90
new file mode 100644
index 0000000000000000000000000000000000000000..aef7d4032b848cf635bcb657a5b3cf709e7fc44c
--- /dev/null
+++ b/src/int_bilin_spatial_interpol.f90
@@ -0,0 +1,29 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine bilin_spatial_interpol(field,output,zlevel,dz1,dz2,ztot)
+
+  integer, intent(in) :: zlevel,ztot        ! interpolation z level
+  real, intent(in)    :: field(0:nxmax-1,0:nymax-1,ztot,numwfmem)
+                                            ! input field to interpolate
+  real, intent(in)    :: dz1,dz2
+  real, intent(inout) :: output(2)          ! interpolated values
+  integer             :: m,n,indzh
+  real                :: output1(2)
+
+  do m=1,2
+
+    do n=1,2
+      indzh=zlevel+n-1
+      call hor_interpol_4d(field,output1(n),indzh,memind(m),ztot)
+    end do
+
+    !**********************************
+    ! 2.) Linear vertical interpolation on logarithmic scale
+    !**********************************
+
+    call vert_interpol(output1(1),output1(2),dz1,dz2,output(m))
+
+  end do
+
+end subroutine bilin_spatial_interpol
diff --git a/src/int_bilin_spatial_interpol_nest.f90 b/src/int_bilin_spatial_interpol_nest.f90
new file mode 100644
index 0000000000000000000000000000000000000000..9670851dd0b02100df246c196b8d5081003a8b9b
--- /dev/null
+++ b/src/int_bilin_spatial_interpol_nest.f90
@@ -0,0 +1,29 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine bilin_spatial_interpol_nest(field,output,zlevel,dz1,dz2,ztot)
+
+  integer, intent(in) :: zlevel,ztot       ! interpolation z level
+  real, intent(in)    :: field(0:nxmaxn-1,0:nymaxn-1,ztot,numwfmem,numbnests)
+                                           ! input field to interpolate
+  real, intent(in)    :: dz1,dz2
+  real, intent(inout) :: output(2)         ! interpolated values
+  integer             :: m,n,indzh
+  real                :: output1(2)
+
+  do m=1,2
+
+    do n=1,2
+      indzh=zlevel+n-1
+      call hor_interpol_4d_nest(field,output1(n),indzh,memind(m),ztot)
+    end do
+
+    !**********************************
+    ! 2.) Linear vertical interpolation on logarithmic scale
+    !**********************************
+
+    call vert_interpol(output1(1),output1(2),dz1,dz2,output(m))
+
+  end do
+
+end subroutine bilin_spatial_interpol_nest
diff --git a/src/int_compute_sl_sq.f90 b/src/int_compute_sl_sq.f90
new file mode 100644
index 0000000000000000000000000000000000000000..7799e58004a048ba1a7e480f4b7dc69394b65dcb
--- /dev/null
+++ b/src/int_compute_sl_sq.f90
@@ -0,0 +1,19 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine compute_sl_sq(field,sl,sq,zlevel,indexh,ztot)
+
+  integer, intent(in) :: zlevel,ztot,indexh   ! interpolation z levels
+  real, intent(in)    :: field(0:nxmax-1,0:nymax-1,ztot,numwfmem)
+                                              ! input field to interpolate
+  real, intent(inout) :: sl,sq                ! standard deviation
+
+  sl=sl+field(ix ,jy ,zlevel,indexh)+field(ixp,jy ,zlevel,indexh) &
+       +field(ix ,jyp,zlevel,indexh)+field(ixp,jyp,zlevel,indexh)
+
+  sq=sq+field(ix ,jy ,zlevel,indexh)*field(ix ,jy ,zlevel,indexh)+ &
+        field(ixp,jy ,zlevel,indexh)*field(ixp,jy ,zlevel,indexh)+ &
+        field(ix ,jyp,zlevel,indexh)*field(ix ,jyp,zlevel,indexh)+ &
+        field(ixp,jyp,zlevel,indexh)*field(ixp,jyp,zlevel,indexh)
+
+end subroutine compute_sl_sq
diff --git a/src/int_compute_sl_sq_nest.f90 b/src/int_compute_sl_sq_nest.f90
new file mode 100644
index 0000000000000000000000000000000000000000..bb2516212110da82d8a1cd31908adc46359fc323
--- /dev/null
+++ b/src/int_compute_sl_sq_nest.f90
@@ -0,0 +1,19 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine compute_sl_sq_nest(field,sl,sq,zlevel,indexh,ztot)
+
+  integer, intent(in) :: zlevel,ztot,indexh   ! interpolation z levels
+  real, intent(in)    :: field(0:nxmaxn-1,0:nymaxn-1,ztot,numwfmem,numbnests)
+                                              ! input field to interpolate
+  real, intent(inout) :: sl,sq                ! standard deviation
+
+  sl=sl+field(ix ,jy ,zlevel,indexh,ngrid)+field(ixp,jy ,zlevel,indexh,ngrid) &
+       +field(ix ,jyp,zlevel,indexh,ngrid)+field(ixp,jyp,zlevel,indexh,ngrid)
+
+  sq=sq+field(ix ,jy ,zlevel,indexh,ngrid)*field(ix ,jy ,zlevel,indexh,ngrid)+ &
+        field(ixp,jy ,zlevel,indexh,ngrid)*field(ixp,jy ,zlevel,indexh,ngrid)+ &
+        field(ix ,jyp,zlevel,indexh,ngrid)*field(ix ,jyp,zlevel,indexh,ngrid)+ &
+        field(ixp,jyp,zlevel,indexh,ngrid)*field(ixp,jyp,zlevel,indexh,ngrid)
+
+end subroutine compute_sl_sq_nest
diff --git a/src/int_dealloc_interpol.f90 b/src/int_dealloc_interpol.f90
new file mode 100644
index 0000000000000000000000000000000000000000..3b2c65322a09aba6111a126f6b626a79083ed477
--- /dev/null
+++ b/src/int_dealloc_interpol.f90
@@ -0,0 +1,8 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine dealloc_interpol
+  ! deallocate(uprof,vprof,wprof,wprofeta,      &
+  !   usigprof,vsigprof,wsigprof,wsigprofeta, &
+  !   rhoprof,rhogradprof,indzindicator)
+end subroutine dealloc_interpol
diff --git a/src/int_find_grid_distances.f90 b/src/int_find_grid_distances.f90
new file mode 100644
index 0000000000000000000000000000000000000000..56065952ddfb1cc17b03e06d0959aa812e8d09dd
--- /dev/null
+++ b/src/int_find_grid_distances.f90
@@ -0,0 +1,24 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine find_grid_distances(xt,yt)
+
+  implicit none
+
+  real, intent(in) :: xt,yt                 ! particle positions
+
+  if (ngrid.le.0) then
+    ddx=xt-real(ix)
+    ddy=yt-real(jy)
+  else
+    ddx=xtn-real(ix)
+    ddy=ytn-real(jy)
+  endif
+  rddx=1.-ddx
+  rddy=1.-ddy
+  p1=rddx*rddy
+  p2=ddx*rddy
+  p3=rddx*ddy
+  p4=ddx*ddy
+
+end subroutine find_grid_distances
diff --git a/src/int_find_grid_indices.f90 b/src/int_find_grid_indices.f90
new file mode 100644
index 0000000000000000000000000000000000000000..613ed104893e371a63c133ba2b807d55b69783d1
--- /dev/null
+++ b/src/int_find_grid_indices.f90
@@ -0,0 +1,42 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine find_grid_indices(xt,yt)
+
+  real, intent(in) :: xt,yt                 ! particle positions
+
+  if (ngrid.gt.0) then
+    xtn=(xt-xln(ngrid))*xresoln(ngrid)
+    ytn=(yt-yln(ngrid))*yresoln(ngrid)
+    ! ix=int(xtn)
+    ! jy=int(ytn)
+    ! nix=nint(xtn)
+    ! njy=nint(ytn)
+    nix=max(min(nint(xtn),nxn(ngrid)-1),0)
+    njy=max(min(nint(ytn),nyn(ngrid)-1),0)
+    ix=nix
+    jy=njy
+    ixp=ix+1
+    jyp=jy+1
+    return
+  else
+    ix=int(xt)
+    jy=int(yt)
+    nix=nint(xt)
+    njy=nint(yt)
+    ixp=ix+1
+    jyp=jy+1
+  endif
+
+  ! eso: Temporary fix for particle exactly at north pole
+  if (jyp.ge.nymax) then
+    write(*,*) 'WARNING: interpol_mod.f90 jyp >= nymax. xt,yt:',xt,yt
+    jyp=jyp-1
+  end if
+
+  if (ixp.ge.nxmax) then
+    write(*,*) 'WARNING: interpol_mod.f90 ixp >= nxmax. xt,yt:',xt,yt
+    ixp=ixp-nxmax
+  end if
+
+end subroutine find_grid_indices
diff --git a/src/int_find_ngrid_dp.f90 b/src/int_find_ngrid_dp.f90
new file mode 100644
index 0000000000000000000000000000000000000000..691b7128b4d465fd4da3156f4aa01b56b3e550fc
--- /dev/null
+++ b/src/int_find_ngrid_dp.f90
@@ -0,0 +1,27 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine find_ngrid_dp(xt,yt)
+
+  real eps
+  real(kind=dp), intent(in) :: xt,yt ! particle positions on grid
+  integer :: j
+
+  eps=nxmax/3.e5
+  if (nglobal.and.(real(yt).gt.switchnorthg)) then
+    ngrid=-1
+  else if (sglobal.and.(real(yt).lt.switchsouthg)) then
+    ngrid=-2
+  else
+    ngrid=0
+    ! Temporary fix for nested layer edges: replaced eps with dxn and dyn (LB)
+    do j=numbnests,1,-1
+      if (real(xt).gt.xln(j)+dxn(j) .and. real(xt).lt.xrn(j)-dxn(j) .and. &
+          real(yt).gt.yln(j)+dyn(j) .and. real(yt).lt.yrn(j)-dyn(j)) then
+        ngrid=j
+        exit
+      endif
+    end do
+  endif
+
+end subroutine find_ngrid_dp
diff --git a/src/int_find_ngrid_sp.f90 b/src/int_find_ngrid_sp.f90
new file mode 100644
index 0000000000000000000000000000000000000000..f9766f35a41a74a56f704156d0b79ff46305e18e
--- /dev/null
+++ b/src/int_find_ngrid_sp.f90
@@ -0,0 +1,27 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine find_ngrid_sp(xt,yt)
+
+  real :: eps
+  real, intent(in) :: xt,yt ! particle positions on grid
+  integer :: j
+
+  eps=nxmax/3.e5
+  if (nglobal .and. yt.gt.switchnorthg) then
+    ngrid=-1
+  else if (sglobal .and. yt.lt.switchsouthg) then
+    ngrid=-2
+  else
+    ngrid=0
+    ! Temporary fix for nested layer edges: replaced eps with dxn and dyn (LB)
+    do j=numbnests,1,-1
+      if (xt.gt.xln(j)+dxn(j) .and. xt.lt.xrn(j)-dxn(j) .and. &
+          yt.gt.yln(j)+dyn(j) .and. yt.lt.yrn(j)-dyn(j)) then
+        ngrid=j
+        exit
+      endif
+    end do
+  endif
+
+end subroutine find_ngrid_sp
diff --git a/src/int_find_time_vars.f90 b/src/int_find_time_vars.f90
new file mode 100644
index 0000000000000000000000000000000000000000..e4c5d2b8e2dcbd5a07e6170e02c6c15bf4584028
--- /dev/null
+++ b/src/int_find_time_vars.f90
@@ -0,0 +1,12 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine find_time_vars(itime)
+
+  integer, intent(in) :: itime             ! time step
+
+  dt1=real(itime-memtime(1))
+  dt2=real(memtime(2)-itime)
+  dtt=1./(dt1+dt2)
+
+end subroutine find_time_vars
diff --git a/src/int_find_vert_vars.f90 b/src/int_find_vert_vars.f90
new file mode 100644
index 0000000000000000000000000000000000000000..770d5b53ad80a0258cbdbf3dee0951f0e3fe6e4e
--- /dev/null
+++ b/src/int_find_vert_vars.f90
@@ -0,0 +1,95 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine find_vert_vars(vertlevels,zpos,zlevel,dz1,dz2,bounds,wlevel)
+
+  !*****************************************************************************
+  !                                                                            *
+  ! This subroutine computes the vertical interpolation variables              *
+  ! logarithmically, unless log_interpol=.false. in the par_mod                *
+  !                                                                            *
+  ! Author: L. Bakels                                                          *
+  !*****************************************************************************
+
+  real, intent(in)    :: vertlevels(:)    ! vertical levels in coordinate system
+  real, intent(in)    :: zpos             ! verticle particle position
+  integer, intent(in) :: zlevel           ! vertical level of interest
+  logical, intent(in) :: bounds(2),wlevel ! flag marking if particles are
+                                          ! outside bounds
+  real, intent(inout) :: dz1,dz2          ! fractional distance to point 1
+                                          ! (closer to ground) and 2
+  real                :: dz,dh1,dh,pfact
+  real                :: psint1(2),psint,pr1,pr2,pr_test
+                                          ! pressure of encompassing levels
+  integer             :: m
+
+  ! Only do logarithmic interpolation when using ETA coordinates, since the
+  ! levels are following pressure, while METER levels are linear.
+  !##############################################################
+
+  if (.not. log_interpol) then
+    call find_vert_vars_lin(vertlevels,zpos,zlevel,dz1,dz2,bounds,wlevel)
+    return
+  endif
+
+  ! To check if taking the logarithm is safe
+  if (wlevel) then
+    pr_test=akm(zlevel+1)+bkm(zlevel+1)
+  else
+    pr_test=akz(zlevel+1)+bkz(zlevel+1)
+  endif
+
+  ! If the particle is below bounds (bounds(1)==.true.):
+  if (bounds(1)) then
+    dz1=0.
+    dz2=1.
+  ! If above bounds (bounds(2)==.true.):
+  else if (bounds(2)) then
+    dz1=1.
+    dz2=0.
+
+  ! Instead of the linear z variables, we need the ones that correspond to
+  ! the pressure of the height of the particle in relation to the model levels
+  !***************************************************************************
+  else if (pr_test.eq.0) then
+    dz=1./(vertlevels(zlevel+1)-vertlevels(zlevel))
+    dz1=(zpos-vertlevels(zlevel))*dz
+    dz2=(vertlevels(zlevel+1)-zpos)*dz
+  else
+    if (ngrid.le.0) then
+      do m=1,2
+        call hor_interpol(ps,psint1(m),1,memind(m),1)
+      end do
+    else
+      do m=1,2
+        call hor_interpol_nest(psn,psint1(m),1,memind(m),1)
+      end do
+    endif
+    call temp_interpol(psint1(1),psint1(2),psint)
+    dh = vertlevels(zlevel+1)-vertlevels(zlevel)
+    dh1 = zpos - vertlevels(zlevel)
+    if (wlevel) then
+      pr1=akm(zlevel) + bkm(zlevel)*psint
+      pr2=akm(zlevel+1) + bkm(zlevel+1)*psint
+    else
+      pr1=akz(zlevel) + bkz(zlevel)*psint
+      pr2=akz(zlevel+1) + bkz(zlevel+1)*psint
+    endif
+    pfact = log(pr2/pr1)*dh1/dh
+    dz = 1./(pr2-pr1)
+    dz1 = pr1*(exp(pfact)-1.)*dz
+    dz2 = 1.-dz1
+  endif
+  ! else if ((vertlevels(zlevel).eq.0).or.(vertlevels(zlevel+1).eq.0)) then
+  !   ! Linear interpolation for bottom or top layer is zero
+  !   dz=1./(vertlevels(zlevel+1)-vertlevels(zlevel))
+  !   dz1=(zpos-vertlevels(zlevel))*dz
+  !   dz2=(vertlevels(zlevel+1)-zpos)*dz
+  ! else
+  !   ! Logaritmic interpolation
+  !   dz=1./(log(vertlevels(zlevel+1))-log(vertlevels(zlevel)))
+  !   dz1=(log(zpos)-log(vertlevels(zlevel)))*dz
+  !   dz2=(log(vertlevels(zlevel+1))-log(zpos))*dz
+  ! endif
+
+end subroutine find_vert_vars
diff --git a/src/int_find_vert_vars_lin.f90 b/src/int_find_vert_vars_lin.f90
new file mode 100644
index 0000000000000000000000000000000000000000..b393af61e0980a1f07df36374957c9e4d032d5ea
--- /dev/null
+++ b/src/int_find_vert_vars_lin.f90
@@ -0,0 +1,30 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine find_vert_vars_lin(vertlevels,zpos,zlevel,dz1,dz2,bounds,wlevel)
+
+  real, intent(in)    :: vertlevels(:)   ! vertical levels in coordinate system
+  real, intent(in)    :: zpos            ! verticle particle position
+  integer, intent(in) :: zlevel          ! vertical level of interest
+  logical, intent(in) :: bounds(2),wlevel! flag marking if particles are outside
+                                         ! bounds
+  real, intent(inout) :: dz1,dz2         ! fractional distance to point 1
+                                         ! (closer to ground) and 2
+  real                :: dz,dh1,dh,pfact
+  real :: psint1(2),psint,pr1,pr2,temp   ! pressure of encompassing levels
+
+  ! If the particle is below bounds (bounds(1)==.true.):
+  if (bounds(1)) then
+    dz1=0.
+    dz2=1.
+  ! If above bounds (bounds(2)==.true.):
+  else if (bounds(2)) then
+    dz1=1.
+    dz2=0.
+  else
+    dz=1./(vertlevels(zlevel+1)-vertlevels(zlevel))
+    dz1=(zpos-vertlevels(zlevel))*dz
+    dz2=(vertlevels(zlevel+1)-zpos)*dz
+  endif
+
+end subroutine find_vert_vars_lin
diff --git a/src/int_find_z_level.f90 b/src/int_find_z_level.f90
new file mode 100644
index 0000000000000000000000000000000000000000..482a54cc4911e9052949c2061ecf82958e9fe16a
--- /dev/null
+++ b/src/int_find_z_level.f90
@@ -0,0 +1,20 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine find_z_level(zt,zteta)
+
+  real, intent(in)     :: &
+    zt,                   & ! height in meters
+    zteta                   ! height in eta
+
+  select case (wind_coord_type)
+    case('ETA')
+      call find_z_level_meters(zt)
+      call find_z_level_eta(zteta)
+    case('METER')
+      call find_z_level_meters(zt)
+    case default
+      call find_z_level_meters(zt)
+  end select
+
+end subroutine find_z_level
diff --git a/src/int_find_z_level_eta.f90 b/src/int_find_z_level_eta.f90
new file mode 100644
index 0000000000000000000000000000000000000000..52a64c277cbb24d881adc10162855227f92cba10
--- /dev/null
+++ b/src/int_find_z_level_eta.f90
@@ -0,0 +1,13 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine find_z_level_eta(zteta)
+
+  real, intent(in)       :: zteta    ! height in eta coordinates
+  integer                :: i        ! loop variable
+
+  call find_z_level_eta_w(zteta)
+
+  call find_z_level_eta_uv(zteta)
+
+end subroutine find_z_level_eta
diff --git a/src/int_find_z_level_eta_uv.f90 b/src/int_find_z_level_eta_uv.f90
new file mode 100644
index 0000000000000000000000000000000000000000..81da654281ad175d3a868a31481e3f9f9dfb6fd2
--- /dev/null
+++ b/src/int_find_z_level_eta_uv.f90
@@ -0,0 +1,31 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine find_z_level_eta_uv(zteta)
+
+  real, intent(in)       :: zteta    ! height in eta coordinates
+  integer                :: i        ! loop variable
+
+  induv=nz-1
+  indpuv=nz
+  if (zteta.gt.uvheight(1)) then
+    lbounds_uv(1)=.true.
+    lbounds_uv(2)=.false.
+    induv=1
+    indpuv=2
+  else if (zteta.lt.uvheight(nz)) then
+    lbounds_uv(1)=.false.
+    lbounds_uv(2)=.true.
+  else
+    lbounds_uv(1)=.false.
+    lbounds_uv(2)=.false.
+    do i=2,nz
+      if (uvheight(i).lt.zteta) then
+        induv=i-1
+        indpuv=i
+        exit
+      endif
+    end do
+  endif
+
+end subroutine find_z_level_eta_uv
diff --git a/src/int_find_z_level_eta_w.f90 b/src/int_find_z_level_eta_w.f90
new file mode 100644
index 0000000000000000000000000000000000000000..5b1502cddf69632f70dcfa8df68a61b916e8d776
--- /dev/null
+++ b/src/int_find_z_level_eta_w.f90
@@ -0,0 +1,32 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine find_z_level_eta_w(zteta)
+
+  real, intent(in)       :: zteta    ! height in eta coordinates
+  integer                :: i        ! loop variable
+
+  indzeta=nz-1
+  indzpeta=nz
+  ! Flag particles that are above or below bounds
+  if (zteta.ge.wheight(1)) then
+    lbounds_w(1)=.true.
+    lbounds_w(2)=.false.
+    indzeta=1
+    indzpeta=2
+  else if (zteta.le.wheight(nz)) then
+    lbounds_w(1)=.false.
+    lbounds_w(2)=.true.
+  else
+    lbounds_w(1)=.false.
+    lbounds_w(2)=.false.
+    do i=2,nz
+      if (wheight(i).lt.zteta) then
+        indzeta=i-1
+        indzpeta=i
+        exit
+      endif
+    end do
+  endif
+
+end subroutine find_z_level_eta_w
diff --git a/src/int_find_z_level_meters.f90 b/src/int_find_z_level_meters.f90
new file mode 100644
index 0000000000000000000000000000000000000000..6ba6fc0d2d7f6409dee14202e4f9abbf7785a917
--- /dev/null
+++ b/src/int_find_z_level_meters.f90
@@ -0,0 +1,31 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine find_z_level_meters(zt)
+
+  real, intent(in)     :: zt       ! height in meters
+  integer              :: i
+
+  indz=nz-1
+  indzp=nz
+  if (zt.le.height(1)) then
+    lbounds(1)=.true.
+    lbounds(2)=.false.
+    indz=1
+    indzp=2
+  else if (zt.ge.height(nz)) then
+    lbounds(1)=.false.
+    lbounds(2)=.true.
+  else
+    lbounds(1)=.false.
+    lbounds(2)=.false.
+    do i=2,nz
+      if (height(i).gt.zt) then
+        indz=i-1
+        indzp=i
+        exit
+      endif
+    end do
+  endif
+
+end subroutine find_z_level_meters
diff --git a/src/int_hor_interpol_2d.f90 b/src/int_hor_interpol_2d.f90
new file mode 100644
index 0000000000000000000000000000000000000000..e21e9dac2f3a6eafe06162fa39febfdf5ac90411
--- /dev/null
+++ b/src/int_hor_interpol_2d.f90
@@ -0,0 +1,13 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine hor_interpol_2d(field,output)
+
+  real, intent(in)    :: field(0:nxmax-1,0:nymax-1)       ! 2D imput field
+  real, intent(inout) :: output                           ! Interpolated value
+
+  output=p1*field(ix ,jy) &
+         + p2*field(ixp,jy) &
+         + p3*field(ix ,jyp) &
+         + p4*field(ixp,jyp)
+end subroutine hor_interpol_2d
diff --git a/src/int_hor_interpol_2d_nest.f90 b/src/int_hor_interpol_2d_nest.f90
new file mode 100644
index 0000000000000000000000000000000000000000..bc8ae7c5501cc0a4ecd06e27b1cba3fff3ecb9d1
--- /dev/null
+++ b/src/int_hor_interpol_2d_nest.f90
@@ -0,0 +1,15 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine hor_interpol_2d_nest(field,output)
+
+  real, intent(in)    :: field(0:nxmaxn-1,0:nymaxn-1,numbnests)
+                                          ! input field to interpolate
+  real, intent(inout) :: output           ! interpolated values
+
+  output=p1*field(ix ,jy ,ngrid) &
+       + p2*field(ixp,jy ,ngrid) &
+       + p3*field(ix ,jyp,ngrid) &
+       + p4*field(ixp,jyp,ngrid)
+
+end subroutine hor_interpol_2d_nest
diff --git a/src/int_hor_interpol_4d.f90 b/src/int_hor_interpol_4d.f90
new file mode 100644
index 0000000000000000000000000000000000000000..2cba537dab38a04c9cf592ed65fcadd455eee800
--- /dev/null
+++ b/src/int_hor_interpol_4d.f90
@@ -0,0 +1,16 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine hor_interpol_4d(field,output,zlevel,indexh,ztot)
+
+  integer, intent(in) :: zlevel,ztot,indexh   ! interpolation z level, z
+  real, intent(in)    :: field(0:nxmax-1,0:nymax-1,ztot,numwfmem)
+   ! input field to interpolate
+  real, intent(inout) :: output  ! interpolated values
+
+  output=p1*field(ix ,jy ,zlevel,indexh) &
+       + p2*field(ixp,jy ,zlevel,indexh) &
+       + p3*field(ix ,jyp,zlevel,indexh) &
+       + p4*field(ixp,jyp,zlevel,indexh)
+
+end subroutine hor_interpol_4d
diff --git a/src/int_hor_interpol_4d_nest.f90 b/src/int_hor_interpol_4d_nest.f90
new file mode 100644
index 0000000000000000000000000000000000000000..5d285e4f48b373ba5760811371b30caf2b6b92e5
--- /dev/null
+++ b/src/int_hor_interpol_4d_nest.f90
@@ -0,0 +1,16 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine hor_interpol_4d_nest(field,output,zlevel,indexh,ztot)
+
+  integer, intent(in) :: zlevel,ztot,indexh   ! interpolation z level, z
+  real, intent(in)    :: field(0:nxmaxn-1,0:nymaxn-1,ztot,numwfmem,numbnests)
+                                              ! input field to interpolate
+  real, intent(inout) :: output               ! interpolated values
+
+  output=p1*field(ix ,jy ,zlevel,indexh,ngrid) &
+       + p2*field(ixp,jy ,zlevel,indexh,ngrid) &
+       + p3*field(ix ,jyp,zlevel,indexh,ngrid) &
+       + p4*field(ixp,jyp,zlevel,indexh,ngrid)
+
+end subroutine hor_interpol_4d_nest
diff --git a/src/int_init_interpol.f90 b/src/int_init_interpol.f90
new file mode 100644
index 0000000000000000000000000000000000000000..331792fc6464901d34fdf59f5e5949e0b9b674e0
--- /dev/null
+++ b/src/int_init_interpol.f90
@@ -0,0 +1,22 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine init_interpol(itime,xt,yt,zt,zteta)
+
+  ! This routine initialises all important values used in the interpol module
+  ! This includes:
+  ! - The current grid number in which the particle is positioned
+  ! - The interpolation fractions of the grid (x,y,z) and of time
+
+  integer, intent(in) :: itime             ! time step
+  real, intent(in)    :: xt,yt             ! particle positions
+  real, intent(in)    :: zt                ! height in meters
+  real, intent(in)    :: zteta             ! height in eta coordinates
+
+  call find_ngrid(xt,yt)
+  call find_grid_indices(xt,yt)
+  call find_grid_distances(xt,yt)
+  call find_time_vars(itime)
+  call find_z_level(zt,zteta)
+
+end subroutine init_interpol
diff --git a/src/int_interpol_density.f90 b/src/int_interpol_density.f90
new file mode 100644
index 0000000000000000000000000000000000000000..e4ce945bb10b83e5e6afbfba521929c48f3543e5
--- /dev/null
+++ b/src/int_interpol_density.f90
@@ -0,0 +1,56 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine interpol_density(itime,ipart,output)
+
+  integer, intent(in) :: itime,ipart  ! time and particle index
+  real, intent(inout) :: output ! output density (rhoi)
+  integer :: ind
+  real :: dz1,dz2,rhoprof(2)
+
+  ! Where in the grid? Stereographic (ngrid<0) or nested (ngrid>0)
+  !***************************************************************
+  call find_ngrid(part(ipart)%xlon,part(ipart)%ylat)
+  call find_grid_indices(real(part(ipart)%xlon),real(part(ipart)%ylat))
+  call find_grid_distances(real(part(ipart)%xlon),real(part(ipart)%ylat))
+  call find_time_vars(itime)
+
+  ! Take density from 2nd wind field in memory
+  !(accurate enough, no time interpolation needed)
+  !***********************************************
+
+  select case (wind_coord_type)
+    case ('ETA')
+      call find_z_level_eta(real(part(ipart)%zeta))
+      call find_vert_vars(uvheight,real(part(ipart)%zeta),induv, &
+        dz1,dz2,lbounds_uv,.false.)
+      if (ngrid.le.0) then
+        do ind=induv,indpuv
+          call hor_interpol(rhoeta,rhoprof(ind-induv+1),ind,memind(2),nzmax)
+        end do
+      else
+        do ind=induv,indpuv
+          call hor_interpol_nest(rhoetan,rhoprof(ind-induv+1),ind,memind(2), &
+            nzmax)
+        end do
+      endif
+    case ('METER')
+      call find_z_level_meters(real(part(ipart)%z))
+      call find_vert_vars(height,real(part(ipart)%z),indz, &
+        dz1,dz2,lbounds,.false.)
+      if (ngrid.le.0) then
+        do ind=indz,indzp
+          call hor_interpol(rho,rhoprof(ind-indz+1),ind,memind(2),nzmax)
+        end do
+      else
+        do ind=indz,indzp
+          call hor_interpol_nest(rhon,rhoprof(ind-indz+1),ind,memind(2),nzmax)
+        end do
+      endif
+    case default
+      stop 'wind_coord_type not defined in conccalc.f90'
+  end select
+
+  call vert_interpol(rhoprof(1),rhoprof(2),dz1,dz2,output)
+
+end subroutine interpol_density
diff --git a/src/int_interpol_htropo_hmix.f90 b/src/int_interpol_htropo_hmix.f90
new file mode 100644
index 0000000000000000000000000000000000000000..1a91ce6d23dfc5ab5d220e11c5196f8a595835ca
--- /dev/null
+++ b/src/int_interpol_htropo_hmix.f90
@@ -0,0 +1,43 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine interpol_htropo_hmix(tropop,h)
+
+  real, intent(inout) :: tropop   ! height of troposphere
+  real, intent(inout) :: h        ! mixing height
+  real    :: h1(2)                ! mixing height of 2 timesteps
+  integer :: mind                 ! windfield index
+  integer :: i,j,k,m              ! loop variables
+
+  h=0.
+  if (ngrid.le.0) then
+    if (interpolhmix) then
+      do m=1,2
+        call hor_interpol(hmix,h1(m),1,memind(m),1)
+      end do
+    else
+      do k=1,2
+        mind=memind(k) ! eso: compatibility with 3-field version
+        do j=jy,jyp
+          do i=ix,ixp
+             if (hmix(i,j,1,mind).gt.h) h=hmix(i,j,1,mind)
+          end do
+        end do
+      end do
+    endif
+    tropop=tropopause(nix,njy,1,memind(1))
+  else
+    do k=1,2
+      mind=memind(k)
+      do j=jy,jyp
+        do i=ix,ixp
+          if (hmixn(i,j,1,mind,ngrid).gt.h) h=hmixn(i,j,1,mind,ngrid)
+        end do
+      end do
+    end do
+    tropop=tropopausen(nix,njy,1,memind(1),ngrid)
+  endif
+
+  if (interpolhmix) h= (h1(1)*dt2 + h1(2)*dt1)*dtt
+
+end subroutine interpol_htropo_hmix
diff --git a/src/int_interpol_mesoscale.f90 b/src/int_interpol_mesoscale.f90
new file mode 100644
index 0000000000000000000000000000000000000000..2916681327dfb7f6ffca8ac806b0f0830c0d2b96
--- /dev/null
+++ b/src/int_interpol_mesoscale.f90
@@ -0,0 +1,39 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine interpol_mesoscale(itime,xt,yt,zt,zteta)
+
+  use turbulence_mod
+
+  integer, intent(in) :: itime
+  real, intent(in)    :: xt,yt,zt,zteta
+  integer             :: iw(2),iuv(2),iweta(2)
+  integer             :: m,indexh
+
+  ! Where in the grid? Stereographic (ngrid<0) or nested (ngrid>0)
+  !***************************************************************
+  call find_ngrid(xt,yt)
+
+  call find_grid_indices(xt,yt)
+
+  ! Determine the level below the current position
+  !***********************************************
+  call find_z_level_meters(zt)
+  iw(:)=(/ indz, indzp /)
+
+  select case (wind_coord_type)
+    case ('ETA')
+      call find_z_level_eta(zteta)
+      iuv(:)=(/ induv, indpuv /)
+      iweta(:)=(/ indzeta, indzpeta /)
+      call stdev_eta(iw,iuv,iweta)
+    case ('METER')
+      iw(:)=(/ indz, indzp /)
+      call stdev_meter(iw)
+    case default
+      write(*,*) 'ERROR: wind_coord_type is not allowed ', wind_coord_type
+      write(*,*) 'Choose ETA or METER.'
+      stop
+  end select
+
+end subroutine interpol_mesoscale
diff --git a/src/int_interpol_mixinglayer_eta.f90 b/src/int_interpol_mixinglayer_eta.f90
new file mode 100644
index 0000000000000000000000000000000000000000..02fff3551b41615a22bdbe9de8c1b1d8f5241572
--- /dev/null
+++ b/src/int_interpol_mixinglayer_eta.f90
@@ -0,0 +1,21 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine interpol_mixinglayer_eta(zt,zteta,rhoa,rhograd)
+
+  real, intent(in)    :: zt,zteta
+  real, intent(inout) :: rhoa,rhograd
+  real                :: dz1w,dz2w,dz1uv,dz2uv,dz1weta,dz2weta
+
+  call find_vert_vars(height,zt,indz,dz1w,dz2w,lbounds,.false.)
+  call find_vert_vars(uvheight,zteta,induv,dz1uv,dz2uv,lbounds_uv,.false.)
+  call find_vert_vars(wheight,zteta,indzeta,dz1weta,dz2weta,lbounds_w,.true.)
+
+  call vert_interpol(wprof(indz),wprof(indzp),dz1w,dz2w,w)
+  call vert_interpol(uprof(induv),uprof(indpuv),dz1uv,dz2uv,u)
+  call vert_interpol(vprof(induv),vprof(indpuv),dz1uv,dz2uv,v)
+  call vert_interpol(rhoprof(induv),rhoprof(indpuv),dz1uv,dz2uv,rhoa)
+  call vert_interpol(rhogradprof(induv),rhogradprof(indpuv),dz1uv,dz2uv,rhograd)
+  call vert_interpol(wprofeta(indzeta),wprofeta(indzpeta),dz1weta,dz2weta,weta)
+
+end subroutine interpol_mixinglayer_eta
diff --git a/src/int_interpol_partoutput_val.f90 b/src/int_interpol_partoutput_val.f90
new file mode 100644
index 0000000000000000000000000000000000000000..1d3647398f00a74f9ce3090d1481997aa7c2f5bd
--- /dev/null
+++ b/src/int_interpol_partoutput_val.f90
@@ -0,0 +1,22 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine interpol_partoutput_val(fieldname,output,j)
+
+  integer, intent(in)         :: j          ! particle number
+  character(2), intent(in)    :: fieldname  ! input field to interpolate over
+  real, intent(inout)         :: output
+
+  ! Interpolate over the windfields depending on the prefered
+  ! coordinate system
+  !**********************************************************
+  select case (wind_coord_type)
+    case ('ETA')
+      call interpol_partoutput_val_eta(fieldname,output,j)
+    case ('METER')
+      call interpol_partoutput_val_meter(fieldname,output,j)
+    case default
+      call interpol_partoutput_val_meter(fieldname,output,j)
+  end select
+
+end subroutine interpol_partoutput_val
diff --git a/src/int_interpol_partoutput_val_eta.f90 b/src/int_interpol_partoutput_val_eta.f90
new file mode 100644
index 0000000000000000000000000000000000000000..eed092141bf330db99a75d700c1d24fb2f49a643
--- /dev/null
+++ b/src/int_interpol_partoutput_val_eta.f90
@@ -0,0 +1,81 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine interpol_partoutput_val_eta(fieldname,output,j)
+
+!* PRIVATE FUNCTION *
+
+  integer, intent(in)         :: j          ! particle number
+  character(2), intent(in)    :: fieldname  ! input field to interpolate over
+  real, intent(inout)         :: output
+  real                        :: field1(2)
+
+  if (int(dz1out).eq.-1) then
+    call find_z_level_eta(real(part(j)%zeta))
+    call find_vert_vars(uvheight,real(part(j)%zeta),induv,dz1out,dz2out, &
+      lbounds_uv,.false.)
+  endif
+
+  select case(fieldname)
+    case('PR','pr')
+      if (ngrid.le.0) then
+        call bilin_spatial_interpol(prseta,field1,induv,dz1out,dz2out,nzmax)
+      else
+        call bilin_spatial_interpol_nest(prsetan,field1,induv,dz1out,dz2out,nzmax)
+      endif
+      call temp_interpol(field1(1),field1(2),output)
+    case('PV','pv')
+      if (ngrid.le.0) then
+        call bilin_spatial_interpol(pveta,field1,induv,dz1out,dz2out,nzmax)
+      else
+        call bilin_spatial_interpol_nest(pvetan,field1,induv,dz1out,dz2out,nzmax)
+      endif
+      call temp_interpol(field1(1),field1(2),output)
+    case('QV','qv')
+      if (ngrid.le.0) then
+        call bilin_spatial_interpol(qv,field1,induv,dz1out,dz2out,nzmax)
+      else
+        call bilin_spatial_interpol_nest(qvn,field1,induv,dz1out,dz2out,nzmax)
+      endif
+      call temp_interpol(field1(1),field1(2),output)
+    case('TT','tt')
+      if (ngrid.le.0) then
+        call bilin_spatial_interpol(tteta,field1,induv,dz1out,dz2out,nzmax)
+      else
+        call bilin_spatial_interpol_nest(ttetan,field1,induv,dz1out,dz2out,nzmax)
+      endif
+      call temp_interpol(field1(1),field1(2),output)
+    case('UU','uu')
+      if (ngrid.le.0) then
+        call bilin_spatial_interpol(uueta,field1,induv,dz1out,dz2out,nzmax)
+      else
+        call bilin_spatial_interpol_nest(uuetan,field1,induv,dz1out,dz2out,nzmax)
+      endif
+      call temp_interpol(field1(1),field1(2),output)
+    case('VV','vv')
+      if (ngrid.le.0) then
+        call bilin_spatial_interpol(vveta,field1,induv,dz1out,dz2out,nzmax)
+      else
+        call bilin_spatial_interpol_nest(vvetan,field1,induv,dz1out,dz2out,nzmax)
+      endif
+      call temp_interpol(field1(1),field1(2),output)
+    case('WW','ww')
+      call find_z_level_meters(real(part(j)%z))
+      call find_vert_vars(height,real(part(j)%z),indz,dz1out,dz2out,lbounds,.false.)
+      if (ngrid.le.0) then
+        call bilin_spatial_interpol(ww,field1,induv,dz1out,dz2out,nzmax)
+      else
+        call bilin_spatial_interpol_nest(wwn,field1,induv,dz1out,dz2out,nzmax)
+      endif
+      call temp_interpol(field1(1),field1(2),output)
+      dz1out = -1
+    case('RH','rh')
+      if (ngrid.le.0) then
+        call bilin_spatial_interpol(rhoeta,field1,induv,dz1out,dz2out,nzmax)
+      else
+        call bilin_spatial_interpol_nest(rhoetan,field1,induv,dz1out,dz2out,nzmax)
+      endif
+      call temp_interpol(field1(1),field1(2),output)
+  end select
+
+end subroutine interpol_partoutput_val_eta
diff --git a/src/int_interpol_partoutput_val_meter.f90 b/src/int_interpol_partoutput_val_meter.f90
new file mode 100644
index 0000000000000000000000000000000000000000..fcaa6e7cef3691c799e89b9c6f87f8cc77b57e3e
--- /dev/null
+++ b/src/int_interpol_partoutput_val_meter.f90
@@ -0,0 +1,77 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine interpol_partoutput_val_meter(fieldname,output,j)
+
+!* PRIVATE FUNCTION *
+
+  integer, intent(in)         :: j          ! particle number
+  character(2), intent(in)    :: fieldname  ! input field to interpolate over
+  real, intent(inout)         :: output
+  real                        :: field1(2)
+
+  if (int(dz1out).eq.-1) then
+    call find_z_level_meters(real(part(j)%z))
+    call find_vert_vars(height,real(part(j)%z),indz,dz1out,dz2out,lbounds,.false.)
+  endif
+
+  select case(fieldname)
+    case('PR','pr')
+      if (ngrid.le.0) then
+        call bilin_spatial_interpol(prs,field1,indz,dz1out,dz2out,nzmax)
+      else
+        call bilin_spatial_interpol_nest(prsn,field1,indz,dz1out,dz2out,nzmax)
+      endif
+      call temp_interpol(field1(1),field1(2),output)
+    case('PV','pv')
+      if (ngrid.le.0) then
+        call bilin_spatial_interpol(pv,field1,indz,dz1out,dz2out,nzmax)
+      else
+        call bilin_spatial_interpol_nest(pvn,field1,indz,dz1out,dz2out,nzmax)
+      endif
+      call temp_interpol(field1(1),field1(2),output)
+    case('QV','qv')
+      if (ngrid.le.0) then
+        call bilin_spatial_interpol(qv,field1,indz,dz1out,dz2out,nzmax)
+      else
+        call bilin_spatial_interpol_nest(qvn,field1,indz,dz1out,dz2out,nzmax)
+      endif
+      call temp_interpol(field1(1),field1(2),output)
+    case('TT','tt')
+      if (ngrid.le.0) then
+        call bilin_spatial_interpol(tt,field1,indz,dz1out,dz2out,nzmax)
+      else
+        call bilin_spatial_interpol_nest(ttn,field1,indz,dz1out,dz2out,nzmax)
+      endif
+      call temp_interpol(field1(1),field1(2),output)
+    case('UU','uu')
+      if (ngrid.le.0) then
+        call bilin_spatial_interpol(uu,field1,indz,dz1out,dz2out,nzmax)
+      else
+        call bilin_spatial_interpol_nest(uun,field1,indz,dz1out,dz2out,nzmax)
+      endif
+      call temp_interpol(field1(1),field1(2),output)
+    case('VV','vv')
+      if (ngrid.le.0) then
+        call bilin_spatial_interpol(vv,field1,indz,dz1out,dz2out,nzmax)
+      else
+        call bilin_spatial_interpol_nest(vvn,field1,indz,dz1out,dz2out,nzmax)
+      endif
+      call temp_interpol(field1(1),field1(2),output)
+    case('WW','ww')
+      if (ngrid.le.0) then
+        call bilin_spatial_interpol(ww,field1,indz,dz1out,dz2out,nzmax)
+      else
+        call bilin_spatial_interpol_nest(wwn,field1,indz,dz1out,dz2out,nzmax)
+      endif
+      call temp_interpol(field1(1),field1(2),output)
+    case('RH','rh')
+      if (ngrid.le.0) then
+        call bilin_spatial_interpol(rho,field1,indz,dz1out,dz2out,nzmax)
+      else
+        call bilin_spatial_interpol_nest(rhon,field1,indz,dz1out,dz2out,nzmax)
+      endif
+      call temp_interpol(field1(1),field1(2),output)
+  end select
+
+end subroutine interpol_partoutput_val_meter
diff --git a/src/int_interpol_pbl.f90 b/src/int_interpol_pbl.f90
new file mode 100644
index 0000000000000000000000000000000000000000..e1dca440689cf6fe43e643da11d0e8e07c71dc64
--- /dev/null
+++ b/src/int_interpol_pbl.f90
@@ -0,0 +1,175 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine interpol_pbl(itime,xt,yt,zt,zteta)
+  !                          i   i  i  i
+  !*****************************************************************************
+  !                                                                            *
+  !  This subroutine interpolates everything that is needed for calculating the*
+  !  dispersion.                                                               *
+  !                                                                            *
+  !    Author: A. Stohl                                                        *
+  !                                                                            *
+  !    16 December 1997                                                        *
+  !                                                                            *
+  !  Revision March 2005 by AST : all output variables in common block cal-    *
+  !                               culation of standard deviation done in this  *
+  !                               routine rather than subroutine call in order *
+  !                               to save computation time                     *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! itime [s]          current temporal position                               *
+  ! memtime(3) [s]     times of the wind fields in memory                      *
+  ! xt,yt,zt           coordinates position for which wind data shall be       *
+  !                    culated                                                 *
+  !                                                                            *
+  ! Constants:                                                                 *
+  !                                                                            *
+  !*****************************************************************************
+
+  use turbulence_mod
+
+  integer, intent(in) :: itime
+  real, intent(in)    :: xt,yt,zt,zteta
+  integer             :: m,n,indexh
+  integer             :: iw(2),iweta(2)
+  real                :: uh1(2),vh1(2),wh1(2),wetah1(2),rho1(2),rhograd1(2)
+  real                :: dz1weta,dz2weta
+  real,parameter      :: eps=1.0e-30
+
+  ! Auxiliary variables needed for interpolation
+  real :: ust1(2),wst1(2),oli1(2),oliaux
+
+  !********************************************
+  ! Multilinear interpolation in time and space
+  !********************************************
+
+  ! ngrid and grid coordinates have already been definded, and are included
+  ! in the input (for nested: xtn,ytn; for not nested: xts,yts)
+
+  !************************************************************************
+  ! Determine the lower left corner and its distance to the current position
+  !*************************************************************************
+
+  call find_grid_distances(xt,yt)
+
+  ! Calculate variables for time interpolation
+  !*******************************************
+
+  call find_time_vars(itime)
+
+  !********************************************************
+  ! 1. Interpolate u*, w* and Obukhov length for turbulence
+  !********************************************************
+
+  ! a) Bilinear horizontal interpolation
+  if (ngrid.le.0) then ! No nest
+    do m=1,2
+      indexh=memind(m)
+      call hor_interpol(ustar,ust1(m),1,memind(m),1)
+      call hor_interpol(wstar,wst1(m),1,memind(m),1)
+      call hor_interpol(oli,oli1(m),1,memind(m),1)
+    end do
+  else ! Nest
+    do m=1,2
+      indexh=memind(m)
+      call hor_interpol_nest(ustarn,ust1(m),1,memind(m),1)
+      call hor_interpol_nest(wstarn,wst1(m),1,memind(m),1)
+      call hor_interpol_nest(olin,oli1(m),1,memind(m),1)
+    end do
+  endif
+
+  ! b) Temporal interpolation
+  call temp_interpol(ust1(1),ust1(2),ust)
+  call temp_interpol(wst1(1),wst1(2),wst)
+  call temp_interpol(oli1(1),oli1(2),oliaux)
+
+  if (oliaux.ne.0.) then
+    ol=1./oliaux
+  else
+    ol=99999.
+  endif
+
+  ! Within the PBL, only METER coordinates are used
+  ! with the exception of mesoscale turbulence,
+  ! which uses wsigeta computed in interpol_mesoscale
+  !**************************************************
+
+  ! Determine the level below the current position
+  !***********************************************
+  call find_z_level_meters(zt)
+
+  iw(:)=(/ indz, indzp /)
+
+  ! w(eta) velocities are necessary for the Petterssen correction
+  !**************************************************************
+  if (wind_coord_type.eq.'ETA') then
+    call find_z_level_eta(zteta)
+    iweta(:)=(/ indzeta, indzpeta /)
+  endif
+
+  !**************************************
+  ! 1.) Bilinear horizontal interpolation
+  ! 2.) Temporal interpolation (linear)
+  !**************************************
+
+  ! Loop over 2 time steps and indz levels
+  !***************************************
+  if (ngrid.le.0) then ! No nest
+    do n=1,2
+      do m=1,2
+        call hor_interpol(ww,wh1(m),iw(n),memind(m),nzmax)
+        if (wind_coord_type.eq.'ETA') &
+          call hor_interpol(wweta,wetah1(m),iweta(n),memind(m),nzmax)
+        call hor_interpol(rho,rho1(m),iw(n),memind(m),nzmax)
+        call hor_interpol(drhodz,rhograd1(m),iw(n),memind(m),nzmax)
+        if (ngrid.lt.0) then
+          call hor_interpol(uupol,uh1(m),iw(n),memind(m),nzmax)
+          call hor_interpol(vvpol,vh1(m),iw(n),memind(m),nzmax)
+        else
+          call hor_interpol(uu,uh1(m),iw(n),memind(m),nzmax)
+          call hor_interpol(vv,vh1(m),iw(n),memind(m),nzmax)
+        endif
+      end do
+      call temp_interpol(wh1(1),wh1(2),wprof(iw(n)))
+      if (wind_coord_type.eq.'ETA') &
+        call temp_interpol(wetah1(1),wetah1(2),wprofeta(iweta(n)))
+      call temp_interpol(uh1(1),uh1(2),uprof(iw(n)))
+      call temp_interpol(vh1(1),vh1(2),vprof(iw(n)))
+      call temp_interpol(rho1(1),rho1(2),rhoprof(iw(n)))
+      call temp_interpol(rhograd1(1),rhograd1(2),rhogradprof(iw(n)))
+    end do
+  else ! Nest
+    do n=1,2
+      do m=1,2
+        call hor_interpol_nest(wwn,wh1(m),iw(n),memind(m),nzmax)
+        if (wind_coord_type.eq.'ETA') &
+          call hor_interpol_nest(wwetan,wetah1(m),iweta(n),memind(m),nzmax)
+        call hor_interpol_nest(uun,uh1(m),iw(n),memind(m),nzmax)
+        call hor_interpol_nest(vvn,vh1(m),iw(n),memind(m),nzmax)
+        call hor_interpol_nest(rhon,rho1(m),iw(n),memind(m),nzmax)
+        call hor_interpol_nest(drhodzn,rhograd1(m),iw(n),memind(m),nzmax)
+      end do
+      call temp_interpol(wh1(1),wh1(2),wprof(iw(n)))
+      if (wind_coord_type.eq.'ETA') &
+        call temp_interpol(wetah1(1),wetah1(2),wprofeta(iweta(n)))
+      call temp_interpol(uh1(1),uh1(2),uprof(iw(n)))
+      call temp_interpol(vh1(1),vh1(2),vprof(iw(n)))
+      call temp_interpol(rho1(1),rho1(2),rhoprof(iw(n)))
+      call temp_interpol(rhograd1(1),rhograd1(2),rhogradprof(iw(n)))
+
+      indzindicator(iw(n))=.false.
+    end do
+  endif
+
+  ! Only necessary for the Petterssen correction
+  if (wind_coord_type.eq.'ETA') then
+    call find_vert_vars(wheight,zteta,indzeta, &
+      dz1weta,dz2weta,lbounds_w,.true.)
+    call vert_interpol(wprofeta(indzeta),wprofeta(indzpeta), &
+      dz1weta,dz2weta,weta)
+  endif
+
+end subroutine interpol_pbl
diff --git a/src/int_interpol_pbl_misslev.f90 b/src/int_interpol_pbl_misslev.f90
new file mode 100644
index 0000000000000000000000000000000000000000..6962f8d64b84af86dd433cf0d41b45f47fbd3e1d
--- /dev/null
+++ b/src/int_interpol_pbl_misslev.f90
@@ -0,0 +1,76 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine interpol_pbl_misslev
+
+  !*****************************************************************************
+  !                                                                            *
+  !  This subroutine interpolates u,v,w, density and density gradients.        *
+  !                                                                            *
+  !    Author: A. Stohl                                                        *
+  !                                                                            *
+  !    16 December 1997                                                        *
+  !    Update: 2 March 1999                                                    *
+  !                                                                            *
+  !  Revision March 2005 by AST : all output variables in common block cal-    *
+  !                               culation of standard deviation done in this  *
+  !                               routine rather than subroutine call in order *
+  !                               to save computation time                     *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! n                  level                                                   *
+  !                                                                            *
+  ! Constants:                                                                 *
+  !                                                                            *
+  !*****************************************************************************
+
+  real                :: uh1(2),vh1(2),wh1(2),rho1(2),rhograd1(2)
+  integer             :: m,n,iw(2)
+
+  ! Within the PBL, only METER coordinates are used
+  ! with the exception of mesoscale turbulence,
+  ! which uses wsigeta computed in interpol_mesoscale
+  !**************************************************
+
+  !********************************************
+  ! Multilinear interpolation in time and space
+  !********************************************
+
+  iw(:)=(/ indz, indzp /)
+  do n=1,2
+    if (indzindicator(iw(n))) then
+      if (ngrid.le.0) then ! No nest
+        do m=1,2
+          call hor_interpol(ww,wh1(m),iw(n),memind(m),nzmax)
+          call hor_interpol(rho,rho1(m),iw(n),memind(m),nzmax)
+          call hor_interpol(drhodz,rhograd1(m),iw(n),memind(m),nzmax)
+          if (ngrid.lt.0) then
+            call hor_interpol(uupol,uh1(m),iw(n),memind(m),nzmax)
+            call hor_interpol(vvpol,vh1(m),iw(n),memind(m),nzmax)
+          else
+            call hor_interpol(uu,uh1(m),iw(n),memind(m),nzmax)
+            call hor_interpol(vv,vh1(m),iw(n),memind(m),nzmax)
+          endif
+        end do
+      else ! Nest
+        do m=1,2
+          call hor_interpol_nest(wwn,wh1(m),iw(n),memind(m),nzmax)
+          call hor_interpol_nest(uun,uh1(m),iw(n),memind(m),nzmax)
+          call hor_interpol_nest(vvn,vh1(m),iw(n),memind(m),nzmax)
+          call hor_interpol_nest(rhon,rho1(m),iw(n),memind(m),nzmax)
+          call hor_interpol_nest(drhodzn,rhograd1(m),iw(n),memind(m),nzmax)
+        end do
+      endif
+      call temp_interpol(wh1(1),wh1(2),wprof(iw(n)))
+      call temp_interpol(uh1(1),uh1(2),uprof(iw(n)))
+      call temp_interpol(vh1(1),vh1(2),vprof(iw(n)))
+      call temp_interpol(rho1(1),rho1(2),rhoprof(iw(n)))
+      call temp_interpol(rhograd1(1),rhograd1(2),rhogradprof(iw(n)))
+
+      indzindicator(iw(n))=.false.
+    endif
+  end do
+
+end subroutine interpol_pbl_misslev
diff --git a/src/int_interpol_pbl_short.f90 b/src/int_interpol_pbl_short.f90
new file mode 100644
index 0000000000000000000000000000000000000000..451f2a376c326a20739d06f16c3a94dcc5ee083e
--- /dev/null
+++ b/src/int_interpol_pbl_short.f90
@@ -0,0 +1,18 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine interpol_pbl_short(zt,rhoa,rhograd)
+
+  real, intent(in)    :: zt
+  real, intent(inout) :: rhoa,rhograd
+  real                :: dz1,dz2
+
+  call find_vert_vars(height,zt,indz,dz1,dz2,lbounds,.false.)
+
+  call vert_interpol(wprof(indz),wprof(indzp),dz1,dz2,w)
+  call vert_interpol(uprof(indz),uprof(indzp),dz1,dz2,u)
+  call vert_interpol(vprof(indz),vprof(indzp),dz1,dz2,v)
+  call vert_interpol(rhoprof(indz),rhoprof(indzp),dz1,dz2,rhoa)
+  call vert_interpol(rhogradprof(indz),rhogradprof(indzp),dz1,dz2,rhograd)
+
+end subroutine interpol_pbl_short
diff --git a/src/int_interpol_wind.f90 b/src/int_interpol_wind.f90
new file mode 100644
index 0000000000000000000000000000000000000000..39d147c80041964c3f8ece164132f77dbb150fd2
--- /dev/null
+++ b/src/int_interpol_wind.f90
@@ -0,0 +1,82 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine interpol_wind(itime,xt,yt,zt,zteta,pp)
+  !                           i   i  i  i
+
+  !*****************************************************************************
+  !                                                                            *
+  !  This subroutine interpolates the wind data to current trajectory position.*
+  !                                                                            *
+  !    Author: A. Stohl                                                        *
+  !                                                                            *
+  !    16 December 1997                                                        *
+  !                                                                            *
+  !  Revision March 2005 by AST : all output variables in common block cal-    *
+  !                               culation of standard deviation done in this  *
+  !                               routine rather than subroutine call in order *
+  !                               to save computation time                     *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! u,v,w              wind components                                         *
+  ! itime [s]          current temporal position                               *
+  ! memtime(3) [s]     times of the wind fields in memory                      *
+  ! xt,yt,zt           coordinates position for which wind data shall be       *
+  !                    calculated                                              *
+  !                                                                            *
+  ! Constants:                                                                 *
+  !                                                                            *
+  !*****************************************************************************
+
+  integer, intent(in) :: itime,pp
+  real, intent(in)    :: xt,yt,zt,zteta
+  integer             :: iw(2),iuv(2),iweta(2)
+
+
+  ! Where in the grid? Stereographic (ngrid<0) or nested (ngrid>0)
+  !***************************************************************
+  call find_ngrid(xt,yt)
+
+  call find_grid_indices(xt,yt)
+  ! ! Multilinear interpolation in time and space
+  ! !********************************************
+
+  ! Determine the lower left corner and its distance to the current position
+  !*************************************************************************
+  call find_grid_distances(xt,yt)
+
+  ! Calculate variables for time interpolation
+  !*******************************************
+  call find_time_vars(itime)
+
+  ! Interpolate over the windfields depending on the prefered
+  ! coordinate system
+  !**********************************************************
+  select case (wind_coord_type)
+    case ('ETA')
+      ! Same for eta coordinates
+      !*************************
+      call find_z_level_eta(zteta)
+
+      iuv(:)  = (/ induv, indpuv /)
+      iweta(:)= (/ indzeta, indzpeta /)
+      call interpol_wind_eta(zteta,iuv,iweta)
+      !call stdev_wind_eta(iw,iuv,iweta)
+    case ('METER')
+      ! Determine the level below the current position for u,v
+      !*******************************************************
+      call find_z_level_meters(zt)
+
+      iw(:)=(/ indz, indzp /)
+      call interpol_wind_meter(zt,iw)
+      !call stdev_wind_meter(iw)
+
+    case default
+      write(*,*) 'ERROR: wind_coord_type is not allowed ', wind_coord_type
+      write(*,*) 'Choose ETA or METER.'
+      stop
+  end select
+
+end subroutine interpol_wind
diff --git a/src/int_interpol_wind_eta.f90 b/src/int_interpol_wind_eta.f90
new file mode 100644
index 0000000000000000000000000000000000000000..9c469812c91f87e3775be3853675421ca78973d0
--- /dev/null
+++ b/src/int_interpol_wind_eta.f90
@@ -0,0 +1,64 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine interpol_wind_eta(zteta,iuv,iweta)
+
+!* PRIVATE FUNCTION *
+
+  real, intent(in)    :: zteta
+  integer,intent(in)  :: iuv(2),iweta(2)
+  integer             :: n,m
+  real                :: uh(2),vh(2),wetah(2),uh1(2),vh1(2),wetah1(2)
+  real                :: dz1uv,dz2uv,dz1weta,dz2weta
+
+  !**********************************************************************
+  ! 1.) Bilinear horizontal interpolation
+  ! This has to be done separately for 6 fields (Temporal(2)*Vertical(3))
+  !**********************************************************************
+
+  ! Vertical distance to the level below and above current position
+  !****************************************************************
+  call find_vert_vars(uvheight,zteta,induv,dz1uv,dz2uv,lbounds_uv,.false.)
+  call find_vert_vars(wheight,zteta,indzeta,dz1weta,dz2weta,lbounds_w,.true.)
+
+  ! Loop over 2 time steps and 2 levels
+  !************************************
+  if (ngrid.le.0) then ! No nest
+    do m=1,2
+      do n=1,2
+        call hor_interpol(wweta,wetah1(n),iweta(n),memind(m),nzmax)
+        if (ngrid.lt.0) then
+          call hor_interpol(uupoleta,uh1(n),iuv(n),memind(m),nzmax)
+          call hor_interpol(vvpoleta,vh1(n),iuv(n),memind(m),nzmax)
+        else
+          call hor_interpol(uueta,uh1(n),iuv(n),memind(m),nzmax)
+          call hor_interpol(vveta,vh1(n),iuv(n),memind(m),nzmax)
+        endif
+      end do
+      call vert_interpol(uh1(1),uh1(2),dz1uv,dz2uv,uh(m))
+      call vert_interpol(vh1(1),vh1(2),dz1uv,dz2uv,vh(m))
+      call vert_interpol(wetah1(1),wetah1(2),dz1weta,dz2weta,wetah(m))
+    end do
+  else ! Nest
+    do m=1,2
+      do n=1,2
+
+        ! wetah1(n) = p1*wwetan(ix ,jy ,iweta(n),memind(m),ngrid) &
+        !           + p2*wwetan(ixp,jy ,iweta(n),memind(m),ngrid) &
+        !           + p3*wwetan(ix ,jyp,iweta(n),memind(m),ngrid) &
+        !           + p4*wwetan(ixp,jyp,iweta(n),memind(m),ngrid)
+        call hor_interpol_nest(wwetan,wetah1(n),iweta(n),memind(m),nzmax)
+        call hor_interpol_nest(uuetan,uh1(n),iuv(n),memind(m),nzmax)
+        call hor_interpol_nest(vvetan,vh1(n),iuv(n),memind(m),nzmax)
+      end do
+      call vert_interpol(uh1(1),uh1(2),dz1uv,dz2uv,uh(m))
+      call vert_interpol(vh1(1),vh1(2),dz1uv,dz2uv,vh(m))
+      call vert_interpol(wetah1(1),wetah1(2),dz1weta,dz2weta,wetah(m))
+    end do
+  endif
+
+  call temp_interpol(uh(1),uh(2),u)
+  call temp_interpol(vh(1),vh(2),v)
+  call temp_interpol(wetah(1),wetah(2),weta)
+
+end subroutine interpol_wind_eta
diff --git a/src/int_interpol_wind_meter.f90 b/src/int_interpol_wind_meter.f90
new file mode 100644
index 0000000000000000000000000000000000000000..bea88b8bc4b086b006bdefc07510b1e554f1210a
--- /dev/null
+++ b/src/int_interpol_wind_meter.f90
@@ -0,0 +1,58 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine interpol_wind_meter(zt,iw)
+
+!* PRIVATE FUNCTION *
+
+  real, intent(in)    :: zt
+  integer,intent(in)  :: iw(2)
+  integer             :: n,m
+  real                :: uh(2),vh(2),wh(2),uh1(2),vh1(2),wh1(2)
+  real                :: dz1w,dz2w
+
+  !**********************************************************************
+  ! 1.) Bilinear horizontal interpolation
+  ! This has to be done separately for 6 fields (Temporal(2)*Vertical(3))
+  !**********************************************************************
+
+  ! Vertical distance to the level below and above current position
+  !****************************************************************
+  call find_vert_vars(height,zt,indz,dz1w,dz2w,lbounds,.false.)
+
+  ! Loop over 2 time steps and 2 levels
+  !************************************
+  if (ngrid.le.0) then ! No nest
+    do m=1,2
+      do n=1,2
+        call hor_interpol(ww,wh1(n),iw(n),memind(m),nzmax)
+        if (ngrid.lt.0) then
+          call hor_interpol(uupol,uh1(n),iw(n),memind(m),nzmax)
+          call hor_interpol(vvpol,vh1(n),iw(n),memind(m),nzmax)
+        else
+          call hor_interpol(uu,uh1(n),iw(n),memind(m),nzmax)
+          call hor_interpol(vv,vh1(n),iw(n),memind(m),nzmax)
+        endif
+      end do
+      call vert_interpol(wh1(1),wh1(2),dz1w,dz2w,wh(m))
+      call vert_interpol(uh1(1),uh1(2),dz1w,dz2w,uh(m))
+      call vert_interpol(vh1(1),vh1(2),dz1w,dz2w,vh(m))
+    end do
+  else ! Nest
+    do m=1,2
+      do n=1,2
+        call hor_interpol_nest(wwn,wh1(n),iw(n),memind(m),nzmax)
+        call hor_interpol_nest(uun,uh1(n),iw(n),memind(m),nzmax)
+        call hor_interpol_nest(vvn,vh1(n),iw(n),memind(m),nzmax)
+      end do
+      call vert_interpol(wh1(1),wh1(2),dz1w,dz2w,wh(m))
+      call vert_interpol(uh1(1),uh1(2),dz1w,dz2w,uh(m))
+      call vert_interpol(vh1(1),vh1(2),dz1w,dz2w,vh(m))
+    end do
+  endif
+
+  call temp_interpol(wh(1),wh(2),w)
+  call temp_interpol(uh(1),uh(2),u)
+  call temp_interpol(vh(1),vh(2),v)
+
+end subroutine interpol_wind_meter
diff --git a/src/int_interpol_wind_short.f90 b/src/int_interpol_wind_short.f90
new file mode 100644
index 0000000000000000000000000000000000000000..0eb2833e18dc9e3ecc4c4e2ba3f2265b7fc0d402
--- /dev/null
+++ b/src/int_interpol_wind_short.f90
@@ -0,0 +1,76 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine interpol_wind_short(itime,xt,yt,zt,zteta)
+!                                i   i  i  i  i
+
+  !*****************************************************************************
+  !                                                                            *
+  !  This subroutine interpolates the wind data to current trajectory position.*
+  !                                                                            *
+  !    Author: A. Stohl                                                        *
+  !                                                                            *
+  !    16 December 1997                                                        *
+  !                                                                            *
+  !  Revision March 2005 by AST : all output variables in common block         *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! u,v,w              wind components                                         *
+  ! itime [s]          current temporal position                               *
+  ! memtime(3) [s]     times of the wind fields in memory                      *
+  ! xt,yt,zt           coordinates position for which wind data shall be       *
+  !                    calculated                                              *
+  !                                                                            *
+  ! Constants:                                                                 *
+  !                                                                            *
+  !*****************************************************************************
+
+  integer, intent(in) :: itime
+  real, intent(in) :: xt,yt,zt,zteta
+  integer             :: iw(2),iuv(2),iweta(2)
+
+  !********************************************
+  ! Multilinear interpolation in time and space
+  !********************************************
+
+  ! Where in the grid? Stereographic (ngrid<0) or nested (ngrid>0)
+  !***************************************************************
+  call find_ngrid(xt,yt)
+  call find_grid_indices(xt,yt)
+  call find_grid_distances(xt,yt)
+
+  ! Calculate variables for time interpolation
+  !*******************************************
+  call find_time_vars(itime)
+
+  ! Interpolate over the windfields depending on the prefered
+  ! coordinate system
+  !**********************************************************
+  select case (wind_coord_type)
+    case ('ETA')
+      ! Determine the level below the current position for eta coordinates
+      !*******************************************************************
+      call find_z_level_eta(zteta)
+
+      iuv(:)=(/ induv, indpuv /)
+      iweta(:)=(/ indzeta, indzpeta /)
+      ! Interpolate the u, v, weta windfields
+      !**************************************
+      call interpol_wind_eta(zteta,iuv,iweta)
+    case ('METER')
+
+      ! Determine the level below the current position for u,v
+      !*******************************************************
+      call find_z_level_meters(zt)
+
+      iw(:)=(/ indz, indzp /)
+      call interpol_wind_meter(zt,iw)
+    case default
+      write(*,*) 'ERROR: wind_coord_type is not allowed ', wind_coord_type
+      write(*,*) 'Choose ETA or METER.'
+      stop
+  end select
+
+end subroutine interpol_wind_short
diff --git a/src/int_stdev.f90 b/src/int_stdev.f90
new file mode 100644
index 0000000000000000000000000000000000000000..9545ff70ebff5dabe4048d310b6dc5c4d979f413
--- /dev/null
+++ b/src/int_stdev.f90
@@ -0,0 +1,19 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine stdev(sl,sq,divisor,output)
+
+  real, intent(in) :: sl,sq,divisor
+  real, intent(out) :: output
+  real :: xaux
+  real,parameter      :: eps=1.0e-30
+
+  xaux= sq - sl*sl/divisor
+
+  if (xaux.lt.eps) then
+    output=0.
+  else
+    output=sqrt(xaux/(divisor-1.))
+  endif
+
+end subroutine stdev
diff --git a/src/int_stdev_eta.f90 b/src/int_stdev_eta.f90
new file mode 100644
index 0000000000000000000000000000000000000000..ec66fea14393ba54b9919542ad8113f78c962faa
--- /dev/null
+++ b/src/int_stdev_eta.f90
@@ -0,0 +1,58 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine stdev_eta(iw,iuv,iweta)
+
+!* PRIVATE FUNCTION *
+
+  ! Standard deviation of surrounding grid points
+  ! Only used in mesoscale turbulence calculations
+  !***********************************************
+
+  integer,intent(in)  :: iw(2),iuv(2),iweta(2)
+  real :: wsl,wsq,wxaux,usl,usq,uxaux,vsl,vsq,vxaux,wetasl,wetasq,wetaxaux
+  integer             :: n,m
+  real,parameter      :: eps=1.0e-30
+
+  ! Standard deviations
+  !********************
+  wsl=0.
+  wsq=0.
+  usl=0.
+  usq=0.
+  vsl=0.
+  vsq=0.
+  wetasl=0.
+  wetasq=0.
+
+  if (ngrid.le.0) then ! No nest
+    do m=1,2
+      do n=1,2
+        call compute_sl_sq(ww,wsl,wsq,iw(n),memind(m),nzmax)
+        call compute_sl_sq(wweta,wetasl,wetasq,iweta(n),memind(m),nzmax)
+        if (ngrid.lt.0) then
+          call compute_sl_sq(uupoleta,usl,usq,iuv(n),memind(m),nzmax)
+          call compute_sl_sq(vvpoleta,vsl,vsq,iuv(n),memind(m),nzmax)
+        else
+          call compute_sl_sq(uueta,usl,usq,iuv(n),memind(m),nzmax)
+          call compute_sl_sq(vveta,vsl,vsq,iuv(n),memind(m),nzmax)
+        endif
+      end do
+    end do
+  else ! Nest
+    do m=1,2
+      do n=1,2
+        call compute_sl_sq_nest(wwn,wsl,wsq,iw(n),memind(m),nzmax)
+        call compute_sl_sq_nest(wwetan,wetasl,wetasq,iweta(n),memind(m),nzmax)
+        call compute_sl_sq_nest(uuetan,usl,usq,iuv(n),memind(m),nzmax)
+        call compute_sl_sq_nest(vvetan,vsl,vsq,iuv(n),memind(m),nzmax)
+      end do
+    end do
+  endif
+
+  call stdev(wsl,wsq,16.,wsig)
+  call stdev(usl,usq,16.,usig)
+  call stdev(vsl,vsq,16.,vsig)
+  call stdev(wetasl,wetasq,16.,wsigeta)
+
+end subroutine stdev_eta
diff --git a/src/int_stdev_meter.f90 b/src/int_stdev_meter.f90
new file mode 100644
index 0000000000000000000000000000000000000000..369d174fd987121da59b2f354bf4b589a12db32c
--- /dev/null
+++ b/src/int_stdev_meter.f90
@@ -0,0 +1,53 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine stdev_meter(iw)
+
+!* PRIVATE FUNCTION *
+
+  ! Standard deviation of surrounding grid points
+  ! Only used in mesoscale turbulence calculations
+  !***********************************************
+
+  integer,intent(in)  :: iw(2)
+  real                :: wsl,wsq,wxaux,usl,usq,uxaux,vsl,vsq,vxaux
+  integer             :: n,m
+  real,parameter      :: eps=1.0e-30
+
+  ! Standard deviations
+  !********************
+  wsl=0.
+  wsq=0.
+  usl=0.
+  usq=0.
+  vsl=0.
+  vsq=0.
+
+  if (ngrid.le.0) then ! No nest
+    do m=1,2
+      do n=1,2
+        call compute_sl_sq(ww,wsl,wsq,iw(n),memind(m),nzmax)
+        if (ngrid.lt.0) then
+          call compute_sl_sq(uupol,usl,usq,iw(n),memind(m),nzmax)
+          call compute_sl_sq(vvpol,vsl,vsq,iw(n),memind(m),nzmax)
+        else
+          call compute_sl_sq(uu,usl,usq,iw(n),memind(m),nzmax)
+          call compute_sl_sq(vv,vsl,vsq,iw(n),memind(m),nzmax)
+        endif
+      end do
+    end do
+  else ! Nest
+    do m=1,2
+      do n=1,2
+        call compute_sl_sq_nest(wwn,wsl,wsq,iw(n),memind(m),nzmax)
+        call compute_sl_sq_nest(uun,usl,usq,iw(n),memind(m),nzmax)
+        call compute_sl_sq_nest(vvn,vsl,vsq,iw(n),memind(m),nzmax)
+      end do
+    end do
+  endif
+
+  call stdev(wsl,wsq,16.,wsig)
+  call stdev(usl,usq,16.,usig)
+  call stdev(vsl,vsq,16.,vsig)
+
+end subroutine stdev_meter
diff --git a/src/int_temp_interpol.f90 b/src/int_temp_interpol.f90
new file mode 100644
index 0000000000000000000000000000000000000000..270b291610e05faf08d732d03eb0d7d3e262f15f
--- /dev/null
+++ b/src/int_temp_interpol.f90
@@ -0,0 +1,11 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine temp_interpol(time1,time2,output)
+
+  real, intent(in)    :: time1,time2     ! input data at two timesteps
+  real, intent(inout) :: output          ! interpolated data
+
+  output= (time1*dt2 + time2*dt1) * dtt
+
+end subroutine temp_interpol
diff --git a/src/int_vert_interpol.f90 b/src/int_vert_interpol.f90
new file mode 100644
index 0000000000000000000000000000000000000000..de3a8c3f62a1c658f8d5cc4f35b133c99925852c
--- /dev/null
+++ b/src/int_vert_interpol.f90
@@ -0,0 +1,13 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine vert_interpol(input1,input2,dz1,dz2,output)
+
+  real, intent(in)    :: input1,input2   ! input data at two vertical levels,
+                                         ! 1 being closer to ground
+  real, intent(in)    :: dz1,dz2         ! logarithmic interpolation values
+  real, intent(inout) :: output          ! interpolated data
+
+  output = input1*dz2 + input2*dz1 ! input1**dz2 * input2**dz1
+
+end subroutine vert_interpol
diff --git a/src/interpol_mod.f90 b/src/interpol_mod.f90
index 55e35ec2cd3df655e870b0602ffc995028c5d48d..53b1ee26154eec4bf724f23abdeeab489283e820 100644
--- a/src/interpol_mod.f90
+++ b/src/interpol_mod.f90
@@ -39,7 +39,7 @@ module interpol_mod
   interface hor_interpol
     procedure hor_interpol_4d,hor_interpol_2d
   end interface hor_interpol
-  
+
   interface hor_interpol_nest
     procedure hor_interpol_4d_nest,hor_interpol_2d_nest
   end interface hor_interpol_nest
@@ -58,1548 +58,96 @@ module interpol_mod
 
 contains
 
-subroutine alloc_interpol
-  ! allocate(uprof(nzmax),vprof(nzmax),wprof(nzmax),wprofeta(nzmax),      &
-  !   usigprof(nzmax),vsigprof(nzmax),wsigprof(nzmax),wsigprofeta(nzmax), &
-  !   rhoprof(nzmax),rhogradprof(nzmax),indzindicator(nzmax))
-end subroutine alloc_interpol
-
-subroutine dealloc_interpol
-  ! deallocate(uprof,vprof,wprof,wprofeta,      &
-  !   usigprof,vsigprof,wsigprof,wsigprofeta, &
-  !   rhoprof,rhogradprof,indzindicator)
-end subroutine dealloc_interpol
-
-subroutine init_interpol(itime,xt,yt,zt,zteta)
-
-  ! This routine initialises all important values used in the interpol module
-  ! This includes:
-  ! - The current grid number in which the particle is positioned
-  ! - The interpolation fractions of the grid (x,y,z) and of time
-
-  integer, intent(in) :: itime             ! time step
-  real, intent(in)    :: xt,yt             ! particle positions
-  real, intent(in)    :: zt                ! height in meters
-  real, intent(in)    :: zteta             ! height in eta coordinates
-
-  call find_ngrid(xt,yt)
-  call find_grid_indices(xt,yt)
-  call find_grid_distances(xt,yt)
-  call find_time_vars(itime)
-  call find_z_level(zt,zteta)
-
-end subroutine init_interpol
-
-subroutine find_grid_indices(xt,yt)
-
-  real, intent(in) :: xt,yt                 ! particle positions
-
-  if (ngrid.gt.0) then
-    xtn=(xt-xln(ngrid))*xresoln(ngrid)
-    ytn=(yt-yln(ngrid))*yresoln(ngrid)
-    ! ix=int(xtn)
-    ! jy=int(ytn)
-    ! nix=nint(xtn)
-    ! njy=nint(ytn)
-    nix=max(min(nint(xtn),nxn(ngrid)-1),0)
-    njy=max(min(nint(ytn),nyn(ngrid)-1),0)
-    ix=nix
-    jy=njy
-    ixp=ix+1
-    jyp=jy+1
-    return
-  else
-    ix=int(xt)
-    jy=int(yt)
-    nix=nint(xt)
-    njy=nint(yt)
-    ixp=ix+1
-    jyp=jy+1
-  endif
-
-  ! eso: Temporary fix for particle exactly at north pole
-  if (jyp.ge.nymax) then
-    write(*,*) 'WARNING: interpol_mod.f90 jyp >= nymax. xt,yt:',xt,yt
-    jyp=jyp-1
-  end if
-
-  if (ixp.ge.nxmax) then
-    write(*,*) 'WARNING: interpol_mod.f90 ixp >= nxmax. xt,yt:',xt,yt
-    ixp=ixp-nxmax
-  end if
-
-end subroutine find_grid_indices
-
-subroutine find_grid_distances(xt,yt)
-
-  implicit none 
-
-  real, intent(in) :: xt,yt                 ! particle positions
-
-  if (ngrid.le.0) then
-    ddx=xt-real(ix)
-    ddy=yt-real(jy)
-  else
-    ddx=xtn-real(ix)
-    ddy=ytn-real(jy)
-  endif
-  rddx=1.-ddx
-  rddy=1.-ddy
-  p1=rddx*rddy
-  p2=ddx*rddy
-  p3=rddx*ddy
-  p4=ddx*ddy
-
-end subroutine find_grid_distances
-
-subroutine find_time_vars(itime)
-
-  integer, intent(in) :: itime             ! time step
-  
-  dt1=real(itime-memtime(1))
-  dt2=real(memtime(2)-itime)
-  dtt=1./(dt1+dt2)  
-
-end subroutine find_time_vars
-
-subroutine find_z_level(zt,zteta)
-
-  real, intent(in)     :: &
-    zt,                   & ! height in meters
-    zteta                   ! height in eta
-
-  select case (wind_coord_type)
-    case('ETA')
-      call find_z_level_meters(zt)
-      call find_z_level_eta(zteta)
-    case('METER')
-      call find_z_level_meters(zt)
-    case default
-      call find_z_level_meters(zt)
-  end select
-
-end subroutine find_z_level
-
-subroutine find_z_level_meters(zt)
-
-  real, intent(in)     :: zt       ! height in meters
-  integer              :: i
-
-  indz=nz-1
-  indzp=nz
-  if (zt.le.height(1)) then
-    lbounds(1)=.true.
-    lbounds(2)=.false.
-    indz=1
-    indzp=2
-  else if (zt.ge.height(nz)) then
-    lbounds(1)=.false.
-    lbounds(2)=.true.
-  else
-    lbounds(1)=.false.
-    lbounds(2)=.false.
-    do i=2,nz
-      if (height(i).gt.zt) then
-        indz=i-1
-        indzp=i
-        exit
-      endif
-    end do
-  endif
-
-end subroutine find_z_level_meters
-
-subroutine find_z_level_eta(zteta)
-
-  real, intent(in)       :: zteta    ! height in eta coordinates
-  integer                :: i        ! loop variable
-
-  call find_z_level_eta_w(zteta)
-
-  call find_z_level_eta_uv(zteta)
-
-end subroutine find_z_level_eta
-
-subroutine find_z_level_eta_w(zteta)
-
-  real, intent(in)       :: zteta    ! height in eta coordinates
-  integer                :: i        ! loop variable
-
-  indzeta=nz-1
-  indzpeta=nz
-  ! Flag particles that are above or below bounds
-  if (zteta.ge.wheight(1)) then
-    lbounds_w(1)=.true.
-    lbounds_w(2)=.false.
-    indzeta=1
-    indzpeta=2
-  else if (zteta.le.wheight(nz)) then
-    lbounds_w(1)=.false.
-    lbounds_w(2)=.true.
-  else
-    lbounds_w(1)=.false.
-    lbounds_w(2)=.false.
-    do i=2,nz
-      if (wheight(i).lt.zteta) then
-        indzeta=i-1
-        indzpeta=i
-        exit
-      endif
-    end do
-  endif
-
-end subroutine find_z_level_eta_w
-
-subroutine find_z_level_eta_uv(zteta)
-
-  real, intent(in)       :: zteta    ! height in eta coordinates
-  integer                :: i        ! loop variable
-
-  induv=nz-1
-  indpuv=nz
-  if (zteta.gt.uvheight(1)) then
-    lbounds_uv(1)=.true.
-    lbounds_uv(2)=.false.
-    induv=1 
-    indpuv=2
-  else if (zteta.lt.uvheight(nz)) then
-    lbounds_uv(1)=.false.
-    lbounds_uv(2)=.true.
-  else
-    lbounds_uv(1)=.false.
-    lbounds_uv(2)=.false.
-    do i=2,nz
-      if (uvheight(i).lt.zteta) then
-        induv=i-1
-        indpuv=i
-        exit
-      endif
-    end do
-  endif
-
-end subroutine find_z_level_eta_uv
-
-subroutine find_vert_vars(vertlevels,zpos,zlevel,dz1,dz2,bounds,wlevel)
-
-  !*****************************************************************************
-  !                                                                            *
-  ! This subroutine computes the vertical interpolation variables              *
-  ! logarithmically, unless log_interpol=.false. in the par_mod                *
-  !                                                                            *
-  ! Author: L. Bakels                                                          *
-  !*****************************************************************************
-
-  real, intent(in)    :: vertlevels(:)    ! vertical levels in coordinate system
-  real, intent(in)    :: zpos             ! verticle particle position
-  integer, intent(in) :: zlevel           ! vertical level of interest
-  logical, intent(in) :: bounds(2),wlevel ! flag marking if particles are
-                                          ! outside bounds  
-  real, intent(inout) :: dz1,dz2          ! fractional distance to point 1 
-                                          ! (closer to ground) and 2
-  real                :: dz,dh1,dh,pfact
-  real                :: psint1(2),psint,pr1,pr2,pr_test 
-                                          ! pressure of encompassing levels
-  integer             :: m
-
-  ! Only do logarithmic interpolation when using ETA coordinates, since the
-  ! levels are following pressure, while METER levels are linear.
-  !##############################################################
-
-  if (.not. log_interpol) then
-    call find_vert_vars_lin(vertlevels,zpos,zlevel,dz1,dz2,bounds,wlevel)
-    return
-  endif
-  
-  ! To check if taking the logarithm is safe
-  if (wlevel) then
-    pr_test=akm(zlevel+1)+bkm(zlevel+1)
-  else
-    pr_test=akz(zlevel+1)+bkz(zlevel+1)
-  endif
-
-  ! If the particle is below bounds (bounds(1)==.true.):
-  if (bounds(1)) then
-    dz1=0.
-    dz2=1.
-  ! If above bounds (bounds(2)==.true.):
-  else if (bounds(2)) then
-    dz1=1.
-    dz2=0.
-
-  ! Instead of the linear z variables, we need the ones that correspond to 
-  ! the pressure of the height of the particle in relation to the model levels
-  !***************************************************************************
-  else if (pr_test.eq.0) then
-    dz=1./(vertlevels(zlevel+1)-vertlevels(zlevel))
-    dz1=(zpos-vertlevels(zlevel))*dz
-    dz2=(vertlevels(zlevel+1)-zpos)*dz
-  else
-    if (ngrid.le.0) then
-      do m=1,2
-        call hor_interpol(ps,psint1(m),1,memind(m),1)
-      end do
-    else
-      do m=1,2
-        call hor_interpol_nest(psn,psint1(m),1,memind(m),1)
-      end do
-    endif
-    call temp_interpol(psint1(1),psint1(2),psint)
-    dh = vertlevels(zlevel+1)-vertlevels(zlevel)
-    dh1 = zpos - vertlevels(zlevel)
-    if (wlevel) then
-      pr1=akm(zlevel) + bkm(zlevel)*psint
-      pr2=akm(zlevel+1) + bkm(zlevel+1)*psint
-    else
-      pr1=akz(zlevel) + bkz(zlevel)*psint
-      pr2=akz(zlevel+1) + bkz(zlevel+1)*psint
-    endif
-    pfact = log(pr2/pr1)*dh1/dh  
-    dz = 1./(pr2-pr1)
-    dz1 = pr1*(exp(pfact)-1.)*dz 
-    dz2 = 1.-dz1
-  endif
-  ! else if ((vertlevels(zlevel).eq.0).or.(vertlevels(zlevel+1).eq.0)) then
-  !   ! Linear interpolation for bottom or top layer is zero
-  !   dz=1./(vertlevels(zlevel+1)-vertlevels(zlevel))
-  !   dz1=(zpos-vertlevels(zlevel))*dz
-  !   dz2=(vertlevels(zlevel+1)-zpos)*dz
-  ! else 
-  !   ! Logaritmic interpolation
-  !   dz=1./(log(vertlevels(zlevel+1))-log(vertlevels(zlevel)))
-  !   dz1=(log(zpos)-log(vertlevels(zlevel)))*dz
-  !   dz2=(log(vertlevels(zlevel+1))-log(zpos))*dz
-  ! endif
-
-end subroutine find_vert_vars
-
-subroutine find_vert_vars_lin(vertlevels,zpos,zlevel,dz1,dz2,bounds,wlevel)
-
-  real, intent(in)    :: vertlevels(:)   ! vertical levels in coordinate system
-  real, intent(in)    :: zpos            ! verticle particle position
-  integer, intent(in) :: zlevel          ! vertical level of interest
-  logical, intent(in) :: bounds(2),wlevel! flag marking if particles are outside
-                                         ! bounds  
-  real, intent(inout) :: dz1,dz2         ! fractional distance to point 1
-                                         ! (closer to ground) and 2
-  real                :: dz,dh1,dh,pfact
-  real :: psint1(2),psint,pr1,pr2,temp   ! pressure of encompassing levels
-
-  ! If the particle is below bounds (bounds(1)==.true.):
-  if (bounds(1)) then
-    dz1=0.
-    dz2=1.
-  ! If above bounds (bounds(2)==.true.):
-  else if (bounds(2)) then
-    dz1=1.
-    dz2=0.
-  else
-    dz=1./(vertlevels(zlevel+1)-vertlevels(zlevel))
-    dz1=(zpos-vertlevels(zlevel))*dz
-    dz2=(vertlevels(zlevel+1)-zpos)*dz
-  endif
-
-end subroutine find_vert_vars_lin
-
-subroutine find_ngrid_dp(xt,yt)
-
-  real eps           
-  real(kind=dp), intent(in) :: xt,yt ! particle positions on grid
-  integer :: j
-
-  eps=nxmax/3.e5
-  if (nglobal.and.(real(yt).gt.switchnorthg)) then
-    ngrid=-1
-  else if (sglobal.and.(real(yt).lt.switchsouthg)) then
-    ngrid=-2
-  else
-    ngrid=0
-    ! Temporary fix for nested layer edges: replaced eps with dxn and dyn (LB)
-    do j=numbnests,1,-1
-      if (real(xt).gt.xln(j)+dxn(j) .and. real(xt).lt.xrn(j)-dxn(j) .and. &
-          real(yt).gt.yln(j)+dyn(j) .and. real(yt).lt.yrn(j)-dyn(j)) then
-        ngrid=j
-        exit
-      endif
-    end do
-  endif
-  
-end subroutine find_ngrid_dp
+#include "int_alloc_interpol.f90"
 
-subroutine find_ngrid_sp(xt,yt)
+#include "int_dealloc_interpol.f90"
 
-  real :: eps           
-  real, intent(in) :: xt,yt ! particle positions on grid
-  integer :: j
+#include "int_init_interpol.f90"
 
-  eps=nxmax/3.e5
-  if (nglobal .and. yt.gt.switchnorthg) then
-    ngrid=-1
-  else if (sglobal .and. yt.lt.switchsouthg) then
-    ngrid=-2
-  else
-    ngrid=0
-    ! Temporary fix for nested layer edges: replaced eps with dxn and dyn (LB)
-    do j=numbnests,1,-1
-      if (xt.gt.xln(j)+dxn(j) .and. xt.lt.xrn(j)-dxn(j) .and. &
-          yt.gt.yln(j)+dyn(j) .and. yt.lt.yrn(j)-dyn(j)) then
-        ngrid=j
-        exit
-      endif
-    end do
-  endif
+#include "int_find_grid_indices.f90"
 
-end subroutine find_ngrid_sp
+#include "int_find_grid_distances.f90"
 
-subroutine hor_interpol_4d(field,output,zlevel,indexh,ztot)
+#include "int_find_time_vars.f90"
 
-  integer, intent(in) :: zlevel,ztot,indexh   ! interpolation z level, z
-  real, intent(in)    :: field(0:nxmax-1,0:nymax-1,ztot,numwfmem) 
-   ! input field to interpolate
-  real, intent(inout) :: output  ! interpolated values
+#include "int_find_z_level.f90"
 
-  output=p1*field(ix ,jy ,zlevel,indexh) &
-       + p2*field(ixp,jy ,zlevel,indexh) &
-       + p3*field(ix ,jyp,zlevel,indexh) &
-       + p4*field(ixp,jyp,zlevel,indexh)
+#include "int_find_z_level_meters.f90"
 
-end subroutine hor_interpol_4d
+#include "int_find_z_level_eta.f90"
 
-subroutine hor_interpol_2d(field,output)
+#include "int_find_z_level_eta_w.f90"
 
-  real, intent(in)    :: field(0:nxmax-1,0:nymax-1)       ! 2D imput field
-  real, intent(inout) :: output                           ! Interpolated value
+#include "int_find_z_level_eta_uv.f90"
 
-  output=p1*field(ix ,jy) &
-         + p2*field(ixp,jy) &
-         + p3*field(ix ,jyp) &
-         + p4*field(ixp,jyp)
-end subroutine hor_interpol_2d
+#include "int_find_vert_vars.f90"
 
-subroutine hor_interpol_4d_nest(field,output,zlevel,indexh,ztot)
+#include "int_find_vert_vars_lin.f90"
 
-  integer, intent(in) :: zlevel,ztot,indexh   ! interpolation z level, z
-  real, intent(in)    :: field(0:nxmaxn-1,0:nymaxn-1,ztot,numwfmem,numbnests) 
-                                              ! input field to interpolate 
-  real, intent(inout) :: output               ! interpolated values
+#include "int_find_ngrid_dp.f90"
 
-  output=p1*field(ix ,jy ,zlevel,indexh,ngrid) &
-       + p2*field(ixp,jy ,zlevel,indexh,ngrid) &
-       + p3*field(ix ,jyp,zlevel,indexh,ngrid) &
-       + p4*field(ixp,jyp,zlevel,indexh,ngrid)
+#include "int_find_ngrid_sp.f90"
 
-end subroutine hor_interpol_4d_nest
+#include "int_hor_interpol_4d.f90"
 
-subroutine hor_interpol_2d_nest(field,output)
+#include "int_hor_interpol_2d.f90"
 
-  real, intent(in)    :: field(0:nxmaxn-1,0:nymaxn-1,numbnests) 
-                                          ! input field to interpolate
-  real, intent(inout) :: output           ! interpolated values
+#include "int_hor_interpol_4d_nest.f90"
 
-  output=p1*field(ix ,jy ,ngrid) &
-       + p2*field(ixp,jy ,ngrid) &
-       + p3*field(ix ,jyp,ngrid) &
-       + p4*field(ixp,jyp,ngrid)
+#include "int_hor_interpol_2d_nest.f90"
 
-end subroutine hor_interpol_2d_nest
+#include "int_temp_interpol.f90"
 
-subroutine temp_interpol(time1,time2,output)
+#include "int_vert_interpol.f90"
 
-  real, intent(in)    :: time1,time2     ! input data at two timesteps 
-  real, intent(inout) :: output          ! interpolated data
+#include "int_bilin_spatial_interpol.f90"
 
-  output= (time1*dt2 + time2*dt1) * dtt
+#include "int_bilin_spatial_interpol_nest.f90"
 
-end subroutine temp_interpol
+#include "int_compute_sl_sq.f90"
 
-subroutine vert_interpol(input1,input2,dz1,dz2,output)
+#include "int_compute_sl_sq_nest.f90"
 
-  real, intent(in)    :: input1,input2   ! input data at two vertical levels, 
-                                         ! 1 being closer to ground
-  real, intent(in)    :: dz1,dz2         ! logarithmic interpolation values
-  real, intent(inout) :: output          ! interpolated data
-
-  output = input1*dz2 + input2*dz1 ! input1**dz2 * input2**dz1
-
-end subroutine vert_interpol
-
-subroutine bilin_spatial_interpol(field,output,zlevel,dz1,dz2,ztot)
-
-  integer, intent(in) :: zlevel,ztot        ! interpolation z level
-  real, intent(in)    :: field(0:nxmax-1,0:nymax-1,ztot,numwfmem)  
-                                            ! input field to interpolate
-  real, intent(in)    :: dz1,dz2
-  real, intent(inout) :: output(2)          ! interpolated values
-  integer             :: m,n,indzh
-  real                :: output1(2)
-
-  do m=1,2
-    
-    do n=1,2
-      indzh=zlevel+n-1
-      call hor_interpol_4d(field,output1(n),indzh,memind(m),ztot)
-    end do
-    
-    !**********************************
-    ! 2.) Linear vertical interpolation on logarithmic scale
-    !**********************************
-    
-    call vert_interpol(output1(1),output1(2),dz1,dz2,output(m))
-    
-  end do
-  
-end subroutine bilin_spatial_interpol
-
-subroutine bilin_spatial_interpol_nest(field,output,zlevel,dz1,dz2,ztot)
-
-  integer, intent(in) :: zlevel,ztot       ! interpolation z level
-  real, intent(in)    :: field(0:nxmaxn-1,0:nymaxn-1,ztot,numwfmem,numbnests)  
-                                           ! input field to interpolate
-  real, intent(in)    :: dz1,dz2
-  real, intent(inout) :: output(2)         ! interpolated values
-  integer             :: m,n,indzh
-  real                :: output1(2)
-
-  do m=1,2
-  
-    do n=1,2
-      indzh=zlevel+n-1
-      call hor_interpol_4d_nest(field,output1(n),indzh,memind(m),ztot)
-    end do
-    
-    !**********************************
-    ! 2.) Linear vertical interpolation on logarithmic scale
-    !**********************************
-    
-    call vert_interpol(output1(1),output1(2),dz1,dz2,output(m))
-    
-  end do
-  
-end subroutine bilin_spatial_interpol_nest
-
-subroutine compute_sl_sq(field,sl,sq,zlevel,indexh,ztot)
-
-  integer, intent(in) :: zlevel,ztot,indexh   ! interpolation z levels
-  real, intent(in)    :: field(0:nxmax-1,0:nymax-1,ztot,numwfmem) 
-                                              ! input field to interpolate
-  real, intent(inout) :: sl,sq                ! standard deviation
-
-  sl=sl+field(ix ,jy ,zlevel,indexh)+field(ixp,jy ,zlevel,indexh) &
-       +field(ix ,jyp,zlevel,indexh)+field(ixp,jyp,zlevel,indexh)
-
-  sq=sq+field(ix ,jy ,zlevel,indexh)*field(ix ,jy ,zlevel,indexh)+ &
-        field(ixp,jy ,zlevel,indexh)*field(ixp,jy ,zlevel,indexh)+ &
-        field(ix ,jyp,zlevel,indexh)*field(ix ,jyp,zlevel,indexh)+ &
-        field(ixp,jyp,zlevel,indexh)*field(ixp,jyp,zlevel,indexh)
-
-end subroutine compute_sl_sq
-
-subroutine compute_sl_sq_nest(field,sl,sq,zlevel,indexh,ztot)
-
-  integer, intent(in) :: zlevel,ztot,indexh   ! interpolation z levels
-  real, intent(in)    :: field(0:nxmaxn-1,0:nymaxn-1,ztot,numwfmem,numbnests) 
-                                              ! input field to interpolate
-  real, intent(inout) :: sl,sq                ! standard deviation
-
-  sl=sl+field(ix ,jy ,zlevel,indexh,ngrid)+field(ixp,jy ,zlevel,indexh,ngrid) &
-       +field(ix ,jyp,zlevel,indexh,ngrid)+field(ixp,jyp,zlevel,indexh,ngrid)
-
-  sq=sq+field(ix ,jy ,zlevel,indexh,ngrid)*field(ix ,jy ,zlevel,indexh,ngrid)+ &
-        field(ixp,jy ,zlevel,indexh,ngrid)*field(ixp,jy ,zlevel,indexh,ngrid)+ &
-        field(ix ,jyp,zlevel,indexh,ngrid)*field(ix ,jyp,zlevel,indexh,ngrid)+ &
-        field(ixp,jyp,zlevel,indexh,ngrid)*field(ixp,jyp,zlevel,indexh,ngrid)
-
-end subroutine compute_sl_sq_nest
-
-subroutine stdev(sl,sq,divisor,output)
-
-  real, intent(in) :: sl,sq,divisor
-  real, intent(out) :: output
-  real :: xaux
-  real,parameter      :: eps=1.0e-30
-
-  xaux= sq - sl*sl/divisor
-
-  if (xaux.lt.eps) then
-    output=0.
-  else
-    output=sqrt(xaux/(divisor-1.))
-  endif
-
-end subroutine stdev
+#include "int_stdev.f90"
 
 ! Interpolation functions
 !************************
 
-subroutine interpol_pbl(itime,xt,yt,zt,zteta)
-  !                          i   i  i  i
-  !*****************************************************************************
-  !                                                                            *
-  !  This subroutine interpolates everything that is needed for calculating the*
-  !  dispersion.                                                               *
-  !                                                                            *
-  !    Author: A. Stohl                                                        *
-  !                                                                            *
-  !    16 December 1997                                                        *
-  !                                                                            *
-  !  Revision March 2005 by AST : all output variables in common block cal-    *
-  !                               culation of standard deviation done in this  *
-  !                               routine rather than subroutine call in order *
-  !                               to save computation time                     *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! itime [s]          current temporal position                               *
-  ! memtime(3) [s]     times of the wind fields in memory                      *
-  ! xt,yt,zt           coordinates position for which wind data shall be       *
-  !                    culated                                                 *
-  !                                                                            *
-  ! Constants:                                                                 *
-  !                                                                            *
-  !*****************************************************************************
-
-  use turbulence_mod
-
-  integer, intent(in) :: itime
-  real, intent(in)    :: xt,yt,zt,zteta
-  integer             :: m,n,indexh
-  integer             :: iw(2),iweta(2)
-  real                :: uh1(2),vh1(2),wh1(2),wetah1(2),rho1(2),rhograd1(2)
-  real                :: dz1weta,dz2weta
-  real,parameter      :: eps=1.0e-30
-
-  ! Auxiliary variables needed for interpolation
-  real :: ust1(2),wst1(2),oli1(2),oliaux
-
-  !********************************************
-  ! Multilinear interpolation in time and space
-  !********************************************
-
-  ! ngrid and grid coordinates have already been definded, and are included
-  ! in the input (for nested: xtn,ytn; for not nested: xts,yts)
-
-  !************************************************************************
-  ! Determine the lower left corner and its distance to the current position
-  !*************************************************************************
-
-  call find_grid_distances(xt,yt)
-
-  ! Calculate variables for time interpolation
-  !*******************************************
-
-  call find_time_vars(itime)
-
-  !********************************************************
-  ! 1. Interpolate u*, w* and Obukhov length for turbulence
-  !********************************************************
-
-  ! a) Bilinear horizontal interpolation
-  if (ngrid.le.0) then ! No nest
-    do m=1,2
-      indexh=memind(m)
-      call hor_interpol(ustar,ust1(m),1,memind(m),1)
-      call hor_interpol(wstar,wst1(m),1,memind(m),1)
-      call hor_interpol(oli,oli1(m),1,memind(m),1)
-    end do
-  else ! Nest
-    do m=1,2
-      indexh=memind(m)
-      call hor_interpol_nest(ustarn,ust1(m),1,memind(m),1)
-      call hor_interpol_nest(wstarn,wst1(m),1,memind(m),1)
-      call hor_interpol_nest(olin,oli1(m),1,memind(m),1)
-    end do
-  endif    
+#include "int_interpol_pbl.f90"
 
-  ! b) Temporal interpolation
-  call temp_interpol(ust1(1),ust1(2),ust)
-  call temp_interpol(wst1(1),wst1(2),wst)
-  call temp_interpol(oli1(1),oli1(2),oliaux)
+#include "int_interpol_pbl_misslev.f90"
 
-  if (oliaux.ne.0.) then
-    ol=1./oliaux
-  else
-    ol=99999.
-  endif
+#include "int_interpol_pbl_short.f90"
 
-  ! Within the PBL, only METER coordinates are used
-  ! with the exception of mesoscale turbulence,
-  ! which uses wsigeta computed in interpol_mesoscale
-  !**************************************************
+#include "int_interpol_mesoscale.f90"
 
-  ! Determine the level below the current position
-  !***********************************************
-  call find_z_level_meters(zt)
+#include "int_interpol_wind.f90"
 
-  iw(:)=(/ indz, indzp /)
+#include "int_interpol_wind_short.f90"
 
-  ! w(eta) velocities are necessary for the Petterssen correction
-  !**************************************************************
-  if (wind_coord_type.eq.'ETA') then
-    call find_z_level_eta(zteta)
-    iweta(:)=(/ indzeta, indzpeta /)
-  endif
+#include "int_interpol_partoutput_val.f90"
 
-  !**************************************
-  ! 1.) Bilinear horizontal interpolation
-  ! 2.) Temporal interpolation (linear)
-  !**************************************
-  
-  ! Loop over 2 time steps and indz levels
-  !***************************************
-  if (ngrid.le.0) then ! No nest
-    do n=1,2
-      do m=1,2
-        call hor_interpol(ww,wh1(m),iw(n),memind(m),nzmax)
-        if (wind_coord_type.eq.'ETA') &
-          call hor_interpol(wweta,wetah1(m),iweta(n),memind(m),nzmax)
-        call hor_interpol(rho,rho1(m),iw(n),memind(m),nzmax)
-        call hor_interpol(drhodz,rhograd1(m),iw(n),memind(m),nzmax)
-        if (ngrid.lt.0) then
-          call hor_interpol(uupol,uh1(m),iw(n),memind(m),nzmax)
-          call hor_interpol(vvpol,vh1(m),iw(n),memind(m),nzmax)
-        else
-          call hor_interpol(uu,uh1(m),iw(n),memind(m),nzmax)
-          call hor_interpol(vv,vh1(m),iw(n),memind(m),nzmax)
-        endif
-      end do
-      call temp_interpol(wh1(1),wh1(2),wprof(iw(n)))
-      if (wind_coord_type.eq.'ETA') &
-        call temp_interpol(wetah1(1),wetah1(2),wprofeta(iweta(n)))
-      call temp_interpol(uh1(1),uh1(2),uprof(iw(n)))
-      call temp_interpol(vh1(1),vh1(2),vprof(iw(n)))
-      call temp_interpol(rho1(1),rho1(2),rhoprof(iw(n)))
-      call temp_interpol(rhograd1(1),rhograd1(2),rhogradprof(iw(n)))
-    end do
-  else ! Nest
-    do n=1,2
-      do m=1,2
-        call hor_interpol_nest(wwn,wh1(m),iw(n),memind(m),nzmax)
-        if (wind_coord_type.eq.'ETA') &
-          call hor_interpol_nest(wwetan,wetah1(m),iweta(n),memind(m),nzmax)
-        call hor_interpol_nest(uun,uh1(m),iw(n),memind(m),nzmax)
-        call hor_interpol_nest(vvn,vh1(m),iw(n),memind(m),nzmax)
-        call hor_interpol_nest(rhon,rho1(m),iw(n),memind(m),nzmax)
-        call hor_interpol_nest(drhodzn,rhograd1(m),iw(n),memind(m),nzmax)
-      end do
-      call temp_interpol(wh1(1),wh1(2),wprof(iw(n)))
-      if (wind_coord_type.eq.'ETA') &
-        call temp_interpol(wetah1(1),wetah1(2),wprofeta(iweta(n)))
-      call temp_interpol(uh1(1),uh1(2),uprof(iw(n)))
-      call temp_interpol(vh1(1),vh1(2),vprof(iw(n)))
-      call temp_interpol(rho1(1),rho1(2),rhoprof(iw(n)))
-      call temp_interpol(rhograd1(1),rhograd1(2),rhogradprof(iw(n)))
+#include "int_interpol_htropo_hmix.f90"
 
-      indzindicator(iw(n))=.false.
-    end do
-  endif
-
-  ! Only necessary for the Petterssen correction
-  if (wind_coord_type.eq.'ETA') then
-    call find_vert_vars(wheight,zteta,indzeta, &
-      dz1weta,dz2weta,lbounds_w,.true.)
-    call vert_interpol(wprofeta(indzeta),wprofeta(indzpeta), &
-      dz1weta,dz2weta,weta)
-  endif
-
-end subroutine interpol_pbl
-
-subroutine interpol_pbl_misslev
-
-  !*****************************************************************************
-  !                                                                            *
-  !  This subroutine interpolates u,v,w, density and density gradients.        *
-  !                                                                            *
-  !    Author: A. Stohl                                                        *
-  !                                                                            *
-  !    16 December 1997                                                        *
-  !    Update: 2 March 1999                                                    *
-  !                                                                            *
-  !  Revision March 2005 by AST : all output variables in common block cal-    *
-  !                               culation of standard deviation done in this  *
-  !                               routine rather than subroutine call in order *
-  !                               to save computation time                     *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! n                  level                                                   *
-  !                                                                            *
-  ! Constants:                                                                 *
-  !                                                                            *
-  !*****************************************************************************
-
-  real                :: uh1(2),vh1(2),wh1(2),rho1(2),rhograd1(2)
-  integer             :: m,n,iw(2)
-
-  ! Within the PBL, only METER coordinates are used
-  ! with the exception of mesoscale turbulence,
-  ! which uses wsigeta computed in interpol_mesoscale
-  !**************************************************
-
-  !********************************************
-  ! Multilinear interpolation in time and space
-  !********************************************
-
-  iw(:)=(/ indz, indzp /)
-  do n=1,2
-    if (indzindicator(iw(n))) then
-      if (ngrid.le.0) then ! No nest
-        do m=1,2
-          call hor_interpol(ww,wh1(m),iw(n),memind(m),nzmax)
-          call hor_interpol(rho,rho1(m),iw(n),memind(m),nzmax)
-          call hor_interpol(drhodz,rhograd1(m),iw(n),memind(m),nzmax)
-          if (ngrid.lt.0) then
-            call hor_interpol(uupol,uh1(m),iw(n),memind(m),nzmax)
-            call hor_interpol(vvpol,vh1(m),iw(n),memind(m),nzmax)
-          else
-            call hor_interpol(uu,uh1(m),iw(n),memind(m),nzmax)
-            call hor_interpol(vv,vh1(m),iw(n),memind(m),nzmax)
-          endif
-        end do
-      else ! Nest
-        do m=1,2
-          call hor_interpol_nest(wwn,wh1(m),iw(n),memind(m),nzmax)
-          call hor_interpol_nest(uun,uh1(m),iw(n),memind(m),nzmax)
-          call hor_interpol_nest(vvn,vh1(m),iw(n),memind(m),nzmax)
-          call hor_interpol_nest(rhon,rho1(m),iw(n),memind(m),nzmax)
-          call hor_interpol_nest(drhodzn,rhograd1(m),iw(n),memind(m),nzmax)
-        end do
-      endif
-      call temp_interpol(wh1(1),wh1(2),wprof(iw(n)))
-      call temp_interpol(uh1(1),uh1(2),uprof(iw(n)))
-      call temp_interpol(vh1(1),vh1(2),vprof(iw(n)))
-      call temp_interpol(rho1(1),rho1(2),rhoprof(iw(n)))
-      call temp_interpol(rhograd1(1),rhograd1(2),rhogradprof(iw(n)))
-
-      indzindicator(iw(n))=.false.
-    endif
-  end do
-
-end subroutine interpol_pbl_misslev
-
-subroutine interpol_pbl_short(zt,rhoa,rhograd)
-
-  real, intent(in)    :: zt
-  real, intent(inout) :: rhoa,rhograd
-  real                :: dz1,dz2
-
-  call find_vert_vars(height,zt,indz,dz1,dz2,lbounds,.false.)
-
-  call vert_interpol(wprof(indz),wprof(indzp),dz1,dz2,w)
-  call vert_interpol(uprof(indz),uprof(indzp),dz1,dz2,u)
-  call vert_interpol(vprof(indz),vprof(indzp),dz1,dz2,v)
-  call vert_interpol(rhoprof(indz),rhoprof(indzp),dz1,dz2,rhoa)
-  call vert_interpol(rhogradprof(indz),rhogradprof(indzp),dz1,dz2,rhograd)
-
-end subroutine interpol_pbl_short
-
-subroutine interpol_mesoscale(itime,xt,yt,zt,zteta)
-
-  use turbulence_mod
-
-  integer, intent(in) :: itime
-  real, intent(in)    :: xt,yt,zt,zteta
-  integer             :: iw(2),iuv(2),iweta(2)
-  integer             :: m,indexh
-
-  ! Where in the grid? Stereographic (ngrid<0) or nested (ngrid>0)
-  !***************************************************************
-  call find_ngrid(xt,yt)
-
-  call find_grid_indices(xt,yt)
-
-  ! Determine the level below the current position
-  !***********************************************
-  call find_z_level_meters(zt)
-  iw(:)=(/ indz, indzp /)
-  
-  select case (wind_coord_type)
-    case ('ETA')  
-      call find_z_level_eta(zteta)
-      iuv(:)=(/ induv, indpuv /)
-      iweta(:)=(/ indzeta, indzpeta /)
-      call stdev_eta(iw,iuv,iweta)
-    case ('METER')
-      iw(:)=(/ indz, indzp /)
-      call stdev_meter(iw)
-    case default
-      write(*,*) 'ERROR: wind_coord_type is not allowed ', wind_coord_type
-      write(*,*) 'Choose ETA or METER.'
-      stop
-  end select
-
-end subroutine interpol_mesoscale
-
-subroutine interpol_wind(itime,xt,yt,zt,zteta,pp)
-  !                           i   i  i  i
-
-  !*****************************************************************************
-  !                                                                            *
-  !  This subroutine interpolates the wind data to current trajectory position.*
-  !                                                                            *
-  !    Author: A. Stohl                                                        *
-  !                                                                            *
-  !    16 December 1997                                                        *
-  !                                                                            *
-  !  Revision March 2005 by AST : all output variables in common block cal-    *
-  !                               culation of standard deviation done in this  *
-  !                               routine rather than subroutine call in order *
-  !                               to save computation time                     *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! u,v,w              wind components                                         *
-  ! itime [s]          current temporal position                               *
-  ! memtime(3) [s]     times of the wind fields in memory                      *
-  ! xt,yt,zt           coordinates position for which wind data shall be       *
-  !                    calculated                                              *
-  !                                                                            *
-  ! Constants:                                                                 *
-  !                                                                            *
-  !*****************************************************************************
-
-  integer, intent(in) :: itime,pp
-  real, intent(in)    :: xt,yt,zt,zteta
-  integer             :: iw(2),iuv(2),iweta(2)
-
-
-  ! Where in the grid? Stereographic (ngrid<0) or nested (ngrid>0)
-  !***************************************************************
-  call find_ngrid(xt,yt)
-
-  call find_grid_indices(xt,yt)
-  ! ! Multilinear interpolation in time and space
-  ! !********************************************
-
-  ! Determine the lower left corner and its distance to the current position
-  !*************************************************************************
-  call find_grid_distances(xt,yt)
-
-  ! Calculate variables for time interpolation
-  !*******************************************
-  call find_time_vars(itime)
-
-  ! Interpolate over the windfields depending on the prefered
-  ! coordinate system
-  !**********************************************************
-  select case (wind_coord_type)
-    case ('ETA')
-      ! Same for eta coordinates
-      !*************************
-      call find_z_level_eta(zteta)
-
-      iuv(:)  = (/ induv, indpuv /)
-      iweta(:)= (/ indzeta, indzpeta /)
-      call interpol_wind_eta(zteta,iuv,iweta)
-      !call stdev_wind_eta(iw,iuv,iweta)
-    case ('METER')
-      ! Determine the level below the current position for u,v
-      !*******************************************************
-      call find_z_level_meters(zt)
-
-      iw(:)=(/ indz, indzp /)
-      call interpol_wind_meter(zt,iw)
-      !call stdev_wind_meter(iw)
-
-    case default
-      write(*,*) 'ERROR: wind_coord_type is not allowed ', wind_coord_type
-      write(*,*) 'Choose ETA or METER.'
-      stop
-  end select
-
-end subroutine interpol_wind
-
-subroutine interpol_wind_short(itime,xt,yt,zt,zteta)
-!                                i   i  i  i  i
-
-  !*****************************************************************************
-  !                                                                            *
-  !  This subroutine interpolates the wind data to current trajectory position.*
-  !                                                                            *
-  !    Author: A. Stohl                                                        *
-  !                                                                            *
-  !    16 December 1997                                                        *
-  !                                                                            *
-  !  Revision March 2005 by AST : all output variables in common block         *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! u,v,w              wind components                                         *
-  ! itime [s]          current temporal position                               *
-  ! memtime(3) [s]     times of the wind fields in memory                      *
-  ! xt,yt,zt           coordinates position for which wind data shall be       *
-  !                    calculated                                              *
-  !                                                                            *
-  ! Constants:                                                                 *
-  !                                                                            *
-  !*****************************************************************************
-
-  integer, intent(in) :: itime
-  real, intent(in) :: xt,yt,zt,zteta
-  integer             :: iw(2),iuv(2),iweta(2)
-
-  !********************************************
-  ! Multilinear interpolation in time and space
-  !********************************************
-
-  ! Where in the grid? Stereographic (ngrid<0) or nested (ngrid>0)
-  !***************************************************************
-  call find_ngrid(xt,yt)
-  call find_grid_indices(xt,yt)
-  call find_grid_distances(xt,yt)
-
-  ! Calculate variables for time interpolation
-  !*******************************************
-  call find_time_vars(itime)
-
-  ! Interpolate over the windfields depending on the prefered
-  ! coordinate system
-  !**********************************************************
-  select case (wind_coord_type)
-    case ('ETA')
-      ! Determine the level below the current position for eta coordinates
-      !*******************************************************************
-      call find_z_level_eta(zteta)
-
-      iuv(:)=(/ induv, indpuv /)
-      iweta(:)=(/ indzeta, indzpeta /)
-      ! Interpolate the u, v, weta windfields
-      !**************************************
-      call interpol_wind_eta(zteta,iuv,iweta)
-    case ('METER')
-
-      ! Determine the level below the current position for u,v
-      !*******************************************************
-      call find_z_level_meters(zt)
-
-      iw(:)=(/ indz, indzp /)
-      call interpol_wind_meter(zt,iw)
-    case default
-      write(*,*) 'ERROR: wind_coord_type is not allowed ', wind_coord_type
-      write(*,*) 'Choose ETA or METER.'
-      stop
-  end select
-
-end subroutine interpol_wind_short
-
-subroutine interpol_partoutput_val(fieldname,output,j)
-
-  integer, intent(in)         :: j          ! particle number
-  character(2), intent(in)    :: fieldname  ! input field to interpolate over
-  real, intent(inout)         :: output
-
-  ! Interpolate over the windfields depending on the prefered
-  ! coordinate system
-  !**********************************************************
-  select case (wind_coord_type)
-    case ('ETA')
-      call interpol_partoutput_val_eta(fieldname,output,j)
-    case ('METER')
-      call interpol_partoutput_val_meter(fieldname,output,j)
-    case default
-      call interpol_partoutput_val_meter(fieldname,output,j)
-  end select
-
-end subroutine interpol_partoutput_val
-
-subroutine interpol_htropo_hmix(tropop,h)
-
-  real, intent(inout) :: tropop   ! height of troposphere
-  real, intent(inout) :: h        ! mixing height
-  real    :: h1(2)                ! mixing height of 2 timesteps
-  integer :: mind                 ! windfield index
-  integer :: i,j,k,m              ! loop variables
-
-  h=0.
-  if (ngrid.le.0) then
-    if (interpolhmix) then
-      do m=1,2
-        call hor_interpol(hmix,h1(m),1,memind(m),1)
-      end do
-    else
-      do k=1,2
-        mind=memind(k) ! eso: compatibility with 3-field version
-        do j=jy,jyp
-          do i=ix,ixp
-             if (hmix(i,j,1,mind).gt.h) h=hmix(i,j,1,mind)
-          end do
-        end do
-      end do
-    endif
-    tropop=tropopause(nix,njy,1,memind(1))
-  else
-    do k=1,2
-      mind=memind(k)
-      do j=jy,jyp
-        do i=ix,ixp
-          if (hmixn(i,j,1,mind,ngrid).gt.h) h=hmixn(i,j,1,mind,ngrid)
-        end do
-      end do
-    end do
-    tropop=tropopausen(nix,njy,1,memind(1),ngrid)
-  endif
-
-  if (interpolhmix) h= (h1(1)*dt2 + h1(2)*dt1)*dtt 
-
-end subroutine interpol_htropo_hmix
-
-subroutine interpol_density(itime,ipart,output)
-
-  integer, intent(in) :: itime,ipart  ! time and particle index
-  real, intent(inout) :: output ! output density (rhoi)
-  integer :: ind
-  real :: dz1,dz2,rhoprof(2)
-
-  ! Where in the grid? Stereographic (ngrid<0) or nested (ngrid>0)
-  !***************************************************************
-  call find_ngrid(part(ipart)%xlon,part(ipart)%ylat)
-  call find_grid_indices(real(part(ipart)%xlon),real(part(ipart)%ylat))
-  call find_grid_distances(real(part(ipart)%xlon),real(part(ipart)%ylat))
-  call find_time_vars(itime)
-
-  ! Take density from 2nd wind field in memory 
-  !(accurate enough, no time interpolation needed)
-  !***********************************************
-  
-  select case (wind_coord_type)
-    case ('ETA')
-      call find_z_level_eta(real(part(ipart)%zeta))
-      call find_vert_vars(uvheight,real(part(ipart)%zeta),induv, &
-        dz1,dz2,lbounds_uv,.false.)
-      if (ngrid.le.0) then
-        do ind=induv,indpuv
-          call hor_interpol(rhoeta,rhoprof(ind-induv+1),ind,memind(2),nzmax)
-        end do
-      else
-        do ind=induv,indpuv
-          call hor_interpol_nest(rhoetan,rhoprof(ind-induv+1),ind,memind(2), &
-            nzmax)
-        end do
-      endif
-    case ('METER')
-      call find_z_level_meters(real(part(ipart)%z))
-      call find_vert_vars(height,real(part(ipart)%z),indz, &
-        dz1,dz2,lbounds,.false.)
-      if (ngrid.le.0) then
-        do ind=indz,indzp
-          call hor_interpol(rho,rhoprof(ind-indz+1),ind,memind(2),nzmax)
-        end do
-      else
-        do ind=indz,indzp
-          call hor_interpol_nest(rhon,rhoprof(ind-indz+1),ind,memind(2),nzmax)
-        end do
-      endif
-    case default
-      stop 'wind_coord_type not defined in conccalc.f90'
-  end select
-
-  call vert_interpol(rhoprof(1),rhoprof(2),dz1,dz2,output)
-
-end subroutine interpol_density
+#include "int_interpol_density.f90"
 
 !*********************
 !* PRIVATE FUNCTIONS *
 !*********************
 ! Interpolation of wind fields
 !*****************************
-subroutine interpol_wind_eta(zteta,iuv,iweta)
-
-!* PRIVATE FUNCTION *
-
-  real, intent(in)    :: zteta
-  integer,intent(in)  :: iuv(2),iweta(2)
-  integer             :: n,m
-  real                :: uh(2),vh(2),wetah(2),uh1(2),vh1(2),wetah1(2)
-  real                :: dz1uv,dz2uv,dz1weta,dz2weta
-
-  !**********************************************************************
-  ! 1.) Bilinear horizontal interpolation
-  ! This has to be done separately for 6 fields (Temporal(2)*Vertical(3))
-  !**********************************************************************
-
-  ! Vertical distance to the level below and above current position
-  !****************************************************************
-  call find_vert_vars(uvheight,zteta,induv,dz1uv,dz2uv,lbounds_uv,.false.)
-  call find_vert_vars(wheight,zteta,indzeta,dz1weta,dz2weta,lbounds_w,.true.)
-
-  ! Loop over 2 time steps and 2 levels
-  !************************************
-  if (ngrid.le.0) then ! No nest
-    do m=1,2
-      do n=1,2
-        call hor_interpol(wweta,wetah1(n),iweta(n),memind(m),nzmax)
-        if (ngrid.lt.0) then
-          call hor_interpol(uupoleta,uh1(n),iuv(n),memind(m),nzmax)
-          call hor_interpol(vvpoleta,vh1(n),iuv(n),memind(m),nzmax)
-        else
-          call hor_interpol(uueta,uh1(n),iuv(n),memind(m),nzmax)
-          call hor_interpol(vveta,vh1(n),iuv(n),memind(m),nzmax)
-        endif
-      end do
-      call vert_interpol(uh1(1),uh1(2),dz1uv,dz2uv,uh(m))
-      call vert_interpol(vh1(1),vh1(2),dz1uv,dz2uv,vh(m))
-      call vert_interpol(wetah1(1),wetah1(2),dz1weta,dz2weta,wetah(m))
-    end do 
-  else ! Nest
-    do m=1,2
-      do n=1,2
-        
-        ! wetah1(n) = p1*wwetan(ix ,jy ,iweta(n),memind(m),ngrid) &
-        !           + p2*wwetan(ixp,jy ,iweta(n),memind(m),ngrid) &
-        !           + p3*wwetan(ix ,jyp,iweta(n),memind(m),ngrid) &
-        !           + p4*wwetan(ixp,jyp,iweta(n),memind(m),ngrid)
-        call hor_interpol_nest(wwetan,wetah1(n),iweta(n),memind(m),nzmax)
-        call hor_interpol_nest(uuetan,uh1(n),iuv(n),memind(m),nzmax)
-        call hor_interpol_nest(vvetan,vh1(n),iuv(n),memind(m),nzmax)
-      end do
-      call vert_interpol(uh1(1),uh1(2),dz1uv,dz2uv,uh(m))
-      call vert_interpol(vh1(1),vh1(2),dz1uv,dz2uv,vh(m))
-      call vert_interpol(wetah1(1),wetah1(2),dz1weta,dz2weta,wetah(m))
-    end do    
-  endif
-
-  call temp_interpol(uh(1),uh(2),u)
-  call temp_interpol(vh(1),vh(2),v)
-  call temp_interpol(wetah(1),wetah(2),weta)
-
-end subroutine interpol_wind_eta
-
-subroutine interpol_wind_meter(zt,iw)
-
-!* PRIVATE FUNCTION *
-
-  real, intent(in)    :: zt
-  integer,intent(in)  :: iw(2)
-  integer             :: n,m
-  real                :: uh(2),vh(2),wh(2),uh1(2),vh1(2),wh1(2)
-  real                :: dz1w,dz2w
-
-  !**********************************************************************
-  ! 1.) Bilinear horizontal interpolation
-  ! This has to be done separately for 6 fields (Temporal(2)*Vertical(3))
-  !**********************************************************************
-
-  ! Vertical distance to the level below and above current position
-  !****************************************************************
-  call find_vert_vars(height,zt,indz,dz1w,dz2w,lbounds,.false.)
-
-  ! Loop over 2 time steps and 2 levels
-  !************************************
-  if (ngrid.le.0) then ! No nest
-    do m=1,2
-      do n=1,2
-        call hor_interpol(ww,wh1(n),iw(n),memind(m),nzmax)
-        if (ngrid.lt.0) then
-          call hor_interpol(uupol,uh1(n),iw(n),memind(m),nzmax)
-          call hor_interpol(vvpol,vh1(n),iw(n),memind(m),nzmax)
-        else
-          call hor_interpol(uu,uh1(n),iw(n),memind(m),nzmax)
-          call hor_interpol(vv,vh1(n),iw(n),memind(m),nzmax)
-        endif
-      end do
-      call vert_interpol(wh1(1),wh1(2),dz1w,dz2w,wh(m))
-      call vert_interpol(uh1(1),uh1(2),dz1w,dz2w,uh(m))
-      call vert_interpol(vh1(1),vh1(2),dz1w,dz2w,vh(m))
-    end do 
-  else ! Nest
-    do m=1,2
-      do n=1,2
-        call hor_interpol_nest(wwn,wh1(n),iw(n),memind(m),nzmax)
-        call hor_interpol_nest(uun,uh1(n),iw(n),memind(m),nzmax)
-        call hor_interpol_nest(vvn,vh1(n),iw(n),memind(m),nzmax)
-      end do
-      call vert_interpol(wh1(1),wh1(2),dz1w,dz2w,wh(m))
-      call vert_interpol(uh1(1),uh1(2),dz1w,dz2w,uh(m))
-      call vert_interpol(vh1(1),vh1(2),dz1w,dz2w,vh(m))
-    end do    
-  endif
-
-  call temp_interpol(wh(1),wh(2),w)
-  call temp_interpol(uh(1),uh(2),u)
-  call temp_interpol(vh(1),vh(2),v)
-
-end subroutine interpol_wind_meter
-
-subroutine interpol_partoutput_val_eta(fieldname,output,j)
-
-!* PRIVATE FUNCTION *
-
-  integer, intent(in)         :: j          ! particle number
-  character(2), intent(in)    :: fieldname  ! input field to interpolate over
-  real, intent(inout)         :: output
-  real                        :: field1(2)
-
-  if (int(dz1out).eq.-1) then
-    call find_z_level_eta(real(part(j)%zeta))
-    call find_vert_vars(uvheight,real(part(j)%zeta),induv,dz1out,dz2out, &
-      lbounds_uv,.false.)
-  endif
-
-  select case(fieldname)
-    case('PR','pr')
-      if (ngrid.le.0) then
-        call bilin_spatial_interpol(prseta,field1,induv,dz1out,dz2out,nzmax)
-      else
-        call bilin_spatial_interpol_nest(prsetan,field1,induv,dz1out,dz2out,nzmax)
-      endif
-      call temp_interpol(field1(1),field1(2),output)
-    case('PV','pv')
-      if (ngrid.le.0) then
-        call bilin_spatial_interpol(pveta,field1,induv,dz1out,dz2out,nzmax)
-      else
-        call bilin_spatial_interpol_nest(pvetan,field1,induv,dz1out,dz2out,nzmax)
-      endif
-      call temp_interpol(field1(1),field1(2),output)
-    case('QV','qv')
-      if (ngrid.le.0) then
-        call bilin_spatial_interpol(qv,field1,induv,dz1out,dz2out,nzmax)
-      else
-        call bilin_spatial_interpol_nest(qvn,field1,induv,dz1out,dz2out,nzmax)
-      endif
-      call temp_interpol(field1(1),field1(2),output)
-    case('TT','tt')
-      if (ngrid.le.0) then
-        call bilin_spatial_interpol(tteta,field1,induv,dz1out,dz2out,nzmax)
-      else
-        call bilin_spatial_interpol_nest(ttetan,field1,induv,dz1out,dz2out,nzmax)
-      endif
-      call temp_interpol(field1(1),field1(2),output)
-    case('UU','uu')
-      if (ngrid.le.0) then
-        call bilin_spatial_interpol(uueta,field1,induv,dz1out,dz2out,nzmax)
-      else
-        call bilin_spatial_interpol_nest(uuetan,field1,induv,dz1out,dz2out,nzmax)
-      endif
-      call temp_interpol(field1(1),field1(2),output)
-    case('VV','vv')
-      if (ngrid.le.0) then
-        call bilin_spatial_interpol(vveta,field1,induv,dz1out,dz2out,nzmax)
-      else
-        call bilin_spatial_interpol_nest(vvetan,field1,induv,dz1out,dz2out,nzmax)
-      endif
-      call temp_interpol(field1(1),field1(2),output)
-    case('WW','ww')
-      call find_z_level_meters(real(part(j)%z))
-      call find_vert_vars(height,real(part(j)%z),indz,dz1out,dz2out,lbounds,.false.)
-      if (ngrid.le.0) then
-        call bilin_spatial_interpol(ww,field1,induv,dz1out,dz2out,nzmax)
-      else
-        call bilin_spatial_interpol_nest(wwn,field1,induv,dz1out,dz2out,nzmax)
-      endif
-      call temp_interpol(field1(1),field1(2),output)
-      dz1out = -1
-    case('RH','rh')
-      if (ngrid.le.0) then
-        call bilin_spatial_interpol(rhoeta,field1,induv,dz1out,dz2out,nzmax)
-      else
-        call bilin_spatial_interpol_nest(rhoetan,field1,induv,dz1out,dz2out,nzmax)
-      endif
-      call temp_interpol(field1(1),field1(2),output)
-  end select
-
-end subroutine interpol_partoutput_val_eta
-
-subroutine interpol_partoutput_val_meter(fieldname,output,j)
-
-!* PRIVATE FUNCTION *
-
-  integer, intent(in)         :: j          ! particle number
-  character(2), intent(in)    :: fieldname  ! input field to interpolate over
-  real, intent(inout)         :: output
-  real                        :: field1(2)
-
-  if (int(dz1out).eq.-1) then
-    call find_z_level_meters(real(part(j)%z))
-    call find_vert_vars(height,real(part(j)%z),indz,dz1out,dz2out,lbounds,.false.)
-  endif
-
-  select case(fieldname)
-    case('PR','pr')
-      if (ngrid.le.0) then
-        call bilin_spatial_interpol(prs,field1,indz,dz1out,dz2out,nzmax)
-      else
-        call bilin_spatial_interpol_nest(prsn,field1,indz,dz1out,dz2out,nzmax)
-      endif
-      call temp_interpol(field1(1),field1(2),output)
-    case('PV','pv')
-      if (ngrid.le.0) then
-        call bilin_spatial_interpol(pv,field1,indz,dz1out,dz2out,nzmax)
-      else
-        call bilin_spatial_interpol_nest(pvn,field1,indz,dz1out,dz2out,nzmax)
-      endif
-      call temp_interpol(field1(1),field1(2),output)
-    case('QV','qv')
-      if (ngrid.le.0) then
-        call bilin_spatial_interpol(qv,field1,indz,dz1out,dz2out,nzmax)
-      else
-        call bilin_spatial_interpol_nest(qvn,field1,indz,dz1out,dz2out,nzmax)
-      endif
-      call temp_interpol(field1(1),field1(2),output)
-    case('TT','tt')
-      if (ngrid.le.0) then
-        call bilin_spatial_interpol(tt,field1,indz,dz1out,dz2out,nzmax)
-      else
-        call bilin_spatial_interpol_nest(ttn,field1,indz,dz1out,dz2out,nzmax)
-      endif
-      call temp_interpol(field1(1),field1(2),output)
-    case('UU','uu')
-      if (ngrid.le.0) then
-        call bilin_spatial_interpol(uu,field1,indz,dz1out,dz2out,nzmax)
-      else
-        call bilin_spatial_interpol_nest(uun,field1,indz,dz1out,dz2out,nzmax)
-      endif
-      call temp_interpol(field1(1),field1(2),output)
-    case('VV','vv')
-      if (ngrid.le.0) then
-        call bilin_spatial_interpol(vv,field1,indz,dz1out,dz2out,nzmax)
-      else
-        call bilin_spatial_interpol_nest(vvn,field1,indz,dz1out,dz2out,nzmax)
-      endif
-      call temp_interpol(field1(1),field1(2),output)
-    case('WW','ww')
-      if (ngrid.le.0) then
-        call bilin_spatial_interpol(ww,field1,indz,dz1out,dz2out,nzmax)
-      else
-        call bilin_spatial_interpol_nest(wwn,field1,indz,dz1out,dz2out,nzmax)
-      endif
-      call temp_interpol(field1(1),field1(2),output)
-    case('RH','rh')
-      if (ngrid.le.0) then
-        call bilin_spatial_interpol(rho,field1,indz,dz1out,dz2out,nzmax)
-      else
-        call bilin_spatial_interpol_nest(rhon,field1,indz,dz1out,dz2out,nzmax)
-      endif
-      call temp_interpol(field1(1),field1(2),output)
-  end select
-
-end subroutine interpol_partoutput_val_meter
-
-subroutine interpol_mixinglayer_eta(zt,zteta,rhoa,rhograd)
-
-  real, intent(in)    :: zt,zteta
-  real, intent(inout) :: rhoa,rhograd
-  real                :: dz1w,dz2w,dz1uv,dz2uv,dz1weta,dz2weta
-
-  call find_vert_vars(height,zt,indz,dz1w,dz2w,lbounds,.false.)
-  call find_vert_vars(uvheight,zteta,induv,dz1uv,dz2uv,lbounds_uv,.false.)
-  call find_vert_vars(wheight,zteta,indzeta,dz1weta,dz2weta,lbounds_w,.true.)
-
-  call vert_interpol(wprof(indz),wprof(indzp),dz1w,dz2w,w)
-  call vert_interpol(uprof(induv),uprof(indpuv),dz1uv,dz2uv,u)
-  call vert_interpol(vprof(induv),vprof(indpuv),dz1uv,dz2uv,v)
-  call vert_interpol(rhoprof(induv),rhoprof(indpuv),dz1uv,dz2uv,rhoa)
-  call vert_interpol(rhogradprof(induv),rhogradprof(indpuv),dz1uv,dz2uv,rhograd)
-  call vert_interpol(wprofeta(indzeta),wprofeta(indzpeta),dz1weta,dz2weta,weta)
-
-end subroutine interpol_mixinglayer_eta
-
-subroutine stdev_eta(iw,iuv,iweta)
-
-!* PRIVATE FUNCTION *
-
-  ! Standard deviation of surrounding grid points
-  ! Only used in mesoscale turbulence calculations
-  !***********************************************
-
-  integer,intent(in)  :: iw(2),iuv(2),iweta(2)
-  real :: wsl,wsq,wxaux,usl,usq,uxaux,vsl,vsq,vxaux,wetasl,wetasq,wetaxaux
-  integer             :: n,m
-  real,parameter      :: eps=1.0e-30
-  
-  ! Standard deviations
-  !********************
-  wsl=0.
-  wsq=0.
-  usl=0.
-  usq=0.
-  vsl=0.
-  vsq=0.
-  wetasl=0.
-  wetasq=0.
-
-  if (ngrid.le.0) then ! No nest  
-    do m=1,2
-      do n=1,2
-        call compute_sl_sq(ww,wsl,wsq,iw(n),memind(m),nzmax)
-        call compute_sl_sq(wweta,wetasl,wetasq,iweta(n),memind(m),nzmax)
-        if (ngrid.lt.0) then
-          call compute_sl_sq(uupoleta,usl,usq,iuv(n),memind(m),nzmax)
-          call compute_sl_sq(vvpoleta,vsl,vsq,iuv(n),memind(m),nzmax)
-        else
-          call compute_sl_sq(uueta,usl,usq,iuv(n),memind(m),nzmax)
-          call compute_sl_sq(vveta,vsl,vsq,iuv(n),memind(m),nzmax)
-        endif
-      end do
-    end do
-  else ! Nest
-    do m=1,2
-      do n=1,2
-        call compute_sl_sq_nest(wwn,wsl,wsq,iw(n),memind(m),nzmax)
-        call compute_sl_sq_nest(wwetan,wetasl,wetasq,iweta(n),memind(m),nzmax)
-        call compute_sl_sq_nest(uuetan,usl,usq,iuv(n),memind(m),nzmax)
-        call compute_sl_sq_nest(vvetan,vsl,vsq,iuv(n),memind(m),nzmax)
-      end do
-    end do
-  endif
-
-  call stdev(wsl,wsq,16.,wsig)
-  call stdev(usl,usq,16.,usig)
-  call stdev(vsl,vsq,16.,vsig)
-  call stdev(wetasl,wetasq,16.,wsigeta)
-
-end subroutine stdev_eta
-
-subroutine stdev_meter(iw)
-
-!* PRIVATE FUNCTION *
+#include "int_interpol_wind_eta.f90"
 
-  ! Standard deviation of surrounding grid points
-  ! Only used in mesoscale turbulence calculations
-  !***********************************************
+#include "int_interpol_wind_meter.f90"
 
-  integer,intent(in)  :: iw(2)
-  real                :: wsl,wsq,wxaux,usl,usq,uxaux,vsl,vsq,vxaux
-  integer             :: n,m
-  real,parameter      :: eps=1.0e-30
+#include "int_interpol_partoutput_val_eta.f90"
 
-  ! Standard deviations
-  !********************
-  wsl=0.
-  wsq=0.
-  usl=0.
-  usq=0.
-  vsl=0.
-  vsq=0.
+#include "int_interpol_partoutput_val_meter.f90"
 
-  if (ngrid.le.0) then ! No nest  
-    do m=1,2
-      do n=1,2
-        call compute_sl_sq(ww,wsl,wsq,iw(n),memind(m),nzmax)
-        if (ngrid.lt.0) then
-          call compute_sl_sq(uupol,usl,usq,iw(n),memind(m),nzmax)
-          call compute_sl_sq(vvpol,vsl,vsq,iw(n),memind(m),nzmax)
-        else
-          call compute_sl_sq(uu,usl,usq,iw(n),memind(m),nzmax)
-          call compute_sl_sq(vv,vsl,vsq,iw(n),memind(m),nzmax)
-        endif
-      end do
-    end do
-  else ! Nest
-    do m=1,2
-      do n=1,2
-        call compute_sl_sq_nest(wwn,wsl,wsq,iw(n),memind(m),nzmax)
-        call compute_sl_sq_nest(uun,usl,usq,iw(n),memind(m),nzmax)
-        call compute_sl_sq_nest(vvn,vsl,vsq,iw(n),memind(m),nzmax)
-      end do
-    end do
-  endif
+#include "int_interpol_mixinglayer_eta.f90"
 
-  call stdev(wsl,wsq,16.,wsig)
-  call stdev(usl,usq,16.,usig)
-  call stdev(vsl,vsq,16.,vsig)
+#include "int_stdev_eta.f90"
 
-end subroutine stdev_meter
+#include "int_stdev_meter.f90"
 
 end module interpol_mod
diff --git a/src/mea_mean_dp.f90 b/src/mea_mean_dp.f90
new file mode 100644
index 0000000000000000000000000000000000000000..6471b5578791c128e00536a4fc11f42fed647849
--- /dev/null
+++ b/src/mea_mean_dp.f90
@@ -0,0 +1,54 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+  subroutine mean_dp(x_dp,xm,xs,number)
+
+!*****************************************************************************
+!                                                                            *
+!  This subroutine calculates mean and standard deviation of a given element.*
+!                                                                            *
+!      AUTHOR: Andreas Stohl, 25 January 1994                                *
+!                                                                            *
+!      Double precision version ESO 2016                                     *
+!*****************************************************************************
+!                                                                            *
+! Variables:                                                                 *
+! x_dp(number)        field of input data                                    *
+! xm                  mean                                                   *
+! xs                  standard deviation                                     *
+! number              number of elements of field x_dp                       *
+!                                                                            *
+! Constants:                                                                 *
+! eps                 tiny number                                            *
+!                                                                            *
+!*****************************************************************************
+
+    use par_mod, only: dp
+
+    implicit none
+
+    integer,intent(in) :: number
+    real(dp), intent(in) :: x_dp(number)
+    real(dp), intent(out) ::xm,xs
+    real(dp) :: xl,xq,xaux
+    real(dp),parameter :: eps=1.0e-30
+    integer :: i
+
+    xl=0._dp
+    xq=0._dp
+    do i=1,number
+      xl=xl+x_dp(i)
+      xq=xq+x_dp(i)*x_dp(i)
+    end do
+
+    xm=xl/real(number,kind=dp)
+
+    xaux=xq-xl*xl/real(number,kind=dp)
+
+    if (xaux.lt.eps) then
+      xs=0._dp
+    else
+      xs=sqrt(xaux/real(number-1,kind=dp))
+    endif
+
+  end subroutine mean_dp
diff --git a/src/mea_mean_mixed_dsd.f90 b/src/mea_mean_mixed_dsd.f90
new file mode 100644
index 0000000000000000000000000000000000000000..04b65e630d53def7fb095bda15025efa82daa4cd
--- /dev/null
+++ b/src/mea_mean_mixed_dsd.f90
@@ -0,0 +1,55 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+  subroutine mean_mixed_dsd(x_dp,xm,xs_dp,number)
+
+!*****************************************************************************
+!                                                                            *
+!  This subroutine calculates mean and standard deviation of a given element.*
+!                                                                            *
+!      AUTHOR: Andreas Stohl, 25 January 1994                                *
+!                                                                            *
+!      Mixed precision version ESO 2016 (dp in, sp out, dp out)              *
+!*****************************************************************************
+!                                                                            *
+! Variables:                                                                 *
+! x_dp(number)        field of input data                                    *
+! xm                  mean                                                   *
+! xs_dp               standard deviation                                     *
+! number              number of elements of field x_dp                       *
+!                                                                            *
+! Constants:                                                                 *
+! eps                 tiny number                                            *
+!                                                                            *
+!*****************************************************************************
+
+    use par_mod, only: sp,dp
+
+    implicit none
+
+    integer,intent(in) :: number
+    real(dp), intent(in) :: x_dp(number)
+    real(sp), intent(out) ::xm
+    real(dp), intent(out) ::xs_dp
+    real(dp) :: xl,xq,xaux
+    real(dp),parameter :: eps=1.0e-30_dp
+    integer :: i
+
+    xl=0._dp
+    xq=0._dp
+    do i=1,number
+      xl=xl+x_dp(i)
+      xq=xq+x_dp(i)*x_dp(i)
+    end do
+
+    xm=real(xl,kind=sp)/real(number,kind=sp)
+
+    xaux=xq-xl*xl/real(number,kind=dp)
+
+    if (xaux.lt.eps) then
+      xs_dp=0._dp
+    else
+      xs_dp=sqrt(xaux/real(number-1,kind=dp))
+    endif
+
+  end subroutine mean_mixed_dsd
diff --git a/src/mea_mean_mixed_dss.f90 b/src/mea_mean_mixed_dss.f90
new file mode 100644
index 0000000000000000000000000000000000000000..534fa71ca16f1232494abe342400824d2374fb32
--- /dev/null
+++ b/src/mea_mean_mixed_dss.f90
@@ -0,0 +1,54 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+  subroutine mean_mixed_dss(x_dp,xm,xs,number)
+
+!*****************************************************************************
+!                                                                            *
+!  This subroutine calculates mean and standard deviation of a given element.*
+!                                                                            *
+!      AUTHOR: Andreas Stohl, 25 January 1994                                *
+!                                                                            *
+!      Mixed precision version ESO 2016 (dp in, sp out, sp out)              *
+!*****************************************************************************
+!                                                                            *
+! Variables:                                                                 *
+! x_dp(number)        field of input data                                    *
+! xm                  mean                                                   *
+! xs                  standard deviation                                     *
+! number              number of elements of field x_dp                       *
+!                                                                            *
+! Constants:                                                                 *
+! eps                 tiny number                                            *
+!                                                                            *
+!*****************************************************************************
+
+    use par_mod, only: sp,dp
+
+    implicit none
+
+    integer,intent(in) :: number
+    real(dp), intent(in) :: x_dp(number)
+    real(sp), intent(out) ::xm,xs
+    real(sp) :: xl,xq,xaux
+    real(sp),parameter :: eps=1.0e-30
+    integer :: i
+
+    xl=0._sp
+    xq=0._sp
+    do i=1,number
+      xl=xl+real(x_dp(i),kind=sp)
+      xq=xq+real(x_dp(i),kind=sp)*real(x_dp(i),kind=sp)
+    end do
+
+    xm=xl/real(number,kind=sp)
+
+    xaux=xq-xl*xl/real(number,kind=sp)
+
+    if (xaux.lt.eps) then
+      xs=0._sp
+    else
+      xs=sqrt(xaux/real(number-1,kind=sp))
+    endif
+
+  end subroutine mean_mixed_dss
diff --git a/src/mea_mean_sp.f90 b/src/mea_mean_sp.f90
new file mode 100644
index 0000000000000000000000000000000000000000..fdc3f7b92bef9d36c06636f17d1283ddf385c849
--- /dev/null
+++ b/src/mea_mean_sp.f90
@@ -0,0 +1,58 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+  subroutine mean_sp(x_sp,xm,xs,number)
+
+!*****************************************************************************
+!                                                                            *
+!  This subroutine calculates mean and standard deviation of a given element.*
+!                                                                            *
+!      AUTHOR: Andreas Stohl, 25 January 1994                                *
+!                                                                            *
+!      Single precision version ESO 2016                                     *
+!*****************************************************************************
+!                                                                            *
+! Variables:                                                                 *
+! x_sp(number)        field of input data                                    *
+! xm                  mean                                                   *
+! xs                  standard deviation                                     *
+! number              number of elements of field x_sp                       *
+!                                                                            *
+! Constants:                                                                 *
+! eps                 tiny number                                            *
+!                                                                            *
+!*****************************************************************************
+
+    use par_mod, only: sp
+
+    implicit none
+
+    ! integer :: number,i
+    ! real(sp) :: x_sp(number),xm,xs,xl,xq,xaux
+    ! real(sp),parameter :: eps=1.0e-30
+
+    integer,intent(in) :: number
+    real(sp), intent(in) :: x_sp(number)
+    real(sp), intent(out) ::xm,xs
+    real(sp) :: xl,xq,xaux
+    real(sp),parameter :: eps=1.0e-30
+    integer :: i
+
+    xl=0.
+    xq=0.
+    do i=1,number
+      xl=xl+x_sp(i)
+      xq=xq+x_sp(i)*x_sp(i)
+    end do
+
+    xm=xl/real(number,kind=sp)
+
+    xaux=xq-xl*xl/real(number,kind=sp)
+
+    if (xaux.lt.eps) then
+      xs=0.
+    else
+      xs=sqrt(xaux/real(number-1,kind=sp))
+    endif
+
+  end subroutine mean_sp
diff --git a/src/mean_mod.f90 b/src/mean_mod.f90
index c231f4669a82315a4978acf24191c58990bf6b3e..c8b247ec34e5107e393fcb2354c6f2d16b0fe619 100644
--- a/src/mean_mod.f90
+++ b/src/mean_mod.f90
@@ -17,217 +17,12 @@ module mean_mod
 
 contains
 
-  subroutine mean_sp(x_sp,xm,xs,number)
+#include "mea_mean_sp.f90"
 
-!*****************************************************************************
-!                                                                            *
-!  This subroutine calculates mean and standard deviation of a given element.*
-!                                                                            *
-!      AUTHOR: Andreas Stohl, 25 January 1994                                *
-!                                                                            *
-!      Single precision version ESO 2016                                     *
-!*****************************************************************************
-!                                                                            *
-! Variables:                                                                 *
-! x_sp(number)        field of input data                                    *
-! xm                  mean                                                   *
-! xs                  standard deviation                                     *
-! number              number of elements of field x_sp                       *
-!                                                                            *
-! Constants:                                                                 *
-! eps                 tiny number                                            *
-!                                                                            *
-!*****************************************************************************
+#include "mea_mean_dp.f90"
 
-    use par_mod, only: sp
+#include "mea_mean_mixed_dss.f90"
 
-    implicit none
-
-    ! integer :: number,i
-    ! real(sp) :: x_sp(number),xm,xs,xl,xq,xaux
-    ! real(sp),parameter :: eps=1.0e-30
-
-    integer,intent(in) :: number
-    real(sp), intent(in) :: x_sp(number)
-    real(sp), intent(out) ::xm,xs
-    real(sp) :: xl,xq,xaux
-    real(sp),parameter :: eps=1.0e-30
-    integer :: i
-
-    xl=0.
-    xq=0.
-    do i=1,number
-      xl=xl+x_sp(i)
-      xq=xq+x_sp(i)*x_sp(i)
-    end do
-
-    xm=xl/real(number,kind=sp)
-
-    xaux=xq-xl*xl/real(number,kind=sp)
-
-    if (xaux.lt.eps) then
-      xs=0.
-    else
-      xs=sqrt(xaux/real(number-1,kind=sp))
-    endif
-
-  end subroutine mean_sp
-
-  subroutine mean_dp(x_dp,xm,xs,number)
-
-!*****************************************************************************
-!                                                                            *
-!  This subroutine calculates mean and standard deviation of a given element.*
-!                                                                            *
-!      AUTHOR: Andreas Stohl, 25 January 1994                                *
-!                                                                            *
-!      Double precision version ESO 2016                                     *
-!*****************************************************************************
-!                                                                            *
-! Variables:                                                                 *
-! x_dp(number)        field of input data                                    *
-! xm                  mean                                                   *
-! xs                  standard deviation                                     *
-! number              number of elements of field x_dp                       *
-!                                                                            *
-! Constants:                                                                 *
-! eps                 tiny number                                            *
-!                                                                            *
-!*****************************************************************************
-
-    use par_mod, only: dp
-
-    implicit none
-
-    integer,intent(in) :: number
-    real(dp), intent(in) :: x_dp(number)
-    real(dp), intent(out) ::xm,xs
-    real(dp) :: xl,xq,xaux
-    real(dp),parameter :: eps=1.0e-30
-    integer :: i
-
-    xl=0._dp
-    xq=0._dp
-    do i=1,number
-      xl=xl+x_dp(i)
-      xq=xq+x_dp(i)*x_dp(i)
-    end do
-
-    xm=xl/real(number,kind=dp)
-
-    xaux=xq-xl*xl/real(number,kind=dp)
-
-    if (xaux.lt.eps) then
-      xs=0._dp
-    else
-      xs=sqrt(xaux/real(number-1,kind=dp))
-    endif
-
-  end subroutine mean_dp
-
-  subroutine mean_mixed_dss(x_dp,xm,xs,number)
-
-!*****************************************************************************
-!                                                                            *
-!  This subroutine calculates mean and standard deviation of a given element.*
-!                                                                            *
-!      AUTHOR: Andreas Stohl, 25 January 1994                                *
-!                                                                            *
-!      Mixed precision version ESO 2016 (dp in, sp out, sp out)              *
-!*****************************************************************************
-!                                                                            *
-! Variables:                                                                 *
-! x_dp(number)        field of input data                                    *
-! xm                  mean                                                   *
-! xs                  standard deviation                                     *
-! number              number of elements of field x_dp                       *
-!                                                                            *
-! Constants:                                                                 *
-! eps                 tiny number                                            *
-!                                                                            *
-!*****************************************************************************
-
-    use par_mod, only: sp,dp
-
-    implicit none
-
-    integer,intent(in) :: number
-    real(dp), intent(in) :: x_dp(number)
-    real(sp), intent(out) ::xm,xs
-    real(sp) :: xl,xq,xaux
-    real(sp),parameter :: eps=1.0e-30
-    integer :: i
-
-    xl=0._sp
-    xq=0._sp
-    do i=1,number
-      xl=xl+real(x_dp(i),kind=sp)
-      xq=xq+real(x_dp(i),kind=sp)*real(x_dp(i),kind=sp)
-    end do
-
-    xm=xl/real(number,kind=sp)
-
-    xaux=xq-xl*xl/real(number,kind=sp)
-
-    if (xaux.lt.eps) then
-      xs=0._sp
-    else
-      xs=sqrt(xaux/real(number-1,kind=sp))
-    endif
-
-  end subroutine mean_mixed_dss
-
-  subroutine mean_mixed_dsd(x_dp,xm,xs_dp,number)
-
-!*****************************************************************************
-!                                                                            *
-!  This subroutine calculates mean and standard deviation of a given element.*
-!                                                                            *
-!      AUTHOR: Andreas Stohl, 25 January 1994                                *
-!                                                                            *
-!      Mixed precision version ESO 2016 (dp in, sp out, dp out)              *
-!*****************************************************************************
-!                                                                            *
-! Variables:                                                                 *
-! x_dp(number)        field of input data                                    *
-! xm                  mean                                                   *
-! xs_dp               standard deviation                                     *
-! number              number of elements of field x_dp                       *
-!                                                                            *
-! Constants:                                                                 *
-! eps                 tiny number                                            *
-!                                                                            *
-!*****************************************************************************
-
-    use par_mod, only: sp,dp
-
-    implicit none
-
-    integer,intent(in) :: number
-    real(dp), intent(in) :: x_dp(number)
-    real(sp), intent(out) ::xm
-    real(dp), intent(out) ::xs_dp
-    real(dp) :: xl,xq,xaux
-    real(dp),parameter :: eps=1.0e-30_dp
-    integer :: i
-
-    xl=0._dp
-    xq=0._dp
-    do i=1,number
-      xl=xl+x_dp(i)
-      xq=xq+x_dp(i)*x_dp(i)
-    end do
-
-    xm=real(xl,kind=sp)/real(number,kind=sp)
-
-    xaux=xq-xl*xl/real(number,kind=dp)
-
-    if (xaux.lt.eps) then
-      xs_dp=0._dp
-    else
-      xs_dp=sqrt(xaux/real(number-1,kind=dp))
-    endif
-
-  end subroutine mean_mixed_dsd
+#include "mea_mean_mixed_dsd.f90"
 
 end module mean_mod
diff --git a/src/net_close_partoutput_file.f90 b/src/net_close_partoutput_file.f90
new file mode 100644
index 0000000000000000000000000000000000000000..5ebb11e9e9ade5b18c6a6760c5512125dbb4b9b0
--- /dev/null
+++ b/src/net_close_partoutput_file.f90
@@ -0,0 +1,11 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine close_partoutput_file(ncid)
+
+  implicit none
+
+  integer                        :: ncid
+
+  call nf90_err(nf90_close(ncid))
+end subroutine close_partoutput_file
diff --git a/src/net_concoutput_ncf.f90 b/src/net_concoutput_ncf.f90
new file mode 100644
index 0000000000000000000000000000000000000000..7e685384efaef406828b66ff0e92e3dedc02885a
--- /dev/null
+++ b/src/net_concoutput_ncf.f90
@@ -0,0 +1,409 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine concoutput_ncf(itime,outnum,gridtotalunc,wetgridtotalunc,drygridtotalunc)
+
+  !                          i     i          o             o
+  !       o
+  !*****************************************************************************
+  !                                                                            *
+  !     Output of the concentration grid and the receptor concentrations.      *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     24 May 1995                                                            *
+  !                                                                            *
+  !     13 April 1999, Major update: if output size is smaller, dump output in *
+  !                    sparse matrix format; additional output of uncertainty  *
+  !                                                                            *
+  !     05 April 2000, Major update: output of age classes; output for backward*
+  !                    runs is time spent in grid cell times total mass of     *
+  !                    species.                                                *
+  !                                                                            *
+  !     17 February 2002, Appropriate dimensions for backward and forward runs *
+  !                       are now specified in module par_mod                  *
+  !                                                                            *
+  !     June 2006, write grid in sparse matrix with a single write command     *
+  !                in order to save disk space                                 *
+  !                                                                            *
+  !     2008 new sparse matrix format                                          *
+  !                                                                            *
+  !     February 2010, Dominik Brunner, Empa                                   *
+  !                    Adapted for COSMO                                       *
+  !                    Remark: calculation of density could be improved.       *
+  !                    Currently, it is calculated for the lower left corner   *
+  !                    of each output grid cell rather than for its center.    *
+  !                    Furthermore, the average density could be calculated    *
+  !                    from the difference in pressure at the top and bottom   *
+  !                    of each cell rather than by interpolation.              *
+  !                                                                            *
+  !     April 2013, Dominik Brunner, Empa                                      *
+  !                    Adapted for netcdf output                               *
+  !                                                                            *
+  !     2022, Lucie Bakels:                                                    *
+  !           - OpenMP parallelisation                                         *
+  !           - Receptor output to NetCDF instead of binary format             *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! outnum          number of samples                                          *
+  ! ncells          number of cells with non-zero concentrations               *
+  ! sparse          .true. if in sparse matrix format, else .false.            *
+  ! tot_mu          1 for forward, initial mass mixing ration for backw. runs  *
+  !                                                                            *
+  !*****************************************************************************
+
+  use unc_mod, only: gridunc,drygridunc,wetgridunc,drygridunc0,wetgridunc0
+
+  implicit none
+
+  integer, intent(in) :: itime
+  real, intent(in)    :: outnum
+  real(dep_prec),intent(out):: wetgridtotalunc,drygridtotalunc
+  real, intent(out)   :: gridtotalunc
+  real                :: densityoutrecept(maxreceptor),recout(maxreceptor)
+  integer             :: ncid,kp,ks,kz,ix,jy,iix,jjy,kzz,kzzm1,ngrid
+  integer             :: nage,i,l,jj
+  real                :: tot_mu(maxspec,maxpointspec_act)
+  real                :: halfheight,dz,dz1,dz2
+  real                :: xl,yl,xlrot,ylrot,zagnd,zagndprev
+  real(dep_prec)      :: auxgrid(nclassunc)
+  real(dep_prec)      :: gridtotal,gridsigmatotal
+  real(dep_prec)      :: wetgridtotal,wetgridsigmatotal
+  real(dep_prec)      :: drygridtotal,drygridsigmatotal
+  ! real(sp)            :: gridtotal,gridsigmatotal
+  ! real(sp)            :: wetgridtotal,wetgridsigmatotal
+  ! real(sp)            :: drygridtotal,drygridsigmatotal
+
+  real, parameter     :: weightair=28.97
+
+  eps=nxmax/3.e5
+
+  ! open output file
+  call nf90_err(nf90_open(trim(ncfname), nf90_write, ncid))
+
+  ! write time
+  tpointer = tpointer + 1
+  call nf90_err(nf90_put_var( ncid, timeID, itime, (/ tpointer /)))
+
+  ! For forward simulations, output fields have dimension MAXSPEC,
+  ! for backward simulations, output fields have dimension MAXPOINT.
+  ! Thus, make loops either about nspec, or about numpoint
+  !*****************************************************************
+
+  if (ldirect.eq.1) then
+    do ks=1,nspec
+      do kp=1,maxpointspec_act
+        tot_mu(ks,kp)=1.0
+      end do
+    end do
+  else
+    do ks=1,nspec
+      do kp=1,maxpointspec_act
+        tot_mu(ks,kp)=xmass(kp,ks)
+      end do
+    end do
+  endif
+
+
+  gridtotal=0.
+  gridsigmatotal=0.
+  gridtotalunc=0.
+  wetgridtotal=0._dep_prec
+  wetgridsigmatotal=0._dep_prec
+  wetgridtotalunc=0._dep_prec
+  drygridtotal=0._dep_prec
+  drygridsigmatotal=0._dep_prec
+  drygridtotalunc=0._dep_prec
+
+  !*******************************************************************
+  ! Compute air density:
+  ! brd134: we now take into account whether we are in the mother or in
+  !    a nested domain (before only from mother domain)
+  ! Determine center altitude of output layer, and interpolate density
+  ! data to that altitude
+  !*******************************************************************
+!$OMP PARALLEL PRIVATE(halfheight,kzz,dz1,dz2,dz,xl,yl,ngrid,iix,jjy, &
+!$OMP kz,ix,jy,l,ks,kp,nage,auxgrid) REDUCTION(+:wetgridtotal,wetgridsigmatotal, &
+!$OMP drygridtotal,drygridsigmatotal,gridtotal,gridsigmatotal)
+!$OMP DO
+  do kz=1,numzgrid
+    if (kz.eq.1) then
+      halfheight=outheight(1)/2.
+    else
+      halfheight=(outheight(kz)+outheight(kz-1))/2.
+    endif
+    do kzz=2,nz
+      if ((height(kzz-1).lt.halfheight).and. &
+           (height(kzz).gt.halfheight)) exit
+    end do
+    kzz=max(min(kzz,nz),2)
+    dz1=halfheight-height(kzz-1)
+    dz2=height(kzz)-halfheight
+    dz=dz1+dz2
+
+    do jy=0,numygrid-1
+      do ix=0,numxgrid-1
+        xl=outlon0+real(ix)*dxout
+        yl=outlat0+real(jy)*dyout
+        ! grid index in mother domain
+        xl=(xl-xlon0)/dx
+        yl=(yl-ylat0)/dx
+
+        ngrid=0
+        do jj=numbnests,1,-1
+          if ( xl.gt.xln(jj)+eps .and. xl.lt.xrn(jj)-eps .and. &
+                 yl.gt.yln(jj)+eps .and. yl.lt.yrn(jj)-eps ) then
+            ngrid=jj
+            exit
+          end if
+        end do
+
+        if (ngrid.eq.0) then
+          iix=max(min(nint(xl),nxmin1),0) ! if output grid cell is outside mother domain
+          jjy=max(min(nint(yl),nymin1),0)
+
+          densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,memind(2))*dz1+ &
+            rho(iix,jjy,kzz-1,memind(2))*dz2)/dz
+        else
+          xl=(xl-xln(ngrid))*xresoln(ngrid)
+          yl=(yl-yln(ngrid))*yresoln(ngrid)
+          iix=max(min(nint(xl),nxn(ngrid)-1),0)
+          jjy=max(min(nint(yl),nyn(ngrid)-1),0)
+
+          densityoutgrid(ix,jy,kz)=(rhon(iix,jjy,kzz,memind(2), ngrid)*dz1+ &
+            rhon(iix,jjy,kzz-1,memind(2), ngrid)*dz2)/dz
+        endif
+      end do
+    end do
+  end do
+!$OMP END DO NOWAIT
+
+  ! brd134: for receptor points no option for nests yet to specify density
+  !    and also altitude zreceptor not considered yet (needs revision)
+  if (numreceptor.gt.0) then
+!$OMP DO
+    do i=1,numreceptor
+      xl=xreceptor(i)
+      yl=yreceptor(i)
+      iix=max(min(nint(xl),nxmin1),0)
+      jjy=max(min(nint(yl),nymin1),0)
+      densityoutrecept(i)=rho(iix,jjy,1,memind(2))
+    end do
+!$OMP END DO NOWAIT
+  endif
+
+  ! Output is different for forward and backward simulations
+  if (ldirect.eq.1) then
+!$OMP DO
+    do kz=1,numzgrid
+      do jy=0,numygrid-1
+         do ix=0,numxgrid-1
+            factor3d(ix,jy,kz)=1.e12/volume(ix,jy,kz)/outnum
+         end do
+      end do
+    end do
+!$OMP END DO
+  else
+!$OMP DO
+    do kz=1,numzgrid
+      do jy=0,numygrid-1
+         do ix=0,numxgrid-1
+            factor3d(ix,jy,kz)=real(abs(loutaver))/outnum
+         end do
+      end do
+    end do
+!$OMP END DO
+  endif
+
+  !*********************************************************************
+  ! Determine the standard deviation of the mean concentration or mixing
+  ! ratio (uncertainty of the output) and the dry and wet deposition
+  !*********************************************************************
+
+
+  do ks=1,nspec
+
+    do kp=1,maxpointspec_act
+      do nage=1,nageclass
+!$OMP DO
+        do jy=0,numygrid-1
+          do ix=0,numxgrid-1
+
+            ! WET DEPOSITION
+            if ((wetdep).and.(ldirect.gt.0)) then
+              if (mpi_mode.gt.0) then
+                do l=1,nclassunc
+                  auxgrid(l)=wetgridunc0(ix,jy,ks,kp,l,nage)
+                end do
+              else
+                do l=1,nclassunc
+                  auxgrid(l)=wetgridunc(ix,jy,ks,kp,l,nage)
+                end do
+              end if
+              call mean(auxgrid,wetgrid(ix,jy), &
+                   wetgridsigma(ix,jy),nclassunc)
+              ! Multiply by number of classes to get total concentration
+              wetgrid(ix,jy)=wetgrid(ix,jy)*real(nclassunc,kind=sp)
+              wetgridtotal=wetgridtotal+wetgrid(ix,jy)
+              ! Calculate standard deviation of the mean
+              wetgridsigma(ix,jy)= &
+                   wetgridsigma(ix,jy)* &
+                   sqrt(real(nclassunc,kind=dep_prec))
+              wetgridsigmatotal=wetgridsigmatotal+ &
+                   wetgridsigma(ix,jy)
+            endif
+
+            ! DRY DEPOSITION
+            if ((drydep).and.(ldirect.gt.0)) then
+              if (mpi_mode.gt.0) then
+                do l=1,nclassunc
+                  auxgrid(l)=drygridunc0(ix,jy,ks,kp,l,nage)
+                end do
+              else
+                do l=1,nclassunc
+                  auxgrid(l)=drygridunc(ix,jy,ks,kp,l,nage)
+                end do
+              end if
+              call mean(auxgrid,drygrid(ix,jy), &
+                   drygridsigma(ix,jy),nclassunc)
+              ! Multiply by number of classes to get total concentration
+              drygrid(ix,jy)=drygrid(ix,jy)*real(nclassunc,kind=sp)
+              drygridtotal=drygridtotal+drygrid(ix,jy)
+              ! Calculate standard deviation of the mean
+              drygridsigma(ix,jy)= &
+                   drygridsigma(ix,jy)* &
+                   sqrt(real(nclassunc, kind=dep_prec))
+              drygridsigmatotal=drygridsigmatotal+ &
+                   drygridsigma(ix,jy)
+            endif
+
+            ! CONCENTRATION OR MIXING RATIO
+            do kz=1,numzgrid
+              do l=1,nclassunc
+                auxgrid(l)=gridunc(ix,jy,kz,ks,kp,l,nage)
+              end do
+              call mean(auxgrid,grid(ix,jy,kz), &
+                   gridsigma(ix,jy,kz),nclassunc)
+              ! Multiply by number of classes to get total concentration
+              grid(ix,jy,kz)= &
+                   grid(ix,jy,kz)*real(nclassunc)
+              gridtotal=gridtotal+grid(ix,jy,kz)
+              ! Calculate standard deviation of the mean
+              gridsigma(ix,jy,kz)= &
+                   gridsigma(ix,jy,kz)* &
+                   sqrt(real(nclassunc))
+              gridsigmatotal=gridsigmatotal+ &
+                   gridsigma(ix,jy,kz)
+            end do
+          end do
+        end do
+!$OMP END DO
+  !       print*,gridtotal,maxpointspec_act
+
+        !*******************************************************************
+        ! Generate output: may be in concentration (ng/m3) or in mixing
+        ! ratio (ppt) or both
+        ! Output the position and the values alternated multiplied by
+        ! 1 or -1, first line is number of values, number of positions
+        ! For backward simulations, the unit is seconds, stored in grid_time
+        !*******************************************************************
+
+        ! Concentration output
+        !*********************
+!$OMP SINGLE
+        if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
+
+          ! Wet deposition
+          if ((ldirect.eq.1).and.(WETDEP)) then
+            call nf90_err(nf90_put_var(ncid,wdspecID(ks),1.e12*&
+                 wetgrid(0:numxgrid-1,0:numygrid-1)/area(0:numxgrid-1,0:numygrid-1),&
+                 (/ 1,1,tpointer,kp,nage /), (/ numxgrid,numygrid,1,1,1 /)))
+          end if
+
+          ! Dry deposition
+          if ((ldirect.eq.1).and.(DRYDEP)) then
+            call nf90_err(nf90_put_var(ncid,ddspecID(ks),1.e12*&
+                 drygrid(0:numxgrid-1,0:numygrid-1)/area(0:numxgrid-1,0:numygrid-1),&
+                 (/ 1,1,tpointer,kp,nage /), (/ numxgrid,numygrid,1,1,1 /)))
+          endif
+
+          ! Concentrations
+          call nf90_err(nf90_put_var(ncid,specID(ks),grid(0:numxgrid-1,0:numygrid-1,&
+             1:numzgrid)*factor3d(0:numxgrid-1,0:numygrid-1,1:numzgrid)/tot_mu(ks,kp),&
+               (/ 1,1,1,tpointer,kp,nage /), (/ numxgrid,numygrid,numzgrid,1,1,1 /) ))
+
+        endif !  concentration output
+
+        ! Mixing ratio output
+        !********************
+
+        if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
+
+          ! Wet deposition
+          if ((ldirect.eq.1).and.(WETDEP)) then
+            call nf90_err(nf90_put_var(ncid,wdspecID(ks),1.e12*&
+                 wetgrid(0:numxgrid-1,0:numygrid-1)/area(0:numxgrid-1,0:numygrid-1),&
+                 (/ 1,1,tpointer,kp,nage /), (/ numxgrid,numygrid,1,1,1 /)))
+
+          endif
+
+          ! Dry deposition
+          if ((ldirect.eq.1).and.(DRYDEP)) then
+            call nf90_err(nf90_put_var(ncid,ddspecID(ks),1.e12*&
+                 drygrid(0:numxgrid-1,0:numygrid-1)/area(0:numxgrid-1,0:numygrid-1),&
+                 (/ 1,1,tpointer,kp,nage /), (/ numxgrid,numygrid,1,1,1 /)))
+          endif
+
+          ! Mixing ratios
+          call nf90_err(nf90_put_var(ncid,specIDppt(ks),weightair/weightmolar(ks)*&
+               grid(0:numxgrid-1,0:numygrid-1,1:numzgrid)*&
+               factor3d(0:numxgrid-1,0:numygrid-1,1:numzgrid)/&
+               densityoutgrid(0:numxgrid-1,0:numygrid-1,1:numzgrid),&
+               (/ 1,1,1,tpointer,kp,nage /), (/ numxgrid,numygrid,numzgrid,1,1,1 /)))
+
+        endif ! output for ppt
+!$OMP END SINGLE
+!$OMP BARRIER
+      end do
+    end do
+
+  end do
+!$OMP END PARALLEL
+
+  if (gridtotal.gt.0.) gridtotalunc=gridsigmatotal/gridtotal
+  if (wetgridtotal.gt.0.) wetgridtotalunc=wetgridsigmatotal/ &
+       wetgridtotal
+  if (drygridtotal.gt.0.) drygridtotalunc=real(drygridsigmatotal/ &
+       drygridtotal, kind=dep_prec)
+
+  ! Dump of receptor concentrations
+
+  if (numreceptor.ge.1) then
+    if (iout.eq.2 .or. iout.eq.3) then
+      do ks=1,nspec
+        recout(:)=1.e12*creceptor(:,ks)/outnum*weightair/weightmolar(ks)/densityoutrecept(:)
+        call nf90_err(nf90_put_var(ncid,recpptvID(ks),recout(1:numreceptor),(/ tpointer,1 /),(/ 1,numreceptor /)))
+      end do
+    endif
+
+    ! Dump of receptor concentrations
+
+    if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
+      do ks=1,nspec
+        recout(:)=1.e12*creceptor(:,ks)/outnum
+        call nf90_err(nf90_put_var(ncid,recconcID(ks),recout(1:numreceptor),(/ tpointer,1 /),(/ 1,numreceptor /)))
+      end do
+    endif
+  endif
+
+  ! Close netCDF file
+  !**************************
+  call nf90_err(nf90_close(ncid))
+
+  ! Reinitialization of grid
+  !*************************
+  if (numreceptor.gt.0) creceptor(1:numreceptor,1:nspec) = 0.
+  gridunc(:,:,:,1:nspec,:,:,1:nageclass) = 0.
+end subroutine concoutput_ncf
diff --git a/src/net_concoutput_ncf_nest.f90 b/src/net_concoutput_ncf_nest.f90
new file mode 100644
index 0000000000000000000000000000000000000000..8ace4c49a33f6b39e0bb51080b9308c192e29dfc
--- /dev/null
+++ b/src/net_concoutput_ncf_nest.f90
@@ -0,0 +1,334 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine concoutput_ncf_nest(itime,outnum)
+  !                               i     i
+  !*****************************************************************************
+  !                                                                            *
+  !     Output of the concentration grid and the receptor concentrations.      *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     24 May 1995                                                            *
+  !                                                                            *
+  !     13 April 1999, Major update: if output size is smaller, dump output in *
+  !                    sparse matrix format; additional output of uncertainty  *
+  !                                                                            *
+  !     05 April 2000, Major update: output of age classes; output for backward*
+  !                    runs is time spent in grid cell times total mass of     *
+  !                    species.                                                *
+  !                                                                            *
+  !     17 February 2002, Appropriate dimensions for backward and forward runs *
+  !                    are now specified in module par_mod                     *
+  !                                                                            *
+  !     June 2006, write grid in sparse matrix with a single write command     *
+  !                    in order to save disk space                             *
+  !                                                                            *
+  !     2008 new sparse matrix format                                          *
+  !                                                                            *
+  !     19 February 2010, Dominik Brunner, Empa: Adapted for COSMO             *
+  !                                                                            *
+  !     April 2013, Dominik Brunner, Empa                                      *
+  !                    Adapted for netcdf output                               *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! itime           current simulation time                                    *
+  ! outnum          number of samples                                          *
+  !                                                                            *
+  !*****************************************************************************
+
+  use unc_mod, only: griduncn,drygriduncn,wetgriduncn,drygriduncn0,wetgriduncn0
+
+  implicit none
+
+  integer, intent(in) :: itime
+  real, intent(in)    :: outnum
+  real                :: densityoutrecept(maxreceptor)
+  integer             :: ncid,kp,ks,kz,ix,jy,iix,jjy,kzz,kzzm1,ngrid
+  integer             :: nage,i,l, jj
+  real                :: tot_mu(maxspec,maxpointspec_act)
+  real                :: halfheight,dz,dz1,dz2
+  real                :: xl,yl,xlrot,ylrot,zagnd,zagndprev
+  real(dep_prec)      :: auxgrid(nclassunc)
+  real                :: gridtotal
+  real, parameter     :: weightair=28.97
+
+  eps=nxmax/3.e5
+
+  ! open output file
+  call nf90_err(nf90_open(trim(ncfnamen), nf90_write, ncid))
+
+  ! write time (do not increase time counter here, done in main output domain)
+  call nf90_err(nf90_put_var( ncid, timeID, itime, (/ tpointer /)))
+
+  ! For forward simulations, output fields have dimension MAXSPEC,
+  ! for backward simulations, output fields have dimension MAXPOINT.
+  ! Thus, make loops either about nspec, or about numpoint
+  !*****************************************************************
+
+  if (ldirect.eq.1) then
+    do ks=1,nspec
+      do kp=1,maxpointspec_act
+        tot_mu(ks,kp)=1.0
+      end do
+    end do
+  else
+    do ks=1,nspec
+      do kp=1,maxpointspec_act
+        tot_mu(ks,kp)=xmass(kp,ks)
+      end do
+    end do
+  endif
+
+  gridtotal=0.
+  !*******************************************************************
+  ! Compute air density:
+  ! brd134: we now take into account whether we are in the mother or in
+  !    a nested domain (before only from mother domain)
+  ! Determine center altitude of output layer, and interpolate density
+  ! data to that altitude
+  !*******************************************************************
+!$OMP PARALLEL PRIVATE(halfheight,kzz,dz1,dz2,dz,xl,yl,ngrid,iix,jjy, &
+!$OMP kz,ix,jy,l,ks,kp,nage,auxgrid) REDUCTION(+:gridtotal)
+!$OMP DO
+  do kz=1,numzgrid
+    if (kz.eq.1) then
+      halfheight=outheight(1)/2.
+    else
+      halfheight=(outheight(kz)+outheight(kz-1))/2.
+    endif
+    do kzz=2,nz
+      if ((height(kzz-1).lt.halfheight).and. &
+           (height(kzz).gt.halfheight)) exit
+    end do
+    kzz=max(min(kzz,nz),2)
+    dz1=halfheight-height(kzz-1)
+    dz2=height(kzz)-halfheight
+    dz=dz1+dz2
+
+    do jy=0,numygridn-1
+      do ix=0,numxgridn-1
+        xl=outlon0n+real(ix)*dxoutn
+        yl=outlat0n+real(jy)*dyoutn
+        xl=(xl-xlon0)/dx
+        yl=(yl-ylat0)/dy
+
+        ngrid=0
+        do jj=numbnests,1,-1
+          if ( xl.gt.xln(jj)+eps .and. xl.lt.xrn(jj)-eps .and. &
+                 yl.gt.yln(jj)+eps .and. yl.lt.yrn(jj)-eps ) then
+            ngrid=jj
+            exit
+          end if
+        end do
+
+        if (ngrid.eq.0) then
+          iix=max(min(nint(xl),nxmin1),0)
+          jjy=max(min(nint(yl),nymin1),0)
+
+          densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,memind(2))*dz1+ &
+             rho(iix,jjy,kzz-1,memind(2))*dz2)/dz
+        else
+          xl=(xl-xln(ngrid))*xresoln(ngrid)
+          yl=(yl-yln(ngrid))*yresoln(ngrid)
+          iix=max(min(nint(xl),nxn(ngrid)-1),0)
+          jjy=max(min(nint(yl),nyn(ngrid)-1),0)
+          densityoutgrid(ix,jy,kz)=(rhon(iix,jjy,kzz,memind(2), ngrid)*dz1+ &
+             rhon(iix,jjy,kzz-1,memind(2), ngrid)*dz2)/dz
+        endif
+
+      end do
+    end do
+  end do
+!$OMP END DO NOWAIT
+
+  if (numreceptor.gt.0) then
+!$OMP DO
+     do i=1,numreceptor
+       xl=xreceptor(i)
+       yl=yreceptor(i)
+       iix=max(min(nint(xl),nxmin1),0)
+       jjy=max(min(nint(yl),nymin1),0)
+       densityoutrecept(i)=rho(iix,jjy,1,memind(2))
+     end do
+!$OMP END DO NOWAIT
+  endif
+
+  ! Output is different for forward and backward simulations
+  if (ldirect.eq.1) then
+!$OMP DO
+     do kz=1,numzgrid
+        do jy=0,numygridn-1
+           do ix=0,numxgridn-1
+              factor3d(ix,jy,kz)=1.e12/volumen(ix,jy,kz)/outnum
+           end do
+        end do
+     end do
+!$OMP END DO
+  else
+!$OMP DO
+     do kz=1,numzgrid
+        do jy=0,numygridn-1
+           do ix=0,numxgridn-1
+              factor3d(ix,jy,kz)=real(abs(loutaver))/outnum
+           end do
+        end do
+     end do
+!$OMP END DO
+  endif
+
+  !*********************************************************************
+  ! Determine the standard deviation of the mean concentration or mixing
+  ! ratio (uncertainty of the output) and the dry and wet deposition
+  !*********************************************************************
+
+  do ks=1,nspec
+
+    do kp=1,maxpointspec_act
+      do nage=1,nageclass
+!$OMP DO
+        do jy=0,numygridn-1
+          do ix=0,numxgridn-1
+            ! WET DEPOSITION
+            if ((WETDEP).and.(ldirect.gt.0)) then
+              if (mpi_mode.gt.0) then
+                do l=1,nclassunc
+                  auxgrid(l)=wetgriduncn0(ix,jy,ks,kp,l,nage)
+                end do
+              else
+                do l=1,nclassunc
+                  auxgrid(l)=wetgriduncn(ix,jy,ks,kp,l,nage)
+                end do
+              end if
+              call mean(auxgrid,wetgrid(ix,jy), &
+                   wetgridsigma(ix,jy),nclassunc)
+              ! Multiply by number of classes to get total concentration
+              wetgrid(ix,jy)=wetgrid(ix,jy)*real(nclassunc)
+              ! Calculate standard deviation of the mean
+              wetgridsigma(ix,jy)= &
+                   wetgridsigma(ix,jy)* &
+                   sqrt(real(nclassunc,kind=dep_prec))
+            endif
+
+            ! DRY DEPOSITION
+            if ((DRYDEP).and.(ldirect.gt.0)) then
+              if (mpi_mode.gt.0) then
+                do l=1,nclassunc
+                  auxgrid(l)=drygriduncn0(ix,jy,ks,kp,l,nage)
+                end do
+              else
+                do l=1,nclassunc
+                  auxgrid(l)=drygriduncn(ix,jy,ks,kp,l,nage)
+                end do
+              end if
+              call mean(auxgrid,drygrid(ix,jy), &
+                   drygridsigma(ix,jy),nclassunc)
+              ! Multiply by number of classes to get total concentration
+              drygrid(ix,jy)=drygrid(ix,jy)*real(nclassunc)
+              ! Calculate standard deviation of the mean
+              drygridsigma(ix,jy)= &
+                   drygridsigma(ix,jy)* &
+                   sqrt(real(nclassunc,kind=dep_prec))
+            endif
+
+            ! CONCENTRATION OR MIXING RATIO
+            do kz=1,numzgrid
+              do l=1,nclassunc
+                auxgrid(l)=griduncn(ix,jy,kz,ks,kp,l,nage)
+              end do
+              call mean(auxgrid,grid(ix,jy,kz), &
+                   gridsigma(ix,jy,kz),nclassunc)
+              ! Multiply by number of classes to get total concentration
+              grid(ix,jy,kz)= &
+                   grid(ix,jy,kz)*real(nclassunc)
+              gridtotal=gridtotal+grid(ix,jy,kz)
+              ! Calculate standard deviation of the mean
+              gridsigma(ix,jy,kz)= &
+                   gridsigma(ix,jy,kz)* &
+                   sqrt(real(nclassunc))
+            end do
+          end do
+        end do
+!$OMP END DO
+  !       print*,gridtotal,maxpointspec_act
+
+        !*******************************************************************
+        ! Generate output: may be in concentration (ng/m3) or in mixing
+        ! ratio (ppt) or both
+        ! Output the position and the values alternated multiplied by
+        ! 1 or -1, first line is number of values, number of positions
+        ! For backward simulations, the unit is seconds, stored in grid_time
+        !*******************************************************************
+
+        ! Concentration output
+        !*********************
+!$OMP SINGLE
+        if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
+
+          ! Wet deposition
+          if ((ldirect.eq.1).and.(WETDEP)) then
+             call nf90_err(nf90_put_var(ncid,wdspecIDn(ks),1.e12*&
+                  wetgrid(0:numxgridn-1,0:numygridn-1)/arean(0:numxgridn-1,0:numygridn-1),&
+                  (/ 1,1,tpointer,kp,nage /), (/ numxgridn,numygridn,1,1,1 /)))
+          endif
+
+          ! Dry deposition
+          if ((ldirect.eq.1).and.(DRYDEP)) then
+             call nf90_err(nf90_put_var(ncid,ddspecIDn(ks),1.e12*&
+                  drygrid(0:numxgridn-1,0:numygridn-1)/arean(0:numxgridn-1,0:numygridn-1),&
+                  (/ 1,1,tpointer,kp,nage /), (/ numxgridn,numygridn,1,1,1 /)))
+          endif
+
+          ! Concentrations
+          call nf90_err(nf90_put_var(ncid,specIDn(ks),grid(0:numxgridn-1,0:numygridn-1,&
+             1:numzgrid)*factor3d(0:numxgridn-1,0:numygridn-1,1:numzgrid)/tot_mu(ks,kp),&
+               (/ 1,1,1,tpointer,kp,nage /), (/ numxgridn,numygridn,numzgrid,1,1,1 /)))
+
+        endif !  concentration output
+
+        ! Mixing ratio output
+        !********************
+
+        if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
+
+          ! Wet deposition
+          if ((ldirect.eq.1).and.(WETDEP)) then
+             call nf90_err(nf90_put_var(ncid,wdspecIDn(ks),1.e12*&
+                  wetgrid(0:numxgridn-1,0:numygridn-1)/arean(0:numxgridn-1,0:numygridn-1),&
+                  (/ 1,1,tpointer,kp,nage /), (/ numxgridn,numygridn,1,1,1 /)))
+          endif
+
+          ! Dry deposition
+          if ((ldirect.eq.1).and.(DRYDEP)) then
+             call nf90_err(nf90_put_var(ncid,ddspecIDn(ks),1.e12*&
+                  drygrid(0:numxgridn-1,0:numygridn-1)/arean(0:numxgridn-1,0:numygridn-1),&
+                  (/ 1,1,tpointer,kp,nage /), (/ numxgridn,numygridn,1,1,1 /)))
+          endif
+
+          ! Mixing ratios
+          call nf90_err(nf90_put_var(ncid,specIDnppt(ks),weightair/weightmolar(ks)*&
+               grid(0:numxgridn-1,0:numygridn-1,1:numzgrid)*&
+               factor3d(0:numxgridn-1,0:numygridn-1,1:numzgrid)/&
+               densityoutgrid(0:numxgridn-1,0:numygridn-1,1:numzgrid),&
+               (/ 1,1,1,tpointer,kp,nage /), (/ numxgridn,numygridn,numzgrid,1,1,1 /)))
+
+        endif ! output for ppt
+!$OMP END SINGLE
+!$OMP BARRIER
+      end do
+    end do
+
+  end do
+!$OMP END PARALLEL
+  ! Close netCDF file
+  !**************************
+  call nf90_err(nf90_close(ncid))
+
+  ! Reinitialization of grid
+  !*************************
+
+  if (numreceptor.gt.0) creceptor(1:numreceptor,1:nspec) = 0.
+  griduncn(:,:,:,1:nspec,:,:,1:nageclass) = 0.
+end subroutine concoutput_ncf_nest
diff --git a/src/net_concoutput_sfc_ncf.f90 b/src/net_concoutput_sfc_ncf.f90
new file mode 100644
index 0000000000000000000000000000000000000000..0707d5294f9e03b379802e70dfec3f7256d62e14
--- /dev/null
+++ b/src/net_concoutput_sfc_ncf.f90
@@ -0,0 +1,16 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine concoutput_sfc_ncf(itime,outnum,gridtotalunc,wetgridtotalunc,drygridtotalunc)
+
+  use unc_mod, only: gridunc,drygridunc,wetgridunc,drygridunc0,wetgridunc0
+
+  implicit none
+
+  integer, intent(in) :: itime
+  real, intent(in)    :: outnum
+  real(sp), intent(out)   :: gridtotalunc
+  real(dep_prec), intent(out)   :: wetgridtotalunc,drygridtotalunc
+
+  print*,'Netcdf output for surface only not yet implemented'
+end subroutine concoutput_sfc_ncf
diff --git a/src/net_concoutput_sfc_ncf_nest.f90 b/src/net_concoutput_sfc_ncf_nest.f90
new file mode 100644
index 0000000000000000000000000000000000000000..3be79faccb56b4f16895a2888d3654b006e114d6
--- /dev/null
+++ b/src/net_concoutput_sfc_ncf_nest.f90
@@ -0,0 +1,12 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine concoutput_sfc_ncf_nest(itime,outnum)
+
+  implicit none
+
+  integer, intent(in) :: itime
+  real, intent(in)    :: outnum
+
+  print*,'Netcdf output for surface only not yet implemented'
+end subroutine concoutput_sfc_ncf_nest
diff --git a/src/net_nf90_err.f90 b/src/net_nf90_err.f90
new file mode 100644
index 0000000000000000000000000000000000000000..47bfa8347166be6fe51ead54ec4207634901bd78
--- /dev/null
+++ b/src/net_nf90_err.f90
@@ -0,0 +1,14 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine nf90_err(status)
+  !****************************************************************
+  ! netcdf error message handling
+  !****************************************************************
+  implicit none
+  integer, intent (in) :: status
+   if(status /= nf90_noerr) then
+      print *, trim(nf90_strerror(status))
+      stop 'Stopped'
+    end if
+end subroutine nf90_err
diff --git a/src/net_open_partinit_file.f90 b/src/net_open_partinit_file.f90
new file mode 100644
index 0000000000000000000000000000000000000000..c466fd613c523ad2f63efe860341ce70ddc7a0ba
--- /dev/null
+++ b/src/net_open_partinit_file.f90
@@ -0,0 +1,12 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine open_partinit_file(ncid)!,irelease)
+
+  implicit none
+
+  integer, intent(inout)         :: ncid
+  !integer, intent(in)            :: irelease
+
+  call nf90_err(nf90_open(trim(ncfname_partinit), nf90_write, ncid))
+end subroutine open_partinit_file
diff --git a/src/net_open_partoutput_file.f90 b/src/net_open_partoutput_file.f90
new file mode 100644
index 0000000000000000000000000000000000000000..45f5395e83b82359c44f0824786677435daee82c
--- /dev/null
+++ b/src/net_open_partoutput_file.f90
@@ -0,0 +1,12 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine open_partoutput_file(ncid)!,irelease)
+
+  implicit none
+
+  integer, intent(inout)         :: ncid
+  !integer, intent(in)            :: irelease
+
+  call nf90_err(nf90_open(trim(ncfname_part), nf90_write, ncid))
+end subroutine open_partoutput_file
diff --git a/src/net_output_units.f90 b/src/net_output_units.f90
new file mode 100644
index 0000000000000000000000000000000000000000..60f7488bc0e96abb2ef5838864350665485f1d4e
--- /dev/null
+++ b/src/net_output_units.f90
@@ -0,0 +1,38 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine output_units(units)
+  implicit none
+  character(len=15), intent(out) :: units
+  if (ldirect.eq.1) then
+     ! forward simulation
+     if (ind_source.eq.1) then
+        if (ind_receptor.eq.1) then
+           units = 'ng m-3'   ! hes the kg in Tab1 is only indicating the units of the relase not the output
+        else
+           units = 'ng kg-1'
+        endif
+     else
+        if (ind_receptor.eq.1) then
+           units = 'ng m-3'
+        else
+           units = 'ng kg-1'
+        endif
+     endif
+  else
+     ! backward simulation
+     if (ind_source.eq.1) then
+        if (ind_receptor.eq.1) then
+           units = 's'
+        else
+           units = 's m3 kg-1'
+        endif
+     else
+        if (ind_receptor.eq.1) then
+           units = 's kg m-3'
+        else
+           units = 's'
+        endif
+     endif
+  endif
+end subroutine output_units
diff --git a/src/net_particle_initialpos.f90 b/src/net_particle_initialpos.f90
new file mode 100644
index 0000000000000000000000000000000000000000..d51106aa4ac3c46bcdc19d426b033c9fd08abafe
--- /dev/null
+++ b/src/net_particle_initialpos.f90
@@ -0,0 +1,140 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine particle_initialpos(itime,idate,itime_start,idate_start)
+
+  !*****************************************************************************
+  !                                                                            *
+  !   This subroutine creates an initial particle positions and properties     *
+  !   NetCDF file: partinit_xxx.nc                                             *
+  !   The release time, release number and positions, together with all fields *
+  !   specified in the PARTOPTIONS option file will saved.                     *
+  !                                                                            *
+  !   Author: L. Bakels 2022                                                   *
+  !                                                                            *
+  !*****************************************************************************
+
+  implicit none
+
+  integer, intent(in) :: itime,idate,itime_start,idate_start
+  ! integer, intent(in) :: irelease
+  integer             :: cache_size,ncid,j,totpart,np
+  integer             :: partDimID
+  character(len=11)   :: fprefix
+  character(len=3)    :: anspec,arelease
+  character           :: adate*8,atime*6,adate_start*8,atime_start*6,timeunit*32
+  character(len=255)  :: fname_partoutput
+  real                :: fillval
+
+  write(adate,'(i8.8)') idate
+  write(atime,'(i6.6)') itime
+  write(adate_start,'(i8.8)') idate_start
+  write(atime_start,'(i6.6)') itime_start
+  ! write(arelease, '(i3.3)') irelease
+  fprefix = 'partinit_'!rel'//arelease//'_'
+
+  fname_partoutput = path(2)(1:length(2))//trim(fprefix)//adate//atime//'.nc'
+  !ncfname_part(irelease) = fname_partoutput
+  ncfname_partinit = fname_partoutput
+
+  call nf90_err(nf90_create(trim(fname_partoutput), cmode = nf90_hdf5, ncid = ncid))!, &
+    ! cache_size = cache_size))
+
+  ! create dimensions:
+  !*************************
+
+  ! particle
+  partinitpointer=0
+  call nf90_err(nf90_def_dim(ncid, 'particle', nf90_unlimited, partDimID))
+
+  ! create variables
+  !*************************
+
+  ! particles
+  call nf90_err(nf90_def_var(ncid, 'particle', nf90_int, (/ partDimID/), partIDi))
+  call nf90_err(nf90_put_att(ncid, partIDi, 'long_name', 'particle index'))
+
+  fillval = -1.
+  ! time
+  timeunit = 'seconds since '//adate_start(1:4)//'-'//adate_start(5:6)// &
+     '-'//adate_start(7:8)//' '//atime_start(1:2)//':'//atime_start(3:4)
+
+  call write_to_file(ncid,'time',nf90_int,(/ partDimID /),tIDi,(/ 1 /), &
+    timeunit,.false.,'time','time of release')
+  call nf90_err(nf90_put_att(ncid, tIDi, 'axis', 't'))
+  call nf90_err(nf90_put_att(ncid, tIDi, 'calendar', 'proleptic_gregorian'))
+  call nf90_err(nf90_put_att(ncid, tIDi, 'description', 'time of release'))
+
+  ! lon
+  call write_to_file(ncid,'longitude',nf90_float,(/ partDimID /),lonIDi,(/ 1 /), &
+    'degrees_east',.false.,'longitude','longitude in degree east')
+  call nf90_err(nf90_put_att(ncid, lonIDi, 'axis', 'Lon'))
+  call nf90_err(nf90_put_att(ncid, lonIDi, 'description', 'longitude of particles'))
+
+  ! lat
+  call write_to_file(ncid,'latitude',nf90_float,(/ partDimID /),latIDi,(/ 1 /), &
+    'degrees_north',.false.,'latitude','latitude in degree north')
+  call nf90_err(nf90_put_att(ncid, latIDi, 'axis', 'Lat'))
+  call nf90_err(nf90_put_att(ncid, latIDi, 'description', 'latitude of particles'))
+
+  ! height
+  call write_to_file(ncid,'height',nf90_float,(/ partDimID /),levIDi,(/ 1 /), &
+   'meters',.true.,'height','height above ground')
+
+  ! release
+  call write_to_file(ncid,'release',nf90_int,(/ partDimID /),relIDi,(/ 1 /), &
+   '',.true.,'release','particle release')
+
+  do np=1,num_partopt
+    if (.not. partopt(np)%print) cycle
+    select case(partopt(np)%name)
+      case ('PV') ! Potential vorticity
+        call write_to_file(ncid,'pv',nf90_float,(/ partDimID /),pvIDi,(/ 1 /), &
+          'pvu',.false.,'potential_vorticity','potential vorticity')
+      case ('PR') ! Pressure
+        call write_to_file(ncid,'pr',nf90_float,(/ partDimID /),prIDi,(/ 1 /), &
+          'Pa',.false.,'pressure','pressure')
+      case ('QV') ! Specific humidity
+        call write_to_file(ncid,'qv',nf90_float,(/ partDimID /),qvIDi,(/ 1 /), &
+          '',.false.,'specific_humidity','specific humidity')
+      case ('RH') ! Density
+        call write_to_file(ncid,'rho',nf90_float,(/ partDimID /),rhoIDi,(/ 1 /), &
+          'kg/m3',.true.,'density','density')
+      case ('TT') ! Temperature
+        call write_to_file(ncid,'temperature',nf90_float,(/ partDimID /),ttIDi,(/ 1 /), &
+          'K',.true.,'temperature','temperature')
+      case ('UU')
+        call write_to_file(ncid,'u',nf90_float,(/ partDimID /),uIDi,(/ 1 /), &
+          'm/s',.false.,'u','longitudinal velocity')
+      case ('VV')
+        call write_to_file(ncid,'v',nf90_float,(/ partDimID /),vIDi,(/ 1 /), &
+          'm/s',.false.,'v','latitudinal velocity')
+      case ('WW')
+        call write_to_file(ncid,'w',nf90_float,(/ partDimID /),wIDi,(/ 1 /), &
+          'm/s',.false.,'w','vertical velocity')
+      case ('MA')
+        do j=1,nspec
+          ! Masses
+          write(anspec, '(i3.3)') j
+          call write_to_file(ncid,'mass'//anspec,nf90_float,(/ partDimID /),massIDi(j), &
+            (/ 1 /),'kg',.true.,'mass'//anspec,'mass for nspec'//anspec)
+        end do
+      case ('TO')
+        call write_to_file(ncid,'topo',nf90_float,(/ partDimID /),topoIDi,(/ 1 /), &
+          'meters',.false.,'topography','topography above sealevel')
+      case ('TR')
+        call write_to_file(ncid,'tr',nf90_float,(/ partDimID /),trIDi,(/ 1 /), &
+          'meters',.true.,'htropo','height above ground of tropopause')
+      case ('HM') ! Mixing layer height
+        call write_to_file(ncid,'hmix',nf90_float,(/ partDimID /),hmixIDi,(/ 1 /), &
+          'meters',.true.,'hmix','height above ground of mixing layer')
+      case default
+        cycle
+    end select
+  end do
+
+  ! moves the file from define to data mode
+  call nf90_err(nf90_enddef(ncid))
+
+  call nf90_err(nf90_close(ncid))
+end subroutine particle_initialpos
diff --git a/src/net_partinit_ncf.f90 b/src/net_partinit_ncf.f90
new file mode 100644
index 0000000000000000000000000000000000000000..7c31761c89f18cd8a0bdf2ae06296db2bee61e49
--- /dev/null
+++ b/src/net_partinit_ncf.f90
@@ -0,0 +1,66 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine partinit_ncf(itime,field,fieldname,imass,ncid)
+
+  !*****************************************************************************
+  !                                                                            *
+  !   This subroutine saves properties chosen by the user in PARTOPTIONS       *
+  !   to a NetCDF file created in particle_initialpos.                         *
+  !   This happens whenever a new particle is spawned.                         *
+  !                                                                            *
+  !   Author: L. Bakels 2022                                                   *
+  !                                                                            *
+  !*****************************************************************************
+
+  implicit none
+
+  integer, intent(in)            :: itime,imass
+  real, intent(in)               :: field(:)
+  character(2), intent(in)       :: fieldname  ! input field to interpolate over
+  integer, allocatable           :: partindices(:)
+  integer                        :: ncid,newpart,j,iend
+
+  newpart = partinitpointer - (partinitpointer1-1)
+
+  select case(fieldname)
+    case('TO') ! Topography
+      call nf90_err(nf90_put_var(ncid,topoIDi,field(partinitpointer1:partinitpointer), &
+        (/ partinitpointer1 /),(/ newpart /)))
+    case('PV') ! Potential vorticity
+      call nf90_err(nf90_put_var(ncid,pvIDi,field(partinitpointer1:partinitpointer), &
+        (/ partinitpointer1 /),(/ newpart /)))
+    case('PR') ! Pressure
+      call nf90_err(nf90_put_var(ncid,prIDi,field(partinitpointer1:partinitpointer), &
+        (/ partinitpointer1 /),(/ newpart /)))
+    case('QV') ! Specific humidity
+      call nf90_err(nf90_put_var(ncid,qvIDi,field(partinitpointer1:partinitpointer), &
+        (/ partinitpointer1 /),(/ newpart /)))
+    case('RH') ! Air density
+      call nf90_err(nf90_put_var(ncid,rhoIDi,field(partinitpointer1:partinitpointer), &
+        (/ partinitpointer1 /),(/ newpart /)))
+    case('UU') ! Longitudinal velocity
+      call nf90_err(nf90_put_var(ncid,uIDi,field(partinitpointer1:partinitpointer), &
+        (/ partinitpointer1 /),(/ newpart /)))
+    case('VV') ! Latitudinal velocity
+      call nf90_err(nf90_put_var(ncid,vIDi,field(partinitpointer1:partinitpointer), &
+        (/ partinitpointer1 /),(/ newpart /)))
+    case('WW') ! Vertical velocity
+      call nf90_err(nf90_put_var(ncid,wIDi,field(partinitpointer1:partinitpointer), &
+        (/ partinitpointer1 /),(/ newpart /)))
+    case('TT') ! Temperature
+      call nf90_err(nf90_put_var(ncid,ttIDi,field(partinitpointer1:partinitpointer), &
+        (/ partinitpointer1 /),(/ newpart /)))
+    case('MA') ! Mass
+      call nf90_err(nf90_put_var(ncid,massIDi(imass),field(partinitpointer1:partinitpointer), &
+        (/ partinitpointer1 /),(/ newpart /)))
+    case('TR') ! Tropopause
+      call nf90_err(nf90_put_var(ncid,trIDi,field(partinitpointer1:partinitpointer), &
+        (/ partinitpointer1 /),(/ newpart /)))
+    case('HM') ! Mixing height
+      call nf90_err(nf90_put_var(ncid,hmixIDi,field(partinitpointer1:partinitpointer), &
+        (/ partinitpointer1 /),(/ newpart /)))
+    case default
+      return
+  end select
+end subroutine partinit_ncf
diff --git a/src/net_partoutput_ncf.f90 b/src/net_partoutput_ncf.f90
new file mode 100644
index 0000000000000000000000000000000000000000..19a5b54c876c65b0ae15bc5be258adabb693b7d8
--- /dev/null
+++ b/src/net_partoutput_ncf.f90
@@ -0,0 +1,156 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine partoutput_ncf(itime,field,fieldname,imass,ncid)
+
+
+  !*****************************************************************************
+  !                                                                            *
+  !   Writing a field from PARTOPTIONS to partoutput_xxx.nc created in         *
+  !   writeheader_partoutput                                                   *
+  !                                                                            *
+  !   Author: L. Bakels 2021                                                   *
+  !                                                                            *
+  !*****************************************************************************
+
+  implicit none
+
+  integer, intent(in)            :: itime,imass
+  real, intent(in)               :: field(:)
+  character(2), intent(in)       :: fieldname  ! input field to interpolate over
+  integer, allocatable           :: partindices(:)
+  integer                        :: ncid,newpart,j
+  ! ! open output file
+  ! call nf90_err(nf90_open(trim(ncfname_part), nf90_write, ncid))
+  select case(fieldname)
+    case('TI')
+      ! write time
+      tpointer_part = tpointer_part + 1
+      call nf90_err(nf90_put_var(ncid, timeIDpart, itime, (/ tpointer_part /)))
+    case('PA')
+      newpart = numpart - ppointer_part
+
+      if (tpointer_part.eq.1) then
+        allocate ( partindices(numpart) )
+        do j=1,numpart
+          partindices(j)=j
+        end do
+
+        call nf90_err(nf90_put_var(ncid, partID,partindices, (/ 1 /),(/ numpart /)))
+
+        deallocate (partindices)
+
+        ppointer_part = numpart
+
+      else if (newpart.ge.0) then
+
+        allocate ( partindices(newpart) )
+        do j=1,newpart
+          partindices(j)=j+ppointer_part
+        end do
+
+        call nf90_err(nf90_put_var(ncid, partID,partindices, (/ ppointer_part+1 /),(/ newpart /)))
+
+        deallocate (partindices)
+
+        ppointer_part = numpart
+      endif
+    case('LO') ! Longitude
+      call nf90_err(nf90_put_var(ncid,lonIDpart,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
+    case('lo') ! Longitude averaged
+      call nf90_err(nf90_put_var(ncid,lonavIDpart,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
+    case('LA') ! Latitude
+      call nf90_err(nf90_put_var(ncid,latIDpart,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
+    case('la') ! Latitude averaged
+      call nf90_err(nf90_put_var(ncid,latavIDpart,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
+    case('ZZ') ! Height
+      call nf90_err(nf90_put_var(ncid,levIDpart,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
+    case('zz') ! Height averaged
+      call nf90_err(nf90_put_var(ncid,levavIDpart,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
+    case('IT') ! Itramem (not in use atm)
+      call nf90_err(nf90_put_var(ncid,itramemID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
+    case('TO') ! Topography
+      if (mdomainfill.ge.1) then
+        if (topo_written.eqv..false.) call nf90_err(nf90_put_var(ncid,topoID,oro(0:nx-1,0:ny-1), (/ 1,1 /),(/ nx,ny /)))
+        topo_written=.true.
+      else
+        call nf90_err(nf90_put_var(ncid,topoID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
+      endif
+    case('to') ! topography averaged
+      call nf90_err(nf90_put_var(ncid,topoavID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
+    case('PV') ! Potential vorticity
+      call nf90_err(nf90_put_var(ncid,pvID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
+    case('pv') ! Potential vorticity averaged
+      call nf90_err(nf90_put_var(ncid,pvavID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
+    case('PR') ! Pressure
+      call nf90_err(nf90_put_var(ncid,prID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
+    case('pr') ! Pressure averaged
+      call nf90_err(nf90_put_var(ncid,pravID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
+    case('QV') ! Specific humidity
+      call nf90_err(nf90_put_var(ncid,qvID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
+    case('qv') ! Specific humidity averaged
+      call nf90_err(nf90_put_var(ncid,qvavID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
+    case('RH') ! Air density
+      call nf90_err(nf90_put_var(ncid,rhoID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
+    case('rh') ! Air density averaged
+      call nf90_err(nf90_put_var(ncid,rhoavID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
+    case('UU') ! Longitudinal velocity
+      call nf90_err(nf90_put_var(ncid,uID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
+    case('uu') ! Longitudinal velocity averaged
+      call nf90_err(nf90_put_var(ncid,uavID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
+    case('VV') ! Latitudinal velocity
+      call nf90_err(nf90_put_var(ncid,vID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
+    case('vv') ! Latitudinal velocity averaged
+      call nf90_err(nf90_put_var(ncid,vavID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
+    case('WW') ! Vertical velocity
+      call nf90_err(nf90_put_var(ncid,wID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
+    case('ww') ! Vertical velocity averaged
+      call nf90_err(nf90_put_var(ncid,wavID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
+    case('VS') ! Settling velocity
+      call nf90_err(nf90_put_var(ncid,vsetID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
+    case('vs') ! Settling velocity averaged
+      call nf90_err(nf90_put_var(ncid,vsetavID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
+    case('HM') ! Mixing height
+      if (mdomainfill.ge.1) then
+        call nf90_err(nf90_put_var(ncid,hmixID,hmix(0:nx-1,0:ny-1,1,memind(1)), &
+          (/ tpointer_part,1,1 /),(/ 1,nx,ny /)))
+      else
+        call nf90_err(nf90_put_var(ncid,hmixID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
+      endif
+    case('hm') ! Mixing height averaged
+      call nf90_err(nf90_put_var(ncid,hmixavID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
+    case('TR') ! Tropopause
+      if (mdomainfill.ge.1) then
+        call nf90_err(nf90_put_var(ncid,trID,tropopause(0:nx-1,0:ny-1,1,memind(1)), &
+          (/ tpointer_part,1,1 /),(/ 1,nx,ny /)))
+      else
+        call nf90_err(nf90_put_var(ncid,trID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
+      endif
+    case('tr') ! Tropopause averaged
+      call nf90_err(nf90_put_var(ncid,travID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
+    case('TT') ! Temperature
+      call nf90_err(nf90_put_var(ncid,ttID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
+    case('tt') ! Temperature averaged
+      call nf90_err(nf90_put_var(ncid,ttavID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
+    case('MA') ! Mass
+      if ((mdomainfill.ge.1).and.(imass.eq.1)) then
+        if (mass_written.eqv..false.) call nf90_err(nf90_put_var(ncid=ncid,varid=massID(1),values=field(1)))
+        mass_written=.true.
+      else
+        call nf90_err(nf90_put_var(ncid,massID(imass),field, (/ tpointer_part,1 /),(/ 1,numpart /)))
+      endif
+    case('ma') ! Mass averaged
+      if ((mdomainfill.ge.1).and.(imass.eq.1)) then
+        if (mass_written.eqv..false.) call nf90_err(nf90_put_var(ncid=ncid,varid=massavID(1),values=field(1)))
+        massav_written=.true.
+      else
+        call nf90_err(nf90_put_var(ncid,massavID(imass),field, (/ tpointer_part,1 /),(/ 1,numpart /)))
+      endif
+    case('WD') ! Cumulative mass of wet deposition
+      call nf90_err(nf90_put_var(ncid,wdID(imass),field, (/ tpointer_part,1 /),(/ 1,numpart /)))
+    case('DD') ! Cumulative mass of wet deposition
+      call nf90_err(nf90_put_var(ncid,ddID(imass),field, (/ tpointer_part,1 /),(/ 1,numpart /)))
+  end select
+
+  ! call nf90_err(nf90_close(ncid))
+end subroutine partoutput_ncf
diff --git a/src/net_read_grid_id.f90 b/src/net_read_grid_id.f90
new file mode 100644
index 0000000000000000000000000000000000000000..f5a668673b7fbee466bcd1da290f0b31050f7e1a
--- /dev/null
+++ b/src/net_read_grid_id.f90
@@ -0,0 +1,62 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine read_grid_id(lnest)
+
+  implicit none
+  logical, intent(in) :: lnest
+
+  integer :: ncid,i
+  character(len=3)            :: anspec
+
+  if (.not. lnest) then
+    ! open output file
+    call nf90_err(nf90_open(trim(ncfname), nf90_write, ncid))
+
+    call nf90_err(nf90_inq_varid(ncid=ncid,name='time',varid=timeID))
+
+    do i = 1,nspec
+      write(anspec,'(i3.3)') i
+
+      if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
+        call nf90_err(nf90_inq_varid(ncid=ncid,name='spec'//anspec//'_mr',varid=specID(i)))
+      endif
+      if ((iout.eq.2).or.(iout.eq.3)) then
+        call nf90_err(nf90_inq_varid(ncid=ncid,name='spec'//anspec//'_pptv',varid=specIDppt(i)))
+      endif
+      if ((ldirect.eq.1).and.(wetdep)) then
+        call nf90_err(nf90_inq_varid(ncid=ncid,name='WD_spec'//anspec,varid=wdspecID(i)))
+      endif
+      if ((ldirect.eq.1).and.(drydep)) then
+        call nf90_err(nf90_inq_varid(ncid=ncid,name='DD_spec'//anspec,varid=ddspecID(i)))
+      endif
+    end do
+
+  else
+
+    ! open output file
+    call nf90_err(nf90_open(trim(ncfnamen), nf90_write, ncid))
+
+    call nf90_err(nf90_inq_varid(ncid=ncid,name='time',varid=timeIDn))
+
+    do i = 1,nspec
+      write(anspec,'(i3.3)') i
+
+      if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
+        call nf90_err(nf90_inq_varid(ncid=ncid,name='spec'//anspec//'_mr',varid=specIDn(i)))
+      endif
+      if ((iout.eq.2).or.(iout.eq.3)) then
+        call nf90_err(nf90_inq_varid(ncid=ncid,name='spec'//anspec//'_pptv',varid=specIDnppt(i)))
+      endif
+      if ((ldirect.eq.1).and.(wetdep)) then
+        call nf90_err(nf90_inq_varid(ncid=ncid,name='WD_spec'//anspec,varid=wdspecIDn(i)))
+      endif
+      if ((ldirect.eq.1).and.(drydep)) then
+        call nf90_err(nf90_inq_varid(ncid=ncid,name='DD_spec'//anspec,varid=ddspecIDn(i)))
+      endif
+    end do
+  endif
+
+  call nf90_err(nf90_close(ncid))
+
+end subroutine read_grid_id
diff --git a/src/net_read_init_cond_nc.f90 b/src/net_read_init_cond_nc.f90
new file mode 100644
index 0000000000000000000000000000000000000000..463c485ba2e26a8576d2337b7ac864d84c0862ff
--- /dev/null
+++ b/src/net_read_init_cond_nc.f90
@@ -0,0 +1,298 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine read_init_cond_nc()
+
+  !*****************************************************************************
+  !                                                                            *
+  !   IPIN=3: starting a run from a user defined initial particle conditions,  *
+  !           more on how to create such a file can be found in the manual     *
+  !   IPIN=4: restarting a run, while also reading in the initial particle     *
+  !           conditions                                                       *
+  !                                                                            *
+  !   Author: L. Bakels 2022                                                   *
+  !                                                                            *
+  !*****************************************************************************
+
+  use random_mod
+  use particle_mod
+  use date_mod
+  use coord_ec_mod
+  use readoptions_mod
+  use drydepo_mod
+
+  implicit none
+
+  integer             :: ncidend,tIDend,pIDend,tempIDend,stat
+  integer             :: plen,tend,i,j,release_max,nsp
+  integer             :: zkind
+  real                :: totmass,cun
+  integer,allocatable, dimension (:) :: specnum_rel,numpoint_max
+  real,allocatable,dimension(:,:) :: mass_temp
+  real,allocatable,dimension(:) :: vsh,fracth,schmih
+
+  integer :: idummy = -8
+
+  if (mquasilag.ne.0) then
+    write(*,*) 'Combination of ipin, netcdf partoutput, and mquasilag!=0 does not work yet'
+    stop
+  endif
+
+  ! Open part_ic.nc file
+  call nf90_err(nf90_open(trim(path(2)(1:length(2))//'part_ic.nc'), mode=NF90_NOWRITE,ncid=ncidend))
+
+  ! allocate with maxspec for first input loop
+  allocate(specnum_rel(maxspec),stat=stat)
+  if (stat.ne.0) write(*,*)'ERROR: could not allocate specnum_rel'
+
+  ! How many species are contained in each particle?
+  call nf90_err(nf90_inquire_attribute(ncid=ncidend,name='nspecies',varid=NF90_GLOBAL))
+  call nf90_err(nf90_get_att(ncid=ncidend,varid=NF90_GLOBAL,name='nspecies',values=nspec))
+
+  ! Which species?
+  call nf90_err(nf90_inquire_attribute(ncid=ncidend,name='species',varid=NF90_GLOBAL))
+  call nf90_err(nf90_get_att(ncid=ncidend,varid=NF90_GLOBAL,name='species',values=specnum_rel(1:nspec)))
+
+  ! Get the particle dimension
+  call nf90_err(nf90_inq_dimid(ncid=ncidend,name='particle',dimid=pIDend))
+  call nf90_err(nf90_inquire_dimension(ncid=ncidend,dimid=pIDend,len=plen))
+
+  ! Now spawn the correct number of particles
+  write(*,*) 'Npart:',plen
+  call alloc_particles( plen )
+  ! allocate temporary mass array
+  allocate(mass_temp(plen,nspec))
+
+  ! And give them the correct positions
+  ! Longitude
+  call nf90_err(nf90_inq_varid(ncid=ncidend,name='longitude',varid=tempIDend))
+  call nf90_err(nf90_get_var(ncid=ncidend,varid=tempIDend,values=part(:)%xlon, &
+    start=(/ 1 /),count=(/ plen /)))
+  part(:)%xlon=(part(:)%xlon-xlon0)/dx
+  ! Latitude
+  call nf90_err(nf90_inq_varid(ncid=ncidend,name='latitude',varid=tempIDend))
+  call nf90_err(nf90_get_var(ncid=ncidend,varid=tempIDend,values=part(:)%ylat, &
+    start=(/ 1 /),count=(/ plen /)))
+  part(:)%ylat=(part(:)%ylat-ylat0)/dx
+  ! Height
+  call nf90_err(nf90_inq_varid(ncid=ncidend,name='height',varid=tempIDend))
+  call nf90_err(nf90_get_var(ncid=ncidend,varid=tempIDend,values=part(:)%z, &
+    start=(/ 1 /),count=(/ plen /)))
+  ! Spawning time
+  call nf90_err(nf90_inq_varid(ncid=ncidend,name='time',varid=tempIDend))
+  call nf90_err(nf90_get_var(ncid=ncidend,varid=tempIDend,values=part(:)%tstart, &
+    start=(/ 1 /),count=(/ plen /)))
+  ! Mass
+  call nf90_err(nf90_inq_varid(ncid=ncidend,name='mass',varid=tempIDend))
+  call nf90_err(nf90_get_var(ncid=ncidend,varid=tempIDend,values=mass_temp, &
+    start=(/ 1,1 /),count=(/ plen,nspec /)))
+  do nsp=1,nspec
+    part(:)%mass(nsp)=mass_temp(1:plen,nsp)
+  end do
+  deallocate(mass_temp)
+  ! Release
+  call nf90_err(nf90_inq_varid(ncid=ncidend,name='release',varid=tempIDend))
+  call nf90_err(nf90_get_var(ncid=ncidend,varid=tempIDend,values=part(:)%npoint, &
+    start=(/ 1 /),count=(/ plen /)))
+  ! ! Species
+  ! call nf90_err(nf90_inq_varid(ncid=ncidend,name='species',varid=tempIDend))
+  ! call nf90_err(nf90_get_var(ncid=ncidend,varid=tempIDend,values=part(:)%species, &
+  !   start=(/ 1 /),count=(/ plen /)))
+
+  ! Count number of releases
+  numpoint=1
+  allocate(numpoint_max(plen),stat=stat)
+  numpoint_max=0
+  release_max=0
+
+  l1: do i=1,plen
+    l2: do j=1,numpoint
+      if (part(i)%npoint.eq.numpoint_max(numpoint)) then
+        cycle l1
+      endif
+    end do l2
+    numpoint = numpoint+1
+    numpoint_max(numpoint)=part(i)%npoint
+    if (part(i)%npoint.gt.release_max) release_max=part(i)%npoint
+  end do l1
+
+  allocate(kindz(numpoint),stat=stat)
+  kindz=-1
+  if (stat.ne.0) write(*,*)'ERROR: could not allocate kindz'
+  ! Above sea-level or ground?
+  call nf90_err(nf90_inquire_attribute(ncid=ncidend,name='kindz',varid=NF90_GLOBAL))
+  call nf90_err(nf90_get_att(ncid=ncidend,varid=NF90_GLOBAL,name='kindz',values=zkind))
+  kindz=zkind
+  do nsp=1,nspec
+   if ((kindz(nsp).le.0).or.(kindz(nsp).ge.4)) then
+      write(*,*) 'ERROR: kindz should be an integer between 1 and 3, not', kindz(nsp)
+      stop
+   endif
+  end do
+
+  if (ioutputforeachrelease.eq.1) then
+    maxpointspec_act=numpoint
+  else
+    maxpointspec_act=1
+  endif
+
+  if (release_max.gt.numpoint) then
+    write(*,*) "WARNING: release numbers in part_ic.nc are not consecutive:", &
+      release_max, "is larger than the total number of releases:", numpoint, &
+      " Releases will be renumbered."
+
+    do j=1,numpoint
+      do i=1,plen
+        if (part(i)%npoint.eq.numpoint_max(j)) then
+          part(i)%npoint=numpoint_max(j)
+        endif
+      end do
+    end do
+  endif
+  deallocate(numpoint_max)
+
+  allocate(xmass(numpoint,nspec), npart(numpoint),ireleasestart(numpoint),ireleaseend(numpoint))
+  xmass=0
+  npart=0
+  ireleasestart=-1
+  ireleaseend=-1
+  do i=1,plen
+    do j=1,numpoint
+      do nsp=1,nspec
+        xmass(j,nsp) = xmass(j,nsp)+part(i)%mass(nsp)
+      end do
+      if (part(i)%npoint.eq.j) then
+        npart(j)=npart(j)+1
+        if ((ireleasestart(j).gt.part(i)%tstart).or.(ireleasestart(j).eq.-1)) ireleasestart(j)=part(i)%tstart
+        if ((ireleaseend(j).le.part(i)%tstart).or.(ireleaseend(j).eq.-1)) ireleaseend(j)=part(i)%tstart
+      endif
+    end do
+  end do
+  if ((iout.eq.4).or.(iout.eq.5)) then
+    write(*,*) "ERROR: IPIN=3 or IPIN=4, using the part_ic.nc file, is not possible in combination with plume", &
+      "computations (IOUT=4 or 5)."
+    stop
+  endif
+
+  part(:)%idt=part(:)%tstart
+  do i=1,plen
+    part(i)%nclass=min(int(ran1(idummy,0)*real(nclassunc))+1, &
+         nclassunc)
+    part(i)%mass_init=part(i)%mass
+    ! Activate particles that are alive from the start of the simulation
+    if (part(i)%tstart.eq.0) then
+      call spawn_particle(0,i)
+    endif
+  end do
+  write(*,FMT='(A,ES14.7)') ' Total mass to be released:', sum(xmass(1:numpoint,1:nspec))
+  call get_totalpart_num(numpart)
+  numparticlecount=numpart
+  call nf90_err(nf90_close(ncidend))
+
+
+  ! Read species and derive initial conditions
+
+  !now save the information
+  DEP=.false.
+  DRYDEP=.false.
+  WETDEP=.false.
+  OHREA=.false.
+  do nsp=1,maxspec
+    DRYDEPSPEC(nsp)=.false.
+    WETDEPSPEC(nsp)=.false.
+  end do
+
+  do nsp=1,nspec
+    call readspecies(specnum_rel(nsp),nsp)
+    ! Allocate temporary memory necessary for the different diameter bins
+    !********************************************************************
+    allocate(vsh(ndia(nsp)),fracth(ndia(nsp)),schmih(ndia(nsp)))
+
+    ! Molecular weight
+    !*****************
+    if (((iout.eq.2).or.(iout.eq.3)).and.(weightmolar(nsp).lt.0.)) then
+      write(*,*) 'For mixing ratio output, valid molar weight'
+      write(*,*) 'must be specified for all simulated species.'
+      write(*,*) 'Check table SPECIES or choose concentration'
+      write(*,*) 'output instead if molar weight is not known.'
+      stop
+    endif
+
+    ! Radioactive decay
+    !******************
+    decay(nsp)=0.693147/decay(nsp) !conversion half life to decay constant
+
+  ! Dry deposition of gases
+  !************************
+
+    if (reldiff(nsp).gt.0.) rm(nsp)=1./(henry(nsp)/3000.+100.*f0(nsp))    ! mesophyll resistance
+
+  ! Dry deposition of particles
+  !****************************
+
+    vsetaver(nsp)=0.
+    cunningham(nsp)=0.
+    dquer(nsp)=dquer(nsp)*1000000.         ! Conversion m to um
+    if (density(nsp).gt.0.) then         ! Additional parameters
+      call part0(dquer(nsp),dsigma(nsp),density(nsp),ndia(nsp),fracth,schmih,cun,vsh)
+      do j=1,ndia(nsp)
+        fract(nsp,j)=fracth(j)
+        schmi(nsp,j)=schmih(j)
+        vset(nsp,j)=vsh(j)
+        cunningham(nsp)=cunningham(nsp)+cun*fract(nsp,j)
+        vsetaver(nsp)=vsetaver(nsp)-vset(nsp,j)*fract(nsp,j)
+      end do
+      if (lroot) write(*,*) 'Average settling velocity: ',i,vsetaver(nsp)
+    endif
+
+    ! Dry deposition for constant deposition velocity
+    !************************************************
+
+    dryvel(nsp)=dryvel(nsp)*0.01         ! conversion to m/s
+
+    ! Check if wet deposition or OH reaction shall be calculated
+    !***********************************************************
+
+    ! ESO 04.2016 check for below-cloud scavenging (gas or aerosol)
+    if ((dquer(nsp).le.0..and.(weta_gas(nsp).gt.0. .or. wetb_gas(nsp).gt.0.)) .or. &
+         &(dquer(nsp).gt.0. .and. (crain_aero(nsp) .gt. 0. .or. csnow_aero(nsp).gt.0.)))  then
+      WETDEP=.true.
+      WETDEPSPEC(nsp)=.true.
+      if (lroot) then
+        write (*,*) '  Below-cloud scavenging: ON'
+      end if
+    else
+      if (lroot) write (*,*) '  Below-cloud scavenging: OFF'
+    endif
+
+    ! NIK 31.01.2013 + 10.12.2013 + 15.02.2015
+    if (dquer(nsp).gt.0..and.(ccn_aero(nsp).gt.0. .or. in_aero(nsp).gt.0.))  then
+      WETDEP=.true.
+      WETDEPSPEC(nsp)=.true.
+      if (lroot) then
+        write (*,*) '  In-cloud scavenging: ON'
+      end if
+    else
+      if (lroot) write (*,*) '  In-cloud scavenging: OFF'
+    endif
+
+    if (ohcconst(nsp).gt.0.) then
+      OHREA=.true.
+      if (lroot) write (*,*) '  OHreaction switched on: ',ohcconst(nsp),nsp
+    endif
+
+    if ((reldiff(nsp).gt.0.).or.(density(nsp).gt.0.).or.(dryvel(nsp).gt.0.)) then
+      DRYDEP=.true.
+      DRYDEPSPEC(nsp)=.true.
+    endif
+
+    deallocate(vsh,fracth,schmih)
+  end do ! end loop over species
+
+  if (WETDEP.or.DRYDEP) then
+   DEP=.true.
+  endif
+
+
+  deallocate(specnum_rel)
+end subroutine read_init_cond_nc
diff --git a/src/net_read_partpos_ncf.f90 b/src/net_read_partpos_ncf.f90
new file mode 100644
index 0000000000000000000000000000000000000000..786f00d2ced0ec97fa2a2515cc13dbf51408e5a3
--- /dev/null
+++ b/src/net_read_partpos_ncf.f90
@@ -0,0 +1,117 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine read_partpos_ncf(ibtime,ibdate)
+
+  !*****************************************************************************
+  !                                                                            *
+  !   IPIN=2: restarting from a partoutput_xxx.nc file written by a previous   *
+  !           run, depending on what PARTOPTIONS the user has chosen, this     *
+  !           option might not be possible to use                              *
+  !                                                                            *
+  !   Author: L. Bakels 2022                                                   *
+  !                                                                            *
+  !*****************************************************************************
+
+  use random_mod
+  use particle_mod
+  use date_mod
+
+  implicit none
+
+  integer, intent(in) :: ibtime,ibdate
+  integer             :: ncidend,tIDend,pIDend,tempIDend
+  integer             :: tlen,plen,tend,i,j
+  integer             :: idate_start,itime_start
+  character           :: adate*8,atime*6,timeunit*32,adate_start*8,atime_start*6
+  character(len=3)    :: anspec
+  real(kind=dp)       :: julin,julcommand,julpartin
+
+  integer :: idummy = -8
+
+  write(adate,'(i8.8)') ibdate
+  write(atime,'(i6.6)') ibtime
+
+  if (mquasilag.ne.0) then
+    write(*,*) 'Combination of ipin, netcdf partoutput, and mquasilag!=0 does not work yet'
+    stop
+  endif
+
+  ! Open partoutput_end.nc file
+  call nf90_err(nf90_open(trim('partoutput_end.nc'), mode=NF90_NOWRITE,ncid=ncidend))
+
+  ! Take the positions of the particles at the last timestep in the file
+  ! It needs to be the same as given in the COMMAND file, this is arbitrary
+  ! and should be removed in the future for easier use
+
+  ! First get the time dimension
+  call nf90_err(nf90_inq_dimid(ncid=ncidend,name='time',dimid=tIDend))
+  call nf90_err(nf90_inquire_dimension(ncid=ncidend,dimid=tIDend,len=tlen))
+
+  ! Check if the time corresponds to the one given in the COMMAND file
+  call nf90_err(nf90_inq_varid(ncid=ncidend,name='time',varid=tIDend))
+  call nf90_err(nf90_get_att(ncid=ncidend,varid=tIDend,name='units',values=timeunit))
+  call nf90_err(nf90_get_var(ncid=ncidend,varid=tIDend,values=tend,start=(/ tlen /)))!,count=(/ 1 /)))
+  adate_start(1:4) = timeunit(15:18)
+  adate_start(5:6) = timeunit(20:21)
+  adate_start(7:8) = timeunit(23:24)
+  atime_start = '000000'
+  atime_start(1:2) = timeunit(26:27)
+  atime_start(3:4) = timeunit(29:30)
+  read(adate_start,*) idate_start
+  read(atime_start,*) itime_start
+  julin = juldate(idate_start,itime_start)+real(tend,kind=dp)/86400._dp
+  julcommand = juldate(ibdate,ibtime)
+  if (abs(julin-julcommand).gt.1.e-5) then
+    write(*,*) 'ERROR: The given starting time and date do not correspond to'
+    write(*,*) 'the last timestep of partoutput_end.nc:'
+    write(*,*) julin,julcommand,tend
+    stop
+  endif
+
+  ! Then the particle dimension
+  call nf90_err(nf90_inq_dimid(ncid=ncidend,name='particle',dimid=pIDend))
+  call nf90_err(nf90_inquire_dimension(ncid=ncidend,dimid=pIDend,len=plen))
+
+  ! Now spawn the correct number of particles
+  write(*,*) 'Npart:',plen
+  call spawn_particles(0,plen)
+
+  ! And give them the correct positions
+  ! Longitude
+  call nf90_err(nf90_inq_varid(ncid=ncidend,name='longitude',varid=tempIDend))
+  call nf90_err(nf90_get_var(ncid=ncidend,varid=tempIDend,values=part(:)%xlon, &
+    start=(/ tlen, 1 /),count=(/ 1, plen /)))
+  part(:)%xlon=(part(:)%xlon-xlon0)/dx
+  ! Latitude
+  call nf90_err(nf90_inq_varid(ncid=ncidend,name='latitude',varid=tempIDend))
+  call nf90_err(nf90_get_var(ncid=ncidend,varid=tempIDend,values=part(:)%ylat, &
+    start=(/ tlen, 1 /),count=(/ 1, plen /)))
+  part(:)%ylat=(part(:)%ylat-ylat0)/dx
+  ! Height
+  call nf90_err(nf90_inq_varid(ncid=ncidend,name='height',varid=tempIDend))
+  call nf90_err(nf90_get_var(ncid=ncidend,varid=tempIDend,values=part(:)%z, &
+    start=(/ tlen, 1 /),count=(/ 1, plen /)))
+  ! Mass
+  if (mdomainfill.eq.0) then
+    do j=1,nspec
+      write(anspec, '(i3.3)') j
+      call nf90_err(nf90_inq_varid(ncid=ncidend,name='mass'//anspec,varid=tempIDend))
+      call nf90_err(nf90_get_var(ncid=ncidend,varid=tempIDend,values=part(:)%mass(j), &
+        start=(/ tlen, 1 /),count=(/ 1, plen /)))
+    end do
+  endif
+
+  do i=1,plen
+    if (part(i)%z.lt.0) then
+      call terminate_particle(i,0)
+      write(*,*) 'Particle ',i,'is not alive in the restart file.'
+    endif
+    part(i)%nclass=min(int(ran1(idummy,0)*real(nclassunc))+1, &
+         nclassunc)
+    part(i)%idt=mintime
+    part(i)%npoint=1
+  end do
+
+  call nf90_err(nf90_close(ncidend))
+end subroutine read_partpos_ncf
diff --git a/src/net_write_to_file.f90 b/src/net_write_to_file.f90
new file mode 100644
index 0000000000000000000000000000000000000000..99b99b1d59766874b3ca51c40c90e74a134007d8
--- /dev/null
+++ b/src/net_write_to_file.f90
@@ -0,0 +1,35 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine write_to_file(ncid,short_name,xtype,dimids,varid,chunksizes,units,l_positive, &
+  standard_name,long_name)
+
+  !*****************************************************************************
+  !                                                                            *
+  !   Generalised writing data to netcdf file                                  *
+  !                                                                            *
+  !   Author: L. Bakels 2022                                                   *
+  !                                                                            *
+  !*****************************************************************************
+
+  implicit none
+
+  integer, intent(in) :: ncid, xtype
+  integer, intent(out) :: varid
+  character(len = *), intent(in) :: short_name,standard_name,long_name,units
+  integer, dimension(:), intent(in) :: dimids,chunksizes
+  logical, intent(in) :: l_positive
+
+  call nf90_err(nf90_def_var(ncid, short_name, xtype, dimids, varid))
+  call nf90_err(nf90_def_var_chunking(ncid,varid,NF90_CHUNKED,chunksizes=chunksizes))
+  call nf90_err(nf90_def_var_deflate(ncid,varid,shuffle=0,deflate=1,deflate_level=1))
+  call nf90_err(nf90_put_att(ncid, varid, 'units', units))
+  if(xtype.eq.nf90_float) then
+    call nf90_err(nf90_put_att(ncid, varid, '_FillValue', -1.))
+  else
+    call nf90_err(nf90_put_att(ncid, varid, '_FillValue', -1))
+  endif
+  if(l_positive) call nf90_err(nf90_put_att(ncid, varid, 'positive', 'up'))
+  call nf90_err(nf90_put_att(ncid, varid, 'standard_name', standard_name))
+  call nf90_err(nf90_put_att(ncid, varid, 'long_name', long_name))
+end subroutine write_to_file
diff --git a/src/net_writeheader_ncf.f90 b/src/net_writeheader_ncf.f90
new file mode 100644
index 0000000000000000000000000000000000000000..cc583687f117e377c7cea10c7e23948a6e44429e
--- /dev/null
+++ b/src/net_writeheader_ncf.f90
@@ -0,0 +1,492 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine writeheader_ncf(lnest)
+
+  !****************************************************************
+  ! Create netcdf file and write header/metadata information
+  ! lnest = .false. : Create main output file
+  ! lnest = .true.  : Create nested output file
+  !****************************************************************
+  implicit none
+
+  logical, intent(in) :: lnest
+
+  integer :: ncid, sID, wdsID, ddsID
+  integer :: timeDimID, latDimID, lonDimID, levDimID, receptorDimID
+  integer :: nspecDimID, npointDimID, nageclassDimID, ncharDimID, pointspecDimID
+  integer :: tID, lonID, latID, levID, poleID, lageID, oroID, ncharrecDimID
+  integer :: volID, areaID
+  integer :: rellng1ID, rellng2ID, rellat1ID, rellat2ID, relzz1ID, relzz2ID
+  integer :: relcomID, relkindzID, relstartID, relendID, relpartID, relxmassID
+  integer :: nnx, nny
+  integer, dimension(6)       :: dIDs
+  integer, dimension(5)       :: depdIDs
+  character(len=255)          :: fname
+  character(len=15)           :: units
+  character(len=20)           :: fprefix
+  character(len=3)            :: anspec
+  CHARACTER                   :: adate*8,atime*6,timeunit*32
+  !REAL, DIMENSION(1000)       :: coord
+  real, allocatable, dimension(:) :: coord
+
+  integer                     :: cache_size
+  integer, dimension(6)       :: chunksizes
+  integer, dimension(5)       :: dep_chunksizes
+
+  integer                     :: i,ix,jy
+  integer                     :: test_unit
+
+
+  ! Check if output directory exists (the netcdf library will
+  ! otherwise give an error which can look confusing).
+  ! *********************************************************************
+  open(unit=unittmp,file=trim(path(2)(1:length(2)))//'test_dir.txt',status='replace',&
+       &err=100)
+  close (unittmp, status='delete')
+  goto 101
+100 write(*,FMT='(80("#"))')
+  write(*,*) 'ERROR: output directory ', trim(path(2)(1:length(2))), ' does not exist&
+       & (or failed to write there).'
+  write(*,*) 'EXITING'
+  write(*,FMT='(80("#"))')
+  stop
+101 continue
+
+  !************************
+  ! Create netcdf file
+  !************************
+
+  if (ldirect.eq.1) then
+     write(adate,'(i8.8)') ibdate
+     write(atime,'(i6.6)') ibtime
+     fprefix = 'grid_conc_'
+  else
+     write(adate,'(i8.8)') iedate
+     write(atime,'(i6.6)') ietime
+     fprefix = 'grid_time_'
+  endif
+  if (DRYBKDEP) fprefix='grid_drydep_'
+  if (WETBKDEP) fprefix='grid_wetdep_'
+
+  if (lnest) then
+     fname = path(2)(1:length(2))//trim(fprefix)//adate//atime//'_nest.nc'
+     ncfnamen = fname
+     nnx = numxgridn
+     nny = numygridn
+  else
+     fname = path(2)(1:length(2))//trim(fprefix)//adate//atime//'.nc'
+     ncfname = fname
+     nnx = numxgrid
+     nny = numygrid
+  endif
+
+  cache_size = 16 * nnx * nny * numzgrid
+
+  ! If starting from a restart file, new data will be added to the existing grid file
+  if ((ipin.eq.1).or.(ipin.eq.4)) then
+    call read_grid_id(lnest)
+    return
+  endif
+
+  ! setting cache size in bytes. It is set to 4 times the largest data block that is written
+  !   size_type x nx x ny x nz
+  ! create file
+  call nf90_err(nf90_create(trim(fname), cmode = nf90_hdf5, ncid = ncid, &
+    cache_size = cache_size))
+
+  ! create dimensions:
+  !*************************
+  ! time
+  call nf90_err(nf90_def_dim(ncid, 'time', nf90_unlimited, timeDimID))
+  timeunit = 'seconds since '//adate(1:4)//'-'//adate(5:6)// &
+     '-'//adate(7:8)//' '//atime(1:2)//':'//atime(3:4)
+
+  ! lon
+  call nf90_err(nf90_def_dim(ncid, 'longitude', nnx, lonDimID))
+  ! lat
+  call nf90_err(nf90_def_dim(ncid, 'latitude', nny, latDimID))
+  ! level
+  call nf90_err(nf90_def_dim(ncid, 'height', numzgrid, levDimID))
+  ! number of species
+  call nf90_err(nf90_def_dim(ncid, 'numspec', nspec, nspecDimID))
+  ! number of release points
+  call nf90_err(nf90_def_dim(ncid, 'pointspec', maxpointspec_act, pointspecDimID))
+  ! number of age classes
+  call nf90_err(nf90_def_dim(ncid, 'nageclass', nageclass, nageclassDimID))
+  ! dimension for release point characters
+  call nf90_err(nf90_def_dim(ncid, 'nchar', 45, ncharDimID))
+  ! dimension for receptor point characters
+  call nf90_err(nf90_def_dim(ncid, 'ncharrec', 16, ncharrecDimID))
+  ! number of actual release points
+  call nf90_err(nf90_def_dim(ncid, 'numpoint', numpoint, npointDimID))
+
+
+  ! create variables
+  !*************************
+
+  ! time
+  call nf90_err(nf90_def_var(ncid, 'time', nf90_int, (/ timeDimID /), tID))
+  call nf90_err(nf90_put_att(ncid, tID, 'units', timeunit))
+  call nf90_err(nf90_put_att(ncid, tID, 'calendar', 'proleptic_gregorian'))
+  if (lnest) then
+     timeIDn = tID
+  else
+     timeID = tID
+  endif
+
+  ! lon
+  call nf90_err(nf90_def_var(ncid, 'longitude', nf90_float, (/ lonDimID /), lonID))
+  call nf90_err(nf90_put_att(ncid, lonID, 'long_name', 'longitude in degree east'))
+  call nf90_err(nf90_put_att(ncid, lonID, 'axis', 'Lon'))
+  call nf90_err(nf90_put_att(ncid, lonID, 'units', 'degrees_east'))
+  call nf90_err(nf90_put_att(ncid, lonID, 'standard_name', 'grid_longitude'))
+  call nf90_err(nf90_put_att(ncid, lonID, 'description', 'grid cell centers'))
+
+  ! lat
+  call nf90_err(nf90_def_var(ncid, 'latitude', nf90_float, (/ latDimID /), latID))
+  call nf90_err(nf90_put_att(ncid, latID, 'long_name', 'latitude in degree north'))
+  call nf90_err(nf90_put_att(ncid, latID, 'axis', 'Lat'))
+  call nf90_err(nf90_put_att(ncid, latID, 'units', 'degrees_north'))
+  call nf90_err(nf90_put_att(ncid, latID, 'standard_name', 'grid_latitude'))
+  call nf90_err(nf90_put_att(ncid, latID, 'description', 'grid cell centers'))
+
+
+  ! height
+  call nf90_err(nf90_def_var(ncid, 'height', nf90_float, (/ levDimID /), levID))
+  ! call nf90_err(nf90_put_att(ncid, levID, 'axis', 'Z'))
+  call nf90_err(nf90_put_att(ncid, levID, 'units', 'meters'))
+  call nf90_err(nf90_put_att(ncid, levID, 'positive', 'up'))
+  call nf90_err(nf90_put_att(ncid, levID, 'standard_name', 'height'))
+  call nf90_err(nf90_put_att(ncid, levID, 'long_name', 'height above ground'))
+
+  ! volume
+  if (write_vol) call nf90_err(nf90_def_var(ncid, 'volume', nf90_float, &
+       &(/ lonDimID, latDimID, levDimID /), volID))
+  ! area
+  if (write_area) call nf90_err(nf90_def_var(ncid, 'area', nf90_float, &
+       &(/ lonDimID, latDimID /), areaID))
+
+
+  if (write_releases.eqv..true.) then
+    ! release comment
+    call nf90_err(nf90_def_var(ncid, 'RELCOM', nf90_char, (/ ncharDimID,npointDimID /), &
+         relcomID))
+    call nf90_err(nf90_put_att(ncid, relcomID, 'long_name', 'release point name'))
+    ! release longitude 1
+    call nf90_err(nf90_def_var(ncid, 'RELLNG1', nf90_float, (/ npointDimID /), rellng1ID))
+    call nf90_err(nf90_put_att(ncid, rellng1ID, 'units', 'degrees_east'))
+    call nf90_err(nf90_put_att(ncid, rellng1ID, 'long_name', &
+         'release longitude lower left corner'))
+    ! release longitude 2
+    call nf90_err(nf90_def_var(ncid, 'RELLNG2', nf90_float, (/ npointDimID /), rellng2ID))
+    call nf90_err(nf90_put_att(ncid, rellng2ID, 'units', 'degrees_east'))
+    call nf90_err(nf90_put_att(ncid, rellng2ID, 'long_name', &
+         'release longitude upper right corner'))
+    ! release latitude 1
+    call nf90_err(nf90_def_var(ncid, 'RELLAT1', nf90_float, (/ npointDimID /), rellat1ID))
+    call nf90_err(nf90_put_att(ncid, rellat1ID, 'units', 'degrees_north'))
+    call nf90_err(nf90_put_att(ncid, rellat1ID, 'long_name', &
+         'release latitude lower left corner'))
+    ! release latitude 2
+    call nf90_err(nf90_def_var(ncid, 'RELLAT2', nf90_float, (/ npointDimID /), rellat2ID))
+    call nf90_err(nf90_put_att(ncid, rellat2ID, 'units', 'degrees_north'))
+    call nf90_err(nf90_put_att(ncid, rellat2ID, 'long_name', &
+         'release latitude upper right corner'))
+
+    ! hes: if rotated_ll it would be convenient also to write the the release points in rotated_coordinates
+
+    ! release height bottom
+    call nf90_err(nf90_def_var(ncid, 'RELZZ1', nf90_float, (/ npointDimID /), relzz1ID))
+    call nf90_err(nf90_put_att(ncid, relzz1ID, 'units', 'meters'))
+    call nf90_err(nf90_put_att(ncid, relzz1ID, 'long_name', 'release height bottom'))
+    ! release height top
+    call nf90_err(nf90_def_var(ncid, 'RELZZ2', nf90_float, (/ npointDimID /), relzz2ID))
+    call nf90_err(nf90_put_att(ncid, relzz2ID, 'units', 'meters'))
+    call nf90_err(nf90_put_att(ncid, relzz2ID, 'long_name', 'release height top'))
+    ! release kind
+    call nf90_err(nf90_def_var(ncid, 'RELKINDZ', nf90_int, (/ npointDimID /), relkindzID))
+    call nf90_err(nf90_put_att(ncid, relkindzID, 'long_name', 'release kind'))
+    ! release start
+    call nf90_err(nf90_def_var(ncid, 'RELSTART', nf90_int, (/ npointDimID /), relstartID))
+    call nf90_err(nf90_put_att(ncid, relstartID, 'units', 'seconds'))
+    call nf90_err(nf90_put_att(ncid, relstartID, 'long_name', &
+         'release start relative to simulation start'))
+    ! release end
+    call nf90_err(nf90_def_var(ncid, 'RELEND', nf90_int, (/ npointDimID /), relendID))
+    call nf90_err(nf90_put_att(ncid, relendID, 'units', 'seconds'))
+    call nf90_err(nf90_put_att(ncid, relendID, 'long_name', &
+         'release end relative to simulation start'))
+    ! release particles
+    call nf90_err(nf90_def_var(ncid, 'RELPART', nf90_int, (/ npointDimID /), relpartID))
+    call nf90_err(nf90_put_att(ncid, relpartID, 'long_name', 'number of release particles'))
+    ! release particle masses
+    call nf90_err(nf90_def_var(ncid, 'RELXMASS', nf90_float, (/ npointDimID, nspecDimID /), &
+         relxmassID))
+    call nf90_err(nf90_put_att(ncid, relxmassID, 'long_name', 'total release particle mass'))
+  end if
+
+  ! age classes
+  call nf90_err(nf90_def_var(ncid, 'LAGE', nf90_int, (/ nageclassDimID /), lageID))
+  call nf90_err(nf90_put_att(ncid, lageID, 'units', 'seconds'))
+  call nf90_err(nf90_put_att(ncid, lageID, 'long_name', 'age class'))
+
+  ! output orography
+  if (.not. min_size) then
+    call nf90_err(nf90_def_var(ncid, 'ORO', nf90_int, (/ lonDimID, latDimID /), oroID,  &
+      deflate_level=deflate_level, chunksizes= (/ nnx, nny /)))
+    call nf90_err(nf90_put_att(ncid, oroID, 'standard_name', 'surface altitude'))
+    call nf90_err(nf90_put_att(ncid, oroID, 'long_name', 'outgrid surface altitude'))
+    call nf90_err(nf90_put_att(ncid, oroID, 'units', 'm'))
+  end if
+
+  ! Receptors
+  if (numreceptor.ge.1) then
+    call nf90_err(nf90_def_dim(ncid, 'receptor', nf90_unlimited, receptorDimID))
+    call nf90_err(nf90_def_var(ncid, 'receptor', nf90_char, (/ ncharrecDimID,receptorDimID /), sID))
+    call nf90_err(nf90_put_var(ncid, sID, receptorname, (/ 1,1 /), (/ 16,numreceptor /)))
+    call nf90_err(nf90_put_att(ncid, sID, 'long_name', 'receptor name'))
+  endif
+
+  ! concentration output, wet and dry deposition variables (one per species)
+  call output_units(units)
+
+  dIDs = (/ londimid, latdimid, levdimid, timedimid, pointspecdimid, nageclassdimid /)
+  depdIDs = (/ londimid, latdimid, timedimid, pointspecdimid, nageclassdimid /)
+  if (lnest) then
+     dimidsn    = dIDs
+     depdimidsn = depdIDs
+  else
+     dimids    = dIDs
+     depdimids = depdIDs
+  endif
+
+  ! set chunksizes according to largest written portion of data in an individual call to
+  ! nf90_put_var
+  if (int(nnx,kind=8)*int(nny,kind=8)*int(numzgrid,kind=8).gt.2147483647) then ! Larger than an
+    chunksizes = (/ nnx, nny, 1, 1, 1, 1 /)
+  else
+    chunksizes = (/ nnx, nny, numzgrid, 1, 1, 1 /)
+  endif
+  dep_chunksizes = (/ nnx, nny, 1, 1, 1 /)
+
+  do i = 1,nspec
+    write(anspec,'(i3.3)') i
+
+    ! concentration output
+    if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
+      call nf90_err(nf90_def_var(ncid,'spec'//anspec//'_mr', nf90_float, dIDs, sID , &
+           deflate_level = deflate_level,  &
+           chunksizes = chunksizes ))
+      call nf90_err(nf90_put_att(ncid, sID, 'units', units))
+      call nf90_err(nf90_put_att(ncid, sID, 'long_name', species(i)))
+      call nf90_err(nf90_put_att(ncid, sID, 'decay', decay(i)))
+      call nf90_err(nf90_put_att(ncid, sID, 'weightmolar', weightmolar(i)))
+    !        call nf90_err(nf90_put_att(ncid, sID, 'ohreact', ohreact(i)))
+      call nf90_err(nf90_put_att(ncid, sID, 'ohcconst', ohcconst(i)))
+      call nf90_err(nf90_put_att(ncid, sID, 'ohdconst', ohdconst(i)))
+      call nf90_err(nf90_put_att(ncid, sID, 'vsetaver', vsetaver(i)))
+
+      if (lnest) then
+         specIDn(i) = sID
+      else
+         specID(i) = sID
+      endif
+    endif
+
+    ! mixing ratio output
+    if ((iout.eq.2).or.(iout.eq.3)) then
+      call nf90_err(nf90_def_var(ncid,'spec'//anspec//'_pptv', nf90_float, dIDs, sID , &
+           deflate_level = deflate_level,  &
+           chunksizes = chunksizes ))
+      call nf90_err(nf90_put_att(ncid, sID, 'units', 'pptv'))
+      call nf90_err(nf90_put_att(ncid, sID, 'long_name', species(i)))
+      call nf90_err(nf90_put_att(ncid, sID, 'decay', decay(i)))
+      call nf90_err(nf90_put_att(ncid, sID, 'weightmolar', weightmolar(i)))
+    !        call nf90_err(nf90_put_att(ncid, sID, 'ohreact', ohreact(i)))
+      call nf90_err(nf90_put_att(ncid, sID, 'ohcconst', ohcconst(i)))
+      call nf90_err(nf90_put_att(ncid, sID, 'ohdconst', ohdconst(i)))
+      call nf90_err(nf90_put_att(ncid, sID, 'vsetaver', vsetaver(i)))
+
+      if (lnest) then
+         specIDnppt(i) = sID
+      else
+         specIDppt(i) = sID
+      endif
+    endif
+
+    ! wet and dry deposition fields for forward runs
+    if ((ldirect.eq.1).and.(wetdep)) then
+      call nf90_err(nf90_def_var(ncid,'WD_spec'//anspec, nf90_float, depdIDs, &
+           wdsID, deflate_level = deflate_level, &
+           chunksizes = dep_chunksizes))
+      call nf90_err(nf90_put_att(ncid, wdsID, 'units', '1e-12 kg m-2'))
+      call nf90_err(nf90_put_att(ncid, wdsID, 'weta_gas', weta_gas(i)))
+      call nf90_err(nf90_put_att(ncid, wdsID, 'wetb_gas', wetb_gas(i)))
+      call nf90_err(nf90_put_att(ncid, wdsID, 'ccn_aero', ccn_aero(i)))
+      call nf90_err(nf90_put_att(ncid, wdsID, 'in_aero', in_aero(i)))
+      ! call nf90_err(nf90_put_att(ncid, wdsID, 'wetc_in', wetc_in(i)))
+      ! call nf90_err(nf90_put_att(ncid, wdsID, 'wetd_in', wetd_in(i)))
+      call nf90_err(nf90_put_att(ncid, wdsID, 'dquer', dquer(i)))
+      call nf90_err(nf90_put_att(ncid, wdsID, 'henry', henry(i)))
+      if (lnest) then
+         wdspecIDn(i) = wdsID
+      else
+         wdspecID(i) = wdsID
+      endif
+    endif
+    if ((ldirect.eq.1).and.(drydep)) then
+      call nf90_err(nf90_def_var(ncid,'DD_spec'//anspec, nf90_float, depdIDs, &
+           ddsID, deflate_level = deflate_level, &
+           chunksizes = dep_chunksizes))
+      call nf90_err(nf90_put_att(ncid, ddsID, 'units', '1e-12 kg m-2'))
+      call nf90_err(nf90_put_att(ncid, ddsID, 'dryvel', dryvel(i)))
+      call nf90_err(nf90_put_att(ncid, ddsID, 'reldiff', reldiff(i)))
+      call nf90_err(nf90_put_att(ncid, ddsID, 'henry', henry(i)))
+      call nf90_err(nf90_put_att(ncid, ddsID, 'f0', f0(i)))
+      call nf90_err(nf90_put_att(ncid, ddsID, 'dquer', dquer(i)))
+      call nf90_err(nf90_put_att(ncid, ddsID, 'density', density(i)))
+      call nf90_err(nf90_put_att(ncid, ddsID, 'dsigma', dsigma(i)))
+      if (lnest) then
+         ddspecIDn(i) = ddsID
+      else
+         ddspecID(i) = ddsID
+      endif
+    endif
+    ! RECEPTORS
+    if (numreceptor.ge.1) then
+      if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
+        call write_to_file(ncid,'receptor_conc'//anspec, nf90_float, (/ timeDimID,receptorDimID /), &
+            sID, (/ 1, numreceptor /), 'ng m-3', .true., 'receptor_conc', 'receptor_concentration')
+        recconcID(i)=sID
+      endif
+      if ((iout.eq.2).or.(iout.eq.3)) then
+        call write_to_file(ncid,'receptor_pptv'//anspec, nf90_float, (/ timeDimID,receptorDimID /), &
+            sID, (/ 1, numreceptor /), 'pptv', .true., 'receptor_pptv', 'receptor_mixingratio')
+        recpptvID(i)=sID
+      endif
+    endif
+  end do
+
+  ! global (metadata) attributes
+  !*******************************
+  call writemetadata(ncid,lnest)
+
+
+  ! moves the file from define to data mode
+  call nf90_err(nf90_enddef(ncid))
+
+  !  ! hes: inquire var definition
+  !  do i = 1,nspec
+  !     write(anspec,'(i3.3)') i
+  !
+  !     ! concentration output
+  !     if (iout.eq.1.or.iout.eq.3.or.iout.eq.5) then
+  !        if (lnest) then
+  !           sID = specIDn(i)
+  !        else
+  !           sID = specID(i)
+  !        endif
+  !        call nf90_err(nf90_inquire_variable(ncid, sID, chunksizes=inq_chunksizes))
+  !        write(*,*) "Chunksizes for var "//anspec//": ", inq_chunksizes
+  !     endif
+  !  end do
+
+
+  ! fill with data
+  !******************************
+  ! longitudes (grid cell centers)
+  if (lnest) then
+    if (.not.allocated(coord)) allocate(coord(numxgridn))
+     do i = 1,numxgridn
+        coord(i) = outlon0n + (i-0.5)*dxoutn
+     enddo
+     call nf90_err(nf90_put_var(ncid, lonID, coord(1:numxgridn)))
+     deallocate(coord)
+  else
+    if (.not.allocated(coord)) allocate(coord(numxgrid))
+     do i = 1,numxgrid
+        coord(i) = outlon0 + (i-0.5)*dxout
+     enddo
+     call nf90_err(nf90_put_var(ncid, lonID, coord(1:numxgrid)))
+     deallocate(coord)
+  endif
+  ! latitudes (grid cell centers)
+  if (lnest) then
+    if (.not.allocated(coord)) allocate(coord(numygridn))
+     do i = 1,numygridn
+        coord(i) = outlat0n + (i-0.5)*dyoutn
+     enddo
+     call nf90_err(nf90_put_var(ncid, latID, coord(1:numygridn)))
+     deallocate(coord)
+  else
+    if (.not.allocated(coord)) allocate(coord(numygrid))
+     do i = 1,numygrid
+        coord(i) = outlat0 + (i-0.5)*dyout
+     enddo
+     call nf90_err(nf90_put_var(ncid, latID, coord(1:numygrid)))
+     deallocate(coord)
+  endif
+  ! levels
+  call nf90_err(nf90_put_var(ncid, levID, outheight(1:numzgrid)))
+
+  ! volume
+  if (write_vol) then
+    if (lnest) then
+      call nf90_err(nf90_put_var(ncid, volID, volumen(:,:,:)))
+    else
+      call nf90_err(nf90_put_var(ncid, volID, volume(:,:,:)))
+    end if
+  end if
+
+  ! area
+  if (write_area) then
+    if (lnest) then
+      call nf90_err(nf90_put_var(ncid, areaID, arean(:,:)))
+    else
+      call nf90_err(nf90_put_var(ncid, areaID, area(:,:)))
+    end if
+  end if
+
+  if ((write_releases.eqv..true.).and.(ipin.ne.3).and.(ipin.ne.4)) then
+    ! release point information
+    do i = 1,numpoint
+       call nf90_err(nf90_put_var(ncid, relstartID, ireleasestart(i), (/i/)))
+       call nf90_err(nf90_put_var(ncid, relendID, ireleaseend(i), (/i/)))
+       call nf90_err(nf90_put_var(ncid, relkindzID, kindz(i), (/i/)))
+       xp1=xpoint1(i)*dx+xlon0
+       yp1=ypoint1(i)*dy+ylat0
+       xp2=xpoint2(i)*dx+xlon0
+       yp2=ypoint2(i)*dy+ylat0
+       call nf90_err(nf90_put_var(ncid, rellng1ID, xp1, (/i/)))
+       call nf90_err(nf90_put_var(ncid, rellng2ID, xp2, (/i/)))
+       call nf90_err(nf90_put_var(ncid, rellat1ID, yp1, (/i/)))
+       call nf90_err(nf90_put_var(ncid, rellat2ID, yp2, (/i/)))
+       call nf90_err(nf90_put_var(ncid, relzz1ID, zpoint1(i), (/i/)))
+       call nf90_err(nf90_put_var(ncid, relzz2ID, zpoint2(i), (/i/)))
+       call nf90_err(nf90_put_var(ncid, relpartID, npart(i), (/i/)))
+       if ((i .le. 1000).and.(ipin.ne.3).and.(ipin.ne.4)) then
+         call nf90_err(nf90_put_var(ncid, relcomID, compoint(i), (/1,i/), (/45,1/)))
+       else
+         call nf90_err(nf90_put_var(ncid, relcomID, 'NA', (/1,i/), (/45,1/)))
+       endif
+       call nf90_err(nf90_put_var(ncid, relxmassID, xmass(i,1:nspec), (/i,1/), (/1,nspec/)))
+    end do
+  end if
+
+  ! age classes
+  call nf90_err(nf90_put_var(ncid, lageID, lage(1:nageclass)))
+
+  ! orography
+  if (.not. min_size) then
+    if (lnest) then
+      call nf90_err(nf90_put_var(ncid, oroID, orooutn(0:(nnx-1), 0:(nny-1))))
+    else
+      call nf90_err(nf90_put_var(ncid, oroID, oroout(0:(nnx-1), 0:(nny-1))))
+    endif
+  end if
+
+  call nf90_err(nf90_close(ncid))
+
+  return
+end subroutine writeheader_ncf
diff --git a/src/net_writeheader_partoutput.f90 b/src/net_writeheader_partoutput.f90
new file mode 100644
index 0000000000000000000000000000000000000000..beef33affd85a7ea10fdc164c95a3959968bf842
--- /dev/null
+++ b/src/net_writeheader_partoutput.f90
@@ -0,0 +1,315 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine writeheader_partoutput(itime,idate,itime_start,idate_start)!,irelease)
+
+  !*****************************************************************************
+  !                                                                            *
+  !   This subroutine creates a file (partoutput_xxx.nc), where every time     *
+  !   interval particle properties specified in the PARTOPTIONS option file    *
+  !   are saved to. Running options are saved as header informtion to this     *
+  !   file as well.                                                            *
+  !                                                                            *
+  !   Author: L. Bakels 2021                                                   *
+  !                                                                            *
+  !*****************************************************************************
+
+  implicit none
+
+  integer, intent(in) :: itime,idate,itime_start,idate_start
+  ! integer, intent(in) :: irelease
+  integer             :: cache_size,ncid,j,i,totpart,np
+  integer             :: timeDimID,partDimID,tID,memDimID
+  integer             :: latDimID, lonDimID, lonID, latID
+  character(len=11)   :: fprefix
+  character(len=3)    :: anspec,arelease
+  character           :: adate*8,atime*6,adate_start*8,atime_start*6,timeunit*32
+  character(len=255)  :: fname_partoutput
+  real                :: fillval
+  real, allocatable, dimension(:) :: coord
+
+  logical,save :: first_time=.true.
+
+  open(unit=unittmp,file=trim(path(2)(1:length(2)))//'test_dir.txt',status='replace',&
+       &err=110)
+  close (unittmp, status='delete')
+
+  write(adate,'(i8.8)') idate
+  write(atime,'(i6.6)') itime
+  write(adate_start,'(i8.8)') idate_start
+  write(atime_start,'(i6.6)') itime_start
+  ! write(arelease, '(i3.3)') irelease
+  fprefix = 'partoutput_'!rel'//arelease//'_'
+
+  ! Reset logicals that ensure ony 1 write out in case of domainfill
+  topo_written=.false.
+  mass_written=.false.
+  massav_written=.false.
+
+  if (first_time) then
+    fname_partoutput = path(2)(1:length(2))//trim(fprefix)//adate//atime//'_init.nc'
+    first_time=.false.
+  else
+    fname_partoutput = path(2)(1:length(2))//trim(fprefix)//adate//atime//'.nc'
+  endif
+  !ncfname_part(irelease) = fname_partoutput
+  ncfname_part = fname_partoutput
+
+  totpart=0
+  if (ipin.gt.1) then ! Not reading from a release has no npart
+    totpart=numpart
+  else
+    do j=1,numpoint
+      totpart = totpart+npart(j)
+    end do
+  endif
+  !totpart = maxpart!max(numpart,totpart)
+  !cache_size = 4 * 1 * (12+nspec)
+
+  write(*,*) 'Write header, nspec,numpart,totpart: ', nspec,numpart,totpart
+
+  call nf90_err(nf90_create(trim(fname_partoutput), cmode = nf90_hdf5, ncid = ncid))!, &
+    ! cache_size = cache_size))
+
+  ! create dimensions:
+  !*************************
+  ! time
+  call nf90_err(nf90_def_dim(ncid, 'time', nf90_unlimited, timeDimID))
+  timeunit = 'seconds since '//adate_start(1:4)//'-'//adate_start(5:6)// &
+     '-'//adate_start(7:8)//' '//atime_start(1:2)//':'//atime_start(3:4)
+
+  ! particle
+  call nf90_err(nf90_def_dim(ncid, 'particle', nf90_unlimited, partDimID)) !totpart needs to be the actual number of particles
+
+  ! If domainfill, save topo, hmix, and htropo to grid to save space
+  !*****************************************************************
+  if (mdomainfill.ge.1) then
+    call nf90_err(nf90_def_dim(ncid, 'lon', nx, lonDimID))
+    call nf90_err(nf90_def_dim(ncid, 'lat', ny, latDimID))
+
+    ! lon
+    call write_to_file(ncid,'lon',nf90_float,(/ lonDimID /),lonID,(/ 1 /), &
+      'degrees_east',.false.,'grid_longitude','longitude in degree east')
+    call nf90_err(nf90_put_att(ncid, lonID, 'axis', 'Lon'))
+    call nf90_err(nf90_put_att(ncid, lonID, 'description', 'grid cell centers'))
+
+    ! lat
+    call write_to_file(ncid,'lat',nf90_float,(/ latDimID /),latID,(/ 1 /), &
+      'degrees_east',.false.,'grid_latitude','latitude in degree north')
+    call nf90_err(nf90_put_att(ncid, latID, 'axis', 'Lat'))
+    call nf90_err(nf90_put_att(ncid, latID, 'description', 'grid cell centers'))
+
+    if (.not.allocated(coord)) allocate(coord(nx))
+     do i = 1,nx
+        coord(i) = xlon0 + i*dx
+     enddo
+     call nf90_err(nf90_put_var(ncid, lonID, coord(1:nx)))
+     deallocate(coord)
+
+    if (.not.allocated(coord)) allocate(coord(ny))
+     do i = 1,ny
+        coord(i) = ylat0 + i*dy
+     enddo
+     call nf90_err(nf90_put_var(ncid, latID, coord(1:ny)))
+     deallocate(coord)
+
+  endif
+  ! create variables
+  !*************************
+
+  ! time
+  tpointer_part=0
+  call nf90_err(nf90_def_var(ncid, 'time', nf90_int, (/ timeDimID /), tID))
+  call nf90_err(nf90_put_att(ncid, tID, 'units', timeunit))
+  call nf90_err(nf90_put_att(ncid, tID, 'calendar', 'proleptic_gregorian'))
+
+  timeIDpart=tID
+  ! particles
+  call nf90_err(nf90_def_var(ncid, 'particle', nf90_int, (/ partDimID/), partID))
+  call nf90_err(nf90_put_att(ncid, partID, 'long_name', 'particle index'))
+
+  fillval = -1.
+  do np=1,num_partopt
+    if (.not. partopt(np)%print) cycle
+    select case(partopt(np)%name)
+      case ('LO') ! Longitude
+        call write_to_file(ncid,'longitude',nf90_float,(/ timeDimID,partDimID /),lonIDpart,(/ 1,totpart /), &
+          'degrees_east',.false.,'longitude','longitude of particles')
+        call nf90_err(nf90_put_att(ncid, lonIDpart, 'axis', 'Lon'))
+        call nf90_err(nf90_put_att(ncid, lonIDpart, 'description', 'longitude of particles'))
+      case ('lo') ! Longitude averaged
+        call write_to_file(ncid,'longitude_av',nf90_float,(/ timeDimID,partDimID /),lonavIDpart,(/ 1,totpart /), &
+          'degrees_east',.false.,'longitude_average','averaged longitude of particles')
+        call nf90_err(nf90_put_att(ncid, lonavIDpart, 'axis', 'Lon'))
+        call nf90_err(nf90_put_att(ncid, lonavIDpart, 'description', 'averaged longitude of particles'))
+      case ('LA') ! Latitude
+        call write_to_file(ncid,'latitude',nf90_float,(/ timeDimID,partDimID /),latIDpart,(/ 1,totpart /), &
+          'degrees_north',.false.,'latitude','latitude in degree north')
+        call nf90_err(nf90_put_att(ncid, latIDpart, 'axis', 'Lat'))
+        call nf90_err(nf90_put_att(ncid, latIDpart, 'description', 'latitude of particles'))
+      case ('la') ! Latitude averaged
+        call write_to_file(ncid,'latitude_av',nf90_float,(/ timeDimID,partDimID /),latavIDpart,(/ 1,totpart /), &
+          'degrees_north',.false.,'latitude_average','averaged latitude in degree north')
+        call nf90_err(nf90_put_att(ncid, latavIDpart, 'axis', 'Lat'))
+        call nf90_err(nf90_put_att(ncid, latavIDpart, 'description', 'averaged latitude of particles'))
+      case ('ZZ') ! Height
+        call write_to_file(ncid,'height',nf90_float,(/ timeDimID,partDimID /),levIDpart,(/ 1,totpart /), &
+          'meters',.false.,'height','height above ground')
+      case ('zz') ! Heights averaged
+        call write_to_file(ncid,'height_av',nf90_float,(/ timeDimID,partDimID /),levavIDpart,(/ 1,totpart /), &
+          'meters',.false.,'height_average','averaged height above ground')
+      case ('PV') ! Potential vorticity
+        call write_to_file(ncid,'pv',nf90_float,(/ timeDimID,partDimID /),pvID,(/ 1,totpart /), &
+          'pvu',.false.,'potential_vorticity','potential vorticity')
+      case ('pv') ! Potential vorticity averaged
+        call write_to_file(ncid,'pv_av',nf90_float,(/ timeDimID,partDimID /),pvavID,(/ 1,totpart /), &
+          'pvu',.false.,'potential_vorticity_average','averaged potential vorticity')
+      case ('PR') ! Pressure
+        call write_to_file(ncid,'pr',nf90_float,(/ timeDimID,partDimID /),prID,(/ 1,totpart /), &
+          'Pa',.false.,'pressure','pressure')
+      case ('pr') ! Pressure averaged
+        call write_to_file(ncid,'pr_av',nf90_float,(/ timeDimID,partDimID /),pravID,(/ 1,totpart /), &
+          'Pa',.false.,'pressure_average','averaged pressure')
+      case ('QV') ! Specific humidity
+        call write_to_file(ncid,'qv',nf90_float,(/ timeDimID,partDimID /),qvID,(/ 1,totpart /), &
+          '',.false.,'specific_humidity','specific humidity')
+      case ('qv') ! Specific humidity averaged
+        call write_to_file(ncid,'qv_av',nf90_float,(/ timeDimID,partDimID /),qvavID,(/ 1,totpart /), &
+          '',.false.,'specific_humidity_average','averaged specific humidity')
+      case ('RH') ! Density
+        call write_to_file(ncid,'rho',nf90_float,(/ timeDimID,partDimID /),rhoID,(/ 1,totpart /), &
+          'kg/m3',.true.,'density','density')
+      case ('rh') ! Density averaged
+        call write_to_file(ncid,'rho_av',nf90_float,(/ timeDimID,partDimID /),rhoavID,(/ 1,totpart /), &
+          'kg/m3',.true.,'density_average','averaged density')
+      case ('TT') ! Temperature
+        call write_to_file(ncid,'temperature',nf90_float,(/ timeDimID,partDimID /),ttID,(/ 1,totpart /), &
+          'K',.true.,'temperature','temperature')
+      case ('tt') ! Temperature averaged
+        call write_to_file(ncid,'temperature_av',nf90_float,(/ timeDimID,partDimID /),ttavID,(/ 1,totpart /), &
+          'K',.true.,'temperature_average','averaged temperature')
+      case ('UU')
+        call write_to_file(ncid,'u',nf90_float,(/ timeDimID,partDimID /),uID,(/ 1,totpart /), &
+          'm/s',.false.,'u','longitudinal velocity')
+      case ('uu')
+        call write_to_file(ncid,'u_av',nf90_float,(/ timeDimID,partDimID /),uavID,(/ 1,totpart /), &
+          'm/s',.false.,'u_av','averaged longitudinal velocity')
+      case ('VV')
+        call write_to_file(ncid,'v',nf90_float,(/ timeDimID,partDimID /),vID,(/ 1,totpart /), &
+          'm/s',.false.,'v','latitudinal velocity')
+      case ('vv')
+        call write_to_file(ncid,'v_av',nf90_float,(/ timeDimID,partDimID /),vavID,(/ 1,totpart /), &
+          'm/s',.false.,'v_average','latitudinal velocity averaged')
+      case ('WW')
+        call write_to_file(ncid,'w',nf90_float,(/ timeDimID,partDimID /),wID,(/ 1,totpart /), &
+          'm/s',.false.,'w','vertical velocity')
+      case ('ww')
+        call write_to_file(ncid,'w_av',nf90_float,(/ timeDimID,partDimID /),wavID,(/ 1,totpart /), &
+          'm/s',.false.,'w_average','vertical velocity averaged')
+      case ('VS')
+        call write_to_file(ncid,'settling',nf90_float,(/ timeDimID,partDimID /),vsetID,(/ 1,totpart /), &
+          'm/s',.false.,'settling_velocity','settling velocity')
+      case ('vs')
+        call write_to_file(ncid,'settling_av',nf90_float,(/ timeDimID,partDimID /),vsetavID,(/ 1,totpart /), &
+          'm/s',.false.,'settling_velocity_average','settling velocity averaged')
+      case ('MA') ! Mass
+        if (mdomainfill.ge.1) then
+          call nf90_err(nf90_def_var(ncid=ncid, name='mass', xtype=nf90_float, dimids=1, varid=massID(1)))
+          call nf90_err(nf90_put_att(ncid, massID(1), 'units', 'kg'))
+          call nf90_err(nf90_put_att(ncid, massID(1), '_FillValue', fillval))
+          call nf90_err(nf90_put_att(ncid, massID(1), 'positive', 'up'))
+          call nf90_err(nf90_put_att(ncid, massID(1), 'standard_name', 'mass'))
+          call nf90_err(nf90_put_att(ncid, massID(1), 'long_name', 'mass of each particle'))
+        else
+          do j=1,nspec
+            ! Masses
+            write(anspec, '(i3.3)') j
+            call write_to_file(ncid,'mass'//anspec,nf90_float,(/ timeDimID,partDimID /),massID(j), &
+              (/ 1,totpart /),'kg',.true.,'mass'//anspec,'mass for nspec'//anspec)
+          end do
+        endif
+      case ('ma') ! Mass averaged
+        if (mdomainfill.ge.1) then
+          call nf90_err(nf90_def_var(ncid=ncid, name='mass_av', xtype=nf90_float, dimids=1, varid=massavID(1)))
+          call nf90_err(nf90_put_att(ncid, massavID(1), 'units', 'kg'))
+          call nf90_err(nf90_put_att(ncid, massavID(1), '_FillValue', fillval))
+          call nf90_err(nf90_put_att(ncid, massavID(1), 'positive', 'up'))
+          call nf90_err(nf90_put_att(ncid, massavID(1), 'standard_name', 'mass'))
+          call nf90_err(nf90_put_att(ncid, massavID(1), 'long_name', 'averaged mass of each particle'))
+        else
+          do j=1,nspec
+            ! Masses averaged
+            write(anspec, '(i3.3)') j
+            call write_to_file(ncid,'mass_av'//anspec,nf90_float,(/ timeDimID,partDimID /),massavID(j), &
+              (/ 1,totpart /),'kg',.true.,'mass'//anspec,'averaged mass for nspec'//anspec)
+          end do
+        endif
+      case ('WD') ! Cumulative mass of wet deposition
+        do j=1,nspec
+          ! Masses
+          write(anspec, '(i3.3)') j
+          call write_to_file(ncid,'wetdepo'//anspec,nf90_float,(/ timeDimID,partDimID /),wdID(j), &
+            (/ 1,totpart /),'kg',.true.,'mass'//anspec,'cumulative wet deposition for nspec'//anspec)
+        end do
+      case ('DD') ! Cumulative mass of dry deposition
+        do j=1,nspec
+          ! Masses
+          write(anspec, '(i3.3)') j
+          call write_to_file(ncid,'drydepo'//anspec,nf90_float,(/ timeDimID,partDimID /),ddID(j), &
+            (/ 1,totpart /),'kg',.true.,'mass'//anspec,'cumulative dry deposition for nspec'//anspec)
+        end do
+      case ('TO')  ! Topography, written to grid if domainfill
+        if (mdomainfill.lt.1) then
+          call write_to_file(ncid,'topo',nf90_float,(/ timeDimID,partDimID /),topoID,(/ 1,totpart /), &
+            'meters',.false.,'topography','topography above sealevel')
+        else
+          call write_to_file(ncid,'topo',nf90_float,(/ lonDimID,latDimID /),topoID,(/ nx,ny /), &
+            'meters',.false.,'topography','topography above sealevel')
+        endif
+      case ('to') ! Topography averaged, no grid when domainfill
+        call write_to_file(ncid,'topo_av',nf90_float,(/ timeDimID,partDimID /),topoavID,(/ 1,totpart /), &
+          'meters',.false.,'topography','averaged topography above sealevel')
+      case ('HM') ! Mixing layer height
+        if (mdomainfill.lt.1) then
+          call write_to_file(ncid,'hmix',nf90_float,(/ timeDimID,partDimID /),hmixID,(/ 1,totpart /), &
+            'meters',.true.,'hmix','height above ground of mixing layer')
+        else
+          call write_to_file(ncid,'hmix',nf90_float,(/ timeDimID,lonDimID,latDimID /),hmixID,(/ 1,nx,ny /), &
+            'meters',.true.,'hmix','height above ground of mixing layer')
+        endif
+      case ('hm') ! Mixing layer height averaged
+        call write_to_file(ncid,'hmix_av',nf90_float,(/ timeDimID,partDimID /),hmixavID,(/ 1,totpart /), &
+          'meters',.true.,'hmix_average','averaged height above ground of mixing layer')
+      case ('TR') ! Tropopause
+        if (mdomainfill.lt.1) then
+          call write_to_file(ncid,'tr',nf90_float,(/ timeDimID,partDimID /),trID,(/ 1,totpart /), &
+            'meters',.true.,'htropo','height above ground of tropopause')
+        else
+          call write_to_file(ncid,'tr',nf90_float,(/ timeDimID,lonDimID,latDimID /),trID,(/ 1,nx,ny /), &
+            'meters',.true.,'htropo','height above ground of tropopause')
+        endif
+      case ('tr') ! Tropopause averaged
+        call write_to_file(ncid,'tr_av',nf90_float,(/ timeDimID,partDimID /),travID,(/ 1,totpart /), &
+          'meters',.true.,'htropo_average','averaged height above ground of tropopause')
+      case default
+        write(*,*) 'The field you are trying to write to file is not coded in yet: ', partopt(np)%long_name
+        stop
+    end select
+  end do
+  ! global (metadata) attributes
+  !*******************************
+  call writemetadata(ncid,lnest=.false.)
+
+  ! moves the file from define to data mode
+  call nf90_err(nf90_enddef(ncid))
+
+  call nf90_err(nf90_close(ncid))
+
+  return
+110 write(*,FMT='(80("#"))')
+  write(*,*) 'ERROR: output directory ', trim(path(2)(1:length(2))), ' does not exist&
+       & (or failed to write there).'
+  write(*,*) 'EXITING'
+  write(*,FMT='(80("#"))')
+  stop
+end subroutine writeheader_partoutput
diff --git a/src/net_writemetadata.f90 b/src/net_writemetadata.f90
new file mode 100644
index 0000000000000000000000000000000000000000..1f9b31583e656d9465b98fa1424ea019731fe65c
--- /dev/null
+++ b/src/net_writemetadata.f90
@@ -0,0 +1,79 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine writemetadata(ncid,lnest)
+
+  implicit none
+
+  integer, intent(in) :: ncid
+  logical, intent(in) :: lnest
+  integer             :: status
+  character           :: time*10,date*8,adate*8,atime*6
+  character(5)        :: zone
+  character(255)      :: login_name, host_name
+
+  ! gather system information
+  call date_and_time(date,time,zone)
+  call getlog(login_name)
+  call hostnm(host_name)
+
+  ! hes CF convention requires these attributes
+  call nf90_err(nf90_put_att(ncid, nf90_global, 'Conventions', 'CF-1.6'))
+  call nf90_err(nf90_put_att(ncid, nf90_global, 'title', 'FLEXPART model output'))
+  call nf90_err(nf90_put_att(ncid, nf90_global, 'institution', trim(institution)))
+  call nf90_err(nf90_put_att(ncid, nf90_global, 'source', trim(flexversion)//' model output'))
+  call nf90_err(nf90_put_att(ncid, nf90_global, 'history', date(1:4)//'-'//date(5:6)// &
+       '-'//date(7:8)//' '//time(1:2)//':'//time(3:4)//' '//zone//'  created by '//  &
+       trim(login_name)//' on '//trim(host_name)))
+  call nf90_err(nf90_put_att(ncid, nf90_global, 'references', &
+       'Stohl et al., Atmos. Chem. Phys., 2005, doi:10.5194/acp-5-2461-200'))
+
+  ! attributes describing model run
+  !************************************************************************************
+
+  if (lnest) then
+     call nf90_err(nf90_put_att(ncid, nf90_global, 'outlon0', outlon0n))
+     call nf90_err(nf90_put_att(ncid, nf90_global, 'outlat0', outlat0n))
+     call nf90_err(nf90_put_att(ncid, nf90_global, 'dxout', dxoutn))
+     call nf90_err(nf90_put_att(ncid, nf90_global, 'dyout', dyoutn))
+  else
+     call nf90_err(nf90_put_att(ncid, nf90_global, 'outlon0', outlon0))
+     call nf90_err(nf90_put_att(ncid, nf90_global, 'outlat0', outlat0))
+     call nf90_err(nf90_put_att(ncid, nf90_global, 'dxout', dxout))
+     call nf90_err(nf90_put_att(ncid, nf90_global, 'dyout', dyout))
+  endif
+  !   vertical levels stored in grid structure
+
+  ! COMMAND file settings
+  call nf90_err(nf90_put_att(ncid, nf90_global, 'ldirect', ldirect))
+  write(adate,'(i8.8)') ibdate
+  write(atime,'(i6.6)') ibtime
+  call nf90_err(nf90_put_att(ncid, nf90_global, 'ibdate', adate))
+  call nf90_err(nf90_put_att(ncid, nf90_global, 'ibtime', atime))
+  write(adate,'(i8.8)') iedate
+  write(atime,'(i6.6)') ietime
+  call nf90_err(nf90_put_att(ncid, nf90_global, 'iedate', adate))
+  call nf90_err(nf90_put_att(ncid, nf90_global, 'ietime', atime))
+  call nf90_err(nf90_put_att(ncid, nf90_global, 'loutstep', loutstep))
+  call nf90_err(nf90_put_att(ncid, nf90_global, 'loutaver', loutaver))
+  call nf90_err(nf90_put_att(ncid, nf90_global, 'loutsample', loutsample))
+  call nf90_err(nf90_put_att(ncid, nf90_global, 'itsplit', itsplit))
+  call nf90_err(nf90_put_att(ncid, nf90_global, 'lsynctime', lsynctime))
+  call nf90_err(nf90_put_att(ncid, nf90_global, 'ctl', ctl))
+  call nf90_err(nf90_put_att(ncid, nf90_global, 'ifine', ifine))
+  call nf90_err(nf90_put_att(ncid, nf90_global, 'iout', iout))
+  call nf90_err(nf90_put_att(ncid, nf90_global, 'ipout', ipout))
+  call nf90_err(nf90_put_att(ncid, nf90_global, 'lsubgrid', lsubgrid))
+  call nf90_err(nf90_put_att(ncid, nf90_global, 'lconvection', lconvection))
+  call nf90_err(nf90_put_att(ncid, nf90_global, 'lagespectra', lagespectra))
+  call nf90_err(nf90_put_att(ncid, nf90_global, 'ipin', ipin))
+  call nf90_err(nf90_put_att(ncid, nf90_global, 'ioutputforeachrelease', ioutputforeachrelease))
+  call nf90_err(nf90_put_att(ncid, nf90_global, 'iflux', iflux))
+  call nf90_err(nf90_put_att(ncid, nf90_global, 'mdomainfill', mdomainfill))
+  call nf90_err(nf90_put_att(ncid, nf90_global, 'ind_source', ind_source))
+  call nf90_err(nf90_put_att(ncid, nf90_global, 'ind_receptor', ind_receptor))
+  call nf90_err(nf90_put_att(ncid, nf90_global, 'mquasilag', mquasilag))
+  call nf90_err(nf90_put_att(ncid, nf90_global, 'nested_output', nested_output))
+  call nf90_err(nf90_put_att(ncid, nf90_global, 'surf_only', surf_only))
+  call nf90_err(nf90_put_att(ncid, nf90_global, 'linit_cond', linit_cond))
+end subroutine writemetadata
diff --git a/src/net_wrt_part_initialpos.f90 b/src/net_wrt_part_initialpos.f90
new file mode 100644
index 0000000000000000000000000000000000000000..0d2b12aec027d8e52d74e807ad95c87b43a170f2
--- /dev/null
+++ b/src/net_wrt_part_initialpos.f90
@@ -0,0 +1,54 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine wrt_part_initialpos(itime,istart,iend)
+
+  !*****************************************************************************
+  !                                                                            *
+  !   This subroutine saves initial particle positions, release time and       *
+  !   releasenumber to a NetCDF file created in particle_initialpos *
+  !   evertime a new particle is spawned.                                      *
+  !                                                                            *
+  !   Author: L. Bakels 2022                                                   *
+  !                                                                            *
+  !*****************************************************************************
+
+  use particle_mod
+
+  implicit none
+
+  integer, intent(in) ::  &
+    itime,               & ! time of particle release
+    istart,              & ! index of first newly released particle
+    iend                   ! index of last newly released partile
+  integer, allocatable    :: partindices(:),releasetimes(:)
+  integer :: newpart,ncid,j
+
+  newpart = iend-istart
+  if (newpart.eq.0) return
+  write(*,*) newpart, ' particles are being added to partinit.'
+  call nf90_err(nf90_open(trim(ncfname_partinit), nf90_write, ncid))
+
+  allocate ( partindices(newpart) )
+
+  do j=1,newpart
+    partindices(j)=j+partinitpointer
+  end do
+
+  partinitpointer1= partinitpointer+1 ! this is also used in partinit_ncf
+  call nf90_err(nf90_put_var(ncid,partIDi,partindices,(/ partinitpointer1 /),(/ newpart /)))
+  deallocate (partindices)
+
+  allocate ( releasetimes(newpart) )
+  releasetimes=itime
+  call nf90_err(nf90_put_var(ncid,tIDi,releasetimes,(/ partinitpointer1 /),(/ newpart /)))
+  deallocate (releasetimes)
+  call nf90_err(nf90_put_var(ncid,lonIDi,xlon0+part(partinitpointer1:iend)%xlon*dx, (/ partinitpointer1 /),(/ newpart /)))
+  call nf90_err(nf90_put_var(ncid,latIDi,ylat0+part(partinitpointer1:iend)%ylat*dy, (/ partinitpointer1 /),(/ newpart /)))
+  call nf90_err(nf90_put_var(ncid,levIDi,part(partinitpointer1:iend)%z, (/ partinitpointer1 /),(/ newpart /)))
+  call nf90_err(nf90_put_var(ncid,relIDi,part(partinitpointer1:iend)%npoint, (/ partinitpointer1 /),(/ newpart /)))
+
+  call nf90_err(nf90_close(ncid))
+
+  partinitpointer = partinitpointer+newpart
+end subroutine wrt_part_initialpos
diff --git a/src/netcdf_output_mod.f90 b/src/netcdf_output_mod.f90
index f96e2f3eb728a0f948750cb2c0e543582bff2215..562c9c26148ff642a534c839384193a90fd511cb 100644
--- a/src/netcdf_output_mod.f90
+++ b/src/netcdf_output_mod.f90
@@ -15,10 +15,10 @@
   !     12 April 2013                                                          *
   !                                                                            *
   ! HSO: 21 Oct 2014
-  !  - added option to not writeout releases information by changing 
+  !  - added option to not writeout releases information by changing
   !    switch write_releases
   !  - additional updates for FLEXPART 9.x
-  ! 
+  !
   ! ESO 2016
   !  - Deposition fields can be calculated in double precision, see variable
   !    'dep_prec' in par_mod
@@ -56,12 +56,12 @@ module netcdf_output_mod
                        numparticlecount,receptorname, &
                        memind,xreceptor,yreceptor,numreceptor,creceptor,iout, &
                        itsplit, lsynctime, ctl, ifine, lagespectra, ipin, &
-                       ioutputforeachrelease, iflux, mdomainfill, mquasilag, & 
+                       ioutputforeachrelease, iflux, mdomainfill, mquasilag, &
                        nested_output, ipout, surf_only, linit_cond, &
                        flexversion,mpi_mode,DRYBKDEP,WETBKDEP,numpart,numpoint, &
                        partopt,num_partopt
   use windfields_mod, only: oro,rho,nxmax,height,nxmin1,nymin1,nz,nx,ny,hmix, &
-                       ! for concoutput_ncf and concoutput_ncf_nest 
+                       ! for concoutput_ncf and concoutput_ncf_nest
                        tropopause,oron,rhon,xresoln,yresoln,xrn,xln,yrn,yln,nxn,nyn
   use mean_mod
 
@@ -115,7 +115,7 @@ module netcdf_output_mod
   real :: xp1,yp1,xp2,yp2
 
 
-  private 
+  private
 
   public :: writeheader_ncf, concoutput_sfc_ncf_nest, concoutput_ncf, &
        concoutput_ncf_nest, concoutput_sfc_ncf, writeheader_partoutput, partoutput_ncf, &
@@ -127,2641 +127,49 @@ contains
 !****************************************************************
 ! determine output units (see table 1 in Stohl et al., ACP 2005
 !****************************************************************
-subroutine output_units(units)
-  implicit none
-  character(len=15), intent(out) :: units
-  if (ldirect.eq.1) then
-     ! forward simulation
-     if (ind_source.eq.1) then
-        if (ind_receptor.eq.1) then
-           units = 'ng m-3'   ! hes the kg in Tab1 is only indicating the units of the relase not the output
-        else
-           units = 'ng kg-1'
-        endif
-     else
-        if (ind_receptor.eq.1) then
-           units = 'ng m-3'
-        else
-           units = 'ng kg-1'
-        endif
-     endif
-  else
-     ! backward simulation
-     if (ind_source.eq.1) then
-        if (ind_receptor.eq.1) then
-           units = 's'
-        else 
-           units = 's m3 kg-1'
-        endif
-     else
-        if (ind_receptor.eq.1) then
-           units = 's kg m-3'
-        else
-           units = 's'
-        endif
-     endif
-  endif
-end subroutine output_units
+#include "net_output_units.f90"
 
 
 !****************************************************************
-! write metadata to netCDF file 
+! write metadata to netCDF file
 !****************************************************************
-subroutine writemetadata(ncid,lnest)
-  
-  implicit none 
-
-  integer, intent(in) :: ncid
-  logical, intent(in) :: lnest
-  integer             :: status
-  character           :: time*10,date*8,adate*8,atime*6
-  character(5)        :: zone
-  character(255)      :: login_name, host_name
-
-  ! gather system information 
-  call date_and_time(date,time,zone)
-  call getlog(login_name)
-  call hostnm(host_name)
-  
-  ! hes CF convention requires these attributes
-  call nf90_err(nf90_put_att(ncid, nf90_global, 'Conventions', 'CF-1.6'))
-  call nf90_err(nf90_put_att(ncid, nf90_global, 'title', 'FLEXPART model output'))
-  call nf90_err(nf90_put_att(ncid, nf90_global, 'institution', trim(institution)))
-  call nf90_err(nf90_put_att(ncid, nf90_global, 'source', trim(flexversion)//' model output'))
-  call nf90_err(nf90_put_att(ncid, nf90_global, 'history', date(1:4)//'-'//date(5:6)// &
-       '-'//date(7:8)//' '//time(1:2)//':'//time(3:4)//' '//zone//'  created by '//  &
-       trim(login_name)//' on '//trim(host_name)))
-  call nf90_err(nf90_put_att(ncid, nf90_global, 'references', &
-       'Stohl et al., Atmos. Chem. Phys., 2005, doi:10.5194/acp-5-2461-200'))
-
-  ! attributes describing model run
-  !************************************************************************************
-
-  if (lnest) then
-     call nf90_err(nf90_put_att(ncid, nf90_global, 'outlon0', outlon0n))
-     call nf90_err(nf90_put_att(ncid, nf90_global, 'outlat0', outlat0n))
-     call nf90_err(nf90_put_att(ncid, nf90_global, 'dxout', dxoutn))
-     call nf90_err(nf90_put_att(ncid, nf90_global, 'dyout', dyoutn))
-  else
-     call nf90_err(nf90_put_att(ncid, nf90_global, 'outlon0', outlon0))
-     call nf90_err(nf90_put_att(ncid, nf90_global, 'outlat0', outlat0))
-     call nf90_err(nf90_put_att(ncid, nf90_global, 'dxout', dxout))
-     call nf90_err(nf90_put_att(ncid, nf90_global, 'dyout', dyout))
-  endif
-  !   vertical levels stored in grid structure
-
-  ! COMMAND file settings
-  call nf90_err(nf90_put_att(ncid, nf90_global, 'ldirect', ldirect))
-  write(adate,'(i8.8)') ibdate
-  write(atime,'(i6.6)') ibtime
-  call nf90_err(nf90_put_att(ncid, nf90_global, 'ibdate', adate))
-  call nf90_err(nf90_put_att(ncid, nf90_global, 'ibtime', atime))
-  write(adate,'(i8.8)') iedate
-  write(atime,'(i6.6)') ietime
-  call nf90_err(nf90_put_att(ncid, nf90_global, 'iedate', adate))
-  call nf90_err(nf90_put_att(ncid, nf90_global, 'ietime', atime))
-  call nf90_err(nf90_put_att(ncid, nf90_global, 'loutstep', loutstep))
-  call nf90_err(nf90_put_att(ncid, nf90_global, 'loutaver', loutaver))
-  call nf90_err(nf90_put_att(ncid, nf90_global, 'loutsample', loutsample))
-  call nf90_err(nf90_put_att(ncid, nf90_global, 'itsplit', itsplit))
-  call nf90_err(nf90_put_att(ncid, nf90_global, 'lsynctime', lsynctime))
-  call nf90_err(nf90_put_att(ncid, nf90_global, 'ctl', ctl))
-  call nf90_err(nf90_put_att(ncid, nf90_global, 'ifine', ifine))
-  call nf90_err(nf90_put_att(ncid, nf90_global, 'iout', iout))
-  call nf90_err(nf90_put_att(ncid, nf90_global, 'ipout', ipout))
-  call nf90_err(nf90_put_att(ncid, nf90_global, 'lsubgrid', lsubgrid))
-  call nf90_err(nf90_put_att(ncid, nf90_global, 'lconvection', lconvection))
-  call nf90_err(nf90_put_att(ncid, nf90_global, 'lagespectra', lagespectra))
-  call nf90_err(nf90_put_att(ncid, nf90_global, 'ipin', ipin))
-  call nf90_err(nf90_put_att(ncid, nf90_global, 'ioutputforeachrelease', ioutputforeachrelease))
-  call nf90_err(nf90_put_att(ncid, nf90_global, 'iflux', iflux))
-  call nf90_err(nf90_put_att(ncid, nf90_global, 'mdomainfill', mdomainfill))
-  call nf90_err(nf90_put_att(ncid, nf90_global, 'ind_source', ind_source))
-  call nf90_err(nf90_put_att(ncid, nf90_global, 'ind_receptor', ind_receptor))
-  call nf90_err(nf90_put_att(ncid, nf90_global, 'mquasilag', mquasilag))
-  call nf90_err(nf90_put_att(ncid, nf90_global, 'nested_output', nested_output))
-  call nf90_err(nf90_put_att(ncid, nf90_global, 'surf_only', surf_only))
-  call nf90_err(nf90_put_att(ncid, nf90_global, 'linit_cond', linit_cond))
-end subroutine writemetadata
-
-
-subroutine nf90_err(status)
-  !****************************************************************
-  ! netcdf error message handling
-  !****************************************************************
-  implicit none
-  integer, intent (in) :: status
-   if(status /= nf90_noerr) then
-      print *, trim(nf90_strerror(status))
-      stop 'Stopped'
-    end if
-end subroutine nf90_err
-
-subroutine writeheader_ncf(lnest)
-
-  !****************************************************************
-  ! Create netcdf file and write header/metadata information
-  ! lnest = .false. : Create main output file
-  ! lnest = .true.  : Create nested output file
-  !****************************************************************
-  implicit none
-
-  logical, intent(in) :: lnest
-
-  integer :: ncid, sID, wdsID, ddsID
-  integer :: timeDimID, latDimID, lonDimID, levDimID, receptorDimID
-  integer :: nspecDimID, npointDimID, nageclassDimID, ncharDimID, pointspecDimID
-  integer :: tID, lonID, latID, levID, poleID, lageID, oroID, ncharrecDimID
-  integer :: volID, areaID
-  integer :: rellng1ID, rellng2ID, rellat1ID, rellat2ID, relzz1ID, relzz2ID
-  integer :: relcomID, relkindzID, relstartID, relendID, relpartID, relxmassID
-  integer :: nnx, nny 
-  integer, dimension(6)       :: dIDs
-  integer, dimension(5)       :: depdIDs
-  character(len=255)          :: fname
-  character(len=15)           :: units
-  character(len=20)           :: fprefix
-  character(len=3)            :: anspec
-  CHARACTER                   :: adate*8,atime*6,timeunit*32
-  !REAL, DIMENSION(1000)       :: coord
-  real, allocatable, dimension(:) :: coord
-
-  integer                     :: cache_size
-  integer, dimension(6)       :: chunksizes
-  integer, dimension(5)       :: dep_chunksizes
-
-  integer                     :: i,ix,jy
-  integer                     :: test_unit
-
-
-  ! Check if output directory exists (the netcdf library will
-  ! otherwise give an error which can look confusing). 
-  ! *********************************************************************
-  open(unit=unittmp,file=trim(path(2)(1:length(2)))//'test_dir.txt',status='replace',&
-       &err=100)
-  close (unittmp, status='delete')
-  goto 101
-100 write(*,FMT='(80("#"))') 
-  write(*,*) 'ERROR: output directory ', trim(path(2)(1:length(2))), ' does not exist&
-       & (or failed to write there).' 
-  write(*,*) 'EXITING' 
-  write(*,FMT='(80("#"))')
-  stop
-101 continue
-
-  !************************
-  ! Create netcdf file
-  !************************
-
-  if (ldirect.eq.1) then
-     write(adate,'(i8.8)') ibdate
-     write(atime,'(i6.6)') ibtime
-     fprefix = 'grid_conc_'
-  else
-     write(adate,'(i8.8)') iedate
-     write(atime,'(i6.6)') ietime
-     fprefix = 'grid_time_'
-  endif
-  if (DRYBKDEP) fprefix='grid_drydep_'
-  if (WETBKDEP) fprefix='grid_wetdep_'
-
-  if (lnest) then
-     fname = path(2)(1:length(2))//trim(fprefix)//adate//atime//'_nest.nc'
-     ncfnamen = fname
-     nnx = numxgridn
-     nny = numygridn
-  else
-     fname = path(2)(1:length(2))//trim(fprefix)//adate//atime//'.nc'
-     ncfname = fname
-     nnx = numxgrid
-     nny = numygrid
-  endif
-
-  cache_size = 16 * nnx * nny * numzgrid
-
-  ! If starting from a restart file, new data will be added to the existing grid file
-  if ((ipin.eq.1).or.(ipin.eq.4)) then
-    call read_grid_id(lnest)
-    return
-  endif
-
-  ! setting cache size in bytes. It is set to 4 times the largest data block that is written
-  !   size_type x nx x ny x nz
-  ! create file
-  call nf90_err(nf90_create(trim(fname), cmode = nf90_hdf5, ncid = ncid, &
-    cache_size = cache_size))  
-
-  ! create dimensions:
-  !*************************
-  ! time
-  call nf90_err(nf90_def_dim(ncid, 'time', nf90_unlimited, timeDimID))
-  timeunit = 'seconds since '//adate(1:4)//'-'//adate(5:6)// &
-     '-'//adate(7:8)//' '//atime(1:2)//':'//atime(3:4)
-
-  ! lon
-  call nf90_err(nf90_def_dim(ncid, 'longitude', nnx, lonDimID))
-  ! lat
-  call nf90_err(nf90_def_dim(ncid, 'latitude', nny, latDimID))
-  ! level
-  call nf90_err(nf90_def_dim(ncid, 'height', numzgrid, levDimID))
-  ! number of species
-  call nf90_err(nf90_def_dim(ncid, 'numspec', nspec, nspecDimID))
-  ! number of release points
-  call nf90_err(nf90_def_dim(ncid, 'pointspec', maxpointspec_act, pointspecDimID))
-  ! number of age classes
-  call nf90_err(nf90_def_dim(ncid, 'nageclass', nageclass, nageclassDimID))
-  ! dimension for release point characters
-  call nf90_err(nf90_def_dim(ncid, 'nchar', 45, ncharDimID))
-  ! dimension for receptor point characters
-  call nf90_err(nf90_def_dim(ncid, 'ncharrec', 16, ncharrecDimID))
-  ! number of actual release points
-  call nf90_err(nf90_def_dim(ncid, 'numpoint', numpoint, npointDimID))
-
-
-  ! create variables
-  !*************************
-
-  ! time
-  call nf90_err(nf90_def_var(ncid, 'time', nf90_int, (/ timeDimID /), tID))
-  call nf90_err(nf90_put_att(ncid, tID, 'units', timeunit))
-  call nf90_err(nf90_put_att(ncid, tID, 'calendar', 'proleptic_gregorian'))
-  if (lnest) then
-     timeIDn = tID
-  else
-     timeID = tID
-  endif
-
-  ! lon
-  call nf90_err(nf90_def_var(ncid, 'longitude', nf90_float, (/ lonDimID /), lonID))
-  call nf90_err(nf90_put_att(ncid, lonID, 'long_name', 'longitude in degree east'))
-  call nf90_err(nf90_put_att(ncid, lonID, 'axis', 'Lon'))
-  call nf90_err(nf90_put_att(ncid, lonID, 'units', 'degrees_east'))
-  call nf90_err(nf90_put_att(ncid, lonID, 'standard_name', 'grid_longitude'))
-  call nf90_err(nf90_put_att(ncid, lonID, 'description', 'grid cell centers'))
-
-  ! lat
-  call nf90_err(nf90_def_var(ncid, 'latitude', nf90_float, (/ latDimID /), latID))
-  call nf90_err(nf90_put_att(ncid, latID, 'long_name', 'latitude in degree north'))
-  call nf90_err(nf90_put_att(ncid, latID, 'axis', 'Lat'))
-  call nf90_err(nf90_put_att(ncid, latID, 'units', 'degrees_north'))
-  call nf90_err(nf90_put_att(ncid, latID, 'standard_name', 'grid_latitude'))
-  call nf90_err(nf90_put_att(ncid, latID, 'description', 'grid cell centers'))
-
-
-  ! height
-  call nf90_err(nf90_def_var(ncid, 'height', nf90_float, (/ levDimID /), levID))
-  ! call nf90_err(nf90_put_att(ncid, levID, 'axis', 'Z'))
-  call nf90_err(nf90_put_att(ncid, levID, 'units', 'meters'))
-  call nf90_err(nf90_put_att(ncid, levID, 'positive', 'up'))
-  call nf90_err(nf90_put_att(ncid, levID, 'standard_name', 'height'))
-  call nf90_err(nf90_put_att(ncid, levID, 'long_name', 'height above ground'))
-
-  ! volume
-  if (write_vol) call nf90_err(nf90_def_var(ncid, 'volume', nf90_float, &
-       &(/ lonDimID, latDimID, levDimID /), volID))
-  ! area 
-  if (write_area) call nf90_err(nf90_def_var(ncid, 'area', nf90_float, &
-       &(/ lonDimID, latDimID /), areaID))
-
-
-  if (write_releases.eqv..true.) then
-    ! release comment
-    call nf90_err(nf90_def_var(ncid, 'RELCOM', nf90_char, (/ ncharDimID,npointDimID /), &
-         relcomID))
-    call nf90_err(nf90_put_att(ncid, relcomID, 'long_name', 'release point name'))
-    ! release longitude 1
-    call nf90_err(nf90_def_var(ncid, 'RELLNG1', nf90_float, (/ npointDimID /), rellng1ID))
-    call nf90_err(nf90_put_att(ncid, rellng1ID, 'units', 'degrees_east'))
-    call nf90_err(nf90_put_att(ncid, rellng1ID, 'long_name', &
-         'release longitude lower left corner'))
-    ! release longitude 2
-    call nf90_err(nf90_def_var(ncid, 'RELLNG2', nf90_float, (/ npointDimID /), rellng2ID))
-    call nf90_err(nf90_put_att(ncid, rellng2ID, 'units', 'degrees_east'))
-    call nf90_err(nf90_put_att(ncid, rellng2ID, 'long_name', &
-         'release longitude upper right corner'))
-    ! release latitude 1
-    call nf90_err(nf90_def_var(ncid, 'RELLAT1', nf90_float, (/ npointDimID /), rellat1ID))
-    call nf90_err(nf90_put_att(ncid, rellat1ID, 'units', 'degrees_north'))
-    call nf90_err(nf90_put_att(ncid, rellat1ID, 'long_name', &
-         'release latitude lower left corner'))
-    ! release latitude 2
-    call nf90_err(nf90_def_var(ncid, 'RELLAT2', nf90_float, (/ npointDimID /), rellat2ID))
-    call nf90_err(nf90_put_att(ncid, rellat2ID, 'units', 'degrees_north'))
-    call nf90_err(nf90_put_att(ncid, rellat2ID, 'long_name', &
-         'release latitude upper right corner'))
-
-    ! hes: if rotated_ll it would be convenient also to write the the release points in rotated_coordinates
-
-    ! release height bottom
-    call nf90_err(nf90_def_var(ncid, 'RELZZ1', nf90_float, (/ npointDimID /), relzz1ID))
-    call nf90_err(nf90_put_att(ncid, relzz1ID, 'units', 'meters'))
-    call nf90_err(nf90_put_att(ncid, relzz1ID, 'long_name', 'release height bottom'))
-    ! release height top
-    call nf90_err(nf90_def_var(ncid, 'RELZZ2', nf90_float, (/ npointDimID /), relzz2ID))
-    call nf90_err(nf90_put_att(ncid, relzz2ID, 'units', 'meters'))
-    call nf90_err(nf90_put_att(ncid, relzz2ID, 'long_name', 'release height top'))
-    ! release kind
-    call nf90_err(nf90_def_var(ncid, 'RELKINDZ', nf90_int, (/ npointDimID /), relkindzID))
-    call nf90_err(nf90_put_att(ncid, relkindzID, 'long_name', 'release kind'))
-    ! release start
-    call nf90_err(nf90_def_var(ncid, 'RELSTART', nf90_int, (/ npointDimID /), relstartID))
-    call nf90_err(nf90_put_att(ncid, relstartID, 'units', 'seconds'))
-    call nf90_err(nf90_put_att(ncid, relstartID, 'long_name', &
-         'release start relative to simulation start'))
-    ! release end
-    call nf90_err(nf90_def_var(ncid, 'RELEND', nf90_int, (/ npointDimID /), relendID))
-    call nf90_err(nf90_put_att(ncid, relendID, 'units', 'seconds'))
-    call nf90_err(nf90_put_att(ncid, relendID, 'long_name', &
-         'release end relative to simulation start'))
-    ! release particles
-    call nf90_err(nf90_def_var(ncid, 'RELPART', nf90_int, (/ npointDimID /), relpartID))
-    call nf90_err(nf90_put_att(ncid, relpartID, 'long_name', 'number of release particles'))
-    ! release particle masses
-    call nf90_err(nf90_def_var(ncid, 'RELXMASS', nf90_float, (/ npointDimID, nspecDimID /), &
-         relxmassID))
-    call nf90_err(nf90_put_att(ncid, relxmassID, 'long_name', 'total release particle mass'))
-  end if
- 
-  ! age classes
-  call nf90_err(nf90_def_var(ncid, 'LAGE', nf90_int, (/ nageclassDimID /), lageID))
-  call nf90_err(nf90_put_att(ncid, lageID, 'units', 'seconds'))
-  call nf90_err(nf90_put_att(ncid, lageID, 'long_name', 'age class'))
-
-  ! output orography
-  if (.not. min_size) then
-    call nf90_err(nf90_def_var(ncid, 'ORO', nf90_int, (/ lonDimID, latDimID /), oroID,  &
-      deflate_level=deflate_level, chunksizes= (/ nnx, nny /)))
-    call nf90_err(nf90_put_att(ncid, oroID, 'standard_name', 'surface altitude'))
-    call nf90_err(nf90_put_att(ncid, oroID, 'long_name', 'outgrid surface altitude'))
-    call nf90_err(nf90_put_att(ncid, oroID, 'units', 'm'))
-  end if
-
-  ! Receptors
-  if (numreceptor.ge.1) then
-    call nf90_err(nf90_def_dim(ncid, 'receptor', nf90_unlimited, receptorDimID)) 
-    call nf90_err(nf90_def_var(ncid, 'receptor', nf90_char, (/ ncharrecDimID,receptorDimID /), sID))
-    call nf90_err(nf90_put_var(ncid, sID, receptorname, (/ 1,1 /), (/ 16,numreceptor /)))
-    call nf90_err(nf90_put_att(ncid, sID, 'long_name', 'receptor name'))
-  endif
-
-  ! concentration output, wet and dry deposition variables (one per species)
-  call output_units(units)
-
-  dIDs = (/ londimid, latdimid, levdimid, timedimid, pointspecdimid, nageclassdimid /)
-  depdIDs = (/ londimid, latdimid, timedimid, pointspecdimid, nageclassdimid /)
-  if (lnest) then
-     dimidsn    = dIDs
-     depdimidsn = depdIDs
-  else
-     dimids    = dIDs
-     depdimids = depdIDs
-  endif
-
-  ! set chunksizes according to largest written portion of data in an individual call to 
-  ! nf90_put_var
-  if (int(nnx,kind=8)*int(nny,kind=8)*int(numzgrid,kind=8).gt.2147483647) then ! Larger than an 
-    chunksizes = (/ nnx, nny, 1, 1, 1, 1 /)
-  else
-    chunksizes = (/ nnx, nny, numzgrid, 1, 1, 1 /)
-  endif
-  dep_chunksizes = (/ nnx, nny, 1, 1, 1 /)
-
-  do i = 1,nspec
-    write(anspec,'(i3.3)') i
-
-    ! concentration output
-    if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
-      call nf90_err(nf90_def_var(ncid,'spec'//anspec//'_mr', nf90_float, dIDs, sID , &
-           deflate_level = deflate_level,  &
-           chunksizes = chunksizes ))
-      call nf90_err(nf90_put_att(ncid, sID, 'units', units))
-      call nf90_err(nf90_put_att(ncid, sID, 'long_name', species(i)))
-      call nf90_err(nf90_put_att(ncid, sID, 'decay', decay(i)))
-      call nf90_err(nf90_put_att(ncid, sID, 'weightmolar', weightmolar(i)))
-    !        call nf90_err(nf90_put_att(ncid, sID, 'ohreact', ohreact(i)))
-      call nf90_err(nf90_put_att(ncid, sID, 'ohcconst', ohcconst(i)))
-      call nf90_err(nf90_put_att(ncid, sID, 'ohdconst', ohdconst(i)))
-      call nf90_err(nf90_put_att(ncid, sID, 'vsetaver', vsetaver(i)))
-
-      if (lnest) then
-         specIDn(i) = sID
-      else
-         specID(i) = sID
-      endif
-    endif
-
-    ! mixing ratio output
-    if ((iout.eq.2).or.(iout.eq.3)) then
-      call nf90_err(nf90_def_var(ncid,'spec'//anspec//'_pptv', nf90_float, dIDs, sID , &
-           deflate_level = deflate_level,  &
-           chunksizes = chunksizes ))
-      call nf90_err(nf90_put_att(ncid, sID, 'units', 'pptv'))
-      call nf90_err(nf90_put_att(ncid, sID, 'long_name', species(i)))
-      call nf90_err(nf90_put_att(ncid, sID, 'decay', decay(i)))
-      call nf90_err(nf90_put_att(ncid, sID, 'weightmolar', weightmolar(i)))
-    !        call nf90_err(nf90_put_att(ncid, sID, 'ohreact', ohreact(i)))
-      call nf90_err(nf90_put_att(ncid, sID, 'ohcconst', ohcconst(i)))
-      call nf90_err(nf90_put_att(ncid, sID, 'ohdconst', ohdconst(i)))
-      call nf90_err(nf90_put_att(ncid, sID, 'vsetaver', vsetaver(i)))
-
-      if (lnest) then
-         specIDnppt(i) = sID
-      else
-         specIDppt(i) = sID
-      endif
-    endif
-
-    ! wet and dry deposition fields for forward runs
-    if ((ldirect.eq.1).and.(wetdep)) then
-      call nf90_err(nf90_def_var(ncid,'WD_spec'//anspec, nf90_float, depdIDs, &
-           wdsID, deflate_level = deflate_level, &
-           chunksizes = dep_chunksizes))
-      call nf90_err(nf90_put_att(ncid, wdsID, 'units', '1e-12 kg m-2'))
-      call nf90_err(nf90_put_att(ncid, wdsID, 'weta_gas', weta_gas(i)))
-      call nf90_err(nf90_put_att(ncid, wdsID, 'wetb_gas', wetb_gas(i)))
-      call nf90_err(nf90_put_att(ncid, wdsID, 'ccn_aero', ccn_aero(i)))
-      call nf90_err(nf90_put_att(ncid, wdsID, 'in_aero', in_aero(i)))
-      ! call nf90_err(nf90_put_att(ncid, wdsID, 'wetc_in', wetc_in(i)))
-      ! call nf90_err(nf90_put_att(ncid, wdsID, 'wetd_in', wetd_in(i)))
-      call nf90_err(nf90_put_att(ncid, wdsID, 'dquer', dquer(i)))
-      call nf90_err(nf90_put_att(ncid, wdsID, 'henry', henry(i)))
-      if (lnest) then
-         wdspecIDn(i) = wdsID
-      else
-         wdspecID(i) = wdsID
-      endif
-    endif
-    if ((ldirect.eq.1).and.(drydep)) then
-      call nf90_err(nf90_def_var(ncid,'DD_spec'//anspec, nf90_float, depdIDs, &
-           ddsID, deflate_level = deflate_level, &
-           chunksizes = dep_chunksizes))
-      call nf90_err(nf90_put_att(ncid, ddsID, 'units', '1e-12 kg m-2'))
-      call nf90_err(nf90_put_att(ncid, ddsID, 'dryvel', dryvel(i)))
-      call nf90_err(nf90_put_att(ncid, ddsID, 'reldiff', reldiff(i)))
-      call nf90_err(nf90_put_att(ncid, ddsID, 'henry', henry(i)))
-      call nf90_err(nf90_put_att(ncid, ddsID, 'f0', f0(i)))
-      call nf90_err(nf90_put_att(ncid, ddsID, 'dquer', dquer(i)))
-      call nf90_err(nf90_put_att(ncid, ddsID, 'density', density(i)))
-      call nf90_err(nf90_put_att(ncid, ddsID, 'dsigma', dsigma(i)))
-      if (lnest) then
-         ddspecIDn(i) = ddsID
-      else
-         ddspecID(i) = ddsID
-      endif
-    endif
-    ! RECEPTORS
-    if (numreceptor.ge.1) then
-      if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
-        call write_to_file(ncid,'receptor_conc'//anspec, nf90_float, (/ timeDimID,receptorDimID /), &
-            sID, (/ 1, numreceptor /), 'ng m-3', .true., 'receptor_conc', 'receptor_concentration')
-        recconcID(i)=sID
-      endif
-      if ((iout.eq.2).or.(iout.eq.3)) then
-        call write_to_file(ncid,'receptor_pptv'//anspec, nf90_float, (/ timeDimID,receptorDimID /), &
-            sID, (/ 1, numreceptor /), 'pptv', .true., 'receptor_pptv', 'receptor_mixingratio')
-        recpptvID(i)=sID
-      endif
-    endif
-  end do
-
-  ! global (metadata) attributes
-  !*******************************
-  call writemetadata(ncid,lnest)
-
-
-  ! moves the file from define to data mode
-  call nf90_err(nf90_enddef(ncid))
-
-  !  ! hes: inquire var definition
-  !  do i = 1,nspec
-  !     write(anspec,'(i3.3)') i
-  !
-  !     ! concentration output
-  !     if (iout.eq.1.or.iout.eq.3.or.iout.eq.5) then
-  !        if (lnest) then
-  !           sID = specIDn(i)
-  !        else
-  !           sID = specID(i)
-  !        endif
-  !        call nf90_err(nf90_inquire_variable(ncid, sID, chunksizes=inq_chunksizes))
-  !        write(*,*) "Chunksizes for var "//anspec//": ", inq_chunksizes
-  !     endif
-  !  end do
-
-  
-  ! fill with data
-  !******************************
-  ! longitudes (grid cell centers)
-  if (lnest) then
-    if (.not.allocated(coord)) allocate(coord(numxgridn))
-     do i = 1,numxgridn
-        coord(i) = outlon0n + (i-0.5)*dxoutn
-     enddo
-     call nf90_err(nf90_put_var(ncid, lonID, coord(1:numxgridn)))
-     deallocate(coord)
-  else
-    if (.not.allocated(coord)) allocate(coord(numxgrid))
-     do i = 1,numxgrid
-        coord(i) = outlon0 + (i-0.5)*dxout
-     enddo
-     call nf90_err(nf90_put_var(ncid, lonID, coord(1:numxgrid)))
-     deallocate(coord)
-  endif
-  ! latitudes (grid cell centers)
-  if (lnest) then
-    if (.not.allocated(coord)) allocate(coord(numygridn))
-     do i = 1,numygridn
-        coord(i) = outlat0n + (i-0.5)*dyoutn
-     enddo
-     call nf90_err(nf90_put_var(ncid, latID, coord(1:numygridn)))
-     deallocate(coord)
-  else
-    if (.not.allocated(coord)) allocate(coord(numygrid))
-     do i = 1,numygrid
-        coord(i) = outlat0 + (i-0.5)*dyout
-     enddo
-     call nf90_err(nf90_put_var(ncid, latID, coord(1:numygrid)))
-     deallocate(coord)
-  endif
-  ! levels
-  call nf90_err(nf90_put_var(ncid, levID, outheight(1:numzgrid)))
-
-  ! volume
-  if (write_vol) then
-    if (lnest) then
-      call nf90_err(nf90_put_var(ncid, volID, volumen(:,:,:)))
-    else
-      call nf90_err(nf90_put_var(ncid, volID, volume(:,:,:)))
-    end if
-  end if
-
-  ! area
-  if (write_area) then
-    if (lnest) then
-      call nf90_err(nf90_put_var(ncid, areaID, arean(:,:)))
-    else
-      call nf90_err(nf90_put_var(ncid, areaID, area(:,:)))
-    end if
-  end if
-
-  if ((write_releases.eqv..true.).and.(ipin.ne.3).and.(ipin.ne.4)) then
-    ! release point information
-    do i = 1,numpoint
-       call nf90_err(nf90_put_var(ncid, relstartID, ireleasestart(i), (/i/)))
-       call nf90_err(nf90_put_var(ncid, relendID, ireleaseend(i), (/i/)))
-       call nf90_err(nf90_put_var(ncid, relkindzID, kindz(i), (/i/)))
-       xp1=xpoint1(i)*dx+xlon0
-       yp1=ypoint1(i)*dy+ylat0
-       xp2=xpoint2(i)*dx+xlon0
-       yp2=ypoint2(i)*dy+ylat0
-       call nf90_err(nf90_put_var(ncid, rellng1ID, xp1, (/i/)))
-       call nf90_err(nf90_put_var(ncid, rellng2ID, xp2, (/i/)))
-       call nf90_err(nf90_put_var(ncid, rellat1ID, yp1, (/i/)))
-       call nf90_err(nf90_put_var(ncid, rellat2ID, yp2, (/i/)))
-       call nf90_err(nf90_put_var(ncid, relzz1ID, zpoint1(i), (/i/)))
-       call nf90_err(nf90_put_var(ncid, relzz2ID, zpoint2(i), (/i/)))
-       call nf90_err(nf90_put_var(ncid, relpartID, npart(i), (/i/)))
-       if ((i .le. 1000).and.(ipin.ne.3).and.(ipin.ne.4)) then
-         call nf90_err(nf90_put_var(ncid, relcomID, compoint(i), (/1,i/), (/45,1/)))
-       else
-         call nf90_err(nf90_put_var(ncid, relcomID, 'NA', (/1,i/), (/45,1/)))
-       endif 
-       call nf90_err(nf90_put_var(ncid, relxmassID, xmass(i,1:nspec), (/i,1/), (/1,nspec/)))
-    end do
-  end if
-
-  ! age classes
-  call nf90_err(nf90_put_var(ncid, lageID, lage(1:nageclass)))
-
-  ! orography 
-  if (.not. min_size) then
-    if (lnest) then
-      call nf90_err(nf90_put_var(ncid, oroID, orooutn(0:(nnx-1), 0:(nny-1))))
-    else
-      call nf90_err(nf90_put_var(ncid, oroID, oroout(0:(nnx-1), 0:(nny-1))))
-    endif
-  end if
-
-  call nf90_err(nf90_close(ncid))
-
-  return
-end subroutine writeheader_ncf
-
-subroutine read_grid_id(lnest)
-  
-  implicit none
-  logical, intent(in) :: lnest
-
-  integer :: ncid,i
-  character(len=3)            :: anspec
-
-  if (.not. lnest) then
-    ! open output file
-    call nf90_err(nf90_open(trim(ncfname), nf90_write, ncid))
-
-    call nf90_err(nf90_inq_varid(ncid=ncid,name='time',varid=timeID))
-
-    do i = 1,nspec
-      write(anspec,'(i3.3)') i
-
-      if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
-        call nf90_err(nf90_inq_varid(ncid=ncid,name='spec'//anspec//'_mr',varid=specID(i)))
-      endif
-      if ((iout.eq.2).or.(iout.eq.3)) then
-        call nf90_err(nf90_inq_varid(ncid=ncid,name='spec'//anspec//'_pptv',varid=specIDppt(i)))
-      endif
-      if ((ldirect.eq.1).and.(wetdep)) then
-        call nf90_err(nf90_inq_varid(ncid=ncid,name='WD_spec'//anspec,varid=wdspecID(i)))
-      endif
-      if ((ldirect.eq.1).and.(drydep)) then
-        call nf90_err(nf90_inq_varid(ncid=ncid,name='DD_spec'//anspec,varid=ddspecID(i)))
-      endif
-    end do
-
-  else
-
-    ! open output file
-    call nf90_err(nf90_open(trim(ncfnamen), nf90_write, ncid))
-
-    call nf90_err(nf90_inq_varid(ncid=ncid,name='time',varid=timeIDn))
-
-    do i = 1,nspec
-      write(anspec,'(i3.3)') i
-
-      if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
-        call nf90_err(nf90_inq_varid(ncid=ncid,name='spec'//anspec//'_mr',varid=specIDn(i)))
-      endif
-      if ((iout.eq.2).or.(iout.eq.3)) then
-        call nf90_err(nf90_inq_varid(ncid=ncid,name='spec'//anspec//'_pptv',varid=specIDnppt(i)))
-      endif
-      if ((ldirect.eq.1).and.(wetdep)) then
-        call nf90_err(nf90_inq_varid(ncid=ncid,name='WD_spec'//anspec,varid=wdspecIDn(i)))
-      endif
-      if ((ldirect.eq.1).and.(drydep)) then
-        call nf90_err(nf90_inq_varid(ncid=ncid,name='DD_spec'//anspec,varid=ddspecIDn(i)))
-      endif
-    end do 
-  endif
-
-  call nf90_err(nf90_close(ncid))
-
-end subroutine read_grid_id
-
-subroutine concoutput_ncf(itime,outnum,gridtotalunc,wetgridtotalunc,drygridtotalunc)
-     
-  !                          i     i          o             o
-  !       o
-  !*****************************************************************************
-  !                                                                            *
-  !     Output of the concentration grid and the receptor concentrations.      *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     24 May 1995                                                            *
-  !                                                                            *
-  !     13 April 1999, Major update: if output size is smaller, dump output in *
-  !                    sparse matrix format; additional output of uncertainty  *
-  !                                                                            *
-  !     05 April 2000, Major update: output of age classes; output for backward*
-  !                    runs is time spent in grid cell times total mass of     *
-  !                    species.                                                *
-  !                                                                            *
-  !     17 February 2002, Appropriate dimensions for backward and forward runs *
-  !                       are now specified in module par_mod                  *
-  !                                                                            *
-  !     June 2006, write grid in sparse matrix with a single write command     *
-  !                in order to save disk space                                 *
-  !                                                                            *
-  !     2008 new sparse matrix format                                          *
-  !                                                                            *
-  !     February 2010, Dominik Brunner, Empa                                   *
-  !                    Adapted for COSMO                                       *
-  !                    Remark: calculation of density could be improved.       *
-  !                    Currently, it is calculated for the lower left corner   *
-  !                    of each output grid cell rather than for its center.    *
-  !                    Furthermore, the average density could be calculated    *
-  !                    from the difference in pressure at the top and bottom   *
-  !                    of each cell rather than by interpolation.              *
-  !                                                                            *
-  !     April 2013, Dominik Brunner, Empa                                      *
-  !                    Adapted for netcdf output                               *
-  !                                                                            *
-  !     2022, Lucie Bakels:                                                    *
-  !           - OpenMP parallelisation                                         *
-  !           - Receptor output to NetCDF instead of binary format             *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! outnum          number of samples                                          *
-  ! ncells          number of cells with non-zero concentrations               *
-  ! sparse          .true. if in sparse matrix format, else .false.            *
-  ! tot_mu          1 for forward, initial mass mixing ration for backw. runs  *
-  !                                                                            *
-  !*****************************************************************************
-
-  use unc_mod, only: gridunc,drygridunc,wetgridunc,drygridunc0,wetgridunc0
-
-  implicit none
-
-  integer, intent(in) :: itime
-  real, intent(in)    :: outnum
-  real(dep_prec),intent(out):: wetgridtotalunc,drygridtotalunc
-  real, intent(out)   :: gridtotalunc
-  real                :: densityoutrecept(maxreceptor),recout(maxreceptor)
-  integer             :: ncid,kp,ks,kz,ix,jy,iix,jjy,kzz,kzzm1,ngrid
-  integer             :: nage,i,l,jj
-  real                :: tot_mu(maxspec,maxpointspec_act)
-  real                :: halfheight,dz,dz1,dz2
-  real                :: xl,yl,xlrot,ylrot,zagnd,zagndprev
-  real(dep_prec)      :: auxgrid(nclassunc)
-  real(dep_prec)      :: gridtotal,gridsigmatotal
-  real(dep_prec)      :: wetgridtotal,wetgridsigmatotal
-  real(dep_prec)      :: drygridtotal,drygridsigmatotal
-  ! real(sp)            :: gridtotal,gridsigmatotal
-  ! real(sp)            :: wetgridtotal,wetgridsigmatotal
-  ! real(sp)            :: drygridtotal,drygridsigmatotal
-
-  real, parameter     :: weightair=28.97
-
-  eps=nxmax/3.e5
-
-  ! open output file
-  call nf90_err(nf90_open(trim(ncfname), nf90_write, ncid))
-
-  ! write time
-  tpointer = tpointer + 1
-  call nf90_err(nf90_put_var( ncid, timeID, itime, (/ tpointer /)))
-  
-  ! For forward simulations, output fields have dimension MAXSPEC,
-  ! for backward simulations, output fields have dimension MAXPOINT.
-  ! Thus, make loops either about nspec, or about numpoint
-  !*****************************************************************
-
-  if (ldirect.eq.1) then
-    do ks=1,nspec
-      do kp=1,maxpointspec_act
-        tot_mu(ks,kp)=1.0
-      end do
-    end do
-  else
-    do ks=1,nspec
-      do kp=1,maxpointspec_act
-        tot_mu(ks,kp)=xmass(kp,ks)
-      end do
-    end do
-  endif
-
-
-  gridtotal=0.
-  gridsigmatotal=0.
-  gridtotalunc=0.
-  wetgridtotal=0._dep_prec
-  wetgridsigmatotal=0._dep_prec
-  wetgridtotalunc=0._dep_prec
-  drygridtotal=0._dep_prec
-  drygridsigmatotal=0._dep_prec
-  drygridtotalunc=0._dep_prec
-
-  !*******************************************************************
-  ! Compute air density:
-  ! brd134: we now take into account whether we are in the mother or in
-  !    a nested domain (before only from mother domain)
-  ! Determine center altitude of output layer, and interpolate density
-  ! data to that altitude
-  !*******************************************************************
-!$OMP PARALLEL PRIVATE(halfheight,kzz,dz1,dz2,dz,xl,yl,ngrid,iix,jjy, &
-!$OMP kz,ix,jy,l,ks,kp,nage,auxgrid) REDUCTION(+:wetgridtotal,wetgridsigmatotal, &
-!$OMP drygridtotal,drygridsigmatotal,gridtotal,gridsigmatotal)
-!$OMP DO
-  do kz=1,numzgrid
-    if (kz.eq.1) then
-      halfheight=outheight(1)/2.
-    else
-      halfheight=(outheight(kz)+outheight(kz-1))/2.
-    endif
-    do kzz=2,nz
-      if ((height(kzz-1).lt.halfheight).and. &
-           (height(kzz).gt.halfheight)) exit
-    end do
-    kzz=max(min(kzz,nz),2)
-    dz1=halfheight-height(kzz-1)
-    dz2=height(kzz)-halfheight
-    dz=dz1+dz2
-
-    do jy=0,numygrid-1
-      do ix=0,numxgrid-1
-        xl=outlon0+real(ix)*dxout
-        yl=outlat0+real(jy)*dyout
-        ! grid index in mother domain
-        xl=(xl-xlon0)/dx
-        yl=(yl-ylat0)/dx
-
-        ngrid=0
-        do jj=numbnests,1,-1
-          if ( xl.gt.xln(jj)+eps .and. xl.lt.xrn(jj)-eps .and. &
-                 yl.gt.yln(jj)+eps .and. yl.lt.yrn(jj)-eps ) then
-            ngrid=jj
-            exit 
-          end if
-        end do
-
-        if (ngrid.eq.0) then
-          iix=max(min(nint(xl),nxmin1),0) ! if output grid cell is outside mother domain
-          jjy=max(min(nint(yl),nymin1),0)
-
-          densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,memind(2))*dz1+ &
-            rho(iix,jjy,kzz-1,memind(2))*dz2)/dz
-        else
-          xl=(xl-xln(ngrid))*xresoln(ngrid)
-          yl=(yl-yln(ngrid))*yresoln(ngrid)
-          iix=max(min(nint(xl),nxn(ngrid)-1),0)
-          jjy=max(min(nint(yl),nyn(ngrid)-1),0)
-
-          densityoutgrid(ix,jy,kz)=(rhon(iix,jjy,kzz,memind(2), ngrid)*dz1+ &
-            rhon(iix,jjy,kzz-1,memind(2), ngrid)*dz2)/dz
-        endif
-      end do
-    end do
-  end do
-!$OMP END DO NOWAIT
-
-  ! brd134: for receptor points no option for nests yet to specify density
-  !    and also altitude zreceptor not considered yet (needs revision)
-  if (numreceptor.gt.0) then
-!$OMP DO
-    do i=1,numreceptor
-      xl=xreceptor(i)
-      yl=yreceptor(i)
-      iix=max(min(nint(xl),nxmin1),0)
-      jjy=max(min(nint(yl),nymin1),0)
-      densityoutrecept(i)=rho(iix,jjy,1,memind(2))
-    end do
-!$OMP END DO NOWAIT
-  endif
-
-  ! Output is different for forward and backward simulations
-  if (ldirect.eq.1) then
-!$OMP DO
-    do kz=1,numzgrid
-      do jy=0,numygrid-1
-         do ix=0,numxgrid-1
-            factor3d(ix,jy,kz)=1.e12/volume(ix,jy,kz)/outnum
-         end do
-      end do
-    end do
-!$OMP END DO
-  else
-!$OMP DO
-    do kz=1,numzgrid
-      do jy=0,numygrid-1
-         do ix=0,numxgrid-1
-            factor3d(ix,jy,kz)=real(abs(loutaver))/outnum
-         end do
-      end do
-    end do
-!$OMP END DO
-  endif
-
-  !*********************************************************************
-  ! Determine the standard deviation of the mean concentration or mixing
-  ! ratio (uncertainty of the output) and the dry and wet deposition
-  !*********************************************************************
-
-
-  do ks=1,nspec
-
-    do kp=1,maxpointspec_act
-      do nage=1,nageclass
-!$OMP DO
-        do jy=0,numygrid-1
-          do ix=0,numxgrid-1
-
-            ! WET DEPOSITION
-            if ((wetdep).and.(ldirect.gt.0)) then
-              if (mpi_mode.gt.0) then
-                do l=1,nclassunc
-                  auxgrid(l)=wetgridunc0(ix,jy,ks,kp,l,nage)
-                end do
-              else
-                do l=1,nclassunc
-                  auxgrid(l)=wetgridunc(ix,jy,ks,kp,l,nage)
-                end do
-              end if
-              call mean(auxgrid,wetgrid(ix,jy), &
-                   wetgridsigma(ix,jy),nclassunc)
-              ! Multiply by number of classes to get total concentration
-              wetgrid(ix,jy)=wetgrid(ix,jy)*real(nclassunc,kind=sp)
-              wetgridtotal=wetgridtotal+wetgrid(ix,jy)
-              ! Calculate standard deviation of the mean
-              wetgridsigma(ix,jy)= &
-                   wetgridsigma(ix,jy)* &
-                   sqrt(real(nclassunc,kind=dep_prec))
-              wetgridsigmatotal=wetgridsigmatotal+ &
-                   wetgridsigma(ix,jy)
-            endif
-
-            ! DRY DEPOSITION
-            if ((drydep).and.(ldirect.gt.0)) then
-              if (mpi_mode.gt.0) then
-                do l=1,nclassunc
-                  auxgrid(l)=drygridunc0(ix,jy,ks,kp,l,nage)
-                end do
-              else
-                do l=1,nclassunc
-                  auxgrid(l)=drygridunc(ix,jy,ks,kp,l,nage)
-                end do
-              end if
-              call mean(auxgrid,drygrid(ix,jy), &
-                   drygridsigma(ix,jy),nclassunc)
-              ! Multiply by number of classes to get total concentration
-              drygrid(ix,jy)=drygrid(ix,jy)*real(nclassunc,kind=sp)
-              drygridtotal=drygridtotal+drygrid(ix,jy)
-              ! Calculate standard deviation of the mean
-              drygridsigma(ix,jy)= &
-                   drygridsigma(ix,jy)* &
-                   sqrt(real(nclassunc, kind=dep_prec))
-              drygridsigmatotal=drygridsigmatotal+ &
-                   drygridsigma(ix,jy)
-            endif
-
-            ! CONCENTRATION OR MIXING RATIO
-            do kz=1,numzgrid
-              do l=1,nclassunc
-                auxgrid(l)=gridunc(ix,jy,kz,ks,kp,l,nage)
-              end do
-              call mean(auxgrid,grid(ix,jy,kz), &
-                   gridsigma(ix,jy,kz),nclassunc)
-              ! Multiply by number of classes to get total concentration
-              grid(ix,jy,kz)= &
-                   grid(ix,jy,kz)*real(nclassunc)
-              gridtotal=gridtotal+grid(ix,jy,kz)
-              ! Calculate standard deviation of the mean
-              gridsigma(ix,jy,kz)= &
-                   gridsigma(ix,jy,kz)* &
-                   sqrt(real(nclassunc))
-              gridsigmatotal=gridsigmatotal+ &
-                   gridsigma(ix,jy,kz)
-            end do
-          end do
-        end do
-!$OMP END DO
-  !       print*,gridtotal,maxpointspec_act
-
-        !*******************************************************************
-        ! Generate output: may be in concentration (ng/m3) or in mixing
-        ! ratio (ppt) or both
-        ! Output the position and the values alternated multiplied by
-        ! 1 or -1, first line is number of values, number of positions
-        ! For backward simulations, the unit is seconds, stored in grid_time
-        !*******************************************************************
-
-        ! Concentration output
-        !*********************
-!$OMP SINGLE
-        if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
-
-          ! Wet deposition
-          if ((ldirect.eq.1).and.(WETDEP)) then
-            call nf90_err(nf90_put_var(ncid,wdspecID(ks),1.e12*&
-                 wetgrid(0:numxgrid-1,0:numygrid-1)/area(0:numxgrid-1,0:numygrid-1),&
-                 (/ 1,1,tpointer,kp,nage /), (/ numxgrid,numygrid,1,1,1 /)))
-          end if
-
-          ! Dry deposition
-          if ((ldirect.eq.1).and.(DRYDEP)) then
-            call nf90_err(nf90_put_var(ncid,ddspecID(ks),1.e12*&
-                 drygrid(0:numxgrid-1,0:numygrid-1)/area(0:numxgrid-1,0:numygrid-1),&
-                 (/ 1,1,tpointer,kp,nage /), (/ numxgrid,numygrid,1,1,1 /)))
-          endif
-
-          ! Concentrations
-          call nf90_err(nf90_put_var(ncid,specID(ks),grid(0:numxgrid-1,0:numygrid-1,&
-             1:numzgrid)*factor3d(0:numxgrid-1,0:numygrid-1,1:numzgrid)/tot_mu(ks,kp),&
-               (/ 1,1,1,tpointer,kp,nage /), (/ numxgrid,numygrid,numzgrid,1,1,1 /) ))
- 
-        endif !  concentration output
-
-        ! Mixing ratio output
-        !********************
-
-        if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
-
-          ! Wet deposition
-          if ((ldirect.eq.1).and.(WETDEP)) then
-            call nf90_err(nf90_put_var(ncid,wdspecID(ks),1.e12*&
-                 wetgrid(0:numxgrid-1,0:numygrid-1)/area(0:numxgrid-1,0:numygrid-1),&
-                 (/ 1,1,tpointer,kp,nage /), (/ numxgrid,numygrid,1,1,1 /)))
-
-          endif
-
-          ! Dry deposition
-          if ((ldirect.eq.1).and.(DRYDEP)) then
-            call nf90_err(nf90_put_var(ncid,ddspecID(ks),1.e12*&
-                 drygrid(0:numxgrid-1,0:numygrid-1)/area(0:numxgrid-1,0:numygrid-1),&
-                 (/ 1,1,tpointer,kp,nage /), (/ numxgrid,numygrid,1,1,1 /)))
-          endif
-
-          ! Mixing ratios
-          call nf90_err(nf90_put_var(ncid,specIDppt(ks),weightair/weightmolar(ks)*&
-               grid(0:numxgrid-1,0:numygrid-1,1:numzgrid)*&
-               factor3d(0:numxgrid-1,0:numygrid-1,1:numzgrid)/&
-               densityoutgrid(0:numxgrid-1,0:numygrid-1,1:numzgrid),&
-               (/ 1,1,1,tpointer,kp,nage /), (/ numxgrid,numygrid,numzgrid,1,1,1 /)))
-
-        endif ! output for ppt
-!$OMP END SINGLE
-!$OMP BARRIER
-      end do
-    end do
-
-  end do
-!$OMP END PARALLEL
-
-  if (gridtotal.gt.0.) gridtotalunc=gridsigmatotal/gridtotal
-  if (wetgridtotal.gt.0.) wetgridtotalunc=wetgridsigmatotal/ &
-       wetgridtotal
-  if (drygridtotal.gt.0.) drygridtotalunc=real(drygridsigmatotal/ &
-       drygridtotal, kind=dep_prec)
-
-  ! Dump of receptor concentrations
-
-  if (numreceptor.ge.1) then 
-    if (iout.eq.2 .or. iout.eq.3) then
-      do ks=1,nspec
-        recout(:)=1.e12*creceptor(:,ks)/outnum*weightair/weightmolar(ks)/densityoutrecept(:)
-        call nf90_err(nf90_put_var(ncid,recpptvID(ks),recout(1:numreceptor),(/ tpointer,1 /),(/ 1,numreceptor /)))
-      end do
-    endif
-
-    ! Dump of receptor concentrations
-
-    if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
-      do ks=1,nspec
-        recout(:)=1.e12*creceptor(:,ks)/outnum
-        call nf90_err(nf90_put_var(ncid,recconcID(ks),recout(1:numreceptor),(/ tpointer,1 /),(/ 1,numreceptor /)))
-      end do
-    endif
-  endif
-
-  ! Close netCDF file
-  !**************************
-  call nf90_err(nf90_close(ncid))
-
-  ! Reinitialization of grid
-  !*************************
-  if (numreceptor.gt.0) creceptor(1:numreceptor,1:nspec) = 0.
-  gridunc(:,:,:,1:nspec,:,:,1:nageclass) = 0.  
-end subroutine concoutput_ncf
-
-subroutine concoutput_sfc_ncf(itime,outnum,gridtotalunc,wetgridtotalunc,drygridtotalunc)
-
-  use unc_mod, only: gridunc,drygridunc,wetgridunc,drygridunc0,wetgridunc0
-
-  implicit none
-
-  integer, intent(in) :: itime
-  real, intent(in)    :: outnum
-  real(sp), intent(out)   :: gridtotalunc
-  real(dep_prec), intent(out)   :: wetgridtotalunc,drygridtotalunc
-
-  print*,'Netcdf output for surface only not yet implemented'
-end subroutine concoutput_sfc_ncf
-
-subroutine concoutput_ncf_nest(itime,outnum)
-  !                               i     i 
-  !*****************************************************************************
-  !                                                                            *
-  !     Output of the concentration grid and the receptor concentrations.      *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     24 May 1995                                                            *
-  !                                                                            *
-  !     13 April 1999, Major update: if output size is smaller, dump output in *
-  !                    sparse matrix format; additional output of uncertainty  *
-  !                                                                            *
-  !     05 April 2000, Major update: output of age classes; output for backward*
-  !                    runs is time spent in grid cell times total mass of     *
-  !                    species.                                                *
-  !                                                                            *
-  !     17 February 2002, Appropriate dimensions for backward and forward runs *
-  !                    are now specified in module par_mod                     *
-  !                                                                            *
-  !     June 2006, write grid in sparse matrix with a single write command     *
-  !                    in order to save disk space                             *
-  !                                                                            *
-  !     2008 new sparse matrix format                                          *
-  !                                                                            *
-  !     19 February 2010, Dominik Brunner, Empa: Adapted for COSMO             *
-  !                                                                            *
-  !     April 2013, Dominik Brunner, Empa                                      *
-  !                    Adapted for netcdf output                               *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! itime           current simulation time                                    *
-  ! outnum          number of samples                                          *
-  !                                                                            *
-  !*****************************************************************************
-
-  use unc_mod, only: griduncn,drygriduncn,wetgriduncn,drygriduncn0,wetgriduncn0
- 
-  implicit none
-
-  integer, intent(in) :: itime
-  real, intent(in)    :: outnum
-  real                :: densityoutrecept(maxreceptor)
-  integer             :: ncid,kp,ks,kz,ix,jy,iix,jjy,kzz,kzzm1,ngrid
-  integer             :: nage,i,l, jj
-  real                :: tot_mu(maxspec,maxpointspec_act)
-  real                :: halfheight,dz,dz1,dz2
-  real                :: xl,yl,xlrot,ylrot,zagnd,zagndprev
-  real(dep_prec)      :: auxgrid(nclassunc)
-  real                :: gridtotal
-  real, parameter     :: weightair=28.97
-
-  eps=nxmax/3.e5
-
-  ! open output file
-  call nf90_err(nf90_open(trim(ncfnamen), nf90_write, ncid))
-
-  ! write time (do not increase time counter here, done in main output domain)
-  call nf90_err(nf90_put_var( ncid, timeID, itime, (/ tpointer /)))
-  
-  ! For forward simulations, output fields have dimension MAXSPEC,
-  ! for backward simulations, output fields have dimension MAXPOINT.
-  ! Thus, make loops either about nspec, or about numpoint
-  !*****************************************************************
-
-  if (ldirect.eq.1) then
-    do ks=1,nspec
-      do kp=1,maxpointspec_act
-        tot_mu(ks,kp)=1.0
-      end do
-    end do
-  else
-    do ks=1,nspec
-      do kp=1,maxpointspec_act
-        tot_mu(ks,kp)=xmass(kp,ks)
-      end do
-    end do
-  endif
-
-  gridtotal=0.
-  !*******************************************************************
-  ! Compute air density:
-  ! brd134: we now take into account whether we are in the mother or in
-  !    a nested domain (before only from mother domain)
-  ! Determine center altitude of output layer, and interpolate density
-  ! data to that altitude
-  !*******************************************************************
-!$OMP PARALLEL PRIVATE(halfheight,kzz,dz1,dz2,dz,xl,yl,ngrid,iix,jjy, &
-!$OMP kz,ix,jy,l,ks,kp,nage,auxgrid) REDUCTION(+:gridtotal)
-!$OMP DO
-  do kz=1,numzgrid
-    if (kz.eq.1) then
-      halfheight=outheight(1)/2.
-    else
-      halfheight=(outheight(kz)+outheight(kz-1))/2.
-    endif
-    do kzz=2,nz
-      if ((height(kzz-1).lt.halfheight).and. &
-           (height(kzz).gt.halfheight)) exit
-    end do
-    kzz=max(min(kzz,nz),2)
-    dz1=halfheight-height(kzz-1)
-    dz2=height(kzz)-halfheight
-    dz=dz1+dz2
-
-    do jy=0,numygridn-1
-      do ix=0,numxgridn-1
-        xl=outlon0n+real(ix)*dxoutn
-        yl=outlat0n+real(jy)*dyoutn
-        xl=(xl-xlon0)/dx
-        yl=(yl-ylat0)/dy
-
-        ngrid=0
-        do jj=numbnests,1,-1
-          if ( xl.gt.xln(jj)+eps .and. xl.lt.xrn(jj)-eps .and. &
-                 yl.gt.yln(jj)+eps .and. yl.lt.yrn(jj)-eps ) then
-            ngrid=jj
-            exit 
-          end if
-        end do
-
-        if (ngrid.eq.0) then
-          iix=max(min(nint(xl),nxmin1),0)
-          jjy=max(min(nint(yl),nymin1),0)
-
-          densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,memind(2))*dz1+ &
-             rho(iix,jjy,kzz-1,memind(2))*dz2)/dz
-        else
-          xl=(xl-xln(ngrid))*xresoln(ngrid)
-          yl=(yl-yln(ngrid))*yresoln(ngrid)
-          iix=max(min(nint(xl),nxn(ngrid)-1),0)
-          jjy=max(min(nint(yl),nyn(ngrid)-1),0)
-          densityoutgrid(ix,jy,kz)=(rhon(iix,jjy,kzz,memind(2), ngrid)*dz1+ &
-             rhon(iix,jjy,kzz-1,memind(2), ngrid)*dz2)/dz
-        endif
-
-      end do
-    end do
-  end do
-!$OMP END DO NOWAIT
-
-  if (numreceptor.gt.0) then
-!$OMP DO
-     do i=1,numreceptor
-       xl=xreceptor(i)
-       yl=yreceptor(i)
-       iix=max(min(nint(xl),nxmin1),0)
-       jjy=max(min(nint(yl),nymin1),0)
-       densityoutrecept(i)=rho(iix,jjy,1,memind(2))
-     end do
-!$OMP END DO NOWAIT
-  endif
-
-  ! Output is different for forward and backward simulations
-  if (ldirect.eq.1) then
-!$OMP DO
-     do kz=1,numzgrid
-        do jy=0,numygridn-1
-           do ix=0,numxgridn-1
-              factor3d(ix,jy,kz)=1.e12/volumen(ix,jy,kz)/outnum
-           end do
-        end do
-     end do
-!$OMP END DO
-  else
-!$OMP DO
-     do kz=1,numzgrid
-        do jy=0,numygridn-1
-           do ix=0,numxgridn-1
-              factor3d(ix,jy,kz)=real(abs(loutaver))/outnum
-           end do
-        end do
-     end do
-!$OMP END DO
-  endif
-
-  !*********************************************************************
-  ! Determine the standard deviation of the mean concentration or mixing
-  ! ratio (uncertainty of the output) and the dry and wet deposition
-  !*********************************************************************
-
-  do ks=1,nspec
-
-    do kp=1,maxpointspec_act
-      do nage=1,nageclass
-!$OMP DO
-        do jy=0,numygridn-1
-          do ix=0,numxgridn-1
-            ! WET DEPOSITION
-            if ((WETDEP).and.(ldirect.gt.0)) then
-              if (mpi_mode.gt.0) then
-                do l=1,nclassunc
-                  auxgrid(l)=wetgriduncn0(ix,jy,ks,kp,l,nage)
-                end do
-              else
-                do l=1,nclassunc
-                  auxgrid(l)=wetgriduncn(ix,jy,ks,kp,l,nage)
-                end do
-              end if
-              call mean(auxgrid,wetgrid(ix,jy), &
-                   wetgridsigma(ix,jy),nclassunc)
-              ! Multiply by number of classes to get total concentration
-              wetgrid(ix,jy)=wetgrid(ix,jy)*real(nclassunc)
-              ! Calculate standard deviation of the mean
-              wetgridsigma(ix,jy)= &
-                   wetgridsigma(ix,jy)* &
-                   sqrt(real(nclassunc,kind=dep_prec))
-            endif
-
-            ! DRY DEPOSITION
-            if ((DRYDEP).and.(ldirect.gt.0)) then
-              if (mpi_mode.gt.0) then
-                do l=1,nclassunc
-                  auxgrid(l)=drygriduncn0(ix,jy,ks,kp,l,nage)
-                end do
-              else
-                do l=1,nclassunc
-                  auxgrid(l)=drygriduncn(ix,jy,ks,kp,l,nage)
-                end do
-              end if
-              call mean(auxgrid,drygrid(ix,jy), &
-                   drygridsigma(ix,jy),nclassunc)
-              ! Multiply by number of classes to get total concentration
-              drygrid(ix,jy)=drygrid(ix,jy)*real(nclassunc)
-              ! Calculate standard deviation of the mean
-              drygridsigma(ix,jy)= &
-                   drygridsigma(ix,jy)* &
-                   sqrt(real(nclassunc,kind=dep_prec))
-            endif
-
-            ! CONCENTRATION OR MIXING RATIO
-            do kz=1,numzgrid
-              do l=1,nclassunc
-                auxgrid(l)=griduncn(ix,jy,kz,ks,kp,l,nage)
-              end do
-              call mean(auxgrid,grid(ix,jy,kz), &
-                   gridsigma(ix,jy,kz),nclassunc)
-              ! Multiply by number of classes to get total concentration
-              grid(ix,jy,kz)= &
-                   grid(ix,jy,kz)*real(nclassunc)
-              gridtotal=gridtotal+grid(ix,jy,kz)
-              ! Calculate standard deviation of the mean
-              gridsigma(ix,jy,kz)= &
-                   gridsigma(ix,jy,kz)* &
-                   sqrt(real(nclassunc))
-            end do
-          end do
-        end do
-!$OMP END DO
-  !       print*,gridtotal,maxpointspec_act
-
-        !*******************************************************************
-        ! Generate output: may be in concentration (ng/m3) or in mixing
-        ! ratio (ppt) or both
-        ! Output the position and the values alternated multiplied by
-        ! 1 or -1, first line is number of values, number of positions
-        ! For backward simulations, the unit is seconds, stored in grid_time
-        !*******************************************************************
-
-        ! Concentration output
-        !*********************
-!$OMP SINGLE
-        if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
-
-          ! Wet deposition
-          if ((ldirect.eq.1).and.(WETDEP)) then
-             call nf90_err(nf90_put_var(ncid,wdspecIDn(ks),1.e12*&
-                  wetgrid(0:numxgridn-1,0:numygridn-1)/arean(0:numxgridn-1,0:numygridn-1),&
-                  (/ 1,1,tpointer,kp,nage /), (/ numxgridn,numygridn,1,1,1 /)))
-          endif
-
-          ! Dry deposition
-          if ((ldirect.eq.1).and.(DRYDEP)) then
-             call nf90_err(nf90_put_var(ncid,ddspecIDn(ks),1.e12*&
-                  drygrid(0:numxgridn-1,0:numygridn-1)/arean(0:numxgridn-1,0:numygridn-1),&
-                  (/ 1,1,tpointer,kp,nage /), (/ numxgridn,numygridn,1,1,1 /)))
-          endif
-
-          ! Concentrations
-          call nf90_err(nf90_put_var(ncid,specIDn(ks),grid(0:numxgridn-1,0:numygridn-1,&
-             1:numzgrid)*factor3d(0:numxgridn-1,0:numygridn-1,1:numzgrid)/tot_mu(ks,kp),&
-               (/ 1,1,1,tpointer,kp,nage /), (/ numxgridn,numygridn,numzgrid,1,1,1 /)))
- 
-        endif !  concentration output
-
-        ! Mixing ratio output
-        !********************
-
-        if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
-
-          ! Wet deposition
-          if ((ldirect.eq.1).and.(WETDEP)) then
-             call nf90_err(nf90_put_var(ncid,wdspecIDn(ks),1.e12*&
-                  wetgrid(0:numxgridn-1,0:numygridn-1)/arean(0:numxgridn-1,0:numygridn-1),&
-                  (/ 1,1,tpointer,kp,nage /), (/ numxgridn,numygridn,1,1,1 /)))
-          endif
-
-          ! Dry deposition
-          if ((ldirect.eq.1).and.(DRYDEP)) then
-             call nf90_err(nf90_put_var(ncid,ddspecIDn(ks),1.e12*&
-                  drygrid(0:numxgridn-1,0:numygridn-1)/arean(0:numxgridn-1,0:numygridn-1),&
-                  (/ 1,1,tpointer,kp,nage /), (/ numxgridn,numygridn,1,1,1 /)))
-          endif
-
-          ! Mixing ratios
-          call nf90_err(nf90_put_var(ncid,specIDnppt(ks),weightair/weightmolar(ks)*&
-               grid(0:numxgridn-1,0:numygridn-1,1:numzgrid)*&
-               factor3d(0:numxgridn-1,0:numygridn-1,1:numzgrid)/&
-               densityoutgrid(0:numxgridn-1,0:numygridn-1,1:numzgrid),&
-               (/ 1,1,1,tpointer,kp,nage /), (/ numxgridn,numygridn,numzgrid,1,1,1 /)))
-
-        endif ! output for ppt
-!$OMP END SINGLE
-!$OMP BARRIER
-      end do
-    end do
-
-  end do
-!$OMP END PARALLEL
-  ! Close netCDF file
-  !**************************
-  call nf90_err(nf90_close(ncid))
-
-  ! Reinitialization of grid
-  !*************************
-
-  if (numreceptor.gt.0) creceptor(1:numreceptor,1:nspec) = 0.
-  griduncn(:,:,:,1:nspec,:,:,1:nageclass) = 0.  
-end subroutine concoutput_ncf_nest
-
-subroutine concoutput_sfc_ncf_nest(itime,outnum)
-
-  implicit none
-
-  integer, intent(in) :: itime
-  real, intent(in)    :: outnum
-
-  print*,'Netcdf output for surface only not yet implemented'
-end subroutine concoutput_sfc_ncf_nest
-
-subroutine particle_initialpos(itime,idate,itime_start,idate_start)
-
-  !*****************************************************************************
-  !                                                                            *
-  !   This subroutine creates an initial particle positions and properties     *
-  !   NetCDF file: partinit_xxx.nc                                             *
-  !   The release time, release number and positions, together with all fields *
-  !   specified in the PARTOPTIONS option file will saved.                     *
-  !                                                                            *
-  !   Author: L. Bakels 2022                                                   *
-  !                                                                            *
-  !*****************************************************************************
-
-  implicit none
-
-  integer, intent(in) :: itime,idate,itime_start,idate_start
-  ! integer, intent(in) :: irelease
-  integer             :: cache_size,ncid,j,totpart,np
-  integer             :: partDimID
-  character(len=11)   :: fprefix
-  character(len=3)    :: anspec,arelease
-  character           :: adate*8,atime*6,adate_start*8,atime_start*6,timeunit*32
-  character(len=255)  :: fname_partoutput
-  real                :: fillval
-
-  write(adate,'(i8.8)') idate
-  write(atime,'(i6.6)') itime
-  write(adate_start,'(i8.8)') idate_start
-  write(atime_start,'(i6.6)') itime_start
-  ! write(arelease, '(i3.3)') irelease
-  fprefix = 'partinit_'!rel'//arelease//'_'
-
-  fname_partoutput = path(2)(1:length(2))//trim(fprefix)//adate//atime//'.nc'
-  !ncfname_part(irelease) = fname_partoutput
-  ncfname_partinit = fname_partoutput
-
-  call nf90_err(nf90_create(trim(fname_partoutput), cmode = nf90_hdf5, ncid = ncid))!, &
-    ! cache_size = cache_size))
-
-  ! create dimensions:
-  !*************************
-  
-  ! particle
-  partinitpointer=0
-  call nf90_err(nf90_def_dim(ncid, 'particle', nf90_unlimited, partDimID))
-
-  ! create variables
-  !*************************
-
-  ! particles
-  call nf90_err(nf90_def_var(ncid, 'particle', nf90_int, (/ partDimID/), partIDi))
-  call nf90_err(nf90_put_att(ncid, partIDi, 'long_name', 'particle index'))
-
-  fillval = -1.
-  ! time
-  timeunit = 'seconds since '//adate_start(1:4)//'-'//adate_start(5:6)// &
-     '-'//adate_start(7:8)//' '//atime_start(1:2)//':'//atime_start(3:4)
-
-  call write_to_file(ncid,'time',nf90_int,(/ partDimID /),tIDi,(/ 1 /), &
-    timeunit,.false.,'time','time of release')
-  call nf90_err(nf90_put_att(ncid, tIDi, 'axis', 't'))
-  call nf90_err(nf90_put_att(ncid, tIDi, 'calendar', 'proleptic_gregorian'))
-  call nf90_err(nf90_put_att(ncid, tIDi, 'description', 'time of release'))
-
-  ! lon  
-  call write_to_file(ncid,'longitude',nf90_float,(/ partDimID /),lonIDi,(/ 1 /), &
-    'degrees_east',.false.,'longitude','longitude in degree east')
-  call nf90_err(nf90_put_att(ncid, lonIDi, 'axis', 'Lon'))
-  call nf90_err(nf90_put_att(ncid, lonIDi, 'description', 'longitude of particles'))
-
-  ! lat
-  call write_to_file(ncid,'latitude',nf90_float,(/ partDimID /),latIDi,(/ 1 /), &
-    'degrees_north',.false.,'latitude','latitude in degree north')
-  call nf90_err(nf90_put_att(ncid, latIDi, 'axis', 'Lat'))
-  call nf90_err(nf90_put_att(ncid, latIDi, 'description', 'latitude of particles'))
-
-  ! height
-  call write_to_file(ncid,'height',nf90_float,(/ partDimID /),levIDi,(/ 1 /), &
-   'meters',.true.,'height','height above ground')
-
-  ! release
-  call write_to_file(ncid,'release',nf90_int,(/ partDimID /),relIDi,(/ 1 /), &
-   '',.true.,'release','particle release')
-
-  do np=1,num_partopt
-    if (.not. partopt(np)%print) cycle
-    select case(partopt(np)%name)
-      case ('PV') ! Potential vorticity
-        call write_to_file(ncid,'pv',nf90_float,(/ partDimID /),pvIDi,(/ 1 /), &
-          'pvu',.false.,'potential_vorticity','potential vorticity')
-      case ('PR') ! Pressure
-        call write_to_file(ncid,'pr',nf90_float,(/ partDimID /),prIDi,(/ 1 /), &
-          'Pa',.false.,'pressure','pressure')
-      case ('QV') ! Specific humidity
-        call write_to_file(ncid,'qv',nf90_float,(/ partDimID /),qvIDi,(/ 1 /), &
-          '',.false.,'specific_humidity','specific humidity')
-      case ('RH') ! Density
-        call write_to_file(ncid,'rho',nf90_float,(/ partDimID /),rhoIDi,(/ 1 /), &
-          'kg/m3',.true.,'density','density')
-      case ('TT') ! Temperature
-        call write_to_file(ncid,'temperature',nf90_float,(/ partDimID /),ttIDi,(/ 1 /), &
-          'K',.true.,'temperature','temperature')
-      case ('UU')
-        call write_to_file(ncid,'u',nf90_float,(/ partDimID /),uIDi,(/ 1 /), &
-          'm/s',.false.,'u','longitudinal velocity')
-      case ('VV')
-        call write_to_file(ncid,'v',nf90_float,(/ partDimID /),vIDi,(/ 1 /), &
-          'm/s',.false.,'v','latitudinal velocity')
-      case ('WW')
-        call write_to_file(ncid,'w',nf90_float,(/ partDimID /),wIDi,(/ 1 /), &
-          'm/s',.false.,'w','vertical velocity')
-      case ('MA')
-        do j=1,nspec
-          ! Masses
-          write(anspec, '(i3.3)') j
-          call write_to_file(ncid,'mass'//anspec,nf90_float,(/ partDimID /),massIDi(j), &
-            (/ 1 /),'kg',.true.,'mass'//anspec,'mass for nspec'//anspec) 
-        end do        
-      case ('TO')
-        call write_to_file(ncid,'topo',nf90_float,(/ partDimID /),topoIDi,(/ 1 /), &
-          'meters',.false.,'topography','topography above sealevel')
-      case ('TR')
-        call write_to_file(ncid,'tr',nf90_float,(/ partDimID /),trIDi,(/ 1 /), &
-          'meters',.true.,'htropo','height above ground of tropopause')
-      case ('HM') ! Mixing layer height
-        call write_to_file(ncid,'hmix',nf90_float,(/ partDimID /),hmixIDi,(/ 1 /), &
-          'meters',.true.,'hmix','height above ground of mixing layer')        
-      case default
-        cycle
-    end select
-  end do
-
-  ! moves the file from define to data mode
-  call nf90_err(nf90_enddef(ncid))
-
-  call nf90_err(nf90_close(ncid))
-end subroutine particle_initialpos
-
-subroutine wrt_part_initialpos(itime,istart,iend)
-
-  !*****************************************************************************
-  !                                                                            *
-  !   This subroutine saves initial particle positions, release time and       *
-  !   releasenumber to a NetCDF file created in particle_initialpos *
-  !   evertime a new particle is spawned.                                      *
-  !                                                                            *
-  !   Author: L. Bakels 2022                                                   *
-  !                                                                            *
-  !*****************************************************************************
-
-  use particle_mod
-
-  implicit none
-
-  integer, intent(in) ::  &
-    itime,               & ! time of particle release
-    istart,              & ! index of first newly released particle
-    iend                   ! index of last newly released partile
-  integer, allocatable    :: partindices(:),releasetimes(:)
-  integer :: newpart,ncid,j
-
-  newpart = iend-istart
-  if (newpart.eq.0) return
-  write(*,*) newpart, ' particles are being added to partinit.'
-  call nf90_err(nf90_open(trim(ncfname_partinit), nf90_write, ncid))
-
-  allocate ( partindices(newpart) )
-
-  do j=1,newpart
-    partindices(j)=j+partinitpointer
-  end do
-
-  partinitpointer1= partinitpointer+1 ! this is also used in partinit_ncf
-  call nf90_err(nf90_put_var(ncid,partIDi,partindices,(/ partinitpointer1 /),(/ newpart /)))
-  deallocate (partindices)
-
-  allocate ( releasetimes(newpart) )
-  releasetimes=itime
-  call nf90_err(nf90_put_var(ncid,tIDi,releasetimes,(/ partinitpointer1 /),(/ newpart /)))
-  deallocate (releasetimes)
-  call nf90_err(nf90_put_var(ncid,lonIDi,xlon0+part(partinitpointer1:iend)%xlon*dx, (/ partinitpointer1 /),(/ newpart /)))
-  call nf90_err(nf90_put_var(ncid,latIDi,ylat0+part(partinitpointer1:iend)%ylat*dy, (/ partinitpointer1 /),(/ newpart /)))
-  call nf90_err(nf90_put_var(ncid,levIDi,part(partinitpointer1:iend)%z, (/ partinitpointer1 /),(/ newpart /)))
-  call nf90_err(nf90_put_var(ncid,relIDi,part(partinitpointer1:iend)%npoint, (/ partinitpointer1 /),(/ newpart /)))
-
-  call nf90_err(nf90_close(ncid))
-
-  partinitpointer = partinitpointer+newpart
-end subroutine wrt_part_initialpos
-
-subroutine partinit_ncf(itime,field,fieldname,imass,ncid)
-
-  !*****************************************************************************
-  !                                                                            *
-  !   This subroutine saves properties chosen by the user in PARTOPTIONS       *
-  !   to a NetCDF file created in particle_initialpos.                         *
-  !   This happens whenever a new particle is spawned.                         *
-  !                                                                            *
-  !   Author: L. Bakels 2022                                                   *
-  !                                                                            *
-  !*****************************************************************************
-
-  implicit none
-
-  integer, intent(in)            :: itime,imass
-  real, intent(in)               :: field(:)
-  character(2), intent(in)       :: fieldname  ! input field to interpolate over
-  integer, allocatable           :: partindices(:)
-  integer                        :: ncid,newpart,j,iend
-
-  newpart = partinitpointer - (partinitpointer1-1)
-
-  select case(fieldname)
-    case('TO') ! Topography
-      call nf90_err(nf90_put_var(ncid,topoIDi,field(partinitpointer1:partinitpointer), &
-        (/ partinitpointer1 /),(/ newpart /)))
-    case('PV') ! Potential vorticity
-      call nf90_err(nf90_put_var(ncid,pvIDi,field(partinitpointer1:partinitpointer), &
-        (/ partinitpointer1 /),(/ newpart /)))
-    case('PR') ! Pressure
-      call nf90_err(nf90_put_var(ncid,prIDi,field(partinitpointer1:partinitpointer), &
-        (/ partinitpointer1 /),(/ newpart /)))
-    case('QV') ! Specific humidity
-      call nf90_err(nf90_put_var(ncid,qvIDi,field(partinitpointer1:partinitpointer), &
-        (/ partinitpointer1 /),(/ newpart /)))
-    case('RH') ! Air density
-      call nf90_err(nf90_put_var(ncid,rhoIDi,field(partinitpointer1:partinitpointer), &
-        (/ partinitpointer1 /),(/ newpart /)))
-    case('UU') ! Longitudinal velocity
-      call nf90_err(nf90_put_var(ncid,uIDi,field(partinitpointer1:partinitpointer), &
-        (/ partinitpointer1 /),(/ newpart /)))
-    case('VV') ! Latitudinal velocity
-      call nf90_err(nf90_put_var(ncid,vIDi,field(partinitpointer1:partinitpointer), &
-        (/ partinitpointer1 /),(/ newpart /)))
-    case('WW') ! Vertical velocity
-      call nf90_err(nf90_put_var(ncid,wIDi,field(partinitpointer1:partinitpointer), &
-        (/ partinitpointer1 /),(/ newpart /)))
-    case('TT') ! Temperature
-      call nf90_err(nf90_put_var(ncid,ttIDi,field(partinitpointer1:partinitpointer), &
-        (/ partinitpointer1 /),(/ newpart /)))
-    case('MA') ! Mass
-      call nf90_err(nf90_put_var(ncid,massIDi(imass),field(partinitpointer1:partinitpointer), &
-        (/ partinitpointer1 /),(/ newpart /)))
-    case('TR') ! Tropopause
-      call nf90_err(nf90_put_var(ncid,trIDi,field(partinitpointer1:partinitpointer), &
-        (/ partinitpointer1 /),(/ newpart /)))
-    case('HM') ! Mixing height
-      call nf90_err(nf90_put_var(ncid,hmixIDi,field(partinitpointer1:partinitpointer), &
-        (/ partinitpointer1 /),(/ newpart /)))
-    case default
-      return
-  end select
-end subroutine partinit_ncf
-
-subroutine writeheader_partoutput(itime,idate,itime_start,idate_start)!,irelease)
-
-  !*****************************************************************************
-  !                                                                            *
-  !   This subroutine creates a file (partoutput_xxx.nc), where every time     *
-  !   interval particle properties specified in the PARTOPTIONS option file    *
-  !   are saved to. Running options are saved as header informtion to this     *
-  !   file as well.                                                            *
-  !                                                                            *
-  !   Author: L. Bakels 2021                                                   *
-  !                                                                            *
-  !*****************************************************************************
-
-  implicit none
-
-  integer, intent(in) :: itime,idate,itime_start,idate_start
-  ! integer, intent(in) :: irelease
-  integer             :: cache_size,ncid,j,i,totpart,np
-  integer             :: timeDimID,partDimID,tID,memDimID
-  integer             :: latDimID, lonDimID, lonID, latID
-  character(len=11)   :: fprefix
-  character(len=3)    :: anspec,arelease
-  character           :: adate*8,atime*6,adate_start*8,atime_start*6,timeunit*32
-  character(len=255)  :: fname_partoutput
-  real                :: fillval
-  real, allocatable, dimension(:) :: coord
-
-  logical,save :: first_time=.true.
-
-  open(unit=unittmp,file=trim(path(2)(1:length(2)))//'test_dir.txt',status='replace',&
-       &err=110)
-  close (unittmp, status='delete')
-
-  write(adate,'(i8.8)') idate
-  write(atime,'(i6.6)') itime
-  write(adate_start,'(i8.8)') idate_start
-  write(atime_start,'(i6.6)') itime_start
-  ! write(arelease, '(i3.3)') irelease
-  fprefix = 'partoutput_'!rel'//arelease//'_'
-
-  ! Reset logicals that ensure ony 1 write out in case of domainfill
-  topo_written=.false.
-  mass_written=.false.
-  massav_written=.false.
-
-  if (first_time) then
-    fname_partoutput = path(2)(1:length(2))//trim(fprefix)//adate//atime//'_init.nc'
-    first_time=.false.
-  else
-    fname_partoutput = path(2)(1:length(2))//trim(fprefix)//adate//atime//'.nc'
-  endif
-  !ncfname_part(irelease) = fname_partoutput
-  ncfname_part = fname_partoutput
-
-  totpart=0
-  if (ipin.gt.1) then ! Not reading from a release has no npart
-    totpart=numpart
-  else
-    do j=1,numpoint
-      totpart = totpart+npart(j)
-    end do
-  endif
-  !totpart = maxpart!max(numpart,totpart)
-  !cache_size = 4 * 1 * (12+nspec)
-
-  write(*,*) 'Write header, nspec,numpart,totpart: ', nspec,numpart,totpart
-
-  call nf90_err(nf90_create(trim(fname_partoutput), cmode = nf90_hdf5, ncid = ncid))!, &
-    ! cache_size = cache_size))
-
-  ! create dimensions:
-  !*************************
-  ! time
-  call nf90_err(nf90_def_dim(ncid, 'time', nf90_unlimited, timeDimID))
-  timeunit = 'seconds since '//adate_start(1:4)//'-'//adate_start(5:6)// &
-     '-'//adate_start(7:8)//' '//atime_start(1:2)//':'//atime_start(3:4)
-
-  ! particle
-  call nf90_err(nf90_def_dim(ncid, 'particle', nf90_unlimited, partDimID)) !totpart needs to be the actual number of particles
-
-  ! If domainfill, save topo, hmix, and htropo to grid to save space
-  !*****************************************************************
-  if (mdomainfill.ge.1) then
-    call nf90_err(nf90_def_dim(ncid, 'lon', nx, lonDimID))
-    call nf90_err(nf90_def_dim(ncid, 'lat', ny, latDimID))
-
-    ! lon
-    call write_to_file(ncid,'lon',nf90_float,(/ lonDimID /),lonID,(/ 1 /), &
-      'degrees_east',.false.,'grid_longitude','longitude in degree east')
-    call nf90_err(nf90_put_att(ncid, lonID, 'axis', 'Lon'))
-    call nf90_err(nf90_put_att(ncid, lonID, 'description', 'grid cell centers'))
-
-    ! lat
-    call write_to_file(ncid,'lat',nf90_float,(/ latDimID /),latID,(/ 1 /), &
-      'degrees_east',.false.,'grid_latitude','latitude in degree north')
-    call nf90_err(nf90_put_att(ncid, latID, 'axis', 'Lat'))
-    call nf90_err(nf90_put_att(ncid, latID, 'description', 'grid cell centers'))
-
-    if (.not.allocated(coord)) allocate(coord(nx))
-     do i = 1,nx
-        coord(i) = xlon0 + i*dx
-     enddo
-     call nf90_err(nf90_put_var(ncid, lonID, coord(1:nx)))
-     deallocate(coord)
-
-    if (.not.allocated(coord)) allocate(coord(ny))
-     do i = 1,ny
-        coord(i) = ylat0 + i*dy
-     enddo
-     call nf90_err(nf90_put_var(ncid, latID, coord(1:ny)))
-     deallocate(coord)
-
-  endif
-  ! create variables
-  !*************************
-
-  ! time
-  tpointer_part=0
-  call nf90_err(nf90_def_var(ncid, 'time', nf90_int, (/ timeDimID /), tID))
-  call nf90_err(nf90_put_att(ncid, tID, 'units', timeunit))
-  call nf90_err(nf90_put_att(ncid, tID, 'calendar', 'proleptic_gregorian'))
-
-  timeIDpart=tID
-  ! particles
-  call nf90_err(nf90_def_var(ncid, 'particle', nf90_int, (/ partDimID/), partID))
-  call nf90_err(nf90_put_att(ncid, partID, 'long_name', 'particle index'))
-
-  fillval = -1.
-  do np=1,num_partopt
-    if (.not. partopt(np)%print) cycle
-    select case(partopt(np)%name)
-      case ('LO') ! Longitude
-        call write_to_file(ncid,'longitude',nf90_float,(/ timeDimID,partDimID /),lonIDpart,(/ 1,totpart /), &
-          'degrees_east',.false.,'longitude','longitude of particles')
-        call nf90_err(nf90_put_att(ncid, lonIDpart, 'axis', 'Lon'))
-        call nf90_err(nf90_put_att(ncid, lonIDpart, 'description', 'longitude of particles'))
-      case ('lo') ! Longitude averaged
-        call write_to_file(ncid,'longitude_av',nf90_float,(/ timeDimID,partDimID /),lonavIDpart,(/ 1,totpart /), &
-          'degrees_east',.false.,'longitude_average','averaged longitude of particles')
-        call nf90_err(nf90_put_att(ncid, lonavIDpart, 'axis', 'Lon'))
-        call nf90_err(nf90_put_att(ncid, lonavIDpart, 'description', 'averaged longitude of particles'))
-      case ('LA') ! Latitude
-        call write_to_file(ncid,'latitude',nf90_float,(/ timeDimID,partDimID /),latIDpart,(/ 1,totpart /), &
-          'degrees_north',.false.,'latitude','latitude in degree north')
-        call nf90_err(nf90_put_att(ncid, latIDpart, 'axis', 'Lat'))
-        call nf90_err(nf90_put_att(ncid, latIDpart, 'description', 'latitude of particles'))
-      case ('la') ! Latitude averaged
-        call write_to_file(ncid,'latitude_av',nf90_float,(/ timeDimID,partDimID /),latavIDpart,(/ 1,totpart /), &
-          'degrees_north',.false.,'latitude_average','averaged latitude in degree north')
-        call nf90_err(nf90_put_att(ncid, latavIDpart, 'axis', 'Lat'))
-        call nf90_err(nf90_put_att(ncid, latavIDpart, 'description', 'averaged latitude of particles'))
-      case ('ZZ') ! Height
-        call write_to_file(ncid,'height',nf90_float,(/ timeDimID,partDimID /),levIDpart,(/ 1,totpart /), &
-          'meters',.false.,'height','height above ground')
-      case ('zz') ! Heights averaged
-        call write_to_file(ncid,'height_av',nf90_float,(/ timeDimID,partDimID /),levavIDpart,(/ 1,totpart /), &
-          'meters',.false.,'height_average','averaged height above ground')
-      case ('PV') ! Potential vorticity
-        call write_to_file(ncid,'pv',nf90_float,(/ timeDimID,partDimID /),pvID,(/ 1,totpart /), &
-          'pvu',.false.,'potential_vorticity','potential vorticity')
-      case ('pv') ! Potential vorticity averaged
-        call write_to_file(ncid,'pv_av',nf90_float,(/ timeDimID,partDimID /),pvavID,(/ 1,totpart /), &
-          'pvu',.false.,'potential_vorticity_average','averaged potential vorticity')
-      case ('PR') ! Pressure
-        call write_to_file(ncid,'pr',nf90_float,(/ timeDimID,partDimID /),prID,(/ 1,totpart /), &
-          'Pa',.false.,'pressure','pressure')
-      case ('pr') ! Pressure averaged
-        call write_to_file(ncid,'pr_av',nf90_float,(/ timeDimID,partDimID /),pravID,(/ 1,totpart /), &
-          'Pa',.false.,'pressure_average','averaged pressure')
-      case ('QV') ! Specific humidity
-        call write_to_file(ncid,'qv',nf90_float,(/ timeDimID,partDimID /),qvID,(/ 1,totpart /), &
-          '',.false.,'specific_humidity','specific humidity')
-      case ('qv') ! Specific humidity averaged
-        call write_to_file(ncid,'qv_av',nf90_float,(/ timeDimID,partDimID /),qvavID,(/ 1,totpart /), &
-          '',.false.,'specific_humidity_average','averaged specific humidity')
-      case ('RH') ! Density
-        call write_to_file(ncid,'rho',nf90_float,(/ timeDimID,partDimID /),rhoID,(/ 1,totpart /), &
-          'kg/m3',.true.,'density','density')
-      case ('rh') ! Density averaged
-        call write_to_file(ncid,'rho_av',nf90_float,(/ timeDimID,partDimID /),rhoavID,(/ 1,totpart /), &
-          'kg/m3',.true.,'density_average','averaged density')
-      case ('TT') ! Temperature
-        call write_to_file(ncid,'temperature',nf90_float,(/ timeDimID,partDimID /),ttID,(/ 1,totpart /), &
-          'K',.true.,'temperature','temperature') 
-      case ('tt') ! Temperature averaged
-        call write_to_file(ncid,'temperature_av',nf90_float,(/ timeDimID,partDimID /),ttavID,(/ 1,totpart /), &
-          'K',.true.,'temperature_average','averaged temperature') 
-      case ('UU')
-        call write_to_file(ncid,'u',nf90_float,(/ timeDimID,partDimID /),uID,(/ 1,totpart /), &
-          'm/s',.false.,'u','longitudinal velocity')    
-      case ('uu')
-        call write_to_file(ncid,'u_av',nf90_float,(/ timeDimID,partDimID /),uavID,(/ 1,totpart /), &
-          'm/s',.false.,'u_av','averaged longitudinal velocity')
-      case ('VV')
-        call write_to_file(ncid,'v',nf90_float,(/ timeDimID,partDimID /),vID,(/ 1,totpart /), &
-          'm/s',.false.,'v','latitudinal velocity')
-      case ('vv')
-        call write_to_file(ncid,'v_av',nf90_float,(/ timeDimID,partDimID /),vavID,(/ 1,totpart /), &
-          'm/s',.false.,'v_average','latitudinal velocity averaged')
-      case ('WW')
-        call write_to_file(ncid,'w',nf90_float,(/ timeDimID,partDimID /),wID,(/ 1,totpart /), &
-          'm/s',.false.,'w','vertical velocity')
-      case ('ww')
-        call write_to_file(ncid,'w_av',nf90_float,(/ timeDimID,partDimID /),wavID,(/ 1,totpart /), &
-          'm/s',.false.,'w_average','vertical velocity averaged')
-      case ('VS')
-        call write_to_file(ncid,'settling',nf90_float,(/ timeDimID,partDimID /),vsetID,(/ 1,totpart /), &
-          'm/s',.false.,'settling_velocity','settling velocity')
-      case ('vs')
-        call write_to_file(ncid,'settling_av',nf90_float,(/ timeDimID,partDimID /),vsetavID,(/ 1,totpart /), &
-          'm/s',.false.,'settling_velocity_average','settling velocity averaged')
-      case ('MA') ! Mass
-        if (mdomainfill.ge.1) then
-          call nf90_err(nf90_def_var(ncid=ncid, name='mass', xtype=nf90_float, dimids=1, varid=massID(1)))
-          call nf90_err(nf90_put_att(ncid, massID(1), 'units', 'kg'))
-          call nf90_err(nf90_put_att(ncid, massID(1), '_FillValue', fillval))
-          call nf90_err(nf90_put_att(ncid, massID(1), 'positive', 'up'))
-          call nf90_err(nf90_put_att(ncid, massID(1), 'standard_name', 'mass'))
-          call nf90_err(nf90_put_att(ncid, massID(1), 'long_name', 'mass of each particle'))
-        else
-          do j=1,nspec
-            ! Masses
-            write(anspec, '(i3.3)') j
-            call write_to_file(ncid,'mass'//anspec,nf90_float,(/ timeDimID,partDimID /),massID(j), &
-              (/ 1,totpart /),'kg',.true.,'mass'//anspec,'mass for nspec'//anspec) 
-          end do
-        endif
-      case ('ma') ! Mass averaged
-        if (mdomainfill.ge.1) then
-          call nf90_err(nf90_def_var(ncid=ncid, name='mass_av', xtype=nf90_float, dimids=1, varid=massavID(1)))
-          call nf90_err(nf90_put_att(ncid, massavID(1), 'units', 'kg'))
-          call nf90_err(nf90_put_att(ncid, massavID(1), '_FillValue', fillval))
-          call nf90_err(nf90_put_att(ncid, massavID(1), 'positive', 'up'))
-          call nf90_err(nf90_put_att(ncid, massavID(1), 'standard_name', 'mass'))
-          call nf90_err(nf90_put_att(ncid, massavID(1), 'long_name', 'averaged mass of each particle'))
-        else
-          do j=1,nspec
-            ! Masses averaged
-            write(anspec, '(i3.3)') j
-            call write_to_file(ncid,'mass_av'//anspec,nf90_float,(/ timeDimID,partDimID /),massavID(j), &
-              (/ 1,totpart /),'kg',.true.,'mass'//anspec,'averaged mass for nspec'//anspec) 
-          end do
-        endif
-      case ('WD') ! Cumulative mass of wet deposition
-        do j=1,nspec
-          ! Masses
-          write(anspec, '(i3.3)') j
-          call write_to_file(ncid,'wetdepo'//anspec,nf90_float,(/ timeDimID,partDimID /),wdID(j), &
-            (/ 1,totpart /),'kg',.true.,'mass'//anspec,'cumulative wet deposition for nspec'//anspec) 
-        end do
-      case ('DD') ! Cumulative mass of dry deposition
-        do j=1,nspec
-          ! Masses
-          write(anspec, '(i3.3)') j
-          call write_to_file(ncid,'drydepo'//anspec,nf90_float,(/ timeDimID,partDimID /),ddID(j), &
-            (/ 1,totpart /),'kg',.true.,'mass'//anspec,'cumulative dry deposition for nspec'//anspec) 
-        end do
-      case ('TO')  ! Topography, written to grid if domainfill
-        if (mdomainfill.lt.1) then
-          call write_to_file(ncid,'topo',nf90_float,(/ timeDimID,partDimID /),topoID,(/ 1,totpart /), &
-            'meters',.false.,'topography','topography above sealevel')
-        else
-          call write_to_file(ncid,'topo',nf90_float,(/ lonDimID,latDimID /),topoID,(/ nx,ny /), &
-            'meters',.false.,'topography','topography above sealevel')
-        endif
-      case ('to') ! Topography averaged, no grid when domainfill
-        call write_to_file(ncid,'topo_av',nf90_float,(/ timeDimID,partDimID /),topoavID,(/ 1,totpart /), &
-          'meters',.false.,'topography','averaged topography above sealevel')
-      case ('HM') ! Mixing layer height
-        if (mdomainfill.lt.1) then
-          call write_to_file(ncid,'hmix',nf90_float,(/ timeDimID,partDimID /),hmixID,(/ 1,totpart /), &
-            'meters',.true.,'hmix','height above ground of mixing layer')
-        else
-          call write_to_file(ncid,'hmix',nf90_float,(/ timeDimID,lonDimID,latDimID /),hmixID,(/ 1,nx,ny /), &
-            'meters',.true.,'hmix','height above ground of mixing layer')  
-        endif
-      case ('hm') ! Mixing layer height averaged
-        call write_to_file(ncid,'hmix_av',nf90_float,(/ timeDimID,partDimID /),hmixavID,(/ 1,totpart /), &
-          'meters',.true.,'hmix_average','averaged height above ground of mixing layer')
-      case ('TR') ! Tropopause
-        if (mdomainfill.lt.1) then
-          call write_to_file(ncid,'tr',nf90_float,(/ timeDimID,partDimID /),trID,(/ 1,totpart /), &
-            'meters',.true.,'htropo','height above ground of tropopause')
-        else
-          call write_to_file(ncid,'tr',nf90_float,(/ timeDimID,lonDimID,latDimID /),trID,(/ 1,nx,ny /), &
-            'meters',.true.,'htropo','height above ground of tropopause')
-        endif
-      case ('tr') ! Tropopause averaged
-        call write_to_file(ncid,'tr_av',nf90_float,(/ timeDimID,partDimID /),travID,(/ 1,totpart /), &
-          'meters',.true.,'htropo_average','averaged height above ground of tropopause')
-      case default
-        write(*,*) 'The field you are trying to write to file is not coded in yet: ', partopt(np)%long_name
-        stop
-    end select
-  end do
-  ! global (metadata) attributes
-  !*******************************
-  call writemetadata(ncid,lnest=.false.)
-
-  ! moves the file from define to data mode
-  call nf90_err(nf90_enddef(ncid))
-
-  call nf90_err(nf90_close(ncid))
-
-  return
-110 write(*,FMT='(80("#"))') 
-  write(*,*) 'ERROR: output directory ', trim(path(2)(1:length(2))), ' does not exist&
-       & (or failed to write there).' 
-  write(*,*) 'EXITING' 
-  write(*,FMT='(80("#"))')
-  stop
-end subroutine writeheader_partoutput
-
-subroutine write_to_file(ncid,short_name,xtype,dimids,varid,chunksizes,units,l_positive, &
-  standard_name,long_name)
-
-  !*****************************************************************************
-  !                                                                            *
-  !   Generalised writing data to netcdf file                                  *
-  !                                                                            *
-  !   Author: L. Bakels 2022                                                   *
-  !                                                                            *
-  !*****************************************************************************
-
-  implicit none
-
-  integer, intent(in) :: ncid, xtype
-  integer, intent(out) :: varid
-  character(len = *), intent(in) :: short_name,standard_name,long_name,units
-  integer, dimension(:), intent(in) :: dimids,chunksizes
-  logical, intent(in) :: l_positive
-
-  call nf90_err(nf90_def_var(ncid, short_name, xtype, dimids, varid))
-  call nf90_err(nf90_def_var_chunking(ncid,varid,NF90_CHUNKED,chunksizes=chunksizes))
-  call nf90_err(nf90_def_var_deflate(ncid,varid,shuffle=0,deflate=1,deflate_level=1))
-  call nf90_err(nf90_put_att(ncid, varid, 'units', units))
-  if(xtype.eq.nf90_float) then
-    call nf90_err(nf90_put_att(ncid, varid, '_FillValue', -1.))
-  else 
-    call nf90_err(nf90_put_att(ncid, varid, '_FillValue', -1))
-  endif
-  if(l_positive) call nf90_err(nf90_put_att(ncid, varid, 'positive', 'up'))
-  call nf90_err(nf90_put_att(ncid, varid, 'standard_name', standard_name))
-  call nf90_err(nf90_put_att(ncid, varid, 'long_name', long_name))
-end subroutine write_to_file
-
-subroutine open_partoutput_file(ncid)!,irelease)
-  
-  implicit none 
-
-  integer, intent(inout)         :: ncid
-  !integer, intent(in)            :: irelease
-
-  call nf90_err(nf90_open(trim(ncfname_part), nf90_write, ncid))
-end subroutine open_partoutput_file
-
-subroutine close_partoutput_file(ncid)
-  
-  implicit none 
-
-  integer                        :: ncid
-
-  call nf90_err(nf90_close(ncid))
-end subroutine close_partoutput_file
-
-subroutine open_partinit_file(ncid)!,irelease)
-  
-  implicit none 
-
-  integer, intent(inout)         :: ncid
-  !integer, intent(in)            :: irelease
-
-  call nf90_err(nf90_open(trim(ncfname_partinit), nf90_write, ncid))
-end subroutine open_partinit_file
-
-subroutine partoutput_ncf(itime,field,fieldname,imass,ncid)
-  
-
-  !*****************************************************************************
-  !                                                                            *
-  !   Writing a field from PARTOPTIONS to partoutput_xxx.nc created in         *
-  !   writeheader_partoutput                                                   *
-  !                                                                            *  
-  !   Author: L. Bakels 2021                                                   *
-  !                                                                            *
-  !*****************************************************************************
-
-  implicit none
-
-  integer, intent(in)            :: itime,imass
-  real, intent(in)               :: field(:)
-  character(2), intent(in)       :: fieldname  ! input field to interpolate over
-  integer, allocatable           :: partindices(:)
-  integer                        :: ncid,newpart,j
-  ! ! open output file
-  ! call nf90_err(nf90_open(trim(ncfname_part), nf90_write, ncid))
-  select case(fieldname)
-    case('TI')
-      ! write time
-      tpointer_part = tpointer_part + 1
-      call nf90_err(nf90_put_var(ncid, timeIDpart, itime, (/ tpointer_part /)))
-    case('PA')
-      newpart = numpart - ppointer_part
-      
-      if (tpointer_part.eq.1) then 
-        allocate ( partindices(numpart) )
-        do j=1,numpart 
-          partindices(j)=j
-        end do 
-
-        call nf90_err(nf90_put_var(ncid, partID,partindices, (/ 1 /),(/ numpart /)))
-
-        deallocate (partindices)
-
-        ppointer_part = numpart 
-
-      else if (newpart.ge.0) then
-
-        allocate ( partindices(newpart) )
-        do j=1,newpart
-          partindices(j)=j+ppointer_part
-        end do
-
-        call nf90_err(nf90_put_var(ncid, partID,partindices, (/ ppointer_part+1 /),(/ newpart /)))
-        
-        deallocate (partindices)
-
-        ppointer_part = numpart
-      endif 
-    case('LO') ! Longitude
-      call nf90_err(nf90_put_var(ncid,lonIDpart,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
-    case('lo') ! Longitude averaged
-      call nf90_err(nf90_put_var(ncid,lonavIDpart,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
-    case('LA') ! Latitude
-      call nf90_err(nf90_put_var(ncid,latIDpart,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
-    case('la') ! Latitude averaged
-      call nf90_err(nf90_put_var(ncid,latavIDpart,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
-    case('ZZ') ! Height
-      call nf90_err(nf90_put_var(ncid,levIDpart,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
-    case('zz') ! Height averaged
-      call nf90_err(nf90_put_var(ncid,levavIDpart,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
-    case('IT') ! Itramem (not in use atm)
-      call nf90_err(nf90_put_var(ncid,itramemID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
-    case('TO') ! Topography
-      if (mdomainfill.ge.1) then 
-        if (topo_written.eqv..false.) call nf90_err(nf90_put_var(ncid,topoID,oro(0:nx-1,0:ny-1), (/ 1,1 /),(/ nx,ny /)))
-        topo_written=.true.
-      else
-        call nf90_err(nf90_put_var(ncid,topoID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
-      endif
-    case('to') ! topography averaged
-      call nf90_err(nf90_put_var(ncid,topoavID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
-    case('PV') ! Potential vorticity
-      call nf90_err(nf90_put_var(ncid,pvID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
-    case('pv') ! Potential vorticity averaged
-      call nf90_err(nf90_put_var(ncid,pvavID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
-    case('PR') ! Pressure
-      call nf90_err(nf90_put_var(ncid,prID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
-    case('pr') ! Pressure averaged
-      call nf90_err(nf90_put_var(ncid,pravID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
-    case('QV') ! Specific humidity
-      call nf90_err(nf90_put_var(ncid,qvID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
-    case('qv') ! Specific humidity averaged
-      call nf90_err(nf90_put_var(ncid,qvavID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
-    case('RH') ! Air density
-      call nf90_err(nf90_put_var(ncid,rhoID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
-    case('rh') ! Air density averaged
-      call nf90_err(nf90_put_var(ncid,rhoavID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
-    case('UU') ! Longitudinal velocity
-      call nf90_err(nf90_put_var(ncid,uID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
-    case('uu') ! Longitudinal velocity averaged
-      call nf90_err(nf90_put_var(ncid,uavID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
-    case('VV') ! Latitudinal velocity
-      call nf90_err(nf90_put_var(ncid,vID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
-    case('vv') ! Latitudinal velocity averaged
-      call nf90_err(nf90_put_var(ncid,vavID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
-    case('WW') ! Vertical velocity
-      call nf90_err(nf90_put_var(ncid,wID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
-    case('ww') ! Vertical velocity averaged
-      call nf90_err(nf90_put_var(ncid,wavID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
-    case('VS') ! Settling velocity
-      call nf90_err(nf90_put_var(ncid,vsetID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
-    case('vs') ! Settling velocity averaged
-      call nf90_err(nf90_put_var(ncid,vsetavID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
-    case('HM') ! Mixing height
-      if (mdomainfill.ge.1) then 
-        call nf90_err(nf90_put_var(ncid,hmixID,hmix(0:nx-1,0:ny-1,1,memind(1)), &
-          (/ tpointer_part,1,1 /),(/ 1,nx,ny /)))
-      else
-        call nf90_err(nf90_put_var(ncid,hmixID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
-      endif
-    case('hm') ! Mixing height averaged
-      call nf90_err(nf90_put_var(ncid,hmixavID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
-    case('TR') ! Tropopause
-      if (mdomainfill.ge.1) then 
-        call nf90_err(nf90_put_var(ncid,trID,tropopause(0:nx-1,0:ny-1,1,memind(1)), &
-          (/ tpointer_part,1,1 /),(/ 1,nx,ny /)))
-      else
-        call nf90_err(nf90_put_var(ncid,trID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
-      endif
-    case('tr') ! Tropopause averaged
-      call nf90_err(nf90_put_var(ncid,travID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
-    case('TT') ! Temperature
-      call nf90_err(nf90_put_var(ncid,ttID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
-    case('tt') ! Temperature averaged
-      call nf90_err(nf90_put_var(ncid,ttavID,field, (/ tpointer_part,1 /),(/ 1,numpart /)))
-    case('MA') ! Mass
-      if ((mdomainfill.ge.1).and.(imass.eq.1)) then
-        if (mass_written.eqv..false.) call nf90_err(nf90_put_var(ncid=ncid,varid=massID(1),values=field(1)))
-        mass_written=.true.
-      else
-        call nf90_err(nf90_put_var(ncid,massID(imass),field, (/ tpointer_part,1 /),(/ 1,numpart /)))
-      endif
-    case('ma') ! Mass averaged
-      if ((mdomainfill.ge.1).and.(imass.eq.1)) then
-        if (mass_written.eqv..false.) call nf90_err(nf90_put_var(ncid=ncid,varid=massavID(1),values=field(1)))
-        massav_written=.true.
-      else
-        call nf90_err(nf90_put_var(ncid,massavID(imass),field, (/ tpointer_part,1 /),(/ 1,numpart /)))
-      endif
-    case('WD') ! Cumulative mass of wet deposition
-      call nf90_err(nf90_put_var(ncid,wdID(imass),field, (/ tpointer_part,1 /),(/ 1,numpart /)))
-    case('DD') ! Cumulative mass of wet deposition
-      call nf90_err(nf90_put_var(ncid,ddID(imass),field, (/ tpointer_part,1 /),(/ 1,numpart /)))
-  end select
-
-  ! call nf90_err(nf90_close(ncid))
-end subroutine partoutput_ncf
-
-subroutine read_partpos_ncf(ibtime,ibdate)
-
-  !*****************************************************************************
-  !                                                                            *
-  !   IPIN=2: restarting from a partoutput_xxx.nc file written by a previous   *
-  !           run, depending on what PARTOPTIONS the user has chosen, this     *
-  !           option might not be possible to use                              *
-  !                                                                            *
-  !   Author: L. Bakels 2022                                                   *
-  !                                                                            *
-  !*****************************************************************************
-
-  use random_mod
-  use particle_mod
-  use date_mod
-
-  implicit none 
-
-  integer, intent(in) :: ibtime,ibdate
-  integer             :: ncidend,tIDend,pIDend,tempIDend
-  integer             :: tlen,plen,tend,i,j
-  integer             :: idate_start,itime_start
-  character           :: adate*8,atime*6,timeunit*32,adate_start*8,atime_start*6
-  character(len=3)    :: anspec
-  real(kind=dp)       :: julin,julcommand,julpartin
-
-  integer :: idummy = -8
-
-  write(adate,'(i8.8)') ibdate
-  write(atime,'(i6.6)') ibtime
-  
-  if (mquasilag.ne.0) then 
-    write(*,*) 'Combination of ipin, netcdf partoutput, and mquasilag!=0 does not work yet'
-    stop 
-  endif
-
-  ! Open partoutput_end.nc file
-  call nf90_err(nf90_open(trim('partoutput_end.nc'), mode=NF90_NOWRITE,ncid=ncidend))
-
-  ! Take the positions of the particles at the last timestep in the file
-  ! It needs to be the same as given in the COMMAND file, this is arbitrary
-  ! and should be removed in the future for easier use
-
-  ! First get the time dimension
-  call nf90_err(nf90_inq_dimid(ncid=ncidend,name='time',dimid=tIDend))
-  call nf90_err(nf90_inquire_dimension(ncid=ncidend,dimid=tIDend,len=tlen))
-
-  ! Check if the time corresponds to the one given in the COMMAND file
-  call nf90_err(nf90_inq_varid(ncid=ncidend,name='time',varid=tIDend))
-  call nf90_err(nf90_get_att(ncid=ncidend,varid=tIDend,name='units',values=timeunit))
-  call nf90_err(nf90_get_var(ncid=ncidend,varid=tIDend,values=tend,start=(/ tlen /)))!,count=(/ 1 /)))
-  adate_start(1:4) = timeunit(15:18)
-  adate_start(5:6) = timeunit(20:21)
-  adate_start(7:8) = timeunit(23:24)
-  atime_start = '000000'
-  atime_start(1:2) = timeunit(26:27)
-  atime_start(3:4) = timeunit(29:30)
-  read(adate_start,*) idate_start
-  read(atime_start,*) itime_start
-  julin = juldate(idate_start,itime_start)+real(tend,kind=dp)/86400._dp
-  julcommand = juldate(ibdate,ibtime)
-  if (abs(julin-julcommand).gt.1.e-5) then 
-    write(*,*) 'ERROR: The given starting time and date do not correspond to'
-    write(*,*) 'the last timestep of partoutput_end.nc:'
-    write(*,*) julin,julcommand,tend
-    stop 
-  endif
-
-  ! Then the particle dimension
-  call nf90_err(nf90_inq_dimid(ncid=ncidend,name='particle',dimid=pIDend))
-  call nf90_err(nf90_inquire_dimension(ncid=ncidend,dimid=pIDend,len=plen))
-
-  ! Now spawn the correct number of particles
-  write(*,*) 'Npart:',plen
-  call spawn_particles(0,plen)
-
-  ! And give them the correct positions
-  ! Longitude
-  call nf90_err(nf90_inq_varid(ncid=ncidend,name='longitude',varid=tempIDend))
-  call nf90_err(nf90_get_var(ncid=ncidend,varid=tempIDend,values=part(:)%xlon, & 
-    start=(/ tlen, 1 /),count=(/ 1, plen /)))
-  part(:)%xlon=(part(:)%xlon-xlon0)/dx
-  ! Latitude
-  call nf90_err(nf90_inq_varid(ncid=ncidend,name='latitude',varid=tempIDend))
-  call nf90_err(nf90_get_var(ncid=ncidend,varid=tempIDend,values=part(:)%ylat, & 
-    start=(/ tlen, 1 /),count=(/ 1, plen /)))
-  part(:)%ylat=(part(:)%ylat-ylat0)/dx
-  ! Height
-  call nf90_err(nf90_inq_varid(ncid=ncidend,name='height',varid=tempIDend))
-  call nf90_err(nf90_get_var(ncid=ncidend,varid=tempIDend,values=part(:)%z, & 
-    start=(/ tlen, 1 /),count=(/ 1, plen /)))
-  ! Mass
-  if (mdomainfill.eq.0) then
-    do j=1,nspec
-      write(anspec, '(i3.3)') j
-      call nf90_err(nf90_inq_varid(ncid=ncidend,name='mass'//anspec,varid=tempIDend))
-      call nf90_err(nf90_get_var(ncid=ncidend,varid=tempIDend,values=part(:)%mass(j), & 
-        start=(/ tlen, 1 /),count=(/ 1, plen /)))
-    end do
-  endif
-
-  do i=1,plen
-    if (part(i)%z.lt.0) then 
-      call terminate_particle(i,0)
-      write(*,*) 'Particle ',i,'is not alive in the restart file.'
-    endif
-    part(i)%nclass=min(int(ran1(idummy,0)*real(nclassunc))+1, &
-         nclassunc)    
-    part(i)%idt=mintime
-    part(i)%npoint=1
-  end do
-
-  call nf90_err(nf90_close(ncidend))
-end subroutine read_partpos_ncf
-
-subroutine read_init_cond_nc()
-
-  !*****************************************************************************
-  !                                                                            *
-  !   IPIN=3: starting a run from a user defined initial particle conditions,  *
-  !           more on how to create such a file can be found in the manual     *
-  !   IPIN=4: restarting a run, while also reading in the initial particle     *
-  !           conditions                                                       *
-  !                                                                            *
-  !   Author: L. Bakels 2022                                                   *
-  !                                                                            *
-  !*****************************************************************************
-
-  use random_mod
-  use particle_mod
-  use date_mod
-  use coord_ec_mod
-  use readoptions_mod
-  use drydepo_mod
-
-  implicit none 
-
-  integer             :: ncidend,tIDend,pIDend,tempIDend,stat
-  integer             :: plen,tend,i,j,release_max,nsp
-  integer             :: zkind
-  real                :: totmass,cun
-  integer,allocatable, dimension (:) :: specnum_rel,numpoint_max
-  real,allocatable,dimension(:,:) :: mass_temp
-  real,allocatable,dimension(:) :: vsh,fracth,schmih
-
-  integer :: idummy = -8
-  
-  if (mquasilag.ne.0) then 
-    write(*,*) 'Combination of ipin, netcdf partoutput, and mquasilag!=0 does not work yet'
-    stop 
-  endif
-
-  ! Open part_ic.nc file
-  call nf90_err(nf90_open(trim(path(2)(1:length(2))//'part_ic.nc'), mode=NF90_NOWRITE,ncid=ncidend))
-
-  ! allocate with maxspec for first input loop
-  allocate(specnum_rel(maxspec),stat=stat)
-  if (stat.ne.0) write(*,*)'ERROR: could not allocate specnum_rel'
-
-  ! How many species are contained in each particle?
-  call nf90_err(nf90_inquire_attribute(ncid=ncidend,name='nspecies',varid=NF90_GLOBAL))
-  call nf90_err(nf90_get_att(ncid=ncidend,varid=NF90_GLOBAL,name='nspecies',values=nspec))
-
-  ! Which species?
-  call nf90_err(nf90_inquire_attribute(ncid=ncidend,name='species',varid=NF90_GLOBAL))
-  call nf90_err(nf90_get_att(ncid=ncidend,varid=NF90_GLOBAL,name='species',values=specnum_rel(1:nspec)))
-
-  ! Get the particle dimension
-  call nf90_err(nf90_inq_dimid(ncid=ncidend,name='particle',dimid=pIDend))
-  call nf90_err(nf90_inquire_dimension(ncid=ncidend,dimid=pIDend,len=plen))
-
-  ! Now spawn the correct number of particles
-  write(*,*) 'Npart:',plen
-  call alloc_particles( plen )
-  ! allocate temporary mass array
-  allocate(mass_temp(plen,nspec))
-
-  ! And give them the correct positions
-  ! Longitude
-  call nf90_err(nf90_inq_varid(ncid=ncidend,name='longitude',varid=tempIDend))
-  call nf90_err(nf90_get_var(ncid=ncidend,varid=tempIDend,values=part(:)%xlon, & 
-    start=(/ 1 /),count=(/ plen /)))
-  part(:)%xlon=(part(:)%xlon-xlon0)/dx
-  ! Latitude
-  call nf90_err(nf90_inq_varid(ncid=ncidend,name='latitude',varid=tempIDend))
-  call nf90_err(nf90_get_var(ncid=ncidend,varid=tempIDend,values=part(:)%ylat, & 
-    start=(/ 1 /),count=(/ plen /)))
-  part(:)%ylat=(part(:)%ylat-ylat0)/dx
-  ! Height
-  call nf90_err(nf90_inq_varid(ncid=ncidend,name='height',varid=tempIDend))
-  call nf90_err(nf90_get_var(ncid=ncidend,varid=tempIDend,values=part(:)%z, & 
-    start=(/ 1 /),count=(/ plen /)))
-  ! Spawning time
-  call nf90_err(nf90_inq_varid(ncid=ncidend,name='time',varid=tempIDend))
-  call nf90_err(nf90_get_var(ncid=ncidend,varid=tempIDend,values=part(:)%tstart, & 
-    start=(/ 1 /),count=(/ plen /)))
-  ! Mass
-  call nf90_err(nf90_inq_varid(ncid=ncidend,name='mass',varid=tempIDend))
-  call nf90_err(nf90_get_var(ncid=ncidend,varid=tempIDend,values=mass_temp, & 
-    start=(/ 1,1 /),count=(/ plen,nspec /)))
-  do nsp=1,nspec
-    part(:)%mass(nsp)=mass_temp(1:plen,nsp)
-  end do
-  deallocate(mass_temp)
-  ! Release
-  call nf90_err(nf90_inq_varid(ncid=ncidend,name='release',varid=tempIDend))
-  call nf90_err(nf90_get_var(ncid=ncidend,varid=tempIDend,values=part(:)%npoint, & 
-    start=(/ 1 /),count=(/ plen /)))
-  ! ! Species
-  ! call nf90_err(nf90_inq_varid(ncid=ncidend,name='species',varid=tempIDend))
-  ! call nf90_err(nf90_get_var(ncid=ncidend,varid=tempIDend,values=part(:)%species, & 
-  !   start=(/ 1 /),count=(/ plen /)))
-
-  ! Count number of releases
-  numpoint=1
-  allocate(numpoint_max(plen),stat=stat)
-  numpoint_max=0
-  release_max=0
-
-  l1: do i=1,plen
-    l2: do j=1,numpoint
-      if (part(i)%npoint.eq.numpoint_max(numpoint)) then
-        cycle l1
-      endif
-    end do l2
-    numpoint = numpoint+1
-    numpoint_max(numpoint)=part(i)%npoint
-    if (part(i)%npoint.gt.release_max) release_max=part(i)%npoint
-  end do l1
-
-  allocate(kindz(numpoint),stat=stat)
-  kindz=-1
-  if (stat.ne.0) write(*,*)'ERROR: could not allocate kindz'
-  ! Above sea-level or ground?
-  call nf90_err(nf90_inquire_attribute(ncid=ncidend,name='kindz',varid=NF90_GLOBAL))
-  call nf90_err(nf90_get_att(ncid=ncidend,varid=NF90_GLOBAL,name='kindz',values=zkind))
-  kindz=zkind
-  do nsp=1,nspec
-   if ((kindz(nsp).le.0).or.(kindz(nsp).ge.4)) then
-      write(*,*) 'ERROR: kindz should be an integer between 1 and 3, not', kindz(nsp)
-      stop
-   endif
-  end do
-
-  if (ioutputforeachrelease.eq.1) then
-    maxpointspec_act=numpoint
-  else
-    maxpointspec_act=1
-  endif
-
-  if (release_max.gt.numpoint) then
-    write(*,*) "WARNING: release numbers in part_ic.nc are not consecutive:", &
-      release_max, "is larger than the total number of releases:", numpoint, &
-      " Releases will be renumbered."
-
-    do j=1,numpoint
-      do i=1,plen
-        if (part(i)%npoint.eq.numpoint_max(j)) then
-          part(i)%npoint=numpoint_max(j)
-        endif
-      end do
-    end do
-  endif
-  deallocate(numpoint_max)
-
-  allocate(xmass(numpoint,nspec), npart(numpoint),ireleasestart(numpoint),ireleaseend(numpoint))
-  xmass=0
-  npart=0
-  ireleasestart=-1
-  ireleaseend=-1
-  do i=1,plen
-    do j=1,numpoint
-      do nsp=1,nspec
-        xmass(j,nsp) = xmass(j,nsp)+part(i)%mass(nsp)
-      end do 
-      if (part(i)%npoint.eq.j) then 
-        npart(j)=npart(j)+1
-        if ((ireleasestart(j).gt.part(i)%tstart).or.(ireleasestart(j).eq.-1)) ireleasestart(j)=part(i)%tstart
-        if ((ireleaseend(j).le.part(i)%tstart).or.(ireleaseend(j).eq.-1)) ireleaseend(j)=part(i)%tstart
-      endif
-    end do
-  end do
-  if ((iout.eq.4).or.(iout.eq.5)) then
-    write(*,*) "ERROR: IPIN=3 or IPIN=4, using the part_ic.nc file, is not possible in combination with plume", &
-      "computations (IOUT=4 or 5)."
-    stop
-  endif
-
-  part(:)%idt=part(:)%tstart
-  do i=1,plen
-    part(i)%nclass=min(int(ran1(idummy,0)*real(nclassunc))+1, &
-         nclassunc)
-    part(i)%mass_init=part(i)%mass
-    ! Activate particles that are alive from the start of the simulation
-    if (part(i)%tstart.eq.0) then
-      call spawn_particle(0,i)
-    endif
-  end do
-  write(*,FMT='(A,ES14.7)') ' Total mass to be released:', sum(xmass(1:numpoint,1:nspec))
-  call get_totalpart_num(numpart)
-  numparticlecount=numpart
-  call nf90_err(nf90_close(ncidend))
-
-
-  ! Read species and derive initial conditions
+#include "net_writemetadata.f90"
 
-  !now save the information
-  DEP=.false.
-  DRYDEP=.false.
-  WETDEP=.false.
-  OHREA=.false.
-  do nsp=1,maxspec
-    DRYDEPSPEC(nsp)=.false.
-    WETDEPSPEC(nsp)=.false.
-  end do
 
-  do nsp=1,nspec
-    call readspecies(specnum_rel(nsp),nsp)
-    ! Allocate temporary memory necessary for the different diameter bins
-    !********************************************************************
-    allocate(vsh(ndia(nsp)),fracth(ndia(nsp)),schmih(ndia(nsp)))
+#include "net_nf90_err.f90"
 
-    ! Molecular weight
-    !*****************
-    if (((iout.eq.2).or.(iout.eq.3)).and.(weightmolar(nsp).lt.0.)) then
-      write(*,*) 'For mixing ratio output, valid molar weight'
-      write(*,*) 'must be specified for all simulated species.'
-      write(*,*) 'Check table SPECIES or choose concentration'
-      write(*,*) 'output instead if molar weight is not known.'
-      stop
-    endif
+#include "net_writeheader_ncf.f90"
 
-    ! Radioactive decay
-    !******************
-    decay(nsp)=0.693147/decay(nsp) !conversion half life to decay constant
+#include "net_read_grid_id.f90"
 
-  ! Dry deposition of gases
-  !************************
+#include "net_concoutput_ncf.f90"
 
-    if (reldiff(nsp).gt.0.) rm(nsp)=1./(henry(nsp)/3000.+100.*f0(nsp))    ! mesophyll resistance
+#include "net_concoutput_sfc_ncf.f90"
 
-  ! Dry deposition of particles
-  !****************************
+#include "net_concoutput_ncf_nest.f90"
 
-    vsetaver(nsp)=0.
-    cunningham(nsp)=0.
-    dquer(nsp)=dquer(nsp)*1000000.         ! Conversion m to um
-    if (density(nsp).gt.0.) then         ! Additional parameters
-      call part0(dquer(nsp),dsigma(nsp),density(nsp),ndia(nsp),fracth,schmih,cun,vsh)
-      do j=1,ndia(nsp)
-        fract(nsp,j)=fracth(j)
-        schmi(nsp,j)=schmih(j)
-        vset(nsp,j)=vsh(j)
-        cunningham(nsp)=cunningham(nsp)+cun*fract(nsp,j)
-        vsetaver(nsp)=vsetaver(nsp)-vset(nsp,j)*fract(nsp,j)
-      end do
-      if (lroot) write(*,*) 'Average settling velocity: ',i,vsetaver(nsp)
-    endif
+#include "net_concoutput_sfc_ncf_nest.f90"
 
-    ! Dry deposition for constant deposition velocity
-    !************************************************
+#include "net_particle_initialpos.f90"
 
-    dryvel(nsp)=dryvel(nsp)*0.01         ! conversion to m/s
+#include "net_wrt_part_initialpos.f90"
 
-    ! Check if wet deposition or OH reaction shall be calculated
-    !***********************************************************
+#include "net_partinit_ncf.f90"
 
-    ! ESO 04.2016 check for below-cloud scavenging (gas or aerosol)
-    if ((dquer(nsp).le.0..and.(weta_gas(nsp).gt.0. .or. wetb_gas(nsp).gt.0.)) .or. &
-         &(dquer(nsp).gt.0. .and. (crain_aero(nsp) .gt. 0. .or. csnow_aero(nsp).gt.0.)))  then
-      WETDEP=.true.
-      WETDEPSPEC(nsp)=.true.
-      if (lroot) then
-        write (*,*) '  Below-cloud scavenging: ON'
-      end if
-    else
-      if (lroot) write (*,*) '  Below-cloud scavenging: OFF'
-    endif
+#include "net_writeheader_partoutput.f90"
 
-    ! NIK 31.01.2013 + 10.12.2013 + 15.02.2015
-    if (dquer(nsp).gt.0..and.(ccn_aero(nsp).gt.0. .or. in_aero(nsp).gt.0.))  then
-      WETDEP=.true.
-      WETDEPSPEC(nsp)=.true.
-      if (lroot) then
-        write (*,*) '  In-cloud scavenging: ON'
-      end if
-    else
-      if (lroot) write (*,*) '  In-cloud scavenging: OFF' 
-    endif
+#include "net_write_to_file.f90"
 
-    if (ohcconst(nsp).gt.0.) then
-      OHREA=.true.
-      if (lroot) write (*,*) '  OHreaction switched on: ',ohcconst(nsp),nsp
-    endif
+#include "net_open_partoutput_file.f90"
 
-    if ((reldiff(nsp).gt.0.).or.(density(nsp).gt.0.).or.(dryvel(nsp).gt.0.)) then
-      DRYDEP=.true.
-      DRYDEPSPEC(nsp)=.true.
-    endif
+#include "net_close_partoutput_file.f90"
 
-    deallocate(vsh,fracth,schmih)
-  end do ! end loop over species
+#include "net_open_partinit_file.f90"
 
-  if (WETDEP.or.DRYDEP) then 
-   DEP=.true.
-  endif
+#include "net_partoutput_ncf.f90"
 
+#include "net_read_partpos_ncf.f90"
 
-  deallocate(specnum_rel)
-end subroutine read_init_cond_nc
+#include "net_read_init_cond_nc.f90"
 
 end module netcdf_output_mod
diff --git a/src/ohr_gethourlyOH.f90 b/src/ohr_gethourlyOH.f90
new file mode 100644
index 0000000000000000000000000000000000000000..98a41ed29e6942aff2f84f38075cf9bf488d68ee
--- /dev/null
+++ b/src/ohr_gethourlyOH.f90
@@ -0,0 +1,138 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine gethourlyOH(itime)
+  !                     i
+  !*****************************************************************************
+  !                                                                            *
+  !                                                                            *
+  !    Author: R.L. Thompson                                                   *
+  !                                                                            *
+  !    Nov 2014                                                                *
+  !                                                                            *
+  !                                                                            *
+  !*****************************************************************************
+  ! Variables:                                                                 *
+  !                                                                            *
+  !*****************************************************************************
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  integer :: itime
+  integer :: ix,jy,kz,m1,m2
+  integer :: ijx,jjy
+  integer :: jjjjmmdd,hhmmss
+  real :: sza,jrate
+  real(kind=dp) :: jul1,jul2
+
+
+  ! Check hourly OH field is available for the current time step
+  !**************************************************************
+
+  if ((ldirect*memOHtime(1).le.ldirect*itime).and. &
+       (ldirect*memOHtime(2).gt.ldirect*itime)) then
+
+  ! The right OH fields are already in memory -> don't do anything
+  !****************************************************************
+
+    return
+
+  else if ((ldirect*memOHtime(2).le.ldirect*itime).and. &
+       (memOHtime(2).ne.0.)) then
+
+    ! Current time is after 2nd OH field
+    !************************************
+
+    memOHtime(1)=memOHtime(2)
+    memOHtime(2)=memOHtime(1)+ldirect*3600.
+    OH_hourly(:,:,:,1)=OH_hourly(:,:,:,2)
+
+    ! Compute new hourly value of OH
+    !**********************************************************
+
+    jul2=bdate+memOHtime(2)/86400._dp  ! date for next hour
+    call caldate(jul2,jjjjmmdd,hhmmss)
+    m2=(jjjjmmdd-(jjjjmmdd/10000)*10000)/100
+
+!$OMP PARALLEL PRIVATE(kz,jy,ix,ijx,jjy,sza,jrate)
+!$OMP DO COLLAPSE(3)
+    do kz=1,nzOH
+      do jy=1,nyOH
+        do ix=1,nxOH
+          ijx=minloc(abs(lonjr-lonOH(ix)),dim=1,mask=abs(lonjr-lonOH(ix)).eq.minval(abs(lonjr-lonOH(ix))))
+          jjy=minloc(abs(latjr-latOH(jy)),dim=1,mask=abs(latjr-latOH(jy)).eq.minval(abs(latjr-latOH(jy))))
+          ! calculate solar zenith angle in degrees (sza)
+          sza=zenithangle(latOH(jy),lonOH(ix),jul2)
+          ! calculate J(O1D) (jrate)
+          jrate=photo_O1D(sza)
+          ! apply hourly correction to OH
+          if(jrate_average(ijx,jjy,m2).gt.0.) then
+            OH_hourly(ix,jy,kz,2)=OH_field(ix,jy,kz,m2)*jrate/jrate_average(ijx,jjy,m2)
+          else
+            OH_hourly(ix,jy,kz,2)=0.
+          endif
+          !! for testing !!
+          ! if(jy.eq.36.and.ix.eq.36.and.kz.eq.1) then
+          !   write(999,fmt='(F6.3)') jrate/jrate_average(ijx,jjy,m2)
+          ! endif
+          ! if(jy.eq.11.and.ix.eq.36.and.kz.eq.1) then
+          !   write(998,fmt='(F6.3)') jrate/jrate_average(ijx,jjy,m2)
+          ! endif
+        end do
+      end do
+    end do
+!$OMP END DO
+!$OMP END PARALLEL
+
+  else
+
+    ! No OH fields in memory -> compute both hourly OH fields
+    !**********************************************************
+
+    jul1=bdate  ! begin date of simulation (julian)
+    call caldate(jul1,jjjjmmdd,hhmmss)
+    m1=(jjjjmmdd-(jjjjmmdd/10000)*10000)/100
+    memOHtime(1)=0.
+
+    jul2=bdate+ldirect*real(1./24.,kind=dp)  ! date for next hour
+    call caldate(jul2,jjjjmmdd,hhmmss)
+    m2=(jjjjmmdd-(jjjjmmdd/10000)*10000)/100
+    memOHtime(2)=ldirect*3600.
+
+!$OMP PARALLEL PRIVATE(kz,jy,ix,ijx,jjy,sza,jrate)
+!$OMP DO COLLAPSE(3)
+    do kz=1,nzOH
+      do jy=1,nyOH
+        do ix=1,nxOH
+          ijx=minloc(abs(lonjr-lonOH(ix)),dim=1,mask=abs(lonjr-lonOH(ix)).eq.minval(abs(lonjr-lonOH(ix))))
+          jjy=minloc(abs(latjr-latOH(jy)),dim=1,mask=abs(latjr-latOH(jy)).eq.minval(abs(latjr-latOH(jy))))
+          ! calculate solar zenith angle in degrees (sza), beginning
+          sza=zenithangle(latOH(jy),lonOH(ix),jul1)
+          ! calculate J(O1D) (jrate), beginning
+          jrate=photo_O1D(sza)
+          ! apply hourly correction to OH
+          if(jrate_average(ijx,jjy,m1).gt.0.) then
+            OH_hourly(ix,jy,kz,1)=OH_field(ix,jy,kz,m1)*jrate/jrate_average(ijx,jjy,m1)
+          else
+            OH_hourly(ix,jy,kz,1)=0.
+          endif
+          ! calculate solar zenith angle in degrees (sza), after 1-hour
+          sza=zenithangle(latOH(jy),lonOH(ix),jul2)
+          ! calculate J(O1D) (jrate), after 1-hour
+          jrate=photo_O1D(sza)
+          ! apply hourly correction to OH
+          if(jrate_average(ijx,jjy,m2).gt.0.) then
+            OH_hourly(ix,jy,kz,2)=OH_field(ix,jy,kz,m2)*jrate/jrate_average(ijx,jjy,m2)
+          else
+            OH_hourly(ix,jy,kz,2)=0.
+          endif
+        end do
+      end do
+    end do
+!$OMP END DO
+!$OMP END PARALLEL
+
+  endif
+end subroutine gethourlyOH
diff --git a/src/ohr_mod.f90 b/src/ohr_mod.f90
index 6e92468b47055d7ea7e613102a6c3600ff362968..1f84d4bbae23e9478ce8ec675878f78347eb7c7e 100644
--- a/src/ohr_mod.f90
+++ b/src/ohr_mod.f90
@@ -6,7 +6,7 @@ module ohr_mod
   !includes OH concentration field as well as the height information
   !for this field
   use date_mod
-  
+
   implicit none
 
   integer :: nxOH,nyOH,nzOH
@@ -20,433 +20,12 @@ module ohr_mod
 
 contains
 
-real function photo_O1D(sza)
-
-  !*****************************************************************************
-  !                                                                            *
-  !                                                                            *
-  !    Author: A. Stohl                                                        *
-  !                                                                            *
-  !    Nov 2014                                                                *
-  !                                                                            *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  !    INPUT:                                                                  *
-  !    sza        solar zenith angle (degrees)                                 *
-  !                                                                            *
-  !    OUTPUT:                                                                 *
-  !    photo_O1D  J(O1D) photoylsis rate                                       *
-  !                                                                            *
-  !*****************************************************************************
-
-  implicit none
-
-  integer :: iz,ik
-  real :: sza
-  real :: z1,z2,zg,f1,f2,dummy
-  real :: photo_NO2
-  integer, parameter :: nzenith=11
-  real, parameter :: pi=3.1415927
-  real, dimension(nzenith) :: zangle,fact_photo
-
-  ! zangle: zenith angles for which fact_photo is tabulated
-  ! fact_photo: conversion of photolysis rate of NO2 to photolysis 
-  !     rate of O3 into O1D as a function of solar zenith angle
-
-  zangle=(/0.,10.,20.,30.,40.,50.,60.,70.,78.,86.,90.0001/)
-  fact_photo=(/0.4616E-02,0.4478E-02,0.4131E-02,0.3583E-02,0.2867E-02,&
-    &0.2081E-02,0.1235E-02,0.5392E-03,0.2200E-03,0.1302E-03,0.0902E-03/)
-
-  if (sza.lt.90.) then
-    do iz=1,nzenith-1
-      if(sza.ge.zangle(iz)) ik=iz
-    end do
-    z1=1./cos(zangle(ik)*pi/180.)
-    z2=1./cos(zangle(ik+1)*pi/180.)
-    zg=1./cos(sza*pi/180.)
-    dummy=(zg-z1)/(z2-z1)
-    f1=alog(fact_photo(ik))
-    f2=alog(fact_photo(ik+1))
-    photo_NO2=1.45e-2*exp(-0.4/cos(sza*pi/180.))
-    photo_O1D=photo_NO2*exp(f1+(f2-f1)*dummy)
-  else
-    photo_O1D=0.
-  endif
-
-  return
-
-end function photo_O1D
-
-real function zenithangle(ylat,xlon,jul)
-  
-  !*********************************************************************
-  !                                                                    *
-  !                      Author: G. WOTAWA                             *
-  !                      Date: 1993-11-17                              *
-  !                      Project: POP-M                                *
-  !                      Last update:                                  *
-  !                                                                    *
-  !*********************************************************************
-  !                                                                    *
-  !     DESCRIPTION: This function returns the sinus of solar          *
-  !                  elevation as a function of geographic longitude,  *
-  !                  latitude and GMT-Time.                            *
-  !                                                                    *
-  !*********************************************************************
-  !                                                                    *
-  !     INPUT:                                                         *
-  !                                                                    *
-  !            ylat          geographical latitude  [DEG]              *
-  !            xlon          geographical longitude [DEG]              *
-  !            jjjj          Year                                      *
-  !            mm            Month                                     *
-  !            dd            Day                                       *
-  !            hh            Hour                                      *
-  !            minute        Minute                                    *
-  !                                                                    *
-  !*********************************************************************
-
-  use par_mod, only: dp
-
-  implicit none
-
-  integer :: jjjj,mm,id,iu,minute,yyyymmdd,hhmmss
-  integer :: ndaynum
-  real :: sinsol,solelev,ylat,xlon
-  real :: rnum,rylat,ttime,dekl,rdekl,eq
-  real,parameter :: pi=3.1415927
-  real(kind=dp)  :: jul
-
-  call caldate(jul,yyyymmdd,hhmmss)
-  jjjj=yyyymmdd/10000
-  mm=yyyymmdd/100-jjjj*100
-  id=yyyymmdd-jjjj*10000-mm*100
-  iu=hhmmss/10000
-  minute=hhmmss/100-100*iu
-
-  ndaynum=31*(mm-1)+id
-  if(mm.gt.2) ndaynum=ndaynum-int(0.4*mm+2.3)
-  if((mm.gt.2).and.(jjjj/4*4.eq.jjjj)) ndaynum=ndaynum+1
-
-  rnum=2.*pi*ndaynum/365.
-  rylat=pi*ylat/180.
-  ttime=real(iu)+real(minute)/60.
-
-  dekl=0.396+3.631*sin(rnum)+0.038*sin(2.*rnum)+0.077*sin(3.*rnum)- &
-       22.97*cos(rnum)-0.389*cos(2.*rnum)-0.158*cos(3.*rnum)
-  rdekl=pi*dekl/180.
-
-  eq=(0.003-7.343*sin(rnum)-9.47*sin(2.*rnum)- &
-       0.329*sin(3.*rnum)-0.196*sin(4.*rnum)+ &
-       0.552*cos(rnum)-3.020*cos(2.*rnum)- &
-       0.076*cos(3.*rnum)-0.125*cos(4.*rnum))/60.
-
-  sinsol=sin(rylat)*sin(rdekl)+cos(rylat)*cos(rdekl)* &
-       cos((ttime-12.+xlon/15.+eq)*pi/12.)
-  ! Calculate the maximum solar elevation on that day
-  !sinsol=sin(rylat)*sin(rdekl)+cos(rylat)*cos(rdekl)*
-  !    &       cos((eq)*pi/12.)
-  solelev=asin(sinsol)*180./pi
-  zenithangle=90.-solelev
-
-  return
-end function zenithangle
-
-subroutine ohreaction(itime,ltsample,loutnext)
-  !                     i      i        i
-  !*****************************************************************************
-  !                                                                            *
-  !                                                                            *
-  !    Author: R.L. Thompson                                                   *
-  !                                                                            *
-  !    Nov 2014                                                                *
-  !                                                                            *
-  !                                                                            *
-  !*****************************************************************************
-  ! Variables:                                                                 *
-  ! ix,jy                indices of output grid cell for each particle         *
-  ! itime [s]            actual simulation time [s]                            *
-  ! jpart                particle index                                        *
-  ! ldeltat [s]          interval since radioactive decay was computed         *
-  ! loutnext [s]         time for which gridded deposition is next output      *
-  ! loutstep [s]         interval at which gridded deposition is output        *
-  ! oh_average [molecule/cm^3] OH Concentration                                *
-  ! ltsample [s]         interval over which mass is deposited                 *
-  !                                                                            *
-  !*****************************************************************************
-  use par_mod
-  use com_mod
-  use windfields_mod
-  use particle_mod
-
-  implicit none
-
-  integer :: jpart,itime,ltsample,loutnext,ldeltat,j,k,ix,jy!,ijx,jjy
-!PS  integer :: ngrid,interp_time,m,n,ih,indz,i!,ia,il
-  integer :: ngrid,interp_time,n,indz,i!,ia,il
-!PS  integer :: jjjjmmdd,hhmmss,
-  integer OHx,OHy,OHz
-  real, dimension(nzOH) :: altOHtop
-  real :: xlon,ylat 
-  real :: xtn,ytn
-  real :: restmass,ohreacted,oh_average
-  real :: ohrate,temp 
-  real, parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
-  real(kind=dp) :: jul
-
-  ! Compute interval since radioactive decay of deposited mass was computed
-  !************************************************************************
-
-  if (itime.le.loutnext) then
-    ldeltat=itime-(loutnext-loutstep)
-  else                                  ! first half of next interval
-    ldeltat=itime-loutnext
-  endif
-
-!PS  jul=bdate+real(itime,kind=dp)/86400.
-!PS  call caldate(jul,jjjjmmdd,hhmmss)
-!PS  m=(jjjjmmdd-(jjjjmmdd/10000)*10000)/100
-!PS  h=hhmmss/10000
-
-  ! Loop over particles
-  !*****************************************
-!$OMP PARALLEL PRIVATE(jpart,xtn,ytn,j,k,ix,jy,interp_time, &
-!$OMP n,indz,i,xlon,ylat,OHx,OHy,OHz,oh_average,temp,ohrate, &
-!$OMP restmass,ohreacted,altOHtop,ngrid)
-
-!$OMP DO
-  do jpart=1,numpart
-
-    ! Determine which nesting level to be used
-    ngrid=0
-    do j=numbnests,1,-1 ! Why is there a +/- eps everywhere else for ngrid but not here?
-      if ((part(jpart)%xlon.gt.xln(j)).and.(part(jpart)%xlon.lt.xrn(j)).and. &
-           (part(jpart)%ylat.gt.yln(j)).and.(part(jpart)%ylat.lt.yrn(j))) then
-        ngrid=j
-        exit
-      endif
-    end do
-
-    ! Determine nested grid coordinates
-    if (ngrid.gt.0) then
-      xtn=(part(jpart)%xlon-xln(ngrid))*xresoln(ngrid)
-      ytn=(part(jpart)%ylat-yln(ngrid))*yresoln(ngrid)
-      ix=int(xtn)
-      jy=int(ytn)
-    else
-      ix=int(part(jpart)%xlon)
-      jy=int(part(jpart)%ylat)
-    endif
-
-    interp_time=nint(itime-0.5*ltsample)
-    n=2
-    if(abs(memtime(1)-interp_time).lt.abs(memtime(2)-interp_time)) n=1
-
-    indz=nz-1
-    do i=2,nz
-      if (height(i).gt.part(jpart)%z) then
-        indz=i-1
-        exit
-      endif
-    end do
-
-    ! Get OH from nearest grid-cell and specific month 
-    !*************************************************
-
-    ! world coordinates
-    xlon=part(jpart)%xlon*dx+xlon0
-    if (xlon.gt.180) then
-       xlon=xlon-360
-    endif
-    ylat=part(jpart)%ylat*dy+ylat0
-
-    ! get position in the OH field
-    OHx=minloc(abs(lonOH-xlon),dim=1,mask=abs(lonOH-xlon).eq.minval(abs(lonOH-xlon)))
-    OHy=minloc(abs(latOH-ylat),dim=1,mask=abs(latOH-ylat).eq.minval(abs(latOH-ylat)))
-
-    ! get the level of the OH field for the particle
-    ! z is the z-coord of the trajectory above model orography in metres
-    ! altOH is the height of the centre of the level in the OH field above orography
-    do i=2,nzOH
-      altOHtop(i-1)=altOH(i)+0.5*(altOH(i)-altOH(i-1))
-    end do
-    altOHtop(nzOH)=altOH(nzOH)+0.5*(altOH(nzOH)-altOH(nzOH-1))
-    OHz=minloc(abs(altOHtop-part(jpart)%z),dim=1,mask=abs(altOHtop-part(jpart)%z) &
-          .eq.minval(abs(altOHtop-part(jpart)%z)))
-
-    ! Interpolate between hourly OH fields to current time
-    !*****************************************************
-
-    oh_average=OH_hourly(OHx,OHy,OHz,1)+ &
-               (OH_hourly(OHx,OHy,OHz,2)-OH_hourly(OHx,OHy,OHz,1))* &
-               (itime-memOHtime(1))/(memOHtime(2)-memOHtime(1))
-
-    if (oh_average.gt.smallnum) then
-
-      ! Computation of the OH reaction
-      !**********************************************************
-
-      temp=tt(ix,jy,indz,n)
-
-      do k=1,nspec                                
-        if (ohcconst(k).gt.0.) then
-          ohrate=ohcconst(k)*temp**ohnconst(k)*exp(-ohdconst(k)/temp)*oh_average
-          ! new particle mass
-          restmass = part(jpart)%mass(k)*exp(-1*ohrate*abs(ltsample))
-          if (restmass .gt. smallnum) then
-            part(jpart)%mass(k)=restmass
-          else
-            part(jpart)%mass(k)=0.
-          endif
-          ohreacted=part(jpart)%mass(k)*(1-exp(-1*ohrate*abs(ltsample)))
-          if (jpart.eq.1) write(*,*) 'ohreaction', part(jpart)%mass(k),k
-        else
-          ohreacted=0.
-        endif
-      end do
-    endif  ! oh_average.gt.smallnum 
-
-  end do  !continue loop over all particles
-
-!$OMP END DO
-!$OMP END PARALLEL
-end subroutine ohreaction
-
-subroutine gethourlyOH(itime)
-  !                     i     
-  !*****************************************************************************
-  !                                                                            *
-  !                                                                            *
-  !    Author: R.L. Thompson                                                   *
-  !                                                                            *
-  !    Nov 2014                                                                *
-  !                                                                            *
-  !                                                                            *
-  !*****************************************************************************
-  ! Variables:                                                                 *
-  !                                                                            *
-  !*****************************************************************************
-  use par_mod
-  use com_mod
-
-  implicit none
-  
-  integer :: itime
-  integer :: ix,jy,kz,m1,m2
-  integer :: ijx,jjy
-  integer :: jjjjmmdd,hhmmss
-  real :: sza,jrate
-  real(kind=dp) :: jul1,jul2
-
-
-  ! Check hourly OH field is available for the current time step
-  !**************************************************************
-
-  if ((ldirect*memOHtime(1).le.ldirect*itime).and. &
-       (ldirect*memOHtime(2).gt.ldirect*itime)) then
-
-  ! The right OH fields are already in memory -> don't do anything
-  !****************************************************************
-
-    return
-
-  else if ((ldirect*memOHtime(2).le.ldirect*itime).and. &
-       (memOHtime(2).ne.0.)) then
-
-    ! Current time is after 2nd OH field
-    !************************************
-
-    memOHtime(1)=memOHtime(2)
-    memOHtime(2)=memOHtime(1)+ldirect*3600.
-    OH_hourly(:,:,:,1)=OH_hourly(:,:,:,2)
-
-    ! Compute new hourly value of OH
-    !**********************************************************
-
-    jul2=bdate+memOHtime(2)/86400._dp  ! date for next hour
-    call caldate(jul2,jjjjmmdd,hhmmss)
-    m2=(jjjjmmdd-(jjjjmmdd/10000)*10000)/100
-
-!$OMP PARALLEL PRIVATE(kz,jy,ix,ijx,jjy,sza,jrate) 
-!$OMP DO COLLAPSE(3)
-    do kz=1,nzOH
-      do jy=1,nyOH
-        do ix=1,nxOH
-          ijx=minloc(abs(lonjr-lonOH(ix)),dim=1,mask=abs(lonjr-lonOH(ix)).eq.minval(abs(lonjr-lonOH(ix))))
-          jjy=minloc(abs(latjr-latOH(jy)),dim=1,mask=abs(latjr-latOH(jy)).eq.minval(abs(latjr-latOH(jy))))
-          ! calculate solar zenith angle in degrees (sza) 
-          sza=zenithangle(latOH(jy),lonOH(ix),jul2)
-          ! calculate J(O1D) (jrate)
-          jrate=photo_O1D(sza)
-          ! apply hourly correction to OH
-          if(jrate_average(ijx,jjy,m2).gt.0.) then
-            OH_hourly(ix,jy,kz,2)=OH_field(ix,jy,kz,m2)*jrate/jrate_average(ijx,jjy,m2)
-          else
-            OH_hourly(ix,jy,kz,2)=0.
-          endif
-          !! for testing !!
-          ! if(jy.eq.36.and.ix.eq.36.and.kz.eq.1) then
-          !   write(999,fmt='(F6.3)') jrate/jrate_average(ijx,jjy,m2)
-          ! endif
-          ! if(jy.eq.11.and.ix.eq.36.and.kz.eq.1) then
-          !   write(998,fmt='(F6.3)') jrate/jrate_average(ijx,jjy,m2)
-          ! endif
-        end do
-      end do
-    end do
-!$OMP END DO
-!$OMP END PARALLEL
-
-  else
-
-    ! No OH fields in memory -> compute both hourly OH fields
-    !**********************************************************
-
-    jul1=bdate  ! begin date of simulation (julian)
-    call caldate(jul1,jjjjmmdd,hhmmss)
-    m1=(jjjjmmdd-(jjjjmmdd/10000)*10000)/100
-    memOHtime(1)=0.
+#include "ohr_photo_O1D.f90"
 
-    jul2=bdate+ldirect*real(1./24.,kind=dp)  ! date for next hour
-    call caldate(jul2,jjjjmmdd,hhmmss)
-    m2=(jjjjmmdd-(jjjjmmdd/10000)*10000)/100
-    memOHtime(2)=ldirect*3600.
+#include "ohr_zenithangle.f90"
 
-!$OMP PARALLEL PRIVATE(kz,jy,ix,ijx,jjy,sza,jrate) 
-!$OMP DO COLLAPSE(3)
-    do kz=1,nzOH
-      do jy=1,nyOH
-        do ix=1,nxOH
-          ijx=minloc(abs(lonjr-lonOH(ix)),dim=1,mask=abs(lonjr-lonOH(ix)).eq.minval(abs(lonjr-lonOH(ix))))
-          jjy=minloc(abs(latjr-latOH(jy)),dim=1,mask=abs(latjr-latOH(jy)).eq.minval(abs(latjr-latOH(jy))))
-          ! calculate solar zenith angle in degrees (sza), beginning 
-          sza=zenithangle(latOH(jy),lonOH(ix),jul1)
-          ! calculate J(O1D) (jrate), beginning
-          jrate=photo_O1D(sza)
-          ! apply hourly correction to OH
-          if(jrate_average(ijx,jjy,m1).gt.0.) then
-            OH_hourly(ix,jy,kz,1)=OH_field(ix,jy,kz,m1)*jrate/jrate_average(ijx,jjy,m1)
-          else
-            OH_hourly(ix,jy,kz,1)=0.
-          endif
-          ! calculate solar zenith angle in degrees (sza), after 1-hour 
-          sza=zenithangle(latOH(jy),lonOH(ix),jul2)
-          ! calculate J(O1D) (jrate), after 1-hour
-          jrate=photo_O1D(sza)
-          ! apply hourly correction to OH
-          if(jrate_average(ijx,jjy,m2).gt.0.) then
-            OH_hourly(ix,jy,kz,2)=OH_field(ix,jy,kz,m2)*jrate/jrate_average(ijx,jjy,m2)
-          else
-            OH_hourly(ix,jy,kz,2)=0.
-          endif
-        end do
-      end do
-    end do
-!$OMP END DO
-!$OMP END PARALLEL
+#include "ohr_ohreaction.f90"
 
-  endif
-end subroutine gethourlyOH
+#include "ohr_gethourlyOH.f90"
 
 end module ohr_mod
diff --git a/src/ohr_ohreaction.f90 b/src/ohr_ohreaction.f90
new file mode 100644
index 0000000000000000000000000000000000000000..aa5c1ee16779dafa589e095aca74720ab802a0f7
--- /dev/null
+++ b/src/ohr_ohreaction.f90
@@ -0,0 +1,162 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine ohreaction(itime,ltsample,loutnext)
+  !                     i      i        i
+  !*****************************************************************************
+  !                                                                            *
+  !                                                                            *
+  !    Author: R.L. Thompson                                                   *
+  !                                                                            *
+  !    Nov 2014                                                                *
+  !                                                                            *
+  !                                                                            *
+  !*****************************************************************************
+  ! Variables:                                                                 *
+  ! ix,jy                indices of output grid cell for each particle         *
+  ! itime [s]            actual simulation time [s]                            *
+  ! jpart                particle index                                        *
+  ! ldeltat [s]          interval since radioactive decay was computed         *
+  ! loutnext [s]         time for which gridded deposition is next output      *
+  ! loutstep [s]         interval at which gridded deposition is output        *
+  ! oh_average [molecule/cm^3] OH Concentration                                *
+  ! ltsample [s]         interval over which mass is deposited                 *
+  !                                                                            *
+  !*****************************************************************************
+  use par_mod
+  use com_mod
+  use windfields_mod
+  use particle_mod
+
+  implicit none
+
+  integer :: jpart,itime,ltsample,loutnext,ldeltat,j,k,ix,jy!,ijx,jjy
+!PS  integer :: ngrid,interp_time,m,n,ih,indz,i!,ia,il
+  integer :: ngrid,interp_time,n,indz,i!,ia,il
+!PS  integer :: jjjjmmdd,hhmmss,
+  integer OHx,OHy,OHz
+  real, dimension(nzOH) :: altOHtop
+  real :: xlon,ylat
+  real :: xtn,ytn
+  real :: restmass,ohreacted,oh_average
+  real :: ohrate,temp
+  real, parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
+  real(kind=dp) :: jul
+
+  ! Compute interval since radioactive decay of deposited mass was computed
+  !************************************************************************
+
+  if (itime.le.loutnext) then
+    ldeltat=itime-(loutnext-loutstep)
+  else                                  ! first half of next interval
+    ldeltat=itime-loutnext
+  endif
+
+!PS  jul=bdate+real(itime,kind=dp)/86400.
+!PS  call caldate(jul,jjjjmmdd,hhmmss)
+!PS  m=(jjjjmmdd-(jjjjmmdd/10000)*10000)/100
+!PS  h=hhmmss/10000
+
+  ! Loop over particles
+  !*****************************************
+!$OMP PARALLEL PRIVATE(jpart,xtn,ytn,j,k,ix,jy,interp_time, &
+!$OMP n,indz,i,xlon,ylat,OHx,OHy,OHz,oh_average,temp,ohrate, &
+!$OMP restmass,ohreacted,altOHtop,ngrid)
+
+!$OMP DO
+  do jpart=1,numpart
+
+    ! Determine which nesting level to be used
+    ngrid=0
+    do j=numbnests,1,-1 ! Why is there a +/- eps everywhere else for ngrid but not here?
+      if ((part(jpart)%xlon.gt.xln(j)).and.(part(jpart)%xlon.lt.xrn(j)).and. &
+           (part(jpart)%ylat.gt.yln(j)).and.(part(jpart)%ylat.lt.yrn(j))) then
+        ngrid=j
+        exit
+      endif
+    end do
+
+    ! Determine nested grid coordinates
+    if (ngrid.gt.0) then
+      xtn=(part(jpart)%xlon-xln(ngrid))*xresoln(ngrid)
+      ytn=(part(jpart)%ylat-yln(ngrid))*yresoln(ngrid)
+      ix=int(xtn)
+      jy=int(ytn)
+    else
+      ix=int(part(jpart)%xlon)
+      jy=int(part(jpart)%ylat)
+    endif
+
+    interp_time=nint(itime-0.5*ltsample)
+    n=2
+    if(abs(memtime(1)-interp_time).lt.abs(memtime(2)-interp_time)) n=1
+
+    indz=nz-1
+    do i=2,nz
+      if (height(i).gt.part(jpart)%z) then
+        indz=i-1
+        exit
+      endif
+    end do
+
+    ! Get OH from nearest grid-cell and specific month
+    !*************************************************
+
+    ! world coordinates
+    xlon=part(jpart)%xlon*dx+xlon0
+    if (xlon.gt.180) then
+       xlon=xlon-360
+    endif
+    ylat=part(jpart)%ylat*dy+ylat0
+
+    ! get position in the OH field
+    OHx=minloc(abs(lonOH-xlon),dim=1,mask=abs(lonOH-xlon).eq.minval(abs(lonOH-xlon)))
+    OHy=minloc(abs(latOH-ylat),dim=1,mask=abs(latOH-ylat).eq.minval(abs(latOH-ylat)))
+
+    ! get the level of the OH field for the particle
+    ! z is the z-coord of the trajectory above model orography in metres
+    ! altOH is the height of the centre of the level in the OH field above orography
+    do i=2,nzOH
+      altOHtop(i-1)=altOH(i)+0.5*(altOH(i)-altOH(i-1))
+    end do
+    altOHtop(nzOH)=altOH(nzOH)+0.5*(altOH(nzOH)-altOH(nzOH-1))
+    OHz=minloc(abs(altOHtop-part(jpart)%z),dim=1,mask=abs(altOHtop-part(jpart)%z) &
+          .eq.minval(abs(altOHtop-part(jpart)%z)))
+
+    ! Interpolate between hourly OH fields to current time
+    !*****************************************************
+
+    oh_average=OH_hourly(OHx,OHy,OHz,1)+ &
+               (OH_hourly(OHx,OHy,OHz,2)-OH_hourly(OHx,OHy,OHz,1))* &
+               (itime-memOHtime(1))/(memOHtime(2)-memOHtime(1))
+
+    if (oh_average.gt.smallnum) then
+
+      ! Computation of the OH reaction
+      !**********************************************************
+
+      temp=tt(ix,jy,indz,n)
+
+      do k=1,nspec
+        if (ohcconst(k).gt.0.) then
+          ohrate=ohcconst(k)*temp**ohnconst(k)*exp(-ohdconst(k)/temp)*oh_average
+          ! new particle mass
+          restmass = part(jpart)%mass(k)*exp(-1*ohrate*abs(ltsample))
+          if (restmass .gt. smallnum) then
+            part(jpart)%mass(k)=restmass
+          else
+            part(jpart)%mass(k)=0.
+          endif
+          ohreacted=part(jpart)%mass(k)*(1-exp(-1*ohrate*abs(ltsample)))
+          if (jpart.eq.1) write(*,*) 'ohreaction', part(jpart)%mass(k),k
+        else
+          ohreacted=0.
+        endif
+      end do
+    endif  ! oh_average.gt.smallnum
+
+  end do  !continue loop over all particles
+
+!$OMP END DO
+!$OMP END PARALLEL
+end subroutine ohreaction
diff --git a/src/ohr_photo_O1D.f90 b/src/ohr_photo_O1D.f90
new file mode 100644
index 0000000000000000000000000000000000000000..ef8570752c554c451050add2b9108c99a45916b9
--- /dev/null
+++ b/src/ohr_photo_O1D.f90
@@ -0,0 +1,60 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+real function photo_O1D(sza)
+
+  !*****************************************************************************
+  !                                                                            *
+  !                                                                            *
+  !    Author: A. Stohl                                                        *
+  !                                                                            *
+  !    Nov 2014                                                                *
+  !                                                                            *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  !    INPUT:                                                                  *
+  !    sza        solar zenith angle (degrees)                                 *
+  !                                                                            *
+  !    OUTPUT:                                                                 *
+  !    photo_O1D  J(O1D) photoylsis rate                                       *
+  !                                                                            *
+  !*****************************************************************************
+
+  implicit none
+
+  integer :: iz,ik
+  real :: sza
+  real :: z1,z2,zg,f1,f2,dummy
+  real :: photo_NO2
+  integer, parameter :: nzenith=11
+  real, parameter :: pi=3.1415927
+  real, dimension(nzenith) :: zangle,fact_photo
+
+  ! zangle: zenith angles for which fact_photo is tabulated
+  ! fact_photo: conversion of photolysis rate of NO2 to photolysis
+  !     rate of O3 into O1D as a function of solar zenith angle
+
+  zangle=(/0.,10.,20.,30.,40.,50.,60.,70.,78.,86.,90.0001/)
+  fact_photo=(/0.4616E-02,0.4478E-02,0.4131E-02,0.3583E-02,0.2867E-02,&
+    &0.2081E-02,0.1235E-02,0.5392E-03,0.2200E-03,0.1302E-03,0.0902E-03/)
+
+  if (sza.lt.90.) then
+    do iz=1,nzenith-1
+      if(sza.ge.zangle(iz)) ik=iz
+    end do
+    z1=1./cos(zangle(ik)*pi/180.)
+    z2=1./cos(zangle(ik+1)*pi/180.)
+    zg=1./cos(sza*pi/180.)
+    dummy=(zg-z1)/(z2-z1)
+    f1=alog(fact_photo(ik))
+    f2=alog(fact_photo(ik+1))
+    photo_NO2=1.45e-2*exp(-0.4/cos(sza*pi/180.))
+    photo_O1D=photo_NO2*exp(f1+(f2-f1)*dummy)
+  else
+    photo_O1D=0.
+  endif
+
+  return
+
+end function photo_O1D
diff --git a/src/ohr_zenithangle.f90 b/src/ohr_zenithangle.f90
new file mode 100644
index 0000000000000000000000000000000000000000..0e8ea67ffa6b539760ba8a517251ff3d0fa9ef99
--- /dev/null
+++ b/src/ohr_zenithangle.f90
@@ -0,0 +1,77 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+real function zenithangle(ylat,xlon,jul)
+
+  !*********************************************************************
+  !                                                                    *
+  !                      Author: G. WOTAWA                             *
+  !                      Date: 1993-11-17                              *
+  !                      Project: POP-M                                *
+  !                      Last update:                                  *
+  !                                                                    *
+  !*********************************************************************
+  !                                                                    *
+  !     DESCRIPTION: This function returns the sinus of solar          *
+  !                  elevation as a function of geographic longitude,  *
+  !                  latitude and GMT-Time.                            *
+  !                                                                    *
+  !*********************************************************************
+  !                                                                    *
+  !     INPUT:                                                         *
+  !                                                                    *
+  !            ylat          geographical latitude  [DEG]              *
+  !            xlon          geographical longitude [DEG]              *
+  !            jjjj          Year                                      *
+  !            mm            Month                                     *
+  !            dd            Day                                       *
+  !            hh            Hour                                      *
+  !            minute        Minute                                    *
+  !                                                                    *
+  !*********************************************************************
+
+  use par_mod, only: dp
+
+  implicit none
+
+  integer :: jjjj,mm,id,iu,minute,yyyymmdd,hhmmss
+  integer :: ndaynum
+  real :: sinsol,solelev,ylat,xlon
+  real :: rnum,rylat,ttime,dekl,rdekl,eq
+  real,parameter :: pi=3.1415927
+  real(kind=dp)  :: jul
+
+  call caldate(jul,yyyymmdd,hhmmss)
+  jjjj=yyyymmdd/10000
+  mm=yyyymmdd/100-jjjj*100
+  id=yyyymmdd-jjjj*10000-mm*100
+  iu=hhmmss/10000
+  minute=hhmmss/100-100*iu
+
+  ndaynum=31*(mm-1)+id
+  if(mm.gt.2) ndaynum=ndaynum-int(0.4*mm+2.3)
+  if((mm.gt.2).and.(jjjj/4*4.eq.jjjj)) ndaynum=ndaynum+1
+
+  rnum=2.*pi*ndaynum/365.
+  rylat=pi*ylat/180.
+  ttime=real(iu)+real(minute)/60.
+
+  dekl=0.396+3.631*sin(rnum)+0.038*sin(2.*rnum)+0.077*sin(3.*rnum)- &
+       22.97*cos(rnum)-0.389*cos(2.*rnum)-0.158*cos(3.*rnum)
+  rdekl=pi*dekl/180.
+
+  eq=(0.003-7.343*sin(rnum)-9.47*sin(2.*rnum)- &
+       0.329*sin(3.*rnum)-0.196*sin(4.*rnum)+ &
+       0.552*cos(rnum)-3.020*cos(2.*rnum)- &
+       0.076*cos(3.*rnum)-0.125*cos(4.*rnum))/60.
+
+  sinsol=sin(rylat)*sin(rdekl)+cos(rylat)*cos(rdekl)* &
+       cos((ttime-12.+xlon/15.+eq)*pi/12.)
+  ! Calculate the maximum solar elevation on that day
+  !sinsol=sin(rylat)*sin(rdekl)+cos(rylat)*cos(rdekl)*
+  !    &       cos((eq)*pi/12.)
+  solelev=asin(sinsol)*180./pi
+  zenithangle=90.-solelev
+
+  return
+end function zenithangle
diff --git a/src/out_conccalc.f90 b/src/out_conccalc.f90
new file mode 100644
index 0000000000000000000000000000000000000000..06a51df9dea45e6dab135a721a1691b2f2fea84f
--- /dev/null
+++ b/src/out_conccalc.f90
@@ -0,0 +1,626 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine conccalc(itime,weight)
+  !                      i     i
+  !*****************************************************************************
+  !                                                                            *
+  !     Calculation of the concentrations on a regular grid using volume       *
+  !     sampling                                                               *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     24 May 1996                                                            *
+  !                                                                            *
+  !     April 2000: Update to calculate age spectra                            *
+  !                 Bug fix to avoid negative conc. at the domain boundaries,  *
+  !                 as suggested by Petra Seibert                              *
+  !                                                                            *
+  !     2 July 2002: re-order if-statements in order to optimize CPU time      *
+  !                                                                            *
+  !     2021, LB: OpenMP parallelisation                                       *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! nspeciesdim     = nspec for forward runs, 1 for backward runs              *
+  !                                                                            *
+  !*****************************************************************************
+
+  use unc_mod
+  use prepoutgrid_mod
+  use par_mod
+  use com_mod
+  use omp_lib, only: OMP_GET_THREAD_NUM
+  use interpol_mod, only: interpol_density
+  use coord_ec_mod
+  use particle_mod
+
+  implicit none
+
+  integer,intent(in) :: itime
+  real,intent(in) :: weight
+  integer :: itage,i,kz,ks,n,nage,inage,thread,ithread
+  integer :: il,ind,indz,indzp,nrelpointer
+  integer :: ix,jy,ixp,jyp
+  real :: ddx,ddy
+  real(kind=dp) :: mm3
+  real :: hx,hy,hz,hxyz,xd,yd,zd,xkern,r2,c(maxspec)
+  real :: rhoi
+  real :: xl,yl,wx,wy,w
+  real,parameter :: factor=.596831, hxmax=6.0, hymax=4.0, hzmax=150.
+  !  integer xscav_count
+
+  ! For forward simulations, make a loop over the number of species;
+  ! for backward simulations, make an additional loop over the
+  ! releasepoints
+  !***************************************************************************
+  !  xscav_count=0
+#ifdef _OPENMP
+  call omp_set_num_threads(numthreads_grid)
+#endif
+!$OMP PARALLEL PRIVATE(i,itage,nage,inage,rhoi,nrelpointer,kz,xl,yl,ks,wx,wy,w,thread,ddx,ddy, &
+!$OMP ix,jy,ixp,jyp)
+#if (defined _OPENMP)
+    thread = OMP_GET_THREAD_NUM()+1 ! Starts with 1
+#else
+    thread = 1
+#endif
+
+!$OMP DO
+  do i=1,numpart
+    if (.not.part(i)%alive) cycle
+
+  ! Determine age class of the particle
+    itage=abs(itime-part(i)%tstart)
+    nage=1
+    do inage=1,nageclass
+      nage=inage
+      if (itage.lt.lage(nage)) exit
+    end do
+
+  !  if (xscav_frac1(i,1).lt.0) xscav_count=xscav_count+1
+
+  ! For special runs, interpolate the air density to the particle position
+  !************************************************************************
+  !***********************************************************************
+  !AF IND_SOURCE switches between different units for concentrations at the source
+  !Af    NOTE that in backward simulations the release of particles takes place
+  !Af    at the receptor and the sampling at the source.
+  !Af          1="mass"
+  !Af          2="mass mixing ratio"
+  !Af IND_RECEPTOR switches between different units for concentrations at the receptor
+  !Af          1="mass"
+  !Af          2="mass mixing ratio"
+
+  !Af switches for the conccalcfile:
+  !AF IND_SAMP =  0 : xmass * 1
+  !Af IND_SAMP = -1 : xmass / rho
+
+  !Af ind_samp is defined in readcommand.f
+
+    if ( ind_samp .eq. -1 ) then
+      call update_zeta_to_z(itime,i)
+      call interpol_density(itime,i,rhoi)
+    elseif (ind_samp.eq.0) then
+      rhoi = 1.
+    endif
+
+  !****************************************************************************
+  ! 1. Evaluate grid concentrations using a uniform kernel of bandwidths dx, dy
+  !****************************************************************************
+
+
+  ! For backward simulations, look from which release point the particle comes from
+  ! For domain-filling trajectory option, npoint contains a consecutive particle
+  ! number, not the release point information. Therefore, nrelpointer is set to 1
+  ! for the domain-filling option.
+  !*****************************************************************************
+
+    if ((ioutputforeachrelease.eq.0).or.(mdomainfill.eq.1)) then
+       nrelpointer=1
+    else
+       nrelpointer=part(i)%npoint
+    endif
+
+    do kz=1,numzgrid                ! determine height of cell
+      if (outheight(kz).gt.part(i)%z) exit
+    end do
+
+    if (kz.le.numzgrid) then           ! inside output domain
+
+
+  !********************************
+  ! Do everything for mother domain
+  !********************************
+
+      xl=(part(i)%xlon*dx+xoutshift)/dxout
+      yl=(part(i)%ylat*dy+youtshift)/dyout
+      ix=int(xl)
+      if (xl.lt.0.) ix=ix-1
+      jy=int(yl)
+      if (yl.lt.0.) jy=jy-1
+
+
+
+  ! For particles aged less than 3 hours, attribute particle mass to grid cell
+  ! it resides in rather than use the kernel, in order to avoid its smoothing effect.
+  ! For older particles, use the uniform kernel.
+  ! If a particle is close to the domain boundary, do not use the kernel either.
+  !*****************************************************************************
+
+      if ((.not.lusekerneloutput).or.(itage.lt.10800).or. &
+           (xl.lt.0.5).or.(yl.lt.0.5).or. &
+           (xl.gt.real(numxgrid-1)-0.5).or. &
+           (yl.gt.real(numygrid-1)-0.5)) then             ! no kernel, direct attribution to grid cell
+
+        if ((ix.ge.0).and.(jy.ge.0).and.(ix.le.numxgrid-1).and. &
+             (jy.le.numygrid-1)) then
+          if (DRYBKDEP.or.WETBKDEP) then
+            do ks=1,nspec
+#ifdef _OPENMP
+              gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
+                   gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
+                   part(i)%mass(ks)/rhoi*weight*max(xscav_frac1(i,ks),0.0)
+#else
+              gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= &
+                   gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
+                   part(i)%mass(ks)/rhoi*weight*max(xscav_frac1(i,ks),0.0)
+#endif
+            end do
+          else
+            if (lparticlecountoutput) then
+              do ks=1,nspec
+#ifdef _OPENMP
+                gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
+                     gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+1
+#else
+                gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= &
+                     gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+1
+#endif
+              end do
+            else
+              do ks=1,nspec
+#ifdef _OPENMP
+                gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
+                     gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
+                     part(i)%mass(ks)/rhoi*weight
+#else
+                gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= &
+                     gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
+                     part(i)%mass(ks)/rhoi*weight
+#endif
+              end do
+            end if
+          endif
+        endif
+
+      else                                 ! attribution via uniform kernel
+
+        ddx=xl-real(ix)                   ! distance to left cell border
+        ddy=yl-real(jy)                   ! distance to lower cell border
+        if (ddx.gt.0.5) then
+          ixp=ix+1
+          wx=1.5-ddx
+        else
+          ixp=ix-1
+          wx=0.5+ddx
+        endif
+
+        if (ddy.gt.0.5) then
+          jyp=jy+1
+          wy=1.5-ddy
+        else
+          jyp=jy-1
+          wy=0.5+ddy
+        endif
+
+  ! Determine mass fractions for four grid points
+  !**********************************************
+
+        if ((ix.ge.0).and.(ix.le.numxgrid-1)) then
+          if ((jy.ge.0).and.(jy.le.numygrid-1)) then
+            w=wx*wy
+            if (DRYBKDEP.or.WETBKDEP) then
+               do ks=1,nspec
+#ifdef _OPENMP
+                 gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
+                   gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
+                   part(i)%mass(ks)/rhoi*w*weight*max(xscav_frac1(i,ks),0.0)
+#else
+                 gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= &
+                   gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
+                   part(i)%mass(ks)/rhoi*w*weight*max(xscav_frac1(i,ks),0.0)
+#endif
+               end do
+            else
+               do ks=1,nspec
+#ifdef _OPENMP
+                 gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
+                   gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
+                   part(i)%mass(ks)/rhoi*weight*w
+#else
+                 gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= &
+                   gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
+                   part(i)%mass(ks)/rhoi*weight*w
+#endif
+               end do
+            endif
+          endif
+
+          if ((jyp.ge.0).and.(jyp.le.numygrid-1)) then
+            w=wx*(1.-wy)
+            if (DRYBKDEP.or.WETBKDEP) then
+              do ks=1,nspec
+#ifdef _OPENMP
+                 gridunc_omp(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
+                   gridunc_omp(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
+                   part(i)%mass(ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0)
+#else
+                 gridunc(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)= &
+                   gridunc(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
+                   part(i)%mass(ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0)
+#endif
+               end do
+             else
+              do ks=1,nspec
+#ifdef _OPENMP
+                 gridunc_omp(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
+                   gridunc_omp(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
+                   part(i)%mass(ks)/rhoi*weight*w
+#else
+                 gridunc(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)= &
+                   gridunc(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
+                   part(i)%mass(ks)/rhoi*weight*w
+#endif
+               end do
+             endif
+          endif
+        endif !ix ge 0
+
+
+        if ((ixp.ge.0).and.(ixp.le.numxgrid-1)) then
+          if ((jyp.ge.0).and.(jyp.le.numygrid-1)) then
+            w=(1.-wx)*(1.-wy)
+            if (DRYBKDEP.or.WETBKDEP) then
+               do ks=1,nspec
+#ifdef _OPENMP
+                 gridunc_omp(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
+                   gridunc_omp(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
+                   part(i)%mass(ks)/rhoi*w*weight*max(xscav_frac1(i,ks),0.0)
+#else
+                 gridunc(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)= &
+                   gridunc(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
+                   part(i)%mass(ks)/rhoi*w*weight*max(xscav_frac1(i,ks),0.0)
+#endif
+               end do
+            else
+               do ks=1,nspec
+#ifdef _OPENMP
+                 gridunc_omp(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
+                   gridunc_omp(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
+                   part(i)%mass(ks)/rhoi*weight*w
+#else
+                 gridunc(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)= &
+                   gridunc(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
+                   part(i)%mass(ks)/rhoi*weight*w
+#endif
+               end do
+            endif
+          endif
+
+          if ((jy.ge.0).and.(jy.le.numygrid-1)) then
+            w=(1.-wx)*wy
+            if (DRYBKDEP.or.WETBKDEP) then
+               do ks=1,nspec
+#ifdef _OPENMP
+                 gridunc_omp(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
+                   gridunc_omp(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
+                   part(i)%mass(ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0)
+#else
+                 gridunc(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= &
+                   gridunc(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
+                   part(i)%mass(ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0)
+#endif
+               end do
+            else
+               do ks=1,nspec
+#ifdef _OPENMP
+                 gridunc_omp(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
+                   gridunc_omp(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
+                   part(i)%mass(ks)/rhoi*weight*w
+#else
+                 gridunc(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= &
+                   gridunc(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
+                   part(i)%mass(ks)/rhoi*weight*w
+#endif
+               end do
+            endif
+          endif
+        endif !ixp ge 0
+      endif
+
+  !************************************
+  ! Do everything for the nested domain
+  !************************************
+
+      if (nested_output.eq.1) then
+        xl=(part(i)%xlon*dx+xoutshiftn)/dxoutn
+        yl=(part(i)%ylat*dy+youtshiftn)/dyoutn
+        ix=int(xl)
+        if (xl.lt.0.) ix=ix-1
+        jy=int(yl)
+        if (yl.lt.0.) jy=jy-1
+
+
+  ! For particles aged less than 3 hours, attribute particle mass to grid cell
+  ! it resides in rather than use the kernel, in order to avoid its smoothing effect.
+  ! For older particles, use the uniform kernel.
+  ! If a particle is close to the domain boundary, do not use the kernel either.
+  !*****************************************************************************
+
+        if ((itage.lt.10800).or.(xl.lt.0.5).or.(yl.lt.0.5).or. &
+             (xl.gt.real(numxgridn-1)-0.5).or. &
+             (yl.gt.real(numygridn-1)-0.5).or.((.not.lusekerneloutput))) then
+  ! no kernel, direct attribution to grid cell
+          if ((ix.ge.0).and.(jy.ge.0).and.(ix.le.numxgridn-1).and. &
+               (jy.le.numygridn-1)) then
+            if (DRYBKDEP.or.WETBKDEP) then
+               do ks=1,nspec
+#ifdef _OPENMP
+                 griduncn_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
+                   griduncn_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
+                   part(i)%mass(ks)/rhoi*weight*max(xscav_frac1(i,ks),0.0)
+#else
+                 griduncn(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= &
+                   griduncn(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
+                   part(i)%mass(ks)/rhoi*weight*max(xscav_frac1(i,ks),0.0)
+#endif
+               end do
+            else
+              if (lparticlecountoutput) then
+                do ks=1,nspec
+#ifdef _OPENMP
+                  griduncn_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
+                       griduncn_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+1
+#else
+                  griduncn(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= &
+                       griduncn(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+1
+#endif
+                end do
+              else
+                do ks=1,nspec
+#ifdef _OPENMP
+                  griduncn_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
+                       griduncn_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
+                       part(i)%mass(ks)/rhoi*weight
+#else
+                  griduncn(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= &
+                       griduncn(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
+                       part(i)%mass(ks)/rhoi*weight
+#endif
+                end do
+              endif
+            endif
+          endif
+
+        else                                 ! attribution via uniform kernel
+
+          ddx=xl-real(ix)                   ! distance to left cell border
+          ddy=yl-real(jy)                   ! distance to lower cell border
+          if (ddx.gt.0.5) then
+            ixp=ix+1
+            wx=1.5-ddx
+          else
+            ixp=ix-1
+            wx=0.5+ddx
+          endif
+
+          if (ddy.gt.0.5) then
+            jyp=jy+1
+            wy=1.5-ddy
+          else
+            jyp=jy-1
+            wy=0.5+ddy
+          endif
+
+
+  ! Determine mass fractions for four grid points
+  !**********************************************
+
+          if ((ix.ge.0).and.(ix.le.numxgridn-1)) then
+            if ((jy.ge.0).and.(jy.le.numygridn-1)) then
+              w=wx*wy
+              if (DRYBKDEP.or.WETBKDEP) then
+                 do ks=1,nspec
+#ifdef _OPENMP
+                   griduncn_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
+                     griduncn_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
+                     part(i)%mass(ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0)
+#else
+                   griduncn(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= &
+                     griduncn(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
+                     part(i)%mass(ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0)
+#endif
+                 end do
+              else
+                do ks=1,nspec
+#ifdef _OPENMP
+                   griduncn_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
+                     griduncn_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
+                     part(i)%mass(ks)/rhoi*weight*w
+#else
+                   griduncn(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= &
+                     griduncn(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
+                     part(i)%mass(ks)/rhoi*weight*w
+#endif
+                 end do
+              endif
+            endif
+
+            if ((jyp.ge.0).and.(jyp.le.numygridn-1)) then
+              w=wx*(1.-wy)
+              if (DRYBKDEP.or.WETBKDEP) then
+                 do ks=1,nspec
+#ifdef _OPENMP
+                   griduncn_omp(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
+                     griduncn_omp(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
+                     part(i)%mass(ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0)
+#else
+                   griduncn(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)= &
+                     griduncn(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
+                     part(i)%mass(ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0)
+#endif
+                 end do
+              else
+                 do ks=1,nspec
+#ifdef _OPENMP
+                   griduncn_omp(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
+                     griduncn_omp(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
+                     part(i)%mass(ks)/rhoi*weight*w
+#else
+                   griduncn(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)= &
+                     griduncn(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
+                     part(i)%mass(ks)/rhoi*weight*w
+#endif
+                 end do
+              endif
+            endif
+          endif
+
+
+          if ((ixp.ge.0).and.(ixp.le.numxgridn-1)) then
+            if ((jyp.ge.0).and.(jyp.le.numygridn-1)) then
+              w=(1.-wx)*(1.-wy)
+              if (DRYBKDEP.or.WETBKDEP) then
+                 do ks=1,nspec
+#ifdef _OPENMP
+                   griduncn_omp(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
+                     griduncn_omp(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
+                     part(i)%mass(ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0)
+#else
+                   griduncn(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)= &
+                     griduncn(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
+                     part(i)%mass(ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0)
+#endif
+                 end do
+              else
+                 do ks=1,nspec
+#ifdef _OPENMP
+                   griduncn_omp(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
+                     griduncn_omp(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
+                     part(i)%mass(ks)/rhoi*weight*w
+#else
+                   griduncn(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)= &
+                     griduncn(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
+                     part(i)%mass(ks)/rhoi*weight*w
+#endif
+                 end do
+              endif
+            endif
+
+            if ((jy.ge.0).and.(jy.le.numygridn-1)) then
+              w=(1.-wx)*wy
+              if (DRYBKDEP.or.WETBKDEP) then
+                 do ks=1,nspec
+#ifdef _OPENMP
+                   griduncn_omp(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
+                     griduncn_omp(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
+                     part(i)%mass(ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0)
+#else
+                   griduncn(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= &
+                     griduncn(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
+                     part(i)%mass(ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0)
+#endif
+                 end do
+              else
+                 do ks=1,nspec
+#ifdef _OPENMP
+                    griduncn_omp(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
+                     griduncn_omp(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
+                     part(i)%mass(ks)/rhoi*weight*w
+#else
+                    griduncn(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= &
+                     griduncn(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
+                     part(i)%mass(ks)/rhoi*weight*w
+#endif
+                 end do
+              endif
+            endif
+          endif
+        endif
+      endif
+    endif
+  end do
+!$OMP END DO
+!$OMP END PARALLEL
+#ifdef _OPENMP
+  call omp_set_num_threads(numthreads)
+#endif
+  ! Reduction of gridunc and griduncn
+#ifdef _OPENMP
+  do ithread=1,numthreads_grid
+    gridunc(:,:,:,:,:,:,:)=gridunc(:,:,:,:,:,:,:)+gridunc_omp(:,:,:,:,:,:,:,ithread)
+    gridunc_omp(:,:,:,:,:,:,:,ithread)=0.
+  end do
+  if (nested_output.eq.1) then
+    do ithread=1,numthreads_grid
+      griduncn(:,:,:,:,:,:,:)=griduncn(:,:,:,:,:,:,:)+griduncn_omp(:,:,:,:,:,:,:,ithread)
+      griduncn_omp(:,:,:,:,:,:,:,ithread)=0.
+    end do
+  endif
+#endif
+
+  !***********************************************************************
+  ! 2. Evaluate concentrations at receptor points, using the kernel method
+  !***********************************************************************
+  if (numreceptor.eq.0) return
+
+  do n=1,numreceptor
+
+
+  ! Reset concentrations
+  !*********************
+
+    do ks=1,nspec
+      c(ks)=0.
+    end do
+
+
+  ! Estimate concentration at receptor
+  !***********************************
+
+    do i=1,numpart
+
+      if (.not. part(i)%alive) cycle
+      itage=abs(itime-part(i)%tstart)
+
+      hz=min(50.+0.3*sqrt(real(itage)),hzmax)
+      zd=part(i)%z/hz
+      if (zd.gt.1.) cycle          ! save computing time, leave loop
+
+      hx=min((0.29+2.222e-3*sqrt(real(itage)))*dx+ &
+           real(itage)*1.2e-5,hxmax)                     ! 80 km/day
+      xd=(part(i)%xlon-xreceptor(n))/hx
+      if (xd*xd.gt.1.) cycle       ! save computing time, leave loop
+
+      hy=min((0.18+1.389e-3*sqrt(real(itage)))*dy+ &
+           real(itage)*7.5e-6,hymax)                     ! 80 km/day
+      yd=(part(i)%ylat-yreceptor(n))/hy
+      if (yd*yd.gt.1.) cycle       ! save computing time, leave loop
+      hxyz=hx*hy*hz
+
+      r2=xd*xd+yd*yd+zd*zd
+      if (r2.lt.1.) then
+        xkern=factor*(1.-r2)
+        do ks=1,nspec
+          c(ks)=c(ks)+part(i)%mass(ks)*xkern/hxyz
+        end do
+      endif
+    end do
+
+    do ks=1,nspec
+      creceptor(n,ks)=creceptor(n,ks)+2.*weight*c(ks)/receptorarea(n)
+    end do
+  end do
+end subroutine conccalc
diff --git a/src/out_finalise_output.f90 b/src/out_finalise_output.f90
new file mode 100644
index 0000000000000000000000000000000000000000..a6bdbaac575da8256642a64623cc53a8e182272d
--- /dev/null
+++ b/src/out_finalise_output.f90
@@ -0,0 +1,33 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine finalise_output(itime)
+  ! Complete the calculation of initial conditions for particles not yet terminated
+
+  implicit none
+
+  integer, intent(in) :: itime
+  integer :: j,ithread
+
+  if (linit_cond.ge.1) then
+    do j=1,numpart
+      call initcond_calc(itime,j,1)
+    end do
+#ifdef _OPENMP
+    do ithread=1,numthreads
+      init_cond(:,:,:,:,:)=init_cond(:,:,:,:,:)+init_cond_omp(:,:,:,:,:,ithread)
+    end do
+#endif
+  endif
+
+
+  if (ipout.eq.2) call output_particle(itime)!,active_per_rel)     ! dump particle positions
+
+  if (linit_cond.ge.1) then
+    if(linversionout.eq.1) then
+      call initcond_output_inv(itime)   ! dump initial cond. field
+    else
+      call initcond_output(itime)   ! dump initial cond. fielf
+    endif
+  endif
+end subroutine finalise_output
diff --git a/src/out_init_output.f90 b/src/out_init_output.f90
new file mode 100644
index 0000000000000000000000000000000000000000..9e0f267850f0a6737c1d716376df8780993cb63b
--- /dev/null
+++ b/src/out_init_output.f90
@@ -0,0 +1,105 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine init_output(itime,filesize)
+
+  implicit none
+
+  integer, intent(in) :: itime
+  real, intent(inout) :: filesize
+#ifdef USE_NCF
+  real(kind=dp) ::          &
+    jul
+  integer ::                &
+    jjjjmmdd,ihmmss,i
+#endif
+
+  ! Writing header information to either binary or NetCDF format
+  if (itime.eq.itime_init) then
+    if (iout.ne.0) then ! No gridded output
+#ifdef USE_NCF
+      if (lnetcdfout.eq.1) then
+        call writeheader_ncf(lnest=.false.)
+      else
+        call writeheader_bin
+      end if
+
+      if (nested_output.eq.1) then
+        if (lnetcdfout.eq.1) then
+          call writeheader_ncf(lnest=.true.)
+        else if ((nested_output.eq.1).and.(surf_only.ne.1)) then
+          call writeheader_bin_nest
+        else if ((nested_output.eq.1).and.(surf_only.eq.1)) then
+          call writeheader_bin_sfc_nest
+        else if ((nested_output.ne.1).and.(surf_only.eq.1)) then
+          call writeheader_bin_sfc
+        endif
+      endif
+#else
+      call writeheader_bin
+
+      !if (nested_output.eq.1) call writeheader_nest
+      if ((nested_output.eq.1).and.(surf_only.ne.1)) call writeheader_bin_nest
+      if ((nested_output.eq.1).and.(surf_only.eq.1)) call writeheader_bin_sfc_nest
+      if ((nested_output.ne.1).and.(surf_only.eq.1)) call writeheader_bin_sfc
+#endif
+    endif ! iout.ne.0
+    ! FLEXPART 9.2 ticket ?? write header in ASCII format
+    call writeheader_txt
+
+    ! NetCDF only: Create file for storing initial particle positions.
+#ifdef USE_NCF
+    if (itime_init.ne.0) then
+      jul=bdate+real(itime,kind=dp)/86400._dp
+      call caldate(jul,jjjjmmdd,ihmmss)
+    endif
+    if ((mdomainfill.eq.0).and.(ipout.ge.1).and.(ipin.le.1)) then
+      if (itime_init.ne.0) then
+        if (ldirect.eq.1) then
+          call particle_initialpos(ihmmss,jjjjmmdd,ibtime,ibdate)
+        else
+          call particle_initialpos(ihmmss,jjjjmmdd,ietime,iedate)
+        endif
+      else if (ldirect.eq.1) then
+        call particle_initialpos(ibtime,ibdate,ibtime,ibdate)
+      else
+        call particle_initialpos(ietime,iedate,ietime,iedate)
+      endif
+    endif
+    ! Create header files for files that store the particle dump output
+    if (ipout.ge.1) then
+      if (itime_init.ne.0) then
+        if (ldirect.eq.1) then
+          call writeheader_partoutput(ihmmss,jjjjmmdd,ibtime,ibdate)
+        else
+          call writeheader_partoutput(ihmmss,jjjjmmdd,ietime,iedate)
+        endif
+      else if (ldirect.eq.1) then
+        call writeheader_partoutput(ibtime,ibdate,ibtime,ibdate)
+      else
+        call writeheader_partoutput(ietime,iedate,ietime,iedate)
+      endif
+    endif
+#endif
+
+  ! In case the particle output file is becoming larger than the maximum set
+  ! in par_mod, create a new one while keeping track of the filesize.
+  ! Also if a new restart file is created.
+  else if ((mod(itime,ipoutfac*loutstep).eq.0).and.(ipout.ge.1)) then
+#ifdef USE_NCF
+    if ((filesize.ge.max_partoutput_filesize).or.(mod(itime,loutrestart).eq.0)) then
+      jul=bdate+real(itime,kind=dp)/86400._dp
+      call caldate(jul,jjjjmmdd,ihmmss)
+      if (ldirect.eq.1) then
+        call writeheader_partoutput(ihmmss,jjjjmmdd,ibtime,ibdate)
+      else
+        call writeheader_partoutput(ihmmss,jjjjmmdd,ietime,iedate)
+      endif
+      filesize = 0.
+    endif
+    do i=1,numpoint
+      filesize = filesize + npart(i)*13.*4./1000000.
+    end do
+#endif
+  endif
+end subroutine init_output
diff --git a/src/out_output_conc.f90 b/src/out_output_conc.f90
new file mode 100644
index 0000000000000000000000000000000000000000..280327067429ad04b785b064c1021bc4367e10e5
--- /dev/null
+++ b/src/out_output_conc.f90
@@ -0,0 +1,128 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine output_conc(itime,loutstart,loutend,loutnext,outnum)
+  use unc_mod
+  use prepoutgrid_mod
+  use par_mod
+  use com_mod
+!#ifdef USE_NCF
+!  use netcdf_output_mod, only: concoutput_ncf,concoutput_ncf_nest,&
+!       &concoutput_sfc_ncf,concoutput_sfc_ncf_nest
+!#endif
+  use binary_output_mod
+
+  implicit none
+
+  integer,intent(in) ::     &
+    itime                     ! time index
+  integer,intent(inout) ::  &
+    loutstart,loutend,      & ! concentration calculation starting and ending time
+    loutnext
+  real,intent(inout) ::     &
+    outnum                    ! concentration calculation sample number
+  real(sp) ::               &
+    gridtotalunc              ! concentration calculation related
+  real(dep_prec) ::         &
+    wetgridtotalunc,        & ! concentration calculation related
+    drygridtotalunc           ! concentration calculation related
+  real ::                   &
+    weight                    ! concentration calculation sample weight
+
+
+  ! Is the time within the computation interval, if not, return
+  !************************************************************
+  if ((ldirect*itime.lt.ldirect*loutstart).or.(ldirect*itime.gt.ldirect*loutend)) then
+    return
+  endif
+
+  ! If we are exactly at the start or end of the concentration averaging interval,
+  ! give only half the weight to this sample
+  !*****************************************************************************
+  if (mod(itime-loutstart,loutsample).eq.0) then
+    if ((itime.eq.loutstart).or.(itime.eq.loutend)) then
+      weight=0.5
+    else
+      weight=1.0
+    endif
+    outnum=outnum+weight
+    if (iout.ne.0) call conccalc(itime,weight)
+  endif
+
+  ! If no grid is to be written to file, return (LB)
+  !*************************************************
+  if (iout.eq.0) then
+    if (itime.ne.loutend) return
+    loutnext=loutnext+loutstep
+    loutstart=loutnext-loutaver/2
+    loutend=loutnext+loutaver/2
+    if (itime.eq.loutstart) then
+      weight=0.5
+      outnum=outnum+weight
+    endif
+    return
+  endif
+
+  ! If it is not time yet to write outputs, return
+  !***********************************************
+  if ((itime.ne.loutend).or.(outnum.le.0)) then
+    return
+  endif
+
+  ! Output and reinitialization of grid
+  ! If necessary, first sample of new grid is also taken
+  !*****************************************************
+  if ((iout.le.3.).or.(iout.eq.5)) then
+    if (surf_only.ne.1) then
+#ifdef USE_NCF
+      call concoutput_ncf(itime,outnum,gridtotalunc,wetgridtotalunc,drygridtotalunc)
+#else
+      call concoutput(itime,outnum,gridtotalunc,wetgridtotalunc,drygridtotalunc)
+#endif
+    else
+#ifdef USE_NCF
+      call concoutput_sfc_ncf(itime,outnum,gridtotalunc,wetgridtotalunc,drygridtotalunc)
+#else
+      if (linversionout.eq.1) then
+        call concoutput_inv(itime,outnum,gridtotalunc,wetgridtotalunc,drygridtotalunc)
+      else
+        call concoutput_sfc(itime,outnum,gridtotalunc,wetgridtotalunc,drygridtotalunc)
+      endif
+#endif
+    endif
+
+    if (nested_output .eq. 1) then
+#ifdef USE_NCF
+      if (surf_only.ne.1) then
+        call concoutput_ncf_nest(itime,outnum)
+      else
+        call concoutput_sfc_ncf_nest(itime,outnum)
+      endif
+#else
+      if (surf_only.ne.1) then
+        call concoutput_nest(itime,outnum)
+      else
+        if(linversionout.eq.1) then
+          call concoutput_inv_nest(itime,outnum)
+        else
+          call concoutput_sfc_nest(itime,outnum)
+        endif
+      endif
+#endif
+    endif
+    outnum=0.
+  endif
+
+  write(*,45) itime,numpart,gridtotalunc,wetgridtotalunc,drygridtotalunc
+
+45      format(i13,' Seconds simulated: ',i13, ' Particles:    Uncertainty: ',3f7.3)
+
+  loutnext=loutnext+loutstep
+  loutstart=loutnext-loutaver/2
+  loutend=loutnext+loutaver/2
+  if (itime.eq.loutstart) then
+    weight=0.5
+    outnum=outnum+weight
+    call conccalc(itime,weight)
+  endif
+end subroutine output_conc
diff --git a/src/out_output_heightlevs.f90 b/src/out_output_heightlevs.f90
new file mode 100644
index 0000000000000000000000000000000000000000..afb9e7e80adde3e40188b84a8b7d635e67c5b0a1
--- /dev/null
+++ b/src/out_output_heightlevs.f90
@@ -0,0 +1,25 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine output_heightlevs(height_tmp,nmixz_tmp)
+  implicit none
+
+  real,intent(in) :: height_tmp(nzmax)
+  integer,intent(in) :: nmixz_tmp
+  integer :: kz
+  character(len=256) :: heightlevels_filename
+
+  heightlevels_filename = path(2)(1:length(2))//'heightlevels.bin'
+
+  write(*,*) 'Writing initialised heightlevels to file', &
+    trim(heightlevels_filename)
+
+  open(unitheightlevels,file=trim(heightlevels_filename),form='unformatted')
+
+  write(unitheightlevels) nmixz_tmp
+
+  do kz=1,nz
+    write(unitheightlevels) height_tmp(kz)
+  end do
+  close(unitheightlevels)
+end subroutine output_heightlevs
diff --git a/src/out_output_particle.f90 b/src/out_output_particle.f90
new file mode 100644
index 0000000000000000000000000000000000000000..94c360d068ed56b33885461e8ee02c3ea8ee4c0f
--- /dev/null
+++ b/src/out_output_particle.f90
@@ -0,0 +1,314 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine output_particle(itime,initial_output)
+  !                        i
+  !*****************************************************************************
+  !                                                                            *
+  !     Dump all particle positions                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     12 March 1999                                                          *
+  !                                                                            *
+  !     Changes L. Bakels, 2021                                                *
+  !     Output is chosen by the fields set in PARTOPTIONS                      *
+  !     Binary output is no longer supported. If required, function can be     *
+  !     added below at "Put binary function here"                              *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  !*****************************************************************************
+
+  use interpol_mod
+  use coord_ec_mod
+  use particle_mod
+#ifdef USE_NCF
+  use netcdf
+!  use netcdf_output_mod, only: partoutput_ncf,open_partoutput_file, &
+!                               close_partoutput_file,partinitpointer1
+  use omp_lib, only: OMP_GET_THREAD_NUM
+#endif
+
+  implicit none
+
+  integer,intent(in) :: itime
+  logical,optional,intent(in) :: initial_output
+  logical :: init_out
+  integer :: i,j,m,jjjjmmdd,ihmmss,np,ns,i_av
+  real(kind=dp) :: jul
+  real :: tmp(2)
+  character :: adate*8,atime*6
+
+  real :: xlon(numpart),ylat(numpart),ztemp1,ztemp2,val_av(numpart,2),z_av(numpart)
+  real :: tti(numpart),rhoi(numpart),pvi(numpart),qvi(numpart),pri(numpart)
+  real :: topo(numpart),hmixi(numpart),tri(numpart),ztemp(numpart)
+  real :: masstemp(numpart,nspec),masstemp_av(numpart,nspec)
+  real :: wetdepotemp(numpart,nspec),drydepotemp(numpart,nspec)
+
+  real :: output(num_partopt, numpart)
+
+  ! For averaged output
+  real :: xlon_av(numpart),ylat_av(numpart)
+
+  real :: cartxyz(3)
+  logical :: cartxyz_comp
+
+#ifdef USE_NCF
+  integer  :: ncid, mythread, thread_divide(12),mass_divide(nspec)
+#else
+  write(*,*) 'NETCDF missing! Please compile with netcdf if you want the particle dump.'
+  stop
+#endif
+
+#ifdef USE_NCF
+  if (present(initial_output)) then
+    init_out=initial_output
+  else
+    init_out=.false.
+  endif
+
+!$OMP PARALLEL PRIVATE(i,j,m,tmp,ns,i_av,cartxyz_comp,cartxyz,np)
+  ! Some variables needed for temporal interpolation
+  !*************************************************
+  call find_time_vars(itime)
+
+!$OMP DO
+  do i=1,numpart
+    if (((.not. part(i)%alive).and.(abs(part(i)%tend-itime).ge.ipoutfac*loutstep)) .or. &
+      (init_out .and. (i.lt.partinitpointer1-1))) then ! Only freshly spawned particles need to be computed for init_out
+      output(:,i) = -1
+      masstemp(i,:) = -1
+      masstemp_av(i,:) = -1
+      wetdepotemp(i,:) = -1
+      drydepotemp(i,:) = -1
+      cycle
+    endif
+    !*****************************************************************************
+    ! Interpolate several variables (PV, specific humidity, etc.) to particle position
+    !*****************************************************************************
+    ! Where in the grid? Stereographic (ngrid<0) or nested (ngrid>0)
+    !***************************************************************
+    call find_ngrid(real(part(i)%xlon),real(part(i)%ylat))
+    call find_grid_indices(real(part(i)%xlon),real(part(i)%ylat))
+    call find_grid_distances(real(part(i)%xlon),real(part(i)%ylat))
+    ! First set dz1out from interpol_mod to -1 so it only is calculated once per particle
+    !************************************************************************************
+    dz1out=-1
+    cartxyz_comp=.false.
+    do np=1,num_partopt
+      if (.not. partopt(np)%print) cycle ! Only compute when field should be printed
+      i_av = partopt(np)%i_average
+      if (init_out.and.(i_av.ne.0)) cycle ! no averages for initial particle output
+      if ((i_av.ne.0).and.(part(i)%ntime.eq.0)) then
+        if (partopt(np)%name.eq.'ma') then
+          masstemp_av(i,1:nspec) = -1
+        else
+          output(np,i) = -1
+        endif
+        cycle ! no averages for freshly spawned particles
+      endif
+      select case (partopt(np)%name)
+        case ('LO')
+          output(np,i)=xlon0+part(i)%xlon*dx
+          cycle
+        case ('LA')
+          output(np,i)=ylat0+part(i)%ylat*dy
+          cycle
+        case ('TO') ! Topography
+          if (ngrid.le.0) then
+            call hor_interpol(oro,output(np,i))
+          else
+            call hor_interpol_nest(oron,output(np,i))
+          endif
+          cycle
+        case ('TR') ! Tropopause
+          if (ngrid.le.0) then
+            do m=1,2
+              call hor_interpol(tropopause,tmp(m),1,memind(m),1)
+            end do
+          else
+            do m=1,2
+              call hor_interpol_nest(tropopausen,tmp(m),1,memind(m),1)
+            end do
+          endif
+          call temp_interpol(tmp(1),tmp(2),output(np,i))
+          cycle
+        case ('HM') ! PBL height
+          if (ngrid.le.0) then
+            do m=1,2
+              call hor_interpol(hmix,tmp(m),1,memind(m),1)
+            end do
+          else
+            do m=1,2
+              call hor_interpol_nest(hmixn,tmp(m),1,memind(m),1)
+            end do
+          endif
+          call temp_interpol(tmp(1),tmp(2),output(np,i))
+          cycle
+        case ('ZZ') ! Height
+          call update_zeta_to_z(itime, i) ! Convert eta z coordinate to meters if necessary
+          output(np,i)=part(i)%z
+          cycle
+        ! case ('UU') ! Longitudinal velocity
+        !   output(np,i)=part(i)%vel%u !This would be preferred, but not implemented yet
+        !   cycle
+        case ('VS') ! Settling velocity
+          output(np,i)=part(i)%settling
+          cycle
+        case ('MA') ! Mass
+          do ns=1,nspec
+            masstemp(i,ns)=part(i)%mass(ns)
+          end do
+          cycle
+        case ('ma') ! Mass averaged
+          do ns=1,nspec
+            masstemp_av(i,ns)=part(i)%val_av(i_av+(ns-1))/part(i)%ntime
+          end do
+          cycle
+        case ('WD') ! Wet deposition
+          do ns=1,nspec
+            wetdepotemp(i,ns)=part(i)%wetdepo(ns)
+          end do
+          cycle
+        case ('DD') ! dry deposition
+          do ns=1,nspec
+            drydepotemp(i,ns)=part(i)%drydepo(ns)
+          end do
+          cycle
+        case ('lo')
+          if (.not. cartxyz_comp) then
+            cartxyz(1) = part(i)%cartx_av/part(i)%ntime
+            cartxyz(2) = part(i)%carty_av/part(i)%ntime
+            cartxyz(3) = part(i)%cartz_av/part(i)%ntime
+            cartxyz_comp=.true.
+          endif
+          output(np,i) = atan2(cartxyz(1),-1.*cartxyz(2))/pi180
+          if (output(np,i).gt.360.) output(np,i)=output(np,i)-360.
+          if (output(np,i).lt.0.) output(np,i)=output(np,i)+360.
+          cycle
+        case ('la')
+          if (.not. cartxyz_comp) then
+            cartxyz(1) = part(i)%cartx_av/part(i)%ntime
+            cartxyz(2) = part(i)%carty_av/part(i)%ntime
+            cartxyz(3) = part(i)%cartz_av/part(i)%ntime
+            cartxyz_comp=.true.
+          endif
+          output(np,i) = atan2(cartxyz(3),sqrt(cartxyz(1)*cartxyz(1)+ &
+            cartxyz(2)*cartxyz(2)))/pi180
+        case default
+          if (.not. partopt(np)%average) then
+            call interpol_partoutput_val(partopt(np)%name,output(np,i),i)
+          else
+            output(np,i) = part(i)%val_av(i_av)/part(i)%ntime
+          endif
+      end select
+    end do
+    ! Reset dz1out
+    !*************
+    dz1out=-1
+    cartxyz_comp=.false.
+
+    if ((.not. init_out).and.(n_average.gt.0)) then
+      part(i)%val_av = 0.
+      part(i)%ntime = 0.
+      part(i)%cartx_av = 0.
+      part(i)%carty_av = 0.
+      part(i)%cartz_av = 0.
+    endif
+  end do
+
+!$OMP END DO
+!$OMP END PARALLEL
+
+  if ((.not. init_out).and.(numpart.gt.0)) then
+    do np=1,num_partopt
+      if (.not. partopt(np)%print) cycle
+      if (partopt(np)%name.eq.'MA') then
+        write(*,*) partopt(np)%long_name, masstemp(1,:)
+      else if (partopt(np)%name.eq.'ma') then
+        write(*,*) partopt(np)%long_name, masstemp_av(1,:)
+      else if (partopt(np)%name.eq.'WD') then
+        write(*,*) partopt(np)%long_name, wetdepotemp(1,:)
+      else if (partopt(np)%name.eq.'DD') then
+        write(*,*) partopt(np)%long_name, drydepotemp(1,:)
+      else
+        write(*,*) partopt(np)%long_name, output(np,1)
+      endif
+    end do
+    write(*,*) part(1)%prob,part(1)%alive
+    write(*,*) 'Alive: ', count%alive, 'Total spawned: ', count%spawned, 'Terminated: ', count%terminated
+  endif
+
+  ! Determine current calendar date, needed for the file name
+  !**********************************************************
+
+  jul=bdate+real(itime,kind=dp)/86400._dp
+  call caldate(jul,jjjjmmdd,ihmmss)
+  write(adate,'(i8.8)') jjjjmmdd
+  write(atime,'(i6.6)') ihmmss
+  j=1
+  if (lnetcdfout.eq.1) then
+  ! open output file
+    if (init_out) then
+      call open_partinit_file(ncid)
+    else
+      call open_partoutput_file(ncid)
+
+      ! First allocate the time and particle dimensions within the netcdf file
+      call partoutput_ncf(itime,xlon,'TI',j,ncid)
+      call partoutput_ncf(itime,xlon,'PA',j,ncid)
+    endif
+
+    ! Fill the fields in parallel
+    if (numpart.gt.0) then
+!$OMP PARALLEL PRIVATE(np,ns)
+!$OMP DO SCHEDULE(dynamic)
+      do np=1,num_partopt
+        !write(*,*) partopt(np)%name, output(np,1)
+        if (.not. partopt(np)%print) cycle
+        if (init_out.and.(partopt(np)%i_average.ne.0)) cycle ! no averages for initial particle output
+        !write(*,*) partopt(np)%name
+        if (partopt(np)%name.eq.'MA') then
+          do ns=1,nspec
+            if (init_out) then
+              call partinit_ncf(itime,masstemp(:,ns),'MA',ns,ncid)
+            else
+              call partoutput_ncf(itime,masstemp(:,ns),'MA',ns,ncid)
+            endif
+          end do
+        else if (partopt(np)%name.eq.'ma') then
+          do ns=1,nspec
+            call partoutput_ncf(itime,masstemp_av(:,ns),'ma',ns,ncid)
+          end do
+        else if ((.not. init_out).and.(partopt(np)%name.eq.'WD')) then
+          do ns=1,nspec
+            call partoutput_ncf(itime,wetdepotemp(:,ns),'WD',ns,ncid)
+          end do
+        else if ((.not. init_out).and.(partopt(np)%name.eq.'DD')) then
+          do ns=1,nspec
+            call partoutput_ncf(itime,drydepotemp(:,ns),'DD',ns,ncid)
+          end do
+        else
+          if (init_out) then
+            call partinit_ncf(itime,output(np,:),partopt(np)%name,j,ncid)
+          else
+            call partoutput_ncf(itime,output(np,:),partopt(np)%name,j,ncid)
+          endif
+        endif
+      end do
+!$OMP END DO
+!$OMP END PARALLEL
+    endif
+    call close_partoutput_file(ncid)
+    if (.not. init_out) then
+      mass_written=.true. ! needs to be reduced within openmp loop
+      topo_written=.true. ! same
+    endif
+  else
+    ! Put binary function here
+  endif
+#else
+    ! Put binary function here
+#endif
+end subroutine output_particle
diff --git a/src/out_output_restart.f90 b/src/out_output_restart.f90
new file mode 100644
index 0000000000000000000000000000000000000000..357e4186476f5a8288763869a846ad5d00ff0797
--- /dev/null
+++ b/src/out_output_restart.f90
@@ -0,0 +1,105 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine output_restart(itime,loutnext,outnum)
+  use particle_mod
+  use coord_ec_mod
+  use unc_mod
+
+  implicit none
+
+  integer, intent(in) :: itime,loutnext
+  real, intent(in) :: outnum
+  integer :: i,j,jjjjmmdd,ihmmss,stat
+  integer :: ks,kp,kz,nage,jy,ix,l
+  real(kind=dp) :: jul
+  character :: adate*8,atime*6
+
+
+  jul=bdate+real(itime,kind=dp)/86400._dp
+  call caldate(jul,jjjjmmdd,ihmmss)
+  write(adate,'(i8.8)') jjjjmmdd
+  write(atime,'(i6.6)') ihmmss
+
+  restart_filename3 = restart_filename2
+  restart_filename2 = restart_filename1
+  restart_filename1 = path(2)(1:length(2))//'restart_'//adate//atime
+
+  write(*,*) 'Writing Restart file:', trim(restart_filename1)
+
+  open(unitrestart,file=restart_filename1,form='unformatted')
+
+  ! Write current time to file
+  !***************************
+
+  write(unitrestart) itime
+  write(unitrestart) count%allocated
+  write(unitrestart) loutnext
+  write(unitrestart) outnum
+
+  do i=1,count%allocated
+    if (part(i)%alive) then
+      call update_zeta_to_z(itime,i)
+      call update_z_to_zeta(itime,i)
+    endif
+    write(unitrestart) part(i)%xlon,part(i)%ylat,part(i)%z,part(i)%zeta, &
+      part(i)%npoint,part(i)%nclass,part(i)%idt,part(i)%tend, &
+      part(i)%tstart,part(i)%alive,part(i)%turbvel%u, &
+      part(i)%turbvel%v,part(i)%turbvel%w,part(i)%mesovel%u, &
+      part(i)%mesovel%v,part(i)%mesovel%w,(part(i)%mass(j),j=1,nspec), &
+      (part(i)%mass_init(j),j=1,nspec),(part(i)%wetdepo(j),j=1,nspec), &
+      (part(i)%drydepo(j),j=1,nspec)
+  end do
+  if (iout.gt.0) then
+#ifdef USE_NCF
+    write(unitrestart) tpointer
+#endif
+    do ks=1,nspec
+      do kp=1,maxpointspec_act
+        do nage=1,nageclass
+          do jy=0,numygrid-1
+            do ix=0,numxgrid-1
+              do l=1,nclassunc
+                do kz=1,numzgrid
+                  write(unitrestart) gridunc(ix,jy,kz,ks,kp,l,nage)
+                end do
+                if ((wetdep).and.(ldirect.gt.0)) then
+                  write(unitrestart) wetgridunc(ix,jy,ks,kp,l,nage)
+                endif
+                if ((drydep).and.(ldirect.gt.0)) then
+                  write(unitrestart) drygridunc(ix,jy,ks,kp,l,nage)
+                endif
+              end do
+            end do
+          end do
+          if (nested_output.eq.1) then
+            do jy=0,numygridn-1
+              do ix=0,numxgridn-1
+                do l=1,nclassunc
+                  do kz=1,numzgrid
+                    write(unitrestart) griduncn(ix,jy,kz,ks,kp,l,nage)
+                  end do
+                  if ((wetdep).and.(ldirect.gt.0)) then
+                    write(unitrestart) wetgriduncn(ix,jy,ks,kp,l,nage)
+                  endif
+                  if ((drydep).and.(ldirect.gt.0)) then
+                    write(unitrestart) drygriduncn(ix,jy,ks,kp,l,nage)
+                  endif
+                end do
+              end do
+            end do
+          endif
+        end do
+      end do
+      if ((drybkdep).or.(wetbkdep)) then
+        do i=1,count%allocated
+          write(unitrestart) xscav_frac1(i,ks)
+        end do
+      endif
+    end do
+  endif
+  close(unitrestart)
+
+  open(unit=1234, iostat=stat, file=restart_filename3, status='old')
+  if(stat == 0) close(1234, status='delete')
+end subroutine output_restart
diff --git a/src/out_partpos_avg.f90 b/src/out_partpos_avg.f90
new file mode 100644
index 0000000000000000000000000000000000000000..d9f1feba0ac27ecb850a68538e7c29e16827182c
--- /dev/null
+++ b/src/out_partpos_avg.f90
@@ -0,0 +1,149 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine partpos_avg(itime,j)
+
+  !**********************************************************************
+  ! This subroutine averages particle quantities, to be used for particle
+  ! dump (in partoutput.f90). Averaging is done over output interval.
+  ! Author: A. Stohl
+  ! Changes L Bakels:
+  !    - Computing fields defined in PARTOPTIONS
+  !**********************************************************************
+
+  use par_mod
+  use com_mod
+  use interpol_mod
+  use coord_ec_mod
+
+  implicit none
+
+  integer,intent(in) :: itime,j
+  integer :: np,i_av,ns,m
+  real :: xlon,ylat,x,y,z
+  real :: topo,hm(2),hmixi,pvi,qvi
+  real :: tti,rhoi,ttemp
+  real :: uui,vvi,output
+  real :: tr(2),tri!,energy
+
+  logical :: cart_comp
+
+  if (ipout.eq.0) return ! No need to compute averages since there is no particle output
+
+  if (n_average.eq.0) return
+
+  if (.not. part(j)%alive) return
+
+  if (part(j)%nstop) return ! If particle is to be killed, averages cannot be computed
+
+ ! Some variables needed for temporal interpolation
+  !*************************************************
+  call find_time_vars(itime)
+
+  xlon=xlon0+real(part(j)%xlon)*dx
+  ylat=ylat0+real(part(j)%ylat)*dy
+
+  !*****************************************************************************
+  ! Interpolate several variables (PV, specific humidity, etc.) to particle position
+  !*****************************************************************************
+  ! Where in the grid? Stereographic (ngrid<0) or nested (ngrid>0)
+  !***************************************************************
+  call find_ngrid(real(part(j)%xlon),real(part(j)%ylat))
+  call find_grid_indices(real(part(j)%xlon),real(part(j)%ylat))
+  call find_grid_distances(real(part(j)%xlon),real(part(j)%ylat))
+
+  ! First set dz1out from interpol_mod to -1 so it only is calculated once per particle
+  !************************************************************************************
+  part(j)%ntime=part(j)%ntime + 1
+  dz1out=-1
+  cart_comp=.false.
+  do np=1,num_partopt
+    if ((.not. partopt(np)%print) .or. (.not. partopt(np)%average)) cycle
+    i_av = partopt(np)%i_average
+    select case (partopt(np)%name)
+      case ('to')
+        if (ngrid.le.0) then
+          call hor_interpol(oro,output)
+        else
+          call hor_interpol_nest(oron,output)
+        endif
+        part(j)%val_av(i_av)=part(j)%val_av(i_av)+output
+      case ('tr')
+        if (ngrid.le.0) then
+          do m=1,2
+            call hor_interpol(tropopause,tr(m),1,memind(m),1)
+          end do
+        else
+          do m=1,2
+            call hor_interpol_nest(tropopausen,tr(m),1,memind(m),1)
+          end do
+        endif
+        call temp_interpol(tr(1),tr(2),output)
+        part(j)%val_av(i_av)=part(j)%val_av(i_av)+output
+      case ('hm')
+        if (ngrid.le.0) then
+          do m=1,2
+            call hor_interpol(hmix,hm(m),1,memind(m),1)
+          end do
+        else
+          do m=1,2
+            call hor_interpol_nest(hmixn,hm(m),1,memind(m),1)
+          end do
+        endif
+        call temp_interpol(hm(1),hm(2),output)
+        part(j)%val_av(i_av)=part(j)%val_av(i_av)+output
+      case ('lo')
+        if (.not. cart_comp) then
+          ! Calculate Cartesian 3D coordinates suitable for averaging
+          !**********************************************************
+
+          xlon=xlon*pi180
+          ylat=ylat*pi180
+          x = cos(ylat)*sin(xlon)
+          y = -1.*cos(ylat)*cos(xlon)
+          z = sin(ylat)
+
+          part(j)%cartx_av=part(j)%cartx_av+x
+          part(j)%carty_av=part(j)%carty_av+y
+          part(j)%cartz_av=part(j)%cartz_av+z
+          cart_comp=.true.
+        endif
+      case ('la')
+        if (.not. cart_comp) then
+          ! Calculate Cartesian 3D coordinates suitable for averaging
+          !**********************************************************
+
+          xlon=xlon*pi180
+          ylat=ylat*pi180
+          x = cos(ylat)*sin(xlon)
+          y = -1.*cos(ylat)*cos(xlon)
+          z = sin(ylat)
+
+          part(j)%cartx_av=part(j)%cartx_av+x
+          part(j)%carty_av=part(j)%carty_av+y
+          part(j)%cartz_av=part(j)%cartz_av+z
+          cart_comp=.true.
+        endif
+      case ('zz')
+        ! Convert eta z coordinate to meters if necessary. Can be moved to output only
+        !************************************************
+        call update_zeta_to_z(itime,j)
+        part(j)%val_av(i_av)=part(j)%val_av(i_av)+part(j)%z
+      case ('ma')
+        do ns=1,nspec
+          part(j)%val_av(i_av+(ns-1))=part(j)%val_av(i_av+(ns-1))+part(j)%mass(ns)
+        end do
+      case ('vs')
+        part(j)%val_av(i_av)=part(j)%val_av(i_av)+part(j)%settling
+      case default
+        call interpol_partoutput_val(partopt(np)%name,output,j)
+        part(j)%val_av(i_av)=part(j)%val_av(i_av)+output
+    end select
+  end do
+  ! Reset dz1out
+  !*************
+  dz1out=-1
+  cart_comp=.false.
+
+  return
+end subroutine partpos_avg
diff --git a/src/output_mod.f90 b/src/output_mod.f90
index 3abcdd29ac7b2765ee796b7afcd916c6898c1603..7555406a20edf4068c692c684f85d75182fc4b5e 100644
--- a/src/output_mod.f90
+++ b/src/output_mod.f90
@@ -8,11 +8,11 @@
 !*****************************************************************************
 
 module output_mod
-  
+
   use com_mod
   use par_mod
   use date_mod
-#ifdef USE_NCF  
+#ifdef USE_NCF
   use netcdf_output_mod
 #endif
   use binary_output_mod
@@ -23,1473 +23,20 @@ module output_mod
   character(len=256) :: restart_filename1,restart_filename2,restart_filename3
 contains
 
-subroutine init_output(itime,filesize)
-
-  implicit none
-  
-  integer, intent(in) :: itime
-  real, intent(inout) :: filesize
-#ifdef USE_NCF
-  real(kind=dp) ::          &
-    jul
-  integer ::                &
-    jjjjmmdd,ihmmss,i
-#endif
-
-  ! Writing header information to either binary or NetCDF format
-  if (itime.eq.itime_init) then
-    if (iout.ne.0) then ! No gridded output
-#ifdef USE_NCF
-      if (lnetcdfout.eq.1) then 
-        call writeheader_ncf(lnest=.false.)
-      else 
-        call writeheader_bin
-      end if
-
-      if (nested_output.eq.1) then
-        if (lnetcdfout.eq.1) then
-          call writeheader_ncf(lnest=.true.)
-        else if ((nested_output.eq.1).and.(surf_only.ne.1)) then
-          call writeheader_bin_nest
-        else if ((nested_output.eq.1).and.(surf_only.eq.1)) then
-          call writeheader_bin_sfc_nest
-        else if ((nested_output.ne.1).and.(surf_only.eq.1)) then 
-          call writeheader_bin_sfc
-        endif
-      endif
-#else
-      call writeheader_bin
-
-      !if (nested_output.eq.1) call writeheader_nest
-      if ((nested_output.eq.1).and.(surf_only.ne.1)) call writeheader_bin_nest
-      if ((nested_output.eq.1).and.(surf_only.eq.1)) call writeheader_bin_sfc_nest
-      if ((nested_output.ne.1).and.(surf_only.eq.1)) call writeheader_bin_sfc
-#endif
-    endif ! iout.ne.0
-    ! FLEXPART 9.2 ticket ?? write header in ASCII format 
-    call writeheader_txt
-
-    ! NetCDF only: Create file for storing initial particle positions.
-#ifdef USE_NCF
-    if (itime_init.ne.0) then
-      jul=bdate+real(itime,kind=dp)/86400._dp
-      call caldate(jul,jjjjmmdd,ihmmss)      
-    endif
-    if ((mdomainfill.eq.0).and.(ipout.ge.1).and.(ipin.le.1)) then
-      if (itime_init.ne.0) then
-        if (ldirect.eq.1) then
-          call particle_initialpos(ihmmss,jjjjmmdd,ibtime,ibdate)
-        else
-          call particle_initialpos(ihmmss,jjjjmmdd,ietime,iedate)
-        endif
-      else if (ldirect.eq.1) then
-        call particle_initialpos(ibtime,ibdate,ibtime,ibdate)
-      else
-        call particle_initialpos(ietime,iedate,ietime,iedate)
-      endif
-    endif
-    ! Create header files for files that store the particle dump output
-    if (ipout.ge.1) then
-      if (itime_init.ne.0) then
-        if (ldirect.eq.1) then
-          call writeheader_partoutput(ihmmss,jjjjmmdd,ibtime,ibdate)
-        else
-          call writeheader_partoutput(ihmmss,jjjjmmdd,ietime,iedate)
-        endif
-      else if (ldirect.eq.1) then
-        call writeheader_partoutput(ibtime,ibdate,ibtime,ibdate)
-      else 
-        call writeheader_partoutput(ietime,iedate,ietime,iedate)
-      endif
-    endif
-#endif
-  
-  ! In case the particle output file is becoming larger than the maximum set
-  ! in par_mod, create a new one while keeping track of the filesize.
-  ! Also if a new restart file is created.
-  else if ((mod(itime,ipoutfac*loutstep).eq.0).and.(ipout.ge.1)) then
-#ifdef USE_NCF
-    if ((filesize.ge.max_partoutput_filesize).or.(mod(itime,loutrestart).eq.0)) then 
-      jul=bdate+real(itime,kind=dp)/86400._dp
-      call caldate(jul,jjjjmmdd,ihmmss)
-      if (ldirect.eq.1) then 
-        call writeheader_partoutput(ihmmss,jjjjmmdd,ibtime,ibdate)
-      else 
-        call writeheader_partoutput(ihmmss,jjjjmmdd,ietime,iedate)
-      endif
-      filesize = 0.
-    endif
-    do i=1,numpoint
-      filesize = filesize + npart(i)*13.*4./1000000.
-    end do
-#endif
-  endif
-end subroutine init_output
-
-subroutine finalise_output(itime)
-  ! Complete the calculation of initial conditions for particles not yet terminated
-  
-  implicit none 
-
-  integer, intent(in) :: itime
-  integer :: j,ithread
-
-  if (linit_cond.ge.1) then
-    do j=1,numpart
-      call initcond_calc(itime,j,1)
-    end do
-#ifdef _OPENMP
-    do ithread=1,numthreads
-      init_cond(:,:,:,:,:)=init_cond(:,:,:,:,:)+init_cond_omp(:,:,:,:,:,ithread)
-    end do
-#endif
-  endif
-
-
-  if (ipout.eq.2) call output_particle(itime)!,active_per_rel)     ! dump particle positions
-
-  if (linit_cond.ge.1) then
-    if(linversionout.eq.1) then
-      call initcond_output_inv(itime)   ! dump initial cond. field
-    else
-      call initcond_output(itime)   ! dump initial cond. fielf
-    endif
-  endif
-end subroutine finalise_output
-
-subroutine output_restart(itime,loutnext,outnum)
-  use particle_mod
-  use coord_ec_mod
-  use unc_mod
-
-  implicit none
-
-  integer, intent(in) :: itime,loutnext
-  real, intent(in) :: outnum
-  integer :: i,j,jjjjmmdd,ihmmss,stat
-  integer :: ks,kp,kz,nage,jy,ix,l
-  real(kind=dp) :: jul
-  character :: adate*8,atime*6
-
-
-  jul=bdate+real(itime,kind=dp)/86400._dp
-  call caldate(jul,jjjjmmdd,ihmmss)
-  write(adate,'(i8.8)') jjjjmmdd
-  write(atime,'(i6.6)') ihmmss
-
-  restart_filename3 = restart_filename2
-  restart_filename2 = restart_filename1
-  restart_filename1 = path(2)(1:length(2))//'restart_'//adate//atime
-
-  write(*,*) 'Writing Restart file:', trim(restart_filename1)
-
-  open(unitrestart,file=restart_filename1,form='unformatted')
-
-  ! Write current time to file
-  !***************************
-
-  write(unitrestart) itime
-  write(unitrestart) count%allocated
-  write(unitrestart) loutnext
-  write(unitrestart) outnum
-
-  do i=1,count%allocated
-    if (part(i)%alive) then
-      call update_zeta_to_z(itime,i)
-      call update_z_to_zeta(itime,i)
-    endif
-    write(unitrestart) part(i)%xlon,part(i)%ylat,part(i)%z,part(i)%zeta, &
-      part(i)%npoint,part(i)%nclass,part(i)%idt,part(i)%tend, &
-      part(i)%tstart,part(i)%alive,part(i)%turbvel%u, &
-      part(i)%turbvel%v,part(i)%turbvel%w,part(i)%mesovel%u, &
-      part(i)%mesovel%v,part(i)%mesovel%w,(part(i)%mass(j),j=1,nspec), &
-      (part(i)%mass_init(j),j=1,nspec),(part(i)%wetdepo(j),j=1,nspec), &
-      (part(i)%drydepo(j),j=1,nspec)
-  end do
-  if (iout.gt.0) then
-#ifdef USE_NCF
-    write(unitrestart) tpointer
-#endif
-    do ks=1,nspec
-      do kp=1,maxpointspec_act
-        do nage=1,nageclass
-          do jy=0,numygrid-1
-            do ix=0,numxgrid-1
-              do l=1,nclassunc
-                do kz=1,numzgrid
-                  write(unitrestart) gridunc(ix,jy,kz,ks,kp,l,nage)
-                end do
-                if ((wetdep).and.(ldirect.gt.0)) then
-                  write(unitrestart) wetgridunc(ix,jy,ks,kp,l,nage)
-                endif
-                if ((drydep).and.(ldirect.gt.0)) then
-                  write(unitrestart) drygridunc(ix,jy,ks,kp,l,nage)
-                endif
-              end do
-            end do
-          end do
-          if (nested_output.eq.1) then
-            do jy=0,numygridn-1
-              do ix=0,numxgridn-1
-                do l=1,nclassunc
-                  do kz=1,numzgrid
-                    write(unitrestart) griduncn(ix,jy,kz,ks,kp,l,nage)
-                  end do
-                  if ((wetdep).and.(ldirect.gt.0)) then
-                    write(unitrestart) wetgriduncn(ix,jy,ks,kp,l,nage)
-                  endif
-                  if ((drydep).and.(ldirect.gt.0)) then
-                    write(unitrestart) drygriduncn(ix,jy,ks,kp,l,nage)
-                  endif
-                end do
-              end do
-            end do
-          endif
-        end do
-      end do
-      if ((drybkdep).or.(wetbkdep)) then
-        do i=1,count%allocated
-          write(unitrestart) xscav_frac1(i,ks)
-        end do
-      endif
-    end do
-  endif
-  close(unitrestart)
-
-  open(unit=1234, iostat=stat, file=restart_filename3, status='old')
-  if(stat == 0) close(1234, status='delete')
-end subroutine output_restart
-
-subroutine output_heightlevs(height_tmp,nmixz_tmp)
-  implicit none
-
-  real,intent(in) :: height_tmp(nzmax)
-  integer,intent(in) :: nmixz_tmp
-  integer :: kz
-  character(len=256) :: heightlevels_filename
-
-  heightlevels_filename = path(2)(1:length(2))//'heightlevels.bin'
-
-  write(*,*) 'Writing initialised heightlevels to file', &
-    trim(heightlevels_filename)
-  
-  open(unitheightlevels,file=trim(heightlevels_filename),form='unformatted')
-
-  write(unitheightlevels) nmixz_tmp
-
-  do kz=1,nz
-    write(unitheightlevels) height_tmp(kz)
-  end do
-  close(unitheightlevels)
-end subroutine output_heightlevs
-
-subroutine output_particle(itime,initial_output)
-  !                        i
-  !*****************************************************************************
-  !                                                                            *
-  !     Dump all particle positions                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     12 March 1999                                                          *
-  !                                                                            *
-  !     Changes L. Bakels, 2021                                                *
-  !     Output is chosen by the fields set in PARTOPTIONS                      *
-  !     Binary output is no longer supported. If required, function can be     *
-  !     added below at "Put binary function here"                              *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  !                                                                            *
-  !*****************************************************************************
-
-  use interpol_mod
-  use coord_ec_mod
-  use particle_mod
-#ifdef USE_NCF
-  use netcdf
-!  use netcdf_output_mod, only: partoutput_ncf,open_partoutput_file, &
-!                               close_partoutput_file,partinitpointer1
-  use omp_lib, only: OMP_GET_THREAD_NUM
-#endif
-
-  implicit none
-
-  integer,intent(in) :: itime
-  logical,optional,intent(in) :: initial_output
-  logical :: init_out
-  integer :: i,j,m,jjjjmmdd,ihmmss,np,ns,i_av
-  real(kind=dp) :: jul
-  real :: tmp(2)
-  character :: adate*8,atime*6
-
-  real :: xlon(numpart),ylat(numpart),ztemp1,ztemp2,val_av(numpart,2),z_av(numpart)
-  real :: tti(numpart),rhoi(numpart),pvi(numpart),qvi(numpart),pri(numpart)
-  real :: topo(numpart),hmixi(numpart),tri(numpart),ztemp(numpart)
-  real :: masstemp(numpart,nspec),masstemp_av(numpart,nspec)
-  real :: wetdepotemp(numpart,nspec),drydepotemp(numpart,nspec)
-
-  real :: output(num_partopt, numpart)
-
-  ! For averaged output
-  real :: xlon_av(numpart),ylat_av(numpart)
-
-  real :: cartxyz(3)
-  logical :: cartxyz_comp
-
-#ifdef USE_NCF
-  integer  :: ncid, mythread, thread_divide(12),mass_divide(nspec)
-#else
-  write(*,*) 'NETCDF missing! Please compile with netcdf if you want the particle dump.'
-  stop
-#endif
-
-#ifdef USE_NCF
-  if (present(initial_output)) then
-    init_out=initial_output
-  else
-    init_out=.false.
-  endif
-
-!$OMP PARALLEL PRIVATE(i,j,m,tmp,ns,i_av,cartxyz_comp,cartxyz,np)
-  ! Some variables needed for temporal interpolation
-  !*************************************************
-  call find_time_vars(itime)
-
-!$OMP DO
-  do i=1,numpart
-    if (((.not. part(i)%alive).and.(abs(part(i)%tend-itime).ge.ipoutfac*loutstep)) .or. &
-      (init_out .and. (i.lt.partinitpointer1-1))) then ! Only freshly spawned particles need to be computed for init_out
-      output(:,i) = -1
-      masstemp(i,:) = -1
-      masstemp_av(i,:) = -1
-      wetdepotemp(i,:) = -1
-      drydepotemp(i,:) = -1
-      cycle
-    endif
-    !*****************************************************************************
-    ! Interpolate several variables (PV, specific humidity, etc.) to particle position
-    !*****************************************************************************
-    ! Where in the grid? Stereographic (ngrid<0) or nested (ngrid>0)
-    !***************************************************************
-    call find_ngrid(real(part(i)%xlon),real(part(i)%ylat))
-    call find_grid_indices(real(part(i)%xlon),real(part(i)%ylat))
-    call find_grid_distances(real(part(i)%xlon),real(part(i)%ylat))
-    ! First set dz1out from interpol_mod to -1 so it only is calculated once per particle
-    !************************************************************************************
-    dz1out=-1
-    cartxyz_comp=.false.
-    do np=1,num_partopt
-      if (.not. partopt(np)%print) cycle ! Only compute when field should be printed
-      i_av = partopt(np)%i_average
-      if (init_out.and.(i_av.ne.0)) cycle ! no averages for initial particle output
-      if ((i_av.ne.0).and.(part(i)%ntime.eq.0)) then
-        if (partopt(np)%name.eq.'ma') then
-          masstemp_av(i,1:nspec) = -1
-        else
-          output(np,i) = -1
-        endif
-        cycle ! no averages for freshly spawned particles
-      endif
-      select case (partopt(np)%name)
-        case ('LO')
-          output(np,i)=xlon0+part(i)%xlon*dx
-          cycle
-        case ('LA')
-          output(np,i)=ylat0+part(i)%ylat*dy
-          cycle
-        case ('TO') ! Topography
-          if (ngrid.le.0) then
-            call hor_interpol(oro,output(np,i))
-          else
-            call hor_interpol_nest(oron,output(np,i))
-          endif 
-          cycle
-        case ('TR') ! Tropopause
-          if (ngrid.le.0) then
-            do m=1,2
-              call hor_interpol(tropopause,tmp(m),1,memind(m),1)
-            end do
-          else
-            do m=1,2
-              call hor_interpol_nest(tropopausen,tmp(m),1,memind(m),1)
-            end do
-          endif
-          call temp_interpol(tmp(1),tmp(2),output(np,i))
-          cycle
-        case ('HM') ! PBL height
-          if (ngrid.le.0) then
-            do m=1,2
-              call hor_interpol(hmix,tmp(m),1,memind(m),1)
-            end do
-          else
-            do m=1,2
-              call hor_interpol_nest(hmixn,tmp(m),1,memind(m),1)
-            end do
-          endif
-          call temp_interpol(tmp(1),tmp(2),output(np,i))
-          cycle
-        case ('ZZ') ! Height
-          call update_zeta_to_z(itime, i) ! Convert eta z coordinate to meters if necessary
-          output(np,i)=part(i)%z
-          cycle
-        ! case ('UU') ! Longitudinal velocity
-        !   output(np,i)=part(i)%vel%u !This would be preferred, but not implemented yet
-        !   cycle
-        case ('VS') ! Settling velocity
-          output(np,i)=part(i)%settling
-          cycle
-        case ('MA') ! Mass
-          do ns=1,nspec
-            masstemp(i,ns)=part(i)%mass(ns)
-          end do
-          cycle
-        case ('ma') ! Mass averaged
-          do ns=1,nspec
-            masstemp_av(i,ns)=part(i)%val_av(i_av+(ns-1))/part(i)%ntime
-          end do
-          cycle
-        case ('WD') ! Wet deposition
-          do ns=1,nspec
-            wetdepotemp(i,ns)=part(i)%wetdepo(ns)
-          end do
-          cycle
-        case ('DD') ! dry deposition
-          do ns=1,nspec
-            drydepotemp(i,ns)=part(i)%drydepo(ns)
-          end do
-          cycle
-        case ('lo')
-          if (.not. cartxyz_comp) then
-            cartxyz(1) = part(i)%cartx_av/part(i)%ntime
-            cartxyz(2) = part(i)%carty_av/part(i)%ntime
-            cartxyz(3) = part(i)%cartz_av/part(i)%ntime
-            cartxyz_comp=.true.
-          endif
-          output(np,i) = atan2(cartxyz(1),-1.*cartxyz(2))/pi180
-          if (output(np,i).gt.360.) output(np,i)=output(np,i)-360.
-          if (output(np,i).lt.0.) output(np,i)=output(np,i)+360.
-          cycle
-        case ('la')
-          if (.not. cartxyz_comp) then
-            cartxyz(1) = part(i)%cartx_av/part(i)%ntime
-            cartxyz(2) = part(i)%carty_av/part(i)%ntime
-            cartxyz(3) = part(i)%cartz_av/part(i)%ntime
-            cartxyz_comp=.true.
-          endif
-          output(np,i) = atan2(cartxyz(3),sqrt(cartxyz(1)*cartxyz(1)+ &
-            cartxyz(2)*cartxyz(2)))/pi180
-        case default
-          if (.not. partopt(np)%average) then
-            call interpol_partoutput_val(partopt(np)%name,output(np,i),i)
-          else
-            output(np,i) = part(i)%val_av(i_av)/part(i)%ntime
-          endif
-      end select
-    end do
-    ! Reset dz1out
-    !*************
-    dz1out=-1
-    cartxyz_comp=.false.
-
-    if ((.not. init_out).and.(n_average.gt.0)) then
-      part(i)%val_av = 0.
-      part(i)%ntime = 0.
-      part(i)%cartx_av = 0.
-      part(i)%carty_av = 0.
-      part(i)%cartz_av = 0.
-    endif
-  end do
-
-!$OMP END DO
-!$OMP END PARALLEL
-
-  if ((.not. init_out).and.(numpart.gt.0)) then
-    do np=1,num_partopt
-      if (.not. partopt(np)%print) cycle
-      if (partopt(np)%name.eq.'MA') then
-        write(*,*) partopt(np)%long_name, masstemp(1,:)
-      else if (partopt(np)%name.eq.'ma') then
-        write(*,*) partopt(np)%long_name, masstemp_av(1,:)
-      else if (partopt(np)%name.eq.'WD') then
-        write(*,*) partopt(np)%long_name, wetdepotemp(1,:)
-      else if (partopt(np)%name.eq.'DD') then
-        write(*,*) partopt(np)%long_name, drydepotemp(1,:)
-      else
-        write(*,*) partopt(np)%long_name, output(np,1)
-      endif
-    end do
-    write(*,*) part(1)%prob,part(1)%alive
-    write(*,*) 'Alive: ', count%alive, 'Total spawned: ', count%spawned, 'Terminated: ', count%terminated
-  endif
-
-  ! Determine current calendar date, needed for the file name
-  !**********************************************************
-
-  jul=bdate+real(itime,kind=dp)/86400._dp
-  call caldate(jul,jjjjmmdd,ihmmss)
-  write(adate,'(i8.8)') jjjjmmdd
-  write(atime,'(i6.6)') ihmmss
-  j=1
-  if (lnetcdfout.eq.1) then
-  ! open output file
-    if (init_out) then
-      call open_partinit_file(ncid)
-    else
-      call open_partoutput_file(ncid)
-
-      ! First allocate the time and particle dimensions within the netcdf file
-      call partoutput_ncf(itime,xlon,'TI',j,ncid)
-      call partoutput_ncf(itime,xlon,'PA',j,ncid)
-    endif
-
-    ! Fill the fields in parallel
-    if (numpart.gt.0) then
-!$OMP PARALLEL PRIVATE(np,ns)
-!$OMP DO SCHEDULE(dynamic)
-      do np=1,num_partopt
-        !write(*,*) partopt(np)%name, output(np,1)
-        if (.not. partopt(np)%print) cycle
-        if (init_out.and.(partopt(np)%i_average.ne.0)) cycle ! no averages for initial particle output
-        !write(*,*) partopt(np)%name
-        if (partopt(np)%name.eq.'MA') then
-          do ns=1,nspec
-            if (init_out) then
-              call partinit_ncf(itime,masstemp(:,ns),'MA',ns,ncid)
-            else
-              call partoutput_ncf(itime,masstemp(:,ns),'MA',ns,ncid)
-            endif
-          end do
-        else if (partopt(np)%name.eq.'ma') then
-          do ns=1,nspec
-            call partoutput_ncf(itime,masstemp_av(:,ns),'ma',ns,ncid)
-          end do
-        else if ((.not. init_out).and.(partopt(np)%name.eq.'WD')) then
-          do ns=1,nspec
-            call partoutput_ncf(itime,wetdepotemp(:,ns),'WD',ns,ncid)
-          end do
-        else if ((.not. init_out).and.(partopt(np)%name.eq.'DD')) then
-          do ns=1,nspec
-            call partoutput_ncf(itime,drydepotemp(:,ns),'DD',ns,ncid)
-          end do
-        else
-          if (init_out) then
-            call partinit_ncf(itime,output(np,:),partopt(np)%name,j,ncid)
-          else
-            call partoutput_ncf(itime,output(np,:),partopt(np)%name,j,ncid)
-          endif
-        endif
-      end do
-!$OMP END DO
-!$OMP END PARALLEL
-    endif
-    call close_partoutput_file(ncid)
-    if (.not. init_out) then
-      mass_written=.true. ! needs to be reduced within openmp loop
-      topo_written=.true. ! same
-    endif
-  else
-    ! Put binary function here
-  endif
-#else
-    ! Put binary function here
-#endif
-end subroutine output_particle
-
-subroutine output_conc(itime,loutstart,loutend,loutnext,outnum)
-  use unc_mod
-  use prepoutgrid_mod
-  use par_mod
-  use com_mod
-!#ifdef USE_NCF
-!  use netcdf_output_mod, only: concoutput_ncf,concoutput_ncf_nest,&
-!       &concoutput_sfc_ncf,concoutput_sfc_ncf_nest
-!#endif
-  use binary_output_mod 
-
-  implicit none
-
-  integer,intent(in) ::     &
-    itime                     ! time index
-  integer,intent(inout) ::  &
-    loutstart,loutend,      & ! concentration calculation starting and ending time
-    loutnext
-  real,intent(inout) ::     &
-    outnum                    ! concentration calculation sample number
-  real(sp) ::               &
-    gridtotalunc              ! concentration calculation related
-  real(dep_prec) ::         &
-    wetgridtotalunc,        & ! concentration calculation related
-    drygridtotalunc           ! concentration calculation related
-  real ::                   &
-    weight                    ! concentration calculation sample weight
-
-
-  ! Is the time within the computation interval, if not, return
-  !************************************************************
-  if ((ldirect*itime.lt.ldirect*loutstart).or.(ldirect*itime.gt.ldirect*loutend)) then
-    return
-  endif
-
-  ! If we are exactly at the start or end of the concentration averaging interval,
-  ! give only half the weight to this sample
-  !*****************************************************************************
-  if (mod(itime-loutstart,loutsample).eq.0) then
-    if ((itime.eq.loutstart).or.(itime.eq.loutend)) then
-      weight=0.5
-    else
-      weight=1.0
-    endif
-    outnum=outnum+weight
-    if (iout.ne.0) call conccalc(itime,weight)
-  endif
-
-  ! If no grid is to be written to file, return (LB)
-  !*************************************************
-  if (iout.eq.0) then 
-    if (itime.ne.loutend) return
-    loutnext=loutnext+loutstep
-    loutstart=loutnext-loutaver/2
-    loutend=loutnext+loutaver/2
-    if (itime.eq.loutstart) then
-      weight=0.5
-      outnum=outnum+weight
-    endif
-    return
-  endif
-
-  ! If it is not time yet to write outputs, return
-  !***********************************************
-  if ((itime.ne.loutend).or.(outnum.le.0)) then
-    return
-  endif
-
-  ! Output and reinitialization of grid
-  ! If necessary, first sample of new grid is also taken
-  !*****************************************************
-  if ((iout.le.3.).or.(iout.eq.5)) then
-    if (surf_only.ne.1) then 
-#ifdef USE_NCF
-      call concoutput_ncf(itime,outnum,gridtotalunc,wetgridtotalunc,drygridtotalunc)
-#else
-      call concoutput(itime,outnum,gridtotalunc,wetgridtotalunc,drygridtotalunc)
-#endif
-    else
-#ifdef USE_NCF
-      call concoutput_sfc_ncf(itime,outnum,gridtotalunc,wetgridtotalunc,drygridtotalunc)
-#else
-      if (linversionout.eq.1) then
-        call concoutput_inv(itime,outnum,gridtotalunc,wetgridtotalunc,drygridtotalunc)
-      else
-        call concoutput_sfc(itime,outnum,gridtotalunc,wetgridtotalunc,drygridtotalunc)
-      endif
-#endif
-    endif
-
-    if (nested_output .eq. 1) then
-#ifdef USE_NCF
-      if (surf_only.ne.1) then
-        call concoutput_ncf_nest(itime,outnum)
-      else 
-        call concoutput_sfc_ncf_nest(itime,outnum)
-      endif
-#else
-      if (surf_only.ne.1) then
-        call concoutput_nest(itime,outnum)
-      else 
-        if(linversionout.eq.1) then
-          call concoutput_inv_nest(itime,outnum)
-        else 
-          call concoutput_sfc_nest(itime,outnum)
-        endif
-      endif
-#endif
-    endif
-    outnum=0.
-  endif
-
-  write(*,45) itime,numpart,gridtotalunc,wetgridtotalunc,drygridtotalunc
-
-45      format(i13,' Seconds simulated: ',i13, ' Particles:    Uncertainty: ',3f7.3)
-
-  loutnext=loutnext+loutstep
-  loutstart=loutnext-loutaver/2
-  loutend=loutnext+loutaver/2
-  if (itime.eq.loutstart) then
-    weight=0.5
-    outnum=outnum+weight
-    call conccalc(itime,weight)
-  endif
-end subroutine output_conc
-
-subroutine conccalc(itime,weight)
-  !                      i     i
-  !*****************************************************************************
-  !                                                                            *
-  !     Calculation of the concentrations on a regular grid using volume       *
-  !     sampling                                                               *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     24 May 1996                                                            *
-  !                                                                            *
-  !     April 2000: Update to calculate age spectra                            *
-  !                 Bug fix to avoid negative conc. at the domain boundaries,  *
-  !                 as suggested by Petra Seibert                              *
-  !                                                                            *
-  !     2 July 2002: re-order if-statements in order to optimize CPU time      *
-  !                                                                            *
-  !     2021, LB: OpenMP parallelisation                                       *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! nspeciesdim     = nspec for forward runs, 1 for backward runs              *
-  !                                                                            *
-  !*****************************************************************************
-
-  use unc_mod
-  use prepoutgrid_mod
-  use par_mod
-  use com_mod
-  use omp_lib, only: OMP_GET_THREAD_NUM
-  use interpol_mod, only: interpol_density
-  use coord_ec_mod
-  use particle_mod
-
-  implicit none
-
-  integer,intent(in) :: itime
-  real,intent(in) :: weight
-  integer :: itage,i,kz,ks,n,nage,inage,thread,ithread
-  integer :: il,ind,indz,indzp,nrelpointer
-  integer :: ix,jy,ixp,jyp
-  real :: ddx,ddy
-  real(kind=dp) :: mm3
-  real :: hx,hy,hz,hxyz,xd,yd,zd,xkern,r2,c(maxspec)
-  real :: rhoi
-  real :: xl,yl,wx,wy,w
-  real,parameter :: factor=.596831, hxmax=6.0, hymax=4.0, hzmax=150.
-  !  integer xscav_count
-
-  ! For forward simulations, make a loop over the number of species;
-  ! for backward simulations, make an additional loop over the
-  ! releasepoints
-  !***************************************************************************
-  !  xscav_count=0
-#ifdef _OPENMP
-  call omp_set_num_threads(numthreads_grid)
-#endif
-!$OMP PARALLEL PRIVATE(i,itage,nage,inage,rhoi,nrelpointer,kz,xl,yl,ks,wx,wy,w,thread,ddx,ddy, &
-!$OMP ix,jy,ixp,jyp)
-#if (defined _OPENMP)
-    thread = OMP_GET_THREAD_NUM()+1 ! Starts with 1
-#else
-    thread = 1
-#endif
-
-!$OMP DO
-  do i=1,numpart
-    if (.not.part(i)%alive) cycle
-
-  ! Determine age class of the particle
-    itage=abs(itime-part(i)%tstart)
-    nage=1
-    do inage=1,nageclass
-      nage=inage
-      if (itage.lt.lage(nage)) exit
-    end do
-
-  !  if (xscav_frac1(i,1).lt.0) xscav_count=xscav_count+1
-           
-  ! For special runs, interpolate the air density to the particle position
-  !************************************************************************
-  !***********************************************************************
-  !AF IND_SOURCE switches between different units for concentrations at the source
-  !Af    NOTE that in backward simulations the release of particles takes place
-  !Af    at the receptor and the sampling at the source.
-  !Af          1="mass"
-  !Af          2="mass mixing ratio"
-  !Af IND_RECEPTOR switches between different units for concentrations at the receptor
-  !Af          1="mass"
-  !Af          2="mass mixing ratio"
-
-  !Af switches for the conccalcfile:
-  !AF IND_SAMP =  0 : xmass * 1
-  !Af IND_SAMP = -1 : xmass / rho
-
-  !Af ind_samp is defined in readcommand.f
-
-    if ( ind_samp .eq. -1 ) then
-      call update_zeta_to_z(itime,i)
-      call interpol_density(itime,i,rhoi)
-    elseif (ind_samp.eq.0) then 
-      rhoi = 1.
-    endif
-
-  !****************************************************************************
-  ! 1. Evaluate grid concentrations using a uniform kernel of bandwidths dx, dy
-  !****************************************************************************
-
-
-  ! For backward simulations, look from which release point the particle comes from
-  ! For domain-filling trajectory option, npoint contains a consecutive particle
-  ! number, not the release point information. Therefore, nrelpointer is set to 1
-  ! for the domain-filling option.
-  !*****************************************************************************
-
-    if ((ioutputforeachrelease.eq.0).or.(mdomainfill.eq.1)) then
-       nrelpointer=1
-    else
-       nrelpointer=part(i)%npoint
-    endif
-
-    do kz=1,numzgrid                ! determine height of cell
-      if (outheight(kz).gt.part(i)%z) exit
-    end do
-
-    if (kz.le.numzgrid) then           ! inside output domain
-
-
-  !********************************
-  ! Do everything for mother domain
-  !********************************
-
-      xl=(part(i)%xlon*dx+xoutshift)/dxout
-      yl=(part(i)%ylat*dy+youtshift)/dyout
-      ix=int(xl)
-      if (xl.lt.0.) ix=ix-1
-      jy=int(yl)
-      if (yl.lt.0.) jy=jy-1
-
-
-
-  ! For particles aged less than 3 hours, attribute particle mass to grid cell
-  ! it resides in rather than use the kernel, in order to avoid its smoothing effect.
-  ! For older particles, use the uniform kernel.
-  ! If a particle is close to the domain boundary, do not use the kernel either.
-  !*****************************************************************************
-
-      if ((.not.lusekerneloutput).or.(itage.lt.10800).or. &
-           (xl.lt.0.5).or.(yl.lt.0.5).or. &
-           (xl.gt.real(numxgrid-1)-0.5).or. &
-           (yl.gt.real(numygrid-1)-0.5)) then             ! no kernel, direct attribution to grid cell
-
-        if ((ix.ge.0).and.(jy.ge.0).and.(ix.le.numxgrid-1).and. &
-             (jy.le.numygrid-1)) then
-          if (DRYBKDEP.or.WETBKDEP) then
-            do ks=1,nspec
-#ifdef _OPENMP
-              gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
-                   gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
-                   part(i)%mass(ks)/rhoi*weight*max(xscav_frac1(i,ks),0.0)
-#else
-              gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= &
-                   gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
-                   part(i)%mass(ks)/rhoi*weight*max(xscav_frac1(i,ks),0.0)
-#endif
-            end do
-          else
-            if (lparticlecountoutput) then
-              do ks=1,nspec
-#ifdef _OPENMP
-                gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
-                     gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+1
-#else
-                gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= &
-                     gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+1
-#endif
-              end do
-            else
-              do ks=1,nspec
-#ifdef _OPENMP
-                gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
-                     gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
-                     part(i)%mass(ks)/rhoi*weight
-#else
-                gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= &
-                     gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
-                     part(i)%mass(ks)/rhoi*weight
-#endif
-              end do
-            end if
-          endif
-        endif
-
-      else                                 ! attribution via uniform kernel 
-
-        ddx=xl-real(ix)                   ! distance to left cell border
-        ddy=yl-real(jy)                   ! distance to lower cell border
-        if (ddx.gt.0.5) then
-          ixp=ix+1
-          wx=1.5-ddx
-        else
-          ixp=ix-1
-          wx=0.5+ddx
-        endif
-
-        if (ddy.gt.0.5) then
-          jyp=jy+1
-          wy=1.5-ddy
-        else
-          jyp=jy-1
-          wy=0.5+ddy
-        endif
-
-  ! Determine mass fractions for four grid points
-  !**********************************************
-
-        if ((ix.ge.0).and.(ix.le.numxgrid-1)) then
-          if ((jy.ge.0).and.(jy.le.numygrid-1)) then
-            w=wx*wy
-            if (DRYBKDEP.or.WETBKDEP) then
-               do ks=1,nspec
-#ifdef _OPENMP
-                 gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
-                   gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
-                   part(i)%mass(ks)/rhoi*w*weight*max(xscav_frac1(i,ks),0.0)
-#else
-                 gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= &
-                   gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
-                   part(i)%mass(ks)/rhoi*w*weight*max(xscav_frac1(i,ks),0.0)
-#endif
-               end do
-            else
-               do ks=1,nspec
-#ifdef _OPENMP
-                 gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
-                   gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
-                   part(i)%mass(ks)/rhoi*weight*w
-#else
-                 gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= &
-                   gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
-                   part(i)%mass(ks)/rhoi*weight*w
-#endif
-               end do
-            endif
-          endif
-
-          if ((jyp.ge.0).and.(jyp.le.numygrid-1)) then
-            w=wx*(1.-wy)
-            if (DRYBKDEP.or.WETBKDEP) then
-              do ks=1,nspec
-#ifdef _OPENMP
-                 gridunc_omp(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
-                   gridunc_omp(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
-                   part(i)%mass(ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0)
-#else
-                 gridunc(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)= &
-                   gridunc(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
-                   part(i)%mass(ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0)
-#endif
-               end do
-             else
-              do ks=1,nspec
-#ifdef _OPENMP
-                 gridunc_omp(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
-                   gridunc_omp(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
-                   part(i)%mass(ks)/rhoi*weight*w
-#else
-                 gridunc(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)= &
-                   gridunc(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
-                   part(i)%mass(ks)/rhoi*weight*w
-#endif
-               end do
-             endif
-          endif
-        endif !ix ge 0
-
-
-        if ((ixp.ge.0).and.(ixp.le.numxgrid-1)) then
-          if ((jyp.ge.0).and.(jyp.le.numygrid-1)) then
-            w=(1.-wx)*(1.-wy)
-            if (DRYBKDEP.or.WETBKDEP) then
-               do ks=1,nspec
-#ifdef _OPENMP
-                 gridunc_omp(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
-                   gridunc_omp(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
-                   part(i)%mass(ks)/rhoi*w*weight*max(xscav_frac1(i,ks),0.0)
-#else
-                 gridunc(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)= &
-                   gridunc(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
-                   part(i)%mass(ks)/rhoi*w*weight*max(xscav_frac1(i,ks),0.0)
-#endif
-               end do
-            else
-               do ks=1,nspec
-#ifdef _OPENMP
-                 gridunc_omp(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
-                   gridunc_omp(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
-                   part(i)%mass(ks)/rhoi*weight*w
-#else
-                 gridunc(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)= &
-                   gridunc(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
-                   part(i)%mass(ks)/rhoi*weight*w
-#endif
-               end do
-            endif
-          endif
-
-          if ((jy.ge.0).and.(jy.le.numygrid-1)) then
-            w=(1.-wx)*wy
-            if (DRYBKDEP.or.WETBKDEP) then
-               do ks=1,nspec
-#ifdef _OPENMP
-                 gridunc_omp(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
-                   gridunc_omp(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
-                   part(i)%mass(ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0)
-#else
-                 gridunc(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= &
-                   gridunc(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
-                   part(i)%mass(ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0)
-#endif
-               end do
-            else
-               do ks=1,nspec
-#ifdef _OPENMP
-                 gridunc_omp(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
-                   gridunc_omp(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
-                   part(i)%mass(ks)/rhoi*weight*w
-#else
-                 gridunc(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= &
-                   gridunc(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
-                   part(i)%mass(ks)/rhoi*weight*w
-#endif
-               end do
-            endif
-          endif
-        endif !ixp ge 0
-      endif
-
-  !************************************
-  ! Do everything for the nested domain
-  !************************************
-
-      if (nested_output.eq.1) then
-        xl=(part(i)%xlon*dx+xoutshiftn)/dxoutn
-        yl=(part(i)%ylat*dy+youtshiftn)/dyoutn
-        ix=int(xl)
-        if (xl.lt.0.) ix=ix-1
-        jy=int(yl)
-        if (yl.lt.0.) jy=jy-1
-
-
-  ! For particles aged less than 3 hours, attribute particle mass to grid cell
-  ! it resides in rather than use the kernel, in order to avoid its smoothing effect.
-  ! For older particles, use the uniform kernel.
-  ! If a particle is close to the domain boundary, do not use the kernel either.
-  !*****************************************************************************
-
-        if ((itage.lt.10800).or.(xl.lt.0.5).or.(yl.lt.0.5).or. &
-             (xl.gt.real(numxgridn-1)-0.5).or. &
-             (yl.gt.real(numygridn-1)-0.5).or.((.not.lusekerneloutput))) then
-  ! no kernel, direct attribution to grid cell
-          if ((ix.ge.0).and.(jy.ge.0).and.(ix.le.numxgridn-1).and. &
-               (jy.le.numygridn-1)) then
-            if (DRYBKDEP.or.WETBKDEP) then
-               do ks=1,nspec
-#ifdef _OPENMP
-                 griduncn_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
-                   griduncn_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
-                   part(i)%mass(ks)/rhoi*weight*max(xscav_frac1(i,ks),0.0)
-#else            
-                 griduncn(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= &
-                   griduncn(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
-                   part(i)%mass(ks)/rhoi*weight*max(xscav_frac1(i,ks),0.0)
-#endif
-               end do
-            else
-              if (lparticlecountoutput) then
-                do ks=1,nspec
-#ifdef _OPENMP
-                  griduncn_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
-                       griduncn_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+1
-#else  
-                  griduncn(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= &
-                       griduncn(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+1
-#endif
-                end do
-              else
-                do ks=1,nspec
-#ifdef _OPENMP
-                  griduncn_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
-                       griduncn_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
-                       part(i)%mass(ks)/rhoi*weight
-#else            
-                  griduncn(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= &
-                       griduncn(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
-                       part(i)%mass(ks)/rhoi*weight
-#endif
-                end do
-              endif
-            endif
-          endif
-          
-        else                                 ! attribution via uniform kernel
-
-          ddx=xl-real(ix)                   ! distance to left cell border
-          ddy=yl-real(jy)                   ! distance to lower cell border
-          if (ddx.gt.0.5) then
-            ixp=ix+1
-            wx=1.5-ddx
-          else
-            ixp=ix-1
-            wx=0.5+ddx
-          endif
-
-          if (ddy.gt.0.5) then
-            jyp=jy+1
-            wy=1.5-ddy
-          else
-            jyp=jy-1
-            wy=0.5+ddy
-          endif
-
-
-  ! Determine mass fractions for four grid points
-  !**********************************************
-
-          if ((ix.ge.0).and.(ix.le.numxgridn-1)) then
-            if ((jy.ge.0).and.(jy.le.numygridn-1)) then
-              w=wx*wy
-              if (DRYBKDEP.or.WETBKDEP) then
-                 do ks=1,nspec
-#ifdef _OPENMP
-                   griduncn_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
-                     griduncn_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
-                     part(i)%mass(ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0)
-#else              
-                   griduncn(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= &
-                     griduncn(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
-                     part(i)%mass(ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0)
-#endif
-                 end do
-              else
-                do ks=1,nspec
-#ifdef _OPENMP
-                   griduncn_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
-                     griduncn_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
-                     part(i)%mass(ks)/rhoi*weight*w
-#else            
-                   griduncn(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= &
-                     griduncn(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
-                     part(i)%mass(ks)/rhoi*weight*w
-#endif
-                 end do
-              endif
-            endif
-
-            if ((jyp.ge.0).and.(jyp.le.numygridn-1)) then
-              w=wx*(1.-wy)
-              if (DRYBKDEP.or.WETBKDEP) then
-                 do ks=1,nspec
-#ifdef _OPENMP
-                   griduncn_omp(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
-                     griduncn_omp(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
-                     part(i)%mass(ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0)
-#else              
-                   griduncn(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)= &
-                     griduncn(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
-                     part(i)%mass(ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0)
-#endif
-                 end do
-              else
-                 do ks=1,nspec
-#ifdef _OPENMP
-                   griduncn_omp(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
-                     griduncn_omp(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
-                     part(i)%mass(ks)/rhoi*weight*w
-#else              
-                   griduncn(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)= &
-                     griduncn(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
-                     part(i)%mass(ks)/rhoi*weight*w
-#endif
-                 end do
-              endif
-            endif
-          endif
-
-
-          if ((ixp.ge.0).and.(ixp.le.numxgridn-1)) then
-            if ((jyp.ge.0).and.(jyp.le.numygridn-1)) then
-              w=(1.-wx)*(1.-wy)
-              if (DRYBKDEP.or.WETBKDEP) then
-                 do ks=1,nspec
-#ifdef _OPENMP
-                   griduncn_omp(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
-                     griduncn_omp(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
-                     part(i)%mass(ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0)
-#else              
-                   griduncn(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)= &
-                     griduncn(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
-                     part(i)%mass(ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0)
-#endif
-                 end do
-              else
-                 do ks=1,nspec
-#ifdef _OPENMP
-                   griduncn_omp(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
-                     griduncn_omp(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
-                     part(i)%mass(ks)/rhoi*weight*w
-#else              
-                   griduncn(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)= &
-                     griduncn(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
-                     part(i)%mass(ks)/rhoi*weight*w
-#endif
-                 end do
-              endif
-            endif
-
-            if ((jy.ge.0).and.(jy.le.numygridn-1)) then
-              w=(1.-wx)*wy
-              if (DRYBKDEP.or.WETBKDEP) then
-                 do ks=1,nspec
-#ifdef _OPENMP
-                   griduncn_omp(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
-                     griduncn_omp(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
-                     part(i)%mass(ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0)
-#else              
-                   griduncn(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= &
-                     griduncn(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
-                     part(i)%mass(ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0)
-#endif
-                 end do
-              else
-                 do ks=1,nspec
-#ifdef _OPENMP
-                    griduncn_omp(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= &
-                     griduncn_omp(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ &
-                     part(i)%mass(ks)/rhoi*weight*w
-#else              
-                    griduncn(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= &
-                     griduncn(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ &
-                     part(i)%mass(ks)/rhoi*weight*w
-#endif
-                 end do
-              endif
-            endif
-          endif
-        endif
-      endif
-    endif
-  end do
-!$OMP END DO
-!$OMP END PARALLEL
-#ifdef _OPENMP
-  call omp_set_num_threads(numthreads)
-#endif
-  ! Reduction of gridunc and griduncn
-#ifdef _OPENMP
-  do ithread=1,numthreads_grid
-    gridunc(:,:,:,:,:,:,:)=gridunc(:,:,:,:,:,:,:)+gridunc_omp(:,:,:,:,:,:,:,ithread)
-    gridunc_omp(:,:,:,:,:,:,:,ithread)=0.
-  end do
-  if (nested_output.eq.1) then 
-    do ithread=1,numthreads_grid
-      griduncn(:,:,:,:,:,:,:)=griduncn(:,:,:,:,:,:,:)+griduncn_omp(:,:,:,:,:,:,:,ithread)
-      griduncn_omp(:,:,:,:,:,:,:,ithread)=0.
-    end do
-  endif
-#endif
-
-  !***********************************************************************
-  ! 2. Evaluate concentrations at receptor points, using the kernel method
-  !***********************************************************************
-  if (numreceptor.eq.0) return
-
-  do n=1,numreceptor
-
-
-  ! Reset concentrations
-  !*********************
-
-    do ks=1,nspec
-      c(ks)=0.
-    end do
-
-
-  ! Estimate concentration at receptor
-  !***********************************
-
-    do i=1,numpart
-
-      if (.not. part(i)%alive) cycle
-      itage=abs(itime-part(i)%tstart)
-
-      hz=min(50.+0.3*sqrt(real(itage)),hzmax)
-      zd=part(i)%z/hz
-      if (zd.gt.1.) cycle          ! save computing time, leave loop
-
-      hx=min((0.29+2.222e-3*sqrt(real(itage)))*dx+ &
-           real(itage)*1.2e-5,hxmax)                     ! 80 km/day
-      xd=(part(i)%xlon-xreceptor(n))/hx
-      if (xd*xd.gt.1.) cycle       ! save computing time, leave loop
-
-      hy=min((0.18+1.389e-3*sqrt(real(itage)))*dy+ &
-           real(itage)*7.5e-6,hymax)                     ! 80 km/day
-      yd=(part(i)%ylat-yreceptor(n))/hy
-      if (yd*yd.gt.1.) cycle       ! save computing time, leave loop
-      hxyz=hx*hy*hz
-
-      r2=xd*xd+yd*yd+zd*zd
-      if (r2.lt.1.) then
-        xkern=factor*(1.-r2)
-        do ks=1,nspec
-          c(ks)=c(ks)+part(i)%mass(ks)*xkern/hxyz
-        end do
-      endif
-    end do
-
-    do ks=1,nspec
-      creceptor(n,ks)=creceptor(n,ks)+2.*weight*c(ks)/receptorarea(n)
-    end do
-  end do
-end subroutine conccalc
-
-subroutine partpos_avg(itime,j)
-
-  !**********************************************************************
-  ! This subroutine averages particle quantities, to be used for particle
-  ! dump (in partoutput.f90). Averaging is done over output interval.
-  ! Author: A. Stohl
-  ! Changes L Bakels:
-  !    - Computing fields defined in PARTOPTIONS
-  !**********************************************************************
-
-  use par_mod
-  use com_mod
-  use interpol_mod
-  use coord_ec_mod
-
-  implicit none
-
-  integer,intent(in) :: itime,j
-  integer :: np,i_av,ns,m
-  real :: xlon,ylat,x,y,z
-  real :: topo,hm(2),hmixi,pvi,qvi
-  real :: tti,rhoi,ttemp
-  real :: uui,vvi,output
-  real :: tr(2),tri!,energy
-
-  logical :: cart_comp
-
-  if (ipout.eq.0) return ! No need to compute averages since there is no particle output
-
-  if (n_average.eq.0) return
-
-  if (.not. part(j)%alive) return
-
-  if (part(j)%nstop) return ! If particle is to be killed, averages cannot be computed
-
- ! Some variables needed for temporal interpolation
-  !*************************************************
-  call find_time_vars(itime)
-
-  xlon=xlon0+real(part(j)%xlon)*dx
-  ylat=ylat0+real(part(j)%ylat)*dy
+#include "out_init_output.f90"
 
-  !*****************************************************************************
-  ! Interpolate several variables (PV, specific humidity, etc.) to particle position
-  !*****************************************************************************
-  ! Where in the grid? Stereographic (ngrid<0) or nested (ngrid>0)
-  !***************************************************************
-  call find_ngrid(real(part(j)%xlon),real(part(j)%ylat))
-  call find_grid_indices(real(part(j)%xlon),real(part(j)%ylat))
-  call find_grid_distances(real(part(j)%xlon),real(part(j)%ylat))
+#include "out_finalise_output.f90"
 
-  ! First set dz1out from interpol_mod to -1 so it only is calculated once per particle
-  !************************************************************************************
-  part(j)%ntime=part(j)%ntime + 1
-  dz1out=-1
-  cart_comp=.false.
-  do np=1,num_partopt
-    if ((.not. partopt(np)%print) .or. (.not. partopt(np)%average)) cycle
-    i_av = partopt(np)%i_average
-    select case (partopt(np)%name)
-      case ('to')
-        if (ngrid.le.0) then
-          call hor_interpol(oro,output)
-        else
-          call hor_interpol_nest(oron,output)
-        endif
-        part(j)%val_av(i_av)=part(j)%val_av(i_av)+output
-      case ('tr')
-        if (ngrid.le.0) then
-          do m=1,2
-            call hor_interpol(tropopause,tr(m),1,memind(m),1)
-          end do
-        else
-          do m=1,2
-            call hor_interpol_nest(tropopausen,tr(m),1,memind(m),1)
-          end do
-        endif
-        call temp_interpol(tr(1),tr(2),output)
-        part(j)%val_av(i_av)=part(j)%val_av(i_av)+output
-      case ('hm')
-        if (ngrid.le.0) then
-          do m=1,2
-            call hor_interpol(hmix,hm(m),1,memind(m),1)
-          end do
-        else
-          do m=1,2
-            call hor_interpol_nest(hmixn,hm(m),1,memind(m),1)
-          end do
-        endif
-        call temp_interpol(hm(1),hm(2),output)
-        part(j)%val_av(i_av)=part(j)%val_av(i_av)+output
-      case ('lo')
-        if (.not. cart_comp) then
-          ! Calculate Cartesian 3D coordinates suitable for averaging
-          !**********************************************************
+#include "out_output_restart.f90"
 
-          xlon=xlon*pi180
-          ylat=ylat*pi180
-          x = cos(ylat)*sin(xlon)
-          y = -1.*cos(ylat)*cos(xlon)
-          z = sin(ylat)
+#include "out_output_heightlevs.f90"
 
-          part(j)%cartx_av=part(j)%cartx_av+x
-          part(j)%carty_av=part(j)%carty_av+y
-          part(j)%cartz_av=part(j)%cartz_av+z
-          cart_comp=.true.
-        endif
-      case ('la')
-        if (.not. cart_comp) then
-          ! Calculate Cartesian 3D coordinates suitable for averaging
-          !**********************************************************
+#include "out_output_particle.f90"
 
-          xlon=xlon*pi180
-          ylat=ylat*pi180
-          x = cos(ylat)*sin(xlon)
-          y = -1.*cos(ylat)*cos(xlon)
-          z = sin(ylat)
+#include "out_output_conc.f90"
 
-          part(j)%cartx_av=part(j)%cartx_av+x
-          part(j)%carty_av=part(j)%carty_av+y
-          part(j)%cartz_av=part(j)%cartz_av+z
-          cart_comp=.true.
-        endif
-      case ('zz')
-        ! Convert eta z coordinate to meters if necessary. Can be moved to output only
-        !************************************************
-        call update_zeta_to_z(itime,j)
-        part(j)%val_av(i_av)=part(j)%val_av(i_av)+part(j)%z
-      case ('ma')
-        do ns=1,nspec
-          part(j)%val_av(i_av+(ns-1))=part(j)%val_av(i_av+(ns-1))+part(j)%mass(ns)
-        end do
-      case ('vs')
-        part(j)%val_av(i_av)=part(j)%val_av(i_av)+part(j)%settling
-      case default
-        call interpol_partoutput_val(partopt(np)%name,output,j)
-        part(j)%val_av(i_av)=part(j)%val_av(i_av)+output
-    end select
-  end do
-  ! Reset dz1out
-  !*************
-  dz1out=-1
-  cart_comp=.false.
+#include "out_conccalc.f90"
 
-  return
-end subroutine partpos_avg
+#include "out_partpos_avg.f90"
 
 end module output_mod
diff --git a/src/par_alloc_particle.f90 b/src/par_alloc_particle.f90
new file mode 100644
index 0000000000000000000000000000000000000000..f7328f7215ee4a88d22283afce1c05d92f3b4d3f
--- /dev/null
+++ b/src/par_alloc_particle.f90
@@ -0,0 +1,18 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+  subroutine alloc_particle(ipart)
+
+    implicit none
+
+    integer, intent(in) :: ipart
+
+  ! Keeping track of the allocated memory in case
+  ! there is a reason for deallocating some of it
+    if (ipart.gt.count%allocated) then
+      call alloc_particles(ipart-count%allocated)
+    else
+      stop 'Error: You are trying to allocate an already existing particle'
+    endif
+
+  end subroutine alloc_particle
diff --git a/src/par_alloc_particles.f90 b/src/par_alloc_particles.f90
new file mode 100644
index 0000000000000000000000000000000000000000..40b4ce062ca04c5768b89438acacca952ab61505
--- /dev/null
+++ b/src/par_alloc_particles.f90
@@ -0,0 +1,66 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+  subroutine alloc_particles(nmpart)
+
+    integer, intent(in) :: nmpart
+
+    integer, allocatable ::       tmpnclust(:)
+    logical, allocatable ::       tmpcount(:)
+    type(particle),allocatable :: tmppart(:)
+    real, allocatable ::          tmpxscav(:,:)
+    real, allocatable ::          tmpxl(:),tmpyl(:),tmpzl(:)
+    integer :: i
+
+    if (nmpart.gt.100) write(*,*) 'Allocating ',nmpart,' particles'
+
+   ! Keeping track of the allocated memory in case
+   ! there is a reason for deallocating some of it
+    allocate( tmpcount(count%allocated + nmpart) )
+    if (count%allocated.gt.0) tmpcount(1:count%allocated) = count%inmem
+    call move_alloc(tmpcount,count%inmem)
+    count%inmem(count%allocated + 1 : count%allocated + nmpart) = .true.
+
+    ! Allocating new particle spaces
+    !*******************************
+
+    allocate( tmppart(count%allocated + nmpart) )
+    if (n_average.gt.0) then
+      do i=1,count%allocated + nmpart
+        allocate( tmppart(i)%val_av(n_average) )
+        tmppart(i)%val_av = 0
+      end do
+    endif
+    if (count%allocated.gt.0) tmppart(1:count%allocated) = part
+    call move_alloc(tmppart,part)
+
+   ! If wet or dry deposition backward mode is switched on, xscav_frac1
+   ! needs to be allocated
+    if (wetbkdep.or.drybkdep) then
+      allocate( tmpxscav(count%allocated + nmpart,maxspec) )
+      if (count%allocated.gt.0) tmpxscav(1:count%allocated,:) = xscav_frac1
+      call move_alloc(tmpxscav,xscav_frac1)
+    endif
+
+    if (iout.eq.4 .or. iout.eq.5) then
+      allocate( tmpxl(count%allocated + nmpart) )
+      if (count%allocated.gt.0) tmpxl(1:count%allocated) = xplum
+      call move_alloc(tmpxl,xplum)
+
+      allocate( tmpyl(count%allocated +nmpart) )
+      if (count%allocated.gt.0) tmpyl(1:count%allocated) = yplum
+      call move_alloc(tmpyl,yplum)
+
+      allocate( tmpzl(count%allocated+nmpart) )
+      if (count%allocated.gt.0) tmpzl(1:count%allocated) = zplum
+      call move_alloc(tmpzl,zplum)
+
+      allocate( tmpnclust(count%allocated + nmpart) )
+      if (count%allocated.gt.0) tmpnclust(1:count%allocated) = nclust
+      call move_alloc(tmpnclust,nclust)
+    endif
+
+    count%allocated = count%allocated + nmpart
+    if (nmpart.gt.100) write(*,*) 'Finished allocation'
+
+  end subroutine alloc_particles
diff --git a/src/par_dealloc_all_particles.f90 b/src/par_dealloc_all_particles.f90
new file mode 100644
index 0000000000000000000000000000000000000000..3f06da68ee9afc7e27786c9608ddf8aef105a816
--- /dev/null
+++ b/src/par_dealloc_all_particles.f90
@@ -0,0 +1,25 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+  subroutine dealloc_all_particles()
+
+    integer :: i
+
+    if (n_average.gt.0) then
+      do i=1,count%allocated
+        deallocate( part(i)%val_av )
+      end do
+    endif
+    deallocate( part )
+    deallocate( count%inmem )
+
+    if (wetbkdep.or.drybkdep) deallocate( xscav_frac1 )
+
+    if (iout.eq.4 .or. iout.eq.5) then
+      deallocate( xplum )
+      deallocate( yplum )
+      deallocate( zplum )
+      deallocate( nclust )
+    endif
+
+  end subroutine dealloc_all_particles
diff --git a/src/par_dealloc_particle.f90 b/src/par_dealloc_particle.f90
new file mode 100644
index 0000000000000000000000000000000000000000..0e92b0930530eb996b0ede53d0c8d8676819f2ce
--- /dev/null
+++ b/src/par_dealloc_particle.f90
@@ -0,0 +1,12 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+  subroutine dealloc_particle(ipart)
+
+    integer, intent(in) :: ipart ! particle index
+
+    !deallocate( part(ipart) )
+    part = part(1:ipart) ! FORTRAN 2008 only
+    count%inmem(ipart+1:) = .false.
+
+  end subroutine dealloc_particle
diff --git a/src/par_dealloc_particle_range.f90 b/src/par_dealloc_particle_range.f90
new file mode 100644
index 0000000000000000000000000000000000000000..27d8a3ddd4f81fc6f23af711bf2f9a5ffa1676bf
--- /dev/null
+++ b/src/par_dealloc_particle_range.f90
@@ -0,0 +1,11 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+  subroutine dealloc_particle_range(istart,iend)
+
+    integer, intent(in) :: istart,iend
+
+    !deallocate( part(istart:iend) )
+    count%inmem(istart:iend) = .false.
+
+  end subroutine dealloc_particle_range
diff --git a/src/par_get_alivepart_num.f90 b/src/par_get_alivepart_num.f90
new file mode 100644
index 0000000000000000000000000000000000000000..f7a05fb939b43643db8af7a8770f8346f2be6455
--- /dev/null
+++ b/src/par_get_alivepart_num.f90
@@ -0,0 +1,14 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+  subroutine get_alivepart_num(npart)
+
+    !**********************************************
+    ! Returns number of particles currently alive *
+    !**********************************************
+
+    integer, intent(inout) :: npart                     ! Number of particles
+
+    npart = count%alive
+
+  end subroutine get_alivepart_num
diff --git a/src/par_get_newpart_index.f90 b/src/par_get_newpart_index.f90
new file mode 100644
index 0000000000000000000000000000000000000000..d753fdf77534a818f1644661b316912caafdc61e
--- /dev/null
+++ b/src/par_get_newpart_index.f90
@@ -0,0 +1,14 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+  subroutine get_newpart_index(ipart)
+
+    !**************************************************
+    ! Returns the first free spot to put a new particle
+    !**************************************************
+
+    integer, intent(inout) :: ipart                     ! First free index
+
+    ipart = count%spawned + 1
+
+  end subroutine get_newpart_index
diff --git a/src/par_get_totalpart_num.f90 b/src/par_get_totalpart_num.f90
new file mode 100644
index 0000000000000000000000000000000000000000..492c2d2bd76bfda0fd76a937f9b5ff28063a42a1
--- /dev/null
+++ b/src/par_get_totalpart_num.f90
@@ -0,0 +1,14 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+  subroutine get_totalpart_num(npart)
+
+    !********************************************
+    ! Returns total number of particles spawned *
+    !********************************************
+
+    integer, intent(inout) :: npart                     ! Number of particles
+
+    npart = count%spawned
+
+  end subroutine get_totalpart_num
diff --git a/src/par_mod.f90 b/src/par_mod.f90
index 38e2e91cc76474f76b71cd3eebee865c9cd4f9f6..2445ebc7bcb33f17a06e3fb52cb952f5eaa1906b 100644
--- a/src/par_mod.f90
+++ b/src/par_mod.f90
@@ -26,7 +26,7 @@ module par_mod
   integer,parameter :: sp=selected_real_kind(6)
 
   !****************************************************************
-  ! dep_prec sets the precision for deposition calculations (sp or 
+  ! dep_prec sets the precision for deposition calculations (sp or
   ! dp). sp is default, dp can be used for increased precision.
   !****************************************************************
 
@@ -59,7 +59,7 @@ module par_mod
   real,parameter :: pi=3.14159265, r_earth=6.371e6, r_air=287.05, ga=9.81
   real,parameter :: cpa=1004.6, kappa=0.286, pi180=pi/180., vonkarman=0.4
   ! additional constants RLT Aug-2017
-  real,parameter :: rgas=8.31447 
+  real,parameter :: rgas=8.31447
   real,parameter :: r_water=461.495
 
   ! pi                      number "pi"
@@ -90,7 +90,7 @@ module par_mod
   ! d_trop [m2/s]     Turbulent diffusivity for horiz components in the troposphere
   ! d_strat [m2/s]    Turbulent diffusivity for vertical component in the stratosphere
 
-  
+
   real,parameter :: xmwml=18.016/28.960
                   ! ratio of molar weights of water vapor and dry air
 
@@ -130,7 +130,7 @@ module par_mod
   !*********************************************
   ! Maximum dimensions of the input mother grids
   !*********************************************
-  
+
   ! ECMWF
 ! integer,parameter :: nxmax=361,nymax=181,nuvzmax=92,nwzmax=92,nzmax=92,nxshift=359 ! 1.0 deg 92 levels
 !  integer,parameter :: nxmax=361,nymax=181,nuvzmax=138,nwzmax=138,nzmax=138,nxshift=0 ! 1.0 deg 138 levels
@@ -140,7 +140,7 @@ module par_mod
 
 ! GFS
 !   integer,parameter :: nxmax=361,nymax=181,nuvzmax=138,nwzmax=138,nzmax=138
-!   integer,parameter :: nxshift=0 ! shift not fixed for the executable 
+!   integer,parameter :: nxshift=0 ! shift not fixed for the executable
 
   !*********************************
   ! Parmaters for GRIB file decoding
@@ -164,7 +164,7 @@ module par_mod
   ! nzmax              maximum dimension of wind fields in z direction
   !                    for the transformed Cartesian coordinates
 
-  
+
   integer,parameter :: nconvlevmax = nuvzmax-1
   integer,parameter :: na = nconvlevmax+1
 
@@ -220,16 +220,16 @@ module par_mod
   !integer,parameter :: numwfmem=3 ! MPI with 3 fields
 
   ! maxwf        maximum number of wind fields to be used for simulation
-  ! maxtable     Maximum number of chemical species that can be tabulated 
+  ! maxtable     Maximum number of chemical species that can be tabulated
   ! numclass     Number of landuse classes available to FLEXPART
   ! maxndia      Maximum number of diameter classes of particles
-  ! numwfmem     Number of windfields kept in memory. 2 for serial version, 
+  ! numwfmem     Number of windfields kept in memory. 2 for serial version,
   !              2 or 3 for MPI version
 
   !**************************************************************************
   ! dimension of the OH field
   !**************************************************************************
-  
+
   integer,parameter :: maxxOH=72, maxyOH=46, maxzOH=7
 
   !**************************************************************************
@@ -247,7 +247,7 @@ module par_mod
   integer,parameter :: maxrand=6000000
 
   ! maxrand                 number of random numbers used
-  
+
 
   !*****************************************************
   ! Number of clusters to be used for plume trajectories
@@ -265,7 +265,7 @@ module par_mod
   integer,parameter :: unitrestart=106,unitheightlevels=107
   integer,parameter :: unitpartin=93, unitflux=98, unitouttraj=96
   integer,parameter :: unitvert=1, unitoro=1, unitpoin=1, unitreceptor=1
-  integer,parameter :: unitreceptorout=2  
+  integer,parameter :: unitreceptorout=2
   integer,parameter :: unitoutgrid=97, unitoutgridppt=99, unitoutinfo=1
   integer,parameter :: unitspecies=1, unitoutrecept=91, unitoutreceptppt=92
   integer,parameter :: unitlsm=1, unitsfcdata=1, unitland=1, unitwesely=1
@@ -284,22 +284,22 @@ module par_mod
   integer,parameter ::  icmv=-9999
 
 !*******************************************************************************
-! Maximum output of each partoutput NetCDF-4 file in Mb 
+! Maximum output of each partoutput NetCDF-4 file in Mb
 ! before a new one is created
 !*******************************************************************************
 
   integer,parameter :: max_partoutput_filesize=30000
 
-  ! Set maximum number of threads for doing grid computations. 
+  ! Set maximum number of threads for doing grid computations.
   ! Recommended to set this to max 16
   ! High numbers create more overhead and a larger memory footprint
   !***********************************************************************
   integer,parameter :: max_numthreads_grid=16
   ! Set the coordinate system. At the moment only ECMWF is possible. This bit
-  ! needs to be a parameter that can be set at compile time. 
+  ! needs to be a parameter that can be set at compile time.
   ! Throughout the code there will be SELECT CASE statements or IFDEFs
   !*******************************************************************
-  
+
   character(len=256),parameter :: wind_coord_type='ETA'
   !character(len=256),parameter :: wind_coord_type='METER'
 
@@ -311,10 +311,10 @@ module par_mod
   !***********************************************************************
   logical,parameter :: lmesoscale_turb=.false.
 
-  ! Threshold equivalent diameter for interaction with surface sublayer 
+  ! Threshold equivalent diameter for interaction with surface sublayer
   ! resistance (below 10 meters) in micrometer. Above this diameter there
   ! is no interaction
   !**********************************************************************
   real,parameter :: d_thresheqv=20
-  
+
 end module par_mod
diff --git a/src/par_particle_allocated.f90 b/src/par_particle_allocated.f90
new file mode 100644
index 0000000000000000000000000000000000000000..454ab31f3f4711757032ca9269829ac5fe96975c
--- /dev/null
+++ b/src/par_particle_allocated.f90
@@ -0,0 +1,20 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+  logical function particle_allocated(ipart)
+
+    !******************************************
+    ! Checks if the memory of the particle is *
+    ! still allocated                         *
+    !******************************************
+
+    integer, intent(in)    ::  ipart      ! particle index
+    !logical :: particle_allocated
+
+    if (ipart.gt.count%allocated) then
+      particle_allocated = .false.
+    else
+      particle_allocated = count%inmem(ipart)
+    endif
+
+  end function particle_allocated
diff --git a/src/par_set_xlon_dp.f90 b/src/par_set_xlon_dp.f90
new file mode 100644
index 0000000000000000000000000000000000000000..7e99fc044e1b460426c210b2bed8050eab281db2
--- /dev/null
+++ b/src/par_set_xlon_dp.f90
@@ -0,0 +1,15 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+  subroutine set_xlon_dp(ipart,xvalue)
+
+    !**************************************
+    ! Sets the longitude of the particle
+    !**************************************
+
+    integer, intent(in)    :: ipart    ! particle index
+    real(kind=dp), intent(in) :: xvalue
+
+    part(ipart)%xlon = xvalue
+
+  end subroutine set_xlon_dp
diff --git a/src/par_set_xlon_int.f90 b/src/par_set_xlon_int.f90
new file mode 100644
index 0000000000000000000000000000000000000000..68547400de7df533477b564762fa9743b242059c
--- /dev/null
+++ b/src/par_set_xlon_int.f90
@@ -0,0 +1,15 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+  subroutine set_xlon_int(ipart,xvalue)
+
+    !**************************************
+    ! Sets the longitude of the particle
+    !**************************************
+
+    integer, intent(in)    :: ipart    ! particle index
+    integer, intent(in)    :: xvalue
+
+    part(ipart)%xlon = real(xvalue,kind=dp)
+
+  end subroutine set_xlon_int
diff --git a/src/par_set_xlon_sp.f90 b/src/par_set_xlon_sp.f90
new file mode 100644
index 0000000000000000000000000000000000000000..ff284b8839bc2cbc3b84e32dbaca41b72b72be5b
--- /dev/null
+++ b/src/par_set_xlon_sp.f90
@@ -0,0 +1,15 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+  subroutine set_xlon_sp(ipart,xvalue)
+
+    !**************************************
+    ! Sets the longitude of the particle
+    !**************************************
+
+    integer, intent(in)    :: ipart    ! particle index
+    real, intent(in)       :: xvalue
+
+    part(ipart)%xlon = real(xvalue,kind=dp)
+
+  end subroutine set_xlon_sp
diff --git a/src/par_set_ylat_dp.f90 b/src/par_set_ylat_dp.f90
new file mode 100644
index 0000000000000000000000000000000000000000..93c86b7a22f2060fb854928c3709ae6bb7cdf422
--- /dev/null
+++ b/src/par_set_ylat_dp.f90
@@ -0,0 +1,15 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+  subroutine set_ylat_dp(ipart,yvalue)
+
+    !**************************************
+    ! Sets the latitude of the particle
+    !**************************************
+
+    integer, intent(in)       :: ipart       ! particle index
+    real(kind=dp), intent(in) :: yvalue
+
+    part(ipart)%ylat = yvalue
+
+  end subroutine set_ylat_dp
diff --git a/src/par_set_ylat_int.f90 b/src/par_set_ylat_int.f90
new file mode 100644
index 0000000000000000000000000000000000000000..ad7bfba4a8d45d95ab34871abf76fdaebe8ce889
--- /dev/null
+++ b/src/par_set_ylat_int.f90
@@ -0,0 +1,15 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+  subroutine set_ylat_int(ipart,yvalue)
+
+    !**************************************
+    ! Sets the latitude of the particle
+    !**************************************
+
+    integer, intent(in)    :: ipart       ! particle index
+    integer, intent(in) :: yvalue
+
+    part(ipart)%ylat = real(yvalue,kind=dp)
+
+  end subroutine set_ylat_int
diff --git a/src/par_set_ylat_sp.f90 b/src/par_set_ylat_sp.f90
new file mode 100644
index 0000000000000000000000000000000000000000..104b49bce6b376472ae80bc41e119220dbd06611
--- /dev/null
+++ b/src/par_set_ylat_sp.f90
@@ -0,0 +1,15 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+  subroutine set_ylat_sp(ipart,yvalue)
+
+    !**************************************
+    ! Sets the latitude of the particle
+    !**************************************
+
+    integer, intent(in)    :: ipart       ! particle index
+    real, intent(in)       :: yvalue
+
+    part(ipart)%ylat = real(yvalue,kind=dp)
+
+  end subroutine set_ylat_sp
diff --git a/src/par_set_z_dp.f90 b/src/par_set_z_dp.f90
new file mode 100644
index 0000000000000000000000000000000000000000..4f7630ddf4e803c3d2eb07a9fd3facff3e7b3b28
--- /dev/null
+++ b/src/par_set_z_dp.f90
@@ -0,0 +1,17 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+  subroutine set_z_dp(ipart,zvalue)
+
+    !**************************************
+    ! Updates the height of the particle
+    !**************************************
+
+    integer, intent(in)        :: ipart       ! particle index
+    real(kind=dp), intent(in)  :: zvalue
+
+    part(ipart)%z = zvalue
+    part(ipart)%meterupdate=.false.
+    part(ipart)%etaupdate=.true.
+
+  end subroutine set_z_dp
diff --git a/src/par_set_z_sp.f90 b/src/par_set_z_sp.f90
new file mode 100644
index 0000000000000000000000000000000000000000..2d9000c402f6fbfd60a6ca4805f3b09d731b8120
--- /dev/null
+++ b/src/par_set_z_sp.f90
@@ -0,0 +1,17 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+  subroutine set_z_sp(ipart,zvalue)
+
+    !**************************************
+    ! Updates the height of the particle
+    !**************************************
+
+    integer, intent(in)    :: ipart       ! particle index
+    real, intent(in)       :: zvalue
+
+    part(ipart)%z = real(zvalue,kind=dp)
+    part(ipart)%meterupdate=.false.
+    part(ipart)%etaupdate=.true.
+
+  end subroutine set_z_sp
diff --git a/src/par_set_zeta_dp.f90 b/src/par_set_zeta_dp.f90
new file mode 100644
index 0000000000000000000000000000000000000000..b29e54b371ab22685b7d6a737b7c81a7152da0b8
--- /dev/null
+++ b/src/par_set_zeta_dp.f90
@@ -0,0 +1,17 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+  subroutine set_zeta_dp(ipart,zvalue)
+
+    !**************************************
+    ! Updates the height of the particle
+    !**************************************
+
+    integer, intent(in)        :: ipart       ! particle index
+    real(kind=dp), intent(in)  :: zvalue
+
+    part(ipart)%zeta = zvalue
+    part(ipart)%etaupdate=.false.
+    part(ipart)%meterupdate=.true.
+
+  end subroutine set_zeta_dp
diff --git a/src/par_set_zeta_sp.f90 b/src/par_set_zeta_sp.f90
new file mode 100644
index 0000000000000000000000000000000000000000..2da5ca4d1cd532ddb2c089a8811a79fae1253628
--- /dev/null
+++ b/src/par_set_zeta_sp.f90
@@ -0,0 +1,17 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+  subroutine set_zeta_sp(ipart,zvalue)
+
+    !**************************************
+    ! Updates the height of the particle
+    !**************************************
+
+    integer, intent(in)    :: ipart       ! particle index
+    real, intent(in)       :: zvalue
+
+    part(ipart)%zeta = real(zvalue,kind=dp)
+    part(ipart)%etaupdate=.false.
+    part(ipart)%meterupdate=.true.
+
+  end subroutine set_zeta_sp
diff --git a/src/par_spawn_particle.f90 b/src/par_spawn_particle.f90
new file mode 100644
index 0000000000000000000000000000000000000000..bbab31edfaa760582171f47cbb0092e0c704f191
--- /dev/null
+++ b/src/par_spawn_particle.f90
@@ -0,0 +1,29 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+  subroutine spawn_particle(itime, ipart)
+
+    !******************************************************
+    ! This routine spawns new particles and allocates the
+    ! memory if necessary.
+    !******************************************************
+
+    integer, intent(in) :: itime   ! spawning time
+    integer, intent(in) :: ipart   ! number of particles that are being spawned
+
+  ! Check if new memory needs to be allocated
+    if (.not. particle_allocated(ipart)) call alloc_particle(ipart)
+
+    if (part(ipart)%alive) stop 'Attempting to overwrite existing particle'
+
+  ! Update the number of particles that are currently alive
+    count%alive = count%alive + 1
+
+  ! Set the spawning time for each new particle and mark it as alive
+    part(ipart)%tstart = itime
+    part(ipart)%alive = .true.
+
+  ! Update the total number of spawned particles
+    count%spawned = count%spawned + 1
+
+  end subroutine spawn_particle
diff --git a/src/par_spawn_particles.f90 b/src/par_spawn_particles.f90
new file mode 100644
index 0000000000000000000000000000000000000000..41ac50101455655b270ac1631f424c3c43b44b4b
--- /dev/null
+++ b/src/par_spawn_particles.f90
@@ -0,0 +1,28 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+  subroutine spawn_particles(itime, nmpart)
+
+    !******************************************************
+    ! This routine spawns new particles and allocates the
+    ! memory if necessary.
+    !******************************************************
+
+    integer, intent(in) :: itime   ! spawning time
+    integer, intent(in) :: nmpart  ! number of particles that are being spawned
+
+  ! Check if new memory needs to be allocated
+    if (nmpart + count%spawned .gt. count%allocated) &
+      call alloc_particles( (nmpart + count%spawned) - count%allocated )
+
+  ! Update the number of particles that are currently alive
+    count%alive = count%alive + nmpart
+
+  ! Set the spawning time for each new particle and mark it as alive
+    part(count%spawned + 1 : count%spawned + nmpart)%tstart = itime
+    part(count%spawned + 1 : count%spawned + nmpart)%alive = .true.
+
+  ! Update the total number of spawned particles
+    count%spawned = count%spawned + nmpart
+
+  end subroutine spawn_particles
diff --git a/src/par_terminate_particle.f90 b/src/par_terminate_particle.f90
new file mode 100644
index 0000000000000000000000000000000000000000..47ae28257a3ba06b5db0caefcc09f18bd95a7451
--- /dev/null
+++ b/src/par_terminate_particle.f90
@@ -0,0 +1,24 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+  subroutine terminate_particle(ipart,itime)
+
+    !*****************************************************
+    ! Terminating specified particle
+    ! This routine terminates a selected particle
+    !*****************************************************
+
+    integer, intent(in) :: ipart ! to be terminated particle index
+    integer, intent(in) :: itime ! Time at which particle is terminated
+
+  ! Flagging the particle as having been terminated
+    part(ipart)%alive=.false.
+    part(ipart)%tend=itime
+
+  ! Update the number of current particles that are alive
+    count%alive = count%alive - 1
+
+  ! Update the total number of terminated particles during the whole run
+    count%terminated = count%terminated + 1
+
+  end subroutine terminate_particle
diff --git a/src/par_update_xlon_dp.f90 b/src/par_update_xlon_dp.f90
new file mode 100644
index 0000000000000000000000000000000000000000..f7c3887a74791451508797b719b1e0ee479a7d33
--- /dev/null
+++ b/src/par_update_xlon_dp.f90
@@ -0,0 +1,15 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+  subroutine update_xlon_dp(ipart,xchange)
+
+    !**************************************
+    ! Updates the longitude of the particle
+    !**************************************
+
+    integer, intent(in)    :: ipart   ! particle index
+    real(kind=dp), intent(in) :: xchange
+
+    part(ipart)%xlon = part(ipart)%xlon + xchange
+
+  end subroutine update_xlon_dp
diff --git a/src/par_update_xlon_int.f90 b/src/par_update_xlon_int.f90
new file mode 100644
index 0000000000000000000000000000000000000000..3e99c5155f610d34679296c6dee997b3ae08f638
--- /dev/null
+++ b/src/par_update_xlon_int.f90
@@ -0,0 +1,15 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+  subroutine update_xlon_int(ipart,xchange)
+
+    !**************************************
+    ! Updates the longitude of the particle
+    !**************************************
+
+    integer, intent(in)    :: ipart    ! particle index
+    integer, intent(in) :: xchange
+
+    part(ipart)%xlon = part(ipart)%xlon + real(xchange,kind=dp)
+
+  end subroutine update_xlon_int
diff --git a/src/par_update_xlon_sp.f90 b/src/par_update_xlon_sp.f90
new file mode 100644
index 0000000000000000000000000000000000000000..794acc9f234c56d93506299c1f31752a72f135ea
--- /dev/null
+++ b/src/par_update_xlon_sp.f90
@@ -0,0 +1,15 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+  subroutine update_xlon_sp(ipart,xchange)
+
+    !**************************************
+    ! Updates the longitude of the particle
+    !**************************************
+
+    integer, intent(in)    :: ipart   ! particle index
+    real, intent(in) :: xchange
+
+    part(ipart)%xlon = part(ipart)%xlon + real(xchange,kind=dp)
+
+  end subroutine update_xlon_sp
diff --git a/src/par_update_ylat_dp.f90 b/src/par_update_ylat_dp.f90
new file mode 100644
index 0000000000000000000000000000000000000000..ea71304d907ba7b94c9198915dea91d206ac95ed
--- /dev/null
+++ b/src/par_update_ylat_dp.f90
@@ -0,0 +1,15 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+  subroutine update_ylat_dp(ipart,ychange)
+
+    !**************************************
+    ! Updates the latitude of the particle
+    !**************************************
+
+    integer, intent(in)       ::  ipart  ! particle index
+    real(kind=dp), intent(in) :: ychange
+
+    part(ipart)%ylat = part(ipart)%ylat + ychange
+
+  end subroutine update_ylat_dp
diff --git a/src/par_update_ylat_int.f90 b/src/par_update_ylat_int.f90
new file mode 100644
index 0000000000000000000000000000000000000000..e32302534dfa9cdb6b05587016a4229a807060cd
--- /dev/null
+++ b/src/par_update_ylat_int.f90
@@ -0,0 +1,15 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+  subroutine update_ylat_int(ipart,ychange)
+
+    !**************************************
+    ! Updates the latitude of the particle
+    !**************************************
+
+    integer, intent(in)    :: ipart       ! particle index
+    integer, intent(in)    :: ychange
+
+    part(ipart)%ylat = part(ipart)%ylat + real(ychange,kind=dp)
+
+  end subroutine update_ylat_int
diff --git a/src/par_update_ylat_sp.f90 b/src/par_update_ylat_sp.f90
new file mode 100644
index 0000000000000000000000000000000000000000..64def0d8b3686f4eba54e3d9ab484f2de48a07b0
--- /dev/null
+++ b/src/par_update_ylat_sp.f90
@@ -0,0 +1,15 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+  subroutine update_ylat_sp(ipart,ychange)
+
+    !**************************************
+    ! Updates the latitude of the particle
+    !**************************************
+
+    integer, intent(in)    :: ipart       ! particle index
+    real, intent(in) :: ychange
+
+    part(ipart)%ylat = part(ipart)%ylat + real(ychange,kind=dp)
+
+  end subroutine update_ylat_sp
diff --git a/src/par_update_z_dp.f90 b/src/par_update_z_dp.f90
new file mode 100644
index 0000000000000000000000000000000000000000..7e38ed8c2d18df36cd84effb93fc57fd81d064ef
--- /dev/null
+++ b/src/par_update_z_dp.f90
@@ -0,0 +1,17 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+  subroutine update_z_dp(ipart,zchange)
+
+    !**************************************
+    ! Updates the height of the particle
+    !**************************************
+
+    integer, intent(in)        :: ipart       ! particle index
+    real(kind=dp), intent(in)  :: zchange
+
+    part(ipart)%z = part(ipart)%z + zchange
+    part(ipart)%meterupdate=.false.
+    part(ipart)%etaupdate=.true.
+
+  end subroutine update_z_dp
diff --git a/src/par_update_z_sp.f90 b/src/par_update_z_sp.f90
new file mode 100644
index 0000000000000000000000000000000000000000..879f38d9a2ea3d733f7c66e5bd8969bafd6a08bf
--- /dev/null
+++ b/src/par_update_z_sp.f90
@@ -0,0 +1,17 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+  subroutine update_z_sp(ipart,zchange)
+
+    !**************************************
+    ! Updates the height of the particle
+    !**************************************
+
+    integer, intent(in)    :: ipart       ! particle index
+    real, intent(in)       :: zchange
+
+    part(ipart)%z = part(ipart)%z + real(zchange,kind=dp)
+    part(ipart)%meterupdate=.false.
+    part(ipart)%etaupdate=.true.
+
+  end subroutine update_z_sp
diff --git a/src/par_update_zeta_dp.f90 b/src/par_update_zeta_dp.f90
new file mode 100644
index 0000000000000000000000000000000000000000..058c989b15f3a39c811e4f41ef9cda02d36c3912
--- /dev/null
+++ b/src/par_update_zeta_dp.f90
@@ -0,0 +1,17 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+  subroutine update_zeta_dp(ipart,zchange)
+
+    !**************************************
+    ! Updates the height of the particle
+    !**************************************
+
+    integer, intent(in)        :: ipart       ! particle index
+    real(kind=dp), intent(in)  :: zchange
+
+    part(ipart)%zeta = part(ipart)%zeta + zchange
+    part(ipart)%etaupdate=.false.
+    part(ipart)%meterupdate=.true.
+
+  end subroutine update_zeta_dp
diff --git a/src/par_update_zeta_sp.f90 b/src/par_update_zeta_sp.f90
new file mode 100644
index 0000000000000000000000000000000000000000..5f21930bb565cae6dd2c01093667a1f16acc184f
--- /dev/null
+++ b/src/par_update_zeta_sp.f90
@@ -0,0 +1,17 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+  subroutine update_zeta_sp(ipart,zchange)
+
+    !**************************************
+    ! Updates the height of the particle
+    !**************************************
+
+    integer, intent(in)    :: ipart       ! particle index
+    real, intent(in)       :: zchange
+
+    part(ipart)%zeta = part(ipart)%zeta + real(zchange,kind=dp)
+    part(ipart)%etaupdate=.false.
+    part(ipart)%meterupdate=.true.
+
+  end subroutine update_zeta_sp
diff --git a/src/particle_mod.f90 b/src/particle_mod.f90
index 0696063a3e9965d488b5214ef1757f99aa4099e0..407e91df0008e1a67347befef8dfbdf42d42bc6a 100644
--- a/src/particle_mod.f90
+++ b/src/particle_mod.f90
@@ -15,7 +15,7 @@ module particle_mod
   use par_mod, only: dp
 
   implicit none
-  
+
   type :: coordinates
     real(kind=dp) ::              &
       xlon,                       & ! longitude in grid coordinates
@@ -57,7 +57,7 @@ module particle_mod
       meterupdate=.false., & ! If false, z(eta) is more up-to-date than z(meter)
       nstop=.false.!Flag stopping particle, used in advance, stop in timemanager
     integer(kind=2)    ::         &
-      icbt                          ! Forbidden state flag   
+      icbt                          ! Forbidden state flag
     integer            ::         &
       tstart,                     & ! spawning time in seconds after start
       tend,                       & ! termination time in seconds after start
@@ -71,7 +71,7 @@ module particle_mod
       wetdepo(maxspec)=0.,        & ! Wet deposition (cumulative)
       drydepo(maxspec)=0.,        & ! Dry deposition (cumulative)
       prob(maxspec)  ! Probability of absorption at ground due to dry deposition
-    
+
     real,allocatable   ::         &
       val_av(:)         ! Averaged values; only used when average_output=.true.
     real               ::         &
@@ -82,7 +82,7 @@ module particle_mod
 
   end type particle
 
-  type :: particlecount          
+  type :: particlecount
     integer              ::       &
       alive=0,                    & ! Number of particles that are alive
       spawned=0,                  & ! Total number of spawned particles
@@ -104,7 +104,7 @@ module particle_mod
   integer,allocatable         ::  &
     nclust(:)                       ! Only allocated for iout=4 or 5 (plumetraj)
   ! private ::                      &
-  !   count             
+  !   count
   public ::                       &
     particle,                     &
     part,                         &
@@ -155,547 +155,84 @@ module particle_mod
   interface set_zeta
     procedure set_zeta_dp,set_zeta_sp
   end interface set_zeta
-   
-contains
-
-  logical function particle_allocated(ipart)
-
-    !******************************************
-    ! Checks if the memory of the particle is *
-    ! still allocated                         *
-    !******************************************
-
-    integer, intent(in)    ::  ipart      ! particle index
-    !logical :: particle_allocated
-    
-    if (ipart.gt.count%allocated) then
-      particle_allocated = .false.
-    else
-      particle_allocated = count%inmem(ipart)
-    endif
-
-  end function particle_allocated
-
-  subroutine get_newpart_index(ipart)
-
-    !**************************************************
-    ! Returns the first free spot to put a new particle
-    !**************************************************
-
-    integer, intent(inout) :: ipart                     ! First free index
-
-    ipart = count%spawned + 1
-
-  end subroutine get_newpart_index
-
-  subroutine get_totalpart_num(npart)
-
-    !********************************************
-    ! Returns total number of particles spawned *
-    !********************************************
-
-    integer, intent(inout) :: npart                     ! Number of particles
-
-    npart = count%spawned
-
-  end subroutine get_totalpart_num
-
-  subroutine get_alivepart_num(npart)
-
-    !**********************************************
-    ! Returns number of particles currently alive *
-    !**********************************************
-
-    integer, intent(inout) :: npart                     ! Number of particles
-
-    npart = count%alive
-
-  end subroutine get_alivepart_num
-
-  subroutine spawn_particles(itime, nmpart)
-
-    !******************************************************
-    ! This routine spawns new particles and allocates the 
-    ! memory if necessary.
-    !******************************************************
-
-    integer, intent(in) :: itime   ! spawning time
-    integer, intent(in) :: nmpart  ! number of particles that are being spawned
-
-  ! Check if new memory needs to be allocated 
-    if (nmpart + count%spawned .gt. count%allocated) &
-      call alloc_particles( (nmpart + count%spawned) - count%allocated )
-
-  ! Update the number of particles that are currently alive
-    count%alive = count%alive + nmpart
-
-  ! Set the spawning time for each new particle and mark it as alive
-    part(count%spawned + 1 : count%spawned + nmpart)%tstart = itime
-    part(count%spawned + 1 : count%spawned + nmpart)%alive = .true.
-
-  ! Update the total number of spawned particles
-    count%spawned = count%spawned + nmpart
-
-  end subroutine spawn_particles
-
-  subroutine spawn_particle(itime, ipart)
-
-    !******************************************************
-    ! This routine spawns new particles and allocates the 
-    ! memory if necessary.
-    !******************************************************
-
-    integer, intent(in) :: itime   ! spawning time
-    integer, intent(in) :: ipart   ! number of particles that are being spawned
-
-  ! Check if new memory needs to be allocated 
-    if (.not. particle_allocated(ipart)) call alloc_particle(ipart)
-
-    if (part(ipart)%alive) stop 'Attempting to overwrite existing particle'
 
-  ! Update the number of particles that are currently alive
-    count%alive = count%alive + 1
-
-  ! Set the spawning time for each new particle and mark it as alive
-    part(ipart)%tstart = itime
-    part(ipart)%alive = .true.
-
-  ! Update the total number of spawned particles
-    count%spawned = count%spawned + 1
-    
-  end subroutine spawn_particle
-
-  subroutine terminate_particle(ipart,itime)
-
-    !*****************************************************
-    ! Terminating specified particle
-    ! This routine terminates a selected particle
-    !***************************************************** 
-
-    integer, intent(in) :: ipart ! to be terminated particle index
-    integer, intent(in) :: itime ! Time at which particle is terminated
-
-  ! Flagging the particle as having been terminated
-    part(ipart)%alive=.false.
-    part(ipart)%tend=itime
-
-  ! Update the number of current particles that are alive
-    count%alive = count%alive - 1
-
-  ! Update the total number of terminated particles during the whole run
-    count%terminated = count%terminated + 1
-
-  end subroutine terminate_particle
- 
-  subroutine alloc_particles(nmpart)
-
-    integer, intent(in) :: nmpart
-    
-    integer, allocatable ::       tmpnclust(:)
-    logical, allocatable ::       tmpcount(:)
-    type(particle),allocatable :: tmppart(:)
-    real, allocatable ::          tmpxscav(:,:)
-    real, allocatable ::          tmpxl(:),tmpyl(:),tmpzl(:)
-    integer :: i
-
-    if (nmpart.gt.100) write(*,*) 'Allocating ',nmpart,' particles'
-
-   ! Keeping track of the allocated memory in case 
-   ! there is a reason for deallocating some of it
-    allocate( tmpcount(count%allocated + nmpart) )
-    if (count%allocated.gt.0) tmpcount(1:count%allocated) = count%inmem
-    call move_alloc(tmpcount,count%inmem)
-    count%inmem(count%allocated + 1 : count%allocated + nmpart) = .true.
-
-    ! Allocating new particle spaces
-    !*******************************
-
-    allocate( tmppart(count%allocated + nmpart) )
-    if (n_average.gt.0) then 
-      do i=1,count%allocated + nmpart
-        allocate( tmppart(i)%val_av(n_average) )
-        tmppart(i)%val_av = 0
-      end do
-    endif
-    if (count%allocated.gt.0) tmppart(1:count%allocated) = part
-    call move_alloc(tmppart,part)
-
-   ! If wet or dry deposition backward mode is switched on, xscav_frac1
-   ! needs to be allocated
-    if (wetbkdep.or.drybkdep) then
-      allocate( tmpxscav(count%allocated + nmpart,maxspec) )
-      if (count%allocated.gt.0) tmpxscav(1:count%allocated,:) = xscav_frac1
-      call move_alloc(tmpxscav,xscav_frac1)
-    endif
-
-    if (iout.eq.4 .or. iout.eq.5) then
-      allocate( tmpxl(count%allocated + nmpart) )
-      if (count%allocated.gt.0) tmpxl(1:count%allocated) = xplum
-      call move_alloc(tmpxl,xplum)
-      
-      allocate( tmpyl(count%allocated +nmpart) )
-      if (count%allocated.gt.0) tmpyl(1:count%allocated) = yplum
-      call move_alloc(tmpyl,yplum)
-
-      allocate( tmpzl(count%allocated+nmpart) )
-      if (count%allocated.gt.0) tmpzl(1:count%allocated) = zplum
-      call move_alloc(tmpzl,zplum)
-
-      allocate( tmpnclust(count%allocated + nmpart) )
-      if (count%allocated.gt.0) tmpnclust(1:count%allocated) = nclust
-      call move_alloc(tmpnclust,nclust)
-    endif
-
-    count%allocated = count%allocated + nmpart
-    if (nmpart.gt.100) write(*,*) 'Finished allocation'
-    
-  end subroutine alloc_particles
-
-  subroutine alloc_particle(ipart)
-
-    implicit none 
-
-    integer, intent(in) :: ipart
-
-  ! Keeping track of the allocated memory in case 
-  ! there is a reason for deallocating some of it
-    if (ipart.gt.count%allocated) then 
-      call alloc_particles(ipart-count%allocated)
-    else
-      stop 'Error: You are trying to allocate an already existing particle'
-    endif
-
-  end subroutine alloc_particle
+contains
 
-  subroutine dealloc_particle_range(istart,iend)
+#include "par_particle_allocated.f90"
 
-    integer, intent(in) :: istart,iend
+#include "par_get_newpart_index.f90"
 
-    !deallocate( part(istart:iend) )
-    count%inmem(istart:iend) = .false.
+#include "par_get_totalpart_num.f90"
 
-  end subroutine dealloc_particle_range
+#include "par_get_alivepart_num.f90"
 
-  subroutine dealloc_particle(ipart)
+#include "par_spawn_particles.f90"
 
-    integer, intent(in) :: ipart ! particle index
+#include "par_spawn_particle.f90"
 
-    !deallocate( part(ipart) )
-    part = part(1:ipart) ! FORTRAN 2008 only
-    count%inmem(ipart+1:) = .false.
+#include "par_terminate_particle.f90"
 
-  end subroutine dealloc_particle
-
-  subroutine dealloc_all_particles()
+#include "par_alloc_particles.f90"
 
-    integer :: i
-
-    if (n_average.gt.0) then 
-      do i=1,count%allocated
-        deallocate( part(i)%val_av )
-      end do
-    endif
-    deallocate( part )
-    deallocate( count%inmem )
+#include "par_alloc_particle.f90"
 
-    if (wetbkdep.or.drybkdep) deallocate( xscav_frac1 )
+#include "par_dealloc_particle_range.f90"
 
-    if (iout.eq.4 .or. iout.eq.5) then
-      deallocate( xplum )
-      deallocate( yplum )
-      deallocate( zplum )
-      deallocate( nclust )
-    endif
+#include "par_dealloc_particle.f90"
 
-  end subroutine dealloc_all_particles
+#include "par_dealloc_all_particles.f90"
 
 ! Update_xlon
-  subroutine update_xlon_dp(ipart,xchange)
-
-    !**************************************
-    ! Updates the longitude of the particle
-    !**************************************
-
-    integer, intent(in)    :: ipart   ! particle index
-    real(kind=dp), intent(in) :: xchange
-
-    part(ipart)%xlon = part(ipart)%xlon + xchange
-
-  end subroutine update_xlon_dp
-
-  subroutine update_xlon_sp(ipart,xchange)
-
-    !**************************************
-    ! Updates the longitude of the particle
-    !**************************************
-
-    integer, intent(in)    :: ipart   ! particle index
-    real, intent(in) :: xchange
-
-    part(ipart)%xlon = part(ipart)%xlon + real(xchange,kind=dp)
-
-  end subroutine update_xlon_sp
-
-  subroutine update_xlon_int(ipart,xchange)
+#include "par_update_xlon_dp.f90"
 
-    !**************************************
-    ! Updates the longitude of the particle
-    !**************************************
+#include "par_update_xlon_sp.f90"
 
-    integer, intent(in)    :: ipart    ! particle index
-    integer, intent(in) :: xchange
-
-    part(ipart)%xlon = part(ipart)%xlon + real(xchange,kind=dp)
-
-  end subroutine update_xlon_int
+#include "par_update_xlon_int.f90"
 ! End Update_xlon
 
 ! Set_xlon
-  subroutine set_xlon_dp(ipart,xvalue)
-
-    !**************************************
-    ! Sets the longitude of the particle
-    !**************************************
-
-    integer, intent(in)    :: ipart    ! particle index
-    real(kind=dp), intent(in) :: xvalue
-
-    part(ipart)%xlon = xvalue
-
-  end subroutine set_xlon_dp
-
-  subroutine set_xlon_sp(ipart,xvalue)
-
-    !**************************************
-    ! Sets the longitude of the particle
-    !**************************************
-
-    integer, intent(in)    :: ipart    ! particle index
-    real, intent(in)       :: xvalue
+#include "par_set_xlon_dp.f90"
 
-    part(ipart)%xlon = real(xvalue,kind=dp)
+#include "par_set_xlon_sp.f90"
 
-  end subroutine set_xlon_sp
-
-  subroutine set_xlon_int(ipart,xvalue)
-
-    !**************************************
-    ! Sets the longitude of the particle
-    !**************************************
-
-    integer, intent(in)    :: ipart    ! particle index
-    integer, intent(in)    :: xvalue
-
-    part(ipart)%xlon = real(xvalue,kind=dp)
-
-  end subroutine set_xlon_int
-! End Set_xlon 
+#include "par_set_xlon_int.f90"
+! End Set_xlon
 
 ! Update_ylat
 
-  subroutine update_ylat_dp(ipart,ychange)
-
-    !**************************************
-    ! Updates the latitude of the particle
-    !**************************************
-
-    integer, intent(in)       ::  ipart  ! particle index
-    real(kind=dp), intent(in) :: ychange
-
-    part(ipart)%ylat = part(ipart)%ylat + ychange
-
-  end subroutine update_ylat_dp
+#include "par_update_ylat_dp.f90"
 
-  subroutine update_ylat_sp(ipart,ychange)
+#include "par_update_ylat_sp.f90"
 
-    !**************************************
-    ! Updates the latitude of the particle
-    !**************************************
-
-    integer, intent(in)    :: ipart       ! particle index
-    real, intent(in) :: ychange
-
-    part(ipart)%ylat = part(ipart)%ylat + real(ychange,kind=dp)
-
-  end subroutine update_ylat_sp
-
-  subroutine update_ylat_int(ipart,ychange)
-
-    !**************************************
-    ! Updates the latitude of the particle
-    !**************************************
-
-    integer, intent(in)    :: ipart       ! particle index
-    integer, intent(in)    :: ychange
-
-    part(ipart)%ylat = part(ipart)%ylat + real(ychange,kind=dp)
-
-  end subroutine update_ylat_int
+#include "par_update_ylat_int.f90"
 ! End Update_ylat
 
 ! Set_ylat
-  subroutine set_ylat_dp(ipart,yvalue)
-
-    !**************************************
-    ! Sets the latitude of the particle
-    !**************************************
-
-    integer, intent(in)       :: ipart       ! particle index
-    real(kind=dp), intent(in) :: yvalue
-
-    part(ipart)%ylat = yvalue
-
-  end subroutine set_ylat_dp
-
-  subroutine set_ylat_sp(ipart,yvalue)
-
-    !**************************************
-    ! Sets the latitude of the particle
-    !**************************************
-
-    integer, intent(in)    :: ipart       ! particle index
-    real, intent(in)       :: yvalue
-
-    part(ipart)%ylat = real(yvalue,kind=dp)
-
-  end subroutine set_ylat_sp
+#include "par_set_ylat_dp.f90"
 
-  subroutine set_ylat_int(ipart,yvalue)
+#include "par_set_ylat_sp.f90"
 
-    !**************************************
-    ! Sets the latitude of the particle
-    !**************************************
-
-    integer, intent(in)    :: ipart       ! particle index
-    integer, intent(in) :: yvalue
-
-    part(ipart)%ylat = real(yvalue,kind=dp)
-
-  end subroutine set_ylat_int
+#include "par_set_ylat_int.f90"
 ! End Set_ylat
 
 ! Update z positions
-  subroutine update_z_dp(ipart,zchange)
-
-    !**************************************
-    ! Updates the height of the particle
-    !**************************************
-
-    integer, intent(in)        :: ipart       ! particle index
-    real(kind=dp), intent(in)  :: zchange
-
-    part(ipart)%z = part(ipart)%z + zchange
-    part(ipart)%meterupdate=.false.
-    part(ipart)%etaupdate=.true.
-
-  end subroutine update_z_dp
-
-  subroutine update_z_sp(ipart,zchange)
-
-    !**************************************
-    ! Updates the height of the particle
-    !**************************************
-
-    integer, intent(in)    :: ipart       ! particle index
-    real, intent(in)       :: zchange
-
-    part(ipart)%z = part(ipart)%z + real(zchange,kind=dp)
-    part(ipart)%meterupdate=.false.
-    part(ipart)%etaupdate=.true.
-
-  end subroutine update_z_sp  
-
-  subroutine update_zeta_dp(ipart,zchange)
-
-    !**************************************
-    ! Updates the height of the particle
-    !**************************************
-
-    integer, intent(in)        :: ipart       ! particle index
-    real(kind=dp), intent(in)  :: zchange
-
-    part(ipart)%zeta = part(ipart)%zeta + zchange
-    part(ipart)%etaupdate=.false.
-    part(ipart)%meterupdate=.true.
-
-  end subroutine update_zeta_dp
+#include "par_update_z_dp.f90"
 
-  subroutine update_zeta_sp(ipart,zchange)
+#include "par_update_z_sp.f90"
 
-    !**************************************
-    ! Updates the height of the particle
-    !**************************************
+#include "par_update_zeta_dp.f90"
 
-    integer, intent(in)    :: ipart       ! particle index
-    real, intent(in)       :: zchange
-
-    part(ipart)%zeta = part(ipart)%zeta + real(zchange,kind=dp)
-    part(ipart)%etaupdate=.false.
-    part(ipart)%meterupdate=.true.
-
-  end subroutine update_zeta_sp
+#include "par_update_zeta_sp.f90"
 ! End update z positions
 
 ! Update z positions
-  subroutine set_z_dp(ipart,zvalue)
-
-    !**************************************
-    ! Updates the height of the particle
-    !**************************************
-
-    integer, intent(in)        :: ipart       ! particle index
-    real(kind=dp), intent(in)  :: zvalue
-
-    part(ipart)%z = zvalue
-    part(ipart)%meterupdate=.false.
-    part(ipart)%etaupdate=.true.
-
-  end subroutine set_z_dp  
-
-  subroutine set_z_sp(ipart,zvalue)
-
-    !**************************************
-    ! Updates the height of the particle
-    !**************************************
-
-    integer, intent(in)    :: ipart       ! particle index
-    real, intent(in)       :: zvalue
-
-    part(ipart)%z = real(zvalue,kind=dp)
-    part(ipart)%meterupdate=.false.
-    part(ipart)%etaupdate=.true.
-
-  end subroutine set_z_sp
-
-  subroutine set_zeta_dp(ipart,zvalue)
-
-    !**************************************
-    ! Updates the height of the particle
-    !**************************************
-
-    integer, intent(in)        :: ipart       ! particle index
-    real(kind=dp), intent(in)  :: zvalue
-
-    part(ipart)%zeta = zvalue
-    part(ipart)%etaupdate=.false.
-    part(ipart)%meterupdate=.true.
-    
-  end subroutine set_zeta_dp
-
-  subroutine set_zeta_sp(ipart,zvalue)
-
-    !**************************************
-    ! Updates the height of the particle
-    !**************************************
+#include "par_set_z_dp.f90"
 
-    integer, intent(in)    :: ipart       ! particle index
-    real, intent(in)       :: zvalue
+#include "par_set_z_sp.f90"
 
-    part(ipart)%zeta = real(zvalue,kind=dp)
-    part(ipart)%etaupdate=.false.
-    part(ipart)%meterupdate=.true.
+#include "par_set_zeta_dp.f90"
 
-  end subroutine set_zeta_sp
+#include "par_set_zeta_sp.f90"
 ! End update z positions
 
 end module particle_mod
diff --git a/src/plu_centerofmass.f90 b/src/plu_centerofmass.f90
new file mode 100644
index 0000000000000000000000000000000000000000..f674f34440ee15c5b13e04126045191f1f52b7c7
--- /dev/null
+++ b/src/plu_centerofmass.f90
@@ -0,0 +1,70 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine centerofmass(xl,yl,n,xcenter,ycenter)
+  !                        i  i  i    o       o
+  !*****************************************************************************
+  !                                                                            *
+  !   This routine calculates the center of mass of n points on the Earth.     *
+  !   Input are the longitudes (xl) and latitudes (yl) of the individual       *
+  !   points, output is the longitude and latitude of the centre of mass.      *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     24 January 2002                                                        *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+
+  implicit none
+
+  integer :: n,l
+  real :: xl(n),yl(n),xll,yll,xav,yav,zav,x,y,z,xcenter,ycenter
+
+
+  xav=0.
+  yav=0.
+  zav=0.
+
+  do l=1,n
+
+  ! Convert longitude and latitude from degrees to radians
+  !*******************************************************
+
+    xll=xl(l)*pi180
+    yll=yl(l)*pi180
+
+  ! Calculate 3D coordinates from longitude and latitude
+  !*****************************************************
+
+    x = cos(yll)*sin(xll)
+    y = -1.*cos(yll)*cos(xll)
+    z = sin(yll)
+
+
+  ! Find the mean location in Cartesian coordinates
+  !************************************************
+
+    xav=xav+x
+    yav=yav+y
+    zav=zav+z
+  end do
+
+  xav=xav/real(n)
+  yav=yav/real(n)
+  zav=zav/real(n)
+
+
+  ! Project the point back onto Earth's surface
+  !********************************************
+
+  xcenter=atan2(xav,-1.*yav)
+  ycenter=atan2(zav,sqrt(xav*xav+yav*yav))
+
+  ! Convert back to degrees
+  !************************
+
+  xcenter=xcenter/pi180
+  ycenter=ycenter/pi180
+end subroutine centerofmass
diff --git a/src/plu_clustering.f90 b/src/plu_clustering.f90
new file mode 100644
index 0000000000000000000000000000000000000000..74e9a0c0a1e9840a471e0978649321e1fb1dcda5
--- /dev/null
+++ b/src/plu_clustering.f90
@@ -0,0 +1,191 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine clustering(n,xclust,yclust,zclust,fclust,rms, &
+       rmsclust,zrms)
+  !                      i  i  i  i   o      o      o      o     o
+  !   o      o
+  !*****************************************************************************
+  !                                                                            *
+  !   This routine clusters the particle position into ncluster custers.       *
+  !   Input are the longitudes (xl) and latitudes (yl) of the individual       *
+  !   points, output are the cluster mean positions (xclust,yclust).           *
+  !   Vertical positions are not directly used for the clustering.             *
+  !                                                                            *
+  !   For clustering, the procedure described in Dorling et al. (1992) is used.*
+  !                                                                            *
+  !   Dorling, S.R., Davies, T.D. and Pierce, C.E. (1992):                     *
+  !   Cluster analysis: a technique for estimating the synoptic meteorological *
+  !   controls on air and precipitation chemistry - method and applications.   *
+  !   Atmospheric Environment 26A, 2575-2581.                                  *
+  !                                                                            *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     1 February 2002                                                        *
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! fclust          fraction of particles belonging to each cluster            *
+  ! ncluster        number of clusters to be used                              *
+  ! rms             total horizontal rms distance after clustering             *
+  ! rmsclust        horizontal rms distance for each individual cluster        *
+  ! zrms            total vertical rms distance after clustering               *
+  ! xclust,yclust,  Cluster centroid positions                                 *
+  ! zclust                                                                     *
+  ! xl,yl,zl        particle positions                                         *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use particle_mod
+
+  implicit none
+
+  integer :: n,i,j,l,numb(ncluster),ncl
+  real :: xclust(ncluster),yclust(ncluster),x,y,z
+  real :: zclust(ncluster),distances,distancemin,rms,rmsold
+  real :: xav(ncluster),yav(ncluster),zav(ncluster),fclust(ncluster)
+  real :: rmsclust(ncluster)
+  real :: zdist,zrms
+
+
+
+  if (n.lt.ncluster) return
+  rmsold=-5.
+
+  ! Convert longitude and latitude from degrees to radians
+  !*******************************************************
+
+  do i=1,n
+    nclust(i)=i
+    xplum(i)=xplum(i)*pi180
+    yplum(i)=yplum(i)*pi180
+  end do
+
+
+  ! Generate a seed for each cluster
+  !*********************************
+
+  do j=1,ncluster
+    zclust(j)=0.
+    xclust(j)=xplum(j*n/ncluster)
+    yclust(j)=yplum(j*n/ncluster)
+  end do
+
+
+  ! Iterative loop to compute the cluster means
+  !********************************************
+
+  do l=1,100
+
+  ! Assign each particle to a cluster: criterion minimum distance to the
+  ! cluster mean position
+  !*********************************************************************
+
+
+    do i=1,n
+      distancemin=10.**10.
+      do j=1,ncluster
+        distances=distance2(yplum(i),xplum(i),yclust(j),xclust(j))
+        if (distances.lt.distancemin) then
+          distancemin=distances
+          ncl=j
+        endif
+      end do
+      nclust(i)=ncl
+    end do
+
+
+  ! Recalculate the cluster centroid position: convert to 3D Cartesian coordinates,
+  ! calculate mean position, and re-project this point onto the Earth's surface
+  !*****************************************************************************
+
+    do j=1,ncluster
+      xav(j)=0.
+      yav(j)=0.
+      zav(j)=0.
+      rmsclust(j)=0.
+      numb(j)=0
+    end do
+    rms=0.
+
+    do i=1,n
+      numb(nclust(i))=numb(nclust(i))+1
+      distances=distance2(yplum(i),xplum(i), &
+           yclust(nclust(i)),xclust(nclust(i)))
+
+  ! rms is the total rms of all particles
+  ! rmsclust is the rms for a particular cluster
+  !*********************************************
+
+      rms=rms+distances*distances
+      rmsclust(nclust(i))=rmsclust(nclust(i))+distances*distances
+
+  ! Calculate Cartesian 3D coordinates from longitude and latitude
+  !***************************************************************
+
+      x = cos(yplum(i))*sin(xplum(i))
+      y = -1.*cos(yplum(i))*cos(xplum(i))
+      z = sin(yplum(i))
+      xav(nclust(i))=xav(nclust(i))+x
+      yav(nclust(i))=yav(nclust(i))+y
+      zav(nclust(i))=zav(nclust(i))+z
+    end do
+
+    rms=sqrt(rms/real(n))
+
+
+  ! Find the mean location in Cartesian coordinates
+  !************************************************
+
+    do j=1,ncluster
+      if (numb(j).gt.0) then
+        rmsclust(j)=sqrt(rmsclust(j)/real(numb(j)))
+        xav(j)=xav(j)/real(numb(j))
+        yav(j)=yav(j)/real(numb(j))
+        zav(j)=zav(j)/real(numb(j))
+
+  ! Project the point back onto Earth's surface
+  !********************************************
+
+        xclust(j)=atan2(xav(j),-1.*yav(j))
+        yclust(j)=atan2(zav(j),sqrt(xav(j)*xav(j)+yav(j)*yav(j)))
+      endif
+    end do
+
+
+  ! Leave the loop if the RMS distance decreases only slightly between 2 iterations
+  !*****************************************************************************
+
+    if ((l.gt.1).and.(abs(rms-rmsold)/rmsold.lt.0.005)) exit
+    rmsold=rms
+
+  end do
+
+  ! Convert longitude and latitude from radians to degrees
+  !*******************************************************
+
+  do i=1,n
+    xplum(i)=xplum(i)/pi180
+    yplum(i)=yplum(i)/pi180
+    zclust(nclust(i))=zclust(nclust(i))+zplum(i)
+  end do
+
+  do j=1,ncluster
+    xclust(j)=xclust(j)/pi180
+    yclust(j)=yclust(j)/pi180
+    if (numb(j).gt.0) zclust(j)=zclust(j)/real(numb(j))
+    fclust(j)=100.*real(numb(j))/real(n)
+  end do
+
+  ! Determine total vertical RMS deviation
+  !***************************************
+
+  zrms=0.
+  do i=1,n
+    zdist=zplum(i)-zclust(nclust(i))
+    zrms=zrms+zdist*zdist
+  end do
+  if (zrms.gt.0.) zrms=sqrt(zrms/real(n))
+
+end subroutine clustering
diff --git a/src/plu_distance.f90 b/src/plu_distance.f90
new file mode 100644
index 0000000000000000000000000000000000000000..5b552109647abce12a42a536bd65df1563399bdd
--- /dev/null
+++ b/src/plu_distance.f90
@@ -0,0 +1,55 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+real function distance(rlat1,rlon1,rlat2,rlon2)
+
+  !$$$  SUBPROGRAM DOCUMENTATION BLOCK
+  !
+  ! SUBPROGRAM:  GCDIST     COMPUTE GREAT CIRCLE DISTANCE
+  !   PRGMMR: IREDELL       ORG: W/NMC23       DATE: 96-04-10
+  !
+  ! ABSTRACT: THIS SUBPROGRAM COMPUTES GREAT CIRCLE DISTANCE
+  !      BETWEEN TWO POINTS ON THE EARTH.
+  !
+  ! PROGRAM HISTORY LOG:
+  !   96-04-10  IREDELL
+  !
+  ! USAGE:    ...GCDIST(RLAT1,RLON1,RLAT2,RLON2)
+  !
+  !   INPUT ARGUMENT LIST:
+  !rlat1    - REAL LATITUDE OF POINT 1 IN DEGREES
+  !rlon1    - REAL LONGITUDE OF POINT 1 IN DEGREES
+  !rlat2    - REAL LATITUDE OF POINT 2 IN DEGREES
+  !rlon2    - REAL LONGITUDE OF POINT 2 IN DEGREES
+  !
+  !   OUTPUT ARGUMENT LIST:
+  !distance - REAL GREAT CIRCLE DISTANCE IN KILOMETERS
+  !
+  ! ATTRIBUTES:
+  !   LANGUAGE: Fortran 90
+  !
+  !$$$
+
+  use par_mod, only: dp
+
+  implicit none
+
+  real          :: rlat1,rlon1,rlat2,rlon2
+  real(kind=dp) :: clat1,clat2,slat1,slat2,cdlon,crd
+  real(kind=dp),parameter :: rerth=6.3712e6_dp
+  real(kind=dp),parameter :: pi=3.14159265358979_dp, dpr=180.0_dp/pi
+  ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  if ((abs(rlat1-rlat2).lt.0.03).and. &
+       (abs(rlon1-rlon2).lt.0.03)) then
+    distance=0.
+  else
+    clat1=cos(real(rlat1,kind=dp)/dpr)
+    slat1=sin(real(rlat1,kind=dp)/dpr)
+    clat2=cos(real(rlat2,kind=dp)/dpr)
+    slat2=sin(real(rlat2,kind=dp)/dpr)
+    cdlon=cos(real((rlon1-rlon2),kind=dp)/dpr)
+    crd=slat1*slat2+clat1*clat2*cdlon
+    distance=real(rerth*acos(crd)/1000.0_dp)
+  endif
+  ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+end function distance
diff --git a/src/plu_distance2.f90 b/src/plu_distance2.f90
new file mode 100644
index 0000000000000000000000000000000000000000..91bdca933c008ffc6dc0b43865ebad2a2945a60a
--- /dev/null
+++ b/src/plu_distance2.f90
@@ -0,0 +1,57 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+real function distance2(rlat1,rlon1,rlat2,rlon2)
+
+  !$$$  SUBPROGRAM DOCUMENTATION BLOCK
+  !
+  ! SUBPROGRAM:  GCDIST     COMPUTE GREAT CIRCLE DISTANCE
+  !   PRGMMR: IREDELL       ORG: W/NMC23       DATE: 96-04-10
+  !
+  ! ABSTRACT: THIS SUBPROGRAM COMPUTES GREAT CIRCLE DISTANCE
+  !      BETWEEN TWO POINTS ON THE EARTH. COORDINATES ARE GIVEN IN RADIANS!
+  !
+  ! PROGRAM HISTORY LOG:
+  !   96-04-10  IREDELL
+  !
+  ! USAGE:    ...GCDIST(RLAT1,RLON1,RLAT2,RLON2)
+  !
+  !   INPUT ARGUMENT LIST:
+  !rlat1    - REAL LATITUDE OF POINT 1 IN RADIANS
+  !rlon1    - REAL LONGITUDE OF POINT 1 IN RADIANS
+  !rlat2    - REAL LATITUDE OF POINT 2 IN RADIANS
+  !rlon2    - REAL LONGITUDE OF POINT 2 IN RADIANS
+  !
+  !   OUTPUT ARGUMENT LIST:
+  !distance2   - REAL GREAT CIRCLE DISTANCE IN KM
+  !
+  ! ATTRIBUTES:
+  !   LANGUAGE: Fortran 90
+  !
+  !$$$
+
+  use par_mod, only: dp
+
+  implicit none
+
+  real                    :: rlat1,rlon1,rlat2,rlon2
+  real(kind=dp)           :: clat1,clat2,slat1,slat2,cdlon,crd
+  real(kind=dp),parameter :: rerth=6.3712e6_dp
+  real(kind=dp),parameter :: pi=3.14159265358979_dp
+
+  if ((abs(rlat1-rlat2).lt.0.0003).and. &
+       (abs(rlon1-rlon2).lt.0.0003)) then
+    distance2=0.0_dp
+  else
+
+  ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    clat1=cos(real(rlat1,kind=dp))
+    slat1=sin(real(rlat1,kind=dp))
+    clat2=cos(real(rlat2,kind=dp))
+    slat2=sin(real(rlat2,kind=dp))
+    cdlon=cos(real(rlon1-rlon2,kind=dp))
+    crd=slat1*slat2+clat1*clat2*cdlon
+    distance2=real(rerth*acos(crd)/1000.0_dp)
+  endif
+  ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+end function distance2
diff --git a/src/plu_openouttraj.f90 b/src/plu_openouttraj.f90
new file mode 100644
index 0000000000000000000000000000000000000000..fef0d6f647dc0ef5fcd9ab4f5075c98808bbbfe2
--- /dev/null
+++ b/src/plu_openouttraj.f90
@@ -0,0 +1,67 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine openouttraj
+
+  !*****************************************************************************
+  !                                                                            *
+  !   This routine opens the output file for the plume trajectory output       *
+  !   produced by the cluster analysis.                                        *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     27 January 2001                                                        *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  !*****************************************************************************
+
+  use point_mod
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  integer :: i
+  real :: xp1,yp1,xp2,yp2
+
+
+  ! Open output file for trajectory output
+  !***************************************
+
+  open(unitouttraj,file=path(2)(1:length(2))//'trajectories.txt', &
+       form='formatted',err=998)
+
+  if (ldirect.eq.1) then
+  write(unitouttraj,'(i8,1x,i6,1x,a)') ibdate,ibtime, trim(flexversion)
+  else
+  write(unitouttraj,'(i8,1x,i6,1x,a)') iedate,ietime, trim(flexversion)
+  endif
+  write(unitouttraj,*) method,lsubgrid,lconvection
+  write(unitouttraj,*) numpoint
+  do i=1,numpoint
+    xp1=xpoint1(i)*dx+xlon0
+    yp1=ypoint1(i)*dy+ylat0
+    xp2=xpoint2(i)*dx+xlon0
+    yp2=ypoint2(i)*dy+ylat0
+    write(unitouttraj,*) ireleasestart(i),ireleaseend(i), &
+         xp1,yp1,xp2,yp2,zpoint1(i),zpoint2(i),kindz(i),npart(i)
+    if (numpoint.le.1000) then
+      write(unitouttraj,'(a)') compoint(i)(1:40)
+    else
+      write(unitouttraj,'(a)') compoint(1001)(1:40)
+    endif
+  end do
+
+  return
+
+998   write(*,*) ' #### FLEXPART MODEL ERROR!   THE FILE         #### '
+  write(*,*) ' #### trajectories.txt                         #### '
+  write(*,*) ' #### CANNOT BE OPENED. IF A FILE WITH THIS    #### '
+  write(*,*) ' #### NAME ALREADY EXISTS, DELETE IT AND START #### '
+  write(*,*) ' #### THE PROGRAM AGAIN.                       #### '
+  stop
+
+end subroutine openouttraj
diff --git a/src/plu_plumetraj.f90 b/src/plu_plumetraj.f90
new file mode 100644
index 0000000000000000000000000000000000000000..d8501545a15b23eeb187553c978f655fc93ac2fa
--- /dev/null
+++ b/src/plu_plumetraj.f90
@@ -0,0 +1,241 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine plumetraj(itime)
+  !                       i
+  !*****************************************************************************
+  !                                                                            *
+  ! Determines a plume centroid trajectory for each release site, and manages  *
+  ! clustering of particle locations. Certain parameters (average PV,          *
+  ! tropopause height, etc., are provided along the plume trajectories.        *
+  ! At the end, output is written to file 'trajectories.txt'.                  *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     24 January 2002                                                        *
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! fclust          fraction of particles belonging to each cluster            *
+  ! hmixcenter      mean mixing height for all particles                       *
+  ! ncluster        number of clusters to be used                              *
+  ! pvcenter        mean PV for all particles                                  *
+  ! pvfract         fraction of particles with PV<2pvu                         *
+  ! rms             total horizontal rms distance after clustering             *
+  ! rmsdist         total horizontal rms distance before clustering            *
+  ! rmsclust        horizontal rms distance for each individual cluster        *
+  ! topocenter      mean topography underlying all particles                   *
+  ! tropocenter     mean tropopause height at the positions of particles       *
+  ! tropofract      fraction of particles within the troposphere               *
+  ! zrms            total vertical rms distance after clustering               *
+  ! zrmsdist        total vertical rms distance before clustering              *
+  ! xclust,yclust,  Cluster centroid positions                                 *
+  ! zclust                                                                     *
+  !                                                                            *
+  !*****************************************************************************
+
+  use point_mod
+  use par_mod
+  use com_mod
+  use mean_mod
+  use particle_mod
+  use coord_ec_mod
+  use windfields_mod
+
+  implicit none
+
+  integer :: itime,ix,jy,ixp,jyp,indexh,i,j,k,m,n,il,ind,indz,indzp
+  ! real :: xl(maxpart),yl(maxpart),zl(maxpart) ! moved to particle_mod and now xplum,yplum,zplum
+  real :: xcenter,ycenter,zcenter,dist,rmsdist,zrmsdist
+
+  real :: xclust(ncluster),yclust(ncluster),zclust(ncluster)
+  real :: fclust(ncluster),rms,rmsclust(ncluster),zrms
+
+  real :: dt1,dt2,dtt,ddx,ddy,rddx,rddy,p1,p2,p3,p4,dz1,dz2,dz
+  real :: topo,topocenter,hm(2),hmixi,hmixfract,hmixcenter
+  real :: pv1(2),pvprof(2),pvi,pvcenter,pvfract,tr(2),tri,tropofract
+  real :: tropocenter
+
+
+  dt1=real(itime-memtime(1))
+  dt2=real(memtime(2)-itime)
+  dtt=1./(dt1+dt2)
+
+
+  ! Loop about all release points
+  !******************************
+
+  do j=1,numpoint
+    if (abs(ireleasestart(j)-itime).gt.lage(nageclass)) cycle
+    topocenter=0.
+    hmixcenter=0.
+    hmixfract=0.
+    tropocenter=0.
+    tropofract=0.
+    pvfract=0.
+    pvcenter=0.
+    rmsdist=0.
+    zrmsdist=0.
+
+    n=0
+    do i=1,numpart
+      if (.not.part(i)%alive) cycle
+      if (part(i)%npoint.ne.j) cycle
+      n=n+1
+      xplum(n)=xlon0+part(i)%xlon*dx
+      yplum(n)=ylat0+part(i)%ylat*dy
+      call update_zeta_to_z(itime,i)
+      zplum(n)=part(i)%z
+
+  ! Interpolate PBL height, PV, and tropopause height to each
+  ! particle position in order to determine fraction of particles
+  ! within the PBL, above tropopause height, and average PV.
+  ! Interpolate topography, too, and convert to altitude asl
+  !**************************************************************
+
+      ix=int(part(i)%xlon)
+      jy=int(part(i)%ylat)
+      ixp=ix+1
+      jyp=jy+1
+
+      ! eso: Temporary fix for particle exactly at north pole
+      if (jyp >= nymax) then
+        write(*,*) 'WARNING: plume_mod.f90 jyp >= nymax. xt,yt:',part(i)%xlon,part(i)%ylat
+        jyp=jyp-1
+      end if
+
+      if (ixp >= nxmax) then
+        write(*,*) 'WARNING: plume_mod.f90 ixp >= nxmax. xt,yt:',part(i)%xlon,part(i)%ylat
+        ixp=ixp-nxmax
+      end if
+
+      ddx=part(i)%xlon-real(ix)
+      ddy=part(i)%ylat-real(jy)
+      rddx=1.-ddx
+      rddy=1.-ddy
+      p1=rddx*rddy
+      p2=ddx*rddy
+      p3=rddx*ddy
+      p4=ddx*ddy
+
+  ! Topography
+  !***********
+
+      topo=p1*oro(ix ,jy) &
+           + p2*oro(ixp,jy) &
+           + p3*oro(ix ,jyp) &
+           + p4*oro(ixp,jyp)
+      topocenter=topocenter+topo
+
+  ! Potential vorticity
+  !********************
+
+      do il=2,nz
+        if (height(il).gt.zplum(n)) then
+          indz=il-1
+          indzp=il
+          exit
+        endif
+      end do
+
+      dz1=zplum(n)-height(indz)
+      dz2=height(indzp)-zplum(n)
+      dz=1./(dz1+dz2)
+
+
+      do ind=indz,indzp
+        do m=1,2
+          indexh=memind(m)
+          pv1(m)=p1*pv(ix ,jy ,ind,indexh) &
+               +p2*pv(ixp,jy ,ind,indexh) &
+               +p3*pv(ix ,jyp,ind,indexh) &
+               +p4*pv(ixp,jyp,ind,indexh)
+        end do
+        pvprof(ind-indz+1)=(pv1(1)*dt2+pv1(2)*dt1)*dtt
+      end do
+      pvi=(dz1*pvprof(2)+dz2*pvprof(1))*dz
+      pvcenter=pvcenter+pvi
+      if (yplum(n).gt.0.) then
+        if (pvi.lt.2.) pvfract=pvfract+1.
+      else
+        if (pvi.gt.-2.) pvfract=pvfract+1.
+      endif
+
+
+  ! Tropopause and PBL height
+  !**************************
+
+      do m=1,2
+        indexh=memind(m)
+
+        tr(m)=p1*tropopause(ix ,jy ,1,indexh) &
+             + p2*tropopause(ixp,jy ,1,indexh) &
+             + p3*tropopause(ix ,jyp,1,indexh) &
+             + p4*tropopause(ixp,jyp,1,indexh)
+
+        hm(m)=p1*hmix(ix ,jy ,1,indexh) &
+             + p2*hmix(ixp,jy ,1,indexh) &
+             + p3*hmix(ix ,jyp,1,indexh) &
+             + p4*hmix(ixp,jyp,1,indexh)
+      end do
+
+      hmixi=(hm(1)*dt2+hm(2)*dt1)*dtt
+      tri=(tr(1)*dt2+tr(2)*dt1)*dtt
+      if (zplum(n).lt.tri) tropofract=tropofract+1.
+      tropocenter=tropocenter+tri+topo
+      if (zplum(n).lt.hmixi) hmixfract=hmixfract+1.
+      zplum(n)=zplum(n)+topo        ! convert to height asl
+      hmixcenter=hmixcenter+hmixi
+
+    end do
+
+
+  ! Make statistics for all plumes with n>0 particles
+  !**************************************************
+
+    if (n.gt.0) then
+      topocenter=topocenter/real(n)
+      hmixcenter=hmixcenter/real(n)
+      pvcenter=pvcenter/real(n)
+      tropocenter=tropocenter/real(n)
+      hmixfract=100.*hmixfract/real(n)
+      pvfract=100.*pvfract/real(n)
+      tropofract=100.*tropofract/real(n)
+
+  ! Cluster the particle positions
+  !*******************************
+
+      call clustering(n,xclust,yclust,zclust,fclust,rms, &
+           rmsclust,zrms)
+
+
+  ! Determine center of mass position on earth and average height
+  !**************************************************************
+
+      call centerofmass(xplum,yplum,n,xcenter,ycenter)
+      call mean(zplum,zcenter,zrmsdist,n)
+
+  ! Root mean square distance from center of mass
+  !**********************************************
+
+      do k=1,n
+        dist=distance(yplum(k),xplum(k),ycenter,xcenter)
+        rmsdist=rmsdist+dist*dist
+      end do
+      if (rmsdist.gt.0.) rmsdist=sqrt(rmsdist/real(n))
+      rmsdist=max(rmsdist,0.)
+
+  ! Write out results in trajectory data file
+  !******************************************
+
+      write(unitouttraj,'(i5,i8,2f9.4,4f8.1,f8.2,4f8.1,3f6.1,&
+           &5(2f8.3,f7.0,f6.1,f8.1))')&
+           &j,itime-(ireleasestart(j)+ireleaseend(j))/2, &
+           xcenter,ycenter,zcenter,topocenter,hmixcenter,tropocenter, &
+           pvcenter,rmsdist,rms,zrmsdist,zrms,hmixfract,pvfract, &
+           tropofract, &
+           (xclust(k),yclust(k),zclust(k),fclust(k),rmsclust(k), &
+           k=1,ncluster)
+    endif
+
+  end do
+end subroutine plumetraj
diff --git a/src/plume_mod.f90 b/src/plume_mod.f90
index 66edd907136f2b2ded8823afa174ecf362080088..e63f7c29cbf9bc128201de747d5d16b7a6b834f0 100644
--- a/src/plume_mod.f90
+++ b/src/plume_mod.f90
@@ -8,680 +8,23 @@
   !                                                                            *
   !*****************************************************************************
 module plume_mod
-  
+
   implicit none
   private :: centerofmass,clustering,distance,distance2
 
   public :: plumetraj,openouttraj
 contains
 
-subroutine plumetraj(itime)
-  !                       i
-  !*****************************************************************************
-  !                                                                            *
-  ! Determines a plume centroid trajectory for each release site, and manages  *
-  ! clustering of particle locations. Certain parameters (average PV,          *
-  ! tropopause height, etc., are provided along the plume trajectories.        *
-  ! At the end, output is written to file 'trajectories.txt'.                  *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     24 January 2002                                                        *
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! fclust          fraction of particles belonging to each cluster            *
-  ! hmixcenter      mean mixing height for all particles                       *
-  ! ncluster        number of clusters to be used                              *
-  ! pvcenter        mean PV for all particles                                  *
-  ! pvfract         fraction of particles with PV<2pvu                         *
-  ! rms             total horizontal rms distance after clustering             *
-  ! rmsdist         total horizontal rms distance before clustering            *
-  ! rmsclust        horizontal rms distance for each individual cluster        *
-  ! topocenter      mean topography underlying all particles                   *
-  ! tropocenter     mean tropopause height at the positions of particles       *
-  ! tropofract      fraction of particles within the troposphere               *
-  ! zrms            total vertical rms distance after clustering               *
-  ! zrmsdist        total vertical rms distance before clustering              *
-  ! xclust,yclust,  Cluster centroid positions                                 *
-  ! zclust                                                                     *
-  !                                                                            *
-  !*****************************************************************************
-
-  use point_mod
-  use par_mod
-  use com_mod
-  use mean_mod
-  use particle_mod
-  use coord_ec_mod
-  use windfields_mod
-
-  implicit none
-
-  integer :: itime,ix,jy,ixp,jyp,indexh,i,j,k,m,n,il,ind,indz,indzp
-  ! real :: xl(maxpart),yl(maxpart),zl(maxpart) ! moved to particle_mod and now xplum,yplum,zplum
-  real :: xcenter,ycenter,zcenter,dist,rmsdist,zrmsdist
-
-  real :: xclust(ncluster),yclust(ncluster),zclust(ncluster)
-  real :: fclust(ncluster),rms,rmsclust(ncluster),zrms
-
-  real :: dt1,dt2,dtt,ddx,ddy,rddx,rddy,p1,p2,p3,p4,dz1,dz2,dz
-  real :: topo,topocenter,hm(2),hmixi,hmixfract,hmixcenter
-  real :: pv1(2),pvprof(2),pvi,pvcenter,pvfract,tr(2),tri,tropofract
-  real :: tropocenter
-
-
-  dt1=real(itime-memtime(1))
-  dt2=real(memtime(2)-itime)
-  dtt=1./(dt1+dt2)
-
-
-  ! Loop about all release points
-  !******************************
-
-  do j=1,numpoint
-    if (abs(ireleasestart(j)-itime).gt.lage(nageclass)) cycle
-    topocenter=0.
-    hmixcenter=0.
-    hmixfract=0.
-    tropocenter=0.
-    tropofract=0.
-    pvfract=0.
-    pvcenter=0.
-    rmsdist=0.
-    zrmsdist=0.
-
-    n=0
-    do i=1,numpart
-      if (.not.part(i)%alive) cycle
-      if (part(i)%npoint.ne.j) cycle
-      n=n+1
-      xplum(n)=xlon0+part(i)%xlon*dx
-      yplum(n)=ylat0+part(i)%ylat*dy
-      call update_zeta_to_z(itime,i)
-      zplum(n)=part(i)%z
-
-  ! Interpolate PBL height, PV, and tropopause height to each
-  ! particle position in order to determine fraction of particles
-  ! within the PBL, above tropopause height, and average PV.
-  ! Interpolate topography, too, and convert to altitude asl
-  !**************************************************************
-
-      ix=int(part(i)%xlon)
-      jy=int(part(i)%ylat)
-      ixp=ix+1
-      jyp=jy+1
-
-      ! eso: Temporary fix for particle exactly at north pole
-      if (jyp >= nymax) then
-        write(*,*) 'WARNING: plume_mod.f90 jyp >= nymax. xt,yt:',part(i)%xlon,part(i)%ylat
-        jyp=jyp-1
-      end if
-
-      if (ixp >= nxmax) then
-        write(*,*) 'WARNING: plume_mod.f90 ixp >= nxmax. xt,yt:',part(i)%xlon,part(i)%ylat
-        ixp=ixp-nxmax
-      end if
-
-      ddx=part(i)%xlon-real(ix)
-      ddy=part(i)%ylat-real(jy)
-      rddx=1.-ddx
-      rddy=1.-ddy
-      p1=rddx*rddy
-      p2=ddx*rddy
-      p3=rddx*ddy
-      p4=ddx*ddy
-
-  ! Topography
-  !***********
-
-      topo=p1*oro(ix ,jy) &
-           + p2*oro(ixp,jy) &
-           + p3*oro(ix ,jyp) &
-           + p4*oro(ixp,jyp)
-      topocenter=topocenter+topo
-
-  ! Potential vorticity
-  !********************
-
-      do il=2,nz
-        if (height(il).gt.zplum(n)) then
-          indz=il-1
-          indzp=il
-          exit
-        endif
-      end do
-
-      dz1=zplum(n)-height(indz)
-      dz2=height(indzp)-zplum(n)
-      dz=1./(dz1+dz2)
-
-
-      do ind=indz,indzp
-        do m=1,2
-          indexh=memind(m)
-          pv1(m)=p1*pv(ix ,jy ,ind,indexh) &
-               +p2*pv(ixp,jy ,ind,indexh) &
-               +p3*pv(ix ,jyp,ind,indexh) &
-               +p4*pv(ixp,jyp,ind,indexh)
-        end do
-        pvprof(ind-indz+1)=(pv1(1)*dt2+pv1(2)*dt1)*dtt
-      end do
-      pvi=(dz1*pvprof(2)+dz2*pvprof(1))*dz
-      pvcenter=pvcenter+pvi
-      if (yplum(n).gt.0.) then
-        if (pvi.lt.2.) pvfract=pvfract+1.
-      else
-        if (pvi.gt.-2.) pvfract=pvfract+1.
-      endif
-
-
-  ! Tropopause and PBL height
-  !**************************
-
-      do m=1,2
-        indexh=memind(m)
-
-        tr(m)=p1*tropopause(ix ,jy ,1,indexh) &
-             + p2*tropopause(ixp,jy ,1,indexh) &
-             + p3*tropopause(ix ,jyp,1,indexh) &
-             + p4*tropopause(ixp,jyp,1,indexh)
-
-        hm(m)=p1*hmix(ix ,jy ,1,indexh) &
-             + p2*hmix(ixp,jy ,1,indexh) &
-             + p3*hmix(ix ,jyp,1,indexh) &
-             + p4*hmix(ixp,jyp,1,indexh)
-      end do
-
-      hmixi=(hm(1)*dt2+hm(2)*dt1)*dtt
-      tri=(tr(1)*dt2+tr(2)*dt1)*dtt
-      if (zplum(n).lt.tri) tropofract=tropofract+1.
-      tropocenter=tropocenter+tri+topo
-      if (zplum(n).lt.hmixi) hmixfract=hmixfract+1.
-      zplum(n)=zplum(n)+topo        ! convert to height asl
-      hmixcenter=hmixcenter+hmixi
-
-    end do
-
-
-  ! Make statistics for all plumes with n>0 particles
-  !**************************************************
-
-    if (n.gt.0) then
-      topocenter=topocenter/real(n)
-      hmixcenter=hmixcenter/real(n)
-      pvcenter=pvcenter/real(n)
-      tropocenter=tropocenter/real(n)
-      hmixfract=100.*hmixfract/real(n)
-      pvfract=100.*pvfract/real(n)
-      tropofract=100.*tropofract/real(n)
-
-  ! Cluster the particle positions
-  !*******************************
-
-      call clustering(n,xclust,yclust,zclust,fclust,rms, &
-           rmsclust,zrms)
-
-
-  ! Determine center of mass position on earth and average height
-  !**************************************************************
-
-      call centerofmass(xplum,yplum,n,xcenter,ycenter)
-      call mean(zplum,zcenter,zrmsdist,n)
-
-  ! Root mean square distance from center of mass
-  !**********************************************
-
-      do k=1,n
-        dist=distance(yplum(k),xplum(k),ycenter,xcenter)
-        rmsdist=rmsdist+dist*dist
-      end do
-      if (rmsdist.gt.0.) rmsdist=sqrt(rmsdist/real(n))
-      rmsdist=max(rmsdist,0.)
-
-  ! Write out results in trajectory data file
-  !******************************************
-
-      write(unitouttraj,'(i5,i8,2f9.4,4f8.1,f8.2,4f8.1,3f6.1,&
-           &5(2f8.3,f7.0,f6.1,f8.1))')&
-           &j,itime-(ireleasestart(j)+ireleaseend(j))/2, &
-           xcenter,ycenter,zcenter,topocenter,hmixcenter,tropocenter, &
-           pvcenter,rmsdist,rms,zrmsdist,zrms,hmixfract,pvfract, &
-           tropofract, &
-           (xclust(k),yclust(k),zclust(k),fclust(k),rmsclust(k), &
-           k=1,ncluster)
-    endif
-
-  end do
-end subroutine plumetraj
-
-subroutine centerofmass(xl,yl,n,xcenter,ycenter)
-  !                        i  i  i    o       o
-  !*****************************************************************************
-  !                                                                            *
-  !   This routine calculates the center of mass of n points on the Earth.     *
-  !   Input are the longitudes (xl) and latitudes (yl) of the individual       *
-  !   points, output is the longitude and latitude of the centre of mass.      *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     24 January 2002                                                        *
-  !                                                                            *
-  !*****************************************************************************
-
-  use par_mod
-
-  implicit none
-
-  integer :: n,l
-  real :: xl(n),yl(n),xll,yll,xav,yav,zav,x,y,z,xcenter,ycenter
-
-
-  xav=0.
-  yav=0.
-  zav=0.
-
-  do l=1,n
-
-  ! Convert longitude and latitude from degrees to radians
-  !*******************************************************
-
-    xll=xl(l)*pi180
-    yll=yl(l)*pi180
-
-  ! Calculate 3D coordinates from longitude and latitude
-  !*****************************************************
-
-    x = cos(yll)*sin(xll)
-    y = -1.*cos(yll)*cos(xll)
-    z = sin(yll)
-
-
-  ! Find the mean location in Cartesian coordinates
-  !************************************************
-
-    xav=xav+x
-    yav=yav+y
-    zav=zav+z
-  end do
-
-  xav=xav/real(n)
-  yav=yav/real(n)
-  zav=zav/real(n)
-
-
-  ! Project the point back onto Earth's surface
-  !********************************************
-
-  xcenter=atan2(xav,-1.*yav)
-  ycenter=atan2(zav,sqrt(xav*xav+yav*yav))
-
-  ! Convert back to degrees
-  !************************
-
-  xcenter=xcenter/pi180
-  ycenter=ycenter/pi180
-end subroutine centerofmass
-
-subroutine clustering(n,xclust,yclust,zclust,fclust,rms, &
-       rmsclust,zrms)
-  !                      i  i  i  i   o      o      o      o     o
-  !   o      o
-  !*****************************************************************************
-  !                                                                            *
-  !   This routine clusters the particle position into ncluster custers.       *
-  !   Input are the longitudes (xl) and latitudes (yl) of the individual       *
-  !   points, output are the cluster mean positions (xclust,yclust).           *
-  !   Vertical positions are not directly used for the clustering.             *
-  !                                                                            *
-  !   For clustering, the procedure described in Dorling et al. (1992) is used.*
-  !                                                                            *
-  !   Dorling, S.R., Davies, T.D. and Pierce, C.E. (1992):                     *
-  !   Cluster analysis: a technique for estimating the synoptic meteorological *
-  !   controls on air and precipitation chemistry - method and applications.   *
-  !   Atmospheric Environment 26A, 2575-2581.                                  *
-  !                                                                            *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     1 February 2002                                                        *
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! fclust          fraction of particles belonging to each cluster            *
-  ! ncluster        number of clusters to be used                              *
-  ! rms             total horizontal rms distance after clustering             *
-  ! rmsclust        horizontal rms distance for each individual cluster        *
-  ! zrms            total vertical rms distance after clustering               *
-  ! xclust,yclust,  Cluster centroid positions                                 *
-  ! zclust                                                                     *
-  ! xl,yl,zl        particle positions                                         *
-  !                                                                            *
-  !*****************************************************************************
-
-  use par_mod
-  use particle_mod
-
-  implicit none
-
-  integer :: n,i,j,l,numb(ncluster),ncl
-  real :: xclust(ncluster),yclust(ncluster),x,y,z
-  real :: zclust(ncluster),distances,distancemin,rms,rmsold
-  real :: xav(ncluster),yav(ncluster),zav(ncluster),fclust(ncluster)
-  real :: rmsclust(ncluster)
-  real :: zdist,zrms
-
-
-
-  if (n.lt.ncluster) return
-  rmsold=-5.
-
-  ! Convert longitude and latitude from degrees to radians
-  !*******************************************************
-
-  do i=1,n
-    nclust(i)=i
-    xplum(i)=xplum(i)*pi180
-    yplum(i)=yplum(i)*pi180
-  end do
-
-
-  ! Generate a seed for each cluster
-  !*********************************
-
-  do j=1,ncluster
-    zclust(j)=0.
-    xclust(j)=xplum(j*n/ncluster)
-    yclust(j)=yplum(j*n/ncluster)
-  end do
-
-
-  ! Iterative loop to compute the cluster means
-  !********************************************
-
-  do l=1,100
-
-  ! Assign each particle to a cluster: criterion minimum distance to the
-  ! cluster mean position
-  !*********************************************************************
-
-
-    do i=1,n
-      distancemin=10.**10.
-      do j=1,ncluster
-        distances=distance2(yplum(i),xplum(i),yclust(j),xclust(j))
-        if (distances.lt.distancemin) then
-          distancemin=distances
-          ncl=j
-        endif
-      end do
-      nclust(i)=ncl
-    end do
-
-
-  ! Recalculate the cluster centroid position: convert to 3D Cartesian coordinates,
-  ! calculate mean position, and re-project this point onto the Earth's surface
-  !*****************************************************************************
-
-    do j=1,ncluster
-      xav(j)=0.
-      yav(j)=0.
-      zav(j)=0.
-      rmsclust(j)=0.
-      numb(j)=0
-    end do
-    rms=0.
-
-    do i=1,n
-      numb(nclust(i))=numb(nclust(i))+1
-      distances=distance2(yplum(i),xplum(i), &
-           yclust(nclust(i)),xclust(nclust(i)))
-
-  ! rms is the total rms of all particles
-  ! rmsclust is the rms for a particular cluster
-  !*********************************************
-
-      rms=rms+distances*distances
-      rmsclust(nclust(i))=rmsclust(nclust(i))+distances*distances
-
-  ! Calculate Cartesian 3D coordinates from longitude and latitude
-  !***************************************************************
-
-      x = cos(yplum(i))*sin(xplum(i))
-      y = -1.*cos(yplum(i))*cos(xplum(i))
-      z = sin(yplum(i))
-      xav(nclust(i))=xav(nclust(i))+x
-      yav(nclust(i))=yav(nclust(i))+y
-      zav(nclust(i))=zav(nclust(i))+z
-    end do
-
-    rms=sqrt(rms/real(n))
-
-
-  ! Find the mean location in Cartesian coordinates
-  !************************************************
-
-    do j=1,ncluster
-      if (numb(j).gt.0) then
-        rmsclust(j)=sqrt(rmsclust(j)/real(numb(j)))
-        xav(j)=xav(j)/real(numb(j))
-        yav(j)=yav(j)/real(numb(j))
-        zav(j)=zav(j)/real(numb(j))
-
-  ! Project the point back onto Earth's surface
-  !********************************************
-
-        xclust(j)=atan2(xav(j),-1.*yav(j))
-        yclust(j)=atan2(zav(j),sqrt(xav(j)*xav(j)+yav(j)*yav(j)))
-      endif
-    end do
-
-
-  ! Leave the loop if the RMS distance decreases only slightly between 2 iterations
-  !*****************************************************************************
-
-    if ((l.gt.1).and.(abs(rms-rmsold)/rmsold.lt.0.005)) exit
-    rmsold=rms
-
-  end do
-
-  ! Convert longitude and latitude from radians to degrees
-  !*******************************************************
-
-  do i=1,n
-    xplum(i)=xplum(i)/pi180
-    yplum(i)=yplum(i)/pi180
-    zclust(nclust(i))=zclust(nclust(i))+zplum(i)
-  end do
-
-  do j=1,ncluster
-    xclust(j)=xclust(j)/pi180
-    yclust(j)=yclust(j)/pi180
-    if (numb(j).gt.0) zclust(j)=zclust(j)/real(numb(j))
-    fclust(j)=100.*real(numb(j))/real(n)
-  end do
-
-  ! Determine total vertical RMS deviation
-  !***************************************
-
-  zrms=0.
-  do i=1,n
-    zdist=zplum(i)-zclust(nclust(i))
-    zrms=zrms+zdist*zdist
-  end do
-  if (zrms.gt.0.) zrms=sqrt(zrms/real(n))
-
-end subroutine clustering
-
-real function distance(rlat1,rlon1,rlat2,rlon2)
-
-  !$$$  SUBPROGRAM DOCUMENTATION BLOCK
-  !
-  ! SUBPROGRAM:  GCDIST     COMPUTE GREAT CIRCLE DISTANCE
-  !   PRGMMR: IREDELL       ORG: W/NMC23       DATE: 96-04-10
-  !
-  ! ABSTRACT: THIS SUBPROGRAM COMPUTES GREAT CIRCLE DISTANCE
-  !      BETWEEN TWO POINTS ON THE EARTH.
-  !
-  ! PROGRAM HISTORY LOG:
-  !   96-04-10  IREDELL
-  !
-  ! USAGE:    ...GCDIST(RLAT1,RLON1,RLAT2,RLON2)
-  !
-  !   INPUT ARGUMENT LIST:
-  !rlat1    - REAL LATITUDE OF POINT 1 IN DEGREES
-  !rlon1    - REAL LONGITUDE OF POINT 1 IN DEGREES
-  !rlat2    - REAL LATITUDE OF POINT 2 IN DEGREES
-  !rlon2    - REAL LONGITUDE OF POINT 2 IN DEGREES
-  !
-  !   OUTPUT ARGUMENT LIST:
-  !distance - REAL GREAT CIRCLE DISTANCE IN KILOMETERS
-  !
-  ! ATTRIBUTES:
-  !   LANGUAGE: Fortran 90
-  !
-  !$$$
-
-  use par_mod, only: dp
-
-  implicit none
-
-  real          :: rlat1,rlon1,rlat2,rlon2
-  real(kind=dp) :: clat1,clat2,slat1,slat2,cdlon,crd
-  real(kind=dp),parameter :: rerth=6.3712e6_dp
-  real(kind=dp),parameter :: pi=3.14159265358979_dp, dpr=180.0_dp/pi
-  ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-  if ((abs(rlat1-rlat2).lt.0.03).and. &
-       (abs(rlon1-rlon2).lt.0.03)) then
-    distance=0.
-  else
-    clat1=cos(real(rlat1,kind=dp)/dpr)
-    slat1=sin(real(rlat1,kind=dp)/dpr)
-    clat2=cos(real(rlat2,kind=dp)/dpr)
-    slat2=sin(real(rlat2,kind=dp)/dpr)
-    cdlon=cos(real((rlon1-rlon2),kind=dp)/dpr)
-    crd=slat1*slat2+clat1*clat2*cdlon
-    distance=real(rerth*acos(crd)/1000.0_dp)
-  endif
-  ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-end function distance
-
-real function distance2(rlat1,rlon1,rlat2,rlon2)
-
-  !$$$  SUBPROGRAM DOCUMENTATION BLOCK
-  !
-  ! SUBPROGRAM:  GCDIST     COMPUTE GREAT CIRCLE DISTANCE
-  !   PRGMMR: IREDELL       ORG: W/NMC23       DATE: 96-04-10
-  !
-  ! ABSTRACT: THIS SUBPROGRAM COMPUTES GREAT CIRCLE DISTANCE
-  !      BETWEEN TWO POINTS ON THE EARTH. COORDINATES ARE GIVEN IN RADIANS!
-  !
-  ! PROGRAM HISTORY LOG:
-  !   96-04-10  IREDELL
-  !
-  ! USAGE:    ...GCDIST(RLAT1,RLON1,RLAT2,RLON2)
-  !
-  !   INPUT ARGUMENT LIST:
-  !rlat1    - REAL LATITUDE OF POINT 1 IN RADIANS
-  !rlon1    - REAL LONGITUDE OF POINT 1 IN RADIANS
-  !rlat2    - REAL LATITUDE OF POINT 2 IN RADIANS
-  !rlon2    - REAL LONGITUDE OF POINT 2 IN RADIANS
-  !
-  !   OUTPUT ARGUMENT LIST:
-  !distance2   - REAL GREAT CIRCLE DISTANCE IN KM
-  !
-  ! ATTRIBUTES:
-  !   LANGUAGE: Fortran 90
-  !
-  !$$$
-
-  use par_mod, only: dp
-
-  implicit none
-
-  real                    :: rlat1,rlon1,rlat2,rlon2
-  real(kind=dp)           :: clat1,clat2,slat1,slat2,cdlon,crd
-  real(kind=dp),parameter :: rerth=6.3712e6_dp
-  real(kind=dp),parameter :: pi=3.14159265358979_dp
-
-  if ((abs(rlat1-rlat2).lt.0.0003).and. &
-       (abs(rlon1-rlon2).lt.0.0003)) then
-    distance2=0.0_dp
-  else
-
-  ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-    clat1=cos(real(rlat1,kind=dp))
-    slat1=sin(real(rlat1,kind=dp))
-    clat2=cos(real(rlat2,kind=dp))
-    slat2=sin(real(rlat2,kind=dp))
-    cdlon=cos(real(rlon1-rlon2,kind=dp))
-    crd=slat1*slat2+clat1*clat2*cdlon
-    distance2=real(rerth*acos(crd)/1000.0_dp)
-  endif
-  ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
-end function distance2
-
-subroutine openouttraj
-
-  !*****************************************************************************
-  !                                                                            *
-  !   This routine opens the output file for the plume trajectory output       *
-  !   produced by the cluster analysis.                                        *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     27 January 2001                                                        *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  !                                                                            *
-  !*****************************************************************************
-
-  use point_mod
-  use par_mod
-  use com_mod
-
-  implicit none
-
-  integer :: i
-  real :: xp1,yp1,xp2,yp2
-
-
-  ! Open output file for trajectory output
-  !***************************************
+#include "plu_plumetraj.f90"
 
-  open(unitouttraj,file=path(2)(1:length(2))//'trajectories.txt', &
-       form='formatted',err=998)
+#include "plu_centerofmass.f90"
 
-  if (ldirect.eq.1) then
-  write(unitouttraj,'(i8,1x,i6,1x,a)') ibdate,ibtime, trim(flexversion)
-  else
-  write(unitouttraj,'(i8,1x,i6,1x,a)') iedate,ietime, trim(flexversion)
-  endif
-  write(unitouttraj,*) method,lsubgrid,lconvection
-  write(unitouttraj,*) numpoint
-  do i=1,numpoint
-    xp1=xpoint1(i)*dx+xlon0
-    yp1=ypoint1(i)*dy+ylat0
-    xp2=xpoint2(i)*dx+xlon0
-    yp2=ypoint2(i)*dy+ylat0
-    write(unitouttraj,*) ireleasestart(i),ireleaseend(i), &
-         xp1,yp1,xp2,yp2,zpoint1(i),zpoint2(i),kindz(i),npart(i)
-    if (numpoint.le.1000) then
-      write(unitouttraj,'(a)') compoint(i)(1:40)
-    else
-      write(unitouttraj,'(a)') compoint(1001)(1:40)
-    endif
-  end do
+#include "plu_clustering.f90"
 
-  return
+#include "plu_distance.f90"
 
-998   write(*,*) ' #### FLEXPART MODEL ERROR!   THE FILE         #### '
-  write(*,*) ' #### trajectories.txt                         #### '
-  write(*,*) ' #### CANNOT BE OPENED. IF A FILE WITH THIS    #### '
-  write(*,*) ' #### NAME ALREADY EXISTS, DELETE IT AND START #### '
-  write(*,*) ' #### THE PROGRAM AGAIN.                       #### '
-  stop
+#include "plu_distance2.f90"
 
-end subroutine openouttraj
+#include "plu_openouttraj.f90"
 
-end module plume_mod
\ No newline at end of file
+end module plume_mod
diff --git a/src/poi_coordtrafo.f90 b/src/poi_coordtrafo.f90
new file mode 100644
index 0000000000000000000000000000000000000000..e43ff9e6488d1e73431ce55c52388cd468155742
--- /dev/null
+++ b/src/poi_coordtrafo.f90
@@ -0,0 +1,106 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine coordtrafo(nxmin1,nymin1)
+
+  !**********************************************************************
+  !                                                                     *
+  !             FLEXPART MODEL SUBROUTINE COORDTRAFO                    *
+  !                                                                     *
+  !**********************************************************************
+  !                                                                     *
+  !             AUTHOR:      G. WOTAWA                                  *
+  !             DATE:        1994-02-07                                 *
+  !             LAST UPDATE: 1996-05-18   A. STOHL                      *
+  !                                                                     *
+  !**********************************************************************
+  !                                                                     *
+  ! DESCRIPTION: This subroutine transforms x and y coordinates of      *
+  ! particle release points to grid coordinates.                        *
+  !                                                                     *
+  !**********************************************************************
+
+  use par_mod
+  use com_mod
+
+  implicit none
+  integer,intent(in) ::   &
+    nxmin1,               & ! nx-1
+    nymin1                  ! ny-1
+  integer :: i,j,k
+  real :: yrspc ! small real number relative to x
+
+  if((ipin.eq.3).or.(ipin.eq.4)) return ! Not necessary when using part_ic.nc
+
+  if(numpoint.eq.0) then
+    write(*,*) ' FLEXPART MODEL SUBROUTINE COORDTRAFO: ERROR ! '
+    write(*,*) ' NO PARTICLE RELEASES ARE DEFINED!'
+    write(*,*) ' CHECK FILE RELEASES...'
+    stop
+  endif
+
+  ! TRANSFORM X- AND Y- COORDINATES OF STARTING POINTS TO GRID COORDINATES
+  !***********************************************************************
+
+  do i=1,numpoint
+    xpoint1(i)=(xpoint1(i)-xlon0)/dx
+    xpoint2(i)=(xpoint2(i)-xlon0)/dx
+    ypoint1(i)=(ypoint1(i)-ylat0)/dy
+    ypoint2(i)=(ypoint2(i)-ylat0)/dy
+  end do
+
+15   continue
+
+
+  ! CHECK IF RELEASE POINTS ARE WITHIN DOMAIN
+  !******************************************
+
+  yrspc = spacing(real(nymin1,kind=sp))
+
+  do i=1,numpoint
+    if (sglobal.and.(ypoint1(i).lt.1.e-6)) ypoint1(i)=1.e-6
+    if (nglobal.and.(ypoint2(i).gt.real(nymin1,kind=dp)-1.e-5)) &
+         ypoint2(i)=real(nymin1,kind=dp)-10*yrspc
+    if ((ypoint1(i).lt.1.e-6).or.(ypoint1(i).ge.real(nymin1,kind=dp)-1.e-6) &
+       .or.(ypoint2(i).lt.1.e-6).or.(ypoint2(i).ge.real(nymin1,kind=dp)-yrspc) &
+       .or.((.not.xglobal).and.((xpoint1(i).lt.1.e-6).or. &
+       (xpoint1(i).ge.real(nxmin1,kind=dp)-1.e-6).or.(xpoint2(i).lt.1.e-6).or. &
+       (xpoint2(i).ge.real(nxmin1,kind=dp)-1.e-6)))) then
+      write(*,*) ' NOTICE: RELEASE POINT OUT OF DOMAIN DETECTED.'
+      write(*,*) ' IT IS REMOVED NOW ... '
+      if (i.le.1000) then
+         write(*,*) ' COMMENT: ',compoint(i)
+      else
+         write(*,*) ' COMMENT: ',compoint(1001)
+      endif
+      if (i.lt.numpoint) then
+        do j=i+1,numpoint
+          xpoint1(j-1)=xpoint1(j)
+          ypoint1(j-1)=ypoint1(j)
+          xpoint2(j-1)=xpoint2(j)
+          ypoint2(j-1)=ypoint2(j)
+          zpoint1(j-1)=zpoint1(j)
+          zpoint2(j-1)=zpoint2(j)
+          npart(j-1)=npart(j)
+          kindz(j-1)=kindz(j)
+          ireleasestart(j-1)=ireleasestart(j)
+          ireleaseend(j-1)=ireleaseend(j)
+          if (j.le.1000) compoint(j-1)=compoint(j)
+          do k=1,nspec
+            xmass(j-1,k)=xmass(j,k)
+          end do
+        end do
+      endif
+
+      numpoint=numpoint-1
+      if (numpoint.gt.0) goto 15
+    endif
+  end do
+
+  if(numpoint.eq.0) then
+    write(*,*) ' FLEXPART MODEL SUBROUTINE COORDTRAFO: ERROR ! '
+    write(*,*) ' NO PARTICLE RELEASES ARE DEFINED!'
+    write(*,*) ' CHECK FILE RELEASES...'
+    stop
+  endif
+end subroutine coordtrafo
diff --git a/src/point_mod.f90 b/src/point_mod.f90
index 764981c6a8c5815adbeda301b547e44a00392a82..9bff1e2b99301ac384596a2c3257341ce5259adf 100644
--- a/src/point_mod.f90
+++ b/src/point_mod.f90
@@ -28,108 +28,6 @@ module point_mod
 
 contains
 
-subroutine coordtrafo(nxmin1,nymin1)
-
-  !**********************************************************************
-  !                                                                     *
-  !             FLEXPART MODEL SUBROUTINE COORDTRAFO                    *
-  !                                                                     *
-  !**********************************************************************
-  !                                                                     *
-  !             AUTHOR:      G. WOTAWA                                  *
-  !             DATE:        1994-02-07                                 *
-  !             LAST UPDATE: 1996-05-18   A. STOHL                      *
-  !                                                                     *
-  !**********************************************************************
-  !                                                                     *
-  ! DESCRIPTION: This subroutine transforms x and y coordinates of      *
-  ! particle release points to grid coordinates.                        *
-  !                                                                     *
-  !**********************************************************************
-
-  use par_mod
-  use com_mod
-
-  implicit none
-  integer,intent(in) ::   &
-    nxmin1,               & ! nx-1
-    nymin1                  ! ny-1
-  integer :: i,j,k
-  real :: yrspc ! small real number relative to x
-
-  if((ipin.eq.3).or.(ipin.eq.4)) return ! Not necessary when using part_ic.nc
-  
-  if(numpoint.eq.0) then
-    write(*,*) ' FLEXPART MODEL SUBROUTINE COORDTRAFO: ERROR ! '
-    write(*,*) ' NO PARTICLE RELEASES ARE DEFINED!'
-    write(*,*) ' CHECK FILE RELEASES...'
-    stop
-  endif
-
-  ! TRANSFORM X- AND Y- COORDINATES OF STARTING POINTS TO GRID COORDINATES
-  !***********************************************************************
-
-  do i=1,numpoint
-    xpoint1(i)=(xpoint1(i)-xlon0)/dx
-    xpoint2(i)=(xpoint2(i)-xlon0)/dx
-    ypoint1(i)=(ypoint1(i)-ylat0)/dy
-    ypoint2(i)=(ypoint2(i)-ylat0)/dy
-  end do
-
-15   continue
-
-
-  ! CHECK IF RELEASE POINTS ARE WITHIN DOMAIN
-  !******************************************
-  
-  yrspc = spacing(real(nymin1,kind=sp))
-  
-  do i=1,numpoint
-    if (sglobal.and.(ypoint1(i).lt.1.e-6)) ypoint1(i)=1.e-6
-    if (nglobal.and.(ypoint2(i).gt.real(nymin1,kind=dp)-1.e-5)) &
-         ypoint2(i)=real(nymin1,kind=dp)-10*yrspc
-    if ((ypoint1(i).lt.1.e-6).or.(ypoint1(i).ge.real(nymin1,kind=dp)-1.e-6) &
-       .or.(ypoint2(i).lt.1.e-6).or.(ypoint2(i).ge.real(nymin1,kind=dp)-yrspc) &
-       .or.((.not.xglobal).and.((xpoint1(i).lt.1.e-6).or. &
-       (xpoint1(i).ge.real(nxmin1,kind=dp)-1.e-6).or.(xpoint2(i).lt.1.e-6).or. &
-       (xpoint2(i).ge.real(nxmin1,kind=dp)-1.e-6)))) then
-      write(*,*) ' NOTICE: RELEASE POINT OUT OF DOMAIN DETECTED.'
-      write(*,*) ' IT IS REMOVED NOW ... '
-      if (i.le.1000) then
-         write(*,*) ' COMMENT: ',compoint(i)
-      else
-         write(*,*) ' COMMENT: ',compoint(1001)
-      endif
-      if (i.lt.numpoint) then
-        do j=i+1,numpoint
-          xpoint1(j-1)=xpoint1(j)
-          ypoint1(j-1)=ypoint1(j)
-          xpoint2(j-1)=xpoint2(j)
-          ypoint2(j-1)=ypoint2(j)
-          zpoint1(j-1)=zpoint1(j)
-          zpoint2(j-1)=zpoint2(j)
-          npart(j-1)=npart(j)
-          kindz(j-1)=kindz(j)
-          ireleasestart(j-1)=ireleasestart(j)
-          ireleaseend(j-1)=ireleaseend(j)
-          if (j.le.1000) compoint(j-1)=compoint(j)
-          do k=1,nspec
-            xmass(j-1,k)=xmass(j,k)
-          end do
-        end do
-      endif
-
-      numpoint=numpoint-1
-      if (numpoint.gt.0) goto 15
-    endif
-  end do
-
-  if(numpoint.eq.0) then
-    write(*,*) ' FLEXPART MODEL SUBROUTINE COORDTRAFO: ERROR ! '
-    write(*,*) ' NO PARTICLE RELEASES ARE DEFINED!'
-    write(*,*) ' CHECK FILE RELEASES...'
-    stop
-  endif
-end subroutine coordtrafo
+#include "poi_coordtrafo.f90"
 
 end module point_mod
diff --git a/src/pre_initcond_calc.f90 b/src/pre_initcond_calc.f90
new file mode 100644
index 0000000000000000000000000000000000000000..8b8a8d3c8405fe3552b11de29336efff1049a163
--- /dev/null
+++ b/src/pre_initcond_calc.f90
@@ -0,0 +1,194 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine initcond_calc(itime,i,thread)
+  !                               i   i
+  !*****************************************************************************
+  !                                                                            *
+  !     Calculation of the sensitivity to initial conditions for BW runs       *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     15 January 2010                                                        *
+  !                                                                            *
+  !  Changes                                                                   *
+  !     2022 L. Bakels: OpenMP parallelisation                                 *
+  !*****************************************************************************
+
+  use interpol_mod, only: interpol_density,ix,jy,ixp,jyp
+  use coord_ec_mod
+  use particle_mod
+
+  integer, intent(in) :: itime,i,thread
+  integer :: kz,ks
+  integer :: il,ind,indz,indzp,nrelpointer
+  real :: rddx,rddy,p1,p2,p3,p4,dz1,dz2,dz
+  real :: ddx,ddy
+  real :: rhoprof(2),rhoi,xl,yl,wx,wy,w
+  integer :: mind2
+  ! mind2        eso: pointer to 2nd windfield in memory
+
+
+  ! For forward simulations, make a loop over the number of species;
+  ! for backward simulations, make an additional loop over the release points
+  !**************************************************************************
+
+
+  if (.not. part(i)%alive) return
+
+  ! Depending on output option, calculate air density or set it to 1
+  ! linit_cond: 1=mass unit, 2=mass mixing ratio unit
+  !*****************************************************************
+
+
+  if (linit_cond.eq.1) then     ! mass unit
+    call update_zeta_to_z(itime,i)
+    call interpol_density(itime,i,rhoi)
+  elseif (linit_cond.eq.2) then    ! mass mixing ratio unit
+    rhoi=1.
+  endif
+
+  !****************************************************************************
+  ! 1. Evaluate grid concentrations using a uniform kernel of bandwidths dx, dy
+  !****************************************************************************
+
+
+  ! For backward simulations, look from which release point the particle comes from
+  ! For domain-filling trajectory option, npoint contains a consecutive particle
+  ! number, not the release point information. Therefore, nrelpointer is set to 1
+  ! for the domain-filling option.
+  !*****************************************************************************
+
+  if ((ioutputforeachrelease.eq.0).or.(mdomainfill.eq.1)) then
+    nrelpointer=1
+  else
+    nrelpointer=part(i)%npoint
+  endif
+
+  do kz=1,numzgrid                ! determine height of cell
+    if (real(outheight(kz),kind=dp).gt.part(i)%z) exit
+  end do
+
+  if (kz.le.numzgrid) then           ! inside output domain
+
+
+    xl=(part(i)%xlon*dx+xoutshift)/dxout
+    yl=(part(i)%ylat*dy+youtshift)/dyout
+    ix=int(xl)
+    if (xl.lt.0.) ix=ix-1
+    jy=int(yl)
+    if (yl.lt.0.) jy=jy-1
+
+
+  ! If a particle is close to the domain boundary, do not use the kernel either
+  !****************************************************************************
+
+    if ((xl.lt.0.5).or.(yl.lt.0.5).or. &
+         (xl.gt.real(numxgrid-1)-0.5).or. &
+         (yl.gt.real(numygrid-1)-0.5)) then             ! no kernel, direct attribution to grid cell
+      if ((ix.ge.0).and.(jy.ge.0).and.(ix.le.numxgrid-1).and. &
+           (jy.le.numygrid-1)) then
+        do ks=1,nspec
+#ifdef _OPENMP
+          init_cond_omp(ix,jy,kz,ks,nrelpointer,thread)= &
+               init_cond_omp(ix,jy,kz,ks,nrelpointer,thread)+ &
+               part(i)%mass(ks)/rhoi
+#else
+          init_cond(ix,jy,kz,ks,nrelpointer)= &
+               init_cond(ix,jy,kz,ks,nrelpointer)+ &
+               part(i)%mass(ks)/rhoi
+#endif
+        end do
+      endif
+
+    else                                 ! attribution via uniform kernel
+
+      ddx=xl-real(ix)                   ! distance to left cell border
+      ddy=yl-real(jy)                   ! distance to lower cell border
+      if (ddx.gt.0.5) then
+        ixp=ix+1
+        wx=1.5-ddx
+      else
+        ixp=ix-1
+        wx=0.5+ddx
+      endif
+
+      if (ddy.gt.0.5) then
+        jyp=jy+1
+        wy=1.5-ddy
+      else
+        jyp=jy-1
+        wy=0.5+ddy
+      endif
+
+
+  ! Determine mass fractions for four grid points
+  !**********************************************
+
+      if ((ix.ge.0).and.(ix.le.numxgrid-1)) then
+        if ((jy.ge.0).and.(jy.le.numygrid-1)) then
+          w=wx*wy
+          do ks=1,nspec
+#ifdef _OPENMP
+            init_cond_omp(ix,jy,kz,ks,nrelpointer,thread)= &
+              init_cond_omp(ix,jy,kz,ks,nrelpointer,thread) + &
+              part(i)%mass(ks) / rhoi * w
+#else
+            init_cond(ix,jy,kz,ks,nrelpointer)= &
+                 init_cond(ix,jy,kz,ks,nrelpointer)+part(i)%mass(ks)/rhoi*w
+#endif
+          end do
+        endif
+
+        if ((jyp.ge.0).and.(jyp.le.numygrid-1)) then
+          w=wx*(1.-wy)
+          do ks=1,nspec
+#ifdef _OPENMP
+            init_cond_omp(ix,jyp,kz,ks,nrelpointer,thread)= &
+              init_cond_omp(ix,jyp,kz,ks,nrelpointer,thread) + &
+              part(i)%mass(ks) / rhoi * w
+#else
+            init_cond(ix,jyp,kz,ks,nrelpointer)= &
+                 init_cond(ix,jyp,kz,ks,nrelpointer)+part(i)%mass(ks)/rhoi*w
+#endif
+          end do
+        endif
+      endif
+
+
+      if ((ixp.ge.0).and.(ixp.le.numxgrid-1)) then
+        if ((jyp.ge.0).and.(jyp.le.numygrid-1)) then
+          w=(1.-wx)*(1.-wy)
+          do ks=1,nspec
+#ifdef _OPENMP
+            init_cond_omp(ixp,jyp,kz,ks,nrelpointer,thread)= &
+                 init_cond_omp(ixp,jyp,kz,ks,nrelpointer,thread) + &
+                 part(i)%mass(ks) / rhoi * w
+#else
+            init_cond(ixp,jyp,kz,ks,nrelpointer)= &
+               init_cond(ixp,jyp,kz,ks,nrelpointer) + &
+               part(i)%mass(ks) / rhoi * w
+#endif
+          end do
+        endif
+
+        if ((jy.ge.0).and.(jy.le.numygrid-1)) then
+          w=(1.-wx)*wy
+          do ks=1,nspec
+#ifdef _OPENMP
+            init_cond_omp(ixp,jy,kz,ks,nrelpointer,thread)= &
+               init_cond_omp(ixp,jy,kz,ks,nrelpointer,thread) + &
+               part(i)%mass(ks) / rhoi * w
+#else
+            init_cond(ixp,jy,kz,ks,nrelpointer)= &
+              init_cond(ixp,jy,kz,ks,nrelpointer) + &
+              part(i)%mass(ks) / rhoi * w
+#endif
+          end do
+        endif
+      endif
+    endif
+
+  endif
+
+end subroutine initcond_calc
diff --git a/src/pre_outgrid_init.f90 b/src/pre_outgrid_init.f90
new file mode 100644
index 0000000000000000000000000000000000000000..f9122e39edae56a86bc6b8db1221bdf7ad8b94e5
--- /dev/null
+++ b/src/pre_outgrid_init.f90
@@ -0,0 +1,374 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine outgrid_init
+  !
+  !*****************************************************************************
+  !                                                                            *
+  !  This routine initializes the output grids                                 *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     7 August 2002                                                          *
+  !                                                                            *
+  !  Changes                                                                   *
+  !     2022 L. Bakels: OpenMP parallelisation                                 *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  ! area               surface area of all output grid cells                   *
+  ! areaeast           eastward facing wall area of all output grid cells      *
+  ! areanorth          northward facing wall area of all output grid cells     *
+  ! volume             volumes of all output grid cells                        *
+  !                                                                            *
+  !*****************************************************************************
+
+  use ohr_mod
+  use unc_mod
+
+  integer :: ix,jy,kz,i,nage,l,iix,jjy,ixp,jyp,i1,j1,j,ngrid
+  integer :: ks,kp,stat
+  real :: ylat,gridarea,ylatp,ylatm,hzone,cosfactm,cosfactp
+  real :: xlon,xl,yl,ddx,ddy,rddx,rddy,p1,p2,p3,p4,xtn,ytn,oroh
+  real :: eps
+
+  eps=nxmax/3.e5
+
+ ! Compute surface area and volume of each grid cell: area, volume;
+ ! and the areas of the northward and eastward facing walls: areaeast, areanorth
+ !***********************************************************************
+  do jy=0,numygrid-1
+    ylat=outlat0+(real(jy)+0.5)*dyout
+    ylatp=ylat+0.5*dyout
+    ylatm=ylat-0.5*dyout
+    if ((ylatm.lt.0).and.(ylatp.gt.0.)) then
+      hzone=dyout*r_earth*pi180
+    else
+
+  ! Calculate area of grid cell with formula M=2*pi*R*h*dx/360,
+  ! see Netz, Formeln der Mathematik, 5. Auflage (1983), p.90
+  !************************************************************
+
+      cosfactp=cos(ylatp*pi180)
+      cosfactm=cos(ylatm*pi180)
+      if (cosfactp.lt.cosfactm) then
+        hzone=sqrt(1-cosfactp**2)- &
+             sqrt(1-cosfactm**2)
+        hzone=hzone*r_earth
+      else
+        hzone=sqrt(1-cosfactm**2)- &
+             sqrt(1-cosfactp**2)
+        hzone=hzone*r_earth
+      endif
+    endif
+
+  ! Surface are of a grid cell at a latitude ylat
+  !**********************************************
+
+    gridarea=2.*pi*r_earth*hzone*dxout/360.
+
+    do ix=0,numxgrid-1
+      area(ix,jy)=gridarea
+
+  ! Volume = area x box height
+  !***************************
+
+      volume(ix,jy,1)=area(ix,jy)*outheight(1)
+      areaeast(ix,jy,1)=dyout*r_earth*pi180*outheight(1)
+      areanorth(ix,jy,1)=cos(ylat*pi180)*dxout*r_earth*pi180* &
+           outheight(1)
+      do kz=2,numzgrid
+        areaeast(ix,jy,kz)=dyout*r_earth*pi180* &
+             (outheight(kz)-outheight(kz-1))
+        areanorth(ix,jy,kz)=cos(ylat*pi180)*dxout*r_earth*pi180* &
+             (outheight(kz)-outheight(kz-1))
+        volume(ix,jy,kz)=area(ix,jy)*(outheight(kz)-outheight(kz-1))
+      end do
+    end do
+  end do
+
+  !******************************************************************
+  ! Determine average height of model topography in output grid cells
+  !******************************************************************
+
+  ! Loop over all output grid cells
+  !********************************
+
+  do jjy=0,numygrid-1
+    do iix=0,numxgrid-1
+      oroh=0.
+
+  ! Take 100 samples of the topography in every grid cell
+  !******************************************************
+
+      do j1=1,10
+        ylat=outlat0+(real(jjy)+real(j1)/10.-0.05)*dyout
+        yl=(ylat-ylat0)/dy
+        do i1=1,10
+          xlon=outlon0+(real(iix)+real(i1)/10.-0.05)*dxout
+          xl=(xlon-xlon0)/dx
+
+  ! Determine the nest we are in
+  !*****************************
+
+          ngrid=0
+          ! Temporary fix for nested layer edges: replaced eps with dxn and dyn (LB)
+          do j=numbnests,1,-1
+            if ((xl.gt.xln(j)+dxn(j)).and.(xl.lt.xrn(j)-dxn(j)).and. &
+                 (yl.gt.yln(j)+dyn(j)).and.(yl.lt.yrn(j)-dyn(j))) then
+              ngrid=j
+              exit
+            endif
+          end do
+
+! Determine (nested) grid coordinates & auxiliary parameters for interpolation
+!*****************************************************************************
+
+          if (ngrid.gt.0) then
+            xtn=(xl-xln(ngrid))*xresoln(ngrid)
+            ytn=(yl-yln(ngrid))*yresoln(ngrid)
+            ix=max(min(nint(xtn),nxn(ngrid)-1),0)
+            jy=max(min(nint(ytn),nyn(ngrid)-1),0)
+            ! ix=int(xtn)
+            ! jy=int(ytn)
+            ddy=ytn-real(jy)
+            ddx=xtn-real(ix)
+
+          else
+            ix=int(xl)
+            jy=int(yl)
+            ddy=yl-real(jy)
+            ddx=xl-real(ix)
+          endif
+          ixp=ix+1
+          jyp=jy+1
+          rddx=1.-ddx
+          rddy=1.-ddy
+          p1=rddx*rddy
+          p2=ddx*rddy
+          p3=rddx*ddy
+          p4=ddx*ddy
+
+          if (ngrid.gt.0) then
+            oroh=oroh+p1*oron(ix ,jy ,ngrid) &
+                 + p2*oron(ixp,jy ,ngrid) &
+                 + p3*oron(ix ,jyp,ngrid) &
+                 + p4*oron(ixp,jyp,ngrid)
+          else
+            oroh=oroh+p1*oro(ix ,jy) &
+                 + p2*oro(ixp,jy) &
+                 + p3*oro(ix ,jyp) &
+                 + p4*oro(ixp,jyp)
+          endif
+        end do
+      end do
+
+  ! Divide by the number of samples taken
+  !**************************************
+
+      oroout(iix,jjy)=oroh/100.
+    end do
+  end do
+
+  ! if necessary allocate flux fields
+  if (iflux.eq.1) then
+    allocate(flux(6,0:numxgrid-1,0:numygrid-1,numzgrid, &
+         1:nspec,1:maxpointspec_act,1:nageclass),stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate flux array '
+#ifdef _OPENMP
+    allocate(flux_omp(6,0:numxgrid-1,0:numygrid-1,numzgrid, &
+         1:nspec,1:maxpointspec_act,1:nageclass,numthreads))
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate flux_omp array '
+#endif
+  endif
+
+  ! gridunc,griduncn        uncertainty of outputted concentrations
+  allocate(gridunc(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec, &
+       maxpointspec_act,nclassunc,maxageclass),stat=stat)
+  if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc'
+#ifdef _OPENMP
+  allocate(gridunc_omp(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec, &
+       maxpointspec_act,nclassunc,maxageclass,numthreads_grid),stat=stat)
+  if (stat.ne.0) then
+    write(*,*)'ERROR: could not allocate gridunc_omp'
+    write(*,*)'increase the memory or reduce max_numthreads_grid in par_mod.f90.'
+    stop
+  endif
+#endif
+  if (ldirect.gt.0) then
+    allocate(wetgridunc(0:numxgrid-1,0:numygrid-1,maxspec, &
+         maxpointspec_act,nclassunc,maxageclass),stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate wetgridunc'
+    allocate(drygridunc(0:numxgrid-1,0:numygrid-1,maxspec, &
+         maxpointspec_act,nclassunc,maxageclass),stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate drygridunc'
+#ifdef _OPENMP
+    allocate(wetgridunc_omp(0:numxgrid-1,0:numygrid-1,maxspec, &
+         maxpointspec_act,nclassunc,maxageclass,numthreads_grid),stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate wetgridunc_omp'
+    allocate(drygridunc_omp(0:numxgrid-1,0:numygrid-1,maxspec, &
+         maxpointspec_act,nclassunc,maxageclass,numthreads_grid),stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate drygridunc_omp'
+#endif
+  endif
+
+#ifdef USE_MPIINPLACE
+#else
+! Extra field for totals at MPI root process
+  if (lroot.and.mpi_mode.gt.0) then
+! If MPI_IN_PLACE option is not used in mpi_mod.f90::mpif_tm_reduce_grid(),
+! then an aux array is needed for parallel grid reduction
+    allocate(gridunc0(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec, &
+         maxpointspec_act,nclassunc,maxageclass),stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc0'
+  else if (.not.lroot.and.mpi_mode.gt.0) then
+    allocate(gridunc0(1,1,1,1,1,1,1),stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc0'
+  end if
+#endif
+  if (ldirect.gt.0) then
+    if (lroot.and.mpi_mode.gt.0) then
+      allocate(wetgridunc0(0:numxgrid-1,0:numygrid-1,maxspec, &
+           maxpointspec_act,nclassunc,maxageclass),stat=stat)
+      if (stat.ne.0) write(*,*)'ERROR: could not allocate wetgridunc0'
+      allocate(drygridunc0(0:numxgrid-1,0:numygrid-1,maxspec, &
+           maxpointspec_act,nclassunc,maxageclass),stat=stat)
+      if (stat.ne.0) write(*,*)'ERROR: could not allocate drygridunc0'
+
+  ! allocate a dummy to avoid compilator complaints
+    else if (.not.lroot.and.mpi_mode.gt.0) then
+      allocate(wetgridunc0(1,1,1,1,1,1),stat=stat)
+      allocate(drygridunc0(1,1,1,1,1,1),stat=stat)
+    end if
+  end if
+
+  !write (*,*) 'Dimensions for fields', numxgrid,numygrid, &
+  !     maxspec,maxpointspec_act,nclassunc,maxageclass
+
+  if (lroot) then
+    write (*,*) 'Allocating fields for global output (x,y): ', &
+      numxgrid,numygrid
+    write (*,*) 'Allocating fields for nested output (x,y): ', &
+      numxgridn,numygridn
+  end if
+
+  ! allocate fields for concoutput with maximum dimension of outgrid
+  ! and outgrid_nest
+
+  allocate(gridsigma(0:max(numxgrid,numxgridn)-1, &
+       0:max(numygrid,numygridn)-1,numzgrid),stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc'
+  allocate(grid(0:max(numxgrid,numxgridn)-1, &
+       0:max(numygrid,numygridn)-1,numzgrid),stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc'
+  allocate(densityoutgrid(0:max(numxgrid,numxgridn)-1, &
+       0:max(numygrid,numygridn)-1,numzgrid),stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc'
+  ! RLT
+  allocate(densitydrygrid(0:max(numxgrid,numxgridn)-1, &
+       0:max(numygrid,numygridn)-1,numzgrid),stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc'
+  allocate(factor_drygrid(0:max(numxgrid,numxgridn)-1, &
+       0:max(numygrid,numygridn)-1,numzgrid),stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc'
+
+  allocate(factor3d(0:max(numxgrid,numxgridn)-1, &
+       0:max(numygrid,numygridn)-1,numzgrid),stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc'
+  allocate(sparse_dump_r(max(numxgrid,numxgridn)* &
+       max(numygrid,numygridn)*numzgrid),stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc'
+
+   allocate(sparse_dump_u(max(numxgrid,numxgridn)* &
+       max(numygrid,numygridn)*numzgrid),stat=stat)
+        if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc'
+
+  allocate(sparse_dump_i(max(numxgrid,numxgridn)* &
+       max(numygrid,numygridn)*numzgrid),stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc'
+
+  ! deposition fields are only allocated for forward runs
+  if (ldirect.gt.0) then
+     allocate(wetgridsigma(0:max(numxgrid,numxgridn)-1, &
+          0:max(numygrid,numygridn)-1),stat=stat)
+     if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc'
+     allocate(drygridsigma(0:max(numxgrid,numxgridn)-1, &
+          0:max(numygrid,numygridn)-1),stat=stat)
+     if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc'
+     allocate(wetgrid(0:max(numxgrid,numxgridn)-1, &
+          0:max(numygrid,numygridn)-1),stat=stat)
+     if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc'
+     allocate(drygrid(0:max(numxgrid,numxgridn)-1, &
+          0:max(numygrid,numygridn)-1),stat=stat)
+     if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc'
+  endif
+
+  ! Initial condition field
+
+  if (linit_cond.gt.0) then
+    allocate(init_cond(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec, &
+         maxpointspec_act),stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate init_cond'
+#ifdef _OPENMP
+    allocate(init_cond_omp(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec, &
+         maxpointspec_act,numthreads),stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate init_cond_omp'
+#endif
+  endif
+
+  !************************
+  ! Initialize output grids
+  !************************
+
+  do ks=1,nspec
+    do kp=1,maxpointspec_act
+      if (numreceptor.gt.0) then
+        do i=1,numreceptor
+      ! Receptor points
+          creceptor(i,ks)=0.
+        end do
+      endif
+      do nage=1,nageclass
+        do jy=0,numygrid-1
+          do ix=0,numxgrid-1
+            do l=1,nclassunc
+    ! Deposition fields
+              if (ldirect.gt.0) then
+              wetgridunc(ix,jy,ks,kp,l,nage)=0.
+              drygridunc(ix,jy,ks,kp,l,nage)=0.
+#ifdef _OPENMP
+              wetgridunc_omp(ix,jy,ks,kp,l,nage,:)=0.
+              drygridunc_omp(ix,jy,ks,kp,l,nage,:)=0.
+#endif
+              endif
+              do kz=1,numzgrid
+                if (iflux.eq.1) then
+    ! Flux fields
+                   do i=1,5
+                     flux(i,ix,jy,kz,ks,kp,nage)=0.
+#ifdef _OPENMP
+                     flux_omp(i,ix,jy,kz,ks,kp,nage,:)=0.
+#endif
+                   end do
+                endif
+    ! Initial condition field
+                if ((l.eq.1).and.(nage.eq.1).and.(linit_cond.gt.0)) then
+                  init_cond(ix,jy,kz,ks,kp)=0.
+#ifdef _OPENMP
+                  init_cond_omp(ix,jy,kz,ks,kp,:)=0.
+#endif
+                endif
+    ! Concentration fields
+                gridunc(ix,jy,kz,ks,kp,l,nage)=0.
+#ifdef _OPENMP
+                gridunc_omp(ix,jy,kz,ks,kp,l,nage,:)=0.
+#endif
+              end do
+            end do
+          end do
+        end do
+      end do
+    end do
+  end do
+end subroutine outgrid_init
diff --git a/src/pre_outgrid_init_nest.f90 b/src/pre_outgrid_init_nest.f90
new file mode 100644
index 0000000000000000000000000000000000000000..bbe43f59135447e97c8e8bd4fa04a596154aa05b
--- /dev/null
+++ b/src/pre_outgrid_init_nest.f90
@@ -0,0 +1,252 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine outgrid_init_nest
+  !
+  !*****************************************************************************
+  !                                                                            *
+  !  This routine calculates, for each grid cell of the output nest, the       *
+  !  volume and the surface area.                                              *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !    30 August 2004                                                          *
+  !                                                                            *
+  !  Changes                                                                   *
+  !     2022 L. Bakels: OpenMP parallelisation                                 *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  ! arean              surface area of all output nest cells                   *
+  ! volumen            volumes of all output nest cells                        *
+  !                                                                            *
+  !*****************************************************************************
+
+  use unc_mod
+
+  integer :: ix,jy,kz,ks,kp,nage,l,iix,jjy,ixp,jyp,i1,j1,j,ngrid
+  integer :: stat
+  real :: ylat,gridarea,ylatp,ylatm,hzone,cosfactm,cosfactp
+  real :: xlon,xl,yl,ddx,ddy,rddx,rddy,p1,p2,p3,p4,xtn,ytn,oroh
+  real :: eps
+
+  eps=nxmax/3.e5
+
+  ! gridunc,griduncn        uncertainty of outputted concentrations
+  allocate(griduncn(0:numxgridn-1,0:numygridn-1,numzgrid,maxspec, &
+       maxpointspec_act,nclassunc,maxageclass),stat=stat)
+  if (stat.ne.0) write(*,*)'ERROR:could not allocate nested gridunc'
+#ifdef _OPENMP
+  allocate(griduncn_omp(0:numxgridn-1,0:numygridn-1,numzgrid,maxspec, &
+       maxpointspec_act,nclassunc,maxageclass,numthreads_grid),stat=stat)
+  if (stat.ne.0) write(*,*)'ERROR:could not allocate nested gridunc_omp'
+#endif
+
+  if (ldirect.gt.0) then
+    allocate(wetgriduncn(0:numxgridn-1,0:numygridn-1,maxspec, &
+         maxpointspec_act,nclassunc,maxageclass),stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR:could not allocate nested gridunc'
+    allocate(drygriduncn(0:numxgridn-1,0:numygridn-1,maxspec, &
+         maxpointspec_act,nclassunc,maxageclass),stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR:could not allocate nested gridunc'
+#ifdef _OPENMP
+    allocate(wetgriduncn_omp(0:numxgridn-1,0:numygridn-1,maxspec, &
+         maxpointspec_act,nclassunc,maxageclass,numthreads_grid),stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR:could not allocate nested wetgridunc_omp'
+    allocate(drygriduncn_omp(0:numxgridn-1,0:numygridn-1,maxspec, &
+         maxpointspec_act,nclassunc,maxageclass,numthreads_grid),stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR:could not allocate nested drygriduncn_omp'
+#endif
+  endif
+
+#ifdef USE_MPIINPLACE
+#else
+  ! Extra field for totals at MPI root process
+  if (lroot.and.mpi_mode.gt.0) then
+  ! If MPI_IN_PLACE option is not used in mpi_mod.f90::mpif_tm_reduce_grid_nest(),
+  ! then an aux array is needed for parallel grid reduction
+    allocate(griduncn0(0:numxgridn-1,0:numygridn-1,numzgrid,maxspec, &
+         maxpointspec_act,nclassunc,maxageclass),stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR:could not allocate nested gridunc'
+  ! allocate a dummy to avoid compilator complaints
+  else if (.not.lroot.and.mpi_mode.gt.0) then
+    allocate(griduncn0(1,1,1,1,1,1,1),stat=stat)
+  end if
+#endif
+  if (ldirect.gt.0) then
+    if (lroot.and.mpi_mode.gt.0) then
+      allocate(wetgriduncn0(0:numxgridn-1,0:numygridn-1,maxspec, &
+           maxpointspec_act,nclassunc,maxageclass),stat=stat)
+      if (stat.ne.0) write(*,*)'ERROR:could not allocate nested gridunc'
+      allocate(drygriduncn0(0:numxgridn-1,0:numygridn-1,maxspec, &
+           maxpointspec_act,nclassunc,maxageclass),stat=stat)
+      if (stat.ne.0) write(*,*)'ERROR:could not allocate nested gridunc'
+  !  endif
+  ! allocate a dummy to avoid compilator complaints
+    else if (.not.lroot.and.mpi_mode.gt.0) then
+      allocate(wetgriduncn0(1,1,1,1,1,1),stat=stat)
+      allocate(drygriduncn0(1,1,1,1,1,1),stat=stat)
+    end if
+  end if
+
+  ! Compute surface area and volume of each grid cell: area, volume;
+  ! and the areas of the northward and eastward facing walls: areaeast, areanorth
+  !***********************************************************************
+
+  do jy=0,numygridn-1
+    ylat=outlat0n+(real(jy)+0.5)*dyoutn
+    ylatp=ylat+0.5*dyoutn
+    ylatm=ylat-0.5*dyoutn
+    if ((ylatm.lt.0).and.(ylatp.gt.0.)) then
+      hzone=dyoutn*r_earth*pi180
+    else
+
+  ! Calculate area of grid cell with formula M=2*pi*R*h*dx/360,
+  ! see Netz, Formeln der Mathematik, 5. Auflage (1983), p.90
+  !************************************************************
+
+      cosfactp=cos(ylatp*pi180)
+      cosfactm=cos(ylatm*pi180)
+      if (cosfactp.lt.cosfactm) then
+        hzone=sqrt(1-cosfactp**2)- &
+             sqrt(1-cosfactm**2)
+        hzone=hzone*r_earth
+      else
+        hzone=sqrt(1-cosfactm**2)- &
+             sqrt(1-cosfactp**2)
+        hzone=hzone*r_earth
+      endif
+    endif
+
+
+
+  ! Surface are of a grid cell at a latitude ylat
+  !**********************************************
+
+    gridarea=2.*pi*r_earth*hzone*dxoutn/360.
+
+    do ix=0,numxgridn-1
+      arean(ix,jy)=gridarea
+
+  ! Volume = area x box height
+  !***************************
+
+      volumen(ix,jy,1)=arean(ix,jy)*outheight(1)
+      do kz=2,numzgrid
+        volumen(ix,jy,kz)=arean(ix,jy)*(outheight(kz)-outheight(kz-1))
+      end do
+    end do
+  end do
+
+
+  !**************************************************************************
+  ! Determine average height of model topography in nesteed output grid cells
+  !**************************************************************************
+
+  ! Loop over all output grid cells
+  !********************************
+
+  do jjy=0,numygridn-1
+    do iix=0,numxgridn-1
+      oroh=0.
+
+  ! Take 100 samples of the topography in every grid cell
+  !******************************************************
+
+      do j1=1,10
+        ylat=outlat0n+(real(jjy)+real(j1)/10.-0.05)*dyoutn
+        yl=(ylat-ylat0)/dy
+        do i1=1,10
+          xlon=outlon0n+(real(iix)+real(i1)/10.-0.05)*dxoutn
+          xl=(xlon-xlon0)/dx
+
+  ! Determine the nest we are in
+  !*****************************
+
+          ngrid=0
+          do j=numbnests,1,-1
+            ! Temporary fix for nested layer edges: replaced eps with dxn and dyn (LB)
+            if ((xl.gt.xln(j)+dxn(j)).and.(xl.lt.xrn(j)-dxn(j)).and. &
+                 (yl.gt.yln(j)+dyn(j)).and.(yl.lt.yrn(j)-dyn(j))) then
+              ngrid=j
+              exit
+            endif
+          end do
+
+  ! Determine (nested) grid coordinates and auxiliary parameters used for interpolation
+  !*****************************************************************************
+
+          if (ngrid.gt.0) then
+            xtn=(xl-xln(ngrid))*xresoln(ngrid)
+            ytn=(yl-yln(ngrid))*yresoln(ngrid)
+            ix=int(xtn)
+            jy=int(ytn)
+            ddy=ytn-real(jy)
+            ddx=xtn-real(ix)
+          else
+            ix=int(xl)
+            jy=int(yl)
+            ddy=yl-real(jy)
+            ddx=xl-real(ix)
+          endif
+          ixp=ix+1
+          jyp=jy+1
+          rddx=1.-ddx
+          rddy=1.-ddy
+          p1=rddx*rddy
+          p2=ddx*rddy
+          p3=rddx*ddy
+          p4=ddx*ddy
+
+          if (ngrid.gt.0) then
+            oroh=oroh+p1*oron(ix ,jy ,ngrid) &
+                 + p2*oron(ixp,jy ,ngrid) &
+                 + p3*oron(ix ,jyp,ngrid) &
+                 + p4*oron(ixp,jyp,ngrid)
+          else
+            oroh=oroh+p1*oro(ix ,jy) &
+                 + p2*oro(ixp,jy) &
+                 + p3*oro(ix ,jyp) &
+                 + p4*oro(ixp,jyp)
+          endif
+        end do
+      end do
+
+  ! Divide by the number of samples taken
+  !**************************************
+
+      orooutn(iix,jjy)=oroh/100.
+    end do
+  end do
+
+  !*******************************
+  ! Initialization of output grids
+  !*******************************
+
+  do kp=1,maxpointspec_act
+    do ks=1,nspec
+      do nage=1,nageclass
+        do jy=0,numygridn-1
+          do ix=0,numxgridn-1
+            do l=1,nclassunc
+  ! Deposition fields
+              if (ldirect.gt.0) then
+                wetgriduncn(ix,jy,ks,kp,l,nage)=0.
+                drygriduncn(ix,jy,ks,kp,l,nage)=0.
+#ifdef _OPENMP
+                wetgriduncn_omp(ix,jy,ks,kp,l,nage,:)=0.
+                drygriduncn_omp(ix,jy,ks,kp,l,nage,:)=0.
+#endif
+              endif
+  ! Concentration fields
+              do kz=1,numzgrid
+                griduncn(ix,jy,kz,ks,kp,l,nage)=0.
+              end do
+            end do
+          end do
+        end do
+      end do
+    end do
+  end do
+end subroutine outgrid_init_nest
diff --git a/src/prepoutgrid_mod.f90 b/src/prepoutgrid_mod.f90
index f0b4e2e19e8e760f9e7286d4385fae799373fd71..4df835c60ec0fe4394e9b98397cc94e5a9ee2814 100644
--- a/src/prepoutgrid_mod.f90
+++ b/src/prepoutgrid_mod.f90
@@ -27,8 +27,8 @@ module prepoutgrid_mod
   real,allocatable, dimension (:,:,:) :: areaeast
   real,allocatable, dimension (:,:,:) :: areanorth
   real,allocatable, dimension (:,:,:) :: densityoutgrid
-  real,allocatable, dimension (:,:,:) :: densitydrygrid ! added RLT 
-  real,allocatable, dimension (:,:,:) :: factor_drygrid ! added RLT 
+  real,allocatable, dimension (:,:,:) :: densitydrygrid ! added RLT
+  real,allocatable, dimension (:,:,:) :: factor_drygrid ! added RLT
   real,allocatable, dimension (:,:,:) :: factor3d
   real,allocatable, dimension (:,:,:) :: grid
   real(dep_prec),allocatable, dimension (:,:) :: wetgrid
@@ -57,818 +57,10 @@ module prepoutgrid_mod
 
 contains
 
-subroutine outgrid_init
-  !
-  !*****************************************************************************
-  !                                                                            *
-  !  This routine initializes the output grids                                 *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     7 August 2002                                                          *
-  !                                                                            *
-  !  Changes                                                                   *
-  !     2022 L. Bakels: OpenMP parallelisation                                 *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  !                                                                            *
-  ! area               surface area of all output grid cells                   *
-  ! areaeast           eastward facing wall area of all output grid cells      *
-  ! areanorth          northward facing wall area of all output grid cells     *
-  ! volume             volumes of all output grid cells                        *
-  !                                                                            *
-  !*****************************************************************************
-
-  use ohr_mod
-  use unc_mod
-
-  integer :: ix,jy,kz,i,nage,l,iix,jjy,ixp,jyp,i1,j1,j,ngrid
-  integer :: ks,kp,stat
-  real :: ylat,gridarea,ylatp,ylatm,hzone,cosfactm,cosfactp
-  real :: xlon,xl,yl,ddx,ddy,rddx,rddy,p1,p2,p3,p4,xtn,ytn,oroh
-  real :: eps
-
-  eps=nxmax/3.e5
-
- ! Compute surface area and volume of each grid cell: area, volume;
- ! and the areas of the northward and eastward facing walls: areaeast, areanorth
- !***********************************************************************
-  do jy=0,numygrid-1
-    ylat=outlat0+(real(jy)+0.5)*dyout
-    ylatp=ylat+0.5*dyout
-    ylatm=ylat-0.5*dyout
-    if ((ylatm.lt.0).and.(ylatp.gt.0.)) then
-      hzone=dyout*r_earth*pi180
-    else
-
-  ! Calculate area of grid cell with formula M=2*pi*R*h*dx/360,
-  ! see Netz, Formeln der Mathematik, 5. Auflage (1983), p.90
-  !************************************************************
-
-      cosfactp=cos(ylatp*pi180)
-      cosfactm=cos(ylatm*pi180)
-      if (cosfactp.lt.cosfactm) then
-        hzone=sqrt(1-cosfactp**2)- &
-             sqrt(1-cosfactm**2)
-        hzone=hzone*r_earth
-      else
-        hzone=sqrt(1-cosfactm**2)- &
-             sqrt(1-cosfactp**2)
-        hzone=hzone*r_earth
-      endif
-    endif
-
-  ! Surface are of a grid cell at a latitude ylat
-  !**********************************************
-
-    gridarea=2.*pi*r_earth*hzone*dxout/360.
-
-    do ix=0,numxgrid-1
-      area(ix,jy)=gridarea
-
-  ! Volume = area x box height
-  !***************************
-
-      volume(ix,jy,1)=area(ix,jy)*outheight(1)
-      areaeast(ix,jy,1)=dyout*r_earth*pi180*outheight(1)
-      areanorth(ix,jy,1)=cos(ylat*pi180)*dxout*r_earth*pi180* &
-           outheight(1)
-      do kz=2,numzgrid
-        areaeast(ix,jy,kz)=dyout*r_earth*pi180* &
-             (outheight(kz)-outheight(kz-1))
-        areanorth(ix,jy,kz)=cos(ylat*pi180)*dxout*r_earth*pi180* &
-             (outheight(kz)-outheight(kz-1))
-        volume(ix,jy,kz)=area(ix,jy)*(outheight(kz)-outheight(kz-1))
-      end do
-    end do
-  end do
-
-  !******************************************************************
-  ! Determine average height of model topography in output grid cells
-  !******************************************************************
-
-  ! Loop over all output grid cells
-  !********************************
-
-  do jjy=0,numygrid-1
-    do iix=0,numxgrid-1
-      oroh=0.
-
-  ! Take 100 samples of the topography in every grid cell
-  !******************************************************
-
-      do j1=1,10
-        ylat=outlat0+(real(jjy)+real(j1)/10.-0.05)*dyout
-        yl=(ylat-ylat0)/dy
-        do i1=1,10
-          xlon=outlon0+(real(iix)+real(i1)/10.-0.05)*dxout
-          xl=(xlon-xlon0)/dx
-
-  ! Determine the nest we are in
-  !*****************************
-
-          ngrid=0
-          ! Temporary fix for nested layer edges: replaced eps with dxn and dyn (LB)
-          do j=numbnests,1,-1
-            if ((xl.gt.xln(j)+dxn(j)).and.(xl.lt.xrn(j)-dxn(j)).and. &
-                 (yl.gt.yln(j)+dyn(j)).and.(yl.lt.yrn(j)-dyn(j))) then
-              ngrid=j
-              exit
-            endif
-          end do
-
-! Determine (nested) grid coordinates & auxiliary parameters for interpolation
-!*****************************************************************************
-
-          if (ngrid.gt.0) then
-            xtn=(xl-xln(ngrid))*xresoln(ngrid)
-            ytn=(yl-yln(ngrid))*yresoln(ngrid)
-            ix=max(min(nint(xtn),nxn(ngrid)-1),0)
-            jy=max(min(nint(ytn),nyn(ngrid)-1),0)
-            ! ix=int(xtn)
-            ! jy=int(ytn)
-            ddy=ytn-real(jy)
-            ddx=xtn-real(ix)
-
-          else
-            ix=int(xl)
-            jy=int(yl)
-            ddy=yl-real(jy)
-            ddx=xl-real(ix)
-          endif
-          ixp=ix+1
-          jyp=jy+1
-          rddx=1.-ddx
-          rddy=1.-ddy
-          p1=rddx*rddy
-          p2=ddx*rddy
-          p3=rddx*ddy
-          p4=ddx*ddy
-
-          if (ngrid.gt.0) then
-            oroh=oroh+p1*oron(ix ,jy ,ngrid) &
-                 + p2*oron(ixp,jy ,ngrid) &
-                 + p3*oron(ix ,jyp,ngrid) &
-                 + p4*oron(ixp,jyp,ngrid)
-          else
-            oroh=oroh+p1*oro(ix ,jy) &
-                 + p2*oro(ixp,jy) &
-                 + p3*oro(ix ,jyp) &
-                 + p4*oro(ixp,jyp)
-          endif
-        end do
-      end do
-
-  ! Divide by the number of samples taken
-  !**************************************
-
-      oroout(iix,jjy)=oroh/100.
-    end do
-  end do
-
-  ! if necessary allocate flux fields
-  if (iflux.eq.1) then
-    allocate(flux(6,0:numxgrid-1,0:numygrid-1,numzgrid, &
-         1:nspec,1:maxpointspec_act,1:nageclass),stat=stat)
-    if (stat.ne.0) write(*,*)'ERROR: could not allocate flux array '
-#ifdef _OPENMP
-    allocate(flux_omp(6,0:numxgrid-1,0:numygrid-1,numzgrid, &
-         1:nspec,1:maxpointspec_act,1:nageclass,numthreads))
-    if (stat.ne.0) write(*,*)'ERROR: could not allocate flux_omp array '
-#endif
-  endif
-
-  ! gridunc,griduncn        uncertainty of outputted concentrations
-  allocate(gridunc(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec, &
-       maxpointspec_act,nclassunc,maxageclass),stat=stat)
-  if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc'
-#ifdef _OPENMP
-  allocate(gridunc_omp(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec, &
-       maxpointspec_act,nclassunc,maxageclass,numthreads_grid),stat=stat)
-  if (stat.ne.0) then
-    write(*,*)'ERROR: could not allocate gridunc_omp'
-    write(*,*)'increase the memory or reduce max_numthreads_grid in par_mod.f90.'
-    stop
-  endif
-#endif
-  if (ldirect.gt.0) then
-    allocate(wetgridunc(0:numxgrid-1,0:numygrid-1,maxspec, &
-         maxpointspec_act,nclassunc,maxageclass),stat=stat)
-    if (stat.ne.0) write(*,*)'ERROR: could not allocate wetgridunc'
-    allocate(drygridunc(0:numxgrid-1,0:numygrid-1,maxspec, &
-         maxpointspec_act,nclassunc,maxageclass),stat=stat)
-    if (stat.ne.0) write(*,*)'ERROR: could not allocate drygridunc'
-#ifdef _OPENMP
-    allocate(wetgridunc_omp(0:numxgrid-1,0:numygrid-1,maxspec, &
-         maxpointspec_act,nclassunc,maxageclass,numthreads_grid),stat=stat)
-    if (stat.ne.0) write(*,*)'ERROR: could not allocate wetgridunc_omp'
-    allocate(drygridunc_omp(0:numxgrid-1,0:numygrid-1,maxspec, &
-         maxpointspec_act,nclassunc,maxageclass,numthreads_grid),stat=stat)
-    if (stat.ne.0) write(*,*)'ERROR: could not allocate drygridunc_omp'
-#endif
-  endif
-
-#ifdef USE_MPIINPLACE
-#else
-! Extra field for totals at MPI root process
-  if (lroot.and.mpi_mode.gt.0) then
-! If MPI_IN_PLACE option is not used in mpi_mod.f90::mpif_tm_reduce_grid(),
-! then an aux array is needed for parallel grid reduction
-    allocate(gridunc0(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec, &
-         maxpointspec_act,nclassunc,maxageclass),stat=stat)
-    if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc0'
-  else if (.not.lroot.and.mpi_mode.gt.0) then
-    allocate(gridunc0(1,1,1,1,1,1,1),stat=stat)
-    if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc0'
-  end if
-#endif
-  if (ldirect.gt.0) then
-    if (lroot.and.mpi_mode.gt.0) then
-      allocate(wetgridunc0(0:numxgrid-1,0:numygrid-1,maxspec, &
-           maxpointspec_act,nclassunc,maxageclass),stat=stat)
-      if (stat.ne.0) write(*,*)'ERROR: could not allocate wetgridunc0'
-      allocate(drygridunc0(0:numxgrid-1,0:numygrid-1,maxspec, &
-           maxpointspec_act,nclassunc,maxageclass),stat=stat)
-      if (stat.ne.0) write(*,*)'ERROR: could not allocate drygridunc0'
-
-  ! allocate a dummy to avoid compilator complaints
-    else if (.not.lroot.and.mpi_mode.gt.0) then
-      allocate(wetgridunc0(1,1,1,1,1,1),stat=stat)
-      allocate(drygridunc0(1,1,1,1,1,1),stat=stat)
-    end if
-  end if
-
-  !write (*,*) 'Dimensions for fields', numxgrid,numygrid, &
-  !     maxspec,maxpointspec_act,nclassunc,maxageclass
-
-  if (lroot) then
-    write (*,*) 'Allocating fields for global output (x,y): ', &
-      numxgrid,numygrid
-    write (*,*) 'Allocating fields for nested output (x,y): ', &
-      numxgridn,numygridn 
-  end if
-
-  ! allocate fields for concoutput with maximum dimension of outgrid
-  ! and outgrid_nest
-
-  allocate(gridsigma(0:max(numxgrid,numxgridn)-1, &
-       0:max(numygrid,numygridn)-1,numzgrid),stat=stat)
-    if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc'
-  allocate(grid(0:max(numxgrid,numxgridn)-1, &
-       0:max(numygrid,numygridn)-1,numzgrid),stat=stat)
-    if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc'
-  allocate(densityoutgrid(0:max(numxgrid,numxgridn)-1, &
-       0:max(numygrid,numygridn)-1,numzgrid),stat=stat)
-    if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc'
-  ! RLT
-  allocate(densitydrygrid(0:max(numxgrid,numxgridn)-1, &
-       0:max(numygrid,numygridn)-1,numzgrid),stat=stat)
-    if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc'
-  allocate(factor_drygrid(0:max(numxgrid,numxgridn)-1, &
-       0:max(numygrid,numygridn)-1,numzgrid),stat=stat)
-    if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc'
-
-  allocate(factor3d(0:max(numxgrid,numxgridn)-1, &
-       0:max(numygrid,numygridn)-1,numzgrid),stat=stat)
-    if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc'
-  allocate(sparse_dump_r(max(numxgrid,numxgridn)* &
-       max(numygrid,numygridn)*numzgrid),stat=stat)
-    if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc'
-
-   allocate(sparse_dump_u(max(numxgrid,numxgridn)* &
-       max(numygrid,numygridn)*numzgrid),stat=stat)
-        if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc'
-
-  allocate(sparse_dump_i(max(numxgrid,numxgridn)* &
-       max(numygrid,numygridn)*numzgrid),stat=stat)
-    if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc'
-
-  ! deposition fields are only allocated for forward runs
-  if (ldirect.gt.0) then
-     allocate(wetgridsigma(0:max(numxgrid,numxgridn)-1, &
-          0:max(numygrid,numygridn)-1),stat=stat)
-     if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc'
-     allocate(drygridsigma(0:max(numxgrid,numxgridn)-1, &
-          0:max(numygrid,numygridn)-1),stat=stat)
-     if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc'
-     allocate(wetgrid(0:max(numxgrid,numxgridn)-1, &
-          0:max(numygrid,numygridn)-1),stat=stat)
-     if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc'
-     allocate(drygrid(0:max(numxgrid,numxgridn)-1, &
-          0:max(numygrid,numygridn)-1),stat=stat)
-     if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc'
-  endif
-
-  ! Initial condition field
-
-  if (linit_cond.gt.0) then
-    allocate(init_cond(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec, &
-         maxpointspec_act),stat=stat)
-    if (stat.ne.0) write(*,*)'ERROR: could not allocate init_cond'
-#ifdef _OPENMP
-    allocate(init_cond_omp(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec, &
-         maxpointspec_act,numthreads),stat=stat)
-    if (stat.ne.0) write(*,*)'ERROR: could not allocate init_cond_omp'
-#endif
-  endif
-
-  !************************
-  ! Initialize output grids
-  !************************
-
-  do ks=1,nspec
-    do kp=1,maxpointspec_act
-      if (numreceptor.gt.0) then
-        do i=1,numreceptor
-      ! Receptor points
-          creceptor(i,ks)=0.
-        end do
-      endif
-      do nage=1,nageclass
-        do jy=0,numygrid-1
-          do ix=0,numxgrid-1
-            do l=1,nclassunc
-    ! Deposition fields
-              if (ldirect.gt.0) then
-              wetgridunc(ix,jy,ks,kp,l,nage)=0.
-              drygridunc(ix,jy,ks,kp,l,nage)=0.
-#ifdef _OPENMP
-              wetgridunc_omp(ix,jy,ks,kp,l,nage,:)=0.
-              drygridunc_omp(ix,jy,ks,kp,l,nage,:)=0.
-#endif
-              endif
-              do kz=1,numzgrid
-                if (iflux.eq.1) then
-    ! Flux fields
-                   do i=1,5
-                     flux(i,ix,jy,kz,ks,kp,nage)=0.
-#ifdef _OPENMP
-                     flux_omp(i,ix,jy,kz,ks,kp,nage,:)=0.
-#endif
-                   end do
-                endif
-    ! Initial condition field
-                if ((l.eq.1).and.(nage.eq.1).and.(linit_cond.gt.0)) then
-                  init_cond(ix,jy,kz,ks,kp)=0.
-#ifdef _OPENMP
-                  init_cond_omp(ix,jy,kz,ks,kp,:)=0.
-#endif
-                endif
-    ! Concentration fields
-                gridunc(ix,jy,kz,ks,kp,l,nage)=0.
-#ifdef _OPENMP
-                gridunc_omp(ix,jy,kz,ks,kp,l,nage,:)=0.
-#endif
-              end do
-            end do
-          end do
-        end do
-      end do
-    end do
-  end do
-end subroutine outgrid_init
-
-subroutine outgrid_init_nest
-  !
-  !*****************************************************************************
-  !                                                                            *
-  !  This routine calculates, for each grid cell of the output nest, the       *
-  !  volume and the surface area.                                              *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !    30 August 2004                                                          *
-  !                                                                            *
-  !  Changes                                                                   *
-  !     2022 L. Bakels: OpenMP parallelisation                                 *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  !                                                                            *
-  ! arean              surface area of all output nest cells                   *
-  ! volumen            volumes of all output nest cells                        *
-  !                                                                            *
-  !*****************************************************************************
-
-  use unc_mod
-
-  integer :: ix,jy,kz,ks,kp,nage,l,iix,jjy,ixp,jyp,i1,j1,j,ngrid
-  integer :: stat
-  real :: ylat,gridarea,ylatp,ylatm,hzone,cosfactm,cosfactp
-  real :: xlon,xl,yl,ddx,ddy,rddx,rddy,p1,p2,p3,p4,xtn,ytn,oroh
-  real :: eps
-
-  eps=nxmax/3.e5
-
-  ! gridunc,griduncn        uncertainty of outputted concentrations
-  allocate(griduncn(0:numxgridn-1,0:numygridn-1,numzgrid,maxspec, &
-       maxpointspec_act,nclassunc,maxageclass),stat=stat)
-  if (stat.ne.0) write(*,*)'ERROR:could not allocate nested gridunc'
-#ifdef _OPENMP
-  allocate(griduncn_omp(0:numxgridn-1,0:numygridn-1,numzgrid,maxspec, &
-       maxpointspec_act,nclassunc,maxageclass,numthreads_grid),stat=stat)
-  if (stat.ne.0) write(*,*)'ERROR:could not allocate nested gridunc_omp'
-#endif
-
-  if (ldirect.gt.0) then
-    allocate(wetgriduncn(0:numxgridn-1,0:numygridn-1,maxspec, &
-         maxpointspec_act,nclassunc,maxageclass),stat=stat)
-    if (stat.ne.0) write(*,*)'ERROR:could not allocate nested gridunc'
-    allocate(drygriduncn(0:numxgridn-1,0:numygridn-1,maxspec, &
-         maxpointspec_act,nclassunc,maxageclass),stat=stat)
-    if (stat.ne.0) write(*,*)'ERROR:could not allocate nested gridunc'
-#ifdef _OPENMP
-    allocate(wetgriduncn_omp(0:numxgridn-1,0:numygridn-1,maxspec, &
-         maxpointspec_act,nclassunc,maxageclass,numthreads_grid),stat=stat)
-    if (stat.ne.0) write(*,*)'ERROR:could not allocate nested wetgridunc_omp'
-    allocate(drygriduncn_omp(0:numxgridn-1,0:numygridn-1,maxspec, &
-         maxpointspec_act,nclassunc,maxageclass,numthreads_grid),stat=stat)
-    if (stat.ne.0) write(*,*)'ERROR:could not allocate nested drygriduncn_omp'
-#endif
-  endif
-
-#ifdef USE_MPIINPLACE
-#else
-  ! Extra field for totals at MPI root process
-  if (lroot.and.mpi_mode.gt.0) then
-  ! If MPI_IN_PLACE option is not used in mpi_mod.f90::mpif_tm_reduce_grid_nest(),
-  ! then an aux array is needed for parallel grid reduction
-    allocate(griduncn0(0:numxgridn-1,0:numygridn-1,numzgrid,maxspec, &
-         maxpointspec_act,nclassunc,maxageclass),stat=stat)
-    if (stat.ne.0) write(*,*)'ERROR:could not allocate nested gridunc'
-  ! allocate a dummy to avoid compilator complaints
-  else if (.not.lroot.and.mpi_mode.gt.0) then
-    allocate(griduncn0(1,1,1,1,1,1,1),stat=stat)
-  end if
-#endif
-  if (ldirect.gt.0) then
-    if (lroot.and.mpi_mode.gt.0) then
-      allocate(wetgriduncn0(0:numxgridn-1,0:numygridn-1,maxspec, &
-           maxpointspec_act,nclassunc,maxageclass),stat=stat)
-      if (stat.ne.0) write(*,*)'ERROR:could not allocate nested gridunc'
-      allocate(drygriduncn0(0:numxgridn-1,0:numygridn-1,maxspec, &
-           maxpointspec_act,nclassunc,maxageclass),stat=stat)
-      if (stat.ne.0) write(*,*)'ERROR:could not allocate nested gridunc'
-  !  endif
-  ! allocate a dummy to avoid compilator complaints
-    else if (.not.lroot.and.mpi_mode.gt.0) then
-      allocate(wetgriduncn0(1,1,1,1,1,1),stat=stat)
-      allocate(drygriduncn0(1,1,1,1,1,1),stat=stat)
-    end if
-  end if
-
-  ! Compute surface area and volume of each grid cell: area, volume;
-  ! and the areas of the northward and eastward facing walls: areaeast, areanorth
-  !***********************************************************************
-
-  do jy=0,numygridn-1
-    ylat=outlat0n+(real(jy)+0.5)*dyoutn
-    ylatp=ylat+0.5*dyoutn
-    ylatm=ylat-0.5*dyoutn
-    if ((ylatm.lt.0).and.(ylatp.gt.0.)) then
-      hzone=dyoutn*r_earth*pi180
-    else
-
-  ! Calculate area of grid cell with formula M=2*pi*R*h*dx/360,
-  ! see Netz, Formeln der Mathematik, 5. Auflage (1983), p.90
-  !************************************************************
-
-      cosfactp=cos(ylatp*pi180)
-      cosfactm=cos(ylatm*pi180)
-      if (cosfactp.lt.cosfactm) then
-        hzone=sqrt(1-cosfactp**2)- &
-             sqrt(1-cosfactm**2)
-        hzone=hzone*r_earth
-      else
-        hzone=sqrt(1-cosfactm**2)- &
-             sqrt(1-cosfactp**2)
-        hzone=hzone*r_earth
-      endif
-    endif
-
-
-
-  ! Surface are of a grid cell at a latitude ylat
-  !**********************************************
-
-    gridarea=2.*pi*r_earth*hzone*dxoutn/360.
-
-    do ix=0,numxgridn-1
-      arean(ix,jy)=gridarea
-
-  ! Volume = area x box height
-  !***************************
-
-      volumen(ix,jy,1)=arean(ix,jy)*outheight(1)
-      do kz=2,numzgrid
-        volumen(ix,jy,kz)=arean(ix,jy)*(outheight(kz)-outheight(kz-1))
-      end do
-    end do
-  end do
-
-
-  !**************************************************************************
-  ! Determine average height of model topography in nesteed output grid cells
-  !**************************************************************************
-
-  ! Loop over all output grid cells
-  !********************************
-
-  do jjy=0,numygridn-1
-    do iix=0,numxgridn-1
-      oroh=0.
-
-  ! Take 100 samples of the topography in every grid cell
-  !******************************************************
-
-      do j1=1,10
-        ylat=outlat0n+(real(jjy)+real(j1)/10.-0.05)*dyoutn
-        yl=(ylat-ylat0)/dy
-        do i1=1,10
-          xlon=outlon0n+(real(iix)+real(i1)/10.-0.05)*dxoutn
-          xl=(xlon-xlon0)/dx
-
-  ! Determine the nest we are in
-  !*****************************
-
-          ngrid=0
-          do j=numbnests,1,-1
-            ! Temporary fix for nested layer edges: replaced eps with dxn and dyn (LB)
-            if ((xl.gt.xln(j)+dxn(j)).and.(xl.lt.xrn(j)-dxn(j)).and. &
-                 (yl.gt.yln(j)+dyn(j)).and.(yl.lt.yrn(j)-dyn(j))) then
-              ngrid=j
-              exit
-            endif
-          end do
-
-  ! Determine (nested) grid coordinates and auxiliary parameters used for interpolation
-  !*****************************************************************************
-
-          if (ngrid.gt.0) then
-            xtn=(xl-xln(ngrid))*xresoln(ngrid)
-            ytn=(yl-yln(ngrid))*yresoln(ngrid)
-            ix=int(xtn)
-            jy=int(ytn)
-            ddy=ytn-real(jy)
-            ddx=xtn-real(ix)
-          else
-            ix=int(xl)
-            jy=int(yl)
-            ddy=yl-real(jy)
-            ddx=xl-real(ix)
-          endif
-          ixp=ix+1
-          jyp=jy+1
-          rddx=1.-ddx
-          rddy=1.-ddy
-          p1=rddx*rddy
-          p2=ddx*rddy
-          p3=rddx*ddy
-          p4=ddx*ddy
-
-          if (ngrid.gt.0) then
-            oroh=oroh+p1*oron(ix ,jy ,ngrid) &
-                 + p2*oron(ixp,jy ,ngrid) &
-                 + p3*oron(ix ,jyp,ngrid) &
-                 + p4*oron(ixp,jyp,ngrid)
-          else
-            oroh=oroh+p1*oro(ix ,jy) &
-                 + p2*oro(ixp,jy) &
-                 + p3*oro(ix ,jyp) &
-                 + p4*oro(ixp,jyp)
-          endif
-        end do
-      end do
-
-  ! Divide by the number of samples taken
-  !**************************************
-
-      orooutn(iix,jjy)=oroh/100.
-    end do
-  end do
-
-  !*******************************
-  ! Initialization of output grids
-  !*******************************
-
-  do kp=1,maxpointspec_act
-    do ks=1,nspec
-      do nage=1,nageclass
-        do jy=0,numygridn-1
-          do ix=0,numxgridn-1
-            do l=1,nclassunc
-  ! Deposition fields
-              if (ldirect.gt.0) then
-                wetgriduncn(ix,jy,ks,kp,l,nage)=0.
-                drygriduncn(ix,jy,ks,kp,l,nage)=0.
-#ifdef _OPENMP
-                wetgriduncn_omp(ix,jy,ks,kp,l,nage,:)=0.
-                drygriduncn_omp(ix,jy,ks,kp,l,nage,:)=0.
-#endif
-              endif
-  ! Concentration fields
-              do kz=1,numzgrid
-                griduncn(ix,jy,kz,ks,kp,l,nage)=0.
-              end do
-            end do
-          end do
-        end do
-      end do
-    end do
-  end do
-end subroutine outgrid_init_nest
-
-subroutine initcond_calc(itime,i,thread)
-  !                               i   i
-  !*****************************************************************************
-  !                                                                            *
-  !     Calculation of the sensitivity to initial conditions for BW runs       *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     15 January 2010                                                        *
-  !                                                                            *
-  !  Changes                                                                   *
-  !     2022 L. Bakels: OpenMP parallelisation                                 *
-  !*****************************************************************************
-
-  use interpol_mod, only: interpol_density,ix,jy,ixp,jyp
-  use coord_ec_mod
-  use particle_mod
-
-  integer, intent(in) :: itime,i,thread
-  integer :: kz,ks
-  integer :: il,ind,indz,indzp,nrelpointer
-  real :: rddx,rddy,p1,p2,p3,p4,dz1,dz2,dz
-  real :: ddx,ddy
-  real :: rhoprof(2),rhoi,xl,yl,wx,wy,w
-  integer :: mind2
-  ! mind2        eso: pointer to 2nd windfield in memory
-
-
-  ! For forward simulations, make a loop over the number of species;
-  ! for backward simulations, make an additional loop over the release points
-  !**************************************************************************
-
-
-  if (.not. part(i)%alive) return
-
-  ! Depending on output option, calculate air density or set it to 1
-  ! linit_cond: 1=mass unit, 2=mass mixing ratio unit
-  !*****************************************************************
-
-
-  if (linit_cond.eq.1) then     ! mass unit
-    call update_zeta_to_z(itime,i)
-    call interpol_density(itime,i,rhoi)
-  elseif (linit_cond.eq.2) then    ! mass mixing ratio unit
-    rhoi=1.
-  endif
-
-  !****************************************************************************
-  ! 1. Evaluate grid concentrations using a uniform kernel of bandwidths dx, dy
-  !****************************************************************************
-
-
-  ! For backward simulations, look from which release point the particle comes from
-  ! For domain-filling trajectory option, npoint contains a consecutive particle
-  ! number, not the release point information. Therefore, nrelpointer is set to 1
-  ! for the domain-filling option.
-  !*****************************************************************************
-
-  if ((ioutputforeachrelease.eq.0).or.(mdomainfill.eq.1)) then
-    nrelpointer=1
-  else
-    nrelpointer=part(i)%npoint
-  endif
-
-  do kz=1,numzgrid                ! determine height of cell
-    if (real(outheight(kz),kind=dp).gt.part(i)%z) exit
-  end do
-
-  if (kz.le.numzgrid) then           ! inside output domain
-
-
-    xl=(part(i)%xlon*dx+xoutshift)/dxout
-    yl=(part(i)%ylat*dy+youtshift)/dyout
-    ix=int(xl)
-    if (xl.lt.0.) ix=ix-1
-    jy=int(yl)
-    if (yl.lt.0.) jy=jy-1
-
-
-  ! If a particle is close to the domain boundary, do not use the kernel either
-  !****************************************************************************
-
-    if ((xl.lt.0.5).or.(yl.lt.0.5).or. &
-         (xl.gt.real(numxgrid-1)-0.5).or. &
-         (yl.gt.real(numygrid-1)-0.5)) then             ! no kernel, direct attribution to grid cell
-      if ((ix.ge.0).and.(jy.ge.0).and.(ix.le.numxgrid-1).and. &
-           (jy.le.numygrid-1)) then
-        do ks=1,nspec
-#ifdef _OPENMP
-          init_cond_omp(ix,jy,kz,ks,nrelpointer,thread)= &
-               init_cond_omp(ix,jy,kz,ks,nrelpointer,thread)+ &
-               part(i)%mass(ks)/rhoi
-#else
-          init_cond(ix,jy,kz,ks,nrelpointer)= &
-               init_cond(ix,jy,kz,ks,nrelpointer)+ &
-               part(i)%mass(ks)/rhoi
-#endif
-        end do
-      endif
-
-    else                                 ! attribution via uniform kernel
-
-      ddx=xl-real(ix)                   ! distance to left cell border
-      ddy=yl-real(jy)                   ! distance to lower cell border
-      if (ddx.gt.0.5) then
-        ixp=ix+1
-        wx=1.5-ddx
-      else
-        ixp=ix-1
-        wx=0.5+ddx
-      endif
-
-      if (ddy.gt.0.5) then
-        jyp=jy+1
-        wy=1.5-ddy
-      else
-        jyp=jy-1
-        wy=0.5+ddy
-      endif
-
-
-  ! Determine mass fractions for four grid points
-  !**********************************************
-
-      if ((ix.ge.0).and.(ix.le.numxgrid-1)) then
-        if ((jy.ge.0).and.(jy.le.numygrid-1)) then
-          w=wx*wy
-          do ks=1,nspec
-#ifdef _OPENMP
-            init_cond_omp(ix,jy,kz,ks,nrelpointer,thread)= &
-              init_cond_omp(ix,jy,kz,ks,nrelpointer,thread) + &
-              part(i)%mass(ks) / rhoi * w
-#else
-            init_cond(ix,jy,kz,ks,nrelpointer)= &
-                 init_cond(ix,jy,kz,ks,nrelpointer)+part(i)%mass(ks)/rhoi*w
-#endif
-          end do
-        endif
-
-        if ((jyp.ge.0).and.(jyp.le.numygrid-1)) then
-          w=wx*(1.-wy)
-          do ks=1,nspec
-#ifdef _OPENMP
-            init_cond_omp(ix,jyp,kz,ks,nrelpointer,thread)= &
-              init_cond_omp(ix,jyp,kz,ks,nrelpointer,thread) + &
-              part(i)%mass(ks) / rhoi * w
-#else
-            init_cond(ix,jyp,kz,ks,nrelpointer)= &
-                 init_cond(ix,jyp,kz,ks,nrelpointer)+part(i)%mass(ks)/rhoi*w
-#endif
-          end do
-        endif
-      endif
-
-
-      if ((ixp.ge.0).and.(ixp.le.numxgrid-1)) then
-        if ((jyp.ge.0).and.(jyp.le.numygrid-1)) then
-          w=(1.-wx)*(1.-wy)
-          do ks=1,nspec
-#ifdef _OPENMP
-            init_cond_omp(ixp,jyp,kz,ks,nrelpointer,thread)= &
-                 init_cond_omp(ixp,jyp,kz,ks,nrelpointer,thread) + &
-                 part(i)%mass(ks) / rhoi * w
-#else
-            init_cond(ixp,jyp,kz,ks,nrelpointer)= &
-               init_cond(ixp,jyp,kz,ks,nrelpointer) + &
-               part(i)%mass(ks) / rhoi * w
-#endif
-          end do
-        endif
-
-        if ((jy.ge.0).and.(jy.le.numygrid-1)) then
-          w=(1.-wx)*wy
-          do ks=1,nspec
-#ifdef _OPENMP
-            init_cond_omp(ixp,jy,kz,ks,nrelpointer,thread)= &
-               init_cond_omp(ixp,jy,kz,ks,nrelpointer,thread) + &
-               part(i)%mass(ks) / rhoi * w
-#else
-            init_cond(ixp,jy,kz,ks,nrelpointer)= &
-              init_cond(ixp,jy,kz,ks,nrelpointer) + &
-              part(i)%mass(ks) / rhoi * w
-#endif
-          end do
-        endif
-      endif
-    endif
+#include "pre_outgrid_init.f90"
 
-  endif
+#include "pre_outgrid_init_nest.f90"
 
-end subroutine initcond_calc
+#include "pre_initcond_calc.f90"
 
 end module prepoutgrid_mod
diff --git a/src/qvs_ew.f90 b/src/qvs_ew.f90
new file mode 100644
index 0000000000000000000000000000000000000000..f26c083bab15bfd571ff34cd8551e18e8636518c
--- /dev/null
+++ b/src/qvs_ew.f90
@@ -0,0 +1,56 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+real function ew(x,p)
+
+  !****************************************************************
+  !SAETTIGUNGSDAMPFDRUCK UEBER WASSER IN PA. X IN KELVIN.
+  !NACH DER GOFF-GRATCH-FORMEL.
+  !****************************************************************
+
+  implicit none
+
+  real :: x, y, a, p , c, d
+
+  ew=0.
+  if(x.le.0.) stop 'sorry: t not in [k]'
+  ! Formula of Goff and Gratch (after Murray, 1966)
+  ! if (x.lt.273.15) then
+  ! ! Above ice
+  !   a = 273.15/x
+  !   y = -20.947031*a - 3.56654*log(a) - 2.01889049/a
+  !   ew = 5.75185606E10*exp(y)
+  ! else
+  ! ! Above water
+  !   a = 373.15/x
+  !   y = -18.1972839*a + 5.02808*log(a) - 70242.1852*exp(-26.1205253/a) + &
+  !     58.0691913*exp(-8.03945282*a)
+  !   ew = 7.95357242E10*exp(y)
+  ! endif
+
+  ! ! Formula of Magnus (after Murray, 1966)
+  ! if (x.lt.273.15) then
+  ! ! Above ice
+  !   ew = 6.1078*exp(21.8745584*(x-273.15)/(x-7.66))
+  ! else
+  ! ! Above water
+  !   ew = 6.1078*exp(17.2693882*(x-273.15)/(x-35.86))
+  ! endif
+
+  ! Formula of Buck 1981
+  ! ew = f_qvsat(p,x)
+
+  ! ! Original
+  y=373.16/x
+  a=-7.90298*(y-1.)
+  a=a+(5.02808*0.43429*alog(y))
+  c=(1.-(1./y))*11.344
+  c=-1.+(10.**c)
+  c=-1.3816*c/(10.**7)
+  d=(1.-y)*3.49149
+  d=-1.+(10.**d)
+  d=8.1328*d/(10.**3)
+  y=a+c+d
+  ew=101324.6*(10.**y)       ! Saettigungsdampfdruck in Pa
+
+end function ew
diff --git a/src/qvs_f_esi.f90 b/src/qvs_f_esi.f90
new file mode 100644
index 0000000000000000000000000000000000000000..8322f47b09a1e5e5ee72e4f4d8ef6956c9311d2a
--- /dev/null
+++ b/src/qvs_f_esi.f90
@@ -0,0 +1,37 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+real function f_esi( p, t )
+  ! Saturation water vapor pressure over ice (Pa)
+  implicit none
+
+  real :: p         ! Pressure (Pascal)
+  real :: t         ! Temperature (K)
+  real :: f
+
+  !#######################################################################
+  !
+  !Saturation specific humidity parameters used in enhanced Teten's
+  !formula. (See A. Buck, JAM 1981)
+  !
+  !#######################################################################
+  !
+  real,parameter ::  satfwa = 1.0007
+  real,parameter ::  satfwb = 3.46e-8  ! for p in Pa
+
+  real,parameter ::  satewa = 611.21   ! es in Pa
+  real,parameter ::  satewb = 17.502
+  real,parameter ::  satewc = 32.18
+
+  real,parameter ::  satfia = 1.0003
+  real,parameter ::  satfib = 4.18e-8  ! for p in Pa
+
+  real,parameter ::  sateia = 611.15   ! es in Pa
+  real,parameter ::  sateib = 22.452
+  real,parameter ::  sateic = 0.6
+
+  f = satfia + satfib * p
+  f_esi = f * sateia * exp( sateib*(t-273.15)/(t-sateic) )
+
+  return
+end function f_esi
diff --git a/src/qvs_f_esl.f90 b/src/qvs_f_esl.f90
new file mode 100644
index 0000000000000000000000000000000000000000..46e57a49d55c0ec15c72d7056f37ec641512c166
--- /dev/null
+++ b/src/qvs_f_esl.f90
@@ -0,0 +1,37 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+real function f_esl( p, t )
+  ! Saturation water vapor pressure over liquid water
+  implicit none
+
+  real :: p         ! Pressure (Pascal)
+  real :: t         ! Temperature (K)
+  real :: f
+
+  !#######################################################################
+  !
+  !Saturation specific humidity parameters used in enhanced Teten's
+  !formula. (See A. Buck, JAM 1981)
+  !
+  !#######################################################################
+
+  real,parameter ::  satfwa = 1.0007
+  real,parameter ::  satfwb = 3.46e-8  ! for p in Pa
+
+  real,parameter ::  satewa = 611.21   ! es in Pa
+  real,parameter ::  satewb = 17.502
+  real,parameter ::  satewc = 32.18
+
+  real,parameter ::  satfia = 1.0003
+  real,parameter ::  satfib = 4.18e-8  ! for p in Pa
+
+  real,parameter ::  sateia = 611.15   ! es in Pa
+  real,parameter ::  sateib = 22.452
+  real,parameter ::  sateic = 0.6
+
+  f = satfwa + satfwb * p
+  f_esl = f * satewa * exp( satewb*(t-273.15)/(t-satewc) )
+
+  return
+end function f_esl
diff --git a/src/qvs_f_qvsat.f90 b/src/qvs_f_qvsat.f90
new file mode 100644
index 0000000000000000000000000000000000000000..fe3093ec9c6341ab39038608b9657073c38de068
--- /dev/null
+++ b/src/qvs_f_qvsat.f90
@@ -0,0 +1,53 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+real function f_qvsat( p, t )
+
+  !PURPOSE:
+  !
+  !Calculate the saturation specific humidity using enhanced Teten's
+  !formula.
+  !
+  !AUTHOR: Yuhe Liu
+  !01/08/1998
+  !
+  !MODIFICATION HISTORY:
+  !
+  !INPUT :
+  !  p        Pressure (Pascal)
+  !  t        Temperature (K)
+  !OUTPUT:
+  !  f_qvsat  Saturation water vapor specific humidity (kg/kg).
+  !
+  !Variable Declarations.
+  !
+
+  implicit none
+
+  real :: p         ! Pressure (Pascal)
+  real :: t         ! Temperature (K)
+  real :: fespt
+
+  real,parameter ::  rd     = 287.0 ! Gas constant for dry air  (m**2/(s**2*K))
+  real,parameter ::  rv     = 461.0 ! Gas constant for water vapor  (m**2/(s**2*K)).
+  real,parameter ::  rddrv  = rd/rv
+
+
+  ! Change by A. Stohl to save computation time:
+  ! IF ( t.ge.273.15 ) THEN     ! for water
+  if ( t.ge.253.15 ) then      ! modification Petra Seibert
+                               ! (supercooled water may be present)
+    fespt=f_esl(p,t)
+  else
+    fespt=f_esi(p,t)
+  endif
+
+!!$  f_qvsat = rddrv * fespt / (p-(1.0-rddrv)*fespt)      !old
+  if (p-(1.0-rddrv)*fespt == 0.) then                     !bugfix
+     f_qvsat = 1.
+  else
+     f_qvsat = rddrv * fespt / (p-(1.0-rddrv)*fespt)
+  end if
+
+  return
+end function f_qvsat
diff --git a/src/qvsat_mod.f90 b/src/qvsat_mod.f90
index d353b9417f87a1c4d92cf3d6a403c2fece4a03ef..f01b45a0dc8d15d874cfbbb424baeb5f7c17c7bf 100644
--- a/src/qvsat_mod.f90
+++ b/src/qvsat_mod.f90
@@ -11,7 +11,7 @@
 !##################################################################
 !##################################################################
 module qvsat_mod
-  
+
   implicit none
   private
 
@@ -19,180 +19,13 @@ module qvsat_mod
 
 contains
 
-real function f_qvsat( p, t )
-
-  !PURPOSE:
-  !
-  !Calculate the saturation specific humidity using enhanced Teten's
-  !formula.
-  !
-  !AUTHOR: Yuhe Liu
-  !01/08/1998
-  !
-  !MODIFICATION HISTORY:
-  !
-  !INPUT :
-  !  p        Pressure (Pascal)
-  !  t        Temperature (K)
-  !OUTPUT:
-  !  f_qvsat  Saturation water vapor specific humidity (kg/kg).
-  !
-  !Variable Declarations.
-  !
-
-  implicit none
-
-  real :: p         ! Pressure (Pascal)
-  real :: t         ! Temperature (K)
-  real :: fespt
-
-  real,parameter ::  rd     = 287.0 ! Gas constant for dry air  (m**2/(s**2*K))
-  real,parameter ::  rv     = 461.0 ! Gas constant for water vapor  (m**2/(s**2*K)).
-  real,parameter ::  rddrv  = rd/rv
-
-
-  ! Change by A. Stohl to save computation time:
-  ! IF ( t.ge.273.15 ) THEN     ! for water
-  if ( t.ge.253.15 ) then      ! modification Petra Seibert
-                               ! (supercooled water may be present)
-    fespt=f_esl(p,t)
-  else
-    fespt=f_esi(p,t)
-  endif
-
-!!$  f_qvsat = rddrv * fespt / (p-(1.0-rddrv)*fespt)      !old
-  if (p-(1.0-rddrv)*fespt == 0.) then                     !bugfix
-     f_qvsat = 1.
-  else
-     f_qvsat = rddrv * fespt / (p-(1.0-rddrv)*fespt)
-  end if
-
-  return
-end function f_qvsat
-
-
-real function f_esl( p, t )
-  ! Saturation water vapor pressure over liquid water
-  implicit none
-
-  real :: p         ! Pressure (Pascal)
-  real :: t         ! Temperature (K)
-  real :: f
-
-  !#######################################################################
-  !
-  !Saturation specific humidity parameters used in enhanced Teten's
-  !formula. (See A. Buck, JAM 1981)
-  !
-  !#######################################################################
-
-  real,parameter ::  satfwa = 1.0007
-  real,parameter ::  satfwb = 3.46e-8  ! for p in Pa
-
-  real,parameter ::  satewa = 611.21   ! es in Pa
-  real,parameter ::  satewb = 17.502
-  real,parameter ::  satewc = 32.18
-
-  real,parameter ::  satfia = 1.0003
-  real,parameter ::  satfib = 4.18e-8  ! for p in Pa
-
-  real,parameter ::  sateia = 611.15   ! es in Pa
-  real,parameter ::  sateib = 22.452
-  real,parameter ::  sateic = 0.6
-
-  f = satfwa + satfwb * p
-  f_esl = f * satewa * exp( satewb*(t-273.15)/(t-satewc) )
-
-  return
-end function f_esl
-
-real function f_esi( p, t )
-  ! Saturation water vapor pressure over ice (Pa)
-  implicit none
-
-  real :: p         ! Pressure (Pascal)
-  real :: t         ! Temperature (K)
-  real :: f
-
-  !#######################################################################
-  !
-  !Saturation specific humidity parameters used in enhanced Teten's
-  !formula. (See A. Buck, JAM 1981)
-  !
-  !#######################################################################
-  !
-  real,parameter ::  satfwa = 1.0007
-  real,parameter ::  satfwb = 3.46e-8  ! for p in Pa
-
-  real,parameter ::  satewa = 611.21   ! es in Pa
-  real,parameter ::  satewb = 17.502
-  real,parameter ::  satewc = 32.18
-
-  real,parameter ::  satfia = 1.0003
-  real,parameter ::  satfib = 4.18e-8  ! for p in Pa
-
-  real,parameter ::  sateia = 611.15   ! es in Pa
-  real,parameter ::  sateib = 22.452
-  real,parameter ::  sateic = 0.6
-
-  f = satfia + satfib * p
-  f_esi = f * sateia * exp( sateib*(t-273.15)/(t-sateic) )
-
-  return
-end function f_esi
-
-real function ew(x,p)
-
-  !****************************************************************
-  !SAETTIGUNGSDAMPFDRUCK UEBER WASSER IN PA. X IN KELVIN.
-  !NACH DER GOFF-GRATCH-FORMEL.
-  !****************************************************************
-
-  implicit none
-
-  real :: x, y, a, p , c, d
-
-  ew=0.
-  if(x.le.0.) stop 'sorry: t not in [k]'
-  ! Formula of Goff and Gratch (after Murray, 1966)
-  ! if (x.lt.273.15) then
-  ! ! Above ice
-  !   a = 273.15/x
-  !   y = -20.947031*a - 3.56654*log(a) - 2.01889049/a
-  !   ew = 5.75185606E10*exp(y)
-  ! else
-  ! ! Above water
-  !   a = 373.15/x 
-  !   y = -18.1972839*a + 5.02808*log(a) - 70242.1852*exp(-26.1205253/a) + &
-  !     58.0691913*exp(-8.03945282*a)
-  !   ew = 7.95357242E10*exp(y)
-  ! endif
+#include "qvs_f_qvsat.f90"
 
-  ! ! Formula of Magnus (after Murray, 1966)
-  ! if (x.lt.273.15) then
-  ! ! Above ice
-  !   ew = 6.1078*exp(21.8745584*(x-273.15)/(x-7.66))
-  ! else 
-  ! ! Above water
-  !   ew = 6.1078*exp(17.2693882*(x-273.15)/(x-35.86))
-  ! endif
 
-  ! Formula of Buck 1981
-  ! ew = f_qvsat(p,x)
+#include "qvs_f_esl.f90"
 
-  ! ! Original
-  y=373.16/x
-  a=-7.90298*(y-1.)
-  a=a+(5.02808*0.43429*alog(y))
-  c=(1.-(1./y))*11.344
-  c=-1.+(10.**c)
-  c=-1.3816*c/(10.**7)
-  d=(1.-y)*3.49149
-  d=-1.+(10.**d)
-  d=8.1328*d/(10.**3)
-  y=a+c+d
-  ew=101324.6*(10.**y)       ! Saettigungsdampfdruck in Pa
+#include "qvs_f_esi.f90"
 
-end function ew
+#include "qvs_ew.f90"
 
-end module qvsat_mod
\ No newline at end of file
+end module qvsat_mod
diff --git a/src/ran_alloc_random.f90 b/src/ran_alloc_random.f90
new file mode 100644
index 0000000000000000000000000000000000000000..2ed4d3d14b359e38987c4f0bcc553cd41340105e
--- /dev/null
+++ b/src/ran_alloc_random.f90
@@ -0,0 +1,25 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+  subroutine alloc_random(num_threads)
+
+    implicit none
+
+    integer :: num_threads, i
+
+    allocate(ran1_iv(ran1_ntab,0:num_threads-1),ran1_iy(0:num_threads-1))
+    allocate(gasdev_iset(0:num_threads-1),gasdev_gset(0:num_threads-1))
+    allocate(ran3_iff(0:num_threads-1),ran3_inext(0:num_threads-1),ran3_inextp(0:num_threads-1))
+    allocate(ma(55,0:num_threads-1))
+    allocate(iseed1(0:num_threads-1),iseed2(0:num_threads-1))
+
+    do i=0,num_threads-1
+      iseed1(i) = -7-i
+      iseed2(i) = -88-i
+    end do
+    ran3_iff(0:num_threads-1)=0
+    ran1_iv(:,0:num_threads-1)=0
+    ran1_iy(0:num_threads-1)=0
+    gasdev_iset(0:num_threads-1)=0
+    gasdev_gset(0:num_threads-1)=0
+  end subroutine alloc_random
diff --git a/src/ran_dealloc_random.f90 b/src/ran_dealloc_random.f90
new file mode 100644
index 0000000000000000000000000000000000000000..c3ad0d5a8005b2de5e45fbd8b1e5eae30f455437
--- /dev/null
+++ b/src/ran_dealloc_random.f90
@@ -0,0 +1,11 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+  subroutine dealloc_random()
+
+    deallocate(ran1_iv,ran1_iy)
+    deallocate(gasdev_iset,gasdev_gset)
+    deallocate(ran3_iff,ran3_inext,ran3_inextp)
+    deallocate(ma)
+    deallocate(iseed1,iseed2)
+  end subroutine dealloc_random
diff --git a/src/ran_gasdev.f90 b/src/ran_gasdev.f90
new file mode 100644
index 0000000000000000000000000000000000000000..6930e50c8052dae06513691b9831542a496879df
--- /dev/null
+++ b/src/ran_gasdev.f90
@@ -0,0 +1,24 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+  function gasdev(idum,ithread)
+
+    implicit none
+
+    integer :: idum,ithread
+    real    :: gasdev, fac, r, v1, v2
+
+    if (gasdev_iset(ithread).eq.0) then
+1     v1=2.*ran3(idum,ithread)-1.
+      v2=2.*ran3(idum,ithread)-1.
+      r=v1**2+v2**2
+      if(r.ge.1.0 .or. r.eq.0.0) go to 1
+      fac=sqrt(-2.*log(r)/r)
+      gasdev_gset(ithread)=v1*fac
+      gasdev=v2*fac
+      gasdev_iset(ithread)=1
+    else
+      gasdev=gasdev_gset(ithread)
+      gasdev_iset(ithread)=0
+    endif
+  end function gasdev
diff --git a/src/ran_gasdev1.f90 b/src/ran_gasdev1.f90
new file mode 100644
index 0000000000000000000000000000000000000000..8843906870e548e2648710c6b9df4021ba7695ce
--- /dev/null
+++ b/src/ran_gasdev1.f90
@@ -0,0 +1,24 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+  subroutine gasdev1(idum,random1,random2)
+
+    implicit none
+
+    integer :: idum
+    real :: random1, random2, fac, v1, v2, r
+
+1   v1=2.*ran3(idum,0)-1.
+    v2=2.*ran3(idum,0)-1.
+    r=v1**2+v2**2
+    if(r.ge.1.0 .or. r.eq.0.0) go to 1
+    fac=sqrt(-2.*log(r)/r)
+    random1=v1*fac
+    random2=v2*fac
+! Limit the random numbers to lie within the interval -3 and +3
+!**************************************************************
+    if (random1.lt.-3.) random1=-3.
+    if (random2.lt.-3.) random2=-3.
+    if (random1.gt.3.) random1=3.
+    if (random2.gt.3.) random2=3.
+  end subroutine gasdev1
diff --git a/src/ran_ran1.f90 b/src/ran_ran1.f90
new file mode 100644
index 0000000000000000000000000000000000000000..e3fbf694bf9c7b0ca94766de42d6aadedeb4b6c5
--- /dev/null
+++ b/src/ran_ran1.f90
@@ -0,0 +1,32 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+  function ran1(idum,ithread)
+
+    implicit none
+
+    integer :: idum,ithread
+    real    :: ran1
+    integer,parameter :: ia=16807, im=2147483647, iq=127773, ir=2836
+    integer,parameter :: ndiv=1+(im-1)/ran1_ntab
+    real,parameter    :: am=1./im, eps=1.2e-7, rnmx=1.-eps
+    integer :: j, k
+
+    if (idum.le.0.or.ran1_iy(ithread).eq.0) then
+      idum=max(-idum,1)
+      do j=ran1_ntab+8,1,-1
+        k=idum/iq
+        idum=ia*(idum-k*iq)-ir*k
+        if (idum.lt.0) idum=idum+im
+        if (j.le.ran1_ntab) ran1_iv(j,ithread)=idum
+      enddo
+      ran1_iy(ithread)=ran1_iv(1,ithread)
+    endif
+    k=idum/iq
+    idum=ia*(idum-k*iq)-ir*k
+    if (idum.lt.0) idum=idum+im
+    j=1+ran1_iy(ithread)/ndiv
+    ran1_iy(ithread)=ran1_iv(j,ithread)
+    ran1_iv(j,ithread)=idum
+    ran1=min(am*ran1_iy(ithread),rnmx)
+  end function ran1
diff --git a/src/ran_ran3.f90 b/src/ran_ran3.f90
new file mode 100644
index 0000000000000000000000000000000000000000..0ed39a967ed3bac547feee3151c18c049e4cc4e7
--- /dev/null
+++ b/src/ran_ran3.f90
@@ -0,0 +1,47 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+  function ran3(idum,ithread)
+
+    implicit none
+
+    integer :: idum,ithread
+    real :: ran3
+
+    integer,parameter :: mbig=1000000000, mseed=161803398, mz=0
+    real,parameter    :: fac=1./mbig
+    integer :: i,ii,inext,inextp,k
+    integer :: mj,mk
+
+    if(idum.lt.0 .or. ran3_iff(ithread).eq.0)then
+      ran3_iff(ithread)=1
+      mj=mseed-iabs(idum)
+      mj=mod(mj,mbig)
+      ma(55,ithread)=mj
+      mk=1
+      do i=1,54
+        ii=mod(21*i,55)
+        ma(ii,ithread)=mk
+        mk=mj-mk
+        if(mk.lt.mz)mk=mk+mbig
+        mj=ma(ii,ithread)
+      end do
+      do k=1,4
+        do i=1,55
+          ma(i,ithread)=ma(i,ithread)-ma(1+mod(i+30,55),ithread)
+          if(ma(i,ithread).lt.mz) ma(i,ithread)=ma(i,ithread)+mbig
+        end do
+      end do
+      ran3_inext(ithread)=0
+      ran3_inextp(ithread)=31
+      idum=1
+    endif
+    ran3_inext(ithread)=ran3_inext(ithread)+1
+    if(ran3_inext(ithread).eq.56) ran3_inext(ithread)=1
+    ran3_inextp(ithread)=ran3_inextp(ithread)+1
+    if(ran3_inextp(ithread).eq.56) ran3_inextp(ithread)=1
+    mj=ma(ran3_inext(ithread),ithread)-ma(ran3_inextp(ithread),ithread)
+    if(mj.lt.mz)mj=mj+mbig
+    ma(ran3_inext(ithread),ithread)=mj
+    ran3=mj*fac
+  end function ran3
diff --git a/src/random_mod.f90 b/src/random_mod.f90
index 803cc9310d071752286c744536ddbbec2ec7bb71..f42e3b49f2fc341d6195930d81aa208ffac73c08 100644
--- a/src/random_mod.f90
+++ b/src/random_mod.f90
@@ -4,7 +4,7 @@
 !  Taken from Press et al., Numerical Recipes
 
 module random_mod
-  
+
   implicit none
 
   integer, parameter :: ran1_ntab=32
@@ -20,160 +20,21 @@ module random_mod
   integer, allocatable :: iseed1(:), iseed2(:)
 
 contains
-  
-  subroutine alloc_random(num_threads)
-
-    implicit none
-
-    integer :: num_threads, i
-
-    allocate(ran1_iv(ran1_ntab,0:num_threads-1),ran1_iy(0:num_threads-1))
-    allocate(gasdev_iset(0:num_threads-1),gasdev_gset(0:num_threads-1))
-    allocate(ran3_iff(0:num_threads-1),ran3_inext(0:num_threads-1),ran3_inextp(0:num_threads-1))
-    allocate(ma(55,0:num_threads-1))
-    allocate(iseed1(0:num_threads-1),iseed2(0:num_threads-1))
-
-    do i=0,num_threads-1
-      iseed1(i) = -7-i
-      iseed2(i) = -88-i
-    end do
-    ran3_iff(0:num_threads-1)=0
-    ran1_iv(:,0:num_threads-1)=0
-    ran1_iy(0:num_threads-1)=0
-    gasdev_iset(0:num_threads-1)=0
-    gasdev_gset(0:num_threads-1)=0
-  end subroutine alloc_random
-
-  subroutine dealloc_random()
-
-    deallocate(ran1_iv,ran1_iy)
-    deallocate(gasdev_iset,gasdev_gset)
-    deallocate(ran3_iff,ran3_inext,ran3_inextp)
-    deallocate(ma)
-    deallocate(iseed1,iseed2)
-  end subroutine dealloc_random
-
-  function ran1(idum,ithread)
-
-    implicit none
-
-    integer :: idum,ithread
-    real    :: ran1
-    integer,parameter :: ia=16807, im=2147483647, iq=127773, ir=2836
-    integer,parameter :: ndiv=1+(im-1)/ran1_ntab
-    real,parameter    :: am=1./im, eps=1.2e-7, rnmx=1.-eps
-    integer :: j, k
-
-    if (idum.le.0.or.ran1_iy(ithread).eq.0) then
-      idum=max(-idum,1)
-      do j=ran1_ntab+8,1,-1
-        k=idum/iq
-        idum=ia*(idum-k*iq)-ir*k
-        if (idum.lt.0) idum=idum+im
-        if (j.le.ran1_ntab) ran1_iv(j,ithread)=idum
-      enddo
-      ran1_iy(ithread)=ran1_iv(1,ithread)
-    endif
-    k=idum/iq
-    idum=ia*(idum-k*iq)-ir*k
-    if (idum.lt.0) idum=idum+im
-    j=1+ran1_iy(ithread)/ndiv
-    ran1_iy(ithread)=ran1_iv(j,ithread)
-    ran1_iv(j,ithread)=idum
-    ran1=min(am*ran1_iy(ithread),rnmx)
-  end function ran1
-
-
-  function gasdev(idum,ithread)
-
-    implicit none
-
-    integer :: idum,ithread
-    real    :: gasdev, fac, r, v1, v2
-
-    if (gasdev_iset(ithread).eq.0) then
-1     v1=2.*ran3(idum,ithread)-1.
-      v2=2.*ran3(idum,ithread)-1.
-      r=v1**2+v2**2
-      if(r.ge.1.0 .or. r.eq.0.0) go to 1
-      fac=sqrt(-2.*log(r)/r)
-      gasdev_gset(ithread)=v1*fac
-      gasdev=v2*fac
-      gasdev_iset(ithread)=1
-    else
-      gasdev=gasdev_gset(ithread)
-      gasdev_iset(ithread)=0
-    endif
-  end function gasdev
-
-
-  subroutine gasdev1(idum,random1,random2)
-
-    implicit none
-
-    integer :: idum
-    real :: random1, random2, fac, v1, v2, r
-
-1   v1=2.*ran3(idum,0)-1.
-    v2=2.*ran3(idum,0)-1.
-    r=v1**2+v2**2
-    if(r.ge.1.0 .or. r.eq.0.0) go to 1
-    fac=sqrt(-2.*log(r)/r)
-    random1=v1*fac
-    random2=v2*fac
-! Limit the random numbers to lie within the interval -3 and +3
-!**************************************************************
-    if (random1.lt.-3.) random1=-3.
-    if (random2.lt.-3.) random2=-3.
-    if (random1.gt.3.) random1=3.
-    if (random2.gt.3.) random2=3.
-  end subroutine gasdev1
-
-
-  function ran3(idum,ithread)
-
-    implicit none
-
-    integer :: idum,ithread
-    real :: ran3
-
-    integer,parameter :: mbig=1000000000, mseed=161803398, mz=0
-    real,parameter    :: fac=1./mbig
-    integer :: i,ii,inext,inextp,k
-    integer :: mj,mk
-
-    if(idum.lt.0 .or. ran3_iff(ithread).eq.0)then
-      ran3_iff(ithread)=1
-      mj=mseed-iabs(idum)
-      mj=mod(mj,mbig)
-      ma(55,ithread)=mj
-      mk=1
-      do i=1,54
-        ii=mod(21*i,55)
-        ma(ii,ithread)=mk
-        mk=mj-mk
-        if(mk.lt.mz)mk=mk+mbig
-        mj=ma(ii,ithread)
-      end do
-      do k=1,4
-        do i=1,55
-          ma(i,ithread)=ma(i,ithread)-ma(1+mod(i+30,55),ithread)
-          if(ma(i,ithread).lt.mz) ma(i,ithread)=ma(i,ithread)+mbig
-        end do
-      end do
-      ran3_inext(ithread)=0
-      ran3_inextp(ithread)=31
-      idum=1
-    endif
-    ran3_inext(ithread)=ran3_inext(ithread)+1
-    if(ran3_inext(ithread).eq.56) ran3_inext(ithread)=1
-    ran3_inextp(ithread)=ran3_inextp(ithread)+1
-    if(ran3_inextp(ithread).eq.56) ran3_inextp(ithread)=1
-    mj=ma(ran3_inext(ithread),ithread)-ma(ran3_inextp(ithread),ithread)
-    if(mj.lt.mz)mj=mj+mbig
-    ma(ran3_inext(ithread),ithread)=mj
-    ran3=mj*fac
-  end function ran3
+
+#include "ran_alloc_random.f90"
+
+#include "ran_dealloc_random.f90"
+
+#include "ran_ran1.f90"
+
+
+#include "ran_gasdev.f90"
+
+
+#include "ran_gasdev1.f90"
+
+
+#include "ran_ran3.f90"
 !  (C) Copr. 1986-92 Numerical Recipes Software US.
 
 end module random_mod
diff --git a/src/rea_readOHfield.f90 b/src/rea_readOHfield.f90
new file mode 100644
index 0000000000000000000000000000000000000000..989fb591d587a85baa1da8a936390dc296a0fddf
--- /dev/null
+++ b/src/rea_readOHfield.f90
@@ -0,0 +1,76 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine readOHfield
+
+  !*****************************************************************************
+  !                                                                            *
+  ! Reads the OH field into memory                                             *
+  !                                                                            *
+  ! AUTHOR: R.L. Thompson, Nov 2014                                            *
+  !                                                                            *
+  ! UPDATES:                                                                   *
+  !   03/2018 SEC: Converted original netCDF files to binary format            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  ! path(numpath)              contains the path names                         *
+  ! lonOH(nxOH)                longitude of OH fields                          *
+  ! latOH(nyOH)                latitude of OH fields                           *
+  ! altOH(nzOH)                altitude of OH fields                           *
+  ! etaOH(nzOH)                eta-levels of OH fields                         *
+  ! OH_field(nxOH,nyOH,nzOH,m) OH concentration (molecules/cm3)                *
+  !                                                                            *
+  !                                                                            *
+  !*****************************************************************************
+
+  use ohr_mod
+
+  implicit none
+
+  integer :: i,j,k,l,ierr
+  real, dimension(:), allocatable :: etaOH
+
+  !  real, parameter :: gasct=8.314   ! gas constant
+  !  real, parameter :: mct=0.02894   ! kg mol-1
+  !  real, parameter :: g=9.80665     ! m s-2
+  !  real, parameter :: lrate=0.0065  ! K m-1
+  real, parameter :: scalehgt=7000. ! scale height in metres
+
+
+  open(unitOH,file=trim(ohfields_path) &
+       //'OH_FIELDS/OH_variables.bin',status='old', &
+       form='UNFORMATTED', iostat=ierr, convert='little_endian')
+
+  if(ierr.ne.0) then
+    write(*,*) 'Cannot read binary OH fields in ', &
+      trim(ohfields_path)//'OH_FIELDS/OH_variables.bin'
+    stop
+  endif
+
+  read(unitOH) nxOH
+  read(unitOH) nyOH
+  read(unitOH) nzOH
+  write(*,*) nxOH,nyOH,nzOH
+
+  ! allocate variables
+  allocate(lonOH(nxOH))
+  allocate(latOH(nyOH))
+  allocate(etaOH(nzOH))
+  allocate(altOH(nzOH))
+  allocate(OH_field(nxOH,nyOH,nzOH,12))
+  allocate(OH_hourly(nxOH,nyOH,nzOH,2))
+
+  read(unitOH) (lonjr(i),i=1,360)
+  read(unitOH) (latjr(i),i=1,180)
+  read(unitOH) (((jrate_average(i,j,k),i=1,360),j=1,180),k=1,12)
+  read(unitOH) (lonOH(i),i=1,nxOH)
+  read(unitOH) (latOH(i),i=1,nyOH)
+  read(unitOH) (lonOH(i),i=1,nxOH)
+
+  read(unitOH) (altOH(i),i=1,nzOH)
+  read(unitOH) ((((OH_field(i,j,k,l),i=1,nxOH),j=1,nyOH),k=1,nzOH),l=1,12)
+  read(unitOH) ((((OH_hourly(i,j,k,l),i=1,nxOH),j=1,nyOH),k=1,nzOH),l=1,2)
+
+end subroutine readOHfield
diff --git a/src/rea_readageclasses.f90 b/src/rea_readageclasses.f90
new file mode 100644
index 0000000000000000000000000000000000000000..cf52ae3253cce916f351a83eeab4090966513f82
--- /dev/null
+++ b/src/rea_readageclasses.f90
@@ -0,0 +1,119 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine readageclasses
+
+  !*****************************************************************************
+  !                                                                            *
+  !     This routine reads the age classes to be used for the current model    *
+  !     run.                                                                   *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !     20 March 2000                                                          *
+  !     HSO, 1 July 2014                                                       *
+  !     Added optional namelist input                                          *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  ! Constants:                                                                 *
+  !                                                                            *
+  !*****************************************************************************
+
+  implicit none
+
+  integer :: i
+
+  ! namelist help variables
+  integer :: ios
+
+  ! namelist declaration
+  namelist /ageclass/ &
+    nageclass, &
+    lage
+
+  ! If age spectra calculation is switched off, set number of age classes
+  ! to 1 and maximum age to a large number
+  !**********************************************************************
+
+  if (lagespectra.ne.1) then
+    nageclass=1
+    lage(nageclass)=999999999
+    return
+  endif
+
+  ! If age spectra claculation is switched on,
+  ! open the AGECLASSSES file and read user options
+  !************************************************
+
+  open(unitageclasses,file=path(1)(1:length(1))//'AGECLASSES', &
+    form='formatted',status='old',err=999)
+
+! try to read in as a namelist
+  nageclass=-1 ! preset to negative value to identify failed namelist input
+  read(unitageclasses,ageclass,iostat=ios)
+  close(unitageclasses)
+
+  if (nageclass.lt.0 .or. ios.ne.0) then
+    open(unitageclasses,file=path(1)(1:length(1))//'AGECLASSES', &
+      status='old',err=999)
+    do i=1,13
+      read(unitageclasses,*)
+    end do
+    read(unitageclasses,*) nageclass
+    read(unitageclasses,*) lage(1)
+    if (nageclass.ge.2) then
+      do i=2,nageclass
+        read(unitageclasses,*) lage(i)
+      end do
+    endif
+    close(unitageclasses)
+  endif
+
+  ! write ageclasses file in namelist format to output directory if requested
+!  if (nmlout.and.lroot) then
+  if (nmlout) then
+    open(unitageclasses,file=path(2)(1:length(2))//'AGECLASSES.namelist', &
+      err=1000)
+    write(unitageclasses,nml=ageclass)
+    close(unitageclasses)
+  endif
+
+  if (nageclass.gt.maxageclass) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! NUMBER OF AGE     #### '
+    write(*,*) ' #### CLASSES GREATER THAN MAXIMUM ALLOWED.   #### '
+    write(*,*) ' #### CHANGE SETTINGS IN FILE AGECLASSES OR   #### '
+    write(*,*) ' #### RECOMPILE WITH LARGER MAXAGECLASS IN    #### '
+    write(*,*) ' #### FILE PAR_MOD.                        #### '
+    stop
+  endif
+
+  if (lage(1).le.0) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! AGE OF FIRST      #### '
+    write(*,*) ' #### CLASS MUST BE GREATER THAN ZERO. CHANGE #### '
+    write(*,*) ' #### SETTINGS IN FILE AGECLASSES.            #### '
+    stop
+  endif
+
+  do i=2,nageclass
+    if (lage(i).le.lage(i-1)) then
+      write(*,*) ' #### FLEXPART MODEL ERROR! AGE CLASSES     #### '
+      write(*,*) ' #### MUST BE GIVEN IN TEMPORAL ORDER.      #### '
+      write(*,*) ' #### CHANGE SETTINGS IN FILE AGECLASSES.   #### '
+      stop
+    endif
+  end do
+
+  return
+
+999   write(*,*) ' #### FLEXPART MODEL ERROR! FILE "AGECLASSES" #### '
+  write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY       #### '
+  write(*,'(a)') path(1)(1:length(1))
+  stop
+
+1000  write(*,*) ' #### FLEXPART MODEL ERROR! FILE "AGECLASSES" #### '
+  write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY       #### '
+  write(*,'(a)') path(2)(1:length(2))
+  stop
+end subroutine readageclasses
diff --git a/src/rea_readavailable.f90 b/src/rea_readavailable.f90
new file mode 100644
index 0000000000000000000000000000000000000000..22e502f378785ee1ed505c263b43d3f5cd7a6143
--- /dev/null
+++ b/src/rea_readavailable.f90
@@ -0,0 +1,270 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine readavailable
+
+  !*****************************************************************************
+  !                                                                            *
+  !   This routine reads the dates and times for which windfields are          *
+  !   available.                                                               *
+  !                                                                            *
+  !     Authors: A. Stohl                                                      *
+  !                                                                            *
+  !     6 February 1994                                                        *
+  !     8 February 1999, Use of nested fields, A. Stohl                        *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! bdate                beginning date as Julian date                         *
+  ! beg                  beginning date for windfields                         *
+  ! endl                  ending date for windfields                            *
+  ! fname                filename of wind field, help variable                 *
+  ! ideltas [s]          duration of modelling period                          *
+  ! idiff                time difference between 2 wind fields                 *
+  ! idiffnorm            normal time difference between 2 wind fields          *
+  ! idiffmax [s]         maximum allowable time between 2 wind fields          *
+  ! jul                  julian date, help variable                            *
+  ! numbwf               actual number of wind fields                          *
+  ! wfname(maxwf)        file names of needed wind fields                      *
+  ! wfspec(maxwf)        file specifications of wind fields (e.g., if on disc) *
+  ! wftime(maxwf) [s]times of wind fields relative to beginning time           *
+  ! wfname1,wfspec1,wftime1 = same as above, but only local (help variables)   *
+  !                                                                            *
+  ! Constants:                                                                 *
+  ! maxwf                maximum number of wind fields                         *
+  ! unitavailab          unit connected to file AVAILABLE                      *
+  !                                                                            *
+  !*****************************************************************************
+
+  implicit none
+
+  integer :: i,idiff,ldat,ltim,wftime1(maxwf),numbwfn(maxnests),k
+  integer :: wftime1n(maxnests,maxwf),wftimen(maxnests,maxwf)
+  logical :: lwarntd=.true.
+  real(kind=dp) :: jul,beg,endl
+  character(len=255) :: fname,spec,wfname1(maxwf),wfspec1(maxwf)
+  character(len=255) :: wfname1n(maxnests,maxwf)
+  character(len=40) :: wfspec1n(maxnests,maxwf)
+
+
+  ! Windfields are only used, if they are within the modelling period.
+  ! However, 1 additional day at the beginning and at the end is used for
+  ! interpolation. -> Compute beginning and ending date for the windfields.
+  !************************************************************************
+
+  if (ideltas.gt.0) then         ! forward trajectories
+    beg=bdate-1._dp
+    endl=bdate+real(ideltas,kind=dp)/86400._dp+real(idiffmax,kind=dp)/ &
+         86400._dp
+  else                           ! backward trajectories
+    beg=bdate+real(ideltas,kind=dp)/86400._dp-real(idiffmax,kind=dp)/ &
+         86400._dp
+    endl=bdate+1._dp
+  endif
+
+  ! Open the wind field availability file and read available wind fields
+  ! within the modelling period.
+  !*********************************************************************
+
+  open(unitavailab,file=path(4)(1:length(4)),status='old', &
+       err=999)
+
+  do i=1,3
+    read(unitavailab,*)
+  end do
+
+  numbwf=0
+100   read(unitavailab,'(i8,1x,i6,2(6x,a255))',end=99) &
+           ldat,ltim,fname,spec
+    jul=juldate(ldat,ltim)
+    if ((jul.ge.beg).and.(jul.le.endl)) then
+      numbwf=numbwf+1
+      if (numbwf.gt.maxwf) then      ! check exceedance of dimension
+       write(*,*) 'Number of wind fields needed is too great.'
+       write(*,*) 'Reduce modelling period (file "COMMAND") or'
+       write(*,*) 'reduce number of wind fields (file "AVAILABLE").'
+       stop
+      endif
+
+      wfname1(numbwf)=fname(1:index(fname,' '))
+      wfspec1(numbwf)=spec
+      wftime1(numbwf)=nint((jul-bdate)*86400._dp)
+    endif
+    goto 100       ! next wind field
+
+99   continue
+
+  close(unitavailab)
+
+  ! Open the wind field availability file and read available wind fields
+  ! within the modelling period (nested grids)
+  !*********************************************************************
+
+  do k=1,numbnests
+  !print*,length(numpath+2*(k-1)+1),length(numpath+2*(k-1)+2),length(4),length(3)
+  !print*,path(numpath+2*(k-1)+2)(1:length(numpath+2*(k-1)+2))
+    open(unitavailab,file=path(numpath+2*(k-1)+2) &
+         (1:length(numpath+2*(k-1)+2)),status='old',err=998)
+
+    do i=1,3
+      read(unitavailab,*)
+    end do
+
+    numbwfn(k)=0
+700   read(unitavailab,'(i8,1x,i6,2(6x,a255))',end=699) ldat, &
+           ltim,fname,spec
+      jul=juldate(ldat,ltim)
+      if ((jul.ge.beg).and.(jul.le.endl)) then
+        numbwfn(k)=numbwfn(k)+1
+        if (numbwfn(k).gt.maxwf) then      ! check exceedance of dimension
+       write(*,*) 'Number of nested wind fields is too great.'
+       write(*,*) 'Reduce modelling period (file "COMMAND") or'
+       write(*,*) 'reduce number of wind fields (file "AVAILABLE").'
+          stop
+        endif
+
+        wfname1n(k,numbwfn(k))=fname
+        wfspec1n(k,numbwfn(k))=spec
+        wftime1n(k,numbwfn(k))=nint((jul-bdate)*86400._dp)
+      endif
+      goto 700       ! next wind field
+
+699   continue
+
+    close(unitavailab)
+  end do
+
+
+  ! Check wind field times of file AVAILABLE (expected to be in temporal order)
+  !****************************************************************************
+
+  if (numbwf.eq.0) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! NO WIND FIELDS    #### '
+    write(*,*) ' #### AVAILABLE FOR SELECTED TIME PERIOD.     #### '
+    stop
+  endif
+
+  do i=2,numbwf
+    if (wftime1(i).le.wftime1(i-1)) then
+      write(*,*) 'FLEXPART ERROR: FILE AVAILABLE IS CORRUPT.'
+      write(*,*) 'THE WIND FIELDS ARE NOT IN TEMPORAL ORDER.'
+      write(*,*) 'PLEASE CHECK FIELD ',wfname1(i)
+      stop
+    endif
+  end do
+
+  ! Check wind field times of file AVAILABLE for the nested fields
+  ! (expected to be in temporal order)
+  !***************************************************************
+
+  do k=1,numbnests
+    if (numbwfn(k).eq.0) then
+      write(*,*) '#### FLEXPART MODEL ERROR! NO WIND FIELDS  ####'
+      write(*,*) '#### AVAILABLE FOR SELECTED TIME PERIOD.   ####'
+      stop
+    endif
+
+    do i=2,numbwfn(k)
+      if (wftime1n(k,i).le.wftime1n(k,i-1)) then
+      write(*,*) 'FLEXPART ERROR: FILE AVAILABLE IS CORRUPT. '
+      write(*,*) 'THE NESTED WIND FIELDS ARE NOT IN TEMPORAL ORDER.'
+      write(*,*) 'PLEASE CHECK FIELD ',wfname1n(k,i)
+      write(*,*) 'AT NESTING LEVEL ',k
+      stop
+      endif
+    end do
+
+  end do
+
+
+  ! For backward trajectories, reverse the order of the windfields
+  !***************************************************************
+
+  if (ideltas.ge.0) then
+    do i=1,numbwf
+      wfname(i)=wfname1(i)
+      wfspec(i)=wfspec1(i)
+      wftime(i)=wftime1(i)
+    end do
+    do k=1,numbnests
+      do i=1,numbwfn(k)
+        wfnamen(k,i)=wfname1n(k,i)
+        wfspecn(k,i)=wfspec1n(k,i)
+        wftimen(k,i)=wftime1n(k,i)
+      end do
+    end do
+  else
+    do i=1,numbwf
+      wfname(numbwf-i+1)=wfname1(i)
+      wfspec(numbwf-i+1)=wfspec1(i)
+      wftime(numbwf-i+1)=wftime1(i)
+    end do
+    do k=1,numbnests
+      do i=1,numbwfn(k)
+        wfnamen(k,numbwfn(k)-i+1)=wfname1n(k,i)
+        wfspecn(k,numbwfn(k)-i+1)=wfspec1n(k,i)
+        wftimen(k,numbwfn(k)-i+1)=wftime1n(k,i)
+      end do
+    end do
+  endif
+
+  ! Check the time difference between the wind fields. If it is big,
+  ! write a warning message. If it is too big, terminate the trajectory.
+  !*********************************************************************
+
+  do i=2,numbwf
+    idiff=abs(wftime(i)-wftime(i-1))
+    if (idiff.gt.idiffmax.and.lroot) then
+      write(*,*) 'FLEXPART WARNING: TIME DIFFERENCE BETWEEN TWO'
+      write(*,*) 'WIND FIELDS IS TOO BIG FOR TRANSPORT CALCULATION.&
+           &'
+      write(*,*) 'THEREFORE, TRAJECTORIES HAVE TO BE SKIPPED.'
+    else if (idiff.gt.idiffnorm.and.lroot.and.lwarntd) then
+      write(*,*) 'FLEXPART WARNING: TIME DIFFERENCE BETWEEN TWO'
+      write(*,*) 'WIND FIELDS IS BIG. THIS MAY CAUSE A DEGRADATION'
+      write(*,*) 'OF SIMULATION QUALITY.'
+      lwarntd=.false. ! only issue this warning once
+    endif
+  end do
+
+  do k=1,numbnests
+    if (numbwfn(k).ne.numbwf) then
+      write(*,*) 'FLEXPART ERROR: THE AVAILABLE FILES FOR THE'
+      write(*,*) 'NESTED WIND FIELDS ARE NOT CONSISTENT WITH'
+      write(*,*) 'THE AVAILABLE FILE OF THE MOTHER DOMAIN.  '
+      write(*,*) 'ERROR AT NEST LEVEL: ',k
+      stop
+    endif
+    do i=1,numbwf
+      if (wftimen(k,i).ne.wftime(i)) then
+        write(*,*) 'FLEXPART ERROR: THE AVAILABLE FILES FOR THE'
+        write(*,*) 'NESTED WIND FIELDS ARE NOT CONSISTENT WITH'
+        write(*,*) 'THE AVAILABLE FILE OF THE MOTHER DOMAIN.  '
+        write(*,*) 'ERROR AT NEST LEVEL: ',k
+        stop
+      endif
+    end do
+  end do
+
+  ! Reset the times of the wind fields that are kept in memory to no time
+  !**********************************************************************
+
+  do i=1,2
+    memind(i)=i
+    memtime(i)=999999999
+  end do
+
+  return
+
+998   write(*,*) ' #### FLEXPART MODEL ERROR! AVAILABLE FILE   #### '
+  write(*,'(a)') '     '//path(numpath+2*(k-1)+2) &
+       (1:length(numpath+2*(k-1)+2))
+  write(*,*) ' #### CANNOT BE OPENED             #### '
+  stop
+
+999   write(*,*) ' #### FLEXPART MODEL ERROR! AVAILABLE FILE #### '
+  write(*,'(a)') '     '//path(4)(1:length(4))
+  write(*,*) ' #### CANNOT BE OPENED           #### '
+  stop
+end subroutine readavailable
diff --git a/src/rea_readcommand.f90 b/src/rea_readcommand.f90
new file mode 100644
index 0000000000000000000000000000000000000000..90ed0b1d21913ec48098819231b4b1b020bd874a
--- /dev/null
+++ b/src/rea_readcommand.f90
@@ -0,0 +1,612 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine readcommand
+
+  !*****************************************************************************
+  !                                                                            *
+  !     This routine reads the user specifications for the current model run.  *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     18 May 1996                                                            *
+  !     HSO, 1 July 2014                                                       *
+  !     Added optional namelist input                                          *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! bdate                beginning date as Julian date                         *
+  ! ctl                  factor by which time step must be smaller than        *
+  !                      Lagrangian time scale                                 *
+  ! ibdate,ibtime        beginnning date and time (YYYYMMDD, HHMISS)           *
+  ! ideltas [s]          modelling period                                      *
+  ! iedate,ietime        ending date and time (YYYYMMDD, HHMISS)               *
+  ! ifine                reduction factor for vertical wind time step          *
+  ! outputforeachrel     for forward runs it is possible either to create      *
+  !                      one outputfield or several for each releasepoint      *
+  ! iflux                switch to turn on (1)/off (0) flux calculations       *
+  ! iout                 1 for conc. (residence time for backward runs) output,*
+  !                      2 for mixing ratio output, 3 both, 4 for plume        *
+  !                      trajectory output, 5 = options 1 and 4                *
+  ! ipin                 1 continue simulation with restart.bin file,          *
+  !                      2 continue simulaion with dumped particle data, 0 no  *
+  !                      3 use self-defined initial conditions in netcdf       *
+  !                      4 initial run using option 3, restart from restart.bin*
+  ! ipout                0 no particle dump, 1 every output time, 3 only at end*
+  ! ipoutfac             increase particle dump interval by factor (default 1) *
+  ! loutaver [s]         concentration output is an average over loutaver      *
+  !                      seconds                                               *
+  ! loutsample [s]       average is computed from samples taken every [s]      *
+  !                      seconds                                               *
+  ! loutstep [s]         time interval of concentration output                 *
+  ! lsynctime [s]        synchronisation time interval for all particles       *
+  ! lagespectra          switch to turn on (1)/off (0) calculation of age      *
+  !                      spectra                                               *
+  ! lconvection          value of either 0 and 1 indicating mixing by          *
+  !                      convection                                            *
+  !                      = 0 .. no convection                                  *
+  !                      + 1 .. parameterisation of mixing by subgrid-scale    *
+  !                              convection = on                               *
+  ! lsubgrid             switch to turn on (1)/off (0) subgrid topography      *
+  !                      parameterization                                      *
+  ! method               method used to compute the particle pseudovelocities  *
+  ! mdomainfill          1 use domain-filling option, 0 not, 2 use strat. O3   *
+  !                                                                            *
+  ! Constants:                                                                 *
+  ! unitcommand          unit connected to file COMMAND                        *
+  !                                                                            *
+  !*****************************************************************************
+
+  implicit none
+
+  character(len=50) :: line
+  logical :: old
+  integer :: ios
+
+  namelist /command/ &
+  ldirect, &
+  ibdate,ibtime, &
+  iedate,ietime, &
+  loutstep, &
+  loutaver, &
+  loutsample, &
+  loutrestart, &
+  lsynctime, &
+  ctl, &
+  ifine, &
+  iout, &
+  ipout, &
+  ipoutfac, &
+  lsubgrid, &
+  lconvection, &
+  lagespectra, &
+  ipin, &
+  ioutputforeachrelease, &
+  iflux, &
+  mdomainfill, &
+  ind_source, &
+  ind_receptor, &
+  mquasilag, &
+  nested_output, &
+  linit_cond, &
+  lnetcdfout, &
+  surf_only, &
+  cblflag, &
+  linversionout, &
+  ohfields_path, &
+  d_trop, &
+  d_strat, &
+  nxshift
+
+  ! Presetting namelist command
+  ldirect=0
+  ibdate=20000101
+  ibtime=0
+  iedate=20000102
+  ietime=0
+  loutstep=10800
+  loutaver=10800
+  loutsample=900
+  loutrestart=999999999
+  lsynctime=900
+  ctl=-5.0
+  ifine=4
+  iout=3
+  ipout=0
+  ipoutfac=1
+  lsubgrid=1
+  lconvection=1
+  lagespectra=0
+  ipin=0
+  ioutputforeachrelease=1
+  iflux=1
+  mdomainfill=0
+  ind_source=1
+  ind_receptor=1
+  mquasilag=0
+  nested_output=0
+  linit_cond=0
+  lnetcdfout=0
+  surf_only=0
+  cblflag=0 ! if using old-style COMMAND file, set to 1 here to use mc cbl routine
+  linversionout=0
+  ohfields_path="../../flexin/"
+  nxshift=-9999
+
+  !Af set release-switch
+  WETBKDEP=.false.
+  DRYBKDEP=.false.
+
+  ! Open the command file and read user options
+  ! Namelist input first: try to read as namelist file
+  !**************************************************************************
+  open(unitcommand,file=path(1)(1:length(1))//'COMMAND',status='old', &
+    form='formatted',err=999)
+
+  ! try namelist input (default)
+  read(unitcommand,command,iostat=ios)
+  close(unitcommand)
+
+  ! distinguish namelist from fixed text input
+  if (ios.ne.0 .or. ldirect.eq.0) then ! parse as text file format
+!    if (lroot)
+    write(*,*) 'COMMAND either having unrecognised entries, &
+      &or in old format, please update to namelist format.'
+      stop
+  endif ! input format
+
+  ! write command file in namelist format to output directory if requested
+!  if (nmlout.and.lroot) then
+  if (nmlout) then
+    open(unitcommand,file=path(2)(1:length(2))//'COMMAND.namelist',err=1000)
+    write(unitcommand,nml=command)
+    close(unitcommand)
+  endif
+
+  ifine=max(ifine,1)
+
+  ! Determine how Markov chain is formulated (for w or for w/sigw)
+  !***************************************************************
+  if (cblflag.eq.1) then ! added by MC to set parameters for CBL simulations
+    turbswitch=.true.
+    if (lsynctime .gt. maxtl) lsynctime=maxtl  !maxtl defined in com_mod.f90
+    if (ctl.lt.5) then
+      print *,'WARNING: CBL flag active the ratio of TLu/dt has been set to 5'
+      ctl=5.
+    end if
+    if (ifine*ctl.lt.50) then
+      ifine=int(50./ctl)+1
+
+      print *,'WARNING: CBL flag active the ratio of TLW/dt was < 50, &
+        &ifine has been re-set to', ifine
+  !pause
+    endif
+    print *,'WARNING: CBL flag active the ratio of TLW/dt is ',ctl*ifine
+    print *,'WARNING: CBL flag active lsynctime is ',lsynctime
+  else                    !added by MC
+    if (ctl.ge.0.1) then
+      turbswitch=.true.
+    else
+      turbswitch=.false.
+      ifine=1
+    endif
+  endif                   !added by MC
+  fine=1./real(ifine)
+  ctl=1./ctl
+
+  ! Set the switches required for the various options for input/output units
+  !*************************************************************************
+  !AF Set the switches IND_REL and IND_SAMP for the release and sampling
+  !Af switches for the releasefile:
+  !Af IND_REL =  1 : xmass * rho
+  !Af IND_REL =  0 : xmass * 1
+
+  !Af switches for the conccalcfile:
+  !AF IND_SAMP =  0 : xmass * 1
+  !Af IND_SAMP = -1 : xmass / rho
+
+  !AF IND_SOURCE switches between different units for concentrations at the source
+  !Af   NOTE that in backward simulations the release of computational particles
+  !Af   takes place at the "receptor" and the sampling of particles at the "source".
+  !Af          1 = mass units
+  !Af          2 = mass mixing ratio units
+  !Af IND_RECEPTOR switches between different units for concentrations at the receptor
+  !            0 = no receptors
+  !Af          1 = mass units
+  !Af          2 = mass mixing ratio units
+  !            3 = wet deposition in outputfield
+  !            4 = dry deposition in outputfield
+
+  if ( ldirect .eq. 1 ) then  ! FWD-Run
+  !Af set release-switch
+     if (ind_source .eq. 1 ) then !mass
+        ind_rel = 0
+     else ! mass mix
+        ind_rel = 1
+     endif
+  !Af set sampling switch
+     if (ind_receptor .le. 1) then !mass
+        ind_samp = 0
+     else ! mass mix
+        ind_samp = -1
+     endif
+  elseif (ldirect .eq. -1 ) then !BWD-Run
+  !Af set sampling switch
+     if (ind_source .eq. 1 ) then !mass
+        ind_samp = -1
+     else ! mass mix
+        ind_samp = 0
+     endif
+     select case (ind_receptor)
+     case (1)  !  1 .. concentration at receptor
+        ind_rel = 1
+     case (2)  !  2 .. mixing ratio at receptor
+        ind_rel = 0
+     case (3)  ! 3 .. wet deposition in outputfield
+        ind_rel = 3
+        if (lroot) then
+          write(*,*) ' #### FLEXPART WET DEPOSITION BACKWARD MODE    #### '
+          write(*,*) ' #### Releaseheight is forced to 0 - 20km      #### '
+          write(*,*) ' #### Release is performed above ground lev    #### '
+        end if
+         WETBKDEP=.true.
+         !allocate(xscav_frac1(maxpart,maxspec))
+     case (4)  ! 4 .. dry deposition in outputfield
+         ind_rel = 4
+         if (lroot) then
+           write(*,*) ' #### FLEXPART DRY DEPOSITION BACKWARD MODE    #### '
+           write(*,*) ' #### Releaseheight is forced to 0 - 2*href    #### '
+           write(*,*) ' #### Release is performed above ground lev    #### '
+         end if
+         DRYBKDEP=.true.
+         !allocate(xscav_frac1(maxpart,maxspec))
+     end select
+  endif
+
+  !*************************************************************
+  ! Check whether valid options have been chosen in file COMMAND
+  !*************************************************************
+
+  ! Check options for initial condition output: Switch off for forward runs
+  !************************************************************************
+
+  if (ldirect.eq.1) linit_cond=0
+  if (linit_cond.lt.0 .or. linit_cond.gt.2) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! INVALID OPTION    #### '
+    write(*,*) ' #### FOR LINIT_COND IN FILE "COMMAND".       #### '
+    stop
+  endif
+
+  ! Check input dates
+  !******************
+
+  if (iedate.lt.ibdate) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! BEGINNING DATE    #### '
+    write(*,*) ' #### IS LARGER THAN ENDING DATE. CHANGE      #### '
+    write(*,*) ' #### EITHER POINT 2 OR POINT 3 IN FILE       #### '
+    write(*,*) ' #### "COMMAND".                              #### '
+    stop
+  else if (iedate.eq.ibdate) then
+    if (ietime.lt.ibtime) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! BEGINNING TIME    #### '
+    write(*,*) ' #### IS LARGER THAN ENDING TIME. CHANGE      #### '
+    write(*,*) ' #### EITHER POINT 2 OR POINT 3 IN FILE       #### '
+    write(*,*) ' #### "COMMAND".                              #### '
+    stop
+    endif
+  endif
+
+#ifndef USE_NCF
+  if ((loutrestart.ne.999999999).or.(ipin.ne.0)) then
+    write(*,*) ' WARNING: restart option set with intervals'
+    write(*,*) ' LOUTRESTART', loutrestart
+    write(*,*) ' not possible when using binary gridded output'
+    write(*,*) ' ==> RESTART FUNCTION SWITCHED OFF!'
+  endif
+  if (ipin.ne.0) then
+    write(*,*) ' ERROR: restart option not possible using binary'
+    write(*,*) ' output.'
+    write(*,*) ' Please only use IPIN>0 when compiling and running using'
+    write(*,*) ' netcdf output. '
+  endif
+#else
+  if ((surf_only.eq.1).or.(linversionout.eq.1)) then
+    write(*,*) ' ERROR: NetCDF output for surface only or for inversions'
+    write(*,*) ' is not yet implemented. Please compile without NetCDF.'
+    stop
+  endif
+#endif
+
+  ! Determine kind of dispersion method
+  !************************************
+
+  if (ctl.gt.0.) then
+    method=1
+    mintime=minstep
+  else
+    method=0
+    mintime=lsynctime
+  endif
+
+  ! Check for netcdf output switch
+  !*******************************
+#ifdef USE_NCF
+  lnetcdfout = 1
+#endif
+  if (iout.ge.8) then
+     lnetcdfout = 1
+     iout = iout - 8
+#ifndef USE_NCF
+     write(*,*) 'ERROR: netcdf output not activated during compile time &
+       &but used in COMMAND file!'
+     write(*,*) 'Please recompile with netcdf library (`make [...] ncf=yes`) &
+       &or use standard output format.'
+     stop
+#endif
+  endif
+#ifndef USE_NCF
+  if (ipout.ne.0) then
+    write(*,*) 'ERROR: NETCDF missing! Please recompile with the netcdf'
+    write(*,*) 'library if you want the particle dump or set IPOUT=0.'
+    stop
+  endif
+#endif
+
+  ! Check whether a valid option for gridded model output has been chosen
+  !**********************************************************************
+
+  if (iout.eq.0) then
+    write(*,*) 'WARNING: IOUT set to zero, no gridded information will be &
+      &written to file'
+  else if ((iout.lt.0).or.(iout.gt.5)) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! FILE COMMAND:     #### '
+    write(*,*) ' #### IOUT MUST BE 1, 2, 3, 4 OR 5 FOR        #### '
+    write(*,*) ' #### STANDARD FLEXPART OUTPUT OR  9 - 13     #### '
+    write(*,*) ' #### FOR NETCDF OUTPUT                       #### '
+    stop
+  endif
+
+  !AF check consistency between units and volume mixing ratio
+  if ( ((iout.eq.2).or.(iout.eq.3)).and. &
+       (ind_source.gt.1 .or.ind_receptor.gt.1) ) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! FILE COMMAND:     #### '
+    write(*,*) ' #### VOLUME MIXING RATIO ONLY SUPPORTED      #### '
+    write(*,*) ' #### FOR MASS UNITS (at the moment)          #### '
+    stop
+  endif
+
+
+  ! For quasilag output for each release is forbidden
+  !*****************************************************************************
+
+  if ((ioutputforeachrelease.eq.1).and.(mquasilag.eq.1)) then
+      write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND:     ####'
+      write(*,*) '#### OUTPUTFOREACHRELEASE AND QUASILAGRANGIAN####'
+      write(*,*) '#### MODE IS NOT POSSIBLE   !                ####'
+      stop
+  endif
+
+
+  ! For quasilag backward is forbidden
+  !*****************************************************************************
+
+  if ((ldirect.lt.0).and.(mquasilag.eq.1)) then
+      write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND:     ####'
+      write(*,*) '#### FOR BACKWARD RUNS, QUASILAGRANGIAN MODE ####'
+      write(*,*) '#### IS NOT POSSIBLE   !                     ####'
+      stop
+  endif
+
+
+  ! For backward runs one releasefield for all releases makes no sense,
+  ! For quasilag and domainfill ioutputforechrelease is forbidden
+  !*****************************************************************************
+
+  if ((ldirect.lt.0).and.(ioutputforeachrelease.eq.0)) then
+      write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND:     ####'
+      write(*,*) '#### FOR BACKWARD RUNS, IOUTPUTFOREACHRLEASE ####'
+      write(*,*) '#### MUST BE SET TO ONE!                     ####'
+      stop
+  endif
+
+
+  ! For backward runs one releasefield for all releases makes no sense,
+  ! and is "forbidden"
+  !*****************************************************************************
+
+  if ((mdomainfill.eq.1).and.(ioutputforeachrelease.eq.1)) then
+      write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND:     ####'
+      write(*,*) '#### FOR DOMAIN FILLING RUNS OUTPUT FOR      ####'
+      write(*,*) '#### EACH RELEASE IS FORBIDDEN !             ####'
+      stop
+  endif
+
+  ! Inversion output format only for backward runs
+  !*****************************************************************************
+
+  if ((linversionout.eq.1).and.(ldirect.eq.1)) then
+      write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND:     ####'
+      write(*,*) '#### INVERSION OUTPUT FORMAT ONLY FOR        ####'
+      write(*,*) '#### BACKWARD RUNS                           ####'
+      stop
+  endif
+
+
+  ! For domain-filling trajectories, a plume centroid trajectory makes no sense,
+  ! For backward runs, only residence time output (iout=1) or plume trajectories (iout=4),
+  ! or both (iout=5) makes sense; other output options are "forbidden"
+  !*****************************************************************************
+
+  if (ldirect.lt.0) then
+    if ((iout.eq.2).or.(iout.eq.3)) then
+      write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND:     ####'
+      write(*,*) '#### FOR BACKWARD RUNS, IOUT MUST BE 1,4,OR 5####'
+      stop
+    endif
+  endif
+
+
+  ! For domain-filling trajectories, a plume centroid trajectory makes no sense,
+  ! and is "forbidden"
+  !*****************************************************************************
+
+  if (mdomainfill.ge.1) then
+    if ((iout.eq.4).or.(iout.eq.5)) then
+      write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND:     ####'
+      write(*,*) '#### FOR DOMAIN-FILLING TRAJECTORY OPTION,   ####'
+      write(*,*) '#### IOUT MUST NOT BE SET TO 4 OR 5.         ####'
+      stop
+    endif
+  endif
+
+  ! Check whether a valid options for particle dump has been chosen
+  !****************************************************************
+
+  if ((ipout.ne.0).and.(ipout.ne.1).and.(ipout.ne.2).and.(ipout.ne.3)) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! FILE COMMAND:     #### '
+    write(*,*) ' #### IPOUT MUST BE 0, 1, 2 OR 3!             #### '
+    stop
+  endif
+
+  ! Check whether input and output settings don't contradict
+  !*********************************************************
+  if (((iout.eq.4).or.(iout.eq.5)).and.((ipin.eq.3).or.(ipin.eq.4))) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! FILE COMMAND:     #### '
+    write(*,*) ' #### IOUT CANNOT BE 4 or 5 (plume) WHEN      #### '
+    write(*,*) ' #### READING FROM part_ic.nc (ipin=4/5)      #### '
+    stop
+  endif
+
+  if(lsubgrid.ne.1.and.verbosity.eq.0) then
+    write(*,*) '             ----------------               '
+    write(*,*) ' INFORMATION: SUBGRIDSCALE TERRAIN EFFECT IS'
+    write(*,*) ' NOT PARAMETERIZED DURING THIS SIMULATION.  '
+    write(*,*) '             ----------------               '
+  endif
+
+
+  ! Check whether convection scheme is either turned on or off
+  !***********************************************************
+
+  if ((lconvection.ne.0).and.(lconvection.ne.1)) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! FILE COMMAND:     #### '
+    write(*,*) ' #### LCONVECTION MUST BE SET TO EITHER 1 OR 0#### '
+    stop
+  endif
+
+
+  ! Check whether synchronisation interval is sufficiently short
+  !*************************************************************
+
+  if (lsynctime.gt.(idiffnorm/2)) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! SYNCHRONISATION   #### '
+    write(*,*) ' #### TIME IS TOO LONG. MAKE IT SHORTER.      #### '
+    write(*,*) ' #### MINIMUM HAS TO BE: ', idiffnorm/2
+    stop
+  endif
+
+
+  ! Check consistency of the intervals, sampling periods, etc., for model output
+  !*****************************************************************************
+
+  if (loutaver.eq.0) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! TIME AVERAGE OF   #### '
+    write(*,*) ' #### CONCENTRATION FIELD OUTPUT MUST NOT BE  #### '
+    write(*,*) ' #### ZERO.                                   #### '
+    write(*,*) ' #### CHANGE INPUT IN FILE COMMAND.           #### '
+    stop
+  endif
+
+  if (loutaver.gt.loutstep) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! TIME AVERAGE OF   #### '
+    write(*,*) ' #### CONCENTRATION FIELD OUTPUT MUST NOT BE  #### '
+    write(*,*) ' #### GREATER THAN INTERVAL OF OUTPUT.        #### '
+    write(*,*) ' #### CHANGE INPUT IN FILE COMMAND.           #### '
+    stop
+  endif
+
+  if (loutsample.gt.loutaver) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! SAMPLING TIME OF  #### '
+    write(*,*) ' #### CONCENTRATION FIELD OUTPUT MUST NOT BE  #### '
+    write(*,*) ' #### GREATER THAN TIME AVERAGE OF OUTPUT.    #### '
+    write(*,*) ' #### CHANGE INPUT IN FILE COMMAND.           #### '
+    stop
+  endif
+
+  if (mod(loutaver,lsynctime).ne.0) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! AVERAGING TIME OF #### '
+    write(*,*) ' #### CONCENTRATION FIELD MUST BE A MULTIPLE  #### '
+    write(*,*) ' #### OF THE SYNCHRONISATION INTERVAL         #### '
+    stop
+  endif
+
+  if ((loutaver/lsynctime).lt.2) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! AVERAGING TIME OF #### '
+    write(*,*) ' #### CONCENTRATION FIELD MUST BE AT LEAST    #### '
+    write(*,*) ' #### TWICE THE SYNCHRONISATION INTERVAL      #### '
+    stop
+  endif
+
+  if (mod(loutstep,lsynctime).ne.0) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! INTERVAL BETWEEN  #### '
+    write(*,*) ' #### CONCENTRATION FIELDS MUST BE A MULTIPLE #### '
+    write(*,*) ' #### OF THE SYNCHRONISATION INTERVAL         #### '
+    stop
+  endif
+
+  if ((loutstep/lsynctime).lt.2) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! INTERVAL BETWEEN  #### '
+    write(*,*) ' #### CONCENTRATION FIELDS MUST BE AT LEAST   #### '
+    write(*,*) ' #### TWICE THE SYNCHRONISATION INTERVAL      #### '
+    stop
+  endif
+
+  if (mod(loutsample,lsynctime).ne.0) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! SAMPLING TIME OF  #### '
+    write(*,*) ' #### CONCENTRATION FIELD MUST BE A MULTIPLE  #### '
+    write(*,*) ' #### OF THE SYNCHRONISATION INTERVAL         #### '
+    stop
+  endif
+
+  if ((mquasilag.eq.1).and.(iout.ge.4)) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! CONFLICTING       #### '
+    write(*,*) ' #### OPTIONS: IF MQUASILAG=1, PLUME          #### '
+    write(*,*) ' #### TRAJECTORY OUTPUT IS IMPOSSIBLE.        #### '
+    stop
+  endif
+
+  ! Compute modeling time in seconds and beginning date in Julian date
+  !*******************************************************************
+
+  outstep=real(abs(loutstep))
+  if (ldirect.eq.1) then
+    bdate=juldate(ibdate,ibtime)
+    edate=juldate(iedate,ietime)
+    ideltas=nint((edate-bdate)*86400.)
+  else if (ldirect.eq.-1) then
+    loutaver=-1*loutaver
+    loutstep=-1*loutstep
+    loutsample=-1*loutsample
+    lsynctime=-1*lsynctime
+    bdate=juldate(iedate,ietime)
+    edate=juldate(ibdate,ibtime)
+    ideltas=nint((edate-bdate)*86400.)
+  else
+    write(*,*) ' #### FLEXPART MODEL ERROR! DIRECTION IN      #### '
+    write(*,*) ' #### FILE "COMMAND" MUST BE EITHER -1 OR 1.  #### '
+    stop
+  endif
+
+  return
+
+999   write(*,*) ' #### FLEXPART MODEL ERROR! FILE "COMMAND"    #### '
+  write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY       #### '
+  write(*,'(a)') path(1)(1:length(1))
+  stop
+
+1000   write(*,*) ' #### FLEXPART MODEL ERROR! FILE "COMMAND"    #### '
+  write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY       #### '
+  write(*,'(a)') path(2)(1:length(2))
+  stop
+end subroutine readcommand
diff --git a/src/rea_readdepo.f90 b/src/rea_readdepo.f90
new file mode 100644
index 0000000000000000000000000000000000000000..a575ec7f4be6d5cc24c13a48d65639c2fd8fbaff
--- /dev/null
+++ b/src/rea_readdepo.f90
@@ -0,0 +1,122 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine readdepo
+
+  !*****************************************************************************
+  !                                                                            *
+  !  Reads dry deposition parameters needed by the procedure of Wesely (1989). *
+  !  Wesely (1989): Parameterization of surface resistances to gaseous         *
+  !  dry deposition in regional-scale numerical models.                        *
+  !  Atmos. Environ. 23, 1293-1304.                                            *
+  !                                                                            *
+  !                                                                            *
+  !      AUTHOR: Andreas Stohl, 19 May 1995                                    *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  ! rcl(maxspec,5,9) [s/m] Lower canopy resistance                             *
+  ! rgs(maxspec,5,9) [s/m] Ground resistance                                   *
+  ! rlu(maxspec,5,9) [s/m] Leaf cuticular resistance                           *
+  ! rm(maxspec) [s/m]      Mesophyll resistance, set in readreleases           *
+  ! ri(maxspec) [s/m]      Stomatal resistance                                 *
+  !                                                                            *
+  ! Constants:                                                                 *
+  !                                                                            *
+  !*****************************************************************************
+
+  implicit none
+
+  ! FOR THIS SUBROUTINE, numclass=9 IS ASSUMED
+  !*******************************************
+
+  real :: rluh(5,numclass),rgssh(5,numclass),rgsoh(5,numclass)
+  real :: rclsh(5,numclass),rcloh(5,numclass)
+  integer :: i,j,ic
+
+
+  ! Read deposition constants related with landuse and seasonal category
+  !*********************************************************************
+  open(unitwesely,file=path(1)(1:length(1))//'sfcdepo.txt', &
+       status='old',err=999)
+
+  do i=1,16
+    read(unitwesely,*)
+  end do
+  do i=1,5
+    read(unitwesely,*)
+    read(unitwesely,'(8x,13f8.0)') (ri(i,j),j=1,numclass)
+    read(unitwesely,'(8x,13f8.0)') (rluh(i,j),j=1,numclass)
+    read(unitwesely,'(8x,13f8.0)') (rac(i,j),j=1,numclass)
+    read(unitwesely,'(8x,13f8.0)') (rgssh(i,j),j=1,numclass)
+    read(unitwesely,'(8x,13f8.0)') (rgsoh(i,j),j=1,numclass)
+    read(unitwesely,'(8x,13f8.0)') (rclsh(i,j),j=1,numclass)
+    read(unitwesely,'(8x,13f8.0)') (rcloh(i,j),j=1,numclass)
+  end do
+
+  ! TEST
+  ! do 31 i=1,5
+  !   ri(i,13)=ri(i,5)
+  !   rluh(i,13)=rluh(i,5)
+  !   rac(i,13)=rac(i,5)
+  !   rgssh(i,13)=rgssh(i,5)
+  !   rgsoh(i,13)=rgsoh(i,5)
+  !   rclsh(i,13)=rclsh(i,5)
+  !   rcloh(i,13)=rcloh(i,5)
+  !31             continue
+  ! TEST
+  ! Sabine Eckhardt, Dec 06, set resistances of 9999 to 'infinite' (1E25)
+  do i=1,5
+    do j=1,numclass
+      if    (ri(i,j).eq.9999.)    ri(i,j)=1.E25
+      if  (rluh(i,j).eq.9999.)  rluh(i,j)=1.E25
+      if   (rac(i,j).eq.9999.)   rac(i,j)=1.E25
+      if (rgssh(i,j).eq.9999.) rgssh(i,j)=1.E25
+      if (rgsoh(i,j).eq.9999.) rgsoh(i,j)=1.E25
+      if (rclsh(i,j).eq.9999.) rclsh(i,j)=1.E25
+      if (rcloh(i,j).eq.9999.) rcloh(i,j)=1.E25
+    end do
+  end do
+
+
+
+  do i=1,5
+    do j=1,numclass
+      ri(i,j)=max(ri(i,j),0.001)
+      rluh(i,j)=max(rluh(i,j),0.001)
+      rac(i,j)=max(rac(i,j),0.001)
+      rgssh(i,j)=max(rgssh(i,j),0.001)
+      rgsoh(i,j)=max(rgsoh(i,j),0.001)
+      rclsh(i,j)=max(rclsh(i,j),0.001)
+      rcloh(i,j)=max(rcloh(i,j),0.001)
+    end do
+  end do
+  close(unitwesely)
+
+
+  ! Compute additional parameters
+  !******************************
+
+  do ic=1,nspec
+    if (reldiff(ic).gt.0.) then     ! gas is dry deposited
+      do i=1,5
+        do j=1,numclass
+          rlu(ic,i,j)=rluh(i,j)/(1.e-5*henry(ic)+f0(ic))
+          rgs(ic,i,j)=1./(henry(ic)/(10.e5*rgssh(i,j))+f0(ic)/ &
+               rgsoh(i,j))
+          rcl(ic,i,j)=1./(henry(ic)/(10.e5*rclsh(i,j))+f0(ic)/ &
+               rcloh(i,j))
+        end do
+      end do
+    endif
+  end do
+
+
+  return
+
+999   write(*,*) '### FLEXPART ERROR! FILE              ###'
+  write(*,*) '### surfdepo.t DOES NOT EXIST.        ###'
+  stop
+end subroutine readdepo
diff --git a/src/rea_readlanduse.f90 b/src/rea_readlanduse.f90
new file mode 100644
index 0000000000000000000000000000000000000000..a7af62f2d58f4aa89b19241e4d8c98d4a2594a52
--- /dev/null
+++ b/src/rea_readlanduse.f90
@@ -0,0 +1,141 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine readlanduse
+
+  !*****************************************************************************
+  !                                                                            *
+  !      Reads the landuse inventory into memory and relates it to Leaf Area   *
+  !      Index and roughness length.                                           *
+  !                                                                            *
+  !      AUTHOR: Andreas Stohl, 10 January 1994                                *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! i                       loop indices                                       *
+  ! landinvent(1200,600,13) area fractions of 13 landuse categories            *
+  ! LENGTH(numpath)         length of the path names                           *
+  ! PATH(numpath)           contains the path names                            *
+  ! unitland                unit connected with landuse inventory              *
+  !                                                                            *
+  ! -----                                                                      *
+  ! Sabine Eckhardt, Dec 06 - new landuse inventary                            *
+  ! after                                                                      *
+  ! Belward, A.S., Estes, J.E., and Kline, K.D., 1999,                         *
+  ! The IGBP-DIS 1-Km Land-Cover Data Set DISCover:                            *
+  ! A Project Overview: Photogrammetric Engineering and Remote Sensing,        *
+  ! v. 65, no. 9, p. 1013-1020                                                 *
+  !                                                                            *
+  ! LANDUSE CATEGORIES:                                                        *
+  !                                                                            *
+  ! 1   Urban land                                                             *
+  ! 2   Agricultural land                                                      *
+  ! 3   Range land                                                             *
+  ! 4   Deciduous forest                                                       *
+  ! 5   Coniferous forest                                                      *
+  ! 6   Mixed forest including wetland                                         *
+  ! 7   water, both salt and fresh                                             *
+  ! 8   barren land mostly desert                                              *
+  ! 9   nonforested wetland                                                    *
+  ! 10  mixed agricultural and range land                                      *
+  ! 11  rocky open areas with low growing shrubs                               *
+  ! 12  ice                                                                    *
+  ! 13  rainforest                                                             *
+  !                                                                            *
+  !*****************************************************************************
+
+  use drydepo_mod
+
+  implicit none
+
+  integer :: ix,jy,i,k,lu_cat,lu_perc
+  integer(kind=1) :: ilr
+  integer(kind=1) :: ilr_buffer(2160000)
+  integer :: il,irecread
+  real :: rlr, r2lr
+
+
+  ! Read landuse inventory
+  !***********************
+  ! The landuse information is saved in a compressed format and written
+  ! out by records of the length of 1 BYTE. Each grid cell consists of 3
+  ! Bytes, which include 3 landuse categories (val 1-13 and 16 percentage
+  ! categories) So one half byte is used to store the Landusecat the other
+  ! for the percentageclass in 6.25 steps (100/6.25=16)
+  ! e.g.
+  ! 4 3  percentage 4 = 4*6.25 => 25% landuse class 3
+  ! 2 1  percentage 2 = 2*6.25 => 13% landuse class 1
+  ! 1 12 percentage 1 = 1*6.26 => 6.25% landuse class 12
+
+  open(unitland,file=path(1)(1:length(1))//'IGBP_int1.dat',status='old', &
+    form='UNFORMATTED', err=998, convert='little_endian')
+  read (unitland) (ilr_buffer(i),i=1,2160000)
+  close(unitland)
+
+  irecread=1
+  do ix=1,1200
+    do jy=1,600
+  ! the 3 most abundant landuse categories in the inventory
+  ! first half byte contains the landuse class
+  ! second half byte contains the respective percentage
+      do k=1,3
+  ! 1 byte is read
+        ilr=ilr_buffer(irecread)
+  !      ilr=0
+        irecread=irecread+1
+  ! as only signed integer values exist an unsigned value is constructed
+        if (ilr.lt.0) then
+           il=ilr+256
+        else
+           il=ilr
+        endif
+  ! dividing by 16 has the effect to get rid of the right half of the byte
+  ! so just the left half remains, this corresponds to a shift right of 4
+  ! bits
+        rlr=real(il)/16.
+        lu_cat=int(rlr)
+  ! the left half of the byte is substracted from the whole in order to
+  ! get only the right half of the byte
+        r2lr=rlr-int(rlr)
+  ! shift left by 4
+        lu_perc=r2lr*16.
+        landinvent(ix,jy,k)=lu_cat
+        landinvent(ix,jy,k+3)=lu_perc
+  ! if ((jy.lt.10).and.(ix.lt.10)) write(*,*) 'reading: ',ix,jy,lu_cat,lu_perc
+      end do
+    end do
+  end do
+
+  ! Read relation landuse,z0
+  !*****************************
+
+  open(unitsfcdata,file=path(1)(1:length(1))//'sfcdata.txt', &
+       status='old',err=999)
+
+  do i=1,4
+    read(unitsfcdata,*)
+  end do
+  do i=1,numclass
+    read(unitsfcdata,'(45x,f15.3)') z0(i)
+  end do
+  close(unitsfcdata)
+
+  return
+
+  ! Issue error messages
+  !*********************
+
+998 write(*,*) ' #### FLEXPART ERROR! FILE                     ####'
+  write(*,*)   ' #### ', path(1)(1:length(1))//'IGBP_int1.dat'
+  write(*,*)   " #### (LANDUSE INVENTORY) COULD NOT BE OPENED  ####"
+  stop
+
+999 write(*,*) ' #### FLEXPART ERROR! FILE              ####'
+  write(*,*)   ' #### ', path(1)(1:length(1))//'sfcdata.txt'
+  write(*,*)   ' #### DOES NOT EXIST. Note that         ####'
+  write(*,*)   ' #### file was renamed from surfdata.t  ####'
+  write(*,*)   ' #### to sfcdata.txt in v11             ####'
+  stop
+
+end subroutine readlanduse
diff --git a/src/rea_readoutgrid.f90 b/src/rea_readoutgrid.f90
new file mode 100644
index 0000000000000000000000000000000000000000..472574ee67fcbe8cf666e41c60752d42ee3f38ec
--- /dev/null
+++ b/src/rea_readoutgrid.f90
@@ -0,0 +1,222 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine readoutgrid
+
+  !*****************************************************************************
+  !                                                                            *
+  !     This routine reads the user specifications for the output grid.        *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     4 June 1996                                                            *
+  !     HSO, 1 July 2014
+  !     Added optional namelist input
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! dxout,dyout          grid distance                                         *
+  ! numxgrid,numygrid,numzgrid    grid dimensions                              *
+  ! outlon0,outlat0      lower left corner of grid                             *
+  ! outheight(maxzgrid)  height levels of output grid [m]                      *
+  !                                                                            *
+  ! Constants:                                                                 *
+  ! unitoutgrid          unit connected to file OUTGRID                        *
+  !                                                                            *
+  !*****************************************************************************
+
+  use prepoutgrid_mod
+
+  implicit none
+
+  integer :: i,j,stat
+  real :: outhelp,xr,xr1,yr,yr1
+  real,parameter :: eps=1.e-4
+
+  ! namelist variables
+  integer, parameter :: maxoutlev=500
+  integer :: ios
+  real,allocatable, dimension (:) :: outheights
+
+  ! declare namelist
+  namelist /outgrid/ &
+    outlon0,outlat0, &
+    numxgrid,numygrid, &
+    dxout,dyout, &
+    outheights
+
+  ! allocate large array for reading input
+  allocate(outheights(maxoutlev),stat=stat)
+  if (stat.ne.0) write(*,*)'ERROR: could not allocate outheights'
+
+
+  ! Open the OUTGRID file and read output grid specifications
+  !**********************************************************
+
+  open(unitoutgrid,file=path(1)(1:length(1))//'OUTGRID',status='old', &
+    form='formatted',err=999)
+
+! try namelist input
+  dxout=-1.
+  outheights=-1.
+! helps identifying failed namelist input
+  read (unitoutgrid,outgrid,iostat=ios)
+  close(unitoutgrid)
+
+  if (dxout.le.0 .or. ios.ne.0) then
+
+    ios=1
+
+    open(unitoutgrid,file=path(1)(1:length(1))//'OUTGRID',status='old',err=999)
+
+    call skplin(5,unitoutgrid)
+
+    ! 1.  Read horizontal grid specifications
+    !****************************************
+
+    call skplin(3,unitoutgrid)
+    read(unitoutgrid,'(4x,f11.4)') outlon0
+    call skplin(3,unitoutgrid)
+    read(unitoutgrid,'(4x,f11.4)') outlat0
+    call skplin(3,unitoutgrid)
+    read(unitoutgrid,'(4x,i5)') numxgrid
+    call skplin(3,unitoutgrid)
+    read(unitoutgrid,'(4x,i5)') numygrid
+    call skplin(3,unitoutgrid)
+    read(unitoutgrid,'(4x,f12.5)') dxout
+    call skplin(3,unitoutgrid)
+    read(unitoutgrid,'(4x,f12.5)') dyout
+
+  endif
+
+  ! Check validity of output grid (shall be within model domain)
+  !*************************************************************
+
+  xr=outlon0+real(numxgrid)*dxout
+  yr=outlat0+real(numygrid)*dyout
+  xr1=xlon0+real(nxmin1)*dx
+  yr1=ylat0+real(nymin1)*dy
+  if ((outlon0+eps.lt.xlon0).or.(outlat0+eps.lt.ylat0) &
+       .or.(xr.gt.xr1+eps).or.(yr.gt.yr1+eps)) then
+    write(*,*) outlon0,outlat0
+    write(*,*) xr1,yr1,xlon0,ylat0,xr,yr,dxout,dyout
+    write(*,*) ' #### FLEXPART MODEL ERROR! PART OF OUTPUT    ####'
+    write(*,*) ' #### GRID IS OUTSIDE MODEL DOMAIN. CHANGE    ####'
+    write(*,*) ' #### FILE OUTGRID IN DIRECTORY               ####'
+    write(*,'(a)') path(1)(1:length(1))
+    stop
+  endif
+
+  ! 2. Count Vertical levels of output grid
+  !****************************************
+
+  if (ios.ne.0) then
+    j=0
+100 j=j+1
+    do i=1,3
+      read(unitoutgrid,*,end=99)
+    end do
+    read(unitoutgrid,'(4x,f7.1)',end=99) outhelp
+    if (outhelp.eq.0.) goto 99
+    goto 100
+99  numzgrid=j-1
+  else
+    do i=1,maxoutlev
+      if (outheights(i).lt.0) exit
+    end do
+    numzgrid=i-1
+  end if
+
+  allocate(outheight(numzgrid),stat=stat)
+  if (stat.ne.0) write(*,*)'ERROR: could not allocate outheight'
+  allocate(outheighthalf(numzgrid),stat=stat)
+  if (stat.ne.0) write(*,*)'ERROR: could not allocate outheighthalf'
+
+  ! 2. Vertical levels of output grid
+  !**********************************
+
+  if (ios.ne.0) then
+
+    rewind(unitoutgrid)
+    call skplin(29,unitoutgrid)
+
+    do j=1,numzgrid
+      do i=1,3
+        read(unitoutgrid,*)
+      end do
+      read(unitoutgrid,'(4x,f7.1)') outhelp
+      outheight(j)=outhelp
+      outheights(j)=outhelp
+    end do
+    close(unitoutgrid)
+
+  else
+
+    do j=1,numzgrid
+      outheight(j)=outheights(j)
+    end do
+
+  endif
+
+  ! write outgrid file in namelist format to output directory if requested
+  if (nmlout.and.lroot) then
+    ! reallocate outheights with actually required dimension for namelist writing
+    deallocate(outheights)
+    allocate(outheights(numzgrid),stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate outheights'
+
+    do j=1,numzgrid
+      outheights(j)=outheight(j)
+    end do
+
+    open(unitoutgrid,file=path(2)(1:length(2))//'OUTGRID.namelist',err=1000)
+    write(unitoutgrid,nml=outgrid)
+    close(unitoutgrid)
+  endif
+
+  ! Check whether vertical levels are specified in ascending order
+  !***************************************************************
+
+  do j=2,numzgrid
+    if (outheight(j).le.outheight(j-1)) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! YOUR SPECIFICATION#### '
+    write(*,*) ' #### OF OUTPUT LEVELS IS CORRUPT AT LEVEL    #### '
+    write(*,*) ' #### ',j,'                              #### '
+    write(*,*) ' #### PLEASE MAKE CHANGES IN FILE OUTGRID.    #### '
+    endif
+  end do
+
+  ! Determine the half levels, i.e. middle levels of the output grid
+  !*****************************************************************
+
+  outheighthalf(1)=outheight(1)/2.
+  do j=2,numzgrid
+    outheighthalf(j)=(outheight(j-1)+outheight(j))/2.
+  end do
+
+  xoutshift=xlon0-outlon0
+  youtshift=ylat0-outlat0
+
+  allocate(oroout(0:numxgrid-1,0:numygrid-1),stat=stat)
+  if (stat.ne.0) write(*,*)'ERROR: could not allocate oroout'
+  allocate(area(0:numxgrid-1,0:numygrid-1),stat=stat)
+  if (stat.ne.0) write(*,*)'ERROR: could not allocate area'
+  allocate(volume(0:numxgrid-1,0:numygrid-1,numzgrid),stat=stat)
+  if (stat.ne.0) write(*,*)'ERROR: could not allocate volume'
+  allocate(areaeast(0:numxgrid-1,0:numygrid-1,numzgrid),stat=stat)
+  if (stat.ne.0) write(*,*)'ERROR: could not allocate areaeast'
+  allocate(areanorth(0:numxgrid-1,0:numygrid-1,numzgrid),stat=stat)
+  if (stat.ne.0) write(*,*)'ERROR: could not allocate areanorth'
+  return
+
+999 write(*,*) ' #### FLEXPART MODEL ERROR! FILE "OUTGRID"    #### '
+  write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY       #### '
+  write(*,'(a)') path(1)(1:length(1))
+  stop
+
+1000 write(*,*) ' #### FLEXPART MODEL ERROR! FILE "OUTGRID"    #### '
+  write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY       #### '
+  write(*,'(a)') path(2)(1:length(2))
+  stop
+end subroutine readoutgrid
diff --git a/src/rea_readoutgrid_nest.f90 b/src/rea_readoutgrid_nest.f90
new file mode 100644
index 0000000000000000000000000000000000000000..109a3e6ae29f055dfa3bc8970aa47e260aa4b48c
--- /dev/null
+++ b/src/rea_readoutgrid_nest.f90
@@ -0,0 +1,122 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine readoutgrid_nest
+
+  !*****************************************************************************
+  !                                                                            *
+  !     This routine reads the user specifications for the output nest.        *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     4 June 1996                                                            *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! dxoutn,dyoutn        grid distances of output nest                         *
+  ! numxgridn,numygridn,numzgrid    nest dimensions                            *
+  ! outlon0n,outlat0n    lower left corner of nest                             *
+  ! outheight(maxzgrid)  height levels of output grid [m]                      *
+  !                                                                            *
+  ! Constants:                                                                 *
+  ! unitoutgrid          unit connected to file OUTGRID                        *
+  !                                                                            *
+  !*****************************************************************************
+
+  use prepoutgrid_mod
+
+  implicit none
+
+  integer :: stat
+  real :: xr,xr1,yr,yr1
+  real,parameter :: eps=1.e-4
+
+  integer :: ios
+
+  ! declare namelist
+  namelist /outgridn/ &
+    outlon0n,outlat0n, &
+    numxgridn,numygridn, &
+    dxoutn,dyoutn
+
+  ! helps identifying failed namelist input
+  dxoutn=-1.0
+
+  ! Open the OUTGRID file and read output grid specifications
+  !**********************************************************
+
+  open(unitoutgrid,file=path(1)(1:length(1))//'OUTGRID_NEST',form='formatted',status='old',err=999)
+
+  ! try namelist input
+  read(unitoutgrid,outgridn,iostat=ios)
+  close(unitoutgrid)
+
+  if ((dxoutn.le.0).or. ios.ne.0) then
+
+    open(unitoutgrid,file=path(1)(1:length(1))//'OUTGRID_NEST',status='old',err=999)
+    call skplin(5,unitoutgrid)
+
+    ! 1.  Read horizontal grid specifications
+    !****************************************
+
+    call skplin(3,unitoutgrid)
+    read(unitoutgrid,'(4x,f11.4)') outlon0n
+    call skplin(3,unitoutgrid)
+    read(unitoutgrid,'(4x,f11.4)') outlat0n
+    call skplin(3,unitoutgrid)
+    read(unitoutgrid,'(4x,i5)') numxgridn
+    call skplin(3,unitoutgrid)
+    read(unitoutgrid,'(4x,i5)') numygridn
+    call skplin(3,unitoutgrid)
+    read(unitoutgrid,'(4x,f12.5)') dxoutn
+    call skplin(3,unitoutgrid)
+    read(unitoutgrid,'(4x,f12.5)') dyoutn
+
+    close(unitoutgrid)
+  endif
+
+  ! write outgrid_nest file in namelist format to output directory if requested
+  if (nmlout.and.lroot) then
+    open(unitoutgrid,file=path(2)(1:length(2))//'OUTGRID_NEST.namelist',err=1000)
+    write(unitoutgrid,nml=outgridn)
+    close(unitoutgrid)
+  endif
+
+  allocate(orooutn(0:numxgridn-1,0:numygridn-1),stat=stat)
+  if (stat.ne.0) write(*,*)'ERROR: could not allocate orooutn'
+  allocate(arean(0:numxgridn-1,0:numygridn-1),stat=stat)
+  if (stat.ne.0) write(*,*)'ERROR: could not allocate arean'
+  allocate(volumen(0:numxgridn-1,0:numygridn-1,numzgrid),stat=stat)
+  if (stat.ne.0) write(*,*)'ERROR: could not allocate volumen'
+
+  ! Check validity of output grid (shall be within model domain)
+  !*************************************************************
+
+  xr=outlon0n+real(numxgridn)*dxoutn
+  yr=outlat0n+real(numygridn)*dyoutn
+  xr1=xlon0+real(nxmin1)*dx
+  yr1=ylat0+real(nymin1)*dy
+  if ((outlon0n+eps.lt.xlon0).or.(outlat0n+eps.lt.ylat0) &
+       .or.(xr.gt.xr1+eps).or.(yr.gt.yr1+eps)) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! PART OF OUTPUT    ####'
+    write(*,*) ' #### NEST IS OUTSIDE MODEL DOMAIN. CHANGE    ####'
+    write(*,*) ' #### FILE OUTGRID IN DIRECTORY               ####'
+    write(*,'(a)') path(1)(1:length(1))
+    stop
+  endif
+
+  xoutshiftn=xlon0-outlon0n
+  youtshiftn=ylat0-outlat0n
+  return
+
+999 write(*,*) ' #### FLEXPART MODEL ERROR! FILE "OUTGRID"    #### '
+  write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY       #### '
+  write(*,'(a)') path(1)(1:length(1))
+  stop
+
+1000 write(*,*) ' #### FLEXPART MODEL ERROR! FILE "OUTGRID"    #### '
+  write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY       #### '
+  write(*,'(a)') path(2)(1:length(2))
+  stop
+end subroutine readoutgrid_nest
diff --git a/src/rea_readpartoptions.f90 b/src/rea_readpartoptions.f90
new file mode 100644
index 0000000000000000000000000000000000000000..6651c7428d79efff65449c751fad20d2d0926663
--- /dev/null
+++ b/src/rea_readpartoptions.f90
@@ -0,0 +1,318 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine readpartoptions
+
+  !*****************************************************************************
+  !                                                                            *
+  !     This routine reads the age classes to be used for the current model    *
+  !     run.                                                                   *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !     20 March 2000                                                          *
+  !     HSO, 1 July 2014                                                       *
+  !     Added optional namelist input                                          *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  ! Constants:                                                                 *
+  !                                                                            *
+  !*****************************************************************************
+
+  implicit none
+
+  integer :: i,np
+
+  ! namelist help variables
+  integer :: ios
+
+  logical ::                      &
+    longitude=.false.,            &
+    longitude_average=.false.,    &
+    latitude=.false.,             &
+    latitude_average=.false.,     &
+    height=.false.,               &
+    height_average=.false.,       &
+    pv=.false.,                   &
+    pv_average=.false.,           &
+    qv=.false.,                   &
+    qv_average=.false.,           &
+    density=.false.,              &
+    density_average=.false.,      &
+    temperature=.false.,          &
+    temperature_average=.false.,  &
+    pressure=.false.,             &
+    pressure_average=.false.,     &
+    mixingheight=.false.,         &
+    mixingheight_average=.false., &
+    tropopause=.false.,           &
+    tropopause_average=.false.,   &
+    topography=.false.,           &
+    topography_average=.false.,   &
+    mass=.false.,                 &
+    mass_average=.false.,         &
+    u=.false.,                    &
+    u_average=.false.,            &
+    v=.false.,                    &
+    v_average=.false.,            &
+    w=.false.,                    &
+    w_average=.false.,            &
+    vsettling=.false.,            &
+    vsettling_average=.false.,    &
+    wetdeposition=.false.,        &
+    drydeposition=.false.
+
+  ! namelist declaration
+  namelist /partoptions/  &
+    longitude,            &
+    longitude_average,    &
+    latitude,             &
+    latitude_average,     &
+    height,               &
+    height_average,       &
+    pv,                   &
+    pv_average,           &
+    qv,                   &
+    qv_average,           &
+    density,              &
+    density_average,      &
+    temperature,          &
+    temperature_average,  &
+    pressure,             &
+    pressure_average,     &
+    mixingheight,         &
+    mixingheight_average, &
+    tropopause,           &
+    tropopause_average,   &
+    topography,           &
+    topography_average,   &
+    mass,                 &
+    mass_average,         &
+    u,                    &
+    u_average,            &
+    v,                    &
+    v_average,            &
+    w,                    &
+    w_average,            &
+    vsettling,            &
+    vsettling_average,    &
+    wetdeposition,        &
+    drydeposition
+
+  ! If age spectra claculation is switched on,
+  ! open the AGECLASSSES file and read user options
+  !************************************************
+
+  open(unitpartoptions,file=path(1)(1:length(1))//'PARTOPTIONS',form='formatted',status='old',err=9999)
+
+  ! try to read in as a namelist
+  read(unitpartoptions,partoptions,iostat=ios)
+  close(unitpartoptions)
+
+  if (ios.ne.0) then
+    write(*,*) 'Namelist error in PARTOPTIONS file', trim(path(1)(1:length(1))//'PARTOPTIONS')
+    stop
+  endif
+  allocate( partopt(num_partopt) )
+  ! Save values in particle options derived type
+  !*********************************************
+  partopt(1)%long_name='longitude'
+  partopt(1)%name='LO'
+  partopt(1)%print=longitude
+
+  partopt(2)%long_name='longitude_average'
+  partopt(2)%name='lo'
+  partopt(2)%print=longitude_average
+  partopt(2)%average=.true.
+
+  partopt(3)%long_name='latitude'
+  partopt(3)%name='LA'
+  partopt(3)%print=latitude
+
+  partopt(4)%long_name='latitude_average'
+  partopt(4)%name='la'
+  partopt(4)%print=latitude_average
+  partopt(4)%average=.true.
+
+  partopt(5)%long_name='height'
+  partopt(5)%name='ZZ'
+  partopt(5)%print=height
+
+  partopt(6)%long_name='height_average'
+  partopt(6)%name='zz'
+  partopt(6)%print=height_average
+  partopt(6)%average=.true.
+
+  partopt(7)%long_name='pv'
+  partopt(7)%name='PV'
+  partopt(7)%print=pv
+
+  partopt(8)%long_name='pv_average'
+  partopt(8)%name='pv'
+  partopt(8)%print=pv_average
+  partopt(8)%average=.true.
+
+  partopt(9)%long_name='qv'
+  partopt(9)%name='QV'
+  partopt(9)%print=qv
+
+  partopt(10)%long_name='qv_average'
+  partopt(10)%name='qv'
+  partopt(10)%print=qv_average
+  partopt(10)%average=.true.
+
+  partopt(11)%long_name='density'
+  partopt(11)%name='RH'
+  partopt(11)%print=density
+
+  partopt(12)%long_name='density_average'
+  partopt(12)%name='rh'
+  partopt(12)%print=density_average
+  partopt(12)%average=.true.
+
+  partopt(13)%long_name='temperature'
+  partopt(13)%name='TT'
+  partopt(13)%print=temperature
+
+  partopt(14)%long_name='temperature_average'
+  partopt(14)%name='tt'
+  partopt(14)%print=temperature_average
+  partopt(14)%average=.true.
+
+  partopt(15)%long_name='pressure'
+  partopt(15)%name='PR'
+  partopt(15)%print=pressure
+
+  partopt(16)%long_name='pressure_average'
+  partopt(16)%name='pr'
+  partopt(16)%print=pressure_average
+  partopt(16)%average=.true.
+
+  partopt(17)%long_name='mixingheight'
+  partopt(17)%name='HM'
+  partopt(17)%print=mixingheight
+
+  partopt(18)%long_name='mixingheight_average'
+  partopt(18)%name='hm'
+  partopt(18)%print=mixingheight_average
+  partopt(18)%average=.true.
+
+  partopt(19)%long_name='tropopause'
+  partopt(19)%name='TR'
+  partopt(19)%print=tropopause
+
+  partopt(20)%long_name='tropopause_average'
+  partopt(20)%name='tr'
+  partopt(20)%print=tropopause_average
+  partopt(20)%average=.true.
+
+  partopt(21)%long_name='topography'
+  partopt(21)%name='TO'
+  partopt(21)%print=topography
+
+  partopt(22)%long_name='topography_average'
+  partopt(22)%name='to'
+  partopt(22)%print=topography_average
+  partopt(22)%average=.true.
+
+  partopt(23)%long_name='mass'
+  partopt(23)%name='MA'
+  partopt(23)%print=mass
+
+  partopt(24)%long_name='mass_average'
+  partopt(24)%name='ma'
+  partopt(24)%print=mass_average
+  partopt(24)%average=.true.
+
+  partopt(25)%long_name='u'
+  partopt(25)%name='UU'
+  partopt(25)%print=u
+
+  partopt(26)%long_name='u_average'
+  partopt(26)%name='uu'
+  partopt(26)%print=u_average
+  partopt(26)%average=.true.
+
+  partopt(27)%long_name='v'
+  partopt(27)%name='VV'
+  partopt(27)%print=v
+
+  partopt(28)%long_name='v_average'
+  partopt(28)%name='vv'
+  partopt(28)%print=v_average
+  partopt(28)%average=.true.
+
+  partopt(29)%long_name='w'
+  partopt(29)%name='WW'
+  partopt(29)%print=w
+
+  partopt(30)%long_name='w_average'
+  partopt(30)%name='ww'
+  partopt(30)%print=w_average
+  partopt(30)%average=.true.
+
+  partopt(31)%long_name='vsettling'
+  partopt(31)%name='VS'
+  partopt(31)%print=vsettling
+
+  partopt(32)%long_name='vsettling_average'
+  partopt(32)%name='vs'
+  partopt(32)%print=vsettling_average
+  partopt(32)%average=.true.
+
+  partopt(33)%long_name='wetdeposition'
+  partopt(33)%name='WD'
+  partopt(33)%print=wetdeposition
+
+  partopt(34)%long_name='drydeposition'
+  partopt(34)%name='DD'
+  partopt(34)%print=drydeposition
+  ! Numbers are assigned to the averaged fields for proper
+  ! allocation and reading in particle_mod and output_mod
+  !******************************************************
+  n_average=0
+  do np=1,num_partopt
+    if (partopt(np)%average .and. partopt(np)%print) then
+      n_average=n_average+1
+      partopt(np)%i_average = n_average
+      if ((partopt(np)%name.eq.'MA') .or. (partopt(np)%name.eq.'ma')) then
+        n_average=n_average + (maxspec-1)
+      endif
+    endif
+  end do
+
+  ! write partoptions file in namelist format to output directory if requested
+  if (nmlout.and.lroot) then
+    open(unitpartoptions,file=path(2)(1:length(2))//'PARTOPTIONS.namelist',err=10000)
+    write(unitpartoptions,nml=partoptions)
+    close(unitpartoptions)
+  endif
+
+
+  ! Restart files, when using in combination with averaged particle output,
+  ! need to be synchronised to prevent false averages in the first step of
+  ! the new run
+  !************************************************************************
+  if ((ipout.ne.0).and.(n_average.gt.0).and.(loutrestart.ne.-1)) then
+    if (mod(loutrestart,ipoutfac*loutstep).ne.0) then
+      write(*,*) '### FLEXPART MODEL ERROR! FILE COMMAND:     ###'
+      write(*,*) '### LOUTRESTART NEEDS TO BE DIVISABLE BY    ###'
+      write(*,*) '### LOUTSTEP*IPOUTFAC.                      ###'
+      stop
+    endif
+  endif
+
+  return
+
+9999   write(*,*) ' #### FLEXPART MODEL ERROR! FILE "PARTOPTIONS" #### '
+  write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY       #### '
+  write(*,'(a)') path(1)(1:length(1))
+  stop
+
+10000  write(*,*) ' #### FLEXPART MODEL ERROR! FILE "PARTOPTIONS" #### '
+  write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY       #### '
+  write(*,'(a)') path(2)(1:length(2))
+  stop
+end subroutine readpartoptions
diff --git a/src/rea_readpaths.f90 b/src/rea_readpaths.f90
new file mode 100644
index 0000000000000000000000000000000000000000..79cae87f740a4391989f53cd1a2826adf929738e
--- /dev/null
+++ b/src/rea_readpaths.f90
@@ -0,0 +1,89 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine readpaths
+
+  !*****************************************************************************
+  !                                                                            *
+  !     Reads the pathnames, where input/output files are expected to be.      *
+  !     The file pathnames must be available in the current working directory. *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     1 February 1994                                                        *
+  !     last modified                                                          *
+  !     HS, 7.9.2012                                                           *
+  !     option to give pathnames file as command line option                   *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! length(numpath)    lengths of the path names                               *
+  ! path(numpath)      pathnames of input/output files                         *
+  !                                                                            *
+  ! Constants:                                                                 *
+  ! numpath            number of pathnames to be read in                       *
+  !                                                                            *
+  !*****************************************************************************
+
+  implicit none
+
+  integer   :: i
+  character(256) :: string_test
+  character(1) :: character_test
+
+  ! Read the pathname information stored in unitpath
+  !*************************************************
+
+  open(unitpath,file=trim(pathfile),status='old',err=999)
+
+  do i=1,numpath
+    read(unitpath,'(a)',err=998) path(i)
+    length(i)=index(path(i),' ')-1
+
+
+    string_test = path(i)
+    character_test = string_test(length(i):length(i))
+    !print*, 'character_test,  string_test ', character_test,  string_test
+      if ((character_test .NE. '/') .AND. (i .LT. 4))  then
+         print*, 'WARNING: path not ending in /'
+         print*, path(i)
+         path(i) = string_test(1:length(i)) // '/'
+         length(i)=length(i)+1
+         print*, 'fix: padded with /'
+         print*, path(i)
+         print*, 'length(i) increased 1'
+      endif
+  end do
+
+  ! Check whether any nested subdomains are to be used
+  !***************************************************
+
+  do i=1,maxnests
+  ! ESO 2016 Added 'end'/'err' in case user forgot '====' at end of file and
+  ! maxnests > numbnests
+    read(unitpath,'(a)', end=30, err=30) path(numpath+2*(i-1)+1)
+    read(unitpath,'(a)', end=30, err=30) path(numpath+2*(i-1)+2)
+    if (path(numpath+2*(i-1)+1)(1:5).eq.'=====') goto 30
+    length(numpath+2*(i-1)+1)=index(path(numpath+2*(i-1)+1),' ')-1
+    length(numpath+2*(i-1)+2)=index(path(numpath+2*(i-1)+2),' ')-1
+  end do
+
+
+  ! Determine number of available nested domains
+  !*********************************************
+
+30   numbnests=i-1
+
+  close(unitpath)
+  return
+
+998   write(*,*) ' #### TRAJECTORY MODEL ERROR! ERROR WHILE     #### '
+  write(*,*) ' #### READING FILE PATHNAMES.                 #### '
+  stop
+
+999   write(*,*) ' #### TRAJECTORY MODEL ERROR! FILE "pathnames"#### '
+  write(*,*) ' #### CANNOT BE OPENED IN THE CURRENT WORKING #### '
+  write(*,*) ' #### DIRECTORY.                              #### '
+  stop
+end subroutine readpaths
diff --git a/src/rea_readreceptors.f90 b/src/rea_readreceptors.f90
new file mode 100644
index 0000000000000000000000000000000000000000..ab1772b2d01ab063321f9e89bf7b6db9749042ec
--- /dev/null
+++ b/src/rea_readreceptors.f90
@@ -0,0 +1,197 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine readreceptors
+
+  !*****************************************************************************
+  !                                                                            *
+  !     This routine reads the user specifications for the receptor points.    *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !     1 August 1996                                                          *
+  !                                                                            *
+  !     HSO, 14 August 2013: Added optional namelist input
+  !     PS, 2/2015: access= -> position=
+  !     PS, 6/2015: variable names, simplify code
+  !     PS, 3/2023: remove position=append, makes no sense for new file        *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! receptorarea(maxreceptor)  area of dx*dy at location of receptor           *
+  ! receptorname(maxreceptor)  names of receptors                              *
+  ! xreceptor,yreceptor  coordinates of receptor points                        *
+  !                                                                            *
+  ! Constants:                                                                 *
+  ! unitreceptor         unit connected to file RECEPTORS                      *
+  !                                                                            *
+  !*****************************************************************************
+
+  implicit none
+
+  integer :: j
+  real :: x,y,xm,ym
+  character(len=10) :: receptor
+
+  integer :: ios
+  real :: xlon,ylat   ! for namelist input, xlon/xlat are used instead of x,y
+
+  ! declare namelist
+!  namelist /nml_receptors/ receptor, xlon, ylat
+  namelist /receptors/ receptor, xlon, ylat
+
+!CPS I comment this out - why should we not have receptor output in bwd runs?
+  ! For backward runs, do not allow receptor output. Thus, set number of
+  ! receptors to zero
+  !  if (ldirect.lt.0) then
+  !    numreceptor=0
+  !    return
+  !  endif
+
+
+  ! Open the RECEPTORS file and read output grid specifications
+  !************************************************************
+
+  open (unitreceptor,file=trim(path(1))//'RECEPTORS',form='formatted', &
+    status='old',err=999)
+
+! try namelist input
+  xlon = -999. ! we need this to check namelist reading
+  ylat = -999.
+  read (unitreceptor,receptors,iostat=ios)
+!  read (unitreceptor,nml_receptors,iostat=ios)
+!  write (*,*) 'nml_receptors iostat',ios
+!  write (*,nml_receptors)
+   close(unitreceptor)
+
+  ! prepare namelist output if requested
+  if (nmlout) open(unitreceptorout,file=trim(path(2))// &
+    'RECEPTORS.namelist',status='new',err=1000)
+
+  if (ios .gt. 0) then
+
+    goto 991 ! wrong variable name in namelist
+
+  elseif (ios .eq. 0) then ! read as namelist
+
+    if (nint(xlon) .eq. -999 .or. nint(ylat) .eq. -999) goto 993
+
+! PS: reopen file otherwise first receptor is skipped!
+   open (unitreceptor,file=trim(path(1))//'RECEPTORS',status='old',err=999)
+
+    j=0
+    do while (ios .eq. 0)
+      j=j+1
+      read(unitreceptor,receptors,iostat=ios)
+!      read(unitreceptor,nml_receptors,iostat=ios)
+      if (ios .eq. 0) then
+        if (j .gt. maxreceptor) then
+          write(*,*) ' #### FLEXPART MODEL ERROR! TOO MANY RECEPTOR #### '
+          write(*,*) ' #### POINTS ARE GIVEN.                       #### '
+          write(*,*) ' #### MAXIMUM NUMBER IS ',maxreceptor,'       #### '
+          write(*,*) ' #### PLEASE MAKE CHANGES IN FILE RECEPTORS   #### '
+        endif
+        receptorname(j)=receptor
+        xreceptor(j)=(xlon-xlon0)/dx       ! transform to grid coordinates
+        yreceptor(j)=(ylat-ylat0)/dy
+        xm=r_earth*cos(ylat*pi/180.)*dx/180.*pi
+        ym=r_earth*dy/180.*pi
+        receptorarea(j)=xm*ym
+      ! write receptors in namelist format to output directory if requested
+        if (nmlout) write(unitreceptorout,nml=receptors)
+!        if (nmlout) write(unitreceptorout,nml=nml_receptors)
+      elseif (ios .gt. 0) then
+        write(*,*) ' ### FLEXPART MODEL ERROR! Error in RECEPTORS namelist ###'
+        stop 'Error in RECEPTORS namelist'
+      else
+        write (*,*) 'receptor read in nml format, ios<0', ios
+        write (*,receptors)
+!        write (*,nml_receptors)
+      endif
+    end do ! end nml receptors reading loop
+
+    numreceptor=j-1
+
+  else ! ios<0 = EOF, read as conventional input file
+
+    open (unitreceptor,file=trim(path(1))//'RECEPTORS',status='old',err=999)
+    call skplin(5,unitreceptor)
+
+    ! Read the names and coordinates of the receptors
+    !************************************************
+
+    j=1
+100 continue
+      read(unitreceptor,*,end=99)
+      read(unitreceptor,*,end=99)
+      read(unitreceptor,*,end=99)
+      read(unitreceptor,'(4x,a16)',end=99) receptor
+      call skplin(3,unitreceptor)
+      read(unitreceptor,'(4x,f11.4)',end=99) xlon
+      call skplin(3,unitreceptor)
+      read(unitreceptor,'(4x,f11.4)',end=99) ylat
+      if (xlon.eq.0. .and. ylat.eq.0. .and. &
+         (receptor .eq. '                ')) then
+        write(*,*) 'WARNING: looks like empty receptor at south pole;'// &
+          ' will be skipped'
+        j=j-1
+        goto 100
+      endif
+
+      if (j .gt. maxreceptor) goto 992
+
+      receptorname(j)=receptor
+      xreceptor(j)=(xlon-xlon0)/dx       ! transform to grid coordinates
+      yreceptor(j)=(ylat-ylat0)/dy
+      xm=r_earth*cos(ylat*pi/180.)*dx/180.*pi
+      ym=r_earth*dy/180.*pi
+      receptorarea(j)=xm*ym
+      ! write receptors file in namelist format to output directory if requested
+      if (nmlout) write(unitreceptorout,nml=receptors)
+!      if (nmlout) write(unitreceptorout,nml=nml_receptors)
+    goto 100
+
+99  numreceptor=j-1
+
+  endif ! end no-nml / nml bloc
+
+  close (unitreceptor)
+  if (nmlout) close (unitreceptorout)
+
+  return
+
+991 continue
+  write(*,*) '#### FLEXPART ERROR: wrong variable names present'
+  write(*,*) '#### in namelist in file RECEPTORS'
+  write(*,*) '#### note that in v11+ coordinate names are xlon and ylat'
+
+  stop
+
+992 continue
+  write(*,*) ' #### FLEXPART MODEL ERROR! TOO MANY RECEPTOR #### '
+  write(*,*) ' #### POINTS ARE GIVEN.                       #### '
+  write(*,*) ' #### MAXIMUM NUMBER IS ',maxreceptor,'       #### '
+!        write(*,*) ' #### PLEASE MAKE CHANGES IN FILE RECEPTORS   #### '
+  stop
+
+993 continue
+  write(*,*) '#### FLEXPART ERROR: namelist in file RECEPTORS'
+  write(*,*) '#### first receptor point did not contain xlon and/or ylat'
+  write(*,*) '#### Check your namelist!'
+  stop
+
+999 write(*,*) 'INFORMATION: input file RECEPTORS cannot be opened'
+    write(*,*) 'in directory '//trim(path(1))
+    write(*,*) 'Continuing without RECEPTOR'
+
+  numreceptor=0
+  return
+
+1000 write(*,*) ' #### FLEXPART MODEL ERROR! File "RECEPTORS"      #### '
+  write(*,*)    ' #### cannot be opened in the output directory    #### '
+  write(*,'(a)') ' #### '//trim(path(2))
+  write(*,*)    ' #### either write perm missing or old file exists ###'
+
+  stop
+
+end subroutine readreceptors
diff --git a/src/rea_readreleases.f90 b/src/rea_readreleases.f90
new file mode 100644
index 0000000000000000000000000000000000000000..d7e8ba8c72458f10aba623df5226535acd6a36b4
--- /dev/null
+++ b/src/rea_readreleases.f90
@@ -0,0 +1,555 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine readreleases
+
+  !*****************************************************************************
+  !                                                                            *
+  !     This routine reads the release point specifications for the current    *
+  !     model run. Several release points can be used at the same time.        *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     18 May 1996                                                            *
+  !                                                                            *
+  !     Update: 29 January 2001                                                *
+  !     Release altitude can be either in magl or masl                         *
+  !     HSO, 12 August 2013
+  !     Added optional namelist input
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! decay               decay constant of species                              *
+  ! dquer [um]          mean particle diameters                                *
+  ! dsigma              e.g. dsigma=10 or dsigma=0.1 means that 68% of the mass*
+  !                     are between 0.1*dquer and 10*dquer                     *
+  ! ireleasestart, ireleaseend [s] starting time and ending time of each       *
+  !                     release                                                *
+  ! kindz               1: zpoint is in m agl, 2: zpoint is in m asl, 3: zpoint*
+  !                     is in hPa                                              *
+  ! npart               number of particles to be released                     *
+  ! nspec               number of species to be released                       *
+  ! density [kg/m3]     density of the particles                               *
+  ! rm [s/m]            Mesophyll resistance                                   *
+  ! species             name of species                                        *
+  ! xmass               total mass of each species                             *
+  ! xpoint1,ypoint1     geograf. coordinates of lower left corner of release   *
+  !                     area                                                   *
+  ! xpoint2,ypoint2     geograf. coordinates of upper right corner of release  *
+  !                     area                                                   *
+  ! weta_gas, wetb_gas  parameters for below-cloud scavenging (gas)            *
+  ! crain_aero, csnow_aero  parameters for below-cloud scavenging (aerosol)    *
+  ! ccn_aero, in_aero   parameters for in-cloud scavenging (aerosol)           *
+  ! zpoint1,zpoint2     height range, over which release takes place           *
+  ! num_min_discrete    if less, release cannot be randomized and happens at   *
+  !                     time mid-point of release interval                     *
+  ! lroot               true if serial version, or if MPI and root process     *
+  !                                                                            *
+  !*****************************************************************************
+
+  use point_mod
+  use xmass_mod
+  use drydepo_mod
+
+  implicit none
+
+  integer :: numpartmax,i,j,id1,it1,id2,it2,idum,stat,irel,ispc,nsettle
+  integer,parameter :: num_min_discrete=100
+  real :: releaserate,xdum,cun
+  real(kind=dp) :: jul1,jul2,julm
+  real,parameter :: eps2=1.e-9
+  character(len=50) :: line
+  logical :: old
+
+  ! help variables for namelist reading
+  integer :: numpoints, parts, ios
+  integer*2 :: zkind
+  integer :: idate1, itime1, idate2, itime2
+  real :: lon1,lon2,lat1,lat2,z1,z2
+  character*40 :: comment
+  integer,parameter :: unitreleasesout=2
+  real,allocatable, dimension (:) :: mass
+  integer,allocatable, dimension (:) :: specnum_rel,specnum_rel2
+  real,allocatable,dimension(:) :: vsh,fracth,schmih
+
+  ! declare namelists
+  namelist /releases_ctrl/ &
+       nspec, &
+       specnum_rel
+
+  namelist /release/ &
+       idate1, itime1, &
+       idate2, itime2, &
+       lon1, lon2, &
+       lat1, lat2, &
+       z1, z2, &
+       zkind, &
+       mass, &
+       parts, &
+       comment
+
+  numpoint=0
+
+  ! allocate with maxspec for first input loop
+  allocate(mass(maxspec),stat=stat)
+  if (stat.ne.0) write(*,*)'ERROR: could not allocate mass'
+  allocate(specnum_rel(maxspec),stat=stat)
+  if (stat.ne.0) write(*,*)'ERROR: could not allocate specnum_rel'
+
+  ! presetting namelist releases_ctrl
+  nspec = -1  ! use negative value to determine failed namelist input
+  specnum_rel = 0
+
+  !sec, read release to find how many releasepoints should be allocated
+  open(unitreleases,file=path(1)(1:length(1))//'RELEASES',status='old', &
+    form='formatted',err=999)
+
+  ! check if namelist input provided
+  read(unitreleases,releases_ctrl,iostat=ios)
+
+  ! prepare namelist output if requested
+!  if (nmlout.and.lroot) then
+  if (nmlout) &
+    open(unitreleasesout,file=path(2)(1:length(2))//'RELEASES.namelist', &
+      access='append',status='replace',err=1000)
+
+  if (ios.ne.0 .or. nspec.lt.0) then
+!    if (lroot) write(*,*) 'RELEASE either having unrecognised entries, &
+!      &or in old format, please update to namelist format.'
+    write(*,*) 'RELEASE either having unrecognised entries, &
+      &or in old format, please update to namelist format.'
+      stop
+  else
+    if (ipin.ne.3 .and. ipin.ne.4) then
+      ! Not necessary to read releases when using part_ic.nc
+      ios=0
+      do while (ios.eq.0)
+        idate1=-1
+        read(unitreleases,release,iostat=ios)
+        if ((idate1.lt.0).or. ios.ne.0) then
+          ios=1
+        else
+          numpoint=numpoint+1
+        endif
+      end do
+      ios=0
+    else
+      numpoint=1
+    endif
+  endif
+
+  rewind(unitreleases)
+
+  if (nspec.gt.maxspec) goto 994
+
+  ! allocate arrays of matching size for number of species (namelist output)
+  deallocate(mass)
+  allocate(mass(nspec),stat=stat)
+  if (stat.ne.0) write(*,*)'ERROR: could not allocate mass'
+  allocate(specnum_rel2(nspec),stat=stat)
+  if (stat.ne.0) write(*,*)'ERROR: could not allocate specnum_rel2'
+  specnum_rel2=specnum_rel(1:nspec)
+  deallocate(specnum_rel)
+  ! eso: BUG, crashes here for nspec=12 and maxspec=6,
+  ! TODO: catch error and exit
+  allocate(specnum_rel(nspec),stat=stat)
+  if (stat.ne.0) write(*,*)'ERROR: could not allocate specnum_rel'
+  specnum_rel=specnum_rel2
+  deallocate(specnum_rel2)
+
+  !allocate memory for numpoint releaspoints
+  allocate(ireleasestart(numpoint),stat=stat)
+  if (stat.ne.0) write(*,*)'ERROR: could not allocate ireleasestart'
+  allocate(ireleaseend(numpoint),stat=stat)
+  if (stat.ne.0) write(*,*)'ERROR: could not allocate ireleaseend'
+  allocate(xpoint1(numpoint),stat=stat)
+  if (stat.ne.0) write(*,*)'ERROR: could not allocate xpoint1'
+  allocate(xpoint2(numpoint),stat=stat)
+  if (stat.ne.0) write(*,*)'ERROR: could not allocate xpoint2'
+  allocate(ypoint1(numpoint),stat=stat)
+  if (stat.ne.0) write(*,*)'ERROR: could not allocate ypoint1'
+  allocate(ypoint2(numpoint),stat=stat)
+  if (stat.ne.0) write(*,*)'ERROR: could not allocate ypoint2'
+  allocate(zpoint1(numpoint),stat=stat)
+  if (stat.ne.0) write(*,*)'ERROR: could not allocate zpoint1'
+  allocate(zpoint2(numpoint),stat=stat)
+  if (stat.ne.0) write(*,*)'ERROR: could not allocate zpoint2'
+  allocate(kindz(numpoint),stat=stat)
+  if (stat.ne.0) write(*,*)'ERROR: could not allocate kindz'
+  allocate(xmass(numpoint,maxspec),stat=stat)
+  if (stat.ne.0) write(*,*)'ERROR: could not allocate xmass'
+  allocate(rho_rel(numpoint),stat=stat)
+  if (stat.ne.0) write(*,*)'ERROR: could not allocate rho_rel'
+  allocate(npart(numpoint),stat=stat)
+  if (stat.ne.0) write(*,*)'ERROR: could not allocate npart'
+  allocate(xmasssave(numpoint),stat=stat)
+  if (stat.ne.0) write(*,*)'ERROR: could not allocate xmasssave'
+
+  if (lroot) write (*,*) 'Releasepoints : ', numpoint
+
+  do i=1,numpoint
+    xmasssave(i)=0.
+  end do
+
+  !now save the information
+  DEP=.false.
+  DRYDEP=.false.
+  WETDEP=.false.
+  OHREA=.false.
+  do i=1,maxspec
+    DRYDEPSPEC(i)=.false.
+    WETDEPSPEC(i)=.false.
+  end do
+
+  ! namelist output
+  if (nmlout.and.lroot) then
+    write(unitreleasesout,nml=releases_ctrl)
+  endif
+
+  do i=1,nspec
+    call readspecies(specnum_rel(i),i)
+
+
+  ! Allocate temporary memory necessary for the different diameter bins
+  !********************************************************************
+    allocate(vsh(ndia(i)),fracth(ndia(i)),schmih(ndia(i)))
+
+  ! Molecular weight
+  !*****************
+
+    if (((iout.eq.2).or.(iout.eq.3)).and.(weightmolar(i).lt.0.)) then
+      write(*,*) 'For mixing ratio output, valid molar weight'
+      write(*,*) 'must be specified for all simulated species.'
+      write(*,*) 'Check table SPECIES or choose concentration'
+      write(*,*) 'output instead if molar weight is not known.'
+      stop
+    endif
+
+  ! Radioactive decay
+  !******************
+
+    decay(i)=0.693147/decay(i) !conversion half life to decay constant
+
+
+  ! Dry deposition of gases
+  !************************
+
+    if (reldiff(i).gt.0.) rm(i)=1./(henry(i)/3000.+100.*f0(i))    ! mesophyll resistance
+
+  ! Dry deposition of particles
+  !****************************
+
+    vsetaver(i)=0.
+    cunningham(i)=0.
+    dquer(i)=dquer(i)*1000000.         ! Conversion m to um
+    if (density(i).gt.0.) then         ! Additional parameters
+      call part0(dquer(i),dsigma(i),density(i),ndia(i),fracth,schmih,cun,vsh)
+      do j=1,ndia(i)
+        fract(i,j)=fracth(j)
+        schmi(i,j)=schmih(j)
+        vset(i,j)=vsh(j)
+        cunningham(i)=cunningham(i)+cun*fract(i,j)
+        vsetaver(i)=vsetaver(i)-vset(i,j)*fract(i,j)
+      end do
+      if (lroot) write(*,*) 'Average settling velocity: ',i,vsetaver(i)
+    endif
+
+  ! Dry deposition for constant deposition velocity
+  !************************************************
+
+    dryvel(i)=dryvel(i)*0.01         ! conversion to m/s
+
+  ! Check if wet deposition or OH reaction shall be calculated
+  !***********************************************************
+
+  ! ESO 04.2016 check for below-cloud scavenging (gas or aerosol)
+    if ((dquer(i).le.0..and.(weta_gas(i).gt.0. .or. wetb_gas(i).gt.0.)) .or. &
+         &(dquer(i).gt.0. .and. (crain_aero(i) .gt. 0. .or. csnow_aero(i).gt.0.)))  then
+      WETDEP=.true.
+      WETDEPSPEC(i)=.true.
+      if (lroot) then
+        write (*,*) '  Below-cloud scavenging: ON'
+  !  write (*,*) 'Below-cloud scavenging coefficients: ',weta(i),i
+      end if
+    else
+      if (lroot) write (*,*) '  Below-cloud scavenging: OFF'
+    endif
+
+  ! NIK 31.01.2013 + 10.12.2013 + 15.02.2015
+    if (dquer(i).gt.0..and.(ccn_aero(i).gt.0. .or. in_aero(i).gt.0.))  then
+      WETDEP=.true.
+      WETDEPSPEC(i)=.true.
+      if (lroot) then
+        write (*,*) '  In-cloud scavenging: ON'
+  !        write (*,*) 'In-cloud scavenging coefficients: ',&
+  !           &ccn_aero(i),in_aero(i),i !,wetc_in(i), wetd_in(i),i
+      end if
+    else
+      if (lroot) write (*,*) '  In-cloud scavenging: OFF'
+    endif
+
+    if (ohcconst(i).gt.0.) then
+      OHREA=.true.
+      if (lroot) write (*,*) '  OHreaction switched on: ',ohcconst(i),i
+    endif
+
+    if ((reldiff(i).gt.0.).or.(density(i).gt.0.).or.(dryvel(i).gt.0.)) then
+      DRYDEP=.true.
+      DRYDEPSPEC(i)=.true.
+    endif
+
+    deallocate(vsh,fracth,schmih)
+  end do ! end loop over species
+
+  if (WETDEP.or.DRYDEP) DEP=.true.
+
+  ! Not necessary to read releases when using part_ic.nc
+  !*****************************************************
+  if ((ipin.eq.3).or.(ipin.eq.4)) then
+    maxpointspec_act=1
+    return
+  endif
+
+  ! Read specifications for each release point
+  !*******************************************
+  numpoints=numpoint
+  numpoint=0
+  numpartmax=0
+  releaserate=0.
+101 numpoint=numpoint+1
+
+  if (numpoint.gt.numpoints) goto 250
+  zkind = 1
+  mass = 0
+  parts = 0
+  comment = ' '
+  read(unitreleases,release,iostat=ios)
+  id1=idate1
+  it1=itime1
+  id2=idate2
+  it2=itime2
+  xpoint1(numpoint)=lon1
+  xpoint2(numpoint)=lon2
+  ypoint1(numpoint)=lat1
+  ypoint2(numpoint)=lat2
+  zpoint1(numpoint)=z1
+  zpoint2(numpoint)=z2
+  kindz(numpoint)=zkind
+  do i=1,nspec
+    xmass(numpoint,i)=mass(i)
+  end do
+  npart(numpoint)=parts
+  compoint(min(1001,numpoint))=comment
+
+! namelist output
+  if (nmlout.and.lroot) then
+    write(unitreleasesout,nml=release)
+  endif
+
+  ! If a release point contains no particles, stop and issue error message
+  !***********************************************************************
+
+  if (npart(numpoint).eq.0) then
+    write(*,*) 'FLEXPART MODEL ERROR'
+    write(*,*) 'RELEASES file is corrupt.'
+    write(*,*) 'At least for one release point, there are zero'
+    write(*,*) 'particles released. Make changes to RELEASES.'
+    stop
+  endif
+
+  ! If FLEXPART is run for backward deposition force zpoint
+  !*********************************************************************
+  if (WETBKDEP) then
+    zpoint1(numpoint)=0.
+    zpoint2(numpoint)=20000.
+    kindz(numpoint)=1
+  endif
+  if (DRYBKDEP) then
+    zpoint1(numpoint)=0.
+    zpoint2(numpoint)=2.*href
+    kindz(numpoint)=1
+  endif
+
+
+  ! Check whether x coordinates of release point are within model domain
+  !*********************************************************************
+
+  if (xpoint1(numpoint).lt.xlon0) &
+       xpoint1(numpoint)=xpoint1(numpoint)+360.
+  if (xpoint1(numpoint).gt.xlon0+(nxmin1)*dx) &
+       xpoint1(numpoint)=xpoint1(numpoint)-360.
+  if (xpoint2(numpoint).lt.xlon0) &
+       xpoint2(numpoint)=xpoint2(numpoint)+360.
+  if (xpoint2(numpoint).gt.xlon0+(nxmin1)*dx) &
+       xpoint2(numpoint)=xpoint2(numpoint)-360.
+
+  ! Determine relative beginning and ending times of particle release
+  !******************************************************************
+
+  jul1=juldate(id1,it1)
+  jul2=juldate(id2,it2)
+  julm=(jul1+jul2)/2.
+  if (jul1.gt.jul2) then
+    write(*,*) 'FLEXPART MODEL ERROR'
+    write(*,*) 'Release stops before it begins.'
+    write(*,*) 'Make changes to file RELEASES.'
+    stop
+  endif
+  if (mdomainfill.eq.0) then   ! no domain filling
+    if (ldirect.eq.1) then
+      if (((jul1.lt.bdate).or.(jul2.gt.edate)).and.(ipin.eq.0)) then
+        write(*,*) 'FLEXPART MODEL ERROR'
+        write(*,*) 'Release starts before simulation begins or ends'
+        write(*,*) 'after simulation stops.'
+        write(*,*) 'Make files COMMAND and RELEASES consistent.'
+        stop
+      endif
+      if (npart(numpoint).gt.num_min_discrete) then
+        ireleasestart(numpoint)=int((jul1-bdate)*86400.)
+        ireleaseend(numpoint)=int((jul2-bdate)*86400.)
+      else
+        ireleasestart(numpoint)=int((julm-bdate)*86400.)
+        ireleaseend(numpoint)=int((julm-bdate)*86400.)
+      endif
+    else if (ldirect.eq.-1) then
+      if (((jul1.lt.edate).or.(jul2.gt.bdate)).and.(ipin.eq.0)) then
+        write(*,*) 'FLEXPART MODEL ERROR'
+        write(*,*) 'Release starts before simulation begins or ends'
+        write(*,*) 'after simulation stops.'
+        write(*,*) 'Make files COMMAND and RELEASES consistent.'
+        stop
+      endif
+      if (npart(numpoint).gt.num_min_discrete) then
+        ireleasestart(numpoint)=int((jul1-bdate)*86400.)
+        ireleaseend(numpoint)=int((jul2-bdate)*86400.)
+      else
+        ireleasestart(numpoint)=int((julm-bdate)*86400.)
+        ireleaseend(numpoint)=int((julm-bdate)*86400.)
+      endif
+    endif
+  endif
+
+
+  ! Determine the release rate (particles per second) and total number
+  ! of particles released during the simulation
+  !*******************************************************************
+
+  if (ireleasestart(numpoint).ne.ireleaseend(numpoint)) then
+    releaserate=releaserate+real(npart(numpoint))/ &
+         real(ireleaseend(numpoint)-ireleasestart(numpoint))
+  else
+    releaserate=99999999
+  endif
+  numpartmax=numpartmax+npart(numpoint)
+  goto 101
+
+250 close(unitreleases)
+
+  if (nmlout.and.lroot) then
+    close(unitreleasesout)
+  endif
+
+  !if (lroot) write (*,*) 'Particles allocated (maxpart)  : ',maxpart
+  if (lroot) write (*,*) 'Particles released (numpartmax): ',numpartmax
+  numpoint=numpoint-1
+
+  if (ioutputforeachrelease.eq.1) then
+    maxpointspec_act=numpoint
+  else
+    maxpointspec_act=1
+  endif
+
+  ! Disable settling if more than 1 species at any release point
+  ! or if MQUASILAG and more than one species
+  !*************************************************************
+
+  if (mquasilag.ne.0) then
+    if (nspec.gt.1) lsettling=.false.
+  else
+    do irel=1,numpoint
+      nsettle=0
+      do ispc=1,nspec
+        if (xmass(irel,ispc).gt.eps2) nsettle=nsettle+1
+      end do
+      if (nsettle.gt.1) lsettling=.false.
+    end do
+  end if
+
+  if (lroot) then
+    if (.not.lsettling) then
+      write(*,*) 'WARNING: more than 1 species per release point, settling &
+           &disabled'
+    end if
+  end if
+
+  ! Check, whether the total number of particles may exceed totally allowed
+  ! number of particles at some time during the simulation
+  !************************************************************************
+
+  ! if (releaserate.gt. &
+  !      0.99*real(maxpart)/real(lage(nageclass))) then
+  !   if (numpartmax.gt.maxpart.and.lroot) then
+  !     write(*,*) '#####################################################'
+  !     write(*,*) '#### FLEXPART MODEL SUBROUTINE READRELEASES:     ####'
+  !     write(*,*) '####                                             ####'
+  !     write(*,*) '####WARNING - TOTAL NUMBER OF PARTICLES SPECIFIED####'
+  !     write(*,*) '#### IN FILE "RELEASES" MAY AT SOME POINT DURING ####'
+  !     write(*,*) '#### THE SIMULATION EXCEED THE MAXIMUM ALLOWED   ####'
+  !     write(*,*) '#### NUMBER (MAXPART).IF RELEASES DO NOT OVERLAP,####'
+  !     write(*,*) '#### FLEXPART CAN POSSIBLY COMPLETE SUCCESSFULLY.####'
+  !     write(*,*) '#### HOWEVER, FLEXPART MAY HAVE TO STOP          ####'
+  !     write(*,*) '#### AT SOME TIME DURING THE SIMULATION. PLEASE  ####'
+  !     write(*,*) '#### MAKE SURE THAT YOUR SETTINGS ARE CORRECT.   ####'
+  !     write(*,*) '#####################################################'
+  !     write(*,*) 'Maximum release rate may be: ',releaserate, &
+  !          ' particles per second'
+  !     write(*,*) 'Maximum allowed release rate is: ', &
+  !          real(maxpart)/real(lage(nageclass)),' particles per second'
+  !     write(*,*) &
+  !          'Total number of particles released during the simulation is: ', &
+  !          numpartmax
+  !     write(*,*) 'Maximum allowed number of particles is: ',maxpart
+  !   endif
+  ! endif
+
+
+  if (lroot) then
+    write(*,FMT='(A,ES14.7)') ' Total mass released:', sum(xmass(1:numpoint,1:nspec))
+  end if
+
+  return
+
+994 write(*,*) '#####################################################'
+  write(*,*) '#### FLEXPART MODEL SUBROUTINE READRELEASES:     ####'
+  write(*,*) '####                                             ####'
+  write(*,*) '#### ERROR - MAXIMUM NUMBER OF EMITTED SPECIES IS####'
+  write(*,*) '#### TOO LARGE. PLEASE REDUCE NUMBER OF SPECIES. ####'
+  write(*,*) '#####################################################'
+  stop
+
+998 write(*,*) '#####################################################'
+  write(*,*) '#### FLEXPART MODEL SUBROUTINE READRELEASES:     ####'
+  write(*,*) '####                                             ####'
+  write(*,*) '#### FATAL ERROR - FILE "RELEASES" IS            ####'
+  write(*,*) '#### CORRUPT. PLEASE CHECK YOUR INPUTS FOR       ####'
+  write(*,*) '#### MISTAKES OR GET A NEW "RELEASES"-           ####'
+  write(*,*) '#### FILE ...                                    ####'
+  write(*,*) '#####################################################'
+  stop
+
+
+999 write(*,*) '#####################################################'
+  write(*,*) '   FLEXPART MODEL SUBROUTINE READRELEASES: '
+  write(*,*)
+  write(*,*) 'FATAL ERROR - FILE CONTAINING PARTICLE RELEASE POINTS'
+  write(*,*) 'POINTS IS NOT AVAILABLE OR YOU ARE NOT'
+  write(*,*) 'PERMITTED FOR ANY ACCESS'
+  write(*,*) '#####################################################'
+  stop
+
+1000 write(*,*) ' #### FLEXPART MODEL ERROR! FILE "RELEASES"    #### '
+  write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY       #### '
+  write(*,'(a)') path(2)(1:length(2))
+  stop
+end subroutine readreleases
diff --git a/src/rea_readspecies.f90 b/src/rea_readspecies.f90
new file mode 100644
index 0000000000000000000000000000000000000000..4657539e0936e3b449617b6ed35557ecf24e9c3c
--- /dev/null
+++ b/src/rea_readspecies.f90
@@ -0,0 +1,504 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine readspecies(id_spec,pos_spec)
+
+  !*****************************************************************************
+  !                                                                            *
+  !     This routine reads names and physical constants of chemical species/   *
+  !     radionuclides given in the parameter pos_spec                          *
+  !                                                                            *
+  !   Author: A. Stohl                                                         *
+  !                                                                            *
+  !   11 July 1996                                                             *
+  !                                                                            *
+  !   Changes:                                                                 *
+  !   N. Kristiansen, 31.01.2013: Including parameters for in-cloud scavenging *
+  !                                                                            *
+  !   HSO, 13 August 2013
+  !   added optional namelist input
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! decaytime(maxtable)   half time for radiological decay                     *
+  ! specname(maxtable)    names of chemical species, radionuclides             *
+  ! weta_gas, wetb_gas    Parameters for below-cloud scavenging of gasses      *
+  ! crain_aero,csnow_aero Parameters for below-cloud scavenging of aerosols    *
+  ! ccn_aero,in_aero      Parameters for in-cloud scavenging of aerosols       *
+  ! ohcconst              OH reaction rate constant C                          *
+  ! ohdconst              OH reaction rate constant D                          *
+  ! ohnconst              OH reaction rate constant n                          *
+  ! id_spec               SPECIES number as referenced in RELEASE file         *
+  ! id_pos                position where SPECIES data shall be stored          *
+  ! ni                    Number of diameter classes of particles              *                                                              *
+  ! Constants:                                                                 *
+  !                                                                            *
+  !*****************************************************************************
+
+  implicit none
+
+  integer :: i, pos_spec,j
+  integer :: idow,ihour,id_spec
+  character(len=3) :: aspecnumb
+  logical :: spec_found
+
+  character(len=16) :: pspecies
+  real :: pdecay, pweta_gas, pwetb_gas, preldiff, phenry, pf0, pdensity, pdquer
+  real :: pdsigma, pdryvel, pweightmolar, pohcconst, pohdconst, pohnconst
+  real :: pcrain_aero, pcsnow_aero, pccn_aero, pin_aero
+  real :: parea_dow(7), parea_hour(24), ppoint_dow(7), ppoint_hour(24)
+  integer :: pndia
+  integer :: ios
+  integer :: pshape,porient
+  ! Daria Tatsii: species shape properties
+  real ::pla,pia,psa,f,e,paspectratio
+  real :: la(maxspec),ia(maxspec),sa(maxspec) ! Axes
+
+  ! declare namelist
+  namelist /species_params/ &
+       pspecies, pdecay, pweta_gas, pwetb_gas, &
+       pcrain_aero, pcsnow_aero, pccn_aero, pin_aero, &
+       preldiff, phenry, pf0, pdensity, pdquer, &
+       pdsigma, pndia, pdryvel, pweightmolar, pohcconst, pohdconst, pohnconst, &
+       parea_dow, parea_hour, ppoint_dow, ppoint_hour, &
+       pshape, paspectratio, pla, pia, psa, porient
+
+  pspecies="" ! read failure indicator value
+  pdecay=-999.9
+  pweta_gas=-9.9E-09
+  pwetb_gas=0.0
+  pcrain_aero=-9.9E-09
+  pcsnow_aero=-9.9E-09
+  pccn_aero=-9.9E-09
+  pin_aero=-9.9E-09
+  preldiff=-9.9
+  phenry=0.0
+  pf0=0.0
+  pdensity=-9.9E09
+  pdquer=0.0
+  pdsigma=0.0
+  pndia=1
+  pdryvel=-9.99
+  pohcconst=-9.99
+  pohdconst=-9.9E-09
+  pohnconst=2.0
+  pweightmolar=-999.9
+  parea_dow=-999.9
+  parea_hour=-999.9
+  ppoint_dow=-999.9
+  ppoint_hour=-999.9
+  pshape=0 ! 0 for sphere, 1 for other shapes
+  paspectratio=-1.
+  pla=-1. ! longest axis in micrometer
+  pia=-1. ! Intermediate axis
+  psa=-1. ! Smallest axis
+  porient=0 ! 0 for horizontal, 1 for random
+
+
+  do j=1,24           ! initialize everything to no variation
+    parea_hour(j)=1.
+    ppoint_hour(j)=1.
+    area_hour(pos_spec,j)=1.
+    point_hour(pos_spec,j)=1.
+  end do
+  do j=1,7
+    parea_dow(j)=1.
+    ppoint_dow(j)=1.
+    area_dow(pos_spec,j)=1.
+    point_dow(pos_spec,j)=1.
+  end do
+
+  ! Open the SPECIES file and read species names and properties
+  !************************************************************
+  specnum(pos_spec)=id_spec
+  write(aspecnumb,'(i3.3)') specnum(pos_spec)
+  open(unitspecies,file=path(1)(1:length(1))//'SPECIES/SPECIES_'//aspecnumb, &
+    status='old',form='formatted',err=998)
+  !write(*,*) 'reading SPECIES',specnum(pos_spec)
+
+  ASSSPEC=.FALSE.
+
+  ! try namelist input
+  read(unitspecies,species_params,iostat=ios)
+  close(unitspecies)
+
+  if ((len(trim(pspecies)).eq.0).or. ios.ne.0) then ! no namelist found
+    if (lroot) write(*,*) "SPECIES file not in NAMELIST format, attempting to &
+         &read as fixed format"
+
+    ios=1
+
+    open(unitspecies,file=path(1)(1:length(1))//'SPECIES/SPECIES_'//aspecnumb, &
+      status='old',err=998)
+
+    do i=1,6
+      read(unitspecies,*)
+    end do
+
+    read(unitspecies,'(a10)',end=22) species(pos_spec)
+  !  write(*,*) species(pos_spec)
+    read(unitspecies,'(f18.1)',end=22) decay(pos_spec)
+  !  write(*,*) decay(pos_spec)
+    read(unitspecies,'(e18.1)',end=22) weta_gas(pos_spec)
+  !  write(*,*) weta_gas(pos_spec)
+    read(unitspecies,'(f18.2)',end=22) wetb_gas(pos_spec)
+  !  write(*,*) wetb_gas(pos_spec)
+    read(unitspecies,'(e18.1)',end=22) crain_aero(pos_spec)
+  !  write(*,*) crain_aero(pos_spec)
+    read(unitspecies,'(f18.2)',end=22) csnow_aero(pos_spec)
+  !  write(*,*) csnow_aero(pos_spec)
+  !*** NIK 31.01.2013: including in-cloud scavening parameters
+    read(unitspecies,'(e18.1)',end=22) ccn_aero(pos_spec)
+  !  write(*,*) ccn_aero(pos_spec)
+    read(unitspecies,'(f18.2)',end=22) in_aero(pos_spec)
+  !  write(*,*) in_aero(pos_spec)
+    read(unitspecies,'(f18.1)',end=22) reldiff(pos_spec)
+  !  write(*,*) reldiff(pos_spec)
+    read(unitspecies,'(e18.1)',end=22) henry(pos_spec)
+  !  write(*,*) henry(pos_spec)
+    read(unitspecies,'(f18.1)',end=22) f0(pos_spec)
+  !  write(*,*) f0(pos_spec)
+    read(unitspecies,'(e18.1)',end=22) density(pos_spec)
+  !  write(*,*) density(pos_spec)
+    read(unitspecies,'(e18.1)',end=22) dquer(pos_spec)
+  !  write(*,*) 'dquer(pos_spec):', dquer(pos_spec)
+    read(unitspecies,'(e18.1)',end=22) dsigma(pos_spec)
+  !  write(*,*) dsigma(pos_spec)
+    read(unitspecies,'(i16)',end=22) ndia(pos_spec)
+    ! write(*,*) ndia(pos_spec)
+    read(unitspecies,'(f18.2)',end=22) dryvel(pos_spec)
+  !  write(*,*) dryvel(pos_spec)
+    read(unitspecies,'(f18.2)',end=22) weightmolar(pos_spec)
+  !  write(*,*) weightmolar(pos_spec)
+    read(unitspecies,'(e18.2)',end=22) ohcconst(pos_spec)
+  !  write(*,*) ohcconst(pos_spec)
+    read(unitspecies,'(f8.2)',end=22) ohdconst(pos_spec)
+  !  write(*,*) ohdconst(pos_spec)
+    read(unitspecies,'(f8.2)',end=22) ohnconst(pos_spec)
+  !  write(*,*) ohnconst(pos_spec)
+
+  ! Read in daily and day-of-week variation of emissions, if available
+  !*******************************************************************
+
+    read(unitspecies,*,end=22)
+    do j=1,24     ! 24 hours, starting with 0-1 local time
+      read(unitspecies,*) ihour,area_hour(pos_spec,j),point_hour(pos_spec,j)
+    end do
+    read(unitspecies,*)
+    do j=1,7      ! 7 days of the week, starting with Monday
+      read(unitspecies,*) idow,area_dow(pos_spec,j),point_dow(pos_spec,j)
+    end do
+
+    pspecies=species(pos_spec)
+    pdecay=decay(pos_spec)
+    pweta_gas=weta_gas(pos_spec)
+    pwetb_gas=wetb_gas(pos_spec)
+    pcrain_aero=crain_aero(pos_spec)
+    pcsnow_aero=csnow_aero(pos_spec)
+    pccn_aero=ccn_aero(pos_spec)
+    pin_aero=in_aero(pos_spec)
+    preldiff=reldiff(pos_spec)
+    phenry=henry(pos_spec)
+    pf0=f0(pos_spec)
+    pdensity=density(pos_spec)
+    pdquer=dquer(pos_spec)
+    pdsigma=dsigma(pos_spec)
+    pndia=ndia(pos_spec)
+    pdryvel=dryvel(pos_spec)
+    pweightmolar=weightmolar(pos_spec)
+    pohcconst=ohcconst(pos_spec)
+    pohdconst=ohdconst(pos_spec)
+    pohnconst=ohnconst(pos_spec)
+
+
+    do j=1,24     ! 24 hours, starting with 0-1 local time
+      parea_hour(j)=area_hour(pos_spec,j)
+      ppoint_hour(j)=point_hour(pos_spec,j)
+    end do
+    do j=1,7      ! 7 days of the week, starting with Monday
+      parea_dow(j)=area_dow(pos_spec,j)
+      ppoint_dow(j)=point_dow(pos_spec,j)
+    end do
+
+  else ! namelist available
+
+    species(pos_spec)=pspecies
+    decay(pos_spec)=pdecay
+    weta_gas(pos_spec)=pweta_gas
+    wetb_gas(pos_spec)=pwetb_gas
+    crain_aero(pos_spec)=pcrain_aero
+    csnow_aero(pos_spec)=pcsnow_aero
+    ccn_aero(pos_spec)=pccn_aero
+    in_aero(pos_spec)=pin_aero
+    reldiff(pos_spec)=preldiff
+    henry(pos_spec)=phenry
+    f0(pos_spec)=pf0
+    density(pos_spec)=pdensity
+    dquer(pos_spec)=pdquer
+    dsigma(pos_spec)=pdsigma
+    ndia(pos_spec)=pndia
+    dryvel(pos_spec)=pdryvel
+    weightmolar(pos_spec)=pweightmolar
+    ohcconst(pos_spec)=pohcconst
+    ohdconst(pos_spec)=pohdconst
+    ohnconst(pos_spec)=pohnconst
+    shape(pos_spec)=pshape
+    orient(pos_spec)=porient
+
+
+    ! Daria Tatsii 2023: compute particle shape dimensions
+    if (shape(pos_spec).ge.1) then ! Compute shape according to given axes
+      select case (shape(pos_spec))
+        case (1)
+          write(*,*) "Particle shape USER-DEFINED for particle", id_spec
+          if ((psa.le.0.0).or.(pia.le.0.0).or.(pla.le.0.0)) then
+            write(*,*) "#### ERROR: Shape=1 (user-defined) is chosen, &
+              &but no valid axes are provided."
+            write(*,*) "#### SPECIES file requires SA, IA, and LA parameter&
+              &greater than zero."
+            stop
+          endif
+          write(*,*) "SA,IA,LA:",psa,pia,pla
+        case (2) ! Cylinders (fibers) !
+          if (paspectratio.le.0.0) then
+            write(*,*) "#### ERROR: Shape=2 cylinder is chosen, but no valid apect ratio is provided."
+            write(*,*) "#### SPECIES file requires ASPECTRATIO parameter greater than zero."
+            stop
+          endif
+          psa=(((dquer(pos_spec)**3.0)*2.0)/ &
+                  (3.0*paspectratio))**(1.0/3.0)
+          pia=psa
+          pla=psa*paspectratio
+          write(*,*) "Particle shape CYLINDER for particle", id_spec
+          write(*,*) "SA,IA,LA:",psa,pia,pla
+        case (3) ! Cubes !
+          write(*,*) "Particle shape CUBE for particle", id_spec
+          psa=((dquer(pos_spec)**3)*pi/6.0)**(1.0/3.0)
+          pia=(2.0**0.5)*psa
+          pla=(3.0**0.5)*psa
+          if ((psa.le.0.0).or.(pia.le.0.0).or.(pla.le.0.0)) then
+            write(*,*) "#### ERROR: Shape=3 (user-defined) is chosen, but no valid axes are provided."
+            write(*,*) "#### SPECIES file requires SA, IA, and LA parameter greater than zero."
+            stop
+          endif
+          write(*,*) "SA,IA,LA:",psa,pia,pla
+        case (4) ! Tetrahedrons !
+          write(*,*) "Particle shape TETRAHEDRON for particle", id_spec
+          pla=((dquer(pos_spec)**3)*pi*2**(0.5))**(1.0/3.0)
+          pia=pla*((3.0/4.0)**(0.5))
+          psa=pla*((2.0/3.0)**(0.5))
+          if ((psa.le.0.0).or.(pia.le.0.0).or.(pla.le.0.0)) then
+            write(*,*) "#### ERROR: Shape=4 (user-defined) is chosen, but no valid axes are provided."
+            write(*,*) "#### SPECIES file requires SA, IA, and LA parameter greater than zero."
+            stop
+          endif
+          write(*,*) "SA,IA,LA:",psa,pia,pla
+        case (5) ! Octahedrons !
+          write(*,*) "Particle shape OCTAHEDRON for particle", id_spec
+          psa=dquer(pos_spec)*(pi/(2.0*2.0**(0.5)))**3
+          pia=psa
+          pla=psa*(2.0**(0.5))
+          if ((psa.le.0.0).or.(pia.le.0.0).or.(pla.le.0.0)) then
+            write(*,*) "#### ERROR: Shape=5 (user-defined) is chosen, but no valid axes are provided."
+            write(*,*) "#### SPECIES file requires SA, IA, and LA parameter greater than zero."
+            stop
+          endif
+          write(*,*) "SA,IA,LA:",psa,pia,pla
+        case (6) ! Ellipsoids !
+          write(*,*) "Particle shape ELLIPSOID for particle", id_spec
+          psa=dquer(pos_spec)/(2.0**(1.0/3.0))
+          pia=psa
+          pla=2*pia
+          if ((psa.le.0.0).or.(pia.le.0.0).or.(pla.le.0.0)) then
+            write(*,*) "#### ERROR: Shape=6 (user-defined) is chosen, but no valid axes are provided."
+            write(*,*) "#### SPECIES file requires SA, IA, and LA parameter greater than zero."
+            stop
+          endif
+          write(*,*) "SA,IA,LA:",psa,pia,pla
+      end select
+
+      ! When using the shape option, dquer is the sphere equivalent diameter
+      f=psa/pia
+      e=pia/pla
+      Fn(pos_spec)=f*f*e*((dquer(pos_spec))**3)/(psa*pia*pla) ! Newton's regime
+      Fs(pos_spec)=f*e**(1.3)*(dquer(pos_spec)**3/(psa*pia*pla)) ! Stokes' regime
+    else ! Spheres
+      write(*,*) "Particle shape SPHERE for particle", id_spec
+    endif
+
+    do j=1,24     ! 24 hours, starting with 0-1 local time
+      area_hour(pos_spec,j)=parea_hour(j)
+      point_hour(pos_spec,j)=ppoint_hour(j)
+    end do
+    do j=1,7      ! 7 days of the week, starting with Monday
+      area_dow(pos_spec,j)=parea_dow(j)
+      point_dow(pos_spec,j)=ppoint_dow(j)
+    end do
+  endif
+
+  i=pos_spec
+
+  !NIK 16.02.2015
+  ! Check scavenging parameters given in SPECIES file
+
+  if (lroot) then
+  ! ZHG 2016.04.07 Start of changes
+    write(*,*) ' '
+    if (dquer(pos_spec) .gt.0)  write(*,'(a,i3,a,a,a)')       ' SPECIES: ', &
+         id_spec,'  ', species(pos_spec),'  (AEROSOL) '
+    if (dquer(pos_spec) .le.0)  write(*,'(a,i3,a,a,a)')       ' SPECIES: ', &
+         id_spec,'  ', species(pos_spec),'  (GAS) '
+
+  ! Particles
+  !**********
+    if (dquer(pos_spec).gt.0) then
+      if (ccn_aero(pos_spec) .gt. 0) then
+        write(*,'(a,f5.2)') '  Particle CCN  efficiency (CCNeff):', ccn_aero(pos_spec)
+      else
+        write(*,'(a)')      '  Particle CCN  efficiency (CCNeff):   OFF'
+      endif
+      if (in_aero(pos_spec) .gt. 0) then
+        write(*,'(a,f5.2)') '  Particle  IN  efficiency (INeff) :', in_aero(pos_spec)
+      else
+        write(*,'(a)')      '  Particle  IN  efficiency (INeff) :   OFF'
+      endif
+      if (crain_aero(pos_spec) .gt. 0) then
+        write(*,'(a,f5.2)') '  Particle Rain efficiency (Crain) :', crain_aero(pos_spec)
+      else
+        write(*,'(a)')      '  Particle Rain efficiency (Crain) :   OFF'
+      endif
+      if (csnow_aero(pos_spec) .gt. 0) then
+        write(*,'(a,f5.2)') '  Particle Snow efficiency (Csnow) :', csnow_aero(pos_spec)
+      else
+        write(*,'(a)')      '  Particle Snow efficiency (Csnow) :   OFF'
+      end if
+      if (density(pos_spec) .gt. 0) then
+        write(*,'(a)') '  Dry deposition is turned         :   ON'
+        if (reldiff(pos_spec).gt.0) then
+           stop 'density>0 (SPECIES is a particle) implies reldiff <=0  '
+        endif
+      else
+        if (reldiff(pos_spec).le.0) then
+           stop 'density<=0 (SPECIES is a gas) implies reldiff >0  '
+        endif
+        write(*,'(a)') '  Dry deposition is (density<0)    :   OFF'
+      end if
+      if (crain_aero(pos_spec).gt.10.0 .or. csnow_aero(pos_spec).gt.10.0 .or. &
+           &ccn_aero(pos_spec).gt.1.0 .or. in_aero(pos_spec).gt.1.0) then
+        write(*,*) '*******************************************'
+        write(*,*) ' WARNING: Particle Scavenging parameter likely out of range '
+        write(*,*) '       Likely   range for Crain    0.0-10'
+        write(*,*) '       Likely   range for Csnow    0.0-10'
+        write(*,*) '       Physical range for CCNeff   0.0-1'
+        write(*,*) '       Physical range for INeff    0.0-1'
+        write(*,*) '*******************************************'
+      end if
+    else
+  ! Gas
+  !****
+      if (weta_gas(pos_spec) .gt. 0 .and. wetb_gas(pos_spec).gt.0) then
+        write(*,*)          '  Wet removal for gases      is turned: ON'
+        write(*,*)          '  Gas below-cloud scavenging parameter A  ', &
+             &weta_gas(pos_spec)
+        write(*,'(a,f5.2)') '  Gas below-cloud scavenging parameter B  ', &
+             &wetb_gas(pos_spec)
+      else
+        write(*,*)          '  Wet removal for gases      is turned: OFF '
+      end if
+      if (reldiff(i).gt.0.) then
+        write(*,*)          '  Dry deposition for gases   is turned: ON '
+      else
+        write(*,*)          '  Dry deposition for gases   is turned: OFF '
+      end if
+      if (weta_gas(pos_spec).gt.0.) then !if wet deposition is turned on
+        if (weta_gas(pos_spec).gt.1E-04 .or. weta_gas(pos_spec).lt.1E-09 .or. &
+             &wetb_gas(pos_spec).gt.0.8 .or. wetb_gas(pos_spec).lt.0.4) then
+          write(*,*) '*******************************************'
+          write(*,*) ' WARNING: Gas below-cloud scavengig is out of likely range'
+          write(*,*) '          Likely range for A is 1E-04 to 1E-08'
+          write(*,*) '          Likely range for B is 0.60  to 0.80 '
+          write(*,*) '*******************************************'
+        end if
+      endif
+
+      if (((weta_gas(pos_spec).gt.0).or.(wetb_gas(pos_spec).gt.0)).and.&
+           &(henry(pos_spec).le.0)) then
+        if (dquer(pos_spec).le.0) goto 996 ! no particle, no henry set
+      endif
+    end if
+  end if
+
+  if (ndia(pos_spec).gt.maxndia) then
+    write(*,*) 'NDIA in SPECIES file', pos_spec, 'set to', ndia(pos_spec), 'larger than maxndia', &
+      maxndia, 'set in par_mod.f90'
+  endif
+  !  if (dsigma(i).eq.0.) dsigma(i)=1.0001   ! avoid floating exception
+  if (dquer(i).gt.0 .and. dsigma(i).le.1.) then !dsigma(i)=1.0001   ! avoid floating exception
+    !write(*,*) '#### FLEXPART MODEL ERROR!                      ####'
+    write(*,*) '#### FLEXPART MODEL WARNING                     ####'
+    write(*,*) '#### in SPECIES_',aspecnumb, '                             ####'
+    write(*,*) '#### from v10.4 dsigma has to be larger than 1  ####'
+    write(*,*) '#### to adapt older SPECIES files,              ####'
+    write(*,*) '#### if dsigma was < 1                          ####'
+    write(*,*) '#### use the reciprocal of the old dsigma       ####'
+    if (.not.debug_mode) then
+       stop
+    else
+       write(*,*) 'debug mode: continue'
+    endif
+  endif
+
+  if ((reldiff(i).gt.0.).and.(density(i).gt.0.)) then
+    write(*,*) '#### FLEXPART MODEL ERROR! FILE "SPECIES"    ####'
+    write(*,*) '#### IS CORRUPT. SPECIES CANNOT BE BOTH      ####'
+    write(*,*) '#### PARTICLE AND GAS.                       ####'
+    write(*,*) '#### SPECIES NUMBER',aspecnumb
+    stop
+  endif
+20 continue
+
+
+22 close(unitspecies)
+
+! namelist output if requested
+  if (nmlout.and.lroot) then
+    open(unitspecies,file=path(2)(1:length(2))//'SPECIES_'//aspecnumb//'.namelist',access='append',status='replace',err=1000)
+    write(unitspecies,nml=species_params)
+    close(unitspecies)
+  endif
+
+  return
+
+996 write(*,*) '#####################################################'
+  write(*,*) '#### FLEXPART MODEL ERROR!                      #### '
+  write(*,*) '#### WET DEPOSITION SWITCHED ON, BUT NO HENRYS  #### '
+  write(*,*) '#### CONSTANT IS SET                            ####'
+  write(*,*) '#### PLEASE MODIFY SPECIES DESCR. FILE!        #### '
+  write(*,*) '#####################################################'
+  stop
+
+
+997 write(*,*) '#####################################################'
+  write(*,*) '#### FLEXPART MODEL ERROR!                      #### '
+  write(*,*) '#### THE ASSSOCIATED SPECIES HAS TO BE DEFINED  #### '
+  write(*,*) '#### BEFORE THE ONE WHICH POINTS AT IT          #### '
+  write(*,*) '#### PLEASE CHANGE ORDER IN RELEASES OR ADD     #### '
+  write(*,*) '#### THE ASSOCIATED SPECIES IN RELEASES         #### '
+  write(*,*) '#####################################################'
+  stop
+
+
+998 write(*,*) '#####################################################'
+  write(*,*) '#### FLEXPART MODEL ERROR!                      #### '
+  write(*,*) '#### THE SPECIES FILE FOR SPECIES ', id_spec
+  write(*,*) '#### CANNOT BE FOUND: CREATE FILE'
+  write(*,*) '#### ',path(1)(1:length(1)),'SPECIES/SPECIES_',aspecnumb
+  write(*,*) '#####################################################'
+  stop
+
+1000 write(*,*) ' #### FLEXPART MODEL ERROR! FILE "SPECIES_',aspecnumb,'.namelist'
+  write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY       #### '
+  write(*,'(a)') path(2)(1:length(2))
+  stop
+end subroutine readspecies
diff --git a/src/rea_skplin.f90 b/src/rea_skplin.f90
new file mode 100644
index 0000000000000000000000000000000000000000..4ffd1b4c8b3620b4c7ec5ef1ee4c85c60b8c4144
--- /dev/null
+++ b/src/rea_skplin.f90
@@ -0,0 +1,31 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine skplin(nlines,iunit)
+  !                    i      i
+  !*****************************************************************************
+  !                                                                            *
+  !   This routine reads nlines from unit iunit and discards them              *
+  !                                                                            *
+  !   Authors: Petra Seibert                                                   *
+  !                                                                            *
+  !   31 Dec 1998                                                              *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  ! iunit   unit number from which lines are to be skipped                     *
+  ! nlines  number of lines to be skipped                                      *
+  !                                                                            *
+  !*****************************************************************************
+
+  implicit none
+
+  integer :: i,iunit, nlines
+
+  do i=1,nlines
+    read(iunit,*)
+  end do
+
+end subroutine skplin
diff --git a/src/readoptions_mod.f90 b/src/readoptions_mod.f90
index e47a71d2878ed5fb902bce20be782b861a444edf..8331d1648fdaa9d0477968ddf2fbe69aeb4f14e9 100644
--- a/src/readoptions_mod.f90
+++ b/src/readoptions_mod.f90
@@ -19,3355 +19,33 @@ module readoptions_mod
 
 contains
 
-subroutine readageclasses
+#include "rea_readageclasses.f90"
 
-  !*****************************************************************************
-  !                                                                            *
-  !     This routine reads the age classes to be used for the current model    *
-  !     run.                                                                   *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !     20 March 2000                                                          *
-  !     HSO, 1 July 2014                                                       *
-  !     Added optional namelist input                                          *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  !                                                                            *
-  ! Constants:                                                                 *
-  !                                                                            *
-  !*****************************************************************************
+#include "rea_readavailable.f90"
 
-  implicit none
-
-  integer :: i
-
-  ! namelist help variables
-  integer :: ios
-
-  ! namelist declaration
-  namelist /ageclass/ &
-    nageclass, &
-    lage
-
-  ! If age spectra calculation is switched off, set number of age classes
-  ! to 1 and maximum age to a large number
-  !**********************************************************************
-
-  if (lagespectra.ne.1) then
-    nageclass=1
-    lage(nageclass)=999999999
-    return
-  endif
-
-  ! If age spectra claculation is switched on,
-  ! open the AGECLASSSES file and read user options
-  !************************************************
-
-  open(unitageclasses,file=path(1)(1:length(1))//'AGECLASSES', &
-    form='formatted',status='old',err=999)
-
-! try to read in as a namelist
-  nageclass=-1 ! preset to negative value to identify failed namelist input
-  read(unitageclasses,ageclass,iostat=ios)
-  close(unitageclasses)
-
-  if (nageclass.lt.0 .or. ios.ne.0) then
-    open(unitageclasses,file=path(1)(1:length(1))//'AGECLASSES', &
-      status='old',err=999)
-    do i=1,13
-      read(unitageclasses,*)
-    end do
-    read(unitageclasses,*) nageclass
-    read(unitageclasses,*) lage(1)
-    if (nageclass.ge.2) then
-      do i=2,nageclass
-        read(unitageclasses,*) lage(i)
-      end do
-    endif
-    close(unitageclasses)
-  endif
-
-  ! write ageclasses file in namelist format to output directory if requested
-!  if (nmlout.and.lroot) then
-  if (nmlout) then
-    open(unitageclasses,file=path(2)(1:length(2))//'AGECLASSES.namelist', &
-      err=1000)
-    write(unitageclasses,nml=ageclass)
-    close(unitageclasses)
-  endif
-
-  if (nageclass.gt.maxageclass) then
-    write(*,*) ' #### FLEXPART MODEL ERROR! NUMBER OF AGE     #### '
-    write(*,*) ' #### CLASSES GREATER THAN MAXIMUM ALLOWED.   #### '
-    write(*,*) ' #### CHANGE SETTINGS IN FILE AGECLASSES OR   #### '
-    write(*,*) ' #### RECOMPILE WITH LARGER MAXAGECLASS IN    #### '
-    write(*,*) ' #### FILE PAR_MOD.                        #### '
-    stop
-  endif
-
-  if (lage(1).le.0) then
-    write(*,*) ' #### FLEXPART MODEL ERROR! AGE OF FIRST      #### '
-    write(*,*) ' #### CLASS MUST BE GREATER THAN ZERO. CHANGE #### '
-    write(*,*) ' #### SETTINGS IN FILE AGECLASSES.            #### '
-    stop
-  endif
-
-  do i=2,nageclass
-    if (lage(i).le.lage(i-1)) then
-      write(*,*) ' #### FLEXPART MODEL ERROR! AGE CLASSES     #### '
-      write(*,*) ' #### MUST BE GIVEN IN TEMPORAL ORDER.      #### '
-      write(*,*) ' #### CHANGE SETTINGS IN FILE AGECLASSES.   #### '
-      stop
-    endif
-  end do
-
-  return
-
-999   write(*,*) ' #### FLEXPART MODEL ERROR! FILE "AGECLASSES" #### '
-  write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY       #### '
-  write(*,'(a)') path(1)(1:length(1))
-  stop
-
-1000  write(*,*) ' #### FLEXPART MODEL ERROR! FILE "AGECLASSES" #### '
-  write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY       #### '
-  write(*,'(a)') path(2)(1:length(2))
-  stop
-end subroutine readageclasses
-
-subroutine readavailable
-
-  !*****************************************************************************
-  !                                                                            *
-  !   This routine reads the dates and times for which windfields are          *
-  !   available.                                                               *
-  !                                                                            *
-  !     Authors: A. Stohl                                                      *
-  !                                                                            *
-  !     6 February 1994                                                        *
-  !     8 February 1999, Use of nested fields, A. Stohl                        *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! bdate                beginning date as Julian date                         *
-  ! beg                  beginning date for windfields                         *
-  ! endl                  ending date for windfields                            *
-  ! fname                filename of wind field, help variable                 *
-  ! ideltas [s]          duration of modelling period                          *
-  ! idiff                time difference between 2 wind fields                 *
-  ! idiffnorm            normal time difference between 2 wind fields          *
-  ! idiffmax [s]         maximum allowable time between 2 wind fields          *
-  ! jul                  julian date, help variable                            *
-  ! numbwf               actual number of wind fields                          *
-  ! wfname(maxwf)        file names of needed wind fields                      *
-  ! wfspec(maxwf)        file specifications of wind fields (e.g., if on disc) *
-  ! wftime(maxwf) [s]times of wind fields relative to beginning time           *
-  ! wfname1,wfspec1,wftime1 = same as above, but only local (help variables)   *
-  !                                                                            *
-  ! Constants:                                                                 *
-  ! maxwf                maximum number of wind fields                         *
-  ! unitavailab          unit connected to file AVAILABLE                      *
-  !                                                                            *
-  !*****************************************************************************
-
-  implicit none
-
-  integer :: i,idiff,ldat,ltim,wftime1(maxwf),numbwfn(maxnests),k
-  integer :: wftime1n(maxnests,maxwf),wftimen(maxnests,maxwf)
-  logical :: lwarntd=.true.
-  real(kind=dp) :: jul,beg,endl
-  character(len=255) :: fname,spec,wfname1(maxwf),wfspec1(maxwf)
-  character(len=255) :: wfname1n(maxnests,maxwf)
-  character(len=40) :: wfspec1n(maxnests,maxwf)
-
-
-  ! Windfields are only used, if they are within the modelling period.
-  ! However, 1 additional day at the beginning and at the end is used for
-  ! interpolation. -> Compute beginning and ending date for the windfields.
-  !************************************************************************
-
-  if (ideltas.gt.0) then         ! forward trajectories
-    beg=bdate-1._dp
-    endl=bdate+real(ideltas,kind=dp)/86400._dp+real(idiffmax,kind=dp)/ &
-         86400._dp
-  else                           ! backward trajectories
-    beg=bdate+real(ideltas,kind=dp)/86400._dp-real(idiffmax,kind=dp)/ &
-         86400._dp
-    endl=bdate+1._dp
-  endif
-
-  ! Open the wind field availability file and read available wind fields
-  ! within the modelling period.
-  !*********************************************************************
-
-  open(unitavailab,file=path(4)(1:length(4)),status='old', &
-       err=999)
-
-  do i=1,3
-    read(unitavailab,*)
-  end do
-
-  numbwf=0
-100   read(unitavailab,'(i8,1x,i6,2(6x,a255))',end=99) &
-           ldat,ltim,fname,spec
-    jul=juldate(ldat,ltim)
-    if ((jul.ge.beg).and.(jul.le.endl)) then
-      numbwf=numbwf+1
-      if (numbwf.gt.maxwf) then      ! check exceedance of dimension
-       write(*,*) 'Number of wind fields needed is too great.'
-       write(*,*) 'Reduce modelling period (file "COMMAND") or'
-       write(*,*) 'reduce number of wind fields (file "AVAILABLE").'
-       stop
-      endif
-
-      wfname1(numbwf)=fname(1:index(fname,' '))
-      wfspec1(numbwf)=spec
-      wftime1(numbwf)=nint((jul-bdate)*86400._dp)
-    endif
-    goto 100       ! next wind field
-
-99   continue
-
-  close(unitavailab)
-
-  ! Open the wind field availability file and read available wind fields
-  ! within the modelling period (nested grids)
-  !*********************************************************************
-
-  do k=1,numbnests
-  !print*,length(numpath+2*(k-1)+1),length(numpath+2*(k-1)+2),length(4),length(3)
-  !print*,path(numpath+2*(k-1)+2)(1:length(numpath+2*(k-1)+2))
-    open(unitavailab,file=path(numpath+2*(k-1)+2) &
-         (1:length(numpath+2*(k-1)+2)),status='old',err=998)
-
-    do i=1,3
-      read(unitavailab,*)
-    end do
-
-    numbwfn(k)=0
-700   read(unitavailab,'(i8,1x,i6,2(6x,a255))',end=699) ldat, &
-           ltim,fname,spec
-      jul=juldate(ldat,ltim)
-      if ((jul.ge.beg).and.(jul.le.endl)) then
-        numbwfn(k)=numbwfn(k)+1
-        if (numbwfn(k).gt.maxwf) then      ! check exceedance of dimension
-       write(*,*) 'Number of nested wind fields is too great.'
-       write(*,*) 'Reduce modelling period (file "COMMAND") or'
-       write(*,*) 'reduce number of wind fields (file "AVAILABLE").'
-          stop
-        endif
-
-        wfname1n(k,numbwfn(k))=fname
-        wfspec1n(k,numbwfn(k))=spec
-        wftime1n(k,numbwfn(k))=nint((jul-bdate)*86400._dp)
-      endif
-      goto 700       ! next wind field
-
-699   continue
-
-    close(unitavailab)
-  end do
-
-
-  ! Check wind field times of file AVAILABLE (expected to be in temporal order)
-  !****************************************************************************
-
-  if (numbwf.eq.0) then
-    write(*,*) ' #### FLEXPART MODEL ERROR! NO WIND FIELDS    #### '
-    write(*,*) ' #### AVAILABLE FOR SELECTED TIME PERIOD.     #### '
-    stop
-  endif
-
-  do i=2,numbwf
-    if (wftime1(i).le.wftime1(i-1)) then
-      write(*,*) 'FLEXPART ERROR: FILE AVAILABLE IS CORRUPT.'
-      write(*,*) 'THE WIND FIELDS ARE NOT IN TEMPORAL ORDER.'
-      write(*,*) 'PLEASE CHECK FIELD ',wfname1(i)
-      stop
-    endif
-  end do
-
-  ! Check wind field times of file AVAILABLE for the nested fields
-  ! (expected to be in temporal order)
-  !***************************************************************
-
-  do k=1,numbnests
-    if (numbwfn(k).eq.0) then
-      write(*,*) '#### FLEXPART MODEL ERROR! NO WIND FIELDS  ####'
-      write(*,*) '#### AVAILABLE FOR SELECTED TIME PERIOD.   ####'
-      stop
-    endif
-
-    do i=2,numbwfn(k)
-      if (wftime1n(k,i).le.wftime1n(k,i-1)) then
-      write(*,*) 'FLEXPART ERROR: FILE AVAILABLE IS CORRUPT. '
-      write(*,*) 'THE NESTED WIND FIELDS ARE NOT IN TEMPORAL ORDER.'
-      write(*,*) 'PLEASE CHECK FIELD ',wfname1n(k,i)
-      write(*,*) 'AT NESTING LEVEL ',k
-      stop
-      endif
-    end do
-
-  end do
-
-
-  ! For backward trajectories, reverse the order of the windfields
-  !***************************************************************
-
-  if (ideltas.ge.0) then
-    do i=1,numbwf
-      wfname(i)=wfname1(i)
-      wfspec(i)=wfspec1(i)
-      wftime(i)=wftime1(i)
-    end do
-    do k=1,numbnests
-      do i=1,numbwfn(k)
-        wfnamen(k,i)=wfname1n(k,i)
-        wfspecn(k,i)=wfspec1n(k,i)
-        wftimen(k,i)=wftime1n(k,i)
-      end do
-    end do
-  else
-    do i=1,numbwf
-      wfname(numbwf-i+1)=wfname1(i)
-      wfspec(numbwf-i+1)=wfspec1(i)
-      wftime(numbwf-i+1)=wftime1(i)
-    end do
-    do k=1,numbnests
-      do i=1,numbwfn(k)
-        wfnamen(k,numbwfn(k)-i+1)=wfname1n(k,i)
-        wfspecn(k,numbwfn(k)-i+1)=wfspec1n(k,i)
-        wftimen(k,numbwfn(k)-i+1)=wftime1n(k,i)
-      end do
-    end do
-  endif
-
-  ! Check the time difference between the wind fields. If it is big,
-  ! write a warning message. If it is too big, terminate the trajectory.
-  !*********************************************************************
-
-  do i=2,numbwf
-    idiff=abs(wftime(i)-wftime(i-1))
-    if (idiff.gt.idiffmax.and.lroot) then
-      write(*,*) 'FLEXPART WARNING: TIME DIFFERENCE BETWEEN TWO'
-      write(*,*) 'WIND FIELDS IS TOO BIG FOR TRANSPORT CALCULATION.&
-           &'
-      write(*,*) 'THEREFORE, TRAJECTORIES HAVE TO BE SKIPPED.'
-    else if (idiff.gt.idiffnorm.and.lroot.and.lwarntd) then
-      write(*,*) 'FLEXPART WARNING: TIME DIFFERENCE BETWEEN TWO'
-      write(*,*) 'WIND FIELDS IS BIG. THIS MAY CAUSE A DEGRADATION'
-      write(*,*) 'OF SIMULATION QUALITY.'
-      lwarntd=.false. ! only issue this warning once
-    endif
-  end do
-
-  do k=1,numbnests
-    if (numbwfn(k).ne.numbwf) then
-      write(*,*) 'FLEXPART ERROR: THE AVAILABLE FILES FOR THE'
-      write(*,*) 'NESTED WIND FIELDS ARE NOT CONSISTENT WITH'
-      write(*,*) 'THE AVAILABLE FILE OF THE MOTHER DOMAIN.  '
-      write(*,*) 'ERROR AT NEST LEVEL: ',k
-      stop
-    endif
-    do i=1,numbwf
-      if (wftimen(k,i).ne.wftime(i)) then
-        write(*,*) 'FLEXPART ERROR: THE AVAILABLE FILES FOR THE'
-        write(*,*) 'NESTED WIND FIELDS ARE NOT CONSISTENT WITH'
-        write(*,*) 'THE AVAILABLE FILE OF THE MOTHER DOMAIN.  '
-        write(*,*) 'ERROR AT NEST LEVEL: ',k
-        stop
-      endif
-    end do
-  end do
-
-  ! Reset the times of the wind fields that are kept in memory to no time
-  !**********************************************************************
-
-  do i=1,2
-    memind(i)=i
-    memtime(i)=999999999
-  end do
-
-  return
-
-998   write(*,*) ' #### FLEXPART MODEL ERROR! AVAILABLE FILE   #### '
-  write(*,'(a)') '     '//path(numpath+2*(k-1)+2) &
-       (1:length(numpath+2*(k-1)+2))
-  write(*,*) ' #### CANNOT BE OPENED             #### '
-  stop
-
-999   write(*,*) ' #### FLEXPART MODEL ERROR! AVAILABLE FILE #### '
-  write(*,'(a)') '     '//path(4)(1:length(4))
-  write(*,*) ' #### CANNOT BE OPENED           #### '
-  stop
-end subroutine readavailable
-
-subroutine readcommand
-
-  !*****************************************************************************
-  !                                                                            *
-  !     This routine reads the user specifications for the current model run.  *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     18 May 1996                                                            *
-  !     HSO, 1 July 2014                                                       *
-  !     Added optional namelist input                                          *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! bdate                beginning date as Julian date                         *
-  ! ctl                  factor by which time step must be smaller than        *
-  !                      Lagrangian time scale                                 *
-  ! ibdate,ibtime        beginnning date and time (YYYYMMDD, HHMISS)           *
-  ! ideltas [s]          modelling period                                      *
-  ! iedate,ietime        ending date and time (YYYYMMDD, HHMISS)               *
-  ! ifine                reduction factor for vertical wind time step          *
-  ! outputforeachrel     for forward runs it is possible either to create      *
-  !                      one outputfield or several for each releasepoint      *
-  ! iflux                switch to turn on (1)/off (0) flux calculations       *
-  ! iout                 1 for conc. (residence time for backward runs) output,*
-  !                      2 for mixing ratio output, 3 both, 4 for plume        *
-  !                      trajectory output, 5 = options 1 and 4                *
-  ! ipin                 1 continue simulation with restart.bin file,          *
-  !                      2 continue simulaion with dumped particle data, 0 no  *
-  !                      3 use self-defined initial conditions in netcdf       *
-  !                      4 initial run using option 3, restart from restart.bin*
-  ! ipout                0 no particle dump, 1 every output time, 3 only at end*
-  ! ipoutfac             increase particle dump interval by factor (default 1) *
-  ! loutaver [s]         concentration output is an average over loutaver      *
-  !                      seconds                                               *
-  ! loutsample [s]       average is computed from samples taken every [s]      *
-  !                      seconds                                               *
-  ! loutstep [s]         time interval of concentration output                 *
-  ! lsynctime [s]        synchronisation time interval for all particles       *
-  ! lagespectra          switch to turn on (1)/off (0) calculation of age      *
-  !                      spectra                                               *
-  ! lconvection          value of either 0 and 1 indicating mixing by          *
-  !                      convection                                            *
-  !                      = 0 .. no convection                                  *
-  !                      + 1 .. parameterisation of mixing by subgrid-scale    *
-  !                              convection = on                               *
-  ! lsubgrid             switch to turn on (1)/off (0) subgrid topography      *
-  !                      parameterization                                      *
-  ! method               method used to compute the particle pseudovelocities  *
-  ! mdomainfill          1 use domain-filling option, 0 not, 2 use strat. O3   *
-  !                                                                            *
-  ! Constants:                                                                 *
-  ! unitcommand          unit connected to file COMMAND                        *
-  !                                                                            *
-  !*****************************************************************************
-
-  implicit none
-
-  character(len=50) :: line
-  logical :: old
-  integer :: ios
-
-  namelist /command/ &
-  ldirect, &
-  ibdate,ibtime, &
-  iedate,ietime, &
-  loutstep, &
-  loutaver, &
-  loutsample, &
-  loutrestart, &
-  lsynctime, &
-  ctl, &
-  ifine, &
-  iout, &
-  ipout, &
-  ipoutfac, &
-  lsubgrid, &
-  lconvection, &
-  lagespectra, &
-  ipin, &
-  ioutputforeachrelease, &
-  iflux, &
-  mdomainfill, &
-  ind_source, &
-  ind_receptor, &
-  mquasilag, &
-  nested_output, &
-  linit_cond, &
-  lnetcdfout, &
-  surf_only, &
-  cblflag, &
-  linversionout, &
-  ohfields_path, &
-  d_trop, &
-  d_strat, &
-  nxshift
-
-  ! Presetting namelist command
-  ldirect=0
-  ibdate=20000101
-  ibtime=0
-  iedate=20000102
-  ietime=0
-  loutstep=10800
-  loutaver=10800
-  loutsample=900
-  loutrestart=999999999
-  lsynctime=900
-  ctl=-5.0
-  ifine=4
-  iout=3
-  ipout=0
-  ipoutfac=1
-  lsubgrid=1
-  lconvection=1
-  lagespectra=0
-  ipin=0
-  ioutputforeachrelease=1
-  iflux=1
-  mdomainfill=0
-  ind_source=1
-  ind_receptor=1
-  mquasilag=0
-  nested_output=0
-  linit_cond=0
-  lnetcdfout=0
-  surf_only=0 
-  cblflag=0 ! if using old-style COMMAND file, set to 1 here to use mc cbl routine
-  linversionout=0
-  ohfields_path="../../flexin/"
-  nxshift=-9999
-
-  !Af set release-switch
-  WETBKDEP=.false.
-  DRYBKDEP=.false.
-
-  ! Open the command file and read user options
-  ! Namelist input first: try to read as namelist file
-  !**************************************************************************
-  open(unitcommand,file=path(1)(1:length(1))//'COMMAND',status='old', &
-    form='formatted',err=999)
-
-  ! try namelist input (default)
-  read(unitcommand,command,iostat=ios)
-  close(unitcommand)
-
-  ! distinguish namelist from fixed text input
-  if (ios.ne.0 .or. ldirect.eq.0) then ! parse as text file format
-!    if (lroot) 
-    write(*,*) 'COMMAND either having unrecognised entries, &
-      &or in old format, please update to namelist format.'
-      stop
-  endif ! input format
-
-  ! write command file in namelist format to output directory if requested
-!  if (nmlout.and.lroot) then
-  if (nmlout) then
-    open(unitcommand,file=path(2)(1:length(2))//'COMMAND.namelist',err=1000)
-    write(unitcommand,nml=command)
-    close(unitcommand)
-  endif
-
-  ifine=max(ifine,1)
-
-  ! Determine how Markov chain is formulated (for w or for w/sigw)
-  !***************************************************************
-  if (cblflag.eq.1) then ! added by MC to set parameters for CBL simulations 
-    turbswitch=.true.
-    if (lsynctime .gt. maxtl) lsynctime=maxtl  !maxtl defined in com_mod.f90
-    if (ctl.lt.5) then
-      print *,'WARNING: CBL flag active the ratio of TLu/dt has been set to 5'
-      ctl=5.
-    end if
-    if (ifine*ctl.lt.50) then
-      ifine=int(50./ctl)+1
-
-      print *,'WARNING: CBL flag active the ratio of TLW/dt was < 50, &
-        &ifine has been re-set to', ifine
-  !pause
-    endif
-    print *,'WARNING: CBL flag active the ratio of TLW/dt is ',ctl*ifine
-    print *,'WARNING: CBL flag active lsynctime is ',lsynctime
-  else                    !added by MC
-    if (ctl.ge.0.1) then
-      turbswitch=.true.
-    else
-      turbswitch=.false.
-      ifine=1
-    endif
-  endif                   !added by MC
-  fine=1./real(ifine)
-  ctl=1./ctl
-
-  ! Set the switches required for the various options for input/output units
-  !*************************************************************************
-  !AF Set the switches IND_REL and IND_SAMP for the release and sampling
-  !Af switches for the releasefile:
-  !Af IND_REL =  1 : xmass * rho
-  !Af IND_REL =  0 : xmass * 1
-
-  !Af switches for the conccalcfile:
-  !AF IND_SAMP =  0 : xmass * 1
-  !Af IND_SAMP = -1 : xmass / rho
-
-  !AF IND_SOURCE switches between different units for concentrations at the source
-  !Af   NOTE that in backward simulations the release of computational particles
-  !Af   takes place at the "receptor" and the sampling of particles at the "source".
-  !Af          1 = mass units
-  !Af          2 = mass mixing ratio units
-  !Af IND_RECEPTOR switches between different units for concentrations at the receptor
-  !            0 = no receptors
-  !Af          1 = mass units
-  !Af          2 = mass mixing ratio units
-  !            3 = wet deposition in outputfield
-  !            4 = dry deposition in outputfield
-
-  if ( ldirect .eq. 1 ) then  ! FWD-Run
-  !Af set release-switch
-     if (ind_source .eq. 1 ) then !mass
-        ind_rel = 0
-     else ! mass mix
-        ind_rel = 1
-     endif
-  !Af set sampling switch
-     if (ind_receptor .le. 1) then !mass
-        ind_samp = 0
-     else ! mass mix
-        ind_samp = -1
-     endif
-  elseif (ldirect .eq. -1 ) then !BWD-Run
-  !Af set sampling switch
-     if (ind_source .eq. 1 ) then !mass
-        ind_samp = -1
-     else ! mass mix
-        ind_samp = 0
-     endif
-     select case (ind_receptor)
-     case (1)  !  1 .. concentration at receptor
-        ind_rel = 1
-     case (2)  !  2 .. mixing ratio at receptor
-        ind_rel = 0
-     case (3)  ! 3 .. wet deposition in outputfield 
-        ind_rel = 3
-        if (lroot) then
-          write(*,*) ' #### FLEXPART WET DEPOSITION BACKWARD MODE    #### '
-          write(*,*) ' #### Releaseheight is forced to 0 - 20km      #### '
-          write(*,*) ' #### Release is performed above ground lev    #### '
-        end if
-         WETBKDEP=.true.
-         !allocate(xscav_frac1(maxpart,maxspec))
-     case (4)  ! 4 .. dry deposition in outputfield
-         ind_rel = 4
-         if (lroot) then
-           write(*,*) ' #### FLEXPART DRY DEPOSITION BACKWARD MODE    #### '
-           write(*,*) ' #### Releaseheight is forced to 0 - 2*href    #### '
-           write(*,*) ' #### Release is performed above ground lev    #### '
-         end if
-         DRYBKDEP=.true.
-         !allocate(xscav_frac1(maxpart,maxspec))
-     end select
-  endif
-
-  !*************************************************************
-  ! Check whether valid options have been chosen in file COMMAND
-  !*************************************************************
-
-  ! Check options for initial condition output: Switch off for forward runs
-  !************************************************************************
-
-  if (ldirect.eq.1) linit_cond=0
-  if (linit_cond.lt.0 .or. linit_cond.gt.2) then
-    write(*,*) ' #### FLEXPART MODEL ERROR! INVALID OPTION    #### '
-    write(*,*) ' #### FOR LINIT_COND IN FILE "COMMAND".       #### '
-    stop
-  endif
-
-  ! Check input dates
-  !******************
-
-  if (iedate.lt.ibdate) then
-    write(*,*) ' #### FLEXPART MODEL ERROR! BEGINNING DATE    #### '
-    write(*,*) ' #### IS LARGER THAN ENDING DATE. CHANGE      #### '
-    write(*,*) ' #### EITHER POINT 2 OR POINT 3 IN FILE       #### '
-    write(*,*) ' #### "COMMAND".                              #### '
-    stop
-  else if (iedate.eq.ibdate) then
-    if (ietime.lt.ibtime) then
-    write(*,*) ' #### FLEXPART MODEL ERROR! BEGINNING TIME    #### '
-    write(*,*) ' #### IS LARGER THAN ENDING TIME. CHANGE      #### '
-    write(*,*) ' #### EITHER POINT 2 OR POINT 3 IN FILE       #### '
-    write(*,*) ' #### "COMMAND".                              #### '
-    stop
-    endif
-  endif
-
-#ifndef USE_NCF
-  if ((loutrestart.ne.999999999).or.(ipin.ne.0)) then
-    write(*,*) ' WARNING: restart option set with intervals'
-    write(*,*) ' LOUTRESTART', loutrestart
-    write(*,*) ' not possible when using binary gridded output'
-    write(*,*) ' ==> RESTART FUNCTION SWITCHED OFF!'
-  endif
-  if (ipin.ne.0) then 
-    write(*,*) ' ERROR: restart option not possible using binary'
-    write(*,*) ' output.'
-    write(*,*) ' Please only use IPIN>0 when compiling and running using'
-    write(*,*) ' netcdf output. '
-  endif
-#else
-  if ((surf_only.eq.1).or.(linversionout.eq.1)) then
-    write(*,*) ' ERROR: NetCDF output for surface only or for inversions'
-    write(*,*) ' is not yet implemented. Please compile without NetCDF.'
-    stop
-  endif
-#endif
-
-  ! Determine kind of dispersion method
-  !************************************
-
-  if (ctl.gt.0.) then
-    method=1
-    mintime=minstep
-  else
-    method=0
-    mintime=lsynctime
-  endif
-
-  ! Check for netcdf output switch
-  !*******************************
-#ifdef USE_NCF
-  lnetcdfout = 1
-#endif
-  if (iout.ge.8) then
-     lnetcdfout = 1
-     iout = iout - 8
-#ifndef USE_NCF
-     write(*,*) 'ERROR: netcdf output not activated during compile time &
-       &but used in COMMAND file!'
-     write(*,*) 'Please recompile with netcdf library (`make [...] ncf=yes`) &
-       &or use standard output format.'
-     stop
-#endif
-  endif
-#ifndef USE_NCF
-  if (ipout.ne.0) then
-    write(*,*) 'ERROR: NETCDF missing! Please recompile with the netcdf'
-    write(*,*) 'library if you want the particle dump or set IPOUT=0.'
-    stop    
-  endif
-#endif
-
-  ! Check whether a valid option for gridded model output has been chosen
-  !**********************************************************************
-
-  if (iout.eq.0) then
-    write(*,*) 'WARNING: IOUT set to zero, no gridded information will be &
-      &written to file'
-  else if ((iout.lt.0).or.(iout.gt.5)) then
-    write(*,*) ' #### FLEXPART MODEL ERROR! FILE COMMAND:     #### '
-    write(*,*) ' #### IOUT MUST BE 1, 2, 3, 4 OR 5 FOR        #### '
-    write(*,*) ' #### STANDARD FLEXPART OUTPUT OR  9 - 13     #### '
-    write(*,*) ' #### FOR NETCDF OUTPUT                       #### '
-    stop
-  endif
-
-  !AF check consistency between units and volume mixing ratio
-  if ( ((iout.eq.2).or.(iout.eq.3)).and. &
-       (ind_source.gt.1 .or.ind_receptor.gt.1) ) then
-    write(*,*) ' #### FLEXPART MODEL ERROR! FILE COMMAND:     #### '
-    write(*,*) ' #### VOLUME MIXING RATIO ONLY SUPPORTED      #### '
-    write(*,*) ' #### FOR MASS UNITS (at the moment)          #### '
-    stop
-  endif
-
-
-  ! For quasilag output for each release is forbidden
-  !*****************************************************************************
-
-  if ((ioutputforeachrelease.eq.1).and.(mquasilag.eq.1)) then
-      write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND:     ####'
-      write(*,*) '#### OUTPUTFOREACHRELEASE AND QUASILAGRANGIAN####'
-      write(*,*) '#### MODE IS NOT POSSIBLE   !                ####'
-      stop
-  endif
-
-
-  ! For quasilag backward is forbidden
-  !*****************************************************************************
-
-  if ((ldirect.lt.0).and.(mquasilag.eq.1)) then
-      write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND:     ####'
-      write(*,*) '#### FOR BACKWARD RUNS, QUASILAGRANGIAN MODE ####'
-      write(*,*) '#### IS NOT POSSIBLE   !                     ####'
-      stop
-  endif
-
-
-  ! For backward runs one releasefield for all releases makes no sense,
-  ! For quasilag and domainfill ioutputforechrelease is forbidden
-  !*****************************************************************************
-
-  if ((ldirect.lt.0).and.(ioutputforeachrelease.eq.0)) then
-      write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND:     ####'
-      write(*,*) '#### FOR BACKWARD RUNS, IOUTPUTFOREACHRLEASE ####'
-      write(*,*) '#### MUST BE SET TO ONE!                     ####'
-      stop
-  endif
-
-
-  ! For backward runs one releasefield for all releases makes no sense,
-  ! and is "forbidden"
-  !*****************************************************************************
-
-  if ((mdomainfill.eq.1).and.(ioutputforeachrelease.eq.1)) then
-      write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND:     ####'
-      write(*,*) '#### FOR DOMAIN FILLING RUNS OUTPUT FOR      ####'
-      write(*,*) '#### EACH RELEASE IS FORBIDDEN !             ####'
-      stop
-  endif
-
-  ! Inversion output format only for backward runs
-  !*****************************************************************************
-  
-  if ((linversionout.eq.1).and.(ldirect.eq.1)) then
-      write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND:     ####'
-      write(*,*) '#### INVERSION OUTPUT FORMAT ONLY FOR        ####'
-      write(*,*) '#### BACKWARD RUNS                           ####'
-      stop
-  endif
-
-
-  ! For domain-filling trajectories, a plume centroid trajectory makes no sense,
-  ! For backward runs, only residence time output (iout=1) or plume trajectories (iout=4),
-  ! or both (iout=5) makes sense; other output options are "forbidden"
-  !*****************************************************************************
-
-  if (ldirect.lt.0) then
-    if ((iout.eq.2).or.(iout.eq.3)) then
-      write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND:     ####'
-      write(*,*) '#### FOR BACKWARD RUNS, IOUT MUST BE 1,4,OR 5####'
-      stop
-    endif
-  endif
-
-
-  ! For domain-filling trajectories, a plume centroid trajectory makes no sense,
-  ! and is "forbidden"
-  !*****************************************************************************
-
-  if (mdomainfill.ge.1) then
-    if ((iout.eq.4).or.(iout.eq.5)) then
-      write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND:     ####'
-      write(*,*) '#### FOR DOMAIN-FILLING TRAJECTORY OPTION,   ####'
-      write(*,*) '#### IOUT MUST NOT BE SET TO 4 OR 5.         ####'
-      stop
-    endif
-  endif
-
-  ! Check whether a valid options for particle dump has been chosen
-  !****************************************************************
-
-  if ((ipout.ne.0).and.(ipout.ne.1).and.(ipout.ne.2).and.(ipout.ne.3)) then
-    write(*,*) ' #### FLEXPART MODEL ERROR! FILE COMMAND:     #### '
-    write(*,*) ' #### IPOUT MUST BE 0, 1, 2 OR 3!             #### '
-    stop
-  endif
-
-  ! Check whether input and output settings don't contradict
-  !*********************************************************
-  if (((iout.eq.4).or.(iout.eq.5)).and.((ipin.eq.3).or.(ipin.eq.4))) then
-    write(*,*) ' #### FLEXPART MODEL ERROR! FILE COMMAND:     #### '
-    write(*,*) ' #### IOUT CANNOT BE 4 or 5 (plume) WHEN      #### '
-    write(*,*) ' #### READING FROM part_ic.nc (ipin=4/5)      #### '
-    stop
-  endif    
-
-  if(lsubgrid.ne.1.and.verbosity.eq.0) then
-    write(*,*) '             ----------------               '
-    write(*,*) ' INFORMATION: SUBGRIDSCALE TERRAIN EFFECT IS'
-    write(*,*) ' NOT PARAMETERIZED DURING THIS SIMULATION.  '
-    write(*,*) '             ----------------               '
-  endif
-
-
-  ! Check whether convection scheme is either turned on or off
-  !***********************************************************
-
-  if ((lconvection.ne.0).and.(lconvection.ne.1)) then
-    write(*,*) ' #### FLEXPART MODEL ERROR! FILE COMMAND:     #### '
-    write(*,*) ' #### LCONVECTION MUST BE SET TO EITHER 1 OR 0#### '
-    stop
-  endif
-
-
-  ! Check whether synchronisation interval is sufficiently short
-  !*************************************************************
-
-  if (lsynctime.gt.(idiffnorm/2)) then
-    write(*,*) ' #### FLEXPART MODEL ERROR! SYNCHRONISATION   #### '
-    write(*,*) ' #### TIME IS TOO LONG. MAKE IT SHORTER.      #### '
-    write(*,*) ' #### MINIMUM HAS TO BE: ', idiffnorm/2
-    stop
-  endif
-
-
-  ! Check consistency of the intervals, sampling periods, etc., for model output
-  !*****************************************************************************
-
-  if (loutaver.eq.0) then
-    write(*,*) ' #### FLEXPART MODEL ERROR! TIME AVERAGE OF   #### '
-    write(*,*) ' #### CONCENTRATION FIELD OUTPUT MUST NOT BE  #### '
-    write(*,*) ' #### ZERO.                                   #### '
-    write(*,*) ' #### CHANGE INPUT IN FILE COMMAND.           #### '
-    stop
-  endif
-
-  if (loutaver.gt.loutstep) then
-    write(*,*) ' #### FLEXPART MODEL ERROR! TIME AVERAGE OF   #### '
-    write(*,*) ' #### CONCENTRATION FIELD OUTPUT MUST NOT BE  #### '
-    write(*,*) ' #### GREATER THAN INTERVAL OF OUTPUT.        #### '
-    write(*,*) ' #### CHANGE INPUT IN FILE COMMAND.           #### '
-    stop
-  endif
-
-  if (loutsample.gt.loutaver) then
-    write(*,*) ' #### FLEXPART MODEL ERROR! SAMPLING TIME OF  #### '
-    write(*,*) ' #### CONCENTRATION FIELD OUTPUT MUST NOT BE  #### '
-    write(*,*) ' #### GREATER THAN TIME AVERAGE OF OUTPUT.    #### '
-    write(*,*) ' #### CHANGE INPUT IN FILE COMMAND.           #### '
-    stop
-  endif
-
-  if (mod(loutaver,lsynctime).ne.0) then
-    write(*,*) ' #### FLEXPART MODEL ERROR! AVERAGING TIME OF #### '
-    write(*,*) ' #### CONCENTRATION FIELD MUST BE A MULTIPLE  #### '
-    write(*,*) ' #### OF THE SYNCHRONISATION INTERVAL         #### '
-    stop
-  endif
-
-  if ((loutaver/lsynctime).lt.2) then
-    write(*,*) ' #### FLEXPART MODEL ERROR! AVERAGING TIME OF #### '
-    write(*,*) ' #### CONCENTRATION FIELD MUST BE AT LEAST    #### '
-    write(*,*) ' #### TWICE THE SYNCHRONISATION INTERVAL      #### '
-    stop
-  endif
-
-  if (mod(loutstep,lsynctime).ne.0) then
-    write(*,*) ' #### FLEXPART MODEL ERROR! INTERVAL BETWEEN  #### '
-    write(*,*) ' #### CONCENTRATION FIELDS MUST BE A MULTIPLE #### '
-    write(*,*) ' #### OF THE SYNCHRONISATION INTERVAL         #### '
-    stop
-  endif
-
-  if ((loutstep/lsynctime).lt.2) then
-    write(*,*) ' #### FLEXPART MODEL ERROR! INTERVAL BETWEEN  #### '
-    write(*,*) ' #### CONCENTRATION FIELDS MUST BE AT LEAST   #### '
-    write(*,*) ' #### TWICE THE SYNCHRONISATION INTERVAL      #### '
-    stop
-  endif
-
-  if (mod(loutsample,lsynctime).ne.0) then
-    write(*,*) ' #### FLEXPART MODEL ERROR! SAMPLING TIME OF  #### '
-    write(*,*) ' #### CONCENTRATION FIELD MUST BE A MULTIPLE  #### '
-    write(*,*) ' #### OF THE SYNCHRONISATION INTERVAL         #### '
-    stop
-  endif
-
-  if ((mquasilag.eq.1).and.(iout.ge.4)) then
-    write(*,*) ' #### FLEXPART MODEL ERROR! CONFLICTING       #### '
-    write(*,*) ' #### OPTIONS: IF MQUASILAG=1, PLUME          #### '
-    write(*,*) ' #### TRAJECTORY OUTPUT IS IMPOSSIBLE.        #### '
-    stop
-  endif
-
-  ! Compute modeling time in seconds and beginning date in Julian date
-  !*******************************************************************
-
-  outstep=real(abs(loutstep))
-  if (ldirect.eq.1) then
-    bdate=juldate(ibdate,ibtime)
-    edate=juldate(iedate,ietime)
-    ideltas=nint((edate-bdate)*86400.)
-  else if (ldirect.eq.-1) then
-    loutaver=-1*loutaver
-    loutstep=-1*loutstep
-    loutsample=-1*loutsample
-    lsynctime=-1*lsynctime
-    bdate=juldate(iedate,ietime)
-    edate=juldate(ibdate,ibtime)
-    ideltas=nint((edate-bdate)*86400.)
-  else
-    write(*,*) ' #### FLEXPART MODEL ERROR! DIRECTION IN      #### '
-    write(*,*) ' #### FILE "COMMAND" MUST BE EITHER -1 OR 1.  #### '
-    stop
-  endif
-
-  return
-
-999   write(*,*) ' #### FLEXPART MODEL ERROR! FILE "COMMAND"    #### '
-  write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY       #### '
-  write(*,'(a)') path(1)(1:length(1))
-  stop
-
-1000   write(*,*) ' #### FLEXPART MODEL ERROR! FILE "COMMAND"    #### '
-  write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY       #### '
-  write(*,'(a)') path(2)(1:length(2))
-  stop
-end subroutine readcommand
-
-subroutine readdepo
-
-  !*****************************************************************************
-  !                                                                            *
-  !  Reads dry deposition parameters needed by the procedure of Wesely (1989). *
-  !  Wesely (1989): Parameterization of surface resistances to gaseous         *
-  !  dry deposition in regional-scale numerical models.                        *
-  !  Atmos. Environ. 23, 1293-1304.                                            *
-  !                                                                            *
-  !                                                                            *
-  !      AUTHOR: Andreas Stohl, 19 May 1995                                    *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  !                                                                            *
-  ! rcl(maxspec,5,9) [s/m] Lower canopy resistance                             *
-  ! rgs(maxspec,5,9) [s/m] Ground resistance                                   *
-  ! rlu(maxspec,5,9) [s/m] Leaf cuticular resistance                           *
-  ! rm(maxspec) [s/m]      Mesophyll resistance, set in readreleases           *
-  ! ri(maxspec) [s/m]      Stomatal resistance                                 *
-  !                                                                            *
-  ! Constants:                                                                 *
-  !                                                                            *
-  !*****************************************************************************
-
-  implicit none
-
-  ! FOR THIS SUBROUTINE, numclass=9 IS ASSUMED
-  !*******************************************
-
-  real :: rluh(5,numclass),rgssh(5,numclass),rgsoh(5,numclass)
-  real :: rclsh(5,numclass),rcloh(5,numclass)
-  integer :: i,j,ic
-
-
-  ! Read deposition constants related with landuse and seasonal category
-  !*********************************************************************
-  open(unitwesely,file=path(1)(1:length(1))//'sfcdepo.txt', &
-       status='old',err=999)
-
-  do i=1,16
-    read(unitwesely,*)
-  end do
-  do i=1,5
-    read(unitwesely,*)
-    read(unitwesely,'(8x,13f8.0)') (ri(i,j),j=1,numclass)
-    read(unitwesely,'(8x,13f8.0)') (rluh(i,j),j=1,numclass)
-    read(unitwesely,'(8x,13f8.0)') (rac(i,j),j=1,numclass)
-    read(unitwesely,'(8x,13f8.0)') (rgssh(i,j),j=1,numclass)
-    read(unitwesely,'(8x,13f8.0)') (rgsoh(i,j),j=1,numclass)
-    read(unitwesely,'(8x,13f8.0)') (rclsh(i,j),j=1,numclass)
-    read(unitwesely,'(8x,13f8.0)') (rcloh(i,j),j=1,numclass)
-  end do
-
-  ! TEST
-  ! do 31 i=1,5
-  !   ri(i,13)=ri(i,5)
-  !   rluh(i,13)=rluh(i,5)
-  !   rac(i,13)=rac(i,5)
-  !   rgssh(i,13)=rgssh(i,5)
-  !   rgsoh(i,13)=rgsoh(i,5)
-  !   rclsh(i,13)=rclsh(i,5)
-  !   rcloh(i,13)=rcloh(i,5)
-  !31             continue
-  ! TEST
-  ! Sabine Eckhardt, Dec 06, set resistances of 9999 to 'infinite' (1E25)
-  do i=1,5
-    do j=1,numclass
-      if    (ri(i,j).eq.9999.)    ri(i,j)=1.E25
-      if  (rluh(i,j).eq.9999.)  rluh(i,j)=1.E25
-      if   (rac(i,j).eq.9999.)   rac(i,j)=1.E25
-      if (rgssh(i,j).eq.9999.) rgssh(i,j)=1.E25
-      if (rgsoh(i,j).eq.9999.) rgsoh(i,j)=1.E25
-      if (rclsh(i,j).eq.9999.) rclsh(i,j)=1.E25
-      if (rcloh(i,j).eq.9999.) rcloh(i,j)=1.E25
-    end do
-  end do
-
-
-
-  do i=1,5
-    do j=1,numclass
-      ri(i,j)=max(ri(i,j),0.001)
-      rluh(i,j)=max(rluh(i,j),0.001)
-      rac(i,j)=max(rac(i,j),0.001)
-      rgssh(i,j)=max(rgssh(i,j),0.001)
-      rgsoh(i,j)=max(rgsoh(i,j),0.001)
-      rclsh(i,j)=max(rclsh(i,j),0.001)
-      rcloh(i,j)=max(rcloh(i,j),0.001)
-    end do
-  end do
-  close(unitwesely)
-
-
-  ! Compute additional parameters
-  !******************************
-
-  do ic=1,nspec
-    if (reldiff(ic).gt.0.) then     ! gas is dry deposited
-      do i=1,5
-        do j=1,numclass
-          rlu(ic,i,j)=rluh(i,j)/(1.e-5*henry(ic)+f0(ic))
-          rgs(ic,i,j)=1./(henry(ic)/(10.e5*rgssh(i,j))+f0(ic)/ &
-               rgsoh(i,j))
-          rcl(ic,i,j)=1./(henry(ic)/(10.e5*rclsh(i,j))+f0(ic)/ &
-               rcloh(i,j))
-        end do
-      end do
-    endif
-  end do
-
-
-  return
-
-999   write(*,*) '### FLEXPART ERROR! FILE              ###'
-  write(*,*) '### surfdepo.t DOES NOT EXIST.        ###'
-  stop
-end subroutine readdepo
-
-subroutine readOHfield
-
-  !*****************************************************************************
-  !                                                                            *
-  ! Reads the OH field into memory                                             *
-  !                                                                            *
-  ! AUTHOR: R.L. Thompson, Nov 2014                                            *
-  !                                                                            *
-  ! UPDATES:                                                                   *
-  !   03/2018 SEC: Converted original netCDF files to binary format            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  !                                                                            *
-  ! path(numpath)              contains the path names                         *
-  ! lonOH(nxOH)                longitude of OH fields                          *
-  ! latOH(nyOH)                latitude of OH fields                           *
-  ! altOH(nzOH)                altitude of OH fields                           *
-  ! etaOH(nzOH)                eta-levels of OH fields                         *
-  ! OH_field(nxOH,nyOH,nzOH,m) OH concentration (molecules/cm3)                *
-  !                                                                            *
-  !                                                                            *
-  !*****************************************************************************
-
-  use ohr_mod
-
-  implicit none
-
-  integer :: i,j,k,l,ierr
-  real, dimension(:), allocatable :: etaOH
-
-  !  real, parameter :: gasct=8.314   ! gas constant
-  !  real, parameter :: mct=0.02894   ! kg mol-1
-  !  real, parameter :: g=9.80665     ! m s-2
-  !  real, parameter :: lrate=0.0065  ! K m-1
-  real, parameter :: scalehgt=7000. ! scale height in metres
-
-
-  open(unitOH,file=trim(ohfields_path) &
-       //'OH_FIELDS/OH_variables.bin',status='old', &
-       form='UNFORMATTED', iostat=ierr, convert='little_endian')
-
-  if(ierr.ne.0) then
-    write(*,*) 'Cannot read binary OH fields in ', &
-      trim(ohfields_path)//'OH_FIELDS/OH_variables.bin'
-    stop
-  endif
-
-  read(unitOH) nxOH
-  read(unitOH) nyOH
-  read(unitOH) nzOH
-  write(*,*) nxOH,nyOH,nzOH
-
-  ! allocate variables
-  allocate(lonOH(nxOH))
-  allocate(latOH(nyOH))
-  allocate(etaOH(nzOH))
-  allocate(altOH(nzOH))
-  allocate(OH_field(nxOH,nyOH,nzOH,12))
-  allocate(OH_hourly(nxOH,nyOH,nzOH,2))
-
-  read(unitOH) (lonjr(i),i=1,360)
-  read(unitOH) (latjr(i),i=1,180)
-  read(unitOH) (((jrate_average(i,j,k),i=1,360),j=1,180),k=1,12)
-  read(unitOH) (lonOH(i),i=1,nxOH)
-  read(unitOH) (latOH(i),i=1,nyOH)
-  read(unitOH) (lonOH(i),i=1,nxOH)
-
-  read(unitOH) (altOH(i),i=1,nzOH)
-  read(unitOH) ((((OH_field(i,j,k,l),i=1,nxOH),j=1,nyOH),k=1,nzOH),l=1,12)
-  read(unitOH) ((((OH_hourly(i,j,k,l),i=1,nxOH),j=1,nyOH),k=1,nzOH),l=1,2)
-
-end subroutine readOHfield
-
-subroutine readlanduse
-
-  !*****************************************************************************
-  !                                                                            *
-  !      Reads the landuse inventory into memory and relates it to Leaf Area   *
-  !      Index and roughness length.                                           *
-  !                                                                            *
-  !      AUTHOR: Andreas Stohl, 10 January 1994                                *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! i                       loop indices                                       *
-  ! landinvent(1200,600,13) area fractions of 13 landuse categories            *
-  ! LENGTH(numpath)         length of the path names                           *
-  ! PATH(numpath)           contains the path names                            *
-  ! unitland                unit connected with landuse inventory              *
-  !                                                                            *
-  ! -----                                                                      *
-  ! Sabine Eckhardt, Dec 06 - new landuse inventary                            *
-  ! after                                                                      *
-  ! Belward, A.S., Estes, J.E., and Kline, K.D., 1999,                         *
-  ! The IGBP-DIS 1-Km Land-Cover Data Set DISCover:                            *
-  ! A Project Overview: Photogrammetric Engineering and Remote Sensing,        *
-  ! v. 65, no. 9, p. 1013-1020                                                 *
-  !                                                                            *
-  ! LANDUSE CATEGORIES:                                                        *
-  !                                                                            *
-  ! 1   Urban land                                                             *
-  ! 2   Agricultural land                                                      *
-  ! 3   Range land                                                             *
-  ! 4   Deciduous forest                                                       *
-  ! 5   Coniferous forest                                                      *
-  ! 6   Mixed forest including wetland                                         *
-  ! 7   water, both salt and fresh                                             *
-  ! 8   barren land mostly desert                                              *
-  ! 9   nonforested wetland                                                    *
-  ! 10  mixed agricultural and range land                                      *
-  ! 11  rocky open areas with low growing shrubs                               *
-  ! 12  ice                                                                    *
-  ! 13  rainforest                                                             *
-  !                                                                            *
-  !*****************************************************************************
-
-  use drydepo_mod
-  
-  implicit none
-
-  integer :: ix,jy,i,k,lu_cat,lu_perc
-  integer(kind=1) :: ilr
-  integer(kind=1) :: ilr_buffer(2160000)
-  integer :: il,irecread
-  real :: rlr, r2lr
-
-
-  ! Read landuse inventory
-  !***********************
-  ! The landuse information is saved in a compressed format and written
-  ! out by records of the length of 1 BYTE. Each grid cell consists of 3
-  ! Bytes, which include 3 landuse categories (val 1-13 and 16 percentage
-  ! categories) So one half byte is used to store the Landusecat the other
-  ! for the percentageclass in 6.25 steps (100/6.25=16)
-  ! e.g.
-  ! 4 3  percentage 4 = 4*6.25 => 25% landuse class 3
-  ! 2 1  percentage 2 = 2*6.25 => 13% landuse class 1
-  ! 1 12 percentage 1 = 1*6.26 => 6.25% landuse class 12
-
-  open(unitland,file=path(1)(1:length(1))//'IGBP_int1.dat',status='old', &
-    form='UNFORMATTED', err=998, convert='little_endian')
-  read (unitland) (ilr_buffer(i),i=1,2160000)
-  close(unitland)
-
-  irecread=1
-  do ix=1,1200
-    do jy=1,600
-  ! the 3 most abundant landuse categories in the inventory
-  ! first half byte contains the landuse class
-  ! second half byte contains the respective percentage
-      do k=1,3
-  ! 1 byte is read
-        ilr=ilr_buffer(irecread)
-  !      ilr=0
-        irecread=irecread+1
-  ! as only signed integer values exist an unsigned value is constructed
-        if (ilr.lt.0) then
-           il=ilr+256
-        else
-           il=ilr
-        endif
-  ! dividing by 16 has the effect to get rid of the right half of the byte
-  ! so just the left half remains, this corresponds to a shift right of 4
-  ! bits
-        rlr=real(il)/16.
-        lu_cat=int(rlr)
-  ! the left half of the byte is substracted from the whole in order to
-  ! get only the right half of the byte
-        r2lr=rlr-int(rlr)
-  ! shift left by 4
-        lu_perc=r2lr*16.
-        landinvent(ix,jy,k)=lu_cat
-        landinvent(ix,jy,k+3)=lu_perc
-  ! if ((jy.lt.10).and.(ix.lt.10)) write(*,*) 'reading: ',ix,jy,lu_cat,lu_perc
-      end do
-    end do
-  end do
-
-  ! Read relation landuse,z0
-  !*****************************
-
-  open(unitsfcdata,file=path(1)(1:length(1))//'sfcdata.txt', &
-       status='old',err=999)
-
-  do i=1,4
-    read(unitsfcdata,*)
-  end do
-  do i=1,numclass
-    read(unitsfcdata,'(45x,f15.3)') z0(i)
-  end do
-  close(unitsfcdata)
-
-  return
-
-  ! Issue error messages
-  !*********************
-
-998 write(*,*) ' #### FLEXPART ERROR! FILE                     ####'
-  write(*,*)   ' #### ', path(1)(1:length(1))//'IGBP_int1.dat'
-  write(*,*)   " #### (LANDUSE INVENTORY) COULD NOT BE OPENED  ####"
-  stop
-
-999 write(*,*) ' #### FLEXPART ERROR! FILE              ####'
-  write(*,*)   ' #### ', path(1)(1:length(1))//'sfcdata.txt'
-  write(*,*)   ' #### DOES NOT EXIST. Note that         ####'
-  write(*,*)   ' #### file was renamed from surfdata.t  ####'
-  write(*,*)   ' #### to sfcdata.txt in v11             ####'
-  stop
-
-end subroutine readlanduse
-
-subroutine readoutgrid
-
-  !*****************************************************************************
-  !                                                                            *
-  !     This routine reads the user specifications for the output grid.        *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     4 June 1996                                                            *
-  !     HSO, 1 July 2014
-  !     Added optional namelist input
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! dxout,dyout          grid distance                                         *
-  ! numxgrid,numygrid,numzgrid    grid dimensions                              *
-  ! outlon0,outlat0      lower left corner of grid                             *
-  ! outheight(maxzgrid)  height levels of output grid [m]                      *
-  !                                                                            *
-  ! Constants:                                                                 *
-  ! unitoutgrid          unit connected to file OUTGRID                        *
-  !                                                                            *
-  !*****************************************************************************
-
-  use prepoutgrid_mod
-
-  implicit none
-
-  integer :: i,j,stat
-  real :: outhelp,xr,xr1,yr,yr1
-  real,parameter :: eps=1.e-4
-
-  ! namelist variables
-  integer, parameter :: maxoutlev=500
-  integer :: ios
-  real,allocatable, dimension (:) :: outheights
-
-  ! declare namelist
-  namelist /outgrid/ &
-    outlon0,outlat0, &
-    numxgrid,numygrid, &
-    dxout,dyout, &
-    outheights
-
-  ! allocate large array for reading input
-  allocate(outheights(maxoutlev),stat=stat)
-  if (stat.ne.0) write(*,*)'ERROR: could not allocate outheights'
-
-
-  ! Open the OUTGRID file and read output grid specifications
-  !**********************************************************
-
-  open(unitoutgrid,file=path(1)(1:length(1))//'OUTGRID',status='old', &
-    form='formatted',err=999)
-
-! try namelist input
-  dxout=-1.
-  outheights=-1.
-! helps identifying failed namelist input
-  read (unitoutgrid,outgrid,iostat=ios)
-  close(unitoutgrid)
-
-  if (dxout.le.0 .or. ios.ne.0) then
-
-    ios=1
-
-    open(unitoutgrid,file=path(1)(1:length(1))//'OUTGRID',status='old',err=999)
-
-    call skplin(5,unitoutgrid)
-
-    ! 1.  Read horizontal grid specifications
-    !****************************************
-
-    call skplin(3,unitoutgrid)
-    read(unitoutgrid,'(4x,f11.4)') outlon0
-    call skplin(3,unitoutgrid)
-    read(unitoutgrid,'(4x,f11.4)') outlat0
-    call skplin(3,unitoutgrid)
-    read(unitoutgrid,'(4x,i5)') numxgrid
-    call skplin(3,unitoutgrid)
-    read(unitoutgrid,'(4x,i5)') numygrid
-    call skplin(3,unitoutgrid)
-    read(unitoutgrid,'(4x,f12.5)') dxout
-    call skplin(3,unitoutgrid)
-    read(unitoutgrid,'(4x,f12.5)') dyout
-
-  endif
-
-  ! Check validity of output grid (shall be within model domain)
-  !*************************************************************
-
-  xr=outlon0+real(numxgrid)*dxout
-  yr=outlat0+real(numygrid)*dyout
-  xr1=xlon0+real(nxmin1)*dx
-  yr1=ylat0+real(nymin1)*dy
-  if ((outlon0+eps.lt.xlon0).or.(outlat0+eps.lt.ylat0) &
-       .or.(xr.gt.xr1+eps).or.(yr.gt.yr1+eps)) then
-    write(*,*) outlon0,outlat0
-    write(*,*) xr1,yr1,xlon0,ylat0,xr,yr,dxout,dyout
-    write(*,*) ' #### FLEXPART MODEL ERROR! PART OF OUTPUT    ####'
-    write(*,*) ' #### GRID IS OUTSIDE MODEL DOMAIN. CHANGE    ####'
-    write(*,*) ' #### FILE OUTGRID IN DIRECTORY               ####'
-    write(*,'(a)') path(1)(1:length(1))
-    stop
-  endif
-
-  ! 2. Count Vertical levels of output grid
-  !****************************************
-
-  if (ios.ne.0) then
-    j=0
-100 j=j+1
-    do i=1,3
-      read(unitoutgrid,*,end=99)
-    end do
-    read(unitoutgrid,'(4x,f7.1)',end=99) outhelp
-    if (outhelp.eq.0.) goto 99
-    goto 100
-99  numzgrid=j-1
-  else
-    do i=1,maxoutlev
-      if (outheights(i).lt.0) exit
-    end do
-    numzgrid=i-1
-  end if
-
-  allocate(outheight(numzgrid),stat=stat)
-  if (stat.ne.0) write(*,*)'ERROR: could not allocate outheight'
-  allocate(outheighthalf(numzgrid),stat=stat)
-  if (stat.ne.0) write(*,*)'ERROR: could not allocate outheighthalf'
-
-  ! 2. Vertical levels of output grid
-  !**********************************
-
-  if (ios.ne.0) then
-
-    rewind(unitoutgrid)
-    call skplin(29,unitoutgrid)
-
-    do j=1,numzgrid
-      do i=1,3
-        read(unitoutgrid,*)
-      end do
-      read(unitoutgrid,'(4x,f7.1)') outhelp
-      outheight(j)=outhelp
-      outheights(j)=outhelp
-    end do
-    close(unitoutgrid)
-
-  else
-
-    do j=1,numzgrid
-      outheight(j)=outheights(j)
-    end do
-
-  endif
-
-  ! write outgrid file in namelist format to output directory if requested
-  if (nmlout.and.lroot) then
-    ! reallocate outheights with actually required dimension for namelist writing
-    deallocate(outheights)
-    allocate(outheights(numzgrid),stat=stat)
-    if (stat.ne.0) write(*,*)'ERROR: could not allocate outheights'
-
-    do j=1,numzgrid
-      outheights(j)=outheight(j)
-    end do
-
-    open(unitoutgrid,file=path(2)(1:length(2))//'OUTGRID.namelist',err=1000)
-    write(unitoutgrid,nml=outgrid)
-    close(unitoutgrid)
-  endif
-
-  ! Check whether vertical levels are specified in ascending order
-  !***************************************************************
-
-  do j=2,numzgrid
-    if (outheight(j).le.outheight(j-1)) then
-    write(*,*) ' #### FLEXPART MODEL ERROR! YOUR SPECIFICATION#### '
-    write(*,*) ' #### OF OUTPUT LEVELS IS CORRUPT AT LEVEL    #### '
-    write(*,*) ' #### ',j,'                              #### '
-    write(*,*) ' #### PLEASE MAKE CHANGES IN FILE OUTGRID.    #### '
-    endif
-  end do
-
-  ! Determine the half levels, i.e. middle levels of the output grid
-  !*****************************************************************
-
-  outheighthalf(1)=outheight(1)/2.
-  do j=2,numzgrid
-    outheighthalf(j)=(outheight(j-1)+outheight(j))/2.
-  end do
-
-  xoutshift=xlon0-outlon0
-  youtshift=ylat0-outlat0
-
-  allocate(oroout(0:numxgrid-1,0:numygrid-1),stat=stat)
-  if (stat.ne.0) write(*,*)'ERROR: could not allocate oroout'
-  allocate(area(0:numxgrid-1,0:numygrid-1),stat=stat)
-  if (stat.ne.0) write(*,*)'ERROR: could not allocate area'
-  allocate(volume(0:numxgrid-1,0:numygrid-1,numzgrid),stat=stat)
-  if (stat.ne.0) write(*,*)'ERROR: could not allocate volume'
-  allocate(areaeast(0:numxgrid-1,0:numygrid-1,numzgrid),stat=stat)
-  if (stat.ne.0) write(*,*)'ERROR: could not allocate areaeast'
-  allocate(areanorth(0:numxgrid-1,0:numygrid-1,numzgrid),stat=stat)
-  if (stat.ne.0) write(*,*)'ERROR: could not allocate areanorth'
-  return
-
-999 write(*,*) ' #### FLEXPART MODEL ERROR! FILE "OUTGRID"    #### '
-  write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY       #### '
-  write(*,'(a)') path(1)(1:length(1))
-  stop
-
-1000 write(*,*) ' #### FLEXPART MODEL ERROR! FILE "OUTGRID"    #### '
-  write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY       #### '
-  write(*,'(a)') path(2)(1:length(2))
-  stop
-end subroutine readoutgrid
-
-subroutine readoutgrid_nest
-
-  !*****************************************************************************
-  !                                                                            *
-  !     This routine reads the user specifications for the output nest.        *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     4 June 1996                                                            *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! dxoutn,dyoutn        grid distances of output nest                         *
-  ! numxgridn,numygridn,numzgrid    nest dimensions                            *
-  ! outlon0n,outlat0n    lower left corner of nest                             *
-  ! outheight(maxzgrid)  height levels of output grid [m]                      *
-  !                                                                            *
-  ! Constants:                                                                 *
-  ! unitoutgrid          unit connected to file OUTGRID                        *
-  !                                                                            *
-  !*****************************************************************************
-
-  use prepoutgrid_mod
-
-  implicit none
-
-  integer :: stat
-  real :: xr,xr1,yr,yr1
-  real,parameter :: eps=1.e-4
-
-  integer :: ios
-
-  ! declare namelist
-  namelist /outgridn/ &
-    outlon0n,outlat0n, &
-    numxgridn,numygridn, &
-    dxoutn,dyoutn
+#include "rea_readcommand.f90"
 
-  ! helps identifying failed namelist input
-  dxoutn=-1.0
+#include "rea_readdepo.f90"
 
-  ! Open the OUTGRID file and read output grid specifications
-  !**********************************************************
+#include "rea_readOHfield.f90"
 
-  open(unitoutgrid,file=path(1)(1:length(1))//'OUTGRID_NEST',form='formatted',status='old',err=999)
+#include "rea_readlanduse.f90"
 
-  ! try namelist input
-  read(unitoutgrid,outgridn,iostat=ios)
-  close(unitoutgrid)
+#include "rea_readoutgrid.f90"
 
-  if ((dxoutn.le.0).or. ios.ne.0) then
+#include "rea_readoutgrid_nest.f90"
 
-    open(unitoutgrid,file=path(1)(1:length(1))//'OUTGRID_NEST',status='old',err=999)
-    call skplin(5,unitoutgrid)
+#include "rea_readpaths.f90"
 
-    ! 1.  Read horizontal grid specifications
-    !****************************************
 
-    call skplin(3,unitoutgrid)
-    read(unitoutgrid,'(4x,f11.4)') outlon0n
-    call skplin(3,unitoutgrid)
-    read(unitoutgrid,'(4x,f11.4)') outlat0n
-    call skplin(3,unitoutgrid)
-    read(unitoutgrid,'(4x,i5)') numxgridn
-    call skplin(3,unitoutgrid)
-    read(unitoutgrid,'(4x,i5)') numygridn
-    call skplin(3,unitoutgrid)
-    read(unitoutgrid,'(4x,f12.5)') dxoutn
-    call skplin(3,unitoutgrid)
-    read(unitoutgrid,'(4x,f12.5)') dyoutn
+#include "rea_readreceptors.f90"
 
-    close(unitoutgrid)
-  endif
-
-  ! write outgrid_nest file in namelist format to output directory if requested
-  if (nmlout.and.lroot) then
-    open(unitoutgrid,file=path(2)(1:length(2))//'OUTGRID_NEST.namelist',err=1000)
-    write(unitoutgrid,nml=outgridn)
-    close(unitoutgrid)
-  endif
-
-  allocate(orooutn(0:numxgridn-1,0:numygridn-1),stat=stat)
-  if (stat.ne.0) write(*,*)'ERROR: could not allocate orooutn'
-  allocate(arean(0:numxgridn-1,0:numygridn-1),stat=stat)
-  if (stat.ne.0) write(*,*)'ERROR: could not allocate arean'
-  allocate(volumen(0:numxgridn-1,0:numygridn-1,numzgrid),stat=stat)
-  if (stat.ne.0) write(*,*)'ERROR: could not allocate volumen'
-
-  ! Check validity of output grid (shall be within model domain)
-  !*************************************************************
-
-  xr=outlon0n+real(numxgridn)*dxoutn
-  yr=outlat0n+real(numygridn)*dyoutn
-  xr1=xlon0+real(nxmin1)*dx
-  yr1=ylat0+real(nymin1)*dy
-  if ((outlon0n+eps.lt.xlon0).or.(outlat0n+eps.lt.ylat0) &
-       .or.(xr.gt.xr1+eps).or.(yr.gt.yr1+eps)) then
-    write(*,*) ' #### FLEXPART MODEL ERROR! PART OF OUTPUT    ####'
-    write(*,*) ' #### NEST IS OUTSIDE MODEL DOMAIN. CHANGE    ####'
-    write(*,*) ' #### FILE OUTGRID IN DIRECTORY               ####'
-    write(*,'(a)') path(1)(1:length(1))
-    stop
-  endif
-
-  xoutshiftn=xlon0-outlon0n
-  youtshiftn=ylat0-outlat0n
-  return
-
-999 write(*,*) ' #### FLEXPART MODEL ERROR! FILE "OUTGRID"    #### '
-  write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY       #### '
-  write(*,'(a)') path(1)(1:length(1))
-  stop
-
-1000 write(*,*) ' #### FLEXPART MODEL ERROR! FILE "OUTGRID"    #### '
-  write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY       #### '
-  write(*,'(a)') path(2)(1:length(2))
-  stop
-end subroutine readoutgrid_nest
-
-subroutine readpaths
-
-  !*****************************************************************************
-  !                                                                            *
-  !     Reads the pathnames, where input/output files are expected to be.      *
-  !     The file pathnames must be available in the current working directory. *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     1 February 1994                                                        *
-  !     last modified                                                          *
-  !     HS, 7.9.2012                                                           *
-  !     option to give pathnames file as command line option                   *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! length(numpath)    lengths of the path names                               *
-  ! path(numpath)      pathnames of input/output files                         *
-  !                                                                            *
-  ! Constants:                                                                 *
-  ! numpath            number of pathnames to be read in                       *
-  !                                                                            *
-  !*****************************************************************************
-
-  implicit none
-
-  integer   :: i
-  character(256) :: string_test 
-  character(1) :: character_test 
-
-  ! Read the pathname information stored in unitpath
-  !*************************************************
-
-  open(unitpath,file=trim(pathfile),status='old',err=999)
-
-  do i=1,numpath
-    read(unitpath,'(a)',err=998) path(i)
-    length(i)=index(path(i),' ')-1
-
-    
-    string_test = path(i)
-    character_test = string_test(length(i):length(i))
-    !print*, 'character_test,  string_test ', character_test,  string_test 
-      if ((character_test .NE. '/') .AND. (i .LT. 4))  then
-         print*, 'WARNING: path not ending in /' 
-         print*, path(i)
-         path(i) = string_test(1:length(i)) // '/'
-         length(i)=length(i)+1
-         print*, 'fix: padded with /' 
-         print*, path(i)
-         print*, 'length(i) increased 1' 
-      endif
-  end do
-
-  ! Check whether any nested subdomains are to be used
-  !***************************************************
-
-  do i=1,maxnests
-  ! ESO 2016 Added 'end'/'err' in case user forgot '====' at end of file and
-  ! maxnests > numbnests
-    read(unitpath,'(a)', end=30, err=30) path(numpath+2*(i-1)+1)
-    read(unitpath,'(a)', end=30, err=30) path(numpath+2*(i-1)+2)
-    if (path(numpath+2*(i-1)+1)(1:5).eq.'=====') goto 30
-    length(numpath+2*(i-1)+1)=index(path(numpath+2*(i-1)+1),' ')-1
-    length(numpath+2*(i-1)+2)=index(path(numpath+2*(i-1)+2),' ')-1
-  end do
-
-
-  ! Determine number of available nested domains
-  !*********************************************
-
-30   numbnests=i-1
-
-  close(unitpath)
-  return
-
-998   write(*,*) ' #### TRAJECTORY MODEL ERROR! ERROR WHILE     #### '
-  write(*,*) ' #### READING FILE PATHNAMES.                 #### '
-  stop
-
-999   write(*,*) ' #### TRAJECTORY MODEL ERROR! FILE "pathnames"#### '
-  write(*,*) ' #### CANNOT BE OPENED IN THE CURRENT WORKING #### '
-  write(*,*) ' #### DIRECTORY.                              #### '
-  stop
-end subroutine readpaths
-
-
-subroutine readreceptors
-
-  !*****************************************************************************
-  !                                                                            *
-  !     This routine reads the user specifications for the receptor points.    *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !     1 August 1996                                                          *
-  !                                                                            *
-  !     HSO, 14 August 2013: Added optional namelist input
-  !     PS, 2/2015: access= -> position=
-  !     PS, 6/2015: variable names, simplify code
-  !     PS, 3/2023: remove position=append, makes no sense for new file        *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! receptorarea(maxreceptor)  area of dx*dy at location of receptor           *
-  ! receptorname(maxreceptor)  names of receptors                              *
-  ! xreceptor,yreceptor  coordinates of receptor points                        *
-  !                                                                            *
-  ! Constants:                                                                 *
-  ! unitreceptor         unit connected to file RECEPTORS                      *
-  !                                                                            *
-  !*****************************************************************************
-
-  implicit none
-
-  integer :: j
-  real :: x,y,xm,ym
-  character(len=10) :: receptor
-
-  integer :: ios
-  real :: xlon,ylat   ! for namelist input, xlon/xlat are used instead of x,y
-
-  ! declare namelist
-!  namelist /nml_receptors/ receptor, xlon, ylat
-  namelist /receptors/ receptor, xlon, ylat
-
-!CPS I comment this out - why should we not have receptor output in bwd runs? 
-  ! For backward runs, do not allow receptor output. Thus, set number of
-  ! receptors to zero
-  !  if (ldirect.lt.0) then
-  !    numreceptor=0
-  !    return
-  !  endif
-
-
-  ! Open the RECEPTORS file and read output grid specifications
-  !************************************************************
-
-  open (unitreceptor,file=trim(path(1))//'RECEPTORS',form='formatted', &
-    status='old',err=999)
-
-! try namelist input
-  xlon = -999. ! we need this to check namelist reading
-  ylat = -999.
-  read (unitreceptor,receptors,iostat=ios)
-!  read (unitreceptor,nml_receptors,iostat=ios)
-!  write (*,*) 'nml_receptors iostat',ios
-!  write (*,nml_receptors)
-   close(unitreceptor)
-
-  ! prepare namelist output if requested
-  if (nmlout) open(unitreceptorout,file=trim(path(2))// &
-    'RECEPTORS.namelist',status='new',err=1000)
-
-  if (ios .gt. 0) then
-    
-    goto 991 ! wrong variable name in namelist
-
-  elseif (ios .eq. 0) then ! read as namelist
-
-    if (nint(xlon) .eq. -999 .or. nint(ylat) .eq. -999) goto 993
-
-! PS: reopen file otherwise first receptor is skipped!
-   open (unitreceptor,file=trim(path(1))//'RECEPTORS',status='old',err=999)
-  
-    j=0
-    do while (ios .eq. 0)
-      j=j+1
-      read(unitreceptor,receptors,iostat=ios)
-!      read(unitreceptor,nml_receptors,iostat=ios)
-      if (ios .eq. 0) then
-        if (j .gt. maxreceptor) then
-          write(*,*) ' #### FLEXPART MODEL ERROR! TOO MANY RECEPTOR #### '
-          write(*,*) ' #### POINTS ARE GIVEN.                       #### '
-          write(*,*) ' #### MAXIMUM NUMBER IS ',maxreceptor,'       #### '
-          write(*,*) ' #### PLEASE MAKE CHANGES IN FILE RECEPTORS   #### '
-        endif
-        receptorname(j)=receptor
-        xreceptor(j)=(xlon-xlon0)/dx       ! transform to grid coordinates
-        yreceptor(j)=(ylat-ylat0)/dy
-        xm=r_earth*cos(ylat*pi/180.)*dx/180.*pi
-        ym=r_earth*dy/180.*pi
-        receptorarea(j)=xm*ym
-      ! write receptors in namelist format to output directory if requested
-        if (nmlout) write(unitreceptorout,nml=receptors)
-!        if (nmlout) write(unitreceptorout,nml=nml_receptors)
-      elseif (ios .gt. 0) then
-        write(*,*) ' ### FLEXPART MODEL ERROR! Error in RECEPTORS namelist ###'
-        stop 'Error in RECEPTORS namelist'
-      else
-        write (*,*) 'receptor read in nml format, ios<0', ios
-        write (*,receptors)
-!        write (*,nml_receptors)
-      endif
-    end do ! end nml receptors reading loop
-
-    numreceptor=j-1
-
-  else ! ios<0 = EOF, read as conventional input file
-
-    open (unitreceptor,file=trim(path(1))//'RECEPTORS',status='old',err=999)
-    call skplin(5,unitreceptor)
-
-    ! Read the names and coordinates of the receptors
-    !************************************************
-
-    j=1
-100 continue
-      read(unitreceptor,*,end=99)
-      read(unitreceptor,*,end=99)
-      read(unitreceptor,*,end=99)
-      read(unitreceptor,'(4x,a16)',end=99) receptor
-      call skplin(3,unitreceptor)
-      read(unitreceptor,'(4x,f11.4)',end=99) xlon
-      call skplin(3,unitreceptor)
-      read(unitreceptor,'(4x,f11.4)',end=99) ylat
-      if (xlon.eq.0. .and. ylat.eq.0. .and. &
-         (receptor .eq. '                ')) then
-        write(*,*) 'WARNING: looks like empty receptor at south pole;'// &
-          ' will be skipped'
-        j=j-1
-        goto 100
-      endif
-
-      if (j .gt. maxreceptor) goto 992
-      
-      receptorname(j)=receptor
-      xreceptor(j)=(xlon-xlon0)/dx       ! transform to grid coordinates
-      yreceptor(j)=(ylat-ylat0)/dy
-      xm=r_earth*cos(ylat*pi/180.)*dx/180.*pi
-      ym=r_earth*dy/180.*pi
-      receptorarea(j)=xm*ym
-      ! write receptors file in namelist format to output directory if requested
-      if (nmlout) write(unitreceptorout,nml=receptors)
-!      if (nmlout) write(unitreceptorout,nml=nml_receptors)
-    goto 100
-
-99  numreceptor=j-1
-
-  endif ! end no-nml / nml bloc
-
-  close (unitreceptor)
-  if (nmlout) close (unitreceptorout)
-
-  return
-
-991 continue
-  write(*,*) '#### FLEXPART ERROR: wrong variable names present'
-  write(*,*) '#### in namelist in file RECEPTORS'
-  write(*,*) '#### note that in v11+ coordinate names are xlon and ylat'
-  
-  stop
-
-992 continue
-  write(*,*) ' #### FLEXPART MODEL ERROR! TOO MANY RECEPTOR #### '
-  write(*,*) ' #### POINTS ARE GIVEN.                       #### '
-  write(*,*) ' #### MAXIMUM NUMBER IS ',maxreceptor,'       #### '
-!        write(*,*) ' #### PLEASE MAKE CHANGES IN FILE RECEPTORS   #### '
-  stop
-
-993 continue
-  write(*,*) '#### FLEXPART ERROR: namelist in file RECEPTORS'
-  write(*,*) '#### first receptor point did not contain xlon and/or ylat'
-  write(*,*) '#### Check your namelist!'
-  stop
-
-999 write(*,*) 'INFORMATION: input file RECEPTORS cannot be opened'
-    write(*,*) 'in directory '//trim(path(1))
-    write(*,*) 'Continuing without RECEPTOR'
-
-  numreceptor=0
-  return
-
-1000 write(*,*) ' #### FLEXPART MODEL ERROR! File "RECEPTORS"      #### '
-  write(*,*)    ' #### cannot be opened in the output directory    #### '
-  write(*,'(a)') ' #### '//trim(path(2))
-  write(*,*)    ' #### either write perm missing or old file exists ###'
-
-  stop
-
-end subroutine readreceptors
-
-subroutine readreleases
-
-  !*****************************************************************************
-  !                                                                            *
-  !     This routine reads the release point specifications for the current    *
-  !     model run. Several release points can be used at the same time.        *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     18 May 1996                                                            *
-  !                                                                            *
-  !     Update: 29 January 2001                                                *
-  !     Release altitude can be either in magl or masl                         *
-  !     HSO, 12 August 2013
-  !     Added optional namelist input
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! decay               decay constant of species                              *
-  ! dquer [um]          mean particle diameters                                *
-  ! dsigma              e.g. dsigma=10 or dsigma=0.1 means that 68% of the mass*
-  !                     are between 0.1*dquer and 10*dquer                     *
-  ! ireleasestart, ireleaseend [s] starting time and ending time of each       *
-  !                     release                                                *
-  ! kindz               1: zpoint is in m agl, 2: zpoint is in m asl, 3: zpoint*
-  !                     is in hPa                                              *
-  ! npart               number of particles to be released                     *
-  ! nspec               number of species to be released                       *
-  ! density [kg/m3]     density of the particles                               *
-  ! rm [s/m]            Mesophyll resistance                                   *
-  ! species             name of species                                        *
-  ! xmass               total mass of each species                             *
-  ! xpoint1,ypoint1     geograf. coordinates of lower left corner of release   *
-  !                     area                                                   *
-  ! xpoint2,ypoint2     geograf. coordinates of upper right corner of release  *
-  !                     area                                                   *
-  ! weta_gas, wetb_gas  parameters for below-cloud scavenging (gas)            *
-  ! crain_aero, csnow_aero  parameters for below-cloud scavenging (aerosol)    *
-  ! ccn_aero, in_aero   parameters for in-cloud scavenging (aerosol)           *
-  ! zpoint1,zpoint2     height range, over which release takes place           *
-  ! num_min_discrete    if less, release cannot be randomized and happens at   *
-  !                     time mid-point of release interval                     *
-  ! lroot               true if serial version, or if MPI and root process     *
-  !                                                                            *
-  !*****************************************************************************
-
-  use point_mod
-  use xmass_mod
-  use drydepo_mod
-
-  implicit none
-
-  integer :: numpartmax,i,j,id1,it1,id2,it2,idum,stat,irel,ispc,nsettle
-  integer,parameter :: num_min_discrete=100
-  real :: releaserate,xdum,cun
-  real(kind=dp) :: jul1,jul2,julm
-  real,parameter :: eps2=1.e-9
-  character(len=50) :: line
-  logical :: old
-
-  ! help variables for namelist reading
-  integer :: numpoints, parts, ios
-  integer*2 :: zkind
-  integer :: idate1, itime1, idate2, itime2
-  real :: lon1,lon2,lat1,lat2,z1,z2
-  character*40 :: comment
-  integer,parameter :: unitreleasesout=2
-  real,allocatable, dimension (:) :: mass
-  integer,allocatable, dimension (:) :: specnum_rel,specnum_rel2
-  real,allocatable,dimension(:) :: vsh,fracth,schmih
-
-  ! declare namelists
-  namelist /releases_ctrl/ &
-       nspec, &
-       specnum_rel
-
-  namelist /release/ &
-       idate1, itime1, &
-       idate2, itime2, &
-       lon1, lon2, &
-       lat1, lat2, &
-       z1, z2, &
-       zkind, &
-       mass, &
-       parts, &
-       comment
-
-  numpoint=0
-
-  ! allocate with maxspec for first input loop
-  allocate(mass(maxspec),stat=stat)
-  if (stat.ne.0) write(*,*)'ERROR: could not allocate mass'
-  allocate(specnum_rel(maxspec),stat=stat)
-  if (stat.ne.0) write(*,*)'ERROR: could not allocate specnum_rel'
-
-  ! presetting namelist releases_ctrl
-  nspec = -1  ! use negative value to determine failed namelist input
-  specnum_rel = 0
-
-  !sec, read release to find how many releasepoints should be allocated
-  open(unitreleases,file=path(1)(1:length(1))//'RELEASES',status='old', &
-    form='formatted',err=999)
-
-  ! check if namelist input provided
-  read(unitreleases,releases_ctrl,iostat=ios)
-
-  ! prepare namelist output if requested
-!  if (nmlout.and.lroot) then
-  if (nmlout) &
-    open(unitreleasesout,file=path(2)(1:length(2))//'RELEASES.namelist', &
-      access='append',status='replace',err=1000)
-
-  if (ios.ne.0 .or. nspec.lt.0) then
-!    if (lroot) write(*,*) 'RELEASE either having unrecognised entries, &
-!      &or in old format, please update to namelist format.'
-    write(*,*) 'RELEASE either having unrecognised entries, &
-      &or in old format, please update to namelist format.'
-      stop
-  else
-    if (ipin.ne.3 .and. ipin.ne.4) then 
-      ! Not necessary to read releases when using part_ic.nc
-      ios=0
-      do while (ios.eq.0) 
-        idate1=-1
-        read(unitreleases,release,iostat=ios)
-        if ((idate1.lt.0).or. ios.ne.0) then
-          ios=1
-        else
-          numpoint=numpoint+1
-        endif
-      end do
-      ios=0
-    else
-      numpoint=1
-    endif
-  endif
-
-  rewind(unitreleases)
-
-  if (nspec.gt.maxspec) goto 994
-
-  ! allocate arrays of matching size for number of species (namelist output)
-  deallocate(mass)
-  allocate(mass(nspec),stat=stat)
-  if (stat.ne.0) write(*,*)'ERROR: could not allocate mass'
-  allocate(specnum_rel2(nspec),stat=stat)
-  if (stat.ne.0) write(*,*)'ERROR: could not allocate specnum_rel2'
-  specnum_rel2=specnum_rel(1:nspec)
-  deallocate(specnum_rel) 
-  ! eso: BUG, crashes here for nspec=12 and maxspec=6,
-  ! TODO: catch error and exit
-  allocate(specnum_rel(nspec),stat=stat)
-  if (stat.ne.0) write(*,*)'ERROR: could not allocate specnum_rel'
-  specnum_rel=specnum_rel2
-  deallocate(specnum_rel2)
-
-  !allocate memory for numpoint releaspoints
-  allocate(ireleasestart(numpoint),stat=stat)
-  if (stat.ne.0) write(*,*)'ERROR: could not allocate ireleasestart'
-  allocate(ireleaseend(numpoint),stat=stat)
-  if (stat.ne.0) write(*,*)'ERROR: could not allocate ireleaseend'
-  allocate(xpoint1(numpoint),stat=stat)
-  if (stat.ne.0) write(*,*)'ERROR: could not allocate xpoint1'
-  allocate(xpoint2(numpoint),stat=stat)
-  if (stat.ne.0) write(*,*)'ERROR: could not allocate xpoint2'
-  allocate(ypoint1(numpoint),stat=stat)
-  if (stat.ne.0) write(*,*)'ERROR: could not allocate ypoint1'
-  allocate(ypoint2(numpoint),stat=stat)
-  if (stat.ne.0) write(*,*)'ERROR: could not allocate ypoint2'
-  allocate(zpoint1(numpoint),stat=stat)
-  if (stat.ne.0) write(*,*)'ERROR: could not allocate zpoint1'
-  allocate(zpoint2(numpoint),stat=stat)
-  if (stat.ne.0) write(*,*)'ERROR: could not allocate zpoint2'
-  allocate(kindz(numpoint),stat=stat)
-  if (stat.ne.0) write(*,*)'ERROR: could not allocate kindz'
-  allocate(xmass(numpoint,maxspec),stat=stat)
-  if (stat.ne.0) write(*,*)'ERROR: could not allocate xmass'
-  allocate(rho_rel(numpoint),stat=stat)
-  if (stat.ne.0) write(*,*)'ERROR: could not allocate rho_rel'
-  allocate(npart(numpoint),stat=stat)
-  if (stat.ne.0) write(*,*)'ERROR: could not allocate npart'
-  allocate(xmasssave(numpoint),stat=stat)
-  if (stat.ne.0) write(*,*)'ERROR: could not allocate xmasssave'
-
-  if (lroot) write (*,*) 'Releasepoints : ', numpoint
-
-  do i=1,numpoint
-    xmasssave(i)=0.
-  end do
-
-  !now save the information
-  DEP=.false.
-  DRYDEP=.false.
-  WETDEP=.false.
-  OHREA=.false.
-  do i=1,maxspec
-    DRYDEPSPEC(i)=.false.
-    WETDEPSPEC(i)=.false.
-  end do
-
-  ! namelist output
-  if (nmlout.and.lroot) then
-    write(unitreleasesout,nml=releases_ctrl)
-  endif
-
-  do i=1,nspec
-    call readspecies(specnum_rel(i),i)
-
-
-  ! Allocate temporary memory necessary for the different diameter bins
-  !********************************************************************
-    allocate(vsh(ndia(i)),fracth(ndia(i)),schmih(ndia(i)))
-
-  ! Molecular weight
-  !*****************
-
-    if (((iout.eq.2).or.(iout.eq.3)).and.(weightmolar(i).lt.0.)) then
-      write(*,*) 'For mixing ratio output, valid molar weight'
-      write(*,*) 'must be specified for all simulated species.'
-      write(*,*) 'Check table SPECIES or choose concentration'
-      write(*,*) 'output instead if molar weight is not known.'
-      stop
-    endif
-
-  ! Radioactive decay
-  !******************
-
-    decay(i)=0.693147/decay(i) !conversion half life to decay constant
-
-
-  ! Dry deposition of gases
-  !************************
-
-    if (reldiff(i).gt.0.) rm(i)=1./(henry(i)/3000.+100.*f0(i))    ! mesophyll resistance
-
-  ! Dry deposition of particles
-  !****************************
-
-    vsetaver(i)=0.
-    cunningham(i)=0.
-    dquer(i)=dquer(i)*1000000.         ! Conversion m to um
-    if (density(i).gt.0.) then         ! Additional parameters
-      call part0(dquer(i),dsigma(i),density(i),ndia(i),fracth,schmih,cun,vsh)
-      do j=1,ndia(i)
-        fract(i,j)=fracth(j)
-        schmi(i,j)=schmih(j)
-        vset(i,j)=vsh(j)
-        cunningham(i)=cunningham(i)+cun*fract(i,j)
-        vsetaver(i)=vsetaver(i)-vset(i,j)*fract(i,j)
-      end do
-      if (lroot) write(*,*) 'Average settling velocity: ',i,vsetaver(i)
-    endif
-
-  ! Dry deposition for constant deposition velocity
-  !************************************************
-
-    dryvel(i)=dryvel(i)*0.01         ! conversion to m/s
-
-  ! Check if wet deposition or OH reaction shall be calculated
-  !***********************************************************
-
-  ! ESO 04.2016 check for below-cloud scavenging (gas or aerosol)
-    if ((dquer(i).le.0..and.(weta_gas(i).gt.0. .or. wetb_gas(i).gt.0.)) .or. &
-         &(dquer(i).gt.0. .and. (crain_aero(i) .gt. 0. .or. csnow_aero(i).gt.0.)))  then
-      WETDEP=.true.
-      WETDEPSPEC(i)=.true.
-      if (lroot) then
-        write (*,*) '  Below-cloud scavenging: ON'
-  !  write (*,*) 'Below-cloud scavenging coefficients: ',weta(i),i
-      end if
-    else
-      if (lroot) write (*,*) '  Below-cloud scavenging: OFF'
-    endif
-
-  ! NIK 31.01.2013 + 10.12.2013 + 15.02.2015
-    if (dquer(i).gt.0..and.(ccn_aero(i).gt.0. .or. in_aero(i).gt.0.))  then
-      WETDEP=.true.
-      WETDEPSPEC(i)=.true.
-      if (lroot) then
-        write (*,*) '  In-cloud scavenging: ON'
-  !        write (*,*) 'In-cloud scavenging coefficients: ',&
-  !           &ccn_aero(i),in_aero(i),i !,wetc_in(i), wetd_in(i),i
-      end if
-    else
-      if (lroot) write (*,*) '  In-cloud scavenging: OFF' 
-    endif
-
-    if (ohcconst(i).gt.0.) then
-      OHREA=.true.
-      if (lroot) write (*,*) '  OHreaction switched on: ',ohcconst(i),i
-    endif
-
-    if ((reldiff(i).gt.0.).or.(density(i).gt.0.).or.(dryvel(i).gt.0.)) then
-      DRYDEP=.true.
-      DRYDEPSPEC(i)=.true.
-    endif
-
-    deallocate(vsh,fracth,schmih)
-  end do ! end loop over species
-
-  if (WETDEP.or.DRYDEP) DEP=.true.
-
-  ! Not necessary to read releases when using part_ic.nc
-  !*****************************************************
-  if ((ipin.eq.3).or.(ipin.eq.4)) then
-    maxpointspec_act=1
-    return 
-  endif
-  
-  ! Read specifications for each release point
-  !*******************************************
-  numpoints=numpoint
-  numpoint=0
-  numpartmax=0
-  releaserate=0.
-101 numpoint=numpoint+1
-
-  if (numpoint.gt.numpoints) goto 250
-  zkind = 1
-  mass = 0
-  parts = 0
-  comment = ' '
-  read(unitreleases,release,iostat=ios)
-  id1=idate1
-  it1=itime1
-  id2=idate2
-  it2=itime2
-  xpoint1(numpoint)=lon1
-  xpoint2(numpoint)=lon2
-  ypoint1(numpoint)=lat1
-  ypoint2(numpoint)=lat2
-  zpoint1(numpoint)=z1
-  zpoint2(numpoint)=z2
-  kindz(numpoint)=zkind
-  do i=1,nspec
-    xmass(numpoint,i)=mass(i)
-  end do
-  npart(numpoint)=parts
-  compoint(min(1001,numpoint))=comment
-
-! namelist output
-  if (nmlout.and.lroot) then
-    write(unitreleasesout,nml=release)
-  endif
-
-  ! If a release point contains no particles, stop and issue error message
-  !***********************************************************************
-
-  if (npart(numpoint).eq.0) then
-    write(*,*) 'FLEXPART MODEL ERROR'
-    write(*,*) 'RELEASES file is corrupt.'
-    write(*,*) 'At least for one release point, there are zero'
-    write(*,*) 'particles released. Make changes to RELEASES.'
-    stop
-  endif
-
-  ! If FLEXPART is run for backward deposition force zpoint
-  !*********************************************************************
-  if (WETBKDEP) then
-    zpoint1(numpoint)=0.
-    zpoint2(numpoint)=20000.
-    kindz(numpoint)=1
-  endif
-  if (DRYBKDEP) then
-    zpoint1(numpoint)=0.
-    zpoint2(numpoint)=2.*href
-    kindz(numpoint)=1
-  endif
-
-
-  ! Check whether x coordinates of release point are within model domain
-  !*********************************************************************
-
-  if (xpoint1(numpoint).lt.xlon0) &
-       xpoint1(numpoint)=xpoint1(numpoint)+360.
-  if (xpoint1(numpoint).gt.xlon0+(nxmin1)*dx) &
-       xpoint1(numpoint)=xpoint1(numpoint)-360.
-  if (xpoint2(numpoint).lt.xlon0) &
-       xpoint2(numpoint)=xpoint2(numpoint)+360.
-  if (xpoint2(numpoint).gt.xlon0+(nxmin1)*dx) &
-       xpoint2(numpoint)=xpoint2(numpoint)-360.
-
-  ! Determine relative beginning and ending times of particle release
-  !******************************************************************
-
-  jul1=juldate(id1,it1)
-  jul2=juldate(id2,it2)
-  julm=(jul1+jul2)/2.
-  if (jul1.gt.jul2) then
-    write(*,*) 'FLEXPART MODEL ERROR'
-    write(*,*) 'Release stops before it begins.'
-    write(*,*) 'Make changes to file RELEASES.'
-    stop
-  endif
-  if (mdomainfill.eq.0) then   ! no domain filling
-    if (ldirect.eq.1) then
-      if (((jul1.lt.bdate).or.(jul2.gt.edate)).and.(ipin.eq.0)) then
-        write(*,*) 'FLEXPART MODEL ERROR'
-        write(*,*) 'Release starts before simulation begins or ends'
-        write(*,*) 'after simulation stops.'
-        write(*,*) 'Make files COMMAND and RELEASES consistent.'
-        stop
-      endif
-      if (npart(numpoint).gt.num_min_discrete) then
-        ireleasestart(numpoint)=int((jul1-bdate)*86400.)
-        ireleaseend(numpoint)=int((jul2-bdate)*86400.)
-      else
-        ireleasestart(numpoint)=int((julm-bdate)*86400.)
-        ireleaseend(numpoint)=int((julm-bdate)*86400.)
-      endif
-    else if (ldirect.eq.-1) then
-      if (((jul1.lt.edate).or.(jul2.gt.bdate)).and.(ipin.eq.0)) then
-        write(*,*) 'FLEXPART MODEL ERROR'
-        write(*,*) 'Release starts before simulation begins or ends'
-        write(*,*) 'after simulation stops.'
-        write(*,*) 'Make files COMMAND and RELEASES consistent.'
-        stop
-      endif
-      if (npart(numpoint).gt.num_min_discrete) then
-        ireleasestart(numpoint)=int((jul1-bdate)*86400.)
-        ireleaseend(numpoint)=int((jul2-bdate)*86400.)
-      else
-        ireleasestart(numpoint)=int((julm-bdate)*86400.)
-        ireleaseend(numpoint)=int((julm-bdate)*86400.)
-      endif
-    endif
-  endif
-
-
-  ! Determine the release rate (particles per second) and total number
-  ! of particles released during the simulation
-  !*******************************************************************
-
-  if (ireleasestart(numpoint).ne.ireleaseend(numpoint)) then
-    releaserate=releaserate+real(npart(numpoint))/ &
-         real(ireleaseend(numpoint)-ireleasestart(numpoint))
-  else
-    releaserate=99999999
-  endif
-  numpartmax=numpartmax+npart(numpoint)
-  goto 101
-
-250 close(unitreleases)
-
-  if (nmlout.and.lroot) then
-    close(unitreleasesout)
-  endif
-
-  !if (lroot) write (*,*) 'Particles allocated (maxpart)  : ',maxpart
-  if (lroot) write (*,*) 'Particles released (numpartmax): ',numpartmax
-  numpoint=numpoint-1
-
-  if (ioutputforeachrelease.eq.1) then
-    maxpointspec_act=numpoint
-  else
-    maxpointspec_act=1
-  endif
-
-  ! Disable settling if more than 1 species at any release point
-  ! or if MQUASILAG and more than one species
-  !*************************************************************
-
-  if (mquasilag.ne.0) then
-    if (nspec.gt.1) lsettling=.false.
-  else
-    do irel=1,numpoint
-      nsettle=0
-      do ispc=1,nspec
-        if (xmass(irel,ispc).gt.eps2) nsettle=nsettle+1
-      end do
-      if (nsettle.gt.1) lsettling=.false.
-    end do
-  end if
-
-  if (lroot) then
-    if (.not.lsettling) then 
-      write(*,*) 'WARNING: more than 1 species per release point, settling &
-           &disabled'
-    end if
-  end if
-
-  ! Check, whether the total number of particles may exceed totally allowed
-  ! number of particles at some time during the simulation
-  !************************************************************************
-
-  ! if (releaserate.gt. &
-  !      0.99*real(maxpart)/real(lage(nageclass))) then
-  !   if (numpartmax.gt.maxpart.and.lroot) then
-  !     write(*,*) '#####################################################'
-  !     write(*,*) '#### FLEXPART MODEL SUBROUTINE READRELEASES:     ####'
-  !     write(*,*) '####                                             ####'
-  !     write(*,*) '####WARNING - TOTAL NUMBER OF PARTICLES SPECIFIED####'
-  !     write(*,*) '#### IN FILE "RELEASES" MAY AT SOME POINT DURING ####'
-  !     write(*,*) '#### THE SIMULATION EXCEED THE MAXIMUM ALLOWED   ####'
-  !     write(*,*) '#### NUMBER (MAXPART).IF RELEASES DO NOT OVERLAP,####'
-  !     write(*,*) '#### FLEXPART CAN POSSIBLY COMPLETE SUCCESSFULLY.####'
-  !     write(*,*) '#### HOWEVER, FLEXPART MAY HAVE TO STOP          ####'
-  !     write(*,*) '#### AT SOME TIME DURING THE SIMULATION. PLEASE  ####'
-  !     write(*,*) '#### MAKE SURE THAT YOUR SETTINGS ARE CORRECT.   ####'
-  !     write(*,*) '#####################################################'
-  !     write(*,*) 'Maximum release rate may be: ',releaserate, &
-  !          ' particles per second'
-  !     write(*,*) 'Maximum allowed release rate is: ', &
-  !          real(maxpart)/real(lage(nageclass)),' particles per second'
-  !     write(*,*) &
-  !          'Total number of particles released during the simulation is: ', &
-  !          numpartmax
-  !     write(*,*) 'Maximum allowed number of particles is: ',maxpart
-  !   endif
-  ! endif
-
-
-  if (lroot) then
-    write(*,FMT='(A,ES14.7)') ' Total mass released:', sum(xmass(1:numpoint,1:nspec))
-  end if
-
-  return
-
-994 write(*,*) '#####################################################'
-  write(*,*) '#### FLEXPART MODEL SUBROUTINE READRELEASES:     ####'
-  write(*,*) '####                                             ####'
-  write(*,*) '#### ERROR - MAXIMUM NUMBER OF EMITTED SPECIES IS####'
-  write(*,*) '#### TOO LARGE. PLEASE REDUCE NUMBER OF SPECIES. ####'
-  write(*,*) '#####################################################'
-  stop
-
-998 write(*,*) '#####################################################'
-  write(*,*) '#### FLEXPART MODEL SUBROUTINE READRELEASES:     ####'
-  write(*,*) '####                                             ####'
-  write(*,*) '#### FATAL ERROR - FILE "RELEASES" IS            ####'
-  write(*,*) '#### CORRUPT. PLEASE CHECK YOUR INPUTS FOR       ####'
-  write(*,*) '#### MISTAKES OR GET A NEW "RELEASES"-           ####'
-  write(*,*) '#### FILE ...                                    ####'
-  write(*,*) '#####################################################'
-  stop
-
-
-999 write(*,*) '#####################################################'
-  write(*,*) '   FLEXPART MODEL SUBROUTINE READRELEASES: '
-  write(*,*)
-  write(*,*) 'FATAL ERROR - FILE CONTAINING PARTICLE RELEASE POINTS'
-  write(*,*) 'POINTS IS NOT AVAILABLE OR YOU ARE NOT'
-  write(*,*) 'PERMITTED FOR ANY ACCESS'
-  write(*,*) '#####################################################'
-  stop
-
-1000 write(*,*) ' #### FLEXPART MODEL ERROR! FILE "RELEASES"    #### '
-  write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY       #### '
-  write(*,'(a)') path(2)(1:length(2))
-  stop
-end subroutine readreleases
-
-subroutine readspecies(id_spec,pos_spec)
-
-  !*****************************************************************************
-  !                                                                            *
-  !     This routine reads names and physical constants of chemical species/   *
-  !     radionuclides given in the parameter pos_spec                          *
-  !                                                                            *
-  !   Author: A. Stohl                                                         *
-  !                                                                            *
-  !   11 July 1996                                                             *
-  !                                                                            *
-  !   Changes:                                                                 *
-  !   N. Kristiansen, 31.01.2013: Including parameters for in-cloud scavenging *
-  !                                                                            *
-  !   HSO, 13 August 2013
-  !   added optional namelist input
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! decaytime(maxtable)   half time for radiological decay                     *
-  ! specname(maxtable)    names of chemical species, radionuclides             *
-  ! weta_gas, wetb_gas    Parameters for below-cloud scavenging of gasses      *
-  ! crain_aero,csnow_aero Parameters for below-cloud scavenging of aerosols    *
-  ! ccn_aero,in_aero      Parameters for in-cloud scavenging of aerosols       *
-  ! ohcconst              OH reaction rate constant C                          *
-  ! ohdconst              OH reaction rate constant D                          *
-  ! ohnconst              OH reaction rate constant n                          *
-  ! id_spec               SPECIES number as referenced in RELEASE file         *
-  ! id_pos                position where SPECIES data shall be stored          *
-  ! ni                    Number of diameter classes of particles              *                                                              *
-  ! Constants:                                                                 *
-  !                                                                            *
-  !*****************************************************************************
-
-  implicit none
-
-  integer :: i, pos_spec,j
-  integer :: idow,ihour,id_spec
-  character(len=3) :: aspecnumb
-  logical :: spec_found
-
-  character(len=16) :: pspecies
-  real :: pdecay, pweta_gas, pwetb_gas, preldiff, phenry, pf0, pdensity, pdquer
-  real :: pdsigma, pdryvel, pweightmolar, pohcconst, pohdconst, pohnconst
-  real :: pcrain_aero, pcsnow_aero, pccn_aero, pin_aero
-  real :: parea_dow(7), parea_hour(24), ppoint_dow(7), ppoint_hour(24)
-  integer :: pndia
-  integer :: ios
-  integer :: pshape,porient
-  ! Daria Tatsii: species shape properties
-  real ::pla,pia,psa,f,e,paspectratio
-  real :: la(maxspec),ia(maxspec),sa(maxspec) ! Axes
-
-  ! declare namelist
-  namelist /species_params/ &
-       pspecies, pdecay, pweta_gas, pwetb_gas, &
-       pcrain_aero, pcsnow_aero, pccn_aero, pin_aero, &
-       preldiff, phenry, pf0, pdensity, pdquer, &
-       pdsigma, pndia, pdryvel, pweightmolar, pohcconst, pohdconst, pohnconst, &
-       parea_dow, parea_hour, ppoint_dow, ppoint_hour, &
-       pshape, paspectratio, pla, pia, psa, porient
-
-  pspecies="" ! read failure indicator value
-  pdecay=-999.9
-  pweta_gas=-9.9E-09
-  pwetb_gas=0.0
-  pcrain_aero=-9.9E-09
-  pcsnow_aero=-9.9E-09
-  pccn_aero=-9.9E-09
-  pin_aero=-9.9E-09
-  preldiff=-9.9
-  phenry=0.0
-  pf0=0.0
-  pdensity=-9.9E09
-  pdquer=0.0
-  pdsigma=0.0
-  pndia=1
-  pdryvel=-9.99
-  pohcconst=-9.99
-  pohdconst=-9.9E-09
-  pohnconst=2.0
-  pweightmolar=-999.9
-  parea_dow=-999.9
-  parea_hour=-999.9
-  ppoint_dow=-999.9
-  ppoint_hour=-999.9
-  pshape=0 ! 0 for sphere, 1 for other shapes
-  paspectratio=-1.
-  pla=-1. ! longest axis in micrometer
-  pia=-1. ! Intermediate axis
-  psa=-1. ! Smallest axis
-  porient=0 ! 0 for horizontal, 1 for random
-
-
-  do j=1,24           ! initialize everything to no variation
-    parea_hour(j)=1.
-    ppoint_hour(j)=1.
-    area_hour(pos_spec,j)=1.
-    point_hour(pos_spec,j)=1.
-  end do
-  do j=1,7
-    parea_dow(j)=1.
-    ppoint_dow(j)=1.
-    area_dow(pos_spec,j)=1.
-    point_dow(pos_spec,j)=1.
-  end do
-
-  ! Open the SPECIES file and read species names and properties
-  !************************************************************
-  specnum(pos_spec)=id_spec
-  write(aspecnumb,'(i3.3)') specnum(pos_spec)
-  open(unitspecies,file=path(1)(1:length(1))//'SPECIES/SPECIES_'//aspecnumb, &
-    status='old',form='formatted',err=998)
-  !write(*,*) 'reading SPECIES',specnum(pos_spec)
-
-  ASSSPEC=.FALSE.
-
-  ! try namelist input
-  read(unitspecies,species_params,iostat=ios)
-  close(unitspecies)
-
-  if ((len(trim(pspecies)).eq.0).or. ios.ne.0) then ! no namelist found
-    if (lroot) write(*,*) "SPECIES file not in NAMELIST format, attempting to &
-         &read as fixed format"
-
-    ios=1
-
-    open(unitspecies,file=path(1)(1:length(1))//'SPECIES/SPECIES_'//aspecnumb, &
-      status='old',err=998)
-
-    do i=1,6
-      read(unitspecies,*)
-    end do
-
-    read(unitspecies,'(a10)',end=22) species(pos_spec)
-  !  write(*,*) species(pos_spec)
-    read(unitspecies,'(f18.1)',end=22) decay(pos_spec)
-  !  write(*,*) decay(pos_spec)
-    read(unitspecies,'(e18.1)',end=22) weta_gas(pos_spec)
-  !  write(*,*) weta_gas(pos_spec)
-    read(unitspecies,'(f18.2)',end=22) wetb_gas(pos_spec)
-  !  write(*,*) wetb_gas(pos_spec)
-    read(unitspecies,'(e18.1)',end=22) crain_aero(pos_spec)
-  !  write(*,*) crain_aero(pos_spec)
-    read(unitspecies,'(f18.2)',end=22) csnow_aero(pos_spec)
-  !  write(*,*) csnow_aero(pos_spec)
-  !*** NIK 31.01.2013: including in-cloud scavening parameters
-    read(unitspecies,'(e18.1)',end=22) ccn_aero(pos_spec)
-  !  write(*,*) ccn_aero(pos_spec)
-    read(unitspecies,'(f18.2)',end=22) in_aero(pos_spec)
-  !  write(*,*) in_aero(pos_spec)
-    read(unitspecies,'(f18.1)',end=22) reldiff(pos_spec)
-  !  write(*,*) reldiff(pos_spec)
-    read(unitspecies,'(e18.1)',end=22) henry(pos_spec)
-  !  write(*,*) henry(pos_spec)
-    read(unitspecies,'(f18.1)',end=22) f0(pos_spec)
-  !  write(*,*) f0(pos_spec)
-    read(unitspecies,'(e18.1)',end=22) density(pos_spec)
-  !  write(*,*) density(pos_spec)
-    read(unitspecies,'(e18.1)',end=22) dquer(pos_spec)
-  !  write(*,*) 'dquer(pos_spec):', dquer(pos_spec)
-    read(unitspecies,'(e18.1)',end=22) dsigma(pos_spec)
-  !  write(*,*) dsigma(pos_spec)
-    read(unitspecies,'(i16)',end=22) ndia(pos_spec)
-    ! write(*,*) ndia(pos_spec)
-    read(unitspecies,'(f18.2)',end=22) dryvel(pos_spec)
-  !  write(*,*) dryvel(pos_spec)
-    read(unitspecies,'(f18.2)',end=22) weightmolar(pos_spec)
-  !  write(*,*) weightmolar(pos_spec)
-    read(unitspecies,'(e18.2)',end=22) ohcconst(pos_spec)
-  !  write(*,*) ohcconst(pos_spec)
-    read(unitspecies,'(f8.2)',end=22) ohdconst(pos_spec)
-  !  write(*,*) ohdconst(pos_spec)
-    read(unitspecies,'(f8.2)',end=22) ohnconst(pos_spec)
-  !  write(*,*) ohnconst(pos_spec)
-
-  ! Read in daily and day-of-week variation of emissions, if available
-  !*******************************************************************
-
-    read(unitspecies,*,end=22)
-    do j=1,24     ! 24 hours, starting with 0-1 local time
-      read(unitspecies,*) ihour,area_hour(pos_spec,j),point_hour(pos_spec,j)
-    end do
-    read(unitspecies,*)
-    do j=1,7      ! 7 days of the week, starting with Monday
-      read(unitspecies,*) idow,area_dow(pos_spec,j),point_dow(pos_spec,j)
-    end do
-
-    pspecies=species(pos_spec)
-    pdecay=decay(pos_spec)
-    pweta_gas=weta_gas(pos_spec)
-    pwetb_gas=wetb_gas(pos_spec)
-    pcrain_aero=crain_aero(pos_spec)
-    pcsnow_aero=csnow_aero(pos_spec)
-    pccn_aero=ccn_aero(pos_spec)
-    pin_aero=in_aero(pos_spec)
-    preldiff=reldiff(pos_spec)
-    phenry=henry(pos_spec)
-    pf0=f0(pos_spec)
-    pdensity=density(pos_spec)
-    pdquer=dquer(pos_spec)
-    pdsigma=dsigma(pos_spec)
-    pndia=ndia(pos_spec)
-    pdryvel=dryvel(pos_spec)
-    pweightmolar=weightmolar(pos_spec)
-    pohcconst=ohcconst(pos_spec)
-    pohdconst=ohdconst(pos_spec)
-    pohnconst=ohnconst(pos_spec)
-
-
-    do j=1,24     ! 24 hours, starting with 0-1 local time
-      parea_hour(j)=area_hour(pos_spec,j)
-      ppoint_hour(j)=point_hour(pos_spec,j)
-    end do
-    do j=1,7      ! 7 days of the week, starting with Monday
-      parea_dow(j)=area_dow(pos_spec,j)
-      ppoint_dow(j)=point_dow(pos_spec,j)
-    end do
-
-  else ! namelist available
-
-    species(pos_spec)=pspecies
-    decay(pos_spec)=pdecay
-    weta_gas(pos_spec)=pweta_gas
-    wetb_gas(pos_spec)=pwetb_gas
-    crain_aero(pos_spec)=pcrain_aero
-    csnow_aero(pos_spec)=pcsnow_aero
-    ccn_aero(pos_spec)=pccn_aero
-    in_aero(pos_spec)=pin_aero
-    reldiff(pos_spec)=preldiff
-    henry(pos_spec)=phenry
-    f0(pos_spec)=pf0
-    density(pos_spec)=pdensity
-    dquer(pos_spec)=pdquer
-    dsigma(pos_spec)=pdsigma
-    ndia(pos_spec)=pndia
-    dryvel(pos_spec)=pdryvel
-    weightmolar(pos_spec)=pweightmolar
-    ohcconst(pos_spec)=pohcconst
-    ohdconst(pos_spec)=pohdconst
-    ohnconst(pos_spec)=pohnconst
-    shape(pos_spec)=pshape
-    orient(pos_spec)=porient
-
-
-    ! Daria Tatsii 2023: compute particle shape dimensions
-    if (shape(pos_spec).ge.1) then ! Compute shape according to given axes
-      select case (shape(pos_spec))
-        case (1)
-          write(*,*) "Particle shape USER-DEFINED for particle", id_spec
-          if ((psa.le.0.0).or.(pia.le.0.0).or.(pla.le.0.0)) then
-            write(*,*) "#### ERROR: Shape=1 (user-defined) is chosen, &
-              &but no valid axes are provided."
-            write(*,*) "#### SPECIES file requires SA, IA, and LA parameter&
-              &greater than zero."
-            stop
-          endif
-          write(*,*) "SA,IA,LA:",psa,pia,pla
-        case (2) ! Cylinders (fibers) !
-          if (paspectratio.le.0.0) then
-            write(*,*) "#### ERROR: Shape=2 cylinder is chosen, but no valid apect ratio is provided."
-            write(*,*) "#### SPECIES file requires ASPECTRATIO parameter greater than zero."
-            stop
-          endif
-          psa=(((dquer(pos_spec)**3.0)*2.0)/ &
-                  (3.0*paspectratio))**(1.0/3.0)
-          pia=psa
-          pla=psa*paspectratio
-          write(*,*) "Particle shape CYLINDER for particle", id_spec
-          write(*,*) "SA,IA,LA:",psa,pia,pla
-        case (3) ! Cubes !
-          write(*,*) "Particle shape CUBE for particle", id_spec
-          psa=((dquer(pos_spec)**3)*pi/6.0)**(1.0/3.0)
-          pia=(2.0**0.5)*psa
-          pla=(3.0**0.5)*psa
-          if ((psa.le.0.0).or.(pia.le.0.0).or.(pla.le.0.0)) then
-            write(*,*) "#### ERROR: Shape=3 (user-defined) is chosen, but no valid axes are provided."
-            write(*,*) "#### SPECIES file requires SA, IA, and LA parameter greater than zero."
-            stop
-          endif
-          write(*,*) "SA,IA,LA:",psa,pia,pla
-        case (4) ! Tetrahedrons !
-          write(*,*) "Particle shape TETRAHEDRON for particle", id_spec
-          pla=((dquer(pos_spec)**3)*pi*2**(0.5))**(1.0/3.0)
-          pia=pla*((3.0/4.0)**(0.5))
-          psa=pla*((2.0/3.0)**(0.5))
-          if ((psa.le.0.0).or.(pia.le.0.0).or.(pla.le.0.0)) then
-            write(*,*) "#### ERROR: Shape=4 (user-defined) is chosen, but no valid axes are provided."
-            write(*,*) "#### SPECIES file requires SA, IA, and LA parameter greater than zero."
-            stop
-          endif
-          write(*,*) "SA,IA,LA:",psa,pia,pla
-        case (5) ! Octahedrons !
-          write(*,*) "Particle shape OCTAHEDRON for particle", id_spec
-          psa=dquer(pos_spec)*(pi/(2.0*2.0**(0.5)))**3
-          pia=psa
-          pla=psa*(2.0**(0.5))
-          if ((psa.le.0.0).or.(pia.le.0.0).or.(pla.le.0.0)) then
-            write(*,*) "#### ERROR: Shape=5 (user-defined) is chosen, but no valid axes are provided."
-            write(*,*) "#### SPECIES file requires SA, IA, and LA parameter greater than zero."
-            stop
-          endif
-          write(*,*) "SA,IA,LA:",psa,pia,pla
-        case (6) ! Ellipsoids !
-          write(*,*) "Particle shape ELLIPSOID for particle", id_spec
-          psa=dquer(pos_spec)/(2.0**(1.0/3.0)) 
-          pia=psa
-          pla=2*pia
-          if ((psa.le.0.0).or.(pia.le.0.0).or.(pla.le.0.0)) then
-            write(*,*) "#### ERROR: Shape=6 (user-defined) is chosen, but no valid axes are provided."
-            write(*,*) "#### SPECIES file requires SA, IA, and LA parameter greater than zero."
-            stop
-          endif
-          write(*,*) "SA,IA,LA:",psa,pia,pla
-      end select
-
-      ! When using the shape option, dquer is the sphere equivalent diameter
-      f=psa/pia
-      e=pia/pla
-      Fn(pos_spec)=f*f*e*((dquer(pos_spec))**3)/(psa*pia*pla) ! Newton's regime
-      Fs(pos_spec)=f*e**(1.3)*(dquer(pos_spec)**3/(psa*pia*pla)) ! Stokes' regime  
-    else ! Spheres
-      write(*,*) "Particle shape SPHERE for particle", id_spec
-    endif
-
-    do j=1,24     ! 24 hours, starting with 0-1 local time
-      area_hour(pos_spec,j)=parea_hour(j)
-      point_hour(pos_spec,j)=ppoint_hour(j)
-    end do
-    do j=1,7      ! 7 days of the week, starting with Monday
-      area_dow(pos_spec,j)=parea_dow(j)
-      point_dow(pos_spec,j)=ppoint_dow(j)
-    end do
-  endif
-
-  i=pos_spec
-
-  !NIK 16.02.2015
-  ! Check scavenging parameters given in SPECIES file
-
-  if (lroot) then
-  ! ZHG 2016.04.07 Start of changes
-    write(*,*) ' '
-    if (dquer(pos_spec) .gt.0)  write(*,'(a,i3,a,a,a)')       ' SPECIES: ', &
-         id_spec,'  ', species(pos_spec),'  (AEROSOL) '
-    if (dquer(pos_spec) .le.0)  write(*,'(a,i3,a,a,a)')       ' SPECIES: ', &
-         id_spec,'  ', species(pos_spec),'  (GAS) '
-
-  ! Particles
-  !**********
-    if (dquer(pos_spec).gt.0) then
-      if (ccn_aero(pos_spec) .gt. 0) then
-        write(*,'(a,f5.2)') '  Particle CCN  efficiency (CCNeff):', ccn_aero(pos_spec)
-      else 
-        write(*,'(a)')      '  Particle CCN  efficiency (CCNeff):   OFF'
-      endif
-      if (in_aero(pos_spec) .gt. 0) then
-        write(*,'(a,f5.2)') '  Particle  IN  efficiency (INeff) :', in_aero(pos_spec)
-      else
-        write(*,'(a)')      '  Particle  IN  efficiency (INeff) :   OFF'
-      endif
-      if (crain_aero(pos_spec) .gt. 0) then
-        write(*,'(a,f5.2)') '  Particle Rain efficiency (Crain) :', crain_aero(pos_spec)
-      else
-        write(*,'(a)')      '  Particle Rain efficiency (Crain) :   OFF'
-      endif
-      if (csnow_aero(pos_spec) .gt. 0) then
-        write(*,'(a,f5.2)') '  Particle Snow efficiency (Csnow) :', csnow_aero(pos_spec)
-      else
-        write(*,'(a)')      '  Particle Snow efficiency (Csnow) :   OFF'
-      end if
-      if (density(pos_spec) .gt. 0) then
-        write(*,'(a)') '  Dry deposition is turned         :   ON'
-        if (reldiff(pos_spec).gt.0) then
-           stop 'density>0 (SPECIES is a particle) implies reldiff <=0  '
-        endif
-      else
-        if (reldiff(pos_spec).le.0) then
-           stop 'density<=0 (SPECIES is a gas) implies reldiff >0  '
-        endif      
-        write(*,'(a)') '  Dry deposition is (density<0)    :   OFF'
-      end if
-      if (crain_aero(pos_spec).gt.10.0 .or. csnow_aero(pos_spec).gt.10.0 .or. &
-           &ccn_aero(pos_spec).gt.1.0 .or. in_aero(pos_spec).gt.1.0) then
-        write(*,*) '*******************************************'
-        write(*,*) ' WARNING: Particle Scavenging parameter likely out of range '
-        write(*,*) '       Likely   range for Crain    0.0-10'
-        write(*,*) '       Likely   range for Csnow    0.0-10'
-        write(*,*) '       Physical range for CCNeff   0.0-1'
-        write(*,*) '       Physical range for INeff    0.0-1'
-        write(*,*) '*******************************************'
-      end if
-    else
-  ! Gas
-  !****
-      if (weta_gas(pos_spec) .gt. 0 .and. wetb_gas(pos_spec).gt.0) then
-        write(*,*)          '  Wet removal for gases      is turned: ON'
-        write(*,*)          '  Gas below-cloud scavenging parameter A  ', &
-             &weta_gas(pos_spec)
-        write(*,'(a,f5.2)') '  Gas below-cloud scavenging parameter B  ', &
-             &wetb_gas(pos_spec)
-      else
-        write(*,*)          '  Wet removal for gases      is turned: OFF '
-      end if
-      if (reldiff(i).gt.0.) then
-        write(*,*)          '  Dry deposition for gases   is turned: ON '
-      else
-        write(*,*)          '  Dry deposition for gases   is turned: OFF '
-      end if
-      if (weta_gas(pos_spec).gt.0.) then !if wet deposition is turned on
-        if (weta_gas(pos_spec).gt.1E-04 .or. weta_gas(pos_spec).lt.1E-09 .or. &
-             &wetb_gas(pos_spec).gt.0.8 .or. wetb_gas(pos_spec).lt.0.4) then
-          write(*,*) '*******************************************'
-          write(*,*) ' WARNING: Gas below-cloud scavengig is out of likely range'
-          write(*,*) '          Likely range for A is 1E-04 to 1E-08'
-          write(*,*) '          Likely range for B is 0.60  to 0.80 ' 
-          write(*,*) '*******************************************'
-        end if
-      endif
-
-      if (((weta_gas(pos_spec).gt.0).or.(wetb_gas(pos_spec).gt.0)).and.&
-           &(henry(pos_spec).le.0)) then
-        if (dquer(pos_spec).le.0) goto 996 ! no particle, no henry set
-      endif
-    end if
-  end if
-
-  if (ndia(pos_spec).gt.maxndia) then
-    write(*,*) 'NDIA in SPECIES file', pos_spec, 'set to', ndia(pos_spec), 'larger than maxndia', &
-      maxndia, 'set in par_mod.f90'
-  endif
-  !  if (dsigma(i).eq.0.) dsigma(i)=1.0001   ! avoid floating exception
-  if (dquer(i).gt.0 .and. dsigma(i).le.1.) then !dsigma(i)=1.0001   ! avoid floating exception
-    !write(*,*) '#### FLEXPART MODEL ERROR!                      ####'
-    write(*,*) '#### FLEXPART MODEL WARNING                     ####'
-    write(*,*) '#### in SPECIES_',aspecnumb, '                             ####'
-    write(*,*) '#### from v10.4 dsigma has to be larger than 1  ####'  
-    write(*,*) '#### to adapt older SPECIES files,              ####' 
-    write(*,*) '#### if dsigma was < 1                          ####' 
-    write(*,*) '#### use the reciprocal of the old dsigma       ####'  
-    if (.not.debug_mode) then 
-       stop
-    else
-       write(*,*) 'debug mode: continue'
-    endif
-  endif
-
-  if ((reldiff(i).gt.0.).and.(density(i).gt.0.)) then
-    write(*,*) '#### FLEXPART MODEL ERROR! FILE "SPECIES"    ####'
-    write(*,*) '#### IS CORRUPT. SPECIES CANNOT BE BOTH      ####'
-    write(*,*) '#### PARTICLE AND GAS.                       ####'
-    write(*,*) '#### SPECIES NUMBER',aspecnumb
-    stop
-  endif
-20 continue
-
-
-22 close(unitspecies)
-
-! namelist output if requested
-  if (nmlout.and.lroot) then
-    open(unitspecies,file=path(2)(1:length(2))//'SPECIES_'//aspecnumb//'.namelist',access='append',status='replace',err=1000)
-    write(unitspecies,nml=species_params)
-    close(unitspecies)
-  endif
-
-  return
-
-996 write(*,*) '#####################################################'
-  write(*,*) '#### FLEXPART MODEL ERROR!                      #### '
-  write(*,*) '#### WET DEPOSITION SWITCHED ON, BUT NO HENRYS  #### '
-  write(*,*) '#### CONSTANT IS SET                            ####'
-  write(*,*) '#### PLEASE MODIFY SPECIES DESCR. FILE!        #### '
-  write(*,*) '#####################################################'
-  stop
-
-
-997 write(*,*) '#####################################################'
-  write(*,*) '#### FLEXPART MODEL ERROR!                      #### '
-  write(*,*) '#### THE ASSSOCIATED SPECIES HAS TO BE DEFINED  #### '
-  write(*,*) '#### BEFORE THE ONE WHICH POINTS AT IT          #### '
-  write(*,*) '#### PLEASE CHANGE ORDER IN RELEASES OR ADD     #### '
-  write(*,*) '#### THE ASSOCIATED SPECIES IN RELEASES         #### '
-  write(*,*) '#####################################################'
-  stop
-
-
-998 write(*,*) '#####################################################'
-  write(*,*) '#### FLEXPART MODEL ERROR!                      #### '
-  write(*,*) '#### THE SPECIES FILE FOR SPECIES ', id_spec
-  write(*,*) '#### CANNOT BE FOUND: CREATE FILE'
-  write(*,*) '#### ',path(1)(1:length(1)),'SPECIES/SPECIES_',aspecnumb
-  write(*,*) '#####################################################'
-  stop
-
-1000 write(*,*) ' #### FLEXPART MODEL ERROR! FILE "SPECIES_',aspecnumb,'.namelist'
-  write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY       #### '
-  write(*,'(a)') path(2)(1:length(2))
-  stop
-end subroutine readspecies
-
-subroutine readpartoptions
-
-  !*****************************************************************************
-  !                                                                            *
-  !     This routine reads the age classes to be used for the current model    *
-  !     run.                                                                   *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !     20 March 2000                                                          *
-  !     HSO, 1 July 2014                                                       *
-  !     Added optional namelist input                                          *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  !                                                                            *
-  ! Constants:                                                                 *
-  !                                                                            *
-  !*****************************************************************************
-
-  implicit none
-
-  integer :: i,np
-
-  ! namelist help variables
-  integer :: ios
-
-  logical ::                      &
-    longitude=.false.,            &
-    longitude_average=.false.,    &
-    latitude=.false.,             &
-    latitude_average=.false.,     &
-    height=.false.,               &
-    height_average=.false.,       &
-    pv=.false.,                   &
-    pv_average=.false.,           &
-    qv=.false.,                   &
-    qv_average=.false.,           &
-    density=.false.,              &
-    density_average=.false.,      &
-    temperature=.false.,          &
-    temperature_average=.false.,  &
-    pressure=.false.,             &
-    pressure_average=.false.,     &
-    mixingheight=.false.,         &
-    mixingheight_average=.false., &
-    tropopause=.false.,           &
-    tropopause_average=.false.,   &
-    topography=.false.,           &
-    topography_average=.false.,   &
-    mass=.false.,                 &
-    mass_average=.false.,         &
-    u=.false.,                    &
-    u_average=.false.,            &
-    v=.false.,                    &
-    v_average=.false.,            &
-    w=.false.,                    &
-    w_average=.false.,            &
-    vsettling=.false.,            &
-    vsettling_average=.false.,    &
-    wetdeposition=.false.,        &
-    drydeposition=.false.
-
-  ! namelist declaration
-  namelist /partoptions/  &
-    longitude,            &
-    longitude_average,    &
-    latitude,             &
-    latitude_average,     &
-    height,               &
-    height_average,       &
-    pv,                   &
-    pv_average,           &
-    qv,                   &
-    qv_average,           &
-    density,              &
-    density_average,      &
-    temperature,          &
-    temperature_average,  &
-    pressure,             &
-    pressure_average,     &
-    mixingheight,         &
-    mixingheight_average, &
-    tropopause,           &
-    tropopause_average,   &
-    topography,           &
-    topography_average,   &
-    mass,                 &
-    mass_average,         &
-    u,                    &
-    u_average,            &
-    v,                    &
-    v_average,            &
-    w,                    &
-    w_average,            &
-    vsettling,            &
-    vsettling_average,    &
-    wetdeposition,        &
-    drydeposition
-
-  ! If age spectra claculation is switched on,
-  ! open the AGECLASSSES file and read user options
-  !************************************************
-
-  open(unitpartoptions,file=path(1)(1:length(1))//'PARTOPTIONS',form='formatted',status='old',err=9999)
-
-  ! try to read in as a namelist
-  read(unitpartoptions,partoptions,iostat=ios)
-  close(unitpartoptions)
-
-  if (ios.ne.0) then
-    write(*,*) 'Namelist error in PARTOPTIONS file', trim(path(1)(1:length(1))//'PARTOPTIONS')
-    stop
-  endif
-  allocate( partopt(num_partopt) )
-  ! Save values in particle options derived type
-  !*********************************************
-  partopt(1)%long_name='longitude'
-  partopt(1)%name='LO'
-  partopt(1)%print=longitude
-
-  partopt(2)%long_name='longitude_average'
-  partopt(2)%name='lo'
-  partopt(2)%print=longitude_average
-  partopt(2)%average=.true.
-
-  partopt(3)%long_name='latitude'
-  partopt(3)%name='LA'
-  partopt(3)%print=latitude
-
-  partopt(4)%long_name='latitude_average'
-  partopt(4)%name='la'
-  partopt(4)%print=latitude_average
-  partopt(4)%average=.true.
-
-  partopt(5)%long_name='height'
-  partopt(5)%name='ZZ'
-  partopt(5)%print=height
-
-  partopt(6)%long_name='height_average'
-  partopt(6)%name='zz'
-  partopt(6)%print=height_average
-  partopt(6)%average=.true.
-
-  partopt(7)%long_name='pv'
-  partopt(7)%name='PV'
-  partopt(7)%print=pv
-
-  partopt(8)%long_name='pv_average'
-  partopt(8)%name='pv'
-  partopt(8)%print=pv_average
-  partopt(8)%average=.true.
-
-  partopt(9)%long_name='qv'
-  partopt(9)%name='QV'
-  partopt(9)%print=qv
-
-  partopt(10)%long_name='qv_average'
-  partopt(10)%name='qv'
-  partopt(10)%print=qv_average
-  partopt(10)%average=.true.
-
-  partopt(11)%long_name='density'
-  partopt(11)%name='RH'
-  partopt(11)%print=density
-
-  partopt(12)%long_name='density_average'
-  partopt(12)%name='rh'
-  partopt(12)%print=density_average
-  partopt(12)%average=.true.
-
-  partopt(13)%long_name='temperature'
-  partopt(13)%name='TT'
-  partopt(13)%print=temperature
-
-  partopt(14)%long_name='temperature_average'
-  partopt(14)%name='tt'
-  partopt(14)%print=temperature_average
-  partopt(14)%average=.true.
-
-  partopt(15)%long_name='pressure'
-  partopt(15)%name='PR'
-  partopt(15)%print=pressure
-
-  partopt(16)%long_name='pressure_average'
-  partopt(16)%name='pr'
-  partopt(16)%print=pressure_average
-  partopt(16)%average=.true.
-
-  partopt(17)%long_name='mixingheight'
-  partopt(17)%name='HM'
-  partopt(17)%print=mixingheight
-
-  partopt(18)%long_name='mixingheight_average'
-  partopt(18)%name='hm'
-  partopt(18)%print=mixingheight_average
-  partopt(18)%average=.true.
-
-  partopt(19)%long_name='tropopause'
-  partopt(19)%name='TR'
-  partopt(19)%print=tropopause
-
-  partopt(20)%long_name='tropopause_average'
-  partopt(20)%name='tr'
-  partopt(20)%print=tropopause_average
-  partopt(20)%average=.true.
-
-  partopt(21)%long_name='topography'
-  partopt(21)%name='TO'
-  partopt(21)%print=topography
-
-  partopt(22)%long_name='topography_average'
-  partopt(22)%name='to'
-  partopt(22)%print=topography_average
-  partopt(22)%average=.true.
-
-  partopt(23)%long_name='mass'
-  partopt(23)%name='MA'
-  partopt(23)%print=mass
-
-  partopt(24)%long_name='mass_average'
-  partopt(24)%name='ma'
-  partopt(24)%print=mass_average
-  partopt(24)%average=.true.
-  
-  partopt(25)%long_name='u'
-  partopt(25)%name='UU'
-  partopt(25)%print=u
-
-  partopt(26)%long_name='u_average'
-  partopt(26)%name='uu'
-  partopt(26)%print=u_average
-  partopt(26)%average=.true.
-
-  partopt(27)%long_name='v'
-  partopt(27)%name='VV'
-  partopt(27)%print=v
-
-  partopt(28)%long_name='v_average'
-  partopt(28)%name='vv'
-  partopt(28)%print=v_average
-  partopt(28)%average=.true.
-
-  partopt(29)%long_name='w'
-  partopt(29)%name='WW'
-  partopt(29)%print=w
-
-  partopt(30)%long_name='w_average'
-  partopt(30)%name='ww'
-  partopt(30)%print=w_average
-  partopt(30)%average=.true.
-
-  partopt(31)%long_name='vsettling'
-  partopt(31)%name='VS'
-  partopt(31)%print=vsettling
-
-  partopt(32)%long_name='vsettling_average'
-  partopt(32)%name='vs'
-  partopt(32)%print=vsettling_average
-  partopt(32)%average=.true.
-
-  partopt(33)%long_name='wetdeposition'
-  partopt(33)%name='WD'
-  partopt(33)%print=wetdeposition
-
-  partopt(34)%long_name='drydeposition'
-  partopt(34)%name='DD'
-  partopt(34)%print=drydeposition
-  ! Numbers are assigned to the averaged fields for proper
-  ! allocation and reading in particle_mod and output_mod
-  !******************************************************
-  n_average=0
-  do np=1,num_partopt
-    if (partopt(np)%average .and. partopt(np)%print) then 
-      n_average=n_average+1
-      partopt(np)%i_average = n_average
-      if ((partopt(np)%name.eq.'MA') .or. (partopt(np)%name.eq.'ma')) then
-        n_average=n_average + (maxspec-1)
-      endif
-    endif
-  end do
-
-  ! write partoptions file in namelist format to output directory if requested
-  if (nmlout.and.lroot) then
-    open(unitpartoptions,file=path(2)(1:length(2))//'PARTOPTIONS.namelist',err=10000)
-    write(unitpartoptions,nml=partoptions)
-    close(unitpartoptions)
-  endif
-
-
-  ! Restart files, when using in combination with averaged particle output, 
-  ! need to be synchronised to prevent false averages in the first step of
-  ! the new run
-  !************************************************************************
-  if ((ipout.ne.0).and.(n_average.gt.0).and.(loutrestart.ne.-1)) then
-    if (mod(loutrestart,ipoutfac*loutstep).ne.0) then
-      write(*,*) '### FLEXPART MODEL ERROR! FILE COMMAND:     ###'
-      write(*,*) '### LOUTRESTART NEEDS TO BE DIVISABLE BY    ###'
-      write(*,*) '### LOUTSTEP*IPOUTFAC.                      ###'
-      stop
-    endif
-  endif
-
-  return
-
-9999   write(*,*) ' #### FLEXPART MODEL ERROR! FILE "PARTOPTIONS" #### '
-  write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY       #### '
-  write(*,'(a)') path(1)(1:length(1))
-  stop
-
-10000  write(*,*) ' #### FLEXPART MODEL ERROR! FILE "PARTOPTIONS" #### '
-  write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY       #### '
-  write(*,'(a)') path(2)(1:length(2))
-  stop
-end subroutine readpartoptions
-
-subroutine skplin(nlines,iunit)
-  !                    i      i
-  !*****************************************************************************
-  !                                                                            *
-  !   This routine reads nlines from unit iunit and discards them              *
-  !                                                                            *
-  !   Authors: Petra Seibert                                                   *
-  !                                                                            *
-  !   31 Dec 1998                                                              *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  !                                                                            *
-  ! iunit   unit number from which lines are to be skipped                     *
-  ! nlines  number of lines to be skipped                                      *
-  !                                                                            *
-  !*****************************************************************************
-
-  implicit none
+#include "rea_readreleases.f90"
 
-  integer :: i,iunit, nlines
+#include "rea_readspecies.f90"
 
-  do i=1,nlines
-    read(iunit,*)
-  end do
+#include "rea_readpartoptions.f90"
 
-end subroutine skplin
+#include "rea_skplin.f90"
 
 end module readoptions_mod
diff --git a/src/set_get_settling.f90 b/src/set_get_settling.f90
new file mode 100644
index 0000000000000000000000000000000000000000..4cfd3f3871ce3773ecd3b09efa4cd0ddaed62391
--- /dev/null
+++ b/src/set_get_settling.f90
@@ -0,0 +1,194 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine get_settling(itime,xt,yt,zt,nsp,settling)
+  !                          i   i  i  i   i     o
+  !*****************************************************************************
+  !                                                                            *
+  !  This subroutine calculates particle settling velocity.                    *
+  !                                                                            *
+  !    Author: A. Stohl                                                        *
+  !                                                                            *
+  !    May 2010                                                                *
+  !                                                                            *
+  !  Improvement over traditional settling calculation in FLEXPART:            *
+  !  generalize to higher Reynolds numbers and also take into account the      *
+  !  temperature dependence of dynamic viscosity.                              *
+  !                                                                            *
+  !  Based on:                                                                 *
+  !  Naeslund E., and Thaning, L. (1991): On the settling velocity in a        *
+  !  nonstationary atmosphere, Aerosol Science and Technology 14, 247-256.     *
+  !                                                                            *
+  !  Changes                                                                   *
+  !     Daria Tatsii 2022: implementation of shape factor according to         *
+  !                        Bagheri & Bonadonna 2016                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! itime [s]          current temporal position                               *
+  ! xt,yt,zt           coordinates position for which wind data shall be cal-  *
+  !                    culated                                                 *
+  !                                                                            *
+  ! Constants:                                                                 *
+  ! dfdr               fluid density/particle density                          *
+  ! Veq [m^3]           equivalent volume of a sphere                          *
+  ! dcyl [m]           diameter of a cylinder (fiber)                          *
+  ! f                  flatness parameters, S/I                               *
+  ! e                  elongation parameters, I/L                              *
+  ! Fs                 Stokes form factor, f e^1.3                             *
+  ! Fn                 Newton's  form factor                                   *
+  ! Ks                 Stokes' drag correction                                 *
+  ! vsp                help variable                                           *
+  ! x                  aspect ratio of cylinder height to its diameter         *
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! c_d                drag coefficient                                        *
+  ! settling [m/s]     settling velocity                                       *
+   !*****************************************************************************
+
+  use par_mod
+  use com_mod
+  use windfields_mod
+
+  implicit none
+
+  integer, intent(in) :: itime, nsp
+  real, intent(in) :: xt, yt, zt
+  real, intent(out) :: settling
+  integer :: indz
+
+  ! Auxiliary variables needed for interpolation
+  real :: dz1,dz2,dz
+  real :: rho1(2),tt1(2),temperature,airdens,vis_dyn,vis_kin
+  real :: settling_old,reynolds,c_d
+  integer :: i,n,nix,njy,indzh
+
+  ! Variables needed for drag coefficient calculation
+  real :: dfdr,f,e,kn,ks,alpha1,alpha2,beta1,beta2,ks1,ks2,kn1,kn2
+
+  !*****************************************************************************
+  ! 1. Interpolate temperature and density: nearest neighbor interpolation sufficient
+  !*****************************************************************************
+
+  nix=int(xt)
+  njy=int(yt)
+
+  ! Determine the level below the current position for u,v
+  !*******************************************************
+  indz=nz-1
+  do i=2,nz
+    if (height(i).gt.zt) then
+      indz=i-1
+      exit
+    endif
+  end do
+
+  ! Vertical distance to the level below and above current position
+  !****************************************************************
+
+  dz=1./(height(indz+1)-height(indz))
+  dz1=(zt-height(indz))*dz
+  dz2=(height(indz+1)-zt)*dz
+
+
+  ! Bilinear horizontal interpolation
+  !**********************************
+
+  ! Loop over 2 levels
+  !*******************
+
+  do n=1,2
+    indzh=indz+n-1
+    rho1(n)=rho(nix,njy,indzh,1)
+    tt1(n)=tt(nix,njy,indzh,1)
+  end do
+
+
+  ! Linear vertical interpolation
+  !******************************
+
+  temperature=dz2*tt1(1)+dz1*tt1(2)
+  airdens=dz2*rho1(1)+dz1*rho1(2)
+
+  vis_dyn=viscosity(temperature)
+  vis_kin=vis_dyn/airdens
+
+  reynolds=dquer(nsp)/1.e6*abs(vsetaver(nsp))/vis_kin
+
+  ! Iteration to determine both Reynolds number and settling velocity
+  !******************************************************************
+
+  settling_old=vsetaver(nsp)    ! initialize iteration with Stokes' law to define settling velocity of a sphere, constant viscosity estimate
+
+  if (shape(nsp).eq.0) then
+    do i=1,20    ! do a few iterations Why 20???
+
+      ! if (reynolds.lt.1.917) then
+      !   c_d=24./reynolds
+      ! else if (reynolds.lt.500.) then
+      !   c_d=18.5/(reynolds**0.6)
+      ! else
+      !   c_d=0.44
+      ! endif
+
+      ! Clift and Guavin 1971 model
+
+      c_d=(24.0/reynolds)*(1+0.15*(reynolds**0.687))+ &
+              0.42/(1.0+42500.0/(reynolds**1.16))
+
+      settling=-1.* &
+           sqrt(4*ga*dquer(nsp)/1.e6*density(nsp)*cunningham(nsp)/ &
+           (3.*c_d*airdens))
+
+      if (abs((settling-settling_old)/settling).lt.0.01) exit  ! stop iteration
+
+      reynolds=dquer(nsp)/1.e6*abs(settling)/vis_kin
+      settling_old=settling
+    end do
+
+  else ! Drag coefficient scheme by Bagheri & Bonadonna, 2016 to define settling velocities of other shapes (by D.Tatsii)
+    dfdr=density(nsp)/airdens
+
+    ! Orientation of particles
+    !*************************
+    if (orient(nsp).eq.0) then
+      ! Horizontal orientation
+      alpha2=0.77 ! B&B: eq. 32
+      beta2=0.63
+      ks=0.5*((Fs(nsp)**0.05)+(Fs(nsp)**(-0.36)))  ! B&B Figure 12 k_(s,max)
+      kn=10.**(alpha2*(-log10(Fn(nsp)))**beta2)
+    else if (orient(nsp).eq.1) then
+      ! Random orientation
+      alpha1=0.45+10.0/(exp(2.5*log10(dfdr))+30.0)
+      beta1=1.-37.0/(exp(3.0*log10(dfdr))+100.0)
+      ks=(Fs(nsp)**(1./3.) + Fs(nsp)**(-1./3))/2.
+      kn=10.**(alpha1*(-log10(Fn(nsp)))**beta1)
+    else
+      ! The average of random and horizontal orientation
+      alpha1=0.45+10.0/(exp(2.5*log10(dfdr))+30.0)
+      beta1=1.-37.0/(exp(3.0*log10(dfdr))+100.0)
+      alpha2=0.77 ! B&B: eq. 32
+      beta2=0.63
+      ks1=(Fs(nsp)**(1./3.) + Fs(nsp)**(-1./3))/2.
+      kn1=10.**(alpha1*(-log10(Fn(nsp)))**beta1)
+      ks2=0.5*((Fs(nsp)**0.05)+(Fs(nsp)**(-0.36)))  ! B&B Figure 12 k_(s,max)
+      kn2=10.**(alpha2*(-log10(Fn(nsp)))**beta2)
+      ks=(ks1+ks2)/2.
+      kn=(kn1+kn2)/2.
+    endif
+
+    do i=1,20
+      c_d=(24.*ks/reynolds)*(1.+0.125*((reynolds*kn/ks)**(2./3.)))+ &
+        (0.46*kn/(1.+5330./(reynolds*kn/ks)))
+
+      settling=-1.* &
+              sqrt(4.*ga*dquer(nsp)/1.e6*density(nsp)*cunningham(nsp)/ &
+              (3.*c_d*airdens))
+
+      if (abs((settling-settling_old)/settling).lt.0.01) exit
+
+      reynolds=dquer(nsp)/1.e6*abs(settling)/vis_kin
+      settling_old=settling
+    end do
+  endif
+end subroutine get_settling
diff --git a/src/set_viscosity.f90 b/src/set_viscosity.f90
new file mode 100644
index 0000000000000000000000000000000000000000..021b1130a99481a10214b3bdfca7c51e329674e6
--- /dev/null
+++ b/src/set_viscosity.f90
@@ -0,0 +1,16 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+real function viscosity(t)
+  ! Function calculates dynamic viscosity of air (kg/m/s) as function of
+  ! temperature (K) using Sutherland's formula
+  implicit none
+
+  real :: t
+  real,parameter :: c=120.,t_0=291.15,eta_0=1.827e-5
+
+  viscosity=eta_0*(t_0+c)/(t+c)*(t/t_0)**1.5
+
+  return
+
+end function viscosity
diff --git a/src/settling_mod.f90 b/src/settling_mod.f90
index 910c41bb8b23fd1d99a8705cf26d1ed0b5938f6d..794134bea36ffb338f2fe3288989d9ed9fc1a572 100644
--- a/src/settling_mod.f90
+++ b/src/settling_mod.f90
@@ -1,217 +1,15 @@
 ! SPDX-FileCopyrightText: FLEXPART 1998-2019, see flexpart_license.txt
 ! SPDX-License-Identifier: GPL-3.0-or-later
 module settling_mod
-  
+
   implicit none
 
   private :: viscosity
   public :: get_settling
 contains
 
-subroutine get_settling(itime,xt,yt,zt,nsp,settling)
-  !                          i   i  i  i   i     o
-  !*****************************************************************************
-  !                                                                            *
-  !  This subroutine calculates particle settling velocity.                    *
-  !                                                                            *
-  !    Author: A. Stohl                                                        *
-  !                                                                            *
-  !    May 2010                                                                *
-  !                                                                            *
-  !  Improvement over traditional settling calculation in FLEXPART:            *
-  !  generalize to higher Reynolds numbers and also take into account the      *
-  !  temperature dependence of dynamic viscosity.                              *
-  !                                                                            *
-  !  Based on:                                                                 *
-  !  Naeslund E., and Thaning, L. (1991): On the settling velocity in a        *
-  !  nonstationary atmosphere, Aerosol Science and Technology 14, 247-256.     *
-  !                                                                            *
-  !  Changes                                                                   *
-  !     Daria Tatsii 2022: implementation of shape factor according to         *
-  !                        Bagheri & Bonadonna 2016                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! itime [s]          current temporal position                               *
-  ! xt,yt,zt           coordinates position for which wind data shall be cal-  *
-  !                    culated                                                 *
-  !                                                                            *
-  ! Constants:                                                                 *
-  ! dfdr               fluid density/particle density                          *
-  ! Veq [m^3]           equivalent volume of a sphere                          *
-  ! dcyl [m]           diameter of a cylinder (fiber)                          * 
-  ! f                  flatness parameters, S/I                               *
-  ! e                  elongation parameters, I/L                              *
-  ! Fs                 Stokes form factor, f e^1.3                             *
-  ! Fn                 Newton's  form factor                                   *
-  ! Ks                 Stokes' drag correction                                 * 
-  ! vsp                help variable                                           *
-  ! x                  aspect ratio of cylinder height to its diameter         *
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! c_d                drag coefficient                                        *
-  ! settling [m/s]     settling velocity                                       *
-   !*****************************************************************************
-
-  use par_mod
-  use com_mod
-  use windfields_mod
-
-  implicit none
-
-  integer, intent(in) :: itime, nsp
-  real, intent(in) :: xt, yt, zt
-  real, intent(out) :: settling
-  integer :: indz
-
-  ! Auxiliary variables needed for interpolation
-  real :: dz1,dz2,dz
-  real :: rho1(2),tt1(2),temperature,airdens,vis_dyn,vis_kin
-  real :: settling_old,reynolds,c_d
-  integer :: i,n,nix,njy,indzh
-
-  ! Variables needed for drag coefficient calculation
-  real :: dfdr,f,e,kn,ks,alpha1,alpha2,beta1,beta2,ks1,ks2,kn1,kn2
-
-  !*****************************************************************************
-  ! 1. Interpolate temperature and density: nearest neighbor interpolation sufficient
-  !*****************************************************************************
-
-  nix=int(xt)
-  njy=int(yt)
-
-  ! Determine the level below the current position for u,v
-  !*******************************************************
-  indz=nz-1
-  do i=2,nz
-    if (height(i).gt.zt) then
-      indz=i-1
-      exit
-    endif
-  end do
-
-  ! Vertical distance to the level below and above current position
-  !****************************************************************
-
-  dz=1./(height(indz+1)-height(indz))
-  dz1=(zt-height(indz))*dz
-  dz2=(height(indz+1)-zt)*dz
-
-
-  ! Bilinear horizontal interpolation
-  !**********************************
-
-  ! Loop over 2 levels
-  !*******************
-
-  do n=1,2
-    indzh=indz+n-1
-    rho1(n)=rho(nix,njy,indzh,1)
-    tt1(n)=tt(nix,njy,indzh,1)
-  end do
-
-
-  ! Linear vertical interpolation
-  !******************************
-
-  temperature=dz2*tt1(1)+dz1*tt1(2)
-  airdens=dz2*rho1(1)+dz1*rho1(2)
-
-  vis_dyn=viscosity(temperature)
-  vis_kin=vis_dyn/airdens
-
-  reynolds=dquer(nsp)/1.e6*abs(vsetaver(nsp))/vis_kin
-
-  ! Iteration to determine both Reynolds number and settling velocity
-  !******************************************************************
-
-  settling_old=vsetaver(nsp)    ! initialize iteration with Stokes' law to define settling velocity of a sphere, constant viscosity estimate
-
-  if (shape(nsp).eq.0) then
-    do i=1,20    ! do a few iterations Why 20???
-
-      ! if (reynolds.lt.1.917) then
-      !   c_d=24./reynolds
-      ! else if (reynolds.lt.500.) then
-      !   c_d=18.5/(reynolds**0.6)
-      ! else
-      !   c_d=0.44
-      ! endif
-
-      ! Clift and Guavin 1971 model
- 
-      c_d=(24.0/reynolds)*(1+0.15*(reynolds**0.687))+ &
-              0.42/(1.0+42500.0/(reynolds**1.16))
-
-      settling=-1.* &
-           sqrt(4*ga*dquer(nsp)/1.e6*density(nsp)*cunningham(nsp)/ &
-           (3.*c_d*airdens))
-
-      if (abs((settling-settling_old)/settling).lt.0.01) exit  ! stop iteration
-
-      reynolds=dquer(nsp)/1.e6*abs(settling)/vis_kin
-      settling_old=settling
-    end do
-
-  else ! Drag coefficient scheme by Bagheri & Bonadonna, 2016 to define settling velocities of other shapes (by D.Tatsii)
-    dfdr=density(nsp)/airdens
-
-    ! Orientation of particles
-    !*************************
-    if (orient(nsp).eq.0) then
-      ! Horizontal orientation
-      alpha2=0.77 ! B&B: eq. 32
-      beta2=0.63
-      ks=0.5*((Fs(nsp)**0.05)+(Fs(nsp)**(-0.36)))  ! B&B Figure 12 k_(s,max)
-      kn=10.**(alpha2*(-log10(Fn(nsp)))**beta2)
-    else if (orient(nsp).eq.1) then 
-      ! Random orientation
-      alpha1=0.45+10.0/(exp(2.5*log10(dfdr))+30.0)
-      beta1=1.-37.0/(exp(3.0*log10(dfdr))+100.0)
-      ks=(Fs(nsp)**(1./3.) + Fs(nsp)**(-1./3))/2.
-      kn=10.**(alpha1*(-log10(Fn(nsp)))**beta1)
-    else
-      ! The average of random and horizontal orientation
-      alpha1=0.45+10.0/(exp(2.5*log10(dfdr))+30.0)
-      beta1=1.-37.0/(exp(3.0*log10(dfdr))+100.0)
-      alpha2=0.77 ! B&B: eq. 32
-      beta2=0.63
-      ks1=(Fs(nsp)**(1./3.) + Fs(nsp)**(-1./3))/2.
-      kn1=10.**(alpha1*(-log10(Fn(nsp)))**beta1)
-      ks2=0.5*((Fs(nsp)**0.05)+(Fs(nsp)**(-0.36)))  ! B&B Figure 12 k_(s,max)
-      kn2=10.**(alpha2*(-log10(Fn(nsp)))**beta2)
-      ks=(ks1+ks2)/2.
-      kn=(kn1+kn2)/2.
-    endif
-
-    do i=1,20
-      c_d=(24.*ks/reynolds)*(1.+0.125*((reynolds*kn/ks)**(2./3.)))+ &
-        (0.46*kn/(1.+5330./(reynolds*kn/ks)))
-
-      settling=-1.* &
-              sqrt(4.*ga*dquer(nsp)/1.e6*density(nsp)*cunningham(nsp)/ &
-              (3.*c_d*airdens))
-
-      if (abs((settling-settling_old)/settling).lt.0.01) exit
-
-      reynolds=dquer(nsp)/1.e6*abs(settling)/vis_kin
-      settling_old=settling
-    end do
-  endif
-end subroutine get_settling
-
-real function viscosity(t)
-  ! Function calculates dynamic viscosity of air (kg/m/s) as function of
-  ! temperature (K) using Sutherland's formula
-  implicit none
-
-  real :: t
-  real,parameter :: c=120.,t_0=291.15,eta_0=1.827e-5
-
-  viscosity=eta_0*(t_0+c)/(t+c)*(t/t_0)**1.5
-
-  return
+#include "set_get_settling.f90"
 
-end function viscosity
+#include "set_viscosity.f90"
 
 end module settling_mod
diff --git a/src/tim_timemanager.f90 b/src/tim_timemanager.f90
new file mode 100644
index 0000000000000000000000000000000000000000..c3fa8e6d23708415324a18d106e1bcc686c42767
--- /dev/null
+++ b/src/tim_timemanager.f90
@@ -0,0 +1,651 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine timemanager
+
+  !*****************************************************************************
+  !                                                                            *
+  ! Handles the computation of trajectories, i.e. determines which             *
+  ! trajectories have to be computed at what time.                             *
+  ! Manages dry+wet deposition routines, radioactive decay and the computation *
+  ! of concentrations.                                                         *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     20 May 1996                                                            *
+  !                                                                            *
+  !*****************************************************************************
+  !  Changes, Bernd C. Krueger, Feb. 2001:                                     *
+  !        Call of convmix when new windfield is read                          *
+  !------------------------------------                                        *
+  !  Changes Petra Seibert, Sept 2002                                          *
+  !     fix wet scavenging problem                                             *
+  !     Code may not be correct for decay of deposition!                       *
+  !  Changes Petra Seibert, Nov 2002                                           *
+  !     call convection BEFORE new fields are read in BWD mode                 *
+  !  Changes Caroline Forster, Feb 2005                                        *
+  !   new interface between flexpart and convection scheme                     *
+  !   Emanuel's latest subroutine convect43c.f is used                         *
+  !  Changes Stefan Henne, Harald Sodemann, 2013-2014                          *
+  !   added netcdf output code                                                 *
+  !  Changes Espen Sollum 2014                                                 *
+  !   For compatibility with MPI version,                                      *
+  !   variables uap,ucp,uzp,us,vs,ws,cbt now in module com_mod                 *
+  !  Unified ECMWF and GFS builds                                              *
+  !   Marian Harustak, 12.5.2017                                               *
+  !  Changes L Bakels 2022: - OpenMP parallelisation                           *
+  !                         - converting input to ETA coordinates              *
+  !                         - spawning particles from part_ic.nc               *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! DEP                .true. if either wet or dry deposition is switched on   *
+  ! decay(maxspec) [1/s] decay constant for radioactive decay                  *
+  ! DRYDEP             .true. if dry deposition is switched on                 *
+  ! ideltas [s]        modelling period                                        *
+  ! itime [s]          actual temporal position of calculation                 *
+  ! ldeltat [s]        time since computation of radioact. decay of depositions*
+  ! loutaver [s]       averaging period for concentration calculations         *
+  ! loutend [s]        end of averaging for concentration calculations         *
+  ! loutnext [s]       next time at which output fields shall be centered      *
+  ! loutsample [s]     sampling interval for averaging of concentrations       *
+  ! loutstart [s]      start of averaging for concentration calculations       *
+  ! loutstep [s]       time interval for which concentrations shall be         *
+  !                    calculated                                              *
+  ! loutrestart [s]    time interval for which restart files will be produced  *
+  ! npoint             index, which starting point the trajectory has          *
+  !                    starting positions of trajectories                      *
+  ! nstop              serves as indicator for fate of particles               *
+  !                    in the particle loop                                    *
+  ! nstop1             serves as indicator for wind fields (see getfields)     *
+  ! outnum             number of samples for each concentration calculation    *
+  ! prob               probability of absorption at ground due to dry          *
+  !                    deposition                                              *
+  ! WETDEP             .true. if wet deposition is switched on                 *
+  ! weight             weight for each concentration sample (1/2 or 1)         *
+  !                                                                            *
+  !*****************************************************************************
+  ! openmp change
+  use omp_lib
+  ! openmp change end
+  use unc_mod
+  use point_mod
+  use xmass_mod
+  use flux_mod
+  use prepoutgrid_mod
+  use ohr_mod
+  use par_mod
+  use com_mod
+  use coord_ec_mod
+  use particle_mod
+  use conv_mod
+  use windfields_mod
+  use advance_mod, only: advance
+  use drydepo_mod
+  use wetdepo_mod
+  use plume_mod
+  use initialise_mod
+  use getfields_mod
+  use output_mod
+  use interpol_mod, only: alloc_interpol,dealloc_interpol
+
+  implicit none
+  real, parameter ::        &
+    e_inv = 1.0/exp(1.0)
+  integer ::                &
+    j,i,                    & ! loop variable
+    ks,                     & ! loop variable species
+    kp,                     & ! loop variable for maxpointspec_act
+    l,                      & ! loop variable over nclassunc
+    n,                      & ! loop variable over particles
+    itime=0,                & ! time index
+    nstop1,                 & ! windfield existence flag
+    loutnext,               & ! following timestep
+    loutstart,loutend,      & ! concentration calculation starting and ending time
+    ix,jy,                  & ! gridcell indices
+    ldeltat,                & ! radioactive decay time
+    itage,nage,inage,       & ! related to age classes
+    idummy,                 & ! used for the random routines
+    i_nan=0,ii_nan,total_nan_intl=0, &  !added by mc to check instability in CBL scheme
+    thread                    ! openmp change (not sure if necessary)
+  ! logical ::                &
+  !   active_per_rel(maxpoint)  ! are there particles active in each release
+  real ::                   &
+    filesize!(maxpoint)        ! Keeping track of the size of the particledump output, so it can be splitted
+  ! real(kind=dp) ::          &
+  !   jul
+  ! integer ::                &
+  !   jjjjmmdd,ihmmss
+  real ::                   &
+    outnum,                 & ! concentration calculation sample number
+    prob_rec(maxspec),      & ! dry deposition related
+    decfact,                & ! radioactive decay factor
+    wetscav,                & ! wet scavenging
+    xmassfract,             & ! dry deposition related
+    grfraction(3)             ! wet deposition related
+  real(dep_prec) ::         &
+    drydeposit(maxspec)       ! dry deposition related
+  real(kind=dp) :: zhier,zetahier
+  integer :: npart_alive=0,alive_tmp,spawned_tmp,terminated_tmp
+
+  ! First output for time 0
+  !************************
+  if (itime_init.ne.0) then
+    loutnext=loutnext_init
+    outnum=outnum_init
+  else
+    loutnext=loutstep/2
+    outnum=0.
+  endif
+  loutstart=loutnext-loutaver/2
+  loutend=loutnext+loutaver/2
+
+  ! Initialise the nan count for CBL option
+  !****************************************
+  sum_nan_count(:) = 0
+  nan_count(:) = 0
+
+  !**********************************************************************
+  ! Loop over the whole modelling period in time steps of mintime seconds
+  !**********************************************************************
+
+  write(*,46) float(itime)/3600,itime,numpart
+46      format(' Simulated ',f7.1,' hours (',i13,' s), ',i13, ' particles')
+
+  filesize=0.
+  ! active_per_rel=.false.
+
+  ! ! Allocate memory for windfields
+  ! !*******************************
+  ! call alloc_windf
+
+  do itime=itime_init,ideltas,lsynctime
+
+  ! Computation of wet deposition, OH reaction and mass transfer
+  ! between two species every lsynctime seconds
+  ! maybe wet depo frequency can be relaxed later but better be on safe side
+  ! wetdepo must be called BEFORE new fields are read in but should not
+  ! be called in the very beginning before any fields are loaded, or
+  ! before particles are in the system
+  ! Code may not be correct for decay of deposition
+  ! changed by Petra Seibert 9/02
+  !********************************************************************
+
+  ! Write basic information on the simulation to a file "header" for the
+  ! first time step and open files that are to be kept open throughout
+  ! the simulation.
+  ! In addition, open new particle dump files if required and keep track
+  ! of the size of these files.
+  !*********************************************************************
+
+    write(*,*) 'Time: ', itime, 'seconds.'
+
+    if (itime.eq.itime_init) then
+      call SYSTEM_CLOCK(count_clock, count_rate, count_max)
+      s_firstt = real(count_clock)/real(count_rate)
+    endif
+
+  ! Writing restart file
+  !*********************
+    if ((itime.ne.itime_init).and.(mod(itime,loutrestart).eq.0)) call output_restart(itime,loutnext,outnum)
+
+    if (itime.ne.0) write(*,*) part(1)%xlon,part(1)%ylat,part(1)%z,part(1)%zeta
+    call init_output(itime,filesize)
+
+  ! Get necessary wind fields if not available
+  !*******************************************
+    call getfields(itime,nstop1) !OMP on verttransform_ecmwf and readwind_ecmwf, getfields_mod.f90
+    if (nstop1.gt.1) stop 'NO METEO FIELDS AVAILABLE'
+
+  ! In case of ETA coordinates being read from file, convert the z positions
+  !*************************************************************************
+    if (((ipin.eq.1).or.(ipin.eq.4)).and.(itime.eq.itime_init).and.(wind_coord_type.eq.'ETA')) then
+      if (numpart.le.0) stop 'Something is going wrong reading the old particle file!'
+!$OMP PARALLEL PRIVATE(i)
+!$OMP DO
+      do i=1,numpart
+        call update_z_to_zeta(itime, i)
+      end do
+!$OMP END DO
+!$OMP END PARALLEL
+    endif
+
+    if ((ipin.eq.3).and.(itime.eq.itime_init).and.(wind_coord_type.eq.'ETA')) then
+      do i=1,count%allocated
+        call update_z_to_zeta(itime, i)
+      end do
+    endif
+
+    if (WETDEP .and. (itime.ne.0) .and. (numpart.gt.0)) then
+      call wetdepo(itime,lsynctime,loutnext) !OMP, wetdepo_mod.f90 (needs test)
+    endif
+
+    if (OHREA .and. (itime.ne.0) .and. (numpart.gt.0)) &
+      call ohreaction(itime,lsynctime,loutnext) !OMP, ohr_mod.f90 (needs test)
+
+  ! compute convection for backward runs
+  !*************************************
+
+    if ((ldirect.eq.-1).and.(lconvection.eq.1).and.(itime.lt.0)) then
+      call convmix(itime) !OMP, conv_mod.f90
+    endif
+
+  ! Get hourly OH fields if not available
+  !****************************************************
+    if (OHREA) then
+      call gethourlyOH(itime) !OMP, ohr_mod.f90 (needs test)
+    endif
+
+  ! Release particles
+  !******************
+    if (mdomainfill.ge.1) then
+      if (itime.eq.itime_init) then
+        call init_domainfill !OMP, initialise_mod.f90 (needs test)
+      else
+        call boundcond_domainfill(itime,loutend) !OMP, initialise_mod.f90 (needs test)
+      endif
+    else if ((ipin.eq.3).or.(ipin.eq.4)) then
+      ! If reading from user defined initial conditions, check which particles are
+      ! to be activated
+      if (count%allocated.le.0) stop 'Something is going wrong reading the part_ic.nc file!'
+
+      alive_tmp=count%alive
+      spawned_tmp=count%spawned
+!$OMP PARALLEL PRIVATE(i) REDUCTION(+:alive_tmp,spawned_tmp)
+!$OMP DO
+      do i=1,count%allocated
+        if (.not. part(i)%alive) then
+          if (ldirect.lt.0) then
+            if ((part(i)%tstart.le.itime).and.(part(i)%tstart.gt.itime+lsynctime)) then
+              call spawn_particle(itime,i)
+              call update_z_to_zeta(itime,i)
+              alive_tmp=alive_tmp+1
+              spawned_tmp=spawned_tmp+1
+            endif
+          else if ((part(i)%tstart.ge.itime).and.(part(i)%tstart.lt.itime+lsynctime)) then
+            call spawn_particle(itime,i)
+            call update_z_to_zeta(itime,i)
+            alive_tmp=alive_tmp+1
+            spawned_tmp=spawned_tmp+1
+          endif
+        endif
+      end do
+!$OMP END DO
+!$OMP END PARALLEL
+      count%alive=alive_tmp
+      count%spawned=spawned_tmp
+      call get_totalpart_num(numpart)
+    else
+      call releaseparticle(itime)
+    endif
+
+  ! Compute convective mixing for forward runs
+  ! for backward runs it is done before next windfield is read in
+  !**************************************************************
+    if ((ldirect.eq.1).and.(lconvection.eq.1)) then
+      call convmix(itime) !OMP (not the nested part yet), conv_mod.f90
+    endif
+
+  ! If middle of averaging period of output fields is reached, accumulated
+  ! deposited mass radioactively decays
+  !***********************************************************************
+    if (DEP.and.(itime.eq.loutnext).and.(ldirect.gt.0)) call deposit_decay() !OMP, unc_mod.f90 (needs test)
+
+
+  ! Is the time within the computation interval, if not, skip
+  !************************************************************
+    if ((ldirect*itime.ge.ldirect*loutstart).and.(ldirect*itime.le.ldirect*loutend)) then
+      call SYSTEM_CLOCK(count_clock, count_rate, count_max)
+      s_temp = (count_clock - count_clock0)/real(count_rate)
+      ! If it is not time yet to write outputs, skip
+      !***********************************************
+      if ((itime.eq.loutend).and.(outnum.gt.0).and.(itime.ne.0)) then
+
+        if ((iout.eq.4).or.(iout.eq.5)) call plumetraj(itime)
+        if (iflux.eq.1) call fluxoutput(itime)
+        if (ipout.ge.1) then
+          if (mod(itime,ipoutfac*loutstep).eq.0) then
+
+            call output_particle(itime)!,active_per_rel) ! dump particle positions
+          endif
+        endif
+      endif
+      ! Check whether concentrations are to be calculated and outputted
+      !****************************************************************
+      call output_conc(itime,loutstart,loutend,loutnext,outnum)
+      call SYSTEM_CLOCK(count_clock, count_rate, count_max)
+      s_writepart = s_writepart + ((count_clock - count_clock0)/real(count_rate)-s_temp)
+    endif
+
+    if (itime.eq.ideltas) exit         ! almost finished
+
+  ! Compute interval since radioactive decay of deposited mass was computed
+  !************************************************************************
+
+    if (itime.lt.loutnext) then
+      ldeltat=itime-(loutnext-loutstep)
+    else                                  ! first half of next interval
+      ldeltat=itime-loutnext
+    endif
+
+
+  ! Loop over all particles
+  !************************
+  ! Various variables for testing reason of CBL scheme, by mc
+    well_mixed_vector=0. !erase vector to test well mixed condition: modified by mc
+    well_mixed_norm=0.   !erase normalization to test well mixed condition: modified by mc
+    avg_ol=0.
+    avg_wst=0.
+    avg_h=0.
+    avg_air_dens=0.  !erase vector to obtain air density at particle positions: modified by mc
+  !-----------------------------------------------------------------------------
+
+  ! openmp change
+  ! LB, openmp following CTM version, need to be very careful due to big differences
+  ! between the openmp loop in this and the CTM version
+!$OMP PARALLEL PRIVATE(prob_rec,inage,nage,itage,ks,kp,thread,j,xmassfract,drydeposit)
+
+#if (defined _OPENMP)
+    thread = OMP_GET_THREAD_NUM() ! Starts with 0
+#else
+    thread = 0
+#endif
+
+!$OMP DO
+! SCHEDULE(dynamic, max(1,numpart/1000))
+!max(1,int(real(numpart)/numthreads/20.)))
+    do j=1,numpart
+
+  ! If integration step is due, do it
+  !**********************************
+      if (.not. part(j)%alive) cycle
+
+  ! Determine age class of the particle
+  !************************************
+      itage=abs(itime-part(j)%tstart)
+      nage=1
+      do inage=1,nageclass
+        nage=inage
+        if (itage.lt.lage(nage)) exit
+      end do
+
+  ! Initialize newly released particle
+  !***********************************
+      if ((part(j)%tstart.eq.itime).or.(itime.eq.0)) then
+        call update_zeta_to_z(itime, j)
+        call init_particle(itime,j)
+      endif
+
+  ! Memorize particle positions
+  !****************************
+      part(j)%xlon_prev=part(j)%xlon
+      part(j)%ylat_prev=part(j)%ylat
+      part(j)%z_prev=part(j)%z
+      part(j)%zeta_prev=part(j)%zeta
+
+  ! RECEPTOR: dry/wet depovel
+  !****************************
+  ! Before the particle is moved
+  ! the calculation of the scavenged mass shall only be done once after release
+  ! xscav_frac1 was initialised with a negative value
+
+      if  (DRYBKDEP) then
+        do ks=1,nspec
+          if  ((xscav_frac1(j,ks).lt.0)) then
+            call update_zeta_to_z(itime,j)
+            call get_vdep_prob(itime,real(part(j)%xlon),real(part(j)%ylat), &
+              real(part(j)%z),prob_rec)
+            if (DRYDEPSPEC(ks)) then        ! dry deposition
+              xscav_frac1(j,ks)=prob_rec(ks)
+            else
+              part(j)%mass(ks)=0.
+              xscav_frac1(j,ks)=0.
+            endif
+          endif
+        enddo
+      endif
+
+  ! Integrate Langevin equation for lsynctime seconds
+  !*************************************************
+
+      call advance(itime,j,thread)
+
+      if (part(j)%nstop.eqv..true.) cycle
+      if (n_average.gt.0) call partpos_avg(itime,j)
+
+  ! Calculate the gross fluxes across layer interfaces
+  !***************************************************
+      if (iflux.eq.1) call calcfluxes(itime,nage,j,real(part(j)%xlon_prev), &
+        real(part(j)%ylat_prev),real(part(j)%z_prev),thread+1)
+    end do
+!$OMP END DO
+!$OMP END PARALLEL
+
+#ifdef _OPENMP
+  call omp_set_num_threads(numthreads_grid)
+#endif
+
+  alive_tmp=count%alive
+  terminated_tmp=count%terminated
+
+!$OMP PARALLEL PRIVATE(prob_rec,nage,inage,itage,ks,kp,thread,j,xmassfract,drydeposit) &
+!$OMP REDUCTION(+:alive_tmp,terminated_tmp)
+
+!num_threads(numthreads_grid)
+
+#if (defined _OPENMP)
+    thread = OMP_GET_THREAD_NUM() ! Starts with 0
+#else
+    thread = 0
+#endif
+
+!$OMP DO
+! SCHEDULE(dynamic, max(1,numpart/1000))
+!max(1,int(real(numpart)/numthreads/20.)))
+    do j=1,numpart
+
+  ! If integration step is due, do it
+  !**********************************
+      if (.not. part(j)%alive) cycle
+
+  ! Determine age class of the particle
+  !************************************
+      itage=abs(itime-part(j)%tstart)
+      nage=1
+      do inage=1,nageclass
+        nage=inage
+        if (itage.lt.lage(nage)) exit
+      end do
+
+  ! Determine, when next time step is due
+  ! If trajectory is terminated, mark it
+  !**************************************
+      if (part(j)%nstop) then
+        if (linit_cond.ge.1) call initcond_calc(itime,j,thread+1)
+        call terminate_particle(j,itime)
+        alive_tmp=alive_tmp-1
+        terminated_tmp=terminated_tmp+1
+      else
+
+! Dry deposition and radioactive decay for each species
+! Also check maximum (of all species) of initial mass remaining on the particle;
+! if it is below a threshold value, terminate particle
+!*****************************************************************************
+
+        xmassfract=0.
+        do ks=1,nspec
+
+          if (DRYDEPSPEC(ks)) then     ! dry deposition (and radioactive decay)
+
+            call drydepo_massloss(j,ks,ldeltat,drydeposit(ks))
+
+          else if (decay(ks).gt.0.) then  ! no dry depo, but radioactive decay
+
+            part(j)%mass(ks) = part(j)%mass(ks) * &
+              exp( -real(abs(lsynctime)) * decay(ks) )
+
+          endif
+
+  ! Skip check on mass fraction when npoint represents particle number
+          if (mdomainfill.eq.0.and.mquasilag.eq.0) then
+            if (ipin.eq.3 .or. ipin.eq.4) then
+              if (part(j)%mass_init(ks).gt.0) &
+                xmassfract = max( xmassfract, &
+                                  part(j)%mass(ks) / part(j)%mass_init(ks) )
+            else if (xmass(part(j)%npoint,ks).gt.0.) then
+              xmassfract = max( xmassfract, real( npart(part(j)%npoint) ) * &
+                part(j)%mass(ks) /  xmass(part(j)%npoint,ks) )
+            endif
+          else
+            xmassfract=1.0
+          end if
+
+        end do
+
+        if (xmassfract.le.minmassfrac) then
+          ! terminate all particles carrying less mass
+          call terminate_particle(j,itime)
+          alive_tmp=alive_tmp-1
+          terminated_tmp=terminated_tmp+1
+        endif
+
+!        Sabine Eckhardt, June 2008
+!        don't create depofield for backward runs
+        if (DRYDEP.AND.(ldirect.eq.1).and.(iout.ne.0)) then
+
+          if (ioutputforeachrelease.eq.1) then
+              kp=part(j)%npoint
+          else
+              kp=1
+          endif
+
+          call drydepokernel(part(j)%nclass,drydeposit,real(part(j)%xlon), &
+               real(part(j)%ylat),nage,kp,thread+1)
+          if (nested_output.eq.1) call drydepokernel_nest( &
+               part(j)%nclass,drydeposit,real(part(j)%xlon),real(part(j)%ylat), &
+               nage,kp,thread+1)
+        endif
+
+  ! Terminate trajectories that are older than maximum allowed age
+  !***************************************************************
+
+        if ((part(j)%alive).and.(abs(itime-part(j)%tstart).ge.lage(nageclass))) then
+          if (linit_cond.ge.1) call initcond_calc(itime+lsynctime,j,thread+1)
+          call terminate_particle(j,itime)
+          alive_tmp=alive_tmp-1
+          terminated_tmp=terminated_tmp+1
+        endif
+      endif
+
+    end do !loop over particles
+
+!$OMP END DO
+!$OMP END PARALLEL
+
+  count%alive=alive_tmp
+  count%terminated=terminated_tmp
+
+#ifdef _OPENMP
+  call omp_set_num_threads(numthreads)
+#endif
+  ! OpenMP Reduction for dynamically allocated arrays. This is done manually since this
+  ! is not yet supported in most OpenMP versions
+  !************************************************************************************
+#ifdef _OPENMP
+    if (iflux.eq.1) then
+      do i=1,numthreads
+        flux(:,:,:,:,:,:,:)=flux(:,:,:,:,:,:,:)+flux_omp(:,:,:,:,:,:,:,i)
+        flux_omp(:,:,:,:,:,:,:,i)=0.
+      end do
+    endif
+    if (linit_cond.ge.1) then
+      do i=1,numthreads_grid
+        init_cond(:,:,:,:,:)=init_cond(:,:,:,:,:)+init_cond_omp(:,:,:,:,:,i)
+        init_cond_omp(:,:,:,:,:,i)=0.
+      end do
+    endif
+    if (DRYDEP.AND.(ldirect.eq.1).and.(iout.ne.0)) then
+      do i=1,numthreads_grid
+        drygridunc(:,:,:,:,:,:)=drygridunc(:,:,:,:,:,:)+gridunc_omp(:,:,1,:,:,:,:,i)
+        gridunc_omp(:,:,1,:,:,:,:,i)=0.
+      end do
+      if (nested_output.eq.1) then
+        do i=1,numthreads_grid
+          drygriduncn(:,:,:,:,:,:)=drygriduncn(:,:,:,:,:,:)+griduncn_omp(:,:,1,:,:,:,:,i)
+          griduncn_omp(:,:,1,:,:,:,:,i)=0.
+        end do
+      endif
+    endif
+#endif
+  ! write(*,*) 'DRYGRIDUNC:',sum(drygridunc),drygridunc(20,270,1,1,1,1),drygridunc(19,269,1,1,1,1)
+  ! Counter of "unstable" particle velocity during a time scale of
+  ! maximumtl=20 minutes (defined in com_mod)
+  !***************************************************************
+
+    total_nan_intl=0
+    i_nan=i_nan+1 ! added by mc to count nan during a time of maxtl (i.e. maximum tl fixed here to 20 minutes, see com_mod)
+    do i=1,numthreads
+      sum_nan_count(i_nan)=sum_nan_count(i_nan)+nan_count(i)
+    end do
+    if (i_nan > maxtl/lsynctime) i_nan=1 !lsynctime must be <= maxtl
+    do ii_nan=1, (maxtl/lsynctime)
+      total_nan_intl=total_nan_intl+sum_nan_count(ii_nan)
+    end do
+  ! Output to keep track of the numerical instabilities in CBL simulation and if
+  ! they are compromising the final result (or not)
+    if (cblflag.eq.1) print *,j,itime,'nan_synctime',sum_nan_count(i_nan),'nan_tl',total_nan_intl
+
+    if (itime.eq.itime_init) then
+      call SYSTEM_CLOCK(count_clock, count_rate, count_max)
+      s_firstt = real(count_clock)/real(count_rate) - s_firstt
+    endif
+
+  end do
+
+  ! Complete the calculation of initial conditions for particles not yet terminated
+  !*****************************************************************************
+  call finalise_output(itime)
+
+  ! De-allocate memory and end
+  !***************************
+  call dealloc_all_particles
+  call dealloc_windf
+  call dealloc_domainfill
+  call dealloc_drydepo
+  call dealloc_convect
+  call dealloc_getfields
+  call dealloc_interpol
+  call dealloc_random
+  if (numbnests.ge.1) call dealloc_windf_nest
+  if (iflux.eq.1) deallocate(flux)
+  if (OHREA) deallocate(OH_field,OH_hourly,lonOH,latOH,altOH)
+  if (ipin.ne.3 .and. ipin.ne.4) &
+    deallocate(xpoint1,xpoint2,ypoint1,ypoint2,zpoint1,zpoint2,xmasssave)
+  deallocate(xmass)
+  deallocate(ireleasestart,ireleaseend,npart,kindz)
+  deallocate(nan_count)
+  if (ipout.ne.0) deallocate( partopt )
+  if (iout.ne.0) then
+    deallocate(outheight,outheighthalf)
+    deallocate(oroout, area, volume)
+    deallocate(gridunc)
+#ifdef _OPENMP
+    deallocate(gridunc_omp)
+#endif
+    if (ldirect.gt.0) then
+      deallocate(drygridunc,wetgridunc)
+#ifdef _OPENMP
+      deallocate(drygridunc_omp,wetgridunc_omp)
+#endif
+    endif
+    if (nested_output.eq.1) then
+      deallocate(orooutn, arean, volumen)
+      if (ldirect.gt.0) then
+        deallocate(griduncn,drygriduncn,wetgriduncn)
+#ifdef _OPENMP
+        deallocate(griduncn_omp,drygriduncn_omp,wetgriduncn_omp)
+#endif
+      endif
+    endif
+  endif
+end subroutine timemanager
diff --git a/src/timemanager_mod.f90 b/src/timemanager_mod.f90
index 1c0b2fb8c50c70f72f7c1ccc09cd683f62fa01ed..a921971dac87d21653ec705c1321c6de2165fb6c 100644
--- a/src/timemanager_mod.f90
+++ b/src/timemanager_mod.f90
@@ -13,653 +13,6 @@ implicit none
 
 contains
 
-subroutine timemanager
-
-  !*****************************************************************************
-  !                                                                            *
-  ! Handles the computation of trajectories, i.e. determines which             *
-  ! trajectories have to be computed at what time.                             *
-  ! Manages dry+wet deposition routines, radioactive decay and the computation *
-  ! of concentrations.                                                         *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     20 May 1996                                                            *
-  !                                                                            *
-  !*****************************************************************************
-  !  Changes, Bernd C. Krueger, Feb. 2001:                                     *
-  !        Call of convmix when new windfield is read                          *
-  !------------------------------------                                        *
-  !  Changes Petra Seibert, Sept 2002                                          *
-  !     fix wet scavenging problem                                             *
-  !     Code may not be correct for decay of deposition!                       *
-  !  Changes Petra Seibert, Nov 2002                                           *
-  !     call convection BEFORE new fields are read in BWD mode                 *
-  !  Changes Caroline Forster, Feb 2005                                        *
-  !   new interface between flexpart and convection scheme                     *
-  !   Emanuel's latest subroutine convect43c.f is used                         *
-  !  Changes Stefan Henne, Harald Sodemann, 2013-2014                          *
-  !   added netcdf output code                                                 *
-  !  Changes Espen Sollum 2014                                                 *
-  !   For compatibility with MPI version,                                      *
-  !   variables uap,ucp,uzp,us,vs,ws,cbt now in module com_mod                 *
-  !  Unified ECMWF and GFS builds                                              *
-  !   Marian Harustak, 12.5.2017                                               *
-  !  Changes L Bakels 2022: - OpenMP parallelisation                           *
-  !                         - converting input to ETA coordinates              *
-  !                         - spawning particles from part_ic.nc               *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! DEP                .true. if either wet or dry deposition is switched on   *
-  ! decay(maxspec) [1/s] decay constant for radioactive decay                  *
-  ! DRYDEP             .true. if dry deposition is switched on                 *
-  ! ideltas [s]        modelling period                                        *
-  ! itime [s]          actual temporal position of calculation                 *
-  ! ldeltat [s]        time since computation of radioact. decay of depositions*
-  ! loutaver [s]       averaging period for concentration calculations         *
-  ! loutend [s]        end of averaging for concentration calculations         *
-  ! loutnext [s]       next time at which output fields shall be centered      *
-  ! loutsample [s]     sampling interval for averaging of concentrations       *
-  ! loutstart [s]      start of averaging for concentration calculations       *
-  ! loutstep [s]       time interval for which concentrations shall be         *
-  !                    calculated                                              *
-  ! loutrestart [s]    time interval for which restart files will be produced  *
-  ! npoint             index, which starting point the trajectory has          *
-  !                    starting positions of trajectories                      *
-  ! nstop              serves as indicator for fate of particles               *
-  !                    in the particle loop                                    *
-  ! nstop1             serves as indicator for wind fields (see getfields)     *
-  ! outnum             number of samples for each concentration calculation    *
-  ! prob               probability of absorption at ground due to dry          *
-  !                    deposition                                              *
-  ! WETDEP             .true. if wet deposition is switched on                 *
-  ! weight             weight for each concentration sample (1/2 or 1)         *
-  !                                                                            *
-  !*****************************************************************************
-  ! openmp change
-  use omp_lib
-  ! openmp change end
-  use unc_mod
-  use point_mod
-  use xmass_mod
-  use flux_mod
-  use prepoutgrid_mod
-  use ohr_mod
-  use par_mod
-  use com_mod
-  use coord_ec_mod
-  use particle_mod
-  use conv_mod
-  use windfields_mod
-  use advance_mod, only: advance
-  use drydepo_mod
-  use wetdepo_mod
-  use plume_mod
-  use initialise_mod
-  use getfields_mod
-  use output_mod
-  use interpol_mod, only: alloc_interpol,dealloc_interpol
-
-  implicit none
-  real, parameter ::        &
-    e_inv = 1.0/exp(1.0)  
-  integer ::                &
-    j,i,                    & ! loop variable
-    ks,                     & ! loop variable species
-    kp,                     & ! loop variable for maxpointspec_act
-    l,                      & ! loop variable over nclassunc
-    n,                      & ! loop variable over particles
-    itime=0,                & ! time index
-    nstop1,                 & ! windfield existence flag
-    loutnext,               & ! following timestep
-    loutstart,loutend,      & ! concentration calculation starting and ending time
-    ix,jy,                  & ! gridcell indices
-    ldeltat,                & ! radioactive decay time
-    itage,nage,inage,       & ! related to age classes
-    idummy,                 & ! used for the random routines
-    i_nan=0,ii_nan,total_nan_intl=0, &  !added by mc to check instability in CBL scheme 
-    thread                    ! openmp change (not sure if necessary)
-  ! logical ::                &
-  !   active_per_rel(maxpoint)  ! are there particles active in each release
-  real ::                   &
-    filesize!(maxpoint)        ! Keeping track of the size of the particledump output, so it can be splitted
-  ! real(kind=dp) ::          &
-  !   jul
-  ! integer ::                &
-  !   jjjjmmdd,ihmmss
-  real ::                   &
-    outnum,                 & ! concentration calculation sample number
-    prob_rec(maxspec),      & ! dry deposition related
-    decfact,                & ! radioactive decay factor
-    wetscav,                & ! wet scavenging
-    xmassfract,             & ! dry deposition related
-    grfraction(3)             ! wet deposition related
-  real(dep_prec) ::         &
-    drydeposit(maxspec)       ! dry deposition related
-  real(kind=dp) :: zhier,zetahier
-  integer :: npart_alive=0,alive_tmp,spawned_tmp,terminated_tmp
-
-  ! First output for time 0
-  !************************
-  if (itime_init.ne.0) then
-    loutnext=loutnext_init
-    outnum=outnum_init
-  else
-    loutnext=loutstep/2
-    outnum=0.
-  endif
-  loutstart=loutnext-loutaver/2
-  loutend=loutnext+loutaver/2
-
-  ! Initialise the nan count for CBL option
-  !****************************************
-  sum_nan_count(:) = 0
-  nan_count(:) = 0
-
-  !**********************************************************************
-  ! Loop over the whole modelling period in time steps of mintime seconds
-  !**********************************************************************
-
-  write(*,46) float(itime)/3600,itime,numpart
-46      format(' Simulated ',f7.1,' hours (',i13,' s), ',i13, ' particles')
-
-  filesize=0.
-  ! active_per_rel=.false.
-
-  ! ! Allocate memory for windfields
-  ! !*******************************
-  ! call alloc_windf
-  
-  do itime=itime_init,ideltas,lsynctime
-
-  ! Computation of wet deposition, OH reaction and mass transfer
-  ! between two species every lsynctime seconds
-  ! maybe wet depo frequency can be relaxed later but better be on safe side
-  ! wetdepo must be called BEFORE new fields are read in but should not
-  ! be called in the very beginning before any fields are loaded, or
-  ! before particles are in the system
-  ! Code may not be correct for decay of deposition
-  ! changed by Petra Seibert 9/02
-  !********************************************************************
-
-  ! Write basic information on the simulation to a file "header" for the
-  ! first time step and open files that are to be kept open throughout 
-  ! the simulation.
-  ! In addition, open new particle dump files if required and keep track
-  ! of the size of these files.
-  !*********************************************************************
-    
-    write(*,*) 'Time: ', itime, 'seconds.'
-
-    if (itime.eq.itime_init) then
-      call SYSTEM_CLOCK(count_clock, count_rate, count_max)
-      s_firstt = real(count_clock)/real(count_rate)
-    endif
-
-  ! Writing restart file
-  !*********************
-    if ((itime.ne.itime_init).and.(mod(itime,loutrestart).eq.0)) call output_restart(itime,loutnext,outnum)
-
-    if (itime.ne.0) write(*,*) part(1)%xlon,part(1)%ylat,part(1)%z,part(1)%zeta
-    call init_output(itime,filesize)
-    
-  ! Get necessary wind fields if not available
-  !*******************************************
-    call getfields(itime,nstop1) !OMP on verttransform_ecmwf and readwind_ecmwf, getfields_mod.f90
-    if (nstop1.gt.1) stop 'NO METEO FIELDS AVAILABLE'
-
-  ! In case of ETA coordinates being read from file, convert the z positions
-  !*************************************************************************
-    if (((ipin.eq.1).or.(ipin.eq.4)).and.(itime.eq.itime_init).and.(wind_coord_type.eq.'ETA')) then 
-      if (numpart.le.0) stop 'Something is going wrong reading the old particle file!'
-!$OMP PARALLEL PRIVATE(i)
-!$OMP DO
-      do i=1,numpart
-        call update_z_to_zeta(itime, i)
-      end do
-!$OMP END DO
-!$OMP END PARALLEL
-    endif
-
-    if ((ipin.eq.3).and.(itime.eq.itime_init).and.(wind_coord_type.eq.'ETA')) then
-      do i=1,count%allocated
-        call update_z_to_zeta(itime, i)
-      end do
-    endif
-
-    if (WETDEP .and. (itime.ne.0) .and. (numpart.gt.0)) then
-      call wetdepo(itime,lsynctime,loutnext) !OMP, wetdepo_mod.f90 (needs test)
-    endif
-
-    if (OHREA .and. (itime.ne.0) .and. (numpart.gt.0)) &
-      call ohreaction(itime,lsynctime,loutnext) !OMP, ohr_mod.f90 (needs test)
-
-  ! compute convection for backward runs
-  !*************************************
-
-    if ((ldirect.eq.-1).and.(lconvection.eq.1).and.(itime.lt.0)) then
-      call convmix(itime) !OMP, conv_mod.f90
-    endif
-
-  ! Get hourly OH fields if not available 
-  !****************************************************
-    if (OHREA) then
-      call gethourlyOH(itime) !OMP, ohr_mod.f90 (needs test)
-    endif
-        
-  ! Release particles
-  !******************
-    if (mdomainfill.ge.1) then
-      if (itime.eq.itime_init) then   
-        call init_domainfill !OMP, initialise_mod.f90 (needs test)
-      else 
-        call boundcond_domainfill(itime,loutend) !OMP, initialise_mod.f90 (needs test)
-      endif
-    else if ((ipin.eq.3).or.(ipin.eq.4)) then
-      ! If reading from user defined initial conditions, check which particles are 
-      ! to be activated
-      if (count%allocated.le.0) stop 'Something is going wrong reading the part_ic.nc file!'
-
-      alive_tmp=count%alive
-      spawned_tmp=count%spawned
-!$OMP PARALLEL PRIVATE(i) REDUCTION(+:alive_tmp,spawned_tmp)
-!$OMP DO
-      do i=1,count%allocated
-        if (.not. part(i)%alive) then
-          if (ldirect.lt.0) then
-            if ((part(i)%tstart.le.itime).and.(part(i)%tstart.gt.itime+lsynctime)) then
-              call spawn_particle(itime,i)
-              call update_z_to_zeta(itime,i)
-              alive_tmp=alive_tmp+1
-              spawned_tmp=spawned_tmp+1
-            endif
-          else if ((part(i)%tstart.ge.itime).and.(part(i)%tstart.lt.itime+lsynctime)) then
-            call spawn_particle(itime,i)
-            call update_z_to_zeta(itime,i)
-            alive_tmp=alive_tmp+1
-            spawned_tmp=spawned_tmp+1
-          endif
-        endif
-      end do
-!$OMP END DO
-!$OMP END PARALLEL
-      count%alive=alive_tmp
-      count%spawned=spawned_tmp
-      call get_totalpart_num(numpart)
-    else
-      call releaseparticle(itime)
-    endif
-
-  ! Compute convective mixing for forward runs
-  ! for backward runs it is done before next windfield is read in
-  !**************************************************************
-    if ((ldirect.eq.1).and.(lconvection.eq.1)) then
-      call convmix(itime) !OMP (not the nested part yet), conv_mod.f90
-    endif
-
-  ! If middle of averaging period of output fields is reached, accumulated
-  ! deposited mass radioactively decays
-  !***********************************************************************
-    if (DEP.and.(itime.eq.loutnext).and.(ldirect.gt.0)) call deposit_decay() !OMP, unc_mod.f90 (needs test)
-
-
-  ! Is the time within the computation interval, if not, skip
-  !************************************************************
-    if ((ldirect*itime.ge.ldirect*loutstart).and.(ldirect*itime.le.ldirect*loutend)) then
-      call SYSTEM_CLOCK(count_clock, count_rate, count_max)
-      s_temp = (count_clock - count_clock0)/real(count_rate)
-      ! If it is not time yet to write outputs, skip
-      !***********************************************
-      if ((itime.eq.loutend).and.(outnum.gt.0).and.(itime.ne.0)) then
-
-        if ((iout.eq.4).or.(iout.eq.5)) call plumetraj(itime)
-        if (iflux.eq.1) call fluxoutput(itime)
-        if (ipout.ge.1) then
-          if (mod(itime,ipoutfac*loutstep).eq.0) then
-
-            call output_particle(itime)!,active_per_rel) ! dump particle positions
-          endif
-        endif
-      endif
-      ! Check whether concentrations are to be calculated and outputted
-      !****************************************************************
-      call output_conc(itime,loutstart,loutend,loutnext,outnum)
-      call SYSTEM_CLOCK(count_clock, count_rate, count_max)
-      s_writepart = s_writepart + ((count_clock - count_clock0)/real(count_rate)-s_temp)
-    endif
-
-    if (itime.eq.ideltas) exit         ! almost finished
-
-  ! Compute interval since radioactive decay of deposited mass was computed
-  !************************************************************************
-
-    if (itime.lt.loutnext) then
-      ldeltat=itime-(loutnext-loutstep)
-    else                                  ! first half of next interval
-      ldeltat=itime-loutnext
-    endif
-
-
-  ! Loop over all particles
-  !************************
-  ! Various variables for testing reason of CBL scheme, by mc
-    well_mixed_vector=0. !erase vector to test well mixed condition: modified by mc
-    well_mixed_norm=0.   !erase normalization to test well mixed condition: modified by mc
-    avg_ol=0.
-    avg_wst=0.
-    avg_h=0.
-    avg_air_dens=0.  !erase vector to obtain air density at particle positions: modified by mc
-  !-----------------------------------------------------------------------------
-
-  ! openmp change
-  ! LB, openmp following CTM version, need to be very careful due to big differences
-  ! between the openmp loop in this and the CTM version
-!$OMP PARALLEL PRIVATE(prob_rec,inage,nage,itage,ks,kp,thread,j,xmassfract,drydeposit)
-
-#if (defined _OPENMP)
-    thread = OMP_GET_THREAD_NUM() ! Starts with 0
-#else
-    thread = 0
-#endif
-
-!$OMP DO 
-! SCHEDULE(dynamic, max(1,numpart/1000))
-!max(1,int(real(numpart)/numthreads/20.)))
-    do j=1,numpart
-
-  ! If integration step is due, do it
-  !**********************************
-      if (.not. part(j)%alive) cycle
-
-  ! Determine age class of the particle
-  !************************************
-      itage=abs(itime-part(j)%tstart)
-      nage=1
-      do inage=1,nageclass
-        nage=inage
-        if (itage.lt.lage(nage)) exit
-      end do
-
-  ! Initialize newly released particle
-  !***********************************
-      if ((part(j)%tstart.eq.itime).or.(itime.eq.0)) then
-        call update_zeta_to_z(itime, j)
-        call init_particle(itime,j)
-      endif
-
-  ! Memorize particle positions
-  !****************************
-      part(j)%xlon_prev=part(j)%xlon
-      part(j)%ylat_prev=part(j)%ylat
-      part(j)%z_prev=part(j)%z
-      part(j)%zeta_prev=part(j)%zeta
-
-  ! RECEPTOR: dry/wet depovel
-  !****************************
-  ! Before the particle is moved 
-  ! the calculation of the scavenged mass shall only be done once after release
-  ! xscav_frac1 was initialised with a negative value
-
-      if  (DRYBKDEP) then
-        do ks=1,nspec
-          if  ((xscav_frac1(j,ks).lt.0)) then
-            call update_zeta_to_z(itime,j)
-            call get_vdep_prob(itime,real(part(j)%xlon),real(part(j)%ylat), &
-              real(part(j)%z),prob_rec)
-            if (DRYDEPSPEC(ks)) then        ! dry deposition
-              xscav_frac1(j,ks)=prob_rec(ks)
-            else
-              part(j)%mass(ks)=0.
-              xscav_frac1(j,ks)=0.
-            endif
-          endif
-        enddo
-      endif
-
-  ! Integrate Langevin equation for lsynctime seconds
-  !*************************************************
-
-      call advance(itime,j,thread)
-
-      if (part(j)%nstop.eqv..true.) cycle
-      if (n_average.gt.0) call partpos_avg(itime,j)
-
-  ! Calculate the gross fluxes across layer interfaces
-  !***************************************************
-      if (iflux.eq.1) call calcfluxes(itime,nage,j,real(part(j)%xlon_prev), &
-        real(part(j)%ylat_prev),real(part(j)%z_prev),thread+1)
-    end do
-!$OMP END DO
-!$OMP END PARALLEL
-
-#ifdef _OPENMP
-  call omp_set_num_threads(numthreads_grid)
-#endif
-
-  alive_tmp=count%alive
-  terminated_tmp=count%terminated
-
-!$OMP PARALLEL PRIVATE(prob_rec,nage,inage,itage,ks,kp,thread,j,xmassfract,drydeposit) &
-!$OMP REDUCTION(+:alive_tmp,terminated_tmp) 
-
-!num_threads(numthreads_grid)
-
-#if (defined _OPENMP)
-    thread = OMP_GET_THREAD_NUM() ! Starts with 0
-#else
-    thread = 0
-#endif
-
-!$OMP DO 
-! SCHEDULE(dynamic, max(1,numpart/1000))
-!max(1,int(real(numpart)/numthreads/20.)))
-    do j=1,numpart
-
-  ! If integration step is due, do it
-  !**********************************
-      if (.not. part(j)%alive) cycle
-
-  ! Determine age class of the particle
-  !************************************
-      itage=abs(itime-part(j)%tstart)
-      nage=1
-      do inage=1,nageclass
-        nage=inage
-        if (itage.lt.lage(nage)) exit
-      end do
-
-  ! Determine, when next time step is due
-  ! If trajectory is terminated, mark it
-  !**************************************
-      if (part(j)%nstop) then
-        if (linit_cond.ge.1) call initcond_calc(itime,j,thread+1)
-        call terminate_particle(j,itime)
-        alive_tmp=alive_tmp-1
-        terminated_tmp=terminated_tmp+1
-      else
-
-! Dry deposition and radioactive decay for each species
-! Also check maximum (of all species) of initial mass remaining on the particle;
-! if it is below a threshold value, terminate particle
-!*****************************************************************************
-
-        xmassfract=0.
-        do ks=1,nspec
-
-          if (DRYDEPSPEC(ks)) then     ! dry deposition (and radioactive decay)
-
-            call drydepo_massloss(j,ks,ldeltat,drydeposit(ks))
-
-          else if (decay(ks).gt.0.) then  ! no dry depo, but radioactive decay
-
-            part(j)%mass(ks) = part(j)%mass(ks) * &
-              exp( -real(abs(lsynctime)) * decay(ks) )
-
-          endif
-
-  ! Skip check on mass fraction when npoint represents particle number
-          if (mdomainfill.eq.0.and.mquasilag.eq.0) then
-            if (ipin.eq.3 .or. ipin.eq.4) then 
-              if (part(j)%mass_init(ks).gt.0) &
-                xmassfract = max( xmassfract, &
-                                  part(j)%mass(ks) / part(j)%mass_init(ks) )
-            else if (xmass(part(j)%npoint,ks).gt.0.) then
-              xmassfract = max( xmassfract, real( npart(part(j)%npoint) ) * &
-                part(j)%mass(ks) /  xmass(part(j)%npoint,ks) )
-            endif
-          else
-            xmassfract=1.0
-          end if
-
-        end do
-        
-        if (xmassfract.le.minmassfrac) then 
-          ! terminate all particles carrying less mass
-          call terminate_particle(j,itime)
-          alive_tmp=alive_tmp-1
-          terminated_tmp=terminated_tmp+1
-        endif
-
-!        Sabine Eckhardt, June 2008
-!        don't create depofield for backward runs
-        if (DRYDEP.AND.(ldirect.eq.1).and.(iout.ne.0)) then
-
-          if (ioutputforeachrelease.eq.1) then
-              kp=part(j)%npoint
-          else
-              kp=1
-          endif
-
-          call drydepokernel(part(j)%nclass,drydeposit,real(part(j)%xlon), &
-               real(part(j)%ylat),nage,kp,thread+1)
-          if (nested_output.eq.1) call drydepokernel_nest( &
-               part(j)%nclass,drydeposit,real(part(j)%xlon),real(part(j)%ylat), &
-               nage,kp,thread+1)
-        endif
-
-  ! Terminate trajectories that are older than maximum allowed age
-  !***************************************************************
-
-        if ((part(j)%alive).and.(abs(itime-part(j)%tstart).ge.lage(nageclass))) then
-          if (linit_cond.ge.1) call initcond_calc(itime+lsynctime,j,thread+1)
-          call terminate_particle(j,itime)
-          alive_tmp=alive_tmp-1
-          terminated_tmp=terminated_tmp+1
-        endif
-      endif
-
-    end do !loop over particles
-
-!$OMP END DO
-!$OMP END PARALLEL
-
-  count%alive=alive_tmp
-  count%terminated=terminated_tmp
-
-#ifdef _OPENMP
-  call omp_set_num_threads(numthreads)
-#endif
-  ! OpenMP Reduction for dynamically allocated arrays. This is done manually since this
-  ! is not yet supported in most OpenMP versions
-  !************************************************************************************
-#ifdef _OPENMP
-    if (iflux.eq.1) then
-      do i=1,numthreads
-        flux(:,:,:,:,:,:,:)=flux(:,:,:,:,:,:,:)+flux_omp(:,:,:,:,:,:,:,i)
-        flux_omp(:,:,:,:,:,:,:,i)=0.
-      end do
-    endif
-    if (linit_cond.ge.1) then
-      do i=1,numthreads_grid
-        init_cond(:,:,:,:,:)=init_cond(:,:,:,:,:)+init_cond_omp(:,:,:,:,:,i)
-        init_cond_omp(:,:,:,:,:,i)=0.
-      end do
-    endif
-    if (DRYDEP.AND.(ldirect.eq.1).and.(iout.ne.0)) then
-      do i=1,numthreads_grid
-        drygridunc(:,:,:,:,:,:)=drygridunc(:,:,:,:,:,:)+gridunc_omp(:,:,1,:,:,:,:,i)
-        gridunc_omp(:,:,1,:,:,:,:,i)=0.
-      end do
-      if (nested_output.eq.1) then
-        do i=1,numthreads_grid
-          drygriduncn(:,:,:,:,:,:)=drygriduncn(:,:,:,:,:,:)+griduncn_omp(:,:,1,:,:,:,:,i)
-          griduncn_omp(:,:,1,:,:,:,:,i)=0.
-        end do
-      endif
-    endif
-#endif
-  ! write(*,*) 'DRYGRIDUNC:',sum(drygridunc),drygridunc(20,270,1,1,1,1),drygridunc(19,269,1,1,1,1)
-  ! Counter of "unstable" particle velocity during a time scale of
-  ! maximumtl=20 minutes (defined in com_mod)
-  !***************************************************************
-    
-    total_nan_intl=0
-    i_nan=i_nan+1 ! added by mc to count nan during a time of maxtl (i.e. maximum tl fixed here to 20 minutes, see com_mod)
-    do i=1,numthreads
-      sum_nan_count(i_nan)=sum_nan_count(i_nan)+nan_count(i)
-    end do
-    if (i_nan > maxtl/lsynctime) i_nan=1 !lsynctime must be <= maxtl
-    do ii_nan=1, (maxtl/lsynctime) 
-      total_nan_intl=total_nan_intl+sum_nan_count(ii_nan)
-    end do
-  ! Output to keep track of the numerical instabilities in CBL simulation and if
-  ! they are compromising the final result (or not)
-    if (cblflag.eq.1) print *,j,itime,'nan_synctime',sum_nan_count(i_nan),'nan_tl',total_nan_intl  
-
-    if (itime.eq.itime_init) then
-      call SYSTEM_CLOCK(count_clock, count_rate, count_max)
-      s_firstt = real(count_clock)/real(count_rate) - s_firstt
-    endif
-
-  end do
-
-  ! Complete the calculation of initial conditions for particles not yet terminated
-  !*****************************************************************************
-  call finalise_output(itime)
-
-  ! De-allocate memory and end
-  !***************************
-  call dealloc_all_particles
-  call dealloc_windf
-  call dealloc_domainfill
-  call dealloc_drydepo
-  call dealloc_convect
-  call dealloc_getfields
-  call dealloc_interpol
-  call dealloc_random
-  if (numbnests.ge.1) call dealloc_windf_nest
-  if (iflux.eq.1) deallocate(flux)
-  if (OHREA) deallocate(OH_field,OH_hourly,lonOH,latOH,altOH)
-  if (ipin.ne.3 .and. ipin.ne.4) &
-    deallocate(xpoint1,xpoint2,ypoint1,ypoint2,zpoint1,zpoint2,xmasssave)
-  deallocate(xmass)
-  deallocate(ireleasestart,ireleaseend,npart,kindz)
-  deallocate(nan_count)
-  if (ipout.ne.0) deallocate( partopt )
-  if (iout.ne.0) then
-    deallocate(outheight,outheighthalf)
-    deallocate(oroout, area, volume)
-    deallocate(gridunc)
-#ifdef _OPENMP
-    deallocate(gridunc_omp)
-#endif
-    if (ldirect.gt.0) then
-      deallocate(drygridunc,wetgridunc)
-#ifdef _OPENMP
-      deallocate(drygridunc_omp,wetgridunc_omp)
-#endif
-    endif
-    if (nested_output.eq.1) then
-      deallocate(orooutn, arean, volumen)
-      if (ldirect.gt.0) then
-        deallocate(griduncn,drygriduncn,wetgriduncn)
-#ifdef _OPENMP
-        deallocate(griduncn_omp,drygriduncn_omp,wetgriduncn_omp)
-#endif
-      endif
-    endif
-  endif
-end subroutine timemanager
+#include "tim_timemanager.f90"
 
 end module timemanager_mod
diff --git a/src/tur_hanna.f90 b/src/tur_hanna.f90
new file mode 100644
index 0000000000000000000000000000000000000000..5deaa30fea4ae95d901f38fa56cc02a3d0154665
--- /dev/null
+++ b/src/tur_hanna.f90
@@ -0,0 +1,102 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine hanna(z)
+  !                 i
+  !*****************************************************************************
+  !                                                                            *
+  !   Computation of \sigma_i and \tau_L based on the scheme of Hanna (1982)   *
+  !                                                                            *
+  !   Author: A. Stohl                                                         *
+  !                                                                            *
+  !   4 December 1997                                                          *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! dsigwdz [1/s]     vertical gradient of sigw                                *
+  ! ol [m]            Obukhov length                                           *
+  ! sigu, sigv, sigw  standard deviations of turbulent velocity fluctuations   *
+  ! tlu [s]           Lagrangian time scale for the along wind component.      *
+  ! tlv [s]           Lagrangian time scale for the cross wind component.      *
+  ! tlw [s]           Lagrangian time scale for the vertical wind component.   *
+  ! ust, ustar [m/s]  friction velocity                                        *
+  ! wst, wstar [m/s]  convective velocity scale                                *
+  !                                                                            *
+  !*****************************************************************************
+
+  implicit none
+
+  real :: corr,z
+
+
+  !**********************
+  ! 1. Neutral conditions
+  !**********************
+
+  if (h/abs(ol).lt.1.) then
+    ust=max(1.e-4,ust)
+    corr=z/ust
+    sigu=1.e-2+2.0*ust*exp(-3.e-4*corr)
+    sigw=1.3*ust*exp(-2.e-4*corr)
+    dsigwdz=-2.e-4*sigw
+    sigw=sigw+1.e-2
+    sigv=sigw
+    tlu=0.5*z/sigw/(1.+1.5e-3*corr)
+    tlv=tlu
+    tlw=tlu
+
+
+  !***********************
+  ! 2. Unstable conditions
+  !***********************
+
+  else if (ol.lt.0.) then
+
+
+  ! Determine sigmas
+  !*****************
+
+    sigu=1.e-2+ust*(12.-0.5*h/ol)**0.33333
+    sigv=sigu
+    sigw=sqrt(1.2*wst**2*(1.-.9*zeta)*zeta**0.66666+ &
+         (1.8-1.4*zeta)*ust**2)+1.e-2
+    dsigwdz=0.5/sigw/h*(-1.4*ust**2+wst**2* &
+         (0.8*max(zeta,1.e-3)**(-.33333)-1.8*zeta**0.66666))
+
+
+  ! Determine average Lagrangian time scale
+  !****************************************
+
+    tlu=0.15*h/sigu
+    tlv=tlu
+    if (z.lt.abs(ol)) then
+      tlw=0.1*z/(sigw*(0.55-0.38*abs(z/ol)))
+    else if (zeta.lt.0.1) then
+      tlw=0.59*z/sigw
+    else
+      tlw=0.15*h/sigw*(1.-exp(-5*zeta))
+    endif
+
+
+  !*********************
+  ! 3. Stable conditions
+  !*********************
+
+  else
+    sigu=1.e-2+2.*ust*(1.-zeta)
+    sigv=1.e-2+1.3*ust*(1.-zeta)
+    sigw=sigv
+    dsigwdz=-1.3*ust/h
+    tlu=0.15*h/sigu*(sqrt(zeta))
+    tlv=0.467*tlu
+    tlw=0.1*h/sigw*zeta**0.8
+  endif
+
+
+  tlu=max(10.,tlu)
+  tlv=max(10.,tlv)
+  tlw=max(30.,tlw)
+
+  if (dsigwdz.eq.0.) dsigwdz=1.e-10
+end subroutine hanna
diff --git a/src/tur_hanna1.f90 b/src/tur_hanna1.f90
new file mode 100644
index 0000000000000000000000000000000000000000..08c48a8b02fcb7901b1553fccb078893a36710de
--- /dev/null
+++ b/src/tur_hanna1.f90
@@ -0,0 +1,125 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine hanna1(z)
+  !                  i
+  !*****************************************************************************
+  !                                                                            *
+  !   Computation of \sigma_i and \tau_L based on the scheme of Hanna (1982)   *
+  !                                                                            *
+  !   Author: A. Stohl                                                         *
+  !                                                                            *
+  !   4 December 1997                                                          *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! dsigwdz [1/s]     vertical gradient of sigw                                *
+  ! ol [m]            Obukhov length                                           *
+  ! sigu, sigv, sigw  standard deviations of turbulent velocity fluctuations   *
+  ! tlu [s]           Lagrangian time scale for the along wind component.      *
+  ! tlv [s]           Lagrangian time scale for the cross wind component.      *
+  ! tlw [s]           Lagrangian time scale for the vertical wind component.   *
+  ! ust, ustar [m/s]  friction velocity                                        *
+  ! wst, wstar [m/s]  convective velocity scale                                *
+  !                                                                            *
+  !*****************************************************************************
+
+  implicit none
+
+  real :: z,s1,s2
+
+
+
+  !**********************
+  ! 1. Neutral conditions
+  !**********************
+
+  if (h/abs(ol).lt.1.) then
+
+    ust=max(1.e-4,ust)
+    sigu=2.0*ust*exp(-3.e-4*z/ust)
+    sigu=max(sigu,1.e-5)
+    sigv=1.3*ust*exp(-2.e-4*z/ust)
+    sigv=max(sigv,1.e-5)
+    sigw=sigv
+    dsigw2dz=-6.76e-4*ust*exp(-4.e-4*z/ust)
+    tlu=0.5*z/sigw/(1.+1.5e-3*z/ust)
+    tlv=tlu
+    tlw=tlu
+
+
+  !***********************
+  ! 2. Unstable conditions
+  !***********************
+
+  else if (ol.lt.0.) then
+
+
+  ! Determine sigmas
+  !*****************
+
+    sigu=ust*(12.-0.5*h/ol)**0.33333
+    sigu=max(sigu,1.e-6)
+    sigv=sigu
+
+    if (zeta.lt.0.03) then
+      sigw=0.96*wst*(3*zeta-ol/h)**0.33333
+      dsigw2dz=1.8432*wst*wst/h*(3*zeta-ol/h)**(-0.33333)
+    else if (zeta.lt.0.4) then
+      s1=0.96*(3*zeta-ol/h)**0.33333
+      s2=0.763*zeta**0.175
+      if (s1.lt.s2) then
+        sigw=wst*s1
+        dsigw2dz=1.8432*wst*wst/h*(3*zeta-ol/h)**(-0.33333)
+      else
+        sigw=wst*s2
+        dsigw2dz=0.203759*wst*wst/h*zeta**(-0.65)
+      endif
+    else if (zeta.lt.0.96) then
+      sigw=0.722*wst*(1-zeta)**0.207
+      dsigw2dz=-.215812*wst*wst/h*(1-zeta)**(-0.586)
+    else if (zeta.lt.1.00) then
+      sigw=0.37*wst
+      dsigw2dz=0.
+    endif
+    sigw=max(sigw,1.e-6)
+
+
+  ! Determine average Lagrangian time scale
+  !****************************************
+
+    tlu=0.15*h/sigu
+    tlv=tlu
+    if (z.lt.abs(ol)) then
+      tlw=0.1*z/(sigw*(0.55-0.38*abs(z/ol)))
+    else if (zeta.lt.0.1) then
+      tlw=0.59*z/sigw
+    else
+      tlw=0.15*h/sigw*(1.-exp(-5*zeta))
+    endif
+
+
+  !*********************
+  ! 3. Stable conditions
+  !*********************
+
+  else
+    sigu=2.*ust*(1.-zeta)
+    sigv=1.3*ust*(1.-zeta)
+    sigu=max(sigu,1.e-6)
+    sigv=max(sigv,1.e-6)
+    sigw=sigv
+    dsigw2dz=3.38*ust*ust*(zeta-1.)/h
+    tlu=0.15*h/sigu*(sqrt(zeta))
+    tlv=0.467*tlu
+    tlw=0.1*h/sigw*zeta**0.8
+  endif
+
+
+
+
+  tlu=max(10.,tlu)
+  tlv=max(10.,tlv)
+  tlw=max(30.,tlw)
+end subroutine hanna1
diff --git a/src/tur_hanna_short.f90 b/src/tur_hanna_short.f90
new file mode 100644
index 0000000000000000000000000000000000000000..eeb203de9bdc74dec9d8e9b6fc10dc7a66b94de9
--- /dev/null
+++ b/src/tur_hanna_short.f90
@@ -0,0 +1,89 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine hanna_short(z)
+  !                       i
+  !*****************************************************************************
+  !                                                                            *
+  !   Computation of \sigma_i and \tau_L based on the scheme of Hanna (1982)   *
+  !                                                                            *
+  !   Author: A. Stohl                                                         *
+  !                                                                            *
+  !   4 December 1997                                                          *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! dsigwdz [1/s]     vertical gradient of sigw                                *
+  ! ol [m]            Obukhov length                                           *
+  ! sigu, sigv, sigw  standard deviations of turbulent velocity fluctuations   *
+  ! tlu [s]           Lagrangian time scale for the along wind component.      *
+  ! tlv [s]           Lagrangian time scale for the cross wind component.      *
+  ! tlw [s]           Lagrangian time scale for the vertical wind component.   *
+  ! ust, ustar [m/s]  friction velocity                                        *
+  ! wst, wstar [m/s]  convective velocity scale                                *
+  !                                                                            *
+  !*****************************************************************************
+
+  implicit none
+
+  real :: z
+
+
+
+  !**********************
+  ! 1. Neutral conditions
+  !**********************
+
+  if (h/abs(ol).lt.1.) then
+    ust=max(1.e-4,ust)
+    sigw=1.3*exp(-2.e-4*z/ust)
+    dsigwdz=-2.e-4*sigw
+    sigw=sigw*ust+1.e-2
+    tlw=0.5*z/sigw/(1.+1.5e-3*z/ust)
+
+
+  !***********************
+  ! 2. Unstable conditions
+  !***********************
+
+  else if (ol.lt.0.) then
+
+
+  ! Determine sigmas
+  !*****************
+
+    sigw=sqrt(1.2*wst**2*(1.-.9*zeta)*zeta**0.66666+ &
+         (1.8-1.4*zeta)*ust**2)+1.e-2
+    dsigwdz=0.5/sigw/h*(-1.4*ust**2+wst**2* &
+         (0.8*max(zeta,1.e-3)**(-.33333)-1.8*zeta**0.66666))
+
+
+  ! Determine average Lagrangian time scale
+  !****************************************
+
+    if (z.lt.abs(ol)) then
+      tlw=0.1*z/(sigw*(0.55-0.38*abs(z/ol)))
+    else if (zeta.lt.0.1) then
+      tlw=0.59*z/sigw
+    else
+      tlw=0.15*h/sigw*(1.-exp(-5*zeta))
+    endif
+
+
+  !*********************
+  ! 3. Stable conditions
+  !*********************
+
+  else
+    sigw=1.e-2+1.3*ust*(1.-zeta)
+    dsigwdz=-1.3*ust/h
+    tlw=0.1*h/sigw*zeta**0.8
+  endif
+
+
+  tlu=max(10.,tlu)
+  tlv=max(10.,tlv)
+  tlw=max(30.,tlw)
+  if (dsigwdz.eq.0.) dsigwdz=1.e-10
+end subroutine hanna_short
diff --git a/src/tur_pbl_profile.f90 b/src/tur_pbl_profile.f90
new file mode 100644
index 0000000000000000000000000000000000000000..dd974cb35de7d0d52c14dc9ff60eddadc1dbdbac
--- /dev/null
+++ b/src/tur_pbl_profile.f90
@@ -0,0 +1,113 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine pbl_profile(ps,td2m,zml1,t2m,tml1,u10m,uml1,stress,hf)
+
+  !********************************************************************
+  !                                                                   *
+  !                    G. WOTAWA, 1995-07-07                          *
+  !                                                                   *
+  !********************************************************************
+  !                                                                   *
+  ! DESCRIPTION: CALCULATION OF FRICTION VELOCITY AND SURFACE SENS-   *
+  !              IBLE HEAT FLUX USING THE PROFILE METHOD (BERKOVICZ   *
+  !              AND PRAHM, 1982)                                     *
+  !                                                                   *
+  ! Output now is surface stress instead of ustar                     *
+  !                                                                   *
+  !                                                                   *
+  !********************************************************************
+  !                                                                   *
+  ! INPUT:                                                            *
+  !                                                                   *
+  !                                                                   *
+  ! ps      surface pressure(Pa)                                      *
+  ! td2m    two metre dew point(K)                                    *
+  ! zml1    heigth of first model level (m)                           *
+  ! t2m     two metre temperature (K)                                 *
+  ! tml1    temperature first model level (K)                         *
+  ! u10m    ten metre wind speed (ms-1)                               *
+  ! uml1    wind speed first model level (ms-1)                       *
+  !                                                                   *
+  !********************************************************************
+  !                                                                   *
+  ! OUTPUT:                                                           *
+  !                                                                   *
+  ! stress  surface stress (i.e., friction velocity (ms-1) squared    *
+  !                         multiplied with air density)              *
+  ! hf      surface sensible heat flux (Wm-2)                         *
+  !                                                                   *
+  !********************************************************************
+  ! ustar   friction velocity (ms-1)                                  *
+  ! maxiter maximum number of iterations                              *
+  !********************************************************************
+
+  use qvsat_mod
+
+  implicit none
+
+  integer :: iter
+  real :: ps,td2m,rhoa,zml1,t2m,tml1,u10m,uml1,ustar,hf
+  real :: al,alold,aldiff,tmean,crit
+  real :: deltau,deltat,thetastar,e,tv,stress
+  integer,parameter :: maxiter=10
+  real,parameter    :: r1=0.74
+
+  e=ew(td2m,ps)               ! vapor pressure
+  tv=t2m*(1.+0.378*e/ps)   ! virtual temperature
+  rhoa=ps/(r_air*tv)       ! air density
+
+  deltau=uml1-u10m         !! Wind Speed difference between
+                           !! Model level 1 and 10 m
+
+  if(deltau.le.0.001) then    !! Monin-Obukhov Theory not
+    al=9999.               !! applicable --> Set dummy values
+    ustar=0.01
+    stress=ustar*ustar*rhoa
+    hf=0.0
+    return
+  endif
+  deltat=tml1-t2m+0.0098*(zml1-2.)  !! Potential temperature difference
+                                    !! between model level 1 and 10 m
+
+  if(abs(deltat).le.0.03) then    !! Neutral conditions
+    hf=0.0
+    al=9999.
+    ustar=(vonkarman*deltau)/ &
+         (log(zml1/10.)-psim(zml1,al)+psim(10.,al))
+    stress=ustar*ustar*rhoa
+    return
+  endif
+
+  tmean=0.5*(t2m+tml1)
+  crit=(0.0219*tmean*(zml1-2.0)*deltau**2)/ &
+       (deltat*(zml1-10.0)**2)
+  if((deltat.gt.0).and.(crit.le.1.)) then
+                                    !! Successive approximation will
+    al=50.                          !! not converge
+    ustar=(vonkarman*deltau)/ &
+         (log(zml1/10.)-psim(zml1,al)+psim(10.,al))
+    thetastar=(vonkarman*deltat/r1)/ &
+         (log(zml1/2.)-psih(zml1,al)+psih(2.,al))
+    hf=rhoa*cpa*ustar*thetastar
+    stress=ustar*ustar*rhoa
+    return
+  endif
+
+  al=9999.                 ! Start iteration assuming neutral conditions
+  do iter=1,maxiter
+    alold=al
+    ustar=(vonkarman*deltau)/ &
+         (log(zml1/10.)-psim(zml1,al)+psim(10.,al))
+    thetastar=(vonkarman*deltat/r1)/ &
+         (log(zml1/2.)-psih(zml1,al)+psih(2.,al))
+    al=(tmean*ustar**2)/(ga*vonkarman*thetastar)
+    aldiff=abs((al-alold)/alold)
+    if(aldiff.lt.0.01) exit  !! Successive approximation successful
+  end do
+  hf=rhoa*cpa*ustar*thetastar
+  if(al.gt.9999.) al=9999.
+  if(al.lt.-9999.) al=-9999.
+
+  stress=ustar*ustar*rhoa
+end subroutine pbl_profile
diff --git a/src/tur_psih.f90 b/src/tur_psih.f90
new file mode 100644
index 0000000000000000000000000000000000000000..a72d6ea562526d4ae1e3078f113457ebde981e48
--- /dev/null
+++ b/src/tur_psih.f90
@@ -0,0 +1,56 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+function psih (z,l)
+
+  !*****************************************************************************
+  !                                                                            *
+  !     Calculation of the stability correction term                           *
+  !                                                                            *
+  !     AUTHOR: Matthias Langer, adapted by Andreas Stohl (6 August 1993)      *
+  !             Update: G. Wotawa, 11 October 1994                             *
+  !                                                                            *
+  !     Literature:                                                            *
+  !     [1] C.A.Paulson (1970), A Mathematical Representation of Wind Speed    *
+  !           and Temperature Profiles in the Unstable Atmospheric Surface     *
+  !           Layer. J.Appl.Met.,Vol.9.(1970), pp.857-861.                     *
+  !                                                                            *
+  !     [2] A.C.M. Beljaars, A.A.M. Holtslag (1991), Flux Parameterization over*
+  !           Land Surfaces for Atmospheric Models. J.Appl.Met. Vol. 30,pp 327-*
+  !           341                                                              *
+  !                                                                            *
+  !     Variables:                                                             *
+  !     L     = Monin-Obukhov-length [m]                                       *
+  !     z     = height [m]                                                     *
+  !     zeta  = auxiliary variable                                             *
+  !                                                                            *
+  !     Constants:                                                             *
+  !     eps   = 1.2E-38, SUN-underflow: to avoid division by zero errors       *
+  !                                                                            *
+  !*****************************************************************************
+
+  implicit none
+
+  real :: psih,x,z,zeta,l
+  real,parameter :: a=1.,b=0.667,c=5.,d=0.35,eps=1.e-20
+
+  if ((l.ge.0).and.(l.lt.eps)) then
+    l=eps
+  else if ((l.lt.0).and.(l.gt.(-1.*eps))) then
+    l=-1.*eps
+  endif
+
+  if ((log10(z)-log10(abs(l))).lt.log10(eps)) then
+    psih=0.
+  else
+    zeta=z/l
+    if (zeta.gt.0.) then
+      psih = - (1.+0.667*a*zeta)**(1.5) - b*(zeta-c/d)*exp(-d*zeta) &
+           - b*c/d + 1.
+    else
+      x=(1.-16.*zeta)**(.25)
+      psih=2.*log((1.+x*x)/2.)
+    end if
+  end if
+
+end function psih
diff --git a/src/tur_psim.f90 b/src/tur_psim.f90
new file mode 100644
index 0000000000000000000000000000000000000000..c5851af2f23e39d21c76f9971493c979c70cfc39
--- /dev/null
+++ b/src/tur_psim.f90
@@ -0,0 +1,30 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+real function psim(z,al)
+
+  !**********************************************************************
+  !                                                                     *
+  ! DESCRIPTION: CALCULATION OF THE STABILITY CORRECTION FUNCTION FOR   *
+  !              MOMENTUM AS FUNCTION OF HEIGHT Z AND OBUKHOV SCALE     *
+  !              HEIGHT L                                               *
+  !                                                                     *
+  !**********************************************************************
+
+  implicit none
+
+  real :: z,al,zeta,x,a1,a2
+
+  zeta=z/al
+  if(zeta.le.0.) then
+  ! UNSTABLE CASE
+    x=(1.-15.*zeta)**0.25
+    a1=((1.+x)/2.)**2
+    a2=(1.+x**2)/2.
+    psim=log(a1*a2)-2.*atan(x)+pi/2.
+  else
+  ! STABLE CASE
+    psim=-4.7*zeta
+  endif
+
+end function psim
diff --git a/src/tur_turb_mesoscale.f90 b/src/tur_turb_mesoscale.f90
new file mode 100644
index 0000000000000000000000000000000000000000..b4eab23edfafee44f35517e75ba5e542867c6c48
--- /dev/null
+++ b/src/tur_turb_mesoscale.f90
@@ -0,0 +1,45 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine turb_mesoscale(nrand,dxsave,dysave,ipart,usig,vsig,wsig,wsigeta,eps_eta)
+
+  implicit none
+
+  integer, intent(inout) ::       &
+    nrand                           ! random number used for turbulence
+  integer, intent(in) ::          &
+    ipart                              ! particle index
+  real, intent(in) ::             &
+    eps_eta,usig,vsig,wsig,wsigeta
+  real, intent(inout) ::          &
+    dxsave,dysave                   ! accumulated displacement in long and lat
+  real ::                         &
+    r,rs,                         & ! mesoscale related
+    ux,vy                           ! random turbulent velocities above PBL
+
+  r=exp(-2.*real(abs(lsynctime))/real(lwindinterv))
+  rs=sqrt(1.-r**2)
+  if (nrand+2.gt.maxrand) nrand=1
+  part(ipart)%mesovel%u=r*part(ipart)%mesovel%u+rs*rannumb(nrand)*usig*fturbmeso
+  part(ipart)%mesovel%v=r*part(ipart)%mesovel%v+rs*rannumb(nrand+1)*vsig*fturbmeso
+  dxsave=dxsave+part(ipart)%mesovel%u*real(lsynctime)
+  dysave=dysave+part(ipart)%mesovel%v*real(lsynctime)
+
+  select case (wind_coord_type)
+    case ('ETA')
+      part(ipart)%mesovel%w=r*part(ipart)%mesovel%w+rs*rannumb(nrand+2)*wsigeta*fturbmeso
+      call update_zeta(ipart,part(ipart)%mesovel%w*real(lsynctime))
+      if (part(ipart)%zeta.ge.1.) call set_zeta(ipart,1.-(part(ipart)%zeta-1.))
+      if (part(ipart)%zeta.eq.1.) call update_zeta(ipart,-eps_eta)
+
+    case ('METER')
+      part(ipart)%mesovel%w=r*part(ipart)%mesovel%w+rs*rannumb(nrand+2)*wsig*fturbmeso
+      call update_z(ipart,part(ipart)%mesovel%w*real(lsynctime))
+      if (part(ipart)%z.lt.0.) call set_z(ipart,-1.*part(ipart)%z)    ! if particle below ground -> refletion
+
+    case default
+      part(ipart)%mesovel%w=r*part(ipart)%mesovel%w+rs*rannumb(nrand+2)*wsig*fturbmeso
+      call update_z(ipart,part(ipart)%mesovel%w*real(lsynctime))
+      if (part(ipart)%z.lt.0.) call set_z(ipart,-1.*part(ipart)%z)    ! if particle below ground -> refletion
+  end select
+end subroutine turb_mesoscale
diff --git a/src/tur_turb_pbl.f90 b/src/tur_turb_pbl.f90
new file mode 100644
index 0000000000000000000000000000000000000000..7361e2f9a19d255857dd7174bce519289680e238
--- /dev/null
+++ b/src/tur_turb_pbl.f90
@@ -0,0 +1,166 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine turb_pbl(ipart,nrand,dt,zts,rhoa,rhograd,thread)
+
+  use cbl_mod
+
+  implicit none
+
+  integer, intent(in) ::   &
+    ipart,                 & ! particle index
+    thread                   ! number of the omp thread
+  integer, intent(inout) ::&
+    nrand                    ! random number used for turbulence
+  real,intent(in) ::       &
+    dt,                    & ! real(ldt)
+    rhoa,                  & ! air density, used in CBL
+    rhograd                  ! vertical gradient of the air density, used in CBL
+  real,intent(inout) ::    &
+    zts                      ! local 'real' copy of the particle position
+  real ::                     &
+    delz,                     & ! change in vertical position due to turbulence
+    ru,rv,rw,wp,icbt_r,       & ! used for computing turbulence
+    dtf,rhoaux,dtftlw,ath,bth,& ! CBL related
+    ptot_lhh,Q_lhh,phi_lhh,   & ! CBL related
+    old_wp_buf,dcas,dcas1,    & ! CBL related
+    del_test                    ! CBL related
+  integer ::                  &
+    flagrein,                 & ! flag used in CBL scheme
+    icbt,                     &
+    i                           ! loop variable
+
+  ! tlw,dsigwdz and dsigw2dz are defined in hanna
+    if (turbswitch) then
+      call hanna(zts)
+    else
+      call hanna1(zts)
+    endif
+
+  !*****************************************
+  ! Determine the new diffusivity velocities
+  !*****************************************
+
+  ! Horizontal components
+  !**********************
+    if (nrand+1.gt.maxrand) nrand=1
+    if (dt/tlu.lt..5) then
+      part(ipart)%turbvel%u=(1.-dt/tlu)*part(ipart)%turbvel%u+rannumb(nrand)*sigu*sqrt(2.*dt/tlu)
+    else
+      ru=exp(-dt/tlu)
+      part(ipart)%turbvel%u=ru*part(ipart)%turbvel%u+rannumb(nrand)*sigu*sqrt(1.-ru**2)
+    endif
+    if (dt/tlv.lt..5) then
+      part(ipart)%turbvel%v=(1.-dt/tlv)*part(ipart)%turbvel%v+rannumb(nrand+1)*sigv*sqrt(2.*dt/tlv)
+    else
+      rv=exp(-dt/tlv)
+      part(ipart)%turbvel%v=rv*part(ipart)%turbvel%v+rannumb(nrand+1)*sigv*sqrt(1.-rv**2)
+    endif
+    nrand=nrand+2
+
+
+    if (nrand+ifine.gt.maxrand) nrand=1
+    rhoaux=rhograd/rhoa
+    dtf=dt*fine
+
+    dtftlw=dtf/tlw
+
+  ! Loop over ifine short time steps for vertical component
+  !********************************************************
+    wp=part(ipart)%turbvel%w
+    icbt=part(ipart)%icbt
+    do i=1,ifine
+      icbt_r=real(icbt)
+  ! Determine the drift velocity and density correction velocity
+  !*************************************************************
+
+      if (turbswitch) then
+        if (dtftlw.lt..5) then
+  !*************************************************************
+  !************** CBL options added by mc see routine cblf90 ***
+          ! LB needs to be checked if this works with openmp
+          if (cblflag.eq.1) then  !modified by mc
+            if (-h/ol.gt.5) then  !modified by mc
+              flagrein=0
+              nrand=nrand+1
+              old_wp_buf=wp
+              call cbl(wp,zts,ust,wst,h,rhoa,rhograd,&
+                sigw,dsigwdz,tlw,ptot_lhh,Q_lhh,phi_lhh,ath,bth,ol,flagrein) !inside the routine for inverse time
+              wp=(wp+ath*dtf+&
+                bth*rannumb(nrand)*sqrt(dtf))*icbt_r
+              delz=wp*dtf
+              if ((flagrein.eq.1).or.(wp.ne.wp).or.((wp-1.).eq.wp)) then
+                call reinit_particle(zts,ust,wst,h,sigw,old_wp_buf,nrand,ol)
+                wp=old_wp_buf
+                delz=wp*dtf
+                nan_count(thread+1)=nan_count(thread+1)+1
+              end if
+            else
+              nrand=nrand+1
+              old_wp_buf=wp
+              ath=-wp/tlw+sigw*dsigwdz+&
+                wp*wp/sigw*dsigwdz+sigw*sigw/rhoa*rhograd  !1-note for inverse time should be -wp/tlw*ldirect+... calculated for wp=-wp
+                                                                                  !2-but since ldirect =-1 for inverse time and this must be calculated for (-wp) and
+                                                                                  !3-the gaussian pdf is symmetric (i.e. pdf(w)=pdf(-w) ldirect can be discarded
+              bth=sigw*rannumb(nrand)*sqrt(2.*dtftlw)
+              wp=(wp+ath*dtf+bth)*icbt_r
+              delz=wp*dtf
+              if ((wp.ne.wp).or.((wp-1.).eq.wp)) then ! Catch infinity or NaN
+                nrand=nrand+1
+                wp=sigw*rannumb(nrand)
+                delz=wp*dtf
+                nan_count(thread+1)=nan_count(thread+1)+1
+              end if
+            end if
+  !******************** END CBL option *******************************
+  !*******************************************************************
+          else
+               wp=((1.-dtftlw)*wp+rannumb(nrand+i)*sqrt(2.*dtftlw) &
+               +dtf*(dsigwdz+rhoaux*sigw))*icbt_r
+               delz=wp*sigw*dtf
+          end if
+        else
+          rw=exp(-dtftlw)
+          wp=(rw*wp+rannumb(nrand+i)*sqrt(1.-rw**2) &
+               +tlw*(1.-rw)*(dsigwdz+rhoaux*sigw))*icbt_r
+          delz=wp*sigw*dtf
+        endif
+
+      else
+        rw=exp(-dtftlw)
+        wp=(rw*wp+rannumb(nrand+i)*sqrt(1.-rw**2)*sigw &
+             +tlw*(1.-rw)*(dsigw2dz+rhoaux*sigw**2))*icbt_r
+        delz=wp*dtf
+      endif
+
+  !****************************************************
+  ! Compute turbulent vertical displacement of particle
+  !****************************************************
+
+      if (abs(delz).gt.h) delz=mod(delz,h)
+
+  ! Determine if particle transfers to a "forbidden state" below the ground
+  ! or above the mixing height
+  !************************************************************************
+
+      if (delz.lt.-zts) then         ! reflection at ground
+        icbt=-1
+        call set_z(ipart,-zts-delz)
+      else if (delz.gt.(h-zts)) then ! reflection at h
+        icbt=-1
+        call set_z(ipart,-zts-delz+2.*h)
+      else                         ! no reflection
+        icbt=1
+        call set_z(ipart,zts+delz)
+      endif
+
+      if (i.ne.ifine) then
+        zeta=zts/h
+        call hanna_short(zts)
+      endif
+      zts=real(part(ipart)%z)
+    end do
+    part(ipart)%turbvel%w=wp
+    part(ipart)%icbt=icbt
+    if (cblflag.ne.1) nrand=nrand+i
+end subroutine turb_pbl
diff --git a/src/tur_turb_stratosph.f90 b/src/tur_turb_stratosph.f90
new file mode 100644
index 0000000000000000000000000000000000000000..6f590169f91c75e38b8dc9da452b7d431b9b1645
--- /dev/null
+++ b/src/tur_turb_stratosph.f90
@@ -0,0 +1,44 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine turb_stratosph(dt,nrand,ux,vy,wp,tropop,zts)
+
+  implicit none
+
+  integer, intent(inout) ::       &
+    nrand                           ! random number used for turbulence
+  real, intent(inout) ::          &
+    ux,vy,wp                        ! random turbulent velocities above PBL
+  real, intent(in) ::             &
+    tropop,                       & ! height of troposphere
+    zts,                          & ! height of particle
+    dt                              ! real(ldt)
+  real ::                         &
+    uxscale,wpscale,              & ! factor used in calculating turbulent perturbations above PBL
+    weight                          ! transition above the tropopause
+
+  if (zts.lt.tropop) then  ! in the troposphere
+    uxscale=sqrt(2.*d_trop/dt)
+    if (nrand+1.gt.maxrand) nrand=1
+    ux=rannumb(nrand)*uxscale
+    vy=rannumb(nrand+1)*uxscale
+    nrand=nrand+2
+    wp=0.
+  else if (zts.lt.tropop+1000.) then     ! just above the tropopause: make transition
+    weight=(zts-tropop)/1000.
+    uxscale=sqrt(2.*d_trop/dt*(1.-weight))
+    if (nrand+2.gt.maxrand) nrand=1
+    ux=rannumb(nrand)*uxscale
+    vy=rannumb(nrand+1)*uxscale
+    wpscale=sqrt(2.*d_strat/dt*weight)
+    wp=rannumb(nrand+2)*wpscale+d_strat/1000.
+    nrand=nrand+3
+  else                 ! in the stratosphere
+    if (nrand.gt.maxrand) nrand=1
+    ux=0.
+    vy=0.
+    wpscale=sqrt(2.*d_strat/dt)
+    wp=rannumb(nrand)*wpscale
+    nrand=nrand+1
+  endif
+end subroutine turb_stratosph
diff --git a/src/tur_windalign.f90 b/src/tur_windalign.f90
new file mode 100644
index 0000000000000000000000000000000000000000..59989bf4b6956f2bccbd6e3baed2161f12629870
--- /dev/null
+++ b/src/tur_windalign.f90
@@ -0,0 +1,55 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine windalign(u,v,ffap,ffcp,ux,vy)
+  !                     i i  i    i   o  o
+  !*****************************************************************************
+  !                                                                            *
+  !  Transformation from along- and cross-wind components to u and v           *
+  !  components.                                                               *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     3 June 1996                                                            *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! ffap  turbulent wind in along wind direction                               *
+  ! ffcp  turbulent wind in cross wind direction                               *
+  ! u     main wind component in x direction                                   *
+  ! ux    turbulent wind in x direction                                        *
+  ! v     main wind component in y direction                                   *
+  ! vy    turbulent wind in y direction                                        *
+  !                                                                            *
+  !*****************************************************************************
+
+  implicit none
+
+  real :: u,v,ffap,ffcp,ux,vy,ffinv,ux1,ux2,vy1,vy2,sinphi,cosphi
+  real,parameter :: eps=1.e-30
+
+
+  ! Transform along wind components
+  !********************************
+
+  ffinv=1./max(sqrt(u*u+v*v),eps)
+  sinphi=v*ffinv
+  vy1=sinphi*ffap
+  cosphi=u*ffinv
+  ux1=cosphi*ffap
+
+
+  ! Transform cross wind components
+  !********************************
+
+  ux2=-sinphi*ffcp
+  vy2=cosphi*ffcp
+
+
+  ! Add contributions from along and cross wind components
+  !*******************************************************
+
+  ux=ux1+ux2
+  vy=vy1+vy2
+end subroutine windalign
diff --git a/src/turbulence_mod.f90 b/src/turbulence_mod.f90
index d347dec2a53bcf43160a206639934484a7851838..15f560c8ac5e48c8b43917cf0503620a2954b07f 100644
--- a/src/turbulence_mod.f90
+++ b/src/turbulence_mod.f90
@@ -20,808 +20,23 @@ module turbulence_mod
 
 contains
 
-subroutine turb_pbl(ipart,nrand,dt,zts,rhoa,rhograd,thread)
-  
-  use cbl_mod
-  
-  implicit none 
+#include "tur_turb_pbl.f90"
 
-  integer, intent(in) ::   &
-    ipart,                 & ! particle index
-    thread                   ! number of the omp thread
-  integer, intent(inout) ::&
-    nrand                    ! random number used for turbulence
-  real,intent(in) ::       &
-    dt,                    & ! real(ldt)
-    rhoa,                  & ! air density, used in CBL
-    rhograd                  ! vertical gradient of the air density, used in CBL
-  real,intent(inout) ::    &
-    zts                      ! local 'real' copy of the particle position
-  real ::                     &
-    delz,                     & ! change in vertical position due to turbulence
-    ru,rv,rw,wp,icbt_r,       & ! used for computing turbulence
-    dtf,rhoaux,dtftlw,ath,bth,& ! CBL related
-    ptot_lhh,Q_lhh,phi_lhh,   & ! CBL related
-    old_wp_buf,dcas,dcas1,    & ! CBL related
-    del_test                    ! CBL related
-  integer ::                  &
-    flagrein,                 & ! flag used in CBL scheme
-    icbt,                     &
-    i                           ! loop variable
+#include "tur_turb_stratosph.f90"
 
-  ! tlw,dsigwdz and dsigw2dz are defined in hanna
-    if (turbswitch) then
-      call hanna(zts)
-    else
-      call hanna1(zts)
-    endif
+#include "tur_turb_mesoscale.f90"
 
-  !*****************************************
-  ! Determine the new diffusivity velocities
-  !*****************************************
+#include "tur_hanna.f90"
 
-  ! Horizontal components
-  !**********************
-    if (nrand+1.gt.maxrand) nrand=1
-    if (dt/tlu.lt..5) then
-      part(ipart)%turbvel%u=(1.-dt/tlu)*part(ipart)%turbvel%u+rannumb(nrand)*sigu*sqrt(2.*dt/tlu)
-    else
-      ru=exp(-dt/tlu)
-      part(ipart)%turbvel%u=ru*part(ipart)%turbvel%u+rannumb(nrand)*sigu*sqrt(1.-ru**2)
-    endif
-    if (dt/tlv.lt..5) then
-      part(ipart)%turbvel%v=(1.-dt/tlv)*part(ipart)%turbvel%v+rannumb(nrand+1)*sigv*sqrt(2.*dt/tlv)
-    else
-      rv=exp(-dt/tlv)
-      part(ipart)%turbvel%v=rv*part(ipart)%turbvel%v+rannumb(nrand+1)*sigv*sqrt(1.-rv**2)
-    endif
-    nrand=nrand+2
+#include "tur_hanna1.f90"
 
+#include "tur_hanna_short.f90"
 
-    if (nrand+ifine.gt.maxrand) nrand=1
-    rhoaux=rhograd/rhoa
-    dtf=dt*fine
+#include "tur_windalign.f90"
+#include "tur_psih.f90"
 
-    dtftlw=dtf/tlw
+#include "tur_psim.f90"
 
-  ! Loop over ifine short time steps for vertical component
-  !********************************************************
-    wp=part(ipart)%turbvel%w
-    icbt=part(ipart)%icbt
-    do i=1,ifine
-      icbt_r=real(icbt)
-  ! Determine the drift velocity and density correction velocity
-  !*************************************************************
-      
-      if (turbswitch) then
-        if (dtftlw.lt..5) then
-  !*************************************************************
-  !************** CBL options added by mc see routine cblf90 ***
-          ! LB needs to be checked if this works with openmp
-          if (cblflag.eq.1) then  !modified by mc
-            if (-h/ol.gt.5) then  !modified by mc
-              flagrein=0
-              nrand=nrand+1
-              old_wp_buf=wp
-              call cbl(wp,zts,ust,wst,h,rhoa,rhograd,&
-                sigw,dsigwdz,tlw,ptot_lhh,Q_lhh,phi_lhh,ath,bth,ol,flagrein) !inside the routine for inverse time
-              wp=(wp+ath*dtf+&
-                bth*rannumb(nrand)*sqrt(dtf))*icbt_r
-              delz=wp*dtf
-              if ((flagrein.eq.1).or.(wp.ne.wp).or.((wp-1.).eq.wp)) then
-                call reinit_particle(zts,ust,wst,h,sigw,old_wp_buf,nrand,ol)
-                wp=old_wp_buf
-                delz=wp*dtf
-                nan_count(thread+1)=nan_count(thread+1)+1
-              end if             
-            else 
-              nrand=nrand+1
-              old_wp_buf=wp
-              ath=-wp/tlw+sigw*dsigwdz+&
-                wp*wp/sigw*dsigwdz+sigw*sigw/rhoa*rhograd  !1-note for inverse time should be -wp/tlw*ldirect+... calculated for wp=-wp
-                                                                                  !2-but since ldirect =-1 for inverse time and this must be calculated for (-wp) and
-                                                                                  !3-the gaussian pdf is symmetric (i.e. pdf(w)=pdf(-w) ldirect can be discarded
-              bth=sigw*rannumb(nrand)*sqrt(2.*dtftlw)
-              wp=(wp+ath*dtf+bth)*icbt_r  
-              delz=wp*dtf
-              if ((wp.ne.wp).or.((wp-1.).eq.wp)) then ! Catch infinity or NaN
-                nrand=nrand+1                      
-                wp=sigw*rannumb(nrand)
-                delz=wp*dtf
-                nan_count(thread+1)=nan_count(thread+1)+1
-              end if
-            end if
-  !******************** END CBL option *******************************            
-  !*******************************************************************            
-          else
-               wp=((1.-dtftlw)*wp+rannumb(nrand+i)*sqrt(2.*dtftlw) &
-               +dtf*(dsigwdz+rhoaux*sigw))*icbt_r
-               delz=wp*sigw*dtf
-          end if
-        else
-          rw=exp(-dtftlw)
-          wp=(rw*wp+rannumb(nrand+i)*sqrt(1.-rw**2) &
-               +tlw*(1.-rw)*(dsigwdz+rhoaux*sigw))*icbt_r
-          delz=wp*sigw*dtf
-        endif
-        
-      else
-        rw=exp(-dtftlw)
-        wp=(rw*wp+rannumb(nrand+i)*sqrt(1.-rw**2)*sigw &
-             +tlw*(1.-rw)*(dsigw2dz+rhoaux*sigw**2))*icbt_r
-        delz=wp*dtf
-      endif
-
-  !****************************************************
-  ! Compute turbulent vertical displacement of particle
-  !****************************************************
-
-      if (abs(delz).gt.h) delz=mod(delz,h)
-
-  ! Determine if particle transfers to a "forbidden state" below the ground
-  ! or above the mixing height
-  !************************************************************************
-
-      if (delz.lt.-zts) then         ! reflection at ground
-        icbt=-1
-        call set_z(ipart,-zts-delz)
-      else if (delz.gt.(h-zts)) then ! reflection at h
-        icbt=-1
-        call set_z(ipart,-zts-delz+2.*h)
-      else                         ! no reflection
-        icbt=1
-        call set_z(ipart,zts+delz)
-      endif
-
-      if (i.ne.ifine) then
-        zeta=zts/h
-        call hanna_short(zts)
-      endif
-      zts=real(part(ipart)%z)
-    end do
-    part(ipart)%turbvel%w=wp
-    part(ipart)%icbt=icbt
-    if (cblflag.ne.1) nrand=nrand+i
-end subroutine turb_pbl
-
-subroutine turb_stratosph(dt,nrand,ux,vy,wp,tropop,zts)
-
-  implicit none
-  
-  integer, intent(inout) ::       &
-    nrand                           ! random number used for turbulence
-  real, intent(inout) ::          &
-    ux,vy,wp                        ! random turbulent velocities above PBL
-  real, intent(in) ::             &
-    tropop,                       & ! height of troposphere
-    zts,                          & ! height of particle
-    dt                              ! real(ldt)
-  real ::                         &
-    uxscale,wpscale,              & ! factor used in calculating turbulent perturbations above PBL
-    weight                          ! transition above the tropopause
-
-  if (zts.lt.tropop) then  ! in the troposphere
-    uxscale=sqrt(2.*d_trop/dt)
-    if (nrand+1.gt.maxrand) nrand=1
-    ux=rannumb(nrand)*uxscale
-    vy=rannumb(nrand+1)*uxscale
-    nrand=nrand+2
-    wp=0.
-  else if (zts.lt.tropop+1000.) then     ! just above the tropopause: make transition
-    weight=(zts-tropop)/1000.
-    uxscale=sqrt(2.*d_trop/dt*(1.-weight))
-    if (nrand+2.gt.maxrand) nrand=1
-    ux=rannumb(nrand)*uxscale
-    vy=rannumb(nrand+1)*uxscale
-    wpscale=sqrt(2.*d_strat/dt*weight)
-    wp=rannumb(nrand+2)*wpscale+d_strat/1000.
-    nrand=nrand+3
-  else                 ! in the stratosphere
-    if (nrand.gt.maxrand) nrand=1
-    ux=0.
-    vy=0.
-    wpscale=sqrt(2.*d_strat/dt)
-    wp=rannumb(nrand)*wpscale
-    nrand=nrand+1
-  endif
-end subroutine turb_stratosph
-
-subroutine turb_mesoscale(nrand,dxsave,dysave,ipart,usig,vsig,wsig,wsigeta,eps_eta)
-  
-  implicit none
-
-  integer, intent(inout) ::       &
-    nrand                           ! random number used for turbulence
-  integer, intent(in) ::          &
-    ipart                              ! particle index
-  real, intent(in) ::             &
-    eps_eta,usig,vsig,wsig,wsigeta
-  real, intent(inout) ::          &
-    dxsave,dysave                   ! accumulated displacement in long and lat
-  real ::                         &
-    r,rs,                         & ! mesoscale related
-    ux,vy                           ! random turbulent velocities above PBL
-
-  r=exp(-2.*real(abs(lsynctime))/real(lwindinterv))
-  rs=sqrt(1.-r**2)
-  if (nrand+2.gt.maxrand) nrand=1
-  part(ipart)%mesovel%u=r*part(ipart)%mesovel%u+rs*rannumb(nrand)*usig*fturbmeso
-  part(ipart)%mesovel%v=r*part(ipart)%mesovel%v+rs*rannumb(nrand+1)*vsig*fturbmeso
-  dxsave=dxsave+part(ipart)%mesovel%u*real(lsynctime)
-  dysave=dysave+part(ipart)%mesovel%v*real(lsynctime)
-
-  select case (wind_coord_type)
-    case ('ETA')
-      part(ipart)%mesovel%w=r*part(ipart)%mesovel%w+rs*rannumb(nrand+2)*wsigeta*fturbmeso
-      call update_zeta(ipart,part(ipart)%mesovel%w*real(lsynctime))
-      if (part(ipart)%zeta.ge.1.) call set_zeta(ipart,1.-(part(ipart)%zeta-1.))
-      if (part(ipart)%zeta.eq.1.) call update_zeta(ipart,-eps_eta)
-
-    case ('METER')
-      part(ipart)%mesovel%w=r*part(ipart)%mesovel%w+rs*rannumb(nrand+2)*wsig*fturbmeso
-      call update_z(ipart,part(ipart)%mesovel%w*real(lsynctime))
-      if (part(ipart)%z.lt.0.) call set_z(ipart,-1.*part(ipart)%z)    ! if particle below ground -> refletion
-
-    case default
-      part(ipart)%mesovel%w=r*part(ipart)%mesovel%w+rs*rannumb(nrand+2)*wsig*fturbmeso
-      call update_z(ipart,part(ipart)%mesovel%w*real(lsynctime))
-      if (part(ipart)%z.lt.0.) call set_z(ipart,-1.*part(ipart)%z)    ! if particle below ground -> refletion
-  end select
-end subroutine turb_mesoscale
-
-subroutine hanna(z)
-  !                 i
-  !*****************************************************************************
-  !                                                                            *
-  !   Computation of \sigma_i and \tau_L based on the scheme of Hanna (1982)   *
-  !                                                                            *
-  !   Author: A. Stohl                                                         *
-  !                                                                            *
-  !   4 December 1997                                                          *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! dsigwdz [1/s]     vertical gradient of sigw                                *
-  ! ol [m]            Obukhov length                                           *
-  ! sigu, sigv, sigw  standard deviations of turbulent velocity fluctuations   *
-  ! tlu [s]           Lagrangian time scale for the along wind component.      *
-  ! tlv [s]           Lagrangian time scale for the cross wind component.      *
-  ! tlw [s]           Lagrangian time scale for the vertical wind component.   *
-  ! ust, ustar [m/s]  friction velocity                                        *
-  ! wst, wstar [m/s]  convective velocity scale                                *
-  !                                                                            *
-  !*****************************************************************************
-
-  implicit none
-
-  real :: corr,z
-
-
-  !**********************
-  ! 1. Neutral conditions
-  !**********************
-
-  if (h/abs(ol).lt.1.) then
-    ust=max(1.e-4,ust)
-    corr=z/ust
-    sigu=1.e-2+2.0*ust*exp(-3.e-4*corr)
-    sigw=1.3*ust*exp(-2.e-4*corr)
-    dsigwdz=-2.e-4*sigw
-    sigw=sigw+1.e-2
-    sigv=sigw
-    tlu=0.5*z/sigw/(1.+1.5e-3*corr)
-    tlv=tlu
-    tlw=tlu
-
-
-  !***********************
-  ! 2. Unstable conditions
-  !***********************
-
-  else if (ol.lt.0.) then
-
-
-  ! Determine sigmas
-  !*****************
-
-    sigu=1.e-2+ust*(12.-0.5*h/ol)**0.33333
-    sigv=sigu
-    sigw=sqrt(1.2*wst**2*(1.-.9*zeta)*zeta**0.66666+ &
-         (1.8-1.4*zeta)*ust**2)+1.e-2
-    dsigwdz=0.5/sigw/h*(-1.4*ust**2+wst**2* &
-         (0.8*max(zeta,1.e-3)**(-.33333)-1.8*zeta**0.66666))
-
-
-  ! Determine average Lagrangian time scale
-  !****************************************
-
-    tlu=0.15*h/sigu
-    tlv=tlu
-    if (z.lt.abs(ol)) then
-      tlw=0.1*z/(sigw*(0.55-0.38*abs(z/ol)))
-    else if (zeta.lt.0.1) then
-      tlw=0.59*z/sigw
-    else
-      tlw=0.15*h/sigw*(1.-exp(-5*zeta))
-    endif
-
-
-  !*********************
-  ! 3. Stable conditions
-  !*********************
-
-  else
-    sigu=1.e-2+2.*ust*(1.-zeta)
-    sigv=1.e-2+1.3*ust*(1.-zeta)
-    sigw=sigv
-    dsigwdz=-1.3*ust/h
-    tlu=0.15*h/sigu*(sqrt(zeta))
-    tlv=0.467*tlu
-    tlw=0.1*h/sigw*zeta**0.8
-  endif
-
-
-  tlu=max(10.,tlu)
-  tlv=max(10.,tlv)
-  tlw=max(30.,tlw)
-
-  if (dsigwdz.eq.0.) dsigwdz=1.e-10
-end subroutine hanna
-
-subroutine hanna1(z)
-  !                  i
-  !*****************************************************************************
-  !                                                                            *
-  !   Computation of \sigma_i and \tau_L based on the scheme of Hanna (1982)   *
-  !                                                                            *
-  !   Author: A. Stohl                                                         *
-  !                                                                            *
-  !   4 December 1997                                                          *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! dsigwdz [1/s]     vertical gradient of sigw                                *
-  ! ol [m]            Obukhov length                                           *
-  ! sigu, sigv, sigw  standard deviations of turbulent velocity fluctuations   *
-  ! tlu [s]           Lagrangian time scale for the along wind component.      *
-  ! tlv [s]           Lagrangian time scale for the cross wind component.      *
-  ! tlw [s]           Lagrangian time scale for the vertical wind component.   *
-  ! ust, ustar [m/s]  friction velocity                                        *
-  ! wst, wstar [m/s]  convective velocity scale                                *
-  !                                                                            *
-  !*****************************************************************************
-
-  implicit none
-
-  real :: z,s1,s2
-
-
-
-  !**********************
-  ! 1. Neutral conditions
-  !**********************
-
-  if (h/abs(ol).lt.1.) then
-
-    ust=max(1.e-4,ust)
-    sigu=2.0*ust*exp(-3.e-4*z/ust)
-    sigu=max(sigu,1.e-5)
-    sigv=1.3*ust*exp(-2.e-4*z/ust)
-    sigv=max(sigv,1.e-5)
-    sigw=sigv
-    dsigw2dz=-6.76e-4*ust*exp(-4.e-4*z/ust)
-    tlu=0.5*z/sigw/(1.+1.5e-3*z/ust)
-    tlv=tlu
-    tlw=tlu
-
-
-  !***********************
-  ! 2. Unstable conditions
-  !***********************
-
-  else if (ol.lt.0.) then
-
-
-  ! Determine sigmas
-  !*****************
-
-    sigu=ust*(12.-0.5*h/ol)**0.33333
-    sigu=max(sigu,1.e-6)
-    sigv=sigu
-
-    if (zeta.lt.0.03) then
-      sigw=0.96*wst*(3*zeta-ol/h)**0.33333
-      dsigw2dz=1.8432*wst*wst/h*(3*zeta-ol/h)**(-0.33333)
-    else if (zeta.lt.0.4) then
-      s1=0.96*(3*zeta-ol/h)**0.33333
-      s2=0.763*zeta**0.175
-      if (s1.lt.s2) then
-        sigw=wst*s1
-        dsigw2dz=1.8432*wst*wst/h*(3*zeta-ol/h)**(-0.33333)
-      else
-        sigw=wst*s2
-        dsigw2dz=0.203759*wst*wst/h*zeta**(-0.65)
-      endif
-    else if (zeta.lt.0.96) then
-      sigw=0.722*wst*(1-zeta)**0.207
-      dsigw2dz=-.215812*wst*wst/h*(1-zeta)**(-0.586)
-    else if (zeta.lt.1.00) then
-      sigw=0.37*wst
-      dsigw2dz=0.
-    endif
-    sigw=max(sigw,1.e-6)
-
-
-  ! Determine average Lagrangian time scale
-  !****************************************
-
-    tlu=0.15*h/sigu
-    tlv=tlu
-    if (z.lt.abs(ol)) then
-      tlw=0.1*z/(sigw*(0.55-0.38*abs(z/ol)))
-    else if (zeta.lt.0.1) then
-      tlw=0.59*z/sigw
-    else
-      tlw=0.15*h/sigw*(1.-exp(-5*zeta))
-    endif
-
-
-  !*********************
-  ! 3. Stable conditions
-  !*********************
-
-  else
-    sigu=2.*ust*(1.-zeta)
-    sigv=1.3*ust*(1.-zeta)
-    sigu=max(sigu,1.e-6)
-    sigv=max(sigv,1.e-6)
-    sigw=sigv
-    dsigw2dz=3.38*ust*ust*(zeta-1.)/h
-    tlu=0.15*h/sigu*(sqrt(zeta))
-    tlv=0.467*tlu
-    tlw=0.1*h/sigw*zeta**0.8
-  endif
-
-
-
-
-  tlu=max(10.,tlu)
-  tlv=max(10.,tlv)
-  tlw=max(30.,tlw)
-end subroutine hanna1
-
-subroutine hanna_short(z)
-  !                       i
-  !*****************************************************************************
-  !                                                                            *
-  !   Computation of \sigma_i and \tau_L based on the scheme of Hanna (1982)   *
-  !                                                                            *
-  !   Author: A. Stohl                                                         *
-  !                                                                            *
-  !   4 December 1997                                                          *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! dsigwdz [1/s]     vertical gradient of sigw                                *
-  ! ol [m]            Obukhov length                                           *
-  ! sigu, sigv, sigw  standard deviations of turbulent velocity fluctuations   *
-  ! tlu [s]           Lagrangian time scale for the along wind component.      *
-  ! tlv [s]           Lagrangian time scale for the cross wind component.      *
-  ! tlw [s]           Lagrangian time scale for the vertical wind component.   *
-  ! ust, ustar [m/s]  friction velocity                                        *
-  ! wst, wstar [m/s]  convective velocity scale                                *
-  !                                                                            *
-  !*****************************************************************************
-
-  implicit none
-
-  real :: z
-
-
-
-  !**********************
-  ! 1. Neutral conditions
-  !**********************
-
-  if (h/abs(ol).lt.1.) then
-    ust=max(1.e-4,ust)
-    sigw=1.3*exp(-2.e-4*z/ust)
-    dsigwdz=-2.e-4*sigw
-    sigw=sigw*ust+1.e-2
-    tlw=0.5*z/sigw/(1.+1.5e-3*z/ust)
-
-
-  !***********************
-  ! 2. Unstable conditions
-  !***********************
-
-  else if (ol.lt.0.) then
-
-
-  ! Determine sigmas
-  !*****************
-
-    sigw=sqrt(1.2*wst**2*(1.-.9*zeta)*zeta**0.66666+ &
-         (1.8-1.4*zeta)*ust**2)+1.e-2
-    dsigwdz=0.5/sigw/h*(-1.4*ust**2+wst**2* &
-         (0.8*max(zeta,1.e-3)**(-.33333)-1.8*zeta**0.66666))
-
-
-  ! Determine average Lagrangian time scale
-  !****************************************
-
-    if (z.lt.abs(ol)) then
-      tlw=0.1*z/(sigw*(0.55-0.38*abs(z/ol)))
-    else if (zeta.lt.0.1) then
-      tlw=0.59*z/sigw
-    else
-      tlw=0.15*h/sigw*(1.-exp(-5*zeta))
-    endif
-
-
-  !*********************
-  ! 3. Stable conditions
-  !*********************
-
-  else
-    sigw=1.e-2+1.3*ust*(1.-zeta)
-    dsigwdz=-1.3*ust/h
-    tlw=0.1*h/sigw*zeta**0.8
-  endif
-
-
-  tlu=max(10.,tlu)
-  tlv=max(10.,tlv)
-  tlw=max(30.,tlw)
-  if (dsigwdz.eq.0.) dsigwdz=1.e-10
-end subroutine hanna_short
-
-subroutine windalign(u,v,ffap,ffcp,ux,vy)
-  !                     i i  i    i   o  o
-  !*****************************************************************************
-  !                                                                            *
-  !  Transformation from along- and cross-wind components to u and v           *
-  !  components.                                                               *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     3 June 1996                                                            *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! ffap  turbulent wind in along wind direction                               *
-  ! ffcp  turbulent wind in cross wind direction                               *
-  ! u     main wind component in x direction                                   *
-  ! ux    turbulent wind in x direction                                        *
-  ! v     main wind component in y direction                                   *
-  ! vy    turbulent wind in y direction                                        *
-  !                                                                            *
-  !*****************************************************************************
-
-  implicit none
-
-  real :: u,v,ffap,ffcp,ux,vy,ffinv,ux1,ux2,vy1,vy2,sinphi,cosphi
-  real,parameter :: eps=1.e-30
-
-
-  ! Transform along wind components
-  !********************************
-
-  ffinv=1./max(sqrt(u*u+v*v),eps)
-  sinphi=v*ffinv
-  vy1=sinphi*ffap
-  cosphi=u*ffinv
-  ux1=cosphi*ffap
-
-
-  ! Transform cross wind components
-  !********************************
-
-  ux2=-sinphi*ffcp
-  vy2=cosphi*ffcp
-
-
-  ! Add contributions from along and cross wind components
-  !*******************************************************
-
-  ux=ux1+ux2
-  vy=vy1+vy2
-end subroutine windalign
-function psih (z,l)
-
-  !*****************************************************************************
-  !                                                                            *
-  !     Calculation of the stability correction term                           *
-  !                                                                            *
-  !     AUTHOR: Matthias Langer, adapted by Andreas Stohl (6 August 1993)      *
-  !             Update: G. Wotawa, 11 October 1994                             *
-  !                                                                            *
-  !     Literature:                                                            *
-  !     [1] C.A.Paulson (1970), A Mathematical Representation of Wind Speed    *
-  !           and Temperature Profiles in the Unstable Atmospheric Surface     *
-  !           Layer. J.Appl.Met.,Vol.9.(1970), pp.857-861.                     *
-  !                                                                            *
-  !     [2] A.C.M. Beljaars, A.A.M. Holtslag (1991), Flux Parameterization over*
-  !           Land Surfaces for Atmospheric Models. J.Appl.Met. Vol. 30,pp 327-*
-  !           341                                                              *
-  !                                                                            *
-  !     Variables:                                                             *
-  !     L     = Monin-Obukhov-length [m]                                       *
-  !     z     = height [m]                                                     *
-  !     zeta  = auxiliary variable                                             *
-  !                                                                            *
-  !     Constants:                                                             *
-  !     eps   = 1.2E-38, SUN-underflow: to avoid division by zero errors       *
-  !                                                                            *
-  !*****************************************************************************
-
-  implicit none
-
-  real :: psih,x,z,zeta,l
-  real,parameter :: a=1.,b=0.667,c=5.,d=0.35,eps=1.e-20
-
-  if ((l.ge.0).and.(l.lt.eps)) then
-    l=eps
-  else if ((l.lt.0).and.(l.gt.(-1.*eps))) then
-    l=-1.*eps
-  endif
-
-  if ((log10(z)-log10(abs(l))).lt.log10(eps)) then
-    psih=0.
-  else
-    zeta=z/l
-    if (zeta.gt.0.) then
-      psih = - (1.+0.667*a*zeta)**(1.5) - b*(zeta-c/d)*exp(-d*zeta) &
-           - b*c/d + 1.
-    else
-      x=(1.-16.*zeta)**(.25)
-      psih=2.*log((1.+x*x)/2.)
-    end if
-  end if
-
-end function psih
-
-real function psim(z,al)
-
-  !**********************************************************************
-  !                                                                     *
-  ! DESCRIPTION: CALCULATION OF THE STABILITY CORRECTION FUNCTION FOR   *
-  !              MOMENTUM AS FUNCTION OF HEIGHT Z AND OBUKHOV SCALE     *
-  !              HEIGHT L                                               *
-  !                                                                     *
-  !**********************************************************************
-
-  implicit none
-
-  real :: z,al,zeta,x,a1,a2
-
-  zeta=z/al
-  if(zeta.le.0.) then
-  ! UNSTABLE CASE
-    x=(1.-15.*zeta)**0.25
-    a1=((1.+x)/2.)**2
-    a2=(1.+x**2)/2.
-    psim=log(a1*a2)-2.*atan(x)+pi/2.
-  else
-  ! STABLE CASE
-    psim=-4.7*zeta
-  endif
-
-end function psim
-
-subroutine pbl_profile(ps,td2m,zml1,t2m,tml1,u10m,uml1,stress,hf)
-
-  !********************************************************************
-  !                                                                   *
-  !                    G. WOTAWA, 1995-07-07                          *
-  !                                                                   *
-  !********************************************************************
-  !                                                                   *
-  ! DESCRIPTION: CALCULATION OF FRICTION VELOCITY AND SURFACE SENS-   *
-  !              IBLE HEAT FLUX USING THE PROFILE METHOD (BERKOVICZ   *
-  !              AND PRAHM, 1982)                                     *
-  !                                                                   *
-  ! Output now is surface stress instead of ustar                     *
-  !                                                                   *
-  !                                                                   *
-  !********************************************************************
-  !                                                                   *
-  ! INPUT:                                                            *
-  !                                                                   *
-  !                                                                   *
-  ! ps      surface pressure(Pa)                                      *
-  ! td2m    two metre dew point(K)                                    *
-  ! zml1    heigth of first model level (m)                           *
-  ! t2m     two metre temperature (K)                                 *
-  ! tml1    temperature first model level (K)                         *
-  ! u10m    ten metre wind speed (ms-1)                               *
-  ! uml1    wind speed first model level (ms-1)                       *
-  !                                                                   *
-  !********************************************************************
-  !                                                                   *
-  ! OUTPUT:                                                           *
-  !                                                                   *
-  ! stress  surface stress (i.e., friction velocity (ms-1) squared    *
-  !                         multiplied with air density)              *
-  ! hf      surface sensible heat flux (Wm-2)                         *
-  !                                                                   *
-  !********************************************************************
-  ! ustar   friction velocity (ms-1)                                  *
-  ! maxiter maximum number of iterations                              *
-  !********************************************************************
-
-  use qvsat_mod
-
-  implicit none
-
-  integer :: iter
-  real :: ps,td2m,rhoa,zml1,t2m,tml1,u10m,uml1,ustar,hf
-  real :: al,alold,aldiff,tmean,crit
-  real :: deltau,deltat,thetastar,e,tv,stress
-  integer,parameter :: maxiter=10
-  real,parameter    :: r1=0.74
-
-  e=ew(td2m,ps)               ! vapor pressure
-  tv=t2m*(1.+0.378*e/ps)   ! virtual temperature
-  rhoa=ps/(r_air*tv)       ! air density
-
-  deltau=uml1-u10m         !! Wind Speed difference between
-                           !! Model level 1 and 10 m
-
-  if(deltau.le.0.001) then    !! Monin-Obukhov Theory not
-    al=9999.               !! applicable --> Set dummy values
-    ustar=0.01
-    stress=ustar*ustar*rhoa
-    hf=0.0
-    return
-  endif
-  deltat=tml1-t2m+0.0098*(zml1-2.)  !! Potential temperature difference
-                                    !! between model level 1 and 10 m
-
-  if(abs(deltat).le.0.03) then    !! Neutral conditions
-    hf=0.0
-    al=9999.
-    ustar=(vonkarman*deltau)/ &
-         (log(zml1/10.)-psim(zml1,al)+psim(10.,al))
-    stress=ustar*ustar*rhoa
-    return
-  endif
-
-  tmean=0.5*(t2m+tml1)
-  crit=(0.0219*tmean*(zml1-2.0)*deltau**2)/ &
-       (deltat*(zml1-10.0)**2)
-  if((deltat.gt.0).and.(crit.le.1.)) then
-                                    !! Successive approximation will
-    al=50.                          !! not converge
-    ustar=(vonkarman*deltau)/ &
-         (log(zml1/10.)-psim(zml1,al)+psim(10.,al))
-    thetastar=(vonkarman*deltat/r1)/ &
-         (log(zml1/2.)-psih(zml1,al)+psih(2.,al))
-    hf=rhoa*cpa*ustar*thetastar
-    stress=ustar*ustar*rhoa
-    return
-  endif
-
-  al=9999.                 ! Start iteration assuming neutral conditions
-  do iter=1,maxiter
-    alold=al
-    ustar=(vonkarman*deltau)/ &
-         (log(zml1/10.)-psim(zml1,al)+psim(10.,al))
-    thetastar=(vonkarman*deltat/r1)/ &
-         (log(zml1/2.)-psih(zml1,al)+psih(2.,al))
-    al=(tmean*ustar**2)/(ga*vonkarman*thetastar)
-    aldiff=abs((al-alold)/alold)
-    if(aldiff.lt.0.01) exit  !! Successive approximation successful
-  end do
-  hf=rhoa*cpa*ustar*thetastar
-  if(al.gt.9999.) al=9999.
-  if(al.lt.-9999.) al=-9999.
-
-  stress=ustar*ustar*rhoa
-end subroutine pbl_profile
+#include "tur_pbl_profile.f90"
 
 end module turbulence_mod
diff --git a/src/txt_output_mod.f90 b/src/txt_output_mod.f90
index 660513fb6a46b355ec15650854cf4a73ae19e463..440cefd2dacb567c18dd4ae57ee63971ad35c36e 100644
--- a/src/txt_output_mod.f90
+++ b/src/txt_output_mod.f90
@@ -5,167 +5,6 @@ module txt_output_mod
 
 contains
 
-subroutine writeheader_txt
-
-  !*****************************************************************************
-  !                                                                            *
-  !  This routine produces a file header containing basic information on the   *
-  !  settings of the FLEXPART run.                                             *
-  !  The header file is essential and must be read in by any postprocessing    *
-  !  program before reading in the output data.                                *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     7 August 2002                                                          *
-  !     modified IP 2013 for text output                                       *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  !                                                                            *
-  ! xlon                   longitude                                           *
-  ! xl                     model x coordinate                                  *
-  ! ylat                   latitude                                            *
-  ! yl                     model y coordinate                                  *
-  !                                                                            *
-  !*****************************************************************************
-
-  use point_mod
-  use prepoutgrid_mod
-  use par_mod
-  use com_mod
-  use date_mod
-
-  implicit none
-
-  !  integer :: jjjjmmdd,ihmmss,i,ix,jy,j
-  integer :: jjjjmmdd,ihmmss,i,j
-  real :: xp1,yp1,xp2,yp2
-
-
-  !************************
-  ! Open header output file
-  !************************
-
-  open(unitheader,file=path(2)(1:length(2))//'header_txt', &
-       form='formatted',err=998)
-  open(unitheader_txt,file=path(2)(1:length(2))//'header_txt_releases', &
-       form='formatted',err=998)
-
-
-  ! Write the header information
-  !*****************************
-  
-  write(unitheader,*) '# ibdate,ibtime, iedate, ietime, flexversion'
-  write(unitheader,*) ibdate, ibtime, iedate, ietime, trim(flexversion) !  'FLEXPART V9.0'
-  !if (ldirect.eq.1) then
-  !  write(unitheader,*) ibdate,ibtime,trim(flexversion) !  'FLEXPART V9.0'
-  !else
-  !  write(unitheader,*) iedate,ietime,trim(flexversion) ! 'FLEXPART V9.0'
-  !endif
-
-  ! Write info on output interval, averaging time, sampling time
-  !*************************************************************
-  
-  write(unitheader,*) '# interval, averaging time, sampling time'
-  write(unitheader,*) loutstep,loutaver,loutsample
-
-  ! Write information on output grid setup
-  !***************************************
-  
-  write(unitheader,*) '# information on grid setup    '
-  write(unitheader,*) '#outlon0,outlat0,numxgrid,numygrid,dxout,dyout'
-  write(unitheader,*) outlon0,outlat0,numxgrid,numygrid, &
-       dxout,dyout  
-  write(unitheader,*) '# numzgrid, outheight(.) '
-  write(unitheader,*) numzgrid,(outheight(i),i=1,numzgrid)
-
-  write(unitheader,*) '# jjjjmmdd,ihmmss'
-  call caldate(bdate,jjjjmmdd,ihmmss)
-  write(unitheader,*) jjjjmmdd,ihmmss
-
-  ! Write number of species, and name for each species (+extra name for depositions)
-  ! Indicate the vertical dimension of the fields (i.e., 1 for deposition fields, numzgrid for
-  ! concentration fields
-  !*****************************************************************************
-
-  write(unitheader,*) '# information on species'
-  write(unitheader,*) '# 3*nspec,maxpointspec_act'
-  write(unitheader,*) 3*nspec,maxpointspec_act
-  write(unitheader,*) '# for nspec:'
-  write(unitheader,*) '# 1, WD_ '
-  write(unitheader,*) '# 1, DD_ '
-  write(unitheader,*) '# numzgrid,species'
-  do i=1,nspec
-    write(unitheader,*) 1,'WD_'//species(i)(1:7)
-    write(unitheader,*) 1,'DD_'//species(i)(1:7)
-    write(unitheader,*) numzgrid,species(i)
-  end do
-
-  ! Write information on release points: total number, then for each point:
-  ! start, end, coordinates, # of particles, name, mass
-  !************************************************************************
-
-
-  write(unitheader_txt,*) '# information on release points'
-  write(unitheader_txt,*) '# numpoint'
-  write(unitheader_txt,*) numpoint
-  if ((ipin.ne.3).and.(ipin.ne.4)) then
-    write(unitheader_txt,*) '# for numpoint:'
-    do i=1,numpoint
-      write(unitheader_txt,*) ireleasestart(i),ireleaseend(i),kindz(i)
-      xp1=xpoint1(i)*dx+xlon0
-      yp1=ypoint1(i)*dy+ylat0
-      xp2=xpoint2(i)*dx+xlon0
-      yp2=ypoint2(i)*dy+ylat0
-      write(unitheader_txt,*) xp1,yp1,xp2,yp2,zpoint1(i),zpoint2(i)
-      write(unitheader_txt,*) npart(i),1
-      if (numpoint.le.1000) then
-        write(unitheader_txt,*) compoint(i)
-      else
-        write(unitheader_txt,*) compoint(1001)
-      endif
-      do j=1,nspec
-        write(unitheader_txt,*) xmass(i,j)
-        write(unitheader_txt,*) xmass(i,j)
-        write(unitheader_txt,*) xmass(i,j)
-      end do
-    end do
-  endif
-
-  ! Write information on model switches
-  !*****************************************
-
-  write(unitheader,*) '# information on model switches'
-  write(unitheader,*) '# method,lsubgrid,lconvection, ind_source,ind_receptor'
-  write(unitheader,*) method,lsubgrid,lconvection, &
-       ind_source,ind_receptor
-
-  ! Write age class information
-  !****************************
-  
-  write(unitheader,*) '# information on age class     '
-  write(unitheader,*) nageclass,(lage(i),i=1,nageclass)
-
-
-  !Do not write topography to text output file. Keep it on the binary one
-  !********************************
-
-  !do ix=0,numxgrid-1
-  !  write(unitheader,*) (oroout(ix,jy),jy=0,numygrid-1)
-  !end do
-
-  close(unitheader)
-  close(unitheader_txt)
-
-  return
-
-
-998   write(*,*) ' #### FLEXPART MODEL ERROR!   THE FILE         #### '
-  write(*,*) ' #### '//path(2)(1:length(2))//'header_txt'//' #### '
-  write(*,*) ' #### CANNOT BE OPENED. IF A FILE WITH THIS    #### '
-  write(*,*) ' #### NAME ALREADY EXISTS, DELETE IT AND START #### '
-  write(*,*) ' #### THE PROGRAM AGAIN.                       #### '
-  stop
-end subroutine writeheader_txt
+#include "txt_writeheader_txt.f90"
 
 end module txt_output_mod
diff --git a/src/txt_writeheader_txt.f90 b/src/txt_writeheader_txt.f90
new file mode 100644
index 0000000000000000000000000000000000000000..4a25781d5b7704077e9bf55317cec441143be5de
--- /dev/null
+++ b/src/txt_writeheader_txt.f90
@@ -0,0 +1,165 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine writeheader_txt
+
+  !*****************************************************************************
+  !                                                                            *
+  !  This routine produces a file header containing basic information on the   *
+  !  settings of the FLEXPART run.                                             *
+  !  The header file is essential and must be read in by any postprocessing    *
+  !  program before reading in the output data.                                *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     7 August 2002                                                          *
+  !     modified IP 2013 for text output                                       *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  ! xlon                   longitude                                           *
+  ! xl                     model x coordinate                                  *
+  ! ylat                   latitude                                            *
+  ! yl                     model y coordinate                                  *
+  !                                                                            *
+  !*****************************************************************************
+
+  use point_mod
+  use prepoutgrid_mod
+  use par_mod
+  use com_mod
+  use date_mod
+
+  implicit none
+
+  !  integer :: jjjjmmdd,ihmmss,i,ix,jy,j
+  integer :: jjjjmmdd,ihmmss,i,j
+  real :: xp1,yp1,xp2,yp2
+
+
+  !************************
+  ! Open header output file
+  !************************
+
+  open(unitheader,file=path(2)(1:length(2))//'header_txt', &
+       form='formatted',err=998)
+  open(unitheader_txt,file=path(2)(1:length(2))//'header_txt_releases', &
+       form='formatted',err=998)
+
+
+  ! Write the header information
+  !*****************************
+
+  write(unitheader,*) '# ibdate,ibtime, iedate, ietime, flexversion'
+  write(unitheader,*) ibdate, ibtime, iedate, ietime, trim(flexversion) !  'FLEXPART V9.0'
+  !if (ldirect.eq.1) then
+  !  write(unitheader,*) ibdate,ibtime,trim(flexversion) !  'FLEXPART V9.0'
+  !else
+  !  write(unitheader,*) iedate,ietime,trim(flexversion) ! 'FLEXPART V9.0'
+  !endif
+
+  ! Write info on output interval, averaging time, sampling time
+  !*************************************************************
+
+  write(unitheader,*) '# interval, averaging time, sampling time'
+  write(unitheader,*) loutstep,loutaver,loutsample
+
+  ! Write information on output grid setup
+  !***************************************
+
+  write(unitheader,*) '# information on grid setup    '
+  write(unitheader,*) '#outlon0,outlat0,numxgrid,numygrid,dxout,dyout'
+  write(unitheader,*) outlon0,outlat0,numxgrid,numygrid, &
+       dxout,dyout
+  write(unitheader,*) '# numzgrid, outheight(.) '
+  write(unitheader,*) numzgrid,(outheight(i),i=1,numzgrid)
+
+  write(unitheader,*) '# jjjjmmdd,ihmmss'
+  call caldate(bdate,jjjjmmdd,ihmmss)
+  write(unitheader,*) jjjjmmdd,ihmmss
+
+  ! Write number of species, and name for each species (+extra name for depositions)
+  ! Indicate the vertical dimension of the fields (i.e., 1 for deposition fields, numzgrid for
+  ! concentration fields
+  !*****************************************************************************
+
+  write(unitheader,*) '# information on species'
+  write(unitheader,*) '# 3*nspec,maxpointspec_act'
+  write(unitheader,*) 3*nspec,maxpointspec_act
+  write(unitheader,*) '# for nspec:'
+  write(unitheader,*) '# 1, WD_ '
+  write(unitheader,*) '# 1, DD_ '
+  write(unitheader,*) '# numzgrid,species'
+  do i=1,nspec
+    write(unitheader,*) 1,'WD_'//species(i)(1:7)
+    write(unitheader,*) 1,'DD_'//species(i)(1:7)
+    write(unitheader,*) numzgrid,species(i)
+  end do
+
+  ! Write information on release points: total number, then for each point:
+  ! start, end, coordinates, # of particles, name, mass
+  !************************************************************************
+
+
+  write(unitheader_txt,*) '# information on release points'
+  write(unitheader_txt,*) '# numpoint'
+  write(unitheader_txt,*) numpoint
+  if ((ipin.ne.3).and.(ipin.ne.4)) then
+    write(unitheader_txt,*) '# for numpoint:'
+    do i=1,numpoint
+      write(unitheader_txt,*) ireleasestart(i),ireleaseend(i),kindz(i)
+      xp1=xpoint1(i)*dx+xlon0
+      yp1=ypoint1(i)*dy+ylat0
+      xp2=xpoint2(i)*dx+xlon0
+      yp2=ypoint2(i)*dy+ylat0
+      write(unitheader_txt,*) xp1,yp1,xp2,yp2,zpoint1(i),zpoint2(i)
+      write(unitheader_txt,*) npart(i),1
+      if (numpoint.le.1000) then
+        write(unitheader_txt,*) compoint(i)
+      else
+        write(unitheader_txt,*) compoint(1001)
+      endif
+      do j=1,nspec
+        write(unitheader_txt,*) xmass(i,j)
+        write(unitheader_txt,*) xmass(i,j)
+        write(unitheader_txt,*) xmass(i,j)
+      end do
+    end do
+  endif
+
+  ! Write information on model switches
+  !*****************************************
+
+  write(unitheader,*) '# information on model switches'
+  write(unitheader,*) '# method,lsubgrid,lconvection, ind_source,ind_receptor'
+  write(unitheader,*) method,lsubgrid,lconvection, &
+       ind_source,ind_receptor
+
+  ! Write age class information
+  !****************************
+
+  write(unitheader,*) '# information on age class     '
+  write(unitheader,*) nageclass,(lage(i),i=1,nageclass)
+
+
+  !Do not write topography to text output file. Keep it on the binary one
+  !********************************
+
+  !do ix=0,numxgrid-1
+  !  write(unitheader,*) (oroout(ix,jy),jy=0,numygrid-1)
+  !end do
+
+  close(unitheader)
+  close(unitheader_txt)
+
+  return
+
+
+998   write(*,*) ' #### FLEXPART MODEL ERROR!   THE FILE         #### '
+  write(*,*) ' #### '//path(2)(1:length(2))//'header_txt'//' #### '
+  write(*,*) ' #### CANNOT BE OPENED. IF A FILE WITH THIS    #### '
+  write(*,*) ' #### NAME ALREADY EXISTS, DELETE IT AND START #### '
+  write(*,*) ' #### THE PROGRAM AGAIN.                       #### '
+  stop
+end subroutine writeheader_txt
diff --git a/src/unc_deposit_decay.f90 b/src/unc_deposit_decay.f90
new file mode 100644
index 0000000000000000000000000000000000000000..b9c48d1b55ce572e50e5e6fad06a04a251aa79e3
--- /dev/null
+++ b/src/unc_deposit_decay.f90
@@ -0,0 +1,56 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine deposit_decay()
+  ! Accumulated deposited mass radioactively decays
+  use com_mod
+
+  implicit none
+
+  integer ::                &
+    j,i,                    & ! loop variable over grid
+    ks,                     & ! loop variable species
+    kp,                     & ! loop variable for maxpointspec_act
+    l,                      & ! loop variable over nclassunc
+    nage,                   & ! loop variable over age classes
+    n                         ! loop variable over particles
+
+!$OMP PARALLEL PRIVATE(ks,kp,nage,l,j,i)
+!$OMP DO COLLAPSE(2)
+  do ks=1,nspec
+  do kp=1,maxpointspec_act
+    if (decay(ks).gt.0.) then
+      do nage=1,nageclass
+        do l=1,nclassunc
+  ! Mother output grid
+          do j=0,numygrid-1
+            do i=0,numxgrid-1
+              wetgridunc(i,j,ks,kp,l,nage)= &
+                   wetgridunc(i,j,ks,kp,l,nage)* &
+                   exp(-1.*outstep*decay(ks))
+              drygridunc(i,j,ks,kp,l,nage)= &
+                   drygridunc(i,j,ks,kp,l,nage)* &
+                   exp(-1.*outstep*decay(ks))
+            end do
+          end do
+  ! Nested output grid
+          if (nested_output.eq.1) then
+            do j=0,numygridn-1
+              do i=0,numxgridn-1
+                wetgriduncn(i,j,ks,kp,l,nage)= &
+                     wetgriduncn(i,j,ks,kp,l,nage)* &
+                     exp(-1.*outstep*decay(ks))
+                drygriduncn(i,j,ks,kp,l,nage)= &
+                     drygriduncn(i,j,ks,kp,l,nage)* &
+                     exp(-1.*outstep*decay(ks))
+              end do
+            end do
+          endif
+        end do
+      end do
+    endif
+  end do
+  end do
+!$OMP END DO
+!$OMP END PARALLEL
+end subroutine deposit_decay
diff --git a/src/unc_mod.f90 b/src/unc_mod.f90
index e536ef7f9127f6807343bc32121b7e98edcb1deb..e69be2ba7123ba3b76a07f01877602e335f0f149 100644
--- a/src/unc_mod.f90
+++ b/src/unc_mod.f90
@@ -42,58 +42,6 @@ module unc_mod
 
 contains
 
-subroutine deposit_decay()
-  ! Accumulated deposited mass radioactively decays
-  use com_mod
-
-  implicit none
-
-  integer ::                &
-    j,i,                    & ! loop variable over grid
-    ks,                     & ! loop variable species
-    kp,                     & ! loop variable for maxpointspec_act
-    l,                      & ! loop variable over nclassunc
-    nage,                   & ! loop variable over age classes
-    n                         ! loop variable over particles
-
-!$OMP PARALLEL PRIVATE(ks,kp,nage,l,j,i)
-!$OMP DO COLLAPSE(2)
-  do ks=1,nspec
-  do kp=1,maxpointspec_act
-    if (decay(ks).gt.0.) then
-      do nage=1,nageclass
-        do l=1,nclassunc
-  ! Mother output grid
-          do j=0,numygrid-1
-            do i=0,numxgrid-1
-              wetgridunc(i,j,ks,kp,l,nage)= &
-                   wetgridunc(i,j,ks,kp,l,nage)* &
-                   exp(-1.*outstep*decay(ks))
-              drygridunc(i,j,ks,kp,l,nage)= &
-                   drygridunc(i,j,ks,kp,l,nage)* &
-                   exp(-1.*outstep*decay(ks))
-            end do
-          end do
-  ! Nested output grid
-          if (nested_output.eq.1) then
-            do j=0,numygridn-1
-              do i=0,numxgridn-1
-                wetgriduncn(i,j,ks,kp,l,nage)= &
-                     wetgriduncn(i,j,ks,kp,l,nage)* &
-                     exp(-1.*outstep*decay(ks))
-                drygriduncn(i,j,ks,kp,l,nage)= &
-                     drygriduncn(i,j,ks,kp,l,nage)* &
-                     exp(-1.*outstep*decay(ks))
-              end do
-            end do
-          endif
-        end do
-      end do
-    endif
-  end do
-  end do
-!$OMP END DO
-!$OMP END PARALLEL
-end subroutine deposit_decay
+#include "unc_deposit_decay.f90"
 
 end module unc_mod
diff --git a/src/ver_vertransf_init.f90 b/src/ver_vertransf_init.f90
new file mode 100644
index 0000000000000000000000000000000000000000..5ce0a7a1b4e10f7b899d2fb606ea6c6f49933973
--- /dev/null
+++ b/src/ver_vertransf_init.f90
@@ -0,0 +1,65 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine vertransf_init(n)
+
+  use par_mod
+  use com_mod
+  use qvsat_mod
+  use initialise_mod
+  use output_mod
+
+  implicit none
+
+  integer, intent(in) :: n
+  real ::  tvold,pold,pint,tv
+  integer :: ix,jy,kz,ixm,jym
+  real,parameter :: const=r_air/ga
+
+  if ((ipin.eq.1).or.(ipin.eq.4)) then
+    call read_heightlevels(height,nmixz)
+    return
+  endif
+
+  loop1: do jy=0,nymin1
+    do ix=0,nxmin1
+      if (ps(ix,jy,1,n).gt.100000.) then
+        ixm=ix
+        jym=jy
+        exit loop1
+      endif
+    end do
+  end do loop1
+
+  tvold=tt2(ixm,jym,1,n)*(1.+0.378*ew(td2(ixm,jym,1,n),ps(ixm,jym,1,n))/ &
+       ps(ixm,jym,1,n))
+  pold=ps(ixm,jym,1,n)
+  height(1)=0.
+
+  do kz=2,nuvz
+    pint=akz(kz)+bkz(kz)*ps(ixm,jym,1,n)
+    tv=tth(ixm,jym,kz,n)*(1.+0.608*qvh(ixm,jym,kz,n))
+
+    if (abs(tv-tvold).gt.0.2) then
+      height(kz)= height(kz-1)+const*log(pold/pint)* &
+           (tv-tvold)/log(tv/tvold)
+    else
+      height(kz)=height(kz-1)+const*log(pold/pint)*tv
+    endif
+
+    tvold=tv
+    pold=pint
+  end do
+
+  ! Determine highest levels that can be within PBL
+  !************************************************
+
+  do kz=1,nz
+    if (height(kz).gt.hmixmax) then
+      nmixz=kz
+      exit
+    endif
+  end do
+
+  call output_heightlevs(height,nmixz)
+end subroutine vertransf_init
diff --git a/src/ver_verttransf_ec_cloud.f90 b/src/ver_verttransf_ec_cloud.f90
new file mode 100644
index 0000000000000000000000000000000000000000..0ce52f0a72e49a9bca80186baab21096c665935a
--- /dev/null
+++ b/src/ver_verttransf_ec_cloud.f90
@@ -0,0 +1,168 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine verttransf_ec_cloud(n,lreadclouds,lsumclouds,nxlim,nylim,clouds_tmp,cloudsh_tmp,&
+  clw_tmp,ctwc_tmp,clwc_tmp,ciwc_tmp,lsprec_tmp,convprec_tmp,rho_tmp,tt_tmp,qv_tmp,uvzlev)
+  use par_mod
+  use com_mod
+  use cmapf_mod, only: cc2gll
+  use qvsat_mod
+
+  implicit none
+
+  logical,intent(in) :: lreadclouds,lsumclouds
+  integer, intent(in) :: nxlim,nylim
+  integer, intent(in) :: n
+  integer(kind=1),intent(inout) :: clouds_tmp(0:nxlim,0:nylim,nzmax)
+  integer,intent(inout) :: cloudsh_tmp(0:nxlim,0:nylim)
+  real,intent(inout) :: clw_tmp(0:nxlim,0:nylim,nzmax)
+  real,intent(inout) :: ctwc_tmp(0:nxlim,0:nylim)
+  real,intent(inout) :: clwc_tmp(0:nxlim,0:nylim,nzmax)
+  real,intent(in) :: ciwc_tmp(0:nxlim,0:nylim,nzmax)
+  real,intent(in) :: lsprec_tmp(0:nxlim,0:nylim),convprec_tmp(0:nxlim,0:nylim)
+  real,intent(in),dimension(0:nxlim,0:nylim,nzmax) :: rho_tmp,tt_tmp,qv_tmp
+  real,intent(out),dimension(0:nxlim,0:nylim,nzmax) :: uvzlev
+
+  integer,dimension(0:nxmax-1,0:nymax-1) :: rain_cloud_above
+
+  integer :: ix,jy,kz,kz_inv
+  real :: pressure,rh,lsp,convp,cloudh_min,prec
+
+!*******************************************************************************
+  if (lreadclouds) then !HG METHOD:
+! loops all grids vertically and constructs the 3D matrix for clouds
+! Cloud top and cloud bottom gid cells are assigned as well as the total column
+! cloud water. For precipitating grids, the type and whether it is in or below
+! cloud scavenging are assigned with numbers 2-5 (following the old metod).
+! Distinction is done for lsp and convp though they are treated the same in
+! regards to scavenging. Also clouds that are not precipitating are defined
+! which may be to include future cloud processing by non-precipitating-clouds.
+!*******************************************************************************
+    !write(*,*) 'Global ECMWF fields: using cloud water'
+    clw_tmp(0:nxlim,0:nylim,:)=0.0
+  !    icloud_stats(:,:,:,n)=0.0
+    ctwc_tmp(:,:)=0.0
+    clouds_tmp(0:nxlim,0:nylim,:)=0
+  ! If water/ice are read separately into clwc and ciwc, store sum in clwc
+    if (.not.lsumclouds) then
+      clwc_tmp(0:nxlim,0:nylim,:) = clwc_tmp(0:nxlim,0:nylim,:) + ciwc_tmp(:,:,:)
+    end if
+    do jy=0,nylim
+      do ix=0,nxlim
+        lsp=lsprec_tmp(ix,jy)
+        convp=convprec_tmp(ix,jy)
+        prec=lsp+convp
+  !        tot_cloud_h=0
+  ! Find clouds in the vertical
+        do kz=1, nz-1 !go from top to bottom
+          if (clwc_tmp(ix,jy,kz).gt.0) then
+  ! assuming rho is in kg/m3 and hz in m gives: kg/kg * kg/m3 *m3/kg /m = m2/m3
+            if (wind_coord_type.eq.'ETA') then
+              clw_tmp(ix,jy,kz)=(clwc_tmp(ix,jy,kz)*rho_tmp(ix,jy,kz))* &
+                (uvzlev(ix,jy,kz+1)-uvzlev(ix,jy,kz))
+              cloudh_min=min(uvzlev(ix,jy,kz+1),uvzlev(ix,jy,kz))
+            else
+              clw_tmp(ix,jy,kz)= (clwc_tmp(ix,jy,kz)*rho_tmp(ix,jy,kz))* &
+                (height(kz+1)-height(kz))
+  !           icloud_stats(ix,jy,3,n)= min(height(kz+1),height(kz))
+                       ! Cloud BOT height stats      [m]
+              cloudh_min=min(height(kz+1),height(kz))
+            endif
+  !            tot_cloud_h=tot_cloud_h+(height(kz+1)-height(kz))
+
+  !            icloud_stats(ix,jy,4,n)= icloud_stats(ix,jy,4,n)+clw(ix,jy,kz,n)
+           ! Column cloud water [m3/m3]
+            ctwc_tmp(ix,jy) = ctwc_tmp(ix,jy)+clw_tmp(ix,jy,kz)
+
+          endif
+        end do
+
+  ! If Precipitation. Define removal type in the vertical
+        if ((lsp.gt.0.01).or.(convp.gt.0.01)) then ! cloud and precipitation
+
+          do kz=nz,2,-1 !go Bottom up!
+            if (clw_tmp(ix,jy,kz).gt. 0) then ! is in cloud
+              if (wind_coord_type.eq.'ETA') then
+                cloudsh_tmp(ix,jy)=cloudsh_tmp(ix,jy)+ &
+                uvzlev(ix,jy,kz)-uvzlev(ix,jy,kz-1)
+              else
+                cloudsh_tmp(ix,jy)=cloudsh_tmp(ix,jy)+height(kz)-height(kz-1)
+              endif
+              clouds_tmp(ix,jy,kz)=1                               ! is a cloud
+              if (lsp.ge.convp) then
+                clouds_tmp(ix,jy,kz)=3                            ! lsp in-cloud
+              else
+                clouds_tmp(ix,jy,kz)=2          ! convp in-cloud
+              endif                             ! convective or large scale
+            elseif (clw_tmp(ix,jy,kz).le.0 .and. cloudh_min.ge.height(kz)) then
+            ! is below cloud
+              if (lsp.ge.convp) then
+                clouds_tmp(ix,jy,kz)=5          ! lsp dominated washout
+              else
+                clouds_tmp(ix,jy,kz)=4          ! convp dominated washout
+              endif                             ! convective or large scale
+            endif
+
+            if (height(kz).ge. 19000) then      ! set a max height for removal
+              clouds_tmp(ix,jy,kz)=0
+            endif !clw>0
+          end do !nz
+        endif ! precipitation
+      end do
+    end do
+
+  ! eso: copy the relevant data to clw4 to reduce amount of communicated data for MPI
+  !    ctwc(:,:,n) = icloud_stats(:,:,4,n)
+
+  !**************************************************************************
+  else       ! use old definitions
+  !**************************************************************************
+  !   create a cloud and rainout/washout field, clouds occur where rh>80%
+  !   total cloudheight is stored at level 0
+    !write(*,*) 'Global fields: using cloud water from Parameterization'
+    do jy=0,nylim
+      do ix=0,nxlim
+  ! OLD METHOD
+        rain_cloud_above(ix,jy)=0
+        lsp=lsprec_tmp(ix,jy)
+        convp=convprec_tmp(ix,jy)
+        cloudsh_tmp(ix,jy)=0
+        do kz_inv=1,nz-1
+          kz=nz-kz_inv+1
+          pressure=rho_tmp(ix,jy,kz)*r_air*tt_tmp(ix,jy,kz)
+          rh=qv_tmp(ix,jy,kz)/f_qvsat(pressure,tt_tmp(ix,jy,kz))
+          clouds_tmp(ix,jy,kz)=0
+          if (rh.gt.0.8) then ! in cloud
+            if ((lsp.gt.0.01).or.(convp.gt.0.01)) then ! cloud and precipitation
+              rain_cloud_above(ix,jy)=1
+              if (wind_coord_type.eq.'ETA') then
+                cloudsh_tmp(ix,jy)=cloudsh_tmp(ix,jy)+ &
+                     uvzlev(ix,jy,kz)-uvzlev(ix,jy,kz-1)
+              else
+                cloudsh_tmp(ix,jy)=cloudsh_tmp(ix,jy)+ &
+                     height(kz)-height(kz-1)
+              endif
+              if (lsp.ge.convp) then
+                clouds_tmp(ix,jy,kz)=3 ! lsp dominated rainout
+              else
+                clouds_tmp(ix,jy,kz)=2 ! convp dominated rainout
+              endif
+            else ! no precipitation
+              clouds_tmp(ix,jy,kz)=1 ! cloud
+            endif
+          else ! no cloud
+            if (rain_cloud_above(ix,jy).eq.1) then ! scavenging
+              if (lsp.ge.convp) then
+                clouds_tmp(ix,jy,kz)=5 ! lsp dominated washout
+              else
+                clouds_tmp(ix,jy,kz)=4 ! convp dominated washout
+              endif
+            endif
+          endif
+        end do
+  !END OLD METHOD
+      end do
+    end do
+  endif !readclouds
+
+end subroutine verttransf_ec_cloud
diff --git a/src/ver_verttransf_ec_height.f90 b/src/ver_verttransf_ec_height.f90
new file mode 100644
index 0000000000000000000000000000000000000000..554c25ee612db49def32ba3b1aa0341eed6ee906
--- /dev/null
+++ b/src/ver_verttransf_ec_height.f90
@@ -0,0 +1,83 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine verttransf_ec_height(nxlim,nylim, &
+
+  tt2_tmp,td2_tmp,ps_tmp,qvh_tmp,tth_tmp,prsh_tmp, &
+  rhoh_tmp,pinmconv,uvzlev,wzlev)
+  use par_mod
+  use com_mod
+  use qvsat_mod
+
+  implicit none
+
+  integer, intent(in) :: nxlim,nylim
+  real,intent(in),dimension(0:nxlim,0:nylim) :: tt2_tmp,td2_tmp,ps_tmp
+  real,intent(in),dimension(0:nxlim,0:nylim,nuvzmax) :: qvh_tmp,tth_tmp
+  real,intent(out),dimension(0:nxlim,0:nylim,nuvzmax) :: rhoh_tmp,prsh_tmp
+  real,intent(out),dimension(0:nxlim,0:nylim,nzmax) :: pinmconv
+  real,intent(out),dimension(0:nxlim,0:nylim,nuvzmax) :: uvzlev,wzlev
+  real,dimension(0:nxlim,0:nylim) :: tvold,pold,pint,tv
+  real,parameter :: const=r_air/ga
+  integer :: ix,jy,kz
+  integer :: nxm1,nym1
+
+  ! Loop over the whole grid
+  !*************************
+
+  do jy=0,nylim
+    do ix=0,nxlim
+      tvold(ix,jy)=tt2_tmp(ix,jy)*(1.+0.378*ew(td2_tmp(ix,jy),ps_tmp(ix,jy))/ &
+           ps_tmp(ix,jy))
+    end do
+  end do
+
+  pold(:,:)=ps_tmp(:,:)
+  uvzlev(:,:,1)=0.
+  wzlev(:,:,1)=0.
+  rhoh_tmp(:,:,1)=pold(:,:)/(r_air*tvold(:,:))
+  prsh_tmp(:,:,1)=ps_tmp(:,:)
+
+  ! Compute heights of eta levels
+  !******************************
+
+  do kz=2,nuvz
+    pint(:,:)=akz(kz)+bkz(kz)*ps_tmp(:,:)
+    prsh_tmp(:,:,kz)=pint(:,:)
+    tv(:,:)=tth_tmp(:,:,kz)*(1.+0.608*qvh_tmp(:,:,kz))
+    rhoh_tmp(:,:,kz)=pint(:,:)/(r_air*tv(:,:))
+
+    where (abs(tv(:,:)-tvold(:,:)).gt.0.2)
+      uvzlev(:,:,kz)=uvzlev(:,:,kz-1)+const*&
+           &log(pold(:,:)/pint(:,:))* &
+           (tv(:,:)-tvold(:,:))/&
+           &log(tv(:,:)/tvold(:,:))
+    elsewhere
+      uvzlev(:,:,kz)=uvzlev(:,:,kz-1)+const*&
+           &log(pold(:,:)/pint(:,:))*tv(:,:)
+    endwhere
+
+    tvold(:,:)=tv(:,:)
+    pold(:,:)=pint(:,:)
+
+  end do
+
+  do kz=2,nwz-1
+    wzlev(:,:,kz)=(uvzlev(:,:,kz+1)+uvzlev(:,:,kz))/2.
+  end do
+  wzlev(:,:,nwz)=wzlev(:,:,nwz-1)+ uvzlev(:,:,nuvz)-uvzlev(:,:,nuvz-1)
+
+
+  pinmconv(:,:,1)=(uvzlev(:,:,2))/ &
+       ((aknew(2)+bknew(2)*ps_tmp(:,:))- &
+        (aknew(1)+bknew(1)*ps_tmp(:,:)))
+  do kz=2,nz-1
+    pinmconv(:,:,kz)=(uvzlev(:,:,kz+1)-uvzlev(:,:,kz-1))/ &
+         ((aknew(kz+1)+bknew(kz+1)*ps_tmp(:,:))- &
+          (aknew(kz-1)+bknew(kz-1)*ps_tmp(:,:)))
+  end do
+  pinmconv(:,:,nz)=(uvzlev(:,:,nz)-uvzlev(:,:,nz-1))/ &
+       ((aknew(nz)+bknew(nz)*ps_tmp(:,:))- &
+        (aknew(nz-1)+bknew(nz-1)*ps_tmp(:,:)))
+
+end subroutine verttransf_ec_height
diff --git a/src/ver_verttransf_ec_stereo.f90 b/src/ver_verttransf_ec_stereo.f90
new file mode 100644
index 0000000000000000000000000000000000000000..2a26c43fb7f7ff413416f679f010a2118a151c40
--- /dev/null
+++ b/src/ver_verttransf_ec_stereo.f90
@@ -0,0 +1,276 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine verttransf_ec_stereo(n)
+  use par_mod
+  use com_mod
+  use cmapf_mod, only: cc2gll
+  use qvsat_mod
+
+  implicit none
+
+  integer, intent(in) :: n
+
+  integer :: ix,jy,iz
+  real :: xlon,ylat,xlonr
+  real :: uuaux,vvaux,uupolaux,vvpolaux,ddpol,ffpol,wdummy
+
+  if (nglobal) then
+    do iz=1,nz
+      do jy=int(switchnorthg)-2,nymin1
+        ylat=ylat0+real(jy)*dy
+        do ix=0,nxmin1
+          xlon=xlon0+real(ix)*dx
+          call cc2gll(northpolemap,ylat,xlon,uu(ix,jy,iz,n), &
+               vv(ix,jy,iz,n),uupol(ix,jy,iz,n), &
+               vvpol(ix,jy,iz,n))
+          if (wind_coord_type.eq.'ETA') then
+            call cc2gll(northpolemap,ylat,xlon,uueta(ix,jy,iz,n), &
+                 vveta(ix,jy,iz,n),uupoleta(ix,jy,iz,n), &
+                 vvpoleta(ix,jy,iz,n))
+          endif
+        end do
+      end do
+    end do
+
+
+    do iz=1,nz
+
+  ! CALCULATE FFPOL, DDPOL FOR CENTRAL GRID POINT
+  !
+  !   AMSnauffer Nov 18 2004 Added check for case vv=0
+  !
+      xlon=xlon0+real(nx/2-1)*dx
+      xlonr=xlon*pi/180.
+      ffpol=sqrt(uu(nx/2-1,nymin1,iz,n)**2+ &
+           vv(nx/2-1,nymin1,iz,n)**2)
+      if (vv(nx/2-1,nymin1,iz,n).lt.0.) then
+        ddpol=atan(uu(nx/2-1,nymin1,iz,n)/ &
+             vv(nx/2-1,nymin1,iz,n))-xlonr
+      else if (vv(nx/2-1,nymin1,iz,n).gt.0.) then
+        ddpol=pi+atan(uu(nx/2-1,nymin1,iz,n)/ &
+             vv(nx/2-1,nymin1,iz,n))-xlonr
+      else
+        ddpol=pi/2-xlonr
+      endif
+      if(ddpol.lt.0.) ddpol=2.0*pi+ddpol
+      if(ddpol.gt.2.0*pi) ddpol=ddpol-2.0*pi
+
+  ! CALCULATE U,V FOR 180 DEG, TRANSFORM TO POLAR STEREOGRAPHIC GRID
+      xlon=180.0
+      xlonr=xlon*pi/180.
+      ylat=90.0
+      uuaux=-ffpol*sin(xlonr+ddpol)
+      vvaux=-ffpol*cos(xlonr+ddpol)
+      call cc2gll(northpolemap,ylat,xlon,uuaux,vvaux,uupolaux, &
+           vvpolaux)
+
+      jy=nymin1
+      do ix=0,nxmin1
+        uupol(ix,jy,iz,n)=uupolaux
+        vvpol(ix,jy,iz,n)=vvpolaux
+      end do
+    end do
+
+    if (wind_coord_type.eq.'ETA') then
+      do iz=1,nz
+
+        xlon=xlon0+real(nx/2-1)*dx
+        xlonr=xlon*pi/180.
+        ffpol=sqrt(uueta(nx/2-1,nymin1,iz,n)**2+ &
+             vveta(nx/2-1,nymin1,iz,n)**2)
+        if (vveta(nx/2-1,nymin1,iz,n).lt.0.) then
+          ddpol=atan(uueta(nx/2-1,nymin1,iz,n)/ &
+               vveta(nx/2-1,nymin1,iz,n))-xlonr
+        else if (vveta(nx/2-1,nymin1,iz,n).gt.0.) then
+          ddpol=pi+atan(uueta(nx/2-1,nymin1,iz,n)/ &
+               vveta(nx/2-1,nymin1,iz,n))-xlonr
+        else
+          ddpol=pi/2-xlonr
+        endif
+        if(ddpol.lt.0.) ddpol=2.0*pi+ddpol
+        if(ddpol.gt.2.0*pi) ddpol=ddpol-2.0*pi
+
+  ! CALCULATE U,V FOR 180 DEG, TRANSFORM TO POLAR STEREOGRAPHIC GRID
+        xlon=180.0
+        xlonr=xlon*pi/180.
+        ylat=90.0
+        uuaux=-ffpol*sin(xlonr+ddpol)
+        vvaux=-ffpol*cos(xlonr+ddpol)
+        call cc2gll(northpolemap,ylat,xlon,uuaux,vvaux,uupolaux, &
+             vvpolaux)
+
+        jy=nymin1
+        do ix=0,nxmin1
+          uupoleta(ix,jy,iz,n)=uupolaux
+          vvpoleta(ix,jy,iz,n)=vvpolaux
+        end do
+      end do
+    endif
+
+
+  ! Fix: Set W at pole to the zonally averaged W of the next equator-
+  ! ward parallel of latitude
+
+    do iz=1,nz
+      wdummy=0.
+      jy=ny-2
+      do ix=0,nxmin1
+        wdummy=wdummy+ww(ix,jy,iz,n)
+      end do
+      wdummy=wdummy/real(nx)
+      jy=nymin1
+      do ix=0,nxmin1
+        ww(ix,jy,iz,n)=wdummy
+      end do
+    end do
+
+    if (wind_coord_type.eq.'ETA') then
+      do iz=1,nz
+        wdummy=0.
+        jy=ny-2
+        do ix=0,nxmin1
+          wdummy=wdummy+wweta(ix,jy,iz,n)
+        end do
+        wdummy=wdummy/real(nx)
+        jy=nymin1
+        do ix=0,nxmin1
+          wweta(ix,jy,iz,n)=wdummy
+        end do
+      end do
+    endif
+
+  endif
+
+
+  ! If south pole is in the domain, calculate wind velocities in polar
+  ! stereographic coordinates
+  !*******************************************************************
+
+  if (sglobal) then
+    do iz=1,nz
+      do jy=0,int(switchsouthg)+3
+        ylat=ylat0+real(jy)*dy
+        do ix=0,nxmin1
+          xlon=xlon0+real(ix)*dx
+          call cc2gll(southpolemap,ylat,xlon,uu(ix,jy,iz,n), &
+               vv(ix,jy,iz,n),uupol(ix,jy,iz,n), &
+               vvpol(ix,jy,iz,n))
+          if (wind_coord_type.eq.'ETA') then
+            call cc2gll(southpolemap,ylat,xlon,uueta(ix,jy,iz,n), &
+                 vveta(ix,jy,iz,n),uupoleta(ix,jy,iz,n), &
+                 vvpoleta(ix,jy,iz,n))
+          endif
+        end do
+      end do
+    end do
+
+    do iz=1,nz
+
+  ! CALCULATE FFPOL, DDPOL FOR CENTRAL GRID POINT
+  !
+  !   AMSnauffer Nov 18 2004 Added check for case vv=0
+  !
+      xlon=xlon0+real(nx/2-1)*dx
+      xlonr=xlon*pi/180.
+      ffpol=sqrt(uu(nx/2-1,0,iz,n)**2+ &
+           vv(nx/2-1,0,iz,n)**2)
+      if (vv(nx/2-1,0,iz,n).lt.0.) then
+        ddpol=atan(uu(nx/2-1,0,iz,n)/ &
+             vv(nx/2-1,0,iz,n))+xlonr
+      else if (vv(nx/2-1,0,iz,n).gt.0.) then
+        ddpol=pi+atan(uu(nx/2-1,0,iz,n)/ &
+             vv(nx/2-1,0,iz,n))+xlonr
+      else
+        ddpol=pi/2-xlonr
+      endif
+      if(ddpol.lt.0.) ddpol=2.0*pi+ddpol
+      if(ddpol.gt.2.0*pi) ddpol=ddpol-2.0*pi
+
+  ! CALCULATE U,V FOR 180 DEG, TRANSFORM TO POLAR STEREOGRAPHIC GRID
+      xlon=180.0
+      xlonr=xlon*pi/180.
+      ylat=-90.0
+      uuaux=+ffpol*sin(xlonr-ddpol)
+      vvaux=-ffpol*cos(xlonr-ddpol)
+      call cc2gll(northpolemap,ylat,xlon,uuaux,vvaux,uupolaux, &
+           vvpolaux)
+
+      jy=0
+      do ix=0,nxmin1
+        uupol(ix,jy,iz,n)=uupolaux
+        vvpol(ix,jy,iz,n)=vvpolaux
+      end do
+    end do
+
+    if (wind_coord_type.eq.'ETA') then
+      do iz=1,nz
+  ! CALCULATE FFPOL, DDPOL FOR CENTRAL GRID POINT
+  !
+  !   AMSnauffer Nov 18 2004 Added check for case vv=0
+  !
+        xlon=xlon0+real(nx/2-1)*dx
+        xlonr=xlon*pi/180.
+        ffpol=sqrt(uueta(nx/2-1,0,iz,n)**2+ &
+             vveta(nx/2-1,0,iz,n)**2)
+        if (vveta(nx/2-1,0,iz,n).lt.0.) then
+          ddpol=atan(uueta(nx/2-1,0,iz,n)/ &
+               vveta(nx/2-1,0,iz,n))+xlonr
+        else if (vveta(nx/2-1,0,iz,n).gt.0.) then
+          ddpol=pi+atan(uueta(nx/2-1,0,iz,n)/ &
+               vveta(nx/2-1,0,iz,n))+xlonr
+        else
+          ddpol=pi/2-xlonr
+        endif
+        if(ddpol.lt.0.) ddpol=2.0*pi+ddpol
+        if(ddpol.gt.2.0*pi) ddpol=ddpol-2.0*pi
+
+  ! CALCULATE U,V FOR 180 DEG, TRANSFORM TO POLAR STEREOGRAPHIC GRID
+        xlon=180.0
+        xlonr=xlon*pi/180.
+        ylat=-90.0
+        uuaux=+ffpol*sin(xlonr-ddpol)
+        vvaux=-ffpol*cos(xlonr-ddpol)
+        call cc2gll(northpolemap,ylat,xlon,uuaux,vvaux,uupolaux, &
+             vvpolaux)
+
+        jy=0
+        do ix=0,nxmin1
+          uupoleta(ix,jy,iz,n)=uupolaux
+          vvpoleta(ix,jy,iz,n)=vvpolaux
+        end do
+      end do
+    endif
+
+  ! Fix: Set W at pole to the zonally averaged W of the next equator-
+  ! ward parallel of latitude
+
+    do iz=1,nz
+      wdummy=0.
+      jy=1
+      do ix=0,nxmin1
+        wdummy=wdummy+ww(ix,jy,iz,n)
+      end do
+      wdummy=wdummy/real(nx)
+      jy=0
+      do ix=0,nxmin1
+        ww(ix,jy,iz,n)=wdummy
+      end do
+    end do
+
+    if (wind_coord_type.eq.'ETA') then
+      do iz=1,nz
+        wdummy=0.
+        jy=1
+        do ix=0,nxmin1
+          wdummy=wdummy+wweta(ix,jy,iz,n)
+        end do
+        wdummy=wdummy/real(nx)
+        jy=0
+        do ix=0,nxmin1
+          wweta(ix,jy,iz,n)=wdummy
+        end do
+      end do
+    endif
+  endif
+end subroutine verttransf_ec_stereo
diff --git a/src/ver_verttransf_ec_windf.f90 b/src/ver_verttransf_ec_windf.f90
new file mode 100644
index 0000000000000000000000000000000000000000..cfc4333e083c5df5ce8c45a590a0844755f9a3c0
--- /dev/null
+++ b/src/ver_verttransf_ec_windf.f90
@@ -0,0 +1,297 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine verttransf_ec_windf(n,uuh,vvh,wwh,pvh,rhoh,prsh,pinmconv)
+  use par_mod
+  use com_mod
+  use qvsat_mod
+
+  implicit none
+
+  integer,intent(in) :: n
+  real,intent(in),dimension(0:nxmax-1,0:nymax-1,nuvzmax) :: uuh,vvh,pvh
+  real,intent(in),dimension(0:nxmax-1,0:nymax-1,nwzmax) :: wwh
+  real,intent(in),dimension(0:nxmax-1,0:nymax-1,nuvzmax) :: rhoh
+  real,intent(in),dimension(0:nxmax-1,0:nymax-1,nzmax) :: pinmconv
+  ! RLT added pressure
+  real,intent(in),dimension(0:nxmax-1,0:nymax-1,nuvzmax) :: prsh
+
+  !real,dimension(0:nxmax-1,0:nymax-1) ::  dpdeta
+
+  real,dimension(0:nymax-1) :: cosf
+
+  integer,dimension(0:nxmax-1,0:nymax-1) :: idx
+
+  integer :: ix,jy,kz,iz,kmin,ixp,jyp,ix1,jy1
+  real :: dz1,dz2,dz,dpdeta
+  real :: xlon,ylat,xlonr,dzdx,dzdy
+  real :: dzdx1,dzdx2,dzdy1,dzdy2
+
+  ! Levels, where u,v,t and q are given
+  !************************************
+!$OMP PARALLEL PRIVATE(jy,ix,kz,dz1,dz2,dz,ix1,jy1,ixp,jyp,dzdx1,dzdx2,dzdx, &
+!$OMP   dzdy1,dzdy2,dzdy,dpdeta)
+
+!$OMP DO
+  do jy=0,nymin1
+    do ix=0,nxmin1
+
+      uu(ix,jy,1,n)=uuh(ix,jy,1)
+      uu(ix,jy,nz,n)=uuh(ix,jy,nuvz)
+      vv(ix,jy,1,n)=vvh(ix,jy,1)
+      vv(ix,jy,nz,n)=vvh(ix,jy,nuvz)
+      tt(ix,jy,1,n)=tth(ix,jy,1,n)
+      tt(ix,jy,nz,n)=tth(ix,jy,nuvz,n)
+      pv(ix,jy,1,n)=pvh(ix,jy,1)
+      pv(ix,jy,nz,n)=pvh(ix,jy,nuvz)
+      if  (wind_coord_type.ne.'ETA') then
+        qv(ix,jy,1,n)=qvh(ix,jy,1,n)
+        qv(ix,jy,nz,n)=qvh(ix,jy,nuvz,n)
+        !hg adding the cloud water
+        if (readclouds) then
+          clwc(ix,jy,1,n)=clwch(ix,jy,1,n)
+          clwc(ix,jy,nz,n)=clwch(ix,jy,nuvz,n)
+          if (.not.sumclouds) then
+            ciwc(ix,jy,1,n)=ciwch(ix,jy,1,n)
+            ciwc(ix,jy,nz,n)=ciwch(ix,jy,nuvz,n)
+          endif
+        end if
+        !hg
+      endif
+      rho(ix,jy,1,n)=rhoh(ix,jy,1)
+      rho(ix,jy,nz,n)=rhoh(ix,jy,nuvz)
+      ! RLT add pressure
+      prs(ix,jy,1,n)=prsh(ix,jy,1)
+      prs(ix,jy,nz,n)=prsh(ix,jy,nuvz)
+      ! RLT
+
+      idx(ix,jy)=2
+    end do
+  end do
+!$OMP END DO
+
+  do iz=2,nz-1
+!$OMP DO SCHEDULE(dynamic)
+    do jy=0,nymin1
+      do ix=0,nxmin1
+        if(height(iz).gt.etauvheight(ix,jy,nuvz,n)) then
+          uu(ix,jy,iz,n)=uu(ix,jy,nz,n)
+          vv(ix,jy,iz,n)=vv(ix,jy,nz,n)
+          tt(ix,jy,iz,n)=tt(ix,jy,nz,n)
+          pv(ix,jy,iz,n)=pv(ix,jy,nz,n)
+          if  (wind_coord_type.ne.'ETA') then
+            qv(ix,jy,iz,n)=qv(ix,jy,nz,n)
+            !hg adding the cloud water
+            if (readclouds) then
+              clwc(ix,jy,iz,n)=clwc(ix,jy,nz,n)
+              if (.not.sumclouds) ciwc(ix,jy,iz,n)=ciwc(ix,jy,nz,n)
+            end if
+          endif
+          rho(ix,jy,iz,n)=rho(ix,jy,nz,n)
+          prs(ix,jy,iz,n)=prs(ix,jy,nz,n)   ! RLT
+        else
+          innuvz: do kz=idx(ix,jy),nuvz
+            if ( idx(ix,jy).le.kz .and. &
+              height(iz).gt.etauvheight(ix,jy,kz-1,n) .and. &
+              height(iz).le.etauvheight(ix,jy,kz,n) ) then
+              idx(ix,jy)=kz
+              exit innuvz
+            endif
+          enddo innuvz
+        endif
+
+        if (height(iz).le.etauvheight(ix,jy,nuvz,n)) then
+          kz=idx(ix,jy)
+          dz1=height(iz)-etauvheight(ix,jy,kz-1,n)
+          dz2=etauvheight(ix,jy,kz,n)-height(iz)
+          dz=dz1+dz2
+          uu(ix,jy,iz,n)=(uuh(ix,jy,kz-1)*dz2+uuh(ix,jy,kz)*dz1)/dz
+          vv(ix,jy,iz,n)=(vvh(ix,jy,kz-1)*dz2+vvh(ix,jy,kz)*dz1)/dz
+          tt(ix,jy,iz,n)=(tth(ix,jy,kz-1,n)*dz2 &
+               +tth(ix,jy,kz,n)*dz1)/dz
+          pv(ix,jy,iz,n)=(pvh(ix,jy,kz-1)*dz2+pvh(ix,jy,kz)*dz1)/dz
+          if  (wind_coord_type.ne.'ETA') then
+            qv(ix,jy,iz,n)=(qvh(ix,jy,kz-1,n)*dz2+qvh(ix,jy,kz,n)*dz1)/dz
+    !hg adding the cloud water
+            if  (readclouds) then
+              clwc(ix,jy,iz,n)= &
+                (clwch(ix,jy,kz-1,n)*dz2+clwch(ix,jy,kz,n)*dz1)/dz
+              if (.not.sumclouds) ciwc(ix,jy,iz,n)= &
+                (ciwch(ix,jy,kz-1,n)*dz2+ciwch(ix,jy,kz,n)*dz1)/dz
+            end if
+    !hg
+          endif
+          rho(ix,jy,iz,n)=(rhoh(ix,jy,kz-1)*dz2+rhoh(ix,jy,kz)*dz1)/dz
+  ! RLT add pressure
+          prs(ix,jy,iz,n)=(prsh(ix,jy,kz-1)*dz2+prsh(ix,jy,kz)*dz1)/dz
+        endif
+      enddo
+    enddo
+!$OMP END DO
+!$OMP BARRIER
+  enddo
+  ! Levels, where w is given
+  !*************************
+
+!$OMP DO
+  do jy=0,nymin1
+    do ix=0,nxmin1
+      idx(ix,jy)=2
+      ww(ix,jy,1,n)=wwh(ix,jy,1)*pinmconv(ix,jy,1)
+      ww(ix,jy,nz,n)=wwh(ix,jy,nwz)*pinmconv(ix,jy,nz)
+    end do
+  end do
+!$OMP END DO
+
+  do iz=2,nz-1
+!$OMP DO SCHEDULE(dynamic)
+    do jy=0,nymin1
+      do ix=0,nxmin1
+
+        inn: do kz=idx(ix,jy),nwz
+          if (idx(ix,jy).le.kz .and. height(iz).gt.etawheight(ix,jy,kz-1,n) &
+            .and. height(iz).le.etawheight(ix,jy,kz,n)) then
+            idx(ix,jy)=kz
+            exit inn
+          endif
+        enddo inn
+
+        kz=idx(ix,jy)
+        dz1=height(iz)-etawheight(ix,jy,kz-1,n)
+        dz2=etawheight(ix,jy,kz,n)-height(iz)
+        dz=dz1+dz2
+        ww(ix,jy,iz,n)=(wwh(ix,jy,kz-1)*pinmconv(ix,jy,kz-1)*dz2 &
+             +wwh(ix,jy,kz)*pinmconv(ix,jy,kz)*dz1)/dz
+        ! Compute density gradients at intermediate levels
+        !*************************************************
+        drhodz(ix,jy,iz,n)=(rho(ix,jy,iz+1,n)-rho(ix,jy,iz-1,n))/ &
+          (height(iz+1)-height(iz-1))
+      end do
+    end do
+!$OMP END DO
+!$OMP BARRIER
+  end do
+
+!$OMP DO
+  do jy=0,nymin1
+    do ix=0,nxmin1
+      drhodz(ix,jy,nz,n)=drhodz(ix,jy,nz-1,n)
+      drhodz(ix,jy,1,n)=(rho(ix,jy,2,n)-rho(ix,jy,1,n))/(height(2)-height(1))
+    end do
+  end do
+!$OMP END DO NOWAIT
+
+  !****************************************************************
+  ! Compute slope of eta levels in windward direction and resulting
+  ! vertical wind correction
+  !****************************************************************
+
+!$OMP DO
+  do jy=1,ny-2
+    cosf(jy)=1./cos((real(jy)*dy+ylat0)*pi180)
+    do ix=1,nx-2
+      idx(ix,jy)=2
+    end do
+  end do
+!$OMP END DO
+
+  do iz=2,nz-1
+!$OMP DO SCHEDULE(dynamic)
+    do jy=1,ny-2
+      do ix=1,nx-2
+        ! For gridpoint (ix,jy) and height (iz), this loop finds the first eta
+        ! level encompassing the height(iz) level and saves it in idx(ix,jy)
+        inneta: do kz=idx(ix,jy),nz
+          if (idx(ix,jy) .le. kz .and. height(iz).gt.etauvheight(ix,jy,kz-1,n) &
+            .and. height(iz).le.etauvheight(ix,jy,kz,n)) then
+            idx(ix,jy)=kz
+            exit inneta
+          endif
+        enddo inneta
+
+        kz=idx(ix,jy)
+        dz1=height(iz)-etauvheight(ix,jy,kz-1,n)
+        dz2=etauvheight(ix,jy,kz,n)-height(iz)
+        dz=dz1+dz2
+        ix1=ix-1
+        jy1=jy-1
+        ixp=ix+1
+        jyp=jy+1
+
+        dzdx1=(etauvheight(ixp,jy,kz-1,n)-etauvheight(ix1,jy,kz-1,n))/2.
+        dzdx2=(etauvheight(ixp,jy,kz,n)-etauvheight(ix1,jy,kz,n))/2.
+        dzdx=(dzdx1*dz2+dzdx2*dz1)/dz
+
+        dzdy1=(etauvheight(ix,jyp,kz-1,n)-etauvheight(ix,jy1,kz-1,n))/2.
+        dzdy2=(etauvheight(ix,jyp,kz,n)-etauvheight(ix,jy1,kz,n))/2.
+        dzdy=(dzdy1*dz2+dzdy2*dz1)/dz
+
+        ww(ix,jy,iz,n) = ww(ix,jy,iz,n) + dzdx*uu(ix,jy,iz,n)*dxconst*cosf(jy) &
+                                        + dzdy*vv(ix,jy,iz,n)*dyconst
+      end do
+    end do
+!$OMP END DO
+!$OMP BARRIER
+  end do
+
+  ! Keep original fields if wind_coord_type==ETA
+  if (wind_coord_type.eq.'ETA') then
+!$OMP DO
+
+    do kz=1,nz
+      do jy=0,nymin1
+        do ix=0,nxmin1
+          uueta(ix,jy,kz,n) = uuh(ix,jy,kz)
+          vveta(ix,jy,kz,n) = vvh(ix,jy,kz)
+          tteta(ix,jy,kz,n) = tth(ix,jy,kz,n)
+          qv(ix,jy,kz,n)    = qvh(ix,jy,kz,n)
+          pveta(ix,jy,kz,n) = pvh(ix,jy,kz)
+          rhoeta(ix,jy,kz,n) = rhoh(ix,jy,kz)
+          prseta(ix,jy,kz,n) = prsh(ix,jy,kz)
+          ! tvirtual(ix,jy,kz,n)=tteta(ix,jy,kz,n)* &
+          !   ((qv(ix,jy,kz,n)+0.622)/(0.622*qv(ix,jy,kz,n)+0.622))
+          ! eq A11 from Mid-latitude atmospheric dynamics by Jonathan E. Martin
+          if ((kz.gt.1).and.(kz.lt.nz)) drhodzeta(ix,jy,kz,n)= &
+               (rhoh(ix,jy,kz+1)-rhoh(ix,jy,kz-1))/ &
+               (height(kz+1)-height(kz-1))
+               ! Note that this is still in SI units and not in eta
+          if (readclouds) then
+            clwc(ix,jy,kz,n)=clwch(ix,jy,kz,n)
+            if (.not. sumclouds) ciwc(ix,jy,kz,n)=ciwch(ix,jy,kz,n)
+          endif
+        end do
+      end do
+    end do
+!$OMP END DO NOWAIT
+
+!$OMP DO
+    do jy=0,nymin1
+      do ix=0,nxmin1
+        drhodzeta(ix,jy,1,n)=(rhoh(ix,jy,2)-rhoh(ix,jy,1))/(height(2)-height(1))
+        drhodzeta(ix,jy,nz,n)=drhodzeta(ix,jy,nz-1,n)
+        ! tvirtual(ix,jy,1,n)=tt2(ix,jy,1,n)* &
+        !   (1.+0.378*ew(td2(ix,jy,1,n),ps(ix,jy,1,n))/ps(ix,jy,1,n))
+        ! Convert w from Pa/s to eta/s, following FLEXTRA
+        !************************************************
+        do kz=1,nuvz-1
+          if (kz.eq.1) then
+            dpdeta=(akm(kz+1)-akm(kz)+(bkm(kz+1)-bkm(kz))*ps(ix,jy,1,n))/ &
+              (wheight(kz+1)-wheight(kz))
+          else if (kz.eq.nuvz-1) then
+            dpdeta=(akm(kz)-akm(kz-1)+(bkm(kz)-bkm(kz-1))*ps(ix,jy,1,n))/ &
+              (wheight(kz)-wheight(kz-1))
+          else
+            dpdeta=(akm(kz+1)-akm(kz-1)+(bkm(kz+1)-bkm(kz-1))*ps(ix,jy,1,n))/ &
+              (wheight(kz+1)-wheight(kz-1))
+          endif
+          wweta(ix,jy,kz,n)=wwh(ix,jy,kz)/dpdeta
+        end do
+        wweta(ix,jy,nuvz,n)=wweta(ix,jy,nuvz-1,n)
+         ! What is the appropriate value for the top level???
+      end do
+    end do
+!$OMP END DO
+  endif
+!$OMP END PARALLEL
+
+end subroutine verttransf_ec_windf
diff --git a/src/ver_verttransf_ec_windf_nest.f90 b/src/ver_verttransf_ec_windf_nest.f90
new file mode 100644
index 0000000000000000000000000000000000000000..33ade8b75e7a276f2b87310b8537244182f67b68
--- /dev/null
+++ b/src/ver_verttransf_ec_windf_nest.f90
@@ -0,0 +1,304 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine verttransf_ec_windf_nest(l,n, &
+
+  uuhn,vvhn,wwhn,pvhn,rhohn,prshn,pinmconv)
+  use par_mod
+  use com_mod
+  use qvsat_mod
+
+  implicit none
+
+  integer,intent(in) :: l,n
+  real,intent(in),dimension(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests) :: &
+    uuhn,vvhn,pvhn
+  real,intent(in),dimension(0:nxmaxn-1,0:nymaxn-1,nwzmax,maxnests) :: wwhn
+  real,intent(in),dimension(0:nxmaxn-1,0:nymaxn-1,nuvzmax) :: rhohn
+  real,intent(in),dimension(0:nxmaxn-1,0:nymaxn-1,nuvzmax) :: prshn
+  real,intent(in),dimension(0:nxmaxn-1,0:nymaxn-1,nzmax) :: pinmconv
+  real,dimension(0:nymaxn-1) :: cosf
+
+  integer,dimension(0:nxmaxn-1,0:nymaxn-1) :: rain_cloud_above, idx
+
+  integer :: ix,jy,kz,iz,kmin,kl,klp,ix1,jy1,ixp,jyp,kz_inv
+  real :: pressure,rh,lsp,convp,cloudh_min,prec
+
+  real :: dz1,dz2,dz,dpdeta
+  real :: dzdx,dzdy
+  real :: dzdx1,dzdx2,dzdy1,dzdy2
+  real :: tot_cloud_h
+  integer :: nxm1, nym1
+
+  nxm1=nxn(l)-1
+  nym1=nyn(l)-1
+
+  ! Levels, where u,v,t and q are given
+  !************************************
+!$OMP PARALLEL PRIVATE(jy,ix,kz,dz1,dz2,dz,ix1,jy1,ixp,jyp,dzdx1,dzdx2,dzdx, &
+!$OMP   dzdy1,dzdy2,dzdy,dpdeta)
+
+!$OMP DO
+  do jy=0,nym1
+    do ix=0,nxm1
+      uun(ix,jy,1,n,l)=uuhn(ix,jy,1,l)
+      vvn(ix,jy,1,n,l)=vvhn(ix,jy,1,l)
+      ttn(ix,jy,1,n,l)=tthn(ix,jy,1,n,l)
+      if (wind_coord_type.ne.'ETA') then
+        qvn(ix,jy,1,n,l)=qvhn(ix,jy,1,n,l)
+      endif
+      if (readclouds_nest(l)) then
+        clwcn(ix,jy,1,n,l)=clwchn(ix,jy,1,n,l)
+        if (.not.sumclouds_nest(l)) ciwcn(ix,jy,1,n,l)=ciwchn(ix,jy,1,n,l)
+      end if
+      pvn(ix,jy,1,n,l)=pvhn(ix,jy,1,l)
+      rhon(ix,jy,1,n,l)=rhohn(ix,jy,1)
+      prsn(ix,jy,1,n,l)=prshn(ix,jy,1)
+
+      uun(ix,jy,nz,n,l)=uuhn(ix,jy,nuvz,l)
+      vvn(ix,jy,nz,n,l)=vvhn(ix,jy,nuvz,l)
+      ttn(ix,jy,nz,n,l)=tthn(ix,jy,nuvz,n,l)
+      if (wind_coord_type.ne.'ETA') then
+        qvn(ix,jy,nz,n,l)=qvhn(ix,jy,nuvz,n,l)
+        if (readclouds_nest(l)) then
+          clwcn(ix,jy,nz,n,l)=clwchn(ix,jy,nuvz,n,l)
+          if (.not.sumclouds_nest(l)) ciwcn(ix,jy,nz,n,l)=ciwchn(ix,jy,nuvz,n,l)
+        endif
+      endif
+      pvn(ix,jy,nz,n,l)=pvhn(ix,jy,nuvz,l)
+      rhon(ix,jy,nz,n,l)=rhohn(ix,jy,nuvz)
+      prsn(ix,jy,nz,n,l)=prshn(ix,jy,nuvz)
+
+      idx(ix,jy)=2
+    end do
+  end do
+!$OMP END DO
+
+  do iz=2,nz-1
+!$OMP DO SCHEDULE(dynamic)
+    do jy=0,nym1
+      do ix=0,nxm1
+        if(height(iz).gt.etauvheightn(ix,jy,nuvz,n,l)) then
+          uun(ix,jy,iz,n,l)=uun(ix,jy,nz,n,l)
+          vvn(ix,jy,iz,n,l)=vvn(ix,jy,nz,n,l)
+          ttn(ix,jy,iz,n,l)=ttn(ix,jy,nz,n,l)
+          pvn(ix,jy,iz,n,l)=pvn(ix,jy,nz,n,l)
+          if (wind_coord_type.ne.'ETA') then
+            qvn(ix,jy,iz,n,l)=qvn(ix,jy,nz,n,l)
+            !hg adding the cloud water
+            if (readclouds_nest(l)) then
+              clwcn(ix,jy,iz,n,l)=clwcn(ix,jy,nz,n,l)
+              if (.not.sumclouds_nest(l)) &
+                ciwcn(ix,jy,iz,n,l)=ciwcn(ix,jy,nz,n,l)
+            endif
+          endif
+          rhon(ix,jy,iz,n,l)=rhon(ix,jy,nz,n,l)
+          prsn(ix,jy,iz,n,l)=prsn(ix,jy,nz,n,l)
+        else
+          innuvz: do kz=idx(ix,jy),nuvz
+            if (idx(ix,jy) .le. kz .and. &
+              height(iz).gt.etauvheightn(ix,jy,kz-1,n,l) .and. &
+              height(iz).le.etauvheightn(ix,jy,kz,n,l) ) then
+              idx(ix,jy)=kz
+              exit innuvz
+            endif
+          enddo innuvz
+        endif
+
+        if(height(iz).le.etauvheightn(ix,jy,nuvz,n,l)) then
+          kz=idx(ix,jy)
+          dz1=height(iz)-etauvheightn(ix,jy,kz-1,n,l)
+          dz2=etauvheightn(ix,jy,kz,n,l)-height(iz)
+          dz=dz1+dz2
+          uun(ix,jy,iz,n,l)=(uuhn(ix,jy,kz-1,l)*dz2+uuhn(ix,jy,kz,l)*dz1)/dz
+          vvn(ix,jy,iz,n,l)=(vvhn(ix,jy,kz-1,l)*dz2+vvhn(ix,jy,kz,l)*dz1)/dz
+          ttn(ix,jy,iz,n,l)=(tthn(ix,jy,kz-1,n,l)*dz2 &
+               +tthn(ix,jy,kz,n,l)*dz1)/dz
+          pvn(ix,jy,iz,n,l)=(pvhn(ix,jy,kz-1,l)*dz2+pvhn(ix,jy,kz,l)*dz1)/dz
+          if (wind_coord_type.ne.'ETA') then
+            qvn(ix,jy,iz,n,l)=(qvhn(ix,jy,kz-1,n,l)*dz2 &
+                 +qvhn(ix,jy,kz,n,l)*dz1)/dz
+            !hg adding the cloud water
+            if (readclouds_nest(l)) then
+              clwcn(ix,jy,iz,n,l)=(clwchn(ix,jy,kz-1,n,l)*dz2 + &
+                clwchn(ix,jy,kz,n,l)*dz1)/dz
+              if (.not.sumclouds_nest(l)) ciwcn(ix,jy,iz,n,l)= &
+                (ciwchn(ix,jy,kz-1,n,l)*dz2+ciwchn(ix,jy,kz,n,l)*dz1)/dz
+            end if
+          endif
+          rhon(ix,jy,iz,n,l)=(rhohn(ix,jy,kz-1)*dz2+rhohn(ix,jy,kz)*dz1)/dz
+          prsn(ix,jy,iz,n,l)=(prshn(ix,jy,kz-1)*dz2+prshn(ix,jy,kz)*dz1)/dz
+        endif
+      enddo
+    enddo
+!$OMP END DO
+!$OMP BARRIER
+  enddo
+
+  ! Levels, where w is given
+  !*************************
+
+!$OMP DO
+  do jy=0,nym1
+    do ix=0,nxm1
+      idx(ix,jy)=2
+      wwn(ix,jy,1,n,l)=wwhn(ix,jy,1,l)*pinmconv(ix,jy,1)
+      wwn(ix,jy,nz,n,l)=wwhn(ix,jy,nwz,l)*pinmconv(ix,jy,nz)
+    end do
+  end do
+!$OMP END DO
+
+  do iz=2,nz-1
+!$OMP DO SCHEDULE(dynamic)
+    do jy=0,nym1
+      do ix=0,nxm1
+
+        inn: do kz=idx(ix,jy),nwz
+          if (idx(ix,jy).le.kz .and. height(iz).gt.etawheightn(ix,jy,kz-1,n,l) &
+                               .and. height(iz).le.etawheightn(ix,jy,kz,  n,l))&
+            then
+            idx(ix,jy)=kz
+            exit inn
+          endif
+        enddo inn
+
+        kz=idx(ix,jy)
+        dz1=height(iz)-etawheightn(ix,jy,kz-1,n,l)
+        dz2=etawheightn(ix,jy,kz,n,l)-height(iz)
+        dz=dz1+dz2
+        wwn(ix,jy,iz,n,l)=(wwhn(ix,jy,kz-1,l)*pinmconv(ix,jy,kz-1)*dz2 &
+             +wwhn(ix,jy,kz,l)*pinmconv(ix,jy,kz)*dz1)/dz
+        drhodzn(ix,jy,iz,n,l)=(rhon(ix,jy,iz+1,n,l)-rhon(ix,jy,iz-1,n,l))/ &
+             (height(iz+1)-height(iz-1))
+      enddo
+    enddo
+!$OMP END DO
+!$OMP BARRIER
+  end do
+
+  ! Compute density gradients at intermediate levels
+  !*************************************************
+!$OMP DO
+  do jy=0,nym1
+    do ix=0,nxm1
+      drhodzn(ix,jy,nz,n,l)=drhodzn(ix,jy,nz-1,n,l)
+      drhodzn(ix,jy,1,n,l)=(rhon(ix,jy,2,n,l)-rhon(ix,jy,1,n,l))/ &
+           (height(2)-height(1))
+    end do
+  end do
+!$OMP END DO NOWAIT
+
+  !****************************************************************
+  ! Compute slope of eta levels in windward direction and resulting
+  ! vertical wind correction
+  !****************************************************************
+
+!$OMP DO
+  do jy=1,nyn(l)-2
+    cosf(jy)=1./cos((real(jy)*dyn(l)+ylat0n(l))*pi180)
+    do ix=1,nxn(l)-2
+      idx(ix,jy)=2
+    end do
+  end do
+!$OMP END DO
+
+  do iz=2,nz-1
+!$OMP DO SCHEDULE(dynamic)
+    do jy=1,nyn(l)-2
+      do ix=1,nxn(l)-2
+
+        inneta: do kz=idx(ix,jy),nz
+          if (idx(ix,jy) .le. kz .and. &
+            height(iz).gt.etauvheightn(ix,jy,kz-1,n,l) .and. &
+            height(iz).le.etauvheightn(ix,jy,kz,  n,l)) then
+            idx(ix,jy)=kz
+            exit inneta
+          endif
+        enddo inneta
+
+        kz=idx(ix,jy)
+        dz1=height(iz)-etauvheightn(ix,jy,kz-1,n,l)
+        dz2=etauvheightn(ix,jy,kz,n,l)-height(iz)
+        dz=dz1+dz2
+        ix1=ix-1
+        jy1=jy-1
+        ixp=ix+1
+        jyp=jy+1
+
+        dzdx1=(etauvheightn(ixp,jy,kz-1,n,l)-etauvheightn(ix1,jy,kz-1,n,l))/2.
+        dzdx2=(etauvheightn(ixp,jy,kz,n,l)-etauvheightn(ix1,jy,kz,n,l))/2.
+        dzdx=(dzdx1*dz2+dzdx2*dz1)/dz
+
+        dzdy1=(etauvheightn(ix,jyp,kz-1,n,l)-etauvheightn(ix,jy1,kz-1,n,l))/2.
+        dzdy2=(etauvheightn(ix,jyp,kz,n,l)-etauvheightn(ix,jy1,kz,n,l))/2.
+        dzdy=(dzdy1*dz2+dzdy2*dz1)/dz
+
+        wwn(ix,jy,iz,n,l)=wwn(ix,jy,iz,n,l) + &
+          (dzdx*uun(ix,jy,iz,n,l)*dxconst*xresoln(l)*cosf(jy) + &
+           dzdy*vvn(ix,jy,iz,n,l)*dyconst*yresoln(l))
+
+      end do
+    end do
+!$OMP END DO
+!$OMP BARRIER
+  end do
+
+  ! Keep original fields if wind_coord_type==ETA
+  if (wind_coord_type.eq.'ETA') then
+!$OMP DO
+
+    do kz=1,nz
+      do jy=0,nym1
+        do ix=0,nxm1
+          uuetan(ix,jy,kz,n,l) = uuhn(ix,jy,kz,l)
+          vvetan(ix,jy,kz,n,l) = vvhn(ix,jy,kz,l)
+          ttetan(ix,jy,kz,n,l) = tthn(ix,jy,kz,n,l)
+          qvn(ix,jy,kz,n,l) = qvhn(ix,jy,kz,n,l)
+          pvetan(ix,jy,kz,n,l) = pvhn(ix,jy,kz,l)
+          rhoetan(ix,jy,kz,n,l) = rhohn(ix,jy,kz)
+          prsetan(ix,jy,kz,n,l) = prshn(ix,jy,kz)
+          ! tvirtualn(ix,jy,kz,n,l)=ttetan(ix,jy,kz,n,l)* &
+          !   ((qvn(ix,jy,kz,n,l)+0.622)/(0.622*qvn(ix,jy,kz,n,l)+0.622))
+          ! eq A11 from Mid-latitude atmospheric dynamics by Jonathan E. Martin
+          if ((kz.gt.1).and.(kz.lt.nz)) drhodzetan(ix,jy,kz,n,l)= &
+            (rhohn(ix,jy,kz+1)-rhohn(ix,jy,kz-1))/(height(kz+1)-height(kz-1))
+          if (readclouds) then
+            clwcn(ix,jy,kz,n,l)=clwchn(ix,jy,kz,n,l)
+            if (.not.sumclouds_nest(l)) ciwcn(ix,jy,kz,n,l)=ciwchn(ix,jy,kz,n,l)
+          endif
+        end do
+      end do
+    end do
+!$OMP END DO NOWAIT
+
+!$OMP DO
+    do jy=0,nym1
+      do ix=0,nxm1
+        drhodzetan(ix,jy,1,n,l)=(rhoetan(ix,jy,2,n,l)-rhoetan(ix,jy,1,n,l))/ &
+             (height(2)-height(1))
+        drhodzetan(ix,jy,nz,n,l)=drhodzetan(ix,jy,nz-1,n,l)
+        ! tvirtualn(ix,jy,1,n,l)=tt2n(ix,jy,1,n,l)* &
+        !   (1.+0.378*ew(td2n(ix,jy,1,n,l),psn(ix,jy,1,n,l))/ps(ix,jy,1,n,l))
+        ! Convert w from Pa/s to eta/s, following FLEXTRA
+        !************************************************
+        do kz=1,nuvz-1
+          if (kz.eq.1) then
+            dpdeta=(akm(kz+1)-akm(kz)+(bkm(kz+1)-bkm(kz))*ps(ix,jy,1,n))/ &
+              (wheight(kz+1)-wheight(kz))
+          else if (kz.eq.nuvz-1) then
+            dpdeta=(akm(kz)-akm(kz-1)+(bkm(kz)-bkm(kz-1))*ps(ix,jy,1,n))/ &
+              (wheight(kz)-wheight(kz-1))
+          else
+            dpdeta=(akm(kz+1)-akm(kz-1)+(bkm(kz+1)-bkm(kz-1))*ps(ix,jy,1,n))/ &
+              (wheight(kz+1)-wheight(kz-1))
+          endif
+          wwetan(ix,jy,kz,n,l)=wwhn(ix,jy,kz,l)/dpdeta
+        end do
+        wwetan(ix,jy,nuvz,n,l)=wwetan(ix,jy,nuvz-1,n,l)
+      end do
+    end do
+!$OMP END DO
+  endif
+!$OMP END PARALLEL
+
+end subroutine verttransf_ec_windf_nest
diff --git a/src/ver_verttransform_ecmwf.f90 b/src/ver_verttransform_ecmwf.f90
new file mode 100644
index 0000000000000000000000000000000000000000..08dfad1b2b2ffddfd2d86bbca66c5b2991d082e3
--- /dev/null
+++ b/src/ver_verttransform_ecmwf.f90
@@ -0,0 +1,127 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine verttransform_ecmwf(n,uuh,vvh,wwh,pvh)
+  !                              i  i   i   i   i
+  !*****************************************************************************
+  !                                                                            *
+  !     This subroutine transforms temperature, dew point temperature and      *
+  !     wind components from eta to meter coordinates.                         *
+  !     The vertical wind component is transformed from Pa/s to m/s using      *
+  !     the conversion factor pinmconv.                                        *
+  !     In addition, this routine calculates vertical density gradients        *
+  !     needed for the parameterization of the turbulent velocities.           *
+  !                                                                            *
+  !     Author: A. Stohl, G. Wotawa                                            *
+  !                                                                            *
+  !     12 August 1996                                                         *
+  !     Update: 16 January 1998                                                *
+  !                                                                            *
+  !     Major update: 17 February 1999                                         *
+  !     by G. Wotawa                                                           *
+  !                                                                            *
+  !     - Vertical levels for u, v and w are put together                      *
+  !     - Slope correction for vertical velocity: Modification of calculation  *
+  !       procedure                                                            *
+  !                                                                            *
+  !*****************************************************************************
+  !  Changes, Bernd C. Krueger, Feb. 2001:
+  !   Variables tth and qvh (on eta coordinates) from common block
+  !
+  ! Sabine Eckhardt, March 2007
+  ! added the variable cloud for use with scavenging - descr. in com_mod
+  !
+  ! Unified ECMWF and GFS builds
+  ! Marian Harustak, 12.5.2017
+  !     - Renamed from verttransform to verttransform_ecmwf
+  !
+  ! Date: 2017-05-30 modification of a bug in ew. Don Morton (CTBTO project)   *
+  !                                                                            *
+  ! Lucie Bakels, 2022                                                         *
+  !    - Separated the code into subroutines                                   *
+  !    - In case of wind_coord_type='ETA': keep ECMWF vertical winds in eta    *
+  !      coordinates                                                           *
+  !    - OpenMP parallelisation                                                *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! nx,ny,nz                        field dimensions in x,y and z direction    *
+  ! clouds(0:nxmax,0:nymax,0:nzmax,numwfmem) cloud field for wet deposition    *
+  ! uu(0:nxmax,0:nymax,nzmax,numwfmem)     wind components in x-direction [m/s]*
+  ! vv(0:nxmax,0:nymax,nzmax,numwfmem)     wind components in y-direction [m/s]*
+  ! ww(0:nxmax,0:nymax,nzmax,numwfmem)     wind components in z-direction      *
+  !                                          [deltaeta/s]                      *
+  ! tt(0:nxmax,0:nymax,nzmax,numwfmem)     temperature [K]                     *
+  ! pv(0:nxmax,0:nymax,nzmax,numwfmem)     potential voriticity (pvu)          *
+  ! ps(0:nxmax,0:nymax,numwfmem)           surface pressure [Pa]               *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+  use cmapf_mod, only: cc2gll
+  use qvsat_mod
+
+  implicit none
+
+  integer, intent(in) :: n
+  real,intent(in),dimension(0:nxmax-1,0:nymax-1,nuvzmax) :: uuh,vvh,pvh
+  real,intent(in),dimension(0:nxmax-1,0:nymax-1,nwzmax) :: wwh
+
+  real,dimension(0:nxmax-1,0:nymax-1,nuvzmax) :: rhoh
+  real,dimension(0:nxmax-1,0:nymax-1,nzmax) :: pinmconv
+  ! RLT added pressure
+  real,dimension(0:nxmax-1,0:nymax-1,nuvzmax) :: prsh
+
+  logical :: init = .true.
+
+  !*************************************************************************
+  ! If verttransform is called the first time, initialize heights of the   *
+  ! z levels in meter. The heights are the heights of model levels, where  *
+  ! u,v,T and qv are given, and of the interfaces, where w is given. So,   *
+  ! the vertical resolution in the z system is doubled. As reference point,*
+  ! the lower left corner of the grid is used.                             *
+  ! Unlike in the eta system, no difference between heights for u,v and    *
+  ! heights for w exists.                                                  *
+  !*************************************************************************
+
+
+  !eso measure CPU time
+  !  call mpif_mtime('verttransform',0)
+
+  if (init) then
+
+  ! Search for a point with high surface pressure (i.e. not above significant topography)
+  ! Then, use this point to construct a reference z profile, to be used at all times
+  !*****************************************************************************
+    call vertransf_init(n)
+
+  ! Do not repeat initialization of the Cartesian z grid
+  !*****************************************************
+
+    init=.false.
+  endif
+
+
+  ! Compute heights of eta levels and their respective pressure and density fields
+  !*******************************************************************************
+  call verttransf_ec_height(nxmax-1,nymax-1,tt2(:,:,1,n),td2(:,:,1,n), &
+    ps(:,:,1,n),qvh(:,:,:,n),tth(:,:,:,n),prsh,rhoh,pinmconv, &
+    etauvheight(:,:,:,n),etawheight(:,:,:,n))
+
+  ! Transform the wind fields to the internal coordinate system and save the native ETA
+  ! fields when case wind_coord_type==ETA
+  !*************************************************************
+  call verttransf_ec_windf(n,uuh,vvh,wwh,pvh,rhoh,prsh,pinmconv)
+
+  ! If north or south pole is in the domain, calculate wind velocities in polar
+  ! stereographic coordinates
+  !*******************************************************************
+  call verttransf_ec_stereo(n)
+
+  ! Create cloud fields
+  !*********************
+  call verttransf_ec_cloud(n,readclouds,sumclouds,nxmin1,nymin1,clouds(:,:,:,n), &
+    cloudsh(:,:,n),clw(:,:,:,n),ctwc(:,:,n),clwc(:,:,:,n),ciwc(:,:,:,n),lsprec(:,:,1,n), &
+    convprec(:,:,1,n),rho(:,:,:,n),tt(:,:,:,n),qv(:,:,:,n),etauvheight(:,:,:,n))
+end subroutine verttransform_ecmwf
diff --git a/src/ver_verttransform_gfs.f90 b/src/ver_verttransform_gfs.f90
new file mode 100644
index 0000000000000000000000000000000000000000..8cf1eafdc4b49fbe5f9bf7e17604e6e8b68e5f9f
--- /dev/null
+++ b/src/ver_verttransform_gfs.f90
@@ -0,0 +1,556 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine verttransform_gfs(n,uuh,vvh,wwh,pvh)
+  !                      i  i   i   i   i
+
+  !*****************************************************************************
+  !                                                                            *
+  !     This subroutine transforms temperature, dew point temperature and      *
+  !     wind components from eta to meter coordinates.                         *
+  !     The vertical wind component is transformed from Pa/s to m/s using      *
+  !     the conversion factor pinmconv.                                        *
+  !     In addition, this routine calculates vertical density gradients        *
+  !     needed for the parameterization of the turbulent velocities.           *
+  !                                                                            *
+  !     Author: A. Stohl, G. Wotawa                                            *
+  !                                                                            *
+  !     12 August 1996                                                         *
+  !     Update: 16 January 1998                                                *
+  !                                                                            *
+  !     Major update: 17 February 1999                                         *
+  !     by G. Wotawa                                                           *
+  !     CHANGE 17/11/2005 Caroline Forster, NCEP GFS version                   *
+  !                                                                            *
+  !   - Vertical levels for u, v and w are put together                        *
+  !   - Slope correction for vertical velocity: Modification of calculation    *
+  !     procedure                                                              *
+  !                                                                            *
+  !*****************************************************************************
+  !  Changes, Bernd C. Krueger, Feb. 2001:
+  !   Variables tth and qvh (on eta coordinates) from common block
+  !
+  !   Unified ECMWF and GFS builds
+  !   Marian Harustak, 12.5.2017
+  !     - Renamed routine from verttransform to verttransform_gfs
+  !
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! nx,ny,nz                        field dimensions in x,y and z direction    *
+  ! uu(0:nxmax,0:nymax,nzmax,2)     wind components in x-direction [m/s]       *
+  ! vv(0:nxmax,0:nymax,nzmax,2)     wind components in y-direction [m/s]       *
+  ! ww(0:nxmax,0:nymax,nzmax,2)     wind components in z-direction [deltaeta/s]*
+  ! tt(0:nxmax,0:nymax,nzmax,2)     temperature [K]                            *
+  ! pv(0:nxmax,0:nymax,nzmax,2)     potential voriticity (pvu)                 *
+  ! ps(0:nxmax,0:nymax,2)           surface pressure [Pa]                      *
+  ! clouds(0:nxmax,0:nymax,0:nzmax,2) cloud field for wet deposition           *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+  use cmapf_mod
+  use qvsat_mod
+
+  implicit none
+
+  integer :: ix,jy,kz,iz,n,kmin,kl,klp,ix1,jy1,ixp,jyp,ixm,jym
+  integer :: rain_cloud_above,kz_inv
+  real :: pressure
+  real :: rh,lsp,cloudh_min,convp,prec
+  real :: rhoh(nuvzmax),pinmconv(nzmax)
+  real :: pint,tv,tvold,pold,dz1,dz2,dz,ui,vi
+  real :: xlon,ylat,xlonr,dzdx,dzdy
+  real :: dzdx1,dzdx2,dzdy1,dzdy2,cosf
+  real :: uuaux,vvaux,uupolaux,vvpolaux,ddpol,ffpol,wdummy
+  real :: uuh(0:nxmax-1,0:nymax-1,nuvzmax)
+  real :: vvh(0:nxmax-1,0:nymax-1,nuvzmax)
+  real :: pvh(0:nxmax-1,0:nymax-1,nuvzmax)
+  real :: wwh(0:nxmax-1,0:nymax-1,nwzmax)
+  real :: wzlev(nwzmax),uvwzlev(0:nxmax-1,0:nymax-1,nzmax)
+  real,parameter :: const=r_air/ga
+
+  ! NCEP version
+  integer :: llev, i
+
+  logical :: init = .true.
+
+
+  !*************************************************************************
+  ! If verttransform is called the first time, initialize heights of the   *
+  ! z levels in meter. The heights are the heights of model levels, where  *
+  ! u,v,T and qv are given.                                                *
+  !*************************************************************************
+
+  if (init) then
+
+  ! Search for a point with high surface pressure (i.e. not above significant topography)
+  ! Then, use this point to construct a reference z profile, to be used at all times
+  !*****************************************************************************
+    call vertransf_init(n)
+
+  ! Do not repeat initialization of the Cartesian z grid
+  !*****************************************************
+
+    init=.false.
+
+  endif
+
+
+  ! Loop over the whole grid
+  !*************************
+
+  do jy=0,nymin1
+    do ix=0,nxmin1
+
+  ! NCEP version: find first level above ground
+      llev = 0
+      do i=1,nuvz
+        if (ps(ix,jy,1,n).lt.akz(i)) llev=i
+      end do
+       llev = llev+1
+       if (llev.gt.nuvz-2) llev = nuvz-2
+  !     if (llev.eq.nuvz-2) write(*,*) 'verttransform
+  !    +WARNING: LLEV eq NUZV-2'
+  ! NCEP version
+
+
+  ! compute height of pressure levels above ground
+  !***********************************************
+
+      tvold=tth(ix,jy,llev,n)*(1.+0.608*qvh(ix,jy,llev,n))
+      pold=akz(llev)
+      wzlev(llev)=0.
+      uvwzlev(ix,jy,llev)=0.
+      rhoh(llev)=pold/(r_air*tvold)
+
+      do kz=llev+1,nuvz
+        pint=akz(kz)+bkz(kz)*ps(ix,jy,1,n)
+        tv=tth(ix,jy,kz,n)*(1.+0.608*qvh(ix,jy,kz,n))
+        rhoh(kz)=pint/(r_air*tv)
+
+        if (abs(tv-tvold).gt.0.2) then
+          uvwzlev(ix,jy,kz)=uvwzlev(ix,jy,kz-1)+const*log(pold/pint)* &
+          (tv-tvold)/log(tv/tvold)
+        else
+          uvwzlev(ix,jy,kz)=uvwzlev(ix,jy,kz-1)+const*log(pold/pint)*tv
+        endif
+        wzlev(kz)=uvwzlev(ix,jy,kz)
+
+        tvold=tv
+        pold=pint
+      end do
+
+  ! pinmconv=(h2-h1)/(p2-p1)
+
+      pinmconv(llev)=(uvwzlev(ix,jy,llev+1)-uvwzlev(ix,jy,llev))/ &
+           ((aknew(llev+1)+bknew(llev+1)*ps(ix,jy,1,n))- &
+           (aknew(llev)+bknew(llev)*ps(ix,jy,1,n)))
+      do kz=llev+1,nz-1
+        pinmconv(kz)=(uvwzlev(ix,jy,kz+1)-uvwzlev(ix,jy,kz-1))/ &
+             ((aknew(kz+1)+bknew(kz+1)*ps(ix,jy,1,n))- &
+             (aknew(kz-1)+bknew(kz-1)*ps(ix,jy,1,n)))
+      end do
+      pinmconv(nz)=(uvwzlev(ix,jy,nz)-uvwzlev(ix,jy,nz-1))/ &
+           ((aknew(nz)+bknew(nz)*ps(ix,jy,1,n))- &
+           (aknew(nz-1)+bknew(nz-1)*ps(ix,jy,1,n)))
+
+
+  ! Levels, where u,v,t and q are given
+  !************************************
+
+      uu(ix,jy,1,n)=uuh(ix,jy,llev)
+      vv(ix,jy,1,n)=vvh(ix,jy,llev)
+      tt(ix,jy,1,n)=tth(ix,jy,llev,n)
+      qv(ix,jy,1,n)=qvh(ix,jy,llev,n)
+  ! IP & SEC, 201812 add clouds
+      if (readclouds) then
+         clwc(ix,jy,1,n)=clwch(ix,jy,llev,n)
+      endif
+      pv(ix,jy,1,n)=pvh(ix,jy,llev)
+      rho(ix,jy,1,n)=rhoh(llev)
+      pplev(ix,jy,1,n)=akz(llev)
+      uu(ix,jy,nz,n)=uuh(ix,jy,nuvz)
+      vv(ix,jy,nz,n)=vvh(ix,jy,nuvz)
+      tt(ix,jy,nz,n)=tth(ix,jy,nuvz,n)
+      qv(ix,jy,nz,n)=qvh(ix,jy,nuvz,n)
+  ! IP & SEC, 201812 add clouds
+      if (readclouds) then
+         clwc(ix,jy,nz,n)=clwch(ix,jy,nuvz,n)
+      endif
+      pv(ix,jy,nz,n)=pvh(ix,jy,nuvz)
+      rho(ix,jy,nz,n)=rhoh(nuvz)
+      pplev(ix,jy,nz,n)=akz(nuvz)
+      kmin=llev+1
+      do iz=2,nz-1
+        do kz=kmin,nuvz
+          if(height(iz).gt.uvwzlev(ix,jy,nuvz)) then
+            uu(ix,jy,iz,n)=uu(ix,jy,nz,n)
+            vv(ix,jy,iz,n)=vv(ix,jy,nz,n)
+            tt(ix,jy,iz,n)=tt(ix,jy,nz,n)
+            qv(ix,jy,iz,n)=qv(ix,jy,nz,n)
+  ! IP & SEC, 201812 add clouds
+            if (readclouds) then
+               clwc(ix,jy,iz,n)=clwc(ix,jy,nz,n)
+            endif
+            pv(ix,jy,iz,n)=pv(ix,jy,nz,n)
+            rho(ix,jy,iz,n)=rho(ix,jy,nz,n)
+            pplev(ix,jy,iz,n)=pplev(ix,jy,nz,n)
+            exit
+          endif
+          if ((height(iz).gt.uvwzlev(ix,jy,kz-1)).and. &
+          (height(iz).le.uvwzlev(ix,jy,kz))) then
+            dz1=height(iz)-uvwzlev(ix,jy,kz-1)
+            dz2=uvwzlev(ix,jy,kz)-height(iz)
+            dz=dz1+dz2
+            uu(ix,jy,iz,n)=(uuh(ix,jy,kz-1)*dz2+uuh(ix,jy,kz)*dz1)/dz
+            vv(ix,jy,iz,n)=(vvh(ix,jy,kz-1)*dz2+vvh(ix,jy,kz)*dz1)/dz
+            tt(ix,jy,iz,n)=(tth(ix,jy,kz-1,n)*dz2 &
+            +tth(ix,jy,kz,n)*dz1)/dz
+            qv(ix,jy,iz,n)=(qvh(ix,jy,kz-1,n)*dz2 &
+            +qvh(ix,jy,kz,n)*dz1)/dz
+  ! IP & SEC, 201812 add clouds
+            if (readclouds) then
+               clwc(ix,jy,iz,n)=(clwch(ix,jy,kz-1,n)*dz2 &
+               +clwch(ix,jy,kz,n)*dz1)/dz
+            endif
+            pv(ix,jy,iz,n)=(pvh(ix,jy,kz-1)*dz2+pvh(ix,jy,kz)*dz1)/dz
+            rho(ix,jy,iz,n)=(rhoh(kz-1)*dz2+rhoh(kz)*dz1)/dz
+            pplev(ix,jy,iz,n)=(akz(kz-1)*dz2+akz(kz)*dz1)/dz
+          endif
+        end do
+      end do
+
+
+  ! Levels, where w is given
+  !*************************
+
+      ww(ix,jy,1,n)=wwh(ix,jy,llev)*pinmconv(llev)
+      ww(ix,jy,nz,n)=wwh(ix,jy,nwz)*pinmconv(nz)
+      kmin=llev+1
+      do iz=2,nz
+        do kz=kmin,nwz
+          if ((height(iz).gt.wzlev(kz-1)).and. &
+          (height(iz).le.wzlev(kz))) then
+            dz1=height(iz)-wzlev(kz-1)
+            dz2=wzlev(kz)-height(iz)
+            dz=dz1+dz2
+            ww(ix,jy,iz,n)=(wwh(ix,jy,kz-1)*pinmconv(kz-1)*dz2 &
+            +wwh(ix,jy,kz)*pinmconv(kz)*dz1)/dz
+          endif
+        end do
+      end do
+
+
+  ! Compute density gradients at intermediate levels
+  !*************************************************
+
+      drhodz(ix,jy,1,n)=(rho(ix,jy,2,n)-rho(ix,jy,1,n))/ &
+           (height(2)-height(1))
+      do kz=2,nz-1
+        drhodz(ix,jy,kz,n)=(rho(ix,jy,kz+1,n)-rho(ix,jy,kz-1,n))/ &
+        (height(kz+1)-height(kz-1))
+      end do
+      drhodz(ix,jy,nz,n)=drhodz(ix,jy,nz-1,n)
+
+    end do
+  end do
+
+
+  !****************************************************************
+  ! Compute slope of eta levels in windward direction and resulting
+  ! vertical wind correction
+  !****************************************************************
+
+  do jy=1,ny-2
+    cosf=cos((real(jy)*dy+ylat0)*pi180)
+    do ix=1,nx-2
+
+  ! NCEP version: find first level above ground
+      llev = 0
+      do i=1,nuvz
+       if (ps(ix,jy,1,n).lt.akz(i)) llev=i
+      end do
+       llev = llev+1
+       if (llev.gt.nuvz-2) llev = nuvz-2
+  !     if (llev.eq.nuvz-2) write(*,*) 'verttransform
+  !    +WARNING: LLEV eq NUZV-2'
+  ! NCEP version
+
+      kmin=llev+1
+      do iz=2,nz-1
+
+        ui=uu(ix,jy,iz,n)*dxconst/cosf
+        vi=vv(ix,jy,iz,n)*dyconst
+
+        do kz=kmin,nz
+          if ((height(iz).gt.uvwzlev(ix,jy,kz-1)).and. &
+          (height(iz).le.uvwzlev(ix,jy,kz))) then
+            dz1=height(iz)-uvwzlev(ix,jy,kz-1)
+            dz2=uvwzlev(ix,jy,kz)-height(iz)
+            dz=dz1+dz2
+            kl=kz-1
+            klp=kz
+            exit
+          endif
+        end do
+
+        ix1=ix-1
+        jy1=jy-1
+        ixp=ix+1
+        jyp=jy+1
+
+        dzdx1=(uvwzlev(ixp,jy,kl)-uvwzlev(ix1,jy,kl))/2.
+        dzdx2=(uvwzlev(ixp,jy,klp)-uvwzlev(ix1,jy,klp))/2.
+        dzdx=(dzdx1*dz2+dzdx2*dz1)/dz
+
+        dzdy1=(uvwzlev(ix,jyp,kl)-uvwzlev(ix,jy1,kl))/2.
+        dzdy2=(uvwzlev(ix,jyp,klp)-uvwzlev(ix,jy1,klp))/2.
+        dzdy=(dzdy1*dz2+dzdy2*dz1)/dz
+
+        ww(ix,jy,iz,n)=ww(ix,jy,iz,n)+(dzdx*ui+dzdy*vi)
+
+      end do
+
+    end do
+  end do
+
+
+  ! If north pole is in the domain, calculate wind velocities in polar
+  ! stereographic coordinates
+  !*******************************************************************
+
+  if (nglobal) then
+    do jy=int(switchnorthg)-2,nymin1
+      ylat=ylat0+real(jy)*dy
+      do ix=0,nxmin1
+        xlon=xlon0+real(ix)*dx
+        do iz=1,nz
+          call cc2gll(northpolemap,ylat,xlon,uu(ix,jy,iz,n), &
+               vv(ix,jy,iz,n),uupol(ix,jy,iz,n), &
+               vvpol(ix,jy,iz,n))
+        end do
+      end do
+    end do
+
+
+    do iz=1,nz
+
+  ! CALCULATE FFPOL, DDPOL FOR CENTRAL GRID POINT
+      xlon=xlon0+real(nx/2-1)*dx
+      xlonr=xlon*pi/180.
+      ffpol=sqrt(uu(nx/2-1,nymin1,iz,n)**2+vv(nx/2-1,nymin1,iz,n)**2)
+      if (vv(nx/2-1,nymin1,iz,n).lt.0.) then
+        ddpol=atan(uu(nx/2-1,nymin1,iz,n)/vv(nx/2-1,nymin1,iz,n))-xlonr
+      elseif (vv(nx/2-1,nymin1,iz,n).gt.0.) then
+        ddpol=pi+atan(uu(nx/2-1,nymin1,iz,n)/ &
+        vv(nx/2-1,nymin1,iz,n))-xlonr
+      else
+        ddpol=pi/2-xlonr
+      endif
+      if(ddpol.lt.0.) ddpol=2.0*pi+ddpol
+      if(ddpol.gt.2.0*pi) ddpol=ddpol-2.0*pi
+
+  ! CALCULATE U,V FOR 180 DEG, TRANSFORM TO POLAR STEREOGRAPHIC GRID
+      xlon=180.0
+      xlonr=xlon*pi/180.
+      ylat=90.0
+      uuaux=-ffpol*sin(xlonr+ddpol)
+      vvaux=-ffpol*cos(xlonr+ddpol)
+      call cc2gll(northpolemap,ylat,xlon,uuaux,vvaux,uupolaux,vvpolaux)
+      jy=nymin1
+      do ix=0,nxmin1
+        uupol(ix,jy,iz,n)=uupolaux
+        vvpol(ix,jy,iz,n)=vvpolaux
+      end do
+    end do
+
+
+  ! Fix: Set W at pole to the zonally averaged W of the next equator-
+  ! ward parallel of latitude
+
+    do iz=1,nz
+      wdummy=0.
+      jy=ny-2
+      do ix=0,nxmin1
+        wdummy=wdummy+ww(ix,jy,iz,n)
+      end do
+      wdummy=wdummy/real(nx)
+      jy=nymin1
+      do ix=0,nxmin1
+        ww(ix,jy,iz,n)=wdummy
+      end do
+    end do
+
+  endif
+
+
+  ! If south pole is in the domain, calculate wind velocities in polar
+  ! stereographic coordinates
+  !*******************************************************************
+
+  if (sglobal) then
+    do jy=0,int(switchsouthg)+3
+      ylat=ylat0+real(jy)*dy
+      do ix=0,nxmin1
+        xlon=xlon0+real(ix)*dx
+        do iz=1,nz
+          call cc2gll(southpolemap,ylat,xlon,uu(ix,jy,iz,n), &
+          vv(ix,jy,iz,n),uupol(ix,jy,iz,n),vvpol(ix,jy,iz,n))
+        end do
+      end do
+    end do
+
+    do iz=1,nz
+
+  ! CALCULATE FFPOL, DDPOL FOR CENTRAL GRID POINT
+      xlon=xlon0+real(nx/2-1)*dx
+      xlonr=xlon*pi/180.
+      ffpol=sqrt(uu(nx/2-1,0,iz,n)**2+vv(nx/2-1,0,iz,n)**2)
+      if(vv(nx/2-1,0,iz,n).lt.0.) then
+        ddpol=atan(uu(nx/2-1,0,iz,n)/vv(nx/2-1,0,iz,n))+xlonr
+      elseif (vv(nx/2-1,0,iz,n).gt.0.) then
+        ddpol=pi+atan(uu(nx/2-1,0,iz,n)/vv(nx/2-1,0,iz,n))-xlonr
+      else
+        ddpol=pi/2-xlonr
+      endif
+      if(ddpol.lt.0.) ddpol=2.0*pi+ddpol
+      if(ddpol.gt.2.0*pi) ddpol=ddpol-2.0*pi
+
+  ! CALCULATE U,V FOR 180 DEG, TRANSFORM TO POLAR STEREOGRAPHIC GRID
+      xlon=180.0
+      xlonr=xlon*pi/180.
+      ylat=-90.0
+      uuaux=+ffpol*sin(xlonr-ddpol)
+      vvaux=-ffpol*cos(xlonr-ddpol)
+      call cc2gll(northpolemap,ylat,xlon,uuaux,vvaux,uupolaux,vvpolaux)
+
+      jy=0
+      do ix=0,nxmin1
+        uupol(ix,jy,iz,n)=uupolaux
+        vvpol(ix,jy,iz,n)=vvpolaux
+      end do
+    end do
+
+
+  ! Fix: Set W at pole to the zonally averaged W of the next equator-
+  ! ward parallel of latitude
+
+    do iz=1,nz
+      wdummy=0.
+      jy=1
+      do ix=0,nxmin1
+        wdummy=wdummy+ww(ix,jy,iz,n)
+      end do
+      wdummy=wdummy/real(nx)
+      jy=0
+      do ix=0,nxmin1
+        ww(ix,jy,iz,n)=wdummy
+      end do
+    end do
+  endif
+
+  !*****************************************************************************
+  ! IP & SEC, 201812 GFS clouds read
+  if (readclouds) then
+! loops all grids vertically and constructs the 3D matrix for clouds
+! Cloud top and cloud bottom gid cells are assigned as well as the total column
+! cloud water. For precipitating grids, the type and whether it is in or below
+! cloud scavenging are assigned with numbers 2-5 (following the old metod).
+! Distinction is done for lsp and convp though they are treated the same in
+! regards to scavenging. Also clouds that are not precipitating are defined
+! which may be to include future cloud processing by non-precipitating-clouds.
+!*****************************************************************************
+    write(*,*) 'Global NCEP fields: using cloud water'
+    clw(:,:,:,n)=0.0
+    ctwc(:,:,n)=0.0
+    clouds(:,:,:,n)=0
+  ! If water/ice are read separately into clwc and ciwc, store sum in clwc
+    do jy=0,nymin1
+      do ix=0,nxmin1
+        lsp=lsprec(ix,jy,1,n)
+        convp=convprec(ix,jy,1,n)
+        prec=lsp+convp
+  ! Find clouds in the vertical
+        do kz=1, nz-1 !go from top to bottom
+          if (clwc(ix,jy,kz,n).gt.0) then
+  ! assuming rho is in kg/m3 and hz in m gives: kg/kg * kg/m3 *m3/kg /m = m2/m3
+            clw(ix,jy,kz,n)=(clwc(ix,jy,kz,n)*rho(ix,jy,kz,n))* &
+              (height(kz+1)-height(kz))
+            ctwc(ix,jy,n) = ctwc(ix,jy,n)+clw(ix,jy,kz,n)
+            cloudh_min=min(height(kz+1),height(kz))
+          endif
+        end do
+
+  ! If Precipitation. Define removal type in the vertical
+        if ((lsp.gt.0.01).or.(convp.gt.0.01)) then ! cloud and precipitation
+
+          do kz=nz,2,-1 !go Bottom up!
+            if (clw(ix,jy,kz,n).gt. 0) then ! is in cloud
+              cloudsh(ix,jy,n)=cloudsh(ix,jy,n)+height(kz)-height(kz-1)
+              clouds(ix,jy,kz,n)=1               ! is a cloud
+              if (lsp.ge.convp) then
+                clouds(ix,jy,kz,n)=3             ! lsp in-cloud
+              else
+                clouds(ix,jy,kz,n)=2             ! convp in-cloud
+              endif                              ! convective or large scale
+            elseif((clw(ix,jy,kz,n).le.0) .and. (cloudh_min.ge.height(kz))) then
+             ! is below cloud
+              if (lsp.ge.convp) then
+                clouds(ix,jy,kz,n)=5             ! lsp dominated washout
+              else
+                clouds(ix,jy,kz,n)=4             ! convp dominated washout
+              endif                              ! convective or large scale
+            endif
+
+            if (height(kz).ge. 19000) then        ! set a max height for removal
+              clouds(ix,jy,kz,n)=0
+            endif !clw>0
+          end do !nz
+        endif ! precipitation
+      end do
+    end do
+  else
+  write(*,*) 'Global NCEP fields: using cloud water from Parameterization'
+  !   write (*,*) 'initializing clouds, n:',n,nymin1,nxmin1,nz
+  !   create a cloud and rainout/washout field, clouds occur where rh>80%
+  !   total cloudheight is stored at level 0
+  do jy=0,nymin1
+    do ix=0,nxmin1
+      rain_cloud_above=0
+      lsp=lsprec(ix,jy,1,n)
+      convp=convprec(ix,jy,1,n)
+      cloudsh(ix,jy,n)=0
+      do kz_inv=1,nz-1
+         kz=nz-kz_inv+1
+         pressure=rho(ix,jy,kz,n)*r_air*tt(ix,jy,kz,n)
+         rh=qv(ix,jy,kz,n)/f_qvsat(pressure,tt(ix,jy,kz,n))
+         clouds(ix,jy,kz,n)=0
+         if (rh.gt.0.8) then ! in cloud
+           if ((lsp.gt.0.01).or.(convp.gt.0.01)) then ! cloud and precipitation
+              rain_cloud_above=1
+              cloudsh(ix,jy,n)=cloudsh(ix,jy,n)+height(kz)-height(kz-1)
+              if (lsp.ge.convp) then
+                 clouds(ix,jy,kz,n)=3 ! lsp dominated rainout
+              else
+                 clouds(ix,jy,kz,n)=2 ! convp dominated rainout
+              endif
+           else ! no precipitation
+             clouds(ix,jy,kz,n)=1 ! cloud
+           endif
+         else ! no cloud
+           if (rain_cloud_above.eq.1) then ! scavenging
+             if (lsp.ge.convp) then
+               clouds(ix,jy,kz,n)=5 ! lsp dominated washout
+             else
+               clouds(ix,jy,kz,n)=4 ! convp dominated washout
+             endif
+           endif
+         endif
+      end do
+    end do
+  end do
+  endif  ! IP & SEC 201812, GFS clouds read
+
+end subroutine verttransform_gfs
diff --git a/src/ver_verttransform_nest.f90 b/src/ver_verttransform_nest.f90
new file mode 100644
index 0000000000000000000000000000000000000000..dd6a0a2644446d0203589ebe56cc7483e72d7a43
--- /dev/null
+++ b/src/ver_verttransform_nest.f90
@@ -0,0 +1,100 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine verttransform_nest(n,uuhn,vvhn,wwhn,pvhn)
+  !                            i   i    i    i   i
+  !*****************************************************************************
+  !                                                                            *
+  !     This subroutine transforms temperature, dew point temperature and      *
+  !     wind components from eta to meter coordinates.                         *
+  !     The vertical wind component is transformed from Pa/s to m/s using      *
+  !     the conversion factor pinmconv.                                        *
+  !     In addition, this routine calculates vertical density gradients        *
+  !     needed for the parameterization of the turbulent velocities.           *
+  !     It is similar to verttransform, but makes the transformations for      *
+  !     the nested grids.                                                      *
+  !                                                                            *
+  !     Author: A. Stohl, G. Wotawa                                            *
+  !                                                                            *
+  !     12 August 1996                                                         *
+  !     Update: 16 January 1998                                                *
+  !                                                                            *
+  !     Major update: 17 February 1999                                         *
+  !     by G. Wotawa                                                           *
+  !                                                                            *
+  !     - Vertical levels for u, v and w are put together                      *
+  !     - Slope correction for vertical velocity: Modification of calculation  *
+  !       procedure                                                            *
+  !                                                                            *
+  !*****************************************************************************
+  !  Changes, Bernd C. Krueger, Feb. 2001:       (marked "C-cv")
+  !   Variables tthn and qvhn (on eta coordinates) from common block
+  !*****************************************************************************
+  ! Sabine Eckhardt, March 2007
+  ! add the variable cloud for use with scavenging - descr. in com_mod
+  !*****************************************************************************
+  ! ESO, 2016
+  ! -note that divide-by-zero occurs when nxmaxn,nymaxn etc. are larger than
+  !  the actual field dimensions
+  !*****************************************************************************
+  ! Date: 2017-05-30 modification of a bug in ew. Don Morton (CTBTO project)   *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! nxn,nyn,nuvz,nwz                field dimensions in x,y and z direction    *
+  ! uun                             wind components in x-direction [m/s]       *
+  ! vvn                             wind components in y-direction [m/s]       *
+  ! wwn                             wind components in z-direction [deltaeta/s]*
+  ! ttn                             temperature [K]                            *
+  ! pvn                             potential vorticity (pvu)                  *
+  ! psn                             surface pressure [Pa]                      *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+  use qvsat_mod
+
+  implicit none
+
+  real,intent(in),dimension(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests) :: uuhn,vvhn,pvhn
+  real,intent(in),dimension(0:nxmaxn-1,0:nymaxn-1,nwzmax,maxnests) :: wwhn
+
+  real,dimension(0:nxmaxn-1,0:nymaxn-1,nuvzmax) :: rhohn,uvzlev,wzlev,prshn
+  real,dimension(0:nxmaxn-1,0:nymaxn-1,nzmax) :: pinmconv
+
+  integer,dimension(0:nxmaxn-1,0:nymaxn-1) :: rain_cloud_above, idx
+
+  integer :: ix,jy,kz,iz,n,l,kmin,kl,klp,ix1,jy1,ixp,jyp,kz_inv
+  integer :: nxm1, nym1
+
+  !  real,parameter :: precmin = 0.002 ! minimum prec in mm/h for cloud diagnostics
+
+  ! Loop over all nests
+  !********************
+
+  do l=1,numbnests
+    nxm1=nxn(l)-1
+    nym1=nyn(l)-1
+    call verttransf_ec_height(nxm1,nym1, tt2n(0:nxm1,0:nym1,1,n,l),&
+      td2n(0:nxm1,0:nym1,1,n,l),psn(0:nxm1,0:nym1,1,n,l), &
+      qvhn(0:nxm1,0:nym1,:,n,l),tthn(0:nxm1,0:nym1,:,n,l), &
+      prshn(0:nxm1,0:nym1,:),rhohn(0:nxm1,0:nym1,:),pinmconv(0:nxm1,0:nym1,:), &
+      etauvheightn(0:nxm1,0:nym1,:,n,l),etawheightn(0:nxm1,0:nym1,:,n,l))
+
+    call verttransf_ec_windf_nest(l,n,uuhn,vvhn,wwhn,pvhn,rhohn,prshn,pinmconv)
+
+    ! Create cloud fields
+    !*********************
+
+    call verttransf_ec_cloud(n,readclouds_nest(l),sumclouds_nest(l),nxm1,nym1,&
+      cloudsn(0:nxm1,0:nym1,:,n,l),cloudshn(0:nxm1,0:nym1,n,l), &
+      clwn(0:nxm1,0:nym1,:,n,l), ctwcn(0:nxm1,0:nym1,n,l), &
+      clwcn(0:nxm1,0:nym1,:,n,l), ciwcn(0:nxm1,0:nym1,:,n,l), &
+      lsprecn(0:nxm1,0:nym1,1,n,l),convprecn(0:nxm1,0:nym1,1,n,l), &
+      rhon(0:nxm1,0:nym1,:,n,l),ttn(0:nxm1,0:nym1,:,n,l), &
+      qvn(0:nxm1,0:nym1,:,n,l), etauvheightn(0:nxm1,0:nym1,:,n,l))
+
+  end do ! end loop over nests
+
+end subroutine verttransform_nest
diff --git a/src/verttransform_mod.f90 b/src/verttransform_mod.f90
index 9bd5b70a8e04b48c1010f970d9f65b3f916ac3e3..f750eec2a15add9d09dbeb733028698b3c870cd3 100644
--- a/src/verttransform_mod.f90
+++ b/src/verttransform_mod.f90
@@ -17,1962 +17,22 @@ module verttransform_mod
 
 contains
 
-subroutine verttransform_ecmwf(n,uuh,vvh,wwh,pvh)
-  !                              i  i   i   i   i
-  !*****************************************************************************
-  !                                                                            *
-  !     This subroutine transforms temperature, dew point temperature and      *
-  !     wind components from eta to meter coordinates.                         *
-  !     The vertical wind component is transformed from Pa/s to m/s using      *
-  !     the conversion factor pinmconv.                                        *
-  !     In addition, this routine calculates vertical density gradients        *
-  !     needed for the parameterization of the turbulent velocities.           *
-  !                                                                            *
-  !     Author: A. Stohl, G. Wotawa                                            *
-  !                                                                            *
-  !     12 August 1996                                                         *
-  !     Update: 16 January 1998                                                *
-  !                                                                            *
-  !     Major update: 17 February 1999                                         *
-  !     by G. Wotawa                                                           *
-  !                                                                            *
-  !     - Vertical levels for u, v and w are put together                      *
-  !     - Slope correction for vertical velocity: Modification of calculation  *
-  !       procedure                                                            *
-  !                                                                            *
-  !*****************************************************************************
-  !  Changes, Bernd C. Krueger, Feb. 2001:
-  !   Variables tth and qvh (on eta coordinates) from common block
-  !
-  ! Sabine Eckhardt, March 2007
-  ! added the variable cloud for use with scavenging - descr. in com_mod
-  !
-  ! Unified ECMWF and GFS builds
-  ! Marian Harustak, 12.5.2017 
-  !     - Renamed from verttransform to verttransform_ecmwf
-  !
-  ! Date: 2017-05-30 modification of a bug in ew. Don Morton (CTBTO project)   *
-  !                                                                            *
-  ! Lucie Bakels, 2022                                                         *
-  !    - Separated the code into subroutines                                   *
-  !    - In case of wind_coord_type='ETA': keep ECMWF vertical winds in eta    *
-  !      coordinates                                                           *
-  !    - OpenMP parallelisation                                                *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! nx,ny,nz                        field dimensions in x,y and z direction    *
-  ! clouds(0:nxmax,0:nymax,0:nzmax,numwfmem) cloud field for wet deposition    *
-  ! uu(0:nxmax,0:nymax,nzmax,numwfmem)     wind components in x-direction [m/s]*
-  ! vv(0:nxmax,0:nymax,nzmax,numwfmem)     wind components in y-direction [m/s]*
-  ! ww(0:nxmax,0:nymax,nzmax,numwfmem)     wind components in z-direction      *
-  !                                          [deltaeta/s]                      *
-  ! tt(0:nxmax,0:nymax,nzmax,numwfmem)     temperature [K]                     *
-  ! pv(0:nxmax,0:nymax,nzmax,numwfmem)     potential voriticity (pvu)          *
-  ! ps(0:nxmax,0:nymax,numwfmem)           surface pressure [Pa]               *
-  !                                                                            *
-  !*****************************************************************************
-
-  use par_mod
-  use com_mod
-  use cmapf_mod, only: cc2gll
-  use qvsat_mod
-
-  implicit none
-
-  integer, intent(in) :: n
-  real,intent(in),dimension(0:nxmax-1,0:nymax-1,nuvzmax) :: uuh,vvh,pvh
-  real,intent(in),dimension(0:nxmax-1,0:nymax-1,nwzmax) :: wwh
-
-  real,dimension(0:nxmax-1,0:nymax-1,nuvzmax) :: rhoh
-  real,dimension(0:nxmax-1,0:nymax-1,nzmax) :: pinmconv
-  ! RLT added pressure
-  real,dimension(0:nxmax-1,0:nymax-1,nuvzmax) :: prsh
-
-  logical :: init = .true.
-
-  !*************************************************************************
-  ! If verttransform is called the first time, initialize heights of the   *
-  ! z levels in meter. The heights are the heights of model levels, where  *
-  ! u,v,T and qv are given, and of the interfaces, where w is given. So,   *
-  ! the vertical resolution in the z system is doubled. As reference point,*
-  ! the lower left corner of the grid is used.                             *
-  ! Unlike in the eta system, no difference between heights for u,v and    *
-  ! heights for w exists.                                                  *
-  !*************************************************************************
-
-
-  !eso measure CPU time
-  !  call mpif_mtime('verttransform',0)
-
-  if (init) then
-
-  ! Search for a point with high surface pressure (i.e. not above significant topography)
-  ! Then, use this point to construct a reference z profile, to be used at all times
-  !*****************************************************************************
-    call vertransf_init(n)
-
-  ! Do not repeat initialization of the Cartesian z grid
-  !*****************************************************
-
-    init=.false.
-  endif
-
-
-  ! Compute heights of eta levels and their respective pressure and density fields
-  !*******************************************************************************
-  call verttransf_ec_height(nxmax-1,nymax-1,tt2(:,:,1,n),td2(:,:,1,n), &
-    ps(:,:,1,n),qvh(:,:,:,n),tth(:,:,:,n),prsh,rhoh,pinmconv, &
-    etauvheight(:,:,:,n),etawheight(:,:,:,n))
-
-  ! Transform the wind fields to the internal coordinate system and save the native ETA 
-  ! fields when case wind_coord_type==ETA
-  !*************************************************************
-  call verttransf_ec_windf(n,uuh,vvh,wwh,pvh,rhoh,prsh,pinmconv)
-
-  ! If north or south pole is in the domain, calculate wind velocities in polar
-  ! stereographic coordinates
-  !*******************************************************************
-  call verttransf_ec_stereo(n)
-
-  ! Create cloud fields
-  !*********************
-  call verttransf_ec_cloud(n,readclouds,sumclouds,nxmin1,nymin1,clouds(:,:,:,n), &
-    cloudsh(:,:,n),clw(:,:,:,n),ctwc(:,:,n),clwc(:,:,:,n),ciwc(:,:,:,n),lsprec(:,:,1,n), &
-    convprec(:,:,1,n),rho(:,:,:,n),tt(:,:,:,n),qv(:,:,:,n),etauvheight(:,:,:,n))
-end subroutine verttransform_ecmwf
-
-subroutine verttransform_nest(n,uuhn,vvhn,wwhn,pvhn)
-  !                            i   i    i    i   i
-  !*****************************************************************************
-  !                                                                            *
-  !     This subroutine transforms temperature, dew point temperature and      *
-  !     wind components from eta to meter coordinates.                         *
-  !     The vertical wind component is transformed from Pa/s to m/s using      *
-  !     the conversion factor pinmconv.                                        *
-  !     In addition, this routine calculates vertical density gradients        *
-  !     needed for the parameterization of the turbulent velocities.           *
-  !     It is similar to verttransform, but makes the transformations for      *
-  !     the nested grids.                                                      *
-  !                                                                            *
-  !     Author: A. Stohl, G. Wotawa                                            *
-  !                                                                            *
-  !     12 August 1996                                                         *
-  !     Update: 16 January 1998                                                *
-  !                                                                            *
-  !     Major update: 17 February 1999                                         *
-  !     by G. Wotawa                                                           *
-  !                                                                            *
-  !     - Vertical levels for u, v and w are put together                      *
-  !     - Slope correction for vertical velocity: Modification of calculation  *
-  !       procedure                                                            *
-  !                                                                            *
-  !*****************************************************************************
-  !  Changes, Bernd C. Krueger, Feb. 2001:       (marked "C-cv")
-  !   Variables tthn and qvhn (on eta coordinates) from common block
-  !*****************************************************************************
-  ! Sabine Eckhardt, March 2007
-  ! add the variable cloud for use with scavenging - descr. in com_mod
-  !*****************************************************************************
-  ! ESO, 2016
-  ! -note that divide-by-zero occurs when nxmaxn,nymaxn etc. are larger than 
-  !  the actual field dimensions
-  !*****************************************************************************
-  ! Date: 2017-05-30 modification of a bug in ew. Don Morton (CTBTO project)   *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! nxn,nyn,nuvz,nwz                field dimensions in x,y and z direction    *
-  ! uun                             wind components in x-direction [m/s]       *
-  ! vvn                             wind components in y-direction [m/s]       *
-  ! wwn                             wind components in z-direction [deltaeta/s]*
-  ! ttn                             temperature [K]                            *
-  ! pvn                             potential vorticity (pvu)                  *
-  ! psn                             surface pressure [Pa]                      *
-  !                                                                            *
-  !*****************************************************************************
-
-  use par_mod
-  use com_mod
-  use qvsat_mod
-
-  implicit none
-
-  real,intent(in),dimension(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests) :: uuhn,vvhn,pvhn
-  real,intent(in),dimension(0:nxmaxn-1,0:nymaxn-1,nwzmax,maxnests) :: wwhn
-
-  real,dimension(0:nxmaxn-1,0:nymaxn-1,nuvzmax) :: rhohn,uvzlev,wzlev,prshn
-  real,dimension(0:nxmaxn-1,0:nymaxn-1,nzmax) :: pinmconv
-
-  integer,dimension(0:nxmaxn-1,0:nymaxn-1) :: rain_cloud_above, idx
-
-  integer :: ix,jy,kz,iz,n,l,kmin,kl,klp,ix1,jy1,ixp,jyp,kz_inv
-  integer :: nxm1, nym1
-
-  !  real,parameter :: precmin = 0.002 ! minimum prec in mm/h for cloud diagnostics
-
-  ! Loop over all nests
-  !********************
-
-  do l=1,numbnests
-    nxm1=nxn(l)-1
-    nym1=nyn(l)-1
-    call verttransf_ec_height(nxm1,nym1, tt2n(0:nxm1,0:nym1,1,n,l),&
-      td2n(0:nxm1,0:nym1,1,n,l),psn(0:nxm1,0:nym1,1,n,l), &
-      qvhn(0:nxm1,0:nym1,:,n,l),tthn(0:nxm1,0:nym1,:,n,l), &
-      prshn(0:nxm1,0:nym1,:),rhohn(0:nxm1,0:nym1,:),pinmconv(0:nxm1,0:nym1,:), &
-      etauvheightn(0:nxm1,0:nym1,:,n,l),etawheightn(0:nxm1,0:nym1,:,n,l))
-
-    call verttransf_ec_windf_nest(l,n,uuhn,vvhn,wwhn,pvhn,rhohn,prshn,pinmconv)
-
-    ! Create cloud fields
-    !*********************
-
-    call verttransf_ec_cloud(n,readclouds_nest(l),sumclouds_nest(l),nxm1,nym1,&
-      cloudsn(0:nxm1,0:nym1,:,n,l),cloudshn(0:nxm1,0:nym1,n,l), &
-      clwn(0:nxm1,0:nym1,:,n,l), ctwcn(0:nxm1,0:nym1,n,l), &
-      clwcn(0:nxm1,0:nym1,:,n,l), ciwcn(0:nxm1,0:nym1,:,n,l), &
-      lsprecn(0:nxm1,0:nym1,1,n,l),convprecn(0:nxm1,0:nym1,1,n,l), &
-      rhon(0:nxm1,0:nym1,:,n,l),ttn(0:nxm1,0:nym1,:,n,l), &
-      qvn(0:nxm1,0:nym1,:,n,l), etauvheightn(0:nxm1,0:nym1,:,n,l))
-      
-  end do ! end loop over nests
-  
-end subroutine verttransform_nest
-
-subroutine vertransf_init(n)
-
-  use par_mod
-  use com_mod
-  use qvsat_mod
-  use initialise_mod
-  use output_mod
-
-  implicit none
-
-  integer, intent(in) :: n
-  real ::  tvold,pold,pint,tv
-  integer :: ix,jy,kz,ixm,jym
-  real,parameter :: const=r_air/ga
-
-  if ((ipin.eq.1).or.(ipin.eq.4)) then
-    call read_heightlevels(height,nmixz)
-    return
-  endif
-
-  loop1: do jy=0,nymin1
-    do ix=0,nxmin1
-      if (ps(ix,jy,1,n).gt.100000.) then
-        ixm=ix
-        jym=jy
-        exit loop1
-      endif
-    end do
-  end do loop1
-
-  tvold=tt2(ixm,jym,1,n)*(1.+0.378*ew(td2(ixm,jym,1,n),ps(ixm,jym,1,n))/ &
-       ps(ixm,jym,1,n))
-  pold=ps(ixm,jym,1,n)
-  height(1)=0.
-
-  do kz=2,nuvz
-    pint=akz(kz)+bkz(kz)*ps(ixm,jym,1,n)
-    tv=tth(ixm,jym,kz,n)*(1.+0.608*qvh(ixm,jym,kz,n))
-
-    if (abs(tv-tvold).gt.0.2) then
-      height(kz)= height(kz-1)+const*log(pold/pint)* &
-           (tv-tvold)/log(tv/tvold)
-    else
-      height(kz)=height(kz-1)+const*log(pold/pint)*tv
-    endif
-
-    tvold=tv
-    pold=pint
-  end do
-
-  ! Determine highest levels that can be within PBL
-  !************************************************
-
-  do kz=1,nz
-    if (height(kz).gt.hmixmax) then
-      nmixz=kz
-      exit
-    endif
-  end do
-
-  call output_heightlevs(height,nmixz)
-end subroutine vertransf_init
-
-subroutine verttransf_ec_windf(n,uuh,vvh,wwh,pvh,rhoh,prsh,pinmconv)
-  use par_mod
-  use com_mod
-  use qvsat_mod
-
-  implicit none
-
-  integer,intent(in) :: n
-  real,intent(in),dimension(0:nxmax-1,0:nymax-1,nuvzmax) :: uuh,vvh,pvh
-  real,intent(in),dimension(0:nxmax-1,0:nymax-1,nwzmax) :: wwh
-  real,intent(in),dimension(0:nxmax-1,0:nymax-1,nuvzmax) :: rhoh
-  real,intent(in),dimension(0:nxmax-1,0:nymax-1,nzmax) :: pinmconv
-  ! RLT added pressure
-  real,intent(in),dimension(0:nxmax-1,0:nymax-1,nuvzmax) :: prsh
-
-  !real,dimension(0:nxmax-1,0:nymax-1) ::  dpdeta
-
-  real,dimension(0:nymax-1) :: cosf
-
-  integer,dimension(0:nxmax-1,0:nymax-1) :: idx
-
-  integer :: ix,jy,kz,iz,kmin,ixp,jyp,ix1,jy1
-  real :: dz1,dz2,dz,dpdeta
-  real :: xlon,ylat,xlonr,dzdx,dzdy
-  real :: dzdx1,dzdx2,dzdy1,dzdy2
-
-  ! Levels, where u,v,t and q are given
-  !************************************
-!$OMP PARALLEL PRIVATE(jy,ix,kz,dz1,dz2,dz,ix1,jy1,ixp,jyp,dzdx1,dzdx2,dzdx, &
-!$OMP   dzdy1,dzdy2,dzdy,dpdeta)
-
-!$OMP DO
-  do jy=0,nymin1
-    do ix=0,nxmin1
-
-      uu(ix,jy,1,n)=uuh(ix,jy,1)
-      uu(ix,jy,nz,n)=uuh(ix,jy,nuvz)
-      vv(ix,jy,1,n)=vvh(ix,jy,1)
-      vv(ix,jy,nz,n)=vvh(ix,jy,nuvz)
-      tt(ix,jy,1,n)=tth(ix,jy,1,n)
-      tt(ix,jy,nz,n)=tth(ix,jy,nuvz,n)
-      pv(ix,jy,1,n)=pvh(ix,jy,1)
-      pv(ix,jy,nz,n)=pvh(ix,jy,nuvz)
-      if  (wind_coord_type.ne.'ETA') then
-        qv(ix,jy,1,n)=qvh(ix,jy,1,n)
-        qv(ix,jy,nz,n)=qvh(ix,jy,nuvz,n)
-        !hg adding the cloud water 
-        if (readclouds) then
-          clwc(ix,jy,1,n)=clwch(ix,jy,1,n)
-          clwc(ix,jy,nz,n)=clwch(ix,jy,nuvz,n)
-          if (.not.sumclouds) then 
-            ciwc(ix,jy,1,n)=ciwch(ix,jy,1,n)
-            ciwc(ix,jy,nz,n)=ciwch(ix,jy,nuvz,n)
-          endif
-        end if
-        !hg 
-      endif
-      rho(ix,jy,1,n)=rhoh(ix,jy,1)
-      rho(ix,jy,nz,n)=rhoh(ix,jy,nuvz)
-      ! RLT add pressure
-      prs(ix,jy,1,n)=prsh(ix,jy,1)
-      prs(ix,jy,nz,n)=prsh(ix,jy,nuvz)
-      ! RLT
-      
-      idx(ix,jy)=2
-    end do
-  end do
-!$OMP END DO
-
-  do iz=2,nz-1
-!$OMP DO SCHEDULE(dynamic)
-    do jy=0,nymin1
-      do ix=0,nxmin1
-        if(height(iz).gt.etauvheight(ix,jy,nuvz,n)) then
-          uu(ix,jy,iz,n)=uu(ix,jy,nz,n)
-          vv(ix,jy,iz,n)=vv(ix,jy,nz,n)
-          tt(ix,jy,iz,n)=tt(ix,jy,nz,n)
-          pv(ix,jy,iz,n)=pv(ix,jy,nz,n)
-          if  (wind_coord_type.ne.'ETA') then
-            qv(ix,jy,iz,n)=qv(ix,jy,nz,n)
-            !hg adding the cloud water
-            if (readclouds) then
-              clwc(ix,jy,iz,n)=clwc(ix,jy,nz,n)
-              if (.not.sumclouds) ciwc(ix,jy,iz,n)=ciwc(ix,jy,nz,n)
-            end if
-          endif
-          rho(ix,jy,iz,n)=rho(ix,jy,nz,n)
-          prs(ix,jy,iz,n)=prs(ix,jy,nz,n)   ! RLT
-        else
-          innuvz: do kz=idx(ix,jy),nuvz
-            if ( idx(ix,jy).le.kz .and. &
-              height(iz).gt.etauvheight(ix,jy,kz-1,n) .and. &
-              height(iz).le.etauvheight(ix,jy,kz,n) ) then
-              idx(ix,jy)=kz
-              exit innuvz
-            endif
-          enddo innuvz
-        endif
-
-        if (height(iz).le.etauvheight(ix,jy,nuvz,n)) then
-          kz=idx(ix,jy)
-          dz1=height(iz)-etauvheight(ix,jy,kz-1,n)
-          dz2=etauvheight(ix,jy,kz,n)-height(iz)
-          dz=dz1+dz2
-          uu(ix,jy,iz,n)=(uuh(ix,jy,kz-1)*dz2+uuh(ix,jy,kz)*dz1)/dz
-          vv(ix,jy,iz,n)=(vvh(ix,jy,kz-1)*dz2+vvh(ix,jy,kz)*dz1)/dz
-          tt(ix,jy,iz,n)=(tth(ix,jy,kz-1,n)*dz2 &
-               +tth(ix,jy,kz,n)*dz1)/dz
-          pv(ix,jy,iz,n)=(pvh(ix,jy,kz-1)*dz2+pvh(ix,jy,kz)*dz1)/dz
-          if  (wind_coord_type.ne.'ETA') then
-            qv(ix,jy,iz,n)=(qvh(ix,jy,kz-1,n)*dz2+qvh(ix,jy,kz,n)*dz1)/dz
-    !hg adding the cloud water
-            if  (readclouds) then
-              clwc(ix,jy,iz,n)= &
-                (clwch(ix,jy,kz-1,n)*dz2+clwch(ix,jy,kz,n)*dz1)/dz
-              if (.not.sumclouds) ciwc(ix,jy,iz,n)= &
-                (ciwch(ix,jy,kz-1,n)*dz2+ciwch(ix,jy,kz,n)*dz1)/dz
-            end if
-    !hg
-          endif
-          rho(ix,jy,iz,n)=(rhoh(ix,jy,kz-1)*dz2+rhoh(ix,jy,kz)*dz1)/dz
-  ! RLT add pressure
-          prs(ix,jy,iz,n)=(prsh(ix,jy,kz-1)*dz2+prsh(ix,jy,kz)*dz1)/dz
-        endif
-      enddo
-    enddo
-!$OMP END DO
-!$OMP BARRIER
-  enddo
-  ! Levels, where w is given
-  !*************************
-
-!$OMP DO
-  do jy=0,nymin1
-    do ix=0,nxmin1
-      idx(ix,jy)=2
-      ww(ix,jy,1,n)=wwh(ix,jy,1)*pinmconv(ix,jy,1)
-      ww(ix,jy,nz,n)=wwh(ix,jy,nwz)*pinmconv(ix,jy,nz)
-    end do
-  end do
-!$OMP END DO
-
-  do iz=2,nz-1
-!$OMP DO SCHEDULE(dynamic)
-    do jy=0,nymin1
-      do ix=0,nxmin1
-
-        inn: do kz=idx(ix,jy),nwz
-          if (idx(ix,jy).le.kz .and. height(iz).gt.etawheight(ix,jy,kz-1,n) & 
-            .and. height(iz).le.etawheight(ix,jy,kz,n)) then
-            idx(ix,jy)=kz
-            exit inn
-          endif
-        enddo inn
-
-        kz=idx(ix,jy)
-        dz1=height(iz)-etawheight(ix,jy,kz-1,n)
-        dz2=etawheight(ix,jy,kz,n)-height(iz)
-        dz=dz1+dz2
-        ww(ix,jy,iz,n)=(wwh(ix,jy,kz-1)*pinmconv(ix,jy,kz-1)*dz2 &
-             +wwh(ix,jy,kz)*pinmconv(ix,jy,kz)*dz1)/dz
-        ! Compute density gradients at intermediate levels
-        !*************************************************
-        drhodz(ix,jy,iz,n)=(rho(ix,jy,iz+1,n)-rho(ix,jy,iz-1,n))/ &
-          (height(iz+1)-height(iz-1))
-      end do
-    end do
-!$OMP END DO
-!$OMP BARRIER
-  end do
-
-!$OMP DO
-  do jy=0,nymin1
-    do ix=0,nxmin1
-      drhodz(ix,jy,nz,n)=drhodz(ix,jy,nz-1,n)
-      drhodz(ix,jy,1,n)=(rho(ix,jy,2,n)-rho(ix,jy,1,n))/(height(2)-height(1))
-    end do
-  end do
-!$OMP END DO NOWAIT
-
-  !****************************************************************
-  ! Compute slope of eta levels in windward direction and resulting
-  ! vertical wind correction
-  !****************************************************************
-
-!$OMP DO
-  do jy=1,ny-2
-    cosf(jy)=1./cos((real(jy)*dy+ylat0)*pi180)
-    do ix=1,nx-2
-      idx(ix,jy)=2
-    end do
-  end do
-!$OMP END DO
-
-  do iz=2,nz-1
-!$OMP DO SCHEDULE(dynamic)
-    do jy=1,ny-2
-      do ix=1,nx-2
-        ! For gridpoint (ix,jy) and height (iz), this loop finds the first eta 
-        ! level encompassing the height(iz) level and saves it in idx(ix,jy)
-        inneta: do kz=idx(ix,jy),nz
-          if (idx(ix,jy) .le. kz .and. height(iz).gt.etauvheight(ix,jy,kz-1,n) &
-            .and. height(iz).le.etauvheight(ix,jy,kz,n)) then
-            idx(ix,jy)=kz
-            exit inneta
-          endif
-        enddo inneta
-
-        kz=idx(ix,jy)
-        dz1=height(iz)-etauvheight(ix,jy,kz-1,n)
-        dz2=etauvheight(ix,jy,kz,n)-height(iz)
-        dz=dz1+dz2
-        ix1=ix-1
-        jy1=jy-1
-        ixp=ix+1
-        jyp=jy+1
-
-        dzdx1=(etauvheight(ixp,jy,kz-1,n)-etauvheight(ix1,jy,kz-1,n))/2.
-        dzdx2=(etauvheight(ixp,jy,kz,n)-etauvheight(ix1,jy,kz,n))/2.
-        dzdx=(dzdx1*dz2+dzdx2*dz1)/dz
-
-        dzdy1=(etauvheight(ix,jyp,kz-1,n)-etauvheight(ix,jy1,kz-1,n))/2.
-        dzdy2=(etauvheight(ix,jyp,kz,n)-etauvheight(ix,jy1,kz,n))/2.
-        dzdy=(dzdy1*dz2+dzdy2*dz1)/dz
-
-        ww(ix,jy,iz,n) = ww(ix,jy,iz,n) + dzdx*uu(ix,jy,iz,n)*dxconst*cosf(jy) &
-                                        + dzdy*vv(ix,jy,iz,n)*dyconst
-      end do
-    end do
-!$OMP END DO
-!$OMP BARRIER
-  end do
-
-  ! Keep original fields if wind_coord_type==ETA
-  if (wind_coord_type.eq.'ETA') then
-!$OMP DO
-
-    do kz=1,nz
-      do jy=0,nymin1
-        do ix=0,nxmin1
-          uueta(ix,jy,kz,n) = uuh(ix,jy,kz)
-          vveta(ix,jy,kz,n) = vvh(ix,jy,kz)
-          tteta(ix,jy,kz,n) = tth(ix,jy,kz,n)
-          qv(ix,jy,kz,n)    = qvh(ix,jy,kz,n)
-          pveta(ix,jy,kz,n) = pvh(ix,jy,kz)
-          rhoeta(ix,jy,kz,n) = rhoh(ix,jy,kz)
-          prseta(ix,jy,kz,n) = prsh(ix,jy,kz)
-          ! tvirtual(ix,jy,kz,n)=tteta(ix,jy,kz,n)* &  
-          !   ((qv(ix,jy,kz,n)+0.622)/(0.622*qv(ix,jy,kz,n)+0.622))
-          ! eq A11 from Mid-latitude atmospheric dynamics by Jonathan E. Martin
-          if ((kz.gt.1).and.(kz.lt.nz)) drhodzeta(ix,jy,kz,n)= &
-               (rhoh(ix,jy,kz+1)-rhoh(ix,jy,kz-1))/ &
-               (height(kz+1)-height(kz-1)) 
-               ! Note that this is still in SI units and not in eta
-          if (readclouds) then
-            clwc(ix,jy,kz,n)=clwch(ix,jy,kz,n)
-            if (.not. sumclouds) ciwc(ix,jy,kz,n)=ciwch(ix,jy,kz,n)
-          endif
-        end do
-      end do
-    end do
-!$OMP END DO NOWAIT
-
-!$OMP DO
-    do jy=0,nymin1
-      do ix=0,nxmin1
-        drhodzeta(ix,jy,1,n)=(rhoh(ix,jy,2)-rhoh(ix,jy,1))/(height(2)-height(1))
-        drhodzeta(ix,jy,nz,n)=drhodzeta(ix,jy,nz-1,n)
-        ! tvirtual(ix,jy,1,n)=tt2(ix,jy,1,n)* &
-        !   (1.+0.378*ew(td2(ix,jy,1,n),ps(ix,jy,1,n))/ps(ix,jy,1,n))
-        ! Convert w from Pa/s to eta/s, following FLEXTRA
-        !************************************************
-        do kz=1,nuvz-1
-          if (kz.eq.1) then
-            dpdeta=(akm(kz+1)-akm(kz)+(bkm(kz+1)-bkm(kz))*ps(ix,jy,1,n))/ &
-              (wheight(kz+1)-wheight(kz))
-          else if (kz.eq.nuvz-1) then
-            dpdeta=(akm(kz)-akm(kz-1)+(bkm(kz)-bkm(kz-1))*ps(ix,jy,1,n))/ &
-              (wheight(kz)-wheight(kz-1))
-          else
-            dpdeta=(akm(kz+1)-akm(kz-1)+(bkm(kz+1)-bkm(kz-1))*ps(ix,jy,1,n))/ &
-              (wheight(kz+1)-wheight(kz-1))
-          endif
-          wweta(ix,jy,kz,n)=wwh(ix,jy,kz)/dpdeta
-        end do
-        wweta(ix,jy,nuvz,n)=wweta(ix,jy,nuvz-1,n) 
-         ! What is the appropriate value for the top level???
-      end do
-    end do
-!$OMP END DO
-  endif
-!$OMP END PARALLEL
-
-end subroutine verttransf_ec_windf
-
-subroutine verttransf_ec_stereo(n)
-  use par_mod
-  use com_mod
-  use cmapf_mod, only: cc2gll
-  use qvsat_mod
-
-  implicit none
-
-  integer, intent(in) :: n
-
-  integer :: ix,jy,iz
-  real :: xlon,ylat,xlonr
-  real :: uuaux,vvaux,uupolaux,vvpolaux,ddpol,ffpol,wdummy
-
-  if (nglobal) then
-    do iz=1,nz
-      do jy=int(switchnorthg)-2,nymin1
-        ylat=ylat0+real(jy)*dy
-        do ix=0,nxmin1
-          xlon=xlon0+real(ix)*dx
-          call cc2gll(northpolemap,ylat,xlon,uu(ix,jy,iz,n), &
-               vv(ix,jy,iz,n),uupol(ix,jy,iz,n), &
-               vvpol(ix,jy,iz,n))
-          if (wind_coord_type.eq.'ETA') then
-            call cc2gll(northpolemap,ylat,xlon,uueta(ix,jy,iz,n), &
-                 vveta(ix,jy,iz,n),uupoleta(ix,jy,iz,n), &
-                 vvpoleta(ix,jy,iz,n))
-          endif
-        end do
-      end do
-    end do
-
-
-    do iz=1,nz
-
-  ! CALCULATE FFPOL, DDPOL FOR CENTRAL GRID POINT
-  !
-  !   AMSnauffer Nov 18 2004 Added check for case vv=0
-  !
-      xlon=xlon0+real(nx/2-1)*dx
-      xlonr=xlon*pi/180.
-      ffpol=sqrt(uu(nx/2-1,nymin1,iz,n)**2+ &
-           vv(nx/2-1,nymin1,iz,n)**2)
-      if (vv(nx/2-1,nymin1,iz,n).lt.0.) then
-        ddpol=atan(uu(nx/2-1,nymin1,iz,n)/ &
-             vv(nx/2-1,nymin1,iz,n))-xlonr
-      else if (vv(nx/2-1,nymin1,iz,n).gt.0.) then
-        ddpol=pi+atan(uu(nx/2-1,nymin1,iz,n)/ &
-             vv(nx/2-1,nymin1,iz,n))-xlonr
-      else
-        ddpol=pi/2-xlonr
-      endif
-      if(ddpol.lt.0.) ddpol=2.0*pi+ddpol
-      if(ddpol.gt.2.0*pi) ddpol=ddpol-2.0*pi
-
-  ! CALCULATE U,V FOR 180 DEG, TRANSFORM TO POLAR STEREOGRAPHIC GRID
-      xlon=180.0
-      xlonr=xlon*pi/180.
-      ylat=90.0
-      uuaux=-ffpol*sin(xlonr+ddpol)
-      vvaux=-ffpol*cos(xlonr+ddpol)
-      call cc2gll(northpolemap,ylat,xlon,uuaux,vvaux,uupolaux, &
-           vvpolaux)
-
-      jy=nymin1
-      do ix=0,nxmin1
-        uupol(ix,jy,iz,n)=uupolaux
-        vvpol(ix,jy,iz,n)=vvpolaux
-      end do
-    end do
-
-    if (wind_coord_type.eq.'ETA') then    
-      do iz=1,nz
-
-        xlon=xlon0+real(nx/2-1)*dx
-        xlonr=xlon*pi/180.
-        ffpol=sqrt(uueta(nx/2-1,nymin1,iz,n)**2+ &
-             vveta(nx/2-1,nymin1,iz,n)**2)
-        if (vveta(nx/2-1,nymin1,iz,n).lt.0.) then
-          ddpol=atan(uueta(nx/2-1,nymin1,iz,n)/ &
-               vveta(nx/2-1,nymin1,iz,n))-xlonr
-        else if (vveta(nx/2-1,nymin1,iz,n).gt.0.) then
-          ddpol=pi+atan(uueta(nx/2-1,nymin1,iz,n)/ &
-               vveta(nx/2-1,nymin1,iz,n))-xlonr
-        else
-          ddpol=pi/2-xlonr
-        endif
-        if(ddpol.lt.0.) ddpol=2.0*pi+ddpol
-        if(ddpol.gt.2.0*pi) ddpol=ddpol-2.0*pi
-
-  ! CALCULATE U,V FOR 180 DEG, TRANSFORM TO POLAR STEREOGRAPHIC GRID
-        xlon=180.0
-        xlonr=xlon*pi/180.
-        ylat=90.0
-        uuaux=-ffpol*sin(xlonr+ddpol)
-        vvaux=-ffpol*cos(xlonr+ddpol)
-        call cc2gll(northpolemap,ylat,xlon,uuaux,vvaux,uupolaux, &
-             vvpolaux)
-
-        jy=nymin1
-        do ix=0,nxmin1
-          uupoleta(ix,jy,iz,n)=uupolaux
-          vvpoleta(ix,jy,iz,n)=vvpolaux
-        end do
-      end do
-    endif
-
-
-  ! Fix: Set W at pole to the zonally averaged W of the next equator-
-  ! ward parallel of latitude
-
-    do iz=1,nz
-      wdummy=0.
-      jy=ny-2
-      do ix=0,nxmin1
-        wdummy=wdummy+ww(ix,jy,iz,n)
-      end do
-      wdummy=wdummy/real(nx)
-      jy=nymin1
-      do ix=0,nxmin1
-        ww(ix,jy,iz,n)=wdummy
-      end do
-    end do
-
-    if (wind_coord_type.eq.'ETA') then
-      do iz=1,nz
-        wdummy=0.
-        jy=ny-2
-        do ix=0,nxmin1
-          wdummy=wdummy+wweta(ix,jy,iz,n)
-        end do
-        wdummy=wdummy/real(nx)
-        jy=nymin1
-        do ix=0,nxmin1
-          wweta(ix,jy,iz,n)=wdummy
-        end do
-      end do
-    endif
-
-  endif
-
-
-  ! If south pole is in the domain, calculate wind velocities in polar
-  ! stereographic coordinates
-  !*******************************************************************
-
-  if (sglobal) then
-    do iz=1,nz
-      do jy=0,int(switchsouthg)+3
-        ylat=ylat0+real(jy)*dy
-        do ix=0,nxmin1
-          xlon=xlon0+real(ix)*dx
-          call cc2gll(southpolemap,ylat,xlon,uu(ix,jy,iz,n), &
-               vv(ix,jy,iz,n),uupol(ix,jy,iz,n), &
-               vvpol(ix,jy,iz,n))
-          if (wind_coord_type.eq.'ETA') then
-            call cc2gll(southpolemap,ylat,xlon,uueta(ix,jy,iz,n), &
-                 vveta(ix,jy,iz,n),uupoleta(ix,jy,iz,n), &
-                 vvpoleta(ix,jy,iz,n))
-          endif
-        end do
-      end do
-    end do
-
-    do iz=1,nz
-
-  ! CALCULATE FFPOL, DDPOL FOR CENTRAL GRID POINT
-  !
-  !   AMSnauffer Nov 18 2004 Added check for case vv=0
-  !
-      xlon=xlon0+real(nx/2-1)*dx
-      xlonr=xlon*pi/180.
-      ffpol=sqrt(uu(nx/2-1,0,iz,n)**2+ &
-           vv(nx/2-1,0,iz,n)**2)
-      if (vv(nx/2-1,0,iz,n).lt.0.) then
-        ddpol=atan(uu(nx/2-1,0,iz,n)/ &
-             vv(nx/2-1,0,iz,n))+xlonr
-      else if (vv(nx/2-1,0,iz,n).gt.0.) then
-        ddpol=pi+atan(uu(nx/2-1,0,iz,n)/ &
-             vv(nx/2-1,0,iz,n))+xlonr
-      else
-        ddpol=pi/2-xlonr
-      endif
-      if(ddpol.lt.0.) ddpol=2.0*pi+ddpol
-      if(ddpol.gt.2.0*pi) ddpol=ddpol-2.0*pi
-
-  ! CALCULATE U,V FOR 180 DEG, TRANSFORM TO POLAR STEREOGRAPHIC GRID
-      xlon=180.0
-      xlonr=xlon*pi/180.
-      ylat=-90.0
-      uuaux=+ffpol*sin(xlonr-ddpol)
-      vvaux=-ffpol*cos(xlonr-ddpol)
-      call cc2gll(northpolemap,ylat,xlon,uuaux,vvaux,uupolaux, &
-           vvpolaux)
-
-      jy=0
-      do ix=0,nxmin1
-        uupol(ix,jy,iz,n)=uupolaux
-        vvpol(ix,jy,iz,n)=vvpolaux
-      end do
-    end do
-
-    if (wind_coord_type.eq.'ETA') then
-      do iz=1,nz
-  ! CALCULATE FFPOL, DDPOL FOR CENTRAL GRID POINT
-  !
-  !   AMSnauffer Nov 18 2004 Added check for case vv=0
-  !
-        xlon=xlon0+real(nx/2-1)*dx
-        xlonr=xlon*pi/180.
-        ffpol=sqrt(uueta(nx/2-1,0,iz,n)**2+ &
-             vveta(nx/2-1,0,iz,n)**2)
-        if (vveta(nx/2-1,0,iz,n).lt.0.) then
-          ddpol=atan(uueta(nx/2-1,0,iz,n)/ &
-               vveta(nx/2-1,0,iz,n))+xlonr
-        else if (vveta(nx/2-1,0,iz,n).gt.0.) then
-          ddpol=pi+atan(uueta(nx/2-1,0,iz,n)/ &
-               vveta(nx/2-1,0,iz,n))+xlonr
-        else
-          ddpol=pi/2-xlonr
-        endif
-        if(ddpol.lt.0.) ddpol=2.0*pi+ddpol
-        if(ddpol.gt.2.0*pi) ddpol=ddpol-2.0*pi
-
-  ! CALCULATE U,V FOR 180 DEG, TRANSFORM TO POLAR STEREOGRAPHIC GRID
-        xlon=180.0
-        xlonr=xlon*pi/180.
-        ylat=-90.0
-        uuaux=+ffpol*sin(xlonr-ddpol)
-        vvaux=-ffpol*cos(xlonr-ddpol)
-        call cc2gll(northpolemap,ylat,xlon,uuaux,vvaux,uupolaux, &
-             vvpolaux)
-
-        jy=0
-        do ix=0,nxmin1
-          uupoleta(ix,jy,iz,n)=uupolaux
-          vvpoleta(ix,jy,iz,n)=vvpolaux
-        end do
-      end do
-    endif
-
-  ! Fix: Set W at pole to the zonally averaged W of the next equator-
-  ! ward parallel of latitude
-
-    do iz=1,nz
-      wdummy=0.
-      jy=1
-      do ix=0,nxmin1
-        wdummy=wdummy+ww(ix,jy,iz,n)
-      end do
-      wdummy=wdummy/real(nx)
-      jy=0
-      do ix=0,nxmin1
-        ww(ix,jy,iz,n)=wdummy
-      end do
-    end do
-
-    if (wind_coord_type.eq.'ETA') then
-      do iz=1,nz
-        wdummy=0.
-        jy=1
-        do ix=0,nxmin1
-          wdummy=wdummy+wweta(ix,jy,iz,n)
-        end do
-        wdummy=wdummy/real(nx)
-        jy=0
-        do ix=0,nxmin1
-          wweta(ix,jy,iz,n)=wdummy
-        end do
-      end do
-    endif
-  endif
-end subroutine verttransf_ec_stereo
-
-subroutine verttransf_ec_cloud(n,lreadclouds,lsumclouds,nxlim,nylim,clouds_tmp,cloudsh_tmp,&
-  clw_tmp,ctwc_tmp,clwc_tmp,ciwc_tmp,lsprec_tmp,convprec_tmp,rho_tmp,tt_tmp,qv_tmp,uvzlev)
-  use par_mod
-  use com_mod
-  use cmapf_mod, only: cc2gll
-  use qvsat_mod
-
-  implicit none
-
-  logical,intent(in) :: lreadclouds,lsumclouds
-  integer, intent(in) :: nxlim,nylim
-  integer, intent(in) :: n
-  integer(kind=1),intent(inout) :: clouds_tmp(0:nxlim,0:nylim,nzmax)
-  integer,intent(inout) :: cloudsh_tmp(0:nxlim,0:nylim)
-  real,intent(inout) :: clw_tmp(0:nxlim,0:nylim,nzmax)
-  real,intent(inout) :: ctwc_tmp(0:nxlim,0:nylim)
-  real,intent(inout) :: clwc_tmp(0:nxlim,0:nylim,nzmax)
-  real,intent(in) :: ciwc_tmp(0:nxlim,0:nylim,nzmax)
-  real,intent(in) :: lsprec_tmp(0:nxlim,0:nylim),convprec_tmp(0:nxlim,0:nylim)
-  real,intent(in),dimension(0:nxlim,0:nylim,nzmax) :: rho_tmp,tt_tmp,qv_tmp
-  real,intent(out),dimension(0:nxlim,0:nylim,nzmax) :: uvzlev
-
-  integer,dimension(0:nxmax-1,0:nymax-1) :: rain_cloud_above
-
-  integer :: ix,jy,kz,kz_inv
-  real :: pressure,rh,lsp,convp,cloudh_min,prec
-
-!*******************************************************************************
-  if (lreadclouds) then !HG METHOD:
-! loops all grids vertically and constructs the 3D matrix for clouds
-! Cloud top and cloud bottom gid cells are assigned as well as the total column 
-! cloud water. For precipitating grids, the type and whether it is in or below 
-! cloud scavenging are assigned with numbers 2-5 (following the old metod).
-! Distinction is done for lsp and convp though they are treated the same in
-! regards to scavenging. Also clouds that are not precipitating are defined
-! which may be to include future cloud processing by non-precipitating-clouds. 
-!*******************************************************************************
-    !write(*,*) 'Global ECMWF fields: using cloud water'
-    clw_tmp(0:nxlim,0:nylim,:)=0.0
-  !    icloud_stats(:,:,:,n)=0.0
-    ctwc_tmp(:,:)=0.0
-    clouds_tmp(0:nxlim,0:nylim,:)=0
-  ! If water/ice are read separately into clwc and ciwc, store sum in clwc
-    if (.not.lsumclouds) then 
-      clwc_tmp(0:nxlim,0:nylim,:) = clwc_tmp(0:nxlim,0:nylim,:) + ciwc_tmp(:,:,:)
-    end if
-    do jy=0,nylim
-      do ix=0,nxlim
-        lsp=lsprec_tmp(ix,jy)
-        convp=convprec_tmp(ix,jy)
-        prec=lsp+convp
-  !        tot_cloud_h=0
-  ! Find clouds in the vertical
-        do kz=1, nz-1 !go from top to bottom
-          if (clwc_tmp(ix,jy,kz).gt.0) then      
-  ! assuming rho is in kg/m3 and hz in m gives: kg/kg * kg/m3 *m3/kg /m = m2/m3
-            if (wind_coord_type.eq.'ETA') then
-              clw_tmp(ix,jy,kz)=(clwc_tmp(ix,jy,kz)*rho_tmp(ix,jy,kz))* &
-                (uvzlev(ix,jy,kz+1)-uvzlev(ix,jy,kz))
-              cloudh_min=min(uvzlev(ix,jy,kz+1),uvzlev(ix,jy,kz))
-            else
-              clw_tmp(ix,jy,kz)= (clwc_tmp(ix,jy,kz)*rho_tmp(ix,jy,kz))* &
-                (height(kz+1)-height(kz))
-  !           icloud_stats(ix,jy,3,n)= min(height(kz+1),height(kz))
-                       ! Cloud BOT height stats      [m]
-              cloudh_min=min(height(kz+1),height(kz))
-            endif
-  !            tot_cloud_h=tot_cloud_h+(height(kz+1)-height(kz)) 
-            
-  !            icloud_stats(ix,jy,4,n)= icloud_stats(ix,jy,4,n)+clw(ix,jy,kz,n) 
-           ! Column cloud water [m3/m3]
-            ctwc_tmp(ix,jy) = ctwc_tmp(ix,jy)+clw_tmp(ix,jy,kz)
-
-          endif
-        end do
-
-  ! If Precipitation. Define removal type in the vertical
-        if ((lsp.gt.0.01).or.(convp.gt.0.01)) then ! cloud and precipitation
-
-          do kz=nz,2,-1 !go Bottom up!
-            if (clw_tmp(ix,jy,kz).gt. 0) then ! is in cloud
-              if (wind_coord_type.eq.'ETA') then
-                cloudsh_tmp(ix,jy)=cloudsh_tmp(ix,jy)+ &
-                uvzlev(ix,jy,kz)-uvzlev(ix,jy,kz-1) 
-              else
-                cloudsh_tmp(ix,jy)=cloudsh_tmp(ix,jy)+height(kz)-height(kz-1) 
-              endif
-              clouds_tmp(ix,jy,kz)=1                               ! is a cloud
-              if (lsp.ge.convp) then
-                clouds_tmp(ix,jy,kz)=3                            ! lsp in-cloud
-              else
-                clouds_tmp(ix,jy,kz)=2          ! convp in-cloud
-              endif                             ! convective or large scale
-            elseif (clw_tmp(ix,jy,kz).le.0 .and. cloudh_min.ge.height(kz)) then 
-            ! is below cloud
-              if (lsp.ge.convp) then
-                clouds_tmp(ix,jy,kz)=5          ! lsp dominated washout
-              else
-                clouds_tmp(ix,jy,kz)=4          ! convp dominated washout
-              endif                             ! convective or large scale 
-            endif
-
-            if (height(kz).ge. 19000) then      ! set a max height for removal
-              clouds_tmp(ix,jy,kz)=0
-            endif !clw>0
-          end do !nz
-        endif ! precipitation
-      end do
-    end do
-
-  ! eso: copy the relevant data to clw4 to reduce amount of communicated data for MPI
-  !    ctwc(:,:,n) = icloud_stats(:,:,4,n)
-
-  !**************************************************************************
-  else       ! use old definitions
-  !**************************************************************************
-  !   create a cloud and rainout/washout field, clouds occur where rh>80%
-  !   total cloudheight is stored at level 0
-    !write(*,*) 'Global fields: using cloud water from Parameterization'
-    do jy=0,nylim
-      do ix=0,nxlim
-  ! OLD METHOD
-        rain_cloud_above(ix,jy)=0
-        lsp=lsprec_tmp(ix,jy)
-        convp=convprec_tmp(ix,jy)
-        cloudsh_tmp(ix,jy)=0
-        do kz_inv=1,nz-1
-          kz=nz-kz_inv+1
-          pressure=rho_tmp(ix,jy,kz)*r_air*tt_tmp(ix,jy,kz)
-          rh=qv_tmp(ix,jy,kz)/f_qvsat(pressure,tt_tmp(ix,jy,kz))
-          clouds_tmp(ix,jy,kz)=0
-          if (rh.gt.0.8) then ! in cloud
-            if ((lsp.gt.0.01).or.(convp.gt.0.01)) then ! cloud and precipitation
-              rain_cloud_above(ix,jy)=1
-              if (wind_coord_type.eq.'ETA') then
-                cloudsh_tmp(ix,jy)=cloudsh_tmp(ix,jy)+ &
-                     uvzlev(ix,jy,kz)-uvzlev(ix,jy,kz-1)              
-              else
-                cloudsh_tmp(ix,jy)=cloudsh_tmp(ix,jy)+ &
-                     height(kz)-height(kz-1)
-              endif
-              if (lsp.ge.convp) then
-                clouds_tmp(ix,jy,kz)=3 ! lsp dominated rainout
-              else
-                clouds_tmp(ix,jy,kz)=2 ! convp dominated rainout
-              endif
-            else ! no precipitation
-              clouds_tmp(ix,jy,kz)=1 ! cloud
-            endif
-          else ! no cloud
-            if (rain_cloud_above(ix,jy).eq.1) then ! scavenging
-              if (lsp.ge.convp) then
-                clouds_tmp(ix,jy,kz)=5 ! lsp dominated washout
-              else
-                clouds_tmp(ix,jy,kz)=4 ! convp dominated washout
-              endif
-            endif
-          endif
-        end do
-  !END OLD METHOD
-      end do
-    end do
-  endif !readclouds
-  
-end subroutine verttransf_ec_cloud
-
-subroutine verttransform_gfs(n,uuh,vvh,wwh,pvh)
-  !                      i  i   i   i   i
-  
-  !*****************************************************************************
-  !                                                                            *
-  !     This subroutine transforms temperature, dew point temperature and      *
-  !     wind components from eta to meter coordinates.                         *
-  !     The vertical wind component is transformed from Pa/s to m/s using      *
-  !     the conversion factor pinmconv.                                        *
-  !     In addition, this routine calculates vertical density gradients        *
-  !     needed for the parameterization of the turbulent velocities.           *
-  !                                                                            *
-  !     Author: A. Stohl, G. Wotawa                                            *
-  !                                                                            *
-  !     12 August 1996                                                         *
-  !     Update: 16 January 1998                                                *
-  !                                                                            *
-  !     Major update: 17 February 1999                                         *
-  !     by G. Wotawa                                                           *
-  !     CHANGE 17/11/2005 Caroline Forster, NCEP GFS version                   *
-  !                                                                            *
-  !   - Vertical levels for u, v and w are put together                        *
-  !   - Slope correction for vertical velocity: Modification of calculation    *
-  !     procedure                                                              *
-  !                                                                            *
-  !*****************************************************************************
-  !  Changes, Bernd C. Krueger, Feb. 2001:
-  !   Variables tth and qvh (on eta coordinates) from common block
-  !
-  !   Unified ECMWF and GFS builds                                      
-  !   Marian Harustak, 12.5.2017                                        
-  !     - Renamed routine from verttransform to verttransform_gfs
-  !
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! nx,ny,nz                        field dimensions in x,y and z direction    *
-  ! uu(0:nxmax,0:nymax,nzmax,2)     wind components in x-direction [m/s]       *
-  ! vv(0:nxmax,0:nymax,nzmax,2)     wind components in y-direction [m/s]       *
-  ! ww(0:nxmax,0:nymax,nzmax,2)     wind components in z-direction [deltaeta/s]*
-  ! tt(0:nxmax,0:nymax,nzmax,2)     temperature [K]                            *
-  ! pv(0:nxmax,0:nymax,nzmax,2)     potential voriticity (pvu)                 *
-  ! ps(0:nxmax,0:nymax,2)           surface pressure [Pa]                      *
-  ! clouds(0:nxmax,0:nymax,0:nzmax,2) cloud field for wet deposition           *
-  !                                                                            *
-  !*****************************************************************************
-
-  use par_mod
-  use com_mod
-  use cmapf_mod
-  use qvsat_mod
-
-  implicit none
-
-  integer :: ix,jy,kz,iz,n,kmin,kl,klp,ix1,jy1,ixp,jyp,ixm,jym
-  integer :: rain_cloud_above,kz_inv
-  real :: pressure
-  real :: rh,lsp,cloudh_min,convp,prec
-  real :: rhoh(nuvzmax),pinmconv(nzmax)
-  real :: pint,tv,tvold,pold,dz1,dz2,dz,ui,vi
-  real :: xlon,ylat,xlonr,dzdx,dzdy
-  real :: dzdx1,dzdx2,dzdy1,dzdy2,cosf
-  real :: uuaux,vvaux,uupolaux,vvpolaux,ddpol,ffpol,wdummy
-  real :: uuh(0:nxmax-1,0:nymax-1,nuvzmax)
-  real :: vvh(0:nxmax-1,0:nymax-1,nuvzmax)
-  real :: pvh(0:nxmax-1,0:nymax-1,nuvzmax)
-  real :: wwh(0:nxmax-1,0:nymax-1,nwzmax)
-  real :: wzlev(nwzmax),uvwzlev(0:nxmax-1,0:nymax-1,nzmax)
-  real,parameter :: const=r_air/ga
-
-  ! NCEP version
-  integer :: llev, i
-
-  logical :: init = .true.
-
-
-  !*************************************************************************
-  ! If verttransform is called the first time, initialize heights of the   *
-  ! z levels in meter. The heights are the heights of model levels, where  *
-  ! u,v,T and qv are given.                                                *
-  !*************************************************************************
-
-  if (init) then
-
-  ! Search for a point with high surface pressure (i.e. not above significant topography)
-  ! Then, use this point to construct a reference z profile, to be used at all times
-  !*****************************************************************************
-    call vertransf_init(n)
-  
-  ! Do not repeat initialization of the Cartesian z grid
-  !*****************************************************
-
-    init=.false.
-
-  endif
-
-
-  ! Loop over the whole grid
-  !*************************
-
-  do jy=0,nymin1
-    do ix=0,nxmin1
-
-  ! NCEP version: find first level above ground
-      llev = 0
-      do i=1,nuvz
-        if (ps(ix,jy,1,n).lt.akz(i)) llev=i
-      end do
-       llev = llev+1
-       if (llev.gt.nuvz-2) llev = nuvz-2
-  !     if (llev.eq.nuvz-2) write(*,*) 'verttransform
-  !    +WARNING: LLEV eq NUZV-2'
-  ! NCEP version
-
-
-  ! compute height of pressure levels above ground
-  !***********************************************
-
-      tvold=tth(ix,jy,llev,n)*(1.+0.608*qvh(ix,jy,llev,n))
-      pold=akz(llev)
-      wzlev(llev)=0.
-      uvwzlev(ix,jy,llev)=0.
-      rhoh(llev)=pold/(r_air*tvold)
-
-      do kz=llev+1,nuvz
-        pint=akz(kz)+bkz(kz)*ps(ix,jy,1,n)
-        tv=tth(ix,jy,kz,n)*(1.+0.608*qvh(ix,jy,kz,n))
-        rhoh(kz)=pint/(r_air*tv)
-
-        if (abs(tv-tvold).gt.0.2) then
-          uvwzlev(ix,jy,kz)=uvwzlev(ix,jy,kz-1)+const*log(pold/pint)* &
-          (tv-tvold)/log(tv/tvold)
-        else
-          uvwzlev(ix,jy,kz)=uvwzlev(ix,jy,kz-1)+const*log(pold/pint)*tv
-        endif
-        wzlev(kz)=uvwzlev(ix,jy,kz)
-
-        tvold=tv
-        pold=pint
-      end do
-
-  ! pinmconv=(h2-h1)/(p2-p1)
-
-      pinmconv(llev)=(uvwzlev(ix,jy,llev+1)-uvwzlev(ix,jy,llev))/ &
-           ((aknew(llev+1)+bknew(llev+1)*ps(ix,jy,1,n))- &
-           (aknew(llev)+bknew(llev)*ps(ix,jy,1,n)))
-      do kz=llev+1,nz-1
-        pinmconv(kz)=(uvwzlev(ix,jy,kz+1)-uvwzlev(ix,jy,kz-1))/ &
-             ((aknew(kz+1)+bknew(kz+1)*ps(ix,jy,1,n))- &
-             (aknew(kz-1)+bknew(kz-1)*ps(ix,jy,1,n)))
-      end do
-      pinmconv(nz)=(uvwzlev(ix,jy,nz)-uvwzlev(ix,jy,nz-1))/ &
-           ((aknew(nz)+bknew(nz)*ps(ix,jy,1,n))- &
-           (aknew(nz-1)+bknew(nz-1)*ps(ix,jy,1,n)))
-
-
-  ! Levels, where u,v,t and q are given
-  !************************************
-
-      uu(ix,jy,1,n)=uuh(ix,jy,llev)
-      vv(ix,jy,1,n)=vvh(ix,jy,llev)
-      tt(ix,jy,1,n)=tth(ix,jy,llev,n)
-      qv(ix,jy,1,n)=qvh(ix,jy,llev,n)
-  ! IP & SEC, 201812 add clouds
-      if (readclouds) then
-         clwc(ix,jy,1,n)=clwch(ix,jy,llev,n)
-      endif 
-      pv(ix,jy,1,n)=pvh(ix,jy,llev)
-      rho(ix,jy,1,n)=rhoh(llev)
-      pplev(ix,jy,1,n)=akz(llev)
-      uu(ix,jy,nz,n)=uuh(ix,jy,nuvz)
-      vv(ix,jy,nz,n)=vvh(ix,jy,nuvz)
-      tt(ix,jy,nz,n)=tth(ix,jy,nuvz,n)
-      qv(ix,jy,nz,n)=qvh(ix,jy,nuvz,n)
-  ! IP & SEC, 201812 add clouds
-      if (readclouds) then
-         clwc(ix,jy,nz,n)=clwch(ix,jy,nuvz,n)
-      endif
-      pv(ix,jy,nz,n)=pvh(ix,jy,nuvz)
-      rho(ix,jy,nz,n)=rhoh(nuvz)
-      pplev(ix,jy,nz,n)=akz(nuvz)
-      kmin=llev+1
-      do iz=2,nz-1
-        do kz=kmin,nuvz
-          if(height(iz).gt.uvwzlev(ix,jy,nuvz)) then
-            uu(ix,jy,iz,n)=uu(ix,jy,nz,n)
-            vv(ix,jy,iz,n)=vv(ix,jy,nz,n)
-            tt(ix,jy,iz,n)=tt(ix,jy,nz,n)
-            qv(ix,jy,iz,n)=qv(ix,jy,nz,n)
-  ! IP & SEC, 201812 add clouds
-            if (readclouds) then
-               clwc(ix,jy,iz,n)=clwc(ix,jy,nz,n)
-            endif
-            pv(ix,jy,iz,n)=pv(ix,jy,nz,n)
-            rho(ix,jy,iz,n)=rho(ix,jy,nz,n)
-            pplev(ix,jy,iz,n)=pplev(ix,jy,nz,n)
-            exit
-          endif
-          if ((height(iz).gt.uvwzlev(ix,jy,kz-1)).and. &
-          (height(iz).le.uvwzlev(ix,jy,kz))) then
-            dz1=height(iz)-uvwzlev(ix,jy,kz-1)
-            dz2=uvwzlev(ix,jy,kz)-height(iz)
-            dz=dz1+dz2
-            uu(ix,jy,iz,n)=(uuh(ix,jy,kz-1)*dz2+uuh(ix,jy,kz)*dz1)/dz
-            vv(ix,jy,iz,n)=(vvh(ix,jy,kz-1)*dz2+vvh(ix,jy,kz)*dz1)/dz
-            tt(ix,jy,iz,n)=(tth(ix,jy,kz-1,n)*dz2 &
-            +tth(ix,jy,kz,n)*dz1)/dz
-            qv(ix,jy,iz,n)=(qvh(ix,jy,kz-1,n)*dz2 &
-            +qvh(ix,jy,kz,n)*dz1)/dz
-  ! IP & SEC, 201812 add clouds
-            if (readclouds) then
-               clwc(ix,jy,iz,n)=(clwch(ix,jy,kz-1,n)*dz2 &
-               +clwch(ix,jy,kz,n)*dz1)/dz
-            endif
-            pv(ix,jy,iz,n)=(pvh(ix,jy,kz-1)*dz2+pvh(ix,jy,kz)*dz1)/dz
-            rho(ix,jy,iz,n)=(rhoh(kz-1)*dz2+rhoh(kz)*dz1)/dz
-            pplev(ix,jy,iz,n)=(akz(kz-1)*dz2+akz(kz)*dz1)/dz
-          endif
-        end do
-      end do
-
-
-  ! Levels, where w is given
-  !*************************
-
-      ww(ix,jy,1,n)=wwh(ix,jy,llev)*pinmconv(llev)
-      ww(ix,jy,nz,n)=wwh(ix,jy,nwz)*pinmconv(nz)
-      kmin=llev+1
-      do iz=2,nz
-        do kz=kmin,nwz
-          if ((height(iz).gt.wzlev(kz-1)).and. &
-          (height(iz).le.wzlev(kz))) then
-            dz1=height(iz)-wzlev(kz-1)
-            dz2=wzlev(kz)-height(iz)
-            dz=dz1+dz2
-            ww(ix,jy,iz,n)=(wwh(ix,jy,kz-1)*pinmconv(kz-1)*dz2 &
-            +wwh(ix,jy,kz)*pinmconv(kz)*dz1)/dz
-          endif
-        end do
-      end do
-
-
-  ! Compute density gradients at intermediate levels
-  !*************************************************
-
-      drhodz(ix,jy,1,n)=(rho(ix,jy,2,n)-rho(ix,jy,1,n))/ &
-           (height(2)-height(1))
-      do kz=2,nz-1
-        drhodz(ix,jy,kz,n)=(rho(ix,jy,kz+1,n)-rho(ix,jy,kz-1,n))/ &
-        (height(kz+1)-height(kz-1))
-      end do
-      drhodz(ix,jy,nz,n)=drhodz(ix,jy,nz-1,n)
-
-    end do
-  end do
-
-
-  !****************************************************************
-  ! Compute slope of eta levels in windward direction and resulting
-  ! vertical wind correction
-  !****************************************************************
-
-  do jy=1,ny-2
-    cosf=cos((real(jy)*dy+ylat0)*pi180)
-    do ix=1,nx-2
-
-  ! NCEP version: find first level above ground
-      llev = 0
-      do i=1,nuvz
-       if (ps(ix,jy,1,n).lt.akz(i)) llev=i
-      end do
-       llev = llev+1
-       if (llev.gt.nuvz-2) llev = nuvz-2
-  !     if (llev.eq.nuvz-2) write(*,*) 'verttransform
-  !    +WARNING: LLEV eq NUZV-2'
-  ! NCEP version
-
-      kmin=llev+1
-      do iz=2,nz-1
-
-        ui=uu(ix,jy,iz,n)*dxconst/cosf
-        vi=vv(ix,jy,iz,n)*dyconst
-
-        do kz=kmin,nz
-          if ((height(iz).gt.uvwzlev(ix,jy,kz-1)).and. &
-          (height(iz).le.uvwzlev(ix,jy,kz))) then
-            dz1=height(iz)-uvwzlev(ix,jy,kz-1)
-            dz2=uvwzlev(ix,jy,kz)-height(iz)
-            dz=dz1+dz2
-            kl=kz-1
-            klp=kz
-            exit
-          endif
-        end do
-
-        ix1=ix-1
-        jy1=jy-1
-        ixp=ix+1
-        jyp=jy+1
-
-        dzdx1=(uvwzlev(ixp,jy,kl)-uvwzlev(ix1,jy,kl))/2.
-        dzdx2=(uvwzlev(ixp,jy,klp)-uvwzlev(ix1,jy,klp))/2.
-        dzdx=(dzdx1*dz2+dzdx2*dz1)/dz
-
-        dzdy1=(uvwzlev(ix,jyp,kl)-uvwzlev(ix,jy1,kl))/2.
-        dzdy2=(uvwzlev(ix,jyp,klp)-uvwzlev(ix,jy1,klp))/2.
-        dzdy=(dzdy1*dz2+dzdy2*dz1)/dz
-
-        ww(ix,jy,iz,n)=ww(ix,jy,iz,n)+(dzdx*ui+dzdy*vi)
-
-      end do
-
-    end do
-  end do
-
-
-  ! If north pole is in the domain, calculate wind velocities in polar
-  ! stereographic coordinates
-  !*******************************************************************
-
-  if (nglobal) then
-    do jy=int(switchnorthg)-2,nymin1
-      ylat=ylat0+real(jy)*dy
-      do ix=0,nxmin1
-        xlon=xlon0+real(ix)*dx
-        do iz=1,nz
-          call cc2gll(northpolemap,ylat,xlon,uu(ix,jy,iz,n), &
-               vv(ix,jy,iz,n),uupol(ix,jy,iz,n), &
-               vvpol(ix,jy,iz,n))
-        end do
-      end do
-    end do
-
-
-    do iz=1,nz
-
-  ! CALCULATE FFPOL, DDPOL FOR CENTRAL GRID POINT
-      xlon=xlon0+real(nx/2-1)*dx
-      xlonr=xlon*pi/180.
-      ffpol=sqrt(uu(nx/2-1,nymin1,iz,n)**2+vv(nx/2-1,nymin1,iz,n)**2)
-      if (vv(nx/2-1,nymin1,iz,n).lt.0.) then
-        ddpol=atan(uu(nx/2-1,nymin1,iz,n)/vv(nx/2-1,nymin1,iz,n))-xlonr
-      elseif (vv(nx/2-1,nymin1,iz,n).gt.0.) then
-        ddpol=pi+atan(uu(nx/2-1,nymin1,iz,n)/ &
-        vv(nx/2-1,nymin1,iz,n))-xlonr
-      else
-        ddpol=pi/2-xlonr
-      endif
-      if(ddpol.lt.0.) ddpol=2.0*pi+ddpol
-      if(ddpol.gt.2.0*pi) ddpol=ddpol-2.0*pi
-
-  ! CALCULATE U,V FOR 180 DEG, TRANSFORM TO POLAR STEREOGRAPHIC GRID
-      xlon=180.0
-      xlonr=xlon*pi/180.
-      ylat=90.0
-      uuaux=-ffpol*sin(xlonr+ddpol)
-      vvaux=-ffpol*cos(xlonr+ddpol)
-      call cc2gll(northpolemap,ylat,xlon,uuaux,vvaux,uupolaux,vvpolaux)
-      jy=nymin1
-      do ix=0,nxmin1
-        uupol(ix,jy,iz,n)=uupolaux
-        vvpol(ix,jy,iz,n)=vvpolaux
-      end do
-    end do
-
-
-  ! Fix: Set W at pole to the zonally averaged W of the next equator-
-  ! ward parallel of latitude
-
-    do iz=1,nz
-      wdummy=0.
-      jy=ny-2
-      do ix=0,nxmin1
-        wdummy=wdummy+ww(ix,jy,iz,n)
-      end do
-      wdummy=wdummy/real(nx)
-      jy=nymin1
-      do ix=0,nxmin1
-        ww(ix,jy,iz,n)=wdummy
-      end do
-    end do
-
-  endif
-
-
-  ! If south pole is in the domain, calculate wind velocities in polar
-  ! stereographic coordinates
-  !*******************************************************************
-
-  if (sglobal) then
-    do jy=0,int(switchsouthg)+3
-      ylat=ylat0+real(jy)*dy
-      do ix=0,nxmin1
-        xlon=xlon0+real(ix)*dx
-        do iz=1,nz
-          call cc2gll(southpolemap,ylat,xlon,uu(ix,jy,iz,n), &
-          vv(ix,jy,iz,n),uupol(ix,jy,iz,n),vvpol(ix,jy,iz,n))
-        end do
-      end do
-    end do
-
-    do iz=1,nz
-
-  ! CALCULATE FFPOL, DDPOL FOR CENTRAL GRID POINT
-      xlon=xlon0+real(nx/2-1)*dx
-      xlonr=xlon*pi/180.
-      ffpol=sqrt(uu(nx/2-1,0,iz,n)**2+vv(nx/2-1,0,iz,n)**2)
-      if(vv(nx/2-1,0,iz,n).lt.0.) then
-        ddpol=atan(uu(nx/2-1,0,iz,n)/vv(nx/2-1,0,iz,n))+xlonr
-      elseif (vv(nx/2-1,0,iz,n).gt.0.) then
-        ddpol=pi+atan(uu(nx/2-1,0,iz,n)/vv(nx/2-1,0,iz,n))-xlonr
-      else
-        ddpol=pi/2-xlonr
-      endif
-      if(ddpol.lt.0.) ddpol=2.0*pi+ddpol
-      if(ddpol.gt.2.0*pi) ddpol=ddpol-2.0*pi
-
-  ! CALCULATE U,V FOR 180 DEG, TRANSFORM TO POLAR STEREOGRAPHIC GRID
-      xlon=180.0
-      xlonr=xlon*pi/180.
-      ylat=-90.0
-      uuaux=+ffpol*sin(xlonr-ddpol)
-      vvaux=-ffpol*cos(xlonr-ddpol)
-      call cc2gll(northpolemap,ylat,xlon,uuaux,vvaux,uupolaux,vvpolaux)
-
-      jy=0
-      do ix=0,nxmin1
-        uupol(ix,jy,iz,n)=uupolaux
-        vvpol(ix,jy,iz,n)=vvpolaux
-      end do
-    end do
-
-
-  ! Fix: Set W at pole to the zonally averaged W of the next equator-
-  ! ward parallel of latitude
-
-    do iz=1,nz
-      wdummy=0.
-      jy=1
-      do ix=0,nxmin1
-        wdummy=wdummy+ww(ix,jy,iz,n)
-      end do
-      wdummy=wdummy/real(nx)
-      jy=0
-      do ix=0,nxmin1
-        ww(ix,jy,iz,n)=wdummy
-      end do
-    end do
-  endif
-
-  !*****************************************************************************
-  ! IP & SEC, 201812 GFS clouds read
-  if (readclouds) then
-! loops all grids vertically and constructs the 3D matrix for clouds
-! Cloud top and cloud bottom gid cells are assigned as well as the total column
-! cloud water. For precipitating grids, the type and whether it is in or below
-! cloud scavenging are assigned with numbers 2-5 (following the old metod).
-! Distinction is done for lsp and convp though they are treated the same in 
-! regards to scavenging. Also clouds that are not precipitating are defined 
-! which may be to include future cloud processing by non-precipitating-clouds.
-!*****************************************************************************
-    write(*,*) 'Global NCEP fields: using cloud water'
-    clw(:,:,:,n)=0.0
-    ctwc(:,:,n)=0.0
-    clouds(:,:,:,n)=0
-  ! If water/ice are read separately into clwc and ciwc, store sum in clwc
-    do jy=0,nymin1
-      do ix=0,nxmin1
-        lsp=lsprec(ix,jy,1,n)
-        convp=convprec(ix,jy,1,n)
-        prec=lsp+convp
-  ! Find clouds in the vertical
-        do kz=1, nz-1 !go from top to bottom
-          if (clwc(ix,jy,kz,n).gt.0) then
-  ! assuming rho is in kg/m3 and hz in m gives: kg/kg * kg/m3 *m3/kg /m = m2/m3
-            clw(ix,jy,kz,n)=(clwc(ix,jy,kz,n)*rho(ix,jy,kz,n))* &
-              (height(kz+1)-height(kz))
-            ctwc(ix,jy,n) = ctwc(ix,jy,n)+clw(ix,jy,kz,n)
-            cloudh_min=min(height(kz+1),height(kz))
-          endif
-        end do
-
-  ! If Precipitation. Define removal type in the vertical
-        if ((lsp.gt.0.01).or.(convp.gt.0.01)) then ! cloud and precipitation
-
-          do kz=nz,2,-1 !go Bottom up!
-            if (clw(ix,jy,kz,n).gt. 0) then ! is in cloud
-              cloudsh(ix,jy,n)=cloudsh(ix,jy,n)+height(kz)-height(kz-1)
-              clouds(ix,jy,kz,n)=1               ! is a cloud
-              if (lsp.ge.convp) then
-                clouds(ix,jy,kz,n)=3             ! lsp in-cloud
-              else
-                clouds(ix,jy,kz,n)=2             ! convp in-cloud
-              endif                              ! convective or large scale
-            elseif((clw(ix,jy,kz,n).le.0) .and. (cloudh_min.ge.height(kz))) then
-             ! is below cloud
-              if (lsp.ge.convp) then
-                clouds(ix,jy,kz,n)=5             ! lsp dominated washout
-              else
-                clouds(ix,jy,kz,n)=4             ! convp dominated washout
-              endif                              ! convective or large scale
-            endif
-
-            if (height(kz).ge. 19000) then        ! set a max height for removal
-              clouds(ix,jy,kz,n)=0
-            endif !clw>0
-          end do !nz
-        endif ! precipitation
-      end do
-    end do
-  else
-  write(*,*) 'Global NCEP fields: using cloud water from Parameterization'
-  !   write (*,*) 'initializing clouds, n:',n,nymin1,nxmin1,nz
-  !   create a cloud and rainout/washout field, clouds occur where rh>80%
-  !   total cloudheight is stored at level 0
-  do jy=0,nymin1
-    do ix=0,nxmin1
-      rain_cloud_above=0
-      lsp=lsprec(ix,jy,1,n)
-      convp=convprec(ix,jy,1,n)
-      cloudsh(ix,jy,n)=0
-      do kz_inv=1,nz-1
-         kz=nz-kz_inv+1
-         pressure=rho(ix,jy,kz,n)*r_air*tt(ix,jy,kz,n)
-         rh=qv(ix,jy,kz,n)/f_qvsat(pressure,tt(ix,jy,kz,n))
-         clouds(ix,jy,kz,n)=0
-         if (rh.gt.0.8) then ! in cloud
-           if ((lsp.gt.0.01).or.(convp.gt.0.01)) then ! cloud and precipitation
-              rain_cloud_above=1
-              cloudsh(ix,jy,n)=cloudsh(ix,jy,n)+height(kz)-height(kz-1)
-              if (lsp.ge.convp) then
-                 clouds(ix,jy,kz,n)=3 ! lsp dominated rainout
-              else
-                 clouds(ix,jy,kz,n)=2 ! convp dominated rainout
-              endif
-           else ! no precipitation
-             clouds(ix,jy,kz,n)=1 ! cloud
-           endif
-         else ! no cloud
-           if (rain_cloud_above.eq.1) then ! scavenging
-             if (lsp.ge.convp) then
-               clouds(ix,jy,kz,n)=5 ! lsp dominated washout
-             else
-               clouds(ix,jy,kz,n)=4 ! convp dominated washout
-             endif
-           endif
-         endif
-      end do
-    end do
-  end do
-  endif  ! IP & SEC 201812, GFS clouds read
-
-end subroutine verttransform_gfs
-
-subroutine verttransf_ec_height(nxlim,nylim, &
-
-  tt2_tmp,td2_tmp,ps_tmp,qvh_tmp,tth_tmp,prsh_tmp, &
-  rhoh_tmp,pinmconv,uvzlev,wzlev)
-  use par_mod
-  use com_mod
-  use qvsat_mod
-
-  implicit none
-
-  integer, intent(in) :: nxlim,nylim
-  real,intent(in),dimension(0:nxlim,0:nylim) :: tt2_tmp,td2_tmp,ps_tmp
-  real,intent(in),dimension(0:nxlim,0:nylim,nuvzmax) :: qvh_tmp,tth_tmp
-  real,intent(out),dimension(0:nxlim,0:nylim,nuvzmax) :: rhoh_tmp,prsh_tmp
-  real,intent(out),dimension(0:nxlim,0:nylim,nzmax) :: pinmconv
-  real,intent(out),dimension(0:nxlim,0:nylim,nuvzmax) :: uvzlev,wzlev
-  real,dimension(0:nxlim,0:nylim) :: tvold,pold,pint,tv
-  real,parameter :: const=r_air/ga
-  integer :: ix,jy,kz
-  integer :: nxm1,nym1
-
-  ! Loop over the whole grid
-  !*************************
-
-  do jy=0,nylim
-    do ix=0,nxlim
-      tvold(ix,jy)=tt2_tmp(ix,jy)*(1.+0.378*ew(td2_tmp(ix,jy),ps_tmp(ix,jy))/ &
-           ps_tmp(ix,jy))
-    end do
-  end do
-
-  pold(:,:)=ps_tmp(:,:)
-  uvzlev(:,:,1)=0.
-  wzlev(:,:,1)=0.
-  rhoh_tmp(:,:,1)=pold(:,:)/(r_air*tvold(:,:))
-  prsh_tmp(:,:,1)=ps_tmp(:,:)
-
-  ! Compute heights of eta levels
-  !******************************
-
-  do kz=2,nuvz
-    pint(:,:)=akz(kz)+bkz(kz)*ps_tmp(:,:)
-    prsh_tmp(:,:,kz)=pint(:,:)
-    tv(:,:)=tth_tmp(:,:,kz)*(1.+0.608*qvh_tmp(:,:,kz))
-    rhoh_tmp(:,:,kz)=pint(:,:)/(r_air*tv(:,:))
-
-    where (abs(tv(:,:)-tvold(:,:)).gt.0.2) 
-      uvzlev(:,:,kz)=uvzlev(:,:,kz-1)+const*&
-           &log(pold(:,:)/pint(:,:))* &
-           (tv(:,:)-tvold(:,:))/&
-           &log(tv(:,:)/tvold(:,:))
-    elsewhere
-      uvzlev(:,:,kz)=uvzlev(:,:,kz-1)+const*&
-           &log(pold(:,:)/pint(:,:))*tv(:,:)
-    endwhere
-
-    tvold(:,:)=tv(:,:)
-    pold(:,:)=pint(:,:)
-
-  end do
-
-  do kz=2,nwz-1
-    wzlev(:,:,kz)=(uvzlev(:,:,kz+1)+uvzlev(:,:,kz))/2.
-  end do
-  wzlev(:,:,nwz)=wzlev(:,:,nwz-1)+ uvzlev(:,:,nuvz)-uvzlev(:,:,nuvz-1)
-
-
-  pinmconv(:,:,1)=(uvzlev(:,:,2))/ &
-       ((aknew(2)+bknew(2)*ps_tmp(:,:))- &
-        (aknew(1)+bknew(1)*ps_tmp(:,:)))
-  do kz=2,nz-1
-    pinmconv(:,:,kz)=(uvzlev(:,:,kz+1)-uvzlev(:,:,kz-1))/ &
-         ((aknew(kz+1)+bknew(kz+1)*ps_tmp(:,:))- &
-          (aknew(kz-1)+bknew(kz-1)*ps_tmp(:,:)))
-  end do
-  pinmconv(:,:,nz)=(uvzlev(:,:,nz)-uvzlev(:,:,nz-1))/ &
-       ((aknew(nz)+bknew(nz)*ps_tmp(:,:))- &
-        (aknew(nz-1)+bknew(nz-1)*ps_tmp(:,:)))
-
-end subroutine verttransf_ec_height
-
-subroutine verttransf_ec_windf_nest(l,n, &
-
-  uuhn,vvhn,wwhn,pvhn,rhohn,prshn,pinmconv)
-  use par_mod
-  use com_mod
-  use qvsat_mod
-
-  implicit none
-
-  integer,intent(in) :: l,n
-  real,intent(in),dimension(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests) :: &
-    uuhn,vvhn,pvhn
-  real,intent(in),dimension(0:nxmaxn-1,0:nymaxn-1,nwzmax,maxnests) :: wwhn
-  real,intent(in),dimension(0:nxmaxn-1,0:nymaxn-1,nuvzmax) :: rhohn
-  real,intent(in),dimension(0:nxmaxn-1,0:nymaxn-1,nuvzmax) :: prshn
-  real,intent(in),dimension(0:nxmaxn-1,0:nymaxn-1,nzmax) :: pinmconv
-  real,dimension(0:nymaxn-1) :: cosf
-
-  integer,dimension(0:nxmaxn-1,0:nymaxn-1) :: rain_cloud_above, idx
-
-  integer :: ix,jy,kz,iz,kmin,kl,klp,ix1,jy1,ixp,jyp,kz_inv
-  real :: pressure,rh,lsp,convp,cloudh_min,prec
-
-  real :: dz1,dz2,dz,dpdeta
-  real :: dzdx,dzdy
-  real :: dzdx1,dzdx2,dzdy1,dzdy2
-  real :: tot_cloud_h
-  integer :: nxm1, nym1
-
-  nxm1=nxn(l)-1 
-  nym1=nyn(l)-1 
-
-  ! Levels, where u,v,t and q are given
-  !************************************
-!$OMP PARALLEL PRIVATE(jy,ix,kz,dz1,dz2,dz,ix1,jy1,ixp,jyp,dzdx1,dzdx2,dzdx, &
-!$OMP   dzdy1,dzdy2,dzdy,dpdeta)
-
-!$OMP DO
-  do jy=0,nym1
-    do ix=0,nxm1
-      uun(ix,jy,1,n,l)=uuhn(ix,jy,1,l)
-      vvn(ix,jy,1,n,l)=vvhn(ix,jy,1,l)
-      ttn(ix,jy,1,n,l)=tthn(ix,jy,1,n,l)
-      if (wind_coord_type.ne.'ETA') then 
-        qvn(ix,jy,1,n,l)=qvhn(ix,jy,1,n,l)
-      endif
-      if (readclouds_nest(l)) then
-        clwcn(ix,jy,1,n,l)=clwchn(ix,jy,1,n,l)
-        if (.not.sumclouds_nest(l)) ciwcn(ix,jy,1,n,l)=ciwchn(ix,jy,1,n,l)
-      end if
-      pvn(ix,jy,1,n,l)=pvhn(ix,jy,1,l)
-      rhon(ix,jy,1,n,l)=rhohn(ix,jy,1)
-      prsn(ix,jy,1,n,l)=prshn(ix,jy,1)
-
-      uun(ix,jy,nz,n,l)=uuhn(ix,jy,nuvz,l)
-      vvn(ix,jy,nz,n,l)=vvhn(ix,jy,nuvz,l)
-      ttn(ix,jy,nz,n,l)=tthn(ix,jy,nuvz,n,l)
-      if (wind_coord_type.ne.'ETA') then 
-        qvn(ix,jy,nz,n,l)=qvhn(ix,jy,nuvz,n,l)
-        if (readclouds_nest(l)) then
-          clwcn(ix,jy,nz,n,l)=clwchn(ix,jy,nuvz,n,l)
-          if (.not.sumclouds_nest(l)) ciwcn(ix,jy,nz,n,l)=ciwchn(ix,jy,nuvz,n,l)
-        endif
-      endif
-      pvn(ix,jy,nz,n,l)=pvhn(ix,jy,nuvz,l)
-      rhon(ix,jy,nz,n,l)=rhohn(ix,jy,nuvz)
-      prsn(ix,jy,nz,n,l)=prshn(ix,jy,nuvz)
-
-      idx(ix,jy)=2
-    end do
-  end do
-!$OMP END DO
-
-  do iz=2,nz-1
-!$OMP DO SCHEDULE(dynamic)
-    do jy=0,nym1
-      do ix=0,nxm1
-        if(height(iz).gt.etauvheightn(ix,jy,nuvz,n,l)) then
-          uun(ix,jy,iz,n,l)=uun(ix,jy,nz,n,l)
-          vvn(ix,jy,iz,n,l)=vvn(ix,jy,nz,n,l)
-          ttn(ix,jy,iz,n,l)=ttn(ix,jy,nz,n,l)
-          pvn(ix,jy,iz,n,l)=pvn(ix,jy,nz,n,l)
-          if (wind_coord_type.ne.'ETA') then 
-            qvn(ix,jy,iz,n,l)=qvn(ix,jy,nz,n,l)
-            !hg adding the cloud water
-            if (readclouds_nest(l)) then
-              clwcn(ix,jy,iz,n,l)=clwcn(ix,jy,nz,n,l)
-              if (.not.sumclouds_nest(l)) &
-                ciwcn(ix,jy,iz,n,l)=ciwcn(ix,jy,nz,n,l)
-            endif
-          endif
-          rhon(ix,jy,iz,n,l)=rhon(ix,jy,nz,n,l)
-          prsn(ix,jy,iz,n,l)=prsn(ix,jy,nz,n,l)
-        else
-          innuvz: do kz=idx(ix,jy),nuvz
-            if (idx(ix,jy) .le. kz .and. &
-              height(iz).gt.etauvheightn(ix,jy,kz-1,n,l) .and. &
-              height(iz).le.etauvheightn(ix,jy,kz,n,l) ) then
-              idx(ix,jy)=kz
-              exit innuvz
-            endif
-          enddo innuvz
-        endif
-
-        if(height(iz).le.etauvheightn(ix,jy,nuvz,n,l)) then
-          kz=idx(ix,jy)
-          dz1=height(iz)-etauvheightn(ix,jy,kz-1,n,l)
-          dz2=etauvheightn(ix,jy,kz,n,l)-height(iz)
-          dz=dz1+dz2
-          uun(ix,jy,iz,n,l)=(uuhn(ix,jy,kz-1,l)*dz2+uuhn(ix,jy,kz,l)*dz1)/dz
-          vvn(ix,jy,iz,n,l)=(vvhn(ix,jy,kz-1,l)*dz2+vvhn(ix,jy,kz,l)*dz1)/dz
-          ttn(ix,jy,iz,n,l)=(tthn(ix,jy,kz-1,n,l)*dz2 &
-               +tthn(ix,jy,kz,n,l)*dz1)/dz
-          pvn(ix,jy,iz,n,l)=(pvhn(ix,jy,kz-1,l)*dz2+pvhn(ix,jy,kz,l)*dz1)/dz
-          if (wind_coord_type.ne.'ETA') then 
-            qvn(ix,jy,iz,n,l)=(qvhn(ix,jy,kz-1,n,l)*dz2 &
-                 +qvhn(ix,jy,kz,n,l)*dz1)/dz
-            !hg adding the cloud water
-            if (readclouds_nest(l)) then
-              clwcn(ix,jy,iz,n,l)=(clwchn(ix,jy,kz-1,n,l)*dz2 + &
-                clwchn(ix,jy,kz,n,l)*dz1)/dz
-              if (.not.sumclouds_nest(l)) ciwcn(ix,jy,iz,n,l)= &
-                (ciwchn(ix,jy,kz-1,n,l)*dz2+ciwchn(ix,jy,kz,n,l)*dz1)/dz
-            end if
-          endif
-          rhon(ix,jy,iz,n,l)=(rhohn(ix,jy,kz-1)*dz2+rhohn(ix,jy,kz)*dz1)/dz
-          prsn(ix,jy,iz,n,l)=(prshn(ix,jy,kz-1)*dz2+prshn(ix,jy,kz)*dz1)/dz
-        endif
-      enddo
-    enddo
-!$OMP END DO
-!$OMP BARRIER
-  enddo
-
-  ! Levels, where w is given
-  !*************************
-
-!$OMP DO
-  do jy=0,nym1
-    do ix=0,nxm1
-      idx(ix,jy)=2
-      wwn(ix,jy,1,n,l)=wwhn(ix,jy,1,l)*pinmconv(ix,jy,1)
-      wwn(ix,jy,nz,n,l)=wwhn(ix,jy,nwz,l)*pinmconv(ix,jy,nz)
-    end do
-  end do
-!$OMP END DO
-
-  do iz=2,nz-1
-!$OMP DO SCHEDULE(dynamic)
-    do jy=0,nym1
-      do ix=0,nxm1
-
-        inn: do kz=idx(ix,jy),nwz
-          if (idx(ix,jy).le.kz .and. height(iz).gt.etawheightn(ix,jy,kz-1,n,l) &
-                               .and. height(iz).le.etawheightn(ix,jy,kz,  n,l))&
-            then
-            idx(ix,jy)=kz
-            exit inn
-          endif
-        enddo inn
-
-        kz=idx(ix,jy)
-        dz1=height(iz)-etawheightn(ix,jy,kz-1,n,l)
-        dz2=etawheightn(ix,jy,kz,n,l)-height(iz)
-        dz=dz1+dz2
-        wwn(ix,jy,iz,n,l)=(wwhn(ix,jy,kz-1,l)*pinmconv(ix,jy,kz-1)*dz2 &
-             +wwhn(ix,jy,kz,l)*pinmconv(ix,jy,kz)*dz1)/dz
-        drhodzn(ix,jy,iz,n,l)=(rhon(ix,jy,iz+1,n,l)-rhon(ix,jy,iz-1,n,l))/ &
-             (height(iz+1)-height(iz-1))
-      enddo
-    enddo
-!$OMP END DO
-!$OMP BARRIER
-  end do
-
-  ! Compute density gradients at intermediate levels
-  !*************************************************
-!$OMP DO
-  do jy=0,nym1
-    do ix=0,nxm1
-      drhodzn(ix,jy,nz,n,l)=drhodzn(ix,jy,nz-1,n,l)
-      drhodzn(ix,jy,1,n,l)=(rhon(ix,jy,2,n,l)-rhon(ix,jy,1,n,l))/ &
-           (height(2)-height(1))
-    end do
-  end do
-!$OMP END DO NOWAIT
-
-  !****************************************************************
-  ! Compute slope of eta levels in windward direction and resulting
-  ! vertical wind correction
-  !****************************************************************
-
-!$OMP DO
-  do jy=1,nyn(l)-2
-    cosf(jy)=1./cos((real(jy)*dyn(l)+ylat0n(l))*pi180)
-    do ix=1,nxn(l)-2
-      idx(ix,jy)=2
-    end do
-  end do
-!$OMP END DO
-
-  do iz=2,nz-1
-!$OMP DO SCHEDULE(dynamic)
-    do jy=1,nyn(l)-2
-      do ix=1,nxn(l)-2
-
-        inneta: do kz=idx(ix,jy),nz
-          if (idx(ix,jy) .le. kz .and. &
-            height(iz).gt.etauvheightn(ix,jy,kz-1,n,l) .and. &
-            height(iz).le.etauvheightn(ix,jy,kz,  n,l)) then
-            idx(ix,jy)=kz
-            exit inneta
-          endif
-        enddo inneta
-
-        kz=idx(ix,jy)
-        dz1=height(iz)-etauvheightn(ix,jy,kz-1,n,l)
-        dz2=etauvheightn(ix,jy,kz,n,l)-height(iz)
-        dz=dz1+dz2
-        ix1=ix-1
-        jy1=jy-1
-        ixp=ix+1
-        jyp=jy+1
+#include "ver_verttransform_ecmwf.f90"
 
-        dzdx1=(etauvheightn(ixp,jy,kz-1,n,l)-etauvheightn(ix1,jy,kz-1,n,l))/2.
-        dzdx2=(etauvheightn(ixp,jy,kz,n,l)-etauvheightn(ix1,jy,kz,n,l))/2.
-        dzdx=(dzdx1*dz2+dzdx2*dz1)/dz
+#include "ver_verttransform_nest.f90"
 
-        dzdy1=(etauvheightn(ix,jyp,kz-1,n,l)-etauvheightn(ix,jy1,kz-1,n,l))/2.
-        dzdy2=(etauvheightn(ix,jyp,kz,n,l)-etauvheightn(ix,jy1,kz,n,l))/2.
-        dzdy=(dzdy1*dz2+dzdy2*dz1)/dz
+#include "ver_vertransf_init.f90"
 
-        wwn(ix,jy,iz,n,l)=wwn(ix,jy,iz,n,l) + &
-          (dzdx*uun(ix,jy,iz,n,l)*dxconst*xresoln(l)*cosf(jy) + &
-           dzdy*vvn(ix,jy,iz,n,l)*dyconst*yresoln(l))
+#include "ver_verttransf_ec_windf.f90"
 
-      end do
-    end do
-!$OMP END DO
-!$OMP BARRIER
-  end do
+#include "ver_verttransf_ec_stereo.f90"
 
-  ! Keep original fields if wind_coord_type==ETA
-  if (wind_coord_type.eq.'ETA') then
-!$OMP DO
+#include "ver_verttransf_ec_cloud.f90"
 
-    do kz=1,nz
-      do jy=0,nym1
-        do ix=0,nxm1
-          uuetan(ix,jy,kz,n,l) = uuhn(ix,jy,kz,l)
-          vvetan(ix,jy,kz,n,l) = vvhn(ix,jy,kz,l)
-          ttetan(ix,jy,kz,n,l) = tthn(ix,jy,kz,n,l)
-          qvn(ix,jy,kz,n,l) = qvhn(ix,jy,kz,n,l)
-          pvetan(ix,jy,kz,n,l) = pvhn(ix,jy,kz,l)
-          rhoetan(ix,jy,kz,n,l) = rhohn(ix,jy,kz)
-          prsetan(ix,jy,kz,n,l) = prshn(ix,jy,kz)
-          ! tvirtualn(ix,jy,kz,n,l)=ttetan(ix,jy,kz,n,l)* &  
-          !   ((qvn(ix,jy,kz,n,l)+0.622)/(0.622*qvn(ix,jy,kz,n,l)+0.622))
-          ! eq A11 from Mid-latitude atmospheric dynamics by Jonathan E. Martin
-          if ((kz.gt.1).and.(kz.lt.nz)) drhodzetan(ix,jy,kz,n,l)= &
-            (rhohn(ix,jy,kz+1)-rhohn(ix,jy,kz-1))/(height(kz+1)-height(kz-1))
-          if (readclouds) then
-            clwcn(ix,jy,kz,n,l)=clwchn(ix,jy,kz,n,l)
-            if (.not.sumclouds_nest(l)) ciwcn(ix,jy,kz,n,l)=ciwchn(ix,jy,kz,n,l)
-          endif
-        end do
-      end do
-    end do
-!$OMP END DO NOWAIT
+#include "ver_verttransform_gfs.f90"
 
-!$OMP DO
-    do jy=0,nym1
-      do ix=0,nxm1
-        drhodzetan(ix,jy,1,n,l)=(rhoetan(ix,jy,2,n,l)-rhoetan(ix,jy,1,n,l))/ &
-             (height(2)-height(1))
-        drhodzetan(ix,jy,nz,n,l)=drhodzetan(ix,jy,nz-1,n,l)
-        ! tvirtualn(ix,jy,1,n,l)=tt2n(ix,jy,1,n,l)* &
-        !   (1.+0.378*ew(td2n(ix,jy,1,n,l),psn(ix,jy,1,n,l))/ps(ix,jy,1,n,l))
-        ! Convert w from Pa/s to eta/s, following FLEXTRA
-        !************************************************
-        do kz=1,nuvz-1
-          if (kz.eq.1) then
-            dpdeta=(akm(kz+1)-akm(kz)+(bkm(kz+1)-bkm(kz))*ps(ix,jy,1,n))/ &
-              (wheight(kz+1)-wheight(kz))
-          else if (kz.eq.nuvz-1) then
-            dpdeta=(akm(kz)-akm(kz-1)+(bkm(kz)-bkm(kz-1))*ps(ix,jy,1,n))/ &
-              (wheight(kz)-wheight(kz-1))
-          else
-            dpdeta=(akm(kz+1)-akm(kz-1)+(bkm(kz+1)-bkm(kz-1))*ps(ix,jy,1,n))/ &
-              (wheight(kz+1)-wheight(kz-1))
-          endif
-          wwetan(ix,jy,kz,n,l)=wwhn(ix,jy,kz,l)/dpdeta
-        end do
-        wwetan(ix,jy,nuvz,n,l)=wwetan(ix,jy,nuvz-1,n,l)
-      end do
-    end do 
-!$OMP END DO
-  endif
-!$OMP END PARALLEL
+#include "ver_verttransf_ec_height.f90"
 
-end subroutine verttransf_ec_windf_nest
+#include "ver_verttransf_ec_windf_nest.f90"
 
 end module verttransform_mod
diff --git a/src/wet_get_wetscav.f90 b/src/wet_get_wetscav.f90
new file mode 100644
index 0000000000000000000000000000000000000000..82967ef00af89af06e0685e0c96805e6baf72378
--- /dev/null
+++ b/src/wet_get_wetscav.f90
@@ -0,0 +1,316 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine get_wetscav(itime,ltsample,loutnext,jpart,ks,grfraction,inc_count,blc_count,wetscav)
+  !                          i      i        i     i   i    o           o          o       o
+  !*****************************************************************************
+  !                                                                            *
+  ! Calculation of wet deposition using the concept of scavenging coefficients.*
+  ! For lack of detailed information, washout and rainout are jointly treated. *
+  ! It is assumed that precipitation does not occur uniformly within the whole *
+  ! grid cell, but that only a fraction of the grid cell experiences rainfall. *
+  ! This fraction is parameterized from total cloud cover and rates of large   *
+  ! scale and convective precipitation.                                        *
+  !                                                                            *
+  !    Author: A. Stohl                                                        *
+  !                                                                            *
+  !    1 December 1996                                                         *
+  !                                                                            *
+  ! Correction by Petra Seibert, Sept 2002:                                    *
+  ! use centred precipitation data for integration                             *
+  ! Code may not be correct for decay of deposition!                           *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! cc [0-1]           total cloud cover                                       *
+  ! convp [mm/h]       convective precipitation rate                           *
+  ! grfraction [0-1]   fraction of grid, for which precipitation occurs        *
+  ! ix,jy              indices of output grid cell for each particle           *
+  ! itime [s]          actual simulation time [s]                              *
+  ! jpart              particle index                                          *
+  ! lfr, cfr           area fraction covered by precipitation for large scale  *
+  !                    and convective precipitation (dependent on prec. rate)  *
+  ! loutnext [s]       time for which gridded deposition is next output        *
+  ! loutstep [s]       interval at which gridded deposition is output          *
+  ! lsp [mm/h]         large scale precipitation rate                          *
+  ! ltsample [s]       interval over which mass is deposited                   *
+  ! prec [mm/h]        precipitation rate in subgrid, where precipitation occurs*
+  ! wetgrid            accumulated deposited mass on output grid               *
+  ! wetscav            scavenging coefficient                                  *
+  !                                                                            *
+  ! Constants:                                                                 *
+  !                                                                            *
+  !*****************************************************************************
+
+  use interpol_mod
+  use windfields_mod
+  use coord_ec_mod
+
+  implicit none
+
+  integer :: jpart,itime,ltsample,loutnext,i,j
+  integer :: hz,il,interp_time, n
+  integer(kind=1) :: clouds_v
+  integer :: ks, kp
+  integer(selected_int_kind(16)), dimension(nspec) :: blc_count, inc_count
+
+  !  integer :: n1,n2, icbot,ictop, indcloud !TEST
+  real :: S_i, act_temp, cl, cle ! in cloud scavenging
+  real :: clouds_h ! cloud height for the specific grid point
+  real :: lsp,convp,cc,grfraction(3),prec(3),wetscav,totprec
+  real :: restmass
+  real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
+  !save lfr,cfr
+  real :: xts,yts
+
+  real, parameter :: lfr(5) = (/ 0.5,0.65,0.8,0.9,0.95/)
+  real, parameter :: cfr(5) = (/ 0.4,0.55,0.7,0.8,0.9 /)
+
+  !ZHG aerosol below-cloud scavenging removal polynomial constants for rain and snow
+  real, parameter :: bclr(6) = (/274.35758, 332839.59273, 226656.57259, 58005.91340, 6588.38582, 0.244984/) !rain (Laakso et al 2003)
+  real, parameter :: bcls(6) = (/22.7, 0.0, 0.0, 1321.0, 381.0, 0.0/) !now (Kyro et al 2009)
+  real :: frac_act, liq_frac, ice_frac, dquer_m
+
+  real    :: Si_dummy, wetscav_dummy
+  logical :: readclouds_this_nest
+
+
+  wetscav=0.
+
+  ! Interpolate large scale precipitation, convective precipitation and
+  ! total cloud cover
+  ! Note that interpolated time refers to itime-0.5*ltsample [PS]
+  !********************************************************************
+  interp_time=nint(itime-0.5*ltsample)
+
+  n=memind(2)
+  if (abs(memtime(1)-interp_time).lt.abs(memtime(2)-interp_time)) &
+       n=memind(1)
+
+  xts=real(part(jpart)%xlon)
+  yts=real(part(jpart)%ylat)
+
+  ! Determine which nesting level to be used
+  !*****************************************
+  call find_ngrid(xts,yts)
+
+  ! If point at border of grid -> small displacement into grid
+  !***********************************************************
+  if (ngrid.le.0) then
+    if (xts.ge.real(nx-1)) xts=real(nx-1)-0.00001
+    if (yts.ge.real(ny-1)) yts=real(ny-1)-0.00001
+  else
+    if (xts.ge.real(nx-1)) xts=real(nx-1)-0.00001
+    if (yts.ge.real(ny-1)) yts=real(ny-1)-0.00001
+  endif
+
+  call find_grid_indices(xts,yts)
+  call find_grid_distances(xts,yts)
+
+  if (ngrid.le.0) then
+    ! No temporal interpolation to stay consistent with clouds
+    call hor_interpol(lsprec,lsp,1,n,1) ! large scale total precipitation
+    call hor_interpol(convprec,convp,1,n,1) ! convective precipitation
+    call hor_interpol(tcc,cc,1,n,1) ! total cloud cover
+  else
+    call hor_interpol_nest(lsprecn,lsp,1,n,1) ! large scale total precipitation
+    call hor_interpol_nest(convprecn,convp,1,n,1) ! convective precipitation
+    call hor_interpol_nest(tccn,cc,1,n,1) ! total cloud cover
+  endif
+
+  !  If total precipitation is less than 0.01 mm/h - no scavenging occurs
+  if ((lsp.lt.0.01).and.(convp.lt.0.01)) return
+
+  if (wind_coord_type.eq.'ETA') then
+    call find_z_level_eta_uv(real(part(jpart)%zeta))
+    hz=induv
+  else
+    call find_z_level_meters(real(part(jpart)%z))
+    hz=indz
+  endif
+
+  if (ngrid.le.0) then
+    clouds_v=clouds(ix,jy,hz,n)
+    clouds_h=cloudsh(ix,jy,n)
+  else
+    clouds_v=cloudsn(ix,jy,hz,n,ngrid)
+    clouds_h=cloudshn(ix,jy,n,ngrid)
+  endif
+
+  ! if there is no precipitation or the particle is above the clouds no
+  ! scavenging is done
+
+  if (clouds_v.le.1) return
+
+  ! 1) Parameterization of the the area fraction of the grid cell where the
+  !    precipitation occurs: the absolute limit is the total cloud cover, but
+  !    for low precipitation rates, an even smaller fraction of the grid cell
+  !    is used. Large scale precipitation occurs over larger areas than
+  !    convective precipitation.
+  !**************************************************************************
+
+  if (lsp.gt.20.) then
+    i=5
+  else if (lsp.gt.8.) then
+    i=4
+  else if (lsp.gt.3.) then
+    i=3
+  else if (lsp.gt.1.) then
+    i=2
+  else
+    i=1
+  endif
+
+  if (convp.gt.20.) then
+    j=5
+  else if (convp.gt.8.) then
+    j=4
+  else if (convp.gt.3.) then
+    j=3
+  else if (convp.gt.1.) then
+    j=2
+  else
+    j=1
+  endif
+
+
+  !ZHG oct 2014 : Calculated for 1) both 2) lsp 3) convp - 2 and 3 not used removed by SE
+  ! Tentatively differentiate the grfraction for lsp and convp for treating differently the two forms
+  ! for now they are treated the same
+  grfraction(1)=max(0.05,cc*(lsp*lfr(i)+convp*cfr(j))/(lsp+convp))
+
+  ! 2) Computation of precipitation rate in sub-grid cell
+  !******************************************************
+  prec(1)=(lsp+convp)/grfraction(1)
+
+  ! 3) Computation of scavenging coefficients for all species
+  !    Computation of wet deposition
+  !**********************************************************
+
+  if (ngrid.gt.0) then
+    if (wind_coord_type.eq.'ETA') then
+      act_temp=ttetan(ix,jy,hz,n,ngrid)
+    else
+      act_temp=ttn(ix,jy,hz,n,ngrid)
+    endif
+  else
+    if (wind_coord_type.eq.'ETA') then
+      act_temp=tteta(ix,jy,hz,n)
+    else
+      act_temp=tt(ix,jy,hz,n)
+    endif
+  endif
+
+  !***********************
+  ! BELOW CLOUD SCAVENGING
+  !***********************
+  if (clouds_v.ge.4) then !below cloud
+
+  ! For gas: if positive below-cloud parameters (A or B), and dquer<=0
+  !******************************************************************
+    if ((dquer(ks).le.0.).and.(weta_gas(ks).gt.0..or.wetb_gas(ks).gt.0.)) then
+      blc_count(ks)=blc_count(ks)+1
+      wetscav=weta_gas(ks)*prec(1)**wetb_gas(ks)
+
+  ! For aerosols: if positive below-cloud parameters (Crain/Csnow or B), and dquer>0
+  !*********************************************************************************
+    else if ((dquer(ks).gt.0.).and.(crain_aero(ks).gt.0..or.csnow_aero(ks).gt.0.)) then
+      blc_count(ks)=blc_count(ks)+1
+
+  !NIK 17.02.2015
+  ! For the calculation here particle size needs to be in meter and not um as dquer is
+  ! changed in readreleases
+  ! For particles larger than 10 um use the largest size defined in the parameterizations (10um)
+      dquer_m=min(10.,dquer(ks))/1000000. !conversion from um to m
+
+  ! Rain:
+      if (act_temp .ge. 273. .and. crain_aero(ks).gt.0.)  then
+
+  ! ZHG 2014 : Particle RAIN scavenging coefficient based on Laakso et al 2003,
+  ! the below-cloud scavenging (rain efficienty) parameter Crain (=crain_aero) from SPECIES file
+        wetscav=crain_aero(ks)*10**(bclr(1)+(bclr(2)*(log10(dquer_m))**(-4))+ &
+             & (bclr(3)*(log10(dquer_m))**(-3))+ (bclr(4)*(log10(dquer_m))**(-2))+&
+             &(bclr(5)*(log10(dquer_m))**(-1))+bclr(6)* (prec(1))**(0.5))
+
+  ! Snow:
+      elseif (act_temp .lt. 273. .and. csnow_aero(ks).gt.0.)  then
+  ! ZHG 2014 : Particle SNOW scavenging coefficient based on Kyro et al 2009,
+  ! the below-cloud scavenging (Snow efficiency) parameter Csnow (=csnow_aero) from SPECIES file
+        wetscav=csnow_aero(ks)*10**(bcls(1)+(bcls(2)*(log10(dquer_m))**(-4))+&
+             &(bcls(3)*(log10(dquer_m))**(-3))+ (bcls(4)*(log10(dquer_m))**(-2))+&
+             &(bcls(5)*(log10(dquer_m))**(-1))+ bcls(6)* (prec(1))**(0.5))
+
+      endif
+
+    endif ! gas or particle
+  !      endif ! positive below-cloud scavenging parameters given in Species file
+  endif !end BELOW
+
+  !********************
+  ! IN CLOUD SCAVENGING
+  !********************
+  if (clouds_v.lt.4) then ! In-cloud
+  ! NIK 13 may 2015: only do incloud if positive in-cloud scavenging parameters are
+  ! given in species file, or if gas and positive Henry's constant
+    if ((ccn_aero(ks).gt.0. .or. in_aero(ks).gt.0.).or.(henry(ks).gt.0.and.dquer(ks).le.0)) then
+      inc_count(ks)=inc_count(ks)+1
+  ! if negative coefficients (turned off) set to zero for use in equation
+      if (ccn_aero(ks).lt.0.) ccn_aero(ks)=0.
+      if (in_aero(ks).lt.0.) in_aero(ks)=0.
+
+  !ZHG 2015 Cloud liquid & ice water (CLWC+CIWC) from ECMWF
+  ! nested fields
+      if (ngrid.gt.0.and.readclouds_this_nest) then
+        cl=ctwcn(ix,jy,n,ngrid)*(grfraction(1)/cc)
+      else if (ngrid.eq.0.and.readclouds) then
+         ! cl=ctwc(ix,jy,n)*(grfraction(1)/cc)
+         ! A.Plach 2021 cl should not become too small
+         cl=max(1E6*2E-7*prec(1)**0.36, ctwc(ix,jy,n)*(grfraction(1)/cc))
+      else                                  !parameterize cloudwater m2/m3
+  !ZHG updated parameterization of cloud water to better reproduce the values coming from ECMWF
+  ! sec test
+  !           cl=1E6*1E-7*prec(1)**0.3 !Sec GFS new
+        cl=1E6*2E-7*prec(1)**0.36 !Sec ECMWF new, is also suitable for GFS
+  !           cl=2E-7*prec(1)**0.36 !Andreas
+  !           cl=1.6E-6*prec(1)**0.36 !Henrik
+      endif
+
+  !ZHG: Calculate the partition between liquid and water phase water.
+      if (act_temp .le. 253.) then
+        liq_frac=0
+        ice_frac=1
+      else if (act_temp .ge. 273.) then
+        liq_frac=1
+        ice_frac=0
+      else
+  ! sec bugfix after FLEXPART paper review, liq_frac was 1-liq_frac
+  ! IP bugfix v10.4, calculate ice_frac and liq_frac
+        ice_frac= ((act_temp-273.)/(273.-253.))**2.
+        !liq_frac = 1-ice_frac   !((act_temp-253.)/(273.-253.))**2.
+        liq_frac=max(0.,1.-ice_frac)
+      end if
+  ! ZHG: Calculate the aerosol partition based on cloud phase and Ai and Bi
+  !         frac_act = liq_frac*ccn_aero(ks) +(1-liq_frac)*in_aero(ks)
+  ! IP, use ice_frac and liq_frac
+      frac_act = liq_frac*ccn_aero(ks) + ice_frac*in_aero(ks)
+
+  !ZHG Use the activated fraction and the liqid water to calculate the washout
+
+  ! AEROSOL
+  !********
+      if (dquer(ks).gt.0.) then
+        S_i= frac_act/cl
+  ! GAS
+  !****
+      else
+        cle=(1-cl)/(henry(ks)*(r_air/3500.)*act_temp)+cl
+        S_i=1/cle
+      endif ! gas or particle
+
+  ! scavenging coefficient based on Hertel et al 1995 - using the S_i for either gas or aerosol
+  !SEC wetscav fix, the cloud height is no longer needed, it gives wrong results
+      wetscav=incloud_ratio*S_i*(prec(1)/3.6E6)
+    endif ! positive in-cloud scavenging parameters given in Species file
+  endif !incloud
+end subroutine get_wetscav
diff --git a/src/wet_wetdepo.f90 b/src/wet_wetdepo.f90
new file mode 100644
index 0000000000000000000000000000000000000000..03d021d75a9ae143f35f39db09b1e155863cbec4
--- /dev/null
+++ b/src/wet_wetdepo.f90
@@ -0,0 +1,191 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine wetdepo(itime,ltsample,loutnext)
+  !                  i      i        i
+  !*****************************************************************************
+  !                                                                            *
+  ! Calculation of wet deposition using the concept of scavenging coefficients.*
+  ! For lack of detailed information, washout and rainout are jointly treated. *
+  ! It is assumed that precipitation does not occur uniformly within the whole *
+  ! grid cell, but that only a fraction of the grid cell experiences rainfall. *
+  ! This fraction is parameterized from total cloud cover and rates of large   *
+  ! scale and convective precipitation.                                        *
+  !                                                                            *
+  !    Author: A. Stohl                                                        *
+  !                                                                            *
+  !    1 December 1996                                                         *
+  !                                                                            *
+  ! Correction by Petra Seibert, Sept 2002:                                    *
+  ! use centred precipitation data for integration                             *
+  ! Code may not be correct for decay of deposition!                           *
+  !                                                                            *
+  ! 2021 Andreas Plach: - moved backward wet depo. calc. here from timemanager *
+  !                     - bugfix in-cloud scavenging                           *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! ix,jy              indices of output grid cell for each particle           *
+  ! itime [s]          actual simulation time [s]                              *
+  ! jpart              particle index                                          *
+  ! ldeltat [s]        interval since radioactive decay was computed           *
+  ! loutnext [s]       time for which gridded deposition is next output        *
+  ! loutstep [s]       interval at which gridded deposition is output          *
+  ! ltsample [s]       interval over which mass is deposited                   *
+  ! wetdeposit         mass that is wet deposited                              *
+  ! wetgrid            accumulated deposited mass on output grid               *
+  ! wetscav            scavenging coefficient                                  *
+  !                                                                            *
+  ! Constants:                                                                 *
+  !                                                                            *
+  !*****************************************************************************
+#ifdef _OPENMP
+  use omp_lib
+#endif
+  use unc_mod
+
+  implicit none
+
+  integer :: jpart,itime,ltsample,loutnext,ldeltat
+  integer :: itage,nage,inage,ithread,thread
+  integer :: ks, kp
+  integer(selected_int_kind(16)), dimension(nspec) :: blc_count, inc_count
+  real :: grfraction(3),wetscav
+  real :: wetdeposit(maxspec),restmass
+  real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
+
+  ! Compute interval since radioactive decay of deposited mass was computed
+  !************************************************************************
+
+  if (itime.le.loutnext) then
+    ldeltat=itime-(loutnext-loutstep)
+  else                                  ! first half of next interval
+    ldeltat=itime-loutnext
+  endif
+
+  ! Loop over all particles
+  !************************
+  blc_count(:)=0
+  inc_count(:)=0
+
+#ifdef _OPENMP
+  call omp_set_num_threads(numthreads_grid)
+#endif
+!$OMP PARALLEL PRIVATE(jpart,itage,nage,inage,ks,kp,thread,wetscav,wetdeposit, &
+!$OMP restmass, grfraction) REDUCTION(+:blc_count,inc_count)
+
+#if (defined _OPENMP)
+    thread = OMP_GET_THREAD_NUM() ! Starts with 0
+#else
+    thread = 0
+#endif
+
+!$OMP DO
+  do jpart=1,numpart
+
+    ! Check if memory has been deallocated
+    if (.not. particle_allocated(jpart)) cycle
+
+    ! Check if particle is still allive
+    if (.not. part(jpart)%alive) cycle
+
+  ! Determine age class of the particle - nage is used for the kernel
+  !******************************************************************
+    itage=abs(itime-part(jpart)%tstart)
+    nage=1
+    do inage=1,nageclass
+      nage=inage
+      if (itage.lt.lage(nage)) exit
+    end do
+
+    do ks=1,nspec      ! loop over species
+
+      if (WETDEPSPEC(ks).eqv..false.) cycle
+
+  !**************************************************
+  ! CALCULATE DEPOSITION
+  !**************************************************
+
+      call get_wetscav(itime,ltsample,loutnext,jpart,ks,grfraction,inc_count,blc_count,wetscav) ! OMP carefully check
+
+      if (WETBKDEP) then
+        if ((xscav_frac1(jpart,ks).lt.-0.1)) then   ! particle marked as starting particle
+          if (wetscav.gt.0.) then
+             xscav_frac1(jpart,ks)=wetscav*(zpoint2(part(jpart)%npoint)-&
+             zpoint1(part(jpart)%npoint))*grfraction(1)
+          else
+            part(jpart)%mass(ks)=0.
+            xscav_frac1(jpart,ks)=0.
+          endif
+        endif
+      endif
+
+      if (wetscav.gt.0.) then
+        wetdeposit(ks)=part(jpart)%mass(ks)* &
+             (1.-exp(-wetscav*abs(ltsample)))*grfraction(1)  ! wet deposition
+      else ! if no scavenging
+        wetdeposit(ks)=0.
+      endif
+      part(jpart)%wetdepo(ks)=part(jpart)%wetdepo(ks)+wetdeposit(ks)
+      restmass = part(jpart)%mass(ks)-wetdeposit(ks)
+      if (ioutputforeachrelease.eq.1) then
+        kp=part(jpart)%npoint
+      else
+        kp=1
+      endif
+      if (restmass .gt. smallnum) then
+        part(jpart)%mass(ks)=restmass
+  !   depostatistic
+  !   wetdepo_sum(ks,kp)=wetdepo_sum(ks,kp)+wetdeposit(ks)
+  !   depostatistic
+      else
+        part(jpart)%mass(ks)=0.
+      endif
+  !   Correct deposited mass to the last time step when radioactive decay of
+  !   gridded deposited mass was calculated
+      if (decay(ks).gt.0.) then
+        wetdeposit(ks)=wetdeposit(ks)*exp(abs(ldeltat)*decay(ks))
+      endif
+
+  !    endif ! no deposition
+    end do ! loop over species
+
+  ! Sabine Eckhardt, June 2008 create deposition runs only for forward runs
+  ! Add the wet deposition to accumulated amount on output grid and nested output grid
+  !*****************************************************************************
+
+    if ((ldirect.eq.1).and.(iout.ne.0)) then !OMP reduction necessary for wetgridunc
+      call wetdepokernel(part(jpart)%nclass,wetdeposit,real(part(jpart)%xlon), &
+           real(part(jpart)%ylat),nage,kp,thread+1)
+      if (nested_output.eq.1) call wetdepokernel_nest(part(jpart)%nclass, &
+           wetdeposit,real(part(jpart)%xlon),real(part(jpart)%ylat),nage,kp,thread+1)
+    endif
+
+  end do ! all particles
+
+!$OMP END DO
+!$OMP END PARALLEL
+
+#ifdef _OPENMP
+  call omp_set_num_threads(numthreads)
+#endif
+
+#ifdef _OPENMP
+    if ((ldirect.eq.1).and.(iout.ne.0)) then
+      do ithread=1,numthreads_grid
+        wetgridunc(:,:,:,:,:,:)=wetgridunc(:,:,:,:,:,:)+gridunc_omp(:,:,1,:,:,:,:,ithread)
+        gridunc_omp(:,:,1,:,:,:,:,ithread)=0.
+      end do
+      if (nested_output.eq.1) then
+        do ithread=1,numthreads_grid
+          wetgriduncn(:,:,:,:,:,:)=wetgriduncn(:,:,:,:,:,:)+griduncn_omp(:,:,1,:,:,:,:,ithread)
+          griduncn_omp(:,:,1,:,:,:,:,ithread)=0.
+        end do
+      endif
+    endif
+#endif
+  !write(*,*) 'WETGRIDUNC:',sum(wetgridunc),wetgridunc(20,270,1,1,1,1),wetgridunc(19,269,1,1,1,1)
+  ! count the total number of below-cloud and in-cloud occurences:
+  tot_blc_count(1:nspec)=tot_blc_count(1:nspec)+blc_count(1:nspec)
+  tot_inc_count(1:nspec)=tot_inc_count(1:nspec)+inc_count(1:nspec)
+end subroutine wetdepo
diff --git a/src/wet_wetdepokernel.f90 b/src/wet_wetdepokernel.f90
new file mode 100644
index 0000000000000000000000000000000000000000..7a5dbd87e42abd5bb62b0f6c018d9b59a17c6691
--- /dev/null
+++ b/src/wet_wetdepokernel.f90
@@ -0,0 +1,133 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine wetdepokernel(nunc,deposit,x,y,nage,kp,thread)
+  !                          i      i    i i  i
+  !*****************************************************************************
+  !                                                                            *
+  !     Attribution of the deposition from an individual particle to the       *
+  !     deposition fields using a uniform kernel with bandwidths dxout and dyout.*
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     26 December 1996                                                       *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  ! nunc             uncertainty class of the respective particle              *
+  ! nage             age class of the respective particle                      *
+  ! deposit          amount (kg) to be deposited                               *
+  !                                                                            *
+  !*****************************************************************************
+  ! Changes:
+  ! eso 10/2016: Added option to disregard kernel
+  !
+  !*****************************************************************************
+
+  use unc_mod
+
+  implicit none
+
+  integer,intent(in) :: thread
+  real :: x,y,deposit(maxspec),ddx,ddy,xl,yl,wx,wy,w
+  integer :: ix,jy,ixp,jyp,nunc,nage,ks,kp
+
+  xl=(x*dx+xoutshift)/dxout
+  yl=(y*dy+youtshift)/dyout
+  ix=int(xl)
+  jy=int(yl)
+  ddx=xl-real(ix)                   ! distance to left cell border
+  ddy=yl-real(jy)                   ! distance to lower cell border
+
+  if (ddx.gt.0.5) then
+    ixp=ix+1
+    wx=1.5-ddx
+  else
+    ixp=ix-1
+    wx=0.5+ddx
+  endif
+
+  if (ddy.gt.0.5) then
+    jyp=jy+1
+    wy=1.5-ddy
+  else
+    jyp=jy-1
+    wy=0.5+ddy
+  endif
+
+  ! If no kernel is used, direct attribution to grid cell
+  !******************************************************
+
+  if (.not.lusekerneloutput) then
+    do ks=1,nspec
+      if ((ix.ge.0).and.(jy.ge.0).and.(ix.le.numxgrid-1).and. &
+           (jy.le.numygrid-1)) then
+#ifdef _OPENMP
+        gridunc_omp(ix,jy,1,ks,kp,nunc,nage,thread)= &
+             gridunc_omp(ix,jy,1,ks,kp,nunc,nage,thread)+deposit(ks)
+#else
+        wetgridunc(ix,jy,ks,kp,nunc,nage)= &
+             wetgridunc(ix,jy,ks,kp,nunc,nage)+deposit(ks)
+#endif
+      end if
+    end do
+  else ! use kernel
+
+  ! Determine mass fractions for four grid points
+  !**********************************************
+
+  do ks=1,nspec
+
+    if ((ix.ge.0).and.(jy.ge.0).and.(ix.le.numxgrid-1).and. &
+       (jy.le.numygrid-1)) then
+      w=wx*wy
+#ifdef _OPENMP
+      gridunc_omp(ix,jy,1,ks,kp,nunc,nage,thread)= &
+           gridunc_omp(ix,jy,1,ks,kp,nunc,nage,thread)+deposit(ks)*w
+#else
+      wetgridunc(ix,jy,ks,kp,nunc,nage)= &
+           wetgridunc(ix,jy,ks,kp,nunc,nage)+deposit(ks)*w
+#endif
+    endif
+
+    if ((ixp.ge.0).and.(jyp.ge.0).and.(ixp.le.numxgrid-1).and. &
+       (jyp.le.numygrid-1)) then
+      w=(1.-wx)*(1.-wy)
+#ifdef _OPENMP
+      gridunc_omp(ixp,jyp,1,ks,kp,nunc,nage,thread)= &
+           gridunc_omp(ixp,jyp,1,ks,kp,nunc,nage,thread)+deposit(ks)*w
+#else
+      wetgridunc(ixp,jyp,ks,kp,nunc,nage)= &
+           wetgridunc(ixp,jyp,ks,kp,nunc,nage)+deposit(ks)*w
+#endif
+    endif
+
+    if ((ixp.ge.0).and.(jy.ge.0).and.(ixp.le.numxgrid-1).and. &
+       (jy.le.numygrid-1)) then
+      w=(1.-wx)*wy
+#ifdef _OPENMP
+      gridunc_omp(ixp,jy,1,ks,kp,nunc,nage,thread)= &
+           gridunc_omp(ixp,jy,1,ks,kp,nunc,nage,thread)+deposit(ks)*w
+#else
+      wetgridunc(ixp,jy,ks,kp,nunc,nage)= &
+           wetgridunc(ixp,jy,ks,kp,nunc,nage)+deposit(ks)*w
+#endif
+    endif
+
+    if ((ix.ge.0).and.(jyp.ge.0).and.(ix.le.numxgrid-1).and. &
+       (jyp.le.numygrid-1)) then
+      w=wx*(1.-wy)
+#ifdef _OPENMP
+      gridunc_omp(ix,jyp,1,ks,kp,nunc,nage,thread)= &
+           gridunc_omp(ix,jyp,1,ks,kp,nunc,nage,thread)+deposit(ks)*w
+#else
+      wetgridunc(ix,jyp,ks,kp,nunc,nage)= &
+           wetgridunc(ix,jyp,ks,kp,nunc,nage)+deposit(ks)*w
+#endif
+    endif
+
+  end do
+  end if
+end subroutine wetdepokernel
diff --git a/src/wet_wetdepokernel_nest.f90 b/src/wet_wetdepokernel_nest.f90
new file mode 100644
index 0000000000000000000000000000000000000000..6ffc055be4d7aa146a59b253069ba56c3556e628
--- /dev/null
+++ b/src/wet_wetdepokernel_nest.f90
@@ -0,0 +1,126 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine wetdepokernel_nest(nunc,deposit,x,y,nage,kp,thread)
+  !                           i    i       i i i    i
+  !*****************************************************************************
+  !                                                                            *
+  !     Attribution of the deposition from an individual particle to the       *
+  !     nested deposition fields using a uniform kernel with bandwidths        *
+  !     dxoutn and dyoutn.                                                     *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     26 December 1996                                                       *
+  !                                                                            *
+  !      2 September 2004: Adaptation from wetdepokernel.                      *
+  !                                                                            *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  ! nunc             uncertainty class of the respective particle              *
+  ! nage             age class of the respective particle                      *
+  ! deposit          amount (kg) to be deposited                               *
+  !                                                                            *
+  !*****************************************************************************
+
+  use unc_mod
+
+  implicit none
+
+  integer,intent(in) :: thread
+  real :: x,y,deposit(maxspec),ddx,ddy,xl,yl,wx,wy,w
+  integer :: ix,jy,ixp,jyp,ks,kp,nunc,nage
+
+  xl=(x*dx+xoutshiftn)/dxoutn
+  yl=(y*dy+youtshiftn)/dyoutn
+
+  ! old:
+  ! ix=int(xl)
+  ! jy=int(yl)
+
+  ! ESO: for xl,yl in range <-.5,-1> we get ix,jy=0 and thus negative
+  ! wx,wy as the int function rounds upwards for negative numbers.
+  ! Either use the floor function, or (perhaps more correctly?) use "(xl.gt.-0.5)"
+  ! in place of "(ix.ge.0)" and similar for the upper boundary.
+
+  ! new:
+  ix=floor(xl)
+  jy=floor(yl)
+
+  ddx=xl-real(ix)                   ! distance to left cell border
+  ddy=yl-real(jy)                   ! distance to lower cell border
+
+
+  if (ddx.gt.0.5) then
+    ixp=ix+1
+    wx=1.5-ddx
+  else
+    ixp=ix-1
+    wx=0.5+ddx
+  endif
+
+  if (ddy.gt.0.5) then
+    jyp=jy+1
+    wy=1.5-ddy
+  else
+    jyp=jy-1
+    wy=0.5+ddy
+  endif
+
+  ! Determine mass fractions for four grid points
+  !**********************************************
+
+  do ks=1,nspec
+    if ((ix.ge.0).and.(jy.ge.0).and.(ix.le.numxgridn-1).and. &
+         (jy.le.numygridn-1)) then
+      w=wx*wy
+#ifdef _OPENMP
+      griduncn_omp(ix,jy,1,ks,kp,nunc,nage,thread)= &
+           griduncn_omp(ix,jy,1,ks,kp,nunc,nage,thread)+deposit(ks)*w
+#else
+      wetgriduncn(ix,jy,ks,kp,nunc,nage)= &
+           wetgriduncn(ix,jy,ks,kp,nunc,nage)+deposit(ks)*w
+#endif
+    endif
+
+    if ((ixp.ge.0).and.(jyp.ge.0).and.(ixp.le.numxgridn-1).and. &
+         (jyp.le.numygridn-1)) then
+      w=(1.-wx)*(1.-wy)
+#ifdef _OPENMP
+      griduncn_omp(ixp,jyp,1,ks,kp,nunc,nage,thread)= &
+           griduncn_omp(ixp,jyp,1,ks,kp,nunc,nage,thread)+deposit(ks)*w
+#else
+      wetgriduncn(ixp,jyp,ks,kp,nunc,nage)= &
+           wetgriduncn(ixp,jyp,ks,kp,nunc,nage)+deposit(ks)*w
+#endif
+    endif
+
+    if ((ixp.ge.0).and.(jy.ge.0).and.(ixp.le.numxgridn-1).and. &
+         (jy.le.numygridn-1)) then
+      w=(1.-wx)*wy
+#ifdef _OPENMP
+      griduncn_omp(ixp,jy,1,ks,kp,nunc,nage,thread)= &
+           griduncn_omp(ixp,jy,1,ks,kp,nunc,nage,thread)+deposit(ks)*w
+#else
+      wetgriduncn(ixp,jy,ks,kp,nunc,nage)= &
+           wetgriduncn(ixp,jy,ks,kp,nunc,nage)+deposit(ks)*w
+#endif
+    endif
+
+    if ((ix.ge.0).and.(jyp.ge.0).and.(ix.le.numxgridn-1).and. &
+         (jyp.le.numygridn-1)) then
+      w=wx*(1.-wy)
+#ifdef _OPENMP
+      griduncn_omp(ix,jyp,1,ks,kp,nunc,nage,thread)= &
+           griduncn_omp(ix,jyp,1,ks,kp,nunc,nage,thread)+deposit(ks)*w
+#else
+      wetgriduncn(ix,jyp,ks,kp,nunc,nage)= &
+           wetgriduncn(ix,jyp,ks,kp,nunc,nage)+deposit(ks)*w
+#endif
+    endif
+
+  end do
+end subroutine wetdepokernel_nest
diff --git a/src/wet_writeprecip.f90 b/src/wet_writeprecip.f90
new file mode 100644
index 0000000000000000000000000000000000000000..6d210295be65662de79dd8737db338702d5631d3
--- /dev/null
+++ b/src/wet_writeprecip.f90
@@ -0,0 +1,65 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine writeprecip(itime,imem)
+
+  !*****************************************************************************
+  !                                                                            *
+  !  This routine produces a file containing total precipitation for each      *
+  !  releases point.                                                           *
+  !                                                                            *
+  !     Author: S. Eckhardt                                                    *
+  !     7 Mai 2017                                                             *
+  !*****************************************************************************
+
+  use point_mod
+  use par_mod
+  use com_mod
+  use date_mod
+  use windfields_mod
+
+  implicit none
+
+  integer :: jjjjmmdd,ihmmss,itime,i
+  real(kind=dp) :: jul
+  character :: adate*8,atime*6
+
+  integer :: ix,jy,imem
+  real :: xp1,yp1
+
+
+  if (itime.eq.0) then
+      open(unitprecip,file=path(2)(1:length(2))//'wetscav_precip.txt', &
+       form='formatted',err=998)
+  else
+      open(unitprecip,file=path(2)(1:length(2))//'wetscav_precip.txt', &
+       ACCESS='APPEND',form='formatted',err=998)
+  endif
+
+  jul=bdate+real(itime,kind=dp)/86400._dp
+  call caldate(jul,jjjjmmdd,ihmmss)
+  write(adate,'(i8.8)') jjjjmmdd
+  write(atime,'(i6.6)') ihmmss
+
+  do i=1,numpoint
+    xp1=xpoint1(i)*dx+xlon0 !lat, long (real) coord
+    yp1=ypoint1(i)*dy+ylat0 !lat, long (real) coord
+    ix=int((xpoint1(i)+xpoint2(i))/2.)
+    jy=int((ypoint1(i)+ypoint2(i))/2.)
+    write(unitprecip,*)  jjjjmmdd, ihmmss, &
+           xp1,yp1,lsprec(ix,jy,1,imem),convprec(ix,jy,1,imem) !time is the same as in the ECMWF windfield
+! units mm/h, valid for the time given in the windfield
+  end do
+
+  close(unitprecip)
+
+  return
+
+
+998   write(*,*) ' #### FLEXPART MODEL ERROR!   THE FILE         #### '
+  write(*,*) ' #### '//path(2)(1:length(2))//'header_txt'//' #### '
+  write(*,*) ' #### CANNOT BE OPENED. IF A FILE WITH THIS    #### '
+  write(*,*) ' #### NAME ALREADY EXISTS, DELETE IT AND START #### '
+  write(*,*) ' #### THE PROGRAM AGAIN.                       #### '
+  stop
+end subroutine writeprecip
diff --git a/src/wetdepo_mod.f90 b/src/wetdepo_mod.f90
index ab1e0fa168a27bd2b61c49ed578888958b1abcbe..071ed64e171976e3b82e436bce153b1c0e66ccea 100644
--- a/src/wetdepo_mod.f90
+++ b/src/wetdepo_mod.f90
@@ -14,825 +14,14 @@ module wetdepo_mod
 
 contains
 
-subroutine wetdepo(itime,ltsample,loutnext)
-  !                  i      i        i
-  !*****************************************************************************
-  !                                                                            *
-  ! Calculation of wet deposition using the concept of scavenging coefficients.*
-  ! For lack of detailed information, washout and rainout are jointly treated. *
-  ! It is assumed that precipitation does not occur uniformly within the whole *
-  ! grid cell, but that only a fraction of the grid cell experiences rainfall. *
-  ! This fraction is parameterized from total cloud cover and rates of large   *
-  ! scale and convective precipitation.                                        *
-  !                                                                            *
-  !    Author: A. Stohl                                                        *
-  !                                                                            *
-  !    1 December 1996                                                         *
-  !                                                                            *
-  ! Correction by Petra Seibert, Sept 2002:                                    *
-  ! use centred precipitation data for integration                             *
-  ! Code may not be correct for decay of deposition!                           *
-  !                                                                            *
-  ! 2021 Andreas Plach: - moved backward wet depo. calc. here from timemanager *
-  !                     - bugfix in-cloud scavenging                           *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! ix,jy              indices of output grid cell for each particle           *
-  ! itime [s]          actual simulation time [s]                              *
-  ! jpart              particle index                                          *
-  ! ldeltat [s]        interval since radioactive decay was computed           *
-  ! loutnext [s]       time for which gridded deposition is next output        *
-  ! loutstep [s]       interval at which gridded deposition is output          *
-  ! ltsample [s]       interval over which mass is deposited                   *
-  ! wetdeposit         mass that is wet deposited                              *
-  ! wetgrid            accumulated deposited mass on output grid               *
-  ! wetscav            scavenging coefficient                                  *
-  !                                                                            *
-  ! Constants:                                                                 *
-  !                                                                            *
-  !*****************************************************************************
-#ifdef _OPENMP
-  use omp_lib
-#endif
-  use unc_mod
-
-  implicit none
-
-  integer :: jpart,itime,ltsample,loutnext,ldeltat
-  integer :: itage,nage,inage,ithread,thread
-  integer :: ks, kp
-  integer(selected_int_kind(16)), dimension(nspec) :: blc_count, inc_count
-  real :: grfraction(3),wetscav
-  real :: wetdeposit(maxspec),restmass
-  real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
-
-  ! Compute interval since radioactive decay of deposited mass was computed
-  !************************************************************************
-
-  if (itime.le.loutnext) then
-    ldeltat=itime-(loutnext-loutstep)
-  else                                  ! first half of next interval
-    ldeltat=itime-loutnext
-  endif
-
-  ! Loop over all particles
-  !************************
-  blc_count(:)=0
-  inc_count(:)=0
-
-#ifdef _OPENMP
-  call omp_set_num_threads(numthreads_grid)
-#endif
-!$OMP PARALLEL PRIVATE(jpart,itage,nage,inage,ks,kp,thread,wetscav,wetdeposit, &
-!$OMP restmass, grfraction) REDUCTION(+:blc_count,inc_count)
-
-#if (defined _OPENMP)
-    thread = OMP_GET_THREAD_NUM() ! Starts with 0
-#else
-    thread = 0
-#endif
-
-!$OMP DO 
-  do jpart=1,numpart
-
-    ! Check if memory has been deallocated
-    if (.not. particle_allocated(jpart)) cycle
-
-    ! Check if particle is still allive
-    if (.not. part(jpart)%alive) cycle
-
-  ! Determine age class of the particle - nage is used for the kernel
-  !******************************************************************
-    itage=abs(itime-part(jpart)%tstart)
-    nage=1
-    do inage=1,nageclass
-      nage=inage
-      if (itage.lt.lage(nage)) exit
-    end do
-
-    do ks=1,nspec      ! loop over species
-
-      if (WETDEPSPEC(ks).eqv..false.) cycle 
-
-  !**************************************************
-  ! CALCULATE DEPOSITION 
-  !**************************************************
-
-      call get_wetscav(itime,ltsample,loutnext,jpart,ks,grfraction,inc_count,blc_count,wetscav) ! OMP carefully check
-
-      if (WETBKDEP) then
-        if ((xscav_frac1(jpart,ks).lt.-0.1)) then   ! particle marked as starting particle
-          if (wetscav.gt.0.) then
-             xscav_frac1(jpart,ks)=wetscav*(zpoint2(part(jpart)%npoint)-&
-             zpoint1(part(jpart)%npoint))*grfraction(1)
-          else
-            part(jpart)%mass(ks)=0.
-            xscav_frac1(jpart,ks)=0.
-          endif
-        endif
-      endif
-
-      if (wetscav.gt.0.) then
-        wetdeposit(ks)=part(jpart)%mass(ks)* &
-             (1.-exp(-wetscav*abs(ltsample)))*grfraction(1)  ! wet deposition
-      else ! if no scavenging
-        wetdeposit(ks)=0.
-      endif
-      part(jpart)%wetdepo(ks)=part(jpart)%wetdepo(ks)+wetdeposit(ks)
-      restmass = part(jpart)%mass(ks)-wetdeposit(ks)
-      if (ioutputforeachrelease.eq.1) then
-        kp=part(jpart)%npoint
-      else
-        kp=1
-      endif
-      if (restmass .gt. smallnum) then
-        part(jpart)%mass(ks)=restmass
-  !   depostatistic
-  !   wetdepo_sum(ks,kp)=wetdepo_sum(ks,kp)+wetdeposit(ks)
-  !   depostatistic
-      else
-        part(jpart)%mass(ks)=0.
-      endif
-  !   Correct deposited mass to the last time step when radioactive decay of
-  !   gridded deposited mass was calculated
-      if (decay(ks).gt.0.) then
-        wetdeposit(ks)=wetdeposit(ks)*exp(abs(ldeltat)*decay(ks))
-      endif
-
-  !    endif ! no deposition
-    end do ! loop over species
-
-  ! Sabine Eckhardt, June 2008 create deposition runs only for forward runs
-  ! Add the wet deposition to accumulated amount on output grid and nested output grid
-  !*****************************************************************************
-
-    if ((ldirect.eq.1).and.(iout.ne.0)) then !OMP reduction necessary for wetgridunc
-      call wetdepokernel(part(jpart)%nclass,wetdeposit,real(part(jpart)%xlon), &
-           real(part(jpart)%ylat),nage,kp,thread+1)
-      if (nested_output.eq.1) call wetdepokernel_nest(part(jpart)%nclass, &
-           wetdeposit,real(part(jpart)%xlon),real(part(jpart)%ylat),nage,kp,thread+1)
-    endif
-
-  end do ! all particles
-
-!$OMP END DO
-!$OMP END PARALLEL
-
-#ifdef _OPENMP
-  call omp_set_num_threads(numthreads)
-#endif
-
-#ifdef _OPENMP
-    if ((ldirect.eq.1).and.(iout.ne.0)) then
-      do ithread=1,numthreads_grid
-        wetgridunc(:,:,:,:,:,:)=wetgridunc(:,:,:,:,:,:)+gridunc_omp(:,:,1,:,:,:,:,ithread)
-        gridunc_omp(:,:,1,:,:,:,:,ithread)=0.
-      end do
-      if (nested_output.eq.1) then
-        do ithread=1,numthreads_grid
-          wetgriduncn(:,:,:,:,:,:)=wetgriduncn(:,:,:,:,:,:)+griduncn_omp(:,:,1,:,:,:,:,ithread)
-          griduncn_omp(:,:,1,:,:,:,:,ithread)=0.
-        end do
-      endif
-    endif
-#endif
-  !write(*,*) 'WETGRIDUNC:',sum(wetgridunc),wetgridunc(20,270,1,1,1,1),wetgridunc(19,269,1,1,1,1)
-  ! count the total number of below-cloud and in-cloud occurences:
-  tot_blc_count(1:nspec)=tot_blc_count(1:nspec)+blc_count(1:nspec)
-  tot_inc_count(1:nspec)=tot_inc_count(1:nspec)+inc_count(1:nspec)
-end subroutine wetdepo
-
-subroutine get_wetscav(itime,ltsample,loutnext,jpart,ks,grfraction,inc_count,blc_count,wetscav)
-  !                          i      i        i     i   i    o           o          o       o
-  !*****************************************************************************
-  !                                                                            *
-  ! Calculation of wet deposition using the concept of scavenging coefficients.*
-  ! For lack of detailed information, washout and rainout are jointly treated. *
-  ! It is assumed that precipitation does not occur uniformly within the whole *
-  ! grid cell, but that only a fraction of the grid cell experiences rainfall. *
-  ! This fraction is parameterized from total cloud cover and rates of large   *
-  ! scale and convective precipitation.                                        *
-  !                                                                            *
-  !    Author: A. Stohl                                                        *
-  !                                                                            *
-  !    1 December 1996                                                         *
-  !                                                                            *
-  ! Correction by Petra Seibert, Sept 2002:                                    *
-  ! use centred precipitation data for integration                             *
-  ! Code may not be correct for decay of deposition!                           *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! cc [0-1]           total cloud cover                                       *
-  ! convp [mm/h]       convective precipitation rate                           *
-  ! grfraction [0-1]   fraction of grid, for which precipitation occurs        *
-  ! ix,jy              indices of output grid cell for each particle           *
-  ! itime [s]          actual simulation time [s]                              *
-  ! jpart              particle index                                          *
-  ! lfr, cfr           area fraction covered by precipitation for large scale  *
-  !                    and convective precipitation (dependent on prec. rate)  *
-  ! loutnext [s]       time for which gridded deposition is next output        *
-  ! loutstep [s]       interval at which gridded deposition is output          *
-  ! lsp [mm/h]         large scale precipitation rate                          *
-  ! ltsample [s]       interval over which mass is deposited                   *
-  ! prec [mm/h]        precipitation rate in subgrid, where precipitation occurs*
-  ! wetgrid            accumulated deposited mass on output grid               *
-  ! wetscav            scavenging coefficient                                  *
-  !                                                                            *
-  ! Constants:                                                                 *
-  !                                                                            *
-  !*****************************************************************************
-
-  use interpol_mod
-  use windfields_mod
-  use coord_ec_mod
-
-  implicit none
-
-  integer :: jpart,itime,ltsample,loutnext,i,j
-  integer :: hz,il,interp_time, n
-  integer(kind=1) :: clouds_v
-  integer :: ks, kp
-  integer(selected_int_kind(16)), dimension(nspec) :: blc_count, inc_count
-
-  !  integer :: n1,n2, icbot,ictop, indcloud !TEST
-  real :: S_i, act_temp, cl, cle ! in cloud scavenging
-  real :: clouds_h ! cloud height for the specific grid point
-  real :: lsp,convp,cc,grfraction(3),prec(3),wetscav,totprec
-  real :: restmass
-  real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
-  !save lfr,cfr
-  real :: xts,yts
-
-  real, parameter :: lfr(5) = (/ 0.5,0.65,0.8,0.9,0.95/)
-  real, parameter :: cfr(5) = (/ 0.4,0.55,0.7,0.8,0.9 /)
-
-  !ZHG aerosol below-cloud scavenging removal polynomial constants for rain and snow
-  real, parameter :: bclr(6) = (/274.35758, 332839.59273, 226656.57259, 58005.91340, 6588.38582, 0.244984/) !rain (Laakso et al 2003)
-  real, parameter :: bcls(6) = (/22.7, 0.0, 0.0, 1321.0, 381.0, 0.0/) !now (Kyro et al 2009)
-  real :: frac_act, liq_frac, ice_frac, dquer_m
-
-  real    :: Si_dummy, wetscav_dummy
-  logical :: readclouds_this_nest
-
-
-  wetscav=0.
-
-  ! Interpolate large scale precipitation, convective precipitation and
-  ! total cloud cover
-  ! Note that interpolated time refers to itime-0.5*ltsample [PS]
-  !********************************************************************
-  interp_time=nint(itime-0.5*ltsample) 
-
-  n=memind(2)
-  if (abs(memtime(1)-interp_time).lt.abs(memtime(2)-interp_time)) &
-       n=memind(1)
-
-  xts=real(part(jpart)%xlon)
-  yts=real(part(jpart)%ylat)
-
-  ! Determine which nesting level to be used
-  !*****************************************
-  call find_ngrid(xts,yts)
-
-  ! If point at border of grid -> small displacement into grid
-  !***********************************************************
-  if (ngrid.le.0) then
-    if (xts.ge.real(nx-1)) xts=real(nx-1)-0.00001
-    if (yts.ge.real(ny-1)) yts=real(ny-1)-0.00001
-  else
-    if (xts.ge.real(nx-1)) xts=real(nx-1)-0.00001
-    if (yts.ge.real(ny-1)) yts=real(ny-1)-0.00001
-  endif
-
-  call find_grid_indices(xts,yts)
-  call find_grid_distances(xts,yts)
-
-  if (ngrid.le.0) then
-    ! No temporal interpolation to stay consistent with clouds
-    call hor_interpol(lsprec,lsp,1,n,1) ! large scale total precipitation
-    call hor_interpol(convprec,convp,1,n,1) ! convective precipitation
-    call hor_interpol(tcc,cc,1,n,1) ! total cloud cover
-  else
-    call hor_interpol_nest(lsprecn,lsp,1,n,1) ! large scale total precipitation
-    call hor_interpol_nest(convprecn,convp,1,n,1) ! convective precipitation
-    call hor_interpol_nest(tccn,cc,1,n,1) ! total cloud cover
-  endif
-
-  !  If total precipitation is less than 0.01 mm/h - no scavenging occurs
-  if ((lsp.lt.0.01).and.(convp.lt.0.01)) return
-
-  if (wind_coord_type.eq.'ETA') then
-    call find_z_level_eta_uv(real(part(jpart)%zeta))
-    hz=induv
-  else
-    call find_z_level_meters(real(part(jpart)%z))
-    hz=indz
-  endif
-
-  if (ngrid.le.0) then
-    clouds_v=clouds(ix,jy,hz,n)
-    clouds_h=cloudsh(ix,jy,n)
-  else
-    clouds_v=cloudsn(ix,jy,hz,n,ngrid)
-    clouds_h=cloudshn(ix,jy,n,ngrid)
-  endif
-
-  ! if there is no precipitation or the particle is above the clouds no
-  ! scavenging is done
-
-  if (clouds_v.le.1) return
-
-  ! 1) Parameterization of the the area fraction of the grid cell where the
-  !    precipitation occurs: the absolute limit is the total cloud cover, but
-  !    for low precipitation rates, an even smaller fraction of the grid cell
-  !    is used. Large scale precipitation occurs over larger areas than
-  !    convective precipitation.
-  !**************************************************************************
-
-  if (lsp.gt.20.) then
-    i=5
-  else if (lsp.gt.8.) then
-    i=4
-  else if (lsp.gt.3.) then
-    i=3
-  else if (lsp.gt.1.) then
-    i=2
-  else
-    i=1
-  endif
-
-  if (convp.gt.20.) then
-    j=5
-  else if (convp.gt.8.) then
-    j=4
-  else if (convp.gt.3.) then
-    j=3
-  else if (convp.gt.1.) then
-    j=2
-  else
-    j=1
-  endif
-
-
-  !ZHG oct 2014 : Calculated for 1) both 2) lsp 3) convp - 2 and 3 not used removed by SE
-  ! Tentatively differentiate the grfraction for lsp and convp for treating differently the two forms
-  ! for now they are treated the same
-  grfraction(1)=max(0.05,cc*(lsp*lfr(i)+convp*cfr(j))/(lsp+convp))
-
-  ! 2) Computation of precipitation rate in sub-grid cell
-  !******************************************************
-  prec(1)=(lsp+convp)/grfraction(1)
-
-  ! 3) Computation of scavenging coefficients for all species
-  !    Computation of wet deposition
-  !**********************************************************
-
-  if (ngrid.gt.0) then
-    if (wind_coord_type.eq.'ETA') then
-      act_temp=ttetan(ix,jy,hz,n,ngrid)
-    else
-      act_temp=ttn(ix,jy,hz,n,ngrid)
-    endif
-  else
-    if (wind_coord_type.eq.'ETA') then
-      act_temp=tteta(ix,jy,hz,n)
-    else
-      act_temp=tt(ix,jy,hz,n)
-    endif
-  endif
-
-  !***********************
-  ! BELOW CLOUD SCAVENGING
-  !***********************  
-  if (clouds_v.ge.4) then !below cloud
-
-  ! For gas: if positive below-cloud parameters (A or B), and dquer<=0
-  !******************************************************************
-    if ((dquer(ks).le.0.).and.(weta_gas(ks).gt.0..or.wetb_gas(ks).gt.0.)) then
-      blc_count(ks)=blc_count(ks)+1
-      wetscav=weta_gas(ks)*prec(1)**wetb_gas(ks)
-
-  ! For aerosols: if positive below-cloud parameters (Crain/Csnow or B), and dquer>0
-  !*********************************************************************************
-    else if ((dquer(ks).gt.0.).and.(crain_aero(ks).gt.0..or.csnow_aero(ks).gt.0.)) then
-      blc_count(ks)=blc_count(ks)+1
-
-  !NIK 17.02.2015
-  ! For the calculation here particle size needs to be in meter and not um as dquer is
-  ! changed in readreleases
-  ! For particles larger than 10 um use the largest size defined in the parameterizations (10um)
-      dquer_m=min(10.,dquer(ks))/1000000. !conversion from um to m
-
-  ! Rain:
-      if (act_temp .ge. 273. .and. crain_aero(ks).gt.0.)  then
-
-  ! ZHG 2014 : Particle RAIN scavenging coefficient based on Laakso et al 2003, 
-  ! the below-cloud scavenging (rain efficienty) parameter Crain (=crain_aero) from SPECIES file
-        wetscav=crain_aero(ks)*10**(bclr(1)+(bclr(2)*(log10(dquer_m))**(-4))+ &
-             & (bclr(3)*(log10(dquer_m))**(-3))+ (bclr(4)*(log10(dquer_m))**(-2))+&
-             &(bclr(5)*(log10(dquer_m))**(-1))+bclr(6)* (prec(1))**(0.5))
-
-  ! Snow:
-      elseif (act_temp .lt. 273. .and. csnow_aero(ks).gt.0.)  then 
-  ! ZHG 2014 : Particle SNOW scavenging coefficient based on Kyro et al 2009, 
-  ! the below-cloud scavenging (Snow efficiency) parameter Csnow (=csnow_aero) from SPECIES file
-        wetscav=csnow_aero(ks)*10**(bcls(1)+(bcls(2)*(log10(dquer_m))**(-4))+&
-             &(bcls(3)*(log10(dquer_m))**(-3))+ (bcls(4)*(log10(dquer_m))**(-2))+&
-             &(bcls(5)*(log10(dquer_m))**(-1))+ bcls(6)* (prec(1))**(0.5))
-
-      endif
-            
-    endif ! gas or particle
-  !      endif ! positive below-cloud scavenging parameters given in Species file
-  endif !end BELOW
-
-  !********************
-  ! IN CLOUD SCAVENGING
-  !********************
-  if (clouds_v.lt.4) then ! In-cloud
-  ! NIK 13 may 2015: only do incloud if positive in-cloud scavenging parameters are
-  ! given in species file, or if gas and positive Henry's constant
-    if ((ccn_aero(ks).gt.0. .or. in_aero(ks).gt.0.).or.(henry(ks).gt.0.and.dquer(ks).le.0)) then 
-      inc_count(ks)=inc_count(ks)+1
-  ! if negative coefficients (turned off) set to zero for use in equation
-      if (ccn_aero(ks).lt.0.) ccn_aero(ks)=0.
-      if (in_aero(ks).lt.0.) in_aero(ks)=0.
-
-  !ZHG 2015 Cloud liquid & ice water (CLWC+CIWC) from ECMWF
-  ! nested fields
-      if (ngrid.gt.0.and.readclouds_this_nest) then
-        cl=ctwcn(ix,jy,n,ngrid)*(grfraction(1)/cc)
-      else if (ngrid.eq.0.and.readclouds) then
-         ! cl=ctwc(ix,jy,n)*(grfraction(1)/cc)
-         ! A.Plach 2021 cl should not become too small
-         cl=max(1E6*2E-7*prec(1)**0.36, ctwc(ix,jy,n)*(grfraction(1)/cc))
-      else                                  !parameterize cloudwater m2/m3
-  !ZHG updated parameterization of cloud water to better reproduce the values coming from ECMWF
-  ! sec test
-  !           cl=1E6*1E-7*prec(1)**0.3 !Sec GFS new
-        cl=1E6*2E-7*prec(1)**0.36 !Sec ECMWF new, is also suitable for GFS
-  !           cl=2E-7*prec(1)**0.36 !Andreas
-  !           cl=1.6E-6*prec(1)**0.36 !Henrik
-      endif
-
-  !ZHG: Calculate the partition between liquid and water phase water. 
-      if (act_temp .le. 253.) then
-        liq_frac=0
-        ice_frac=1
-      else if (act_temp .ge. 273.) then
-        liq_frac=1
-        ice_frac=0
-      else
-  ! sec bugfix after FLEXPART paper review, liq_frac was 1-liq_frac
-  ! IP bugfix v10.4, calculate ice_frac and liq_frac
-        ice_frac= ((act_temp-273.)/(273.-253.))**2.
-        !liq_frac = 1-ice_frac   !((act_temp-253.)/(273.-253.))**2.
-        liq_frac=max(0.,1.-ice_frac)
-      end if
-  ! ZHG: Calculate the aerosol partition based on cloud phase and Ai and Bi
-  !         frac_act = liq_frac*ccn_aero(ks) +(1-liq_frac)*in_aero(ks)
-  ! IP, use ice_frac and liq_frac 
-      frac_act = liq_frac*ccn_aero(ks) + ice_frac*in_aero(ks)
-
-  !ZHG Use the activated fraction and the liqid water to calculate the washout
-
-  ! AEROSOL
-  !********
-      if (dquer(ks).gt.0.) then
-        S_i= frac_act/cl
-  ! GAS
-  !****
-      else
-        cle=(1-cl)/(henry(ks)*(r_air/3500.)*act_temp)+cl
-        S_i=1/cle
-      endif ! gas or particle
-
-  ! scavenging coefficient based on Hertel et al 1995 - using the S_i for either gas or aerosol
-  !SEC wetscav fix, the cloud height is no longer needed, it gives wrong results
-      wetscav=incloud_ratio*S_i*(prec(1)/3.6E6)
-    endif ! positive in-cloud scavenging parameters given in Species file
-  endif !incloud
-end subroutine get_wetscav
-
-subroutine wetdepokernel(nunc,deposit,x,y,nage,kp,thread)
-  !                          i      i    i i  i
-  !*****************************************************************************
-  !                                                                            *
-  !     Attribution of the deposition from an individual particle to the       *
-  !     deposition fields using a uniform kernel with bandwidths dxout and dyout.*
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     26 December 1996                                                       *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  !                                                                            *
-  ! nunc             uncertainty class of the respective particle              *
-  ! nage             age class of the respective particle                      *
-  ! deposit          amount (kg) to be deposited                               *
-  !                                                                            *
-  !*****************************************************************************
-  ! Changes:
-  ! eso 10/2016: Added option to disregard kernel 
-  ! 
-  !*****************************************************************************
-
-  use unc_mod
-
-  implicit none
-
-  integer,intent(in) :: thread
-  real :: x,y,deposit(maxspec),ddx,ddy,xl,yl,wx,wy,w
-  integer :: ix,jy,ixp,jyp,nunc,nage,ks,kp
-
-  xl=(x*dx+xoutshift)/dxout
-  yl=(y*dy+youtshift)/dyout
-  ix=int(xl)
-  jy=int(yl)
-  ddx=xl-real(ix)                   ! distance to left cell border
-  ddy=yl-real(jy)                   ! distance to lower cell border
-
-  if (ddx.gt.0.5) then
-    ixp=ix+1
-    wx=1.5-ddx
-  else
-    ixp=ix-1
-    wx=0.5+ddx
-  endif
-
-  if (ddy.gt.0.5) then
-    jyp=jy+1
-    wy=1.5-ddy
-  else
-    jyp=jy-1
-    wy=0.5+ddy
-  endif
-
-  ! If no kernel is used, direct attribution to grid cell
-  !******************************************************
-
-  if (.not.lusekerneloutput) then
-    do ks=1,nspec
-      if ((ix.ge.0).and.(jy.ge.0).and.(ix.le.numxgrid-1).and. &
-           (jy.le.numygrid-1)) then
-#ifdef _OPENMP
-        gridunc_omp(ix,jy,1,ks,kp,nunc,nage,thread)= &
-             gridunc_omp(ix,jy,1,ks,kp,nunc,nage,thread)+deposit(ks)
-#else
-        wetgridunc(ix,jy,ks,kp,nunc,nage)= &
-             wetgridunc(ix,jy,ks,kp,nunc,nage)+deposit(ks)
-#endif
-      end if
-    end do
-  else ! use kernel 
-    
-  ! Determine mass fractions for four grid points
-  !**********************************************
-
-  do ks=1,nspec
-
-    if ((ix.ge.0).and.(jy.ge.0).and.(ix.le.numxgrid-1).and. &
-       (jy.le.numygrid-1)) then
-      w=wx*wy
-#ifdef _OPENMP
-      gridunc_omp(ix,jy,1,ks,kp,nunc,nage,thread)= &
-           gridunc_omp(ix,jy,1,ks,kp,nunc,nage,thread)+deposit(ks)*w
-#else
-      wetgridunc(ix,jy,ks,kp,nunc,nage)= &
-           wetgridunc(ix,jy,ks,kp,nunc,nage)+deposit(ks)*w
-#endif
-    endif
-
-    if ((ixp.ge.0).and.(jyp.ge.0).and.(ixp.le.numxgrid-1).and. &
-       (jyp.le.numygrid-1)) then
-      w=(1.-wx)*(1.-wy)
-#ifdef _OPENMP
-      gridunc_omp(ixp,jyp,1,ks,kp,nunc,nage,thread)= &
-           gridunc_omp(ixp,jyp,1,ks,kp,nunc,nage,thread)+deposit(ks)*w
-#else
-      wetgridunc(ixp,jyp,ks,kp,nunc,nage)= &
-           wetgridunc(ixp,jyp,ks,kp,nunc,nage)+deposit(ks)*w
-#endif
-    endif
-
-    if ((ixp.ge.0).and.(jy.ge.0).and.(ixp.le.numxgrid-1).and. &
-       (jy.le.numygrid-1)) then
-      w=(1.-wx)*wy
-#ifdef _OPENMP
-      gridunc_omp(ixp,jy,1,ks,kp,nunc,nage,thread)= &
-           gridunc_omp(ixp,jy,1,ks,kp,nunc,nage,thread)+deposit(ks)*w
-#else
-      wetgridunc(ixp,jy,ks,kp,nunc,nage)= &
-           wetgridunc(ixp,jy,ks,kp,nunc,nage)+deposit(ks)*w
-#endif
-    endif
-
-    if ((ix.ge.0).and.(jyp.ge.0).and.(ix.le.numxgrid-1).and. &
-       (jyp.le.numygrid-1)) then
-      w=wx*(1.-wy)
-#ifdef _OPENMP
-      gridunc_omp(ix,jyp,1,ks,kp,nunc,nage,thread)= &
-           gridunc_omp(ix,jyp,1,ks,kp,nunc,nage,thread)+deposit(ks)*w
-#else
-      wetgridunc(ix,jyp,ks,kp,nunc,nage)= &
-           wetgridunc(ix,jyp,ks,kp,nunc,nage)+deposit(ks)*w
-#endif
-    endif
-
-  end do
-  end if
-end subroutine wetdepokernel
-
-subroutine wetdepokernel_nest(nunc,deposit,x,y,nage,kp,thread)
-  !                           i    i       i i i    i
-  !*****************************************************************************
-  !                                                                            *
-  !     Attribution of the deposition from an individual particle to the       *
-  !     nested deposition fields using a uniform kernel with bandwidths        *
-  !     dxoutn and dyoutn.                                                     *
-  !                                                                            *
-  !     Author: A. Stohl                                                       *
-  !                                                                            *
-  !     26 December 1996                                                       *
-  !                                                                            *
-  !      2 September 2004: Adaptation from wetdepokernel.                      *
-  !                                                                            *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  !                                                                            *
-  ! nunc             uncertainty class of the respective particle              *
-  ! nage             age class of the respective particle                      *
-  ! deposit          amount (kg) to be deposited                               *
-  !                                                                            *
-  !*****************************************************************************
-
-  use unc_mod
-
-  implicit none
-
-  integer,intent(in) :: thread
-  real :: x,y,deposit(maxspec),ddx,ddy,xl,yl,wx,wy,w
-  integer :: ix,jy,ixp,jyp,ks,kp,nunc,nage
-
-  xl=(x*dx+xoutshiftn)/dxoutn
-  yl=(y*dy+youtshiftn)/dyoutn
-
-  ! old:
-  ! ix=int(xl) 
-  ! jy=int(yl)
-
-  ! ESO: for xl,yl in range <-.5,-1> we get ix,jy=0 and thus negative
-  ! wx,wy as the int function rounds upwards for negative numbers.
-  ! Either use the floor function, or (perhaps more correctly?) use "(xl.gt.-0.5)" 
-  ! in place of "(ix.ge.0)" and similar for the upper boundary.
-
-  ! new:
-  ix=floor(xl)
-  jy=floor(yl)
-
-  ddx=xl-real(ix)                   ! distance to left cell border
-  ddy=yl-real(jy)                   ! distance to lower cell border
-
-
-  if (ddx.gt.0.5) then
-    ixp=ix+1
-    wx=1.5-ddx
-  else
-    ixp=ix-1
-    wx=0.5+ddx
-  endif
-
-  if (ddy.gt.0.5) then
-    jyp=jy+1
-    wy=1.5-ddy
-  else
-    jyp=jy-1
-    wy=0.5+ddy
-  endif
-
-  ! Determine mass fractions for four grid points
-  !**********************************************
-
-  do ks=1,nspec
-    if ((ix.ge.0).and.(jy.ge.0).and.(ix.le.numxgridn-1).and. &
-         (jy.le.numygridn-1)) then
-      w=wx*wy
-#ifdef _OPENMP
-      griduncn_omp(ix,jy,1,ks,kp,nunc,nage,thread)= &
-           griduncn_omp(ix,jy,1,ks,kp,nunc,nage,thread)+deposit(ks)*w
-#else
-      wetgriduncn(ix,jy,ks,kp,nunc,nage)= &
-           wetgriduncn(ix,jy,ks,kp,nunc,nage)+deposit(ks)*w
-#endif
-    endif
-
-    if ((ixp.ge.0).and.(jyp.ge.0).and.(ixp.le.numxgridn-1).and. &
-         (jyp.le.numygridn-1)) then
-      w=(1.-wx)*(1.-wy)
-#ifdef _OPENMP
-      griduncn_omp(ixp,jyp,1,ks,kp,nunc,nage,thread)= &
-           griduncn_omp(ixp,jyp,1,ks,kp,nunc,nage,thread)+deposit(ks)*w
-#else
-      wetgriduncn(ixp,jyp,ks,kp,nunc,nage)= &
-           wetgriduncn(ixp,jyp,ks,kp,nunc,nage)+deposit(ks)*w
-#endif
-    endif
-
-    if ((ixp.ge.0).and.(jy.ge.0).and.(ixp.le.numxgridn-1).and. &
-         (jy.le.numygridn-1)) then
-      w=(1.-wx)*wy
-#ifdef _OPENMP
-      griduncn_omp(ixp,jy,1,ks,kp,nunc,nage,thread)= &
-           griduncn_omp(ixp,jy,1,ks,kp,nunc,nage,thread)+deposit(ks)*w
-#else
-      wetgriduncn(ixp,jy,ks,kp,nunc,nage)= &
-           wetgriduncn(ixp,jy,ks,kp,nunc,nage)+deposit(ks)*w
-#endif
-    endif
-
-    if ((ix.ge.0).and.(jyp.ge.0).and.(ix.le.numxgridn-1).and. &
-         (jyp.le.numygridn-1)) then
-      w=wx*(1.-wy)
-#ifdef _OPENMP
-      griduncn_omp(ix,jyp,1,ks,kp,nunc,nage,thread)= &
-           griduncn_omp(ix,jyp,1,ks,kp,nunc,nage,thread)+deposit(ks)*w
-#else
-      wetgriduncn(ix,jyp,ks,kp,nunc,nage)= &
-           wetgriduncn(ix,jyp,ks,kp,nunc,nage)+deposit(ks)*w
-#endif
-    endif
-
-  end do
-end subroutine wetdepokernel_nest
-
-subroutine writeprecip(itime,imem)
-
-  !*****************************************************************************
-  !                                                                            *
-  !  This routine produces a file containing total precipitation for each      *
-  !  releases point.                                                           *
-  !                                                                            *
-  !     Author: S. Eckhardt                                                    * 
-  !     7 Mai 2017                                                             *
-  !*****************************************************************************
-
-  use point_mod
-  use par_mod
-  use com_mod
-  use date_mod
-  use windfields_mod
-
-  implicit none
-
-  integer :: jjjjmmdd,ihmmss,itime,i
-  real(kind=dp) :: jul
-  character :: adate*8,atime*6
-
-  integer :: ix,jy,imem
-  real :: xp1,yp1
-
-  
-  if (itime.eq.0) then
-      open(unitprecip,file=path(2)(1:length(2))//'wetscav_precip.txt', &
-       form='formatted',err=998)
-  else
-      open(unitprecip,file=path(2)(1:length(2))//'wetscav_precip.txt', &
-       ACCESS='APPEND',form='formatted',err=998)
-  endif
-
-  jul=bdate+real(itime,kind=dp)/86400._dp
-  call caldate(jul,jjjjmmdd,ihmmss)
-  write(adate,'(i8.8)') jjjjmmdd
-  write(atime,'(i6.6)') ihmmss
-
-  do i=1,numpoint
-    xp1=xpoint1(i)*dx+xlon0 !lat, long (real) coord
-    yp1=ypoint1(i)*dy+ylat0 !lat, long (real) coord
-    ix=int((xpoint1(i)+xpoint2(i))/2.)
-    jy=int((ypoint1(i)+ypoint2(i))/2.)
-    write(unitprecip,*)  jjjjmmdd, ihmmss, & 
-           xp1,yp1,lsprec(ix,jy,1,imem),convprec(ix,jy,1,imem) !time is the same as in the ECMWF windfield
-! units mm/h, valid for the time given in the windfield
-  end do
+#include "wet_wetdepo.f90"
 
-  close(unitprecip)
+#include "wet_get_wetscav.f90"
 
-  return
+#include "wet_wetdepokernel.f90"
 
+#include "wet_wetdepokernel_nest.f90"
 
-998   write(*,*) ' #### FLEXPART MODEL ERROR!   THE FILE         #### '
-  write(*,*) ' #### '//path(2)(1:length(2))//'header_txt'//' #### '
-  write(*,*) ' #### CANNOT BE OPENED. IF A FILE WITH THIS    #### '
-  write(*,*) ' #### NAME ALREADY EXISTS, DELETE IT AND START #### '
-  write(*,*) ' #### THE PROGRAM AGAIN.                       #### '
-  stop
-end subroutine writeprecip
+#include "wet_writeprecip.f90"
 
 end module wetdepo_mod
diff --git a/src/win_alloc_windf.f90 b/src/win_alloc_windf.f90
new file mode 100644
index 0000000000000000000000000000000000000000..e26b6a2bd4d1131c7d5d8b2631ea2a8a03e60555
--- /dev/null
+++ b/src/win_alloc_windf.f90
@@ -0,0 +1,82 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine alloc_windf
+
+  ! Eta coordinates
+  !****************
+  allocate(uueta(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
+  allocate(vveta(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
+  allocate(wweta(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
+  allocate(uupoleta(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
+  allocate(vvpoleta(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
+  allocate(tteta(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
+  allocate(pveta(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
+  allocate(prseta(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
+  allocate(rhoeta(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
+  allocate(drhodzeta(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
+  !allocate(tvirtual(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
+  allocate(etauvheight(0:nxmax-1,0:nymax-1,nuvzmax,numwfmem))
+  allocate(etawheight(0:nxmax-1,0:nymax-1,nuvzmax,numwfmem))
+
+  ! Intrinsic coordinates
+  !**********************
+  allocate(uu(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
+  allocate(vv(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
+  allocate(ww(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
+  allocate(uupol(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
+  allocate(vvpol(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
+  allocate(tt(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
+  allocate(tth(0:nxmax-1,0:nymax-1,nuvzmax,numwfmem))
+  allocate(qv(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
+  allocate(qvh(0:nxmax-1,0:nymax-1,nuvzmax,numwfmem))
+  allocate(rho(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
+  allocate(drhodz(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
+  allocate(pplev(0:nxmax-1,0:nymax-1,nuvzmax,numwfmem))
+  allocate(prs(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
+  allocate(rho_dry(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
+
+  ! Cloud data
+  !***********
+  allocate(clwc(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
+  allocate(ciwc(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
+  allocate(clw(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
+  allocate(clwch(0:nxmax-1,0:nymax-1,nuvzmax,numwfmem))
+  allocate(ciwch(0:nxmax-1,0:nymax-1,nuvzmax,numwfmem))
+  clwc=0.0
+  ciwc=0.0
+  clw=0.0
+  clwch=0.0
+  ciwch=0.0
+  allocate(ctwc(0:nxmax-1,0:nymax-1,numwfmem))
+  allocate(cloudsh(0:nxmax-1,0:nymax-1,numwfmem))
+  allocate(clouds(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
+
+  ! 2d fields
+  !**********
+  allocate(ps(0:nxmax-1,0:nymax-1,1,numwfmem))
+  allocate(sd(0:nxmax-1,0:nymax-1,1,numwfmem))
+  allocate(msl(0:nxmax-1,0:nymax-1,1,numwfmem))
+  allocate(tcc(0:nxmax-1,0:nymax-1,1,numwfmem))
+  allocate(u10(0:nxmax-1,0:nymax-1,1,numwfmem))
+  allocate(v10(0:nxmax-1,0:nymax-1,1,numwfmem))
+  allocate(tt2(0:nxmax-1,0:nymax-1,1,numwfmem))
+  allocate(td2(0:nxmax-1,0:nymax-1,1,numwfmem))
+  allocate(lsprec(0:nxmax-1,0:nymax-1,1,numwfmem))
+  allocate(convprec(0:nxmax-1,0:nymax-1,1,numwfmem))
+  allocate(sshf(0:nxmax-1,0:nymax-1,1,numwfmem))
+  allocate(ssr(0:nxmax-1,0:nymax-1,1,numwfmem))
+  allocate(sfcstress(0:nxmax-1,0:nymax-1,1,numwfmem))
+  allocate(ustar(0:nxmax-1,0:nymax-1,1,numwfmem))
+  allocate(wstar(0:nxmax-1,0:nymax-1,1,numwfmem))
+  allocate(hmix(0:nxmax-1,0:nymax-1,1,numwfmem))
+  allocate(tropopause(0:nxmax-1,0:nymax-1,1,numwfmem))
+  allocate(oli(0:nxmax-1,0:nymax-1,1,numwfmem))
+
+  ! Vertical descritisation arrays
+  !*******************************
+  allocate(height(nzmax),wheight(nzmax),uvheight(nzmax))
+  allocate(akm(nwzmax),bkm(nwzmax),akz(nuvzmax),bkz(nuvzmax), &
+    aknew(nzmax),bknew(nzmax))
+
+end subroutine alloc_windf
diff --git a/src/win_alloc_windf_nest.f90 b/src/win_alloc_windf_nest.f90
new file mode 100644
index 0000000000000000000000000000000000000000..866892dae5180ca6602e1ac8248ff82f24096f8a
--- /dev/null
+++ b/src/win_alloc_windf_nest.f90
@@ -0,0 +1,96 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine alloc_windf_nest
+!****************************************************************************
+! Dynamic allocation of arrays
+!
+! For nested wind fields.
+!
+!****************************************************************************
+
+  allocate(wfnamen(maxnests,maxwf))
+  allocate(wfspecn(maxnests,maxwf))
+
+  allocate(nxn(maxnests))
+  allocate(nyn(maxnests))
+  allocate(dxn(maxnests))
+  allocate(dyn(maxnests))
+  allocate(xlon0n(maxnests))
+  allocate(ylat0n(maxnests))
+
+  allocate(oron(0:nxmaxn-1,0:nymaxn-1,maxnests))
+  allocate(excessoron(0:nxmaxn-1,0:nymaxn-1,maxnests))
+  allocate(lsmn(0:nxmaxn-1,0:nymaxn-1,maxnests))
+
+  allocate(uun(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests))
+  allocate(vvn(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests))
+  allocate(wwn(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests))
+  allocate(ttn(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests))
+  allocate(qvn(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests))
+  allocate(pvn(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests))
+  allocate(clwcn(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests))
+  allocate(ciwcn(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests))
+  allocate(clwn(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests))
+
+  ! ETA equivalents
+  allocate(uuetan(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests))
+  allocate(vvetan(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests))
+  allocate(wwetan(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests))
+  allocate(ttetan(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests))
+  allocate(pvetan(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests))
+  allocate(prsetan(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests))
+  allocate(rhoetan(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests))
+  allocate(drhodzetan(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests))
+  ! allocate(tvirtualn(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests))
+  allocate(etauvheightn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,numwfmem,numbnests))
+  allocate(etawheightn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,numwfmem,numbnests))
+
+  allocate(cloudsn(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests))
+  allocate(cloudshn(0:nxmaxn-1,0:nymaxn-1,numwfmem,numbnests))
+  allocate(prsn(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests))
+  allocate(rhon(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests))
+  allocate(drhodzn(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests))
+  allocate(tthn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,numwfmem,numbnests))
+  allocate(qvhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,numwfmem,numbnests))
+  allocate(clwchn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,numwfmem,numbnests))
+  allocate(ciwchn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,numwfmem,numbnests))
+  allocate(ctwcn(0:nxmaxn-1,0:nymaxn-1,numwfmem,numbnests))
+
+  ! 2d fields
+  !***********
+  allocate(psn(0:nxmaxn-1,0:nymaxn-1,1,numwfmem,maxnests))
+  allocate(sdn(0:nxmaxn-1,0:nymaxn-1,1,numwfmem,maxnests))
+  allocate(msln(0:nxmaxn-1,0:nymaxn-1,1,numwfmem,maxnests))
+  allocate(tccn(0:nxmaxn-1,0:nymaxn-1,1,numwfmem,maxnests))
+  allocate(u10n(0:nxmaxn-1,0:nymaxn-1,1,numwfmem,maxnests))
+  allocate(v10n(0:nxmaxn-1,0:nymaxn-1,1,numwfmem,maxnests))
+  allocate(tt2n(0:nxmaxn-1,0:nymaxn-1,1,numwfmem,maxnests))
+  allocate(td2n(0:nxmaxn-1,0:nymaxn-1,1,numwfmem,maxnests))
+  allocate(lsprecn(0:nxmaxn-1,0:nymaxn-1,1,numwfmem,maxnests))
+  allocate(convprecn(0:nxmaxn-1,0:nymaxn-1,1,numwfmem,maxnests))
+  allocate(sshfn(0:nxmaxn-1,0:nymaxn-1,1,numwfmem,maxnests))
+  allocate(ssrn(0:nxmaxn-1,0:nymaxn-1,1,numwfmem,maxnests))
+  allocate(sfcstressn(0:nxmaxn-1,0:nymaxn-1,1,numwfmem,maxnests))
+  allocate(ustarn(0:nxmaxn-1,0:nymaxn-1,1,numwfmem,maxnests))
+  allocate(wstarn(0:nxmaxn-1,0:nymaxn-1,1,numwfmem,maxnests))
+  allocate(hmixn(0:nxmaxn-1,0:nymaxn-1,1,numwfmem,maxnests))
+  allocate(tropopausen(0:nxmaxn-1,0:nymaxn-1,1,numwfmem,maxnests))
+  allocate(olin(0:nxmaxn-1,0:nymaxn-1,1,numwfmem,maxnests))
+  allocate(vdepn(0:nxmaxn-1,0:nymaxn-1,maxspec,numwfmem,maxnests))
+
+  allocate(xresoln(0:maxnests))
+  allocate(yresoln(0:maxnests))
+  allocate(xln(maxnests))
+  allocate(yln(maxnests))
+  allocate(xrn(maxnests))
+  allocate(yrn(maxnests))
+
+  ! Initialise
+  !************
+  clwcn(:,:,:,:,:)=0.
+  ciwcn(:,:,:,:,:)=0.
+  clwchn(:,:,:,:,:)=0.
+  ciwchn(:,:,:,:,:)=0.
+
+end subroutine alloc_windf_nest
diff --git a/src/win_dealloc_windf.f90 b/src/win_dealloc_windf.f90
new file mode 100644
index 0000000000000000000000000000000000000000..8da2638a500762d1d878f5f2d325fdf6b5a7bc82
--- /dev/null
+++ b/src/win_dealloc_windf.f90
@@ -0,0 +1,15 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine dealloc_windf
+
+  deallocate(oro,excessoro,lsm)
+  deallocate(uueta,vveta,wweta,uupoleta,vvpoleta,tteta,pveta, &
+    prseta,rhoeta,drhodzeta,etauvheight,etawheight)
+  deallocate(uu,vv,ww,uupol,vvpol,tt,tth,qv,qvh,pv,rho,drhodz,pplev,prs,rho_dry)
+  deallocate(clwc,ciwc,clw,clwch,ciwch,ctwc,cloudsh,clouds)
+  deallocate(ps,sd,msl,tcc,u10,v10,tt2,td2,lsprec,convprec,sshf,ssr,sfcstress, &
+    ustar,wstar,hmix,tropopause,oli)
+  deallocate(height,wheight,uvheight,akm,bkm,akz,bkz,aknew,bknew)
+
+end subroutine dealloc_windf
diff --git a/src/win_dealloc_windf_nest.f90 b/src/win_dealloc_windf_nest.f90
new file mode 100644
index 0000000000000000000000000000000000000000..80c89f490ce4da3566d2fec3d798a9ac1466e219
--- /dev/null
+++ b/src/win_dealloc_windf_nest.f90
@@ -0,0 +1,17 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine dealloc_windf_nest
+
+  deallocate(wfnamen,wfspecn)
+  deallocate(nxn,nyn,dxn,dyn,xlon0n,ylat0n)
+  deallocate(oron,excessoron,lsmn)
+  deallocate(uun,vvn,wwn,ttn,qvn,pvn,clwcn,ciwcn,clwn,cloudsn, &
+    cloudshn,rhon,prsn,drhodzn,tthn,qvhn,clwchn,ciwchn,ctwcn)
+  deallocate(uuetan,vvetan,wwetan,ttetan,pvetan,prsetan,rhoetan, &
+    drhodzetan,etauvheightn,etawheightn)
+  deallocate(psn,sdn,msln,tccn,u10n,v10n,tt2n,td2n,lsprecn,convprecn, &
+    sshfn,ssrn,sfcstressn,ustarn,wstarn,hmixn,tropopausen,olin,vdepn)
+  deallocate(xresoln,yresoln,xln,yln,xrn,yrn)
+
+end subroutine dealloc_windf_nest
diff --git a/src/win_detectformat.f90 b/src/win_detectformat.f90
new file mode 100644
index 0000000000000000000000000000000000000000..a3ef9d22e994e310d67854778fb9eea2503d6e6e
--- /dev/null
+++ b/src/win_detectformat.f90
@@ -0,0 +1,47 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine detectformat
+
+  !*****************************************************************************
+  !                                                                            *
+  !   This routine reads the 1st file with windfields to determine             *
+  !   the format.                                                              *
+  !                                                                            *
+  !     Authors: M. Harustak                                                   *
+  !                                                                            *
+  !     6 May 2015                                                             *
+  !                                                                            *
+  !   Unified ECMWF and GFS builds                                             *
+  !   Marian Harustak, 12.5.2017                                               *
+  !     - Added routine to FP10 Flexpart distribution                          *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! fname                file name of file to check                            *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+  use class_gribfile_mod
+
+
+  implicit none
+
+  character(len=255) :: filename
+  character(len=255) :: wfname1(maxwf)
+
+  ! If no file is available
+  if ( maxwf.le.0 ) then
+    print*,'No wind file available'
+    metdata_format = GRIBFILE_CENTRE_UNKNOWN
+    return
+  endif
+
+  ! construct filename
+  filename = path(3)(1:length(3)) // trim(wfname(1))
+
+  ! get format
+  metdata_format = gribfile_centre(TRIM(filename))
+end subroutine detectformat
diff --git a/src/win_fixedfields_alloc.f90 b/src/win_fixedfields_alloc.f90
new file mode 100644
index 0000000000000000000000000000000000000000..e4d71d2d49baeb5497f182f3d69ed9c3b06ed9f5
--- /dev/null
+++ b/src/win_fixedfields_alloc.f90
@@ -0,0 +1,11 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine fixedfields_alloc
+
+  allocate(oro(0:nxmax-1,0:nymax-1))
+  allocate(excessoro(0:nxmax-1,0:nymax-1))
+  allocate(lsm(0:nxmax-1,0:nymax-1))
+  allocate(pv(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
+
+end subroutine fixedfields_alloc
diff --git a/src/win_gridcheck_ecmwf.f90 b/src/win_gridcheck_ecmwf.f90
new file mode 100644
index 0000000000000000000000000000000000000000..91e20ff1ca8b12f5ce5b157a1b70953aff29a14d
--- /dev/null
+++ b/src/win_gridcheck_ecmwf.f90
@@ -0,0 +1,568 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine gridcheck_ecmwf
+
+  !**********************************************************************
+  !                                                                     *
+  !             FLEXPART MODEL SUBROUTINE GRIDCHECK                     *
+  !                                                                     *
+  !**********************************************************************
+  !                                                                     *
+  !             AUTHOR:      G. WOTAWA                                  *
+  !             DATE:        1997-08-06                                 *
+  !             LAST UPDATE: 1997-10-10                                 *
+  !                                                                     *
+  !             Update:      1999-02-08, global fields allowed, A. Stohl*
+  !             CHANGE: 11/01/2008, Harald Sodemann, GRIB1/2 input with *
+  !                                 ECMWF grib_api                      *
+  !             CHANGE: 03/12/2008, Harald Sodemann, update to f90 with *
+  !                                 ECMWF grib_api                      *
+  !                                                                     *
+  !   Unified ECMWF and GFS builds                                      *
+  !   Marian Harustak, 12.5.2017                                        *
+  !     - Renamed from gridcheck to gridcheck_ecmwf                     *
+  !                                                                     *
+  !**********************************************************************
+  !                                                                     *
+  ! DESCRIPTION:                                                        *
+  !                                                                     *
+  ! THIS SUBROUTINE DETERMINES THE GRID SPECIFICATIONS (LOWER LEFT      *
+  ! LONGITUDE, LOWER LEFT LATITUDE, NUMBER OF GRID POINTS, GRID DIST-   *
+  ! ANCE AND VERTICAL DISCRETIZATION OF THE ECMWF MODEL) FROM THE       *
+  ! GRIB HEADER OF THE FIRST INPUT FILE. THE CONSISTANCY (NO CHANGES    *
+  ! WITHIN ONE FLEXPART RUN) IS CHECKED IN THE ROUTINE "READWIND" AT    *
+  ! ANY CALL.                                                           *
+  !                                                                     *
+  ! XLON0                geographical longitude of lower left gridpoint *
+  ! YLAT0                geographical latitude of lower left gridpoint  *
+  ! NX                   number of grid points x-direction              *
+  ! NY                   number of grid points y-direction              *
+  ! DX                   grid distance x-direction                      *
+  ! DY                   grid distance y-direction                      *
+  ! NUVZ                 number of grid points for horizontal wind      *
+  !                      components in z direction                      *
+  ! NWZ                  number of grid points for vertical wind        *
+  !                      component in z direction                       *
+  ! sizesouth, sizenorth give the map scale (i.e. number of virtual grid*
+  !                      points of the polar stereographic grid):       *
+  !                      used to check the CFL criterion                *
+  ! UVHEIGHT(1)-         heights of gridpoints where u and v are        *
+  ! UVHEIGHT(NUVZ)       given                                          *
+  ! WHEIGHT(1)-          heights of gridpoints where w is given         *
+  ! WHEIGHT(NWZ)                                                        *
+  !                                                                     *
+  !**********************************************************************
+
+  use grib_api
+  use cmapf_mod, only: stlmbr,stcm2p
+
+  implicit none
+
+  !HSO  parameters for grib_api
+  integer :: ifile
+  integer :: iret
+  integer :: igrib
+  integer :: gotGrid
+  real(kind=4) :: xaux1,xaux2,yaux1,yaux2
+  real(kind=8) :: xaux1in,xaux2in,yaux1in,yaux2in
+  integer :: gribVer,parCat,parNum,sfctyp,ivalsfc,discipl,parId
+  !HSO  end
+  integer :: ix,jy,i,ifn,ifield,j,k,iumax,iwmax,numskip
+  real :: sizesouth,sizenorth,xauxa,conversion_factor
+
+  ! VARIABLES AND ARRAYS NEEDED FOR GRIB DECODING
+
+  ! dimension of isec2 at least (22+n), where n is the number of parallels or
+  ! meridians in a quasi-regular (reduced) Gaussian or lat/long grid
+
+  ! dimension of zsec2 at least (10+nn), where nn is the number of vertical
+  ! coordinate parameters
+
+  integer :: isec1(56),isec2(22+nxmax+nymax)
+  real(kind=4) :: zsec2(60+2*nuvzmax),zsec4(jpunp)
+  character(len=1) :: opt
+
+  !HSO  grib api error messages
+  character(len=24) :: gribErrorMsg = 'Error reading grib file'
+  character(len=20) :: gribFunction = 'gridcheck'
+
+
+  iumax=0
+  iwmax=0
+
+  if(ideltas.gt.0) then
+    ifn=1
+  else
+    ifn=numbwf
+  endif
+  !
+  ! OPENING OF DATA FILE (GRIB CODE)
+  !
+5 call grib_open_file(ifile,path(3)(1:length(3)) &
+       //trim(wfname(ifn)),'r',iret)
+  if (iret.ne.GRIB_SUCCESS) then
+    goto 999   ! ERROR DETECTED
+  endif
+  !turn on support for multi fields messages
+  !call grib_multi_support_on
+
+  gotGrid=0
+  ifield=0
+  do while(.true.)
+    ifield=ifield+1
+    !
+    ! GET NEXT FIELDS
+    !
+    call grib_new_from_file(ifile,igrib,iret)
+    if (iret.eq.GRIB_END_OF_FILE ) then
+      exit   ! EOF DETECTED
+    elseif (iret.ne.GRIB_SUCCESS) then
+      goto 999   ! ERROR DETECTED
+    endif
+
+    !first see if we read GRIB1 or GRIB2
+    call grib_get_int(igrib,'editionNumber',gribVer,iret)
+    call grib_check(iret,gribFunction,gribErrorMsg)
+
+    if (gribVer.eq.1) then ! GRIB Edition 1
+
+      !print*,'GRiB Edition 1'
+      !read the grib2 identifiers
+      call grib_get_int(igrib,'indicatorOfParameter',isec1(6),iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+      call grib_get_int(igrib,'level',isec1(8),iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+
+      !change code for etadot to code for omega
+      if (isec1(6).eq.77) then
+        isec1(6)=135
+      endif
+
+      !print*,isec1(6),isec1(8)
+
+    else
+
+      !print*,'GRiB Edition 2'
+      !read the grib2 identifiers
+      call grib_get_int(igrib,'discipline',discipl,iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+      call grib_get_int(igrib,'parameterCategory',parCat,iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+      call grib_get_int(igrib,'parameterNumber',parNum,iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+      call grib_get_int(igrib,'typeOfFirstFixedSurface',sfctyp,iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+      call grib_get_int(igrib,'level',ivalsfc,iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+      call grib_get_int(igrib,'paramId',parId,iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+
+      !print*,discipl,parCat,parNum,sfctyp,ivalsfc
+
+      !convert to grib1 identifiers
+      isec1(6)=-1
+      isec1(7)=-1
+      isec1(8)=-1
+      isec1(8)=ivalsfc     ! level
+      if ((parCat.eq.0).and.(parNum.eq.0).and.(sfctyp.eq.105)) then ! T
+        isec1(6)=130         ! indicatorOfParameter
+      elseif ((parCat.eq.2).and.(parNum.eq.2).and.(sfctyp.eq.105)) then ! U
+        isec1(6)=131         ! indicatorOfParameter
+      elseif ((parCat.eq.2).and.(parNum.eq.3).and.(sfctyp.eq.105)) then ! V
+        isec1(6)=132         ! indicatorOfParameter
+      elseif ((parCat.eq.1).and.(parNum.eq.0).and.(sfctyp.eq.105)) then ! Q
+        isec1(6)=133         ! indicatorOfParameter
+        !ZHG FOR CLOUDS FROM GRIB
+      elseif ((parCat.eq.1).and.(parNum.eq.83).and.(sfctyp.eq.105)) then ! clwc
+        isec1(6)=246         ! indicatorOfParameter
+      elseif ((parCat.eq.1).and.(parNum.eq.84).and.(sfctyp.eq.105)) then ! ciwc
+        isec1(6)=247         ! indicatorOfParameter
+        !ZHG end
+        ! ESO qc(=clwc+ciwc)
+      elseif ((parCat.eq.201).and.(parNum.eq.31).and.(sfctyp.eq.105)) then ! qc
+        isec1(6)=201031      ! indicatorOfParameter
+      elseif ((parCat.eq.3).and.(parNum.eq.0).and.(sfctyp.eq.1)) then !SP
+        isec1(6)=134         ! indicatorOfParameter
+      elseif ((parCat.eq.2).and.(parNum.eq.32)) then ! W, actually eta dot
+        isec1(6)=135         ! indicatorOfParameter
+      elseif ((parCat.eq.128).and.(parNum.eq.77)) then ! W, actually eta dot
+        isec1(6)=135         ! indicatorOfParameter
+      elseif ((parCat.eq.3).and.(parNum.eq.0).and.(sfctyp.eq.101)) then !SLP
+        isec1(6)=151         ! indicatorOfParameter
+      elseif ((parCat.eq.2).and.(parNum.eq.2).and.(sfctyp.eq.103)) then ! 10U
+        isec1(6)=165         ! indicatorOfParameter
+      elseif ((parCat.eq.2).and.(parNum.eq.3).and.(sfctyp.eq.103)) then ! 10V
+        isec1(6)=166         ! indicatorOfParameter
+      elseif ((parCat.eq.0).and.(parNum.eq.0).and.(sfctyp.eq.103)) then ! 2T
+        isec1(6)=167         ! indicatorOfParameter
+      elseif ((parCat.eq.0).and.(parNum.eq.6).and.(sfctyp.eq.103)) then ! 2D
+        isec1(6)=168         ! indicatorOfParameter
+      elseif ((parCat.eq.1).and.(parNum.eq.11).and.(sfctyp.eq.1)) then ! SD
+        isec1(6)=141         ! indicatorOfParameter
+      elseif ((parCat.eq.6).and.(parNum.eq.1) .or. parId .eq. 164) then ! CC
+        isec1(6)=164         ! indicatorOfParameter
+      elseif ((parCat.eq.1).and.(parNum.eq.9) .or. parId .eq. 142) then ! LSP
+        isec1(6)=142         ! indicatorOfParameter
+      elseif ((parCat.eq.1).and.(parNum.eq.10)) then ! CP
+        isec1(6)=143         ! indicatorOfParameter
+      elseif ((parCat.eq.0).and.(parNum.eq.11).and.(sfctyp.eq.1)) then ! SHF
+        isec1(6)=146         ! indicatorOfParameter
+      elseif ((parCat.eq.4).and.(parNum.eq.9).and.(sfctyp.eq.1)) then ! SR
+        isec1(6)=176         ! indicatorOfParameter
+      elseif ((parCat.eq.2).and.(parNum.eq.17) .or. parId .eq. 180) then ! EWSS
+        isec1(6)=180         ! indicatorOfParameter
+      elseif ((parCat.eq.2).and.(parNum.eq.18) .or. parId .eq. 181) then ! NSSS
+        isec1(6)=181         ! indicatorOfParameter
+      elseif ((parCat.eq.3).and.(parNum.eq.4)) then ! ORO
+        isec1(6)=129         ! indicatorOfParameter
+      elseif ((parCat.eq.3).and.(parNum.eq.7) .or. parId .eq. 160) then ! SDO
+        isec1(6)=160         ! indicatorOfParameter
+      elseif ((discipl.eq.2).and.(parCat.eq.0).and.(parNum.eq.0).and. &
+           (sfctyp.eq.1)) then ! LSM
+        isec1(6)=172         ! indicatorOfParameter
+      else
+        print*,'***ERROR: undefined GRiB2 message found!',discipl, &
+             parCat,parNum,sfctyp
+      endif
+      if(parId .ne. isec1(6) .and. parId .ne. 77) then
+        write(*,*) 'parId',parId, 'isec1(6)',isec1(6)
+        !    stop
+      endif
+
+    endif
+
+    call grib_get_int(igrib,'numberOfPointsAlongAParallel', &
+         isec2(2),iret)
+    ! ! nx=isec2(2)
+    ! ! WRITE(*,*) nx,nxmax
+    ! if (isec2(2).gt.nxmax) then
+    !   WRITE(*,*) 'FLEXPART error: Too many grid points in x direction.'
+    !   WRITE(*,*) 'Reduce resolution of wind fields.'
+    !   WRITE(*,*) 'Or change parameter settings in file ecmwf_mod.'
+    !   WRITE(*,*) isec2(2),nxmax
+    ! !    STOP
+    ! endif
+
+    !get the size and data of the values array
+    if (isec1(6).ne.-1) then
+      call grib_get_real4_array(igrib,'values',zsec4,iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+    endif
+
+    if (ifield.eq.1) then
+
+      !HSO  get the required fields from section 2 in a gribex compatible manner
+      call grib_get_int(igrib,'numberOfPointsAlongAParallel', &
+           isec2(2),iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+      call grib_get_int(igrib,'numberOfPointsAlongAMeridian', &
+           isec2(3),iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+      call grib_get_real8(igrib,'longitudeOfFirstGridPointInDegrees', &
+           xaux1in,iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+      call grib_get_int(igrib,'numberOfVerticalCoordinateValues', &
+           isec2(12),iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+
+      nxfield=isec2(2)
+      ny=isec2(3)
+      nlev_ec=isec2(12)/2-1
+
+      !  get the size and data of the vertical coordinate array
+      call grib_get_real4_array(igrib,'pv',zsec2,iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+    endif
+
+    !HSO  get the second part of the grid dimensions only from GRiB1 messages
+    if (isec1(6) .eq. 167 .and. (gotGrid.eq.0)) then
+      call grib_get_real8(igrib,'longitudeOfLastGridPointInDegrees', &
+           xaux2in,iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+      call grib_get_real8(igrib,'latitudeOfLastGridPointInDegrees', &
+           yaux1in,iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+      call grib_get_real8(igrib,'latitudeOfFirstGridPointInDegrees', &
+           yaux2in,iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+      xaux1=xaux1in
+      xaux2=xaux2in
+      yaux1=yaux1in
+      yaux2=yaux2in
+      if (xaux1.gt.180.) xaux1=xaux1-360.0
+      if (xaux2.gt.180.) xaux2=xaux2-360.0
+      if (xaux1.lt.-180.) xaux1=xaux1+360.0
+      if (xaux2.lt.-180.) xaux2=xaux2+360.0
+      if (xaux2.lt.xaux1) xaux2=xaux2+360.0
+      xlon0=xaux1
+      ylat0=yaux1
+      dx=(xaux2-xaux1)/real(nxfield-1)
+      dy=(yaux2-yaux1)/real(ny-1)
+      dxconst=180./(dx*r_earth*pi)
+      dyconst=180./(dy*r_earth*pi)
+      gotGrid=1
+      ! Check whether fields are global
+      ! If they contain the poles, specify polar stereographic map
+      ! projections using the stlmbr- and stcm2p-calls
+      !***********************************************************
+
+      xauxa=abs(xaux2+dx-360.-xaux1)
+      if (xauxa.lt.0.001) then
+        nx=nxfield+1                 ! field is cyclic
+        xglobal=.true.
+        if (abs(nxshift).ge.nx) &
+             stop 'nxshift in file par_mod is too large'
+        xlon0=xlon0+real(nxshift)*dx
+      else
+        nx=nxfield
+        xglobal=.false.
+        if (nxshift.ne.0) &
+             stop 'nxshift (par_mod) must be zero for non-global domain'
+      endif
+      nxmin1=nx-1
+      nymin1=ny-1
+      if (xlon0.gt.180.) xlon0=xlon0-360.
+      xauxa=abs(yaux1+90.)
+      if (xglobal.and.xauxa.lt.0.001) then
+        sglobal=.true.               ! field contains south pole
+        ! Enhance the map scale by factor 3 (*2=6) compared to north-south
+        ! map scale
+        sizesouth=6.*(switchsouth+90.)/dy
+        call stlmbr(southpolemap,-90.,0.)
+        call stcm2p(southpolemap,0.,0.,switchsouth,0.,sizesouth, &
+             sizesouth,switchsouth,180.)
+        switchsouthg=(switchsouth-ylat0)/dy
+      else
+        sglobal=.false.
+        switchsouthg=999999.
+      endif
+      xauxa=abs(yaux2-90.)
+      if (xglobal.and.xauxa.lt.0.001) then
+        nglobal=.true.               ! field contains north pole
+        ! Enhance the map scale by factor 3 (*2=6) compared to north-south
+        ! map scale
+        sizenorth=6.*(90.-switchnorth)/dy
+        call stlmbr(northpolemap,90.,0.)
+        call stcm2p(northpolemap,0.,0.,switchnorth,0.,sizenorth, &
+             sizenorth,switchnorth,180.)
+        switchnorthg=(switchnorth-ylat0)/dy
+      else
+        nglobal=.false.
+        switchnorthg=999999.
+      endif
+      if (nxshift.lt.0) &
+           stop 'nxshift (par_mod) must not be negative'
+      if (nxshift.ge.nxfield) stop 'nxshift (par_mod) too large'
+    endif ! gotGrid
+
+    if (nx.gt.nxmax) then
+      write(*,*) 'FLEXPART error: Too many grid points in x direction.'
+      write(*,*) 'Reduce resolution of wind fields.'
+      write(*,*) 'Or change parameter settings in file par_mod.'
+      write(*,*) nx,nxmax
+      stop
+    endif
+
+    if (ny.gt.nymax) then
+      write(*,*) 'FLEXPART error: Too many grid points in y direction.'
+      write(*,*) 'Reduce resolution of wind fields.'
+      write(*,*) 'Or change parameter settings in file par_mod.'
+      write(*,*) ny,nymax
+      stop
+    endif
+
+    k=isec1(8)
+    if(isec1(6).eq.131) iumax=max(iumax,nlev_ec-k+1)
+    if(isec1(6).eq.135) iwmax=max(iwmax,nlev_ec-k+1)
+
+    if (isec1(6) .eq. 167) then
+      ! ! Assing grid values and allocate memory to read windfields
+      ! nxmax=nxfield
+      ! if (xglobal) then
+      !   nxmax=nxfield+1
+      ! endif
+      ! nymax=ny
+      ! nwzmax=iwmax+1
+      ! nuvzmax=iumax+1
+      ! nzmax=nuvzmax
+      ! nconvlevmax=iumax
+      ! na=nuvzmax
+      ! ! Temporary nxmax and nymax
+      call fixedfields_alloc
+    endif
+
+    if(isec1(6).eq.129) then
+      do jy=0,ny-1
+        do ix=0,nxfield-1
+          oro(ix,jy)=zsec4(nxfield*(ny-jy-1)+ix+1)/ga
+        end do
+      end do
+    endif
+    if(isec1(6).eq.172) then
+      do jy=0,ny-1
+        do ix=0,nxfield-1
+          lsm(ix,jy)=zsec4(nxfield*(ny-jy-1)+ix+1)
+        end do
+      end do
+    endif
+    if(isec1(6).eq.160) then
+      do jy=0,ny-1
+        do ix=0,nxfield-1
+          excessoro(ix,jy)=zsec4(nxfield*(ny-jy-1)+ix+1)
+        end do
+      end do
+    endif
+
+    call grib_release(igrib)
+  end do                      !! READ NEXT LEVEL OR PARAMETER
+  !
+  ! CLOSING OF INPUT DATA FILE
+  !
+  call grib_close_file(ifile)
+
+  ! call alloc_windf
+
+  !error message if no fields found with correct first longitude in it
+  if (gotGrid.eq.0) then
+    print*,'***ERROR: input file needs to contain GRiB1 formatted'// &
+         'messages'
+    stop
+  endif
+
+  nuvz=iumax
+  nwz =iwmax
+  if(nuvz.eq.nlev_ec) nwz=nlev_ec+1
+
+  ! if (nuvz+1.gt.nuvzmax) then
+  !   write(*,*) 'FLEXPART error: Too many u,v grid points in z '// &
+  !        'direction.'
+  !   write(*,*) 'Reduce resolution of wind fields.'
+  !   write(*,*) 'Or change parameter settings in file par_mod.'
+  !   write(*,*) nuvz+1,nuvzmax
+  !   stop
+  ! endif
+
+  ! if (nwz.gt.nwzmax) then
+  !   write(*,*) 'FLEXPART error: Too many w grid points in z '// &
+  !        'direction.'
+  !   write(*,*) 'Reduce resolution of wind fields.'
+  !   write(*,*) 'Or change parameter settings in file par_mod.'
+  !   write(*,*) nwz,nwzmax
+  !   stop
+  ! endif
+
+  ! If desired, shift all grids by nxshift grid cells
+  !**************************************************
+
+  if (xglobal) then
+    call shift_field_0(oro,nxfield,ny)
+    call shift_field_0(lsm,nxfield,ny)
+    call shift_field_0(excessoro,nxfield,ny)
+  endif
+
+  ! Output of grid info
+  !********************
+
+  if (lroot) then
+    write(*,'(a,2i7)') ' Vertical levels in ECMWF data: ', &
+         nuvz+1,nwz
+    write(*,*)
+    write(*,'(a)') ' Mother domain:'
+    write(*,'(a,f10.5,a,f10.5,a,f10.5)') '  Longitude range: ', &
+         xlon0,' to ',xlon0+(nx-1)*dx,'   Grid distance: ',dx
+    write(*,'(a,f10.5,a,f10.5,a,f10.5)') '  Latitude range : ', &
+         ylat0,' to ',ylat0+(ny-1)*dy,'   Grid distance: ',dy
+    write(*,*)
+  end if
+
+  ! CALCULATE VERTICAL DISCRETIZATION OF ECMWF MODEL
+  ! PARAMETER akm,bkm DESCRIBE THE HYBRID "ETA" COORDINATE SYSTEM
+
+  numskip=nlev_ec-nuvz  ! number of ecmwf model layers not used
+  ! by trajectory model
+  !do 8940 i=1,244
+  !   write (*,*) 'zsec2:',i,ifield,zsec2(i),numskip
+  !940  continue
+  !   stop
+  ! SEC SEC SEC
+  ! for unknown reason zsec 1 to 10 is filled in this version
+  ! compared to the old one
+  ! SEC SEC SE
+  do i=1,nwz
+    j=numskip+i
+    k=nlev_ec+1+numskip+i
+    akm(nwz-i+1)=zsec2(j)
+    !   write (*,*) 'ifield:',ifield,k,j,zsec2(10+j)
+    bkm(nwz-i+1)=zsec2(k)
+    wheight(nwz-i+1)=akm(nwz-i+1)/101325.+bkm(nwz-i+1) ! From FLEXTRA
+  end do
+
+  !
+  ! CALCULATION OF AKZ, BKZ
+  ! AKZ,BKZ: model discretization parameters at the center of each model
+  !     layer
+  !
+  ! Assign the 10 m winds to an artificial model level with akz=0 and bkz=1.0,
+  ! i.e. ground level
+  !*****************************************************************************
+
+  akz(1)=0.
+  bkz(1)=1.0
+  uvheight(1)=1.
+  do i=1,nuvz
+    uvheight(i+1)=0.5*(wheight(i+1)+wheight(i)) ! From FLEXTRA
+    akz(i+1)=0.5*(akm(i+1)+akm(i))
+    bkz(i+1)=0.5*(bkm(i+1)+bkm(i))
+  end do
+  ! exuvheight=wheight
+  nuvz=nuvz+1
+
+  ! NOTE: In FLEXPART versions up to 4.0, the number of model levels was doubled
+  ! upon the transformation to z levels. In order to save computer memory, this is
+  ! not done anymore in the standard version. However, this option can still be
+  ! switched on by replacing the following lines with those below, that are
+  ! currently commented out. For this, similar changes are necessary in
+  ! verttransform.f and verttranform_nest.f
+  !*****************************************************************************
+
+  nz=nuvz
+  if (nz.gt.nzmax) stop 'nzmax too small'
+  do i=1,nuvz
+    aknew(i)=akz(i)
+    bknew(i)=bkz(i)
+  end do
+
+  ! Switch on following lines to use doubled vertical resolution
+  !*************************************************************
+  !nz=nuvz+nwz-1
+  !if (nz.gt.nzmax) stop 'nzmax too small'
+  !do 100 i=1,nwz
+  !  aknew(2*(i-1)+1)=akm(i)
+  !00     bknew(2*(i-1)+1)=bkm(i)
+  !do 110 i=2,nuvz
+  !  aknew(2*(i-1))=akz(i)
+  !10     bknew(2*(i-1))=bkz(i)
+  ! End doubled vertical resolution
+  return
+
+999 write(*,*)
+  write(*,*) ' ###########################################'// &
+       '###### '
+  write(*,*) '       TRAJECTORY MODEL SUBROUTINE GRIDCHECK:'
+  write(*,*) ' CAN NOT OPEN INPUT DATA FILE '//wfname(ifn)
+  write(*,*) ' ###########################################'// &
+       '###### '
+  write(*,*)
+  write(*,'(a)') '!!! PLEASE INSERT A NEW CD-ROM AND   !!!'
+  write(*,'(a)') '!!! PRESS ANY KEY TO CONTINUE...     !!!'
+  write(*,'(a)') '!!! ...OR TERMINATE FLEXPART PRESSING!!!'
+  write(*,'(a)') '!!! THE "X" KEY...                   !!!'
+  write(*,*)
+  read(*,'(a)') opt
+  if(opt.eq.'X') then
+    stop
+  else
+    goto 5
+  endif
+end subroutine gridcheck_ecmwf
diff --git a/src/win_gridcheck_gfs.f90 b/src/win_gridcheck_gfs.f90
new file mode 100644
index 0000000000000000000000000000000000000000..c8d122aca88425c2f3a939311abfbcfd2fa40a56
--- /dev/null
+++ b/src/win_gridcheck_gfs.f90
@@ -0,0 +1,521 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine gridcheck_gfs
+
+  !**********************************************************************
+  !                                                                     *
+  !             FLEXPART MODEL SUBROUTINE GRIDCHECK                     *
+  !                                                                     *
+  !**********************************************************************
+  !                                                                     *
+  !             AUTHOR:      G. WOTAWA                                  *
+  !             DATE:        1997-08-06                                 *
+  !             LAST UPDATE: 1997-10-10                                 *
+  !                                                                     *
+  !             Update:      1999-02-08, global fields allowed, A. Stohl*
+  !             CHANGE: 17/11/2005, Caroline Forster, GFS data          *
+  !             CHANGE: 11/01/2008, Harald Sodemann, GRIB1/2 input with *
+  !                                 ECMWF grib_api                      *
+  !             CHANGE: 03/12/2008, Harald Sodemann, update to f90 with *
+  !                                 ECMWF grib_api                      *
+  !                                                                     *
+  !   Unified ECMWF and GFS builds                                      *
+  !   Marian Harustak, 12.5.2017                                        *
+  !     - Renamed routine from gridcheck to gridcheck_gfs               *
+  !                                                                     *
+  !**********************************************************************
+  !                                                                     *
+  ! DESCRIPTION:                                                        *
+  !                                                                     *
+  ! THIS SUBROUTINE DETERMINES THE GRID SPECIFICATIONS (LOWER LEFT      *
+  ! LONGITUDE, LOWER LEFT LATITUDE, NUMBER OF GRID POINTS, GRID DIST-   *
+  ! ANCE AND VERTICAL DISCRETIZATION OF THE ECMWF MODEL) FROM THE       *
+  ! GRIB HEADER OF THE FIRST INPUT FILE. THE CONSISTANCY (NO CHANGES    *
+  ! WITHIN ONE FLEXPART RUN) IS CHECKED IN THE ROUTINE "READWIND" AT    *
+  ! ANY CALL.                                                           *
+  !                                                                     *
+  ! XLON0                geographical longitude of lower left gridpoint *
+  ! YLAT0                geographical latitude of lower left gridpoint  *
+  ! NX                   number of grid points x-direction              *
+  ! NY                   number of grid points y-direction              *
+  ! DX                   grid distance x-direction                      *
+  ! DY                   grid distance y-direction                      *
+  ! NUVZ                 number of grid points for horizontal wind      *
+  !                      components in z direction                      *
+  ! NWZ                  number of grid points for vertical wind        *
+  !                      component in z direction                       *
+  ! sizesouth, sizenorth give the map scale (i.e. number of virtual grid*
+  !                      points of the polar stereographic grid):       *
+  !                      used to check the CFL criterion                *
+  ! UVHEIGHT(1)-         heights of gridpoints where u and v are        *
+  ! UVHEIGHT(NUVZ)       given                                          *
+  ! WHEIGHT(1)-          heights of gridpoints where w is given         *
+  ! WHEIGHT(NWZ)                                                        *
+  !                                                                     *
+  !**********************************************************************
+
+  use grib_api
+  use cmapf_mod, only: stlmbr,stcm2p
+
+  implicit none
+
+  !HSO  parameters for grib_api
+  integer :: ifile
+  integer :: iret
+  integer :: igrib
+  real(kind=4) :: xaux1,xaux2,yaux1,yaux2
+  real(kind=8) :: xaux1in,xaux2in,yaux1in,yaux2in
+  integer :: gribVer,parCat,parNum,sfctyp,ivalsfc,discipl
+  !HSO  end
+  integer :: ix,jy,i,ifn,ifield,j,k,iumax,iwmax,numskip
+  real :: sizesouth,sizenorth,xauxa,pint
+  real :: akm_usort(nwzmax)
+  real,parameter :: eps=0.0001
+
+  ! NCEP GFS
+  real :: pres(nwzmax), help
+
+  integer :: i179,i180,i181
+
+  ! VARIABLES AND ARRAYS NEEDED FOR GRIB DECODING
+
+  integer :: isec1(8),isec2(3)
+  real(kind=4) :: zsec4(jpunp)
+  character(len=1) :: opt
+
+  !HSO  grib api error messages
+  character(len=24) :: gribErrorMsg = 'Error reading grib file'
+  character(len=20) :: gribFunction = 'gridcheckwind_gfs'
+  !
+  if (numbnests.ge.1) then
+  write(*,*) ' ###########################################'
+  write(*,*) ' FLEXPART ERROR SUBROUTINE GRIDCHECK:'
+  write(*,*) ' NO NESTED WINDFIELDAS ALLOWED FOR GFS!      '
+  write(*,*) ' ###########################################'
+  stop
+  endif
+
+  iumax=0
+  iwmax=0
+
+  if(ideltas.gt.0) then
+    ifn=1
+  else
+    ifn=numbwf
+  endif
+  !
+  ! OPENING OF DATA FILE (GRIB CODE)
+  !
+5   call grib_open_file(ifile,path(3)(1:length(3)) &
+         //trim(wfname(ifn)),'r',iret)
+  if (iret.ne.GRIB_SUCCESS) then
+    goto 999   ! ERROR DETECTED
+  endif
+  !turn on support for multi fields messages
+  call grib_multi_support_on
+
+  ifield=0
+  do
+    ifield=ifield+1
+    !
+    ! GET NEXT FIELDS
+    !
+    call grib_new_from_file(ifile,igrib,iret)
+    if (iret.eq.GRIB_END_OF_FILE )  then
+      exit    ! EOF DETECTED
+    elseif (iret.ne.GRIB_SUCCESS) then
+      goto 999   ! ERROR DETECTED
+    endif
+
+    !first see if we read GRIB1 or GRIB2
+    call grib_get_int(igrib,'editionNumber',gribVer,iret)
+    call grib_check(iret,gribFunction,gribErrorMsg)
+
+    if (gribVer.eq.1) then ! GRIB Edition 1
+
+      !read the grib1 identifiers
+      call grib_get_int(igrib,'indicatorOfParameter',isec1(6),iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+      call grib_get_int(igrib,'indicatorOfTypeOfLevel',isec1(7),iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+      call grib_get_int(igrib,'level',isec1(8),iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+
+      !get the size and data of the values array
+      call grib_get_real4_array(igrib,'values',zsec4,iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+
+      else ! GRIB Edition 2
+
+      !read the grib2 identifiers
+      call grib_get_int(igrib,'discipline',discipl,iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+      call grib_get_int(igrib,'parameterCategory',parCat,iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+      call grib_get_int(igrib,'parameterNumber',parNum,iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+      call grib_get_int(igrib,'typeOfFirstFixedSurface',sfctyp,iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+      call grib_get_int(igrib,'scaledValueOfFirstFixedSurface', &
+           ivalsfc,iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+
+      !convert to grib1 identifiers
+      isec1(6)=-1
+      isec1(7)=-1
+      isec1(8)=-1
+      if ((parCat.eq.2).and.(parNum.eq.2).and.(sfctyp.eq.100)) then ! U
+        isec1(6)=33          ! indicatorOfParameter
+        isec1(7)=100         ! indicatorOfTypeOfLevel
+        isec1(8)=ivalsfc/100 ! level, convert to hPa
+      elseif ((parCat.eq.3).and.(parNum.eq.5).and.(sfctyp.eq.1)) then ! TOPO
+        isec1(6)=7           ! indicatorOfParameter
+        isec1(7)=1           ! indicatorOfTypeOfLevel
+        isec1(8)=0
+      elseif ((parCat.eq.0).and.(parNum.eq.0).and.(sfctyp.eq.1) &
+           .and.(discipl.eq.2)) then ! LSM
+        isec1(6)=81          ! indicatorOfParameter
+        isec1(7)=1           ! indicatorOfTypeOfLevel
+        isec1(8)=0
+      endif
+
+      if (isec1(6).ne.-1) then
+      !  get the size and data of the values array
+        call grib_get_real4_array(igrib,'values',zsec4,iret)
+        call grib_check(iret,gribFunction,gribErrorMsg)
+      endif
+
+    endif ! gribVer
+
+    if(ifield.eq.1) then
+
+      !get the required fields from section 2
+      !store compatible to gribex input
+      call grib_get_int(igrib,'numberOfPointsAlongAParallel', &
+           isec2(2),iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+      call grib_get_int(igrib,'numberOfPointsAlongAMeridian', &
+           isec2(3),iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+      call grib_get_real8(igrib,'longitudeOfFirstGridPointInDegrees', &
+           xaux1in,iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+      call grib_get_real8(igrib,'longitudeOfLastGridPointInDegrees', &
+           xaux2in,iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+      call grib_get_real8(igrib,'latitudeOfLastGridPointInDegrees', &
+           yaux1in,iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+      call grib_get_real8(igrib,'latitudeOfFirstGridPointInDegrees', &
+           yaux2in,iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+
+      ! Fix for flexpart.eu ticket #48
+      if (xaux2in.lt.0) xaux2in = 359.0
+
+      xaux1=xaux1in
+      xaux2=xaux2in
+      yaux1=yaux1in
+      yaux2=yaux2in
+
+      nxfield=isec2(2)
+      ny=isec2(3)
+      if((abs(xaux1).lt.eps).and.(xaux2.ge.359)) then ! NCEP DATA FROM 0 TO
+        xaux1=-179.0                             ! 359 DEG EAST ->
+        xaux2=-179.0+360.-360./real(nxfield)    ! TRANSFORMED TO -179
+      endif                                      ! TO 180 DEG EAST
+      if (xaux1.gt.180) xaux1=xaux1-360.0
+      if (xaux2.gt.180) xaux2=xaux2-360.0
+      if (xaux1.lt.-180) xaux1=xaux1+360.0
+      if (xaux2.lt.-180) xaux2=xaux2+360.0
+      if (xaux2.lt.xaux1) xaux2=xaux2+360.
+      xlon0=xaux1
+      ylat0=yaux1
+      dx=(xaux2-xaux1)/real(nxfield-1)
+      dy=(yaux2-yaux1)/real(ny-1)
+      dxconst=180./(dx*r_earth*pi)
+      dyconst=180./(dy*r_earth*pi)
+      !HSO end edits
+
+
+      ! Check whether fields are global
+      ! If they contain the poles, specify polar stereographic map
+      ! projections using the stlmbr- and stcm2p-calls
+      !***********************************************************
+
+      xauxa=abs(xaux2+dx-360.-xaux1)
+      if (xauxa.lt.0.001) then
+        nx=nxfield+1                 ! field is cyclic
+        xglobal=.true.
+        if (abs(nxshift).ge.nx) &
+             stop 'nxshift in file par_mod is too large'
+        xlon0=xlon0+real(nxshift)*dx
+      else
+        nx=nxfield
+        xglobal=.false.
+        if (nxshift.ne.0) &
+             stop 'nxshift (par_mod) must be zero for non-global domain'
+      endif
+      nxmin1=nx-1
+      nymin1=ny-1
+      if (xlon0.gt.180.) xlon0=xlon0-360.
+      xauxa=abs(yaux1+90.)
+      if (xglobal.and.xauxa.lt.0.001) then
+        sglobal=.true.               ! field contains south pole
+    ! Enhance the map scale by factor 3 (*2=6) compared to north-south
+    ! map scale
+        sizesouth=6.*(switchsouth+90.)/dy
+        call stlmbr(southpolemap,-90.,0.)
+        call stcm2p(southpolemap,0.,0.,switchsouth,0.,sizesouth, &
+             sizesouth,switchsouth,180.)
+        switchsouthg=(switchsouth-ylat0)/dy
+      else
+        sglobal=.false.
+        switchsouthg=999999.
+      endif
+      xauxa=abs(yaux2-90.)
+      if (xglobal.and.xauxa.lt.0.001) then
+        nglobal=.true.               ! field contains north pole
+    ! Enhance the map scale by factor 3 (*2=6) compared to north-south
+    ! map scale
+        sizenorth=6.*(90.-switchnorth)/dy
+        call stlmbr(northpolemap,90.,0.)
+        call stcm2p(northpolemap,0.,0.,switchnorth,0.,sizenorth, &
+             sizenorth,switchnorth,180.)
+        switchnorthg=(switchnorth-ylat0)/dy
+      else
+        nglobal=.false.
+        switchnorthg=999999.
+      endif
+    endif ! ifield.eq.1
+
+    if (nxshift.lt.0) stop 'nxshift (par_mod) must not be negative'
+    if (nxshift.ge.nxfield) stop 'nxshift (par_mod) too large'
+
+    ! NCEP ISOBARIC LEVELS
+    !*********************
+
+    if((isec1(6).eq.33).and.(isec1(7).eq.100)) then ! check for U wind
+      iumax=iumax+1
+      pres(iumax)=real(isec1(8))*100.0
+    endif
+
+
+    i179=nint(179./dx)
+    if (dx.lt.0.7) then
+      i180=nint(180./dx)+1    ! 0.5 deg data
+    else
+      i180=nint(179./dx)+1    ! 1 deg data
+    endif
+    i181=i180+1
+
+
+    ! NCEP TERRAIN
+    !*************
+
+    if (isec1(6).eq.007 .and. isec1(7).eq.001) then
+    ! IP 2023-05-09: allocate fields missing for GFS reading
+      call fixedfields_alloc
+      do jy=0,ny-1
+        do ix=0,nxfield-1
+          help=zsec4(nxfield*(ny-jy-1)+ix+1)
+          if(ix.le.i180) then
+            oro(i179+ix,jy)=help
+            excessoro(i179+ix,jy)=0.0 ! ISOBARIC SURFACES: SUBGRID TERRAIN DISREGARDED
+          else
+            oro(ix-i181,jy)=help
+            excessoro(ix-i181,jy)=0.0 ! ISOBARIC SURFACES: SUBGRID TERRAIN DISREGARDED
+          endif
+        end do
+      end do
+    endif
+
+    ! NCEP LAND SEA MASK
+    !*******************
+
+    if((isec1(6).eq.081).and.(isec1(7).eq.001)) then
+      do jy=0,ny-1
+        do ix=0,nxfield-1
+          help=zsec4(nxfield*(ny-jy-1)+ix+1)
+          if(ix.le.i180) then
+            lsm(i179+ix,jy)=help
+          else
+            lsm(ix-i181,jy)=help
+          endif
+        end do
+      end do
+    endif
+
+    call grib_release(igrib)
+
+  end do                      !! READ NEXT LEVEL OR PARAMETER
+  !
+  ! CLOSING OF INPUT DATA FILE
+  !
+
+  ! HSO
+  call grib_close_file(ifile)
+  ! HSO end edits
+
+  nuvz=iumax
+  nwz =iumax
+  nlev_ec=iumax
+
+  ! ! Assing grid values and allocate memory to read windfields
+  ! nxmax=nx
+  ! nymax=ny
+  ! nwzmax=nwz
+  ! nuvzmax=nuvz
+  ! nzmax=nuvz
+  ! ! nconvlevmax=nuvzmax-1
+  ! ! na=nconvlevmax+1
+
+  ! call alloc_windf
+
+  if (nx.gt.nxmax) then
+   write(*,*) 'FLEXPART error: Too many grid points in x direction.'
+    write(*,*) 'Reduce resolution of wind fields.'
+    write(*,*) 'Or change parameter settings in file par_mod.'
+    write(*,*) nx,nxmax
+    stop
+  endif
+
+  if (ny.gt.nymax) then
+   write(*,*) 'FLEXPART error: Too many grid points in y direction.'
+    write(*,*) 'Reduce resolution of wind fields.'
+    write(*,*) 'Or change parameter settings in file par_mod.'
+    write(*,*) ny,nymax
+    stop
+  endif
+
+  if (nuvz.gt.nuvzmax) then
+    write(*,*) 'FLEXPART error: Too many u,v grid points in z '// &
+         'direction.'
+    write(*,*) 'Reduce resolution of wind fields.'
+    write(*,*) 'Or change parameter settings in file par_mod.'
+    write(*,*) nuvz,nuvzmax
+    stop
+  endif
+
+  if (nwz.gt.nwzmax) then
+    write(*,*) 'FLEXPART error: Too many w grid points in z '// &
+         'direction.'
+    write(*,*) 'Reduce resolution of wind fields.'
+    write(*,*) 'Or change parameter settings in file par_mod.'
+    write(*,*) nwz,nwzmax
+    stop
+  endif
+
+  ! If desired, shift all grids by nxshift grid cells
+  !**************************************************
+
+  if (xglobal) then
+    call shift_field_0(oro,nxfield,ny)
+    call shift_field_0(lsm,nxfield,ny)
+    call shift_field_0(excessoro,nxfield,ny)
+  endif
+
+  ! Output of grid info
+  !********************
+
+  if (lroot) then
+    write(*,*)
+    write(*,*)
+    write(*,'(a,2i7)') 'Vertical levels in NCEP data: ', &
+         nuvz,nwz
+    write(*,*)
+    write(*,'(a)') 'Mother domain:'
+    write(*,'(a,f10.2,a1,f10.2,a,f10.2)') '  Longitude range: ', &
+         xlon0,' to ',xlon0+(nx-1)*dx,'   Grid distance: ',dx
+    write(*,'(a,f10.2,a1,f10.2,a,f10.2)') '  Latitude range : ', &
+         ylat0,' to ',ylat0+(ny-1)*dy,'   Grid distance: ',dy
+    write(*,*)
+  end if
+
+  ! CALCULATE VERTICAL DISCRETIZATION OF ECMWF MODEL
+  ! PARAMETER akm,bkm DESCRIBE THE HYBRID "ETA" COORDINATE SYSTEM
+
+  numskip=nlev_ec-nuvz  ! number of ecmwf model layers not used
+                        ! by trajectory model
+  do i=1,nwz
+    j=numskip+i
+    k=nlev_ec+1+numskip+i
+    akm_usort(nwz-i+1)=pres(nwz-i+1)
+    bkm(nwz-i+1)=0.0
+  end do
+
+  !******************************
+  ! change Sabine Eckhardt: akm should always be in descending order ... readwind adapted!
+  !******************************
+      do i=1,nwz
+         if (akm_usort(1).gt.akm_usort(2)) then
+            akm(i)=akm_usort(i)
+         else
+            akm(i)=akm_usort(nwz-i+1)
+         endif
+      end do
+
+  !
+  ! CALCULATION OF AKZ, BKZ
+  ! AKZ,BKZ: model discretization parameters at the center of each model
+  !     layer
+  !
+  ! Assign the 10 m winds to an artificial model level with akz=0 and bkz=1.0,
+  ! i.e. ground level
+  !*****************************************************************************
+
+  do i=1,nuvz
+     akz(i)=akm(i)
+     bkz(i)=bkm(i)
+  end do
+
+  ! NOTE: In FLEXPART versions up to 4.0, the number of model levels was doubled
+  ! upon the transformation to z levels. In order to save computer memory, this is
+  ! not done anymore in the standard version. However, this option can still be
+  ! switched on by replacing the following lines with those below, that are
+  ! currently commented out. For this, similar changes are necessary in
+  ! verttransform.f and verttranform_nest.f
+  !*****************************************************************************
+
+  nz=nuvz
+  if (nz.gt.nzmax) stop 'nzmax too small'
+  do i=1,nuvz
+    aknew(i)=akz(i)
+    bknew(i)=bkz(i)
+  end do
+
+  ! Switch on following lines to use doubled vertical resolution
+  !*************************************************************
+  !nz=nuvz+nwz-1
+  !if (nz.gt.nzmax) stop 'nzmax too small'
+  !do 100 i=1,nwz
+  !  aknew(2*(i-1)+1)=akm(i)
+  !00     bknew(2*(i-1)+1)=bkm(i)
+  !do 110 i=2,nuvz
+  !  aknew(2*(i-1))=akz(i)
+  !10     bknew(2*(i-1))=bkz(i)
+  ! End doubled vertical resolution
+  return
+
+999   write(*,*)
+  write(*,*) ' ###########################################'// &
+       '###### '
+  write(*,*) '       TRAJECTORY MODEL SUBROUTINE GRIDCHECK:'
+  write(*,*) ' CAN NOT OPEN INPUT DATA FILE '//wfname(ifn)
+  write(*,*) ' ###########################################'// &
+       '###### '
+  write(*,*)
+  write(*,'(a)') '!!! PLEASE INSERT A NEW CD-ROM AND   !!!'
+  write(*,'(a)') '!!! PRESS ANY KEY TO CONTINUE...     !!!'
+  write(*,'(a)') '!!! ...OR TERMINATE FLEXPART PRESSING!!!'
+  write(*,'(a)') '!!! THE "X" KEY...                   !!!'
+  write(*,*)
+  read(*,'(a)') opt
+  if(opt.eq.'X') then
+    stop
+  else
+    goto 5
+  endif
+
+end subroutine gridcheck_gfs
diff --git a/src/win_gridcheck_nest.f90 b/src/win_gridcheck_nest.f90
new file mode 100644
index 0000000000000000000000000000000000000000..9912f236546fd81ff899c7544c4de5ea67701414
--- /dev/null
+++ b/src/win_gridcheck_nest.f90
@@ -0,0 +1,449 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine gridcheck_nest
+
+  !*****************************************************************************
+  !                                                                            *
+  !     This routine checks the grid specification for the nested model        *
+  !     domains. It is similar to subroutine gridcheck, which checks the       *
+  !     mother domain.                                                         *
+  !                                                                            *
+  !     Authors: A. Stohl, G. Wotawa                                           *
+  !                                                                            *
+  !     8 February 1999                                                        *
+  !                                                                            *
+  !*****************************************************************************
+  !  CHANGE: 11/01/2008, Harald Sodemann, GRIB1/2 input with ECMWF grib_api    *
+  !  CHANGE: 03/12/2008, Harald Sodemann, change to f90 grib_api               *
+  !*****************************************************************************
+
+  use grib_api
+
+  implicit none
+
+  !HSO  parameters for grib_api
+  integer :: ifile
+  integer :: iret
+  integer :: igrib
+  integer :: gribVer,parCat,parNum,sfctyp,ivalsfc,discipl
+  integer :: parID !added by mc for making it consistent with new gridcheck.f90
+  integer :: gotGrib
+  !HSO  end
+  integer :: i,j,k,l,ifn,ifield,iumax,iwmax,numskip,nlev_ecn
+  integer :: nuvzn,nwzn
+  real :: akmn(nwzmax),bkmn(nwzmax),akzn(nuvzmax),bkzn(nuvzmax)
+  real(kind=4) :: xaux1,xaux2,yaux1,yaux2
+  real(kind=8) :: xaux1in,xaux2in,yaux1in,yaux2in
+  real :: conversion_factor !added by mc to make it consistent with new gridchek.f90
+
+  ! VARIABLES AND ARRAYS NEEDED FOR GRIB DECODING
+
+  ! dimension of isec2 at least (22+n), where n is the number of parallels or
+  ! meridians in a quasi-regular (reduced) Gaussian or lat/long grid
+
+  ! dimension of zsec2 at least (10+nn), where nn is the number of vertical
+  ! coordinate parameters
+
+  integer :: isec1(56),isec2(22+nxmaxn+nymaxn)
+  real(kind=4) :: zsec2(60+2*nuvzmax),zsec4(jpunp)
+
+  !HSO  grib api error messages
+  character(len=24) :: gribErrorMsg = 'Error reading grib file'
+  character(len=20) :: gribFunction = 'gridcheck_nest'
+
+  xresoln(0)=1.       ! resolution enhancement for mother grid
+  yresoln(0)=1.       ! resolution enhancement for mother grid
+
+  ! Loop about all nesting levels
+  !******************************
+
+  do l=1,numbnests
+
+    iumax=0
+    iwmax=0
+
+    if(ideltas.gt.0) then
+      ifn=1
+    else
+      ifn=numbwf
+    endif
+  !
+  ! OPENING OF DATA FILE (GRIB CODE)
+  !
+  ifile=0
+  igrib=0
+  iret=0
+
+5   call grib_open_file(ifile,path(numpath+2*(l-1)+1) &
+         (1:length(numpath+2*(l-1)+1))//trim(wfnamen(l,ifn)),'r',iret)
+  if (iret.ne.GRIB_SUCCESS) then
+    goto 999   ! ERROR DETECTED
+  endif
+  !turn on support for multi fields messages
+  !call grib_multi_support_on
+
+  gotGrib=0
+  ifield=0
+  do
+    ifield=ifield+1
+
+    !
+    ! GET NEXT FIELDS
+    !
+    call grib_new_from_file(ifile,igrib,iret)
+    if (iret.eq.GRIB_END_OF_FILE)  then
+      exit    ! EOF DETECTED
+    elseif (iret.ne.GRIB_SUCCESS) then
+      goto 999   ! ERROR DETECTED
+    endif
+
+    !first see if we read GRIB1 or GRIB2
+    call grib_get_int(igrib,'editionNumber',gribVer,iret)
+    call grib_check(iret,gribFunction,gribErrorMsg)
+
+    if (gribVer.eq.1) then ! GRIB Edition 1
+
+      !print*,'GRiB Edition 1'
+      !read the grib2 identifiers
+      call grib_get_int(igrib,'indicatorOfParameter',isec1(6),iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+      call grib_get_int(igrib,'level',isec1(8),iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+
+      !change code for etadot to code for omega
+      if (isec1(6).eq.77) then
+        isec1(6)=135
+      endif
+
+      !print*,isec1(6),isec1(8)
+
+    else
+
+      !print*,'GRiB Edition 2'
+      !read the grib2 identifiers
+      call grib_get_int(igrib,'discipline',discipl,iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+      call grib_get_int(igrib,'parameterCategory',parCat,iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+      call grib_get_int(igrib,'parameterNumber',parNum,iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+      call grib_get_int(igrib,'typeOfFirstFixedSurface',sfctyp,iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+      call grib_get_int(igrib,'level',ivalsfc,iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+      call grib_get_int(igrib,'paramId',parId,iret) !added by mc to make it consisitent with new grid_check.f90
+      call grib_check(iret,gribFunction,gribErrorMsg) !added by mc to make it consisitent with new  grid_check.f90
+
+      !print*,discipl,parCat,parNum,sfctyp,ivalsfc
+
+      !convert to grib1 identifiers
+      isec1(6)=-1
+      isec1(7)=-1
+      isec1(8)=-1
+      isec1(8)=ivalsfc     ! level
+      if ((parCat.eq.0).and.(parNum.eq.0).and.(sfctyp.eq.105)) then ! T
+        isec1(6)=130         ! indicatorOfParameter
+      elseif ((parCat.eq.2).and.(parNum.eq.2).and.(sfctyp.eq.105)) then ! U
+        isec1(6)=131         ! indicatorOfParameter
+      elseif ((parCat.eq.2).and.(parNum.eq.3).and.(sfctyp.eq.105)) then ! V
+        isec1(6)=132         ! indicatorOfParameter
+      elseif ((parCat.eq.1).and.(parNum.eq.0).and.(sfctyp.eq.105)) then ! Q
+        isec1(6)=133         ! indicatorOfParameter
+      elseif ((parCat.eq.1).and.(parNum.eq.83).and.(sfctyp.eq.105)) then ! clwc
+        isec1(6)=246         ! indicatorOfParameter
+      elseif ((parCat.eq.1).and.(parNum.eq.84).and.(sfctyp.eq.105)) then ! ciwc
+        isec1(6)=247         ! indicatorOfParameter
+      !ZHG end
+      ! ESO qc(=clwc+ciwc)
+      elseif ((parCat.eq.201).and.(parNum.eq.31).and.(sfctyp.eq.105)) then ! qc
+        isec1(6)=201031      ! indicatorOfParameter
+      elseif ((parCat.eq.3).and.(parNum.eq.0).and.(sfctyp.eq.1)) then !SP
+        isec1(6)=134         ! indicatorOfParameter
+      elseif ((parCat.eq.2).and.(parNum.eq.32)) then ! W, actually eta dot
+        isec1(6)=135         ! indicatorOfParameter
+      elseif ((parCat.eq.128).and.(parNum.eq.77)) then ! W, actually eta dot !added bymc to make it consistent with new gridcheck.f90
+        isec1(6)=135         ! indicatorOfParameter    !
+      elseif ((parCat.eq.3).and.(parNum.eq.0).and.(sfctyp.eq.101)) then !SLP
+        isec1(6)=151         ! indicatorOfParameter
+      elseif ((parCat.eq.2).and.(parNum.eq.2).and.(sfctyp.eq.103)) then ! 10U
+        isec1(6)=165         ! indicatorOfParameter
+      elseif ((parCat.eq.2).and.(parNum.eq.3).and.(sfctyp.eq.103)) then ! 10V
+        isec1(6)=166         ! indicatorOfParameter
+      elseif ((parCat.eq.0).and.(parNum.eq.0).and.(sfctyp.eq.103)) then ! 2T
+        isec1(6)=167         ! indicatorOfParameter
+      elseif ((parCat.eq.0).and.(parNum.eq.6).and.(sfctyp.eq.103)) then ! 2D
+        isec1(6)=168         ! indicatorOfParameter
+      elseif ((parCat.eq.1).and.(parNum.eq.11).and.(sfctyp.eq.1)) then ! SD
+        isec1(6)=141         ! indicatorOfParameter
+      elseif ((parCat.eq.6).and.(parNum.eq.1) .or. parId .eq. 164) then ! CC !added by mc to make it consistent with new gridchek.f90
+        isec1(6)=164         ! indicatorOfParameter
+      elseif ((parCat.eq.1).and.(parNum.eq.9) .or. parId .eq. 142) then ! LSP !added by mc to make it consistent with new gridchek.f90
+        isec1(6)=142         ! indicatorOfParameter
+      elseif ((parCat.eq.1).and.(parNum.eq.10)) then ! CP
+        isec1(6)=143         ! indicatorOfParameter
+      elseif ((parCat.eq.0).and.(parNum.eq.11).and.(sfctyp.eq.1)) then ! SHF
+        isec1(6)=146         ! indicatorOfParameter
+      elseif ((parCat.eq.4).and.(parNum.eq.9).and.(sfctyp.eq.1)) then ! SR
+        isec1(6)=176         ! indicatorOfParameter
+      elseif ((parCat.eq.2).and.(parNum.eq.17) .or. parId .eq. 180) then ! EWSS !added by mc to make it consistent with new gridchek.f90
+        isec1(6)=180         ! indicatorOfParameter
+      elseif ((parCat.eq.2).and.(parNum.eq.18) .or. parId .eq. 181) then ! NSSS !added by mc to make it consistent with new gridchek.f90
+        isec1(6)=181         ! indicatorOfParameter
+      elseif ((parCat.eq.3).and.(parNum.eq.4)) then ! ORO
+        isec1(6)=129         ! indicatorOfParameter
+      elseif ((parCat.eq.3).and.(parNum.eq.7) .or. parId .eq. 160) then ! SDO !added by mc to make it consistent with new gridchek.f90
+        isec1(6)=160         ! indicatorOfParameter
+      elseif ((discipl.eq.2).and.(parCat.eq.0).and.(parNum.eq.0).and. &
+           (sfctyp.eq.1)) then ! LSM
+        isec1(6)=172         ! indicatorOfParameter
+      else
+        print*,'***ERROR: undefined GRiB2 message found!',discipl, &
+             parCat,parNum,sfctyp
+      endif
+      if(parId .ne. isec1(6) .and. parId .ne. 77) then !added by mc to make it consistent with new gridchek.f90
+        write(*,*) 'parId',parId, 'isec1(6)',isec1(6)
+      !    stop
+      endif
+
+    endif
+
+    !get the size and data of the values array
+    if (isec1(6).ne.-1) then
+      call grib_get_real4_array(igrib,'values',zsec4,iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+    endif
+
+    !HSO  get the required fields from section 2 in a gribex compatible manner
+    if (ifield.eq.1) then
+      call grib_get_int(igrib,'numberOfPointsAlongAParallel', &
+           isec2(2),iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+      call grib_get_int(igrib,'numberOfPointsAlongAMeridian', &
+           isec2(3),iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+      call grib_get_int(igrib,'numberOfVerticalCoordinateValues', &
+           isec2(12),iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+    !HSO    get the size and data of the vertical coordinate array
+      call grib_get_real4_array(igrib,'pv',zsec2,iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+
+      nxn(l)=isec2(2)
+      nyn(l)=isec2(3)
+      nlev_ecn=isec2(12)/2-1
+    endif ! ifield
+
+    if (nxn(l).gt.nxmaxn) then
+      write(*,*) 'FLEXPART error: Too many grid points in x direction.'
+      write(*,*) 'Reduce resolution of wind fields (file GRIDSPEC)'
+      write(*,*) 'for nesting level ',l
+      write(*,*) 'Or change parameter settings in file par_mod.'
+      write(*,*) nxn(l),nxmaxn
+      stop
+    endif
+
+    if (nyn(l).gt.nymaxn) then
+      write(*,*) 'FLEXPART error: Too many grid points in y direction.'
+      write(*,*) 'Reduce resolution of wind fields (file GRIDSPEC)'
+      write(*,*) 'for nesting level ',l
+      write(*,*) 'Or change parameter settings in file par_mod.'
+      write(*,*) nyn(l),nymaxn
+      stop
+    endif
+
+    !HSO  get the second part of the grid dimensions only from GRiB1 messages
+    if (isec1(6) .eq. 167 .and. (gotGrib.eq.0)) then !added by mc to make it consistent with new gridchek.f90 note that gotGrid must be changed in gotGrib!!
+      call grib_get_real8(igrib,'longitudeOfFirstGridPointInDegrees', & !comment by mc: note that this was in the (if (ifield.eq.1) ..end above in gridchek.f90 see line 257
+           xaux1in,iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+      call grib_get_real8(igrib,'longitudeOfLastGridPointInDegrees', &
+           xaux2in,iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+      call grib_get_real8(igrib,'latitudeOfLastGridPointInDegrees', &
+           yaux1in,iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+      call grib_get_real8(igrib,'latitudeOfFirstGridPointInDegrees', &
+           yaux2in,iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+      xaux1=xaux1in
+      xaux2=xaux2in
+      yaux1=yaux1in
+      yaux2=yaux2in
+      if(xaux1.gt.180.) xaux1=xaux1-360.0
+      if(xaux2.gt.180.) xaux2=xaux2-360.0
+      if(xaux1.lt.-180.) xaux1=xaux1+360.0
+      if(xaux2.lt.-180.) xaux2=xaux2+360.0
+      if (xaux2.lt.xaux1) xaux2=xaux2+360.0
+      xlon0n(l)=xaux1
+      ylat0n(l)=yaux1
+      dxn(l)=(xaux2-xaux1)/real(nxn(l)-1)
+      dyn(l)=(yaux2-yaux1)/real(nyn(l)-1)
+      gotGrib=1 !commetn by mc note tahthere gotGRIB is used instead of gotGrid!!!
+    endif ! ifield.eq.1
+
+    k=isec1(8)
+    if(isec1(6).eq.131) iumax=max(iumax,nlev_ec-k+1)
+    if(isec1(6).eq.135) iwmax=max(iwmax,nlev_ec-k+1)
+
+    if(isec1(6).eq.129) then
+      do j=0,nyn(l)-1
+        do i=0,nxn(l)-1
+          oron(i,j,l)=zsec4(nxn(l)*(nyn(l)-j-1)+i+1)/ga
+        end do
+      end do
+    endif
+    if(isec1(6).eq.172) then
+      do j=0,nyn(l)-1
+        do i=0,nxn(l)-1
+          lsmn(i,j,l)=zsec4(nxn(l)*(nyn(l)-j-1)+i+1)/ga
+        end do
+      end do
+    endif
+    if(isec1(6).eq.160) then
+      do j=0,nyn(l)-1
+        do i=0,nxn(l)-1
+          excessoron(i,j,l)=zsec4(nxn(l)*(nyn(l)-j-1)+i+1)/ga
+        end do
+      end do
+    endif
+
+    call grib_release(igrib)
+  end do                 !! READ NEXT LEVEL OR PARAMETER
+  !
+  ! CLOSING OF INPUT DATA FILE
+  !
+
+  call grib_close_file(ifile)
+
+  !error message if no fields found with correct first longitude in it
+  if (gotGrib.eq.0) then
+    print*,'***ERROR: input file needs to contain GRiB1 formatted'// &
+         'messages'
+    stop
+  endif
+
+  nuvzn=iumax
+  nwzn=iwmax
+  if(nuvzn.eq.nlev_ec) nwzn=nlev_ecn+1
+
+  if ((nuvzn.gt.nuvzmax).or.(nwzn.gt.nwzmax)) then
+    write(*,*) 'FLEXPART error: Nested wind fields have too many'// &
+         'vertical levels.'
+    write(*,*) 'Problem was encountered for nesting level ',l
+    stop
+  endif
+
+
+  ! Output of grid info
+  !********************
+
+  write(*,'(a,i2,a)') ' Nested domain ',l,':'
+  write(*,'(a,f10.5,a,f10.5,a,f10.5)') '  Longitude range: ', &
+       xlon0n(l),' to ',xlon0n(l)+(nxn(l)-1)*dxn(l), &
+       '   Grid distance: ',dxn(l)
+  write(*,'(a,f10.5,a,f10.5,a,f10.5)') '  Latitude range : ', &
+       ylat0n(l),' to ',ylat0n(l)+(nyn(l)-1)*dyn(l), &
+       '   Grid distance: ',dyn(l)
+  write(*,*)
+
+  ! Determine, how much the resolutions in the nests are enhanced as
+  ! compared to the mother grid
+  !*****************************************************************
+
+  xresoln(l)=dx/dxn(l)
+  yresoln(l)=dy/dyn(l)
+
+  ! Determine the mother grid coordinates of the corner points of the
+  ! nested grids
+  ! Convert first to geographical coordinates, then to grid coordinates
+  !********************************************************************
+
+  xaux1=xlon0n(l)
+  xaux2=xlon0n(l)+real(nxn(l)-1)*dxn(l)
+  yaux1=ylat0n(l)
+  yaux2=ylat0n(l)+real(nyn(l)-1)*dyn(l)
+
+  xln(l)=(xaux1-xlon0)/dx
+  xrn(l)=(xaux2-xlon0)/dx
+  yln(l)=(yaux1-ylat0)/dy
+  yrn(l)=(yaux2-ylat0)/dy
+
+
+  if ((xln(l).lt.0.).or.(yln(l).lt.0.).or. &
+       (xrn(l).gt.real(nxmin1)).or.(yrn(l).gt.real(nymin1))) then
+    write(*,*) 'Nested domain does not fit into mother domain'
+    write(*,*) 'For global mother domain fields, you can shift'
+    write(*,*) 'shift the mother domain into x-direction'
+    write(*,*) 'by setting nxshift (file par_mod) to a'
+    write(*,*) 'positive value. Execution is terminated.'
+    stop
+  endif
+
+
+  ! CALCULATE VERTICAL DISCRETIZATION OF ECMWF MODEL
+  ! PARAMETER akm,bkm DESCRIBE THE HYBRID "ETA" COORDINATE SYSTEM
+
+  numskip=nlev_ecn-nuvzn ! number of ecmwf model layers not used by FLEXPART
+  do i=1,nwzn
+    j=numskip+i
+    k=nlev_ecn+1+numskip+i
+    akmn(nwzn-i+1)=zsec2(j)
+    bkmn(nwzn-i+1)=zsec2(k)
+  end do
+
+  !
+  ! CALCULATION OF AKZ, BKZ
+  ! AKZ,BKZ: model discretization parameters at the center of each model
+  !     layer
+  !
+  ! Assign the 10 m winds to an artificial model level with akz=0 and bkz=1.0,
+  ! i.e. ground level
+  !*****************************************************************************
+
+    akzn(1)=0.
+    bkzn(1)=1.0
+    do i=1,nuvzn
+      akzn(i+1)=0.5*(akmn(i+1)+akmn(i))
+      bkzn(i+1)=0.5*(bkmn(i+1)+bkmn(i))
+    end do
+    nuvzn=nuvzn+1
+
+  ! Check, whether the heights of the model levels of the nested
+  ! wind fields are consistent with those of the mother domain.
+  ! If not, terminate model run.
+  !*************************************************************
+
+    do i=1,nuvz
+      if ((akzn(i).ne.akz(i)).or.(bkzn(i).ne.bkz(i))) then
+  write(*,*) 'FLEXPART error: The wind fields of nesting level',l
+  write(*,*) 'are not consistent with the mother domain:'
+  write(*,*) 'Differences in vertical levels detected.'
+        stop
+      endif
+    end do
+
+    do i=1,nwz
+      if ((akmn(i).ne.akm(i)).or.(bkmn(i).ne.bkm(i))) then
+  write(*,*) 'FLEXPART error: The wind fields of nesting level',l
+  write(*,*) 'are not consistent with the mother domain:'
+  write(*,*) 'Differences in vertical levels detected.'
+        stop
+      endif
+    end do
+
+  end do
+
+  return
+
+999   write(*,*)
+  write(*,*) ' ###########################################'// &
+       '###### '
+  write(*,*) '                FLEXPART SUBROUTINE GRIDCHECK:'
+  write(*,*) ' CAN NOT OPEN INPUT DATA FILE '//wfnamen(l,ifn)
+  write(*,*) ' FOR NESTING LEVEL ',k
+  write(*,*) ' ###########################################'// &
+       '###### '
+  stop
+
+end subroutine gridcheck_nest
diff --git a/src/win_readwind_ecmwf.f90 b/src/win_readwind_ecmwf.f90
new file mode 100644
index 0000000000000000000000000000000000000000..3a8f521cc523e2df08afe15672dc51d5425f429b
--- /dev/null
+++ b/src/win_readwind_ecmwf.f90
@@ -0,0 +1,683 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine readwind_ecmwf(indj,n,uuh,vvh,wwh)
+
+  !**********************************************************************
+  !                                                                     *
+  !             TRAJECTORY MODEL SUBROUTINE READWIND                    *
+  !                                                                     *
+  !**********************************************************************
+  !                                                                     *
+  !             AUTHOR:      G. WOTAWA                                  *
+  !             DATE:        1997-08-05                                 *
+  !             LAST UPDATE: 2000-10-17, Andreas Stohl                  *
+  !             CHANGE: 11/01/2008, Harald Sodemann, GRIB1/2 input with *
+  !                                 ECMWF grib_api                      *
+  !             CHANGE: 03/12/2008, Harald Sodemann, update to f90 with *
+  !                                 ECMWF grib_api                      *
+  !                                                                     *
+  !**********************************************************************
+  !  Changes, Bernd C. Krueger, Feb. 2001:
+  !   Variables tth and qvh (on eta coordinates) in common block
+  !
+  !   Unified ECMWF and GFS builds
+  !   Marian Harustak, 12.5.2017
+  !     - Renamed from readwind to readwind_ecmwf
+  !
+  !  L. Bakels, 2021: OpenMP parallelisation (following CTM version)
+  !**********************************************************************
+  !                                                                     *
+  ! DESCRIPTION:                                                        *
+  !                                                                     *
+  ! READING OF ECMWF METEOROLOGICAL FIELDS FROM INPUT DATA FILES. THE   *
+  ! INPUT DATA FILES ARE EXPECTED TO BE AVAILABLE IN GRIB CODE          *
+  !                                                                     *
+  ! INPUT:                                                              *
+  ! indj               indicates number of the wind field to be read in *
+  ! n                  temporal index for meteorological fields (1 to 3)*
+  !                                                                     *
+  ! IMPORTANT VARIABLES FROM COMMON BLOCK:                              *
+  !                                                                     *
+  ! wfname             File name of data to be read in                  *
+  ! nx,ny,nuvz,nwz     expected field dimensions                        *
+  ! nlev_ec            number of vertical levels ecmwf model            *
+  ! uu,vv,ww           wind fields                                      *
+  ! tt,qv              temperature and specific humidity                *
+  ! ps                 surface pressure                                 *
+  !                                                                     *
+  !**********************************************************************
+
+  use grib_api
+
+  implicit none
+
+  !  include 'grib_api.h'
+
+  !HSO  parameters for grib_api
+  integer :: ifile
+  integer :: iret
+  integer, dimension(:), allocatable   :: igrib
+  integer :: nfield, ii, arsize
+  integer :: gribVer,parCat,parNum,sfctyp,ivalsfc,discipl,parId
+  integer :: gotGrid
+  ! HSO  end
+
+  real(kind=4) :: uuh(0:nxmax-1,0:nymax-1,nuvzmax)
+  real(kind=4) :: vvh(0:nxmax-1,0:nymax-1,nuvzmax)
+  real(kind=4) :: wwh(0:nxmax-1,0:nymax-1,nwzmax)
+  integer :: indj,i,j,k,n,levdiff2,iumax,iwmax!,ifield
+  integer :: kz
+
+  ! VARIABLES AND ARRAYS NEEDED FOR GRIB DECODING
+
+  ! dimension of isec2 at least (22+n), where n is the number of parallels or
+  ! meridians in a quasi-regular (reduced) Gaussian or lat/long grid
+
+  ! dimension of zsec2 at least (10+nn), where nn is the number of vertical
+  ! coordinate parameters
+
+  integer :: isec1(56),isec2(22+nxmax+nymax)
+  real(kind=4), allocatable, dimension(:) :: zsec4
+  !  real(kind=4) :: zsec4(jpunp)
+  real(kind=4) :: xaux,yaux,xaux0,yaux0
+  real(kind=8) :: xauxin,yauxin
+  real,parameter :: eps=1.e-4
+  real(kind=4) :: nsss(0:nxmax-1,0:nymax-1),ewss(0:nxmax-1,0:nymax-1)
+  real :: plev1,pmean,tv,fu,hlev1,ff10m,fflev1,conversion_factor
+  integer :: stat
+
+  logical :: hflswitch,strswitch!,readcloud
+
+  !HSO  grib api error messages
+  character(len=24) :: gribErrorMsg = 'Error reading grib file'
+  character(len=20) :: gribFunction = 'readwind'
+
+  hflswitch=.false.
+  strswitch=.false.
+  !ZHG test the grib fields that have lcwc without using them
+  !  readcloud=.false.
+
+  levdiff2=nlev_ec-nwz+1
+  iumax=0
+  iwmax=0
+
+  !
+  ! OPENING OF DATA FILE (GRIB CODE)
+  !
+  call grib_open_file(ifile,path(3)(1:length(3)) &
+       //trim(wfname(indj)),'r',iret)
+  if (iret.ne.GRIB_SUCCESS) then
+    goto 888   ! ERROR DETECTED
+  endif
+
+  call grib_count_in_file(ifile,nfield)
+
+  ! allocate memory for grib handles
+  allocate(igrib(nfield), stat=stat)
+  if (stat.ne.0) stop "Could not allocate igrib"
+  ! initialise
+  igrib(:) = -1
+
+  do ii = 1,nfield
+    call grib_new_from_file(ifile, igrib(ii), iret)
+  end do
+
+  call grib_close_file(ifile)
+
+  !turn on support for multi fields messages */
+  !call grib_multi_support_on
+
+  gotGrid=0
+
+!$OMP PARALLEL DEFAULT(none) &
+!$OMP SHARED (nfield, igrib, gribFunction, nxfield, ny, nlev_ec, dx, xlon0, ylat0, &
+!$OMP   n, tth, uuh, vvh, iumax, qvh, ps, wwh, iwmax, sd, msl, tcc, u10, v10, tt2, &
+!$OMP   td2, lsprec, convprec, sshf, hflswitch, ssr, ewss, nsss, strswitch, oro,   &
+!$OMP   excessoro, lsm, nymin1,ciwch,clwch,readclouds,sumclouds, nxshift) &
+!$OMP PRIVATE(ii, gribVer, iret, isec1, discipl, parCat, parNum, parId,sfctyp, ivalsfc, &
+!$OMP   zsec4, isec2, gribErrorMsg, xauxin, yauxin, xaux, yaux, xaux0,  &
+!$OMP   yaux0, k, arsize, stat, conversion_factor)  &
+!$OMP REDUCTION(+:gotGrid)
+  !
+  ! GET NEXT FIELDS
+  !
+  ! allocate memory for reading from grib
+  allocate(zsec4(nxfield*ny), stat=stat)
+  if (stat.ne.0) stop "Could not allocate zsec4"
+
+!$OMP DO SCHEDULE(static)
+
+  fieldloop : do ii=1,nfield
+
+  !first see if we read GRIB1 or GRIB2
+  call grib_get_int(igrib(ii),'editionNumber',gribVer,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+
+  if (gribVer.eq.1) then ! GRIB Edition 1
+
+    !print*,'GRiB Edition 1'
+    !read the grib2 identifiers
+    call grib_get_int(igrib(ii),'indicatorOfParameter',isec1(6),iret)
+    call grib_check(iret,gribFunction,gribErrorMsg)
+    call grib_get_int(igrib(ii),'level',isec1(8),iret)
+    call grib_check(iret,gribFunction,gribErrorMsg)
+
+  !change code for etadot to code for omega
+    if (isec1(6).eq.77) then
+      isec1(6)=135
+    endif
+
+    conversion_factor=1.
+
+  else
+
+  !print*,'GRiB Edition 2'
+  !read the grib2 identifiers
+    call grib_get_int(igrib(ii),'discipline',discipl,iret)
+    call grib_check(iret,gribFunction,gribErrorMsg)
+    call grib_get_int(igrib(ii),'parameterCategory',parCat,iret)
+    call grib_check(iret,gribFunction,gribErrorMsg)
+    call grib_get_int(igrib(ii),'parameterNumber',parNum,iret)
+    call grib_check(iret,gribFunction,gribErrorMsg)
+    call grib_get_int(igrib(ii),'typeOfFirstFixedSurface',sfctyp,iret)
+    call grib_check(iret,gribFunction,gribErrorMsg)
+    call grib_get_int(igrib(ii),'level',ivalsfc,iret)
+    call grib_check(iret,gribFunction,gribErrorMsg)
+    call grib_get_int(igrib(ii),'paramId',parId,iret)
+    call grib_check(iret,gribFunction,gribErrorMsg)
+
+  !print*,discipl,parCat,parNum,sfctyp,ivalsfc
+
+  !convert to grib1 identifiers
+    isec1(6)=-1
+    isec1(7)=-1
+    isec1(8)=-1
+    isec1(8)=ivalsfc     ! level
+    conversion_factor=1.
+    if ((parCat.eq.0).and.(parNum.eq.0).and.(sfctyp.eq.105)) then ! T
+      isec1(6)=130         ! indicatorOfParameter
+    elseif ((parCat.eq.2).and.(parNum.eq.2).and.(sfctyp.eq.105)) then ! U
+      isec1(6)=131         ! indicatorOfParameter
+    elseif ((parCat.eq.2).and.(parNum.eq.3).and.(sfctyp.eq.105)) then ! V
+      isec1(6)=132         ! indicatorOfParameter
+    elseif ((parCat.eq.1).and.(parNum.eq.0).and.(sfctyp.eq.105)) then ! Q
+      isec1(6)=133         ! indicatorOfParameter
+  ! ESO Cloud water is in a) fields CLWC and CIWC, *or* b) field QC
+    elseif ((parCat.eq.1).and.(parNum.eq.83).and.(sfctyp.eq.105)) then ! clwc
+      isec1(6)=246         ! indicatorOfParameter
+    elseif ((parCat.eq.1).and.(parNum.eq.84).and.(sfctyp.eq.105)) then ! ciwc
+      isec1(6)=247         ! indicatorOfParameter
+  ! ESO qc(=clwc+ciwc):
+    elseif ((parCat.eq.201).and.(parNum.eq.31).and.(sfctyp.eq.105)) then ! qc
+      isec1(6)=201031         ! indicatorOfParameter
+    elseif ((parCat.eq.3).and.(parNum.eq.0).and.(sfctyp.eq.1)) then !SP
+      isec1(6)=134         ! indicatorOfParameter
+    elseif ((parCat.eq.2).and.(parNum.eq.32)) then ! W, actually eta dot
+      isec1(6)=135         ! indicatorOfParameter
+    elseif ((parCat.eq.128).and.(parNum.eq.77)) then ! W, actually eta dot
+      isec1(6)=135         ! indicatorOfParameter
+    elseif ((parCat.eq.3).and.(parNum.eq.0).and.(sfctyp.eq.101)) then !SLP
+      isec1(6)=151         ! indicatorOfParameter
+    elseif ((parCat.eq.2).and.(parNum.eq.2).and.(sfctyp.eq.103)) then ! 10U
+      isec1(6)=165         ! indicatorOfParameter
+    elseif ((parCat.eq.2).and.(parNum.eq.3).and.(sfctyp.eq.103)) then ! 10V
+      isec1(6)=166         ! indicatorOfParameter
+    elseif ((parCat.eq.0).and.(parNum.eq.0).and.(sfctyp.eq.103)) then ! 2T
+      isec1(6)=167         ! indicatorOfParameter
+    elseif ((parCat.eq.0).and.(parNum.eq.6).and.(sfctyp.eq.103)) then ! 2D
+      isec1(6)=168         ! indicatorOfParameter
+    elseif ((parCat.eq.1).and.(parNum.eq.11).and.(sfctyp.eq.1)) then ! SD
+      isec1(6)=141         ! indicatorOfParameter
+      conversion_factor=1000.
+    elseif ((parCat.eq.6).and.(parNum.eq.1) .or. parId .eq. 164) then ! CC
+      isec1(6)=164         ! indicatorOfParameter
+    elseif ((parCat.eq.1).and.(parNum.eq.9) .or. parId .eq. 142) then ! LSP
+      isec1(6)=142         ! indicatorOfParameter
+    elseif ((parCat.eq.1).and.(parNum.eq.10)) then ! CP
+      isec1(6)=143         ! indicatorOfParameter
+      conversion_factor=1000.
+    elseif ((parCat.eq.0).and.(parNum.eq.11).and.(sfctyp.eq.1)) then ! SHF
+      isec1(6)=146         ! indicatorOfParameter
+    elseif ((parCat.eq.4).and.(parNum.eq.9).and.(sfctyp.eq.1)) then ! SR
+      isec1(6)=176         ! indicatorOfParameter
+  !    elseif ((parCat.eq.2).and.(parNum.eq.17) .or. parId .eq. 180) then ! EWSS --wrong
+    elseif ((parCat.eq.2).and.(parNum.eq.38) .or. parId .eq. 180) then ! EWSS --correct
+      isec1(6)=180         ! indicatorOfParameter
+  !    elseif ((parCat.eq.2).and.(parNum.eq.18) .or. parId .eq. 181) then ! NSSS --wrong
+    elseif ((parCat.eq.2).and.(parNum.eq.37) .or. parId .eq. 181) then ! NSSS --correct
+      isec1(6)=181         ! indicatorOfParameter
+    elseif ((parCat.eq.3).and.(parNum.eq.4)) then ! ORO
+      isec1(6)=129         ! indicatorOfParameter
+    elseif ((parCat.eq.3).and.(parNum.eq.7) .or. parId .eq. 160) then ! SDO
+      isec1(6)=160         ! indicatorOfParameter
+    elseif ((discipl.eq.2).and.(parCat.eq.0).and.(parNum.eq.0).and. &
+         (sfctyp.eq.1)) then ! LSM
+      isec1(6)=172         ! indicatorOfParameter
+    elseif (parNum.eq.152) then
+      isec1(6)=152         ! avoid warning for lnsp
+    else
+      print*,'***WARNING: undefined GRiB2 message found!',discipl, &
+           parCat,parNum,sfctyp
+    endif
+    if(parId .ne. isec1(6) .and. parId .ne. 77) then
+      write(*,*) 'parId',parId, 'isec1(6)',isec1(6)
+  !    stop
+    endif
+
+  endif
+
+  !HSO  get the size and data of the values array
+  if (isec1(6).ne.-1) then
+    call grib_get_real4_array(igrib(ii),'values',zsec4,iret)
+    call grib_check(iret,gribFunction,gribErrorMsg)
+  endif
+
+  !HSO  get the required fields from section 2 in a gribex compatible manner
+  if (ii.eq.1) then
+    call grib_get_int(igrib(ii),'numberOfPointsAlongAParallel',isec2(2),iret)
+    call grib_check(iret,gribFunction,gribErrorMsg)
+    call grib_get_int(igrib(ii),'numberOfPointsAlongAMeridian',isec2(3),iret)
+    call grib_check(iret,gribFunction,gribErrorMsg)
+    call grib_get_int(igrib(ii),'numberOfVerticalCoordinateValues',isec2(12))
+    call grib_check(iret,gribFunction,gribErrorMsg)
+  ! CHECK GRID SPECIFICATIONS
+    if(isec2(2).ne.nxfield) stop 'READWIND: NX NOT CONSISTENT'
+    if(isec2(3).ne.ny) stop 'READWIND: NY NOT CONSISTENT'
+    if(isec2(12)/2-1.ne.nlev_ec) &
+         stop 'READWIND: VERTICAL DISCRETIZATION NOT CONSISTENT'
+  endif ! ifield
+
+!$OMP CRITICAL
+  !HSO  get the second part of the grid dimensions only from GRiB1 messages
+  if (isec1(6) .eq. 167 .and. (gotGrid.eq.0)) then
+    call grib_get_real8(igrib(ii),'longitudeOfFirstGridPointInDegrees', &
+         xauxin,iret)
+    call grib_check(iret,gribFunction,gribErrorMsg)
+    call grib_get_real8(igrib(ii),'latitudeOfLastGridPointInDegrees', &
+         yauxin,iret)
+    call grib_check(iret,gribFunction,gribErrorMsg)
+    if (xauxin.gt.180.) xauxin=xauxin-360.0
+    if (xauxin.lt.-180.) xauxin=xauxin+360.0
+
+    xaux=xauxin+real(nxshift)*dx
+    yaux=yauxin
+    if (xaux.gt.180.) xaux=xaux-360.0
+    if(abs(xaux-xlon0).gt.eps) &
+         stop 'READWIND: LOWER LEFT LONGITUDE NOT CONSISTENT'
+    if(abs(yaux-ylat0).gt.eps) &
+         stop 'READWIND: LOWER LEFT LATITUDE NOT CONSISTENT'
+    gotGrid=1
+  endif ! gotGrid
+!$OMP END CRITICAL
+
+  k=isec1(8)
+  select case(isec1(6))
+  !! TEMPERATURE
+    case(130)
+      do j=0,nymin1
+        do i=0,nxfield-1
+          tth(i,j,nlev_ec-k+2,n) = zsec4(nxfield*(ny-j-1)+i+1)
+        end do
+      end do
+  !! U VELOCITY
+    case(131)
+      do j=0,nymin1
+        do i=0,nxfield-1
+          uuh(i,j,nlev_ec-k+2) = zsec4(nxfield*(ny-j-1)+i+1)
+        end do
+      end do
+!$OMP CRITICAL
+      iumax=max(iumax,nlev_ec-k+1)
+!$OMP END CRITICAL
+  !! V VELOCITY
+    case(132)
+      do j=0,nymin1
+        do i=0,nxfield-1
+          vvh(i,j,nlev_ec-k+2) = zsec4(nxfield*(ny-j-1)+i+1)
+        end do
+      end do
+  !! SPEC. HUMIDITY
+    case(133)
+      do j=0,nymin1
+        do i=0,nxfield-1
+          qvh(i,j,nlev_ec-k+2,n) = zsec4(nxfield*(ny-j-1)+i+1)
+          if (qvh(i,j,nlev_ec-k+2,n) .lt. 0.) &
+               qvh(i,j,nlev_ec-k+2,n) = 0.
+    !        this is necessary because the gridded data may contain
+    !        spurious negative values
+        end do
+      end do
+  !! SURF. PRESS.
+    case(134)
+      do j=0,nymin1
+        do i=0,nxfield-1
+          ps(i,j,1,n) = zsec4(nxfield*(ny-j-1)+i+1)
+        end do
+      end do
+  !! W VELOCITY
+    case(135)
+      do j=0,nymin1
+        do i=0,nxfield-1
+          wwh(i,j,nlev_ec-k+1) = zsec4(nxfield*(ny-j-1)+i+1)
+        end do
+      end do
+!$OMP CRITICAL
+      iwmax=max(iwmax,nlev_ec-k+1)
+!$OMP END CRITICAL
+  !! SNOW DEPTH
+    case(141)
+      do j=0,nymin1
+        do i=0,nxfield-1
+          sd(i,j,1,n)= zsec4(nxfield*(ny-j-1)+i+1)/conversion_factor
+        end do
+      end do
+  !! SEA LEVEL PRESS.
+    case(151)
+      do j=0,nymin1
+        do i=0,nxfield-1
+          msl(i,j,1,n) = zsec4(nxfield*(ny-j-1)+i+1)
+        end do
+      end do
+  !! CLOUD COVER
+    case(164)
+      do j=0,nymin1
+        do i=0,nxfield-1
+          tcc(i,j,1,n) =  zsec4(nxfield*(ny-j-1)+i+1)
+        end do
+      end do
+  !! 10 M U VELOCITY
+    case(165)
+      do j=0,nymin1
+        do i=0,nxfield-1
+          u10(i,j,1,n)= zsec4(nxfield*(ny-j-1)+i+1)
+        end do
+      end do
+  !! 10 M V VELOCITY
+    case(166)
+      do j=0,nymin1
+        do i=0,nxfield-1
+          v10(i,j,1,n) = zsec4(nxfield*(ny-j-1)+i+1)
+        end do
+      end do
+  !! 2 M TEMPERATURE
+    case(167)
+      do j=0,nymin1
+        do i=0,nxfield-1
+          tt2(i,j,1,n) = zsec4(nxfield*(ny-j-1)+i+1)
+        end do
+      end do
+  !! 2 M DEW POINT
+    case(168)
+      do j=0,nymin1
+        do i=0,nxfield-1
+          td2(i,j,1,n) = zsec4(nxfield*(ny-j-1)+i+1)
+        end do
+      end do
+  !! LARGE SCALE PREC.
+    case(142)
+      do j=0,nymin1
+        do i=0,nxfield-1
+          lsprec(i,j,1,n)=zsec4(nxfield*(ny-j-1)+i+1)
+          if (lsprec(i,j,1,n).lt.0.) lsprec(i,j,1,n)=0.
+        end do
+      end do
+  !! CONVECTIVE PREC.
+    case(143)
+      do j=0,nymin1
+        do i=0,nxfield-1
+          convprec(i,j,1,n)=zsec4(nxfield*(ny-j-1)+i+1)/conversion_factor
+          if (convprec(i,j,1,n).lt.0.) convprec(i,j,1,n)=0.
+        end do
+      end do
+  !! SENS. HEAT FLUX
+    case(146)
+      do j=0,nymin1
+        do i=0,nxfield-1
+          sshf(i,j,1,n) = zsec4(nxfield*(ny-j-1)+i+1)
+!$OMP CRITICAL
+          if(zsec4(nxfield*(ny-j-1)+i+1).ne.0.) &
+            hflswitch=.true.    ! Heat flux available
+!$OMP END CRITICAL
+        end do
+      end do
+  !! SOLAR RADIATION
+    case(176)
+      do j=0,nymin1
+        do i=0,nxfield-1
+          ssr(i,j,1,n)=zsec4(nxfield*(ny-j-1)+i+1)
+          if (ssr(i,j,1,n).lt.0.) ssr(i,j,1,n)=0.
+        end do
+      end do
+  !! EW SURFACE STRESS
+    case(180)
+      do j=0,nymin1
+        do i=0,nxfield-1
+          ewss(i,j) = zsec4(nxfield*(ny-j-1)+i+1)
+!$OMP CRITICAL
+          if (zsec4(nxfield*(ny-j-1)+i+1).ne.0.) strswitch=.true.    ! stress available
+!$OMP END CRITICAL
+        end do
+      end do
+  !! NS SURFACE STRESS
+    case(181)
+     do j=0,nymin1
+       do i=0,nxfield-1
+         nsss(i,j) = zsec4(nxfield*(ny-j-1)+i+1)
+!$OMP CRITICAL
+         if (zsec4(nxfield*(ny-j-1)+i+1).ne.0.) strswitch=.true.    ! stress available
+!$OMP END CRITICAL
+       end do
+     end do
+  !! ECMWF OROGRAPHY
+    case(129)
+      do j=0,nymin1
+        do i=0,nxfield-1
+          oro(i,j) = zsec4(nxfield*(ny-j-1)+i+1)/ga
+        end do
+      end do
+  !! STANDARD DEVIATION OF OROGRAPHY
+    case(160)
+      do j=0,nymin1
+        do i=0,nxfield-1
+          excessoro(i,j) = zsec4(nxfield*(ny-j-1)+i+1)
+        end do
+      end do
+  !! ECMWF LAND SEA MASK
+    case(172)
+      do j=0,nymin1
+        do i=0,nxfield-1
+          lsm(i,j) = zsec4(nxfield*(ny-j-1)+i+1)
+        end do
+      end do
+  !! CLWC  Cloud liquid water content [kg/kg]
+    case(246)
+      do j=0,nymin1
+        do i=0,nxfield-1
+          clwch(i,j,nlev_ec-k+2,n)=zsec4(nxfield*(ny-j-1)+i+1)
+        end do
+      end do
+!$OMP CRITICAL
+      readclouds=.true.
+      sumclouds=.false.
+!$OMP END CRITICAL
+  !! CIWC  Cloud ice water content
+    case(247)
+      do j=0,nymin1
+        do i=0,nxfield-1
+          ciwch(i,j,nlev_ec-k+2,n)=zsec4(nxfield*(ny-j-1)+i+1)
+        end do
+      end do
+  !ZHG end
+  !ESO read qc (=clwc+ciwc)
+  !! QC  Cloud liquid water content [kg/kg]
+    case(201031)
+      do j=0,nymin1
+        do i=0,nxfield-1
+          clwch(i,j,nlev_ec-k+2,n)=zsec4(nxfield*(ny-j-1)+i+1)
+        end do
+      end do
+!$OMP CRITICAL
+      readclouds=.true.
+      sumclouds=.false.
+!$OMP END CRITICAL
+
+  end select
+
+  call grib_release(igrib(ii))
+
+  end do fieldloop
+!$OMP END DO
+  deallocate(zsec4)
+!$OMP END PARALLEL
+
+  deallocate(igrib)
+  !
+  ! CLOSING OF INPUT DATA FILE
+  !
+
+  ! 50 call grib_close_file(ifile)
+
+  !error message if no fields found with correct first longitude in it
+  if (gotGrid.eq.0) then
+    print*,'***ERROR: input file needs to contain GRiB1 formatted'// &
+         'messages'
+    stop
+  endif
+
+  if(levdiff2.eq.0) then
+    iwmax=nlev_ec+1
+    do i=0,nxmin1
+      do j=0,nymin1
+        wwh(i,j,nlev_ec+1)=0.
+      end do
+    end do
+  endif
+
+  ! For global fields, assign the leftmost data column also to the rightmost
+  ! data column; if required, shift whole grid by nxshift grid points
+  !*************************************************************************
+
+  if (xglobal) then
+    call shift_field_0(ewss,nxfield,ny)
+    call shift_field_0(nsss,nxfield,ny)
+    call shift_field_0(oro,nxfield,ny)
+    call shift_field_0(excessoro,nxfield,ny)
+    call shift_field_0(lsm,nxfield,ny)
+    call shift_field(ps,nxfield,ny,1,1,2,n)
+    call shift_field(sd,nxfield,ny,1,1,2,n)
+    call shift_field(msl,nxfield,ny,1,1,2,n)
+    call shift_field(tcc,nxfield,ny,1,1,2,n)
+    call shift_field(u10,nxfield,ny,1,1,2,n)
+    call shift_field(v10,nxfield,ny,1,1,2,n)
+    call shift_field(tt2,nxfield,ny,1,1,2,n)
+    call shift_field(td2,nxfield,ny,1,1,2,n)
+    call shift_field(lsprec,nxfield,ny,1,1,2,n)
+    call shift_field(convprec,nxfield,ny,1,1,2,n)
+    call shift_field(sshf,nxfield,ny,1,1,2,n)
+    call shift_field(ssr,nxfield,ny,1,1,2,n)
+    call shift_field(tth,nxfield,ny,nuvzmax,nuvz,2,n)
+    call shift_field(qvh,nxfield,ny,nuvzmax,nuvz,2,n)
+    call shift_field(uuh,nxfield,ny,nuvzmax,nuvz,1,1)
+    call shift_field(vvh,nxfield,ny,nuvzmax,nuvz,1,1)
+    call shift_field(wwh,nxfield,ny,nwzmax,nwz,1,1)
+  !ZHG
+    call shift_field(clwch,nxfield,ny,nuvzmax,nuvz,2,n)
+    if (.not.sumclouds) call shift_field(ciwch,nxfield,ny,nuvzmax,nuvz,2,n)
+  !ZHG end
+
+  endif
+
+  do i=0,nxmin1
+    do j=0,nymin1
+      if ((ewss(i,j).eq.0.).and.(nsss(i,j).eq.0.)) then
+        if ((i.ne.0).and.(j.ne.0).and.(i.ne.nxmin1).and.(j.ne.nymin1)) then
+          ewss(i,j)=(ewss(i-1,j-1)+ewss(i+1,j+1)+ewss(i+1,j)+ewss(i-1,j)+ &
+                     ewss(i,j+1)+ewss(i,j-1)+ewss(i-1,j+1)+ewss(i+1,j-1))/8.
+          nsss(i,j)=(nsss(i-1,j-1)+nsss(i+1,j+1)+nsss(i+1,j)+nsss(i-1,j)+ &
+                     nsss(i,j+1)+nsss(i,j-1)+nsss(i-1,j+1)+nsss(i+1,j-1))/8.
+        else if ((i.eq.0).and.(j.eq.0)) then
+          ewss(i,j)=(ewss(i+1,j+1)+ewss(i+1,j)+ewss(i,j+1))/3.
+          nsss(i,j)=(nsss(i+1,j+1)+nsss(i+1,j)+nsss(i,j+1))/3.
+        else if ((i.eq.nxmin1).and.(j.eq.nymin1)) then
+          ewss(i,j)=(ewss(i-1,j-1)+ewss(i-1,j)+ewss(i,j-1))/3.
+          nsss(i,j)=(nsss(i-1,j-1)+nsss(i-1,j)+nsss(i,j-1))/3.
+        else if ((i.eq.0).and.(j.eq.nymin1)) then
+          ewss(i,j)=(ewss(i+1,j-1)+ewss(i+1,j)+ewss(i,j-1))/3.
+          nsss(i,j)=(nsss(i+1,j-1)+nsss(i+1,j)+nsss(i,j-1))/3.
+        else if ((i.eq.nxmin1).and.(j.eq.0)) then
+          ewss(i,j)=(ewss(i-1,j+1)+ewss(i-1,j)+ewss(i,j+1))/3.
+          nsss(i,j)=(nsss(i-1,j+1)+nsss(i-1,j)+nsss(i,j+1))/3.
+        else if (i.eq.0) then
+          ewss(i,j)=(ewss(i+1,j+1)+ewss(i+1,j)+ewss(i,j+1)+ewss(i,j-1)+ewss(i+1,j-1))/5.
+          nsss(i,j)=(nsss(i+1,j+1)+nsss(i+1,j)+nsss(i,j+1)+nsss(i,j-1)+nsss(i+1,j-1))/5.
+        else if (i.eq.nxmin1) then
+          ewss(i,j)=(ewss(i-1,j+1)+ewss(i-1,j)+ewss(i,j+1)+ewss(i,j-1)+ewss(i-1,j-1))/5.
+          nsss(i,j)=(nsss(i-1,j+1)+nsss(i-1,j)+nsss(i,j+1)+nsss(i,j-1)+nsss(i-1,j-1))/5.
+        else if (j.eq.0) then
+          ewss(i,j)=(ewss(i+1,j+1)+ewss(i+1,j)+ewss(i-1,j)+ewss(i,j+1)+ewss(i-1,j+1))/5.
+          nsss(i,j)=(nsss(i+1,j+1)+nsss(i+1,j)+nsss(i-1,j)+nsss(i,j+1)+nsss(i-1,j+1))/5.
+        else if (j.eq.nymin1) then
+          ewss(i,j)=(ewss(i+1,j-1)+ewss(i+1,j)+ewss(i-1,j)+ewss(i,j-1)+ewss(i-1,j-1))/5.
+          nsss(i,j)=(nsss(i+1,j-1)+nsss(i+1,j)+nsss(i-1,j)+nsss(i,j-1)+nsss(i-1,j-1))/5.
+        endif
+      endif
+      sfcstress(i,j,1,n)=sqrt(ewss(i,j)**2+nsss(i,j)**2)
+    end do
+  end do
+
+  if ((.not.hflswitch).or.(.not.strswitch)) then
+    write(*,*) 'WARNING: No flux data contained in GRIB file ', &
+         wfname(indj)
+
+  ! CALCULATE USTAR AND SSHF USING THE PROFILE METHOD
+  ! As ECMWF has increased the model resolution, such that now the first model
+  ! level is at about 10 m (where 10-m wind is given), use the 2nd ECMWF level
+  ! (3rd model level in FLEXPART) for the profile method
+  !***************************************************************************
+
+    do i=0,nxmin1
+      do j=0,nymin1
+        plev1=akz(3)+bkz(3)*ps(i,j,1,n)
+        pmean=0.5*(ps(i,j,1,n)+plev1)
+        tv=tth(i,j,3,n)*(1.+0.61*qvh(i,j,3,n))
+        fu=-r_air*tv/ga/pmean
+        hlev1=fu*(plev1-ps(i,j,1,n))   ! HEIGTH OF FIRST MODEL LAYER
+        ff10m= sqrt(u10(i,j,1,n)**2+v10(i,j,1,n)**2)
+        fflev1=sqrt(uuh(i,j,3)**2+vvh(i,j,3)**2)
+        call pbl_profile(ps(i,j,1,n),td2(i,j,1,n),hlev1, &
+             tt2(i,j,1,n),tth(i,j,3,n),ff10m,fflev1, &
+             sfcstress(i,j,1,n),sshf(i,j,1,n))
+        if(sshf(i,j,1,n).gt.200.) sshf(i,j,1,n)=200.
+        if(sshf(i,j,1,n).lt.-400.) sshf(i,j,1,n)=-400.
+      end do
+    end do
+  endif
+
+
+  ! Assign 10 m wind to model level at eta=1.0 to have one additional model
+  ! level at the ground
+  ! Specific humidity is taken the same as at one level above
+  ! Temperature is taken as 2 m temperature
+  !**************************************************************************
+
+  do i=0,nxmin1
+    do j=0,nymin1
+      uuh(i,j,1)=u10(i,j,1,n)
+      vvh(i,j,1)=v10(i,j,1,n)
+      qvh(i,j,1,n)=qvh(i,j,2,n)
+      tth(i,j,1,n)=tt2(i,j,1,n)
+    end do
+  end do
+
+  if(iumax.ne.nuvz-1) stop 'READWIND: NUVZ NOT CONSISTENT'
+  if(iwmax.ne.nwz)    stop 'READWIND: NWZ NOT CONSISTENT'
+
+  return
+
+888 write(*,*) ' #### FLEXPART MODEL ERROR! WINDFIELD         #### '
+  write(*,*) ' #### ',wfname(indj),'                    #### '
+  write(*,*) ' #### IS NOT GRIB FORMAT !!!                  #### '
+  stop 'Execution terminated'
+
+end subroutine readwind_ecmwf
diff --git a/src/win_readwind_gfs.f90 b/src/win_readwind_gfs.f90
new file mode 100644
index 0000000000000000000000000000000000000000..d5811d2db02fc01281af617e97da7d78c9a65124
--- /dev/null
+++ b/src/win_readwind_gfs.f90
@@ -0,0 +1,734 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine readwind_gfs(indj,n,uuh,vvh,wwh)
+
+  !***********************************************************************
+  !*                                                                     *
+  !*             TRAJECTORY MODEL SUBROUTINE READWIND                    *
+  !*                                                                     *
+  !***********************************************************************
+  !*                                                                     *
+  !*             AUTHOR:      G. WOTAWA                                  *
+  !*             DATE:        1997-08-05                                 *
+  !*             LAST UPDATE: 2000-10-17, Andreas Stohl                  *
+  !*             CHANGE: 01/02/2001, Bernd C. Krueger, Variables tth and *
+  !*                     qvh (on eta coordinates) in common block        *
+  !*             CHANGE: 16/11/2005, Caroline Forster, GFS data          *
+  !*             CHANGE: 11/01/2008, Harald Sodemann, Input of GRIB1/2   *
+  !*                     data with the ECMWF grib_api library            *
+  !*             CHANGE: 03/12/2008, Harald Sodemann, update to f90 with *
+  !*                                 ECMWF grib_api                      *
+  !                                                                      *
+  !   Unified ECMWF and GFS builds                                       *
+  !   Marian Harustak, 12.5.2017                                         *
+  !     - Renamed routine from readwind to readwind_gfs                  *
+  !*                                                                     *
+  !***********************************************************************
+  !*                                                                     *
+  !* DESCRIPTION:                                                        *
+  !*                                                                     *
+  !* READING OF ECMWF METEOROLOGICAL FIELDS FROM INPUT DATA FILES. THE   *
+  !* INPUT DATA FILES ARE EXPECTED TO BE AVAILABLE IN GRIB CODE          *
+  !*                                                                     *
+  !* INPUT:                                                              *
+  !* indj               indicates number of the wind field to be read in *
+  !* n                  temporal index for meteorological fields (1 to 3)*
+  !*                                                                     *
+  !* IMPORTANT VARIABLES FROM COMMON BLOCK:                              *
+  !*                                                                     *
+  !* wfname             File name of data to be read in                  *
+  !* nx,ny,nuvz,nwz     expected field dimensions                        *
+  !* nlev_ec            number of vertical levels ecmwf model            *
+  !* uu,vv,ww           wind fields                                      *
+  !* tt,qv              temperature and specific humidity                *
+  !* ps                 surface pressure                                 *
+  !*                                                                     *
+  !***********************************************************************
+
+  use grib_api
+  use qvsat_mod
+
+  implicit none
+
+  !HSO  new parameters for grib_api
+  integer :: ifile
+  integer :: iret
+  integer :: igrib
+  integer :: gribVer,parCat,parNum,sfctyp,ivalsfc,discipl
+  !HSO end edits
+  real :: uuh(0:nxmax-1,0:nymax-1,nuvzmax)
+  real :: vvh(0:nxmax-1,0:nymax-1,nuvzmax)
+  real :: wwh(0:nxmax-1,0:nymax-1,nwzmax)
+  integer :: ii,indj,i,j,k,n,levdiff2,ifield,iumax,iwmax
+
+  ! NCEP
+  integer :: numpt,numpu,numpv,numpw,numprh,numpclwch
+  real :: help, temp
+  real :: elev
+  real :: ulev1(0:nxmax-1,0:nymax-1),vlev1(0:nxmax-1,0:nymax-1)
+  real :: tlev1(0:nxmax-1,0:nymax-1)
+  real :: qvh2(0:nxmax-1,0:nymax-1)
+
+  integer :: i179,i180,i181
+
+  ! VARIABLES AND ARRAYS NEEDED FOR GRIB DECODING
+  !HSO kept isec1, isec2 and zsec4 for consistency with gribex GRIB input
+
+  integer :: isec1(8),isec2(3)
+  real(kind=4) :: zsec4(jpunp)
+  real(kind=4) :: xaux,yaux,xaux0,yaux0
+  real(kind=8) :: xauxin,yauxin
+  real,parameter :: eps=1.e-4
+  real(kind=4) :: ewss(0:nxmax-1,0:nymax-1),nsss(0:nxmax-1,0:nymax-1)
+  real :: plev1,hlev1,ff10m,fflev1
+
+  logical :: hflswitch,strswitch
+
+  !HSO  for grib api error messages
+  character(len=24) :: gribErrorMsg = 'Error reading grib file'
+  character(len=20) :: gribFunction = 'readwind_gfs'
+  character(len=20) :: shortname
+
+
+  hflswitch=.false.
+  strswitch=.false.
+  levdiff2=nlev_ec-nwz+1
+  iumax=0
+  iwmax=0
+
+
+  ! OPENING OF DATA FILE (GRIB CODE)
+
+  !HSO
+  call grib_open_file(ifile,path(3)(1:length(3)) &
+         //trim(wfname(indj)),'r',iret)
+  if (iret.ne.GRIB_SUCCESS) then
+    goto 888   ! ERROR DETECTED
+  endif
+  !turn on support for multi fields messages
+  call grib_multi_support_on
+
+  numpt=0
+  numpu=0
+  numpv=0
+  numpw=0
+  numprh=0
+  numpclwch=0
+  ifield=0
+  do
+    ifield=ifield+1
+    !
+    ! GET NEXT FIELDS
+    !
+    call grib_new_from_file(ifile,igrib,iret)
+    if (iret.eq.GRIB_END_OF_FILE)  then
+      exit   ! EOF DETECTED
+    elseif (iret.ne.GRIB_SUCCESS) then
+      goto 888   ! ERROR DETECTED
+    endif
+
+    !first see if we read GRIB1 or GRIB2
+    call grib_get_int(igrib,'editionNumber',gribVer,iret)
+    !  call grib_check(iret,gribFunction,gribErrorMsg)
+
+    if (gribVer.eq.1) then ! GRIB Edition 1
+
+    !read the grib1 identifiers
+    call grib_get_int(igrib,'indicatorOfParameter',isec1(6),iret)
+    !  call grib_check(iret,gribFunction,gribErrorMsg)
+    call grib_get_int(igrib,'indicatorOfTypeOfLevel',isec1(7),iret)
+    !  call grib_check(iret,gribFunction,gribErrorMsg)
+    call grib_get_int(igrib,'level',isec1(8),iret)
+    !  call grib_check(iret,gribFunction,gribErrorMsg)
+
+    else ! GRIB Edition 2
+
+    !read the grib2 identifiers
+    call grib_get_string(igrib,'shortName',shortname,iret)
+
+    call grib_get_int(igrib,'discipline',discipl,iret)
+    !  call grib_check(iret,gribFunction,gribErrorMsg)
+    call grib_get_int(igrib,'parameterCategory',parCat,iret)
+    !  call grib_check(iret,gribFunction,gribErrorMsg)
+    call grib_get_int(igrib,'parameterNumber',parNum,iret)
+    !  call grib_check(iret,gribFunction,gribErrorMsg)
+    call grib_get_int(igrib,'typeOfFirstFixedSurface',sfctyp,iret)
+    !  call grib_check(iret,gribFunction,gribErrorMsg)
+    call grib_get_int(igrib,'scaledValueOfFirstFixedSurface', &
+         ivalsfc,iret)
+    !  call grib_check(iret,gribFunction,gribErrorMsg)
+
+    !  write(*,*) 'Field: ',ifield,parCat,parNum,sfctyp,shortname
+    !convert to grib1 identifiers
+    isec1(6)=-1
+    isec1(7)=-1
+    isec1(8)=-1
+    if ((parCat.eq.0).and.(parNum.eq.0).and.(sfctyp.eq.100)) then ! T
+      isec1(6)=11          ! indicatorOfParameter
+      isec1(7)=100         ! indicatorOfTypeOfLevel
+      isec1(8)=ivalsfc/100 ! level, convert to hPa
+    elseif ((parCat.eq.2).and.(parNum.eq.2).and.(sfctyp.eq.100)) then ! U
+      isec1(6)=33          ! indicatorOfParameter
+      isec1(7)=100         ! indicatorOfTypeOfLevel
+      isec1(8)=ivalsfc/100 ! level, convert to hPa
+    elseif ((parCat.eq.2).and.(parNum.eq.3).and.(sfctyp.eq.100)) then ! V
+      isec1(6)=34          ! indicatorOfParameter
+      isec1(7)=100         ! indicatorOfTypeOfLevel
+      isec1(8)=ivalsfc/100 ! level, convert to hPa
+    elseif ((parCat.eq.2).and.(parNum.eq.8).and.(sfctyp.eq.100)) then ! W
+      isec1(6)=39          ! indicatorOfParameter
+      isec1(7)=100         ! indicatorOfTypeOfLevel
+      isec1(8)=ivalsfc/100 ! level, convert to hPa
+    elseif ((parCat.eq.1).and.(parNum.eq.1).and.(sfctyp.eq.100)) then ! RH
+      isec1(6)=52          ! indicatorOfParameter
+      isec1(7)=100         ! indicatorOfTypeOfLevel
+      isec1(8)=ivalsfc/100 ! level, convert to hPa
+    elseif ((parCat.eq.1).and.(parNum.eq.1).and.(sfctyp.eq.103)) then ! RH2
+      isec1(6)=52          ! indicatorOfParameter
+      isec1(7)=105         ! indicatorOfTypeOfLevel
+      isec1(8)=2
+    elseif ((parCat.eq.0).and.(parNum.eq.0).and.(sfctyp.eq.103)) then ! T2
+      isec1(6)=11          ! indicatorOfParameter
+      isec1(7)=105         ! indicatorOfTypeOfLevel
+      isec1(8)=2
+    elseif ((parCat.eq.2).and.(parNum.eq.2).and.(sfctyp.eq.103)) then ! U10
+      isec1(6)=33          ! indicatorOfParameter
+      isec1(7)=105         ! indicatorOfTypeOfLevel
+      isec1(8)=10
+    elseif ((parCat.eq.2).and.(parNum.eq.3).and.(sfctyp.eq.103)) then ! V10
+      isec1(6)=34          ! indicatorOfParameter
+      isec1(7)=105         ! indicatorOfTypeOfLevel
+      isec1(8)=10
+    elseif ((parCat.eq.1).and.(parNum.eq.22).and.(sfctyp.eq.100)) then ! CLWMR Cloud Mixing Ratio [kg/kg]:
+      isec1(6)=153         ! indicatorOfParameter
+      isec1(7)=100         ! indicatorOfTypeOfLevel
+      isec1(8)=ivalsfc/100 ! level, convert to hPa
+    elseif ((parCat.eq.3).and.(parNum.eq.1).and.(sfctyp.eq.101)) then ! SLP
+      isec1(6)=2           ! indicatorOfParameter
+      isec1(7)=102         ! indicatorOfTypeOfLevel
+      isec1(8)=0
+    elseif ((parCat.eq.3).and.(parNum.eq.0).and.(sfctyp.eq.1)) then ! SP
+      isec1(6)=1           ! indicatorOfParameter
+      isec1(7)=1           ! indicatorOfTypeOfLevel
+      isec1(8)=0
+    elseif ((parCat.eq.1).and.(parNum.eq.13).and.(sfctyp.eq.1)) then ! SNOW
+      isec1(6)=66          ! indicatorOfParameter
+      isec1(7)=1           ! indicatorOfTypeOfLevel
+      isec1(8)=0
+    elseif ((parCat.eq.0).and.(parNum.eq.0).and.(sfctyp.eq.104)) then ! T sigma 0
+      isec1(6)=11          ! indicatorOfParameter
+      isec1(7)=107         ! indicatorOfTypeOfLevel
+      isec1(8)=0.995       ! lowest sigma level
+    elseif ((parCat.eq.2).and.(parNum.eq.2).and.(sfctyp.eq.104)) then ! U sigma 0
+      isec1(6)=33          ! indicatorOfParameter
+      isec1(7)=107         ! indicatorOfTypeOfLevel
+      isec1(8)=0.995       ! lowest sigma level
+    elseif ((parCat.eq.2).and.(parNum.eq.3).and.(sfctyp.eq.104)) then ! V sigma 0
+      isec1(6)=34          ! indicatorOfParameter
+      isec1(7)=107         ! indicatorOfTypeOfLevel
+      isec1(8)=0.995       ! lowest sigma level
+    elseif ((parCat.eq.3).and.(parNum.eq.5).and.(sfctyp.eq.1)) then ! TOPO
+      isec1(6)=7           ! indicatorOfParameter
+      isec1(7)=1           ! indicatorOfTypeOfLevel
+      isec1(8)=0
+    elseif ((parCat.eq.0).and.(parNum.eq.0).and.(sfctyp.eq.1) &
+         .and.(discipl.eq.2)) then ! LSM
+      isec1(6)=81          ! indicatorOfParameter
+      isec1(7)=1           ! indicatorOfTypeOfLevel
+      isec1(8)=0
+    elseif ((parCat.eq.3).and.(parNum.eq.196).and.(sfctyp.eq.1)) then ! BLH
+      isec1(6)=221         ! indicatorOfParameter
+      isec1(7)=1           ! indicatorOfTypeOfLevel
+      isec1(8)=0
+    elseif ((parCat.eq.1).and.(parNum.eq.7).and.(sfctyp.eq.1)) then ! LSP/TP
+      isec1(6)=62          ! indicatorOfParameter
+      isec1(7)=1           ! indicatorOfTypeOfLevel
+      isec1(8)=0
+    elseif ((parCat.eq.1).and.(parNum.eq.196).and.(sfctyp.eq.1)) then ! CP
+      isec1(6)=63          ! indicatorOfParameter
+      isec1(7)=1           ! indicatorOfTypeOfLevel
+      isec1(8)=0
+    endif
+
+    endif ! gribVer
+
+    if (isec1(6).ne.-1) then
+    !  get the size and data of the values array
+      call grib_get_real4_array(igrib,'values',zsec4,iret)
+    !    call grib_check(iret,gribFunction,gribErrorMsg)
+    endif
+
+    if(ifield.eq.1) then
+
+    !get the required fields from section 2
+    !store compatible to gribex input
+    call grib_get_int(igrib,'numberOfPointsAlongAParallel', &
+         isec2(2),iret)
+    !  call grib_check(iret,gribFunction,gribErrorMsg)
+    call grib_get_int(igrib,'numberOfPointsAlongAMeridian', &
+         isec2(3),iret)
+    !  call grib_check(iret,gribFunction,gribErrorMsg)
+    call grib_get_real8(igrib,'longitudeOfFirstGridPointInDegrees', &
+         xauxin,iret)
+    !  call grib_check(iret,gribFunction,gribErrorMsg)
+    call grib_get_real8(igrib,'latitudeOfLastGridPointInDegrees', &
+         yauxin,iret)
+    !  call grib_check(iret,gribFunction,gribErrorMsg)
+    xaux=xauxin+real(nxshift)*dx
+    yaux=yauxin
+
+    ! CHECK GRID SPECIFICATIONS
+
+      if(isec2(2).ne.nxfield) stop 'READWIND: NX NOT CONSISTENT'
+      if(isec2(3).ne.ny) stop 'READWIND: NY NOT CONSISTENT'
+      if(xaux.eq.0.) xaux=-179.0     ! NCEP DATA
+      xaux0=xlon0
+      yaux0=ylat0
+      if(xaux.lt.0.) xaux=xaux+360.
+      if(yaux.lt.0.) yaux=yaux+360.
+      if(xaux0.lt.0.) xaux0=xaux0+360.
+      if(yaux0.lt.0.) yaux0=yaux0+360.
+      if(abs(xaux-xaux0).gt.eps) &
+           stop 'READWIND: LOWER LEFT LONGITUDE NOT CONSISTENT'
+      if(abs(yaux-yaux0).gt.eps) &
+           stop 'READWIND: LOWER LEFT LATITUDE NOT CONSISTENT'
+    endif
+    !HSO end of edits
+
+    i179=nint(179./dx)
+    if (dx.lt.0.7) then
+      i180=nint(180./dx)+1    ! 0.5 deg data
+    else
+      i180=nint(179./dx)+1    ! 1 deg data
+    endif
+    i181=i180+1
+
+    if (isec1(6).ne.-1) then
+
+    do j=0,nymin1
+      do i=0,nxfield-1
+        if((isec1(6).eq.011).and.(isec1(7).eq.100)) then
+    ! TEMPERATURE
+           if((i.eq.0).and.(j.eq.0)) then
+              do ii=1,nuvz
+                if ((isec1(8)*100.0).eq.akz(ii)) numpt=ii
+              end do
+          endif
+          help=zsec4(nxfield*(ny-j-1)+i+1)
+          if(i.le.i180) then
+            tth(i179+i,j,numpt,n)=help
+          else
+            tth(i-i181,j,numpt,n)=help
+          endif
+        endif
+        if((isec1(6).eq.033).and.(isec1(7).eq.100)) then
+    ! U VELOCITY
+           if((i.eq.0).and.(j.eq.0)) then
+              do ii=1,nuvz
+                if ((isec1(8)*100.0).eq.akz(ii)) numpu=ii
+              end do
+          endif
+          help=zsec4(nxfield*(ny-j-1)+i+1)
+          if(i.le.i180) then
+            uuh(i179+i,j,numpu)=help
+          else
+            uuh(i-i181,j,numpu)=help
+          endif
+        endif
+        if((isec1(6).eq.034).and.(isec1(7).eq.100)) then
+    ! V VELOCITY
+           if((i.eq.0).and.(j.eq.0)) then
+              do ii=1,nuvz
+                if ((isec1(8)*100.0).eq.akz(ii)) numpv=ii
+              end do
+          endif
+          help=zsec4(nxfield*(ny-j-1)+i+1)
+          if(i.le.i180) then
+            vvh(i179+i,j,numpv)=help
+          else
+            vvh(i-i181,j,numpv)=help
+          endif
+        endif
+        if((isec1(6).eq.052).and.(isec1(7).eq.100)) then
+    ! RELATIVE HUMIDITY -> CONVERT TO SPECIFIC HUMIDITY LATER
+           if((i.eq.0).and.(j.eq.0)) then
+              do ii=1,nuvz
+                if ((isec1(8)*100.0).eq.akz(ii)) numprh=ii
+              end do
+          endif
+          help=zsec4(nxfield*(ny-j-1)+i+1)
+          if(i.le.i180) then
+            qvh(i179+i,j,numprh,n)=help
+          else
+            qvh(i-i181,j,numprh,n)=help
+          endif
+        endif
+        if((isec1(6).eq.001).and.(isec1(7).eq.001)) then
+    ! SURFACE PRESSURE
+          help=zsec4(nxfield*(ny-j-1)+i+1)
+          if(i.le.i180) then
+            ps(i179+i,j,1,n)=help
+          else
+            ps(i-i181,j,1,n)=help
+          endif
+        endif
+        if((isec1(6).eq.039).and.(isec1(7).eq.100)) then
+    ! W VELOCITY
+           if((i.eq.0).and.(j.eq.0)) then
+              do ii=1,nuvz
+                if ((isec1(8)*100.0).eq.akz(ii)) numpw=ii
+              end do
+          endif
+          help=zsec4(nxfield*(ny-j-1)+i+1)
+          if(i.le.i180) then
+            wwh(i179+i,j,numpw)=help
+          else
+            wwh(i-i181,j,numpw)=help
+          endif
+        endif
+        if((isec1(6).eq.066).and.(isec1(7).eq.001)) then
+    ! SNOW DEPTH
+          help=zsec4(nxfield*(ny-j-1)+i+1)
+          if(i.le.i180) then
+            sd(i179+i,j,1,n)=help
+          else
+            sd(i-i181,j,1,n)=help
+          endif
+        endif
+        if((isec1(6).eq.002).and.(isec1(7).eq.102)) then
+    ! MEAN SEA LEVEL PRESSURE
+          help=zsec4(nxfield*(ny-j-1)+i+1)
+          if(i.le.i180) then
+            msl(i179+i,j,1,n)=help
+          else
+            msl(i-i181,j,1,n)=help
+          endif
+        endif
+        if((isec1(6).eq.071).and.(isec1(7).eq.244)) then
+    ! TOTAL CLOUD COVER
+          help=zsec4(nxfield*(ny-j-1)+i+1)
+          if(i.le.i180) then
+            tcc(i179+i,j,1,n)=help
+          else
+            tcc(i-i181,j,1,n)=help
+          endif
+        endif
+        if((isec1(6).eq.033).and.(isec1(7).eq.105).and. &
+             (isec1(8).eq.10)) then
+    ! 10 M U VELOCITY
+          help=zsec4(nxfield*(ny-j-1)+i+1)
+          if(i.le.i180) then
+            u10(i179+i,j,1,n)=help
+          else
+            u10(i-i181,j,1,n)=help
+          endif
+        endif
+        if((isec1(6).eq.034).and.(isec1(7).eq.105).and. &
+             (isec1(8).eq.10)) then
+    ! 10 M V VELOCITY
+          help=zsec4(nxfield*(ny-j-1)+i+1)
+          if(i.le.i180) then
+            v10(i179+i,j,1,n)=help
+          else
+            v10(i-i181,j,1,n)=help
+          endif
+        endif
+        if((isec1(6).eq.011).and.(isec1(7).eq.105).and. &
+             (isec1(8).eq.02)) then
+    ! 2 M TEMPERATURE
+          help=zsec4(nxfield*(ny-j-1)+i+1)
+          if(i.le.i180) then
+            tt2(i179+i,j,1,n)=help
+          else
+            tt2(i-i181,j,1,n)=help
+          endif
+        endif
+        if((isec1(6).eq.017).and.(isec1(7).eq.105).and. &
+             (isec1(8).eq.02)) then
+    ! 2 M DEW POINT TEMPERATURE
+          help=zsec4(nxfield*(ny-j-1)+i+1)
+          if(i.le.i180) then
+            td2(i179+i,j,1,n)=help
+          else
+            td2(i-i181,j,1,n)=help
+          endif
+        endif
+        if((isec1(6).eq.062).and.(isec1(7).eq.001)) then
+    ! LARGE SCALE PREC.
+          help=zsec4(nxfield*(ny-j-1)+i+1)
+          if(i.le.i180) then
+            lsprec(i179+i,j,1,n)=help
+          else
+            lsprec(i-i181,j,1,n)=help
+          endif
+        endif
+        if((isec1(6).eq.063).and.(isec1(7).eq.001)) then
+    ! CONVECTIVE PREC.
+          help=zsec4(nxfield*(ny-j-1)+i+1)
+          if(i.le.i180) then
+            convprec(i179+i,j,1,n)=help
+          else
+            convprec(i-i181,j,1,n)=help
+          endif
+        endif
+        if((isec1(6).eq.007).and.(isec1(7).eq.001)) then
+    ! TOPOGRAPHY
+          help=zsec4(nxfield*(ny-j-1)+i+1)
+          if(i.le.i180) then
+            oro(i179+i,j)=help
+            excessoro(i179+i,j)=0.0 ! ISOBARIC SURFACES: SUBGRID TERRAIN DISREGARDED
+          else
+            oro(i-i181,j)=help
+            excessoro(i-i181,j)=0.0 ! ISOBARIC SURFACES: SUBGRID TERRAIN DISREGARDED
+          endif
+        endif
+        if((isec1(6).eq.081).and.(isec1(7).eq.001)) then
+    ! LAND SEA MASK
+          help=zsec4(nxfield*(ny-j-1)+i+1)
+          if(i.le.i180) then
+            lsm(i179+i,j)=help
+          else
+            lsm(i-i181,j)=help
+          endif
+        endif
+        if((isec1(6).eq.221).and.(isec1(7).eq.001)) then
+    ! MIXING HEIGHT
+          help=zsec4(nxfield*(ny-j-1)+i+1)
+          if(i.le.i180) then
+            hmix(i179+i,j,1,n)=help
+          else
+            hmix(i-i181,j,1,n)=help
+          endif
+        endif
+        if((isec1(6).eq.052).and.(isec1(7).eq.105).and. &
+             (isec1(8).eq.02)) then
+    ! 2 M RELATIVE HUMIDITY
+          help=zsec4(nxfield*(ny-j-1)+i+1)
+          if(i.le.i180) then
+            qvh2(i179+i,j)=help
+          else
+            qvh2(i-i181,j)=help
+          endif
+        endif
+        if((isec1(6).eq.011).and.(isec1(7).eq.107)) then
+    ! TEMPERATURE LOWEST SIGMA LEVEL
+          help=zsec4(nxfield*(ny-j-1)+i+1)
+          if(i.le.i180) then
+            tlev1(i179+i,j)=help
+          else
+            tlev1(i-i181,j)=help
+          endif
+        endif
+        if((isec1(6).eq.033).and.(isec1(7).eq.107)) then
+    ! U VELOCITY LOWEST SIGMA LEVEL
+          help=zsec4(nxfield*(ny-j-1)+i+1)
+          if(i.le.i180) then
+            ulev1(i179+i,j)=help
+          else
+            ulev1(i-i181,j)=help
+          endif
+        endif
+        if((isec1(6).eq.034).and.(isec1(7).eq.107)) then
+    ! V VELOCITY LOWEST SIGMA LEVEL
+          help=zsec4(nxfield*(ny-j-1)+i+1)
+          if(i.le.i180) then
+            vlev1(i179+i,j)=help
+          else
+            vlev1(i-i181,j)=help
+          endif
+        endif
+    ! SEC & IP 12/2018 read GFS clouds
+        if((isec1(6).eq.153).and.(isec1(7).eq.100)) then  !! CLWCR  Cloud liquid water content [kg/kg]
+           if((i.eq.0).and.(j.eq.0)) then
+              do ii=1,nuvz
+                if ((isec1(8)*100.0).eq.akz(ii)) numpclwch=ii
+              end do
+          endif
+          help=zsec4(nxfield*(ny-j-1)+i+1)
+          if(i.le.i180) then
+            clwch(i179+i,j,numpclwch,n)=help
+          else
+            clwch(i-i181,j,numpclwch,n)=help
+          endif
+          readclouds=.true.
+          sumclouds=.true.
+    !        readclouds=.false.
+    !       sumclouds=.false.
+        endif
+
+
+      end do
+    end do
+
+    endif
+
+    if((isec1(6).eq.33).and.(isec1(7).eq.100)) then
+    ! NCEP ISOBARIC LEVELS
+      iumax=iumax+1
+    endif
+
+    call grib_release(igrib)
+  end do                      !! READ NEXT LEVEL OR PARAMETER
+  !
+  ! CLOSING OF INPUT DATA FILE
+  !
+
+  !HSO close grib file
+  call grib_close_file(ifile)
+
+  ! SENS. HEAT FLUX
+  sshf(:,:,1,n)=0.0     ! not available from gfs.tccz.pgrbfxx files
+  hflswitch=.false.    ! Heat flux not available
+  ! SOLAR RADIATIVE FLUXES
+  ssr(:,:,1,n)=0.0      ! not available from gfs.tccz.pgrbfxx files
+  ! EW SURFACE STRESS
+  ewss=0.0         ! not available from gfs.tccz.pgrbfxx files
+  ! NS SURFACE STRESS
+  nsss=0.0         ! not available from gfs.tccz.pgrbfxx files
+  strswitch=.false.    ! stress not available
+
+  ! CONVERT TP TO LSP (GRIB2 only)
+  if (gribVer.eq.2) then
+    do j=0,nymin1
+    do i=0,nxfield-1
+     if(i.le.i180) then
+     if (convprec(i179+i,j,1,n).lt.lsprec(i179+i,j,1,n)) then ! neg precip would occur
+         lsprec(i179+i,j,1,n)= &
+              lsprec(i179+i,j,1,n)-convprec(i179+i,j,1,n)
+     else
+         lsprec(i179+i,j,1,n)=0
+     endif
+     else
+     if (convprec(i-i181,j,1,n).lt.lsprec(i-i181,j,1,n)) then
+          lsprec(i-i181,j,1,n)= &
+               lsprec(i-i181,j,1,n)-convprec(i-i181,j,1,n)
+     else
+          lsprec(i-i181,j,1,n)=0
+     endif
+     endif
+    enddo
+    enddo
+  endif
+  !HSO end edits
+
+
+  ! TRANSFORM RH TO SPECIFIC HUMIDITY
+
+  do j=0,ny-1
+    do i=0,nxfield-1
+      do k=1,nuvz
+        help=qvh(i,j,k,n)
+        temp=tth(i,j,k,n)
+        plev1=akm(k)+bkm(k)*ps(i,j,1,n)
+        elev=ew(temp,plev1)*help/100.0
+        qvh(i,j,k,n)=xmwml*(elev/(plev1-((1.0-xmwml)*elev)))
+      end do
+    end do
+  end do
+
+  ! CALCULATE 2 M DEW POINT FROM 2 M RELATIVE HUMIDITY
+  ! USING BOLTON'S (1980) FORMULA
+  ! BECAUSE td2 IS NOT AVAILABLE FROM NCEP GFS DATA
+
+  do j=0,ny-1
+    do i=0,nxfield-1
+        help=qvh2(i,j)
+        temp=tt2(i,j,1,n)
+        plev1=akm(k)+bkm(k)*ps(i,j,1,n)
+        elev=ew(temp,plev1)/100.*help/100.   !vapour pressure in hPa
+        td2(i,j,1,n)=243.5/(17.67/log(elev/6.112)-1)+273.
+        if (help.le.0.) td2(i,j,1,n)=tt2(i,j,1,n)
+    end do
+  end do
+
+  if(levdiff2.eq.0) then
+    iwmax=nlev_ec+1
+    do i=0,nxmin1
+      do j=0,nymin1
+        wwh(i,j,nlev_ec+1)=0.
+      end do
+    end do
+  endif
+
+
+  ! For global fields, assign the leftmost data column also to the rightmost
+  ! data column; if required, shift whole grid by nxshift grid points
+  !*************************************************************************
+
+  if (xglobal) then
+    call shift_field_0(ewss,nxfield,ny)
+    call shift_field_0(nsss,nxfield,ny)
+    call shift_field_0(oro,nxfield,ny)
+    call shift_field_0(excessoro,nxfield,ny)
+    call shift_field_0(lsm,nxfield,ny)
+    call shift_field_0(ulev1,nxfield,ny)
+    call shift_field_0(vlev1,nxfield,ny)
+    call shift_field_0(tlev1,nxfield,ny)
+    call shift_field_0(qvh2,nxfield,ny)
+    call shift_field(ps,nxfield,ny,1,1,2,n)
+    call shift_field(sd,nxfield,ny,1,1,2,n)
+    call shift_field(msl,nxfield,ny,1,1,2,n)
+    call shift_field(tcc,nxfield,ny,1,1,2,n)
+    call shift_field(u10,nxfield,ny,1,1,2,n)
+    call shift_field(v10,nxfield,ny,1,1,2,n)
+    call shift_field(tt2,nxfield,ny,1,1,2,n)
+    call shift_field(td2,nxfield,ny,1,1,2,n)
+    call shift_field(lsprec,nxfield,ny,1,1,2,n)
+    call shift_field(convprec,nxfield,ny,1,1,2,n)
+    call shift_field(sshf,nxfield,ny,1,1,2,n)
+    call shift_field(ssr,nxfield,ny,1,1,2,n)
+    call shift_field(hmix,nxfield,ny,1,1,2,n)
+    call shift_field(tth,nxfield,ny,nuvzmax,nuvz,2,n)
+    call shift_field(qvh,nxfield,ny,nuvzmax,nuvz,2,n)
+    call shift_field(uuh,nxfield,ny,nuvzmax,nuvz,1,1)
+    call shift_field(vvh,nxfield,ny,nuvzmax,nuvz,1,1)
+    call shift_field(wwh,nxfield,ny,nwzmax,nwz,1,1)
+  ! IP & SEC adding GFS Clouds 20181205
+    call shift_field(clwch,nxfield,ny,nuvzmax,nuvz,2,n)
+  endif
+
+  do i=0,nxmin1
+    do j=0,nymin1
+  ! Convert precip. from mm/s -> mm/hour
+      convprec(i,j,1,n)=convprec(i,j,1,n)*3600.
+      lsprec(i,j,1,n)=lsprec(i,j,1,n)*3600.
+      sfcstress(i,j,1,n)=sqrt(ewss(i,j)**2+nsss(i,j)**2)
+    end do
+  end do
+
+  if ((.not.hflswitch).or.(.not.strswitch)) then
+  !  write(*,*) 'WARNING: No flux data contained in GRIB file ',
+  !    +  wfname(indj)
+
+  ! CALCULATE USTAR AND SSHF USING THE PROFILE METHOD
+  !***************************************************************************
+
+    do i=0,nxmin1
+      do j=0,nymin1
+        hlev1=30.0                     ! HEIGHT OF FIRST MODEL SIGMA LAYER
+        ff10m= sqrt(u10(i,j,1,n)**2+v10(i,j,1,n)**2)
+        fflev1=sqrt(ulev1(i,j)**2+vlev1(i,j)**2)
+        call pbl_profile(ps(i,j,1,n),td2(i,j,1,n),hlev1, &
+             tt2(i,j,1,n),tlev1(i,j),ff10m,fflev1, &
+             sfcstress(i,j,1,n),sshf(i,j,1,n))
+        if(sshf(i,j,1,n).gt.200.) sshf(i,j,1,n)=200.
+        if(sshf(i,j,1,n).lt.-400.) sshf(i,j,1,n)=-400.
+      end do
+    end do
+  endif
+
+  if(iumax.ne.nuvz) stop 'READWIND: NUVZ NOT CONSISTENT'
+  if(iumax.ne.nwz)    stop 'READWIND: NWZ NOT CONSISTENT'
+
+  return
+888   write(*,*) ' #### FLEXPART MODEL ERROR! WINDFIELD         #### '
+  write(*,*) ' #### ',wfname(indj),'                    #### '
+  write(*,*) ' #### IS NOT GRIB FORMAT !!!                  #### '
+  stop 'Execution terminated'
+999   write(*,*) ' #### FLEXPART MODEL ERROR! WINDFIELD         #### '
+  write(*,*) ' #### ',wfname(indj),'                    #### '
+  write(*,*) ' #### CANNOT BE OPENED !!!                    #### '
+  stop 'Execution terminated'
+
+end subroutine readwind_gfs
diff --git a/src/win_readwind_nest.f90 b/src/win_readwind_nest.f90
new file mode 100644
index 0000000000000000000000000000000000000000..99628e11938234f9805d6b932b4221d7caa6f0e1
--- /dev/null
+++ b/src/win_readwind_nest.f90
@@ -0,0 +1,443 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine readwind_nest(indj,n,uuhn,vvhn,wwhn)
+  !                           i   i  o    o    o
+  !*****************************************************************************
+  !                                                                            *
+  !     This routine reads the wind fields for the nested model domains.       *
+  !     It is similar to subroutine readwind, which reads the mother domain.   *
+  !                                                                            *
+  !     Authors: A. Stohl, G. Wotawa                                           *
+  !                                                                            *
+  !     8 February 1999                                                        *
+  !                                                                            *
+  !     Last update: 17 October 2000, A. Stohl                                 *
+  !                                                                            *
+  !*****************************************************************************
+  !  Changes, Bernd C. Krueger, Feb. 2001:                                     *
+  !        Variables tthn and qvhn (on eta coordinates) in common block        *
+  !  CHANGE: 11/01/2008, Harald Sodemann, GRIB1/2 input with ECMWF grib_api    *
+  !  CHANGE: 03/12/2008, Harald Sodemann, update to f90 with ECMWF grib_api    *
+  !*****************************************************************************
+
+  use grib_api
+
+  implicit none
+
+  !HSO  parameters for grib_api
+  integer :: ifile
+  integer :: iret
+  integer :: igrib
+  integer :: gribVer,parCat,parNum,sfctyp,ivalsfc,discipl
+  integer :: parId !!added by mc for making it consistent with new readwind.f90
+  integer :: gotGrid
+  !HSO  end
+
+  real :: uuhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
+  real :: vvhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
+  real :: wwhn(0:nxmaxn-1,0:nymaxn-1,nwzmax,maxnests)
+  integer :: indj,i,j,k,n,levdiff2,ifield,iumax,iwmax,l
+
+  ! VARIABLES AND ARRAYS NEEDED FOR GRIB DECODING
+
+  ! dimension of isec2 at least (22+n), where n is the number of parallels or
+  ! meridians in a quasi-regular (reduced) Gaussian or lat/long grid
+
+  ! dimension of zsec2 at least (10+nn), where nn is the number of vertical
+  ! coordinate parameters
+
+  integer :: isec1(56),isec2(22+nxmaxn+nymaxn)
+  real(kind=4) :: zsec4(jpunp)
+  real(kind=4) :: xaux,yaux
+  real(kind=8) :: xauxin,yauxin
+  real,parameter :: eps=1.e-4
+  real :: ewss(0:nxmaxn-1,0:nymaxn-1),nsss(0:nxmaxn-1,0:nymaxn-1)
+  real :: plev1,pmean,tv,fu,hlev1,ff10m,fflev1
+  real :: conversion_factor !added by mc to make it consistent with new gridchek.f90
+
+  logical :: hflswitch,strswitch
+
+  !HSO  grib api error messages
+  character(len=24) :: gribErrorMsg = 'Error reading grib file'
+  character(len=20) :: gribFunction = 'readwind_nest'
+
+  do l=1,numbnests
+    hflswitch=.false.
+    strswitch=.false.
+    levdiff2=nlev_ec-nwz+1
+    iumax=0
+    iwmax=0
+
+    ifile=0
+    igrib=0
+    iret=0
+
+  !
+  ! OPENING OF DATA FILE (GRIB CODE)
+  !
+
+5   call grib_open_file(ifile,path(numpath+2*(l-1)+1) &
+         (1:length(numpath+2*(l-1)+1))//trim(wfnamen(l,indj)),'r')
+    if (iret.ne.GRIB_SUCCESS) then
+      goto 888   ! ERROR DETECTED
+    endif
+    !turn on support for multi fields messages */
+    !call grib_multi_support_on
+
+    gotGrid=0
+    ifield=0
+    do
+      ifield=ifield+1
+      !
+      ! GET NEXT FIELDS
+      !
+      call grib_new_from_file(ifile,igrib,iret)
+      if (iret.eq.GRIB_END_OF_FILE)  then
+        exit    ! EOF DETECTED
+      elseif (iret.ne.GRIB_SUCCESS) then
+        goto 888   ! ERROR DETECTED
+      endif
+
+      !first see if we read GRIB1 or GRIB2
+      call grib_get_int(igrib,'editionNumber',gribVer,iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+
+      if (gribVer.eq.1) then ! GRIB Edition 1
+
+        !print*,'GRiB Edition 1'
+        !read the grib2 identifiers
+        call grib_get_int(igrib,'indicatorOfParameter',isec1(6),iret)
+        call grib_check(iret,gribFunction,gribErrorMsg)
+        call grib_get_int(igrib,'level',isec1(8),iret)
+        call grib_check(iret,gribFunction,gribErrorMsg)
+
+        !change code for etadot to code for omega
+        if (isec1(6).eq.77) then
+          isec1(6)=135
+        endif
+
+        conversion_factor=1.
+
+
+      else
+
+        !print*,'GRiB Edition 2'
+        !read the grib2 identifiers
+        call grib_get_int(igrib,'discipline',discipl,iret)
+        call grib_check(iret,gribFunction,gribErrorMsg)
+        call grib_get_int(igrib,'parameterCategory',parCat,iret)
+        call grib_check(iret,gribFunction,gribErrorMsg)
+        call grib_get_int(igrib,'parameterNumber',parNum,iret)
+        call grib_check(iret,gribFunction,gribErrorMsg)
+        call grib_get_int(igrib,'typeOfFirstFixedSurface',sfctyp,iret)
+        call grib_check(iret,gribFunction,gribErrorMsg)
+        call grib_get_int(igrib,'level',ivalsfc,iret)
+        call grib_check(iret,gribFunction,gribErrorMsg)
+        call grib_get_int(igrib,'paramId',parId,iret) !added by mc to make it consisitent with new readwind.f90
+        call grib_check(iret,gribFunction,gribErrorMsg) !added by mc to make it consisitent with new readwind.f90
+
+        !print*,discipl,parCat,parNum,sfctyp,ivalsfc
+
+        !convert to grib1 identifiers
+        isec1(6)=-1
+        isec1(7)=-1
+        isec1(8)=-1
+        isec1(8)=ivalsfc     ! level
+         conversion_factor=1.
+        if ((parCat.eq.0).and.(parNum.eq.0).and.(sfctyp.eq.105)) then ! T
+          isec1(6)=130         ! indicatorOfParameter
+        elseif ((parCat.eq.2).and.(parNum.eq.2).and.(sfctyp.eq.105)) then ! U
+          isec1(6)=131         ! indicatorOfParameter
+        elseif ((parCat.eq.2).and.(parNum.eq.3).and.(sfctyp.eq.105)) then ! V
+          isec1(6)=132         ! indicatorOfParameter
+        elseif ((parCat.eq.1).and.(parNum.eq.0).and.(sfctyp.eq.105)) then ! Q
+          isec1(6)=133         ! indicatorOfParameter
+        ! ESO Cloud water is in a) fields CLWC and CIWC, *or* b) field QC
+        elseif ((parCat.eq.1).and.(parNum.eq.83).and.(sfctyp.eq.105)) then ! clwc
+            isec1(6)=246         ! indicatorOfParameter
+        elseif ((parCat.eq.1).and.(parNum.eq.84).and.(sfctyp.eq.105)) then ! ciwc
+            isec1(6)=247         ! indicatorOfParameter
+        ! ESO qc(=clwc+ciwc):
+        elseif ((parCat.eq.201).and.(parNum.eq.31).and.(sfctyp.eq.105)) then ! qc
+            isec1(6)=201031         ! indicatorOfParameter
+        elseif ((parCat.eq.3).and.(parNum.eq.0).and.(sfctyp.eq.1)) then !SP
+          isec1(6)=134         ! indicatorOfParameter
+        elseif ((parCat.eq.2).and.(parNum.eq.32)) then ! W, actually eta dot !
+          isec1(6)=135         ! indicatorOfParameter
+        elseif ((parCat.eq.128).and.(parNum.eq.77)) then ! W, actually eta dot !added by mc to make it consisitent with new readwind.f90
+          isec1(6)=135         ! indicatorOfParameter    !added by mc to make it consisitent with new readwind.f90
+        elseif ((parCat.eq.3).and.(parNum.eq.0).and.(sfctyp.eq.101)) then !SLP
+          isec1(6)=151         ! indicatorOfParameter
+        elseif ((parCat.eq.2).and.(parNum.eq.2).and.(sfctyp.eq.103)) then ! 10U
+          isec1(6)=165         ! indicatorOfParameter
+        elseif ((parCat.eq.2).and.(parNum.eq.3).and.(sfctyp.eq.103)) then ! 10V
+          isec1(6)=166         ! indicatorOfParameter
+        elseif ((parCat.eq.0).and.(parNum.eq.0).and.(sfctyp.eq.103)) then ! 2T
+          isec1(6)=167         ! indicatorOfParameter
+        elseif ((parCat.eq.0).and.(parNum.eq.6).and.(sfctyp.eq.103)) then ! 2D
+          isec1(6)=168         ! indicatorOfParameter
+        elseif ((parCat.eq.1).and.(parNum.eq.11).and.(sfctyp.eq.1)) then ! SD
+          isec1(6)=141         ! indicatorOfParameter
+          conversion_factor=1000. !added by mc to make it consisitent with new readwind.f90
+        elseif ((parCat.eq.6).and.(parNum.eq.1) .or. parId .eq. 164) then ! CC !added by mc to make it consisitent with new readwind.f90
+          isec1(6)=164         ! indicatorOfParameter
+        elseif ((parCat.eq.1).and.(parNum.eq.9) .or. parId .eq. 142) then ! LSP !added by mc to make it consisitent with new readwind.f90
+          isec1(6)=142         ! indicatorOfParameter
+        elseif ((parCat.eq.1).and.(parNum.eq.10)) then ! CP
+          isec1(6)=143         ! indicatorOfParameter
+          conversion_factor=1000. !added by mc to make it consisitent with new readwind.f90
+        elseif ((parCat.eq.0).and.(parNum.eq.11).and.(sfctyp.eq.1)) then ! SHF
+          isec1(6)=146         ! indicatorOfParameter
+        elseif ((parCat.eq.4).and.(parNum.eq.9).and.(sfctyp.eq.1)) then ! SR
+          isec1(6)=176         ! indicatorOfParameter
+        elseif ((parCat.eq.2).and.(parNum.eq.38) .or. parId .eq. 180) then ! EWSS !added by mc to make it consisitent with new readwind.f90
+          isec1(6)=180         ! indicatorOfParameter
+        elseif ((parCat.eq.2).and.(parNum.eq.37) .or. parId .eq. 181) then ! NSSS !added by mc to make it consisitent with new readwind.f90
+          isec1(6)=181         ! indicatorOfParameter
+        elseif ((parCat.eq.3).and.(parNum.eq.4)) then ! ORO
+          isec1(6)=129         ! indicatorOfParameter
+        elseif ((parCat.eq.3).and.(parNum.eq.7) .or. parId .eq. 160) then ! SDO !added by mc to make it consisitent with new readwind.f90
+          isec1(6)=160         ! indicatorOfParameter
+        elseif ((discipl.eq.2).and.(parCat.eq.0).and.(parNum.eq.0).and. &
+             (sfctyp.eq.1)) then ! LSM
+          isec1(6)=172         ! indicatorOfParameter
+        elseif (parNum.eq.152) then
+            isec1(6)=152         ! avoid warning for lnsp
+        else
+          print*,'***WARNING: undefined GRiB2 message found!',discipl, &
+               parCat,parNum,sfctyp
+        endif
+        if(parId .ne. isec1(6) .and. parId .ne. 77) then !added by mc to make it consisitent with new readwind.f90
+          write(*,*) 'parId',parId, 'isec1(6)',isec1(6)  !
+        !    stop
+        endif
+
+      endif
+
+      !HSO  get the size and data of the values array
+      if (isec1(6).ne.-1) then
+        call grib_get_real4_array(igrib,'values',zsec4,iret)
+        call grib_check(iret,gribFunction,gribErrorMsg)
+      endif
+
+      !HSO  get the required fields from section 2 in a gribex compatible manner
+      if(ifield.eq.1) then
+      call grib_get_int(igrib,'numberOfPointsAlongAParallel', &
+           isec2(2),iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+      call grib_get_int(igrib,'numberOfPointsAlongAMeridian', &
+           isec2(3),iret)
+      call grib_check(iret,gribFunction,gribErrorMsg)
+      call grib_get_int(igrib,'numberOfVerticalCoordinateValues', &
+           isec2(12))
+      call grib_check(iret,gribFunction,gribErrorMsg)
+      ! CHECK GRID SPECIFICATIONS
+      if(isec2(2).ne.nxn(l)) stop &
+      'READWIND: NX NOT CONSISTENT FOR A NESTING LEVEL'
+      if(isec2(3).ne.nyn(l)) stop &
+      'READWIND: NY NOT CONSISTENT FOR A NESTING LEVEL'
+      if(isec2(12)/2-1.ne.nlev_ec) stop 'READWIND: VERTICAL DISCRET&
+           &IZATION NOT CONSISTENT FOR A NESTING LEVEL'
+      endif ! ifield
+
+      !HSO  get the second part of the grid dimensions only from GRiB1 messages
+      if (isec1(6) .eq. 167 .and. (gotGrid.eq.0)) then ! !added by mc to make it consisitent with new readwind.f90
+        call grib_get_real8(igrib,'longitudeOfFirstGridPointInDegrees', &
+             xauxin,iret)
+        call grib_check(iret,gribFunction,gribErrorMsg)
+        call grib_get_real8(igrib,'latitudeOfLastGridPointInDegrees', &
+             yauxin,iret)
+        call grib_check(iret,gribFunction,gribErrorMsg)
+        if (xauxin.gt.180.) xauxin=xauxin-360.0
+        if (xauxin.lt.-180.) xauxin=xauxin+360.0
+
+        xaux=xauxin
+        yaux=yauxin
+        if (abs(xaux-xlon0n(l)).gt.eps) &
+        stop 'READWIND: LOWER LEFT LONGITUDE NOT CONSISTENT FOR A NESTING LEVEL'
+        if (abs(yaux-ylat0n(l)).gt.eps) &
+        stop 'READWIND: LOWER LEFT LATITUDE NOT CONSISTENT FOR A NESTING LEVEL'
+        gotGrid=1
+      endif
+
+      do j=0,nyn(l)-1
+        do i=0,nxn(l)-1
+          k=isec1(8)
+          if(isec1(6).eq.130) tthn(i,j,nlev_ec-k+2,n,l)= &!! TEMPERATURE
+               zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
+          if(isec1(6).eq.131) uuhn(i,j,nlev_ec-k+2,l)= &!! U VELOCITY
+               zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
+          if(isec1(6).eq.132) vvhn(i,j,nlev_ec-k+2,l)= &!! V VELOCITY
+               zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
+          if(isec1(6).eq.133) then                         !! SPEC. HUMIDITY
+            qvhn(i,j,nlev_ec-k+2,n,l)=zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
+            if (qvhn(i,j,nlev_ec-k+2,n,l) .lt. 0.) &
+                 qvhn(i,j,nlev_ec-k+2,n,l) = 0.
+    !          this is necessary because the gridded data may contain
+    !          spurious negative values
+          endif
+          if(isec1(6).eq.134) psn(i,j,1,n,l)= &!! SURF. PRESS.
+               zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
+          if(isec1(6).eq.135) wwhn(i,j,nlev_ec-k+1,l)= &!! W VELOCITY
+               zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
+          if(isec1(6).eq.141) sdn(i,j,1,n,l)= &!! SNOW DEPTH
+               zsec4(nxn(l)*(nyn(l)-j-1)+i+1)/conversion_factor !added by mc to make it consisitent with new readwind.f90!
+          if(isec1(6).eq.151) msln(i,j,1,n,l)= &!! SEA LEVEL PRESS.
+               zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
+          if(isec1(6).eq.164) tccn(i,j,1,n,l)= &!! CLOUD COVER
+               zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
+          if(isec1(6).eq.165) u10n(i,j,1,n,l)= &!! 10 M U VELOCITY
+               zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
+          if(isec1(6).eq.166) v10n(i,j,1,n,l)= &!! 10 M V VELOCITY
+               zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
+          if(isec1(6).eq.167) tt2n(i,j,1,n,l)= &!! 2 M TEMPERATURE
+               zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
+          if(isec1(6).eq.168) td2n(i,j,1,n,l)= &!! 2 M DEW POINT
+               zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
+          if(isec1(6).eq.142) then                         !! LARGE SCALE PREC.
+            lsprecn(i,j,1,n,l)=zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
+            if (lsprecn(i,j,1,n,l).lt.0.) lsprecn(i,j,1,n,l)=0.
+          endif
+          if(isec1(6).eq.143) then                         !! CONVECTIVE PREC.
+            convprecn(i,j,1,n,l)=zsec4(nxn(l)*(nyn(l)-j-1)+i+1)/conversion_factor !added by mc to make it consisitent with new readwind.f90
+            if (convprecn(i,j,1,n,l).lt.0.) convprecn(i,j,1,n,l)=0.
+          endif
+          if(isec1(6).eq.146) sshfn(i,j,1,n,l)= &!! SENS. HEAT FLUX
+               zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
+          if((isec1(6).eq.146).and. &
+               (zsec4(nxn(l)*(nyn(l)-j-1)+i+1).ne.0.)) hflswitch=.true.    ! Heat flux available
+          if(isec1(6).eq.176) then                         !! SOLAR RADIATION
+            ssrn(i,j,1,n,l)=zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
+            if (ssrn(i,j,1,n,l).lt.0.) ssrn(i,j,1,n,l)=0.
+          endif
+          if(isec1(6).eq.180) ewss(i,j)= &!! EW SURFACE STRESS
+               zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
+          if(isec1(6).eq.181) nsss(i,j)= &!! NS SURFACE STRESS
+               zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
+          if(((isec1(6).eq.180).or.(isec1(6).eq.181)).and. &
+               (zsec4(nxn(l)*(nyn(l)-j-1)+i+1).ne.0.)) strswitch=.true.    ! stress available
+          if(isec1(6).eq.129) oron(i,j,l)= &!! ECMWF OROGRAPHY
+               zsec4(nxn(l)*(nyn(l)-j-1)+i+1)/ga
+          if(isec1(6).eq.160) excessoron(i,j,l)= &!! STANDARD DEVIATION OF OROGRAPHY
+               zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
+          if(isec1(6).eq.172) lsmn(i,j,l)= &!! ECMWF LAND SEA MASK
+               zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
+          if(isec1(6).eq.131) iumax=max(iumax,nlev_ec-k+1)
+          if(isec1(6).eq.135) iwmax=max(iwmax,nlev_ec-k+1)
+
+    ! ESO TODO:
+    ! -add check for if one of clwc/ciwc missing (error),
+    !    also if all 3 cw fields present, use qc and disregard the others
+          if(isec1(6).eq.246) then  !! CLWC  Cloud liquid water content [kg/kg]
+            clwchn(i,j,nlev_ec-k+2,n,l)=zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
+            readclouds_nest(l)=.true.
+            sumclouds_nest(l)=.false.
+          endif
+          if(isec1(6).eq.247) then  !! CIWC  Cloud ice water content
+            ciwchn(i,j,nlev_ec-k+2,n,l)=zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
+          endif
+    !ZHG end
+    !ESO read qc (=clwc+ciwc)
+          if(isec1(6).eq.201031) then  !! QC  Cloud liquid water content [kg/kg]
+            clwchn(i,j,nlev_ec-k+2,n,l)=zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
+            readclouds_nest(l)=.true.
+            sumclouds_nest(l)=.true.
+          endif
+
+
+        end do
+      end do
+
+      call grib_release(igrib)
+    end do                      !! READ NEXT LEVEL OR PARAMETER
+  !
+  ! CLOSING OF INPUT DATA FILE
+  !
+    call grib_close_file(ifile)
+
+    !error message if no fields found with correct first longitude in it
+    if (gotGrid.eq.0) then
+      print*,'***ERROR: input file needs to contain GRiB1 formatted'// &
+           'messages'
+      stop
+    endif
+
+    if(levdiff2.eq.0) then
+      iwmax=nlev_ec+1
+      do i=0,nxn(l)-1
+        do j=0,nyn(l)-1
+          wwhn(i,j,nlev_ec+1,l)=0.
+        end do
+      end do
+    endif
+
+    do i=0,nxn(l)-1
+      do j=0,nyn(l)-1
+        sfcstressn(i,j,1,n,l)=sqrt(ewss(i,j)**2+nsss(i,j)**2)
+      end do
+    end do
+
+    if ((.not.hflswitch).or.(.not.strswitch)) then
+      write(*,*) 'WARNING: No flux data contained in GRIB file ', &
+           wfnamen(l,indj)
+
+    ! CALCULATE USTAR AND SSHF USING THE PROFILE METHOD
+    ! As ECMWF has increased the model resolution, such that now the first model
+    ! level is at about 10 m (where 10-m wind is given), use the 2nd ECMWF level
+    ! (3rd model level in FLEXPART) for the profile method
+    !***************************************************************************
+
+      do i=0,nxn(l)-1
+        do j=0,nyn(l)-1
+          plev1=akz(3)+bkz(3)*psn(i,j,1,n,l)
+          pmean=0.5*(psn(i,j,1,n,l)+plev1)
+          tv=tthn(i,j,3,n,l)*(1.+0.61*qvhn(i,j,3,n,l))
+          fu=-r_air*tv/ga/pmean
+          hlev1=fu*(plev1-psn(i,j,1,n,l))   ! HEIGTH OF FIRST MODEL LAYER
+          ff10m= sqrt(u10n(i,j,1,n,l)**2+v10n(i,j,1,n,l)**2)
+          fflev1=sqrt(uuhn(i,j,3,l)**2+vvhn(i,j,3,l)**2)
+          call pbl_profile(psn(i,j,1,n,l),td2n(i,j,1,n,l),hlev1, &
+               tt2n(i,j,1,n,l),tthn(i,j,3,n,l),ff10m,fflev1, &
+               sfcstressn(i,j,1,n,l),sshfn(i,j,1,n,l))
+          if(sshfn(i,j,1,n,l).gt.200.) sshfn(i,j,1,n,l)=200.
+          if(sshfn(i,j,1,n,l).lt.-400.) sshfn(i,j,1,n,l)=-400.
+        end do
+      end do
+    endif
+
+
+  ! Assign 10 m wind to model level at eta=1.0 to have one additional model
+  ! level at the ground
+  ! Specific humidity is taken the same as at one level above
+  ! Temperature is taken as 2 m temperature
+  !**************************************************************************
+
+    do i=0,nxn(l)-1
+      do j=0,nyn(l)-1
+        uuhn(i,j,1,l)=u10n(i,j,1,n,l)
+        vvhn(i,j,1,l)=v10n(i,j,1,n,l)
+        qvhn(i,j,1,n,l)=qvhn(i,j,2,n,l)
+        tthn(i,j,1,n,l)=tt2n(i,j,1,n,l)
+      end do
+    end do
+
+    if(iumax.ne.nuvz-1) stop &
+         'READWIND: NUVZ NOT CONSISTENT FOR A NESTING LEVEL'
+    if(iwmax.ne.nwz) stop &
+         'READWIND: NWZ NOT CONSISTENT FOR A NESTING LEVEL'
+
+  end do
+
+  return
+888   write(*,*) ' #### FLEXPART MODEL ERROR! WINDFIELD         #### '
+  write(*,*) ' #### ',wfnamen(l,indj),' FOR NESTING LEVEL  #### '
+  write(*,*) ' #### ',l,' IS NOT GRIB FORMAT !!!           #### '
+  stop 'Execution terminated'
+
+
+999   write(*,*) ' #### FLEXPART MODEL ERROR! WINDFIELD         #### '
+  write(*,*) ' #### ',wfnamen(l,indj),'                    #### '
+  write(*,*) ' #### CANNOT BE OPENED FOR NESTING LEVEL ',l,'####'
+
+end subroutine readwind_nest
diff --git a/src/win_shift_field.f90 b/src/win_shift_field.f90
new file mode 100644
index 0000000000000000000000000000000000000000..5deec058a9dec47ec694f7499b7394d641da8f93
--- /dev/null
+++ b/src/win_shift_field.f90
@@ -0,0 +1,58 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine shift_field(field,nxf,nyf,nzfmax,nzf,nmax,n)
+  !                        i/o   i   i    i     i   i   i
+  !*****************************************************************************
+  !                                                                            *
+  !  This subroutine shifts global fields by nxshift grid cells, in order to   *
+  !  facilitate all sorts of nested wind fields, or output grids, which,       *
+  !  without shifting, would overlap with the domain "boundary".               *
+  !                                                                            *
+  !    Author: A. Stohl                                                        *
+  !                                                                            *
+  !    3 July 2002                                                             *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  ! Constants:                                                                 *
+  !                                                                            *
+  !*****************************************************************************
+
+  implicit none
+
+  integer :: nxf,nyf,nzf,n,ix,jy,kz,ixs,nzfmax,nmax
+  real :: field(0:nxmax-1,0:nymax-1,nzfmax,nmax),xshiftaux(0:nxmax-1)
+
+  ! Loop over y and z
+  !******************
+
+  do kz=1,nzf
+    do jy=0,nyf-1
+
+  ! Shift the data
+  !***************
+
+      if (nxshift.ne.0) then
+        do ix=0,nxf-1
+          if (ix.ge.nxshift) then
+            ixs=ix-nxshift
+          else
+            ixs=nxf-nxshift+ix
+          endif
+          xshiftaux(ixs)=field(ix,jy,kz,n)
+        end do
+        do ix=0,nxf-1
+          field(ix,jy,kz,n)=xshiftaux(ix)
+        end do
+      endif
+
+  ! Repeat the westernmost grid cells at the easternmost domain "boundary"
+  !***********************************************************************
+
+      field(nxf,jy,kz,n)=field(0,jy,kz,n)
+    end do
+  end do
+end subroutine shift_field
diff --git a/src/win_shift_field_0.f90 b/src/win_shift_field_0.f90
new file mode 100644
index 0000000000000000000000000000000000000000..b3410811961f071b3f596b64219c914668348348
--- /dev/null
+++ b/src/win_shift_field_0.f90
@@ -0,0 +1,58 @@
+! SPDX-FileCopyrightText: FLEXPART 1998-2023, see flexpart_license.txt
+! SPDX-License-Identifier: GPL-3.0-or-later
+
+subroutine shift_field_0(field,nxf,nyf)
+  !                          i/o   i   i
+  !*****************************************************************************
+  !                                                                            *
+  !  This subroutine shifts global fields by nxshift grid cells, in order to   *
+  !  facilitate all sorts of nested wind fields, or output grids, which,       *
+  !  without shifting, would overlap with the domain "boundary".               *
+  !                                                                            *
+  !    Author: A. Stohl                                                        *
+  !                                                                            *
+  !    3 July 2002                                                             *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  ! Constants:                                                                 *
+  !                                                                            *
+  !*****************************************************************************
+
+  implicit none
+
+  integer :: nxf,nyf,ix,jy,ixs
+  real :: field(0:nxmax-1,0:nymax-1),xshiftaux(0:nxmax-1)
+
+  ! Loop over y and z
+  !******************
+
+  do jy=0,nyf-1
+
+  ! Shift the data
+  !***************
+
+    if (nxshift.ne.0) then
+      do ix=0,nxf-1
+        if (ix.ge.nxshift) then
+          ixs=ix-nxshift
+        else
+          ixs=nxf-nxshift+ix
+        endif
+        xshiftaux(ixs)=field(ix,jy)
+      end do
+      do ix=0,nxf-1
+        field(ix,jy)=xshiftaux(ix)
+      end do
+    endif
+
+  ! Repeat the westernmost grid cells at the easternmost domain "boundary"
+  !***********************************************************************
+
+    field(nxf,jy)=field(0,jy)
+  end do
+
+  return
+end subroutine shift_field_0
diff --git a/src/windfields_mod.f90 b/src/windfields_mod.f90
index 840fba6067f87889e59a8c7884d937b7a84df5e4..2674b3402b61d5426c6396ecb2131822706e394b 100644
--- a/src/windfields_mod.f90
+++ b/src/windfields_mod.f90
@@ -114,7 +114,7 @@ module windfields_mod
     pvn,                                   & ! potential vorticity
     rhon,                                  & ! air density [kg/m3]
     prsn,                                   & ! air pressure RLT
-    drhodzn                                  ! vertical air density gradient [kg/m2] 
+    drhodzn                                  ! vertical air density gradient [kg/m2]
 
   ! ETA equivalents
   real,allocatable,dimension(:,:,:,:,:) :: &
@@ -241,3758 +241,32 @@ module windfields_mod
 
 contains
 
-subroutine detectformat
+#include "win_detectformat.f90"
 
-  !*****************************************************************************
-  !                                                                            *
-  !   This routine reads the 1st file with windfields to determine             *
-  !   the format.                                                              *
-  !                                                                            *
-  !     Authors: M. Harustak                                                   *
-  !                                                                            *
-  !     6 May 2015                                                             *
-  !                                                                            *
-  !   Unified ECMWF and GFS builds                                             *
-  !   Marian Harustak, 12.5.2017                                               *
-  !     - Added routine to FP10 Flexpart distribution                          *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  ! fname                file name of file to check                            *
-  !                                                                            *
-  !*****************************************************************************
-
-  use par_mod
-  use com_mod
-  use class_gribfile_mod
-
-
-  implicit none
-
-  character(len=255) :: filename
-  character(len=255) :: wfname1(maxwf)
-
-  ! If no file is available
-  if ( maxwf.le.0 ) then
-    print*,'No wind file available'
-    metdata_format = GRIBFILE_CENTRE_UNKNOWN
-    return
-  endif
-
-  ! construct filename
-  filename = path(3)(1:length(3)) // trim(wfname(1))
- 
-  ! get format
-  metdata_format = gribfile_centre(TRIM(filename))
-end subroutine detectformat
-
-subroutine gridcheck_ecmwf
-
-  !**********************************************************************
-  !                                                                     *
-  !             FLEXPART MODEL SUBROUTINE GRIDCHECK                     *
-  !                                                                     *
-  !**********************************************************************
-  !                                                                     *
-  !             AUTHOR:      G. WOTAWA                                  *
-  !             DATE:        1997-08-06                                 *
-  !             LAST UPDATE: 1997-10-10                                 *
-  !                                                                     *
-  !             Update:      1999-02-08, global fields allowed, A. Stohl*
-  !             CHANGE: 11/01/2008, Harald Sodemann, GRIB1/2 input with *
-  !                                 ECMWF grib_api                      *
-  !             CHANGE: 03/12/2008, Harald Sodemann, update to f90 with *
-  !                                 ECMWF grib_api                      *
-  !                                                                     *
-  !   Unified ECMWF and GFS builds                                      *
-  !   Marian Harustak, 12.5.2017                                        *
-  !     - Renamed from gridcheck to gridcheck_ecmwf                     *
-  !                                                                     *
-  !**********************************************************************
-  !                                                                     *
-  ! DESCRIPTION:                                                        *
-  !                                                                     *
-  ! THIS SUBROUTINE DETERMINES THE GRID SPECIFICATIONS (LOWER LEFT      *
-  ! LONGITUDE, LOWER LEFT LATITUDE, NUMBER OF GRID POINTS, GRID DIST-   *
-  ! ANCE AND VERTICAL DISCRETIZATION OF THE ECMWF MODEL) FROM THE       *
-  ! GRIB HEADER OF THE FIRST INPUT FILE. THE CONSISTANCY (NO CHANGES    *
-  ! WITHIN ONE FLEXPART RUN) IS CHECKED IN THE ROUTINE "READWIND" AT    *
-  ! ANY CALL.                                                           *
-  !                                                                     *
-  ! XLON0                geographical longitude of lower left gridpoint *
-  ! YLAT0                geographical latitude of lower left gridpoint  *
-  ! NX                   number of grid points x-direction              *
-  ! NY                   number of grid points y-direction              *
-  ! DX                   grid distance x-direction                      *
-  ! DY                   grid distance y-direction                      *
-  ! NUVZ                 number of grid points for horizontal wind      *
-  !                      components in z direction                      *
-  ! NWZ                  number of grid points for vertical wind        *
-  !                      component in z direction                       *
-  ! sizesouth, sizenorth give the map scale (i.e. number of virtual grid*
-  !                      points of the polar stereographic grid):       *
-  !                      used to check the CFL criterion                *
-  ! UVHEIGHT(1)-         heights of gridpoints where u and v are        *
-  ! UVHEIGHT(NUVZ)       given                                          *
-  ! WHEIGHT(1)-          heights of gridpoints where w is given         *
-  ! WHEIGHT(NWZ)                                                        *
-  !                                                                     *
-  !**********************************************************************
-
-  use grib_api
-  use cmapf_mod, only: stlmbr,stcm2p
-
-  implicit none
-
-  !HSO  parameters for grib_api
-  integer :: ifile
-  integer :: iret
-  integer :: igrib
-  integer :: gotGrid
-  real(kind=4) :: xaux1,xaux2,yaux1,yaux2
-  real(kind=8) :: xaux1in,xaux2in,yaux1in,yaux2in
-  integer :: gribVer,parCat,parNum,sfctyp,ivalsfc,discipl,parId
-  !HSO  end
-  integer :: ix,jy,i,ifn,ifield,j,k,iumax,iwmax,numskip
-  real :: sizesouth,sizenorth,xauxa,conversion_factor
-
-  ! VARIABLES AND ARRAYS NEEDED FOR GRIB DECODING
-
-  ! dimension of isec2 at least (22+n), where n is the number of parallels or
-  ! meridians in a quasi-regular (reduced) Gaussian or lat/long grid
-
-  ! dimension of zsec2 at least (10+nn), where nn is the number of vertical
-  ! coordinate parameters
-
-  integer :: isec1(56),isec2(22+nxmax+nymax)
-  real(kind=4) :: zsec2(60+2*nuvzmax),zsec4(jpunp)
-  character(len=1) :: opt
-
-  !HSO  grib api error messages
-  character(len=24) :: gribErrorMsg = 'Error reading grib file'
-  character(len=20) :: gribFunction = 'gridcheck'
-
-
-  iumax=0
-  iwmax=0
-
-  if(ideltas.gt.0) then
-    ifn=1
-  else
-    ifn=numbwf
-  endif
-  !
-  ! OPENING OF DATA FILE (GRIB CODE)
-  !
-5 call grib_open_file(ifile,path(3)(1:length(3)) &
-       //trim(wfname(ifn)),'r',iret)
-  if (iret.ne.GRIB_SUCCESS) then
-    goto 999   ! ERROR DETECTED
-  endif
-  !turn on support for multi fields messages
-  !call grib_multi_support_on
-
-  gotGrid=0
-  ifield=0
-  do while(.true.)
-    ifield=ifield+1
-    !
-    ! GET NEXT FIELDS
-    !
-    call grib_new_from_file(ifile,igrib,iret)
-    if (iret.eq.GRIB_END_OF_FILE ) then
-      exit   ! EOF DETECTED
-    elseif (iret.ne.GRIB_SUCCESS) then
-      goto 999   ! ERROR DETECTED
-    endif
-
-    !first see if we read GRIB1 or GRIB2
-    call grib_get_int(igrib,'editionNumber',gribVer,iret)
-    call grib_check(iret,gribFunction,gribErrorMsg)
-
-    if (gribVer.eq.1) then ! GRIB Edition 1
-
-      !print*,'GRiB Edition 1'
-      !read the grib2 identifiers
-      call grib_get_int(igrib,'indicatorOfParameter',isec1(6),iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-      call grib_get_int(igrib,'level',isec1(8),iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-
-      !change code for etadot to code for omega
-      if (isec1(6).eq.77) then
-        isec1(6)=135
-      endif
-
-      !print*,isec1(6),isec1(8)
-
-    else
-
-      !print*,'GRiB Edition 2'
-      !read the grib2 identifiers
-      call grib_get_int(igrib,'discipline',discipl,iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-      call grib_get_int(igrib,'parameterCategory',parCat,iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-      call grib_get_int(igrib,'parameterNumber',parNum,iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-      call grib_get_int(igrib,'typeOfFirstFixedSurface',sfctyp,iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-      call grib_get_int(igrib,'level',ivalsfc,iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-      call grib_get_int(igrib,'paramId',parId,iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-
-      !print*,discipl,parCat,parNum,sfctyp,ivalsfc
-
-      !convert to grib1 identifiers
-      isec1(6)=-1
-      isec1(7)=-1
-      isec1(8)=-1
-      isec1(8)=ivalsfc     ! level
-      if ((parCat.eq.0).and.(parNum.eq.0).and.(sfctyp.eq.105)) then ! T
-        isec1(6)=130         ! indicatorOfParameter
-      elseif ((parCat.eq.2).and.(parNum.eq.2).and.(sfctyp.eq.105)) then ! U
-        isec1(6)=131         ! indicatorOfParameter
-      elseif ((parCat.eq.2).and.(parNum.eq.3).and.(sfctyp.eq.105)) then ! V
-        isec1(6)=132         ! indicatorOfParameter
-      elseif ((parCat.eq.1).and.(parNum.eq.0).and.(sfctyp.eq.105)) then ! Q
-        isec1(6)=133         ! indicatorOfParameter
-        !ZHG FOR CLOUDS FROM GRIB
-      elseif ((parCat.eq.1).and.(parNum.eq.83).and.(sfctyp.eq.105)) then ! clwc
-        isec1(6)=246         ! indicatorOfParameter
-      elseif ((parCat.eq.1).and.(parNum.eq.84).and.(sfctyp.eq.105)) then ! ciwc
-        isec1(6)=247         ! indicatorOfParameter
-        !ZHG end
-        ! ESO qc(=clwc+ciwc)
-      elseif ((parCat.eq.201).and.(parNum.eq.31).and.(sfctyp.eq.105)) then ! qc
-        isec1(6)=201031      ! indicatorOfParameter
-      elseif ((parCat.eq.3).and.(parNum.eq.0).and.(sfctyp.eq.1)) then !SP
-        isec1(6)=134         ! indicatorOfParameter
-      elseif ((parCat.eq.2).and.(parNum.eq.32)) then ! W, actually eta dot
-        isec1(6)=135         ! indicatorOfParameter
-      elseif ((parCat.eq.128).and.(parNum.eq.77)) then ! W, actually eta dot
-        isec1(6)=135         ! indicatorOfParameter
-      elseif ((parCat.eq.3).and.(parNum.eq.0).and.(sfctyp.eq.101)) then !SLP
-        isec1(6)=151         ! indicatorOfParameter
-      elseif ((parCat.eq.2).and.(parNum.eq.2).and.(sfctyp.eq.103)) then ! 10U
-        isec1(6)=165         ! indicatorOfParameter
-      elseif ((parCat.eq.2).and.(parNum.eq.3).and.(sfctyp.eq.103)) then ! 10V
-        isec1(6)=166         ! indicatorOfParameter
-      elseif ((parCat.eq.0).and.(parNum.eq.0).and.(sfctyp.eq.103)) then ! 2T
-        isec1(6)=167         ! indicatorOfParameter
-      elseif ((parCat.eq.0).and.(parNum.eq.6).and.(sfctyp.eq.103)) then ! 2D
-        isec1(6)=168         ! indicatorOfParameter
-      elseif ((parCat.eq.1).and.(parNum.eq.11).and.(sfctyp.eq.1)) then ! SD
-        isec1(6)=141         ! indicatorOfParameter
-      elseif ((parCat.eq.6).and.(parNum.eq.1) .or. parId .eq. 164) then ! CC
-        isec1(6)=164         ! indicatorOfParameter
-      elseif ((parCat.eq.1).and.(parNum.eq.9) .or. parId .eq. 142) then ! LSP
-        isec1(6)=142         ! indicatorOfParameter
-      elseif ((parCat.eq.1).and.(parNum.eq.10)) then ! CP
-        isec1(6)=143         ! indicatorOfParameter
-      elseif ((parCat.eq.0).and.(parNum.eq.11).and.(sfctyp.eq.1)) then ! SHF
-        isec1(6)=146         ! indicatorOfParameter
-      elseif ((parCat.eq.4).and.(parNum.eq.9).and.(sfctyp.eq.1)) then ! SR
-        isec1(6)=176         ! indicatorOfParameter
-      elseif ((parCat.eq.2).and.(parNum.eq.17) .or. parId .eq. 180) then ! EWSS
-        isec1(6)=180         ! indicatorOfParameter
-      elseif ((parCat.eq.2).and.(parNum.eq.18) .or. parId .eq. 181) then ! NSSS
-        isec1(6)=181         ! indicatorOfParameter
-      elseif ((parCat.eq.3).and.(parNum.eq.4)) then ! ORO
-        isec1(6)=129         ! indicatorOfParameter
-      elseif ((parCat.eq.3).and.(parNum.eq.7) .or. parId .eq. 160) then ! SDO
-        isec1(6)=160         ! indicatorOfParameter
-      elseif ((discipl.eq.2).and.(parCat.eq.0).and.(parNum.eq.0).and. &
-           (sfctyp.eq.1)) then ! LSM
-        isec1(6)=172         ! indicatorOfParameter
-      else
-        print*,'***ERROR: undefined GRiB2 message found!',discipl, &
-             parCat,parNum,sfctyp
-      endif
-      if(parId .ne. isec1(6) .and. parId .ne. 77) then
-        write(*,*) 'parId',parId, 'isec1(6)',isec1(6)
-        !    stop
-      endif
-
-    endif
-
-    call grib_get_int(igrib,'numberOfPointsAlongAParallel', &
-         isec2(2),iret)
-    ! ! nx=isec2(2)
-    ! ! WRITE(*,*) nx,nxmax
-    ! if (isec2(2).gt.nxmax) then
-    !   WRITE(*,*) 'FLEXPART error: Too many grid points in x direction.'
-    !   WRITE(*,*) 'Reduce resolution of wind fields.'
-    !   WRITE(*,*) 'Or change parameter settings in file ecmwf_mod.'
-    !   WRITE(*,*) isec2(2),nxmax
-    ! !    STOP
-    ! endif
-
-    !get the size and data of the values array
-    if (isec1(6).ne.-1) then
-      call grib_get_real4_array(igrib,'values',zsec4,iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-    endif
-
-    if (ifield.eq.1) then
-
-      !HSO  get the required fields from section 2 in a gribex compatible manner
-      call grib_get_int(igrib,'numberOfPointsAlongAParallel', &
-           isec2(2),iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-      call grib_get_int(igrib,'numberOfPointsAlongAMeridian', &
-           isec2(3),iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-      call grib_get_real8(igrib,'longitudeOfFirstGridPointInDegrees', &
-           xaux1in,iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-      call grib_get_int(igrib,'numberOfVerticalCoordinateValues', &
-           isec2(12),iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-
-      nxfield=isec2(2)
-      ny=isec2(3)
-      nlev_ec=isec2(12)/2-1
-
-      !  get the size and data of the vertical coordinate array
-      call grib_get_real4_array(igrib,'pv',zsec2,iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-    endif
-
-    !HSO  get the second part of the grid dimensions only from GRiB1 messages
-    if (isec1(6) .eq. 167 .and. (gotGrid.eq.0)) then
-      call grib_get_real8(igrib,'longitudeOfLastGridPointInDegrees', &
-           xaux2in,iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-      call grib_get_real8(igrib,'latitudeOfLastGridPointInDegrees', &
-           yaux1in,iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-      call grib_get_real8(igrib,'latitudeOfFirstGridPointInDegrees', &
-           yaux2in,iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-      xaux1=xaux1in
-      xaux2=xaux2in
-      yaux1=yaux1in
-      yaux2=yaux2in
-      if (xaux1.gt.180.) xaux1=xaux1-360.0
-      if (xaux2.gt.180.) xaux2=xaux2-360.0
-      if (xaux1.lt.-180.) xaux1=xaux1+360.0
-      if (xaux2.lt.-180.) xaux2=xaux2+360.0
-      if (xaux2.lt.xaux1) xaux2=xaux2+360.0
-      xlon0=xaux1
-      ylat0=yaux1
-      dx=(xaux2-xaux1)/real(nxfield-1)
-      dy=(yaux2-yaux1)/real(ny-1)
-      dxconst=180./(dx*r_earth*pi)
-      dyconst=180./(dy*r_earth*pi)
-      gotGrid=1
-      ! Check whether fields are global
-      ! If they contain the poles, specify polar stereographic map
-      ! projections using the stlmbr- and stcm2p-calls
-      !***********************************************************
-
-      xauxa=abs(xaux2+dx-360.-xaux1)
-      if (xauxa.lt.0.001) then
-        nx=nxfield+1                 ! field is cyclic
-        xglobal=.true.
-        if (abs(nxshift).ge.nx) &
-             stop 'nxshift in file par_mod is too large'
-        xlon0=xlon0+real(nxshift)*dx
-      else
-        nx=nxfield
-        xglobal=.false.
-        if (nxshift.ne.0) &
-             stop 'nxshift (par_mod) must be zero for non-global domain'
-      endif
-      nxmin1=nx-1
-      nymin1=ny-1
-      if (xlon0.gt.180.) xlon0=xlon0-360.
-      xauxa=abs(yaux1+90.)
-      if (xglobal.and.xauxa.lt.0.001) then
-        sglobal=.true.               ! field contains south pole
-        ! Enhance the map scale by factor 3 (*2=6) compared to north-south
-        ! map scale
-        sizesouth=6.*(switchsouth+90.)/dy
-        call stlmbr(southpolemap,-90.,0.)
-        call stcm2p(southpolemap,0.,0.,switchsouth,0.,sizesouth, &
-             sizesouth,switchsouth,180.)
-        switchsouthg=(switchsouth-ylat0)/dy
-      else
-        sglobal=.false.
-        switchsouthg=999999.
-      endif
-      xauxa=abs(yaux2-90.)
-      if (xglobal.and.xauxa.lt.0.001) then
-        nglobal=.true.               ! field contains north pole
-        ! Enhance the map scale by factor 3 (*2=6) compared to north-south
-        ! map scale
-        sizenorth=6.*(90.-switchnorth)/dy
-        call stlmbr(northpolemap,90.,0.)
-        call stcm2p(northpolemap,0.,0.,switchnorth,0.,sizenorth, &
-             sizenorth,switchnorth,180.)
-        switchnorthg=(switchnorth-ylat0)/dy
-      else
-        nglobal=.false.
-        switchnorthg=999999.
-      endif
-      if (nxshift.lt.0) &
-           stop 'nxshift (par_mod) must not be negative'
-      if (nxshift.ge.nxfield) stop 'nxshift (par_mod) too large'
-    endif ! gotGrid
-
-    if (nx.gt.nxmax) then
-      write(*,*) 'FLEXPART error: Too many grid points in x direction.'
-      write(*,*) 'Reduce resolution of wind fields.'
-      write(*,*) 'Or change parameter settings in file par_mod.'
-      write(*,*) nx,nxmax
-      stop
-    endif
-
-    if (ny.gt.nymax) then
-      write(*,*) 'FLEXPART error: Too many grid points in y direction.'
-      write(*,*) 'Reduce resolution of wind fields.'
-      write(*,*) 'Or change parameter settings in file par_mod.'
-      write(*,*) ny,nymax
-      stop
-    endif
-
-    k=isec1(8)
-    if(isec1(6).eq.131) iumax=max(iumax,nlev_ec-k+1)
-    if(isec1(6).eq.135) iwmax=max(iwmax,nlev_ec-k+1)
-
-    if (isec1(6) .eq. 167) then
-      ! ! Assing grid values and allocate memory to read windfields
-      ! nxmax=nxfield
-      ! if (xglobal) then
-      !   nxmax=nxfield+1
-      ! endif
-      ! nymax=ny
-      ! nwzmax=iwmax+1
-      ! nuvzmax=iumax+1
-      ! nzmax=nuvzmax
-      ! nconvlevmax=iumax
-      ! na=nuvzmax
-      ! ! Temporary nxmax and nymax
-      call fixedfields_alloc
-    endif
-
-    if(isec1(6).eq.129) then
-      do jy=0,ny-1
-        do ix=0,nxfield-1
-          oro(ix,jy)=zsec4(nxfield*(ny-jy-1)+ix+1)/ga
-        end do
-      end do
-    endif
-    if(isec1(6).eq.172) then
-      do jy=0,ny-1
-        do ix=0,nxfield-1
-          lsm(ix,jy)=zsec4(nxfield*(ny-jy-1)+ix+1)
-        end do
-      end do
-    endif
-    if(isec1(6).eq.160) then
-      do jy=0,ny-1
-        do ix=0,nxfield-1
-          excessoro(ix,jy)=zsec4(nxfield*(ny-jy-1)+ix+1)
-        end do
-      end do
-    endif
-
-    call grib_release(igrib)
-  end do                      !! READ NEXT LEVEL OR PARAMETER
-  !
-  ! CLOSING OF INPUT DATA FILE
-  !
-  call grib_close_file(ifile)
-
-  ! call alloc_windf
-
-  !error message if no fields found with correct first longitude in it
-  if (gotGrid.eq.0) then
-    print*,'***ERROR: input file needs to contain GRiB1 formatted'// &
-         'messages'
-    stop
-  endif
-
-  nuvz=iumax
-  nwz =iwmax
-  if(nuvz.eq.nlev_ec) nwz=nlev_ec+1
-
-  ! if (nuvz+1.gt.nuvzmax) then
-  !   write(*,*) 'FLEXPART error: Too many u,v grid points in z '// &
-  !        'direction.'
-  !   write(*,*) 'Reduce resolution of wind fields.'
-  !   write(*,*) 'Or change parameter settings in file par_mod.'
-  !   write(*,*) nuvz+1,nuvzmax
-  !   stop
-  ! endif
-
-  ! if (nwz.gt.nwzmax) then
-  !   write(*,*) 'FLEXPART error: Too many w grid points in z '// &
-  !        'direction.'
-  !   write(*,*) 'Reduce resolution of wind fields.'
-  !   write(*,*) 'Or change parameter settings in file par_mod.'
-  !   write(*,*) nwz,nwzmax
-  !   stop
-  ! endif
-
-  ! If desired, shift all grids by nxshift grid cells
-  !**************************************************
-
-  if (xglobal) then
-    call shift_field_0(oro,nxfield,ny)
-    call shift_field_0(lsm,nxfield,ny)
-    call shift_field_0(excessoro,nxfield,ny)
-  endif
-
-  ! Output of grid info
-  !********************
-
-  if (lroot) then
-    write(*,'(a,2i7)') ' Vertical levels in ECMWF data: ', &
-         nuvz+1,nwz
-    write(*,*)
-    write(*,'(a)') ' Mother domain:'
-    write(*,'(a,f10.5,a,f10.5,a,f10.5)') '  Longitude range: ', &
-         xlon0,' to ',xlon0+(nx-1)*dx,'   Grid distance: ',dx
-    write(*,'(a,f10.5,a,f10.5,a,f10.5)') '  Latitude range : ', &
-         ylat0,' to ',ylat0+(ny-1)*dy,'   Grid distance: ',dy
-    write(*,*)
-  end if
-
-  ! CALCULATE VERTICAL DISCRETIZATION OF ECMWF MODEL
-  ! PARAMETER akm,bkm DESCRIBE THE HYBRID "ETA" COORDINATE SYSTEM
-
-  numskip=nlev_ec-nuvz  ! number of ecmwf model layers not used
-  ! by trajectory model
-  !do 8940 i=1,244
-  !   write (*,*) 'zsec2:',i,ifield,zsec2(i),numskip
-  !940  continue
-  !   stop
-  ! SEC SEC SEC
-  ! for unknown reason zsec 1 to 10 is filled in this version
-  ! compared to the old one
-  ! SEC SEC SE
-  do i=1,nwz
-    j=numskip+i
-    k=nlev_ec+1+numskip+i
-    akm(nwz-i+1)=zsec2(j)
-    !   write (*,*) 'ifield:',ifield,k,j,zsec2(10+j)
-    bkm(nwz-i+1)=zsec2(k)
-    wheight(nwz-i+1)=akm(nwz-i+1)/101325.+bkm(nwz-i+1) ! From FLEXTRA
-  end do
-
-  !
-  ! CALCULATION OF AKZ, BKZ
-  ! AKZ,BKZ: model discretization parameters at the center of each model
-  !     layer
-  !
-  ! Assign the 10 m winds to an artificial model level with akz=0 and bkz=1.0,
-  ! i.e. ground level
-  !*****************************************************************************
-
-  akz(1)=0.
-  bkz(1)=1.0
-  uvheight(1)=1.
-  do i=1,nuvz
-    uvheight(i+1)=0.5*(wheight(i+1)+wheight(i)) ! From FLEXTRA
-    akz(i+1)=0.5*(akm(i+1)+akm(i))
-    bkz(i+1)=0.5*(bkm(i+1)+bkm(i))
-  end do
-  ! exuvheight=wheight
-  nuvz=nuvz+1
-
-  ! NOTE: In FLEXPART versions up to 4.0, the number of model levels was doubled
-  ! upon the transformation to z levels. In order to save computer memory, this is
-  ! not done anymore in the standard version. However, this option can still be
-  ! switched on by replacing the following lines with those below, that are
-  ! currently commented out. For this, similar changes are necessary in
-  ! verttransform.f and verttranform_nest.f
-  !*****************************************************************************
-
-  nz=nuvz
-  if (nz.gt.nzmax) stop 'nzmax too small'
-  do i=1,nuvz
-    aknew(i)=akz(i)
-    bknew(i)=bkz(i)
-  end do
-
-  ! Switch on following lines to use doubled vertical resolution
-  !*************************************************************
-  !nz=nuvz+nwz-1
-  !if (nz.gt.nzmax) stop 'nzmax too small'
-  !do 100 i=1,nwz
-  !  aknew(2*(i-1)+1)=akm(i)
-  !00     bknew(2*(i-1)+1)=bkm(i)
-  !do 110 i=2,nuvz
-  !  aknew(2*(i-1))=akz(i)
-  !10     bknew(2*(i-1))=bkz(i)
-  ! End doubled vertical resolution
-  return
-
-999 write(*,*)
-  write(*,*) ' ###########################################'// &
-       '###### '
-  write(*,*) '       TRAJECTORY MODEL SUBROUTINE GRIDCHECK:'
-  write(*,*) ' CAN NOT OPEN INPUT DATA FILE '//wfname(ifn)
-  write(*,*) ' ###########################################'// &
-       '###### '
-  write(*,*)
-  write(*,'(a)') '!!! PLEASE INSERT A NEW CD-ROM AND   !!!'
-  write(*,'(a)') '!!! PRESS ANY KEY TO CONTINUE...     !!!'
-  write(*,'(a)') '!!! ...OR TERMINATE FLEXPART PRESSING!!!'
-  write(*,'(a)') '!!! THE "X" KEY...                   !!!'
-  write(*,*)
-  read(*,'(a)') opt
-  if(opt.eq.'X') then
-    stop
-  else
-    goto 5
-  endif
-end subroutine gridcheck_ecmwf
-
-subroutine gridcheck_gfs
-
-  !**********************************************************************
-  !                                                                     *
-  !             FLEXPART MODEL SUBROUTINE GRIDCHECK                     *
-  !                                                                     *
-  !**********************************************************************
-  !                                                                     *
-  !             AUTHOR:      G. WOTAWA                                  *
-  !             DATE:        1997-08-06                                 *
-  !             LAST UPDATE: 1997-10-10                                 *
-  !                                                                     *
-  !             Update:      1999-02-08, global fields allowed, A. Stohl*
-  !             CHANGE: 17/11/2005, Caroline Forster, GFS data          *
-  !             CHANGE: 11/01/2008, Harald Sodemann, GRIB1/2 input with *
-  !                                 ECMWF grib_api                      *
-  !             CHANGE: 03/12/2008, Harald Sodemann, update to f90 with *
-  !                                 ECMWF grib_api                      *
-  !                                                                     *
-  !   Unified ECMWF and GFS builds                                      *
-  !   Marian Harustak, 12.5.2017                                        *
-  !     - Renamed routine from gridcheck to gridcheck_gfs               *
-  !                                                                     *
-  !**********************************************************************
-  !                                                                     *
-  ! DESCRIPTION:                                                        *
-  !                                                                     *
-  ! THIS SUBROUTINE DETERMINES THE GRID SPECIFICATIONS (LOWER LEFT      *
-  ! LONGITUDE, LOWER LEFT LATITUDE, NUMBER OF GRID POINTS, GRID DIST-   *
-  ! ANCE AND VERTICAL DISCRETIZATION OF THE ECMWF MODEL) FROM THE       *
-  ! GRIB HEADER OF THE FIRST INPUT FILE. THE CONSISTANCY (NO CHANGES    *
-  ! WITHIN ONE FLEXPART RUN) IS CHECKED IN THE ROUTINE "READWIND" AT    *
-  ! ANY CALL.                                                           *
-  !                                                                     *
-  ! XLON0                geographical longitude of lower left gridpoint *
-  ! YLAT0                geographical latitude of lower left gridpoint  *
-  ! NX                   number of grid points x-direction              *
-  ! NY                   number of grid points y-direction              *
-  ! DX                   grid distance x-direction                      *
-  ! DY                   grid distance y-direction                      *
-  ! NUVZ                 number of grid points for horizontal wind      *
-  !                      components in z direction                      *
-  ! NWZ                  number of grid points for vertical wind        *
-  !                      component in z direction                       *
-  ! sizesouth, sizenorth give the map scale (i.e. number of virtual grid*
-  !                      points of the polar stereographic grid):       *
-  !                      used to check the CFL criterion                *
-  ! UVHEIGHT(1)-         heights of gridpoints where u and v are        *
-  ! UVHEIGHT(NUVZ)       given                                          *
-  ! WHEIGHT(1)-          heights of gridpoints where w is given         *
-  ! WHEIGHT(NWZ)                                                        *
-  !                                                                     *
-  !**********************************************************************
-
-  use grib_api
-  use cmapf_mod, only: stlmbr,stcm2p
-
-  implicit none
-
-  !HSO  parameters for grib_api
-  integer :: ifile
-  integer :: iret
-  integer :: igrib
-  real(kind=4) :: xaux1,xaux2,yaux1,yaux2
-  real(kind=8) :: xaux1in,xaux2in,yaux1in,yaux2in
-  integer :: gribVer,parCat,parNum,sfctyp,ivalsfc,discipl
-  !HSO  end
-  integer :: ix,jy,i,ifn,ifield,j,k,iumax,iwmax,numskip
-  real :: sizesouth,sizenorth,xauxa,pint
-  real :: akm_usort(nwzmax)
-  real,parameter :: eps=0.0001
-
-  ! NCEP GFS
-  real :: pres(nwzmax), help
-
-  integer :: i179,i180,i181
-
-  ! VARIABLES AND ARRAYS NEEDED FOR GRIB DECODING
-
-  integer :: isec1(8),isec2(3)
-  real(kind=4) :: zsec4(jpunp)
-  character(len=1) :: opt
-
-  !HSO  grib api error messages
-  character(len=24) :: gribErrorMsg = 'Error reading grib file'
-  character(len=20) :: gribFunction = 'gridcheckwind_gfs'
-  !
-  if (numbnests.ge.1) then
-  write(*,*) ' ###########################################'
-  write(*,*) ' FLEXPART ERROR SUBROUTINE GRIDCHECK:'
-  write(*,*) ' NO NESTED WINDFIELDAS ALLOWED FOR GFS!      '
-  write(*,*) ' ###########################################'
-  stop
-  endif
-
-  iumax=0
-  iwmax=0
-
-  if(ideltas.gt.0) then
-    ifn=1
-  else
-    ifn=numbwf
-  endif
-  !
-  ! OPENING OF DATA FILE (GRIB CODE)
-  !
-5   call grib_open_file(ifile,path(3)(1:length(3)) &
-         //trim(wfname(ifn)),'r',iret)
-  if (iret.ne.GRIB_SUCCESS) then
-    goto 999   ! ERROR DETECTED
-  endif
-  !turn on support for multi fields messages
-  call grib_multi_support_on
-
-  ifield=0
-  do
-    ifield=ifield+1
-    !
-    ! GET NEXT FIELDS
-    !
-    call grib_new_from_file(ifile,igrib,iret)
-    if (iret.eq.GRIB_END_OF_FILE )  then
-      exit    ! EOF DETECTED
-    elseif (iret.ne.GRIB_SUCCESS) then
-      goto 999   ! ERROR DETECTED
-    endif
-
-    !first see if we read GRIB1 or GRIB2
-    call grib_get_int(igrib,'editionNumber',gribVer,iret)
-    call grib_check(iret,gribFunction,gribErrorMsg)
-
-    if (gribVer.eq.1) then ! GRIB Edition 1
-
-      !read the grib1 identifiers
-      call grib_get_int(igrib,'indicatorOfParameter',isec1(6),iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-      call grib_get_int(igrib,'indicatorOfTypeOfLevel',isec1(7),iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-      call grib_get_int(igrib,'level',isec1(8),iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-
-      !get the size and data of the values array
-      call grib_get_real4_array(igrib,'values',zsec4,iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-
-      else ! GRIB Edition 2
-
-      !read the grib2 identifiers
-      call grib_get_int(igrib,'discipline',discipl,iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-      call grib_get_int(igrib,'parameterCategory',parCat,iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-      call grib_get_int(igrib,'parameterNumber',parNum,iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-      call grib_get_int(igrib,'typeOfFirstFixedSurface',sfctyp,iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-      call grib_get_int(igrib,'scaledValueOfFirstFixedSurface', &
-           ivalsfc,iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-
-      !convert to grib1 identifiers
-      isec1(6)=-1
-      isec1(7)=-1
-      isec1(8)=-1
-      if ((parCat.eq.2).and.(parNum.eq.2).and.(sfctyp.eq.100)) then ! U
-        isec1(6)=33          ! indicatorOfParameter
-        isec1(7)=100         ! indicatorOfTypeOfLevel
-        isec1(8)=ivalsfc/100 ! level, convert to hPa
-      elseif ((parCat.eq.3).and.(parNum.eq.5).and.(sfctyp.eq.1)) then ! TOPO
-        isec1(6)=7           ! indicatorOfParameter
-        isec1(7)=1           ! indicatorOfTypeOfLevel
-        isec1(8)=0
-      elseif ((parCat.eq.0).and.(parNum.eq.0).and.(sfctyp.eq.1) &
-           .and.(discipl.eq.2)) then ! LSM
-        isec1(6)=81          ! indicatorOfParameter
-        isec1(7)=1           ! indicatorOfTypeOfLevel
-        isec1(8)=0
-      endif
-
-      if (isec1(6).ne.-1) then
-      !  get the size and data of the values array
-        call grib_get_real4_array(igrib,'values',zsec4,iret)
-        call grib_check(iret,gribFunction,gribErrorMsg)
-      endif
-
-    endif ! gribVer
-
-    if(ifield.eq.1) then
-
-      !get the required fields from section 2
-      !store compatible to gribex input
-      call grib_get_int(igrib,'numberOfPointsAlongAParallel', &
-           isec2(2),iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-      call grib_get_int(igrib,'numberOfPointsAlongAMeridian', &
-           isec2(3),iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-      call grib_get_real8(igrib,'longitudeOfFirstGridPointInDegrees', &
-           xaux1in,iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-      call grib_get_real8(igrib,'longitudeOfLastGridPointInDegrees', &
-           xaux2in,iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-      call grib_get_real8(igrib,'latitudeOfLastGridPointInDegrees', &
-           yaux1in,iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-      call grib_get_real8(igrib,'latitudeOfFirstGridPointInDegrees', &
-           yaux2in,iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-
-      ! Fix for flexpart.eu ticket #48
-      if (xaux2in.lt.0) xaux2in = 359.0
-
-      xaux1=xaux1in
-      xaux2=xaux2in
-      yaux1=yaux1in
-      yaux2=yaux2in
-
-      nxfield=isec2(2)
-      ny=isec2(3)
-      if((abs(xaux1).lt.eps).and.(xaux2.ge.359)) then ! NCEP DATA FROM 0 TO
-        xaux1=-179.0                             ! 359 DEG EAST ->
-        xaux2=-179.0+360.-360./real(nxfield)    ! TRANSFORMED TO -179
-      endif                                      ! TO 180 DEG EAST
-      if (xaux1.gt.180) xaux1=xaux1-360.0
-      if (xaux2.gt.180) xaux2=xaux2-360.0
-      if (xaux1.lt.-180) xaux1=xaux1+360.0
-      if (xaux2.lt.-180) xaux2=xaux2+360.0
-      if (xaux2.lt.xaux1) xaux2=xaux2+360.
-      xlon0=xaux1
-      ylat0=yaux1
-      dx=(xaux2-xaux1)/real(nxfield-1)
-      dy=(yaux2-yaux1)/real(ny-1)
-      dxconst=180./(dx*r_earth*pi)
-      dyconst=180./(dy*r_earth*pi)
-      !HSO end edits
-
-
-      ! Check whether fields are global
-      ! If they contain the poles, specify polar stereographic map
-      ! projections using the stlmbr- and stcm2p-calls
-      !***********************************************************
-
-      xauxa=abs(xaux2+dx-360.-xaux1)
-      if (xauxa.lt.0.001) then
-        nx=nxfield+1                 ! field is cyclic
-        xglobal=.true.
-        if (abs(nxshift).ge.nx) &
-             stop 'nxshift in file par_mod is too large'
-        xlon0=xlon0+real(nxshift)*dx
-      else
-        nx=nxfield
-        xglobal=.false.
-        if (nxshift.ne.0) &
-             stop 'nxshift (par_mod) must be zero for non-global domain'
-      endif
-      nxmin1=nx-1
-      nymin1=ny-1
-      if (xlon0.gt.180.) xlon0=xlon0-360.
-      xauxa=abs(yaux1+90.)
-      if (xglobal.and.xauxa.lt.0.001) then
-        sglobal=.true.               ! field contains south pole
-    ! Enhance the map scale by factor 3 (*2=6) compared to north-south
-    ! map scale
-        sizesouth=6.*(switchsouth+90.)/dy
-        call stlmbr(southpolemap,-90.,0.)
-        call stcm2p(southpolemap,0.,0.,switchsouth,0.,sizesouth, &
-             sizesouth,switchsouth,180.)
-        switchsouthg=(switchsouth-ylat0)/dy
-      else
-        sglobal=.false.
-        switchsouthg=999999.
-      endif
-      xauxa=abs(yaux2-90.)
-      if (xglobal.and.xauxa.lt.0.001) then
-        nglobal=.true.               ! field contains north pole
-    ! Enhance the map scale by factor 3 (*2=6) compared to north-south
-    ! map scale
-        sizenorth=6.*(90.-switchnorth)/dy
-        call stlmbr(northpolemap,90.,0.)
-        call stcm2p(northpolemap,0.,0.,switchnorth,0.,sizenorth, &
-             sizenorth,switchnorth,180.)
-        switchnorthg=(switchnorth-ylat0)/dy
-      else
-        nglobal=.false.
-        switchnorthg=999999.
-      endif
-    endif ! ifield.eq.1
-
-    if (nxshift.lt.0) stop 'nxshift (par_mod) must not be negative'
-    if (nxshift.ge.nxfield) stop 'nxshift (par_mod) too large'
-
-    ! NCEP ISOBARIC LEVELS
-    !*********************
-
-    if((isec1(6).eq.33).and.(isec1(7).eq.100)) then ! check for U wind
-      iumax=iumax+1
-      pres(iumax)=real(isec1(8))*100.0
-    endif
-
-
-    i179=nint(179./dx)
-    if (dx.lt.0.7) then
-      i180=nint(180./dx)+1    ! 0.5 deg data
-    else
-      i180=nint(179./dx)+1    ! 1 deg data
-    endif
-    i181=i180+1
-
-
-    ! NCEP TERRAIN
-    !*************
-
-    if (isec1(6).eq.007 .and. isec1(7).eq.001) then
-    ! IP 2023-05-09: allocate fields missing for GFS reading 
-      call fixedfields_alloc
-      do jy=0,ny-1
-        do ix=0,nxfield-1
-          help=zsec4(nxfield*(ny-jy-1)+ix+1)
-          if(ix.le.i180) then
-            oro(i179+ix,jy)=help
-            excessoro(i179+ix,jy)=0.0 ! ISOBARIC SURFACES: SUBGRID TERRAIN DISREGARDED
-          else
-            oro(ix-i181,jy)=help
-            excessoro(ix-i181,jy)=0.0 ! ISOBARIC SURFACES: SUBGRID TERRAIN DISREGARDED
-          endif
-        end do
-      end do
-    endif
-
-    ! NCEP LAND SEA MASK
-    !*******************
-
-    if((isec1(6).eq.081).and.(isec1(7).eq.001)) then
-      do jy=0,ny-1
-        do ix=0,nxfield-1
-          help=zsec4(nxfield*(ny-jy-1)+ix+1)
-          if(ix.le.i180) then
-            lsm(i179+ix,jy)=help
-          else
-            lsm(ix-i181,jy)=help
-          endif
-        end do
-      end do
-    endif
-
-    call grib_release(igrib)
-
-  end do                      !! READ NEXT LEVEL OR PARAMETER
-  !
-  ! CLOSING OF INPUT DATA FILE
-  !
-
-  ! HSO
-  call grib_close_file(ifile)
-  ! HSO end edits
-
-  nuvz=iumax
-  nwz =iumax
-  nlev_ec=iumax
-
-  ! ! Assing grid values and allocate memory to read windfields
-  ! nxmax=nx
-  ! nymax=ny
-  ! nwzmax=nwz
-  ! nuvzmax=nuvz
-  ! nzmax=nuvz
-  ! ! nconvlevmax=nuvzmax-1
-  ! ! na=nconvlevmax+1
-
-  ! call alloc_windf
-
-  if (nx.gt.nxmax) then
-   write(*,*) 'FLEXPART error: Too many grid points in x direction.'
-    write(*,*) 'Reduce resolution of wind fields.'
-    write(*,*) 'Or change parameter settings in file par_mod.'
-    write(*,*) nx,nxmax
-    stop
-  endif
-
-  if (ny.gt.nymax) then
-   write(*,*) 'FLEXPART error: Too many grid points in y direction.'
-    write(*,*) 'Reduce resolution of wind fields.'
-    write(*,*) 'Or change parameter settings in file par_mod.'
-    write(*,*) ny,nymax
-    stop
-  endif
-
-  if (nuvz.gt.nuvzmax) then
-    write(*,*) 'FLEXPART error: Too many u,v grid points in z '// &
-         'direction.'
-    write(*,*) 'Reduce resolution of wind fields.'
-    write(*,*) 'Or change parameter settings in file par_mod.'
-    write(*,*) nuvz,nuvzmax
-    stop
-  endif
-
-  if (nwz.gt.nwzmax) then
-    write(*,*) 'FLEXPART error: Too many w grid points in z '// &
-         'direction.'
-    write(*,*) 'Reduce resolution of wind fields.'
-    write(*,*) 'Or change parameter settings in file par_mod.'
-    write(*,*) nwz,nwzmax
-    stop
-  endif
-
-  ! If desired, shift all grids by nxshift grid cells
-  !**************************************************
-
-  if (xglobal) then
-    call shift_field_0(oro,nxfield,ny)
-    call shift_field_0(lsm,nxfield,ny)
-    call shift_field_0(excessoro,nxfield,ny)
-  endif
-
-  ! Output of grid info
-  !********************
-
-  if (lroot) then
-    write(*,*)
-    write(*,*)
-    write(*,'(a,2i7)') 'Vertical levels in NCEP data: ', &
-         nuvz,nwz
-    write(*,*)
-    write(*,'(a)') 'Mother domain:'
-    write(*,'(a,f10.2,a1,f10.2,a,f10.2)') '  Longitude range: ', &
-         xlon0,' to ',xlon0+(nx-1)*dx,'   Grid distance: ',dx
-    write(*,'(a,f10.2,a1,f10.2,a,f10.2)') '  Latitude range : ', &
-         ylat0,' to ',ylat0+(ny-1)*dy,'   Grid distance: ',dy
-    write(*,*)
-  end if
-
-  ! CALCULATE VERTICAL DISCRETIZATION OF ECMWF MODEL
-  ! PARAMETER akm,bkm DESCRIBE THE HYBRID "ETA" COORDINATE SYSTEM
-
-  numskip=nlev_ec-nuvz  ! number of ecmwf model layers not used
-                        ! by trajectory model
-  do i=1,nwz
-    j=numskip+i
-    k=nlev_ec+1+numskip+i
-    akm_usort(nwz-i+1)=pres(nwz-i+1)
-    bkm(nwz-i+1)=0.0
-  end do
-
-  !******************************
-  ! change Sabine Eckhardt: akm should always be in descending order ... readwind adapted!
-  !******************************
-      do i=1,nwz
-         if (akm_usort(1).gt.akm_usort(2)) then
-            akm(i)=akm_usort(i)
-         else
-            akm(i)=akm_usort(nwz-i+1)
-         endif
-      end do
-
-  !
-  ! CALCULATION OF AKZ, BKZ
-  ! AKZ,BKZ: model discretization parameters at the center of each model
-  !     layer
-  !
-  ! Assign the 10 m winds to an artificial model level with akz=0 and bkz=1.0,
-  ! i.e. ground level
-  !*****************************************************************************
-
-  do i=1,nuvz
-     akz(i)=akm(i)
-     bkz(i)=bkm(i)
-  end do
-
-  ! NOTE: In FLEXPART versions up to 4.0, the number of model levels was doubled
-  ! upon the transformation to z levels. In order to save computer memory, this is
-  ! not done anymore in the standard version. However, this option can still be
-  ! switched on by replacing the following lines with those below, that are
-  ! currently commented out. For this, similar changes are necessary in
-  ! verttransform.f and verttranform_nest.f
-  !*****************************************************************************
-
-  nz=nuvz
-  if (nz.gt.nzmax) stop 'nzmax too small'
-  do i=1,nuvz
-    aknew(i)=akz(i)
-    bknew(i)=bkz(i)
-  end do
-
-  ! Switch on following lines to use doubled vertical resolution
-  !*************************************************************
-  !nz=nuvz+nwz-1
-  !if (nz.gt.nzmax) stop 'nzmax too small'
-  !do 100 i=1,nwz
-  !  aknew(2*(i-1)+1)=akm(i)
-  !00     bknew(2*(i-1)+1)=bkm(i)
-  !do 110 i=2,nuvz
-  !  aknew(2*(i-1))=akz(i)
-  !10     bknew(2*(i-1))=bkz(i)
-  ! End doubled vertical resolution
-  return
-
-999   write(*,*)
-  write(*,*) ' ###########################################'// &
-       '###### '
-  write(*,*) '       TRAJECTORY MODEL SUBROUTINE GRIDCHECK:'
-  write(*,*) ' CAN NOT OPEN INPUT DATA FILE '//wfname(ifn)
-  write(*,*) ' ###########################################'// &
-       '###### '
-  write(*,*)
-  write(*,'(a)') '!!! PLEASE INSERT A NEW CD-ROM AND   !!!'
-  write(*,'(a)') '!!! PRESS ANY KEY TO CONTINUE...     !!!'
-  write(*,'(a)') '!!! ...OR TERMINATE FLEXPART PRESSING!!!'
-  write(*,'(a)') '!!! THE "X" KEY...                   !!!'
-  write(*,*)
-  read(*,'(a)') opt
-  if(opt.eq.'X') then
-    stop
-  else
-    goto 5
-  endif
-
-end subroutine gridcheck_gfs
-
-subroutine gridcheck_nest
-
-  !*****************************************************************************
-  !                                                                            *
-  !     This routine checks the grid specification for the nested model        *
-  !     domains. It is similar to subroutine gridcheck, which checks the       *
-  !     mother domain.                                                         *
-  !                                                                            *
-  !     Authors: A. Stohl, G. Wotawa                                           *
-  !                                                                            *
-  !     8 February 1999                                                        *
-  !                                                                            *
-  !*****************************************************************************
-  !  CHANGE: 11/01/2008, Harald Sodemann, GRIB1/2 input with ECMWF grib_api    *
-  !  CHANGE: 03/12/2008, Harald Sodemann, change to f90 grib_api               *
-  !*****************************************************************************
-
-  use grib_api
-
-  implicit none
-
-  !HSO  parameters for grib_api
-  integer :: ifile
-  integer :: iret
-  integer :: igrib
-  integer :: gribVer,parCat,parNum,sfctyp,ivalsfc,discipl
-  integer :: parID !added by mc for making it consistent with new gridcheck.f90
-  integer :: gotGrib
-  !HSO  end
-  integer :: i,j,k,l,ifn,ifield,iumax,iwmax,numskip,nlev_ecn
-  integer :: nuvzn,nwzn
-  real :: akmn(nwzmax),bkmn(nwzmax),akzn(nuvzmax),bkzn(nuvzmax)
-  real(kind=4) :: xaux1,xaux2,yaux1,yaux2
-  real(kind=8) :: xaux1in,xaux2in,yaux1in,yaux2in
-  real :: conversion_factor !added by mc to make it consistent with new gridchek.f90
-
-  ! VARIABLES AND ARRAYS NEEDED FOR GRIB DECODING
-
-  ! dimension of isec2 at least (22+n), where n is the number of parallels or
-  ! meridians in a quasi-regular (reduced) Gaussian or lat/long grid
-
-  ! dimension of zsec2 at least (10+nn), where nn is the number of vertical
-  ! coordinate parameters
-
-  integer :: isec1(56),isec2(22+nxmaxn+nymaxn)
-  real(kind=4) :: zsec2(60+2*nuvzmax),zsec4(jpunp)
-
-  !HSO  grib api error messages
-  character(len=24) :: gribErrorMsg = 'Error reading grib file'
-  character(len=20) :: gribFunction = 'gridcheck_nest'
-
-  xresoln(0)=1.       ! resolution enhancement for mother grid
-  yresoln(0)=1.       ! resolution enhancement for mother grid
-
-  ! Loop about all nesting levels
-  !******************************
-
-  do l=1,numbnests
-
-    iumax=0
-    iwmax=0
-
-    if(ideltas.gt.0) then
-      ifn=1
-    else
-      ifn=numbwf
-    endif
-  !
-  ! OPENING OF DATA FILE (GRIB CODE)
-  !
-  ifile=0
-  igrib=0
-  iret=0
-
-5   call grib_open_file(ifile,path(numpath+2*(l-1)+1) &
-         (1:length(numpath+2*(l-1)+1))//trim(wfnamen(l,ifn)),'r',iret)
-  if (iret.ne.GRIB_SUCCESS) then
-    goto 999   ! ERROR DETECTED
-  endif
-  !turn on support for multi fields messages
-  !call grib_multi_support_on
-
-  gotGrib=0
-  ifield=0
-  do
-    ifield=ifield+1
-
-    !
-    ! GET NEXT FIELDS
-    !
-    call grib_new_from_file(ifile,igrib,iret)
-    if (iret.eq.GRIB_END_OF_FILE)  then
-      exit    ! EOF DETECTED
-    elseif (iret.ne.GRIB_SUCCESS) then
-      goto 999   ! ERROR DETECTED
-    endif
-
-    !first see if we read GRIB1 or GRIB2
-    call grib_get_int(igrib,'editionNumber',gribVer,iret)
-    call grib_check(iret,gribFunction,gribErrorMsg)
-
-    if (gribVer.eq.1) then ! GRIB Edition 1
-
-      !print*,'GRiB Edition 1'
-      !read the grib2 identifiers
-      call grib_get_int(igrib,'indicatorOfParameter',isec1(6),iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-      call grib_get_int(igrib,'level',isec1(8),iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-
-      !change code for etadot to code for omega
-      if (isec1(6).eq.77) then
-        isec1(6)=135
-      endif
-
-      !print*,isec1(6),isec1(8)
-
-    else
-
-      !print*,'GRiB Edition 2'
-      !read the grib2 identifiers
-      call grib_get_int(igrib,'discipline',discipl,iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-      call grib_get_int(igrib,'parameterCategory',parCat,iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-      call grib_get_int(igrib,'parameterNumber',parNum,iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-      call grib_get_int(igrib,'typeOfFirstFixedSurface',sfctyp,iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-      call grib_get_int(igrib,'level',ivalsfc,iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-      call grib_get_int(igrib,'paramId',parId,iret) !added by mc to make it consisitent with new grid_check.f90
-      call grib_check(iret,gribFunction,gribErrorMsg) !added by mc to make it consisitent with new  grid_check.f90
-
-      !print*,discipl,parCat,parNum,sfctyp,ivalsfc
-
-      !convert to grib1 identifiers
-      isec1(6)=-1
-      isec1(7)=-1
-      isec1(8)=-1
-      isec1(8)=ivalsfc     ! level
-      if ((parCat.eq.0).and.(parNum.eq.0).and.(sfctyp.eq.105)) then ! T
-        isec1(6)=130         ! indicatorOfParameter
-      elseif ((parCat.eq.2).and.(parNum.eq.2).and.(sfctyp.eq.105)) then ! U
-        isec1(6)=131         ! indicatorOfParameter
-      elseif ((parCat.eq.2).and.(parNum.eq.3).and.(sfctyp.eq.105)) then ! V
-        isec1(6)=132         ! indicatorOfParameter
-      elseif ((parCat.eq.1).and.(parNum.eq.0).and.(sfctyp.eq.105)) then ! Q
-        isec1(6)=133         ! indicatorOfParameter
-      elseif ((parCat.eq.1).and.(parNum.eq.83).and.(sfctyp.eq.105)) then ! clwc
-        isec1(6)=246         ! indicatorOfParameter
-      elseif ((parCat.eq.1).and.(parNum.eq.84).and.(sfctyp.eq.105)) then ! ciwc
-        isec1(6)=247         ! indicatorOfParameter
-      !ZHG end
-      ! ESO qc(=clwc+ciwc)
-      elseif ((parCat.eq.201).and.(parNum.eq.31).and.(sfctyp.eq.105)) then ! qc
-        isec1(6)=201031      ! indicatorOfParameter
-      elseif ((parCat.eq.3).and.(parNum.eq.0).and.(sfctyp.eq.1)) then !SP
-        isec1(6)=134         ! indicatorOfParameter
-      elseif ((parCat.eq.2).and.(parNum.eq.32)) then ! W, actually eta dot
-        isec1(6)=135         ! indicatorOfParameter
-      elseif ((parCat.eq.128).and.(parNum.eq.77)) then ! W, actually eta dot !added bymc to make it consistent with new gridcheck.f90
-        isec1(6)=135         ! indicatorOfParameter    !
-      elseif ((parCat.eq.3).and.(parNum.eq.0).and.(sfctyp.eq.101)) then !SLP
-        isec1(6)=151         ! indicatorOfParameter
-      elseif ((parCat.eq.2).and.(parNum.eq.2).and.(sfctyp.eq.103)) then ! 10U
-        isec1(6)=165         ! indicatorOfParameter
-      elseif ((parCat.eq.2).and.(parNum.eq.3).and.(sfctyp.eq.103)) then ! 10V
-        isec1(6)=166         ! indicatorOfParameter
-      elseif ((parCat.eq.0).and.(parNum.eq.0).and.(sfctyp.eq.103)) then ! 2T
-        isec1(6)=167         ! indicatorOfParameter
-      elseif ((parCat.eq.0).and.(parNum.eq.6).and.(sfctyp.eq.103)) then ! 2D
-        isec1(6)=168         ! indicatorOfParameter
-      elseif ((parCat.eq.1).and.(parNum.eq.11).and.(sfctyp.eq.1)) then ! SD
-        isec1(6)=141         ! indicatorOfParameter
-      elseif ((parCat.eq.6).and.(parNum.eq.1) .or. parId .eq. 164) then ! CC !added by mc to make it consistent with new gridchek.f90
-        isec1(6)=164         ! indicatorOfParameter
-      elseif ((parCat.eq.1).and.(parNum.eq.9) .or. parId .eq. 142) then ! LSP !added by mc to make it consistent with new gridchek.f90
-        isec1(6)=142         ! indicatorOfParameter
-      elseif ((parCat.eq.1).and.(parNum.eq.10)) then ! CP
-        isec1(6)=143         ! indicatorOfParameter
-      elseif ((parCat.eq.0).and.(parNum.eq.11).and.(sfctyp.eq.1)) then ! SHF
-        isec1(6)=146         ! indicatorOfParameter
-      elseif ((parCat.eq.4).and.(parNum.eq.9).and.(sfctyp.eq.1)) then ! SR
-        isec1(6)=176         ! indicatorOfParameter
-      elseif ((parCat.eq.2).and.(parNum.eq.17) .or. parId .eq. 180) then ! EWSS !added by mc to make it consistent with new gridchek.f90
-        isec1(6)=180         ! indicatorOfParameter
-      elseif ((parCat.eq.2).and.(parNum.eq.18) .or. parId .eq. 181) then ! NSSS !added by mc to make it consistent with new gridchek.f90
-        isec1(6)=181         ! indicatorOfParameter
-      elseif ((parCat.eq.3).and.(parNum.eq.4)) then ! ORO
-        isec1(6)=129         ! indicatorOfParameter
-      elseif ((parCat.eq.3).and.(parNum.eq.7) .or. parId .eq. 160) then ! SDO !added by mc to make it consistent with new gridchek.f90
-        isec1(6)=160         ! indicatorOfParameter
-      elseif ((discipl.eq.2).and.(parCat.eq.0).and.(parNum.eq.0).and. &
-           (sfctyp.eq.1)) then ! LSM
-        isec1(6)=172         ! indicatorOfParameter
-      else
-        print*,'***ERROR: undefined GRiB2 message found!',discipl, &
-             parCat,parNum,sfctyp
-      endif
-      if(parId .ne. isec1(6) .and. parId .ne. 77) then !added by mc to make it consistent with new gridchek.f90
-        write(*,*) 'parId',parId, 'isec1(6)',isec1(6)
-      !    stop
-      endif
-
-    endif
-
-    !get the size and data of the values array
-    if (isec1(6).ne.-1) then
-      call grib_get_real4_array(igrib,'values',zsec4,iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-    endif
-
-    !HSO  get the required fields from section 2 in a gribex compatible manner
-    if (ifield.eq.1) then
-      call grib_get_int(igrib,'numberOfPointsAlongAParallel', &
-           isec2(2),iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-      call grib_get_int(igrib,'numberOfPointsAlongAMeridian', &
-           isec2(3),iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-      call grib_get_int(igrib,'numberOfVerticalCoordinateValues', &
-           isec2(12),iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-    !HSO    get the size and data of the vertical coordinate array
-      call grib_get_real4_array(igrib,'pv',zsec2,iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-
-      nxn(l)=isec2(2)
-      nyn(l)=isec2(3)
-      nlev_ecn=isec2(12)/2-1
-    endif ! ifield
-
-    if (nxn(l).gt.nxmaxn) then
-      write(*,*) 'FLEXPART error: Too many grid points in x direction.'
-      write(*,*) 'Reduce resolution of wind fields (file GRIDSPEC)'
-      write(*,*) 'for nesting level ',l
-      write(*,*) 'Or change parameter settings in file par_mod.'
-      write(*,*) nxn(l),nxmaxn
-      stop
-    endif
-
-    if (nyn(l).gt.nymaxn) then
-      write(*,*) 'FLEXPART error: Too many grid points in y direction.'
-      write(*,*) 'Reduce resolution of wind fields (file GRIDSPEC)'
-      write(*,*) 'for nesting level ',l
-      write(*,*) 'Or change parameter settings in file par_mod.'
-      write(*,*) nyn(l),nymaxn
-      stop
-    endif
-
-    !HSO  get the second part of the grid dimensions only from GRiB1 messages
-    if (isec1(6) .eq. 167 .and. (gotGrib.eq.0)) then !added by mc to make it consistent with new gridchek.f90 note that gotGrid must be changed in gotGrib!!
-      call grib_get_real8(igrib,'longitudeOfFirstGridPointInDegrees', & !comment by mc: note that this was in the (if (ifield.eq.1) ..end above in gridchek.f90 see line 257
-           xaux1in,iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-      call grib_get_real8(igrib,'longitudeOfLastGridPointInDegrees', &
-           xaux2in,iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-      call grib_get_real8(igrib,'latitudeOfLastGridPointInDegrees', &
-           yaux1in,iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-      call grib_get_real8(igrib,'latitudeOfFirstGridPointInDegrees', &
-           yaux2in,iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-      xaux1=xaux1in
-      xaux2=xaux2in
-      yaux1=yaux1in
-      yaux2=yaux2in
-      if(xaux1.gt.180.) xaux1=xaux1-360.0
-      if(xaux2.gt.180.) xaux2=xaux2-360.0
-      if(xaux1.lt.-180.) xaux1=xaux1+360.0
-      if(xaux2.lt.-180.) xaux2=xaux2+360.0
-      if (xaux2.lt.xaux1) xaux2=xaux2+360.0
-      xlon0n(l)=xaux1
-      ylat0n(l)=yaux1
-      dxn(l)=(xaux2-xaux1)/real(nxn(l)-1)
-      dyn(l)=(yaux2-yaux1)/real(nyn(l)-1)
-      gotGrib=1 !commetn by mc note tahthere gotGRIB is used instead of gotGrid!!!
-    endif ! ifield.eq.1
-
-    k=isec1(8)
-    if(isec1(6).eq.131) iumax=max(iumax,nlev_ec-k+1)
-    if(isec1(6).eq.135) iwmax=max(iwmax,nlev_ec-k+1)
-
-    if(isec1(6).eq.129) then
-      do j=0,nyn(l)-1
-        do i=0,nxn(l)-1
-          oron(i,j,l)=zsec4(nxn(l)*(nyn(l)-j-1)+i+1)/ga
-        end do
-      end do
-    endif
-    if(isec1(6).eq.172) then
-      do j=0,nyn(l)-1
-        do i=0,nxn(l)-1
-          lsmn(i,j,l)=zsec4(nxn(l)*(nyn(l)-j-1)+i+1)/ga
-        end do
-      end do
-    endif
-    if(isec1(6).eq.160) then
-      do j=0,nyn(l)-1
-        do i=0,nxn(l)-1
-          excessoron(i,j,l)=zsec4(nxn(l)*(nyn(l)-j-1)+i+1)/ga
-        end do
-      end do
-    endif
-
-    call grib_release(igrib)
-  end do                 !! READ NEXT LEVEL OR PARAMETER
-  !
-  ! CLOSING OF INPUT DATA FILE
-  !
-
-  call grib_close_file(ifile)
-
-  !error message if no fields found with correct first longitude in it
-  if (gotGrib.eq.0) then
-    print*,'***ERROR: input file needs to contain GRiB1 formatted'// &
-         'messages'
-    stop
-  endif
-
-  nuvzn=iumax
-  nwzn=iwmax
-  if(nuvzn.eq.nlev_ec) nwzn=nlev_ecn+1
-
-  if ((nuvzn.gt.nuvzmax).or.(nwzn.gt.nwzmax)) then
-    write(*,*) 'FLEXPART error: Nested wind fields have too many'// &
-         'vertical levels.'
-    write(*,*) 'Problem was encountered for nesting level ',l
-    stop
-  endif
-
-
-  ! Output of grid info
-  !********************
-
-  write(*,'(a,i2,a)') ' Nested domain ',l,':'
-  write(*,'(a,f10.5,a,f10.5,a,f10.5)') '  Longitude range: ', &
-       xlon0n(l),' to ',xlon0n(l)+(nxn(l)-1)*dxn(l), &
-       '   Grid distance: ',dxn(l)
-  write(*,'(a,f10.5,a,f10.5,a,f10.5)') '  Latitude range : ', &
-       ylat0n(l),' to ',ylat0n(l)+(nyn(l)-1)*dyn(l), &
-       '   Grid distance: ',dyn(l)
-  write(*,*)
-
-  ! Determine, how much the resolutions in the nests are enhanced as
-  ! compared to the mother grid
-  !*****************************************************************
-
-  xresoln(l)=dx/dxn(l)
-  yresoln(l)=dy/dyn(l)
-
-  ! Determine the mother grid coordinates of the corner points of the
-  ! nested grids
-  ! Convert first to geographical coordinates, then to grid coordinates
-  !********************************************************************
-
-  xaux1=xlon0n(l)
-  xaux2=xlon0n(l)+real(nxn(l)-1)*dxn(l)
-  yaux1=ylat0n(l)
-  yaux2=ylat0n(l)+real(nyn(l)-1)*dyn(l)
-
-  xln(l)=(xaux1-xlon0)/dx
-  xrn(l)=(xaux2-xlon0)/dx
-  yln(l)=(yaux1-ylat0)/dy
-  yrn(l)=(yaux2-ylat0)/dy
-
-
-  if ((xln(l).lt.0.).or.(yln(l).lt.0.).or. &
-       (xrn(l).gt.real(nxmin1)).or.(yrn(l).gt.real(nymin1))) then
-    write(*,*) 'Nested domain does not fit into mother domain'
-    write(*,*) 'For global mother domain fields, you can shift'
-    write(*,*) 'shift the mother domain into x-direction'
-    write(*,*) 'by setting nxshift (file par_mod) to a'
-    write(*,*) 'positive value. Execution is terminated.'
-    stop
-  endif
-
-
-  ! CALCULATE VERTICAL DISCRETIZATION OF ECMWF MODEL
-  ! PARAMETER akm,bkm DESCRIBE THE HYBRID "ETA" COORDINATE SYSTEM
-
-  numskip=nlev_ecn-nuvzn ! number of ecmwf model layers not used by FLEXPART
-  do i=1,nwzn
-    j=numskip+i
-    k=nlev_ecn+1+numskip+i
-    akmn(nwzn-i+1)=zsec2(j)
-    bkmn(nwzn-i+1)=zsec2(k)
-  end do
-
-  !
-  ! CALCULATION OF AKZ, BKZ
-  ! AKZ,BKZ: model discretization parameters at the center of each model
-  !     layer
-  !
-  ! Assign the 10 m winds to an artificial model level with akz=0 and bkz=1.0,
-  ! i.e. ground level
-  !*****************************************************************************
-
-    akzn(1)=0.
-    bkzn(1)=1.0
-    do i=1,nuvzn
-      akzn(i+1)=0.5*(akmn(i+1)+akmn(i))
-      bkzn(i+1)=0.5*(bkmn(i+1)+bkmn(i))
-    end do
-    nuvzn=nuvzn+1
-
-  ! Check, whether the heights of the model levels of the nested
-  ! wind fields are consistent with those of the mother domain.
-  ! If not, terminate model run.
-  !*************************************************************
-
-    do i=1,nuvz
-      if ((akzn(i).ne.akz(i)).or.(bkzn(i).ne.bkz(i))) then
-  write(*,*) 'FLEXPART error: The wind fields of nesting level',l
-  write(*,*) 'are not consistent with the mother domain:'
-  write(*,*) 'Differences in vertical levels detected.'
-        stop
-      endif
-    end do
-
-    do i=1,nwz
-      if ((akmn(i).ne.akm(i)).or.(bkmn(i).ne.bkm(i))) then
-  write(*,*) 'FLEXPART error: The wind fields of nesting level',l
-  write(*,*) 'are not consistent with the mother domain:'
-  write(*,*) 'Differences in vertical levels detected.'
-        stop
-      endif
-    end do
-
-  end do
-
-  return
-
-999   write(*,*)
-  write(*,*) ' ###########################################'// &
-       '###### '
-  write(*,*) '                FLEXPART SUBROUTINE GRIDCHECK:'
-  write(*,*) ' CAN NOT OPEN INPUT DATA FILE '//wfnamen(l,ifn)
-  write(*,*) ' FOR NESTING LEVEL ',k
-  write(*,*) ' ###########################################'// &
-       '###### '
-  stop
-
-end subroutine gridcheck_nest
-
-subroutine readwind_ecmwf(indj,n,uuh,vvh,wwh)
-
-  !**********************************************************************
-  !                                                                     *
-  !             TRAJECTORY MODEL SUBROUTINE READWIND                    *
-  !                                                                     *
-  !**********************************************************************
-  !                                                                     *
-  !             AUTHOR:      G. WOTAWA                                  *
-  !             DATE:        1997-08-05                                 *
-  !             LAST UPDATE: 2000-10-17, Andreas Stohl                  *
-  !             CHANGE: 11/01/2008, Harald Sodemann, GRIB1/2 input with *
-  !                                 ECMWF grib_api                      *
-  !             CHANGE: 03/12/2008, Harald Sodemann, update to f90 with *
-  !                                 ECMWF grib_api                      *
-  !                                                                     *
-  !**********************************************************************
-  !  Changes, Bernd C. Krueger, Feb. 2001:
-  !   Variables tth and qvh (on eta coordinates) in common block
-  !
-  !   Unified ECMWF and GFS builds                                      
-  !   Marian Harustak, 12.5.2017                                        
-  !     - Renamed from readwind to readwind_ecmwf                     
-  !
-  !  L. Bakels, 2021: OpenMP parallelisation (following CTM version)
-  !**********************************************************************
-  !                                                                     *
-  ! DESCRIPTION:                                                        *
-  !                                                                     *
-  ! READING OF ECMWF METEOROLOGICAL FIELDS FROM INPUT DATA FILES. THE   *
-  ! INPUT DATA FILES ARE EXPECTED TO BE AVAILABLE IN GRIB CODE          *
-  !                                                                     *
-  ! INPUT:                                                              *
-  ! indj               indicates number of the wind field to be read in *
-  ! n                  temporal index for meteorological fields (1 to 3)*
-  !                                                                     *
-  ! IMPORTANT VARIABLES FROM COMMON BLOCK:                              *
-  !                                                                     *
-  ! wfname             File name of data to be read in                  *
-  ! nx,ny,nuvz,nwz     expected field dimensions                        *
-  ! nlev_ec            number of vertical levels ecmwf model            *
-  ! uu,vv,ww           wind fields                                      *
-  ! tt,qv              temperature and specific humidity                *
-  ! ps                 surface pressure                                 *
-  !                                                                     *
-  !**********************************************************************
-
-  use grib_api
-
-  implicit none
-
-  !  include 'grib_api.h'
-
-  !HSO  parameters for grib_api
-  integer :: ifile
-  integer :: iret
-  integer, dimension(:), allocatable   :: igrib
-  integer :: nfield, ii, arsize
-  integer :: gribVer,parCat,parNum,sfctyp,ivalsfc,discipl,parId
-  integer :: gotGrid
-  ! HSO  end
-
-  real(kind=4) :: uuh(0:nxmax-1,0:nymax-1,nuvzmax)
-  real(kind=4) :: vvh(0:nxmax-1,0:nymax-1,nuvzmax)
-  real(kind=4) :: wwh(0:nxmax-1,0:nymax-1,nwzmax)
-  integer :: indj,i,j,k,n,levdiff2,iumax,iwmax!,ifield
-  integer :: kz
-
-  ! VARIABLES AND ARRAYS NEEDED FOR GRIB DECODING
-
-  ! dimension of isec2 at least (22+n), where n is the number of parallels or
-  ! meridians in a quasi-regular (reduced) Gaussian or lat/long grid
+#include "win_gridcheck_ecmwf.f90"
 
-  ! dimension of zsec2 at least (10+nn), where nn is the number of vertical
-  ! coordinate parameters
+#include "win_gridcheck_gfs.f90"
 
-  integer :: isec1(56),isec2(22+nxmax+nymax)
-  real(kind=4), allocatable, dimension(:) :: zsec4
-  !  real(kind=4) :: zsec4(jpunp)
-  real(kind=4) :: xaux,yaux,xaux0,yaux0
-  real(kind=8) :: xauxin,yauxin
-  real,parameter :: eps=1.e-4
-  real(kind=4) :: nsss(0:nxmax-1,0:nymax-1),ewss(0:nxmax-1,0:nymax-1)
-  real :: plev1,pmean,tv,fu,hlev1,ff10m,fflev1,conversion_factor
-  integer :: stat
+#include "win_gridcheck_nest.f90"
 
-  logical :: hflswitch,strswitch!,readcloud
+#include "win_readwind_ecmwf.f90"
 
-  !HSO  grib api error messages
-  character(len=24) :: gribErrorMsg = 'Error reading grib file'
-  character(len=20) :: gribFunction = 'readwind'
-
-  hflswitch=.false.
-  strswitch=.false.
-  !ZHG test the grib fields that have lcwc without using them
-  !  readcloud=.false.
-
-  levdiff2=nlev_ec-nwz+1
-  iumax=0
-  iwmax=0
-
-  !
-  ! OPENING OF DATA FILE (GRIB CODE)
-  !
-  call grib_open_file(ifile,path(3)(1:length(3)) &
-       //trim(wfname(indj)),'r',iret)
-  if (iret.ne.GRIB_SUCCESS) then
-    goto 888   ! ERROR DETECTED
-  endif
-
-  call grib_count_in_file(ifile,nfield)
-
-  ! allocate memory for grib handles
-  allocate(igrib(nfield), stat=stat)
-  if (stat.ne.0) stop "Could not allocate igrib"
-  ! initialise
-  igrib(:) = -1
-
-  do ii = 1,nfield
-    call grib_new_from_file(ifile, igrib(ii), iret)
-  end do
-
-  call grib_close_file(ifile)
-
-  !turn on support for multi fields messages */
-  !call grib_multi_support_on
-
-  gotGrid=0
-
-!$OMP PARALLEL DEFAULT(none) &
-!$OMP SHARED (nfield, igrib, gribFunction, nxfield, ny, nlev_ec, dx, xlon0, ylat0, &
-!$OMP   n, tth, uuh, vvh, iumax, qvh, ps, wwh, iwmax, sd, msl, tcc, u10, v10, tt2, &
-!$OMP   td2, lsprec, convprec, sshf, hflswitch, ssr, ewss, nsss, strswitch, oro,   &
-!$OMP   excessoro, lsm, nymin1,ciwch,clwch,readclouds,sumclouds, nxshift) & 
-!$OMP PRIVATE(ii, gribVer, iret, isec1, discipl, parCat, parNum, parId,sfctyp, ivalsfc, &
-!$OMP   zsec4, isec2, gribErrorMsg, xauxin, yauxin, xaux, yaux, xaux0,  &
-!$OMP   yaux0, k, arsize, stat, conversion_factor)  &
-!$OMP REDUCTION(+:gotGrid)
-  !
-  ! GET NEXT FIELDS
-  !
-  ! allocate memory for reading from grib
-  allocate(zsec4(nxfield*ny), stat=stat)
-  if (stat.ne.0) stop "Could not allocate zsec4"
-
-!$OMP DO SCHEDULE(static)
-
-  fieldloop : do ii=1,nfield
-
-  !first see if we read GRIB1 or GRIB2
-  call grib_get_int(igrib(ii),'editionNumber',gribVer,iret)
-  call grib_check(iret,gribFunction,gribErrorMsg)
-
-  if (gribVer.eq.1) then ! GRIB Edition 1
-
-    !print*,'GRiB Edition 1'
-    !read the grib2 identifiers
-    call grib_get_int(igrib(ii),'indicatorOfParameter',isec1(6),iret)
-    call grib_check(iret,gribFunction,gribErrorMsg)
-    call grib_get_int(igrib(ii),'level',isec1(8),iret)
-    call grib_check(iret,gribFunction,gribErrorMsg)
-
-  !change code for etadot to code for omega
-    if (isec1(6).eq.77) then
-      isec1(6)=135
-    endif
-
-    conversion_factor=1.
-
-  else
-
-  !print*,'GRiB Edition 2'
-  !read the grib2 identifiers
-    call grib_get_int(igrib(ii),'discipline',discipl,iret)
-    call grib_check(iret,gribFunction,gribErrorMsg)
-    call grib_get_int(igrib(ii),'parameterCategory',parCat,iret)
-    call grib_check(iret,gribFunction,gribErrorMsg)
-    call grib_get_int(igrib(ii),'parameterNumber',parNum,iret)
-    call grib_check(iret,gribFunction,gribErrorMsg)
-    call grib_get_int(igrib(ii),'typeOfFirstFixedSurface',sfctyp,iret)
-    call grib_check(iret,gribFunction,gribErrorMsg)
-    call grib_get_int(igrib(ii),'level',ivalsfc,iret)
-    call grib_check(iret,gribFunction,gribErrorMsg)
-    call grib_get_int(igrib(ii),'paramId',parId,iret)
-    call grib_check(iret,gribFunction,gribErrorMsg)
-
-  !print*,discipl,parCat,parNum,sfctyp,ivalsfc
-
-  !convert to grib1 identifiers
-    isec1(6)=-1
-    isec1(7)=-1
-    isec1(8)=-1
-    isec1(8)=ivalsfc     ! level
-    conversion_factor=1.
-    if ((parCat.eq.0).and.(parNum.eq.0).and.(sfctyp.eq.105)) then ! T
-      isec1(6)=130         ! indicatorOfParameter
-    elseif ((parCat.eq.2).and.(parNum.eq.2).and.(sfctyp.eq.105)) then ! U
-      isec1(6)=131         ! indicatorOfParameter
-    elseif ((parCat.eq.2).and.(parNum.eq.3).and.(sfctyp.eq.105)) then ! V
-      isec1(6)=132         ! indicatorOfParameter
-    elseif ((parCat.eq.1).and.(parNum.eq.0).and.(sfctyp.eq.105)) then ! Q
-      isec1(6)=133         ! indicatorOfParameter
-  ! ESO Cloud water is in a) fields CLWC and CIWC, *or* b) field QC 
-    elseif ((parCat.eq.1).and.(parNum.eq.83).and.(sfctyp.eq.105)) then ! clwc
-      isec1(6)=246         ! indicatorOfParameter
-    elseif ((parCat.eq.1).and.(parNum.eq.84).and.(sfctyp.eq.105)) then ! ciwc
-      isec1(6)=247         ! indicatorOfParameter
-  ! ESO qc(=clwc+ciwc):
-    elseif ((parCat.eq.201).and.(parNum.eq.31).and.(sfctyp.eq.105)) then ! qc
-      isec1(6)=201031         ! indicatorOfParameter
-    elseif ((parCat.eq.3).and.(parNum.eq.0).and.(sfctyp.eq.1)) then !SP
-      isec1(6)=134         ! indicatorOfParameter
-    elseif ((parCat.eq.2).and.(parNum.eq.32)) then ! W, actually eta dot
-      isec1(6)=135         ! indicatorOfParameter
-    elseif ((parCat.eq.128).and.(parNum.eq.77)) then ! W, actually eta dot
-      isec1(6)=135         ! indicatorOfParameter
-    elseif ((parCat.eq.3).and.(parNum.eq.0).and.(sfctyp.eq.101)) then !SLP
-      isec1(6)=151         ! indicatorOfParameter
-    elseif ((parCat.eq.2).and.(parNum.eq.2).and.(sfctyp.eq.103)) then ! 10U
-      isec1(6)=165         ! indicatorOfParameter
-    elseif ((parCat.eq.2).and.(parNum.eq.3).and.(sfctyp.eq.103)) then ! 10V
-      isec1(6)=166         ! indicatorOfParameter
-    elseif ((parCat.eq.0).and.(parNum.eq.0).and.(sfctyp.eq.103)) then ! 2T
-      isec1(6)=167         ! indicatorOfParameter
-    elseif ((parCat.eq.0).and.(parNum.eq.6).and.(sfctyp.eq.103)) then ! 2D
-      isec1(6)=168         ! indicatorOfParameter
-    elseif ((parCat.eq.1).and.(parNum.eq.11).and.(sfctyp.eq.1)) then ! SD
-      isec1(6)=141         ! indicatorOfParameter
-      conversion_factor=1000.
-    elseif ((parCat.eq.6).and.(parNum.eq.1) .or. parId .eq. 164) then ! CC
-      isec1(6)=164         ! indicatorOfParameter
-    elseif ((parCat.eq.1).and.(parNum.eq.9) .or. parId .eq. 142) then ! LSP
-      isec1(6)=142         ! indicatorOfParameter
-    elseif ((parCat.eq.1).and.(parNum.eq.10)) then ! CP
-      isec1(6)=143         ! indicatorOfParameter
-      conversion_factor=1000.
-    elseif ((parCat.eq.0).and.(parNum.eq.11).and.(sfctyp.eq.1)) then ! SHF
-      isec1(6)=146         ! indicatorOfParameter
-    elseif ((parCat.eq.4).and.(parNum.eq.9).and.(sfctyp.eq.1)) then ! SR
-      isec1(6)=176         ! indicatorOfParameter
-  !    elseif ((parCat.eq.2).and.(parNum.eq.17) .or. parId .eq. 180) then ! EWSS --wrong
-    elseif ((parCat.eq.2).and.(parNum.eq.38) .or. parId .eq. 180) then ! EWSS --correct
-      isec1(6)=180         ! indicatorOfParameter
-  !    elseif ((parCat.eq.2).and.(parNum.eq.18) .or. parId .eq. 181) then ! NSSS --wrong
-    elseif ((parCat.eq.2).and.(parNum.eq.37) .or. parId .eq. 181) then ! NSSS --correct
-      isec1(6)=181         ! indicatorOfParameter
-    elseif ((parCat.eq.3).and.(parNum.eq.4)) then ! ORO
-      isec1(6)=129         ! indicatorOfParameter
-    elseif ((parCat.eq.3).and.(parNum.eq.7) .or. parId .eq. 160) then ! SDO
-      isec1(6)=160         ! indicatorOfParameter
-    elseif ((discipl.eq.2).and.(parCat.eq.0).and.(parNum.eq.0).and. &
-         (sfctyp.eq.1)) then ! LSM
-      isec1(6)=172         ! indicatorOfParameter
-    elseif (parNum.eq.152) then 
-      isec1(6)=152         ! avoid warning for lnsp    
-    else
-      print*,'***WARNING: undefined GRiB2 message found!',discipl, &
-           parCat,parNum,sfctyp
-    endif
-    if(parId .ne. isec1(6) .and. parId .ne. 77) then
-      write(*,*) 'parId',parId, 'isec1(6)',isec1(6)
-  !    stop
-    endif
-
-  endif
-
-  !HSO  get the size and data of the values array
-  if (isec1(6).ne.-1) then
-    call grib_get_real4_array(igrib(ii),'values',zsec4,iret)
-    call grib_check(iret,gribFunction,gribErrorMsg)
-  endif
-
-  !HSO  get the required fields from section 2 in a gribex compatible manner
-  if (ii.eq.1) then
-    call grib_get_int(igrib(ii),'numberOfPointsAlongAParallel',isec2(2),iret)
-    call grib_check(iret,gribFunction,gribErrorMsg)
-    call grib_get_int(igrib(ii),'numberOfPointsAlongAMeridian',isec2(3),iret)
-    call grib_check(iret,gribFunction,gribErrorMsg)
-    call grib_get_int(igrib(ii),'numberOfVerticalCoordinateValues',isec2(12))
-    call grib_check(iret,gribFunction,gribErrorMsg)
-  ! CHECK GRID SPECIFICATIONS
-    if(isec2(2).ne.nxfield) stop 'READWIND: NX NOT CONSISTENT'
-    if(isec2(3).ne.ny) stop 'READWIND: NY NOT CONSISTENT'
-    if(isec2(12)/2-1.ne.nlev_ec) &
-         stop 'READWIND: VERTICAL DISCRETIZATION NOT CONSISTENT'
-  endif ! ifield
-
-!$OMP CRITICAL
-  !HSO  get the second part of the grid dimensions only from GRiB1 messages
-  if (isec1(6) .eq. 167 .and. (gotGrid.eq.0)) then
-    call grib_get_real8(igrib(ii),'longitudeOfFirstGridPointInDegrees', &
-         xauxin,iret)
-    call grib_check(iret,gribFunction,gribErrorMsg)
-    call grib_get_real8(igrib(ii),'latitudeOfLastGridPointInDegrees', &
-         yauxin,iret)
-    call grib_check(iret,gribFunction,gribErrorMsg)
-    if (xauxin.gt.180.) xauxin=xauxin-360.0
-    if (xauxin.lt.-180.) xauxin=xauxin+360.0
-
-    xaux=xauxin+real(nxshift)*dx
-    yaux=yauxin
-    if (xaux.gt.180.) xaux=xaux-360.0
-    if(abs(xaux-xlon0).gt.eps) &
-         stop 'READWIND: LOWER LEFT LONGITUDE NOT CONSISTENT'
-    if(abs(yaux-ylat0).gt.eps) &
-         stop 'READWIND: LOWER LEFT LATITUDE NOT CONSISTENT'
-    gotGrid=1
-  endif ! gotGrid
-!$OMP END CRITICAL
-
-  k=isec1(8)
-  select case(isec1(6)) 
-  !! TEMPERATURE
-    case(130) 
-      do j=0,nymin1
-        do i=0,nxfield-1
-          tth(i,j,nlev_ec-k+2,n) = zsec4(nxfield*(ny-j-1)+i+1)
-        end do 
-      end do 
-  !! U VELOCITY
-    case(131) 
-      do j=0,nymin1
-        do i=0,nxfield-1
-          uuh(i,j,nlev_ec-k+2) = zsec4(nxfield*(ny-j-1)+i+1)
-        end do 
-      end do 
-!$OMP CRITICAL
-      iumax=max(iumax,nlev_ec-k+1)
-!$OMP END CRITICAL
-  !! V VELOCITY
-    case(132)
-      do j=0,nymin1
-        do i=0,nxfield-1
-          vvh(i,j,nlev_ec-k+2) = zsec4(nxfield*(ny-j-1)+i+1)
-        end do 
-      end do
-  !! SPEC. HUMIDITY
-    case(133)
-      do j=0,nymin1
-        do i=0,nxfield-1
-          qvh(i,j,nlev_ec-k+2,n) = zsec4(nxfield*(ny-j-1)+i+1)
-          if (qvh(i,j,nlev_ec-k+2,n) .lt. 0.) &
-               qvh(i,j,nlev_ec-k+2,n) = 0.
-    !        this is necessary because the gridded data may contain
-    !        spurious negative values
-        end do 
-      end do
-  !! SURF. PRESS.
-    case(134) 
-      do j=0,nymin1
-        do i=0,nxfield-1
-          ps(i,j,1,n) = zsec4(nxfield*(ny-j-1)+i+1)
-        end do 
-      end do
-  !! W VELOCITY
-    case(135)
-      do j=0,nymin1
-        do i=0,nxfield-1
-          wwh(i,j,nlev_ec-k+1) = zsec4(nxfield*(ny-j-1)+i+1)
-        end do 
-      end do 
-!$OMP CRITICAL
-      iwmax=max(iwmax,nlev_ec-k+1)
-!$OMP END CRITICAL
-  !! SNOW DEPTH
-    case(141) 
-      do j=0,nymin1
-        do i=0,nxfield-1
-          sd(i,j,1,n)= zsec4(nxfield*(ny-j-1)+i+1)/conversion_factor
-        end do 
-      end do
-  !! SEA LEVEL PRESS.
-    case(151)
-      do j=0,nymin1
-        do i=0,nxfield-1
-          msl(i,j,1,n) = zsec4(nxfield*(ny-j-1)+i+1)
-        end do 
-      end do
-  !! CLOUD COVER
-    case(164)
-      do j=0,nymin1
-        do i=0,nxfield-1
-          tcc(i,j,1,n) =  zsec4(nxfield*(ny-j-1)+i+1)
-        end do 
-      end do 
-  !! 10 M U VELOCITY
-    case(165) 
-      do j=0,nymin1
-        do i=0,nxfield-1
-          u10(i,j,1,n)= zsec4(nxfield*(ny-j-1)+i+1)
-        end do 
-      end do 
-  !! 10 M V VELOCITY
-    case(166) 
-      do j=0,nymin1
-        do i=0,nxfield-1
-          v10(i,j,1,n) = zsec4(nxfield*(ny-j-1)+i+1)
-        end do 
-      end do 
-  !! 2 M TEMPERATURE
-    case(167)
-      do j=0,nymin1
-        do i=0,nxfield-1
-          tt2(i,j,1,n) = zsec4(nxfield*(ny-j-1)+i+1)
-        end do 
-      end do 
-  !! 2 M DEW POINT
-    case(168)
-      do j=0,nymin1
-        do i=0,nxfield-1
-          td2(i,j,1,n) = zsec4(nxfield*(ny-j-1)+i+1)
-        end do 
-      end do
-  !! LARGE SCALE PREC.
-    case(142)
-      do j=0,nymin1
-        do i=0,nxfield-1
-          lsprec(i,j,1,n)=zsec4(nxfield*(ny-j-1)+i+1)
-          if (lsprec(i,j,1,n).lt.0.) lsprec(i,j,1,n)=0.
-        end do 
-      end do
-  !! CONVECTIVE PREC.
-    case(143)
-      do j=0,nymin1
-        do i=0,nxfield-1
-          convprec(i,j,1,n)=zsec4(nxfield*(ny-j-1)+i+1)/conversion_factor
-          if (convprec(i,j,1,n).lt.0.) convprec(i,j,1,n)=0.
-        end do 
-      end do
-  !! SENS. HEAT FLUX
-    case(146)
-      do j=0,nymin1
-        do i=0,nxfield-1
-          sshf(i,j,1,n) = zsec4(nxfield*(ny-j-1)+i+1)
-!$OMP CRITICAL
-          if(zsec4(nxfield*(ny-j-1)+i+1).ne.0.) &  
-            hflswitch=.true.    ! Heat flux available
-!$OMP END CRITICAL
-        end do 
-      end do
-  !! SOLAR RADIATION
-    case(176)
-      do j=0,nymin1
-        do i=0,nxfield-1
-          ssr(i,j,1,n)=zsec4(nxfield*(ny-j-1)+i+1)
-          if (ssr(i,j,1,n).lt.0.) ssr(i,j,1,n)=0.
-        end do 
-      end do
-  !! EW SURFACE STRESS
-    case(180)
-      do j=0,nymin1
-        do i=0,nxfield-1
-          ewss(i,j) = zsec4(nxfield*(ny-j-1)+i+1)
-!$OMP CRITICAL
-          if (zsec4(nxfield*(ny-j-1)+i+1).ne.0.) strswitch=.true.    ! stress available
-!$OMP END CRITICAL
-        end do 
-      end do 
-  !! NS SURFACE STRESS
-    case(181)
-     do j=0,nymin1
-       do i=0,nxfield-1
-         nsss(i,j) = zsec4(nxfield*(ny-j-1)+i+1)
-!$OMP CRITICAL
-         if (zsec4(nxfield*(ny-j-1)+i+1).ne.0.) strswitch=.true.    ! stress available
-!$OMP END CRITICAL
-       end do 
-     end do 
-  !! ECMWF OROGRAPHY
-    case(129)
-      do j=0,nymin1
-        do i=0,nxfield-1
-          oro(i,j) = zsec4(nxfield*(ny-j-1)+i+1)/ga
-        end do 
-      end do
-  !! STANDARD DEVIATION OF OROGRAPHY
-    case(160)
-      do j=0,nymin1
-        do i=0,nxfield-1
-          excessoro(i,j) = zsec4(nxfield*(ny-j-1)+i+1)
-        end do 
-      end do 
-  !! ECMWF LAND SEA MASK
-    case(172)
-      do j=0,nymin1
-        do i=0,nxfield-1
-          lsm(i,j) = zsec4(nxfield*(ny-j-1)+i+1)
-        end do 
-      end do
-  !! CLWC  Cloud liquid water content [kg/kg]
-    case(246)    
-      do j=0,nymin1
-        do i=0,nxfield-1
-          clwch(i,j,nlev_ec-k+2,n)=zsec4(nxfield*(ny-j-1)+i+1)
-        end do
-      end do
-!$OMP CRITICAL
-      readclouds=.true.
-      sumclouds=.false.
-!$OMP END CRITICAL
-  !! CIWC  Cloud ice water content
-    case(247)
-      do j=0,nymin1
-        do i=0,nxfield-1
-          ciwch(i,j,nlev_ec-k+2,n)=zsec4(nxfield*(ny-j-1)+i+1)
-        end do
-      end do
-  !ZHG end
-  !ESO read qc (=clwc+ciwc)
-  !! QC  Cloud liquid water content [kg/kg]
-    case(201031)
-      do j=0,nymin1
-        do i=0,nxfield-1      
-          clwch(i,j,nlev_ec-k+2,n)=zsec4(nxfield*(ny-j-1)+i+1)
-        end do
-      end do
-!$OMP CRITICAL
-      readclouds=.true.
-      sumclouds=.false.
-!$OMP END CRITICAL
-
-  end select
-
-  call grib_release(igrib(ii))
-
-  end do fieldloop
-!$OMP END DO
-  deallocate(zsec4)
-!$OMP END PARALLEL
-
-  deallocate(igrib)
-  !
-  ! CLOSING OF INPUT DATA FILE
-  !
-
-  ! 50 call grib_close_file(ifile)
-
-  !error message if no fields found with correct first longitude in it
-  if (gotGrid.eq.0) then
-    print*,'***ERROR: input file needs to contain GRiB1 formatted'// &
-         'messages'
-    stop
-  endif
-
-  if(levdiff2.eq.0) then
-    iwmax=nlev_ec+1
-    do i=0,nxmin1
-      do j=0,nymin1
-        wwh(i,j,nlev_ec+1)=0.
-      end do
-    end do
-  endif
-
-  ! For global fields, assign the leftmost data column also to the rightmost
-  ! data column; if required, shift whole grid by nxshift grid points
-  !*************************************************************************
-
-  if (xglobal) then
-    call shift_field_0(ewss,nxfield,ny)
-    call shift_field_0(nsss,nxfield,ny)
-    call shift_field_0(oro,nxfield,ny)
-    call shift_field_0(excessoro,nxfield,ny)
-    call shift_field_0(lsm,nxfield,ny)
-    call shift_field(ps,nxfield,ny,1,1,2,n)
-    call shift_field(sd,nxfield,ny,1,1,2,n)
-    call shift_field(msl,nxfield,ny,1,1,2,n)
-    call shift_field(tcc,nxfield,ny,1,1,2,n)
-    call shift_field(u10,nxfield,ny,1,1,2,n)
-    call shift_field(v10,nxfield,ny,1,1,2,n)
-    call shift_field(tt2,nxfield,ny,1,1,2,n)
-    call shift_field(td2,nxfield,ny,1,1,2,n)
-    call shift_field(lsprec,nxfield,ny,1,1,2,n)
-    call shift_field(convprec,nxfield,ny,1,1,2,n)
-    call shift_field(sshf,nxfield,ny,1,1,2,n)
-    call shift_field(ssr,nxfield,ny,1,1,2,n)
-    call shift_field(tth,nxfield,ny,nuvzmax,nuvz,2,n)
-    call shift_field(qvh,nxfield,ny,nuvzmax,nuvz,2,n)
-    call shift_field(uuh,nxfield,ny,nuvzmax,nuvz,1,1)
-    call shift_field(vvh,nxfield,ny,nuvzmax,nuvz,1,1)
-    call shift_field(wwh,nxfield,ny,nwzmax,nwz,1,1)
-  !ZHG
-    call shift_field(clwch,nxfield,ny,nuvzmax,nuvz,2,n)
-    if (.not.sumclouds) call shift_field(ciwch,nxfield,ny,nuvzmax,nuvz,2,n)
-  !ZHG end
-
-  endif
-
-  do i=0,nxmin1
-    do j=0,nymin1
-      if ((ewss(i,j).eq.0.).and.(nsss(i,j).eq.0.)) then
-        if ((i.ne.0).and.(j.ne.0).and.(i.ne.nxmin1).and.(j.ne.nymin1)) then
-          ewss(i,j)=(ewss(i-1,j-1)+ewss(i+1,j+1)+ewss(i+1,j)+ewss(i-1,j)+ &
-                     ewss(i,j+1)+ewss(i,j-1)+ewss(i-1,j+1)+ewss(i+1,j-1))/8.
-          nsss(i,j)=(nsss(i-1,j-1)+nsss(i+1,j+1)+nsss(i+1,j)+nsss(i-1,j)+ &
-                     nsss(i,j+1)+nsss(i,j-1)+nsss(i-1,j+1)+nsss(i+1,j-1))/8.
-        else if ((i.eq.0).and.(j.eq.0)) then
-          ewss(i,j)=(ewss(i+1,j+1)+ewss(i+1,j)+ewss(i,j+1))/3.
-          nsss(i,j)=(nsss(i+1,j+1)+nsss(i+1,j)+nsss(i,j+1))/3.
-        else if ((i.eq.nxmin1).and.(j.eq.nymin1)) then
-          ewss(i,j)=(ewss(i-1,j-1)+ewss(i-1,j)+ewss(i,j-1))/3.
-          nsss(i,j)=(nsss(i-1,j-1)+nsss(i-1,j)+nsss(i,j-1))/3.
-        else if ((i.eq.0).and.(j.eq.nymin1)) then
-          ewss(i,j)=(ewss(i+1,j-1)+ewss(i+1,j)+ewss(i,j-1))/3.
-          nsss(i,j)=(nsss(i+1,j-1)+nsss(i+1,j)+nsss(i,j-1))/3.
-        else if ((i.eq.nxmin1).and.(j.eq.0)) then
-          ewss(i,j)=(ewss(i-1,j+1)+ewss(i-1,j)+ewss(i,j+1))/3.
-          nsss(i,j)=(nsss(i-1,j+1)+nsss(i-1,j)+nsss(i,j+1))/3.
-        else if (i.eq.0) then
-          ewss(i,j)=(ewss(i+1,j+1)+ewss(i+1,j)+ewss(i,j+1)+ewss(i,j-1)+ewss(i+1,j-1))/5.
-          nsss(i,j)=(nsss(i+1,j+1)+nsss(i+1,j)+nsss(i,j+1)+nsss(i,j-1)+nsss(i+1,j-1))/5.
-        else if (i.eq.nxmin1) then
-          ewss(i,j)=(ewss(i-1,j+1)+ewss(i-1,j)+ewss(i,j+1)+ewss(i,j-1)+ewss(i-1,j-1))/5.
-          nsss(i,j)=(nsss(i-1,j+1)+nsss(i-1,j)+nsss(i,j+1)+nsss(i,j-1)+nsss(i-1,j-1))/5.
-        else if (j.eq.0) then
-          ewss(i,j)=(ewss(i+1,j+1)+ewss(i+1,j)+ewss(i-1,j)+ewss(i,j+1)+ewss(i-1,j+1))/5.
-          nsss(i,j)=(nsss(i+1,j+1)+nsss(i+1,j)+nsss(i-1,j)+nsss(i,j+1)+nsss(i-1,j+1))/5.
-        else if (j.eq.nymin1) then
-          ewss(i,j)=(ewss(i+1,j-1)+ewss(i+1,j)+ewss(i-1,j)+ewss(i,j-1)+ewss(i-1,j-1))/5.
-          nsss(i,j)=(nsss(i+1,j-1)+nsss(i+1,j)+nsss(i-1,j)+nsss(i,j-1)+nsss(i-1,j-1))/5.
-        endif
-      endif
-      sfcstress(i,j,1,n)=sqrt(ewss(i,j)**2+nsss(i,j)**2)
-    end do
-  end do
-
-  if ((.not.hflswitch).or.(.not.strswitch)) then
-    write(*,*) 'WARNING: No flux data contained in GRIB file ', &
-         wfname(indj)
-
-  ! CALCULATE USTAR AND SSHF USING THE PROFILE METHOD
-  ! As ECMWF has increased the model resolution, such that now the first model
-  ! level is at about 10 m (where 10-m wind is given), use the 2nd ECMWF level
-  ! (3rd model level in FLEXPART) for the profile method
-  !***************************************************************************
-
-    do i=0,nxmin1
-      do j=0,nymin1
-        plev1=akz(3)+bkz(3)*ps(i,j,1,n)
-        pmean=0.5*(ps(i,j,1,n)+plev1)
-        tv=tth(i,j,3,n)*(1.+0.61*qvh(i,j,3,n))
-        fu=-r_air*tv/ga/pmean
-        hlev1=fu*(plev1-ps(i,j,1,n))   ! HEIGTH OF FIRST MODEL LAYER
-        ff10m= sqrt(u10(i,j,1,n)**2+v10(i,j,1,n)**2)
-        fflev1=sqrt(uuh(i,j,3)**2+vvh(i,j,3)**2)
-        call pbl_profile(ps(i,j,1,n),td2(i,j,1,n),hlev1, &
-             tt2(i,j,1,n),tth(i,j,3,n),ff10m,fflev1, &
-             sfcstress(i,j,1,n),sshf(i,j,1,n))
-        if(sshf(i,j,1,n).gt.200.) sshf(i,j,1,n)=200.
-        if(sshf(i,j,1,n).lt.-400.) sshf(i,j,1,n)=-400.
-      end do
-    end do
-  endif
-
-
-  ! Assign 10 m wind to model level at eta=1.0 to have one additional model
-  ! level at the ground
-  ! Specific humidity is taken the same as at one level above
-  ! Temperature is taken as 2 m temperature
-  !**************************************************************************
-
-  do i=0,nxmin1
-    do j=0,nymin1
-      uuh(i,j,1)=u10(i,j,1,n)
-      vvh(i,j,1)=v10(i,j,1,n)
-      qvh(i,j,1,n)=qvh(i,j,2,n)
-      tth(i,j,1,n)=tt2(i,j,1,n)
-    end do
-  end do
-
-  if(iumax.ne.nuvz-1) stop 'READWIND: NUVZ NOT CONSISTENT'
-  if(iwmax.ne.nwz)    stop 'READWIND: NWZ NOT CONSISTENT'
-
-  return
-
-888 write(*,*) ' #### FLEXPART MODEL ERROR! WINDFIELD         #### '
-  write(*,*) ' #### ',wfname(indj),'                    #### '
-  write(*,*) ' #### IS NOT GRIB FORMAT !!!                  #### '
-  stop 'Execution terminated'
-
-end subroutine readwind_ecmwf
-
-subroutine readwind_gfs(indj,n,uuh,vvh,wwh)
-
-  !***********************************************************************
-  !*                                                                     *
-  !*             TRAJECTORY MODEL SUBROUTINE READWIND                    *
-  !*                                                                     *
-  !***********************************************************************
-  !*                                                                     *
-  !*             AUTHOR:      G. WOTAWA                                  *
-  !*             DATE:        1997-08-05                                 *
-  !*             LAST UPDATE: 2000-10-17, Andreas Stohl                  *
-  !*             CHANGE: 01/02/2001, Bernd C. Krueger, Variables tth and *
-  !*                     qvh (on eta coordinates) in common block        *
-  !*             CHANGE: 16/11/2005, Caroline Forster, GFS data          *
-  !*             CHANGE: 11/01/2008, Harald Sodemann, Input of GRIB1/2   *
-  !*                     data with the ECMWF grib_api library            *
-  !*             CHANGE: 03/12/2008, Harald Sodemann, update to f90 with *
-  !*                                 ECMWF grib_api                      *
-  !                                                                      *
-  !   Unified ECMWF and GFS builds                                       *
-  !   Marian Harustak, 12.5.2017                                         *
-  !     - Renamed routine from readwind to readwind_gfs                  *
-  !*                                                                     *
-  !***********************************************************************
-  !*                                                                     *
-  !* DESCRIPTION:                                                        *
-  !*                                                                     *
-  !* READING OF ECMWF METEOROLOGICAL FIELDS FROM INPUT DATA FILES. THE   *
-  !* INPUT DATA FILES ARE EXPECTED TO BE AVAILABLE IN GRIB CODE          *
-  !*                                                                     *
-  !* INPUT:                                                              *
-  !* indj               indicates number of the wind field to be read in *
-  !* n                  temporal index for meteorological fields (1 to 3)*
-  !*                                                                     *
-  !* IMPORTANT VARIABLES FROM COMMON BLOCK:                              *
-  !*                                                                     *
-  !* wfname             File name of data to be read in                  *
-  !* nx,ny,nuvz,nwz     expected field dimensions                        *
-  !* nlev_ec            number of vertical levels ecmwf model            *
-  !* uu,vv,ww           wind fields                                      *
-  !* tt,qv              temperature and specific humidity                *
-  !* ps                 surface pressure                                 *
-  !*                                                                     *
-  !***********************************************************************
-
-  use grib_api
-  use qvsat_mod
-
-  implicit none
-
-  !HSO  new parameters for grib_api
-  integer :: ifile
-  integer :: iret
-  integer :: igrib
-  integer :: gribVer,parCat,parNum,sfctyp,ivalsfc,discipl
-  !HSO end edits
-  real :: uuh(0:nxmax-1,0:nymax-1,nuvzmax)
-  real :: vvh(0:nxmax-1,0:nymax-1,nuvzmax)
-  real :: wwh(0:nxmax-1,0:nymax-1,nwzmax)
-  integer :: ii,indj,i,j,k,n,levdiff2,ifield,iumax,iwmax
-
-  ! NCEP
-  integer :: numpt,numpu,numpv,numpw,numprh,numpclwch
-  real :: help, temp
-  real :: elev
-  real :: ulev1(0:nxmax-1,0:nymax-1),vlev1(0:nxmax-1,0:nymax-1)
-  real :: tlev1(0:nxmax-1,0:nymax-1)
-  real :: qvh2(0:nxmax-1,0:nymax-1)
-
-  integer :: i179,i180,i181
-
-  ! VARIABLES AND ARRAYS NEEDED FOR GRIB DECODING
-  !HSO kept isec1, isec2 and zsec4 for consistency with gribex GRIB input
-
-  integer :: isec1(8),isec2(3)
-  real(kind=4) :: zsec4(jpunp)
-  real(kind=4) :: xaux,yaux,xaux0,yaux0
-  real(kind=8) :: xauxin,yauxin
-  real,parameter :: eps=1.e-4
-  real(kind=4) :: ewss(0:nxmax-1,0:nymax-1),nsss(0:nxmax-1,0:nymax-1)
-  real :: plev1,hlev1,ff10m,fflev1
-
-  logical :: hflswitch,strswitch
-
-  !HSO  for grib api error messages
-  character(len=24) :: gribErrorMsg = 'Error reading grib file'
-  character(len=20) :: gribFunction = 'readwind_gfs'
-  character(len=20) :: shortname
-
-
-  hflswitch=.false.
-  strswitch=.false.
-  levdiff2=nlev_ec-nwz+1
-  iumax=0
-  iwmax=0
-
-
-  ! OPENING OF DATA FILE (GRIB CODE)
-
-  !HSO
-  call grib_open_file(ifile,path(3)(1:length(3)) &
-         //trim(wfname(indj)),'r',iret)
-  if (iret.ne.GRIB_SUCCESS) then
-    goto 888   ! ERROR DETECTED
-  endif
-  !turn on support for multi fields messages
-  call grib_multi_support_on
-
-  numpt=0
-  numpu=0
-  numpv=0
-  numpw=0
-  numprh=0
-  numpclwch=0
-  ifield=0
-  do
-    ifield=ifield+1
-    !
-    ! GET NEXT FIELDS
-    !
-    call grib_new_from_file(ifile,igrib,iret)
-    if (iret.eq.GRIB_END_OF_FILE)  then
-      exit   ! EOF DETECTED
-    elseif (iret.ne.GRIB_SUCCESS) then
-      goto 888   ! ERROR DETECTED
-    endif
-
-    !first see if we read GRIB1 or GRIB2
-    call grib_get_int(igrib,'editionNumber',gribVer,iret)
-    !  call grib_check(iret,gribFunction,gribErrorMsg)
-
-    if (gribVer.eq.1) then ! GRIB Edition 1
-
-    !read the grib1 identifiers
-    call grib_get_int(igrib,'indicatorOfParameter',isec1(6),iret)
-    !  call grib_check(iret,gribFunction,gribErrorMsg)
-    call grib_get_int(igrib,'indicatorOfTypeOfLevel',isec1(7),iret)
-    !  call grib_check(iret,gribFunction,gribErrorMsg)
-    call grib_get_int(igrib,'level',isec1(8),iret)
-    !  call grib_check(iret,gribFunction,gribErrorMsg)
-
-    else ! GRIB Edition 2
-
-    !read the grib2 identifiers
-    call grib_get_string(igrib,'shortName',shortname,iret)
-
-    call grib_get_int(igrib,'discipline',discipl,iret)
-    !  call grib_check(iret,gribFunction,gribErrorMsg)
-    call grib_get_int(igrib,'parameterCategory',parCat,iret)
-    !  call grib_check(iret,gribFunction,gribErrorMsg)
-    call grib_get_int(igrib,'parameterNumber',parNum,iret)
-    !  call grib_check(iret,gribFunction,gribErrorMsg)
-    call grib_get_int(igrib,'typeOfFirstFixedSurface',sfctyp,iret)
-    !  call grib_check(iret,gribFunction,gribErrorMsg)
-    call grib_get_int(igrib,'scaledValueOfFirstFixedSurface', &
-         ivalsfc,iret)
-    !  call grib_check(iret,gribFunction,gribErrorMsg)
-    
-    !  write(*,*) 'Field: ',ifield,parCat,parNum,sfctyp,shortname
-    !convert to grib1 identifiers
-    isec1(6)=-1
-    isec1(7)=-1
-    isec1(8)=-1
-    if ((parCat.eq.0).and.(parNum.eq.0).and.(sfctyp.eq.100)) then ! T
-      isec1(6)=11          ! indicatorOfParameter
-      isec1(7)=100         ! indicatorOfTypeOfLevel
-      isec1(8)=ivalsfc/100 ! level, convert to hPa
-    elseif ((parCat.eq.2).and.(parNum.eq.2).and.(sfctyp.eq.100)) then ! U
-      isec1(6)=33          ! indicatorOfParameter
-      isec1(7)=100         ! indicatorOfTypeOfLevel
-      isec1(8)=ivalsfc/100 ! level, convert to hPa
-    elseif ((parCat.eq.2).and.(parNum.eq.3).and.(sfctyp.eq.100)) then ! V
-      isec1(6)=34          ! indicatorOfParameter
-      isec1(7)=100         ! indicatorOfTypeOfLevel
-      isec1(8)=ivalsfc/100 ! level, convert to hPa
-    elseif ((parCat.eq.2).and.(parNum.eq.8).and.(sfctyp.eq.100)) then ! W
-      isec1(6)=39          ! indicatorOfParameter
-      isec1(7)=100         ! indicatorOfTypeOfLevel
-      isec1(8)=ivalsfc/100 ! level, convert to hPa
-    elseif ((parCat.eq.1).and.(parNum.eq.1).and.(sfctyp.eq.100)) then ! RH
-      isec1(6)=52          ! indicatorOfParameter
-      isec1(7)=100         ! indicatorOfTypeOfLevel
-      isec1(8)=ivalsfc/100 ! level, convert to hPa
-    elseif ((parCat.eq.1).and.(parNum.eq.1).and.(sfctyp.eq.103)) then ! RH2
-      isec1(6)=52          ! indicatorOfParameter
-      isec1(7)=105         ! indicatorOfTypeOfLevel
-      isec1(8)=2
-    elseif ((parCat.eq.0).and.(parNum.eq.0).and.(sfctyp.eq.103)) then ! T2
-      isec1(6)=11          ! indicatorOfParameter
-      isec1(7)=105         ! indicatorOfTypeOfLevel
-      isec1(8)=2
-    elseif ((parCat.eq.2).and.(parNum.eq.2).and.(sfctyp.eq.103)) then ! U10
-      isec1(6)=33          ! indicatorOfParameter
-      isec1(7)=105         ! indicatorOfTypeOfLevel
-      isec1(8)=10
-    elseif ((parCat.eq.2).and.(parNum.eq.3).and.(sfctyp.eq.103)) then ! V10
-      isec1(6)=34          ! indicatorOfParameter
-      isec1(7)=105         ! indicatorOfTypeOfLevel
-      isec1(8)=10
-    elseif ((parCat.eq.1).and.(parNum.eq.22).and.(sfctyp.eq.100)) then ! CLWMR Cloud Mixing Ratio [kg/kg]:
-      isec1(6)=153         ! indicatorOfParameter
-      isec1(7)=100         ! indicatorOfTypeOfLevel
-      isec1(8)=ivalsfc/100 ! level, convert to hPa
-    elseif ((parCat.eq.3).and.(parNum.eq.1).and.(sfctyp.eq.101)) then ! SLP
-      isec1(6)=2           ! indicatorOfParameter
-      isec1(7)=102         ! indicatorOfTypeOfLevel
-      isec1(8)=0
-    elseif ((parCat.eq.3).and.(parNum.eq.0).and.(sfctyp.eq.1)) then ! SP
-      isec1(6)=1           ! indicatorOfParameter
-      isec1(7)=1           ! indicatorOfTypeOfLevel
-      isec1(8)=0
-    elseif ((parCat.eq.1).and.(parNum.eq.13).and.(sfctyp.eq.1)) then ! SNOW
-      isec1(6)=66          ! indicatorOfParameter
-      isec1(7)=1           ! indicatorOfTypeOfLevel
-      isec1(8)=0
-    elseif ((parCat.eq.0).and.(parNum.eq.0).and.(sfctyp.eq.104)) then ! T sigma 0
-      isec1(6)=11          ! indicatorOfParameter
-      isec1(7)=107         ! indicatorOfTypeOfLevel
-      isec1(8)=0.995       ! lowest sigma level
-    elseif ((parCat.eq.2).and.(parNum.eq.2).and.(sfctyp.eq.104)) then ! U sigma 0
-      isec1(6)=33          ! indicatorOfParameter
-      isec1(7)=107         ! indicatorOfTypeOfLevel
-      isec1(8)=0.995       ! lowest sigma level
-    elseif ((parCat.eq.2).and.(parNum.eq.3).and.(sfctyp.eq.104)) then ! V sigma 0
-      isec1(6)=34          ! indicatorOfParameter
-      isec1(7)=107         ! indicatorOfTypeOfLevel
-      isec1(8)=0.995       ! lowest sigma level
-    elseif ((parCat.eq.3).and.(parNum.eq.5).and.(sfctyp.eq.1)) then ! TOPO
-      isec1(6)=7           ! indicatorOfParameter
-      isec1(7)=1           ! indicatorOfTypeOfLevel
-      isec1(8)=0
-    elseif ((parCat.eq.0).and.(parNum.eq.0).and.(sfctyp.eq.1) &
-         .and.(discipl.eq.2)) then ! LSM
-      isec1(6)=81          ! indicatorOfParameter
-      isec1(7)=1           ! indicatorOfTypeOfLevel
-      isec1(8)=0
-    elseif ((parCat.eq.3).and.(parNum.eq.196).and.(sfctyp.eq.1)) then ! BLH
-      isec1(6)=221         ! indicatorOfParameter
-      isec1(7)=1           ! indicatorOfTypeOfLevel
-      isec1(8)=0
-    elseif ((parCat.eq.1).and.(parNum.eq.7).and.(sfctyp.eq.1)) then ! LSP/TP
-      isec1(6)=62          ! indicatorOfParameter
-      isec1(7)=1           ! indicatorOfTypeOfLevel
-      isec1(8)=0
-    elseif ((parCat.eq.1).and.(parNum.eq.196).and.(sfctyp.eq.1)) then ! CP
-      isec1(6)=63          ! indicatorOfParameter
-      isec1(7)=1           ! indicatorOfTypeOfLevel
-      isec1(8)=0
-    endif
-
-    endif ! gribVer
-
-    if (isec1(6).ne.-1) then
-    !  get the size and data of the values array
-      call grib_get_real4_array(igrib,'values',zsec4,iret)
-    !    call grib_check(iret,gribFunction,gribErrorMsg)
-    endif
-
-    if(ifield.eq.1) then
-
-    !get the required fields from section 2
-    !store compatible to gribex input
-    call grib_get_int(igrib,'numberOfPointsAlongAParallel', &
-         isec2(2),iret)
-    !  call grib_check(iret,gribFunction,gribErrorMsg)
-    call grib_get_int(igrib,'numberOfPointsAlongAMeridian', &
-         isec2(3),iret)
-    !  call grib_check(iret,gribFunction,gribErrorMsg)
-    call grib_get_real8(igrib,'longitudeOfFirstGridPointInDegrees', &
-         xauxin,iret)
-    !  call grib_check(iret,gribFunction,gribErrorMsg)
-    call grib_get_real8(igrib,'latitudeOfLastGridPointInDegrees', &
-         yauxin,iret)
-    !  call grib_check(iret,gribFunction,gribErrorMsg)
-    xaux=xauxin+real(nxshift)*dx
-    yaux=yauxin
-
-    ! CHECK GRID SPECIFICATIONS
-
-      if(isec2(2).ne.nxfield) stop 'READWIND: NX NOT CONSISTENT'
-      if(isec2(3).ne.ny) stop 'READWIND: NY NOT CONSISTENT'
-      if(xaux.eq.0.) xaux=-179.0     ! NCEP DATA
-      xaux0=xlon0
-      yaux0=ylat0
-      if(xaux.lt.0.) xaux=xaux+360.
-      if(yaux.lt.0.) yaux=yaux+360.
-      if(xaux0.lt.0.) xaux0=xaux0+360.
-      if(yaux0.lt.0.) yaux0=yaux0+360.
-      if(abs(xaux-xaux0).gt.eps) &
-           stop 'READWIND: LOWER LEFT LONGITUDE NOT CONSISTENT'
-      if(abs(yaux-yaux0).gt.eps) &
-           stop 'READWIND: LOWER LEFT LATITUDE NOT CONSISTENT'
-    endif
-    !HSO end of edits
-
-    i179=nint(179./dx)
-    if (dx.lt.0.7) then
-      i180=nint(180./dx)+1    ! 0.5 deg data
-    else
-      i180=nint(179./dx)+1    ! 1 deg data
-    endif
-    i181=i180+1
-
-    if (isec1(6).ne.-1) then
-
-    do j=0,nymin1
-      do i=0,nxfield-1
-        if((isec1(6).eq.011).and.(isec1(7).eq.100)) then
-    ! TEMPERATURE
-           if((i.eq.0).and.(j.eq.0)) then
-              do ii=1,nuvz
-                if ((isec1(8)*100.0).eq.akz(ii)) numpt=ii
-              end do
-          endif
-          help=zsec4(nxfield*(ny-j-1)+i+1)
-          if(i.le.i180) then
-            tth(i179+i,j,numpt,n)=help
-          else
-            tth(i-i181,j,numpt,n)=help
-          endif
-        endif
-        if((isec1(6).eq.033).and.(isec1(7).eq.100)) then
-    ! U VELOCITY
-           if((i.eq.0).and.(j.eq.0)) then
-              do ii=1,nuvz
-                if ((isec1(8)*100.0).eq.akz(ii)) numpu=ii
-              end do
-          endif
-          help=zsec4(nxfield*(ny-j-1)+i+1)
-          if(i.le.i180) then
-            uuh(i179+i,j,numpu)=help
-          else
-            uuh(i-i181,j,numpu)=help
-          endif
-        endif
-        if((isec1(6).eq.034).and.(isec1(7).eq.100)) then
-    ! V VELOCITY
-           if((i.eq.0).and.(j.eq.0)) then
-              do ii=1,nuvz
-                if ((isec1(8)*100.0).eq.akz(ii)) numpv=ii
-              end do
-          endif
-          help=zsec4(nxfield*(ny-j-1)+i+1)
-          if(i.le.i180) then
-            vvh(i179+i,j,numpv)=help
-          else
-            vvh(i-i181,j,numpv)=help
-          endif
-        endif
-        if((isec1(6).eq.052).and.(isec1(7).eq.100)) then
-    ! RELATIVE HUMIDITY -> CONVERT TO SPECIFIC HUMIDITY LATER
-           if((i.eq.0).and.(j.eq.0)) then
-              do ii=1,nuvz
-                if ((isec1(8)*100.0).eq.akz(ii)) numprh=ii
-              end do
-          endif
-          help=zsec4(nxfield*(ny-j-1)+i+1)
-          if(i.le.i180) then
-            qvh(i179+i,j,numprh,n)=help
-          else
-            qvh(i-i181,j,numprh,n)=help
-          endif
-        endif
-        if((isec1(6).eq.001).and.(isec1(7).eq.001)) then
-    ! SURFACE PRESSURE
-          help=zsec4(nxfield*(ny-j-1)+i+1)
-          if(i.le.i180) then
-            ps(i179+i,j,1,n)=help
-          else
-            ps(i-i181,j,1,n)=help
-          endif
-        endif
-        if((isec1(6).eq.039).and.(isec1(7).eq.100)) then
-    ! W VELOCITY
-           if((i.eq.0).and.(j.eq.0)) then
-              do ii=1,nuvz
-                if ((isec1(8)*100.0).eq.akz(ii)) numpw=ii
-              end do
-          endif
-          help=zsec4(nxfield*(ny-j-1)+i+1)
-          if(i.le.i180) then
-            wwh(i179+i,j,numpw)=help
-          else
-            wwh(i-i181,j,numpw)=help
-          endif
-        endif
-        if((isec1(6).eq.066).and.(isec1(7).eq.001)) then
-    ! SNOW DEPTH
-          help=zsec4(nxfield*(ny-j-1)+i+1)
-          if(i.le.i180) then
-            sd(i179+i,j,1,n)=help
-          else
-            sd(i-i181,j,1,n)=help
-          endif
-        endif
-        if((isec1(6).eq.002).and.(isec1(7).eq.102)) then
-    ! MEAN SEA LEVEL PRESSURE
-          help=zsec4(nxfield*(ny-j-1)+i+1)
-          if(i.le.i180) then
-            msl(i179+i,j,1,n)=help
-          else
-            msl(i-i181,j,1,n)=help
-          endif
-        endif
-        if((isec1(6).eq.071).and.(isec1(7).eq.244)) then
-    ! TOTAL CLOUD COVER
-          help=zsec4(nxfield*(ny-j-1)+i+1)
-          if(i.le.i180) then
-            tcc(i179+i,j,1,n)=help
-          else
-            tcc(i-i181,j,1,n)=help
-          endif
-        endif
-        if((isec1(6).eq.033).and.(isec1(7).eq.105).and. &
-             (isec1(8).eq.10)) then
-    ! 10 M U VELOCITY
-          help=zsec4(nxfield*(ny-j-1)+i+1)
-          if(i.le.i180) then
-            u10(i179+i,j,1,n)=help
-          else
-            u10(i-i181,j,1,n)=help
-          endif
-        endif
-        if((isec1(6).eq.034).and.(isec1(7).eq.105).and. &
-             (isec1(8).eq.10)) then
-    ! 10 M V VELOCITY
-          help=zsec4(nxfield*(ny-j-1)+i+1)
-          if(i.le.i180) then
-            v10(i179+i,j,1,n)=help
-          else
-            v10(i-i181,j,1,n)=help
-          endif
-        endif
-        if((isec1(6).eq.011).and.(isec1(7).eq.105).and. &
-             (isec1(8).eq.02)) then
-    ! 2 M TEMPERATURE
-          help=zsec4(nxfield*(ny-j-1)+i+1)
-          if(i.le.i180) then
-            tt2(i179+i,j,1,n)=help
-          else
-            tt2(i-i181,j,1,n)=help
-          endif
-        endif
-        if((isec1(6).eq.017).and.(isec1(7).eq.105).and. &
-             (isec1(8).eq.02)) then
-    ! 2 M DEW POINT TEMPERATURE
-          help=zsec4(nxfield*(ny-j-1)+i+1)
-          if(i.le.i180) then
-            td2(i179+i,j,1,n)=help
-          else
-            td2(i-i181,j,1,n)=help
-          endif
-        endif
-        if((isec1(6).eq.062).and.(isec1(7).eq.001)) then
-    ! LARGE SCALE PREC.
-          help=zsec4(nxfield*(ny-j-1)+i+1)
-          if(i.le.i180) then
-            lsprec(i179+i,j,1,n)=help
-          else
-            lsprec(i-i181,j,1,n)=help
-          endif
-        endif
-        if((isec1(6).eq.063).and.(isec1(7).eq.001)) then
-    ! CONVECTIVE PREC.
-          help=zsec4(nxfield*(ny-j-1)+i+1)
-          if(i.le.i180) then
-            convprec(i179+i,j,1,n)=help
-          else
-            convprec(i-i181,j,1,n)=help
-          endif
-        endif
-        if((isec1(6).eq.007).and.(isec1(7).eq.001)) then
-    ! TOPOGRAPHY
-          help=zsec4(nxfield*(ny-j-1)+i+1)
-          if(i.le.i180) then
-            oro(i179+i,j)=help
-            excessoro(i179+i,j)=0.0 ! ISOBARIC SURFACES: SUBGRID TERRAIN DISREGARDED
-          else
-            oro(i-i181,j)=help
-            excessoro(i-i181,j)=0.0 ! ISOBARIC SURFACES: SUBGRID TERRAIN DISREGARDED
-          endif
-        endif
-        if((isec1(6).eq.081).and.(isec1(7).eq.001)) then
-    ! LAND SEA MASK
-          help=zsec4(nxfield*(ny-j-1)+i+1)
-          if(i.le.i180) then
-            lsm(i179+i,j)=help
-          else
-            lsm(i-i181,j)=help
-          endif
-        endif
-        if((isec1(6).eq.221).and.(isec1(7).eq.001)) then
-    ! MIXING HEIGHT
-          help=zsec4(nxfield*(ny-j-1)+i+1)
-          if(i.le.i180) then
-            hmix(i179+i,j,1,n)=help
-          else
-            hmix(i-i181,j,1,n)=help
-          endif
-        endif
-        if((isec1(6).eq.052).and.(isec1(7).eq.105).and. &
-             (isec1(8).eq.02)) then
-    ! 2 M RELATIVE HUMIDITY
-          help=zsec4(nxfield*(ny-j-1)+i+1)
-          if(i.le.i180) then
-            qvh2(i179+i,j)=help
-          else
-            qvh2(i-i181,j)=help
-          endif
-        endif
-        if((isec1(6).eq.011).and.(isec1(7).eq.107)) then
-    ! TEMPERATURE LOWEST SIGMA LEVEL
-          help=zsec4(nxfield*(ny-j-1)+i+1)
-          if(i.le.i180) then
-            tlev1(i179+i,j)=help
-          else
-            tlev1(i-i181,j)=help
-          endif
-        endif
-        if((isec1(6).eq.033).and.(isec1(7).eq.107)) then
-    ! U VELOCITY LOWEST SIGMA LEVEL
-          help=zsec4(nxfield*(ny-j-1)+i+1)
-          if(i.le.i180) then
-            ulev1(i179+i,j)=help
-          else
-            ulev1(i-i181,j)=help
-          endif
-        endif
-        if((isec1(6).eq.034).and.(isec1(7).eq.107)) then
-    ! V VELOCITY LOWEST SIGMA LEVEL
-          help=zsec4(nxfield*(ny-j-1)+i+1)
-          if(i.le.i180) then
-            vlev1(i179+i,j)=help
-          else
-            vlev1(i-i181,j)=help
-          endif
-        endif
-    ! SEC & IP 12/2018 read GFS clouds
-        if((isec1(6).eq.153).and.(isec1(7).eq.100)) then  !! CLWCR  Cloud liquid water content [kg/kg] 
-           if((i.eq.0).and.(j.eq.0)) then
-              do ii=1,nuvz
-                if ((isec1(8)*100.0).eq.akz(ii)) numpclwch=ii
-              end do
-          endif
-          help=zsec4(nxfield*(ny-j-1)+i+1)
-          if(i.le.i180) then
-            clwch(i179+i,j,numpclwch,n)=help
-          else
-            clwch(i-i181,j,numpclwch,n)=help
-          endif
-          readclouds=.true.
-          sumclouds=.true.
-    !        readclouds=.false.
-    !       sumclouds=.false.
-        endif
-
-
-      end do
-    end do
-
-    endif
-
-    if((isec1(6).eq.33).and.(isec1(7).eq.100)) then
-    ! NCEP ISOBARIC LEVELS
-      iumax=iumax+1
-    endif
-
-    call grib_release(igrib)
-  end do                      !! READ NEXT LEVEL OR PARAMETER
-  !
-  ! CLOSING OF INPUT DATA FILE
-  !
-
-  !HSO close grib file
-  call grib_close_file(ifile)
-
-  ! SENS. HEAT FLUX
-  sshf(:,:,1,n)=0.0     ! not available from gfs.tccz.pgrbfxx files
-  hflswitch=.false.    ! Heat flux not available
-  ! SOLAR RADIATIVE FLUXES
-  ssr(:,:,1,n)=0.0      ! not available from gfs.tccz.pgrbfxx files
-  ! EW SURFACE STRESS
-  ewss=0.0         ! not available from gfs.tccz.pgrbfxx files
-  ! NS SURFACE STRESS
-  nsss=0.0         ! not available from gfs.tccz.pgrbfxx files
-  strswitch=.false.    ! stress not available
-
-  ! CONVERT TP TO LSP (GRIB2 only)
-  if (gribVer.eq.2) then
-    do j=0,nymin1
-    do i=0,nxfield-1
-     if(i.le.i180) then
-     if (convprec(i179+i,j,1,n).lt.lsprec(i179+i,j,1,n)) then ! neg precip would occur
-         lsprec(i179+i,j,1,n)= &
-              lsprec(i179+i,j,1,n)-convprec(i179+i,j,1,n)
-     else
-         lsprec(i179+i,j,1,n)=0
-     endif
-     else
-     if (convprec(i-i181,j,1,n).lt.lsprec(i-i181,j,1,n)) then
-          lsprec(i-i181,j,1,n)= &
-               lsprec(i-i181,j,1,n)-convprec(i-i181,j,1,n)
-     else
-          lsprec(i-i181,j,1,n)=0
-     endif
-     endif
-    enddo
-    enddo
-  endif
-  !HSO end edits
-
-
-  ! TRANSFORM RH TO SPECIFIC HUMIDITY
-
-  do j=0,ny-1
-    do i=0,nxfield-1
-      do k=1,nuvz
-        help=qvh(i,j,k,n)
-        temp=tth(i,j,k,n)
-        plev1=akm(k)+bkm(k)*ps(i,j,1,n)
-        elev=ew(temp,plev1)*help/100.0
-        qvh(i,j,k,n)=xmwml*(elev/(plev1-((1.0-xmwml)*elev)))
-      end do
-    end do
-  end do
-
-  ! CALCULATE 2 M DEW POINT FROM 2 M RELATIVE HUMIDITY
-  ! USING BOLTON'S (1980) FORMULA
-  ! BECAUSE td2 IS NOT AVAILABLE FROM NCEP GFS DATA
-
-  do j=0,ny-1
-    do i=0,nxfield-1
-        help=qvh2(i,j)
-        temp=tt2(i,j,1,n)
-        plev1=akm(k)+bkm(k)*ps(i,j,1,n)
-        elev=ew(temp,plev1)/100.*help/100.   !vapour pressure in hPa
-        td2(i,j,1,n)=243.5/(17.67/log(elev/6.112)-1)+273.
-        if (help.le.0.) td2(i,j,1,n)=tt2(i,j,1,n)
-    end do
-  end do
-
-  if(levdiff2.eq.0) then
-    iwmax=nlev_ec+1
-    do i=0,nxmin1
-      do j=0,nymin1
-        wwh(i,j,nlev_ec+1)=0.
-      end do
-    end do
-  endif
-
-
-  ! For global fields, assign the leftmost data column also to the rightmost
-  ! data column; if required, shift whole grid by nxshift grid points
-  !*************************************************************************
-
-  if (xglobal) then
-    call shift_field_0(ewss,nxfield,ny)
-    call shift_field_0(nsss,nxfield,ny)
-    call shift_field_0(oro,nxfield,ny)
-    call shift_field_0(excessoro,nxfield,ny)
-    call shift_field_0(lsm,nxfield,ny)
-    call shift_field_0(ulev1,nxfield,ny)
-    call shift_field_0(vlev1,nxfield,ny)
-    call shift_field_0(tlev1,nxfield,ny)
-    call shift_field_0(qvh2,nxfield,ny)
-    call shift_field(ps,nxfield,ny,1,1,2,n)
-    call shift_field(sd,nxfield,ny,1,1,2,n)
-    call shift_field(msl,nxfield,ny,1,1,2,n)
-    call shift_field(tcc,nxfield,ny,1,1,2,n)
-    call shift_field(u10,nxfield,ny,1,1,2,n)
-    call shift_field(v10,nxfield,ny,1,1,2,n)
-    call shift_field(tt2,nxfield,ny,1,1,2,n)
-    call shift_field(td2,nxfield,ny,1,1,2,n)
-    call shift_field(lsprec,nxfield,ny,1,1,2,n)
-    call shift_field(convprec,nxfield,ny,1,1,2,n)
-    call shift_field(sshf,nxfield,ny,1,1,2,n)
-    call shift_field(ssr,nxfield,ny,1,1,2,n)
-    call shift_field(hmix,nxfield,ny,1,1,2,n)
-    call shift_field(tth,nxfield,ny,nuvzmax,nuvz,2,n)
-    call shift_field(qvh,nxfield,ny,nuvzmax,nuvz,2,n)
-    call shift_field(uuh,nxfield,ny,nuvzmax,nuvz,1,1)
-    call shift_field(vvh,nxfield,ny,nuvzmax,nuvz,1,1)
-    call shift_field(wwh,nxfield,ny,nwzmax,nwz,1,1)
-  ! IP & SEC adding GFS Clouds 20181205
-    call shift_field(clwch,nxfield,ny,nuvzmax,nuvz,2,n)
-  endif
-
-  do i=0,nxmin1
-    do j=0,nymin1
-  ! Convert precip. from mm/s -> mm/hour
-      convprec(i,j,1,n)=convprec(i,j,1,n)*3600.
-      lsprec(i,j,1,n)=lsprec(i,j,1,n)*3600.
-      sfcstress(i,j,1,n)=sqrt(ewss(i,j)**2+nsss(i,j)**2)
-    end do
-  end do
-
-  if ((.not.hflswitch).or.(.not.strswitch)) then
-  !  write(*,*) 'WARNING: No flux data contained in GRIB file ',
-  !    +  wfname(indj)
-
-  ! CALCULATE USTAR AND SSHF USING THE PROFILE METHOD
-  !***************************************************************************
-
-    do i=0,nxmin1
-      do j=0,nymin1
-        hlev1=30.0                     ! HEIGHT OF FIRST MODEL SIGMA LAYER
-        ff10m= sqrt(u10(i,j,1,n)**2+v10(i,j,1,n)**2)
-        fflev1=sqrt(ulev1(i,j)**2+vlev1(i,j)**2)
-        call pbl_profile(ps(i,j,1,n),td2(i,j,1,n),hlev1, &
-             tt2(i,j,1,n),tlev1(i,j),ff10m,fflev1, &
-             sfcstress(i,j,1,n),sshf(i,j,1,n))
-        if(sshf(i,j,1,n).gt.200.) sshf(i,j,1,n)=200.
-        if(sshf(i,j,1,n).lt.-400.) sshf(i,j,1,n)=-400.
-      end do
-    end do
-  endif
-
-  if(iumax.ne.nuvz) stop 'READWIND: NUVZ NOT CONSISTENT'
-  if(iumax.ne.nwz)    stop 'READWIND: NWZ NOT CONSISTENT'
-
-  return
-888   write(*,*) ' #### FLEXPART MODEL ERROR! WINDFIELD         #### '
-  write(*,*) ' #### ',wfname(indj),'                    #### '
-  write(*,*) ' #### IS NOT GRIB FORMAT !!!                  #### '
-  stop 'Execution terminated'
-999   write(*,*) ' #### FLEXPART MODEL ERROR! WINDFIELD         #### '
-  write(*,*) ' #### ',wfname(indj),'                    #### '
-  write(*,*) ' #### CANNOT BE OPENED !!!                    #### '
-  stop 'Execution terminated'
-
-end subroutine readwind_gfs
-
-subroutine readwind_nest(indj,n,uuhn,vvhn,wwhn)
-  !                           i   i  o    o    o
-  !*****************************************************************************
-  !                                                                            *
-  !     This routine reads the wind fields for the nested model domains.       *
-  !     It is similar to subroutine readwind, which reads the mother domain.   *
-  !                                                                            *
-  !     Authors: A. Stohl, G. Wotawa                                           *
-  !                                                                            *
-  !     8 February 1999                                                        *
-  !                                                                            *
-  !     Last update: 17 October 2000, A. Stohl                                 *
-  !                                                                            *
-  !*****************************************************************************
-  !  Changes, Bernd C. Krueger, Feb. 2001:                                     *
-  !        Variables tthn and qvhn (on eta coordinates) in common block        *
-  !  CHANGE: 11/01/2008, Harald Sodemann, GRIB1/2 input with ECMWF grib_api    *
-  !  CHANGE: 03/12/2008, Harald Sodemann, update to f90 with ECMWF grib_api    *
-  !*****************************************************************************
-
-  use grib_api
-
-  implicit none
-
-  !HSO  parameters for grib_api
-  integer :: ifile
-  integer :: iret
-  integer :: igrib
-  integer :: gribVer,parCat,parNum,sfctyp,ivalsfc,discipl
-  integer :: parId !!added by mc for making it consistent with new readwind.f90
-  integer :: gotGrid
-  !HSO  end
-
-  real :: uuhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
-  real :: vvhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
-  real :: wwhn(0:nxmaxn-1,0:nymaxn-1,nwzmax,maxnests)
-  integer :: indj,i,j,k,n,levdiff2,ifield,iumax,iwmax,l
-
-  ! VARIABLES AND ARRAYS NEEDED FOR GRIB DECODING
-
-  ! dimension of isec2 at least (22+n), where n is the number of parallels or
-  ! meridians in a quasi-regular (reduced) Gaussian or lat/long grid
-
-  ! dimension of zsec2 at least (10+nn), where nn is the number of vertical
-  ! coordinate parameters
-
-  integer :: isec1(56),isec2(22+nxmaxn+nymaxn)
-  real(kind=4) :: zsec4(jpunp)
-  real(kind=4) :: xaux,yaux
-  real(kind=8) :: xauxin,yauxin
-  real,parameter :: eps=1.e-4
-  real :: ewss(0:nxmaxn-1,0:nymaxn-1),nsss(0:nxmaxn-1,0:nymaxn-1)
-  real :: plev1,pmean,tv,fu,hlev1,ff10m,fflev1
-  real :: conversion_factor !added by mc to make it consistent with new gridchek.f90
-
-  logical :: hflswitch,strswitch
-
-  !HSO  grib api error messages
-  character(len=24) :: gribErrorMsg = 'Error reading grib file'
-  character(len=20) :: gribFunction = 'readwind_nest'
-
-  do l=1,numbnests
-    hflswitch=.false.
-    strswitch=.false.
-    levdiff2=nlev_ec-nwz+1
-    iumax=0
-    iwmax=0
-
-    ifile=0
-    igrib=0
-    iret=0
-
-  !
-  ! OPENING OF DATA FILE (GRIB CODE)
-  !
-
-5   call grib_open_file(ifile,path(numpath+2*(l-1)+1) &
-         (1:length(numpath+2*(l-1)+1))//trim(wfnamen(l,indj)),'r')
-    if (iret.ne.GRIB_SUCCESS) then
-      goto 888   ! ERROR DETECTED
-    endif
-    !turn on support for multi fields messages */
-    !call grib_multi_support_on
-
-    gotGrid=0
-    ifield=0
-    do
-      ifield=ifield+1
-      !
-      ! GET NEXT FIELDS
-      !
-      call grib_new_from_file(ifile,igrib,iret)
-      if (iret.eq.GRIB_END_OF_FILE)  then
-        exit    ! EOF DETECTED
-      elseif (iret.ne.GRIB_SUCCESS) then
-        goto 888   ! ERROR DETECTED
-      endif
-
-      !first see if we read GRIB1 or GRIB2
-      call grib_get_int(igrib,'editionNumber',gribVer,iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-
-      if (gribVer.eq.1) then ! GRIB Edition 1
-
-        !print*,'GRiB Edition 1'
-        !read the grib2 identifiers
-        call grib_get_int(igrib,'indicatorOfParameter',isec1(6),iret)
-        call grib_check(iret,gribFunction,gribErrorMsg)
-        call grib_get_int(igrib,'level',isec1(8),iret)
-        call grib_check(iret,gribFunction,gribErrorMsg)
-
-        !change code for etadot to code for omega
-        if (isec1(6).eq.77) then
-          isec1(6)=135
-        endif
-
-        conversion_factor=1.
-
-
-      else
-
-        !print*,'GRiB Edition 2'
-        !read the grib2 identifiers
-        call grib_get_int(igrib,'discipline',discipl,iret)
-        call grib_check(iret,gribFunction,gribErrorMsg)
-        call grib_get_int(igrib,'parameterCategory',parCat,iret)
-        call grib_check(iret,gribFunction,gribErrorMsg)
-        call grib_get_int(igrib,'parameterNumber',parNum,iret)
-        call grib_check(iret,gribFunction,gribErrorMsg)
-        call grib_get_int(igrib,'typeOfFirstFixedSurface',sfctyp,iret)
-        call grib_check(iret,gribFunction,gribErrorMsg)
-        call grib_get_int(igrib,'level',ivalsfc,iret)
-        call grib_check(iret,gribFunction,gribErrorMsg)
-        call grib_get_int(igrib,'paramId',parId,iret) !added by mc to make it consisitent with new readwind.f90
-        call grib_check(iret,gribFunction,gribErrorMsg) !added by mc to make it consisitent with new readwind.f90
-
-        !print*,discipl,parCat,parNum,sfctyp,ivalsfc
-
-        !convert to grib1 identifiers
-        isec1(6)=-1
-        isec1(7)=-1
-        isec1(8)=-1
-        isec1(8)=ivalsfc     ! level
-         conversion_factor=1.
-        if ((parCat.eq.0).and.(parNum.eq.0).and.(sfctyp.eq.105)) then ! T
-          isec1(6)=130         ! indicatorOfParameter
-        elseif ((parCat.eq.2).and.(parNum.eq.2).and.(sfctyp.eq.105)) then ! U
-          isec1(6)=131         ! indicatorOfParameter
-        elseif ((parCat.eq.2).and.(parNum.eq.3).and.(sfctyp.eq.105)) then ! V
-          isec1(6)=132         ! indicatorOfParameter
-        elseif ((parCat.eq.1).and.(parNum.eq.0).and.(sfctyp.eq.105)) then ! Q
-          isec1(6)=133         ! indicatorOfParameter
-        ! ESO Cloud water is in a) fields CLWC and CIWC, *or* b) field QC 
-        elseif ((parCat.eq.1).and.(parNum.eq.83).and.(sfctyp.eq.105)) then ! clwc
-            isec1(6)=246         ! indicatorOfParameter
-        elseif ((parCat.eq.1).and.(parNum.eq.84).and.(sfctyp.eq.105)) then ! ciwc
-            isec1(6)=247         ! indicatorOfParameter
-        ! ESO qc(=clwc+ciwc):
-        elseif ((parCat.eq.201).and.(parNum.eq.31).and.(sfctyp.eq.105)) then ! qc
-            isec1(6)=201031         ! indicatorOfParameter
-        elseif ((parCat.eq.3).and.(parNum.eq.0).and.(sfctyp.eq.1)) then !SP
-          isec1(6)=134         ! indicatorOfParameter
-        elseif ((parCat.eq.2).and.(parNum.eq.32)) then ! W, actually eta dot !
-          isec1(6)=135         ! indicatorOfParameter
-        elseif ((parCat.eq.128).and.(parNum.eq.77)) then ! W, actually eta dot !added by mc to make it consisitent with new readwind.f90
-          isec1(6)=135         ! indicatorOfParameter    !added by mc to make it consisitent with new readwind.f90
-        elseif ((parCat.eq.3).and.(parNum.eq.0).and.(sfctyp.eq.101)) then !SLP
-          isec1(6)=151         ! indicatorOfParameter
-        elseif ((parCat.eq.2).and.(parNum.eq.2).and.(sfctyp.eq.103)) then ! 10U
-          isec1(6)=165         ! indicatorOfParameter
-        elseif ((parCat.eq.2).and.(parNum.eq.3).and.(sfctyp.eq.103)) then ! 10V
-          isec1(6)=166         ! indicatorOfParameter
-        elseif ((parCat.eq.0).and.(parNum.eq.0).and.(sfctyp.eq.103)) then ! 2T
-          isec1(6)=167         ! indicatorOfParameter
-        elseif ((parCat.eq.0).and.(parNum.eq.6).and.(sfctyp.eq.103)) then ! 2D
-          isec1(6)=168         ! indicatorOfParameter
-        elseif ((parCat.eq.1).and.(parNum.eq.11).and.(sfctyp.eq.1)) then ! SD
-          isec1(6)=141         ! indicatorOfParameter
-          conversion_factor=1000. !added by mc to make it consisitent with new readwind.f90
-        elseif ((parCat.eq.6).and.(parNum.eq.1) .or. parId .eq. 164) then ! CC !added by mc to make it consisitent with new readwind.f90
-          isec1(6)=164         ! indicatorOfParameter
-        elseif ((parCat.eq.1).and.(parNum.eq.9) .or. parId .eq. 142) then ! LSP !added by mc to make it consisitent with new readwind.f90
-          isec1(6)=142         ! indicatorOfParameter
-        elseif ((parCat.eq.1).and.(parNum.eq.10)) then ! CP
-          isec1(6)=143         ! indicatorOfParameter
-          conversion_factor=1000. !added by mc to make it consisitent with new readwind.f90
-        elseif ((parCat.eq.0).and.(parNum.eq.11).and.(sfctyp.eq.1)) then ! SHF
-          isec1(6)=146         ! indicatorOfParameter
-        elseif ((parCat.eq.4).and.(parNum.eq.9).and.(sfctyp.eq.1)) then ! SR
-          isec1(6)=176         ! indicatorOfParameter
-        elseif ((parCat.eq.2).and.(parNum.eq.38) .or. parId .eq. 180) then ! EWSS !added by mc to make it consisitent with new readwind.f90
-          isec1(6)=180         ! indicatorOfParameter
-        elseif ((parCat.eq.2).and.(parNum.eq.37) .or. parId .eq. 181) then ! NSSS !added by mc to make it consisitent with new readwind.f90
-          isec1(6)=181         ! indicatorOfParameter
-        elseif ((parCat.eq.3).and.(parNum.eq.4)) then ! ORO
-          isec1(6)=129         ! indicatorOfParameter
-        elseif ((parCat.eq.3).and.(parNum.eq.7) .or. parId .eq. 160) then ! SDO !added by mc to make it consisitent with new readwind.f90
-          isec1(6)=160         ! indicatorOfParameter
-        elseif ((discipl.eq.2).and.(parCat.eq.0).and.(parNum.eq.0).and. &
-             (sfctyp.eq.1)) then ! LSM
-          isec1(6)=172         ! indicatorOfParameter
-        elseif (parNum.eq.152) then 
-            isec1(6)=152         ! avoid warning for lnsp       
-        else
-          print*,'***WARNING: undefined GRiB2 message found!',discipl, &
-               parCat,parNum,sfctyp
-        endif
-        if(parId .ne. isec1(6) .and. parId .ne. 77) then !added by mc to make it consisitent with new readwind.f90
-          write(*,*) 'parId',parId, 'isec1(6)',isec1(6)  !
-        !    stop
-        endif
-
-      endif
-
-      !HSO  get the size and data of the values array
-      if (isec1(6).ne.-1) then
-        call grib_get_real4_array(igrib,'values',zsec4,iret)
-        call grib_check(iret,gribFunction,gribErrorMsg)
-      endif
-
-      !HSO  get the required fields from section 2 in a gribex compatible manner
-      if(ifield.eq.1) then
-      call grib_get_int(igrib,'numberOfPointsAlongAParallel', &
-           isec2(2),iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-      call grib_get_int(igrib,'numberOfPointsAlongAMeridian', &
-           isec2(3),iret)
-      call grib_check(iret,gribFunction,gribErrorMsg)
-      call grib_get_int(igrib,'numberOfVerticalCoordinateValues', &
-           isec2(12))
-      call grib_check(iret,gribFunction,gribErrorMsg)
-      ! CHECK GRID SPECIFICATIONS
-      if(isec2(2).ne.nxn(l)) stop &
-      'READWIND: NX NOT CONSISTENT FOR A NESTING LEVEL'
-      if(isec2(3).ne.nyn(l)) stop &
-      'READWIND: NY NOT CONSISTENT FOR A NESTING LEVEL'
-      if(isec2(12)/2-1.ne.nlev_ec) stop 'READWIND: VERTICAL DISCRET&
-           &IZATION NOT CONSISTENT FOR A NESTING LEVEL'
-      endif ! ifield
-
-      !HSO  get the second part of the grid dimensions only from GRiB1 messages
-      if (isec1(6) .eq. 167 .and. (gotGrid.eq.0)) then ! !added by mc to make it consisitent with new readwind.f90
-        call grib_get_real8(igrib,'longitudeOfFirstGridPointInDegrees', &
-             xauxin,iret)
-        call grib_check(iret,gribFunction,gribErrorMsg)
-        call grib_get_real8(igrib,'latitudeOfLastGridPointInDegrees', &
-             yauxin,iret)
-        call grib_check(iret,gribFunction,gribErrorMsg)
-        if (xauxin.gt.180.) xauxin=xauxin-360.0
-        if (xauxin.lt.-180.) xauxin=xauxin+360.0
-
-        xaux=xauxin
-        yaux=yauxin
-        if (abs(xaux-xlon0n(l)).gt.eps) &
-        stop 'READWIND: LOWER LEFT LONGITUDE NOT CONSISTENT FOR A NESTING LEVEL'
-        if (abs(yaux-ylat0n(l)).gt.eps) &
-        stop 'READWIND: LOWER LEFT LATITUDE NOT CONSISTENT FOR A NESTING LEVEL'
-        gotGrid=1
-      endif
-
-      do j=0,nyn(l)-1
-        do i=0,nxn(l)-1
-          k=isec1(8)
-          if(isec1(6).eq.130) tthn(i,j,nlev_ec-k+2,n,l)= &!! TEMPERATURE
-               zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
-          if(isec1(6).eq.131) uuhn(i,j,nlev_ec-k+2,l)= &!! U VELOCITY
-               zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
-          if(isec1(6).eq.132) vvhn(i,j,nlev_ec-k+2,l)= &!! V VELOCITY
-               zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
-          if(isec1(6).eq.133) then                         !! SPEC. HUMIDITY
-            qvhn(i,j,nlev_ec-k+2,n,l)=zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
-            if (qvhn(i,j,nlev_ec-k+2,n,l) .lt. 0.) &
-                 qvhn(i,j,nlev_ec-k+2,n,l) = 0.
-    !          this is necessary because the gridded data may contain
-    !          spurious negative values
-          endif
-          if(isec1(6).eq.134) psn(i,j,1,n,l)= &!! SURF. PRESS.
-               zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
-          if(isec1(6).eq.135) wwhn(i,j,nlev_ec-k+1,l)= &!! W VELOCITY
-               zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
-          if(isec1(6).eq.141) sdn(i,j,1,n,l)= &!! SNOW DEPTH
-               zsec4(nxn(l)*(nyn(l)-j-1)+i+1)/conversion_factor !added by mc to make it consisitent with new readwind.f90!
-          if(isec1(6).eq.151) msln(i,j,1,n,l)= &!! SEA LEVEL PRESS.
-               zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
-          if(isec1(6).eq.164) tccn(i,j,1,n,l)= &!! CLOUD COVER
-               zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
-          if(isec1(6).eq.165) u10n(i,j,1,n,l)= &!! 10 M U VELOCITY
-               zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
-          if(isec1(6).eq.166) v10n(i,j,1,n,l)= &!! 10 M V VELOCITY
-               zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
-          if(isec1(6).eq.167) tt2n(i,j,1,n,l)= &!! 2 M TEMPERATURE
-               zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
-          if(isec1(6).eq.168) td2n(i,j,1,n,l)= &!! 2 M DEW POINT
-               zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
-          if(isec1(6).eq.142) then                         !! LARGE SCALE PREC.
-            lsprecn(i,j,1,n,l)=zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
-            if (lsprecn(i,j,1,n,l).lt.0.) lsprecn(i,j,1,n,l)=0.
-          endif
-          if(isec1(6).eq.143) then                         !! CONVECTIVE PREC.
-            convprecn(i,j,1,n,l)=zsec4(nxn(l)*(nyn(l)-j-1)+i+1)/conversion_factor !added by mc to make it consisitent with new readwind.f90
-            if (convprecn(i,j,1,n,l).lt.0.) convprecn(i,j,1,n,l)=0.
-          endif
-          if(isec1(6).eq.146) sshfn(i,j,1,n,l)= &!! SENS. HEAT FLUX
-               zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
-          if((isec1(6).eq.146).and. &
-               (zsec4(nxn(l)*(nyn(l)-j-1)+i+1).ne.0.)) hflswitch=.true.    ! Heat flux available
-          if(isec1(6).eq.176) then                         !! SOLAR RADIATION
-            ssrn(i,j,1,n,l)=zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
-            if (ssrn(i,j,1,n,l).lt.0.) ssrn(i,j,1,n,l)=0.
-          endif
-          if(isec1(6).eq.180) ewss(i,j)= &!! EW SURFACE STRESS
-               zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
-          if(isec1(6).eq.181) nsss(i,j)= &!! NS SURFACE STRESS
-               zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
-          if(((isec1(6).eq.180).or.(isec1(6).eq.181)).and. &
-               (zsec4(nxn(l)*(nyn(l)-j-1)+i+1).ne.0.)) strswitch=.true.    ! stress available
-          if(isec1(6).eq.129) oron(i,j,l)= &!! ECMWF OROGRAPHY
-               zsec4(nxn(l)*(nyn(l)-j-1)+i+1)/ga
-          if(isec1(6).eq.160) excessoron(i,j,l)= &!! STANDARD DEVIATION OF OROGRAPHY
-               zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
-          if(isec1(6).eq.172) lsmn(i,j,l)= &!! ECMWF LAND SEA MASK
-               zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
-          if(isec1(6).eq.131) iumax=max(iumax,nlev_ec-k+1)
-          if(isec1(6).eq.135) iwmax=max(iwmax,nlev_ec-k+1)
-
-    ! ESO TODO:
-    ! -add check for if one of clwc/ciwc missing (error),
-    !    also if all 3 cw fields present, use qc and disregard the others
-          if(isec1(6).eq.246) then  !! CLWC  Cloud liquid water content [kg/kg]
-            clwchn(i,j,nlev_ec-k+2,n,l)=zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
-            readclouds_nest(l)=.true.
-            sumclouds_nest(l)=.false.
-          endif
-          if(isec1(6).eq.247) then  !! CIWC  Cloud ice water content
-            ciwchn(i,j,nlev_ec-k+2,n,l)=zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
-          endif
-    !ZHG end
-    !ESO read qc (=clwc+ciwc)
-          if(isec1(6).eq.201031) then  !! QC  Cloud liquid water content [kg/kg]
-            clwchn(i,j,nlev_ec-k+2,n,l)=zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
-            readclouds_nest(l)=.true.
-            sumclouds_nest(l)=.true.
-          endif
-
-
-        end do
-      end do
-
-      call grib_release(igrib)
-    end do                      !! READ NEXT LEVEL OR PARAMETER
-  !
-  ! CLOSING OF INPUT DATA FILE
-  !
-    call grib_close_file(ifile)
-
-    !error message if no fields found with correct first longitude in it
-    if (gotGrid.eq.0) then
-      print*,'***ERROR: input file needs to contain GRiB1 formatted'// &
-           'messages'
-      stop
-    endif
-
-    if(levdiff2.eq.0) then
-      iwmax=nlev_ec+1
-      do i=0,nxn(l)-1
-        do j=0,nyn(l)-1
-          wwhn(i,j,nlev_ec+1,l)=0.
-        end do
-      end do
-    endif
-
-    do i=0,nxn(l)-1
-      do j=0,nyn(l)-1
-        sfcstressn(i,j,1,n,l)=sqrt(ewss(i,j)**2+nsss(i,j)**2)
-      end do
-    end do
-
-    if ((.not.hflswitch).or.(.not.strswitch)) then
-      write(*,*) 'WARNING: No flux data contained in GRIB file ', &
-           wfnamen(l,indj)
-
-    ! CALCULATE USTAR AND SSHF USING THE PROFILE METHOD
-    ! As ECMWF has increased the model resolution, such that now the first model
-    ! level is at about 10 m (where 10-m wind is given), use the 2nd ECMWF level
-    ! (3rd model level in FLEXPART) for the profile method
-    !***************************************************************************
-
-      do i=0,nxn(l)-1
-        do j=0,nyn(l)-1
-          plev1=akz(3)+bkz(3)*psn(i,j,1,n,l)
-          pmean=0.5*(psn(i,j,1,n,l)+plev1)
-          tv=tthn(i,j,3,n,l)*(1.+0.61*qvhn(i,j,3,n,l))
-          fu=-r_air*tv/ga/pmean
-          hlev1=fu*(plev1-psn(i,j,1,n,l))   ! HEIGTH OF FIRST MODEL LAYER
-          ff10m= sqrt(u10n(i,j,1,n,l)**2+v10n(i,j,1,n,l)**2)
-          fflev1=sqrt(uuhn(i,j,3,l)**2+vvhn(i,j,3,l)**2)
-          call pbl_profile(psn(i,j,1,n,l),td2n(i,j,1,n,l),hlev1, &
-               tt2n(i,j,1,n,l),tthn(i,j,3,n,l),ff10m,fflev1, &
-               sfcstressn(i,j,1,n,l),sshfn(i,j,1,n,l))
-          if(sshfn(i,j,1,n,l).gt.200.) sshfn(i,j,1,n,l)=200.
-          if(sshfn(i,j,1,n,l).lt.-400.) sshfn(i,j,1,n,l)=-400.
-        end do
-      end do
-    endif
-
-
-  ! Assign 10 m wind to model level at eta=1.0 to have one additional model
-  ! level at the ground
-  ! Specific humidity is taken the same as at one level above
-  ! Temperature is taken as 2 m temperature
-  !**************************************************************************
-
-    do i=0,nxn(l)-1
-      do j=0,nyn(l)-1
-        uuhn(i,j,1,l)=u10n(i,j,1,n,l)
-        vvhn(i,j,1,l)=v10n(i,j,1,n,l)
-        qvhn(i,j,1,n,l)=qvhn(i,j,2,n,l)
-        tthn(i,j,1,n,l)=tt2n(i,j,1,n,l)
-      end do
-    end do
-
-    if(iumax.ne.nuvz-1) stop &
-         'READWIND: NUVZ NOT CONSISTENT FOR A NESTING LEVEL'
-    if(iwmax.ne.nwz) stop &
-         'READWIND: NWZ NOT CONSISTENT FOR A NESTING LEVEL'
-
-  end do
-
-  return
-888   write(*,*) ' #### FLEXPART MODEL ERROR! WINDFIELD         #### '
-  write(*,*) ' #### ',wfnamen(l,indj),' FOR NESTING LEVEL  #### '
-  write(*,*) ' #### ',l,' IS NOT GRIB FORMAT !!!           #### '
-  stop 'Execution terminated'
-
-
-999   write(*,*) ' #### FLEXPART MODEL ERROR! WINDFIELD         #### '
-  write(*,*) ' #### ',wfnamen(l,indj),'                    #### '
-  write(*,*) ' #### CANNOT BE OPENED FOR NESTING LEVEL ',l,'####'
-
-end subroutine readwind_nest
-
-subroutine shift_field_0(field,nxf,nyf)
-  !                          i/o   i   i
-  !*****************************************************************************
-  !                                                                            *
-  !  This subroutine shifts global fields by nxshift grid cells, in order to   *
-  !  facilitate all sorts of nested wind fields, or output grids, which,       *
-  !  without shifting, would overlap with the domain "boundary".               *
-  !                                                                            *
-  !    Author: A. Stohl                                                        *
-  !                                                                            *
-  !    3 July 2002                                                             *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  !                                                                            *
-  ! Constants:                                                                 *
-  !                                                                            *
-  !*****************************************************************************
-
-  implicit none
-
-  integer :: nxf,nyf,ix,jy,ixs
-  real :: field(0:nxmax-1,0:nymax-1),xshiftaux(0:nxmax-1)
-
-  ! Loop over y and z
-  !******************
-
-  do jy=0,nyf-1
-
-  ! Shift the data
-  !***************
-
-    if (nxshift.ne.0) then
-      do ix=0,nxf-1
-        if (ix.ge.nxshift) then
-          ixs=ix-nxshift
-        else
-          ixs=nxf-nxshift+ix
-        endif
-        xshiftaux(ixs)=field(ix,jy)
-      end do
-      do ix=0,nxf-1
-        field(ix,jy)=xshiftaux(ix)
-      end do
-    endif
-
-  ! Repeat the westernmost grid cells at the easternmost domain "boundary"
-  !***********************************************************************
-
-    field(nxf,jy)=field(0,jy)
-  end do
-
-  return
-end subroutine shift_field_0
-
-subroutine shift_field(field,nxf,nyf,nzfmax,nzf,nmax,n)
-  !                        i/o   i   i    i     i   i   i
-  !*****************************************************************************
-  !                                                                            *
-  !  This subroutine shifts global fields by nxshift grid cells, in order to   *
-  !  facilitate all sorts of nested wind fields, or output grids, which,       *
-  !  without shifting, would overlap with the domain "boundary".               *
-  !                                                                            *
-  !    Author: A. Stohl                                                        *
-  !                                                                            *
-  !    3 July 2002                                                             *
-  !                                                                            *
-  !*****************************************************************************
-  !                                                                            *
-  ! Variables:                                                                 *
-  !                                                                            *
-  ! Constants:                                                                 *
-  !                                                                            *
-  !*****************************************************************************
-
-  implicit none
-
-  integer :: nxf,nyf,nzf,n,ix,jy,kz,ixs,nzfmax,nmax
-  real :: field(0:nxmax-1,0:nymax-1,nzfmax,nmax),xshiftaux(0:nxmax-1)
-
-  ! Loop over y and z
-  !******************
-
-  do kz=1,nzf
-    do jy=0,nyf-1
-
-  ! Shift the data
-  !***************
-
-      if (nxshift.ne.0) then
-        do ix=0,nxf-1
-          if (ix.ge.nxshift) then
-            ixs=ix-nxshift
-          else
-            ixs=nxf-nxshift+ix
-          endif
-          xshiftaux(ixs)=field(ix,jy,kz,n)
-        end do
-        do ix=0,nxf-1
-          field(ix,jy,kz,n)=xshiftaux(ix)
-        end do
-      endif
-
-  ! Repeat the westernmost grid cells at the easternmost domain "boundary"
-  !***********************************************************************
-
-      field(nxf,jy,kz,n)=field(0,jy,kz,n)
-    end do
-  end do
-end subroutine shift_field
-
-subroutine fixedfields_alloc
-
-  allocate(oro(0:nxmax-1,0:nymax-1))
-  allocate(excessoro(0:nxmax-1,0:nymax-1))
-  allocate(lsm(0:nxmax-1,0:nymax-1))
-  allocate(pv(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
-
-end subroutine fixedfields_alloc
-
-subroutine alloc_windf
-
-  ! Eta coordinates
-  !****************
-  allocate(uueta(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
-  allocate(vveta(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
-  allocate(wweta(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
-  allocate(uupoleta(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
-  allocate(vvpoleta(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
-  allocate(tteta(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
-  allocate(pveta(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
-  allocate(prseta(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
-  allocate(rhoeta(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
-  allocate(drhodzeta(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
-  !allocate(tvirtual(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
-  allocate(etauvheight(0:nxmax-1,0:nymax-1,nuvzmax,numwfmem))
-  allocate(etawheight(0:nxmax-1,0:nymax-1,nuvzmax,numwfmem))
-
-  ! Intrinsic coordinates
-  !**********************
-  allocate(uu(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
-  allocate(vv(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
-  allocate(ww(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
-  allocate(uupol(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
-  allocate(vvpol(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
-  allocate(tt(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
-  allocate(tth(0:nxmax-1,0:nymax-1,nuvzmax,numwfmem))
-  allocate(qv(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
-  allocate(qvh(0:nxmax-1,0:nymax-1,nuvzmax,numwfmem))
-  allocate(rho(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
-  allocate(drhodz(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
-  allocate(pplev(0:nxmax-1,0:nymax-1,nuvzmax,numwfmem))
-  allocate(prs(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
-  allocate(rho_dry(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
-
-  ! Cloud data
-  !***********
-  allocate(clwc(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
-  allocate(ciwc(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
-  allocate(clw(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
-  allocate(clwch(0:nxmax-1,0:nymax-1,nuvzmax,numwfmem))
-  allocate(ciwch(0:nxmax-1,0:nymax-1,nuvzmax,numwfmem))
-  clwc=0.0
-  ciwc=0.0
-  clw=0.0
-  clwch=0.0
-  ciwch=0.0
-  allocate(ctwc(0:nxmax-1,0:nymax-1,numwfmem))
-  allocate(cloudsh(0:nxmax-1,0:nymax-1,numwfmem))
-  allocate(clouds(0:nxmax-1,0:nymax-1,nzmax,numwfmem))
-
-  ! 2d fields
-  !**********
-  allocate(ps(0:nxmax-1,0:nymax-1,1,numwfmem))
-  allocate(sd(0:nxmax-1,0:nymax-1,1,numwfmem))
-  allocate(msl(0:nxmax-1,0:nymax-1,1,numwfmem))
-  allocate(tcc(0:nxmax-1,0:nymax-1,1,numwfmem))
-  allocate(u10(0:nxmax-1,0:nymax-1,1,numwfmem))
-  allocate(v10(0:nxmax-1,0:nymax-1,1,numwfmem))
-  allocate(tt2(0:nxmax-1,0:nymax-1,1,numwfmem))
-  allocate(td2(0:nxmax-1,0:nymax-1,1,numwfmem))
-  allocate(lsprec(0:nxmax-1,0:nymax-1,1,numwfmem))
-  allocate(convprec(0:nxmax-1,0:nymax-1,1,numwfmem))
-  allocate(sshf(0:nxmax-1,0:nymax-1,1,numwfmem))
-  allocate(ssr(0:nxmax-1,0:nymax-1,1,numwfmem))
-  allocate(sfcstress(0:nxmax-1,0:nymax-1,1,numwfmem))
-  allocate(ustar(0:nxmax-1,0:nymax-1,1,numwfmem))
-  allocate(wstar(0:nxmax-1,0:nymax-1,1,numwfmem))
-  allocate(hmix(0:nxmax-1,0:nymax-1,1,numwfmem))
-  allocate(tropopause(0:nxmax-1,0:nymax-1,1,numwfmem))
-  allocate(oli(0:nxmax-1,0:nymax-1,1,numwfmem))
-
-  ! Vertical descritisation arrays
-  !*******************************
-  allocate(height(nzmax),wheight(nzmax),uvheight(nzmax))
-  allocate(akm(nwzmax),bkm(nwzmax),akz(nuvzmax),bkz(nuvzmax), &
-    aknew(nzmax),bknew(nzmax))
-    
-end subroutine alloc_windf
-
-subroutine alloc_windf_nest
-!****************************************************************************   
-! Dynamic allocation of arrays
-!
-! For nested wind fields. 
-! 
-!****************************************************************************
-
-  allocate(wfnamen(maxnests,maxwf))
-  allocate(wfspecn(maxnests,maxwf))
-
-  allocate(nxn(maxnests))
-  allocate(nyn(maxnests))
-  allocate(dxn(maxnests))
-  allocate(dyn(maxnests))
-  allocate(xlon0n(maxnests))
-  allocate(ylat0n(maxnests))
-
-  allocate(oron(0:nxmaxn-1,0:nymaxn-1,maxnests))
-  allocate(excessoron(0:nxmaxn-1,0:nymaxn-1,maxnests))
-  allocate(lsmn(0:nxmaxn-1,0:nymaxn-1,maxnests))
-
-  allocate(uun(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests))
-  allocate(vvn(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests))
-  allocate(wwn(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests))
-  allocate(ttn(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests))
-  allocate(qvn(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests))
-  allocate(pvn(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests))
-  allocate(clwcn(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests))
-  allocate(ciwcn(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests))
-  allocate(clwn(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests))
-
-  ! ETA equivalents
-  allocate(uuetan(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests))
-  allocate(vvetan(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests))
-  allocate(wwetan(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests))
-  allocate(ttetan(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests))
-  allocate(pvetan(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests)) 
-  allocate(prsetan(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests))  
-  allocate(rhoetan(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests))
-  allocate(drhodzetan(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests))
-  ! allocate(tvirtualn(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests))
-  allocate(etauvheightn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,numwfmem,numbnests))
-  allocate(etawheightn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,numwfmem,numbnests))
-
-  allocate(cloudsn(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests))
-  allocate(cloudshn(0:nxmaxn-1,0:nymaxn-1,numwfmem,numbnests))
-  allocate(prsn(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests))
-  allocate(rhon(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests))
-  allocate(drhodzn(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests))
-  allocate(tthn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,numwfmem,numbnests))
-  allocate(qvhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,numwfmem,numbnests))
-  allocate(clwchn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,numwfmem,numbnests))
-  allocate(ciwchn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,numwfmem,numbnests))
-  allocate(ctwcn(0:nxmaxn-1,0:nymaxn-1,numwfmem,numbnests))
-
-  ! 2d fields
-  !***********
-  allocate(psn(0:nxmaxn-1,0:nymaxn-1,1,numwfmem,maxnests))
-  allocate(sdn(0:nxmaxn-1,0:nymaxn-1,1,numwfmem,maxnests))
-  allocate(msln(0:nxmaxn-1,0:nymaxn-1,1,numwfmem,maxnests))
-  allocate(tccn(0:nxmaxn-1,0:nymaxn-1,1,numwfmem,maxnests))
-  allocate(u10n(0:nxmaxn-1,0:nymaxn-1,1,numwfmem,maxnests))
-  allocate(v10n(0:nxmaxn-1,0:nymaxn-1,1,numwfmem,maxnests))
-  allocate(tt2n(0:nxmaxn-1,0:nymaxn-1,1,numwfmem,maxnests))
-  allocate(td2n(0:nxmaxn-1,0:nymaxn-1,1,numwfmem,maxnests))
-  allocate(lsprecn(0:nxmaxn-1,0:nymaxn-1,1,numwfmem,maxnests))
-  allocate(convprecn(0:nxmaxn-1,0:nymaxn-1,1,numwfmem,maxnests))
-  allocate(sshfn(0:nxmaxn-1,0:nymaxn-1,1,numwfmem,maxnests))
-  allocate(ssrn(0:nxmaxn-1,0:nymaxn-1,1,numwfmem,maxnests))
-  allocate(sfcstressn(0:nxmaxn-1,0:nymaxn-1,1,numwfmem,maxnests))
-  allocate(ustarn(0:nxmaxn-1,0:nymaxn-1,1,numwfmem,maxnests))
-  allocate(wstarn(0:nxmaxn-1,0:nymaxn-1,1,numwfmem,maxnests))
-  allocate(hmixn(0:nxmaxn-1,0:nymaxn-1,1,numwfmem,maxnests))
-  allocate(tropopausen(0:nxmaxn-1,0:nymaxn-1,1,numwfmem,maxnests))
-  allocate(olin(0:nxmaxn-1,0:nymaxn-1,1,numwfmem,maxnests))
-  allocate(vdepn(0:nxmaxn-1,0:nymaxn-1,maxspec,numwfmem,maxnests))
+#include "win_readwind_gfs.f90"
 
-  allocate(xresoln(0:maxnests))
-  allocate(yresoln(0:maxnests))
-  allocate(xln(maxnests))
-  allocate(yln(maxnests))
-  allocate(xrn(maxnests))
-  allocate(yrn(maxnests))
+#include "win_readwind_nest.f90"
 
-  ! Initialise
-  !************  
-  clwcn(:,:,:,:,:)=0.
-  ciwcn(:,:,:,:,:)=0.
-  clwchn(:,:,:,:,:)=0.
-  ciwchn(:,:,:,:,:)=0.
+#include "win_shift_field_0.f90"
 
-end subroutine alloc_windf_nest
+#include "win_shift_field.f90"
 
-subroutine dealloc_windf_nest
-  
-  deallocate(wfnamen,wfspecn)
-  deallocate(nxn,nyn,dxn,dyn,xlon0n,ylat0n)
-  deallocate(oron,excessoron,lsmn)
-  deallocate(uun,vvn,wwn,ttn,qvn,pvn,clwcn,ciwcn,clwn,cloudsn, &
-    cloudshn,rhon,prsn,drhodzn,tthn,qvhn,clwchn,ciwchn,ctwcn)
-  deallocate(uuetan,vvetan,wwetan,ttetan,pvetan,prsetan,rhoetan, &
-    drhodzetan,etauvheightn,etawheightn)
-  deallocate(psn,sdn,msln,tccn,u10n,v10n,tt2n,td2n,lsprecn,convprecn, &
-    sshfn,ssrn,sfcstressn,ustarn,wstarn,hmixn,tropopausen,olin,vdepn)
-  deallocate(xresoln,yresoln,xln,yln,xrn,yrn)
+#include "win_fixedfields_alloc.f90"
 
-end subroutine dealloc_windf_nest
+#include "win_alloc_windf.f90"
 
-subroutine dealloc_windf
+#include "win_alloc_windf_nest.f90"
 
-  deallocate(oro,excessoro,lsm)
-  deallocate(uueta,vveta,wweta,uupoleta,vvpoleta,tteta,pveta, &
-    prseta,rhoeta,drhodzeta,etauvheight,etawheight)
-  deallocate(uu,vv,ww,uupol,vvpol,tt,tth,qv,qvh,pv,rho,drhodz,pplev,prs,rho_dry)
-  deallocate(clwc,ciwc,clw,clwch,ciwch,ctwc,cloudsh,clouds)
-  deallocate(ps,sd,msl,tcc,u10,v10,tt2,td2,lsprec,convprec,sshf,ssr,sfcstress, &
-    ustar,wstar,hmix,tropopause,oli)
-  deallocate(height,wheight,uvheight,akm,bkm,akz,bkz,aknew,bknew)
+#include "win_dealloc_windf_nest.f90"
 
-end subroutine dealloc_windf
+#include "win_dealloc_windf.f90"
 
 end module windfields_mod
diff --git a/src/xmass_mod.f90 b/src/xmass_mod.f90
index 7af9a0c1db7d26a508d40fe2f72db54c200cd443..0be8d88a826d5123487a591294bc5ea354bc6b8d 100644
--- a/src/xmass_mod.f90
+++ b/src/xmass_mod.f90
@@ -2,9 +2,9 @@
 ! SPDX-License-Identifier: GPL-3.0-or-later
 
 module xmass_mod
-  
+
   implicit none
-  
+
   real,allocatable, dimension (:) :: xmasssave
-  
+
 end module xmass_mod