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"
 
#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;
 
  /* Get meteo variable... */
  const int metvar = compress_metvar_index(varname);
 
  /* Set lon-lat grid... */
  const size_t nxy = nx * ny;
  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 rho[EP], mean_err[EP], stddev_err[EP], min_err[EP], max_err[EP];
    double mean_org[EP], range_org[EP], nrmse[EP];
    double ratio[EP], bpv[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++) {
 
        /* 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]);
 
        /* 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 += (omp_get_wtime() - t0);
 
        /* Write per-level diagnostics... */
        if (level_log) {
          ratio[ip] = cms_compression_rate(cms_ptr[ip], cms_sol[ip]);
          bpv[ip] = 32. / ratio[ip];
          compress_error_stats(tmp_org, tmp_cms, nxy, &mean_err[ip],
                               &stddev_err[ip], &min_err[ip], &max_err[ip],
                               &nrmse[ip], &mean_org[ip], &range_org[ip]);
          rho[ip] = gsl_stats_float_correlation(tmp_org, 1, tmp_cms, 1, nxy);
        }
 
        /* Calculate harmonic mean of compression rates... */
        cr += 1.0 / cms_compression_rate(cms_ptr[ip], cms_sol[ip]);
 
        /* 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 per-level diagnostics... */
    if (level_log) {
      const size_t nbytes = nx * ny * np * sizeof(float);
      for (size_t ip = 0; ip < np; ip++)
        fprintf(level_log,
                "%s %s %lu %g %g %g %g %g %g %g %g %g %g %g %g %g %g %g\n",
                "CMS", varname, (unsigned long) ip, met->p[ip], ratio[ip],
                bpv[ip], rho[ip], mean_err[ip], stddev_err[ip], min_err[ip],
                max_err[ip], mean_org[ip], range_org[ip], nrmse[ip], t_coars,
                COMPRESS_SPEED(nbytes, t_coars), t_eval,
                COMPRESS_SPEED(nbytes, t_eval));
    }
 
    /* 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_error_stats(
  const float *org,
  const float *cmp,
  const size_t n,
  double *mean,
  double *stddev,
  double *min,
  double *max,
  double *nrmse,
  double *org_mean,
  double *range) {
 
  double avg = 0, m2 = 0, err_min = 0, err_max = 0, rmse = 0;
  double org_min = 0, org_max = 0;
 
  /* Calculate error statistics... */
  for (size_t i = 0; i < n; i++) {
    const double err = (double) cmp[i] - (double) org[i];
    const double val = (double) org[i];
    const double delta = err - avg;
 
    avg += delta / ((double) i + 1.);
    m2 += delta * (err - avg);
    rmse += err * err;
 
    if (i == 0 || err < err_min)
      err_min = err;
    if (i == 0 || err > err_max)
      err_max = err;
    if (i == 0 || val < org_min)
      org_min = val;
    if (i == 0 || val > org_max)
      org_max = val;
  }
 
  *mean = avg;
  *stddev = (n > 1 ? sqrt(m2 / ((double) n - 1.)) : 0);
  *min = err_min;
  *max = err_max;
  *org_mean = 0;
  for (size_t i = 0; i < n; i++)
    *org_mean += (double) org[i];
  *org_mean /= (double) n;
  *range = org_max - org_min;
  *nrmse = ((org_max - org_min) > 0
            ? sqrt(rmse / (double) n) / (org_max - org_min)
            : NAN);
}
 
/*****************************************************************************/
 
void compress_log_header(
  FILE *out) {
 
  /* Write file header... */
  fprintf(out,
          "# $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");
}
 
/*****************************************************************************/
 
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 rho,
  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] = "";
  double mean_err, stddev_err, min_err, max_err;
  double nrmse, mean_org, range_org, rho_out = rho;
 
  /* Calculate error statistics... */
  compress_error_stats(org, cmp, n, &mean_err, &stddev_err, &min_err,
                       &max_err, &nrmse, &mean_org, &range_org);
  if (isnan(rho_out))
    rho_out = gsl_stats_float_correlation(org, 1, cmp, 1, n);
 
  /* Write output... */
  if (out != last_out) {
    last_out = out;
    last_var[0] = '\0';
  }
  if (last_var[0] != '\0' && strcmp(last_var, varname) != 0)
    fprintf(out, "\n");
  snprintf(last_var, LEN, "%s", varname);
  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_out,
          mean_err, stddev_err, min_err, max_err, mean_org, range_org, nrmse,
          t_comp, COMPRESS_SPEED(nbytes, t_comp), t_decomp,
          COMPRESS_SPEED(nbytes, t_decomp));
}
 
/*****************************************************************************/
 
void compress_scale_to_unit(
  float *array,
  const size_t nxy,
  const size_t nz,
  double *off,
  double *scl) {
 
  for (size_t iz = 0; iz < nz; iz++) {
    off[iz] = array[iz];
    scl[iz] = array[iz];
  }
 
  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;
    }
 
  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;
  }
 
#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) {
 
#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_metvar_index(
  const char *varname) {
 
  if (strcasecmp(varname, "Z") == 0)
    return 0;
  else if (strcasecmp(varname, "T") == 0)
    return 1;
  else if (strcasecmp(varname, "U") == 0)
    return 2;
  else if (strcasecmp(varname, "V") == 0)
    return 3;
  else if (strcasecmp(varname, "W") == 0)
    return 4;
  else if (strcasecmp(varname, "PV") == 0)
    return 5;
  else if (strcasecmp(varname, "H2O") == 0)
    return 6;
  else if (strcasecmp(varname, "O3") == 0)
    return 7;
  else if (strcasecmp(varname, "LWC") == 0)
    return 8;
  else if (strcasecmp(varname, "RWC") == 0)
    return 9;
  else if (strcasecmp(varname, "IWC") == 0)
    return 10;
  else if (strcasecmp(varname, "SWC") == 0)
    return 11;
  else if (strcasecmp(varname, "CC") == 0)
    return 12;
  else
    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;
 
  double vmin[EP], vmax[EP], off[EP], scl[EP];
  unsigned short *sarray;
  const size_t payload_len = 2 * nz * sizeof(double)
    + nxy * nz * sizeof(unsigned short);
  size_t stored_len = payload_len;
 
  /* Allocate... */
  ALLOC(sarray, unsigned short,
        nxy * nz);
 
  /* Read compressed stream and decompress array... */
  if (decompress) {
    double t_zstd = 0.0;
 
    /* Read data... */
    if (ctl->met_pck_zstd) {
#ifdef ZSTD
      uint64_t magic, pck_zstd_magic = UINT64_C(0x50434b5a53544431);
      unsigned char *compr = NULL, *payload = NULL;
 
      FREAD(&magic, uint64_t, 1, inout);
      if (magic != pck_zstd_magic)
        ERRMSG("PCK+ZSTD magic mismatch! Check MET_PCK_ZSTD and file type.");
      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!");
      memcpy(scl, payload, nz * sizeof(double));
      memcpy(off, payload + nz * sizeof(double), nz * sizeof(double));
      memcpy(sarray, payload + 2 * nz * sizeof(double),
             nxy * nz * sizeof(unsigned short));
      free(payload);
      free(compr);
#else
      ERRMSG("MPTRAC was compiled without ZSTD compression!");
#endif
    } else {
      FREAD(&scl, double,
            nz,
            inout);
      FREAD(&off, double,
            nz,
            inout);
      FREAD(sarray, unsigned short,
            nxy * nz,
            inout);
    }
 
    /* Measure time... */
    const double t0 = omp_get_wtime();
 
    /* Convert to float... */
#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]);
 
    /* Write info... */
    const double t_decomp = t_zstd + omp_get_wtime() - t0;
    const double ratio_out =
      (double) (nxy * nz * sizeof(float)) / (double) stored_len;
    const double bpv_out = (8. * (double) stored_len) / (double) (nxy * nz);
    LOG(2, "Read 3-D variable: %s"
        " (PCK%s, RATIO=%g, BPV=%g, T_DECOMP=%g s, V_DECOMP=%g MiB/s)",
        varname, ctl->met_pck_zstd ? "+ZSTD" : "", ratio_out, bpv_out,
        t_decomp, COMPRESS_SPEED(nxy * nz * sizeof(float), 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 rho[EP], mean[EP], stddev[EP], min[EP], max[EP], nrmse[EP];
    double org_mean[EP], range[EP];
 
    /* Allocate... */
    ALLOC(tmp_org, float,
          nxy);
    ALLOC(tmp_pck, float,
          nxy);
 
    /* Get range... */
    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];
      }
 
    /* Get offset and scaling factor... */
    for (size_t iz = 0; iz < nz; iz++) {
      scl[iz] = (vmax[iz] - vmin[iz]) / 65533.;
      off[iz] = vmin[iz];
    }
 
    /* Convert to short and evaluate per level... */
    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] =
            (unsigned short) ((array[ixy * nz + iz] - off[iz]) / scl[iz] +
                              .5);
        else
          sarray[ixy * nz + iz] = 0;
 
      const double t_comp = omp_get_wtime() - t0;
      t_comp_sum += t_comp;
 
      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]);
      }
 
      const double t_decomp = omp_get_wtime() - t1;
      t_decomp_sum += t_decomp;
 
      if (level_log) {
        compress_error_stats(tmp_org, tmp_pck, nxy, &mean[iz], &stddev[iz],
                             &min[iz], &max[iz], &nrmse[iz], &org_mean[iz],
                             &range[iz]);
        rho[iz] = gsl_stats_float_correlation(tmp_org, 1, tmp_pck, 1, nxy);
      }
    }
 
    /* Write data... */
    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;
      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,
             nxy * nz * sizeof(unsigned short));
      const size_t dst_cap = ZSTD_compressBound(payload_len);
      ALLOC(stored_data, char,
            dst_cap);
      ZSTD_CCtx *cctx = ZSTD_createCCtx();
      if (!cctx)
        ERRMSG("Cannot create ZSTD context!");
      if (ZSTD_isError
          (ZSTD_CCtx_setParameter
           (cctx, ZSTD_c_compressionLevel, ctl->met_zstd_level)))
        ERRMSG("Cannot set ZSTD compression level!");
      if (ZSTD_isError
          (ZSTD_CCtx_setParameter
           (cctx, ZSTD_c_nbWorkers, ctl->met_zstd_nworkers)))
        ERRMSG("Cannot set ZSTD worker count!");
      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!");
      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(payload_chk);
      free(payload);
      FWRITE(&pck_zstd_magic, uint64_t, 1, inout);
      FWRITE(&stored_len, size_t,
             1,
             inout);
      FWRITE(stored_data, unsigned char,
             stored_len,
             inout);
      free(stored_data);
#else
      ERRMSG("MPTRAC was compiled without ZSTD compression!");
#endif
    } else {
      FWRITE(&scl, double,
             nz,
             inout);
      FWRITE(&off, double,
             nz,
             inout);
      FWRITE(sarray, unsigned short,
             nxy * nz,
             inout);
    }
 
    /* Write info... */
    const double ratio_out =
      (double) (nxy * nz * sizeof(float)) / (double) stored_len;
    const double bpv_out = (8. * (double) stored_len) / (double) (nxy * nz);
    const double t_comp = t_comp_sum + t_zstd;
    const double t_decomp = t_decomp_sum + t_zstd_decomp;
    LOG(2, "Write 3-D variable: %s"
        " (PCK%s, RATIO=%g, BPV=%g, T_COMP=%g s, V_COMP=%g MiB/s,"
        " T_DECOMP=%g s, V_DECOMP=%g MiB/s)",
        varname, ctl->met_pck_zstd ? "+ZSTD" : "", ratio_out, bpv_out, t_comp,
        COMPRESS_SPEED(nxy * nz * sizeof(float), t_comp), t_decomp,
        COMPRESS_SPEED(nxy * nz * sizeof(float), t_decomp));
 
    /* Write per-level diagnostics... */
    if (level_log) {
      const double t_comp_level = t_comp / (double) nz;
      const double t_decomp_level = t_decomp / (double) nz;
      for (size_t iz = 0; iz < nz; iz++)
        fprintf(level_log,
                "%s %s %lu %g %g %g %g %g %g %g %g %g %g %g %g %g %g %g\n",
                ctl->met_pck_zstd ? "PCKZSTD" : "PCK", varname,
                (unsigned long) iz, met->p[iz], ratio_out, bpv_out, rho[iz],
                mean[iz], stddev[iz], min[iz], max[iz], org_mean[iz],
                range[iz], nrmse[iz], t_comp_level,
                COMPRESS_SPEED(nxy * sizeof(float), t_comp_level),
                t_decomp_level, COMPRESS_SPEED(nxy * sizeof(float),
                                               t_decomp_level));
    }
 
    /* 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;
 
  /* Read compressed stream and decompress array... */
  if (decompress) {
 
    int stored_lossy_scale;
    FREAD(&stored_lossy_scale, int,
          1,
          inout);
    if (stored_lossy_scale < 0 || stored_lossy_scale > 1)
      ERRMSG("Invalid stored MET_LOSSY_SCALE flag!");
    if (stored_lossy_scale > 0) {
      ALLOC(scale_off, double,
            r1);
      ALLOC(scale_scl, double,
            r1);
      FREAD(scale_off, double,
            r1,
            inout);
      FREAD(scale_scl, double,
            r1,
            inout);
    }
 
    size_t sz3size;
    FREAD(&sz3size, size_t,
          1,
          inout);
    ALLOC(bytes, char,
          sz3size);
    FREAD(bytes, unsigned char,
          sz3size,
          inout);
 
    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));
    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(outData);
    free(bytes);
 
    LOG(2, "Read 3-D variable: %s"
        " (SZ3, PREC=%d, TOL=%g, SCALE=%d, RATIO=%g, BPV=%g, T_DECOMP=%g s, V_DECOMP=%g MiB/s)",
        varname, ctl->met_sz3_prec[metvar], ctl->met_sz3_tol[metvar],
        stored_lossy_scale,
        (double) (total_elems * sizeof(float)) / (double) sz3size,
        (8. * (double) sz3size) / (double) total_elems, t_decomp,
        COMPRESS_SPEED(total_elems * sizeof(float), t_decomp));
  }
 
  /* Compress array and output compressed stream... */
  else {
    const int errBoundMode = (ctl->met_sz3_prec[metvar] > 0) ? REL : ABS;
    FWRITE(&ctl->met_lossy_scale[metvar], int,
           1,
           inout);
    if (ctl->met_lossy_scale[metvar] > 0) {
      ALLOC(scale_off, double,
            r1);
      ALLOC(scale_scl, double,
            r1);
      if (level_log) {
        ALLOC(orig_all, float,
              total_elems);
        memcpy(orig_all, array, total_elems * sizeof(float));
      }
      compress_scale_to_unit(array, r2 * r3, r1, scale_off, scale_scl);
      FWRITE(scale_off, double,
             r1,
             inout);
      FWRITE(scale_scl, double,
             r1,
             inout);
    }
    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 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!");
 
    FWRITE(&outSize, size_t,
           1,
           inout);
    FWRITE(bytes, unsigned char,
           outSize,
           inout);
 
    double t_decomp = NAN;
    if (level_log) {
      unsigned char *bytes_copy;
 
      /* 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!");
 
      float *tmp_all, *tmp_org, *tmp_sz3;
      const size_t nxy = r2 * r3;
 
      ALLOC(tmp_all, float,
            total_elems);
      ALLOC(tmp_org, float,
            nxy);
      ALLOC(tmp_sz3, float,
            nxy);
      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);
 
      for (size_t lev = 0; lev < r1; lev++) {
 
        /* Extract current level... */
#pragma omp parallel for default(shared)
        for (size_t ixy = 0; ixy < nxy; ixy++) {
          tmp_org[ixy] = (orig_all ? orig_all : array)[ixy * r1 + lev];
          tmp_sz3[ixy] = tmp_all[ixy * r1 + lev];
        }
        compress_log_level(level_log, "SZ3", varname, lev, met->p[lev],
                           (double) (total_elems * sizeof(float))
                           / (double) outSize,
                           (8. * (double) outSize) / (double) total_elems,
                           NAN, t_comp, t_decomp, nxy,
                           total_elems * sizeof(float), tmp_org, tmp_sz3);
      }
 
      free(tmp_all);
      free(tmp_org);
      free(tmp_sz3);
      free(decData);
      free(bytes_copy);
 
      LOG(2, "Write 3-D variable: %s"
          " (SZ3, PREC=%d, TOL=%g, SCALE=%d, RATIO=%g, BPV=%g, T_COMP=%g s, V_COMP=%g MiB/s,"
          " T_DECOMP=%g s, V_DECOMP=%g MiB/s)",
          varname, ctl->met_sz3_prec[metvar], ctl->met_sz3_tol[metvar],
          ctl->met_lossy_scale[metvar],
          (double) (total_elems * sizeof(float)) / (double) outSize,
          (8. * (double) outSize) / (double) total_elems, t_comp,
          COMPRESS_SPEED(total_elems * sizeof(float), t_comp), t_decomp,
          COMPRESS_SPEED(total_elems * sizeof(float), t_decomp));
    } else
      LOG(2, "Write 3-D variable: %s"
          " (SZ3, PREC=%d, TOL=%g, SCALE=%d, RATIO=%g, BPV=%g, T_COMP=%g s, V_COMP=%g MiB/s)",
          varname, ctl->met_sz3_prec[metvar], ctl->met_sz3_tol[metvar],
          ctl->met_lossy_scale[metvar],
          (double) (total_elems * sizeof(float)) / (double) outSize,
          (8. * (double) outSize) / (double) total_elems, t_comp,
          COMPRESS_SPEED(total_elems * sizeof(float), t_comp));
    free(bytes);
    free(orig_all);
  }
 
  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 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;
  if (decompress) {
    int stored_lossy_scale;
    FREAD(&stored_lossy_scale, int,
          1,
          inout);
    if (stored_lossy_scale < 0 || stored_lossy_scale > 1)
      ERRMSG("Invalid stored MET_LOSSY_SCALE flag!");
    if (stored_lossy_scale > 0) {
      ALLOC(scale_off, double,
            snx);
      ALLOC(scale_scl, double,
            snx);
      FREAD(scale_off, double,
            snx,
            inout);
      FREAD(scale_scl, double,
            snx,
            inout);
    }
    FREAD(&zfpsize, size_t,
          1,
          inout);
    if (zfpsize > bufsize)
      ERRMSG("Compressed data size exceeds allocated buffer!");
    FREAD(buffer, unsigned char,
          zfpsize,
          inout);
    const double t0 = omp_get_wtime();
    if (!zfp_decompress(zfp, field))
      ERRMSG("Decompression failed!");
    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 cr =
      ((double) (snx * sny * snz * sizeof(float))) / (double) zfpsize;
    const double bpv = (8.0 * (double) zfpsize) / (double) (snx * sny * snz);
    LOG(2,
        "Read 3-D variable: %s"
        " (ZFP, PREC=%d, TOL=%g, SCALE=%d, RATIO=%g, BPV=%g, T_DECOMP=%g s,"
        " V_DECOMP=%g MiB/s)",
        varname, actual_prec, actual_tol, stored_lossy_scale, cr, bpv,
        t_decomp, COMPRESS_SPEED(snx * sny * snz * sizeof(float), t_decomp));
  }
 
  /* Compress array and output compressed stream... */
  else {
    float *tmp_all, *tmp_org, *tmp_zfp, *orig_all = NULL;
    const size_t nxy = sny * snz;
 
    FWRITE(&ctl->met_lossy_scale[metvar], int,
           1,
           inout);
    if (ctl->met_lossy_scale[metvar] > 0) {
      ALLOC(scale_off, double,
            snx);
      ALLOC(scale_scl, double,
            snx);
      if (level_log) {
        ALLOC(orig_all, float,
              snx * sny * snz);
        memcpy(orig_all, array, snx * sny * snz * sizeof(float));
      }
      compress_scale_to_unit(array, nxy, snx, scale_off, scale_scl);
      FWRITE(scale_off, double,
             snx,
             inout);
      FWRITE(scale_scl, double,
             snx,
             inout);
    }
 
    ALLOC(tmp_all, float,
          snx * sny * snz);
    ALLOC(tmp_org, float,
          nxy);
    ALLOC(tmp_zfp, float,
          nxy);
 
    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 {
      FWRITE(&zfpsize, size_t,
             1,
             inout);
      FWRITE(buffer, unsigned char,
             zfpsize,
             inout);
    }
 
    zfp_field *dec_field = zfp_field_3d(tmp_all, type, snx, sny, snz);
    if (!dec_field)
      ERRMSG("Failed to allocate zfp structures!");
 
    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;
 
    for (size_t lev = 0; lev < snx; lev++) {
 
      /* Extract current level... */
#pragma omp parallel for default(shared)
      for (size_t ixy = 0; ixy < nxy; ixy++) {
        tmp_org[ixy] = (orig_all ? orig_all : array)[ixy * snx + lev];
        tmp_zfp[ixy] = tmp_all[ixy * snx + lev];
      }
      if (level_log)
        compress_log_level(level_log, "ZFP", varname, lev, met->p[lev],
                           ((double) (snx * sny * snz * sizeof(float)))
                           / (double) zfpsize, (8.0 * (double) zfpsize)
                           / (double) (snx * sny * snz),
                           NAN, t_comp, t_decomp, nxy,
                           snx * sny * snz * sizeof(float), tmp_org, tmp_zfp);
    }
 
    const double cr =
      ((double) (snx * sny * snz * sizeof(float))) / (double) zfpsize;
    const double bpv = (8.0 * (double) zfpsize) / (double) (snx * sny * snz);
    LOG(2,
        "Write 3-D variable: %s"
        " (ZFP, PREC=%d, TOL=%g, SCALE=%d, RATIO=%g, BPV=%g, T_COMP=%g s,"
        " V_COMP=%g MiB/s, T_DECOMP=%g s, V_DECOMP=%g MiB/s)",
        varname, actual_prec, actual_tol, ctl->met_lossy_scale[metvar], cr,
        bpv, t_comp, COMPRESS_SPEED(snx * sny * snz * sizeof(float), t_comp),
        t_decomp, COMPRESS_SPEED(snx * sny * snz * sizeof(float), t_decomp));
 
    free(tmp_all);
    free(tmp_org);
    free(tmp_zfp);
    free(orig_all);
    zfp_field_free(dec_field);
  }
 
  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;
  ALLOC(compr, char,
        comprLen);
 
  /* Read compressed stream and decompress array... */
  if (decompress) {
    FREAD(&comprLen, size_t,
          1,
          inout);
    FREAD(compr, unsigned char,
          comprLen,
          inout);
    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!");
    LOG(2, "Read 3-D variable: %s"
        " (ZSTD, LEVEL=%d, RATIO=%g, BPV=%g, T_DECOMP=%g s, V_DECOMP=%g MiB/s)",
        varname, ctl->met_zstd_level,
        ((double) uncomprLen) / (double) comprLen,
        (8. * (double) comprLen) / (double) n, t_decomp,
        COMPRESS_SPEED(uncomprLen, t_decomp));
  }
 
  /* Compress array and output compressed stream... */
  else {
    float *tmp_org, *tmp_zstd, *tmp_all;
    ZSTD_CCtx *cctx;
 
    ALLOC(tmp_org, float,
          nxy);
    ALLOC(tmp_zstd, float,
          nxy);
    ALLOC(tmp_all, float,
          n);
 
    cctx = ZSTD_createCCtx();
    if (!cctx)
      ERRMSG("Cannot create ZSTD context!");
 
    if (ZSTD_isError(ZSTD_CCtx_setParameter(cctx, ZSTD_c_compressionLevel,
                                            ctl->met_zstd_level)))
      ERRMSG("Cannot set ZSTD compression level!");
 
    if (ZSTD_isError(ZSTD_CCtx_setParameter(cctx, ZSTD_c_nbWorkers,
                                            ctl->met_zstd_nworkers)))
      ERRMSG("Cannot set ZSTD worker count!");
 
    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 {
      FWRITE(&compsize, size_t,
             1,
             inout);
      FWRITE(compr, unsigned char,
             compsize,
             inout);
    }
 
    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!");
 
    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] = array[ixy * nz + lev];
        tmp_zstd[ixy] = tmp_all[ixy * nz + lev];
      }
      if (level_log)
        compress_log_level(level_log, "ZSTD", varname, lev, met->p[lev],
                           ((double) uncomprLen) / (double) compsize,
                           (8. * (double) compsize) / (double) n,
                           NAN, t_comp, t_decomp, nxy, uncomprLen, tmp_org,
                           tmp_zstd);
    }
 
    LOG(2, "Write 3-D variable: %s"
        " (ZSTD, LEVEL=%d, NWORKERS=%d, RATIO=%g, BPV=%g, T_COMP=%g s,"
        " V_COMP=%g MiB/s,"
        " T_DECOMP=%g s, V_DECOMP=%g MiB/s)",
        varname, ctl->met_zstd_level, ctl->met_zstd_nworkers,
        ((double) uncomprLen) / (double) compsize,
        (8. * (double) compsize) / (double) n, t_comp,
        COMPRESS_SPEED(uncomprLen, t_comp), t_decomp,
        COMPRESS_SPEED(uncomprLen, t_decomp));
 
    ZSTD_freeCCtx(cctx);
    free(tmp_org);
    free(tmp_zstd);
    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;
  ALLOC(compr, char,
        comprLen);
 
  /* Read compressed stream and decompress array... */
  if (decompress) {
    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);
    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!");
    LOG(2, "Read 3-D variable: %s"
        " (LZ4, ACCEL=%d, RATIO=%g, BPV=%g, T_DECOMP=%g s, V_DECOMP=%g MiB/s)",
        varname, accel, ((double) uncomprLen) / (double) comprLen,
        (8. * (double) comprLen) / (double) n, t_decomp,
        COMPRESS_SPEED(uncomprLen, t_decomp));
  }
 
  /* Compress array and output compressed stream... */
  else {
    float *tmp_org, *tmp_lz4, *tmp_all;
 
    ALLOC(tmp_org, float,
          nxy);
    ALLOC(tmp_lz4, float,
          nxy);
    ALLOC(tmp_all, float,
          n);
 
    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;
    FWRITE(&compsize, size_t,
           1,
           inout);
    FWRITE(compr, unsigned char,
           compsize,
           inout);
 
    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!");
 
    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] = array[ixy * nz + lev];
        tmp_lz4[ixy] = tmp_all[ixy * nz + lev];
      }
      if (level_log)
        compress_log_level(level_log, "LZ4", varname, lev, met->p[lev],
                           ((double) uncomprLen) / (double) compsize,
                           (8. * (double) compsize) / (double) n,
                           NAN, t_comp, t_decomp, nxy, uncomprLen, tmp_org,
                           tmp_lz4);
    }
 
    LOG(2, "Write 3-D variable: %s"
        " (LZ4, ACCEL=%d, RATIO=%g, BPV=%g, T_COMP=%g s, V_COMP=%g MiB/s,"
        " T_DECOMP=%g s, V_DECOMP=%g MiB/s)",
        varname, accel, ((double) uncomprLen) / (double) compsize,
        (8. * (double) compsize) / (double) n, t_comp,
        COMPRESS_SPEED(uncomprLen, t_comp), t_decomp,
        COMPRESS_SPEED(uncomprLen, t_decomp));
 
    free(tmp_org);
    free(tmp_lz4);
    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
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_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_subdomain][ip] = inside ? rank : -1;
      atm->q[ctl->qnt_destination][ip] = inside ? rank : -1;
    }
 
    /* Reassign... */
    else {
      atm->q[ctl->qnt_destination][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_destination][ip]) != rank)
        && ((int) (atm->q[ctl->qnt_destination][ip]) >= 0)
        && ((int) atm->q[ctl->qnt_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];
 
      atm->q[ctl->qnt_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
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_destination];
    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];
  }
 
  /* 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_destination];
    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_destination] = rank;
    (*particles)[ip].q[ctl->qnt_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 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[5] =
    { MPI_DOUBLE, MPI_DOUBLE, MPI_DOUBLE, MPI_DOUBLE, MPI_DOUBLE };
  const int blocklengths[5] = { 1, 1, 1, 1, NQ };
  const MPI_Aint displacements[5] =
    { offsetof(particle_t, time), offsetof(particle_t, p),
    offsetof(particle_t, lon), offsetof(particle_t, lat),
    offsetof(particle_t, q)
  };
  MPI_Type_create_struct(5, blocklengths, displacements, types,
                         &dd->MPI_Particle);
  MPI_Type_commit(&dd->MPI_Particle);
 
  /* 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];
    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
 
/*****************************************************************************/
 
#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);
 
  /* Create a counter on the device... */
  int device_counter = 0;
  int *device_counter_ptr = (int *) acc_malloc(sizeof(int));
  if (device_counter_ptr == NULL) {
    ERRMSG("Failed to allocate device counter memory!");
  }
  acc_memcpy_to_device(device_counter_ptr, &device_counter, sizeof(int));
 
  /* Push non local particles behind the end of the atm... */
#pragma acc parallel loop present(atm, cache) deviceptr(device_counter_ptr)
  for (int ip = 0; ip < atm->np; ip++) {
    if ((int) atm->q[ctl->qnt_subdomain][ip] != -1 &&
        (int) atm->q[ctl->qnt_destination][ip] != rank) {
 
      int local_idx;
 
#pragma acc atomic capture
      {
        local_idx = *device_counter_ptr;
        (*device_counter_ptr)++;
      }
 
      int global_index = atm->np + local_idx;
 
      /* 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 < NQ; iq++) {
        atm->q[iq][global_index] = atm->q[iq][ip];
      }
 
      /* Mark the original parcel as processed... */
      atm->q[ctl->qnt_destination][ip] = -1;
      atm->q[ctl->qnt_subdomain][ip] = -1;
 
      /* Reset cache->dt for the shifted particle... */
      cache->dt[global_index] = cache->dt[ip];
      cache->dt[ip] = 0;
    }
  }
 
  /* Update host and free... */
  acc_memcpy_from_device(npart, device_counter_ptr, sizeof(int));
  acc_free(device_counter_ptr);
}
#endif
 
/*****************************************************************************/
 
#ifdef DD
void dd_sort(
  const ctl_t *ctl,
  const met_t *met0,
  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_subdomain][ip] != -1) {
      if ((int) atm->q[ctl->qnt_destination][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... */
  dd_sort_help(atm->time, dd, np);
  dd_sort_help(atm->p, dd, np);
  dd_sort_help(atm->lon, dd, np);
  dd_sort_help(atm->lat, dd, np);
  for (int iq = 0; iq < ctl->nq; iq++)
    dd_sort_help(atm->q[iq], dd, np);
 
  /* Reset the size... */
  int nkeep = 0;
#ifdef _OPENACC
#pragma acc parallel loop reduction(+:nkeep) present(atm, ctl)
#endif
  for (int ip = 0; ip < np; ip++)
    if (((int) atm->q[ctl->qnt_subdomain][ip] != -1)
        && ((int) atm->q[ctl->qnt_destination][ip] == rank))
      nkeep++;
 
  /* Count number of particles to send... */
  int nsend = 0;
#ifdef _OPENACC
#pragma acc parallel loop reduction(+:nsend) present(atm, ctl)
#endif
  for (int ip = nkeep; ip < np; ip++)
    if (((int) atm->q[ctl->qnt_subdomain][ip] != -1)
        && ((int) atm->q[ctl->qnt_destination][ip] != rank))
      nsend++;
 
  /* Reset sizes... */
  *npart = nsend;
 
  /* Count particles with -1 subdomain (these will be effectively lost) */
  int nlost = 0;
  for (int ip = 0; ip < np; ip++)
    if ((int) atm->q[ctl->qnt_subdomain][ip] == -1)
      nlost++;
 
  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_sort_help(
  double *a,
  dd_t *dd,
  const int np) {
 
  /* Reordering of array... */
#ifdef _OPENACC
#pragma acc data present(dd,a)
#pragma acc parallel loop independent gang vector
#else
#pragma omp parallel for default(shared)
#endif
  for (int ip = 0; ip < np; ip++)
    dd->tmp[ip] = a[dd->perm[ip]];
#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] = dd->tmp[ip];
}
#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]);
  }
 
  /* 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++) {
    ixs[ip] = (int) ((atm->lon[ip] - ctl->chemgrid_lon0) / dlon);
    iys[ip] = (int) ((atm->lat[ip] - ctl->chemgrid_lat0) / dlat);
    izs[ip] = (int) ((Z(atm->p[ip]) - ctl->chemgrid_z0) / dz);
    if (atm->time[ip] < t0 || atm->time[ip] > t1
        || ixs[ip] < 0 || ixs[ip] >= nx
        || iys[ip] < 0 || iys[ip] >= ny || izs[ip] < 0 || 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 = GSL_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(
  const ctl_t *ctl,
  cache_t *cache,
  dd_t *dd,
  atm_t *atm,
  met_t **met) {
 
  /* Initialize particles locally... */
  int npart = 0, capacity = 0;
  particle_t *particles = NULL;
 
  /* Assign particles to new subdomains... */
  dd_assign_subdomains(ctl, dd, atm, 0);
 
  /* Sort particles according to location and target rank... */
  if (fmod(t, ctl->dd_sort_dt) == 0)
    dd_sort(ctl, *met, atm, dd, &npart);
  else
    dd_push(ctl, atm, cache, &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... */
  dd_atm2particles(ctl, cache, atm, particles, 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,
  met_t *met0,
  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, sig_w, tau_u, tau_w;
 
    /* 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);
 
    /* Calculate heights... */
    const double p = MIN(atm->p[ip], ps);
    const double zs = Z(ps);
    const double z = 1e3 * (Z(p) - zs);
    const double zi = 1e3 * (Z(pbl) - zs);
    const double zratio = z / zi;
 
    /* Calculate friction velocity... */
    double ess, nss, h2o, t;
    INTPOL_2D(ess, 0);
    INTPOL_2D(nss, 0);
    INTPOL_3D(t, 1);
    INTPOL_3D(h2o, 0);
    const double thetav = THETAVIRT(p, t, h2o);
    const double rho = RHO(p, TVIRT(t, h2o));
    const double tau = sqrt(SQR(ess) + SQR(nss));
    const double ustar = sqrt(tau / rho);
    const double ust = MAX(1e-4, ustar);
    const double zeta = MAX(zratio, 1e-6);
    const double z_m = MAX(z, 1.0);
 
    /* Get surface sensible heat flux... */
    double shf;
    INTPOL_2D(shf, 1);
 
    /* Estimate Monin-Obukhov length to distinguish
       neutral, stable, and unstable cases. */
    double ol = 1e12;
    if (fabs(shf) > 1e-6 && ust > 0.0)
      ol = thetav * rho * CPD * (ust * ust * ust) / (KARMAN * G0 * shf);
 
    /* Neutral conditions... */
    if (zi / fabs(ol) < 1.0) {
      const double corr = z_m / ust;
      const double sigw0 = 1.3 * ust * exp(-2e-4 * corr);
      sig_u = 1e-2 + 2.0 * ust * exp(-3e-4 * corr);
      sig_w = 1e-2 + sigw0;
      dsigw_dz = -2e-4 * sigw0;
      tau_u = 0.5 * z_m / sig_w / (1.0 + 1.5e-3 * corr);
      tau_w = tau_u;
    }
 
    /* Unstable conditions... */
    else if (ol < 0.0) {
 
      /* Convective velocity... */
      const double wstar =
        pow(-G0 / thetav * shf / (rho * CPD) * zi, 1. / 3.);
 
      /* Hanna/FLEXPART turbulent velocity variances... */
      sig_u = 1e-2 + ust * pow(12.0 - 0.5 * zi / ol, 1.0 / 3.0);
      sig_w = 1e-2 + sqrt(1.2 * SQR(wstar) * (1.0 - 0.9 * zeta)
                          * pow(zeta, 2.0 / 3.0)
                          + (1.8 - 1.4 * zeta) * SQR(ust));
 
      /* Calculate derivative dsig_w/dz... */
      dsigw_dz = 0.5 / sig_w / zi * (-1.4 * SQR(ust)
                                     + SQR(wstar) *
                                     (0.8 * pow(MAX(zeta, 1e-3), -1.0 / 3.0)
                                      - 1.8 * pow(zeta, 2.0 / 3.0)));
 
      /* Hanna/FLEXPART Lagrangian timescales... */
      tau_u = 0.15 * zi / sig_u;
      if (z_m < fabs(ol))
        tau_w = 0.1 * z_m / (sig_w * (0.55 - 0.38 * fabs(z_m / ol)));
      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 = 1e-2 + 2.0 * ust * (1.0 - zeta);
      sig_w = 1e-2 + 1.3 * ust * (1.0 - zeta);
      dsigw_dz = -1.3 * ust / zi;
      tau_u = 0.15 * zi / sig_u * sqrt(zeta);
      tau_w = 0.1 * zi / sig_w * pow(zeta, 0.8);
    }
 
    /* Apply lower bounds for numerical robustness... */
    sig_u = MAX(sig_u, 0.25);
    sig_w = MAX(sig_w, 0.1);
    tau_u = MAX(tau_u, 10.);
    tau_w = MAX(tau_w, 30.);
 
    /* Update perturbations... */
    const double ru = exp(-fabs(cache->dt[ip]) / tau_u);
    const double ru2 = sqrt(1.0 - SQR(ru));
    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] * ru
                 + sig_u * ru2 * cache->rs[3 * ip + 1]);
 
    const double rw = exp(-fabs(cache->dt[ip]) / tau_w);
    const double rw2 = sqrt(1.0 - SQR(rw));
    const double dsigw2_dz = 2.0 * sig_w * dsigw_dz;
    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) * (dsigw2_dz + rhoaux * SQR(sig_w)));
 
    /* Calculate new air parcel position... */
    atm->lon[ip] +=
      DX2COORD(met0, cache->uvwp[ip][0] * cache->dt[ip], atm->lat[ip]);
    atm->lat[ip] += DY2COORD(met0, cache->uvwp[ip][1] * cache->dt[ip]);
 
    /* Calculate new air parcel height... */
    double znew = z + cache->uvwp[ip][2] * cache->dt[ip];
    while (znew < 0.0 || znew > zi) {
      if (znew < 0.0)
        znew = -znew;
      if (znew > zi)
        znew = 2.0 * zi - znew;
    }
    atm->p[ip] += DZ2DP((znew - z) / 1000., atm->p[ip]);
  }
}
 
/*****************************************************************************/
 
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 and surface pressure... */
    double pbl, ps;
    INTPOL_INIT;
    INTPOL_2D(pbl, 1);
    INTPOL_2D(ps, 0);
 
    /* Let optional PBL closure schemes handle turbulent diffusion inside the PBL. */
    if (ctl->turb_pbl_scheme > 0 && atm->p[ip] >= pbl)
      continue;
 
    /* Get weighting factors... */
    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 diffusivity... */
    const double dx = wpbl * ctl->turb_dx_pbl + wtrop * ctl->turb_dx_trop
      + wstrat * ctl->turb_dx_strat;
    const double dz = wpbl * ctl->turb_dz_pbl + wtrop * ctl->turb_dz_trop
      + wstrat * ctl->turb_dz_strat;
 
    /* Horizontal turbulent diffusion... */
    if (dx > 0) {
      const double sigma = sqrt(2.0 * dx * fabs(cache->dt[ip]));
      atm->lon[ip] += DX2COORD(met0, cache->rs[3 * ip] * sigma, atm->lat[ip]);
      atm->lat[ip] += DY2COORD(met0, cache->rs[3 * ip + 1] * sigma);
    }
 
    /* Vertical turbulent diffusion... */
    if (dz > 0) {
      const double sigma = sqrt(2.0 * dz * fabs(cache->dt[ip])) / 1000.;
      atm->p[ip] += DZ2DP(cache->rs[3 * ip + 2] * sigma, atm->p[ip]);
    }
  }
}
 
/*****************************************************************************/
 
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 a = 3.12541941e-06;
  const double b = -5.72532259e-01;
  const double low = pow(1. / a, 1. / 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 = 9.1e7 * exp(-29700. / RI * (1. / t - 1. / 298.15));        /* (Maass, 1999), unit: M^(-2) */
 
    /* Henry constant of SO2... */
    const double H_SO2 =
      1.3e-2 * exp(2900. * (1. / t - 1. / 298.15)) * RI * t;
    const double K_1S = 1.23e-2 * exp(2.01e3 * (1. / t - 1. / 298.15)); /* unit: mol/L */
 
    /* Henry constant of H2O2... */
    const double H_h2o2 =
      8.3e2 * exp(7600. * (1. / t - 1. / 298.15)) * 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 ? a * pow(atm->q[ctl->qnt_Cx][ip], 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(cache,atm)") {
      cache->iso_var[ip] = atm->p[ip];
    }
  }
 
  /* Save density... */
  else if (ctl->isosurf == 2) {
    PARTICLE_LOOP(0, atm->np, 0, "acc data present(cache,met0,met1,atm)") {
      INTPOL_INIT;
      INTPOL_3D(t, 1);
      cache->iso_var[ip] = atm->p[ip] / t;
    }
  }
 
  /* Save potential temperature... */
  else if (ctl->isosurf == 3) {
    PARTICLE_LOOP(0, atm->np, 0, "acc data present(cache,met0,met1,atm)") {
      INTPOL_INIT;
      INTPOL_3D(t, 1);
      cache->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] = cache->iso_var[ip];
 
    /* Restore density... */
    else if (ctl->isosurf == 2) {
      INTPOL_3D(t, 1);
      atm->p[ip] = cache->iso_var[ip] * t;
    }
 
    /* Restore potential temperature... */
    else if (ctl->isosurf == 3) {
      INTPOL_3D(t, 1);
      atm->p[ip] = 1000. * pow(cache->iso_var[ip] / t, -1. / 0.286);
    }
 
    /* 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;
 
    /* Interpolate meteo data... */
    INTPOL_INIT;
    INTPOL_TIME_ALL(atm->time[ip], atm->p[ip], atm->lon[ip], atm->lat[ip]);
 
    /* 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_zeta_dot, atm->q[ctl->qnt_zeta_dot][ip]);
    SET_ATM(qnt_eta, atm->q[ctl->qnt_eta][ip]);
    SET_ATM(qnt_eta_dot, atm->q[ctl->qnt_eta_dot][ip]);
    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));
 
  /* 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;
 
  /* Get indices... */
#ifdef _OPENACC
#pragma acc enter data create(ixs[0:np],iys[0:np],izs[0:np])
#pragma acc data present(ctl,clim,atm,ixs,iys,izs)
#pragma acc parallel loop independent gang vector
#else
#pragma omp parallel for default(shared)
#endif
  for (int ip = 0; ip < np; ip++) {
    ixs[ip] = (int) ((atm->lon[ip] - ctl->mixing_lon0) / dlon);
    iys[ip] = (int) ((atm->lat[ip] - ctl->mixing_lat0) / dlat);
    izs[ip] = (int) ((Z(atm->p[ip]) - ctl->mixing_z0) / dz);
    if (atm->time[ip] < t0 || atm->time[ip] > t1
        || ixs[ip] < 0 || ixs[ip] >= ctl->mixing_nx
        || iys[ip] < 0 || iys[ip] >= ctl->mixing_ny
        || izs[ip] < 0 || izs[ip] >= ctl->mixing_nz)
      izs[ip] = -1;
  }
 
  /* 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, clim, atm, ixs, iys, izs, quantities[i],
                         use_ensemble);
 
  /* Free... */
#ifdef _OPENACC
#pragma acc exit data delete(ixs,iys,izs)
#endif
  free(ixs);
  free(iys);
  free(izs);
}
 
/*****************************************************************************/
 
void module_mixing_help(
  const ctl_t *ctl,
  const clim_t *clim,
  atm_t *atm,
  const int *ixs,
  const int *iys,
  const int *izs,
  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));
  int *restrict const count =
    (int *) malloc((size_t) total_grid * sizeof(int));
 
  /* Init... */
#ifdef _OPENACC
#pragma acc enter data create(cmean[0:total_grid],count[0:total_grid])
#pragma acc data present(ctl,clim,atm,ixs,iys,izs,cmean,count)
#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++) {
    count[i] = 0;
    cmean[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;
      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] += atm->q[qnt_idx][ip];
#ifdef _OPENACC
#pragma acc atomic update
#endif
      count[idx]++;
    }
 
  /* 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 (count[i] > 0)
      cmean[i] /= count[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;
 
      double mixparam = 1.0;
      if (ctl->mixing_trop < 1 || ctl->mixing_strat < 1) {
        const double w = tropo_weight(ctl, clim, atm, ip);
        mixparam = w * ctl->mixing_trop + (1.0 - w) * ctl->mixing_strat;
      }
 
      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;
    }
  }
 
  /* Free... */
#ifdef _OPENACC
#pragma acc exit data delete(cmean,count)
#endif
  free(cmean);
  free(count);
}
 
/*****************************************************************************/
 
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) {
 
  /* 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... */
    if (atm->p[ip] < met0->p[met0->np - 1]) {
      atm->p[ip] = met0->p[met0->np - 1];
    } else if (atm->p[ip] > 300.) {
      INTPOL_2D(ps, 1);
      if (atm->p[ip] > 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) / (3.8235 * 86400.0);
  const double lambda_pb210 = log(2.0) / (22.3 * 365.25 * 86400.0);
  const double lambda_be7 = log(2.0) / (53.22 * 86400.0);
  const double lambda_cs137 = log(2.0) / (30.05 * 365.25 * 86400.0);
  const double lambda_i131 = log(2.0) / (8.02 * 86400.0);
  const double lambda_xe133 = log(2.0) / (5.2474 * 86400.0);
 
  /* 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_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,
  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,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... */
  module_sort_help(atm->time, p, np);
  module_sort_help(atm->p, p, np);
  module_sort_help(atm->lon, p, np);
  module_sort_help(atm->lat, p, np);
  for (int iq = 0; iq < ctl->nq; iq++)
    module_sort_help(atm->q[iq], p, np);
 
  /* Free... */
#ifdef _OPENACC
#pragma acc exit data delete(a,p)
#endif
  free(a);
  free(p);
}
 
/*****************************************************************************/
 
void module_sort_help(
  double *a,
  const int *p,
  const int np) {
 
  /* Allocate... */
  double *restrict const help =
    (double *) malloc((size_t) np * sizeof(double));
  if (help == NULL)
    ERRMSG("Out of memory!");
 
  /* Reordering of array... */
#ifdef _OPENACC
#pragma acc enter data create(help[0:np])
#pragma acc data present(a,p,help)
#pragma acc parallel loop independent gang vector
#else
#pragma omp parallel for default(shared)
#endif
  for (int ip = 0; ip < np; ip++)
    help[ip] = a[p[ip]];
#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] = help[ip];
 
  /* Free... */
#ifdef _OPENACC
#pragma acc exit data delete(help)
#endif
  free(help);
}
 
/*****************************************************************************/
 
void module_timesteps(
  const ctl_t *ctl,
  cache_t *cache,
  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... */
#ifndef DD
    int dd = 1;
#else
    int dd = 0;
#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_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(3.30e-10, 0, 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(2.30e-10, 0, 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(1.40e-10, -25, 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(1.19e-10, -20, 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 > 273.15)
        eta = 1;
      else if (t <= 238.15)
        eta = ctl->wet_depo_ic_ret_ratio;
      else
        eta = LIN(273.15, 1, 238.15, 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. / 298.15));
 
        /* 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 = 1.23e-2 * exp(2.01e3 * (1. / t - 1. / 298.15));
          const double K_2 = 6e-8 * exp(1.12e3 * (1. / t - 1. / 298.15));
          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 > 270)
        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. / 298.15));
 
        /* 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,
  dd_t **dd) {
 
  /* Initialize GPU... */
#ifdef _OPENACC
  SELECT_TIMER("ACC_INIT", "INIT");
  int rank = 0;
#ifdef MPI
  MPI_Comm_rank(MPI_COMM_WORLD, &rank);
#endif
  if (acc_get_num_devices(acc_device_nvidia) <= 0)
    ERRMSG("Not running on a GPU device!");
  acc_set_device_num(rank % acc_get_num_devices(acc_device_nvidia),
                     acc_device_nvidia);
  acc_device_t device_type = acc_get_device_type();
  acc_init(device_type);
#endif
 
  /* Allocate... */
  SELECT_TIMER("ALLOC", "MEMORY");
  ALLOC(*ctl, ctl_t, 1);
  ALLOC(*cache, cache_t, 1);
  ALLOC(*clim, clim_t, 1);
  ALLOC(*met0, met_t, 1);
  ALLOC(*met1, met_t, 1);
  ALLOC(*atm, atm_t, 1);
  ALLOC(*dd, dd_t, 1);
 
  /* Create data region on GPU... */
#ifdef _OPENACC
  SELECT_TIMER("CREATE_DATA_REGION", "MEMORY");
  ctl_t *ctlup = *ctl;
  cache_t *cacheup = *cache;
  clim_t *climup = *clim;
  met_t *met0up = *met0;
  met_t *met1up = *met1;
  atm_t *atmup = *atm;
#pragma acc enter data create(ctlup[:1],cacheup[:1],climup[:1],met0up[:1],met1up[:1],atmup[:1])
#ifdef DD
  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,
  dd_t *dd) {
 
  /* Delete data region on GPU... */
#ifdef _OPENACC
  SELECT_TIMER("DELETE_DATA_REGION", "MEMORY");
#pragma acc exit data delete(ctl,cache,clim,met0,met1,atm)
#ifdef DD
#pragma acc exit data delete(dd)
#endif
#endif
 
  /* Free... */
  SELECT_TIMER("FREE", "MEMORY");
  free(atm);
  free(ctl);
  free(cache);
  free(clim);
  free(met0);
  free(met1);
 
  /* Free MPI datatype... */
#ifdef DD
  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,
  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);
}
 
/*****************************************************************************/
 
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_zeta = -1;
  ctl->qnt_zeta_d = -1;
  ctl->qnt_zeta_dot = -1;
  ctl->qnt_eta = -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_subdomain = -1;
  ctl->qnt_destination = -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_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_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_subdomain, "subdomain", "current subdomain index", "-")
      SET_QNT(qnt_destination, "destination",
              "subdomain index of destination", "-")
      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->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!");
 
  /* 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);
  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_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);
  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);
 
  /* 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);
  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] = 1.3e-2;
    ctl->wet_depo_ic_h[1] = ctl->wet_depo_bc_h[1] = 2900.0;
  }
 
  /* 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);
 
  /* 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_trop =
    scan_ctl(filename, argc, argv, "MIXING_TROP", -1, "-999", NULL);
  ctl->mixing_strat =
    scan_ctl(filename, argc, argv, "MIXING_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);
 
  /* 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);
 
  /* 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 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);
 
  /* Output of ensemble data... */
  ctl->nens = (int) scan_ctl(filename, argc, argv, "NENS", -1, "0", NULL);
  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);
 
  /* 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);
 
  /* 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... */
  ctl->dd = (int) scan_ctl(filename, argc, argv, "DD", -1, "0", NULL);
  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);
  if (ctl->dd_subdomains_zonal * ctl->dd_subdomains_meridional > 1)
    ctl->dd = 1;
  else if (ctl->dd == 1)
    ERRMSG("Please provide zonal and meridional subdomain numbers!");
  ctl->dd_halos_size =
    (int) scan_ctl(filename, argc, argv, "DD_HALOS_SIZE", -1, "1", NULL);
}
 
/*****************************************************************************/
 
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);
 
  /* Set rank... */
  int rank = 0;
#ifdef MPI
  if (ctl->met_mpi_share)
    MPI_Comm_rank(MPI_COMM_WORLD, &rank);
#endif
 
  /* Check rank... */
  if (!ctl->met_mpi_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... */
#ifndef DD
      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 (ctl->met_mpi_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,
  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->sort_dt > 0 && fmod(t, ctl->sort_dt) == 0)
    module_sort(ctl, *met0, atm);
 
  /* Check positions (initial)... */
  module_position(cache, *met0, *met1, atm);
 
  /* 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);
 
  /* 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_trop >= 0 && ctl->mixing_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... */
  if (ctl->dd) {
#ifdef DD
    module_dd(ctl, cache, dd, atm, met0);
#else
    ERRMSG("Code was compiled without DD!");
 
    /* This will never execute, hack to avoid compilation error... */
    LOG(3, "%d", dd->nx_glob);
#endif
  }
 
  /* 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,
  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);
 
  /* Update host... */
  if ((ctl->atm_basename[0] != '-' && fmod(t, ctl->atm_dt_out) == 0)
      || (ctl->grid_basename[0] != '-' && fmod(t, ctl->grid_dt_out) == 0)
      || (ctl->ens_basename[0] != '-' && fmod(t, ctl->ens_dt_out) == 0)
      || ctl->csi_basename[0] != '-' || ctl->prof_basename[0] != '-'
      || ctl->sample_basename[0] != '-' || ctl->stat_basename[0] != '-'
      || (ctl->vtk_basename[0] != '-' && fmod(t, ctl->vtk_dt_out) == 0))
    mptrac_update_host(NULL, NULL, NULL, NULL, NULL, atm);
 
  /* Write atmospheric data... */
  if (ctl->atm_basename[0] != '-' &&
      (fmod(t, ctl->atm_dt_out) == 0 || t == ctl->t_stop)) {
    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 (ctl->grid_basename[0] != '-' && fmod(t, ctl->grid_dt_out) == 0) {
    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 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 (ctl->ens_basename[0] != '-' && fmod(t, ctl->ens_dt_out) == 0) {
    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 (ctl->vtk_basename[0] != '-' && fmod(t, ctl->vtk_dt_out) == 0) {
    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 varible... */
  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], 0.286);
        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, 0.286);
        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, 0.286);
      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 'naive', i.e. equidistant lat-lon domain decomposition... */
    read_met_nc_grid_dd_naive(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] / 100000.0 + 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, "lnsp", "LNSP", NULL, NULL, NULL, NULL, 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, "ps", "PS", "sp", "SP", NULL, NULL, 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, "z", "Z", NULL, NULL, NULL, NULL, ctl, met, dd, met->zs,
         (float) (1. / (1000. * G0)), 1))
      if (!read_met_nc_2d
          (ncid, "zm", "ZM", NULL, NULL, NULL, NULL, ctl, met, dd, met->zs,
           (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, "gph", "GPH", NULL, NULL, ctl, met, dd, met->pl,
         (float) (1e-3 / G0)))
      ERRMSG("Cannot read geopotential height!");
    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, "t2m", "T2M", "2t", "2T", "t2", "T2", 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, "u10m", "U10M", "10u", "10U", "u10", "U10", 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, "v10m", "V10M", "10v", "10V", "v10", "V10", 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, "iews", "IEWS", NULL, NULL, NULL, NULL, 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, "inss", "INSS", NULL, NULL, NULL, NULL, ctl, met, dd, met->nss,
       1.0, 1))
    WARN("Cannot read nothward turbulent surface stress!");
 
  /* Read surface sensible heat flux... */
  if (!read_met_nc_2d
      (ncid, "ishf", "ISHF", NULL, NULL, NULL, NULL, 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, "lsm", "LSM", NULL, NULL, NULL, NULL, ctl, met, dd, met->lsm,
       1.0, 1))
    WARN("Cannot read land-sea mask!");
 
  /* Read sea surface temperature... */
  if (!read_met_nc_2d
      (ncid, "sstk", "SSTK", "sst", "SST", NULL, NULL, 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, "blp", "BLP", NULL, NULL, NULL, NULL, 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, "blh", "BLH", NULL, NULL, NULL, NULL, 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, "cape", "CAPE", NULL, NULL, NULL, NULL, 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, "cin", "CIN", NULL, NULL, NULL, NULL, 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, "t", "T", "temp", "TEMP", ctl, met, dd, met->t, 1.0))
    ERRMSG("Cannot read temperature!");
 
  /* Read horizontal wind and vertical velocity... */
  if (!read_met_nc_3d(ncid, "u", "U", NULL, NULL, ctl, met, dd, met->u, 1.0))
    ERRMSG("Cannot read zonal wind!");
  if (!read_met_nc_3d(ncid, "v", "V", NULL, NULL, ctl, met, dd, met->v, 1.0))
    ERRMSG("Cannot read meridional wind!");
  if (!read_met_nc_3d
      (ncid, "w", "W", "omega", "OMEGA", 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, "q", "Q", "sh", "SH", ctl, met, dd, met->h2o,
         (float) (MA / MH2O)))
      WARN("Cannot read specific humidity!");
  } else {
    if (!read_met_nc_3d
        (ncid, "rh", "RH", NULL, NULL, 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, "o3", "O3", NULL, NULL, ctl, met, dd, met->o3,
       (float) (MA / MO3)))
    WARN("Cannot read ozone data!");
 
  /* Read cloud data... */
  if (!read_met_nc_3d
      (ncid, "clwc", "CLWC", NULL, NULL, ctl, met, dd, met->lwc, 1.0))
    WARN("Cannot read cloud liquid water content!");
  if (!read_met_nc_3d
      (ncid, "crwc", "CRWC", NULL, NULL, ctl, met, dd, met->rwc, 1.0))
    WARN("Cannot read cloud rain water content!");
  if (!read_met_nc_3d
      (ncid, "ciwc", "CIWC", NULL, NULL, ctl, met, dd, met->iwc, 1.0))
    WARN("Cannot read cloud ice water content!");
  if (!read_met_nc_3d
      (ncid, "cswc", "CSWC", NULL, NULL, ctl, met, dd, met->swc, 1.0))
    WARN("Cannot read cloud snow water content!");
  if (!read_met_nc_3d
      (ncid, "cc", "CC", NULL, NULL, 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, "ZETA", "zeta", NULL, NULL, ctl, met, dd, met->zetal, 1.0))
      WARN("Cannot read ZETA!");
    if (!read_met_nc_3d
        (ncid, "ZETA_DOT_TOT", "ZETA_DOT_clr", "zeta_dot_clr",
         NULL, ctl, met, dd, met->zeta_dotl, 0.00001157407f))
      WARN("Cannot read ZETA_DOT!");
  }
 
  /* Read eta and eta_dot... */
  else if (ctl->advect_vert_coord == 3) {
#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] / 100000.0 + met->hybm[ip]);
    if (!read_met_nc_3d
        (ncid, "etadot", "ETADOT", NULL, NULL, ctl, met, dd, met->zeta_dotl,
         1.0))
      WARN("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, "pl", "PL", "pressure", "PRESSURE", ctl, met, dd, met->pl,
           0.01f))
        if (!read_met_nc_3d
            (ncid, "press", "PRESS", NULL, NULL, 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!");
}
 
/*****************************************************************************/
 
int read_met_nc_2d(
  const int ncid,
  const char *varname,
  const char *varname2,
  const char *varname3,
  const char *varname4,
  const char *varname5,
  const char *varname6,
  const ctl_t *ctl,
  const met_t *met,
  dd_t *dd,
  float dest[EX][EY],
  const float scl,
  const int init) {
 
  char varsel[LEN];
 
  float offset, scalfac;
 
  int varid;
 
  /* Check if variable exists... */
  if (nc_inq_varid(ncid, varname, &varid) == NC_NOERR)
    sprintf(varsel, "%s", varname);
  else if (varname2 != NULL
           && nc_inq_varid(ncid, varname2, &varid) == NC_NOERR)
    sprintf(varsel, "%s", varname2);
  else if (varname3 != NULL
           && nc_inq_varid(ncid, varname3, &varid) == NC_NOERR)
    sprintf(varsel, "%s", varname3);
  else if (varname4 != NULL
           && nc_inq_varid(ncid, varname4, &varid) == NC_NOERR)
    sprintf(varsel, "%s", varname4);
  else if (varname5 != NULL
           && nc_inq_varid(ncid, varname5, &varid) == NC_NOERR)
    sprintf(varsel, "%s", varname5);
  else if (varname6 != NULL
           && nc_inq_varid(ncid, varname6, &varid) == NC_NOERR)
    sprintf(varsel, "%s", varname6);
  else
    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);
 
    /* 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... */
#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));
 
    /* 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);
    }
 
    /* Free... */
    free(help);
    free(help_halo);
  }
 
  /* Return... */
  return 1;
}
 
/*****************************************************************************/
 
int read_met_nc_3d(
  const int ncid,
  const char *varname,
  const char *varname2,
  const char *varname3,
  const char *varname4,
  const ctl_t *ctl,
  const met_t *met,
  dd_t *dd,
  float dest[EX][EY][EP],
  const float scl) {
 
  char varsel[LEN];
 
  float offset, scalfac;
 
  int varid;
 
  /* Check if variable exists... */
  if (nc_inq_varid(ncid, varname, &varid) == NC_NOERR)
    sprintf(varsel, "%s", varname);
  else if (varname2 != NULL
           && nc_inq_varid(ncid, varname2, &varid) == NC_NOERR)
    sprintf(varsel, "%s", varname2);
  else if (varname3 != NULL
           && nc_inq_varid(ncid, varname3, &varid) == NC_NOERR)
    sprintf(varsel, "%s", varname3);
  else if (varname4 != NULL
           && nc_inq_varid(ncid, varname4, &varid) == NC_NOERR)
    sprintf(varsel, "%s", varname4);
  else
    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);
 
    /* 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 */
#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 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]);
 
    /* Halo read also uses independent access */
#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));
 
    /* 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);
    }
 
    /* 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;
 
  /* Open file... */
#ifdef DD
  if (ctl->dd) {
    NC(nc_open_par
       (filename, NC_NOWRITE | NC_SHARE, MPI_COMM_WORLD, MPI_INFO_NULL,
        &ncid))
  }
#else
  if (nc_open(filename, NC_NOWRITE, &ncid) != NC_NOERR) {
    WARN("Cannot open file!");
    return 0;
  }
#endif
 
  /* 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);
 
  /* 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);
 
  /* Close file... */
  NC(nc_close(ncid));
 
  /* Return success... */
  return 1;
}
 
/*****************************************************************************/
 
void read_met_nc_grid_dd_naive(
  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;
 
  /* 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] =
      (size_t) met->ny +
      (size_t) ctl->dd_halos_size * ((top || bottom) ? 1 : 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], 0.286);
 
  /* 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 * 7.2921e-5 * 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 * 7.2921e-5 * 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 / 2.1415e-5);
    }
}
 
/*****************************************************************************/
 
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) {
          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 * 4.8096e-26));
 
  /* 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_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;
 
    /* Calculate indices... */
    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 < 0 || ix >= ctl->csi_nx || iy < 0 || iy >= ctl->csi_ny || iz < 0
        || 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!");
 
    /* Get indices... */
    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) ((Z(atm->p[ip]) - ctl->csi_z0) / dz);
    if (ix < 0 || ix >= ctl->csi_nx || iy < 0 || iy >= ctl->csi_ny || iz < 0
        || 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_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++) {
    ixs[ip] = (int) ((atm->lon[ip] - ctl->grid_lon0) / dlon);
    iys[ip] = (int) ((atm->lat[ip] - ctl->grid_lat0) / dlat);
    izs[ip] = (int) ((Z(atm->p[ip]) - ctl->grid_z0) / dz);
    if (atm->time[ip] < t0 || atm->time[ip] > t1
        || ixs[ip] < 0 || ixs[ip] >= ctl->grid_nx
        || iys[ip] < 0 || iys[ip] >= ctl->grid_ny
        || izs[ip] < 0 || 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!");
  if (strcmp(ctl->met_comp_logfile, "-") != 0) {
    /* Open diagnostics file... */
    if (!(level_log = fopen(ctl->met_comp_logfile, "w")))
      ERRMSG("Cannot create compression log file!");
    compress_log_header(level_log);
    LOG(1, "Write compression diagnostics: %s", ctl->met_comp_logfile);
  }
 
  /* 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[2] = { latid, lonid };
  NC_DEF_VAR("sp", NC_FLOAT, 2, dimid2, "Surface pressure", "Pa",
             ctl->met_nc_level, 0);
  NC_DEF_VAR("z", NC_FLOAT, 2, dimid2, "Geopotential", "m**2 s**-2",
             ctl->met_nc_level, 0);
  NC_DEF_VAR("t2m", NC_FLOAT, 2, dimid2, "2 metre temperature", "K",
             ctl->met_nc_level, 0);
  NC_DEF_VAR("u10m", NC_FLOAT, 2, dimid2, "10 metre U wind component",
             "m s**-1", ctl->met_nc_level, 0);
  NC_DEF_VAR("v10m", NC_FLOAT, 2, dimid2, "10 metre V wind component",
             "m s**-1", ctl->met_nc_level, 0);
  NC_DEF_VAR("iews", NC_FLOAT, 2, dimid2,
             "Instantaneous eastward turbulent surface stress", "N m**-2",
             ctl->met_nc_level, 0);
  NC_DEF_VAR("inss", NC_FLOAT, 2, dimid2,
             "Instantaneous northward turbulent surface stress", "N m**-2",
             ctl->met_nc_level, 0);
  NC_DEF_VAR("ishf", NC_FLOAT, 2, dimid2,
             "Instantaneous surface sensible heat flux", "W m**-2",
             ctl->met_nc_level, 0);
  NC_DEF_VAR("lsm", NC_FLOAT, 2, dimid2, "Land/sea mask", "-",
             ctl->met_nc_level, 0);
  NC_DEF_VAR("sstk", NC_FLOAT, 2, dimid2, "Sea surface temperature", "K",
             ctl->met_nc_level, 0);
  NC_DEF_VAR("blp", NC_FLOAT, 2, dimid2, "Boundary layer pressure", "Pa",
             ctl->met_nc_level, 0);
  NC_DEF_VAR("pt", NC_FLOAT, 2, dimid2, "Tropopause pressure", "Pa",
             ctl->met_nc_level, 0);
  NC_DEF_VAR("tt", NC_FLOAT, 2, dimid2, "Tropopause temperature", "K",
             ctl->met_nc_level, 0);
  NC_DEF_VAR("zt", NC_FLOAT, 2, dimid2, "Tropopause height", "m",
             ctl->met_nc_level, 0);
  NC_DEF_VAR("h2ot", NC_FLOAT, 2, dimid2, "Tropopause water vapor", "ppv",
             ctl->met_nc_level, 0);
  NC_DEF_VAR("pct", NC_FLOAT, 2, dimid2, "Cloud top pressure", "Pa",
             ctl->met_nc_level, 0);
  NC_DEF_VAR("pcb", NC_FLOAT, 2, dimid2, "Cloud bottom pressure", "Pa",
             ctl->met_nc_level, 0);
  NC_DEF_VAR("cl", NC_FLOAT, 2, dimid2, "Total column cloud water",
             "kg m**2", ctl->met_nc_level, 0);
  NC_DEF_VAR("plcl", NC_FLOAT, 2, dimid2,
             "Pressure at lifted condensation level (LCL)", "Pa",
             ctl->met_nc_level, 0);
  NC_DEF_VAR("plfc", NC_FLOAT, 2, dimid2,
             "Pressure at level of free convection (LFC)", "Pa",
             ctl->met_nc_level, 0);
  NC_DEF_VAR("pel", NC_FLOAT, 2, dimid2,
             "Pressure at equilibrium level (EL)", "Pa", ctl->met_nc_level,
             0);
  NC_DEF_VAR("cape", NC_FLOAT, 2, dimid2,
             "Convective available potential energy", "J kg**-1",
             ctl->met_nc_level, 0);
  NC_DEF_VAR("cin", NC_FLOAT, 2, dimid2, "Convective inhibition",
             "J kg**-1", ctl->met_nc_level, 0);
  NC_DEF_VAR("o3c", NC_FLOAT, 2, dimid2, "Total column ozone", "DU",
             ctl->met_nc_level, 0);
 
  /* Define level data... */
  int dimid3[3] = { levid, latid, lonid };
  NC_DEF_VAR("t", NC_FLOAT, 3, dimid3, "Temperature", "K",
             ctl->met_nc_level, ctl->met_nc_quant);
  NC_DEF_VAR("u", NC_FLOAT, 3, dimid3, "U velocity", "m s**-1",
             ctl->met_nc_level, ctl->met_nc_quant);
  NC_DEF_VAR("v", NC_FLOAT, 3, dimid3, "V velocity", "m s**-1",
             ctl->met_nc_level, ctl->met_nc_quant);
  NC_DEF_VAR("w", NC_FLOAT, 3, dimid3, "Vertical velocity", "Pa s**-1",
             ctl->met_nc_level, ctl->met_nc_quant);
  NC_DEF_VAR("q", NC_FLOAT, 3, dimid3, "Specific humidity", "kg kg**-1",
             ctl->met_nc_level, ctl->met_nc_quant);
  NC_DEF_VAR("o3", NC_FLOAT, 3, dimid3, "Ozone mass mixing ratio",
             "kg kg**-1", ctl->met_nc_level, ctl->met_nc_quant);
  NC_DEF_VAR("clwc", NC_FLOAT, 3, dimid3, "Cloud liquid water content",
             "kg kg**-1", ctl->met_nc_level, ctl->met_nc_quant);
  NC_DEF_VAR("crwc", NC_FLOAT, 3, dimid3, "Cloud rain water content",
             "kg kg**-1", ctl->met_nc_level, ctl->met_nc_quant);
  NC_DEF_VAR("ciwc", NC_FLOAT, 3, dimid3, "Cloud ice water content",
             "kg kg**-1", ctl->met_nc_level, ctl->met_nc_quant);
  NC_DEF_VAR("cswc", NC_FLOAT, 3, dimid3, "Cloud snow water content",
             "kg kg**-1", ctl->met_nc_level, ctl->met_nc_quant);
  NC_DEF_VAR("cc", NC_FLOAT, 3, 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;
 
    /* Calculate indices... */
    const int ix = (int) ((rlon[i] - ctl->prof_lon0) / dlon);
    const int iy = (int) ((rlat[i] - ctl->prof_lat0) / dlat);
 
    /* Check indices... */
    if (ix < 0 || ix >= ctl->prof_nx || iy < 0 || 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;
 
    /* Get indices... */
    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) ((Z(atm->p[ip]) - ctl->prof_z0) / dz);
 
    /* Check indices... */
    if (ix < 0 || ix >= ctl->prof_nx ||
        iy < 0 || iy >= ctl->prof_ny || iz < 0 || 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;
 
  /* 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;
 
    /* 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");
  }
 
  /* 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);
}