mptrac.c

Go to the documentation of this file.

/*
  This file is part of MPTRAC.
 
  MPTRAC is free software: you can redistribute it and/or modify
  it under the terms of the GNU General Public License as published by
  the Free Software Foundation, either version 3 of the License, or
  (at your option) any later version.
 
  MPTRAC is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.
 
  You should have received a copy of the GNU General Public License
  along with MPTRAC. If not, see <http://www.gnu.org/licenses/>.
 
  Copyright (C) 2013-2026 Forschungszentrum Juelich GmbH
*/
 
#include "mptrac.h"
 
#include <limits.h>
 
#ifdef KPP
#include "kpp_chem.h"
#endif
 
static gsl_rng *rng[NTHREADS];
 
static uint64_t rng_ctr;
 
#ifdef CURAND
static curandGenerator_t rng_curand;
#endif
 
/*****************************************************************************/
 
#ifdef MPI
void broadcast_large_data(
  void *data,
  size_t N) {
 
#define CHUNK_SIZE 2147483647
 
  /* Broadcast the size of the data first... */
  MPI_Bcast(&N, 1, MPI_UINT64_T, 0, MPI_COMM_WORLD);
 
  /* Calculate the number of chunks... */
  const size_t num_chunks = (N + CHUNK_SIZE - 1) / CHUNK_SIZE;
 
  /* Loop over chunks... */
  for (size_t i = 0; i < num_chunks; i++) {
 
    /* Determine the start and end indices for the current chunk... */
    const size_t start = i * CHUNK_SIZE;
    const size_t end = (start + CHUNK_SIZE > N) ? N : start + CHUNK_SIZE;
    const size_t chunk_size = end - start;
 
    /* Broadcast the current chunk... */
    MPI_Bcast((char *) data + start, (int) chunk_size, MPI_BYTE, 0,
              MPI_COMM_WORLD);
  }
}
#endif
 
/*****************************************************************************/
 
void cart2geo(
  const double *x,
  double *z,
  double *lon,
  double *lat) {
 
  const double radius = sqrt(DOTP(x, x));
 
  *lat = RAD2DEG(asin(x[2] / radius));
  *lon = RAD2DEG(atan2(x[1], x[0]));
  *z = radius - RE;
}
 
/*****************************************************************************/
 
double clim_oh(
  const ctl_t *ctl,
  const clim_t *clim,
  const double t,
  const double lon,
  const double lat,
  const double p) {
 
  /* Set SZA threshold... */
  const double sza_thresh = DEG2RAD(85.), csza_thresh = cos(sza_thresh);
 
  /* Set reference coordinates... */
  const double lat_ref =
    ctl->met_coord_type == 0 ? lat : ctl->met_utm_ref_lat;
  double lon_ref = ctl->met_coord_type == 0 ? lon : ctl->met_utm_ref_lon;
  while (lon_ref < -180.0)
    lon_ref += 360.0;
  while (lon_ref >= 180.0)
    lon_ref -= 360.0;
 
  /* Get OH data from climatology... */
  const double oh = clim_zm(&clim->oh, t, lat_ref, p);
 
  /* Check beta... */
  if (ctl->oh_chem_beta <= 0)
    return oh;
 
  /* Apply diurnal correction... */
  const double csza = cos_sza(t, lon_ref, lat_ref);
  const double denom = (csza >= csza_thresh) ? csza : csza_thresh;
  return oh * exp(-ctl->oh_chem_beta / denom);
}
 
/*****************************************************************************/
 
void clim_oh_diurnal_correction(
  const ctl_t *ctl,
  clim_t *clim) {
 
  /* Set SZA threshold... */
  const double sza_thresh = DEG2RAD(85.), csza_thresh = cos(sza_thresh);
 
  /* Loop over climatology data points... */
  for (int it = 0; it < clim->oh.ntime; it++)
    for (int iz = 0; iz < clim->oh.np; iz++)
      for (int iy = 0; iy < clim->oh.nlat; iy++) {
 
        /* Init... */
        int n = 0;
        double sum = 0;
 
        /* Integrate day/night correction factor over longitude... */
        for (double lon = -180; lon < 180; lon += 1.0) {
          const double csza =
            cos_sza(clim->oh.time[it], lon, clim->oh.lat[iy]);
          const double denom = (csza >= csza_thresh) ? csza : csza_thresh;
          sum += exp(-ctl->oh_chem_beta / denom);
          n++;
        }
 
        /* Apply scaling factor to OH data... */
        clim->oh.vmr[it][iz][iy] /= (sum / (double) n);
      }
}
 
/*****************************************************************************/
 
double clim_photo(
  const double rate[CP][CSZA][CO3],
  const clim_photo_t *photo,
  const double p,
  const double sza,
  const double o3c) {
 
  /* Check pressure range... */
  double p_help = p;
  if (p < photo->p[photo->np - 1])
    p_help = photo->p[photo->np - 1];
  else if (p > photo->p[0])
    p_help = photo->p[0];
 
  /* Check sza range... */
  double sza_help = sza;
  if (sza < photo->sza[0])
    sza_help = photo->sza[0];
  else if (sza > photo->sza[photo->nsza - 1])
    sza_help = photo->sza[photo->nsza - 1];
 
  /* Check ozone column range... */
  double o3c_help = o3c;
  if (o3c < photo->o3c[0])
    o3c_help = photo->o3c[0];
  else if (o3c > photo->o3c[photo->no3c - 1])
    o3c_help = photo->o3c[photo->no3c - 1];
 
  /* Get indices... */
  const int ip = locate_irr(photo->p, photo->np, p_help);
  const int isza = locate_reg(photo->sza, photo->nsza, sza_help);
  const int io3c = locate_reg(photo->o3c, photo->no3c, o3c_help);
 
  /* Interpolate photolysis rate... */
  const double aux00 = LIN(photo->p[ip], rate[ip][isza][io3c],
                           photo->p[ip + 1], rate[ip + 1][isza][io3c],
                           p_help);
  const double aux01 = LIN(photo->p[ip], rate[ip][isza][io3c + 1],
                           photo->p[ip + 1], rate[ip + 1][isza][io3c + 1],
                           p_help);
  const double aux10 = LIN(photo->p[ip], rate[ip][isza + 1][io3c],
                           photo->p[ip + 1], rate[ip + 1][isza + 1][io3c],
                           p_help);
  const double aux11 = LIN(photo->p[ip], rate[ip][isza + 1][io3c + 1],
                           photo->p[ip + 1], rate[ip + 1][isza + 1][io3c + 1],
                           p_help);
  const double aux0 =
    LIN(photo->o3c[io3c], aux00, photo->o3c[io3c + 1], aux01, o3c_help);
  const double aux1 =
    LIN(photo->o3c[io3c], aux10, photo->o3c[io3c + 1], aux11, o3c_help);
  const double aux =
    LIN(photo->sza[isza], aux0, photo->sza[isza + 1], aux1, sza_help);
  return MAX(aux, 0.0);
}
 
/*****************************************************************************/
 
double clim_tropo(
  const clim_t *clim,
  const double t,
  const double lat) {
 
  /* Get seconds since begin of year... */
  double sec = FMOD(t, 365.25 * 86400.);
  while (sec < 0)
    sec += 365.25 * 86400.;
 
  /* Get indices... */
  const int isec = locate_irr(clim->tropo_time, clim->tropo_ntime, sec);
  const int ilat = locate_reg(clim->tropo_lat, clim->tropo_nlat, lat);
 
  /* Interpolate tropopause pressure... */
  const double p0 = LIN(clim->tropo_lat[ilat],
                        clim->tropo[isec][ilat],
                        clim->tropo_lat[ilat + 1],
                        clim->tropo[isec][ilat + 1], lat);
  const double p1 = LIN(clim->tropo_lat[ilat],
                        clim->tropo[isec + 1][ilat],
                        clim->tropo_lat[ilat + 1],
                        clim->tropo[isec + 1][ilat + 1], lat);
  return LIN(clim->tropo_time[isec], p0, clim->tropo_time[isec + 1], p1, sec);
}
 
/*****************************************************************************/
 
void clim_tropo_init(
  clim_t *clim) {
 
  /* Write info... */
  LOG(1, "Initialize tropopause data...");
 
  /* Set time [s]... */
  clim->tropo_ntime = 12;
  double tropo_time[12] = {
    1209600.00, 3888000.00, 6393600.00,
    9072000.00, 11664000.00, 14342400.00,
    16934400.00, 19612800.00, 22291200.00,
    24883200.00, 27561600.00, 30153600.00
  };
  memcpy(clim->tropo_time, tropo_time, sizeof(clim->tropo_time));
 
  /* Set latitudes [deg]... */
  clim->tropo_nlat = 73;
  const double tropo_lat[73] = {
    -90, -87.5, -85, -82.5, -80, -77.5, -75, -72.5, -70, -67.5,
    -65, -62.5, -60, -57.5, -55, -52.5, -50, -47.5, -45, -42.5,
    -40, -37.5, -35, -32.5, -30, -27.5, -25, -22.5, -20, -17.5,
    -15, -12.5, -10, -7.5, -5, -2.5, 0, 2.5, 5, 7.5, 10, 12.5,
    15, 17.5, 20, 22.5, 25, 27.5, 30, 32.5, 35, 37.5, 40, 42.5,
    45, 47.5, 50, 52.5, 55, 57.5, 60, 62.5, 65, 67.5, 70, 72.5,
    75, 77.5, 80, 82.5, 85, 87.5, 90
  };
  memcpy(clim->tropo_lat, tropo_lat, sizeof(clim->tropo_lat));
 
  /* Set tropopause pressure [hPa] (NCEP/NCAR Reanalysis 1)... */
  const double tropo[12][73] = {
    {324.1, 325.6, 325, 324.3, 322.5, 319.7, 314, 307.2, 301.8, 299.6,
     297.1, 292.2, 285.6, 276.1, 264, 248.9, 231.9, 213.5, 194.4,
     175.3, 157, 140.4, 126.7, 116.3, 109.5, 105.4, 103, 101.4, 100.4,
     99.69, 99.19, 98.84, 98.56, 98.39, 98.39, 98.42, 98.44, 98.54,
     98.68, 98.81, 98.89, 98.96, 99.12, 99.65, 101.4, 105.4, 113.5, 128,
     152.1, 184.7, 214, 234.1, 247.3, 255.8, 262.6, 267.7, 271.7, 275,
     277.2, 279, 280.1, 280.4, 280.6, 280.1, 279.3, 278.3, 276.8, 275.8,
     275.3, 275.6, 275.4, 274.1, 273.5},
    {337.3, 338.7, 337.8, 336.4, 333, 328.8, 321.1, 312.6, 306.6, 303.7,
     300.2, 293.8, 285.4, 273.8, 259.6, 242.7, 224.4, 205.2, 186, 167.5,
     150.3, 135, 122.8, 113.9, 108.2, 104.7, 102.5, 101.1, 100.2, 99.42,
     98.88, 98.52, 98.25, 98.09, 98.07, 98.1, 98.12, 98.2, 98.25, 98.27,
     98.26, 98.27, 98.36, 98.79, 100.2, 104.2, 113.7, 131.2, 159.5, 193,
     220.4, 238.1, 250.2, 258.1, 264.7, 269.7, 273.7, 277.3, 280.2, 282.8,
     284.9, 286.5, 288.1, 288.8, 289, 288.5, 287.2, 286.3, 286.1, 287.2,
     287.5, 286.2, 285.8},
    {335, 336, 335.7, 335.1, 332.3, 328.1, 320.6, 311.8, 305.1, 301.9,
     297.6, 290, 280.4, 268.3, 254.6, 239.6, 223.9, 207.9, 192.2, 176.9,
     161.7, 146.4, 132.2, 120.6, 112.3, 107.2, 104.3, 102.4, 101.3,
     100.4, 99.86, 99.47, 99.16, 98.97, 98.94, 98.97, 99, 99.09, 99.2,
     99.31, 99.35, 99.41, 99.51, 99.86, 101.1, 104.9, 114.3, 131, 156.8,
     186.3, 209.3, 224.6, 236.8, 246.3, 254.9, 262.3, 268.8, 274.8,
     279.9, 284.6, 288.6, 291.6, 294.9, 297.5, 299.8, 301.8, 303.1,
     304.3, 304.9, 306, 306.6, 306.2, 306},
    {306.2, 306.7, 305.7, 307.1, 307.3, 306.4, 301.8, 296.2, 292.4,
     290.3, 287.1, 280.9, 273.4, 264.3, 254.1, 242.8, 231, 219, 207.2,
     195.5, 183.3, 169.7, 154.7, 138.7, 124.1, 113.6, 107.8, 104.7,
     102.8, 101.7, 100.9, 100.4, 100, 99.79, 99.7, 99.66, 99.68, 99.79,
     99.94, 100.2, 100.5, 100.9, 101.4, 102.1, 103.4, 107, 115.2, 129.1,
     148.7, 171, 190.8, 205.6, 218.4, 229.4, 239.6, 248.6, 256.5,
     263.7, 270.3, 276.6, 282.6, 288.1, 294.5, 300.4, 306.3, 311.4,
     315.1, 318.3, 320.3, 322.2, 322.8, 321.5, 321.1},
    {266.5, 264.9, 260.8, 261, 262, 263, 261.3, 259.7, 259.2, 259.8,
     260.1, 258.6, 256.7, 253.6, 249.5, 243.9, 237.4, 230, 222.1, 213.9,
     205, 194.4, 180.4, 161.8, 140.7, 122.9, 112.1, 106.7, 104.1, 102.7,
     101.8, 101.4, 101.1, 101, 101, 101, 101.1, 101.2, 101.5, 101.9,
     102.4, 103, 103.8, 104.9, 106.8, 110.1, 115.6, 124, 135.2, 148.9,
     165.2, 181.3, 198, 211.8, 223.5, 233.8, 242.9, 251.5, 259, 266.2,
     273.1, 279.2, 286.2, 292.8, 299.6, 306, 311.1, 315.5, 318.8, 322.6,
     325.3, 325.8, 325.8},
    {220.1, 218.1, 210.8, 207.2, 207.6, 210.5, 211.4, 213.5, 217.3,
     222.4, 227.9, 232.8, 237.4, 240.8, 242.8, 243, 241.5, 238.6, 234.2,
     228.5, 221, 210.7, 195.1, 172.9, 147.8, 127.6, 115.6, 109.9, 107.1,
     105.7, 105, 104.8, 104.8, 104.9, 105, 105.1, 105.3, 105.5, 105.8,
     106.4, 107, 107.6, 108.1, 108.8, 110, 111.8, 114.2, 117.4, 121.6,
     127.9, 137.3, 151.2, 169.5, 189, 205.8, 218.9, 229.1, 237.8, 245,
     251.5, 257.1, 262.3, 268.2, 274, 280.4, 286.7, 292.4, 297.9, 302.9,
     308.5, 312.2, 313.1, 313.3},
    {187.4, 184.5, 173.3, 166.1, 165.4, 167.8, 169.6, 173.6, 179.6,
     187.9, 198.9, 210, 220.5, 229.2, 235.7, 239.9, 241.8, 241.6, 239.6,
     235.8, 229.4, 218.6, 200.9, 175.9, 149.4, 129.4, 118.3, 113.1,
     110.8, 109.7, 109.3, 109.4, 109.7, 110, 110.2, 110.4, 110.5, 110.7,
     111, 111.4, 111.8, 112.1, 112.3, 112.7, 113.2, 113.9, 115, 116.4,
     117.9, 120.4, 124.1, 130.9, 142.2, 159.6, 179.6, 198.5, 212.9,
     224.2, 232.7, 239.1, 243.8, 247.7, 252.4, 257.3, 263.2, 269.5,
     275.4, 281.1, 286.3, 292, 296.3, 298.2, 298.8},
    {166, 166.4, 155.7, 148.3, 147.1, 149, 152.1, 157, 163.6, 172.4,
     185.3, 199.2, 212.6, 224, 233.2, 239.6, 243.3, 244.6, 243.6, 240.3,
     233.9, 222.6, 203.7, 177, 149.5, 129.7, 119, 114, 111.7, 110.7,
     110.3, 110.3, 110.6, 110.9, 111.1, 111.3, 111.5, 111.6, 111.9,
     112.2, 112.5, 112.6, 112.8, 113, 113.4, 114, 115.1, 116.5, 118.3,
     120.9, 124.4, 130.2, 139.4, 154.6, 173.8, 193.1, 208.1, 220.4,
     230.1, 238.2, 244.7, 249.5, 254.5, 259.3, 264.5, 269.4, 273.7,
     278.2, 282.6, 287.4, 290.9, 292.5, 293},
    {171.9, 172.8, 166.2, 162.3, 161.4, 162.5, 165.2, 169.6, 175.3,
     183.1, 193.8, 205.9, 218.3, 229.6, 238.5, 244.3, 246.9, 246.7,
     243.8, 238.4, 230.2, 217.9, 199.6, 174.9, 148.9, 129.8, 119.5,
     114.8, 112.3, 110.9, 110.3, 110.1, 110.2, 110.3, 110.4, 110.5,
     110.6, 110.8, 111, 111.4, 111.8, 112, 112.2, 112.4, 112.9, 113.6,
     114.7, 116.3, 118.4, 121.9, 127.1, 136.1, 149.8, 168.4, 186.9,
     203.3, 217, 229.1, 238.7, 247, 254, 259.3, 264.3, 268.3, 272.5,
     276.6, 280.4, 284.4, 288.4, 293.3, 297.2, 298.7, 299.1},
    {191.6, 192.2, 189, 188.1, 190.2, 193.7, 197.8, 202.9, 208.5,
     215.6, 224.2, 233.1, 241.2, 247.3, 250.8, 251.3, 248.9, 244.2,
     237.3, 228.4, 217.2, 202.9, 184.5, 162.5, 140.7, 124.8, 116.2,
     111.8, 109.4, 107.9, 107, 106.7, 106.6, 106.6, 106.7, 106.7,
     106.8, 107, 107.4, 108, 108.7, 109.3, 109.8, 110.4, 111.2,
     112.4, 114.2, 116.9, 121.1, 127.9, 139.3, 155.2, 173.6, 190.7,
     206.1, 220.1, 232.3, 243, 251.8, 259.2, 265.7, 270.6, 275.3,
     279.3, 283.3, 286.9, 289.7, 292.8, 296.1, 300.5, 303.9, 304.8,
     305.1},
    {241.5, 239.6, 236.8, 237.4, 239.4, 242.3, 244.2, 246.4, 249.2,
     253.6, 258.6, 262.7, 264.8, 264.2, 260.6, 254.1, 245.5, 235.3,
     223.9, 211.7, 198.3, 183.1, 165.6, 147.1, 130.5, 118.7, 111.9,
     108.1, 105.8, 104.3, 103.4, 102.8, 102.5, 102.4, 102.5, 102.5,
     102.5, 102.7, 103.1, 103.8, 104.6, 105.4, 106.1, 107, 108.2,
     109.9, 112.8, 117.5, 126, 140.4, 161, 181.9, 201.2, 216.8, 230.4,
     241.8, 251.4, 259.9, 266.9, 272.8, 277.4, 280.4, 282.9, 284.6,
     286.1, 287.4, 288.3, 289.5, 290.9, 294.2, 296.9, 297.5, 297.6},
    {301.2, 300.3, 296.6, 295.4, 295, 294.3, 291.2, 287.4, 284.9, 284.7,
     284.1, 281.5, 277.1, 270.4, 261.7, 250.6, 237.6, 223.1, 207.9, 192,
     175.8, 158.8, 142.1, 127.6, 116.8, 109.9, 106, 103.6, 102.1, 101.1,
     100.4, 99.96, 99.6, 99.37, 99.32, 99.32, 99.31, 99.46, 99.77, 100.2,
     100.7, 101.3, 101.8, 102.7, 104.1, 106.8, 111.9, 121, 136.7, 160,
     186.9, 209.9, 228.1, 241.2, 251.5, 259.5, 265.7, 270.9, 274.8, 278,
     280.3, 281.8, 283, 283.3, 283.7, 283.8, 283, 282.2, 281.2, 281.4,
     281.7, 281.1, 281.2}
  };
  memcpy(clim->tropo, tropo, sizeof(clim->tropo));
 
  /* Get range... */
  double tropomin = 1e99, tropomax = -1e99;
  for (int it = 0; it < clim->tropo_ntime; it++)
    for (int iy = 0; iy < clim->tropo_nlat; iy++) {
      tropomin = MIN(tropomin, clim->tropo[it][iy]);
      tropomax = MAX(tropomax, clim->tropo[it][iy]);
    }
 
  /* Write info... */
  LOG(2, "Number of time steps: %d", clim->tropo_ntime);
  LOG(2, "Time steps: %.2f, %.2f ... %.2f s",
      clim->tropo_time[0], clim->tropo_time[1],
      clim->tropo_time[clim->tropo_ntime - 1]);
  LOG(2, "Number of latitudes: %d", clim->tropo_nlat);
  LOG(2, "Latitudes: %g, %g ... %g deg",
      clim->tropo_lat[0], clim->tropo_lat[1],
      clim->tropo_lat[clim->tropo_nlat - 1]);
  LOG(2, "Tropopause altitude range: %g ... %g hPa", Z(tropomax),
      Z(tropomin));
  LOG(2, "Tropopause pressure range: %g ... %g hPa", tropomin, tropomax);
}
 
/*****************************************************************************/
 
double clim_ts(
  const clim_ts_t *ts,
  const double t) {
 
  /* Interpolate... */
  if (t <= ts->time[0])
    return ts->vmr[0];
  else if (t >= ts->time[ts->ntime - 1])
    return ts->vmr[ts->ntime - 1];
  else {
    const int idx = locate_irr(ts->time, ts->ntime, t);
    return LIN(ts->time[idx], ts->vmr[idx],
               ts->time[idx + 1], ts->vmr[idx + 1], t);
  }
}
 
/*****************************************************************************/
 
double clim_zm(
  const clim_zm_t *zm,
  const double t,
  const double lat,
  const double p) {
 
  /* Get seconds since begin of year... */
  double sec = FMOD(t, 365.25 * 86400.);
  while (sec < 0)
    sec += 365.25 * 86400.;
 
  /* Check pressure range... */
  double p_help = p;
  if (p < zm->p[zm->np - 1])
    p_help = zm->p[zm->np - 1];
  else if (p > zm->p[0])
    p_help = zm->p[0];
 
  /* Check latitude range... */
  double lat_help = lat;
  if (lat < zm->lat[0])
    lat_help = zm->lat[0];
  else if (lat > zm->lat[zm->nlat - 1])
    lat_help = zm->lat[zm->nlat - 1];
 
  /* Get indices... */
  const int isec = locate_irr(zm->time, zm->ntime, sec);
  const int ilat = locate_reg(zm->lat, zm->nlat, lat_help);
  const int ip = locate_irr(zm->p, zm->np, p_help);
 
  /* Interpolate climatology data... */
  const double aux00 = LIN(zm->p[ip], zm->vmr[isec][ip][ilat],
                           zm->p[ip + 1], zm->vmr[isec][ip + 1][ilat],
                           p_help);
  const double aux01 = LIN(zm->p[ip], zm->vmr[isec][ip][ilat + 1],
                           zm->p[ip + 1], zm->vmr[isec][ip + 1][ilat + 1],
                           p_help);
  const double aux10 = LIN(zm->p[ip], zm->vmr[isec + 1][ip][ilat],
                           zm->p[ip + 1], zm->vmr[isec + 1][ip + 1][ilat],
                           p_help);
  const double aux11 = LIN(zm->p[ip], zm->vmr[isec + 1][ip][ilat + 1],
                           zm->p[ip + 1], zm->vmr[isec + 1][ip + 1][ilat + 1],
                           p_help);
  const double aux0 =
    LIN(zm->lat[ilat], aux00, zm->lat[ilat + 1], aux01, lat_help);
  const double aux1 =
    LIN(zm->lat[ilat], aux10, zm->lat[ilat + 1], aux11, lat_help);
  const double aux = LIN(zm->time[isec], aux0, zm->time[isec + 1], aux1, sec);
  return MAX(aux, 0.0);
}
 
/*****************************************************************************/
 
#ifdef CMS
void compress_cms(
  const ctl_t *ctl,
  const met_t *met,
  const char *varname,
  float *array,
  const int decompress,
  FILE *level_log,
  FILE *inout) {
 
  const size_t nx = (size_t) met->nx;
  const size_t ny = (size_t) met->ny;
  const size_t np = (size_t) met->np;
  const size_t nxy = nx * ny;
 
  /* Get meteo variable... */
  const int metvar = compress_metvar_index(varname);
 
  /* Set lon-lat grid... */
  double lon[EX], lat[EY];
  for (size_t ix = 0; ix < nx; ix++)
    lon[ix] = 360. * (double) ix / ((double) nx - 1.);
  for (size_t iy = 0; iy < ny; iy++)
    lat[iy] = 90. - 180. * (double) iy / ((double) ny - 1.);
 
  /* Set multiscale parameters... */
  const char domain[] = "[0.0, 360.0]x[-90.0, 90.0]";
  const int Nd0_x = ctl->met_cms_nd0x;
  const int Nd0_y = ctl->met_cms_nd0y;
  const int max_level_grid = ctl->met_cms_maxlev;
  cms_param_t *cms_param
    = cms_set_parameters(nx, ny, max_level_grid, Nd0_x, Nd0_y, domain);
 
  /* Init... */
  double cr = 0, t_coars = 0, t_eval = 0;
 
  /* Read compressed stream and decompress array... */
  if (decompress) {
    t_eval = 0;
 
    /* Loop over levels... */
    for (size_t ip = 0; ip < np; ip++) {
 
      /* Initialize multiscale module... */
      cms_module_t *cms_ptr = cms_init(cms_param);
 
      /* Read binary data... */
      cms_sol_t *cms_sol;
      if (ctl->met_cms_zstd == 1)
        cms_sol = cms_read_zstd_sol(cms_ptr, inout);
      else
        cms_sol = cms_read_sol(cms_ptr, inout);
 
      /* Evaluate current level... */
      const double t0 = omp_get_wtime();
#pragma omp parallel for collapse(2) default(shared)
      for (size_t ix = 0; ix < nx; ix++)
        for (size_t iy = 0; iy < ny; iy++) {
          double val;
          const double x[] = { lon[ix], lat[iy] };
          cms_eval(cms_ptr, cms_sol, x, &val);
          array[ARRAY_3D(ix, iy, ny, ip, np)] = (float) val;
        }
      t_eval += omp_get_wtime() - t0;
 
      /* Calculate harmonic mean of compression rates... */
      cr += 1.0 / cms_compression_rate(cms_ptr, cms_sol);
 
      /* Free... */
      cms_delete_sol(cms_sol);
      cms_delete_module(cms_ptr);
    }
 
    /* Write info... */
    LOG(2, "Read 3-D variable: %s"
        " (CMS, RATIO=%g, BPV=%g, T_DECOMP=%g s, V_DECOMP=%g MiB/s)",
        varname, (double) np / cr, 32. * cr / (double) np, t_eval,
        COMPRESS_SPEED(nx * ny * np * sizeof(float), t_eval));
  }
 
  /* Compress array and output compressed stream... */
  else {
 
    /* Init... */
    cms_module_t *cms_ptr[EP];
    cms_sol_t *cms_sol[EP];
    double ratio[EP], t_coars_level[EP], t_eval_level[EP];
 
    /* Loop over batches... */
    const size_t dip = (ctl->met_cms_batch <= 0
                        ? (size_t) omp_get_max_threads()
                        : (size_t) ctl->met_cms_batch);
    for (size_t ip0 = 0; ip0 < np; ip0 += dip) {
 
      /* Measure time... */
      double t0 = omp_get_wtime();
 
      /* Loop over levels... */
#pragma omp parallel for default(shared)
      for (size_t ip = ip0; ip < MIN(ip0 + dip, np); ip++) {
        const double t1 = omp_get_wtime();
 
        /* Allocate... */
        float *tmp_arr;
        ALLOC(tmp_arr, float,
              nxy);
 
        /* Copy level data... */
        for (size_t ix = 0; ix < nx; ++ix)
          for (size_t iy = 0; iy < ny; ++iy)
            tmp_arr[ARRAY_2D(ix, iy, ny)] =
              array[ARRAY_3D(ix, iy, ny, ip, np)];
 
        /* Initialize current level... */
        cms_ptr[ip] = cms_init(cms_param);
 
        /* Coarsening... */
        cms_sol[ip] =
          cms_read_arr_new(cms_ptr[ip], tmp_arr, lon, lat,
                           nx, ny, ctl->met_cms_eps[metvar]);
        t_coars_level[ip] = omp_get_wtime() - t1;
 
        /* Free... */
        free(tmp_arr);
      }
 
      /* Measure time... */
      t_coars += (omp_get_wtime() - t0);
 
      /* Loop over levels... */
      for (size_t ip = ip0; ip < MIN(ip0 + dip, np); ip++) {
 
        /* Allocate... */
        float *tmp_cms, *tmp_org;
        ALLOC(tmp_cms, float,
              nxy);
        ALLOC(tmp_org, float,
              nxy);
 
        /* Measure time... */
        t0 = omp_get_wtime();
 
        /* Evaluate... */
#pragma omp parallel for collapse(2) default(shared)
        for (size_t ix = 0; ix < nx; ix++)
          for (size_t iy = 0; iy < ny; iy++) {
            const size_t idx = ARRAY_2D(ix, iy, ny);
            const double x[] = { lon[ix], lat[iy] };
            double val;
            cms_eval(cms_ptr[ip], cms_sol[ip], x, &val);
            tmp_cms[idx] = (float) val;
            tmp_org[idx] = array[ARRAY_3D(ix, iy, ny, ip, np)];
          }
 
        /* Measure time... */
        t_eval_level[ip] = omp_get_wtime() - t0;
        t_eval += t_eval_level[ip];
 
        /* Calculate harmonic mean of compression rates... */
        ratio[ip] = cms_compression_rate(cms_ptr[ip], cms_sol[ip]);
        cr += 1.0 / ratio[ip];
 
        /* Write per-level diagnostics... */
        if (level_log)
          compress_log_level(level_log, "CMS", varname, ip, met->p[ip],
                             ratio[ip], 32. / ratio[ip],
                             t_coars_level[ip], t_eval_level[ip], nxy,
                             nxy * sizeof(float), tmp_org, tmp_cms);
 
        /* Save binary data... */
        if (ctl->met_cms_zstd == 1)
          cms_save_zstd_sol(cms_sol[ip], inout, 3);
        else
          cms_save_sol(cms_sol[ip], inout);
 
        /* Free... */
        cms_delete_sol(cms_sol[ip]);
        cms_delete_module(cms_ptr[ip]);
        free(tmp_cms);
        free(tmp_org);
      }
    }
 
    /* Write info... */
    LOG(2, "Write 3-D variable: %s"
        " (CMS, RATIO=%g, BPV=%g, T_COMP=%g s, V_COMP=%g MiB/s,"
        " T_DECOMP=%g s, V_DECOMP=%g MiB/s)",
        varname, (double) np / cr, 32. * cr / (double) np, t_coars,
        COMPRESS_SPEED(nx * ny * np * sizeof(float), t_coars), t_eval,
        COMPRESS_SPEED(nx * ny * np * sizeof(float), t_eval));
  }
 
  /* Free... */
  cms_delete_param(cms_param);
}
#endif
 
/*****************************************************************************/
 
void compress_log_level(
  FILE *out,
  const char *codec,
  const char *varname,
  const size_t lev,
  const double plev,
  const double ratio,
  const double bpv,
  const double t_comp,
  const double t_decomp,
  const size_t n,
  const size_t nbytes,
  const float *org,
  const float *cmp) {
 
  static FILE *last_out = NULL;
  static char last_var[LEN] = "";
 
  /* Calculate error statistics... */
  double mean_err = 0.0, stddev_err = 0.0;
  double nrmse = NAN, mean_orig = 0.0, orig_range = 0.0, rho = NAN;
 
  double sum_err = 0.0, sumsq_err = 0.0;
  double sum_orig = 0.0, sum_cmp = 0.0;
  double sumsq_orig = 0.0, sumsq_cmp = 0.0, sum_org_cmp = 0.0;
 
  double min_orig = 0.0, max_orig = 0.0;
  double min_err = 0.0, max_err = 0.0;
 
  /* Accumulate error, signal and cross-product sums in one pass... */
  for (size_t i = 0; i < n; i++) {
    const double o = (double) org[i];
    const double c = (double) cmp[i];
    const double e = c - o;
 
    sum_err += e;
    sumsq_err += e * e;
    sum_orig += o;
    sum_cmp += c;
 
    sumsq_orig += o * o;
    sumsq_cmp += c * c;
    sum_org_cmp += o * c;
 
    if (e < min_err || i == 0)
      min_err = e;
    if (e > max_err || i == 0)
      max_err = e;
 
    if (o < min_orig || i == 0)
      min_orig = o;
    if (o > max_orig || i == 0)
      max_orig = o;
  }
 
  /* Derive the basic error and signal summary statistics... */
  mean_err = sum_err / (double) n;
  mean_orig = sum_orig / (double) n;
  orig_range = max_orig - min_orig;
 
  /* Convert the accumulated error sums into a standard deviation... */
  const double var_err =
    (sumsq_err - (sum_err * sum_err) / (double) n) / (double) n;
  stddev_err = sqrt(var_err > 0.0 ? var_err : 0.0);
 
  /* Normalize RMSE by the original data range if available... */
  nrmse = (orig_range > 0.0)
    ? sqrt(sumsq_err / (double) n) / orig_range : NAN;
 
  /* Compute the Pearson correlation from the accumulated moments... */
  const double nn = (double) n;
  const double cov = sum_org_cmp - sum_orig * sum_cmp / nn;
  const double var_orig = sumsq_orig - sum_orig * sum_orig / nn;
  const double var_cmp = sumsq_cmp - sum_cmp * sum_cmp / nn;
  const double denom = sqrt(var_orig * var_cmp);
  rho = denom > 0.0 ? cov / denom : NAN;
 
  /* Reset the variable separator state when the target file changes... */
  if (out != last_out) {
    last_out = out;
    last_var[0] = '\0';
  }
 
  /* Separate diagnostic blocks when switching to a new variable... */
  if (last_var[0] != '\0' && strcmp(last_var, varname) != 0)
    fprintf(out, "\n");
  snprintf(last_var, LEN, "%s", varname);
 
  /* Logging... */
  fprintf(out,
          "%s %s %lu %g %g %g %g %g %g %g %g %g %g %g %g %g %g %g\n",
          codec, varname, (unsigned long) lev, plev, ratio, bpv, rho,
          mean_err, stddev_err, min_err, max_err, mean_orig, orig_range,
          nrmse, t_comp, COMPRESS_SPEED(nbytes, t_comp), t_decomp,
          COMPRESS_SPEED(nbytes, t_decomp));
}
 
/*****************************************************************************/
 
void compress_log_levels_3d(
  FILE *out,
  const char *codec,
  const char *varname,
  const met_t *met,
  const float *org_all,
  const float *cmp_all,
  const size_t nxy,
  const size_t nz,
  const double ratio,
  const double bpv,
  const double t_comp,
  const double t_decomp,
  const size_t nbytes) {
 
  if (!out)
    return;
 
  /* Allocate temporary buffers for one level... */
  float *tmp_org, *tmp_cmp;
  ALLOC(tmp_org, float,
        nxy);
  ALLOC(tmp_cmp, float,
        nxy);
 
  for (size_t lev = 0; lev < nz; lev++) {
 
    /* Extract current level... */
#pragma omp parallel for default(shared)
    for (size_t ixy = 0; ixy < nxy; ixy++) {
      tmp_org[ixy] = org_all[ixy * nz + lev];
      tmp_cmp[ixy] = cmp_all[ixy * nz + lev];
    }
 
    /* Write diagnostics for the extracted level... */
    compress_log_level(out, codec, varname, lev, met->p[lev], ratio, bpv,
                       t_comp, t_decomp, nxy, nbytes, tmp_org, tmp_cmp);
  }
 
  /* Free... */
  free(tmp_org);
  free(tmp_cmp);
}
 
/*****************************************************************************/
 
void compress_scale_to_unit(
  float *array,
  const size_t nxy,
  const size_t nz,
  double *off,
  double *scl) {
 
  /* Initialize per-level minima and maxima from the first sample... */
  for (size_t iz = 0; iz < nz; iz++) {
    off[iz] = array[iz];
    scl[iz] = array[iz];
  }
 
  /* Scan the remaining samples to get per-level minima and maxima... */
  for (size_t ixy = 1; ixy < nxy; ixy++)
    for (size_t iz = 0; iz < nz; iz++) {
      const double value = array[ixy * nz + iz];
      if (value < off[iz])
        off[iz] = value;
      if (value > scl[iz])
        scl[iz] = value;
    }
 
  /* Convert maxima into ranges and suppress numerically flat levels... */
  for (size_t iz = 0; iz < nz; iz++) {
    const double range = scl[iz] - off[iz];
    const double ref = fmax(1.0, fmax(fabs(off[iz]), fabs(scl[iz])));
    scl[iz] = !(range > 1e-12 * ref) ? 0.0 : range;
  }
 
  /* Scale each level independently to the unit interval... */
#pragma omp parallel for default(shared)
  for (size_t ixy = 0; ixy < nxy; ixy++)
    for (size_t iz = 0; iz < nz; iz++)
      if (scl[iz] > 0.0)
        array[ixy * nz + iz] =
          (float) ((array[ixy * nz + iz] - off[iz]) / scl[iz]);
      else
        array[ixy * nz + iz] = 0.0f;
}
 
/*****************************************************************************/
 
void compress_unscale_from_unit(
  float *array,
  const size_t nxy,
  const size_t nz,
  const double *off,
  const double *scl) {
 
  /* Restore each level from unit space back to its original range... */
#pragma omp parallel for default(shared)
  for (size_t ixy = 0; ixy < nxy; ixy++)
    for (size_t iz = 0; iz < nz; iz++)
      if (scl[iz] > 0.0)
        array[ixy * nz + iz] =
          (float) (array[ixy * nz + iz] * scl[iz] + off[iz]);
      else
        array[ixy * nz + iz] = (float) off[iz];
}
 
/*****************************************************************************/
 
int compress_read_lossy_scale(
  FILE *in,
  const size_t nz,
  double **off,
  double **scl) {
 
  int enabled;
  *off = NULL;
  *scl = NULL;
 
  /* Read input... */
  FREAD(&enabled, int,
        1,
        in);
  if (enabled < 0 || enabled > 1)
    ERRMSG("Invalid stored MET_LOSSY_SCALE flag!");
 
  if (enabled > 0) {
    ALLOC(*off, double,
          nz);
    ALLOC(*scl, double,
          nz);
    FREAD(*off, double,
          nz,
          in);
    FREAD(*scl, double,
          nz,
          in);
  }
 
  return enabled;
}
 
/*****************************************************************************/
 
void compress_write_lossy_scale(
  FILE *out,
  const int enabled,
  float *array,
  const size_t nxy,
  const size_t nz,
  double **off,
  double **scl) {
 
  *off = NULL;
  *scl = NULL;
 
  /* Write output... */
  FWRITE(&enabled, int,
         1,
         out);
  if (enabled <= 0)
    return;
 
  /* Derive per-level scaling data... */
  ALLOC(*off, double,
        nz);
  ALLOC(*scl, double,
        nz);
 
  compress_scale_to_unit(array, nxy, nz, *off, *scl);
 
  FWRITE(*off, double,
         nz,
         out);
  FWRITE(*scl, double,
         nz,
         out);
}
 
/*****************************************************************************/
 
#ifdef ZSTD
ZSTD_CCtx *compress_zstd_create_cctx(
  const int level,
  const int nworkers) {
 
  /* Create and configure the ZSTD context... */
  ZSTD_CCtx *cctx = ZSTD_createCCtx();
  if (!cctx)
    ERRMSG("Cannot create ZSTD context!");
 
  if (ZSTD_isError(ZSTD_CCtx_setParameter(cctx, ZSTD_c_compressionLevel,
                                          level)))
    ERRMSG("Cannot set ZSTD compression level!");
 
  if (ZSTD_isError(ZSTD_CCtx_setParameter(cctx, ZSTD_c_nbWorkers, nworkers)))
    ERRMSG("Cannot set ZSTD worker count!");
 
  return cctx;
}
#endif
 
/*****************************************************************************/
 
int compress_metvar_index(
  const char *varname) {
 
  static const char *const names[] = {
    "Z", "T", "U", "V", "W", "PV", "H2O", "O3",
    "LWC", "RWC", "IWC", "SWC", "CC"
  };
 
  for (size_t i = 0; i < sizeof(names) / sizeof(names[0]); i++)
    if (strcasecmp(varname, names[i]) == 0)
      return (int) i;
 
  ERRMSG("Unknown meteorological variable name!");
}
 
/*****************************************************************************/
 
void compress_pck(
  const ctl_t *ctl,
  const met_t *met,
  const char *varname,
  float *array,
  const int decompress,
  FILE *level_log,
  FILE *inout) {
 
  const size_t nxy = (size_t) met->nx * (size_t) met->ny;
  const size_t nz = (size_t) met->np;
  const size_t n = nxy * nz;
  const size_t nbytes = n * sizeof(float);
  const size_t pck_bytes = n * sizeof(uint16_t);
 
  double vmin[EP], vmax[EP], off[EP], scl[EP];
  uint16_t *sarray;
 
  /* PCK+ZSTD payload = scale + offset + packed 16-bit samples... */
  const size_t payload_len = 2 * nz * sizeof(double) + pck_bytes;
  size_t stored_len = payload_len;
  const char *codec_info = ctl->met_pck_zstd ? "PCK+ZSTD" : "PCK";
 
  /* Allocate packed sample buffer... */
  ALLOC(sarray, uint16_t, n);
 
  /* Read compressed stream and decompress array... */
  if (decompress) {
    double t_zstd = 0.0;
 
    /* Read packed data... */
    if (ctl->met_pck_zstd) {
#ifdef ZSTD
      uint64_t magic, pck_zstd_magic = UINT64_C(0x50434b5a53544431);
      unsigned char *compr = NULL, *payload = NULL;
 
      /* Read input... */
      FREAD(&magic, uint64_t, 1, inout);
      if (magic != pck_zstd_magic)
        ERRMSG("PCK+ZSTD magic mismatch! Check MET_PCK_ZSTD and file type.");
 
      /* Read and decompress the outer ZSTD payload... */
      FREAD(&stored_len, size_t,
            1,
            inout);
      ALLOC(compr, unsigned char,
            stored_len);
      FREAD(compr, unsigned char,
            stored_len,
            inout);
      ALLOC(payload, unsigned char,
            payload_len);
      const double t0_decomp = omp_get_wtime();
      const size_t out_len =
        ZSTD_decompress(payload, payload_len, compr, stored_len);
      t_zstd = omp_get_wtime() - t0_decomp;
      if (ZSTD_isError(out_len) || out_len != payload_len)
        ERRMSG("PCK ZSTD decompression failed or size mismatch!");
 
      /* Split payload into scale, offset and packed samples... */
      memcpy(scl, payload, nz * sizeof(double));
      memcpy(off, payload + nz * sizeof(double), nz * sizeof(double));
      memcpy(sarray, payload + 2 * nz * sizeof(double), pck_bytes);
 
      /* Free... */
      free(payload);
      free(compr);
#else
      ERRMSG("MPTRAC was compiled without ZSTD compression!");
#endif
    } else {
      /* Read input... */
      FREAD(&scl, double,
            nz,
            inout);
      FREAD(&off, double,
            nz,
            inout);
      FREAD(sarray, uint16_t, n, inout);
    }
 
    /* Measure the scalar unpacking step separately from optional ZSTD... */
    const double t0 = omp_get_wtime();
 
    /* Convert packed 16-bit samples back to floating-point values... */
#pragma omp parallel for default(shared)
    for (size_t ixy = 0; ixy < nxy; ixy++)
      for (size_t iz = 0; iz < nz; iz++)
        array[ixy * nz + iz]
          = (float) (sarray[ixy * nz + iz] * scl[iz] + off[iz]);
 
    /* Add optional ZSTD time to the scalar unpacking time... */
    const double t_decomp = t_zstd + omp_get_wtime() - t0;
 
    /* Logging... */
    LOG(2, "Read 3-D variable: %s"
        " (%s, RATIO=%g, BPV=%g, T_DECOMP=%g s, V_DECOMP=%g MiB/s)",
        varname, codec_info, COMPRESS_RATIO(nbytes, stored_len),
        COMPRESS_BPV(n, stored_len), t_decomp, COMPRESS_SPEED(nbytes,
                                                              t_decomp));
  }
 
  /* Compress array and output compressed stream... */
  else {
    float *tmp_org, *tmp_pck;
    double t_comp_sum = 0, t_decomp_sum = 0, t_zstd = 0, t_zstd_decomp = 0;
    double t_comp_level[EP], t_decomp_level[EP];
 
    /* Allocate temporary buffers for one level... */
    ALLOC(tmp_org, float,
          nxy);
    ALLOC(tmp_pck, float,
          nxy);
 
    /* Derive per-level minima and maxima for the 16-bit quantization... */
    for (size_t iz = 0; iz < nz; iz++) {
      vmin[iz] = array[iz];
      vmax[iz] = array[iz];
    }
    for (size_t ixy = 1; ixy < nxy; ixy++)
      for (size_t iz = 0; iz < nz; iz++) {
        if (array[ixy * nz + iz] < vmin[iz])
          vmin[iz] = array[ixy * nz + iz];
        if (array[ixy * nz + iz] > vmax[iz])
          vmax[iz] = array[ixy * nz + iz];
      }
 
    /* Derive per-level offset and scaling factor... */
    for (size_t iz = 0; iz < nz; iz++) {
      scl[iz] = (vmax[iz] - vmin[iz]) / 65533.;
      off[iz] = vmin[iz];
    }
 
    /* Quantize each level and time encode/decode diagnostics on the fly... */
    for (size_t iz = 0; iz < nz; iz++) {
      const double t0 = omp_get_wtime();
 
#pragma omp parallel for default(shared)
      for (size_t ixy = 0; ixy < nxy; ixy++)
        if (scl[iz] != 0)
          sarray[ixy * nz + iz] =
            (uint16_t) ((array[ixy * nz + iz] - off[iz]) / scl[iz] + .5);
        else
          sarray[ixy * nz + iz] = 0;
 
      t_comp_level[iz] = omp_get_wtime() - t0;
      t_comp_sum += t_comp_level[iz];
 
      const double t1 = omp_get_wtime();
 
#pragma omp parallel for default(shared)
      for (size_t ixy = 0; ixy < nxy; ixy++) {
        tmp_org[ixy] = array[ixy * nz + iz];
        tmp_pck[ixy] = (float) (sarray[ixy * nz + iz] * scl[iz] + off[iz]);
      }
 
      t_decomp_level[iz] = omp_get_wtime() - t1;
      t_decomp_sum += t_decomp_level[iz];
    }
 
    /* Write packed data, optionally wrapped in ZSTD... */
    if (ctl->met_pck_zstd) {
#ifdef ZSTD
      uint64_t pck_zstd_magic = UINT64_C(0x50434b5a53544431);
      unsigned char *payload = NULL, *payload_chk = NULL;
      void *stored_data = NULL;
 
      /* Pack plain PCK data into one ZSTD payload... */
      ALLOC(payload, unsigned char,
            payload_len);
      memcpy(payload, scl, nz * sizeof(double));
      memcpy(payload + nz * sizeof(double), off, nz * sizeof(double));
      memcpy(payload + 2 * nz * sizeof(double), sarray, pck_bytes);
      const size_t dst_cap = ZSTD_compressBound(payload_len);
      ALLOC(stored_data, char,
            dst_cap);
      ZSTD_CCtx *cctx = compress_zstd_create_cctx(ctl->met_zstd_level,
                                                  ctl->met_zstd_nworkers);
      const double t0_comp = omp_get_wtime();
      stored_len =
        ZSTD_compress2(cctx, stored_data, dst_cap, payload, payload_len);
      t_zstd = omp_get_wtime() - t0_comp;
      ZSTD_freeCCtx(cctx);
      if (ZSTD_isError(stored_len))
        ERRMSG("PCK ZSTD compression failed!");
 
      /* Decompress once for validation and timing... */
      ALLOC(payload_chk, unsigned char,
            payload_len);
      const double t0_decomp2 = omp_get_wtime();
      const size_t out_len2 =
        ZSTD_decompress(payload_chk, payload_len, stored_data, stored_len);
      t_zstd_decomp = omp_get_wtime() - t0_decomp2;
      if (ZSTD_isError(out_len2) || out_len2 != payload_len)
        ERRMSG("PCK ZSTD decompression failed or size mismatch!");
 
      /* Free... */
      free(payload_chk);
      free(payload);
 
      /* Write output... */
      FWRITE(&pck_zstd_magic, uint64_t, 1, inout);
      FWRITE(&stored_len, size_t,
             1,
             inout);
      FWRITE(stored_data, unsigned char,
             stored_len,
             inout);
 
      /* Free... */
      free(stored_data);
#else
      ERRMSG("MPTRAC was compiled without ZSTD compression!");
#endif
    } else {
 
      /* Write output... */
      FWRITE(&scl, double,
             nz,
             inout);
      FWRITE(&off, double,
             nz,
             inout);
      FWRITE(sarray, uint16_t, n, inout);
    }
 
    /* Combine PCK and optional ZSTD timing and size metrics... */
    const double ratio_out = COMPRESS_RATIO(nbytes, stored_len);
    const double bpv_out = COMPRESS_BPV(n, stored_len);
    const double t_comp = t_comp_sum + t_zstd;
    const double t_decomp = t_decomp_sum + t_zstd_decomp;
 
    /* Logging... */
    LOG(2, "Write 3-D variable: %s"
        " (%s, RATIO=%g, BPV=%g, T_COMP=%g s, V_COMP=%g MiB/s,"
        " T_DECOMP=%g s, V_DECOMP=%g MiB/s)",
        varname, codec_info, ratio_out, bpv_out, t_comp,
        COMPRESS_SPEED(nbytes, t_comp), t_decomp,
        COMPRESS_SPEED(nbytes, t_decomp));
 
    /* Distribute optional ZSTD cost across levels for diagnostics... */
    if (level_log) {
      const double t_zstd_level = t_zstd / (double) nz;
      const double t_zstd_decomp_level = t_zstd_decomp / (double) nz;
      const char *codec = ctl->met_pck_zstd ? "PCKZSTD" : "PCK";
      for (size_t iz = 0; iz < nz; iz++) {
#pragma omp parallel for default(shared)
 
        /* Rebuild one decoded level for diagnostics... */
        for (size_t ixy = 0; ixy < nxy; ixy++) {
          tmp_org[ixy] = array[ixy * nz + iz];
          tmp_pck[ixy] = (float) (sarray[ixy * nz + iz] * scl[iz] + off[iz]);
        }
 
        /* Logging... */
        compress_log_level(level_log, codec, varname, iz, met->p[iz],
                           ratio_out, bpv_out,
                           t_comp_level[iz] + t_zstd_level,
                           t_decomp_level[iz] + t_zstd_decomp_level,
                           nxy, nxy * sizeof(float), tmp_org, tmp_pck);
      }
    }
 
    /* Free... */
    free(tmp_org);
    free(tmp_pck);
  }
 
  /* Free... */
  free(sarray);
}
 
/*****************************************************************************/
 
#ifdef SZ3
void compress_sz3(
  const ctl_t *ctl,
  const met_t *met,
  const char *varname,
  float *array,
  const int decompress,
  FILE *level_log,
  FILE *inout) {
 
  /* Get meteo variable... */
  const int metvar = compress_metvar_index(varname);
 
  /* Check compression settings... */
  if ((ctl->met_sz3_prec[metvar] > 0) == (ctl->met_sz3_tol[metvar] > 0.0))
    ERRMSG("Exactly one of precision or tolerance must be set for SZ3!");
 
  size_t r1 = (size_t) met->np, r2 = (size_t) met->ny, r3 = (size_t) met->nx,
    outSize = 0, total_elems = r1 * r2 * r3;
 
  unsigned char *bytes = NULL;
  double *scale_off = NULL, *scale_scl = NULL;
  float *orig_all = NULL;
  char codec_info[LEN];
 
  /* Read compressed stream and decompress array... */
  if (decompress) {
 
    /* Read optional scaling metadata before the SZ3 byte stream... */
    const int stored_lossy_scale =
      compress_read_lossy_scale(inout, r1, &scale_off, &scale_scl);
 
    size_t sz3size;
 
    /* Read input... */
    FREAD(&sz3size, size_t,
          1,
          inout);
    ALLOC(bytes, char,
          sz3size);
    FREAD(bytes, unsigned char,
          sz3size,
          inout);
 
    /* Let SZ3 rebuild the scaled field in its native 3-D layout... */
    const double t0 = omp_get_wtime();
    void *outData = SZ_decompress(SZ_FLOAT, bytes, sz3size, 0, 0, r3, r2, r1);
    if (!outData)
      ERRMSG("Decompression failed!");
 
    memcpy(array, outData, total_elems * sizeof(float));
 
    /* Restore the original value range after lossy unit scaling... */
    if (stored_lossy_scale > 0)
      compress_unscale_from_unit(array, r2 * r3, r1, scale_off, scale_scl);
    const double t_decomp = omp_get_wtime() - t0;
 
    /* Free... */
    free(outData);
    free(bytes);
 
    const double ratio = COMPRESS_RATIO(total_elems * sizeof(float), sz3size);
    const double bpv = COMPRESS_BPV(total_elems, sz3size);
    snprintf(codec_info, LEN, "SZ3, PREC=%d, TOL=%g, SCALE=%d",
             ctl->met_sz3_prec[metvar], ctl->met_sz3_tol[metvar],
             stored_lossy_scale);
 
    /* Logging... */
    LOG(2, "Read 3-D variable: %s"
        " (%s, RATIO=%g, BPV=%g, T_DECOMP=%g s, V_DECOMP=%g MiB/s)",
        varname, codec_info, ratio, bpv, t_decomp,
        COMPRESS_SPEED(total_elems * sizeof(float), t_decomp));
  }
 
  /* Compress array and output compressed stream... */
  else {
 
    /* Translate MPTRAC settings into the SZ3 absolute/relative error mode... */
    const int errBoundMode = (ctl->met_sz3_prec[metvar] > 0) ? REL : ABS;
    const double absBound =
      (errBoundMode == ABS) ? ctl->met_sz3_tol[metvar] : 0.0;
    const double relBound =
      (errBoundMode == REL) ? pow(2.0, -(double) ctl->met_sz3_prec[metvar])
      : 0.0;
    const size_t raw_size = total_elems * sizeof(float);
 
    /* Preserve the unscaled input only if diagnostics need it later... */
    if (ctl->met_lossy_scale[metvar] > 0 && level_log) {
      ALLOC(orig_all, float,
            total_elems);
      memcpy(orig_all, array, total_elems * sizeof(float));
    }
 
    /* Optionally scale each vertical level to unit space before SZ3... */
    compress_write_lossy_scale(inout, ctl->met_lossy_scale[metvar], array,
                               r2 * r3, r1, &scale_off, &scale_scl);
 
    /* Compress the possibly scaled field with the selected SZ3 error mode... */
    const double t0 = omp_get_wtime();
    bytes = SZ_compress_args(SZ_FLOAT, array, &outSize,
                             errBoundMode, absBound, relBound, 0.0,
                             0, 0, r3, r2, r1);
    const double t_comp = omp_get_wtime() - t0;
    if (!bytes || outSize == 0)
      ERRMSG("Compression failed!");
 
    /* Write output... */
    FWRITE(&outSize, size_t,
           1,
           inout);
    FWRITE(bytes, unsigned char,
           outSize,
           inout);
 
    snprintf(codec_info, LEN, "SZ3, PREC=%d, TOL=%g, SCALE=%d",
             ctl->met_sz3_prec[metvar], ctl->met_sz3_tol[metvar],
             ctl->met_lossy_scale[metvar]);
 
    /* Reconstruct once more only when per-level diagnostics are requested... */
    double t_decomp = NAN;
    if (level_log) {
      unsigned char *bytes_copy;
      float *tmp_all;
      const size_t nxy = r2 * r3;
 
      /* Reconstruct data for per-level diagnostics... */
      ALLOC(bytes_copy, unsigned char,
            outSize);
      memcpy(bytes_copy, bytes, outSize);
 
      const double t1 = omp_get_wtime();
      void *decData = SZ_decompress(SZ_FLOAT, bytes_copy, outSize, 0, 0, r3,
                                    r2, r1);
      t_decomp = omp_get_wtime() - t1;
      if (!decData)
        ERRMSG("Decompression failed!");
 
      /* Rebuild the decoded field so diagnostics compare like with like... */
      ALLOC(tmp_all, float,
            total_elems);
      memcpy(tmp_all, decData, total_elems * sizeof(float));
      if (ctl->met_lossy_scale[metvar] > 0)
        compress_unscale_from_unit(tmp_all, r2 * r3, r1, scale_off,
                                   scale_scl);
 
      const double ratio = COMPRESS_RATIO(raw_size, outSize);
      const double bpv = COMPRESS_BPV(total_elems, outSize);
      compress_log_levels_3d(level_log, "SZ3", varname, met,
                             (orig_all ? orig_all : array), tmp_all, nxy, r1,
                             ratio, bpv, t_comp, t_decomp, raw_size);
 
      /* Free... */
      free(tmp_all);
      free(decData);
      free(bytes_copy);
 
      /* Logging... */
      LOG(2, "Write 3-D variable: %s"
          " (%s, RATIO=%g, BPV=%g, T_COMP=%g s, V_COMP=%g MiB/s,"
          " T_DECOMP=%g s, V_DECOMP=%g MiB/s)",
          varname, codec_info, ratio, bpv, t_comp,
          COMPRESS_SPEED(raw_size, t_comp), t_decomp,
          COMPRESS_SPEED(raw_size, t_decomp));
    } else {
      const double ratio = COMPRESS_RATIO(raw_size, outSize);
      const double bpv = COMPRESS_BPV(total_elems, outSize);
 
      /* Logging... */
      LOG(2, "Write 3-D variable: %s"
          " (%s, RATIO=%g, BPV=%g, T_COMP=%g s, V_COMP=%g MiB/s)",
          varname, codec_info, ratio, bpv, t_comp,
          COMPRESS_SPEED(raw_size, t_comp));
    }
    /* Free... */
    free(bytes);
    free(orig_all);
  }
 
  /* Free... */
  free(scale_off);
  free(scale_scl);
}
#endif
 
/*****************************************************************************/
 
#ifdef ZFP
void compress_zfp(
  const ctl_t *ctl,
  const met_t *met,
  const char *varname,
  float *array,
  const int decompress,
  FILE *level_log,
  FILE *inout) {
 
  /* Get meteo variable... */
  const int metvar = compress_metvar_index(varname);
 
  /* Allocate meta data for the 3D array a[nz][ny][nx]... */
  const size_t snx = (size_t) met->np;
  const size_t sny = (size_t) met->ny;
  const size_t snz = (size_t) met->nx;
  const size_t n = snx * sny * snz;
  const size_t raw_size = n * sizeof(float);
  const zfp_type type = zfp_type_float;
  zfp_field *field = zfp_field_3d(array, type, snx, sny, snz);
 
  /* Allocate meta data for a compressed stream... */
  zfp_stream *zfp = zfp_stream_open(NULL);
  if (!field || !zfp)
    ERRMSG("Failed to allocate zfp structures!");
 
  /* Set compression mode... */
  int actual_prec = 0;
  double actual_tol = 0;
  if ((ctl->met_zfp_prec[metvar] > 0 && ctl->met_zfp_tol[metvar] > 0)
      || (ctl->met_zfp_prec[metvar] <= 0 && ctl->met_zfp_tol[metvar] <= 0)) {
    ERRMSG("Exactly one of precision or tolerance must be set for zfp!");
  } else if (ctl->met_zfp_prec[metvar] > 0)
    actual_prec = (int) zfp_stream_set_precision(zfp, (unsigned int)
                                                 ctl->met_zfp_prec[metvar]);
  else if (ctl->met_zfp_tol[metvar] > 0)
    actual_tol = zfp_stream_set_accuracy(zfp, ctl->met_zfp_tol[metvar]);
 
  /* Allocate buffer for compressed data... */
  const size_t bufsize = zfp_stream_maximum_size(zfp, field);
  void *buffer;
  ALLOC(buffer, char,
        bufsize);
 
  /* Associate bit stream with allocated buffer... */
  bitstream *stream = stream_open(buffer, bufsize);
  zfp_stream_set_bit_stream(zfp, stream);
  zfp_stream_rewind(zfp);
 
  /* Read compressed stream and decompress array... */
  size_t zfpsize;
  double *scale_off = NULL, *scale_scl = NULL;
  char codec_info[LEN];
  if (decompress) {
 
    /* Read optional scaling metadata before the ZFP bit stream... */
    const int stored_lossy_scale =
      compress_read_lossy_scale(inout, snx, &scale_off, &scale_scl);
    /* Read input... */
    FREAD(&zfpsize, size_t,
          1,
          inout);
    if (zfpsize > bufsize)
      ERRMSG("Compressed data size exceeds allocated buffer!");
    FREAD(buffer, unsigned char,
          zfpsize,
          inout);
 
    /* Decode the bit stream directly into the caller-provided field... */
    const double t0 = omp_get_wtime();
    if (!zfp_decompress(zfp, field))
      ERRMSG("Decompression failed!");
 
    /* Restore the original value range after lossy unit scaling... */
    if (stored_lossy_scale > 0)
      compress_unscale_from_unit(array, sny * snz, snx, scale_off, scale_scl);
    const double t_decomp = omp_get_wtime() - t0;
    const double ratio = COMPRESS_RATIO(raw_size, zfpsize);
    const double bpv = COMPRESS_BPV(n, zfpsize);
    snprintf(codec_info, LEN, "ZFP, PREC=%d, TOL=%g, SCALE=%d",
             actual_prec, actual_tol, stored_lossy_scale);
 
    /* Logging... */
    LOG(2, "Read 3-D variable: %s"
        " (%s, RATIO=%g, BPV=%g, T_DECOMP=%g s, V_DECOMP=%g MiB/s)",
        varname, codec_info, ratio, bpv, t_decomp, COMPRESS_SPEED(raw_size,
                                                                  t_decomp));
  }
 
  /* Compress array and output compressed stream... */
  else {
    float *tmp_all, *orig_all = NULL;
    const size_t nxy = sny * snz;
 
    /* Preserve the unscaled input only if diagnostics need it later... */
    if (ctl->met_lossy_scale[metvar] > 0 && level_log) {
      ALLOC(orig_all, float,
            n);
      memcpy(orig_all, array, raw_size);
    }
 
    /* Optionally scale each vertical level to unit space before ZFP... */
    compress_write_lossy_scale(inout, ctl->met_lossy_scale[metvar], array,
                               nxy, snx, &scale_off, &scale_scl);
 
    /* Keep a temporary decode buffer for the shared diagnostics path... */
    ALLOC(tmp_all, float,
          n);
 
    /* Compress the field into the configured ZFP bit stream... */
    const double t0 = omp_get_wtime();
    zfpsize = zfp_compress(zfp, field);
    const double t_comp = omp_get_wtime() - t0;
    if (!zfpsize) {
      ERRMSG("Compression failed!");
    } else {
      /* Write output... */
      FWRITE(&zfpsize, size_t,
             1,
             inout);
      FWRITE(buffer, unsigned char,
             zfpsize,
             inout);
    }
 
    /* Decode once into a temporary field for the shared diagnostics... */
    zfp_field *dec_field = zfp_field_3d(tmp_all, type, snx, sny, snz);
    if (!dec_field)
      ERRMSG("Failed to allocate zfp structures!");
 
    /* Rewind the bit stream and decode once for diagnostics and timing... */
    const double t1 = omp_get_wtime();
    zfp_stream_rewind(zfp);
    if (!zfp_decompress(zfp, dec_field))
      ERRMSG("Decompression failed!");
    if (ctl->met_lossy_scale[metvar] > 0)
      compress_unscale_from_unit(tmp_all, nxy, snx, scale_off, scale_scl);
    const double t_decomp = omp_get_wtime() - t1;
 
    const double ratio = COMPRESS_RATIO(raw_size, zfpsize);
    const double bpv = COMPRESS_BPV(n, zfpsize);
    compress_log_levels_3d(level_log, "ZFP", varname, met,
                           (orig_all ? orig_all : array), tmp_all, nxy, snx,
                           ratio, bpv, t_comp, t_decomp, raw_size);
 
    snprintf(codec_info, LEN, "ZFP, PREC=%d, TOL=%g, SCALE=%d",
             actual_prec, actual_tol, ctl->met_lossy_scale[metvar]);
 
    /* Logging... */
    LOG(2, "Write 3-D variable: %s"
        " (%s, RATIO=%g, BPV=%g, T_COMP=%g s, V_COMP=%g MiB/s,"
        " T_DECOMP=%g s, V_DECOMP=%g MiB/s)",
        varname, codec_info, ratio, bpv, t_comp, COMPRESS_SPEED(raw_size,
                                                                t_comp),
        t_decomp, COMPRESS_SPEED(raw_size, t_decomp));
 
    /* Free... */
    free(tmp_all);
    free(orig_all);
    zfp_field_free(dec_field);
  }
 
  /* Free... */
  free(scale_off);
  free(scale_scl);
 
  /* Free... */
  zfp_field_free(field);
  stream_close(stream);
  zfp_stream_close(zfp);
  free(buffer);
}
#endif
 
/*****************************************************************************/
 
#ifdef ZSTD
void compress_zstd(
  const ctl_t *ctl,
  const met_t *met,
  const char *varname,
  float *array,
  const int decompress,
  FILE *level_log,
  FILE *inout) {
 
  /* Get buffer sizes... */
  const size_t nxy = (size_t) met->nx * (size_t) met->ny;
  const size_t nz = (size_t) met->np;
  const size_t n = nxy * nz, uncomprLen = n * sizeof(float);
  size_t compsize, comprLen = ZSTD_compressBound(uncomprLen);
 
  /* Allocate... */
  char *compr, *uncompr = (char *) array;
  char codec_info[LEN];
  ALLOC(compr, char,
        comprLen);
 
  /* Read compressed stream and decompress array... */
  if (decompress) {
 
    /* Read input... */
    FREAD(&comprLen, size_t,
          1,
          inout);
    FREAD(compr, unsigned char,
          comprLen,
          inout);
 
    /* Decode one full frame and validate the restored byte count... */
    const double t0 = omp_get_wtime();
    compsize = ZSTD_decompress(uncompr, uncomprLen, compr, comprLen);
    const double t_decomp = omp_get_wtime() - t0;
    if (ZSTD_isError(compsize) || compsize != uncomprLen)
      ERRMSG("Decompression failed or size mismatch!");
    const double ratio = COMPRESS_RATIO(uncomprLen, comprLen);
    const double bpv = COMPRESS_BPV(n, comprLen);
    snprintf(codec_info, LEN, "ZSTD, LEVEL=%d", ctl->met_zstd_level);
 
    /* Logging... */
    LOG(2, "Read 3-D variable: %s"
        " (%s, RATIO=%g, BPV=%g, T_DECOMP=%g s, V_DECOMP=%g MiB/s)",
        varname, codec_info, ratio, bpv, t_decomp, COMPRESS_SPEED(uncomprLen,
                                                                  t_decomp));
  }
 
  /* Compress array and output compressed stream... */
  else {
    ZSTD_CCtx *cctx;
    float *tmp_all;
 
    /* Keep one temporary decode buffer for the shared diagnostics path... */
    ALLOC(tmp_all, float,
          n);
 
    cctx = compress_zstd_create_cctx(ctl->met_zstd_level,
                                     ctl->met_zstd_nworkers);
 
    /* Compress one full field with the preconfigured ZSTD context... */
    const double t0 = omp_get_wtime();
    compsize = ZSTD_compress2(cctx, compr, comprLen, uncompr, uncomprLen);
    const double t_comp = omp_get_wtime() - t0;
    if (ZSTD_isError(compsize)) {
      ZSTD_freeCCtx(cctx);
      ERRMSG("Compression failed!");
    } else {
 
      /* Write output... */
      FWRITE(&compsize, size_t,
             1,
             inout);
      FWRITE(compr, unsigned char,
             compsize,
             inout);
    }
 
    /* Decode once more so the common diagnostics see the reconstructed field... */
    const double t1 = omp_get_wtime();
    const size_t decomp_size = ZSTD_decompress(tmp_all, uncomprLen, compr,
                                               compsize);
    const double t_decomp = omp_get_wtime() - t1;
    if (ZSTD_isError(decomp_size) || decomp_size != uncomprLen)
      ERRMSG("Decompression failed or size mismatch!");
 
    const double ratio = COMPRESS_RATIO(uncomprLen, compsize);
    const double bpv = COMPRESS_BPV(n, compsize);
    compress_log_levels_3d(level_log, "ZSTD", varname, met, array, tmp_all,
                           nxy, nz, ratio, bpv, t_comp, t_decomp, uncomprLen);
 
    snprintf(codec_info, LEN, "ZSTD, LEVEL=%d, NWORKERS=%d",
             ctl->met_zstd_level, ctl->met_zstd_nworkers);
 
    /* Logging... */
    LOG(2, "Write 3-D variable: %s"
        " (%s, RATIO=%g, BPV=%g, T_COMP=%g s, V_COMP=%g MiB/s,"
        " T_DECOMP=%g s, V_DECOMP=%g MiB/s)",
        varname, codec_info, ratio, bpv, t_comp, COMPRESS_SPEED(uncomprLen,
                                                                t_comp),
        t_decomp, COMPRESS_SPEED(uncomprLen, t_decomp));
 
    /* Free... */
    ZSTD_freeCCtx(cctx);
    free(tmp_all);
  }
 
  /* Free... */
  free(compr);
}
#endif
 
/*****************************************************************************/
 
#ifdef LZ4
void compress_lz4(
  const ctl_t *ctl,
  const met_t *met,
  const char *varname,
  float *array,
  const int decompress,
  FILE *level_log,
  FILE *inout) {
 
  /* Get buffer sizes... */
  const size_t nxy = (size_t) met->nx * (size_t) met->ny;
  const size_t nz = (size_t) met->np;
  const size_t n = nxy * nz;
  const size_t uncomprLen = n * sizeof(float);
  if (uncomprLen > (size_t) INT_MAX)
    ERRMSG("LZ4 input buffer exceeds INT_MAX!");
  const int uncomprLenInt = (int) uncomprLen;
  const int accel = ctl->met_lz4_accel > 0 ? ctl->met_lz4_accel : 1;
  const int comprCapInt = LZ4_compressBound(uncomprLenInt);
  if (comprCapInt <= 0)
    ERRMSG("Cannot determine LZ4 compression bound!");
  size_t comprLen = (size_t) comprCapInt;
 
  /* Allocate... */
  char *compr, *uncompr = (char *) array;
  char codec_info[LEN];
  ALLOC(compr, char,
        comprLen);
  snprintf(codec_info, LEN, "LZ4, ACCEL=%d", accel);
 
  /* Read compressed stream and decompress array... */
  if (decompress) {
 
    /* Read input... */
    FREAD(&comprLen, size_t,
          1,
          inout);
    if (comprLen > (size_t) INT_MAX)
      ERRMSG("LZ4 compressed buffer exceeds INT_MAX!");
    FREAD(compr, unsigned char,
          comprLen,
          inout);
 
    /* Decode one full frame and validate the restored byte count... */
    const double t0 = omp_get_wtime();
    const int decomp_size =
      LZ4_decompress_safe(compr, uncompr, (int) comprLen, uncomprLenInt);
    const double t_decomp = omp_get_wtime() - t0;
    if (decomp_size != uncomprLenInt)
      ERRMSG("Decompression failed or size mismatch!");
    const double ratio = COMPRESS_RATIO(uncomprLen, comprLen);
    const double bpv = COMPRESS_BPV(n, comprLen);
 
    /* Logging... */
    LOG(2, "Read 3-D variable: %s"
        " (%s, RATIO=%g, BPV=%g, T_DECOMP=%g s, V_DECOMP=%g MiB/s)",
        varname, codec_info, ratio, bpv, t_decomp, COMPRESS_SPEED(uncomprLen,
                                                                  t_decomp));
  }
 
  /* Compress array and output compressed stream... */
  else {
    float *tmp_all;
 
    /* Keep one temporary decode buffer for the shared diagnostics path... */
    ALLOC(tmp_all, float,
          n);
 
    /* Compress one full field with the configured LZ4 acceleration... */
    const double t0 = omp_get_wtime();
    const int compsizeInt =
      LZ4_compress_fast(uncompr, compr, uncomprLenInt, comprCapInt, accel);
    const double t_comp = omp_get_wtime() - t0;
    if (compsizeInt <= 0)
      ERRMSG("Compression failed!");
    const size_t compsize = (size_t) compsizeInt;
 
    /* Write output... */
    FWRITE(&compsize, size_t,
           1,
           inout);
    FWRITE(compr, unsigned char,
           compsize,
           inout);
 
    /* Decode once more so the common diagnostics see the reconstructed field... */
    const double t1 = omp_get_wtime();
    const int decomp_size =
      LZ4_decompress_safe(compr, (char *) tmp_all, compsizeInt,
                          uncomprLenInt);
    const double t_decomp = omp_get_wtime() - t1;
    if (decomp_size != uncomprLenInt)
      ERRMSG("Decompression failed or size mismatch!");
 
    const double ratio = COMPRESS_RATIO(uncomprLen, compsize);
    const double bpv = COMPRESS_BPV(n, compsize);
    compress_log_levels_3d(level_log, "LZ4", varname, met, array, tmp_all,
                           nxy, nz, ratio, bpv, t_comp, t_decomp, uncomprLen);
 
    /* Logging... */
    LOG(2, "Write 3-D variable: %s"
        " (%s, RATIO=%g, BPV=%g, T_COMP=%g s, V_COMP=%g MiB/s,"
        " T_DECOMP=%g s, V_DECOMP=%g MiB/s)",
        varname, codec_info, ratio, bpv, t_comp, COMPRESS_SPEED(uncomprLen,
                                                                t_comp),
        t_decomp, COMPRESS_SPEED(uncomprLen, t_decomp));
 
    free(tmp_all);
  }
 
  /* Free... */
  free(compr);
}
#endif
 
/*****************************************************************************/
 
double cos_sza(
  const double sec,
  const double lon,
  const double lat) {
 
  /* Number of days and fraction with respect to 2000-01-01T12:00Z... */
  const double D = sec / 86400 - 0.5;
 
  /* Geocentric apparent ecliptic longitude [rad]... */
  const double g = DEG2RAD(357.529 + 0.98560028 * D);
  const double q = 280.459 + 0.98564736 * D;
  const double L = DEG2RAD(q + 1.915 * sin(g) + 0.020 * sin(2 * g));
 
  /* Mean obliquity of the ecliptic [rad]... */
  const double e = DEG2RAD(23.439 - 0.00000036 * D);
 
  /* Declination [rad]... */
  const double sindec = sin(e) * sin(L);
 
  /* Right ascension [rad]... */
  const double ra = atan2(cos(e) * sin(L), cos(L));
 
  /* Greenwich Mean Sidereal Time [h]... */
  const double GMST = 18.697374558 + 24.06570982441908 * D;
 
  /* Local Sidereal Time [h]... */
  const double LST = GMST + lon / 15;
 
  /* Hour angle [rad]... */
  const double h = LST / 12 * M_PI - ra;
 
  /* Convert latitude... */
  const double lat_help = DEG2RAD(lat);
 
  /* Return cosine of solar zenith angle... */
  return sin(lat_help) * sindec + cos(lat_help) * sqrt(1 -
                                                       SQR(sindec)) * cos(h);
}
 
/*****************************************************************************/
 
void day2doy(
  const int year,
  const int mon,
  const int day,
  int *doy) {
 
  const int
    d0[12] = { 1, 32, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335 },
    d0l[12] = { 1, 32, 61, 92, 122, 153, 183, 214, 245, 275, 306, 336 };
 
  /* Get day of year... */
  if (year % 400 == 0 || (year % 100 != 0 && year % 4 == 0))
    *doy = d0l[mon - 1] + day - 1;
  else
    *doy = d0[mon - 1] + day - 1;
}
 
/*****************************************************************************/
 
#ifdef DD
/* Per-rank communication statistics use the existing MPI send counts. */
#if LOGLEV >= 2
static int *dd_node;
static int dd_particle_bytes;
static unsigned long long dd_sent, dd_intra, dd_inter;
#endif
 
void dd_assign_subdomains(
  const ctl_t *ctl,
  const dd_t *dd,
  atm_t *atm,
  const int init) {
 
  /* Set timer... */
  SELECT_TIMER("DD_ASSIGN_SUBDOMAINS", "DD");
 
  /* Get MPI rank... */
  int rank;
  MPI_Comm_rank(MPI_COMM_WORLD, &rank);
 
  /* Determine owned core subdomain in index space... */
  const int zonal_rank = rank / ctl->dd_subdomains_meridional;
  const int merid_rank = rank % ctl->dd_subdomains_meridional;
 
  const int nx_block = dd->nx_glob / ctl->dd_subdomains_zonal;
  const int ny_block = dd->ny_glob / ctl->dd_subdomains_meridional;
 
  const int ix0 = zonal_rank * nx_block;
  const int iy0 = merid_rank * ny_block;
 
  const int ix1 = ix0 + nx_block
    + (zonal_rank == ctl->dd_subdomains_zonal - 1 ?
       dd->nx_glob - ctl->dd_subdomains_zonal * nx_block : 0);
 
  const int iy1 = iy0 + ny_block
    + (merid_rank == ctl->dd_subdomains_meridional - 1 ?
       dd->ny_glob - ctl->dd_subdomains_meridional * ny_block : 0);
 
  /* Loop over particles... */
#ifdef _OPENACC
#pragma acc update device(dd->nx_glob, dd->ny_glob, \
                          dd->lon_glob[:dd->nx_glob], \
                          dd->lat_glob[:dd->ny_glob])
#pragma acc data present(atm, ctl, dd)
#pragma acc parallel loop independent gang vector
#endif
  for (int ip = 0; ip < atm->np; ip++) {
 
    /* Skip already invalid particles... */
    if (!init && (int) atm->q[ctl->qnt_current_subdomain][ip] == -1)
      continue;
 
    /* Normalize coordinates... */
    double lon = atm->lon[ip];
    double lat = atm->lat[ip];
    dd_normalize_lon_lat(dd, &lon, &lat);
 
    /* Check whether particle is inside owned core subdomain... */
    const int ix = locate_reg(dd->lon_glob, dd->nx_glob, lon);
    const int iy = locate_irr(dd->lat_glob, dd->ny_glob, lat);
    const int inside = (ix >= ix0 && ix < ix1 && iy >= iy0 && iy < iy1);
 
    /* Init... */
    if (init) {
      atm->q[ctl->qnt_current_subdomain][ip] = inside ? rank : -1;
      atm->q[ctl->qnt_target_subdomain][ip] = inside ? rank : -1;
    }
 
    /* Reassign... */
    else {
      atm->q[ctl->qnt_target_subdomain][ip] =
        inside ? rank : dd_calc_subdomain_from_coords(ctl, dd, lon, lat);
    }
  }
}
#endif
 
/*****************************************************************************/
 
#ifdef DD
void dd_atm2particles(
  const ctl_t *ctl,
  cache_t *cache,
  atm_t *atm,
  particle_t *particles,
  const int npart) {
 
  /* Set timer... */
  SELECT_TIMER("DD_ATM2PARTICLES", "DD");
 
  /* Check if particles are present... */
  if (npart == 0)
    return;
 
  int rank;
  MPI_Comm_rank(MPI_COMM_WORLD, &rank);
 
  /* Select the particles that will be send... */
#ifdef _OPENACC
#pragma acc enter data create(npart, particles[:npart])
#pragma acc update device(npart, particles[:npart])
#pragma acc parallel loop present(atm, ctl, particles, cache, npart)
#endif
  for (int ip = atm->np; ip < atm->np + npart; ip++)
    if (((int) (atm->q[ctl->qnt_target_subdomain][ip]) != rank)
        && ((int) (atm->q[ctl->qnt_target_subdomain][ip]) >= 0)
        && ((int) atm->q[ctl->qnt_current_subdomain][ip] >= 0)) {
 
      particles[ip - atm->np].time = atm->time[ip];
      particles[ip - atm->np].lon = atm->lon[ip];
      particles[ip - atm->np].lat = atm->lat[ip];
      particles[ip - atm->np].p = atm->p[ip];
      for (int iq = 0; iq < ctl->nq; iq++)
        particles[ip - atm->np].q[iq] = atm->q[iq][ip];
      for (int i = 0; i < 3; i++)
        particles[ip - atm->np].uvwp[i] = cache->uvwp[ip][i];
 
      atm->q[ctl->qnt_current_subdomain][ip] = -1;
      cache->dt[ip] = 0;
    }
#ifdef _OPENACC
#pragma acc update host( particles[:npart])
#pragma acc exit data delete(npart, particles)
#endif
}
#endif
 
/*****************************************************************************/
 
#ifdef DD
void dd_pack_compact(
  const ctl_t *ctl,
  cache_t *cache,
  atm_t *atm,
  dd_t *dd,
  particle_t *particles,
  const int nkeep,
  const int npart) {
 
  /* Set timer... */
  SELECT_TIMER("DD_PACK_COMPACT", "DD");
 
  int rank;
  MPI_Comm_rank(MPI_COMM_WORLD, &rank);
 
  const int np = atm->np;
#ifdef _OPENACC
  /* The permutation was built by dd_count_outgoing(): kept particles at
     the front and outgoing particles at the back. Pack before compacting,
     since the latter overwrites source slots. */
  if (npart > 0) {
    SELECT_TIMER("DD_GPU_PACK", "DD");
#pragma acc enter data create(particles[0:npart])
#pragma acc parallel loop present(ctl, atm, cache, dd, particles)
    for (int i = 0; i < npart; i++) {
      const int ip = dd->perm[np - 1 - i];
      particles[i].time = atm->time[ip];
      particles[i].p = atm->p[ip];
      particles[i].lon = atm->lon[ip];
      particles[i].lat = atm->lat[ip];
      for (int iq = 0; iq < ctl->nq; iq++)
        particles[i].q[iq] = atm->q[iq][ip];
      for (int j = 0; j < 3; j++)
        particles[i].uvwp[j] = cache->uvwp[ip][j];
    }
    SELECT_TIMER("DD_GPU_SEND_D2H", "DD");
#pragma acc update self(particles[0:npart])
#pragma acc exit data delete(particles[0:npart])
  }
 
  /* sort_array stages one field in dd->tmp before writing it back.
     Thus no parallel read can race with a write to the original field. */
  if (nkeep > 0 && nkeep != np) {
    SELECT_TIMER("DD_GPU_COMPACT", "DD");
    sort_array(atm->time, dd->perm, dd->tmp, nkeep);
    sort_array(atm->p, dd->perm, dd->tmp, nkeep);
    sort_array(atm->lon, dd->perm, dd->tmp, nkeep);
    sort_array(atm->lat, dd->perm, dd->tmp, nkeep);
    for (int iq = 0; iq < ctl->nq; iq++)
      sort_array(atm->q[iq], dd->perm, dd->tmp, nkeep);
    sort_array(cache->dt, dd->perm, dd->tmp, nkeep);
    sort_uvwp(cache, dd->perm, dd->tmp, nkeep);
  }
 
  const int nlost = np - nkeep - npart;
  if (nlost > 0)
    WARN("Rank %d: %d particles have invalid subdomain and will be lost",
         rank, nlost);
  atm->np = nkeep;
#pragma acc update device(atm->np)
#else
  (void) dd;
  (void) nkeep;
 
  /* Pack outgoing particles and fill gaps with the remaining local ones... */
  int nkeep_cpu = 0, nsend = 0, nlost = 0;
  for (int ip = 0; ip < np; ip++) {
    const int current = (int) atm->q[ctl->qnt_current_subdomain][ip];
    const int target = (int) atm->q[ctl->qnt_target_subdomain][ip];
    if (current < 0 || target < 0) {
      nlost++;
      continue;
    }
 
    if (target != rank) {
      particles[nsend].time = atm->time[ip];
      particles[nsend].p = atm->p[ip];
      particles[nsend].lon = atm->lon[ip];
      particles[nsend].lat = atm->lat[ip];
      for (int iq = 0; iq < ctl->nq; iq++)
        particles[nsend].q[iq] = atm->q[iq][ip];
      for (int i = 0; i < 3; i++)
        particles[nsend].uvwp[i] = cache->uvwp[ip][i];
      nsend++;
      continue;
    }
 
    if (nkeep_cpu != ip) {
      atm->time[nkeep_cpu] = atm->time[ip];
      atm->p[nkeep_cpu] = atm->p[ip];
      atm->lon[nkeep_cpu] = atm->lon[ip];
      atm->lat[nkeep_cpu] = atm->lat[ip];
      for (int iq = 0; iq < ctl->nq; iq++)
        atm->q[iq][nkeep_cpu] = atm->q[iq][ip];
      cache->dt[nkeep_cpu] = cache->dt[ip];
      for (int i = 0; i < 3; i++)
        cache->uvwp[nkeep_cpu][i] = cache->uvwp[ip][i];
    }
    nkeep_cpu++;
  }
 
  if (nsend != npart)
    ERRMSG("Inconsistent number of outgoing particles!");
  if (nlost > 0)
    WARN("Rank %d: %d particles have invalid subdomain and will be lost",
         rank, nlost);
  atm->np = nkeep_cpu;
#endif
}
#endif
 
/*****************************************************************************/
 
#ifdef DD
int dd_calc_subdomain_from_coords(
  const ctl_t *ctl,
  const dd_t *dd,
  double lon,
  double lat) {
 
  /* Normalize coordinates... */
  dd_normalize_lon_lat(dd, &lon, &lat);
 
  /* Get grid index... */
  const int ix = locate_reg(dd->lon_glob, dd->nx_glob, lon);
  const int iy = locate_irr(dd->lat_glob, dd->ny_glob, lat);
 
  /* Get zonal subdomain index... */
  const int nx_block = dd->nx_glob / ctl->dd_subdomains_zonal;
  int zonal_rank = ix / nx_block;
  if (zonal_rank >= ctl->dd_subdomains_zonal)
    zonal_rank = ctl->dd_subdomains_zonal - 1;
 
  /* Get meridional subdomain index... */
  const int ny_block = dd->ny_glob / ctl->dd_subdomains_meridional;
  int merid_rank = iy / ny_block;
  if (merid_rank >= ctl->dd_subdomains_meridional)
    merid_rank = ctl->dd_subdomains_meridional - 1;
 
  /* Return rank... */
  return zonal_rank * ctl->dd_subdomains_meridional + merid_rank;
}
#endif
 
/*****************************************************************************/
 
#ifdef DD
void dd_communicate_particles(
  const ctl_t *ctl,
  const dd_t *dd,
  particle_t **particles,
  int *npart,
  int *capacity) {
 
  /* Set timer... */
  SELECT_TIMER("DD_COMMUNICATE_PARTICLES", "DD");
 
  int rank, size;
  MPI_Comm_rank(MPI_COMM_WORLD, &rank);
  MPI_Comm_size(MPI_COMM_WORLD, &size);
 
  int *send_counts, *recv_counts;
  int *send_displs, *recv_displs;
  int *offsets;
 
  particle_t *sendbuf = NULL;
  particle_t *recvbuf = NULL;
 
  ALLOC(send_counts, int,
        size);
  ALLOC(recv_counts, int,
        size);
  ALLOC(send_displs, int,
        size);
  ALLOC(recv_displs, int,
        size);
  ALLOC(offsets, int,
        size);
 
  /* Count particles per destination rank... */
#pragma omp parallel for
  for (int ip = 0; ip < *npart; ip++) {
    const int dest = (int) (*particles)[ip].q[ctl->qnt_target_subdomain];
    if (dest == rank)
      continue;
    if (dest < 0 || dest >= size)
      ERRMSG("Invalid destination rank!");
#pragma omp atomic
    send_counts[dest]++;
  }
 
  /* Compute send displacements... */
  int nsend = 0;
  for (int i = 0; i < size; i++) {
    send_displs[i] = nsend;
    nsend += send_counts[i];
  }
#if LOGLEV >= 3
  LOG(3, "DD_SEND rank=%d particles=%d", rank, nsend);
#endif
 
  /* Classify the already available MPI counts without scanning particles. */
#if LOGLEV >= 2
  if (dd_node != NULL) {
    dd_sent += (unsigned long long) nsend;
    for (int i = 0; i < size; i++) {
      if (dd_node[i] == dd_node[rank])
        dd_intra += (unsigned long long) send_counts[i];
      else
        dd_inter += (unsigned long long) send_counts[i];
    }
  }
#endif
 
  /* Exchange particle counts... */
  MPI_Alltoall(send_counts, 1, MPI_INT,
               recv_counts, 1, MPI_INT, MPI_COMM_WORLD);
 
  /* Compute receive displacements... */
  int nrecv = 0;
  for (int i = 0; i < size; i++) {
    recv_displs[i] = nrecv;
    nrecv += recv_counts[i];
  }
  if (nsend > 0)
    ALLOC(sendbuf, particle_t, nsend);
  if (nrecv > 0)
    ALLOC(recvbuf, particle_t, nrecv);
  for (int i = 0; i < size; i++)
    offsets[i] = send_displs[i];
 
  /* Pack particles into send buffer... */
  for (int ip = 0; ip < *npart; ip++) {
    const int dest = (int) (*particles)[ip].q[ctl->qnt_target_subdomain];
    if (dest == rank)
      continue;
    memcpy(&sendbuf[offsets[dest]], &(*particles)[ip], sizeof(particle_t));
    offsets[dest]++;
  }
 
  /* Exchange particle data... */
  MPI_Alltoallv(sendbuf,
                send_counts,
                send_displs,
                dd->MPI_Particle,
                recvbuf,
                recv_counts, recv_displs, dd->MPI_Particle, MPI_COMM_WORLD);
 
  /* Resize particle buffer if necessary... */
  if (nrecv > *capacity) {
    const int newcap = nrecv + nrecv / 2 + 1;
    particle_t *tmp =
      realloc(*particles, (size_t) newcap * sizeof(particle_t));
    if (!tmp)
      ERRMSG("Out of memory!");
    *particles = tmp;
    *capacity = newcap;
  }
 
  /* Copy received particles... */
#pragma omp parallel for
  for (int ip = 0; ip < nrecv; ip++) {
    (*particles)[ip] = recvbuf[ip];
    (*particles)[ip].q[ctl->qnt_target_subdomain] = rank;
    (*particles)[ip].q[ctl->qnt_current_subdomain] = rank;
  }
  *npart = nrecv;
 
  /* Free temporary buffers... */
  if (sendbuf)
    free(sendbuf);
  if (recvbuf)
    free(recvbuf);
  free(send_counts);
  free(recv_counts);
  free(send_displs);
  free(recv_displs);
  free(offsets);
}
#endif
 
/*****************************************************************************/
 
#ifdef DD
void dd_init(
  const ctl_t *ctl,
  dd_t *dd,
  atm_t *atm) {
 
  /* Check configuration... */
  if ((ctl->dd) &&
      (ctl->dd_subdomains_zonal * ctl->dd_subdomains_meridional == 1))
    ERRMSG("Please provide zonal and meridional subdomain numbers!");
  if (!ctl->dd)
    ERRMSG("Activate control flag DD!");
 
  /* Check if enough tasks are requested... */
  int size;
  MPI_Comm_size(MPI_COMM_WORLD, &size);
  if (size != ctl->dd_subdomains_meridional * ctl->dd_subdomains_zonal)
    ERRMSG("Number of tasks and subdomains is not identical!");
 
  /* Register the MPI_Particle data type... */
  const MPI_Datatype types[6] =
    { MPI_DOUBLE, MPI_DOUBLE, MPI_DOUBLE, MPI_DOUBLE, MPI_DOUBLE,
    MPI_FLOAT };
  const int blocklengths[6] = { 1, 1, 1, 1, NQ, 3 };
  const MPI_Aint displacements[6] =
    { offsetof(particle_t, time), offsetof(particle_t, p),
    offsetof(particle_t, lon), offsetof(particle_t, lat),
    offsetof(particle_t, q), offsetof(particle_t, uvwp)
  };
  MPI_Datatype fields;
  MPI_Type_create_struct(6, blocklengths, displacements, types, &fields);
  /* The trailing float array can leave padding in particle_t. Alltoallv
     counts and displacements must advance by the full C structure size. */
  MPI_Type_create_resized(fields, 0, (MPI_Aint) sizeof(particle_t),
                          &dd->MPI_Particle);
  MPI_Type_free(&fields);
  MPI_Type_commit(&dd->MPI_Particle);
  MPI_Aint lower_bound, extent;
  MPI_Type_get_extent(dd->MPI_Particle, &lower_bound, &extent);
  if (lower_bound != 0 || extent != (MPI_Aint) sizeof(particle_t))
    ERRMSG("Invalid MPI particle datatype extent!");
 
  LOG(1, "DD: %d x %d subdomains | exchange mode %d | initial particles %d",
      ctl->dd_subdomains_zonal, ctl->dd_subdomains_meridional,
      ctl->dd_exchange_mode, atm->np);
 
  /* Discover node placement once when detailed logging is enabled. */
#if LOGLEV >= 2
  {
    int rank, local_rank, leader;
    MPI_Comm shared;
    MPI_Comm_rank(MPI_COMM_WORLD, &rank);
    MPI_Comm_split_type(MPI_COMM_WORLD, MPI_COMM_TYPE_SHARED, rank,
                        MPI_INFO_NULL, &shared);
    MPI_Comm_rank(shared, &local_rank);
    leader = local_rank == 0 ? rank : -1;
    MPI_Bcast(&leader, 1, MPI_INT, 0, shared);
    ALLOC(dd_node, int, size);
    MPI_Allgather(&leader, 1, MPI_INT, dd_node, 1, MPI_INT,
                  MPI_COMM_WORLD);
    MPI_Type_size(dd->MPI_Particle, &dd_particle_bytes);
    dd_sent = dd_intra = dd_inter = 0;
    char hostname[MPI_MAX_PROCESSOR_NAME];
    int hostname_len;
    MPI_Get_processor_name(hostname, &hostname_len);
    const char *gpu = getenv("CUDA_VISIBLE_DEVICES");
    LOG(2, "DD_NODE rank=%d leader=%d local_rank=%d host=%s gpu=%s",
        rank, leader, local_rank, hostname, gpu ? gpu : "-");
    MPI_Comm_free(&shared);
  }
#endif
 
  /* Check if particles are in subdomain... */
  dd_assign_subdomains(ctl, dd, atm, 1);
}
#endif
 
/*****************************************************************************/
 
#ifdef DD
void dd_normalize_lon_lat(
  const dd_t *dd,
  double *lon,
  double *lat) {
 
  const double lon_min = (dd->lon_glob[0] < 0) ? -180.0 : 0.0;
 
  /* Normalize longitude to match global grid convention... */
  *lon = FMOD(*lon - lon_min, 360.0);
  if (*lon < 0.0)
    *lon += 360.0;
  *lon += lon_min;
 
  /* Wrap latitude across the poles and shift longitude... */
  if (*lat > 90.0) {
    *lat = 180.0 - *lat;
    *lon += 180.0;
  } else if (*lat < -90.0) {
    *lat = -180.0 - *lat;
    *lon += 180.0;
  }
 
  /* Renormalize longitude after pole crossing... */
  *lon = FMOD(*lon - lon_min, 360.0);
  if (*lon < 0.0)
    *lon += 360.0;
  *lon += lon_min;
}
#endif
 
/*****************************************************************************/
 
#ifdef DD
void dd_particles2atm(
  const ctl_t *ctl,
  cache_t *cache,
  const particle_t *particles,
  const int npart,
  atm_t *atm) {
 
  /* Set timer... */
  SELECT_TIMER("DD_PARTICLES2ATM", "DD");
 
  /* Check if particles are present... */
  if (npart == 0)
    return;
 
  /* Check number of particles... */
  if (atm->np + npart > NP)
    ERRMSG("Too many particles. Increase NP!");
 
#ifdef _OPENACC
#pragma acc enter data create(npart, particles[:npart])
#pragma acc update device(particles[:npart], npart)
#pragma acc data present(atm, ctl, cache, particles, npart)
#pragma acc parallel loop
#endif
  for (int ip = atm->np; ip < atm->np + npart; ip++) {
    atm->time[ip] = particles[ip - atm->np].time;
    atm->lon[ip] = particles[ip - atm->np].lon;
    atm->lat[ip] = particles[ip - atm->np].lat;
    atm->p[ip] = particles[ip - atm->np].p;
    for (int iq = 0; iq < ctl->nq; iq++)
      atm->q[iq][ip] = particles[ip - atm->np].q[iq];
    for (int i = 0; i < 3; i++)
      cache->uvwp[ip][i] = particles[ip - atm->np].uvwp[i];
    cache->dt[ip] = ctl->dt_mod;
  }
#ifdef _OPENACC
#pragma acc exit data delete(npart, particles)
#endif
 
  /* Reset size... */
  atm->np += npart;
#ifdef _OPENACC
#pragma acc update device(atm->np)
#endif
}
#endif
 
/*****************************************************************************/
 
void sort_array(
  double *array,
  const int *perm,
  double *tmp,
  const int np) {
 
  if (np == 0)
    return;
 
  /* The caller keeps all three buffers resident on the device. */
#ifdef _OPENACC
#pragma acc data present(array[0:np],perm[0:np],tmp[0:np])
#endif
  {
 
  /* perm maps each destination index to its original source index. Gather
     every source value before any destination can overwrite it. */
#ifdef _OPENACC
#pragma acc parallel loop independent gang vector
#else
#pragma omp parallel for default(shared)
#endif
  for (int ip = 0; ip < np; ip++)
    tmp[ip] = array[perm[ip]];
 
  /* The staging pass is complete, so writes to array are independent. */
#ifdef _OPENACC
#pragma acc parallel loop independent gang vector
#else
#pragma omp parallel for default(shared)
#endif
  for (int ip = 0; ip < np; ip++)
    array[ip] = tmp[ip];
  }
}
 
/*****************************************************************************/
 
void sort_uvwp(
  cache_t *cache,
  const int *perm,
  double *tmp,
  const int np) {
 
  if (np == 0)
    return;
 
  /* Reuse the caller's device-resident permutation and staging buffer. */
#ifdef _OPENACC
#pragma acc data present(cache,perm[0:np],tmp[0:np])
#endif
  {
 
  /* The three float components share one double staging buffer. Finish
     both passes for a component before reusing the buffer for the next. */
  for (int j = 0; j < 3; j++) {
    /* Gather first so in-place writes cannot race with source reads. */
#ifdef _OPENACC
#pragma acc parallel loop
#else
#pragma omp parallel for
#endif
    for (int ip = 0; ip < np; ip++)
      tmp[ip] = cache->uvwp[perm[ip]][j];
 
    /* Every float value is represented exactly while staged as double. */
#ifdef _OPENACC
#pragma acc parallel loop
#else
#pragma omp parallel for
#endif
    for (int ip = 0; ip < np; ip++)
      cache->uvwp[ip][j] = (float) tmp[ip];
  }
  }
}
 
/*****************************************************************************/
 
#ifdef DD
void dd_push(
  const ctl_t *ctl,
  atm_t *atm,
  cache_t *cache,
  int *npart) {
  SELECT_TIMER("DD_PUSH", "DD");
  int rank;
  MPI_Comm_rank(MPI_COMM_WORLD, &rank);
 
  int counter = 0;
 
#ifdef _OPENACC
  int *counter_ptr = (int *) acc_malloc(sizeof(int));
  if (counter_ptr == NULL) {
    ERRMSG("Failed to allocate device counter memory!");
  }
  acc_memcpy_to_device(counter_ptr, &counter, sizeof(int));
#else
  int *counter_ptr = &counter;
#endif
 
  /* Push non local particles behind the end of the atm... */
#ifdef _OPENACC
#pragma acc parallel loop present(atm, cache, ctl) deviceptr(counter_ptr)
#else
#pragma omp parallel for
#endif
  for (int ip = 0; ip < atm->np; ip++) {
    if ((int) atm->q[ctl->qnt_current_subdomain][ip] != -1 &&
        (int) atm->q[ctl->qnt_target_subdomain][ip] != rank) {
      int local_idx;
#ifdef _OPENACC
#pragma acc atomic capture
#else
#pragma omp atomic capture
#endif
      {
        local_idx = *counter_ptr;
        (*counter_ptr)++;
      }
      int global_index = atm->np + local_idx;
      if (global_index >= NP)
        continue;
      /* Copy time, pressure, longitude, and latitude... */
      atm->time[global_index] = atm->time[ip];
      atm->p[global_index] = atm->p[ip];
      atm->lon[global_index] = atm->lon[ip];
      atm->lat[global_index] = atm->lat[ip];
      /* Copy all quantity data (q array)... */
      for (int iq = 0; iq < ctl->nq; iq++) {
        atm->q[iq][global_index] = atm->q[iq][ip];
      }
      /* Mark the original parcel as processed... */
      atm->q[ctl->qnt_target_subdomain][ip] = -1;
      atm->q[ctl->qnt_current_subdomain][ip] = -1;
      /* Reset cache->dt for the shifted particle... */
      cache->dt[global_index] = cache->dt[ip];
      cache->dt[ip] = 0;
      for (int i = 0; i < 3; i++)
        cache->uvwp[global_index][i] = cache->uvwp[ip][i];
    }
  }
 
#ifdef _OPENACC
  acc_memcpy_from_device(npart, counter_ptr, sizeof(int));
  acc_free(counter_ptr);
#else
  *npart = counter;
#endif
 
  if (atm->np + *npart > NP)
    ERRMSG("Too many particles during DD push. Increase NP!");
}
#endif
 
/*****************************************************************************/
 
#ifdef DD
void dd_sort(
  const ctl_t *ctl,
  const met_t *met0,
  cache_t *cache,
  atm_t *atm,
  dd_t *dd,
  int *npart) {
 
  /* Set timer... */
  SELECT_TIMER("DD_SORT", "DD");
 
  int rank;
  MPI_Comm_rank(MPI_COMM_WORLD, &rank);
 
  /* Allocate... */
  const int np = atm->np;
  double amax = (met0->nx * met0->ny + met0->ny) * met0->np + met0->np;
#ifdef _OPENACC
#pragma acc enter data create(amax)
#pragma acc update device(amax)
#pragma acc data present(ctl,met0,atm,dd,amax)
#endif
 
  /* Get box index... */
#ifdef _OPENACC
#pragma acc parallel loop independent gang vector
#else
#pragma omp parallel for default(shared)
#endif
  for (int ip = 0; ip < np; ip++) {
    if ((int) atm->q[ctl->qnt_current_subdomain][ip] != -1) {
      if ((int) atm->q[ctl->qnt_target_subdomain][ip] == rank)
        dd->sort_key[ip] =
          (double) ((locate_reg(met0->lon, met0->nx, atm->lon[ip]) *
                     met0->ny + locate_irr(met0->lat, met0->ny, atm->lat[ip]))
                    * met0->np + locate_irr(met0->p, met0->np, atm->p[ip]));
      else
        dd->sort_key[ip] = amax + 1;
    } else {
      dd->sort_key[ip] = amax + 2;
    }
    dd->perm[ip] = ip;
  }
 
  /* Sorting... */
#ifdef THRUST
#ifdef _OPENACC
#pragma acc host_data use_device(dd->sort_key, dd->perm)
#endif
  thrustSortWrapper(dd->sort_key, np, dd->perm);
#else
  size_t *perm_sz = (size_t *) malloc((size_t) np * sizeof(size_t));
  if (perm_sz == NULL)
    ERRMSG("Out of memory!");
#ifdef _OPENACC
#pragma acc update self(dd->sort_key[0:np])
#endif
  gsl_sort_index(perm_sz, dd->sort_key, 1, (size_t) np);
  for (int ip = 0; ip < np; ++ip)
    dd->perm[ip] = (int) perm_sz[ip];
  free(perm_sz);
#ifdef _OPENACC
#pragma acc update device(dd->perm[0:np])
#endif
#endif
 
  /* Sort data... */
  sort_array(atm->time, dd->perm, dd->tmp, np);
  sort_array(atm->p, dd->perm, dd->tmp, np);
  sort_array(atm->lon, dd->perm, dd->tmp, np);
  sort_array(atm->lat, dd->perm, dd->tmp, np);
  for (int iq = 0; iq < ctl->nq; iq++)
    sort_array(atm->q[iq], dd->perm, dd->tmp, np);
  sort_array(cache->dt, dd->perm, dd->tmp, np);
  sort_uvwp(cache, dd->perm, dd->tmp, np);
 
  /* Count kept, outgoing, and invalid particles in one pass... */
  int nkeep = 0, nsend = 0, nlost = 0;
#ifdef _OPENACC
#pragma acc parallel loop reduction(+:nkeep,nsend,nlost) present(atm, ctl)
#endif
  for (int ip = 0; ip < np; ip++) {
    const int current = (int) atm->q[ctl->qnt_current_subdomain][ip];
    const int target = (int) atm->q[ctl->qnt_target_subdomain][ip];
    if (current == -1)
      nlost++;
    else if (target == rank)
      nkeep++;
    else
      nsend++;
  }
 
  /* Reset sizes... */
  *npart = nsend;
 
  if (nlost > 0)
    WARN
      ("Rank %d: %d particles have subdomain index -1 and will be lost (kept: %d, to_send: %d, total_before: %d)",
       rank, nlost, nkeep, nsend, np);
 
  atm->np = nkeep;
#ifdef _OPENACC
#pragma acc update device(atm->np)
#endif
 
  /* Free... */
#ifdef _OPENACC
#pragma acc exit data delete(amax)
#endif
}
#endif
 
/*****************************************************************************/
 
#ifdef DD
void dd_count_outgoing(
  const ctl_t *ctl,
  const atm_t *atm,
  dd_t *dd,
  int *nkeep,
  int *npart) {
 
  /* Count particles that must be sent to another rank... */
  SELECT_TIMER("DD_COUNT_OUTGOING", "DD");
  int rank;
  MPI_Comm_rank(MPI_COMM_WORLD, &rank);
  const int np = atm->np;
#ifdef _OPENACC
  int counts[2] = { 0, 0 };
  if (np > 0) {
    SELECT_TIMER("DD_GPU_CLASSIFY", "DD");
#pragma acc data copy(counts[0:2]) present(ctl, atm, dd)
    {
#pragma acc parallel loop
      for (int ip = 0; ip < np; ip++) {
        const int current = (int) atm->q[ctl->qnt_current_subdomain][ip];
        const int target = (int) atm->q[ctl->qnt_target_subdomain][ip];
        int i;
        if (current < 0 || target < 0)
          continue;
        if (target == rank) {
#pragma acc atomic capture
          {
            i = counts[0];
            counts[0]++;
          }
          dd->perm[i] = ip;
        } else {
#pragma acc atomic capture
          {
            i = counts[1];
            counts[1]++;
          }
          dd->perm[np - 1 - i] = ip;
        }
      }
    }
  }
  *nkeep = counts[0];
  *npart = counts[1];
#else
  (void) dd;
  int kept = 0;
  int nsend = 0;
  for (int ip = 0; ip < np; ip++) {
    if ((int) atm->q[ctl->qnt_current_subdomain][ip] < 0
        || (int) atm->q[ctl->qnt_target_subdomain][ip] < 0)
      continue;
    if ((int) atm->q[ctl->qnt_target_subdomain][ip] == rank)
      kept++;
    else
      nsend++;
  }
  *nkeep = kept;
  *npart = nsend;
#endif
}
#endif
 
/*****************************************************************************/
 
void doy2day(
  const int year,
  const int doy,
  int *mon,
  int *day) {
 
  const int
    d0[12] = { 1, 32, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335 },
    d0l[12] = { 1, 32, 61, 92, 122, 153, 183, 214, 245, 275, 306, 336 };
 
  int i;
 
  /* Get month and day... */
  if (year % 400 == 0 || (year % 100 != 0 && year % 4 == 0)) {
    for (i = 11; i > 0; i--)
      if (d0l[i] <= doy)
        break;
    *mon = i + 1;
    *day = doy - d0l[i] + 1;
  } else {
    for (i = 11; i > 0; i--)
      if (d0[i] <= doy)
        break;
    *mon = i + 1;
    *day = doy - d0[i] + 1;
  }
}
 
/*****************************************************************************/
 
void fft_help(
  double *fcReal,
  double *fcImag,
  const int n) {
 
  double data[2 * EX];
 
  /* Check size... */
  if (n > EX)
    ERRMSG("Too many data points!");
 
  /* Allocate... */
  gsl_fft_complex_wavetable *wavetable =
    gsl_fft_complex_wavetable_alloc((size_t) n);
  gsl_fft_complex_workspace *workspace =
    gsl_fft_complex_workspace_alloc((size_t) n);
 
  /* Set data (real, complex)... */
  for (int i = 0; i < n; i++) {
    data[2 * i] = fcReal[i];
    data[2 * i + 1] = fcImag[i];
  }
 
  /* Calculate FFT... */
  gsl_fft_complex_forward(data, 1, (size_t) n, wavetable, workspace);
 
  /* Copy data... */
  for (int i = 0; i < n; i++) {
    fcReal[i] = data[2 * i];
    fcImag[i] = data[2 * i + 1];
  }
 
  /* Free... */
  gsl_fft_complex_wavetable_free(wavetable);
  gsl_fft_complex_workspace_free(workspace);
}
 
/*****************************************************************************/
 
void geo2cart(
  const double z,
  const double lon,
  const double lat,
  double *x) {
 
  const double radius = z + RE;
  const double latrad = DEG2RAD(lat);
  const double lonrad = DEG2RAD(lon);
  const double coslat = cos(latrad);
 
  x[0] = radius * coslat * cos(lonrad);
  x[1] = radius * coslat * sin(lonrad);
  x[2] = radius * sin(latrad);
}
 
/*****************************************************************************/
 
void get_met_filename(
  const ctl_t *ctl,
  const double t,
  const int direct,
  const char *metbase,
  const double dt_met,
  char *filename) {
 
  char repl[LEN];
 
  double t6, r;
 
  int year, mon, day, hour, min, sec;
 
  /* Round time to fixed intervals... */
  if (direct == -1)
    t6 = floor(t / dt_met) * dt_met;
  else
    t6 = ceil(t / dt_met) * dt_met;
 
  /* Decode time... */
  jsec2time(t6, &year, &mon, &day, &hour, &min, &sec, &r);
 
  /* Set filename of MPTRAC meteo files... */
  if (ctl->met_clams == 0) {
    if (ctl->met_type == 0)
      sprintf(filename, "%s_YYYY_MM_DD_HH.nc", metbase);
    else if (ctl->met_type == 1)
      sprintf(filename, "%s_YYYY_MM_DD_HH.bin", metbase);
    else if (ctl->met_type == 2)
      sprintf(filename, "%s_YYYY_MM_DD_HH.pck", metbase);
    else if (ctl->met_type == 3)
      sprintf(filename, "%s_YYYY_MM_DD_HH.zfp", metbase);
    else if (ctl->met_type == 4)
      sprintf(filename, "%s_YYYY_MM_DD_HH.zstd", metbase);
    else if (ctl->met_type == 5)
      sprintf(filename, "%s_YYYY_MM_DD_HH.cms", metbase);
    else if (ctl->met_type == 7)
      sprintf(filename, "%s_YYYY_MM_DD_HH.sz3", metbase);
    else if (ctl->met_type == 8)
      sprintf(filename, "%s_YYYY_MM_DD_HH.lz4", metbase);
    sprintf(repl, "%d", year);
    get_met_replace(filename, "YYYY", repl);
    sprintf(repl, "%02d", mon);
    get_met_replace(filename, "MM", repl);
    sprintf(repl, "%02d", day);
    get_met_replace(filename, "DD", repl);
    sprintf(repl, "%02d", hour);
    get_met_replace(filename, "HH", repl);
  }
 
  /* Set filename of CLaMS meteo files... */
  else {
    sprintf(filename, "%s_YYMMDDHH.nc", metbase);
    sprintf(repl, "%d", year);
    get_met_replace(filename, "YYYY", repl);
    sprintf(repl, "%02d", year % 100);
    get_met_replace(filename, "YY", repl);
    sprintf(repl, "%02d", mon);
    get_met_replace(filename, "MM", repl);
    sprintf(repl, "%02d", day);
    get_met_replace(filename, "DD", repl);
    sprintf(repl, "%02d", hour);
    get_met_replace(filename, "HH", repl);
  }
}
 
/*****************************************************************************/
 
void get_met_replace(
  char *orig,
  const char *search,
  const char *repl) {
 
  char buffer[LEN];
 
  /* Iterate... */
  for (int i = 0; i < 3; i++) {
 
    /* Replace sub-string... */
    char *ch;
    if (!(ch = strstr(orig, search)))
      return;
    strncpy(buffer, orig, (size_t) (ch - orig));
    buffer[ch - orig] = 0;
    sprintf(buffer + (ch - orig), "%s%s", repl, ch + strlen(search));
    orig[0] = 0;
    strcpy(orig, buffer);
  }
}
 
/*****************************************************************************/
 
void get_tropo(
  const int met_tropo,
  ctl_t *ctl,
  const clim_t *clim,
  met_t *met,
  const double *lons,
  const int nx,
  const double *lats,
  const int ny,
  double *pt,
  double *zt,
  double *tt,
  double *qt,
  double *o3t,
  double *ps,
  double *zs) {
 
  INTPOL_INIT;
 
  ctl->met_tropo = met_tropo;
  read_met_tropo(ctl, clim, met);
#pragma omp parallel for default(shared) private(ci,cw)
  for (int ix = 0; ix < nx; ix++)
    for (int iy = 0; iy < ny; iy++) {
      intpol_met_space_2d(met, met->pt, lons[ix], lats[iy],
                          &pt[iy * nx + ix], ci, cw, 1);
      intpol_met_space_2d(met, met->ps, lons[ix], lats[iy],
                          &ps[iy * nx + ix], ci, cw, 0);
      intpol_met_space_2d(met, met->zs, lons[ix], lats[iy],
                          &zs[iy * nx + ix], ci, cw, 0);
      intpol_met_space_3d(met, met->z, pt[iy * nx + ix], lons[ix],
                          lats[iy], &zt[iy * nx + ix], ci, cw, 1);
      intpol_met_space_3d(met, met->t, pt[iy * nx + ix], lons[ix],
                          lats[iy], &tt[iy * nx + ix], ci, cw, 0);
      intpol_met_space_3d(met, met->h2o, pt[iy * nx + ix], lons[ix],
                          lats[iy], &qt[iy * nx + ix], ci, cw, 0);
      intpol_met_space_3d(met, met->o3, pt[iy * nx + ix], lons[ix],
                          lats[iy], &o3t[iy * nx + ix], ci, cw, 0);
    }
}
 
/*****************************************************************************/
 
void intpol_check_lon_lat(
  const double *lons,
  const int nlon,
  const double *lats,
  const int nlat,
  const double lon,
  const double lat,
  double *lon2,
  double *lat2) {
 
  /* Check longitude... */
  *lon2 = FMOD(lon, 360.);
  if (*lon2 < lons[0])
    *lon2 += 360;
  else if (*lon2 > lons[nlon - 1])
    *lon2 -= 360;
 
  /* Check latitude... */
  *lat2 = lat;
  if (lats[0] < lats[nlat - 1])
    *lat2 = MIN(MAX(*lat2, lats[0]), lats[nlat - 1]);
  else
    *lat2 = MIN(MAX(*lat2, lats[nlat - 1]), lats[0]);
}
 
/*****************************************************************************/
 
void intpol_check_cartesian(
  const double *lons,
  const int nlon,
  const double *lats,
  const int nlat,
  const double lon,
  const double lat,
  double *lon2,
  double *lat2) {
 
  *lon2 = lon;
  if (lons[0] < lons[nlon - 1])
    *lon2 = MIN(MAX(lon, lons[0]), lons[nlon - 1]);
  else
    *lon2 = MIN(MAX(lon, lons[nlon - 1]), lons[0]);
 
  *lat2 = lat;
  if (lats[0] < lats[nlat - 1])
    *lat2 = MIN(MAX(lat, lats[0]), lats[nlat - 1]);
  else
    *lat2 = MIN(MAX(lat, lats[nlat - 1]), lats[0]);
}
 
 
/*****************************************************************************/
 
void intpol_met_4d_zeta(
  const met_t *met0,
  float heights0[EX][EY][EP],
  float array0[EX][EY][EP],
  const met_t *met1,
  float heights1[EX][EY][EP],
  float array1[EX][EY][EP],
  const double ts,
  const double height,
  const double lon,
  const double lat,
  double *var,
  int *ci,
  double *cw,
  const int init) {
 
  if (init) {
 
    /* Check longitude and latitude... */
    double lon2, lat2;
 
    if (met0->coord_type == 0)
      intpol_check_lon_lat(met0->lon, met0->nx, met0->lat, met0->ny, lon, lat,
                           &lon2, &lat2);
    else
      intpol_check_cartesian(met0->lon, met0->nx, met0->lat, met0->ny, lon,
                             lat, &lon2, &lat2);
 
    /* Get horizontal indizes... */
    ci[0] = locate_reg(met0->lon, met0->nx, lon2);
    ci[1] = locate_irr(met0->lat, met0->ny, lat2);
 
    /* Locate the vertical indizes for each edge of the column... */
    int ind[2][4];
    locate_vert(heights0, met0->npl, ci[0], ci[1], height, ind[0]);
    locate_vert(heights1, met1->npl, ci[0], ci[1], height, ind[1]);
 
    /* Find minimum and maximum indizes... */
    ci[2] = ind[0][0];
    int k_max = ind[0][0];
    for (int i = 0; i < 2; i++)
      for (int j = 0; j < 4; j++) {
        if (ci[2] > ind[i][j])
          ci[2] = ind[i][j];
        if (k_max < ind[i][j])
          k_max = ind[i][j];
      }
 
    /* Get weighting factors for time, longitude and latitude... */
    cw[3] = (ts - met0->time) / (met1->time - met0->time);
    cw[0] = (lon2 - met0->lon[ci[0]]) /
      (met0->lon[ci[0] + 1] - met0->lon[ci[0]]);
    cw[1] = (lat2 - met0->lat[ci[1]]) /
      (met0->lat[ci[1] + 1] - met0->lat[ci[1]]);
 
    /* Interpolate in time at the lowest level... */
    double height00 = cw[3] * (heights1[ci[0]][ci[1]][ci[2]]
                               - heights0[ci[0]][ci[1]][ci[2]])
      + heights0[ci[0]][ci[1]][ci[2]];
    double height01 = cw[3] * (heights1[ci[0]][ci[1] + 1][ci[2]]
                               - heights0[ci[0]][ci[1] + 1][ci[2]])
      + heights0[ci[0]][ci[1] + 1][ci[2]];
    double height10 = cw[3] * (heights1[ci[0] + 1][ci[1]][ci[2]]
                               - heights0[ci[0] + 1][ci[1]][ci[2]])
      + heights0[ci[0] + 1][ci[1]][ci[2]];
    double height11 = cw[3] * (heights1[ci[0] + 1][ci[1] + 1][ci[2]]
                               - heights0[ci[0] + 1][ci[1] + 1][ci[2]])
      + heights0[ci[0] + 1][ci[1] + 1][ci[2]];
 
    /* Interpolate in latitude direction... */
    double height0 = cw[1] * (height01 - height00) + height00;
    double height1 = cw[1] * (height11 - height10) + height10;
 
    /* Interpolate in longitude direction... */
    double height_bot = cw[0] * (height1 - height0) + height0;
 
    /* Interpolate in time at the upper level... */
    height00 = cw[3] * (heights1[ci[0]][ci[1]][ci[2] + 1]
                        - heights0[ci[0]][ci[1]][ci[2] + 1])
      + heights0[ci[0]][ci[1]][ci[2] + 1];
    height01 = cw[3] * (heights1[ci[0]][ci[1] + 1][ci[2] + 1]
                        - heights0[ci[0]][ci[1] + 1][ci[2] + 1])
      + heights0[ci[0]][ci[1] + 1][ci[2] + 1];
    height10 = cw[3] * (heights1[ci[0] + 1][ci[1]][ci[2] + 1]
                        - heights0[ci[0] + 1][ci[1]][ci[2] + 1])
      + heights0[ci[0] + 1][ci[1]][ci[2] + 1];
    height11 = cw[3] * (heights1[ci[0] + 1][ci[1] + 1][ci[2] + 1]
                        - heights0[ci[0] + 1][ci[1] + 1][ci[2] + 1])
      + heights0[ci[0] + 1][ci[1] + 1][ci[2] + 1];
 
    /* Interpolate in latitude direction... */
    height0 = cw[1] * (height01 - height00) + height00;
    height1 = cw[1] * (height11 - height10) + height10;
 
    /* Interpolate in longitude direction... */
    double height_top = cw[0] * (height1 - height0) + height0;
 
    /* Search at higher levels if height is not in box... */
    while (((heights0[0][0][0] > heights0[0][0][1]) &&
            ((height_bot <= height) || (height_top > height))
            && (height_bot >= height) && (ci[2] < k_max))
           ||
           ((heights0[0][0][0] < heights0[0][0][1]) &&
            ((height_bot >= height) || (height_top < height))
            && (height_bot <= height) && (ci[2] < k_max))
      ) {
 
      ci[2]++;
      height_bot = height_top;
 
      /* Interpolate in time at the next level... */
      height00 = cw[3] * (heights1[ci[0]][ci[1]][ci[2] + 1]
                          - heights0[ci[0]][ci[1]][ci[2] + 1])
        + heights0[ci[0]][ci[1]][ci[2] + 1];
      height01 = cw[3] * (heights1[ci[0]][ci[1] + 1][ci[2] + 1]
                          - heights0[ci[0]][ci[1] + 1][ci[2] + 1])
        + heights0[ci[0]][ci[1] + 1][ci[2] + 1];
      height10 = cw[3] * (heights1[ci[0] + 1][ci[1]][ci[2] + 1]
                          - heights0[ci[0] + 1][ci[1]][ci[2] + 1])
        + heights0[ci[0] + 1][ci[1]][ci[2] + 1];
      height11 = cw[3] * (heights1[ci[0] + 1][ci[1] + 1][ci[2] + 1]
                          - heights0[ci[0] + 1][ci[1] + 1][ci[2] + 1])
        + heights0[ci[0] + 1][ci[1] + 1][ci[2] + 1];
 
      /* Interpolate in latitude direction... */
      height0 = cw[1] * (height01 - height00) + height00;
      height1 = cw[1] * (height11 - height10) + height10;
 
      /* Interpolate in longitude direction... */
      height_top = cw[0] * (height1 - height0) + height0;
    }
 
    /* Get vertical weighting factors... */
    cw[2] = (height - height_bot)
      / (height_top - height_bot);
  }
 
  /* Calculate the needed array values... */
  const double array000 = cw[3] * (array1[ci[0]][ci[1]][ci[2]]
                                   - array0[ci[0]][ci[1]][ci[2]])
    + array0[ci[0]][ci[1]][ci[2]];
  const double array100 = cw[3] * (array1[ci[0] + 1][ci[1]][ci[2]]
                                   - array0[ci[0] + 1][ci[1]][ci[2]])
    + array0[ci[0] + 1][ci[1]][ci[2]];
  const double array010 = cw[3] * (array1[ci[0]][ci[1] + 1][ci[2]]
                                   - array0[ci[0]][ci[1] + 1][ci[2]])
    + array0[ci[0]][ci[1] + 1][ci[2]];
  const double array110 = cw[3] * (array1[ci[0] + 1][ci[1] + 1][ci[2]]
                                   - array0[ci[0] + 1][ci[1] + 1][ci[2]])
    + array0[ci[0] + 1][ci[1] + 1][ci[2]];
  const double array001 = cw[3] * (array1[ci[0]][ci[1]][ci[2] + 1]
                                   - array0[ci[0]][ci[1]][ci[2] + 1])
    + array0[ci[0]][ci[1]][ci[2] + 1];
  const double array101 = cw[3] * (array1[ci[0] + 1][ci[1]][ci[2] + 1]
                                   - array0[ci[0] + 1][ci[1]][ci[2] + 1])
    + array0[ci[0] + 1][ci[1]][ci[2] + 1];
  const double array011 = cw[3] * (array1[ci[0]][ci[1] + 1][ci[2] + 1]
                                   - array0[ci[0]][ci[1] + 1][ci[2] + 1])
    + array0[ci[0]][ci[1] + 1][ci[2] + 1];
  const double array111 = cw[3] * (array1[ci[0] + 1][ci[1] + 1][ci[2] + 1]
                                   - array0[ci[0] + 1][ci[1] + 1][ci[2] + 1])
    + array0[ci[0] + 1][ci[1] + 1][ci[2] + 1];
 
  const double array00 = cw[0] * (array100 - array000) + array000;
  const double array10 = cw[0] * (array110 - array010) + array010;
  const double array01 = cw[0] * (array101 - array001) + array001;
  const double array11 = cw[0] * (array111 - array011) + array011;
 
  const double aux0 = cw[1] * (array10 - array00) + array00;
  const double aux1 = cw[1] * (array11 - array01) + array01;
 
  /* Interpolate vertically... */
  *var = cw[2] * (aux1 - aux0) + aux0;
}
 
/*****************************************************************************/
 
void intpol_met_space_3d(
  const met_t *met,
  float array[EX][EY][EP],
  const double p,
  const double lon,
  const double lat,
  double *var,
  int *ci,
  double *cw,
  const int init) {
 
  /* Initialize interpolation... */
  if (init) {
 
    /* Check longitude and latitude... */
    double lon2, lat2;
 
    if (met->coord_type == 0)
      intpol_check_lon_lat(met->lon, met->nx, met->lat, met->ny, lon, lat,
                           &lon2, &lat2);
    else
      intpol_check_cartesian(met->lon, met->nx, met->lat, met->ny, lon, lat,
                             &lon2, &lat2);
 
    /* Get interpolation indices... */
    ci[0] = locate_irr(met->p, met->np, p);
    ci[1] = locate_reg(met->lon, met->nx, lon2);
    ci[2] = locate_irr(met->lat, met->ny, lat2);
 
    /* Get interpolation weights... */
    cw[0] = (met->p[ci[0] + 1] - p)
      / (met->p[ci[0] + 1] - met->p[ci[0]]);
    cw[1] = (met->lon[ci[1] + 1] - lon2)
      / (met->lon[ci[1] + 1] - met->lon[ci[1]]);
    cw[2] = (met->lat[ci[2] + 1] - lat2)
      / (met->lat[ci[2] + 1] - met->lat[ci[2]]);
  }
 
  /* Interpolate vertically... */
  const double aux00 =
    cw[0] * (array[ci[1]][ci[2]][ci[0]] - array[ci[1]][ci[2]][ci[0] + 1])
    + array[ci[1]][ci[2]][ci[0] + 1];
  const double aux01 =
    cw[0] * (array[ci[1]][ci[2] + 1][ci[0]] -
             array[ci[1]][ci[2] + 1][ci[0] + 1])
    + array[ci[1]][ci[2] + 1][ci[0] + 1];
  const double aux10 =
    cw[0] * (array[ci[1] + 1][ci[2]][ci[0]] -
             array[ci[1] + 1][ci[2]][ci[0] + 1])
    + array[ci[1] + 1][ci[2]][ci[0] + 1];
  const double aux11 =
    cw[0] * (array[ci[1] + 1][ci[2] + 1][ci[0]] -
             array[ci[1] + 1][ci[2] + 1][ci[0] + 1])
    + array[ci[1] + 1][ci[2] + 1][ci[0] + 1];
 
  /* Interpolate horizontally... */
  const double aux0 = cw[2] * (aux00 - aux01) + aux01;
  const double aux1 = cw[2] * (aux10 - aux11) + aux11;
  *var = cw[1] * (aux0 - aux1) + aux1;
}
 
/*****************************************************************************/
 
void intpol_met_space_2d(
  const met_t *met,
  float array[EX][EY],
  const double lon,
  const double lat,
  double *var,
  int *ci,
  double *cw,
  const int init) {
 
  /* Initialize interpolation... */
  if (init) {
 
    /* Check longitude and latitude... */
    double lon2, lat2;
 
    if (met->coord_type == 0)
      intpol_check_lon_lat(met->lon, met->nx, met->lat, met->ny, lon, lat,
                           &lon2, &lat2);
    else
      intpol_check_cartesian(met->lon, met->nx, met->lat, met->ny, lon, lat,
                             &lon2, &lat2);
 
 
    /* Get interpolation indices... */
    ci[1] = locate_reg(met->lon, met->nx, lon2);
    ci[2] = locate_irr(met->lat, met->ny, lat2);
 
    /* Get interpolation weights... */
    cw[1] = (met->lon[ci[1] + 1] - lon2)
      / (met->lon[ci[1] + 1] - met->lon[ci[1]]);
    cw[2] = (met->lat[ci[2] + 1] - lat2)
      / (met->lat[ci[2] + 1] - met->lat[ci[2]]);
  }
 
  /* Set variables... */
  const double aux00 = array[ci[1]][ci[2]];
  const double aux01 = array[ci[1]][ci[2] + 1];
  const double aux10 = array[ci[1] + 1][ci[2]];
  const double aux11 = array[ci[1] + 1][ci[2] + 1];
 
  /* Interpolate horizontally... */
  if (isfinite(aux00) && isfinite(aux01)
      && isfinite(aux10) && isfinite(aux11)) {
    const double aux0 = cw[2] * (aux00 - aux01) + aux01;
    const double aux1 = cw[2] * (aux10 - aux11) + aux11;
    *var = cw[1] * (aux0 - aux1) + aux1;
  } else {
    if (cw[2] < 0.5) {
      if (cw[1] < 0.5)
        *var = aux11;
      else
        *var = aux01;
    } else {
      if (cw[1] < 0.5)
        *var = aux10;
      else
        *var = aux00;
    }
  }
}
 
/*****************************************************************************/
 
void intpol_met_time_3d(
  const met_t *met0,
  float array0[EX][EY][EP],
  const met_t *met1,
  float array1[EX][EY][EP],
  const double ts,
  const double p,
  const double lon,
  const double lat,
  double *var,
  int *ci,
  double *cw,
  const int init) {
 
  double var0, var1;
 
  /* Spatial interpolation... */
  intpol_met_space_3d(met0, array0, p, lon, lat, &var0, ci, cw, init);
  intpol_met_space_3d(met1, array1, p, lon, lat, &var1, ci, cw, 0);
 
  /* Get weighting factor... */
  const double wt = (met1->time - ts) / (met1->time - met0->time);
 
  /* Interpolate... */
  *var = wt * (var0 - var1) + var1;
}
 
/*****************************************************************************/
 
void intpol_met_time_2d(
  const met_t *met0,
  float array0[EX][EY],
  const met_t *met1,
  float array1[EX][EY],
  const double ts,
  const double lon,
  const double lat,
  double *var,
  int *ci,
  double *cw,
  const int init) {
 
  double var0, var1;
 
  /* Spatial interpolation... */
  intpol_met_space_2d(met0, array0, lon, lat, &var0, ci, cw, init);
  intpol_met_space_2d(met1, array1, lon, lat, &var1, ci, cw, 0);
 
  /* Get weighting factor... */
  const double wt = (met1->time - ts) / (met1->time - met0->time);
 
  /* Interpolate... */
  if (isfinite(var0) && isfinite(var1))
    *var = wt * (var0 - var1) + var1;
  else if (wt < 0.5)
    *var = var1;
  else
    *var = var0;
}
 
/*****************************************************************************/
 
void intpol_tropo_3d(
  const double time0,
  float array0[EX][EY],
  const double time1,
  float array1[EX][EY],
  const double lons[EX],
  const double lats[EY],
  const int nlon,
  const int nlat,
  const double time,
  const double lon,
  const double lat,
  const int method,
  double *var,
  double *sigma) {
 
  double mean = 0;
 
  int n = 0;
 
  /* Check longitude and latitude... */
  double lon2, lat2;
  intpol_check_lon_lat(lons, nlon, lats, nlat, lon, lat, &lon2, &lat2);
 
  /* Get indices... */
  const int ix = locate_reg(lons, (int) nlon, lon2);
  const int iy = locate_irr(lats, (int) nlat, lat2);
 
  /* Calculate standard deviation... */
  *sigma = 0;
  for (int dx = 0; dx < 2; dx++)
    for (int dy = 0; dy < 2; dy++) {
      if (isfinite(array0[ix + dx][iy + dy])) {
        mean += array0[ix + dx][iy + dy];
        *sigma += SQR(array0[ix + dx][iy + dy]);
        n++;
      }
      if (isfinite(array1[ix + dx][iy + dy])) {
        mean += array1[ix + dx][iy + dy];
        *sigma += SQR(array1[ix + dx][iy + dy]);
        n++;
      }
    }
  if (n > 0)
    *sigma = sqrt(MAX(*sigma / n - SQR(mean / n), 0.0));
 
  /* Linear interpolation... */
  if (method == 1 && isfinite(array0[ix][iy])
      && isfinite(array0[ix][iy + 1])
      && isfinite(array0[ix + 1][iy])
      && isfinite(array0[ix + 1][iy + 1])
      && isfinite(array1[ix][iy])
      && isfinite(array1[ix][iy + 1])
      && isfinite(array1[ix + 1][iy])
      && isfinite(array1[ix + 1][iy + 1])) {
 
    const double aux00 = LIN(lons[ix], array0[ix][iy],
                             lons[ix + 1], array0[ix + 1][iy], lon2);
    const double aux01 = LIN(lons[ix], array0[ix][iy + 1],
                             lons[ix + 1], array0[ix + 1][iy + 1], lon2);
    const double aux0 = LIN(lats[iy], aux00, lats[iy + 1], aux01, lat2);
 
    const double aux10 = LIN(lons[ix], array1[ix][iy],
                             lons[ix + 1], array1[ix + 1][iy], lon2);
    const double aux11 = LIN(lons[ix], array1[ix][iy + 1],
                             lons[ix + 1], array1[ix + 1][iy + 1], lon2);
    const double aux1 = LIN(lats[iy], aux10, lats[iy + 1], aux11, lat2);
 
    *var = LIN(time0, aux0, time1, aux1, time);
  }
 
  /* Nearest neighbor interpolation... */
  else {
    const double aux00 = NN(lons[ix], array0[ix][iy],
                            lons[ix + 1], array0[ix + 1][iy], lon2);
    const double aux01 = NN(lons[ix], array0[ix][iy + 1],
                            lons[ix + 1], array0[ix + 1][iy + 1], lon2);
    const double aux0 = NN(lats[iy], aux00, lats[iy + 1], aux01, lat2);
 
    const double aux10 = NN(lons[ix], array1[ix][iy],
                            lons[ix + 1], array1[ix + 1][iy], lon2);
    const double aux11 = NN(lons[ix], array1[ix][iy + 1],
                            lons[ix + 1], array1[ix + 1][iy + 1], lon2);
    const double aux1 = NN(lats[iy], aux10, lats[iy + 1], aux11, lat2);
 
    *var = NN(time0, aux0, time1, aux1, time);
  }
}
 
/*****************************************************************************/
 
void jsec2time(
  const double jsec,
  int *year,
  int *mon,
  int *day,
  int *hour,
  int *min,
  int *sec,
  double *remain) {
 
  struct tm t0, *t1;
 
  t0.tm_year = 100;
  t0.tm_mon = 0;
  t0.tm_mday = 1;
  t0.tm_hour = 0;
  t0.tm_min = 0;
  t0.tm_sec = 0;
 
  const time_t jsec0 = (time_t) jsec + timegm(&t0);
  t1 = gmtime(&jsec0);
 
  *year = t1->tm_year + 1900;
  *mon = t1->tm_mon + 1;
  *day = t1->tm_mday;
  *hour = t1->tm_hour;
  *min = t1->tm_min;
  *sec = t1->tm_sec;
  *remain = jsec - floor(jsec);
}
 
/*****************************************************************************/
 
double kernel_weight(
  const double kz[EP],
  const double kw[EP],
  const int nk,
  const double p) {
 
  /* Check number of data points... */
  if (nk < 2)
    return 1.0;
 
  /* Get altitude... */
  const double z = Z(p);
 
  /* Get weighting factor... */
  if (z < kz[0])
    return kw[0];
  else if (z > kz[nk - 1])
    return kw[nk - 1];
  else {
    const int idx = locate_irr(kz, nk, z);
    return LIN(kz[idx], kw[idx], kz[idx + 1], kw[idx + 1], z);
  }
}
 
/*****************************************************************************/
 
double lapse_rate(
  const double t,
  const double h2o) {
 
  /*
     Calculate moist adiabatic lapse rate [K/km] from temperature [K]
     and water vapor volume mixing ratio [1].
 
     Reference: https://en.wikipedia.org/wiki/Lapse_rate
   */
 
  const double a = RA * SQR(t), r = SH(h2o) / (1. - SH(h2o));
 
  return 1e3 * G0 * (a + LV * r * t) / (CPD * a + SQR(LV) * r * EPS);
}
 
/*****************************************************************************/
 
void level_definitions(
  ctl_t *ctl) {
 
  if (0 == ctl->met_press_level_def) {
 
    ERRMSG
      ("MET_PRESS_LEVEL_DEF=0 is disabled. Use 3 for the extended L137 set.");
 
  } else if (1 == ctl->met_press_level_def) {
 
    ERRMSG
      ("MET_PRESS_LEVEL_DEF=1 is disabled. Use 4 for the extended L91 set.");
 
  } else if (2 == ctl->met_press_level_def) {
 
    ERRMSG
      ("MET_PRESS_LEVEL_DEF=2 is disabled. Use 5 for the extended L60 set.");
 
  } else if (3 == ctl->met_press_level_def) {
 
    ctl->met_np = 147;
 
    const double press[147] = {
      0.0200, 0.0310, 0.0467, 0.0683, 0.0975, 0.1361, 0.1861, 0.2499,
      0.3299, 0.4288, 0.5496, 0.6952, 0.8690, 1.0742, 1.3143, 1.5928, 1.9134,
      2.2797, 2.6954, 3.1642, 3.6898, 4.2759, 4.9262, 5.6441, 6.4334, 7.2974,
      8.2397, 9.2634, 10.3720, 11.5685, 12.8561, 14.2377, 15.7162, 17.2945,
      18.9752, 20.7610, 22.6543, 24.6577, 26.7735, 29.0039, 31.3512, 33.8174,
      36.4047, 39.1149, 41.9493, 44.9082, 47.9915, 51.1990, 54.5299, 57.9834,
      61.5607, 65.2695, 69.1187, 73.1187, 77.2810, 81.6182, 86.1450, 90.8774,
      95.8280, 101.0047, 106.4153, 112.0681, 117.9714, 124.1337, 130.5637,
      137.2703, 144.2624, 151.5493, 159.1403, 167.0450, 175.2731, 183.8344,
      192.7389, 201.9969, 211.6186, 221.6146, 231.9954, 242.7719, 253.9549,
      265.5556, 277.5852, 290.0548, 302.9762, 316.3607, 330.2202, 344.5663,
      359.4111, 374.7666, 390.6450, 407.0583, 424.0190, 441.5395, 459.6321,
      478.3096, 497.5845, 517.4198, 537.7195, 558.3430, 579.1926, 600.1668,
      621.1624, 642.0764, 662.8084, 683.2620, 703.3467, 722.9795, 742.0855,
      760.5996, 778.4661, 795.6396, 812.0847, 827.7756, 842.6959, 856.8376,
      870.2004, 882.7910, 894.6222, 905.7116, 916.0815, 925.7571, 934.7666,
      943.1399, 950.9082, 958.1037, 964.7584, 970.9046, 976.5737, 981.7968,
      986.6036, 991.0230, 995.0824, 998.8081, 1002.2250, 1005.3562, 1008.2239,
      1010.8487, 1013.25, 1016.37, 1019.49, 1022.61, 1025.73, 1028.85,
      1031.97,
      1035.09, 1038.21, 1041.33, 1044.45
    };
 
    for (int ip = 0; ip < ctl->met_np; ip++)
      ctl->met_p[ctl->met_np - ip - 1] = press[ip];
 
  } else if (4 == ctl->met_press_level_def) {
 
    ctl->met_np = 101;
 
    const double press[101] = {
      0.0200, 0.0398, 0.0739, 0.1291, 0.2141, 0.3395, 0.5175, 0.7617,
      1.0872, 1.5099, 2.0464, 2.7136, 3.5282, 4.5069, 5.6652, 7.0181,
      8.5795, 10.3617, 12.3759, 14.6316, 17.1371, 19.8987, 22.9216, 26.2090,
      29.7630, 33.5843, 37.6720, 42.0242, 46.6378, 51.5086, 56.6316, 61.9984,
      67.5973, 73.4150, 79.4434, 85.7016, 92.2162, 99.0182, 106.1445,
      113.6382,
      121.5502, 129.9403, 138.8558, 148.3260, 158.3816, 169.0545, 180.3786,
      192.3889, 205.1222, 218.6172, 232.9140, 248.0547, 264.0833, 281.0456,
      298.9895, 317.9651, 338.0245, 359.2221, 381.6144, 405.2606, 430.2069,
      456.4813, 483.8505, 512.0662, 540.8577, 569.9401, 599.0310, 627.9668,
      656.6129, 684.8491, 712.5573, 739.5739, 765.7697, 791.0376, 815.2774,
      838.3507, 860.1516, 880.6080, 899.6602, 917.2205, 933.2247, 947.6584,
      960.5245, 971.8169, 981.5301, 989.7322, 996.8732, 1002.8013,
      1007.4431, 1010.8487, 1013.25, 1016.37, 1019.49, 1022.61, 1025.73,
      1028.85, 1031.97,
      1035.09, 1038.21, 1041.33, 1044.45
    };
 
    for (int ip = 0; ip < ctl->met_np; ip++)
      ctl->met_p[ctl->met_np - ip - 1] = press[ip];
 
  } else if (5 == ctl->met_press_level_def) {
 
    ctl->met_np = 62;
 
    const double press[62] = {
      0.01, 0.1361, 0.2499, 0.4288, 0.6952, 1.0742,
      2.2797, 3.1642, 4.2759, 7.2974, 9.2634, 11.5685, 14.2377, 20.761,
      24.6577, 33.8174, 39.1149, 51.199, 57.9834, 73.1187, 81.6182,
      90.8774, 101.005, 112.068, 124.134, 137.27, 151.549, 167.045, 183.834,
      201.997, 221.615, 242.772, 265.556, 290.055, 316.361, 344.566, 374.767,
      407.058, 441.539, 478.31, 517.42, 558.343, 600.167, 683.262, 722.979,
      760.6, 795.64, 827.776, 856.838, 882.791, 905.712, 925.757, 943.14,
      958.104, 972.495, 986.886, 1001.28, 1015.67, 1030.06, 1034.86, 1039.65,
      1044.45
    };
 
    for (int ip = 0; ip < ctl->met_np; ip++)
      ctl->met_p[ctl->met_np - ip - 1] = press[ip];
 
  } else if (6 == ctl->met_press_level_def) {
 
    ctl->met_np = 137;
 
    const double press[137] = {
      0.01, 0.02, 0.031, 0.0467, 0.0683, 0.0975, 0.1361, 0.1861,
      0.2499, 0.3299, 0.4288, 0.5496, 0.6952, 0.869, 1.0742,
      1.3143, 1.5928, 1.9134, 2.2797, 2.6954, 3.1642, 3.6898,
      4.2759, 4.9262, 5.6441, 6.4334, 7.2974, 8.2397, 9.2634,
      10.372, 11.5685, 12.8561, 14.2377, 15.7162, 17.2945, 18.9752,
      20.761, 22.6543, 24.6577, 26.7735, 29.0039, 31.3512, 33.8174,
      36.4047, 39.1149, 41.9493, 44.9082, 47.9915, 51.199, 54.5299,
      57.9834, 61.5607, 65.2695, 69.1187, 73.1187, 77.281, 81.6182,
      86.145, 90.8774, 95.828, 101.005, 106.415, 112.068, 117.971,
      124.134, 130.564, 137.27, 144.262, 151.549, 159.14, 167.045,
      175.273, 183.834, 192.739, 201.997, 211.619, 221.615, 231.995,
      242.772, 253.955, 265.556, 277.585, 290.055, 302.976, 316.361,
      330.22, 344.566, 359.411, 374.767, 390.645, 407.058, 424.019,
      441.539, 459.632, 478.31, 497.584, 517.42, 537.72, 558.343,
      579.193, 600.167, 621.162, 642.076, 662.808, 683.262, 703.347,
      722.979, 742.086, 760.6, 778.466, 795.64, 812.085, 827.776,
      842.696, 856.838, 870.2, 882.791, 894.622, 905.712, 916.081,
      925.757, 934.767, 943.14, 950.908, 958.104, 965.299, 972.495,
      979.69, 986.886, 994.081, 1001.28, 1008.47, 1015.67, 1022.86,
      1030.06, 1037.25, 1044.45
    };
 
    for (int ip = 0; ip < ctl->met_np; ip++)
      ctl->met_p[ctl->met_np - ip - 1] = press[ip];
 
  } else if (7 == ctl->met_press_level_def) {
 
    ctl->met_np = 59;
 
    const double press[59] = {
      0.1, 0.2, 0.3843, 0.6365, 0.9564, 1.3448, 1.8058, 2.3478,
      2.985, 3.7397, 4.6462, 5.7565, 7.1322, 8.8366, 10.9483,
      13.5647, 16.8064, 20.8227, 25.7989, 31.9642, 39.6029, 49.0671,
      60.1802, 73.0663, 87.7274, 104.229, 122.614, 142.902, 165.089,
      189.147, 215.025, 242.652, 272.059, 303.217, 336.044, 370.407,
      406.133, 443.009, 480.791, 519.209, 557.973, 596.777, 635.306,
      673.24, 710.263, 746.063, 780.346, 812.83, 843.263, 871.42,
      897.112, 920.189, 940.551, 958.148, 975.744, 993.341, 1010.94,
      1028.53, 1046.13
    };
 
    for (int ip = 0; ip < ctl->met_np; ip++)
      ctl->met_p[ctl->met_np - ip - 1] = press[ip];
 
  } else {
    ERRMSG("Use values between 3 and 7.");
  }
 
  if (ctl->met_np > EP)
    ERRMSG("Recompile with larger EP to use this pressure level definition!");
}
 
/*****************************************************************************/
 
int locate_irr(
  const double *xx,
  const int n,
  const double x) {
 
  int ilo = 0;
  int ihi = n - 1;
  int i = (ihi + ilo) >> 1;
 
  if (xx[i] < xx[i + 1])
    while (ihi > ilo + 1) {
      i = (ihi + ilo) >> 1;
      if (xx[i] > x)
        ihi = i;
      else
        ilo = i;
  } else
    while (ihi > ilo + 1) {
      i = (ihi + ilo) >> 1;
      if (xx[i] <= x)
        ihi = i;
      else
        ilo = i;
    }
 
  return ilo;
}
 
/*****************************************************************************/
 
int locate_irr_float(
  const float *xx,
  const int n,
  const double x,
  const int ig) {
 
  int ilo = 0;
  int ihi = n - 1;
  int i = (ihi + ilo) >> 1;
 
  if ((xx[ig] <= x && x < xx[ig + 1]) || (xx[ig] >= x && x > xx[ig + 1]))
    return ig;
 
  if (xx[i] < xx[i + 1])
    while (ihi > ilo + 1) {
      i = (ihi + ilo) >> 1;
      if (xx[i] > x)
        ihi = i;
      else
        ilo = i;
  } else
    while (ihi > ilo + 1) {
      i = (ihi + ilo) >> 1;
      if (xx[i] <= x)
        ihi = i;
      else
        ilo = i;
    }
 
  return ilo;
}
 
/*****************************************************************************/
 
int locate_reg(
  const double *xx,
  const int n,
  const double x) {
 
  /* Calculate index... */
  const int i = (int) ((x - xx[0]) / (xx[1] - xx[0]));
 
  /* Check range... */
  if (i < 0)
    return 0;
  else if (i > n - 2)
    return n - 2;
  else
    return i;
}
 
/*****************************************************************************/
 
void locate_vert(
  float profiles[EX][EY][EP],
  const int np,
  const int lon_ap_ind,
  const int lat_ap_ind,
  const double height_ap,
  int *ind) {
 
  ind[0] = locate_irr_float(profiles[lon_ap_ind][lat_ap_ind],
                            np, height_ap, 0);
  ind[1] = locate_irr_float(profiles[lon_ap_ind + 1][lat_ap_ind],
                            np, height_ap, ind[0]);
  ind[2] = locate_irr_float(profiles[lon_ap_ind][lat_ap_ind + 1],
                            np, height_ap, ind[1]);
  ind[3] = locate_irr_float(profiles[lon_ap_ind + 1][lat_ap_ind + 1],
                            np, height_ap, ind[2]);
}
 
/*****************************************************************************/
 
void module_advect(
  const ctl_t *ctl,
  const cache_t *cache,
  met_t *met0,
  met_t *met1,
  atm_t *atm) {
 
  /* Set timer... */
  SELECT_TIMER("MODULE_ADVECT", "PHYSICS");
 
  /* Use omega vertical velocity... */
  if (ctl->advect_vert_coord == 0 || ctl->advect_vert_coord == 2) {
 
    /* Loop over particles... */
    PARTICLE_LOOP(0, atm->np, 1, "acc data present(ctl,cache,met0,met1,atm)") {
 
      /* Init... */
      INTPOL_INIT;
      double dts, u[4], um = 0, v[4], vm = 0, w[4], wm = 0,
        x[3] = { 0, 0, 0 };
 
      /* Loop over integration nodes... */
      for (int i = 0; i < ctl->advect; i++) {
 
        /* Set position... */
        if (i == 0) {
          dts = 0.0;
          x[0] = atm->lon[ip];
          x[1] = atm->lat[ip];
          x[2] = atm->p[ip];
        } else {
          dts = (i == 3 ? 1.0 : 0.5) * cache->dt[ip];
          x[0] = atm->lon[ip] + DX2COORD(met0, dts * u[i - 1], atm->lat[ip]);
          x[1] = atm->lat[ip] + DY2COORD(met0, dts * v[i - 1]);
          x[2] = atm->p[ip] + dts * w[i - 1];
        }
        const double tm = atm->time[ip] + dts;
 
        /* Interpolate meteo data on pressure levels... */
        if (ctl->advect_vert_coord == 0) {
          intpol_met_time_3d(met0, met0->u, met1, met1->u,
                             tm, x[2], x[0], x[1], &u[i], ci, cw, 1);
          intpol_met_time_3d(met0, met0->v, met1, met1->v,
                             tm, x[2], x[0], x[1], &v[i], ci, cw, 0);
          intpol_met_time_3d(met0, met0->w, met1, met1->w,
                             tm, x[2], x[0], x[1], &w[i], ci, cw, 0);
        }
 
        /* Interpolate meteo data on model levels... */
        else {
          intpol_met_4d_zeta(met0, met0->pl, met0->ul,
                             met1, met1->pl, met1->ul,
                             tm, x[2], x[0], x[1], &u[i], ci, cw, 1);
          intpol_met_4d_zeta(met0, met0->pl, met0->vl,
                             met1, met1->pl, met1->vl,
                             tm, x[2], x[0], x[1], &v[i], ci, cw, 0);
          intpol_met_4d_zeta(met0, met0->pl, met0->wl,
                             met1, met1->pl, met1->wl,
                             tm, x[2], x[0], x[1], &w[i], ci, cw, 0);
        }
 
        /* Get mean wind... */
        double k = 1.0;
        if (ctl->advect == 2)
          k = (i == 0 ? 0.0 : 1.0);
        else if (ctl->advect == 4)
          k = (i == 0 || i == 3 ? 1.0 / 6.0 : 2.0 / 6.0);
        um += k * u[i];
        vm += k * v[i];
        wm += k * w[i];
      }
 
      /* Set new position... */
      atm->time[ip] += cache->dt[ip];
      atm->lon[ip] += DX2COORD(met0, cache->dt[ip] * um,
                               (ctl->advect == 2 ? x[1] : atm->lat[ip]));
      atm->lat[ip] += DY2COORD(met0, cache->dt[ip] * vm);
      atm->p[ip] += cache->dt[ip] * wm;
 
    }
  }
 
  /* Use zeta or eta vertical velocity... */
  else if (ctl->advect_vert_coord == 1 || ctl->advect_vert_coord == 3) {
 
    /* Select quantity index depending on coordinate... */
    const int qnt = (ctl->advect_vert_coord == 1
                     ? ctl->qnt_zeta : ctl->qnt_eta);
 
    /* Loop over particles... */
    PARTICLE_LOOP(0, atm->np, 1, "acc data present(ctl,cache,met0,met1,atm)") {
 
      /* Convert pressure to vertical coordinate (zeta or eta)... */
      INTPOL_INIT;
      intpol_met_4d_zeta(met0, met0->pl, met0->zetal,
                         met1, met1->pl, met1->zetal,
                         atm->time[ip], atm->p[ip],
                         atm->lon[ip], atm->lat[ip],
                         &atm->q[qnt][ip], ci, cw, 1);
 
      /* Init... */
      double dts, u[4], um = 0, v[4], vm = 0, wdot[4],
        wdotm = 0, x[3] = { 0, 0, 0 };
 
      /* Loop over integration nodes (Runge–Kutta steps)... */
      for (int i = 0; i < ctl->advect; i++) {
 
        /* Set position... */
        if (i == 0) {
          dts = 0.0;
          x[0] = atm->lon[ip];
          x[1] = atm->lat[ip];
          x[2] = atm->q[qnt][ip];
        } else {
          dts = (i == 3 ? 1.0 : 0.5) * cache->dt[ip];
          x[0] = atm->lon[ip] + DX2COORD(met0, dts * u[i - 1], atm->lat[ip]);
          x[1] = atm->lat[ip] + DY2COORD(met0, dts * v[i - 1]);
          x[2] = atm->q[qnt][ip] + dts * wdot[i - 1];
        }
 
        const double tm = atm->time[ip] + dts;
 
        /* Interpolate meteo data... */
        intpol_met_4d_zeta(met0, met0->zetal, met0->ul,
                           met1, met1->zetal, met1->ul,
                           tm, x[2], x[0], x[1], &u[i], ci, cw, 1);
        intpol_met_4d_zeta(met0, met0->zetal, met0->vl,
                           met1, met1->zetal, met1->vl,
                           tm, x[2], x[0], x[1], &v[i], ci, cw, 0);
        intpol_met_4d_zeta(met0, met0->zetal, met0->zeta_dotl,
                           met1, met1->zetal, met1->zeta_dotl,
                           tm, x[2], x[0], x[1], &wdot[i], ci, cw, 0);
 
        /* Compute Runge–Kutta weights... */
        double k = 1.0;
        if (ctl->advect == 2)
          k = (i == 0 ? 0.0 : 1.0);
        else if (ctl->advect == 4)
          k = (i == 0 || i == 3 ? 1.0 / 6.0 : 2.0 / 6.0);
 
        um += k * u[i];
        vm += k * v[i];
        wdotm += k * wdot[i];
      }
 
      /* Update particle position... */
      atm->time[ip] += cache->dt[ip];
      atm->lon[ip] += DX2COORD(met0, cache->dt[ip] * um,
                               (ctl->advect == 2 ? x[1] : atm->lat[ip]));
      atm->lat[ip] += DY2COORD(met0, cache->dt[ip] * vm);
      atm->q[qnt][ip] += cache->dt[ip] * wdotm;
 
      /* Convert vertical coordinate (zeta or eta) back to pressure... */
      intpol_met_4d_zeta(met0, met0->zetal, met0->pl,
                         met1, met1->zetal, met1->pl,
                         atm->time[ip],
                         atm->q[qnt][ip], atm->lon[ip], atm->lat[ip],
                         &atm->p[ip], ci, cw, 1);
    }
  }
}
 
/*****************************************************************************/
 
void module_advect_init(
  const ctl_t *ctl,
  const cache_t *cache,
  met_t *met0,
  met_t *met1,
  atm_t *atm) {
 
  /* Check parameters... */
  if (ctl->advect_vert_coord != 1)
    return;
 
  /* Set timer... */
  SELECT_TIMER("MODULE_ADVECT_INIT", "PHYSICS");
 
  /* Loop over particles... */
  PARTICLE_LOOP(0, atm->np, 0, "acc data present(ctl,met0,met1,atm)") {
 
    /* Initialize pressure consistent with zeta... */
    INTPOL_INIT;
    intpol_met_4d_zeta(met0, met0->zetal, met0->pl, met1, met1->zetal,
                       met1->pl, atm->time[ip], atm->q[ctl->qnt_zeta][ip],
                       atm->lon[ip], atm->lat[ip], &atm->p[ip], ci, cw, 1);
  }
}
 
/*****************************************************************************/
 
void module_bound_cond(
  const ctl_t *ctl,
  const cache_t *cache,
  const clim_t *clim,
  met_t *met0,
  met_t *met1,
  atm_t *atm) {
 
  /* Set timer... */
  SELECT_TIMER("MODULE_BOUND_COND", "PHYSICS");
 
  /* Check quantity flags... */
  if (ctl->qnt_m < 0 && ctl->qnt_vmr < 0 && ctl->qnt_Cccl4
      && ctl->qnt_Cccl3f < 0 && ctl->qnt_Cccl2f2 < 0
      && ctl->qnt_Cn2o < 0 && ctl->qnt_Csf6 < 0 && ctl->qnt_aoa < 0)
    return;
 
  /* Loop over particles... */
  PARTICLE_LOOP(0, atm->np, 1,
                "acc data present(ctl,cache,clim,met0,met1,atm)") {
 
    /* Check latitude and pressure range... */
    if (atm->lat[ip] < ctl->bound_lat0 || atm->lat[ip] > ctl->bound_lat1
        || atm->p[ip] > ctl->bound_p0 || atm->p[ip] < ctl->bound_p1)
      continue;
 
    /* Check surface layer... */
    if (ctl->bound_dps > 0 || ctl->bound_dzs > 0
        || ctl->bound_zetas > 0 || ctl->bound_pbl) {
 
      /* Get surface pressure... */
      double ps;
      INTPOL_INIT;
      INTPOL_2D(ps, 1);
 
      /* Check pressure... */
      if (ctl->bound_dps > 0 && atm->p[ip] < ps - ctl->bound_dps)
        continue;
 
      /* Check height... */
      if (ctl->bound_dzs > 0 && Z(atm->p[ip]) > Z(ps) + ctl->bound_dzs)
        continue;
 
      /* Check zeta range... */
      if (ctl->bound_zetas > 0) {
        double t;
        INTPOL_3D(t, 1);
        if (ZETA(ps, atm->p[ip], t) > ctl->bound_zetas)
          continue;
      }
 
      /* Check planetary boundary layer... */
      if (ctl->bound_pbl) {
        double pbl;
        INTPOL_2D(pbl, 0);
        if (atm->p[ip] < pbl)
          continue;
      }
    }
 
    /* Set mass and volume mixing ratio... */
    if (ctl->qnt_m >= 0 && ctl->bound_mass >= 0)
      atm->q[ctl->qnt_m][ip] =
        ctl->bound_mass + ctl->bound_mass_trend * atm->time[ip];
    if (ctl->qnt_vmr >= 0 && ctl->bound_vmr >= 0)
      atm->q[ctl->qnt_vmr][ip] =
        ctl->bound_vmr + ctl->bound_vmr_trend * atm->time[ip];
 
    /* Set CFC-10 volume mixing ratio... */
    if (ctl->qnt_Cccl4 >= 0 && ctl->clim_ccl4_timeseries[0] != '-')
      atm->q[ctl->qnt_Cccl4][ip] = clim_ts(&clim->ccl4, atm->time[ip]);
 
    /* Set CFC-11 volume mixing ratio... */
    if (ctl->qnt_Cccl3f >= 0 && ctl->clim_ccl3f_timeseries[0] != '-')
      atm->q[ctl->qnt_Cccl3f][ip] = clim_ts(&clim->ccl3f, atm->time[ip]);
 
    /* Set CFC-12 volume mixing ratio... */
    if (ctl->qnt_Cccl2f2 >= 0 && ctl->clim_ccl2f2_timeseries[0] != '-')
      atm->q[ctl->qnt_Cccl2f2][ip] = clim_ts(&clim->ccl2f2, atm->time[ip]);
 
    /* Set N2O volume mixing ratio... */
    if (ctl->qnt_Cn2o >= 0 && ctl->clim_n2o_timeseries[0] != '-')
      atm->q[ctl->qnt_Cn2o][ip] = clim_ts(&clim->n2o, atm->time[ip]);
 
    /* Set SF6 volume mixing ratio... */
    if (ctl->qnt_Csf6 >= 0 && ctl->clim_sf6_timeseries[0] != '-')
      atm->q[ctl->qnt_Csf6][ip] = clim_ts(&clim->sf6, atm->time[ip]);
 
    /* Set age of air... */
    if (ctl->qnt_aoa >= 0)
      atm->q[ctl->qnt_aoa][ip] = atm->time[ip];
  }
}
 
/*****************************************************************************/
 
void module_chem_grid(
  const ctl_t *ctl,
  met_t *met0,
  met_t *met1,
  atm_t *atm,
  const double tt) {
 
  if (met0->coord_type != 0)
    ERRMSG("Only lat/lon grid supported");
 
  /* Check quantities... */
  if (ctl->qnt_m < 0 || ctl->qnt_Cx < 0)
    return;
  if (ctl->molmass <= 0)
    ERRMSG("Molar mass is not defined!");
 
  /* Set timer... */
  SELECT_TIMER("MODULE_CHEM_GRID", "PHYSICS");
 
  /* Allocate... */
  const int ensemble_mode = (ctl->nens > 0);
  const int np = atm->np;
  const int nz = ctl->chemgrid_nz;
  const int nx = ctl->chemgrid_nx;
  const int ny = ctl->chemgrid_ny;
  const int ngrid = nx * ny * nz;
  const int nens = ensemble_mode ? ctl->nens : 1;
 
  double *restrict const z = (double *) malloc((size_t) nz * sizeof(double));
  double *restrict const press =
    (double *) malloc((size_t) nz * sizeof(double));
  double *restrict const mass =
    (double *) calloc((size_t) ngrid * (size_t) nens, sizeof(double));
  double *restrict const area =
    (double *) malloc((size_t) ny * sizeof(double));
  double *restrict const lon =
    (double *) malloc((size_t) nx * sizeof(double));
  double *restrict const lat =
    (double *) malloc((size_t) ny * sizeof(double));
 
  int *restrict const ixs = (int *) malloc((size_t) np * sizeof(int));
  int *restrict const iys = (int *) malloc((size_t) np * sizeof(int));
  int *restrict const izs = (int *) malloc((size_t) np * sizeof(int));
 
  /* Set grid box size... */
  const double dz = (ctl->chemgrid_z1 - ctl->chemgrid_z0) / nz;
  const double dlon = (ctl->chemgrid_lon1 - ctl->chemgrid_lon0) / nx;
  const double dlat = (ctl->chemgrid_lat1 - ctl->chemgrid_lat0) / ny;
 
  /* Set vertical coordinates... */
#ifdef _OPENACC
#pragma acc enter data create(ixs[0:np],iys[0:np],izs[0:np],z[0:nz],press[0:nz],mass[0:ngrid*nens],area[0:ny],lon[0:nx],lat[0:ny])
#pragma acc data present(ctl,met0,met1,atm,ixs,iys,izs,z,press,mass,area,lon,lat)
#pragma acc parallel loop independent gang vector
#else
#pragma omp parallel for default(shared)
#endif
  for (int iz = 0; iz < nz; iz++) {
    z[iz] = ctl->chemgrid_z0 + dz * (iz + 0.5);
    press[iz] = P(z[iz]);
  }
 
  /* Initialize mass grid... */
#ifdef _OPENACC
#pragma acc parallel loop independent gang vector
#endif
  for (int i = 0; i < ngrid * nens; i++)
    mass[i] = 0;
 
  /* Set time interval for output... */
  const double t0 = tt - 0.5 * ctl->dt_mod;
  const double t1 = tt + 0.5 * ctl->dt_mod;
 
  /* Get indices... */
#ifdef _OPENACC
#pragma acc parallel loop independent gang vector
#else
#pragma omp parallel for default(shared)
#endif
  for (int ip = 0; ip < np; ip++) {
    const double zpart = Z(atm->p[ip]);
    if (atm->time[ip] < t0 || atm->time[ip] > t1
        || atm->lon[ip] < ctl->chemgrid_lon0
        || atm->lon[ip] >= ctl->chemgrid_lon1
        || atm->lat[ip] < ctl->chemgrid_lat0
        || atm->lat[ip] >= ctl->chemgrid_lat1
        || zpart < ctl->chemgrid_z0 || zpart >= ctl->chemgrid_z1) {
      izs[ip] = -1;
      continue;
    }
    ixs[ip] = (int) ((atm->lon[ip] - ctl->chemgrid_lon0) / dlon);
    iys[ip] = (int) ((atm->lat[ip] - ctl->chemgrid_lat0) / dlat);
    izs[ip] = (int) ((zpart - ctl->chemgrid_z0) / dz);
    if (ixs[ip] >= nx || iys[ip] >= ny || izs[ip] >= nz)
      izs[ip] = -1;
  }
 
  /* Set horizontal coordinates... */
#ifdef _OPENACC
#pragma acc parallel loop independent gang vector
#else
#pragma omp parallel for default(shared)
#endif
  for (int ix = 0; ix < nx; ix++)
    lon[ix] = ctl->chemgrid_lon0 + dlon * (ix + 0.5);
 
#ifdef _OPENACC
#pragma acc parallel loop independent gang vector
#else
#pragma omp parallel for default(shared)
#endif
  for (int iy = 0; iy < ny; iy++) {
    lat[iy] = ctl->chemgrid_lat0 + dlat * (iy + 0.5);
    area[iy] = dlat * dlon * SQR(RE * M_PI / 180.) * cos(DEG2RAD(lat[iy]));
  }
 
  /* Get mass per grid box... */
#ifdef _OPENACC
#pragma acc parallel loop independent gang vector
#endif
  for (int ip = 0; ip < np; ip++) {
    if (izs[ip] >= 0) {
      int mass_idx = ARRAY_3D(ixs[ip], iys[ip], ny, izs[ip], nz);
      if (ensemble_mode) {
        const int ens = (int) atm->q[ctl->qnt_ens][ip];
        mass_idx += ens * ngrid;
      }
#ifdef _OPENACC
#pragma acc atomic update
#endif
      mass[mass_idx] += atm->q[ctl->qnt_m][ip];
    }
  }
 
  /* Assign grid data to air parcels ... */
#ifdef _OPENACC
#pragma acc parallel loop independent gang vector
#else
#pragma omp parallel for default(shared)
#endif
  for (int ip = 0; ip < np; ip++)
    if (izs[ip] >= 0) {
 
      /* Interpolate temperature... */
      double temp;
      INTPOL_INIT;
      intpol_met_time_3d(met0, met0->t, met1, met1->t, tt,
                         press[izs[ip]],
                         lon[ixs[ip]], lat[iys[ip]], &temp, ci, cw, 1);
 
      /* Set mass... */
      int mass_idx = ARRAY_3D(ixs[ip], iys[ip], ny, izs[ip], nz);
      if (ensemble_mode) {
        const int ens = (int) atm->q[ctl->qnt_ens][ip];
        mass_idx += ens * ngrid;
      }
 
      /* Calculate volume mixing ratio... */
      const double m = mass[mass_idx];
      atm->q[ctl->qnt_Cx][ip] = MA / ctl->molmass * m
        / (RHO(press[izs[ip]], temp) * area[iys[ip]] * dz * 1e9);
    }
 
  /* Free... */
#ifdef _OPENACC
#pragma acc exit data delete(ixs,iys,izs,z,press,mass,area,lon,lat)
#endif
  free(mass);
  free(lon);
  free(lat);
  free(area);
  free(z);
  free(press);
  free(ixs);
  free(iys);
  free(izs);
}
 
/*****************************************************************************/
 
void module_chem_init(
  const ctl_t *ctl,
  const cache_t *cache,
  const clim_t *clim,
  met_t *met0,
  met_t *met1,
  atm_t *atm) {
 
  /* Set timer... */
  SELECT_TIMER("MODULE_CHEM_INIT", "PHYSICS");
 
  /* Loop over particles... */
  PARTICLE_LOOP(0, atm->np, 0,
                "acc data present(ctl,cache,clim,met0,met1,atm)") {
 
    /* Set H2O and O3 using meteo data... */
    INTPOL_INIT;
    if (ctl->qnt_Ch2o >= 0) {
      double h2o;
      INTPOL_3D(h2o, 1);
      SET_ATM(qnt_Ch2o, h2o);
    }
    if (ctl->qnt_Co3 >= 0) {
      double o3;
      INTPOL_3D(o3, 1);
      SET_ATM(qnt_Co3, o3);
    }
 
    /* Set radical species... */
    const double lat_ref =
      ctl->met_coord_type == 0 ? atm->lat[ip] : ctl->met_utm_ref_lat;
    SET_ATM(qnt_Coh, clim_oh(ctl, clim, atm->time[ip],
                             atm->lon[ip], atm->lat[ip], atm->p[ip]));
    SET_ATM(qnt_Cho2, clim_zm(&clim->ho2, atm->time[ip],
                              lat_ref, atm->p[ip]));
    SET_ATM(qnt_Ch2o2, clim_zm(&clim->h2o2, atm->time[ip],
                               lat_ref, atm->p[ip]));
    SET_ATM(qnt_Co1d, clim_zm(&clim->o1d, atm->time[ip],
                              lat_ref, atm->p[ip]));
  }
}
 
/*****************************************************************************/
 
void module_convection(
  const ctl_t *ctl,
  cache_t *cache,
  met_t *met0,
  met_t *met1,
  atm_t *atm) {
 
  /* Set timer... */
  SELECT_TIMER("MODULE_CONVECTION", "PHYSICS");
 
  /* Create random numbers... */
  module_rng(ctl, cache->rs, (size_t) atm->np, 0);
 
  /* Loop over particles... */
  PARTICLE_LOOP(0, atm->np, 1, "acc data present(ctl,cache,met0,met1,atm)") {
 
    /* Interpolate surface pressure... */
    double ps;
    INTPOL_INIT;
    INTPOL_2D(ps, 1);
 
    /* Initialize pressure range for vertical mixing... */
    double pbot = ps, ptop = ps;
 
    /* Mixing in the PBL... */
    if (ctl->conv_mix_pbl) {
 
      /* Interpolate PBL... */
      double pbl;
      INTPOL_2D(pbl, 0);
 
      /* Set pressure range... */
      ptop = pbl - ctl->conv_pbl_trans * (ps - pbl);
    }
 
    /* Convective mixing... */
    if (ctl->conv_cape >= 0) {
 
      /* Interpolate CAPE, CIN, and equilibrium level... */
      double cape, cin, pel;
      INTPOL_2D(cape, 0);
      INTPOL_2D(cin, 0);
      INTPOL_2D(pel, 0);
 
      /* Set pressure range... */
      if (isfinite(cape) && cape >= ctl->conv_cape
          && (ctl->conv_cin <= 0 || (isfinite(cin) && cin >= ctl->conv_cin)))
        ptop = MIN(ptop, pel);
    }
 
    /* Apply vertical mixing... */
    if (ptop != pbot && atm->p[ip] >= ptop) {
 
      /* Get density range... */
      double tbot, ttop;
      intpol_met_time_3d(met0, met0->t, met1, met1->t, atm->time[ip],
                         pbot, atm->lon[ip], atm->lat[ip], &tbot, ci, cw, 1);
      intpol_met_time_3d(met0, met0->t, met1, met1->t, atm->time[ip], ptop,
                         atm->lon[ip], atm->lat[ip], &ttop, ci, cw, 1);
      const double rhobot = pbot / tbot;
      const double rhotop = ptop / ttop;
 
      /* Get new density... */
      const double rho = rhobot + (rhotop - rhobot) * cache->rs[ip];
 
      /* Get pressure... */
      atm->p[ip] = LIN(rhobot, pbot, rhotop, ptop, rho);
    }
  }
}
 
/*****************************************************************************/
 
#ifdef DD
void module_dd(
  double t,
  const ctl_t *ctl,
  cache_t *cache,
  dd_t *dd,
  atm_t *atm,
  met_t **met) {
 
  /* Initialize particles locally... */
  int npart = 0, nkeep = 0, capacity = 0;
  particle_t *particles = NULL;
 
  /* Assign particles to new subdomains... */
  dd_assign_subdomains(ctl, dd, atm, 0);
 
  if (ctl->dd_exchange_mode == 0) {
    /* Original sort/push exchange path... */
    if (fmod(t, ctl->dd_sort_dt) == 0)
      dd_sort(ctl, *met, cache, atm, dd, &npart);
    else
      dd_push(ctl, atm, cache, &npart);
  } else {
    /* Count outgoing particles for direct packing and compaction... */
    dd_count_outgoing(ctl, atm, dd, &nkeep, &npart);
  }
 
  /* Ensure particle buffer is large enough for outgoing particles... */
  if (npart > capacity) {
    const int newcap = npart + npart / 2 + 1;
    particle_t *tmp =
      realloc(particles, (size_t) newcap * sizeof(particle_t));
    if (!tmp)
      ERRMSG("Out of memory!");
    particles = tmp;
    capacity = newcap;
  }
 
  /* Transform from struct of array to array of struct... */
  if (ctl->dd_exchange_mode == 0)
    dd_atm2particles(ctl, cache, atm, particles, npart);
  else
    dd_pack_compact(ctl, cache, atm, dd, particles, nkeep, npart);
 
  SELECT_TIMER("SYNC", "DD");
  MPI_Barrier(MPI_COMM_WORLD);
 
  /* Perform the communication... */
  dd_communicate_particles(ctl, dd, &particles, &npart, &capacity);
 
  /* Transform from array of struct to struct of array... */
  dd_particles2atm(ctl, cache, particles, npart, atm);
 
  /* Free local particle array... */
  free(particles);
}
#endif
 
/*****************************************************************************/
 
void module_decay(
  const ctl_t *ctl,
  const cache_t *cache,
  const clim_t *clim,
  atm_t *atm) {
 
  /* Set timer... */
  SELECT_TIMER("MODULE_DECAY", "PHYSICS");
 
  /* Check quantity flags... */
  if (ctl->qnt_m < 0 && ctl->qnt_vmr < 0)
    ERRMSG("Module needs quantity mass or volume mixing ratio!");
 
  /* Loop over particles... */
  PARTICLE_LOOP(0, atm->np, 1, "acc data present(ctl,cache,clim,atm)") {
 
    /* Get weighting factor... */
    const double w = tropo_weight(ctl, clim, atm, ip);
 
    /* Set lifetime... */
    const double tdec = w * ctl->tdec_trop + (1 - w) * ctl->tdec_strat;
 
    /* Calculate exponential decay... */
    const double aux = exp(-cache->dt[ip] / tdec);
    if (ctl->qnt_m >= 0) {
      if (ctl->qnt_mloss_decay >= 0)
        atm->q[ctl->qnt_mloss_decay][ip]
          += atm->q[ctl->qnt_m][ip] * (1 - aux);
      atm->q[ctl->qnt_m][ip] *= aux;
      if (ctl->qnt_loss_rate >= 0)
        atm->q[ctl->qnt_loss_rate][ip] += 1. / tdec;
    }
    if (ctl->qnt_vmr >= 0)
      atm->q[ctl->qnt_vmr][ip] *= aux;
  }
}
 
/*****************************************************************************/
 
void module_diff_meso(
  const ctl_t *ctl,
  cache_t *cache,
  const met_t *met0,
  const met_t *met1,
  atm_t *atm) {
 
  /* Set timer... */
  SELECT_TIMER("MODULE_DIFF_MESO", "PHYSICS");
 
  /* Create random numbers... */
  module_rng(ctl, cache->rs, 3 * (size_t) atm->np, 1);
 
  /* Loop over particles... */
  PARTICLE_LOOP(0, atm->np, 1, "acc data present(ctl,cache,met0,met1,atm)") {
 
    /* Get indices... */
    const int ix = locate_reg(met0->lon, met0->nx, atm->lon[ip]);
    const int iy = locate_irr(met0->lat, met0->ny, atm->lat[ip]);
    const int iz = locate_irr(met0->p, met0->np, atm->p[ip]);
 
    /* Get standard deviations of local wind data... */
    float umean = 0, usig = 0, vmean = 0, vsig = 0, wmean = 0, wsig = 0;
    for (int i = 0; i < 2; i++)
      for (int j = 0; j < 2; j++)
        for (int k = 0; k < 2; k++) {
          umean += met0->u[ix + i][iy + j][iz + k];
          usig += SQR(met0->u[ix + i][iy + j][iz + k]);
          vmean += met0->v[ix + i][iy + j][iz + k];
          vsig += SQR(met0->v[ix + i][iy + j][iz + k]);
          wmean += met0->w[ix + i][iy + j][iz + k];
          wsig += SQR(met0->w[ix + i][iy + j][iz + k]);
 
          umean += met1->u[ix + i][iy + j][iz + k];
          usig += SQR(met1->u[ix + i][iy + j][iz + k]);
          vmean += met1->v[ix + i][iy + j][iz + k];
          vsig += SQR(met1->v[ix + i][iy + j][iz + k]);
          wmean += met1->w[ix + i][iy + j][iz + k];
          wsig += SQR(met1->w[ix + i][iy + j][iz + k]);
        }
    usig = usig / 16.f - SQR(umean / 16.f);
    usig = (usig > 0 ? sqrtf(usig) : 0);
    vsig = vsig / 16.f - SQR(vmean / 16.f);
    vsig = (vsig > 0 ? sqrtf(vsig) : 0);
    wsig = wsig / 16.f - SQR(wmean / 16.f);
    wsig = (wsig > 0 ? sqrtf(wsig) : 0);
 
    /* Set temporal correlations for mesoscale fluctuations... */
    const double r = 1 - 2 * fabs(cache->dt[ip]) / ctl->dt_met;
    const double r2 = sqrt(1 - r * r);
 
    /* Calculate horizontal mesoscale wind fluctuations... */
    if (ctl->turb_mesox > 0) {
      cache->uvwp[ip][0] =
        (float) (r * cache->uvwp[ip][0] +
                 r2 * cache->rs[3 * ip] * ctl->turb_mesox * usig);
      atm->lon[ip] +=
        DX2COORD(met0, cache->uvwp[ip][0] * cache->dt[ip], atm->lat[ip]);
 
      cache->uvwp[ip][1] =
        (float) (r * cache->uvwp[ip][1] +
                 r2 * cache->rs[3 * ip + 1] * ctl->turb_mesox * vsig);
      atm->lat[ip] += DY2COORD(met0, cache->uvwp[ip][1] * cache->dt[ip]);
    }
 
    /* Calculate vertical mesoscale wind fluctuations... */
    if (ctl->turb_mesoz > 0) {
      cache->uvwp[ip][2] =
        (float) (r * cache->uvwp[ip][2] +
                 r2 * cache->rs[3 * ip + 2] * ctl->turb_mesoz * wsig);
      atm->p[ip] += cache->uvwp[ip][2] * cache->dt[ip];
    }
  }
}
 
/*****************************************************************************/
 
void module_diff_pbl(
  const ctl_t *ctl,
  cache_t *cache,
  met_t *met0,
  met_t *met1,
  atm_t *atm) {
 
  /* Set timer... */
  SELECT_TIMER("MODULE_DIFF_PBL", "PHYSICS");
 
  /* Create random numbers... */
  module_rng(ctl, cache->rs, 3 * (size_t) atm->np, 1);
 
  /* Loop over particles... */
  PARTICLE_LOOP(0, atm->np, 1, "acc data present(ctl,cache,met0,met1,atm)") {
 
    double pbl, ps, dsigw_dz = 0.0, sig_u = 0.0, sig_v = 0.0, sig_w = 0.0;
    double tau_u = 0.0, tau_v = 0.0, tau_w = 0.0;
 
    /* Get PBL pressure... */
    INTPOL_INIT;
    INTPOL_2D(pbl, 1);
 
    /* Let the background diffusion scheme handle particles above the PBL. */
    if (atm->p[ip] < pbl)
      continue;
 
    /* Get surface pressure... */
    INTPOL_2D(ps, 0);
 
    /* Skip invalid or vanishing PBL layers. */
    if (!(ps > 0.0 && pbl > 0.0 && ps > pbl))
      continue;
 
    /* Calculate heights [m] above ground.
       Z() returns altitude in km, so multiply differences by 1e3. */
    const double p = MIN(atm->p[ip], ps);
    const double zs = Z(ps);
    const double z_raw = 1e3 * (Z(p) - zs);
    const double zi = 1e3 * (Z(pbl) - zs);
 
    /* Require a physically meaningful PBL depth. */
    if (!(zi > 1.0))
      continue;
 
    /* Clamp height to the PBL interval for closure evaluation. */
    const double z = CLAMP(z_raw, 0.0, zi);
    const double zeta = CLAMP(z / zi, 1e-6, 1.0 - 1e-6);
    const double z_m = MAX(z, 1.0);
 
    /* Temporarily use clamped pressure for thermodynamic interpolation.
       This avoids inconsistent interpolation if a particle has slipped
       below the surface pressure. */
    const double p_save = atm->p[ip];
    atm->p[ip] = p;
 
    /* Calculate friction velocity... */
    double ess, nss, h2o, t;
    INTPOL_2D(ess, 0);
    INTPOL_2D(nss, 0);
    INTPOL_3D(t, 1);
    INTPOL_3D(h2o, 0);
 
    /* Restore particle pressure before any continue/update path. */
    atm->p[ip] = p_save;
 
    const double tv = TVIRT(t, h2o);
    const double thetav = THETAVIRT(p, t, h2o);
    const double rho = RHO(p, tv);
    const double tau = sqrt(SQR(ess) + SQR(nss));
 
    if (!(rho > 0.0))
      continue;
 
    const double ustar = sqrt(MAX(tau / rho, 0.0));
    const double ust = MAX(1e-4, ustar);
 
    /* Get surface sensible heat flux.
       Sign convention assumed here: unstable surface heating gives shf < 0,
       as in the existing implementation. */
    double shf;
    INTPOL_2D(shf, 1);
 
    /* Estimate Monin-Obukhov length [m] to distinguish
       neutral, stable, and unstable cases. */
    double ol = 1e12;
    if (fabs(shf) > 1e-6)
      ol = thetav * rho * CPD * SQR(ust) * ust / (KARMAN * G0 * shf);
 
    /* Neutral conditions... */
    if (zi / fabs(ol) < 1.0) {
 
      /* corr has units of seconds, hence the exponential coefficients
         have units of s^-1. The derivative d(sig_w)/dz therefore needs
         the extra factor 1/ust. */
      const double corr = z_m / ust;
      const double sigw0 = 1.3 * ust * exp(-2e-4 * corr);
 
      sig_u = MAX(2.0 * ust * exp(-3e-4 * corr), 1e-5);
      sig_v = MAX(sigw0, 1e-5);
      sig_w = MAX(sigw0, 1e-5);
      dsigw_dz = -2e-4 * sigw0 / ust;
 
      tau_u = 0.5 * z_m / sig_w / (1.0 + 1.5e-3 * corr);
      tau_v = tau_u;
      tau_w = tau_u;
    }
 
    /* Unstable conditions... */
    else if (ol < 0.0) {
 
      /* Convective velocity scale [m/s]. */
      const double wstar_arg = -G0 / thetav * shf / (rho * CPD) * zi;
      const double wstar = pow(MAX(wstar_arg, 0.0), 1.0 / 3.0);
      double dsigw2_dz = 0.0;
 
      /* Hanna1/FLEXPART turbulent velocity standard deviations [m/s]. */
      sig_u = MAX(ust * pow(MAX(12.0 - 0.5 * zi / ol, 0.0), 1.0 / 3.0), 1e-6);
      sig_v = sig_u;
 
      if (zeta < 0.03) {
        const double arg = MAX(3.0 * zeta - ol / zi, 1e-12);
        sig_w = 0.96 * wstar * pow(arg, 1.0 / 3.0);
        dsigw2_dz = 1.8432 * SQR(wstar) / zi * pow(arg, -1.0 / 3.0);
      } else if (zeta < 0.4) {
        const double arg = MAX(3.0 * zeta - ol / zi, 1e-12);
        const double s1 = 0.96 * pow(arg, 1.0 / 3.0);
        const double s2 = 0.763 * pow(zeta, 0.175);
        if (s1 < s2) {
          sig_w = wstar * s1;
          dsigw2_dz = 1.8432 * SQR(wstar) / zi * pow(arg, -1.0 / 3.0);
        } else {
          sig_w = wstar * s2;
          dsigw2_dz = 0.203759 * SQR(wstar) / zi * pow(zeta, -0.65);
        }
      } else if (zeta < 0.96) {
        sig_w = 0.722 * wstar * pow(1.0 - zeta, 0.207);
        dsigw2_dz = -0.215812 * SQR(wstar) / zi * pow(1.0 - zeta, -0.586);
      } else {
        sig_w = 0.37 * wstar;
        dsigw2_dz = 0.0;
      }
 
      sig_w = MAX(sig_w, 1e-6);
      dsigw_dz = sig_w > 1e-12 ? 0.5 * dsigw2_dz / sig_w : 0.0;
 
      /* Hanna/FLEXPART Lagrangian timescales [s]. */
      tau_u = 0.15 * zi / MAX(sig_u, 1e-12);
      tau_v = tau_u;
 
      if (z_m < fabs(ol)) {
        const double denom = 0.55 - 0.38 * fabs(z_m / ol);
        tau_w = 0.1 * z_m / (sig_w * MAX(denom, 0.05));
      } else if (zeta < 0.1)
        tau_w = 0.59 * z_m / sig_w;
      else
        tau_w = 0.15 * zi / sig_w * (1.0 - exp(-5.0 * zeta));
    }
 
    /* Stable conditions... */
    else {
 
      sig_u = MAX(2.0 * ust * (1.0 - zeta), 1e-6);
      sig_v = MAX(1.3 * ust * (1.0 - zeta), 1e-6);
      sig_w = MAX(1.3 * ust * (1.0 - zeta), 1e-6);
      dsigw_dz = -1.3 * ust / zi;
 
      tau_u = 0.15 * zi / sig_u * sqrt(zeta);
      tau_v = 0.467 * tau_u;
      tau_w = 0.1 * zi / sig_w * pow(zeta, 0.8);
    }
 
    /* Apply FLEXPART-consistent lower bounds for timescales. */
    tau_u = MAX(tau_u, 10.0);
    tau_v = MAX(tau_v, 10.0);
    tau_w = MAX(tau_w, 30.0);
 
    /* Skip pathological states. */
    if (!(sig_u > 0.0 && sig_v > 0.0
          && sig_w > 0.0 && tau_u > 0.0 && tau_v > 0.0 && tau_w > 0.0))
      continue;
 
    /* Update horizontal perturbation [m/s]. */
    const double dt = cache->dt[ip];
    const double dt_abs = fabs(dt);
 
    const double ru = exp(-dt_abs / tau_u);
    const double ru2 = sqrt(MAX(0.0, 1.0 - SQR(ru)));
    const double rv = exp(-dt_abs / tau_v);
    const double rv2 = sqrt(MAX(0.0, 1.0 - SQR(rv)));
 
    cache->uvwp[ip][0]
      = (float) (cache->uvwp[ip][0] * ru + sig_u * ru2 * cache->rs[3 * ip]);
 
    cache->uvwp[ip][1]
      = (float) (cache->uvwp[ip][1] * rv
                 + sig_v * rv2 * cache->rs[3 * ip + 1]);
 
    /* Update vertical perturbation [m/s].
       The drift term is d(sig_w^2)/dz + sig_w^2/rho * d(rho)/dz.
       With exponential scale height H0 [km], dln(rho)/dz ~= -1/(1000 H0). */
    const double rw = exp(-dt_abs / tau_w);
    const double rw2 = sqrt(MAX(0.0, 1.0 - SQR(rw)));
    const double rhoaux = -1.0 / (1e3 * H0);
 
    cache->uvwp[ip][2]
      = (float) (cache->uvwp[ip][2] * rw + sig_w * rw2 * cache->rs[3 * ip + 2]
                 + tau_w * (1.0 - rw)
                 * (2.0 * sig_w * dsigw_dz + rhoaux * SQR(sig_w)));
 
    /* Calculate new horizontal air parcel position. */
    atm->lon[ip] += DX2COORD(met0, cache->uvwp[ip][0] * dt, atm->lat[ip]);
    atm->lat[ip] += DY2COORD(met0, cache->uvwp[ip][1] * dt);
 
    /* Calculate new height and reflect robustly at surface and PBL top.
       Each boundary reflection reverses the vertical turbulent velocity.
       This loop is intentionally simple and explicit: it remains correct
       even if a large step crosses multiple boundaries. */
    double znew = z + cache->uvwp[ip][2] * dt;
 
    while (znew < 0.0 || znew > zi) {
 
      if (znew < 0.0) {
        znew = -znew;
        cache->uvwp[ip][2] = -cache->uvwp[ip][2];
      }
 
      if (znew > zi) {
        znew = 2.0 * zi - znew;
        cache->uvwp[ip][2] = -cache->uvwp[ip][2];
      }
    }
 
    /* Set pressure from reflected geometric height.
       This is more consistent than a linearized DZ2DP update for
       potentially large turbulent steps. */
    atm->p[ip] = P(zs + znew / 1000.0);
 
    /* Enforce exact pressure limits of the local PBL column. */
    atm->p[ip] = CLAMP(atm->p[ip], pbl, ps);
  }
}
 
/*****************************************************************************/
 
void module_diff_turb(
  const ctl_t *ctl,
  cache_t *cache,
  const clim_t *clim,
  met_t *met0,
  met_t *met1,
  atm_t *atm) {
 
  /* Set timer... */
  SELECT_TIMER("MODULE_DIFF_TURB", "PHYSICS");
 
  /* Create random numbers... */
  module_rng(ctl, cache->rs, 3 * (size_t) atm->np, 1);
 
  /* Loop over particles... */
  PARTICLE_LOOP(0, atm->np, 1,
                "acc data present(ctl,cache,clim,met0,met1,atm)") {
 
    /* Get PBL pressure... */
    double pbl;
    INTPOL_INIT;
    INTPOL_2D(pbl, 1);
 
    /* Let optional PBL closure schemes handle turbulent diffusion inside the PBL. */
    if (ctl->turb_pbl_scheme > 0 && atm->p[ip] >= pbl)
      continue;
 
    /* Get surface pressure... */
    double ps;
    INTPOL_2D(ps, 0);
 
    /* Pressure at model top [hPa]. */
    const double ptop = met0->p[met0->np - 1];
 
    /* Get weighting factors at current particle position... */
    const double wpbl = pbl_weight(ctl, atm, ip, pbl, ps);
    const double wtrop = tropo_weight(ctl, clim, atm, ip) * (1.0 - wpbl);
    const double wstrat = 1.0 - wpbl - wtrop;
 
    /* Set diffusivities [m2/s]... */
    const double Kx =
      wpbl * ctl->turb_dx_pbl
      + wtrop * ctl->turb_dx_trop + wstrat * ctl->turb_dx_strat;
 
    const double Kz =
      wpbl * ctl->turb_dz_pbl
      + wtrop * ctl->turb_dz_trop + wstrat * ctl->turb_dz_strat;
 
    /* Set time step... */
    const double dt_abs = fabs(cache->dt[ip]);
 
    /* Horizontal turbulent diffusion...
       Kx [m2/s], dt [s] => sigma_h [m]. */
    if (Kx > 0) {
      const double sigma_h = sqrt(2.0 * Kx * dt_abs);
 
      atm->lon[ip] +=
        DX2COORD(met0, cache->rs[3 * ip] * sigma_h, atm->lat[ip]);
 
      atm->lat[ip] += DY2COORD(met0, cache->rs[3 * ip + 1] * sigma_h);
    }
 
    /* Vertical turbulent diffusion... */
    if (Kz > 0) {
 
      /* Random displacement:
         Kz [m2/s], dt [s] => sigma_z [m], converted to [km]. */
      const double sigma_z = sqrt(2.0 * Kz * dt_abs) * 1e-3;
 
      /* Save current pressure because pbl_weight() and tropo_weight()
         use atm->p[ip]. */
      const double p_save = atm->p[ip];
 
      /* Estimate dKz/dz by centered finite difference.
         eps_km = 0.01 km = 10 m.
         Positive z is upward; therefore p_up < p_save and p_dn > p_save. */
      const double eps_km = 0.01;
      const double p_up = p_save + DZ2DP(eps_km, p_save);
      const double p_dn = p_save + DZ2DP(-eps_km, p_save);
 
      /* Kz above... */
      atm->p[ip] = MAX(ptop, MIN(ps, p_up));
      const double wpbl_up = pbl_weight(ctl, atm, ip, pbl, ps);
      const double wtrop_up =
        tropo_weight(ctl, clim, atm, ip) * (1.0 - wpbl_up);
      const double wstrat_up = 1.0 - wpbl_up - wtrop_up;
 
      const double Kz_up =
        wpbl_up * ctl->turb_dz_pbl
        + wtrop_up * ctl->turb_dz_trop + wstrat_up * ctl->turb_dz_strat;
 
      /* Kz below... */
      atm->p[ip] = MAX(ptop, MIN(ps, p_dn));
      const double wpbl_dn = pbl_weight(ctl, atm, ip, pbl, ps);
      const double wtrop_dn =
        tropo_weight(ctl, clim, atm, ip) * (1.0 - wpbl_dn);
      const double wstrat_dn = 1.0 - wpbl_dn - wtrop_dn;
 
      const double Kz_dn =
        wpbl_dn * ctl->turb_dz_pbl
        + wtrop_dn * ctl->turb_dz_trop + wstrat_dn * ctl->turb_dz_strat;
 
      /* Restore current pressure... */
      atm->p[ip] = p_save;
 
      /* Well-mixed drift:
         w_drift = dKz/dz + Kz * dlnrho/dz
 
         Units:
         dKz_dz     [m2/s] / [m] = [m/s]
         dlnrho_dz  [1/m]
         Kz*dlnrho  [m2/s] * [1/m] = [m/s]
         dz_drift   [m/s] * [s] * 1e-3 = [km]
 
         With exponential atmosphere rho ~ exp(-z/H0):
         dlnrho/dz = -1 / (1000 * H0)
         because H0 is in [km]. */
      const double dKz_dz = (Kz_up - Kz_dn) / (2.0 * eps_km * 1e3);
      const double dlnrho_dz = -1.0 / (1e3 * H0);
      const double w_drift = dKz_dz + Kz * dlnrho_dz;
      const double dz_drift = w_drift * dt_abs * 1e-3;
 
      /* Total vertical displacement [km]. */
      const double dz_tot = cache->rs[3 * ip + 2] * sigma_z + dz_drift;
 
      /* Update particle pressure... */
      double ptrial = p_save + DZ2DP(dz_tot, p_save);
 
      /* Reflect at surface and model top.
         The transformation p -> pb^2 / p corresponds to reflection in
         logarithmic pressure / approximate height coordinates.  Use repeated
         reflection for robustness in case a large random step crosses more
         than one boundary. */
      for (int iter = 0; iter < 10; iter++) {
        if (ptrial > ps)
          ptrial = ps * ps / ptrial;
        else if (ptrial < ptop)
          ptrial = ptop * ptop / ptrial;
        else
          break;
      }
 
      /* Final safety clamp in case of an exceptionally large displacement... */
      atm->p[ip] = MAX(ptop, MIN(ps, ptrial));
    }
  }
}
 
/*****************************************************************************/
 
void module_dry_depo(
  const ctl_t *ctl,
  const cache_t *cache,
  met_t *met0,
  met_t *met1,
  atm_t *atm) {
 
  /* Set timer... */
  SELECT_TIMER("MODULE_DRY_DEPO", "PHYSICS");
 
  /* Check quantity flags... */
  if (ctl->qnt_m < 0 && ctl->qnt_vmr < 0)
    ERRMSG("Module needs quantity mass or volume mixing ratio!");
 
  /* Loop over particles... */
  PARTICLE_LOOP(0, atm->np, 1, "acc data present(ctl,cache,met0,met1,atm)") {
 
    /* Get surface pressure... */
    double ps;
    INTPOL_INIT;
    INTPOL_2D(ps, 1);
 
    /* Check whether particle is above the surface layer... */
    if (atm->p[ip] < ps - ctl->dry_depo_dp)
      continue;
 
    /* Set depth of surface layer... */
    const double dz = 1000. * (Z(ps - ctl->dry_depo_dp) - Z(ps));
 
    /* Calculate sedimentation velocity for particles... */
    double v_dep;
    if (ctl->qnt_rp > 0 && ctl->qnt_rhop > 0) {
 
      /* Get temperature... */
      double t;
      INTPOL_3D(t, 1);
 
      /* Set deposition velocity... */
      v_dep = sedi(atm->p[ip], t, atm->q[ctl->qnt_rp][ip],
                   atm->q[ctl->qnt_rhop][ip]);
    }
 
    /* Use explicit sedimentation velocity for gases... */
    else
      v_dep = ctl->dry_depo_vdep;
 
    /* Calculate loss of mass based on deposition velocity... */
    const double aux = exp(-cache->dt[ip] * v_dep / dz);
    if (ctl->qnt_m >= 0) {
      if (ctl->qnt_mloss_dry >= 0)
        atm->q[ctl->qnt_mloss_dry][ip]
          += atm->q[ctl->qnt_m][ip] * (1 - aux);
      atm->q[ctl->qnt_m][ip] *= aux;
      if (ctl->qnt_loss_rate >= 0)
        atm->q[ctl->qnt_loss_rate][ip] += v_dep / dz;
    }
    if (ctl->qnt_vmr >= 0)
      atm->q[ctl->qnt_vmr][ip] *= aux;
  }
}
 
/*****************************************************************************/
 
void module_h2o2_chem(
  const ctl_t *ctl,
  const cache_t *cache,
  const clim_t *clim,
  met_t *met0,
  met_t *met1,
  atm_t *atm) {
 
  if (ctl->met_coord_type != 0)
    ERRMSG("Only lat/lon grid supported");
 
  /* Set timer... */
  SELECT_TIMER("MODULE_H2O2_CHEM", "PHYSICS");
 
  /* Check quantity flags... */
  if (ctl->qnt_m < 0 && ctl->qnt_vmr < 0)
    ERRMSG("Module needs quantity mass or volume mixing ratio!");
 
  /* Parameter of SO2 correction... */
  const double low = pow(1. / SO2_CORR_A, 1. / SO2_CORR_B);
 
  /* Loop over particles... */
  PARTICLE_LOOP(0, atm->np, 1, "acc data present(ctl,cache,met0,met1,atm)") {
 
    /* Check whether particle is inside cloud... */
    double lwc, rwc;
    INTPOL_INIT;
    INTPOL_3D(lwc, 1);
    INTPOL_3D(rwc, 0);
    if (!(lwc > 0 || rwc > 0))
      continue;
 
    /* Get temperature... */
    double t;
    INTPOL_3D(t, 0);
 
    /* Get molecular density... */
    const double M = MOLEC_DENS(atm->p[ip], t);
 
    /* Reaction rate (Berglen et al., 2004)... */
    const double k = H2O2_SO2_RATE_REF * exp(-H2O2_SO2_RATE_TEMP / RI * (1. / t - 1. / CHEM_REF_TEMP)); /* Maass (1999), M^(-2) */
 
    /* Henry constant of SO2... */
    const double H_SO2 =
      SO2_HENRY_REF * exp(SO2_HENRY_TEMP
                          * (1. / t - 1. / CHEM_REF_TEMP)) * RI * t;
    const double K_1S = SO2_DISS_K1_REF * exp(SO2_DISS_K1_TEMP * (1. / t - 1. / CHEM_REF_TEMP));        /* unit: mol/L */
 
    /* Henry constant of H2O2... */
    const double H_h2o2 =
      H2O2_HENRY_REF * exp(H2O2_HENRY_TEMP
                           * (1. / t - 1. / CHEM_REF_TEMP)) * RI * t;
 
    /* Correction factor for high SO2 concentration
       (if qnt_Cx is defined, the correction is switched on)... */
    double cor = 1.0;
    if (ctl->qnt_Cx >= 0)
      cor = atm->q[ctl->qnt_Cx][ip] >
        low ? SO2_CORR_A * pow(atm->q[ctl->qnt_Cx][ip], SO2_CORR_B) : 1;
 
    const double h2o2 = H_h2o2
      * clim_zm(&clim->h2o2, atm->time[ip], atm->lat[ip], atm->p[ip])
      * M * cor * 1000. / AVO;  /* unit: mol/L */
 
    /* Volume water content in cloud [m^3 m^(-3)]... */
    const double rho_air = atm->p[ip] / (RI * t) * MA / 10.;
    const double CWC = (lwc + rwc) * rho_air / 1e3;
 
    /* Calculate exponential decay (Rolph et al., 1992)... */
    const double rate_coef = k * K_1S * h2o2 * H_SO2 * CWC;
    const double aux = exp(-cache->dt[ip] * rate_coef);
    if (ctl->qnt_m >= 0) {
      if (ctl->qnt_mloss_h2o2 >= 0)
        atm->q[ctl->qnt_mloss_h2o2][ip] += atm->q[ctl->qnt_m][ip] * (1 - aux);
      atm->q[ctl->qnt_m][ip] *= aux;
      if (ctl->qnt_loss_rate >= 0)
        atm->q[ctl->qnt_loss_rate][ip] += rate_coef;
    }
    if (ctl->qnt_vmr >= 0)
      atm->q[ctl->qnt_vmr][ip] *= aux;
  }
}
 
/*****************************************************************************/
 
void module_isosurf_init(
  const ctl_t *ctl,
  cache_t *cache,
  met_t *met0,
  met_t *met1,
  atm_t *atm) {
 
  double t;
 
  /* Set timer... */
  SELECT_TIMER("MODULE_ISOSURF_INIT", "PHYSICS");
 
  /* Save pressure... */
  if (ctl->isosurf == 1) {
    PARTICLE_LOOP(0, atm->np, 0, "acc data present(ctl,atm)") {
      atm->q[ctl->qnt_iso_var][ip] = atm->p[ip];
    }
  }
 
  /* Save density... */
  else if (ctl->isosurf == 2) {
    PARTICLE_LOOP(0, atm->np, 0, "acc data present(ctl,met0,met1,atm)") {
      INTPOL_INIT;
      INTPOL_3D(t, 1);
      atm->q[ctl->qnt_iso_var][ip] = atm->p[ip] / t;
    }
  }
 
  /* Save potential temperature... */
  else if (ctl->isosurf == 3) {
    PARTICLE_LOOP(0, atm->np, 0, "acc data present(ctl,met0,met1,atm)") {
      INTPOL_INIT;
      INTPOL_3D(t, 1);
      atm->q[ctl->qnt_iso_var][ip] = THETA(atm->p[ip], t);
    }
  }
 
  /* Read balloon pressure data... */
  else if (ctl->isosurf == 4) {
 
    /* Write info... */
    LOG(1, "Read balloon pressure data: %s", ctl->balloon);
 
    /* Open file... */
    FILE *in;
    if (!(in = fopen(ctl->balloon, "r")))
      ERRMSG("Cannot open file!");
 
    /* Read pressure time series... */
    char line[LEN];
    while (fgets(line, LEN, in))
      if (sscanf(line, "%lg %lg", &(cache->iso_ts[cache->iso_n]),
                 &(cache->iso_ps[cache->iso_n])) == 2)
        if ((++cache->iso_n) > NP)
          ERRMSG("Too many data points!");
 
    /* Check number of points... */
    if (cache->iso_n < 1)
      ERRMSG("Could not read any data!");
 
    /* Close file... */
    fclose(in);
 
    /* Update of cache data on device... */
    mptrac_update_device(NULL, cache, NULL, NULL, NULL, NULL);
  }
}
 
/*****************************************************************************/
 
void module_isosurf(
  const ctl_t *ctl,
  const cache_t *cache,
  met_t *met0,
  met_t *met1,
  atm_t *atm) {
 
  /* Set timer... */
  SELECT_TIMER("MODULE_ISOSURF", "PHYSICS");
 
  /* Loop over particles... */
  PARTICLE_LOOP(0, atm->np, 0, "acc data present(ctl,cache,met0,met1,atm)") {
 
    /* Init... */
    double t;
    INTPOL_INIT;
 
    /* Restore pressure... */
    if (ctl->isosurf == 1)
      atm->p[ip] = atm->q[ctl->qnt_iso_var][ip];
 
    /* Restore density... */
    else if (ctl->isosurf == 2) {
      INTPOL_3D(t, 1);
      atm->p[ip] = atm->q[ctl->qnt_iso_var][ip] * t;
    }
 
    /* Restore potential temperature... */
    else if (ctl->isosurf == 3) {
      INTPOL_3D(t, 1);
      atm->p[ip] = 1000. * pow(atm->q[ctl->qnt_iso_var][ip] / t, -1. / KAPPA);
    }
 
    /* Interpolate pressure... */
    else if (ctl->isosurf == 4) {
      if (atm->time[ip] <= cache->iso_ts[0])
        atm->p[ip] = cache->iso_ps[0];
      else if (atm->time[ip] >= cache->iso_ts[cache->iso_n - 1])
        atm->p[ip] = cache->iso_ps[cache->iso_n - 1];
      else {
        const int idx =
          locate_irr(cache->iso_ts, cache->iso_n, atm->time[ip]);
        atm->p[ip] =
          LIN(cache->iso_ts[idx], cache->iso_ps[idx], cache->iso_ts[idx + 1],
              cache->iso_ps[idx + 1], atm->time[ip]);
      }
    }
  }
}
 
/*****************************************************************************/
 
#ifdef KPP
void module_kpp_chem(
  ctl_t *ctl,
  cache_t *cache,
  clim_t *clim,
  met_t *met0,
  met_t *met1,
  atm_t *atm) {
 
  /* Set timer... */
  SELECT_TIMER("MODULE_KPP_CHEM", "PHYSICS");
 
  const int nvar = NVAR, nfix = NFIX, nreact = NREACT;
  double rtol[1] = { 1.0e-3 };
  double atol[1] = { 1.0 };
 
  /* Loop over particles... */
#ifdef _OPENACC
#pragma acc data copy(rtol,atol,nvar,nfix,nreact)
#endif
  PARTICLE_LOOP(0, atm->np, 1,
                "acc data present(ctl,cache,clim,met0,met1,atm) ") {
 
    /* Initialize... */
    double var[nvar], fix[nfix], rconst[nreact];
    for (int i = 0; i < nvar; i++)
      var[i] = 0.0;
    for (int i = 0; i < nfix; i++)
      fix[i] = 0.0;
    for (int i = 0; i < nreact; i++)
      rconst[i] = 0.0;
    kpp_chem_initialize(ctl, clim, met0, met1, atm, var, fix, rconst, ip);
 
    /* Integrate... */
    double rpar[20];
    int ipar[20];
    for (int i = 0; i < 20; i++) {
      ipar[i] = 0;
      rpar[i] = 0.0;
    }
    ipar[0] = 0;                /* 0: F=F(y), i.e. independent of t (autonomous); 0:F=F(t,y), i.e. depends on t (non-autonomous) */
    ipar[1] = 1;                /* 0: NVAR-dimentional vector of tolerances; 1:scalar tolerances */
    ipar[3] = 4;                /* choice of the method:Rodas3 */
    Rosenbrock(var, fix, rconst, 0, ctl->dt_kpp,
               atol, rtol, &FunTemplate, &JacTemplate, rpar, ipar);
 
    /* Save results.. */
    kpp_chem_output2atm(atm, ctl, met0, met1, var, ip);
  }
}
#endif
 
/*****************************************************************************/
 
void module_meteo(
  const ctl_t *ctl,
  const cache_t *cache,
  const clim_t *clim,
  met_t *met0,
  met_t *met1,
  atm_t *atm) {
 
  /* Set timer... */
  SELECT_TIMER("MODULE_METEO", "PHYSICS");
 
  /* Check quantity flags... */
  if (ctl->qnt_tsts >= 0)
    if (ctl->qnt_tice < 0 || ctl->qnt_tnat < 0)
      ERRMSG("Need T_ice and T_NAT to calculate T_STS!");
 
  /* Loop over particles... */
  PARTICLE_LOOP(0, atm->np, 0,
                "acc data present(ctl,cache,clim,met0,met1,atm)") {
 
    double ps, ts, zs, us, vs, ess, nss, shf, lsm, sst, pbl, pt, pct, pcb,
      cl, plcl, plfc, pel, cape, cin, o3c, pv, t, tt, u, v, w, h2o, h2ot,
      o3, lwc, rwc, iwc, swc, cc, z, zt, eta_d = 0, wdot = 0;
 
    /* Interpolate meteo data... */
    INTPOL_INIT;
    INTPOL_TIME_ALL(atm->time[ip], atm->p[ip], atm->lon[ip], atm->lat[ip]);
 
    /* Diagnose eta coordinate on native model levels... */
    if (ctl->qnt_eta_d >= 0)
      intpol_met_4d_zeta(met0, met0->pl, met0->zetal,
                         met1, met1->pl, met1->zetal,
                         atm->time[ip], atm->p[ip], atm->lon[ip],
                         atm->lat[ip], &eta_d, ci, cw, 1);
 
    /* Interpolate vertical velocity on native model levels... */
    if ((ctl->advect_vert_coord == 1 && ctl->qnt_zeta_dot >= 0)
        || (ctl->advect_vert_coord == 3 && ctl->qnt_eta_dot >= 0))
      intpol_met_4d_zeta(met0, met0->pl, met0->zeta_dotl,
                         met1, met1->pl, met1->zeta_dotl,
                         atm->time[ip], atm->p[ip], atm->lon[ip],
                         atm->lat[ip], &wdot, ci, cw, 1);
 
    /* Set quantities... */
    SET_ATM(qnt_ps, ps);
    SET_ATM(qnt_ts, ts);
    SET_ATM(qnt_zs, zs);
    SET_ATM(qnt_us, us);
    SET_ATM(qnt_vs, vs);
    SET_ATM(qnt_ess, ess);
    SET_ATM(qnt_nss, nss);
    SET_ATM(qnt_shf, shf);
    SET_ATM(qnt_lsm, lsm);
    SET_ATM(qnt_sst, sst);
    SET_ATM(qnt_pbl, pbl);
    SET_ATM(qnt_pt, pt);
    SET_ATM(qnt_tt, tt);
    SET_ATM(qnt_zt, zt);
    SET_ATM(qnt_h2ot, h2ot);
    SET_ATM(qnt_zg, z);
    SET_ATM(qnt_p, atm->p[ip]);
    SET_ATM(qnt_t, t);
    SET_ATM(qnt_rho, RHO(atm->p[ip], t));
    SET_ATM(qnt_u, u);
    SET_ATM(qnt_v, v);
    SET_ATM(qnt_w, w);
    SET_ATM(qnt_h2o, h2o);
    SET_ATM(qnt_o3, o3);
    SET_ATM(qnt_lwc, lwc);
    SET_ATM(qnt_rwc, rwc);
    SET_ATM(qnt_iwc, iwc);
    SET_ATM(qnt_swc, swc);
    SET_ATM(qnt_cc, cc);
    SET_ATM(qnt_pct, pct);
    SET_ATM(qnt_pcb, pcb);
    SET_ATM(qnt_cl, cl);
    SET_ATM(qnt_plcl, plcl);
    SET_ATM(qnt_plfc, plfc);
    SET_ATM(qnt_pel, pel);
    SET_ATM(qnt_cape, cape);
    SET_ATM(qnt_cin, cin);
    SET_ATM(qnt_o3c, o3c);
    const double lat_ref =
      ctl->met_coord_type == 0 ? atm->lat[ip] : ctl->met_utm_ref_lat;
    SET_ATM(qnt_hno3,
            clim_zm(&clim->hno3, atm->time[ip], lat_ref, atm->p[ip]));
    SET_ATM(qnt_oh, clim_oh(ctl, clim, atm->time[ip],
                            atm->lon[ip], atm->lat[ip], atm->p[ip]));
    SET_ATM(qnt_h2o2, clim_zm(&clim->h2o2, atm->time[ip],
                              lat_ref, atm->p[ip]));
    SET_ATM(qnt_ho2, clim_zm(&clim->ho2, atm->time[ip], lat_ref, atm->p[ip]));
    SET_ATM(qnt_o1d, clim_zm(&clim->o1d, atm->time[ip], lat_ref, atm->p[ip]));
    SET_ATM(qnt_vh, sqrt(u * u + v * v));
    SET_ATM(qnt_vz, -1e3 * H0 / atm->p[ip] * w);
    SET_ATM(qnt_psat, PSAT(t));
    SET_ATM(qnt_psice, PSICE(t));
    SET_ATM(qnt_pw, PW(atm->p[ip], h2o));
    SET_ATM(qnt_sh, SH(h2o));
    SET_ATM(qnt_rh, RH(atm->p[ip], t, h2o));
    SET_ATM(qnt_rhice, RHICE(atm->p[ip], t, h2o));
    SET_ATM(qnt_theta, THETA(atm->p[ip], t));
    SET_ATM(qnt_zeta, atm->q[ctl->qnt_zeta][ip]);
    SET_ATM(qnt_zeta_d, ZETA(ps, atm->p[ip], t));
    SET_ATM(qnt_eta, atm->q[ctl->qnt_eta][ip]);
    SET_ATM(qnt_eta_d, eta_d);
    if (ctl->advect_vert_coord == 1) {
      SET_ATM(qnt_zeta_dot, wdot);
    } else if (ctl->advect_vert_coord == 3) {
      SET_ATM(qnt_eta_dot, wdot);
    }
    SET_ATM(qnt_tvirt, TVIRT(t, h2o));
    SET_ATM(qnt_lapse, lapse_rate(t, h2o));
    SET_ATM(qnt_pv, pv);
    SET_ATM(qnt_tdew, TDEW(atm->p[ip], h2o));
    SET_ATM(qnt_tice, TICE(atm->p[ip], h2o));
    SET_ATM(qnt_tnat,
            nat_temperature(atm->p[ip], h2o,
                            clim_zm(&clim->hno3, atm->time[ip],
                                    atm->lat[ip], atm->p[ip])));
    SET_ATM(qnt_tsts,
            0.5 * (atm->q[ctl->qnt_tice][ip] + atm->q[ctl->qnt_tnat][ip]));
  }
}
 
/*****************************************************************************/
 
void module_mixing(
  const ctl_t *ctl,
  const clim_t *clim,
  atm_t *atm,
  const double t) {
 
  /* Set timer... */
  SELECT_TIMER("MODULE_MIXING", "PHYSICS");
 
  /* Allocate... */
  const int np = atm->np;
  int *restrict const ixs = (int *) malloc((size_t) np * sizeof(int));
  int *restrict const iys = (int *) malloc((size_t) np * sizeof(int));
  int *restrict const izs = (int *) malloc((size_t) np * sizeof(int));
  double *restrict const mixparam =
    (double *) malloc((size_t) np * sizeof(double));
  if (ixs == NULL || iys == NULL || izs == NULL || mixparam == NULL)
    ERRMSG("Out of memory!");
 
  /* Set grid box size... */
  const double dz = (ctl->mixing_z1 - ctl->mixing_z0) / ctl->mixing_nz;
  const double dlon = (ctl->mixing_lon1 - ctl->mixing_lon0) / ctl->mixing_nx;
  const double dlat = (ctl->mixing_lat1 - ctl->mixing_lat0) / ctl->mixing_ny;
 
  /* Set time interval... */
  const double t0 = t - 0.5 * ctl->dt_mod;
  const double t1 = t + 0.5 * ctl->dt_mod;
  const double dt_mix = ctl->mixing_dt > 0 ? ctl->mixing_dt : ctl->dt_mod;
 
  /* Get indices... */
#ifdef _OPENACC
#pragma acc enter data create(ixs[0:np],iys[0:np],izs[0:np],mixparam[0:np])
#pragma acc data present(ctl,clim,atm,ixs,iys,izs,mixparam)
#pragma acc parallel loop independent gang vector
#else
#pragma omp parallel for default(shared)
#endif
  for (int ip = 0; ip < np; ip++) {
    const double zpart = Z(atm->p[ip]);
    if (atm->time[ip] < t0 || atm->time[ip] > t1
        || atm->lon[ip] < ctl->mixing_lon0
        || atm->lon[ip] >= ctl->mixing_lon1
        || atm->lat[ip] < ctl->mixing_lat0
        || atm->lat[ip] >= ctl->mixing_lat1
        || zpart < ctl->mixing_z0 || zpart >= ctl->mixing_z1) {
      izs[ip] = -1;
      continue;
    }
    ixs[ip] = (int) ((atm->lon[ip] - ctl->mixing_lon0) / dlon);
    iys[ip] = (int) ((atm->lat[ip] - ctl->mixing_lat0) / dlat);
    izs[ip] = (int) ((zpart - ctl->mixing_z0) / dz);
    if (ixs[ip] >= ctl->mixing_nx || iys[ip] >= ctl->mixing_ny
        || izs[ip] >= ctl->mixing_nz) {
      izs[ip] = -1;
      continue;
    }
    const double w = tropo_weight(ctl, clim, atm, ip);
    const double rate =
      w / ctl->mixing_tau_trop + (1.0 - w) / ctl->mixing_tau_strat;
    mixparam[ip] = -expm1(-dt_mix * rate);
  }
 
  /* Calculate interparcel mixing... */
  const int use_ensemble = (ctl->nens > 0);
 
  const int quantities[] = {
    ctl->qnt_m, ctl->qnt_vmr, ctl->qnt_Ch2o, ctl->qnt_Co3,
    ctl->qnt_Cco, ctl->qnt_Coh, ctl->qnt_Ch, ctl->qnt_Cho2,
    ctl->qnt_Ch2o2, ctl->qnt_Co1d, ctl->qnt_Co3p, ctl->qnt_Cccl4,
    ctl->qnt_Cccl3f, ctl->qnt_Cccl2f2, ctl->qnt_Cn2o,
    ctl->qnt_Csf6, ctl->qnt_aoa, ctl->qnt_Arn222, ctl->qnt_Apb210,
    ctl->qnt_Abe7, ctl->qnt_Acs137, ctl->qnt_Ai131, ctl->qnt_Axe133
  };
  const int n_qnt = sizeof(quantities) / sizeof(quantities[0]);
 
  for (int i = 0; i < n_qnt; i++)
    if (quantities[i] >= 0)
      module_mixing_help(ctl, atm, ixs, iys, izs, mixparam, quantities[i],
                         use_ensemble);
 
  /* Free... */
#ifdef _OPENACC
#pragma acc exit data delete(ixs,iys,izs,mixparam)
#endif
  free(ixs);
  free(iys);
  free(izs);
  free(mixparam);
}
 
/*****************************************************************************/
 
void module_mixing_help(
  const ctl_t *ctl,
  atm_t *atm,
  const int *ixs,
  const int *iys,
  const int *izs,
  const double *mixparam,
  const int qnt_idx,
  const int use_ensemble) {
 
  const int np = atm->np;
  const int ngrid = ctl->mixing_nx * ctl->mixing_ny * ctl->mixing_nz;
  const int nens = use_ensemble ? ctl->nens : 1;
  const int total_grid = ngrid * nens;
 
  double *restrict const cmean =
    (double *) malloc((size_t) total_grid * sizeof(double));
  double *restrict const cweight =
    (double *) malloc((size_t) total_grid * sizeof(double));
  if (cmean == NULL || cweight == NULL)
    ERRMSG("Out of memory!");
 
  /* Init... */
#ifdef _OPENACC
#pragma acc enter data create(cmean[0:total_grid],cweight[0:total_grid])
#pragma acc data present(ctl,atm,ixs,iys,izs,mixparam,cmean,cweight)
#pragma acc parallel loop independent gang vector
#else
#ifdef __NVCOMPILER
#pragma novector
#endif
#pragma omp parallel for
#endif
  for (int i = 0; i < total_grid; i++) {
    cmean[i] = 0.0;
    cweight[i] = 0.0;
  }
 
  /* Loop over particles... */
#ifdef _OPENACC
#pragma acc parallel loop independent gang vector
#endif
  for (int ip = 0; ip < np; ip++)
    if (izs[ip] >= 0) {
      const int ens = use_ensemble ? (int) atm->q[ctl->qnt_ens][ip] : 0;
      if (ens < 0 || ens >= nens)
        continue;
      const int idx =
        ens * ngrid + ARRAY_3D(ixs[ip], iys[ip], ctl->mixing_ny, izs[ip],
                               ctl->mixing_nz);
#ifdef _OPENACC
#pragma acc atomic update
#endif
      cmean[idx] += mixparam[ip] * atm->q[qnt_idx][ip];
#ifdef _OPENACC
#pragma acc atomic update
#endif
      cweight[idx] += mixparam[ip];
    }
 
  /* Compute means... */
#ifdef _OPENACC
#pragma acc parallel loop independent gang vector
#else
#ifdef __NVCOMPILER
#pragma novector
#endif
#pragma omp parallel for
#endif
  for (int i = 0; i < total_grid; i++)
    if (cweight[i] > 0)
      cmean[i] /= cweight[i];
 
  /* Interparcel mixing... */
#ifdef _OPENACC
#pragma acc parallel loop independent gang vector
#else
#pragma omp parallel for
#endif
  for (int ip = 0; ip < np; ip++) {
    if (izs[ip] >= 0) {
      const int ens = use_ensemble ? (int) atm->q[ctl->qnt_ens][ip] : 0;
 
      if (ens < 0 || ens >= nens)
        continue;
      const int idx =
        ens * ngrid + ARRAY_3D(ixs[ip], iys[ip], ctl->mixing_ny, izs[ip],
                               ctl->mixing_nz);
      atm->q[qnt_idx][ip] +=
        (cmean[idx] - atm->q[qnt_idx][ip]) * mixparam[ip];
    }
  }
 
  /* Free... */
#ifdef _OPENACC
#pragma acc exit data delete(cmean,cweight)
#endif
  free(cmean);
  free(cweight);
}
 
/*****************************************************************************/
 
void module_oh_chem(
  const ctl_t *ctl,
  const cache_t *cache,
  const clim_t *clim,
  met_t *met0,
  met_t *met1,
  atm_t *atm) {
 
  /* Set timer... */
  SELECT_TIMER("MODULE_OH_CHEM", "PHYSICS");
 
  /* Check quantity flags... */
  if (ctl->qnt_m < 0 && ctl->qnt_vmr < 0)
    ERRMSG("Module needs quantity mass or volume mixing ratio!");
 
  /* Parameter of SO2 correction... */
  const double a = 4.71572206e-08;
  const double b = -8.28782867e-01;
  const double low = pow(1. / a, 1. / b);
 
  /* Loop over particles... */
  PARTICLE_LOOP(0, atm->np, 1,
                "acc data present(ctl,cache,clim,met0,met1,atm)") {
 
    /* Get temperature... */
    double t;
    INTPOL_INIT;
    INTPOL_3D(t, 1);
 
    /* Calculate molecular density... */
    const double M = MOLEC_DENS(atm->p[ip], t);
 
    /* Use constant reaction rate... */
    double k = NAN;
    if (ctl->oh_chem_reaction == 1)
      k = ctl->oh_chem[0];
 
    /* Calculate bimolecular reaction rate... */
    else if (ctl->oh_chem_reaction == 2)
      k = ctl->oh_chem[0] * exp(-ctl->oh_chem[1] / t);
 
    /* Calculate termolecular reaction rate... */
    if (ctl->oh_chem_reaction == 3) {
 
      /* Calculate rate coefficient for X + OH + M -> XOH + M
         (JPL Publication 19-05) ... */
      const double k0 =
        ctl->oh_chem[0] * (ctl->oh_chem[1] !=
                           0 ? pow(298. / t, ctl->oh_chem[1]) : 1.);
      const double ki =
        ctl->oh_chem[2] * (ctl->oh_chem[3] !=
                           0 ? pow(298. / t, ctl->oh_chem[3]) : 1.);
      const double c = log10(k0 * M / ki);
      k = k0 * M / (1. + k0 * M / ki) * pow(0.6, 1. / (1. + c * c));
    }
 
    /* Correction factor for high SO2 concentration
       (if qnt_Cx is defined, the correction is switched on)... */
    double cor = 1;
    if (ctl->qnt_Cx >= 0)
      cor =
        atm->q[ctl->qnt_Cx][ip] >
        low ? a * pow(atm->q[ctl->qnt_Cx][ip], b) : 1;
 
    /* Calculate exponential decay... */
    const double rate_coef =
      k * clim_oh(ctl, clim, atm->time[ip], atm->lon[ip],
                  atm->lat[ip], atm->p[ip]) * M * cor;
    const double aux = exp(-cache->dt[ip] * rate_coef);
    if (ctl->qnt_m >= 0) {
      if (ctl->qnt_mloss_oh >= 0)
        atm->q[ctl->qnt_mloss_oh][ip]
          += atm->q[ctl->qnt_m][ip] * (1 - aux);
      atm->q[ctl->qnt_m][ip] *= aux;
      if (ctl->qnt_loss_rate >= 0)
        atm->q[ctl->qnt_loss_rate][ip] += rate_coef;
    }
    if (ctl->qnt_vmr >= 0)
      atm->q[ctl->qnt_vmr][ip] *= aux;
  }
}
 
/*****************************************************************************/
 
void module_position(
  const cache_t *cache,
  met_t *met0,
  met_t *met1,
  atm_t *atm,
  const int reflect) {
 
  /* Set timer... */
  SELECT_TIMER("MODULE_POSITION", "PHYSICS");
 
  /* Loop over particles... */
  PARTICLE_LOOP(0, atm->np, 1, "acc data present(cache,met0,met1,atm)") {
 
    /* Init... */
    double ps;
    INTPOL_INIT;
 
    if (met0->coord_type == 0) {
      /* Calculate modulo... */
      atm->lon[ip] = FMOD(atm->lon[ip], 360.);
      atm->lat[ip] = FMOD(atm->lat[ip], 360.);
 
      /* Check latitude... */
      while (atm->lat[ip] < -90 || atm->lat[ip] > 90) {
        if (atm->lat[ip] > 90) {
          atm->lat[ip] = 180 - atm->lat[ip];
          atm->lon[ip] += 180;
        }
        if (atm->lat[ip] < -90) {
          atm->lat[ip] = -180 - atm->lat[ip];
          atm->lon[ip] += 180;
        }
      }
 
      /* Check longitude... */
      while (atm->lon[ip] < -180)
        atm->lon[ip] += 360;
      while (atm->lon[ip] >= 180)
        atm->lon[ip] -= 360;
    } else {
      intpol_check_cartesian(met0->lon, met0->nx, met0->lat, met0->ny,
                             atm->lon[ip], atm->lat[ip], &atm->lon[ip],
                             &atm->lat[ip]);
    }
 
    /* Check pressure... */
    const double ptop = met0->p[met0->np - 1];
    if (atm->p[ip] < ptop) {
      atm->p[ip] = reflect ? ptop * ptop / atm->p[ip] : ptop;
    } else if (atm->p[ip] > 300.) {
      INTPOL_2D(ps, 1);
      if (atm->p[ip] > ps)
        atm->p[ip] = reflect ? ps * ps / atm->p[ip] : ps;
    }
  }
}
 
/*****************************************************************************/
 
void module_radio_decay(
  const ctl_t *ctl,
  const cache_t *cache,
  atm_t *atm) {
 
  /* Set timer... */
  SELECT_TIMER("MODULE_RADIO_DECAY", "PHYSICS");
 
  /* Set decay constants of radioactive species [s^-1]... */
  const double lambda_rn222 = log(2.0) / RADIO_HALF_LIFE_RN222;
  const double lambda_pb210 = log(2.0) / RADIO_HALF_LIFE_PB210;
  const double lambda_be7 = log(2.0) / RADIO_HALF_LIFE_BE7;
  const double lambda_cs137 = log(2.0) / RADIO_HALF_LIFE_CS137;
  const double lambda_i131 = log(2.0) / RADIO_HALF_LIFE_I131;
  const double lambda_xe133 = log(2.0) / RADIO_HALF_LIFE_XE133;
 
  /* Loop over particles... */
  PARTICLE_LOOP(0, atm->np, 1, "acc data present(ctl,cache,atm)") {
 
    /* Set timestep... */
    const double dt = cache->dt[ip];
 
    /* Loss for Pb-210... */
    if (ctl->qnt_Apb210 >= 0)
      atm->q[ctl->qnt_Apb210][ip] *= exp(-dt * lambda_pb210);
 
    /* Loss for Rn-222... */
    if (ctl->qnt_Arn222 >= 0) {
      const double old = atm->q[ctl->qnt_Arn222][ip];
      const double aux = exp(-dt * lambda_rn222);
      const double lost = old * (1.0 - aux);
      atm->q[ctl->qnt_Arn222][ip] = old * aux;
 
      /* Parent-daughter process for Pb-210... */
      if (ctl->qnt_Apb210 >= 0)
        atm->q[ctl->qnt_Apb210][ip] += lost * lambda_pb210 / lambda_rn222;
    }
 
    /* Loss for Be-7... */
    if (ctl->qnt_Abe7 >= 0)
      atm->q[ctl->qnt_Abe7][ip] *= exp(-dt * lambda_be7);
 
    /* Loss for Cs-137... */
    if (ctl->qnt_Acs137 >= 0)
      atm->q[ctl->qnt_Acs137][ip] *= exp(-dt * lambda_cs137);
 
    /* Loss for I-131... */
    if (ctl->qnt_Ai131 >= 0)
      atm->q[ctl->qnt_Ai131][ip] *= exp(-dt * lambda_i131);
 
    /* Loss for Xe-133... */
    if (ctl->qnt_Axe133 >= 0)
      atm->q[ctl->qnt_Axe133][ip] *= exp(-dt * lambda_xe133);
  }
}
 
/*****************************************************************************/
 
void module_radio_depo(
  const ctl_t *ctl,
  const cache_t *cache,
  met_t *met0,
  met_t *met1,
  atm_t *atm,
  depo_t *depo) {
 
  /* Set timer... */
  SELECT_TIMER("MODULE_RADIO_DEPO", "PHYSICS");
 
  /* Decay constants of deposited radionuclides [s^-1]... */
  const double lambda_pb210 = log(2.0) / RADIO_HALF_LIFE_PB210;
  const double lambda_be7 = log(2.0) / RADIO_HALF_LIFE_BE7;
  const double lambda_cs137 = log(2.0) / RADIO_HALF_LIFE_CS137;
  const double lambda_i131 = log(2.0) / RADIO_HALF_LIFE_I131;
 
  /* Set horizontal grid increments... */
  const double dlon = (ctl->grid_lon1 - ctl->grid_lon0) / ctl->grid_nx;
  const double dlat = (ctl->grid_lat1 - ctl->grid_lat0) / ctl->grid_ny;
 
  /* Loop over particles... */
  PARTICLE_LOOP(0, atm->np, 1,
                "acc data present(ctl,cache,met0,met1,atm,depo)") {
 
    /* Deposition is only defined for forward integration... */
    const double dt = cache->dt[ip];
    if (dt <= 0)
      continue;
 
    /* Get surface pressure... */
    double ps;
    INTPOL_INIT;
    INTPOL_2D(ps, 1);
 
    /* Calculate dry deposition rate [s^-1]... */
    double dry_pb210 = 0, dry_be7 = 0, dry_cs137 = 0, dry_i131 = 0;
    if (atm->p[ip] >= ps - ctl->dry_depo_dp) {
      const double dz = 1000. * (Z(ps - ctl->dry_depo_dp) - Z(ps));
      if (dz > 0) {
        dry_pb210 = RADIO_DRY_VDEP_PB210 / dz;
        dry_be7 = RADIO_DRY_VDEP_BE7 / dz;
        dry_cs137 = RADIO_DRY_VDEP_CS137 / dz;
        dry_i131 = RADIO_DRY_VDEP_I131 / dz;
      }
    }
 
    /* Calculate wet deposition rate [s^-1]... */
    double wet_pb210 = 0, wet_be7 = 0, wet_cs137 = 0, wet_i131 = 0;
    double pct;
    INTPOL_2D(pct, 1);
    if (isfinite(pct) && atm->p[ip] > pct) {
      double cl;
      INTPOL_2D(cl, 0);
      if (cl > 0) {
        const double Is =
          pow(cl / ctl->wet_depo_pre[0], 1. / ctl->wet_depo_pre[1]);
        if (Is >= 0.01) {
          double lwc, rwc, iwc, swc, t;
          INTPOL_3D(lwc, 1);
          INTPOL_3D(rwc, 0);
          INTPOL_3D(iwc, 0);
          INTPOL_3D(swc, 0);
          INTPOL_3D(t, 0);
          const int inside = (lwc > 0 || rwc > 0 || iwc > 0 || swc > 0);
          double eta;
          if (inside) {
            if (t > WET_DEPO_T_LIQUID)
              eta = 1;
            else if (t <= WET_DEPO_T_ICE)
              eta = ctl->wet_depo_ic_ret_ratio;
            else
              eta = LIN(WET_DEPO_T_LIQUID, 1, WET_DEPO_T_ICE,
                        ctl->wet_depo_ic_ret_ratio, t);
          } else
            eta = (t > WET_DEPO_T_LIQUID_BC ? 1 : ctl->wet_depo_bc_ret_ratio);
          wet_pb210 = RADIO_WET_COEFF_PB210 * Is * eta;
          wet_be7 = RADIO_WET_COEFF_BE7 * Is * eta;
          wet_cs137 = RADIO_WET_COEFF_CS137 * Is * eta;
          wet_i131 = RADIO_WET_COEFF_I131 * Is * eta;
        }
      }
    }
 
    /* Get deposition grid index... */
    const int ingrid =
      (atm->lon[ip] >= ctl->grid_lon0
       && atm->lon[ip] < ctl->grid_lon1
       && atm->lat[ip] >= ctl->grid_lat0 && atm->lat[ip] < ctl->grid_lat1);
    const int ix = ingrid
      ? (int) ((atm->lon[ip] - ctl->grid_lon0) / dlon) : 0;
    const int iy = ingrid
      ? (int) ((atm->lat[ip] - ctl->grid_lat0) / dlat) : 0;
    const int idx = (ingrid ? ARRAY_2D(ix, iy, ctl->grid_ny) : 0);
    const double tref = atm->time[ip] - ctl->t_start;
 
    /* Deposit Pb-210... */
    if (ctl->qnt_Apb210 >= 0) {
      const double old = atm->q[ctl->qnt_Apb210][ip];
      const double aux = exp(-dt * (dry_pb210 + wet_pb210));
      const double lost = old * (1. - aux);
      const double deposited = lost
        * (ctl->radio_decay ? exp(lambda_pb210 * tref) : 1.0);
      atm->q[ctl->qnt_Apb210][ip] = old * aux;
      if (ingrid && lost > 0) {
#ifdef _OPENACC
#pragma acc atomic update
#else
#pragma omp atomic update
#endif
        depo->Apb210[idx] += deposited;
      }
    }
 
    /* Deposit Be-7... */
    if (ctl->qnt_Abe7 >= 0) {
      const double old = atm->q[ctl->qnt_Abe7][ip];
      const double aux = exp(-dt * (dry_be7 + wet_be7));
      const double lost = old * (1. - aux);
      const double deposited = lost
        * (ctl->radio_decay ? exp(lambda_be7 * tref) : 1.0);
      atm->q[ctl->qnt_Abe7][ip] = old * aux;
      if (ingrid && lost > 0) {
#ifdef _OPENACC
#pragma acc atomic update
#else
#pragma omp atomic update
#endif
        depo->Abe7[idx] += deposited;
      }
    }
 
    /* Deposit Cs-137... */
    if (ctl->qnt_Acs137 >= 0) {
      const double old = atm->q[ctl->qnt_Acs137][ip];
      const double aux = exp(-dt * (dry_cs137 + wet_cs137));
      const double lost = old * (1. - aux);
      const double deposited = lost
        * (ctl->radio_decay ? exp(lambda_cs137 * tref) : 1.0);
      atm->q[ctl->qnt_Acs137][ip] = old * aux;
      if (ingrid && lost > 0) {
#ifdef _OPENACC
#pragma acc atomic update
#else
#pragma omp atomic update
#endif
        depo->Acs137[idx] += deposited;
      }
    }
 
    /* Deposit aerosol-bound I-131... */
    if (ctl->qnt_Ai131 >= 0) {
      const double old = atm->q[ctl->qnt_Ai131][ip];
      const double aux = exp(-dt * (dry_i131 + wet_i131));
      const double lost = old * (1. - aux);
      const double deposited = lost
        * (ctl->radio_decay ? exp(lambda_i131 * tref) : 1.0);
      atm->q[ctl->qnt_Ai131][ip] = old * aux;
      if (ingrid && lost > 0) {
#ifdef _OPENACC
#pragma acc atomic update
#else
#pragma omp atomic update
#endif
        depo->Ai131[idx] += deposited;
      }
    }
  }
}
 
/*****************************************************************************/
 
void module_rng_init(
  const int ntask) {
 
  /* Initialize GSL random number generators... */
  gsl_rng_env_setup();
  if (omp_get_max_threads() > NTHREADS)
    ERRMSG("Too many threads!");
  for (int i = 0; i < NTHREADS; i++) {
    rng[i] = gsl_rng_alloc(gsl_rng_default);
    gsl_rng_set(rng[i], gsl_rng_default_seed
                + (long unsigned) (ntask * NTHREADS + i));
  }
 
  /* Initialize cuRAND random number generators... */
#ifdef CURAND
  if (curandCreateGenerator(&rng_curand, CURAND_RNG_PSEUDO_DEFAULT) !=
      CURAND_STATUS_SUCCESS)
    ERRMSG("Cannot create random number generator!");
  if (curandSetPseudoRandomGeneratorSeed(rng_curand, ntask) !=
      CURAND_STATUS_SUCCESS)
    ERRMSG("Cannot set seed for random number generator!");
  if (curandSetStream
      (rng_curand,
       (cudaStream_t) acc_get_cuda_stream(acc_async_sync)) !=
      CURAND_STATUS_SUCCESS)
    ERRMSG("Cannot set stream for random number generator!");
#endif
}
 
/*****************************************************************************/
 
void module_rng(
  const ctl_t *ctl,
  double *rs,
  const size_t n,
  const int method) {
 
  /* Use GSL random number generators... */
  if (ctl->rng_type == 0) {
 
    /* Uniform distribution... */
    if (method == 0) {
#pragma omp parallel for default(shared)
      for (size_t i = 0; i < n; ++i)
        rs[i] = gsl_rng_uniform(rng[omp_get_thread_num()]);
    }
 
    /* Normal distribution... */
    else if (method == 1) {
#pragma omp parallel for default(shared)
      for (size_t i = 0; i < n; ++i)
        rs[i] = gsl_ran_gaussian_ziggurat(rng[omp_get_thread_num()], 1.0);
    }
 
    /* Update of random numbers on device... */
#ifdef _OPENACC
    SELECT_TIMER("UPDATE_DEVICE", "MEMORY");
#pragma acc update device(rs[:n])
#endif
  }
 
  /* Use Squares random number generator (Widynski, 2022)... */
  else if (ctl->rng_type == 1) {
 
    /* Set key (don't change this!)... */
    const uint64_t key = 0xc8e4fd154ce32f6d;
 
    /* Uniform distribution... */
#ifdef _OPENACC
#pragma acc data present(rs)
#pragma acc parallel loop independent gang vector
#else
#pragma omp parallel for default(shared)
#endif
    for (size_t i = 0; i < n + 1; ++i) {
      uint64_t r, t, x, y, z;
      y = x = (rng_ctr + i) * key;
      z = y + key;
      x = x * x + y;
      x = (x >> 32) | (x << 32);
      x = x * x + z;
      x = (x >> 32) | (x << 32);
      x = x * x + y;
      x = (x >> 32) | (x << 32);
      t = x = x * x + z;
      x = (x >> 32) | (x << 32);
      r = t ^ ((x * x + y) >> 32);
      rs[i] = (double) r / (double) UINT64_MAX;
    }
    rng_ctr += n + 1;
 
    /* Normal distribution... */
    if (method == 1) {
#ifdef _OPENACC
#pragma acc parallel loop independent gang vector
#else
#pragma omp parallel for default(shared)
#endif
      for (size_t i = 0; i < n; i += 2) {
        const double r = sqrt(-2.0 * log(rs[i]));
        const double phi = 2.0 * M_PI * rs[i + 1];
        rs[i] = r * cosf((float) phi);
        rs[i + 1] = r * sinf((float) phi);
      }
    }
  }
 
  /* Use cuRAND random number generators... */
  else if (ctl->rng_type == 2) {
#ifdef CURAND
#pragma acc host_data use_device(rs)
    {
 
      /* Uniform distribution... */
      if (method == 0) {
        if (curandGenerateUniformDouble(rng_curand, rs, (n < 4 ? 4 : n)) !=
            CURAND_STATUS_SUCCESS)
          ERRMSG("Cannot create random numbers!");
      }
 
      /* Normal distribution... */
      else if (method == 1) {
        if (curandGenerateNormalDouble
            (rng_curand, rs, (n < 4 ? 4 : n), 0.0,
             1.0) != CURAND_STATUS_SUCCESS)
          ERRMSG("Cannot create random numbers!");
      }
    }
#else
    ERRMSG("MPTRAC was compiled without cuRAND!");
#endif
  }
}
 
/*****************************************************************************/
 
void module_sedi(
  const ctl_t *ctl,
  const cache_t *cache,
  met_t *met0,
  met_t *met1,
  atm_t *atm) {
 
  /* Set timer... */
  SELECT_TIMER("MODULE_SEDI", "PHYSICS")
    /* Loop over particles... */
    PARTICLE_LOOP(0, atm->np, 1, "acc data present(ctl,cache,met0,met1,atm)") {
 
    /* Get temperature... */
    double t;
    INTPOL_INIT;
    INTPOL_3D(t, 1);
 
    /* Sedimentation velocity... */
    const double v_s = sedi(atm->p[ip], t, atm->q[ctl->qnt_rp][ip],
                            atm->q[ctl->qnt_rhop][ip]);
 
    /* Calculate pressure change... */
    atm->p[ip] += DZ2DP(v_s * cache->dt[ip] / 1000., atm->p[ip]);
  }
}
 
/*****************************************************************************/
 
void module_sort(
  const ctl_t *ctl,
  const met_t *met0,
  cache_t *cache,
  atm_t *atm) {
 
  /* Set timer... */
  SELECT_TIMER("MODULE_SORT", "PHYSICS");
 
  /* Allocate... */
  const int np = atm->np;
  double *restrict const a = (double *) malloc((size_t) np * sizeof(double));
  int *restrict const p = (int *) malloc((size_t) np * sizeof(int));
  if (a == NULL || p == NULL)
    ERRMSG("Out of memory!");
 
#ifdef _OPENACC
#pragma acc enter data create(a[0:np],p[0:np])
#pragma acc data present(ctl,met0,cache,atm,a,p)
#endif
 
  /* Get box index... */
#ifdef _OPENACC
#pragma acc parallel loop independent gang vector
#else
#pragma omp parallel for default(shared)
#endif
  for (int ip = 0; ip < np; ip++) {
    a[ip] =
      (double) ((locate_reg(met0->lon, met0->nx, atm->lon[ip]) * met0->ny +
                 locate_irr(met0->lat, met0->ny, atm->lat[ip]))
                * met0->np + locate_irr(met0->p, met0->np, atm->p[ip]));
    p[ip] = ip;
  }
 
  /* Sorting... */
#ifdef THRUST
#ifdef _OPENACC
#pragma acc host_data use_device(a,p)
#endif
  thrustSortWrapper(a, np, p);
#else
  size_t *perm_sz = (size_t *) malloc((size_t) np * sizeof(size_t));
  if (perm_sz == NULL)
    ERRMSG("Out of memory!");
#ifdef _OPENACC
#pragma acc update self(a[0:np])
#endif
  gsl_sort_index(perm_sz, a, 1, (size_t) np);
  for (int ip = 0; ip < np; ++ip)
    p[ip] = (int) perm_sz[ip];
  free(perm_sz);
#ifdef _OPENACC
#pragma acc update device(p[0:np])
#endif
#endif
 
  /* Sort data... */
  sort_array(atm->time, p, a, np);
  sort_array(atm->p, p, a, np);
  sort_array(atm->lon, p, a, np);
  sort_array(atm->lat, p, a, np);
  for (int iq = 0; iq < ctl->nq; iq++)
    sort_array(atm->q[iq], p, a, np);
  sort_array(cache->dt, p, a, np);
  sort_uvwp(cache, p, a, np);
 
  /* Free... */
#ifdef _OPENACC
#pragma acc exit data delete(a,p)
#endif
  free(a);
  free(p);
}
 
/*****************************************************************************/
 
void module_timesteps(
  const ctl_t *ctl,
  cache_t *cache,
  const met_t *met0,
  atm_t *atm,
  const double t) {
 
  /* Set timer... */
  SELECT_TIMER("MODULE_TIMESTEPS", "PHYSICS");
 
  const double latmin = gsl_stats_min(met0->lat, 1, (size_t) met0->ny),
    latmax = gsl_stats_max(met0->lat, 1, (size_t) met0->ny);
 
  const int local =
    (fabs(met0->lon[met0->nx - 1] - met0->lon[0] - 360.0) >= 0.01);
 
  /* Loop over particles... */
  PARTICLE_LOOP(0, atm->np, 0, "acc data present(ctl,cache,met0,atm)") {
 
    /* Set time step for each air parcel... */
    if ((ctl->direction * (atm->time[ip] - ctl->t_start) >= 0
         && ctl->direction * (atm->time[ip] - ctl->t_stop) <= 0
         && ctl->direction * (atm->time[ip] - t) < 0))
      cache->dt[ip] = t - atm->time[ip];
    else
      cache->dt[ip] = 0.0;
 
    /* Check horizontal boundaries of local meteo data... */
#ifdef DD
    /* With domain decomposition, the subdomain rather than the meteo grid
       defines the boundaries of a trajectory... */
    int dd = (ctl->dd) ? 0 : 1;
#else
    int dd = 1;
#endif
    if (dd) {
      if (local && (atm->lon[ip] <= met0->lon[0]
                    || atm->lon[ip] >= met0->lon[met0->nx - 1]
                    || atm->lat[ip] <= latmin || atm->lat[ip] >= latmax))
        cache->dt[ip] = 0.0;
    } else {
      if ((int) atm->q[ctl->qnt_current_subdomain][ip] == -1)
        cache->dt[ip] = 0;
    }
  }
}
 
/*****************************************************************************/
 
void module_timesteps_init(
  ctl_t *ctl,
  const atm_t *atm) {
 
  /* Set timer... */
  SELECT_TIMER("MODULE_TIMESTEPS_INIT", "PHYSICS");
 
  /* Set start time... */
  if (ctl->direction == 1) {
    ctl->t_start = gsl_stats_min(atm->time, 1, (size_t) atm->np);
    if (ctl->t_stop > 1e99)
      ctl->t_stop = gsl_stats_max(atm->time, 1, (size_t) atm->np);
  } else {
    ctl->t_start = gsl_stats_max(atm->time, 1, (size_t) atm->np);
    if (ctl->t_stop > 1e99)
      ctl->t_stop = gsl_stats_min(atm->time, 1, (size_t) atm->np);
  }
 
  /* Check time interval... */
  if (ctl->direction * (ctl->t_stop - ctl->t_start) <= 0)
    ERRMSG("Nothing to do! Check T_STOP and DIRECTION!");
 
  /* Round start time... */
  if (ctl->direction == 1)
    ctl->t_start = floor(ctl->t_start / ctl->dt_mod) * ctl->dt_mod;
  else
    ctl->t_start = ceil(ctl->t_start / ctl->dt_mod) * ctl->dt_mod;
}
 
/*****************************************************************************/
 
void module_tracer_chem(
  const ctl_t *ctl,
  const cache_t *cache,
  const clim_t *clim,
  met_t *met0,
  met_t *met1,
  atm_t *atm) {
 
  if (ctl->met_coord_type != 0)
    ERRMSG("Only lat/lon grid supported");
 
  /* Set timer... */
  SELECT_TIMER("MODULE_TRACER_CHEM", "PHYSICS");
 
  /* Loop over particles... */
  PARTICLE_LOOP(0, atm->np, 1,
                "acc data present(ctl,cache,clim,met0,met1,atm)") {
 
    /* Get temperature... */
    double t;
    INTPOL_INIT;
    INTPOL_3D(t, 1);
 
    /* Get molecular density... */
    const double M = MOLEC_DENS(atm->p[ip], t);
 
    /* Get total column ozone... */
    double o3c;
    INTPOL_2D(o3c, 1);
 
    /* Get solar zenith angle... */
    const double sza =
      acos(cos_sza(atm->time[ip], atm->lon[ip], atm->lat[ip]));
 
    /* Get O(1D) volume mixing ratio... */
    const double o1d =
      clim_zm(&clim->o1d, atm->time[ip], atm->lat[ip], atm->p[ip]);
 
    /* Reactions for CFC-10... */
    if (ctl->qnt_Cccl4 >= 0) {
      const double K_o1d =
        ARRHENIUS(O1D_RATE_CCL4_A, O1D_RATE_CCL4_B, t) * o1d * M;
      const double K_hv = clim_photo(clim->photo.ccl4, &(clim->photo),
                                     atm->p[ip], sza, o3c);
      atm->q[ctl->qnt_Cccl4][ip] *= exp(-cache->dt[ip] * (K_hv + K_o1d));
    }
 
    /* Reactions for CFC-11... */
    if (ctl->qnt_Cccl3f >= 0) {
      const double K_o1d =
        ARRHENIUS(O1D_RATE_CFC11_A, O1D_RATE_CFC11_B, t) * o1d * M;
      const double K_hv = clim_photo(clim->photo.ccl3f, &(clim->photo),
                                     atm->p[ip], sza, o3c);
      atm->q[ctl->qnt_Cccl3f][ip] *= exp(-cache->dt[ip] * (K_hv + K_o1d));
    }
 
    /* Reactions for CFC-12... */
    if (ctl->qnt_Cccl2f2 >= 0) {
      const double K_o1d =
        ARRHENIUS(O1D_RATE_CFC12_A, O1D_RATE_CFC12_B, t) * o1d * M;
      const double K_hv = clim_photo(clim->photo.ccl2f2, &(clim->photo),
                                     atm->p[ip], sza, o3c);
      atm->q[ctl->qnt_Cccl2f2][ip] *= exp(-cache->dt[ip] * (K_hv + K_o1d));
    }
 
    /* Reactions for N2O... */
    if (ctl->qnt_Cn2o >= 0) {
      const double K_o1d =
        ARRHENIUS(O1D_RATE_N2O_A, O1D_RATE_N2O_B, t) * o1d * M;
      const double K_hv = clim_photo(clim->photo.n2o, &(clim->photo),
                                     atm->p[ip], sza, o3c);
      atm->q[ctl->qnt_Cn2o][ip] *= exp(-cache->dt[ip] * (K_hv + K_o1d));
    }
  }
}
 
/*****************************************************************************/
 
void module_wet_depo(
  const ctl_t *ctl,
  const cache_t *cache,
  met_t *met0,
  met_t *met1,
  atm_t *atm) {
 
  /* Set timer... */
  SELECT_TIMER("MODULE_WET_DEPO", "PHYSICS");
 
  /* Check quantity flags... */
  if (ctl->qnt_m < 0 && ctl->qnt_vmr < 0)
    ERRMSG("Module needs quantity mass or volume mixing ratio!");
 
  /* Loop over particles... */
  PARTICLE_LOOP(0, atm->np, 1, "acc data present(ctl,cache,met0,met1,atm)") {
 
    /* Check whether particle is below cloud top... */
    double pct;
    INTPOL_INIT;
    INTPOL_2D(pct, 1);
    if (!isfinite(pct) || atm->p[ip] <= pct)
      continue;
 
    /* Get cloud bottom pressure... */
    double pcb;
    INTPOL_2D(pcb, 0);
 
    /* Estimate precipitation rate (Pisso et al., 2019)... */
    double cl;
    INTPOL_2D(cl, 0);
    const double Is =
      pow(1. / ctl->wet_depo_pre[0] * cl, 1. / ctl->wet_depo_pre[1]);
    if (Is < 0.01)
      continue;
 
    /* Check whether particle is inside or below cloud... */
    double lwc, rwc, iwc, swc;
    INTPOL_3D(lwc, 1);
    INTPOL_3D(rwc, 0);
    INTPOL_3D(iwc, 0);
    INTPOL_3D(swc, 0);
    const int inside = (lwc > 0 || rwc > 0 || iwc > 0 || swc > 0);
 
    /* Get temperature... */
    double t;
    INTPOL_3D(t, 0);
 
    /* Calculate in-cloud scavenging coefficient... */
    double lambda = 0;
    if (inside) {
 
      /* Calculate retention factor... */
      double eta;
      if (t > WET_DEPO_T_LIQUID)
        eta = 1;
      else if (t <= WET_DEPO_T_ICE)
        eta = ctl->wet_depo_ic_ret_ratio;
      else
        eta =
          LIN(WET_DEPO_T_LIQUID, 1, WET_DEPO_T_ICE,
              ctl->wet_depo_ic_ret_ratio, t);
 
      /* Use exponential dependency for particles (Bakels et al., 2024)... */
      if (ctl->wet_depo_ic_a > 0)
        lambda = ctl->wet_depo_ic_a * pow(Is, ctl->wet_depo_ic_b) * eta;
 
      /* Use Henry's law for gases... */
      else if (ctl->wet_depo_ic_h[0] > 0) {
 
        /* Get Henry's constant (Burkholder et al., 2019; Sander, 2023)... */
        double h = ctl->wet_depo_ic_h[0]
          * exp(ctl->wet_depo_ic_h[1] * (1. / t - 1. / CHEM_REF_TEMP));
 
        /* Use effective Henry's constant for SO2
           (Berglen, 2004; Simpson, 2012)... */
        if (ctl->wet_depo_so2_ph > 0) {
          const double H_ion = pow(10., -ctl->wet_depo_so2_ph);
          const double K_1 = SO2_DISS_K1_REF
            * exp(SO2_DISS_K1_TEMP * (1. / t - 1. / CHEM_REF_TEMP));
          const double K_2 = SO2_DISS_K2_REF
            * exp(SO2_DISS_K2_TEMP * (1. / t - 1. / CHEM_REF_TEMP));
          h *= (1. + K_1 / H_ion + K_1 * K_2 / SQR(H_ion));
        }
 
        /* Estimate depth of cloud layer... */
        const double dz = 1e3 * (Z(pct) - Z(pcb));
 
        /* Calculate scavenging coefficient... */
        lambda = h * RI * t * Is / 3.6e6 / dz * eta;
      }
    }
 
    /* Calculate below-cloud scavenging coefficient... */
    else {
 
      /* Calculate retention factor... */
      double eta;
      if (t > WET_DEPO_T_LIQUID_BC)
        eta = 1;
      else
        eta = ctl->wet_depo_bc_ret_ratio;
 
      /* Use exponential dependency for particles (Bakels et al., 2024)... */
      if (ctl->wet_depo_bc_a > 0)
        lambda = ctl->wet_depo_bc_a * pow(Is, ctl->wet_depo_bc_b) * eta;
 
      /* Use Henry's law for gases... */
      else if (ctl->wet_depo_bc_h[0] > 0) {
 
        /* Get Henry's constant (Burkholder et al., 2019; Sander, 2023)... */
        const double h = ctl->wet_depo_bc_h[0]
          * exp(ctl->wet_depo_bc_h[1] * (1. / t - 1. / CHEM_REF_TEMP));
 
        /* Estimate depth of cloud layer... */
        const double dz = 1e3 * (Z(pct) - Z(pcb));
 
        /* Calculate scavenging coefficient... */
        lambda = h * RI * t * Is / 3.6e6 / dz * eta;
      }
    }
 
    /* Calculate exponential decay of mass... */
    const double aux = exp(-cache->dt[ip] * lambda);
    if (ctl->qnt_m >= 0) {
      if (ctl->qnt_mloss_wet >= 0)
        atm->q[ctl->qnt_mloss_wet][ip]
          += atm->q[ctl->qnt_m][ip] * (1 - aux);
      atm->q[ctl->qnt_m][ip] *= aux;
      if (ctl->qnt_loss_rate >= 0)
        atm->q[ctl->qnt_loss_rate][ip] += lambda;
    }
    if (ctl->qnt_vmr >= 0)
      atm->q[ctl->qnt_vmr][ip] *= aux;
  }
}
 
/*****************************************************************************/
 
void mptrac_alloc(
  ctl_t **ctl,
  cache_t **cache,
  clim_t **clim,
  met_t **met0,
  met_t **met1,
  atm_t **atm,
  depo_t **depo,
  dd_t **dd) {
 
  /* Initialize GPU... */
#ifdef _OPENACC
  if (ctl != NULL || cache != NULL || clim != NULL || met0 != NULL
      || met1 != NULL || atm != NULL || depo != NULL || dd != NULL) {
    SELECT_TIMER("ACC_INIT", "INIT");
    if (acc_get_num_devices(acc_device_nvidia) <= 0)
      ERRMSG("Not running on a GPU device!");
    acc_device_t device_type = acc_get_device_type();
    acc_init(device_type);
  }
#endif
 
  /* Allocate... */
  SELECT_TIMER("ALLOC", "MEMORY");
  if (ctl != NULL)
    ALLOC(*ctl, ctl_t, 1);
  if (cache != NULL)
    ALLOC(*cache, cache_t, 1);
  if (clim != NULL)
    ALLOC(*clim, clim_t, 1);
  if (met0 != NULL)
    ALLOC(*met0, met_t, 1);
  if (met1 != NULL)
    ALLOC(*met1, met_t, 1);
  if (atm != NULL)
    ALLOC(*atm, atm_t, 1);
  if (depo != NULL)
    ALLOC(*depo, depo_t, 1);
  if (dd != NULL) {
    ALLOC(*dd, dd_t, 1);
 
    /* Initialize the MPI datatype such that mptrac_free() knows whether
       dd_init() has created it... */
#ifdef DD
    (*dd)->MPI_Particle = MPI_DATATYPE_NULL;
#endif
  }
 
  /* Create data region on GPU... */
#ifdef _OPENACC
  SELECT_TIMER("CREATE_DATA_REGION", "MEMORY");
  if (ctl != NULL) {
    ctl_t *ctlup = *ctl;
#pragma acc enter data create(ctlup[:1])
  }
  if (cache != NULL) {
    cache_t *cacheup = *cache;
#pragma acc enter data create(cacheup[:1])
  }
  if (clim != NULL) {
    clim_t *climup = *clim;
#pragma acc enter data create(climup[:1])
  }
  if (met0 != NULL) {
    met_t *met0up = *met0;
#pragma acc enter data create(met0up[:1])
  }
  if (met1 != NULL) {
    met_t *met1up = *met1;
#pragma acc enter data create(met1up[:1])
  }
  if (atm != NULL) {
    atm_t *atmup = *atm;
#pragma acc enter data create(atmup[:1])
  }
  if (depo != NULL) {
    depo_t *depoup = *depo;
#pragma acc enter data create(depoup[:1])
  }
#ifdef DD
  if (dd != NULL) {
    dd_t *ddup = *dd;
#pragma acc enter data create(ddup[:1])
  }
#endif
#endif
}
 
/*****************************************************************************/
 
void mptrac_free(
  ctl_t *ctl,
  cache_t *cache,
  clim_t *clim,
  met_t *met0,
  met_t *met1,
  atm_t *atm,
  depo_t *depo,
  dd_t *dd) {
 
#ifdef DD
#if LOGLEV >= 2
  if (dd_node != NULL) {
    int rank;
    MPI_Comm_rank(MPI_COMM_WORLD, &rank);
    LOG(2, "DD_COMM rank=%d sent=%llu intra=%llu inter=%llu "
        "intra_bytes=%llu inter_bytes=%llu particle_bytes=%d",
        rank, dd_sent, dd_intra, dd_inter,
        dd_intra * (unsigned long long) dd_particle_bytes,
        dd_inter * (unsigned long long) dd_particle_bytes,
        dd_particle_bytes);
    free(dd_node);
    dd_node = NULL;
  }
#endif
#endif
 
  /* Delete data region on GPU... */
#ifdef _OPENACC
  SELECT_TIMER("DELETE_DATA_REGION", "MEMORY");
  if (ctl != NULL) {
#pragma acc exit data delete(ctl[:1])
  }
  if (cache != NULL) {
#pragma acc exit data delete(cache[:1])
  }
  if (clim != NULL) {
#pragma acc exit data delete(clim[:1])
  }
  if (met0 != NULL) {
#pragma acc exit data delete(met0[:1])
  }
  if (met1 != NULL) {
#pragma acc exit data delete(met1[:1])
  }
  if (atm != NULL) {
#pragma acc exit data delete(atm[:1])
  }
  if (depo != NULL) {
#pragma acc exit data delete(depo[:1])
  }
#ifdef DD
  if (dd != NULL) {
#pragma acc exit data delete(dd[:1])
  }
#endif
#endif
 
  /* Free... */
  SELECT_TIMER("FREE", "MEMORY");
  free(atm);
  free(depo);
  free(ctl);
  free(cache);
  free(clim);
  free(met0);
  free(met1);
 
  /* Free MPI datatype... */
#ifdef DD
  if (dd != NULL && dd->MPI_Particle != MPI_DATATYPE_NULL)
    MPI_Type_free(&dd->MPI_Particle);
#endif
  free(dd);
}
 
/*****************************************************************************/
 
void mptrac_get_met(
  ctl_t *ctl,
  clim_t *clim,
  const double t,
  met_t **met0,
  met_t **met1,
  dd_t *dd) {
 
  static int init;
 
  met_t *mets;
 
  char cachefile[LEN], cmd[2 * LEN], filename[LEN];
 
  /* Set timer... */
  SELECT_TIMER("GET_MET", "INPUT");
 
  /* Init... */
  if (t == ctl->t_start || !init) {
    init = 1;
 
    /* Read meteo data... */
    get_met_filename(ctl, t + (ctl->direction == -1 ? -1 : 0), -1,
                     ctl->metbase, ctl->dt_met, filename);
    if (!mptrac_read_met(filename, ctl, clim, *met0, dd))
      ERRMSG("Cannot open file!");
 
    get_met_filename(ctl, t + (ctl->direction == 1 ? 1 : 0), 1,
                     ctl->metbase, ctl->dt_met, filename);
    if (!mptrac_read_met(filename, ctl, clim, *met1, dd))
      ERRMSG("Cannot open file!");
 
    /* Update GPU... */
    mptrac_update_device(NULL, NULL, NULL, met0, met1, NULL);
    SELECT_TIMER("GET_MET", "INPUT");
 
    /* Caching... */
    if (ctl->met_cache && t != ctl->t_stop) {
      get_met_filename(ctl, t + 1.1 * ctl->dt_met * ctl->direction,
                       ctl->direction, ctl->metbase, ctl->dt_met, cachefile);
      sprintf(cmd, "cat %s > /dev/null &", cachefile);
      LOG(1, "Caching: %s", cachefile);
      if (system(cmd) != 0)
        WARN("Caching command failed!");
    }
  }
 
  /* Read new data for forward trajectories... */
  if (t > (*met1)->time) {
 
    /* Pointer swap... */
    mets = *met1;
    *met1 = *met0;
    *met0 = mets;
 
    /* Read new meteo data... */
    get_met_filename(ctl, t, 1, ctl->metbase, ctl->dt_met, filename);
    if (!mptrac_read_met(filename, ctl, clim, *met1, dd))
      ERRMSG("Cannot open file!");
 
    /* Update GPU... */
    mptrac_update_device(NULL, NULL, NULL, NULL, met1, NULL);
    SELECT_TIMER("GET_MET", "INPUT");
 
    /* Caching... */
    if (ctl->met_cache && t != ctl->t_stop) {
      get_met_filename(ctl, t + ctl->dt_met, 1, ctl->metbase, ctl->dt_met,
                       cachefile);
      sprintf(cmd, "cat %s > /dev/null &", cachefile);
      LOG(1, "Caching: %s", cachefile);
      if (system(cmd) != 0)
        WARN("Caching command failed!");
    }
  }
 
  /* Read new data for backward trajectories... */
  if (t < (*met0)->time) {
 
    /* Pointer swap... */
    mets = *met1;
    *met1 = *met0;
    *met0 = mets;
 
    /* Read new meteo data... */
    get_met_filename(ctl, t, -1, ctl->metbase, ctl->dt_met, filename);
    if (!mptrac_read_met(filename, ctl, clim, *met0, dd))
      ERRMSG("Cannot open file!");
 
    /* Update GPU... */
    mptrac_update_device(NULL, NULL, NULL, met0, NULL, NULL);
    SELECT_TIMER("GET_MET", "INPUT");
 
    /* Caching... */
    if (ctl->met_cache && t != ctl->t_stop) {
      get_met_filename(ctl, t - ctl->dt_met, -1, ctl->metbase, ctl->dt_met,
                       cachefile);
      sprintf(cmd, "cat %s > /dev/null &", cachefile);
      LOG(1, "Caching: %s", cachefile);
      if (system(cmd) != 0)
        WARN("Caching command failed!");
    }
  }
 
  if ((*met0)->coord_type != (*met1)->coord_type)
    ERRMSG("Coordinate types do not match!");
 
  /* Check that grids are consistent... */
  if ((*met0)->nx != 0 && (*met1)->nx != 0) {
    if ((*met0)->nx != (*met1)->nx
        || (*met0)->ny != (*met1)->ny || (*met0)->np != (*met1)->np)
      ERRMSG("Meteo grid dimensions do not match!");
    for (int ix = 0; ix < (*met0)->nx; ix++)
      if (fabs((*met0)->lon[ix] - (*met1)->lon[ix]) > 0.001)
        ERRMSG("Meteo grid longitudes do not match!");
    for (int iy = 0; iy < (*met0)->ny; iy++)
      if (fabs((*met0)->lat[iy] - (*met1)->lat[iy]) > 0.001)
        ERRMSG("Meteo grid latitudes do not match!");
    for (int ip = 0; ip < (*met0)->np; ip++)
      if (fabs((*met0)->p[ip] - (*met1)->p[ip]) > 0.001)
        ERRMSG("Meteo grid pressure levels do not match!");
  }
}
 
/*****************************************************************************/
 
void mptrac_init(
  ctl_t *ctl,
  cache_t *cache,
  clim_t *clim,
  atm_t *atm,
  depo_t *depo,
  const int ntask) {
 
  /* Initialize timesteps... */
  module_timesteps_init(ctl, atm);
 
  /* Initialize random number generator... */
  module_rng_init(ntask);
 
  /* Update GPU memory... */
  mptrac_update_device(ctl, cache, clim, NULL, NULL, atm);
#ifdef _OPENACC
#pragma acc update device(depo[:1])
#else
  (void) depo;
#endif
}
 
/*****************************************************************************/
 
int mptrac_read_atm(
  const char *filename,
  const ctl_t *ctl,
  atm_t *atm) {
 
  int result;
 
  /* Set timer... */
  SELECT_TIMER("READ_ATM", "INPUT");
 
  /* Init... */
  atm->np = 0;
 
  /* Write info... */
  LOG(1, "Read atmospheric data: %s", filename);
 
  /* Read ASCII data... */
  if (ctl->atm_type == 0)
    result = read_atm_asc(filename, ctl, atm);
 
  /* Read binary data... */
  else if (ctl->atm_type == 1)
    result = read_atm_bin(filename, ctl, atm);
 
  /* Read netCDF data... */
  else if (ctl->atm_type == 2)
    result = read_atm_nc(filename, ctl, atm);
 
  /* Read CLaMS data... */
  else if (ctl->atm_type == 3 || ctl->atm_type == 4)
    result = read_atm_clams(filename, ctl, atm);
 
  /* Error... */
  else
    ERRMSG("Atmospheric data type not supported!");
 
  /* Check result... */
  if (result != 1)
    return 0;
 
  /* Check number of air parcels... */
  if (atm->np < 1)
    ERRMSG("Can not read any data!");
 
  /* Write info... */
  double mini, maxi;
  LOG(2, "Number of particles: %d", atm->np);
  gsl_stats_minmax(&mini, &maxi, atm->time, 1, (size_t) atm->np);
  LOG(2, "Time range: %.2f ... %.2f s", mini, maxi);
  gsl_stats_minmax(&mini, &maxi, atm->p, 1, (size_t) atm->np);
  LOG(2, "Altitude range: %g ... %g km", Z(maxi), Z(mini));
  LOG(2, "Pressure range: %g ... %g hPa", maxi, mini);
  gsl_stats_minmax(&mini, &maxi, atm->lon, 1, (size_t) atm->np);
  LOG(2, "%s range: %g ... %g %s",
      ctl->met_coord_type == 0 ? "Longitude" : "X coordinate", mini, maxi,
      ctl->met_coord_type == 0 ? "deg" : "m");
  gsl_stats_minmax(&mini, &maxi, atm->lat, 1, (size_t) atm->np);
  LOG(2, "%s range: %g ... %g %s",
      ctl->met_coord_type == 0 ? "Latitude" : "Y coordinate", mini, maxi,
      ctl->met_coord_type == 0 ? "deg" : "m");
  for (int iq = 0; iq < ctl->nq; iq++) {
    char msg[5 * LEN];
    sprintf(msg, "Quantity %s range: %s ... %s %s",
            ctl->qnt_name[iq], ctl->qnt_format[iq],
            ctl->qnt_format[iq], ctl->qnt_unit[iq]);
    gsl_stats_minmax(&mini, &maxi, atm->q[iq], 1, (size_t) atm->np);
    LOG(2, msg, mini, maxi);
  }
 
  /* Return success... */
  return 1;
}
 
/*****************************************************************************/
 
void mptrac_read_clim(
  const ctl_t *ctl,
  clim_t *clim) {
 
  /* Set timer... */
  SELECT_TIMER("READ_CLIM", "INPUT");
 
  /* Init tropopause climatology... */
  clim_tropo_init(clim);
 
  /* Read photolysis rates... */
  if (ctl->clim_photo[0] != '-')
    read_clim_photo(ctl->clim_photo, &clim->photo);
 
  /* Read HNO3 climatology... */
  if (ctl->clim_hno3_filename[0] != '-')
    read_clim_zm(ctl->clim_hno3_filename, "HNO3", &clim->hno3);
 
  /* Read OH climatology... */
  if (ctl->clim_oh_filename[0] != '-') {
    read_clim_zm(ctl->clim_oh_filename, "OH", &clim->oh);
    if (ctl->oh_chem_beta > 0)
      clim_oh_diurnal_correction(ctl, clim);
  }
 
  /* Read H2O2 climatology... */
  if (ctl->clim_h2o2_filename[0] != '-')
    read_clim_zm(ctl->clim_h2o2_filename, "H2O2", &clim->h2o2);
 
  /* Read HO2 climatology... */
  if (ctl->clim_ho2_filename[0] != '-')
    read_clim_zm(ctl->clim_ho2_filename, "HO2", &clim->ho2);
 
  /* Read O(1D) climatology... */
  if (ctl->clim_o1d_filename[0] != '-')
    read_clim_zm(ctl->clim_o1d_filename, "O1D", &clim->o1d);
 
  /* Read CFC-10 time series... */
  if (ctl->clim_ccl4_timeseries[0] != '-')
    read_clim_ts(ctl->clim_ccl4_timeseries, &clim->ccl4);
 
  /* Read CFC-11 time series... */
  if (ctl->clim_ccl3f_timeseries[0] != '-')
    read_clim_ts(ctl->clim_ccl3f_timeseries, &clim->ccl3f);
 
  /* Read CFC-12 time series... */
  if (ctl->clim_ccl2f2_timeseries[0] != '-')
    read_clim_ts(ctl->clim_ccl2f2_timeseries, &clim->ccl2f2);
 
  /* Read N2O time series... */
  if (ctl->clim_n2o_timeseries[0] != '-')
    read_clim_ts(ctl->clim_n2o_timeseries, &clim->n2o);
 
  /* Read SF6 time series... */
  if (ctl->clim_sf6_timeseries[0] != '-')
    read_clim_ts(ctl->clim_sf6_timeseries, &clim->sf6);
}
 
/*****************************************************************************/
 
void mptrac_read_ctl(
  const char *filename,
  int argc,
  char *argv[],
  ctl_t *ctl) {
 
  /* Set timer... */
  SELECT_TIMER("READ_CTL", "INPUT");
 
  /* Write info... */
  LOG(1, "\nMassive-Parallel Trajectory Calculations (MPTRAC)\n"
      "(executable: %s | version: %s | compiled: %s, %s)\n",
      argv[0], VERSION, __DATE__, __TIME__);
 
  /* Initialize quantity indices... */
  ctl->qnt_idx = -1;
  ctl->qnt_ens = -1;
  ctl->qnt_stat = -1;
  ctl->qnt_m = -1;
  ctl->qnt_vmr = -1;
  ctl->qnt_rp = -1;
  ctl->qnt_rhop = -1;
  ctl->qnt_ps = -1;
  ctl->qnt_ts = -1;
  ctl->qnt_zs = -1;
  ctl->qnt_us = -1;
  ctl->qnt_vs = -1;
  ctl->qnt_ess = -1;
  ctl->qnt_nss = -1;
  ctl->qnt_shf = -1;
  ctl->qnt_lsm = -1;
  ctl->qnt_sst = -1;
  ctl->qnt_pbl = -1;
  ctl->qnt_pt = -1;
  ctl->qnt_tt = -1;
  ctl->qnt_zt = -1;
  ctl->qnt_h2ot = -1;
  ctl->qnt_zg = -1;
  ctl->qnt_p = -1;
  ctl->qnt_t = -1;
  ctl->qnt_rho = -1;
  ctl->qnt_u = -1;
  ctl->qnt_v = -1;
  ctl->qnt_w = -1;
  ctl->qnt_h2o = -1;
  ctl->qnt_o3 = -1;
  ctl->qnt_lwc = -1;
  ctl->qnt_rwc = -1;
  ctl->qnt_iwc = -1;
  ctl->qnt_swc = -1;
  ctl->qnt_cc = -1;
  ctl->qnt_pct = -1;
  ctl->qnt_pcb = -1;
  ctl->qnt_cl = -1;
  ctl->qnt_plcl = -1;
  ctl->qnt_plfc = -1;
  ctl->qnt_pel = -1;
  ctl->qnt_cape = -1;
  ctl->qnt_cin = -1;
  ctl->qnt_o3c = -1;
  ctl->qnt_hno3 = -1;
  ctl->qnt_oh = -1;
  ctl->qnt_h2o2 = -1;
  ctl->qnt_ho2 = -1;
  ctl->qnt_o1d = -1;
  ctl->qnt_mloss_oh = -1;
  ctl->qnt_mloss_h2o2 = -1;
  ctl->qnt_mloss_kpp = -1;
  ctl->qnt_mloss_wet = -1;
  ctl->qnt_mloss_dry = -1;
  ctl->qnt_mloss_decay = -1;
  ctl->qnt_loss_rate = -1;
  ctl->qnt_psat = -1;
  ctl->qnt_psice = -1;
  ctl->qnt_pw = -1;
  ctl->qnt_sh = -1;
  ctl->qnt_rh = -1;
  ctl->qnt_rhice = -1;
  ctl->qnt_theta = -1;
  ctl->qnt_iso_var = -1;
  ctl->qnt_zeta = -1;
  ctl->qnt_zeta_d = -1;
  ctl->qnt_zeta_dot = -1;
  ctl->qnt_eta = -1;
  ctl->qnt_eta_d = -1;
  ctl->qnt_eta_dot = -1;
  ctl->qnt_tvirt = -1;
  ctl->qnt_lapse = -1;
  ctl->qnt_vh = -1;
  ctl->qnt_vz = -1;
  ctl->qnt_pv = -1;
  ctl->qnt_tdew = -1;
  ctl->qnt_tice = -1;
  ctl->qnt_tsts = -1;
  ctl->qnt_tnat = -1;
  ctl->qnt_Cx = -1;
  ctl->qnt_Ch2o = -1;
  ctl->qnt_Co3 = -1;
  ctl->qnt_Cco = -1;
  ctl->qnt_Coh = -1;
  ctl->qnt_Ch = -1;
  ctl->qnt_Cho2 = -1;
  ctl->qnt_Ch2o2 = -1;
  ctl->qnt_Co1d = -1;
  ctl->qnt_Co3p = -1;
  ctl->qnt_Cccl4 = -1;
  ctl->qnt_Cccl3f = -1;
  ctl->qnt_Cccl2f2 = -1;
  ctl->qnt_Cn2o = -1;
  ctl->qnt_Csf6 = -1;
  ctl->qnt_aoa = -1;
  ctl->qnt_Arn222 = -1;
  ctl->qnt_Apb210 = -1;
  ctl->qnt_Abe7 = -1;
  ctl->qnt_Acs137 = -1;
  ctl->qnt_Ai131 = -1;
  ctl->qnt_Axe133 = -1;
  ctl->qnt_current_subdomain = -1;
  ctl->qnt_target_subdomain = -1;
 
  /* Read quantities... */
  ctl->nq = (int) scan_ctl(filename, argc, argv, "NQ", -1, "0", NULL);
  if (ctl->nq > NQ)
    ERRMSG("Too many quantities!");
  for (int iq = 0; iq < ctl->nq; iq++) {
 
    /* Read quantity name and format... */
    scan_ctl(filename, argc, argv, "QNT_NAME", iq, "", ctl->qnt_name[iq]);
    scan_ctl(filename, argc, argv, "QNT_LONGNAME", iq, ctl->qnt_name[iq],
             ctl->qnt_longname[iq]);
    scan_ctl(filename, argc, argv, "QNT_FORMAT", iq, "%g",
             ctl->qnt_format[iq]);
    if (strcasecmp(ctl->qnt_name[iq], "aoa") == 0)
      sprintf(ctl->qnt_format[iq], "%%.2f");
 
    /* Try to identify quantity... */
    SET_QNT(qnt_idx, "idx", "particle index", "-")
      SET_QNT(qnt_ens, "ens", "ensemble index", "-")
      SET_QNT(qnt_stat, "stat", "station flag", "-")
      SET_QNT(qnt_m, "m", "mass", "kg")
      SET_QNT(qnt_vmr, "vmr", "volume mixing ratio", "ppv")
      SET_QNT(qnt_rp, "rp", "particle radius", "microns")
      SET_QNT(qnt_rhop, "rhop", "particle density", "kg/m^3")
      SET_QNT(qnt_ps, "ps", "surface pressure", "hPa")
      SET_QNT(qnt_ts, "ts", "surface temperature", "K")
      SET_QNT(qnt_zs, "zs", "surface height", "km")
      SET_QNT(qnt_us, "us", "surface zonal wind", "m/s")
      SET_QNT(qnt_vs, "vs", "surface meridional wind", "m/s")
      SET_QNT(qnt_ess, "ess", "eastward turbulent surface stress", "N/m^2")
      SET_QNT(qnt_nss, "nss", "northward turbulent surface stress", "N/m^2")
      SET_QNT(qnt_shf, "shf", "surface sensible heat flux", "W/m^2")
      SET_QNT(qnt_lsm, "lsm", "land-sea mask", "1")
      SET_QNT(qnt_sst, "sst", "sea surface temperature", "K")
      SET_QNT(qnt_pbl, "pbl", "planetary boundary layer", "hPa")
      SET_QNT(qnt_pt, "pt", "tropopause pressure", "hPa")
      SET_QNT(qnt_tt, "tt", "tropopause temperature", "K")
      SET_QNT(qnt_zt, "zt", "tropopause geopotential height", "km")
      SET_QNT(qnt_h2ot, "h2ot", "tropopause water vapor", "ppv")
      SET_QNT(qnt_zg, "zg", "geopotential height", "km")
      SET_QNT(qnt_p, "p", "pressure", "hPa")
      SET_QNT(qnt_t, "t", "temperature", "K")
      SET_QNT(qnt_rho, "rho", "air density", "kg/m^3")
      SET_QNT(qnt_u, "u", "zonal wind", "m/s")
      SET_QNT(qnt_v, "v", "meridional wind", "m/s")
      SET_QNT(qnt_w, "w", "vertical velocity", "hPa/s")
      SET_QNT(qnt_h2o, "h2o", "water vapor", "ppv")
      SET_QNT(qnt_o3, "o3", "ozone", "ppv")
      SET_QNT(qnt_lwc, "lwc", "cloud liquid water content", "kg/kg")
      SET_QNT(qnt_rwc, "rwc", "cloud rain water content", "kg/kg")
      SET_QNT(qnt_iwc, "iwc", "cloud ice water content", "kg/kg")
      SET_QNT(qnt_swc, "swc", "cloud snow water content", "kg/kg")
      SET_QNT(qnt_cc, "cc", "cloud cover", "1")
      SET_QNT(qnt_pct, "pct", "cloud top pressure", "hPa")
      SET_QNT(qnt_pcb, "pcb", "cloud bottom pressure", "hPa")
      SET_QNT(qnt_cl, "cl", "total column cloud water", "kg/m^2")
      SET_QNT(qnt_plcl, "plcl", "lifted condensation level", "hPa")
      SET_QNT(qnt_plfc, "plfc", "level of free convection", "hPa")
      SET_QNT(qnt_pel, "pel", "equilibrium level", "hPa")
      SET_QNT(qnt_cape, "cape", "convective available potential energy",
              "J/kg")
      SET_QNT(qnt_cin, "cin", "convective inhibition", "J/kg")
      SET_QNT(qnt_o3c, "o3c", "total column ozone", "DU")
      SET_QNT(qnt_hno3, "hno3", "nitric acid", "ppv")
      SET_QNT(qnt_oh, "oh", "hydroxyl radical", "ppv")
      SET_QNT(qnt_h2o2, "h2o2", "hydrogen peroxide", "ppv")
      SET_QNT(qnt_ho2, "ho2", "hydroperoxyl radical", "ppv")
      SET_QNT(qnt_o1d, "o1d", "atomic oxygen", "ppv")
      SET_QNT(qnt_mloss_oh, "mloss_oh", "mass loss due to OH chemistry", "kg")
      SET_QNT(qnt_mloss_h2o2, "mloss_h2o2",
              "mass loss due to H2O2 chemistry", "kg")
      SET_QNT(qnt_mloss_kpp, "mloss_kpp", "mass loss due to kpp chemistry",
              "kg")
      SET_QNT(qnt_mloss_wet, "mloss_wet", "mass loss due to wet deposition",
              "kg")
      SET_QNT(qnt_mloss_dry, "mloss_dry", "mass loss due to dry deposition",
              "kg")
      SET_QNT(qnt_mloss_decay, "mloss_decay",
              "mass loss due to exponential decay", "kg")
      SET_QNT(qnt_loss_rate, "loss_rate", "total loss rate", "s^-1")
      SET_QNT(qnt_psat, "psat", "saturation pressure over water", "hPa")
      SET_QNT(qnt_psice, "psice", "saturation pressure over ice", "hPa")
      SET_QNT(qnt_pw, "pw", "partial water vapor pressure", "hPa")
      SET_QNT(qnt_sh, "sh", "specific humidity", "kg/kg")
      SET_QNT(qnt_rh, "rh", "relative humidity", "%%")
      SET_QNT(qnt_rhice, "rhice", "relative humidity over ice", "%%")
      SET_QNT(qnt_theta, "theta", "potential temperature", "K")
      SET_QNT(qnt_iso_var, "iso_var", "isosurface reference value", "varies")
      SET_QNT(qnt_zeta, "zeta", "zeta coordinate", "K")
      SET_QNT(qnt_zeta_d, "zeta_d", "diagnosed zeta coordinate", "K")
      SET_QNT(qnt_zeta_dot, "zeta_dot", "velocity of zeta coordinate",
              "K/day")
      SET_QNT(qnt_eta, "eta", "eta coordinate", "1")
      SET_QNT(qnt_eta_d, "eta_d", "diagnosed eta coordinate", "1")
      SET_QNT(qnt_eta_dot, "eta_dot", "velocity of eta coordinate", "1/s")
      SET_QNT(qnt_tvirt, "tvirt", "virtual temperature", "K")
      SET_QNT(qnt_lapse, "lapse", "temperature lapse rate", "K/km")
      SET_QNT(qnt_vh, "vh", "horizontal velocity", "m/s")
      SET_QNT(qnt_vz, "vz", "vertical velocity", "m/s")
      SET_QNT(qnt_pv, "pv", "potential vorticity", "PVU")
      SET_QNT(qnt_tdew, "tdew", "dew point temperature", "K")
      SET_QNT(qnt_tice, "tice", "frost point temperature", "K")
      SET_QNT(qnt_tsts, "tsts", "STS existence temperature", "K")
      SET_QNT(qnt_tnat, "tnat", "NAT existence temperature", "K")
      SET_QNT(qnt_Cx, "Cx", "Trace species x volume mixing ratio", "ppv")
      SET_QNT(qnt_Ch2o, "Ch2o", "H2O volume mixing ratio", "ppv")
      SET_QNT(qnt_Co3, "Co3", "O3 volume mixing ratio", "ppv")
      SET_QNT(qnt_Cco, "Cco", "CO volume mixing ratio", "ppv")
      SET_QNT(qnt_Coh, "Coh", "HO volume mixing ratio", "ppv")
      SET_QNT(qnt_Ch, "Ch", "H radical volume mixing ratio", "ppv")
      SET_QNT(qnt_Cho2, "Cho2", "HO2 volume mixing ratio", "ppv")
      SET_QNT(qnt_Ch2o2, "Ch2o2", "H2O2 volume mixing ratio", "ppv")
      SET_QNT(qnt_Co1d, "Co1d", "O(1D) volume mixing ratio", "ppv")
      SET_QNT(qnt_Co3p, "Co3p", "O(3P) radical volume mixing ratio", "ppv")
      SET_QNT(qnt_Cccl4, "Cccl4", "CCl4 (CFC-10) volume mixing ratio", "ppv")
      SET_QNT(qnt_Cccl3f, "Cccl3f", "CCl3F (CFC-11) volume mixing ratio",
              "ppv")
      SET_QNT(qnt_Cccl2f2, "Cccl2f2", "CCl2F2 (CFC-12) volume mixing ratio",
              "ppv")
      SET_QNT(qnt_Cn2o, "Cn2o", "N2O volume mixing ratio", "ppv")
      SET_QNT(qnt_Csf6, "Csf6", "SF6 volume mixing ratio", "ppv")
      SET_QNT(qnt_aoa, "aoa", "age of air", "s")
      SET_QNT(qnt_Arn222, "Arn222", "Rn-222 activity", "Bq")
      SET_QNT(qnt_Apb210, "Apb210", "Pb-210 activity", "Bq")
      SET_QNT(qnt_Abe7, "Abe7", "Be-7 activity", "Bq")
      SET_QNT(qnt_Acs137, "Acs137", "Cs-137 activity", "Bq")
      SET_QNT(qnt_Ai131, "Ai131", "I-131 activity", "Bq")
      SET_QNT(qnt_Axe133, "Axe133", "Xe-133 activity", "Bq")
      SET_QNT(qnt_current_subdomain, "current_subdomain",
              "current subdomain rank", "-")
      SET_QNT(qnt_target_subdomain, "target_subdomain",
              "target subdomain rank", "-")
      scan_ctl(filename, argc, argv, "QNT_UNIT", iq, "", ctl->qnt_unit[iq]);
  }
 
  ctl->met_coord_type =
    (int) scan_ctl(filename, argc, argv, "MET_COORD_TYPE", -1, "0", NULL);
  if (ctl->met_coord_type < 0 || ctl->met_coord_type > 1)
    ERRMSG("MET_COORD_TYPE must be 0 or 1!");
  ctl->met_utm_ref_lat = 0.0;
  ctl->met_utm_ref_lon = 0.0;
  if (ctl->met_coord_type == 1) {
    ctl->met_utm_ref_lat =
      scan_ctl(filename, argc, argv, "MET_UTM_REF_LAT", -1, "", NULL);
    ctl->met_utm_ref_lon =
      scan_ctl(filename, argc, argv, "MET_UTM_REF_LON", -1, "", NULL);
  }
 
  /* Vertical coordinate and velocity... */
  ctl->advect_vert_coord =
    (int) scan_ctl(filename, argc, argv, "ADVECT_VERT_COORD", -1, "0", NULL);
  if (ctl->advect_vert_coord < 0 || ctl->advect_vert_coord > 3)
    ERRMSG("ADVECT_VERT_COORD must be 0, 1, 2, or 3!");
 
  if (ctl->advect_vert_coord == 1 && ctl->qnt_zeta < 0)
    ERRMSG("Add quantity zeta for diabatic advection!");
  if (ctl->advect_vert_coord == 3 && ctl->qnt_eta < 0)
    ERRMSG("Add quantity eta for etadot avection!");
 
  ctl->met_vert_coord =
    (int) scan_ctl(filename, argc, argv, "MET_VERT_COORD", -1, "0", NULL);
  if (ctl->met_vert_coord < 0 || ctl->met_vert_coord > 4)
    ERRMSG("MET_VERT_COORD must be 0, 1, 2, 3, or 4!");
  if (ctl->qnt_eta_d >= 0
      && ctl->met_vert_coord != 2 && ctl->met_vert_coord != 3)
    ERRMSG("Quantity eta_d requires full-level A and B coefficients!");
 
  if (ctl->advect_vert_coord == 2 && ctl->met_vert_coord == 0)
    ERRMSG
      ("Using ADVECT_VERT_COORD = 2 requires meteo data on model levels!");
  if (ctl->advect_vert_coord == 3 && ctl->met_vert_coord != 3)
    ERRMSG
      ("Using ADVECT_VERT_COORD = 3 requires A and B model level coefficients!");
 
  ctl->met_gp2z =
    (int) scan_ctl(filename, argc, argv, "MET_GP2Z", -1, "0", NULL);
  if (ctl->met_gp2z != 0 && ctl->met_gp2z != 1)
    ERRMSG("Set MET_GP2Z to 0 or 1!");
 
  /* Time steps of simulation... */
  ctl->direction =
    (int) scan_ctl(filename, argc, argv, "DIRECTION", -1, "1", NULL);
  if (ctl->direction != -1 && ctl->direction != 1)
    ERRMSG("Set DIRECTION to -1 or 1!");
  ctl->t_stop = scan_ctl(filename, argc, argv, "T_STOP", -1, "1e100", NULL);
  ctl->dt_mod = scan_ctl(filename, argc, argv, "DT_MOD", -1, "180", NULL);
 
  /* Meteo data... */
  scan_ctl(filename, argc, argv, "METBASE", -1, "-", ctl->metbase);
  ctl->dt_met = scan_ctl(filename, argc, argv, "DT_MET", -1, "3600", NULL);
  if (ctl->dt_mod > ctl->dt_met)
    ERRMSG("DT_MOD must not exceed DT_MET!");
  ctl->met_convention =
    (int) scan_ctl(filename, argc, argv, "MET_CONVENTION", -1, "0", NULL);
  ctl->met_type =
    (int) scan_ctl(filename, argc, argv, "MET_TYPE", -1, "0", NULL);
  if (ctl->advect_vert_coord == 1 && ctl->met_type != 0)
    ERRMSG
      ("Please use meteo files in netcdf format for diabatic calculations.");
  if (ctl->advect_vert_coord == 3 && ctl->met_type != 0)
    ERRMSG
      ("Please use meteo files in netcdf format for etadot calculations.");
  ctl->met_clams =
    (int) scan_ctl(filename, argc, argv, "MET_CLAMS", -1, "0", NULL);
  ctl->met_nc_scale =
    (int) scan_ctl(filename, argc, argv, "MET_NC_SCALE", -1, "1", NULL);
  ctl->met_nc_read_mode =
    (int) scan_ctl(filename, argc, argv, "MET_NC_READ_MODE", -1, "0", NULL);
  if (ctl->met_nc_read_mode < 0 || ctl->met_nc_read_mode > 1)
    ERRMSG("Set MET_NC_READ_MODE to 0 or 1!");
  ctl->met_nc_level =
    (int) scan_ctl(filename, argc, argv, "MET_NC_LEVEL", -1, "0", NULL);
  ctl->met_nc_quant =
    (int) scan_ctl(filename, argc, argv, "MET_NC_QUANT", -1, "0", NULL);
  ctl->met_zstd_level =
    (int) scan_ctl(filename, argc, argv, "MET_ZSTD_LEVEL", -1, "-3", NULL);
  ctl->met_zstd_nworkers =
    (int) scan_ctl(filename, argc, argv, "MET_ZSTD_NWORKERS", -1, "4", NULL);
  ctl->met_lz4_accel =
    (int) scan_ctl(filename, argc, argv, "MET_LZ4_ACCEL", -1, "8", NULL);
  ctl->met_pck_zstd =
    (int) scan_ctl(filename, argc, argv, "MET_PCK_ZSTD", -1, "0", NULL);
  if (ctl->met_pck_zstd != 0 && ctl->met_pck_zstd != 1)
    ERRMSG("Set MET_PCK_ZSTD to 0 or 1!");
#ifndef ZSTD
  if (ctl->met_type == 2 && ctl->met_pck_zstd)
    ERRMSG("MET_PCK_ZSTD requires MPTRAC to be compiled with ZSTD support!");
#endif
  const int def_lossy_scale =
    (int) scan_ctl(filename, argc, argv, "MET_LOSSY_SCALE", -1, "0", NULL);
  for (int i = 0; i < METVAR; i++) {
    char defprec_zfp[LEN] = "7", deftol_zfp[LEN] = "0.0";
    char defprec_sz3[LEN] = "6", deftol_sz3[LEN] = "0.0";
    if (i == 0) {               /* geopotential height */
      sprintf(defprec_zfp, "12");
      sprintf(defprec_sz3, "11");
    } else if (i == 1) {        /* temperature */
      sprintf(defprec_zfp, "11");
      sprintf(defprec_sz3, "7");
    } else if (i == 2 || i == 3) {      /* horizontal wind */
      sprintf(defprec_zfp, "7");
      sprintf(defprec_sz3, "7");
    } else if (i == 4) {        /* vertical wind */
      sprintf(defprec_zfp, "6");
      sprintf(defprec_sz3, "13");
    } else if (i == 5) {        /* potential vorticity */
      sprintf(defprec_zfp, "7");
      sprintf(defprec_sz3, "20");
    } else if (i == 6) {        /* water vapor */
      sprintf(defprec_zfp, "10");
      sprintf(defprec_sz3, "18");
    } else if (i == 7) {        /* ozone */
      sprintf(defprec_zfp, "9");
      sprintf(defprec_sz3, "10");
    } else if (i >= 8 && i <= 11) {     /* cloud water fields */
      sprintf(defprec_zfp, "6");
      sprintf(defprec_sz3, "13");
    } else if (i == 12) {       /* cloud cover */
      sprintf(defprec_zfp, "9");
      sprintf(defprec_sz3, "6");
    }
    ctl->met_zfp_prec[i] =
      (int) scan_ctl(filename, argc, argv, "MET_ZFP_PREC", i, defprec_zfp,
                     NULL);
    ctl->met_zfp_tol[i] =
      scan_ctl(filename, argc, argv, "MET_ZFP_TOL", i, deftol_zfp, NULL);
    ctl->met_sz3_prec[i] =
      (int) scan_ctl(filename, argc, argv, "MET_SZ3_PREC", i, defprec_sz3,
                     NULL);
    ctl->met_sz3_tol[i] =
      scan_ctl(filename, argc, argv, "MET_SZ3_TOL", i, deftol_sz3, NULL);
    char defscale[LEN];
    snprintf(defscale, LEN, "%d", def_lossy_scale);
    ctl->met_lossy_scale[i] =
      (int) scan_ctl(filename, argc, argv, "MET_LOSSY_SCALE", i, defscale,
                     NULL);
    if (ctl->met_lossy_scale[i] < 0 || ctl->met_lossy_scale[i] > 1)
      ERRMSG("Set MET_LOSSY_SCALE to 0 or 1!");
  }
 
  /* Scan compression diagnostics file... */
  scan_ctl(filename, argc, argv, "MET_COMP_LOGFILE", -1, "-",
           ctl->met_comp_logfile);
  ctl->met_cms_batch =
    (int) scan_ctl(filename, argc, argv, "MET_CMS_BATCH", -1, "-1", NULL);
  ctl->met_cms_zstd =
    (int) scan_ctl(filename, argc, argv, "MET_CMS_ZSTD", -1, "1", NULL);
  ctl->met_cms_nd0x =
    (int) scan_ctl(filename, argc, argv, "MET_CMS_ND0X", -1, "48", NULL);
  ctl->met_cms_nd0y =
    (int) scan_ctl(filename, argc, argv, "MET_CMS_ND0Y", -1, "24", NULL);
  ctl->met_cms_maxlev =
    (int) scan_ctl(filename, argc, argv, "MET_CMS_MAXLEV", -1, "6", NULL);
  for (int i = 0; i < METVAR; i++) {
    char defeps[LEN] = "1.0";
    if (i == 1 || i == 2 || i == 3)
      sprintf(defeps, "0.05");
    ctl->met_cms_eps[i] =
      scan_ctl(filename, argc, argv, "MET_CMS_EPS", i, defeps, NULL);
  }
  ctl->met_dx = (int) scan_ctl(filename, argc, argv, "MET_DX", -1, "1", NULL);
  ctl->met_dy = (int) scan_ctl(filename, argc, argv, "MET_DY", -1, "1", NULL);
  ctl->met_dp = (int) scan_ctl(filename, argc, argv, "MET_DP", -1, "1", NULL);
  if (ctl->met_dx < 1 || ctl->met_dy < 1 || ctl->met_dp < 1)
    ERRMSG("MET_DX, MET_DY, and MET_DP need to be greater than zero!");
  ctl->met_sx = (int) scan_ctl(filename, argc, argv, "MET_SX", -1, "1", NULL);
  ctl->met_sy = (int) scan_ctl(filename, argc, argv, "MET_SY", -1, "1", NULL);
  ctl->met_sp = (int) scan_ctl(filename, argc, argv, "MET_SP", -1, "1", NULL);
  if (ctl->met_sx < 1 || ctl->met_sy < 1 || ctl->met_sp < 1)
    ERRMSG("MET_SX, MET_SY, and MET_SP need to be greater than zero!");
  ctl->met_detrend =
    scan_ctl(filename, argc, argv, "MET_DETREND", -1, "-999", NULL);
  ctl->met_np = (int) scan_ctl(filename, argc, argv, "MET_NP", -1, "0", NULL);
  if (ctl->met_np > EP)
    ERRMSG("Too many pressure levels!");
  ctl->met_press_level_def =
    (int) scan_ctl(filename, argc, argv, "MET_PRESS_LEVEL_DEF", -1, "-1",
                   NULL);
  if (ctl->met_press_level_def >= 0) {
    level_definitions(ctl);
  } else {
    if (ctl->met_np > 0) {
      for (int ip = 0; ip < ctl->met_np; ip++)
        ctl->met_p[ip] =
          scan_ctl(filename, argc, argv, "MET_P", ip, "", NULL);
    }
  }
  ctl->met_nlev =
    (int) scan_ctl(filename, argc, argv, "MET_NLEV", -1, "0", NULL);
  if (ctl->met_nlev > EP)
    ERRMSG("Too many model levels!");
  for (int ip = 0; ip < ctl->met_nlev; ip++)
    ctl->met_lev_hyam[ip] =
      scan_ctl(filename, argc, argv, "MET_LEV_HYAM", ip, "", NULL);
  for (int ip = 0; ip < ctl->met_nlev; ip++)
    ctl->met_lev_hybm[ip] =
      scan_ctl(filename, argc, argv, "MET_LEV_HYBM", ip, "", NULL);
  ctl->met_geopot_sx =
    (int) scan_ctl(filename, argc, argv, "MET_GEOPOT_SX", -1, "-1", NULL);
  ctl->met_geopot_sy =
    (int) scan_ctl(filename, argc, argv, "MET_GEOPOT_SY", -1, "-1", NULL);
  ctl->met_relhum =
    (int) scan_ctl(filename, argc, argv, "MET_RELHUM", -1, "0", NULL);
  ctl->met_cape =
    (int) scan_ctl(filename, argc, argv, "MET_CAPE", -1, "1", NULL);
  if (ctl->met_cape < 0 || ctl->met_cape > 1)
    ERRMSG("Set MET_CAPE to 0 or 1!");
  ctl->met_pbl =
    (int) scan_ctl(filename, argc, argv, "MET_PBL", -1, "3", NULL);
  if (ctl->met_pbl < 0 || ctl->met_pbl > 3)
    ERRMSG("Set MET_PBL to 0 ... 3!");
  ctl->met_pbl_min =
    scan_ctl(filename, argc, argv, "MET_PBL_MIN", -1, "0.1", NULL);
  ctl->met_pbl_max =
    scan_ctl(filename, argc, argv, "MET_PBL_MAX", -1, "5.0", NULL);
  ctl->met_tropo =
    (int) scan_ctl(filename, argc, argv, "MET_TROPO", -1, "3", NULL);
  if (ctl->met_tropo < 0 || ctl->met_tropo > 5)
    ERRMSG("Set MET_TROPO to 0 ... 5!");
  ctl->met_tropo_pv =
    scan_ctl(filename, argc, argv, "MET_TROPO_PV", -1, "3.5", NULL);
  ctl->met_tropo_theta =
    scan_ctl(filename, argc, argv, "MET_TROPO_THETA", -1, "380", NULL);
  ctl->met_tropo_spline =
    (int) scan_ctl(filename, argc, argv, "MET_TROPO_SPLINE", -1, "1", NULL);
  ctl->met_dt_out =
    scan_ctl(filename, argc, argv, "MET_DT_OUT", -1, "0.1", NULL);
  ctl->met_cache =
    (int) scan_ctl(filename, argc, argv, "MET_CACHE", -1, "0", NULL);
  ctl->met_mpi_share =
    (int) scan_ctl(filename, argc, argv, "MET_MPI_SHARE", -1, "0", NULL);
 
  /* Sorting... */
  ctl->sort_dt = scan_ctl(filename, argc, argv, "SORT_DT", -1, "-999", NULL);
 
  /* Isosurface parameters... */
  ctl->isosurf =
    (int) scan_ctl(filename, argc, argv, "ISOSURF", -1, "0", NULL);
  if (ctl->isosurf >= 1 && ctl->isosurf <= 3 && ctl->qnt_iso_var < 0)
    ERRMSG("Add quantity iso_var for ISOSURF=1, 2, or 3!");
  scan_ctl(filename, argc, argv, "BALLOON", -1, "-", ctl->balloon);
 
  /* Random number generator... */
  ctl->rng_type =
    (int) scan_ctl(filename, argc, argv, "RNG_TYPE", -1, "1", NULL);
  if (ctl->rng_type < 0 || ctl->rng_type > 2)
    ERRMSG("Set RNG_TYPE to 0, 1, or 2!");
 
  /* Advection parameters... */
  ctl->advect = (int) scan_ctl(filename, argc, argv, "ADVECT", -1, "2", NULL);
  if (!(ctl->advect == 1 || ctl->advect == 2 || ctl->advect == 4))
    ERRMSG("Set ADVECT to 1, 2, or 4!");
 
  /* Diffusion parameters... */
  ctl->diffusion
    = (int) scan_ctl(filename, argc, argv, "DIFFUSION", -1, "0", NULL);
  if (ctl->diffusion < 0 || ctl->diffusion > 1)
    ERRMSG("Set DIFFUSION to 0 or 1!");
  ctl->turb_pbl_scheme =
    (int) scan_ctl(filename, argc, argv, "TURB_PBL_SCHEME", -1, "0", NULL);
  if (ctl->turb_pbl_scheme < 0 || ctl->turb_pbl_scheme > 1)
    ERRMSG("Set TURB_PBL_SCHEME to 0 or 1!");
  ctl->turb_dx_pbl =
    scan_ctl(filename, argc, argv, "TURB_DX_PBL", -1, "50", NULL);
  ctl->turb_dx_trop =
    scan_ctl(filename, argc, argv, "TURB_DX_TROP", -1, "50", NULL);
  ctl->turb_dx_strat =
    scan_ctl(filename, argc, argv, "TURB_DX_STRAT", -1, "0", NULL);
  ctl->turb_dz_pbl =
    scan_ctl(filename, argc, argv, "TURB_DZ_PBL", -1, "0", NULL);
  ctl->turb_dz_trop =
    scan_ctl(filename, argc, argv, "TURB_DZ_TROP", -1, "0", NULL);
  ctl->turb_dz_strat =
    scan_ctl(filename, argc, argv, "TURB_DZ_STRAT", -1, "0.1", NULL);
  ctl->turb_mesox =
    scan_ctl(filename, argc, argv, "TURB_MESOX", -1, "0.16", NULL);
  ctl->turb_mesoz =
    scan_ctl(filename, argc, argv, "TURB_MESOZ", -1, "0.16", NULL);
  ctl->turb_pbl_trans =
    scan_ctl(filename, argc, argv, "TURB_PBL_TRANS", -1, "0", NULL);
  if (ctl->turb_pbl_trans < 0 || ctl->turb_pbl_trans > 1)
    ERRMSG("TURB_PBL_TRANS must be in the range [0, 1]!");
 
  /* Convection... */
  ctl->conv_mix_pbl
    = (int) scan_ctl(filename, argc, argv, "CONV_MIX_PBL", -1, "0", NULL);
  ctl->conv_pbl_trans
    = scan_ctl(filename, argc, argv, "CONV_PBL_TRANS", -1, "0", NULL);
  if (ctl->conv_pbl_trans < 0 || ctl->conv_pbl_trans > 1)
    ERRMSG("CONV_PBL_TRANS must be in the range [0, 1]!");
  ctl->conv_cape
    = scan_ctl(filename, argc, argv, "CONV_CAPE", -1, "-999", NULL);
  ctl->conv_cin
    = scan_ctl(filename, argc, argv, "CONV_CIN", -1, "-999", NULL);
  ctl->conv_dt = scan_ctl(filename, argc, argv, "CONV_DT", -1, "-999", NULL);
 
  /* Boundary conditions... */
  ctl->bound_mass =
    scan_ctl(filename, argc, argv, "BOUND_MASS", -1, "-999", NULL);
  ctl->bound_mass_trend =
    scan_ctl(filename, argc, argv, "BOUND_MASS_TREND", -1, "0", NULL);
  ctl->bound_vmr =
    scan_ctl(filename, argc, argv, "BOUND_VMR", -1, "-999", NULL);
  ctl->bound_vmr_trend =
    scan_ctl(filename, argc, argv, "BOUND_VMR_TREND", -1, "0", NULL);
  ctl->bound_lat0 =
    scan_ctl(filename, argc, argv, "BOUND_LAT0", -1, "-999", NULL);
  ctl->bound_lat1 =
    scan_ctl(filename, argc, argv, "BOUND_LAT1", -1, "-999", NULL);
  ctl->bound_p0 =
    scan_ctl(filename, argc, argv, "BOUND_P0", -1, "-999", NULL);
  ctl->bound_p1 =
    scan_ctl(filename, argc, argv, "BOUND_P1", -1, "-999", NULL);
  ctl->bound_dps =
    scan_ctl(filename, argc, argv, "BOUND_DPS", -1, "-999", NULL);
  ctl->bound_dzs =
    scan_ctl(filename, argc, argv, "BOUND_DZS", -1, "-999", NULL);
  ctl->bound_zetas =
    scan_ctl(filename, argc, argv, "BOUND_ZETAS", -1, "-999", NULL);
  ctl->bound_pbl =
    (int) scan_ctl(filename, argc, argv, "BOUND_PBL", -1, "0", NULL);
 
  /* Species parameters... */
  scan_ctl(filename, argc, argv, "SPECIES", -1, "-", ctl->species);
  if (strcasecmp(ctl->species, "CF2Cl2") == 0) {
    ctl->molmass = 120.907;
    ctl->wet_depo_ic_h[0] = ctl->wet_depo_bc_h[0] = 3e-5;
    ctl->wet_depo_ic_h[1] = ctl->wet_depo_bc_h[1] = 3500.0;
  } else if (strcasecmp(ctl->species, "CFCl3") == 0) {
    ctl->molmass = 137.359;
    ctl->wet_depo_ic_h[0] = ctl->wet_depo_bc_h[0] = 1.1e-4;
    ctl->wet_depo_ic_h[1] = ctl->wet_depo_bc_h[1] = 3300.0;
  } else if (strcasecmp(ctl->species, "CH4") == 0) {
    ctl->molmass = 16.043;
    ctl->oh_chem_reaction = 2;
    ctl->oh_chem[0] = 2.45e-12;
    ctl->oh_chem[1] = 1775;
    ctl->wet_depo_ic_h[0] = ctl->wet_depo_bc_h[0] = 1.4e-5;
    ctl->wet_depo_ic_h[1] = ctl->wet_depo_bc_h[1] = 1600.0;
  } else if (strcasecmp(ctl->species, "CO") == 0) {
    ctl->molmass = 28.01;
    ctl->oh_chem_reaction = 3;
    ctl->oh_chem[0] = 6.9e-33;
    ctl->oh_chem[1] = 2.1;
    ctl->oh_chem[2] = 1.1e-12;
    ctl->oh_chem[3] = -1.3;
    ctl->wet_depo_ic_h[0] = ctl->wet_depo_bc_h[0] = 9.7e-6;
    ctl->wet_depo_ic_h[1] = ctl->wet_depo_bc_h[1] = 1300.0;
  } else if (strcasecmp(ctl->species, "CO2") == 0) {
    ctl->molmass = 44.009;
    ctl->wet_depo_ic_h[0] = ctl->wet_depo_bc_h[0] = 3.3e-4;
    ctl->wet_depo_ic_h[1] = ctl->wet_depo_bc_h[1] = 2400.0;
  } else if (strcasecmp(ctl->species, "H2O") == 0) {
    ctl->molmass = 18.01528;
  } else if (strcasecmp(ctl->species, "N2O") == 0) {
    ctl->molmass = 44.013;
    ctl->wet_depo_ic_h[0] = ctl->wet_depo_bc_h[0] = 2.4e-4;
    ctl->wet_depo_ic_h[1] = ctl->wet_depo_bc_h[1] = 2600.;
  } else if (strcasecmp(ctl->species, "NH3") == 0) {
    ctl->molmass = 17.031;
    ctl->oh_chem_reaction = 2;
    ctl->oh_chem[0] = 1.7e-12;
    ctl->oh_chem[1] = 710;
    ctl->wet_depo_ic_h[0] = ctl->wet_depo_bc_h[0] = 5.9e-1;
    ctl->wet_depo_ic_h[1] = ctl->wet_depo_bc_h[1] = 4200.0;
  } else if (strcasecmp(ctl->species, "HNO3") == 0) {
    ctl->molmass = 63.012;
    ctl->wet_depo_ic_h[0] = ctl->wet_depo_bc_h[0] = 2.1e3;
    ctl->wet_depo_ic_h[1] = ctl->wet_depo_bc_h[1] = 8700.0;
  } else if (strcasecmp(ctl->species, "NO") == 0) {
    ctl->molmass = 30.006;
    ctl->oh_chem_reaction = 3;
    ctl->oh_chem[0] = 7.1e-31;
    ctl->oh_chem[1] = 2.6;
    ctl->oh_chem[2] = 3.6e-11;
    ctl->oh_chem[3] = 0.1;
    ctl->wet_depo_ic_h[0] = ctl->wet_depo_bc_h[0] = 1.9e-5;
    ctl->wet_depo_ic_h[1] = ctl->wet_depo_bc_h[1] = 1600.0;
  } else if (strcasecmp(ctl->species, "NO2") == 0) {
    ctl->molmass = 46.005;
    ctl->oh_chem_reaction = 3;
    ctl->oh_chem[0] = 1.8e-30;
    ctl->oh_chem[1] = 3.0;
    ctl->oh_chem[2] = 2.8e-11;
    ctl->oh_chem[3] = 0.0;
    ctl->wet_depo_ic_h[0] = ctl->wet_depo_bc_h[0] = 1.2e-4;
    ctl->wet_depo_ic_h[1] = ctl->wet_depo_bc_h[1] = 2400.0;
  } else if (strcasecmp(ctl->species, "O3") == 0) {
    ctl->molmass = 47.997;
    ctl->oh_chem_reaction = 2;
    ctl->oh_chem[0] = 1.7e-12;
    ctl->oh_chem[1] = 940;
    ctl->wet_depo_ic_h[0] = ctl->wet_depo_bc_h[0] = 1e-4;
    ctl->wet_depo_ic_h[1] = ctl->wet_depo_bc_h[1] = 2800.0;
  } else if (strcasecmp(ctl->species, "SF6") == 0) {
    ctl->molmass = 146.048;
    ctl->wet_depo_ic_h[0] = ctl->wet_depo_bc_h[0] = 2.4e-6;
    ctl->wet_depo_ic_h[1] = ctl->wet_depo_bc_h[1] = 3100.0;
  } else if (strcasecmp(ctl->species, "SO2") == 0) {
    ctl->molmass = 64.066;
    ctl->oh_chem_reaction = 3;
    ctl->oh_chem[0] = 2.9e-31;
    ctl->oh_chem[1] = 4.1;
    ctl->oh_chem[2] = 1.7e-12;
    ctl->oh_chem[3] = -0.2;
    ctl->wet_depo_ic_h[0] = ctl->wet_depo_bc_h[0] = SO2_HENRY_REF;
    ctl->wet_depo_ic_h[1] = ctl->wet_depo_bc_h[1] = SO2_HENRY_TEMP;
  }
 
  /* Molar mass... */
  char defstr[LEN];
  sprintf(defstr, "%g", ctl->molmass);
  ctl->molmass = scan_ctl(filename, argc, argv, "MOLMASS", -1, defstr, NULL);
 
  /* OH chemistry... */
  sprintf(defstr, "%d", ctl->oh_chem_reaction);
  ctl->oh_chem_reaction =
    (int) scan_ctl(filename, argc, argv, "OH_CHEM_REACTION", -1, defstr,
                   NULL);
  for (int ip = 0; ip < 4; ip++) {
    sprintf(defstr, "%g", ctl->oh_chem[ip]);
    ctl->oh_chem[ip] =
      scan_ctl(filename, argc, argv, "OH_CHEM", ip, defstr, NULL);
  }
  ctl->oh_chem_beta =
    scan_ctl(filename, argc, argv, "OH_CHEM_BETA", -1, "0", NULL);
 
  /* H2O2 chemistry... */
  ctl->h2o2_chem_reaction =
    (int) scan_ctl(filename, argc, argv, "H2O2_CHEM_REACTION", -1, "0", NULL);
 
  /* KPP chemistry... */
  ctl->kpp_chem =
    (int) scan_ctl(filename, argc, argv, "KPP_CHEM", -1, "0", NULL);
  ctl->dt_kpp = scan_ctl(filename, argc, argv, "DT_KPP", -1, "1800", NULL);
 
  /* First order tracer chemistry... */
  ctl->tracer_chem =
    (int) scan_ctl(filename, argc, argv, "TRACER_CHEM", -1, "0", NULL);
 
  /* Radioactive decay... */
  ctl->radio_decay =
    (int) scan_ctl(filename, argc, argv, "RADIO_DECAY", -1, "0", NULL);
  ctl->radio_depo =
    (int) scan_ctl(filename, argc, argv, "RADIO_DEPO", -1, "0", NULL);
  if (ctl->radio_depo && ctl->met_coord_type != 0)
    ERRMSG("Radioactive deposition requires a lat/lon meteorological grid!");
 
  /* Wet deposition... */
  for (int ip = 0; ip < 2; ip++) {
    sprintf(defstr, "%g", ctl->wet_depo_ic_h[ip]);
    ctl->wet_depo_ic_h[ip] =
      scan_ctl(filename, argc, argv, "WET_DEPO_IC_H", ip, defstr, NULL);
  }
  for (int ip = 0; ip < 1; ip++) {
    sprintf(defstr, "%g", ctl->wet_depo_bc_h[ip]);
    ctl->wet_depo_bc_h[ip] =
      scan_ctl(filename, argc, argv, "WET_DEPO_BC_H", ip, defstr, NULL);
  }
  ctl->wet_depo_so2_ph =
    scan_ctl(filename, argc, argv, "WET_DEPO_SO2_PH", -1, "0", NULL);
  ctl->wet_depo_ic_a =
    scan_ctl(filename, argc, argv, "WET_DEPO_IC_A", -1, "0", NULL);
  ctl->wet_depo_ic_b =
    scan_ctl(filename, argc, argv, "WET_DEPO_IC_B", -1, "0", NULL);
  ctl->wet_depo_bc_a =
    scan_ctl(filename, argc, argv, "WET_DEPO_BC_A", -1, "0", NULL);
  ctl->wet_depo_bc_b =
    scan_ctl(filename, argc, argv, "WET_DEPO_BC_B", -1, "0", NULL);
  ctl->wet_depo_pre[0] =
    scan_ctl(filename, argc, argv, "WET_DEPO_PRE", 0, "0.5", NULL);
  ctl->wet_depo_pre[1] =
    scan_ctl(filename, argc, argv, "WET_DEPO_PRE", 1, "0.36", NULL);
  ctl->wet_depo_ic_ret_ratio =
    scan_ctl(filename, argc, argv, "WET_DEPO_IC_RET_RATIO", -1, "1", NULL);
  ctl->wet_depo_bc_ret_ratio =
    scan_ctl(filename, argc, argv, "WET_DEPO_BC_RET_RATIO", -1, "1", NULL);
 
  /* Dry deposition... */
  ctl->dry_depo_vdep =
    scan_ctl(filename, argc, argv, "DRY_DEPO_VDEP", -1, "0", NULL);
  ctl->dry_depo_dp =
    scan_ctl(filename, argc, argv, "DRY_DEPO_DP", -1, "30", NULL);
 
  /* Climatological data... */
  scan_ctl(filename, argc, argv, "CLIM_PHOTO", -1,
           "../../data/clams_photolysis_rates.nc", ctl->clim_photo);
  scan_ctl(filename, argc, argv, "CLIM_HNO3_FILENAME", -1,
           "../../data/gozcards_HNO3.nc", ctl->clim_hno3_filename);
  scan_ctl(filename, argc, argv, "CLIM_OH_FILENAME", -1,
           "../../data/clams_radical_species_vmr.nc", ctl->clim_oh_filename);
  scan_ctl(filename, argc, argv, "CLIM_H2O2_FILENAME", -1,
           "../../data/cams_H2O2.nc", ctl->clim_h2o2_filename);
  scan_ctl(filename, argc, argv, "CLIM_HO2_FILENAME", -1,
           "../../data/clams_radical_species_vmr.nc", ctl->clim_ho2_filename);
  scan_ctl(filename, argc, argv, "CLIM_O1D_FILENAME", -1,
           "../../data/clams_radical_species_vmr.nc", ctl->clim_o1d_filename);
  scan_ctl(filename, argc, argv, "CLIM_CCL4_TIMESERIES", -1,
           "../../data/noaa_gml_ccl4.tab", ctl->clim_ccl4_timeseries);
  scan_ctl(filename, argc, argv, "CLIM_CCL3F_TIMESERIES", -1,
           "../../data/noaa_gml_cfc11.tab", ctl->clim_ccl3f_timeseries);
  scan_ctl(filename, argc, argv, "CLIM_CCL2F2_TIMESERIES", -1,
           "../../data/noaa_gml_cfc12.tab", ctl->clim_ccl2f2_timeseries);
  scan_ctl(filename, argc, argv, "CLIM_N2O_TIMESERIES", -1,
           "../../data/noaa_gml_n2o.tab", ctl->clim_n2o_timeseries);
  scan_ctl(filename, argc, argv, "CLIM_SF6_TIMESERIES", -1,
           "../../data/noaa_gml_sf6.tab", ctl->clim_sf6_timeseries);
 
  /* Mixing... */
  ctl->mixing_dt =
    scan_ctl(filename, argc, argv, "MIXING_DT", -1, "3600.", NULL);
  ctl->mixing_tau_trop =
    scan_ctl(filename, argc, argv, "MIXING_TAU_TROP", -1, "-999", NULL);
  ctl->mixing_tau_strat =
    scan_ctl(filename, argc, argv, "MIXING_TAU_STRAT", -1, "-999", NULL);
  ctl->mixing_z0 =
    scan_ctl(filename, argc, argv, "MIXING_Z0", -1, "-5", NULL);
  ctl->mixing_z1 =
    scan_ctl(filename, argc, argv, "MIXING_Z1", -1, "85", NULL);
  ctl->mixing_nz =
    (int) scan_ctl(filename, argc, argv, "MIXING_NZ", -1, "90", NULL);
  ctl->mixing_lon0 =
    scan_ctl(filename, argc, argv, "MIXING_LON0", -1, "-180", NULL);
  ctl->mixing_lon1 =
    scan_ctl(filename, argc, argv, "MIXING_LON1", -1, "180", NULL);
  ctl->mixing_nx =
    (int) scan_ctl(filename, argc, argv, "MIXING_NX", -1, "360", NULL);
  ctl->mixing_lat0 =
    scan_ctl(filename, argc, argv, "MIXING_LAT0", -1, "-90", NULL);
  ctl->mixing_lat1 =
    scan_ctl(filename, argc, argv, "MIXING_LAT1", -1, "90", NULL);
  ctl->mixing_ny =
    (int) scan_ctl(filename, argc, argv, "MIXING_NY", -1, "180", NULL);
  if (ctl->mixing_nx < 1 || ctl->mixing_ny < 1 || ctl->mixing_nz < 1
      || ctl->mixing_lon0 >= ctl->mixing_lon1
      || ctl->mixing_lat0 >= ctl->mixing_lat1
      || ctl->mixing_z0 >= ctl->mixing_z1
      || ctl->mixing_lat0 < -90 || ctl->mixing_lat1 > 90)
    ERRMSG("Invalid mixing grid!");
  if ((ctl->mixing_tau_trop > 0) != (ctl->mixing_tau_strat > 0)
      || ctl->mixing_tau_trop == 0 || ctl->mixing_tau_strat == 0)
    ERRMSG("Mixing times must either both be positive or both be disabled!");
 
  /* Chemistry grid... */
  ctl->chemgrid_z0 =
    scan_ctl(filename, argc, argv, "CHEMGRID_Z0", -1, "-5", NULL);
  ctl->chemgrid_z1 =
    scan_ctl(filename, argc, argv, "CHEMGRID_Z1", -1, "85", NULL);
  ctl->chemgrid_nz =
    (int) scan_ctl(filename, argc, argv, "CHEMGRID_NZ", -1, "90", NULL);
  ctl->chemgrid_lon0 =
    scan_ctl(filename, argc, argv, "CHEMGRID_LON0", -1, "-180", NULL);
  ctl->chemgrid_lon1 =
    scan_ctl(filename, argc, argv, "CHEMGRID_LON1", -1, "180", NULL);
  ctl->chemgrid_nx =
    (int) scan_ctl(filename, argc, argv, "CHEMGRID_NX", -1, "360", NULL);
  ctl->chemgrid_lat0 =
    scan_ctl(filename, argc, argv, "CHEMGRID_LAT0", -1, "-90", NULL);
  ctl->chemgrid_lat1 =
    scan_ctl(filename, argc, argv, "CHEMGRID_LAT1", -1, "90", NULL);
  ctl->chemgrid_ny =
    (int) scan_ctl(filename, argc, argv, "CHEMGRID_NY", -1, "180", NULL);
  if (ctl->chemgrid_nx < 1 || ctl->chemgrid_ny < 1 || ctl->chemgrid_nz < 1
      || ctl->chemgrid_lon0 >= ctl->chemgrid_lon1
      || ctl->chemgrid_lat0 >= ctl->chemgrid_lat1
      || ctl->chemgrid_z0 >= ctl->chemgrid_z1
      || ctl->chemgrid_lat0 < -90 || ctl->chemgrid_lat1 > 90)
    ERRMSG("Invalid chemistry grid!");
 
  /* Exponential decay... */
  ctl->tdec_trop = scan_ctl(filename, argc, argv, "TDEC_TROP", -1, "0", NULL);
  ctl->tdec_strat =
    scan_ctl(filename, argc, argv, "TDEC_STRAT", -1, "0", NULL);
 
  /* PSC analysis... */
  ctl->psc_h2o = scan_ctl(filename, argc, argv, "PSC_H2O", -1, "4e-6", NULL);
  ctl->psc_hno3 =
    scan_ctl(filename, argc, argv, "PSC_HNO3", -1, "9e-9", NULL);
 
  /* Output of atmospheric data... */
  scan_ctl(filename, argc, argv, "ATM_BASENAME", -1, "-", ctl->atm_basename);
  scan_ctl(filename, argc, argv, "ATM_GPFILE", -1, "-", ctl->atm_gpfile);
  ctl->atm_dt_out =
    scan_ctl(filename, argc, argv, "ATM_DT_OUT", -1, "86400", NULL);
  ctl->atm_filter =
    (int) scan_ctl(filename, argc, argv, "ATM_FILTER", -1, "0", NULL);
  ctl->atm_stride =
    (int) scan_ctl(filename, argc, argv, "ATM_STRIDE", -1, "1", NULL);
  ctl->atm_type =
    (int) scan_ctl(filename, argc, argv, "ATM_TYPE", -1, "0", NULL);
  ctl->atm_type_out =
    (int) scan_ctl(filename, argc, argv, "ATM_TYPE_OUT", -1, "-1", NULL);
  if (ctl->atm_type_out == -1)
    ctl->atm_type_out = ctl->atm_type;
  ctl->atm_nc_level =
    (int) scan_ctl(filename, argc, argv, "ATM_NC_LEVEL", -1, "0", NULL);
  for (int iq = 0; iq < ctl->nq; iq++)
    ctl->atm_nc_quant[iq] =
      (int) scan_ctl(filename, argc, argv, "ATM_NC_QUANT", iq, "0", NULL);
  ctl->obs_type =
    (int) scan_ctl(filename, argc, argv, "OBS_TYPE", -1, "0", NULL);
 
  /* Output of mass budget data... */
  scan_ctl(filename, argc, argv, "BUDGET_BASENAME", -1, "-",
           ctl->budget_basename);
  ctl->budget_dt_out =
    scan_ctl(filename, argc, argv, "BUDGET_DT_OUT", -1, "86400", NULL);
  if (ctl->budget_basename[0] != '-' && ctl->budget_dt_out <= 0)
    ERRMSG("Invalid mass budget output settings!");
 
  /* Output of radioactive deposition data... */
  scan_ctl(filename, argc, argv, "DEPO_BASENAME", -1, "-",
           ctl->depo_basename);
  ctl->depo_dt_out =
    scan_ctl(filename, argc, argv, "DEPO_DT_OUT", -1, "86400", NULL);
  ctl->depo_type =
    (int) scan_ctl(filename, argc, argv, "DEPO_TYPE", -1, "0", NULL);
 
  /* Output of CSI data... */
  scan_ctl(filename, argc, argv, "CSI_BASENAME", -1, "-", ctl->csi_basename);
  scan_ctl(filename, argc, argv, "CSI_KERNEL", -1, "-", ctl->csi_kernel);
  ctl->csi_dt_out =
    scan_ctl(filename, argc, argv, "CSI_DT_OUT", -1, "86400", NULL);
  scan_ctl(filename, argc, argv, "CSI_OBSFILE", -1, "-", ctl->csi_obsfile);
  ctl->csi_obsmin =
    scan_ctl(filename, argc, argv, "CSI_OBSMIN", -1, "0", NULL);
  ctl->csi_modmin =
    scan_ctl(filename, argc, argv, "CSI_MODMIN", -1, "0", NULL);
  ctl->csi_z0 = scan_ctl(filename, argc, argv, "CSI_Z0", -1, "-5", NULL);
  ctl->csi_z1 = scan_ctl(filename, argc, argv, "CSI_Z1", -1, "85", NULL);
  ctl->csi_nz = (int) scan_ctl(filename, argc, argv, "CSI_NZ", -1, "1", NULL);
  ctl->csi_lon0 =
    scan_ctl(filename, argc, argv, "CSI_LON0", -1, "-180", NULL);
  ctl->csi_lon1 = scan_ctl(filename, argc, argv, "CSI_LON1", -1, "180", NULL);
  ctl->csi_nx =
    (int) scan_ctl(filename, argc, argv, "CSI_NX", -1, "360", NULL);
  ctl->csi_lat0 = scan_ctl(filename, argc, argv, "CSI_LAT0", -1, "-90", NULL);
  ctl->csi_lat1 = scan_ctl(filename, argc, argv, "CSI_LAT1", -1, "90", NULL);
  ctl->csi_ny =
    (int) scan_ctl(filename, argc, argv, "CSI_NY", -1, "180", NULL);
  if (ctl->csi_nx < 1 || ctl->csi_ny < 1 || ctl->csi_nz < 1
      || ctl->csi_lon0 >= ctl->csi_lon1
      || ctl->csi_lat0 >= ctl->csi_lat1 || ctl->csi_z0 >= ctl->csi_z1
      || ctl->csi_lat0 < -90 || ctl->csi_lat1 > 90)
    ERRMSG("Invalid CSI grid!");
 
  /* Output of ensemble data... */
  ctl->nens = (int) scan_ctl(filename, argc, argv, "NENS", -1, "0", NULL);
  if (ctl->nens < 0)
    ERRMSG("NENS must not be negative!");
  if (ctl->nens > 0 && ctl->qnt_ens < 0)
    ERRMSG("Add quantity ens for ensemble calculations!");
  scan_ctl(filename, argc, argv, "ENS_BASENAME", -1, "-", ctl->ens_basename);
  ctl->ens_dt_out =
    scan_ctl(filename, argc, argv, "ENS_DT_OUT", -1, "86400", NULL);
 
  /* Output of grid data... */
  scan_ctl(filename, argc, argv, "GRID_BASENAME", -1, "-",
           ctl->grid_basename);
  scan_ctl(filename, argc, argv, "GRID_KERNEL", -1, "-", ctl->grid_kernel);
  scan_ctl(filename, argc, argv, "GRID_GPFILE", -1, "-", ctl->grid_gpfile);
  ctl->grid_dt_out =
    scan_ctl(filename, argc, argv, "GRID_DT_OUT", -1, "86400", NULL);
  ctl->grid_sparse =
    (int) scan_ctl(filename, argc, argv, "GRID_SPARSE", -1, "0", NULL);
  ctl->grid_nc_level =
    (int) scan_ctl(filename, argc, argv, "GRID_NC_LEVEL", -1, "0", NULL);
  for (int iq = 0; iq < ctl->nq; iq++)
    ctl->grid_nc_quant[iq] =
      (int) scan_ctl(filename, argc, argv, "GRID_NC_QUANT", iq, "0", NULL);
  ctl->grid_stddev =
    (int) scan_ctl(filename, argc, argv, "GRID_STDDEV", -1, "0", NULL);
  ctl->grid_z0 = scan_ctl(filename, argc, argv, "GRID_Z0", -1, "-5", NULL);
  ctl->grid_z1 = scan_ctl(filename, argc, argv, "GRID_Z1", -1, "85", NULL);
  ctl->grid_nz =
    (int) scan_ctl(filename, argc, argv, "GRID_NZ", -1, "1", NULL);
  ctl->grid_lon0 =
    scan_ctl(filename, argc, argv, "GRID_LON0", -1, "-180", NULL);
  ctl->grid_lon1 =
    scan_ctl(filename, argc, argv, "GRID_LON1", -1, "180", NULL);
  ctl->grid_nx =
    (int) scan_ctl(filename, argc, argv, "GRID_NX", -1, "360", NULL);
  ctl->grid_lat0 =
    scan_ctl(filename, argc, argv, "GRID_LAT0", -1, "-90", NULL);
  ctl->grid_lat1 =
    scan_ctl(filename, argc, argv, "GRID_LAT1", -1, "90", NULL);
  ctl->grid_ny =
    (int) scan_ctl(filename, argc, argv, "GRID_NY", -1, "180", NULL);
  ctl->grid_type =
    (int) scan_ctl(filename, argc, argv, "GRID_TYPE", -1, "0", NULL);
  if (ctl->grid_nx < 1 || ctl->grid_nx > EX
      || ctl->grid_ny < 1 || ctl->grid_ny > EY || ctl->grid_nz < 1)
    ERRMSG("Invalid output grid dimensions!");
  if (ctl->grid_lon0 >= ctl->grid_lon1
      || ctl->grid_lat0 >= ctl->grid_lat1 || ctl->grid_z0 >= ctl->grid_z1
      || ctl->grid_lat0 < -90 || ctl->grid_lat1 > 90)
    ERRMSG("Invalid output grid boundaries!");
  if (ctl->depo_basename[0] != '-'
      && (ctl->depo_dt_out <= 0 || ctl->depo_type < 0 || ctl->depo_type > 1))
    ERRMSG("Invalid radioactive deposition output settings!");
 
  /* Output of profile data... */
  scan_ctl(filename, argc, argv, "PROF_BASENAME", -1, "-",
           ctl->prof_basename);
  scan_ctl(filename, argc, argv, "PROF_OBSFILE", -1, "-", ctl->prof_obsfile);
  ctl->prof_z0 = scan_ctl(filename, argc, argv, "PROF_Z0", -1, "0", NULL);
  ctl->prof_z1 = scan_ctl(filename, argc, argv, "PROF_Z1", -1, "60", NULL);
  ctl->prof_nz =
    (int) scan_ctl(filename, argc, argv, "PROF_NZ", -1, "60", NULL);
  ctl->prof_lon0 =
    scan_ctl(filename, argc, argv, "PROF_LON0", -1, "-180", NULL);
  ctl->prof_lon1 =
    scan_ctl(filename, argc, argv, "PROF_LON1", -1, "180", NULL);
  ctl->prof_nx =
    (int) scan_ctl(filename, argc, argv, "PROF_NX", -1, "360", NULL);
  ctl->prof_lat0 =
    scan_ctl(filename, argc, argv, "PROF_LAT0", -1, "-90", NULL);
  ctl->prof_lat1 =
    scan_ctl(filename, argc, argv, "PROF_LAT1", -1, "90", NULL);
  ctl->prof_ny =
    (int) scan_ctl(filename, argc, argv, "PROF_NY", -1, "180", NULL);
  if (ctl->prof_nx < 1 || ctl->prof_ny < 1 || ctl->prof_nz < 1
      || ctl->prof_lon0 >= ctl->prof_lon1
      || ctl->prof_lat0 >= ctl->prof_lat1 || ctl->prof_z0 >= ctl->prof_z1
      || ctl->prof_lat0 < -90 || ctl->prof_lat1 > 90)
    ERRMSG("Invalid profile grid!");
 
  /* Output of sample data... */
  scan_ctl(filename, argc, argv, "SAMPLE_BASENAME", -1, "-",
           ctl->sample_basename);
  scan_ctl(filename, argc, argv, "SAMPLE_KERNEL", -1, "-",
           ctl->sample_kernel);
  scan_ctl(filename, argc, argv, "SAMPLE_OBSFILE", -1, "-",
           ctl->sample_obsfile);
  ctl->sample_dx =
    scan_ctl(filename, argc, argv, "SAMPLE_DX", -1, "50", NULL);
  ctl->sample_dz =
    scan_ctl(filename, argc, argv, "SAMPLE_DZ", -1, "-999", NULL);
 
  /* Output of station data... */
  scan_ctl(filename, argc, argv, "STAT_BASENAME", -1, "-",
           ctl->stat_basename);
  ctl->stat_lon = scan_ctl(filename, argc, argv, "STAT_LON", -1, "0", NULL);
  ctl->stat_lat = scan_ctl(filename, argc, argv, "STAT_LAT", -1, "0", NULL);
  ctl->stat_r = scan_ctl(filename, argc, argv, "STAT_R", -1, "50", NULL);
  ctl->stat_t0 =
    scan_ctl(filename, argc, argv, "STAT_T0", -1, "-1e100", NULL);
  ctl->stat_t1 = scan_ctl(filename, argc, argv, "STAT_T1", -1, "1e100", NULL);
 
  /* Output of VTK data... */
  scan_ctl(filename, argc, argv, "VTK_BASENAME", -1, "-", ctl->vtk_basename);
  ctl->vtk_dt_out =
    scan_ctl(filename, argc, argv, "VTK_DT_OUT", -1, "86400", NULL);
  ctl->vtk_stride =
    (int) scan_ctl(filename, argc, argv, "VTK_STRIDE", -1, "1", NULL);
  ctl->vtk_scale =
    scan_ctl(filename, argc, argv, "VTK_SCALE", -1, "1.0", NULL);
  ctl->vtk_offset =
    scan_ctl(filename, argc, argv, "VTK_OFFSET", -1, "0.0", NULL);
  ctl->vtk_sphere =
    (int) scan_ctl(filename, argc, argv, "VTK_SPHERE", -1, "0", NULL);
 
  /* Domain decomposition... */
 
  /* Only the trac tool sets this flag after reading the control parameters... */
  ctl->dd_supported = 0;
#ifdef DD
  /* Domain decomposition is only implemented by the trac tool and only works
     if the executable was started with one task per subdomain. Therefore, use
     it by default only if MPI has been initialized by the calling tool and if
     more than one task is running; otherwise, stay in serial mode. */
  int mpi_initialized = 0;
  int mpi_size = 1;
  MPI_Initialized(&mpi_initialized);
  if (mpi_initialized)
    MPI_Comm_size(MPI_COMM_WORLD, &mpi_size);
  ctl->dd =
    (int) scan_ctl(filename, argc, argv, "DD", -1,
                   (mpi_initialized && mpi_size > 1) ? "1" : "0", NULL);
#else
  ctl->dd = (int) scan_ctl(filename, argc, argv, "DD", -1, "0", NULL);
#endif
 
  ctl->dd_subdomains_meridional =
    (int) scan_ctl(filename, argc, argv, "DD_SUBDOMAINS_MERIDIONAL", -1,
                   (ctl->dd == 1) ? "2" : "1", NULL);
  ctl->dd_subdomains_zonal =
    (int) scan_ctl(filename, argc, argv, "DD_SUBDOMAINS_ZONAL", -1,
                   (ctl->dd == 1) ? "2" : "1", NULL);
  ctl->dd_halos_size =
    (int) scan_ctl(filename, argc, argv, "DD_HALOS_SIZE", -1, "1", NULL);
  ctl->dd_sort_dt =
    (double) scan_ctl(filename, argc, argv, "DD_SORT_DT", -1, "1800", NULL);
  ctl->dd_exchange_mode =
    (int) scan_ctl(filename, argc, argv, "DD_EXCHANGE_MODE", -1, "0", NULL);
  if (ctl->dd_exchange_mode < 0 || ctl->dd_exchange_mode > 1)
    ERRMSG("Set DD_EXCHANGE_MODE to 0 (sort/push) or 1 (no sort)!");
  if (ctl->met_nc_read_mode == 1 &&
      (!ctl->dd || ctl->met_type != 0 || ctl->met_convention != 0))
    ERRMSG("MET_NC_READ_MODE=1 requires MPI DD, NetCDF, and MET_CONVENTION=0!");
#ifndef DD
  if (ctl->met_nc_read_mode == 1)
    ERRMSG("MET_NC_READ_MODE=1 requires a DD build!");
#endif
 
#ifdef DD
  /* Check the domain decomposition configuration... */
  if (ctl->dd) {
    if (!mpi_initialized)
      ERRMSG
        ("Domain decomposition requires to start the executable with one task per subdomain!");
    if (ctl->dd_halos_size < 0)
      ERRMSG("DD_HALOS_SIZE must be non-negative!");
    if (ctl->dd_subdomains_zonal < 1 || ctl->dd_subdomains_meridional < 1)
      ERRMSG("The number of subdomains has to be positive!");
    if (ctl->dd_subdomains_zonal * ctl->dd_subdomains_meridional == 1)
      ERRMSG("Please provide zonal and meridional subdomain numbers!");
    if (mpi_size != ctl->dd_subdomains_zonal * ctl->dd_subdomains_meridional)
      ERRMSG("Number of tasks and subdomains is not identical!");
    if (ctl->qnt_current_subdomain < 0 || ctl->qnt_target_subdomain < 0)
      ERRMSG
        ("Domain decomposition requires the quantities current_subdomain and target_subdomain!");
    if (ctl->met_coord_type != 0)
      ERRMSG("Domain decomposition requires a lat/lon meteorological grid!");
    if (ctl->radio_depo)
      ERRMSG
        ("Radioactive deposition is not supported with domain decomposition!");
  }
#endif
}
 
/*****************************************************************************/
 
int mptrac_read_met(
  const char *filename,
  const ctl_t *ctl,
  const clim_t *clim,
  met_t *met,
  dd_t *dd) {
 
  /* Write info... */
  LOG(1, "Read meteo data: %s", filename);
 
#ifdef DD
  /* With domain decomposition, each task reads the meteo data of its own
     subdomain only, which is not what the tools operating on the full meteo
     grid expect... */
  if (ctl->dd && !ctl->dd_supported)
    ERRMSG("The domain decomposition is only implemented by the trac tool!");
#endif
 
  /* Set rank... */
  int rank = 0;
 
  /* Check whether the meteo data is shared between the tasks... */
  int share = ctl->met_mpi_share;
#ifdef MPI
  /* Sharing the meteo data between the tasks requires to start the executable
     with a parallel launcher. If MPI has not been initialized, the meteo data
     is read by the single task itself... */
  int mpi_initialized = 0;
  MPI_Initialized(&mpi_initialized);
  if (share && !mpi_initialized) {
    WARN("Cannot share meteo data because MPI has not been initialized!");
    share = 0;
  }
  if (share)
    MPI_Comm_rank(MPI_COMM_WORLD, &rank);
#endif
 
  /* Check rank... */
  if (!share || rank == 0) {
 
    /* Read netCDF data... */
    if (ctl->met_type == 0) {
      if (read_met_nc(filename, ctl, met, dd) != 1)
        return 0;
    }
 
    /* Read binary data... */
    else if ((ctl->met_type >= 1 && ctl->met_type <= 5)
             || ctl->met_type == 7 || ctl->met_type == 8) {
      if (read_met_bin(filename, ctl, met) != 1)
        return 0;
    }
#ifdef ECCODES
    /* Read grib data... */
    else if (ctl->met_type == 6) {
      if (read_met_grib(filename, ctl, met) != 1)
        return 0;
    }
#endif
 
    /* Not implemented... */
    else
      ERRMSG("MET_TYPE not implemented!");
 
    /* Preprocessing for netCDF and grib files... */
    if (ctl->met_type == 0 || ctl->met_type == 6) {
 
      /* Extrapolate data for lower boundary... */
      read_met_extrapolate(met);
 
      /* Fix polar winds... */
      read_met_polar_winds(met);
 
      /* Create periodic boundary conditions... */
#ifdef DD
      /* Zonal DD halos provide periodic boundaries only when there is more
         than one zonal subdomain. With a single zonal subdomain, append the
         periodic endpoint locally as in a run without DD. */
      if (!ctl->dd || ctl->dd_subdomains_zonal == 1)
        read_met_periodic(met);
#else
      read_met_periodic(met);
#endif
 
      /* Downsampling... */
      read_met_sample(ctl, met);
 
      /* Calculate geopotential heights... */
      read_met_geopot(ctl, met);
 
      /* Calculate potential vorticity... */
      read_met_pv(met);
 
      /* Calculate boundary layer data... */
      read_met_pbl(ctl, met);
 
      /* Calculate tropopause data... */
      read_met_tropo(ctl, clim, met);
 
      /* Calculate cloud properties... */
      read_met_cloud(met);
 
      /* Calculate convective available potential energy... */
      read_met_cape(ctl, clim, met);
 
      /* Calculate total column ozone... */
      read_met_ozone(met);
 
      /* Detrending... */
      read_met_detrend(ctl, met);
 
      /* Check meteo data and smooth zeta profiles ... */
      read_met_monotonize(ctl, met);
    }
  }
 
  /* Broadcast data via MPI... */
#ifdef MPI
  if (share) {
 
    /* Set timer... */
    SELECT_TIMER("READ_MET_MPI_BCAST", "COMM");
    LOG(2, "Broadcast data on rank %d...", rank);
 
    /* Broadcast... */
    broadcast_large_data(met, sizeof(met_t));
  }
#endif
 
  /* Return success... */
  return 1;
}
 
/*****************************************************************************/
 
void mptrac_run_timestep(
  ctl_t *ctl,
  cache_t *cache,
  clim_t *clim,
  met_t **met0,
  met_t **met1,
  atm_t *atm,
  depo_t *depo,
  double t,
  dd_t *dd) {
 
  /* Initialize modules... */
  if (t == ctl->t_start) {
 
    /* Initialize isosurface data... */
    if (ctl->isosurf >= 1 && ctl->isosurf <= 4)
      module_isosurf_init(ctl, cache, *met0, *met1, atm);
 
    /* Initialize advection... */
    module_advect_init(ctl, cache, *met0, *met1, atm);
 
    /* Initialize chemistry... */
    module_chem_init(ctl, cache, clim, *met0, *met1, atm);
  }
 
  /* Set time steps of air parcels... */
  module_timesteps(ctl, cache, *met0, atm, t);
 
  /* Sort particles... */
  if (!(ctl->dd && ctl->dd_exchange_mode == 1)
      && ctl->sort_dt > 0 && fmod(t, ctl->sort_dt) == 0)
    module_sort(ctl, *met0, cache, atm);
 
  /* Check positions (initial)... */
  module_position(cache, *met0, *met1, atm, 0);
 
  /* Advection... */
  if (ctl->advect > 0)
    module_advect(ctl, cache, *met0, *met1, atm);
 
  /* Turbulent diffusion... */
  if (ctl->diffusion
      && (ctl->turb_dx_pbl > 0 || ctl->turb_dz_pbl > 0
          || ctl->turb_dx_trop > 0 || ctl->turb_dz_trop > 0
          || ctl->turb_dx_strat > 0 || ctl->turb_dz_strat > 0))
    module_diff_turb(ctl, cache, clim, *met0, *met1, atm);
 
  /* Optional PBL-specific diffusion scheme... */
  if (ctl->diffusion && ctl->turb_pbl_scheme == 1)
    module_diff_pbl(ctl, cache, *met0, *met1, atm);
 
  /* Mesoscale diffusion... */
  if (ctl->diffusion && (ctl->turb_mesox > 0 || ctl->turb_mesoz > 0))
    module_diff_meso(ctl, cache, *met0, *met1, atm);
 
  /* Convection... */
  if ((ctl->conv_mix_pbl || ctl->conv_cape >= 0)
      && (ctl->conv_dt <= 0 || fmod(t, ctl->conv_dt) == 0))
    module_convection(ctl, cache, *met0, *met1, atm);
 
  /* Sedimentation... */
  if (ctl->qnt_rp >= 0 && ctl->qnt_rhop >= 0)
    module_sedi(ctl, cache, *met0, *met1, atm);
 
  /* Isosurface... */
  if (ctl->isosurf >= 1 && ctl->isosurf <= 4)
    module_isosurf(ctl, cache, *met0, *met1, atm);
 
  /* Check positions (final)... */
  module_position(cache, *met0, *met1, atm, 1);
 
  /* Interpolate meteo data... */
  if (ctl->met_dt_out > 0
      && (ctl->met_dt_out < ctl->dt_mod || fmod(t, ctl->met_dt_out) == 0))
    module_meteo(ctl, cache, clim, *met0, *met1, atm);
 
  /* Check boundary conditions (initial)... */
  if ((ctl->bound_lat0 < ctl->bound_lat1)
      && (ctl->bound_p0 > ctl->bound_p1))
    module_bound_cond(ctl, cache, clim, *met0, *met1, atm);
 
  /* Initialize quantity of total loss rate... */
  if (ctl->qnt_loss_rate >= 0) {
    PARTICLE_LOOP(0, atm->np, 1, "acc data present(ctl,atm)") {
      atm->q[ctl->qnt_loss_rate][ip] = 0;
    }
  }
 
  /* Decay of particle mass... */
  if (ctl->tdec_trop > 0 && ctl->tdec_strat > 0)
    module_decay(ctl, cache, clim, atm);
 
  /* Interparcel mixing... */
  if (ctl->mixing_tau_trop > 0 && ctl->mixing_tau_strat > 0
      && (ctl->mixing_dt <= 0 || fmod(t, ctl->mixing_dt) == 0))
    module_mixing(ctl, clim, atm, t);
 
  /* Calculate the tracer vmr in the chemistry grid... */
  if (ctl->oh_chem_reaction != 0 || ctl->h2o2_chem_reaction != 0
      || (ctl->kpp_chem && fmod(t, ctl->dt_kpp) == 0))
    module_chem_grid(ctl, *met0, *met1, atm, t);
 
  /* OH chemistry... */
  if (ctl->oh_chem_reaction != 0)
    module_oh_chem(ctl, cache, clim, *met0, *met1, atm);
 
  /* H2O2 chemistry (for SO2 aqueous phase oxidation)... */
  if (ctl->h2o2_chem_reaction != 0)
    module_h2o2_chem(ctl, cache, clim, *met0, *met1, atm);
 
  /* First-order tracer chemistry... */
  if (ctl->tracer_chem)
    module_tracer_chem(ctl, cache, clim, *met0, *met1, atm);
 
  /* Radioactive decay... */
  if (ctl->radio_decay)
    module_radio_decay(ctl, cache, atm);
 
  /* Domain decomposition... */
#ifdef DD
  if (ctl->dd)
    module_dd(t, ctl, cache, dd, atm, met0);
#else
  (void) dd;
#endif
 
  /* Radioactive deposition... */
  if (ctl->radio_depo)
    module_radio_depo(ctl, cache, *met0, *met1, atm, depo);
 
  /* KPP chemistry... */
  if (ctl->kpp_chem && fmod(t, ctl->dt_kpp) == 0) {
#ifdef KPP
    module_kpp_chem(ctl, cache, clim, *met0, *met1, atm);
#else
    ERRMSG("Code was compiled without KPP!");
#endif
  }
 
  /* Wet deposition... */
  if ((ctl->wet_depo_ic_a > 0 || ctl->wet_depo_ic_h[0] > 0)
      && (ctl->wet_depo_bc_a > 0 || ctl->wet_depo_bc_h[0] > 0))
    module_wet_depo(ctl, cache, *met0, *met1, atm);
 
  /* Dry deposition... */
  if (ctl->dry_depo_vdep > 0)
    module_dry_depo(ctl, cache, *met0, *met1, atm);
 
  /* Check boundary conditions (final)... */
  if ((ctl->bound_lat0 < ctl->bound_lat1)
      && (ctl->bound_p0 > ctl->bound_p1))
    module_bound_cond(ctl, cache, clim, *met0, *met1, atm);
}
 
/*****************************************************************************/
 
void mptrac_update_device(
  const ctl_t *ctl,
  const cache_t *cache,
  const clim_t *clim,
  met_t **met0,
  met_t **met1,
  const atm_t *atm) {
 
  /* Update GPU... */
  if (ctl != NULL) {
#ifdef _OPENACC
    SELECT_TIMER("UPDATE_DEVICE", "MEMORY");
#pragma acc update device(ctl[:1])
#endif
  }
 
  if (cache != NULL) {
#ifdef _OPENACC
    SELECT_TIMER("UPDATE_DEVICE", "MEMORY");
#pragma acc update device(cache[:1])
#endif
  }
 
  if (clim != NULL) {
#ifdef _OPENACC
    SELECT_TIMER("UPDATE_DEVICE", "MEMORY");
#pragma acc update device(clim[:1])
#endif
  }
 
  if (met0 != NULL) {
#ifdef _OPENACC
    SELECT_TIMER("UPDATE_DEVICE", "MEMORY");
    met_t *met0up = *met0;
#pragma acc update device(met0up[:1])
#endif
  }
 
  if (met1 != NULL) {
#ifdef _OPENACC
    SELECT_TIMER("UPDATE_DEVICE", "MEMORY");
    met_t *met1up = *met1;
#pragma acc update device(met1up[:1])
#endif
  }
 
  if (atm != NULL) {
#ifdef _OPENACC
    SELECT_TIMER("UPDATE_DEVICE", "MEMORY");
#pragma acc update device(atm[:1])
#endif
  }
}
 
/*****************************************************************************/
 
void mptrac_update_host(
  const ctl_t *ctl,
  const cache_t *cache,
  const clim_t *clim,
  met_t **met0,
  met_t **met1,
  const atm_t *atm) {
 
  /* Update GPU... */
  if (ctl != NULL) {
#ifdef _OPENACC
    SELECT_TIMER("UPDATE_HOST", "MEMORY");
#pragma acc update host(ctl[:1])
#endif
  }
 
  if (cache != NULL) {
#ifdef _OPENACC
    SELECT_TIMER("UPDATE_HOST", "MEMORY");
#pragma acc update host(cache[:1])
#endif
  }
 
  if (clim != NULL) {
#ifdef _OPENACC
    SELECT_TIMER("UPDATE_HOST", "MEMORY");
#pragma acc update host(clim[:1])
#endif
  }
 
  if (met0 != NULL) {
#ifdef _OPENACC
    SELECT_TIMER("UPDATE_HOST", "MEMORY");
    met_t *met0up = *met0;
#pragma acc update host(met0up[:1])
#endif
  }
 
  if (met1 != NULL) {
#ifdef _OPENACC
    SELECT_TIMER("UPDATE_HOST", "MEMORY");
    met_t *met1up = *met1;
#pragma acc update host(met1up[:1])
#endif
  }
 
  if (atm != NULL) {
#ifdef _OPENACC
    SELECT_TIMER("UPDATE_HOST", "MEMORY");
#pragma acc update host(atm[:1])
#endif
  }
}
 
/*****************************************************************************/
 
void mptrac_write_atm(
  const char *filename,
  const ctl_t *ctl,
  const atm_t *atm,
  const double t) {
 
  /* Set timer... */
  SELECT_TIMER("WRITE_ATM", "OUTPUT");
 
  /* Write info... */
  LOG(1, "Write atmospheric data: %s", filename);
 
  /* Write ASCII data... */
  if (ctl->atm_type_out == 0)
    write_atm_asc(filename, ctl, atm, t);
 
  /* Write binary data... */
  else if (ctl->atm_type_out == 1)
    write_atm_bin(filename, ctl, atm);
 
  /* Write netCDF data... */
  else if (ctl->atm_type_out == 2)
    write_atm_nc(filename, ctl, atm);
 
  /* Write CLaMS trajectory data... */
  else if (ctl->atm_type_out == 3)
    write_atm_clams_traj(filename, ctl, atm, t);
 
  /* Write CLaMS pos data... */
  else if (ctl->atm_type_out == 4)
    write_atm_clams(filename, ctl, atm);
 
  /* Error... */
  else
    ERRMSG("Atmospheric data type not supported!");
 
  /* Write info... */
  double mini, maxi;
  LOG(2, "Number of particles: %d", atm->np);
  gsl_stats_minmax(&mini, &maxi, atm->time, 1, (size_t) atm->np);
  LOG(2, "Time range: %.2f ... %.2f s", mini, maxi);
  gsl_stats_minmax(&mini, &maxi, atm->p, 1, (size_t) atm->np);
  LOG(2, "Altitude range: %g ... %g km", Z(maxi), Z(mini));
  LOG(2, "Pressure range: %g ... %g hPa", maxi, mini);
  gsl_stats_minmax(&mini, &maxi, atm->lon, 1, (size_t) atm->np);
  LOG(2, "%s range: %g ... %g %s",
      ctl->met_coord_type == 0 ? "Longitude" : "X coordinate", mini, maxi,
      ctl->met_coord_type == 0 ? "deg" : "m");
  gsl_stats_minmax(&mini, &maxi, atm->lat, 1, (size_t) atm->np);
  LOG(2, "%s range: %g ... %g %s",
      ctl->met_coord_type == 0 ? "Latitude" : "Y coordinate", mini, maxi,
      ctl->met_coord_type == 0 ? "deg" : "m");
  for (int iq = 0; iq < ctl->nq; iq++) {
    char msg[5 * LEN];
    sprintf(msg, "Quantity %s range: %s ... %s %s",
            ctl->qnt_name[iq], ctl->qnt_format[iq],
            ctl->qnt_format[iq], ctl->qnt_unit[iq]);
    gsl_stats_minmax(&mini, &maxi, atm->q[iq], 1, (size_t) atm->np);
    LOG(2, msg, mini, maxi);
  }
}
 
/*****************************************************************************/
 
void mptrac_write_met(
  const char *filename,
  const ctl_t *ctl,
  met_t *met) {
 
  /* Set timer... */
  SELECT_TIMER("WRITE_MET", "OUTPUT");
 
  /* Write info... */
  LOG(1, "Write meteo data: %s", filename);
 
  /* Check compression flags... */
#ifndef ZFP
  if (ctl->met_type == 3)
    ERRMSG("MPTRAC was compiled without ZFP compression!");
#endif
#ifndef ZSTD
  if (ctl->met_type == 4)
    ERRMSG("MPTRAC was compiled without ZSTD compression!");
#endif
#ifndef LZ4
  if (ctl->met_type == 8)
    ERRMSG("MPTRAC was compiled without LZ4 compression!");
#endif
#ifndef CMS
  if (ctl->met_type == 5)
    ERRMSG("MPTRAC was compiled without cmultiscale compression!");
#endif
#ifndef SZ3
  if (ctl->met_type == 7)
    ERRMSG("MPTRAC was compiled without SZ3 compression!");
#endif
 
  /* Write netCDF data... */
  if (ctl->met_type == 0)
    write_met_nc(filename, ctl, met);
 
  /* Write binary data... */
  else if ((ctl->met_type >= 1 && ctl->met_type <= 5)
           || ctl->met_type == 7 || ctl->met_type == 8)
    write_met_bin(filename, ctl, met);
 
  /* Not implemented... */
  else
    ERRMSG("MET_TYPE not implemented!");
}
 
/*****************************************************************************/
 
void mptrac_write_output(
  const char *dirname,
  const ctl_t *ctl,
  met_t *met0,
  met_t *met1,
  atm_t *atm,
  depo_t *depo,
  const double t) {
 
  char ext[10], filename[2 * LEN];
 
  double r;
 
  int year, mon, day, hour, min, sec;
 
  /* Get time... */
  jsec2time(t, &year, &mon, &day, &hour, &min, &sec, &r);
 
  /* Decide which particle outputs are due, including the final step... */
  const int final = (t == ctl->t_stop);
  const int output_atm = ctl->atm_basename[0] != '-'
    && (fmod(t, ctl->atm_dt_out) == 0 || final);
  const int output_grid = ctl->grid_basename[0] != '-'
    && (fmod(t, ctl->grid_dt_out) == 0 || final);
  const int output_budget = ctl->budget_basename[0] != '-'
    && (fmod(t, ctl->budget_dt_out) == 0 || final);
  const int output_depo = ctl->depo_basename[0] != '-'
    && (fmod(t, ctl->depo_dt_out) == 0 || final);
  const int output_ens = ctl->ens_basename[0] != '-'
    && (fmod(t, ctl->ens_dt_out) == 0 || final);
  const int output_vtk = ctl->vtk_basename[0] != '-'
    && (fmod(t, ctl->vtk_dt_out) == 0 || final);
 
  /* Update host... */
  if (output_atm || output_grid || output_budget || output_ens || output_vtk
      || ctl->csi_basename[0] != '-' || ctl->prof_basename[0] != '-'
      || ctl->sample_basename[0] != '-' || ctl->stat_basename[0] != '-')
    mptrac_update_host(NULL, NULL, NULL, NULL, NULL, atm);
 
  /* Write atmospheric data... */
  if (output_atm) {
    if (ctl->atm_type_out == 0)
      sprintf(ext, "tab");
    else if (ctl->atm_type_out == 1)
      sprintf(ext, "bin");
    else if (ctl->atm_type_out >= 2)
      sprintf(ext, "nc");
    sprintf(filename, "%s/%s_%04d_%02d_%02d_%02d_%02d_%02d.%s",
            dirname, ctl->atm_basename, year, mon, day, hour, min, sec, ext);
    mptrac_write_atm(filename, ctl, atm, t);
  }
 
  /* Write gridded data... */
  if (output_grid) {
    sprintf(filename, "%s/%s_%04d_%02d_%02d_%02d_%02d_%02d.%s",
            dirname, ctl->grid_basename, year, mon, day, hour, min, sec,
            ctl->grid_type == 0 ? "tab" : "nc");
    write_grid(filename, ctl, met0, met1, atm, t);
  }
 
  /* Write mass budget data... */
  if (output_budget) {
    sprintf(filename, "%s/%s.tab", dirname, ctl->budget_basename);
    write_budget(filename, ctl, atm, t);
  }
 
  /* Write radioactive deposition data... */
  if (output_depo) {
#ifdef _OPENACC
#pragma acc update host(depo[:1])
#endif
    sprintf(filename, "%s/%s_%04d_%02d_%02d_%02d_%02d_%02d.%s",
            dirname, ctl->depo_basename, year, mon, day, hour, min, sec,
            ctl->depo_type == 0 ? "tab" : "nc");
    write_depo(filename, ctl, depo, t);
  }
 
  /* Write CSI data... */
  if (ctl->csi_basename[0] != '-') {
    sprintf(filename, "%s/%s.tab", dirname, ctl->csi_basename);
    write_csi(filename, ctl, atm, t);
  }
 
  /* Write ensemble data... */
  if (output_ens) {
    sprintf(filename, "%s/%s_%04d_%02d_%02d_%02d_%02d_%02d.tab",
            dirname, ctl->ens_basename, year, mon, day, hour, min, sec);
    write_ens(filename, ctl, atm, t);
  }
 
  /* Write profile data... */
  if (ctl->prof_basename[0] != '-') {
    sprintf(filename, "%s/%s.tab", dirname, ctl->prof_basename);
    write_prof(filename, ctl, met0, met1, atm, t);
  }
 
  /* Write sample data... */
  if (ctl->sample_basename[0] != '-') {
    sprintf(filename, "%s/%s.tab", dirname, ctl->sample_basename);
    write_sample(filename, ctl, met0, met1, atm, t);
  }
 
  /* Write station data... */
  if (ctl->stat_basename[0] != '-') {
    sprintf(filename, "%s/%s.tab", dirname, ctl->stat_basename);
    write_station(filename, ctl, atm, t);
  }
 
  /* Write VTK data... */
  if (output_vtk) {
    static int nvtk;
    if (t == ctl->t_start)
      nvtk = 0;
    sprintf(filename, "%s/%s_%05d.vtk", dirname, ctl->vtk_basename, ++nvtk);
    write_vtk(filename, ctl, atm, t);
  }
}
 
/*****************************************************************************/
 
double nat_temperature(
  const double p,
  const double h2o,
  const double hno3) {
 
  /* Check water vapor volume mixing ratio... */
  const double h2o_help = MAX(h2o, 0.1e-6);
 
  /* Calculate T_NAT... */
  const double p_hno3 = hno3 * p / 1.333224;
  const double p_h2o = h2o_help * p / 1.333224;
  const double a = 0.009179 - 0.00088 * log10(p_h2o);
  const double b = (38.9855 - log10(p_hno3) - 2.7836 * log10(p_h2o)) / a;
  const double c = -11397.0 / a;
  double tnat = (-b + sqrt(b * b - 4. * c)) / 2.;
  double x2 = (-b - sqrt(b * b - 4. * c)) / 2.;
  if (x2 > 0)
    tnat = x2;
 
  return tnat;
}
 
/*****************************************************************************/
 
double pbl_weight(
  const ctl_t *ctl,
  const atm_t *atm,
  const int ip,
  const double pbl,
  const double ps) {
 
  /* Get pressure range... */
  const double p1 = pbl - ctl->turb_pbl_trans * (ps - pbl);
  const double p0 = pbl;
 
  /* Get weighting factor... */
  if (atm->p[ip] > p0)
    return 1;
  else if (atm->p[ip] < p1)
    return 0;
  else
    return LIN(p0, 1.0, p1, 0.0, atm->p[ip]);
}
 
/*****************************************************************************/
 
int read_atm_asc(
  const char *filename,
  const ctl_t *ctl,
  atm_t *atm) {
 
  /* Open file... */
  FILE *in;
  if (!(in = fopen(filename, "r"))) {
    WARN("Cannot open file!");
    return 0;
  }
 
  /* Read line... */
  char line[LEN];
  while (fgets(line, LEN, in)) {
 
    /* Read data... */
    char *tok;
    TOK(line, tok, "%lg", atm->time[atm->np]);
    TOK(NULL, tok, "%lg", atm->p[atm->np]);
    TOK(NULL, tok, "%lg", atm->lon[atm->np]);
    TOK(NULL, tok, "%lg", atm->lat[atm->np]);
    for (int iq = 0; iq < ctl->nq; iq++)
      TOK(NULL, tok, "%lg", atm->q[iq][atm->np]);
 
    /* Convert altitude to pressure... */
    atm->p[atm->np] = P(atm->p[atm->np]);
 
    /* Increment data point counter... */
    if ((++atm->np) > NP)
      ERRMSG("Too many data points!");
  }
 
  /* Close file... */
  fclose(in);
 
  /* Return success... */
  return 1;
}
 
/*****************************************************************************/
 
int read_atm_bin(
  const char *filename,
  const ctl_t *ctl,
  atm_t *atm) {
 
  /* Open file... */
  FILE *in;
  if (!(in = fopen(filename, "r")))
    return 0;
 
  /* Check version of binary data... */
  int version;
  FREAD(&version, int,
        1,
        in);
  if (version != 100)
    ERRMSG("Wrong version of binary data!");
 
  /* Read data... */
  FREAD(&atm->np, int,
        1,
        in);
  FREAD(atm->time, double,
          (size_t) atm->np,
        in);
  FREAD(atm->p, double,
          (size_t) atm->np,
        in);
  FREAD(atm->lon, double,
          (size_t) atm->np,
        in);
  FREAD(atm->lat, double,
          (size_t) atm->np,
        in);
  for (int iq = 0; iq < ctl->nq; iq++)
    FREAD(atm->q[iq], double,
            (size_t) atm->np,
          in);
 
  /* Read final flag... */
  int final;
  FREAD(&final, int,
        1,
        in);
  if (final != 999)
    ERRMSG("Error while reading binary data!");
 
  /* Close file... */
  fclose(in);
 
  /* Return success... */
  return 1;
}
 
/*****************************************************************************/
 
int read_atm_clams(
  const char *filename,
  const ctl_t *ctl,
  atm_t *atm) {
 
  if (ctl->met_coord_type != 0)
    ERRMSG("CLaMS atmospheric files support only lat/lon grids");
 
  int ncid, varid;
 
  /* Open file... */
  if (nc_open(filename, NC_NOWRITE, &ncid) != NC_NOERR)
    return 0;
 
  /* Get dimensions... */
  NC_INQ_DIM("NPARTS", &atm->np, 1, NP, 1);
 
  /* Get time... */
  if (nc_inq_varid(ncid, "TIME_INIT", &varid) == NC_NOERR) {
    NC(nc_get_var_double(ncid, varid, atm->time));
  } else {
    WARN("TIME_INIT not found use time instead!");
    double time_init;
    NC_GET_DOUBLE("time", &time_init, 1);
    for (int ip = 0; ip < atm->np; ip++) {
      atm->time[ip] = time_init;
    }
  }
 
  /* Read zeta coordinate, pressure is optional... */
  if (ctl->advect_vert_coord == 1) {
    NC_GET_DOUBLE("ZETA", atm->q[ctl->qnt_zeta], 1);
    NC_GET_DOUBLE("PRESS", atm->p, 0);
  }
 
  /* Read pressure, zeta coordinate is optional... */
  else {
    if (nc_inq_varid(ncid, "PRESS_INIT", &varid) == NC_NOERR) {
      NC(nc_get_var_double(ncid, varid, atm->p));
    } else {
      WARN("PRESS_INIT not found use PRESS instead!");
      nc_inq_varid(ncid, "PRESS", &varid);
      NC(nc_get_var_double(ncid, varid, atm->p));
    }
  }
 
  /* Read further quantities if requested... */
  for (int iq = 0; iq < ctl->nq; iq++)
    NC_GET_DOUBLE(ctl->qnt_name[iq], atm->q[iq], 0);
 
  /* Read longitude and latitude... */
  NC_GET_DOUBLE("LON", atm->lon, 1);
  NC_GET_DOUBLE("LAT", atm->lat, 1);
 
  /* Close file... */
  NC(nc_close(ncid));
 
  /* Return success... */
  return 1;
}
 
/*****************************************************************************/
 
int read_atm_nc(
  const char *filename,
  const ctl_t *ctl,
  atm_t *atm) {
 
  int ncid, varid;
 
  /* Open file... */
  if (nc_open(filename, NC_NOWRITE, &ncid) != NC_NOERR)
    return 0;
 
  /* Get dimensions... */
  NC_INQ_DIM("obs", &atm->np, 1, NP, 1);
 
  /* Read geolocations... */
  NC_GET_DOUBLE("time", atm->time, 1);
  NC_GET_DOUBLE("press", atm->p, 1);
  NC_GET_DOUBLE("lon", atm->lon, 1);
  NC_GET_DOUBLE("lat", atm->lat, 1);
 
  /* Read variables... */
  for (int iq = 0; iq < ctl->nq; iq++)
    NC_GET_DOUBLE(ctl->qnt_name[iq], atm->q[iq], 0);
 
  /* Close file... */
  NC(nc_close(ncid));
 
  /* Return success... */
  return 1;
}
 
/*****************************************************************************/
 
void read_clim_photo(
  const char *filename,
  clim_photo_t *photo) {
 
  int ncid, varid;
 
  /* Write info... */
  LOG(1, "Read photolysis rates: %s", filename);
 
  /* Open netCDF file... */
  if (nc_open(filename, NC_NOWRITE, &ncid) != NC_NOERR) {
    WARN("Photolysis rate data are missing!");
    return;
  }
 
  /* Read pressure data... */
  NC_INQ_DIM("press", &photo->np, 2, CP, 1);
  NC_GET_DOUBLE("press", photo->p, 1);
  if (photo->p[0] < photo->p[1])
    ERRMSG("Pressure data are not descending!");
 
  /* Read total column ozone data... */
  NC_INQ_DIM("total_o3col", &photo->no3c, 2, CO3, 1);
  NC_GET_DOUBLE("total_o3col", photo->o3c, 1);
  if (photo->o3c[0] > photo->o3c[1])
    ERRMSG("Total column ozone data are not ascending!");
 
  /* Read solar zenith angle data... */
  NC_INQ_DIM("sza", &photo->nsza, 2, CSZA, 1);
  NC_GET_DOUBLE("sza", photo->sza, 1);
  if (photo->sza[0] > photo->sza[1])
    ERRMSG("Solar zenith angle data are not ascending!");
 
  /* Read data... */
  read_clim_photo_help(ncid, "J_N2O", photo, photo->n2o);
  read_clim_photo_help(ncid, "J_CCl4", photo, photo->ccl4);
  read_clim_photo_help(ncid, "J_CFC-11", photo, photo->ccl3f);
  read_clim_photo_help(ncid, "J_CFC-12", photo, photo->ccl2f2);
  read_clim_photo_help(ncid, "J_O2", photo, photo->o2);
  read_clim_photo_help(ncid, "J_O3b", photo, photo->o3_1);
  read_clim_photo_help(ncid, "J_O3a", photo, photo->o3_2);
  read_clim_photo_help(ncid, "J_H2O2", photo, photo->h2o2);
  read_clim_photo_help(ncid, "J_H2O", photo, photo->h2o);
 
  /* Close netCDF file... */
  NC(nc_close(ncid));
 
  /* Write info... */
  LOG(2, "Number of pressure levels: %d", photo->np);
  LOG(2, "Altitude levels: %g, %g ... %g km",
      Z(photo->p[0]), Z(photo->p[1]), Z(photo->p[photo->np - 1]));
  LOG(2, "Pressure levels: %g, %g ... %g hPa",
      photo->p[0], photo->p[1], photo->p[photo->np - 1]);
  LOG(2, "Number of solar zenith angles: %d", photo->nsza);
  LOG(2, "Solar zenith angles: %g, %g ... %g deg",
      RAD2DEG(photo->sza[0]), RAD2DEG(photo->sza[1]),
      RAD2DEG(photo->sza[photo->nsza - 1]));
  LOG(2, "Number of total column ozone values: %d", photo->no3c);
  LOG(2, "Total column ozone: %g, %g ... %g DU",
      photo->o3c[0], photo->o3c[1], photo->o3c[photo->no3c - 1]);
  LOG(2, "N2O photolysis rate: %g, %g ... %g s**-1",
      photo->n2o[0][0][0], photo->n2o[1][0][0],
      photo->n2o[photo->np - 1][photo->nsza - 1][photo->no3c - 1]);
  LOG(2, "CCl4 photolysis rate: %g, %g ... %g s**-1",
      photo->ccl4[0][0][0], photo->ccl4[1][0][0],
      photo->ccl4[photo->np - 1][photo->nsza - 1][photo->no3c - 1]);
  LOG(2, "CFC-11 photolysis rate: %g, %g ... %g s**-1",
      photo->ccl3f[0][0][0], photo->ccl3f[1][0][0],
      photo->ccl3f[photo->np - 1][photo->nsza - 1][photo->no3c - 1]);
  LOG(2, "CFC-12 photolysis rate: %g, %g ... %g s**-1",
      photo->ccl2f2[0][0][0], photo->ccl2f2[1][0][0],
      photo->ccl2f2[photo->np - 1][photo->nsza - 1][photo->no3c - 1]);
  LOG(2, "O2 photolysis rate: %g, %g ... %g s**-1",
      photo->o2[0][0][0], photo->o2[1][0][0],
      photo->o2[photo->np - 1][photo->nsza - 1][photo->no3c - 1]);
  LOG(2, "O3 -> O(1D) photolysis rate: %g, %g ... %g s**-1",
      photo->o3_1[0][0][0], photo->o3_1[1][0][0],
      photo->o3_1[photo->np - 1][photo->nsza - 1][photo->no3c - 1]);
  LOG(2, "O3 -> O(3P) photolysis rate: %g, %g ... %g s**-1",
      photo->o3_2[0][0][0], photo->o3_2[1][0][0],
      photo->o3_2[photo->np - 1][photo->nsza - 1][photo->no3c - 1]);
  LOG(2, "H2O2 photolysis rate: %g, %g ... %g s**-1",
      photo->h2o2[0][0][0], photo->h2o2[1][0][0],
      photo->h2o2[photo->np - 1][photo->nsza - 1][photo->no3c - 1]);
  LOG(2, "H2O photolysis rate: %g, %g ... %g s**-1",
      photo->h2o[0][0][0], photo->h2o[1][0][0],
      photo->h2o[photo->np - 1][photo->nsza - 1][photo->no3c - 1]);
}
 
/*****************************************************************************/
 
void read_clim_photo_help(
  const int ncid,
  const char *varname,
  const clim_photo_t *photo,
  double var[CP][CSZA][CO3]) {
 
  /* Allocate... */
  double *help;
  ALLOC(help, double,
        photo->np * photo->nsza * photo->no3c);
 
  /* Read variable... */
  int varid;
  NC_GET_DOUBLE(varname, help, 1);
 
  /* Copy data... */
  for (int ip = 0; ip < photo->np; ip++)
    for (int is = 0; is < photo->nsza; is++)
      for (int io = 0; io < photo->no3c; io++)
        var[ip][is][io] =
          help[ARRAY_3D(ip, is, photo->nsza, io, photo->no3c)];
 
  /* Free... */
  free(help);
}
 
/*****************************************************************************/
 
int read_clim_ts(
  const char *filename,
  clim_ts_t *ts) {
 
  /* Write info... */
  LOG(1, "Read climatological time series: %s", filename);
 
  /* Open file... */
  FILE *in;
  if (!(in = fopen(filename, "r"))) {
    WARN("Cannot open file!");
    return 0;
  }
 
  /* Read data... */
  char line[LEN];
  int nh = 0;
  while (fgets(line, LEN, in))
    if (sscanf(line, "%lg %lg", &ts->time[nh], &ts->vmr[nh]) == 2) {
 
      /* Convert years to seconds... */
      ts->time[nh] = (ts->time[nh] - 2000.0) * 365.25 * 86400.;
 
      /* Check data... */
      if (nh > 0 && ts->time[nh] <= ts->time[nh - 1])
        ERRMSG("Time series must be ascending!");
 
      /* Count time steps... */
      if ((++nh) >= CTS)
        ERRMSG("Too many data points!");
    }
 
  /* Close file... */
  fclose(in);
 
  /* Check number of data points... */
  ts->ntime = nh;
  if (nh < 2)
    ERRMSG("Not enough data points!");
 
  /* Write info... */
  LOG(2, "Number of time steps: %d", ts->ntime);
  LOG(2, "Time steps: %.2f, %.2f ... %.2f s", ts->time[0], ts->time[1],
      ts->time[nh - 1]);
  LOG(2, "Volume mixing ratio range: %g ... %g ppv",
      gsl_stats_min(ts->vmr, 1, (size_t) nh), gsl_stats_max(ts->vmr, 1,
                                                            (size_t) nh));
 
  /* Exit success... */
  return 1;
}
 
/*****************************************************************************/
 
void read_clim_zm(
  const char *filename,
  const char *varname,
  clim_zm_t *zm) {
 
  int ncid, varid, it, iy, iz, iz2, nt;
 
  double *help, varmin = 1e99, varmax = -1e99;
 
  /* Write info... */
  LOG(1, "Read %s data: %s", varname, filename);
 
  /* Open netCDF file... */
  if (nc_open(filename, NC_NOWRITE, &ncid) != NC_NOERR) {
    WARN("%s climatology data are missing!", varname);
    return;
  }
 
  /* Read pressure data... */
  NC_INQ_DIM("press", &zm->np, 2, CP, 1);
  NC_GET_DOUBLE("press", zm->p, 1);
  if (zm->p[0] < zm->p[1])
    ERRMSG("Pressure data are not descending!");
 
  /* Read latitudes... */
  NC_INQ_DIM("lat", &zm->nlat, 2, CY, 1);
  NC_GET_DOUBLE("lat", zm->lat, 1);
  if (zm->lat[0] > zm->lat[1])
    ERRMSG("Latitude data are not ascending!");
 
  /* Set time data (for monthly means)... */
  zm->ntime = 12;
  zm->time[0] = 1209600.00;
  zm->time[1] = 3888000.00;
  zm->time[2] = 6393600.00;
  zm->time[3] = 9072000.00;
  zm->time[4] = 11664000.00;
  zm->time[5] = 14342400.00;
  zm->time[6] = 16934400.00;
  zm->time[7] = 19612800.00;
  zm->time[8] = 22291200.00;
  zm->time[9] = 24883200.00;
  zm->time[10] = 27561600.00;
  zm->time[11] = 30153600.00;
 
  /* Check number of timesteps... */
  NC_INQ_DIM("time", &nt, 12, 12, 1);
 
  /* Read data... */
  ALLOC(help, double,
        zm->nlat * zm->np * zm->ntime);
  NC_GET_DOUBLE(varname, help, 1);
  for (it = 0; it < zm->ntime; it++)
    for (iz = 0; iz < zm->np; iz++)
      for (iy = 0; iy < zm->nlat; iy++)
        zm->vmr[it][iz][iy] = help[ARRAY_3D(it, iz, zm->np, iy, zm->nlat)];
  free(help);
 
  /* Fix data gaps... */
  for (it = 0; it < zm->ntime; it++)
    for (iy = 0; iy < zm->nlat; iy++)
      for (iz = 0; iz < zm->np; iz++) {
        if (zm->vmr[it][iz][iy] < 0) {
          for (iz2 = 0; iz2 < zm->np; iz2++)
            if (zm->vmr[it][iz2][iy] >= 0) {
              zm->vmr[it][iz][iy] = zm->vmr[it][iz2][iy];
              break;
            }
          for (iz2 = zm->np - 1; iz2 >= 0; iz2--)
            if (zm->vmr[it][iz2][iy] >= 0) {
              zm->vmr[it][iz][iy] = zm->vmr[it][iz2][iy];
              break;
            }
        }
        varmin = MIN(varmin, zm->vmr[it][iz][iy]);
        varmax = MAX(varmax, zm->vmr[it][iz][iy]);
      }
 
  /* Close netCDF file... */
  NC(nc_close(ncid));
 
  /* Write info... */
  LOG(2, "Number of time steps: %d", zm->ntime);
  LOG(2, "Time steps: %.2f, %.2f ... %.2f s",
      zm->time[0], zm->time[1], zm->time[zm->ntime - 1]);
  LOG(2, "Number of pressure levels: %d", zm->np);
  LOG(2, "Altitude levels: %g, %g ... %g km",
      Z(zm->p[0]), Z(zm->p[1]), Z(zm->p[zm->np - 1]));
  LOG(2, "Pressure levels: %g, %g ... %g hPa", zm->p[0],
      zm->p[1], zm->p[zm->np - 1]);
  LOG(2, "Number of latitudes: %d", zm->nlat);
  LOG(2, "Latitudes: %g, %g ... %g deg",
      zm->lat[0], zm->lat[1], zm->lat[zm->nlat - 1]);
  LOG(2, "%s volume mixing ratio range: %g ... %g ppv", varname, varmin,
      varmax);
}
 
/*****************************************************************************/
 
void read_kernel(
  const char *filename,
  double kz[EP],
  double kw[EP],
  int *nk) {
 
  /* Write info... */
  LOG(1, "Read kernel function: %s", filename);
 
  /* Open file... */
  FILE *in;
  if (!(in = fopen(filename, "r")))
    ERRMSG("Cannot open file!");
 
  /* Read data... */
  char line[LEN];
  int n = 0;
  while (fgets(line, LEN, in))
    if (sscanf(line, "%lg %lg", &kz[n], &kw[n]) == 2) {
      if (n > 0 && kz[n] < kz[n - 1])
        ERRMSG("Height levels must be ascending!");
      if ((++n) >= EP)
        ERRMSG("Too many height levels!");
    }
 
  /* Close file... */
  fclose(in);
 
  /* Check number of data points... */
  *nk = n;
  if (n < 2)
    ERRMSG("Not enough height levels!");
 
  /* Normalize kernel function... */
  const double kmax = gsl_stats_max(kw, 1, (size_t) n);
  for (int iz = 0; iz < n; iz++)
    kw[iz] /= kmax;
}
 
/*****************************************************************************/
 
int read_met_bin(
  const char *filename,
  const ctl_t *ctl,
  met_t *met) {
 
  FILE *in;
 
  double r;
 
  int year, mon, day, hour, min, sec;
 
  /* Set timer... */
  SELECT_TIMER("READ_MET_BIN", "INPUT");
 
  /* Open file... */
  if (!(in = fopen(filename, "r"))) {
    WARN("Cannot open file!");
    return 0;
  }
 
  /* Check type of binary data... */
  int met_type;
  FREAD(&met_type, int,
        1,
        in);
  if (met_type != ctl->met_type)
    ERRMSG("Wrong MET_TYPE of binary data!");
 
  /* Check version of binary data... */
  int version;
  FREAD(&version, int,
        1,
        in);
  if (version != 104)
    ERRMSG("Wrong version of binary data!");
 
  /* Read time... */
  FREAD(&met->time, double,
        1,
        in);
  jsec2time(met->time, &year, &mon, &day, &hour, &min, &sec, &r);
  LOG(2, "Time: %.2f (%d-%02d-%02d, %02d:%02d UTC)",
      met->time, year, mon, day, hour, min);
  if (year < 1900 || year > 2100 || mon < 1 || mon > 12
      || day < 1 || day > 31 || hour < 0 || hour > 23)
    ERRMSG("Error while reading time!");
 
  /* Read dimensions... */
  met->coord_type = ctl->met_coord_type;
 
  FREAD(&met->nx, int,
        1,
        in);
  LOG(2, "Number of %s: %d",
      (met->coord_type == 0) ? "longitudes" : "x coordinates", met->nx);
  if (met->nx < 2 || met->nx > EX)
    ERRMSG(met->coord_type == 0
           ? "Number of longitudes out of range!"
           : "Number of x coordinates out of range!");
 
  FREAD(&met->ny, int,
        1,
        in);
  LOG(2, "Number of %s: %d",
      (met->coord_type == 0) ? "latitudes" : "y coordinates", met->ny);
  if (met->ny < 2 || met->ny > EY)
    ERRMSG(met->coord_type == 0
           ? "Number of latitudes out of range!"
           : "Number of y coordinates out of range!");
 
  FREAD(&met->np, int,
        1,
        in);
  LOG(2, "Number of levels: %d", met->np);
  if (met->np < 2 || met->np > EP)
    ERRMSG("Number of levels out of range!");
 
  /* Read grid... */
  FREAD(met->lon, double,
          (size_t) met->nx,
        in);
  LOG(2, "%s: %g, %g ... %g %s",
      met->coord_type == 0 ? "Longitudes" : "X coordinates",
      met->lon[0], met->lon[1], met->lon[met->nx - 1],
      met->coord_type == 0 ? "deg" : "m");
 
  FREAD(met->lat, double,
          (size_t) met->ny,
        in);
  LOG(2, "%s: %g, %g ... %g %s",
      met->coord_type == 0 ? "Latitudes" : "Y coordinates",
      met->lat[0], met->lat[1], met->lat[met->ny - 1],
      met->coord_type == 0 ? "deg" : "m");
 
  FREAD(met->p, double,
          (size_t) met->np,
        in);
  LOG(2, "Altitude levels: %g, %g ... %g km",
      Z(met->p[0]), Z(met->p[1]), Z(met->p[met->np - 1]));
  LOG(2, "Pressure levels: %g, %g ... %g hPa",
      met->p[0], met->p[1], met->p[met->np - 1]);
 
  /* Read surface data... */
  read_met_bin_2d(in, met, met->ps, "PS");
  read_met_bin_2d(in, met, met->ts, "TS");
  read_met_bin_2d(in, met, met->zs, "ZS");
  read_met_bin_2d(in, met, met->us, "US");
  read_met_bin_2d(in, met, met->vs, "VS");
  read_met_bin_2d(in, met, met->ess, "ESS");
  read_met_bin_2d(in, met, met->nss, "NSS");
  read_met_bin_2d(in, met, met->shf, "SHF");
  read_met_bin_2d(in, met, met->lsm, "LSM");
  read_met_bin_2d(in, met, met->sst, "SST");
  read_met_bin_2d(in, met, met->pbl, "PBL");
  read_met_bin_2d(in, met, met->pt, "PT");
  read_met_bin_2d(in, met, met->tt, "TT");
  read_met_bin_2d(in, met, met->zt, "ZT");
  read_met_bin_2d(in, met, met->h2ot, "H2OT");
  read_met_bin_2d(in, met, met->pct, "PCT");
  read_met_bin_2d(in, met, met->pcb, "PCB");
  read_met_bin_2d(in, met, met->cl, "CL");
  read_met_bin_2d(in, met, met->plcl, "PLCL");
  read_met_bin_2d(in, met, met->plfc, "PLFC");
  read_met_bin_2d(in, met, met->pel, "PEL");
  read_met_bin_2d(in, met, met->cape, "CAPE");
  read_met_bin_2d(in, met, met->cin, "CIN");
  read_met_bin_2d(in, met, met->o3c, "O3C");
 
  /* Read level data... */
  read_met_bin_3d(in, ctl, met, met->z, "Z", -1e34f, 1e34f);
  read_met_bin_3d(in, ctl, met, met->t, "T", 0, 1e34f);
  read_met_bin_3d(in, ctl, met, met->u, "U", -1e34f, 1e34f);
  read_met_bin_3d(in, ctl, met, met->v, "V", -1e34f, 1e34f);
  read_met_bin_3d(in, ctl, met, met->w, "W", -1e34f, 1e34f);
  read_met_bin_3d(in, ctl, met, met->pv, "PV", -1e34f, 1e34f);
  read_met_bin_3d(in, ctl, met, met->h2o, "H2O", 0, 1e34f);
  read_met_bin_3d(in, ctl, met, met->o3, "O3", 0, 1e34f);
  read_met_bin_3d(in, ctl, met, met->lwc, "LWC", 0, 1e34f);
  read_met_bin_3d(in, ctl, met, met->rwc, "RWC", 0, 1e34f);
  read_met_bin_3d(in, ctl, met, met->iwc, "IWC", 0, 1e34f);
  read_met_bin_3d(in, ctl, met, met->swc, "SWC", 0, 1e34f);
  read_met_bin_3d(in, ctl, met, met->cc, "CC", 0, 1);
 
  /* Read final flag... */
  int final;
  FREAD(&final, int,
        1,
        in);
  if (final != 999)
    ERRMSG("Error while reading binary data!");
 
  /* Close file... */
  fclose(in);
 
  /* Return success... */
  return 1;
}
 
/*****************************************************************************/
 
void read_met_bin_2d(
  FILE *in,
  const met_t *met,
  float var[EX][EY],
  const char *varname) {
 
  float *help;
 
  /* Allocate... */
  ALLOC(help, float,
        EX * EY);
 
  /* Read uncompressed... */
  LOG(2, "Read 2-D variable: %s (uncompressed)", varname);
  FREAD(help, float,
          (size_t) (met->nx * met->ny),
        in);
 
  /* Copy data... */
  for (int ix = 0; ix < met->nx; ix++)
    for (int iy = 0; iy < met->ny; iy++)
      var[ix][iy] = help[ARRAY_2D(ix, iy, met->ny)];
 
  /* Free... */
  free(help);
}
 
/*****************************************************************************/
 
void read_met_bin_3d(
  FILE *in,
  const ctl_t *ctl,
  const met_t *met,
  float var[EX][EY][EP],
  const char *varname,
  const float bound_min,
  const float bound_max) {
 
  float *help;
 
  /* Allocate... */
  ALLOC(help, float,
        EX * EY * EP);
 
  /* Read uncompressed data... */
  if (ctl->met_type == 1) {
    LOG(2, "Read 3-D variable: %s (uncompressed)", varname);
    FREAD(help, float,
            (size_t) (met->nx * met->ny * met->np),
          in);
  }
 
  /* Read packed data... */
  else if (ctl->met_type == 2)
    compress_pck(ctl, met, varname, help, 1, NULL, in);
 
  /* Read ZFP data... */
  else if (ctl->met_type == 3) {
#ifdef ZFP
    int precision;
    FREAD(&precision, int,
          1,
          in);
 
    double tolerance;
    FREAD(&tolerance, double,
          1,
          in);
 
    compress_zfp(ctl, met, varname, help, 1, NULL, in);
#else
    ERRMSG("MPTRAC was compiled without ZFP compression!");
#endif
  }
 
  /* Read zstd data... */
  else if (ctl->met_type == 4) {
#ifdef ZSTD
    compress_zstd(ctl, met, varname, help, 1, NULL, in);
#else
    ERRMSG("MPTRAC was compiled without ZSTD compression!");
#endif
  }
 
  /* Read LZ4 data... */
  else if (ctl->met_type == 8) {
#ifdef LZ4
    compress_lz4(ctl, met, varname, help, 1, NULL, in);
#else
    ERRMSG("MPTRAC was compiled without LZ4 compression!");
#endif
  }
 
  /* Read cmultiscale data... */
  else if (ctl->met_type == 5) {
#ifdef CMS
    compress_cms(ctl, met, varname, help, 1, NULL, in);
#else
    ERRMSG("MPTRAC was compiled without cmultiscale compression!");
#endif
  }
 
  /* Read SZ3 data... */
  else if (ctl->met_type == 7) {
#ifdef SZ3
    int precision;
    FREAD(&precision, int,
          1,
          in);
 
    double tolerance;
    FREAD(&tolerance, double,
          1,
          in);
 
    compress_sz3(ctl, met, varname, help, 1, NULL, in);
#else
    ERRMSG("MPTRAC was compiled without sz3 compression!");
#endif
  }
 
  /* Copy data... */
#pragma omp parallel for default(shared) collapse(2)
  for (int ix = 0; ix < met->nx; ix++)
    for (int iy = 0; iy < met->ny; iy++)
      for (int ip = 0; ip < met->np; ip++) {
        var[ix][iy][ip] = help[ARRAY_3D(ix, iy, met->ny, ip, met->np)];
        if (var[ix][iy][ip] < bound_min)
          var[ix][iy][ip] = bound_min;
        else if (var[ix][iy][ip] > bound_max)
          var[ix][iy][ip] = bound_max;
      }
 
  /* Free... */
  free(help);
}
 
/*****************************************************************************/
 
void read_met_cape(
  const ctl_t *ctl,
  const clim_t *clim,
  met_t *met) {
 
  /* Check parameters... */
  if (ctl->met_cape != 1)
    return;
 
  if (ctl->met_coord_type != 0)
    ERRMSG("Only lat/lon grid supported");
 
  /* Set timer... */
  SELECT_TIMER("READ_MET_CAPE", "METPROC");
  LOG(2, "Calculate CAPE...");
 
  /* Vertical spacing (about 100 m)... */
  const double pfac = 1.01439, dz0 = RI / MA / G0 * log(pfac);
 
  /* Loop over columns... */
#pragma omp parallel for default(shared) collapse(2)
  for (int ix = 0; ix < met->nx; ix++)
    for (int iy = 0; iy < met->ny; iy++) {
 
      /* Get potential temperature and water vapor at lowest 50 hPa... */
      int n = 0;
      double h2o = 0, t, theta = 0;
      double pbot = MIN(met->ps[ix][iy], met->p[0]);
      double ptop = pbot - 50.;
      for (int ip = 0; ip < met->np; ip++) {
        if (met->p[ip] <= pbot) {
          theta += THETA(met->p[ip], met->t[ix][iy][ip]);
          h2o += met->h2o[ix][iy][ip];
          n++;
        }
        if (met->p[ip] < ptop && n > 0)
          break;
      }
      theta /= n;
      h2o /= n;
 
      /* Cannot compute anything if water vapor is missing... */
      met->plcl[ix][iy] = NAN;
      met->plfc[ix][iy] = NAN;
      met->pel[ix][iy] = NAN;
      met->cape[ix][iy] = NAN;
      met->cin[ix][iy] = NAN;
      if (h2o <= 0)
        continue;
 
      /* Find lifted condensation level (LCL)... */
      ptop = P(20.);
      pbot = met->ps[ix][iy];
      do {
        met->plcl[ix][iy] = (float) (0.5 * (pbot + ptop));
        t = theta / pow(1000. / met->plcl[ix][iy], KAPPA);
        if (RH(met->plcl[ix][iy], t, h2o) > 100.)
          ptop = met->plcl[ix][iy];
        else
          pbot = met->plcl[ix][iy];
      } while (pbot - ptop > 0.1);
 
      /* Calculate CIN up to LCL... */
      INTPOL_INIT;
      double dcape, dz, h2o_env, t_env;
      double p = met->ps[ix][iy];
      met->cape[ix][iy] = met->cin[ix][iy] = 0;
      do {
        dz = dz0 * TVIRT(t, h2o);
        p /= pfac;
        t = theta / pow(1000. / p, KAPPA);
        intpol_met_space_3d(met, met->t, p, met->lon[ix], met->lat[iy],
                            &t_env, ci, cw, 1);
        intpol_met_space_3d(met, met->h2o, p, met->lon[ix], met->lat[iy],
                            &h2o_env, ci, cw, 0);
        dcape = 1e3 * G0 * (TVIRT(t, h2o) - TVIRT(t_env, h2o_env)) /
          TVIRT(t_env, h2o_env) * dz;
        if (dcape < 0)
          met->cin[ix][iy] += fabsf((float) dcape);
      } while (p > met->plcl[ix][iy]);
 
      /* Calculate level of free convection (LFC), equilibrium level (EL),
         and convective available potential energy (CAPE)... */
      dcape = 0;
      p = met->plcl[ix][iy];
      t = theta / pow(1000. / p, KAPPA);
      ptop = 0.75 * clim_tropo(clim, met->time,
                               ctl->met_coord_type ==
                               0 ? met->lat[iy] : ctl->met_utm_ref_lat);
      do {
        dz = dz0 * TVIRT(t, h2o);
        p /= pfac;
        t -= lapse_rate(t, h2o) * dz;
        double psat = PSAT(t);
        h2o = psat / (p - (1. - EPS) * psat);
        intpol_met_space_3d(met, met->t, p, met->lon[ix], met->lat[iy],
                            &t_env, ci, cw, 1);
        intpol_met_space_3d(met, met->h2o, p, met->lon[ix], met->lat[iy],
                            &h2o_env, ci, cw, 0);
        double dcape_old = dcape;
        dcape = 1e3 * G0 * (TVIRT(t, h2o) - TVIRT(t_env, h2o_env)) /
          TVIRT(t_env, h2o_env) * dz;
        if (dcape > 0) {
          met->cape[ix][iy] += (float) dcape;
          if (!isfinite(met->plfc[ix][iy]))
            met->plfc[ix][iy] = (float) p;
        } else if (dcape_old > 0)
          met->pel[ix][iy] = (float) p;
        if (dcape < 0 && !isfinite(met->plfc[ix][iy]))
          met->cin[ix][iy] += fabsf((float) dcape);
      } while (p > ptop);
 
      /* Check results... */
      if (!isfinite(met->plfc[ix][iy]))
        met->cin[ix][iy] = NAN;
    }
}
 
/*****************************************************************************/
 
void read_met_cloud(
  met_t *met) {
 
  /* Set timer... */
  SELECT_TIMER("READ_MET_CLOUD", "METPROC");
  LOG(2, "Calculate cloud data...");
 
  /* Thresholds for cloud detection... */
  const double ccmin = 0.01, cwmin = 1e-6;
 
  /* Loop over columns... */
#pragma omp parallel for default(shared) collapse(2)
  for (int ix = 0; ix < met->nx; ix++)
    for (int iy = 0; iy < met->ny; iy++) {
 
      /* Init... */
      met->pct[ix][iy] = NAN;
      met->pcb[ix][iy] = NAN;
      met->cl[ix][iy] = 0;
 
      /* Loop over pressure levels... */
      for (int ip = 0; ip < met->np - 1; ip++) {
 
        /* Check pressure... */
        if (met->p[ip] > met->ps[ix][iy] || met->p[ip] < P(20.))
          continue;
 
        /* Check ice water and liquid water content... */
        if (met->cc[ix][iy][ip] > ccmin
            && (met->lwc[ix][iy][ip] > cwmin
                || met->rwc[ix][iy][ip] > cwmin
                || met->iwc[ix][iy][ip] > cwmin
                || met->swc[ix][iy][ip] > cwmin)) {
 
          /* Get cloud top pressure ... */
          met->pct[ix][iy]
            = (float) (0.5 * (met->p[ip] + (float) met->p[ip + 1]));
 
          /* Get cloud bottom pressure ... */
          if (!isfinite(met->pcb[ix][iy]))
            met->pcb[ix][iy]
              = (float) (0.5 * (met->p[ip] + met->p[MAX(ip - 1, 0)]));
        }
 
        /* Get cloud water... */
        met->cl[ix][iy] += (float)
          (0.5 * (met->lwc[ix][iy][ip] + met->lwc[ix][iy][ip + 1]
                  + met->rwc[ix][iy][ip] + met->rwc[ix][iy][ip + 1]
                  + met->iwc[ix][iy][ip] + met->iwc[ix][iy][ip + 1]
                  + met->swc[ix][iy][ip] + met->swc[ix][iy][ip + 1])
           * 100. * (met->p[ip] - met->p[ip + 1]) / G0);
      }
    }
}
 
/*****************************************************************************/
 
void read_met_detrend(
  const ctl_t *ctl,
  met_t *met) {
 
  met_t *help;
 
  /* Check parameters... */
  if (ctl->met_detrend <= 0)
    return;
 
  if (ctl->met_coord_type != 0)
    ERRMSG("Only lat/lon grid supported");
 
  /* Set timer... */
  SELECT_TIMER("READ_MET_DETREND", "METPROC");
  LOG(2, "Detrend meteo data...");
 
  /* Allocate... */
  ALLOC(help, met_t, 1);
 
  /* Calculate standard deviation... */
  const double sigma = ctl->met_detrend / 2.355;
  const double tssq = 2. * SQR(sigma);
 
  /* Calculate box size in latitude... */
  int sy = (int) (3. * DY2DEG(sigma) / fabs(met->lat[1] - met->lat[0]));
  sy = MIN(MAX(1, sy), met->ny / 2);
 
  /* Calculate background... */
#pragma omp parallel for default(shared) collapse(2)
  for (int ix = 0; ix < met->nx; ix++) {
    for (int iy = 0; iy < met->ny; iy++) {
 
      /* Calculate Cartesian coordinates... */
      double x0[3];
      geo2cart(0.0, met->lon[ix], met->lat[iy], x0);
 
      /* Calculate box size in longitude... */
      int sx =
        (int) (3. * DX2DEG(sigma, met->lat[iy]) /
               fabs(met->lon[1] - met->lon[0]));
      sx = MIN(MAX(1, sx), met->nx / 2);
 
      /* Init... */
      float wsum = 0;
      for (int ip = 0; ip < met->np; ip++) {
        help->t[ix][iy][ip] = 0;
        help->u[ix][iy][ip] = 0;
        help->v[ix][iy][ip] = 0;
        help->w[ix][iy][ip] = 0;
      }
 
      /* Loop over neighboring grid points... */
      for (int ix2 = ix - sx; ix2 <= ix + sx; ix2++) {
        int ix3 = ix2;
        if (ix3 < 0)
          ix3 += met->nx;
        else if (ix3 >= met->nx)
          ix3 -= met->nx;
        for (int iy2 = MAX(iy - sy, 0);
             iy2 <= MIN(iy + sy, met->ny - 1); iy2++) {
 
          /* Calculate Cartesian coordinates... */
          double x1[3];
          geo2cart(0.0, met->lon[ix3], met->lat[iy2], x1);
 
          /* Calculate weighting factor... */
          const float w = (float) exp(-DIST2(x0, x1) / tssq);
 
          /* Add data... */
          wsum += w;
          for (int ip = 0; ip < met->np; ip++) {
            help->t[ix][iy][ip] += w * met->t[ix3][iy2][ip];
            help->u[ix][iy][ip] += w * met->u[ix3][iy2][ip];
            help->v[ix][iy][ip] += w * met->v[ix3][iy2][ip];
            help->w[ix][iy][ip] += w * met->w[ix3][iy2][ip];
          }
        }
      }
 
      /* Normalize... */
      for (int ip = 0; ip < met->np; ip++) {
        help->t[ix][iy][ip] /= wsum;
        help->u[ix][iy][ip] /= wsum;
        help->v[ix][iy][ip] /= wsum;
        help->w[ix][iy][ip] /= wsum;
      }
    }
  }
 
  /* Subtract background... */
#pragma omp parallel for default(shared) collapse(3)
  for (int ix = 0; ix < met->nx; ix++)
    for (int iy = 0; iy < met->ny; iy++)
      for (int ip = 0; ip < met->np; ip++) {
        met->t[ix][iy][ip] -= help->t[ix][iy][ip];
        met->u[ix][iy][ip] -= help->u[ix][iy][ip];
        met->v[ix][iy][ip] -= help->v[ix][iy][ip];
        met->w[ix][iy][ip] -= help->w[ix][iy][ip];
      }
 
  /* Free... */
  free(help);
}
 
/*****************************************************************************/
 
void read_met_extrapolate(
  met_t *met) {
 
  /* Set timer... */
  SELECT_TIMER("READ_MET_EXTRAPOLATE", "METPROC");
  LOG(2, "Extrapolate meteo data...");
 
  /* Loop over columns... */
#pragma omp parallel for default(shared) collapse(2)
  for (int ix = 0; ix < met->nx; ix++)
    for (int iy = 0; iy < met->ny; iy++) {
 
      /* Find lowest valid data point... */
      int ip0;
      for (ip0 = met->np - 1; ip0 >= 0; ip0--)
        if (!isfinite(met->t[ix][iy][ip0])
            || !isfinite(met->u[ix][iy][ip0])
            || !isfinite(met->v[ix][iy][ip0])
            || !isfinite(met->w[ix][iy][ip0]))
          break;
 
      /* Extrapolate... */
      for (int ip = ip0; ip >= 0; ip--) {
        met->t[ix][iy][ip] = met->t[ix][iy][ip + 1];
        met->u[ix][iy][ip] = met->u[ix][iy][ip + 1];
        met->v[ix][iy][ip] = met->v[ix][iy][ip + 1];
        met->w[ix][iy][ip] = met->w[ix][iy][ip + 1];
        met->h2o[ix][iy][ip] = met->h2o[ix][iy][ip + 1];
        met->o3[ix][iy][ip] = met->o3[ix][iy][ip + 1];
        met->lwc[ix][iy][ip] = met->lwc[ix][iy][ip + 1];
        met->rwc[ix][iy][ip] = met->rwc[ix][iy][ip + 1];
        met->iwc[ix][iy][ip] = met->iwc[ix][iy][ip + 1];
        met->swc[ix][iy][ip] = met->swc[ix][iy][ip + 1];
        met->cc[ix][iy][ip] = met->cc[ix][iy][ip + 1];
      }
    }
}
 
/*****************************************************************************/
 
void read_met_geopot(
  const ctl_t *ctl,
  met_t *met) {
 
  float *help;
 
  double logp[EP];
 
  int dx = ctl->met_geopot_sx, dy = ctl->met_geopot_sy;
 
  /* Set timer... */
  SELECT_TIMER("READ_MET_GEOPOT", "METPROC");
  LOG(2, "Calculate geopotential heights...");
 
  /* Allocate... */
  ALLOC(help, float,
        EX * EY * EP);
 
  /* Calculate log pressure... */
#pragma omp parallel for default(shared)
  for (int ip = 0; ip < met->np; ip++)
    logp[ip] = log(met->p[ip]);
 
  /* Apply hydrostatic equation to calculate geopotential heights... */
#pragma omp parallel for default(shared) collapse(2)
  for (int ix = 0; ix < met->nx; ix++)
    for (int iy = 0; iy < met->ny; iy++) {
 
      /* Get surface height and pressure... */
      const double zs = met->zs[ix][iy];
      const double lnps = log(met->ps[ix][iy]);
 
      /* Get temperature and water vapor at the surface... */
      const int ip0 = locate_irr(met->p, met->np, met->ps[ix][iy]);
      const double ts = LIN(met->p[ip0], met->t[ix][iy][ip0], met->p[ip0 + 1],
                            met->t[ix][iy][ip0 + 1], met->ps[ix][iy]);
      const double h2os =
        LIN(met->p[ip0], met->h2o[ix][iy][ip0], met->p[ip0 + 1],
            met->h2o[ix][iy][ip0 + 1], met->ps[ix][iy]);
 
      /* Upper part of profile... */
      met->z[ix][iy][ip0 + 1]
        = (float) (zs +
                   ZDIFF(lnps, ts, h2os, logp[ip0 + 1],
                         met->t[ix][iy][ip0 + 1], met->h2o[ix][iy][ip0 + 1]));
      for (int ip = ip0 + 2; ip < met->np; ip++)
        met->z[ix][iy][ip]
          = (float) (met->z[ix][iy][ip - 1] +
                     ZDIFF(logp[ip - 1], met->t[ix][iy][ip - 1],
                           met->h2o[ix][iy][ip - 1], logp[ip],
                           met->t[ix][iy][ip], met->h2o[ix][iy][ip]));
 
      /* Lower part of profile... */
      met->z[ix][iy][ip0]
        = (float) (zs +
                   ZDIFF(lnps, ts, h2os, logp[ip0],
                         met->t[ix][iy][ip0], met->h2o[ix][iy][ip0]));
      for (int ip = ip0 - 1; ip >= 0; ip--)
        met->z[ix][iy][ip]
          = (float) (met->z[ix][iy][ip + 1] +
                     ZDIFF(logp[ip + 1], met->t[ix][iy][ip + 1],
                           met->h2o[ix][iy][ip + 1], logp[ip],
                           met->t[ix][iy][ip], met->h2o[ix][iy][ip]));
    }
 
  /* Check control parameters... */
  if (dx == 0 || dy == 0)
    return;
 
  /* Default smoothing parameters... */
  if (dx < 0 || dy < 0) {
    if (fabs(met->lon[1] - met->lon[0]) < 0.5) {
      dx = 3;
      dy = 2;
    } else {
      dx = 6;
      dy = 4;
    }
  }
 
  /* Calculate weights for smoothing... */
  float ws[dx + 1][dy + 1];
#pragma omp parallel for default(shared) collapse(2)
  for (int ix = 0; ix <= dx; ix++)
    for (int iy = 0; iy < dy; iy++)
      ws[ix][iy] = (1.0f - (float) ix / (float) dx)
        * (1.0f - (float) iy / (float) dy);
 
  /* Copy data... */
#pragma omp parallel for default(shared) collapse(3)
  for (int ix = 0; ix < met->nx; ix++)
    for (int iy = 0; iy < met->ny; iy++)
      for (int ip = 0; ip < met->np; ip++)
        help[ARRAY_3D(ip, ix, met->nx, iy, met->ny)] = met->z[ix][iy][ip];
 
  /* Horizontal smoothing... */
#pragma omp parallel for default(shared) collapse(3)
  for (int ip = 0; ip < met->np; ip++)
    for (int ix = 0; ix < met->nx; ix++)
      for (int iy = 0; iy < met->ny; iy++) {
        float res = 0, wsum = 0;
        int iy0 = MAX(iy - dy + 1, 0);
        int iy1 = MIN(iy + dy - 1, met->ny - 1);
        for (int ix2 = ix - dx + 1; ix2 <= ix + dx - 1; ++ix2) {
          int ix3 = ix2;
          if (ix3 < 0)
            ix3 += met->nx;
          else if (ix3 >= met->nx)
            ix3 -= met->nx;
          for (int iy2 = iy0; iy2 <= iy1; ++iy2)
            if (isfinite(help[ARRAY_3D(ip, ix3, met->nx, iy2, met->ny)])) {
              float w = ws[abs(ix - ix2)][abs(iy - iy2)];
              res += w * help[ARRAY_3D(ip, ix3, met->nx, iy2, met->ny)];
              wsum += w;
            }
        }
        if (wsum > 0)
          met->z[ix][iy][ip] = res / wsum;
        else
          met->z[ix][iy][ip] = NAN;
      }
 
  /* Free... */
  free(help);
}
 
/*****************************************************************************/
 
void read_met_nc_grid(
  const char *filename,
  const int ncid,
  const ctl_t *ctl,
  met_t *met,
  dd_t *dd) {
 
  char levname[LEN], tstr[10];
 
  double rtime = 0, r, r2;
 
  int varid, ndims, dimids[NC_MAX_DIMS], year2, mon2, day2, hour2, min2, sec2,
    year, mon, day, hour, min, sec;
 
  size_t dimlen;
 
  /* Set timer... */
  SELECT_TIMER("READ_MET_NC_GRID", "INPUT");
  LOG(2, "Read meteo grid information...");
 
  /* MPTRAC meteo files... */
  if (!ctl->met_clams) {
 
    /* Get time from filename... */
    met->time = time_from_filename(filename, 16, 0);
 
    /* Check time information from data file... */
    jsec2time(met->time, &year, &mon, &day, &hour, &min, &sec, &r);
    if (nc_inq_varid(ncid, "time", &varid) == NC_NOERR) {
      NC(nc_get_var_double(ncid, varid, &rtime));
      if (fabs(year * 10000. + mon * 100. + day + hour / 24. - rtime) > 1.0)
        WARN("Time information in meteo file does not match filename!");
    } else
      WARN("Time information in meteo file is missing!");
  }
 
  /* CLaMS meteo files... */
  else {
 
    /* Read time from file... */
    NC_GET_DOUBLE("time", &rtime, 0);
 
    /* Get time from filename (considering the century)... */
    if (rtime < 0)
      sprintf(tstr, "19%.2s", &filename[strlen(filename) - 11]);
    else
      sprintf(tstr, "20%.2s", &filename[strlen(filename) - 11]);
    year = atoi(tstr);
    sprintf(tstr, "%.2s", &filename[strlen(filename) - 9]);
    mon = atoi(tstr);
    sprintf(tstr, "%.2s", &filename[strlen(filename) - 7]);
    day = atoi(tstr);
    sprintf(tstr, "%.2s", &filename[strlen(filename) - 5]);
    hour = atoi(tstr);
    time2jsec(year, mon, day, hour, 0, 0, 0, &met->time);
  }
 
  /* Check time... */
  if (year < 1900 || year > 2100 || mon < 1 || mon > 12
      || day < 1 || day > 31 || hour < 0 || hour > 23)
    ERRMSG("Cannot read time from filename!");
  jsec2time(met->time, &year2, &mon2, &day2, &hour2, &min2, &sec2, &r2);
  LOG(2, "Time: %.2f (%d-%02d-%02d, %02d:%02d UTC)",
      met->time, year2, mon2, day2, hour2, min2);
 
  /* Get vertical dimension... */
  if (nc_inq_varid(ncid, "u", &varid) != NC_NOERR)
    if (nc_inq_varid(ncid, "U", &varid) != NC_NOERR)
      ERRMSG
        ("Variable 'u' or 'U' not found, cannot determine vertical dimension!");
 
  NC(nc_inq_varndims(ncid, varid, &ndims));
  NC(nc_inq_vardimid(ncid, varid, dimids));
 
  if (ndims == 4) {
    NC(nc_inq_dim
       (ncid, dimids[ctl->met_convention == 0 ? 1 : 3], levname, &dimlen));
  } else if (ndims == 3) {
    NC(nc_inq_dim
       (ncid, dimids[ctl->met_convention == 0 ? 0 : 2], levname, &dimlen));
  } else
    ERRMSG("Cannot determine vertical dimension!")
      met->np = (int) dimlen;
 
  LOG(2, "Number of levels: %d", met->np);
  if (met->np < 2 || met->np > EP)
    ERRMSG("Number of levels out of range!");
 
  if (!ctl->dd) {
 
    /* Get grid dimensions and coordinates... */
    if (met->coord_type == 0) {
      /* Longitude/latitude grid... */
      NC_INQ_DIM("lon", &met->nx, 2, EX, 1);
      LOG(2, "Number of longitudes: %d", met->nx);
 
      NC_INQ_DIM("lat", &met->ny, 2, EY, 1);
      LOG(2, "Number of latitudes: %d", met->ny);
 
      NC_GET_DOUBLE("lon", met->lon, 1);
      LOG(2, "Longitudes: %g, %g ... %g deg",
          met->lon[0], met->lon[1], met->lon[met->nx - 1]);
      NC_GET_DOUBLE("lat", met->lat, 1);
      LOG(2, "Latitudes: %g, %g ... %g deg",
          met->lat[0], met->lat[1], met->lat[met->ny - 1]);
 
    } else {
      /* UTM grid... */
      NC_INQ_DIM("x", &met->nx, 2, EX, 1);
      LOG(2, "Number of x coordinates: %d", met->nx);
 
      NC_INQ_DIM("y", &met->ny, 2, EY, 1);
      LOG(2, "Number of y coordinates: %d", met->ny);
 
      NC_GET_DOUBLE("x", met->lon, 1);
      LOG(2, "X coordinates: %g, %g ... %g m",
          met->lon[0], met->lon[1], met->lon[met->nx - 1]);
      NC_GET_DOUBLE("y", met->lat, 1);
      LOG(2, "Y coordinates: %g, %g ... %g m",
          met->lat[0], met->lat[1], met->lat[met->ny - 1]);
    }
 
  } else {
 
    if (met->coord_type != 0)
      ERRMSG("Domain decomposition is only supported for lat/lon grids!");
 
    /* Use equidistant lat-lon domain decomposition... */
    dd_read_met_nc_grid(dd, ctl, met, ncid);
 
  }
 
  /* Read pressure levels... */
  if (ctl->met_np <= 0) {
    NC_GET_DOUBLE(levname, met->p, 1);
    for (int ip = 0; ip < met->np; ip++)
      met->p[ip] /= 100.;
    LOG(2, "Altitude levels: %g, %g ... %g km",
        Z(met->p[0]), Z(met->p[1]), Z(met->p[met->np - 1]));
    LOG(2, "Pressure levels: %g, %g ... %g hPa",
        met->p[0], met->p[1], met->p[met->np - 1]);
  }
 
  /* Read hybrid levels... */
  if (strcasecmp(levname, "hybrid") == 0)
    NC_GET_DOUBLE("hybrid", met->hybrid, 1);
 
  /* Read model level coefficients from file... */
  if (ctl->met_vert_coord == 2) {
    NC_GET_DOUBLE("hyam", met->hyam, 1);
    NC_GET_DOUBLE("hybm", met->hybm, 1);
  }
 
  /* Copy model level coefficients from control parameters... */
  else if (ctl->met_vert_coord == 3 || ctl->met_vert_coord == 4) {
    if (ctl->met_nlev <= 0)
      ERRMSG("You need to specify MET_NLEV, MET_LEV_HYAM, and MET_LEV_HYBM!");
    for (int ip = 0; ip < ctl->met_nlev; ip++) {
      met->hyam[ip] = ctl->met_lev_hyam[ip];
      met->hybm[ip] = ctl->met_lev_hybm[ip];
    }
  }
 
  /* Calculate eta levels... */
  for (int k = 0; k < MAX(met->np, ctl->met_nlev); ++k) {
    met->eta[k] = met->hyam[k] / (100.0 * P0) + met->hybm[k];
    if (ctl->met_vert_coord >= 2 && k > 0 && met->eta[k] <= met->eta[k - 1])
      ERRMSG("Eta levels must be ascending!");
  }
 
  /* Check horizontal grid spacing... */
  for (int ix = 2; ix < met->nx; ix++)
    if (fabs
        (fabs(met->lon[ix] - met->lon[ix - 1]) -
         fabs(met->lon[1] - met->lon[0])) > 0.001)
      ERRMSG("No regular grid spacing in longitudes!");
  for (int iy = 2; iy < met->ny; iy++)
    if (fabs
        (fabs(met->lat[iy] - met->lat[iy - 1]) -
         fabs(met->lat[1] - met->lat[0])) > 0.001) {
      WARN("No regular grid spacing in latitudes!");
      break;
    }
}
 
/*****************************************************************************/
 
void read_met_nc_surface(
  const int ncid,
  const ctl_t *ctl,
  met_t *met,
  dd_t *dd) {
 
  /* Set timer... */
  SELECT_TIMER("READ_MET_SURFACE", "INPUT");
  LOG(2, "Read surface data...");
 
  /* Read surface pressure... */
  if (read_met_nc_2d
      (ncid, (const char *const[]) { "lnsp", "LNSP" }, 2, ctl, met, dd,
       met->ps,
       1.0f, 1)) {
    for (int ix = 0; ix < met->nx; ix++)
      for (int iy = 0; iy < met->ny; iy++)
        met->ps[ix][iy] = (float) (exp(met->ps[ix][iy]) / 100.);
  } else
    if (!read_met_nc_2d
        (ncid, (const char *const[]) { "ps", "PS", "sp", "SP" }, 4, ctl, met,
         dd, met->ps,
         0.01f, 1)) {
    WARN("Cannot not read surface pressure data (use lowest level)!");
    for (int ix = 0; ix < met->nx; ix++)
      for (int iy = 0; iy < met->ny; iy++)
        met->ps[ix][iy]
          = (ctl->met_np > 0 ? (float) ctl->met_p[0] : (float) met->p[0]);
  }
 
  /* MPTRAC meteo data... */
  if (ctl->met_clams == 0) {
 
    /* Read geopotential height at the surface... */
    if (!read_met_nc_2d
        (ncid, (const char *const[]) { "z", "Z" }, 2, ctl, met, dd, met->zs,
         (float) (1. / (1000. * G0)), 1))
      if (!read_met_nc_2d
          (ncid, (const char *const[]) { "zm", "ZM" }, 2, ctl, met, dd,
           met->zs,
           (ctl->met_gp2z ? (float) (1e-3 / G0) : (float) (1. / 1000.)), 1))
      WARN("Cannot read surface geopotential height!");
  }
 
  /* CLaMS meteo data... */
  else {
 
    /* Read geopotential height at the surface
       (use lowermost level of 3-D data field)... */
    float *help;
    ALLOC(help, float,
          EX * EY * EP);
    memcpy(help, met->pl, sizeof(met->pl));
    if (!read_met_nc_3d
        (ncid, (const char *const[]) { "gph", "GPH" }, 2, ctl, met, dd,
         met->pl,
         (float) (1e-3 / G0)))
      ERRMSG("Cannot read geopotential height!");
    /* read_met_nc_3d hands back the levels timer... */
    SELECT_TIMER("READ_MET_SURFACE", "INPUT");
    for (int ix = 0; ix < met->nx; ix++)
      for (int iy = 0; iy < met->ny; iy++)
        met->zs[ix][iy] = met->pl[ix][iy][0];
    memcpy(met->pl, help, sizeof(met->pl));
    free(help);
  }
 
  /* Read temperature at the surface... */
  if (!read_met_nc_2d
      (ncid, (const char *const[]) { "t2m", "T2M", "2t", "2T", "t2", "T2" },
       6, ctl, met, dd, met->ts, 1.0,
       1))
    WARN("Cannot read surface temperature!");
 
  /* Read zonal wind at the surface... */
  if (!read_met_nc_2d
      (ncid, (const char *const[]) { "u10m", "U10M", "10u", "10U", "u10",
       "U10"
       }, 6, ctl, met, dd,
       met->us, 1.0, 1))
    WARN("Cannot read surface zonal wind!");
 
  /* Read meridional wind at the surface... */
  if (!read_met_nc_2d
      (ncid, (const char *const[]) { "v10m", "V10M", "10v", "10V", "v10",
       "V10"
       }, 6, ctl, met, dd,
       met->vs, 1.0, 1))
    WARN("Cannot read surface meridional wind!");
 
  /* Read eastward turbulent surface stress... */
  if (!read_met_nc_2d
      (ncid, (const char *const[]) { "iews", "IEWS" }, 2, ctl, met, dd,
       met->ess,
       1.0, 1))
    WARN("Cannot read eastward turbulent surface stress!");
 
  /* Read northward turbulent surface stress... */
  if (!read_met_nc_2d
      (ncid, (const char *const[]) { "inss", "INSS" }, 2, ctl, met, dd,
       met->nss,
       1.0, 1))
    WARN("Cannot read northward turbulent surface stress!");
 
  /* Read surface sensible heat flux... */
  if (!read_met_nc_2d
      (ncid, (const char *const[]) { "ishf", "ISHF" }, 2, ctl, met, dd,
       met->shf,
       1.0, 1))
    WARN("Cannot read surface sensible heat flux!");
 
  /* Read land-sea mask... */
  if (!read_met_nc_2d
      (ncid, (const char *const[]) { "lsm", "LSM" }, 2, ctl, met, dd,
       met->lsm,
       1.0, 1))
    WARN("Cannot read land-sea mask!");
 
  /* Read sea surface temperature... */
  if (!read_met_nc_2d
      (ncid, (const char *const[]) { "sstk", "SSTK", "sst", "SST" }, 4, ctl,
       met, dd, met->sst,
       1.0, 1))
    WARN("Cannot read sea surface temperature!");
 
  /* Read PBL... */
  if (ctl->met_pbl == 0)
    if (!read_met_nc_2d
        (ncid, (const char *const[]) { "blp", "BLP" }, 2, ctl, met, dd,
         met->pbl,
         0.01f, 1))
    WARN("Cannot read planetary boundary layer pressure!");
  if (ctl->met_pbl == 1)
    if (!read_met_nc_2d
        (ncid, (const char *const[]) { "blh", "BLH" }, 2, ctl, met, dd,
         met->pbl,
         0.001f, 1))
    WARN("Cannot read planetary boundary layer height!");
 
  /* Read CAPE... */
  if (ctl->met_cape == 0)
    if (!read_met_nc_2d
        (ncid, (const char *const[]) { "cape", "CAPE" }, 2, ctl, met, dd,
         met->cape, 1.0, 1))
    WARN("Cannot read CAPE!");
 
  /* Read CIN... */
  if (ctl->met_cape == 0)
    if (!read_met_nc_2d
        (ncid, (const char *const[]) { "cin", "CIN" }, 2, ctl, met, dd,
         met->cin,
         1.0, 1))
    WARN("Cannot read convective inhibition!");
}
 
/*****************************************************************************/
 
void read_met_nc_levels(
  const int ncid,
  const ctl_t *ctl,
  met_t *met,
  dd_t *dd) {
 
  /* Set timer... */
  SELECT_TIMER("READ_MET_NC_LEVELS", "INPUT");
  LOG(2, "Read level data...");
 
  /* Read temperature... */
  if (!read_met_nc_3d
      (ncid, (const char *const[]) { "t", "T", "temp", "TEMP" }, 4, ctl, met,
       dd, met->t, 1.0))
    ERRMSG("Cannot read temperature!");
 
  /* Read horizontal wind and vertical velocity... */
  if (!read_met_nc_3d
      (ncid, (const char *const[]) { "u", "U" }, 2, ctl, met, dd, met->u,
       1.0))
    ERRMSG("Cannot read zonal wind!");
  if (!read_met_nc_3d
      (ncid, (const char *const[]) { "v", "V" }, 2, ctl, met, dd, met->v,
       1.0))
    ERRMSG("Cannot read meridional wind!");
  if (!read_met_nc_3d
      (ncid, (const char *const[]) { "w", "W", "omega", "OMEGA" }, 4, ctl,
       met, dd, met->w, 0.01f))
    WARN("Cannot read vertical velocity!");
 
  /* Read water vapor... */
  if (!ctl->met_relhum) {
    if (!read_met_nc_3d
        (ncid, (const char *const[]) { "q", "Q", "sh", "SH" }, 4, ctl, met,
         dd, met->h2o,
         (float) (MA / MH2O)))
      WARN("Cannot read specific humidity!");
  } else {
    if (!read_met_nc_3d
        (ncid, (const char *const[]) { "rh", "RH" }, 2, ctl, met, dd,
         met->h2o, 0.01f))
      WARN("Cannot read relative humidity!");
#pragma omp parallel for default(shared) collapse(2)
    for (int ix = 0; ix < met->nx; ix++)
      for (int iy = 0; iy < met->ny; iy++)
        for (int ip = 0; ip < met->np; ip++) {
          double pw = met->h2o[ix][iy][ip] * PSAT(met->t[ix][iy][ip]);
          met->h2o[ix][iy][ip] =
            (float) (pw / (met->p[ip] - (1.0 - EPS) * pw));
        }
  }
 
  /* Read ozone... */
  if (!read_met_nc_3d
      (ncid, (const char *const[]) { "o3", "O3" }, 2, ctl, met, dd, met->o3,
       (float) (MA / MO3)))
    WARN("Cannot read ozone data!");
 
  /* Read cloud data... */
  if (!read_met_nc_3d
      (ncid, (const char *const[]) { "clwc", "CLWC" }, 2, ctl, met, dd,
       met->lwc, 1.0))
    WARN("Cannot read cloud liquid water content!");
  if (!read_met_nc_3d
      (ncid, (const char *const[]) { "crwc", "CRWC" }, 2, ctl, met, dd,
       met->rwc, 1.0))
    WARN("Cannot read cloud rain water content!");
  if (!read_met_nc_3d
      (ncid, (const char *const[]) { "ciwc", "CIWC" }, 2, ctl, met, dd,
       met->iwc, 1.0))
    WARN("Cannot read cloud ice water content!");
  if (!read_met_nc_3d
      (ncid, (const char *const[]) { "cswc", "CSWC" }, 2, ctl, met, dd,
       met->swc, 1.0))
    WARN("Cannot read cloud snow water content!");
  if (!read_met_nc_3d
      (ncid, (const char *const[]) { "cc", "CC" }, 2, ctl, met, dd, met->cc,
       1.0))
    WARN("Cannot read cloud cover!");
 
  /* Read zeta and zeta_dot... */
  if (ctl->advect_vert_coord == 1) {
    if (!read_met_nc_3d
        (ncid, (const char *const[]) { "ZETA", "zeta" }, 2, ctl, met, dd,
         met->zetal, 1.0))
      WARN("Cannot read ZETA!");
    if (!read_met_nc_3d
        (ncid, (const char *const[]) { "ZETA_DOT_TOT", "ZETA_DOT_clr",
         "zeta_dot_clr"
         }, 3, ctl, met, dd, met->zeta_dotl, 0.00001157407f))
      ERRMSG("Cannot read ZETA_DOT!");
  }
 
  /* Set eta coordinate on native model levels... */
  if (ctl->advect_vert_coord == 3 || ctl->qnt_eta_d >= 0) {
#pragma omp parallel for default(shared)
    for (int ix = 0; ix < met->nx; ix++)
      for (int iy = 0; iy < met->ny; iy++)
        for (int ip = 0; ip < met->np; ip++)
          met->zetal[ix][iy][ip] =
            (float) (met->hyam[ip] / (100.0 * P0) + met->hybm[ip]);
  }
 
  /* Read eta_dot... */
  if (ctl->advect_vert_coord == 3)
    if (!read_met_nc_3d
        (ncid, (const char *const[]) { "etadot", "ETADOT" }, 2, ctl, met, dd,
         met->zeta_dotl,
         1.0))
    ERRMSG("Cannot read eta vertical velocity!");
 
  /* Store velocities on model levels... */
  if (ctl->met_vert_coord != 0) {
#pragma omp parallel for default(shared)
    for (int ix = 0; ix < met->nx; ix++)
      for (int iy = 0; iy < met->ny; iy++)
        for (int ip = 0; ip < met->np; ip++) {
          met->ul[ix][iy][ip] = met->u[ix][iy][ip];
          met->vl[ix][iy][ip] = met->v[ix][iy][ip];
          met->wl[ix][iy][ip] = met->w[ix][iy][ip];
        }
 
    /* Save number of model levels... */
    met->npl = met->np;
  }
 
  /* Get pressure on model levels... */
  if (ctl->met_np > 0 || ctl->met_vert_coord != 0) {
 
    /* Read 3-D pressure field... */
    if (ctl->met_vert_coord == 1) {
      if (!read_met_nc_3d
          (ncid, (const char *const[]) { "pl", "PL", "pressure", "PRESSURE" },
           4, ctl, met, dd, met->pl,
           0.01f))
        if (!read_met_nc_3d
            (ncid, (const char *const[]) { "press", "PRESS" }, 2, ctl, met,
             dd, met->pl, 1.0))
        ERRMSG("Cannot read pressure on model levels!");
    }
 
    /* Use a and b coefficients for full levels (at layer midpoints)... */
    else if (ctl->met_vert_coord == 2 || ctl->met_vert_coord == 3) {
 
      /* Check number of levels... */
      if (ctl->met_vert_coord == 3 && met->np != ctl->met_nlev)
        ERRMSG("Mismatch in number of model levels!");
 
      /* Calculate pressure... */
      for (int ix = 0; ix < met->nx; ix++)
        for (int iy = 0; iy < met->ny; iy++)
          for (int ip = 0; ip < met->np; ip++)
            met->pl[ix][iy][ip] =
              (float) (met->hyam[ip] / 100. +
                       met->hybm[ip] * met->ps[ix][iy]);
    }
 
    /* Use a and b coefficients for half levels (at layer interfaces)... */
    else if (ctl->met_vert_coord == 4) {
 
      /* Check number of levels... */
      if (met->np + 1 != ctl->met_nlev)
        ERRMSG("Mismatch in number of model levels!");
 
      /* Calculate pressure... */
#pragma omp parallel for default(shared) collapse(2)
      for (int ix = 0; ix < met->nx; ix++)
        for (int iy = 0; iy < met->ny; iy++)
          for (int ip = 0; ip < met->np; ip++) {
            const double p0 =
              met->hyam[ip] / 100. + met->hybm[ip] * met->ps[ix][iy];
            const double p1 =
              met->hyam[ip + 1] / 100. + met->hybm[ip + 1] * met->ps[ix][iy];
            met->pl[ix][iy][ip] = (float) ((p1 - p0) / log(p1 / p0));
          }
    }
 
    /* Check ordering of pressure levels... */
    for (int ix = 0; ix < met->nx; ix++)
      for (int iy = 0; iy < met->ny; iy++)
        for (int ip = 1; ip < met->np; ip++)
          if ((met->pl[ix][iy][0] > met->pl[ix][iy][1]
               && met->pl[ix][iy][ip - 1] <= met->pl[ix][iy][ip])
              || (met->pl[ix][iy][0] < met->pl[ix][iy][1]
                  && met->pl[ix][iy][ip - 1] >= met->pl[ix][iy][ip]))
            ERRMSG("Pressure profiles are not monotonic!");
  }
 
  /* Interpolate from model levels to pressure levels... */
  if (ctl->met_np > 0) {
 
    /* Interpolate variables... */
    read_met_ml2pl(ctl, met, met->t, "T");
    read_met_ml2pl(ctl, met, met->u, "U");
    read_met_ml2pl(ctl, met, met->v, "V");
    read_met_ml2pl(ctl, met, met->w, "W");
    read_met_ml2pl(ctl, met, met->h2o, "H2O");
    read_met_ml2pl(ctl, met, met->o3, "O3");
    read_met_ml2pl(ctl, met, met->lwc, "LWC");
    read_met_ml2pl(ctl, met, met->rwc, "RWC");
    read_met_ml2pl(ctl, met, met->iwc, "IWC");
    read_met_ml2pl(ctl, met, met->swc, "SWC");
    read_met_ml2pl(ctl, met, met->cc, "CC");
 
    /* Set new pressure levels... */
    met->np = ctl->met_np;
    for (int ip = 0; ip < met->np; ip++)
      met->p[ip] = ctl->met_p[ip];
  }
 
  /* Check ordering of pressure levels... */
  for (int ip = 1; ip < met->np; ip++)
    if (met->p[ip - 1] < met->p[ip])
      ERRMSG("Pressure levels must be descending!");
}
 
/*****************************************************************************/
 
#ifdef DD
/* One file-local redistribution workspace. The eight entries per rank are
 * y/x starts, y/x counts, periodic x start/count, and the two x offsets. */
static struct {
  unsigned long long *geometry;
  float *global, *packed, *local;
  size_t global_elements, packed_elements, local_elements;
  int rank, size;
} met_global_2d;
 
static void met_global_2d_init(const dd_t *dd, const met_t *met) {
 
  MPI_Comm_rank(MPI_COMM_WORLD, &met_global_2d.rank);
  MPI_Comm_size(MPI_COMM_WORLD, &met_global_2d.size);
  const unsigned long long own[8] = {
    dd->subdomain_start[2], dd->subdomain_start[3],
    dd->subdomain_count[2], dd->subdomain_count[3],
    dd->halo_bnd_start[3], dd->halo_bnd_count[3],
    (unsigned long long) dd->halo_offset_start,
    (unsigned long long) dd->halo_offset_end
  };
  ALLOC(met_global_2d.geometry, unsigned long long,
        8 * (size_t) met_global_2d.size);
  MPI_Allgather(own, 8, MPI_UNSIGNED_LONG_LONG, met_global_2d.geometry,
                8, MPI_UNSIGNED_LONG_LONG, MPI_COMM_WORLD);
 
  const size_t nx = (size_t) dd->nx_glob, ny = (size_t) dd->ny_glob;
  if (nx > SIZE_MAX / ny || nx * ny > SIZE_MAX / sizeof(float))
    ERRMSG("Global 2-D meteorological field exceeds addressable memory!");
  met_global_2d.global_elements = nx * ny;
  met_global_2d.local_elements = (size_t) met->nx * (size_t) met->ny;
  if (met_global_2d.local_elements > SIZE_MAX / sizeof(float))
    ERRMSG("Local 2-D meteorological field exceeds addressable memory!");
  ALLOC(met_global_2d.local, float, met_global_2d.local_elements);
 
  for (int rank = 0; rank < met_global_2d.size; rank++) {
    const unsigned long long *g = met_global_2d.geometry + 8 * rank;
    if (g[3] > SIZE_MAX - g[5])
      ERRMSG("Invalid DD window width for global 2-D redistribution!");
    const size_t width = (size_t) g[3] + (size_t) g[5];
    if (width == 0 || g[2] > SIZE_MAX / width)
      ERRMSG("Invalid DD window size for global 2-D redistribution!");
    const size_t count = (size_t) g[2] * width;
    if (g[6] > width || g[3] > width - g[6]
        || g[7] > width || g[5] > width - g[7]
        || count > SIZE_MAX / sizeof(float)
        || g[0] + g[2] > ny || g[1] + g[3] > nx
        || g[4] + g[5] > nx)
      ERRMSG("Invalid DD window for global 2-D redistribution!");
    if (count > met_global_2d.packed_elements)
      met_global_2d.packed_elements = count;
  }
  ALLOC(met_global_2d.packed, float, met_global_2d.packed_elements);
}
 
static void met_global_2d_free(void) {
 
  free(met_global_2d.geometry);
  free(met_global_2d.global);
  free(met_global_2d.packed);
  free(met_global_2d.local);
  memset(&met_global_2d, 0, sizeof(met_global_2d));
}
 
static void met_global_2d_pack(
  const float *global,
  float *packed,
  const unsigned long long *g,
  const size_t nx) {
 
  const size_t width = (size_t) g[3] + (size_t) g[5];
  for (size_t y = 0; y < (size_t) g[2]; y++) {
    float *row = packed + y * width;
    const float *source = global + ((size_t) g[0] + y) * nx;
    memcpy(row + (size_t) g[6], source + (size_t) g[1],
           (size_t) g[3] * sizeof(float));
    if (g[5])
      memcpy(row + (size_t) g[7], source + (size_t) g[4],
             (size_t) g[5] * sizeof(float));
  }
}
 
static const float *met_global_2d_read(
  const int ncid,
  const int varid,
  const int ndims,
  const int level,
  const dd_t *dd) {
 
  const int reader = level % met_global_2d.size;
  if (met_global_2d.rank == reader) {
    SELECT_TIMER("MET_READ", "INPUT");
    if (met_global_2d.global == NULL)
      ALLOC(met_global_2d.global, float, met_global_2d.global_elements);
    if (ndims == 4) {
      const size_t start[4] = { 0, (size_t) level, 0, 0 };
      const size_t count[4] = { 1, 1, (size_t) dd->ny_glob,
        (size_t) dd->nx_glob };
      NC(nc_get_vara_float(ncid, varid, start, count,
                           met_global_2d.global));
    } else {
      const size_t start[3] = { 0, 0, 0 };
      const size_t count[3] = { 1, (size_t) dd->ny_glob,
        (size_t) dd->nx_glob };
      NC(nc_get_vara_float(ncid, varid, start, count,
                           met_global_2d.global));
    }
  }
 
  for (int rank = 0; rank < met_global_2d.size; rank++) {
    const unsigned long long *g = met_global_2d.geometry + 8 * rank;
    const size_t elements = (size_t) g[2] * ((size_t) g[3] + (size_t) g[5]);
    if (met_global_2d.rank == reader) {
      SELECT_TIMER("MET_PACK", "INPUT");
      float *target = rank == reader ? met_global_2d.local :
        met_global_2d.packed;
      met_global_2d_pack(met_global_2d.global, target, g,
                         (size_t) dd->nx_glob);
      if (rank != reader) {
        SELECT_TIMER("MET_MPI", "INPUT");
        for (size_t offset = 0; offset < elements;) {
          const int count = (int) MIN(elements - offset, (size_t) INT_MAX);
          if (MPI_Send(target + offset, count, MPI_FLOAT, rank, 0,
                       MPI_COMM_WORLD) != MPI_SUCCESS)
            ERRMSG("Failed to distribute meteorological field!");
          offset += (size_t) count;
        }
      }
    } else if (met_global_2d.rank == rank) {
      SELECT_TIMER("MET_MPI", "INPUT");
      for (size_t offset = 0; offset < elements;) {
        const int count = (int) MIN(elements - offset, (size_t) INT_MAX);
        if (MPI_Recv(met_global_2d.local + offset, count, MPI_FLOAT, reader,
                     0, MPI_COMM_WORLD, MPI_STATUS_IGNORE) != MPI_SUCCESS)
          ERRMSG("Failed to receive meteorological field!");
        offset += (size_t) count;
      }
    }
  }
  return met_global_2d.local;
}
 
static void met_global_2d_check_var(
  const int ncid,
  const int varid,
  const int ndims,
  const dd_t *dd,
  const int levels) {
 
  int actual, ids[NC_MAX_VAR_DIMS];
  char name[NC_MAX_NAME + 1];
  size_t length;
  NC(nc_inq_varndims(ncid, varid, &actual));
  if (actual != ndims)
    ERRMSG("MET_NC_READ_MODE=1 requires time-first NetCDF variables!");
  NC(nc_inq_vardimid(ncid, varid, ids));
  NC(nc_inq_dimname(ncid, ids[0], name));
  if (strcmp(name, "time") != 0)
    ERRMSG("MET_NC_READ_MODE=1 requires time as first dimension!");
  NC(nc_inq_dimlen(ncid, ids[0], &length));
  if (length < 1)
    ERRMSG("MET_NC_READ_MODE=1 requires a nonempty time dimension!");
  NC(nc_inq_dimname(ncid, ids[ndims - 1], name));
  if (strcmp(name, "lon") != 0)
    ERRMSG("MET_NC_READ_MODE=1 requires longitude as last dimension!");
  NC(nc_inq_dimlen(ncid, ids[ndims - 1], &length));
  if (length != (size_t) dd->nx_glob)
    ERRMSG("MET_NC_READ_MODE=1 requires longitude as fastest dimension!");
  NC(nc_inq_dimname(ncid, ids[ndims - 2], name));
  if (strcmp(name, "lat") != 0)
    ERRMSG("MET_NC_READ_MODE=1 requires latitude before longitude!");
  NC(nc_inq_dimlen(ncid, ids[ndims - 2], &length));
  if (length != (size_t) dd->ny_glob)
    ERRMSG("MET_NC_READ_MODE=1 requires latitude before longitude!");
  if (ndims == 4) {
    NC(nc_inq_dimlen(ncid, ids[1], &length));
    if (length != (size_t) levels)
      ERRMSG("MET_NC_READ_MODE=1 requires all vertical levels!");
  }
}
#endif
 
/*****************************************************************************/
 
int read_met_nc_2d(
  const int ncid,
  const char *const varnames[],
  const size_t nvarnames,
  const ctl_t *ctl,
  const met_t *met,
  dd_t *dd,
  float dest[EX][EY],
  const float scl,
  const int init) {
 
  const char *varsel = NULL;
 
  float offset, scalfac;
 
  int varid;
 
  /* Check if variable exists... */
  for (size_t i = 0; i < nvarnames; i++)
    if (nc_inq_varid(ncid, varnames[i], &varid) == NC_NOERR) {
      varsel = varnames[i];
      break;
    }
  if (varsel == NULL)
    return 0;
 
  /* Read packed data... */
  if (ctl->met_nc_scale && !ctl->dd
      && nc_get_att_float(ncid, varid, "add_offset", &offset) == NC_NOERR
      && nc_get_att_float(ncid, varid, "scale_factor",
                          &scalfac) == NC_NOERR) {
 
    /* Allocate... */
    short *help;
    ALLOC(help, short,
          EX * EY * EP);
 
    /* Read fill value and missing value... */
    short fillval, missval;
    if (nc_get_att_short(ncid, varid, "_FillValue", &fillval) != NC_NOERR)
      fillval = 0;
    if (nc_get_att_short(ncid, varid, "missing_value", &missval) != NC_NOERR)
      missval = 0;
 
    /* Write info... */
    LOG(2, "Read 2-D variable: %s"
        " (FILL = %d, MISS = %d, SCALE = %g, OFFSET = %g)",
        varsel, fillval, missval, scalfac, offset);
 
    /* Read data... */
    NC(nc_get_var_short(ncid, varid, help));
 
    /* Check meteo data layout... */
    if (ctl->met_convention != 0)
      ERRMSG("Meteo data layout not implemented for packed netCDF files!");
 
    /* Copy and check data... */
    omp_set_dynamic(1);
#pragma omp parallel for default(shared)
    for (int ix = 0; ix < met->nx; ix++)
      for (int iy = 0; iy < met->ny; iy++) {
        if (init)
          dest[ix][iy] = 0;
        const short aux = help[ARRAY_2D(iy, ix, met->nx)];
        if ((fillval == 0 || aux != fillval)
            && (missval == 0 || aux != missval)
            && fabsf(aux * scalfac + offset) < 1e14f)
          dest[ix][iy] += scl * (aux * scalfac + offset);
        else
          dest[ix][iy] = NAN;
      }
    omp_set_dynamic(0);
 
    /* Free... */
    free(help);
  }
 
  /* Unpacked data... */
  else if (!ctl->dd) {
 
    /* Allocate... */
    float *help;
    ALLOC(help, float,
          EX * EY);
 
    /* Read fill value and missing value... */
    float fillval, missval;
    if (nc_get_att_float(ncid, varid, "_FillValue", &fillval) != NC_NOERR)
      fillval = 0;
    if (nc_get_att_float(ncid, varid, "missing_value", &missval) != NC_NOERR)
      missval = 0;
 
    /* Write info... */
    LOG(2, "Read 2-D variable: %s (FILL = %g, MISS = %g)",
        varsel, fillval, missval);
 
    /* Read data... */
    NC(nc_get_var_float(ncid, varid, help));
 
    /* Check meteo data layout... */
    if (ctl->met_convention == 0) {
 
      /* Copy and check data (ordering: lat, lon)... */
      omp_set_dynamic(1);
#pragma omp parallel for default(shared)
      for (int ix = 0; ix < met->nx; ix++)
        for (int iy = 0; iy < met->ny; iy++) {
          if (init)
            dest[ix][iy] = 0;
          const float aux = help[ARRAY_2D(iy, ix, met->nx)];
          if ((fillval == 0 || aux != fillval)
              && (missval == 0 || aux != missval)
              && fabsf(aux) < 1e14f)
            dest[ix][iy] += scl * aux;
          else
            dest[ix][iy] = NAN;
        }
      omp_set_dynamic(0);
 
    } else {
 
      /* Copy and check data (ordering: lon, lat)... */
      omp_set_dynamic(1);
#pragma omp parallel for default(shared)
      for (int iy = 0; iy < met->ny; iy++)
        for (int ix = 0; ix < met->nx; ix++) {
          if (init)
            dest[ix][iy] = 0;
          const float aux = help[ARRAY_2D(ix, iy, met->ny)];
          if ((fillval == 0 || aux != fillval)
              && (missval == 0 || aux != missval)
              && fabsf(aux) < 1e14f)
            dest[ix][iy] += scl * aux;
          else
            dest[ix][iy] = NAN;
        }
      omp_set_dynamic(0);
    }
 
    /* Free... */
    free(help);
  }
 
  /* Domain decomposed data... */
  else {
 
    /* Read fill value and missing value... */
    float fillval, missval;
    if (nc_get_att_float(ncid, varid, "_FillValue", &fillval) != NC_NOERR)
      fillval = 0;
    if (nc_get_att_float(ncid, varid, "missing_value", &missval) != NC_NOERR)
      missval = 0;
 
    /* Write info... */
    LOG(2, "Read 2-D variable: %s (FILL = %g, MISS = %g)",
        varsel, fillval, missval);
 
#ifdef DD
    if (ctl->met_nc_read_mode == 1) {
      met_global_2d_check_var(ncid, varid, 3, dd, 0);
      NC(nc_var_par_access(ncid, varid, NC_INDEPENDENT));
      const float *help = met_global_2d_read(ncid, varid, 3, varid, dd);
      SELECT_TIMER("MET_CONVERT", "INPUT");
      omp_set_dynamic(1);
#pragma omp parallel for default(shared)
      for (int iy = 0; iy < met->ny; iy++)
        for (int ix = 0; ix < met->nx; ix++) {
          const float aux = help[(size_t) iy * (size_t) met->nx + (size_t) ix];
          if (init)
            dest[ix][iy] = 0;
          if ((fillval == 0 || aux != fillval)
              && (missval == 0 || aux != missval) && fabsf(aux) < 1e14f)
            dest[ix][iy] += scl * aux;
          else
            dest[ix][iy] = NAN;
        }
      omp_set_dynamic(0);
      /* Return to the caller's timer (only called from read_met_nc_surface)... */
      SELECT_TIMER("READ_MET_SURFACE", "INPUT");
      return 1;
    }
#endif
 
    /* Define hyperslab... */
    float *help;
    size_t help_subdomain_start[3];
    size_t help_subdomain_count[3];
 
    help_subdomain_start[0] = 0;
    if (ctl->met_convention == 0) {
      help_subdomain_start[1] = dd->subdomain_start[2];
      help_subdomain_start[2] = dd->subdomain_start[3];
    } else {
      help_subdomain_start[1] = dd->subdomain_start[3];
      help_subdomain_start[2] = dd->subdomain_start[2];
    }
 
    help_subdomain_count[0] = 1;
    if (ctl->met_convention == 0) {
      help_subdomain_count[1] = dd->subdomain_count[2]; //y
      help_subdomain_count[2] = dd->subdomain_count[3]; //x
    } else {
      help_subdomain_count[1] = dd->subdomain_count[3]; //x
      help_subdomain_count[2] = dd->subdomain_count[2]; //y
    }
 
    ALLOC(help, float,
            (int) dd->subdomain_count[2] * (int) dd->subdomain_count[3]);
 
    /* Read data... */
    SELECT_TIMER("MET_READ", "INPUT");
#ifdef DD
    nc_var_par_access(ncid, varid, NC_COLLECTIVE);
#endif
    NC(nc_get_vara_float
       (ncid, varid, help_subdomain_start, help_subdomain_count, help));
 
    /* Read halos at boundaries... */
    size_t help_halo_bnd_start[3];
    size_t help_halo_bnd_count[3];
 
    help_halo_bnd_start[0] = 0;
    if (ctl->met_convention == 0) {
      help_halo_bnd_start[1] = dd->halo_bnd_start[2];
      help_halo_bnd_start[2] = dd->halo_bnd_start[3];
    } else {
      help_halo_bnd_start[1] = dd->halo_bnd_start[3];
      help_halo_bnd_start[2] = dd->halo_bnd_start[2];
    }
 
    help_halo_bnd_count[0] = 1;
    if (ctl->met_convention == 0) {
      help_halo_bnd_count[1] = dd->halo_bnd_count[2];   //y
      help_halo_bnd_count[2] = dd->halo_bnd_count[3];   //x
    } else {
      help_halo_bnd_count[1] = dd->halo_bnd_count[3];   //x
      help_halo_bnd_count[2] = dd->halo_bnd_count[2];   //y
    }
 
    float *help_halo;
    ALLOC(help_halo, float,
          help_halo_bnd_count[1] * help_halo_bnd_count[2]);
 
#ifdef DD
    nc_var_par_access(ncid, varid, NC_COLLECTIVE);
#endif
    NC(nc_get_vara_float
       (ncid, varid, help_halo_bnd_start, help_halo_bnd_count,
        help_halo));
 
    SELECT_TIMER("MET_CONVERT", "INPUT");
 
    /* Check meteo data layout... */
    if (ctl->met_convention == 0) {
 
      /* Copy and check data (ordering: lat, lon)... */
      omp_set_dynamic(1);
#pragma omp parallel for default(shared)
      for (int ix = 0; ix < (int) help_subdomain_count[2]; ix++)
        for (int iy = 0; iy < (int) help_subdomain_count[1]; iy++) {
          if (init == 1)
            dest[ix + dd->halo_offset_start][iy] = 0;
          const float aux =
            help[ARRAY_2D(iy, ix, (int) help_subdomain_count[2])];
          if ((fillval == 0 || aux != fillval)
              && (missval == 0 || aux != missval)
              && fabsf(aux) < 1e14f) {
            dest[ix + dd->halo_offset_start][iy] += scl * aux;
          } else
            dest[ix + dd->halo_offset_start][iy] = NAN;
        }
 
#pragma omp parallel for default(shared)
      for (int ix = 0; ix < (int) help_halo_bnd_count[2]; ix++)
        for (int iy = 0; iy < (int) help_halo_bnd_count[1]; iy++) {
          if (init == 1)
            dest[ix + dd->halo_offset_end][iy] = 0;
          const float aux =
            help_halo[ARRAY_2D(iy, ix, (int) help_halo_bnd_count[2])];
          if ((fillval == 0 || aux != fillval)
              && (missval == 0 || aux != missval)
              && fabsf(aux) < 1e14f)
            dest[ix + dd->halo_offset_end][iy] += scl * aux;
          else {
            dest[ix + dd->halo_offset_end][iy] = NAN;
          }
        }
      omp_set_dynamic(0);
 
    } else {
 
      /* Copy and check data (ordering: lon, lat)... */
      omp_set_dynamic(1);
#pragma omp parallel for default(shared)
      for (int ix = 0; ix < (int) help_subdomain_count[1]; ix++)
        for (int iy = 0; iy < (int) help_subdomain_count[2]; iy++) {
          if (init == 1)
            dest[ix + dd->halo_offset_start][iy] = 0;
          const float aux =
            help[ARRAY_2D(ix, iy, (int) help_subdomain_count[1])];
          if ((fillval == 0 || aux != fillval)
              && (missval == 0 || aux != missval)
              && fabsf(aux) < 1e14f)
            dest[ix + dd->halo_offset_start][iy] += scl * aux;
          else
            dest[ix + dd->halo_offset_start][iy] = NAN;
        }
 
#pragma omp parallel for default(shared)
      for (int ix = 0; ix < (int) help_halo_bnd_count[1]; ix++)
        for (int iy = 0; iy < (int) help_halo_bnd_count[2]; iy++) {
          if (init == 1)
            dest[ix + dd->halo_offset_end][iy] = 0;
          const float aux =
            help_halo[ARRAY_2D(ix, iy, (int) help_halo_bnd_count[1])];
          if ((fillval == 0 || aux != fillval)
              && (missval == 0 || aux != missval)
              && fabsf(aux) < 1e14f)
            dest[ix + dd->halo_offset_end][iy] += scl * aux;
          else
            dest[ix + dd->halo_offset_end][iy] = NAN;
        }
      omp_set_dynamic(0);
    }
    /* Return to the caller's timer (only called from read_met_nc_surface)... */
    SELECT_TIMER("READ_MET_SURFACE", "INPUT");
 
    /* Free... */
    free(help);
    free(help_halo);
  }
 
  /* Return... */
  return 1;
}
 
/*****************************************************************************/
 
int read_met_nc_3d(
  const int ncid,
  const char *const varnames[],
  const size_t nvarnames,
  const ctl_t *ctl,
  const met_t *met,
  dd_t *dd,
  float dest[EX][EY][EP],
  const float scl) {
 
  const char *varsel = NULL;
 
  float offset, scalfac;
 
  int varid;
 
  /* Check if variable exists... */
  for (size_t i = 0; i < nvarnames; i++)
    if (nc_inq_varid(ncid, varnames[i], &varid) == NC_NOERR) {
      varsel = varnames[i];
      break;
    }
  if (varsel == NULL)
    return 0;
 
  /* Read packed data... */
  if (ctl->met_nc_scale && !ctl->dd
      && nc_get_att_float(ncid, varid, "add_offset", &offset) == NC_NOERR
      && nc_get_att_float(ncid, varid, "scale_factor",
                          &scalfac) == NC_NOERR) {
 
    /* Allocate... */
    short *help;
    ALLOC(help, short,
          EX * EY * EP);
 
    /* Read fill value and missing value... */
    short fillval, missval;
    if (nc_get_att_short(ncid, varid, "_FillValue", &fillval) != NC_NOERR)
      fillval = 0;
    if (nc_get_att_short(ncid, varid, "missing_value", &missval) != NC_NOERR)
      missval = 0;
 
    /* Write info... */
    LOG(2, "Read 3-D variable: %s "
        "(FILL = %d, MISS = %d, SCALE = %g, OFFSET = %g)",
        varsel, fillval, missval, scalfac, offset);
 
    /* Read data... */
    NC(nc_get_var_short(ncid, varid, help));
 
    /* Check meteo data layout... */
    if (ctl->met_convention != 0)
      ERRMSG("Meteo data layout not implemented for packed netCDF files!");
 
    /* Copy and check data... */
    omp_set_dynamic(1);
#pragma omp parallel for default(shared)
    for (int ix = 0; ix < met->nx; ix++)
      for (int iy = 0; iy < met->ny; iy++)
        for (int ip = 0; ip < met->np; ip++) {
          const short aux = help[ARRAY_3D(ip, iy, met->ny, ix, met->nx)];
          if ((fillval == 0 || aux != fillval)
              && (missval == 0 || aux != missval)
              && fabsf(aux * scalfac + offset) < 1e14f)
            dest[ix][iy][ip] = scl * (aux * scalfac + offset);
          else
            dest[ix][iy][ip] = NAN;
        }
    omp_set_dynamic(0);
 
    /* Free... */
    free(help);
  }
 
  /* Unpacked data... */
  else if (!ctl->dd) {
 
    /* Allocate... */
    float *help;
    ALLOC(help, float,
          EX * EY * EP);
 
    /* Read fill value and missing value... */
    float fillval, missval;
    if (nc_get_att_float(ncid, varid, "_FillValue", &fillval) != NC_NOERR)
      fillval = 0;
    if (nc_get_att_float(ncid, varid, "missing_value", &missval) != NC_NOERR)
      missval = 0;
 
    /* Write info... */
    LOG(2, "Read 3-D variable: %s (FILL = %g, MISS = %g)",
        varsel, fillval, missval);
 
    /* Read data... */
    NC(nc_get_var_float(ncid, varid, help));
 
    /* Check meteo data layout... */
    if (ctl->met_convention == 0) {
 
      /* Copy and check data (ordering: lev, lat, lon)... */
      omp_set_dynamic(1);
#pragma omp parallel for default(shared)
      for (int ix = 0; ix < met->nx; ix++)
        for (int iy = 0; iy < met->ny; iy++)
          for (int ip = 0; ip < met->np; ip++) {
            const float aux = help[ARRAY_3D(ip, iy, met->ny, ix, met->nx)];
            if ((fillval == 0 || aux != fillval)
                && (missval == 0 || aux != missval)
                && fabsf(aux) < 1e14f)
              dest[ix][iy][ip] = scl * aux;
            else
              dest[ix][iy][ip] = NAN;
          }
      omp_set_dynamic(0);
 
    } else {
 
      /* Copy and check data (ordering: lon, lat, lev)... */
      omp_set_dynamic(1);
#pragma omp parallel for default(shared)
      for (int ip = 0; ip < met->np; ip++)
        for (int iy = 0; iy < met->ny; iy++)
          for (int ix = 0; ix < met->nx; ix++) {
            const float aux = help[ARRAY_3D(ix, iy, met->ny, ip, met->np)];
            if ((fillval == 0 || aux != fillval)
                && (missval == 0 || aux != missval)
                && fabsf(aux) < 1e14f)
              dest[ix][iy][ip] = scl * aux;
            else
              dest[ix][iy][ip] = NAN;
          }
      omp_set_dynamic(0);
    }
 
    /* Free... */
    free(help);
  }
 
  /* Domain decomposed data... */
  else {
 
    /* Read fill value and missing value... */
    float fillval, missval;
    if (nc_get_att_float(ncid, varid, "_FillValue", &fillval) != NC_NOERR)
      fillval = 0;
    if (nc_get_att_float(ncid, varid, "missing_value", &missval) != NC_NOERR)
      missval = 0;
 
    /* Write info... */
    LOG(2, "Read 3-D variable: %s (FILL = %g, MISS = %g)",
        varsel, fillval, missval);
 
#ifdef DD
    if (ctl->met_nc_read_mode == 1) {
      met_global_2d_check_var(ncid, varid, 4, dd, met->np);
      NC(nc_var_par_access(ncid, varid, NC_INDEPENDENT));
      for (int ip = 0; ip < met->np; ip++) {
        const float *help = met_global_2d_read(ncid, varid, 4, ip, dd);
        SELECT_TIMER("MET_CONVERT", "INPUT");
        omp_set_dynamic(1);
#pragma omp parallel for default(shared)
        for (int iy = 0; iy < met->ny; iy++)
          for (int ix = 0; ix < met->nx; ix++) {
            const float aux =
              help[(size_t) iy * (size_t) met->nx + (size_t) ix];
            if ((fillval == 0 || aux != fillval)
                && (missval == 0 || aux != missval) && fabsf(aux) < 1e14f)
              dest[ix][iy][ip] = scl * aux;
            else
              dest[ix][iy][ip] = NAN;
          }
        omp_set_dynamic(0);
      }
      /* Return to the caller's timer (only called from read_met_nc_levels)... */
      SELECT_TIMER("READ_MET_NC_LEVELS", "INPUT");
      return 1;
    }
#endif
 
    /* Define hyperslab... */
    size_t help_subdomain_start[4];
    size_t help_subdomain_count[4];
    size_t help_halo_bnd_start[4];
    size_t help_halo_bnd_count[4];
 
    if (ctl->met_convention == 0) {
      for (int i = 0; i < 4; i++) {
        help_subdomain_start[i] = dd->subdomain_start[i];
        help_subdomain_count[i] = dd->subdomain_count[i];
        help_halo_bnd_start[i] = dd->halo_bnd_start[i];
        help_halo_bnd_count[i] = dd->halo_bnd_count[i];
      }
    } else {
      help_subdomain_start[0] = dd->subdomain_start[0];
      help_subdomain_start[1] = dd->subdomain_start[3];
      help_subdomain_start[2] = dd->subdomain_start[2];
      help_subdomain_start[3] = dd->subdomain_start[1];
 
      help_subdomain_count[0] = dd->subdomain_count[0];
      help_subdomain_count[1] = dd->subdomain_count[3];
      help_subdomain_count[2] = dd->subdomain_count[2];
      help_subdomain_count[3] = dd->subdomain_count[1];
 
      help_halo_bnd_start[0] = dd->halo_bnd_start[0];
      help_halo_bnd_start[1] = dd->halo_bnd_start[3];
      help_halo_bnd_start[2] = dd->halo_bnd_start[2];
      help_halo_bnd_start[3] = dd->halo_bnd_start[1];
 
      help_halo_bnd_count[0] = dd->halo_bnd_count[0];
      help_halo_bnd_count[1] = dd->halo_bnd_count[3];
      help_halo_bnd_count[2] = dd->halo_bnd_count[2];
      help_halo_bnd_count[3] = dd->halo_bnd_count[1];
    }
 
    /* Allocate... */
    float *help;
    ALLOC(help, float,
            (int) dd->subdomain_count[0] * (int) dd->subdomain_count[1]
          * (int) dd->subdomain_count[2] * (int) dd->subdomain_count[3]);
 
    /* Use default NetCDF parallel I/O behavior */
    SELECT_TIMER("MET_READ", "INPUT");
#ifdef DD
    NC(nc_var_par_access(ncid, varid, NC_INDEPENDENT));
#endif
    NC(nc_get_vara_float
       (ncid, varid, help_subdomain_start, help_subdomain_count, help));
 
    /* Read halos separately at boundaries... */
    float *help_halo;
    ALLOC(help_halo, float,
          dd->halo_bnd_count[0] * dd->halo_bnd_count[1] *
          dd->halo_bnd_count[2] * dd->halo_bnd_count[3]);
 
#ifdef DD
    NC(nc_var_par_access(ncid, varid, NC_INDEPENDENT));
#endif
    if (dd->halo_bnd_count[1] > 0 && dd->halo_bnd_count[2] > 0
        && dd->halo_bnd_count[3] > 0) {
      NC(nc_get_vara_float
         (ncid, varid, help_halo_bnd_start, help_halo_bnd_count,
          help_halo));
    }
 
    SELECT_TIMER("MET_CONVERT", "INPUT");
 
    /* Check meteo data layout... */
    if (ctl->met_convention == 0) {
 
      /* Copy and check data (ordering: lev, lat, lon)... */
      omp_set_dynamic(1);
#pragma omp parallel for default(shared)
      for (int ix = 0; ix < (int) dd->subdomain_count[3]; ix++)
        for (int iy = 0; iy < (int) dd->subdomain_count[2]; iy++)
          for (int ip = 0; ip < met->np; ip++) {
            const float aux =
              help[ARRAY_3D(ip, iy, (int) dd->subdomain_count[2], ix,
                            (int) dd->subdomain_count[3])];
            if ((fillval == 0 || aux != fillval)
                && (missval == 0 || aux != missval)
                && fabsf(aux) < 1e14f) {
              dest[ix + dd->halo_offset_start][iy][ip] = scl * aux;
 
            } else
              dest[ix + dd->halo_offset_start][iy][ip] = NAN;
          }
 
#pragma omp parallel for default(shared)
      for (int ix = 0; ix < (int) dd->halo_bnd_count[3]; ix++)
        for (int iy = 0; iy < (int) dd->halo_bnd_count[2]; iy++)
          for (int ip = 0; ip < met->np; ip++) {
            const float aux =
              help_halo[ARRAY_3D(ip, iy, (int) dd->halo_bnd_count[2], ix,
                                 (int) dd->halo_bnd_count[3])];
            if ((fillval == 0 || aux != fillval)
                && (missval == 0 || aux != missval)
                && fabsf(aux) < 1e14f)
              dest[ix + dd->halo_offset_end][iy][ip] = scl * aux;
            else
              dest[ix + dd->halo_offset_end][iy][ip] = NAN;
          }
      omp_set_dynamic(0);
 
    } else {
 
      /* Copy and check data (ordering: lon, lat, lev)... */
      omp_set_dynamic(1);
#pragma omp parallel for default(shared)
      for (int ip = 0; ip < met->np; ip++)
        for (int iy = 0; iy < (int) dd->subdomain_count[2]; iy++)
          for (int ix = 0; ix < (int) dd->subdomain_count[3]; ix++) {
            const float aux =
              help[ARRAY_3D
                   (ix, iy, (int) dd->subdomain_count[2], ip, met->np)];
            if ((fillval == 0 || aux != fillval)
                && (missval == 0 || aux != missval)
                && fabsf(aux) < 1e14f)
              dest[ix + dd->halo_offset_start][iy][ip] = scl * aux;
            else
              dest[ix + dd->halo_offset_start][iy][ip] = NAN;
          }
 
#pragma omp parallel for default(shared)
      for (int ip = 0; ip < met->np; ip++)
        for (int iy = 0; iy < (int) dd->halo_bnd_count[2]; iy++)
          for (int ix = 0; ix < (int) dd->halo_bnd_count[3]; ix++) {
            const float aux =
              help_halo[ARRAY_3D(ix, iy, (int) dd->halo_bnd_count[2], ip,
                                 met->np)];
            if ((fillval == 0 || aux != fillval)
                && (missval == 0 || aux != missval)
                && fabsf(aux) < 1e14f)
              dest[ix + dd->halo_offset_end][iy][ip] = scl * aux;
            else
              dest[ix + dd->halo_offset_end][iy][ip] = NAN;
          }
      omp_set_dynamic(0);
    }
    /* Return to the caller's timer (only called from read_met_nc_levels)... */
    SELECT_TIMER("READ_MET_NC_LEVELS", "INPUT");
 
    /* Free... */
    free(help);
    free(help_halo);
  }
 
  /* Return... */
  return 1;
}
 
/*****************************************************************************/
 
#ifdef ECCODES
int read_met_grib(
  const char *filename,
  const ctl_t *ctl,
  met_t *met) {
 
  /* Set filenames... */
  size_t filename_len = strlen(filename) + 1;
  char sf_filename[filename_len];
  char ml_filename[filename_len];
  strcpy(sf_filename, filename);
  strcpy(ml_filename, filename);
  get_met_replace(ml_filename, "XX", "ml");
  get_met_replace(sf_filename, "XX", "sf");
 
  /* Open files... */
  FILE *ml_file = fopen(ml_filename, "rb");
  FILE *sf_file = fopen(sf_filename, "rb");
  if (ml_file == NULL || sf_file == NULL) {
    if (ml_file != NULL) {
      fclose(ml_file);
      WARN("Cannot open file: %s", sf_filename);
    }
    if (sf_file != NULL) {
      fclose(sf_file);
      WARN("Cannot open file: %s", ml_filename);
    }
    return 0;
  }
 
  /* Get handles for model level data... */
  int ml_num_messages = 0, err = 0;
  ECC(codes_count_in_file(0, ml_file, &ml_num_messages));
  codes_handle **ml_handles =
    (codes_handle **) malloc(sizeof(codes_handle *) *
                             (size_t) ml_num_messages);
  for (int i = 0; i < ml_num_messages; i++) {
    codes_handle *h = NULL;
    if ((h = codes_grib_handle_new_from_file(0, ml_file, &err)) != NULL)
      ml_handles[i] = h;
  }
 
  /* Get handles for surface data... */
  int sf_num_messages = 0;
  ECC(codes_count_in_file(0, sf_file, &sf_num_messages));
  codes_handle **sf_handles =
    (codes_handle **) malloc(sizeof(codes_handle *) *
                             (size_t) sf_num_messages);
  for (int i = 0; i < sf_num_messages; i++) {
    codes_handle *h = NULL;
    if ((h = codes_grib_handle_new_from_file(0, sf_file, &err)) != NULL)
      sf_handles[i] = h;
  }
 
  /* Close files... */
  fclose(ml_file);
  fclose(sf_file);
 
  /* Read grid data... */
  read_met_grib_grid(ml_handles, ml_num_messages, met);
 
  /* Read surface data... */
  read_met_grib_surface(sf_handles, sf_num_messages, ctl, met);
  for (int i = 0; i < sf_num_messages; i++)
    codes_handle_delete(sf_handles[i]);
  free(sf_handles);
 
  /* Compute 3D pressure field... */
  size_t value_count = 0;
  ECC(codes_get_size(ml_handles[0], "pv", &value_count));
  if (value_count % 2 != 0)
    ERRMSG("Unexpected pv array length!");
  size_t nlevels = value_count / 2 - 1; /* number of full model levels */
  double *values;
  ALLOC(values, double,
        value_count);
  ECC(codes_get_double_array(ml_handles[0], "pv", values, &value_count));
  double *a_vals = values;
  double *b_vals = values + nlevels;
  if (met->npl > (int) nlevels)
    ERRMSG("met->npl exceeds number of pressure levels in GRIB!");
  for (int nx = 0; nx < met->nx; nx++)
    for (int ny = 0; ny < met->ny; ny++)
      for (int level = 0; level <= met->npl; level++) {
        const float p1 = (float) (a_vals[level] * 0.01f +
                                  met->ps[nx][ny] * b_vals[level]);
        const float p2 = (float) (a_vals[level + 1] * 0.01f +
                                  met->ps[nx][ny] * b_vals[level + 1]);
        met->pl[nx][ny][level] = 0.5f * (p1 + p2);
      }
  free(values);
 
  /* Read model level data... */
  read_met_grib_levels(ml_handles, ml_num_messages, ctl, met);
  for (int i = 0; i < ml_num_messages; i++)
    codes_handle_delete(ml_handles[i]);
  free(ml_handles);
 
  /* Return success... */
  return 1;
}
#endif
 
/*****************************************************************************/
 
#ifdef ECCODES
void read_met_grib_grid(
  codes_handle **handles,
  int count_handles,
  met_t *met) {
 
  /* Set timer... */
  SELECT_TIMER("READ_MET_GRIB_GRID", "INPUT");
  LOG(2, "Read meteo grid information...");
 
  /* Read date and time... */
  char datestr[LEN], timestr[LEN];
  size_t s_date = sizeof(datestr);
  ECC(codes_get_string(handles[0], "dataDate", datestr, &s_date));
  size_t s_time = sizeof(timestr);
  ECC(codes_get_string(handles[0], "dataTime", timestr, &s_time));
  int year, month, day, hour;
  if (sscanf(datestr, "%4d%2d%2d", &year, &month, &day) != 3)
    ERRMSG("Failed to parse dataDate: %s", datestr);
  if (sscanf(timestr, "%2d", &hour) != 1)
    ERRMSG("Failed to parse dataTime: %s", timestr);
  time2jsec(year, month, day, hour, 0, 0, 0, &(met->time));
  LOG(2, "Time: %.2f (%d-%02d-%02d, %02d:%02d UTC)", met->time, year, month,
      day, hour, 0);
 
  /* Read grid information... */
  long count_lat = 0, count_lon = 0;
  ECC(codes_get_long(handles[0], "Nj", &count_lat));
  ECC(codes_get_long(handles[0], "Ni", &count_lon));
  met->ny = (int) count_lat;
  met->nx = (int) count_lon;
 
  /* Check grid dimensions... */
  LOG(2, "Number of longitudes: %d", met->nx);
  if (met->nx < 2 || met->nx > EX)
    ERRMSG("Number of longitudes out of range!");
  LOG(2, "Number of latitudes: %d", met->ny);
  if (met->ny < 2 || met->ny > EY)
    ERRMSG("Number of latitudes out of range!");
 
  double first_lon, last_lon, first_lat, last_lat, inc_lon, inc_lat;
  ECC(codes_get_double
      (handles[0], "longitudeOfFirstGridPointInDegrees", &first_lon));
  ECC(codes_get_double
      (handles[0], "latitudeOfFirstGridPointInDegrees", &first_lat));
  ECC(codes_get_double
      (handles[0], "longitudeOfLastGridPointInDegrees", &last_lon));
  ECC(codes_get_double
      (handles[0], "latitudeOfLastGridPointInDegrees", &last_lat));
  ECC(codes_get_double(handles[0], "iDirectionIncrementInDegrees", &inc_lon));
  ECC(codes_get_double(handles[0], "jDirectionIncrementInDegrees", &inc_lat));
 
  long jscanpos, iscanneg;
  ECC(codes_get_long(handles[0], "iScansNegatively", &iscanneg));
  ECC(codes_get_long(handles[0], "jScansPositively", &jscanpos));
 
  /* Compute longitude-latitude grid... */
  int counter = 0;
  if (iscanneg == 0)
    for (double i = first_lon; i <= last_lon + 1e-6; i += inc_lon) {
      met->lon[counter] = i;
      counter++;
  } else
    for (double i = first_lon; i > last_lon - 1e-6; i -= inc_lon) {
      met->lon[counter] = i;
      counter++;
    }
 
  counter = 0;
  if (jscanpos == 0)
    for (double i = first_lat; i > last_lat - 1e-6; i -= inc_lat) {
      met->lat[counter] = i;
      counter++;
  } else
    for (double i = first_lat; i <= last_lat + 1e-6; i += inc_lat) {
      met->lat[counter] = i;
      counter++;
    }
 
  /* Write info... */
  LOG(2, "Longitudes: %g, %g ... %g deg",
      met->lon[0], met->lon[1], met->lon[met->nx - 1]);
  LOG(2, "Latitudes: %g, %g ... %g deg",
      met->lat[0], met->lat[1], met->lat[met->ny - 1]);
 
  /* Read vertical levels... */
  int max_level = 0;
  for (int i = 0; i < count_handles; i++) {
    long level;
    ECC(codes_get_long(handles[i], "level", &level));
    if (level > max_level)
      max_level = (int) level;
  }
  met->npl = max_level;
 
  /* Check number of levels... */
  LOG(2, "Number of levels: %d", met->npl);
  if (met->npl < 2 || met->npl > EP)
    ERRMSG("Number of levels out of range!");
}
#endif
 
/*****************************************************************************/
 
#ifdef ECCODES
void read_met_grib_levels(
  codes_handle **handles,
  const int num_messages,
  const ctl_t *ctl,
  met_t *met) {
 
  /* Set timer... */
  SELECT_TIMER("READ_MET_GRIB_LEVELS", "INPUT");
  LOG(2, "Read level data...");
 
  /* Init... */
  int t_flag = 0, u_flag = 0, v_flag = 0, w_flag = 0, o3_flag = 0, h2o_flag =
    0, lwc_flag = 0, rwc_flag = 0, iwc_flag = 0, swc_flag = 0, cc_flag = 0;
 
  /* Iterate over all messages... */
  for (int i = 0; i < num_messages; i++) {
 
    size_t max_size = LEN;
    char short_name[max_size];
    size_t value_count;
    double *values;
 
    /* Get the current level */
    long current_level;
    ECC(codes_get_long(handles[i], "level", &current_level));
    current_level -= 1;
 
    /* Retrieve data from current message */
    ECC(codes_get_string(handles[i], "shortName", short_name, &max_size));
    ECC(codes_get_size(handles[i], "values", &value_count));
    ALLOC(values, double,
          value_count);
    ECC(codes_get_double_array(handles[i], "values", values, &value_count));
 
    /* Read temperature... */
    ECC_READ_3D("t", current_level, met->t, 1.0, t_flag);
 
    /* Read horizontal wind and vertical velocity... */
    ECC_READ_3D("u", current_level, met->u, 1.0, u_flag);
    ECC_READ_3D("v", current_level, met->v, 1.0, v_flag);
    ECC_READ_3D("w", current_level, met->w, 0.01f, w_flag);
 
    /* Read water vapor and ozone... */
    ECC_READ_3D("q", current_level, met->h2o, (float) (MA / MH2O), h2o_flag);
    ECC_READ_3D("o3", current_level, met->o3, (float) (MA / MO3), o3_flag);
 
    /* Read cloud data... */
    ECC_READ_3D("clwc", current_level, met->lwc, 1.0, lwc_flag);
    ECC_READ_3D("crwc", current_level, met->rwc, 1.0, rwc_flag);
    ECC_READ_3D("ciwc", current_level, met->iwc, 1.0, iwc_flag);
    ECC_READ_3D("cswc", current_level, met->swc, 1.0, swc_flag);
    ECC_READ_3D("cc", current_level, met->cc, 1.0, cc_flag);
 
    /*Free allocated array */
    free(values);
  }
 
  /* Check whether data were found... */
  if (t_flag != met->npl)
    ERRMSG("Cannot read temperature!");
  if (u_flag != met->npl)
    ERRMSG("Cannot read zonal wind!");
  if (v_flag != met->npl)
    ERRMSG("Cannot read meridional wind!");
  if (w_flag != met->npl)
    WARN("Cannot read vertical velocity!");
  if (h2o_flag != met->npl)
    WARN("Cannot read specific humidity!");
  if (o3_flag != met->npl)
    WARN("Cannot read ozone data!");
  if (lwc_flag != met->npl)
    WARN("Cannot read cloud liquid water content!");
  if (rwc_flag != met->npl)
    WARN("Cannot read cloud rain water content!");
  if (iwc_flag != met->npl)
    WARN("Cannot read cloud ice water content!");
  if (swc_flag != met->npl)
    WARN("Cannot read cloud snow water content!");
  if (cc_flag != met->npl)
    WARN("Cannot read cloud cover!");
 
  /* Check ordering of pressure levels... */
  for (int ix = 0; ix < met->nx; ix++)
    for (int iy = 0; iy < met->ny; iy++)
      for (int ip = 1; ip < met->np; ip++)
        if ((met->pl[ix][iy][0] > met->pl[ix][iy][1]
             && met->pl[ix][iy][ip - 1] <= met->pl[ix][iy][ip])
            || (met->pl[ix][iy][0] < met->pl[ix][iy][1]
                && met->pl[ix][iy][ip - 1] >= met->pl[ix][iy][ip])) {
          LOG(1, "%f %f %f %f", met->pl[ix][iy][0], met->pl[ix][iy][1],
              met->pl[ix][iy][ip - 1], met->pl[ix][iy][ip]);
          ERRMSG("Pressure profiles are not monotonic!");
        }
 
  /* Interpolate from model levels to pressure levels... */
  if (ctl->met_np > 0) {
    met->np = ctl->met_np;
 
    /* Interpolate variables... */
    read_met_ml2pl(ctl, met, met->t, "T");
    read_met_ml2pl(ctl, met, met->u, "U");
    read_met_ml2pl(ctl, met, met->v, "V");
    read_met_ml2pl(ctl, met, met->w, "W");
    read_met_ml2pl(ctl, met, met->h2o, "H2O");
    read_met_ml2pl(ctl, met, met->o3, "O3");
    read_met_ml2pl(ctl, met, met->lwc, "LWC");
    read_met_ml2pl(ctl, met, met->rwc, "RWC");
    read_met_ml2pl(ctl, met, met->iwc, "IWC");
    read_met_ml2pl(ctl, met, met->swc, "SWC");
    read_met_ml2pl(ctl, met, met->cc, "CC");
 
    /* Set new pressure levels... */
    for (int ip = 0; ip < met->np; ip++)
      met->p[ip] = ctl->met_p[ip];
  }
 
  /* Check ordering of pressure levels... */
  for (int ip = 1; ip < met->np; ip++)
    if (met->p[ip - 1] < met->p[ip])
      ERRMSG("Pressure levels must be descending!");
}
#endif
 
/*****************************************************************************/
 
#ifdef ECCODES
void read_met_grib_surface(
  codes_handle **handles,
  const int num_messages,
  const ctl_t *ctl,
  met_t *met) {
 
  /* Set timer... */
  SELECT_TIMER("READ_MET_GRIB_SURFACE", "INPUT");
  LOG(2, "Read surface data...");
 
  /* Init... */
  int sp_flag = 0, z_flag = 0, t_flag = 0, u_flag = 0, v_flag = 0, ess_flag =
    0, nss_flag = 0, shf_flag = 0, lsm_flag = 0, sst_flag = 0, cape_flag = 0,
    cin_flag = 0, pbl_flag = 0;
 
  /* Iterate over all messages... */
  for (int i = 0; i < num_messages; i++) {
 
    size_t max_size = LEN, value_count;
 
    char short_name[max_size];
 
    /* Store values with shortname... */
    ECC(codes_get_string(handles[i], "shortName", short_name, &max_size));
    ECC(codes_get_size(handles[i], "values", &value_count));
    double *values = (double *) malloc(value_count * sizeof(double));
    ECC(codes_get_double_array(handles[i], "values", values, &value_count));
 
    /*Read surface pressure... */
    ECC_READ_2D("sp", met->ps, 0.01f, sp_flag);
 
    /*Read geopotential height at the surface... */
    ECC_READ_2D("z", met->zs, (float) (1. / (1000. * G0)), z_flag);
 
    /* Read temperature at the surface... */
    ECC_READ_2D("2t", met->ts, 1.0f, t_flag);
 
    /* Read zonal wind at the surface... */
    ECC_READ_2D("10u", met->us, 1.0f, u_flag);
 
    /* Read meridional wind at the surface... */
    ECC_READ_2D("10v", met->vs, 1.0f, v_flag);
 
    /* Read eastward turbulent surface stress... */
    ECC_READ_2D("iews", met->ess, 1.0f, ess_flag);
 
    /* Read northward turbulent surface stress... */
    ECC_READ_2D("inss", met->nss, 1.0f, nss_flag);
 
    /* Read surface sensible heat flux... */
    ECC_READ_2D("ishf", met->shf, 1.0f, shf_flag);
 
    /* Read land-sea mask... */
    ECC_READ_2D("lsm", met->lsm, 1.0f, lsm_flag);
 
    /* Read sea surface temperature... */
    ECC_READ_2D("sst", met->sst, 1.0f, sst_flag);
    if (ctl->met_cape == 0) {
 
      /* Read CAPE... */
      ECC_READ_2D("cape", met->cape, 1.0f, cape_flag);
 
      /* Read CIN... */
      ECC_READ_2D("cin", met->cin, 1.0f, cin_flag);
    }
 
    /* Read PBL... */
    if (ctl->met_pbl == 1)
      ECC_READ_2D("blh", met->pbl, 0.001f, pbl_flag);
  }
 
  /* Check whether data have been read... */
  if (sp_flag == 0)
    WARN("Cannot read surface pressure data!");
  if (z_flag == 0)
    WARN("Cannot read surface geopotential height!");
  if (t_flag == 0)
    WARN("Cannot read surface temperature!");
  if (u_flag == 0)
    WARN("Cannot read surface zonal wind!");
  if (v_flag == 0)
    WARN("Cannot read surface meridional wind!");
  if (ess_flag == 0)
    WARN("Cannot read eastward turbulent surface stress!");
  if (nss_flag == 0)
    WARN("Cannot read northward turbulent surface stress!");
  if (shf_flag == 0)
    WARN("Cannot read surface sensible heat flux!");
  if (lsm_flag == 0)
    WARN("Cannot read land-sea mask!");
  if (sst_flag == 0)
    WARN("Cannot read sea surface temperature!");
  if (ctl->met_cape == 0) {
    if (cape_flag == 0)
      WARN("Cannot read CAPE!");
    if (cin_flag == 0)
      WARN("Cannot read convective inhibition!");
  }
  if (ctl->met_pbl == 1 && pbl_flag == 0)
    WARN("Cannot read planetary boundary layer height!");
}
#endif
 
/*****************************************************************************/
 
void read_met_ml2pl(
  const ctl_t *ctl,
  const met_t *met,
  float var[EX][EY][EP],
  const char *varname) {
 
  double aux[EP], p[EP];
 
  /* Set timer... */
  SELECT_TIMER("READ_MET_ML2PL", "METPROC");
  LOG(2, "Interpolate meteo data to pressure levels: %s", varname);
 
  /* Loop over columns... */
#pragma omp parallel for default(shared) private(aux,p) collapse(2)
  for (int ix = 0; ix < met->nx; ix++)
    for (int iy = 0; iy < met->ny; iy++) {
 
      /* Copy pressure profile... */
      for (int ip = 0; ip < met->np; ip++)
        p[ip] = met->pl[ix][iy][ip];
 
      /* Interpolate... */
      for (int ip = 0; ip < ctl->met_np; ip++) {
        double pt = ctl->met_p[ip];
        if ((pt > p[0] && p[0] > p[1]) || (pt < p[0] && p[0] < p[1]))
          pt = p[0];
        else if ((pt > p[met->np - 1] && p[1] > p[0])
                 || (pt < p[met->np - 1] && p[1] < p[0]))
          pt = p[met->np - 1];
        const int ip2 = locate_irr(p, met->np, pt);
        aux[ip] = LIN(p[ip2], var[ix][iy][ip2],
                      p[ip2 + 1], var[ix][iy][ip2 + 1], pt);
      }
 
      /* Copy data... */
      for (int ip = 0; ip < ctl->met_np; ip++)
        var[ix][iy][ip] = (float) aux[ip];
    }
}
 
/*****************************************************************************/
 
void read_met_monotonize(
  const ctl_t *ctl,
  met_t *met) {
 
  /* Check parameters... */
  if (ctl->advect_vert_coord != 1)
    return;
 
  /* Set timer... */
  SELECT_TIMER("READ_MET_MONOTONIZE", "METPROC");
  LOG(2, "Make zeta profiles monotone...");
 
  /* Create monotone zeta profiles... */
#pragma omp parallel for default(shared) collapse(2)
  for (int i = 0; i < met->nx; i++)
    for (int j = 0; j < met->ny; j++) {
      int k = 1;
 
      while (k < met->npl) {    /* Check if there is an inversion at level k... */
        if ((met->zetal[i][j][k - 1] >= met->zetal[i][j][k])) {
          /* Find the upper level k+l over the inversion... */
          int l = 0;
          do {
            l++;
          }
          while ((met->zetal[i][j][k - 1] >=
                  met->zetal[i][j][k + l]) & (k + l < met->npl));
 
          /* Interpolate linear between the top and bottom 
             of the inversion... */
          float s =
            (float) (met->zetal[i][j][k + l] - met->zetal[i][j][k - 1])
            / (float) (met->hybrid[k + l] - met->hybrid[k - 1]);
 
          for (int m = k; m < k + l; m++) {
            float d = (float) (met->hybrid[m] - met->hybrid[k - 1]);
            met->zetal[i][j][m] = s * d + met->zetal[i][j][k - 1];
          }
 
          /* Search for more inversions above the last inversion ... */
          k = k + l;
        } else {
          k++;
        }
      }
    }
 
  /* Create monotone pressure profiles... */
#pragma omp parallel for default(shared) collapse(2)
  for (int i = 0; i < met->nx; i++)
    for (int j = 0; j < met->ny; j++) {
      int k = 1;
 
      while (k < met->npl) {    /* Check if there is an inversion at level k... */
        if ((met->pl[i][j][k - 1] <= met->pl[i][j][k])) {
 
          /* Find the upper level k+l over the inversion... */
          int l = 0;
          do {
            l++;
          }
          while ((met->pl[i][j][k - 1] <= met->pl[i][j][k + l]) & (k + l <
                                                                   met->npl));
 
          /* Interpolate linear between the top and bottom 
             of the inversion... */
          float s = (float) (met->pl[i][j][k + l] - met->pl[i][j][k - 1])
            / (float) (met->hybrid[k + l] - met->hybrid[k - 1]);
 
          for (int m = k; m < k + l; m++) {
            float d = (float) (met->hybrid[m] - met->hybrid[k - 1]);
            met->pl[i][j][m] = s * d + met->pl[i][j][k - 1];
          }
 
          /* Search for more inversions above the last inversion ... */
          k += l;
        } else {
          k++;
        }
      }
    }
}
 
/*****************************************************************************/
 
int read_met_nc(
  const char *filename,
  const ctl_t *ctl,
  met_t *met,
  dd_t *dd) {
 
  int ncid = 0;
  int have_ncid = 0;
 
  /* With domain decomposition, all tasks collectively open the file in
     parallel mode and each task reads its own subdomain... */
#ifdef DD
  if (ctl->dd) {
    NC(nc_open_par
       (filename, NC_NOWRITE | NC_SHARE, MPI_COMM_WORLD, MPI_INFO_NULL,
        &ncid));
    have_ncid = 1;
  }
#endif
 
  /* Without domain decomposition, the file is opened in serial mode... */
  if (!have_ncid && nc_open(filename, NC_NOWRITE, &ncid) != NC_NOERR) {
    WARN("Cannot open file!");
    return 0;
  }
 
  /* Set coordinate system of meteo data... */
  met->coord_type = ctl->met_coord_type;
 
  /* Read coordinates of meteo data... */
  read_met_nc_grid(filename, ncid, ctl, met, dd);
 
  /* Setup for global read mode happens under the general input timer... */
  SELECT_TIMER("GET_MET", "INPUT");
#ifdef DD
  if (ctl->dd && ctl->met_nc_read_mode == 1)
    met_global_2d_init(dd, met);
#endif
 
  /* Read surface data... */
  read_met_nc_surface(ncid, ctl, met, dd);
 
  /* Read meteo data on vertical levels... */
  read_met_nc_levels(ncid, ctl, met, dd);
 
  /* The remaining work happens under the general input timer... */
  SELECT_TIMER("GET_MET", "INPUT");
 
#ifdef DD
  if (ctl->dd && ctl->met_nc_read_mode == 1)
    met_global_2d_free();
#endif
 
  /* Close file... */
  NC(nc_close(ncid));
 
  /* Return success... */
  return 1;
}
 
/*****************************************************************************/
 
void dd_read_met_nc_grid(
  dd_t *dd,
  const ctl_t *ctl,
  met_t *met,
  const int ncid) {
 
  int varid;
 
  /* Get the MPI information... */
  int rank = 0, size = 1;
#ifdef MPI
  MPI_Comm_rank(MPI_COMM_WORLD, &rank);
  MPI_Comm_size(MPI_COMM_WORLD, &size);
#endif
 
  /* Get grid dimensions... */
  NC_INQ_DIM("lon", &dd->nx_glob, 0, 0, 0);
  NC_INQ_DIM("lat", &dd->ny_glob, 0, 0, 0);
 
  LOG(2, "Number of longitudes: %d", dd->nx_glob);
  LOG(2, "Number of latitudes: %d", dd->ny_glob);
 
  /* Check grid... */
  if (dd->nx_glob > DD_EX_GLOB || dd->ny_glob > DD_EY_GLOB)
    ERRMSG("Global grid is too large!");
 
  if (ctl->dd_subdomains_zonal > dd->nx_glob)
    ERRMSG("Too many zonal subdomains for global x grid!");
 
  if (ctl->dd_subdomains_meridional > dd->ny_glob)
    ERRMSG("Too many meridional subdomains for global y grid!");
 
  /* Read global longitudes and latitudes... */
  NC_GET_DOUBLE("lon", dd->lon_glob, 1);
  NC_GET_DOUBLE("lat", dd->lat_glob, 1);
 
  LOG(2, "Longitudes: %g, %g ... %g deg",
      dd->lon_glob[0], dd->lon_glob[1], dd->lon_glob[dd->nx_glob - 1]);
  LOG(2, "Latitudes: %g, %g ... %g deg",
      dd->lat_glob[0], dd->lat_glob[1], dd->lat_glob[dd->ny_glob - 1]);
 
  /* Rank coordinates in DD layout... */
  const int zonal_rank = rank / ctl->dd_subdomains_meridional;
  const int merid_rank = rank % ctl->dd_subdomains_meridional;
 
  /* Check for edge cases... */
  const int left = (zonal_rank == 0);
  const int right = (zonal_rank == ctl->dd_subdomains_zonal - 1);
  const int top = (merid_rank == 0);
  const int bottom = (merid_rank == ctl->dd_subdomains_meridional - 1);
 
  /* Core owned block (without halos)... */
  const int nx_block = dd->nx_glob / ctl->dd_subdomains_zonal;
  const int ny_block = dd->ny_glob / ctl->dd_subdomains_meridional;
 
  const int ix0 = zonal_rank * nx_block;
  const int iy0 = merid_rank * ny_block;
 
  int nx_core = nx_block;
  int ny_core = ny_block;
 
  if (right)
    nx_core += dd->nx_glob - ctl->dd_subdomains_zonal * nx_block;
  if (bottom)
    ny_core += dd->ny_glob - ctl->dd_subdomains_meridional * ny_block;
 
  /* Check halo extents before converting grid indices to size_t... */
  const int halo = ctl->dd_halos_size;
  if ((!left && halo > ix0)
      || (!right && halo > dd->nx_glob - ix0 - nx_core)
      || (!top && halo > iy0)
      || (!bottom && halo > dd->ny_glob - iy0 - ny_core))
    ERRMSG("DD_HALOS_SIZE exceeds the available global grid!");
 
  const int nx_local = nx_core
    + (ctl->dd_subdomains_zonal > 1 ? 2 * halo : 0);
  const int ny_local = ny_core + (!top ? halo : 0) + (!bottom ? halo : 0);
  if (nx_local > EX || ny_local > EY)
    ERRMSG("DD halo grid exceeds EX or EY. Increase the grid capacity!");
  if (nx_local < 2 || ny_local < 2)
    ERRMSG("DD halo grid needs at least two points in each direction!");
 
  /* Store core met size first... */
  met->nx = nx_core;
  met->ny = ny_core;
 
  /* Set hyperslab for core subdomain... */
  dd->subdomain_start[0] = 0;
  dd->subdomain_start[1] = 0;
  dd->subdomain_start[2] = (size_t) iy0;
  dd->subdomain_start[3] = (size_t) ix0;
 
  dd->subdomain_count[0] = 1;
  dd->subdomain_count[1] = (size_t) met->np;
  dd->subdomain_count[2] = (size_t) ny_core;
  dd->subdomain_count[3] = (size_t) nx_core;
 
  /* Add inner halos to read window... */
  if (!left && !right) {
    dd->subdomain_start[3] -= (size_t) ctl->dd_halos_size;
    dd->subdomain_count[3] += (size_t) (2 * ctl->dd_halos_size);
  } else if (left ^ right) {
    dd->subdomain_count[3] += (size_t) ctl->dd_halos_size;
    if (!left)
      dd->subdomain_start[3] -= (size_t) ctl->dd_halos_size;
  }
 
  if (!top && !bottom) {
    dd->subdomain_start[2] -= (size_t) ctl->dd_halos_size;
    dd->subdomain_count[2] += (size_t) (2 * ctl->dd_halos_size);
  } else if (top ^ bottom) {
    dd->subdomain_count[2] += (size_t) ctl->dd_halos_size;
    if (!top)
      dd->subdomain_start[2] -= (size_t) ctl->dd_halos_size;
  }
 
  /* Set boundary halo hyperslabs... */
  double lon_shift = 0.0;
 
  if (left ^ right) {
    dd->halo_bnd_start[0] = 0;
    dd->halo_bnd_start[1] = 0;
    dd->halo_bnd_start[2] = dd->subdomain_start[2];
    dd->halo_bnd_start[3] =
      (size_t) (left ? (dd->nx_glob - ctl->dd_halos_size) : 0);
 
    dd->halo_bnd_count[0] = 1;
    dd->halo_bnd_count[1] = (size_t) met->np;
    dd->halo_bnd_count[2] = dd->subdomain_count[2];
    dd->halo_bnd_count[3] = (size_t) ctl->dd_halos_size;
 
    dd->halo_offset_start = left ? (int) dd->halo_bnd_count[3] : 0;
    dd->halo_offset_end = left ? 0 : (int) dd->subdomain_count[3];
    lon_shift = left ? -360.0 : 360.0;
  } else {
    dd->halo_bnd_start[0] = 0;
    dd->halo_bnd_start[1] = 0;
    dd->halo_bnd_start[2] = 0;
    dd->halo_bnd_start[3] = 0;
 
    dd->halo_bnd_count[0] = 0;
    dd->halo_bnd_count[1] = 0;
    dd->halo_bnd_count[2] = 0;
    dd->halo_bnd_count[3] = 0;
 
    dd->halo_offset_start = 0;
    dd->halo_offset_end = 0;
  }
 
  /* Focus on subdomain latitudes... */
  for (int iy = 0; iy < (int) dd->subdomain_count[2]; iy++)
    met->lat[iy] = dd->lat_glob[(int) dd->subdomain_start[2] + iy];
 
  /* Focus on subdomain longitudes... */
  for (int ix = 0; ix < (int) dd->subdomain_count[3]; ix++)
    met->lon[ix + dd->halo_offset_start] =
      dd->lon_glob[(int) dd->subdomain_start[3] + ix];
 
  for (int ix = 0; ix < (int) dd->halo_bnd_count[3]; ix++)
    met->lon[ix + dd->halo_offset_end] =
      dd->lon_glob[(int) dd->halo_bnd_start[3] + ix] + lon_shift;
 
  /* Reset halo-extended grid dimensions... */
  met->nx = (int) dd->subdomain_count[3] + (int) dd->halo_bnd_count[3];
  met->ny = (int) dd->subdomain_count[2];
 
  LOG(2, "Define subdomain properties.");
  LOG(2, "MPI information: Rank %d, Size %d", rank, size);
  LOG(2, "Edge position: l=%d,r=%d,t=%d,b=%d", left, right, top, bottom);
  LOG(2, "Total size for subdomain meteo data: nx %d ny %d np %d",
      met->nx, met->ny, met->np);
  LOG(2, "Hyperslab sizes for boundary halos: nx %d ny %d np %d",
      (int) dd->halo_bnd_count[3], (int) dd->halo_bnd_count[2],
      (int) dd->halo_bnd_count[1]);
  LOG(2, "Hyperslab sizes for subdomain and inner halos: nx %d ny %d np %d",
      (int) dd->subdomain_count[3], (int) dd->subdomain_count[2],
      (int) dd->subdomain_count[1]);
  LOG(2, "Subdomain start: nx %ld ny %ld np %ld",
      dd->subdomain_start[3], dd->subdomain_start[2], dd->subdomain_start[1]);
  LOG(2, "Boundary halo start: nx %ld ny %ld np %ld",
      dd->halo_bnd_start[3], dd->halo_bnd_start[2], dd->halo_bnd_start[1]);
  LOG(2, "Offsets: nx %d ny %d", dd->halo_offset_start, dd->halo_offset_end);
  LOG(2, "%d Subdomain longitudes: %g, %g ... %g deg",
      rank, met->lon[0], met->lon[1], met->lon[met->nx - 1]);
  LOG(2, "%d Subdomain latitudes: %g, %g ... %g deg",
      rank, met->lat[0], met->lat[1], met->lat[met->ny - 1]);
}
 
/*****************************************************************************/
 
void read_met_pbl(
  const ctl_t *ctl,
  met_t *met) {
 
  /* Set timer... */
  SELECT_TIMER("READ_MET_PBL", "METPROC");
  LOG(2, "Calculate planetary boundary layer...");
 
  /* Convert PBL height from meteo file to pressure... */
  if (ctl->met_pbl == 1) {
 
    /* Loop over grid points... */
#pragma omp parallel for default(shared) collapse(2)
    for (int ix = 0; ix < met->nx; ix++)
      for (int iy = 0; iy < met->ny; iy++) {
 
        /* Get pressure at top of PBL... */
        const float z = met->zs[ix][iy] + met->pbl[ix][iy];
        const int ip = locate_irr_float(met->z[ix][iy], met->np, z, 0);
        met->pbl[ix][iy] =
          (float) (LIN(met->z[ix][iy][ip], met->p[ip],
                       met->z[ix][iy][ip + 1], met->p[ip + 1], z));
      }
  }
 
  /* Determine PBL based on Richardson number... */
  else if (ctl->met_pbl == 2) {
 
    /* Parameters used to estimate the height of the PBL
       (e.g., Vogelezang and Holtslag, 1996; Seidel et al., 2012)... */
    const double rib_crit = 0.25, dz = 0.05, umin = 5.0;
 
    /* Loop over grid points... */
#pragma omp parallel for default(shared) collapse(2)
    for (int ix = 0; ix < met->nx; ix++)
      for (int iy = 0; iy < met->ny; iy++) {
 
        /* Set bottom level of PBL... */
        const double pbl_bot = met->ps[ix][iy] * exp(-dz / H0);
 
        /* Find lowest level near the bottom... */
        int ip;
        for (ip = 1; ip < met->np; ip++)
          if (met->p[ip] < pbl_bot)
            break;
 
        /* Get near surface data... */
        const double h2os = LIN(met->p[ip - 1], met->h2o[ix][iy][ip - 1],
                                met->p[ip], met->h2o[ix][iy][ip], pbl_bot);
        const double tvs = THETAVIRT(pbl_bot, met->ts[ix][iy], h2os);
 
        /* Init... */
        double rib_old = 0;
 
        /* Loop over levels... */
        for (; ip < met->np; ip++) {
 
          /* Get squared horizontal wind speed... */
          double vh2 = SQR(met->u[ix][iy][ip] - met->us[ix][iy])
            + SQR(met->v[ix][iy][ip] - met->vs[ix][iy]);
          vh2 = MAX(vh2, SQR(umin));
 
          /* Calculate bulk Richardson number... */
          const double rib =
            G0 * 1e3 * (met->z[ix][iy][ip] - met->zs[ix][iy]) / tvs
            * (THETAVIRT(met->p[ip], met->t[ix][iy][ip],
                         met->h2o[ix][iy][ip]) - tvs) / vh2;
 
          /* Check for critical value... */
          if (rib >= rib_crit) {
            met->pbl[ix][iy] = (float) (LIN(rib_old, met->p[ip - 1],
                                            rib, met->p[ip], rib_crit));
            if (met->pbl[ix][iy] > pbl_bot)
              met->pbl[ix][iy] = (float) pbl_bot;
            break;
          }
 
          /* Save Richardson number... */
          rib_old = rib;
        }
      }
  }
 
  /* Determine PBL based on potential temperature... */
  if (ctl->met_pbl == 3) {
 
    /* Parameters used to estimate the height of the PBL
       (following HYSPLIT model)... */
    const double dtheta = 2.0, zmin = 0.1;
 
    /* Loop over grid points... */
#pragma omp parallel for default(shared) collapse(2)
    for (int ix = 0; ix < met->nx; ix++)
      for (int iy = 0; iy < met->ny; iy++) {
 
        /* Potential temperature at the surface... */
        const double theta0 = THETA(met->ps[ix][iy], met->ts[ix][iy]);
 
        /* Find topmost level where theta exceeds surface value by 2 K... */
        int ip;
        for (ip = met->np - 2; ip > 0; ip--)
          if (met->p[ip] >= 300.)
            if (met->p[ip] > met->ps[ix][iy]
                || THETA(met->p[ip], met->t[ix][iy][ip]) <= theta0 + dtheta)
              break;
 
        /* Interpolate... */
        met->pbl[ix][iy]
          = (float) (LIN(THETA(met->p[ip + 1], met->t[ix][iy][ip + 1]),
                         met->p[ip + 1],
                         THETA(met->p[ip], met->t[ix][iy][ip]),
                         met->p[ip], theta0 + dtheta));
 
        /* Check minimum value... */
        double pbl_min = met->ps[ix][iy] * exp(-zmin / H0);
        if (met->pbl[ix][iy] > pbl_min || met->p[ip] > met->ps[ix][iy])
          met->pbl[ix][iy] = (float) pbl_min;
      }
  }
 
  /* Loop over grid points... */
#pragma omp parallel for default(shared) collapse(2)
  for (int ix = 0; ix < met->nx; ix++)
    for (int iy = 0; iy < met->ny; iy++) {
 
      /* Check minimum value... */
      double pbl_min = met->ps[ix][iy] * exp(-ctl->met_pbl_min / H0);
      met->pbl[ix][iy] = MIN(met->pbl[ix][iy], (float) pbl_min);
 
      /* Check maximum value... */
      double pbl_max = met->ps[ix][iy] * exp(-ctl->met_pbl_max / H0);
      met->pbl[ix][iy] = MAX(met->pbl[ix][iy], (float) pbl_max);
    }
}
 
/*****************************************************************************/
 
void read_met_periodic(
  met_t *met) {
 
  /* Set timer... */
  SELECT_TIMER("READ_MET_PERIODIC", "METPROC");
  LOG(2, "Apply periodic boundary conditions...");
 
  /* Check longitudes... */
  if (!(fabs(met->lon[met->nx - 1] - met->lon[0]
             + met->lon[1] - met->lon[0] - 360) < 0.01))
    return;
 
  /* Increase longitude counter... */
  if ((++met->nx) >= EX)
    ERRMSG("Cannot create periodic boundary conditions!");
 
  /* Set longitude... */
  met->lon[met->nx - 1] = met->lon[met->nx - 2] + met->lon[1] - met->lon[0];
 
  /* Loop over latitudes and pressure levels... */
#pragma omp parallel for default(shared)
  for (int iy = 0; iy < met->ny; iy++) {
    met->ps[met->nx - 1][iy] = met->ps[0][iy];
    met->zs[met->nx - 1][iy] = met->zs[0][iy];
    met->ts[met->nx - 1][iy] = met->ts[0][iy];
    met->us[met->nx - 1][iy] = met->us[0][iy];
    met->vs[met->nx - 1][iy] = met->vs[0][iy];
    met->ess[met->nx - 1][iy] = met->ess[0][iy];
    met->nss[met->nx - 1][iy] = met->nss[0][iy];
    met->shf[met->nx - 1][iy] = met->shf[0][iy];
    met->lsm[met->nx - 1][iy] = met->lsm[0][iy];
    met->sst[met->nx - 1][iy] = met->sst[0][iy];
    met->pbl[met->nx - 1][iy] = met->pbl[0][iy];
    met->cape[met->nx - 1][iy] = met->cape[0][iy];
    met->cin[met->nx - 1][iy] = met->cin[0][iy];
    for (int ip = 0; ip < met->np; ip++) {
      met->t[met->nx - 1][iy][ip] = met->t[0][iy][ip];
      met->u[met->nx - 1][iy][ip] = met->u[0][iy][ip];
      met->v[met->nx - 1][iy][ip] = met->v[0][iy][ip];
      met->w[met->nx - 1][iy][ip] = met->w[0][iy][ip];
      met->h2o[met->nx - 1][iy][ip] = met->h2o[0][iy][ip];
      met->o3[met->nx - 1][iy][ip] = met->o3[0][iy][ip];
      met->lwc[met->nx - 1][iy][ip] = met->lwc[0][iy][ip];
      met->rwc[met->nx - 1][iy][ip] = met->rwc[0][iy][ip];
      met->iwc[met->nx - 1][iy][ip] = met->iwc[0][iy][ip];
      met->swc[met->nx - 1][iy][ip] = met->swc[0][iy][ip];
      met->cc[met->nx - 1][iy][ip] = met->cc[0][iy][ip];
    }
    for (int ip = 0; ip < met->npl; ip++) {
      met->ul[met->nx - 1][iy][ip] = met->ul[0][iy][ip];
      met->vl[met->nx - 1][iy][ip] = met->vl[0][iy][ip];
      met->wl[met->nx - 1][iy][ip] = met->wl[0][iy][ip];
      met->pl[met->nx - 1][iy][ip] = met->pl[0][iy][ip];
      met->zetal[met->nx - 1][iy][ip] = met->zetal[0][iy][ip];
      met->zeta_dotl[met->nx - 1][iy][ip] = met->zeta_dotl[0][iy][ip];
    }
  }
}
 
/*****************************************************************************/
 
void read_met_polar_winds(
  met_t *met) {
 
  /* Set timer... */
  SELECT_TIMER("READ_MET_POLAR_WINDS", "METPROC");
  LOG(2, "Apply fix for polar winds...");
 
  if (met->coord_type != 0)
    return;
 
  /* Check latitudes... */
  if (fabs(met->lat[0]) < 89.999 || fabs(met->lat[met->ny - 1]) < 89.999)
    return;
 
  /* Loop over hemispheres... */
  for (int ihem = 0; ihem < 2; ihem++) {
 
    /* Set latitude indices... */
    int i89 = 1, i90 = 0, sign = 1;
    if (ihem == 1) {
      i89 = met->ny - 2;
      i90 = met->ny - 1;
    }
    if (met->lat[i90] < 0)
      sign = -1;
 
    /* Look-up table of cosinus and sinus... */
    double clon[EX], slon[EX];
#pragma omp parallel for default(shared)
    for (int ix = 0; ix < met->nx; ix++) {
      clon[ix] = cos(sign * DEG2RAD(met->lon[ix]));
      slon[ix] = sin(sign * DEG2RAD(met->lon[ix]));
    }
 
    /* Loop over levels... */
#pragma omp parallel for default(shared)
    for (int ip = 0; ip < met->np; ip++) {
 
      /* Transform 89 degree u and v winds into Cartesian coordinates and take the mean... */
      double vel89x = 0, vel89y = 0;
      for (int ix = 0; ix < met->nx; ix++) {
        vel89x +=
          (met->u[ix][i89][ip] * clon[ix] -
           met->v[ix][i89][ip] * slon[ix]) / met->nx;
        vel89y +=
          (met->u[ix][i89][ip] * slon[ix] +
           met->v[ix][i89][ip] * clon[ix]) / met->nx;
      }
 
      /* Replace 90 degree winds by 89 degree mean... */
      for (int ix = 0; ix < met->nx; ix++) {
        met->u[ix][i90][ip]
          = (float) (vel89x * clon[ix] + vel89y * slon[ix]);
        met->v[ix][i90][ip]
          = (float) (-vel89x * slon[ix] + vel89y * clon[ix]);
      }
    }
  }
}
 
/*****************************************************************************/
 
void read_met_pv(
  met_t *met) {
 
  double pows[EP];
 
  /* Set timer... */
  SELECT_TIMER("READ_MET_PV", "METPROC");
  LOG(2, "Calculate potential vorticity...");
 
  /* Set powers... */
#pragma omp parallel for default(shared)
  for (int ip = 0; ip < met->np; ip++)
    pows[ip] = pow(1000. / met->p[ip], KAPPA);
 
  /* Loop over grid points... */
#pragma omp parallel for default(shared)
  for (int ix = 0; ix < met->nx; ix++) {
 
    /* Set indices... */
    const int ix0 = MAX(ix - 1, 0);
    const int ix1 = MIN(ix + 1, met->nx - 1);
 
    /* Loop over grid points... */
    for (int iy = 0; iy < met->ny; iy++) {
 
      /* Set indices... */
      const int iy0 = MAX(iy - 1, 0);
      const int iy1 = MIN(iy + 1, met->ny - 1);
 
      /* Set auxiliary variables... */
      const double latr = 0.5 * (met->lat[iy1] + met->lat[iy0]);
      double dx, dy, c0, c1, cr, vort;
 
      // Calculate potential vorticity..
      if (met->coord_type == 0) {       // coords are lat/lon
        dx = 1000. * DEG2DX(met->lon[ix1] - met->lon[ix0], latr);
        dy = 1000. * DEG2DY(met->lat[iy1] - met->lat[iy0]);
        c0 = cos(DEG2RAD(met->lat[iy0]));
        c1 = cos(DEG2RAD(met->lat[iy1]));
        cr = cos(DEG2RAD(latr));
        vort = 2 * OMEGA_EARTH * sin(DEG2RAD(latr));
      } else {                  // coords are in meters
        dx = met->lon[ix1] - met->lon[ix0];
        dy = met->lat[iy1] - met->lat[iy0];
 
        c0 = 1.0;
        c1 = 1.0;
        cr = 1.0;
 
        vort = 2 * OMEGA_EARTH * sin(latr / (RE * 1000));
      }
 
      /* Loop over grid points... */
      for (int ip = 0; ip < met->np; ip++) {
 
        /* Get gradients in longitude... */
        const double dtdx
          = (met->t[ix1][iy][ip] - met->t[ix0][iy][ip]) * pows[ip] / dx;
        const double dvdx = (met->v[ix1][iy][ip] - met->v[ix0][iy][ip]) / dx;
 
        /* Get gradients in latitude... */
        const double dtdy
          = (met->t[ix][iy1][ip] - met->t[ix][iy0][ip]) * pows[ip] / dy;
        const double dudy
          = (met->u[ix][iy1][ip] * c1 - met->u[ix][iy0][ip] * c0) / dy;
 
        /* Set indices... */
        const int ip0 = MAX(ip - 1, 0);
        const int ip1 = MIN(ip + 1, met->np - 1);
 
        /* Get gradients in pressure... */
        double dtdp, dudp, dvdp;
        const double dp0 = 100. * (met->p[ip] - met->p[ip0]);
        const double dp1 = 100. * (met->p[ip1] - met->p[ip]);
        if (ip != ip0 && ip != ip1) {
          double denom = dp0 * dp1 * (dp0 + dp1);
          dtdp = (dp0 * dp0 * met->t[ix][iy][ip1] * pows[ip1]
                  - dp1 * dp1 * met->t[ix][iy][ip0] * pows[ip0]
                  + (dp1 * dp1 - dp0 * dp0) * met->t[ix][iy][ip] * pows[ip])
            / denom;
          dudp = (dp0 * dp0 * met->u[ix][iy][ip1]
                  - dp1 * dp1 * met->u[ix][iy][ip0]
                  + (dp1 * dp1 - dp0 * dp0) * met->u[ix][iy][ip])
            / denom;
          dvdp = (dp0 * dp0 * met->v[ix][iy][ip1]
                  - dp1 * dp1 * met->v[ix][iy][ip0]
                  + (dp1 * dp1 - dp0 * dp0) * met->v[ix][iy][ip])
            / denom;
        } else {
          const double denom = dp0 + dp1;
          dtdp =
            (met->t[ix][iy][ip1] * pows[ip1] -
             met->t[ix][iy][ip0] * pows[ip0]) / denom;
          dudp = (met->u[ix][iy][ip1] - met->u[ix][iy][ip0]) / denom;
          dvdp = (met->v[ix][iy][ip1] - met->v[ix][iy][ip0]) / denom;
        }
 
        /* Calculate PV... */
        met->pv[ix][iy][ip] = (float)
          (1e6 * G0 *
           (-dtdp * (dvdx - dudy / cr + vort) + dvdp * dtdx - dudp * dtdy));
      }
    }
  }
 
  /* Fix for polar regions... */
#pragma omp parallel for default(shared)
  for (int ix = 0; ix < met->nx; ix++)
    for (int ip = 0; ip < met->np; ip++) {
      met->pv[ix][0][ip]
        = met->pv[ix][1][ip]
        = met->pv[ix][2][ip];
      met->pv[ix][met->ny - 1][ip]
        = met->pv[ix][met->ny - 2][ip]
        = met->pv[ix][met->ny - 3][ip];
    }
}
 
/*****************************************************************************/
 
void read_met_ozone(
  met_t *met) {
 
  /* Set timer... */
  SELECT_TIMER("READ_MET_OZONE", "METPROC");
  LOG(2, "Calculate total column ozone...");
 
  /* Loop over columns... */
#pragma omp parallel for default(shared) collapse(2)
  for (int ix = 0; ix < met->nx; ix++)
    for (int iy = 0; iy < met->ny; iy++) {
 
      /* Integrate... */
      double cd = 0;
      for (int ip = 1; ip < met->np; ip++)
        if (met->p[ip - 1] <= met->ps[ix][iy]) {
          const double vmr =
            0.5 * (met->o3[ix][iy][ip - 1] + met->o3[ix][iy][ip]);
          const double dp = met->p[ip - 1] - met->p[ip];
          cd += vmr * MO3 / MA * dp * 1e2 / G0;
        }
 
      /* Convert to Dobson units... */
      met->o3c[ix][iy] = (float) (cd / DOBSON_UNIT);
    }
}
 
/*****************************************************************************/
 
void read_met_sample(
  const ctl_t *ctl,
  met_t *met) {
 
  met_t *help;
 
  /* Check parameters... */
  if (ctl->met_dp <= 1 && ctl->met_dx <= 1 && ctl->met_dy <= 1
      && ctl->met_sp <= 1 && ctl->met_sx <= 1 && ctl->met_sy <= 1)
    return;
 
  /* Set timer... */
  SELECT_TIMER("READ_MET_SAMPLE", "METPROC");
  LOG(2, "Downsampling of meteo data...");
 
  /* Allocate... */
  ALLOC(help, met_t, 1);
 
  /* Copy data... */
  help->nx = met->nx;
  help->ny = met->ny;
  help->np = met->np;
  memcpy(help->lon, met->lon, sizeof(met->lon));
  memcpy(help->lat, met->lat, sizeof(met->lat));
  memcpy(help->p, met->p, sizeof(met->p));
 
  /* Smoothing... */
  for (int ix = 0; ix < met->nx; ix += ctl->met_dx) {
    for (int iy = 0; iy < met->ny; iy += ctl->met_dy) {
      for (int ip = 0; ip < met->np; ip += ctl->met_dp) {
        help->ps[ix][iy] = 0;
        help->zs[ix][iy] = 0;
        help->ts[ix][iy] = 0;
        help->us[ix][iy] = 0;
        help->vs[ix][iy] = 0;
        help->ess[ix][iy] = 0;
        help->nss[ix][iy] = 0;
        help->shf[ix][iy] = 0;
        help->lsm[ix][iy] = 0;
        help->sst[ix][iy] = 0;
        help->pbl[ix][iy] = 0;
        help->cape[ix][iy] = 0;
        help->cin[ix][iy] = 0;
        help->t[ix][iy][ip] = 0;
        help->u[ix][iy][ip] = 0;
        help->v[ix][iy][ip] = 0;
        help->w[ix][iy][ip] = 0;
        help->h2o[ix][iy][ip] = 0;
        help->o3[ix][iy][ip] = 0;
        help->lwc[ix][iy][ip] = 0;
        help->rwc[ix][iy][ip] = 0;
        help->iwc[ix][iy][ip] = 0;
        help->swc[ix][iy][ip] = 0;
        help->cc[ix][iy][ip] = 0;
        float wsum = 0;
        for (int ix2 = ix - ctl->met_sx + 1; ix2 <= ix + ctl->met_sx - 1;
             ix2++) {
          int ix3 = ix2;
          if (ix3 < 0)
            ix3 += met->nx;
          else if (ix3 >= met->nx)
            ix3 -= met->nx;
 
          for (int iy2 = MAX(iy - ctl->met_sy + 1, 0);
               iy2 <= MIN(iy + ctl->met_sy - 1, met->ny - 1); iy2++)
            for (int ip2 = MAX(ip - ctl->met_sp + 1, 0);
                 ip2 <= MIN(ip + ctl->met_sp - 1, met->np - 1); ip2++) {
              const float w =
                (1.0f - (float) abs(ix - ix2) / (float) ctl->met_sx)
                * (1.0f - (float) abs(iy - iy2) / (float) ctl->met_sy)
                * (1.0f - (float) abs(ip - ip2) / (float) ctl->met_sp);
              help->ps[ix][iy] += w * met->ps[ix3][iy2];
              help->zs[ix][iy] += w * met->zs[ix3][iy2];
              help->ts[ix][iy] += w * met->ts[ix3][iy2];
              help->us[ix][iy] += w * met->us[ix3][iy2];
              help->vs[ix][iy] += w * met->vs[ix3][iy2];
              help->ess[ix][iy] += w * met->ess[ix3][iy2];
              help->nss[ix][iy] += w * met->nss[ix3][iy2];
              help->shf[ix][iy] += w * met->shf[ix3][iy2];
              help->lsm[ix][iy] += w * met->lsm[ix3][iy2];
              help->sst[ix][iy] += w * met->sst[ix3][iy2];
              help->pbl[ix][iy] += w * met->pbl[ix3][iy2];
              help->cape[ix][iy] += w * met->cape[ix3][iy2];
              help->cin[ix][iy] += w * met->cin[ix3][iy2];
              help->t[ix][iy][ip] += w * met->t[ix3][iy2][ip2];
              help->u[ix][iy][ip] += w * met->u[ix3][iy2][ip2];
              help->v[ix][iy][ip] += w * met->v[ix3][iy2][ip2];
              help->w[ix][iy][ip] += w * met->w[ix3][iy2][ip2];
              help->h2o[ix][iy][ip] += w * met->h2o[ix3][iy2][ip2];
              help->o3[ix][iy][ip] += w * met->o3[ix3][iy2][ip2];
              help->lwc[ix][iy][ip] += w * met->lwc[ix3][iy2][ip2];
              help->rwc[ix][iy][ip] += w * met->rwc[ix3][iy2][ip2];
              help->iwc[ix][iy][ip] += w * met->iwc[ix3][iy2][ip2];
              help->swc[ix][iy][ip] += w * met->swc[ix3][iy2][ip2];
              help->cc[ix][iy][ip] += w * met->cc[ix3][iy2][ip2];
              wsum += w;
            }
        }
        help->ps[ix][iy] /= wsum;
        help->zs[ix][iy] /= wsum;
        help->ts[ix][iy] /= wsum;
        help->us[ix][iy] /= wsum;
        help->vs[ix][iy] /= wsum;
        help->ess[ix][iy] /= wsum;
        help->nss[ix][iy] /= wsum;
        help->shf[ix][iy] /= wsum;
        help->lsm[ix][iy] /= wsum;
        help->sst[ix][iy] /= wsum;
        help->pbl[ix][iy] /= wsum;
        help->cape[ix][iy] /= wsum;
        help->cin[ix][iy] /= wsum;
        help->t[ix][iy][ip] /= wsum;
        help->u[ix][iy][ip] /= wsum;
        help->v[ix][iy][ip] /= wsum;
        help->w[ix][iy][ip] /= wsum;
        help->h2o[ix][iy][ip] /= wsum;
        help->o3[ix][iy][ip] /= wsum;
        help->lwc[ix][iy][ip] /= wsum;
        help->rwc[ix][iy][ip] /= wsum;
        help->iwc[ix][iy][ip] /= wsum;
        help->swc[ix][iy][ip] /= wsum;
        help->cc[ix][iy][ip] /= wsum;
      }
    }
  }
 
  /* Downsampling... */
  met->nx = 0;
  for (int ix = 0; ix < help->nx; ix += ctl->met_dx) {
    met->lon[met->nx] = help->lon[ix];
    met->ny = 0;
    for (int iy = 0; iy < help->ny; iy += ctl->met_dy) {
      met->lat[met->ny] = help->lat[iy];
      met->ps[met->nx][met->ny] = help->ps[ix][iy];
      met->zs[met->nx][met->ny] = help->zs[ix][iy];
      met->ts[met->nx][met->ny] = help->ts[ix][iy];
      met->us[met->nx][met->ny] = help->us[ix][iy];
      met->vs[met->nx][met->ny] = help->vs[ix][iy];
      met->ess[met->nx][met->ny] = help->ess[ix][iy];
      met->nss[met->nx][met->ny] = help->nss[ix][iy];
      met->shf[met->nx][met->ny] = help->shf[ix][iy];
      met->lsm[met->nx][met->ny] = help->lsm[ix][iy];
      met->sst[met->nx][met->ny] = help->sst[ix][iy];
      met->pbl[met->nx][met->ny] = help->pbl[ix][iy];
      met->cape[met->nx][met->ny] = help->cape[ix][iy];
      met->cin[met->nx][met->ny] = help->cin[ix][iy];
      met->np = 0;
      for (int ip = 0; ip < help->np; ip += ctl->met_dp) {
        met->p[met->np] = help->p[ip];
        met->t[met->nx][met->ny][met->np] = help->t[ix][iy][ip];
        met->u[met->nx][met->ny][met->np] = help->u[ix][iy][ip];
        met->v[met->nx][met->ny][met->np] = help->v[ix][iy][ip];
        met->w[met->nx][met->ny][met->np] = help->w[ix][iy][ip];
        met->h2o[met->nx][met->ny][met->np] = help->h2o[ix][iy][ip];
        met->o3[met->nx][met->ny][met->np] = help->o3[ix][iy][ip];
        met->lwc[met->nx][met->ny][met->np] = help->lwc[ix][iy][ip];
        met->rwc[met->nx][met->ny][met->np] = help->rwc[ix][iy][ip];
        met->iwc[met->nx][met->ny][met->np] = help->iwc[ix][iy][ip];
        met->swc[met->nx][met->ny][met->np] = help->swc[ix][iy][ip];
        met->cc[met->nx][met->ny][met->np] = help->cc[ix][iy][ip];
        met->np++;
      }
      met->ny++;
    }
    met->nx++;
  }
 
  /* Free... */
  free(help);
}
 
/*****************************************************************************/
 
void read_met_tropo(
  const ctl_t *ctl,
  const clim_t *clim,
  met_t *met) {
 
  double p2[200], pv[EP], pv2[200], t[EP], t2[200], th[EP],
    th2[200], z[EP], z2[200];
 
  /* Set timer... */
  SELECT_TIMER("READ_MET_TROPO", "METPROC");
  LOG(2, "Calculate tropopause...");
 
  /* Get altitude and pressure profiles... */
#pragma omp parallel for default(shared)
  for (int iz = 0; iz < met->np; iz++)
    z[iz] = Z(met->p[iz]);
#pragma omp parallel for default(shared)
  for (int iz = 0; iz <= 190; iz++) {
    z2[iz] = 4.5 + 0.1 * iz;
    p2[iz] = P(z2[iz]);
  }
 
  /* Do not calculate tropopause... */
  if (ctl->met_tropo == 0)
#pragma omp parallel for default(shared) collapse(2)
    for (int ix = 0; ix < met->nx; ix++)
      for (int iy = 0; iy < met->ny; iy++)
        met->pt[ix][iy] = NAN;
 
  /* Use tropopause climatology... */
  else if (ctl->met_tropo == 1) {
    if (met->coord_type != 0)
      ERRMSG("Only lat/lon grid supported");
#pragma omp parallel for default(shared) collapse(2)
    for (int ix = 0; ix < met->nx; ix++)
      for (int iy = 0; iy < met->ny; iy++)
        met->pt[ix][iy] = (float) clim_tropo(clim, met->time, met->lat[iy]);
  }
 
  /* Use cold point... */
  else if (ctl->met_tropo == 2) {
 
    /* Loop over grid points... */
#pragma omp parallel for default(shared) private(t,t2) collapse(2)
    for (int ix = 0; ix < met->nx; ix++)
      for (int iy = 0; iy < met->ny; iy++) {
 
        /* Interpolate temperature profile... */
        for (int iz = 0; iz < met->np; iz++)
          t[iz] = met->t[ix][iy][iz];
        spline(z, t, met->np, z2, t2, 171, ctl->met_tropo_spline);
 
        /* Find minimum... */
        int iz = (int) gsl_stats_min_index(t2, 1, 171);
        if (iz > 0 && iz < 170)
          met->pt[ix][iy] = (float) p2[iz];
        else
          met->pt[ix][iy] = NAN;
      }
  }
 
  /* Use WMO definition... */
  else if (ctl->met_tropo == 3 || ctl->met_tropo == 4) {
 
    /* Loop over grid points... */
#pragma omp parallel for default(shared) private(t,t2) collapse(2)
    for (int ix = 0; ix < met->nx; ix++)
      for (int iy = 0; iy < met->ny; iy++) {
 
        /* Interpolate temperature profile... */
        int iz;
        for (iz = 0; iz < met->np; iz++)
          t[iz] = met->t[ix][iy][iz];
        spline(z, t, met->np, z2, t2, 191, ctl->met_tropo_spline);
 
        /* Find 1st tropopause... */
        met->pt[ix][iy] = NAN;
        for (iz = 0; iz <= 170; iz++) {
          int found = 1;
          for (int iz2 = iz + 1; iz2 <= iz + 20; iz2++)
            if (LAPSE(p2[iz], t2[iz], p2[iz2], t2[iz2]) > 2.0) {
              found = 0;
              break;
            }
          if (found) {
            if (iz > 0 && iz < 170)
              met->pt[ix][iy] = (float) p2[iz];
            break;
          }
        }
 
        /* Find 2nd tropopause... */
        if (ctl->met_tropo == 4 && isfinite(met->pt[ix][iy])) {
          met->pt[ix][iy] = NAN;
          for (; iz <= 170; iz++) {
            int found = 1;
            for (int iz2 = iz + 1; iz2 <= iz + 10; iz2++)
              if (LAPSE(p2[iz], t2[iz], p2[iz2], t2[iz2]) < 3.0) {
                found = 0;
                break;
              }
            if (found)
              break;
          }
          for (; iz <= 170; iz++) {
            int found = 1;
            for (int iz2 = iz + 1; iz2 <= iz + 20; iz2++)
              if (LAPSE(p2[iz], t2[iz], p2[iz2], t2[iz2]) > 2.0) {
                found = 0;
                break;
              }
            if (found) {
              if (iz > 0 && iz < 170)
                met->pt[ix][iy] = (float) p2[iz];
              break;
            }
          }
        }
      }
  }
 
  /* Use dynamical tropopause... */
  else if (ctl->met_tropo == 5) {
 
    /* Loop over grid points... */
#pragma omp parallel for default(shared) private(pv,pv2,th,th2) collapse(2)
    for (int ix = 0; ix < met->nx; ix++)
      for (int iy = 0; iy < met->ny; iy++) {
 
        /* Interpolate potential vorticity profile... */
        for (int iz = 0; iz < met->np; iz++)
          pv[iz] = met->pv[ix][iy][iz];
        spline(z, pv, met->np, z2, pv2, 171, ctl->met_tropo_spline);
 
        /* Interpolate potential temperature profile... */
        for (int iz = 0; iz < met->np; iz++)
          th[iz] = THETA(met->p[iz], met->t[ix][iy][iz]);
        spline(z, th, met->np, z2, th2, 171, ctl->met_tropo_spline);
 
        /* Find dynamical tropopause... */
        met->pt[ix][iy] = NAN;
        for (int iz = 0; iz <= 170; iz++)
          if (fabs(pv2[iz]) >= ctl->met_tropo_pv
              || th2[iz] >= ctl->met_tropo_theta) {
            if (iz > 0 && iz < 170)
              met->pt[ix][iy] = (float) p2[iz];
            break;
          }
      }
  }
 
  else
    ERRMSG("Cannot calculate tropopause!");
 
  /* Interpolate temperature, geopotential height, and water vapor... */
#pragma omp parallel for default(shared) collapse(2)
  for (int ix = 0; ix < met->nx; ix++)
    for (int iy = 0; iy < met->ny; iy++) {
      double h2ot, tt, zt;
      INTPOL_INIT;
      intpol_met_space_3d(met, met->t, met->pt[ix][iy], met->lon[ix],
                          met->lat[iy], &tt, ci, cw, 1);
      intpol_met_space_3d(met, met->z, met->pt[ix][iy], met->lon[ix],
                          met->lat[iy], &zt, ci, cw, 0);
      intpol_met_space_3d(met, met->h2o, met->pt[ix][iy], met->lon[ix],
                          met->lat[iy], &h2ot, ci, cw, 0);
      met->tt[ix][iy] = (float) tt;
      met->zt[ix][iy] = (float) zt;
      met->h2ot[ix][iy] = (float) h2ot;
    }
}
 
/*****************************************************************************/
 
void read_obs(
  const char *filename,
  const ctl_t *ctl,
  double *rt,
  double *rz,
  double *rlon,
  double *rlat,
  double *robs,
  int *nobs) {
 
  /* Write info... */
  LOG(1, "Read observation data: %s", filename);
 
  /* Read data... */
  if (ctl->obs_type == 0)
    read_obs_asc(filename, rt, rz, rlon, rlat, robs, nobs);
  else if (ctl->obs_type == 1)
    read_obs_nc(filename, rt, rz, rlon, rlat, robs, nobs);
  else
    ERRMSG("Set OBS_TYPE to 0 or 1!");
 
  /* Check time... */
  for (int i = 1; i < *nobs; i++)
    if (rt[i] < rt[i - 1])
      ERRMSG("Time must be ascending!");
 
  /* Write info... */
  int n = *nobs;
  double mini, maxi;
  LOG(2, "Number of observations: %d", *nobs);
  gsl_stats_minmax(&mini, &maxi, rt, 1, (size_t) n);
  LOG(2, "Time range: %.2f ... %.2f s", mini, maxi);
  gsl_stats_minmax(&mini, &maxi, rz, 1, (size_t) n);
  LOG(2, "Altitude range: %g ... %g km", mini, maxi);
  gsl_stats_minmax(&mini, &maxi, rlon, 1, (size_t) n);
  LOG(2, "Longitude range: %g ... %g deg", mini, maxi);
  gsl_stats_minmax(&mini, &maxi, rlat, 1, (size_t) n);
  LOG(2, "Latitude range: %g ... %g deg", mini, maxi);
  gsl_stats_minmax(&mini, &maxi, robs, 1, (size_t) n);
  LOG(2, "Observation range: %g ... %g", mini, maxi);
}
 
/*****************************************************************************/
 
void read_obs_asc(
  const char *filename,
  double *rt,
  double *rz,
  double *rlon,
  double *rlat,
  double *robs,
  int *nobs) {
 
  /* Open observation data file... */
  FILE *in;
  if (!(in = fopen(filename, "r")))
    ERRMSG("Cannot open file!");
 
  /* Read observations... */
  char line[LEN];
  while (fgets(line, LEN, in))
    if (sscanf(line, "%lg %lg %lg %lg %lg", &rt[*nobs], &rz[*nobs],
               &rlon[*nobs], &rlat[*nobs], &robs[*nobs]) == 5)
      if ((++(*nobs)) >= NOBS)
        ERRMSG("Too many observations!");
 
  /* Close observation data file... */
  fclose(in);
}
 
/*****************************************************************************/
 
void read_obs_nc(
  const char *filename,
  double *rt,
  double *rz,
  double *rlon,
  double *rlat,
  double *robs,
  int *nobs) {
 
  int ncid, varid;
 
  /* Open netCDF file... */
  if (nc_open(filename, NC_NOWRITE, &ncid) != NC_NOERR)
    ERRMSG("Cannot open file!");
 
  /* Read the observations from the NetCDF file... */
  NC_INQ_DIM("nobs", nobs, 1, NOBS, 1);
  NC_GET_DOUBLE("time", rt, 1);
  NC_GET_DOUBLE("alt", rz, 1);
  NC_GET_DOUBLE("lon", rlon, 1);
  NC_GET_DOUBLE("lat", rlat, 1);
  NC_GET_DOUBLE("obs", robs, 1);
 
  /* Close file... */
  NC(nc_close(ncid));
}
 
/*****************************************************************************/
 
double scan_ctl(
  const char *filename,
  int argc,
  char *argv[],
  const char *varname,
  const int arridx,
  const char *defvalue,
  char *value) {
 
  FILE *in = NULL;
 
  char fullname1[LEN], fullname2[LEN], rval[LEN];
 
  int contain = 0, i;
 
  /* Open file... */
  if (filename[strlen(filename) - 1] != '-')
    if (!(in = fopen(filename, "r")))
      ERRMSG("Cannot open file!");
 
  /* Set full variable name... */
  if (arridx >= 0) {
    sprintf(fullname1, "%s[%d]", varname, arridx);
    sprintf(fullname2, "%s[*]", varname);
  } else {
    sprintf(fullname1, "%s", varname);
    sprintf(fullname2, "%s", varname);
  }
 
  /* Read data... */
  if (in != NULL) {
    char dummy[LEN], line[LEN], rvarname[LEN];
    while (fgets(line, LEN, in)) {
      if (sscanf(line, "%4999s %4999s %4999s", rvarname, dummy, rval) == 3)
        if (strcasecmp(rvarname, fullname1) == 0 ||
            strcasecmp(rvarname, fullname2) == 0) {
          contain = 1;
          break;
        }
    }
  }
  for (i = 1; i < argc - 1; i++)
    if (strcasecmp(argv[i], fullname1) == 0 ||
        strcasecmp(argv[i], fullname2) == 0) {
      sprintf(rval, "%s", argv[i + 1]);
      contain = 1;
      break;
    }
 
  /* Close file... */
  if (in != NULL)
    fclose(in);
 
  /* Check for missing variables... */
  if (!contain) {
    if (strlen(defvalue) > 0)
      sprintf(rval, "%s", defvalue);
    else
      ERRMSG("Missing variable %s!\n", fullname1);
  }
 
  /* Write info... */
  LOG(1, "%s = %s", fullname1, rval);
 
  /* Return values... */
  if (value != NULL)
    sprintf(value, "%s", rval);
  return atof(rval);
}
 
/*****************************************************************************/
 
double sedi(
  const double p,
  const double T,
  const double rp,
  const double rhop) {
 
  /* Convert particle radius from microns to m... */
  const double rp_help = rp * 1e-6;
 
  /* Density of dry air [kg / m^3]... */
  const double rho = RHO(p, T);
 
  /* Dynamic viscosity of air [kg / (m s)]... */
  const double eta = 1.8325e-5 * (416.16 / (T + 120.)) * pow(T / 296.16, 1.5);
 
  /* Thermal velocity of an air molecule [m / s]... */
  const double v = sqrt(8. * KB * T / (M_PI * M_AIR_MOLECULE));
 
  /* Mean free path of an air molecule [m]... */
  const double lambda = 2. * eta / (rho * v);
 
  /* Knudsen number for air (dimensionless)... */
  const double K = lambda / rp_help;
 
  /* Cunningham slip-flow correction (dimensionless)... */
  const double G = 1. + K * (1.249 + 0.42 * exp(-0.87 / K));
 
  /* Sedimentation velocity [m / s]... */
  return 2. * SQR(rp_help) * (rhop - rho) * G0 / (9. * eta) * G;
}
 
/*****************************************************************************/
 
void spline(
  const double *x,
  const double *y,
  const int n,
  const double *x2,
  double *y2,
  const int n2,
  const int method) {
 
  /* Cubic spline interpolation... */
  if (method == 1) {
 
    /* Allocate... */
    gsl_interp_accel *acc = gsl_interp_accel_alloc();
    gsl_spline *s = gsl_spline_alloc(gsl_interp_cspline, (size_t) n);
 
    /* Interpolate profile... */
    gsl_spline_init(s, x, y, (size_t) n);
    for (int i = 0; i < n2; i++)
      if (x2[i] <= x[0])
        y2[i] = y[0];
      else if (x2[i] >= x[n - 1])
        y2[i] = y[n - 1];
      else
        y2[i] = gsl_spline_eval(s, x2[i], acc);
 
    /* Free... */
    gsl_spline_free(s);
    gsl_interp_accel_free(acc);
  }
 
  /* Linear interpolation... */
  else {
    for (int i = 0; i < n2; i++)
      if (x2[i] <= x[0])
        y2[i] = y[0];
      else if (x2[i] >= x[n - 1])
        y2[i] = y[n - 1];
      else {
        const int idx = locate_irr(x, n, x2[i]);
        y2[i] = LIN(x[idx], y[idx], x[idx + 1], y[idx + 1], x2[i]);
      }
  }
}
 
/*****************************************************************************/
 
float stddev(
  const float *data,
  const int n) {
 
  if (n <= 0)
    return 0;
 
  float mean = 0, var = 0;
 
  for (int i = 0; i < n; ++i) {
    mean += data[i];
    var += SQR(data[i]);
  }
 
  var = var / (float) n - SQR(mean / (float) n);
 
  return (var > 0 ? sqrtf(var) : 0);
}
 
/*****************************************************************************/
 
void time2jsec(
  const int year,
  const int mon,
  const int day,
  const int hour,
  const int min,
  const int sec,
  const double remain,
  double *jsec) {
 
  struct tm t0, t1;
 
  t0.tm_year = 100;
  t0.tm_mon = 0;
  t0.tm_mday = 1;
  t0.tm_hour = 0;
  t0.tm_min = 0;
  t0.tm_sec = 0;
 
  t1.tm_year = year - 1900;
  t1.tm_mon = mon - 1;
  t1.tm_mday = day;
  t1.tm_hour = hour;
  t1.tm_min = min;
  t1.tm_sec = sec;
 
  *jsec = (double) timegm(&t1) - (double) timegm(&t0) + remain;
}
 
/*****************************************************************************/
 
void timer(
  const char *name,
  const char *group,
  const int output) {
 
  static char names[NTIMER][100], groups[NTIMER][100];
 
  static double rt_name[NTIMER], rt_group[NTIMER],
    rt_min[NTIMER], rt_max[NTIMER], dt, t0, t1;
 
  static int iname = -1, igroup = -1, nname, ngroup, ct_name[NTIMER];
 
  /* Get time... */
  t1 = omp_get_wtime();
  dt = t1 - t0;
 
  /* Add elapsed time to current timers... */
  if (iname >= 0) {
    rt_name[iname] += dt;
    rt_min[iname] = (ct_name[iname] <= 0 ? dt : MIN(rt_min[iname], dt));
    rt_max[iname] = (ct_name[iname] <= 0 ? dt : MAX(rt_max[iname], dt));
    ct_name[iname]++;
  }
  if (igroup >= 0)
    rt_group[igroup] += t1 - t0;
 
  /* Report timers... */
  if (output) {
    for (int i = 0; i < nname; i++)
      LOG(1, "TIMER_%s = %.3f s    (min= %g s, mean= %g s,"
          " max= %g s, n= %d)", names[i], rt_name[i], rt_min[i],
          rt_name[i] / ct_name[i], rt_max[i], ct_name[i]);
    for (int i = 0; i < ngroup; i++)
      LOG(1, "TIMER_GROUP_%s = %.3f s", groups[i], rt_group[i]);
    double total = 0.0;
    for (int i = 0; i < nname; i++)
      total += rt_name[i];
    LOG(1, "TIMER_TOTAL = %.3f s", total);
  }
 
  /* Identify IDs of next timer... */
  for (iname = 0; iname < nname; iname++)
    if (strcasecmp(name, names[iname]) == 0)
      break;
  for (igroup = 0; igroup < ngroup; igroup++)
    if (strcasecmp(group, groups[igroup]) == 0)
      break;
 
  /* Check whether this is a new timer... */
  if (iname >= nname) {
    sprintf(names[iname], "%s", name);
    if ((++nname) >= NTIMER)
      ERRMSG("Too many timers!");
  }
 
  /* Check whether this is a new group... */
  if (igroup >= ngroup) {
    sprintf(groups[igroup], "%s", group);
    if ((++ngroup) >= NTIMER)
      ERRMSG("Too many groups!");
  }
 
  /* Save starting time... */
  t0 = t1;
}
 
/*****************************************************************************/
 
double time_from_filename(
  const char *filename,
  const int offset,
  const int with_seconds) {
 
  char tstr[10];
 
  double t;
 
  /* Get time from filename... */
  int len = (int) strlen(filename);
  sprintf(tstr, "%.4s", &filename[len - offset]);
  int year = atoi(tstr);
  sprintf(tstr, "%.2s", &filename[len - offset + 5]);
  int mon = atoi(tstr);
  sprintf(tstr, "%.2s", &filename[len - offset + 8]);
  int day = atoi(tstr);
  sprintf(tstr, "%.2s", &filename[len - offset + 11]);
  int hour = atoi(tstr);
  sprintf(tstr, "%.2s", &filename[len - offset + 14]);
  int min = atoi(tstr);
 
  int sec = 0;
  if (with_seconds) {
    sprintf(tstr, "%.2s", &filename[len - offset + 17]);
    sec = atoi(tstr);
  }
 
  /* Check time... */
  if (year < 1900 || year > 2100 || mon < 1 || mon > 12 || day < 1
      || day > 31 || hour < 0 || hour > 23 || min < 0 || min > 59)
    ERRMSG("Cannot read time from filename!");
 
  /* Convert time to Julian seconds... */
  time2jsec(year, mon, day, hour, min, sec, 0.0, &t);
 
  /* Return time... */
  return t;
}
 
/*****************************************************************************/
 
double tropo_weight(
  const ctl_t *ctl,
  const clim_t *clim,
  const atm_t *atm,
  const int ip) {
 
  /* Get tropopause pressure... */
  const double pt = clim_tropo(clim, atm->time[ip],
                               ctl->met_coord_type ==
                               0 ? atm->lat[ip] : ctl->met_utm_ref_lat);
 
  /* Get pressure range... */
  const double p1 = pt * 0.866877899;
  const double p0 = pt / 0.866877899;
 
  /* Get weighting factor... */
  if (atm->p[ip] > p0)
    return 1;
  else if (atm->p[ip] < p1)
    return 0;
  else
    return LIN(p0, 1.0, p1, 0.0, atm->p[ip]);
}
 
/*****************************************************************************/
 
void write_atm_asc(
  const char *filename,
  const ctl_t *ctl,
  const atm_t *atm,
  const double t) {
 
  FILE *out;
 
  /* Set time interval for output... */
  const double t0 = t - 0.5 * ctl->dt_mod;
  const double t1 = t + 0.5 * ctl->dt_mod;
 
  /* Check if gnuplot output is requested... */
  if (ctl->atm_gpfile[0] != '-') {
 
    /* Create gnuplot pipe... */
    if (!(out = popen("gnuplot", "w")))
      ERRMSG("Cannot create pipe to gnuplot!");
 
    /* Set plot filename... */
    fprintf(out, "set out \"%s.png\"\n", filename);
 
    /* Set time string... */
    double r;
    int year, mon, day, hour, min, sec;
    jsec2time(t, &year, &mon, &day, &hour, &min, &sec, &r);
    fprintf(out, "timestr=\"%d-%02d-%02d, %02d:%02d UTC\"\n",
            year, mon, day, hour, min);
 
    /* Dump gnuplot file to pipe... */
    FILE *in;
    if (!(in = fopen(ctl->atm_gpfile, "r")))
      ERRMSG("Cannot open file!");
    char line[LEN];
    while (fgets(line, LEN, in))
      fprintf(out, "%s", line);
    fclose(in);
  }
 
  else {
 
    /* Create file... */
    if (!(out = fopen(filename, "w")))
      ERRMSG("Cannot create file!");
  }
 
  /* Write header... */
 
  if (ctl->met_coord_type == 0) {
    fprintf(out,
            "# $1 = time [s]\n"
            "# $2 = altitude [km]\n"
            "# $3 = longitude [deg]\n" "# $4 = latitude [deg]\n");
  } else {
    fprintf(out,
            "# $1 = time [s]\n"
            "# $2 = altitude [km]\n" "# $3 = x [m]\n" "# $4 = y [m]\n");
  }
 
  for (int iq = 0; iq < ctl->nq; iq++)
    fprintf(out, "# $%i = %s [%s]\n", iq + 5, ctl->qnt_name[iq],
            ctl->qnt_unit[iq]);
  fprintf(out, "\n");
 
  /* Write data... */
  for (int ip = 0; ip < atm->np; ip += ctl->atm_stride) {
 
    /* Check time... */
    if (ctl->atm_filter == 2 && (atm->time[ip] < t0 || atm->time[ip] > t1))
      continue;
 
    /* Write output... */
    if (ctl->met_coord_type == 0) {
      fprintf(out, "%.2f %g %g %g",
              atm->time[ip], Z(atm->p[ip]), atm->lon[ip], atm->lat[ip]
        );
    } else {
      fprintf(out, "%.2f %g %.2f %.2f",
              atm->time[ip], Z(atm->p[ip]), atm->lon[ip], atm->lat[ip]
        );
    }
 
    for (int iq = 0; iq < ctl->nq; iq++) {
      fprintf(out, " ");
      if (ctl->atm_filter == 1 && (atm->time[ip] < t0 || atm->time[ip] > t1))
        fprintf(out, ctl->qnt_format[iq], NAN);
      else
        fprintf(out, ctl->qnt_format[iq], atm->q[iq][ip]);
    }
    fprintf(out, "\n");
  }
 
  /* Close file... */
  fclose(out);
}
 
/*****************************************************************************/
 
void write_atm_bin(
  const char *filename,
  const ctl_t *ctl,
  const atm_t *atm) {
 
  FILE *out;
 
  /* Create file... */
  if (!(out = fopen(filename, "w")))
    ERRMSG("Cannot create file!");
 
  /* Write version of binary data... */
  int version = 100;
  FWRITE(&version, int,
         1,
         out);
 
  /* Write data... */
  FWRITE(&atm->np, int,
         1,
         out);
  FWRITE(atm->time, double,
           (size_t) atm->np,
         out);
  FWRITE(atm->p, double,
           (size_t) atm->np,
         out);
  FWRITE(atm->lon, double,
           (size_t) atm->np,
         out);
  FWRITE(atm->lat, double,
           (size_t) atm->np,
         out);
  for (int iq = 0; iq < ctl->nq; iq++)
    FWRITE(atm->q[iq], double,
             (size_t) atm->np,
           out);
 
  /* Write final flag... */
  int final = 999;
  FWRITE(&final, int,
         1,
         out);
 
  /* Close file... */
  fclose(out);
}
 
/*****************************************************************************/
 
void write_atm_clams(
  const char *filename,
  const ctl_t *ctl,
  const atm_t *atm) {
 
  if (ctl->met_coord_type != 0)
    ERRMSG("CLaMS atmospheric files support only lat/lon grids");
 
  int tid, pid, ncid, varid;
  size_t start[2], count[2];
 
  /* Create file... */
  NC(nc_create(filename, NC_NETCDF4, &ncid));
 
  /* Define dimensions... */
  NC(nc_def_dim(ncid, "time", 1, &tid));
  NC(nc_def_dim(ncid, "NPARTS", (size_t) atm->np, &pid));
 
  /* Define variables and their attributes... */
  int dim_ids[2] = { tid, pid };
  NC_DEF_VAR("time", NC_DOUBLE, 1, &tid, "Time",
             "seconds since 2000-01-01 00:00:00 UTC", ctl->atm_nc_level, 0);
  NC_DEF_VAR("LAT", NC_DOUBLE, 1, &pid, "Latitude", "deg",
             ctl->atm_nc_level, 0);
  NC_DEF_VAR("LON", NC_DOUBLE, 1, &pid, "Longitude", "deg",
             ctl->atm_nc_level, 0);
  NC_DEF_VAR("PRESS", NC_DOUBLE, 1, &pid, "Pressure", "hPa",
             ctl->atm_nc_level, 0);
  NC_DEF_VAR("ZETA", NC_DOUBLE, 1, &pid, "Zeta", "K", ctl->atm_nc_level, 0);
  for (int iq = 0; iq < ctl->nq; iq++)
    NC_DEF_VAR(ctl->qnt_name[iq], NC_DOUBLE, 2, dim_ids,
               ctl->qnt_name[iq], ctl->qnt_unit[iq],
               ctl->atm_nc_level, ctl->atm_nc_quant[iq]);
 
  /* Define global attributes... */
  NC_PUT_ATT_GLOBAL("exp_VERTCOOR_name", "zeta");
  NC_PUT_ATT_GLOBAL("model", "MPTRAC");
 
  /* End definitions... */
  NC(nc_enddef(ncid));
 
  /* Write data... */
  NC_PUT_DOUBLE("time", atm->time, 0);
  NC_PUT_DOUBLE("LAT", atm->lat, 0);
  NC_PUT_DOUBLE("LON", atm->lon, 0);
  NC_PUT_DOUBLE("PRESS", atm->p, 0);
  NC_PUT_DOUBLE("ZETA", atm->q[ctl->qnt_zeta_d], 0);
  for (int iq = 0; iq < ctl->nq; iq++)
    NC_PUT_DOUBLE(ctl->qnt_name[iq], atm->q[iq], 0);
 
  /* Close file... */
  NC(nc_close(ncid));
}
 
/*****************************************************************************/
 
void write_atm_clams_traj(
  const char *dirname,
  const ctl_t *ctl,
  const atm_t *atm,
  const double t) {
 
  if (ctl->met_coord_type != 0)
    ERRMSG("CLaMS atmospheric files support only lat/lon grids");
 
  /* Global Counter... */
  static size_t out_cnt = 0;
 
  double r, r_start, r_stop;
  int year, mon, day, hour, min, sec;
  int year_start, mon_start, day_start, hour_start, min_start, sec_start;
  int year_stop, mon_stop, day_stop, hour_stop, min_stop, sec_stop;
  char filename_out[2 * LEN] = "traj_fix_3d_YYYYMMDDHH_YYYYMMDDHH.nc";
 
  int ncid, varid, tid, pid, cid;
  int dim_ids[2];
 
  /* time, nparc */
  size_t start[2];
  size_t count[2];
 
  /* Determine start and stop times of calculation... */
  jsec2time(t, &year, &mon, &day, &hour, &min, &sec, &r);
  jsec2time(ctl->t_start, &year_start, &mon_start, &day_start, &hour_start,
            &min_start, &sec_start, &r_start);
  jsec2time(ctl->t_stop, &year_stop, &mon_stop, &day_stop, &hour_stop,
            &min_stop, &sec_stop, &r_stop);
 
  sprintf(filename_out,
          "%s/traj_fix_3d_%02d%02d%02d%02d_%02d%02d%02d%02d.nc", dirname,
          year_start % 100, mon_start, day_start, hour_start,
          year_stop % 100, mon_stop, day_stop, hour_stop);
  LOG(1, "Write traj file: %s", filename_out);
 
  /* Define hyperslap for the traj_file... */
  start[0] = out_cnt;
  start[1] = 0;
  count[0] = 1;
  count[1] = (size_t) atm->np;
 
  /* Create the file at the first timestep... */
  if (out_cnt == 0) {
 
    /* Create file... */
    NC(nc_create(filename_out, NC_NETCDF4, &ncid));
 
    /* Define dimensions... */
    NC(nc_def_dim(ncid, "time", NC_UNLIMITED, &tid));
    NC(nc_def_dim(ncid, "NPARTS", (size_t) atm->np, &pid));
    NC(nc_def_dim(ncid, "TMDT", 7, &cid));
    dim_ids[0] = tid;
    dim_ids[1] = pid;
 
    /* Define variables and their attributes... */
    NC_DEF_VAR("time", NC_DOUBLE, 1, &tid, "Time",
               "seconds since 2000-01-01 00:00:00 UTC", ctl->atm_nc_level, 0);
    NC_DEF_VAR("LAT", NC_DOUBLE, 2, dim_ids, "Latitude", "deg",
               ctl->atm_nc_level, 0);
    NC_DEF_VAR("LON", NC_DOUBLE, 2, dim_ids, "Longitude", "deg",
               ctl->atm_nc_level, 0);
    NC_DEF_VAR("PRESS", NC_DOUBLE, 2, dim_ids, "Pressure", "hPa",
               ctl->atm_nc_level, 0);
    NC_DEF_VAR("ZETA", NC_DOUBLE, 2, dim_ids, "Zeta", "K",
               ctl->atm_nc_level, 0);
    for (int iq = 0; iq < ctl->nq; iq++)
      NC_DEF_VAR(ctl->qnt_name[iq], NC_DOUBLE, 2, dim_ids,
                 ctl->qnt_name[iq], ctl->qnt_unit[iq],
                 ctl->atm_nc_level, ctl->atm_nc_quant[iq]);
 
    /* Define global attributes... */
    NC_PUT_ATT_GLOBAL("exp_VERTCOOR_name", "zeta");
    NC_PUT_ATT_GLOBAL("model", "MPTRAC");
 
    /* End definitions... */
    NC(nc_enddef(ncid));
    NC(nc_close(ncid));
  }
 
  /* Increment global counter to change hyperslap... */
  out_cnt++;
 
  /* Open file... */
  NC(nc_open(filename_out, NC_WRITE, &ncid));
 
  /* Write data... */
  NC_PUT_DOUBLE("time", atm->time, 1);
  NC_PUT_DOUBLE("LAT", atm->lat, 1);
  NC_PUT_DOUBLE("LON", atm->lon, 1);
  NC_PUT_DOUBLE("PRESS", atm->p, 1);
  if (ctl->advect_vert_coord == 1) {
    NC_PUT_DOUBLE("ZETA", atm->q[ctl->qnt_zeta], 1);
  } else if (ctl->qnt_zeta >= 0) {
    NC_PUT_DOUBLE("ZETA", atm->q[ctl->qnt_zeta_d], 1);
  }
  for (int iq = 0; iq < ctl->nq; iq++)
    NC_PUT_DOUBLE(ctl->qnt_name[iq], atm->q[iq], 1);
 
  /* Close file... */
  NC(nc_close(ncid));
 
  /* At the last time step create the init_fix_YYYYMMDDHH file... */
  if ((year == year_stop) && (mon == mon_stop)
      && (day == day_stop) && (hour == hour_stop)) {
 
    /* Set filename... */
    char filename_init[2 * LEN] = "./init_fix_YYYYMMDDHH.nc";
    sprintf(filename_init, "%s/init_fix_%02d%02d%02d%02d.nc",
            dirname, year_stop % 100, mon_stop, day_stop, hour_stop);
    LOG(1, "Write init file: %s", filename_init);
 
    /* Create file... */
    NC(nc_create(filename_init, NC_NETCDF4, &ncid));
 
    /* Define dimensions... */
    NC(nc_def_dim(ncid, "time", 1, &tid));
    NC(nc_def_dim(ncid, "NPARTS", (size_t) atm->np, &pid));
    dim_ids[0] = tid;
    dim_ids[1] = pid;
 
    /* Define variables and their attributes... */
    NC_DEF_VAR("time", NC_DOUBLE, 1, &tid, "Time",
               "seconds since 2000-01-01 00:00:00 UTC", ctl->atm_nc_level, 0);
    NC_DEF_VAR("LAT", NC_DOUBLE, 1, &pid, "Latitude", "deg",
               ctl->atm_nc_level, 0);
    NC_DEF_VAR("LON", NC_DOUBLE, 1, &pid, "Longitude", "deg",
               ctl->atm_nc_level, 0);
    NC_DEF_VAR("PRESS", NC_DOUBLE, 1, &pid, "Pressure", "hPa",
               ctl->atm_nc_level, 0);
    NC_DEF_VAR("ZETA", NC_DOUBLE, 1, &pid, "Zeta", "K", ctl->atm_nc_level, 0);
    for (int iq = 0; iq < ctl->nq; iq++)
      NC_DEF_VAR(ctl->qnt_name[iq], NC_DOUBLE, 2, dim_ids,
                 ctl->qnt_name[iq], ctl->qnt_unit[iq],
                 ctl->atm_nc_level, ctl->atm_nc_quant[iq]);
 
    /* Define global attributes... */
    NC_PUT_ATT_GLOBAL("exp_VERTCOOR_name", "zeta");
    NC_PUT_ATT_GLOBAL("model", "MPTRAC");
 
    /* End definitions... */
    NC(nc_enddef(ncid));
 
    /* Write data... */
    NC_PUT_DOUBLE("time", atm->time, 0);
    NC_PUT_DOUBLE("LAT", atm->lat, 0);
    NC_PUT_DOUBLE("LON", atm->lon, 0);
    NC_PUT_DOUBLE("PRESS", atm->p, 0);
    NC_PUT_DOUBLE("ZETA", atm->q[ctl->qnt_zeta_d], 0);
    for (int iq = 0; iq < ctl->nq; iq++)
      NC_PUT_DOUBLE(ctl->qnt_name[iq], atm->q[iq], 0);
 
    /* Close file... */
    NC(nc_close(ncid));
  }
}
 
/*****************************************************************************/
 
void write_atm_nc(
  const char *filename,
  const ctl_t *ctl,
  const atm_t *atm) {
 
  int ncid, obsid, varid;
 
  size_t start[2], count[2];
 
  /* Create file... */
  NC(nc_create(filename, NC_NETCDF4, &ncid));
 
  /* Define dimensions... */
  NC(nc_def_dim(ncid, "obs", (size_t) atm->np, &obsid));
 
  /* Define variables and their attributes... */
  NC_DEF_VAR("time", NC_DOUBLE, 1, &obsid, "time",
             "seconds since 2000-01-01 00:00:00 UTC", ctl->atm_nc_level, 0);
  NC_DEF_VAR("press", NC_DOUBLE, 1, &obsid, "pressure", "hPa",
             ctl->atm_nc_level, 0);
  NC_DEF_VAR("lon", NC_DOUBLE, 1, &obsid, "longitude", "degrees_east",
             ctl->atm_nc_level, 0);
  NC_DEF_VAR("lat", NC_DOUBLE, 1, &obsid, "latitude", "degrees_north",
             ctl->atm_nc_level, 0);
  for (int iq = 0; iq < ctl->nq; iq++)
    NC_DEF_VAR(ctl->qnt_name[iq], NC_DOUBLE, 1, &obsid,
               ctl->qnt_longname[iq], ctl->qnt_unit[iq],
               ctl->atm_nc_level, ctl->atm_nc_quant[iq]);
 
  /* Define global attributes... */
  NC_PUT_ATT_GLOBAL("featureType", "point");
 
  /* End definitions... */
  NC(nc_enddef(ncid));
 
  /* Write data... */
  NC_PUT_DOUBLE("time", atm->time, 0);
  NC_PUT_DOUBLE("press", atm->p, 0);
  NC_PUT_DOUBLE("lon", atm->lon, 0);
  NC_PUT_DOUBLE("lat", atm->lat, 0);
  for (int iq = 0; iq < ctl->nq; iq++)
    NC_PUT_DOUBLE(ctl->qnt_name[iq], atm->q[iq], 0);
 
  /* Close file... */
  NC(nc_close(ncid));
}
 
/*****************************************************************************/
 
void write_budget(
  const char *filename,
  const ctl_t *ctl,
  const atm_t *atm,
  const double t) {
 
  static FILE *out;
 
  /* Set timer... */
  SELECT_TIMER("WRITE_BUDGET", "OUTPUT");
 
  /* Check quantities... */
  if (ctl->qnt_m < 0)
    ERRMSG("Need quantity mass!");
  const int ensemble = (ctl->nens > 0);
  if (ensemble && ctl->qnt_ens < 0)
    ERRMSG("Missing ensemble IDs!");
  if (ctl->nens > NENS)
    ERRMSG("Too many ensembles!");
 
  /* Initialize output file... */
  if (out == NULL) {
    LOG(1, "Write mass budget data: %s", filename);
    if (!(out = fopen(filename, "w")))
      ERRMSG("Cannot create file!");
    fprintf(out,
            "# $1 = time [s]\n"
            "# $2 = ensemble ID (-999=total)\n"
            "# $3 = number of active air parcels [1]\n"
            "# $4 = total mass [kg]\n"
            "# $5 = mass loss due to OH chemistry [kg]\n"
            "# $6 = mass loss due to H2O2 chemistry [kg]\n"
            "# $7 = mass loss due to KPP chemistry [kg]\n"
            "# $8 = mass loss due to wet deposition [kg]\n"
            "# $9 = mass loss due to dry deposition [kg]\n"
            "# $10 = mass loss due to exponential decay [kg]\n"
            "# $11 = total tracked mass loss [kg]\n"
            "# $12 = accounted mass [kg]\n\n");
  }
 
  /* Calculate mass budget... */
  const int nq = 7;
  const int qnt[7] = {
    ctl->qnt_m, ctl->qnt_mloss_oh, ctl->qnt_mloss_h2o2,
    ctl->qnt_mloss_kpp, ctl->qnt_mloss_wet, ctl->qnt_mloss_dry,
    ctl->qnt_mloss_decay
  };
  double sum[NENS + 1][7] = { {0} };
  int np[NENS + 1] = { 0 };
  const double t0 = t - 0.5 * ctl->dt_mod;
  const double t1 = t + 0.5 * ctl->dt_mod;
 
  /* Sum active air parcels... */
  for (int ip = 0; ip < atm->np; ip++) {
    if (atm->time[ip] < t0 || atm->time[ip] > t1)
      continue;
    int e = 0;
    if (ensemble) {
      e = (int) atm->q[ctl->qnt_ens][ip];
      if (e < 0 || e >= ctl->nens)
        ERRMSG("Ensemble ID out of range!");
    }
    np[e]++;
    np[NENS]++;
    for (int iq = 0; iq < nq; iq++)
      if (qnt[iq] >= 0) {
        sum[e][iq] += atm->q[qnt[iq]][ip];
        sum[NENS][iq] += atm->q[qnt[iq]][ip];
      }
  }
 
  /* Write total and ensemble budgets... */
  for (int ie = -1; ie < (ensemble ? ctl->nens : 0); ie++) {
    const int e = (ie < 0 ? NENS : ie);
    double mloss = 0;
    for (int iq = 1; iq < nq; iq++)
      if (qnt[iq] >= 0)
        mloss += sum[e][iq];
    fprintf(out, "%.2f %d %d %g", t, ie < 0 ? -999 : ie, np[e], sum[e][0]);
    for (int iq = 1; iq < nq; iq++)
      fprintf(out, " %g", qnt[iq] >= 0 ? sum[e][iq] : NAN);
    fprintf(out, " %g %g\n", mloss, sum[e][0] + mloss);
  }
  fflush(out);
 
  /* Finalize... */
  if (t == ctl->t_stop) {
    fclose(out);
    out = NULL;
  }
}
 
/*****************************************************************************/
 
void write_csi(
  const char *filename,
  const ctl_t *ctl,
  const atm_t *atm,
  const double t) {
 
  if (ctl->met_coord_type != 0)
    ERRMSG("Only lat/lon grid supported");
 
  static FILE *out;
 
  static double *modmean, *obsmean, *obsstd, *rt, *rz, *rlon, *rlat, *robs,
    *area, dlon, dlat, dz, x[NCSI], y[NCSI], obsstdn[NCSI], kz[EP], kw[EP];
 
  static int *obscount, nobs, nk;
 
  static int ct[NENS], cx[NENS], cy[NENS], cz[NENS], n[NENS];
 
  const int ensemble = (ctl->nens > 0);
 
  /* Set timer */
  SELECT_TIMER("WRITE_CSI", "OUTPUT");
 
  /* Check quantities... */
  if (ctl->qnt_m < 0)
    ERRMSG("Need quantity mass!");
  if (ensemble) {
    if (ctl->qnt_ens < 0)
      ERRMSG("Missing ensemble IDs!");
    if (ctl->nens > NENS)
      ERRMSG("Too many ensembles!");
  }
 
  /* Init... */
  if (t == ctl->t_start) {
 
    /* Allocate.. */
    ALLOC(area, double,
          ctl->csi_ny);
    ALLOC(rt, double,
          NOBS);
    ALLOC(rz, double,
          NOBS);
    ALLOC(rlon, double,
          NOBS);
    ALLOC(rlat, double,
          NOBS);
    ALLOC(robs, double,
          NOBS);
 
    /* Read observation data... */
    read_obs(ctl->csi_obsfile, ctl, rt, rz, rlon, rlat, robs, &nobs);
 
    /* Read kernel data... */
    if (ctl->csi_kernel[0] != '-')
      read_kernel(ctl->csi_kernel, kz, kw, &nk);
 
    /* Create new file... */
    LOG(1, "Write CSI%s data: %s", ensemble ? " ensemble" : "", filename);
    if (!(out = fopen(filename, "w")))
      ERRMSG("Cannot create file!");
 
    /* Write header... */
    fprintf(out,
            "# $1 = time [s]\n"
            "# $2 = ensemble ID\n"
            "# $3 = number of hits (cx)\n"
            "# $4 = number of misses (cy)\n"
            "# $5 = number of false alarms (cz)\n"
            "# $6 = number of observations (cx + cy)\n"
            "# $7 = number of forecasts (cx + cz)\n"
            "# $8 = bias (%%)\n"
            "# $9 = POD (%%)\n"
            "# $10 = FAR (%%)\n"
            "# $11 = CSI (%%)\n"
            "# $12 = hits by random chance\n"
            "# $13 = ETS (%%)\n"
            "# $14 = Pearson R\n"
            "# $15 = Spearman R\n"
            "# $16 = mean error [kg/m²]\n"
            "# $17 = RMSE [kg/m²]\n"
            "# $18 = MAE [kg/m²]\n"
            "# $19 = log-likelihood\n" "# $20 = number of points\n\n");
 
    /* Set grid box size... */
    dz = (ctl->csi_z1 - ctl->csi_z0) / ctl->csi_nz;
    dlon = (ctl->csi_lon1 - ctl->csi_lon0) / ctl->csi_nx;
    dlat = (ctl->csi_lat1 - ctl->csi_lat0) / ctl->csi_ny;
 
    /* Set horizontal coordinates... */
    for (int iy = 0; iy < ctl->csi_ny; iy++) {
      const double lat = ctl->csi_lat0 + dlat * (iy + 0.5);
      area[iy] = dlat * dlon * SQR(RE * M_PI / 180.0) * cos(DEG2RAD(lat));
    }
  }
 
  /* Set time interval... */
  const double t0 = t - 0.5 * ctl->dt_mod;
  const double t1 = t + 0.5 * ctl->dt_mod;
 
  /* Allocate... */
  int grid_size = ctl->csi_nx * ctl->csi_ny * ctl->csi_nz;
  ALLOC(modmean, double,
          (ensemble ? ctl->nens : 1) * grid_size);
  ALLOC(obsmean, double,
        grid_size);
  ALLOC(obscount, int,
        grid_size);
  ALLOC(obsstd, double,
        grid_size);
 
  /* Init... */
  for (int i = 0; i < (ensemble ? ctl->nens : 1); i++)
    ct[i] = cx[i] = cy[i] = cz[i] = n[i] = 0;
 
  /* Loop over observations... */
  for (int i = 0; i < nobs; i++) {
    if (rt[i] < t0 || rt[i] >= t1 || !isfinite(robs[i]))
      continue;
 
    /* Check grid boundaries and calculate indices... */
    if (rlon[i] < ctl->csi_lon0 || rlon[i] >= ctl->csi_lon1
        || rlat[i] < ctl->csi_lat0 || rlat[i] >= ctl->csi_lat1
        || rz[i] < ctl->csi_z0 || rz[i] >= ctl->csi_z1)
      continue;
    const int ix = (int) ((rlon[i] - ctl->csi_lon0) / dlon);
    const int iy = (int) ((rlat[i] - ctl->csi_lat0) / dlat);
    const int iz = (int) ((rz[i] - ctl->csi_z0) / dz);
    if (ix >= ctl->csi_nx || iy >= ctl->csi_ny || iz >= ctl->csi_nz)
      continue;
 
    /* Get mean observation index... */
    const int idx = ARRAY_3D(ix, iy, ctl->csi_ny, iz, ctl->csi_nz);
    obsmean[idx] += robs[i];
    obsstd[idx] += SQR(robs[i]);
    obscount[idx]++;
  }
 
  /* Analyze model data... */
  for (int ip = 0; ip < atm->np; ip++) {
 
    /* Check time... */
    if (atm->time[ip] < t0 || atm->time[ip] > t1)
      continue;
 
    /* Get ensemble ID... */
    int ens_id = ensemble ? (int) atm->q[ctl->qnt_ens][ip] : 0;
    if (ens_id < 0 || ens_id >= (ensemble ? ctl->nens : 1))
      ERRMSG("Ensemble ID out of range!");
 
    /* Check grid boundaries and get indices... */
    const double zpart = Z(atm->p[ip]);
    if (atm->lon[ip] < ctl->csi_lon0
        || atm->lon[ip] >= ctl->csi_lon1
        || atm->lat[ip] < ctl->csi_lat0
        || atm->lat[ip] >= ctl->csi_lat1
        || zpart < ctl->csi_z0 || zpart >= ctl->csi_z1)
      continue;
    const int ix = (int) ((atm->lon[ip] - ctl->csi_lon0) / dlon);
    const int iy = (int) ((atm->lat[ip] - ctl->csi_lat0) / dlat);
    const int iz = (int) ((zpart - ctl->csi_z0) / dz);
    if (ix >= ctl->csi_nx || iy >= ctl->csi_ny || iz >= ctl->csi_nz)
      continue;
 
    /* Get total mass in grid cell... */
    const int idx =
      ens_id * grid_size + ARRAY_3D(ix, iy, ctl->csi_ny, iz, ctl->csi_nz);
    modmean[idx] +=
      kernel_weight(kz, kw, nk, atm->p[ip]) * atm->q[ctl->qnt_m][ip];
  }
  for (int e = 0; e < (ensemble ? ctl->nens : 1); e++) {
    /* Analyze all grid cells... */
    for (int ix = 0; ix < ctl->csi_nx; ix++)
      for (int iy = 0; iy < ctl->csi_ny; iy++)
        for (int iz = 0; iz < ctl->csi_nz; iz++) {
 
          /* Calculate mean observation index... */
          const int idx = ARRAY_3D(ix, iy, ctl->csi_ny, iz, ctl->csi_nz);
          if (e == 0)
            if (obscount[idx]) {
              obsmean[idx] /= obscount[idx];
              obsstd[idx] =
                sqrt(obsstd[idx] / obscount[idx] - SQR(obsmean[idx]));
            }
 
          /* Calculate model mean per ensemble... */
          const int midx = e * grid_size + idx;
          if (modmean[midx] > 0)
            modmean[midx] /= (1e6 * area[iy]);
 
          /* Check number of observations... */
          if (obscount[idx]) {
 
            /* Calculate CSI... */
            ct[e]++;
            if (obsmean[idx] >= ctl->csi_obsmin
                && modmean[midx] >= ctl->csi_modmin)
              cx[e]++;
            else if (obsmean[idx] >= ctl->csi_obsmin)
              cy[e]++;
            else if (modmean[midx] >= ctl->csi_modmin)
              cz[e]++;
 
            /* Save data for other verification statistics... */
            if (obsmean[idx] >= ctl->csi_obsmin
                || modmean[midx] >= ctl->csi_modmin) {
              x[n[e]] = modmean[midx];
              y[n[e]] = obsmean[idx];
              if (modmean[midx] >= ctl->csi_modmin)
                obsstdn[n[e]] = obsstd[idx];
              if ((++n[e]) >= NCSI)
                ERRMSG("Too many points for statistics!");
            }
          }
        }
    /* Write output... */
    if (fmod(t, ctl->csi_dt_out) == 0) {
 
      if (n[e] == 0)
        continue;
 
      /* Calculate verification statistics
         (https://www.cawcr.gov.au/projects/verification/) ... */
      static double work[2 * NCSI], work2[2 * NCSI];
      const int n_obs = cx[e] + cy[e];
      const int n_for = cx[e] + cz[e];
      const double cx_rd = (ct[e] > 0) ? (1. * n_obs * n_for) / ct[e] : NAN;
      const double bias = (n_obs > 0) ? 100. * n_for / n_obs : NAN;
      const double pod = (n_obs > 0) ? 100. * cx[e] / n_obs : NAN;
      const double far = (n_for > 0) ? 100. * cz[e] / n_for : NAN;
      const double csi =
        (cx[e] + cy[e] + cz[e] >
         0) ? 100. * cx[e] / (cx[e] + cy[e] + cz[e]) : NAN;
      const double ets =
        (cx[e] + cy[e] + cz[e] - cx_rd >
         0) ? 100. * (cx[e] - cx_rd) / (cx[e] + cy[e] + cz[e] - cx_rd) : NAN;
      const double rho_p = gsl_stats_correlation(x, 1, y, 1, (size_t) n[e]);
      const double rho_s =
        gsl_stats_spearman(x, 1, y, 1, (size_t) n[e], work);
      for (int i = 0; i < n[e]; i++) {
        work[i] = x[i] - y[i];
        work2[i] = (obsstdn[i] != 0) ? work[i] / obsstdn[i] : 0;
      }
      const double mean = gsl_stats_mean(work, 1, (size_t) n[e]);
      const double rmse =
        gsl_stats_sd_with_fixed_mean(work, 1, (size_t) n[e], 0.0);
      const double absdev = gsl_stats_absdev_m(work, 1, (size_t) n[e], 0.0);
      const double loglikelihood =
        gsl_stats_tss_m(work2, 1, (size_t) n[e], 0.0) * -0.5;
 
      /* Write... */
      fprintf(out,
              "%.2f %d %d %d %d %d %d %g %g %g %g %g %g %g %g %g %g %g %g %d\n",
              t, ensemble ? e : -999, cx[e], cy[e], cz[e], n_obs, n_for, bias,
              pod, far, csi, cx_rd, ets, rho_p, rho_s, mean, rmse, absdev,
              loglikelihood, n[e]);
 
      /* Set counters to zero... */
      for (int i = 0; i < n[e]; i++)
        work[i] = work2[i] = x[i] = y[i] = obsstdn[i] = 0;
      ct[e] = cx[e] = cy[e] = cz[e] = n[e] = 0;
    }
  }
  /* Free... */
  free(modmean);
  free(obsmean);
  free(obscount);
  free(obsstd);
 
  /* Finalize... */
  if (t == ctl->t_stop) {
 
    /* Close output file... */
    fclose(out);
 
    /* Free... */
    free(area);
    free(rt);
    free(rz);
    free(rlon);
    free(rlat);
    free(robs);
  }
}
 
/*****************************************************************************/
 
void write_ens(
  const char *filename,
  const ctl_t *ctl,
  const atm_t *atm,
  const double t) {
 
  if (ctl->met_coord_type != 0)
    ERRMSG("Only lat/lon grid supported");
 
  static FILE *out;
 
  static double dummy, lat, lon, qm[NQ][NENS], qs[NQ][NENS], xm[NENS][3],
    x[3], zm[NENS];
 
  static int n[NENS];
 
  /* Set timer... */
  SELECT_TIMER("WRITE_ENS", "OUTPUT");
 
  /* Check quantities... */
  if (ctl->qnt_ens < 0)
    ERRMSG("Missing ensemble IDs!");
 
  /* Set time interval... */
  const double t0 = t - 0.5 * ctl->dt_mod;
  const double t1 = t + 0.5 * ctl->dt_mod;
 
  /* Init... */
  for (int i = 0; i < NENS; i++) {
    for (int iq = 0; iq < ctl->nq; iq++)
      qm[iq][i] = qs[iq][i] = 0;
    xm[i][0] = xm[i][1] = xm[i][2] = zm[i] = 0;
    n[i] = 0;
  }
 
  /* Loop over air parcels... */
  for (int ip = 0; ip < atm->np; ip++) {
 
    /* Check time... */
    if (atm->time[ip] < t0 || atm->time[ip] > t1)
      continue;
 
    /* Check ensemble ID... */
    if (atm->q[ctl->qnt_ens][ip] < 0 || atm->q[ctl->qnt_ens][ip] >= NENS)
      ERRMSG("Ensemble ID is out of range!");
 
    /* Get means... */
    geo2cart(0, atm->lon[ip], atm->lat[ip], x);
    for (int iq = 0; iq < ctl->nq; iq++) {
      qm[iq][ctl->qnt_ens] += atm->q[iq][ip];
      qs[iq][ctl->qnt_ens] += SQR(atm->q[iq][ip]);
    }
    xm[ctl->qnt_ens][0] += x[0];
    xm[ctl->qnt_ens][1] += x[1];
    xm[ctl->qnt_ens][2] += x[2];
    zm[ctl->qnt_ens] += Z(atm->p[ip]);
    n[ctl->qnt_ens]++;
  }
 
  /* Create file... */
  LOG(1, "Write ensemble data: %s", filename);
  if (!(out = fopen(filename, "w")))
    ERRMSG("Cannot create file!");
 
  /* Write header... */
  fprintf(out,
          "# $1 = time [s]\n"
          "# $2 = altitude [km]\n"
          "# $3 = longitude [deg]\n" "# $4 = latitude [deg]\n");
  for (int iq = 0; iq < ctl->nq; iq++)
    fprintf(out, "# $%d = %s (mean) [%s]\n", 5 + iq,
            ctl->qnt_name[iq], ctl->qnt_unit[iq]);
  for (int iq = 0; iq < ctl->nq; iq++)
    fprintf(out, "# $%d = %s (sigma) [%s]\n", 5 + ctl->nq + iq,
            ctl->qnt_name[iq], ctl->qnt_unit[iq]);
  fprintf(out, "# $%d = number of members\n\n", 5 + 2 * ctl->nq);
 
  /* Write data... */
  for (int i = 0; i < NENS; i++)
    if (n[i] > 0) {
      cart2geo(xm[i], &dummy, &lon, &lat);
      fprintf(out, "%.2f %g %g %g", t, zm[i] / n[i], lon, lat);
      for (int iq = 0; iq < ctl->nq; iq++) {
        fprintf(out, " ");
        fprintf(out, ctl->qnt_format[iq], qm[iq][i] / n[i]);
      }
      for (int iq = 0; iq < ctl->nq; iq++) {
        fprintf(out, " ");
        double var = qs[iq][i] / n[i] - SQR(qm[iq][i] / n[i]);
        fprintf(out, ctl->qnt_format[iq], (var > 0 ? sqrt(var) : 0));
      }
      fprintf(out, " %d\n", n[i]);
    }
 
  /* Close file... */
  fclose(out);
}
 
/*****************************************************************************/
 
void write_depo(
  const char *filename,
  const ctl_t *ctl,
  const depo_t *depo,
  const double t) {
 
  double *area, *data, *lat, *lon;
 
  /* Set timer... */
  SELECT_TIMER("WRITE_DEPO", "OUTPUT");
  LOG(1, "Write radioactive deposition data: %s", filename);
 
  /* Allocate output arrays... */
  const int nxy = ctl->grid_nx * ctl->grid_ny;
  ALLOC(area, double,
        ctl->grid_ny);
  ALLOC(data, double,
        4 * nxy);
  ALLOC(lat, double,
        ctl->grid_ny);
  ALLOC(lon, double,
        ctl->grid_nx);
 
  /* Set horizontal coordinates and grid-cell areas... */
  const double dlon = (ctl->grid_lon1 - ctl->grid_lon0) / ctl->grid_nx;
  const double dlat = (ctl->grid_lat1 - ctl->grid_lat0) / ctl->grid_ny;
  for (int ix = 0; ix < ctl->grid_nx; ix++)
    lon[ix] = ctl->grid_lon0 + dlon * (ix + 0.5);
  for (int iy = 0; iy < ctl->grid_ny; iy++) {
    lat[iy] = ctl->grid_lat0 + dlat * (iy + 0.5);
    area[iy] = 1e6 * dlat * dlon * SQR(RE * M_PI / 180.)
      * cos(DEG2RAD(lat[iy]));
  }
 
  /* Convert inventories to activity densities at output time... */
  const double lambda[4] = {
    log(2.0) / RADIO_HALF_LIFE_PB210,
    log(2.0) / RADIO_HALF_LIFE_BE7,
    log(2.0) / RADIO_HALF_LIFE_CS137,
    log(2.0) / RADIO_HALF_LIFE_I131
  };
  const double *inventory[4] = {
    depo->Apb210, depo->Abe7, depo->Acs137, depo->Ai131
  };
  for (int iq = 0; iq < 4; iq++) {
    const double decay = ctl->radio_decay
      ? exp(-lambda[iq] * (t - ctl->t_start)) : 1.0;
    for (int ix = 0; ix < ctl->grid_nx; ix++)
      for (int iy = 0; iy < ctl->grid_ny; iy++) {
        const int idx = ARRAY_2D(ix, iy, ctl->grid_ny);
        data[iq * nxy + idx] = inventory[iq][idx] * decay / area[iy];
      }
  }
 
  /* Write output... */
  if (ctl->depo_type == 0)
    write_depo_asc(filename, ctl, data, t, lon, lat, area);
  else if (ctl->depo_type == 1)
    write_depo_nc(filename, ctl, data, t, lon, lat, area);
  else
    ERRMSG("Radioactive deposition output type unknown!");
 
  /* Free... */
  free(area);
  free(data);
  free(lat);
  free(lon);
}
 
/*****************************************************************************/
 
void write_depo_asc(
  const char *filename,
  const ctl_t *ctl,
  const double *data,
  const double t,
  const double *lon,
  const double *lat,
  const double *area) {
 
  FILE *out;
  if (!(out = fopen(filename, "w")))
    ERRMSG("Cannot create file!");
 
  fprintf(out,
          "# $1 = time [s]\n"
          "# $2 = longitude [deg]\n"
          "# $3 = latitude [deg]\n"
          "# $4 = area [m^2]\n"
          "# $5 = deposited Pb-210 activity [Bq/m^2]\n"
          "# $6 = deposited Be-7 activity [Bq/m^2]\n"
          "# $7 = deposited Cs-137 activity [Bq/m^2]\n"
          "# $8 = deposited I-131 activity [Bq/m^2]\n\n");
 
  const int nxy = ctl->grid_nx * ctl->grid_ny;
  for (int ix = 0; ix < ctl->grid_nx; ix++) {
    for (int iy = 0; iy < ctl->grid_ny; iy++) {
      const int idx = ARRAY_2D(ix, iy, ctl->grid_ny);
      fprintf(out, "%.2f %g %g %g %g %g %g %g\n",
              t, lon[ix], lat[iy], area[iy],
              data[idx], data[nxy + idx],
              data[2 * nxy + idx], data[3 * nxy + idx]);
    }
    fprintf(out, "\n");
  }
 
  fclose(out);
}
 
/*****************************************************************************/
 
void write_depo_nc(
  const char *filename,
  const ctl_t *ctl,
  const double *data,
  const double t,
  const double *lon,
  const double *lat,
  const double *area) {
 
  double *help;
  int ncid, dimid[3], varid;
  size_t start[2], count[2];
 
  const int nxy = ctl->grid_nx * ctl->grid_ny;
  ALLOC(help, double,
        nxy);
 
  /* Create file and dimensions... */
  NC(nc_create(filename, NC_NETCDF4, &ncid));
  NC(nc_def_dim(ncid, "time", 1, &dimid[0]));
  NC(nc_def_dim(ncid, "lat", (size_t) ctl->grid_ny, &dimid[1]));
  NC(nc_def_dim(ncid, "lon", (size_t) ctl->grid_nx, &dimid[2]));
 
  /* Define variables... */
  NC_DEF_VAR("time", NC_DOUBLE, 1, &dimid[0], "time",
             "seconds since 2000-01-01 00:00:00 UTC", 0, 0);
  NC_DEF_VAR("lat", NC_DOUBLE, 1, &dimid[1], "latitude",
             "degrees_north", 0, 0);
  NC_DEF_VAR("lon", NC_DOUBLE, 1, &dimid[2], "longitude",
             "degrees_east", 0, 0);
  NC_DEF_VAR("area", NC_DOUBLE, 1, &dimid[1], "surface area", "m**2", 0, 0);
  NC_DEF_VAR("depo_pb210", NC_DOUBLE, 3, dimid,
             "ground inventory of Pb-210", "Bq m**-2", ctl->grid_nc_level, 0);
  NC_DEF_VAR("depo_be7", NC_DOUBLE, 3, dimid,
             "ground inventory of Be-7", "Bq m**-2", ctl->grid_nc_level, 0);
  NC_DEF_VAR("depo_cs137", NC_DOUBLE, 3, dimid,
             "ground inventory of Cs-137", "Bq m**-2", ctl->grid_nc_level, 0);
  NC_DEF_VAR("depo_i131", NC_DOUBLE, 3, dimid,
             "ground inventory of aerosol-bound I-131", "Bq m**-2",
             ctl->grid_nc_level, 0);
  NC(nc_enddef(ncid));
 
  /* Write coordinates... */
  NC_PUT_DOUBLE("time", &t, 0);
  NC_PUT_DOUBLE("lon", lon, 0);
  NC_PUT_DOUBLE("lat", lat, 0);
  NC_PUT_DOUBLE("area", area, 0);
 
  /* Write fields in netCDF dimension order... */
  const char *varname[4] = {
    "depo_pb210", "depo_be7", "depo_cs137", "depo_i131"
  };
  for (int iq = 0; iq < 4; iq++) {
    for (int ix = 0; ix < ctl->grid_nx; ix++)
      for (int iy = 0; iy < ctl->grid_ny; iy++)
        help[ARRAY_2D(iy, ix, ctl->grid_nx)] =
          data[iq * nxy + ARRAY_2D(ix, iy, ctl->grid_ny)];
    NC_PUT_DOUBLE(varname[iq], help, 0);
  }
 
  NC(nc_close(ncid));
  free(help);
}
 
/*****************************************************************************/
 
void write_grid(
  const char *filename,
  const ctl_t *ctl,
  met_t *met0,
  met_t *met1,
  const atm_t *atm,
  const double t) {
 
  if (ctl->met_coord_type != 0)
    ERRMSG("Only lat/lon grid supported");
 
  static double kz[EP], kw[EP];
 
  static int nk;
 
  double *cd, *mean[NQ], *sigma[NQ], *vmr_impl, *z, *lon, *lat, *area, *press;
 
  int *ixs, *iys, *izs, *np;
 
  /* Set timer... */
  SELECT_TIMER("WRITE_GRID", "OUTPUT");
 
  /* Write info... */
  LOG(1, "Write grid data: %s", filename);
 
  /* Init... */
  if (t == ctl->t_start) {
 
    /* Read kernel data... */
    if (ctl->grid_kernel[0] != '-')
      read_kernel(ctl->grid_kernel, kz, kw, &nk);
  }
 
  /* Allocate... */
  ALLOC(cd, double,
        ctl->grid_nx * ctl->grid_ny * ctl->grid_nz);
  for (int iq = 0; iq < ctl->nq; iq++) {
    ALLOC(mean[iq], double,
          ctl->grid_nx * ctl->grid_ny * ctl->grid_nz);
    ALLOC(sigma[iq], double,
          ctl->grid_nx * ctl->grid_ny * ctl->grid_nz);
  }
  ALLOC(vmr_impl, double,
        ctl->grid_nx * ctl->grid_ny * ctl->grid_nz);
  ALLOC(z, double,
        ctl->grid_nz);
  ALLOC(lon, double,
        ctl->grid_nx);
  ALLOC(lat, double,
        ctl->grid_ny);
  ALLOC(area, double,
        ctl->grid_ny);
  ALLOC(press, double,
        ctl->grid_nz);
  ALLOC(np, int,
        ctl->grid_nx * ctl->grid_ny * ctl->grid_nz);
  ALLOC(ixs, int,
        atm->np);
  ALLOC(iys, int,
        atm->np);
  ALLOC(izs, int,
        atm->np);
 
  /* Set grid box size... */
  const double dz = (ctl->grid_z1 - ctl->grid_z0) / ctl->grid_nz;
  const double dlon = (ctl->grid_lon1 - ctl->grid_lon0) / ctl->grid_nx;
  const double dlat = (ctl->grid_lat1 - ctl->grid_lat0) / ctl->grid_ny;
 
  /* Set vertical coordinates... */
#pragma omp parallel for default(shared)
  for (int iz = 0; iz < ctl->grid_nz; iz++) {
    z[iz] = ctl->grid_z0 + dz * (iz + 0.5);
    press[iz] = P(z[iz]);
  }
 
  /* Set horizontal coordinates... */
  for (int ix = 0; ix < ctl->grid_nx; ix++)
    lon[ix] = ctl->grid_lon0 + dlon * (ix + 0.5);
#pragma omp parallel for default(shared)
  for (int iy = 0; iy < ctl->grid_ny; iy++) {
    lat[iy] = ctl->grid_lat0 + dlat * (iy + 0.5);
    area[iy] = dlat * dlon * SQR(RE * M_PI / 180.) * cos(DEG2RAD(lat[iy]));
  }
 
  /* Set time interval for output... */
  const double t0 = t - 0.5 * ctl->dt_mod;
  const double t1 = t + 0.5 * ctl->dt_mod;
 
  /* Get grid box indices... */
#pragma omp parallel for default(shared)
  for (int ip = 0; ip < atm->np; ip++) {
    const double zpart = Z(atm->p[ip]);
    if (atm->time[ip] < t0 || atm->time[ip] > t1
        || atm->lon[ip] < ctl->grid_lon0
        || atm->lon[ip] >= ctl->grid_lon1
        || atm->lat[ip] < ctl->grid_lat0
        || atm->lat[ip] >= ctl->grid_lat1
        || zpart < ctl->grid_z0 || zpart >= ctl->grid_z1) {
      izs[ip] = -1;
      continue;
    }
    ixs[ip] = (int) ((atm->lon[ip] - ctl->grid_lon0) / dlon);
    iys[ip] = (int) ((atm->lat[ip] - ctl->grid_lat0) / dlat);
    izs[ip] = (int) ((zpart - ctl->grid_z0) / dz);
    if (ixs[ip] >= ctl->grid_nx || iys[ip] >= ctl->grid_ny
        || izs[ip] >= ctl->grid_nz)
      izs[ip] = -1;
  }
 
  /* Average data... */
  for (int ip = 0; ip < atm->np; ip++)
    if (izs[ip] >= 0) {
      const int idx =
        ARRAY_3D(ixs[ip], iys[ip], ctl->grid_ny, izs[ip], ctl->grid_nz);
      const double kernel = kernel_weight(kz, kw, nk, atm->p[ip]);
      np[idx]++;
      for (int iq = 0; iq < ctl->nq; iq++) {
        mean[iq][idx] += kernel * atm->q[iq][ip];
        sigma[iq][idx] += SQR(kernel * atm->q[iq][ip]);
      }
    }
 
  /* Calculate column density and volume mixing ratio... */
#pragma omp parallel for default(shared)
  for (int ix = 0; ix < ctl->grid_nx; ix++)
    for (int iy = 0; iy < ctl->grid_ny; iy++)
      for (int iz = 0; iz < ctl->grid_nz; iz++) {
 
        /* Get grid index... */
        const int idx = ARRAY_3D(ix, iy, ctl->grid_ny, iz, ctl->grid_nz);
 
        /* Calculate column density... */
        cd[idx] = NAN;
        if (ctl->qnt_m >= 0)
          cd[idx] = mean[ctl->qnt_m][idx] / (1e6 * area[iy]);
 
        /* Calculate volume mixing ratio (implicit)... */
        vmr_impl[idx] = NAN;
        if (ctl->qnt_m >= 0 && ctl->molmass > 0 && met0 != NULL
            && met1 != NULL) {
          vmr_impl[idx] = 0;
          if (mean[ctl->qnt_m][idx] > 0) {
 
            /* Get temperature... */
            double temp;
            INTPOL_INIT;
            intpol_met_time_3d(met0, met0->t, met1, met1->t, t, press[iz],
                               lon[ix], lat[iy], &temp, ci, cw, 1);
 
            /* Calculate volume mixing ratio... */
            vmr_impl[idx] =
              MA / ctl->molmass * cd[idx] / (RHO(press[iz], temp) * dz * 1e3);
          }
        }
 
        /* Calculate mean... */
        if (np[idx] > 0)
          for (int iq = 0; iq < ctl->nq; iq++) {
            mean[iq][idx] /= np[idx];
            const double var = sigma[iq][idx] / np[idx] - SQR(mean[iq][idx]);
            sigma[iq][idx] = (var > 0 ? sqrt(var) : 0);
        } else
          for (int iq = 0; iq < ctl->nq; iq++) {
            mean[iq][idx] = NAN;
            sigma[iq][idx] = NAN;
          }
      }
 
  /* Write ASCII data... */
  if (ctl->grid_type == 0)
    write_grid_asc(filename, ctl, cd, mean, sigma, vmr_impl,
                   t, z, lon, lat, area, dz, np);
 
  /* Write netCDF data... */
  else if (ctl->grid_type == 1)
    write_grid_nc(filename, ctl, cd, mean, sigma, vmr_impl,
                  t, z, lon, lat, area, dz, np);
 
  /* Error message... */
  else
    ERRMSG("Grid data format GRID_TYPE unknown!");
 
  /* Free... */
  free(cd);
  for (int iq = 0; iq < ctl->nq; iq++) {
    free(mean[iq]);
    free(sigma[iq]);
  }
  free(vmr_impl);
  free(z);
  free(lon);
  free(lat);
  free(area);
  free(press);
  free(np);
  free(ixs);
  free(iys);
  free(izs);
}
 
/*****************************************************************************/
 
void write_grid_asc(
  const char *filename,
  const ctl_t *ctl,
  const double *cd,
  double *mean[NQ],
  double *sigma[NQ],
  const double *vmr_impl,
  const double t,
  const double *z,
  const double *lon,
  const double *lat,
  const double *area,
  const double dz,
  const int *np) {
 
  FILE *out;
 
  /* Check if gnuplot output is requested... */
  if (ctl->grid_gpfile[0] != '-') {
 
    /* Create gnuplot pipe... */
    if (!(out = popen("gnuplot", "w")))
      ERRMSG("Cannot create pipe to gnuplot!");
 
    /* Set plot filename... */
    fprintf(out, "set out \"%s.png\"\n", filename);
 
    /* Set time string... */
    double r;
    int year, mon, day, hour, min, sec;
    jsec2time(t, &year, &mon, &day, &hour, &min, &sec, &r);
    fprintf(out, "timestr=\"%d-%02d-%02d, %02d:%02d UTC\"\n",
            year, mon, day, hour, min);
 
    /* Dump gnuplot file to pipe... */
    FILE *in;
    char line[LEN];
    if (!(in = fopen(ctl->grid_gpfile, "r")))
      ERRMSG("Cannot open file!");
    while (fgets(line, LEN, in))
      fprintf(out, "%s", line);
    fclose(in);
  }
 
  else {
 
    /* Create file... */
    if (!(out = fopen(filename, "w")))
      ERRMSG("Cannot create file!");
  }
 
  /* Write header... */
  fprintf(out,
          "# $1 = time [s]\n"
          "# $2 = altitude [km]\n"
          "# $3 = longitude [deg]\n"
          "# $4 = latitude [deg]\n"
          "# $5 = surface area [km^2]\n"
          "# $6 = layer depth [km]\n"
          "# $7 = column density (implicit) [kg/m^2]\n"
          "# $8 = volume mixing ratio (implicit) [ppv]\n"
          "# $9 = number of particles [1]\n");
  for (int iq = 0; iq < ctl->nq; iq++)
    fprintf(out, "# $%i = %s (mean) [%s]\n", 10 + iq, ctl->qnt_name[iq],
            ctl->qnt_unit[iq]);
  if (ctl->grid_stddev)
    for (int iq = 0; iq < ctl->nq; iq++)
      fprintf(out, "# $%i = %s (stddev) [%s]\n", 10 + ctl->nq + iq,
              ctl->qnt_name[iq], ctl->qnt_unit[iq]);
  fprintf(out, "\n");
 
  /* Write data... */
  for (int ix = 0; ix < ctl->grid_nx; ix++) {
    if (ix > 0 && ctl->grid_ny > 1 && !ctl->grid_sparse)
      fprintf(out, "\n");
    for (int iy = 0; iy < ctl->grid_ny; iy++) {
      if (iy > 0 && ctl->grid_nz > 1 && !ctl->grid_sparse)
        fprintf(out, "\n");
      for (int iz = 0; iz < ctl->grid_nz; iz++) {
        int idx = ARRAY_3D(ix, iy, ctl->grid_ny, iz, ctl->grid_nz);
        if (!ctl->grid_sparse || vmr_impl[idx] > 0) {
          fprintf(out, "%.2f %g %g %g %g %g %g %g %d", t, z[iz], lon[ix],
                  lat[iy], area[iy], dz, cd[idx], vmr_impl[idx], np[idx]);
          for (int iq = 0; iq < ctl->nq; iq++) {
            fprintf(out, " ");
            fprintf(out, ctl->qnt_format[iq], mean[iq][idx]);
          }
          if (ctl->grid_stddev)
            for (int iq = 0; iq < ctl->nq; iq++) {
              fprintf(out, " ");
              fprintf(out, ctl->qnt_format[iq], sigma[iq][idx]);
            }
          fprintf(out, "\n");
        }
      }
    }
  }
 
  /* Close file... */
  fclose(out);
}
 
/*****************************************************************************/
 
void write_grid_nc(
  const char *filename,
  const ctl_t *ctl,
  const double *cd,
  double *mean[NQ],
  double *sigma[NQ],
  const double *vmr_impl,
  const double t,
  const double *z,
  const double *lon,
  const double *lat,
  const double *area,
  const double dz,
  const int *np) {
 
  char longname[2 * LEN], varname[2 * LEN];
 
  double *help;
 
  int *help2, ncid, dimid[10], varid;
 
  size_t start[2], count[2];
 
  /* Allocate... */
  ALLOC(help, double,
        ctl->grid_nx * ctl->grid_ny * ctl->grid_nz);
  ALLOC(help2, int,
        ctl->grid_nx * ctl->grid_ny * ctl->grid_nz);
 
  /* Create file... */
  NC(nc_create(filename, NC_NETCDF4, &ncid));
 
  /* Define dimensions... */
  NC(nc_def_dim(ncid, "time", 1, &dimid[0]));
  NC(nc_def_dim(ncid, "z", (size_t) ctl->grid_nz, &dimid[1]));
  NC(nc_def_dim(ncid, "lat", (size_t) ctl->grid_ny, &dimid[2]));
  NC(nc_def_dim(ncid, "lon", (size_t) ctl->grid_nx, &dimid[3]));
  NC(nc_def_dim(ncid, "dz", 1, &dimid[4]));
 
  /* Define variables and their attributes... */
  NC_DEF_VAR("time", NC_DOUBLE, 1, &dimid[0], "time",
             "seconds since 2000-01-01 00:00:00 UTC", 0, 0);
  NC_DEF_VAR("z", NC_DOUBLE, 1, &dimid[1], "altitude", "km", 0, 0);
  NC_DEF_VAR("lat", NC_DOUBLE, 1, &dimid[2], "latitude", "degrees_north", 0,
             0);
  NC_DEF_VAR("lon", NC_DOUBLE, 1, &dimid[3], "longitude", "degrees_east", 0,
             0);
  NC_DEF_VAR("dz", NC_DOUBLE, 1, &dimid[1], "layer depth", "km", 0, 0);
  NC_DEF_VAR("area", NC_DOUBLE, 1, &dimid[2], "surface area", "km**2", 0, 0);
 
  NC_DEF_VAR("cd", NC_FLOAT, 4, dimid, "column density", "kg m**-2",
             ctl->grid_nc_level, 0);
  NC_DEF_VAR("vmr_impl", NC_FLOAT, 4, dimid,
             "volume mixing ratio (implicit)", "ppv", ctl->grid_nc_level, 0);
  NC_DEF_VAR("np", NC_INT, 4, dimid, "number of particles", "1", 0, 0);
  for (int iq = 0; iq < ctl->nq; iq++) {
    sprintf(varname, "%s_mean", ctl->qnt_name[iq]);
    sprintf(longname, "%s (mean)", ctl->qnt_longname[iq]);
    NC_DEF_VAR(varname, NC_DOUBLE, 4, dimid, longname, ctl->qnt_unit[iq],
               ctl->grid_nc_level, ctl->grid_nc_quant[iq]);
    if (ctl->grid_stddev) {
      sprintf(varname, "%s_stddev", ctl->qnt_name[iq]);
      sprintf(longname, "%s (stddev)", ctl->qnt_longname[iq]);
      NC_DEF_VAR(varname, NC_DOUBLE, 4, dimid, longname, ctl->qnt_unit[iq],
                 ctl->grid_nc_level, ctl->grid_nc_quant[iq]);
    }
  }
  /* End definitions... */
  NC(nc_enddef(ncid));
 
  /* Write data... */
  NC_PUT_DOUBLE("time", &t, 0);
  NC_PUT_DOUBLE("lon", lon, 0);
  NC_PUT_DOUBLE("lat", lat, 0);
  NC_PUT_DOUBLE("z", z, 0);
  NC_PUT_DOUBLE("area", area, 0);
  NC_PUT_DOUBLE("dz", &dz, 0);
 
  for (int ix = 0; ix < ctl->grid_nx; ix++)
    for (int iy = 0; iy < ctl->grid_ny; iy++)
      for (int iz = 0; iz < ctl->grid_nz; iz++)
        help[ARRAY_3D(iz, iy, ctl->grid_ny, ix, ctl->grid_nx)] =
          cd[ARRAY_3D(ix, iy, ctl->grid_ny, iz, ctl->grid_nz)];
  NC_PUT_DOUBLE("cd", help, 0);
 
  for (int ix = 0; ix < ctl->grid_nx; ix++)
    for (int iy = 0; iy < ctl->grid_ny; iy++)
      for (int iz = 0; iz < ctl->grid_nz; iz++)
        help[ARRAY_3D(iz, iy, ctl->grid_ny, ix, ctl->grid_nx)] =
          vmr_impl[ARRAY_3D(ix, iy, ctl->grid_ny, iz, ctl->grid_nz)];
  NC_PUT_DOUBLE("vmr_impl", help, 0);
 
  for (int ix = 0; ix < ctl->grid_nx; ix++)
    for (int iy = 0; iy < ctl->grid_ny; iy++)
      for (int iz = 0; iz < ctl->grid_nz; iz++)
        help2[ARRAY_3D(iz, iy, ctl->grid_ny, ix, ctl->grid_nx)] =
          np[ARRAY_3D(ix, iy, ctl->grid_ny, iz, ctl->grid_nz)];
  NC_PUT_INT("np", help2, 0);
 
  for (int iq = 0; iq < ctl->nq; iq++) {
    sprintf(varname, "%s_mean", ctl->qnt_name[iq]);
    for (int ix = 0; ix < ctl->grid_nx; ix++)
      for (int iy = 0; iy < ctl->grid_ny; iy++)
        for (int iz = 0; iz < ctl->grid_nz; iz++)
          help[ARRAY_3D(iz, iy, ctl->grid_ny, ix, ctl->grid_nx)] =
            mean[iq][ARRAY_3D(ix, iy, ctl->grid_ny, iz, ctl->grid_nz)];
    NC_PUT_DOUBLE(varname, help, 0);
  }
 
  if (ctl->grid_stddev)
    for (int iq = 0; iq < ctl->nq; iq++) {
      sprintf(varname, "%s_stddev", ctl->qnt_name[iq]);
      for (int ix = 0; ix < ctl->grid_nx; ix++)
        for (int iy = 0; iy < ctl->grid_ny; iy++)
          for (int iz = 0; iz < ctl->grid_nz; iz++)
            help[ARRAY_3D(iz, iy, ctl->grid_ny, ix, ctl->grid_nx)] =
              sigma[iq][ARRAY_3D(ix, iy, ctl->grid_ny, iz, ctl->grid_nz)];
      NC_PUT_DOUBLE(varname, help, 0);
    }
 
  /* Close file... */
  NC(nc_close(ncid));
 
  /* Free... */
  free(help);
  free(help2);
}
 
/*****************************************************************************/
 
void write_met_bin(
  const char *filename,
  const ctl_t *ctl,
  met_t *met) {
 
  /* Create file... */
  FILE *out, *level_log = NULL;
  if (!(out = fopen(filename, "w")))
    ERRMSG("Cannot create file!");
 
  /* Create diagnostics file... */
  if (strcmp(ctl->met_comp_logfile, "-") != 0) {
 
    if (!(level_log = fopen(ctl->met_comp_logfile, "w")))
      ERRMSG("Cannot create compression log file!");
    LOG(1, "Write compression diagnostics: %s", ctl->met_comp_logfile);
 
    /* Write header... */
    fprintf(level_log,
            "# $1 = compression codec name [-]\n"
            "# $2 = variable name [-]\n"
            "# $3 = level index [-]\n"
            "# $4 = pressure level [hPa]\n"
            "# $5 = compression ratio [-]\n"
            "# $6 = bits per value [bit/value]\n"
            "# $7 = correlation coefficient [-]\n"
            "# $8 = mean compression error [-]\n"
            "# $9 = standard deviation of compression error [-]\n"
            "# $10 = minimum compression error [-]\n"
            "# $11 = maximum compression error [-]\n"
            "# $12 = mean value of original field [-]\n"
            "# $13 = value range of original field [-]\n"
            "# $14 = normalized root mean square error [-]\n"
            "# $15 = compression time [s]\n"
            "# $16 = compression speed [MiB/s]\n"
            "# $17 = decompression time [s]\n"
            "# $18 = decompression speed [MiB/s]\n\n");
  }
 
  /* Write type of binary data... */
  FWRITE(&ctl->met_type, int,
         1,
         out);
 
  /* Write version of binary data... */
  int version = 104;
  FWRITE(&version, int,
         1,
         out);
 
  /* Write grid data... */
  FWRITE(&met->time, double,
         1,
         out);
  FWRITE(&met->nx, int,
         1,
         out);
  FWRITE(&met->ny, int,
         1,
         out);
  FWRITE(&met->np, int,
         1,
         out);
  FWRITE(met->lon, double,
           (size_t) met->nx,
         out);
  FWRITE(met->lat, double,
           (size_t) met->ny,
         out);
  FWRITE(met->p, double,
           (size_t) met->np,
         out);
 
  /* Write surface data... */
  write_met_bin_2d(out, met, met->ps, "PS");
  write_met_bin_2d(out, met, met->ts, "TS");
  write_met_bin_2d(out, met, met->zs, "ZS");
  write_met_bin_2d(out, met, met->us, "US");
  write_met_bin_2d(out, met, met->vs, "VS");
  write_met_bin_2d(out, met, met->ess, "ESS");
  write_met_bin_2d(out, met, met->nss, "NSS");
  write_met_bin_2d(out, met, met->shf, "SHF");
  write_met_bin_2d(out, met, met->lsm, "LSM");
  write_met_bin_2d(out, met, met->sst, "SST");
  write_met_bin_2d(out, met, met->pbl, "PBL");
  write_met_bin_2d(out, met, met->pt, "PT");
  write_met_bin_2d(out, met, met->tt, "TT");
  write_met_bin_2d(out, met, met->zt, "ZT");
  write_met_bin_2d(out, met, met->h2ot, "H2OT");
  write_met_bin_2d(out, met, met->pct, "PCT");
  write_met_bin_2d(out, met, met->pcb, "PCB");
  write_met_bin_2d(out, met, met->cl, "CL");
  write_met_bin_2d(out, met, met->plcl, "PLCL");
  write_met_bin_2d(out, met, met->plfc, "PLFC");
  write_met_bin_2d(out, met, met->pel, "PEL");
  write_met_bin_2d(out, met, met->cape, "CAPE");
  write_met_bin_2d(out, met, met->cin, "CIN");
  write_met_bin_2d(out, met, met->o3c, "O3C");
 
  /* Write level data... */
  write_met_bin_3d(out, ctl, met, met->z, "Z", 0, level_log);
  write_met_bin_3d(out, ctl, met, met->t, "T", 1, level_log);
  write_met_bin_3d(out, ctl, met, met->u, "U", 2, level_log);
  write_met_bin_3d(out, ctl, met, met->v, "V", 3, level_log);
  write_met_bin_3d(out, ctl, met, met->w, "W", 4, level_log);
  write_met_bin_3d(out, ctl, met, met->pv, "PV", 5, level_log);
  write_met_bin_3d(out, ctl, met, met->h2o, "H2O", 6, level_log);
  write_met_bin_3d(out, ctl, met, met->o3, "O3", 7, level_log);
  write_met_bin_3d(out, ctl, met, met->lwc, "LWC", 8, level_log);
  write_met_bin_3d(out, ctl, met, met->rwc, "RWC", 9, level_log);
  write_met_bin_3d(out, ctl, met, met->iwc, "IWC", 10, level_log);
  write_met_bin_3d(out, ctl, met, met->swc, "SWC", 11, level_log);
  write_met_bin_3d(out, ctl, met, met->cc, "CC", 12, level_log);
  if (METVAR != 13)
    ERRMSG("Number of meteo variables doesn't match!");
 
  /* Write final flag... */
  int final = 999;
  FWRITE(&final, int,
         1,
         out);
 
  /* Close file... */
  if (level_log)
    fclose(level_log);
  fclose(out);
}
 
/*****************************************************************************/
 
void write_met_bin_2d(
  FILE *out,
  met_t *met,
  float var[EX][EY],
  const char *varname) {
 
  float *help;
 
  /* Allocate... */
  ALLOC(help, float,
        EX * EY);
 
  /* Copy data... */
  for (int ix = 0; ix < met->nx; ix++)
    for (int iy = 0; iy < met->ny; iy++)
      help[ARRAY_2D(ix, iy, met->ny)] = var[ix][iy];
 
  /* Write uncompressed data... */
  LOG(2, "Write 2-D variable: %s (uncompressed)", varname);
  FWRITE(help, float,
           (size_t) (met->nx * met->ny),
         out);
 
  /* Free... */
  free(help);
}
 
/*****************************************************************************/
 
void write_met_bin_3d(
  FILE *out,
  const ctl_t *ctl,
  met_t *met,
  float var[EX][EY][EP],
  const char *varname,
  const int metvar,
  FILE *level_log) {
 
  float *help;
 
  /* Allocate... */
  ALLOC(help, float,
        EX * EY * EP);
 
  /* Copy data... */
#pragma omp parallel for default(shared) collapse(2)
  for (int ix = 0; ix < met->nx; ix++)
    for (int iy = 0; iy < met->ny; iy++)
      for (int ip = 0; ip < met->np; ip++)
        help[ARRAY_3D(ix, iy, met->ny, ip, met->np)] = var[ix][iy][ip];
 
  /* Write uncompressed data... */
  if (ctl->met_type == 1) {
    LOG(2, "Write 3-D variable: %s (uncompressed)", varname);
    FWRITE(help, float,
             (size_t) (met->nx * met->ny * met->np),
           out);
  }
 
  /* Write packed data... */
  else if (ctl->met_type == 2)
    compress_pck(ctl, met, varname, help, 0, level_log, out);
 
  /* Write ZFP data... */
#ifdef ZFP
  else if (ctl->met_type == 3) {
    FWRITE(&ctl->met_zfp_prec[metvar], int,
           1,
           out);
    FWRITE(&ctl->met_zfp_tol[metvar], double,
           1,
           out);
    compress_zfp(ctl, met, varname, help, 0, level_log, out);
  }
#endif
 
  /* Write zstd data... */
#ifdef ZSTD
  else if (ctl->met_type == 4)
    compress_zstd(ctl, met, varname, help, 0, level_log, out);
#endif
 
  /* Write LZ4 data... */
#ifdef LZ4
  else if (ctl->met_type == 8)
    compress_lz4(ctl, met, varname, help, 0, level_log, out);
#endif
 
  /* Write cmultiscale data... */
#ifdef CMS
  else if (ctl->met_type == 5) {
    compress_cms(ctl, met, varname, help, 0, level_log, out);
  }
#endif
 
  /* Write SZ3 data... */
#ifdef SZ3
  else if (ctl->met_type == 7) {
    FWRITE(&ctl->met_sz3_prec[metvar], int,
           1,
           out);
    FWRITE(&ctl->met_sz3_tol[metvar], double,
           1,
           out);
    compress_sz3(ctl, met, varname, help, 0, level_log, out);
  }
#endif
 
  /* Unknown method... */
  else {
    ERRMSG("MET_TYPE not supported!");
 
    /* This will never execute, hack to avoid compilation error... */
    LOG(3, "%d", metvar);
  }
 
  /* Free... */
  free(help);
}
 
/*****************************************************************************/
 
void write_met_nc(
  const char *filename,
  const ctl_t *ctl,
  met_t *met) {
 
  /* Create file... */
  int ncid, varid;
  size_t start[4], count[4];
  NC(nc_create(filename, NC_NETCDF4, &ncid));
 
  /* Define dimensions... */
  int tid, lonid, latid, levid;
  NC(nc_def_dim(ncid, "time", 1, &tid));
 
  if (met->coord_type == 0) {
    NC(nc_def_dim(ncid, "lon", (size_t) met->nx, &lonid));
    NC(nc_def_dim(ncid, "lat", (size_t) met->ny, &latid));
    NC_DEF_VAR("lon", NC_DOUBLE, 1, &lonid, "longitude", "degrees_east", 0,
               0);
    NC_DEF_VAR("lat", NC_DOUBLE, 1, &latid, "latitude", "degrees_north", 0,
               0);
  } else {
    NC(nc_def_dim(ncid, "x", (size_t) met->nx, &lonid));
    NC(nc_def_dim(ncid, "y", (size_t) met->ny, &latid));
    NC_DEF_VAR("x", NC_DOUBLE, 1, &lonid, "x", "easting", 0, 0);
    NC_DEF_VAR("y", NC_DOUBLE, 1, &latid, "y", "northing", 0, 0);
  }
 
  NC(nc_def_dim(ncid, "lev", (size_t) met->np, &levid));
 
  /* Define grid... */
  NC_DEF_VAR("time", NC_DOUBLE, 1, &tid, "time",
             "seconds since 2000-01-01 00:00:00 UTC", 0, 0);
  NC_DEF_VAR("lev", NC_DOUBLE, 1, &levid, "pressure", "Pa", 0, 0);
 
  /* Define surface variables... */
  int dimid2[3] = { tid, latid, lonid };
  NC_DEF_VAR("sp", NC_FLOAT, 3, dimid2, "Surface pressure", "Pa",
             ctl->met_nc_level, 0);
  NC_DEF_VAR("z", NC_FLOAT, 3, dimid2, "Geopotential", "m**2 s**-2",
             ctl->met_nc_level, 0);
  NC_DEF_VAR("t2m", NC_FLOAT, 3, dimid2, "2 metre temperature", "K",
             ctl->met_nc_level, 0);
  NC_DEF_VAR("u10m", NC_FLOAT, 3, dimid2, "10 metre U wind component",
             "m s**-1", ctl->met_nc_level, 0);
  NC_DEF_VAR("v10m", NC_FLOAT, 3, dimid2, "10 metre V wind component",
             "m s**-1", ctl->met_nc_level, 0);
  NC_DEF_VAR("iews", NC_FLOAT, 3, dimid2,
             "Instantaneous eastward turbulent surface stress", "N m**-2",
             ctl->met_nc_level, 0);
  NC_DEF_VAR("inss", NC_FLOAT, 3, dimid2,
             "Instantaneous northward turbulent surface stress", "N m**-2",
             ctl->met_nc_level, 0);
  NC_DEF_VAR("ishf", NC_FLOAT, 3, dimid2,
             "Instantaneous surface sensible heat flux", "W m**-2",
             ctl->met_nc_level, 0);
  NC_DEF_VAR("lsm", NC_FLOAT, 3, dimid2, "Land/sea mask", "-",
             ctl->met_nc_level, 0);
  NC_DEF_VAR("sstk", NC_FLOAT, 3, dimid2, "Sea surface temperature", "K",
             ctl->met_nc_level, 0);
  NC_DEF_VAR("blp", NC_FLOAT, 3, dimid2, "Boundary layer pressure", "Pa",
             ctl->met_nc_level, 0);
  NC_DEF_VAR("pt", NC_FLOAT, 3, dimid2, "Tropopause pressure", "Pa",
             ctl->met_nc_level, 0);
  NC_DEF_VAR("tt", NC_FLOAT, 3, dimid2, "Tropopause temperature", "K",
             ctl->met_nc_level, 0);
  NC_DEF_VAR("zt", NC_FLOAT, 3, dimid2, "Tropopause height", "m",
             ctl->met_nc_level, 0);
  NC_DEF_VAR("h2ot", NC_FLOAT, 3, dimid2, "Tropopause water vapor", "ppv",
             ctl->met_nc_level, 0);
  NC_DEF_VAR("pct", NC_FLOAT, 3, dimid2, "Cloud top pressure", "Pa",
             ctl->met_nc_level, 0);
  NC_DEF_VAR("pcb", NC_FLOAT, 3, dimid2, "Cloud bottom pressure", "Pa",
             ctl->met_nc_level, 0);
  NC_DEF_VAR("cl", NC_FLOAT, 3, dimid2, "Total column cloud water",
             "kg m**2", ctl->met_nc_level, 0);
  NC_DEF_VAR("plcl", NC_FLOAT, 3, dimid2,
             "Pressure at lifted condensation level (LCL)", "Pa",
             ctl->met_nc_level, 0);
  NC_DEF_VAR("plfc", NC_FLOAT, 3, dimid2,
             "Pressure at level of free convection (LFC)", "Pa",
             ctl->met_nc_level, 0);
  NC_DEF_VAR("pel", NC_FLOAT, 3, dimid2,
             "Pressure at equilibrium level (EL)", "Pa", ctl->met_nc_level,
             0);
  NC_DEF_VAR("cape", NC_FLOAT, 3, dimid2,
             "Convective available potential energy", "J kg**-1",
             ctl->met_nc_level, 0);
  NC_DEF_VAR("cin", NC_FLOAT, 3, dimid2, "Convective inhibition",
             "J kg**-1", ctl->met_nc_level, 0);
  NC_DEF_VAR("o3c", NC_FLOAT, 3, dimid2, "Total column ozone", "DU",
             ctl->met_nc_level, 0);
 
  /* Define level data... */
  int dimid3[4] = { tid, levid, latid, lonid };
  NC_DEF_VAR("t", NC_FLOAT, 4, dimid3, "Temperature", "K",
             ctl->met_nc_level, ctl->met_nc_quant);
  NC_DEF_VAR("u", NC_FLOAT, 4, dimid3, "U velocity", "m s**-1",
             ctl->met_nc_level, ctl->met_nc_quant);
  NC_DEF_VAR("v", NC_FLOAT, 4, dimid3, "V velocity", "m s**-1",
             ctl->met_nc_level, ctl->met_nc_quant);
  NC_DEF_VAR("w", NC_FLOAT, 4, dimid3, "Vertical velocity", "Pa s**-1",
             ctl->met_nc_level, ctl->met_nc_quant);
  NC_DEF_VAR("q", NC_FLOAT, 4, dimid3, "Specific humidity", "kg kg**-1",
             ctl->met_nc_level, ctl->met_nc_quant);
  NC_DEF_VAR("o3", NC_FLOAT, 4, dimid3, "Ozone mass mixing ratio",
             "kg kg**-1", ctl->met_nc_level, ctl->met_nc_quant);
  NC_DEF_VAR("clwc", NC_FLOAT, 4, dimid3, "Cloud liquid water content",
             "kg kg**-1", ctl->met_nc_level, ctl->met_nc_quant);
  NC_DEF_VAR("crwc", NC_FLOAT, 4, dimid3, "Cloud rain water content",
             "kg kg**-1", ctl->met_nc_level, ctl->met_nc_quant);
  NC_DEF_VAR("ciwc", NC_FLOAT, 4, dimid3, "Cloud ice water content",
             "kg kg**-1", ctl->met_nc_level, ctl->met_nc_quant);
  NC_DEF_VAR("cswc", NC_FLOAT, 4, dimid3, "Cloud snow water content",
             "kg kg**-1", ctl->met_nc_level, ctl->met_nc_quant);
  NC_DEF_VAR("cc", NC_FLOAT, 4, dimid3, "Cloud cover", "-",
             ctl->met_nc_level, ctl->met_nc_quant);
 
  /* End definitions... */
  NC(nc_enddef(ncid));
 
  /* Write grid data... */
  NC_PUT_DOUBLE("time", &met->time, 0);
 
  if (met->coord_type == 0) {
    NC_PUT_DOUBLE("lon", met->lon, 0);
    NC_PUT_DOUBLE("lat", met->lat, 0);
  } else {
    NC_PUT_DOUBLE("x", met->lon, 0);
    NC_PUT_DOUBLE("y", met->lat, 0);
  }
 
  double phelp[EP];
  for (int ip = 0; ip < met->np; ip++)
    phelp[ip] = 100. * met->p[ip];
  NC_PUT_DOUBLE("lev", phelp, 0);
 
  /* Write surface data... */
  write_met_nc_2d(ncid, "sp", met, met->ps, 100.0f);
  write_met_nc_2d(ncid, "z", met, met->zs, (float) (1000. * G0));
  write_met_nc_2d(ncid, "t2m", met, met->ts, 1.0f);
  write_met_nc_2d(ncid, "u10m", met, met->us, 1.0f);
  write_met_nc_2d(ncid, "v10m", met, met->vs, 1.0f);
  write_met_nc_2d(ncid, "iews", met, met->ess, 1.0f);
  write_met_nc_2d(ncid, "inss", met, met->nss, 1.0f);
  write_met_nc_2d(ncid, "ishf", met, met->shf, 1.0f);
  write_met_nc_2d(ncid, "lsm", met, met->lsm, 1.0f);
  write_met_nc_2d(ncid, "sstk", met, met->sst, 1.0f);
  write_met_nc_2d(ncid, "blp", met, met->pbl, 100.0f);
  write_met_nc_2d(ncid, "pt", met, met->pt, 100.0f);
  write_met_nc_2d(ncid, "tt", met, met->tt, 1.0f);
  write_met_nc_2d(ncid, "zt", met, met->zt, 1000.0f);
  write_met_nc_2d(ncid, "h2ot", met, met->h2ot, 1.0f);
  write_met_nc_2d(ncid, "pct", met, met->pct, 100.0f);
  write_met_nc_2d(ncid, "pcb", met, met->pcb, 100.0f);
  write_met_nc_2d(ncid, "cl", met, met->cl, 1.0f);
  write_met_nc_2d(ncid, "plcl", met, met->plcl, 100.0f);
  write_met_nc_2d(ncid, "plfc", met, met->plfc, 100.0f);
  write_met_nc_2d(ncid, "pel", met, met->pel, 100.0f);
  write_met_nc_2d(ncid, "cape", met, met->cape, 1.0f);
  write_met_nc_2d(ncid, "cin", met, met->cin, 1.0f);
  write_met_nc_2d(ncid, "o3c", met, met->o3c, 1.0f);
 
  /* Write level data... */
  write_met_nc_3d(ncid, "t", met, met->t, 1.0f);
  write_met_nc_3d(ncid, "u", met, met->u, 1.0f);
  write_met_nc_3d(ncid, "v", met, met->v, 1.0f);
  write_met_nc_3d(ncid, "w", met, met->w, 100.0f);
  write_met_nc_3d(ncid, "q", met, met->h2o, (float) (MH2O / MA));
  write_met_nc_3d(ncid, "o3", met, met->o3, (float) (MO3 / MA));
  write_met_nc_3d(ncid, "clwc", met, met->lwc, 1.0f);
  write_met_nc_3d(ncid, "crwc", met, met->rwc, 1.0f);
  write_met_nc_3d(ncid, "ciwc", met, met->iwc, 1.0f);
  write_met_nc_3d(ncid, "cswc", met, met->swc, 1.0f);
  write_met_nc_3d(ncid, "cc", met, met->cc, 1.0f);
 
  /* Close file... */
  NC(nc_close(ncid));
}
 
/*****************************************************************************/
 
void write_met_nc_2d(
  const int ncid,
  const char *varname,
  met_t *met,
  float var[EX][EY],
  const float scl) {
 
  int varid;
  size_t start[4], count[4];
 
  /* Allocate... */
  float *help;
  ALLOC(help, float,
        EX * EY);
 
  /* Copy data... */
  for (int ix = 0; ix < met->nx; ix++)
    for (int iy = 0; iy < met->ny; iy++)
      help[ARRAY_2D(iy, ix, met->nx)] = scl * var[ix][iy];
 
  /* Write data... */
  LOG(2, "Write 2-D variable: %s (netCDF)", varname);
  NC_PUT_FLOAT(varname, help, 0);
 
  /* Free... */
  free(help);
}
 
/*****************************************************************************/
 
void write_met_nc_3d(
  const int ncid,
  const char *varname,
  met_t *met,
  float var[EX][EY][EP],
  const float scl) {
 
  int varid;
  size_t start[4], count[4];
 
  /* Allocate... */
  float *help;
  ALLOC(help, float,
        EX * EY * EP);
 
  /* Copy data... */
  for (int ix = 0; ix < met->nx; ix++)
    for (int iy = 0; iy < met->ny; iy++)
      for (int ip = 0; ip < met->np; ip++)
        help[ARRAY_3D(ip, iy, met->ny, ix, met->nx)] = scl * var[ix][iy][ip];
 
  /* Write data... */
  LOG(2, "Write 3-D variable: %s (netCDF)", varname);
  NC_PUT_FLOAT(varname, help, 0);
 
  /* Free... */
  free(help);
}
 
/*****************************************************************************/
 
void write_prof(
  const char *filename,
  const ctl_t *ctl,
  met_t *met0,
  met_t *met1,
  const atm_t *atm,
  const double t) {
 
  if (ctl->met_coord_type != 0)
    ERRMSG("Only lat/lon grid supported");
 
  static FILE *out;
 
  static double *mass, *obsmean, *rt, *rz, *rlon, *rlat, *robs, *area,
    dz, dlon, dlat, *lon, *lat, *z, *press, temp, vmr, h2o, o3;
 
  static int nobs, *obscount, ip, okay;
 
  /* Set timer... */
  SELECT_TIMER("WRITE_PROF", "OUTPUT");
 
  /* Init... */
  if (t == ctl->t_start) {
 
    /* Check quantity index for mass... */
    if (ctl->qnt_m < 0)
      ERRMSG("Need quantity mass!");
 
    /* Check molar mass... */
    if (ctl->molmass <= 0)
      ERRMSG("Specify molar mass!");
 
    /* Allocate... */
    ALLOC(lon, double,
          ctl->prof_nx);
    ALLOC(lat, double,
          ctl->prof_ny);
    ALLOC(area, double,
          ctl->prof_ny);
    ALLOC(z, double,
          ctl->prof_nz);
    ALLOC(press, double,
          ctl->prof_nz);
    ALLOC(rt, double,
          NOBS);
    ALLOC(rz, double,
          NOBS);
    ALLOC(rlon, double,
          NOBS);
    ALLOC(rlat, double,
          NOBS);
    ALLOC(robs, double,
          NOBS);
 
    /* Read observation data... */
    read_obs(ctl->prof_obsfile, ctl, rt, rz, rlon, rlat, robs, &nobs);
 
    /* Create new output file... */
    LOG(1, "Write profile data: %s", filename);
    if (!(out = fopen(filename, "w")))
      ERRMSG("Cannot create file!");
 
    /* Write header... */
    fprintf(out,
            "# $1 = time [s]\n"
            "# $2 = altitude [km]\n"
            "# $3 = longitude [deg]\n"
            "# $4 = latitude [deg]\n"
            "# $5 = pressure [hPa]\n"
            "# $6 = temperature [K]\n"
            "# $7 = volume mixing ratio [ppv]\n"
            "# $8 = H2O volume mixing ratio [ppv]\n"
            "# $9 = O3 volume mixing ratio [ppv]\n"
            "# $10 = observed BT index [K]\n"
            "# $11 = number of observations\n");
 
    /* Set grid box size... */
    dz = (ctl->prof_z1 - ctl->prof_z0) / ctl->prof_nz;
    dlon = (ctl->prof_lon1 - ctl->prof_lon0) / ctl->prof_nx;
    dlat = (ctl->prof_lat1 - ctl->prof_lat0) / ctl->prof_ny;
 
    /* Set vertical coordinates... */
    for (int iz = 0; iz < ctl->prof_nz; iz++) {
      z[iz] = ctl->prof_z0 + dz * (iz + 0.5);
      press[iz] = P(z[iz]);
    }
 
    /* Set horizontal coordinates... */
    for (int ix = 0; ix < ctl->prof_nx; ix++)
      lon[ix] = ctl->prof_lon0 + dlon * (ix + 0.5);
    for (int iy = 0; iy < ctl->prof_ny; iy++) {
      lat[iy] = ctl->prof_lat0 + dlat * (iy + 0.5);
      area[iy] = dlat * dlon * SQR(RE * M_PI / 180.) * cos(DEG2RAD(lat[iy]));
    }
  }
 
  /* Set time interval... */
  const double t0 = t - 0.5 * ctl->dt_mod;
  const double t1 = t + 0.5 * ctl->dt_mod;
 
  /* Allocate... */
  ALLOC(mass, double,
        ctl->prof_nx * ctl->prof_ny * ctl->prof_nz);
  ALLOC(obsmean, double,
        ctl->prof_nx * ctl->prof_ny);
  ALLOC(obscount, int,
        ctl->prof_nx * ctl->prof_ny);
 
  /* Loop over observations... */
  for (int i = 0; i < nobs; i++) {
 
    /* Check time... */
    if (rt[i] < t0)
      continue;
    else if (rt[i] >= t1)
      break;
 
    /* Check observation data... */
    if (!isfinite(robs[i]))
      continue;
 
    /* Check grid boundaries and calculate indices... */
    if (rlon[i] < ctl->prof_lon0 || rlon[i] >= ctl->prof_lon1
        || rlat[i] < ctl->prof_lat0 || rlat[i] >= ctl->prof_lat1)
      continue;
    const int ix = (int) ((rlon[i] - ctl->prof_lon0) / dlon);
    const int iy = (int) ((rlat[i] - ctl->prof_lat0) / dlat);
    if (ix >= ctl->prof_nx || iy >= ctl->prof_ny)
      continue;
 
    /* Get mean observation index... */
    const int idx = ARRAY_2D(ix, iy, ctl->prof_ny);
    obsmean[idx] += robs[i];
    obscount[idx]++;
  }
 
  /* Analyze model data... */
  for (ip = 0; ip < atm->np; ip++) {
 
    /* Check time... */
    if (atm->time[ip] < t0 || atm->time[ip] > t1)
      continue;
 
    /* Check grid boundaries and get indices... */
    const double zpart = Z(atm->p[ip]);
    if (atm->lon[ip] < ctl->prof_lon0
        || atm->lon[ip] >= ctl->prof_lon1
        || atm->lat[ip] < ctl->prof_lat0
        || atm->lat[ip] >= ctl->prof_lat1
        || zpart < ctl->prof_z0 || zpart >= ctl->prof_z1)
      continue;
    const int ix = (int) ((atm->lon[ip] - ctl->prof_lon0) / dlon);
    const int iy = (int) ((atm->lat[ip] - ctl->prof_lat0) / dlat);
    const int iz = (int) ((zpart - ctl->prof_z0) / dz);
    if (ix >= ctl->prof_nx || iy >= ctl->prof_ny || iz >= ctl->prof_nz)
      continue;
 
    /* Get total mass in grid cell... */
    const int idx = ARRAY_3D(ix, iy, ctl->prof_ny, iz, ctl->prof_nz);
    mass[idx] += atm->q[ctl->qnt_m][ip];
  }
 
  /* Extract profiles... */
  for (int ix = 0; ix < ctl->prof_nx; ix++)
    for (int iy = 0; iy < ctl->prof_ny; iy++) {
      int idx2 = ARRAY_2D(ix, iy, ctl->prof_ny);
      if (obscount[idx2] > 0) {
 
        /* Check profile... */
        okay = 0;
        for (int iz = 0; iz < ctl->prof_nz; iz++) {
          int idx3 = ARRAY_3D(ix, iy, ctl->prof_ny, iz, ctl->prof_nz);
          if (mass[idx3] > 0) {
            okay = 1;
            break;
          }
        }
        if (!okay)
          continue;
 
        /* Write output... */
        fprintf(out, "\n");
 
        /* Loop over altitudes... */
        for (int iz = 0; iz < ctl->prof_nz; iz++) {
 
          /* Get temperature, water vapor, and ozone... */
          INTPOL_INIT;
          intpol_met_time_3d(met0, met0->t, met1, met1->t, t, press[iz],
                             lon[ix], lat[iy], &temp, ci, cw, 1);
          intpol_met_time_3d(met0, met0->h2o, met1, met1->h2o, t, press[iz],
                             lon[ix], lat[iy], &h2o, ci, cw, 0);
          intpol_met_time_3d(met0, met0->o3, met1, met1->o3, t, press[iz],
                             lon[ix], lat[iy], &o3, ci, cw, 0);
 
          /* Calculate volume mixing ratio... */
          const int idx3 = ARRAY_3D(ix, iy, ctl->prof_ny, iz, ctl->prof_nz);
          vmr = MA / ctl->molmass * mass[idx3]
            / (RHO(press[iz], temp) * area[iy] * dz * 1e9);
 
          /* Write output... */
          fprintf(out, "%.2f %g %g %g %g %g %g %g %g %g %d\n",
                  t, z[iz], lon[ix], lat[iy], press[iz], temp, vmr, h2o, o3,
                  obsmean[idx2] / obscount[idx2], obscount[idx2]);
        }
      }
    }
 
  /* Free... */
  free(mass);
  free(obsmean);
  free(obscount);
 
  /* Finalize... */
  if (t == ctl->t_stop) {
 
    /* Close output file... */
    fclose(out);
 
    /* Free... */
    free(lon);
    free(lat);
    free(area);
    free(z);
    free(press);
    free(rt);
    free(rz);
    free(rlon);
    free(rlat);
    free(robs);
  }
}
 
/*****************************************************************************/
 
void write_sample(
  const char *filename,
  const ctl_t *ctl,
  met_t *met0,
  met_t *met1,
  const atm_t *atm,
  const double t) {
 
  if (ctl->met_coord_type != 0)
    ERRMSG("Only lat/lon grid supported");
 
  static FILE *out;
 
  static double area, dlat, rmax2, *rt, *rz, *rlon, *rlat, *robs, kz[EP],
    kw[EP];
 
  static int nobs, nk;
 
  /* Set timer... */
  SELECT_TIMER("WRITE_SAMPLE", "OUTPUT");
 
  /* Init... */
  if (t == ctl->t_start) {
 
    /* Allocate... */
    ALLOC(rt, double,
          NOBS);
    ALLOC(rz, double,
          NOBS);
    ALLOC(rlon, double,
          NOBS);
    ALLOC(rlat, double,
          NOBS);
    ALLOC(robs, double,
          NOBS);
 
    /* Read observation data... */
    read_obs(ctl->sample_obsfile, ctl, rt, rz, rlon, rlat, robs, &nobs);
 
    /* Read kernel data... */
    if (ctl->sample_kernel[0] != '-')
      read_kernel(ctl->sample_kernel, kz, kw, &nk);
 
    /* Create output file... */
    LOG(1, "Write sample data: %s", filename);
    if (!(out = fopen(filename, "w")))
      ERRMSG("Cannot create file!");
 
    /* Write header... */
    fprintf(out,
            "# $1 = time [s]\n"
            "# $2 = altitude [km]\n"
            "# $3 = longitude [deg]\n"
            "# $4 = latitude [deg]\n"
            "# $5 = surface area [km^2]\n"
            "# $6 = layer depth [km]\n"
            "# $7 = number of particles [1]\n"
            "# $8 = column density [kg/m^2]\n"
            "# $9 = volume mixing ratio [ppv]\n"
            "# $10 = observed BT index [K]\n\n");
 
    /* Set latitude range, squared radius, and area... */
    dlat = DY2DEG(ctl->sample_dx);
    rmax2 = SQR(ctl->sample_dx);
    area = M_PI * rmax2;
  }
 
  /* Set time interval for output... */
  const double t0 = t - 0.5 * ctl->dt_mod;
  const double t1 = t + 0.5 * ctl->dt_mod;
 
  /* Loop over observations... */
  for (int i = 0; i < nobs; i++) {
 
    /* Check time... */
    if (rt[i] < t0)
      continue;
    else if (rt[i] >= t1)
      break;
 
    /* Calculate Cartesian coordinates... */
    double x0[3];
    geo2cart(0, rlon[i], rlat[i], x0);
 
    /* Set pressure range... */
    const double rp = P(rz[i]);
    const double ptop = P(rz[i] + ctl->sample_dz);
    const double pbot = P(rz[i] - ctl->sample_dz);
 
    /* Init... */
    double mass = 0;
    int np = 0;
 
    /* Loop over air parcels... */
    //#pragma omp parallel for default(shared) reduction(+:mass,np)
    for (int ip = 0; ip < atm->np; ip++) {
 
      /* Check time... */
      if (atm->time[ip] < t0 || atm->time[ip] > t1)
        continue;
 
      /* Check latitude... */
      if (fabs(rlat[i] - atm->lat[ip]) > dlat)
        continue;
 
      /* Check horizontal distance... */
      double x1[3];
      geo2cart(0, atm->lon[ip], atm->lat[ip], x1);
      if (DIST2(x0, x1) > rmax2)
        continue;
 
      /* Check pressure... */
      if (ctl->sample_dz > 0)
        if (atm->p[ip] > pbot || atm->p[ip] < ptop)
          continue;
 
      /* Add mass... */
      if (ctl->qnt_m >= 0)
        mass +=
          kernel_weight(kz, kw, nk, atm->p[ip]) * atm->q[ctl->qnt_m][ip];
      np++;
    }
 
    /* Calculate column density... */
    const double cd = mass / (1e6 * area);
 
    /* Calculate volume mixing ratio... */
    double vmr = 0;
    if (ctl->molmass > 0 && ctl->sample_dz > 0) {
      if (mass > 0) {
 
        /* Get temperature... */
        double temp;
        INTPOL_INIT;
        intpol_met_time_3d(met0, met0->t, met1, met1->t, rt[i], rp,
                           rlon[i], rlat[i], &temp, ci, cw, 1);
 
        /* Calculate volume mixing ratio... */
        vmr = MA / ctl->molmass * cd / (RHO(rp, temp) * ctl->sample_dz * 1e3);
      }
    } else
      vmr = NAN;
 
    /* Write output... */
    fprintf(out, "%.2f %g %g %g %g %g %d %g %g %g\n", rt[i], rz[i],
            rlon[i], rlat[i], area, ctl->sample_dz, np, cd, vmr, robs[i]);
  }
 
  /* Finalize...... */
  if (t == ctl->t_stop) {
 
    /* Close output file... */
    fclose(out);
 
    /* Free... */
    free(rt);
    free(rz);
    free(rlon);
    free(rlat);
    free(robs);
  }
}
 
/*****************************************************************************/
 
void write_station(
  const char *filename,
  const ctl_t *ctl,
  atm_t *atm,
  const double t) {
 
  if (ctl->met_coord_type != 0)
    ERRMSG("Only lat/lon grid supported");
 
  static FILE *out;
 
  static double rmax2, x0[3], x1[3];
 
  /* Set timer... */
  SELECT_TIMER("WRITE_STATION", "OUTPUT");
 
  /* Init... */
  if (t == ctl->t_start) {
 
    /* Write info... */
    LOG(1, "Write station data: %s", filename);
 
    /* Create new file... */
    if (!(out = fopen(filename, "w")))
      ERRMSG("Cannot create file!");
 
    /* Write header... */
    fprintf(out,
            "# $1 = time [s]\n"
            "# $2 = altitude [km]\n"
            "# $3 = longitude [deg]\n" "# $4 = latitude [deg]\n");
    for (int iq = 0; iq < ctl->nq; iq++)
      fprintf(out, "# $%i = %s [%s]\n", (iq + 5),
              ctl->qnt_name[iq], ctl->qnt_unit[iq]);
    fprintf(out, "\n");
 
    /* Set geolocation and search radius... */
    geo2cart(0, ctl->stat_lon, ctl->stat_lat, x0);
    rmax2 = SQR(ctl->stat_r);
  }
 
  /* Set time interval for output... */
  const double t0 = t - 0.5 * ctl->dt_mod;
  const double t1 = t + 0.5 * ctl->dt_mod;
 
  /* Count number of newly set station flags... */
  int nflag = 0;
 
  /* Loop over air parcels... */
  for (int ip = 0; ip < atm->np; ip++) {
 
    /* Check time... */
    if (atm->time[ip] < t0 || atm->time[ip] > t1)
      continue;
 
    /* Check time range for station output... */
    if (atm->time[ip] < ctl->stat_t0 || atm->time[ip] > ctl->stat_t1)
      continue;
 
    /* Check station flag... */
    if (ctl->qnt_stat >= 0)
      if ((int) atm->q[ctl->qnt_stat][ip])
        continue;
 
    /* Get Cartesian coordinates... */
    geo2cart(0, atm->lon[ip], atm->lat[ip], x1);
 
    /* Check horizontal distance... */
    if (DIST2(x0, x1) > rmax2)
      continue;
 
    /* Set station flag... */
    if (ctl->qnt_stat >= 0) {
      atm->q[ctl->qnt_stat][ip] = 1;
      nflag += 1;
    }
 
    /* Write data... */
    fprintf(out, "%.2f %g %g %g",
            atm->time[ip], Z(atm->p[ip]), atm->lon[ip], atm->lat[ip]);
    for (int iq = 0; iq < ctl->nq; iq++) {
      fprintf(out, " ");
      fprintf(out, ctl->qnt_format[iq], atm->q[iq][ip]);
    }
    fprintf(out, "\n");
  }
 
  /* During the run, the parcel state lives on the GPU, see mptrac_init().
     Therefore, push the station flags written above back to the device;
     otherwise, they are invisible to the next timesteps and get discarded
     by the next mptrac_update_host() within mptrac_write_output(). */
#ifdef _OPENACC
  if (nflag > 0) {
#pragma acc update device(atm->q[ctl->qnt_stat][0:atm->np])
  }
#else
  (void) nflag;
#endif
 
  /* Close file... */
  if (t == ctl->t_stop)
    fclose(out);
}
 
/*****************************************************************************/
 
void write_vtk(
  const char *filename,
  const ctl_t *ctl,
  const atm_t *atm,
  const double t) {
 
  if (ctl->met_coord_type != 0)
    ERRMSG("Only lat/lon grid supported");
 
  FILE *out;
 
  /* Set timer... */
  SELECT_TIMER("WRITE_VTK", "OUTPUT");
 
  /* Write info... */
  LOG(1, "Write VTK data: %s", filename);
 
  /* Set time interval for output... */
  const double t0 = t - 0.5 * ctl->dt_mod;
  const double t1 = t + 0.5 * ctl->dt_mod;
 
  /* Create file... */
  if (!(out = fopen(filename, "w")))
    ERRMSG("Cannot create file!");
 
  /* Count data points... */
  int np = 0;
  for (int ip = 0; ip < atm->np; ip += ctl->vtk_stride) {
    if (atm->time[ip] < t0 || atm->time[ip] > t1)
      continue;
    np++;
  }
 
  /* Write header... */
  fprintf(out,
          "# vtk DataFile Version 3.0\n"
          "vtk output\n" "ASCII\n" "DATASET POLYDATA\n");
 
  /* Write point coordinates... */
  fprintf(out, "POINTS %d float\n", np);
  if (ctl->vtk_sphere) {
    for (int ip = 0; ip < atm->np; ip += ctl->vtk_stride) {
      if (atm->time[ip] < t0 || atm->time[ip] > t1)
        continue;
      const double radius = (RE + Z(atm->p[ip]) * ctl->vtk_scale
                             + ctl->vtk_offset) / RE;
      const double coslat = cos(DEG2RAD(atm->lat[ip]));
      const double x = radius * coslat * cos(DEG2RAD(atm->lon[ip]));
      const double y = radius * coslat * sin(DEG2RAD(atm->lon[ip]));
      const double z = radius * sin(DEG2RAD(atm->lat[ip]));
      fprintf(out, "%g %g %g\n", x, y, z);
    }
  } else
    for (int ip = 0; ip < atm->np; ip += ctl->vtk_stride) {
      if (atm->time[ip] < t0 || atm->time[ip] > t1)
        continue;
      fprintf(out, "%g %g %g\n", atm->lon[ip], atm->lat[ip],
              Z(atm->p[ip]) * ctl->vtk_scale + ctl->vtk_offset);
    }
 
  /* Write point data... */
  fprintf(out, "POINT_DATA %d\n", np);
  for (int iq = 0; iq < ctl->nq; iq++) {
    fprintf(out, "SCALARS %s float 1\n" "LOOKUP_TABLE default\n",
            ctl->qnt_name[iq]);
    for (int ip = 0; ip < atm->np; ip += ctl->vtk_stride) {
      if (atm->time[ip] < t0 || atm->time[ip] > t1)
        continue;
      fprintf(out, "%g\n", atm->q[iq][ip]);
    }
  }
 
  /* Close file... */
  fclose(out);
}