diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 1bd21522268648e6377825b148a2fbb4e7cb3741..a678ab53078f12fa0fd797eb4ea60aa217fe4056 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -61,6 +61,22 @@ options-test: - ./tests/output_bkw_eta expire_in: 5 mins +nests-test: + # image: harbor.wolke.img.univie.ac.at/flexpart/almalinux8:latest + image: harbor.wolke.img.univie.ac.at/flexpart/rockylinux9:latest + stage: test + when: manual + needs: + - alma8-build + - rocky9-build + + script: + - ulimit -s unlimited + - bash ./tests/run_nests_test.sh + artifacts: + when: on_success + paths: + openmp-simulation: # image: harbor.wolke.img.univie.ac.at/flexpart/almalinux8:latest image: harbor.wolke.img.univie.ac.at/flexpart/rockylinux9:latest @@ -155,3 +171,10 @@ etex-test: paths: - ./tests/etex_test.txt expire_in: never + +documentation: + image: harbor.wolke.img.univie.ac.at/podman/mkdocs-computer:latest + stage: build + script: + - cd ./documentation && mkdocs build -c --verbose + - sshpass -p "$WOLKE_PASSWORD" rsync -autv --delete -e "ssh -o StrictHostKeyChecking=no" /tmp/cr-site/* "$WOLKE_USER@wolke.img.univie.ac.at:/var/www/html/documentation/flexpart" \ No newline at end of file diff --git a/documentation/docs/LCM.md b/documentation/docs/LCM.md new file mode 100644 index 0000000000000000000000000000000000000000..cd860b7beb72c64e028f037617eb54d5d0310425 --- /dev/null +++ b/documentation/docs/LCM.md @@ -0,0 +1,31 @@ +# Linear Chemistry Module +The Linear Chemistry Module (LCM) is based on the initial work of [Henne et al.](https://doi.org/10.5281/zenodo.1249190) who developed the FLEXPART-CTM model from FLEXPART 8, and was first described in [Groot Zwaaftink et al.](https://gmd.copernicus.org/articles/11/4469/2018/). This model was an extension of the domain-filling capability of FLEXPART and added the possibility to initialise particles' mixing ratio from pre-defined fields, account for the influence of surface fluxes and simple linear chemistry on the particles' mass, and sample the particle mixing ratios at user-defined receptor locations. + +## How to run LCM +To run the LCM the following OPTIONS files are used and need to be edited (see also the Appendix for example OPTIONS files): + +1. COMMAND: choose the following options: + - LDIRECT= 1 (forward simulation) + - MDOMAINFILL = 1 (domain-filling mode) + - IND_SOURCE = 1 (releases units of mass) + - IND_RECEPTOR = 1 (receptor units of mass) + - LCMOUTPUT = 1 (uses the LCM initialization and output formats) + +2. RELEASES: specify the following: + - NSPEC: number of species including the mandatory species AIRTRACER + - SPECNUM_REL: species number in the directory SPECIES (note AIRTRACER must be the first species) + - LON1: left longitude of release box for global domain + - LON2: right longitude of release box for global domain + - LAT1: lower latitude of release box for global domain + - LAT2: upper latitude of release box for global domain + - PARTS: total number of particles to be used + +- INITCONC: specifies input for initializing the mixing ratios + +- OUTGRID: specifies the domain and vertical levels for the gridded output + +- REAGENTS (optional): specifies chemical reagents for reactions (the corresponding rate constants are given in the SPECIES files) + +- RECEPTORS (optional): specifies the locations and times of receptors where mixing ratios should be output. + +- SATELLITES (optional): specifies paths and input file names of satellite retrievals for which mixing ratios should be output. \ No newline at end of file diff --git a/documentation/docs/installation.md b/documentation/docs/building.md similarity index 76% rename from documentation/docs/installation.md rename to documentation/docs/building.md index 3e241d57a215df0bc324b4a0e3795590fe79556b..0eccace55fce84ae84100ff5468f3ccf17dda6fd 100644 --- a/documentation/docs/installation.md +++ b/documentation/docs/building.md @@ -1,4 +1,4 @@ -# Installation +# Building ## Download FLEXPART There are two options to download _FLEXPART_: @@ -21,7 +21,7 @@ _FLEXPART_ 11 is written in Fortran 2018. The following compilers can be used to - GNU Fortran compiler version 8+ (`gfortran`) - Intel Fortran compiler (`ifort`) -For running _FLEXPART_ in parallel mode, a compiler supporting [OpenMP](https://www.openmp.org/) is required. +For running _FLEXPART_ in parallel mode, a compiler supporting [OpenMP](https://www.openmp.org/) is required. In addition, libraries (in particular hdf5) should be compiled threadsafe. ## Libraries _FLEXPART_ uses the following libraries: @@ -37,10 +37,12 @@ These libraries are usually available as packages in most Linux distributions an ## Parameters Before compiling FLEXPART, you might want to change parameters defined in par_mod.f90 -- `wind_coord_type`: for ECMWF meteorological data, you can set this to ETA to use the native eta coordinate system. Otherwise, set this to METER. -- `mesoscale_turbulence`: by default the mesocale turbulence is switched off, but can be switched on setting this variable to .true. -- `max_partoutput_filesize`: maximum output of each partoutput NetCDF-4 file in Mb before a new one is created. -- `max_numthreads_grid`: when using many openmp threads and gridded output (IOUT>0 in COMMAND option file), this variable sets a maximum on how many threads are used for doing the reductions on the grid. A high number can result in a significant increase in RAM usage. +- `dp`, `sp`, `dep_prec`: Setting the precision of the simulation. +- `lusekerneloutput`: Switch for using a kernel for calculating concentrations/deposition. Default: **True**. +- `lparticlecountoutput`: Switch to set output units to number of particles per grid cell. Default: **False**. +- `numpf`: Number of precipitation fields read by the executable. This should correspond with the number of precipitation fields present in the meteorological data. Default: **1**. +- `lpartoutputperfield`: When using particle output (IPOUT=1), this switch sets if all selected fields are written to one netcdf file or a separate one for each field. +- Many parameters that govern the different parameter schemes within FLEXPART. ## <a name="compiling"></a>Compiling FLEXPART _FLEXPART_ is compiled with [make](https://www.gnu.org/software/make/), which uses the makefile in the `src` subdirectory. Starting from the root directory, you can then compile _FLEXPART_ with the following steps: diff --git a/documentation/docs/configuration.md b/documentation/docs/configuration.md new file mode 100644 index 0000000000000000000000000000000000000000..42569e3afddc33007d00344646de115d7d30a2c1 --- /dev/null +++ b/documentation/docs/configuration.md @@ -0,0 +1,362 @@ +# Configuration +To run FLEXPART, there are three important (sets) of files that need to be specified. +These are: + +- the [**option files**](configuration.md#options), defining the set-up of the run, +- the [**pathnames file**](configuration.md#pathnames), defining the paths of where input and output are located, +- the [**AVAILABLE file**](configuration.md#available), listing all available meteorological input, + +Of course, there is also the **par_mod.f90** file, which needs to be specified before compiling (see [**Compiling FLEXPART**](building.md#compliling), but the parameters in this file are expected to not have to be changed between simulations. + +In addition to the regular input files listed above, a simulation can also be started using a NetCDF file listing all particles to be released. This option can be switched on by specifying IPIN=3 in the COMMAND option file. More information about how to use this option can be found here: [User-defined initial conditions](configuration.md#ic). + +When wanting to restart a previous simulation, see [restarting a simulation](configuration.md#restart). + +## <a name="options"></a>Option files +These files define the simulation settings. At the start of a simulation, a copy of each file will be written to the output directory defined in the [**pathnames file**](configuration.md#pathnames). +All option files should be presented as namelists (i.e. &OPTIONFILE). A template of these files can be found in the options/ directory within the repository. + +Inside the `options/` directory a template of all option files can be found: + +- [COMMAND](configuration.md#command) +- [RELEASES](configuration.md#releases) +- [SPECIES](configuration.md#species) +- [OUTGRID](configuration.md#outgrid) +- [OUTGRID_NESTED](configuration.md#outgrid_nested) +- [AGECLASSES](configuration.md#ageclasses) +- [INITCONC (optional)](configuration.md#initconc) +- [RECEPTORS (optional)](configuration.md#receptors) +- [PARTOPTIONS (optional)](configuration.md#partoptions) +- [REAGENTS (optional)](configuration.md#reagents) +- [SATELLITES (optional)](configuration.md#satellites) + +### <a name="command"></a>COMMAND +Sets the behaviour of the run (time range, backward or forward, output frequency, etc.). A table of all options is listed below. + +- **Time variables**: Flexpart can be run in forward or backward mode. In forward mode, particles are being traced forward in time, while in backward more, the origin of particles are being traced, going backward in time. This can be set by the [LDIRECT](configuration.md#ldirect) variable. The start and end of the simulation are set by [IBDATE](configuration.md#IBDATE):[IBTIME](configuration.md#IBTIME) and [IEDATE](configuration.md#IEDATE):[IETIME](configuration.md#IETIME). [IEDATE](configuration.md#IEDATE):[IETIME](configuration.md#IETIME) is always at a later time than [IBDATE](configuration.md#IBDATE):[IBTIME](configuration.md#IBTIME), also for backwards simulations. Output variables can be written at specified times: [LOUTSTEP](configuration.md#LOUTSTEP), and restart files will be written at every [LOUTRESTART](configuration.md#LOUTRESTART) interval. +- **Numerical variables**: [LSYNCTIME](configuration.md#LSYNCTIME) and LOUTSAMPLE set the integration interval, smaller generally giving better results, although below a certain number, not much will be gained. With the [CTL](configuration.md#CTL) and [IFINE](configuration.md#IFINE) setting, you can make integration steps even smaller for the turbulence computations. +- **Output variables**: The output is written at every [LOUTSTEP](configuration.md#LOUTSTEP) interval. Both gridded data ([IOUT](configuration.md#IOUT)>0) and particle based data ([IPOUT](configuration.md#IPOUT)=1) can be written to NetCDF files (binary option for gridded data). Nested output can be set by the [NESTED_OUTPUT](configuration.md#NESTED_OUTPUT) switched. Note that for gridded output, the [OUTGRID](configuration.md#OUTGRID) for ([IOUT](configuration.md#IOUT)>0) and [OUTGRID_NESTED](configuration.md#OUTGRID_NESTED) (for [NESTED_OUTPUT](configuration.md#NESTED_OUTPUT)=1) option files should be specified. Other output variables can be set in the par_mod.f90 file. Namely, the size of the NetCDF files that contain the particle based data (max_partoutput_filesize). [IND_RECEPTOR](configuration.md#IND_RECEPTOR) can be set to get concentrations or mixing ratios at specified receptor points set in the RECEPTORS options file. For backward simulations, [IND_RECEPTOR](configuration.md#IND_RECEPTOR) can be used to get wet or dry deposition gridded data. [SFC_ONLY](configuration.md#SFC_ONLY) and [LINIT_COND](configuration.md#LINIT_COND) are only working for binary output. +- **Input variables**: IPIN can be set to chose the input type: either initial conditions from particles come from the [RELEASES](configuration.md#releases) file ([IPIN](configuration.md#IPIN)=0), from restart files of a previous run ([IPIN](configuration.md#IPIN)=1), +from a particle netCDF file written in a previous run (only works when the correct fields in [PARTOPTIONS](configuration.md#PARTOPTIONS) are chosen) ([IPIN](configuration.md#IPIN)=2), or from user-defined initial particle conditions ([IPIN](configuration.md#IPIN)=3). [MDOMAINFILL](configuration.md#MDOMAINFILL) can be set to distribute particles according to the air density or stratospheric ozone density profiles. This option overwrites the vertical levels set in the [RELEASES](configuration.md#releases) option file. + +| Variable name | Description | Possible values and **default** (bold) | +| ----------- | ----------- | ----------- | +| <a name="ldirect"></a>LDIRECT | Simulation direction in time | **1 (forward)** or -1 (backward) | +| <a name="IBDATE"></a>IBDATE | Start date of the simulation | YYYYMMDD: YYYY=year, MM=month, DD=day | +| <a name="IBTIME"></a>IBTIME | Start time of the simulation | HHMISS: HH=hours, MI=minutes, SS=seconds. UTC zone. | +| <a name="IEDATE"></a>IEDATE | End date of the simulation | YYYYMMDD: YYYY=year, MM=month, DD=day | +| <a name="IETIME"></a>IETIME | End time of the simulation | HHMISS: HH=hours, MI=minutes, SS=seconds. UTC zone. | +| <a name="LOUTSTEP"></a>LOUTSTEP | Interval of model output. Average concentrations are calculated every LOUTSTEP (seconds) | **10800** | +| <a name="LOUTAVER"></a>LOUTAVER | Concentration averaging interval, instantaneous for value of zero (seconds) | **10800** | +| <a name="LOUTSAMPLE"></a>LOUTSAMPLE | Numerical sampling rate of output, higher statistical accuracy with shorter intervals (seconds) | **900** | +| <a name="LRECOUTSTEP"></a>LRECOUTSTEP | Interval of receptor output. LCM: mixing ratios are calculated every LRECOUTSTEP (seconds) | **LOUTSTEP** | +| <a name="LRECOUTAVER"></a>LRECOUTAVER | Concentration averaging interval for receptors, instantaneous for value of zero (seconds) | **LOUTAVER** | +| <a name="LRECOUTSAMPLE"></a>LRECOUTSAMPLE | Numerical sampling rate of receptor output (seconds) | **LOUTSAMPLE** | +| <a name="LOUTRESTART"></a>LOUTRESTART | Time interval when a restart file is written (seconds) | **-1** | +| <a name="LSYNCTIME"></a>LSYNCTIME | All processes are synchronized to this time interval; all values above should be dividable by this number (seconds) | **900** | +| <a name="CTL"></a>CTL | Factor by which particle transport time step in the ABL must be smaller than the Lagrangian timescale t l ; resulting time steps can be shorter than LSYNCTIME; LSYNCTIME is used if CTL < 0 | **-5.0** | +| <a name="IFINE"></a>IFINE | Additional reduction factor for time step used for vertical transport only considered if CTL > 1 | **4** | +| <a name="IOUT"></a>IOUT | Switch determining the gridded output type | 0 (no gridded output), **1 (forward: mass concentration; backwards: residence time)**, 2 (volume mixing ratio), 3 (1 and 2 combined), 4 (plume trajectories), 5 (1 and 4 combined), Add 8 for NetCDF output | +| <a name="IPOUT"></a>IPOUT | Switch for particle position output | **0 (no particle output)**, 1 (particle output every LOUTSTEP), 2 (particle output at the end of the simulation) | +| <a name="LSUBGRID"></a>LSUBGRID | Increase in ABL heights due to subgrid-scale orographic variations | **0 (off)**, 1 (on) | +| <a name="LCONVECTION"></a>LCONVECTION | Switch for convection parameterization | 0 (off), **1 (on)** | +| <a name="LTURBULENCE"></a>LTURBULENCE | Switch for turbulence parameterization | 0 (off), **1 (on)** | +| <a name="LTURBULENCE_MESO"></a>LTURBULENCE_MESO | Switch for mesoscale turbulence parameterization | **0 (off)**, 1 (on) | +| <a name="LAGESPECTRA"></a>LAGESPECTRA | Switch for calculation of age spectra (needs file [AGECLASSES](configuration.md#ageclasses) option file) | 0 (off), **1 (on)** | +| <a name="IPIN"></a>IPIN | Particle information input. Starting from [RELEASES](configuration.md#releases) option file, form restart.bin, or user-defined particle input data (see Silvia Bucci's stuff) | **0 (using RELEASES option file)**, 1 (using restart.bin file), 2 (using previous partoutput file), 3 (self made initial conditions), 4 (restart.bin and self made initial conditions) | +| <a name="IOUTPUTFOREACHRELEASE"></a>IOUTPUTFOREACHRELEASE | Switch for separate output fields for each location in the [RELEASES](configuration.md#releases) file | 0 (no), **1 (yes)** | +| <a name="IFLUX"></a>IFLUX | Output of mass fluxes through output grid box boundaries (northward, southward, eastward, westward, upward and downward) | 0 (off), **1 (on)** | +| <a name="MDOMAINFILL"></a>MDOMAINFILL | Switch for domain-filling calculations: particles are initialized to reproduce air density or stratospheric ozone density; for limited-area simulations, particles are generated at the domain boundaries | **0 (no)**, 1 (like air density), 2 (stratospheric ozone tracer) | +| <a name="IND_SOURCE"></a>IND_SOURCE | Unit to be used at the source; see Seibert and Frank (2004); Eckhardt et al. (2017) | **1 (mass)**, 2 (mass mixing ratio) | +| <a name="IND_RECEPTOR"></a>IND_RECEPTOR | Unit to be used at the receptor; see Seibert and Frank (2004); Eckhardt et al. (2017) | 0 (no receptor), **1 (mass)**, 2 (mass mixing ratio), 3 (backward only: wet deposition), 4 (backward only: dry depostion) | +| <a name="MQUASILAG"></a>MQUASILAG | Quasi-Lagrangian mode to track individual numbered particles | **0 (off)**, 1 (on) | +| <a name="NESTED_OUTPUT"></a>NESTED_OUTPUT | Switch to produce output also for a nested domain | **0 (no)**, 1 (yes) | +| <a name="LNETCDFOUT"></a>LNETCDFOUT | Switch to produce NetCDF output, overwritten to 1 when IOUT>8 and set to 0 when compiled without NetCDF libraries | 0 (no), **1 (yes)** | +| <a name="LINIT_COND"></a>LINIT_COND | Switch to produce output sensitivity to initial conditions given in concentration or mixing ratio units (in backwards mode only) | **0 (no)**, 1 (mass), 2 (mass mixing ratio) | +| <a name="LCMOUTPUT"></a>LCMOUTPUT | Linear Chemistry Module switch, should be used in combination with LDIRECT=1, MDOMAINFILL=1, IND_SOURCE=1, IND_RECEPTOR=1 | **0 (no)**, 1 (yes) | +| <a name="SFC_ONLY"></a>SFC_ONLY | Output of SRR for fluxes only for the lowest model layer, most useful for backward runs when LINIT_COND set to 1 or 2 | **0 (no)**, 1 (yes) | +| <a name="CBLFLAG"></a>CBLFLAG | Skewed rather than Gaussian turbulence in the convective ABL; when turned on, very short time steps should be used (see CTL and IFINE) | **0 (no)**, 1 (yes) | +| <a name="MAXTHREADGRID"></a>MAXTHREADGRID | Set maximum number of threads for doing grid computations. Recommended to set this to max 16. High numbers create more overhead and a larger memory footprint | **1 (default=no parallelisation on grid)** integer | +| <a name="MAXFILESIZE"></a>MAXFILESIZE | Maximum output of each partoutput NetCDF-4 file in Mb before a new one is created | *10000 (default=10GB)** integer | +| <a name="LOGVERTINTERP"></a>LOGVERTINTERP| Flag to set all vertical interpolation to logarithmic instead of linear | *0=off (default)**, 1=on | + +<br/> + +### <a name="releases"></a>RELEASES +This file contains the information about the particles initial conditions: how many, where and when they will be released, their mass and what species they are (defined in the SPECIES files). +The RELEASES file contains at two types of namelists: + + 1. `&RELEASES_CTRL` namelist, specifying the total number of species and the specific species file associated (see [SPECIES](configuration.md#species)). There is only one of this namelist and it is found at the top of the file. + + 2. `&RELEASE` namelist, specifying for each release, the start and end of the release, the location of the release, and the number of particles that are to be released. + +| Variable name `&RELEASES_CTRL` | Description | Data type | +| ------------- | ----------- | --------- | +|NSPEC | Total number of species | integer | +|SPECNUM_REL | Species numbers in directory SPECIES | integer(s divided by comma's) | + +<br/> +And for each release: + +| Variable name `&RELEASE` | Description | Data type | +| ------------- | ----------- | --------- | +|IDATE1 | Release start date | integer in the form of YYYYMMDD: YYYY=year, MM=month, DD=day| +|ITIME1 | Release start time in UTC | integers in the form of HHMISS: HH hours, MI=minutes, SS=seconds| +|IDATE2 | Release end date | same as IDATE1| +|ITIME2 | Release end time | same as ITIME1| +|LON1 | Left longitude of release box -180 < LON1 <180| real | +|LON2 | Right longitude of release box, same as LON1| real | +|LAT1 | Lower latitude of release box, -90 < LAT1 < 90| real | +|LAT2 | Upper latitude of release box same format as LAT1 | real | +|Z1 | Lower height of release box meters/hPa above reference level| real | +|Z2 | Upper height of release box meters/hPa above reference level| real | +|ZKIND | Reference level | integer: 1=above ground, 2=above sea level, 3 for pressure in hPa| +|MASS | Total mass emitted, only relevant for fwd simulations| real | +|PARTS | Total number of particles to be released| integer | +|COMMENT | Comment, written in the outputfile| character string | + +<br/> +**Note:** the RELEASES file is no longer necessary when using [IPIN](configuration.md#ipin)=3, giving full control to the user to decide where and when particles of different species are being released (see [User-defined initial conditions](configuration.md#ic)). + +### <a name="species"></a>SPECIES +The subdirectory options/SPECIES/ needs to contain one or more files named SPECIES_nnn. In options/SPECIES/ templates for several species are given. These come with no warranty and will have to be renamed to SPECIES_nnn where nnn are three digits. For each species nnn listed in the header section of the RELEASES file, such a SPECIES_nnn file must exist. The parameters in the SPECIES_nnn file, contained in the namelist &SPECIES_PARAMS, set the species name and define the physicochemical properties of the species; they are described in Table 10. These are important for simulating radioactive or chemical decay, wet deposition (scavenging) for gases and aerosols, dry deposition for gases and aerosols, particle settling, and chemical reaction with the OH radical. Some parameters are only necessary for gas tracers and some are only necessary for aerosol tracers; thus, a namelist does not need to contain all parameters for both gases and particles. Optionally, since FLEXPART version 6.0, information about temporal emission variations can be added at the end of the file. + +The following specifies the parameters associated with each physicochemical process simulated. + +- Radioactive or chemical decay: set with pdecay; off if pdecay<0. +- Wet deposition for gases: set with pweta_gas, pwetb_gas (for below-cloud) and phenry (for in-cloud). Switch off for both in- and below-cloud if either pweta_gas or pwetb_gas is negative. +- Wet deposition for aerosols: set with pccn_aero, pin_aero for in-cloud scavenging and pcrain_aero, pcsnow_aero and pdquer for below-cloud scavenging. +- Dry deposition for aerosols: set with pdensity, pdquer, pndia, and psigma; off if pdensity < 0. +- Dry deposition for gases: set with phenry, pf0 and preldiff; off if preldiff < 0. Alternatively, a constant dry deposition velocity pdryvel can be given. +- Settling of particles: set with pdensity and pdquer. +- Shape of particles: set with PSHAPE, PASPECTRATIO, PLA, PIA, PSA, and PORIENT +- OH reaction: chemical reaction with the OH radical can be turned on by giving parameter pohcconst (cm^3 molecule^-1 s^-1 ), pohdconst (K) and pohnconst (no unit) positive values; defined by Eq. (13) in Pisso et al. (2019). +- Emission variation: emission variation during the hours (local time) of the day and during the days of the week can be specified. Factors should be 1.0 on average to obtain unbiased emissions overall. The area source factors (useful, e.g., for traffic emissions) are applied to emis sions with a lower release height below 0.5 m above ground level (a.g.l.) and the point source factors (useful, e.g., for power plant emissions) to emissions with a lower release height than 0.5 m a.g.l. Default values are 1.0. + +| Variable name | Description | Data type | +| ----------- | ----------- | --------- | +|PSPECIES | Tracer name | character(len=16) | +|PDECAY | Species half life | real | +|PWETA_GAS | Below-cloud scavenging (gases) - A (weta_gas) | real | +|PWETB_GAS | Below-cloud scavenging (gases) - B (wetb_gas) | real | +|PCRAIN_AERO | Below-cloud scavenging (particles) - Crain (crain_aero) | real | +|PCSNOW_AERO | Below-cloud scavenging (particles) - Csnow (csnow_aero) | real | +|PCCN_AERO | In-cloud scavenging (particles) - CCNeff (ccn_aero) | real | +|PIN_AERO | In-cloud scavenging (particles) - INeff (in_aero) | real | +|PDENSITY | Dry deposition (particles) - rho | real | +|PDIA | Dry deposition (particles) - diameter or equivalent diameter for shape (meter) | real | +|PDSIGMA | Dry deposition (particles) - dsig | real | +|PNDIA | Dry deposition (particles) - ndia | integer | +|PDRYVEL | Alternative: dry deposition velocity | real | +|PRELDIFF | Dry deposition (gases) - D | real | +|PHENRY | Dry deposition (gases) - Henrys const. | real | +|PF0 | Dry deposition (gases) - f0 (reactivity) | real | +|PWEIGHTMOLAR | molweight | real | +|PREACTIONS | List of reactions, must correspond to names in REAGENTS | string | +|PCCONST | OH Reaction rate - C [cm^3/molecule/sec], in order of PREACTIONS | real | +|PDCONST | OH Reaction rate - D [K], in order of PREACTIONS | real | +|PNCONST | OH Reaction rate - N [dimensionless], in order of PREACTIONS | real | +|PEMIS_PATH | Emissions path, if empty, no emissions | string | +|PEMIS_FILE | Generic file name for emissions, if empty, no emissions | string | +|PEMIS_NAME | Variable name for emissions, if empty, no emissions | string | +|PEMIS_UNIT | Unit of emissions | integer 0=per gridcell, 1=per m2 | +|PEMIS_COEFF | Coefficient to convert from emission input unit to kg/s | real | +|PSHAPE | Defining the shape of a particle | integer: **0=sphere (default)**, 1=any shape (defined by axes PLA,PIA,PSA), 2=cylinder, 3=cube, 4=tetrahedron, 5=octahedron, 6=ellipsoid | +|PASPECTRATIO | Aspect ratio of cylinders: works for PSHAPE=2 only | real | +|PLA | Longest axis in meter (Bagheri & Bonadonna 2016): only for PSHAPE=1 | real | +|PIA | Intermediate axis in meter: only for PSHAPE=1 | real | +|PSA | Smallest axis in meter: only for PSHAPE=1 | real | +|PORIENT | Falling orientation for aerosol particles of shape != 0 | integer: **0=horizontal (default)**, 1=random orientation of particles, 2=average between random and horizontal | + +<br/> + +### <a name="outgrid"></a>OUTGRID +The OUTGRID file specifies the domain and grid spacing of the three-dimensional output grid. Note that in a Lagrangian model, the domain and resolution of the gridded output are totally independent from those of the meteorological input (apart from the fact that the output domain must be contained within the computational domain). The output grid is available in binary and NetCDF format, which can be set by [IOUT](configuration.md#iout) in the [COMMAND](configuration.md#command) file. + + +| Variable name | Descriptions | Data type | +| ------------- | ------------ | --------- | +|OUTLON0 | Geographical longitude of the lower left corner of the output grid | real | +|OUTLAT0 | Geographical latitude of the lower left corner of the output grid | real | +|NUMXGRID | Number of grid points in the X direction (= No. of cells +1) | integer | +|NUMYGRID | Number of grid points in the Y direction (= No. of cells +1) | integer | +|DXOUT | Grid distance in the X direction | real | +|DYOUT | Grid distance in the Y direction | real | +|OUTHEIGHTS | The height of the levels (upper boundary) | real(s divided by comma's) | + +<br/> + +### <a name="outgrid_nest"></a>OUTGRID_NEST +Output can also be produced on one nested output grid with higher horizontal resolution. +This file specifies the size and dimensions of the nested output grid. The height levels are equal to those set in [OUTGRID](configuration.md#outgrid). + +| Variable name | Descriptions | Data type | +| ------------- | ------------ | --------- | +|OUTLON0N | Geographical longitude of the lower left corner of the output grid | real | +|OUTLAT0N | Geographical latitude of the lower left corner of the output grid | real | +|NUMXGRIDN | Number of grid points in the X direction (= No. of cells +1) | integer | +|NUMYGRIDN | Number of grid points in the Y direction (= No. of cells +1) | integer | +|DXOUTN | Grid distance in the X direction | real | +|DYOUTN | Grid distance in the Y direction | real | + +<br/> + +### <a name="ageclasses"></a>AGECLASSES + +The option to produce age class output can be activated by setting [LAGESPECTRA](configuration.md#lagespectra) in the [COMMAND](configuration.md#command) file. The AGECLASSES file then allows for the definition of a list of times (in seconds, in increasing order) that define the age classes used for model output. With this option, the model output (e.g., oncentrations) is split into contributions from particles of different age, defined as the time passed since the particle release. Particles are dropped from the simulation once they exceed the maximum age, skipping unnecesary computations. This is an important technique to limit the cpu usage for long-term simulations. Thus, even if the user is not interested in age information per se, it may often be useful to set one age class to define a maximum particle age. +The file should contain two namelist: + +1) &NAGE + +| Variable name | Description | Data type | +| ------------- | ------------ | --------- | +|NAGECLASS | Number of ageclasses for the age spectra calculation | integer | + +<br/> + +2) &AGECLASS + +| Variable name | Description | Data type | +| ------------- | ------------ | --------- | +|LAGE | Maximum age of particles in seconds for each ageclass | integer(s divided by comma's) | + +<br/> + +### <a name="initconc"></a>INITCONC + +**Optional** Specifies input for initialising the mixing ratios. If hybrid pressure coordinates, the variable PS_NAME is required. Otherwise, either ALT_NAME or PRS_NAME need to be given. The file should contain two namelists: + +1) &INITCONC_CTRL + +| Variable name | Description | Data type | +| ------------- | ------------ | --------- | +|NINIT | Number of species for which initial concentration is specified | integer | +|SPECNUM_REL | List of species of length NSPEC set in [RELEASES](configuration.md#releases) | integer | + +<br/> + +2) &INITCONC + +| Variable name | Description | Data type | +| ------------- | ------------ | --------- | +|PATH_NAME | Path to initial concentration files | character string | +|FILE_NAME | Name of the receptor point | character string | +|VAR_NAME | Generic name of file (using YYYY[MM][DD]) for dates | character string | +|HYA_NAME | Name of concentration variable in file | character string | +|HYB_NAME | Name of hybrid pressure coord A (use "" if none)| character string | +|PS_NAME | Name of surface pressure variable (use "" if none) | character string | +|Q_NAME | Name of specific humidity variable (use "" if none, then assumes dry air mixing ratio) | character string | +|PRS_NAME | Name of vertical pressure coordinate (use "" if none) | character string | +|ALT_NAME | Name of altitude coordinate (use "" if none) | character string | +|COEFF | Coefficient from input unit to ppbv | real | + + +<br/> + +### <a name="receptors"></a>RECEPTORS + +**Optional** In addition to gridded model output, it is also possible to define receptor points. With this option output can be specifically produced for certain points at the surface in addition to gridded output. The RECEPTORS file contains a list with the definitions of the receptor name, longitude and latitude. If no such file is present, no receptors are written to output. At the moment, this data is added to the gridded_output file, when using netcdf, maybe this should be a dedicated RECEPTOR netcdf file instead. + +| Variable name | Description | Data type | +| ------------- | ------------ | --------- | +|RECEPTOR | Name of the receptor point | character string | +|LON | Geographical longitude | real | +|LAT | Geographical latitude | real | +|ALT | Altitude | real | +|TIME | (Optional) time of receptor output | real | + +<br/> + +### <a name="partoptions"></a>PARTOPTIONS +**Optional** This option file is only necessary when requiring particle properties to be written out (IPOUT=1 in the COMMAND option file). In this file, the user can set what particle properties and interpolated fields they want to be written to files. At the moment, the available fields that can be written to file are: + +- particle positions (longitude, latitude and height), +- potential vorticity, +- specific humidity, +- density, temperature, +- pressure, +- particle mass, +- separate cumulative wet and dry deposition masses, +- settling velocity, +- 3D velocities, +- the height of the PBL, tropopause and topography. + +Each property can also be printed out as an average instead of an instantaneous value. For example, if one makes internal time steps of 600 seconds each, +and writes properties to files every hour, the outputted value will be the average of the 6 previous values of the particle of the past hour. Note that this comes with an additional computational cost. + +If the particle output is switched on (IPOUT=1), terminated particles are kept in the simulation, but values associated with them are set to`NaN' instead of being overwritten by newly released particles in the NetCDF output. +This comes with no additional computational cost, but it may need more memory than when running without the particle output option switched on. +As some applications might use a large number of short-lived particles during a longer simulation, the behaviour of overwriting terminated particles can be restored by removing \texttt{ipout.eq.0} from the \texttt{get\_newpart\_index} subroutine, located in the \texttt{particle\_mod.f90}. +<br/> + +### <a name="reagents"></a>REAGENTS +**Optional** Specifies chemical reagents for reactions. The corresponding rate constants are given in the SPECIES files (PREACTION). + +| Variable name | Description | Data type | +| ------------- | ----------- | --------- | +| PREAGENT | Reagent name, must be the same as variable name and match those used in reations list in SPECIES file | string | +| PREAG_PATH | path to reagent file | string | +| PHOURLY | Interpolate field to hourly based on solar zenith angle | integer: 0=no, 1=yes | + +<br/> + +### <a name="satellites"></a>SATELLITES +**Optional** Specifies paths and input file names of satellite retrievals for which mixing ratios should be output + +| Variable name | Description | Data type | +| ------------- | ----------- | --------- | +| PSATNAME | Name of satellite | string | +| PPATH | path to satellite files | string | +| PFILE | Generic name of satellite files | string ending with "YYYYMMDD.nc" | + +<br/> + +## <a name="pathnames"></a>Pathnames file +The pathnames file is a text file containing the path to: + +- first line: directory of the option files, +- second line: name of directory where output files are generated, +- third line: base path to the meteorological input data, +- fourth line: full path and filename of the AVAILABLE file (see [**AVAILABLE**](configuration.md#available)). + +When using nested areas, the third and fourth line can be repeated with the respected meteorological data directory base paths and AVAILABLE_NEST file paths: + +- Line 2n+3: path where meteorological fields are available (nested grid n), +- Line 2n+4: full path and filename of the AVAILABLE-file of nested grid n. + +## <a name="available"></a>AVAILABLE files +The meteorological input data, one file for each input time, are stored in GRIB format in a common directory (specified in line 3 of pathnames). To enable FLEXPART to find these files, a file usually named AVAILABLE (given in line 4 of pathnames) contains a list of all available meteorological input files and their corresponding time stamps. Additional files containing nested input data may also be provided. In this case, a separate file containing the input file names (e.g., named AVAILABLE_NESTED) must be given. Date and time entries in the AVAILABLE* files for mother and nested +fields must be identical. + +## <a name="ic"></a>User-defined initial conditions +A simulation can be started using a NetCDF file listing all particles to be released. This option can be switched on by specifying [IPIN](configuration.md#ipin)=3 in the [COMMAND](configuration.md#command) option file. This file should be called **part_ic.nc** and located in the output directory defined in [Pathnames file](configuration.md#pathnames). It should have the following structure: + +**Header** + +| Variable name | Description | Data type | +| ------------- | ----------- | --------- | +| `nspecies` | Number of species | integer | +| `species` | Species IDs (see [SPECIES](configuration.md#species)) | 1D-array of integers | +| `kindz` | Reference level | integer: 1=above ground, 2=above sea level, 3 for pressure in hPa | + +<br/> + +**Data** + +| Variable name | Description | Data type | +| ------------- | ----------- | --------- | +| `longitude` | Initial longitude of each particle | 1D-array of reals with dimension `particle` | +| `latitude` | Initial latitude of each particle | 1D-array of reals with dimension `particle` | +| `height` | Initial height of each particle (meter above reference level) | 1D-array of reals with dimension `particle` | +| `time` | Release time of each particle seconds after simulation start (IBDATE/IBTIME for forward runs, IEDATE/IETIME for backward runs, set in [COMMAND](configuration.md#command)) | 1D-array of integers with dimension `particle` | +| `mass` | Initial mass of each particle (kg) | 2D-array of reals with dimension `species` and `particle` | +| `release` | Release ID of each particle, giving separate concentration fields for each ID when [IOUTPUTFOREACHRELEASE](configuration.md#ioutputforeachrelease) in [COMMAND](configuration.md#command) is set | 1D-array of integers with dimension `particle` | + +<br/> + +## <a name="restart"></a>Restarting a simulation +In case your simulation crashes or if you simply want to extend your simulation period, it is possible to run using the restart option (COMMAND option file: IPIN=1 or IPIN=4 when initially running with part_ic.nc). You will need to decide if you will need this option before starting your initial simulation: LOUTRESTART in the COMMAND option file needs to be set to an appropriate time interval. For example, you can choose to set LOUTRESTART = 172800 s to get a new restart file ever 2 days. The restart files are written in binary and their name specifies the time within your simulation period they are written. When LOUTRESTART is set to -1, this option is disabled. + +To run from one of these files, simply rename the desired restart_XXX.bin file to restart.bin, set IPIN=1 (or IPIN=4 when initially running with IPIN=3) and you can restart your run from there. + +WARNING: If you chose to use gridded data output (IOUT>0), then new data will be written to this file. If it is not desirable to overwrite a gridded data output file from a previous run, copy this file to another directory. diff --git a/documentation/docs/examples.md b/documentation/docs/examples.md index df635b4e61303f9498a7b2edbc413cd6df86f06d..70b3fb0a3bdd8160d512a9790e86d8c07c78c7b5 100644 --- a/documentation/docs/examples.md +++ b/documentation/docs/examples.md @@ -1 +1,30 @@ # Examples + +Since its inception, FLEXPART has proven to be a valuable tool for studying a wide range of environmental problems both for the research community as well as in operational settings. Some examples where FLEXPART was used in the literature are: + +- Studying the transport of heat and water in the atmosphere: [Baier et al.](https://doi.org/10.1029/2022GL100906),[Peng et al. 2022](https://doi.org/10.1175/JCLI-D-21-0289.1). +- Volcanic and wildfire plumes: [Stohl et al. 2006](https://doi.org/10.1029/2006JD007216), [Stohl et al. 2011](https://doi.org/10.5194/acpd-11-5541-2011), [Moxnes et al. 2014](https://doi.org/10.1002/2013JD021129). +- Transport and fall-out after nuclear accidents or explosions: [Stohl et al. 2012](https://doi.org/10.5194/acp-12-2313-2012), [Arnold et al. 2015](https://doi.org/10.1016/j.jenvrad.2014.02.013). +- Transport of aerosols such as dust: [Zwaaftink et al. 2017](https://doi.org/10.5194/acp-17-10865-2017), [Ryder et al. 2019](https://doi.org/10.5194/acp-19-15353-2019). +- The interpretation of biogenic secondary organic aerosol compound measurements: [Martinsson et al. 2017](https://doi.org/10.5194/acp-17-11025-2017). +- Transport of pollutants into remote regions like the Arctic: [Dada et al. 2022](https://doi.org/10.1038/s41467-022-32872-2), [Zhu et al. 2020](https://doi.org/10.5194/acp-20-1641-2020). +- The interpretation of ice cores: [Eckhardt et al. 2023](https://doi.org/10.1038/s41467-022-35660-0). +- Modelling emission sensitivities of greenhouse gases: [Vojta et al. 2022](https://doi.org/10.5194/gmd-15-8295-2022). + +## Example cases +The range of FLEXPART capabilities comes with a complicated set of option files (see [**option files**](configuration.md#options)), which can be overwhelming to new users. Therefore, we have outlined the settings of three common groups of simulations below, which correspond to the test cases used in the publication of FLEXPART 11. + +Each set of option files can be found in the repository in the 'examples' directory. The `IGBP_int1.dat`, `sfcdata.t`, `sfcdepo.t` files are not present here, but can be found in the 'options' directory in the repository. + +### Case Tracer +This case is useful for studying transport of heat and water through the global atmosphere. It is a domain-filling simulation, with 10 million particles representing a passive air tracer distributed across the globe following air density. Every hour, all particle in- +formation but no gridded output is written to NetCDF files. The example runs for only 5 hours, using 10 minute time-steps, and the turbulence options are set to CTL=10 and IFINE=10. + +### Case Aerosol +This case serves as a template for option files using aerosol particles, i.e. tracing pollutants. Case Aerosol simulations generally take much longer than Case Tracer simulations, on one hand because of the extra computations in the wet and dry deposition and gravitational settling routines and on the other hand because of all particles starting within the ABL, where solving the Langevin equations of the turbulence parameterisation requires very short time steps. + +This is a very general example, where 1 million particles representing spherical aerosols with a diameter of 50 micrometer are initially homogeneously distributed in the bottom 100 meters across the globe. Every hour, gridded properties are printed to NetCDF files on the same horizontal resolution as the input data (0.5° by 0.5° global grid), and four vertical levels. The example runs for only 5 hours, using 15 minute time-steps, and turbulence options CTL=10 and IFINE=4. +MAXTHREADGRID is set to 16, meaning that the gridded computations are using a maximum of 16 threads. The efficiency of this setting should be carefully checked when changing the dimensions of the grid and the number of particles. + +### Case Nuclear +This example includes a nested input and output grid over Europe with 0.25° by 0.25°. Using the RELEASES file, 1 million particles representing xenon-133 are released at a single location, using the CBL option for skewed turbulence in the ABL and CTL=40 and IFINE=5. MAXTHREADGRID is set to 1, meaning that gridded computations are conducted on a single thread. \ No newline at end of file diff --git a/documentation/docs/index.md b/documentation/docs/index.md index e408e65feb1d541d01ccae16301fd2ae8880d9fb..ab809e9d5d38ecccb33e1141794d670f868019c7 100644 --- a/documentation/docs/index.md +++ b/documentation/docs/index.md @@ -1,9 +1,9 @@ # Welcome to the FLEXPART 11 documentation -Information on how to download and install FLEXPART can be found [here](installation.md). -How to set up a simulation, with an explanation of all input files can be found [here](running.md), and some examples can be found [here](examples.md). -A list of all possible output options and files can be found [here](output.md). -An overview of all processes relation to the direct transport of particles can be found [here](transport.md), and internal particle processes [here](evolution.md). +- Information on how to download and install FLEXPART can be found [here](building.md). +- How to set up a simulation, with an explanation of all input files can be found [here](configuration.md#config), and some examples can be found [here](examples.md). +- A list of all possible output options and files can be found [here](output.md). +- An overview of all processes relation to the direct transport of particles can be found [here](transport.md), and internal particle processes [here](evolution.md). This manual covers FLEXPART 11. A full description can be found in the official release paper: diff --git a/documentation/docs/running.md b/documentation/docs/running.md index 09496de858145705e8ed77dc05d63b10f527e814..2d3596c57632efc020a21f4651eca11813dc8cb4 100644 --- a/documentation/docs/running.md +++ b/documentation/docs/running.md @@ -1,287 +1,98 @@ -# Running FLEXPART -To run FLEXPART, there are three important (sets) of files that need to be specified. -These are: +# Running -- the [**option files**](running.md#options), defining the set-up of the run, -- the [**pathnames file**](running.md#pathnames), defining the paths of where input and output are located, -- the [**AVAILABLE file**](running.md#available), listing all available meteorological input, +<span style="color:red"> +**WARNING:** +</span> +For many systems it is required to print the following in the command line or to set it in your submit script before executing FLEXPART compiled with OpenMP: +~~~ +ulimit -s unlimited +~~~ +Not setting this can result in a segmentation fault close to the start of your simulation. -Of course, there is also the **par_mod.f90** file, which needs to be specified before compiling (see [**Compiling FLEXPART**](installation.md#compliling), but the parameters in this file are expected to not have to be changed between simulations. +Additionaly, one should set the following for optimal memory usage: +~~~ +export OMP_PLACES=cores +export OMP_PROC_BIND=true +~~~ +Not setting these can result in unnecessary slow performance of your application. -In addition to the regular input files listed above, a simulation can also be started using a NetCDF file listing all particles to be released. This option can be switched on by specifying IPIN=3 in the COMMAND option file. More information about how to use this option can be found here: [User-defined initial conditions](running.md#ic). +## Command line usage -When wanting to restart a previous simulation, see [restarting a simulation](running.md#restart). +FLEXPART accepts two command line options: -## <a name="options"></a>Option files -These files define the simulation settings. At the start of a simulation, a copy of each file will be written to the output directory defined in the [**pathnames file**](running.md#pathnames). -All option files should be presented as namelists (i.e. &OPTIONFILE). A template of these files can be found in the options/ directory within the repository. +- `pathnames`, setting all appropriate paths, as explained in [Configuration](configuration.md#config). +- `-v <verbosity>`, currently not operational -Inside the `options/` directory a template of all option files can be found: +## Exit code -- [COMMAND](running.md#command) -- [RELEASES](running.md#releases) -- [SPECIES](running.md#species) -- [OUTGRID](running.md#outgrid) -- [OUTGRID_NESTED](running.md#outgrid_nested) -- [AGECLASSES](running.md#ageclasses) -- [RECEPTORS](running.md#receptors) -- [PARTOPTIONS](running.md#partoptions) +The introduction of `error stop` in Fortran 2008 now garantees FLEXPART to only exit with code `0` for successful runs. Any other exit code indicates a failed run. -### <a name="command"></a>COMMAND -Sets the behaviour of the run (time range, backward or forward, output frequency, etc.). A table of all options is listed below. +## Input data -- **Time variables**: Flexpart can be run in forward or backward mode. In forward mode, particles are being traced forward in time, while in backward more, the origin of particles are being traced, going backward in time. This can be set by the [LDIRECT](running.md#ldirect) variable. The start and end of the simulation are set by [IBDATE](running.md#IBDATE):[IBTIME](running.md#IBTIME) and [IEDATE](running.md#IEDATE):[IETIME](running.md#IETIME). [IEDATE](running.md#IEDATE):[IETIME](running.md#IETIME) is always at a later time than [IBDATE](running.md#IBDATE):[IBTIME](running.md#IBTIME), also for backwards simulations. Output variables can be written at specified times: [LOUTSTEP](running.md#LOUTSTEP), and restart files will be written at every [LOUTRESTART](running.md#LOUTRESTART) interval. -- **Numerical variables**: [LSYNCTIME](running.md#LSYNCTIME) and LOUTSAMPLE set the integration interval, smaller generally giving better results, although below a certain number, not much will be gained. With the [CTL](running.md#CTL) and [IFINE](running.md#IFINE) setting, you can make integration steps even smaller for the turbulence computations. -- **Output variables**: The output is written at every [LOUTSTEP](running.md#LOUTSTEP) interval. Both gridded data ([IOUT](running.md#IOUT)>0) and particle based data ([IPOUT](running.md#IPOUT)=1) can be written to NetCDF files (binary option for gridded data). Nested output can be set by the [NESTED_OUTPUT](running.md#NESTED_OUTPUT) switched. Note that for gridded output, the [OUTGRID](running.md#OUTGRID) for ([IOUT](running.md#IOUT)>0) and [OUTGRID_NESTED](running.md#OUTGRID_NESTED) (for [NESTED_OUTPUT](running.md#NESTED_OUTPUT)=1) option files should be specified. Other output variables can be set in the par_mod.f90 file. Namely, the size of the NetCDF files that contain the particle based data (max_partoutput_filesize). [IND_RECEPTOR](running.md#IND_RECEPTOR) can be set to get concentrations or mixing ratios at specified receptor points set in the RECEPTORS options file. For backward simulations, [IND_RECEPTOR](running.md#IND_RECEPTOR) can be used to get wet or dry deposition gridded data. [SFC_ONLY](running.md#SFC_ONLY) and [LINIT_COND](running.md#LINIT_COND) are only working for binary output. -- **Input variables**: IPIN can be set to chose the input type: either initial conditions from particles come from the [RELEASES](running.md#releases) file ([IPIN](running.md#IPIN)=0), from restart files of a previous run ([IPIN](running.md#IPIN)=1), -from a particle netCDF file written in a previous run (only works when the correct fields in [PARTOPTIONS](running.md#PARTOPTIONS) are chosen) ([IPIN](running.md#IPIN)=2), or from user-defined initial particle conditions ([IPIN](running.md#IPIN)=3). [MDOMAINFILL](running.md#MDOMAINFILL) can be set to distribute particles according to the air density or stratospheric ozone density profiles. This option overwrites the vertical levels set in the [RELEASES](running.md#releases) option file. +To run FLEXPART, there are three important (sets) of files that need to be specified. +These are: -| Variable name | Description | Possible values and **default** (bold) | -| ----------- | ----------- | ----------- | -| <a name="ldirect"></a>LDIRECT | Simulation direction in time | **1 (forward)** or -1 (backward) | -| <a name="IBDATE"></a>IBDATE | Start date of the simulation | YYYYMMDD: YYYY=year, MM=month, DD=day | -| <a name="IBTIME"></a>IBTIME | Start time of the simulation | HHMISS: HH=hours, MI=minutes, SS=seconds. UTC zone. | -| <a name="IEDATE"></a>IEDATE | End date of the simulation | YYYYMMDD: YYYY=year, MM=month, DD=day | -| <a name="IETIME"></a>IETIME | End time of the simulation | HHMISS: HH=hours, MI=minutes, SS=seconds. UTC zone. | -| <a name="LOUTSTEP"></a>LOUTSTEP | Interval of model output. Average concentrations are calculated every LOUTSTEP (seconds) | **10800** | -| <a name="LOUTAVER"></a>LOUTAVER | Concentration averaging interval, instantaneous for value of zero (seconds) | **10800** | -| <a name="LOUTSAMPLE"></a>LOUTSAMPLE | Numerical sampling rate of output, higher statistical accuracy with shorter intervals (seconds) | **900** | -| <a name="LOUTRESTART"></a>LOUTRESTART | Time interval when a restart file is written (seconds) | **-1** | -| <a name="LSYNCTIME"></a>LSYNCTIME | All processes are synchronized to this time interval; all values above should be dividable by this number (seconds) | **900** | -| <a name="CTL"></a>CTL | Factor by which particle transport time step in the ABL must be smaller than the Lagrangian timescale t l ; resulting time steps can be shorter than LSYNCTIME; LSYNCTIME is used if CTL < 0 | **-5.0** | -| <a name="IFINE"></a>IFINE | Additional reduction factor for time step used for vertical transport only considered if CTL > 1 | **4** | -| <a name="IOUT"></a>IOUT | Switch determining the gridded output type | 0 (no gridded output), **1 (forward: mass concentration; backwards: residence time)**, 2 (volume mixing ratio), 3 (1 and 2 combined), 4 (plume trajectories), 5 (1 and 4 combined), Add 8 for NetCDF output | -| <a name="IPOUT"></a>IPOUT | Switch for particle position output | **0 (no particle output)**, 1 (particle output every LOUTSTEP), 2 (particle output at the end of the simulation) | -| <a name="LSUBGRID"></a>LSUBGRID | Increase in ABL heights due to subgrid-scale orographic variations | **0 (off)**, 1 (on) | -| <a name="LCONVECTION"></a>LCONVECTION | Switch for convection parameterization | 0 (off), **1 (on)** | -| <a name="LTURBULENCE"></a>LTURBULENCE | Switch for turbulence parameterization | 0 (off), **1 (on)** | -| <a name="LTURBULENCE_MESO"></a>LTURBULENCE_MESO | Switch for mesoscale turbulence parameterization | **0 (off)**, 1 (on) | -| <a name="LAGESPECTRA"></a>LAGESPECTRA | Switch for calculation of age spectra (needs file [AGECLASSES](running.md#ageclasses) option file) | 0 (off), **1 (on)** | -| <a name="IPIN"></a>IPIN | Particle information input. Starting from [RELEASES](running.md#releases) option file, form restart.bin, or user-defined particle input data (see Silvia Bucci's stuff) | **0 (using RELEASES option file)**, 1 (using restart.bin file), 2 (using previous partoutput file), 3 (self made initial conditions), 4 (restart.bin and self made initial conditions) | -| <a name="IOUTPUTFOREACHRELEASE"></a>IOUTPUTFOREACHRELEASE | Switch for separate output fields for each location in the [RELEASES](running.md#releases) file | 0 (no), **1 (yes)** | -| <a name="IFLUX"></a>IFLUX | Output of mass fluxes through output grid box boundaries (northward, southward, eastward, westward, upward and downward) | 0 (off), **1 (on)** | -| <a name="MDOMAINFILL"></a>MDOMAINFILL | Switch for domain-filling calculations: particles are initialized to reproduce air density or stratospheric ozone density; for limited-area simulations, particles are generated at the domain boundaries | **0 (no)**, 1 (like air density), 2 (stratospheric ozone tracer) | -| <a name="IND_SOURCE"></a>IND_SOURCE | Unit to be used at the source; see Seibert and Frank (2004); Eckhardt et al. (2017) | **1 (mass)**, 2 (mass mixing ratio) | -| <a name="IND_RECEPTOR"></a>IND_RECEPTOR | Unit to be used at the receptor; see Seibert and Frank (2004); Eckhardt et al. (2017) | 0 (no receptor), **1 (mass)**, 2 (mass mixing ratio), 3 (backward only: wet deposition), 4 (backward only: dry depostion) | -| <a name="MQUASILAG"></a>MQUASILAG | Quasi-Lagrangian mode to track individual numbered particles | **0 (off)**, 1 (on) | -| <a name="NESTED_OUTPUT"></a>NESTED_OUTPUT | Switch to produce output also for a nested domain | **0 (no)**, 1 (yes) | -| <a name="LNETCDFOUT"></a>LNETCDFOUT | Switch to produce NetCDF output, overwritten to 1 when IOUT>8 and set to 0 when compiled without NetCDF libraries | 0 (no), **1 (yes)** | -| <a name="LINIT_COND"></a>LINIT_COND | Switch to produce output sensitivity to initial conditions given in concentration or mixing ratio units (in backwards mode only) | **0 (no)**, 1 (mass), 2 (mass mixing ratio) | -| <a name="SFC_ONLY"></a>SFC_ONLY | Output of SRR for fluxes only for the lowest model layer, most useful for backward runs when LINIT_COND set to 1 or 2 | **0 (no)**, 1 (yes) | -| <a name="CBLFLAG"></a>CBLFLAG | Skewed rather than Gaussian turbulence in the convective ABL; when turned on, very short time steps should be used (see CTL and IFINE) | **0 (no)**, 1 (yes) | -| <a name="MAXTHREADGRID"></a>MAXTHREADGRID | Set maximum number of threads for doing grid computations. Recommended to set this to max 16. High numbers create more overhead and a larger memory footprint | **1 (default=no parallelisation on grid)** integer | -| <a name="MAXFILESIZE"></a>MAXFILESIZE | Maximum output of each partoutput NetCDF-4 file in Mb before a new one is created | *10000 (default=10GB)** integer | -| <a name="LOGVERTINTERP"></a>LOGVERTINTERP| Flag to set all vertical interpolation to logarithmic instead of linear | *0=off (default)**, 1=on | +- the [**option files**](configuration.md#options), defining the set-up of the run, +- the [**pathnames file**](configuration.md#pathnames), defining the paths of where input and output are located, +- the [**AVAILABLE file**](configuration.md#available), listing all available [meteorological input files](running.md#meteodata). -<br/> +A full description of these files can be found in [Configuration](configuration.md#config). -### <a name="releases"></a>RELEASES -This file contains the information about the particles initial conditions: how many, where and when they will be released, their mass and what species they are (defined in the SPECIES files). -The RELEASES file contains at two types of namelists: - - 1. `&RELEASES_CTRL` namelist, specifying the total number of species and the specific species file associated (see [SPECIES](running.md#species)). There is only one of this namelist and it is found at the top of the file. +### <a name="meteodata"></a>Meteorological input data - 2. `&RELEASE` namelist, specifying for each release, the start and end of the release, the location of the release, and the number of particles that are to be released. +Necessary fields from Eularian models: -| Variable name `&RELEASES_CTRL` | Description | Data type | +| Input field | Description | Unit| | ------------- | ----------- | --------- | -|NSPEC | Total number of species | integer | -|SPECNUM_REL | Species numbers in directory SPECIES | integer(s divided by comma's) | - -<br/> -And for each release: - -| Variable name `&RELEASE` | Description | Data type | -| ------------- | ----------- | --------- | -|IDATE1 | Release start date | integer in the form of YYYYMMDD: YYYY=year, MM=month, DD=day| -|ITIME1 | Release start time in UTC | integers in the form of HHMISS: HH hours, MI=minutes, SS=seconds| -|IDATE2 | Release end date | same as IDATE1| -|ITIME2 | Release end time | same as ITIME1| -|LON1 | Left longitude of release box -180 < LON1 <180| real | -|LON2 | Right longitude of release box, same as LON1| real | -|LAT1 | Lower latitude of release box, -90 < LAT1 < 90| real | -|LAT2 | Upper latitude of release box same format as LAT1 | real | -|Z1 | Lower height of release box meters/hPa above reference level| real | -|Z2 | Upper height of release box meters/hPa above reference level| real | -|ZKIND | Reference level | integer: 1=above ground, 2=above sea level, 3 for pressure in hPa| -|MASS | Total mass emitted, only relevant for fwd simulations| real | -|PARTS | Total number of particles to be released| integer | -|COMMENT | Comment, written in the outputfile| character string | - -<br/> -**Note:** the RELEASES file is no longer necessary when using [IPIN](running.md#ipin)=3, giving full control to the user to decide where and when particles of different species are being released (see [User-defined initial conditions](running.md#ic)). - -### <a name="species"></a>SPECIES -The subdirectory options/SPECIES/ needs to contain one or more files named SPECIES_nnn. For each species nnn listed in the header section of the RELEASES file, such a SPECIES_nnn file must exist. The parameters in the SPECIES_nnn file, contained in the namelist &SPECIES_PARAMS, set the species name and define the physicochemical properties of the species; they are described in Table 10. These are important for simulating radioactive or chemical decay, wet deposition (scavenging) for gases and aerosols, dry deposition for gases and aerosols, particle settling, and chemical reaction with the OH radical. Some parameters are only necessary for gas tracers and some are only necessary for aerosol tracers; thus, a namelist does not need to contain all parameters for both gases and particles. Optionally, since FLEXPART version 6.0, information about temporal emission variations can be added at the end of the file. - -The following specifies the parameters associated with each physicochemical process simulated. - -- Radioactive or chemical decay: set with pdecay; off if pdecay<0. -- Wet deposition for gases: set with pweta_gas, pwetb_gas (for below-cloud) and phenry (for in-cloud). Switch off for both in- and below-cloud if either pweta_gas or pwetb_gas is negative. -- Wet deposition for aerosols: set with pccn_aero, pin_aero for in-cloud scavenging and pcrain_aero, pcsnow_aero and pdquer for below-cloud scavenging. -- Dry deposition for aerosols: set with pdensity, pdquer, pndia, and psigma; off if pdensity < 0. -- Dry deposition for gases: set with phenry, pf0 and preldiff; off if preldiff < 0. Alternatively, a constant dry deposition velocity pdryvel can be given. -- Settling of particles: set with pdensity and pdquer. -- Shape of particles: set with PSHAPE, PASPECTRATIO, PLA, PIA, PSA, and PORIENT -- OH reaction: chemical reaction with the OH radical can be turned on by giving parameter pohcconst (cm^3 molecule^-1 s^-1 ), pohdconst (K) and pohnconst (no unit) positive values; defined by Eq. (13) in Pisso et al. (2019). -- Emission variation: emission variation during the hours (local time) of the day and during the days of the week can be specified. Factors should be 1.0 on average to obtain unbiased emissions overall. The area source factors (useful, e.g., for traffic emissions) are applied to emis sions with a lower release height below 0.5 m above ground level (a.g.l.) and the point source factors (useful, e.g., for power plant emissions) to emissions with a lower release height than 0.5 m a.g.l. Default values are 1.0. - -| Variable name | Description | Data type | -| ----------- | ----------- | --------- | -|PSPECIES | Tracer name | character(len=16) | -|PDECAY | Species half life | real | -|PWETA_GAS | Below-cloud scavenging (gases) - A (weta_gas) | real | -|PWETB_GAS | Below-cloud scavenging (gases) - B (wetb_gas) | real | -|PCRAIN_AERO | Below-cloud scavenging (particles) - Crain (crain_aero) | real | -|PCSNOW_AERO | Below-cloud scavenging (particles) - Csnow (csnow_aero) | real | -|PCCN_AERO | In-cloud scavenging (particles) - CCNeff (ccn_aero) | real | -|PIN_AERO | In-cloud scavenging (particles) - INeff (in_aero) | real | -|PDENSITY | Dry deposition (particles) - rho | real | -|PDQUER | Dry deposition (particles) - dquer (equivalent diameter for shape) | real | -|PDSIGMA | Dry deposition (particles) - dsig | real | -|PNDIA | Dry deposition (particles) - ndia | integer | -|PDRYVEL | Alternative: dry deposition velocity | real | -|PRELDIFF | Dry deposition (gases) - D | real | -|PHENRY | Dry deposition (gases) - Henrys const. | real | -|PF0 | Dry deposition (gases) - f0 (reactivity) | real | -|PWEIGHTMOLAR | molweight | real | -|POHCCONST | OH Reaction rate - C [cm^3/molecule/sec] | real | -|POHDCONST | OH Reaction rate - D [K] | real | -|POHNCONST | OH Reaction rate - C [cm^3/molecule/sec] | real | -|PSHAPE | Defining the shape of a particle | integer: **0=sphere (default)**, 1=any shape (defined by axes PLA,PIA,PSA), 2=cylinder, 3=cube, 4=tetrahedron, 5=octahedron, 6=ellipsoid | -|PASPECTRATIO | Aspect ratio of cylinders: works for PSHAPE=2 only | real | -|PLA | Longest axis in micrometer (Bagheri & Bonadonna 2016): only for PSHAPE=1 | real | -|PIA | Intermediate axis in micrometer: only for PSHAPE=1 | real | -|PSA | Smallest axis in micrometer: only for PSHAPE=1 | real | -|PORIENT | Falling orientation for aerosol particles of shape != 0 | integer: **0=horizontal (default)**, 1=random orientation of particles, 2=average between random and horizontal | - -<br/> - -### <a name="outgrid"></a>OUTGRID -The OUTGRID file specifies the domain and grid spacing of the three-dimensional output grid. Note that in a Lagrangian model, the domain and resolution of the gridded output are totally independent from those of the meteorological input (apart from the fact that the output domain must be contained within the computational domain). The output grid is available in binary and NetCDF format, which can be set by [IOUT](running.md#iout) in the [COMMAND](running.md#command) file. - - -| Variable name | Descriptions | Data type | -| ------------- | ------------ | --------- | -|OUTLON0 | Geographical longitude of the lower left corner of the output grid | real | -|OUTLAT0 | Geographical latitude of the lower left corner of the output grid | real | -|NUMXGRID | Number of grid points in the X direction (= No. of cells +1) | integer | -|NUMYGRID | Number of grid points in the Y direction (= No. of cells +1) | integer | -|DXOUT | Grid distance in the X direction | real | -|DYOUT | Grid distance in the Y direction | real | -|OUTHEIGHTS | The height of the levels (upper boundary) | real(s divided by comma's) | - -<br/> - -### <a name="outgrid_nest"></a>OUTGRID_NEST -Output can also be produced on one nested output grid with higher horizontal resolution. -This file specifies the size and dimensions of the nested output grid. The height levels are equal to those set in [OUTGRID](running.md#outgrid). - -| Variable name | Descriptions | Data type | -| ------------- | ------------ | --------- | -|OUTLON0N | Geographical longitude of the lower left corner of the output grid | real | -|OUTLAT0N | Geographical latitude of the lower left corner of the output grid | real | -|NUMXGRIDN | Number of grid points in the X direction (= No. of cells +1) | integer | -|NUMYGRIDN | Number of grid points in the Y direction (= No. of cells +1) | integer | -|DXOUTN | Grid distance in the X direction | real | -|DYOUTN | Grid distance in the Y direction | real | - -<br/> - -### <a name="ageclasses"></a>AGECLASSES - -The option to produce age class output can be activated by setting [LAGESPECTRA](running.md#lagespectra) in the [COMMAND](running.md#command) file. The AGECLASSES file then allows for the definition of a list of times (in seconds, in increasing order) that define the age classes used for model output. With this option, the model output (e.g., oncentrations) is split into contributions from particles of different age, defined as the time passed since the particle release. Particles are dropped from the simulation once they exceed the maximum age, skipping unnecesary computations. This is an important technique to limit the cpu usage for long-term simulations. Thus, even if the user is not interested in age information per se, it may often be useful to set one age class to define a maximum particle age. -The file should contain two namelist: - -1) &NAGE - - | Variable name | Description | Data type | - | ------------- | ------------ | --------- | - |NAGECLASS | Number of ageclasses for the age spectra calculation | integer | - -2) &AGECLASS - - | Variable name | Description | Data type | - | ------------- | ------------ | --------- | - |LAGE | Maximum age of particles in seconds for each ageclass | integer(s divided by comma's) | +**3D fields** +|horizontal velocities | grid scale velocities used for, e.g., particle propagation | m/s | +|vertical velocity |Vertical velocities on model levels used for, e.g., particle propagation. | etadot (IFS), m/s (GFS)| +|Temperature |Air temperature used for parameterisation schemes. | K | +|Specific (IFS) or relative (GFS) humidity |Internal use of specific humidity for parameterisation schemes. | kg/kg (IFS), \% (GFS) | +**2D fields** +|Surface pressure |Pressure at the ground level. | Pa | +|Snow depth |Thickness of snow layer necessary for dry deposition calculation. | m | +|Cloud cover |Fraction of the grid cell that is covered by cloud, used for wet deposition calculations. | 0-1 | +|10 meter horizontal velocities |Used to compute surface stress if not available. | m/s | +|2 meter temperature |Used for parameterisation. | K | +|2 meter dew point (ECMWF only) |Used for parameterisation, for GFS, this is computed according to \cite{bolton1980}. | K | +|Large scale precipitation |Used in the wet deposition scheme. | mm/h | +|Convective precipitation |Used in the wet deposition scheme. | mm/h | +|Sensible heat flux (ECMWF only) | Used to compute Obukhov length, for GFS this is computed using the profile method \citep{berkowicz1982}. | J m^2 | +|Solar radiation (ECMWF only) |Used to calculate the surface resistance for gases, for GFS solar radiation is assumed to be zero | J m^2 | +E-ward N-ward turbulent surface stress (ECMWF only) |Surface stress used for dry deposition computations. For GFS data, surface stress is calculated using [Berkowicz 1982](https://doi.org/10.1016/0004-6981(82)90032-4) | N m^2 s | +|Orography |Altitude of topography above sea level | m | +|Standard deviation of orography |Included into mixing layer height to account for subgrid scale variability | m | +|Land sea mask |Invoking surface stress computation including wind speeds over sea | 0-1 | +|Cloud liquid water content |Used by the wet scavenging scheme | kg/kg | +|Cloud ice water content |Used by the wet scavenging scheme | kg/kg | <br/> -### <a name="receptors"></a>RECEPTORS - -In addition to gridded model output, it is also possible to define receptor points. With this option output can be specifically produced for certain points at the surface in addition to gridded output. The RECEPTORS file contains a list with the definitions of the receptor name, longitude and latitude. If no such file is present, no receptors are written to output. At the moment, this data is added to the gridded_output file, when using netcdf, maybe this should be a dedicated RECEPTOR netcdf file instead. - -| Variable name | Description | Data type | -| ------------- | ------------ | --------- | -|RECEPTOR | Name of the receptor point | character string | -|LON | Geographical longitude | real | -|LAT | Geographical latitude | real | - -<br/> - -### <a name="partoptions"></a>PARTOPTIONS -This option file is only necessary when requiring particle properties to be written out (IPOUT=1 in the COMMAND option file). In this file, the user can set what particle properties and interpolated fields they want to be written to files. At the moment, the available fields that can be written to file are: - -- particle positions (longitude, latitude and height), -- potential vorticity, -- specific humidity, -- density, temperature, -- pressure, -- particle mass, -- separate cumulative wet and dry deposition masses, -- settling velocity, -- 3D velocities, -- the height of the PBL, tropopause and topography. +## OpenMP -Each property can also be printed out as an average instead of an instantaneous value. For example, if one makes internal time steps of 600 seconds each, -and writes properties to files every hour, the outputted value will be the average of the 6 previous values of the particle of the past hour. Note that this comes with an additional computational cost. +Where most of FLEXPART's computational time is spent is very dependent on the specific problem to be solved and the set-up of FLEXPART. For example, when many particles are released from a single release point, initially most time is spent on particle trajectory computations. However, when a global high-resolution domain for the meteorological input data is used, significant time is spent on the convection computations on the grid. On the other hand, when few particles are used, computations on the gridded meteorological input data (e.g., coordinate transformations) are taking a large share. For this reason, we implemented OpenMP parallelisation throughout FLEXPART and tried to avoid bottlenecks at least for the most common set-ups. -## <a name="pathnames"></a>Pathnames file -The pathnames file is a text file containing the path to: +We parallelised all particle based computations, apart from their initial release in the \texttt{releaseparticles} subroutine. On top of that, we parallelised the reading and computations on the meteorological fields, including the convection, wet and dry deposition, and the vertical coordinate transformation of the fields. Lastly, we parallelised the computations needed for the output, both for the gridded output and the particle dump. -- first line: directory of the option files, -- second line: name of directory where output files are generated, -- third line: base path to the meteorological input data, -- fourth line: full path and filename of the AVAILABLE file (see [**AVAILABLE**](running.md#available)). +One drawback of OpenMP parallelisation is that it is more difficult for users to make changes than in serial code, since they also are likely to have to update OpenMP regions. To minimise errors, we therefore strongly recommend users to make changes in the form of subroutines and functions and avoid the use of global variables. -When using nested areas, the third and fourth line can be repeated with the respected meteorological data directory base paths and AVAILABLE_NEST file paths: +## HPC systems -- Line 2n+3: path where meteorological fields are available (nested grid n), -- Line 2n+4: full path and filename of the AVAILABLE-file of nested grid n. - -## <a name="available"></a>AVAILABLE files -The meteorological input data, one file for each input time, are stored in GRIB format in a common directory (specified in line 3 of pathnames). To enable FLEXPART to find these files, a file usually named AVAILABLE (given in line 4 of pathnames) contains a list of all available meteorological input files and their corresponding time stamps. Additional files containing nested input data may also be provided. In this case, a separate file containing the input file names (e.g., named AVAILABLE_NESTED) must be given. Date and time entries in the AVAILABLE* files for mother and nested -fields must be identical. - -## <a name="ic"></a>User-defined initial conditions -A simulation can be started using a NetCDF file listing all particles to be released. This option can be switched on by specifying [IPIN](running.md#ipin)=3 in the [COMMAND](running.md#command) option file. This file should be called **part_ic.nc** and located in the output directory defined in [Pathnames file](running.md#pathnames). It should have the following structure: - -**Header** - -| Variable name | Description | Data type | -| ------------- | ----------- | --------- | -| `nspecies` | Number of species | integer | -| `species` | Species IDs (see [SPECIES](running.md#species)) | 1D-array of integers | -| `kindz` | Reference level | integer: 1=above ground, 2=above sea level, 3 for pressure in hPa | - -<br/> - -**Data** - -| Variable name | Description | Data type | -| ------------- | ----------- | --------- | -| `longitude` | Initial longitude of each particle | 1D-array of reals with dimension `particle` | -| `latitude` | Initial latitude of each particle | 1D-array of reals with dimension `particle` | -| `height` | Initial height of each particle (meter above reference level) | 1D-array of reals with dimension `particle` | -| `time` | Release time of each particle seconds after simulation start (IBDATE/IBTIME for forward runs, IEDATE/IETIME for backward runs, set in [COMMAND](running.md#command)) | 1D-array of reals with dimension `particle` | -| `mass` | Initial mass of each particle (kg) | 2D-array of reals with dimension `species` and `particle` | -| `release` | Release ID of each particle, giving separate concentration fields for each ID when [IOUTPUTFOREACHRELEASE](running.md#ioutputforeachrelease) in [COMMAND](running.md#command) is set | 1D-array of integers with dimension `particle` | - -<br/> +### SLURM example script -## <a name="restart"></a>Restarting a simulation -In case your simulation crashes or if you simply want to extend your simulation period, it is possible to run using the restart option (COMMAND option file: IPIN=1). You will need to decide if you will need this option before starting your initial simulation: LOUTRESTART in the COMMAND option file needs to be set to an appropriate time interval. For example, you can choose to set LOUTRESTART = 172800 s to get a new restart file ever 2 days. The restart files are written in binary and their name specifies the time within your simulation period they are written. When LOUTRESTART is set to -1, this option is disabled. +``` +#!/bin/bash +#SBATCH --job-name=example +#SBATCH --output=example.log +#SBATCH --nodes=1 --ntasks-per-node=10 --ntasks-per-core=2 +#SBATCH --mem=30GB +#SBATCH --time=20:00:00 -To run from one of these files, simply rename the desired restart_XXX.bin file to restart.bin, set IPIN=1 and you can restart your run from there. +export OMP_NUM_THREADS=10 +export OMP_PLACES=cores +export OMP_PROC_BIND=true +ulimit -s unlimited -WARNING: If you chose to use gridded data output (IOUT>0), then new data will be written to this file. If it is not desirable to overwrite a gridded data output file from a previous run, copy this file to another directory. +./FLEXPART_ETA pathnames +``` \ No newline at end of file diff --git a/documentation/docs/troubleshooting.md b/documentation/docs/troubleshooting.md new file mode 100644 index 0000000000000000000000000000000000000000..de0cd630604304a8adedc1ca992374d971f664f9 --- /dev/null +++ b/documentation/docs/troubleshooting.md @@ -0,0 +1,26 @@ +# Trouble Shooting + +Here we provide a list of common problems and their solutions. + +<span style="color:seagreen;"> +If you have a problem that is not listed or clearly explained by an error message, please create a ticket on our gitlab page. +</span> + +#### **My application crashes with a segmentation fault shortly after its launch** +This could be due to having compiled with OpenMP, but not setting the following `ulimit` before launching your application, resulting in too little memory per core: +~~~ +ulimit -s unlimited +~~~ + +#### **My application is unexpectedly slow** +There could be many reasons for this to happen, here are some tips to make your application faster: + +- Make sure you compiled using appropriate optimisation flags (see [Optimisation](building.md#paths)). +- Check if you need the resolution of output grid, number of particles, and timestep you are currently using and reduce these where possible. For an explanation of all options, see [Configuration](configuration.md). +- Use more OpenMP threads when running your application. +- Make sure to set the following options in your command line (or submit script if you use one) before launching your application: +~~~ +export OMP_PLACES=cores +export OMP_PROC_BIND=true +~~~ + diff --git a/documentation/mkdocs.yml b/documentation/mkdocs.yml index b886b503a51a98087bb315b6262f868e87b5726f..9cddeee8112c79a762643c00a6defddf2b4b5e05 100644 --- a/documentation/mkdocs.yml +++ b/documentation/mkdocs.yml @@ -30,10 +30,13 @@ markdown_extensions: # - pymdownx.tilde nav: - 'index.md' - - 'installation.md' + - 'building.md' + - 'configuration.md' - 'running.md' - 'output.md' + - 'LCM.md' - 'transport.md' - 'evolution.md' - 'examples.md' + - 'troubleshooting.md' diff --git a/examples/Aerosol/AGECLASSES b/examples/Aerosol/AGECLASSES new file mode 100644 index 0000000000000000000000000000000000000000..bfcfb2457839a056a8b3d0c060183cd68d67e33c --- /dev/null +++ b/examples/Aerosol/AGECLASSES @@ -0,0 +1,17 @@ +************************************************ +* * +*Lagrangian particle dispersion model FLEXPART * +* Please select your options * +* * +*This file determines the ageclasses to be used* +* * +*Ages are given in seconds. The first class * +*starts at age zero and goes up to the first * +*age specified. The last age gives the maximum * +*time a particle is carried in the simulation. * +* * +************************************************ +&AGECLASS + NAGECLASS= 1, + LAGE= 1728000, + / diff --git a/examples/Aerosol/COMMAND b/examples/Aerosol/COMMAND new file mode 100644 index 0000000000000000000000000000000000000000..a23db5756af6148325e26c1eb49f88f3fb459a05 --- /dev/null +++ b/examples/Aerosol/COMMAND @@ -0,0 +1,38 @@ +*************************************************************************************************************** +* * +* Input file for the Lagrangian particle dispersion model FLEXPART * +* Please select your options * +* * +*************************************************************************************************************** +&COMMAND + LDIRECT= 1, ! Simulation direction in time ; 1 (forward) or -1 (backward) + IBDATE= 19950101, ! Start date of the simulation ; YYYYMMDD: YYYY=year, MM=month, DD=day + IBTIME= 000000, ! Start time of the simulation ; HHMISS: HH=hours, MI=min, SS=sec; UTC + IEDATE= 19950101, ! End date of the simulation ; same format as IBDATE + IETIME= 050000, ! End time of the simulation ; same format as IBTIME + LOUTSTEP= 3600, ! Interval of model output; average concentrations calculated every LOUTSTEP (s) !600 or 3600 + LOUTAVER= 3600, ! Interval of output averaging (s) !600 or 3600 + LOUTSAMPLE= 900, ! Interval of output sampling (s), higher stat. accuracy with shorter intervals !300 or 900 + LOUTRESTART= -1, ! Interval of particle splitting (s) + LSYNCTIME= 900, ! All processes are synchronized to this time interval (s) !300 or 900 + CTL= 10.0000000, ! CTL>1, ABL time step = (Lagrangian timescale (TL))/CTL, uses LSYNCTIME if CTL<0 + IFINE= 4, ! Reduction for time step in vertical transport, used only if CTL>1 + IOUT= 9, ! Output type: [1]mass 2]pptv 3]1&2 4]plume 5]1&4, +8 for NetCDF output + IPOUT= 0, ! Particle position output: 0]no 1]every output 2]only at end 3]time averaged + LSUBGRID= 0, ! Increase of ABL heights due to sub-grid scale orographic variations;[0]off 1]on + LCONVECTION= 1, ! Switch for convection parameterization;0]off [1]on + LAGESPECTRA= 0, ! Switch for calculation of age spectra (needs AGECLASSES);[0]off 1]on + IPIN= 0, ! Warm start from particle dump (needs previous partposit_end file); [0]no 1]yes + IOUTPUTFOREACHRELEASE= 1, ! Separate output fields for each location in the RELEASE file; [0]no 1]yes + IFLUX= 0, ! Output of mass fluxes through output grid box boundaries + MDOMAINFILL= 0, ! Switch for domain-filling, if limited-area particles generated at boundary + IND_SOURCE= 1, ! Unit to be used at the source ; [1]mass 2]mass mixing ratio + IND_RECEPTOR= 1, ! Unit to be used at the receptor; [1]mass 2]mass mixing ratio 3]wet depo. 4]dry depo. + MQUASILAG= 0, ! Quasi-Lagrangian mode to track individual numbered particles + NESTED_OUTPUT= 0, ! Output also for a nested domain + LINIT_COND= 0, ! Output sensitivity to initial conditions (bkw mode only) [0]off 1]conc 2]mmr + SURF_ONLY= 0, ! Output only for the lowest model layer, used w/ LINIT_COND=1 or 2 + CBLFLAG= 0, ! Skewed, not Gaussian turbulence in the convective ABL, need large CTL and IFINE + OHFIELDS_PATH= "../../flexin/", ! Default path for OH file + MAXTHREADGRID=16, + / diff --git a/examples/Aerosol/OUTGRID b/examples/Aerosol/OUTGRID new file mode 100644 index 0000000000000000000000000000000000000000..bcb8f77bc5316561b57c91c36252ae1998e47789 --- /dev/null +++ b/examples/Aerosol/OUTGRID @@ -0,0 +1,22 @@ +!******************************************************************************* +! * +! Input file for the Lagrangian particle dispersion model FLEXPART * +! Please specify your output grid * +! * +! OUTLON0 = GEOGRAPHYICAL LONGITUDE OF LOWER LEFT CORNER OF OUTPUT GRID * +! OUTLAT0 = GEOGRAPHYICAL LATITUDE OF LOWER LEFT CORNER OF OUTPUT GRID * +! NUMXGRID = NUMBER OF GRID POINTS IN X DIRECTION (= No. of cells + 1) * +! NUMYGRID = NUMBER OF GRID POINTS IN Y DIRECTION (= No. of cells + 1) * +! DXOUT = GRID DISTANCE IN X DIRECTION * +! DYOUN = GRID DISTANCE IN Y DIRECTION * +! OUTHEIGHTS = HEIGHT OF LEVELS (UPPER BOUNDARY) * +!******************************************************************************* +&OUTGRID + OUTLON0= 0.00, !-179.0 for ERAI; -178 for CERA; 0.0 for ERA5 + OUTLAT0= -90.00, + NUMXGRID= 720, !720 for ERA5; 180 for CERA + NUMYGRID= 360, !360 for ERA5; 90 for CERA + DXOUT= 0.5, + DYOUT= 0.5, + OUTHEIGHTS= 100.0,500.0,1000.0 + / diff --git a/examples/Aerosol/RELEASES b/examples/Aerosol/RELEASES new file mode 100644 index 0000000000000000000000000000000000000000..80e041c52fae7f1d0410592fb41398a52b9fa45c --- /dev/null +++ b/examples/Aerosol/RELEASES @@ -0,0 +1,35 @@ +*************************************************************************************************************** +* * +* * +* * +* Input file for the Lagrangian particle dispersion model FLEXPART * +* Please select your options * +* * +* * +* * +*************************************************************************************************************** +&RELEASES_CTRL + NSPEC = 1, ! Total number of species + SPECNUM_REL= 40, ! Species numbers in directory SPECIES + / +&RELEASE ! For each release + IDATE1 = 19950101, ! Release start date, YYYYMMDD: YYYY=year, MM=month, DD=day + ITIME1 = 000000, ! Release start time in UTC HHMISS: HH hours, MI=minutes, SS=seconds + IDATE2 = 19950101, ! Release end date, same as IDATE1I + ITIME2 = 000000, ! Release end time, same as ITIME1 + LON1 = 0.000, ! Left longitude of release box -180 < LON1 <180 + LON2 = 360.00, ! Right longitude of release box, same as LON1 + LAT1 = -90.000, ! Lower latitude of release box, -90 < LAT1 < 90 + LAT2 = 90.000, ! Upper latitude of release box same format as LAT1 + Z1 = 10.000, ! Lower height of release box meters/hPa above reference level + Z2 = 100.000, ! Upper height of release box meters/hPa above reference level + ZKIND = 1, ! Reference level 1=above ground, 2=above sea level, 3 for pressure in hPa + MASS = 1.0, ! Total mass emitted, only relevant for fwd simulations + PARTS = 1000000, ! Total number of particles to be released + COMMENT = "RELEASE 1", ! Comment, written in the outputfile + / + +&& Arctic: LON 17.00 17.5; LAT 78.00 78.5 (R4) +&& Tropical Pacific LON 147.00 147.5; LAT -10.0 -10.5 (R3) +&& Russan North: LON 53.0 53.5; LAT 62.0 62.5 (R2) +&& Italy: LON 10.0 10.5; LAT 45.0 45.5 (R1) diff --git a/options/SPECIES/SPECIES_040 b/examples/Aerosol/SPECIES/SPECIES_040 similarity index 54% rename from options/SPECIES/SPECIES_040 rename to examples/Aerosol/SPECIES/SPECIES_040 index db99287224c30d394f99c78aea4e5a611a059ce3..406f61b88e5fd67d049a63887cb5a659ee3089b3 100644 --- a/options/SPECIES/SPECIES_040 +++ b/examples/Aerosol/SPECIES/SPECIES_040 @@ -1,5 +1,5 @@ &SPECIES_PARAMS - PSPECIES="BC", ! Tracer name + PSPECIES="EXAMPLE", ! Tracer name PDECAY=-9.9, ! Species half life PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas) PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas) @@ -7,15 +7,21 @@ PCSNOW_AERO=1.0, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) PCCN_AERO=0.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) PIN_AERO=0.1, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=2000.0, ! Dry deposition (particles) - rho - PDQUER=4.0E-07, ! Dry deposition (particles) - dquer - PDSIGMA=3.3, ! Dry deposition (particles) - dsig + PDENSITY=1000.0, ! Dry deposition (particles) - rho ! default 2000 + PDIA=50.0E-06, ! Dry deposition (particles) - dia + PNDIA=11, ! Dry deposition (particles) - ndia + PDSIGMA=3.3, ! Dry deposition (particles) - dsig !default 3.3 PDRYVEL=-9.9, ! Alternative: dry deposition velocity PRELDIFF=-9.9, ! Dry deposition (gases) - D PHENRY=-0.9E-9, ! Dry deposition (gases) - Henrys const. PF0=-9, ! Dry deposition (gases) - f0 (reactivity) PWEIGHTMOLAR=-9.9, ! molweight - POHCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - C [cm^3/molecule/sec] + PCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec] + PDCONST=-9.9, ! OH Reaction rate - D [K] + PNCONST=2.0, ! OH Reaction rate - C [cm^3/molecule/sec] + PSHAPE=0, ! 0 for sphere, 1 for other shapes + PLA=940, ! Longest axis in micrometer (Bagheri & Bonadonna 2016) + PIA=9.4, ! Intermediate axis + PSA=9.4, ! Smallest axis + PORIENT=0, ! 0 for horizontal, 1 for random orientation of particles / diff --git a/examples/Nuclear/AGECLASSES b/examples/Nuclear/AGECLASSES new file mode 100644 index 0000000000000000000000000000000000000000..bfcfb2457839a056a8b3d0c060183cd68d67e33c --- /dev/null +++ b/examples/Nuclear/AGECLASSES @@ -0,0 +1,17 @@ +************************************************ +* * +*Lagrangian particle dispersion model FLEXPART * +* Please select your options * +* * +*This file determines the ageclasses to be used* +* * +*Ages are given in seconds. The first class * +*starts at age zero and goes up to the first * +*age specified. The last age gives the maximum * +*time a particle is carried in the simulation. * +* * +************************************************ +&AGECLASS + NAGECLASS= 1, + LAGE= 1728000, + / diff --git a/examples/Nuclear/COMMAND b/examples/Nuclear/COMMAND new file mode 100644 index 0000000000000000000000000000000000000000..0070458b25fce9e6c6728933780cbcbadf179858 --- /dev/null +++ b/examples/Nuclear/COMMAND @@ -0,0 +1,39 @@ +*************************************************************************************************************** +* * +* Input file for the Lagrangian particle dispersion model FLEXPART * +* Please select your options * +* * +*************************************************************************************************************** +&COMMAND + LDIRECT= 1, ! Simulation direction in time ; 1 (forward) or -1 (backward) + IBDATE= 20140101, ! Start date of the simulation ; YYYYMMDD: YYYY=year, MM=month, DD=day + IBTIME= 000000, ! Start time of the simulation ; HHMISS: HH=hours, MI=min, SS=sec; UTC + IEDATE= 20140101, ! End date of the simulation ; same format as IBDATE + IETIME= 050000, ! End time of the simulation ; same format as IBTIME + LOUTSTEP= 3600, ! Interval of model output; average concentrations calculated every LOUTSTEP (s) !600 or 3600 + LOUTAVER= 3600, ! Interval of output averaging (s) !600 or 3600 + LOUTSAMPLE= 900, ! Interval of output sampling (s), higher stat. accuracy with shorter intervals !300 or 900 + LOUTRESTART= -1, ! Interval of particle splitting (s) + LSYNCTIME= 900, ! All processes are synchronized to this time interval (s) !300 or 900 + CTL= 40.0000000, ! CTL>1, ABL time step = (Lagrangian timescale (TL))/CTL, uses LSYNCTIME if CTL<0 + IFINE= 5, ! Reduction for time step in vertical transport, used only if CTL>1 + IOUT= 9, ! Output type: [1]mass 2]pptv 3]1&2 4]plume 5]1&4, +8 for NetCDF output + IPOUT= 0, ! Particle position output: 0]no 1]every output 2]only at end 3]time averaged + LSUBGRID= 0, ! Increase of ABL heights due to sub-grid scale orographic variations;[0]off 1]on + LCONVECTION= 1, ! Switch for convection parameterization;0]off [1]on + LAGESPECTRA= 0, ! Switch for calculation of age spectra (needs AGECLASSES);[0]off 1]on + IPIN= 0, ! Warm start from particle dump (needs previous partposit_end file); [0]no 1]yes + IOUTPUTFOREACHRELEASE= 1, ! Separate output fields for each location in the RELEASE file; [0]no 1]yes + IFLUX= 0, ! Output of mass fluxes through output grid box boundaries + MDOMAINFILL= 0, ! Switch for domain-filling, if limited-area particles generated at boundary + IND_SOURCE= 1, ! Unit to be used at the source ; [1]mass 2]mass mixing ratio + IND_RECEPTOR= 1, ! Unit to be used at the receptor; [1]mass 2]mass mixing ratio 3]wet depo. 4]dry depo. + MQUASILAG= 0, ! Quasi-Lagrangian mode to track individual numbered particles + NESTED_OUTPUT= 1, ! Output also for a nested domain + LINIT_COND= 0, ! Output sensitivity to initial conditions (bkw mode only) [0]off 1]conc 2]mmr + SURF_ONLY= 0, ! Output only for the lowest model layer, used w/ LINIT_COND=1 or 2 + CBLFLAG= 1, ! Skewed, not Gaussian turbulence in the convective ABL, need large CTL and IFINE + OHFIELDS_PATH= "../../flexin/", ! Default path for OH file + NXSHIFT=0, + MAXTHREADGRID=16, + / diff --git a/examples/Nuclear/OUTGRID b/examples/Nuclear/OUTGRID new file mode 100644 index 0000000000000000000000000000000000000000..02886b0e7d9d0ade761fa9ad9505822bf578e22a --- /dev/null +++ b/examples/Nuclear/OUTGRID @@ -0,0 +1,12 @@ +&OUTGRID + OUTLON0= -179.500000 , + OUTLAT0= -90.0000000 , + NUMXGRID=360 , + NUMYGRID=180 , + DXOUT= 1.00000000 , + DYOUT= 1.00000000 , + OUTHEIGHTS= 100.000000 , 500.000000 , 1000.00000 , 2000.00000 , 3000.00000 , + 4000.00000 , 5000.00000 , 7000.00000 , 9000.00000 , 11000.0000 , 13000.0000 , + 15000.0000 , 17000.0000 , 20000.0000 , 25000.0000 , 30000.0000 , 40000.0000 , + 50000.0000 , + / diff --git a/examples/Nuclear/OUTGRID_NEST b/examples/Nuclear/OUTGRID_NEST new file mode 100644 index 0000000000000000000000000000000000000000..c4cd989c3115f65a5160e868c49b770a43a907e8 --- /dev/null +++ b/examples/Nuclear/OUTGRID_NEST @@ -0,0 +1,8 @@ +&OUTGRIDN + OUTLON0N= -15.0000000 , + OUTLAT0N= 30.0000000 , + NUMXGRIDN=220 , + NUMYGRIDN=168 , + DXOUTN= 0.250000000 , + DYOUTN= 0.250000000 , + / diff --git a/examples/Nuclear/RELEASES b/examples/Nuclear/RELEASES new file mode 100644 index 0000000000000000000000000000000000000000..82bf44c31c89d307ffe8507be2ffa14774a4166b --- /dev/null +++ b/examples/Nuclear/RELEASES @@ -0,0 +1,35 @@ +*************************************************************************************************************** +* * +* * +* * +* Input file for the Lagrangian particle dispersion model FLEXPART * +* Please select your options * +* * +* * +* * +*************************************************************************************************************** +&RELEASES_CTRL + NSPEC = 1, ! Total number of species + SPECNUM_REL= 21, ! Species numbers in directory SPECIES + / +&RELEASE ! For each release + IDATE1 = 20140101, ! Release start date, YYYYMMDD: YYYY=year, MM=month, DD=day + ITIME1 = 000000, ! Release start time in UTC HHMISS: HH hours, MI=minutes, SS=seconds + IDATE2 = 20140101, ! Release end date, same as IDATE1I + ITIME2 = 000000, ! Release end time, same as ITIME1 + LON1 = 6.000, ! Left longitude of release box -180 < LON1 <180 + LON2 = 6.000, ! Right longitude of release box, same as LON1 + LAT1 = 30.000, ! Lower latitude of release box, -90 < LAT1 < 90 + LAT2 = 30.000, ! Upper latitude of release box same format as LAT1 + Z1 = 10.000, ! Lower height of release box meters/hPa above reference level + Z2 = 100.000, ! Upper height of release box meters/hPa above reference level + ZKIND = 1, ! Reference level 1=above ground, 2=above sea level, 3 for pressure in hPa + MASS = 1.0, ! Total mass emitted, only relevant for fwd simulations + PARTS = 1000000, ! Total number of particles to be released + COMMENT = "RELEASE 1", ! Comment, written in the outputfile + / + +&& Arctic: LON 17.00 17.5; LAT 78.00 78.5 (R4) +&& Tropical Pacific LON 147.00 147.5; LAT -10.0 -10.5 (R3) +&& Russan North: LON 53.0 53.5; LAT 62.0 62.5 (R2) +&& Italy: LON 10.0 10.5; LAT 45.0 45.5 (R1) diff --git a/tests/default_options/SPECIES/SPECIES_021 b/examples/Nuclear/SPECIES/SPECIES_021 similarity index 76% rename from tests/default_options/SPECIES/SPECIES_021 rename to examples/Nuclear/SPECIES/SPECIES_021 index 4d89b6c7b82b42f59f48d30a1aaea7bc709af386..a76f6fc82b3aa6a884ec3100368a8c9b36e6956a 100644 --- a/tests/default_options/SPECIES/SPECIES_021 +++ b/examples/Nuclear/SPECIES/SPECIES_021 @@ -8,15 +8,14 @@ PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero) PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho - PDQUER=0.0, ! Dry deposition (particles) - dquer + PDIA=0.0, ! Dry deposition (particles) - dquer PDSIGMA=0.0, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia PDRYVEL=-9.99, ! Alternative: dry deposition velocity PRELDIFF=-9.9, ! Dry deposition (gases) - D PHENRY=-0.9E-9, ! Dry deposition (gases) - Henrys const. PF0=-9, ! Dry deposition (gases) - f0 (reactivity) PWEIGHTMOLAR=-9.9, ! molweight - POHCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) + PCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec] + PDCONST=-9.9, ! OH Reaction rate - D [K] + PNCONST=2.0, ! OH Reaction rate - N (no unit) / diff --git a/examples/Tracer/AGECLASSES b/examples/Tracer/AGECLASSES new file mode 100644 index 0000000000000000000000000000000000000000..08a41a662e7bd6b5301f7eb5af3ba1b3b3441d51 --- /dev/null +++ b/examples/Tracer/AGECLASSES @@ -0,0 +1,17 @@ +************************************************ +* * +*Lagrangian particle dispersion model FLEXPART * +* Please select your options * +* * +*This file determines the ageclasses to be used* +* * +*Ages are given in seconds. The first class * +*starts at age zero and goes up to the first * +*age specified. The last age gives the maximum * +*time a particle is carried in the simulation. * +* * +************************************************ +&AGECLASS + NAGECLASS= 1, + LAGE= 1728000, + / diff --git a/examples/Tracer/COMMAND b/examples/Tracer/COMMAND new file mode 100644 index 0000000000000000000000000000000000000000..ef8fd009a74f4bfa7d6c70161b208de00f5af486 --- /dev/null +++ b/examples/Tracer/COMMAND @@ -0,0 +1,37 @@ +*************************************************************************************************************** +* * +* Input file for the Lagrangian particle dispersion model FLEXPART * +* Please select your options * +* * +*************************************************************************************************************** +&COMMAND + LDIRECT= 1, ! Simulation direction in time ; 1 (forward) or -1 (backward) + IBDATE= 19950101, ! Start date of the simulation ; YYYYMMDD: YYYY=year, MM=month, DD=day + IBTIME= 000000, ! Start time of the simulation ; HHMISS: HH=hours, MI=min, SS=sec; UTC + IEDATE= 19950101, ! End date of the simulation ; same format as IBDATE + IETIME= 050000, ! End time of the simulation ; same format as IBTIME + LOUTSTEP= 3600, ! Interval of model output; average concentrations calculated every LOUTSTEP (s) + LOUTAVER= 3600, ! Interval of output averaging (s) + LOUTSAMPLE= 600, ! Interval of output sampling (s), higher stat. accuracy with shorter intervals + LOUTRESTART= -1, ! Interval of particle splitting (s) + LSYNCTIME= 600, ! All processes are synchronized to this time interval (s) + CTL= 10.0000000, ! CTL>1, ABL time step = (Lagrangian timescale (TL))/CTL, uses LSYNCTIME if CTL<0 + IFINE= 10, ! Reduction for time step in vertical transport, used only if CTL>1 + IOUT= 0, ! Output type: [1]mass 2]pptv 3]1&2 4]plume 5]1&4, +8 for NetCDF output + IPOUT= 1, ! Particle position output: 0]no 1]every output 2]only at end 3]time averaged + LSUBGRID= 1, ! Increase of ABL heights due to sub-grid scale orographic variations;[0]off 1]on + LCONVECTION= 1, ! Switch for convection parameterization;0]off [1]on + LAGESPECTRA= 0, ! Switch for calculation of age spectra (needs AGECLASSES);[0]off 1]on + IPIN= 0, ! Warm start from particle dump (needs previous partposit_end file); [0]no 1]yes + IOUTPUTFOREACHRELEASE= 0, ! Separate output fields for each location in the RELEASE file; [0]no 1]yes + IFLUX= 0, ! Output of mass fluxes through output grid box boundaries + MDOMAINFILL= 1, ! Switch for domain-filling, if limited-area particles generated at boundary + IND_SOURCE= 1, ! Unit to be used at the source ; [1]mass 2]mass mixing ratio + IND_RECEPTOR= 1, ! Unit to be used at the receptor; [1]mass 2]mass mixing ratio 3]wet depo. 4]dry depo. + MQUASILAG= 0, ! Quasi-Lagrangian mode to track individual numbered particles + NESTED_OUTPUT= 0, ! Output also for a nested domain + LINIT_COND= 0, ! Output sensitivity to initial conditions (bkw mode only) [0]off 1]conc 2]mmr + SURF_ONLY= 0, ! Output only for the lowest model layer, used w/ LINIT_COND=1 or 2 + CBLFLAG= 0, ! Skewed, not Gaussian turbulence in the convective ABL, need large CTL and IFINE + OHFIELDS_PATH= "../../flexin/", ! Default path for OH file + / diff --git a/examples/Tracer/OUTGRID b/examples/Tracer/OUTGRID new file mode 100644 index 0000000000000000000000000000000000000000..6debcb369571c698c24e4da0f59dbc9695edd10e --- /dev/null +++ b/examples/Tracer/OUTGRID @@ -0,0 +1,22 @@ +!******************************************************************************* +! * +! Input file for the Lagrangian particle dispersion model FLEXPART * +! Please specify your output grid * +! * +! OUTLON0 = GEOGRAPHYICAL LONGITUDE OF LOWER LEFT CORNER OF OUTPUT GRID * +! OUTLAT0 = GEOGRAPHYICAL LATITUDE OF LOWER LEFT CORNER OF OUTPUT GRID * +! NUMXGRID = NUMBER OF GRID POINTS IN X DIRECTION (= No. of cells + 1) * +! NUMYGRID = NUMBER OF GRID POINTS IN Y DIRECTION (= No. of cells + 1) * +! DXOUT = GRID DISTANCE IN X DIRECTION * +! DYOUN = GRID DISTANCE IN Y DIRECTION * +! OUTHEIGHTS = HEIGHT OF LEVELS (UPPER BOUNDARY) * +!******************************************************************************* +&OUTGRID + OUTLON0= 0.00, + OUTLAT0= -90.00, + NUMXGRID= 60, + NUMYGRID= 30, + DXOUT= 6.00, + DYOUT= 6.00, + OUTHEIGHTS= 100.0, 500.0, 1000.0 , 50000.0, + / diff --git a/examples/Tracer/PARTOPTIONS b/examples/Tracer/PARTOPTIONS new file mode 100644 index 0000000000000000000000000000000000000000..04a2bdebb38dfc77c83632286227fe1990cbc22d --- /dev/null +++ b/examples/Tracer/PARTOPTIONS @@ -0,0 +1,38 @@ +*************************************************************************************************************** +* * +* Input file for the Lagrangian particle dispersion model FLEXPART * +* Please select which fields you would like to print in the partoutput files * +* * +*************************************************************************************************************** +&PARTOPTIONS + LONGITUDE= .true., ! + LONGITUDE_AVERAGE= .false., ! + LATITUDE= .true., ! + LATITUDE_AVERAGE= .false., ! + HEIGHT= .true., ! + HEIGHT_AVERAGE= .false., ! + PV= .true., ! + PV_AVERAGE= .false., ! + QV= .true., ! + QV_AVERAGE= .false., ! + DENSITY= .true., ! + DENSITY_AVERAGE= .false., ! + TEMPERATURE= .true., ! + TEMPERATURE_AVERAGE= .false., ! + PRESSURE= .false., ! + PRESSURE_AVERAGE= .false., ! + MIXINGHEIGHT= .true., ! + MIXINGHEIGHT_AVERAGE= .false., ! + TROPOPAUSE= .true., ! + TROPOPAUSE_AVERAGE= .false., ! + TOPOGRAPHY= .true., ! + TOPOGRAPHY_AVERAGE= .false., ! + MASS= .true., ! + MASS_AVERAGE= .false., ! + U= .false., ! + U_AVERAGE= .false., ! + V= .false., ! + V_AVERAGE= .false., ! + W= .false., ! + W_AVERAGE= .false., ! + / diff --git a/examples/Tracer/RELEASES b/examples/Tracer/RELEASES new file mode 100644 index 0000000000000000000000000000000000000000..f9761508e5831a2fa22450738def8c009762db6a --- /dev/null +++ b/examples/Tracer/RELEASES @@ -0,0 +1,30 @@ +*************************************************************************************************************** +* * +* * +* * +* Input file for the Lagrangian particle dispersion model FLEXPART * +* Please select your options * +* * +* * +* * +*************************************************************************************************************** +&RELEASES_CTRL + NSPEC = 1, ! Total number of species + SPECNUM_REL= 24, ! Species numbers in directory SPECIES + / +&RELEASE ! For each release + IDATE1 = 19950101, ! Release start date, YYYYMMDD: YYYY=year, MM=month, DD=day + ITIME1 = 000000, ! Release start time in UTC HHMISS: HH hours, MI=minutes, SS=seconds + IDATE2 = 19950101, ! Release end date, same as IDATE1 + ITIME2 = 000000, ! Release end time, same as ITIME1 + LON1 = 0.000, ! Left longitude of release box -180 < LON1 <180 + LON2 = 360.000, ! Right longitude of release box, same as LON1 + LAT1 = -90.000, ! Lower latitude of release box, -90 < LAT1 < 90 + LAT2 = 90.000, ! Upper latitude of release box same format as LAT1 + Z1 = 0.000, ! Lower height of release box meters/hPa above reference level + Z2 = 35000.000, ! Upper height of release box meters/hPa above reference level + ZKIND = 1, ! Reference level 1=above ground, 2=above sea level, 3 for pressure in hPa + MASS = 5.09256513E18, ! Total mass emitted, only relevant for fwd simulations + PARTS = 10000000, ! Total number of particles to be released + COMMENT = "RELEASE 1", ! Comment, written in the outputfile + / diff --git a/options/SPECIES/SPECIES_024 b/examples/Tracer/SPECIES/SPECIES_024 similarity index 77% rename from options/SPECIES/SPECIES_024 rename to examples/Tracer/SPECIES/SPECIES_024 index 92284f313318b9049fd380055b1bb98b2af05b3f..051755a530c03a096113859e2eb7d49bb55294a0 100644 --- a/options/SPECIES/SPECIES_024 +++ b/examples/Tracer/SPECIES/SPECIES_024 @@ -8,15 +8,14 @@ PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero) PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho - PDQUER=0.0, ! Dry deposition (particles) - dquer + PDIA=0.0, ! Dry deposition (particles) - dquer PDSIGMA=0.0, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia PDRYVEL=-9.99, ! Alternative: dry deposition velocity PRELDIFF=-9.9, ! Dry deposition (gases) - D PHENRY=-0.9E-9, ! Dry deposition (gases) - Henrys const. PF0=-9, ! Dry deposition (gases) - f0 (reactivity) PWEIGHTMOLAR=29.0, ! molweight - POHCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) + PCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec] + PDCONST=-9.9, ! OH Reaction rate - D [K] + PNCONST=2.0, ! OH Reaction rate - N (no unit) / diff --git a/options/COMMAND b/options/COMMAND index e759d3f6fda8f0b76e444190dcbd5eed01d3b44d..397f8677023c8e4eda21d7b029930f9b7f262c3a 100644 --- a/options/COMMAND +++ b/options/COMMAND @@ -14,6 +14,9 @@ LOUTAVER= 3600, ! Interval of output averaging (s) LOUTSAMPLE= 900, ! Interval of output sampling (s), higher stat. accuracy with shorter intervals LOUTRESTART= 86400, ! Interval of writing restart files (s), switched off when set to -1 + LRECOUTSTEP= 3600, ! Interval of model output at receptors (s) + LRECOUTAVER= 3600, ! Interval of receptor output averaging (s) + LRECOUTSAMPLE= 1200, ! Interval of receptor output sampling (s) LSYNCTIME= 900, ! All processes are synchronized to this time interval (s) CTL= -5.0000000, ! CTL>1, ABL time step = (Lagrangian timescale (TL))/CTL, uses LSYNCTIME if CTL<0 IFINE= 4, ! Reduction for time step in vertical transport, used only if CTL>1 @@ -41,4 +44,5 @@ MAXTHREADGRID= 1, ! Set maximum number of threads for doing grid computations. Recommended to set this no higher than 16. High numbers create more overhead and a larger memory footprint, 1=no parallelisation on grid. MAXFILESIZE= 10000, ! Maximum output of each partoutput NetCDF-4 file in Mb before a new one is created LOGVERTINTERP= 0, ! Flag to set all vertical interpolation to logarithmic instead of linear + LCMOUTPUT= 0, ! Switch for the Linear Chemistry Module; [0] off [1] on / diff --git a/options/INITCONC b/options/INITCONC new file mode 100644 index 0000000000000000000000000000000000000000..9f82370e68ec38489dcadc773230a6975c41d06b --- /dev/null +++ b/options/INITCONC @@ -0,0 +1,41 @@ +!******************************************************************************* +! * +! Input file for the Lagrangian particle dispersion model FLEXPART * +! Please specify file info for initial mixing ratios (domainfill runs only) * +! * +! NINIT = number of species for which initial concentration specified * +! SPECNUM_REL = list of species of length nspec * +! * +! Specify INITCONC variables for each species: * +! PATH_NAME = path to initial concentration files * +! FILE_NAME = generic name of file (using YYYY[MM][DD]) for dates * +! VAR_NAME = name of concentration variable in file * +! HYA_NAME = name of hybrid pressure coord A (use "" if none) * +! HYB_NAME = name of hybrid pressure coord B (use "" if none) * +! PS_NAME = name of surface pressure variable (use "" if none) * +! Q_NAME = name of specific humidity variable (use "" if none, then * +! assumes dry air mixing ratio) * +! PRS_NAME = name of vertical pressure coordinate (use "" if none) * +! ALT_NAME = name of altitude coordinate (use "" if none) * +! COEFF = coefficient from input unit to ppbv * +! * +! Note: if hybrid pres coord need variable PS_NAME, otherwise one of * +! ALT_NAME or PRS_NAME needs to be given * +! * +!******************************************************************************* +&INITCONC_CTRL + NINIT = 1, + SPECNUM_REL = 26, +/ +&INITCONC + PATH_NAME = "/xnilu_wrk/users/rlt/NILU/FLEXDATA/BACKGROUND/CAMS/CH4/v20r1/", + FILE_NAME = "cams73_v20r1_ch4_conc_surface_dm_YYYYMM.nc", + VAR_NAME = "CH4", + HYA_NAME = "hyam", + HYB_NAME = "hybm", + PS_NAME = "ps", + Q_NAME = "Q", + PRS_NAME = "", + ALT_NAME = "", + COEFF = 1., +/ diff --git a/options/REAGENTS b/options/REAGENTS new file mode 100644 index 0000000000000000000000000000000000000000..7b487b16caa17c243df8f80459eaade6aca96db0 --- /dev/null +++ b/options/REAGENTS @@ -0,0 +1,16 @@ +!******************************************************************************* +! * +! Input file for the Lagrangian particle dispersion model FLEXPART * +! Please specify reagents used for chemical loss * +! * +! PREAGENT = reagent name (must be same as variable name and match those * +! used in reactions list in SPECIES file) * +! PREAG_PATH = path to reagent file * +! PHOURLY = interpolate field to hourly based on solar zenith angle * +! (0 = NO, 1 = YES) * +!******************************************************************************* +&REAGENT_PARAMS + PREAGENT="OH", + PREAG_PATH="./oh_fields/", + PHOURLY=1, +/ diff --git a/options/RECEPTORS b/options/RECEPTORS index 91806c1b31cc870f36da4fd149df5330faeda4f6..7dce6836420530d4b70d0c594b566cd366078c21 100644 --- a/options/RECEPTORS +++ b/options/RECEPTORS @@ -1,10 +1,232 @@ &RECEPTORS - RECEPTOR="receptor 1", - LON = 0.0000000, - LAT = 0.0000000, + RECEPTOR="BRW ", + LAT= 71.3199997 , + LON= -156.610001 , + ALT= 16.0000000 , + TIME= 2459032.0000000000 , / &RECEPTORS - RECEPTOR="receptor 2", - LON = 1.00000000, - LAT = 0.00000000, + RECEPTOR="CRV ", + LAT= 64.9899979 , + LON= -147.600006 , + ALT= 32.0000000 , + TIME= 2459032.0000000000 , / +&RECEPTORS + RECEPTOR="LEF ", + LAT= 45.9500008 , + LON= -90.2699966 , + ALT= 396.000000 , + TIME= 2459032.0000000000 , + / +&RECEPTORS + RECEPTOR="MLO ", + LAT= 19.5400009 , + LON= -155.580002 , + ALT= 300.000000 , + TIME= 2459032.0000000000 , + / +&RECEPTORS + RECEPTOR="SCT ", + LAT= 33.4099998 , + LON= -81.8300018 , + ALT= 305.000000 , + TIME= 2459032.0000000000 , + / +&RECEPTORS + RECEPTOR="WGC ", + LAT= 38.2599983 , + LON= -121.489998 , + ALT= 484.000000 , + TIME= 2459032.0000000000 , + / +&RECEPTORS + RECEPTOR="MHD ", + LAT= 53.3300018 , + LON= -9.98999977 , + ALT= 11.0000000 , + TIME= 2459032.0000000000 , + / +&RECEPTORS + RECEPTOR="THD ", + LAT= 41.0499992 , + LON= -124.150002 , + ALT= 15.0000000 , + TIME= 2459032.0000000000 , + / +&RECEPTORS + RECEPTOR="RPB ", + LAT= 13.1700001 , + LON= -59.4300003 , + ALT= 13.0000000 , + TIME= 2459032.0000000000 , + / +&RECEPTORS + RECEPTOR="SMO ", + LAT= -14.2500000 , + LON= -170.559998 , + ALT= 35.0000000 , + TIME= 2459032.0000000000 , + / +&RECEPTORS + RECEPTOR="CGO ", + LAT= -40.6800003 , + LON= 144.690002 , + ALT= 80.0000000 , + TIME= 2459032.0000000000 , + / +&RECEPTORS + RECEPTOR="BRW ", + LAT= 71.3199997 , + LON= -156.610001 , + ALT= 16.0000000 , + TIME= 2459032.0416666665 , + / +&RECEPTORS + RECEPTOR="CRV ", + LAT= 64.9899979 , + LON= -147.600006 , + ALT= 32.0000000 , + TIME= 2459032.0416666665 , + / +&RECEPTORS + RECEPTOR="LEF ", + LAT= 45.9500008 , + LON= -90.2699966 , + ALT= 396.000000 , + TIME= 2459032.0416666665 , + / +&RECEPTORS + RECEPTOR="MLO ", + LAT= 19.5400009 , + LON= -155.580002 , + ALT= 300.000000 , + TIME= 2459032.0416666665 , + / +&RECEPTORS + RECEPTOR="SCT ", + LAT= 33.4099998 , + LON= -81.8300018 , + ALT= 305.000000 , + TIME= 2459032.0416666665 , + / +&RECEPTORS + RECEPTOR="WGC ", + LAT= 38.2599983 , + LON= -121.489998 , + ALT= 484.000000 , + TIME= 2459032.0416666665 , + / +&RECEPTORS + RECEPTOR="MHD ", + LAT= 53.3300018 , + LON= -9.98999977 , + ALT= 11.0000000 , + TIME= 2459032.0416666665 , + / +&RECEPTORS + RECEPTOR="THD ", + LAT= 41.0499992 , + LON= -124.150002 , + ALT= 15.0000000 , + TIME= 2459032.0416666665 , + / +&RECEPTORS + RECEPTOR="RPB ", + LAT= 13.1700001 , + LON= -59.4300003 , + ALT= 13.0000000 , + TIME= 2459032.0416666665 , + / +&RECEPTORS + RECEPTOR="SMO ", + LAT= -14.2500000 , + LON= -170.559998 , + ALT= 35.0000000 , + TIME= 2459032.0416666665 , + / +&RECEPTORS + RECEPTOR="CGO ", + LAT= -40.6800003 , + LON= 144.690002 , + ALT= 80.0000000 , + TIME= 2459032.0416666665 , + / +&RECEPTORS + RECEPTOR="BRW ", + LAT= 71.3199997 , + LON= -156.610001 , + ALT= 16.0000000 , + TIME= 2459032.0833333335 , + / +&RECEPTORS + RECEPTOR="CRV ", + LAT= 64.9899979 , + LON= -147.600006 , + ALT= 32.0000000 , + TIME= 2459032.0833333335 , + / +&RECEPTORS + RECEPTOR="LEF ", + LAT= 45.9500008 , + LON= -90.2699966 , + ALT= 396.000000 , + TIME= 2459032.0833333335 , + / +&RECEPTORS + RECEPTOR="MLO ", + LAT= 19.5400009 , + LON= -155.580002 , + ALT= 300.000000 , + TIME= 2459032.0833333335 , + / +&RECEPTORS + RECEPTOR="SCT ", + LAT= 33.4099998 , + LON= -81.8300018 , + ALT= 305.000000 , + TIME= 2459032.0833333335 , + / +&RECEPTORS + RECEPTOR="WGC ", + LAT= 38.2599983 , + LON= -121.489998 , + ALT= 484.000000 , + TIME= 2459032.0833333335 , + / +&RECEPTORS + RECEPTOR="MHD ", + LAT= 53.3300018 , + LON= -9.98999977 , + ALT= 11.0000000 , + TIME= 2459032.0833333335 , + / +&RECEPTORS + RECEPTOR="THD ", + LAT= 41.0499992 , + LON= -124.150002 , + ALT= 15.0000000 , + TIME= 2459032.0833333335 , + / +&RECEPTORS + RECEPTOR="RPB ", + LAT= 13.1700001 , + LON= -59.4300003 , + ALT= 13.0000000 , + TIME= 2459032.0833333335 , + / +&RECEPTORS + RECEPTOR="SMO ", + LAT= -14.2500000 , + LON= -170.559998 , + ALT= 35.0000000 , + TIME= 2459032.0833333335 , + / +&RECEPTORS + RECEPTOR="CGO ", + LAT= -40.6800003 , + LON= 144.690002 , + ALT= 80.0000000 , + TIME= 2459032.0833333335 , + / + diff --git a/options/SATELLITES b/options/SATELLITES new file mode 100644 index 0000000000000000000000000000000000000000..1fa0d63ac6468397abfca4c49a7f25d44782e7d7 --- /dev/null +++ b/options/SATELLITES @@ -0,0 +1,5 @@ +&SATELLITES + PSATNAME = "esa_ch4", + PPATH = "/home/rthompson/BACKWARD_RUNS/REGAME/bremen/test_fpctm/", + PFILE = "releases_esa_ch4_YYYYMMDD.nc", + / diff --git a/options/SPECIES/Radionuclides/SPECIES_Ba-140 b/options/SPECIES/Radionuclides/SPECIES_Ba-140 new file mode 100644 index 0000000000000000000000000000000000000000..46f23a3fe9525a608506737e93ffcc22ef0b0c66 --- /dev/null +++ b/options/SPECIES/Radionuclides/SPECIES_Ba-140 @@ -0,0 +1,11 @@ +&SPECIES_PARAMS + PSPECIES="Ba-140", ! Tracer name: BARIUM 140 + PDECAY=1101721.0, ! Species half life [https://www.internetchemie.info/chemische-elemente/isotope.php] + PCRAIN_AERO=3.6, ! Below-cloud scavenging (particles) - Crain (crain_aero) [Grythe et al. (2017), Van Leuven et al. (2023)] + PCSNOW_AERO=1.4, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) [Grythe et al. (2017), Van Leuven et al. (2023)] + PCCN_AERO=1.8, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) [Grythe et al. (2017), Van Leuven et al. (2023)] + PIN_AERO=1.6, ! In-cloud scavenging (particles) - INeff (in_aero) [Grythe et al. (2017), Van Leuven et al. (2023)] + PDENSITY=1900.0, ! Dry deposition (particles) - rho [Van Leuven et al. (2023)] + PDIA=0.65E-06, ! Dry deposition (particles) - dquer [Van Leuven et al. (2023)] + PDSIGMA=3.0, ! Dry deposition (particles) - dsig [Van Leuven et al. (2023)] + / diff --git a/options/SPECIES/Radionuclides/SPECIES_CH3I-131 b/options/SPECIES/Radionuclides/SPECIES_CH3I-131 new file mode 100644 index 0000000000000000000000000000000000000000..a5409b8fa52f786f3af0aeb40303d412cf19f1db --- /dev/null +++ b/options/SPECIES/Radionuclides/SPECIES_CH3I-131 @@ -0,0 +1,7 @@ +&SPECIES_PARAMS + PSPECIES="CH-3-I-131", ! Tracer name: METHYL IODIDE + PDECAY=693382.0, ! Species half life [https://www.internetchemie.info/chemische-elemente/isotope.php] + PWETA_GAS=8.0E-07, ! Below-cloud scavenging (gases) - A (weta_gas) [Asman (1995), Paesler-Sauer (2003)] + PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas) [Asman (1995)] + PDRYVEL=0.1E-3, ! Alternative: dry deposition velocity [Mueller and Proehl (1993), average of grass and soil] + / diff --git a/options/SPECIES/Radionuclides/SPECIES_Cs-137 b/options/SPECIES/Radionuclides/SPECIES_Cs-137 new file mode 100644 index 0000000000000000000000000000000000000000..912428eb070dc1d94c4beb82a50b781cdb27a6a4 --- /dev/null +++ b/options/SPECIES/Radionuclides/SPECIES_Cs-137 @@ -0,0 +1,12 @@ +&SPECIES_PARAMS + PSPECIES="Cs-137", ! Tracer name: CESIUM 137 + PDECAY=-9.9, ! Species half life (948886704 sec) [https://www.internetchemie.info/chemische-elemente/isotope.php] + PCRAIN_AERO=3.6, ! Below-cloud scavenging (particles) - Crain (crain_aero) [Grythe et al. (2017), Van Leuven et al. (2023)] + PCSNOW_AERO=1.4, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) [Grythe et al. (2017), Van Leuven et al. (2023)] + PCCN_AERO=1.8, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) [Grythe et al. (2017), Van Leuven et al. (2023)] + PIN_AERO=1.6, ! In-cloud scavenging (particles) - INeff (in_aero) [Grythe et al. (2017), Van Leuven et al. (2023)] + PDENSITY=1900.0, ! Dry deposition (particles) - rho [Van Leuven et al. (2023)] + PDIA=0.65E-06, ! Dry deposition (particles) - dquer [Van Leuven et al. (2023)] + PDSIGMA=3.0, ! Dry deposition (particles) - dsig [Van Leuven et al. (2023)] + PWEIGHTMOLAR=-9.9, ! molweight + / diff --git a/options/SPECIES/Radionuclides/SPECIES_I-131 b/options/SPECIES/Radionuclides/SPECIES_I-131 new file mode 100644 index 0000000000000000000000000000000000000000..b31939a552f602da3777907fd015ffcc063c2596 --- /dev/null +++ b/options/SPECIES/Radionuclides/SPECIES_I-131 @@ -0,0 +1,11 @@ +&SPECIES_PARAMS + PSPECIES="I-131", ! Tracer name: PARTICLE-BOUND IODINE 131 + PDECAY=693382.0, ! Species half life [https://www.internetchemie.info/chemische-elemente/isotope.php] + PCRAIN_AERO=3.6, ! Below-cloud scavenging (particles) - Crain (crain_aero) [Grythe et al. (2017), Van Leuven et al. (2023)] + PCSNOW_AERO=1.4, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) [Grythe et al. (2017), Van Leuven et al. (2023)] + PCCN_AERO=1.8, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) [Grythe et al. (2017), Van Leuven et al. (2023)] + PIN_AERO=1.6, ! In-cloud scavenging (particles) - INeff (in_aero) [Grythe et al. (2017), Van Leuven et al. (2023)] + PDENSITY=1900.0, ! Dry deposition (particles) - rho [Van Leuven et al. (2023)] + PDIA=5.0E-07, ! Dry deposition (particles) - dquer [Baklanov and Sorensen (2001)] + PDSIGMA=3.0, ! Dry deposition (particles) - dsig [Baklanov and Sorensen (2001)] + / diff --git a/options/SPECIES/Radionuclides/SPECIES_I2-131 b/options/SPECIES/Radionuclides/SPECIES_I2-131 new file mode 100644 index 0000000000000000000000000000000000000000..94d318aa837a57a5305938e99de41b85e47bc117 --- /dev/null +++ b/options/SPECIES/Radionuclides/SPECIES_I2-131 @@ -0,0 +1,10 @@ +&SPECIES_PARAMS + PSPECIES="I2-131", ! Tracer name: ELEMENTAL IODINE 131 + PDECAY=693382.0, ! Species half life [https://www.internetchemie.info/chemische-elemente/isotope.php] + PWETA_GAS=8.0E-05, ! Below-cloud scavenging (gases) - A (weta_gas) [Asman (1995), Paesler-Sauer (2003)] + PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas) [Asman (1995)] + PRELDIFF=2.7, ! Dry deposition (gases) - D + PHENRY=100000.0, ! Dry deposition (gases) - Henrys const. + PF0=0.1, ! Dry deposition (gases) - f0 (reactivity) + PWEIGHTMOLAR=-9.9, ! molweight + / diff --git a/options/SPECIES/Radionuclides/SPECIES_Kr-85 b/options/SPECIES/Radionuclides/SPECIES_Kr-85 new file mode 100644 index 0000000000000000000000000000000000000000..794e4736223592cdeae0d5c1847fa4d77381c337 --- /dev/null +++ b/options/SPECIES/Radionuclides/SPECIES_Kr-85 @@ -0,0 +1,5 @@ +&SPECIES_PARAMS + PSPECIES="Kr-85", ! Tracer name: KRYPTON 85 + PDECAY=-9.9, ! Species half life (338669519 sec) [https://www.internetchemie.info/chemische-elemente/isotope.php] + PWEIGHTMOLAR=-9.9, ! molweight + / diff --git a/options/SPECIES/Radionuclides/SPECIES_Particulate-radionuclide b/options/SPECIES/Radionuclides/SPECIES_Particulate-radionuclide new file mode 100644 index 0000000000000000000000000000000000000000..ac7013883d1859c3c958155d15276c90b4872d22 --- /dev/null +++ b/options/SPECIES/Radionuclides/SPECIES_Particulate-radionuclide @@ -0,0 +1,11 @@ +&SPECIES_PARAMS + PSPECIES="Particulate-Radionuclide", ! Tracer name: e.g. Y-92, Ru-106, I-131, Cs-137 + PDECAY=-9.9, ! Species half life [https://www.internetchemie.info/chemische-elemente/isotope.php] + PCRAIN_AERO=3.6, ! Below-cloud scavenging (particles) - Crain (crain_aero) [arbitrary value] + PCSNOW_AERO=1.4, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) [arbitrary value] + PCCN_AERO=1.8, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) [arbitrary value] + PIN_AERO=1.6, ! In-cloud scavenging (particles) - INeff (in_aero) [arbitrary value] + PDENSITY=1900.0, ! Dry deposition (particles) - rho [arbitrary value] + PDIA=0.65E-06, ! Dry deposition (particles) - dquer [arbitrary value] + PDSIGMA=3.0, ! Dry deposition (particles) - dsig [arbitrary value] + / diff --git a/options/SPECIES/Radionuclides/SPECIES_Ru-106 b/options/SPECIES/Radionuclides/SPECIES_Ru-106 new file mode 100644 index 0000000000000000000000000000000000000000..7b553651a4ed0d5bcedb3f8bfd404f0c82ddafe9 --- /dev/null +++ b/options/SPECIES/Radionuclides/SPECIES_Ru-106 @@ -0,0 +1,11 @@ +&SPECIES_PARAMS + PSPECIES="Ru-106", ! Tracer name: RUTHENIUM 106 + PDECAY=-9.9, ! Species half life (32125075 sec) [https://www.internetchemie.info/chemische-elemente/isotope.php] + PCRAIN_AERO=3.6, ! Below-cloud scavenging (particles) - Crain (crain_aero) [Grythe et al. (2017), Van Leuven et al. (2023)] + PCSNOW_AERO=1.4, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) [Grythe et al. (2017), Van Leuven et al. (2023)] + PCCN_AERO=1.8, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) [Grythe et al. (2017), Van Leuven et al. (2023)] + PIN_AERO=1.6, ! In-cloud scavenging (particles) - INeff (in_aero) [Grythe et al. (2017), Van Leuven et al. (2023)] + PDENSITY=1900.0, ! Dry deposition (particles) - rho [Van Leuven et al. (2023)] + PDIA=0.65E-06, ! Dry deposition (particles) - dquer [Van Leuven et al. (2023)] + PDSIGMA=3.0, ! Dry deposition (particles) - dsig [Van Leuven et al. (2023)] + / diff --git a/options/SPECIES/Radionuclides/SPECIES_Sr-90 b/options/SPECIES/Radionuclides/SPECIES_Sr-90 new file mode 100644 index 0000000000000000000000000000000000000000..4acd107510a35f618525b2320232f5c81e2ed4bc --- /dev/null +++ b/options/SPECIES/Radionuclides/SPECIES_Sr-90 @@ -0,0 +1,11 @@ +&SPECIES_PARAMS + PSPECIES="Sr-90", ! Tracer name: STRONTIUM 90 + PDECAY=-9.9, ! Species half life (911800368 sec) [https://www.internetchemie.info/chemische-elemente/isotope.php] + PCRAIN_AERO=3.6, ! Below-cloud scavenging (particles) - Crain (crain_aero) [Grythe et al. (2017), Van Leuven et al. (2023)] + PCSNOW_AERO=1.4, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) [Grythe et al. (2017), Van Leuven et al. (2023)] + PCCN_AERO=1.8, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) [Grythe et al. (2017), Van Leuven et al. (2023)] + PIN_AERO=1.6, ! In-cloud scavenging (particles) - INeff (in_aero) [Grythe et al. (2017), Van Leuven et al. (2023)] + PDENSITY=1900.0, ! Dry deposition (particles) - rho [Van Leuven et al. (2023)] + PDIA=0.65E-06, ! Dry deposition (particles) - dquer [Van Leuven et al. (2023)] + PDSIGMA=3.0, ! Dry deposition (particles) - dsig [Van Leuven et al. (2023)] + / diff --git a/options/SPECIES/Radionuclides/SPECIES_Xe-131m b/options/SPECIES/Radionuclides/SPECIES_Xe-131m new file mode 100644 index 0000000000000000000000000000000000000000..bb1222c833d6cba441851251134a2b4906b12ab0 --- /dev/null +++ b/options/SPECIES/Radionuclides/SPECIES_Xe-131m @@ -0,0 +1,4 @@ +&SPECIES_PARAMS + PSPECIES="Xe-131m", ! Tracer name: XENON 131 metastable + PDECAY=1023322.0, ! Species half life [https://www.internetchemie.info/chemische-elemente/isotope.php] + / diff --git a/options/SPECIES/Radionuclides/SPECIES_Xe-133 b/options/SPECIES/Radionuclides/SPECIES_Xe-133 new file mode 100644 index 0000000000000000000000000000000000000000..071e15e66a3d457f136f0cc225f9ea7daccdf256 --- /dev/null +++ b/options/SPECIES/Radionuclides/SPECIES_Xe-133 @@ -0,0 +1,4 @@ +&SPECIES_PARAMS + PSPECIES="Xe-133", ! Tracer name: XENON 133 + PDECAY=453388, ! Species half life [https://www.internetchemie.info/chemische-elemente/isotope.php] + / diff --git a/options/SPECIES/Radionuclides/SPECIES_Xe-133m b/options/SPECIES/Radionuclides/SPECIES_Xe-133m new file mode 100644 index 0000000000000000000000000000000000000000..365f23ca1a12f30dbb0747256fd61a7fee996c90 --- /dev/null +++ b/options/SPECIES/Radionuclides/SPECIES_Xe-133m @@ -0,0 +1,4 @@ +&SPECIES_PARAMS + PSPECIES="Xe-133m", ! Tracer name: XENON 133 metastable + PDECAY=189918.0, ! Species half life [https://www.internetchemie.info/chemische-elemente/isotope.php] + / diff --git a/options/SPECIES/Radionuclides/SPECIES_Xe-135 b/options/SPECIES/Radionuclides/SPECIES_Xe-135 new file mode 100644 index 0000000000000000000000000000000000000000..1401292e9ef5622a002e8fa953a51af19fce7ec1 --- /dev/null +++ b/options/SPECIES/Radionuclides/SPECIES_Xe-135 @@ -0,0 +1,4 @@ +&SPECIES_PARAMS + PSPECIES="Xe-135", ! Tracer name: XENON 135 + PDECAY=32911.0, ! Species half life [https://www.internetchemie.info/chemische-elemente/isotope.php] + / diff --git a/options/SPECIES/Radionuclides/SPECIES_Y-91 b/options/SPECIES/Radionuclides/SPECIES_Y-91 new file mode 100644 index 0000000000000000000000000000000000000000..be2cb0563e110501c7867f8d07b3289ef26c8d6e --- /dev/null +++ b/options/SPECIES/Radionuclides/SPECIES_Y-91 @@ -0,0 +1,11 @@ +&SPECIES_PARAMS + PSPECIES="Y-91", ! Tracer name: YTTRIUM 91 + PDECAY=5055782.0, ! Species half life [https://www.internetchemie.info/chemische-elemente/isotope.php] + PCRAIN_AERO=3.6, ! Below-cloud scavenging (particles) - Crain (crain_aero) [Grythe et al. (2017), Van Leuven et al. (2023)] + PCSNOW_AERO=1.4, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) [Grythe et al. (2017), Van Leuven et al. (2023)] + PCCN_AERO=1.8, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) [Grythe et al. (2017), Van Leuven et al. (2023)] + PIN_AERO=1.6, ! In-cloud scavenging (particles) - INeff (in_aero) [Grythe et al. (2017), Van Leuven et al. (2023)] + PDENSITY=1900.0, ! Dry deposition (particles) - rho [Van Leuven et al. (2023)] + PDIA=0.65E-06, ! Dry deposition (particles) - dquer [Van Leuven et al. (2023)] + PDSIGMA=3.0, ! Dry deposition (particles) - dsig [Van Leuven et al. (2023)] + / diff --git a/options/SPECIES/SPECIES.README b/options/SPECIES/SPECIES.README index 4a1e85794825f819fbbb2afdcf655101ca9a3369..a73f15df761200de67c84795e9f1d1f1aef299bf 100644 --- a/options/SPECIES/SPECIES.README +++ b/options/SPECIES/SPECIES.README @@ -1,18 +1,183 @@ -Specifies all physico-chemical properties for the species. +Specifies all physico-chemical properties for the species. To generate an overview table compile the specoverview.f90 program gfortran specoverview.f90 -o specoverview ./specoverview +--------------------------------------------------------------------------------------------------------------------------- +WET DEPOSITION -UPDATE FOR FLEXPART VERSION 10.0 DEV: --------------------------------------------------------------------------------- -Please note that the format of the SPECIES files has changed from the previous -version (9.2) of FLEXPART and it is important to update all SPECIES files -accordingly. The use of SPECIES files from older FLEXPART versions may lead to -run-time errors or erroneous results. --------------------------------------------------------------------------------- -Half life due to radioactive or chemical decay and can be switched off by -specifying a negative value. Molecular weight (molweight of the species, needed -for mixing ratio output) --------------------------------------------------------------------------------- +Below-cloud scavenging +- Gases: + A and B are the parameters for below-cloud scavenging defined by Eq. scavenging coefficient = A x precipitation-rate^B + If you migrate from FLEXPART version 9.2 and below this is equal to A and B as it was. +- Particles: + A "rain collection efficiency" + B "snow collection efficiency" are both defined by Equations 46-47. + Suggested values for particle scavenging are A=1.0,B=1.0. + Using values A=0.2 and B=0.2 will give results close to the old scavenging scheme of FLEXPART version 9.2 and below. + +In-cloud scavenging +- Gases: + Is switched on if Ai or Bi are given greater than 0 + If you migrate from FLEXPART version 9.2 and below this is equal to Ai and Bi should be set to 1 +- Particles: + Ai ("Cloud Condensation Nuclei (CCN) efficiency") + Bi ("Ice Nuclei (IN) efficiency") are both from Eq. 51. + Suggested values for particle scavenging are Ai=0.9 and Bi=0.1. + Using values Ai=0.9 and Bi=0.9 should give results cto the old scavenging scheme of FLEXPART version 9.2 and below. +--------------------------------------------------------------------------------------------------------------------------- +DRY DEPOSITION +- Gases: + D is the diffusivity of water vapor and + D_i is the diffusivity of the species, + H is the effective Henry’s constant, + f0 varies between 0 and 1 and gives the reactivity of a species relative to that of ozone. For non-reactive species f0 is 0, for slightly reactive it is 0.1 and for highly reactive it is 1. + Dry deposition of gases is switched off by negative D. + +- Particles: + rho specifies the density of the substance, + dquer its mean diameter + dsig the measure of variation. + If no detailed information for deposition velocity calculation is available, a constant deposition velocity vd [cm s-1] can be used. + Dry deposition of particles is switched off by negative rho. +--------------------------------------------------------------------------------------------------------------------------- +OH REACTION: + can be turned on by giving parameter C [cm^3/molecule/sec]], D [K] and N [no unit] positive values, defined by Eq. 39. + OH reaction is switched off by negative C. +--------------------------------------------------------------------------------------------------------------------------- +Optionally emission variation information can be added at the end of the file, defined as following: Since FLEXPART version 6.0, emission factors can be defined that change the temporal variation of particle releases. This is useful, for instance, to simulate the typical daily and weekly cycle of anthropogenic emissions. The emission factors are given in the file of the corresponding species SPECIES_nnn, where nnn is the species number defined in file RELEASES. If no emission variation information is given, emission rates for species nnn are taken as constant. Release rates can vary with the hour of the day and with the day of the week, according to the local time at the release location. Emission factors must be 1 on average. 24 hourly as well as 7 daily values must be specified. Furthermore, different disaggregation factors must be given for area sources and for point sources. FLEXPART distinguishes between the two using the lower altitude of the release box: area sources are assumed to start below 0.5 m above the ground, whereas point sources are assumed to be higher. Please note that when this option is used, it is not so easy to determine the maximum number of particles present at a particular time of the model run. It might then be necessary to increase the parameter maxpart to a higher value than what would otherwise be needed. + +--------------------------------------------------------------------------------------------------------------------------- + +Author: C. Maurer (GeoSphere Austria), 9.2023 (Radionuclides), M.D. Mulder (Other SPECIES) + +FLEXPART V11 SPECIES files now contain literature references. + +Radionculides can be partioned into three main groups: + +IODINE (I-131) + +Iodine is typically released in gaseous reactive elemental, gaseous nonreactive organic and particulate form (Nair et al., 2000). +The release fractions of the three iodine components may vary significantly from sight to sight (Sportisse, 2007). +The particulate form is centred around 0.5 um with a gaseous fraction of 15% (for a total atmospheric aerosol concentration of 100 ugm-3), +35% (for 30 ugm-3) and 60% (for 10 ugm-3) according to a condensation/evaporation model (Sportisse, 2007). It is reasonable to assume that +there would be increased sorption of iodine onto aerosols with increased humidity resulting in a higher rate of transformation of the elemental +form of iodine into the particulate form (Nair et al., 2000). Measurements after the Chernobyl accident in Muenchen indicated a growth of the organic part +(from 43% to 59% of the total mass, including gas and aerosols) due to the atmospheric ageing (Sportisse, 2007). No transformations of any kind are +accounted for in FLEXPART! Dry and wet removal are most effective for elemental iodine and least effective for organic iodine (e.g., Nair et al., 2000). +Particle-bound iodine is treated analogously to other particle-bound nuclides (see below). + +PARTICLE-BOUND RADIONUCLIDES (e.g., Cs-137) + +A particle size of 0.1 to 1 um is typical for an aged - "accumulation mode" (AM) - aerosol (Mueller and Proehl, 1993). +Indeed, for the Chernobyl accident, most authors reported that the aerosols were in the submicronic range (Sportisse, 2007). +Adhesion of different radionuclides to particles of different size is assumed to be uniform, i.e., no specific sizes for specific nuclides are prefered +(Seibert, 2023). Aerosol surface (not number) concentration is the relevant quantity regarding particle sizes selected for modelling radionuclides +attached to aerosols (Seibert, 2023). [Atmospheric nuclear explosion certainly cause a different size distribution. But we focus here on nuclear accidents. +In addition, there are hot particles (part of the nuclear fuel). The consequent size distribution depends on the situation with increasing fractionation +with transport time. Interestingly, hot particles contain a lot of Ru (not yet understood; Seibert, 2023)]. A key point is to have an aerosol model +in which the particulate radionuclides can be included (Sportisse, 2007). According to Kristiansen et al. (2016) Cs-137 size distribution measurements taken +close to the Fuskushima-Daiichi (FDNPP) power plant suggested that accumulation mode (AM) sulfate aerosols were the main carriers of cesium. +The cesium released during the accident attached to the particles in the ambient air, approximately in proportion to their surface area. +The peak of the aerosol surface area distribution is generally in the AM, which in the area of FDNPP was typically dominated by sulfate. +Even though it is possible that some of the Cs-137 attached to other aerosol than sulfate, these aerosol components were likely mixed internally +with the dominant AM sulfate aerosol and therefore should have similar removal properties. For accumulation-mode (AM) aerosol, +the dominant removal process is wet deposition. + +The aerosol distribution (in the simplest case) follows a lognormal law of variance sigma, centered around the mean diameter (Sportisse, 2007). +The geometric mean "dquer" varies between dquer*dsig and dquer*dsig^-1 for 68% of particle diameters. The size of the emitted particles differed +according to the period after the Chernobyl accident. In the first weeks, emissions were in the submicronic range. +In the second period (after the building of the sarcophage), the mean diameter was up to 6-7 um due to resuspension (Sportisse, 2007). + +For most aerosol particles and in-cloud scavenging CCNeff >= INeff. The sum of CCNeff + CINeff is more important for the removal +efficiency than the individual choice of values (Grythe et al., 2017). + +Values from 0.1 to 10 for Crain and Csnow are supposed to cover the range of below-cloud scavenging rates seen in other ATMs (Van Leuven et al., 2023). +There are in general large uncertainties tied to the efficiency of impaction scavenging (Grythe et al., 2017). +Recent measurements have indicated that below-cloud scavenging contributes to the majority of the total wet deposition (Van Leuven et al., 2023). + +For particles >> 1 um, dry deposition combined with relatively fast gravitational settling take over as the most +important removal mechanisms and thus very little effect is seen from altering the wet removal parameters (Grythe et al., 2017). + +The most recent parameterization is available from Van Leuven et al. (2023) for Cs-137. All other particle-bound radionuclide characterizations +are based on the very same dry and wet removal parameters and only altering the half-life. Thus, as first approximation further particle-bound +radionculide species files can be generated based on the existing dry and wet removal parameters and just altering the half-life. + +Alternatively to the default parameterization based on a single bin size, in Grythe et al. (2017) a more realistic aerosol size distribution +for Cs-137 was used. The mass was emitted in six different size bins ranging from d = 0.4 to 6.2 μm. The size bins with logarithmic mean diameters +of [0.4, 0.65, 1, 2.2, 4, and 6.2] μm received 1, 2, 10, 40, 32, and 15% of the emitted mass. Crain = Csnow = 1.0, CCNeff = INeff = 0.9. +Scavenging parameters are set to values believed to be valid for sulfate aerosols. + +Both parameterizations above are based on or evaluated for Fuskushima data! + +Dry deposition may actually be different for different groups of radionuclides and influenced by differences in chemical properties (Rosner et al., 1989; +but not accounted for in the FP species definition). The dry deposition velocity of Cs-137 (and Cs-134), was found to be similar to that of Ag-110, +aerosol I-131 and Ba-140. Another group of radionuclides includes Ru-103, Ru-106, Sb-125, total I-131, Te-129 and Te-132. Mo-99, Ce-141 and Ce-144 +are more likely to belong to the first group of radionuclides. The washout ratios show much more variation from one sampling interval to another than +do the dry deposition velocities. This is not unexpected since it is well known that the individual meteorological parameters strongly influence the +deposition behavior in each individual rainfall event (Rosner et al., 1989). The washout ratios of the individual radionuclides are much more similar +to each other than were the dry deposition velocities in dry periods. + +NOBLE GASES (e.g., Xe-133) + +Noble gases do not deposit. Only difference to a simply air tracer is their decay which must be set properly. + +OVERALL REMARKS: + +Radioactive decay can be considered a posteriori in post-processing unless when dealing with a quickly decaying nuclide like, e.g., Xe-135, +in comparison to the FLEXPART output time interval. Applying decay as postprocessing saves computation time! No decay should be applied online or a posteriori if +half-life is longer than ca. one month (e.g., Cs-137 or Sr-90; Seibert, 2023). + +All nuclides start as gases, then they condense onto aerosols. Most fugitive ones are Te, Cs and I, followed by Sr, Ru and Ce, +followed by the least fugitives ones U and Pu (Seibert, 2023). + +In general, constant dry deposition velocities should be avoided. They do not describe the strong sensitivity with respect to the particle size distribution, +meteorological conditions and surface properties (Sportisse, 2007; Wesely & Hicks, 1977). + +The main uncertainties for below-cloud scavenging are actually related to the rain intensity and raindrop distribution (Sportisse, 2007; Asman, 1995). + +The scavenging by snow is poorly known and the measured data are usually not related to radionuclides. The uncertainties are +related to the large variety of types and shapes of solid hydrometeors. In many works, it is usually assumed that the scavenging coefficient +is the same one as for rain (Sportisse, 2007). + +Scavenging parameters may depend on a case-by-case basis as there exist no unique globally representative values (Grythe et al., 2017). +In a study by Quérel et al. (2021) none of the wet deposition schemes investigated were the best option to satisfy all the comparison criteria against observations +under different configurations (e.g., meteorological input). At the current time, it is preferable to use several wet deposition schemes in +an ensemble modelling appproach if possible. However, total deposition results vary to a fairly small extent when compared with the orders of magnitude +of the differences between scavenging coefficients used in different models (Quérel et al., 2021). + +OTHER SPECIES + +Considering the non-radionuclide SPECIES files, N2O is added and HCHO is reintroduced. + +Concerning the parameters for the wet deposition of non-radionuclides, for parameter A (for a ground level air temperature of 283.15 K), the ed here are the original ones from the Asman (1995), or calculated according to his method. For O3, NO2 and CH4 the diffusion coefficient in air, needed for this calculation was defined for 283.15 K from Langenberg et al. (2020). No experimental values were found for the other listed gases. The parameter B is the same for all gases, the original value of 0.62 according to Asman (1995) is kept. + +The simulation of dry deposition of gas needs values for D(iffusivity relative to diffusivity of H2O), H(enry's constant) and f0 (reactivity relative to that of O3), originally taken from Wesely (1989). The D values are kept (or corrected back to the ones) as in his table 2 (NH3, H2O2, HNO3, O3, NO, NO2, HNO2, PAN, SO2, HCHO). The relative diffusivity of the other listed gases (CO, SO2, CH4, C2H6, PCB28, G-HCH, N2O) could be calculated using the diffusivity of water (2.49E-05). + +The Henry’s law constants from a literature review can be found in https://henrys-law.org/henry/casrn/10028-15-6. When comparing the Wesely values with those in the database of this website (focus is on the originally measured values "M"), then the Wesely table 2 and the database show the same for: O3, NO, NO2, H2O2, HCHO, PAN. Or close enough, for example, the database shows 1.9E-5 mol/(m3⋅Pa) for NO (henrys-law.org), which corresponds to the rounded 2.0E-3 M/atm (Wesely 1989). Differences were found for HNO3, SO2, NH3 and HNO2, for these species, the values are adopted from the database. Newly added values based on henrys-law.org are included for CO, CH4, C2H6 and N2O. Concerning the persistent organic pollutants, for PCB28, the Henry’s law constant is kept and given the reference to Mackay et al., 2006, while for γ-HCH the value from Sahsuvar et al., 2003 is selected. + +f0 reactivity values can also be found in Wesely's Table 2. The values for CO and CH4 were found in Clifton et al., 2020. For others (C2H6 and N2O) they are not included but could be calculated. + +The density (rho) of particles is usually assumed to be about 2E3 kg/m3 as a commonly used value based on the density of soot. Regarding the mean geometric particle diameter (dquer) for SO4-aerosol and NO3-aerosol, the FLEXPART10 SPECIES files contain 4E-7 m. However, since a literature reference could not be found, now is chosen for 0.2e-7 m with a dsigma of 1.5 (Tunved et al. 2013; personal communication Nikolaos Evangeliou, 2023). + + +REFERENCES: + +Asman, W. A. H. (1995): Parametrisation of below-cloud scavenging of highly soluble gases under convective conditions. Atmospheric Environment 29 (12): 1359-1368. +Atkinson, R. (1997): Gas-phase tropospheric chemistry of volatile organic compounds: 1. Alkanes and alkenes, J. Phys. Chem. Ref. Data, 26, 215–290. +Bian, Q. et al. (2014): One-year observations of size distribution characteristics of major aerosol constituents at a coastal receptor site in Hong Kong – Part 1: Inorganic ions and oxalate, Atmos. Chem. Phys., 14, 9013–9027 +Clifton, O. E. et al. (2022). Large eddy simulation for investigating coupled forest canopy and turbulence influences on atmospheric chemistry. Journal Of Advances In Modeling Earth Systems, 14, e2022MS003078. +Grythe, H. et al. (2017): A new aerosol wet removal scheme for the Lagrangian particle model FLEXPART v10. Geosci. Model Dev., 10: 1447-1466. +Langenberg, S. et al. (2020): Technical note: Determination of binary gas-phase diffusion coefficients of unstable and adsorbing atmospheric trace gases at low temperature – arrested flow and twin tube method, Atmos. Chem. Phys., 20, 3669–3682. +Mackay, D. et al. (2006): Hand Book of Physical–Chemical Properties and Environmental Fate for Organic Chemicals, CRC Press, Boca Raton, U.S.A. +Mueller, H., and Proehl, G. (1993): ECOSYS-87: A dynamic model for assessing radiological consequences of nuclear accidents. Health Physics 64 (3): 232-252. +Nair, S.K. et al. (2000): A radioiodine speciation, deposition and dispersion model with uncertainty propagation for the Oak Ridge dose reconstruction. Health Physics 78 (4): 394-413. +Querel, A. et al. (2021): Sensitivity study to select the wet deposition scheme in an operational atmospheric transport model. Journal of Environmental Radioactivity 237: 106712. +Rosner, G. et al. (1989): Effect of dry deposition, washout and resuspension on radionuclide ratios after the Chernobyl accident. The Science of the Total Environment 90 (1-2). +Seibert, P. (2023): Personal Communication. +Sahsuvar, L., P. A. Helm, L. M. Jantunen, and T. F. Bidleman (2003), Henry’s law constants for a-, b-, and g-hexachlorocyclohexanes(HCHs) as a function of temperature and revised estimates of gas exchange in Arctic regions, Atmos. Environ., 37, 983–992, doi:10.1016/S1352-2310(02)00936-6 +Sportisse, B. (2007): A review of parameterizations for modelling dry deposition and scavenging of radionuclides. Atmospheric Environment 41: 2683-2698. +Tunved, P. et al. (2013): Arctic aerosol life cycle: linking aerosol size distributions observed between 2000 and 2010 with air mass transport and precipitation at Zeppelin station, Ny-Ålesund, Svalbard, Atmos. Chem. Phys., 13, 3643–3660. +Van Leuven, S. et al. (2023): An optimisation method to improve modelling of wet deposition in atmospheric transport models: applied to FLEXPART v10.4. EGUsphere, in discussion. +Wesely M. L. & Hicks B. B. (1977): Some Factors that Affect the Deposition Rates of Sulfur Dioxide and Similar Gases on Vegetation. Journal of the Air Pollution Control Association 27 (11): 1110-1116. diff --git a/options/SPECIES/SPECIES_002 b/options/SPECIES/SPECIES_002 deleted file mode 100644 index 371e65b09b7f5844798f08843826a98890ba188b..0000000000000000000000000000000000000000 --- a/options/SPECIES/SPECIES_002 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="O3", ! Tracer name - PDECAY=-9.9, ! Species half life - PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho - PDQUER=0., ! Dry deposition (particles) - dquer - PDSIGMA=0., ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.9, ! Alternative: dry deposition velocity - PRELDIFF=1.6, ! Dry deposition (gases) - D - PHENRY=1.0E-2, ! Dry deposition (gases) - Henrys const. - PF0=1, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=48.0, ! molweight - POHCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - / diff --git a/options/SPECIES/SPECIES_003 b/options/SPECIES/SPECIES_003 deleted file mode 100644 index 3df5f23c95c7778e2962877e8b33e34e82684bb3..0000000000000000000000000000000000000000 --- a/options/SPECIES/SPECIES_003 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="NO", ! Tracer name - PDECAY=-9.9, ! Species half life - PWETA_GAS=8.0E-6, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho - PDQUER=0.0, ! Dry deposition (particles) - dquer - PDSIGMA=0.0, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=1.2, ! Dry deposition (gases) - D - PHENRY=2.0E-03, ! Dry deposition (gases) - Henrys const. - PF0=0.0, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=30.0, ! molweight - POHCCONST=-0.9E+9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9 ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - / diff --git a/options/SPECIES/SPECIES_004 b/options/SPECIES/SPECIES_004 deleted file mode 100644 index 2fea08e601e305dc0d98e3a6f6c7fbe2320eb182..0000000000000000000000000000000000000000 --- a/options/SPECIES/SPECIES_004 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="NO2", ! Tracer name - PDECAY=-9.9, ! Species half life - PWETA_GAS=1.0E-05, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=-0.9E9, ! Dry deposition (particles) - rho - PDQUER=0.0, ! Dry deposition (particles) - dquer - PDSIGMA=0.0, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=1.6, ! Dry deposition (gases) - D - PHENRY=1.0E-02, ! Dry deposition (gases) - Henrys const. - PF0=0.1, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=46.0, ! molweight - POHCCONST=-0.9E9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - / diff --git a/options/SPECIES/SPECIES_005 b/options/SPECIES/SPECIES_005 deleted file mode 100644 index 900a461cc8fbc924797f2f21e2e83c782adc5738..0000000000000000000000000000000000000000 --- a/options/SPECIES/SPECIES_005 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="HNO3", ! Tracer name - PDECAY=-9.9, ! Species half life - PWETA_GAS=8.0E-04, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho - PDQUER=0.0, ! Dry deposition (particles) - dquer - PDSIGMA=0.0, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=1.9, ! Dry deposition (gases) - D - PHENRY=1E14, ! Dry deposition (gases) - Henrys const. - PF0=0, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=63.0, ! molweight - POHCCONST=-0.9E+9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - / diff --git a/options/SPECIES/SPECIES_006 b/options/SPECIES/SPECIES_006 deleted file mode 100644 index 446441a69dd50bcbaf9b6c246f7f924538716087..0000000000000000000000000000000000000000 --- a/options/SPECIES/SPECIES_006 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="HNO2", ! Tracer name - PDECAY=-9.9, ! Species half life - PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho - PDQUER=0.0, ! Dry deposition (particles) - dquer - PDSIGMA=0.0, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=1.6, ! Dry deposition (gases) - D - PHENRY=100000.0, ! Dry deposition (gases) - Henrys const. - PF0=.1, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=47.0, ! molweight - POHCCONST=-0.9E+9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - / diff --git a/options/SPECIES/SPECIES_007 b/options/SPECIES/SPECIES_007 deleted file mode 100644 index 362ff3ae308077ce499379d474c950f119b40a64..0000000000000000000000000000000000000000 --- a/options/SPECIES/SPECIES_007 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="H2O2", ! Tracer name - PDECAY=-9.9, ! Species half life - PWETA_GAS=1.0E-04, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho - PDQUER=0.0, ! Dry deposition (particles) - dquer - PDSIGMA=0.0, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=1.4, ! Dry deposition (gases) - D - PHENRY=100000.0, ! Dry deposition (gases) - Henrys const. - PF0=1.0, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=34.0, ! molweight - POHCCONST=-0.9E+9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - / diff --git a/options/SPECIES/SPECIES_008 b/options/SPECIES/SPECIES_008 deleted file mode 100644 index 5c49b9b07ca682b503881893aa1c5e4506e21259..0000000000000000000000000000000000000000 --- a/options/SPECIES/SPECIES_008 +++ /dev/null @@ -1,26 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="NO2", ! Tracer name - PDECAY=-9.9, ! Species half life - PWETA_GAS=1.0E-05, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=-0.9E9, ! Dry deposition (particles) - rho - PDQUER=0.0, ! Dry deposition (particles) - dquer - PDSIGMA=0.0, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=1.6, ! Dry deposition (gases) - D - PHENRY=1.0E-02, ! Dry deposition (gases) - Henrys const. - PF0=0.1, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=46.0, ! molweight - POHCCONST=-0.9E9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - PAREA_HOUR=0.578, 0.491, 0.428, 0.329, 0.384, 0.485, 0.763, 1.103, 1.084, 1.047, 1.096, 1.196, 1.298, 1.357, 1.447, 1.565, 1.636, 1.662, 1.401, 1.168, 1.031, 0.926, 0.816, 0.709, - PPOINT_HOUR=0.845, 0.806, 0.786, 0.779, 0.793, 0.832, 0.895, 0.977, 1.031, 1.071, 1.105, 1.118, 1.131, 1.136, 1.143, 1.141, 1.133, 1.118, 1.097, 1.091, 1.079, 1.036, 0.966, 0.892, - PAREA_DOW=1.060, 1.060, 1.060, 1.060, 1.060, 0.900, 0.000, - PPOINT_DOW=1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, - / diff --git a/options/SPECIES/SPECIES_009 b/options/SPECIES/SPECIES_009 deleted file mode 100644 index b15e09554361536c1c8b32906e52bbe191879843..0000000000000000000000000000000000000000 --- a/options/SPECIES/SPECIES_009 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="HCHO", ! Tracer name - PDECAY=-9.9, ! Species half life - PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho - PDQUER=0.0, ! Dry deposition (particles) - dquer - PDSIGMA=0.0, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=1,3, ! Dry deposition (gases) - D - PHENRY=6000.0, ! Dry deposition (gases) - Henrys const. - PF0=-9, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=30.0, ! molweight - POHCCONST=-0.9E+9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - / diff --git a/options/SPECIES/SPECIES_010 b/options/SPECIES/SPECIES_010 deleted file mode 100644 index 2fb4e88d6d5a676b86bafbf6e796ea6aa536372f..0000000000000000000000000000000000000000 --- a/options/SPECIES/SPECIES_010 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="PAN", ! Tracer name - PDECAY=-9.9, ! Species half life - PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho - PDQUER=0.0, ! Dry deposition (particles) - dquer - PDSIGMA=0.0, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=2.6, ! Dry deposition (gases) - D - PHENRY=3.6, ! Dry deposition (gases) - Henrys const. - PF0=0.1, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=121.0, ! molweight - POHCCONST=-0.9E+9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - / diff --git a/options/SPECIES/SPECIES_011 b/options/SPECIES/SPECIES_011 deleted file mode 100644 index 371c515e066acf5aa270eca7071d3565b2f37a46..0000000000000000000000000000000000000000 --- a/options/SPECIES/SPECIES_011 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="NH3", ! Tracer name - PDECAY=-9.9, ! Species half life - PWETA_GAS=9.9E-05, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho - PDQUER=0.0, ! Dry deposition (particles) - dquer - PDSIGMA=0.0, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=1.1, ! Dry deposition (gases) - D - PHENRY=2.0E14, ! Dry deposition (gases) - Henrys const. - PF0=0.0, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=17.0, ! molweight - POHCCONST=-0.9E+9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - / diff --git a/options/SPECIES/SPECIES_012 b/options/SPECIES/SPECIES_012 deleted file mode 100644 index d4bd4ac24b38100229c704304ae96b6c0c33c4df..0000000000000000000000000000000000000000 --- a/options/SPECIES/SPECIES_012 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="SO4-aero", ! Tracer name - PDECAY=-9.9, ! Species half life - PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=1.0, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=1.0, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=0.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=0.1, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=2000.0, ! Dry deposition (particles) - rho - PDQUER=4.0E-07, ! Dry deposition (particles) - dquer - PDSIGMA=3.3, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=-9.9, ! Dry deposition (gases) - D - PHENRY=-0.9E+9, ! Dry deposition (gases) - Henrys const. - PF0=-9, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=-9.9, ! molweight - POHCCONST=-0.9E+9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - / diff --git a/options/SPECIES/SPECIES_013 b/options/SPECIES/SPECIES_013 deleted file mode 100644 index 21da254fcdd378f610aca68f96f3c5af9b20ba01..0000000000000000000000000000000000000000 --- a/options/SPECIES/SPECIES_013 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="NO3-aero", ! Tracer name - PDECAY=-9.9, ! Species half life - PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=1.0, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=1.0, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=0.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=0.1, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=2.0E+3, ! Dry deposition (particles) - rho - PDQUER=4.0E-07, ! Dry deposition (particles) - dquer - PDSIGMA=3.3, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=-9.9, ! Dry deposition (gases) - D - PHENRY=-0.9E+9, ! Dry deposition (gases) - Henrys const. - PF0=-9, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=-9.9, ! molweight - POHCCONST=-0.9E+9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - / diff --git a/options/SPECIES/SPECIES_014 b/options/SPECIES/SPECIES_014 deleted file mode 100644 index 5ad9079085e99f49c04992745030961373892f70..0000000000000000000000000000000000000000 --- a/options/SPECIES/SPECIES_014 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="I2-131", ! Tracer name - PDECAY=691200.0, ! Species half life - PWETA_GAS=8.0E-05, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho - PDQUER=0.0, ! Dry deposition (particles) - dquer - PDSIGMA=0.0, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=2.7, ! Dry deposition (gases) - D - PHENRY=100000.0, ! Dry deposition (gases) - Henrys const. - PF0=0.1, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=-9.9, ! molweight - POHCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - / diff --git a/options/SPECIES/SPECIES_015 b/options/SPECIES/SPECIES_015 deleted file mode 100644 index d8fad0fa33f09a980ad5fe4ada8ec27d60bcf51a..0000000000000000000000000000000000000000 --- a/options/SPECIES/SPECIES_015 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="I-131", ! Tracer name - PDECAY=691200.0, ! Species half life - PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=1.0, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=1.0, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=0.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=0.1, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=2500.0, ! Dry deposition (particles) - rho - PDQUER=6.0E-07, ! Dry deposition (particles) - dquer - PDSIGMA=3.3, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=-9.9, ! Dry deposition (gases) - D - PHENRY=-9.9, ! Dry deposition (gases) - Henrys const. - PF0=-9, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=350.0, ! molweight - POHCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - / diff --git a/options/SPECIES/SPECIES_016 b/options/SPECIES/SPECIES_016 deleted file mode 100644 index fad26c579c2d9f2f78968e1698d73d3fa88e0350..0000000000000000000000000000000000000000 --- a/options/SPECIES/SPECIES_016 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="Cs-137", ! Tracer name - PDECAY=-9.9, ! Species half life - PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=1.0, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=1.0, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=0.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=0.9, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=1900.0, ! Dry deposition (particles) - rho - PDQUER=0.4E-06, ! Dry deposition (particles) - dquer - PDSIGMA=3.3, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=-9.9, ! Dry deposition (gases) - D - PHENRY=-0.9E-9, ! Dry deposition (gases) - Henrys const. - PF0=-9, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=-9.9, ! molweight - POHCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - / diff --git a/options/SPECIES/SPECIES_017 b/options/SPECIES/SPECIES_017 deleted file mode 100644 index 54d9aec279df0b46b9fbc29ea9e4736b776be20e..0000000000000000000000000000000000000000 --- a/options/SPECIES/SPECIES_017 +++ /dev/null @@ -1,23 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="Y-91", ! Tracer name - PDECAY=5037120.0, ! Species half life - PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=1.0, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=1.0, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=0.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=0.1, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=2500.0, ! Dry deposition (particles) - rho - PDQUER=6.0E-07, ! Dry deposition (particles) - dquer - PDSIGMA=3.3, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=-9.9, ! Dry deposition (gases) - D - PHENRY=-0.9E-9, ! Dry deposition (gases) - Henrys const. - PF0=-9.0, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=350.0, ! molweight - POHCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - / diff --git a/options/SPECIES/SPECIES_018 b/options/SPECIES/SPECIES_018 deleted file mode 100644 index e10df5743d8b18d2d5732006eba361ef5f60ee9b..0000000000000000000000000000000000000000 --- a/options/SPECIES/SPECIES_018 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="Ru-106", ! Tracer name - PDECAY=31536000.0, ! Species half life - PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=1.0, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=1.0, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=0.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=0.1, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=2500.0, ! Dry deposition (particles) - rho - PDQUER=6.0E-07, ! Dry deposition (particles) - dquer - PDSIGMA=3.3, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=-9.9, ! Dry deposition (gases) - D - PHENRY=-0.9E-9, ! Dry deposition (gases) - Henrys const. - PF0=-9, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=350.0, ! molweight - POHCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - / diff --git a/options/SPECIES/SPECIES_019 b/options/SPECIES/SPECIES_019 deleted file mode 100644 index 76cc9868d03c2f8c36fce39d402bb6b337a5bca2..0000000000000000000000000000000000000000 --- a/options/SPECIES/SPECIES_019 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="Kr-85", ! Tracer name - PDECAY=-9.9, ! Species half life - PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho - PDQUER=0.0, ! Dry deposition (particles) - dquer - PDSIGMA=0.0, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=-9.9, ! Dry deposition (gases) - D - PHENRY=-0.9E-9, ! Dry deposition (gases) - Henrys const. - PF0=-9, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=83.8, ! molweight - POHCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - / diff --git a/options/SPECIES/SPECIES_020 b/options/SPECIES/SPECIES_020 deleted file mode 100644 index 17dafa57ed84681ac468be1008e35d7551a6829a..0000000000000000000000000000000000000000 --- a/options/SPECIES/SPECIES_020 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="Sr-90", ! Tracer name - PDECAY=-9.9, ! Species half life - PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=1.0, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=1.0, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=0.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=0.1, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=2500.0, ! Dry deposition (particles) - rho - PDQUER=6.0E-07, ! Dry deposition (particles) - dquer - PDSIGMA=3.3, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=-9.9, ! Dry deposition (gases) - D - PHENRY=-0.9E-9, ! Dry deposition (gases) - Henrys const. - PF0=-9, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=-9.9, ! molweight - POHCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - / diff --git a/options/SPECIES/SPECIES_021 b/options/SPECIES/SPECIES_021 deleted file mode 100644 index 4d89b6c7b82b42f59f48d30a1aaea7bc709af386..0000000000000000000000000000000000000000 --- a/options/SPECIES/SPECIES_021 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="Xe-133", ! Tracer name - PDECAY=453168.0, ! Species half life - PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho - PDQUER=0.0, ! Dry deposition (particles) - dquer - PDSIGMA=0.0, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=-9.9, ! Dry deposition (gases) - D - PHENRY=-0.9E-9, ! Dry deposition (gases) - Henrys const. - PF0=-9, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=-9.9, ! molweight - POHCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - / diff --git a/options/SPECIES/SPECIES_022 b/options/SPECIES/SPECIES_022 deleted file mode 100644 index 50accc0769f96843b96d488b588d3cb095b9528b..0000000000000000000000000000000000000000 --- a/options/SPECIES/SPECIES_022 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="CO", ! Tracer name - PDECAY=-9.9, ! Species half life - PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho - PDQUER=0.0, ! Dry deposition (particles) - dquer - PDSIGMA=0.0, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=-9.9, ! Dry deposition (gases) - D - PHENRY=-0.9E-9, ! Dry deposition (gases) - Henrys const. - PF0=-9, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=28.0, ! molweight - POHCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - / diff --git a/options/SPECIES/SPECIES_023 b/options/SPECIES/SPECIES_023 deleted file mode 100644 index 12461e766ff8be1afa78632dc81dac228cbfdde3..0000000000000000000000000000000000000000 --- a/options/SPECIES/SPECIES_023 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="SO2", ! Tracer name - PDECAY=-9.9, ! Species half life - PWETA_GAS=2.0E-05, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=-0.9E-9, ! Dry deposition (particles) - rho - PDQUER=0.0, ! Dry deposition (particles) - dquer - PDSIGMA=0.0, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=2.0, ! Dry deposition (gases) - D - PHENRY=100000.0, ! Dry deposition (gases) - Henrys const. - PF0=0, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=64.0, ! molweight - POHCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - / diff --git a/options/SPECIES/SPECIES_025 b/options/SPECIES/SPECIES_025 deleted file mode 100644 index f41666a29cdb623ab9294586dadcf8e7cfc3d4e7..0000000000000000000000000000000000000000 --- a/options/SPECIES/SPECIES_025 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="AERO-TRACE", ! Tracer name - PDECAY=-9.9, ! Species half life - PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=1.0, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=1.0, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=0.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=0.1, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=1400.0, ! Dry deposition (particles) - rho - PDQUER=2.5E-07, ! Dry deposition (particles) - dquer - PDSIGMA=1.25, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=-9.9, ! Dry deposition (gases) - D - PHENRY=-0.9E-9, ! Dry deposition (gases) - Henrys const. - PF0=-9, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=-9.9, ! molweight - POHCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - / diff --git a/options/SPECIES/SPECIES_026 b/options/SPECIES/SPECIES_026 deleted file mode 100644 index da37f55e982a184134c86ce41f8f5ef602c09bd6..0000000000000000000000000000000000000000 --- a/options/SPECIES/SPECIES_026 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="CH4", ! Tracer name - PDECAY=-9.9, ! Species half life - PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho - PDQUER=0.0, ! Dry deposition (particles) - dquer - PDSIGMA=0.0, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=-9.9, ! Dry deposition (gases) - D - PHENRY=-0.9E-9, ! Dry deposition (gases) - Henrys const. - PF0=-9, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=16.0, ! molweight - POHCCONST=9.65E-20, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=1082.0, ! OH Reaction rate - D [K] - POHNCONST=2.58, ! OH Reaction rate - N (no unit) - / diff --git a/options/SPECIES/SPECIES_027 b/options/SPECIES/SPECIES_027 deleted file mode 100644 index 6265f9ba6f1004b7486207052a0b85a9075cb220..0000000000000000000000000000000000000000 --- a/options/SPECIES/SPECIES_027 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="C2H6", ! Tracer name - PDECAY=-9.9, ! Species half life - PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho - PDQUER=0.0, ! Dry deposition (particles) - dquer - PDSIGMA=0.0, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=-9.9, ! Dry deposition (gases) - D - PHENRY=-0.9E-9, ! Dry deposition (gases) - Henrys const. - PF0=-9, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=30.0, ! molweight - POHCCONST=15.2E-18, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=498.0, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - / diff --git a/options/SPECIES/SPECIES_028 b/options/SPECIES/SPECIES_028 deleted file mode 100644 index 4e92447c237978dd059312b51173d651e52e70a0..0000000000000000000000000000000000000000 --- a/options/SPECIES/SPECIES_028 +++ /dev/null @@ -1,7 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="C3H8 ", - PWEIGHTMOLAR= 44.0000000 , - POHCCONST= 1.55-E17, - POHDCONST= 61.0000000 , - POHNCONST= 2.00000000 , - / diff --git a/options/SPECIES/SPECIES_031 b/options/SPECIES/SPECIES_031 deleted file mode 100644 index 701f2866389a6e527e4bb25a0bbab198823cca6c..0000000000000000000000000000000000000000 --- a/options/SPECIES/SPECIES_031 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="PCB28", ! Tracer name - PDECAY=-9.9, ! Species half life - PWETA_GAS=3.5E-05, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho - PDQUER=0.0, ! Dry deposition (particles) - dquer - PDSIGMA=0.0, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=4.3, ! Dry deposition (gases) - D - PHENRY=3.1, ! Dry deposition (gases) - Henrys const. - PF0=0.1, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=257.54, ! molweight - POHCCONST=1.07E-11, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=1203.0, ! OH Reaction rate - D [K] - POHNCONST=0.0, ! OH Reaction rate - N (no unit) - / diff --git a/options/SPECIES/SPECIES_034 b/options/SPECIES/SPECIES_034 deleted file mode 100644 index 5e7ebe277313703828a58db941f89e68058d8757..0000000000000000000000000000000000000000 --- a/options/SPECIES/SPECIES_034 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="G-HCH", ! Tracer name - PDECAY=-9.9, ! Species half life - PWETA_GAS=3.5E-05, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho - PDQUER=0.0, ! Dry deposition (particles) - dquer - PDSIGMA=0.0, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=4.3, ! Dry deposition (gases) - D - PHENRY=422.0, ! Dry deposition (gases) - Henrys const. - PF0=0.1, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=290.83, ! molweight - POHCCONST=6.21E-11, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=1203.0, ! OH Reaction rate - D [K] - POHNCONST=2.00, ! OH Reaction rate - N (no unit) - / diff --git a/options/SPECIES/SPECIES_AEROSOL b/options/SPECIES/SPECIES_AEROSOL new file mode 100644 index 0000000000000000000000000000000000000000..732de8a4874fa948cd1b15d22b484f8c1bed6566 --- /dev/null +++ b/options/SPECIES/SPECIES_AEROSOL @@ -0,0 +1,16 @@ +&SPECIES_PARAMS + PSPECIES="AEROSOL", ! Tracer name + PCRAIN_AERO=1.0, ! Below-cloud scavenging (particles) - Crain (crain_aero) [arbitrary value] + PCSNOW_AERO=1.0, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) [arbitrary value] + PCCN_AERO=0.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) [arbitrary value] + PIN_AERO=0.1, ! In-cloud scavenging (particles) - INeff (in_aero) [arbitrary value] + PDENSITY=1.4E3, ! Dry deposition (particles) - rho [arbitrary value] + PDIA=2.5E-07, ! Dry deposition (particles) - dquer [arbitrary value] + PDSIGMA=1.25, ! Dry deposition (particles) - dsig [arbitrary value] + PSHAPE=1, ! 0 for sphere, 1 any shape (defined by axes PLA,PIA,PSA), 2-cylinder, 3-cube, 4-tetrahedron, 5-octahedron, 6-ellipsoid + PASPECTRATIO=50.0 ! Aspect ratio of cylinders: works for PSHAPE=2 only + PLA=1.8E-06, ! Longest axis in meters (Bagheri & Bonadonna 2016): only for PSHAPE=1 + PIA=0.6E-06, ! Intermediate axis in meters: only for PSHAPE=1 + PSA=0.6E-06, ! Smallest axis in meters: only for PSHAPE=1 + PORIENT=0, ! 0 for random orientation of particles, 1 for horizontal, 2 for an average between random and horizontal + / diff --git a/options/SPECIES/SPECIES_AIRTRACER b/options/SPECIES/SPECIES_AIRTRACER new file mode 100644 index 0000000000000000000000000000000000000000..2e2ed3a15bcbac8d530fa7462a6622b1de5a928c --- /dev/null +++ b/options/SPECIES/SPECIES_AIRTRACER @@ -0,0 +1,4 @@ +&SPECIES_PARAMS + PSPECIES="AIRTRACER", ! Tracer name + PWEIGHTMOLAR=29.0, ! molweight + / diff --git a/options/SPECIES/SPECIES_BC b/options/SPECIES/SPECIES_BC new file mode 100644 index 0000000000000000000000000000000000000000..af35715203a1114cc341f23318c14af316d1596b --- /dev/null +++ b/options/SPECIES/SPECIES_BC @@ -0,0 +1,10 @@ +&SPECIES_PARAMS + PSPECIES="BC", ! Tracer name + PCRAIN_AERO=1.0, ! Below-cloud scavenging (particles) - Crain (crain_aero) [Grythe et al. (2017)] + PCSNOW_AERO=1.0, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) [Grythe et al. (2017)] + PCCN_AERO=0.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) [Grythe et al. (2017)] + PIN_AERO=0.1, ! In-cloud scavenging (particles) - INeff (in_aero) [Grythe et al. (2017)] + PDENSITY=2000.0, ! Dry deposition (particles) - rho + PDIA=2.0E-08, ! Dry deposition (particles) - dquer [Tunved et al. (2013)] + PDSIGMA=1.5, ! Dry deposition (particles) - dsig [Tunved et al. (2013)] + / diff --git a/options/SPECIES/SPECIES_C2H6 b/options/SPECIES/SPECIES_C2H6 new file mode 100644 index 0000000000000000000000000000000000000000..76d2f6f5fb12dd476b70d69fb0035f7966bc891b --- /dev/null +++ b/options/SPECIES/SPECIES_C2H6 @@ -0,0 +1,13 @@ +&SPECIES_PARAMS + PSPECIES="C2H6", ! Tracer name + PWETA_GAS=8.38E-5, ! Below-cloud scavenging (gases) - A (weta_gas) [Calculated accord to Asman (1995)] + PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas) [Asman (1995)] + PRELDIFF=1.30, ! Dry deposition (gases) - D [Calculated accord to Asman (1995)] + PHENRY=1.9E-03, ! Dry deposition (gases) - Henrys const. [henrys-law.org] + PF0=0.0, ! Dry deposition (gases) - f0 (reactivity) [no redox potential] + PWEIGHTMOLAR=30.0, ! molweight + PREACTIONS="OH", ! List of reactions (must correspond to names in REAGENTS) + PCCONST=15.2E-18, ! OH Reaction rate - C [cm^3/molecule/sec] [Atkinson 1997] + PDCONST=498.0, ! OH Reaction rate - D [K] [Atkinson 1997] + PNCONST=2.0, ! OH Reaction rate - N (no unit) [Atkinson 1997] + / diff --git a/options/SPECIES/SPECIES_CH4 b/options/SPECIES/SPECIES_CH4 new file mode 100644 index 0000000000000000000000000000000000000000..f20a9060f6b700b7038702ddf6a1507a81f55818 --- /dev/null +++ b/options/SPECIES/SPECIES_CH4 @@ -0,0 +1,13 @@ +&SPECIES_PARAMS + PSPECIES="CH4", ! Tracer name + PWETA_GAS=9.31E-5, ! Below-cloud scavenging (gases) - A (weta_gas) [Calculated accord to Asman (1995)] + PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas) [Asman (1995)] + PRELDIFF=0.95, ! Dry deposition (gases) - D [Calculated accord to Asman (1995)] + PHENRY=1.4E-03, ! Dry deposition (gases) - Henrys const. [henrys-law.org] + PF0=0.0, ! Dry deposition (gases) - f0 (reactivity) [Clifton et al. (2020)] + PWEIGHTMOLAR=16.0, ! molweight + PREACTIONS="OH", ! List of reactions (must correspond to names in REAGENTS) + PCCONST=9.65E-20, ! OH Reaction rate - C [cm^3/molecule/sec] [Atkinson 1997] + PDCONST=1082.0, ! OH Reaction rate - D [K] [Atkinson 1997] + PNCONST=2.58, ! OH Reaction rate - N (no unit) [Atkinson 1997] + / diff --git a/options/SPECIES/SPECIES_CO b/options/SPECIES/SPECIES_CO new file mode 100644 index 0000000000000000000000000000000000000000..c2682cd3bc8baa8c623bbd78b6ff9649d427a188 --- /dev/null +++ b/options/SPECIES/SPECIES_CO @@ -0,0 +1,9 @@ +&SPECIES_PARAMS + PSPECIES="CO", ! Tracer name + PWETA_GAS=8.62E-5, ! Below-cloud scavenging (gases) - A (weta_gas) [Calculated accord to Asman (1995)] + PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas) [Asman (1995)] + PRELDIFF=1.3, ! Dry deposition (gases) - D [Calculated accord to Asman (1995)] + PHENRY=9.7E-04, ! Dry deposition (gases) - Henrys const. [henrys-law.org] + PF0=0.0, ! Dry deposition (gases) - f0 (reactivity) [Clifton et al. (2020)] + PWEIGHTMOLAR=28.0, ! molweight + / diff --git a/options/SPECIES/SPECIES_DUST-COARSE b/options/SPECIES/SPECIES_DUST-COARSE new file mode 100644 index 0000000000000000000000000000000000000000..dedd002d261789409ac3fd60f28cbec1c34a5267 --- /dev/null +++ b/options/SPECIES/SPECIES_DUST-COARSE @@ -0,0 +1,10 @@ +&SPECIES_PARAMS + PSPECIES="DUST-COARSE", ! Tracer name + PCRAIN_AERO=1.0, ! Below-cloud scavenging (particles) - Crain (crain_aero) [arbitrary value] + PCSNOW_AERO=1.0, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) [arbitrary value] + PCCN_AERO=0.3, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) [arbitrary value] + PIN_AERO=0.02, ! In-cloud scavenging (particles) - INeff (in_aero) [arbitrary value] + PDENSITY=2.5E3, ! Dry deposition (particles) - rho [arbitrary value] + PDIA=1.23E-05, ! Dry deposition (particles) - dquer [arbitrary value] + PDSIGMA=1.22, ! Dry deposition (particles) - dsig [arbitrary value] + / \ No newline at end of file diff --git a/options/SPECIES/SPECIES_DUST-FINE b/options/SPECIES/SPECIES_DUST-FINE new file mode 100644 index 0000000000000000000000000000000000000000..e56f4d1d49d9dc730a2030debd064c4b888c5131 --- /dev/null +++ b/options/SPECIES/SPECIES_DUST-FINE @@ -0,0 +1,10 @@ +&SPECIES_PARAMS + PSPECIES="DUST-FINE", ! Tracer name + PCRAIN_AERO=1.0, ! Below-cloud scavenging (particles) - Crain (crain_aero) [arbitrary value] + PCSNOW_AERO=1.0, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) [arbitrary value] + PCCN_AERO=0.15, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) [arbitrary value] + PIN_AERO=0.02, ! In-cloud scavenging (particles) - INeff (in_aero) [arbitrary value] + PDENSITY=2.5E3, ! Dry deposition (particles) - rho [arbitrary value] + PDIA=2.2E-07, ! Dry deposition (particles) - dquer [arbitrary value] + PDSIGMA=2.24, ! Dry deposition (particles) - dsig [arbitrary value] + / diff --git a/options/SPECIES/SPECIES_G-HCH b/options/SPECIES/SPECIES_G-HCH new file mode 100644 index 0000000000000000000000000000000000000000..06bcac17ba413c881f42dc80d451d1cb01c26139 --- /dev/null +++ b/options/SPECIES/SPECIES_G-HCH @@ -0,0 +1,13 @@ +&SPECIES_PARAMS + PSPECIES="G-HCH", ! Tracer name + PWETA_GAS=3.86E-5, ! Below-cloud scavenging (gases) - A (weta_gas) [Calculated accord to Asman (1995)] + PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas) [Asman (1995)] + PRELDIFF=4.04, ! Dry deposition (gases) - D [Calculated accord to Asman (1995)] + PHENRY=7.14E+02, ! Dry deposition (gases) - Henrys const. [Sahsuvar et al.(2003)] + PF0=0.1, ! Dry deposition (gases) - f0 (reactivity) [slight redox potential] + PWEIGHTMOLAR=290.83, ! molweight + PREACTIONS="OH", ! List of reactions (must correspond to names in REAGENTS) + PCCONST=6.21E-11, ! OH Reaction rate - C [cm^3/molecule/sec] [ref missing] + PDCONST=1203.0, ! OH Reaction rate - D [K] [ref missing] + PNCONST=2.00, ! OH Reaction rate - N (no unit) [ref missing] + / diff --git a/options/SPECIES/SPECIES_H2O2 b/options/SPECIES/SPECIES_H2O2 new file mode 100644 index 0000000000000000000000000000000000000000..2c14b22d2f7bf75f9091084e1e721b916ed1040d --- /dev/null +++ b/options/SPECIES/SPECIES_H2O2 @@ -0,0 +1,9 @@ +&SPECIES_PARAMS + PSPECIES="H2O2", ! Tracer name + PWETA_GAS=7.42E-5, ! Below-cloud scavenging (gases) - A (weta_gas) [Asman (1995)] + PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas) [Asman (1995)] + PRELDIFF=1.4, ! Dry deposition (gases) - D [Wesely (1989)] + PHENRY=1.0E+5, ! Dry deposition (gases) - Henrys const. [Wesely (1989)] + PF0=1.0, ! Dry deposition (gases) - f0 (reactivity) [Wesely (1989)] + PWEIGHTMOLAR=34.0, ! molweight + / diff --git a/options/SPECIES/SPECIES_HCHO b/options/SPECIES/SPECIES_HCHO new file mode 100644 index 0000000000000000000000000000000000000000..52f0f6746633fd9c23c94cb2d0c1d2f1db2a3570 --- /dev/null +++ b/options/SPECIES/SPECIES_HCHO @@ -0,0 +1,9 @@ +&SPECIES_PARAMS + PSPECIES="HCHO", ! Tracer name + PWETA_GAS=8.38E-5, ! Below-cloud scavenging (gases) - A (weta_gas) [Calculated accord to Asman (1995)] + PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas) [Asman (1995)] + PRELDIFF=1.3, ! Dry deposition (gases) - D [Wesely (1989)] + PHENRY=6.0E+03, ! Dry deposition (gases) - Henrys const. [Wesely (1989)] + PF0=0.0, ! Dry deposition (gases) - f0 (reactivity) [Wesely (1989)] + PWEIGHTMOLAR=30.0, ! molweight + / diff --git a/options/SPECIES/SPECIES_HNO2 b/options/SPECIES/SPECIES_HNO2 new file mode 100644 index 0000000000000000000000000000000000000000..b533dd9de84a283b7551a471a93c666116a64c55 --- /dev/null +++ b/options/SPECIES/SPECIES_HNO2 @@ -0,0 +1,9 @@ +&SPECIES_PARAMS + PSPECIES="HNO2", ! Tracer name + PWETA_GAS=7.04E-5, ! Below-cloud scavenging (gases) - A (weta_gas) [Calculated accord to Asman (1995)] + PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas) [Asman (1995)] + PRELDIFF=1.6, ! Dry deposition (gases) - D [Wesely (1989)] + PHENRY=4.8E+1, ! Dry deposition (gases) - Henrys const. [henrys-law.org] + PF0=0.1, ! Dry deposition (gases) - f0 (reactivity) [Wesely (1989)] + PWEIGHTMOLAR=47.0, ! molweight + / diff --git a/options/SPECIES/SPECIES_HNO3 b/options/SPECIES/SPECIES_HNO3 new file mode 100644 index 0000000000000000000000000000000000000000..084f55dcc24195526989db64ea4b623ecade670d --- /dev/null +++ b/options/SPECIES/SPECIES_HNO3 @@ -0,0 +1,9 @@ +&SPECIES_PARAMS + PSPECIES="HNO3", ! Tracer name + PWETA_GAS=5.82E-5, ! Below-cloud scavenging (gases) - A (weta_gas) [Asman (1995)] + PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas) [Asman (1995)] + PRELDIFF=1.9, ! Dry deposition (gases) - D [Wesely (1989)] + PHENRY=2.1E+5, ! Dry deposition (gases) - Henrys const. [henrys-law.org] + PF0=0., ! Dry deposition (gases) - f0 (reactivity) [Wesely (1989)] + PWEIGHTMOLAR=63.0, ! molweight + / diff --git a/options/SPECIES/SPECIES_N2O b/options/SPECIES/SPECIES_N2O new file mode 100644 index 0000000000000000000000000000000000000000..d38449977c6203de99b6ca16206bcd1a26f2e969 --- /dev/null +++ b/options/SPECIES/SPECIES_N2O @@ -0,0 +1,9 @@ +&SPECIES_PARAMS + PSPECIES="N2O", ! Tracer name + PWETA_GAS=7.22E-5, ! Below-cloud scavenging (gases) - A (weta_gas) [Calculated accord to Asman (1995)] + PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas) [Asman (1995)] + PRELDIFF=1.6, ! Dry deposition (gases) - D [Calculated accord to Asman (1995)] + PHENRY=2.4E-02, ! Dry deposition (gases) - Henrys const. [henrys-law.org] + PF0=0.0, ! Dry deposition (gases) - f0 (reactivity) [long-lived as CH4] + PWEIGHTMOLAR=44.0, ! molweight + / diff --git a/options/SPECIES/SPECIES_NH3 b/options/SPECIES/SPECIES_NH3 new file mode 100644 index 0000000000000000000000000000000000000000..b6791f00429085771cfffbfeafc22b197ff77ea7 --- /dev/null +++ b/options/SPECIES/SPECIES_NH3 @@ -0,0 +1,9 @@ +&SPECIES_PARAMS + PSPECIES="NH3", ! Tracer name + PWETA_GAS=9.85E-5, ! Below-cloud scavenging (gases) - A (weta_gas) [Asman (1995)] + PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas) [Asman (1995)] + PRELDIFF=1.0, ! Dry deposition (gases) - D [Wesely (1989)] + PHENRY=5.9E+01, ! Dry deposition (gases) - Henrys const. [henrys-law.org] + PF0=0.0, ! Dry deposition (gases) - f0 (reactivity) [Wesely (1989)] + PWEIGHTMOLAR=17.0, ! molweight + / diff --git a/options/SPECIES/SPECIES_NO b/options/SPECIES/SPECIES_NO new file mode 100644 index 0000000000000000000000000000000000000000..a3210cfaf0a91ccef82470d83a2eaea8eaefea28 --- /dev/null +++ b/options/SPECIES/SPECIES_NO @@ -0,0 +1,9 @@ +&SPECIES_PARAMS + PSPECIES="NO", ! Tracer name + PWETA_GAS=8.38E-5, ! Below-cloud scavenging (gases) - A (weta_gas) [Asman (1995)] + PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas) [Asman (1995)] + PRELDIFF=1.3, ! Dry deposition (gases) - D [Wesely (1989)] + PHENRY=2.0E-3, ! Dry deposition (gases) - Henrys const. [Wesely (1989)] + PF0=0, ! Dry deposition (gases) - f0 (reactivity) [Wesely (1989)] + PWEIGHTMOLAR=30.0, ! molweight + / diff --git a/options/SPECIES/SPECIES_NO2 b/options/SPECIES/SPECIES_NO2 new file mode 100644 index 0000000000000000000000000000000000000000..cb3aa40238b2981b0394b7be2248f15fc6befe4e --- /dev/null +++ b/options/SPECIES/SPECIES_NO2 @@ -0,0 +1,9 @@ +&SPECIES_PARAMS + PSPECIES="NO2", ! Tracer name + PWETA_GAS=7.12E-5, ! Below-cloud scavenging (gases) - A (weta_gas) [Asman (1995), Langenberg (2020)] + PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas) [Asman (1995)] + PRELDIFF=1.6, ! Dry deposition (gases) - D [Wesely (1989)] + PHENRY=1.0E-2, ! Dry deposition (gases) - Henrys const. [Wesely (1989)] + PF0=0.1, ! Dry deposition (gases) - f0 (reactivity) [Wesely (1989)] + PWEIGHTMOLAR=46.0, ! molweight + / diff --git a/options/SPECIES/SPECIES_NO3-aero b/options/SPECIES/SPECIES_NO3-aero new file mode 100644 index 0000000000000000000000000000000000000000..b58ce465a73365e9abb19e38c6e11d390a9157d0 --- /dev/null +++ b/options/SPECIES/SPECIES_NO3-aero @@ -0,0 +1,10 @@ +&SPECIES_PARAMS + PSPECIES="NO3-aero", ! Tracer name + PCRAIN_AERO=1.0, ! Below-cloud scavenging (particles) - Crain (crain_aero) [Grythe et al. (2017)] + PCSNOW_AERO=1.0, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) [Grythe et al. (2017)] + PCCN_AERO=0.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) [Grythe et al. (2017)] + PIN_AERO=0.1, ! In-cloud scavenging (particles) - INeff (in_aero) [Grythe et al. (2017)] + PDENSITY=2.0E+03, ! Dry deposition (particles) - rho + PDIA=2.0E-07, ! Dry deposition (particles) - dia [Tunved et al., 2013] + PDSIGMA=1.5, ! Dry deposition (particles) - dsig [Tunved et al., 2013] + / diff --git a/options/SPECIES/SPECIES_O3 b/options/SPECIES/SPECIES_O3 new file mode 100644 index 0000000000000000000000000000000000000000..c131fe0081d681b5bc98af60d6e414adff888f92 --- /dev/null +++ b/options/SPECIES/SPECIES_O3 @@ -0,0 +1,9 @@ +&SPECIES_PARAMS + PSPECIES="O3", ! Tracer name + PWETA_GAS=7.43E-5, ! Below-cloud scavenging (gases) - A (weta_gas) [Asman (1995), Langenberg (2020)] + PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas) [Asman (1995)] + PRELDIFF=1.6, ! Dry deposition (gases) - D [Wesely (1989)] + PHENRY=1.0E-2, ! Dry deposition (gases) - Henrys const. [Wesely (1989)] + PF0=1, ! Dry deposition (gases) - f0 (reactivity) [Wesely (1989)] + PWEIGHTMOLAR=48.0, ! molweight + / diff --git a/options/SPECIES/SPECIES_PAN b/options/SPECIES/SPECIES_PAN new file mode 100644 index 0000000000000000000000000000000000000000..e87fedcfb5c8a813d3c62a0c012a82e3e009cd98 --- /dev/null +++ b/options/SPECIES/SPECIES_PAN @@ -0,0 +1,9 @@ +&SPECIES_PARAMS + PSPECIES="PAN" ! Tracer name + PWETA_GAS=5.04E-5, ! Below-cloud scavenging (gases) - A (weta_gas) [Calculated accord to Asman (1995)] + PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas) [Asman (1995)] + PRELDIFF=2.6, ! Dry deposition (gases) - D [Wesely (1989)] + PHENRY=3.6E+0, ! Dry deposition (gases) - Henrys const. [Wesely (1989)] + PF0=0.1, ! Dry deposition (gases) - f0 (reactivity) [Wesely (1989)] + PWEIGHTMOLAR=121.0, ! molweight + / diff --git a/options/SPECIES/SPECIES_PCB28 b/options/SPECIES/SPECIES_PCB28 new file mode 100644 index 0000000000000000000000000000000000000000..503e208cc5a2adf39201054dc772f38ba1d162b9 --- /dev/null +++ b/options/SPECIES/SPECIES_PCB28 @@ -0,0 +1,13 @@ +&SPECIES_PARAMS + PSPECIES="PCB28", ! Tracer name + PWETA_GAS=3.99E-5, ! Below-cloud scavenging (gases) - A (weta_gas) [Calculated accord to Asman (1995)] + PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas) [Asman (1995)] + PRELDIFF=3.81, ! Dry deposition (gases) - D [Calculated accord to Asman (1995)] + PHENRY=3.02E+00, ! Dry deposition (gases) - Henrys const. [Mackay et al., 2006] + PF0=0.1, ! Dry deposition (gases) - f0 (reactivity) [slight redox potential] + PWEIGHTMOLAR=257.54, ! molweight + PREACTIONS="OH", ! List of reactions (must correspond to names in REAGENTS) + PCCONST=1.07E-11, ! OH Reaction rate - C [cm^3/molecule/sec] [ref missing] + PDCONST=1203.0, ! OH Reaction rate - D [K] [ref missing] + PNCONST=0.0, ! OH Reaction rate - N (no unit) [ref missing] + / diff --git a/options/SPECIES/SPECIES_SO2 b/options/SPECIES/SPECIES_SO2 new file mode 100644 index 0000000000000000000000000000000000000000..a0d7b420e6c33ea343944e2684d6e685a490f9c9 --- /dev/null +++ b/options/SPECIES/SPECIES_SO2 @@ -0,0 +1,9 @@ +&SPECIES_PARAMS + PSPECIES="SO2", ! Tracer name + PWETA_GAS=6.28E-5, ! Below-cloud scavenging (gases) - A (weta_gas) [Calculated accord to Asman (1995)] + PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas) [Asman (1995)] + PRELDIFF=1.9, ! Dry deposition (gases) - D [Wesely (1989)] + PHENRY=1.3E+0, ! Dry deposition (gases) - Henrys const. [henrys-law.org] + PF0=0.0, ! Dry deposition (gases) - f0 (reactivity) [Wesely (1989)] + PWEIGHTMOLAR=64.0, ! molweight + / diff --git a/options/SPECIES/SPECIES_SO4-aero b/options/SPECIES/SPECIES_SO4-aero new file mode 100644 index 0000000000000000000000000000000000000000..35d5e43ab4d371b28a997eb43f7b1baa2e0d68a0 --- /dev/null +++ b/options/SPECIES/SPECIES_SO4-aero @@ -0,0 +1,10 @@ +&SPECIES_PARAMS + PSPECIES="SO4-aero", ! Tracer name + PCRAIN_AERO=1.0, ! Below-cloud scavenging (particles) - Crain (crain_aero) [Grythe et al. (2017)] + PCSNOW_AERO=1.0, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) [Grythe et al. (2017)] + PCCN_AERO=0.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) [Grythe et al. (2017)] + PIN_AERO=0.1, ! In-cloud scavenging (particles) - INeff (in_aero) [Grythe et al. (2017)] + PDENSITY=2.0E+03, ! Dry deposition (particles) - rho + PDIA=2.0E-07, ! Dry deposition (particles) - dquer [Tunved et al., 2013] + PDSIGMA=1.5, ! Dry deposition (particles) - dsig [Tunved et al., 2013] + / diff --git a/options/oh_fields/OH_01.nc b/options/oh_fields/OH_01.nc new file mode 100755 index 0000000000000000000000000000000000000000..3933c250dde089e0f1e90d0ddf364d65992b45b4 Binary files /dev/null and b/options/oh_fields/OH_01.nc differ diff --git a/options/oh_fields/OH_02.nc b/options/oh_fields/OH_02.nc new file mode 100755 index 0000000000000000000000000000000000000000..104e7fa6f2b252fd26b8a3b91bedfd8133fef88e Binary files /dev/null and b/options/oh_fields/OH_02.nc differ diff --git a/options/oh_fields/OH_03.nc b/options/oh_fields/OH_03.nc new file mode 100755 index 0000000000000000000000000000000000000000..27dec9d15eb97c1f6eb1bef4057b007a8496d0bd Binary files /dev/null and b/options/oh_fields/OH_03.nc differ diff --git a/options/oh_fields/OH_04.nc b/options/oh_fields/OH_04.nc new file mode 100755 index 0000000000000000000000000000000000000000..587c1e669bd607fa0d838a2a55a92218a6f195e4 Binary files /dev/null and b/options/oh_fields/OH_04.nc differ diff --git a/options/oh_fields/OH_05.nc b/options/oh_fields/OH_05.nc new file mode 100755 index 0000000000000000000000000000000000000000..066dc377cd6b5c9cb552c172c61df769d31dfcd4 Binary files /dev/null and b/options/oh_fields/OH_05.nc differ diff --git a/options/oh_fields/OH_06.nc b/options/oh_fields/OH_06.nc new file mode 100755 index 0000000000000000000000000000000000000000..c422864cceb580a999b4d1ce00479525ae4a08db Binary files /dev/null and b/options/oh_fields/OH_06.nc differ diff --git a/options/oh_fields/OH_07.nc b/options/oh_fields/OH_07.nc new file mode 100755 index 0000000000000000000000000000000000000000..9a682e83dd7746638177219fa4466e700fce3fbd Binary files /dev/null and b/options/oh_fields/OH_07.nc differ diff --git a/options/oh_fields/OH_08.nc b/options/oh_fields/OH_08.nc new file mode 100755 index 0000000000000000000000000000000000000000..2169a896ce5cb1ca1ff18cb10065da6c41791072 Binary files /dev/null and b/options/oh_fields/OH_08.nc differ diff --git a/options/oh_fields/OH_09.nc b/options/oh_fields/OH_09.nc new file mode 100755 index 0000000000000000000000000000000000000000..8f804d99e2ac210245643c4b5bc5d847c4600010 Binary files /dev/null and b/options/oh_fields/OH_09.nc differ diff --git a/options/oh_fields/OH_10.nc b/options/oh_fields/OH_10.nc new file mode 100755 index 0000000000000000000000000000000000000000..4ff9ffba3bd00b3b921298e41cc119bd18d42eb0 Binary files /dev/null and b/options/oh_fields/OH_10.nc differ diff --git a/options/oh_fields/OH_11.nc b/options/oh_fields/OH_11.nc new file mode 100755 index 0000000000000000000000000000000000000000..f51e83237cc85d6f0f9d39c64ca50f7512ba3a36 Binary files /dev/null and b/options/oh_fields/OH_11.nc differ diff --git a/options/oh_fields/OH_12.nc b/options/oh_fields/OH_12.nc new file mode 100755 index 0000000000000000000000000000000000000000..f67007236b399c84061a047fb02a255b5083df15 Binary files /dev/null and b/options/oh_fields/OH_12.nc differ diff --git a/options/oh_fields/jrate_average.nc b/options/oh_fields/jrate_average.nc new file mode 100644 index 0000000000000000000000000000000000000000..29a5ad7dd800ad4185e8e9fad8af41fee9b2a8f5 Binary files /dev/null and b/options/oh_fields/jrate_average.nc differ diff --git a/src/FLEXPART.f90 b/src/FLEXPART.f90 index 859927b3cb933b972f213d5cd1d6898adb63029d..ec735eb06f5f63bdc451d7e6fc66d9db4f37d2d7 100644 --- a/src/FLEXPART.f90 +++ b/src/FLEXPART.f90 @@ -40,6 +40,7 @@ program flexpart implicit none + integer :: i real :: s_timemanager character(len=256) :: & inline_options ! pathfile, flexversion, arg2 @@ -50,10 +51,10 @@ program flexpart CALL SYSTEM_CLOCK(count_clock, count_rate, count_max) s_total = (count_clock - count_clock0)/real(count_rate) - ! FLEXPART version string flexversion_major = '11' ! Major version number, also used for species file names - flexversion='Version '//trim(flexversion_major) + + flexversion='Version '//trim(flexversion_major)//'.0 (2023-07-11)' verbosity=0 call update_gitversion(gitversion_tmp) @@ -119,6 +120,21 @@ program flexpart CALL SYSTEM_CLOCK(count_clock, count_rate, count_max) s_total = (count_clock - count_clock0)/real(count_rate) - s_total + if (verbosity.gt.0) then +! NIK 16.02.2005 + do i=1,nspec + if (icnt_incld(i).gt.0) then + write(*,*) '**********************************************' + write(*,*) 'Scavenging statistics for species ', species(i), ':' + write(*,*) 'Total number of occurences of below-cloud scavenging', & + & icnt_belowcld(i) + write(*,*) 'Total number of occurences of in-cloud scavenging', & + & icnt_incld(i) + write(*,*) '**********************************************' + endif + end do + endif + write(*,*) 'Read wind fields: ', s_readwind, ' seconds' write(*,*) 'Timemanager: ', s_timemanager, ' seconds,', 'first timestep: ',s_firstt, 'seconds' write(*,*) 'Write particle files: ', s_writepart, ' seconds' @@ -154,10 +170,16 @@ subroutine read_options_and_initialise_flexpart use initialise_mod use drydepo_mod use getfields_mod - use interpol_mod, only: alloc_interpol + use interpol_mod, only: alloc_interpol use outgrid_mod use binary_output_mod - use omp_lib, only: OMP_GET_MAX_THREADS + use omp_lib, only: OMP_GET_MAX_THREADS +#ifdef USE_NCF + use chemistry_mod, only: readreagents + use totals_mod + use receptor_netcdf_mod, only: read_satellite_info, receptorout_init +#endif + use receptor_mod, only: alloc_receptor implicit none @@ -172,7 +194,7 @@ subroutine read_options_and_initialise_flexpart ! Read pathnames from file in working director that specify I/O directories !************************************************************************** call readpaths - + ! Read the user specifications for the current model run !******************************************************* call readcommand @@ -215,7 +237,6 @@ subroutine read_options_and_initialise_flexpart !******************************** call readageclasses - ! ! Allocate memory for windfields ! !******************************* ! call alloc_windfields @@ -276,22 +297,39 @@ subroutine read_options_and_initialise_flexpart ! Read the receptor points for which extra concentrations are to be calculated !***************************************************************************** + numreceptor=0 + numsatreceptor=0 + nlayermax=1 +#ifdef USE_NCF + call read_satellite_info +#endif call readreceptors - ! Read the physico-chemical species property table - !************************************************* - !SEC: now only needed SPECIES are read in readreleases.f - !call readspecies - ! Read the landuse inventory !*************************** call readlanduse ! CHECK ETA + ! Read chemical reagent information + !********************************** + ! default settings + nreagent=0 + reagents(:)="" +#ifdef USE_NCF + call readreagents +#endif + ! For continuation of previous run or from user defined initial ! conditions, read in particle positions !************************************************************************* call initialise_particles + ! Initialize variables for totals calculations + !********************************************* +#ifdef USE_NCF + call alloc_totals + call totals_init +#endif + ! Convert the release point coordinates from geografical to grid coordinates !*************************************************************************** call coordtrafo(nxmin1,nymin1) @@ -308,29 +346,30 @@ subroutine read_options_and_initialise_flexpart call alloc_interpol #ifdef USE_NCF if (lnetcdfout.eq.1) call alloc_netcdf -#endif USE_NCF +#endif ! Assign fractional cover of landuse classes to each ECMWF grid point !******************************************************************** call assignland ! Calculate volume, surface area, etc., of all output grid cells - ! Allocate fluxes and OHfield if necessary !*************************************************************** if (iout.ne.0) then call outgrid_init if (nested_output.eq.1) call outgrid_init_nest ! CHECK ETA endif - ! Read the OH field - !****************** - if (OHREA) then - call readOHfield - endif + ! Initialize receptor output + !*************************** - ! Binary receptor output when lnetcdfout is set to zero, otherwise - ! added to gridded output - if (lnetcdfout.eq.0) call openreceptors + call alloc_receptor + if (lnetcdfout.eq.1) then +#ifdef USE_NCF + call receptorout_init +#endif + else + call receptorout_init_binary + endif if ((iout.eq.4).or.(iout.eq.5)) call openouttraj ! CHECK ETA @@ -348,6 +387,7 @@ subroutine read_options_and_initialise_flexpart !************************************ allocate(nan_count(numthreads), stat=stat) if (stat.ne.0) error stop "Could not allocate nan_count" + end subroutine read_options_and_initialise_flexpart subroutine initialise_particles @@ -393,6 +433,8 @@ subroutine initialise_particles if (ipin.le.2) then call readreleases + ! needs to be called after maxspec is defined in readreleases or readinitconditions + if (ipout.ne.0) call readpartoptions else #ifdef USE_NCF call readinitconditions_netcdf @@ -401,8 +443,6 @@ subroutine initialise_particles #endif endif - if (ipout.ne.0) call readpartoptions - if (iout.ne.0) then call alloc_grid call alloc_grid_unc diff --git a/src/advance_mod.f90 b/src/advance_mod.f90 index 442f891780b2e38dc89090002198c067aba6d06e..8c18451026b8660db887b304d3ba23b06b6c9e55 100644 --- a/src/advance_mod.f90 +++ b/src/advance_mod.f90 @@ -145,12 +145,11 @@ subroutine advance(itime,ipart,ithread) if (DRYDEP) then ! reset probability for deposition depoindicator(:,ithread+1)=.true. - part(ipart)%prob=0. + prob(ipart,:)=0. endif if (lsettling) part(ipart)%settling=0. - !if (ipart.eq.1) write(*,*) 'Mass: ', part(ipart)%mass(:), itime dxsave=0. ! reset position displacements dysave=0. ! due to mean wind dawsave=0. ! and turbulent wind @@ -411,10 +410,16 @@ subroutine adv_above_pbl(itime,itimec,dxsave,dysave,ux,vy,tropop,nrand,ipart) call get_settling(xts,yts,zts,nsp,part(ipart)%settling) #ifdef ETA call update_zeta_to_z(itime,ipart) + if ((ldirect.eq.1).and.(part(ipart)%z+part(ipart)%settling*dt.lt.0.)) then + part(ipart)%settling=-part(ipart)%z/dt + endif call w_to_weta(itime,dt,part(ipart)%xlon,part(ipart)%ylat, & part(ipart)%z,part(ipart)%zeta,part(ipart)%settling,weta_settling) - weta=weta+weta_settling + weta=weta+weta_settling #else + if ((ldirect.eq.1).and.(part(ipart)%z+part(ipart)%settling*dt.lt.0.)) then + part(ipart)%settling=-part(ipart)%z/dt + endif w=w+part(ipart)%settling #endif end if @@ -587,6 +592,9 @@ subroutine adv_in_pbl(itime,itimec, dxsave,dysave,dawsave,dcwsave, abovePBL, & endif if (density(nsp).gt.0.) then call get_settling(xts,yts,zts,nsp,part(ipart)%settling) !bugfix + if ((ldirect.eq.1).and.(part(ipart)%z+part(ipart)%settling*dt.lt.0.)) then + part(ipart)%settling=-part(ipart)%z/dt + endif w=w+part(ipart)%settling end if end if @@ -631,7 +639,7 @@ subroutine adv_in_pbl(itime,itimec, dxsave,dysave,dawsave,dcwsave, abovePBL, & ! Determine probability of deposition !************************************ if (DRYDEP) then - call drydepo_probability(part(ipart)%prob,dt,zts,vdepo,ithread+1) + call drydepo_probability(ipart,dt,zts,vdepo,ithread+1) endif if (zts.lt.0.) call set_z(ipart,min(h-eps2,-1.*part(ipart)%z)) @@ -713,6 +721,10 @@ subroutine petterssen_corr(itime,ipart) call update_z_to_zeta(itime+part(ipart)%idt,ipart) zts=real(part(ipart)%z) call get_settling(xts,yts,zts,nsp,part(ipart)%settling) !bugfix + if ((ldirect.eq.1).and. & + (part(ipart)%z+part(ipart)%settling*part(ipart)%idt.lt.0)) then + part(ipart)%settling=-part(ipart)%z/part(ipart)%idt + endif call w_to_weta( & itime+part(ipart)%idt, real(part(ipart)%idt), part(ipart)%xlon, & part(ipart)%ylat, part(ipart)%z, part(ipart)%zeta, & @@ -722,6 +734,10 @@ subroutine petterssen_corr(itime,ipart) !real(part(ipart)%zeta-part(ipart)%zeta_prev)/real(part(ipart)%idt*ldirect) #else call get_settling(xts,yts,zts,nsp,part(ipart)%settling) + if ((ldirect.eq.1).and. & + (part(ipart)%z+part(ipart)%settling*part(ipart)%idt.lt.0)) then + part(ipart)%settling=-part(ipart)%z/part(ipart)%idt + endif w=w+part(ipart)%settling #endif end if @@ -736,12 +752,12 @@ subroutine petterssen_corr(itime,ipart) v=(v-vold)*0.5 #ifdef ETA - weta=(weta-woldeta)/2. + weta=(weta-woldeta)*0.5 call update_zeta(ipart,weta*real(part(ipart)%idt*ldirect)) if (part(ipart)%zeta.ge.1.) call set_zeta(ipart,1.-(part(ipart)%zeta-1.)) if (part(ipart)%zeta.eq.1.) call update_zeta(ipart,-eps_eta) #else - w=(w-wold)/2. + w=(w-wold)*0.5 call update_z(ipart,w*real(part(ipart)%idt*ldirect)) if (part(ipart)%z.lt.0.) call set_z(ipart,min(h-eps2,-1.*part(ipart)%z)) ! if particle below ground -> reflection #endif @@ -862,11 +878,21 @@ subroutine pushpartdown(ipart) eps=nxmax/3.e5 #ifdef ETA - if (part(ipart)%zeta.le.real(uvheight(nz),kind=dp)) & - call set_zeta(ipart,uvheight(nz)+eps_eta) + if (part(ipart)%zeta.le.real(uvheight(nz),kind=dp)) then + if ((ldirect.eq.-1) .and. (lsettling)) then + part(ipart)%nstop=.true. + else + call set_zeta(ipart,uvheight(nz)+eps_eta) + endif + endif #else - if (part(ipart)%z.ge.real(height(nz),kind=dp)) & - call set_z(ipart,height(nz)-100.*eps) + if (part(ipart)%z.ge.real(height(nz),kind=dp)) then + if ((ldirect.eq.-1) .and. (lsettling)) then + part(ipart)%nstop=.true. + else + call set_z(ipart,height(nz)-100.*eps) + endif + endif #endif end subroutine pushpartdown diff --git a/src/binary_output_mod.f90 b/src/binary_output_mod.f90 index df48ce7fe338b4ae8c96279e568fc74d5d844b68..49d23a486b145b1a55569ad2da207433d32e3074 100644 --- a/src/binary_output_mod.f90 +++ b/src/binary_output_mod.f90 @@ -6,9 +6,9 @@ ! This module contains routines that output gridded data to binary files. * ! * ! Not all routines that should have a netcdf equivalent, have one yet: * - ! writeheader_bin_sfc_nest,writeheader_bin_sfc,concoutput_sfc, * - ! concoutput_sfc_nest,initcond_output,initcond_output_inv, * - ! concoutput_inv_nest * + ! writeheader_bin_sfc_nest,writeheader_bin_sfc, * + ! initcond_output,initcond_output_inversion * + ! concoutput_inversion, concoutput_inversion_nest * ! * ! L. Bakels 2022 * ! * @@ -583,41 +583,48 @@ subroutine writeheader_bin_sfc end subroutine writeheader_bin_sfc -subroutine openreceptors +subroutine receptorout_init_binary !***************************************************************************** ! * ! This routine opens the receptor output files and writes out the receptor * - ! names and the receptor locations. The receptor output files are not * + ! names, location and times. The receptor output files are not * ! closed, but kept open throughout the simulation. Concentrations are * ! continuously dumped to these files. * ! * ! Author: A. Stohl * - ! * ! 7 August 2002 * ! * + ! Modified: R. Thompson * + ! January 2024: for moving receptors * + ! changed format write to: * + ! nspec * + ! and then for each timestep and receptors: * + ! name, lat, lon, alt, time, nn, xk, conc, unc * + ! * !***************************************************************************** ! * ! Variables: * ! numreceptor actual number of receptor points specified * - ! receptornames names of the receptor points * - ! xreceptor,yreceptor coordinates of the receptor points * + ! receptorname names of the receptor points * + ! xreceptor longitude coordinate of the receptor points * + ! yreceptor latitude coordinate of the receptor points * + ! zreceptor altitude coordinate of the receptor points * + ! treceptor time coordinate of the receptor points * ! * !***************************************************************************** implicit none - integer :: j - - ! Open output file for receptor points and write out a short header - ! containing receptor names and locations - !****************************************************************** - - if (numreceptor.ge.1) then ! do it only if receptors are specified + if (numreceptor.eq.0) then + return + endif - ! Concentration output - !********************* + ! Open output file for receptor points and write number + ! of receptors and species for concentration and uncertainty variables + !********************************************************************** + ! Concentration output if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then if ((ipin.eq.1).or.(ipin.eq.4)) then open(unitoutrecept,file=path(2)(1:length(2))//'receptor_conc', & @@ -625,40 +632,197 @@ subroutine openreceptors else open(unitoutrecept,file=path(2)(1:length(2))//'receptor_conc', & form='unformatted',err=997) - write(unitoutrecept) (receptorname(j),j=1,numreceptor) - write(unitoutrecept) (xreceptor(j)*dx+xlon0, & - yreceptor(j)*dy+ylat0,j=1,numreceptor) + write(unitoutrecept) numreceptor + if (llcmoutput) then + write(unitoutrecept) nspec-1 ! first species is mass of air + else + write(unitoutrecept) nspec + endif endif endif - ! Mixing ratio output - !******************** - + ! Mixing ratio output if ((iout.eq.2).or.(iout.eq.3)) then if ((ipin.eq.1).or.(ipin.eq.4)) then open(unitoutreceptppt,file=path(2)(1:length(2))//'receptor_pptv', & - access='APPEND',status='OLD',err=997) + access='APPEND',status='OLD',err=998) else open(unitoutreceptppt,file=path(2)(1:length(2))//'receptor_pptv', & form='unformatted',err=998) - write(unitoutreceptppt) (receptorname(j),j=1,numreceptor) - write(unitoutreceptppt) (xreceptor(j)*dx+xlon0, & - yreceptor(j)*dy+ylat0,j=1,numreceptor) + write(unitoutreceptppt) numreceptor + if (llcmoutput) then + write(unitoutreceptppt) nspec-1 ! first species is mass of air + else + write(unitoutreceptppt) nspec + endif endif endif - endif - return + return + 997 write(*,*) ' #### FLEXPART MODEL ERROR! THE FILE #### ' - write(*,*) ' #### receptor_conc #### ' - write(*,*) ' #### CANNOT BE OPENED. #### ' - error stop + write(*,*) ' #### receptor_conc #### ' + write(*,*) ' #### CANNOT BE OPENED. #### ' + error stop 998 write(*,*) ' #### FLEXPART MODEL ERROR! THE FILE #### ' - write(*,*) ' #### receptor_pptv #### ' - write(*,*) ' #### CANNOT BE OPENED. #### ' - error stop -end subroutine openreceptors + write(*,*) ' #### receptor_pptv #### ' + write(*,*) ' #### CANNOT BE OPENED. #### ' + error stop + +end subroutine receptorout_init_binary + + +subroutine satelliteout_init_binary + + !***************************************************************************** + ! * + ! This routine opens the satellite output files for subsequent writing * + ! * + ! Author: R. Thompson * + ! January 2024 * + ! * + !***************************************************************************** + ! * + ! Variables: * + ! numsatreceptor actual number of satellite receptors * + ! nspec number of species * + ! nlayermax max number of layers in retrievals * + ! * + !***************************************************************************** + + implicit none + + if (numsatreceptor.eq.0) then + return + endif + + ! Open output file for satellite receptors and write number + ! of receptors and species for concentration and uncertainty variables + !********************************************************************** + + ! Mixing ratio output + if ((ipin.eq.1).or.(ipin.eq.4)) then + open(unitoutsatellite,file=path(2)(1:length(2))//'satellite_pptv', & + access='APPEND',status='OLD',err=998) + else + open(unitoutsatellite,file=path(2)(1:length(2))//'satellite_pptv', & + form='unformatted',err=998) +! write(unitoutsatellite) numsatreceptor + if (llcmoutput) then + write(unitoutsatellite) nspec-1 ! first species is mass of air + else + write(unitoutsatellite) nspec + endif + write(unitoutsatellite) nlayermax + endif + + return + +998 write(*,*) ' #### FLEXPART MODEL ERROR! THE FILE #### ' + write(*,*) ' #### satellite_pptv #### ' + write(*,*) ' #### CANNOT BE OPENED. #### ' + error stop + +end subroutine satelliteout_init_binary + + +subroutine write_receptor_binary(crec,cunc,nnrec,xkrec,lonrec,latrec,altrec,timerec,namerec,nrec) + + !***************************************************************************** + ! * + ! This routine writes the receptor concentrations for each time step * + ! and receptor to binary output files * + ! * + ! R. Thompson, January 2024 * + ! * + !***************************************************************************** + + implicit none + + integer :: nrec, ks, ks_start + real, dimension(nspec,maxrecsample,nlayermax) :: crec, cunc + real, dimension(maxrecsample,nlayermax) :: nnrec, xkrec, altrec + real, dimension(maxrecsample) :: lonrec, latrec + integer, dimension(maxrecsample) :: timerec + character(len=16), dimension(maxrecsample) :: namerec + + if (llcmoutput) then + ks_start=2 + else + ks_start=1 + endif + + if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then + write(unitoutrecept) nrec + write(unitoutrecept) namerec(1:nrec) + write(unitoutrecept) lonrec(1:nrec) + write(unitoutrecept) latrec(1:nrec) + write(unitoutrecept) altrec(1:nrec,1) + write(unitoutrecept) timerec(1:nrec) + write(unitoutrecept) nnrec(1:nrec,1) + write(unitoutrecept) xkrec(1:nrec,1) + write(unitoutrecept) (crec(ks,1:nrec,1),ks=ks_start,nspec) + write(unitoutrecept) (cunc(ks,1:nrec,1),ks=ks_start,nspec) + endif + if ((iout.eq.2).or.(iout.eq.3)) then + write(unitoutreceptppt) nrec + write(unitoutreceptppt) namerec(1:nrec) + write(unitoutreceptppt) lonrec(1:nrec) + write(unitoutreceptppt) latrec(1:nrec) + write(unitoutreceptppt) altrec(1:nrec,1) + write(unitoutreceptppt) timerec(1:nrec) + write(unitoutreceptppt) nnrec(1:nrec,1) + write(unitoutreceptppt) xkrec(1:nrec,1) + write(unitoutreceptppt) (crec(ks,1:nrec,1),ks=ks_start,nspec) + write(unitoutreceptppt) (cunc(ks,1:nrec,1),ks=ks_start,nspec) + endif + +end subroutine write_receptor_binary + + +subroutine write_satellite_binary(crec,cunc,nnrec,xkrec,lonrec,latrec,altrec,timerec,namerec,nrec) + + !***************************************************************************** + ! * + ! This routine writes the satellite concentrations for each time step * + ! and receptor to binary output files * + ! * + ! R. Thompson, January 2024 * + ! * + !***************************************************************************** + + implicit none + + integer :: nrec, n, ks, ks_start + real, dimension(nspec,maxrecsample,nlayermax) :: crec, cunc + real, dimension(maxrecsample,nlayermax) :: nnrec, xkrec, altrec + real, dimension(maxrecsample) :: lonrec, latrec + integer, dimension(maxrecsample) :: timerec + character(len=24), dimension(maxrecsample) :: namerec + + if (llcmoutput) then + ks_start=2 + else + ks_start=1 + endif + + ! satellite only mixing ratio output + write(unitoutsatellite) nrec + write(unitoutsatellite) namerec(1:nrec) + write(unitoutsatellite) timerec(1:nrec) + write(unitoutsatellite) lonrec(1:nrec) + write(unitoutsatellite) latrec(1:nrec) + write(unitoutsatellite) (altrec(n,1:nlayermax),n=1,nrec) + write(unitoutsatellite) (nnrec(n,1:nlayermax),n=1,nrec) + write(unitoutsatellite) (xkrec(n,1:nlayermax),n=1,nrec) + do ks=ks_start,nspec + write(unitoutsatellite) (crec(ks,n,1:nlayermax),n=1,nrec) + write(unitoutsatellite) (cunc(ks,n,1:nlayermax),n=1,nrec) + end do + +end subroutine write_satellite_binary + subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, & drygridtotalunc) @@ -666,7 +830,7 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, & ! o !***************************************************************************** ! * - ! Output of the concentration grid and the receptor concentrations. * + ! Output of the concentration grid * ! * ! Author: A. Stohl * ! * @@ -707,10 +871,7 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, & integer :: itime,i,ix,jy,kz,ks,kp,l,iix,jjy,kzz,nage,jjjjmmdd,ihmmss integer :: sp_count_i,sp_count_r real :: sp_fact - real :: outnum,densityoutrecept(numreceptor),xl,yl - ! RLT - real :: densitydryrecept(numreceptor) - real :: factor_dryrecept(numreceptor) + real :: outnum,xl,yl real(dep_prec) :: auxgrid(nclassunc) real(sp) :: gridtotal,gridsigmatotal,gridtotalunc @@ -729,6 +890,7 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, & logical :: lexist integer :: ierr character(LEN=100) :: dates_char + integer :: numzwrite, ks_start ! Determine current calendar date, needed for the file name !********************************************************** @@ -740,7 +902,6 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, & ! Overwrite existing dates file on first call, later append to it ! This fixes a bug where the dates file kept growing across multiple runs - ! Restarting a run: if ((ipin.eq.1).or.(ipin.eq.4)) then file_stat='OLD' @@ -782,11 +943,7 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, & if (ldirect.eq.1) then - do ks=1,nspec - do kp=1,maxpointspec_act - tot_mu(ks,kp)=1 - end do - end do + tot_mu(:,:)=1. else do ks=1,nspec do kp=1,maxpointspec_act @@ -801,70 +958,90 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, & ! from coarse grid at some time ! Determine center altitude of output layer, and interpolate density ! data to that altitude + ! + ! Note: + ! llcmoutput = true: grid is mass_spec/mass_air + ! for iout 1,3, or 5 multiply by rho + ! for iout 2 multiply by 1 + ! llcmoutput = false: grid is mass_spec/V + ! for iout 1,3, or 5 multiply by 1 + ! for iout 2 multiply by 1/rho !******************************************************************* - mind=memind(2) - do kz=1,numzgrid - if (kz.eq.1) then - halfheight=outheight(1)/2. - else - halfheight=(outheight(kz)+outheight(kz-1))/2. - endif - do kzz=2,nz - if ((height(kzz-1).lt.halfheight).and. & - (height(kzz).gt.halfheight)) exit - end do - kzz=max(min(kzz,nz),2) - dz1=halfheight-height(kzz-1) - dz2=height(kzz)-halfheight - dz=dz1+dz2 - do jy=0,numygrid-1 - do ix=0,numxgrid-1 - xl=outlon0+real(ix)*dxout - yl=outlat0+real(jy)*dyout - xl=(xl-xlon0)/dx - yl=(yl-ylat0)/dy !v9.1.1 - iix=max(min(nint(xl),nxmin1),0) - jjy=max(min(nint(yl),nymin1),0) - ! densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,2)*dz1+ & - ! rho(iix,jjy,kzz-1,2)*dz2)/dz - densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,mind)*dz1+ & - rho(iix,jjy,kzz-1,mind)*dz2)/dz - ! RLT - densitydrygrid(ix,jy,kz)=(rho_dry(iix,jjy,kzz,mind)*dz1+ & - rho_dry(iix,jjy,kzz-1,mind)*dz2)/dz +!$OMP PARALLEL & +!$OMP PRIVATE(kz,halfheight,kzz,dz1,dz2,dz,xl,yl,iix,jjy, & +!$OMP ix,jy,l,ks,kp,nage,auxgrid) & +!$OMP REDUCTION(+:wetgridtotal,wetgridsigmatotal, & +!$OMP drygridtotal,drygridsigmatotal,gridtotal,gridsigmatotal) + + if (((.not.llcmoutput).and.(iout.eq.2)).or.& + (llcmoutput.and.((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)))) then + ! compute density + mind=memind(2) +!$OMP DO + do kz=1,numzgrid + if (kz.eq.1) then + halfheight=outheight(1)*0.5 + else + halfheight=(outheight(kz)+outheight(kz-1))*0.5 + endif + do kzz=2,nz + if ((height(kzz-1).lt.halfheight).and. & + (height(kzz).gt.halfheight)) exit + end do + kzz=max(min(kzz,nz),2) + dz1=halfheight-height(kzz-1) + dz2=height(kzz)-halfheight + dz=dz1+dz2 + do jy=0,numygrid-1 + do ix=0,numxgrid-1 + xl=outlon0+real(ix)*dxout + yl=outlat0+real(jy)*dyout + xl=(xl-xlon0)/dx + yl=(yl-ylat0)/dy !v9.1.1 + iix=max(min(nint(xl),nxmin1),0) + jjy=max(min(nint(yl),nymin1),0) + densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,mind)*dz1+ & + rho(iix,jjy,kzz-1,mind)*dz2)/dz + densitydrygrid(ix,jy,kz)=(rho_dry(iix,jjy,kzz,mind)*dz1+ & + rho_dry(iix,jjy,kzz-1,mind)*dz2)/dz + end do end do end do - end do - - do i=1,numreceptor - xl=xreceptor(i) - yl=yreceptor(i) - iix=max(min(nint(xl),nxmin1),0) - jjy=max(min(nint(yl),nymin1),0) - !densityoutrecept(i)=rho(iix,jjy,1,2) - densityoutrecept(i)=rho(iix,jjy,1,mind) - ! RLT - densitydryrecept(i)=rho_dry(iix,jjy,1,mind) - end do - - ! RLT - ! conversion factor for output relative to dry air - factor_drygrid=densityoutgrid/densitydrygrid - factor_dryrecept=densityoutrecept/densitydryrecept +!$OMP END DO + ! conversion factor for output relative to dry air + factor_drygrid=densityoutgrid/densitydrygrid + if (llcmoutput) then + ! because divide grid by densityoutgrid + densityoutgrid=1./densityoutgrid + endif + else + ! no division by density + densityoutgrid(:,:,:)=1. + endif ! Output is different for forward and backward simulations - do kz=1,numzgrid - do jy=0,numygrid-1 - do ix=0,numxgrid-1 - if (ldirect.eq.1) then - factor3d(ix,jy,kz)=1.e12/volume(ix,jy,kz)/outnum - else - factor3d(ix,jy,kz)=real(abs(loutaver))/outnum - endif + if (ldirect.eq.1) then +!$OMP DO + do kz=1,numzgrid + do jy=0,numygrid-1 + do ix=0,numxgrid-1 + if (llcmoutput) then + if (gridcnt(ix,jy,kz).gt.0.) then + factor3d(ix,jy,kz)=1.e12/gridcnt(ix,jy,kz) + else + factor3d(ix,jy,kz)=0. + endif + else + factor3d(ix,jy,kz)=1.e12/volume(ix,jy,kz)/outnum + endif + end do end do end do - end do +!$OMP END DO + else + factor3d(:,:,:)=real(abs(loutaver))/outnum + endif !********************************************************************* ! Determine the standard deviation of the mean concentration or mixing @@ -881,8 +1058,16 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, & drygridsigmatotal=0. drygridtotalunc=0. - do ks=1,nspec + if (llcmoutput) then + ks_start=2 + else + ks_start=1 + endif + do ks=ks_start,nspec + +!$OMP BARRIER +!$OMP SINGLE write(anspec,'(i3.3)') ks if (DRYBKDEP.or.WETBKDEP) then !scavdep output @@ -910,10 +1095,11 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, & write(unitoutgridppt) itime endif endif ! if deposition output +!$OMP END SINGLE do kp=1,maxpointspec_act do nage=1,nageclass - +!$OMP DO do jy=0,numygrid-1 do ix=0,numxgrid-1 @@ -975,6 +1161,7 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, & end do end do end do +!$OMP END DO !******************************************************************* ! Generate output: may be in concentration (ng/m3) or in mixing @@ -984,8 +1171,12 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, & ! For backward simulations, the unit is seconds, stored in grid_time !******************************************************************* +!$OMP BARRIER +!$OMP SINGLE + ! Concentration output !********************* + if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then ! Wet deposition @@ -996,7 +1187,7 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, & if ((ldirect.eq.1).and.(WETDEP)) then do jy=0,numygrid-1 do ix=0,numxgrid-1 - !oncentraion greater zero + ! concentration greater zero if (wetgrid(ix,jy).gt.smallnum) then if (sp_zer.eqv..true.) then ! first non zero value sp_count_i=sp_count_i+1 @@ -1054,14 +1245,14 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, & write(unitoutgrid) sp_count_r write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r) - - ! Concentrations sp_count_i=0 sp_count_r=0 sp_fact=-1. sp_zer=.true. - do kz=1,numzgrid + numzwrite=numzgrid + if (sfc_only.eq.1) numzwrite=1 + do kz=1,numzwrite do jy=0,numygrid-1 do ix=0,numxgrid-1 if (grid(ix,jy,kz).gt.smallnum) then @@ -1094,9 +1285,6 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, & write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i) write(unitoutgrid) sp_count_r write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r) - - - endif ! concentration output ! Mixing ratio output @@ -1138,7 +1326,6 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, & write(unitoutgridppt) sp_count_r write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r) - ! Dry deposition sp_count_i=0 sp_count_r=0 @@ -1173,13 +1360,14 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, & write(unitoutgridppt) sp_count_r write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r) - ! Mixing ratios sp_count_i=0 sp_count_r=0 sp_fact=-1. sp_zer=.true. - do kz=1,numzgrid + numzwrite=numzgrid + if (sfc_only.eq.1) numzwrite=1 + do kz=1,numzwrite do jy=0,numygrid-1 do ix=0,numxgrid-1 if (grid(ix,jy,kz).gt.smallnum) then @@ -1193,8 +1381,7 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, & sp_count_r=sp_count_r+1 sparse_dump_r(sp_count_r)= & sp_fact* & - 1.e12*grid(ix,jy,kz) & - /volume(ix,jy,kz)/outnum* & + factor3d(ix,jy,kz)*grid(ix,jy,kz)* & weightair/weightmolar(ks)/densityoutgrid(ix,jy,kz) else ! concentration is zero sp_zer=.true. @@ -1208,7 +1395,8 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, & write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r) endif ! output for ppt - +!$OMP END SINGLE +!$OMP BARRIER end do end do @@ -1216,49 +1404,54 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, & close(unitoutgrid) end do +!$OMP END PARALLEL - ! RLT Aug 2017 ! Write out conversion factor for dry air - inquire(file=path(2)(1:length(2))//'factor_drygrid',exist=lexist) - if (lexist) then - ! open and append - open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid',form='unformatted',& + !**************************************** + + if (.not.llcmoutput) then + inquire(file=path(2)(1:length(2))//'factor_drygrid',exist=lexist) + if (lexist) then + ! open and append + open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid',form='unformatted',& status='old',action='write',access='append') - else - ! create new - open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid',form='unformatted',& + else + ! create new + open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid',form='unformatted',& status='new',action='write') - endif - sp_count_i=0 - sp_count_r=0 - sp_fact=-1. - sp_zer=.true. - do kz=1,numzgrid - do jy=0,numygrid-1 - do ix=0,numxgrid-1 - if (factor_drygrid(ix,jy,kz).gt.(1.+smallnum).or.factor_drygrid(ix,jy,kz).lt.(1.-smallnum)) then - if (sp_zer.eqv..true.) then ! first value not equal to one - sp_count_i=sp_count_i+1 - sparse_dump_i(sp_count_i)= & + endif + sp_count_i=0 + sp_count_r=0 + sp_fact=-1. + sp_zer=.true. + numzwrite=numzgrid + if (sfc_only.eq.1) numzwrite=1 + do kz=1,numzwrite + do jy=0,numygrid-1 + do ix=0,numxgrid-1 + if (factor_drygrid(ix,jy,kz).gt.(1.+smallnum).or.factor_drygrid(ix,jy,kz).lt.(1.-smallnum)) then + if (sp_zer.eqv..true.) then ! first value not equal to one + sp_count_i=sp_count_i+1 + sparse_dump_i(sp_count_i)= & ix+jy*numxgrid+kz*numxgrid*numygrid - sp_zer=.false. - sp_fact=sp_fact*(-1.) + sp_zer=.false. + sp_fact=sp_fact*(-1.) + endif + sp_count_r=sp_count_r+1 + sparse_dump_r(sp_count_r)= & + sp_fact*factor_drygrid(ix,jy,kz) + else ! factor is one + sp_zer=.true. endif - sp_count_r=sp_count_r+1 - sparse_dump_r(sp_count_r)= & - sp_fact*factor_drygrid(ix,jy,kz) - else ! factor is one - sp_zer=.true. - endif + end do end do end do - end do - write(unitoutfactor) sp_count_i - write(unitoutfactor) (sparse_dump_i(i),i=1,sp_count_i) - write(unitoutfactor) sp_count_r - write(unitoutfactor) (sparse_dump_r(i),i=1,sp_count_r) - close(unitoutfactor) - + write(unitoutfactor) sp_count_i + write(unitoutfactor) (sparse_dump_i(i),i=1,sp_count_i) + write(unitoutfactor) sp_count_r + write(unitoutfactor) (sparse_dump_r(i),i=1,sp_count_r) + close(unitoutfactor) + endif if (gridtotal.gt.0.) gridtotalunc=gridsigmatotal/gridtotal if (wetgridtotal.gt.0.) wetgridtotalunc=wetgridsigmatotal/ & @@ -1266,53 +1459,20 @@ subroutine concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, & if (drygridtotal.gt.0.) drygridtotalunc=drygridsigmatotal/ & drygridtotal - ! Dump of receptor concentrations - - if (numreceptor.gt.0 .and. (iout.eq.2 .or. iout.eq.3) ) then - write(unitoutreceptppt) itime - do ks=1,nspec - write(unitoutreceptppt) (1.e12*creceptor(i,ks)/outnum* & - weightair/weightmolar(ks)/densityoutrecept(i),i=1,numreceptor) - end do - endif - - ! Dump of receptor concentrations - - if (numreceptor.gt.0) then - write(unitoutrecept) itime - do ks=1,nspec - write(unitoutrecept) (1.e12*creceptor(i,ks)/outnum, & - i=1,numreceptor) - end do - endif - - ! RLT Aug 2017 - ! Write out conversion factor for dry air - if (numreceptor.gt.0) then - inquire(file=path(2)(1:length(2))//'factor_dryreceptor',exist=lexist) - if (lexist) then - ! open and append - open(unitoutfactor,file=path(2)(1:length(2))//'factor_dryreceptor',form='unformatted',& - status='old',action='write',access='append') - else - ! create new - open(unitoutfactor,file=path(2)(1:length(2))//'factor_dryreceptor',form='unformatted',& - status='new',action='write') - endif - write(unitoutfactor) itime - write(unitoutfactor) (factor_dryrecept(i),i=1,numreceptor) - close(unitoutfactor) - endif - - creceptor(:,:)=0. gridunc(:,:,:,:,:,:,:)=0. + gridcnt(:,:,:) = 0. +#ifdef _OPENMP + gridunc_omp(:,:,:,:,:,:,:,:) = 0. + gridcnt_omp(:,:,:,:) = 0. +#endif + end subroutine concoutput subroutine concoutput_nest(itime,outnum) ! i i !***************************************************************************** ! * - ! Output of the concentration grid and the receptor concentrations. * + ! Output of the nested concentration grid * ! * ! Author: A. Stohl * ! * @@ -1352,29 +1512,7 @@ subroutine concoutput_nest(itime,outnum) integer :: itime,i,ix,jy,kz,ks,kp,l,iix,jjy,kzz,nage,jjjjmmdd,ihmmss integer :: sp_count_i,sp_count_r real :: sp_fact - real :: outnum,densityoutrecept(numreceptor),xl,yl - ! RLT - real :: densitydryrecept(numreceptor) - real :: factor_dryrecept(numreceptor) - - !real densityoutgrid(0:numxgrid-1,0:numygrid-1,numzgrid), - ! +grid(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec,maxpointspec_act, - ! + maxageclass) - !real wetgrid(0:numxgrid-1,0:numygrid-1,maxspec,maxpointspec_act, - ! + maxageclass) - !real drygrid(0:numxgrid-1,0:numygrid-1,maxspec, - ! + maxpointspec_act,maxageclass) - !real gridsigma(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec, - ! + maxpointspec_act,maxageclass), - ! + drygridsigma(0:numxgrid-1,0:numygrid-1,maxspec, - ! + maxpointspec_act,maxageclass), - ! + wetgridsigma(0:numxgrid-1,0:numygrid-1,maxspec, - ! + maxpointspec_act,maxageclass) - !real factor(0:numxgrid-1,0:numygrid-1,numzgrid) - !real sparse_dump_r(numxgrid*numygrid*numzgrid) - !integer sparse_dump_i(numxgrid*numygrid*numzgrid) - - !real sparse_dump_u(numxgrid*numygrid*numzgrid) + real :: outnum,xl,yl real(dep_prec) :: auxgrid(nclassunc) real :: halfheight,dz,dz1,dz2,tot_mu(maxspec,maxpointspec_act) real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled @@ -1384,6 +1522,7 @@ subroutine concoutput_nest(itime,outnum) character(len=3) :: anspec logical :: lexist integer :: mind + integer :: numzwrite ! Determine current calendar date, needed for the file name @@ -1401,19 +1540,15 @@ subroutine concoutput_nest(itime,outnum) !***************************************************************** - if (ldirect.eq.1) then - do ks=1,nspec - do kp=1,maxpointspec_act - tot_mu(ks,kp)=1 - end do - end do - else - do ks=1,nspec - do kp=1,maxpointspec_act - tot_mu(ks,kp)=xmass(kp,ks) - end do + if (ldirect.eq.1) then + tot_mu(:,:)=1. + else + do ks=1,nspec + do kp=1,maxpointspec_act + tot_mu(ks,kp)=xmass(kp,ks) end do - endif + end do + endif !******************************************************************* @@ -1424,17 +1559,23 @@ subroutine concoutput_nest(itime,outnum) !******************************************************************* mind=memind(2) + +!$OMP PARALLEL & +!$OMP PRIVATE(halfheight,kzz,dz1,dz2,dz,xl,yl,iix,jjy, & +!$OMP kz,ix,jy,l,ks,kp,nage,auxgrid) + +!$OMP DO do kz=1,numzgrid if (kz.eq.1) then - halfheight=outheight(1)/2. + halfheight=outheight(1)*0.5 else - halfheight=(outheight(kz)+outheight(kz-1))/2. + halfheight=(outheight(kz)+outheight(kz-1))*0.5 endif do kzz=2,nz if ((height(kzz-1).lt.halfheight).and. & - (height(kzz).gt.halfheight)) goto 46 + (height(kzz).gt.halfheight)) exit end do -46 kzz=max(min(kzz,nz),2) + kzz=max(min(kzz,nz),2) dz1=halfheight-height(kzz-1) dz2=height(kzz)-halfheight dz=dz1+dz2 @@ -1446,45 +1587,24 @@ subroutine concoutput_nest(itime,outnum) yl=(yl-ylat0)/dy iix=max(min(nint(xl),nxmin1),0) jjy=max(min(nint(yl),nymin1),0) - ! densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,2)*dz1+ & - ! rho(iix,jjy,kzz-1,2)*dz2)/dz densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,mind)*dz1+ & rho(iix,jjy,kzz-1,mind)*dz2)/dz - ! RLT densitydrygrid(ix,jy,kz)=(rho_dry(iix,jjy,kzz,mind)*dz1+ & rho_dry(iix,jjy,kzz-1,mind)*dz2)/dz end do end do end do +!$OMP END DO - do i=1,numreceptor - xl=xreceptor(i) - yl=yreceptor(i) - iix=max(min(nint(xl),nxmin1),0) - jjy=max(min(nint(yl),nymin1),0) - !densityoutrecept(i)=rho(iix,jjy,1,2) - densityoutrecept(i)=rho(iix,jjy,1,mind) - ! RLT - densitydryrecept(i)=rho_dry(iix,jjy,1,mind) - end do - - ! RLT ! conversion factor for output relative to dry air factor_drygrid=densityoutgrid/densitydrygrid - factor_dryrecept=densityoutrecept/densitydryrecept ! Output is different for forward and backward simulations - do kz=1,numzgrid - do jy=0,numygridn-1 - do ix=0,numxgridn-1 - if (ldirect.eq.1) then - factor3d(ix,jy,kz)=1.e12/volumen(ix,jy,kz)/outnum - else - factor3d(ix,jy,kz)=real(abs(loutaver))/outnum - endif - end do - end do - end do + if ( ldirect.eq.1) then + factor3d(:,:,:)=1.e12/volumen(:,:,:)/outnum + else + factor3d(:,:,:)=real(abs(loutaver))/outnum + endif !********************************************************************* ! Determine the standard deviation of the mean concentration or mixing @@ -1493,9 +1613,11 @@ subroutine concoutput_nest(itime,outnum) do ks=1,nspec - write(anspec,'(i3.3)') ks +!$OMP BARRIER +!$OMP SINGLE + write(anspec,'(i3.3)') ks - if (DRYBKDEP.or.WETBKDEP) then !scavdep output + if (DRYBKDEP.or.WETBKDEP) then !scavdep output if (DRYBKDEP) & open(unitoutgrid,file=path(2)(1:length(2))//'grid_drydep_nest_'//adate// & atime//'_'//anspec,form='unformatted') @@ -1503,1264 +1625,67 @@ subroutine concoutput_nest(itime,outnum) open(unitoutgrid,file=path(2)(1:length(2))//'grid_wetdep_nest_'//adate// & atime//'_'//anspec,form='unformatted') write(unitoutgrid) itime - else - if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then - if (ldirect.eq.1) then - open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_nest_' & - //adate// & - atime//'_'//anspec,form='unformatted') - else - open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_nest_' & - //adate// & - atime//'_'//anspec,form='unformatted') - endif - write(unitoutgrid) itime - endif - endif - - if ((iout.eq.2).or.(iout.eq.3)) then ! mixing ratio - open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_nest_' & - //adate// & - atime//'_'//anspec,form='unformatted') - - write(unitoutgridppt) itime - endif + else + if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then + if (ldirect.eq.1) then + open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_nest_' & + //adate// & + atime//'_'//anspec,form='unformatted') + else + open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_nest_' & + //adate// & + atime//'_'//anspec,form='unformatted') + endif + write(unitoutgrid) itime + endif + endif + if ((iout.eq.2).or.(iout.eq.3)) then ! mixing ratio + open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_nest_' & + //adate// & + atime//'_'//anspec,form='unformatted') - do kp=1,maxpointspec_act - do nage=1,nageclass + write(unitoutgridppt) itime + endif +!$OMP END SINGLE - do jy=0,numygridn-1 - do ix=0,numxgridn-1 + do kp=1,maxpointspec_act + do nage=1,nageclass +!$OMP DO + do jy=0,numygridn-1 + do ix=0,numxgridn-1 ! WET DEPOSITION - if ((WETDEP).and.(ldirect.gt.0)) then - do l=1,nclassunc - auxgrid(l)=wetgriduncn(ix,jy,ks,kp,l,nage) - end do - call mean(auxgrid,wetgrid(ix,jy), & - wetgridsigma(ix,jy),nclassunc) + if ((WETDEP).and.(ldirect.gt.0)) then + do l=1,nclassunc + auxgrid(l)=wetgriduncn(ix,jy,ks,kp,l,nage) + end do + call mean(auxgrid,wetgrid(ix,jy), & + wetgridsigma(ix,jy),nclassunc) ! Multiply by number of classes to get total concentration - wetgrid(ix,jy)=wetgrid(ix,jy) & - *nclassunc + wetgrid(ix,jy)=wetgrid(ix,jy) & + *nclassunc ! Calculate standard deviation of the mean - wetgridsigma(ix,jy)= & - wetgridsigma(ix,jy)* & - sqrt(real(nclassunc)) - endif + wetgridsigma(ix,jy)= & + wetgridsigma(ix,jy)* & + sqrt(real(nclassunc)) + endif ! DRY DEPOSITION - if ((DRYDEP).and.(ldirect.gt.0)) then - do l=1,nclassunc - auxgrid(l)=drygriduncn(ix,jy,ks,kp,l,nage) - end do - call mean(auxgrid,drygrid(ix,jy), & - drygridsigma(ix,jy),nclassunc) - ! Multiply by number of classes to get total concentration - drygrid(ix,jy)=drygrid(ix,jy)* & - nclassunc - ! Calculate standard deviation of the mean - drygridsigma(ix,jy)= & - drygridsigma(ix,jy)* & - sqrt(real(nclassunc)) - endif - - ! CONCENTRATION OR MIXING RATIO - do kz=1,numzgrid - do l=1,nclassunc - auxgrid(l)=griduncn(ix,jy,kz,ks,kp,l,nage) - end do - call mean(auxgrid,grid(ix,jy,kz), & - gridsigma(ix,jy,kz),nclassunc) - ! Multiply by number of classes to get total concentration - grid(ix,jy,kz)= & - grid(ix,jy,kz)*nclassunc - ! Calculate standard deviation of the mean - gridsigma(ix,jy,kz)= & - gridsigma(ix,jy,kz)* & - sqrt(real(nclassunc)) - end do - end do - end do - - - !******************************************************************* - ! Generate output: may be in concentration (ng/m3) or in mixing - ! ratio (ppt) or both - ! Output the position and the values alternated multiplied by - ! 1 or -1, first line is number of values, number of positions - ! For backward simulations, the unit is seconds, stored in grid_time - !******************************************************************* - - ! Concentration output - !********************* - if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then - - ! Wet deposition - sp_count_i=0 - sp_count_r=0 - sp_fact=-1. - sp_zer=.true. - if ((ldirect.eq.1).and.(WETDEP)) then - do jy=0,numygridn-1 - do ix=0,numxgridn-1 - !oncentraion greater zero - if (wetgrid(ix,jy).gt.smallnum) then - if (sp_zer.eqv..true.) then ! first non zero value - sp_count_i=sp_count_i+1 - sparse_dump_i(sp_count_i)=ix+jy*numxgridn - sp_zer=.false. - sp_fact=sp_fact*(-1.) - endif - sp_count_r=sp_count_r+1 - sparse_dump_r(sp_count_r)= & - sp_fact*1.e12*real(wetgrid(ix,jy))/arean(ix,jy) - ! sparse_dump_u(sp_count_r)= - !+ 1.e12*wetgridsigma(ix,jy,ks,kp,nage)/area(ix,jy) - else ! concentration is zero - sp_zer=.true. - endif - end do - end do - else - sp_count_i=0 - sp_count_r=0 - endif - write(unitoutgrid) sp_count_i - write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i) - write(unitoutgrid) sp_count_r - write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r) - ! write(unitoutgrid) sp_count_u - ! write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r) - - ! Dry deposition - sp_count_i=0 - sp_count_r=0 - sp_fact=-1. - sp_zer=.true. - if ((ldirect.eq.1).and.(DRYDEP)) then - do jy=0,numygridn-1 - do ix=0,numxgridn-1 - if (drygrid(ix,jy).gt.smallnum) then - if (sp_zer.eqv..true.) then ! first non zero value - sp_count_i=sp_count_i+1 - sparse_dump_i(sp_count_i)=ix+jy*numxgridn - sp_zer=.false. - sp_fact=sp_fact*(-1.) - endif - sp_count_r=sp_count_r+1 - sparse_dump_r(sp_count_r)= & - sp_fact* & - 1.e12*real(drygrid(ix,jy))/arean(ix,jy) - ! sparse_dump_u(sp_count_r)= - !+ 1.e12*drygridsigma(ix,jy,ks,kp,nage)/area(ix,jy) - else ! concentration is zero - sp_zer=.true. - endif - end do - end do - else - sp_count_i=0 - sp_count_r=0 - endif - write(unitoutgrid) sp_count_i - write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i) - write(unitoutgrid) sp_count_r - write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r) - ! write(*,*) sp_count_u - ! write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r) - - - - ! Concentrations - sp_count_i=0 - sp_count_r=0 - sp_fact=-1. - sp_zer=.true. - do kz=1,numzgrid - do jy=0,numygridn-1 - do ix=0,numxgridn-1 - if (grid(ix,jy,kz).gt.smallnum) then - if (sp_zer.eqv..true.) then ! first non zero value - sp_count_i=sp_count_i+1 - sparse_dump_i(sp_count_i)= & - ix+jy*numxgridn+kz*numxgridn*numygridn - sp_zer=.false. - sp_fact=sp_fact*(-1.) - endif - sp_count_r=sp_count_r+1 - sparse_dump_r(sp_count_r)= & - sp_fact* & - grid(ix,jy,kz)* & - factor3d(ix,jy,kz)/tot_mu(ks,kp) - ! if ((factor(ix,jy,kz)/tot_mu(ks,kp)).eq.0) - ! + write (*,*) factor(ix,jy,kz),tot_mu(ks,kp),ks,kp - ! sparse_dump_u(sp_count_r)= - !+ ,gridsigma(ix,jy,kz,ks,kp,nage)* - !+ factor(ix,jy,kz)/tot_mu(ks,kp) - else ! concentration is zero - sp_zer=.true. - endif - end do - end do - end do - write(unitoutgrid) sp_count_i - write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i) - write(unitoutgrid) sp_count_r - write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r) - ! write(unitoutgrid) sp_count_u - ! write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r) - - - - endif ! concentration output - - ! Mixing ratio output - !******************** - - if ((iout.eq.2).or.(iout.eq.3)) then ! mixing ratio - - ! Wet deposition - sp_count_i=0 - sp_count_r=0 - sp_fact=-1. - sp_zer=.true. - if ((ldirect.eq.1).and.(WETDEP)) then - do jy=0,numygridn-1 - do ix=0,numxgridn-1 - if (wetgrid(ix,jy).gt.smallnum) then - if (sp_zer.eqv..true.) then ! first non zero value - sp_count_i=sp_count_i+1 - sparse_dump_i(sp_count_i)= & - ix+jy*numxgridn - sp_zer=.false. - sp_fact=sp_fact*(-1.) - endif - sp_count_r=sp_count_r+1 - sparse_dump_r(sp_count_r)= & - sp_fact* & - 1.e12*real(wetgrid(ix,jy))/arean(ix,jy) - ! sparse_dump_u(sp_count_r)= - ! + ,1.e12*wetgridsigma(ix,jy,ks,kp,nage)/area(ix,jy) - else ! concentration is zero - sp_zer=.true. - endif - end do - end do - else - sp_count_i=0 - sp_count_r=0 - endif - write(unitoutgridppt) sp_count_i - write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i) - write(unitoutgridppt) sp_count_r - write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r) - ! write(unitoutgridppt) sp_count_u - ! write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r) - - - ! Dry deposition - sp_count_i=0 - sp_count_r=0 - sp_fact=-1. - sp_zer=.true. - if ((ldirect.eq.1).and.(DRYDEP)) then - do jy=0,numygridn-1 - do ix=0,numxgridn-1 - if (drygrid(ix,jy).gt.smallnum) then - if (sp_zer.eqv..true.) then ! first non zero value - sp_count_i=sp_count_i+1 - sparse_dump_i(sp_count_i)= & - ix+jy*numxgridn - sp_zer=.false. - sp_fact=sp_fact*(-1) - endif - sp_count_r=sp_count_r+1 - sparse_dump_r(sp_count_r)= & - sp_fact* & - 1.e12*real(drygrid(ix,jy))/arean(ix,jy) - ! sparse_dump_u(sp_count_r)= - ! + ,1.e12*drygridsigma(ix,jy,ks,kp,nage)/area(ix,jy) - else ! concentration is zero - sp_zer=.true. - endif - end do - end do - else - sp_count_i=0 - sp_count_r=0 - endif - write(unitoutgridppt) sp_count_i - write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i) - write(unitoutgridppt) sp_count_r - write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r) - ! write(unitoutgridppt) sp_count_u - ! write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r) - - - ! Mixing ratios - sp_count_i=0 - sp_count_r=0 - sp_fact=-1. - sp_zer=.true. - do kz=1,numzgrid - do jy=0,numygridn-1 - do ix=0,numxgridn-1 - if (grid(ix,jy,kz).gt.smallnum) then - if (sp_zer.eqv..true.) then ! first non zero value - sp_count_i=sp_count_i+1 - sparse_dump_i(sp_count_i)= & - ix+jy*numxgridn+kz*numxgridn*numygridn - sp_zer=.false. - sp_fact=sp_fact*(-1.) - endif - sp_count_r=sp_count_r+1 - sparse_dump_r(sp_count_r)= & - sp_fact* & - 1.e12*grid(ix,jy,kz) & - /volumen(ix,jy,kz)/outnum* & - weightair/weightmolar(ks)/densityoutgrid(ix,jy,kz) - ! sparse_dump_u(sp_count_r)= - !+ ,1.e12*gridsigma(ix,jy,kz,ks,kp,nage)/volume(ix,jy,kz)/ - !+ outnum*weightair/weightmolar(ks)/ - !+ densityoutgrid(ix,jy,kz) - else ! concentration is zero - sp_zer=.true. - endif - end do - end do - end do - write(unitoutgridppt) sp_count_i - write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i) - write(unitoutgridppt) sp_count_r - write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r) - ! write(unitoutgridppt) sp_count_u - ! write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r) - endif ! output for ppt - - end do - end do - - close(unitoutgridppt) - close(unitoutgrid) - - end do - - ! RLT Aug 2017 - ! Write out conversion factor for dry air - inquire(file=path(2)(1:length(2))//'factor_drygrid_nest',exist=lexist) - if (lexist) then - ! open and append - open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid_nest',form='unformatted',& - status='old',action='write',access='append') - else - ! create new - open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid_nest',form='unformatted',& - status='new',action='write') - endif - sp_count_i=0 - sp_count_r=0 - sp_fact=-1. - sp_zer=.true. - do kz=1,numzgrid - do jy=0,numygridn-1 - do ix=0,numxgridn-1 - if (factor_drygrid(ix,jy,kz).gt.(1.+smallnum).or.factor_drygrid(ix,jy,kz).lt.(1.-smallnum)) then - if (sp_zer.eqv..true.) then ! first value not equal to one - sp_count_i=sp_count_i+1 - sparse_dump_i(sp_count_i)= & - ix+jy*numxgridn+kz*numxgridn*numygridn - sp_zer=.false. - sp_fact=sp_fact*(-1.) - endif - sp_count_r=sp_count_r+1 - sparse_dump_r(sp_count_r)= & - sp_fact*factor_drygrid(ix,jy,kz) - else ! factor is one - sp_zer=.true. - endif - end do - end do - end do - write(unitoutfactor) sp_count_i - write(unitoutfactor) (sparse_dump_i(i),i=1,sp_count_i) - write(unitoutfactor) sp_count_r - write(unitoutfactor) (sparse_dump_r(i),i=1,sp_count_r) - close(unitoutfactor) - - creceptor(:,:)=0. - griduncn(:,:,:,:,:,:,:)=0. -end subroutine concoutput_nest - -subroutine concoutput_inversion(itime,outnum,gridtotalunc,wetgridtotalunc, & - drygridtotalunc) - ! i i o o - ! o - !***************************************************************************** - ! * - ! Output of the concentration grid and the receptor concentrations. * - ! * - ! Author: A. Stohl * - ! * - ! 24 May 1995 * - ! * - ! 13 April 1999, Major update: if output size is smaller, dump output * - ! in sparse matrix format; additional output of * - ! uncertainty * - ! * - ! 05 April 2000, Major update: output of age classes; output for backward* - ! runs is time spent in grid cell times total mass of * - ! species. * - ! * - ! 17 February 2002, Appropriate dimensions for backward and forward runs * - ! are now specified in file par_mod * - ! * - ! June 2006, write grid in sparse matrix with a single write command * - ! in order to save disk space * - ! * - ! 2008 new sparse matrix format * - ! - ! January 2017, Separate files by release but include all timesteps - ! * - !***************************************************************************** - ! * - ! Variables: * - ! outnum number of samples * - ! ncells number of cells with non-zero concentrations * - ! sparse .true. if in sparse matrix format, else .false. * - ! tot_mu 1 for forward, initial mass mixing ration for backw. runs * - ! * - !***************************************************************************** - - use unc_mod - use mean_mod - - implicit none - - real(kind=dp) :: jul - integer :: itime,i,ix,jy,kz,ks,kp,l,iix,jjy,kzz,nage,jjjjmmdd,ihmmss - integer :: sp_count_i,sp_count_r - real :: sp_fact - real :: outnum,densityoutrecept(numreceptor),xl,yl - ! RLT - real :: densitydryrecept(numreceptor) - real :: factor_dryrecept(numreceptor) - - - real(dep_prec) :: auxgrid(nclassunc) - real(sp) :: gridtotal,gridsigmatotal,gridtotalunc - real(dep_prec) :: wetgridtotal,wetgridsigmatotal,wetgridtotalunc - real(dep_prec) :: drygridtotal,drygridsigmatotal,drygridtotalunc - real :: halfheight,dz,dz1,dz2,tot_mu(maxspec,maxpointspec_act) - real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled - real,parameter :: weightair=28.97 - logical :: sp_zer - character :: adate*8,atime*6 - character(len=3) :: anspec - logical :: lexist - character :: areldate*8,areltime*6 - logical,save :: lstart=.true. - logical,save,allocatable,dimension(:) :: lstartrel - integer :: ierr - character(LEN=100) :: dates_char - integer, parameter :: unitrelnames=654 - - - if(lstart) then - allocate(lstartrel(maxpointspec_act)) - lstartrel(:)=.true. - endif - print*, 'lstartrel = ',lstartrel - - if (verbosity.eq.1) then - print*,'inside concoutput_inversion ' - CALL SYSTEM_CLOCK(count_clock) - WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0 - endif - - ! Determine current calendar date - !********************************************************** - - jul=bdate+real(itime,kind=dp)/86400._dp - call caldate(jul,jjjjmmdd,ihmmss) - write(adate,'(i8.8)') jjjjmmdd - write(atime,'(i6.6)') ihmmss - - - ! Prepare output files for dates - !********************************************************** - - ! Overwrite existing dates file on first call, later append to it - ! If 'dates' file exists in output directory, copy to new file dates.old - inquire(file=path(2)(1:length(2))//'dates', exist=lexist) - if (lexist.and.lstart) then - ! copy contents of existing dates file to dates.old - print*, 'warning: replacing old dates file' - open(unit=unitdates, file=path(2)(1:length(2))//'dates',form='formatted', & - &access='sequential', status='old', action='read', iostat=ierr) - open(unit=unittmp, file=path(2)(1:length(2))//'dates.old', access='sequential', & - &status='replace', action='write', form='formatted', iostat=ierr) - do while (.true.) - read(unitdates, '(a)', iostat=ierr) dates_char - if (ierr.ne.0) exit - write(unit=unittmp, fmt='(a)', iostat=ierr, advance='yes') trim(dates_char) - end do - close(unit=unitdates) - close(unit=unittmp) - ! create new dates file - open(unit=unitdates, file=path(2)(1:length(2))//'dates',form='formatted', & - &access='sequential', status='replace', iostat=ierr) - close(unit=unitdates) - endif - - open(unitdates,file=path(2)(1:length(2))//'dates', ACCESS='APPEND') - write(unitdates,'(a)') adate//atime - close(unitdates) - - !CGZ: Make a filename with names of releases - if (lstart) then - open(unit=unitrelnames, file=path(2)(1:length(2))//'releases_out',form='formatted', & - &access='sequential', status='replace', iostat=ierr) - close(unitrelnames) - endif - - print*, 'after creating dates files: lstart = ',lstart - ! print*, 'outnum:',outnum - ! print*, 'datetime:',adate//atime - - - ! For forward simulations, output fields have dimension MAXSPEC, - ! for backward simulations, output fields have dimension MAXPOINT. - ! Thus, make loops either about nspec, or about numpoint - !***************************************************************** - - - if (ldirect.eq.1) then - do ks=1,nspec - do kp=1,maxpointspec_act - tot_mu(ks,kp)=1 - end do - end do - else - do ks=1,nspec - do kp=1,maxpointspec_act - tot_mu(ks,kp)=xmass(kp,ks) - end do - end do - endif - - - if (verbosity.eq.1) then - print*,'concoutput_inversion 2' - CALL SYSTEM_CLOCK(count_clock) - WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0 - endif - - !******************************************************************* - ! Compute air density: sufficiently accurate to take it - ! from coarse grid at some time - ! Determine center altitude of output layer, and interpolate density - ! data to that altitude - !******************************************************************* - - do kz=1,numzgrid - if (kz.eq.1) then - halfheight=outheight(1)/2. - else - halfheight=(outheight(kz)+outheight(kz-1))/2. - endif - do kzz=2,nz - if ((height(kzz-1).lt.halfheight).and. & - (height(kzz).gt.halfheight)) goto 46 - end do -46 kzz=max(min(kzz,nz),2) - dz1=halfheight-height(kzz-1) - dz2=height(kzz)-halfheight - dz=dz1+dz2 - do jy=0,numygrid-1 - do ix=0,numxgrid-1 - xl=outlon0+real(ix)*dxout - yl=outlat0+real(jy)*dyout - xl=(xl-xlon0)/dx - yl=(yl-ylat0)/dy - iix=max(min(nint(xl),nxmin1),0) - jjy=max(min(nint(yl),nymin1),0) - densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,2)*dz1+ & - rho(iix,jjy,kzz-1,2)*dz2)/dz - ! RLT - densitydrygrid(ix,jy,kz)=(rho_dry(iix,jjy,kzz,2)*dz1+ & - rho_dry(iix,jjy,kzz-1,2)*dz2)/dz - end do - end do - end do - - do i=1,numreceptor - xl=xreceptor(i) - yl=yreceptor(i) - iix=max(min(nint(xl),nxmin1),0) - jjy=max(min(nint(yl),nymin1),0) - densityoutrecept(i)=rho(iix,jjy,1,2) - ! RLT - densitydryrecept(i)=rho_dry(iix,jjy,1,2) - end do - - ! RLT - ! conversion factor for output relative to dry air - factor_drygrid=densityoutgrid/densitydrygrid - factor_dryrecept=densityoutrecept/densitydryrecept - - ! Output is different for forward and backward simulations - do kz=1,numzgrid - do jy=0,numygrid-1 - do ix=0,numxgrid-1 - if (ldirect.eq.1) then - factor3d(ix,jy,kz)=1.e12/volume(ix,jy,kz)/outnum - else - factor3d(ix,jy,kz)=real(abs(loutaver))/outnum - endif - end do - end do - end do - - !********************************************************************* - ! Determine the standard deviation of the mean concentration or mixing - ! ratio (uncertainty of the output) and the dry and wet deposition - !********************************************************************* - - if (verbosity.eq.1) then - print*,'concoutput_inversion 3 (sd)' - CALL SYSTEM_CLOCK(count_clock) - WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0 - endif - gridtotal=0. - gridsigmatotal=0. - gridtotalunc=0. - wetgridtotal=0. - wetgridsigmatotal=0. - wetgridtotalunc=0. - drygridtotal=0. - drygridsigmatotal=0. - drygridtotalunc=0. - - do ks=1,nspec - - write(anspec,'(i3.3)') ks - - ! loop over releases - do kp=1,maxpointspec_act - - print*, 'itime = ',itime - !print*, 'lage(1) = ',lage(1) - print*, 'ireleasestart(kp) = ',ireleasestart(kp) - print*, 'ireleaseend(kp) = ',ireleaseend(kp) - - ! check itime is within release and backward trajectory length - if (nageclass.eq.1) then - if ((itime.gt.ireleaseend(kp)).or.(itime.lt.(ireleasestart(kp)-lage(1)))) then - go to 10 - endif - endif - - ! calculate date of release for filename - jul=bdate+real(ireleasestart(kp),kind=dp)/86400._dp ! this is the current day - call caldate(jul,jjjjmmdd,ihmmss) - write(areldate,'(i8.8)') jjjjmmdd - write(areltime,'(i6.6)') ihmmss - print*, 'areldate/areltime = ',areldate//areltime - - ! calculate date of field - jul=bdate+real(itime,kind=dp)/86400._dp - call caldate(jul,jjjjmmdd,ihmmss) - write(adate,'(i8.8)') jjjjmmdd - write(atime,'(i6.6)') ihmmss - - if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then - if (ldirect.eq.1) then - ! concentrations - inquire(file=path(2)(1:length(2))//'grid_conc_'//areldate// & - areltime//'_'//anspec,exist=lexist) - if(lexist.and..not.lstartrel(kp)) then - ! open and append to existing file - open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_'//areldate// & - areltime//'_'//anspec,form='unformatted',status='old',action='write',access='append') - else - ! open new file - open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_'//areldate// & - areltime//'_'//anspec,form='unformatted',status='replace',action='write') - endif - else - ! residence times - inquire(file=path(2)(1:length(2))//'grid_time_'//areldate// & - areltime//'_'//anspec,exist=lexist) - if(lexist.and..not.lstartrel(kp)) then - ! open and append to existing file - open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_'//areldate// & - areltime//'_'//anspec,form='unformatted',status='old',action='write',access='append') - else - ! open new file - open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_'//areldate// & - areltime//'_'//anspec,form='unformatted',status='replace',action='write') - ! add part of the filename to a file (similar to dates) for easier post-processing - open(unit=unitrelnames, file=path(2)(1:length(2))//'releases_out',form='formatted', & - & access='APPEND', iostat=ierr) - write(unitrelnames,'(a)') areldate//areltime//'_'//anspec - close(unitrelnames) - endif - endif - write(unitoutgrid) jjjjmmdd - write(unitoutgrid) ihmmss - endif - - if ((iout.eq.2).or.(iout.eq.3)) then - ! mixing ratio - inquire(file=path(2)(1:length(2))//'grid_pptv_'//areldate// & - areltime//'_'//anspec,exist=lexist) - if(lexist.and..not.lstartrel(kp)) then - ! open and append to existing file - open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_'//areldate// & - areltime//'_'//anspec,form='unformatted',status='old',action='write',access='append') - else - ! open new file - open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_'//areldate// & - areltime//'_'//anspec,form='unformatted',status='replace',action='write') - endif - write(unitoutgridppt) jjjjmmdd - write(unitoutgridppt) ihmmss - endif - - lstartrel(kp)=.false. - - do nage=1,nageclass - - do jy=0,numygrid-1 - do ix=0,numxgrid-1 - - ! CONCENTRATION OR MIXING RATIO - do kz=1,numzgrid - do l=1,nclassunc - auxgrid(l)=gridunc(ix,jy,kz,ks,kp,l,nage) - end do - call mean(auxgrid,grid(ix,jy,kz), & - gridsigma(ix,jy,kz),nclassunc) - ! Multiply by number of classes to get total concentration - grid(ix,jy,kz)= & - grid(ix,jy,kz)*nclassunc - gridtotal=gridtotal+grid(ix,jy,kz) - ! Calculate standard deviation of the mean - gridsigma(ix,jy,kz)= & - gridsigma(ix,jy,kz)* & - sqrt(real(nclassunc)) - gridsigmatotal=gridsigmatotal+ & - gridsigma(ix,jy,kz) - end do - end do - end do - - - !******************************************************************* - ! Generate output: may be in concentration (ng/m3) or in mixing - ! ratio (ppt) or both - ! Output the position and the values alternated multiplied by - ! 1 or -1, first line is number of values, number of positions - ! For backward simulations, the unit is seconds, stored in grid_time - !******************************************************************* - - if (verbosity.eq.1) then - print*,'concoutput_inversion 4 (output)' - CALL SYSTEM_CLOCK(count_clock) - WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0 - endif - - ! Concentration output - !********************* - - if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then - - if (verbosity.eq.1) then - print*,'concoutput_inversion (Wet deposition)' - CALL SYSTEM_CLOCK(count_clock) - WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0 - endif - - if (verbosity.eq.1) then - print*,'concoutput_inversion (Concentrations)' - CALL SYSTEM_CLOCK(count_clock) - WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0 - endif - - ! Concentrations - - ! sfc_only write only 1st layer - - sp_count_i=0 - sp_count_r=0 - sp_fact=-1. - sp_zer=.true. - do kz=1,1 - do jy=0,numygrid-1 - do ix=0,numxgrid-1 - if (grid(ix,jy,kz).gt.smallnum) then - if (sp_zer.eqv..true.) then ! first non zero value - sp_count_i=sp_count_i+1 - sparse_dump_i(sp_count_i)= & - ix+jy*numxgrid+kz*numxgrid*numygrid - sp_zer=.false. - sp_fact=sp_fact*(-1.) - endif - sp_count_r=sp_count_r+1 - sparse_dump_r(sp_count_r)= & - sp_fact* & - grid(ix,jy,kz)* & - factor3d(ix,jy,kz)/tot_mu(ks,kp) - sparse_dump_u(sp_count_r)= & - gridsigma(ix,jy,kz)* & - factor3d(ix,jy,kz)/tot_mu(ks,kp) - - else ! concentration is zero - sp_zer=.true. - endif - end do - end do - end do - write(unitoutgrid) sp_count_i - write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i) - write(unitoutgrid) sp_count_r - write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r) - - endif ! concentration output - - ! Mixing ratio output - !******************** - - if ((iout.eq.2).or.(iout.eq.3)) then ! mixing ratio - - ! Mixing ratios - - ! sfc_only write only 1st layer - - sp_count_i=0 - sp_count_r=0 - sp_fact=-1. - sp_zer=.true. - do kz=1,1 - do jy=0,numygrid-1 - do ix=0,numxgrid-1 - if (grid(ix,jy,kz).gt.smallnum) then - if (sp_zer.eqv..true.) then ! first non zero value - sp_count_i=sp_count_i+1 - sparse_dump_i(sp_count_i)= & - ix+jy*numxgrid+kz*numxgrid*numygrid - sp_zer=.false. - sp_fact=sp_fact*(-1.) - endif - sp_count_r=sp_count_r+1 - sparse_dump_r(sp_count_r)= & - sp_fact* & - 1.e12*grid(ix,jy,kz) & - /volume(ix,jy,kz)/outnum* & - weightair/weightmolar(ks)/densityoutgrid(ix,jy,kz) - sparse_dump_u(sp_count_r)= & - 1.e12*gridsigma(ix,jy,kz)/volume(ix,jy,kz)/ & - outnum*weightair/weightmolar(ks)/ & - densityoutgrid(ix,jy,kz) - else ! concentration is zero - sp_zer=.true. - endif - end do - end do - end do - write(unitoutgridppt) sp_count_i - write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i) - write(unitoutgridppt) sp_count_r - write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r) - - endif ! output for ppt - - end do ! nageclass - - close(unitoutgridppt) - close(unitoutgrid) - - ! itime is outside range -10 continue - - end do ! maxpointspec_act - - end do ! nspec - - ! RLT Aug 2017 - ! Write out conversion factor for dry air - inquire(file=path(2)(1:length(2))//'factor_drygrid',exist=lexist) - if (lexist.and..not.lstart) then - ! open and append - open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid',form='unformatted',& - status='old',action='write',access='append') - else - ! create new - open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid',form='unformatted',& - status='replace',action='write') - endif - sp_count_i=0 - sp_count_r=0 - sp_fact=-1. - sp_zer=.true. - do kz=1,1 - do jy=0,numygrid-1 - do ix=0,numxgrid-1 - if (factor_drygrid(ix,jy,kz).gt.(1.+smallnum).or.factor_drygrid(ix,jy,kz).lt.(1.-smallnum)) then - if (sp_zer.eqv..true.) then ! first value not equal to one - sp_count_i=sp_count_i+1 - sparse_dump_i(sp_count_i)= & - ix+jy*numxgrid+kz*numxgrid*numygrid - sp_zer=.false. - sp_fact=sp_fact*(-1.) - endif - sp_count_r=sp_count_r+1 - sparse_dump_r(sp_count_r)= & - sp_fact*factor_drygrid(ix,jy,kz) - else ! factor is one - sp_zer=.true. - endif - end do - end do - end do - write(unitoutfactor) sp_count_i - write(unitoutfactor) (sparse_dump_i(i),i=1,sp_count_i) - write(unitoutfactor) sp_count_r - write(unitoutfactor) (sparse_dump_r(i),i=1,sp_count_r) - close(unitoutfactor) - - - if (gridtotal.gt.0.) gridtotalunc=gridsigmatotal/gridtotal - - ! Dump of receptor concentrations - - if (numreceptor.gt.0 .and. (iout.eq.2 .or. iout.eq.3) ) then - write(unitoutreceptppt) itime - do ks=1,nspec - write(unitoutreceptppt) (1.e12*creceptor(i,ks)/outnum* & - weightair/weightmolar(ks)/densityoutrecept(i),i=1,numreceptor) - end do - endif - - ! Dump of receptor concentrations - - if (numreceptor.gt.0) then - write(unitoutrecept) itime - do ks=1,nspec - write(unitoutrecept) (1.e12*creceptor(i,ks)/outnum, & - i=1,numreceptor) - end do - endif - - ! RLT Aug 2017 - ! Write out conversion factor for dry air - if (numreceptor.gt.0) then - inquire(file=path(2)(1:length(2))//'factor_dryreceptor',exist=lexist) - if (lexist.and..not.lstart) then - ! open and append - open(unitoutfactor,file=path(2)(1:length(2))//'factor_dryreceptor',form='unformatted',& - status='old',action='write',access='append') - else - ! create new - open(unitoutfactor,file=path(2)(1:length(2))//'factor_dryreceptor',form='unformatted',& - status='replace',action='write') - endif - write(unitoutfactor) itime - write(unitoutfactor) (factor_dryrecept(i),i=1,numreceptor) - close(unitoutfactor) - endif - - ! reset lstart - if (lstart) then - lstart=.false. - endif - print*, 'after writing output files: lstart = ',lstart - - - ! Reinitialization of grid - !************************* - - do ks=1,nspec - do kp=1,maxpointspec_act - do i=1,numreceptor - creceptor(i,ks)=0. - end do - do jy=0,numygrid-1 - do ix=0,numxgrid-1 - do l=1,nclassunc - do nage=1,nageclass - do kz=1,numzgrid - gridunc(ix,jy,kz,ks,kp,l,nage)=0. - end do - end do - end do - end do - end do - end do - end do -end subroutine concoutput_inversion - -subroutine concoutput_inversion_nest(itime,outnum) - ! i i - !***************************************************************************** - ! * - ! Output of the concentration grid and the receptor concentrations. * - ! * - ! Author: A. Stohl * - ! * - ! 24 May 1995 * - ! * - ! 13 April 1999, Major update: if output size is smaller, dump output * - ! in sparse matrix format; additional output of * - ! uncertainty * - ! * - ! 05 April 2000, Major update: output of age classes; output for backward* - ! runs is time spent in grid cell times total mass of * - ! species. * - ! * - ! 17 February 2002, Appropriate dimensions for backward and forward runs * - ! are now specified in file par_mod * - ! * - ! June 2006, write grid in sparse matrix with a single write command * - ! in order to save disk space * - ! * - ! 2008 new sparse matrix format * - ! - ! January 2017, Separate files by release but include all timesteps * - ! * - !***************************************************************************** - ! * - ! Variables: * - ! outnum number of samples * - ! ncells number of cells with non-zero concentrations * - ! sparse .true. if in sparse matrix format, else .false. * - ! tot_mu 1 for forward, initial mass mixing ration for backw. runs * - ! * - !***************************************************************************** - - use unc_mod - use mean_mod - - implicit none - - real(kind=dp) :: jul - integer :: itime,i,ix,jy,kz,ks,kp,l,iix,jjy,kzz,nage,jjjjmmdd,ihmmss - integer :: sp_count_i,sp_count_r - real :: sp_fact - real :: outnum,densityoutrecept(numreceptor),xl,yl - ! RLT - real :: densitydryrecept(numreceptor) - real :: factor_dryrecept(numreceptor) - - real(dep_prec) :: auxgrid(nclassunc) - real :: halfheight,dz,dz1,dz2,tot_mu(maxspec,maxpointspec_act) - real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled - real,parameter :: weightair=28.97 - logical :: sp_zer - logical,save :: lnstart=.true. - logical,save,allocatable,dimension(:) :: lnstartrel - character :: adate*8,atime*6 - character(len=3) :: anspec - logical :: lexist - character :: areldate*8,areltime*6 - - if(lnstart) then - allocate(lnstartrel(maxpointspec_act)) - lnstartrel(:)=.true. - endif - print*, 'lnstartrel = ',lnstartrel - - ! Determine current calendar date, needed for the file name - !********************************************************** - - jul=bdate+real(itime,kind=dp)/86400._dp - call caldate(jul,jjjjmmdd,ihmmss) - write(adate,'(i8.8)') jjjjmmdd - write(atime,'(i6.6)') ihmmss - - print*, 'outnum:',outnum - print*, 'datetime:',adate//atime - - ! For forward simulations, output fields have dimension MAXSPEC, - ! for backward simulations, output fields have dimension MAXPOINT. - ! Thus, make loops either about nspec, or about numpoint - !***************************************************************** - - - if (ldirect.eq.1) then - do ks=1,nspec - do kp=1,maxpointspec_act - tot_mu(ks,kp)=1 - end do - end do - else - do ks=1,nspec - do kp=1,maxpointspec_act - tot_mu(ks,kp)=xmass(kp,ks) - end do - end do - endif - - - !******************************************************************* - ! Compute air density: sufficiently accurate to take it - ! from coarse grid at some time - ! Determine center altitude of output layer, and interpolate density - ! data to that altitude - !******************************************************************* - - do kz=1,numzgrid - if (kz.eq.1) then - halfheight=outheight(1)/2. - else - halfheight=(outheight(kz)+outheight(kz-1))/2. - endif - do kzz=2,nz - if ((height(kzz-1).lt.halfheight).and. & - (height(kzz).gt.halfheight)) goto 46 - end do -46 kzz=max(min(kzz,nz),2) - dz1=halfheight-height(kzz-1) - dz2=height(kzz)-halfheight - dz=dz1+dz2 - do jy=0,numygridn-1 - do ix=0,numxgridn-1 - xl=outlon0n+real(ix)*dxoutn - yl=outlat0n+real(jy)*dyoutn - xl=(xl-xlon0)/dx - yl=(yl-ylat0)/dy - iix=max(min(nint(xl),nxmin1),0) - jjy=max(min(nint(yl),nymin1),0) - densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,2)*dz1+ & - rho(iix,jjy,kzz-1,2)*dz2)/dz - ! RLT - densitydrygrid(ix,jy,kz)=(rho_dry(iix,jjy,kzz,2)*dz1+ & - rho_dry(iix,jjy,kzz-1,2)*dz2)/dz - end do - end do - end do - - do i=1,numreceptor - xl=xreceptor(i) - yl=yreceptor(i) - iix=max(min(nint(xl),nxmin1),0) - jjy=max(min(nint(yl),nymin1),0) - densityoutrecept(i)=rho(iix,jjy,1,2) - ! RLT - densitydryrecept(i)=rho_dry(iix,jjy,1,2) - end do - - ! RLT - ! conversion factor for output relative to dry air - factor_drygrid=densityoutgrid/densitydrygrid - factor_dryrecept=densityoutrecept/densitydryrecept - - ! Output is different for forward and backward simulations - do kz=1,numzgrid - do jy=0,numygridn-1 - do ix=0,numxgridn-1 - if (ldirect.eq.1) then - factor3d(ix,jy,kz)=1.e12/volumen(ix,jy,kz)/outnum - else - factor3d(ix,jy,kz)=real(abs(loutaver))/outnum - endif - end do - end do - end do - - !********************************************************************* - ! Determine the standard deviation of the mean concentration or mixing - ! ratio (uncertainty of the output) and the dry and wet deposition - !********************************************************************* - - do ks=1,nspec - - write(anspec,'(i3.3)') ks - - do kp=1,maxpointspec_act - - print*, 'itime = ',itime - print*, 'lage(1) = ',lage(1) - print*, 'ireleasestart(kp) = ',ireleasestart(kp) - print*, 'ireleaseend(kp) = ',ireleaseend(kp) - - ! check itime is within release and backward trajectory length - if (nageclass.eq.1) then - if ((itime.gt.ireleaseend(kp)).or.(itime.lt.(ireleasestart(kp)-lage(1)))) then - go to 10 - endif - endif - - ! calculate date of release - jul=bdate+real(ireleasestart(kp),kind=dp)/86400._dp ! this is the current day - call caldate(jul,jjjjmmdd,ihmmss) - write(areldate,'(i8.8)') jjjjmmdd - write(areltime,'(i6.6)') ihmmss - print*, areldate//areltime - - ! calculate date of field - jul=bdate+real(itime,kind=dp)/86400._dp - call caldate(jul,jjjjmmdd,ihmmss) - write(adate,'(i8.8)') jjjjmmdd - write(atime,'(i6.6)') ihmmss - print*, adate//atime - - if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then - if (ldirect.eq.1) then - ! concentrations - inquire(file=path(2)(1:length(2))//'grid_conc_nest_'//areldate// & - areltime//'_'//anspec,exist=lexist) - if(lexist.and..not.lnstartrel(kp)) then - ! open and append to existing file - open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_nest_'//areldate// & - areltime//'_'//anspec,form='unformatted',status='old',action='write',access='append') - else - ! open new file - open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_nest_'//areldate// & - areltime//'_'//anspec,form='unformatted',status='replace',action='write') - endif - else - ! residence times - inquire(file=path(2)(1:length(2))//'grid_time_nest_'//areldate// & - areltime//'_'//anspec,exist=lexist) - if(lexist.and..not.lnstartrel(kp)) then - ! open and append to existing file - open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_nest_'//areldate// & - areltime//'_'//anspec,form='unformatted',status='old',action='write',access='append') - else - ! open new file - open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_nest_'//areldate// & - areltime//'_'//anspec,form='unformatted',status='replace',action='write') - endif - endif - write(unitoutgrid) jjjjmmdd - write(unitoutgrid) ihmmss - endif - - if ((iout.eq.2).or.(iout.eq.3)) then - ! mixing ratio - inquire(file=path(2)(1:length(2))//'grid_pptv_nest_'//areldate// & - areltime//'_'//anspec,exist=lexist) - if(lexist.and..not.lnstartrel(kp)) then - ! open and append to existing file - open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_nest_'//areldate// & - areltime//'_'//anspec,form='unformatted',status='old',action='write',access='append') - else - ! open new file - open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_nest_'//areldate// & - areltime//'_'//anspec,form='unformatted',status='replace',action='write') - endif - write(unitoutgridppt) jjjjmmdd - write(unitoutgridppt) ihmmss - endif - - lnstartrel(kp)=.false. - - do nage=1,nageclass - - do jy=0,numygridn-1 - do ix=0,numxgridn-1 + if ((DRYDEP).and.(ldirect.gt.0)) then + do l=1,nclassunc + auxgrid(l)=drygriduncn(ix,jy,ks,kp,l,nage) + end do + call mean(auxgrid,drygrid(ix,jy), & + drygridsigma(ix,jy),nclassunc) + ! Multiply by number of classes to get total concentration + drygrid(ix,jy)=drygrid(ix,jy)* & + nclassunc + ! Calculate standard deviation of the mean + drygridsigma(ix,jy)= & + drygridsigma(ix,jy)* & + sqrt(real(nclassunc)) + endif ! CONCENTRATION OR MIXING RATIO do kz=1,numzgrid @@ -2768,7 +1693,7 @@ subroutine concoutput_inversion_nest(itime,outnum) auxgrid(l)=griduncn(ix,jy,kz,ks,kp,l,nage) end do call mean(auxgrid,grid(ix,jy,kz), & - gridsigma(ix,jy,kz),nclassunc) + gridsigma(ix,jy,kz),nclassunc) ! Multiply by number of classes to get total concentration grid(ix,jy,kz)= & grid(ix,jy,kz)*nclassunc @@ -2777,9 +1702,9 @@ subroutine concoutput_inversion_nest(itime,outnum) gridsigma(ix,jy,kz)* & sqrt(real(nclassunc)) end do - end do - end do - + end do ! ix + end do ! jy +!$OMP END DO !******************************************************************* ! Generate output: may be in concentration (ng/m3) or in mixing @@ -2789,20 +1714,87 @@ subroutine concoutput_inversion_nest(itime,outnum) ! For backward simulations, the unit is seconds, stored in grid_time !******************************************************************* +!$OMP BARRIER +!$OMP SINGLE + ! Concentration output !********************* - if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then - ! Concentrations + ! Wet deposition + sp_count_i=0 + sp_count_r=0 + sp_fact=-1. + sp_zer=.true. + if ((ldirect.eq.1).and.(WETDEP)) then + do jy=0,numygridn-1 + do ix=0,numxgridn-1 + !concentration greater zero + if (wetgrid(ix,jy).gt.smallnum) then + if (sp_zer.eqv..true.) then ! first non zero value + sp_count_i=sp_count_i+1 + sparse_dump_i(sp_count_i)=ix+jy*numxgridn + sp_zer=.false. + sp_fact=sp_fact*(-1.) + endif + sp_count_r=sp_count_r+1 + sparse_dump_r(sp_count_r)= & + sp_fact*1.e12*real(wetgrid(ix,jy))/arean(ix,jy) + else ! concentration is zero + sp_zer=.true. + endif + end do + end do + else + sp_count_i=0 + sp_count_r=0 + endif + write(unitoutgrid) sp_count_i + write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i) + write(unitoutgrid) sp_count_r + write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r) - ! sfc_only write only 1st layer + ! Dry deposition + sp_count_i=0 + sp_count_r=0 + sp_fact=-1. + sp_zer=.true. + if ((ldirect.eq.1).and.(DRYDEP)) then + do jy=0,numygridn-1 + do ix=0,numxgridn-1 + if (drygrid(ix,jy).gt.smallnum) then + if (sp_zer.eqv..true.) then ! first non zero value + sp_count_i=sp_count_i+1 + sparse_dump_i(sp_count_i)=ix+jy*numxgridn + sp_zer=.false. + sp_fact=sp_fact*(-1.) + endif + sp_count_r=sp_count_r+1 + sparse_dump_r(sp_count_r)= & + sp_fact* & + 1.e12*real(drygrid(ix,jy))/arean(ix,jy) + else ! concentration is zero + sp_zer=.true. + endif + end do + end do + else + sp_count_i=0 + sp_count_r=0 + endif + write(unitoutgrid) sp_count_i + write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i) + write(unitoutgrid) sp_count_r + write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r) - sp_count_i=0 - sp_count_r=0 - sp_fact=-1. - sp_zer=.true. - do kz=1,1 + ! Concentrations + sp_count_i=0 + sp_count_r=0 + sp_fact=-1. + sp_zer=.true. + numzwrite=numzgrid + if (sfc_only.eq.1) numzwrite=1 + do kz=1,numzwrite do jy=0,numygridn-1 do ix=0,numxgridn-1 if (grid(ix,jy,kz).gt.smallnum) then @@ -2812,45 +1804,106 @@ subroutine concoutput_inversion_nest(itime,outnum) ix+jy*numxgridn+kz*numxgridn*numygridn sp_zer=.false. sp_fact=sp_fact*(-1.) - endif - sp_count_r=sp_count_r+1 - sparse_dump_r(sp_count_r)= & + endif + sp_count_r=sp_count_r+1 + sparse_dump_r(sp_count_r)= & sp_fact* & grid(ix,jy,kz)* & factor3d(ix,jy,kz)/tot_mu(ks,kp) - ! if ((factor(ix,jy,kz)/tot_mu(ks,kp)).eq.0) - ! + write (*,*) factor(ix,jy,kz),tot_mu(ks,kp),ks,kp - sparse_dump_u(sp_count_r)= & - gridsigma(ix,jy,kz)* & - factor3d(ix,jy,kz)/tot_mu(ks,kp) - else ! concentration is zero + else ! concentration is zero sp_zer=.true. - endif + endif end do end do end do - write(unitoutgrid) sp_count_i - write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i) - write(unitoutgrid) sp_count_r - write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r) + write(unitoutgrid) sp_count_i + write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i) + write(unitoutgrid) sp_count_r + write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r) - endif ! concentration output + endif ! concentration output ! Mixing ratio output !******************** - if ((iout.eq.2).or.(iout.eq.3)) then ! mixing ratio - + if ((iout.eq.2).or.(iout.eq.3)) then ! mixing ratio - ! Mixing ratios + ! Wet deposition + sp_count_i=0 + sp_count_r=0 + sp_fact=-1. + sp_zer=.true. + if ((ldirect.eq.1).and.(WETDEP)) then + do jy=0,numygridn-1 + do ix=0,numxgridn-1 + if (wetgrid(ix,jy).gt.smallnum) then + if (sp_zer.eqv..true.) then ! first non zero value + sp_count_i=sp_count_i+1 + sparse_dump_i(sp_count_i)= & + ix+jy*numxgridn + sp_zer=.false. + sp_fact=sp_fact*(-1.) + endif + sp_count_r=sp_count_r+1 + sparse_dump_r(sp_count_r)= & + sp_fact* & + 1.e12*real(wetgrid(ix,jy))/arean(ix,jy) + else ! concentration is zero + sp_zer=.true. + endif + end do + end do + else + sp_count_i=0 + sp_count_r=0 + endif + write(unitoutgridppt) sp_count_i + write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i) + write(unitoutgridppt) sp_count_r + write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r) - ! sfc_only write only 1st layer + ! Dry deposition + sp_count_i=0 + sp_count_r=0 + sp_fact=-1. + sp_zer=.true. + if ((ldirect.eq.1).and.(DRYDEP)) then + do jy=0,numygridn-1 + do ix=0,numxgridn-1 + if (drygrid(ix,jy).gt.smallnum) then + if (sp_zer.eqv..true.) then ! first non zero value + sp_count_i=sp_count_i+1 + sparse_dump_i(sp_count_i)= & + ix+jy*numxgridn + sp_zer=.false. + sp_fact=sp_fact*(-1) + endif + sp_count_r=sp_count_r+1 + sparse_dump_r(sp_count_r)= & + sp_fact* & + 1.e12*real(drygrid(ix,jy))/arean(ix,jy) + else ! concentration is zero + sp_zer=.true. + endif + end do + end do + else + sp_count_i=0 + sp_count_r=0 + endif + write(unitoutgridppt) sp_count_i + write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i) + write(unitoutgridppt) sp_count_r + write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r) - sp_count_i=0 - sp_count_r=0 - sp_fact=-1. - sp_zer=.true. - do kz=1,1 + ! Mixing ratios + sp_count_i=0 + sp_count_r=0 + sp_fact=-1. + sp_zer=.true. + numzwrite=numzgrid + if (sfc_only.eq.1) numzwrite=1 + do kz=1,numzwrite do jy=0,numygridn-1 do ix=0,numxgridn-1 if (grid(ix,jy,kz).gt.smallnum) then @@ -2867,13 +1920,9 @@ subroutine concoutput_inversion_nest(itime,outnum) 1.e12*grid(ix,jy,kz) & /volumen(ix,jy,kz)/outnum* & weightair/weightmolar(ks)/densityoutgrid(ix,jy,kz) - sparse_dump_u(sp_count_r)= & - 1.e12*gridsigma(ix,jy,kz)/volumen(ix,jy,kz)/ & - outnum*weightair/weightmolar(ks)/ & - densityoutgrid(ix,jy,kz) - else ! concentration is zero + else ! concentration is zero sp_zer=.true. - endif + endif end do end do end do @@ -2883,37 +1932,37 @@ subroutine concoutput_inversion_nest(itime,outnum) write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r) endif ! output for ppt - - end do ! nageclass - - close(unitoutgridppt) - close(unitoutgrid) - - ! itime is outside range -10 continue - - end do ! maxpointspec_act +!$OMP END SINGLE +!$OMP BARRIER + end do + end do - end do ! nspec + close(unitoutgridppt) + close(unitoutgrid) + end do +!$OMP END PARALLEL - ! RLT Aug 2017 ! Write out conversion factor for dry air + !**************************************** + inquire(file=path(2)(1:length(2))//'factor_drygrid_nest',exist=lexist) - if (lexist.and..not.lnstart) then + if (lexist) then ! open and append open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid_nest',form='unformatted',& status='old',action='write',access='append') else ! create new open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid_nest',form='unformatted',& - status='replace',action='write') + status='new',action='write') endif sp_count_i=0 sp_count_r=0 sp_fact=-1. sp_zer=.true. - do kz=1,1 + numzwrite=numzgrid + if (sfc_only.eq.1) numzwrite=1 + do kz=1,numzwrite do jy=0,numygridn-1 do ix=0,numxgridn-1 if (factor_drygrid(ix,jy,kz).gt.(1.+smallnum).or.factor_drygrid(ix,jy,kz).lt.(1.-smallnum)) then @@ -2939,41 +1988,21 @@ subroutine concoutput_inversion_nest(itime,outnum) write(unitoutfactor) (sparse_dump_r(i),i=1,sp_count_r) close(unitoutfactor) - ! reset lnstart - if (lnstart) then - lnstart=.false. - endif + griduncn(:,:,:,:,:,:,:)=0. +#ifdef _OPENMP + griduncn_omp(:,:,:,:,:,:,:,:) = 0. +#endif - ! Reinitialization of grid - !************************* +end subroutine concoutput_nest - do ks=1,nspec - do kp=1,maxpointspec_act - do i=1,numreceptor - creceptor(i,ks)=0. - end do - do jy=0,numygridn-1 - do ix=0,numxgridn-1 - do l=1,nclassunc - do nage=1,nageclass - do kz=1,numzgrid - griduncn(ix,jy,kz,ks,kp,l,nage)=0. - end do - end do - end do - end do - end do - end do - end do -end subroutine concoutput_inversion_nest -subroutine concoutput_sfc(itime,outnum,gridtotalunc,wetgridtotalunc, & +subroutine concoutput_inversion(itime,outnum,gridtotalunc,wetgridtotalunc, & drygridtotalunc) ! i i o o ! o !***************************************************************************** ! * - ! Output of the concentration grid and the receptor concentrations. * + ! Output of the concentration grid formatted for inversions. * ! * ! Author: A. Stohl * ! * @@ -2995,6 +2024,8 @@ subroutine concoutput_sfc(itime,outnum,gridtotalunc,wetgridtotalunc, & ! * ! 2008 new sparse matrix format * ! * + ! January 2017, Separate files by release but include all timesteps * + ! * !***************************************************************************** ! * ! Variables: * @@ -3014,11 +2045,7 @@ subroutine concoutput_sfc(itime,outnum,gridtotalunc,wetgridtotalunc, & integer :: itime,i,ix,jy,kz,ks,kp,l,iix,jjy,kzz,nage,jjjjmmdd,ihmmss integer :: sp_count_i,sp_count_r real :: sp_fact - real :: outnum,densityoutrecept(numreceptor),xl,yl - ! RLT - real :: densitydryrecept(numreceptor) - real :: factor_dryrecept(numreceptor) - + real :: outnum,xl,yl real(dep_prec) :: auxgrid(nclassunc) real(sp) :: gridtotal,gridsigmatotal,gridtotalunc real(dep_prec) :: wetgridtotal,wetgridsigmatotal,wetgridtotalunc @@ -3030,15 +2057,25 @@ subroutine concoutput_sfc(itime,outnum,gridtotalunc,wetgridtotalunc, & character :: adate*8,atime*6 character(len=3) :: anspec logical :: lexist + character :: areldate*8,areltime*6 + logical,save :: lstart=.true. + logical,save,allocatable,dimension(:) :: lstartrel + integer :: ierr + character(LEN=100) :: dates_char + integer, parameter :: unitrelnames=654 + if(lstart) then + allocate(lstartrel(maxpointspec_act)) + lstartrel(:)=.true. + endif + if (verbosity.eq.1) then - print*,'inside concoutput_sfc ' CALL SYSTEM_CLOCK(count_clock) WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0 endif - ! Determine current calendar date, needed for the file name + ! Determine current calendar date !********************************************************** jul=bdate+real(itime,kind=dp)/86400._dp @@ -3046,10 +2083,49 @@ subroutine concoutput_sfc(itime,outnum,gridtotalunc,wetgridtotalunc, & write(adate,'(i8.8)') jjjjmmdd write(atime,'(i6.6)') ihmmss + + ! Prepare output files for dates + !********************************************************** + + ! Overwrite existing dates file on first call, later append to it + ! If 'dates' file exists in output directory, copy to new file dates.old + inquire(file=path(2)(1:length(2))//'dates', exist=lexist) + if (lexist.and.lstart) then + ! copy contents of existing dates file to dates.old + print*, 'warning: replacing old dates file' + open(unit=unitdates, file=path(2)(1:length(2))//'dates',form='formatted', & + &access='sequential', status='old', action='read', iostat=ierr) + open(unit=unittmp, file=path(2)(1:length(2))//'dates.old', access='sequential', & + &status='replace', action='write', form='formatted', iostat=ierr) + do while (.true.) + read(unitdates, '(a)', iostat=ierr) dates_char + if (ierr.ne.0) exit + write(unit=unittmp, fmt='(a)', iostat=ierr, advance='yes') trim(dates_char) + end do + close(unit=unitdates) + close(unit=unittmp) + ! create new dates file + open(unit=unitdates, file=path(2)(1:length(2))//'dates',form='formatted', & + &access='sequential', status='replace', iostat=ierr) + close(unit=unitdates) + endif + open(unitdates,file=path(2)(1:length(2))//'dates', ACCESS='APPEND') write(unitdates,'(a)') adate//atime close(unitdates) + !CGZ: Make a filename with names of releases + if (lstart) then + open(unit=unitrelnames, file=path(2)(1:length(2))//'releases_out',form='formatted', & + &access='sequential', status='replace', iostat=ierr) + close(unitrelnames) + endif + + print*, 'after creating dates files: lstart = ',lstart + ! print*, 'outnum:',outnum + ! print*, 'datetime:',adate//atime + + ! For forward simulations, output fields have dimension MAXSPEC, ! for backward simulations, output fields have dimension MAXPOINT. ! Thus, make loops either about nspec, or about numpoint @@ -3072,7 +2148,7 @@ subroutine concoutput_sfc(itime,outnum,gridtotalunc,wetgridtotalunc, & if (verbosity.eq.1) then - print*,'concoutput_sfc 2' + print*,'concoutput_inversion 2' CALL SYSTEM_CLOCK(count_clock) WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0 endif @@ -3086,9 +2162,9 @@ subroutine concoutput_sfc(itime,outnum,gridtotalunc,wetgridtotalunc, & do kz=1,numzgrid if (kz.eq.1) then - halfheight=outheight(1)/2. + halfheight=outheight(1)*0.5 else - halfheight=(outheight(kz)+outheight(kz-1))/2. + halfheight=(outheight(kz)+outheight(kz-1))*0.5 endif do kzz=2,nz if ((height(kzz-1).lt.halfheight).and. & @@ -3115,20 +2191,8 @@ subroutine concoutput_sfc(itime,outnum,gridtotalunc,wetgridtotalunc, & end do end do - do i=1,numreceptor - xl=xreceptor(i) - yl=yreceptor(i) - iix=max(min(nint(xl),nxmin1),0) - jjy=max(min(nint(yl),nymin1),0) - densityoutrecept(i)=rho(iix,jjy,1,2) - ! RLT - densitydryrecept(i)=rho_dry(iix,jjy,1,2) - end do - - ! RLT ! conversion factor for output relative to dry air factor_drygrid=densityoutgrid/densitydrygrid - factor_dryrecept=densityoutrecept/densitydryrecept ! Output is different for forward and backward simulations do kz=1,numzgrid @@ -3149,7 +2213,7 @@ subroutine concoutput_sfc(itime,outnum,gridtotalunc,wetgridtotalunc, & !********************************************************************* if (verbosity.eq.1) then - print*,'concoutput_sfc 3 (sd)' + print*,'concoutput_inversion 3 (sd)' CALL SYSTEM_CLOCK(count_clock) WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0 endif @@ -3166,68 +2230,95 @@ subroutine concoutput_sfc(itime,outnum,gridtotalunc,wetgridtotalunc, & do ks=1,nspec write(anspec,'(i3.3)') ks - if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then - if (ldirect.eq.1) then - open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_'//adate// & - atime//'_'//anspec,form='unformatted') - else - open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_'//adate// & - atime//'_'//anspec,form='unformatted') + + ! loop over releases + do kp=1,maxpointspec_act + + print*, 'itime = ',itime + print*, 'ireleasestart(kp) = ',ireleasestart(kp) + print*, 'ireleaseend(kp) = ',ireleaseend(kp) + + ! check itime is within release and backward trajectory length + if (nageclass.eq.1) then + if ((itime.gt.ireleaseend(kp)).or.(itime.lt.(ireleasestart(kp)-lage(1)))) then + go to 10 + endif endif - write(unitoutgrid) itime - endif - if ((iout.eq.2).or.(iout.eq.3)) then ! mixing ratio - open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_'//adate// & - atime//'_'//anspec,form='unformatted') + ! calculate date of release for filename + jul=bdate+real(ireleasestart(kp),kind=dp)/86400._dp ! this is the current day + call caldate(jul,jjjjmmdd,ihmmss) + write(areldate,'(i8.8)') jjjjmmdd + write(areltime,'(i6.6)') ihmmss + print*, 'areldate/areltime = ',areldate//areltime - write(unitoutgridppt) itime - endif + ! calculate date of field + jul=bdate+real(itime,kind=dp)/86400._dp + call caldate(jul,jjjjmmdd,ihmmss) + write(adate,'(i8.8)') jjjjmmdd + write(atime,'(i6.6)') ihmmss + + if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then + if (ldirect.eq.1) then + ! concentrations + inquire(file=path(2)(1:length(2))//'grid_conc_'//areldate// & + areltime//'_'//anspec,exist=lexist) + if(lexist.and..not.lstartrel(kp)) then + ! open and append to existing file + open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_'//areldate// & + areltime//'_'//anspec,form='unformatted',status='old',action='write',access='append') + else + ! open new file + open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_'//areldate// & + areltime//'_'//anspec,form='unformatted',status='replace',action='write') + endif + else + ! residence times + inquire(file=path(2)(1:length(2))//'grid_time_'//areldate// & + areltime//'_'//anspec,exist=lexist) + if(lexist.and..not.lstartrel(kp)) then + ! open and append to existing file + open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_'//areldate// & + areltime//'_'//anspec,form='unformatted',status='old',action='write',access='append') + else + ! open new file + open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_'//areldate// & + areltime//'_'//anspec,form='unformatted',status='replace',action='write') + ! add part of the filename to a file (similar to dates) for easier post-processing + open(unit=unitrelnames, file=path(2)(1:length(2))//'releases_out',form='formatted', & + & access='APPEND', iostat=ierr) + write(unitrelnames,'(a)') areldate//areltime//'_'//anspec + close(unitrelnames) + endif + endif + write(unitoutgrid) jjjjmmdd + write(unitoutgrid) ihmmss + endif + + if ((iout.eq.2).or.(iout.eq.3)) then + ! mixing ratio + inquire(file=path(2)(1:length(2))//'grid_pptv_'//areldate// & + areltime//'_'//anspec,exist=lexist) + if(lexist.and..not.lstartrel(kp)) then + ! open and append to existing file + open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_'//areldate// & + areltime//'_'//anspec,form='unformatted',status='old',action='write',access='append') + else + ! open new file + open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_'//areldate// & + areltime//'_'//anspec,form='unformatted',status='replace',action='write') + endif + write(unitoutgridppt) jjjjmmdd + write(unitoutgridppt) ihmmss + endif + + lstartrel(kp)=.false. - do kp=1,maxpointspec_act do nage=1,nageclass do jy=0,numygrid-1 do ix=0,numxgrid-1 - ! WET DEPOSITION - if ((WETDEP).and.(ldirect.gt.0)) then - do l=1,nclassunc - auxgrid(l)=wetgridunc(ix,jy,ks,kp,l,nage) - end do - call mean(auxgrid,wetgrid(ix,jy), & - wetgridsigma(ix,jy),nclassunc) - ! Multiply by number of classes to get total concentration - wetgrid(ix,jy)=wetgrid(ix,jy) & - *nclassunc - wetgridtotal=wetgridtotal+wetgrid(ix,jy) - ! Calculate standard deviation of the mean - wetgridsigma(ix,jy)= & - wetgridsigma(ix,jy)* & - sqrt(real(nclassunc)) - wetgridsigmatotal=wetgridsigmatotal+ & - wetgridsigma(ix,jy) - endif - - ! DRY DEPOSITION - if ((DRYDEP).and.(ldirect.gt.0)) then - do l=1,nclassunc - auxgrid(l)=drygridunc(ix,jy,ks,kp,l,nage) - end do - call mean(auxgrid,drygrid(ix,jy), & - drygridsigma(ix,jy),nclassunc) - ! Multiply by number of classes to get total concentration - drygrid(ix,jy)=drygrid(ix,jy)* & - nclassunc - drygridtotal=drygridtotal+drygrid(ix,jy) - ! Calculate standard deviation of the mean - drygridsigma(ix,jy)= & - drygridsigma(ix,jy)* & - sqrt(real(nclassunc)) - drygridsigmatotal=drygridsigmatotal+ & - drygridsigma(ix,jy) - endif - ! CONCENTRATION OR MIXING RATIO do kz=1,numzgrid do l=1,nclassunc @@ -3257,101 +2348,26 @@ subroutine concoutput_sfc(itime,outnum,gridtotalunc,wetgridtotalunc, & ! 1 or -1, first line is number of values, number of positions ! For backward simulations, the unit is seconds, stored in grid_time !******************************************************************* - - if (verbosity.eq.1) then - print*,'concoutput_sfc 4 (output)' - CALL SYSTEM_CLOCK(count_clock) - WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0 - endif - - ! Concentration output - !********************* - - if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then - - if (verbosity.eq.1) then - print*,'concoutput_sfc (Wet deposition)' - CALL SYSTEM_CLOCK(count_clock) - WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0 - endif - - ! Wet deposition - sp_count_i=0 - sp_count_r=0 - sp_fact=-1. - sp_zer=.true. - if ((ldirect.eq.1).and.(WETDEP)) then - do jy=0,numygrid-1 - do ix=0,numxgrid-1 - ! concentraion greater zero - if (wetgrid(ix,jy).gt.smallnum) then - if (sp_zer.eqv..true.) then ! first non zero value - sp_count_i=sp_count_i+1 - sparse_dump_i(sp_count_i)=ix+jy*numxgrid - sp_zer=.false. - sp_fact=sp_fact*(-1.) - endif - sp_count_r=sp_count_r+1 - sparse_dump_r(sp_count_r)= & - sp_fact*1.e12*real(wetgrid(ix,jy))/area(ix,jy) - sparse_dump_u(sp_count_r)= & - 1.e12*real(wetgridsigma(ix,jy))/area(ix,jy) - else ! concentration is zero - sp_zer=.true. - endif - end do - end do - else - sp_count_i=0 - sp_count_r=0 - endif - write(unitoutgrid) sp_count_i - write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i) - write(unitoutgrid) sp_count_r - write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r) - - if (verbosity.eq.1) then - print*,'concoutput_sfc (Dry deposition)' - CALL SYSTEM_CLOCK(count_clock) - WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0 - endif - ! Dry deposition - sp_count_i=0 - sp_count_r=0 - sp_fact=-1. - sp_zer=.true. - if ((ldirect.eq.1).and.(DRYDEP)) then - do jy=0,numygrid-1 - do ix=0,numxgrid-1 - if (drygrid(ix,jy).gt.smallnum) then - if (sp_zer.eqv..true.) then ! first non zero value - sp_count_i=sp_count_i+1 - sparse_dump_i(sp_count_i)=ix+jy*numxgrid - sp_zer=.false. - sp_fact=sp_fact*(-1.) - endif - sp_count_r=sp_count_r+1 - sparse_dump_r(sp_count_r)= & - sp_fact* & - 1.e12*real(drygrid(ix,jy))/area(ix,jy) - sparse_dump_u(sp_count_r)= & - 1.e12*real(drygridsigma(ix,jy))/area(ix,jy) - else ! concentration is zero - sp_zer=.true. - endif - end do - end do - else - sp_count_i=0 - sp_count_r=0 + + if (verbosity.eq.1) then + print*,'concoutput_inversion 4 (output)' + CALL SYSTEM_CLOCK(count_clock) + WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0 + endif + + ! Concentration output + !********************* + + if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then + + if (verbosity.eq.1) then + print*,'concoutput_inversion (Wet deposition)' + CALL SYSTEM_CLOCK(count_clock) + WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0 endif - write(unitoutgrid) sp_count_i - write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i) - write(unitoutgrid) sp_count_r - write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r) if (verbosity.eq.1) then - print*,'concoutput_sfc (Concentrations)' + print*,'concoutput_inversion (Concentrations)' CALL SYSTEM_CLOCK(count_clock) WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0 endif @@ -3383,6 +2399,7 @@ subroutine concoutput_sfc(itime,outnum,gridtotalunc,wetgridtotalunc, & sparse_dump_u(sp_count_r)= & gridsigma(ix,jy,kz)* & factor3d(ix,jy,kz)/tot_mu(ks,kp) + else ! concentration is zero sp_zer=.true. endif @@ -3393,6 +2410,7 @@ subroutine concoutput_sfc(itime,outnum,gridtotalunc,wetgridtotalunc, & write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i) write(unitoutgrid) sp_count_r write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r) + endif ! concentration output ! Mixing ratio output @@ -3400,78 +2418,6 @@ subroutine concoutput_sfc(itime,outnum,gridtotalunc,wetgridtotalunc, & if ((iout.eq.2).or.(iout.eq.3)) then ! mixing ratio - ! Wet deposition - sp_count_i=0 - sp_count_r=0 - sp_fact=-1. - sp_zer=.true. - if ((ldirect.eq.1).and.(WETDEP)) then - do jy=0,numygrid-1 - do ix=0,numxgrid-1 - if (wetgrid(ix,jy).gt.smallnum) then - if (sp_zer.eqv..true.) then ! first non zero value - sp_count_i=sp_count_i+1 - sparse_dump_i(sp_count_i)= & - ix+jy*numxgrid - sp_zer=.false. - sp_fact=sp_fact*(-1.) - endif - sp_count_r=sp_count_r+1 - sparse_dump_r(sp_count_r)= & - sp_fact* & - 1.e12*real(wetgrid(ix,jy))/area(ix,jy) - sparse_dump_u(sp_count_r)= & - 1.e12*real(wetgridsigma(ix,jy))/area(ix,jy) - else ! concentration is zero - sp_zer=.true. - endif - end do - end do - else - sp_count_i=0 - sp_count_r=0 - endif - write(unitoutgridppt) sp_count_i - write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i) - write(unitoutgridppt) sp_count_r - write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r) - - ! Dry deposition - sp_count_i=0 - sp_count_r=0 - sp_fact=-1. - sp_zer=.true. - if ((ldirect.eq.1).and.(DRYDEP)) then - do jy=0,numygrid-1 - do ix=0,numxgrid-1 - if (drygrid(ix,jy).gt.smallnum) then - if (sp_zer.eqv..true.) then ! first non zero value - sp_count_i=sp_count_i+1 - sparse_dump_i(sp_count_i)= & - ix+jy*numxgrid - sp_zer=.false. - sp_fact=sp_fact*(-1) - endif - sp_count_r=sp_count_r+1 - sparse_dump_r(sp_count_r)= & - sp_fact* & - 1.e12*real(drygrid(ix,jy))/area(ix,jy) - sparse_dump_u(sp_count_r)= & - 1.e12*real(drygridsigma(ix,jy))/area(ix,jy) - else ! concentration is zero - sp_zer=.true. - endif - end do - end do - else - sp_count_i=0 - sp_count_r=0 - endif - write(unitoutgridppt) sp_count_i - write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i) - write(unitoutgridppt) sp_count_r - write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r) - ! Mixing ratios ! sfc_only write only 1st layer @@ -3511,27 +2457,33 @@ subroutine concoutput_sfc(itime,outnum,gridtotalunc,wetgridtotalunc, & write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i) write(unitoutgridppt) sp_count_r write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r) + endif ! output for ppt - end do - end do + end do ! nageclass - close(unitoutgridppt) - close(unitoutgrid) + close(unitoutgridppt) + close(unitoutgrid) - end do + ! itime is outside range +10 continue + + end do ! maxpointspec_act + + end do ! nspec - ! RLT Aug 2017 ! Write out conversion factor for dry air + !***************************************** + inquire(file=path(2)(1:length(2))//'factor_drygrid',exist=lexist) - if (lexist) then + if (lexist.and..not.lstart) then ! open and append open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid',form='unformatted',& status='old',action='write',access='append') else ! create new open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid',form='unformatted',& - status='new',action='write') + status='replace',action='write') endif sp_count_i=0 sp_count_r=0 @@ -3563,79 +2515,27 @@ subroutine concoutput_sfc(itime,outnum,gridtotalunc,wetgridtotalunc, & write(unitoutfactor) (sparse_dump_r(i),i=1,sp_count_r) close(unitoutfactor) - if (gridtotal.gt.0.) gridtotalunc=gridsigmatotal/gridtotal - if (wetgridtotal.gt.0.) wetgridtotalunc=wetgridsigmatotal/ & - wetgridtotal - if (drygridtotal.gt.0.) drygridtotalunc=drygridsigmatotal/ & - drygridtotal - - ! Dump of receptor concentrations - - if (numreceptor.gt.0 .and. (iout.eq.2 .or. iout.eq.3) ) then - write(unitoutreceptppt) itime - do ks=1,nspec - write(unitoutreceptppt) (1.e12*creceptor(i,ks)/outnum* & - weightair/weightmolar(ks)/densityoutrecept(i),i=1,numreceptor) - end do - endif - - ! Dump of receptor concentrations - - if (numreceptor.gt.0) then - write(unitoutrecept) itime - do ks=1,nspec - write(unitoutrecept) (1.e12*creceptor(i,ks)/outnum, & - i=1,numreceptor) - end do - endif - ! RLT Aug 2017 - ! Write out conversion factor for dry air - if (numreceptor.gt.0) then - inquire(file=path(2)(1:length(2))//'factor_dryreceptor',exist=lexist) - if (lexist) then - ! open and append - open(unitoutfactor,file=path(2)(1:length(2))//'factor_dryreceptor',form='unformatted',& - status='old',action='write',access='append') - else - ! create new - open(unitoutfactor,file=path(2)(1:length(2))//'factor_dryreceptor',form='unformatted',& - status='new',action='write') - endif - write(unitoutfactor) itime - write(unitoutfactor) (factor_dryrecept(i),i=1,numreceptor) - close(unitoutfactor) + ! reset lstart + if (lstart) then + lstart=.false. endif + print*, 'after writing output files: lstart = ',lstart ! Reinitialization of grid !************************* - do ks=1,nspec - do kp=1,maxpointspec_act - do i=1,numreceptor - creceptor(i,ks)=0. - end do - do jy=0,numygrid-1 - do ix=0,numxgrid-1 - do l=1,nclassunc - do nage=1,nageclass - do kz=1,numzgrid - gridunc(ix,jy,kz,ks,kp,l,nage)=0. - end do - end do - end do - end do - end do - end do - end do -end subroutine concoutput_sfc + gridunc(:,:,:,:,:,:,:)=0. + +end subroutine concoutput_inversion + -subroutine concoutput_sfc_nest(itime,outnum) +subroutine concoutput_inversion_nest(itime,outnum) ! i i !***************************************************************************** ! * - ! Output of the concentration grid and the receptor concentrations. * + ! Output of the nested concentration grid formatted for inversions. * ! * ! Author: A. Stohl * ! * @@ -3657,6 +2557,8 @@ subroutine concoutput_sfc_nest(itime,outnum) ! * ! 2008 new sparse matrix format * ! * + ! January 2017, Separate files by release but include all timesteps * + ! * !***************************************************************************** ! * ! Variables: * @@ -3676,19 +2578,25 @@ subroutine concoutput_sfc_nest(itime,outnum) integer :: itime,i,ix,jy,kz,ks,kp,l,iix,jjy,kzz,nage,jjjjmmdd,ihmmss integer :: sp_count_i,sp_count_r real :: sp_fact - real :: outnum,densityoutrecept(numreceptor),xl,yl - ! RLT - real :: densitydryrecept(numreceptor) - real :: factor_dryrecept(numreceptor) + real :: outnum,xl,yl real(dep_prec) :: auxgrid(nclassunc) real :: halfheight,dz,dz1,dz2,tot_mu(maxspec,maxpointspec_act) real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled real,parameter :: weightair=28.97 logical :: sp_zer + logical,save :: lnstart=.true. + logical,save,allocatable,dimension(:) :: lnstartrel character :: adate*8,atime*6 character(len=3) :: anspec logical :: lexist + character :: areldate*8,areltime*6 + + if(lnstart) then + allocate(lnstartrel(maxpointspec_act)) + lnstartrel(:)=.true. + endif + print*, 'lnstartrel = ',lnstartrel ! Determine current calendar date, needed for the file name !********************************************************** @@ -3698,6 +2606,8 @@ subroutine concoutput_sfc_nest(itime,outnum) write(adate,'(i8.8)') jjjjmmdd write(atime,'(i6.6)') ihmmss + print*, 'outnum:',outnum + print*, 'datetime:',adate//atime ! For forward simulations, output fields have dimension MAXSPEC, ! for backward simulations, output fields have dimension MAXPOINT. @@ -3729,9 +2639,9 @@ subroutine concoutput_sfc_nest(itime,outnum) do kz=1,numzgrid if (kz.eq.1) then - halfheight=outheight(1)/2. + halfheight=outheight(1)*0.5 else - halfheight=(outheight(kz)+outheight(kz-1))/2. + halfheight=(outheight(kz)+outheight(kz-1))*0.5 endif do kzz=2,nz if ((height(kzz-1).lt.halfheight).and. & @@ -3751,40 +2661,21 @@ subroutine concoutput_sfc_nest(itime,outnum) jjy=max(min(nint(yl),nymin1),0) densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,2)*dz1+ & rho(iix,jjy,kzz-1,2)*dz2)/dz - ! RLT densitydrygrid(ix,jy,kz)=(rho_dry(iix,jjy,kzz,2)*dz1+ & rho_dry(iix,jjy,kzz-1,2)*dz2)/dz end do end do end do - do i=1,numreceptor - xl=xreceptor(i) - yl=yreceptor(i) - iix=max(min(nint(xl),nxmin1),0) - jjy=max(min(nint(yl),nymin1),0) - densityoutrecept(i)=rho(iix,jjy,1,2) - ! RLT - densitydryrecept(i)=rho_dry(iix,jjy,1,2) - end do - - ! RLT ! conversion factor for output relative to dry air factor_drygrid=densityoutgrid/densitydrygrid - factor_dryrecept=densityoutrecept/densitydryrecept ! Output is different for forward and backward simulations - do kz=1,numzgrid - do jy=0,numygridn-1 - do ix=0,numxgridn-1 - if (ldirect.eq.1) then - factor3d(ix,jy,kz)=1.e12/volumen(ix,jy,kz)/outnum - else - factor3d(ix,jy,kz)=real(abs(loutaver))/outnum - endif - end do - end do - end do + if (ldirect.eq.1) then + factor3d(:,:,:)=1.e12/volumen(:,:,:)/outnum + else + factor3d(:,:,:)=real(abs(loutaver))/outnum + endif !********************************************************************* ! Determine the standard deviation of the mean concentration or mixing @@ -3794,82 +2685,108 @@ subroutine concoutput_sfc_nest(itime,outnum) do ks=1,nspec write(anspec,'(i3.3)') ks - if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then - if (ldirect.eq.1) then - open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_nest_' & - //adate// & - atime//'_'//anspec,form='unformatted') - else - open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_nest_' & - //adate// & - atime//'_'//anspec,form='unformatted') - endif - write(unitoutgrid) itime - endif - if ((iout.eq.2).or.(iout.eq.3)) then ! mixing ratio - open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_nest_' & - //adate// & - atime//'_'//anspec,form='unformatted') + do kp=1,maxpointspec_act - write(unitoutgridppt) itime - endif + print*, 'itime = ',itime + print*, 'lage(1) = ',lage(1) + print*, 'ireleasestart(kp) = ',ireleasestart(kp) + print*, 'ireleaseend(kp) = ',ireleaseend(kp) + + ! check itime is within release and backward trajectory length + if (nageclass.eq.1) then + if ((itime.gt.ireleaseend(kp)).or.(itime.lt.(ireleasestart(kp)-lage(1)))) then + go to 10 + endif + endif + + ! calculate date of release + jul=bdate+real(ireleasestart(kp),kind=dp)/86400._dp ! this is the current day + call caldate(jul,jjjjmmdd,ihmmss) + write(areldate,'(i8.8)') jjjjmmdd + write(areltime,'(i6.6)') ihmmss + print*, areldate//areltime + + ! calculate date of field + jul=bdate+real(itime,kind=dp)/86400._dp + call caldate(jul,jjjjmmdd,ihmmss) + write(adate,'(i8.8)') jjjjmmdd + write(atime,'(i6.6)') ihmmss + print*, adate//atime + + if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then + if (ldirect.eq.1) then + ! concentrations + inquire(file=path(2)(1:length(2))//'grid_conc_nest_'//areldate// & + areltime//'_'//anspec,exist=lexist) + if(lexist.and..not.lnstartrel(kp)) then + ! open and append to existing file + open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_nest_'//areldate// & + areltime//'_'//anspec,form='unformatted',status='old',action='write',access='append') + else + ! open new file + open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_nest_'//areldate// & + areltime//'_'//anspec,form='unformatted',status='replace',action='write') + endif + else + ! residence times + inquire(file=path(2)(1:length(2))//'grid_time_nest_'//areldate// & + areltime//'_'//anspec,exist=lexist) + if(lexist.and..not.lnstartrel(kp)) then + ! open and append to existing file + open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_nest_'//areldate// & + areltime//'_'//anspec,form='unformatted',status='old',action='write',access='append') + else + ! open new file + open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_nest_'//areldate// & + areltime//'_'//anspec,form='unformatted',status='replace',action='write') + endif + endif + write(unitoutgrid) jjjjmmdd + write(unitoutgrid) ihmmss + endif - do kp=1,maxpointspec_act - do nage=1,nageclass + if ((iout.eq.2).or.(iout.eq.3)) then + ! mixing ratio + inquire(file=path(2)(1:length(2))//'grid_pptv_nest_'//areldate// & + areltime//'_'//anspec,exist=lexist) + if(lexist.and..not.lnstartrel(kp)) then + ! open and append to existing file + open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_nest_'//areldate// & + areltime//'_'//anspec,form='unformatted',status='old',action='write',access='append') + else + ! open new file + open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_nest_'//areldate// & + areltime//'_'//anspec,form='unformatted',status='replace',action='write') + endif + write(unitoutgridppt) jjjjmmdd + write(unitoutgridppt) ihmmss + endif - do jy=0,numygridn-1 - do ix=0,numxgridn-1 + lnstartrel(kp)=.false. - ! WET DEPOSITION - if ((WETDEP).and.(ldirect.gt.0)) then - do l=1,nclassunc - auxgrid(l)=wetgriduncn(ix,jy,ks,kp,l,nage) - end do - call mean(auxgrid,wetgrid(ix,jy), & - wetgridsigma(ix,jy),nclassunc) - ! Multiply by number of classes to get total concentration - wetgrid(ix,jy)=wetgrid(ix,jy) & - *nclassunc - ! Calculate standard deviation of the mean - wetgridsigma(ix,jy)= & - wetgridsigma(ix,jy)* & - sqrt(real(nclassunc)) - endif + do nage=1,nageclass - ! DRY DEPOSITION - if ((DRYDEP).and.(ldirect.gt.0)) then - do l=1,nclassunc - auxgrid(l)=drygriduncn(ix,jy,ks,kp,l,nage) - end do - call mean(auxgrid,drygrid(ix,jy), & - drygridsigma(ix,jy),nclassunc) - ! Multiply by number of classes to get total concentration - drygrid(ix,jy)=drygrid(ix,jy)* & - nclassunc - ! Calculate standard deviation of the mean - drygridsigma(ix,jy)= & - drygridsigma(ix,jy)* & - sqrt(real(nclassunc)) - endif + do jy=0,numygridn-1 + do ix=0,numxgridn-1 ! CONCENTRATION OR MIXING RATIO - do kz=1,numzgrid - do l=1,nclassunc - auxgrid(l)=griduncn(ix,jy,kz,ks,kp,l,nage) - end do - call mean(auxgrid,grid(ix,jy,kz), & - gridsigma(ix,jy,kz),nclassunc) + do kz=1,numzgrid + do l=1,nclassunc + auxgrid(l)=griduncn(ix,jy,kz,ks,kp,l,nage) + end do + call mean(auxgrid,grid(ix,jy,kz), & + gridsigma(ix,jy,kz),nclassunc) ! Multiply by number of classes to get total concentration - grid(ix,jy,kz)= & - grid(ix,jy,kz)*nclassunc + grid(ix,jy,kz)= & + grid(ix,jy,kz)*nclassunc ! Calculate standard deviation of the mean - gridsigma(ix,jy,kz)= & - gridsigma(ix,jy,kz)* & - sqrt(real(nclassunc)) + gridsigma(ix,jy,kz)= & + gridsigma(ix,jy,kz)* & + sqrt(real(nclassunc)) + end do + end do end do - end do - end do !******************************************************************* @@ -3882,82 +2799,13 @@ subroutine concoutput_sfc_nest(itime,outnum) ! Concentration output !********************* - if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then - ! Wet deposition - sp_count_i=0 - sp_count_r=0 - sp_fact=-1. - sp_zer=.true. - if ((ldirect.eq.1).and.(WETDEP)) then - do jy=0,numygridn-1 - do ix=0,numxgridn-1 - !oncentraion greater zero - if (wetgrid(ix,jy).gt.smallnum) then - if (sp_zer.eqv..true.) then ! first non zero value - sp_count_i=sp_count_i+1 - sparse_dump_i(sp_count_i)=ix+jy*numxgridn - sp_zer=.false. - sp_fact=sp_fact*(-1.) - endif - sp_count_r=sp_count_r+1 - sparse_dump_r(sp_count_r)= & - sp_fact*1.e12*real(wetgrid(ix,jy))/arean(ix,jy) - sparse_dump_u(sp_count_r)= & - 1.e12*real(wetgridsigma(ix,jy))/area(ix,jy) - else ! concentration is zero - sp_zer=.true. - endif - end do - end do - else - sp_count_i=0 - sp_count_r=0 - endif - write(unitoutgrid) sp_count_i - write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i) - write(unitoutgrid) sp_count_r - write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r) - ! Dry deposition - sp_count_i=0 - sp_count_r=0 - sp_fact=-1. - sp_zer=.true. - if ((ldirect.eq.1).and.(DRYDEP)) then - do jy=0,numygridn-1 - do ix=0,numxgridn-1 - if (drygrid(ix,jy).gt.smallnum) then - if (sp_zer.eqv..true.) then ! first non zero value - sp_count_i=sp_count_i+1 - sparse_dump_i(sp_count_i)=ix+jy*numxgridn - sp_zer=.false. - sp_fact=sp_fact*(-1.) - endif - sp_count_r=sp_count_r+1 - sparse_dump_r(sp_count_r)= & - sp_fact* & - 1.e12*real(drygrid(ix,jy))/arean(ix,jy) - sparse_dump_u(sp_count_r)= & - 1.e12*real(drygridsigma(ix,jy))/area(ix,jy) - else ! concentration is zero - sp_zer=.true. - endif - end do - end do - else - sp_count_i=0 - sp_count_r=0 - endif - write(unitoutgrid) sp_count_i - write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i) - write(unitoutgrid) sp_count_r - write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r) + if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then ! Concentrations - ! if sfc_only write only 1st layer + ! sfc_only write only 1st layer - if(sfc_only.eq.1) then sp_count_i=0 sp_count_r=0 sp_fact=-1. @@ -3993,130 +2841,19 @@ subroutine concoutput_sfc_nest(itime,outnum) write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i) write(unitoutgrid) sp_count_r write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r) - else - - ! write full vertical resolution - - sp_count_i=0 - sp_count_r=0 - sp_fact=-1. - sp_zer=.true. - do kz=1,numzgrid - do jy=0,numygridn-1 - do ix=0,numxgridn-1 - if (grid(ix,jy,kz).gt.smallnum) then - if (sp_zer.eqv..true.) then ! first non zero value - sp_count_i=sp_count_i+1 - sparse_dump_i(sp_count_i)= & - ix+jy*numxgridn+kz*numxgridn*numygridn - sp_zer=.false. - sp_fact=sp_fact*(-1.) - endif - sp_count_r=sp_count_r+1 - sparse_dump_r(sp_count_r)= & - sp_fact* & - grid(ix,jy,kz)* & - factor3d(ix,jy,kz)/tot_mu(ks,kp) - sparse_dump_u(sp_count_r)= & - gridsigma(ix,jy,kz)* & - factor3d(ix,jy,kz)/tot_mu(ks,kp) - else ! concentration is zero - sp_zer=.true. - endif - end do - end do - end do - write(unitoutgrid) sp_count_i - write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i) - write(unitoutgrid) sp_count_r - write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r) - endif ! sfc_only - - endif ! concentration output + endif ! concentration output ! Mixing ratio output !******************** - if ((iout.eq.2).or.(iout.eq.3)) then ! mixing ratio - - ! Wet deposition - sp_count_i=0 - sp_count_r=0 - sp_fact=-1. - sp_zer=.true. - if ((ldirect.eq.1).and.(WETDEP)) then - do jy=0,numygridn-1 - do ix=0,numxgridn-1 - if (wetgrid(ix,jy).gt.smallnum) then - if (sp_zer.eqv..true.) then ! first non zero value - sp_count_i=sp_count_i+1 - sparse_dump_i(sp_count_i)= & - ix+jy*numxgridn - sp_zer=.false. - sp_fact=sp_fact*(-1.) - endif - sp_count_r=sp_count_r+1 - sparse_dump_r(sp_count_r)= & - sp_fact* & - 1.e12*real(wetgrid(ix,jy))/arean(ix,jy) - sparse_dump_u(sp_count_r)= & - 1.e12*real(wetgridsigma(ix,jy))/area(ix,jy) - else ! concentration is zero - sp_zer=.true. - endif - end do - end do - else - sp_count_i=0 - sp_count_r=0 - endif - write(unitoutgridppt) sp_count_i - write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i) - write(unitoutgridppt) sp_count_r - write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r) + if ((iout.eq.2).or.(iout.eq.3)) then ! mixing ratio - ! Dry deposition - sp_count_i=0 - sp_count_r=0 - sp_fact=-1. - sp_zer=.true. - if ((ldirect.eq.1).and.(DRYDEP)) then - do jy=0,numygridn-1 - do ix=0,numxgridn-1 - if (drygrid(ix,jy).gt.smallnum) then - if (sp_zer.eqv..true.) then ! first non zero value - sp_count_i=sp_count_i+1 - sparse_dump_i(sp_count_i)= & - ix+jy*numxgridn - sp_zer=.false. - sp_fact=sp_fact*(-1) - endif - sp_count_r=sp_count_r+1 - sparse_dump_r(sp_count_r)= & - sp_fact* & - 1.e12*real(drygrid(ix,jy))/arean(ix,jy) - sparse_dump_u(sp_count_r)= & - 1.e12*real(drygridsigma(ix,jy))/area(ix,jy) - else ! concentration is zero - sp_zer=.true. - endif - end do - end do - else - sp_count_i=0 - sp_count_r=0 - endif - write(unitoutgridppt) sp_count_i - write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i) - write(unitoutgridppt) sp_count_r - write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r) ! Mixing ratios - ! if sfc_only write only 1st layer + ! sfc_only write only 1st layer - if(sfc_only.eq.1) then sp_count_i=0 sp_count_r=0 sp_fact=-1. @@ -4148,72 +2885,37 @@ subroutine concoutput_sfc_nest(itime,outnum) end do end do end do - write(unitoutgridppt) sp_count_i - write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i) - write(unitoutgridppt) sp_count_r - write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r) - else - - ! write full vertical resolution + write(unitoutgridppt) sp_count_i + write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i) + write(unitoutgridppt) sp_count_r + write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r) - sp_count_i=0 - sp_count_r=0 - sp_fact=-1. - sp_zer=.true. - do kz=1,numzgrid - do jy=0,numygridn-1 - do ix=0,numxgridn-1 - if (grid(ix,jy,kz).gt.smallnum) then - if (sp_zer.eqv..true.) then ! first non zero value - sp_count_i=sp_count_i+1 - sparse_dump_i(sp_count_i)= & - ix+jy*numxgridn+kz*numxgridn*numygridn - sp_zer=.false. - sp_fact=sp_fact*(-1.) - endif - sp_count_r=sp_count_r+1 - sparse_dump_r(sp_count_r)= & - sp_fact* & - 1.e12*grid(ix,jy,kz) & - /volumen(ix,jy,kz)/outnum* & - weightair/weightmolar(ks)/densityoutgrid(ix,jy,kz) - sparse_dump_u(sp_count_r)= & - 1.e12*gridsigma(ix,jy,kz)/volumen(ix,jy,kz)/ & - outnum*weightair/weightmolar(ks)/ & - densityoutgrid(ix,jy,kz) - else ! concentration is zero - sp_zer=.true. - endif - end do - end do - end do - write(unitoutgridppt) sp_count_i - write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i) - write(unitoutgridppt) sp_count_r - write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r) - endif ! sfc_only + endif ! output for ppt + + end do ! nageclass - endif ! output for ppt + close(unitoutgridppt) + close(unitoutgrid) - end do - end do + ! itime is outside range +10 continue - close(unitoutgridppt) - close(unitoutgrid) + end do ! maxpointspec_act - end do + end do ! nspec - ! RLT Aug 2017 ! Write out conversion factor for dry air + !***************************************** + inquire(file=path(2)(1:length(2))//'factor_drygrid_nest',exist=lexist) - if (lexist) then + if (lexist.and..not.lnstart) then ! open and append open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid_nest',form='unformatted',& status='old',action='write',access='append') else ! create new open(unitoutfactor,file=path(2)(1:length(2))//'factor_drygrid_nest',form='unformatted',& - status='new',action='write') + status='replace',action='write') endif sp_count_i=0 sp_count_r=0 @@ -4245,30 +2947,18 @@ subroutine concoutput_sfc_nest(itime,outnum) write(unitoutfactor) (sparse_dump_r(i),i=1,sp_count_r) close(unitoutfactor) - + ! reset lnstart + if (lnstart) then + lnstart=.false. + endif ! Reinitialization of grid !************************* - do ks=1,nspec - do kp=1,maxpointspec_act - do i=1,numreceptor - creceptor(i,ks)=0. - end do - do jy=0,numygridn-1 - do ix=0,numxgridn-1 - do l=1,nclassunc - do nage=1,nageclass - do kz=1,numzgrid - griduncn(ix,jy,kz,ks,kp,l,nage)=0. - end do - end do - end do - end do - end do - end do - end do -end subroutine concoutput_sfc_nest + griduncn(:,:,:,:,:,:,:)=0. + +end subroutine concoutput_inversion_nest + subroutine initcond_output(itime) ! i diff --git a/src/cbl_mod.f90 b/src/cbl_mod.f90 index 32592ac560895cb0fb9eae41a5a07fb4486fcd84..9a9331a637cb26da33dd7d3bdf3cf8c94decbe52 100644 --- a/src/cbl_mod.f90 +++ b/src/cbl_mod.f90 @@ -88,7 +88,7 @@ subroutine cbl(wp,zp,wst,h,rhoa,rhograd,sigmaw,dsigmawdz,tlw,ptot,Q,phi,ath,bth, ! stability transition function see Cassiani et al(2015) BLM transition=1. !if (ol.lt.-50) transition=((sin(((ol+100.)/100.)*pi))-1.)/2. - if (-h/ol.lt.15) transition=((sin((((-h/ol)+10.)/10.)*pi)))/2.+0.5 + if (-h/ol.lt.15) transition=((sin((((-h/ol)+10.)/10.)*pi)))*0.5+0.5 ! momento secondo @@ -284,7 +284,7 @@ subroutine reinit_particle(zp,wst,h,sigmaw,wp,nrand,ol) z=zp/h transition=1. - if (-h/ol.lt.15) transition=((sin((((-h/ol)+10.)/10.)*pi)))/2.+0.5 + if (-h/ol.lt.15) transition=((sin((((-h/ol)+10.)/10.)*pi)))*0.5+0.5 w2=sigmaw*sigmaw w3=(((1.2*z*((1.-z)**(3./2.)))+eps)*wst**3)*transition @@ -374,7 +374,7 @@ subroutine init_cbl_vel(idum,zp,wst,h,sigmaw,wp,ol,ithread) transition=1. - if (-h/ol.lt.15) transition=((sin((((-h/ol)+10.)/10.)*pi)))/2.+0.5 !see also in cbl.f90 + if (-h/ol.lt.15) transition=((sin((((-h/ol)+10.)/10.)*pi)))*0.5+0.5 !see also in cbl.f90 w2=sigmaw*sigmaw w3=(((1.2*z*((1.-z)**(3./2.)))+eps)*wst**3) *transition diff --git a/src/chemistry_mod.f90 b/src/chemistry_mod.f90 new file mode 100644 index 0000000000000000000000000000000000000000..45e08927129bca3ca1191b72a2507a03b65ff925 --- /dev/null +++ b/src/chemistry_mod.f90 @@ -0,0 +1,1004 @@ +! SPDX-FileCopyrightText: FLEXPART 1998-2019, see flexpart_license.txt +! SPDX-License-Identifier: GPL-3.0-or-later + + !***************************************************************************** + ! * + ! This module contains variables and subroutines for calculating * + ! chemical loss of species * + ! * + !***************************************************************************** + +module chemistry_mod + + use netcdf + use par_mod + use com_mod + use date_mod + use windfields_mod, only: rho,nxmax,nymax,nzmax + use totals_mod, only: chem_loss + use netcdf_output_mod, only: nf90_err + + ! reagent field variables + + implicit none + + integer, allocatable, dimension(:) :: nxCL, nyCL, nzCL + integer :: nxjr, nyjr + real, allocatable, dimension(:,:) :: lonCL, latCL, altCL + real, allocatable, dimension(:) :: dxCL, dyCL + real :: dxjr, dyjr + real, allocatable, dimension(:,:,:,:,:) :: CL_field ! chemical loss fields at input resolution + real, allocatable, dimension(:,:,:,:) :: clfield_cur ! chemical loss fields current hour + integer, dimension(2) :: memCLtime ! time of fields in memory (sec) + integer :: curCLhour ! current hour since start of simulation + real(kind=dp), dimension(2) :: CL_time ! julian date of fields in memory + real, allocatable, dimension(:,:,:) :: jrate_average ! monthly average actinic flux + real, allocatable, dimension(:) :: lonjr, latjr + + private :: zenithangle, photo_O1D + + contains + + subroutine readreagents() + + !***************************************************************************** + ! * + ! This routine reads names and input paths of chemical reagents * + ! * + ! Author: R. Thompson, Sep 2023 * + ! * + !***************************************************************************** + ! * + ! Variables: * + ! preagent Reagent name * + ! preag_path Path to reagent fields * + ! phourly Logical for hourly interpolate (0 = no, 1 = yes) * + ! * + !***************************************************************************** + + implicit none + + character(len=256) :: preag_path + character(len=16) :: preagent, punit + integer :: phourly + integer,parameter :: unitreagents=2, unitreagentsout=3 + integer :: readerror + integer :: j + + ! declare namelist + namelist /reagent_params/ & + preagent, preag_path, phourly, punit + + preagent="" ! read failure indicator value + preag_path="" + punit="" + phourly=0 + reag_hourly(:)=0 + + open(unitreagents,file=path(1)(1:length(1))//'REAGENTS',status='old',form='formatted',iostat=readerror) + if (readerror.ne.0) then + ! no REAGENTS file + nreagent=0 + go to 999 + endif + + ! prepare namelist output if requested + if (nmlout.and.lroot) then + open(unitreagentsout,file=path(2)(1:length(2))//'REAGENTS.namelist',access='append',status='replace',iostat=readerror) + if (readerror.ne.0) then + write(*,*) '#### FLEXPART MODEL ERROR CANNOT CREATE FILE: ####' + write(*,*) '#### ',path(2)(1:length(2))//'REAGENTS.namelist ####' + endif + endif + + ! try namelist input + read(unitreagents,reagent_params,iostat=readerror) + close(unitreagents) + if (readerror.ne.0) then + ! not namelist format + nreagent=0 + go to 999 + endif + + ! namelist input + open(unitreagents,file=path(1)(1:length(1))//'REAGENTS',status='old',form='formatted',iostat=readerror) + j=0 + do while (readerror.eq.0) + j=j+1 + if (j.gt.maxreagent) then + write(*,*) ' #### FLEXPART MODEL ERROR! TOO MANY REAGENTS #### ' + write(*,*) ' #### MAXIMUM NUMBER IS ',maxreagent,' #### ' + write(*,*) ' #### PLEASE MAKE CHANGES IN FILE REAGENTS #### ' + stop + endif + read(unitreagents,reagent_params,iostat=readerror) + reagents(j)=preagent + reag_path(j)=preag_path + reag_hourly(j)=phourly + reag_unit(j)=punit + ! namelist output + if (nmlout.and.lroot) then + write(unitreagentsout,nml=reagent_params) + endif + end do + nreagent=j-1 + if (lroot) then + write(*,*) 'Number of reagents: ',nreagent + write(*,*) 'Reagent names: ',reagents(1:nreagent) + write(*,*) 'Reagent units: ',reag_unit(1:nreagent) + endif + close(unitreagents) + close(unitreagentsout) + +999 continue ! no reagents file + + end subroutine readreagents + + subroutine getchemfield(itime) + + !***************************************************************************** + ! * + ! This routine reads the chemical reagent fields into memory * + ! * + ! Author: Rona Thompson, Sep 2023 * + ! * + !***************************************************************************** + ! * + ! Variables: * + ! * + ! itime time since start of simulation in sec * + ! * + !***************************************************************************** + + implicit none + + integer :: itime + integer :: jjjjmmdd, hhmmss, mm, eomday + integer :: nr, memid + real(kind=dp) :: jd, jdmid + character(len=2) :: amonth + character(len=256):: CL_name, jr_name + logical :: lexist + + print*, 'getchemfield: ldirect*memCLtime(1) = ',ldirect*memCLtime(1) + print*, 'getchemfield: ldirect*memCLtime(2) = ',ldirect*memCLtime(2) + + ! Check fields are available for the current time step + !***************************************************** + + if ((ldirect*memCLtime(1).le.ldirect*itime).and. & + (ldirect*memCLtime(2).gt.ldirect*itime)) then + + ! The rightfields are already in memory -> don't do anything + return + + else if ((ldirect*memCLtime(2).le.ldirect*itime).and. & + (memCLtime(2).ne.0.)) then + + ! Current time is after 2nd chem field + !************************************* + + write(*,*) 'Updating CL fields... ' + + memCLtime(1)=memCLtime(2) ! time in sec + CL_time(1)=CL_time(2) ! julian date + memid=2 + + ! Get date/time of next chem field + !********************************* + ! assumes fields are monthly + + call caldate(CL_time(1), jjjjmmdd, hhmmss) + eomday=calceomday(jjjjmmdd/100) + memCLtime(2)=memCLtime(1)+ldirect*eomday*24*3600 ! time in sec + CL_time(2)=CL_time(1)+real(ldirect*eomday,kind=dp) ! julian date + write(*,*) 'getchemfield: memCLtime = ',memCLtime(1), memCLtime(2) + write(*,*) 'getchemfield: CL_time = ',CL_time(1), CL_time(2) + call caldate(CL_time(2), jjjjmmdd,hhmmss) + mm=int((jjjjmmdd-(jjjjmmdd/10000)*10000)/100) + write(amonth,'(I2.2)') mm + + do nr=1,nreagent + + write(*,*) 'Updating CL field for: ',trim(reagents(nr)) + + CL_field(:,:,:,nr,1)=CL_field(:,:,:,nr,2) + + ! Read new chem field and store in 2nd position + !********************************************** + + write(CL_name,'(A)') trim(reag_path(nr))//trim(reagents(nr))//'_'//amonth//'.nc' + inquire(file=CL_name,exist=lexist) + if (lexist) then + write(*,*) 'Reading CL field: ',CL_name + call readchemfield(CL_name, memid, nr) + else + write(*,*) '#### FLEXPART ERROR ####' + write(*,*) '#### CHEMISTRY FIELD NOT FOUND ####' + write(*,*) '#### '//trim(CL_name)//' ####' + error stop + endif + + if (reag_hourly(nr).gt.0) then + + ! Read average jrates and store in 2nd position + !********************************************** + + write(jr_name,'(A)') trim(reag_path(nr))//'jrate_average.nc' + inquire(file=jr_name,exist=lexist) + if (lexist) then + write(*,*) 'Reading jrate field: ',jr_name + call readjrate(jr_name, memid, mm) + else + write(*,*) '#### FLEXPART ERROR ####' + write(*,*) '#### JRATE_AVERAGE NOT FOUND ####' + write(*,*) '#### '//trim(jr_name)//' ####' + error stop + endif + + endif + + end do ! nreagent + + else + + ! No chem field in memory that can be used + !****************************************** + + write(*,*) 'Reading two new CL fields...' + + ! Get date/time of both chem fields + !********************************** + ! assumes fields are monthly + + do memid=1,2 + if (memid.eq.1) then + jd=bdate+real(ldirect*itime,kind=dp)/86400._dp + call caldate(jd, jjjjmmdd, hhmmss) + ! middle of month day + jdmid=juldate(int(jjjjmmdd/100)*100+15,0) + !! testing + print*, 'getchemfield: jjjjmmdd, jjjjmmdd_mid = ',jjjjmmdd, int(jjjjmmdd/100)*100+15 + ! julian date of fields + if (ldirect.gt.0) then + if (jd.ge.jdmid) then + ! use current month + CL_time(memid)=jdmid + else + ! use last month + eomday=calceomday(jjjjmmdd/100) + CL_time(memid)=jdmid-real(eomday,kind=dp) + endif + else + if (jd.ge.jdmid) then + ! use next month + CL_time(memid)=jdmid+real(eomday,kind=dp) + else + ! use current month + CL_time(memid)=jdmid + endif + endif + !! testing + print*, 'getchemfield: memid, jd, jdmid, CL_time = ',memid,jd,jdmid,CL_time(1) + else + call caldate(jd, jjjjmmdd, hhmmss) + eomday=calceomday(jjjjmmdd/100) + CL_time(memid)=CL_time(memid-1)+real(ldirect*eomday,kind=dp) + endif + ! time of field in seconds from start + memCLtime(memid)=int((CL_time(memid)-bdate)*86400._dp) + + write(*,*) 'getchemfield: memid, memCLtime = ',memCLtime(memid) + write(*,*) 'getchemfield: memid, CL_time = ',CL_time(memid) + + call caldate(CL_time(memid), jjjjmmdd, hhmmss) + mm=int((jjjjmmdd-(jjjjmmdd/10000)*10000)/100) + write(amonth,'(I2.2)') mm + + do nr=1,nreagent + + write(*,*) 'Reading two new CL fields for: ',trim(reagents(nr)) + + ! Read new chem field + !******************** + + write(CL_name,'(A)') trim(reag_path(nr))//trim(reagents(nr))//'_'//amonth//'.nc' + inquire(file=CL_name,exist=lexist) + if (lexist) then + write(*,*) 'Reading CL field: ',CL_name + call readchemfield(CL_name, memid, nr) + else + write(*,*) '#### FLEXPART ERROR ####' + write(*,*) '#### CHEMISTRY FIELD NOT FOUND ####' + write(*,*) '#### '//trim(CL_name)//' ####' + error stop + endif + + ! Read average jrates + !******************** + + if (reag_hourly(nr).gt.0) then + ! Read average jrates into memory + write(jr_name,'(A)') trim(reag_path(nr))//'jrate_average.nc' + inquire(file=jr_name,exist=lexist) + if (lexist) then + write(*,*) 'Reading jrate field: ',jr_name + call readjrate(jr_name, memid, mm) + else + write(*,*) '#### FLEXPART ERROR ####' + write(*,*) '#### JRATE_AVERAGE NOT FOUND ####' + write(*,*) '#### '//trim(jr_name)//' ####' + error stop + endif + endif ! reag_hourly + + end do ! nreagent + + end do ! memid + + endif ! update hourly fields + + + end subroutine getchemfield + + + subroutine readchemfield(CL_name,memid,nr) + + !***************************************************************************** + ! * + ! Reads the chemical reagent fields into memory * + ! * + ! Author: Rona Thompson, Sep 2023 * + ! * + !***************************************************************************** + ! * + ! Variables: * + ! * + ! CL_name name of chemical reagent file * + ! memid time index to chemical field variable * + ! nr reagent index to chemical field variable * + ! * + !***************************************************************************** + + implicit none + + character(len=256) :: CL_name + integer :: memid,nr,len + integer :: ncid,dimid,varid + + ! Read netcdf file + !****************** + + ! open file + call nf90_err( nf90_open(trim(CL_name),nf90_NOWRITE,ncid) ) + + ! longitude + call nf90_err( nf90_inq_dimid(ncid,'lon',dimid) ) + call nf90_err( nf90_inquire_dimension(ncid,dimid,len=len) ) + if (.not.allocated(lonCL)) then + allocate(nxCL(nreagent)) + allocate(dxCL(nreagent)) + allocate(lonCL(nxmax,nreagent)) + endif + nxCL(nr)=len + call nf90_err( nf90_inq_varid(ncid,'lon',varid) ) + call nf90_err( nf90_get_var(ncid,varid,lonCL(1:nxCL(nr),nr)) ) + dxCL(nr)=abs(lonCL(2,nr)-lonCL(1,nr)) + + ! latitude + call nf90_err( nf90_inq_dimid(ncid,'lat',dimid) ) + call nf90_err( nf90_inquire_dimension(ncid,dimid,len=len) ) + if (.not.allocated(latCL)) then + allocate(nyCL(nreagent)) + allocate(dyCL(nreagent)) + allocate(latCL(nymax,nreagent)) + endif + nyCL(nr)=len + call nf90_err( nf90_inq_varid(ncid,'lat',varid) ) + call nf90_err( nf90_get_var(ncid,varid,latCL(1:nyCL(nr),nr)) ) + dyCL(nr)=abs(latCL(2,nr)-latCL(1,nr)) + + ! altitude + call nf90_err( nf90_inq_dimid(ncid,'lev',dimid) ) + call nf90_err( nf90_inquire_dimension(ncid,dimid,len=len) ) + if (.not.allocated(altCL)) then + allocate(nzCL(nreagent)) + allocate(altCL(nzmax,nreagent)) + endif + nzCL(nr)=len + call nf90_err( nf90_inq_varid(ncid,'lev',varid) ) + call nf90_err( nf90_get_var(ncid,varid,altCL(1:nzCL(nr),nr)) ) + + ! chemical field + call nf90_err( nf90_inq_varid(ncid,trim(reagents(nr)),varid) ) + if (.not.allocated(CL_field)) then + allocate(CL_field(nxmax,nymax,nzmax,nreagent,2)) + allocate(clfield_cur(nxmax,nymax,nzmax,nreagent)) + endif + call nf90_err( nf90_get_var(ncid,varid,CL_field(1:nxCL(nr),1:nyCL(nr),1:nzCL(nr),nr,memid)) ) + + ! close file + call nf90_err( nf90_close(ncid) ) + + !! testing +! print*, 'readchemfield: nxCL, nyCL, nzCL = ',nxCL(nr), nyCL(nr), nzCL(nr) +! print*, 'readchemfield: lonCL = ',lonCL(1:nxCL(nr),nr) +! print*, 'readchemfield: latCL = ',latCL(1:nyCL(nr),nr) + + return + + end subroutine readchemfield + + subroutine getchemhourly(itime) + + !***************************************************************************** + ! * + ! This routine interpolates the chemistry fields to current hour and * + ! if required using information on solar zenith angle * + ! * + ! Author: Rona Thompson, Mar 2024 * + ! * + !***************************************************************************** + ! * + ! Variables: * + ! itime [s] actual simulation time [s] * + ! * + !***************************************************************************** + + use point_mod, only: xlon0, ylat0, dx, dy + use windfields_mod, only : height, nz + + implicit none + + integer :: itime, curhour, interp_time + integer :: nr, kz, ix, jy, ixm, jym, ixp, jyp, indz, indzm, ii + real :: dt1, dt2, dtt, sza, jrate, jrate_cur, r + real, dimension(2) :: r1 + real :: dz1, dz2, dz, ddx, ddy, rddx, rddy, p1, p2, p3, p4 + integer :: jjjjmmdd, hhmmss + integer :: jrx, jry + real(kind=dp) :: jul + real, parameter :: avog = 6.02214e23 ! Avogadro constant (1/mol) + !! testing +! character(len=4) :: atime +! character(len=20) :: frmt +! real, dimension(nxjr,nyjr) :: jscalar, sza_grid + + !! testing +! jscalar(:,:)=1. +! sza_grid(:,:)=0. + + ! current hour of simulation + curhour=itime/3600 + write(*,*) 'getchemhourly: curhour, curCLhour = ',curhour, curCLhour + + jul=bdate+real(itime,kind=dp)/86400._dp + call caldate(jul,jjjjmmdd,hhmmss) + + if ((ldirect*curCLhour.eq.ldirect*curhour).and.(ldirect*itime.gt.0)) then + ! chemical field is for current hour -> don't do anything + return + else + ! interpolate to middle of hour + curCLhour=curhour + interp_time=curhour*3600+1800 + dt1=float(interp_time-memCLtime(1)) + dt2=float(memCLtime(2)-interp_time) + dtt=1./(dt1+dt2) + !! testing + print*, 'getchemhourly: dt1, dt2, dtt = ',dt1,dt2,dtt + do nr=1,nreagent + write(*,*) 'Interpolating fields for reagent: ',reagents(nr) + clfield_cur(:,:,:,nr)=(dt2*CL_field(:,:,:,nr,1) + dt1*CL_field(:,:,:,nr,2))*dtt + if (reag_unit(nr).eq.'mol/mol') then + ! convert to molecule/cm3 +!$OMP PARALLEL & +!$OMP PRIVATE(kz,ix,jy,indz,indzm,ixm,jym,ixp,jyp,ddx,ddy,rddx,rddy,& +!$OMP p1,p2,p3,p4,r1,ii,dz1,dz2,dz,r) +!$OMP DO + do kz=1,nzCL(nr) + ! assume chem fields vertical coordinate is in meters + indzm=nz-1 + do indz=1,nz + if (height(indz).gt.altCL(kz,nr)) then + indzm=indz-1 + exit + endif + end do + dz1=altCL(kz,nr)-height(indzm) + dz2=height(indz)-altCL(kz,nr) + dz=1./(dz1+dz2) + do jy=1,nyCL(nr) + jym=int((latCL(jy,nr)-ylat0)/dy) + jyp=jym+1 + ddy=(latCL(jy,nr)-ylat0)/dy-real(jym) + rddy=1.-ddy + do ix=1,nxCL(nr) + ixm=int((lonCL(ix,nr)-xlon0)/dx) + ixp=ixm+1 + ddx=(lonCL(ix,nr)-xlon0)/dx-real(ixm) + rddx=1.-ddx + p1=rddx*rddy + p2=ddx*rddy + p3=rddx*ddy + p4=ddx*ddy + !! testing +! if ((ix.lt.5).and.(jy.gt.10.and.jy.lt.20).and.kz.eq.1) then +! print*, 'getchemhourly: lonCL, xlon, latCL, ylat = ',lonCL(ix,nr), xlon0+ixm*dx, latCL(jy,nr), ylat0+jyp*dy +! print*, 'getchemhourly: altCL, height = ',altCL(kz,nr), (dz2*height(indzm)+dz1*height(indzm+1))*dz +! endif + ! take density from first field (accurate enough) + do ii=1,2 + indz=indzm+ii-1 + r1(ii)=p1*rho(ixm,jym,indz,1)+& + p2*rho(ixp,jym,indz,1)+& + p3*rho(ixm,jyp,indz,1)+& + p4*rho(ixp,jyp,indz,1) + end do + r=(dz2*r1(1)+dz1*r1(2))*dz + ! vmr*Avog*P/(RT)/1e6 + ! using P/T = rho*rair + clfield_cur(ix,jy,kz,nr)=clfield_cur(ix,jy,kz,nr)*avog*r*r_air/rgas/1.e6 + end do + end do + end do +!$OMP END DO +!$OMP END PARALLEL + endif + if (reag_hourly(nr).gt.0) then + ! use actinic flux (jrate) for interpolation +!$OMP PARALLEL & +!$OMP PRIVATE(kz,jy,jry,ix,jrx,sza,jrate,jrate_cur) +!$OMP DO + do kz=1,nzCL(nr) + do jy=1,nyCL(nr) + ! jrate_average dimensions given as grid midpoints + jry=int((latCL(jy,nr)-(latjr(1)-0.5*dyjr))/dyjr)+1 + jry=min(jry,nyCL(nr)) + !! testing +! if (kz.eq.1.and.jy.lt.10) print*, 'latCL, latjr = ',latCL(jy), latjr(jry) + do ix=1,nxCL(nr) + ! jrate_average dimensions given as grid midpoints + jrx=int((lonCL(ix,nr)-(lonjr(1)-0.5*dxjr))/dxjr)+1 + jrx=min(jrx,nxCL(nr)) + !! testing +! if (kz.eq.1.and.jy.lt.10.and.ix.lt.10) print*, 'lonCL, lonjr = ',lonCL(ix), lonjr(jrx) + ! solar zenith angle + sza=zenithangle(latjr(jry),lonjr(jrx),jjjjmmdd,hhmmss) + ! calculate J(O1D) (jrate) + jrate=photo_O1D(sza) + jrate_cur=(dt2*jrate_average(jrx,jry,1) + & + dt1*jrate_average(jrx,jry,2))*dtt + ! apply hourly correction to chem field + if(jrate_cur.gt.0.) then + clfield_cur(ix,jy,kz,nr)=clfield_cur(ix,jy,kz,nr)*jrate/jrate_cur + !! testing +! if (kz.eq.1) then +! jscalar(ix,jy)=jrate/jrate_cur +! sza_grid(ix,jy)=sza +! endif + endif + end do + end do + end do +!$OMP END DO +!$OMP END PARALLEL + endif ! reag_hourly + end do ! nreagent + endif ! curhour + + !! testing +! write(frmt,fmt='(A,I4,A)') '(',nxCL,'(E14.6))' +! write(atime,fmt='(I4.4)') curhour +! open(600,file=path(2)(1:length(2))//'clfield_'//atime//'.txt',action='write',status='replace') +! do kz=1,nzCL +! do jy=1,nyCL +! write(600,fmt=frmt) clfield_cur(:,jy,kz,1) +! end do +! end do +! close(600) +! write(frmt,fmt='(A,I4,A)') '(',nxjr,'(E14.6))' +! open(600,file=path(2)(1:length(2))//'jscalar_'//atime//'.txt',action='write',status='replace') +! do jy=1,nyjr +! write(600,fmt=frmt) jscalar(:,jy) +! end do +! close(600) +! write(frmt,fmt='(A,I4,A)') '(',nxjr,'(E14.6))' +! open(600,file=path(2)(1:length(2))//'sza_'//atime//'.txt',action='write',status='replace') +! do jy=1,nyjr +! write(600,fmt=frmt) sza_grid(:,jy) +! end do +! close(600) + + end subroutine getchemhourly + + subroutine chemreaction(itime) + + !***************************************************************************** + ! * + ! This routine computes the chemical loss of each species and updates * + ! the particle mass * + ! * + ! Author: Rona Thompson, Sep 2023 * + ! updated for v11, Jan 2024 * + ! * + !***************************************************************************** + ! * + ! Variables: * + ! itime [s] actual simulation time [s] * + ! * + !***************************************************************************** + + use particle_mod, only: count, part, mass + use point_mod, only: xlon0, ylat0, dx, dy + use windfields_mod, only: xresoln, yresoln, xln, yln, xrn, yrn, height, tt, nz + use omp_lib + + implicit none + + integer :: jpart,itime + integer :: ii,i,j,ks,ix,jy,kz,jrx,jry,nr + integer :: ngrid,interp_time,n,indz + integer :: jjjjmmdd,hhmmss,mm,hh,m1,m2 + integer :: clx,cly,clz,clzm,ithread + real, dimension(nzmax) :: altCLtop + real, dimension(2) :: cl_tmp + real :: xlon,ylat + real :: xtn,ytn + real :: dt1,dt2,dtt,dtt1,dtt2,dttt,dz1,dz2,dzz + real :: restmass,clreacted,cl_cur + real :: jrate,jrate_cur,sza + real :: clrate,temp + real, parameter :: smallnum = tiny(0.0) ! smallest number that can be handled + real(kind=dp) :: jul + real :: lonjrx,latjry +#ifdef _OPENMP + real(kind=dp), allocatable, dimension(:,:,:) :: chem_loss_tmp +#endif + + ! use middle of synchronisation time step + interp_time=nint(itime+0.5*lsynctime) + dtt1=float(interp_time-memtime(1)) + dtt2=float(memtime(2)-interp_time) + dttt=1./(dtt1+dtt2) + + ! initialization + chem_loss(:,:)=0d0 + +#ifdef _OPENMP + allocate( chem_loss_tmp(nreagent,nspec,numthreads) ) + chem_loss_tmp(:,:,:) = 0d0 +#endif + + ! Loop over particles + !***************************************** + +!$OMP PARALLEL & +!$OMP PRIVATE(ii,jpart,ngrid,j,xtn,ytn,ix,jy, & +!$OMP xlon,ylat,clx,cly,clz,clzm,kz,altCLtop,dz1,dz2,dzz,nr,i, & +!$OMP cl_cur,indz,temp,ks,clrate,restmass,clreacted,ithread) + +#ifdef _OPENMP + ithread = OMP_GET_THREAD_NUM()+1 ! Starts with 1 +#else + ithread = 1 +#endif + +!$OMP DO + do ii=1,count%alive + + jpart=count%ialive(ii) + ! Determine which nesting level to be used + ngrid=0 + do j=numbnests,1,-1 ! check if need +/- dxn below + if ((part(jpart)%xlon.gt.xln(j)).and.(part(jpart)%xlon.lt.xrn(j)).and. & + (part(jpart)%ylat.gt.yln(j)).and.(part(jpart)%ylat.lt.yrn(j))) then + ngrid=j + exit + endif + end do + + ! Determine nested grid coordinates + if (ngrid.gt.0) then + xtn=(real(part(jpart)%xlon)-xln(ngrid))*xresoln(ngrid) + ytn=(real(part(jpart)%ylat)-yln(ngrid))*yresoln(ngrid) + ix=int(xtn) + jy=int(ytn) + else + ix=int(part(jpart)%xlon) + jy=int(part(jpart)%ylat) + endif + + ! Get CL from nearest grid-cell for current hour + !*********************************************** + + ! world coordinates + xlon=real(part(jpart)%xlon)*dx+xlon0 + if (xlon.gt.180.) then + xlon=xlon-360. + endif + ylat=real(part(jpart)%ylat)*dy+ylat0 + if (ylat.gt.90.) then + ylat=90. + endif + + do nr=1,nreagent + + ! get position in the chem field + ! assumes chem field dimensions given as grid midpoints + clx=min(nxCL(nr),int((xlon-(lonCL(1,nr)-0.5*dxCL(nr)))/dxCL(nr))+1) + cly=min(nyCL(nr),int((ylat-(latCL(1,nr)-0.5*dyCL(nr)))/dyCL(nr))+1) + + ! get the level of the chem field for the particle + ! z is the z-coord of the trajectory above model orography in metres + ! altCL is the height of the centre of the level in the chem field above orography + do kz=2,nzCL(nr) + altCLtop(kz-1)=altCL(kz-1,nr)+0.5*(altCL(kz,nr)-altCL(kz-1,nr)) + end do + altCLtop(nzCL(nr))=altCL(nzCL(nr),nr)+0.5*(altCL(nzCL(nr),nr)-altCL(nzCL(nr)-1,nr)) + clzm=nzCL(nr)-1 + do clz=1,nzCL(nr) + if (real(part(jpart)%z).lt.altCLtop(clz)) then + clzm=clz-1 + exit + endif + end do + clz=min(nzCL(nr),clz) + if (clzm.eq.0 ) then + dz1=1. + dz2=1. + clzm=clz + else + dz1=real(part(jpart)%z)-altCL(clzm,nr) + dz2=altCL(clz,nr)-real(part(jpart)%z) + endif + if (dz1.eq.(-1.*dz2)) then + dz1=1. + dz2=1. + endif + dzz=1./(dz1+dz2) + + !! testing +! if(ii.lt.100) print*, 'chemreaction: nr, clx, cly, clz, clzm = ',nr, clx, cly, clz, clzm + + ! chem reagent for particle time and location + cl_cur=(dz2*clfield_cur(clx,cly,clzm,nr) + & + dz1*clfield_cur(clx,cly,clz,nr))*dzz + + ! Compute chemical loss + !********************** + + if (cl_cur.gt.smallnum) then + indz=nz + do kz=2,nz + if (height(kz).gt.part(jpart)%z) then + indz=kz-1 + exit + endif + end do + temp=(tt(ix,jy,indz,1)*dtt2 & + + tt(ix,jy,indz,2)*dtt1)*dttt + do ks=1,nspec + if (reaccconst(nr,ks).gt.0.) then + ! k = CT^Nexp(-D/T)[reagent] + clrate=reaccconst(nr,ks)*(temp**reacnconst(nr,ks))*exp(-1.*reacdconst(nr,ks)/temp)*cl_cur + ! new particle mass + restmass=mass(jpart,ks)*exp(-1.*clrate*abs(lsynctime)) + if (restmass.gt.smallnum) then + clreacted=mass(jpart,ks)-restmass + mass(jpart,ks)=restmass + else + clreacted=mass(jpart,ks) + mass(jpart,ks)=0. + endif +#ifdef _OPENMP + chem_loss_tmp(nr,ks,ithread)=chem_loss_tmp(nr,ks,ithread)+real(clreacted,kind=dp) +#else + chem_loss(nr,ks)=chem_loss(nr,ks)+real(clreacted,kind=dp) +#endif + endif + end do ! nspec + endif + + end do ! nreagent + + end do ! loop over all particles +!$OMP END DO + +!$OMP END PARALLEL + +#ifdef _OPENMP + do ithread=1,numthreads + chem_loss(:,:) = chem_loss(:,:)+chem_loss_tmp(:,:,ithread) + end do + deallocate( chem_loss_tmp ) +#endif + + end subroutine chemreaction + + + subroutine readjrate(jr_name,memid,mm) + + !***************************************************************************** + ! * + ! Reads the average actinic flux rates into memory * + ! * + ! Author: Rona Thompson, Sep 2023 * + ! * + !***************************************************************************** + ! * + ! Variables: * + ! * + ! jr_name name of the file * + ! memid time index to chemical field variable * + ! mm month to read * + ! * + !***************************************************************************** + + implicit none + + character(len=256) :: jr_name + integer :: memid,mm + integer :: ncid,dimid,varid + + ! Read netcdf file + !****************** + + ! open file + call nf90_err( nf90_open(trim(jr_name),nf90_NOWRITE,ncid) ) + + ! longitude + call nf90_err( nf90_inq_dimid(ncid,'longitude',dimid) ) + call nf90_err( nf90_inquire_dimension(ncid,dimid,len=nxjr) ) + if (.not.allocated(lonjr)) allocate(lonjr(nxjr)) + call nf90_err( nf90_inq_varid(ncid,'longitude',varid) ) + call nf90_err( nf90_get_var(ncid,varid,lonjr) ) + dxjr=abs(lonjr(2)-lonjr(1)) + + ! latitude + call nf90_err( nf90_inq_dimid(ncid,'latitude',dimid) ) + call nf90_err( nf90_inquire_dimension(ncid,dimid,len=nyjr) ) + if (.not.allocated(latjr)) allocate(latjr(nyjr)) + call nf90_err( nf90_inq_varid(ncid,'latitude',varid) ) + call nf90_err( nf90_get_var(ncid,varid,latjr) ) + dyjr=abs(latjr(2)-latjr(1)) + + ! jrate field + call nf90_err( nf90_inq_varid(ncid,'jrate',varid) ) + if (.not.allocated(jrate_average)) then + allocate(jrate_average(nxjr,nyjr,2)) + endif + call nf90_err( nf90_get_var(ncid,varid,jrate_average(:,:,memid),start=(/1,1,mm/),count=(/nxjr,nyjr,1/)) ) + + ! close file + call nf90_err( nf90_close(ncid) ) + + return + + end subroutine readjrate + + function photo_O1D(sza) result(jrate) + + !***************************************************************************** + ! * + ! Calculates J(O1D) photolysis rate based on solar zenith angle * + ! * + ! Author: A. Stohl, Nov 2014 * + ! * + !***************************************************************************** + ! * + ! INPUT: * + ! sza solar zenith angle (degrees) * + ! * + ! OUTPUT: * + ! photo_O1D J(O1D) photoylsis rate * + ! * + !***************************************************************************** + + implicit none + + real, intent(in) :: sza + real :: jrate + integer :: iz,ik + real :: z1,z2,zg,f1,f2,dummy + real :: photo_NO2 + integer, parameter :: nzenith=11 + real, parameter :: pi=3.1415927 + real, dimension(nzenith) :: zangle,fact_photo + + ! zangle: zenith angles for which fact_photo is tabulated + ! fact_photo: conversion of photolysis rate of NO2 to photolysis + ! rate of O3 into O1D as a function of solar zenith angle + + zangle=(/0.,10.,20.,30.,40.,50.,60.,70.,78.,86.,90.0001/) + fact_photo=(/0.4616E-02,0.4478E-02,0.4131E-02,0.3583E-02,0.2867E-02,& + &0.2081E-02,0.1235E-02,0.5392E-03,0.2200E-03,0.1302E-03,0.0902E-03/) + + if (sza.lt.90.) then + do iz=1,nzenith-1 + if(sza.ge.zangle(iz)) ik=iz + end do + z1=1./cos(zangle(ik)*pi/180.) + z2=1./cos(zangle(ik+1)*pi/180.) + zg=1./cos(sza*pi/180.) + dummy=(zg-z1)/(z2-z1) + f1=alog(fact_photo(ik)) + f2=alog(fact_photo(ik+1)) + photo_NO2=1.45e-2*exp(-0.4/cos(sza*pi/180.)) + jrate=photo_NO2*exp(f1+(f2-f1)*dummy) + else + jrate=0. + endif + + end function photo_O1D + + + function zenithangle(ylat,xlon,jjjjmmdd,hhmmss) result(sza) + + !***************************************************************************** + ! * + ! This function returns the sinus of solar elevation as a function * + ! of geographic longitde, latitude and GMT-Time. * + ! * + ! Author: G. Wotawa, Nov 1993 * + ! * + !***************************************************************************** + ! * + ! INPUT: * + ! * + ! ylat geographical latitude [DEG] * + ! xlon geographical longitude [DEG] * + ! jjjj Year * + ! mm Month * + ! dd Day * + ! hh Hour * + ! minute Minute * + ! * + !***************************************************************************** + + implicit none + + integer, intent(in) :: jjjjmmdd,hhmmss + real, intent(in) :: ylat,xlon + real :: sza + integer :: jjjj,mm,id,iu,minute + integer :: ndaynum + real :: sinsol,solelev + real :: rnum,rylat,ttime,dekl,rdekl,eq + real,parameter :: pi=3.1415927 + + jjjj=jjjjmmdd/10000 + mm=jjjjmmdd/100-jjjj*100 + id=jjjjmmdd-jjjj*10000-mm*100 + iu=hhmmss/10000 + minute=hhmmss/100-100*iu + + ndaynum=31*(mm-1)+id + if(mm.gt.2) ndaynum=ndaynum-int(0.4*mm+2.3) + if((mm.gt.2).and.(jjjj/4*4.eq.jjjj)) ndaynum=ndaynum+1 + + rnum=2.*pi*ndaynum/365. + rylat=pi*ylat/180. + ttime=real(iu)+real(minute)/60. + + dekl=0.396+3.631*sin(rnum)+0.038*sin(2.*rnum)+0.077*sin(3.*rnum)- & + 22.97*cos(rnum)-0.389*cos(2.*rnum)-0.158*cos(3.*rnum) + rdekl=pi*dekl/180. + + eq=(0.003-7.343*sin(rnum)-9.47*sin(2.*rnum)- & + 0.329*sin(3.*rnum)-0.196*sin(4.*rnum)+ & + 0.552*cos(rnum)-3.020*cos(2.*rnum)- & + 0.076*cos(3.*rnum)-0.125*cos(4.*rnum))/60. + sinsol=sin(rylat)*sin(rdekl)+cos(rylat)*cos(rdekl)* & + cos((ttime-12.+xlon/15.+eq)*pi/12.) + ! Calculate the maximum solar elevation on that day + !sinsol=sin(rylat)*sin(rdekl)+cos(rylat)*cos(rdekl)* + ! & cos((eq)*pi/12.) + solelev=asin(sinsol)*180./pi + sza=90.-solelev + + end function zenithangle + + +end module chemistry_mod + diff --git a/src/cmapf_mod.f90 b/src/cmapf_mod.f90 index f5aa61e8eaa2935b8ca1d8a9dc084ff07feda00a..cf2e216c1385b7bdea912094c886e883030984d7 100644 --- a/src/cmapf_mod.f90 +++ b/src/cmapf_mod.f90 @@ -228,7 +228,7 @@ real function cgszll (strcmp, xlat) endif else slat = sin(radpdg * xlat) - ymerc = log((1. + slat) / (1. - slat))/2. + ymerc = log((1. + slat) / (1. - slat))*0.5 !efact = exp(ymerc) !cgszll = 2. * strcmp(7) * exp (strcmp(1) * ymerc) !c / (efact + 1./efact) @@ -270,7 +270,7 @@ real function cgszxy (strcmp, x,y) (1./5. + temp * & (1./7. )))) else - ymerc = - log( 1. - efact ) /2. /strcmp(1) + ymerc = - log( 1. - efact ) *0.5 /strcmp(1) endif if (ymerc .gt. 6.) then if (strcmp(1) .gt. almst1) then @@ -398,7 +398,7 @@ subroutine cnxyll (strcmp, xi,eta, xlat,xlong) (1./7. )))) else ! Code for moderate values of gamma - ymerc = - log ( 1. - arg1 ) /2. / gamma + ymerc = - log ( 1. - arg1 ) *0.5 / gamma endif ! Convert ymerc to latitude temp = exp( - abs(ymerc) ) diff --git a/src/com_mod.f90 b/src/com_mod.f90 index e6d083c50f29c2ac1c56d74b1781ae0eb1519c1f..9e87f459e04518081c5c26f381d6151a950e8086 100644 --- a/src/com_mod.f90 +++ b/src/com_mod.f90 @@ -6,14 +6,18 @@ ! * ! June 1996 * ! * -! Last update:15 August 2013 IP * +! Update: 15 August 2013 IP * +! PS 19 Nov 2020: correct comment about lcw * +! Anne Tipka, Petra Seibert 2021-02: implement new interpolation * +! for precipitation according to #295 using 2 additional fields * ! * !******************************************************************************* module com_mod - use par_mod, only: dp, numpath, maxnests, & - numclass, maxcolumn, maxrand, numwfmem + use par_mod, only: dp, numpath, maxnests, maxndia, & + numclass, maxcolumn, maxrand, numwfmem, numpf, & + maxreagent, maxrecsample implicit none @@ -21,10 +25,12 @@ module com_mod !********************************************************************************** type :: particleoptions character(2) :: name - character(20) :: long_name + character(28) :: long_name + character(7) :: short_name logical :: print logical :: average=.false. integer :: i_average=0 + integer :: ncid end type particleoptions integer :: num_partopt=34 @@ -53,7 +59,7 @@ module com_mod ! Variables defining the general model run specifications !******************************************************** - integer :: ibdate,ibtime,iedate,ietime,itime_init,loutnext_init + integer :: ibdate,ibtime,iedate,ietime,itime_init,loutnext_init,lrecoutnext_init real :: outnum_init real(kind=dp) :: bdate,edate @@ -76,11 +82,15 @@ module com_mod ! ending date (s) integer :: loutstep,loutaver,loutsample,loutrestart,method,lsynctime + integer :: lrecoutstep,lrecoutaver,lrecoutsample real :: outstep ! loutstep [s] gridded concentration output every loutstep seconds ! loutaver [s] concentration output is an average over [s] seconds ! loutsample [s] sampling interval of gridded concentration output + ! lrecoutstep [s] receptor concentration output every loutstep seconds + ! lrecoutaver [s] receptor concentration output is an average over [s] seconds + ! lrecoutsample [s] sampling interval of receptor concentration output ! loutrestart [s] time interval for writing restart files ! lsynctime [s] synchronisation time of all particles ! method indicator which dispersion method is to be used @@ -93,6 +103,7 @@ module com_mod integer :: surf_only ! deprecated logical :: turbswitch integer :: cblflag !added by mc for cbl + logical :: llcmoutput ! ctl factor, by which time step must be smaller than Lagrangian time scale ! ifine reduction factor for time step used for vertical wind @@ -129,6 +140,7 @@ module com_mod ! ind_rel and ind_samp are used within the code to change between mass and mass-mix (see readcommand.f) ! cblflag !: 1 activate cbl skewed pdf routines with bi-gaussina pdf whan OL<0 added by mc + ! llcmoutput switch for LCM output (uses mass ratio of species to air tracer) or normal output integer :: mintime,itsplit @@ -159,24 +171,28 @@ module com_mod ! nageclass number of ageclasses for the age spectra calculation ! lage [s] ageclasses for the age spectra calculation + !ESO: Disable settling if more than 1 species per release point + logical :: lsettling=.true. logical :: gdomainfill ! gdomainfill .T., if domain-filling is global, .F. if not -!ZHG SEP 2015 wheather or not to read clouds from GRIB - logical :: readclouds=.false. -!ESO DEC 2015 whether or not both clwc and ciwc are present (if so they are summed) - logical :: sumclouds=.false. - -!ESO: Disable settling if more than 1 species per release point - logical :: lsettling=.true. + logical :: lcw=.false. ! ZHG Sep 2015 ! AT renamed + ! whether or not cloud water data found in GRIB, overwritten if CW is found - logical,dimension(maxnests) :: readclouds_nest, sumclouds_nest - + logical :: lcwsum=.false. ! ESO Dec 2015 ! AT renamed + ! whether or not both clwc and ciwc are present (if so they are summed) -!NIK 16.02.2015 - integer(selected_int_kind(16)),allocatable,dimension(:) :: & - tot_blc_count,tot_inc_count + logical :: lprecint ! AT, PS 2021 + ! true if new interpolation using additional precip fields is used + + logical,dimension(maxnests) :: lcw_nest=.false. + logical,dimension(maxnests) :: lcwsum_nest=.false. + logical,dimension(maxnests) :: lprecintn + + !NIK 16.02.2015 + integer(selected_int_kind(16)),allocatable,dimension(:) :: icnt_belowcld, & + &icnt_incld !********************************************************************* ! Variables defining the release locations, released species and their @@ -207,11 +223,20 @@ module com_mod real,allocatable,dimension(:,:) :: ri,rac real,allocatable,dimension(:,:,:) :: rcl,rgs,rlu real,allocatable,dimension(:) :: rm,dryvel - real,allocatable,dimension(:) :: ohcconst,ohdconst,ohnconst ! Daria Tatsii: species shape properties real,allocatable,dimension(:) :: Fn,Fs ! Newton and Stokes' regime real,allocatable,dimension(:) :: ks1,ks2,kn2 integer,allocatable,dimension(:) :: ishape,orient + ! chemical reagent variables + character(len=256) :: reag_path(maxreagent) + character(len=16) :: reagents(maxreagent), reag_unit(maxreagent) + integer :: reag_hourly(maxreagent), nreagent + ! reaction rates + real,allocatable,dimension(:,:) :: reaccconst,reacdconst,reacnconst + ! emissions variables for LCM + character(len=256),allocatable,dimension(:) :: emis_path,emis_file,emis_name + integer,allocatable,dimension(:) :: emis_unit + real,allocatable,dimension(:) :: emis_coeff real,allocatable,dimension(:,:) :: area_hour,point_hour real,allocatable,dimension(:,:) :: area_dow,point_dow @@ -337,7 +362,7 @@ module com_mod real :: dxoutn,dyoutn,outlon0n,outlat0n,xoutshiftn,youtshiftn !real outheight(maxzgrid),outheighthalf(maxzgrid) - logical :: DEP,DRYDEP,WETDEP,OHREA,ASSSPEC + logical :: DEP,DRYDEP,WETDEP,CLREA,ASSSPEC,LDECAY,LEMIS logical,allocatable,dimension(:) :: DRYDEPSPEC,WETDEPSPEC logical :: DRYBKDEP,WETBKDEP @@ -357,10 +382,11 @@ module com_mod ! DRYDEPSPEC .true., if dry deposition is switched on for that species ! WETDEP .true., if wet deposition is switched on ! WETDEPSPEC .true., if wet deposition is switched on for that species - ! OHREA .true., if OH reaction is switched on + ! CLREA .true., if chemical reactions is switched on ! ASSSPEC .true., if there are two species asscoiated ! DRYBKDEP,WETBKDEP .true., for bkwd runs, where mass deposited and source regions is calculated - either for dry or for wet deposition ! (i.e. transfer of mass between these two occurs + ! LEMIS .true., if particle mass should change due to surface fluxes ! if output for each releasepoint shall be created maxpointspec=number of releasepoints ! else maxpointspec is 1 -> moved to unc_mod @@ -380,16 +406,40 @@ module com_mod ! Variables defining receptor points !*********************************** - real,allocatable,dimension(:) :: xreceptor,yreceptor - real,allocatable,dimension(:) :: receptorarea - real,allocatable,dimension(:,:) :: creceptor - character(len=16),allocatable,dimension(:) :: receptorname - integer :: numreceptor - - ! xreceptor,yreceptor receptor position - ! creceptor concentrations at receptor points - ! receptorarea area of 1*1 grid cell at receptor point - ! numreceptor number of receptor points + ! general receptors + real, allocatable, dimension(:) :: xreceptor,yreceptor,zreceptor + integer, allocatable, dimension(:) :: treceptor + real, allocatable, dimension(:) :: receptorarea + real, allocatable, dimension(:,:) :: creceptor,crecuncert + real, allocatable, dimension(:) :: xkreceptor,nnreceptor + character(len=16), allocatable, dimension(:) :: receptorname + integer :: cpointer(maxrecsample) + integer :: numreceptor, numcurrec + logical :: lrecregular + + ! satellite receptors + real, allocatable, dimension(:) :: xsatellite,ysatellite + integer, allocatable, dimension(:) :: tsatellite + real, allocatable, dimension(:) :: satellitearea + real, allocatable, dimension(:,:) :: zsatellite + real, allocatable, dimension(:,:,:) :: csatellite, csatuncert + real, allocatable, dimension(:,:) :: xksatellite, nnsatellite + character(len=24), allocatable, dimension(:) :: satellitename + integer :: numsatreceptor, nlayermax, numsatellite, numcursat + integer, allocatable, dimension(:) :: nnsatlayer + integer :: csatpointer(maxrecsample) + + ! xreceptor,yreceptor,zreceptor receptor position + ! creceptor concentrations at receptor points + ! receptorarea area of 1*1 grid cell at receptor point + ! numreceptor number of receptors (non-satellite) + ! numcurrec number of receptors in current time interval (updated each time interval) + ! lrecregular logical if receptor output should be at regular intervals (and not according to RECEPTORS namelist) + ! numsatreceptor number of satellite receptors (aka. retrievals) + ! numcursat number of satellite receptors in current time interval (updated each time interval) + ! numsatellite number of satellite instruments + ! nlayermax max number of vertical layers in satellite retrievals + ! nnsatlayer actual number of vertical layers for each satellite !*************************************** ! Variables characterizing each particle @@ -398,7 +448,7 @@ module com_mod integer :: numpart=0 integer :: numparticlecount integer :: maxspec ! Number of chemical species per release - integer :: maxndia ! Number of diameter bins + !integer :: maxndia ! Number of diameter bins (now set in par_mod.f90) !real, allocatable, dimension(:,:) :: xscav_frac1 !**************************************************************** @@ -518,7 +568,7 @@ module com_mod !LB 04.05.2021, simple timing of IO and total running time !********************************************************* real :: s_readwind=0, s_writepartav=0, s_writepart=0, s_temp=0, s_total=0, s_firstt=0 - + real, parameter :: eta_convert=1000000., zfac=100. contains @@ -527,8 +577,8 @@ contains implicit none integer :: stat - allocate( tot_blc_count(maxspec),tot_inc_count(maxspec),stat=stat) - if (stat.ne.0) error stop "Could not allocate tot_blc_count or tot_inc_count" + allocate( icnt_belowcld(maxspec),icnt_incld(maxspec),stat=stat) + if (stat.ne.0) error stop "Could not allocate cnt_belowcld or icnt_incld" allocate( specnum(maxspec),decay(maxspec),weta_gas(maxspec), & wetb_gas(maxspec),crain_aero(maxspec),csnow_aero(maxspec), & ccn_aero(maxspec),in_aero(maxspec),ndia(maxspec), & @@ -538,8 +588,7 @@ contains allocate( vsetaver(maxspec),cunningham(maxspec), & weightmolar(maxspec),ri(5,numclass),rac(5,numclass), & rcl(maxspec,5,numclass),rgs(maxspec,5,numclass), & - rlu(maxspec,5,numclass),rm(maxspec),dryvel(maxspec), & - ohcconst(maxspec),ohdconst(maxspec),ohnconst(maxspec),stat=stat) + rlu(maxspec,5,numclass),rm(maxspec),dryvel(maxspec),stat=stat) if (stat.ne.0) error stop "Could not allocate particle property arrays 2" allocate( Fn(maxspec),Fs(maxspec),ks1(maxspec),ks2(maxspec), & kn2(maxspec),ishape(maxspec),orient(maxspec),stat=stat) @@ -550,10 +599,11 @@ contains if (stat.ne.0) error stop "Could not allocate species arrays" allocate( DRYDEPSPEC(maxspec),WETDEPSPEC(maxspec),stat=stat) if (stat.ne.0) error stop "Could not allocate DRYDEPSPEC or WETDEPSPEC" - allocate( creceptor(numreceptor,maxspec),stat=stat) - if (stat.ne.0) error stop "Could not allocate creceptor" - tot_blc_count=0 - tot_inc_count=0 +! allocate( creceptor(numreceptor,maxspec),stat=stat) +! if (stat.ne.0) error stop "Could not allocate creceptor" + + icnt_belowcld=0 + icnt_incld=0 end subroutine alloc_com subroutine alloc_com_ndia @@ -565,10 +615,10 @@ contains end subroutine alloc_com_ndia subroutine dealloc_com - deallocate(tot_blc_count,tot_inc_count,specnum,decay,weta_gas,wetb_gas, & + deallocate(icnt_belowcld,icnt_incld,specnum,decay,weta_gas,wetb_gas, & crain_aero,csnow_aero,ccn_aero,in_aero,reldiff,henry,f0,density,dquer, & dsigma,ndia,vsetaver,cunningham,weightmolar,vset,schmi,fract,ri,rac,rcl, & - rgs,rlu,rm,dryvel,ohcconst,ohdconst,ohnconst,Fn,Fs,ks1,ks2,kn2,ishape, & + rgs,rlu,rm,dryvel,Fn,Fs,ks1,ks2,kn2,ishape, & orient,area_hour,point_hour,area_dow,point_dow,species) deallocate(DRYDEPSPEC,WETDEPSPEC) deallocate(creceptor,xreceptor,yreceptor,receptorarea,receptorname) diff --git a/src/conv_mod.f90 b/src/conv_mod.f90 index 065cb2db0524afbbc562a5b452ec5937fd0b376b..b2c7efcf5f5cb390773b266b64bb050b3151bffb 100644 --- a/src/conv_mod.f90 +++ b/src/conv_mod.f90 @@ -165,8 +165,8 @@ subroutine convmix(itime) implicit none - integer :: igr,igrold, ipart, itime, ix, i, j, inest - integer :: ipconv,ithread,stat + integer :: igr,igrold, ipart, itime, ix, i, j, ik, inest + integer :: ipconv,ithread,stat,countconv integer :: jy, kpart, ktop, ngrid,kz integer,allocatable :: igrid(:), ipoint(:), igridn(:,:) @@ -175,7 +175,7 @@ subroutine convmix(itime) ! igridn(maxpart,maxnests) dto. for nested grids ! ipoint(maxpart) pointer to access particles according to grid position - logical :: lconv + logical :: lconv,lcalcflux real :: x, y, xtn,ytn, ztold, delt real :: dt1,dt2,dtt integer :: mind1,mind2 @@ -184,7 +184,7 @@ subroutine convmix(itime) ! OMP changes integer :: cnt,kk - integer,allocatable,dimension(:) :: frst + integer,allocatable,dimension(:) :: frst,kkcnt double precision :: tmarray(2) integer :: alivepart @@ -319,8 +319,16 @@ subroutine convmix(itime) end do frst(cnt) = alivepart+1 + allocate(kkcnt(cnt-1)) + countconv=0 + do kk=1,cnt-1 + if (igrid(frst(kk)).eq.-1) cycle ! Only consider grids that have particles inside + countconv=countconv+1 + kkcnt(countconv)=kk + end do + !$OMP PARALLEL PRIVATE(kk,jy,ix,tmarray,j,kz,ktop,lconv,kpart,ipart,& -!$OMP ztold,nage,ipconv,itage,ithread) +!$OMP ztold,nage,ipconv,itage,ithread,lcalcflux) #if (defined _OPENMP) ithread = OMP_GET_THREAD_NUM()+1 ! Starts at 1 @@ -329,10 +337,10 @@ subroutine convmix(itime) #endif !$OMP DO SCHEDULE(dynamic) - do kk=1,cnt-1 - ! Only consider grids that have particles inside - if (igrid(frst(kk)).eq.-1) cycle - + do ik=1,countconv + + !if (igrid(frst(kk)).eq.-1) cycle + kk=kkcnt(ik) ! Find horizontal location of grid column ix = (igrid(frst(kk))-1)/ny jy = igrid(frst(kk)) - ix*ny - 1 @@ -379,14 +387,21 @@ subroutine convmix(itime) !*************************************************** if (iflux.eq.1) then - itage=abs(itime-part(ipart)%tstart) - nage=1 - do inage=1,nageclass - nage=inage - if ((itage.lt.lage(nage)).or.(.not.part(ipart)%alive)) exit - end do - - if (nage.le.nageclass) & + lcalcflux=.true. + if (lagespectra.eq.1) then + nage=0 + itage=abs(itime-part(ipart)%tstart) + do inage=1,nageclass + if ((itage.lt.lage(inage)).and.(part(ipart)%alive)) exit + nage=inage + end do + if (nage.eq.nageclass) lcalcflux=.false. + nage=nage+1 + else + nage=1 + endif + + if (lcalcflux) & call calcfluxes(itime,nage,ipart,real(part(ipart)%xlon), & real(part(ipart)%ylat),ztold,ithread) endif @@ -423,7 +438,7 @@ subroutine convmix(itime) ! Now visit all grid columns where particles are present ! by going through the sorted particles !$OMP PARALLEL PRIVATE (igrold,kpart,ipart,igr,jy,ix,kz,lconv, & -!$OMP ktop,ztold,nage,ipconv,itage) +!$OMP ktop,ztold,nage,ipconv,itage,lcalcflux) igrold = -1 #if (defined _OPENMP) ithread = OMP_GET_THREAD_NUM()+1 ! Starts at 1 @@ -472,20 +487,25 @@ subroutine convmix(itime) ! Calculate the gross fluxes across layer interfaces !*************************************************** - if (iflux.eq.1) then - itage=abs(itime-part(ipart)%tstart) - nage=1 - do inage=1,nageclass - nage=inage - if ((itage.lt.lage(nage)).or.(.not.part(ipart)%alive)) exit - end do - - if (nage.le.nageclass) & - call calcfluxes(itime,nage,ipart,real(part(ipart)%xlon), & - real(part(ipart)%ylat),ztold,1) + lcalcflux=.true. + if (lagespectra.eq.1) then + nage=0 + itage=abs(itime-part(ipart)%tstart) + do inage=1,nageclass + if ((itage.lt.lage(inage)).and.(part(ipart)%alive)) exit + nage=inage + end do + if (nage.eq.nageclass) lcalcflux=.false. + nage=nage+1 + else + nage=1 + endif + + if (lcalcflux) & + call calcfluxes(itime,nage,ipart,real(part(ipart)%xlon), & + real(part(ipart)%ylat),ztold,ithread) endif - endif !(lconv .eqv. .true.) end do @@ -833,11 +853,9 @@ subroutine redist(itime,ipart,ktop,ipconv,ithread) loop1: do k = 1,nconvtop ! for backward runs use the transposed matrix if (ldirect.eq.1) then - ffraction=ffraction+fmassfrac(levold,k,ithread) & - /totlevmass + ffraction=ffraction+fmassfrac(levold,k,ithread) / totlevmass else - ffraction=ffraction+fmassfrac(k,levold,ithread) & - /totlevmass + ffraction=ffraction+fmassfrac(k,levold,ithread) / totlevmass endif if (rn.le.ffraction) then levnew=k @@ -895,8 +913,10 @@ subroutine redist(itime,ipart,ktop,ipconv,ithread) (tconv(levold,ithread)-tconv(levold-1,ithread)) & *(pconv(levold-1,ithread)-phconv(levold,ithread))/ & (pconv(levold-1,ithread)-pconv(levold,ithread)) - ! Bug fix: Added lsynctime to make units correct - sub_levold = sub(levold,ithread)/(1.-ga*sub(levold,ithread)*lsynctime/dpr(levold,ithread)) + ! LB: the units seem to not add up correctly, but adding lsynctime gives incorrect mixing + ! in the lowest km and too many right above the ground + ! sub_levold = sub(levold,ithread)/(1.-ga*sub(levold,ithread)*lsynctime/dpr(levold,ithread)) + sub_levold = sub(levold,ithread)/(1.-ga*sub(levold,ithread)/dpr(levold,ithread)) wsub(levold,ithread)=-1.*sub_levold*r_air*temp_levold/(phconv(levold,ithread)) else wsub(levold,ithread)=0. @@ -906,8 +926,8 @@ subroutine redist(itime,ipart,ktop,ipconv,ithread) (tconv(levold+1,ithread)-tconv(levold,ithread)) & *(pconv(levold,ithread)-phconv(levold+1,ithread))/ & (pconv(levold,ithread)-pconv(levold+1,ithread)) - ! Bug fix: Added lsynctime to make units correct - sub_levold1 = sub(levold+1,ithread)/(1.-ga*sub(levold+1,ithread)*lsynctime/dpr(levold+1,ithread)) + !sub_levold1 = sub(levold+1,ithread)/(1.-ga*sub(levold+1,ithread)*lsynctime/dpr(levold+1,ithread)) + sub_levold1 = sub(levold+1,ithread)/(1.-ga*sub(levold+1,ithread)/dpr(levold+1,ithread)) wsub(levold+1,ithread)=-1.*sub_levold1*r_air*temp_levold1/ & (phconv(levold+1,ithread)) @@ -951,11 +971,11 @@ subroutine redist(itime,ipart,ktop,ipconv,ithread) !******************************************************* #ifdef ETA - if (part(abs(ipart))%zeta .lt. uvheight(nz)) call set_zeta(ipart,uvheight(nz)+1.e-4) - if (part(abs(ipart))%zeta.ge.1.) call set_zeta(ipart,1.-(part(abs(ipart))%zeta-1.)) - if (part(abs(ipart))%zeta.eq.1.) call update_zeta(ipart,-1.e-4) + if (part(abs(ipart))%zeta .lt. uvheight(nz)) call set_zeta(ipart,uvheight(nz)+1.e-4) + if (part(abs(ipart))%zeta.ge.1.) call set_zeta(ipart,1.-(part(abs(ipart))%zeta-1.)) + if (part(abs(ipart))%zeta.eq.1.) call update_zeta(ipart,-1.e-4) #else - if (part(abs(ipart))%z .gt. height(nz)-0.5) call set_z(ipart,height(nz)-0.5) + if (part(abs(ipart))%z .gt. height(nz)-0.5) call set_z(ipart,height(nz)-0.5) #endif end subroutine redist diff --git a/src/date_mod.f90 b/src/date_mod.f90 index 7e4d80292f17a81ed421c71350c250a817156c7b..ade2aac3748fde7bc29db55d5d185a1fdcb9d6b6 100644 --- a/src/date_mod.f90 +++ b/src/date_mod.f90 @@ -23,6 +23,9 @@ subroutine caldate(juliandate,yyyymmdd,hhmiss) ! * ! AUTHOR: Andreas Stohl (21 January 1994), adapted from Numerical Recipes* ! * + ! PS 2020-07-27: add a check to avoid giving back 240000 for hhmiss * + ! * + ! * ! Variables: * ! dd Day * ! hh Hour * @@ -50,6 +53,7 @@ subroutine caldate(juliandate,yyyymmdd,hhmiss) integer,parameter :: igreg=2299161 julday=int(juliandate) + ! PS check to avoid 240000 as hhmiss: if ((juliandate-julday)*86400._dp .ge. 86399.5_dp) then juliandate = juliandate + juliandate-julday-86399.5_dp/86400._dp julday=int(juliandate) @@ -150,4 +154,48 @@ real(kind=dp) function juldate(yyyymmdd,hhmiss) end function juldate + !***************************************************************************** + ! * + ! Calculates number of days in a month * + ! * + ! Author: Rona Thompson (Sep 2023) * + ! * + ! Variables: * + ! yyyymm year and month * + ! eomday number of days in month (end of month day) * + ! * + !***************************************************************************** + + integer function calceomday(yyyymm) + + integer, intent(in) :: yyyymm + integer :: yyyy,mm + integer, dimension(12) :: leapdays,days + integer :: eomday + + leapdays=(/31,29,31,30,31,30,31,31,30,31,30,31/) + days=(/31,28,31,30,31,30,31,31,30,31,30,31/) + + yyyy=floor(yyyymm/100.) + mm=yyyymm-yyyy*100 + + if((float(yyyy)/100.).eq.float(yyyy/100)) then + if((float(yyyy)/400.).eq.float(yyyy/400)) then + eomday=leapdays(mm) + else + eomday=days(mm) + endif + else + if((float(yyyy)/4.).eq.float(yyyy/4)) then + eomday=leapdays(mm) + else + eomday=days(mm) + endif + endif + + calceomday=eomday + + end function calceomday + + end module date_mod diff --git a/src/drydepo_mod.f90 b/src/drydepo_mod.f90 index 156737b07e2db0af2871212ca6bc486ed16bcc0e..98bf7c653873446964cdff93e2f7911e61257a19 100644 --- a/src/drydepo_mod.f90 +++ b/src/drydepo_mod.f90 @@ -85,16 +85,19 @@ subroutine assignland implicit none - integer :: ix,jy,k,l,li,nrefine,iix,jjy + integer :: ix,jy,k,l,li,nrefine,iix,jjy,stat integer,parameter :: lumaxx=1200,lumaxy=600 integer,parameter :: xlon0lu=-180,ylat0lu=-90 real,parameter :: dxlu=0.3 real :: xlon,ylat,sumperc,p,xi,yj - real :: xlandusep(lumaxx,lumaxy,numclass) + real,allocatable,dimension(:,:,:) :: xlandusep ! character*2 ck if (.not.DRYDEP) return + allocate( xlandusep(lumaxx,lumaxy,numclass), stat=stat) + if (stat.ne.0) error stop "Could not allocate xlandusep in assignland" + do ix=1,lumaxx do jy=1,lumaxy do k=1,numclass @@ -329,12 +332,12 @@ subroutine drydepo_massloss(ipart,ks,ldeltat,drydepopart) else decfact=1. endif - drydepopart=part(ipart)%mass(ks)*part(ipart)%prob(ks)*decfact + drydepopart=mass(ipart,ks)*prob(ipart,ks)*decfact - part(ipart)%drydepo(ks)=part(ipart)%drydepo(ks)+ & - part(ipart)%mass(ks)*part(ipart)%prob(ks)*decfact + drydeposit(ipart,ks)=drydeposit(ipart,ks)+ & + mass(ipart,ks)*prob(ipart,ks)*decfact - part(ipart)%mass(ks)=part(ipart)%mass(ks)*(1.-part(ipart)%prob(ks))*decfact + mass(ipart,ks)=mass(ipart,ks)*(1.-prob(ipart,ks))*decfact if (decay(ks).gt.0.) then ! correct for decay (see wetdepo) drydepopart=drydepopart*exp(real(abs(ldeltat))*decay(ks)) @@ -717,7 +720,7 @@ subroutine part0(dquer,dsigma,density,ni,fract,schmi,cun,vsh) !stop 'part0' end subroutine part0 -subroutine get_vdep_prob(itime,xt,yt,zt,prob,ithread) +subroutine get_vdep_prob(itime,xt,yt,zt,tmpprob,ithread) ! i i i i o !***************************************************************************** ! * @@ -750,7 +753,7 @@ subroutine get_vdep_prob(itime,xt,yt,zt,prob,ithread) real,intent(in) :: xt,yt,zt integer,intent(in) :: itime,ithread !ithread starting at 1 - real,intent(out) :: prob(maxspec) + real,intent(out) :: tmpprob(maxspec) integer :: ks,m,memindnext!nix,njy, real :: vdepo(maxspec),vdeptemp(2) real :: eps @@ -760,7 +763,7 @@ subroutine get_vdep_prob(itime,xt,yt,zt,prob,ithread) if (DRYDEP) then ! reset probability for deposition do ks=1,nspec depoindicator(ks,ithread)=.true. - prob(ks)=0. + tmpprob(ks)=0. end do endif @@ -806,7 +809,7 @@ subroutine get_vdep_prob(itime,xt,yt,zt,prob,ithread) ! correction by Petra Seibert, 10 April 2001 ! this formulation means that prob(n) = 1 - f(0)*...*f(n) ! where f(n) is the exponential term - prob(ks)=vdepo(ks) + tmpprob(ks)=vdepo(ks) ! prob(ks)=vdepo(ks)/2./href ! instead of prob - return vdepo -> result kg/m2/s endif @@ -814,16 +817,17 @@ subroutine get_vdep_prob(itime,xt,yt,zt,prob,ithread) endif end subroutine get_vdep_prob -subroutine drydepo_probability(prob,dt,zts,vdepo,ithread) +subroutine drydepo_probability(ipart,dt,zts,vdepo,ithread) use par_mod use com_mod use interpol_mod + use particle_mod implicit none integer,intent(in) :: ithread ! OMP thread starting at 1 - real,intent(inout) :: prob(maxspec) - real,intent(inout) :: vdepo(maxspec) ! deposition velocities for all species + integer,intent(in) :: ipart ! particle index + real,intent(out) :: vdepo(maxspec) ! deposition velocities for all species real,intent(in) :: dt,zts ! real(ldt), real(zt) integer :: ns,m ! loop variable over species real :: vdeptemp(2) @@ -846,7 +850,7 @@ subroutine drydepo_probability(prob,dt,zts,vdepo,ithread) ! correction by Petra Seibert, 10 April 2001 ! this formulation means that prob(n) = 1 - f(0)*...*f(n) ! where f(n) is the exponential term - prob(ns)=1.+(prob(ns)-1.)*exp(-vdepo(ns)*abs(dt)/(2.*href)) + prob(ipart,ns)=1.+(prob(ipart,ns)-1.)*exp(-vdepo(ns)*abs(dt)/(2.*href)) !if (pp.eq.535) write(*,*) 'advance1', ks,dtt,p1,vdep(ix,jy,ks,1) endif end do @@ -902,7 +906,7 @@ subroutine getvdep(n,ix,jy,ust,temp,pa,L,gr,rh,rr,snow,vdepo) ylat=jy*dy+ylat0 if (ylat.lt.0) then - jul=jul+365/2 + jul=jul+365.*0.5 endif @@ -1089,7 +1093,7 @@ subroutine getvdep_nest(n,ix,jy,ust,temp,pa, & ylat=jy*dy+ylat0 if (ylat.lt.0) then - jul=jul+365/2 + jul=jul+365.*0.5 endif @@ -1300,11 +1304,35 @@ subroutine partdep(nc,density,fract,schmi,vset,ra,ustar,nyl,rhoa,vdep_tmp) do j=1,ndia(ic) ! loop over all diameter intervals if (ustar.gt.eps) then if (ishape(ic).eq.0) then - + + reynolds=dquer(ic)/1.e6*vset(ic,j)/nyl + settling_old=-1.0*vset(ic,j) + + do i=1,20 + + if (reynolds.le.0.02) then + c_d=(24.0/reynolds) + + else ! Clif and Gauvin scheme is used + c_d=(24.0/reynolds)*(1+0.15*(reynolds**0.687))+ & + 0.42/(1.0+42500.0/(reynolds**1.16)) + endif + + + ! Settling velocity of a particle is defined by the Newton's impact law: + settling=-1.* & + sqrt(4.*ga*dquer(ic)/1.e6*density(ic)*cunningham(ic)/ & + (3.*c_d*rhoa)) + + if (abs((settling-settling_old)/settling).lt.0.01) exit + reynolds=dquer(ic)/1.e6*abs(settling)/nyl + settling_old=settling + end do + ! Stokes number for each diameter interval !***************************************** ! Use this stokes number for different shapes - stokes=vset(ic,j)/ga*ustar*ustar/nyl + stokes=abs(settling)/ga*ustar*ustar/nyl alpha=-3./stokes ! Deposition layer resistance @@ -1316,7 +1344,7 @@ subroutine partdep(nc,density,fract,schmi,vset,ra,ustar,nyl,rhoa,vdep_tmp) rdp=1./((schmi(ic,j)+10.**alpha)*ustar) endif - vdepj=vset(ic,j)+1./(ra+rdp+ra*rdp*vset(ic,j)) + vdepj=abs(settling)+1./(ra+rdp+ra*rdp*abs(settling)) else ! Daria Tatsii: Drag coefficient scheme by Bagheri & Bonadonna 2016 ! Settling velocities of other shapes @@ -1345,8 +1373,8 @@ subroutine partdep(nc,density,fract,schmi,vset,ra,ustar,nyl,rhoa,vdep_tmp) alpha1=0.45+10.0/(exp(2.5*log10(dfdr))+30.0) beta1=1.-37.0/(exp(3.0*log10(dfdr))+100.0) kn1=10.**(alpha1*(-log10(Fn(ic)))**beta1) - ks=(ks1(ic)+ks2(ic))/2. - kn=(kn1+kn2(ic))/2. + ks=(ks1(ic)+ks2(ic))*0.5 + kn=(kn1+kn2(ic))*0.5 endif do i=1,20 diff --git a/src/emissions_mod.f90 b/src/emissions_mod.f90 new file mode 100644 index 0000000000000000000000000000000000000000..60656c8f5f9ae57fcfc018fc90de75a166204a5d --- /dev/null +++ b/src/emissions_mod.f90 @@ -0,0 +1,832 @@ +! SPDX-FileCopyrightText: FLEXPART 1998-2019, see flexpart_license.txt +! SPDX-License-Identifier: GPL-3.0-or-later + +module emissions_mod + + !***************************************************************************** + ! * + ! This module contains variables and subroutines for injecting mass * + ! into particles based on gridded emissions estimates * + ! * + !***************************************************************************** + + use par_mod + use com_mod + use point_mod, only: xlon0, ylat0, dx, dy, npart + use particle_mod + use date_mod + use totals_mod, only: tot_em_up, tot_em_field, tot_em_res + use netcdf + use netcdf_output_mod, only: nf90_err + + implicit none + + real, parameter :: tau_em_r=4000. ! time scale of residual emission release (s) + real, parameter :: tau_ipm=900. ! time scale of micro mixing (s) + logical, parameter :: ABLMIX=.true. ! mass exchange for particles in same PBL grid cell + + integer :: nxem, nyem + real :: dxem, dyem + integer, dimension(2) :: em_memtime + real, allocatable, dimension(:,:,:,:) :: em_field ! emission fields all species + real, allocatable, dimension(:) :: lonem, latem ! emission field lon and lat + real, allocatable, dimension(:,:,:) :: em_res ! residual emissions + real, allocatable, dimension(:,:,:) :: mass_field + real, allocatable, dimension(:,:) :: em_area ! area for emissions grid + integer, allocatable, dimension(:,:) :: nn_field + real(kind=dp), dimension(2) :: em_time + character(len=32), allocatable, dimension(:) :: emf_name + + contains + + subroutine emissions(itime) + + !***************************************************************************** + ! * + ! This subroutine calculates the fraction of emission to be released * + ! in each timestep and adds this mass to the particles in the PBL * + ! * + ! Author: S. Henne, Mar-2009 * + ! Adapted by R. Thompson for v10.4, Oct-2023 * + ! * + !***************************************************************************** + + use windfields_mod, only: hmix + use omp_lib + + implicit none + + integer :: itime + real :: xlon,ylat + integer :: ix, jy, ixp, jyp, ii, ks, em_ix, em_jy, ithread + real :: dt1,dt2,dtt,ddx,ddy,rddx,rddy,p1,p2,p3,p4,dz1,dz2,dz + real :: em_dt1, em_dt2, em_dtt + real, dimension(2) :: hm + real :: hmixi + real :: tmp, max_val, em_cur + logical, dimension(npart(1)) :: em_cond + integer :: mm + character(len=20) :: frmt + real :: em_frac + real, allocatable, dimension(:,:,:) :: em_neg + real, allocatable, dimension(:,:) :: tot_em_up_tmp + real, allocatable, dimension(:,:,:,:) :: mass_field_tmp, em_neg_tmp + real :: f_m + logical :: lexist +! integer, parameter :: unittest=120 + + + ! fraction of stored emissions that is released in a time step + em_frac = 1. - exp(-1.*real(lsynctime)/tau_em_r) + + ! distance of emission fields in memory from current time + em_dt1 = float(itime-em_memtime(1)) + em_dt2 = float(em_memtime(2)-itime) + em_dtt = 1./(em_dt1+em_dt2) + + ! determine temporal distances for interpolation of meteo fields + dt1=float(itime-memtime(1)) + dt2=float(memtime(2)-itime) + dtt=1./(dt1+dt2) + + tot_em_up(:) = 0. + + ! estimate mass in PBL from particle positions + !********************************************** + + mass_field(:,:,:) = 0. + allocate( em_neg(nspec-1,nxem,nyem) ) +#if _OPENMP + allocate( mass_field_tmp(nspec,nxem,nyem,numthreads)) + allocate( em_neg_tmp(nspec-1,nxem,nyem,numthreads)) + allocate( tot_em_up_tmp(nspec,numthreads) ) + mass_field_tmp(:,:,:,:) = 0. + em_neg_tmp(:,:,:,:) = 0. + tot_em_up_tmp(:,:) = 0. +#endif + tot_em_up(:) = 0. + mass_field(:,:,:) = 0. + em_neg(:,:,:) = 0. + +!$OMP PARALLEL & +!$OMP PRIVATE(ii,xlon,ylat,em_ix,em_jy,ix,jy,ixp,jyp,ddx,ddy, & +!$OMP rddx,rddy,p1,p2,p3,p4,mm,hm,hmixi,ks,ithread) + +#ifdef _OPENMP + ithread = OMP_GET_THREAD_NUM()+1 ! Starts with 1 +#else + ithread = 1 +#endif + +!$OMP DO + do ii=1,count%alive ! loop over all particles + + xlon=xlon0+part(ii)%xlon*dx + ylat=ylat0+part(ii)%ylat*dy + + ! assume emission dimensions given as grid midpoints + em_ix=min(nxem, int((xlon-(lonem(1)-0.5*dxem))/dxem)+1) + em_jy=min(nyem, int((ylat-(latem(1)-0.5*dyem))/dyem)+1) + !! testing +! if (ii.lt.20) print*, 'lonem, lon, latem, lat = ',lonem(em_ix),xlon,latem(em_jy),ylat + + ! interpolate to particle position + ix=int(part(ii)%xlon) + jy=int(part(ii)%ylat) + ixp=ix+1 + jyp=jy+1 + ddx=part(ii)%xlon-float(ix) + ddy=part(ii)%ylat-float(jy) + rddx=1.-ddx + rddy=1.-ddy + p1=rddx*rddy + p2=ddx*rddy + p3=rddx*ddy + p4=ddx*ddy + + do mm=1,2 + ! PBL height at particle position + hm(mm)=p1*hmix(ix,jy ,1,memind(mm)) + & + p2*hmix(ixp,jy ,1,memind(mm)) + & + p3*hmix(ix ,jyp,1,memind(mm)) + & + p4*hmix(ixp,jyp,1,memind(mm)) + end do + hmixi=(hm(1)*dt2+hm(2)*dt1)*dtt + ! set minimum PBL height to dampen day/night amplitude of emission + hmixi=max(hmixi,hmixmin) + + ! determine if particle is in PBL + em_cond(ii) = part(ii)%z.le.hmixi + + if (em_cond(ii)) then +#ifdef _OPENMP + mass_field_tmp(1:nspec,em_ix,em_jy,ithread)= & + mass_field_tmp(1:nspec,em_ix,em_jy,ithread) + & + mass(ii,1:nspec) +#else + mass_field(1:nspec,em_ix,em_jy)=mass_field(1:nspec,em_ix,em_jy) + & + mass(ii,1:nspec) +#endif + endif + + end do ! end of particle loop +!$OMP END DO +!$OMP END PARALLEL + +#ifdef _OPENMP + ! manual reduction of mass_field + do ithread=1,numthreads + mass_field(:,:,:) = mass_field(:,:,:)+mass_field_tmp(:,:,:,ithread) + end do +#endif + + f_m = exp(-1.*real(lsynctime)/tau_ipm) + + ! estimate emissions for each particle + !************************************** + +!$OMP PARALLEL & +!$OMP PRIVATE(ii,xlon,ylat,em_ix,em_jy, & +!$OMP ks,em_cur,tmp,ithread) + +#ifdef _OPENMP + ithread = OMP_GET_THREAD_NUM()+1 ! Starts with 1 +#else + ithread = 1 +#endif + +!$OMP DO + do ii=1,count%alive ! loop over particles + + if (.not.em_cond(ii)) cycle ! skip particles not in PBL + + xlon=xlon0+part(ii)%xlon*dx + ylat=ylat0+part(ii)%ylat*dy + ! assume emission dimensions given as grid midpoints + em_ix=min(nxem, int((xlon-(lonem(1)-0.5*dxem))/dxem)+1) + em_jy=min(nyem, int((ylat-(latem(1)-0.5*dyem))/dyem)+1) + + ! loop over species + ! skip species 1 as it is always air tracer with no emission + do ks=2,nspec + em_cur=(em_field(ks-1,em_ix,em_jy,1)*em_dt2 + & + em_field(ks-1,em_ix,em_jy,2)*em_dt1)*em_dtt + tmp=(em_cur*real(lsynctime) + em_res(ks-1,em_ix,em_jy)*em_frac ) * & + mass(ii,1)/mass_field(1,em_ix,em_jy) + + ! micro mixing scheme executed before new emissions are taken up + !***************************************************************** + if (ABLMIX) then + mass(ii,ks)=mass(ii,1) * & + (f_m * mass(ii,ks)/mass(ii,1) + & + (1.-f_m) * mass_field(ks,em_ix,em_jy)/mass_field(1,em_ix,em_jy)) + endif + + ! deal with negative emissions + if (tmp.lt.0.) then + if (-1.*tmp.gt.mass(ii,ks)) then + tmp = tmp + mass(ii,ks) + ! subtract mass from atmosphere by setting it to zero below +#ifdef _OPENMP + tot_em_up_tmp(ks,ithread) = tot_em_up_tmp(ks,ithread) - real(mass(ii,ks),kind=dp) +#else + tot_em_up(ks) = tot_em_up(ks) - real(mass(ii,ks),kind=dp) +#endif + mass(ii,ks) = 0. + ! add remaining uptake to em_neg +#ifdef _OPENMP + em_neg_tmp(ks-1,em_ix,em_jy,ithread) = em_neg_tmp(ks-1,em_ix,em_jy,ithread) + & + tmp/mass(ii,1)*mass_field(1,em_ix,em_jy) +#else + em_neg(ks-1, em_ix, em_jy) = em_neg(ks-1, em_ix, em_jy) + & + tmp/mass(ii,1)*mass_field(1,em_ix,em_jy) +#endif + else + mass(ii,ks)=mass(ii,ks)+tmp +#ifdef _OPENMP + tot_em_up_tmp(ks,ithread) = tot_em_up_tmp(ks,ithread) + real(tmp,kind=dp) +#else + tot_em_up(ks) = tot_em_up(ks) + real(tmp,kind=dp) +#endif + endif + else + mass(ii,ks)=mass(ii,ks)+tmp +#ifdef _OPENMP + tot_em_up_tmp(ks,ithread) = tot_em_up_tmp(ks,ithread) + real(tmp,kind=dp) +#else + tot_em_up(ks) = tot_em_up(ks) + real(tmp,kind=dp) +#endif + endif ! negative emissions + + end do ! nspec + + end do ! loop over particles +!$OMP END DO + + ! loop over grid points to update residual emissions + ! skip species 1 as it is always air tracer + !*************************************************** + +!$OMP DO + do jy=1,nyem + do ix=1,nxem + do ks=2,nspec + if (mass_field(1,ix,jy).eq.0.) then + em_cur=(em_field(ks-1,ix,jy,1)*em_dt2 + & + em_field(ks-1,ix,jy,2)*em_dt1)*em_dtt + em_res(ks-1,ix,jy)=em_res(ks-1,ix,jy) + & + em_cur*real(lsynctime) + else + em_res(ks-1,ix,jy)=(1.-em_frac) * em_res(ks-1,ix,jy) + endif + end do + end do + end do +!$OMP END DO +!$OMP END PARALLEL + + ! manual reduction of em_neg and tot_em_up +#ifdef _OPENMP + do ithread=1,numthreads + em_neg(:,:,:) = em_neg(:,:,:)+em_neg_tmp(:,:,:,ithread) + tot_em_up(:) = tot_em_up(:) + tot_em_up_tmp(:,ithread) + end do + deallocate( mass_field_tmp, em_neg_tmp, tot_em_up_tmp ) +#endif + + ! update for negative emissions + em_res(:,:,:) = em_res(:,:,:)+em_neg(:,:,:) + deallocate(em_neg) + + ! calculate total emission flux and field +!$OMP PARALLEL IF(nspec>99) PRIVATE(ks) +!$OMP DO + do ks=2,nspec + tot_em_field(ks)=sum((em_field(ks-1,:,:,1)*em_dt2 + & + em_field(ks-1,:,:,2)*em_dt1)*em_dtt)*real(lsynctime) + tot_em_res(ks)=sum(em_res(ks-1,:,:)) + end do +!$OMP END DO +!$OMP END PARALLEL + + !! test +! inquire(file=path(2)(1:length(2))//'mass_field.txt',exist=lexist) +! write(*,*) 'emissions: lexist = ',lexist +! if (lexist) then +! open(unittest,file=path(2)(1:length(2))//'mass_field.txt',ACCESS='APPEND',STATUS='OLD') +! else +! open(unittest,file=path(2)(1:length(2))//'mass_field.txt',STATUS='NEW') +! endif +! write(frmt, '(A, I4, A)') '(', nxem, 'E12.3)' +! do jy=1,nyem-1 +! write(unittest,frmt) (mass_field(2,ix,jy),ix=1,nxem) +! end do +! close(unittest) + !! + + end subroutine emissions + + subroutine getemissions(itime) + + !***************************************************************************** + ! * + ! This subroutine checks which emission fields need to be read and * + ! interpolates these to the current time step * + ! * + ! Author: Rona Thompson, Oct-2023 * + ! * + !***************************************************************************** + + implicit none + + integer :: itime + real(kind=dp) :: julstart, jd, jdmid + integer :: jjjjmmdd, hhmmss, dd, mm, yyyy + integer :: nn, ks, eomday, memid + character(len=4) :: ayear + character(len=2) :: amonth, aday + character(len=256) :: em_name, file_name, strtmp1, strtmp2 + logical :: lexist + + + ! Check fields are available for the current time step + !***************************************************** + + if ((ldirect*em_memtime(1).le.ldirect*itime).and. & + (ldirect*em_memtime(2).gt.ldirect*itime)) then + + ! The rightfields are already in memory -> don't do anything + return + + else if ((ldirect*em_memtime(2).le.ldirect*itime).and. & + (em_memtime(2).ne.0.)) then + + ! Current time is after 2nd field + !********************************* + + ! update dates of emission fields + em_memtime(1)=em_memtime(2) ! time in sec + em_time(1)=em_time(2) ! julian date + memid=2 + + ! julian date of next emission field assuming monthly fields + call caldate(em_time(1), jjjjmmdd, hhmmss) + eomday=calceomday(jjjjmmdd/100) + em_memtime(2)=em_memtime(1)+ldirect*eomday*24*3600 ! time in sec + em_time(2)=em_time(1)+real(ldirect*eomday,kind=dp) ! julian date + call caldate(em_time(2), jjjjmmdd,hhmmss) + yyyy=jjjjmmdd/10000 + mm=(jjjjmmdd-yyyy*10000)/100 + dd=jjjjmmdd-yyyy*10000-mm*100 + write(amonth,'(I2.2)') mm + write(aday,'(I2.2)') dd + write(ayear,'(I4)') yyyy + + ! skip species 1 as is always air tracer with no emissions +!$OMP PARALLEL IF(nspec>99) & +!$OMP PRIVATE(ks,file_name,nn,strtmp1,strtmp2,julstart,em_name,lexist) +!$OMP DO + do ks=2,nspec + + write(*,*) 'Updating emission fields for: ',trim(species(ks)) + + em_field(ks-1,:,:,1)=em_field(ks-1,:,:,2) + + ! Read new emission field and store in 2nd position + !*************************************************** + + ! TO DO: make more general to fit any field frequency + + file_name=emis_file(ks) + nn=index(file_name,'YYYY',back=.false.) + if (nn.ne.0) then + strtmp1=file_name(1:nn-1) + nn=index(file_name,'YYYY',back=.true.) + strtmp2=file_name(nn+4:len_trim(file_name)) + file_name=trim(strtmp1)//ayear//trim(strtmp2) + julstart=juldate((jjjjmmdd/10000)*10000+101,0) + endif + nn=index(file_name,'MM',back=.false.) + if (nn.ne.0) then + strtmp1=file_name(1:nn-1) + nn=index(file_name,'MM',back=.true.) + strtmp2=file_name(nn+2:len_trim(file_name)) + file_name=trim(strtmp1)//amonth//trim(strtmp2) + julstart=juldate((jjjjmmdd/100)*100+1,0) + endif + nn=index(file_name,'DD',back=.false.) + if (nn.ne.0) then + strtmp1=file_name(1:nn-1) + nn=index(file_name,'DD',back=.true.) + strtmp2=file_name(nn+2:len_trim(file_name)) + file_name=trim(strtmp1)//aday//trim(strtmp2) + julstart=juldate(jjjjmmdd,0) + endif + + em_name=trim(emis_path(ks))//trim(file_name) + inquire(file=em_name,exist=lexist) + if (lexist) then + write(*,*) 'Reading emissions field: ',trim(em_name) + call reademissions(em_name, julstart, itime, memid, ks-1) + else + write(*,*) '#### FLEXPART ERROR ####' + write(*,*) '#### EMISSION FIELD NOT FOUND ####' + write(*,*) '#### '//trim(em_name)//' ####' + error stop + endif + + end do ! nspec +!$OMP END DO +!$OMP END PARALLEL + + else + + ! No emission field in memory that can be used + !********************************************** + + ! read both fields into memory + do memid=1,2 + + if (memid.eq.1) then + jd=bdate+real(ldirect*itime,kind=dp)/86400._dp + call caldate(jd, jjjjmmdd, hhmmss) + ! middle of month day + jdmid=juldate(int(jjjjmmdd/100)*100+15,0) + if (jd.ge.jdmid) then + ! use current month + em_time(memid)=jdmid + else + ! use last month + eomday=calceomday(jjjjmmdd/100) + em_time(memid)=jdmid-real(eomday,kind=dp) + endif + else + call caldate(jd, jjjjmmdd, hhmmss) + eomday=calceomday(jjjjmmdd/100) + em_time(memid)=em_time(memid-1)+real(ldirect*eomday,kind=dp) + endif + em_memtime(memid)=int((em_time(memid)-bdate)*86400._dp) + + write(*,*) 'getemissions: memid, em_time = ',memid, em_time(memid) + write(*,*) 'getemissions: memid, em_memtime = ',memid, em_memtime(memid) + + call caldate(em_time(memid), jjjjmmdd, hhmmss) + yyyy=jjjjmmdd/10000 + mm=(jjjjmmdd-yyyy*10000)/100 + dd=jjjjmmdd-yyyy*10000-mm*100 + write(amonth,'(I2.2)') mm + write(aday,'(I2.2)') dd + write(ayear,'(I4)') yyyy + +!$OMP PARALLEL IF(nspec>99) & +!$OMP PRIVATE(ks,file_name,nn,strtmp1,strtmp2,julstart,em_name,lexist) +!$OMP DO + do ks=2,nspec + + write(*,*) 'Reading two new emission fields for: ',trim(species(ks)) + + ! TO DO: make more general to fit any field frequency + + file_name=emis_file(ks) + nn=index(file_name,'YYYY',back=.false.) + if (nn.ne.0) then + strtmp1=file_name(1:nn-1) + nn=index(file_name,'YYYY',back=.true.) + strtmp2=file_name(nn+4:len_trim(file_name)) + file_name=trim(strtmp1)//ayear//trim(strtmp2) + julstart=juldate((jjjjmmdd/10000)*10000+101,0) + endif + nn=index(file_name,'MM',back=.false.) + if (nn.ne.0) then + strtmp1=file_name(1:nn-1) + nn=index(file_name,'MM',back=.true.) + strtmp2=file_name(nn+2:len_trim(file_name)) + file_name=trim(strtmp1)//amonth//trim(strtmp2) + julstart=juldate((jjjjmmdd/100)*100+1,0) + endif + nn=index(file_name,'DD',back=.false.) + if (nn.ne.0) then + strtmp1=file_name(1:nn-1) + nn=index(file_name,'DD',back=.true.) + strtmp2=file_name(nn+2:len_trim(file_name)) + file_name=trim(strtmp1)//aday//trim(strtmp2) + julstart=juldate(jjjjmmdd,0) + endif + + em_name=trim(emis_path(ks))//trim(file_name) + inquire(file=em_name,exist=lexist) + if (lexist) then + write(*,*) 'Reading emissions field: ',trim(em_name) + call reademissions(em_name, julstart, itime, memid, ks-1) + else + write(*,*) '#### FLEXPART ERROR ####' + write(*,*) '#### EMISSION FIELD NOT FOUND ####' + write(*,*) '#### '//trim(em_name)//' ####' + error stop + endif + + end do ! nspec +!$OMP END DO +!$OMP END PARALLEL + + end do ! memid + + endif ! update fields + + + end subroutine getemissions + + + subroutine reademissions(em_name, julstart, itime, memid, kk) + + !***************************************************************************** + ! * + ! This subroutine reads the emission fields * + ! * + ! Author: Rona Thompson, Oct-2023 * + ! * + !***************************************************************************** + + implicit none + + character(len=256) :: em_name, unitinfo + integer :: memid, kk, itime + real(kind=dp) :: julstart, jtime + integer :: jjjjmmdd, ihmmss, mm + integer :: nn, ntem, len, ix, jy + integer :: ncid, dimid, varid, ndim, nvar, natt, xtype, indxt, unlimid + real :: ylatp, ylatm, hzone, cosfactm, cosfactp + real :: sclfact, offset + integer, dimension(:), allocatable :: dimids + real(kind=dp), dimension(:), allocatable :: jdate + real, dimension(:), allocatable :: time + real, dimension(:,:), allocatable :: emis + character(len=32) :: dimname, nameout, attname + + ! current time in julian days + jtime=real(itime,kind=dp)/86400._dp+bdate + + ! Read netcdf file + !****************** + + ! open file + call nf90_err( nf90_open(trim(em_name),nf90_NOWRITE,ncid) ) + + ! inquire about dims and vars + call nf90_err( nf90_inquire( ncid, ndim, nvar, natt, unlimid ) ) + allocate(dimids(ndim)) + + if (.not.allocated(lonem)) then + ! read dimension info + do nn=1,ndim + call nf90_err( nf90_inquire_dimension( ncid, nn, dimname, len ) ) + if ((index(dimname,'lon').ne.0).or.(index(dimname,'LON').ne.0) & + .or.(index(dimname,'Lon').ne.0)) then + ! longitude + nxem=len + allocate( lonem(nxem) ) + call nf90_err( nf90_inq_varid(ncid,trim(dimname),varid) ) + call nf90_err( nf90_get_var(ncid,varid,lonem) ) + dxem=abs(lonem(2)-lonem(1)) + endif + if ((index(dimname,'lat').ne.0).or.(index(dimname,'LAT').ne.0) & + .or.(index(dimname,'Lat').ne.0)) then + ! latitude + nyem=len + allocate( latem(nyem) ) + call nf90_err( nf90_inq_varid(ncid,trim(dimname),varid) ) + call nf90_err( nf90_get_var(ncid,varid,latem) ) + dyem=abs(latem(2)-latem(1)) + endif + end do ! ndim + ! check dimensions read correctly + if (.not.allocated(lonem)) then + write(*,*) 'ERROR in reademissions: longitude dimension not found in file: '//trim(em_name) + error stop + endif + if (.not.allocated(latem)) then + write(*,*) 'ERROR in reademissions: latitude dimension not found in file: '//trim(em_name) + error stop + endif + ! allocate emission variables + allocate( em_field(nspec-1,nxem,nyem,2) ) + em_field(:,:,:,:)=0. + allocate( em_res(nspec-1,nxem,nyem) ) + if (ipin.eq.2) then + ! read residual emissions from end of previous run + write(*,*) 'Reading residual emissions from previous run' + call em_res_read + else + em_res(:,:,:)=0. + endif + allocate( mass_field(nspec,nxem,nyem) ) + mass_field(:,:,:)=0. + ! calculate area for emissions grid + allocate( em_area(nxem,nyem) ) + if (emis_unit(kk+1).eq.1) then + ! emissions given per sqm + do jy=1,nyem + ylatp=latem(jy)+0.5*abs(latem(2)-latem(1)) + ylatm=latem(jy)-0.5*abs(latem(2)-latem(1)) + if ((ylatm.lt.0).and.(ylatp.gt.0.)) then + hzone=abs(latem(2)-latem(1))*r_earth*pi180 + else + cosfactp=cos(ylatp*pi180) + cosfactm=cos(ylatm*pi180) + if (cosfactp.lt.cosfactm) then + hzone=sqrt(1-cosfactp**2)-sqrt(1-cosfactm**2) + hzone=hzone*r_earth + else + hzone=sqrt(1-cosfactm**2)-sqrt(1-cosfactp**2) + hzone=hzone*r_earth + endif + endif + em_area(:,jy)=pi180*r_earth*hzone*abs(lonem(2)-lonem(1)) + end do ! nyem + else + ! emissions given per gridcell + em_area(:,:)=1. + endif + endif + + ! read time dimension + do nn=1,ndim + call nf90_err( nf90_inquire_dimension( ncid, nn, dimname, len ) ) + if ((index(dimname,'time').ne.0).or.(index(dimname,'Time').ne.0).or. & + (index(dimname,'TIME').ne.0).or.(index(dimname,'Date').ne.0).or. & + (index(dimname,'date').ne.0).or.(index(dimname,'DATE').ne.0)) then + ntem=len + allocate( time(ntem), jdate(ntem) ) + call nf90_err( nf90_inq_varid(ncid,trim(dimname),varid) ) + call nf90_err( nf90_get_var(ncid,varid,time) ) + call nf90_err( nf90_get_att(ncid,varid,'units',unitinfo) ) + write(*,*) 'Time units: ',trim(unitinfo) + if (index(unitinfo,'sec').ne.0) then + ! seconds + jdate=real(time-time(1),kind=dp)/3600._dp/24._dp+julstart + indxt=minloc(abs(jdate-jtime),dim=1) + else if (index(unitinfo,'hour').ne.0) then + ! hours + jdate=real(time-time(1),kind=dp)/24._dp+julstart + indxt=minloc(abs(jdate-jtime),dim=1) + else if (index(unitinfo,'day').ne.0) then + ! days + jdate=real(time-time(1),kind=dp)+julstart + indxt=minloc(abs(jdate-jtime),dim=1) + else if (index(unitinfo,'month').ne.0) then + ! months + call caldate(jtime,jjjjmmdd,ihmmss) + mm=jjjjmmdd/10000 + indxt=minloc(abs(time-mm),dim=1) + else + write(*,*) 'ERROR in reademissions: unknown time units in file: '//trim(em_name) + error stop + endif + deallocate( time, jdate ) + exit + endif + end do ! ndim + + ! emission field + allocate( emis(nxem,nyem) ) + write(*,*) 'Reading emissions for species '//trim(species(kk+1)) + call nf90_err( nf90_inq_varid(ncid,trim(emis_name(kk+1)),varid) ) + call nf90_err( nf90_inquire_variable(ncid,varid,nameout,xtype,ndim,dimids,natt) ) + sclfact=1. + offset=0. + if (natt.gt.0 ) then + do nn=1,natt + call nf90_err( nf90_inq_attname(ncid,varid,nn,attname) ) + if (index(attname,'add_offset').ne.0) then + call nf90_err( nf90_get_att(ncid,varid,'add_offset',offset) ) + else if (index(attname,'scale_factor').ne.0) then + call nf90_err( nf90_get_att(ncid,varid,'scale_factor',sclfact) ) + endif + end do + endif + if (ndim.eq.2) then + call nf90_err( nf90_get_var(ncid,varid,emis) ) + else if (ndim.eq.3) then + write(*,*) 'reademissions: time index in file = ',indxt + call nf90_err( nf90_get_var(ncid,varid,emis,start=(/1,1,indxt/),count=(/nxem,nyem,1/)) ) + endif + emis=emis*sclfact+offset + !! test + print*, 'reademissions: sclfact, offset = ',sclfact, offset + print*, 'reademissions: range(emis) = ',minval(emis), maxval(emis) + print*, 'reademissions: range(em_area) = ',minval(em_area), maxval(em_area) + print*, 'reademissions: emis_coeff, emis_unit = ',emis_coeff(kk+1), emis_unit(kk+1) + print*, 'reademissions: emis total = ',sum(emis*em_area*emis_coeff(kk+1))*3600.*24.*365./1.e9 + em_field(kk,:,:,memid)=emis*em_area*emis_coeff(kk+1) + + ! close file + call nf90_err( nf90_close(ncid) ) + + deallocate(emis) + + return + + end subroutine reademissions + + subroutine em_res_write() + + !***************************************************************************** + ! * + ! This subroutine outputs the residual emissions to be used if * + ! picking up a run from where this one left off (ipin = 1) * + ! * + ! Author: R. Thompson, Oct-2023 * + ! * + !***************************************************************************** + + implicit none + + character(len=256) :: file_name + integer :: nc_id, londim_id, latdim_id, specdim_id, nchardim_id + integer :: spec_id, lon_id, lat_id, emres_id + + file_name=trim(path(2)(1:length(2)))//'emis_residual.nc' + + call nf90_err( nf90_create(trim(file_name), nf90_clobber, ncid=nc_id) ) + + ! define dimensions + call nf90_err( nf90_def_dim(nc_id, 'species', nspec-1, specdim_id) ) + call nf90_err( nf90_def_dim(nc_id, 'longitude', nxem, londim_id) ) + call nf90_err( nf90_def_dim(nc_id, 'latitude', nyem, latdim_id) ) + call nf90_err( nf90_def_dim(nc_id, 'nchar', 18, nchardim_id) ) + + ! define variables + call nf90_err( nf90_def_var(nc_id, 'species', nf90_char, (/ nchardim_id, specdim_id /), spec_id) ) + call nf90_err( nf90_put_att(nc_id, spec_id, 'long_name', 'Species names') ) + call nf90_err( nf90_def_var(nc_id, 'longitude', nf90_float, (/ londim_id /), lon_id) ) + call nf90_err( nf90_put_att(nc_id, lon_id, 'units', 'degrees') ) + call nf90_err( nf90_def_var(nc_id, 'latitude', nf90_float, (/ latdim_id /), lat_id) ) + call nf90_err( nf90_put_att(nc_id, lat_id, 'units', 'degrees') ) + call nf90_err( nf90_def_var(nc_id, 'em_res', nf90_double, (/ specdim_id, londim_id, latdim_id /), emres_id) ) + call nf90_err( nf90_put_att(nc_id, emres_id, 'long_name', 'Emission residuals') ) + call nf90_err( nf90_put_att(nc_id, emres_id, 'units', 'kg') ) + + call nf90_err( nf90_enddef(nc_id) ) + + ! write variables + call nf90_err( nf90_put_var(nc_id, spec_id, species(2:nspec)) ) + call nf90_err( nf90_put_var(nc_id, lon_id, lonem) ) + call nf90_err( nf90_put_var(nc_id, lat_id, latem) ) + call nf90_err( nf90_put_var(nc_id, emres_id, em_res) ) + + call nf90_err( nf90_close(nc_id) ) + + end subroutine em_res_write + + subroutine em_res_read() + + !***************************************************************************** + ! * + ! This subroutine reads the residual emissions from a previous run * + ! which have to be copied into the output directory of this run * + ! * + ! Author: R. Thompson, Oct-2023 * + ! * + !***************************************************************************** + + implicit none + + character(len=256) :: file_name + integer :: nc_id, specdim_id, londim_id, latdim_id, emres_id + integer :: xlen, ylen, splen + logical :: lexist + + file_name=trim(path(2)(1:length(2)))//'emis_residual.nc' + + inquire(file=trim(file_name),exist=lexist) + if (.not.lexist) then + write(*,*) 'FLEXPART ERROR: cannot find file '//trim(file_name) + error stop + endif + + call nf90_err( nf90_open(file_name, nf90_nowrite, nc_id) ) + + ! read dimensions + call nf90_err( nf90_inq_dimid(nc_id, 'longitude', londim_id) ) + call nf90_err( nf90_inquire_dimension(nc_id, londim_id, len=xlen) ) + call nf90_err( nf90_inq_dimid(nc_id, 'latitude', latdim_id) ) + call nf90_err( nf90_inquire_dimension(nc_id, latdim_id, len=ylen) ) + call nf90_err( nf90_inq_dimid(nc_id, 'species', specdim_id) ) + call nf90_err( nf90_inquire_dimension(nc_id, specdim_id, len=splen) ) + + ! check dimensions match input emissions + if ((xlen.ne.nxem).or.(ylen.ne.nyem).or.(splen.ne.(nspec-1))) then + write(*,*) 'FLEXPART ERROR: emis_residual dimensions do not match input emissions' + error stop + endif + + ! read em_res + call nf90_err( nf90_inq_varid(nc_id, 'em_res', emres_id) ) + call nf90_err( nf90_get_var(nc_id, emres_id, em_res) ) + + call nf90_err( nf90_close(nc_id) ) + + end subroutine em_res_read + + +end module emissions_mod diff --git a/src/flux_mod.f90 b/src/flux_mod.f90 index 360a22fe7e14bb102621fbacfde6946295b4b998..acaad622f7241f59419fcc6cad5315c265fabec2 100644 --- a/src/flux_mod.f90 +++ b/src/flux_mod.f90 @@ -78,8 +78,8 @@ subroutine calcfluxes(itime,nage,jpart,xold,yold,zold,thread) #ifdef ETA call update_zeta_to_z(itime,jpart) #endif - xmean=(xold+real(part(jpart)%xlon))/2. - ymean=(yold+real(part(jpart)%ylat))/2. + xmean=(xold+real(part(jpart)%xlon))*0.5 + ymean=(yold+real(part(jpart)%ylat))*0.5 ixave=int((xmean*dx+xoutshift)/dxout) jyave=int((ymean*dy+youtshift)/dyout) @@ -108,22 +108,22 @@ subroutine calcfluxes(itime,nage,jpart,xold,yold,zold,thread) #ifdef _OPENMP flux_omp(5,ixave,jyave,kz,k,kp,nage,thread)= & flux_omp(5,ixave,jyave,kz,k,kp,nage,thread)+ & - part(jpart)%mass(k) + mass(jpart,k) #else flux(5,ixave,jyave,kz,k,kp,nage)= & flux(5,ixave,jyave,kz,k,kp,nage)+ & - part(jpart)%mass(k) + mass(jpart,k) #endif end do do kz=k2,k1-1 #ifdef _OPENMP flux_omp(6,ixave,jyave,kz,k,kp,nage,thread)= & flux_omp(6,ixave,jyave,kz,k,kp,nage,thread)+ & - part(jpart)%mass(k) + mass(jpart,k) #else flux(6,ixave,jyave,kz,k,kp,nage)= & flux(6,ixave,jyave,kz,k,kp,nage)+ & - part(jpart)%mass(k) + mass(jpart,k) #endif end do end do @@ -138,7 +138,7 @@ subroutine calcfluxes(itime,nage,jpart,xold,yold,zold,thread) ! 1) Particle does not cross domain boundary - if (abs(xold-part(jpart)%xlon).lt.real(nx)/2.) then + if (abs(xold-part(jpart)%xlon).lt.real(nx)*0.5) then ix1=int((xold*dx+xoutshift)/dxout+0.5) ix2=int((part(jpart)%xlon*dx+xoutshift)/dxout+0.5) do k=1,nspec @@ -147,11 +147,11 @@ subroutine calcfluxes(itime,nage,jpart,xold,yold,zold,thread) #ifdef _OPENMP flux_omp(1,ix,jyave,kzave,k,kp,nage,thread)= & flux_omp(1,ix,jyave,kzave,k,kp,nage,thread) & - +part(jpart)%mass(k) + +mass(jpart,k) #else flux(1,ix,jyave,kzave,k,kp,nage)= & flux(1,ix,jyave,kzave,k,kp,nage) & - +part(jpart)%mass(k) + +mass(jpart,k) #endif endif end do @@ -160,11 +160,11 @@ subroutine calcfluxes(itime,nage,jpart,xold,yold,zold,thread) #ifdef _OPENMP flux_omp(2,ix,jyave,kzave,k,kp,nage,thread)= & flux_omp(2,ix,jyave,kzave,k,kp,nage,thread) & - +part(jpart)%mass(k) + +mass(jpart,k) #else flux(2,ix,jyave,kzave,k,kp,nage)= & flux(2,ix,jyave,kzave,k,kp,nage) & - +part(jpart)%mass(k) + +mass(jpart,k) #endif endif end do @@ -182,11 +182,11 @@ subroutine calcfluxes(itime,nage,jpart,xold,yold,zold,thread) #ifdef _OPENMP flux_omp(1,ixs,jyave,kzave,k,kp,nage,thread)= & flux_omp(1,ixs,jyave,kzave,k,kp,nage,thread) & - +part(jpart)%mass(k) + +mass(jpart,k) #else flux(1,ixs,jyave,kzave,k,kp,nage)= & flux(1,ixs,jyave,kzave,k,kp,nage) & - +part(jpart)%mass(k) + +mass(jpart,k) #endif end do else ! east-west flux @@ -194,11 +194,11 @@ subroutine calcfluxes(itime,nage,jpart,xold,yold,zold,thread) #ifdef _OPENMP flux_omp(2,ixs,jyave,kzave,k,kp,nage,thread)= & flux_omp(2,ixs,jyave,kzave,k,kp,nage,thread) & - +part(jpart)%mass(k) + +mass(jpart,k) #else flux(2,ixs,jyave,kzave,k,kp,nage)= & flux(2,ixs,jyave,kzave,k,kp,nage) & - +part(jpart)%mass(k) + +mass(jpart,k) #endif end do endif @@ -221,11 +221,11 @@ subroutine calcfluxes(itime,nage,jpart,xold,yold,zold,thread) #ifdef _OPENMP flux_omp(3,ixave,jy,kzave,k,kp,nage,thread)= & flux_omp(3,ixave,jy,kzave,k,kp,nage,thread) & - +part(jpart)%mass(k) + +mass(jpart,k) #else flux(3,ixave,jy,kzave,k,kp,nage)= & flux(3,ixave,jy,kzave,k,kp,nage) & - +part(jpart)%mass(k) + +mass(jpart,k) #endif endif end do @@ -234,11 +234,11 @@ subroutine calcfluxes(itime,nage,jpart,xold,yold,zold,thread) #ifdef _OPENMP flux_omp(4,ixave,jy,kzave,k,kp,nage,thread)= & flux_omp(4,ixave,jy,kzave,k,kp,nage,thread) & - +part(jpart)%mass(k) + +mass(jpart,k) #else flux(4,ixave,jy,kzave,k,kp,nage)= & flux(4,ixave,jy,kzave,k,kp,nage) & - +part(jpart)%mass(k) + +mass(jpart,k) #endif endif end do diff --git a/src/getfields_mod.f90 b/src/getfields_mod.f90 index 3f691ccc0731a52ef1ac80c656a63719add07f0b..2e256233c3acceb73c971be7b170691f5f3d0063 100644 --- a/src/getfields_mod.f90 +++ b/src/getfields_mod.f90 @@ -155,6 +155,7 @@ subroutine getfields(itime,nstop) return endif + if ((ldirect*memtime(1).le.ldirect*itime).and. & (ldirect*memtime(2).gt.ldirect*itime)) then @@ -166,7 +167,6 @@ subroutine getfields(itime,nstop) else if ((ldirect*memtime(2).le.ldirect*itime).and. & (memtime(2).ne.999999999)) then - ! Current time is after 2nd wind field ! -> Resort wind field pointers, so that current time is between 1st and 2nd !*************************************************************************** @@ -235,7 +235,7 @@ subroutine getfields(itime,nstop) !$OMP END PARALLEL endif else - + ! No wind fields, which can be used, are currently in memory ! -> read both wind fields !*********************************************************** @@ -256,11 +256,13 @@ subroutine getfields(itime,nstop) call readwind_nest(indj,memind(1),uuhn,vvhn,wwhn) call calcpar(memind(1)) call calcpar_nest(memind(1)) + if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then call verttransform_ecmwf(memind(1),uuh,vvh,wwh,pvh) else call verttransform_gfs(memind(1),uuh,vvh,wwh,pvh) end if + call verttransform_nest(memind(1),uuhn,vvhn,wwhn,pvhn) memtime(1)=wftime(indj) memind(2)=2 @@ -373,10 +375,16 @@ subroutine calcpv(n) !$OMP ixvp,ixvm,jumpx,ivrp,ivrm,jux,theta,klvrp,klvrm,klpt,thetap,thetam,dthetadp, & !$OMP ii,i,ivr,kdn,kch,kup,thdn,thup,dt1,dt2,dt,vx,k,dvdx, & !$OMP jj,j,uy,dudy) -!$OMP DO +!$OMP DO SCHEDULE(dynamic,1) do jy=0,nymin1 if (sglobal.and.jy.eq.0) cycle if (nglobal.and.jy.eq.nymin1) cycle + + ! do kl=1,nuvz + ! ppml(0:nxmin1,jy,kl)=akz(kl)+bkz(kl)*ps(0:nxmin1,jy,1,n) + ! ppmk(0:nxmin1,jy,kl)=(100000./ppml(0:nxmin1,jy,kl))**kappa + ! end do + phi = (ylat0 + jy * dy) * pi / 180. f = 0.00014585 * sin(phi) tanphi = tan(phi) @@ -880,7 +888,7 @@ subroutine calcpar(n) ! * ! 21 May 1995 * ! * - ! ------------------------------------------------------------------ * + !***************************************************************************** ! Petra Seibert, Feb 2000: * ! convection scheme: * ! new variables in call to richardson * @@ -895,7 +903,9 @@ subroutine calcpar(n) ! - Merged calcpar and calcpar_gfs into one routine using if-then * ! for meteo-type dependent code * !***************************************************************************** - + ! Changes Anne Tipka June 2023: * + ! sum up precipitation fields over number of available fields in a single * + ! time interval (newWetDepoScheme) * !***************************************************************************** ! * ! Variables: * @@ -1053,7 +1063,7 @@ subroutine calcpar(n) call getvdep(n,ix,jy,ustar(ix,jy,1,n), & tt2(ix,jy,1,n),ps(ix,jy,1,n),1./oli(ix,jy,1,n), & - ssr(ix,jy,1,n),rh,lsprec(ix,jy,1,n)+convprec(ix,jy,1,n), & + ssr(ix,jy,1,n),rh,sum(lsprec(ix,jy,1,:,n))+sum(convprec(ix,jy,1,:,n)), & sd(ix,jy,1,n),vd) do i=1,nspec @@ -1153,7 +1163,7 @@ subroutine calcpar_nest(n) ! * ! 8 February 1999 * ! * - ! ------------------------------------------------------------------ * + !***************************************************************************** ! Petra Seibert, Feb 2000: * ! convection scheme: * ! new variables in call to richardson * @@ -1165,6 +1175,10 @@ subroutine calcpar_nest(n) ! Unified ECMWF and GFS builds * ! Marian Harustak, 12.5.2017 * !***************************************************************************** + ! Changes Anne Tipka June 2023: * + ! sum up precipitation fields over number of available fields in a single * + ! time interval (newWetDepoScheme) * + !***************************************************************************** ! * ! Variables: * ! n temporal index for meteorological fields (1 to 3) * @@ -1295,8 +1309,8 @@ subroutine calcpar_nest(n) call getvdep_nest(n,ix,jy,ustarn(ix,jy,1,n,l), & tt2n(ix,jy,1,n,l),psn(ix,jy,1,n,l),1./olin(ix,jy,1,n,l), & - ssrn(ix,jy,1,n,l),rh,lsprecn(ix,jy,1,n,l)+ & - convprecn(ix,jy,1,n,l),sdn(ix,jy,1,n,l),vd,l) + ssrn(ix,jy,1,n,l),rh,sum(lsprecn(ix,jy,1,:,n,l))+ & + sum(convprecn(ix,jy,1,:,n,l)),sdn(ix,jy,1,n,l),vd,l) do i=1,nspec vdepn(ix,jy,i,n,l)=vd(i) @@ -1426,8 +1440,8 @@ real function obukhov(ps,tsfc,tdsfc,tlev,ustar,hf,akm,bkm,plev) tv=tsfc*(1.+0.378*e/ps) ! virtual temperature rhoa=ps/(r_air*tv) ! air density if (metdata_format.eq.GRIBFILE_CENTRE_ECMWF) then - ak1=(akm(1)+akm(2))/2. - bk1=(bkm(1)+bkm(2))/2. + ak1=(akm(1)+akm(2))*0.5 + bk1=(bkm(1)+bkm(2))*0.5 plev=ak1+bk1*ps ! Pressure level 1 end if theta=tlev*(100000./plev)**(r_air/cpa) ! potential temperature diff --git a/src/initdomain_mod.f90 b/src/initdomain_mod.f90 new file mode 100644 index 0000000000000000000000000000000000000000..059f29ff052936a025ab5eb9eb9e8d3165f86fde --- /dev/null +++ b/src/initdomain_mod.f90 @@ -0,0 +1,1137 @@ +! SPDX-FileCopyrightText: FLEXPART 1998-2019, see flexpart_license.txt +! SPDX-License-Identifier: GPL-3.0-or-later + +module initdomain_mod + + !***************************************************************************** + ! * + ! This module contains variables and subroutines for initializing * + ! particles and their mass for global domain-filling runs * + ! * + !***************************************************************************** + + use netcdf + use par_mod + use com_mod + + implicit none + + integer, allocatable, dimension(:) :: specnini ! spec number in initial fields info + integer, allocatable, dimension(:) :: nxini ! number grid cells longitude + integer, allocatable, dimension(:) :: nyini ! number grid cells latitude + integer, allocatable, dimension(:) :: nzini ! number grid cell vertical + real, allocatable, dimension(:,:) :: lonini ! longitudes of initial fields + real, allocatable, dimension(:,:) :: latini ! latitudes of initial fields + real, allocatable, dimension(:) :: dxini, dyini ! longitude, latitude resolution of initial fields + real, allocatable, dimension(:,:) :: altini ! altitudes of initial fields + real, allocatable, dimension(:,:,:,:) :: prsini ! pressure of initial fields + real, allocatable, dimension(:,:,:,:) :: gridini ! initial mixing ratios (dry air, ppbv) + + contains + + subroutine readgridini(ks, lexist) + + !****************************************************************************** + ! * + ! Reads mixing ratios from a netcdf file with general format * + ! * + ! Author: Rona Thompson, Sep-2023 * + ! * + !****************************************************************************** + ! * + ! Variables: * + ! ks relative number of species * + ! lexist logical to indicate if INITCONC file specified * + ! * + !****************************************************************************** + + use date_mod + use windfields_mod, only: nxmax,nymax,nzmax + use netcdf_output_mod, only: nf90_err + + implicit none + + integer :: ks + logical :: lexist + integer :: ninit + integer, dimension(:), allocatable :: specnum_rel + character(len=256) :: path_name, file_name, unitinfo, strtmp1, strtmp2, nameout + character(len=10) :: var_name, hya_name, hyb_name, ps_name, prs_name, q_name, alt_name + real :: coeff + integer :: readerror + integer :: ncid, dimid, varid, ndim, nvar, natt, unlimid, ndims, xtype, natts, len + integer :: yyyymmdd, hhmiss, yyyy, mm + integer, dimension(:), allocatable :: dimids + character(len=256) :: dimname, attname + character(len=2) :: amonth + character(len=4) :: ayear + integer :: nn, indxn, ntini, indxt, ix, jy, kz + real, dimension(:), allocatable :: time, hya, hyb + real, dimension(:,:), allocatable :: psurf + real, dimension(:,:,:), allocatable :: shumid, pw + real(kind=dp) :: julstart + real(kind=dp), dimension(:), allocatable :: jdate + real :: sclfact, offset + logical :: lfexist + integer,parameter :: unitinitconc=103, unitinitconcout=104 + + ! declare namelists + namelist /initconc_ctrl/ & + ninit, & + specnum_rel + + namelist /initconc/ & + path_name, file_name, var_name, & + hya_name, hyb_name, & + ps_name, q_name, & + prs_name, alt_name, & + coeff + + ! Read initconc input info + ! ************************ + + allocate(specnum_rel(maxspec)) + + ! presetting namelist initconc_ctrl + ninit = -1 ! use negative value to determine failed namelist input + specnum_rel(:) = 0 + + ! read initconc_ctrl to find how many fields are specified + open(unitinitconc,file=path(1)(1:length(1))//'INITCONC',status='old',form='formatted',iostat=readerror) + if (readerror.ne.0) then + write(*,*) 'WARNING: cannot open file INITCONC' + write(*,*) 'Trying to initialize using latitude profiles' + lexist=.false. + return + endif + + ! check if namelist input provided + read(unitinitconc,initconc_ctrl,iostat=readerror) + if (readerror.ne.0 ) then + write(*,*) 'ERROR in readgridini: cannot read INITCONC namelist' + error stop + endif + write(*,*) 'ninit, specnum = ',ninit, specnum_rel + + ! namelist output + if (nmlout.and.lroot) then + inquire(file=path(2)(1:length(2))//'INITCONC.namelist',exist=lfexist) + if (lfexist) then + open(unitinitconcout,file=path(2)(1:length(2))//'INITCONC.namelist',status='old',& + access='append',iostat=readerror) + else + open(unitinitconcout,file=path(2)(1:length(2))//'INITCONC.namelist',status='new',& + iostat=readerror) + endif + if (readerror.ne.0) then + write(*,*) 'ERROR in readgridini: file INITCONC cannot be opened' + write(*,*) 'in the directory',path(2)(1:length(2)) + error stop + endif + if (.not.lfexist) then + ! write this only once + write(unitinitconcout,nml=initconc_ctrl) + endif + endif + + ! allocate variables used for initial mixing ratios + if (.not.allocated(gridini)) then + allocate( nxini(ninit), nyini(ninit), nzini(ninit) ) + allocate( dxini(ninit), dyini(ninit) ) + allocate( lonini(nxmax,ninit), latini(nymax,ninit), altini(nzmax,ninit) ) + allocate( prsini(nxmax,nymax,nzmax,ninit), gridini(nxmax,nymax,nzmax,ninit) ) + allocate( specnini(ninit) ) + nxini(:)=0 + nyini(:)=0 + nzini(:)=0 + lonini(:,:)=0. + latini(:,:)=0. + altini(:,:)=0. + prsini(:,:,:,:)=0. + gridini(:,:,:,:)=0. + specnini(:)=specnum_rel(1:ninit) + endif + + ! presetting namelist initconc + path_name="" + file_name="" + var_name="" + hya_name="" + hyb_name="" + ps_name="" + q_name="" + prs_name="" + alt_name="" + coeff=-1. + + ! read initconc file info + do nn=1,ninit + read(unitinitconc,initconc,iostat=readerror) + if (readerror.ne.0) then + write(*,*) 'ERROR in readgridini: cannot read file info for ',specnum_rel(nn) + error stop + endif + if (specnum_rel(nn).eq.specnum(ks)) then + indxn=nn ! index to gridini for this species + exit + endif + end do + + ! namelist output + if (nmlout.and.lroot) then + write(unitinitconcout,nml=initconc) + endif + + write(*,*) 'readgridini: path, filename, varname = ',path_name,file_name,var_name + write(*,*) 'readgridini: specnum_rel(indxn), specnum(ks), indxn = ',specnum_rel(indxn), specnum(ks), indxn + + close(unitinitconc) + close(unitinitconcout) + + ! get file name for current year and month + call caldate(bdate,yyyymmdd,hhmiss) + yyyy=yyyymmdd/10000 + mm=(yyyymmdd-(yyyymmdd/10000)*10000)/100 + write(ayear,'(I4)') yyyy + write(amonth,'(I2.2)') mm + nn=index(file_name,'YYYY',back=.false.) + if (nn.ne.0) then + strtmp1=file_name(1:nn-1) + nn=index(file_name,'YYYY',back=.true.) + strtmp2=file_name(nn+4:len_trim(file_name)) + file_name=trim(strtmp1)//ayear//trim(strtmp2) + julstart=juldate((yyyymmdd/10000)*10000+101,0) + endif + nn=index(file_name,'MM',back=.false.) + if (nn.ne.0) then + strtmp1=file_name(1:nn-1) + nn=index(file_name,'MM',back=.true.) + strtmp2=file_name(nn+2:len_trim(file_name)) + file_name=trim(strtmp1)//amonth//trim(strtmp2) + julstart=juldate((yyyymmdd/100)*100+1,0) + endif + write(*,*) 'readgridini: julstart = ',julstart + write(*,*) 'readgridini: initial mixing ratio file to read: '//trim(path_name)//trim(file_name) + + ! check file exists + inquire(file=trim(path_name)//trim(file_name), exist=lexist) + if (.not.lexist) then + write(*,*) 'ERROR readgridini: file not found: '//trim(path_name)//trim(file_name) + error stop + endif + + ! Read netcdf file + !****************** + + ! open file + call nf90_err( nf90_open( trim(path_name)//trim(file_name), nf90_nowrite, ncid ) ) + + ! inquire about dims and vars + call nf90_err( nf90_inquire( ncid, ndim, nvar, natt, unlimid ) ) + write(*,*) 'ndim, nvar:', ndim, nvar + allocate(dimids(ndim)) + + ! read dimension info + !******************** + do nn=1,ndim + call nf90_err( nf90_inquire_dimension( ncid, nn, dimname, len ) ) + if ((index(dimname,'lon').ne.0).or.(index(dimname,'LON').ne.0) & + .or.(index(dimname,'Lon').ne.0)) then + if (len.gt.nxmax) then + write(*,*) 'ERROR in readgridini: length longitude exceeds nxmax' + error stop + endif + nxini(indxn)=len + call nf90_err( nf90_inq_varid(ncid,trim(dimname),varid) ) + call nf90_err( nf90_get_var(ncid,varid,lonini(1:nxini(indxn),indxn)) ) + dxini(indxn)=abs(lonini(2,indxn)-lonini(1,indxn)) + else if ((index(dimname,'lat').ne.0).or.(index(dimname,'LAT').ne.0) & + .or.(index(dimname,'Lat').ne.0)) then + if (len.gt.nymax) then + write(*,*) 'ERROR in readgridini: length latitude exceeds nymax' + error stop + endif + nyini(indxn)=len + call nf90_err( nf90_inq_varid(ncid,trim(dimname),varid) ) + call nf90_err( nf90_get_var(ncid,varid,latini(1:nyini(indxn),indxn)) ) + dyini(indxn)=abs(latini(2,indxn)-latini(1,indxn)) + else if (((index(dimname,'lev').ne.0).or.(index(dimname,'LEV').ne.0) & + .or.(index(dimname,'Lev').ne.0)).and.(index(dimname,'hlevel').eq.0)) then + if (len.gt.nzmax) then + write(*,*) 'ERROR in readgridini: length vertical coord exceeds nzmax' + error stop + endif + nzini(indxn)=len + else if ((index(dimname,'time').ne.0).or.(index(dimname,'Time').ne.0) & + .or.(index(dimname,'Date').ne.0).or.(index(dimname,'date').ne.0)) then + ntini=len + allocate( time(ntini), jdate(ntini) ) + call nf90_err( nf90_inq_varid(ncid,trim(dimname),varid) ) + call nf90_err( nf90_get_var(ncid,varid,time) ) + call nf90_err( nf90_get_att(ncid,varid,'units',unitinfo) ) + write(*,*) 'Time units: ',trim(unitinfo) + if (index(unitinfo,'sec').ne.0) then + jdate=real(time-time(1),kind=dp)/3600._dp/24._dp+julstart + indxt=minloc(abs(jdate-bdate),dim=1) + else if (index(unitinfo,'hour').ne.0) then + jdate=real(time-time(1),kind=dp)/24._dp+julstart + indxt=minloc(abs(jdate-bdate),dim=1) + else if (index(unitinfo,'day').ne.0) then + jdate=real(time-time(1),kind=dp)+julstart + indxt=minloc(abs(jdate-bdate),dim=1) + else if (index(unitinfo,'month').ne.0) then + indxt=minloc(abs(time-mm),dim=1) + else + write(*,*) 'ERROR in readgridini: unknown time units in file: '//trim(path_name)//trim(file_name) + error stop + endif + write(*,*) 'readgridini: time index in file = ',indxt + deallocate( time, jdate ) + endif + enddo + + if ((nxini(indxn).eq.0).or.(nyini(indxn).eq.0)) then + write(*,*) 'ERROR in reagridini: unable to find lat and lon dimensions in file: '//trim(path_name)//trim(file_name) + error stop + endif + write(*,*) 'readgridini: nxini(indxn), nyini(indxn), nzini(indxn) = ',nxini(indxn), nyini(indxn), nzini(indxn) + write(*,*) 'readgridini: lonini(1:nxini(indxn),indxn) = ',lonini(1:nxini(indxn),indxn) + write(*,*) 'readgridini: latini(1:nyini(indxn),indxn) = ',latini(1:nyini(indxn),indxn) + + ! read vertical coordinates + !************************** + if ((alt_name.eq."").and.(prs_name.eq."")) then + ! hybrid pressure coordinates + write(*,*) 'readgridini: reading hybrid pressure coordinates' + if ((hya_name.eq."").or.(hyb_name.eq."").or.(ps_name.eq."")) then + write(*,*) 'ERROR in readgridini: hybrid pressure coordinates and/or surface pressure missing' + error stop + endif + ! read hybrid pressure coordinates + allocate( hya(nzini(indxn)), hyb(nzini(indxn)), psurf(nxini(indxn),nyini(indxn)) ) + call nf90_err( nf90_inq_varid(ncid,trim(hya_name),varid) ) + call nf90_err( nf90_get_var(ncid,varid,hya) ) + call nf90_err( nf90_inq_varid(ncid,trim(hyb_name),varid) ) + call nf90_err( nf90_get_var(ncid,varid,hyb) ) + write(*,*) 'read hybrid pressure coords' + ! read surface pressure + call nf90_err( nf90_inq_varid(ncid,trim(ps_name),varid) ) + call nf90_err( nf90_inquire_variable(ncid,varid,nameout,xtype,ndims,dimids,natts) ) + write(*,*) 'psurf: ndims, natts = ',ndims, natts + sclfact=0. + offset=0. + if (natts.gt.0 ) then + do nn=1,natts + call nf90_err( nf90_inq_attname(ncid,varid,nn,attname) ) + if (index(attname,'add_offset').ne.0) then + call nf90_err( nf90_get_att(ncid,varid,'add_offset',offset) ) + else if (index(attname,'scale_factor').ne.0) then + call nf90_err( nf90_get_att(ncid,varid,'scale_factor',sclfact) ) + endif + end do + endif + write(*,*) 'psurf: sclfact, offset = ',sclfact, offset + if (ndims.eq.2) then + call nf90_err( nf90_get_var(ncid,varid,psurf,start=(/1,1/),count=(/nxini(indxn),nyini(indxn)/)) ) + else if (ndims.eq.3) then + ! read from first time step (assume this is good enough) + call nf90_err( nf90_get_var(ncid,varid,psurf,start=(/1,1,1/),count=(/nxini(indxn),nyini(indxn),1/)) ) + endif + if ((sclfact.ne.0).and.(offset.ne.0)) then + psurf=psurf*sclfact+offset + endif + ! calculate pressure + do kz=1,nzini(indxn) + prsini(1:nxini(indxn),1:nyini(indxn),kz,indxn)=hya(kz)+hyb(kz)*psurf(:,:) + end do + deallocate( psurf, hya, hyb ) + else if (alt_name.ne."") then + ! height coordinates (assume metres above ground) + call nf90_err( nf90_inq_varid(ncid,trim(alt_name),varid) ) + call nf90_err( nf90_get_var(ncid,varid,altini(1:nzini(indxn),indxn)) ) + else if (prs_name.ne."") then + ! pressure coordinates + call nf90_err( nf90_inq_varid(ncid,trim(prs_name),varid) ) + call nf90_err( nf90_get_var(ncid,varid,prsini(1,1,1:nzini(indxn),indxn)) ) + do jy=1,nyini(indxn) + do ix=1,nxini(indxn) + prsini(ix,jy,:,indxn)=prsini(1,1,:,indxn) + end do + end do + endif + + ! read mixing ratio variables + !**************************** + if (var_name.eq."") then + write(*,*) 'ERROR in readgridini: mixing ratios missing in file'//trim(path_name)//trim(file_name) + error stop + endif + call nf90_err( nf90_inq_varid(ncid,trim(var_name),varid) ) + call nf90_err( nf90_inquire_variable(ncid,varid,nameout,xtype,ndims,dimids,natts) ) + write(*,*) 'conc: ndims, natts, dimids = ',ndims, natts, dimids + sclfact=0. + offset=0. + if (natts.gt.0 ) then + do nn=1,natts + call nf90_err( nf90_inq_attname(ncid,varid,nn,attname) ) + if (index(attname,'add_offset').ne.0) then + call nf90_err( nf90_get_att(ncid,varid,'add_offset',offset) ) + else if (index(attname,'scale_factor').ne.0) then + call nf90_err( nf90_get_att(ncid,varid,'scale_factor',sclfact) ) + endif + end do + endif + write(*,*) 'conc: sclfact, offset = ',sclfact, offset + if (ndims.eq.3) then + call nf90_err( nf90_get_var(ncid,varid,gridini(1:nxini(indxn),1:nyini(indxn),1:nzini(indxn),indxn), & + start=(/1,1,1/),count=(/nxini(indxn),nyini(indxn),nzini(indxn)/)) ) + else if (ndims.eq.4) then + call nf90_err( nf90_get_var(ncid,varid,gridini(1:nxini(indxn),1:nyini(indxn),1:nzini(indxn),indxn), & + start=(/1,1,1,indxt/),count=(/nxini(indxn),nyini(indxn),nzini(indxn),1/)) ) + endif + if ((sclfact.ne.0).and.(offset.ne.0)) then + gridini(:,:,:,indxn)=gridini(:,:,:,indxn)*sclfact+offset + endif + + ! other variables + !**************** + if (q_name.ne."") then + ! read specific humidity + allocate( shumid(nxini(indxn),nyini(indxn),nzini(indxn)), pw(nxini(indxn),nyini(indxn),nzini(indxn)) ) + call nf90_err( nf90_inq_varid(ncid,trim(q_name),varid) ) + call nf90_err( nf90_inquire_variable(ncid,varid,nameout,xtype,ndims,dimids,natts) ) + sclfact=0. + offset=0. + if (natts.gt.0 ) then + do nn=1,natts + call nf90_err( nf90_inq_attname(ncid,varid,nn,attname) ) + if (index(attname,'add_offset').ne.0) then + call nf90_err( nf90_get_att(ncid,varid,'add_offset',offset) ) + else if (index(attname,'scale_factor').ne.0) then + call nf90_err( nf90_get_att(ncid,varid,'scale_factor',sclfact) ) + endif + end do + endif + if (ndims.eq.3) then + call nf90_err( nf90_get_var(ncid,varid,shumid(:,:,:), & + start=(/1,1,1/),count=(/nxini(indxn),nyini(indxn),nzini(indxn)/)) ) + else if (ndims.eq.4) then + call nf90_err( nf90_get_var(ncid,varid,shumid(:,:,:), & + start=(/1,1,1,indxt/),count=(/nxini(indxn),nyini(indxn),nzini(indxn),1/)) ) + endif + write(*,*) 'conc: sclfact, offset = ',sclfact, offset + if ((sclfact.ne.0).and.(offset.ne.0)) then + shumid=shumid*sclfact+offset + endif + ! partial pressure of water from specific humidity + pw = shumid*prsini(1:nxini(indxn),1:nyini(indxn),1:nzini(indxn),indxn)/(0.622 + 0.378*shumid) + ! correct mixing ratio to dry air (needed in init_domainfill) + gridini(1:nxini(indxn),1:nyini(indxn),1:nzini(indxn),indxn)= & + gridini(1:nxini(indxn),1:nyini(indxn),1:nzini(indxn),indxn)* & + prsini(1:nxini(indxn),1:nyini(indxn),1:nzini(indxn),indxn)/ & + (prsini(1:nxini(indxn),1:nyini(indxn),1:nzini(indxn),indxn) - pw) + deallocate( shumid, pw ) + endif + + ! convert units to ppbv + !********************** + if (coeff.gt.0) gridini(:,:,:,indxn)=gridini(:,:,:,indxn)*coeff + write(*,*) 'range(gridini) = ',minval(gridini(1:nxini(indxn),1:nyini(indxn),1,indxn)),& + maxval(gridini(1:nxini(indxn),1:nyini(indxn),1,indxn)) + + end subroutine readgridini + + + subroutine init_domainfill_ncf + + !****************************************************************************** + ! * + ! Initializes particles equally distributed over the first release location * + ! specified in file RELEASES. This box is assumed to be the domain for doing * + ! domain-filling trajectory calculations. * + ! All particles carry the same amount of mass which alltogether comprises the* + ! mass of air within the box. * + ! * + ! Author: A. Stohl, Oct 2002 * + ! Modifications: * + ! R. Thompson, Sep 2023: added initialization of mass from grid based * + ! on code of S. Henne for Flexpart-CTM * + ! * + !****************************************************************************** + ! * + ! Variables: * + ! * + ! numparticlecount consecutively counts the number of particles released * + ! nx_we(2) grid indices for western and eastern boundary of domain- * + ! filling trajectory calculations * + ! ny_sn(2) grid indices for southern and northern boundary of domain- * + ! filling trajectory calculations * + ! * + !****************************************************************************** + + use point_mod + use random_mod + use outgrid_mod + use particle_mod +#ifdef ETA + use coord_ecmwf_mod +#endif + use initialise_mod, only: nx_we,ny_sn,numcolumn,numcolumn_we,numcolumn_sn, & + zcolumn_we,zcolumn_sn,acc_mass_we,acc_mass_sn, & + xmassperparticle,alloc_domainfill + use totals_mod, only: tot_mass + + implicit none + + integer :: j,ix,jy,kz,ncolumn,numparttot,iterminate,stat + real :: ylat,ylatp,ylatm,hzone + real :: cosfactm,cosfactp,deltacol,dz1,dz2,dz,pnew,pnew_temp,fractus + real,parameter :: pih=pi/180. + real :: colmasstotal,zposition + real :: hgt_tmp + real, allocatable,dimension(:) :: pp + + integer :: ixm,ixp,jym,jyp,indzm,indzp,nn,indzh,i,ii,jj,ks,indxn + real :: pvpart,ddx,ddy,rddx,rddy,p1,p2,p3,p4,y1(2) + integer :: idummy = -11 + logical :: deall + real,parameter :: eps=1.e-6 + + ! dry and moist air density at particle position + real :: rho_d_i, rho_m_i + + ! variables for column mass calculation + integer,allocatable,dimension(:,:) :: nncolumn + real,allocatable,dimension(:) :: gridarea + real,allocatable,dimension(:,:) :: colmass + real,parameter :: weightair=28.97 + + ! variables to store source profiles + real :: bg_lat(maxspec,ny), dummy1, dummy2 + real :: ppbvpart, presspart + character(256) :: filename + logical :: lexist, lgridini + real :: xl, yl + + ! io variables + character(30) :: frmt + integer, parameter :: unitcolmass=98, unitinitconc=99 + + ! Determine the release region (only full grid cells), over which particles + ! shall be initialized + ! Use 2 fields for west/east and south/north boundary + !************************************************************************** + call alloc_domainfill + nx_we(1)=max(int(xpoint1(1)),0) + nx_we(2)=min((int(xpoint2(1))+1),nxmin1) + ny_sn(1)=max(int(ypoint1(1)),0) + ny_sn(2)=min((int(ypoint2(1))+1),nymin1) + + ! For global simulations (both global wind data and global domain-filling), + ! set a switch, such that no boundary conditions are used + !************************************************************************** + if (xglobal.and.sglobal.and.nglobal) then + if ((nx_we(1).eq.0).and.(nx_we(2).eq.nxmin1).and. & + (ny_sn(1).eq.0).and.(ny_sn(2).eq.nymin1)) then + gdomainfill=.true. + else + gdomainfill=.false. + endif + endif + + ! If resuming a run from particle dump + ! calculate total mass each species then exit + !******************************************** + if (gdomainfill.and.ipin.ne.0) then + write(*,*) 'Initialising particles from partoutput' + tot_mass(:)=0. + do ks=2,nspec + tot_mass(ks)=sum(mass(1:count%alive,ks)) + write(*,'(A,E12.4,A)') 'Species '//species(ks)//': ',tot_mass(ks),' (kg)' + end do + return + endif + + ! Allocate fields used within this subroutine + !********************************************* + allocate( nncolumn(0:nxmax-1, 0:nymax-1),stat=stat ) + if (stat.ne.0) write(*,*)'ERROR: could not allocate nncolumn' + allocate(gridarea(0:nymax-1),colmass(0:nxmax-2,0:nymax-1),stat=stat) + if (stat.ne.0) write(*,*)'ERROR: could not allocate gridarea or colmass' + + ! Do not release particles twice (i.e., not at both in the leftmost and rightmost + ! grid cell) for a global domain + !***************************************************************************** + if (xglobal) nx_we(2)=min(nx_we(2),nx-2) + write(*,*) 'init_domainfill: nx_we, ny_sn = ',nx_we, ny_sn + + ! Try reading initial mixing ratio fields into gridini + !***************************************************** + ! this is to restart from 3D fields + ! grid_pptv files have to be present for all species except 1 (airtracer) + lgridini = .true. + do ks=2,nspec ! species 1 is assumed to be air tracer + call readgridini(ks,lexist) + if (.not.lexist) then + lgridini = .false. + exit + end if + end do + + if (lgridini) then + write(*,*) "Initialising all species with gridded input" + !! test + open(unitoutgrid,file=path(2)(1:length(2))//'gridini.txt',status='replace',action='write') + write(frmt,fmt='(A,I4,A)') '(',nxini(1),'(E14.6))' + do kz=1,nzini(1) + do jj=1,nyini(1) + write(unitoutgrid,frmt) gridini(1:nxini(1),jj,kz,1) + end do + end do + close(unitoutgrid) + !! + else + ! read latitude profiles for initialization + do ks=2,nspec ! species 1 is assumed to be air tracer + filename=trim(path(2)(1:length(2)))//'latitude_profile_'//trim(species(ks))//'.txt' + print*, 'init_domainfill: filename = ',filename + inquire(file=filename,exist=lexist) + if (lexist) then + open(unitinitconc,file=filename,action='read') + do jj=1,ny + read(unitinitconc,'(3F13.6)') dummy1, bg_lat(ks,jj), dummy2 + write(*,*) 'read values; ', dummy1, bg_lat(ks,jj), dummy2 + enddo + close(unitinitconc) + write(*,'(A)') "Initialising species "//species(ks)//" with latitudinal profile" + else + bg_lat(ks,:) = 1. + write(*,'(A)') "Initialising species "//species(ks)//" with value in RELEASES" + endif + end do ! nspec + endif ! lgridini + + ! Calculate area of grid cell with formula M=2*pi*R*h*dx/360, + ! see Netz, Formeln der Mathematik, 5. Auflage (1983), p.90 + ! Note gridarea is for meteo grid + !************************************************************ + + write(*,*) 'init_domainfill: nxmin1, nxmax, nymin1, nymax = ',nxmin1, nxmax, nymin1, nymax + + ! for the south pole + if (sglobal) then + ylat=ylat0 + ylatp=ylat+0.5*dy + ylatm=ylat + cosfactm=0. + cosfactp=cos(ylatp*pih)*r_earth + hzone=sqrt(r_earth**2-cosfactm**2)- & + sqrt(r_earth**2-cosfactp**2) + gridarea(0)=2.*pi*r_earth*hzone*dx/360. + endif + + ! do the same for the north pole + if (nglobal) then + ylat=ylat0+real(nymin1)*dy + ylatp=ylat + ylatm=ylat-0.5*dy + cosfactp=0. + cosfactm=cos(ylatm*pih)*r_earth + hzone=sqrt(r_earth**2-cosfactp**2)- & + sqrt(r_earth**2-cosfactm**2) + gridarea(nymin1)=2.*pi*r_earth*hzone*dx/360. + endif + + ! Initialise the sum over the total mass of the atmosphere + colmasstotal=0. + colmass(:,:)=0. + + write(*,*) 'init_domainfill: ny_sn, nx_we = ',ny_sn, nx_we + write(*,*) 'init_domainfill: dxini, dyini = ',dxini, dyini + + allocate( pp(nzmax),stat=stat) + if (stat.ne.0) write(*,*)'ERROR: could not allocate pp' + +!$OMP PARALLEL PRIVATE(jy,ix,ylat,ylatp,ylatm,hzone,cosfactp,cosfactm,pp) + +!$OMP DO + ! loop over latitudes + do jy=ny_sn(1),ny_sn(2) + if (sglobal.and.(jy.eq.ny_sn(1))) cycle + if (nglobal.and.(jy.eq.ny_sn(2))) cycle + ylat=ylat0+real(jy)*dy + ylatp=ylat+0.5*dy + ylatm=ylat-0.5*dy + if ((ylatm.lt.0).and.(ylatp.gt.0.)) then + hzone=1./dyconst + else + cosfactp=cos(ylatp*pih)*r_earth + cosfactm=cos(ylatm*pih)*r_earth + if (cosfactp.lt.cosfactm) then + hzone=sqrt(r_earth**2-cosfactp**2)- & + sqrt(r_earth**2-cosfactm**2) + else + hzone=sqrt(r_earth**2-cosfactm**2)- & + sqrt(r_earth**2-cosfactp**2) + endif + endif + gridarea(jy)=2.*pi*r_earth*hzone*dx/360. + end do +!$OMP END DO +!$OMP BARRIER + + ! Calculate total mass of each grid column and of the whole atmosphere + !********************************************************************* + +!$OMP DO + do jy=ny_sn(1),ny_sn(2) + do ix=nx_we(1),nx_we(2) + pp(1)=prs(ix,jy,1,1) + pp(nz)=prs(ix,jy,nz,1) + colmass(ix,jy)=(pp(1)-pp(nz))/ga*gridarea(jy) + end do + end do +!$OMP END DO +!$OMP END PARALLEL + + deallocate(pp) + + colmasstotal=sum(colmass) + write(*,*) 'Atmospheric mass air = ',colmasstotal + + ! Output of colmass distribution + !******************************** + + open(unitcolmass,file=path(2)(1:length(2))//'colmass.dat',action='write') + write(frmt, '(A, I4, A)') '(', ny_sn(2)-ny_sn(1)+1, 'E12.3)' + do ix=nx_we(1),nx_we(2) + write(unitcolmass, frmt) (colmass(ix,i),i=0,(nymax-1)) + end do + close(unitcolmass) + + ! If not continuing from particle dump + !************************************* + + if (ipin.eq.0) numpart=0 + + ! Determine the particle positions + !********************************* + allocate( pp(nzmax),stat=stat) + if (stat.ne.0) write(*,*)'ERROR: could not allocate pp' + numparttot=0 + numcolumn=0 + iterminate=0 + + ! allocate all particles before loop + call spawn_particles(0, npart(1)) + write(*,*) 'init_domainfill: count%alive = ',count%alive + + do jy=ny_sn(1),ny_sn(2) ! loop about latitudes + ylat=ylat0+real(jy)*dy + do ix=nx_we(1),nx_we(2) ! loop about longitudes + ncolumn=nint(0.999*real(npart(1))*colmass(ix,jy)/colmasstotal) + ! this condition means with 0.5 degrees need around 200 million particles + ! to avoid any grid cells having zero particles + ncolumn=max(ncolumn,1) + nncolumn(ix,jy) = ncolumn + if (ncolumn.gt.numcolumn) numcolumn=ncolumn + + ! Calculate pressure at the altitudes of model surfaces, using the air density + ! information, which is stored as a 3-d field + pp(:)=prs(ix,jy,:,1) + + ! Loop over number of particles in grid column + deltacol=(pp(1)-pp(nz))/real(ncolumn) + pnew=pp(1)+deltacol/2. + jj=0 + do j=1,ncolumn + jj=jj+1 + + ! For columns with many particles (i.e. around the equator), distribute + ! the particles equally, for columns with few particles (i.e. around the + ! poles), distribute the particles randomly. When only few particles are + ! left distribute them randomly + + if ((ncolumn.gt.20).and.(ncolumn-j.gt.20)) then + pnew_temp=pnew-ran1(idummy,0)*deltacol + pnew=pnew-deltacol + else if (ncolumn.gt.20) then + pnew_temp=pnew-ran1(idummy,0)*(pnew-pp(nz)) + else + pnew_temp=pp(1)-ran1(idummy,0)*(pp(1)-pp(nz)) + endif + pnew_temp=min(pp(1),pnew_temp) + pnew_temp=max(pp(nz)+eps,pnew_temp) + + ! find vertical layer + do kz=1,nz-1 + if ((pp(kz).ge.pnew_temp).and.(pp(kz+1).lt.pnew_temp)) then + dz1=log(pp(kz))-log(pnew_temp) + dz2=log(pnew_temp)-log(pp(kz+1)) + dz=1./(dz1+dz2) + + ! Assign particle position + !************************* + + ! Do the following steps only if particles are not read in from + ! previous model run + if (ipin.eq.0) then + + ! Horizontal position + call set_xlon(numpart+jj,real(real(ix)-0.5+ran1(idummy,0),kind=dp)) + if (ix.eq.0) call set_xlon(numpart+jj,real(ran1(idummy,0),kind=dp)) + if (ix.eq.nxmin1) & + call set_xlon(numpart+jj,real(real(nxmin1)-ran1(idummy,0),kind=dp)) + call set_ylat(numpart+jj,real(real(jy)-0.5+ran1(idummy,0),kind=dp)) + if (jy.eq.0) call set_ylat(numpart+jj,real(ran1(idummy,0),kind=dp)) + if (jy.eq.nymin1) & + call set_ylat(numpart+jj,real(real(nymin1)-ran1(idummy,0),kind=dp)) + ! Vertical position + hgt_tmp=(height(kz)*dz2+height(kz+1)*dz1)*dz + call set_z(numpart+jj,hgt_tmp) + if (real(part(numpart+jj)%z).gt.(height(nz)-0.5)) & + call set_z(numpart+jj,height(nz)-0.5) +#ifdef ETA + call update_z_to_zeta(0, numpart+jj) +#endif + ! Interpolate PV to the particle position + !**************************************** + ixm=int(part(numpart+jj)%xlon) + jym=int(part(numpart+jj)%ylat) + ixp=ixm+1 + jyp=jym+1 + ddx=real(part(numpart+jj)%xlon)-real(ixm) + ddy=real(part(numpart+jj)%ylat)-real(jym) + rddx=1.-ddx + rddy=1.-ddy + p1=rddx*rddy + p2=ddx*rddy + p3=rddx*ddy + p4=ddx*ddy + indzm=nz-1 + indzp=nz + do ii=2,nz + if (real(height(ii),kind=dp).gt.part(numpart+jj)%z) then + indzm=ii-1 + indzp=ii + exit + endif + end do + dz1=real(part(numpart+jj)%z)-height(indzm) + dz2=height(indzp)-real(part(numpart+jj)%z) + dz=1./(dz1+dz2) + do ii=1,2 + indzh=indzm+ii-1 + y1(ii)=p1*pv(ixm,jym,indzh,1) & + + p2*pv(ixp,jym,indzh,1) & + + p3*pv(ixm,jyp,indzh,1) & + + p4*pv(ixp,jyp,indzh,1) + end do + pvpart=(dz2*y1(1)+dz1*y1(2))*dz + if (ylat.lt.0.) pvpart=-1.*pvpart + + ! Interpolate moist air density to the particle position + !******************************************************* + do ii=1,2 + indzh=indzm+ii-1 + y1(ii)=p1*rho(ixm,jym,indzh,1) & + +p2*rho(ixp,jym,indzh,1) & + +p3*rho(ixm,jyp,indzh,1) & + +p4*rho(ixp,jyp,indzh,1) + end do + rho_m_i=(dz2*y1(1)+dz1*y1(2))*dz + + ! Interpolate dry air density to the particle position + !***************************************************** + do ii=1,2 + indzh=indzm+ii-1 + y1(ii)=p1*rho(ixm,jym,indzh,1)*(1-qv(ixm,jym,indzh,1)) & + +p2*rho(ixp,jym,indzh,1)*(1-qv(ixp,jym,indzh,1)) & + +p3*rho(ixm,jyp,indzh,1)*(1-qv(ixm,jyp,indzh,1)) & + +p4*rho(ixp,jyp,indzh,1)*(1-qv(ixp,jyp,indzh,1)) + end do + rho_d_i=(dz2*y1(1)+dz1*y1(2))*dz + + ! For domain-filling option 2 (stratospheric O3), + ! do the rest only in the stratosphere + !************************************************ + + if (((part(numpart+jj)%z.gt.3000.).and. & + (pvpart.gt.pvcrit)).or.(mdomainfill.eq.1)) then + + ! Assign certain properties to the particle + !****************************************** + part(numpart+jj)%nclass=min(int(ran1(idummy,0)*real(nclassunc))+1,nclassunc) + numparticlecount=numparticlecount+1 + part(numpart+jj)%npoint=numparticlecount + part(numpart+jj)%idt=mintime + mass(numpart+jj,1)=colmass(ix,jy)/real(ncolumn) + + if (lgridini) then + + ! Initialize particle mass using gridded input + !********************************************* + ! Assume input is in units of ppv and species 1 carries airmass tracer so + ! mass of other species is easily determined + ! loop over all species, assuming species 1 is airtracer + do ks=2, nspec + indxn=minloc(abs(specnini-specnum(ks)),dim=1) + ! lon and lat of particle + xl=real(part(numpart+jj)%xlon)*dx+xlon0 + yl=real(part(numpart+jj)%ylat)*dy+ylat0 + ! get coordinates in gridini + ! Assumes lon and lat dimensions are midpoints + ixm=int((xl-(lonini(1,indxn)-0.5*dxini(indxn)))/dxini(indxn))+1 + jym=int((yl-(latini(1,indxn)-0.5*dyini(indxn)))/dyini(indxn))+1 + ixm=min(ixm,nxini(indxn)) + jym=min(jym,nyini(indxn)) + !! testing +! if (jj.eq.1.and.jy.lt.5.and.ix.lt.5) then +! print*, 'init_domainfill: lonini, xl, latini, yl = ',lonini(ixm,indxn),xl,latini(jym,indxn),yl +! endif !! + ! Get vertical position in gridini + if (any(altini(:,indxn).gt.0)) then + ! vertical coordinate in metres above ground + indzm=nzini(indxn)-1 + indzp=nzini(indxn) + do ii=2,nzini(indxn) + if (altini(ii,indxn).gt.real(part(numpart+jj)%z)) then + indzm=ii-1 + indzp=ii + exit + endif + enddo + dz1=real(part(numpart+jj)%z)-altini(indzm,indxn) + dz2=altini(indzp,indxn)-real(part(numpart+jj)%z) + dz=1./(dz1+dz2) + ppbvpart=(dz2*gridini(ixm,jym,indzm,indxn)+ & + dz1*gridini(ixm,jym,indzp,indxn))*dz + else if (any(prsini(:,:,:,indxn).gt.0)) then + ! vertical coordinate in pressure (Pa) + presspart=pnew_temp + indzm=nzini(indxn)-1 + indzp=nzini(indxn) + do ii=2,nzini(indxn) + if (presspart.gt.prsini(ixm,jym,ii,indxn)) then + indzm=ii-1 + indzp=ii + exit + endif + end do + dz1=presspart-prsini(ixm,jym,indzm,indxn) + dz2=prsini(ixm,jym,indzp,indxn)-presspart + dz=1./(dz1+dz2) + ppbvpart=(dz2*gridini(ixm,jym,indzm,indxn)+ & + dz1*gridini(ixm,jym,indzp,indxn))*dz + endif + !! test +! if (numpart.lt.100) write(*,*) 'init_domainfill: ratio dry/moist density =',rho_d_i/rho_m_i + mass(numpart+jj,ks)=mass(numpart+jj,1) * & + weightmolar(ks)/weightair * & + rho_d_i/rho_m_i*ppbvpart/1.E9 + end do ! nspec + + else + + ! Initialize with latitude profile + !********************************* + ! loop over all species, assuming species 1 is airtracer + do ks=2, nspec + mass(numpart+jj,ks)=mass(numpart+jj,1)* & + weightmolar(ks)/weightair * & + rho_d_i/rho_m_i*bg_lat(ks,jy)/1.E9 + end do + + endif ! lgridini + + ! Assign ozone mass if domain-filling option 2 + !********************************************* + if (mdomainfill.eq.2) mass(numpart+jj,1)= & + mass(numpart+jj,1)*pvpart*48./29.*ozonescale/10.**9 + + mass_init(numpart+jj,1)=mass(numpart+jj,1) + + else + + ! Particle in stratosphere and not domain-filling option 1 + !********************************************************* + call terminate_particle(numpart+jj, 0) + jj=jj-1 + iterminate=iterminate+1 + + endif ! domainfill option + endif ! if initialization + endif ! if in layer + end do ! loop over layers + end do ! loop over column + + numparttot=numparttot+ncolumn + if (ipin.eq.0) numpart=numpart+jj + + end do ! loop over longitude + + end do ! loop over latitude + + write(*,*) 'init_domainfill: numpart, numparttot = ',numpart, numparttot + + ! Terminate unused particles + !*************************** + do j=(numpart+1),count%alive + call terminate_particle(j,0) ! Cannot be within an OMP region + iterminate=iterminate+1 + end do + write(*,*) 'init_domainfill: after terminating extra particles count%alive = ',count%alive + + ! Total mass each species + !************************ + tot_mass(:)=0. + do ks=2,nspec + tot_mass(ks)=sum(mass(1:count%alive,ks)) + write(*,'(A,E12.4,A)') 'Species '//species(ks)//': ',tot_mass(ks),' (kg)' + end do + + xmassperparticle=colmasstotal/real(numparttot) + + ! Output colmass distribution + !**************************** + + open(unitcolmass,file=path(2)(1:length(2))//'ncolumn.dat',action='write') + write(frmt, '(A, I4, A)') '(', ny_sn(2)-ny_sn(1)+1, 'I5)' + do ix=nx_we(1), nx_we(2) + write(unitcolmass,frmt) (nncolumn(ix, jj), jj=ny_sn(1),ny_sn(2)) + end do + close(unitcolmass) + + ! For boundary conditions, we need fewer particle release heights per column, + ! because otherwise it takes too long until enough mass has accumulated to + ! release a particle at the boundary (would take dx/u seconds), leading to + ! relatively large position errors of the order of one grid distance. + ! It's better to release fewer particles per column, but to do so more often. + ! Thus, use on the order of nz starting heights per column. + ! We thus repeat the above to determine fewer starting heights, that are + ! used furtheron in subroutine boundcond_domainfill.f90 + !**************************************************************************** + + fractus=real(numcolumn)/real(nz) + write(*,*) 'Total number of particles at model start: ',numpart + write(*,*) 'Maximum number of particles per column: ',numcolumn + write(*,*) 'If ',fractus,' <1, better use more particles' + fractus=sqrt(max(fractus,1.))/2. + + do jy=ny_sn(1),ny_sn(2) ! loop about latitudes + do ix=nx_we(1),nx_we(2) ! loop about longitudes + ncolumn=nint(0.999/fractus*real(npart(1))*colmass(ix,jy) & + /colmasstotal) + if (ncolumn.gt.maxcolumn) error stop 'maxcolumn too small' + if (ncolumn.eq.0) cycle + + ! Memorize how many particles per column shall be used for all boundaries + ! This is further used in subroutine boundcond_domainfill.f + ! Use 2 fields for west/east and south/north boundary + !************************************************************************ + + if (ix.eq.nx_we(1)) numcolumn_we(1,jy)=ncolumn + if (ix.eq.nx_we(2)) numcolumn_we(2,jy)=ncolumn + if (jy.eq.ny_sn(1)) numcolumn_sn(1,ix)=ncolumn + if (jy.eq.ny_sn(2)) numcolumn_sn(2,ix)=ncolumn + + ! Calculate pressure at the altitudes of model surfaces, using the air density + ! information, which is stored as a 3-d field + !***************************************************************************** + + do kz=1,nz + pp(kz)=prs(ix,jy,kz,1) + end do + + ! Determine the reference starting altitudes + !******************************************* + + deltacol=(pp(1)-pp(nz))/real(ncolumn) + pnew=pp(1)+deltacol/2. + do j=1,ncolumn + pnew=pnew-deltacol + do kz=1,nz-1 + if ((pp(kz).ge.pnew).and.(pp(kz+1).lt.pnew)) then + dz1=pp(kz)-pnew + dz2=pnew-pp(kz+1) + dz=1./(dz1+dz2) + zposition=(height(kz)*dz2+height(kz+1)*dz1)*dz + if (zposition.gt.height(nz)-0.5) zposition=height(nz)-0.5 + + ! Memorize vertical positions where particles are introduced + ! This is further used in subroutine boundcond_domainfill.f + !*********************************************************** + + if (ix.eq.nx_we(1)) zcolumn_we(1,jy,j)=zposition + if (ix.eq.nx_we(2)) zcolumn_we(2,jy,j)=zposition + if (jy.eq.ny_sn(1)) zcolumn_sn(1,ix,j)=zposition + if (jy.eq.ny_sn(2)) zcolumn_sn(2,ix,j)=zposition + + ! Initialize mass that has accumulated at boundary to zero + !********************************************************* + + acc_mass_we(1,jy,j)=0. + acc_mass_we(2,jy,j)=0. + acc_mass_sn(1,jy,j)=0. + acc_mass_sn(2,jy,j)=0. + + endif + end do + end do + end do + end do + + ! If there were more particles allocated than used, + ! Deallocate unused memory and update numpart + !************************************************** + + deall=.false. + do i=numpart, 1, -1 + if (.not. part(i)%alive) then + deall=.true. + numpart = numpart - 1 + else + exit + endif + end do + + if (deall) call dealloc_particle(numpart) ! deallocates everything above numpart + write(*,*) 'init_domainfill: after dealloc count%alive = ',count%alive + write(*,*) 'init_domainfill: count%allocated = ',count%allocated + + + ! If particles shall be read in to continue an existing run, + ! then the accumulated masses at the domain boundaries must be read in, too. + ! This overrides any previous calculations. + !*************************************************************************** + + if ((ipin.eq.1).and.(.not.gdomainfill)) then + open(unitboundcond,file=path(2)(1:length(2))//'boundcond.bin', & + form='unformatted') + read(unitboundcond) numcolumn_we,numcolumn_sn, & + zcolumn_we,zcolumn_sn,acc_mass_we,acc_mass_sn + close(unitboundcond) + endif + + deallocate(pp,nncolumn,gridarea) + + end subroutine init_domainfill_ncf + + !***************************************************************************** + ! * + ! netcdf error message handling * + ! * + !***************************************************************************** + +! subroutine nf90_err(status) +! +! integer, intent (in) :: status +! +! if(status /= nf90_noerr) then +! print*, trim(nf90_strerror(status)) +! error stop 'Stopped' +! end if +! +! end subroutine nf90_err + +end module initdomain_mod diff --git a/src/initialise_mod.f90 b/src/initialise_mod.f90 index 350f9f307ab76703640ceff7855f694dce8a52dc..9a1cd6d497dadd5b2df40f2f557e55bd83c96a44 100644 --- a/src/initialise_mod.f90 +++ b/src/initialise_mod.f90 @@ -98,14 +98,12 @@ subroutine releaseparticles(itime) !real xaux,yaux,zaux,ran1,rfraction,xmasssave(maxpoint) real :: xaux,yaux,zaux,rfraction - real :: topo,r,t - real :: dp1,dp2,xlonav,timecorrect(maxspec),press,pressold - real :: presspart,average_timecorrect + real :: xlonav,timecorrect(maxspec) + real :: average_timecorrect integer :: itime,numrel,i,j,k,ipart,minpart - integer :: kz,istart,iend,totpart + integer :: istart,iend,totpart,iterm_index integer :: nweeks,ndayofweek,nhour,jjjjmmdd,ihmmss,mm real(kind=dp) :: julmonday,jul,jullocal,juldiff - real,parameter :: eps2=1.e-6 integer :: idummy = -7 !save idummy,xmasssave @@ -129,22 +127,25 @@ subroutine releaseparticles(itime) ! For every release point, check whether we are in the release time interval !*************************************************************************** ! First allocate all particles that are going to be in the simulation - - if (itime.eq.0) then - totpart=0 - do i=1,numpoint - totpart = totpart+npart(i) - end do - call alloc_particles(totpart) - else if (itime.eq.itime_init) then !From restart point only allocate particles that are yet to be born - totpart=0 - do i=1,numpoint - totpart = totpart+npart(i) - end do - if (totpart.gt.count%allocated) call alloc_particles(totpart-count%allocated) - end if + ! If ipin==0,1, and ipout==0, then dead particles can be overwritten to save memory + if (ipin.gt.1 .or. ipout.ne.0) then + if (itime.eq.0) then + totpart=0 + do i=1,numpoint + totpart = totpart+npart(i) + end do + call alloc_particles(totpart) + else if (itime.eq.itime_init) then !From restart point only allocate particles that are yet to be born + totpart=0 + do i=1,numpoint + totpart = totpart+npart(i) + end do + if (totpart.gt.count%allocated) call alloc_particles(totpart-count%allocated) + end if + endif call get_totalpart_num(istart) + if (ipin.le.1 .and. ipout.eq.0) call rewrite_iterm() minpart=1 do i=1,numpoint if ((itime.ge.ireleasestart(i)).and. &! are we within release interval? @@ -153,7 +154,7 @@ subroutine releaseparticles(itime) ! Determine the local day and time !********************************* - xlonav=xlon0+(xpoint2(i)+xpoint1(i))/2.*dx ! longitude needed to determine local time + xlonav=xlon0+(xpoint2(i)+xpoint1(i))*0.5*dx ! longitude needed to determine local time if (xlonav.lt.-180.) xlonav=xlonav+360. if (xlonav.gt.180.) xlonav=xlonav-360. jullocal=jul+real(xlonav,kind=dp)/360._dp ! correct approximately for time zone to obtain local time @@ -193,7 +194,7 @@ subroutine releaseparticles(itime) rfraction=abs(real(npart(i))*real(lsynctime)/ & real(ireleaseend(i)-ireleasestart(i))) if ((itime.eq.ireleasestart(i)).or. & - (itime.eq.ireleaseend(i))) rfraction=rfraction/2. + (itime.eq.ireleaseend(i))) rfraction=rfraction*0.5 ! Take the species-average time correction factor in order to scale the ! number of particles released this time @@ -211,8 +212,15 @@ subroutine releaseparticles(itime) yaux=ypoint2(i)-ypoint1(i) zaux=zpoint2(i)-zpoint1(i) + if (ipin.le.1 .and. ipout.eq.0) then + call rewrite_iterm() + totpart = numrel-count%iterm_max + if (totpart.gt.0) call alloc_particles(totpart) + call rewrite_iterm() + iterm_index=1 + endif do j=1,numrel ! loop over particles to be released this time - call get_newpart_index(ipart) + call get_newpart_index(ipart,iterm_index) call spawn_particle(itime, ipart) ! Particle coordinates are determined by using a random position within the release volume @@ -238,9 +246,9 @@ subroutine releaseparticles(itime) ! divided by the sum of rho of all particles. !***************************************************************************** do k=1,nspec - part(ipart)%mass(k)=xmass(i,k)/real(npart(i)) & + mass(ipart,k)=xmass(i,k)/real(npart(i)) & *timecorrect(k)/average_timecorrect - part(ipart)%mass_init(k)=part(ipart)%mass(k) + mass_init(ipart,k)=mass(ipart,k) end do ! Assign certain properties to particle !************************************** @@ -254,85 +262,16 @@ subroutine releaseparticles(itime) endif part(ipart)%idt=mintime ! first time step - ! Determine vertical particle position - !************************************* + ! Determine vertical particle position + !************************************* call set_z(ipart,zpoint1(i)+ran1(idummy,0)*zaux) - ! Interpolation of topography and density - !**************************************** - - ! Determine the nest we are in - !***************************** - call find_ngrid(part(ipart)%xlon,part(ipart)%ylat) - - ! Determine (nested) grid coordinates and auxiliary parameters used for interpolation - !***************************************************************************** - call find_grid_indices(real(part(ipart)%xlon),real(part(ipart)%ylat)) - call find_grid_distances(real(part(ipart)%xlon),real(part(ipart)%ylat)) - - if (ngrid.gt.0) then - topo=p1*oron(ix ,jy ,ngrid) & - + p2*oron(ixp,jy ,ngrid) & - + p3*oron(ix ,jyp,ngrid) & - + p4*oron(ixp,jyp,ngrid) - else - topo=p1*oro(ix ,jy) & - + p2*oro(ixp,jy) & - + p3*oro(ix ,jyp) & - + p4*oro(ixp,jyp) - endif - - ! If starting height is in pressure coordinates, retrieve pressure profile and convert zpart1 to meters - !***************************************************************************** - if (kindz(i).eq.3) then - presspart=real(part(ipart)%z) - do kz=1,nz - if (ngrid.gt.0) then - r=p1*rhon(ix ,jy ,kz,2,ngrid) & - +p2*rhon(ixp,jy ,kz,2,ngrid) & - +p3*rhon(ix ,jyp,kz,2,ngrid) & - +p4*rhon(ixp,jyp,kz,2,ngrid) - t=p1*ttn(ix ,jy ,kz,2,ngrid) & - +p2*ttn(ixp,jy ,kz,2,ngrid) & - +p3*ttn(ix ,jyp,kz,2,ngrid) & - +p4*ttn(ixp,jyp,kz,2,ngrid) - else - r=p1*rho(ix ,jy ,kz,2) & - +p2*rho(ixp,jy ,kz,2) & - +p3*rho(ix ,jyp,kz,2) & - +p4*rho(ixp,jyp,kz,2) - t=p1*tt(ix ,jy ,kz,2) & - +p2*tt(ixp,jy ,kz,2) & - +p3*tt(ix ,jyp,kz,2) & - +p4*tt(ixp,jyp,kz,2) - endif - press=r*r_air*t/100. - if (kz.eq.1) pressold=press - - if (press.lt.presspart) then - if (kz.eq.1) then - call set_z(ipart,height(1)/2.) - else - dp1=pressold-presspart - dp2=presspart-press - call set_z(ipart,(height(kz-1)*dp2+height(kz)*dp1) & - /(dp1+dp2)) - endif - exit - endif - pressold=press - end do - endif - - - ! If release positions are given in meters above sea level, subtract the - ! topography from the starting height - !*********************************************************************** - - if (kindz(i).eq.2) call update_z(ipart,-topo) - if (part(ipart)%z.lt.eps2) call set_z(ipart,eps2) ! Minimum starting height is eps2 - if (part(ipart)%z.gt.height(nz)-0.5) & - call set_z(ipart,height(nz)-0.5) ! Maximum starting height is uppermost level - 0.5 meters + ! Interpolation of topography and density + !**************************************** + ! Transform the verticle particle position from pressure or sea level to above ground + ! if necessary + !************************************************************************************ + call kindz_to_z(ipart) #ifdef ETA call z_to_zeta(itime,part(ipart)%xlon,part(ipart)%ylat,part(ipart)%z,part(ipart)%zeta) part(ipart)%etaupdate = .true. ! The z(meter) coordinate is up to date @@ -347,15 +286,17 @@ subroutine releaseparticles(itime) endif ! releasepoint end do ! numpoint + if (ipin.le.1 .and. ipout.eq.0) call rewrite_iterm() + call get_totalpart_num(iend) ! NetCDF only: write initial positions of new particles -#ifdef USE_NCF - if ((iend-istart.gt.0).and.(ipout.ge.1)) then - call wrt_part_initialpos(itime,istart,iend) - call output_particles(itime,.true.) - endif -#endif +! #ifdef USE_NCF +! if ((iend-istart.gt.0).and.(ipout.ge.1)) then +! call wrt_part_initialpos(itime,istart,iend) +! call output_particles(itime,.true.) +! endif +! #endif return ! 996 continue @@ -371,6 +312,106 @@ subroutine releaseparticles(itime) end subroutine releaseparticles +subroutine kindz_to_z(ipart) + use point_mod + use xmass_mod + use output_mod + use interpol_mod + + implicit none + + integer,intent(in) :: ipart + integer :: kz + real :: dp1,dp2,press,presspart,pressold,topo,r,t + real,parameter :: eps2=1.e-6 + + + ! Determine the nest we are in + !***************************** + call find_ngrid(part(ipart)%xlon,part(ipart)%ylat) + + ! Determine (nested) grid coordinates and auxiliary parameters used for interpolation + !***************************************************************************** + call find_grid_indices(real(part(ipart)%xlon),real(part(ipart)%ylat)) + call find_grid_distances(real(part(ipart)%xlon),real(part(ipart)%ylat)) + + + if (kindz(part(ipart)%npoint).eq.1) return ! Nothing needs to happen + + ! If starting height is in pressure coordinates, retrieve pressure profile and + ! convert zpart1 to meters + !***************************************************************************** + + if (kindz(part(ipart)%npoint).eq.3) then + presspart=real(part(ipart)%z) + do kz=1,nz + if (ngrid.gt.0) then + r=p1*rhon(ix ,jy ,kz,2,ngrid) & + +p2*rhon(ixp,jy ,kz,2,ngrid) & + +p3*rhon(ix ,jyp,kz,2,ngrid) & + +p4*rhon(ixp,jyp,kz,2,ngrid) + t=p1*ttn(ix ,jy ,kz,2,ngrid) & + +p2*ttn(ixp,jy ,kz,2,ngrid) & + +p3*ttn(ix ,jyp,kz,2,ngrid) & + +p4*ttn(ixp,jyp,kz,2,ngrid) + else + r=p1*rho(ix ,jy ,kz,2) & + +p2*rho(ixp,jy ,kz,2) & + +p3*rho(ix ,jyp,kz,2) & + +p4*rho(ixp,jyp,kz,2) + t=p1*tt(ix ,jy ,kz,2) & + +p2*tt(ixp,jy ,kz,2) & + +p3*tt(ix ,jyp,kz,2) & + +p4*tt(ixp,jyp,kz,2) + endif + press=r*r_air*t/100. + if (kz.eq.1) pressold=press + + if (press.lt.presspart) then + if (kz.eq.1) then + call set_z(ipart,height(1)*0.5) + else + dp1=pressold-presspart + dp2=presspart-press + call set_z(ipart,(height(kz-1)*dp2+height(kz)*dp1) & + /(dp1+dp2)) + endif + exit + endif + pressold=press + end do + + ! If release positions are given in meters above sea level, subtract the + ! topography from the starting height + !*********************************************************************** + + else if (kindz(part(ipart)%npoint).eq.2) then + if (ngrid.gt.0) then + topo=p1*oron(ix ,jy ,ngrid) & + + p2*oron(ixp,jy ,ngrid) & + + p3*oron(ix ,jyp,ngrid) & + + p4*oron(ixp,jyp,ngrid) + else + topo=p1*oro(ix ,jy) & + + p2*oro(ixp,jy) & + + p3*oro(ix ,jyp) & + + p4*oro(ixp,jyp) + endif + call update_z(ipart,-topo) + endif + if (part(ipart)%z.lt.eps2) call set_z(ipart,eps2) ! Minimum starting height is eps2 + if (part(ipart)%z.gt.height(nz)-0.5) & + call set_z(ipart,height(nz)-0.5) ! Maximum starting height is uppermost level - 0.5 meters + + if (ipin.eq.3 .or. ipin.eq.4) then + if (part(ipart)%z.gt.zpoint2(part(ipart)%npoint)) & + zpoint2(part(ipart)%npoint)=real(part(ipart)%z) + if (part(ipart)%z.lt.zpoint1(part(ipart)%npoint)) & + zpoint1(part(ipart)%npoint)=real(part(ipart)%z) + endif + +end subroutine kindz_to_z + subroutine init_mass_conversion(ipart,ipoint) ! For special simulations, multiply particle concentration air density; ! Simply take the 2nd field in memory to do this (accurate enough) @@ -398,15 +439,15 @@ subroutine init_mass_conversion(ipart,ipoint) implicit none integer,intent(in) :: ipart,ipoint - integer :: n,k + integer :: n real :: rhoaux(2),rhoout real :: dz1,dz2 if ((ind_rel .eq. 1).or.(ind_rel .eq. 3).or.(ind_rel .eq. 4)) then - ! Interpolate the air density - !**************************** + ! Interpolate the air density, horizontal values are computed in kindz_to_z + !************************************************************************** call find_z_level_meters(real(part(ipart)%z)) call find_vert_vars_lin(height,real(part(ipart)%z),indz,dz1,dz2,lbounds) @@ -426,16 +467,13 @@ subroutine init_mass_conversion(ipart,ipoint) end do endif rhoout=dz2*rhoaux(1)+dz1*rhoaux(2) - rho_rel(ipoint)=rhoout !What is this???? + rho_rel(ipoint)=rhoout - ! Multiply "mass" (i.e., mass mixing ratio in forward runs) with density - !******************************************************************** - - do k=1,nspec - part(ipart)%mass(k)=part(ipart)%mass(k)*rhoout - part(ipart)%mass_init(k)=part(ipart)%mass(k) - end do + ! Multiply "mass" (i.e., mass mixing ratio in forward runs) with density + !*********************************************************************** + mass(ipart,:)=mass(ipart,:)*rhoout + mass_init(ipart,:)=mass(ipart,:) endif end subroutine init_mass_conversion @@ -550,7 +588,7 @@ subroutine readpartpositions do i=i+1 read(unitpartin) part(i)%npoint,xlonin,ylatin,part(i)%z,part(i)%tstart, & - topo,pvi,qvi,rhoi,hmixi,tri,tti,(part(i)%mass(j),j=1,nspec) + topo,pvi,qvi,rhoi,hmixi,tri,tti,(mass(i,j),j=1,nspec) ! For switching coordinates: this happens in timemanager.f90 after the first fields are read if (xlonin.eq.-9999.9) exit call set_xlon(i,real((xlonin-xlon0)/dx,kind=dp)) @@ -851,6 +889,8 @@ subroutine init_domainfill ! * ! Changes * ! 2022, L. Bakels: OpenMP parallelisation * + ! 2023, L. Bakels: smooth vertical particle distribution instead of * + ! distributing particles on fixed vertical layers * ! * !***************************************************************************** ! * @@ -869,7 +909,7 @@ subroutine init_domainfill implicit none - integer :: j,kz,lix,ljy,ncolumn,numparttot,stat + integer :: j,kz,lix,ljy,ncolumn,numparttot,stat,iterminate real :: ylat,ylatp,ylatm,hzone real :: cosfactm,cosfactp,deltacol,dz1,dz2,dz,pnew,pnew_temp,fractus real,parameter :: pih=pi/180. @@ -895,9 +935,9 @@ subroutine init_domainfill call alloc_domainfill nx_we(1)=max(int(xpoint1(1)),0) - nx_we(2)=min((int(xpoint2(1))+1),nxmin1) + nx_we(2)=min((ceiling(xpoint2(1))),nxmin1) ny_sn(1)=max(int(ypoint1(1)),0) - ny_sn(2)=min((int(ypoint2(1))+1),nymin1) + ny_sn(2)=min((ceiling(ypoint2(1))),nymin1) ! For global simulations (both global wind data and global domain-filling), ! set a switch, such that no boundary conditions are used @@ -918,7 +958,8 @@ subroutine init_domainfill ! Allocate grid and column mass !******************************* - allocate(gridarea(0:nymax-1),colmass(0:nxmax-1,0:nymax-1)) + allocate(gridarea(0:nymax-1),colmass(0:nxmax-1,0:nymax-1),stat=stat) + if (stat.ne.0) write(*,*)'ERROR: could not allocate gridarea or colmass' ! Do not release particles twice (i.e., not at both in the leftmost and rightmost ! grid cell) for a global domain @@ -959,7 +1000,7 @@ subroutine init_domainfill ! Allocate memory for storing the particles !****************************************** - call alloc_particles(npart(1)) + call alloc_particles(int(npart(1)*1.1)) ! A bit more to avoid single part alloc ! Initialise total particle number numparttot=0 @@ -1022,6 +1063,7 @@ subroutine init_domainfill ! Determine the particle positions !********************************* + iterminate=0 do ljy=ny_sn(1),ny_sn(2) ! loop about latitudes ylat=ylat0+real(ljy)*dy do lix=nx_we(1),nx_we(2) ! loop about longitudes @@ -1033,21 +1075,19 @@ subroutine init_domainfill ! information, which is stored as a 3-d field !***************************************************************************** - do kz=1,nz - pp(kz)=prs(lix,ljy,kz,1)!rho(lix,ljy,kz,1)*r_air*tt(lix,ljy,kz,1) - end do + pp(:)=prs(lix,ljy,:,1)!rho(lix,ljy,kz,1)*r_air*tt(lix,ljy,kz,1) deltacol=(pp(1)-pp(nz))/real(ncolumn) - pnew=pp(1)+deltacol/2. + pnew=pp(1)+deltacol*0.5 jj=0 do j=1,ncolumn ! looping over the number of particles within the column - ! For columns with many particles (i.e. around the equator), distribute - ! the particles equally (1 on a random position within the deltacol range), - ! for columns with few particles (i.e. around the poles), - ! distribute the particles randomly - !*********************************************************************** + ! For columns with many particles (i.e. around the equator), distribute + ! the particles equally (1 on a random position within the deltacol range), + ! for columns with few particles (i.e. around the poles), + ! distribute the particles randomly + !*********************************************************************** if ((ncolumn.gt.20).and.(ncolumn-j.gt.20)) then pnew_temp=pnew-ran1(idummy,0)*deltacol @@ -1142,13 +1182,14 @@ subroutine init_domainfill numparticlecount=numparticlecount+1 part(numpart+jj)%npoint=numparticlecount part(numpart+jj)%idt=mintime - part(numpart+jj)%mass(1)=colmass(lix,ljy)/real(ncolumn) - if (mdomainfill.eq.2) part(numpart+jj)%mass(1)= & - part(numpart+jj)%mass(1)*pvpart*48./29.*ozonescale/10.**9 - part(numpart+jj)%mass_init(1)=part(numpart+jj)%mass(1) + mass(numpart+jj,1)=colmass(lix,ljy)/real(ncolumn) + if (mdomainfill.eq.2) mass(numpart+jj,1)= & + mass(numpart+jj,1)*pvpart*48./29.*ozonescale/10.**9 + mass_init(numpart+jj,1)=mass(numpart+jj,1) else call terminate_particle(numpart+jj, 0) jj=jj-1 + iterminate=iterminate+1 endif endif endif @@ -1173,10 +1214,13 @@ subroutine init_domainfill if ((part(j)%xlon.lt.0.).or.(part(j)%xlon.ge.real(nxmin1,kind=dp)).or. & (part(j)%ylat.lt.0.).or.(part(j)%ylat.ge.real(nymin1,kind=dp))) then call terminate_particle(j,0) ! Cannot be within an OMP region + iterminate=iterminate+1 ! alive_tmp=alive_tmp-1 ! terminated_tmp=terminated_tmp+1 endif end do + + if (iterminate.gt.0) call rewrite_ialive() ! !$OMP END DO ! !$OMP END PARALLEL @@ -1210,7 +1254,7 @@ subroutine init_domainfill write(*,*) 'Total number of particles at model start: ',numpart write(*,*) 'Maximum number of particles per column: ',numcolumn write(*,*) 'If ',fractus,' <1, better use more particles' - fractus=sqrt(max(fractus,1.))/2. + fractus=sqrt(max(fractus,1.))*0.5 do ljy=ny_sn(1),ny_sn(2) ! loop about latitudes do lix=nx_we(1),nx_we(2) ! loop about longitudes @@ -1242,7 +1286,7 @@ subroutine init_domainfill !******************************************* deltacol=(pp(1)-pp(nz))/real(ncolumn) - pnew=pp(1)+deltacol/2. + pnew=pp(1)+deltacol*0.5 do j=1,ncolumn pnew=pnew-deltacol do kz=1,nz-1 @@ -1343,14 +1387,14 @@ subroutine boundcond_domainfill(itime,loutend) real :: dz,dz1,dz2,dt1,dt2,dtt,ylat,cosfact,accmasst integer :: itime,ii,indz,indzp,i,loutend,numparticlecount_tmp integer :: j,k,ix,jy,m,indzh,indexh,ipart,mmass,ithread - integer :: numactiveparticles + integer :: numactiveparticles,iterminate real :: windl(2),rhol(2) real :: windhl(2),rhohl(2) real :: windx,rhox real :: deltaz,boundarea,fluxofmass - integer :: ixm,ixp,jym,jyp,indzm,mm + integer :: ixm,ixp,jym,jyp,indzm,mm,iterm_index real :: pvpart,ddx,ddy,rddx,rddy,p1,p2,p3,p4,y1(2),yh1(2) integer :: idummy = -11 @@ -1374,18 +1418,25 @@ subroutine boundcond_domainfill(itime,loutend) ! Terminate trajectories that have left the domain, if domain-filling ! trajectory calculation domain is not global !******************************************************************** + if (ipin.le.1 .and. ipout.eq.0) call rewrite_iterm() + iterminate=0 do i=1,count%allocated if (.not. part(i)%alive) cycle - if ((part(i)%ylat.gt.real(ny_sn(2))).or. & - (part(i)%ylat.lt.real(ny_sn(1)))) call terminate_particle(i,itime) + if ((part(i)%ylat.gt.real(ny_sn(2))).or.(part(i)%ylat.lt.real(ny_sn(1)))) then + call terminate_particle(i,itime) + iterminate=iterminate+1 + endif if (((.not.xglobal).or.(nx_we(2).ne.(nx-2))).and. & ((part(i)%xlon.lt.real(nx_we(1))).or. & - (part(i)%xlon.gt.real(nx_we(2))))) call terminate_particle(i,itime) + (part(i)%xlon.gt.real(nx_we(2))))) then + call terminate_particle(i,itime) + iterminate=iterminate+1 + endif if (part(i)%alive) numactiveparticles = numactiveparticles+1 end do - + if (iterminate.gt.0) call rewrite_ialive() !*************************************** ! Western and eastern boundary condition !*************************************** @@ -1403,7 +1454,8 @@ subroutine boundcond_domainfill(itime,loutend) ! #else ! ithread = 0 ! #endif - + ithread=0 + iterm_index=1 ! !$OMP DO do jy=ny_sn(1),ny_sn(2) @@ -1421,13 +1473,13 @@ subroutine boundcond_domainfill(itime,loutend) !***************************************************************************** if (j.eq.1) then - deltaz=(zcolumn_we(k,jy,2)+zcolumn_we(k,jy,1))/2. + deltaz=(zcolumn_we(k,jy,2)+zcolumn_we(k,jy,1))*0.5 else if (j.eq.numcolumn_we(k,jy)) then ! In order to avoid taking a very high column for very many particles, ! use the deltaz from one particle below instead - deltaz=(zcolumn_we(k,jy,j)-zcolumn_we(k,jy,j-2))/2. + deltaz=(zcolumn_we(k,jy,j)-zcolumn_we(k,jy,j-2))*0.5 else - deltaz=(zcolumn_we(k,jy,j+1)-zcolumn_we(k,jy,j-1))/2. + deltaz=(zcolumn_we(k,jy,j+1)-zcolumn_we(k,jy,j-1))*0.5 endif if ((jy.eq.ny_sn(1)).or.(jy.eq.ny_sn(2))) then boundarea=deltaz*111198.5/2.*dy @@ -1506,8 +1558,8 @@ subroutine boundcond_domainfill(itime,loutend) ! reduced by the mass of this (these) particle(s) !****************************************************************************** - if (acc_mass_we(k,jy,j).ge.xmassperparticle/2.) then - mmass=int((acc_mass_we(k,jy,j)+xmassperparticle/2.)/ & + if (acc_mass_we(k,jy,j).ge.xmassperparticle*0.5) then + mmass=int((acc_mass_we(k,jy,j)+xmassperparticle*0.5)/ & xmassperparticle) acc_mass_we(k,jy,j)=acc_mass_we(k,jy,j)- & real(mmass)*xmassperparticle @@ -1517,7 +1569,7 @@ subroutine boundcond_domainfill(itime,loutend) do m=1,mmass !THIS WILL CAUSE PROBLEMS WITH OMP! because of dynamical allocation - call get_newpart_index(ipart) + call get_newpart_index(ipart,iterm_index) call spawn_particle(itime, ipart) ! Assign particle positions @@ -1598,10 +1650,10 @@ subroutine boundcond_domainfill(itime,loutend) part(ipart)%npoint=numparticlecount_tmp part(ipart)%idt=mintime part(ipart)%tstart=itime - part(ipart)%mass(1)=xmassperparticle - if (mdomainfill.eq.2) part(ipart)%mass(1)= & - part(ipart)%mass(1)*pvpart*48./29.*ozonescale/10.**9 - part(ipart)%mass_init(1)=part(ipart)%mass(1) + mass(ipart,1)=xmassperparticle + if (mdomainfill.eq.2) mass(ipart,1)= & + mass(ipart,1)*pvpart*48./29.*ozonescale/10.**9 + mass_init(ipart,1)=mass(ipart,1) else stop 'boundcond_domainfill error: look into original to understand what should happen here' endif @@ -1636,18 +1688,18 @@ subroutine boundcond_domainfill(itime,loutend) !***************************************************************************** if (j.eq.1) then - deltaz=(zcolumn_sn(k,ix,2)+zcolumn_sn(k,ix,1))/2. + deltaz=(zcolumn_sn(k,ix,2)+zcolumn_sn(k,ix,1))*0.5 else if (j.eq.numcolumn_sn(k,ix)) then ! deltaz=height(nz)-(zcolumn_sn(k,ix,j-1)+ ! + zcolumn_sn(k,ix,j))/2. ! In order to avoid taking a very high column for very many particles, ! use the deltaz from one particle below instead - deltaz=(zcolumn_sn(k,ix,j)-zcolumn_sn(k,ix,j-2))/2. + deltaz=(zcolumn_sn(k,ix,j)-zcolumn_sn(k,ix,j-2))*0.5 else - deltaz=(zcolumn_sn(k,ix,j+1)-zcolumn_sn(k,ix,j-1))/2. + deltaz=(zcolumn_sn(k,ix,j+1)-zcolumn_sn(k,ix,j-1))*0.5 endif if ((ix.eq.nx_we(1)).or.(ix.eq.nx_we(2))) then - boundarea=deltaz*111198.5/2.*cosfact*dx + boundarea=deltaz*111198.5*0.5*cosfact*dx else boundarea=deltaz*111198.5*cosfact*dx endif @@ -1722,8 +1774,8 @@ subroutine boundcond_domainfill(itime,loutend) ! reduced by the mass of this (these) particle(s) !****************************************************************************** - if (acc_mass_sn(k,ix,j).ge.xmassperparticle/2.) then - mmass=int((acc_mass_sn(k,ix,j)+xmassperparticle/2.)/ & + if (acc_mass_sn(k,ix,j).ge.xmassperparticle*0.5) then + mmass=int((acc_mass_sn(k,ix,j)+xmassperparticle*0.5)/ & xmassperparticle) acc_mass_sn(k,ix,j)=acc_mass_sn(k,ix,j)- & real(mmass)*xmassperparticle @@ -1732,7 +1784,7 @@ subroutine boundcond_domainfill(itime,loutend) endif do m=1,mmass - call get_newpart_index(ipart) + call get_newpart_index(ipart,iterm_index) call spawn_particle(itime, ipart) ! Assign particle positions @@ -1810,10 +1862,10 @@ subroutine boundcond_domainfill(itime,loutend) numparticlecount_tmp=numparticlecount_tmp+1 part(ipart)%npoint=numparticlecount_tmp part(ipart)%idt=mintime - part(ipart)%mass(1)=xmassperparticle - if (mdomainfill.eq.2) part(ipart)%mass(1)= & - part(ipart)%mass(1)*pvpart*48./29.*ozonescale/10.**9 - part(ipart)%mass_init(1)=part(ipart)%mass(1) + mass(ipart,1)=xmassperparticle + if (mdomainfill.eq.2) mass(ipart,1)= & + mass(ipart,1)*pvpart*48./29.*ozonescale/10.**9 + mass_init(ipart,1)=mass(ipart,1) else stop 'boundcond_domainfill error: look into original to understand what should happen here' endif @@ -1823,6 +1875,7 @@ subroutine boundcond_domainfill(itime,loutend) end do ! north south ! !$OMP END DO ! !$OMP END PARALLEL + if (ipin.le.1 .and. ipout.eq.0) call rewrite_iterm() numparticlecount = numparticlecount_tmp ! If particles shall be dumped, then accumulated masses at the domain boundaries ! must be dumped, too, to be used for later runs diff --git a/src/interpol_mod.f90 b/src/interpol_mod.f90 index fca16b18c3ad6436189f8f621a593e1676b970a3..8cd29e3ffb5739c2524810f0d44d4f528a82817b 100644 --- a/src/interpol_mod.f90 +++ b/src/interpol_mod.f90 @@ -1206,6 +1206,381 @@ subroutine interpol_density(itime,ipart,output) call vert_interpol(rhoprof(1),rhoprof(2),dz1,dz2,output) end subroutine interpol_density +subroutine interpol_rain(itime,kz,yint1,yint2,yint3,ytint,yint4,intiy1,intiy2,icmv) + ! i i o o o o o o o i + !**************************************************************************** + ! * + ! Interpolation of meteorological fields on 2-d model layers. * + ! In horizontal direction bilinear interpolation is used. * + ! Temporally a linear interpolation is used. * + ! Seven fields are interpolated at the same time. * + ! * + ! This is a special version of levlininterpol to save CPU time. * + ! * + ! 1 first time * + ! 2 second time * + ! * + ! * + ! Author: A. Stohl * + ! * + ! 30 August 1996 * + ! * + ! * + ! PS, AP 04/2019, 11/2020: * + ! put back temporal interpolation of rain, from v10.01 * + ! and cloud bottom / thickness interpolation * + ! PS, AP 01/2021: * + ! interpolate particle temperature and cloud total water * + ! PS, AP 02/2021: * + ! interpolation of precipitation using two additional fields * + ! which are temporally equidistant between the main fields * + ! * + !**************************************************************************** + ! * + ! Variables: * + ! * + ! dt1,dt2 time differences between fields and current position * + ! dz1,dz2 z distance between levels and current position * + ! height(nzmax) heights of the model levels * + ! mm help variable * + ! indz the level closest to the current trajectory position * + ! indzh help variable * + ! itime current time * + ! ix,jy x,y coordinates of lower left subgrid point * + ! level level at which interpolation shall be done 2d, =1 * + ! kz level at which interpolation shall be done * + ! memind(3) points to the places of the wind fields * + ! nx,ny actual field dimensions in x,y and z direction * + ! nxmax,nymax,nzmax maximum field dimensions in x,y and z direction * + ! xt current x coordinate * + ! yint the final interpolated value * + ! yt current y coordinate * + ! yy?(0:nxmax,0:nymax,nzx2d,3) meteorological field used for interpolation * + ! yyt(0:nxmax,0:nymax,nzmax,3) tt field * + ! iy1,iy2(0:nxmax,0:nymax,3) cloud bottom, thickness fields (integer) * + ! zt current z coordinate * + ! * + !**************************************************************************** + use par_mod, only: numwfmem, numpf + use com_mod, only: lcw + + implicit none + + integer, intent(in) :: kz, icmv, itime + integer, intent(out) :: intiy1,intiy2 + real, intent(out) :: yint1,yint2,yint3,ytint,yint4 + integer :: m + integer :: mm + real :: ip1,ip2,ip3,ip4,ipsum + real :: dt,dtp1,dtp2,rt + real :: y1(2),y2(2),y3(2),y4(2),yi1(2),yi2(2),ytt(2) ! interpolated values + + integer, dimension(2) :: ip, mp + + !********************************************************************** + ! 1.) Bilinear horizontal interpolation + ! This has to be done separately for 2 fields (Temporal) + !******************************************************* + ! Loop over 2 time steps + !*********************** + + !------------------------------------------------------------------------- + ! PS, AT new interpolation of precip with 2 additional fields + ! therefore, we need a special treatment of lsp,cp which are in yy1,yy2 + !------------------------------------------------------------------------- + ! + ! 1.1 1.2 1.3 ip(1).mp(1) + ! 1.2 1.3 2.1 ip(2).mp(2) + ! + ! ||___|___|___||___|___|___|| + ! + ! ip 1 2 3 1 2 3 1 + ! m 1 2 + ! + !------------------------------------------------------------------------- + + dt1 = real(itime - memtime(1)) + dt2 = real(memtime(2) - itime) + dt = real(memtime(2) - memtime(1)) + if (dt.eq.0. .and. dt1.eq.0.) then ! Fix if last last timestep and memtime(2)=memtime(1) + dt = 1. + dt2 = 1. + endif + dtt = dt/3. + if (numpf .eq. 1) then + mp(1) = 1 + mp(2) = 2 + ip(1) = 1 + ip(2) = 1 + dtp1 = dt1 + dtp2 = dt2 + else + rt = abs(dt1/dt) + if (0 .le. rt .and. rt .lt. 1./3.) then + mp(1) = 1 + mp(2) = 1 + ip(1) = 1 + ip(2) = 2 + dtp1 = dt1 + dtp2 = dt2 - 2.*dtt + elseif (1./3. .le. rt .and. rt .lt. 2./3.) then + mp(1) = 1 + mp(2) = 1 + ip(1) = 2 + ip(2) = 3 + dtp1 = dt1 - dtt + dtp2 = dt2 - dtt + elseif (2./3. .le. rt .and. rt .lt. 1.) then + mp(1) = 1 + mp(2) = 2 + ip(1) = 3 + ip(2) = 1 + dtp1 = dt1 - 2.*dtt + dtp2 = dt2 + endif + endif + + + if (ngrid.le.0) then ! No nest + do m=1,2 + mm=memind(mp(m)) + y1(m)= p1*lsprec(ix ,jy ,1,ip(m),mm) & + + p2*lsprec(ixp,jy ,1,ip(m),mm) & + + p3*lsprec(ix ,jyp,1,ip(m),mm) & + + p4*lsprec(ixp,jyp,1,ip(m),mm) + y2(m)= p1*convprec(ix ,jy ,1,ip(m),mm) & + + p2*convprec(ixp,jy ,1,ip(m),mm) & + + p3*convprec(ix ,jyp,1,ip(m),mm) & + + p4*convprec(ixp,jyp,1,ip(m),mm) + + mm=memind(m) + y3(m)= p1*tcc(ix ,jy ,1,mm) & + + p2*tcc(ixp,jy ,1,mm) & + + p3*tcc(ix ,jyp,1,mm) & + + p4*tcc(ixp,jyp,1,mm) +#ifdef ETA + ytt(m)=p1*tteta(ix ,jy ,kz,mm) & + + p2*tteta(ixp,jy ,kz,mm) & + + p3*tteta(ix ,jyp,kz,mm) & + + p4*tteta(ixp,jyp,kz,mm) +#else + ytt(m)=p1*tt(ix ,jy ,kz,mm) & + + p2*tt(ixp,jy ,kz,mm) & + + p3*tt(ix ,jyp,kz,mm) & + + p4*tt(ixp,jyp,kz,mm) +#endif + if (lcw) & + y4(m)= p1*ctwc(ix ,jy ,mm) & + + p2*ctwc(ixp,jy ,mm) & + + p3*ctwc(ix ,jyp,mm) & + + p4*ctwc(ixp,jyp,mm) + + !PS clouds: + ip1=1. + ip2=1. + ip3=1. + ip4=1. + ipsum=1. + if (icloudbot(ix ,jy ,mm) .eq. icmv) then + ip1=0. + ipsum=ipsum-p1 + endif + if (icloudbot(ixp,jy ,mm) .eq. icmv) then + ip2=0. + ipsum=ipsum-p2 + endif + if (icloudbot(ix ,jyp,mm) .eq. icmv) then + ip3=0. + ipsum=ipsum-p3 + endif + if (icloudbot(ixp,jyp,mm) .eq. icmv) then + ip4=0. + ipsum=ipsum-p4 + endif + if (ipsum .eq. 0.) then + yi1(m)=icmv + else + yi1(m)=(ip1*p1*icloudbot(ix ,jy ,mm) & + + ip2*p2*icloudbot(ixp,jy ,mm) & + + ip3*p3*icloudbot(ix ,jyp,mm) & + + ip4*p4*icloudbot(ixp,jyp,mm))/ipsum + ! AP test output + ! if (yi1(m) .lt. 1.) then + ! write(*,*) ip1,ip2,ip3,ip4,ipsum + ! write(*,*) p1,p2,p3,p4 + ! write(*,*) iy1(ix ,jy ,mm), iy1(ixp,jy ,mm), iy1(ix ,jyp,mm), iy1(ixp,jyp,mm) + ! endif + + endif + + ip1=1. + ip2=1. + ip3=1. + ip4=1. + ipsum=1. + if (icloudtop(ix ,jy ,mm) .eq. icmv) then + ip1=0. + ipsum=ipsum-p1 + endif + if (icloudtop(ixp,jy ,mm) .eq. icmv) then + ip2=0. + ipsum=ipsum-p2 + endif + if (icloudtop(ix ,jyp,mm) .eq. icmv) then + ip3=0. + ipsum=ipsum-p3 + endif + if (icloudtop(ixp,jyp,mm) .eq. icmv) then + ip4=0. + ipsum=ipsum-p4 + endif + if (ipsum .eq. 0.) then + yi2(m)=icmv + else + yi2(m)=(ip1*p1*icloudtop(ix ,jy ,mm) & + + ip2*p2*icloudtop(ixp,jy ,mm) & + + ip3*p3*icloudtop(ix ,jyp,mm) & + + ip4*p4*icloudtop(ixp,jyp,mm))/ipsum + endif + !PS end clouds + end do + else ! Nest + do m=1,2 + mm=memind(mp(m)) + y1(m)= p1*lsprecn(ix ,jy ,1,ip(m),mm,ngrid) & + + p2*lsprecn(ixp,jy ,1,ip(m),mm,ngrid) & + + p3*lsprecn(ix ,jyp,1,ip(m),mm,ngrid) & + + p4*lsprecn(ixp,jyp,1,ip(m),mm,ngrid) + y2(m)= p1*convprecn(ix ,jy ,1,ip(m),mm,ngrid) & + + p2*convprecn(ixp,jy ,1,ip(m),mm,ngrid) & + + p3*convprecn(ix ,jyp,1,ip(m),mm,ngrid) & + + p4*convprecn(ixp,jyp,1,ip(m),mm,ngrid) + + mm=memind(m) + y3(m)= p1*tccn(ix ,jy ,1,mm,ngrid) & + + p2*tccn(ixp,jy ,1,mm,ngrid) & + + p3*tccn(ix ,jyp,1,mm,ngrid) & + + p4*tccn(ixp,jyp,1,mm,ngrid) +#ifdef ETA + ytt(m)=p1*ttetan(ix ,jy ,kz,mm,ngrid) & + + p2*ttetan(ixp,jy ,kz,mm,ngrid) & + + p3*ttetan(ix ,jyp,kz,mm,ngrid) & + + p4*ttetan(ixp,jyp,kz,mm,ngrid) +#else + ytt(m)=p1*ttn(ix ,jy ,kz,mm,ngrid) & + + p2*ttn(ixp,jy ,kz,mm,ngrid) & + + p3*ttn(ix ,jyp,kz,mm,ngrid) & + + p4*ttn(ixp,jyp,kz,mm,ngrid) +#endif + if (lcw_nest(ngrid)) & + y4(m)= p1*ctwcn(ix ,jy ,mm,ngrid) & + + p2*ctwcn(ixp,jy ,mm,ngrid) & + + p3*ctwcn(ix ,jyp,mm,ngrid) & + + p4*ctwcn(ixp,jyp,mm,ngrid) + + !PS clouds: + ip1=1. + ip2=1. + ip3=1. + ip4=1. + ipsum=1. + if (icloudbotn(ix ,jy ,mm,ngrid) .eq. icmv) then + ip1=0. + ipsum=ipsum-p1 + endif + if (icloudbotn(ixp,jy ,mm,ngrid) .eq. icmv) then + ip2=0. + ipsum=ipsum-p2 + endif + if (icloudbotn(ix ,jyp,mm,ngrid) .eq. icmv) then + ip3=0. + ipsum=ipsum-p3 + endif + if (icloudbotn(ixp,jyp,mm,ngrid) .eq. icmv) then + ip4=0. + ipsum=ipsum-p4 + endif + if (ipsum .eq. 0.) then + yi1(m)=icmv + else + yi1(m)=(ip1*p1*icloudbotn(ix ,jy ,mm,ngrid) & + + ip2*p2*icloudbotn(ixp,jy ,mm,ngrid) & + + ip3*p3*icloudbotn(ix ,jyp,mm,ngrid) & + + ip4*p4*icloudbotn(ixp,jyp,mm,ngrid))/ipsum + endif + + ip1=1. + ip2=1. + ip3=1. + ip4=1. + ipsum=1. + if (icloudtopn(ix ,jy ,mm,ngrid) .eq. icmv) then + ip1=0. + ipsum=ipsum-p1 + endif + if (icloudtopn(ixp,jy ,mm,ngrid) .eq. icmv) then + ip2=0. + ipsum=ipsum-p2 + endif + if (icloudtopn(ix ,jyp,mm,ngrid) .eq. icmv) then + ip3=0. + ipsum=ipsum-p3 + endif + if (icloudtopn(ixp,jyp,mm,ngrid) .eq. icmv) then + ip4=0. + ipsum=ipsum-p4 + endif + if (ipsum .eq. 0.) then + yi2(m)=icmv + else + yi2(m)=(ip1*p1*icloudtopn(ix ,jy ,mm,ngrid) & + + ip2*p2*icloudtopn(ixp,jy ,mm,ngrid) & + + ip3*p3*icloudtopn(ix ,jyp,mm,ngrid) & + + ip4*p4*icloudtopn(ixp,jyp,mm,ngrid))/ipsum + endif + !PS end clouds + end do + endif + + !************************************ + ! 2.) Temporal interpolation (linear) + !************************************ + + yint1=(y1(1)*dtp2+y1(2)*dtp1)/dtt ! lsp + yint2=(y2(1)*dtp2+y2(2)*dtp1)/dtt ! cp + + yint3=(y3(1)*dt2+y3(2)*dt1)/dt + yint4=(y4(1)*dt2+y4(2)*dt1)/dt + ytint=(ytt(1)*dt2+ytt(2)*dt1)/dt + +!PS clouds:450. + +! write(*,*) yi1(1),yi1(2),yi2(1),yi2(2),dt,dt1,dt2 + intiy1=int((yi1(1)*dt2 + yi1(2)*dt1)/dt) + if (int(yi1(1)) .eq. icmv) intiy1=int(yi1(2)) + if (int(yi1(2)) .eq. icmv) intiy1=int(yi1(1)) + + intiy2=int((yi2(1)*dt2 + yi2(2)*dt1)/dt) + if (int(yi2(1)) .eq. icmv) intiy2=int(yi2(2)) + if (int(yi2(2)) .eq. icmv) intiy2=int(yi2(1)) + +! write(*,*) 'before cbot: ', intiy1, ' cthick: ', intiy2 + if (intiy1 .ne. icmv .and. intiy2 .ne. icmv) then + intiy2 = intiy2 !intiy1 + intiy2 ! convert cloud thickness to cloud top + else + intiy1=icmv + intiy2=icmv + endif + if (intiy2 .ne. icmv .and. intiy2 .lt. 0) then + write(*,*) itime, memind(1), memind(2) + write(*,*) yi1(1),yi1(2),yi2(1),yi2(2),dt,dt1,dt2 + write(*,*) 'final cbot: ', intiy1, ' ctop: ', intiy2 + stop 'intiy2 (cloud top) negative' + endif +!PS end clouds + +end subroutine interpol_rain + !********************* !* PRIVATE FUNCTIONS * !********************* diff --git a/src/list-of-modules.txt b/src/list-of-modules.txt deleted file mode 100644 index e16dc5e18d9695640e22fb0e97dfa69708d12304..0000000000000000000000000000000000000000 --- a/src/list-of-modules.txt +++ /dev/null @@ -1,39 +0,0 @@ - 10 xmass_mod.f90 WHY DO WE NEED EXTRA MODULE? - 99 unc_mod.f90 A BIT STRANGE FOR ME. SHOULD GO IN OUTG? - 135 point_mod.f90 WHY IS THIS A MODULE? BUNDLE WITH READINPUT? - 154 date_mod.f90 - 171 txt_output_mod.f90 SHOULD GO IN OUTPUT? - 179 random_mod.f90 MAYBE BUNDLE WITH ERF? - 197 qvsat_mod.f90 MAYBE BUNDLE WITH OTHER THERMODY STUFF? - 201 erf_mod.f90 - 217 settling_mod.f90 MAYBE BUNDLE WITH DRYDEPO? - 233 mean_mod.f90 - 320 par_mod.f90 - 400 FLEXPART.f90 - 419 cbl_mod.f90 - 419 class_gribfile_mod.f90 WILL REPLACE THIS WITH MY CODE - 450 oh_mod.f90 - 475 coordinates_ecmwf_mod.f90 NEED A NEW NAME - 525 com_mod.f90 - 545 flux_mod.f90 - 663 timemanager_mod.f90 - 686 plume_mod.f90 - 717 turbulence_mod.f90 RENAME TURB_MOD? - 746 particle_mod.f90 RENAME PART_MOD? - 814 advance_mod.f90 - 816 cmapf_mod.f90 - 838 wetdepo_mod.f90 - 876 outg_mod.f90 RENAME OUTGRID_MOD? - 952 output_mod_old.f90 REMOVE? - 1495 output_mod.f90 - 1540 drydepo_mod.f90 - 1558 interpol_mod.f90 RENAME INTERP_MOD? - 1684 getfields_mod.f90 - 1949 verttransform_mod.f90 - 2009 initialise_mod.f90 IF DOMAINFILLING ONLY, RENAME INITDOMFILL_MOD? - 2196 conv_mod.f90 - 2767 netcdf_output_mod.f90 - 3309 readoptions_mod.f90 - 4115 windfields_mod.f90 - 4546 binary_output_mod.f90 - 39425 total diff --git a/src/make_command.sh b/src/make_command.sh new file mode 100755 index 0000000000000000000000000000000000000000..deb0e704a23a0da693480e6e4455e4a5d0c7a559 --- /dev/null +++ b/src/make_command.sh @@ -0,0 +1,23 @@ + +module purge +module load eccodes +export CPATH=/opt/tools/eccodes/2.28.0-gcc9.4/include:/opt/tools/netcdf-fortran/4.6.0-gcc9.4/include +export LIBRARY_PATH=$LIBRARY_PATH:/opt/tools/eccodes/2.28.0-gcc9.4/lib + +rm -f *.o *.mod + +# eta ncf - new default FLEXPART_ETA +FC=/opt/tools/gcc/9.4.0/bin/gfortran make -f makefile_gfortran +#executable: FLEXPART_ETA + +# meter bin - classic +#FC=/opt/tools/gcc/9.4.0/bin/gfortran make -f makefile_gfortran eta=no ncf=no +# executable: FLEXPART_BIN + +# meter ncf: +#FC=/opt/tools/gcc/9.4.0/bin/gfortran make -f makefile_gfortran eta=no +# executable: FLEXPART + +# eta/bin +#FC=/opt/tools/gcc/9.4.0/bin/gfortran make -f makefile_gfortran ncf=no +# executable: FLEXPART_ETA_BIN diff --git a/src/makefile_gfortran b/src/makefile_gfortran index 7164cc73f35acb40fbfbd7b01845d18ea1b44ba6..6b0c04d73d4a7ad380e4f7add40fc3f0fe93fb7f 100644 --- a/src/makefile_gfortran +++ b/src/makefile_gfortran @@ -94,6 +94,8 @@ else FUSER = -g -fopenmp -march=native -mtune=native endif +# To compile in serial +#FUSER = -g -fopenmp_stubs -march=skylake-avx512 mpi: FUSER := $(FUSER) -Dusempi #-MM -MT -MD ## LIBRARIES @@ -115,20 +117,23 @@ date_mod.o drydepo_mod.o \ erf_mod.o flux_mod.o \ getfields_mod.o initialise_mod.o \ interpol_mod.o mean_mod.o \ -ohr_mod.o outgrid_mod.o \ +outgrid_mod.o \ output_mod.o par_mod.o \ particle_mod.o pbl_profile_mod.o \ plume_mod.o point_mod.o \ random_mod.o readoptions_mod.o \ restart_mod.o settling_mod.o \ -sort_mod.o \ +sort_mod.o \ timemanager_mod.o turbulence_mod.o \ txt_output_mod.o unc_mod.o \ verttransform_mod.o wetdepo_mod.o \ windfields_mod.o qvsat_mod.o \ -xmass_mod.o +xmass_mod.o receptor_mod.o -OBJECTS_NCF = netcdf_output_mod.o +OBJECTS_NCF = \ +netcdf_output_mod.o chemistry_mod.o \ +totals_mod.o initdomain_mod.o \ +receptor_netcdf_mod.o emissions_mod.o \ OBJECTS_ETA = coord_ecmwf_mod.o @@ -153,6 +158,8 @@ else endif endif +$(info $(OBJECTS)) + %.o: %.mod # serial executable @@ -174,6 +181,8 @@ $(FP): $(MODOBJS) $(OBJECTS) clean: \rm -f *.o *.mod +.PHONY: clean + cleanall: \rm -f *.o *.mod $(FLEXPART) $(FLEXPART-BIN) $(FLEXPART-ETA) $(FLEXPART-ETA-BIN) @@ -249,7 +258,6 @@ endif verttransform_mod.o: par_mod.o com_mod.o qvsat_mod.o windfields_mod.o settling_mod.o: windfields_mod.o interpol_mod.o: windfields_mod.o particle_mod.o turbulence_mod.o -ohr_mod.o: windfields_mod.o particle_mod.o #5) ifneq ($(eta),no) @@ -261,12 +269,12 @@ drydepo_mod.o: unc_mod.o interpol_mod.o erf_mod.o ifneq ($(eta),no) advance_mod.o: coord_ecmwf_mod.o settling_mod.o drydepo_mod.o turbulence_mod.o plume_mod.o: mean_mod.o coord_ecmwf_mod.o -outgrid_mod.o: ohr_mod.o unc_mod.o coord_ecmwf_mod.o +outgrid_mod.o: unc_mod.o coord_ecmwf_mod.o wetdepo_mod.o: coord_ecmwf_mod.o unc_mod.o else advance_mod.o: interpol_mod.o settling_mod.o drydepo_mod.o turbulence_mod.o plume_mod.o: mean_mod.o particle_mod.o windfields_mod.o -outgrid_mod.o: ohr_mod.o unc_mod.o interpol_mod.o +outgrid_mod.o: unc_mod.o interpol_mod.o wetdepo_mod.o: interpol_mod.o unc_mod.o endif readoptions_mod.o: drydepo_mod.o xmass_mod.o @@ -277,7 +285,23 @@ flux_mod.o: outgrid_mod.o qvsat_mod.o txt_output_mod.o: outgrid_mod.o binary_output_mod.o: mean_mod.o outgrid_mod.o ifneq ($(ncf), no) +receptor_mod.o: par_mod.o com_mod.o point_mod.o particle_mod.o date_mod.o \ + windfields_mod.o receptor_netcdf_mod.o binary_output_mod.o +else +receptor_mod.o: par_mod.o com_mod.o point_mod.o particle_mod.o date_mod.o \ + windfields_mod.o binary_output_mod.o +endif +ifneq ($(ncf), no) netcdf_output_mod.o: mean_mod.o outgrid_mod.o readoptions_mod.o drydepo_mod.o +totals_mod.o: par_mod.o com_mod.o netcdf_output_mod.o +chemistry_mod.o: par_mod.o com_mod.o date_mod.o particle_mod.o \ + point_mod.o windfields_mod.o totals_mod.o netcdf_output_mod.o +initdomain_mod.o: par_mod.o com_mod.o point_mod.o random_mod.o outgrid_mod.o \ + initialise_mod.o totals_mod.o date_mod.o windfields_mod.o netcdf_output_mod.o +receptor_netcdf_mod.o: par_mod.o com_mod.o point_mod.o date_mod.o \ + windfields_mod.o netcdf_output_mod.o +emissions_mod.o: par_mod.o com_mod.o point_mod.o particle_mod.o date_mod.o \ + netcdf_output_mod.o totals_mod.o windfields_mod.o endif #8) @@ -302,7 +326,14 @@ endif initialise_mod.o: interpol_mod.o xmass_mod.o output_mod.o turbulence_mod.o #10) -timemanager_mod.o: advance_mod.o conv_mod.o plume_mod.o getfields_mod.o restart_mod.o initialise_mod.o +ifneq ($(ncf), no) +timemanager_mod.o: advance_mod.o conv_mod.o plume_mod.o getfields_mod.o restart_mod.o \ + initialise_mod.o chemistry_mod.o initdomain_mod.o receptor_mod.o \ + emissions_mod.o totals_mod.o +else +timemanager_mod.o: advance_mod.o conv_mod.o plume_mod.o getfields_mod.o restart_mod.o \ + initialise_mod.o receptor_mod.o +endif #11) ifneq ($(GIT_VERSION),$(GIT_OLD)) diff --git a/src/netcdf_output_mod.f90 b/src/netcdf_output_mod.f90 index f462adb7203e300ccf65484dfd1e4729eae902a8..5d8655d6cf8506079384f10027b1d73f8eab3b17 100644 --- a/src/netcdf_output_mod.f90 +++ b/src/netcdf_output_mod.f90 @@ -14,20 +14,23 @@ ! * ! 12 April 2013 * ! * - ! HSO: 21 Oct 2014 - ! - added option to not writeout releases information by changing - ! switch write_releases - ! - additional updates for FLEXPART 9.x - ! - ! ESO 2016 - ! - Deposition fields can be calculated in double precision, see variable - ! 'dep_prec' in par_mod - ! - Hardcoded options 'write_vol' and 'write_area' for grid cell - ! volume and area - ! + ! HSO: 21 Oct 2014 * + ! - added option to not writeout releases information by changing * + ! switch write_releases * + ! - additional updates for FLEXPART 9.x * + ! * + ! ESO 2016 * + ! - Deposition fields can be calculated in double precision, see variable * + ! 'dep_prec' in par_mod * + ! - Hardcoded options 'write_vol' and 'write_area' for grid cell * + ! volume and area * + ! * ! LB: 2021 * ! - Particle dump and initial particle positions in NetCDF * ! - Receptor files in NetCDF format * + ! * + ! RLT: 2024 * + ! - Moved receptor output new module * !***************************************************************************** @@ -41,27 +44,9 @@ module netcdf_output_mod wetgrid,wetgridsigma,drygrid,drygridsigma,grid,gridsigma,& area,arean,volumen,orooutn use par_mod, only: dep_prec, sp, dp, nclassunc,& - unitoutrecept,unitoutreceptppt,unittmp - use com_mod, only: path,length,ldirect,ibdate,ibtime,iedate,ietime,itime_init, & - loutstep,loutaver,loutsample,outlon0,outlat0,& - numxgrid,numygrid,dxout,dyout,numzgrid, & - outlon0n,outlat0n,dxoutn,dyoutn,numxgridn,numygridn, & - nspec,maxpointspec_act,species,numpoint,& - compoint,method,lsubgrid,lconvection,& - ind_source,ind_receptor,nageclass,lage,& - drydep,wetdep,decay,weta_gas,wetb_gas, numbnests, & - ccn_aero,in_aero, mintime, & ! wetc_in,wetd_in, & - reldiff,henry,f0,density,dquer,dsigma,dryvel,& - weightmolar,ohcconst,ohdconst,vsetaver,& - numparticlecount,receptorname, & - memind,xreceptor,yreceptor,numreceptor,creceptor,iout, & - loutrestart,lnetcdfout,lsynctime, ctl, ifine, lagespectra, ipin, & - ioutputforeachrelease, iflux, mdomainfill, mquasilag, & - nested_output, ipout, sfc_only, linit_cond, & - flexversion,mpi_mode,DEP,DRYDEP,WETDEP,DRYBKDEP,WETBKDEP,OHREA, & - numpart,numpoint,partopt,num_partopt,gitversion,ndia, & - DRYDEPSPEC,WETDEPSPEC,maxspec,maxndia - ! use com_mod + unitoutrecept,unitoutreceptppt,unittmp,lpartoutputperfield + use com_mod + use windfields_mod, only: oro,rho,nxmax,height,nxmin1,nymin1,nz,nx,ny,hmix, & ! for concoutput_netcdf and concoutput_nest_netcdf tropopause,oron,rhon,xresoln,yresoln,xrn,xln,yrn,yln,nxn,nyn @@ -76,7 +61,7 @@ module netcdf_output_mod logical, parameter :: min_size = .false. ! if set true, redundant fields (topography) are not written to minimize file size integer :: tpointer=0,tpointer_part=0,ppointer_part=0,partinitpointer=0,partinitpointer1=0 - character(len=255) :: ncfname, ncfnamen, ncfname_part, ncfname_partinit!(maxpoint) + character(len=255) :: ncfname, ncfnamen, ncfname_part, ncfname_partinit, ncfname_part_end ! netcdf dimension and variable IDs for main and nested output grid integer,allocatable,dimension(:) :: specID,specIDppt,wdspecID,ddspecID @@ -86,15 +71,6 @@ module netcdf_output_mod integer, dimension(6) :: dimids, dimidsn integer, dimension(5) :: depdimids, depdimidsn - !IDs for partoutput - integer :: partID - integer :: itramemID,topoID,pvID,qvID,rhoID,prID,uID,vID,wID,vsetID - integer :: hmixID,trID,ttID,lonIDpart,latIDpart,levIDpart - integer,allocatable,dimension(:) :: massID,wdID,ddID - ! For averaged output - integer :: lonavIDpart,latavIDpart,levavIDpart,pvavID,qvavID,pravID, & - rhoavID,ttavID,topoavID,hmixavID,travID,uavID,vavID,wavID,vsetavID - integer,allocatable,dimension(:) :: massavID ! For initial particle outputs integer :: partIDi,tIDi,lonIDi,latIDi,levIDi,relIDi,pvIDi,prIDi,qvIDi, & rhoIDi,ttIDi,uIDi,vIDi,wIDi,topoIDi,trIDi,hmixIDi @@ -126,10 +102,8 @@ module netcdf_output_mod open_partoutput_file,close_partoutput_file,create_particles_initialoutput,& topo_written,mass_written,wrt_part_initialpos,partinit_netcdf,open_partinit_file, & readpartpositions_netcdf,readinitconditions_netcdf,partinitpointer1,tpointer, & - alloc_netcdf,dealloc_netcdf + alloc_netcdf,dealloc_netcdf,nf90_err,update_partoutput_pointers,ppointer_part - ! Not written yet: - ! concoutput_sfc_netcdf,concoutput_sfc_nest_netcdf, contains subroutine alloc_netcdf @@ -141,15 +115,14 @@ subroutine alloc_netcdf recconcID(maxspec),recpptvID(maxspec), stat=stat) if (stat.ne.0) error stop "Could not allocate netcdf fields" - allocate( massID(maxspec),wdID(maxspec),ddID(maxspec),massavID(maxspec), & - massIDi(maxspec), stat=stat) + allocate( massIDi(maxspec), stat=stat) if (stat.ne.0) error stop "Could not allocate netcdf fields 2" end subroutine alloc_netcdf subroutine dealloc_netcdf deallocate( specID,specIDppt,wdspecID,ddspecID,specIDn,specIDnppt,wdspecIDn,ddspecIDn, & recconcID,recpptvID ) - deallocate( massID,wdID,ddID,massavID,massIDi ) + deallocate( massIDi ) end subroutine dealloc_netcdf !**************************************************************** @@ -296,7 +269,7 @@ subroutine writeheader_netcdf(lnest) logical, intent(in) :: lnest integer :: ncid, sID, wdsID, ddsID - integer :: timeDimID, latDimID, lonDimID, levDimID, receptorDimID + integer :: timeDimID, latDimID, lonDimID, levDimID integer :: nspecDimID, npointDimID, nageclassDimID, ncharDimID, pointspecDimID integer :: tID, lonID, latID, levID, lageID, oroID, ncharrecDimID integer :: volID, areaID @@ -318,6 +291,7 @@ subroutine writeheader_netcdf(lnest) integer, dimension(5) :: dep_chunksizes integer :: i + integer :: numzwrite ! Check if output directory exists (the netcdf library will @@ -339,6 +313,9 @@ subroutine writeheader_netcdf(lnest) ! Create netcdf file !************************ + numzwrite=numzgrid + if (sfc_only.eq.1) numzwrite=1 + if (ldirect.eq.1) then write(adate,'(i8.8)') ibdate write(atime,'(i6.6)') ibtime @@ -389,7 +366,8 @@ subroutine writeheader_netcdf(lnest) ! lat call nf90_err(nf90_def_dim(ncid, 'latitude', nny, latDimID)) ! level - call nf90_err(nf90_def_dim(ncid, 'height', numzgrid, levDimID)) +! call nf90_err(nf90_def_dim(ncid, 'height', numzgrid, levDimID)) + call nf90_err(nf90_def_dim(ncid, 'height', numzwrite, levDimID)) ! number of species call nf90_err(nf90_def_dim(ncid, 'numspec', nspec, nspecDimID)) ! number of release points @@ -398,8 +376,6 @@ subroutine writeheader_netcdf(lnest) call nf90_err(nf90_def_dim(ncid, 'nageclass', nageclass, nageclassDimID)) ! dimension for release point characters call nf90_err(nf90_def_dim(ncid, 'nchar', 45, ncharDimID)) - ! dimension for receptor point characters - call nf90_err(nf90_def_dim(ncid, 'ncharrec', 16, ncharrecDimID)) ! number of actual release points call nf90_err(nf90_def_dim(ncid, 'numpoint', numpoint, npointDimID)) @@ -522,14 +498,6 @@ subroutine writeheader_netcdf(lnest) call nf90_err(nf90_put_att(ncid, oroID, 'units', 'm')) end if - ! Receptors - if (numreceptor.ge.1) then - call nf90_err(nf90_def_dim(ncid, 'receptor', nf90_unlimited, receptorDimID)) - call nf90_err(nf90_def_var(ncid, 'receptor', nf90_char, (/ ncharrecDimID,receptorDimID /), sID)) - call nf90_err(nf90_put_var(ncid, sID, receptorname, (/ 1,1 /), (/ 16,numreceptor /))) - call nf90_err(nf90_put_att(ncid, sID, 'long_name', 'receptor name')) - endif - ! concentration output, wet and dry deposition variables (one per species) call output_units(units) @@ -548,7 +516,8 @@ subroutine writeheader_netcdf(lnest) if (int(nnx,kind=8)*int(nny,kind=8)*int(numzgrid,kind=8).gt.2147483647) then ! Larger than an chunksizes = (/ nnx, nny, 1, 1, 1, 1 /) else - chunksizes = (/ nnx, nny, numzgrid, 1, 1, 1 /) +! chunksizes = (/ nnx, nny, numzgrid, 1, 1, 1 /) + chunksizes = (/ nnx, nny, numzwrite, 1, 1, 1 /) endif dep_chunksizes = (/ nnx, nny, 1, 1, 1 /) @@ -565,9 +534,9 @@ subroutine writeheader_netcdf(lnest) call nf90_err(nf90_put_att(ncid, sID, 'decay', decay(i))) call nf90_err(nf90_put_att(ncid, sID, 'weightmolar', weightmolar(i))) ! call nf90_err(nf90_put_att(ncid, sID, 'ohreact', ohreact(i))) - call nf90_err(nf90_put_att(ncid, sID, 'ohcconst', ohcconst(i))) - call nf90_err(nf90_put_att(ncid, sID, 'ohdconst', ohdconst(i))) - call nf90_err(nf90_put_att(ncid, sID, 'vsetaver', vsetaver(i))) +! call nf90_err(nf90_put_att(ncid, sID, 'ohcconst', ohcconst(i))) +! call nf90_err(nf90_put_att(ncid, sID, 'ohdconst', ohdconst(i))) +! call nf90_err(nf90_put_att(ncid, sID, 'vsetaver', vsetaver(i))) if (lnest) then specIDn(i) = sID @@ -586,9 +555,9 @@ subroutine writeheader_netcdf(lnest) call nf90_err(nf90_put_att(ncid, sID, 'decay', decay(i))) call nf90_err(nf90_put_att(ncid, sID, 'weightmolar', weightmolar(i))) ! call nf90_err(nf90_put_att(ncid, sID, 'ohreact', ohreact(i))) - call nf90_err(nf90_put_att(ncid, sID, 'ohcconst', ohcconst(i))) - call nf90_err(nf90_put_att(ncid, sID, 'ohdconst', ohdconst(i))) - call nf90_err(nf90_put_att(ncid, sID, 'vsetaver', vsetaver(i))) +! call nf90_err(nf90_put_att(ncid, sID, 'ohcconst', ohcconst(i))) +! call nf90_err(nf90_put_att(ncid, sID, 'ohdconst', ohdconst(i))) +! call nf90_err(nf90_put_att(ncid, sID, 'vsetaver', vsetaver(i))) if (lnest) then specIDnppt(i) = sID @@ -635,19 +604,6 @@ subroutine writeheader_netcdf(lnest) ddspecID(i) = ddsID endif endif - ! RECEPTORS - if (numreceptor.ge.1) then - if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then - call write_to_file(ncid,'receptor_conc'//anspec, nf90_float, (/ timeDimID,receptorDimID /), & - sID, (/ 1, numreceptor /), 'ng m-3', .true., 'receptor_conc', 'receptor_concentration') - recconcID(i)=sID - endif - if ((iout.eq.2).or.(iout.eq.3)) then - call write_to_file(ncid,'receptor_pptv'//anspec, nf90_float, (/ timeDimID,receptorDimID /), & - sID, (/ 1, numreceptor /), 'pptv', .true., 'receptor_pptv', 'receptor_mixingratio') - recpptvID(i)=sID - endif - endif end do ! global (metadata) attributes @@ -658,23 +614,6 @@ subroutine writeheader_netcdf(lnest) ! moves the file from define to data mode call nf90_err(nf90_enddef(ncid)) - ! ! hes: inquire var definition - ! do i = 1,nspec - ! write(anspec,'(i3.3)') i - ! - ! ! concentration output - ! if (iout.eq.1.or.iout.eq.3.or.iout.eq.5) then - ! if (lnest) then - ! sID = specIDn(i) - ! else - ! sID = specID(i) - ! endif - ! call nf90_err(nf90_inquire_variable(ncid, sID, chunksizes=inq_chunksizes)) - ! write(*,*) "Chunksizes for var "//anspec//": ", inq_chunksizes - ! endif - ! end do - - ! fill with data !****************************** ! longitudes (grid cell centers) @@ -710,14 +649,17 @@ subroutine writeheader_netcdf(lnest) deallocate(coord) endif ! levels - call nf90_err(nf90_put_var(ncid, levID, outheight(1:numzgrid))) +! call nf90_err(nf90_put_var(ncid, levID, outheight(1:numzgrid))) + call nf90_err(nf90_put_var(ncid, levID, outheight(1:numzwrite))) ! volume if (write_vol) then if (lnest) then - call nf90_err(nf90_put_var(ncid, volID, volumen(:,:,:))) +! call nf90_err(nf90_put_var(ncid, volID, volumen(:,:,:))) + call nf90_err(nf90_put_var(ncid, volID, volumen(:,:,1:numzwrite))) else - call nf90_err(nf90_put_var(ncid, volID, volume(:,:,:))) +! call nf90_err(nf90_put_var(ncid, volID, volume(:,:,:))) + call nf90_err(nf90_put_var(ncid, volID, volume(:,:,1:numzwrite))) end if end if @@ -829,18 +771,6 @@ subroutine read_grid_id(lnest) end do endif - ! RECEPTORS - if (numreceptor.ge.1) then - do i = 1,nspec - if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then - call nf90_err(nf90_inq_varid(ncid,name='receptor_conc'//anspec,varid=recconcID(i))) - endif - if ((iout.eq.2).or.(iout.eq.3)) then - call nf90_err(nf90_inq_varid(ncid,name='receptor_pptv'//anspec,varid=recpptvID(i))) - endif - end do - endif - call nf90_err(nf90_close(ncid)) end subroutine read_grid_id @@ -851,7 +781,7 @@ subroutine concoutput_netcdf(itime,outnum,gridtotalunc,wetgridtotalunc,drygridto ! o !***************************************************************************** ! * - ! Output of the concentration grid and the receptor concentrations. * + ! Output of the concentration grid and the concentrations. * ! * ! Author: A. Stohl * ! * @@ -888,6 +818,10 @@ subroutine concoutput_netcdf(itime,outnum,gridtotalunc,wetgridtotalunc,drygridto ! - OpenMP parallelisation * ! - Receptor output to NetCDF instead of binary format * ! * + ! January, 2024, Rona Thompson * + ! - removed output of receptors (new module) * + ! - introduced option for LCM output * + ! * !***************************************************************************** ! * ! Variables: * @@ -898,7 +832,7 @@ subroutine concoutput_netcdf(itime,outnum,gridtotalunc,wetgridtotalunc,drygridto ! * !***************************************************************************** - use unc_mod, only: gridunc,drygridunc,wetgridunc,drygridunc0,wetgridunc0 + use unc_mod implicit none @@ -906,8 +840,8 @@ subroutine concoutput_netcdf(itime,outnum,gridtotalunc,wetgridtotalunc,drygridto real, intent(in) :: outnum real(dep_prec),intent(out):: wetgridtotalunc,drygridtotalunc real, intent(out) :: gridtotalunc - real :: densityoutrecept(numreceptor),recout(numreceptor) integer :: ncid,kp,ks,kz,ix,jy,iix,jjy,kzz,ngrid + integer :: ks_start integer :: nage,i,l,jj real :: tot_mu(maxspec,maxpointspec_act) real :: halfheight,dz,dz1,dz2 @@ -919,11 +853,15 @@ subroutine concoutput_netcdf(itime,outnum,gridtotalunc,wetgridtotalunc,drygridto ! real(sp) :: gridtotal,gridsigmatotal ! real(sp) :: wetgridtotal,wetgridsigmatotal ! real(sp) :: drygridtotal,drygridsigmatotal + integer :: numzwrite real, parameter :: weightair=28.97 eps=nxmax/3.e5 + numzwrite=numzgrid + if (sfc_only.eq.1 ) numzwrite=1 + ! open output file call nf90_err(nf90_open(trim(ncfname), nf90_write, ncid)) @@ -967,76 +905,83 @@ subroutine concoutput_netcdf(itime,outnum,gridtotalunc,wetgridtotalunc,drygridto ! a nested domain (before only from mother domain) ! Determine center altitude of output layer, and interpolate density ! data to that altitude + ! + ! Note: + ! llcmoutput = true: grid is mass_spec/mass_air + ! for iout 1,3, or 5 multiply by rho + ! for iout 2 multiply by 1 + ! llcmoutput = false: grid is mass_spec/V + ! for iout 1,3, or 5 multiply by 1 + ! for iout 2 multiply by 1/rho !******************************************************************* + !$OMP PARALLEL PRIVATE(halfheight,kzz,dz1,dz2,dz,xl,yl,ngrid,iix,jjy, & !$OMP kz,ix,jy,l,ks,kp,nage,auxgrid) REDUCTION(+:wetgridtotal,wetgridsigmatotal, & !$OMP drygridtotal,drygridsigmatotal,gridtotal,gridsigmatotal) -!$OMP DO - do kz=1,numzgrid - if (kz.eq.1) then - halfheight=outheight(1)/2. - else - halfheight=(outheight(kz)+outheight(kz-1))/2. - endif - do kzz=2,nz - if ((height(kzz-1).lt.halfheight).and. & - (height(kzz).gt.halfheight)) exit - end do - kzz=max(min(kzz,nz),2) - dz1=halfheight-height(kzz-1) - dz2=height(kzz)-halfheight - dz=dz1+dz2 - do jy=0,numygrid-1 - do ix=0,numxgrid-1 - xl=outlon0+real(ix)*dxout - yl=outlat0+real(jy)*dyout - ! grid index in mother domain - xl=(xl-xlon0)/dx - yl=(yl-ylat0)/dx + if (((.not.llcmoutput).and.(iout.eq.2)).or.& + (llcmoutput.and.((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)))) then + ! compute density +!$OMP DO + do kz=1,numzgrid + if (kz.eq.1) then + halfheight=outheight(1)*0.5 + else + halfheight=(outheight(kz)+outheight(kz-1))*0.5 + endif + do kzz=2,nz + if ((height(kzz-1).lt.halfheight).and. & + (height(kzz).gt.halfheight)) exit + end do + kzz=max(min(kzz,nz),2) + dz1=halfheight-height(kzz-1) + dz2=height(kzz)-halfheight + dz=dz1+dz2 - ngrid=0 - do jj=numbnests,1,-1 - if ( xl.gt.xln(jj)+eps .and. xl.lt.xrn(jj)-eps .and. & - yl.gt.yln(jj)+eps .and. yl.lt.yrn(jj)-eps ) then - ngrid=jj - exit - end if - end do + do jy=0,numygrid-1 + do ix=0,numxgrid-1 + xl=outlon0+real(ix)*dxout + yl=outlat0+real(jy)*dyout + ! grid index in mother domain + xl=(xl-xlon0)/dx + yl=(yl-ylat0)/dx + + ngrid=0 + do jj=numbnests,1,-1 + if ( xl.gt.xln(jj)+eps .and. xl.lt.xrn(jj)-eps .and. & + yl.gt.yln(jj)+eps .and. yl.lt.yrn(jj)-eps ) then + ngrid=jj + exit + end if + end do - if (ngrid.eq.0) then - iix=max(min(nint(xl),nxmin1),0) ! if output grid cell is outside mother domain - jjy=max(min(nint(yl),nymin1),0) + if (ngrid.eq.0) then + iix=max(min(nint(xl),nxmin1),0) ! if output grid cell is outside mother domain + jjy=max(min(nint(yl),nymin1),0) - densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,memind(2))*dz1+ & - rho(iix,jjy,kzz-1,memind(2))*dz2)/dz - else - xl=(xl-xln(ngrid))*xresoln(ngrid) - yl=(yl-yln(ngrid))*yresoln(ngrid) - iix=max(min(nint(xl),nxn(ngrid)-1),0) - jjy=max(min(nint(yl),nyn(ngrid)-1),0) + densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,memind(2))*dz1+ & + rho(iix,jjy,kzz-1,memind(2))*dz2)/dz + else + xl=(xl-xln(ngrid))*xresoln(ngrid) + yl=(yl-yln(ngrid))*yresoln(ngrid) + iix=max(min(nint(xl),nxn(ngrid)-1),0) + jjy=max(min(nint(yl),nyn(ngrid)-1),0) - densityoutgrid(ix,jy,kz)=(rhon(iix,jjy,kzz,memind(2), ngrid)*dz1+ & - rhon(iix,jjy,kzz-1,memind(2), ngrid)*dz2)/dz - endif + densityoutgrid(ix,jy,kz)=(rhon(iix,jjy,kzz,memind(2), ngrid)*dz1+ & + rhon(iix,jjy,kzz-1,memind(2), ngrid)*dz2)/dz + endif + end do end do end do - end do -!$OMP END DO NOWAIT - - ! brd134: for receptor points no option for nests yet to specify density - ! and also altitude zreceptor not considered yet (needs revision) - if (numreceptor.gt.0) then -!$OMP DO - do i=1,numreceptor - xl=xreceptor(i) - yl=yreceptor(i) - iix=max(min(nint(xl),nxmin1),0) - jjy=max(min(nint(yl),nymin1),0) - densityoutrecept(i)=rho(iix,jjy,1,memind(2)) - end do !$OMP END DO NOWAIT - endif + if (llcmoutput) then + ! because divide grid by densityoutgrid + densityoutgrid=1./densityoutgrid + endif + else + ! no division by density + densityoutgrid(:,:,:)=1. + endif ! llcmoutput ! Output is different for forward and backward simulations if (ldirect.eq.1) then @@ -1044,7 +989,11 @@ subroutine concoutput_netcdf(itime,outnum,gridtotalunc,wetgridtotalunc,drygridto do kz=1,numzgrid do jy=0,numygrid-1 do ix=0,numxgrid-1 - factor3d(ix,jy,kz)=1.e12/volume(ix,jy,kz)/outnum + if (llcmoutput) then + factor3d(ix,jy,kz)=1.e12/gridcnt(ix,jy,kz) + else + factor3d(ix,jy,kz)=1.e12/volume(ix,jy,kz)/outnum + endif end do end do end do @@ -1066,8 +1015,13 @@ subroutine concoutput_netcdf(itime,outnum,gridtotalunc,wetgridtotalunc,drygridto ! ratio (uncertainty of the output) and the dry and wet deposition !********************************************************************* + if (llcmoutput) then + ks_start=2 + else + ks_start=1 + endif - do ks=1,nspec + do ks=ks_start,nspec do kp=1,maxpointspec_act do nage=1,nageclass @@ -1175,9 +1129,12 @@ subroutine concoutput_netcdf(itime,outnum,gridtotalunc,wetgridtotalunc,drygridto endif ! Concentrations +! call nf90_err(nf90_put_var(ncid,specID(ks),grid(0:numxgrid-1,0:numygrid-1,& +! 1:numzgrid)*factor3d(0:numxgrid-1,0:numygrid-1,1:numzgrid)/tot_mu(ks,kp),& +! (/ 1,1,1,tpointer,kp,nage /), (/ numxgrid,numygrid,numzgrid,1,1,1 /) )) call nf90_err(nf90_put_var(ncid,specID(ks),grid(0:numxgrid-1,0:numygrid-1,& - 1:numzgrid)*factor3d(0:numxgrid-1,0:numygrid-1,1:numzgrid)/tot_mu(ks,kp),& - (/ 1,1,1,tpointer,kp,nage /), (/ numxgrid,numygrid,numzgrid,1,1,1 /) )) + 1:numzwrite)*factor3d(0:numxgrid-1,0:numygrid-1,1:numzwrite)/tot_mu(ks,kp),& + (/ 1,1,1,tpointer,kp,nage /), (/ numxgrid,numygrid,numzwrite,1,1,1 /) )) endif ! concentration output @@ -1202,19 +1159,24 @@ subroutine concoutput_netcdf(itime,outnum,gridtotalunc,wetgridtotalunc,drygridto endif ! Mixing ratios +! call nf90_err(nf90_put_var(ncid,specIDppt(ks),weightair/weightmolar(ks)*& +! grid(0:numxgrid-1,0:numygrid-1,1:numzgrid)*& +! factor3d(0:numxgrid-1,0:numygrid-1,1:numzgrid)/& +! densityoutgrid(0:numxgrid-1,0:numygrid-1,1:numzgrid),& +! (/ 1,1,1,tpointer,kp,nage /), (/ numxgrid,numygrid,numzgrid,1,1,1 /))) call nf90_err(nf90_put_var(ncid,specIDppt(ks),weightair/weightmolar(ks)*& - grid(0:numxgrid-1,0:numygrid-1,1:numzgrid)*& - factor3d(0:numxgrid-1,0:numygrid-1,1:numzgrid)/& - densityoutgrid(0:numxgrid-1,0:numygrid-1,1:numzgrid),& - (/ 1,1,1,tpointer,kp,nage /), (/ numxgrid,numygrid,numzgrid,1,1,1 /))) + grid(0:numxgrid-1,0:numygrid-1,1:numzwrite)*& + factor3d(0:numxgrid-1,0:numygrid-1,1:numzwrite)/& + densityoutgrid(0:numxgrid-1,0:numygrid-1,1:numzwrite),& + (/ 1,1,1,tpointer,kp,nage /), (/ numxgrid,numygrid,numzwrite,1,1,1 /))) endif ! output for ppt !$OMP END SINGLE !$OMP BARRIER - end do - end do + end do ! nageclass + end do ! maxpointspec_act - end do + end do ! nspec !$OMP END PARALLEL if (gridtotal.gt.0.) gridtotalunc=real(gridsigmatotal/gridtotal,kind=sp) @@ -1223,55 +1185,27 @@ subroutine concoutput_netcdf(itime,outnum,gridtotalunc,wetgridtotalunc,drygridto if (drygridtotal.gt.0.) drygridtotalunc=real(drygridsigmatotal/ & drygridtotal, kind=dep_prec) - ! Dump of receptor concentrations - - if (numreceptor.ge.1) then - if (iout.eq.2 .or. iout.eq.3) then - do ks=1,nspec - recout(:)=1.e12*creceptor(:,ks)/outnum*weightair/weightmolar(ks)/densityoutrecept(:) - call nf90_err(nf90_put_var(ncid,recpptvID(ks),recout(1:numreceptor),(/ tpointer,1 /),(/ 1,numreceptor /))) - end do - endif - - ! Dump of receptor concentrations - - if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then - do ks=1,nspec - recout(:)=1.e12*creceptor(:,ks)/outnum - call nf90_err(nf90_put_var(ncid,recconcID(ks),recout(1:numreceptor),(/ tpointer,1 /),(/ 1,numreceptor /))) - end do - endif - endif - ! Close netCDF file !************************** call nf90_err(nf90_close(ncid)) ! Reinitialization of grid !************************* - if (numreceptor.gt.0) creceptor(1:numreceptor,1:nspec) = 0. gridunc(:,:,:,1:nspec,:,:,1:nageclass) = 0. -end subroutine concoutput_netcdf - -! subroutine concoutput_sfc_netcdf(itime,outnum,gridtotalunc,wetgridtotalunc,drygridtotalunc) + gridcnt(:,:,:) = 0. +#ifdef _OPENMP + gridunc_omp(:,:,:,:,:,:,:,:) = 0. + gridcnt_omp(:,:,:,:) = 0. +#endif -! use unc_mod, only: gridunc,drygridunc,wetgridunc,drygridunc0,wetgridunc0 - -! implicit none - -! integer, intent(in) :: itime -! real, intent(in) :: outnum -! real(sp), intent(out) :: gridtotalunc -! real(dep_prec), intent(out) :: wetgridtotalunc,drygridtotalunc +end subroutine concoutput_netcdf -! print*,'Netcdf output for surface only not yet implemented' -! end subroutine concoutput_sfc_netcdf subroutine concoutput_nest_netcdf(itime,outnum) ! i i !***************************************************************************** ! * - ! Output of the concentration grid and the receptor concentrations. * + ! Output of the concentration grid and the concentrations. * ! * ! Author: A. Stohl * ! * @@ -1311,7 +1245,6 @@ subroutine concoutput_nest_netcdf(itime,outnum) integer, intent(in) :: itime real, intent(in) :: outnum - real :: densityoutrecept(numreceptor) integer :: ncid,kp,ks,kz,ix,jy,iix,jjy,kzz,ngrid integer :: nage,i,l,jj real :: tot_mu(maxspec,maxpointspec_act) @@ -1320,9 +1253,13 @@ subroutine concoutput_nest_netcdf(itime,outnum) real(dep_prec) :: auxgrid(nclassunc) real :: gridtotal real, parameter :: weightair=28.97 + integer :: numzwrite eps=nxmax/3.e5 + numzwrite=numzgrid + if (sfc_only.eq.1 ) numzwrite=1 + ! open output file call nf90_err(nf90_open(trim(ncfnamen), nf90_write, ncid)) @@ -1361,9 +1298,9 @@ subroutine concoutput_nest_netcdf(itime,outnum) !$OMP DO do kz=1,numzgrid if (kz.eq.1) then - halfheight=outheight(1)/2. + halfheight=outheight(1)*0.5 else - halfheight=(outheight(kz)+outheight(kz-1))/2. + halfheight=(outheight(kz)+outheight(kz-1))*0.5 endif do kzz=2,nz if ((height(kzz-1).lt.halfheight).and. & @@ -1410,18 +1347,6 @@ subroutine concoutput_nest_netcdf(itime,outnum) end do !$OMP END DO NOWAIT - if (numreceptor.gt.0) then -!$OMP DO - do i=1,numreceptor - xl=xreceptor(i) - yl=yreceptor(i) - iix=max(min(nint(xl),nxmin1),0) - jjy=max(min(nint(yl),nymin1),0) - densityoutrecept(i)=rho(iix,jjy,1,memind(2)) - end do -!$OMP END DO NOWAIT - endif - ! Output is different for forward and backward simulations if (ldirect.eq.1) then !$OMP DO @@ -1548,9 +1473,12 @@ subroutine concoutput_nest_netcdf(itime,outnum) endif ! Concentrations +! call nf90_err(nf90_put_var(ncid,specIDn(ks),grid(0:numxgridn-1,0:numygridn-1,& +! 1:numzgrid)*factor3d(0:numxgridn-1,0:numygridn-1,1:numzgrid)/tot_mu(ks,kp),& +! (/ 1,1,1,tpointer,kp,nage /), (/ numxgridn,numygridn,numzgrid,1,1,1 /))) call nf90_err(nf90_put_var(ncid,specIDn(ks),grid(0:numxgridn-1,0:numygridn-1,& - 1:numzgrid)*factor3d(0:numxgridn-1,0:numygridn-1,1:numzgrid)/tot_mu(ks,kp),& - (/ 1,1,1,tpointer,kp,nage /), (/ numxgridn,numygridn,numzgrid,1,1,1 /))) + 1:numzwrite)*factor3d(0:numxgridn-1,0:numygridn-1,1:numzwrite)/tot_mu(ks,kp),& + (/ 1,1,1,tpointer,kp,nage /), (/ numxgridn,numygridn,numzwrite,1,1,1 /))) endif ! concentration output @@ -1574,11 +1502,16 @@ subroutine concoutput_nest_netcdf(itime,outnum) endif ! Mixing ratios +! call nf90_err(nf90_put_var(ncid,specIDnppt(ks),weightair/weightmolar(ks)*& +! grid(0:numxgridn-1,0:numygridn-1,1:numzgrid)*& +! factor3d(0:numxgridn-1,0:numygridn-1,1:numzgrid)/& +! densityoutgrid(0:numxgridn-1,0:numygridn-1,1:numzgrid),& +! (/ 1,1,1,tpointer,kp,nage /), (/ numxgridn,numygridn,numzgrid,1,1,1 /))) call nf90_err(nf90_put_var(ncid,specIDnppt(ks),weightair/weightmolar(ks)*& - grid(0:numxgridn-1,0:numygridn-1,1:numzgrid)*& - factor3d(0:numxgridn-1,0:numygridn-1,1:numzgrid)/& - densityoutgrid(0:numxgridn-1,0:numygridn-1,1:numzgrid),& - (/ 1,1,1,tpointer,kp,nage /), (/ numxgridn,numygridn,numzgrid,1,1,1 /))) + grid(0:numxgridn-1,0:numygridn-1,1:numzwrite)*& + factor3d(0:numxgridn-1,0:numygridn-1,1:numzwrite)/& + densityoutgrid(0:numxgridn-1,0:numygridn-1,1:numzwrite),& + (/ 1,1,1,tpointer,kp,nage /), (/ numxgridn,numygridn,numzwrite,1,1,1 /))) endif ! output for ppt !$OMP END SINGLE @@ -1595,8 +1528,8 @@ subroutine concoutput_nest_netcdf(itime,outnum) ! Reinitialization of grid !************************* - if (numreceptor.gt.0) creceptor(1:numreceptor,1:nspec) = 0. griduncn(:,:,:,1:nspec,:,:,1:nageclass) = 0. + end subroutine concoutput_nest_netcdf ! subroutine concoutput_sfc_nest_netcdf(itime,outnum) @@ -1674,19 +1607,19 @@ subroutine create_particles_initialoutput(itime,idate,itime_start,idate_start) call nf90_err(nf90_put_att(ncid, tIDi, 'description', 'time of release')) ! lon - call write_to_file(ncid,'longitude',nf90_float,(/ partDimID /),lonIDi,(/ 1 /), & + call write_to_file(ncid,'lon',nf90_float,(/ partDimID /),lonIDi,(/ 1 /), & 'degrees_east',.false.,'longitude','longitude in degree east') call nf90_err(nf90_put_att(ncid, lonIDi, 'axis', 'Lon')) call nf90_err(nf90_put_att(ncid, lonIDi, 'description', 'longitude of particles')) ! lat - call write_to_file(ncid,'latitude',nf90_float,(/ partDimID /),latIDi,(/ 1 /), & + call write_to_file(ncid,'lat',nf90_float,(/ partDimID /),latIDi,(/ 1 /), & 'degrees_north',.false.,'latitude','latitude in degree north') call nf90_err(nf90_put_att(ncid, latIDi, 'axis', 'Lat')) call nf90_err(nf90_put_att(ncid, latIDi, 'description', 'latitude of particles')) ! height - call write_to_file(ncid,'height',nf90_float,(/ partDimID /),levIDi,(/ 1 /), & + call write_to_file(ncid,'z',nf90_float,(/ partDimID /),levIDi,(/ 1 /), & 'meters',.true.,'height','height above ground') ! release @@ -1697,44 +1630,44 @@ subroutine create_particles_initialoutput(itime,idate,itime_start,idate_start) if (.not. partopt(np)%print) cycle select case(partopt(np)%name) case ('PV') ! Potential vorticity - call write_to_file(ncid,'pv',nf90_float,(/ partDimID /),pvIDi,(/ 1 /), & + call write_to_file(ncid,trim(partopt(np)%short_name),nf90_float,(/ partDimID /),pvIDi,(/ 1 /), & 'pvu',.false.,'potential_vorticity','potential vorticity') case ('PR') ! Pressure - call write_to_file(ncid,'pr',nf90_float,(/ partDimID /),prIDi,(/ 1 /), & + call write_to_file(ncid,trim(partopt(np)%short_name),nf90_float,(/ partDimID /),prIDi,(/ 1 /), & 'Pa',.false.,'pressure','pressure') case ('QV') ! Specific humidity - call write_to_file(ncid,'qv',nf90_float,(/ partDimID /),qvIDi,(/ 1 /), & + call write_to_file(ncid,trim(partopt(np)%short_name),nf90_float,(/ partDimID /),qvIDi,(/ 1 /), & '',.false.,'specific_humidity','specific humidity') case ('RH') ! Density - call write_to_file(ncid,'rho',nf90_float,(/ partDimID /),rhoIDi,(/ 1 /), & + call write_to_file(ncid,trim(partopt(np)%short_name),nf90_float,(/ partDimID /),rhoIDi,(/ 1 /), & 'kg/m3',.true.,'density','density') case ('TT') ! Temperature - call write_to_file(ncid,'temperature',nf90_float,(/ partDimID /),ttIDi,(/ 1 /), & + call write_to_file(ncid,trim(partopt(np)%short_name),nf90_float,(/ partDimID /),ttIDi,(/ 1 /), & 'K',.true.,'temperature','temperature') case ('UU') - call write_to_file(ncid,'u',nf90_float,(/ partDimID /),uIDi,(/ 1 /), & + call write_to_file(ncid,trim(partopt(np)%short_name),nf90_float,(/ partDimID /),uIDi,(/ 1 /), & 'm/s',.false.,'u','longitudinal velocity') case ('VV') - call write_to_file(ncid,'v',nf90_float,(/ partDimID /),vIDi,(/ 1 /), & + call write_to_file(ncid,trim(partopt(np)%short_name),nf90_float,(/ partDimID /),vIDi,(/ 1 /), & 'm/s',.false.,'v','latitudinal velocity') case ('WW') - call write_to_file(ncid,'w',nf90_float,(/ partDimID /),wIDi,(/ 1 /), & + call write_to_file(ncid,trim(partopt(np)%short_name),nf90_float,(/ partDimID /),wIDi,(/ 1 /), & 'm/s',.false.,'w','vertical velocity') case ('MA') do j=1,nspec ! Masses write(anspec, '(i3.3)') j - call write_to_file(ncid,'mass'//anspec,nf90_float,(/ partDimID /),massIDi(j), & + call write_to_file(ncid,trim(partopt(np)%short_name)//anspec,nf90_float,(/ partDimID /),massIDi(j), & (/ 1 /),'kg',.true.,'mass'//anspec,'mass for nspec'//anspec) end do case ('TO') - call write_to_file(ncid,'topo',nf90_float,(/ partDimID /),topoIDi,(/ 1 /), & + call write_to_file(ncid,trim(partopt(np)%short_name),nf90_float,(/ partDimID /),topoIDi,(/ 1 /), & 'meters',.false.,'topography','topography above sealevel') case ('TR') - call write_to_file(ncid,'tr',nf90_float,(/ partDimID /),trIDi,(/ 1 /), & + call write_to_file(ncid,trim(partopt(np)%short_name),nf90_float,(/ partDimID /),trIDi,(/ 1 /), & 'meters',.true.,'htropo','height above ground of tropopause') case ('HM') ! Mixing layer height - call write_to_file(ncid,'hmix',nf90_float,(/ partDimID /),hmixIDi,(/ 1 /), & + call write_to_file(ncid,trim(partopt(np)%short_name),nf90_float,(/ partDimID /),hmixIDi,(/ 1 /), & 'meters',.true.,'hmix','height above ground of mixing layer') case default cycle @@ -1882,11 +1815,9 @@ subroutine writeheader_partoutput(itime,idate,itime_start,idate_start)!,irelease integer :: ncid,j,i,totpart,np integer :: timeDimID,partDimID,tID integer :: latDimID, lonDimID, lonID, latID - character(len=11) :: fprefix + character(len=255) :: fprefix_part character(len=3) :: anspec character :: adate*8,atime*6,adate_start*8,atime_start*6,timeunit*32 - character(len=255) :: fname_partoutput - real :: fillval real, allocatable, dimension(:) :: coord logical,save :: first_time=.true. @@ -1899,23 +1830,18 @@ subroutine writeheader_partoutput(itime,idate,itime_start,idate_start)!,irelease write(atime,'(i6.6)') itime write(adate_start,'(i8.8)') idate_start write(atime_start,'(i6.6)') itime_start + + timeunit = 'seconds since '//adate_start(1:4)//'-'//adate_start(5:6)// & + '-'//adate_start(7:8)//' '//atime_start(1:2)//':'//atime_start(3:4) + ! write(arelease, '(i3.3)') irelease - fprefix = 'partoutput_'!rel'//arelease//'_' + fprefix_part = 'partoutput_'//adate//atime !rel'//arelease//'_' ! Reset logicals that ensure ony 1 write out in case of domainfill topo_written=.false. mass_written=.false. massav_written=.false. - if (first_time) then - fname_partoutput = path(2)(1:length(2))//trim(fprefix)//adate//atime//'_init.nc' - first_time=.false. - else - fname_partoutput = path(2)(1:length(2))//trim(fprefix)//adate//atime//'.nc' - endif - !ncfname_part(irelease) = fname_partoutput - ncfname_part = fname_partoutput - totpart=0 if (ipin.gt.1) then ! Not reading from a release has no npart totpart=numpart @@ -1926,54 +1852,98 @@ subroutine writeheader_partoutput(itime,idate,itime_start,idate_start)!,irelease endif !totpart = maxpart!max(numpart,totpart) !cache_size = 4 * 1 * (12+nspec) + ncfname_part = path(2)(1:length(2))//trim(fprefix_part) + if (lpartoutputperfield) then + do np=1,num_partopt + if (.not. partopt(np)%print ) cycle + if (first_time) then + call nf90_err(nf90_create(trim(ncfname_part)//'_'//trim(partopt(np)%long_name)//'_init.nc', & + cmode = nf90_hdf5, ncid = partopt(np)%ncid)) + ncfname_part_end = '_init.nc' + else + call nf90_err(nf90_create(trim(ncfname_part)//'_'//trim(partopt(np)%long_name)//'.nc', & + cmode = nf90_hdf5, ncid = partopt(np)%ncid)) + ncfname_part_end = '.nc' + endif + end do + first_time=.false. + else + if (first_time) then + ncfname_part = path(2)(1:length(2))//trim(fprefix_part)//'_init.nc' + first_time=.false. + else + ncfname_part = path(2)(1:length(2))//trim(fprefix_part)//'.nc' + endif + call nf90_err(nf90_create(trim(ncfname_part), cmode = nf90_hdf5, ncid = ncid))!, & + ! cache_size = cache_size)) + endif write(*,*) 'Write header, nspec,numpart,totpart: ', nspec,numpart,totpart - call nf90_err(nf90_create(trim(fname_partoutput), cmode = nf90_hdf5, ncid = ncid))!, & - ! cache_size = cache_size)) + if (lpartoutputperfield) then + do np=1,num_partopt + if (.not. partopt(np)%print) cycle + call writeheader_partoutput_dims(np,partopt(np)%ncid,timeunit,timeDimID,partDimID,latDimID,lonDimID) + call writeheader_partoutput_vars(np,partopt(np)%ncid,totpart,timeDimID,partDimID,latDimID,lonDimID) + + ! moves the file from define to data mode + call nf90_err(nf90_enddef(partopt(np)%ncid)) + call nf90_err(nf90_close(partopt(np)%ncid)) + end do + else + call writeheader_partoutput_dims(1,ncid,timeunit,timeDimID,partDimID,latDimID,lonDimID) + do np=1,num_partopt + if (.not. partopt(np)%print) cycle + call writeheader_partoutput_vars(np,ncid,totpart,timeDimID,partDimID,latDimID,lonDimID) + end do + + ! moves the file from define to data mode + call nf90_err(nf90_enddef(ncid)) + call nf90_err(nf90_close(ncid)) + endif + + return +110 write(*,FMT='(80("#"))') + write(*,*) 'ERROR: output directory ', trim(path(2)(1:length(2))), ' does not exist& + & (or failed to write there).' + write(*,*) 'EXITING' + write(*,FMT='(80("#"))') + error stop +end subroutine writeheader_partoutput + +subroutine writeheader_partoutput_dims(np,ncid,timeunit,timeDimID,partDimID,latDimID,lonDimID) + + implicit none + integer,intent(in) :: ncid,np + character,intent(in) :: timeunit*32 + integer,intent(out) :: timeDimID,partDimID + integer,intent(out) :: latDimID, lonDimID + integer :: tID,partID + + logical,save :: first_time=.true. ! create dimensions: !************************* ! time call nf90_err(nf90_def_dim(ncid, 'time', nf90_unlimited, timeDimID)) - timeunit = 'seconds since '//adate_start(1:4)//'-'//adate_start(5:6)// & - '-'//adate_start(7:8)//' '//atime_start(1:2)//':'//atime_start(3:4) ! particle - call nf90_err(nf90_def_dim(ncid, 'particle', nf90_unlimited, partDimID)) !totpart needs to be the actual number of particles ! If domainfill, save topo, hmix, and htropo to grid to save space !***************************************************************** - if (mdomainfill.ge.1) then - call nf90_err(nf90_def_dim(ncid, 'lon', nx, lonDimID)) - call nf90_err(nf90_def_dim(ncid, 'lat', ny, latDimID)) - - ! lon - call write_to_file(ncid,'lon',nf90_float,(/ lonDimID /),lonID,(/ 1 /), & - 'degrees_east',.false.,'grid_longitude','longitude in degree east') - call nf90_err(nf90_put_att(ncid, lonID, 'axis', 'Lon')) - call nf90_err(nf90_put_att(ncid, lonID, 'description', 'grid cell centers')) - - ! lat - call write_to_file(ncid,'lat',nf90_float,(/ latDimID /),latID,(/ 1 /), & - 'degrees_east',.false.,'grid_latitude','latitude in degree north') - call nf90_err(nf90_put_att(ncid, latID, 'axis', 'Lat')) - call nf90_err(nf90_put_att(ncid, latID, 'description', 'grid cell centers')) - - if (.not.allocated(coord)) allocate(coord(nx)) - do i = 1,nx - coord(i) = xlon0 + i*dx - enddo - call nf90_err(nf90_put_var(ncid, lonID, coord(1:nx))) - deallocate(coord) - - if (.not.allocated(coord)) allocate(coord(ny)) - do i = 1,ny - coord(i) = ylat0 + i*dy - enddo - call nf90_err(nf90_put_var(ncid, latID, coord(1:ny))) - deallocate(coord) - + if (lpartoutputperfield.and.(mdomainfill.eq.1).and. & + ((partopt(np)%name.eq.'TO') .or. & + (partopt(np)%name.eq.'HM') .or. & + (partopt(np)%name.eq.'TR'))) then + call writeheader_partoutput_grid(ncid,lonDimID,latDimID) + else + if (.not. lpartoutputperfield .and. (mdomainfill.eq.1)) then + call writeheader_partoutput_grid(ncid,lonDimID,latDimID) + endif + call nf90_err(nf90_def_dim(ncid, 'particle', nf90_unlimited, partDimID)) + ! particles variables + call nf90_err(nf90_def_var(ncid, 'particle', nf90_int, (/ partDimID/), partID)) + call nf90_err(nf90_put_att(ncid, partID, 'long_name', 'particle index')) endif ! create variables !************************* @@ -1985,195 +1955,232 @@ subroutine writeheader_partoutput(itime,idate,itime_start,idate_start)!,irelease call nf90_err(nf90_put_att(ncid, tID, 'calendar', 'proleptic_gregorian')) timeIDpart=tID - ! particles - call nf90_err(nf90_def_var(ncid, 'particle', nf90_int, (/ partDimID/), partID)) - call nf90_err(nf90_put_att(ncid, partID, 'long_name', 'particle index')) + + ! global (metadata) attributes + !******************************* + call writemetadata(ncid,lnest=.false.) + +end subroutine writeheader_partoutput_dims + +subroutine writeheader_partoutput_vars(np,ncid,totpart,timeDimID,partDimID,latDimID,lonDimID) + + implicit none + integer,intent(in) :: ncid,totpart,np + integer,intent(in) :: timeDimID,partDimID + integer,intent(in) :: latDimID, lonDimID + integer :: j,i,varid + character(len=3) :: anspec + real :: fillval fillval = -1. - do np=1,num_partopt - if (.not. partopt(np)%print) cycle - select case(partopt(np)%name) - case ('LO') ! Longitude - call write_to_file(ncid,'longitude',nf90_float,(/ timeDimID,partDimID /),lonIDpart,(/ 1,totpart /), & - 'degrees_east',.false.,'longitude','longitude of particles') - call nf90_err(nf90_put_att(ncid, lonIDpart, 'axis', 'Lon')) - call nf90_err(nf90_put_att(ncid, lonIDpart, 'description', 'longitude of particles')) - case ('lo') ! Longitude averaged - call write_to_file(ncid,'longitude_av',nf90_float,(/ timeDimID,partDimID /),lonavIDpart,(/ 1,totpart /), & - 'degrees_east',.false.,'longitude_average','averaged longitude of particles') - call nf90_err(nf90_put_att(ncid, lonavIDpart, 'axis', 'Lon')) - call nf90_err(nf90_put_att(ncid, lonavIDpart, 'description', 'averaged longitude of particles')) - case ('LA') ! Latitude - call write_to_file(ncid,'latitude',nf90_float,(/ timeDimID,partDimID /),latIDpart,(/ 1,totpart /), & - 'degrees_north',.false.,'latitude','latitude in degree north') - call nf90_err(nf90_put_att(ncid, latIDpart, 'axis', 'Lat')) - call nf90_err(nf90_put_att(ncid, latIDpart, 'description', 'latitude of particles')) - case ('la') ! Latitude averaged - call write_to_file(ncid,'latitude_av',nf90_float,(/ timeDimID,partDimID /),latavIDpart,(/ 1,totpart /), & - 'degrees_north',.false.,'latitude_average','averaged latitude in degree north') - call nf90_err(nf90_put_att(ncid, latavIDpart, 'axis', 'Lat')) - call nf90_err(nf90_put_att(ncid, latavIDpart, 'description', 'averaged latitude of particles')) - case ('ZZ') ! Height - call write_to_file(ncid,'height',nf90_float,(/ timeDimID,partDimID /),levIDpart,(/ 1,totpart /), & - 'meters',.false.,'height','height above ground') - case ('zz') ! Heights averaged - call write_to_file(ncid,'height_av',nf90_float,(/ timeDimID,partDimID /),levavIDpart,(/ 1,totpart /), & - 'meters',.false.,'height_average','averaged height above ground') - case ('PV') ! Potential vorticity - call write_to_file(ncid,'pv',nf90_float,(/ timeDimID,partDimID /),pvID,(/ 1,totpart /), & - 'pvu',.false.,'potential_vorticity','potential vorticity') - case ('pv') ! Potential vorticity averaged - call write_to_file(ncid,'pv_av',nf90_float,(/ timeDimID,partDimID /),pvavID,(/ 1,totpart /), & - 'pvu',.false.,'potential_vorticity_average','averaged potential vorticity') - case ('PR') ! Pressure - call write_to_file(ncid,'pr',nf90_float,(/ timeDimID,partDimID /),prID,(/ 1,totpart /), & - 'Pa',.false.,'pressure','pressure') - case ('pr') ! Pressure averaged - call write_to_file(ncid,'pr_av',nf90_float,(/ timeDimID,partDimID /),pravID,(/ 1,totpart /), & - 'Pa',.false.,'pressure_average','averaged pressure') - case ('QV') ! Specific humidity - call write_to_file(ncid,'qv',nf90_float,(/ timeDimID,partDimID /),qvID,(/ 1,totpart /), & - '',.false.,'specific_humidity','specific humidity') - case ('qv') ! Specific humidity averaged - call write_to_file(ncid,'qv_av',nf90_float,(/ timeDimID,partDimID /),qvavID,(/ 1,totpart /), & - '',.false.,'specific_humidity_average','averaged specific humidity') - case ('RH') ! Density - call write_to_file(ncid,'rho',nf90_float,(/ timeDimID,partDimID /),rhoID,(/ 1,totpart /), & - 'kg/m3',.true.,'density','density') - case ('rh') ! Density averaged - call write_to_file(ncid,'rho_av',nf90_float,(/ timeDimID,partDimID /),rhoavID,(/ 1,totpart /), & - 'kg/m3',.true.,'density_average','averaged density') - case ('TT') ! Temperature - call write_to_file(ncid,'temperature',nf90_float,(/ timeDimID,partDimID /),ttID,(/ 1,totpart /), & - 'K',.true.,'temperature','temperature') - case ('tt') ! Temperature averaged - call write_to_file(ncid,'temperature_av',nf90_float,(/ timeDimID,partDimID /),ttavID,(/ 1,totpart /), & - 'K',.true.,'temperature_average','averaged temperature') - case ('UU') - call write_to_file(ncid,'u',nf90_float,(/ timeDimID,partDimID /),uID,(/ 1,totpart /), & - 'm/s',.false.,'u','longitudinal velocity') - case ('uu') - call write_to_file(ncid,'u_av',nf90_float,(/ timeDimID,partDimID /),uavID,(/ 1,totpart /), & - 'm/s',.false.,'u_av','averaged longitudinal velocity') - case ('VV') - call write_to_file(ncid,'v',nf90_float,(/ timeDimID,partDimID /),vID,(/ 1,totpart /), & - 'm/s',.false.,'v','latitudinal velocity') - case ('vv') - call write_to_file(ncid,'v_av',nf90_float,(/ timeDimID,partDimID /),vavID,(/ 1,totpart /), & - 'm/s',.false.,'v_average','latitudinal velocity averaged') - case ('WW') - call write_to_file(ncid,'w',nf90_float,(/ timeDimID,partDimID /),wID,(/ 1,totpart /), & - 'm/s',.false.,'w','vertical velocity') - case ('ww') - call write_to_file(ncid,'w_av',nf90_float,(/ timeDimID,partDimID /),wavID,(/ 1,totpart /), & - 'm/s',.false.,'w_average','vertical velocity averaged') - case ('VS') - call write_to_file(ncid,'settling',nf90_float,(/ timeDimID,partDimID /),vsetID,(/ 1,totpart /), & - 'm/s',.false.,'settling_velocity','settling velocity') - case ('vs') - call write_to_file(ncid,'settling_av',nf90_float,(/ timeDimID,partDimID /),vsetavID,(/ 1,totpart /), & - 'm/s',.false.,'settling_velocity_average','settling velocity averaged') - case ('MA') ! Mass - if (mdomainfill.ge.1) then - call nf90_err(nf90_def_var(ncid=ncid, name='mass', xtype=nf90_float, dimids=1, varid=massID(1))) - call nf90_err(nf90_put_att(ncid, massID(1), 'units', 'kg')) - call nf90_err(nf90_put_att(ncid, massID(1), '_FillValue', fillval)) - call nf90_err(nf90_put_att(ncid, massID(1), 'positive', 'up')) - call nf90_err(nf90_put_att(ncid, massID(1), 'standard_name', 'mass')) - call nf90_err(nf90_put_att(ncid, massID(1), 'long_name', 'mass of each particle')) - else - do j=1,nspec - ! Masses - write(anspec, '(i3.3)') j - call write_to_file(ncid,'mass'//anspec,nf90_float,(/ timeDimID,partDimID /),massID(j), & - (/ 1,totpart /),'kg',.true.,'mass'//anspec,'mass for nspec'//anspec) - end do - endif - case ('ma') ! Mass averaged - if (mdomainfill.ge.1) then - call nf90_err(nf90_def_var(ncid=ncid, name='mass_av', xtype=nf90_float, dimids=1, varid=massavID(1))) - call nf90_err(nf90_put_att(ncid, massavID(1), 'units', 'kg')) - call nf90_err(nf90_put_att(ncid, massavID(1), '_FillValue', fillval)) - call nf90_err(nf90_put_att(ncid, massavID(1), 'positive', 'up')) - call nf90_err(nf90_put_att(ncid, massavID(1), 'standard_name', 'mass')) - call nf90_err(nf90_put_att(ncid, massavID(1), 'long_name', 'averaged mass of each particle')) - else - do j=1,nspec - ! Masses averaged - write(anspec, '(i3.3)') j - call write_to_file(ncid,'mass_av'//anspec,nf90_float,(/ timeDimID,partDimID /),massavID(j), & - (/ 1,totpart /),'kg',.true.,'mass'//anspec,'averaged mass for nspec'//anspec) - end do - endif - case ('WD') ! Cumulative mass of wet deposition + select case(partopt(np)%name) + case ('LO') ! Longitude + call write_to_file(ncid,trim(partopt(np)%short_name),nf90_float,(/ timeDimID,partDimID /), & + varid,(/ 1,totpart /),'degrees_east',.false.,'longitude','longitude of particles') + call nf90_err(nf90_put_att(ncid, varid, 'axis', 'Lon')) + call nf90_err(nf90_put_att(ncid, varid, 'description', 'longitude of particles')) + case ('lo') ! Longitude averaged + call write_to_file(ncid,trim(partopt(np)%short_name),nf90_float,(/ timeDimID,partDimID /), & + varid,(/ 1,totpart /),'degrees_east',.false.,'longitude_average','averaged longitude of particles') + call nf90_err(nf90_put_att(ncid, varid, 'axis', 'Lon')) + call nf90_err(nf90_put_att(ncid, varid, 'description', 'averaged longitude of particles')) + case ('LA') ! Latitude + call write_to_file(ncid,trim(partopt(np)%short_name),nf90_float,(/ timeDimID,partDimID /), & + varid,(/ 1,totpart /),'degrees_north',.false.,'latitude','latitude in degree north') + call nf90_err(nf90_put_att(ncid, varid, 'axis', 'Lat')) + call nf90_err(nf90_put_att(ncid, varid, 'description', 'latitude of particles')) + case ('la') ! Latitude averaged + call write_to_file(ncid,trim(partopt(np)%short_name),nf90_float,(/ timeDimID,partDimID /), & + varid,(/ 1,totpart /),'degrees_north',.false.,'latitude_average','averaged latitude in degree north') + call nf90_err(nf90_put_att(ncid, varid, 'axis', 'Lat')) + call nf90_err(nf90_put_att(ncid, varid, 'description', 'averaged latitude of particles')) + case ('ZZ') ! Height + call write_to_file(ncid,trim(partopt(np)%short_name),nf90_float,(/ timeDimID,partDimID /), & + varid,(/ 1,totpart /),'meters',.false.,'height','height above ground') + case ('zz') ! Heights averaged + call write_to_file(ncid,trim(partopt(np)%short_name),nf90_float,(/ timeDimID,partDimID /), & + varid,(/ 1,totpart /),'meters',.false.,'height_average','averaged height above ground') + case ('PV') ! Potential vorticity + call write_to_file(ncid,trim(partopt(np)%short_name),nf90_float,(/ timeDimID,partDimID /), & + varid,(/ 1,totpart /),'pvu',.false.,'potential_vorticity','potential vorticity') + case ('pv') ! Potential vorticity averaged + call write_to_file(ncid,trim(partopt(np)%short_name),nf90_float,(/ timeDimID,partDimID /), & + varid,(/ 1,totpart /),'pvu',.false.,'potential_vorticity_average','averaged potential vorticity') + case ('PR') ! Pressure + call write_to_file(ncid,trim(partopt(np)%short_name),nf90_float,(/ timeDimID,partDimID /), & + varid,(/ 1,totpart /),'Pa',.false.,'pressure','pressure') + case ('pr') ! Pressure averaged + call write_to_file(ncid,trim(partopt(np)%short_name),nf90_float,(/ timeDimID,partDimID /), & + varid,(/ 1,totpart /),'Pa',.false.,'pressure_average','averaged pressure') + case ('QV') ! Specific humidity + call write_to_file(ncid,trim(partopt(np)%short_name),nf90_float,(/ timeDimID,partDimID /), & + varid,(/ 1,totpart /),'',.false.,'specific_humidity','specific humidity') + case ('qv') ! Specific humidity averaged + call write_to_file(ncid,trim(partopt(np)%short_name),nf90_float,(/ timeDimID,partDimID /), & + varid,(/ 1,totpart /),'',.false.,'specific_humidity_average','averaged specific humidity') + case ('RH') ! Density + call write_to_file(ncid,trim(partopt(np)%short_name),nf90_float,(/ timeDimID,partDimID /), & + varid,(/ 1,totpart /),'kg/m3',.true.,'density','density') + case ('rh') ! Density averaged + call write_to_file(ncid,trim(partopt(np)%short_name),nf90_float,(/ timeDimID,partDimID /), & + varid,(/ 1,totpart /),'kg/m3',.true.,'density_average','averaged density') + case ('TT') ! Temperature + call write_to_file(ncid,trim(partopt(np)%short_name),nf90_float,(/ timeDimID,partDimID /), & + varid,(/ 1,totpart /),'K',.true.,'temperature','temperature') + case ('tt') ! Temperature averaged + call write_to_file(ncid,trim(partopt(np)%short_name),nf90_float,(/ timeDimID,partDimID /), & + varid,(/ 1,totpart /),'K',.true.,'temperature_average','averaged temperature') + case ('UU') + call write_to_file(ncid,trim(partopt(np)%short_name),nf90_float,(/ timeDimID,partDimID /), & + varid,(/ 1,totpart /),'m/s',.false.,'u','longitudinal velocity') + case ('uu') + call write_to_file(ncid,trim(partopt(np)%short_name),nf90_float,(/ timeDimID,partDimID /), & + varid,(/ 1,totpart /),'m/s',.false.,'u_av','averaged longitudinal velocity') + case ('VV') + call write_to_file(ncid,trim(partopt(np)%short_name),nf90_float,(/ timeDimID,partDimID /), & + varid,(/ 1,totpart /),'m/s',.false.,'v','latitudinal velocity') + case ('vv') + call write_to_file(ncid,trim(partopt(np)%short_name),nf90_float,(/ timeDimID,partDimID /), & + varid,(/ 1,totpart /),'m/s',.false.,'v_average','latitudinal velocity averaged') + case ('WW') + call write_to_file(ncid,trim(partopt(np)%short_name),nf90_float,(/ timeDimID,partDimID /), & + varid,(/ 1,totpart /),'m/s',.false.,'w','vertical velocity') + case ('ww') + call write_to_file(ncid,trim(partopt(np)%short_name),nf90_float,(/ timeDimID,partDimID /), & + varid,(/ 1,totpart /),'m/s',.false.,'w_average','vertical velocity averaged') + case ('VS') + call write_to_file(ncid,trim(partopt(np)%short_name),nf90_float,(/ timeDimID,partDimID /), & + varid,(/ 1,totpart /),'m/s',.false.,'settling_velocity','settling velocity') + case ('vs') + call write_to_file(ncid,trim(partopt(np)%short_name),nf90_float,(/ timeDimID,partDimID /), & + varid,(/ 1,totpart /),'m/s',.false.,'settling_velocity_average','settling velocity averaged') + case ('MA') ! Mass + if ((mdomainfill.ge.1).and.(nspec.eq.1)) then + call nf90_err(nf90_def_var(ncid=ncid, name=trim(partopt(np)%short_name), xtype=nf90_float, & + dimids=1, varid=varid)) + call nf90_err(nf90_put_att(ncid, varid, 'units', 'kg')) + call nf90_err(nf90_put_att(ncid, varid, '_FillValue', fillval)) + call nf90_err(nf90_put_att(ncid, varid, 'positive', 'up')) + call nf90_err(nf90_put_att(ncid, varid, 'standard_name', 'mass')) + call nf90_err(nf90_put_att(ncid, varid, 'long_name', 'mass of each particle')) + else do j=1,nspec ! Masses write(anspec, '(i3.3)') j - call write_to_file(ncid,'wetdepo'//anspec,nf90_float,(/ timeDimID,partDimID /),wdID(j), & - (/ 1,totpart /),'kg',.true.,'mass'//anspec,'cumulative wet deposition for nspec'//anspec) + call write_to_file(ncid,trim(partopt(np)%short_name)//anspec,nf90_float, & + (/ timeDimID,partDimID /),varid, & + (/ 1,totpart /),'kg',.true.,'mass'//anspec,'mass for nspec'//anspec) end do - case ('DD') ! Cumulative mass of dry deposition + endif + case ('ma') ! Mass averaged + if ((mdomainfill.ge.1).and.(nspec.eq.1)) then + call nf90_err(nf90_def_var(ncid=ncid, name=trim(partopt(np)%short_name), xtype=nf90_float, dimids=1, varid=varid)) + call nf90_err(nf90_put_att(ncid, varid, 'units', 'kg')) + call nf90_err(nf90_put_att(ncid, varid, '_FillValue', fillval)) + call nf90_err(nf90_put_att(ncid, varid, 'positive', 'up')) + call nf90_err(nf90_put_att(ncid, varid, 'standard_name', 'mass')) + call nf90_err(nf90_put_att(ncid, varid, 'long_name', 'averaged mass of each particle')) + else do j=1,nspec - ! Masses + ! Masses averaged write(anspec, '(i3.3)') j - call write_to_file(ncid,'drydepo'//anspec,nf90_float,(/ timeDimID,partDimID /),ddID(j), & - (/ 1,totpart /),'kg',.true.,'mass'//anspec,'cumulative dry deposition for nspec'//anspec) + call write_to_file(ncid,trim(partopt(np)%short_name)//anspec,nf90_float,(/ timeDimID,partDimID /),varid, & + (/ 1,totpart /),'kg',.true.,'mass'//anspec,'averaged mass for nspec'//anspec) end do - case ('TO') ! Topography, written to grid if domainfill - if (mdomainfill.lt.1) then - call write_to_file(ncid,'topo',nf90_float,(/ timeDimID,partDimID /),topoID,(/ 1,totpart /), & - 'meters',.false.,'topography','topography above sealevel') - else - call write_to_file(ncid,'topo',nf90_float,(/ lonDimID,latDimID /),topoID,(/ nx,ny /), & - 'meters',.false.,'topography','topography above sealevel') - endif - case ('to') ! Topography averaged, no grid when domainfill - call write_to_file(ncid,'topo_av',nf90_float,(/ timeDimID,partDimID /),topoavID,(/ 1,totpart /), & - 'meters',.false.,'topography','averaged topography above sealevel') - case ('HM') ! Mixing layer height - if (mdomainfill.lt.1) then - call write_to_file(ncid,'hmix',nf90_float,(/ timeDimID,partDimID /),hmixID,(/ 1,totpart /), & - 'meters',.true.,'hmix','height above ground of mixing layer') - else - call write_to_file(ncid,'hmix',nf90_float,(/ timeDimID,lonDimID,latDimID /),hmixID,(/ 1,nx,ny /), & - 'meters',.true.,'hmix','height above ground of mixing layer') - endif - case ('hm') ! Mixing layer height averaged - call write_to_file(ncid,'hmix_av',nf90_float,(/ timeDimID,partDimID /),hmixavID,(/ 1,totpart /), & - 'meters',.true.,'hmix_average','averaged height above ground of mixing layer') - case ('TR') ! Tropopause - if (mdomainfill.lt.1) then - call write_to_file(ncid,'tr',nf90_float,(/ timeDimID,partDimID /),trID,(/ 1,totpart /), & - 'meters',.true.,'htropo','height above ground of tropopause') - else - call write_to_file(ncid,'tr',nf90_float,(/ timeDimID,lonDimID,latDimID /),trID,(/ 1,nx,ny /), & - 'meters',.true.,'htropo','height above ground of tropopause') - endif - case ('tr') ! Tropopause averaged - call write_to_file(ncid,'tr_av',nf90_float,(/ timeDimID,partDimID /),travID,(/ 1,totpart /), & - 'meters',.true.,'htropo_average','averaged height above ground of tropopause') - case default - write(*,*) 'The field you are trying to write to file is not coded in yet: ', partopt(np)%long_name - error stop - end select - end do - ! global (metadata) attributes - !******************************* - call writemetadata(ncid,lnest=.false.) + endif + case ('WD') ! Cumulative mass of wet deposition + do j=1,nspec + ! Masses + write(anspec, '(i3.3)') j + call write_to_file(ncid,trim(partopt(np)%short_name)//anspec,nf90_float,(/ timeDimID,partDimID /),varid, & + (/ 1,totpart /),'kg',.true.,'mass'//anspec,'cumulative wet deposition for nspec'//anspec) + end do + case ('DD') ! Cumulative mass of dry deposition + do j=1,nspec + ! Masses + write(anspec, '(i3.3)') j + call write_to_file(ncid,trim(partopt(np)%short_name)//anspec,nf90_float,(/ timeDimID,partDimID /),varid, & + (/ 1,totpart /),'kg',.true.,'mass'//anspec,'cumulative dry deposition for nspec'//anspec) + end do + case ('TO') ! Topography, written to grid if domainfill + if (mdomainfill.lt.1) then + call write_to_file(ncid,trim(partopt(np)%short_name),nf90_float,(/ timeDimID,partDimID /),varid,(/ 1,totpart /), & + 'meters',.false.,'topography','topography above sealevel') + else + call write_to_file(ncid,trim(partopt(np)%short_name),nf90_float,(/ lonDimID,latDimID /),varid,(/ nx,ny /), & + 'meters',.false.,'topography','topography above sealevel') + endif + case ('to') ! Topography averaged, no grid when domainfill + call write_to_file(ncid,trim(partopt(np)%short_name),nf90_float,(/ timeDimID,partDimID /),varid,(/ 1,totpart /), & + 'meters',.false.,'topography','averaged topography above sealevel') + case ('HM') ! Mixing layer height + if (mdomainfill.lt.1) then + call write_to_file(ncid,trim(partopt(np)%short_name),nf90_float,(/ timeDimID,partDimID /),varid,(/ 1,totpart /), & + 'meters',.true.,'hmix','height above ground of mixing layer') + else + call write_to_file(ncid,trim(partopt(np)%short_name),nf90_float,(/ timeDimID,lonDimID,latDimID /),varid,(/ 1,nx,ny /), & + 'meters',.true.,'hmix','height above ground of mixing layer') + endif + case ('hm') ! Mixing layer height averaged + call write_to_file(ncid,trim(partopt(np)%short_name),nf90_float,(/ timeDimID,partDimID /),varid,(/ 1,totpart /), & + 'meters',.true.,'hmix_average','averaged height above ground of mixing layer') + case ('TR') ! Tropopause + if (mdomainfill.lt.1) then + call write_to_file(ncid,trim(partopt(np)%short_name),nf90_float,(/ timeDimID,partDimID /),varid,(/ 1,totpart /), & + 'meters',.true.,'htropo','height above ground of tropopause') + else + call write_to_file(ncid,trim(partopt(np)%short_name),nf90_float,(/ timeDimID,lonDimID,latDimID /),varid,(/ 1,nx,ny /), & + 'meters',.true.,'htropo','height above ground of tropopause') + endif + case ('tr') ! Tropopause averaged + call write_to_file(ncid,trim(partopt(np)%short_name),nf90_float,(/ timeDimID,partDimID /),varid,(/ 1,totpart /), & + 'meters',.true.,'htropo_average','averaged height above ground of tropopause') + case default + write(*,*) 'The field you are trying to write to file is not coded in yet: ', partopt(np)%name,partopt(np)%long_name + error stop + end select - ! moves the file from define to data mode - call nf90_err(nf90_enddef(ncid)) +end subroutine writeheader_partoutput_vars - call nf90_err(nf90_close(ncid)) +subroutine writeheader_partoutput_grid(ncid,lonDimID,latDimID) - return -110 write(*,FMT='(80("#"))') - write(*,*) 'ERROR: output directory ', trim(path(2)(1:length(2))), ' does not exist& - & (or failed to write there).' - write(*,*) 'EXITING' - write(*,FMT='(80("#"))') - error stop -end subroutine writeheader_partoutput + implicit none + + integer,intent(in) :: ncid + integer,intent(out) :: lonDimID,latDimID + real, allocatable, dimension(:) :: coord + integer :: lonID, latID, i + + call nf90_err(nf90_def_dim(ncid, 'longitude', nx, lonDimID)) + call nf90_err(nf90_def_dim(ncid, 'latitude', ny, latDimID)) + + ! lon + call write_to_file(ncid,'longitude',nf90_float,(/ lonDimID /),lonID,(/ 1 /), & + 'degrees_east',.false.,'grid_longitude','longitude in degree east') + call nf90_err(nf90_put_att(ncid, lonID, 'axis', 'Lon')) + call nf90_err(nf90_put_att(ncid, lonID, 'description', 'grid cell centers')) + + ! lat + call write_to_file(ncid,'latitude',nf90_float,(/ latDimID /),latID,(/ 1 /), & + 'degrees_east',.false.,'grid_latitude','latitude in degree north') + call nf90_err(nf90_put_att(ncid, latID, 'axis', 'Lat')) + call nf90_err(nf90_put_att(ncid, latID, 'description', 'grid cell centers')) + + if (.not.allocated(coord)) allocate(coord(nx)) + do i = 1,nx + coord(i) = xlon0 + i*dx + enddo + call nf90_err(nf90_put_var(ncid, lonID, coord(1:nx))) + deallocate(coord) + + if (.not.allocated(coord)) allocate(coord(ny)) + do i = 1,ny + coord(i) = ylat0 + i*dy + enddo + call nf90_err(nf90_put_var(ncid, latID, coord(1:ny))) + deallocate(coord) + +end subroutine writeheader_partoutput_grid subroutine write_to_file(ncid,short_name,xtype,dimids,varid,chunksizes,units,l_positive, & standard_name,long_name) @@ -2208,15 +2215,20 @@ subroutine write_to_file(ncid,short_name,xtype,dimids,varid,chunksizes,units,l_p call nf90_err(nf90_put_att(ncid, varid, 'long_name', long_name)) end subroutine write_to_file -subroutine open_partoutput_file(ncid)!,irelease) +subroutine open_partoutput_file(ncid,np) implicit none - integer, intent(inout) :: ncid - !integer, intent(in) :: irelease + integer, intent(out) :: ncid + integer, intent(in),optional :: np - call nf90_err(nf90_open(trim(ncfname_part), nf90_write, ncid)) -end subroutine open_partoutput_file + if (lpartoutputperfield) then + call nf90_err(nf90_open(trim(ncfname_part)//'_'//trim(partopt(np)%long_name)//trim(ncfname_part_end), & + nf90_write, ncid)) + else + call nf90_err(nf90_open(trim(ncfname_part), nf90_write, ncid)) + endif +end subroutine open_partoutput_file subroutine close_partoutput_file(ncid) @@ -2227,17 +2239,95 @@ subroutine close_partoutput_file(ncid) call nf90_err(nf90_close(ncid)) end subroutine close_partoutput_file -subroutine open_partinit_file(ncid)!,irelease) +subroutine open_partinit_file(ncid) implicit none integer, intent(inout) :: ncid - !integer, intent(in) :: irelease call nf90_err(nf90_open(trim(ncfname_partinit), nf90_write, ncid)) end subroutine open_partinit_file -subroutine partoutput_netcdf(itime,field,fieldname,imass,ncid) +subroutine update_partoutput_pointers(itime,ncid) + + use particle_mod + + implicit none + + integer, intent(in) :: itime + integer, intent(in),optional :: ncid + integer, allocatable :: partindices(:) + integer :: j,tempIDend,newpart,np + + ! Time + tpointer_part = tpointer_part + 1 + + if (lpartoutputperfield) then + do np=1,num_partopt + if (.not. partopt(np)%print) cycle + call nf90_err(nf90_inq_varid(ncid=partopt(np)%ncid,name='time',varid=tempIDend)) + call nf90_err(nf90_put_var(partopt(np)%ncid, tempIDend, itime, (/ tpointer_part /))) + end do + else + call nf90_err(nf90_inq_varid(ncid=ncid,name='time',varid=tempIDend)) + call nf90_err(nf90_put_var(ncid, tempIDend, itime, (/ tpointer_part /))) + endif + + ! Particles + newpart = count%allocated - ppointer_part + + if (tpointer_part.eq.1) then + allocate ( partindices(count%allocated) ) + do j=1,count%allocated + partindices(j)=j + end do + if (lpartoutputperfield) then + do np=1,num_partopt + if (.not. partopt(np)%print) cycle + if ((mdomainfill.eq.1).and. & + ((partopt(np)%name.eq.'TO') .or. & + (partopt(np)%name.eq.'HM') .or. & + (partopt(np)%name.eq.'TR'))) cycle + call nf90_err(nf90_inq_varid(ncid=partopt(np)%ncid,name='particle',varid=tempIDend)) + call nf90_err(nf90_put_var(partopt(np)%ncid, tempIDend,partindices, (/ 1 /),(/ count%allocated /))) + end do + else + call nf90_err(nf90_inq_varid(ncid=ncid,name='particle',varid=tempIDend)) + call nf90_err(nf90_put_var(ncid, tempIDend,partindices, (/ 1 /),(/ count%allocated /))) + endif + deallocate (partindices) + + ppointer_part = count%allocated + + else if (newpart.ge.0) then + + allocate ( partindices(newpart) ) + do j=1,newpart + partindices(j)=j+ppointer_part + end do + if (lpartoutputperfield) then + do np=1,num_partopt + if (.not. partopt(np)%print) cycle + if ((mdomainfill.eq.1).and. & + ((partopt(np)%name.eq.'TO') .or. & + (partopt(np)%name.eq.'HM') .or. & + (partopt(np)%name.eq.'TR'))) cycle + call nf90_err(nf90_inq_varid(ncid=partopt(np)%ncid,name='particle',varid=tempIDend)) + call nf90_err(nf90_put_var(partopt(np)%ncid, tempIDend,partindices, (/ ppointer_part+1 /),(/ newpart /))) + end do + else + call nf90_err(nf90_inq_varid(ncid=ncid,name='particle',varid=tempIDend)) + call nf90_err(nf90_put_var(ncid, tempIDend,partindices, (/ ppointer_part+1 /),(/ newpart /))) + endif + deallocate (partindices) + + ppointer_part = count%allocated + endif + +end subroutine update_partoutput_pointers + +subroutine partoutput_netcdf(itime,field,np,imass,ncid) + use particle_mod !***************************************************************************** @@ -2251,142 +2341,60 @@ subroutine partoutput_netcdf(itime,field,fieldname,imass,ncid) implicit none - integer, intent(in) :: itime,imass + integer, intent(in) :: itime,imass,ncid real, intent(in) :: field(:) - character(2), intent(in) :: fieldname ! input field to interpolate over - integer, allocatable :: partindices(:) - integer :: ncid,newpart,j + integer, intent(in) :: np ! input field to interpolate over + integer :: tempIDend + character(len=3) :: anspec + ! ! open output file ! call nf90_err(nf90_open(trim(ncfname_part), nf90_write, ncid)) - select case(fieldname) - case('TI') - ! write time - tpointer_part = tpointer_part + 1 - call nf90_err(nf90_put_var(ncid, timeIDpart, itime, (/ tpointer_part /))) - case('PA') - newpart = count%allocated - ppointer_part - - if (tpointer_part.eq.1) then - allocate ( partindices(count%allocated) ) - do j=1,count%allocated - partindices(j)=j - end do - - call nf90_err(nf90_put_var(ncid, partID,partindices, (/ 1 /),(/ count%allocated /))) - - deallocate (partindices) - - ppointer_part = count%allocated - - else if (newpart.ge.0) then - - allocate ( partindices(newpart) ) - do j=1,newpart - partindices(j)=j+ppointer_part - end do - - call nf90_err(nf90_put_var(ncid, partID,partindices, (/ ppointer_part+1 /),(/ newpart /))) - - deallocate (partindices) - - ppointer_part = count%allocated - endif - case('LO') ! Longitude - call nf90_err(nf90_put_var(ncid,lonIDpart,field, (/ tpointer_part,1 /),(/ 1,count%allocated /))) - case('lo') ! Longitude averaged - call nf90_err(nf90_put_var(ncid,lonavIDpart,field, (/ tpointer_part,1 /),(/ 1,count%allocated /))) - case('LA') ! Latitude - call nf90_err(nf90_put_var(ncid,latIDpart,field, (/ tpointer_part,1 /),(/ 1,count%allocated /))) - case('la') ! Latitude averaged - call nf90_err(nf90_put_var(ncid,latavIDpart,field, (/ tpointer_part,1 /),(/ 1,count%allocated /))) - case('ZZ') ! Height - call nf90_err(nf90_put_var(ncid,levIDpart,field, (/ tpointer_part,1 /),(/ 1,count%allocated /))) - case('zz') ! Height averaged - call nf90_err(nf90_put_var(ncid,levavIDpart,field, (/ tpointer_part,1 /),(/ 1,count%allocated /))) - case('IT') ! Itramem (not in use atm) - call nf90_err(nf90_put_var(ncid,itramemID,field, (/ tpointer_part,1 /),(/ 1,count%allocated /))) - case('TO') ! Topography - if (mdomainfill.ge.1) then - if (topo_written.eqv..false.) call nf90_err(nf90_put_var(ncid,topoID,oro(0:nx-1,0:ny-1), (/ 1,1 /),(/ nx,ny /))) + if ((mdomainfill.ge.1).and. ((partopt(np)%name.eq.'TO').or. & + (partopt(np)%name.eq.'HM').or.(partopt(np)%name.eq.'TR'))) then + if (partopt(np)%name.eq.'TO') then + if (topo_written.eqv..false.) then + call nf90_err(nf90_inq_varid(ncid=ncid,name=trim(partopt(np)%short_name),varid=tempIDend)) + call nf90_err(nf90_put_var(ncid,tempIDend,oro(0:nx-1,0:ny-1), (/ 1,1 /),(/ nx,ny /))) topo_written=.true. - else - call nf90_err(nf90_put_var(ncid,topoID,field, (/ tpointer_part,1 /),(/ 1,count%allocated /))) endif - case('to') ! topography averaged - call nf90_err(nf90_put_var(ncid,topoavID,field, (/ tpointer_part,1 /),(/ 1,count%allocated /))) - case('PV') ! Potential vorticity - call nf90_err(nf90_put_var(ncid,pvID,field, (/ tpointer_part,1 /),(/ 1,count%allocated /))) - case('pv') ! Potential vorticity averaged - call nf90_err(nf90_put_var(ncid,pvavID,field, (/ tpointer_part,1 /),(/ 1,count%allocated /))) - case('PR') ! Pressure - call nf90_err(nf90_put_var(ncid,prID,field, (/ tpointer_part,1 /),(/ 1,count%allocated /))) - case('pr') ! Pressure averaged - call nf90_err(nf90_put_var(ncid,pravID,field, (/ tpointer_part,1 /),(/ 1,count%allocated /))) - case('QV') ! Specific humidity - call nf90_err(nf90_put_var(ncid,qvID,field, (/ tpointer_part,1 /),(/ 1,count%allocated /))) - case('qv') ! Specific humidity averaged - call nf90_err(nf90_put_var(ncid,qvavID,field, (/ tpointer_part,1 /),(/ 1,count%allocated /))) - case('RH') ! Air density - call nf90_err(nf90_put_var(ncid,rhoID,field, (/ tpointer_part,1 /),(/ 1,count%allocated /))) - case('rh') ! Air density averaged - call nf90_err(nf90_put_var(ncid,rhoavID,field, (/ tpointer_part,1 /),(/ 1,count%allocated /))) - case('UU') ! Longitudinal velocity - call nf90_err(nf90_put_var(ncid,uID,field, (/ tpointer_part,1 /),(/ 1,count%allocated /))) - case('uu') ! Longitudinal velocity averaged - call nf90_err(nf90_put_var(ncid,uavID,field, (/ tpointer_part,1 /),(/ 1,count%allocated /))) - case('VV') ! Latitudinal velocity - call nf90_err(nf90_put_var(ncid,vID,field, (/ tpointer_part,1 /),(/ 1,count%allocated /))) - case('vv') ! Latitudinal velocity averaged - call nf90_err(nf90_put_var(ncid,vavID,field, (/ tpointer_part,1 /),(/ 1,count%allocated /))) - case('WW') ! Vertical velocity - call nf90_err(nf90_put_var(ncid,wID,field, (/ tpointer_part,1 /),(/ 1,count%allocated /))) - case('ww') ! Vertical velocity averaged - call nf90_err(nf90_put_var(ncid,wavID,field, (/ tpointer_part,1 /),(/ 1,count%allocated /))) - case('VS') ! Settling velocity - call nf90_err(nf90_put_var(ncid,vsetID,field, (/ tpointer_part,1 /),(/ 1,count%allocated /))) - case('vs') ! Settling velocity averaged - call nf90_err(nf90_put_var(ncid,vsetavID,field, (/ tpointer_part,1 /),(/ 1,count%allocated /))) - case('HM') ! Mixing height - if (mdomainfill.ge.1) then - call nf90_err(nf90_put_var(ncid,hmixID,hmix(0:nx-1,0:ny-1,1,memind(1)), & - (/ tpointer_part,1,1 /),(/ 1,nx,ny /))) - else - call nf90_err(nf90_put_var(ncid,hmixID,field, (/ tpointer_part,1 /),(/ 1,count%allocated /))) - endif - case('hm') ! Mixing height averaged - call nf90_err(nf90_put_var(ncid,hmixavID,field, (/ tpointer_part,1 /),(/ 1,count%allocated /))) - case('TR') ! Tropopause - if (mdomainfill.ge.1) then - call nf90_err(nf90_put_var(ncid,trID,tropopause(0:nx-1,0:ny-1,1,memind(1)), & - (/ tpointer_part,1,1 /),(/ 1,nx,ny /))) - else - call nf90_err(nf90_put_var(ncid,trID,field, (/ tpointer_part,1 /),(/ 1,count%allocated /))) - endif - case('tr') ! Tropopause averaged - call nf90_err(nf90_put_var(ncid,travID,field, (/ tpointer_part,1 /),(/ 1,count%allocated /))) - case('TT') ! Temperature - call nf90_err(nf90_put_var(ncid,ttID,field, (/ tpointer_part,1 /),(/ 1,count%allocated /))) - case('tt') ! Temperature averaged - call nf90_err(nf90_put_var(ncid,ttavID,field, (/ tpointer_part,1 /),(/ 1,count%allocated /))) - case('MA') ! Mass - if ((mdomainfill.ge.1).and.(imass.eq.1)) then - if (mass_written.eqv..false.) call nf90_err(nf90_put_var(ncid=ncid,varid=massID(1),values=field(1))) - mass_written=.true. - else - call nf90_err(nf90_put_var(ncid,massID(imass),field, (/ tpointer_part,1 /),(/ 1,count%allocated /))) + else !HM or TR + call nf90_err(nf90_inq_varid(ncid=ncid,name=trim(partopt(np)%short_name),varid=tempIDend)) + call nf90_err(nf90_put_var(ncid,tempIDend,hmix(0:nx-1,0:ny-1,1,memind(1)), & + (/ tpointer_part,1,1 /),(/ 1,nx,ny /))) + endif + + else if (partopt(np)%name.eq.'MA') then + if ((mdomainfill.ge.1).and.(imass.eq.1).and.(nspec.eq.1)) then + if (mass_written.eqv..false.) then + call nf90_err(nf90_inq_varid(ncid=ncid,name=trim(partopt(np)%short_name),varid=tempIDend)) + call nf90_err(nf90_put_var(ncid=ncid,varid=tempIDend,values=field(1))) endif - case('ma') ! Mass averaged - if ((mdomainfill.ge.1).and.(imass.eq.1)) then - if (mass_written.eqv..false.) call nf90_err(nf90_put_var(ncid=ncid,varid=massavID(1),values=field(1))) - massav_written=.true. - else - call nf90_err(nf90_put_var(ncid,massavID(imass),field, (/ tpointer_part,1 /),(/ 1,count%allocated /))) + mass_written=.true. + else + write(anspec, '(i3.3)') imass + call nf90_err(nf90_inq_varid(ncid=ncid,name=trim(partopt(np)%short_name)//anspec,varid=tempIDend)) + call nf90_err(nf90_put_var(ncid,tempIDend,field, (/ tpointer_part,1 /),(/ 1,count%allocated /))) + endif + else if (partopt(np)%name.eq.'ma') then + if ((mdomainfill.ge.1).and.(imass.eq.1).and.(nspec.eq.1)) then + if (mass_written.eqv..false.) then + call nf90_err(nf90_inq_varid(ncid=ncid,name=trim(partopt(np)%short_name),varid=tempIDend)) + call nf90_err(nf90_put_var(ncid,tempIDend,field, (/ tpointer_part,1 /),(/ 1,count%allocated /))) endif - case('WD') ! Cumulative mass of wet deposition - call nf90_err(nf90_put_var(ncid,wdID(imass),field, (/ tpointer_part,1 /),(/ 1,count%allocated /))) - case('DD') ! Cumulative mass of wet deposition - call nf90_err(nf90_put_var(ncid,ddID(imass),field, (/ tpointer_part,1 /),(/ 1,count%allocated /))) - end select + massav_written=.true. + else + write(anspec, '(i3.3)') imass + call nf90_err(nf90_inq_varid(ncid=ncid,name=trim(partopt(np)%short_name)//anspec,varid=tempIDend)) + call nf90_err(nf90_put_var(ncid,tempIDend,field, (/ tpointer_part,1 /),(/ 1,count%allocated /))) + endif + else if ((partopt(np)%name.eq.'WD').or.(partopt(np)%name.eq.'DD')) then + write(anspec, '(i3.3)') imass + call nf90_err(nf90_inq_varid(ncid=ncid,name=trim(partopt(np)%short_name)//anspec,varid=tempIDend)) + call nf90_err(nf90_put_var(ncid,tempIDend,field, (/ tpointer_part,1 /),(/ 1,count%allocated /))) + else + call nf90_err(nf90_inq_varid(ncid=ncid,name=trim(partopt(np)%short_name),varid=tempIDend)) + call nf90_err(nf90_put_var(ncid,tempIDend,field, (/ tpointer_part,1 /),(/ 1,count%allocated /))) + endif ! call nf90_err(nf90_close(ncid)) end subroutine partoutput_netcdf @@ -2411,12 +2419,12 @@ subroutine readpartpositions_netcdf(ibtime,ibdate) integer, intent(in) :: ibtime,ibdate integer :: ncidend,tIDend,pIDend,tempIDend - integer :: tlen,plen,tend,i,j,stat + integer :: tlen,plen,tend,i,j,stat,iterminate integer :: idate_start,itime_start character :: adate*8,atime*6,timeunit*32,adate_start*8,atime_start*6 character(len=3) :: anspec real(kind=dp) :: julin,julcommand - real,allocatable,dimension(:) :: mass_temp + ! real,allocatable,dimension(:) :: mass_temp integer :: idummy = -8 write(adate,'(i8.8)') ibdate @@ -2428,7 +2436,7 @@ subroutine readpartpositions_netcdf(ibtime,ibdate) endif ! Open partoutput_end.nc file - call nf90_err(nf90_open(trim('partoutput_end.nc'), mode=NF90_NOWRITE,ncid=ncidend)) + call nf90_err(nf90_open(path(2)(1:length(2))//trim('partoutput_end.nc'), mode=NF90_NOWRITE,ncid=ncidend)) ! Take the positions of the particles at the last timestep in the file ! It needs to be the same as given in the COMMAND file, this is arbitrary @@ -2459,6 +2467,9 @@ subroutine readpartpositions_netcdf(ibtime,ibdate) error stop endif + !! testing +! print*, 'readpartpositions_netcdf: julin, julcommand = ',julin, julcommand + ! Then the particle dimension call nf90_err(nf90_inq_dimid(ncid=ncidend,name='particle',dimid=pIDend)) call nf90_err(nf90_inquire_dimension(ncid=ncidend,dimid=pIDend,len=plen)) @@ -2469,39 +2480,43 @@ subroutine readpartpositions_netcdf(ibtime,ibdate) ! And give them the correct positions ! Longitude - call nf90_err(nf90_inq_varid(ncid=ncidend,name='longitude',varid=tempIDend)) + call nf90_err(nf90_inq_varid(ncid=ncidend,name='lon',varid=tempIDend)) call nf90_err(nf90_get_var(ncid=ncidend,varid=tempIDend,values=part(:)%xlon, & start=(/ tlen, 1 /),count=(/ 1, plen /))) part(:)%xlon=(part(:)%xlon-xlon0)/dx ! Latitude - call nf90_err(nf90_inq_varid(ncid=ncidend,name='latitude',varid=tempIDend)) + call nf90_err(nf90_inq_varid(ncid=ncidend,name='lat',varid=tempIDend)) call nf90_err(nf90_get_var(ncid=ncidend,varid=tempIDend,values=part(:)%ylat, & start=(/ tlen, 1 /),count=(/ 1, plen /))) part(:)%ylat=(part(:)%ylat-ylat0)/dx ! Height - call nf90_err(nf90_inq_varid(ncid=ncidend,name='height',varid=tempIDend)) + call nf90_err(nf90_inq_varid(ncid=ncidend,name='z',varid=tempIDend)) call nf90_err(nf90_get_var(ncid=ncidend,varid=tempIDend,values=part(:)%z, & start=(/ tlen, 1 /),count=(/ 1, plen /))) ! Mass - allocate(mass_temp(count%allocated), stat=stat) - if (stat.ne.0) error stop "Could not allocate mass_temp" - if (mdomainfill.eq.0) then + ! allocate(mass_temp(count%allocated), stat=stat) + ! if (stat.ne.0) error stop "Could not allocate mass_temp" + if ((mdomainfill.eq.0).or.(nspec.gt.1)) then do j=1,nspec write(anspec, '(i3.3)') j - call nf90_err(nf90_inq_varid(ncid=ncidend,name='mass'//anspec,varid=tempIDend)) - call nf90_err(nf90_get_var(ncid=ncidend,varid=tempIDend,values=mass_temp(:), & + call nf90_err(nf90_inq_varid(ncid=ncidend,name='m'//anspec,varid=tempIDend)) + call nf90_err(nf90_get_var(ncid=ncidend,varid=tempIDend,values=mass(:,j), & start=(/ tlen, 1 /),count=(/ 1, plen /))) - do i=1,count%allocated - part(i)%mass(j)=mass_temp(i) - end do + ! do i=1,count%allocated + ! part(i)%mass(j)=mass_temp(i) + ! end do end do endif - deallocate( mass_temp ) + ! deallocate( mass_temp ) + iterminate=0 do i=1,plen if (part(i)%z.lt.0) then call terminate_particle(i,0) - write(*,*) 'Particle ',i,'is not alive in the restart file.' + if (mdomainfill.eq.0) then + write(*,*) 'Particle ',i,'is not alive in the restart file.' + endif + iterminate=iterminate+1 endif part(i)%nclass=min(int(ran1(idummy,0)*real(nclassunc))+1, & nclassunc) @@ -2509,8 +2524,15 @@ subroutine readpartpositions_netcdf(ibtime,ibdate) part(i)%npoint=1 end do + if (iterminate.gt.0) call rewrite_ialive() + call nf90_err(nf90_close(ncidend)) + !! testing +! print*, 'readpartpositions_netcdf: number alive = ',count%alive +! print*, 'readpartpositions_netcdf: range(part%z) = ',minval(part(1:count%alive)%z),maxval(part(1:count%alive)%z) +! print*, 'readpartpositions_netcdf: part(1)%tstart = ',part(1)%tstart + end subroutine readpartpositions_netcdf subroutine readinitconditions_netcdf() @@ -2539,7 +2561,7 @@ subroutine readinitconditions_netcdf() integer(kind=2) :: zkind real :: cun integer,allocatable, dimension (:) :: specnum_rel,numpoint_max - real,allocatable,dimension(:,:) :: mass_temp + ! real,allocatable,dimension(:,:) :: mass_temp real,allocatable,dimension(:) :: vsh,fracth,schmih logical :: lstart=.true. @@ -2560,6 +2582,10 @@ subroutine readinitconditions_netcdf() maxspec=nspec call alloc_com() + ! Read number of fields that need to be output. This needs to happen after maxspec is defined + ! but before particles are allocated (n_average is necessary). + if (ipout.ne.0) call readpartoptions + ! allocate with maxspec for first input loop allocate(specnum_rel(maxspec),stat=stat) if (stat.ne.0) error stop 'ERROR: could not allocate specnum_rel' @@ -2571,6 +2597,118 @@ subroutine readinitconditions_netcdf() call nf90_err(nf90_inquire_attribute(ncid=ncidend,name='species',varid=NF90_GLOBAL)) call nf90_err(nf90_get_att(ncid=ncidend,varid=NF90_GLOBAL,name='species',values=specnum_rel(1:nspec))) + ! Read species and derive initial conditions + !**************************************************** + DEP=.false. + DRYDEP=.false. + WETDEP=.false. + CLREA=.false. + do nsp=1,maxspec + DRYDEPSPEC(nsp)=.false. + WETDEPSPEC(nsp)=.false. + end do + + do nsp=1,nspec + call readspecies(specnum_rel(nsp),nsp) + end do + + ! Allocate fields that depend on ndia + call alloc_com_ndia + + do nsp=1,nspec + ! Allocate temporary memory necessary for the different diameter bins + !******************************************************************** + allocate(vsh(ndia(nsp)),fracth(ndia(nsp)),schmih(ndia(nsp)), stat=stat) + if (stat.ne.0) error stop "Could not allocate vsh,fracth,schmih" + + ! Molecular weight + !***************** + if (((iout.eq.2).or.(iout.eq.3)).and.(weightmolar(nsp).lt.0.)) then + write(*,*) 'For mixing ratio output, valid molar weight' + write(*,*) 'must be specified for all simulated species.' + write(*,*) 'Check table SPECIES or choose concentration' + write(*,*) 'output instead if molar weight is not known.' + error stop + endif + + ! Radioactive decay + !****************** + decay(nsp)=0.693147/decay(nsp) !conversion half life to decay constant + + ! Dry deposition of gases + !************************ + + if (reldiff(nsp).gt.0.) rm(nsp)=1./(henry(nsp)/3000.+100.*f0(nsp)) ! mesophyll resistance + + ! Dry deposition of particles + !**************************** + + vsetaver(nsp)=0. + cunningham(nsp)=0. + dquer(nsp)=dquer(nsp)*1000000. ! Conversion m to um + if (density(nsp).gt.0.) then ! Additional parameters + call part0(dquer(nsp),dsigma(nsp),density(nsp),ndia(nsp),fracth,schmih,cun,vsh) + do j=1,ndia(nsp) + fract(nsp,j)=fracth(j) + schmi(nsp,j)=schmih(j) + vset(nsp,j)=vsh(j) + cunningham(nsp)=cunningham(nsp)+cun*fract(nsp,j) + vsetaver(nsp)=vsetaver(nsp)-vset(nsp,j)*fract(nsp,j) + end do + if (lroot) write(*,*) 'Average settling velocity: ',i,vsetaver(nsp) + endif + + ! Dry deposition for constant deposition velocity + !************************************************ + + dryvel(nsp)=dryvel(nsp)*0.01 ! conversion to m/s + + ! Check if wet deposition or OH reaction shall be calculated + !*********************************************************** + + ! ESO 04.2016 check for below-cloud scavenging (gas or aerosol) + if ((dquer(nsp).le.0..and.(weta_gas(nsp).gt.0. .or. wetb_gas(nsp).gt.0.)) .or. & + &(dquer(nsp).gt.0. .and. (crain_aero(nsp) .gt. 0. .or. csnow_aero(nsp).gt.0.))) then + WETDEP=.true. + WETDEPSPEC(nsp)=.true. + if (lroot) then + write (*,*) ' Below-cloud scavenging: ON' + end if + else + if (lroot) write (*,*) ' Below-cloud scavenging: OFF' + endif + + ! NIK 31.01.2013 + 10.12.2013 + 15.02.2015 + if (dquer(nsp).gt.0..and.(ccn_aero(nsp).gt.0. .or. in_aero(nsp).gt.0.)) then + WETDEP=.true. + WETDEPSPEC(nsp)=.true. + if (lroot) then + write (*,*) ' In-cloud scavenging: ON' + end if + else + if (lroot) write (*,*) ' In-cloud scavenging: OFF' + endif + + if (any(reaccconst(:,:).gt.0.)) then + CLREA=.true. + if (lroot) write (*,*) ' Chemical reactions switched on' + endif + + if ((reldiff(nsp).gt.0.).or.(density(nsp).gt.0.).or.(dryvel(nsp).gt.0.)) then + DRYDEP=.true. + DRYDEPSPEC(nsp)=.true. + endif + + deallocate(vsh,fracth,schmih) + end do ! end loop over species + + if (WETDEP.or.DRYDEP) then + DEP=.true. + endif + + deallocate(specnum_rel) + !********************************* END READING SPECIES + ! Get the particle dimension call nf90_err(nf90_inq_dimid(ncid=ncidend,name='particle',dimid=pIDend)) call nf90_err(nf90_inquire_dimension(ncid=ncidend,dimid=pIDend,len=plen)) @@ -2579,7 +2717,7 @@ subroutine readinitconditions_netcdf() write(*,*) 'Npart:',plen call alloc_particles( plen ) ! allocate temporary mass array - allocate(mass_temp(plen,nspec)) + ! allocate(mass_temp(plen,nspec)) ! And give them the correct positions ! Longitude @@ -2602,14 +2740,14 @@ subroutine readinitconditions_netcdf() start=(/ 1 /),count=(/ plen /))) ! Mass call nf90_err(nf90_inq_varid(ncid=ncidend,name='mass',varid=tempIDend)) - call nf90_err(nf90_get_var(ncid=ncidend,varid=tempIDend,values=mass_temp, & + call nf90_err(nf90_get_var(ncid=ncidend,varid=tempIDend,values=mass, & start=(/ 1,1 /),count=(/ plen,nspec /))) - do i=1,plen - do nsp=1,nspec - part(i)%mass(nsp)=mass_temp(i,nsp) - end do - end do - deallocate(mass_temp) + ! do i=1,plen + ! do nsp=1,nspec + ! part(i)%mass(nsp)=mass_temp(i,nsp) + ! end do + ! end do + ! deallocate(mass_temp) ! Check if they are within the bounds do i=1,plen @@ -2628,8 +2766,8 @@ subroutine readinitconditions_netcdf() error stop "Initial height particle below surface/sea level." endif do nsp=1,nspec - if (part(i)%mass(nsp).lt.0) then - write(*,*) "Particle", i, "of species", nsp, "with mass", part(i)%mass(nsp) + if (mass(i,nsp).lt.0) then + write(*,*) "Particle", i, "of species", nsp, "with mass", mass(i,nsp) error stop "Negative initial mass." endif end do @@ -2647,8 +2785,9 @@ subroutine readinitconditions_netcdf() write(*,*) "start of your simulation. Negative values will be converted to" write(*,*) "positive starting times..." endif + lstart=.false. endif - part(i)%tstart = part(i)%tstart*-1 + part(i)%tstart = part(i)%tstart*(-1) endif end do ! Release @@ -2662,20 +2801,25 @@ subroutine readinitconditions_netcdf() ! Count number of releases numpoint=0 + ! Allocate plen of numpoint_max, since each particle could in principle have + ! a unique release number allocate(numpoint_max(plen), stat=stat) if (stat.ne.0) error stop "Could not allocate numpoint_max" numpoint_max=0 release_max=0 + ! Count number of releases l1: do i=1,plen + ! See if the release number already exists l2: do j=1,numpoint if (part(i)%npoint.eq.numpoint_max(numpoint)) then cycle l1 endif end do l2 - numpoint = numpoint+1 - numpoint_max(numpoint)=part(i)%npoint - if (part(i)%npoint.gt.release_max) release_max=part(i)%npoint + numpoint = numpoint+1 ! Counting the number of releases + numpoint_max(numpoint)=part(i)%npoint ! Save the release numbers + ! Save maximum release number + if (part(i)%npoint.gt.release_max) release_max=part(i)%npoint end do l1 if (numpoint.eq.0) numpoint=1 @@ -2689,10 +2833,17 @@ subroutine readinitconditions_netcdf() kindz=zkind do j=1,numpoint - if ((kindz(j).le.0).or.(kindz(j).ge.4)) then + if ((kindz(j).le.0).or.(kindz(j).ge.4)) then write(*,*) 'ERROR: kindz should be an integer between 1 and 3, not', kindz(nsp) error stop - endif + endif + if (kindz(j).eq.3) then + do i=1,plen + if (part(i)%z.gt.1500.) then + error stop 'Pressure heights should be given in hPa units. Input value exceeds surface pressure!' + endif + end do + endif end do if (ioutputforeachrelease.eq.1) then @@ -2704,12 +2855,12 @@ subroutine readinitconditions_netcdf() if (release_max.gt.numpoint) then write(*,*) "WARNING: release numbers in part_ic.nc are not consecutive:", & release_max, "is larger than the total number of releases:", numpoint, & - " Releases will be renumbered." + " Releases will be renumbered starting from 1." do j=1,numpoint do i=1,plen if (part(i)%npoint.eq.numpoint_max(j)) then - part(i)%npoint=numpoint_max(j) + part(i)%npoint=j endif end do end do @@ -2722,6 +2873,8 @@ subroutine readinitconditions_netcdf() zpoint2(:)=0. zpoint1(:)=1.e8 do i=1,plen + if (part(i)%npoint.ne.1) cycle ! This will be computed after information about + ! topography (2) or pressure (3) is known (kindz_to_z) if (part(i)%z.gt.zpoint2(part(i)%npoint)) zpoint2(part(i)%npoint)=real(part(i)%z) if (part(i)%z.lt.zpoint1(part(i)%npoint)) zpoint1(part(i)%npoint)=real(part(i)%z) end do @@ -2759,7 +2912,7 @@ subroutine readinitconditions_netcdf() do j=1,numpoint if (part(i)%npoint.eq.j) then do nsp=1,nspec - xmass(j,nsp) = xmass(j,nsp)+part(i)%mass(nsp) + xmass(j,nsp) = xmass(j,nsp)+mass(i,nsp) end do endif if (part(i)%npoint.eq.j) then @@ -2773,133 +2926,20 @@ subroutine readinitconditions_netcdf() end do part(:)%idt=mintime + mass_init(:,:)=mass(:,:) do i=1,plen part(i)%nclass=min(int(ran1(idummy,0)*real(nclassunc))+1, & nclassunc) - part(i)%mass_init=part(i)%mass - ! Activate particles that are alive from the start of the simulation - ! if (part(i)%tstart.eq.0) then - ! call spawn_particle(0,i) - ! endif end do + + allocate(rho_rel(numpoint),stat=stat) + if (stat.ne.0) write(*,*)'ERROR: could not allocate rho_rel in readinitconditions_netcdf' + write(*,FMT='(A,ES14.7)') ' Total mass to be released:', sum(xmass(1:numpoint,1:nspec)) call get_totalpart_num(numpart) numparticlecount=numpart call nf90_err(nf90_close(ncidend)) - - ! Read species and derive initial conditions - - !now save the information - DEP=.false. - DRYDEP=.false. - WETDEP=.false. - OHREA=.false. - do nsp=1,maxspec - DRYDEPSPEC(nsp)=.false. - WETDEPSPEC(nsp)=.false. - end do - - do nsp=1,nspec - call readspecies(specnum_rel(nsp),nsp) - end do - - ! Allocate fields that depend on ndia - call alloc_com_ndia - - do nsp=1,nspec - ! Allocate temporary memory necessary for the different diameter bins - !******************************************************************** - allocate(vsh(ndia(nsp)),fracth(ndia(nsp)),schmih(ndia(nsp)), stat=stat) - if (stat.ne.0) error stop "Could not allocate vsh,fracth,schmih" - - ! Molecular weight - !***************** - if (((iout.eq.2).or.(iout.eq.3)).and.(weightmolar(nsp).lt.0.)) then - write(*,*) 'For mixing ratio output, valid molar weight' - write(*,*) 'must be specified for all simulated species.' - write(*,*) 'Check table SPECIES or choose concentration' - write(*,*) 'output instead if molar weight is not known.' - error stop - endif - - ! Radioactive decay - !****************** - decay(nsp)=0.693147/decay(nsp) !conversion half life to decay constant - - ! Dry deposition of gases - !************************ - - if (reldiff(nsp).gt.0.) rm(nsp)=1./(henry(nsp)/3000.+100.*f0(nsp)) ! mesophyll resistance - - ! Dry deposition of particles - !**************************** - - vsetaver(nsp)=0. - cunningham(nsp)=0. - dquer(nsp)=dquer(nsp)*1000000. ! Conversion m to um - if (density(nsp).gt.0.) then ! Additional parameters - call part0(dquer(nsp),dsigma(nsp),density(nsp),ndia(nsp),fracth,schmih,cun,vsh) - do j=1,ndia(nsp) - fract(nsp,j)=fracth(j) - schmi(nsp,j)=schmih(j) - vset(nsp,j)=vsh(j) - cunningham(nsp)=cunningham(nsp)+cun*fract(nsp,j) - vsetaver(nsp)=vsetaver(nsp)-vset(nsp,j)*fract(nsp,j) - end do - if (lroot) write(*,*) 'Average settling velocity: ',i,vsetaver(nsp) - endif - - ! Dry deposition for constant deposition velocity - !************************************************ - - dryvel(nsp)=dryvel(nsp)*0.01 ! conversion to m/s - - ! Check if wet deposition or OH reaction shall be calculated - !*********************************************************** - - ! ESO 04.2016 check for below-cloud scavenging (gas or aerosol) - if ((dquer(nsp).le.0..and.(weta_gas(nsp).gt.0. .or. wetb_gas(nsp).gt.0.)) .or. & - &(dquer(nsp).gt.0. .and. (crain_aero(nsp) .gt. 0. .or. csnow_aero(nsp).gt.0.))) then - WETDEP=.true. - WETDEPSPEC(nsp)=.true. - if (lroot) then - write (*,*) ' Below-cloud scavenging: ON' - end if - else - if (lroot) write (*,*) ' Below-cloud scavenging: OFF' - endif - - ! NIK 31.01.2013 + 10.12.2013 + 15.02.2015 - if (dquer(nsp).gt.0..and.(ccn_aero(nsp).gt.0. .or. in_aero(nsp).gt.0.)) then - WETDEP=.true. - WETDEPSPEC(nsp)=.true. - if (lroot) then - write (*,*) ' In-cloud scavenging: ON' - end if - else - if (lroot) write (*,*) ' In-cloud scavenging: OFF' - endif - - if (ohcconst(nsp).gt.0.) then - OHREA=.true. - if (lroot) write (*,*) ' OHreaction switched on: ',ohcconst(nsp),nsp - endif - - if ((reldiff(nsp).gt.0.).or.(density(nsp).gt.0.).or.(dryvel(nsp).gt.0.)) then - DRYDEP=.true. - DRYDEPSPEC(nsp)=.true. - endif - - deallocate(vsh,fracth,schmih) - end do ! end loop over species - - if (WETDEP.or.DRYDEP) then - DEP=.true. - endif - - - deallocate(specnum_rel) end subroutine readinitconditions_netcdf end module netcdf_output_mod diff --git a/src/ohr_mod.f90 b/src/ohr_mod.f90 deleted file mode 100644 index 13eb239b73fdf8476976d1ebec7a773847c8b0b0..0000000000000000000000000000000000000000 --- a/src/ohr_mod.f90 +++ /dev/null @@ -1,452 +0,0 @@ -! SPDX-FileCopyrightText: FLEXPART 1998-2019, see flexpart_license.txt -! SPDX-License-Identifier: GPL-3.0-or-later - -module ohr_mod - - !includes OH concentration field as well as the height information - !for this field - use date_mod - - implicit none - - integer :: nxOH,nyOH,nzOH - real, allocatable, dimension(:) :: lonOH,latOH,altOH - real, allocatable, dimension(:,:,:,:) :: OH_hourly - real, allocatable, dimension (:,:,:,:) :: OH_field - real, dimension(2) :: memOHtime - real, dimension(360,180,12) :: jrate_average - real, dimension(360) :: lonjr - real, dimension(180) :: latjr - -contains - -real function photo_O1D(sza) - - !***************************************************************************** - ! * - ! * - ! Author: A. Stohl * - ! * - ! Nov 2014 * - ! * - ! * - !***************************************************************************** - ! * - ! INPUT: * - ! sza solar zenith angle (degrees) * - ! * - ! OUTPUT: * - ! photo_O1D J(O1D) photoylsis rate * - ! * - !***************************************************************************** - - implicit none - - integer :: iz,ik - real :: sza - real :: z1,z2,zg,f1,f2,dummy - real :: photo_NO2 - integer, parameter :: nzenith=11 - real, parameter :: pi=3.1415927 - real, dimension(nzenith) :: zangle,fact_photo - - ! zangle: zenith angles for which fact_photo is tabulated - ! fact_photo: conversion of photolysis rate of NO2 to photolysis - ! rate of O3 into O1D as a function of solar zenith angle - - zangle=(/0.,10.,20.,30.,40.,50.,60.,70.,78.,86.,90.0001/) - fact_photo=(/0.4616E-02,0.4478E-02,0.4131E-02,0.3583E-02,0.2867E-02,& - &0.2081E-02,0.1235E-02,0.5392E-03,0.2200E-03,0.1302E-03,0.0902E-03/) - - if (sza.lt.90.) then - do iz=1,nzenith-1 - if(sza.ge.zangle(iz)) ik=iz - end do - z1=1./cos(zangle(ik)*pi/180.) - z2=1./cos(zangle(ik+1)*pi/180.) - zg=1./cos(sza*pi/180.) - dummy=(zg-z1)/(z2-z1) - f1=alog(fact_photo(ik)) - f2=alog(fact_photo(ik+1)) - photo_NO2=1.45e-2*exp(-0.4/cos(sza*pi/180.)) - photo_O1D=photo_NO2*exp(f1+(f2-f1)*dummy) - else - photo_O1D=0. - endif - - return - -end function photo_O1D - -real function zenithangle(ylat,xlon,jul) - - !********************************************************************* - ! * - ! Author: G. WOTAWA * - ! Date: 1993-11-17 * - ! Project: POP-M * - ! Last update: * - ! * - !********************************************************************* - ! * - ! DESCRIPTION: This function returns the sinus of solar * - ! elevation as a function of geographic longitude, * - ! latitude and GMT-Time. * - ! * - !********************************************************************* - ! * - ! INPUT: * - ! * - ! ylat geographical latitude [DEG] * - ! xlon geographical longitude [DEG] * - ! jjjj Year * - ! mm Month * - ! dd Day * - ! hh Hour * - ! minute Minute * - ! * - !********************************************************************* - - use par_mod, only: dp - - implicit none - - integer :: jjjj,mm,id,iu,minute,yyyymmdd,hhmmss - integer :: ndaynum - real :: sinsol,solelev,ylat,xlon - real :: rnum,rylat,ttime,dekl,rdekl,eq - real,parameter :: pi=3.1415927 - real(kind=dp) :: jul - - call caldate(jul,yyyymmdd,hhmmss) - jjjj=yyyymmdd/10000 - mm=yyyymmdd/100-jjjj*100 - id=yyyymmdd-jjjj*10000-mm*100 - iu=hhmmss/10000 - minute=hhmmss/100-100*iu - - ndaynum=31*(mm-1)+id - if(mm.gt.2) ndaynum=ndaynum-int(0.4*mm+2.3) - if((mm.gt.2).and.(jjjj/4*4.eq.jjjj)) ndaynum=ndaynum+1 - - rnum=2.*pi*ndaynum/365. - rylat=pi*ylat/180. - ttime=real(iu)+real(minute)/60. - - dekl=0.396+3.631*sin(rnum)+0.038*sin(2.*rnum)+0.077*sin(3.*rnum)- & - 22.97*cos(rnum)-0.389*cos(2.*rnum)-0.158*cos(3.*rnum) - rdekl=pi*dekl/180. - - eq=(0.003-7.343*sin(rnum)-9.47*sin(2.*rnum)- & - 0.329*sin(3.*rnum)-0.196*sin(4.*rnum)+ & - 0.552*cos(rnum)-3.020*cos(2.*rnum)- & - 0.076*cos(3.*rnum)-0.125*cos(4.*rnum))/60. - - sinsol=sin(rylat)*sin(rdekl)+cos(rylat)*cos(rdekl)* & - cos((ttime-12.+xlon/15.+eq)*pi/12.) - ! Calculate the maximum solar elevation on that day - !sinsol=sin(rylat)*sin(rdekl)+cos(rylat)*cos(rdekl)* - ! & cos((eq)*pi/12.) - solelev=asin(sinsol)*180./pi - zenithangle=90.-solelev - - return -end function zenithangle - -subroutine ohreaction(itime,ltsample,loutnext) - ! i i i - !***************************************************************************** - ! * - ! * - ! Author: R.L. Thompson * - ! * - ! Nov 2014 * - ! * - ! * - !***************************************************************************** - ! Variables: * - ! ix,jy indices of output grid cell for each particle * - ! itime [s] actual simulation time [s] * - ! jpart particle index * - ! ldeltat [s] interval since radioactive decay was computed * - ! loutnext [s] time for which gridded deposition is next output * - ! loutstep [s] interval at which gridded deposition is output * - ! oh_average [molecule/cm^3] OH Concentration * - ! ltsample [s] interval over which mass is deposited * - ! * - !***************************************************************************** - use par_mod - use com_mod - use windfields_mod - use particle_mod - - implicit none - - integer :: ii,jpart,itime,ltsample,loutnext,ldeltat,j,k,ix,jy!,ijx,jjy -!PS integer :: ngrid,interp_time,m,n,ih,indz,i!,ia,il - integer :: ngrid,interp_time,n,indz,i!,ia,il -!PS integer :: jjjjmmdd,hhmmss, - integer OHx,OHy,OHz - real, dimension(nzOH) :: altOHtop - real :: xlon,ylat - real :: xtn,ytn - real :: restmass,ohreacted,oh_average - real :: ohrate,temp - real, parameter :: smallnum = tiny(0.0) ! smallest number that can be handled - - ! Compute interval since radioactive decay of deposited mass was computed - !************************************************************************ - - if (itime.le.loutnext) then - ldeltat=itime-(loutnext-loutstep) - else ! first half of next interval - ldeltat=itime-loutnext - endif - -!PS jul=bdate+real(itime,kind=dp)/86400. -!PS call caldate(jul,jjjjmmdd,hhmmss) -!PS m=(jjjjmmdd-(jjjjmmdd/10000)*10000)/100 -!PS h=hhmmss/10000 - - ! Loop over particles - !***************************************** -!$OMP PARALLEL PRIVATE(jpart,xtn,ytn,j,k,ix,jy,interp_time, & -!$OMP n,indz,i,xlon,ylat,OHx,OHy,OHz,oh_average,temp,ohrate, & -!$OMP restmass,ohreacted,altOHtop,ngrid) - -!$OMP DO - do ii=1,count%alive - - jpart=count%ialive(ii) - ! Determine which nesting level to be used - ngrid=0 - do j=numbnests,1,-1 ! Why is there a +/- eps everywhere else for ngrid but not here? - if ((part(jpart)%xlon.gt.xln(j)).and.(part(jpart)%xlon.lt.xrn(j)).and. & - (part(jpart)%ylat.gt.yln(j)).and.(part(jpart)%ylat.lt.yrn(j))) then - ngrid=j - exit - endif - end do - - ! Determine nested grid coordinates - if (ngrid.gt.0) then - xtn=(real(part(jpart)%xlon)-xln(ngrid))*xresoln(ngrid) - ytn=(real(part(jpart)%ylat)-yln(ngrid))*yresoln(ngrid) - ix=int(xtn) - jy=int(ytn) - else - ix=int(part(jpart)%xlon) - jy=int(part(jpart)%ylat) - endif - - interp_time=nint(itime-0.5*ltsample) - n=2 - if(abs(memtime(1)-interp_time).lt.abs(memtime(2)-interp_time)) n=1 - - indz=nz-1 - do i=2,nz - if (height(i).gt.part(jpart)%z) then - indz=i-1 - exit - endif - end do - - ! Get OH from nearest grid-cell and specific month - !************************************************* - - ! world coordinates - xlon=real(part(jpart)%xlon)*dx+xlon0 - if (xlon.gt.180) then - xlon=xlon-360 - endif - ylat=real(part(jpart)%ylat)*dy+ylat0 - - ! get position in the OH field - OHx=minloc(abs(lonOH-xlon),dim=1,mask=abs(lonOH-xlon).eq.minval(abs(lonOH-xlon))) - OHy=minloc(abs(latOH-ylat),dim=1,mask=abs(latOH-ylat).eq.minval(abs(latOH-ylat))) - - ! get the level of the OH field for the particle - ! z is the z-coord of the trajectory above model orography in metres - ! altOH is the height of the centre of the level in the OH field above orography - do i=2,nzOH - altOHtop(i-1)=altOH(i)+0.5*(altOH(i)-altOH(i-1)) - end do - altOHtop(nzOH)=altOH(nzOH)+0.5*(altOH(nzOH)-altOH(nzOH-1)) - OHz=minloc(abs(altOHtop-part(jpart)%z),dim=1,mask=abs(altOHtop-part(jpart)%z) & - .eq.minval(abs(altOHtop-part(jpart)%z))) - - ! Interpolate between hourly OH fields to current time - !***************************************************** - - oh_average=OH_hourly(OHx,OHy,OHz,1)+ & - (OH_hourly(OHx,OHy,OHz,2)-OH_hourly(OHx,OHy,OHz,1))* & - (itime-memOHtime(1))/(memOHtime(2)-memOHtime(1)) - - if (oh_average.gt.smallnum) then - - ! Computation of the OH reaction - !********************************************************** - - temp=tt(ix,jy,indz,n) - - do k=1,nspec - if (ohcconst(k).gt.0.) then - ohrate=ohcconst(k)*temp**ohnconst(k)*exp(-ohdconst(k)/temp)*oh_average - ! new particle mass - restmass = part(jpart)%mass(k)*exp(-1*ohrate*abs(ltsample)) - if (restmass .gt. smallnum) then - part(jpart)%mass(k)=restmass - else - part(jpart)%mass(k)=0. - endif - ohreacted=part(jpart)%mass(k)*(1-exp(-1*ohrate*abs(ltsample))) - if (jpart.eq.1) write(*,*) 'ohreaction', part(jpart)%mass(k),k - else - ohreacted=0. - endif - end do - endif ! oh_average.gt.smallnum - - end do !continue loop over all particles - -!$OMP END DO -!$OMP END PARALLEL -end subroutine ohreaction - -subroutine gethourlyOH(itime) - ! i - !***************************************************************************** - ! * - ! * - ! Author: R.L. Thompson * - ! * - ! Nov 2014 * - ! * - ! * - !***************************************************************************** - ! Variables: * - ! * - !***************************************************************************** - use par_mod - use com_mod - - implicit none - - integer :: itime - integer :: ix,jy,kz,m1,m2 - integer :: ijx,jjy - integer :: jjjjmmdd,hhmmss - real :: sza,jrate - real(kind=dp) :: jul1,jul2 - - - ! Check hourly OH field is available for the current time step - !************************************************************** - - if ((ldirect*memOHtime(1).le.ldirect*itime).and. & - (ldirect*memOHtime(2).gt.ldirect*itime)) then - - ! The right OH fields are already in memory -> don't do anything - !**************************************************************** - - return - - else if ((ldirect*memOHtime(2).le.ldirect*itime).and. & - (memOHtime(2).ne.0.)) then - - ! Current time is after 2nd OH field - !************************************ - - memOHtime(1)=memOHtime(2) - memOHtime(2)=memOHtime(1)+ldirect*3600. - OH_hourly(:,:,:,1)=OH_hourly(:,:,:,2) - - ! Compute new hourly value of OH - !********************************************************** - - jul2=bdate+memOHtime(2)/86400._dp ! date for next hour - call caldate(jul2,jjjjmmdd,hhmmss) - m2=(jjjjmmdd-(jjjjmmdd/10000)*10000)/100 - -!$OMP PARALLEL PRIVATE(kz,jy,ix,ijx,jjy,sza,jrate) -!$OMP DO COLLAPSE(3) - do kz=1,nzOH - do jy=1,nyOH - do ix=1,nxOH - ijx=minloc(abs(lonjr-lonOH(ix)),dim=1,mask=abs(lonjr-lonOH(ix)).eq.minval(abs(lonjr-lonOH(ix)))) - jjy=minloc(abs(latjr-latOH(jy)),dim=1,mask=abs(latjr-latOH(jy)).eq.minval(abs(latjr-latOH(jy)))) - ! calculate solar zenith angle in degrees (sza) - sza=zenithangle(latOH(jy),lonOH(ix),jul2) - ! calculate J(O1D) (jrate) - jrate=photo_O1D(sza) - ! apply hourly correction to OH - if(jrate_average(ijx,jjy,m2).gt.0.) then - OH_hourly(ix,jy,kz,2)=OH_field(ix,jy,kz,m2)*jrate/jrate_average(ijx,jjy,m2) - else - OH_hourly(ix,jy,kz,2)=0. - endif - !! for testing !! - ! if(jy.eq.36.and.ix.eq.36.and.kz.eq.1) then - ! write(999,fmt='(F6.3)') jrate/jrate_average(ijx,jjy,m2) - ! endif - ! if(jy.eq.11.and.ix.eq.36.and.kz.eq.1) then - ! write(998,fmt='(F6.3)') jrate/jrate_average(ijx,jjy,m2) - ! endif - end do - end do - end do -!$OMP END DO -!$OMP END PARALLEL - - else - - ! No OH fields in memory -> compute both hourly OH fields - !********************************************************** - - jul1=bdate ! begin date of simulation (julian) - call caldate(jul1,jjjjmmdd,hhmmss) - m1=(jjjjmmdd-(jjjjmmdd/10000)*10000)/100 - memOHtime(1)=0. - - jul2=bdate+ldirect*real(1./24.,kind=dp) ! date for next hour - call caldate(jul2,jjjjmmdd,hhmmss) - m2=(jjjjmmdd-(jjjjmmdd/10000)*10000)/100 - memOHtime(2)=ldirect*3600. - -!$OMP PARALLEL PRIVATE(kz,jy,ix,ijx,jjy,sza,jrate) -!$OMP DO COLLAPSE(3) - do kz=1,nzOH - do jy=1,nyOH - do ix=1,nxOH - ijx=minloc(abs(lonjr-lonOH(ix)),dim=1,mask=abs(lonjr-lonOH(ix)).eq.minval(abs(lonjr-lonOH(ix)))) - jjy=minloc(abs(latjr-latOH(jy)),dim=1,mask=abs(latjr-latOH(jy)).eq.minval(abs(latjr-latOH(jy)))) - ! calculate solar zenith angle in degrees (sza), beginning - sza=zenithangle(latOH(jy),lonOH(ix),jul1) - ! calculate J(O1D) (jrate), beginning - jrate=photo_O1D(sza) - ! apply hourly correction to OH - if(jrate_average(ijx,jjy,m1).gt.0.) then - OH_hourly(ix,jy,kz,1)=OH_field(ix,jy,kz,m1)*jrate/jrate_average(ijx,jjy,m1) - else - OH_hourly(ix,jy,kz,1)=0. - endif - ! calculate solar zenith angle in degrees (sza), after 1-hour - sza=zenithangle(latOH(jy),lonOH(ix),jul2) - ! calculate J(O1D) (jrate), after 1-hour - jrate=photo_O1D(sza) - ! apply hourly correction to OH - if(jrate_average(ijx,jjy,m2).gt.0.) then - OH_hourly(ix,jy,kz,2)=OH_field(ix,jy,kz,m2)*jrate/jrate_average(ijx,jjy,m2) - else - OH_hourly(ix,jy,kz,2)=0. - endif - end do - end do - end do -!$OMP END DO -!$OMP END PARALLEL - - endif -end subroutine gethourlyOH - -end module ohr_mod diff --git a/src/outgrid_mod.f90 b/src/outgrid_mod.f90 index 581f3435a1310c3ab8e454349faab4eda1eb3d64..97138884050729ef12d3fac1009277e4e6b0d6b4 100644 --- a/src/outgrid_mod.f90 +++ b/src/outgrid_mod.f90 @@ -164,7 +164,7 @@ subroutine outgrid_init ! * !***************************************************************************** - use ohr_mod +! use ohr_mod use unc_mod use windfields_mod, only: nxmax implicit none @@ -322,60 +322,42 @@ subroutine outgrid_init ! Initialize output grids !************************ - do ks=1,nspec - do kp=1,maxpointspec_act - if ((numreceptor.gt.0).and.(ipin.ne.1).and.(ipin.ne.4)) then - do i=1,numreceptor - ! Receptor points - creceptor(i,ks)=0. - end do - endif - do nage=1,nageclass - do jy=0,numygrid-1 - do ix=0,numxgrid-1 - do kz=1,numzgrid - if (iflux.eq.1) then ! Flux fields - do i=1,5 - if ((ipin.ne.1).and.(ipin.ne.4)) flux(i,ix,jy,kz,ks,kp,nage)=0. + if (iflux.eq.1) then + do i=1,5 + if ((ipin.ne.1).and.(ipin.ne.4)) flux(i,:,:,:,:,:,:)=0. #ifdef _OPENMP - flux_omp(i,ix,jy,kz,ks,kp,nage,:)=0. + flux_omp(i,:,:,:,:,:,:,:)=0. #endif - end do - endif + end do + endif ! Initial condition field - if ((nage.eq.1).and.(linit_cond.gt.0)) then - if ((ipin.ne.1).and.(ipin.ne.4)) init_cond(ix,jy,kz,ks,kp)=0. + if ((nage.eq.1).and.(linit_cond.gt.0)) then + if ((ipin.ne.1).and.(ipin.ne.4)) init_cond(:,:,:,:,:)=0. #ifdef _OPENMP - init_cond_omp(ix,jy,kz,ks,kp,:)=0. + init_cond_omp(:,:,:,:,:,:)=0. #endif - endif - end do - do l=1,nclassunc - ! Deposition fields - if (ldirect.gt.0) then - if ((ipin.ne.1).and.(ipin.ne.4)) then - wetgridunc(ix,jy,ks,kp,l,nage)=0. - drygridunc(ix,jy,ks,kp,l,nage)=0. - endif + endif + ! Deposition fields + if (ldirect.gt.0) then + if ((ipin.ne.1).and.(ipin.ne.4)) then + wetgridunc(:,:,:,:,:,:)=0. + drygridunc(:,:,:,:,:,:)=0. + endif #ifdef _OPENMP - wetgridunc_omp(ix,jy,ks,kp,l,nage,:)=0. - drygridunc_omp(ix,jy,ks,kp,l,nage,:)=0. + wetgridunc_omp(:,:,:,:,:,:,:)=0. + drygridunc_omp(:,:,:,:,:,:,:)=0. #endif - endif - do kz=1,numzgrid - ! Concentration fields - if ((ipin.ne.1).and.(ipin.ne.4)) gridunc(ix,jy,kz,ks,kp,l,nage)=0. + endif + ! Concentration fields + if ((ipin.ne.1).and.(ipin.ne.4)) gridunc(:,:,:,:,:,:,:)=0. + ! Weighting for LCM output + gridcnt(:,:,:)=0. #ifdef _OPENMP - gridunc_omp(ix,jy,kz,ks,kp,l,nage,:)=0. + gridunc_omp(:,:,:,:,:,:,:,:)=0. + gridcnt_omp(:,:,:,:)=0. #endif - end do - end do - end do - end do - end do - end do - end do + end subroutine outgrid_init subroutine outgrid_init_nest @@ -666,11 +648,11 @@ subroutine initcond_calc(itime,i,thread) #ifdef _OPENMP init_cond_omp(ix,jy,kz,ks,nrelpointer,thread)= & init_cond_omp(ix,jy,kz,ks,nrelpointer,thread)+ & - part(i)%mass(ks)/rhoi + mass(i,ks)/rhoi #else init_cond(ix,jy,kz,ks,nrelpointer)= & init_cond(ix,jy,kz,ks,nrelpointer)+ & - part(i)%mass(ks)/rhoi + mass(i,ks)/rhoi #endif end do endif @@ -706,10 +688,10 @@ subroutine initcond_calc(itime,i,thread) #ifdef _OPENMP init_cond_omp(ix,jy,kz,ks,nrelpointer,thread)= & init_cond_omp(ix,jy,kz,ks,nrelpointer,thread) + & - part(i)%mass(ks)/rhoi*w + mass(i,ks)/rhoi*w #else init_cond(ix,jy,kz,ks,nrelpointer)= & - init_cond(ix,jy,kz,ks,nrelpointer)+part(i)%mass(ks)/rhoi*w + init_cond(ix,jy,kz,ks,nrelpointer)+mass(i,ks)/rhoi*w #endif end do endif @@ -720,10 +702,10 @@ subroutine initcond_calc(itime,i,thread) #ifdef _OPENMP init_cond_omp(ix,jyp,kz,ks,nrelpointer,thread)= & init_cond_omp(ix,jyp,kz,ks,nrelpointer,thread) + & - part(i)%mass(ks)/rhoi*w + mass(i,ks)/rhoi*w #else init_cond(ix,jyp,kz,ks,nrelpointer)= & - init_cond(ix,jyp,kz,ks,nrelpointer)+part(i)%mass(ks)/rhoi*w + init_cond(ix,jyp,kz,ks,nrelpointer)+mass(i,ks)/rhoi*w #endif end do endif @@ -737,10 +719,10 @@ subroutine initcond_calc(itime,i,thread) #ifdef _OPENMP init_cond_omp(ixp,jyp,kz,ks,nrelpointer,thread)= & init_cond_omp(ixp,jyp,kz,ks,nrelpointer,thread) + & - part(i)%mass(ks)/rhoi*w + mass(i,ks)/rhoi*w #else init_cond(ixp,jyp,kz,ks,nrelpointer)= & - init_cond(ixp,jyp,kz,ks,nrelpointer)+part(i)%mass(ks)/rhoi*w + init_cond(ixp,jyp,kz,ks,nrelpointer)+mass(i,ks)/rhoi*w #endif end do endif @@ -751,10 +733,10 @@ subroutine initcond_calc(itime,i,thread) #ifdef _OPENMP init_cond_omp(ixp,jy,kz,ks,nrelpointer,thread)= & init_cond_omp(ixp,jy,kz,ks,nrelpointer,thread) + & - part(i)%mass(ks)/rhoi*w + mass(i,ks)/rhoi*w #else init_cond(ixp,jy,kz,ks,nrelpointer)= & - init_cond(ixp,jy,kz,ks,nrelpointer)+part(i)%mass(ks)/rhoi*w + init_cond(ixp,jy,kz,ks,nrelpointer)+mass(i,ks)/rhoi*w #endif end do endif diff --git a/src/output_mod.f90 b/src/output_mod.f90 index 5446e7e83cd0345be869358857c9da19ab179d31..b8680cf20b99bf9dcaca1b6faa4e45a6f5575e77 100644 --- a/src/output_mod.f90 +++ b/src/output_mod.f90 @@ -62,19 +62,19 @@ subroutine init_output(itime,filesize) jul=bdate+real(itime,kind=dp)/86400._dp call caldate(jul,jjjjmmdd,ihmmss) endif - if ((mdomainfill.eq.0).and.(ipin.le.1)) then - if (itime_init.ne.0) then - if (ldirect.eq.1) then - call create_particles_initialoutput(ihmmss,jjjjmmdd,ibtime,ibdate) - else - call create_particles_initialoutput(ihmmss,jjjjmmdd,ietime,iedate) - endif - else if (ldirect.eq.1) then - call create_particles_initialoutput(ibtime,ibdate,ibtime,ibdate) - else - call create_particles_initialoutput(ietime,iedate,ietime,iedate) - endif - endif + ! if ((mdomainfill.eq.0).and.(ipin.le.1)) then + ! if (itime_init.ne.0) then + ! if (ldirect.eq.1) then + ! call create_particles_initialoutput(ihmmss,jjjjmmdd,ibtime,ibdate) + ! else + ! call create_particles_initialoutput(ihmmss,jjjjmmdd,ietime,iedate) + ! endif + ! else if (ldirect.eq.1) then + ! call create_particles_initialoutput(ibtime,ibdate,ibtime,ibdate) + ! else + ! call create_particles_initialoutput(ietime,iedate,ietime,iedate) + ! endif + ! endif ! Create header files for files that store the particle dump output if (itime_init.ne.0) then if (ldirect.eq.1) then @@ -197,7 +197,7 @@ subroutine output_particles(itime,initial_output) logical :: cartxyz_comp #ifdef USE_NCF - integer :: ncid + integer :: ncid,ncid_tmp #else error stop 'NETCDF missing! Please compile with netcdf if you want the particle dump.' #endif @@ -230,8 +230,8 @@ subroutine output_particles(itime,initial_output) output(:,i) = -1 masstemp(i,:) = -1 masstemp_av(i,:) = -1 - wetdepotemp(i,:) = -1 - drydepotemp(i,:) = -1 + if (wetdep) wetdepotemp(i,:) = -1 + if (drydep) drydepotemp(i,:) = -1 cycle endif !***************************************************************************** @@ -260,6 +260,7 @@ subroutine output_particles(itime,initial_output) output(np,i)=ylat0+real(part(i)%ylat)*dy cycle case ('TO') ! Topography + if (topo_written) cycle if (ngrid.le.0) then call hor_interpol(oro,output(np,i)) else @@ -303,27 +304,22 @@ subroutine output_particles(itime,initial_output) output(np,i)=part(i)%settling cycle case ('MA') ! Mass - do ns=1,nspec - masstemp(i,ns)=part(i)%mass(ns) - end do + if (mass_written) cycle + masstemp(i,:)=mass(i,:) cycle case ('ma') ! Mass averaged do ns=1,nspec - masstemp_av(i,ns)=part(i)%val_av(i_av+(ns-1))/part(i)%ntime + masstemp_av(i,ns)=val_av(i, i_av+(ns-1))/part(i)%ntime end do cycle case ('WD') ! Wet deposition if (wetdep) then - do ns=1,nspec - wetdepotemp(i,ns)=part(i)%wetdepo(ns) - end do + wetdepotemp(i,:)=wetdeposit(i,:) endif cycle case ('DD') ! dry deposition if (drydep) then - do ns=1,nspec - drydepotemp(i,ns)=part(i)%drydepo(ns) - end do + drydepotemp(i,:)=drydeposit(i,:) endif cycle case ('lo') @@ -350,7 +346,7 @@ subroutine output_particles(itime,initial_output) if (.not. partopt(np)%average) then call interpol_partoutput_val(partopt(np)%name,output(np,i),i) else - output(np,i) = part(i)%val_av(i_av)/part(i)%ntime + output(np,i) = val_av(i,i_av)/part(i)%ntime endif end select end do @@ -360,7 +356,7 @@ subroutine output_particles(itime,initial_output) cartxyz_comp=.false. if ((.not. init_out).and.(n_average.gt.0)) then - part(i)%val_av = 0. + val_av(i,:) = 0. part(i)%ntime = 0. part(i)%cartx_av = 0. part(i)%carty_av = 0. @@ -397,67 +393,79 @@ subroutine output_particles(itime,initial_output) write(adate,'(i8.8)') jjjjmmdd write(atime,'(i6.6)') ihmmss j=1 - if (lnetcdfout.eq.1) then + ! if (lnetcdfout.eq.1) then ! open output file - if (init_out) then - call open_partinit_file(ncid) - else + if (init_out) then + call open_partinit_file(ncid) + else + if (.not. lpartoutputperfield) then call open_partoutput_file(ncid) ! First allocate the time and particle dimensions within the netcdf file - call partoutput_netcdf(itime,dummy,'TI',j,ncid) - call partoutput_netcdf(itime,dummy,'PA',j,ncid) + else + do np=1,num_partopt + if (.not. partopt(np)%print) cycle + call open_partoutput_file(partopt(np)%ncid,np) + end do endif - ! Fill the fields in parallel - if (numpart.gt.0) then - ! OpenMP output does not work on all systems depending on how they are set-up -! !$OMP PARALLEL PRIVATE(np,ns) + call update_partoutput_pointers(itime, ncid) + !ppointer_part = count%allocated + endif + ! Fill the fields in parallel + if (numpart.gt.0) then + + ! OpenMP output does not work on all systems depending on how they are set-up +! !$OMP PARALLEL PRIVATE(np,ns,ncid_tmp) ! !$OMP DO SCHEDULE(dynamic) - do np=1,num_partopt - !write(*,*) partopt(np)%name, output(np,1) - if (.not. partopt(np)%print) cycle - if (init_out.and.(partopt(np)%i_average.ne.0)) cycle ! no averages for initial particle output - !write(*,*) partopt(np)%name - if (partopt(np)%name.eq.'MA') then - do ns=1,nspec - if (init_out) then - call partinit_netcdf(masstemp(:,ns),'MA',ns,ncid) - else - call partoutput_netcdf(itime,masstemp(:,ns),'MA',ns,ncid) - endif - end do - else if (partopt(np)%name.eq.'ma') then - do ns=1,nspec - call partoutput_netcdf(itime,masstemp_av(:,ns),'ma',ns,ncid) - end do - else if ((.not. init_out).and.(partopt(np)%name.eq.'WD').and.wetdep) then - do ns=1,nspec - call partoutput_netcdf(itime,wetdepotemp(:,ns),'WD',ns,ncid) - end do - else if ((.not. init_out).and.(partopt(np)%name.eq.'DD').and.drydep) then - do ns=1,nspec - call partoutput_netcdf(itime,drydepotemp(:,ns),'DD',ns,ncid) - end do - else + do np=1,num_partopt + if (.not. partopt(np)%print) cycle + if (init_out.and.(partopt(np)%i_average.ne.0)) cycle ! no averages for initial particle output + if (lpartoutputperfield.and. (.not. init_out)) then + ncid_tmp=partopt(np)%ncid + else + ncid_tmp = ncid + endif + if (partopt(np)%name.eq.'MA') then + do ns=1,nspec if (init_out) then - call partinit_netcdf(output(np,:),partopt(np)%name,j,ncid) + call partinit_netcdf(masstemp(:,ns),'MA',ns,ncid_tmp) else - call partoutput_netcdf(itime,output(np,:),partopt(np)%name,j,ncid) + call partoutput_netcdf(itime,masstemp(:,ns),np,ns,ncid_tmp) endif + end do + else if (partopt(np)%name.eq.'ma') then + do ns=1,nspec + call partoutput_netcdf(itime,masstemp_av(:,ns),np,ns,ncid_tmp) + end do + else if ((.not. init_out).and.(partopt(np)%name.eq.'WD').and.wetdep) then + do ns=1,nspec + call partoutput_netcdf(itime,wetdepotemp(:,ns),np,ns,ncid_tmp) + end do + else if ((.not. init_out).and.(partopt(np)%name.eq.'DD').and.drydep) then + do ns=1,nspec + call partoutput_netcdf(itime,drydepotemp(:,ns),np,ns,ncid_tmp) + end do + else + if (init_out) then + call partinit_netcdf(output(np,:),partopt(np)%name,j,ncid_tmp) + else + call partoutput_netcdf(itime,output(np,:),np,j,ncid_tmp) endif - end do + endif + if (lpartoutputperfield) call close_partoutput_file(ncid_tmp) + end do ! !$OMP END DO ! !$OMP END PARALLEL - endif - call close_partoutput_file(ncid) - if (.not. init_out) then - mass_written=.true. ! needs to be reduced within openmp loop - topo_written=.true. ! same - endif - else - ! Put binary function here endif + if (.not. lpartoutputperfield) call close_partoutput_file(ncid) + if (mdomainfill.ge.1 .and. (.not. init_out)) then + mass_written=.true. ! needs to be reduced within openmp loop + topo_written=.true. ! same + endif + !else + ! Put binary function here + !endif #else ! Put binary function here #endif @@ -531,7 +539,8 @@ subroutine output_conc(itime,loutstart,loutend,loutnext,outnum) ! If necessary, first sample of new grid is also taken !***************************************************** if ((iout.le.3.).or.(iout.eq.5)) then - if (sfc_only.ne.1) then + if (linversionout.eq.0) then + ! regular output format if (lnetcdfout.eq.1) then #ifdef USE_NCF call concoutput_netcdf(itime,outnum,gridtotalunc,wetgridtotalunc,drygridtotalunc) @@ -540,39 +549,32 @@ subroutine output_conc(itime,loutstart,loutend,loutnext,outnum) call concoutput(itime,outnum,gridtotalunc,wetgridtotalunc,drygridtotalunc) endif else + ! inversion output - one file each release if (lnetcdfout.eq.1) then -#ifdef USE_NCF - ! call concoutput_sfc_netcdf(itime,outnum,gridtotalunc,wetgridtotalunc,drygridtotalunc) - error stop 'Netcdf output for surface only not yet implemented' -#endif + write(*,*) 'FLEXPART ERROR: netcdf output not avaiable yet for inversion format' + error stop else - if (linversionout.eq.1) then - call concoutput_inversion(itime,outnum,gridtotalunc,wetgridtotalunc,drygridtotalunc) - else - call concoutput_sfc(itime,outnum,gridtotalunc,wetgridtotalunc,drygridtotalunc) - endif + call concoutput_inversion(itime,outnum,gridtotalunc,wetgridtotalunc,drygridtotalunc) endif endif if (nested_output .eq. 1) then - if (lnetcdfout.eq.1) then + if (linversionout.eq.0) then + ! regular output format + if (lnetcdfout.eq.1) then #ifdef USE_NCF - if (sfc_only.ne.1) then call concoutput_nest_netcdf(itime,outnum) +#endif else - error stop 'Netcdf output for surface only not yet implemented' - !call concoutput_sfc_nest_netcdf(itime,outnum) + call concoutput_nest(itime,outnum) endif -#endif else - if (sfc_only.ne.1) then - call concoutput_nest(itime,outnum) - else - if(linversionout.eq.1) then - call concoutput_inversion_nest(itime,outnum) - else - call concoutput_sfc_nest(itime,outnum) - endif + ! inversion output + if (lnetcdfout.eq.1) then + write(*,*) 'FLEXPART ERROR: netcdf output not avaiable yet for inversion format' + error stop + else + call concoutput_inversion_nest(itime,outnum) endif endif endif @@ -654,6 +656,7 @@ subroutine conccalc(itime,weight) #endif !$OMP PARALLEL PRIVATE(i,itage,nage,inage,rhoi,nrelpointer,kz,xl,yl,ks,wx,wy,w,thread,ddx,ddy, & !$OMP ix,jy,ixp,jyp) + #if (defined _OPENMP) thread = OMP_GET_THREAD_NUM()+1 ! Starts with 1 #else @@ -668,16 +671,18 @@ subroutine conccalc(itime,weight) ! Determine age class of the particle itage=abs(itime-part(i)%tstart) nage=1 - do inage=1,nageclass - nage=inage - if (itage.lt.lage(nage)) exit - end do + if (lagespectra.eq.1) then + do inage=1,nageclass + nage=inage + if (itage.lt.lage(nage)) exit + end do + endif ! if (xscav_frac1(i,1).lt.0) xscav_count=xscav_count+1 + !************************************************************************ ! For special runs, interpolate the air density to the particle position !************************************************************************ - !*********************************************************************** !AF IND_SOURCE switches between different units for concentrations at the source !Af NOTE that in backward simulations the release of particles takes place !Af at the receptor and the sampling at the source. @@ -686,12 +691,11 @@ subroutine conccalc(itime,weight) !Af IND_RECEPTOR switches between different units for concentrations at the receptor !Af 1="mass" !Af 2="mass mixing ratio" - !Af switches for the conccalcfile: !AF IND_SAMP = 0 : xmass * 1 !Af IND_SAMP = -1 : xmass / rho - !Af ind_samp is defined in readcommand.f + !************************************************************************ if ( ind_samp .eq. -1 ) then #ifdef ETA @@ -705,8 +709,6 @@ subroutine conccalc(itime,weight) !**************************************************************************** ! 1. Evaluate grid concentrations using a uniform kernel of bandwidths dx, dy !**************************************************************************** - - ! For backward simulations, look from which release point the particle comes from ! For domain-filling trajectory option, npoint contains a consecutive particle ! number, not the release point information. Therefore, nrelpointer is set to 1 @@ -757,11 +759,11 @@ subroutine conccalc(itime,weight) #ifdef _OPENMP gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= & gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ & - part(i)%mass(ks)/rhoi*weight*max(xscav_frac1(i,ks),0.0) + mass(i,ks)/rhoi*weight*max(xscav_frac1(i,ks),0.0) #else gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= & gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ & - part(i)%mass(ks)/rhoi*weight*max(xscav_frac1(i,ks),0.0) + mass(i,ks)/rhoi*weight*max(xscav_frac1(i,ks),0.0) #endif end do else @@ -776,17 +778,38 @@ subroutine conccalc(itime,weight) #endif end do else - do ks=1,nspec + if (llcmoutput) then + ! special case LCM output use mass ratio species to airtracer + ! species 1 is always airtracer + do ks=2,nspec #ifdef _OPENMP - gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= & - gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ & - part(i)%mass(ks)/rhoi*weight + gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= & + gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ & + mass(i,ks)/mass(i,1)*weight #else - gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= & - gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ & - part(i)%mass(ks)/rhoi*weight + gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= & + gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ & + mass(i,ks)/mass(i,1)*weight #endif - end do + end do +#ifdef _OPENMP + gridcnt_omp(ix,jy,kz,thread)=gridcnt_omp(ix,jy,kz,thread)+weight +#else + gridcnt(ix,jy,kz)=gridcnt(ix,jy,kz)+weight +#endif + else + do ks=1,nspec +#ifdef _OPENMP + gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= & + gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ & + mass(i,ks)/rhoi*weight +#else + gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= & + gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ & + mass(i,ks)/rhoi*weight +#endif + end do + end if ! llcmoutput end if endif endif @@ -822,25 +845,46 @@ subroutine conccalc(itime,weight) #ifdef _OPENMP gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= & gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ & - part(i)%mass(ks)/rhoi*w*weight*max(xscav_frac1(i,ks),0.0) + mass(i,ks)/rhoi*w*weight*max(xscav_frac1(i,ks),0.0) #else gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= & gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ & - part(i)%mass(ks)/rhoi*w*weight*max(xscav_frac1(i,ks),0.0) + mass(i,ks)/rhoi*w*weight*max(xscav_frac1(i,ks),0.0) #endif end do else - do ks=1,nspec + if (llcmoutput) then + ! special case CTM output use mass ratio species to airtracer + ! species 1 is always airtracer + do ks=2,nspec #ifdef _OPENMP - gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= & - gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ & - part(i)%mass(ks)/rhoi*weight*w + gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= & + gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ & + mass(i,ks)/mass(i,1)*weight*w #else - gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= & - gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ & - part(i)%mass(ks)/rhoi*weight*w + gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= & + gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ & + mass(i,ks)/mass(i,1)*weight*w #endif - end do + end do +#ifdef _OPENMP + gridcnt_omp(ix,jy,kz,thread)=gridcnt_omp(ix,jy,kz,thread)+w*weight +#else + gridcnt(ix,jy,kz)=gridcnt(ix,jy,kz)+w*weight +#endif + else + do ks=1,nspec +#ifdef _OPENMP + gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= & + gridunc_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ & + mass(i,ks)/rhoi*weight*w +#else + gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= & + gridunc(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ & + mass(i,ks)/rhoi*weight*w +#endif + end do + endif ! llcmoutput endif endif @@ -851,26 +895,47 @@ subroutine conccalc(itime,weight) #ifdef _OPENMP gridunc_omp(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= & gridunc_omp(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ & - part(i)%mass(ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0) + mass(i,ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0) #else gridunc(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)= & gridunc(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)+ & - part(i)%mass(ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0) + mass(i,ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0) #endif - end do - else - do ks=1,nspec + end do + else + if (llcmoutput) then + ! special case CTM output use mass ratio species to airtracer + ! species 1 is always airtracer + do ks=2,nspec #ifdef _OPENMP - gridunc_omp(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= & - gridunc_omp(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ & - part(i)%mass(ks)/rhoi*weight*w + gridunc_omp(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= & + gridunc_omp(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ & + mass(i,ks)/mass(i,1)*weight*w #else - gridunc(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)= & - gridunc(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)+ & - part(i)%mass(ks)/rhoi*weight*w + gridunc(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)= & + gridunc(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)+ & + mass(i,ks)/mass(i,1)*weight*w #endif - end do - endif + end do +#ifdef _OPENMP + gridcnt_omp(ix,jyp,kz,thread)=gridcnt_omp(ix,jyp,kz,thread)+w*weight +#else + gridcnt(ix,jyp,kz)=gridcnt(ix,jyp,kz)+w*weight +#endif + else + do ks=1,nspec +#ifdef _OPENMP + gridunc_omp(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= & + gridunc_omp(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ & + mass(i,ks)/rhoi*weight*w +#else + gridunc(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)= & + gridunc(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)+ & + mass(i,ks)/rhoi*weight*w +#endif + end do + endif ! llcmoutput + endif endif endif !ix ge 0 @@ -883,25 +948,46 @@ subroutine conccalc(itime,weight) #ifdef _OPENMP gridunc_omp(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= & gridunc_omp(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ & - part(i)%mass(ks)/rhoi*w*weight*max(xscav_frac1(i,ks),0.0) + mass(i,ks)/rhoi*w*weight*max(xscav_frac1(i,ks),0.0) #else gridunc(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)= & gridunc(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)+ & - part(i)%mass(ks)/rhoi*w*weight*max(xscav_frac1(i,ks),0.0) + mass(i,ks)/rhoi*w*weight*max(xscav_frac1(i,ks),0.0) #endif end do else - do ks=1,nspec + if (llcmoutput) then + ! special case CTM output use mass ratio species to airtracer + ! species 1 is always airtracer + do ks=2,nspec #ifdef _OPENMP - gridunc_omp(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= & - gridunc_omp(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ & - part(i)%mass(ks)/rhoi*weight*w + gridunc_omp(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= & + gridunc_omp(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ & + mass(i,ks)/mass(i,1)*weight*w #else - gridunc(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)= & - gridunc(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)+ & - part(i)%mass(ks)/rhoi*weight*w + gridunc(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)= & + gridunc(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)+ & + mass(i,ks)/mass(i,1)*weight*w #endif - end do + end do +#ifdef _OPENMP + gridcnt_omp(ixp,jyp,kz,thread)=gridcnt_omp(ixp,jyp,kz,thread)+w*weight +#else + gridcnt(ixp,jyp,kz)=gridcnt(ixp,jyp,kz)+w*weight +#endif + else + do ks=1,nspec +#ifdef _OPENMP + gridunc_omp(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= & + gridunc_omp(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ & + mass(i,ks)/rhoi*weight*w +#else + gridunc(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)= & + gridunc(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)+ & + mass(i,ks)/rhoi*weight*w +#endif + end do + endif ! llcmoutput endif endif @@ -912,25 +998,46 @@ subroutine conccalc(itime,weight) #ifdef _OPENMP gridunc_omp(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= & gridunc_omp(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ & - part(i)%mass(ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0) + mass(i,ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0) #else gridunc(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= & gridunc(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ & - part(i)%mass(ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0) + mass(i,ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0) #endif end do else - do ks=1,nspec + if (llcmoutput) then + ! special case CTM output use mass ratio species to airtracer + ! species 1 is always airtracer + do ks=2,nspec #ifdef _OPENMP - gridunc_omp(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= & - gridunc_omp(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ & - part(i)%mass(ks)/rhoi*weight*w + gridunc_omp(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= & + gridunc_omp(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ & + mass(i,ks)/mass(i,1)*weight*w #else - gridunc(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= & - gridunc(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ & - part(i)%mass(ks)/rhoi*weight*w + gridunc(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= & + gridunc(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ & + mass(i,ks)/mass(i,1)*weight*w #endif - end do + end do +#ifdef _OPENMP + gridcnt_omp(ixp,jy,kz,thread)=gridcnt_omp(ixp,jy,kz,thread)+w*weight +#else + gridcnt(ixp,jy,kz)=gridcnt(ixp,jy,kz)+w*weight +#endif + else + do ks=1,nspec +#ifdef _OPENMP + gridunc_omp(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= & + gridunc_omp(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ & + mass(i,ks)/rhoi*weight*w +#else + gridunc(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= & + gridunc(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ & + mass(i,ks)/rhoi*weight*w +#endif + end do + endif ! llcmoutput endif endif endif !ixp ge 0 @@ -966,11 +1073,11 @@ subroutine conccalc(itime,weight) #ifdef _OPENMP griduncn_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= & griduncn_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ & - part(i)%mass(ks)/rhoi*weight*max(xscav_frac1(i,ks),0.0) + mass(i,ks)/rhoi*weight*max(xscav_frac1(i,ks),0.0) #else griduncn(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= & griduncn(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ & - part(i)%mass(ks)/rhoi*weight*max(xscav_frac1(i,ks),0.0) + mass(i,ks)/rhoi*weight*max(xscav_frac1(i,ks),0.0) #endif end do else @@ -989,11 +1096,11 @@ subroutine conccalc(itime,weight) #ifdef _OPENMP griduncn_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= & griduncn_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ & - part(i)%mass(ks)/rhoi*weight + mass(i,ks)/rhoi*weight #else griduncn(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= & griduncn(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ & - part(i)%mass(ks)/rhoi*weight + mass(i,ks)/rhoi*weight #endif end do endif @@ -1032,11 +1139,11 @@ subroutine conccalc(itime,weight) #ifdef _OPENMP griduncn_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= & griduncn_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ & - part(i)%mass(ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0) + mass(i,ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0) #else griduncn(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= & griduncn(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ & - part(i)%mass(ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0) + mass(i,ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0) #endif end do else @@ -1044,11 +1151,11 @@ subroutine conccalc(itime,weight) #ifdef _OPENMP griduncn_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= & griduncn_omp(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ & - part(i)%mass(ks)/rhoi*weight*w + mass(i,ks)/rhoi*weight*w #else griduncn(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= & griduncn(ix,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ & - part(i)%mass(ks)/rhoi*weight*w + mass(i,ks)/rhoi*weight*w #endif end do endif @@ -1061,11 +1168,11 @@ subroutine conccalc(itime,weight) #ifdef _OPENMP griduncn_omp(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= & griduncn_omp(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ & - part(i)%mass(ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0) + mass(i,ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0) #else griduncn(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)= & griduncn(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)+ & - part(i)%mass(ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0) + mass(i,ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0) #endif end do else @@ -1073,11 +1180,11 @@ subroutine conccalc(itime,weight) #ifdef _OPENMP griduncn_omp(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= & griduncn_omp(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ & - part(i)%mass(ks)/rhoi*weight*w + mass(i,ks)/rhoi*weight*w #else griduncn(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)= & griduncn(ix,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)+ & - part(i)%mass(ks)/rhoi*weight*w + mass(i,ks)/rhoi*weight*w #endif end do endif @@ -1093,11 +1200,11 @@ subroutine conccalc(itime,weight) #ifdef _OPENMP griduncn_omp(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= & griduncn_omp(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ & - part(i)%mass(ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0) + mass(i,ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0) #else griduncn(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)= & griduncn(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)+ & - part(i)%mass(ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0) + mass(i,ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0) #endif end do else @@ -1105,11 +1212,11 @@ subroutine conccalc(itime,weight) #ifdef _OPENMP griduncn_omp(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= & griduncn_omp(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ & - part(i)%mass(ks)/rhoi*weight*w + mass(i,ks)/rhoi*weight*w #else griduncn(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)= & griduncn(ixp,jyp,kz,ks,nrelpointer,part(i)%nclass,nage)+ & - part(i)%mass(ks)/rhoi*weight*w + mass(i,ks)/rhoi*weight*w #endif end do endif @@ -1122,11 +1229,11 @@ subroutine conccalc(itime,weight) #ifdef _OPENMP griduncn_omp(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= & griduncn_omp(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ & - part(i)%mass(ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0) + mass(i,ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0) #else griduncn(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= & griduncn(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ & - part(i)%mass(ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0) + mass(i,ks)/rhoi*weight*w*max(xscav_frac1(i,ks),0.0) #endif end do else @@ -1134,11 +1241,11 @@ subroutine conccalc(itime,weight) #ifdef _OPENMP griduncn_omp(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)= & griduncn_omp(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage,thread)+ & - part(i)%mass(ks)/rhoi*weight*w + mass(i,ks)/rhoi*weight*w #else griduncn(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage)= & griduncn(ixp,jy,kz,ks,nrelpointer,part(i)%nclass,nage)+ & - part(i)%mass(ks)/rhoi*weight*w + mass(i,ks)/rhoi*weight*w #endif end do endif @@ -1157,7 +1264,9 @@ subroutine conccalc(itime,weight) #ifdef _OPENMP do ithread=1,numthreads_grid gridunc(:,:,:,:,:,:,:)=gridunc(:,:,:,:,:,:,:)+gridunc_omp(:,:,:,:,:,:,:,ithread) + gridcnt(:,:,:)=gridcnt(:,:,:)+gridcnt_omp(:,:,:,ithread) gridunc_omp(:,:,:,:,:,:,:,ithread)=0. + gridcnt_omp(:,:,:,ithread)=0. end do if (nested_output.eq.1) then do ithread=1,numthreads_grid @@ -1165,61 +1274,9 @@ subroutine conccalc(itime,weight) griduncn_omp(:,:,:,:,:,:,:,ithread)=0. end do endif -#endif - - !*********************************************************************** - ! 2. Evaluate concentrations at receptor points, using the kernel method - !*********************************************************************** - if (numreceptor.eq.0) return - - do n=1,numreceptor - - - ! Reset concentrations - !********************* - - do ks=1,nspec - c(ks)=0. - end do - - - ! Estimate concentration at receptor - !*********************************** - - do j=1,count%alive - i=count%ialive(j) - - itage=abs(itime-part(i)%tstart) - - hz=min(50.+0.3*sqrt(real(itage)),hzmax) - zd=real(part(i)%z)/hz - if (zd.gt.1.) cycle ! save computing time, leave loop - - hx=min((0.29+2.222e-3*sqrt(real(itage)))*dx+ & - real(itage)*1.2e-5,hxmax) ! 80 km/day - xd=(real(part(i)%xlon)-xreceptor(n))/hx - if (xd*xd.gt.1.) cycle ! save computing time, leave loop - - hy=min((0.18+1.389e-3*sqrt(real(itage)))*dy+ & - real(itage)*7.5e-6,hymax) ! 80 km/day - yd=(real(part(i)%ylat)-yreceptor(n))/hy - if (yd*yd.gt.1.) cycle ! save computing time, leave loop - hxyz=hx*hy*hz - - r2=xd*xd+yd*yd+zd*zd - if (r2.lt.1.) then - xkern=factor*(1.-r2) - do ks=1,nspec - c(ks)=c(ks)+part(i)%mass(ks)*xkern/hxyz - end do - endif - end do +#endif - do ks=1,nspec - creceptor(n,ks)=creceptor(n,ks)+2.*weight*c(ks)/receptorarea(n) - end do - end do end subroutine conccalc subroutine partpos_avg(itime,j) @@ -1289,7 +1346,7 @@ subroutine partpos_avg(itime,j) else call hor_interpol_nest(oron,output) endif - part(j)%val_av(i_av)=part(j)%val_av(i_av)+output + val_av(j,i_av)=val_av(j,i_av)+output case ('tr') if (ngrid.le.0) then do m=1,2 @@ -1301,7 +1358,7 @@ subroutine partpos_avg(itime,j) end do endif call temporal_interpolation(tr(1),tr(2),output) - part(j)%val_av(i_av)=part(j)%val_av(i_av)+output + val_av(j,i_av)=val_av(j,i_av)+output case ('hm') if (ngrid.le.0) then do m=1,2 @@ -1313,7 +1370,7 @@ subroutine partpos_avg(itime,j) end do endif call temporal_interpolation(hm(1),hm(2),output) - part(j)%val_av(i_av)=part(j)%val_av(i_av)+output + val_av(j,i_av)=val_av(j,i_av)+output case ('lo') if (.not. cart_comp) then ! Calculate Cartesian 3D coordinates suitable for averaging @@ -1352,16 +1409,16 @@ subroutine partpos_avg(itime,j) #ifdef ETA call update_zeta_to_z(itime,j) #endif - part(j)%val_av(i_av)=part(j)%val_av(i_av)+real(part(j)%z) + val_av(j,i_av)=val_av(j,i_av)+real(part(j)%z) case ('ma') do ns=1,nspec - part(j)%val_av(i_av+(ns-1))=part(j)%val_av(i_av+(ns-1))+part(j)%mass(ns) + val_av(j,i_av+(ns-1))=val_av(j,i_av+(ns-1))+mass(j,ns) end do case ('vs') - part(j)%val_av(i_av)=part(j)%val_av(i_av)+part(j)%settling + val_av(j,i_av)=val_av(j,i_av)+part(j)%settling case default call interpol_partoutput_val(partopt(np)%name,output,j) - part(j)%val_av(i_av)=part(j)%val_av(i_av)+output + val_av(j,i_av)=val_av(j,i_av)+output end select end do ! Reset dz1out diff --git a/src/par_mod.f90 b/src/par_mod.f90 index 5fe9783e60e5fdec64871cef622e4c9aeae683fd..53b482f808e82a66b4e1efde8bdd7fa56f593fd1 100644 --- a/src/par_mod.f90 +++ b/src/par_mod.f90 @@ -11,6 +11,8 @@ ! * ! Update 15 August 2013 IP * ! * +! Anne Tipka, Petra Seibert, 2021-02: implement new interpolation * +! for precipitation according to #295 using 2 additional fields * ! * !******************************************************************************* @@ -78,7 +80,8 @@ module par_mod !real,parameter :: d_trop=50., d_strat=0.1 real :: d_trop=50., d_strat=0.1, fturbmeso=0.16 ! turbulence factors can change for different runs real,parameter :: rho_water=1000. !ZHG 2015 [kg/m3] - real,parameter :: incloud_ratio=6.2 !ZHG MAR2016 + real,parameter :: ratio_incloud=0.0062 !MC 2024 + real,parameter :: wet_a=1.e-5, wet_b=0.8 !AT ! karman Karman's constant ! href [m] Reference height for dry deposition @@ -89,6 +92,8 @@ module par_mod ! yield the scales for the mesoscale wind velocity fluctuations ! d_trop [m2/s] Turbulent diffusivity for horiz components in the troposphere ! d_strat [m2/s] Turbulent diffusivity for vertical component in the stratosphere + ! ratio_incloud MC 2024, dimensionless ratio that should be <= 1 + ! wet_a, wet_b for wetscav=wet_a*prec**wet_b if no cloud found, but precipitation occurs real,parameter :: xmwml=18.016/28.960 @@ -180,21 +185,73 @@ module par_mod ! --------- ! Sabine Eckhardt: change of landuse inventary numclass=13 + integer,parameter :: maxtable=1000, numclass=13 + integer,parameter :: numpf=1 ! number of precip fields original =1, new=3(AT and PS, #295) integer,parameter :: numwfmem=2 ! Serial version/MPI with 2 fields + integer,parameter :: maxndia=1 !integer,parameter :: numwfmem=3 ! MPI with 3 fields ! maxtable Maximum number of chemical species that can be tabulated ! numclass Number of landuse classes available to FLEXPART ! maxndia Maximum number of diameter classes of particles + ! numpf Number of precipitation fields (1 standard, 3 #295) ! numwfmem Number of windfields kept in memory. 2 for serial version, ! 2 or 3 for MPI version + !************************************************************************** + ! Variables for LCM + !************************************************************************** + + integer,parameter :: maxreagent=5 ! Max number of reagents + integer,parameter :: maxrecsample=2000 ! Max number of receptors per sampling interval + !************************************************************************** ! dimension of the OH field !************************************************************************** integer,parameter :: maxxOH=72, maxyOH=46, maxzOH=7 + + !************************************************************************** + ! aerosol below-cloud scavenging removal polynomial constants for rain & snow + !************************************************************************** + + ! AT (after Wang et al 2014, Table 8) + ! rain + real, parameter :: bclr_a(4) = & + (/-6.2609, 0.682, 0.8676, 0.1282/) + real, parameter :: bclr_b(7) = & + (/-14.707, 51.043, -97.306, 97.946, -53.923, 15.311, -1.751/) + real, parameter :: bclr_c(2) = & + (/0.723, 0.0303/) + real, parameter :: bclr_e(7) = & + (/-0.6492, 9.3483, -21.929, 25.317, -15.395, 4.7242, -0.5766/) + ! snow + real, parameter :: bcls_a(7) = & + (/-4.426, 1.394, -1.202, -3.2942, -1.9521, -0.4904, -0.0457/) + real, parameter :: bcls_b(7) = & + (/-4.3521, -0.7828, 12.768, -19.864, 13.618, -4.4350, 0.5551/) + real, parameter :: bcls_c(7) = & + (/0.5664, 0.0085, -0.1948, -0.6532, -0.5462, -0.1778, -0.0201/) + real, parameter :: bcls_e(7) = & + (/0.5689, -0.0923, 0.0402, 1.4523, -2.078, 1.05, -0.1821/) + + ! Cloud parameters to set bottom and top of cloud in verttransform_ecmwf_cloud + ! These will be converted to eta coordinates in verttransform if + ! wind_coord_type='ETA' + + integer, parameter :: max_cloudthck = 19000 !Maximum thickness of clouds + integer, parameter :: min_cloudthck = 50 !Minimum thickness of clouds + ! If clouds in convection regions are outside the following range, they will + ! be fixed to lowconv_range in case of convp > 0.1 + ! or highconv_range otherwise + integer, parameter :: conv_clrange(2) = (/ 3000, 6000 /) + integer, parameter :: highconvp_clrange(2) = (/ 0, 10000 /) + integer, parameter :: lowconvp_clrange(2) = (/ 500, 8000 /) + real, parameter :: rhmin = 0.90 ! Condition for presence of clouds in the nested fields + ! PS note that original by Sabine Eckhart was 80% + ! PS however, for T<-20 C we consider saturation over ice + ! PS so I think 90% should be enough !************************************************************************** ! Maximum number of particles to be released in a single atmospheric column @@ -232,6 +289,7 @@ module par_mod integer,parameter :: unitreceptorout=2 integer,parameter :: unitoutgrid=97, unitoutgridppt=99, unitoutinfo=1 integer,parameter :: unitspecies=1, unitoutrecept=91, unitoutreceptppt=92 + integer,parameter :: unitoutsatellite=108 integer,parameter :: unitlsm=1, unitsfcdata=1, unitland=1, unitwesely=1 integer,parameter :: unitOH=1 integer,parameter :: unitdates=94, unitheader=90,unitheader_txt=100 @@ -245,6 +303,12 @@ module par_mod ! integer code for missing values, used in wet scavenging (PS, 2012) !****************************************************** - integer,parameter :: icmv=-9999 + integer,parameter :: icmv=-9999. + + ! Temporary parameter to switch off the gridfaction calculation in the wetdeposition + logical,parameter :: lgridfraction=.false. + + ! Particle dump: one file per field or all in one netcdf file + logical,parameter :: lpartoutputperfield=.false. end module par_mod diff --git a/src/particle_mod.f90 b/src/particle_mod.f90 index c6b41e5f01b85fecea2c3395af2d56405eb3f237..35363566ecf31e1ecfcf7110dcc48c03b083116e 100644 --- a/src/particle_mod.f90 +++ b/src/particle_mod.f90 @@ -11,7 +11,8 @@ !***************************************************************************** module particle_mod - use com_mod, only: maxspec,DRYDEP,WETDEP,DRYBKDEP,WETBKDEP,iout,n_average,nspec + use com_mod, only: maxspec,DRYDEP,WETDEP,DRYBKDEP,WETBKDEP,iout, & + n_average,nspec,ipout,ipin use par_mod, only: dp implicit none @@ -52,7 +53,7 @@ module particle_mod zeta_prev ! Previous position #endif type(velocities) :: & - vel, & ! Velocities from interpolated windfields + !vel, & ! Velocities from interpolated windfields turbvel, & ! Random turbulent velocities mesovel ! Mesoscale turbulent velocities real :: & @@ -75,15 +76,15 @@ module particle_mod nclass, & !species(maxspec), & ! the number of the corresponding species file of the particle idt ! internal time of the particle - real,allocatable,dimension(:) :: & - mass, & ! Particle mass for each particle species - mass_init, & ! Initial mass of each particle - wetdepo, & ! Wet deposition (cumulative) - drydepo, & ! Dry deposition (cumulative) - prob ! Probability of absorption at ground due to dry deposition + ! real,allocatable,dimension(:) :: & + ! mass, & ! Particle mass for each particle species + ! mass_init, & ! Initial mass of each particle + ! wetdepo, & ! Wet deposition (cumulative) + ! drydepo, & ! Dry deposition (cumulative) + ! prob ! Probability of absorption at ground due to dry deposition - real,allocatable :: & - val_av(:) ! Averaged values; only used when average_output=.true. + ! real,allocatable :: & + ! val_av(:) ! Averaged values; only used when average_output=.true. real :: & ntime=0., & ! Number of timesteps to average over cartx_av=0., & ! Averaged x pos; @@ -98,11 +99,13 @@ module particle_mod spawned=0, & ! Total number of spawned particles terminated=0, & ! Total number of particles that have been terminated allocated=0, & ! Number of total allocated particle spaces + iterm_max=0, & ! Number of empty spaces for overwriting particles ninmem=0 ! Number of particles currently in memory logical,allocatable :: & inmem(:) ! Logical to keep track which particle numbers are allocated integer,allocatable :: & - ialive(:) ! Array that stores alive particle numbers up to count%alive for OMP loops + ialive(:), & ! Array that stores alive particle numbers up to count%alive for OMP loops + iterm(:) ! Array that stores terminated particle numbers up to count%allocated end type type(particle), allocatable :: & @@ -110,7 +113,14 @@ module particle_mod type(particlecount) :: & count ! Keeping track of global particle number within the simulation real,allocatable :: & - xscav_frac1(:,:) ! Only allocated when wet or dry deposit backward mode is switched on + val_av(:,:), & ! Averaged values; only used when average_output=.true. + xscav_frac1(:,:), & ! Only allocated when wet or dry deposit backward mode is switched on + mass(:,:), & ! mass + mass_init(:,:), & + wetdeposit(:,:), & + drydeposit(:,:), & + prob(:,:) + real,allocatable :: & xplum(:),yplum(:),zplum(:) ! Only allocated for iout=4 or 5 (plumetraj) integer,allocatable :: & @@ -125,6 +135,8 @@ module particle_mod dealloc_particle, & dealloc_all_particles, & terminate_particle, & + rewrite_ialive, & + rewrite_iterm, & spawn_particle, & spawn_particles, & get_totalpart_num, & @@ -134,7 +146,18 @@ module particle_mod update_xlon, & update_ylat, & update_z, & - count + count, & + val_av, & + xscav_frac1, & + mass, & + mass_init, & + wetdeposit, & + drydeposit, & + prob, & + xplum, & + yplum, & + zplum, & + nclust interface update_xlon procedure update_xlon_dp, update_xlon_sp, update_xlon_int @@ -189,15 +212,35 @@ contains endif end function particle_allocated - subroutine get_newpart_index(ipart) + subroutine get_newpart_index(ipart,iterm_index) !************************************************** ! Returns the first free spot to put a new particle !************************************************** implicit none integer, intent(inout) :: ipart ! First free index + integer, intent(inout) :: iterm_index + integer :: i - ipart = count%spawned + 1 + if (ipin.le.1 .and. ipout.eq.0) then + if ((ipin.eq.0 .and. count%terminated.eq.0) .or. & + (count%allocated.gt.count%spawned)) then + ipart = count%spawned + 1 + else if (iterm_index.le.count%iterm_max) then + ! Find dead particles to replace + if (count%iterm(iterm_index).eq.-1) then + error stop 'BUG: Attempting to overwrite particle: get_newpart_index.' + endif + ipart=count%iterm(iterm_index) + count%iterm(iterm_index) = -1 + iterm_index = iterm_index+1 + else + write(*,*) ipart + ipart=count%allocated + 1 + endif + else + ipart = count%spawned + 1 + endif end subroutine get_newpart_index subroutine get_totalpart_num(npart) @@ -285,7 +328,10 @@ contains !******************************************* if (.not. particle_allocated(ipart)) call alloc_particle(ipart) - if (part(ipart)%alive) error stop 'Attempting to overwrite existing particle' + if (part(ipart)%alive) then + write(*,*) ipart, count%alive, count%terminated, count%allocated + error stop 'Attempting to overwrite existing particle' + endif ! Update the number of particles that are currently alive !******************************************************** @@ -319,9 +365,6 @@ contains integer, intent(in) :: & ipart, & ! to be terminated particle index itime ! Time at which particle is terminated - integer :: & - i, & ! loop variable - iloc ! location of ipart in count%ialive ! Flagging the particle as having been terminated !************************************************ @@ -331,24 +374,74 @@ contains ! Update the number of current particles that are alive !****************************************************** count%alive = count%alive - 1 + + ! Update the total number of terminated particles during the whole run + !********************************************************************** + count%terminated = count%terminated + 1 + end subroutine terminate_particle + + subroutine rewrite_ialive() + implicit none + + integer :: i,j + + j=1 + do i=1,count%allocated + if (part(i)%alive) then + count%ialive(j)=i + j=j+1 + endif + end do + + count%alive=j-1 + + if (ipin.le.1 .and. ipout.eq.0) call rewrite_iterm + end subroutine rewrite_ialive + + subroutine rewrite_iterm() + implicit none + + integer :: i,j + + j=1 + do i=1,count%allocated + if (.not. part(i)%alive) then + count%iterm(j)=i + j=j+1 + endif + end do + + count%iterm_max=j-1 + + end subroutine rewrite_iterm + + subroutine rewrite_ialive_single(ipart) + implicit none + + integer, intent(in) :: & + ipart ! to be terminated particle index + integer :: & + i, & ! loop variable + iloc ! location of ipart in count%ialive + ! And remove from the ialive array !********************************* ! iloc=findloc(count%ialive,ipart,1) ! findloc not supported in gcc<v9 iloc=count%allocated - do i=1,count%alive+1 + do i=1,count%alive+2 if (count%ialive(i).eq.ipart) then iloc=i exit endif end do if (iloc.ne.count%allocated) then +!$OMP PARALLEL +!$OMP WORKSHARE count%ialive(iloc:count%allocated-1)=count%ialive(iloc+1:count%allocated) +!$OMP END WORKSHARE +!$OMP END PARALLEL endif - - ! Update the total number of terminated particles during the whole run - !********************************************************************** - count%terminated = count%terminated + 1 - end subroutine terminate_particle + end subroutine rewrite_ialive_single subroutine alloc_particles(nmpart) @@ -357,7 +450,7 @@ contains integer, intent(in) :: nmpart type(particle),allocatable :: tmppart(:) logical, allocatable :: tmpcount(:) - real, allocatable :: tmpxscav(:,:) + real, allocatable :: tmpxscav(:,:),tmpval_av(:,:),tmpmass(:,:),tmpdepo(:,:) real, allocatable :: tmpxl(:),tmpyl(:),tmpzl(:) integer, allocatable :: tmpnclust(:) integer :: i,stat @@ -377,37 +470,69 @@ contains if (count%allocated.gt.0) tmpnclust(1:count%allocated) = count%ialive call move_alloc(tmpnclust,count%ialive) + if (ipin.le.1 .and. ipout.eq.0) then + allocate( tmpnclust(count%allocated+nmpart),stat=stat) + if (stat.ne.0) error stop "Could not allocate tmpnclust" + if (count%allocated.gt.0) tmpnclust(1:count%allocated) = count%iterm + call move_alloc(tmpnclust,count%iterm) + endif + count%inmem(count%allocated+1:count%allocated+nmpart) = .true. ! Allocating new particle spaces !******************************* allocate( tmppart(count%allocated+nmpart),stat=stat) if (stat.ne.0) error stop "Could not allocate tmppart" - if (n_average.gt.0) then - do i=1,count%allocated+nmpart - allocate( tmppart(i)%val_av(n_average) ) - tmppart(i)%val_av = 0 - end do - endif do i=1,count%allocated+nmpart - allocate( tmppart(i)%mass(maxspec),tmppart(i)%mass_init(maxspec),stat=stat) - if (stat.ne.0) error stop "Could not allocate tmppart" - if (DRYDEP) then - allocate( tmppart(i)%drydepo(maxspec),tmppart(i)%prob(maxspec),stat=stat) - if (stat.ne.0) error stop "Could not allocate tmppart" - tmppart(i)%drydepo(maxspec)=0. - endif - if (WETDEP) then - allocate( tmppart(i)%wetdepo(maxspec),stat=stat) - if (stat.ne.0) error stop "Could not allocate tmppart" - tmppart(i)%wetdepo(maxspec)=0. - endif + ! allocate( tmppart(i)%mass(maxspec),tmppart(i)%mass_init(maxspec),stat=stat) + ! if (stat.ne.0) error stop "Could not allocate tmppart" + ! if (DRYDEP) then + ! allocate( tmppart(i)%drydepo(maxspec),tmppart(i)%prob(maxspec),stat=stat) + ! if (stat.ne.0) error stop "Could not allocate tmppart" + ! tmppart(i)%drydepo(maxspec)=0. + ! endif + ! if (WETDEP) then + ! allocate( tmppart(i)%wetdepo(maxspec),stat=stat) + ! if (stat.ne.0) error stop "Could not allocate tmppart" + ! tmppart(i)%wetdepo(maxspec)=0. + ! endif tmppart(i)%ntime=0 ! Preventing particles to be written to partoutput when they just spawned end do if (count%allocated.gt.0) tmppart(1:count%allocated) = part call move_alloc(tmppart,part) + allocate( tmpmass(count%allocated+nmpart,maxspec),stat=stat) + if (stat.ne.0) error stop "Could not allocate tmpmass" + if (count%allocated.gt.0) tmpmass(1:count%allocated,:) = mass + call move_alloc(tmpmass,mass) + + allocate( tmpmass(count%allocated+nmpart,maxspec),stat=stat) + if (stat.ne.0) error stop "Could not allocate tmpmass_init" + if (count%allocated.gt.0) tmpmass(1:count%allocated,:) = mass_init + call move_alloc(tmpmass,mass_init) + + if (DRYDEP) then + allocate( tmpdepo(count%allocated+nmpart,maxspec),stat=stat) + if (stat.ne.0) error stop "Could not allocate drydeposit" + if (count%allocated.gt.0) tmpdepo(1:count%allocated,:) = drydeposit + call move_alloc(tmpdepo,drydeposit) + drydeposit(count%allocated+1:count%allocated+nmpart,:)=0. + + allocate( tmpdepo(count%allocated+nmpart,maxspec),stat=stat) + if (stat.ne.0) error stop "Could not allocate prob" + if (count%allocated.gt.0) tmpdepo(1:count%allocated,:) = prob + call move_alloc(tmpdepo,prob) + prob(count%allocated+1:count%allocated+nmpart,:)=0. + endif + if (WETDEP) then + allocate( tmpdepo(count%allocated+nmpart,maxspec),stat=stat) + if (stat.ne.0) error stop "Could not allocate wetdeposit" + if (count%allocated.gt.0) tmpdepo(1:count%allocated,:) = wetdeposit + call move_alloc(tmpdepo,wetdeposit) + wetdeposit(count%allocated+1:count%allocated+nmpart,:)=0. + endif + ! If wet or dry deposition backward mode is switched on, xscav_frac1 ! needs to be allocated !******************************************************************* @@ -420,6 +545,14 @@ contains xscav_frac1(count%allocated+1:count%allocated+nmpart,:) = -1. endif + if (n_average.gt.0) then + allocate( tmpval_av(count%allocated+nmpart,n_average),stat=stat) + if (stat.ne.0) error stop "Could not allocate val_av" + if (count%allocated.gt.0) tmpval_av(1:count%allocated,:) = val_av + tmpval_av(count%allocated+1:count%allocated+nmpart,:) = 0 + call move_alloc(tmpval_av, val_av) + endif + if ((iout.eq.4).or.(iout.eq.5)) then allocate( tmpxl(count%allocated+nmpart),stat=stat) if (stat.ne.0) error stop "Could not allocate tmpxl" @@ -490,19 +623,20 @@ contains integer :: i - if (n_average.gt.0) then - do i=1,count%allocated - deallocate( part(i)%val_av ) - end do - endif + if (n_average.gt.0) deallocate( val_av ) deallocate( part ) deallocate( count%inmem ) deallocate( count%ialive ) + if (ipin.le.1 .and. ipout.eq.0) deallocate( count%iterm ) + deallocate( mass, mass_init ) if (WETBKDEP.or.DRYBKDEP) then deallocate( xscav_frac1 ) endif + if (WETDEP) deallocate( wetdeposit ) + if (DRYDEP) deallocate( drydeposit,prob ) + if ((iout.eq.4).or.(iout.eq.5)) then deallocate( xplum ) deallocate( yplum ) diff --git a/src/pbl_profile_mod.f90 b/src/pbl_profile_mod.f90 index 4f4584aeae7a2af5b86b432b38e1e1d29a3da140..bc30358256621e4419bb0fd17bb9a873d6fab19b 100644 --- a/src/pbl_profile_mod.f90 +++ b/src/pbl_profile_mod.f90 @@ -54,7 +54,7 @@ function psih (z,l) - b*c/d + 1. else x=(1.-16.*zeta)**(.25) - psih=2.*log((1.+x*x)/2.) + psih=2.*log((1.+x*x)*0.5) end if end if @@ -78,9 +78,9 @@ real function psim(z,al) if(zeta.le.0.) then ! UNSTABLE CASE x=(1.-15.*zeta)**0.25 - a1=((1.+x)/2.)**2 - a2=(1.+x**2)/2. - psim=log(a1*a2)-2.*atan(x)+pi/2. + a1=((1.+x)*0.5)**2 + a2=(1.+x**2)*0.5 + psim=log(a1*a2)-2.*atan(x)+pi*0.5 else ! STABLE CASE psim=-4.7*zeta @@ -171,9 +171,9 @@ subroutine pbl_profile(ps,td2m,zml1,t2m,tml1,u10m,uml1,stress,hf) !! Successive approximation will al=50. !! not converge ustar=(vonkarman*deltau)/ & - (log(zml1/10.)-psim(zml1,al)+psim(10.,al)) + (log(zml1*0.1)-psim(zml1,al)+psim(10.,al)) thetastar=(vonkarman*deltat/r1)/ & - (log(zml1/2.)-psih(zml1,al)+psih(2.,al)) + (log(zml1*0.5)-psih(zml1,al)+psih(2.,al)) hf=rhoa*cpa*ustar*thetastar stress=ustar*ustar*rhoa return @@ -183,9 +183,9 @@ subroutine pbl_profile(ps,td2m,zml1,t2m,tml1,u10m,uml1,stress,hf) do iter=1,maxiter alold=al ustar=(vonkarman*deltau)/ & - (log(zml1/10.)-psim(zml1,al)+psim(10.,al)) + (log(zml1*0.1)-psim(zml1,al)+psim(10.,al)) thetastar=(vonkarman*deltat/r1)/ & - (log(zml1/2.)-psih(zml1,al)+psih(2.,al)) + (log(zml1*0.5)-psih(zml1,al)+psih(2.,al)) al=(tmean*ustar**2)/(ga*vonkarman*thetastar) aldiff=abs((al-alold)/alold) if(aldiff.lt.0.01) exit !! Successive approximation successful diff --git a/src/readoptions_mod.f90 b/src/readoptions_mod.f90 index 4a4150d5a6273c4a4d56e0256d1ddd4692da82e8..c214b2acdfdcb0daecf0403a2fe19a4433d08b45 100644 --- a/src/readoptions_mod.f90 +++ b/src/readoptions_mod.f90 @@ -180,7 +180,6 @@ subroutine readavailable tmpwfname character(len=255),allocatable,dimension(:,:) :: wfname1n,tmpwfnamen - ! Windfields are only used, if they are within the modelling period. ! However, 1 additional day at the beginning and at the end is used for ! interpolation. -> Compute beginning and ending date for the windfields. @@ -254,14 +253,14 @@ subroutine readavailable jul=juldate(ldat,ltim) if ((jul.ge.beg).and.(jul.le.endl)) then numbwfn(k)=numbwfn(k)+1 - allocate( tmpwfnamen(numbnests,numbwf),tmpwftimen(numbnests,numbwf), & + allocate( tmpwfnamen(numbnests,numbwfn(k)),tmpwftimen(numbnests,numbwfn(k)), & stat=stat) if (stat.ne.0) error stop 'ERROR: could not allocate tmpwfnamen' if (numbwfn(k).gt.1) then - tmpwfnamen(:,1:numbwf-1)=wfname1n - tmpwftimen(:,1:numbwf-1)=wftime1n + tmpwfnamen(:,1:numbwfn(k)-1)=wfname1n + tmpwftimen(:,1:numbwfn(k)-1)=wftime1n endif - tmpwfnamen(k,numbwfn(k))=fname + tmpwfnamen(k,numbwfn(k))=fname(1:index(fname,' ')) tmpwftimen(k,numbwfn(k))=nint((jul-bdate)*86400._dp) call move_alloc(tmpwfnamen,wfname1n) call move_alloc(tmpwftimen,wftime1n) @@ -426,6 +425,10 @@ subroutine readcommand ! 18 May 1996 * ! HSO, 1 July 2014 * ! Added optional namelist input * + ! * + ! * + ! January 2024 Rona Thompson * + ! Added new variables for LCM * ! * !***************************************************************************** ! * @@ -454,6 +457,9 @@ subroutine readcommand ! loutsample [s] average is computed from samples taken every [s] * ! seconds * ! loutstep [s] time interval of concentration output * + ! lrecoutstep [s] time interval of receptor output * + ! lrecoutaver [s] receptor output is an average of lrecoutaver seconds * + ! lrecoutsample [s] average is computed from samples taken every [s] * ! lsynctime [s] synchronisation time interval for all particles * ! lagespectra switch to turn on (1)/off (0) calculation of age * ! spectra * @@ -476,7 +482,8 @@ subroutine readcommand character(len=50) :: line integer :: ios - integer :: lturbulence_meso + integer :: lturbulence_meso,lcmoutput + character(len=50) :: ohfields_path ! deprecated namelist /command/ & ldirect, & @@ -486,6 +493,9 @@ subroutine readcommand loutaver, & loutsample, & loutrestart, & + lrecoutstep, & + lrecoutaver, & + lrecoutsample, & lsynctime, & ctl, & ifine, & @@ -511,13 +521,15 @@ subroutine readcommand surf_only, & cblflag, & linversionout, & - ohfields_path, & d_trop, & d_strat, & nxshift, & maxthreadgrid, & maxfilesize, & - logvertinterp + logvertinterp, & + ohfields_path, & + lcmoutput, & + itsplit ! deprecated: only for IO back compatibility ! Presetting namelist command ldirect=0 @@ -528,6 +540,9 @@ subroutine readcommand loutstep=10800 loutaver=10800 loutsample=900 + lrecoutstep=-1 + lrecoutaver=-1 + lrecoutsample=-1 loutrestart=-1 lsynctime=900 ctl=-5.0 @@ -554,16 +569,19 @@ subroutine readcommand surf_only=-1 cblflag=0 ! if using old-style COMMAND file, set to 1 here to use mc cbl routine linversionout=0 - ohfields_path="../../flexin/" nxshift=-9999 maxthreadgrid=1 maxfilesize=10000 logvertinterp=0 + ohfields_path='' + lcmoutput=0 + itsplit=999999999 ! deprecated: only for IO back compatibility !Af set release-switch WETBKDEP=.false. DRYBKDEP=.false. + ! Open the command file and read user options ! Namelist input first: try to read as namelist file !************************************************************************** @@ -657,6 +675,14 @@ subroutine readcommand ! 3 = wet deposition in outputfield ! 4 = dry deposition in outputfield + ! Settings for LCM output + !************************************************************ + ! MDOMAINFILL = 1 | LLCMOUTPUT = true + ! IND_SOURCE = 1 | IND_SAMP = 0 + ! IND_RECEPTOR = 1 | calculates mass ratio mixing ratio + ! IOUT = 2 | as ratio species_mass to airtracer_mass + !------------------------------------------------------------ + if ( ldirect .eq. 1 ) then ! FWD-Run !Af set release-switch if (ind_source .eq. 1 ) then !mass @@ -805,6 +831,30 @@ subroutine readcommand endif #endif + ! Check whether RECEPTOR commands are given, otherwise give them default values + !****************************************************************************** + + if (lrecoutstep.eq.-1) then + write(*,*) 'WARNING: FILE COMMAND LRECOUTSTEP not provided,' + write(*,*) 'value of LOUTSTEP will be used if RECEPTORS are' + write(*,*) 'required.' + lrecoutstep=loutstep + endif + + if (lrecoutaver.eq.-1) then + write(*,*) 'WARNING: FILE COMMAND LRECOUTAVER not provided,' + write(*,*) 'value of LOUTAVER will be used if RECEPTORS are' + write(*,*) 'required.' + lrecoutaver=loutaver + endif + + if (lrecoutsample.eq.-1) then + write(*,*) 'WARNING: FILE COMMAND LRECOUTSTEP not provided,' + write(*,*) 'value of LOUTSAMPLE will be used if RECEPTORS are' + write(*,*) 'required.' + lrecoutsample=loutsample + endif + ! Check whether a valid option for gridded model output has been chosen !********************************************************************** @@ -1028,6 +1078,95 @@ subroutine readcommand error stop endif + ! Check consistency of the intervals for receptors + ! ************************************************ + ! only if ldirect=1 + + if (ldirect.eq.1) then + + if (lrecoutaver.eq.0) then + write(*,*) ' #### FLEXPART MODEL ERROR! TIME AVERAGE OF #### ' + write(*,*) ' #### RECEPTOR OUTPUT MUST NOT BE ZERO #### ' + write(*,*) ' #### CHANGE INPUT IN FILE COMMAND. #### ' + stop + endif + + if (lrecoutaver.gt.lrecoutstep) then + write(*,*) ' #### FLEXPART MODEL ERROR! TIME AVERAGE OF #### ' + write(*,*) ' #### RECEPTOR OUTPUT MUST NOT BE #### ' + write(*,*) ' #### GREATER THAN INTERVAL OF OUTPUT. #### ' + write(*,*) ' #### CHANGE INPUT IN FILE COMMAND. #### ' + stop + endif + + if (lrecoutsample.gt.lrecoutaver) then + write(*,*) ' #### FLEXPART MODEL ERROR! SAMPLING TIME OF #### ' + write(*,*) ' #### RECEPTOR OUTPUT MUST NOT BE #### ' + write(*,*) ' #### GREATER THAN TIME AVERAGE OF OUTPUT. #### ' + write(*,*) ' #### CHANGE INPUT IN FILE COMMAND. #### ' + stop + endif + + if (mod(lrecoutaver,lsynctime).ne.0) then + write(*,*) ' #### FLEXPART MODEL ERROR! AVERAGING TIME OF #### ' + write(*,*) ' #### RECEPTOR OUTPUT MUST BE A MULTIPLE #### ' + write(*,*) ' #### OF THE SYNCHRONISATION INTERVAL #### ' + stop + endif + + if ((lrecoutaver/lsynctime).lt.2) then + write(*,*) ' #### FLEXPART MODEL ERROR! AVERAGING TIME OF #### ' + write(*,*) ' #### RECEPTOR OUTPUT MUST BE AT LEAST #### ' + write(*,*) ' #### TWICE THE SYNCHRONISATION INTERVAL #### ' + stop + endif + + if (mod(lrecoutstep,lsynctime).ne.0) then + write(*,*) ' #### FLEXPART MODEL ERROR! INTERVAL BETWEEN #### ' + write(*,*) ' #### RECEPTOR OUTPUT MUST BE A MULTIPLE #### ' + write(*,*) ' #### OF THE SYNCHRONISATION INTERVAL #### ' + stop + endif + + if ((lrecoutstep/lsynctime).lt.2) then + write(*,*) ' #### FLEXPART MODEL ERROR! INTERVAL BETWEEN #### ' + write(*,*) ' #### RECEPTOR OUTPUT MUST BE AT LEAST #### ' + write(*,*) ' #### TWICE THE SYNCHRONISATION INTERVAL #### ' + stop + endif + + if (mod(lrecoutsample,lsynctime).ne.0) then + write(*,*) ' #### FLEXPART MODEL ERROR! SAMPLING TIME OF #### ' + write(*,*) ' #### RECEPTOR OUTPUT MUST BE A MULTIPLE #### ' + write(*,*) ' #### OF THE SYNCHRONISATION INTERVAL #### ' + stop + endif + + endif ! ldirect + + ! Switch for LCM mode + !******************************************************************* + + if ( (lcmoutput.ne.0) .and. ((.not. ind_source.eq.1).or. & + (.not. ind_receptor.eq.1).or.(.not. iout.eq.2).or. & + (.not. ldirect.eq.1).or.(.not. mdomainfill.eq.1)) ) then + write(*,*) 'LCM output requested, but one of the following options' + write(*,*) 'is not correctly set in COMMAND:' + write(*,*) 'ind_source =', ind_source, 'should be set to 1' + write(*,*) 'ind_receptor =', ind_receptor, 'should be set to 1' + write(*,*) 'iout =', iout, 'should be set to 2' + write(*,*) 'ldirect =', ldirect, 'should be set to 1' + write(*,*) 'mdomainfill =', mdomainfill, 'should be set to 1' + error stop + endif + if (lcmoutput.eq.0) then + llcmoutput=.false. + else + llcmoutput=.true. + endif + + write(*,*) 'Switch for LCM output LCMOUTPUT = ',llcmoutput + ! Compute modeling time in seconds and beginning date in Julian date !******************************************************************* @@ -1196,85 +1335,6 @@ subroutine readdepo error stop end subroutine readdepo -subroutine readOHfield - - !***************************************************************************** - ! * - ! Reads the OH field into memory * - ! * - ! AUTHOR: R.L. Thompson, Nov 2014 * - ! * - ! UPDATES: * - ! 03/2018 SEC: Converted original netCDF files to binary format * - !***************************************************************************** - ! * - ! Variables: * - ! * - ! path(numpath) contains the path names * - ! lonOH(nxOH) longitude of OH fields * - ! latOH(nyOH) latitude of OH fields * - ! altOH(nzOH) altitude of OH fields * - ! etaOH(nzOH) eta-levels of OH fields * - ! OH_field(nxOH,nyOH,nzOH,m) OH concentration (molecules/cm3) * - ! * - ! * - !***************************************************************************** - - use ohr_mod - - implicit none - - integer :: i,j,k,l,ierr,stat - real, dimension(:), allocatable :: etaOH - - ! real, parameter :: gasct=8.314 ! gas constant - ! real, parameter :: mct=0.02894 ! kg mol-1 - ! real, parameter :: g=9.80665 ! m s-2 - ! real, parameter :: lrate=0.0065 ! K m-1 - real, parameter :: scalehgt=7000. ! scale height in metres - - - open(unitOH,file=trim(ohfields_path) & - //'OH_FIELDS/OH_variables.bin',status='old', & - form='UNFORMATTED', iostat=ierr, convert='little_endian') - - if(ierr.ne.0) then - write(*,*) 'Cannot read binary OH fields in ', & - trim(ohfields_path)//'OH_FIELDS/OH_variables.bin' - error stop - endif - - read(unitOH) nxOH - read(unitOH) nyOH - read(unitOH) nzOH - write(*,*) nxOH,nyOH,nzOH - - ! allocate variables - allocate(lonOH(nxOH),stat=stat) - if (stat.ne.0) error stop "Could not allocate lonOH" - allocate(latOH(nyOH),stat=stat) - if (stat.ne.0) error stop "Could not allocate latOH" - allocate(etaOH(nzOH),stat=stat) - if (stat.ne.0) error stop "Could not allocate etaOH" - allocate(altOH(nzOH),stat=stat) - if (stat.ne.0) error stop "Could not allocate altOH" - allocate(OH_field(nxOH,nyOH,nzOH,12),stat=stat) - if (stat.ne.0) error stop "Could not allocate OH_field" - allocate(OH_hourly(nxOH,nyOH,nzOH,2),stat=stat) - if (stat.ne.0) error stop "Could not allocate OH_hourly" - - read(unitOH) (lonjr(i),i=1,360) - read(unitOH) (latjr(i),i=1,180) - read(unitOH) (((jrate_average(i,j,k),i=1,360),j=1,180),k=1,12) - read(unitOH) (lonOH(i),i=1,nxOH) - read(unitOH) (latOH(i),i=1,nyOH) - read(unitOH) (lonOH(i),i=1,nxOH) - - read(unitOH) (altOH(i),i=1,nzOH) - read(unitOH) ((((OH_field(i,j,k,l),i=1,nxOH),j=1,nyOH),k=1,nzOH),l=1,12) - read(unitOH) ((((OH_hourly(i,j,k,l),i=1,nxOH),j=1,nyOH),k=1,nzOH),l=1,2) -end subroutine readOHfield - subroutine readlanduse !***************************************************************************** @@ -1611,9 +1671,9 @@ subroutine readoutgrid ! Determine the half levels, i.e. middle levels of the output grid !***************************************************************** - outheighthalf(1)=outheight(1)/2. + outheighthalf(1)=outheight(1)*0.5 do j=2,numzgrid - outheighthalf(j)=(outheight(j-1)+outheight(j))/2. + outheighthalf(j)=(outheight(j-1)+outheight(j))*0.5 end do xoutshift=xlon0-outlon0 @@ -1881,22 +1941,25 @@ subroutine readreceptors real :: xm,ym character(len=16) :: receptor - integer :: ios,stat - real :: lon,lat ! for namelist input, lon/lat are used instead of x,y - real,allocatable,dimension(:) :: tmpxrec,tmpyrec,tmprecarea - character(len=16),allocatable,dimension(:) :: tmprecname + integer :: ios + real :: lon,lat,alt ! for namelist input, lon/lat are used instead of x,y + real(kind=dp) :: time + +! real,allocatable,dimension(:) :: tmpxrec,tmpyrec,tmprecarea +! character(len=16),allocatable,dimension(:) :: tmprecname + ! declare namelist - namelist /receptors/ receptor, lon, lat + namelist /receptors/ & + receptor, lon, lat, alt, time numreceptor=0 ! Initialise numreceptor -!CPS I comment this out - why should we not have receptor output in bwd runs? - ! For backward runs, do not allow receptor output. Thus, set number of - ! receptors to zero - ! if (ldirect.lt.0) then - ! numreceptor=0 - ! return - ! endif + ! For backward runs no receptor output + !************************************* + + if (ldirect.lt.0) then + return + endif ! Open the RECEPTORS file and read output grid specifications !************************************************************ @@ -1906,153 +1969,105 @@ subroutine readreceptors lon = -999. lat = -999. + time = -999. + lrecregular = .false. ! try namelist input read(unitreceptor,receptors,iostat=ios) close (unitreceptor) - ! prepare namelist output if requested - if (nmlout) open(unitreceptorout,file=trim(path(2))// & - 'RECEPTORS.namelist',err=1000) - + if ((lon.lt.-900).or.(ios.ne.0)) then + go to 999 + else ! only namelist input possible - if (ios .ne. 0) then ! read as regular text file + ! prepare namelist output if requested + if (nmlout) open(unitreceptorout,file=trim(path(2))// & + 'RECEPTORS.namelist',status='replace',err=1000) - goto 991 ! wrong variable name in namelist - - elseif (ios .eq. 0) then ! read as namelist - - if (nint(lon) .eq. -999 .or. nint(lat) .eq. -999) goto 993 - - ! PS: reopen file otherwise first receptor is skipped! + ! Get number of receptors + !************************ open (unitreceptor,file=trim(path(1))//'RECEPTORS',status='old',err=999) - - ! Read the names and coordinates of the receptors - !************************************************ j=0 - do while (ios .eq. 0) - j=j+1 + do while (ios.eq.0) + lon=-999.9 read(unitreceptor,receptors,iostat=ios) - if (ios .eq. 0) then - numreceptor = j - allocate( tmprecname(j),tmpxrec(j),tmpyrec(j),tmprecarea(j),stat=stat) - if (stat.ne.0) error stop 'ERROR: could not allocate tmp arrays in readrec' - if (j.gt.1) then - tmprecname(1:j-1)=receptorname - tmpxrec(1:j-1)=xreceptor - tmpyrec(1:j-1)=yreceptor - tmprecarea(1:j-1)=receptorarea - endif - tmprecname(j)=receptor - tmpxrec(j)=(lon-xlon0)/dx ! transform to grid coordinates - tmpyrec(j)=(lat-ylat0)/dy - xm=r_earth*cos(lat*pi/180.)*dx/180.*pi - ym=r_earth*dy/180.*pi - tmprecarea(j)=xm*ym - - call move_alloc(tmprecname,receptorname) - call move_alloc(tmpxrec,xreceptor) - call move_alloc(tmpyrec,yreceptor) - call move_alloc(tmprecarea,receptorarea) - - ! write receptors in namelist format to output directory if requested - if (nmlout) write(unitreceptorout,nml=receptors) -! if (nmlout) write(unitreceptorout,nml=nml_receptors) - elseif (ios .gt. 0) then - write(*,*) ' ### FLEXPART MODEL ERROR! Error in RECEPTORS namelist ###' - error stop 'Error in RECEPTORS namelist' - ! else - ! write (*,*) 'receptor read in nml format, ios<0', ios - ! write (*,receptors) - endif - end do ! end nml receptors reading loop + if ((lon.lt.-900).or.(ios.ne.0)) exit + ! skip receptors for which a timestamp is given but are not in simulation window + if ((time.ne.-999.).and.((time.lt.bdate).or.(time.ge.edate))) cycle + j=j+1 + end do + numreceptor=j + write(*,*) 'Number of receptors: ',numreceptor + close (unitreceptor) - else ! ios<0 = EOF, read as conventional input file + ! Allocate arrays + !**************** - open (unitreceptor,file=trim(path(1))//'RECEPTORS',status='old',err=999) - call skplin(5,unitreceptor) + allocate(receptorname(numreceptor),xreceptor(numreceptor),& + yreceptor(numreceptor),zreceptor(numreceptor),& + treceptor(numreceptor),receptorarea(numreceptor)) ! Read the names and coordinates of the receptors !************************************************ - j=1 -100 continue - read(unitreceptor,*,end=99) - read(unitreceptor,*,end=99) - read(unitreceptor,*,end=99) - read(unitreceptor,'(4x,a16)',end=99) receptor - call skplin(3,unitreceptor) - read(unitreceptor,'(4x,f11.4)',end=99) lon - call skplin(3,unitreceptor) - read(unitreceptor,'(4x,f11.4)',end=99) lat - if (lon.eq.0. .and. lat.eq.0. .and. & - (receptor .eq. ' ')) then - write(*,*) 'WARNING: looks like empty receptor at south pole;'// & - ' will be skipped' - j=j-1 - goto 100 - endif - - numreceptor = j - allocate( tmprecname(j),tmpxrec(j),tmpyrec(j),tmprecarea(j),stat=stat) - if (stat.ne.0) write(*,*)'ERROR: could not allocate tmp arrays in readrec' - if (j.gt.1) then - tmprecname(1:j-1)=receptorname - tmpxrec(1:j-1)=xreceptor - tmpyrec(1:j-1)=yreceptor - tmprecarea(1:j-1)=receptorarea + open (unitreceptor,file=trim(path(1))//'RECEPTORS',status='old',iostat=ios) + j=0 + do while (ios.eq.0) + lon=-999.9 + read(unitreceptor,receptors,iostat=ios) + if ((lon.lt.-900).or.(ios.ne.0)) exit ! read error + ! skip receptors for which a timestamp is given but are not in simulation window + if ((time.ne.-999.).and.((time.lt.bdate).or.(time.ge.edate))) cycle + j=j+1 + receptorname(j)=receptor + xreceptor(j)=(lon-xlon0)/dx ! transform to grid coordinates + yreceptor(j)=(lat-ylat0)/dy + zreceptor(j)=alt + if (time.ne.-999.) then + treceptor(j)=int((time-bdate)*24.*3600.) ! time in sec + ! round to nearest 10 seconds + treceptor(j)=nint(real(treceptor(j))/10.)*10 + else + treceptor(j)=-999 endif - tmprecname(j)=receptor - tmpxrec(j)=(lon-xlon0)/dx ! transform to grid coordinates - tmpyrec(j)=(lat-ylat0)/dy xm=r_earth*cos(lat*pi/180.)*dx/180.*pi ym=r_earth*dy/180.*pi - tmprecarea(j)=xm*ym - - call move_alloc(tmprecname,receptorname) - call move_alloc(tmpxrec,xreceptor) - call move_alloc(tmpyrec,yreceptor) - call move_alloc(tmprecarea,receptorarea) - ! write receptors file in namelist format to output directory if requested + receptorarea(j)=xm*ym + ! write receptors in namelist format to output directory if requested if (nmlout) write(unitreceptorout,nml=receptors) -! if (nmlout) write(unitreceptorout,nml=nml_receptors) - goto 100 + end do + close (unitreceptor) + if (nmlout) close (unitreceptorout) -99 continue + endif - endif ! end no-nml / nml bloc + ! if not timestamp given in namelist assume regular output + ! according to COMMAND file settings + if (.not.any(treceptor.ne.-999)) then + lrecregular=.true. + endif - close (unitreceptor) - if (nmlout) close (unitreceptorout) + !! testing +! write(*,*) 'readreceptors: ' +! do j=1,numreceptor +! print*, 'receptorname = ',receptorname(j) +! print*, 'xreceptor, yreceptor, zreceptor = ',xreceptor(j), yreceptor(j), zreceptor(j) +! print*, 'treceptor = ',treceptor(j) +! end do + !! - write(*,*) 'Number of receptors: ',numreceptor return -991 continue - write(*,*) '#### FLEXPART ERROR: wrong variable names present' - write(*,*) '#### in namelist in file RECEPTORS' - write(*,*) '#### note that in v11+ coordinate names are lon and lat' - - error stop - -993 continue - write(*,*) '#### FLEXPART ERROR: namelist in file RECEPTORS' - write(*,*) '#### first receptor point did not contain lon and/or lat' - write(*,*) '#### Check your namelist!' - error stop - -999 write(*,*) 'INFORMATION: input file RECEPTORS cannot be opened' - write(*,*) 'in directory '//trim(path(1)) - write(*,*) 'Continuing without RECEPTOR' - +999 write(*,*) ' #### FLEXPART WARNING: File RECEPTORS cannot be opened #### ' + write(*,*) ' #### in directory '//trim(path(1))//' #### ' + write(*,*) ' #### continuing without RECEPTOR output #### ' numreceptor=0 return 1000 write(*,*) ' #### FLEXPART MODEL ERROR! File "RECEPTORS" #### ' write(*,*) ' #### cannot be opened in the output directory #### ' write(*,'(a)') ' #### '//trim(path(2)) - write(*,*) ' #### either write perm missing or old file exists ###' - + write(*,*) ' #### either write perm missing or old file exists ####' error stop end subroutine readreceptors @@ -2269,7 +2284,8 @@ subroutine readreleases DEP=.false. DRYDEP=.false. WETDEP=.false. - OHREA=.false. + CLREA=.false. + LDECAY=.false. do i=1,maxspec DRYDEPSPEC(i)=.false. WETDEPSPEC(i)=.false. @@ -2307,9 +2323,10 @@ subroutine readreleases ! Radioactive decay !****************** - - decay(i)=0.693147/decay(i) !conversion half life to decay constant - + if (decay(i).gt.0) then + LDECAY=.true. + decay(i)=0.693147/decay(i) !conversion half life to decay constant + endif ! Dry deposition of gases !************************ @@ -2339,8 +2356,8 @@ subroutine readreleases dryvel(i)=dryvel(i)*0.01 ! conversion to m/s - ! Check if wet deposition or OH reaction shall be calculated - !*********************************************************** + ! Check if wet deposition shall be calculated + !********************************************* ! ESO 04.2016 check for below-cloud scavenging (gas or aerosol) if ((dquer(i).le.0..and.(weta_gas(i).gt.0. .or. wetb_gas(i).gt.0.)) .or. & @@ -2368,11 +2385,6 @@ subroutine readreleases if (lroot) write (*,*) ' In-cloud scavenging: OFF' endif - if (ohcconst(i).gt.0.) then - OHREA=.true. - if (lroot) write (*,*) ' OHreaction switched on: ',ohcconst(i),i - endif - if ((reldiff(i).gt.0.).or.(density(i).gt.0.).or.(dryvel(i).gt.0.)) then DRYDEP=.true. DRYDEPSPEC(i)=.true. @@ -2383,6 +2395,22 @@ subroutine readreleases if (WETDEP.or.DRYDEP) DEP=.true. + ! Check if chemical reaction shall be calculated + !*********************************************** + + if (any(reaccconst(:,:).gt.0.)) then + CLREA=.true. + if (lroot) write (*,*) ' Chemical reactions switched on' + endif + + ! Check if emissions shall be used + !********************************* + + if (any(emis_path(:).ne."")) then + LEMIS=.true. + if (lroot) write(*,*) ' Emissions switched on' + endif + ! Not necessary to read releases when using part_ic.nc !***************************************************** if ((ipin.eq.3).or.(ipin.eq.4)) then @@ -2468,7 +2496,7 @@ subroutine readreleases jul1=juldate(id1,it1) jul2=juldate(id2,it2) - julm=(jul1+jul2)/2. + julm=(jul1+jul2)*0.5 if (jul1.gt.jul2) then write(*,*) 'FLEXPART MODEL ERROR' write(*,*) 'Release stops before it begins.' @@ -2639,6 +2667,9 @@ subroutine readspecies(id_spec,pos_spec) ! HSO, 13 August 2013 ! added optional namelist input ! * + ! R. Thompson, 18.01.2024 * + ! variables for LCM * + ! * !***************************************************************************** ! * ! Variables: * @@ -2647,12 +2678,11 @@ subroutine readspecies(id_spec,pos_spec) ! weta_gas, wetb_gas Parameters for below-cloud scavenging of gasses * ! crain_aero,csnow_aero Parameters for below-cloud scavenging of aerosols * ! ccn_aero,in_aero Parameters for in-cloud scavenging of aerosols * - ! ohcconst OH reaction rate constant C * - ! ohdconst OH reaction rate constant D * - ! ohnconst OH reaction rate constant n * + ! reaccconst Chemical reaction rate constant C * + ! reacdconst Chemical reaction rate constant D * + ! reacnconst Chemical reaction rate constant n * ! id_spec SPECIES number as referenced in RELEASE file * - ! id_pos position where SPECIES data shall be stored * - ! ni Number of diameter classes of particles * * + ! id_pos position where SPECIES data shall be stored * ! Constants: * ! * !***************************************************************************** @@ -2663,13 +2693,19 @@ subroutine readspecies(id_spec,pos_spec) integer :: idow,ihour,id_spec character(len=3) :: aspecnumb - character(len=16) :: pspecies + character(len=16) :: pspecies, pemis_name + character(len=256) :: pemis_path, pemis_file + integer :: pemis_unit + real :: pemis_coeff character(len=50) :: line real :: pdecay, pweta_gas, pwetb_gas, preldiff, phenry, pf0, pdensity, pdquer - real :: pdsigma, pdryvel, pweightmolar, pohcconst, pohdconst, pohnconst + real :: pdsigma, pdryvel, pweightmolar, pdia + character(len=10), allocatable, dimension(:) :: preactions + real, allocatable, dimension(:) :: pcconst, pdconst, pnconst real :: pcrain_aero, pcsnow_aero, pccn_aero, pin_aero + real :: pohcconst,pohdconst,pohnconst ! deprecated real :: parea_dow(7), parea_hour(24), ppoint_dow(7), ppoint_hour(24) - integer :: pndia + !integer :: pndia integer :: ios integer :: pshape,porient ! Daria Tatsii: species shape properties @@ -2679,10 +2715,31 @@ subroutine readspecies(id_spec,pos_spec) namelist /species_params/ & pspecies, pdecay, pweta_gas, pwetb_gas, & pcrain_aero, pcsnow_aero, pccn_aero, pin_aero, & - preldiff, phenry, pf0, pdensity, pdquer, & - pdsigma, pndia, pdryvel, pweightmolar, pohcconst, pohdconst, pohnconst, & + preldiff, phenry, pf0, pdensity, pdquer, pdia, & + pdsigma, pdryvel, pweightmolar, pohnconst, & + preactions, pcconst, pdconst, pnconst, pohcconst, pohdconst, & + pemis_path, pemis_file, pemis_name, pemis_unit, pemis_coeff, & parea_dow, parea_hour, ppoint_dow, ppoint_hour, & - pshape, paspectratio, pla, pia, psa, porient + pshape, paspectratio, pla, pia, psa, porient !pndia, + + ! allocate reaction variables + allocate(preactions(maxreagent)) + allocate(pcconst(maxreagent)) + allocate(pdconst(maxreagent)) + allocate(pnconst(maxreagent)) + if (.not.allocated(reaccconst)) then + allocate(reaccconst(maxreagent,nspec)) + allocate(reacdconst(maxreagent,nspec)) + allocate(reacnconst(maxreagent,nspec)) + reaccconst(:,:)=-9.99e-9 + reacdconst(:,:)=-9.99 + reacnconst(:,:)=-9.99 + allocate(emis_path(nspec)) + allocate(emis_file(nspec)) + allocate(emis_name(nspec)) + allocate(emis_unit(nspec)) + allocate(emis_coeff(nspec)) + endif pspecies="" ! read failure indicator value pdecay=-999.9 @@ -2693,16 +2750,21 @@ subroutine readspecies(id_spec,pos_spec) pccn_aero=-9.9E-09 pin_aero=-9.9E-09 preldiff=-9.9 - phenry=0.0 + phenry=-9.9 pf0=0.0 pdensity=-9.9E09 - pdquer=0.0 + pdquer=-9.9 + pdia=-9.9 pdsigma=0.0 - pndia=1 + !pndia=1 pdryvel=-9.99 + preactions(:)="" + pcconst(:)=-9.99e-9 + pdconst(:)=-9.99 + pnconst(:)=-9.99 pohcconst=-9.99 - pohdconst=-9.9E-09 - pohnconst=2.0 + pohdconst=-9.99 + pohnconst=-9.99 pweightmolar=-999.9 parea_dow=-999.9 parea_hour=-999.9 @@ -2714,7 +2776,11 @@ subroutine readspecies(id_spec,pos_spec) pia=-1. ! Intermediate axis psa=-1. ! Smallest axis porient=0 ! 0 for horizontal, 1 for random - + pemis_path="" ! read failure indicator value + pemis_file="" ! read failure indicator value + pemis_name="" ! read failure indicator value + pemis_unit=0 + pemis_coeff=1. do j=1,24 ! initialize everything to no variation parea_hour(j)=1. @@ -2739,9 +2805,8 @@ subroutine readspecies(id_spec,pos_spec) ASSSPEC=.FALSE. - ! try namelist input read(unitspecies,species_params,iostat=ios) - !CGZ add check on which line of species file problem occurs + ! check on which line of species file problem occurs if (ios.ne.0) then backspace(unitspecies) read(unitspecies,fmt='(A)') line @@ -2751,233 +2816,189 @@ subroutine readspecies(id_spec,pos_spec) close(unitspecies) if ((len(trim(pspecies)).eq.0).or.(ios.ne.0)) then ! no namelist found - if (lroot) write(*,*) "SPECIES file not in NAMELIST format, attempting to & - &read as fixed format" - - ios=1 - - open(unitspecies,file=path(1)(1:length(1))//'SPECIES/SPECIES_'//aspecnumb, & - status='old',err=998) + if (lroot) then + write(*,*) "FLEXPART ERROR: SPECIES file not in NAMELIST format" + write(*,*) "fixed format no longer supported" + endif + error stop + endif - do i=1,6 - read(unitspecies,*) - end do + if ((pohcconst.ne.-9.99).or.(pohdconst.ne.-9.99).or.(pohnconst.ne.-9.99)) then + write(*,*) "ERROR: POHCCONST,POHDCONST, and POHNCONST in SPECIES file are deprecated." + error stop + endif + species(pos_spec)=pspecies + decay(pos_spec)=pdecay + weta_gas(pos_spec)=pweta_gas + wetb_gas(pos_spec)=pwetb_gas + crain_aero(pos_spec)=pcrain_aero + csnow_aero(pos_spec)=pcsnow_aero + ccn_aero(pos_spec)=pccn_aero + in_aero(pos_spec)=pin_aero + reldiff(pos_spec)=preldiff + henry(pos_spec)=phenry + f0(pos_spec)=pf0 + density(pos_spec)=pdensity + if (pdia.ne.-9.9) then + dquer(pos_spec)=pdia + else if (pdquer.ne.-9.9) then + write(*,*) 'WARNING: PDQUER will be depricated, please use PDIA instead.' + dquer(pos_spec)=pdquer ! For backwards compatibility + else + dquer(pos_spec)=0.0 + endif + dsigma(pos_spec)=pdsigma + ! ndia(pos_spec)=pndia + dryvel(pos_spec)=pdryvel + weightmolar(pos_spec)=pweightmolar + emis_path(pos_spec)=pemis_path + emis_file(pos_spec)=pemis_file + emis_name(pos_spec)=pemis_name + emis_unit(pos_spec)=pemis_unit + emis_coeff(pos_spec)=pemis_coeff + ishape(pos_spec)=pshape + orient(pos_spec)=porient + + ! Daria Tatsii 2023: compute particle shape dimensions + if (ishape(pos_spec).ge.1) then ! Compute shape according to given axes + select case (ishape(pos_spec)) + case (1) + write(*,*) "Particle shape USER-DEFINED for particle", id_spec + if ((psa.le.0.0).or.(pia.le.0.0).or.(pla.le.0.0)) then + write(*,*) "#### ERROR: Shape=1 (user-defined) is chosen, & + &but no valid axes are provided." + write(*,*) "#### SPECIES file requires SA, IA, and LA parameter & + &greater than zero." + error stop + endif + write(*,*) "SA,IA,LA:",psa,pia,pla + case (2) ! Cylinders (fibers) ! + if (paspectratio.le.0.0) then + write(*,*) "#### ERROR: Shape=2 cylinder is chosen, but no valid apect ratio is provided." + write(*,*) "#### SPECIES file requires ASPECTRATIO parameter greater than zero." + error stop + endif + psa=(((dquer(pos_spec)**3.0)*2.0)/ & + (3.0*paspectratio))**(1.0/3.0) + pia=psa + pla=psa*paspectratio + write(*,*) "Particle shape CYLINDER for particle", id_spec + write(*,*) "SA,IA,LA:",psa,pia,pla + case (3) ! Cubes ! + write(*,*) "Particle shape CUBE for particle", id_spec + psa=((dquer(pos_spec)**3)*pi/6.0)**(1.0/3.0) + pia=(2.0**0.5)*psa + pla=(3.0**0.5)*psa + if ((psa.le.0.0).or.(pia.le.0.0).or.(pla.le.0.0)) then + write(*,*) "#### ERROR: Shape=3 (user-defined) is chosen, but no valid axes are provided." + write(*,*) "#### SPECIES file requires SA, IA, and LA parameter greater than zero." + error stop + endif + write(*,*) "SA,IA,LA:",psa,pia,pla + case (4) ! Tetrahedrons ! + write(*,*) "Particle shape TETRAHEDRON for particle", id_spec + pla=((dquer(pos_spec)**3)*pi*2**(0.5))**(1.0/3.0) + pia=pla*((3.0/4.0)**(0.5)) + psa=pla*((2.0/3.0)**(0.5)) + if ((psa.le.0.0).or.(pia.le.0.0).or.(pla.le.0.0)) then + write(*,*) "#### ERROR: Shape=4 (user-defined) is chosen, but no valid axes are provided." + write(*,*) "#### SPECIES file requires SA, IA, and LA parameter greater than zero." + error stop + endif + write(*,*) "SA,IA,LA:",psa,pia,pla + case (5) ! Octahedrons ! + write(*,*) "Particle shape OCTAHEDRON for particle", id_spec + psa=dquer(pos_spec)*(pi/(2.0*2.0**(0.5)))**3 + pia=psa + pla=psa*(2.0**(0.5)) + if ((psa.le.0.0).or.(pia.le.0.0).or.(pla.le.0.0)) then + write(*,*) "#### ERROR: Shape=5 (user-defined) is chosen, but no valid axes are provided." + write(*,*) "#### SPECIES file requires SA, IA, and LA parameter greater than zero." + error stop + endif + write(*,*) "SA,IA,LA:",psa,pia,pla + case (6) ! Ellipsoids ! + write(*,*) "Particle shape ELLIPSOID for particle", id_spec + psa=dquer(pos_spec)/(2.0**(1.0/3.0)) + pia=psa + pla=2*pia + if ((psa.le.0.0).or.(pia.le.0.0).or.(pla.le.0.0)) then + write(*,*) "#### ERROR: Shape=6 (user-defined) is chosen, but no valid axes are provided." + write(*,*) "#### SPECIES file requires SA, IA, and LA parameter greater than zero." + error stop + endif + write(*,*) "SA,IA,LA:",psa,pia,pla + end select + + ! When using the shape option, dquer is the sphere equivalent diameter + + f=psa/pia + e=pia/pla + ! Drag coefficient scheme by Bagheri & Bonadonna, 2016 to define settling velocities of other shapes (by D.Tatsii) + if ((ishape(pos_spec).eq.2).or.((ishape(pos_spec).eq.1).and. & + (pia.eq.psa).and.(pla.ge.20.0*pia))) then + + Fn(pos_spec)=f*f*e ! simplified equation, validated by experiments with fibers + Fs(pos_spec)=f*e**(1.3) ! simplified equation, validated by experiments with fibers + else + Fn(pos_spec)=f*f*e*((dquer(pos_spec))**3)/(psa*pia*pla) ! Newton's regime + Fs(pos_spec)=f*e**(1.3)*(dquer(pos_spec)**3/(psa*pia*pla)) ! Stokes' regime + endif - read(unitspecies,'(a10)',end=22) species(pos_spec) - ! write(*,*) species(pos_spec) - read(unitspecies,'(f18.1)',end=22) decay(pos_spec) - ! write(*,*) decay(pos_spec) - read(unitspecies,'(e18.1)',end=22) weta_gas(pos_spec) - ! write(*,*) weta_gas(pos_spec) - read(unitspecies,'(f18.2)',end=22) wetb_gas(pos_spec) - ! write(*,*) wetb_gas(pos_spec) - read(unitspecies,'(e18.1)',end=22) crain_aero(pos_spec) - ! write(*,*) crain_aero(pos_spec) - read(unitspecies,'(f18.2)',end=22) csnow_aero(pos_spec) - ! write(*,*) csnow_aero(pos_spec) - !*** NIK 31.01.2013: including in-cloud scavening parameters - read(unitspecies,'(e18.1)',end=22) ccn_aero(pos_spec) - ! write(*,*) ccn_aero(pos_spec) - read(unitspecies,'(f18.2)',end=22) in_aero(pos_spec) - ! write(*,*) in_aero(pos_spec) - read(unitspecies,'(f18.1)',end=22) reldiff(pos_spec) - ! write(*,*) reldiff(pos_spec) - read(unitspecies,'(e18.1)',end=22) henry(pos_spec) - ! write(*,*) henry(pos_spec) - read(unitspecies,'(f18.1)',end=22) f0(pos_spec) - ! write(*,*) f0(pos_spec) - read(unitspecies,'(e18.1)',end=22) density(pos_spec) - ! write(*,*) density(pos_spec) - read(unitspecies,'(e18.1)',end=22) dquer(pos_spec) - ! write(*,*) 'dquer(pos_spec):', dquer(pos_spec) - read(unitspecies,'(e18.1)',end=22) dsigma(pos_spec) - ! write(*,*) dsigma(pos_spec) - read(unitspecies,'(i16)',end=22) ndia(pos_spec) - ! write(*,*) ndia(pos_spec) - read(unitspecies,'(f18.2)',end=22) dryvel(pos_spec) - ! write(*,*) dryvel(pos_spec) - read(unitspecies,'(f18.2)',end=22) weightmolar(pos_spec) - ! write(*,*) weightmolar(pos_spec) - read(unitspecies,'(e18.2)',end=22) ohcconst(pos_spec) - ! write(*,*) ohcconst(pos_spec) - read(unitspecies,'(f8.2)',end=22) ohdconst(pos_spec) - ! write(*,*) ohdconst(pos_spec) - read(unitspecies,'(f8.2)',end=22) ohnconst(pos_spec) - ! write(*,*) ohnconst(pos_spec) - - ! Read in daily and day-of-week variation of emissions, if available - !******************************************************************* + ! Pre-compute ks and kn values needed for horizontal and average orientation (B&B Figure 12 k_(s,max)) + ks1(pos_spec)=(Fs(pos_spec)**(1./3.) + Fs(pos_spec)**(-1./3.))/2. + ks2(pos_spec)=0.5*((Fs(pos_spec)**0.05)+(Fs(pos_spec)**(-0.36))) + kn2(pos_spec)=10.**(alpha2*(-log10(Fn(pos_spec)))**beta2) - read(unitspecies,*,end=22) - do j=1,24 ! 24 hours, starting with 0-1 local time - read(unitspecies,*) ihour,area_hour(pos_spec,j),point_hour(pos_spec,j) - end do - read(unitspecies,*) - do j=1,7 ! 7 days of the week, starting with Monday - read(unitspecies,*) idow,area_dow(pos_spec,j),point_dow(pos_spec,j) - end do + else ! Spheres + write(*,*) "Particle shape SPHERE for particle", id_spec + endif - pspecies=species(pos_spec) - pdecay=decay(pos_spec) - pweta_gas=weta_gas(pos_spec) - pwetb_gas=wetb_gas(pos_spec) - pcrain_aero=crain_aero(pos_spec) - pcsnow_aero=csnow_aero(pos_spec) - pccn_aero=ccn_aero(pos_spec) - pin_aero=in_aero(pos_spec) - preldiff=reldiff(pos_spec) - phenry=henry(pos_spec) - pf0=f0(pos_spec) - pdensity=density(pos_spec) - pdquer=dquer(pos_spec) - pdsigma=dsigma(pos_spec) - pndia=ndia(pos_spec) - pdryvel=dryvel(pos_spec) - pweightmolar=weightmolar(pos_spec) - pohcconst=ohcconst(pos_spec) - pohdconst=ohdconst(pos_spec) - pohnconst=ohnconst(pos_spec) - - - do j=1,24 ! 24 hours, starting with 0-1 local time - parea_hour(j)=area_hour(pos_spec,j) - ppoint_hour(j)=point_hour(pos_spec,j) - end do - do j=1,7 ! 7 days of the week, starting with Monday - parea_dow(j)=area_dow(pos_spec,j) - ppoint_dow(j)=point_dow(pos_spec,j) - end do + ! assign chemical reaction rate constants to table + !************************************************* - else ! namelist available - - species(pos_spec)=pspecies - decay(pos_spec)=pdecay - weta_gas(pos_spec)=pweta_gas - wetb_gas(pos_spec)=pwetb_gas - crain_aero(pos_spec)=pcrain_aero - csnow_aero(pos_spec)=pcsnow_aero - ccn_aero(pos_spec)=pccn_aero - in_aero(pos_spec)=pin_aero - reldiff(pos_spec)=preldiff - henry(pos_spec)=phenry - f0(pos_spec)=pf0 - density(pos_spec)=pdensity - dquer(pos_spec)=pdquer - dsigma(pos_spec)=pdsigma - ndia(pos_spec)=pndia - dryvel(pos_spec)=pdryvel - weightmolar(pos_spec)=pweightmolar - ohcconst(pos_spec)=pohcconst - ohdconst(pos_spec)=pohdconst - ohnconst(pos_spec)=pohnconst - ishape(pos_spec)=pshape - orient(pos_spec)=porient - - - ! Daria Tatsii 2023: compute particle shape dimensions - if (ishape(pos_spec).ge.1) then ! Compute shape according to given axes - select case (ishape(pos_spec)) - case (1) - write(*,*) "Particle shape USER-DEFINED for particle", id_spec - if ((psa.le.0.0).or.(pia.le.0.0).or.(pla.le.0.0)) then - write(*,*) "#### ERROR: Shape=1 (user-defined) is chosen, & - &but no valid axes are provided." - write(*,*) "#### SPECIES file requires SA, IA, and LA parameter & - &greater than zero." - error stop - endif - write(*,*) "SA,IA,LA:",psa,pia,pla - case (2) ! Cylinders (fibers) ! - if (paspectratio.le.0.0) then - write(*,*) "#### ERROR: Shape=2 cylinder is chosen, but no valid apect ratio is provided." - write(*,*) "#### SPECIES file requires ASPECTRATIO parameter greater than zero." - error stop - endif - psa=(((dquer(pos_spec)**3.0)*2.0)/ & - (3.0*paspectratio))**(1.0/3.0) - pia=psa - pla=psa*paspectratio - write(*,*) "Particle shape CYLINDER for particle", id_spec - write(*,*) "SA,IA,LA:",psa,pia,pla - case (3) ! Cubes ! - write(*,*) "Particle shape CUBE for particle", id_spec - psa=((dquer(pos_spec)**3)*pi/6.0)**(1.0/3.0) - pia=(2.0**0.5)*psa - pla=(3.0**0.5)*psa - if ((psa.le.0.0).or.(pia.le.0.0).or.(pla.le.0.0)) then - write(*,*) "#### ERROR: Shape=3 (user-defined) is chosen, but no valid axes are provided." - write(*,*) "#### SPECIES file requires SA, IA, and LA parameter greater than zero." - error stop - endif - write(*,*) "SA,IA,LA:",psa,pia,pla - case (4) ! Tetrahedrons ! - write(*,*) "Particle shape TETRAHEDRON for particle", id_spec - pla=((dquer(pos_spec)**3)*pi*2**(0.5))**(1.0/3.0) - pia=pla*((3.0/4.0)**(0.5)) - psa=pla*((2.0/3.0)**(0.5)) - if ((psa.le.0.0).or.(pia.le.0.0).or.(pla.le.0.0)) then - write(*,*) "#### ERROR: Shape=4 (user-defined) is chosen, but no valid axes are provided." - write(*,*) "#### SPECIES file requires SA, IA, and LA parameter greater than zero." - error stop - endif - write(*,*) "SA,IA,LA:",psa,pia,pla - case (5) ! Octahedrons ! - write(*,*) "Particle shape OCTAHEDRON for particle", id_spec - psa=dquer(pos_spec)*(pi/(2.0*2.0**(0.5)))**3 - pia=psa - pla=psa*(2.0**(0.5)) - if ((psa.le.0.0).or.(pia.le.0.0).or.(pla.le.0.0)) then - write(*,*) "#### ERROR: Shape=5 (user-defined) is chosen, but no valid axes are provided." - write(*,*) "#### SPECIES file requires SA, IA, and LA parameter greater than zero." - error stop - endif - write(*,*) "SA,IA,LA:",psa,pia,pla - case (6) ! Ellipsoids ! - write(*,*) "Particle shape ELLIPSOID for particle", id_spec - psa=dquer(pos_spec)/(2.0**(1.0/3.0)) - pia=psa - pla=2*pia - if ((psa.le.0.0).or.(pia.le.0.0).or.(pla.le.0.0)) then - write(*,*) "#### ERROR: Shape=6 (user-defined) is chosen, but no valid axes are provided." - write(*,*) "#### SPECIES file requires SA, IA, and LA parameter greater than zero." - error stop - endif - write(*,*) "SA,IA,LA:",psa,pia,pla - end select - - ! When using the shape option, dquer is the sphere equivalent diameter - - f=psa/pia - e=pia/pla - ! Drag coefficient scheme by Bagheri & Bonadonna, 2016 to define settling velocities of other shapes (by D.Tatsii) - if ((ishape(pos_spec).eq.2).or.((ishape(pos_spec).eq.1).and. & - (pia.eq.psa).and.(pla.ge.20.0*pia))) then - - Fn(pos_spec)=f*f*e ! simplified equation, validated by experiments with fibers - Fs(pos_spec)=f*e**(1.3) ! simplified equation, validated by experiments with fibers - else - Fn(pos_spec)=f*f*e*((dquer(pos_spec))**3)/(psa*pia*pla) ! Newton's regime - Fs(pos_spec)=f*e**(1.3)*(dquer(pos_spec)**3/(psa*pia*pla)) ! Stokes' regime + print*, 'readspecies: preactions = ',preactions + + if (any(preactions.ne."")) then + do j=1,maxreagent + if ( preactions(j).eq."" ) cycle + do i=1,maxreagent + if (preactions(j).eq.reagents(i)) then + reaccconst(i,pos_spec)=pcconst(j) + reacdconst(i,pos_spec)=pdconst(j) + reacnconst(i,pos_spec)=pnconst(j) + exit + endif + end do + if (i.gt.nreagent) then + write(*,*) '#### FLEXPART MODEL ERROR ####' + write(*,*) '#### REAGENT NOT FOUND FOR ####' + write(*,*) '#### REACTION '//trim(preactions(j))//' ####' + error stop endif - ! Pre-compute ks and kn values needed for horizontal and average orientation (B&B Figure 12 k_(s,max)) - ks1(pos_spec)=(Fs(pos_spec)**(1./3.) + Fs(pos_spec)**(-1./3.))/2. - ks2(pos_spec)=0.5*((Fs(pos_spec)**0.05)+(Fs(pos_spec)**(-0.36))) - kn2(pos_spec)=10.**(alpha2*(-log10(Fn(pos_spec)))**beta2) - - else ! Spheres - write(*,*) "Particle shape SPHERE for particle", id_spec - endif - - do j=1,24 ! 24 hours, starting with 0-1 local time - area_hour(pos_spec,j)=parea_hour(j) - point_hour(pos_spec,j)=ppoint_hour(j) end do - do j=1,7 ! 7 days of the week, starting with Monday - area_dow(pos_spec,j)=parea_dow(j) - point_dow(pos_spec,j)=ppoint_dow(j) + endif + + ! Check reaction rates + if (lroot) then + write(*,*) 'Reaction rates for ',species(pos_spec),':' + do j=1,nreagent + if (reaccconst(j,pos_spec).lt.0.) reaccconst(j,pos_spec)=0. + if (reacdconst(j,pos_spec).lt.0.) reacdconst(j,pos_spec)=0. + if (reacnconst(j,pos_spec).lt.0.) reacnconst(j,pos_spec)=0. + write(*,*) reagents(j),': C, D, N = ',reaccconst(j,pos_spec),reacdconst(j,pos_spec),reacnconst(j,pos_spec) end do endif + do j=1,24 ! 24 hours, starting with 0-1 local time + area_hour(pos_spec,j)=parea_hour(j) + point_hour(pos_spec,j)=ppoint_hour(j) + end do + do j=1,7 ! 7 days of the week, starting with Monday + area_dow(pos_spec,j)=parea_dow(j) + point_dow(pos_spec,j)=ppoint_dow(j) + end do + i=pos_spec !NIK 16.02.2015 @@ -3070,11 +3091,10 @@ subroutine readspecies(id_spec,pos_spec) end if end if - if (ndia(pos_spec).gt.maxndia) then - maxndia=ndia(pos_spec) - ! write(*,*) 'NDIA in SPECIES file', pos_spec, 'set to', ndia(pos_spec), 'larger than maxndia', & - ! maxndia, 'set in par_mod.f90' - endif + !if (ndia(pos_spec).gt.maxndia) then + ! maxndia=ndia(pos_spec) + !endif + ndia(pos_spec)=maxndia ! Setting all ndia to maxndia (par_mod.f90) ! if (dsigma(i).eq.0.) dsigma(i)=1.0001 ! avoid floating exception if (dquer(i).gt.0 .and. dsigma(i).le.1.) then !dsigma(i)=1.0001 ! avoid floating exception !write(*,*) '#### FLEXPART MODEL ERROR! ####' @@ -3251,156 +3271,191 @@ subroutine readpartoptions ! Save values in particle options derived type !********************************************* partopt(1)%long_name='longitude' + partopt(1)%short_name='lon' partopt(1)%name='LO' partopt(1)%print=longitude partopt(2)%long_name='longitude_average' + partopt(2)%short_name='lon_av' partopt(2)%name='lo' partopt(2)%print=longitude_average partopt(2)%average=.true. partopt(3)%long_name='latitude' + partopt(3)%short_name='lat' partopt(3)%name='LA' partopt(3)%print=latitude partopt(4)%long_name='latitude_average' + partopt(4)%short_name='lat_av' partopt(4)%name='la' partopt(4)%print=latitude_average partopt(4)%average=.true. partopt(5)%long_name='height' + partopt(5)%short_name='z' partopt(5)%name='ZZ' partopt(5)%print=height partopt(6)%long_name='height_average' + partopt(6)%short_name='z_av' partopt(6)%name='zz' partopt(6)%print=height_average partopt(6)%average=.true. - partopt(7)%long_name='pv' + partopt(7)%long_name='potential_vorticity' + partopt(7)%short_name='pv' partopt(7)%name='PV' partopt(7)%print=pv - partopt(8)%long_name='pv_average' + partopt(8)%long_name='potential_vorticity_average' + partopt(8)%short_name='pv_av' partopt(8)%name='pv' partopt(8)%print=pv_average partopt(8)%average=.true. - partopt(9)%long_name='qv' + partopt(9)%long_name='specific_humidity' + partopt(9)%short_name='qv' partopt(9)%name='QV' partopt(9)%print=qv - partopt(10)%long_name='qv_average' + partopt(10)%long_name='specific_humidity_average' + partopt(10)%short_name='qv_av' partopt(10)%name='qv' partopt(10)%print=qv_average partopt(10)%average=.true. partopt(11)%long_name='density' + partopt(11)%short_name='rho' partopt(11)%name='RH' partopt(11)%print=density partopt(12)%long_name='density_average' + partopt(12)%short_name='rho_av' partopt(12)%name='rh' partopt(12)%print=density_average partopt(12)%average=.true. partopt(13)%long_name='temperature' + partopt(13)%short_name='T' partopt(13)%name='TT' partopt(13)%print=temperature partopt(14)%long_name='temperature_average' + partopt(14)%short_name='T_av' partopt(14)%name='tt' partopt(14)%print=temperature_average partopt(14)%average=.true. partopt(15)%long_name='pressure' + partopt(15)%short_name='prs' partopt(15)%name='PR' partopt(15)%print=pressure partopt(16)%long_name='pressure_average' + partopt(16)%short_name='prs_av' partopt(16)%name='pr' partopt(16)%print=pressure_average partopt(16)%average=.true. partopt(17)%long_name='mixingheight' + partopt(17)%short_name='hmix' partopt(17)%name='HM' partopt(17)%print=mixingheight partopt(18)%long_name='mixingheight_average' + partopt(18)%short_name='hmix_av' partopt(18)%name='hm' partopt(18)%print=mixingheight_average partopt(18)%average=.true. partopt(19)%long_name='tropopause' + partopt(19)%short_name='tro' partopt(19)%name='TR' partopt(19)%print=tropopause partopt(20)%long_name='tropopause_average' + partopt(20)%short_name='tro_av' partopt(20)%name='tr' partopt(20)%print=tropopause_average partopt(20)%average=.true. partopt(21)%long_name='topography' + partopt(21)%short_name='to' partopt(21)%name='TO' partopt(21)%print=topography partopt(22)%long_name='topography_average' + partopt(22)%short_name='to_av' partopt(22)%name='to' partopt(22)%print=topography_average partopt(22)%average=.true. partopt(23)%long_name='mass' + partopt(23)%short_name='m' partopt(23)%name='MA' partopt(23)%print=mass partopt(24)%long_name='mass_average' + partopt(24)%short_name='m_av' partopt(24)%name='ma' partopt(24)%print=mass_average partopt(24)%average=.true. - partopt(25)%long_name='u' + partopt(25)%long_name='longitudinal_velocity' + partopt(25)%short_name='u' partopt(25)%name='UU' partopt(25)%print=u - partopt(26)%long_name='u_average' + partopt(26)%long_name='longitudinal_velocity_average' + partopt(26)%short_name='u_av' partopt(26)%name='uu' partopt(26)%print=u_average partopt(26)%average=.true. - partopt(27)%long_name='v' + partopt(27)%long_name='latitudinal_velocity' + partopt(27)%short_name='v' partopt(27)%name='VV' partopt(27)%print=v - partopt(28)%long_name='v_average' + partopt(28)%long_name='latitudinal_velocity_average' + partopt(28)%short_name='v_av' partopt(28)%name='vv' partopt(28)%print=v_average partopt(28)%average=.true. - partopt(29)%long_name='w' + partopt(29)%long_name='vertical_velocity' + partopt(29)%short_name='w' partopt(29)%name='WW' partopt(29)%print=w - partopt(30)%long_name='w_average' + partopt(30)%long_name='vertical_velocity_average' + partopt(30)%short_name='w_av' partopt(30)%name='ww' partopt(30)%print=w_average partopt(30)%average=.true. - partopt(31)%long_name='vsettling' + partopt(31)%long_name='settling_velocity' + partopt(31)%short_name='vset' partopt(31)%name='VS' partopt(31)%print=vsettling - partopt(32)%long_name='vsettling_average' + partopt(32)%long_name='settling_velocity_average' + partopt(32)%short_name='vset_av' partopt(32)%name='vs' partopt(32)%print=vsettling_average partopt(32)%average=.true. partopt(33)%long_name='wetdeposition' + partopt(33)%short_name='wetdepo' partopt(33)%name='WD' partopt(33)%print=wetdeposition partopt(34)%long_name='drydeposition' + partopt(34)%short_name='drydepo' partopt(34)%name='DD' partopt(34)%print=drydeposition + ! Numbers are assigned to the averaged fields for proper ! allocation and reading in particle_mod and output_mod !****************************************************** diff --git a/src/receptor_mod.f90 b/src/receptor_mod.f90 new file mode 100644 index 0000000000000000000000000000000000000000..44fa3a4ec47dd92935c38929af4805580ace82fa --- /dev/null +++ b/src/receptor_mod.f90 @@ -0,0 +1,1016 @@ +! SPDX-FileCopyrightText: FLEXPART 1998-2019, see flexpart_license.txt +! SPDX-License-Identifier: GPL-3.0-or-later + +module receptor_mod + + !***************************************************************************** + ! * + ! This module contains variables and subroutines for calculating * + ! receptor concentrations and writing these to file * + ! * + !***************************************************************************** + + use par_mod + use com_mod + use point_mod + use particle_mod + use date_mod + use windfields_mod, only: rho, prs, height, nzmax, nz !, qv +#if USE_NCF + use receptor_netcdf_mod, only: nc_id, concvar_id, uncvar_id, & + recnamevar_id, timevar_id, & + reclonvar_id, reclatvar_id, recaltvar_id, & + nnvar_id, xkvar_id, rpointer, & + ncsat_id, satvar_id, satuncvar_id, & + satnamevar_id, sattimevar_id, & + satlonvar_id, satlatvar_id, sataltvar_id, & + satnnvar_id, satxkvar_id, spointer, sat_name, & + receptor_output_netcdf, write_receptor_netcdf, & + satellite_output_netcdf, write_satellite_netcdf, & + close_receptor_netcdf, close_satellite_netcdf +#endif + use binary_output_mod, only: receptorout_init_binary, write_receptor_binary, & + satelliteout_init_binary, write_satellite_binary + + implicit none + + contains + + + subroutine alloc_receptor + + !***************************************************************************** + ! * + ! This routine allocates variables for receptor concentrations * + ! * + !***************************************************************************** + + implicit none + + if (numreceptor.gt.0) then + allocate( creceptor(nspec,maxrecsample) ) + allocate( crecuncert(nspec,maxrecsample) ) + allocate( nnreceptor(maxrecsample) ) + allocate( xkreceptor(maxrecsample) ) + creceptor(:,:)=0. + crecuncert(:,:)=0. + nnreceptor(:)=0. + xkreceptor(:)=0. + endif + + end subroutine alloc_receptor + + + subroutine receptoroutput(itime,lrecoutstart,lrecoutend,lrecoutnext,recoutnum,recoutnumsat) + + !***************************************************************************** + ! * + ! Output concentrations at receptors * + ! * + ! Author: R. Thompson, Sep-2023 * + ! * + ! * + !***************************************************************************** + + use omp_lib, only: OMP_GET_MAX_THREADS, OMP_GET_THREAD_NUM + + implicit none + + integer :: itime, lrecoutstart, lrecoutend, lrecoutnext + real, dimension(maxrecsample) :: recoutnum + real, dimension(nlayermax,maxrecsample) :: recoutnumsat + real :: weight + real(kind=dp) :: jul + character(len=256) :: fn, fnsat + character :: adate*8, atime*6 + integer :: jjjjmmdd, ihmmss + integer :: numsatlayer, nchar, ks_start + integer :: n, nn, nr, ix, jy, ixp, jyp, indz, indzp, il, ind, ks, k, kz + real :: ddx, ddy, rddx, rddy, p1, p2, p3, p4, dz1, dz2, dz + real :: rhoi, zmid + real, dimension(2) :: rho_p + real, dimension(:), allocatable :: densityoutrecept + real, dimension(:,:), allocatable :: nnrec, xkrec, altrec + real, dimension(:), allocatable :: lonrec, latrec + integer, dimension(:), allocatable :: timerec + real, dimension(:,:,:), allocatable :: crec, cunc + character(len=16), dimension(:), allocatable :: namerec + character(len=24), dimension(:), allocatable :: namesatrec + real, dimension(:,:,:), allocatable :: nnrec_omp, xkrec_omp, altrec_omp + real, dimension(:,:), allocatable :: lonrec_omp, latrec_omp + integer, dimension(:,:), allocatable :: timerec_omp + real, dimension(:,:,:,:), allocatable :: crec_omp, cunc_omp + character(len=16), dimension(:,:), allocatable :: namerec_omp + character(len=24), dimension(:,:), allocatable :: namesatrec_omp + integer, dimension(:), allocatable :: nr_omp + real, parameter :: weightair=28.97 + integer, parameter :: unitoutrecdates=109 + logical :: lexist + integer :: nthreads, thread, ithread + + + if (llcmoutput) then + ks_start=2 + else + ks_start=1 + endif + + if (mod(itime-lrecoutstart,lrecoutsample).eq.0) then + if ((itime.eq.lrecoutstart).or.(itime.eq.lrecoutend)) then + weight=0.5 + else + weight=1.0 + endif + call receptorcalc(itime,weight,lrecoutstart,lrecoutend,recoutnum,recoutnumsat) + endif + + !! testing + print*, 'receptor_mod: itime, lrecoutstart, lrecoutend = ',itime, lrecoutstart, lrecoutend + + if ((itime.eq.lrecoutend).and.(any(recoutnum.gt.0.).or.any(recoutnumsat.gt.0.))) then + + ! output receptor concentrations + !******************************* + + if ((iout.le.3.).or.(iout.eq.5)) then + + ! Determine current date for output in dates_receptor file + !********************************************************** + + jul=bdate+dble(float(itime))/86400. + call caldate(jul,jjjjmmdd,ihmmss) + write(adate,'(i8.8)') jjjjmmdd + write(atime,'(i6.6)') ihmmss + + inquire(file=path(2)(1:length(2))//'dates_receptors',exist=lexist) + if (.not.lexist) then + ! initialize dates output file + open(unitoutrecdates,file=path(2)(1:length(2))//'dates_receptors',STATUS='REPLACE') + close(unitoutrecdates) + endif + open(unitoutrecdates,file=path(2)(1:length(2))//'dates_receptors', & + ACCESS='APPEND', STATUS='OLD') + write(unitoutrecdates,'(a)') adate//atime + close(unitoutrecdates) + + ! For netcdf output open files and get variable info + !*************************************************** + + if (lnetcdfout.eq.1) then +#ifdef USE_NCF + if (numreceptor.gt.0) then + call receptor_output_netcdf() + endif + if (numsatreceptor.gt.0) then + call satellite_output_netcdf() + endif +#endif + endif + + !! testing +! print*, 'receptor_mod: concvar_id = ',concvar_id +! print*, 'receptor_mod: satvar_id = ',satvar_id + + + ! Initialize variables + !********************* + +#if (defined _OPENMP) + nthreads=OMP_GET_MAX_THREADS() +#else + nthreads=1 +#endif + + !! testing +! print*, 'receptor_mod: nthread = ',nthreads + + allocate(densityoutrecept(nlayermax)) + allocate(nnrec(maxrecsample,nlayermax),& + xkrec(maxrecsample,nlayermax),& + lonrec(maxrecsample),& + latrec(maxrecsample),& + altrec(maxrecsample,nlayermax),& + namerec(maxrecsample),& + namesatrec(maxrecsample),& + timerec(maxrecsample),& + crec(nspec,maxrecsample,nlayermax),& + cunc(nspec,maxrecsample,nlayermax)) + allocate(nnrec_omp(maxrecsample,nlayermax,nthreads),& + xkrec_omp(maxrecsample,nlayermax,nthreads),& + lonrec_omp(maxrecsample,nthreads),& + latrec_omp(maxrecsample,nthreads),& + altrec_omp(maxrecsample,nlayermax,nthreads),& + namerec_omp(maxrecsample,nthreads),& + namesatrec_omp(maxrecsample,nthreads),& + timerec_omp(maxrecsample,nthreads),& + crec_omp(nspec,maxrecsample,nlayermax,nthreads),& + cunc_omp(nspec,maxrecsample,nlayermax,nthreads)) + allocate(nr_omp(nthreads)) + nnrec(:,:)=0. + xkrec(:,:)=0. + crec(:,:,:)=0. + cunc(:,:,:)=0. + nnrec_omp(:,:,:)=0. + xkrec_omp(:,:,:)=0. + crec_omp(:,:,:,:)=0. + cunc_omp(:,:,:,:)=0. + nr_omp(:)=0 + + ! Loop over general receptors + !**************************** + + write(*,fmt='(A,1X,I8,1X,A,1X,I3)') 'Number of receptors output at itime ',itime,'is',numcurrec + +!$OMP PARALLEL & +!$OMP PRIVATE(n,k,nn,nr,ix,jy,ixp,jyp,ddx,ddy,rddx,rddy,p1,p2,p3,p4,indz,indzp,il,dz1,dz2,dz, & +!$OMP ind,rho_p,rhoi,densityoutrecept,ks,thread) + +#if (defined _OPENMP) + thread=OMP_GET_THREAD_NUM()+1 ! Starts with 1 +#else + thread=1 +#endif + + nr=0 +!$OMP DO + do k=1,numcurrec + + if (cpointer(k).eq.0.) cycle + + ! number of the receptor + n=cpointer(k) + + ! counter of receptor values this time interval + nr=nr+1 + nr_omp(thread)=nr + + !! testing +! print*, 'receptor_mod: n, thread, nr, cpointer(k), rpointer = ',n, thread, nr, cpointer(k), rpointer + + if (((.not.llcmoutput).and.(iout.eq.2)).or.& + (llcmoutput.and.((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)))) then + + ! Compute air density + !********************* + + ix=int(xreceptor(n)) + jy=int(yreceptor(n)) + ixp=ix+1 + jyp=jy+1 + ddx=xreceptor(n)-float(ix) + ddy=yreceptor(n)-float(jy) + rddx=1.-ddx + rddy=1.-ddy + p1=rddx*rddy + p2=ddx*rddy + p3=rddx*ddy + p4=ddx*ddy + + indz=nzmax-1 + indzp=nzmax + do il=2,nzmax + if (height(il).gt.zreceptor(n)) then + indz=il-1 + indzp=il + exit + endif + end do + + dz1=zreceptor(n)-height(indz) + dz2=height(indzp)-zreceptor(n) + dz=1./(dz1+dz2) + + ! Take density from 2nd wind field in memory + !******************************************** + + do ind=indz,indzp + ! assume moist air density + rho_p(ind-indz+1)=p1*rho(ix ,jy ,ind,2) + & + p2*rho(ixp,jy ,ind,2) + & + p3*rho(ix ,jyp,ind,2) + & + p4*rho(ixp,jyp,ind,2) + ! dry air density +! rho_p(ind-indz+1)= & +! p1*rho(ix ,jy ,ind,2)*(1. - qv(ix ,jy ,ind,2)) + & +! p2*rho(ixp,jy ,ind,2)*(1. - qv(ixp,jy ,ind,2)) + & +! p3*rho(ix ,jyp,ind,2)*(1. - qv(ix ,jyp,ind,2)) + & +! p4*rho(ixp,jyp,ind,2)*(1. - qv(ixp,jyp,ind,2)) + end do + rhoi=(dz1*rho_p(2)+dz2*rho_p(1))*dz + + if (.not.llcmoutput) then + densityoutrecept(1)=1./rhoi + else + densityoutrecept(1)=rhoi + endif + + else + + ! no multiplication or division by air density + densityoutrecept(1)=1. + + endif ! llcmoutput + + ! Write receptor output + !********************** + ! llcmoutput = true: creceptor = m_spec/m_air + ! llcmoutput = false: creceptor = m_spec/V + + if (recoutnum(k).gt.0.) then + do ks = ks_start,nspec + ! write mass concentration + if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then + ! concentration (ng/m3) + crec_omp(ks,nr,1,thread)=creceptor(ks,k)*1.E12*densityoutrecept(1)/recoutnum(k) + cunc_omp(ks,nr,1,thread)=crecuncert(ks,k)*1.E12*densityoutrecept(1)/recoutnum(k) + else if (iout.eq.2) then + ! mixing ratio (ppt) + ! note: for iout=3 (both conc and mixing ratio) only output conc at receptors + crec_omp(ks,nr,1,thread)=creceptor(ks,k)*1.E12*densityoutrecept(1)* & + weightair/weightmolar(ks)/recoutnum(k) + cunc_omp(ks,nr,1,thread)=crecuncert(ks,k)*1.E12*densityoutrecept(1)* & + weightair/weightmolar(ks)/recoutnum(k) + endif + end do + nnrec_omp(nr,1,thread)=nnreceptor(k)/recoutnum(k) + xkrec_omp(nr,1,thread)=xkreceptor(k)/recoutnum(k) + else + ! no particles found in kernel for this receptor + crec_omp(:,nr,1,thread)=-999. + cunc_omp(:,nr,1,thread)=-999. + nnrec_omp(nr,1,thread)=-999. + xkrec_omp(nr,1,thread)=-999. + endif + lonrec_omp(nr,thread)=xreceptor(n)*dx+xlon0 + latrec_omp(nr,thread)=yreceptor(n)*dy+ylat0 + altrec_omp(nr,1,thread)=zreceptor(n) + if ( lrecregular ) then + timerec_omp(nr,thread)=itime + else + timerec_omp(nr,thread)=treceptor(n) + endif + namerec_omp(nr,thread)=receptorname(n) + + end do ! numcurrec +!$OMP END DO +!$OMP END PARALLEL + + ! concatentate from all threads + nr=1 + do ithread=1,nthreads + !! testing +! print*, 'receptor_mod: nr_omp(ithread) = ',nr_omp(ithread) + if (nr_omp(ithread).eq.0) cycle + crec(:,nr:(nr+nr_omp(ithread)-1),1)=crec_omp(:,1:nr_omp(ithread),1,ithread) + cunc(:,nr:(nr+nr_omp(ithread)-1),1)=cunc_omp(:,1:nr_omp(ithread),1,ithread) + nnrec(nr:(nr+nr_omp(ithread)-1),1)=nnrec_omp(1:nr_omp(ithread),1,ithread) + xkrec(nr:(nr+nr_omp(ithread)-1),1)=xkrec_omp(1:nr_omp(ithread),1,ithread) + lonrec(nr:(nr+nr_omp(ithread)-1))=lonrec_omp(1:nr_omp(ithread),ithread) + latrec(nr:(nr+nr_omp(ithread)-1))=latrec_omp(1:nr_omp(ithread),ithread) + altrec(nr:(nr+nr_omp(ithread)-1),1)=altrec_omp(1:nr_omp(ithread),1,ithread) + timerec(nr:(nr+nr_omp(ithread)-1))=timerec_omp(1:nr_omp(ithread),ithread) + namerec(nr:(nr+nr_omp(ithread)-1))=namerec_omp(1:nr_omp(ithread),ithread) + nr=nr+nr_omp(ithread) + !! testing +! print*, 'receptor_mod: nr = ',nr + end do + + ! total number of receptors to write this interval + nr=nr-1 + + ! write receptor output this time interval + if (nr.gt.0) then + if (lnetcdfout.eq.1) then +#if USE_NCF + call write_receptor_netcdf(crec,cunc,nnrec,xkrec,lonrec,latrec,altrec,timerec,namerec,nr) +#endif + else + call write_receptor_binary(crec,cunc,nnrec,xkrec,lonrec,latrec,altrec,timerec,namerec,nr) + endif + endif + ! advance output index + rpointer=rpointer+nr + + !! testing +! print*, 'receptor_mod: nr_omp = ',nr_omp +! print*, 'receptor_mod: rpointer = ',rpointer + + ! Loop over satellites + !********************* + + nnrec(:,:)=0. + xkrec(:,:)=0. + crec(:,:,:)=0. + cunc(:,:,:)=0. + nnrec_omp(:,:,:)=0. + xkrec_omp(:,:,:)=0. + crec_omp(:,:,:,:)=0. + cunc_omp(:,:,:,:)=0. + nr_omp(:)=0 + + write(*,fmt='(A,1X,I8,1X,A,1X,I3)') 'Number of satellite receptors output at itime ',itime,'is',numcursat + +!$OMP PARALLEL & +!$OMP PRIVATE(n,nr,nn,nchar,k,ix,jy,ixp,jyp,ddx,ddy,rddx,rddy,p1,p2,p3,p4,kz,numsatlayer,zmid,indz,indzp, & +!$OMP il,dz1,dz2,dz,ind,rho_p,rhoi,densityoutrecept,ks,thread) + +#if (defined _OPENMP) + thread=OMP_GET_THREAD_NUM()+1 ! Starts with 1 +#else + thread=1 +#endif + + nr=0 +!$OMP DO + do k=1,numcursat + + if (csatpointer(k).eq.0) cycle + + ! number of satellite receptor + n=csatpointer(k) + + ! counter of receptor values this time interval + nr=nr+1 + nr_omp(thread)=nr + + !! testing +! print*, 'receptor_mod: n, thread, nr, csatpointer(k) = ',n, thread, nr, csatpointer(k) + + ! get actual number vertical layers for this retrieval + do nn=1,numsatellite + nchar=len_trim(sat_name(nn)) + if (satellitename(n)(1:nchar).eq.trim(sat_name(nn))) then + numsatlayer=nnsatlayer(nn) + exit + endif + end do + + if (.not.llcmoutput) then + + ! Compute air density + !********************* + + ix=int(xsatellite(n)) + jy=int(ysatellite(n)) + ixp=ix+1 + jyp=jy+1 + ddx=xsatellite(n)-float(ix) + ddy=ysatellite(n)-float(jy) + rddx=1.-ddx + rddy=1.-ddy + p1=rddx*rddy + p2=ddx*rddy + p3=rddx*ddy + p4=ddx*ddy + + do kz=1,numsatlayer + + zmid=0.5*(zsatellite(kz,n)+zsatellite(kz+1,n)) + indz=nzmax-1 + indzp=nzmax + do il=2,nzmax + if (height(il).gt.zmid) then + indz=il-1 + indzp=il + exit + endif + end do + + dz1=zmid-height(indz) + dz2=height(indzp)-zmid + dz=1./(dz1+dz2) + + ! Take density from 2nd wind field in memory + !******************************************** + + do ind=indz,indzp + ! assume moist air density + rho_p(ind-indz+1)=p1*rho(ix ,jy ,ind,2) + & + p2*rho(ixp,jy ,ind,2) + & + p3*rho(ix ,jyp,ind,2) + & + p4*rho(ixp,jyp,ind,2) + ! dry air density +! rho_p(ind-indz+1)= & +! p1*rho(ix ,jy ,ind,2)*(1. - qv(ix ,jy ,ind,2)) + & +! p2*rho(ixp,jy ,ind,2)*(1. - qv(ixp,jy ,ind,2)) + & +! p3*rho(ix ,jyp,ind,2)*(1. - qv(ix ,jyp,ind,2)) + & +! p4*rho(ixp,jyp,ind,2)*(1. - qv(ixp,jyp,ind,2)) + end do + rhoi=(dz1*rho_p(2)+dz2*rho_p(1))*dz + densityoutrecept(kz)=1./rhoi + + end do ! numsatlayer + + else + + ! no normalization by density + densityoutrecept(:)=1. + + endif ! llcmoutput + + ! Write receptor output + !********************** + + do kz=1,numsatlayer + if (recoutnumsat(kz,k).gt.0.) then + do ks = ks_start,nspec + ! only mixing ratio (ppt) for satellites + crec_omp(ks,nr,kz,thread)=csatellite(ks,kz,k)*1.E12*densityoutrecept(kz)* & + weightair/weightmolar(ks)/recoutnumsat(kz,k) + cunc_omp(ks,nr,kz,thread)=csatuncert(ks,kz,k)*1.E12*densityoutrecept(kz)* & + weightair/weightmolar(ks)/recoutnumsat(kz,k) + end do + nnrec_omp(nr,kz,thread)=nnsatellite(kz,k)/recoutnumsat(kz,k) + xkrec_omp(nr,kz,thread)=xksatellite(kz,k)/recoutnumsat(kz,k) + else + crec_omp(:,nr,kz,thread)=-999. + cunc_omp(:,nr,kz,thread)=-999. + nnrec_omp(nr,kz,thread)=-999. + xkrec_omp(nr,kz,thread)=-999. + endif + end do + lonrec_omp(nr,thread)=xsatellite(n)*dx+xlon0 + latrec_omp(nr,thread)=ysatellite(n)*dy+ylat0 + altrec_omp(nr,:,thread)=zsatellite(:,n) + timerec_omp(nr,thread)=tsatellite(n) + namesatrec_omp(nr,thread)=satellitename(n) + + end do ! numcursat +!$OMP END DO +!$OMP END PARALLEL + + ! concatentate from all threads + nr=1 + do ithread=1,nthreads + !! testing +! print*, 'receptor_mod: satellites, nr_omp(ithread) = ',nr_omp(ithread) + if (nr_omp(ithread).eq.0) cycle + crec(:,nr:nr+nr_omp(ithread)-1,:)=crec_omp(:,1:nr_omp(ithread),:,ithread) + cunc(:,nr:nr+nr_omp(ithread)-1,:)=cunc_omp(:,1:nr_omp(ithread),:,ithread) + nnrec(nr:nr+nr_omp(ithread)-1,:)=nnrec_omp(1:nr_omp(ithread),:,ithread) + xkrec(nr:nr+nr_omp(ithread)-1,:)=xkrec_omp(1:nr_omp(ithread),:,ithread) + lonrec(nr:nr+nr_omp(ithread)-1)=lonrec_omp(1:nr_omp(ithread),ithread) + latrec(nr:nr+nr_omp(ithread)-1)=latrec_omp(1:nr_omp(ithread),ithread) + altrec(nr:nr+nr_omp(ithread)-1,:)=altrec_omp(1:nr_omp(ithread),:,ithread) + timerec(nr:nr+nr_omp(ithread)-1)=timerec_omp(1:nr_omp(ithread),ithread) + namesatrec(nr:nr+nr_omp(ithread)-1)=namesatrec_omp(1:nr_omp(ithread),ithread) + nr=nr+nr_omp(ithread) + !! testing +! print*, 'receptor_mod: satellites, nr = ',nr + end do + + ! total number of receptors to write this interval + nr=nr-1 + + ! write satellite output this time interval + if (nr.gt.0) then + if (lnetcdfout.eq.1) then +#if USE_NCF + call write_satellite_netcdf(crec,cunc,nnrec,xkrec,lonrec,latrec,altrec,timerec,namesatrec,nr) +#endif + else + call write_satellite_binary(crec,cunc,nnrec,xkrec,lonrec,latrec,altrec,timerec,namesatrec,nr) + endif + endif + ! advance output index + spointer=spointer+nr + + !! testing + print*, 'receptor_mod: satellites, nr = ',nr + print*, 'receptor_mod: spointer = ',spointer + + ! close files + if (lnetcdfout.eq.1) then +#ifdef USE_NCF + if (numreceptor.gt.0) then + call close_receptor_netcdf + endif + if (numsatreceptor.gt.0) then + call close_satellite_netcdf + endif +#endif + endif + + deallocate(densityoutrecept) + deallocate(crec,cunc,nnrec,xkrec) + deallocate(crec_omp,cunc_omp,nnrec_omp,xkrec_omp) + deallocate(lonrec,latrec,altrec,timerec,namerec,namesatrec) + deallocate(lonrec_omp,latrec_omp,altrec_omp,timerec_omp,namesatrec_omp) + deallocate(nr_omp) + + ! End of receptor output + !*********************** + + recoutnum(:)=0. + recoutnumsat(:,:)=0. + + endif ! output receptor conc + + endif ! receptor output + + if (itime.eq.lrecoutend) then + + ! Reinitialize + !************* + + creceptor(:,:)=0. + crecuncert(:,:)=0. + nnreceptor(:)=0. + xkreceptor(:)=0. + if (numsatellite.gt.0) then + csatellite(:,:,:)=0. + csatuncert(:,:,:)=0. + nnsatellite(:,:)=0. + xksatellite(:,:)=0. + endif + + recoutnum(:)=0. + recoutnumsat(:,:)=0. + + ! Update output timesteps + !************************ + lrecoutnext=lrecoutnext+lrecoutstep + lrecoutstart=lrecoutnext-lrecoutaver/2 + lrecoutend=lrecoutnext+lrecoutaver/2 + + if (itime.eq.lrecoutstart) then + weight=0.5 + call receptorcalc(itime,weight,lrecoutstart,lrecoutend,recoutnum,recoutnumsat) + endif + + endif + + end subroutine receptoroutput + + + subroutine receptorcalc(itime,weight,lrecoutstart,lrecoutend,recoutnum,recoutnumsat) + + !***************************************************************************** + ! * + ! Calculation of the concentrations at receptor points using the * + ! kernel method * + ! * + ! Author: A. Stohl * + ! * + ! Modifications: * + ! Sep-2023, R. Thompson: added option for domain filling mode * + ! * + !***************************************************************************** + + implicit none + + integer :: itime, itage, lrecoutstart, lrecoutend + real, dimension(maxrecsample) :: recoutnum + real, dimension(nlayermax,maxrecsample) :: recoutnumsat + real :: weight + real :: xd, yd, zd, hx, hy, hz, h, r2, xkern + real, dimension(nspec) :: conc + real, dimension(:,:), allocatable :: unc + integer :: n, j, k, ks, kz, i, nn, ks_start, nchar, numsatlayer + real :: hxmax, hymax, hzmax, hxsat, hysat, rec_ff, xksum, eta, zmid + real, parameter :: factor=.596831 ! 15/(8*pi) + real, parameter :: zref=2000. ! normalizing height for calculating eta + integer, parameter :: jmax=4000 ! max number of particles in kernel + + ! initialization + !*************** + + if (llcmoutput) then + ks_start=2 + else + ks_start=1 + endif + allocate(unc(nspec,jmax)) + + ! hxmax and hymax in degrees, hzmax in metres + !******************************************** + + if (mdomainfill.ne.1) then + hxmax=6.0 + hymax=4.0 + hzmax=150. + else + hxmax=2.0 + hymax=1.5 + hzmax=300. + hxsat=1.75 + hysat=1.25 + endif + + ! convert h-values to grid coordinates + !************************************* + + hxmax=hxmax/dx + hymax=hymax/dy + hxsat=hxsat/dx + hysat=hysat/dy + + ! Loop over receptors + !******************** + + ! pointer for creceptor, xkreceptor and nnreceptor + numcurrec=0 + cpointer(:)=0 + k=0 + + do n=1,numreceptor + + if ((.not.lrecregular).and.((treceptor(n).lt.lrecoutstart).or. & + (treceptor(n).ge.lrecoutend))) cycle ! skip if not in current sampling time interval + + ! update pointer + k=k+1 + if (k.gt.maxrecsample) then + write(*,*) 'FLEXPART ERROR in receptorcalc: maxrecsample too small' + error stop + endif + cpointer(k)=n + + !! testing +! print*, 'receptorcalc: n, receptorname(n) = ',n, receptorname(n) + + ! Reset concentrations for new receptor + conc(:)=0. + unc(:,:)=0. + xksum=0. + j=0 + + if (zreceptor(n).lt.hzmax) then + rec_ff=0.5 + 0.9375*(zreceptor(n)/hzmax) - & + 0.625*(zreceptor(n)/hzmax)**3 + & + 0.1875*(zreceptor(n)/hzmax)**5 + rec_ff=1./rec_ff + else + rec_ff=1. + endif + h=hxmax*hymax*hzmax + + !! testing +! print*, 'receptorcalc: rec_ff = ',rec_ff + + ! Estimate concentration at receptor + !*********************************** + +!$OMP PARALLEL & +!$OMP PRIVATE(i,itage,hz,zd,hx,xd,hy,yd,h,r2,xkern,ks) & +!$OMP SHARED(j,unc,conc) & +!$OMP REDUCTION(+:xksum,xkreceptor,nnreceptor) + +!$OMP DO + do i=1,count%alive + + if (mdomainfill.ne.1) then + + ! not domain filling run so consider age of particle + itage=abs(itime-part(i)%tstart) + + hz=min(50.+0.3*sqrt(real(itage)),hzmax) + zd=part(i)%z/hz + if (zd.gt.1.) cycle ! save computing time + + hx=min((0.29+2.222e-3*sqrt(real(itage)))*dx+ & + real(itage)*1.2e-5,hxmax) ! 80 km/day + xd=(part(i)%xlon-xreceptor(n))/hx + if (xd*xd.gt.1.) cycle ! save computing time + + hy=min((0.18+1.389e-3*sqrt(real(itage)))*dy+ & + real(itage)*7.5e-6,hymax) ! 80 km/day + yd=(part(i)%ylat-yreceptor(n))/hy + if (yd*yd.gt.1.) cycle ! save computing time + h=hx*hy*hz + + r2=xd*xd+yd*yd+zd*zd + if (r2.ge.1.) cycle ! save computing time + xkern=2.*factor*(1.-r2) ! parabolic kernel + + else + + ! domain filling run + xd=(part(i)%xlon-xreceptor(n))/hxmax + if (xd*xd.gt.1) cycle ! save computing time + + yd=(part(i)%ylat-yreceptor(n))/hymax + if (yd*yd.gt.1.) cycle ! save computing time + + zd=(part(i)%z-zreceptor(n))/hzmax + if (zd*zd.gt.1.) cycle ! save computing time + + r2=xd*xd+yd*yd+zd*zd + if (r2.ge.1.) cycle ! save computing time + xkern=rec_ff*factor*(1.-r2) ! parabolic kernel + + endif ! mdomainfill + + ! counter of particles used in conc calculation + ! note: use of atomic may not be efficient, alternative split unc, j over threads + ! and combine all threads after end of parallel section, need to save j from each thread +!$OMP ATOMIC + j=j+1 + if (j.gt.jmax) then + write(*,*) 'FLEXPART ERROR in receptorcalc: size of jmax too small' + error stop + endif + + do ks=ks_start,nspec + if (llcmoutput) then + ! special case LCM output use mass ratio species to airtracer + ! species 1 is always airtracer + conc(ks)=conc(ks) + mass(i,ks)/mass(i,1) * & + weight * xkern + unc(ks,j)=mass(i,ks)/mass(i,1) + else + ! normal case + conc(ks)=conc(ks) + mass(i,ks) * & + weight * xkern/h/receptorarea(n) + unc(ks,j)=mass(i,ks)/h/receptorarea(n) + endif + end do + nnreceptor(k)=nnreceptor(k) + 1. + xkreceptor(k)=xkreceptor(k) + xkern + xksum=xksum + xkern + + end do ! count%alive +!$OMP END DO +!$OMP END PARALLEL + +!$OMP PARALLEL IF(nspec>99) PRIVATE(ks) +!$OMP DO + do ks=ks_start,nspec + if (conc(ks).gt.0.) then + ! only do if conc could be calculated for this receptor at this time + creceptor(ks,k)=creceptor(ks,k) + conc(ks)/xksum + crecuncert(ks,k)=crecuncert(ks,k) + & + sqrt(sum((unc(ks,1:j)-conc(ks)/xksum/weight)**2)/real(j)) + endif + end do +!$OMP END DO +!$OMP END PARALLEL + if (any(conc(:).gt.0.)) then + recoutnum(k)=recoutnum(k)+weight + endif + + ! update number receptors this time interval + numcurrec=k + + !! testing +! print*, 'receptorcalc: j, conc, xksum = ',j, conc(2), xksum +! print*, 'receptorcalc: n, k, cpointer(k) = ',n, k, cpointer(k) +! print*, 'receptorcalc: nnreceptor(k) = ',nnreceptor(k) +! print*, 'receptorcalc: xkreceptor(k) = ',xkreceptor(k) +! print*, 'receptorcalc: creceptor(2,k) = ',creceptor(2,k) +! print*, 'receptorcalc: crecuncert(2,k) = ',crecuncert(2,k) + + end do ! numreceptor + + ! Loop over satellites + !********************* + + ! pointer for csatellite, xksatellite and nnsatellite + numcursat=0 + csatpointer(:)=0 + k=0 + + do n=1,numsatreceptor + + if ((tsatellite(n).lt.lrecoutstart).or. & + (tsatellite(n).ge.lrecoutend)) cycle ! skip if not in current sampling time interval + + !! testing +! print*, 'receptorcalc: lrecoutstart, lrecoutend, tsatellite(n) = ',lrecoutstart, lrecoutend, tsatellite(n) + + ! update pointer + k=k+1 + if (k.gt.maxrecsample) then + write(*,*) 'FLEXPART ERROR in receptorcalc: maxrecsample too small' + error stop + endif + csatpointer(k)=n + + ! get actual number vertical layers for this retrieval + do nn=1,numsatellite + nchar=len_trim(sat_name(nn)) + if (satellitename(n)(1:nchar).eq.trim(sat_name(nn))) then + numsatlayer=nnsatlayer(nn) + exit + endif + end do + + !! testing +! print*, 'receptorcalc: n, satellitename(n) = ',n, satellitename(n) + + do kz=1,numsatlayer + + ! Reset concentrations for new receptor + conc(:)=0. + unc(:,:)=0. + xksum=0. + j=0 + + ! height of layer + hz=zsatellite(kz+1,n)-zsatellite(kz,n) + + ! rare cases when 2 satellite pressure layers fall in same meteo layer + ! set minimum height between layers + hz=max(200.,hz) + + ! midpoint of layer + zmid=zsatellite(kz,n)+0.5*hz + + ! factor by which to expand horizontal threshhold + ! as expect particle density to decrease with altitude + eta=max(1.,sqrt(0.5*zmid/zref)) + + h=hxsat*hysat*(0.5*hz) + + !! testing +! print*, 'zmid, hz, eta =',zmid, hz, eta + +!$OMP PARALLEL & +!$OMP PRIVATE(i,zd,xd,yd,r2,xkern,ks) & +!$OMP SHARED(j,unc,conc) & +!$OMP REDUCTION(+:xksum,xksatellite,nnsatellite) + +!$OMP DO + do i=1,count%alive + + ! sample satellite retrievals for domain-filling and + ! non-domain-filling modes in the same way + + zd=(part(i)%z-zmid)/(0.5*hz) + if (zd*zd.gt.1.) cycle ! save computing time + + xd=(part(i)%xlon-xsatellite(n))/(eta*hxsat) + if (xd*xd.gt.1) cycle ! save computing time + + yd=(part(i)%ylat-ysatellite(n))/(eta*hysat) + if (yd*yd.gt.1.) cycle ! save computing time + + r2=xd*xd+yd*yd+zd*zd + if (r2.ge.1.) cycle ! save computing time + + xkern=factor*(1.-r2) ! parabolic kernel + + ! counter of particles used in conc calculation +!$OMP ATOMIC + j=j+1 + if (j.gt.jmax) then + write(*,*) 'FLEXPART ERROR in receptorcalc: size of jmax too small' + error stop + endif + + do ks=ks_start,nspec + if (llcmoutput) then + ! special case LCM output use mass ratio species to airtracer + ! species 1 is always airtracer + conc(ks)=conc(ks) + mass(i,ks)/mass(i,1) * & + weight * xkern + unc(ks,j)=mass(i,ks)/mass(i,1) + else + ! normal case + conc(ks)=conc(ks) + mass(i,ks) * & + weight * xkern/h/satellitearea(n) + unc(ks,j)=mass(i,ks)/h/satellitearea(n) + endif + end do + nnsatellite(kz,k)=nnsatellite(kz,k) + 1. + xksatellite(kz,k)=xksatellite(kz,k) + xkern + xksum=xksum + xkern + + end do ! count%alive +!$OMP END DO +!$OMP END PARALLEL + +!$OMP PARALLEL IF(nspec>99) PRIVATE(ks) +!$OMP DO + do ks=ks_start,nspec + if (conc(ks).gt.0.) then + ! only do if conc could be calculated for this receptor and time + csatellite(ks,kz,k)=csatellite(ks,kz,k) + conc(ks)/xksum + csatuncert(ks,kz,k)=csatuncert(ks,kz,k) + & + sqrt(sum((unc(ks,1:j)-conc(ks)/xksum/weight)**2)/real(j)) + endif + end do +!$OMP END DO +!$OMP END PARALLEL + if (any(conc(:).gt.0.)) then + recoutnumsat(kz,k)=recoutnumsat(kz,k)+weight + endif + + !! testing +! print*, 'receptorcalc: for satellite: j, conc, xksum = ',j, conc(2), xksum +! print*, 'receptorcalc: n, k, csatpointer(k) = ',n, k, csatpointer(k) +! print*, 'receptorcalc: nnsatellite(:,k) = ',nnsatellite(:,k) +! print*, 'receptorcalc: xksatellite(:,k) = ',xksatellite(:,k) + + end do ! numsatlayer + + ! update current number of satellite receptors this time interval + numcursat=k + + end do ! numsatreceptor + + end subroutine receptorcalc + + +end module receptor_mod + diff --git a/src/receptor_netcdf_mod.f90 b/src/receptor_netcdf_mod.f90 new file mode 100644 index 0000000000000000000000000000000000000000..7d311f51fa71cc5c2d9e249dad4ba4dfc752be7e --- /dev/null +++ b/src/receptor_netcdf_mod.f90 @@ -0,0 +1,1109 @@ +! SPDX-FileCopyrightText: FLEXPART 1998-2019, see flexpart_license.txt +! SPDX-License-Identifier: GPL-3.0-or-later + +module receptor_netcdf_mod + + !***************************************************************************** + ! * + ! This module contains variables and subroutines for reading input * + ! for satellite receptors and for saving the output of all receptor * + ! types to netcdf file * + ! * + ! Author, Rona Thompson * + ! * + !***************************************************************************** + + use netcdf + use par_mod + use com_mod + use point_mod + use date_mod + use netcdf_output_mod, only: nf90_err + use windfields_mod, only: prs, height, nzmax, nz + + implicit none + + ! general receptors + integer :: rpointer + integer :: nc_id + integer :: recdim_id, nchardim_id + integer :: timevar_id, recvar_id, reclonvar_id, reclatvar_id, recaltvar_id, recnamevar_id + integer, dimension(:), allocatable :: concvar_id, uncvar_id + integer :: nnvar_id, xkvar_id + ! satellite receptors + integer :: spointer + integer :: memsatday + character(len=8), dimension(:), allocatable :: sat_name + character(len=256), dimension(:), allocatable :: sat_file, sat_path + integer :: ncsat_id + integer :: satrecdim_id, ncharsatdim_id, sataltdim_id, satlayerdim_id + integer :: sattimevar_id, satrecvar_id, satlonvar_id, satlatvar_id, sataltvar_id, satnamevar_id + integer, dimension(:), allocatable :: satvar_id, satuncvar_id + integer :: satnnvar_id, satxkvar_id + + contains + + + subroutine alloc_satellite + + !***************************************************************************** + ! * + ! This routine allocates variables for satellite concentrations * + ! * + !***************************************************************************** + + implicit none + + if (numsatellite.gt.0) then + allocate( csatellite(nspec,nlayermax,maxrecsample) ) + allocate( csatuncert(nspec,nlayermax,maxrecsample) ) + allocate( nnsatellite(nlayermax,maxrecsample) ) + allocate( xksatellite(nlayermax,maxrecsample) ) + csatellite(:,:,:)=0. + csatuncert(:,:,:)=0. + nnsatellite(:,:)=0. + xksatellite(:,:)=0. + endif + + end subroutine alloc_satellite + + + subroutine receptorout_init + + !***************************************************************************** + ! * + ! Intitialize netcdf files for receptor concentrations * + ! * + ! Author: R. Thompson, Sep-2023 * + ! * + ! * + !***************************************************************************** + + implicit none + + character(len=256) :: fn, timeunit + character(len=8) :: adate + character(len=6) :: atime + integer :: ks, n, ks_start + character(8) :: date + character(10) :: time + character(5) :: zone + + if (numreceptor.eq.0) then + return + endif + + if (llcmoutput) then + ks_start=2 + else + ks_start=1 + endif + + ! time at simulation start + if (ldirect.eq.1) then + write(adate,'(i8.8)') ibdate + write(atime,'(i6.6)') ibtime + else + write(adate,'(i8.8)') iedate + write(atime,'(i6.6)') ietime + end if + + if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then + ! concentration output file + write(fn,'(A)') path(2)(1:length(2))//'receptor_conc.nc' + else if (iout.eq.2) then + ! mixing ratio output file + ! note: for iout=3 (both conc and mixing ratio) only output conc at receptors + write(fn,'(A)') path(2)(1:length(2))//'receptor_pptv.nc' + endif + + ! initialization + if (.not.allocated(concvar_id)) then + allocate(concvar_id(nspec)) + allocate(uncvar_id(nspec)) + endif + + ! pointer for receptor dimension + rpointer=1 + + ! create file + call nf90_err( nf90_create(trim(fn), nf90_clobber, nc_id) ) + + ! define dimensions + !****************** + + call nf90_err( nf90_def_dim(nc_id, "rec", nf90_unlimited, recdim_id) ) + call nf90_err( nf90_def_dim(nc_id, 'nchar', 16, nchardim_id) ) + + ! define variables + !***************** + + ! time + timeunit = 'seconds since '//adate(1:4)//'-'//adate(5:6)// & + '-'//adate(7:8)//' '//atime(1:2)//':'//atime(3:4) + call nf90_err( nf90_def_var(nc_id, 'time', nf90_int, (/ recdim_id /), timevar_id) ) + call nf90_err( nf90_put_att(nc_id, timevar_id, 'units', trim(timeunit)) ) + call nf90_err( nf90_put_att(nc_id, timevar_id, 'calendar', 'proleptic_gregorian') ) + + ! receptors + call nf90_err( nf90_def_var(nc_id, "rec", nf90_float, (/ recdim_id /), recvar_id) ) + call nf90_err( nf90_put_att(nc_id, recvar_id, "longname", "receptors") ) + call nf90_err( nf90_put_att(nc_id, recvar_id, "units", "index") ) + + ! receptor names + call nf90_err( nf90_def_var(nc_id, "receptorname", nf90_char, (/ nchardim_id, recdim_id /), & + recnamevar_id) ) + call nf90_err( nf90_put_att(nc_id, recnamevar_id, "longname", "receptor name") ) + + ! receptor longitude + call nf90_err( nf90_def_var(nc_id, "lon", nf90_float, (/ recdim_id /), reclonvar_id) ) + call nf90_err( nf90_put_att(nc_id, reclonvar_id, "longname", "receptor longitude") ) + call nf90_err( nf90_put_att(nc_id, reclonvar_id, "units", "degrees_east") ) + + ! receptor latitude + call nf90_err( nf90_def_var(nc_id, "lat", nf90_float, (/ recdim_id /), reclatvar_id) ) + call nf90_err( nf90_put_att(nc_id, reclatvar_id, "longname", "receptor latitude") ) + call nf90_err( nf90_put_att(nc_id, reclatvar_id, "units", "degrees_north") ) + + ! receptor altitude + call nf90_err( nf90_def_var(nc_id, "lev", nf90_float, (/ recdim_id /), recaltvar_id) ) + call nf90_err( nf90_put_att(nc_id, recaltvar_id, "longname", "receptor altitude") ) + call nf90_err( nf90_put_att(nc_id, recaltvar_id, "units", "meters") ) + + ! species specific variables + do ks=ks_start,nspec + ! concentration/mixing ratio variables + call nf90_err( nf90_def_var(nc_id, trim(species(ks)), nf90_float, (/ recdim_id /), concvar_id(ks)) ) + call nf90_err( nf90_def_var(nc_id, trim(species(ks))//"_uncert", nf90_float, (/ recdim_id /), & + uncvar_id(ks)) ) + if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then + call nf90_err( nf90_put_att(nc_id, concvar_id(ks), "units", "ng/m3") ) + call nf90_err( nf90_put_att(nc_id, concvar_id(ks), "longname", "mean receptor concentration") ) + call nf90_err( nf90_put_att(nc_id, uncvar_id(ks), "units", "ng/m3") ) + call nf90_err( nf90_put_att(nc_id, uncvar_id(ks), "longname", "uncertainty receptor concentration") ) + else if ((iout.eq.2)) then + call nf90_err( nf90_put_att(nc_id, concvar_id(ks), "units", "pptv") ) + call nf90_err( nf90_put_att(nc_id, concvar_id(ks), "longname", "mean receptor VMR") ) + call nf90_err( nf90_put_att(nc_id, uncvar_id(ks), "units", "pptv") ) + call nf90_err( nf90_put_att(nc_id, uncvar_id(ks), "longname", "uncertainty receptor VMR") ) + endif + end do + + ! not species specific variables + ! number of particles in receptor output + call nf90_err( nf90_def_var(nc_id,"npart", nf90_float, (/ recdim_id /), nnvar_id) ) + call nf90_err( nf90_put_att(nc_id, nnvar_id, "units", "counts") ) + call nf90_err( nf90_put_att(nc_id, nnvar_id, "longname","number of particles at receptor") ) + ! average kernel weight at receptor + call nf90_err( nf90_def_var(nc_id,"kernel", nf90_float, (/ recdim_id /), xkvar_id) ) + call nf90_err( nf90_put_att(nc_id, xkvar_id, "units", "") ) + call nf90_err( nf90_put_att(nc_id, xkvar_id, "longname", "average kernel weight at receptor") ) + + ! write global attributes + !************************ + + call date_and_time(date,time,zone) + call nf90_err( nf90_put_att(nc_id, nf90_global, 'Conventions', 'CF-1.6') ) + call nf90_err( nf90_put_att(nc_id, nf90_global, 'title', 'FLEXPART receptor output') ) + call nf90_err( nf90_put_att(nc_id, nf90_global, 'source', trim(flexversion)//' model output') ) + call nf90_err( nf90_put_att(nc_id, nf90_global, 'history', date(1:4)//'-'//date(5:6)//& + '-'//date(7:8)//' '//time(1:2)//':'//time(3:4)//' '//zone ) ) + call nf90_err( nf90_put_att(nc_id, nf90_global, 'references', & + 'Stohl et al., Atmos. Chem. Phys., 2005, doi:10.5194/acp-5-2461-200;'//& + 'Henne et al., in Lagrangian Modeling of the Atmosphere, 2012, doi:10.1029/2012GM001247') ) + + ! end definition + call nf90_err( nf90_enddef(nc_id) ) + + ! write dimension variables + !************************** + + ! receptor index + call nf90_err( nf90_put_var(nc_id, recvar_id, (/(n,n=1,numreceptor)/)) ) + + ! close file + call nf90_err( nf90_close(nc_id) ) + + end subroutine receptorout_init + + + subroutine satelliteout_init + + !***************************************************************************** + ! * + ! Intitialize netcdf files for satellite concentrations * + ! * + ! Author: R. Thompson, Oct-2023 * + ! * + ! * + !***************************************************************************** + + implicit none + + character(len=256) :: fn, timeunit + character(len=8) :: adate + character(len=6) :: atime + integer :: ks, n, ks_start + character(8) :: date + character(10) :: time + character(5) :: zone + + if (numsatellite.eq.0) then + return + endif + + if (llcmoutput) then + ks_start=2 + else + ks_start=1 + endif + + ! time at simulation start + if (ldirect.eq.1) then + write(adate,'(i8.8)') ibdate + write(atime,'(i6.6)') ibtime + else + write(adate,'(i8.8)') iedate + write(atime,'(i6.6)') ietime + end if + + ! mixing ratio output for satellites + write(fn,'(A)') path(2)(1:length(2))//'satellite_pptv.nc' + + ! initialization + if (.not.allocated(satvar_id)) then + allocate(satvar_id(nspec)) + allocate(satuncvar_id(nspec)) + endif + + ! pointer for satellite receptor dimension + spointer=1 + + ! create file + call nf90_err( nf90_create(trim(fn), nf90_clobber, ncsat_id) ) + + ! define dimensions + !****************** + + call nf90_err( nf90_def_dim(ncsat_id, "rec", nf90_unlimited, satrecdim_id) ) + call nf90_err( nf90_def_dim(ncsat_id, "layer", (nlayermax-1), satlayerdim_id) ) + call nf90_err( nf90_def_dim(ncsat_id, "level", nlayermax, sataltdim_id) ) + call nf90_err( nf90_def_dim(ncsat_id, 'nchar', 24, ncharsatdim_id) ) + + ! define variables + !***************** + + ! Note: did not include variables for kernel parameters as currently use same + ! at all sites and did not include windspeed, ageclasses, and release points + + ! time + timeunit = 'seconds since '//adate(1:4)//'-'//adate(5:6)// & + '-'//adate(7:8)//' '//atime(1:2)//':'//atime(3:4) + call nf90_err( nf90_def_var(ncsat_id, 'time', nf90_int, (/ satrecdim_id /), sattimevar_id) ) + call nf90_err( nf90_put_att(ncsat_id, sattimevar_id, 'units', trim(timeunit)) ) + call nf90_err( nf90_put_att(ncsat_id, sattimevar_id, 'calendar', 'proleptic_gregorian') ) + + ! receptor names + call nf90_err( nf90_def_var(ncsat_id, "receptorname", nf90_char, (/ ncharsatdim_id, satrecdim_id /), & + satnamevar_id) ) + call nf90_err( nf90_put_att(ncsat_id, satnamevar_id, "longname", "receptor name") ) + + ! receptors + call nf90_err( nf90_def_var(ncsat_id, "rec", nf90_float, (/ satrecdim_id /), satrecvar_id) ) + call nf90_err( nf90_put_att(ncsat_id, satrecvar_id, "longname", "receptors") ) + call nf90_err( nf90_put_att(ncsat_id, satrecvar_id, "units", "index") ) + + ! receptor longitude + call nf90_err( nf90_def_var(ncsat_id, "lon", nf90_float, (/ satrecdim_id /), satlonvar_id) ) + call nf90_err( nf90_put_att(ncsat_id, satlonvar_id, "longname", "receptor longitude") ) + call nf90_err( nf90_put_att(ncsat_id, satlonvar_id, "units", "degrees_east") ) + + ! receptor latitude + call nf90_err( nf90_def_var(ncsat_id, "lat", nf90_float, (/ satrecdim_id /), satlatvar_id) ) + call nf90_err( nf90_put_att(ncsat_id, satlatvar_id, "longname", "receptor latitude") ) + call nf90_err( nf90_put_att(ncsat_id, satlatvar_id, "units", "degrees_north") ) + + ! receptor altitude + call nf90_err( nf90_def_var(ncsat_id, "alt", nf90_float, (/ sataltdim_id, satrecdim_id /), sataltvar_id) ) + call nf90_err( nf90_put_att(ncsat_id, sataltvar_id, "longname", "receptor altitude of levels") ) + call nf90_err( nf90_put_att(ncsat_id, sataltvar_id, "units", "meters") ) + + ! species specific variables + do ks=ks_start,nspec + ! mixing ratio output for each layer of retrieval + call nf90_err( nf90_def_var(ncsat_id, trim(species(ks)), nf90_float, (/ satlayerdim_id, satrecdim_id /), & + satvar_id(ks)) ) + call nf90_err( nf90_put_att(ncsat_id, satvar_id(ks), "units", "pptv") ) + call nf90_err( nf90_put_att(ncsat_id, satvar_id(ks), "longname", "mean VMR") ) + ! uncertainty output for each layer of retrieval + call nf90_err( nf90_def_var(ncsat_id, trim(species(ks))//"_uncert", nf90_float, (/ satlayerdim_id, satrecdim_id /), & + satuncvar_id(ks)) ) + call nf90_err( nf90_put_att(ncsat_id, satuncvar_id(ks), "units", "pptv") ) + call nf90_err( nf90_put_att(ncsat_id, satuncvar_id(ks), "longname", "uncertainty VMR") ) + end do + + ! not species specific variables + ! number of particles in receptor output + call nf90_err( nf90_def_var(ncsat_id,"npart", nf90_float, (/ satlayerdim_id, satrecdim_id /), satnnvar_id) ) + call nf90_err( nf90_put_att(ncsat_id, satnnvar_id, "units", "counts") ) + call nf90_err( nf90_put_att(ncsat_id, satnnvar_id, "longname","number of particles at receptor") ) + ! average kernel weight at receptor + call nf90_err( nf90_def_var(ncsat_id,"kernel", nf90_float, (/ satlayerdim_id, satrecdim_id /), satxkvar_id) ) + call nf90_err( nf90_put_att(ncsat_id, satxkvar_id, "units", "") ) + call nf90_err( nf90_put_att(ncsat_id, satxkvar_id, "longname", "average kernel weight at receptor") ) + + ! write global attributes + !************************ + + call date_and_time(date,time,zone) + call nf90_err( nf90_put_att(ncsat_id, nf90_global, 'Conventions', 'CF-1.6') ) + call nf90_err( nf90_put_att(ncsat_id, nf90_global, 'title', 'FLEXPART receptor output') ) + call nf90_err( nf90_put_att(ncsat_id, nf90_global, 'source', trim(flexversion)//' model output') ) + call nf90_err( nf90_put_att(ncsat_id, nf90_global, 'history', date(1:4)//'-'//date(5:6)//& + '-'//date(7:8)//' '//time(1:2)//':'//time(3:4)//' '//zone ) ) + call nf90_err( nf90_put_att(ncsat_id, nf90_global, 'references', & + 'Stohl et al., Atmos. Chem. Phys., 2005, doi:10.5194/acp-5-2461-200;'//& + 'Henne et al., in Lagrangian Modeling of the Atmosphere, 2012, doi:10.1029/2012GM001247') ) + + ! end definition + call nf90_err( nf90_enddef(ncsat_id) ) + + ! write dimension variables + !************************** + + ! receptor index + call nf90_err( nf90_put_var(ncsat_id, satrecvar_id, (/(n,n=1,numsatreceptor)/)) ) + + ! close file + call nf90_err( nf90_close(ncsat_id) ) + + end subroutine satelliteout_init + + + subroutine receptor_output_netcdf() + + !***************************************************************************** + ! * + ! This routine writes receptor concentrations to netcdf files * + ! * + ! Author: R. Thompson * + ! January 2024 * + ! * + !***************************************************************************** + + implicit none + + integer :: ks, ks_start + character(len=256) :: fn + + ! Open output files + !****************** + + if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then + ! concentration output file + write(fn,'(A)') path(2)(1:length(2))//'receptor_conc.nc' + else if (iout.eq.2) then + ! mixing ratio output file + ! note for iout=3 (both conc and mixing ratio) only output conc at receptors + write(fn,'(A)') path(2)(1:length(2))//'receptor_pptv.nc' + endif + call nf90_err( nf90_open(trim(fn), nf90_write, nc_id) ) + + ! Get variable ids + !***************** + + if (llcmoutput) then + ks_start=2 + else + ks_start=1 + endif + + + do ks = ks_start,nspec + call nf90_err( nf90_inq_varid(nc_id, trim(species(ks)), concvar_id(ks)) ) + call nf90_err( nf90_inq_varid(nc_id, trim(species(ks))//"_uncert", uncvar_id(ks)) ) + end do + call nf90_err( nf90_inq_varid(nc_id, "npart", nnvar_id) ) + call nf90_err( nf90_inq_varid(nc_id, "kernel", xkvar_id) ) + + end subroutine receptor_output_netcdf + + + subroutine satellite_output_netcdf() + + !***************************************************************************** + ! * + ! This routine writes receptor concentrations to netcdf files * + ! * + ! Author: R. Thompson * + ! January 2024 * + ! * + !***************************************************************************** + + implicit none + + integer :: ks, ks_start + character(len=256) :: fn + + ! Open output files + !****************** + + write(fn,'(A)') path(2)(1:length(2))//'satellite_pptv.nc' + call nf90_err( nf90_open(trim(fn), nf90_write, ncsat_id) ) + + ! Get variable ids + !***************** + + if (llcmoutput) then + ks_start=2 + else + ks_start=1 + endif + + ! satellite receptors + do ks = ks_start,nspec + call nf90_err( nf90_inq_varid(ncsat_id, trim(species(ks)), satvar_id(ks)) ) + call nf90_err( nf90_inq_varid(ncsat_id, trim(species(ks))//"_uncert", satuncvar_id(ks)) ) + end do + call nf90_err( nf90_inq_varid(ncsat_id, "npart", satnnvar_id) ) + call nf90_err( nf90_inq_varid(ncsat_id, "kernel", satxkvar_id) ) + + end subroutine satellite_output_netcdf + + + subroutine write_receptor_netcdf(crec,cunc,nnrec,xkrec,lonrec,latrec,altrec,timerec,namerec,nrec) + + !***************************************************************************** + ! * + ! This routine writes receptor concentrations to netcdf files * + ! * + ! Author: R. Thompson * + ! January 2024 * + ! * + !***************************************************************************** + + implicit none + + integer :: ks, ks_start, nrec + real, dimension(nspec,maxrecsample,nlayermax) :: crec, cunc + real, dimension(maxrecsample,nlayermax) :: nnrec, xkrec, altrec + real, dimension(maxrecsample) :: lonrec, latrec + integer, dimension(maxrecsample) :: timerec + character(len=16), dimension(maxrecsample) :: namerec + + if (llcmoutput) then + ks_start=2 + else + ks_start=1 + endif + + !! testing +! print*, 'write_receptor_netcdf: rpointer, nrec = ',rpointer, nrec + + ! species specific + do ks=ks_start,nspec + call nf90_err( nf90_put_var(nc_id, concvar_id(ks), crec(ks,1:nrec,1), (/rpointer/), (/nrec/) ) ) + call nf90_err( nf90_put_var(nc_id, uncvar_id(ks), cunc(ks,1:nrec,1), (/rpointer/), (/nrec/) ) ) + end do + + ! not species specific output + ! receptor name + call nf90_err( nf90_put_var(nc_id, recnamevar_id, namerec(1:nrec), (/1,rpointer/), (/16,nrec/) ) ) + ! receptor time + call nf90_err( nf90_put_var(nc_id, timevar_id, timerec(1:nrec), (/rpointer/), (/nrec/) ) ) + ! receptor longitude + call nf90_err( nf90_put_var(nc_id, reclonvar_id, lonrec(1:nrec), (/rpointer/), (/nrec/) ) ) + ! receptor latitude + call nf90_err( nf90_put_var(nc_id, reclatvar_id, latrec(1:nrec), (/rpointer/), (/nrec/) ) ) + ! receptor latitude + call nf90_err( nf90_put_var(nc_id, recaltvar_id, altrec(1:nrec,1), (/rpointer/), (/nrec/) ) ) + ! average number of particles all timesteps for each receptor + call nf90_err( nf90_put_var(nc_id, nnvar_id, nnrec(1:nrec,1), (/rpointer/), (/nrec/) ) ) + ! average kernel all timesteps + call nf90_err( nf90_put_var(nc_id, xkvar_id, xkrec(1:nrec,1), (/rpointer/), (/nrec/) ) ) + + end subroutine write_receptor_netcdf + + + subroutine write_satellite_netcdf(crec,cunc,nnrec,xkrec,lonrec,latrec,altrec,timerec,namerec,nrec) + + !***************************************************************************** + ! * + ! This routine writes receptor concentrations to netcdf files * + ! * + ! Author: R. Thompson * + ! January 2024 * + ! * + !***************************************************************************** + + implicit none + + integer :: ks, ks_start, nrec + real, dimension(nspec,maxrecsample,nlayermax) :: crec, cunc + real, dimension(maxrecsample,nlayermax) :: nnrec, xkrec, altrec + real, dimension(maxrecsample) :: lonrec, latrec + integer, dimension(maxrecsample) :: timerec + character(len=24), dimension(maxrecsample) :: namerec + + if (llcmoutput) then + ks_start=2 + else + ks_start=1 + endif + + !! testing +! print*, 'write_satellite_netcdf: spointer, nrec = ',spointer, nrec + + ! species specific output + do ks = ks_start,nspec + call nf90_err( nf90_put_var(ncsat_id,satvar_id(ks),transpose(crec(ks,1:nrec,1:nlayermax-1)),& + (/1,spointer/),(/nlayermax-1,nrec/) ) ) + call nf90_err( nf90_put_var(ncsat_id,satuncvar_id(ks),transpose(cunc(ks,1:nrec,1:nlayermax-1)),& + (/1,spointer/),(/nlayermax-1,nrec/) ) ) + end do + + ! non-species specific + ! receptor name + call nf90_err( nf90_put_var(ncsat_id, satnamevar_id, namerec(1:nrec), (/1,spointer/), (/24,nrec/) ) ) + ! receptor time + call nf90_err( nf90_put_var(ncsat_id, sattimevar_id, timerec(1:nrec), (/spointer/), (/nrec/) ) ) + ! receptor longitude + call nf90_err( nf90_put_var(ncsat_id, satlonvar_id, lonrec(1:nrec), (/spointer/), (/nrec/) ) ) + ! receptor latitude + call nf90_err( nf90_put_var(ncsat_id, satlatvar_id, latrec(1:nrec), (/spointer/), (/nrec/) ) ) + ! receptor altitude + call nf90_err( nf90_put_var(ncsat_id, sataltvar_id, transpose(altrec(1:nrec,:)), (/1,spointer/), (/nlayermax,nrec/) ) ) + ! average number of particles all timesteps for each receptor + call nf90_err( nf90_put_var(ncsat_id, satnnvar_id, transpose(nnrec(1:nrec,1:nlayermax-1)),& + (/1,spointer/), (/nlayermax-1,nrec/) ) ) + ! average kernel all timesteps + call nf90_err( nf90_put_var(ncsat_id, satxkvar_id, transpose(xkrec(1:nrec,1:nlayermax-1)), & + (/1,spointer/), (/nlayermax-1,nrec/) ) ) + + end subroutine write_satellite_netcdf + + + !***************************************************************************** + + subroutine close_receptor_netcdf + + call nf90_err( nf90_close(nc_id) ) + + end subroutine close_receptor_netcdf + + !***************************************************************************** + + subroutine close_satellite_netcdf + + call nf90_err( nf90_close(ncsat_id) ) + + end subroutine close_satellite_netcdf + + !***************************************************************************** + + + subroutine read_satellite_info + + !***************************************************************************** + ! * + ! This routine reads the satellite information for which satellite * + ! retrievals should be read * + ! * + ! Author: R. Thompson * + ! October 2023 * + ! * + !***************************************************************************** + + implicit none + + character(len=256) :: ppath, pfile + character(len=8) :: psatname + integer :: readerror, writeerror + integer :: j + integer,parameter :: unitreceptorout=2 + logical :: lexist + + ! declare namelist + namelist /satellites/ psatname, ppath, pfile + + ! For backward runs, do not allow receptor output + !************************************************ + + if (ldirect.lt.0) then + return + endif + + ! Open the SATELLITES file and read path and file info + !***************************************************** + + open(unitreceptor,file=path(1)(1:length(1))//'SATELLITES',form='formatted',status='old',iostat=readerror) + + if (readerror.ne.0) then + write(*,*) 'FLEXPART WARNING read_satellite_info: no satellite file found' + return + endif + + ! try namelist input + read(unitreceptor,satellites,iostat=readerror) + close(unitreceptor) + + if (readerror.ne.0) then + write(*,*) ' #### FLEXPART ERROR in read_satellite_info: #### ' + write(*,*) ' #### error in namelist input #### ' + error stop + endif ! only namelist input + + + ! prepare namelist output if requested + if (nmlout) then + open(unitreceptorout,file=path(2)(1:length(2))//'SATELLITES.namelist',& + &access='append',status='replace',iostat=writeerror) + if (writeerror.ne.0) then + write(*,*) ' #### FLEXPART ERROR read_satellite_info: cannot open file #### ' + write(*,*) ' #### '//trim(path(2)(1:length(2)))//'SATELLITES.namelist #### ' + error stop + endif + endif + + ! Get number of satellites + !************************* + + numsatellite=0 + open (unitreceptor,file=trim(path(1))//'SATELLITES',status='old',iostat=readerror) + j=0 + do while (readerror.eq.0) + read(unitreceptor,satellites,iostat=readerror) + if (readerror.ne.0) exit + j=j+1 + end do + numsatellite=j + write(*,*) 'Number of satellites: ',numsatellite + close(unitreceptor) + + ! Allocate arrays + !**************** + + allocate(sat_name(numsatellite),sat_path(numsatellite),sat_file(numsatellite)) + allocate(nnsatlayer(numsatellite)) + + ! Read satellite info + !******************** + + open(unitreceptor,file=path(1)(1:length(1))//'SATELLITES',form='formatted',status='old',iostat=readerror) + j=0 + do while (readerror.eq.0) + read(unitreceptor,satellites,iostat=readerror) + if (readerror.ne.0) exit + j=j+1 + write(*,*) 'read_satellite_info: psatname, ppath = ',trim(psatname),', ',trim(ppath) + sat_name(j)=trim(psatname) + sat_path(j)=trim(ppath) + sat_file(j)=trim(pfile) + ! namelist output + if (nmlout) then + write(unitreceptorout,nml=satellites) + endif + end do + close(unitreceptor) + close(unitreceptorout) + + end subroutine read_satellite_info + + + subroutine readreceptors_satellite(itime) + + !***************************************************************************** + ! * + ! This routine reads the satellite retrieval information for which * + ! mixing ratios should be modelled * + ! * + ! Author: R. Thompson * + ! October 2023 * + ! * + !***************************************************************************** + + use binary_output_mod, only: satelliteout_init_binary + + implicit none + + integer :: itime + character(len=256) :: file_name + character(len=6) :: anretr + character(len=8) :: adate + integer :: jjjjmmdd, hhmmss, yyyy, mm, dd + integer :: nc_id, dimid, varid + real :: xm, ym + real(kind=dp) :: jul, jd, curday + real, allocatable, dimension(:,:) :: xpts, ypts, zpt1, zpt2 + integer, allocatable, dimension(:) :: npt, sdate, stime + integer :: stat + integer :: j, nn, nr, nretr, nlayer, tmp_numsat + logical :: lexist + real, allocatable, dimension(:) :: tmp_xsat, tmp_ysat, tmp_satarea + real, allocatable, dimension(:,:) :: tmp_zsat + integer, allocatable, dimension(:) :: tmp_tsat + character(len=24), allocatable, dimension(:) :: tmp_satname + + ! For backward runs, do not allow receptor output + !************************************************ + + if (ldirect.lt.0) then + return + endif + + ! If no satellites do nothing + !**************************** + + if (numsatellite.eq.0) then + return + endif + + ! Check if retrievals already in memory for current day + !****************************************************** + + ! If itime is a full day do not update retrievals + print*, 'readreceptors_satellite: mod = ',mod(real(itime),86400.) + if ((itime.ne.0).and.(mod(real(itime),86400.).eq.0)) then + return + endif + + curday=bdate+real(itime,kind=dp)/86400._dp + curday=floor(curday) + print*, 'readreceptors_satellite: curday = ',curday + print*, 'readreceptors_satellite: memsatday = ',memsatday + + if (memsatday.eq.curday ) then + ! The retrievals for the current day are in memory -> don't do anything + return + endif + memsatday=curday + + ! Get number of satellite receptors + !********************************** + + ! Loop over satellites + jd=curday + tmp_numsat=0 + do j=1,numsatellite + ! get filename for current day + call caldate(jd, jjjjmmdd, hhmmss) + write(adate,'(I8.8)') jjjjmmdd + file_name=sat_file(j) + call getfilename(jjjjmmdd, file_name) + write(*,*) 'readreceptors_satellite: file_name = ',file_name + inquire(file=trim(sat_path(j))//'/'//trim(file_name),exist=lexist) + if (.not.lexist) then + write(*,*) 'readreceptors_satellite: no retrievals file for '//adate + cycle + endif + ! open file + call nf90_err( nf90_open(trim(sat_path(j))//'/'//trim(file_name), nf90_nowrite, nc_id) ) + ! read dimensions + call nf90_err( nf90_inq_dimid(nc_id, 'retrieval', dimid) ) + call nf90_err( nf90_inquire_dimension(nc_id, dimid, len=nretr) ) + call nf90_err( nf90_inq_dimid(nc_id, 'nlayer', dimid) ) + call nf90_err( nf90_inquire_dimension(nc_id, dimid, len=nlayer) ) + tmp_numsat=tmp_numsat+nretr + ! Define nlayermax only for first day (must not change by day) + if (jd.eq.bdate) then + nlayermax=max(nlayermax,nlayer) + nnsatlayer(j)=nlayer + endif + call nf90_err(nf90_close(nc_id)) + end do + if (jd.eq.bdate) then + nlayermax=nlayermax+1 ! for levels + endif + print*, 'readreceptors_satellite: nlayermax = ',nlayermax + + ! Initialize satellite output + !**************************** + + ! Only do once + print*, 'readreceptors_satellite: jd, bdate = ',jd, bdate + if (jd.eq.bdate) then + print*, 'readreceptors_satellite: allocating satellite variables' + call alloc_satellite + if (lnetcdfout.eq.1) then +#ifdef USE_NCF + print*, 'readreceptors_satellite: initialising output file' + call satelliteout_init +#endif + else + print*, 'readreceptors_satellite: initialising binary output file' + call satelliteout_init_binary + endif + endif + + ! Allocate temporary arrays + !************************** + + allocate(tmp_xsat(tmp_numsat),tmp_ysat(tmp_numsat),& + tmp_tsat(tmp_numsat),tmp_satarea(tmp_numsat),& + tmp_zsat(nlayermax,tmp_numsat),tmp_satname(tmp_numsat)) + + ! Deallocate existing satellite arrays + !************************************* + + if (allocated(xsatellite)) then + deallocate(xsatellite,ysatellite,& + tsatellite,satellitearea,& + zsatellite,satellitename) + endif + + ! Read satellite retrievals info + !******************************* + + numsatreceptor=0 + jd=curday + call caldate(jd, jjjjmmdd, hhmmss) + write(adate,'(I8.8)') jjjjmmdd + print*, 'readreceptors_satellite: adate = ',adate + + do j=1,numsatellite + + ! get filename for current day + ! assumes same format as output from prep_satellite + call caldate(jd, jjjjmmdd, hhmmss) + file_name=sat_file(j) + call getfilename(jjjjmmdd, file_name) + write(*,*) 'readreceptors_satellite: file_name = ',file_name + inquire(file=trim(sat_path(j))//'/'//trim(file_name),exist=lexist) + if (.not.lexist) then + write(*,*) 'readreceptors_satellite: no retrievals file for '//adate + cycle + endif + + ! open file + call nf90_err( nf90_open(trim(sat_path(j))//'/'//trim(file_name), nf90_nowrite, nc_id) ) + + ! read dimensions + call nf90_err( nf90_inq_dimid(nc_id, 'retrieval', dimid) ) + call nf90_err( nf90_inquire_dimension(nc_id, dimid, len=nretr) ) + call nf90_err( nf90_inq_dimid(nc_id, 'nlayer', dimid) ) + call nf90_err( nf90_inquire_dimension(nc_id, dimid, len=nlayer) ) + print*, 'readreceptors_satellite: nretr = ',nretr + + ! allocate temporary variables + allocate(sdate(nretr),stat=stat) + if (stat.ne.0) write(*,*)'ERROR: could not allocate sdate' + allocate(stime(nretr),stat=stat) + if (stat.ne.0) write(*,*)'ERROR: could not allocate stime' + allocate(xpts(nretr,4),stat=stat) + if (stat.ne.0) write(*,*)'ERROR: could not allocate xpts' + allocate(ypts(nretr,4),stat=stat) + if (stat.ne.0) write(*,*)'ERROR: could not allocate ypts' + allocate(zpt1(nretr,nlayer),stat=stat) + if (stat.ne.0) write(*,*)'ERROR: could not allocate zpt1' + allocate(zpt2(nretr,nlayer),stat=stat) + if (stat.ne.0) write(*,*)'ERROR: could not allocate zpt2' + + ! read coordinate variables + call nf90_err( nf90_inq_varid(nc_id,'idate',varid) ) + call nf90_err( nf90_get_var(nc_id,varid,sdate) ) + call nf90_err( nf90_inq_varid(nc_id,'itime',varid) ) + call nf90_err( nf90_get_var(nc_id,varid,stime) ) + call nf90_err( nf90_inq_varid(nc_id,'xpoints',varid) ) + call nf90_err( nf90_get_var(nc_id,varid,xpts) ) + call nf90_err( nf90_inq_varid(nc_id,'ypoints',varid) ) + call nf90_err( nf90_get_var(nc_id,varid,ypts) ) + call nf90_err( nf90_inq_varid(nc_id,'zpoint1',varid) ) + call nf90_err( nf90_get_var(nc_id,varid,zpt1) ) + call nf90_err( nf90_inq_varid(nc_id,'zpoint2',varid) ) + call nf90_err( nf90_get_var(nc_id,varid,zpt2) ) + call nf90_err( nf90_close(nc_id) ) + + ! write to coordinates receptor variables + do nr=1,nretr + jul=juldate(sdate(nr),stime(nr)) + ! skip retrievals not for current day + if (floor(jul).ne.curday) cycle + numsatreceptor=numsatreceptor+1 + write(anretr,'(I6.6)') nr + tmp_satname(numsatreceptor)=trim(sat_name(j))//'_'//adate//'_'//anretr + tmp_tsat(numsatreceptor)=int((jul-bdate)*24.*3600.) ! time in sec + ! transform to grid coordinates + tmp_xsat(numsatreceptor)=(sum(xpts(nr,:))/4.-xlon0)/dx + tmp_ysat(numsatreceptor)=(sum(ypts(nr,:))/4.-ylat0)/dy + ! vertical coordinates layer boundaries in Pa + tmp_zsat(1:nlayer,numsatreceptor)=zpt1(nr,:) + tmp_zsat(nlayer+1,numsatreceptor)=zpt2(nr,nlayer) + ! area for mixing ratio calc (used if ind_samp = -1) + xm=r_earth*cos((sum(ypts(nr,:))/4.)*pi/180.)*dx/180.*pi + ym=r_earth*dy/180.*pi + tmp_satarea(numsatreceptor)=xm*ym + end do ! nretr + + deallocate(sdate, stime, xpts, ypts, zpt1, zpt2) + + end do ! numsatellite + + write(*,*) 'readreceptors_satellite: numsatreceptor = ',numsatreceptor + + ! Reallocate satellite arrays to actual size + !******************************************* + + allocate(xsatellite(numsatreceptor),ysatellite(numsatreceptor),& + tsatellite(numsatreceptor),satellitearea(numsatreceptor),& + zsatellite(nlayermax,numsatreceptor),satellitename(numsatreceptor)) + + xsatellite=tmp_xsat(1:numsatreceptor) + ysatellite=tmp_ysat(1:numsatreceptor) + tsatellite=tmp_tsat(1:numsatreceptor) + satellitearea=tmp_satarea(1:numsatreceptor) + zsatellite=tmp_zsat(:,1:numsatreceptor) + satellitename=tmp_satname(1:numsatreceptor) + + deallocate(tmp_xsat,tmp_ysat,tmp_tsat,tmp_satarea,tmp_zsat,tmp_satname) + + ! Transform vertical coordinates of satellite receptors + !****************************************************** + + if (numsatreceptor.gt.0) then + call verttransform_satellite + endif + + end subroutine readreceptors_satellite + + + subroutine getfilename(jjjjmmdd,file_name) + + !***************************************************************************** + ! * + ! Get actual filename based on dates from generic name * + ! * + ! Author: R. Thompson, Sep-2023 * + ! * + ! * + !***************************************************************************** + + implicit none + + character(len=256) :: file_name, strtmp1, strtmp2 + character(len=4) :: ayear + character(len=2) :: amonth, aday + integer :: jjjjmmdd, yyyy, mm, dd, nn + + yyyy=jjjjmmdd/10000 + mm=(jjjjmmdd-yyyy*10000)/100 + dd=jjjjmmdd-yyyy*10000-mm*100 + write(ayear,'(I4)') yyyy + write(amonth,'(I2.2)') mm + write(aday,'(I2.2)') dd + nn=index(file_name,'YYYY',back=.false.) + if (nn.ne.0) then + strtmp1=file_name(1:nn-1) + nn=index(file_name,'YYYY',back=.true.) + strtmp2=file_name(nn+4:len_trim(file_name)) + file_name=trim(strtmp1)//ayear//trim(strtmp2) + endif + nn=index(file_name,'MM',back=.false.) + if (nn.ne.0) then + strtmp1=file_name(1:nn-1) + nn=index(file_name,'MM',back=.true.) + strtmp2=file_name(nn+2:len_trim(file_name)) + file_name=trim(strtmp1)//amonth//trim(strtmp2) + endif + nn=index(file_name,'DD',back=.false.) + if (nn.ne.0) then + strtmp1=file_name(1:nn-1) + nn=index(file_name,'DD',back=.true.) + strtmp2=file_name(nn+2:len_trim(file_name)) + file_name=trim(strtmp1)//aday//trim(strtmp2) + endif + + end subroutine getfilename + + + subroutine verttransform_satellite + + !***************************************************************************** + ! * + ! This routine transforms the vertical coordinate of the satellite * + ! receptors from pressure to height above ground * + ! * + ! Author: R. Thompson * + ! October 2023 * + ! * + !***************************************************************************** + + implicit none + + integer :: nr, nn, nl, kz, nchar + integer :: numsatlayer + integer :: ix, jy, ixp, jyp + real :: p1, p2, p3, p4, ddx, ddy, rddx, rddy, dz1, dz2 + real :: press, pressold, zpres + +!$OMP PARALLEL & +!$OMP PRIVATE(nr,nn,nchar,numsatlayer,nl,zpres,ix,jy,ddx,ddy,ixp,jyp,rddx,rddy,& +!$OMP p1,p2,p3,p4,kz,press,pressold,dz1,dz2) + +!$OMP DO + do nr=1,numsatreceptor + + ! get actual number vertical layers for this retrieval + do nn=1,numsatellite + nchar=len_trim(sat_name(nn)) + if (satellitename(nr)(1:nchar).eq.trim(sat_name(nn))) then + numsatlayer=nnsatlayer(nn) + exit + endif + end do + + do nl=1,(numsatlayer+1) + + ! pressure of level in Pa + zpres=zsatellite(nl,nr) + ix=int(xsatellite(nr)) + jy=int(ysatellite(nr)) + ddx=xsatellite(nr)-real(ix) + ddy=ysatellite(nr)-real(jy) + ixp=ix+1 + jyp=jy+1 + rddx=1.-ddx + rddy=1.-ddy + p1=rddx*rddy + p2=ddx*rddy + p3=rddx*ddy + p4=ddx*ddy + + ! use pressure from second field regardless of time stamp + ! think this is adequate otherwise need to transform just + ! for retrievals in recoutaverage interval before calling receptorcalc + do kz=1,nz + press=p1*prs(ix,jy,kz,2) & + +p2*prs(ixp,jy,kz,2) & + +p3*prs(ix,jyp,kz,2) & + +p4*prs(ixp,jyp,kz,2) + if (kz.eq.1) pressold=press + if (press.lt.zpres) then + if (kz.eq.1) then + zsatellite(nl,nr)=height(1)/2. + else + dz1=pressold-zpres + dz2=zpres-press + zsatellite(nl,nr)=(height(kz-1)*dz2+height(kz)*dz1)/(dz1+dz2) + endif + exit ! found height end loop over nz + endif + pressold=press + end do ! nz + if ((kz.gt.nz).and.(zpres.le.press)) then + ! ztra1 press less than top of windfield press + zsatellite(nl,nr)=0.5*(height(nz-1)+height(nz)) + endif + + end do ! numsatlayer + + !! testing + if (nr.lt.20) print*, 'zsatellite after transform = ',zsatellite(:,nr) + + end do ! numsatreceptor +!$OMP END DO +!$OMP END PARALLEL + + end subroutine verttransform_satellite + +end module receptor_netcdf_mod + diff --git a/src/restart_mod.f90 b/src/restart_mod.f90 index 70b2ecfd4940aafc2810f1681ce4eb0df97ec6fa..6236394cbb8f4195b9aab4e56846fff39fa47c08 100644 --- a/src/restart_mod.f90 +++ b/src/restart_mod.f90 @@ -1,4 +1,15 @@ +! SPDX-FileCopyrightText: FLEXPART 1998-2019, see flexpart_license.txt +! SPDX-License-Identifier: GPL-3.0-or-later + module restart_mod + + !***************************************************************************** + ! * + ! This module write variables to file for eventual restart, and reads * + ! these variables from file in case of restart * + ! * + !***************************************************************************** + use particle_mod #ifdef ETA use coord_ecmwf_mod @@ -14,13 +25,13 @@ module restart_mod contains -subroutine output_restart(itime,loutnext,outnum) +subroutine output_restart(itime,loutnext,lrecoutnext,outnum) implicit none - integer, intent(in) :: itime,loutnext + integer, intent(in) :: itime,loutnext,lrecoutnext real, intent(in) :: outnum - integer :: i,j,jjjjmmdd,ihmmss + integer :: imax,i,j,jjjjmmdd,ihmmss,ipart,iwritten integer :: ks,kp,kz,nage,jy,ix,l,n real(kind=dp) :: jul character :: adate*8,atime*6 @@ -37,41 +48,71 @@ subroutine output_restart(itime,loutnext,outnum) write(*,*) 'Writing Restart file:', trim(restart_filename1) +#ifdef ETA +!$OMP PARALLEL PRIVATE(i,j) +!$OMP DO + do j=1,count%alive + i=count%ialive(j) + if (part(i)%alive) then + call update_zeta_to_z(itime,i) + call update_z_to_zeta(itime,i) + endif + end do +!$OMP END DO +!$OMP END PARALLEL +#endif + open(unitrestart,file=restart_filename1,form='unformatted') + !Get largest live particle number for allocation new start + + imax=0 + iwritten=0 + do ipart=1,count%allocated + if ((ipout.gt.0).and.(n_average.gt.0)) then + if((.not. part(ipart)%alive).and.(abs(part(ipart)%tend-itime).ge.ipoutfac*loutstep)) & + cycle + else + if (.not. part(ipart)%alive) cycle + endif + if (ipart.gt.imax) imax=ipart + iwritten=iwritten+1 + end do ! Write current time to file !*************************** - write(unitrestart) itime - write(unitrestart) count%allocated + write(unitrestart) imax + write(unitrestart) iwritten write(unitrestart) loutnext + write(unitrestart) lrecoutnext write(unitrestart) outnum - write(unitrestart) numreceptor - - do i=1,count%allocated -#ifdef ETA - if (part(i)%alive) then - call update_zeta_to_z(itime,i) - call update_z_to_zeta(itime,i) + do ipart=1,imax + if ((ipout.gt.0).and.(n_average.gt.0)) then + if((.not. part(ipart)%alive).and.(abs(part(ipart)%tend-itime).ge.ipoutfac*loutstep)) & + cycle + else + if (.not. part(ipart)%alive) cycle endif -#endif - write(unitrestart) part(i)%xlon,part(i)%ylat,part(i)%z, & + write(unitrestart) ipart + write(unitrestart) part(ipart)%xlon,part(ipart)%ylat,part(ipart)%z, & #ifdef ETA - part(i)%zeta, & + part(ipart)%zeta, & #endif - part(i)%npoint,part(i)%nclass,part(i)%idt,part(i)%tend, & - part(i)%tstart,part(i)%alive,part(i)%turbvel%u, & - part(i)%turbvel%v,part(i)%turbvel%w,part(i)%mesovel%u, & - part(i)%mesovel%v,part(i)%mesovel%w,(part(i)%mass(j),j=1,nspec), & - (part(i)%mass_init(j),j=1,nspec) - if (wetdep) write(unitrestart) (part(i)%wetdepo(j),j=1,nspec) - if (drydep) write(unitrestart) (part(i)%drydepo(j),j=1,nspec) + part(ipart)%npoint,part(ipart)%nclass,part(ipart)%idt,part(ipart)%tend, & + part(ipart)%tstart,part(ipart)%alive,part(ipart)%turbvel%u, & + part(ipart)%turbvel%v,part(ipart)%turbvel%w,part(ipart)%mesovel%u, & + part(ipart)%mesovel%v,part(ipart)%mesovel%w,(mass(ipart,j),j=1,nspec), & + (mass_init(ipart,j),j=1,nspec) + if (wetdep) write(unitrestart) (wetdeposit(ipart,j),j=1,nspec) + if (drydep) write(unitrestart) (drydeposit(ipart,j),j=1,nspec) + if ((drybkdep).or.(wetbkdep)) write(unitrestart) (xscav_frac1(ipart,j),j=1,nspec) end do if (iout.gt.0) then #ifdef USE_NCF if (lnetcdfout.eq.1) write(unitrestart) tpointer #endif + do ks=1,nspec do kp=1,maxpointspec_act do nage=1,nageclass @@ -129,16 +170,6 @@ subroutine output_restart(itime,loutnext,outnum) end do endif end do - if ((drybkdep).or.(wetbkdep)) then - do i=1,count%allocated - write(unitrestart) xscav_frac1(i,ks) - end do - endif - if (numreceptor.gt.0) then - do n=1,numreceptor - write(unitrestart) creceptor(n,ks) - end do - endif end do endif close(unitrestart) @@ -161,10 +192,11 @@ subroutine readrestart implicit none - integer :: i,j,ios - integer :: id1,id2,it1,it2 + integer :: i,j,ipart,ios,iterminate + integer :: id1,id2,it1,it2,imax integer :: ks,kp,kz,nage,jy,ix,l,n real(kind=dp) :: julin + real :: a numparticlecount=0 @@ -175,37 +207,37 @@ subroutine readrestart write(*,*) 'Reading Restart file:', path(2)(1:length(2))//'restart.bin' read(unitpartin,iostat=ios) itime_init - read(unitpartin) numpart ! count%allocated + read(unitpartin) imax ! count%alive + read(unitpartin) numpart read(unitpartin) loutnext_init + read(unitpartin) lrecoutnext_init read(unitpartin) outnum_init - read(unitpartin) numreceptor - call spawn_particles(itime_init, numpart) + count%alive=numpart + count%spawned=numpart + if (count%allocated.lt.imax) call alloc_particles(imax-count%allocated) do i=1,numpart - read(unitpartin) part(i)%xlon,part(i)%ylat,part(i)%z, & + read(unitpartin) ipart + read(unitpartin) part(ipart)%xlon,part(ipart)%ylat,part(ipart)%z, & #ifdef ETA - part(i)%zeta, & + part(ipart)%zeta, & #endif - part(i)%npoint,part(i)%nclass,part(i)%idt,part(i)%tend, & - part(i)%tstart,part(i)%alive,part(i)%turbvel%u, & - part(i)%turbvel%v,part(i)%turbvel%w,part(i)%mesovel%u, & - part(i)%mesovel%v,part(i)%mesovel%w,(part(i)%mass(j),j=1,nspec), & - (part(i)%mass_init(j),j=1,nspec) - if (wetdep) read(unitrestart) (part(i)%wetdepo(j),j=1,nspec) - if (drydep) read(unitrestart) (part(i)%drydepo(j),j=1,nspec) + part(ipart)%npoint,part(ipart)%nclass,part(ipart)%idt,part(ipart)%tend, & + part(ipart)%tstart,part(ipart)%alive,part(ipart)%turbvel%u, & + part(ipart)%turbvel%v,part(ipart)%turbvel%w,part(ipart)%mesovel%u, & + part(ipart)%mesovel%v,part(ipart)%mesovel%w,(mass(ipart,j),j=1,nspec), & + (mass_init(ipart,j),j=1,nspec) + part(ipart)%spawned = .true. + if (wetdep) read(unitpartin) (wetdeposit(ipart,j),j=1,nspec) + if (drydep) read(unitpartin) (drydeposit(ipart,j),j=1,nspec) + if ((drybkdep).or.(wetbkdep)) read(unitpartin) (xscav_frac1(ipart,j),j=1,nspec) + #ifdef ETA - part(i)%etaupdate=.true. - part(i)%meterupdate=.true. + part(ipart)%etaupdate=.true. + part(ipart)%meterupdate=.true. #endif - if (.not. part(i)%alive) then - if (part(i)%tstart.le.itime_init) then - call terminate_particle(i,part(i)%tend) - else ! Particle is not spawned yet (original run with ipin=3) - count%alive = count%alive - 1 - count%spawned = count%spawned -1 - endif - endif end do + if (iout.gt.0) then #ifdef USE_NCF if (lnetcdfout.eq.1) read(unitpartin) tpointer @@ -267,11 +299,6 @@ subroutine readrestart end do endif end do - if ((drybkdep).or.(wetbkdep)) then - do i=1,numpart - read(unitpartin) xscav_frac1(i,ks) - end do - endif if (numreceptor.gt.0) then do n=1,numreceptor read(unitpartin) creceptor(n,ks) @@ -281,6 +308,18 @@ subroutine readrestart endif close(unitpartin) + iterminate=0 + do i=1,numpart + if (.not. part(i)%alive) then + if (part(i)%tstart.le.itime_init) then + call terminate_particle(i,part(i)%tend) + iterminate=iterminate+1 + endif + endif + end do + + call rewrite_ialive() + count%spawned=count%spawned-iterminate numpart=count%spawned julin=juldate(ibdate,ibtime)+real(itime_init,kind=dp)/86400._dp @@ -306,4 +345,4 @@ subroutine readrestart write(*,*) ' #### RESTART FILE TO restart.bin. #### ' end subroutine readrestart -end module restart_mod \ No newline at end of file +end module restart_mod diff --git a/src/settling_mod.f90 b/src/settling_mod.f90 index 3496dac46da62ab48fc92e91c21cdbe3f034c2cd..1b8cbafd0e2367e43648c70486e31a0dfaec1af6 100644 --- a/src/settling_mod.f90 +++ b/src/settling_mod.f90 @@ -268,8 +268,8 @@ subroutine get_settling(xt,yt,zt,nsp,settling) alpha1=0.45+10.0/(exp(2.5*log10(dfdr))+30.0) beta1=1.-37.0/(exp(3.0*log10(dfdr))+100.0) kn1=10.**(alpha1*(-log10(Fn(nsp)))**beta1) - ks=(ks1(nsp)+ks2(nsp))/2. - kn=(kn1+kn2(nsp))/2. + ks=(ks1(nsp)+ks2(nsp))*0.5 + kn=(kn1+kn2(nsp))*0.5 endif do i=1,20 diff --git a/src/sort_mod.f90 b/src/sort_mod.f90 index 14b16f9725546de8e0b9d3475e1a843ea1d1a02d..d34ecf9c6eedbc16e712d957ffe58aeb6634c907 100644 --- a/src/sort_mod.f90 +++ b/src/sort_mod.f90 @@ -90,10 +90,11 @@ contains integer, intent(in) :: n integer, intent(inout) :: arr(n),brr(n) integer, dimension(:) :: brrout(n), work(n/2) + integer(int_size), dimension(:) :: iwork(0:n/2-1) integer(int_size), dimension(:) :: iarr(n) integer :: i - call sort_index(arr, iarr, work) + call sort_index(arr, iarr, work, iwork) do i=1,n brrout(i) = brr(iarr(i)) diff --git a/src/timemanager_mod.f90 b/src/timemanager_mod.f90 index f66293dd2de4d9f66b9df7a0aed1865520808856..e7666b688d1c379777df04e925a574a52e7af7ea 100644 --- a/src/timemanager_mod.f90 +++ b/src/timemanager_mod.f90 @@ -71,6 +71,8 @@ subroutine timemanager ! in the particle loop * ! nstop1 serves as indicator for wind fields (see getfields) * ! outnum number of samples for each concentration calculation * + ! recoutnum number of samples for each receptor calculation * + ! recoutnumsat number of samples for each satellite calculation * ! prob probability of absorption at ground due to dry * ! deposition * ! WETDEP .true. if wet deposition is switched on * @@ -85,7 +87,7 @@ subroutine timemanager use xmass_mod use flux_mod use outgrid_mod - use ohr_mod +! use ohr_mod use par_mod use com_mod #ifdef ETA @@ -103,18 +105,29 @@ subroutine timemanager use output_mod use restart_mod use interpol_mod, only: alloc_interpol,dealloc_interpol +#ifdef USE_NCF + use chemistry_mod + use initdomain_mod + use receptor_netcdf_mod, only: readreceptors_satellite, verttransform_satellite + use emissions_mod + use totals_mod +#endif + use receptor_mod, only: receptoroutput implicit none real, parameter :: & e_inv = 1.0/exp(1.0) integer :: & j,i, & ! loop variables + iterminate, & ! Keep track of terminated particles per timestep ks, & ! loop variable species kp, & ! loop variable for maxpointspec_act itime=0, & ! time index nstop1, & ! windfield existence flag loutnext, & ! following timestep loutstart,loutend, & ! concentration calculation starting and ending time + lrecoutnext, & ! following timestep for receptor output + lrecoutstart,lrecoutend,& ! receptor calculation interval start and end time ldeltat, & ! radioactive decay time itage,nage,inage, & ! related to age classes i_nan=0,ii_nan,total_nan_intl=0, & !added by mc to check instability in CBL scheme @@ -129,23 +142,32 @@ subroutine timemanager ! integer :: & ! jjjjmmdd,ihmmss real :: & - outnum, & ! concentration calculation sample number + outnum, & ! number of samples for grid concentration calculation prob_rec(maxspec), & ! dry deposition related xmassfract ! dry deposition related real(dep_prec),allocatable,dimension(:) :: & - drydeposit ! dry deposition related + drytmp ! dry deposition related + logical :: itsopen + real, dimension(maxrecsample) :: recoutnum ! number of samples for receptor calculation + real, allocatable, dimension(:,:) :: recoutnumsat ! number of samples for satellite receptor calculation ! First output for time 0 !************************ if (itime_init.ne.0) then loutnext=loutnext_init + lrecoutnext=lrecoutnext_init outnum=outnum_init else loutnext=loutstep/2 + lrecoutnext=lrecoutstep/2 outnum=0. + recoutnum(:)=0. +! recoutnumsat(:,:)=0. endif loutstart=loutnext-loutaver/2 loutend=loutnext+loutaver/2 + lrecoutstart=lrecoutnext-lrecoutaver/2 + lrecoutend=lrecoutnext+lrecoutaver/2 ! Initialise the nan count for CBL option !**************************************** @@ -191,12 +213,9 @@ subroutine timemanager ! Writing restart file !********************* if ((itime.ne.itime_init).and.(loutrestart.ne.-1).and.(mod(itime,loutrestart).eq.0)) then - call output_restart(itime,loutnext,outnum) + call output_restart(itime,loutnext,lrecoutnext,outnum) endif - ! if ((itime.ne.0).and.(count%alive.gt.0)) then - ! if (part(1)%alive) write(*,*) 'xlon,ylat,z,zeta', part(1)%xlon,part(1)%ylat,part(1)%z,part(1)%zeta - ! endif call init_output(itime,filesize) ! Get necessary wind fields if not available @@ -209,12 +228,18 @@ subroutine timemanager #ifdef ETA if ((itime.eq.itime_init).and.((ipin.eq.1).or.(ipin.eq.3).or.(ipin.eq.4))) then - if (numpart.le.0) error stop 'Something is going wrong reading the old particle file! & + if (count%allocated.le.0) error stop 'Something is going wrong reading the old particle file! & &No particles found.' !$OMP PARALLEL PRIVATE(i) !$OMP DO do i=1,count%allocated ! Also includes particles that are not spawned yet - call update_z_to_zeta(itime, i) + ! If kindz>1, vertical positions computation + if (ipin.eq.3 .or. ipin.eq.4) call kindz_to_z(i) +#ifdef ETA + call z_to_zeta(itime,part(i)%xlon,part(i)%ylat,part(i)%z,part(i)%zeta) + part(i)%etaupdate = .true. + part(i)%meterupdate = .true. +#endif end do !$OMP END DO !$OMP END PARALLEL @@ -225,27 +250,76 @@ subroutine timemanager call wetdepo(itime,lsynctime,loutnext) endif - if (OHREA .and. (itime.ne.0) .and. (numpart.gt.0)) & - call ohreaction(itime,lsynctime,loutnext) + ! compute chemical losses + !************************ +#ifdef USE_NCF + if (CLREA .and. (itime.ne.0) .and. (numpart.gt.0)) then + call chemreaction(itime) + endif +#endif ! compute convection for backward runs !************************************* if ((ldirect.eq.-1).and.(lconvection.eq.1).and.(itime.lt.0)) then - call convmix(itime) !OMP, conv_mod.f90 + call convmix(itime) endif - ! Get hourly OH fields if not available - !**************************************************** - if (OHREA) then - call gethourlyOH(itime) + ! Get chemical fields if not available + !************************************* +#ifdef USE_NCF + if (CLREA) then + call getchemfield(itime) + call getchemhourly(itime) endif +#endif + ! Get emission fields if not available + !************************************* + +#ifdef USE_NCF + if (LEMIS.and.mdomainfill.eq.1) then + call getemissions(itime) + endif +#endif + + ! Read satellite receptors + !************************* + +#ifdef USE_NCF + call readreceptors_satellite(itime) +#endif + if (.not.allocated(recoutnumsat)) then + allocate(recoutnumsat(nlayermax,maxrecsample)) + recoutnumsat(:,:)=0. + endif + ! Release particles !****************** if (mdomainfill.ge.1) then - if (itime.eq.itime_init) then - call init_domainfill + if (itime.eq.itime_init) then + if (llcmoutput) then +#ifdef USE_NCF + call init_domainfill_ncf +#else + call init_domainfill +#endif + else + call init_domainfill + endif + if (ipin.eq.2) then + ! Particles initialized from partoutput +#ifdef ETA +!$OMP PARALLEL PRIVATE(i,j) +!$OMP DO + do i=1,count%alive + j=count%ialive(i) + call update_z_to_zeta(itime,j) + end do +!$OMP END DO +!$OMP END PARALLEL +#endif + endif else call boundcond_domainfill(itime,loutend) endif @@ -259,15 +333,17 @@ subroutine timemanager if (ldirect.lt.0) then if ((part(i)%tstart.le.itime).and.(part(i)%tstart.gt.itime+lsynctime)) then call spawn_particle(itime,i) + call init_mass_conversion(i,part(i)%npoint) endif else if ((part(i)%tstart.ge.itime).and.(part(i)%tstart.lt.itime+lsynctime)) then call spawn_particle(itime,i) + call init_mass_conversion(i,part(i)%npoint) endif endif end do #ifdef ETA -!$OMP PARALLEL PRIVATE(i) +!$OMP PARALLEL PRIVATE(i,j) !$OMP DO do i=1,count%alive j=count%ialive(i) @@ -283,6 +359,15 @@ subroutine timemanager call releaseparticles(itime) endif + ! Inject emissions + !***************** + +#ifdef USE_NCF + if (LEMIS.and.mdomainfill.eq.1) then + call emissions(itime) + endif +#endif + ! Compute convective mixing for forward runs ! for backward runs it is done before next windfield is read in !************************************************************** @@ -307,7 +392,7 @@ subroutine timemanager if ((iout.eq.4).or.(iout.eq.5)) call plumetraj(itime) if (iflux.eq.1) call fluxoutput(itime) - if (ipout.ge.1) then + if (ipout.eq.1) then if (mod(itime,ipoutfac*loutstep).eq.0) then call output_particles(itime)!,active_per_rel) ! dump particle positions @@ -321,6 +406,15 @@ subroutine timemanager s_writepart = s_writepart + ((count_clock - count_clock0)/real(count_rate)-s_temp) endif + ! Check whether receptor concentrations are to be calculated + !*********************************************************** + + if ((ldirect*itime.ge.ldirect*lrecoutstart).and. & + ((numreceptor.gt.0.).or.(numsatreceptor.gt.0)).and. & + (ldirect*itime.le.ldirect*lrecoutend)) then + call receptoroutput(itime,lrecoutstart,lrecoutend,lrecoutnext,recoutnum,recoutnumsat) + endif + if (itime.eq.ideltas) exit ! almost finished ! Compute interval since radioactive decay of deposited mass was computed @@ -345,8 +439,7 @@ subroutine timemanager !----------------------------------------------------------------------------- ! openmp change - ! LB, openmp following CTM version, need to be very careful due to big differences - ! between the openmp loop in this and the CTM version + ! LB, openmp following CTM version !$OMP PARALLEL PRIVATE(prob_rec,inage,nage,itage,ks,kp,thread,j,i,xmassfract) #if (defined _OPENMP) @@ -355,7 +448,7 @@ subroutine timemanager thread = 0 #endif -!$OMP DO +!$OMP DO SCHEDULE(dynamic,max(1,numpart/1000)) ! SCHEDULE(dynamic, max(1,numpart/1000)) !max(1,int(real(numpart)/numthreads/20.))) do i=1,count%alive @@ -368,10 +461,12 @@ subroutine timemanager !************************************ itage=abs(itime-part(j)%tstart) nage=1 - do inage=1,nageclass - nage=inage - if (itage.lt.lage(nage)) exit - end do + if (lagespectra.eq.1) then + do inage=1,nageclass + nage=inage + if (itage.lt.lage(nage)) exit + end do + endif ! Initialize newly released particle !*********************************** @@ -408,7 +503,7 @@ subroutine timemanager if (DRYDEPSPEC(ks)) then ! dry deposition xscav_frac1(j,ks)=prob_rec(ks) else - part(j)%mass(ks)=0. + mass(j,ks)=0. xscav_frac1(j,ks)=0. endif endif @@ -436,14 +531,17 @@ subroutine timemanager #endif ! Terminating particles flagged in advance call + iterminate=0 do i=1,count%allocated if ((part(i)%nstop).and.(part(i)%alive)) then call terminate_particle(i,itime) + iterminate=iterminate+1 endif end do + if (iterminate.gt.0) call rewrite_ialive() - -!$OMP PARALLEL PRIVATE(prob_rec,nage,inage,itage,ks,kp,thread,i,j,xmassfract,drydeposit) + if (DRYDEP.or.WETDEP.or.LDECAY.or.(lagespectra.eq.1)) then +!$OMP PARALLEL PRIVATE(prob_rec,nage,inage,itage,ks,kp,thread,i,j,xmassfract,drytmp) !num_threads(numthreads_grid) @@ -452,10 +550,13 @@ subroutine timemanager #else thread = 0 #endif - allocate( drydeposit(maxspec),stat=stat ) - if (stat.ne.0) write(*,*)'ERROR: could not allocate drydeposit inside of OMP loop' + if (DRYDEP) then + allocate( drytmp(maxspec),stat=stat ) + if (stat.ne.0) write(*,*)'ERROR: could not allocate drytmp inside of OMP loop' + endif -!$OMP DO +!$OMP DO SCHEDULE(static) +!, max(1,numpart/1000)) ! SCHEDULE(dynamic, max(1,numpart/1000)) !max(1,int(real(numpart)/numthreads/20.))) do i=1,count%alive @@ -468,39 +569,41 @@ subroutine timemanager !************************************ itage=abs(itime-part(j)%tstart) nage=1 - do inage=1,nageclass - nage=inage - if (itage.lt.lage(nage)) exit - end do + if (lagespectra.eq.1) then + do inage=1,nageclass + nage=inage + if (itage.lt.lage(nage)) exit + end do + endif ! Dry deposition and radioactive decay for each species ! Also check maximum (of all species) of initial mass remaining on the particle; ! if it is below a threshold value, terminate particle !***************************************************************************** - + if (DRYDEP.or.WETDEP.or.LDECAY) then xmassfract=0. do ks=1,nspec if (DRYDEPSPEC(ks)) then ! dry deposition (and radioactive decay) - call drydepo_massloss(j,ks,ldeltat,drydeposit(ks)) + call drydepo_massloss(j,ks,ldeltat,drytmp(ks)) else if (decay(ks).gt.0.) then ! no dry depo, but radioactive decay - part(j)%mass(ks) = part(j)%mass(ks) * & + mass(j,ks) = mass(j,ks) * & exp( -real(abs(lsynctime)) * decay(ks) ) endif - ! Skip check on mass fraction when npoint represents particle number + ! Skip check on mass fraction when npoint represents particle number if (mdomainfill.eq.0.and.mquasilag.eq.0) then if (ipin.eq.3 .or. ipin.eq.4) then - if (part(j)%mass_init(ks).gt.0) & + if (mass_init(j,ks).gt.0) & xmassfract = max( xmassfract, & - part(j)%mass(ks) / part(j)%mass_init(ks) ) + mass(j,ks) / mass_init(j,ks) ) else if (xmass(part(j)%npoint,ks).gt.0.) then xmassfract = max( xmassfract, real( npart(part(j)%npoint) ) * & - part(j)%mass(ks) / xmass(part(j)%npoint,ks) ) + mass(j,ks) / xmass(part(j)%npoint,ks) ) endif else xmassfract=1.0 @@ -512,45 +615,50 @@ subroutine timemanager ! flag all particles carrying less mass for termination after parallel region part(j)%nstop=.true. endif - + endif ! Sabine Eckhardt, June 2008 ! don't create depofield for backward runs - if (DRYDEP.AND.(ldirect.eq.1).and.(iout.ne.0)) then + if (DRYDEP.AND.(ldirect.eq.1).and.(iout.ne.0)) then - if (ioutputforeachrelease.eq.1) then - kp=part(j)%npoint - else - kp=1 - endif - - call drydepokernel(part(j)%nclass,drydeposit,real(part(j)%xlon), & - real(part(j)%ylat),nage,kp,thread+1) - if (nested_output.eq.1) call drydepokernel_nest( & - part(j)%nclass,drydeposit,real(part(j)%xlon),real(part(j)%ylat), & - nage,kp,thread+1) + if (ioutputforeachrelease.eq.1) then + kp=part(j)%npoint + else + kp=1 endif + call drydepokernel(part(j)%nclass,drytmp,real(part(j)%xlon), & + real(part(j)%ylat),nage,kp,thread+1) + if (nested_output.eq.1) call drydepokernel_nest( & + part(j)%nclass,drytmp,real(part(j)%xlon),real(part(j)%ylat), & + nage,kp,thread+1) + endif + ! Terminate trajectories that are older than maximum allowed age !*************************************************************** - + if (lagespectra.eq.1) then if ((part(j)%alive).and.(abs(itime-part(j)%tstart).ge.lage(nageclass))) then if (linit_cond.ge.1) call initcond_calc(itime+lsynctime,j,thread+1) ! flag all particles for termination after parallel region part(j)%nstop=.true. endif + endif end do !loop over particles !$OMP END DO - deallocate(drydeposit) + if (DRYDEP) deallocate(drytmp) !$OMP END PARALLEL + + ! Terminating particles flagged due to insufficient mass or exceeded max age + iterminate=0 + do i=1,count%allocated + if ((part(i)%nstop).and.(part(i)%alive)) then + call terminate_particle(i,itime) + iterminate=iterminate+1 + endif + end do + if (iterminate.gt.0) call rewrite_ialive() - ! Terminating particles flagged due to insufficient mass or exceeded max age - do i=1,count%allocated - if ((part(i)%nstop).and.(part(i)%alive)) then - call terminate_particle(i,itime) - endif - end do - + endif !(DRYDEP.or.WETDEP.or.LDECAY.or.(lagespectra.eq.1)) #ifdef _OPENMP call omp_set_num_threads(numthreads) @@ -607,12 +715,33 @@ subroutine timemanager s_firstt = real(count_clock)/real(count_rate) - s_firstt endif + ! Output totals + !************** + +#ifdef USE_NCF + if ((mdomainfill.eq.1).and.(llcmoutput)) then + do ks=1,nspec + tot_mass(ks)=sum(real(mass(1:count%alive,ks),kind=dp)) + end do + call totals_write(itime) + endif +#endif + end do ! Complete the calculation of initial conditions for particles not yet terminated !***************************************************************************** call finalise_output(itime) + ! Output residual emissions + !************************** + +#ifdef USE_NCF + if (LEMIS.and.(ipout.eq.2)) then + call em_res_write + endif +#endif + ! De-allocate memory and end !*************************** call dealloc_all_particles @@ -625,11 +754,27 @@ subroutine timemanager call dealloc_random if (numbnests.ge.1) call dealloc_windfields_nest if (iflux.eq.1) deallocate(flux) - if (OHREA) deallocate(OH_field,OH_hourly,lonOH,latOH,altOH) if (ipin.ne.3 .and. ipin.ne.4) deallocate(xmasssave) -#ifdef _USE_NCF - if (lnetcdfout.eq.1) call dealloc_netcdf -#endif _USE_NCF + if (CLREA) then + deallocate(CL_field,lonCL,latCL,altCL) + endif + deallocate(reaccconst,reacdconst,reacnconst) + deallocate(emis_path,emis_file,emis_name,emis_unit,emis_coeff) + if (lnetcdfout.eq.1) then +#ifdef USE_NCF + call dealloc_netcdf + if (LEMIS) then + deallocate(em_field,em_res,em_area,mass_field) + endif +#endif + else + inquire(unit=unitoutrecept, opened=itsopen) + if (itsopen) close(unitoutrecept) + inquire(unit=unitoutreceptppt, opened=itsopen) + if (itsopen) close(unitoutreceptppt) + inquire(unit=unitoutsatellite, opened=itsopen) + if (itsopen) close(unitoutsatellite) + endif deallocate(xpoint1,xpoint2,ypoint1,ypoint2,zpoint1,zpoint2) deallocate(xmass) deallocate(ireleasestart,ireleaseend,npart,kindz) @@ -639,8 +784,10 @@ subroutine timemanager deallocate(outheight,outheighthalf) deallocate(oroout, area, volume) deallocate(gridunc) + deallocate(gridcnt) #ifdef _OPENMP deallocate(gridunc_omp) + deallocate(gridcnt_omp) #endif if (ldirect.gt.0) then deallocate(drygridunc,wetgridunc) diff --git a/src/totals_mod.f90 b/src/totals_mod.f90 new file mode 100644 index 0000000000000000000000000000000000000000..bf6af51f64ebcbc7969c6119a3b3b808ef5ac164 --- /dev/null +++ b/src/totals_mod.f90 @@ -0,0 +1,215 @@ +! SPDX-FileCopyrightText: FLEXPART 1998-2019, see flexpart_license.txt +! SPDX-License-Identifier: GPL-3.0-or-later + +module totals_mod + + !***************************************************************************** + ! * + ! This module contains variables and subroutines for injecting mass * + ! into particles based on gridded emissions estimates * + ! * + !***************************************************************************** + + use netcdf + use par_mod, only: dp + use com_mod + use netcdf_output_mod, only: nf90_err + + implicit none + + character(len=256) :: fn_totals + integer :: nc_id, specdim_id, reagdim_id, timedim_id, nchardim_id + integer :: time_id, spec_id, cl_id, emis_id, efld_id, eres_id, mass_id + real(kind=dp), dimension(:,:), allocatable :: chem_loss + real(kind=dp), dimension(:), allocatable :: tot_mass + real(kind=dp), dimension(:), allocatable :: tot_em_up + real(kind=dp), dimension(:), allocatable :: tot_em_res + real(kind=dp), dimension(:), allocatable :: tot_em_field + + contains + + subroutine alloc_totals + + !***************************************************************************** + ! * + ! Allocate variables for totals * + ! * + !***************************************************************************** + + implicit none + + integer :: stat + + allocate(chem_loss(nreagent,nspec),stat=stat) + if (stat.ne.0) error stop "Could not allocate totals arrays" + chem_loss(:,:)=0. + + allocate( tot_mass(nspec) ) + allocate( tot_em_up(nspec) ) + allocate( tot_em_field(nspec) ) + allocate( tot_em_res(nspec) ) + + end subroutine alloc_totals + + subroutine totals_init() + + !***************************************************************************** + ! * + ! This subroutine initializes the totals output * + ! * + ! Author: S. Henne * + ! Adapted by R. Thompson for v11, Feb-2024 * + ! * + !***************************************************************************** + + implicit none + + character(len=10) :: time + character(len=8) :: date + character(len=5) :: zone + character(len=8) :: adate + character(len=6) :: atime + character(len=32) :: timeunit + character(len=256) :: host_name, login_name + integer :: ks + + ! get string of start time + write(adate,'(i8.8)') ibdate + write(atime,'(i6.6)') ibtime + timeunit = 'seconds since '//adate(1:4)//'-'//adate(5:6)// & + '-'//adate(7:8)//' '//atime(1:2)//':'//atime(3:4) + + ! get run info + call date_and_time(date,time,zone) + call getlog(login_name) + call hostnm(host_name) + + ! file name + fn_totals=trim(path(2)(1:length(2)))//'totals.nc' + + ! open new file handle + call nf90_err( nf90_create(trim(fn_totals), cmode=nf90_hdf5, ncid=nc_id) ) + + ! define dimensions + !****************** + + call nf90_err( nf90_def_dim(nc_id, "species", nspec, specdim_id) ) + call nf90_err( nf90_def_dim(nc_id, "reagents", nreagent, reagdim_id) ) + call nf90_err( nf90_def_dim(nc_id, "time", nf90_unlimited, timedim_id) ) + call nf90_err( nf90_def_dim(nc_id, "nchar", 10, nchardim_id) ) + + ! define variables + !***************** + + ! time + call nf90_err( nf90_def_var(nc_id, 'time', nf90_int, (/ timedim_id /), time_id) ) + call nf90_err( nf90_put_att(nc_id, time_id, 'units', timeunit) ) + ! species names + call nf90_err( nf90_def_var(nc_id, 'species', nf90_char, (/ nchardim_id, specdim_id /), spec_id) ) + call nf90_err( nf90_put_att(nc_id, spec_id, 'long_name', 'Species names') ) + ! total masses + call nf90_err( nf90_def_var(nc_id, 'mass', nf90_double, (/ specdim_id, timedim_id /), mass_id) ) + call nf90_err( nf90_put_att(nc_id, mass_id, 'units', 'kg') ) + call nf90_err( nf90_put_att(nc_id, mass_id, 'long_name', 'Total global mass') ) + ! emission uptake + call nf90_err( nf90_def_var(nc_id, 'emissions', nf90_double, (/ specdim_id, timedim_id /), emis_id) ) + call nf90_err( nf90_put_att(nc_id, emis_id, 'units', 'kg s-1') ) + call nf90_err( nf90_put_att(nc_id, emis_id, 'long_name', 'Actual emission flux') ) + ! emission field + call nf90_err( nf90_def_var(nc_id, 'em_field', nf90_double, (/ specdim_id, timedim_id /), efld_id) ) + call nf90_err( nf90_put_att(nc_id, efld_id, 'units', 'kg s-1') ) + call nf90_err( nf90_put_att(nc_id, efld_id, 'long_name', 'Emission flux in fields') ) + ! emission residual + call nf90_err( nf90_def_var(nc_id, 'em_res', nf90_double, (/ specdim_id, timedim_id /), eres_id) ) + call nf90_err( nf90_put_att(nc_id, eres_id, 'units', 'kg') ) + call nf90_err( nf90_put_att(nc_id, eres_id, 'long_name', 'Emission residuals') ) + ! chemical loss + call nf90_err( nf90_def_var(nc_id, 'chem_loss', nf90_double, (/ reagdim_id, specdim_id, timedim_id /), cl_id) ) + call nf90_err( nf90_put_att(nc_id, cl_id, 'units', 'kg s-1') ) + call nf90_err( nf90_put_att(nc_id, cl_id, 'long_name', 'Mass loss through chemical reactions') ) + + ! write global attributes + !************************ + + call nf90_err( nf90_put_att(nc_id, nf90_global, 'title', 'FLEXPART total mass and flux output') ) + call nf90_err( nf90_put_att(nc_id, nf90_global, 'source', trim(flexversion)//' model output') ) + call nf90_err( nf90_put_att(nc_id, nf90_global, 'history', date(1:4)//'-'//date(5:6)// & + '-'//date(7:8)//' '//time(1:2)//':'//time(3:4)//' '//zone//' created by '// & + trim(login_name)//' on '//trim(host_name)) ) + call nf90_err( nf90_put_att(nc_id, nf90_global, 'references', & + 'Stohl et al., Atmos. Chem. Phys., 2005, doi:10.5194/acp-5-2461-200;'//& + 'Henne et al., in Lagrangian Modeling of the Atmosphere, 2012, doi:10.1029/2012GM001247') ) + + ! end definition of file + call nf90_err( nf90_enddef(nc_id) ) + + ! write species info + do ks=1,nspec + print*, 'totals: species = ',trim(species(ks)) + call nf90_err( nf90_put_var(nc_id, spec_id, species(ks), (/1,ks/), (/10,1/)) ) + end do + + ! close file + call nf90_err( nf90_close(nc_id) ) + + end subroutine totals_init + + + subroutine totals_write(itime) + + !***************************************************************************** + ! * + ! This subroutine writes the totals to file * + ! * + ! Author: S. Henne * + ! Adapted by R. Thompson for v11, Feb-2024 * + ! * + !***************************************************************************** + + implicit none + + integer :: itime, tidx + integer :: var_id + + ! open file + call nf90_err( nf90_open(trim(fn_totals), nf90_write, nc_id) ) + + ! get length of time dimension -> increase index by one to write new data + call nf90_err( nf90_inq_dimid(nc_id, "time", timedim_id) ) + call nf90_err( nf90_inquire_dimension(nc_id, timedim_id, len=tidx) ) + tidx = tidx + 1 + + ! add to time variable + call nf90_err( nf90_inq_varid(nc_id, "time", time_id) ) + call nf90_err( nf90_put_var(nc_id, time_id, itime, (/ tidx /)) ) + + ! write variables + !**************** + + call nf90_err( nf90_inq_varid(nc_id, "mass", var_id) ) + call nf90_err( nf90_put_var(nc_id, var_id, tot_mass(1:nspec), (/ 1, tidx /), (/ nspec, 1/)) ) + + call nf90_err( nf90_inq_varid(nc_id, "emissions", var_id) ) + call nf90_err( nf90_put_var(nc_id, var_id, tot_em_up(1:nspec)/real(lsynctime), & + (/ 1, tidx /), (/ nspec, 1/)) ) + + call nf90_err( nf90_inq_varid(nc_id, "em_field", var_id) ) + call nf90_err( nf90_put_var(nc_id, var_id, tot_em_field(1:nspec)/real(lsynctime), & + (/ 1, tidx /), (/ nspec, 1/)) ) + + ! em_res accumulated over all time steps (units kg) -> no division by lsynctime + call nf90_err( nf90_inq_varid(nc_id, "em_res", var_id) ) + call nf90_err( nf90_put_var(nc_id, var_id, tot_em_res(1:nspec), & + (/ 1, tidx /), (/ nspec, 1/)) ) + + if (nreagent.gt.0) then + call nf90_err( nf90_inq_varid(nc_id, "chem_loss", var_id) ) + call nf90_err( nf90_put_var(nc_id, var_id, chem_loss(1:nreagent,1:nspec)/real(lsynctime), & + (/ 1, 1, tidx /), (/ nreagent, nspec, 1/)) ) + endif + + call nf90_err( nf90_close(nc_id) ) + + end subroutine totals_write + +end module totals_mod diff --git a/src/unc_mod.f90 b/src/unc_mod.f90 index 70a2081747ef45b0a3dd8022f033f694f122e620..7b588fda66e35247b51c1e68ff578bc15cd2fc4f 100644 --- a/src/unc_mod.f90 +++ b/src/unc_mod.f90 @@ -14,6 +14,7 @@ module unc_mod implicit none real(dep_prec),allocatable, dimension (:,:,:,:,:,:,:) :: gridunc + real(dep_prec),allocatable, dimension (:,:,:) :: gridcnt #ifdef USE_MPIINPLACE #else ! If MPI_IN_PLACE option is not used in mpi_mod.f90::mpif_tm_reduce_grid(), @@ -33,6 +34,7 @@ module unc_mod real(dep_prec),allocatable, dimension (:,:,:,:,:,:,:) :: drygriduncn_omp real(dep_prec),allocatable, dimension (:,:,:,:,:,:,:) :: wetgridunc_omp real(dep_prec),allocatable, dimension (:,:,:,:,:,:,:) :: wetgriduncn_omp + real(dep_prec),allocatable, dimension (:,:,:,:) :: gridcnt_omp #endif ! For sum of individual contributions, used for the MPI version real(dep_prec),allocatable, dimension (:,:,:,:,:,:) :: drygridunc0 @@ -53,6 +55,8 @@ subroutine alloc_grid_unc() allocate(gridunc(0:numxgrid-1,0:numygrid-1,numzgrid,nspec, & maxpointspec_act,nclassunc,nageclass),stat=stat) if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc' + allocate(gridcnt(0:numxgrid-1,0:numygrid-1,numzgrid),stat=stat) + if (stat.ne.0) write(*,*)'ERROR: could not allocate gridcnt' #ifdef _OPENMP allocate(gridunc_omp(0:numxgrid-1,0:numygrid-1,numzgrid,nspec, & maxpointspec_act,nclassunc,nageclass,numthreads_grid),stat=stat) @@ -61,6 +65,12 @@ subroutine alloc_grid_unc() write(*,*)'increase the memory or reduce MAXTHREADGRID in COMMAND.' error stop endif + allocate(gridcnt_omp(0:numxgrid-1,0:numygrid-1,numzgrid,numthreads_grid),stat=stat) + if (stat.ne.0) then + write(*,*)'ERROR: could not allocate gridcnt_omp' + write(*,*)'increase the memory or reduce MAXTHREADGRID in COMMAND.' + error stop + endif #endif if (ldirect.gt.0) then allocate(wetgridunc(0:numxgrid-1,0:numygrid-1,nspec, & diff --git a/src/verttransform_mod.f90 b/src/verttransform_mod.f90 index b7aee4bc6bfafd4d553b612cd6030a8ceaa10f46..9952cf746bd9546eb8f0fc6d43875456069e4f02 100644 --- a/src/verttransform_mod.f90 +++ b/src/verttransform_mod.f90 @@ -34,6 +34,8 @@ subroutine verttransform_ecmwf(n,uuh,vvh,wwh,pvh) ! * ! 12 August 1996 * ! Update: 16 January 1998 * + !***************************************************************************** + ! CHANGES * ! * ! Major update: 17 February 1999 * ! by G. Wotawa * @@ -42,17 +44,16 @@ subroutine verttransform_ecmwf(n,uuh,vvh,wwh,pvh) ! - Slope correction for vertical velocity: Modification of calculation * ! procedure * ! * - !***************************************************************************** - ! Changes, Bernd C. Krueger, Feb. 2001: - ! Variables tth and qvh (on eta coordinates) from common block - ! - ! Sabine Eckhardt, March 2007 - ! added the variable cloud for use with scavenging - descr. in com_mod - ! - ! Unified ECMWF and GFS builds - ! Marian Harustak, 12.5.2017 - ! - Renamed from verttransform to verttransform_ecmwf - ! + ! Changes, Bernd C. Krueger, Feb. 2001: * + ! Variables tth and qvh (on eta coordinates) from common block * + ! * + ! Sabine Eckhardt, March 2007 * + ! added the variable cloud for use with scavenging - descr. in com_mod * + ! * + ! Unified ECMWF and GFS builds * + ! Marian Harustak, 12.5.2017 * + ! - Renamed from verttransform to verttransform_ecmwf * + ! * ! Date: 2017-05-30 modification of a bug in ew. Don Morton (CTBTO project) * ! * ! Lucie Bakels, 2022 * @@ -60,11 +61,17 @@ subroutine verttransform_ecmwf(n,uuh,vvh,wwh,pvh) ! - In case of wind_coord_type='ETA': keep ECMWF vertical winds in eta * ! coordinates * ! - OpenMP parallelisation * + ! * + ! Petra Seibert, Anne Philipp, 2019-05-02: implement wetdepo quickfix * + ! Petra Seibert, Anne Tipka, 2020-11-19: reimplement in latest version * + ! * !***************************************************************************** ! * ! Variables: * + ! Note PS, AT 2021-01-29: all these fields are 0:nxmax-1,0:nymax-1 !! * ! nx,ny,nz field dimensions in x,y and z direction * - ! clouds(0:nxmax,0:nymax,0:nzmax,numwfmem) cloud field for wet deposition * + ! icloudbot(0:nxmax,0:nymax,numwfmem) cloud bottom field for wet deposition * + ! icloudtop(0:nxmax,0:nymax,numwfmem) cloud thickness for wet deposition * ! uu(0:nxmax,0:nymax,nzmax,numwfmem) wind components in x-direction [m/s]* ! vv(0:nxmax,0:nymax,nzmax,numwfmem) wind components in y-direction [m/s]* ! ww(0:nxmax,0:nymax,nzmax,numwfmem) wind components in z-direction * @@ -83,7 +90,6 @@ subroutine verttransform_ecmwf(n,uuh,vvh,wwh,pvh) real,dimension(0:nxmax-1,0:nymax-1,nuvzmax) :: rhoh real,dimension(0:nxmax-1,0:nymax-1,nzmax) :: pinmconv - ! RLT added pressure real,dimension(0:nxmax-1,0:nymax-1,nuvzmax) :: prsh logical :: init = .true. @@ -136,16 +142,34 @@ subroutine verttransform_ecmwf(n,uuh,vvh,wwh,pvh) ! If north or south pole is in the domain, calculate wind velocities in polar ! stereographic coordinates !******************************************************************* - call verttransform_ecmwf_stereo(n) + call verttransform_ecmwf_polar(n) ! Create cloud fields !********************* - call verttransform_ecmwf_cloud(readclouds,sumclouds,nxmin1,nymin1, & - clouds(0:nxmin1,0:nymin1,:,n), cloudsh(0:nxmin1,0:nymin1,n), & - clw(0:nxmin1,0:nymin1,:,n),ctwc(0:nxmin1,0:nymin1,n),clwc(0:nxmin1,0:nymin1,:,n), & - ciwc(0:nxmin1,0:nymin1,:,n),lsprec(0:nxmin1,0:nymin1,1,n), & - convprec(0:nxmin1,0:nymin1,1,n),rho(0:nxmin1,0:nymin1,:,n), & - tt(0:nxmin1,0:nymin1,:,n),qv(0:nxmin1,0:nymin1,:,n),etauvheight(0:nxmin1,0:nymin1,:,n)) +#ifdef ETA + call verttransform_ecmwf_cloud(lcw,lcwsum,nxmin1,nymin1, & + ctwc(0:nxmin1,0:nymin1,n), & + clwc(0:nxmin1,0:nymin1,:,n), & + ciwc(0:nxmin1,0:nymin1,:,n), & + icloudbot(0:nxmin1,0:nymin1,n), & + icloudtop(0:nxmin1,0:nymin1,n), & + lsprec(0:nxmin1,0:nymin1,1,:,n), & + convprec(0:nxmin1,0:nymin1,1,:,n), & + rhoeta(0:nxmin1,0:nymin1,:,n), & + tteta(0:nxmin1,0:nymin1,:,n), & + qv(0:nxmin1,0:nymin1,:,n), & + etauvheight(0:nxmin1,0:nymin1,:,n), & + etawheight(0:nxmin1,0:nymin1,:,n)) +#else + call verttransform_ecmwf_cloud(lcw,lcwsum,nxmin1,nymin1, & + ctwc(0:nxmin1,0:nymin1,n),clwc(0:nxmin1,0:nymin1,:,n), & + ciwc(0:nxmin1,0:nymin1,:,n), & + icloudbot(0:nxmin1,0:nymin1,n), icloudtop(0:nxmin1,0:nymin1,n), & + lsprec(0:nxmin1,0:nymin1,1,:,n),convprec(0:nxmin1,0:nymin1,1,:,n), & + rho(0:nxmin1,0:nymin1,:,n), tt(0:nxmin1,0:nymin1,:,n), & + qv(0:nxmin1,0:nymin1,:,n), etauvheight(0:nxmin1,0:nymin1,:,n), & + etawheight(0:nxmin1,0:nymin1,:,n)) +#endif end subroutine verttransform_ecmwf subroutine verttransform_nest(n,uuhn,vvhn,wwhn,pvhn) @@ -166,6 +190,8 @@ subroutine verttransform_nest(n,uuhn,vvhn,wwhn,pvhn) ! 12 August 1996 * ! Update: 16 January 1998 * ! * + !***************************************************************************** + ! CHANGES * ! Major update: 17 February 1999 * ! by G. Wotawa * ! * @@ -173,22 +199,38 @@ subroutine verttransform_nest(n,uuhn,vvhn,wwhn,pvhn) ! - Slope correction for vertical velocity: Modification of calculation * ! procedure * ! * - !***************************************************************************** - ! Changes, Bernd C. Krueger, Feb. 2001: (marked "C-cv") - ! Variables tthn and qvhn (on eta coordinates) from common block - !***************************************************************************** - ! Sabine Eckhardt, March 2007 - ! add the variable cloud for use with scavenging - descr. in com_mod - !***************************************************************************** - ! ESO, 2016 - ! -note that divide-by-zero occurs when nxmaxn,nymaxn etc. are larger than - ! the actual field dimensions - !***************************************************************************** - ! Date: 2017-05-30 modification of a bug in ew. Don Morton (CTBTO project) * + ! Bernd C. Krueger, Feb. 2001: * + ! Variables tthn and qvhn (on eta coordinates) from common block * + ! * + ! Sabine Eckhardt, March 2007: * + ! added the variable cloud for use with scavenging - descr. in com_mod * + ! PS/AT 2018/-21: variable "cloud" is replaced by quickfix, see below * + ! * + ! ESO, 2016 * + ! -note that divide-by-zero occurs when nxmaxn,nymaxn etc. are larger than * + ! the actual field dimensions * + ! * + ! Don Morton, 2017-05-30: * + ! modification of a bug in ew. Don Morton (CTBTO project) * + ! * + ! undocumented modifications by NILU for v10 * + ! * + ! Petra Seibert, 2018-06-13: * + ! - put back SAVE attribute for INIT, just to be safe * + ! - minor changes, most of them just cosmetics * + ! for details see changelog.txt in branch unive * + ! * + ! Petra Seibert, Anne Philipp, 2019-05-02: implement wetdepo quickfix * + ! Petra Seibert, Anne Tipka, 2020-11-19: reimplement in latest version * + ! * + ! **************************************************************************** !***************************************************************************** ! * ! Variables: * + ! Note PS, AT 2021-01-29: all these fields are 0:nxmaxn-1,0:nymaxn-1 !! * ! nxn,nyn,nuvz,nwz field dimensions in x,y and z direction * + ! icloudbot cloud bottom field for wet deposition * + ! icloudtop cloud thickness for wet deposition * ! uun wind components in x-direction [m/s] * ! vvn wind components in y-direction [m/s] * ! wwn wind components in z-direction [deltaeta/s]* @@ -200,16 +242,16 @@ subroutine verttransform_nest(n,uuhn,vvhn,wwhn,pvhn) implicit none - real,intent(in),dimension(0:nxmaxn-1,0:nymaxn-1,nuvzmax,numbnests) :: uuhn,vvhn,pvhn + real,intent(in),dimension(0:nxmaxn-1,0:nymaxn-1,nuvzmax,numbnests) :: & + uuhn,vvhn,pvhn real,intent(in),dimension(0:nxmaxn-1,0:nymaxn-1,nwzmax,numbnests) :: wwhn real,dimension(0:nxmaxn-1,0:nymaxn-1,nuvzmax) :: rhohn,prshn real,dimension(0:nxmaxn-1,0:nymaxn-1,nzmax) :: pinmconv - integer :: n,l integer :: nxm1, nym1 + integer :: n,l - ! real,parameter :: precmin = 0.002 ! minimum prec in mm/h for cloud diagnostics ! Loop over all nests !******************** @@ -217,6 +259,7 @@ subroutine verttransform_nest(n,uuhn,vvhn,wwhn,pvhn) do l=1,numbnests nxm1=nxn(l)-1 nym1=nyn(l)-1 + if (nxm1.lt.1 .or. nym1.lt.1 ) cycle call verttransform_ecmwf_heights(nxm1,nym1, & tt2n(0:nxm1,0:nym1,1,n,l),td2n(0:nxm1,0:nym1,1,n,l),psn(0:nxm1,0:nym1,1,n,l), & qvhn(0:nxm1,0:nym1,:,n,l),tthn(0:nxm1,0:nym1,:,n,l),prshn(0:nxm1,0:nym1,:), & @@ -229,13 +272,23 @@ subroutine verttransform_nest(n,uuhn,vvhn,wwhn,pvhn) ! Create cloud fields !********************* - call verttransform_ecmwf_cloud(readclouds_nest(l),sumclouds_nest(l),nxm1,nym1,& - cloudsn(0:nxm1,0:nym1,:,n,l),cloudshn(0:nxm1,0:nym1,n,l), & - clwn(0:nxm1,0:nym1,:,n,l), ctwcn(0:nxm1,0:nym1,n,l), & - clwcn(0:nxm1,0:nym1,:,n,l), ciwcn(0:nxm1,0:nym1,:,n,l), & - lsprecn(0:nxm1,0:nym1,1,n,l),convprecn(0:nxm1,0:nym1,1,n,l), & +#ifdef ETA + call verttransform_ecmwf_cloud(lcw_nest(l),lcwsum_nest(l),nxm1,nym1,& + ctwcn(0:nxm1,0:nym1,n,l), clwcn(0:nxm1,0:nym1,:,n,l), ciwcn(0:nxm1,0:nym1,:,n,l), & + icloudbotn(0:nxm1,0:nym1,n,l), icloudtopn(0:nxm1,0:nym1,n,l), & + lsprecn(0:nxm1,0:nym1,1,:,n,l),convprecn(0:nxm1,0:nym1,1,:,n,l), & + rhoetan(0:nxm1,0:nym1,:,n,l),ttetan(0:nxm1,0:nym1,:,n,l), & + qvn(0:nxm1,0:nym1,:,n,l), etauvheightn(0:nxm1,0:nym1,:,n,l), & + etawheightn(0:nxm1,0:nym1,:,n,l)) +#else + call verttransform_ecmwf_cloud(lcw_nest(l),lcwsum_nest(l),nxm1,nym1,& + ctwcn(0:nxm1,0:nym1,n,l), clwcn(0:nxm1,0:nym1,:,n,l), ciwcn(0:nxm1,0:nym1,:,n,l), & + icloudbotn(0:nxm1,0:nym1,n,l), icloudtopn(0:nxm1,0:nym1,n,l), & + lsprecn(0:nxm1,0:nym1,1,:,n,l),convprecn(0:nxm1,0:nym1,1,:,n,l), & rhon(0:nxm1,0:nym1,:,n,l),ttn(0:nxm1,0:nym1,:,n,l), & - qvn(0:nxm1,0:nym1,:,n,l), etauvheightn(0:nxm1,0:nym1,:,n,l)) + qvn(0:nxm1,0:nym1,:,n,l), etauvheightn(0:nxm1,0:nym1,:,n,l), & + etawheightn(0:nxm1,0:nym1,:,n,l)) +#endif end do ! end loop over nests end subroutine verttransform_nest @@ -275,8 +328,7 @@ subroutine verttransform_init(n) tv=tth(ixm,jym,kz,n)*(1.+0.608*qvh(ixm,jym,kz,n)) if (abs(tv-tvold).gt.0.2) then - height(kz)= height(kz-1)+const*log(pold/pint)* & - (tv-tvold)/log(tv/tvold) + height(kz)= height(kz-1)+const*log(pold/pint)*(tv-tvold)/log(tv/tvold) else height(kz)=height(kz-1)+const*log(pold/pint)*tv endif @@ -374,19 +426,73 @@ subroutine verttransform_ecmwf_windfields(n,nxlim,nylim,uuh,vvh,wwh,pvh,rhoh,prs real :: dzdx,dzdy real :: dzdx1,dzdx2,dzdy1,dzdy2 + ! Copy fields for ETA coordinate interpolations +#ifdef ETA +!$OMP PARALLEL PRIVATE(ix,jy,kz) +!$OMP WORKSHARE + uueta(0:nxlim,0:nylim,:,n) = uuh(0:nxlim,0:nylim,:) + vveta(0:nxlim,0:nylim,:,n) = vvh(0:nxlim,0:nylim,:) + tteta(0:nxlim,0:nylim,:,n) = tth(0:nxlim,0:nylim,:,n) + qv(0:nxlim,0:nylim,:,n) = qvh(0:nxlim,0:nylim,:,n) + pveta(0:nxlim,0:nylim,:,n) = pvh(0:nxlim,0:nylim,:) + rhoeta(0:nxlim,0:nylim,:,n) = rhoh(0:nxlim,0:nylim,:) + prseta(0:nxlim,0:nylim,:,n) = prsh(0:nxlim,0:nylim,:) + + forall (ix=0:nxlim,jy=0:nylim,kz=2:nz-1) + drhodzeta(ix,jy,kz,n)= & + (rhoh(ix,jy,kz+1)-rhoh(ix,jy,kz-1))/ & + (height(kz+1)-height(kz-1)) + ! Note that this is still in SI units and not in eta + end forall + drhodzeta(0:nxlim,0:nylim,1,n)=(rhoh(0:nxlim,0:nylim,2)-rhoh(0:nxlim,0:nylim,1))/(height(2)-height(1)) + drhodzeta(0:nxlim,0:nylim,nz,n)=drhodzeta(0:nxlim,0:nylim,nz-1,n) + + ! Convert w from Pa/s to eta/s, following FLEXTRA + !************************************************ + ! z=1 + wweta(0:nxlim,0:nylim,1,n)=wwh(0:nxlim,0:nylim,1)/ & + ((akm(2)-akm(1)+(bkm(2)-bkm(1))*ps(0:nxlim,0:nylim,1,n))/ & + (wheight(2)-wheight(1))) + ! z=nuvz-1 + wweta(0:nxlim,0:nylim,nuvz-1,n)=wwh(0:nxlim,0:nylim,nuvz-1)/ & + ((akm(nuvz-1)-akm(nuvz-2)+(bkm(nuvz-1)-bkm(nuvz-2))*ps(0:nxlim,0:nylim,1,n))/ & + (wheight(nuvz-1)-wheight(nuvz-2))) + ! 1<z<nuvz-1 + forall (ix=0:nxlim,jy=0:nylim,kz=2:nuvz-2) + wweta(ix,jy,kz,n)=wwh(ix,jy,kz)/ & + ((akm(kz+1)-akm(kz-1)+(bkm(kz+1)-bkm(kz-1))*ps(ix,jy,1,n))/ & + (wheight(kz+1)-wheight(kz-1))) + end forall +!$OMP END WORKSHARE NOWAIT + + if (lcw) then +!$OMP DO + do kz=1,nz + clwc(0:nxlim,0:nylim,kz,n)=clwch(0:nxlim,0:nylim,kz,n) + if (.not. lcwsum) ciwc(0:nxlim,0:nylim,kz,n)=ciwch(0:nxlim,0:nylim,kz,n) + end do +!$OMP END DO + endif +!$OMP END PARALLEL +#endif - +!$OMP PARALLEL PRIVATE(jy,ix,iz,kz,dz1,dz2,dz,ix1,jy1,ixp,jyp,dzdx1,dzdx2,dzdx, & +!$OMP dzdy1,dzdy2,dzdy,dpdeta) ! Finding the index in eta levels (uv and w) that correspond to ! a certain height level in meters !************************************************************** +!$OMP WORKSHARE + idx(0:nxlim,0:nylim,1:2)=2 + idxw(0:nxlim,0:nylim,1:2)=2 +!$OMP END WORKSHARE + +!$OMP DO + do jy=0,nylim + do iz=2,nz-1 + do ix=0,nxlim + idx(ix,jy,iz)=idx(ix,jy,iz-1) + idxw(ix,jy,iz)=idxw(ix,jy,iz-1) - idx(:,:,1)=2 - idxw(:,:,1)=2 - do iz=2,nz-1 - idx(:,:,iz)=idx(:,:,iz-1) - idxw(:,:,iz)=idxw(:,:,iz-1) - do jy=0,nymin1 - do ix=0,nxmin1 ! height in meters that corresponds to the eta w level innwz: do kz=idxw(ix,jy,iz),nuvz if ((idxw(ix,jy,iz).le.kz).and. & @@ -413,57 +519,56 @@ subroutine verttransform_ecmwf_windfields(n,nxlim,nylim,uuh,vvh,wwh,pvh,rhoh,prs end do end do end do +!$OMP END DO NOWAIT -!$OMP PARALLEL PRIVATE(jy,ix,kz,dz1,dz2,dz,ix1,jy1,ixp,jyp,dzdx1,dzdx2,dzdx, & -!$OMP dzdy1,dzdy2,dzdy,dpdeta) - - ! All bottom and top levels -!$OMP DO - do jy=0,nymin1 + ! Setting upper and lower levels +!$OMP WORKSHARE + uu(0:nxlim,0:nylim,1,n)=uuh(0:nxlim,0:nylim,1) + uu(0:nxlim,0:nylim,nz,n)=uuh(0:nxlim,0:nylim,nuvz) + vv(0:nxlim,0:nylim,1,n)=vvh(0:nxlim,0:nylim,1) + vv(0:nxlim,0:nylim,nz,n)=vvh(0:nxlim,0:nylim,nuvz) + tt(0:nxlim,0:nylim,1,n)=tth(0:nxlim,0:nylim,1,n) + tt(0:nxlim,0:nylim,nz,n)=tth(0:nxlim,0:nylim,nuvz,n) + pv(0:nxlim,0:nylim,1,n)=pvh(0:nxlim,0:nylim,1) + pv(0:nxlim,0:nylim,nz,n)=pvh(0:nxlim,0:nylim,nuvz) +#ifndef ETA + qv(0:nxlim,0:nylim,1,n)=qvh(0:nxlim,0:nylim,1,n) + qv(0:nxlim,0:nylim,nz,n)=qvh(0:nxlim,0:nylim,nuvz,n) +#endif + rho(0:nxlim,0:nylim,1,n)=rhoh(0:nxlim,0:nylim,1) + rho(0:nxlim,0:nylim,nz,n)=rhoh(0:nxlim,0:nylim,nuvz) + ! RLT add pressure + prs(0:nxlim,0:nylim,1,n)=prsh(0:nxlim,0:nylim,1) + prs(0:nxlim,0:nylim,nz,n)=prsh(0:nxlim,0:nylim,nuvz) + ! RLT + ww(0:nxlim,0:nylim,1,n)=wwh(0:nxlim,0:nylim,1)*pinmconv(0:nxlim,0:nylim,1) + ww(0:nxlim,0:nylim,nz,n)=wwh(0:nxlim,0:nylim,nwz)*pinmconv(0:nxlim,0:nylim,nz) + forall (jy=0:nylim) cosf(jy)=1./cos((real(jy)*dy+ylat0)*pi180) ! Needed in slope computations - - do ix=0,nxmin1 + end forall +!$OMP END WORKSHARE NOWAIT - uu(ix,jy,1,n)=uuh(ix,jy,1) - uu(ix,jy,nz,n)=uuh(ix,jy,nuvz) - vv(ix,jy,1,n)=vvh(ix,jy,1) - vv(ix,jy,nz,n)=vvh(ix,jy,nuvz) - tt(ix,jy,1,n)=tth(ix,jy,1,n) - tt(ix,jy,nz,n)=tth(ix,jy,nuvz,n) - pv(ix,jy,1,n)=pvh(ix,jy,1) - pv(ix,jy,nz,n)=pvh(ix,jy,nuvz) #ifndef ETA - qv(ix,jy,1,n)=qvh(ix,jy,1,n) - qv(ix,jy,nz,n)=qvh(ix,jy,nuvz,n) - !hg adding the cloud water - if (readclouds) then - clwc(ix,jy,1,n)=clwch(ix,jy,1,n) - clwc(ix,jy,nz,n)=clwch(ix,jy,nuvz,n) - if (.not.sumclouds) then - ciwc(ix,jy,1,n)=ciwch(ix,jy,1,n) - ciwc(ix,jy,nz,n)=ciwch(ix,jy,nuvz,n) - endif - end if - !hg + if (lcw) then !hg adding the cloud water +!$OMP WORKSHARE + clwc(0:nxlim,0:nylim,1,n)=clwch(0:nxlim,0:nylim,1,n) + clwc(0:nxlim,0:nylim,nz,n)=clwch(0:nxlim,0:nylim,nuvz,n) +!$OMP END WORKSHARE NOWAIT + if (.not. lcwsum) then +!$OMP WORKSHARE + ciwc(0:nxlim,0:nylim,1,n)=ciwch(0:nxlim,0:nylim,1,n) + ciwc(0:nxlim,0:nylim,nz,n)=ciwch(0:nxlim,0:nylim,nuvz,n) +!$OMP END WORKSHARE NOWAIT + endif + endif #endif - rho(ix,jy,1,n)=rhoh(ix,jy,1) - rho(ix,jy,nz,n)=rhoh(ix,jy,nuvz) - ! RLT add pressure - prs(ix,jy,1,n)=prsh(ix,jy,1) - prs(ix,jy,nz,n)=prsh(ix,jy,nuvz) - ! RLT - - ww(ix,jy,1,n)=wwh(ix,jy,1)*pinmconv(ix,jy,1) - ww(ix,jy,nz,n)=wwh(ix,jy,nwz)*pinmconv(ix,jy,nz) - end do - end do -!$OMP END DO -!$OMP DO SCHEDULE(dynamic) - do iz=2,nz-1 - do jy=0,nymin1 - do ix=0,nxmin1 +!$OMP BARRIER +!$OMP DO + do iz=2,nz-1 + do jy=0,nylim + do ix=0,nxlim ! Levels, where uv is given !************************* if (height(iz).gt.etauvheight(ix,jy,nuvz,n)) then @@ -471,16 +576,16 @@ subroutine verttransform_ecmwf_windfields(n,nxlim,nylim,uuh,vvh,wwh,pvh,rhoh,prs vv(ix,jy,iz,n)=vv(ix,jy,nz,n) tt(ix,jy,iz,n)=tt(ix,jy,nz,n) pv(ix,jy,iz,n)=pv(ix,jy,nz,n) + rho(ix,jy,iz,n)=rho(ix,jy,nz,n) + prs(ix,jy,iz,n)=prs(ix,jy,nz,n) ! RLT #ifndef ETA qv(ix,jy,iz,n)=qv(ix,jy,nz,n) !hg adding the cloud water - if (readclouds) then + if (lcw) then clwc(ix,jy,iz,n)=clwc(ix,jy,nz,n) - if (.not.sumclouds) ciwc(ix,jy,iz,n)=ciwc(ix,jy,nz,n) + if (.not.lcwsum) ciwc(ix,jy,iz,n)=ciwc(ix,jy,nz,n) end if #endif - rho(ix,jy,iz,n)=rho(ix,jy,nz,n) - prs(ix,jy,iz,n)=prs(ix,jy,nz,n) ! RLT else kz=idx(ix,jy,iz) dz1=height(iz)-etauvheight(ix,jy,kz-1,n) @@ -491,146 +596,84 @@ subroutine verttransform_ecmwf_windfields(n,nxlim,nylim,uuh,vvh,wwh,pvh,rhoh,prs tt(ix,jy,iz,n)=(tth(ix,jy,kz-1,n)*dz2 & +tth(ix,jy,kz,n)*dz1)/dz pv(ix,jy,iz,n)=(pvh(ix,jy,kz-1)*dz2+pvh(ix,jy,kz)*dz1)/dz + rho(ix,jy,iz,n)=(rhoh(ix,jy,kz-1)*dz2+rhoh(ix,jy,kz)*dz1)/dz + ! RLT add pressure + prs(ix,jy,iz,n)=(prsh(ix,jy,kz-1)*dz2+prsh(ix,jy,kz)*dz1)/dz #ifndef ETA qv(ix,jy,iz,n)=(qvh(ix,jy,kz-1,n)*dz2+qvh(ix,jy,kz,n)*dz1)/dz - !hg adding the cloud water - if (readclouds) then + !hg adding the cloud water + if (lcw) then clwc(ix,jy,iz,n)= & (clwch(ix,jy,kz-1,n)*dz2+clwch(ix,jy,kz,n)*dz1)/dz - if (.not.sumclouds) ciwc(ix,jy,iz,n)= & + if (.not.lcwsum) ciwc(ix,jy,iz,n)= & (ciwch(ix,jy,kz-1,n)*dz2+ciwch(ix,jy,kz,n)*dz1)/dz end if - !hg #endif - rho(ix,jy,iz,n)=(rhoh(ix,jy,kz-1)*dz2+rhoh(ix,jy,kz)*dz1)/dz - ! RLT add pressure - prs(ix,jy,iz,n)=(prsh(ix,jy,kz-1)*dz2+prsh(ix,jy,kz)*dz1)/dz endif - ! Levels, where w is given !************************* kz=idxw(ix,jy,iz) + dz1=height(iz)-etawheight(ix,jy,kz-1,n) dz2=etawheight(ix,jy,kz,n)-height(iz) dz=dz1+dz2 ww(ix,jy,iz,n)=(wwh(ix,jy,kz-1)*pinmconv(ix,jy,kz-1)*dz2 & +wwh(ix,jy,kz)*pinmconv(ix,jy,kz)*dz1)/dz - if ((jy.eq.nymin1).or.(ix.eq.nxmin1).or.(ix.eq.0).or.(jy.eq.0)) cycle - !**************************************************************** ! Compute slope of eta levels in windward direction and resulting ! vertical wind correction !**************************************************************** - kz=idx(ix,jy,iz) - dz1=height(iz)-etauvheight(ix,jy,kz-1,n) - dz2=etauvheight(ix,jy,kz,n)-height(iz) - dz=dz1+dz2 ix1=ix-1 jy1=jy-1 ixp=ix+1 jyp=jy+1 + if ((jy.eq.nylim).or.(jy.eq.0)) then + cycle + else if ((.not.xglobal).and.((ix.eq.nxlim).or.(ix.eq.0))) then + cycle + else if (ix.eq.nxlim) then + ixp=0 + else if (ix.eq.0) then + ix1=nxlim + endif + kz=idx(ix,jy,iz) + dz1=height(iz)-etauvheight(ix,jy,kz-1,n) + dz2=etauvheight(ix,jy,kz,n)-height(iz) + dz=dz1+dz2 + + dzdx1=(etauvheight(ixp,jy,kz-1,n)-etauvheight(ix1,jy,kz-1,n))*0.5 + dzdx2=(etauvheight(ixp,jy,kz,n)-etauvheight(ix1,jy,kz,n))*0.5 - dzdx1=(etauvheight(ixp,jy,kz-1,n)-etauvheight(ix1,jy,kz-1,n))/2. - dzdx2=(etauvheight(ixp,jy,kz,n)-etauvheight(ix1,jy,kz,n))/2. dzdx=(dzdx1*dz2+dzdx2*dz1)/dz - dzdy1=(etauvheight(ix,jyp,kz-1,n)-etauvheight(ix,jy1,kz-1,n))/2. - dzdy2=(etauvheight(ix,jyp,kz,n)-etauvheight(ix,jy1,kz,n))/2. + dzdy1=(etauvheight(ix,jyp,kz-1,n)-etauvheight(ix,jy1,kz-1,n))*0.5 + dzdy2=(etauvheight(ix,jyp,kz,n)-etauvheight(ix,jy1,kz,n))*0.5 dzdy=(dzdy1*dz2+dzdy2*dz1)/dz ww(ix,jy,iz,n)=ww(ix,jy,iz,n) + dzdx*uu(ix,jy,iz,n)*dxconst*cosf(jy) & - + dzdy*vv(ix,jy,iz,n)*dyconst - - enddo - enddo - enddo -!$OMP END DO - - ! Compute density gradients - !************************** -!$OMP DO - do jy=0,nymin1 - do ix=0,nxmin1 - drhodz(ix,jy,nz,n)=drhodz(ix,jy,nz-1,n) - drhodz(ix,jy,1,n)=(rho(ix,jy,2,n)-rho(ix,jy,1,n))/(height(2)-height(1)) - end do - end do -!$OMP END DO - -!$OMP DO - do iz=2,nz-1 - do jy=0,nymin1 - do ix=0,nxmin1 - drhodz(ix,jy,iz,n)=(rho(ix,jy,iz+1,n)-rho(ix,jy,iz-1,n))/ & - (height(iz+1)-height(iz-1)) - enddo - enddo - enddo -!$OMP END DO NOWAIT - - ! Keep original fields if wind_coord_type==ETA -#ifdef ETA -!$OMP DO - do kz=1,nz - do jy=0,nymin1 - do ix=0,nxmin1 - uueta(ix,jy,kz,n) = uuh(ix,jy,kz) - vveta(ix,jy,kz,n) = vvh(ix,jy,kz) - tteta(ix,jy,kz,n) = tth(ix,jy,kz,n) - qv(ix,jy,kz,n) = qvh(ix,jy,kz,n) - pveta(ix,jy,kz,n) = pvh(ix,jy,kz) - rhoeta(ix,jy,kz,n) = rhoh(ix,jy,kz) - prseta(ix,jy,kz,n) = prsh(ix,jy,kz) - ! eq A11 from Mid-latitude atmospheric dynamics by Jonathan E. Martin - ! tvirtual(ix,jy,kz,n)=tteta(ix,jy,kz,n)* & - ! ((qv(ix,jy,kz,n)+0.622)/(0.622*qv(ix,jy,kz,n)+0.622)) - if ((kz.gt.1).and.(kz.lt.nz)) drhodzeta(ix,jy,kz,n)= & - (rhoh(ix,jy,kz+1)-rhoh(ix,jy,kz-1))/ & - (height(kz+1)-height(kz-1)) - ! Note that this is still in SI units and not in eta - if (readclouds) then - clwc(ix,jy,kz,n)=clwch(ix,jy,kz,n) - if (.not. sumclouds) ciwc(ix,jy,kz,n)=ciwch(ix,jy,kz,n) - endif - end do + + dzdy*vv(ix,jy,iz,n)*dyconst end do end do + end do !$OMP END DO -!$OMP DO - do jy=0,nymin1 - do ix=0,nxmin1 - drhodzeta(ix,jy,1,n)=(rhoh(ix,jy,2)-rhoh(ix,jy,1))/(height(2)-height(1)) - drhodzeta(ix,jy,nz,n)=drhodzeta(ix,jy,nz-1,n) - ! tvirtual(ix,jy,1,n)=tt2(ix,jy,1,n)* & - ! (1.+0.378*ew(td2(ix,jy,1,n),ps(ix,jy,1,n))/ps(ix,jy,1,n)) - ! Convert w from Pa/s to eta/s, following FLEXTRA - !************************************************ - do kz=1,nuvz-1 - if (kz.eq.1) then - dpdeta=(akm(kz+1)-akm(kz)+(bkm(kz+1)-bkm(kz))*ps(ix,jy,1,n))/ & - (wheight(kz+1)-wheight(kz)) - else if (kz.eq.nuvz-1) then - dpdeta=(akm(kz)-akm(kz-1)+(bkm(kz)-bkm(kz-1))*ps(ix,jy,1,n))/ & - (wheight(kz)-wheight(kz-1)) - else - dpdeta=(akm(kz+1)-akm(kz-1)+(bkm(kz+1)-bkm(kz-1))*ps(ix,jy,1,n))/ & - (wheight(kz+1)-wheight(kz-1)) - endif - wweta(ix,jy,kz,n)=wwh(ix,jy,kz)/dpdeta - end do - wweta(ix,jy,nuvz,n)=wweta(ix,jy,nuvz-1,n) - !What is the appropriate value for the top level??? - end do - end do -!$OMP END DO -#endif +!$OMP WORKSHARE + ! Compute density gradients + !************************** + drhodz(0:nxlim,0:nylim,nz,n)=drhodz(0:nxlim,0:nylim,nz-1,n) + drhodz(0:nxlim,0:nylim,1,n)=(rho(0:nxlim,0:nylim,2,n)-rho(0:nxlim,0:nylim,1,n))/ & + (height(2)-height(1)) + forall (ix=0:nxlim,jy=0:nylim,iz=2:nz-1) + drhodz(ix,jy,iz,n)=(rho(ix,jy,iz+1,n)-rho(ix,jy,iz-1,n))/ & + (height(iz+1)-height(iz-1)) + end forall +!$OMP END WORKSHARE !$OMP END PARALLEL end subroutine verttransform_ecmwf_windfields -subroutine verttransform_ecmwf_stereo(n) +subroutine verttransform_ecmwf_polar(n) implicit none integer, intent(in) :: n @@ -640,6 +683,8 @@ subroutine verttransform_ecmwf_stereo(n) real :: uuaux,vvaux,uupolaux,vvpolaux,ddpol,ffpol,wdummy if (nglobal) then +!$OMP PARALLEL PRIVATE(iz,jy,ix,xlon,ylat) +!$OMP DO do iz=1,nz do jy=int(switchnorthg)-2,nymin1 ylat=ylat0+real(jy)*dy @@ -656,8 +701,12 @@ subroutine verttransform_ecmwf_stereo(n) end do end do end do +!$OMP END DO +!$OMP END PARALLEL - +!$OMP PARALLEL PRIVATE(iz,jy,ix,xlon,xlonr,ffpol,ddpol,uuaux,vvaux,uupolaux, & +!$OMP wdummy,vvpolaux) +!$OMP DO do iz=1,nz ! CALCULATE FFPOL, DDPOL FOR CENTRAL GRID POINT @@ -675,30 +724,37 @@ subroutine verttransform_ecmwf_stereo(n) ddpol=pi+atan(uu(nx/2-1,nymin1,iz,n)/ & vv(nx/2-1,nymin1,iz,n))-xlonr else - ddpol=pi/2-xlonr + ddpol=pi*0.5-xlonr endif - if(ddpol.lt.0.) ddpol=2.0*pi+ddpol - if(ddpol.gt.2.0*pi) ddpol=ddpol-2.0*pi + if(ddpol.lt.0.) ddpol=2.*pi+ddpol + if(ddpol.gt.2.*pi) ddpol=ddpol-2.*pi - ! CALCULATE U,V FOR 180 DEG, TRANSFORM TO POLAR STEREOGRAPHIC GRID - xlon=180.0 + ! CALCULATE U,V FOR 180 DEG, TRANSFORM TO POLAR STEREOGRAPHIC GRID + xlon=180. xlonr=xlon*pi/180. - ylat=90.0 + ylat=90. uuaux=-ffpol*sin(xlonr+ddpol) vvaux=-ffpol*cos(xlonr+ddpol) call cc2gll(northpolemap,ylat,xlon,uuaux,vvaux,uupolaux, & vvpolaux) + + ! Fix: Set W at pole to the zonally averaged W of the next equator- + ! ward parallel of latitude + wdummy=0. + jy=ny-2 + do ix=0,nxmin1 + wdummy=wdummy+ww(ix,jy,iz,n) + end do + wdummy=wdummy/real(nx) jy=nymin1 do ix=0,nxmin1 + ww(ix,jy,iz,n)=wdummy uupol(ix,jy,iz,n)=uupolaux vvpol(ix,jy,iz,n)=vvpolaux end do - end do - -#ifdef ETA - do iz=1,nz +#ifdef ETA xlon=xlon0+real(nx/2-1)*dx xlonr=xlon*pi/180. ffpol=sqrt(uueta(nx/2-1,nymin1,iz,n)**2+ & @@ -710,7 +766,7 @@ subroutine verttransform_ecmwf_stereo(n) ddpol=pi+atan(uueta(nx/2-1,nymin1,iz,n)/ & vveta(nx/2-1,nymin1,iz,n))-xlonr else - ddpol=pi/2-xlonr + ddpol=pi*0.5-xlonr endif if(ddpol.lt.0.) ddpol=2.0*pi+ddpol if(ddpol.gt.2.0*pi) ddpol=ddpol-2.0*pi @@ -724,33 +780,6 @@ subroutine verttransform_ecmwf_stereo(n) call cc2gll(northpolemap,ylat,xlon,uuaux,vvaux,uupolaux, & vvpolaux) - jy=nymin1 - do ix=0,nxmin1 - uupoleta(ix,jy,iz,n)=uupolaux - vvpoleta(ix,jy,iz,n)=vvpolaux - end do - end do -#endif - - - ! Fix: Set W at pole to the zonally averaged W of the next equator- - ! ward parallel of latitude - - do iz=1,nz - wdummy=0. - jy=ny-2 - do ix=0,nxmin1 - wdummy=wdummy+ww(ix,jy,iz,n) - end do - wdummy=wdummy/real(nx) - jy=nymin1 - do ix=0,nxmin1 - ww(ix,jy,iz,n)=wdummy - end do - end do - -#ifdef ETA - do iz=1,nz wdummy=0. jy=ny-2 do ix=0,nxmin1 @@ -760,9 +789,46 @@ subroutine verttransform_ecmwf_stereo(n) jy=nymin1 do ix=0,nxmin1 wweta(ix,jy,iz,n)=wdummy + uupoleta(ix,jy,iz,n)=uupolaux + vvpoleta(ix,jy,iz,n)=vvpolaux end do - end do + #endif + end do +!$OMP END DO +!$OMP END PARALLEL + + + ! Fix: Set W at pole to the zonally averaged W of the next equator- + ! ward parallel of latitude + + ! do iz=1,nz + ! wdummy=0. + ! jy=ny-2 + ! do ix=0,nxmin1 + ! wdummy=wdummy+ww(ix,jy,iz,n) + ! end do + ! wdummy=wdummy/real(nx) + ! jy=nymin1 + ! do ix=0,nxmin1 + ! ww(ix,jy,iz,n)=wdummy + ! end do + ! end do + +! #ifdef ETA +! do iz=1,nz +! wdummy=0. +! jy=ny-2 +! do ix=0,nxmin1 +! wdummy=wdummy+wweta(ix,jy,iz,n) +! end do +! wdummy=wdummy/real(nx) +! jy=nymin1 +! do ix=0,nxmin1 +! wweta(ix,jy,iz,n)=wdummy +! end do +! end do +! #endif endif @@ -772,6 +838,8 @@ subroutine verttransform_ecmwf_stereo(n) !******************************************************************* if (sglobal) then +!$OMP PARALLEL PRIVATE(iz,jy,ix,xlon,ylat) +!$OMP DO do iz=1,nz do jy=0,int(switchsouthg)+3 ylat=ylat0+real(jy)*dy @@ -788,7 +856,12 @@ subroutine verttransform_ecmwf_stereo(n) end do end do end do +!$OMP END DO +!$OMP END PARALLEL +!$OMP PARALLEL PRIVATE(iz,jy,ix,xlon,xlonr,ffpol,ddpol,uuaux,vvaux,uupolaux, & +!$OMP wdummy,vvpolaux) +!$OMP DO do iz=1,nz ! CALCULATE FFPOL, DDPOL FOR CENTRAL GRID POINT @@ -806,29 +879,36 @@ subroutine verttransform_ecmwf_stereo(n) ddpol=pi+atan(uu(nx/2-1,0,iz,n)/ & vv(nx/2-1,0,iz,n))+xlonr else - ddpol=pi/2-xlonr + ddpol=pi*0.5-xlonr endif - if(ddpol.lt.0.) ddpol=2.0*pi+ddpol - if(ddpol.gt.2.0*pi) ddpol=ddpol-2.0*pi + if(ddpol.lt.0.) ddpol=2.*pi+ddpol + if(ddpol.gt.2.*pi) ddpol=ddpol-2.*pi ! CALCULATE U,V FOR 180 DEG, TRANSFORM TO POLAR STEREOGRAPHIC GRID - xlon=180.0 + xlon=180. xlonr=xlon*pi/180. - ylat=-90.0 + ylat=-90. uuaux=+ffpol*sin(xlonr-ddpol) vvaux=-ffpol*cos(xlonr-ddpol) call cc2gll(northpolemap,ylat,xlon,uuaux,vvaux,uupolaux, & vvpolaux) + ! Fix: Set W at pole to the zonally averaged W of the next equator- + ! ward parallel of latitude + wdummy=0. + jy=1 + do ix=0,nxmin1 + wdummy=wdummy+ww(ix,jy,iz,n) + end do + wdummy=wdummy/real(nx) jy=0 do ix=0,nxmin1 + ww(ix,jy,iz,n)=wdummy uupol(ix,jy,iz,n)=uupolaux vvpol(ix,jy,iz,n)=vvpolaux end do - end do #ifdef ETA - do iz=1,nz ! CALCULATE FFPOL, DDPOL FOR CENTRAL GRID POINT ! ! AMSnauffer Nov 18 2004 Added check for case vv=0 @@ -844,7 +924,7 @@ subroutine verttransform_ecmwf_stereo(n) ddpol=pi+atan(uueta(nx/2-1,0,iz,n)/ & vveta(nx/2-1,0,iz,n))+xlonr else - ddpol=pi/2-xlonr + ddpol=pi*0.5-xlonr endif if(ddpol.lt.0.) ddpol=2.0*pi+ddpol if(ddpol.gt.2.0*pi) ddpol=ddpol-2.0*pi @@ -858,32 +938,6 @@ subroutine verttransform_ecmwf_stereo(n) call cc2gll(northpolemap,ylat,xlon,uuaux,vvaux,uupolaux, & vvpolaux) - jy=0 - do ix=0,nxmin1 - uupoleta(ix,jy,iz,n)=uupolaux - vvpoleta(ix,jy,iz,n)=vvpolaux - end do - end do -#endif - - ! Fix: Set W at pole to the zonally averaged W of the next equator- - ! ward parallel of latitude - - do iz=1,nz - wdummy=0. - jy=1 - do ix=0,nxmin1 - wdummy=wdummy+ww(ix,jy,iz,n) - end do - wdummy=wdummy/real(nx) - jy=0 - do ix=0,nxmin1 - ww(ix,jy,iz,n)=wdummy - end do - end do - -#ifdef ETA - do iz=1,nz wdummy=0. jy=1 do ix=0,nxmin1 @@ -893,177 +947,324 @@ subroutine verttransform_ecmwf_stereo(n) jy=0 do ix=0,nxmin1 wweta(ix,jy,iz,n)=wdummy + uupoleta(ix,jy,iz,n)=uupolaux + vvpoleta(ix,jy,iz,n)=vvpolaux end do - end do #endif + end do +!$OMP END DO +!$OMP END PARALLEL endif -end subroutine verttransform_ecmwf_stereo +end subroutine verttransform_ecmwf_polar -subroutine verttransform_ecmwf_cloud(lreadclouds,lsumclouds,nxlim,nylim,clouds_tmp,cloudsh_tmp,& - clw_tmp,ctwc_tmp,clwc_tmp,ciwc_tmp,lsprec_tmp,convprec_tmp,rho_tmp,tt_tmp,qv_tmp,uvzlev) +subroutine verttransform_ecmwf_cloud(lcw_tmp,lcwsum_tmp,nxlim,nylim,& + ctwc_tmp,clwc_tmp,ciwc_tmp,icloudbot_tmp,icloudtop_tmp,lsprec_tmp,convprec_tmp,rho_tmp, & + tt_tmp,qv_tmp,uvzlev,wzlev) implicit none - logical,intent(in) :: lreadclouds,lsumclouds + logical,intent(in) :: lcw_tmp,lcwsum_tmp integer, intent(in) :: nxlim,nylim - integer(kind=1),intent(inout) :: clouds_tmp(0:nxlim,0:nylim,nzmax) - integer,intent(inout) :: cloudsh_tmp(0:nxlim,0:nylim) - real,intent(inout) :: clw_tmp(0:nxlim,0:nylim,nzmax) - real,intent(inout) :: ctwc_tmp(0:nxlim,0:nylim) + real,intent(out) :: ctwc_tmp(0:nxlim,0:nylim) + real,intent(inout) :: clwc_tmp(0:nxlim,0:nylim,nzmax) real,intent(in) :: ciwc_tmp(0:nxlim,0:nylim,nzmax) - real,intent(in) :: lsprec_tmp(0:nxlim,0:nylim),convprec_tmp(0:nxlim,0:nylim) + real,intent(in) :: lsprec_tmp(0:nxlim,0:nylim,numpf),convprec_tmp(0:nxlim,0:nylim,numpf) real,intent(in),dimension(0:nxlim,0:nylim,nzmax) :: rho_tmp,tt_tmp,qv_tmp + real,intent(in),dimension(0:nxlim,0:nylim,nzmax) :: uvzlev,wzlev + + integer,intent(out) :: icloudbot_tmp(0:nxlim,0:nylim), icloudtop_tmp(0:nxlim,0:nylim) + + integer :: ix,jy + + ! converted parameters for eta coordinates: + integer :: max_cloudthck_eta + integer, dimension(2) :: conv_clrange_eta,highconvp_clrange_eta,lowconvp_clrange_eta + + ! AT, PS: for v11, we add back the quick fix to interpolate clouds in + ! interpol_rain developed by PS for v8 and extend it to using + ! cloud water fields (in apply_cloud_bounds) + + +! !$OMP PARALLEL PRIVATE(ix,jy,kz,k,lsp,convp,prec, & +! !$OMP max_cloudthck_eta,conv_clrange_eta,conv_clrange_eta,highconvp_clrange_eta, & +! $OMP highconvp_clrange_eta,lowconvp_clrange_eta,lowconvp_clrange_eta) REDUCTION(+:ctwc_tmp) +! !$OMP DO SCHEDULE(dynamic,max(1,nylim/50)) + + do jy=0,nylim + do ix=0,nxlim + +#ifdef ETA + call convert_cloud_params(ix,jy,nxlim,nylim,max_cloudthck_eta,conv_clrange_eta, & + highconvp_clrange_eta,lowconvp_clrange_eta,uvzlev) +#endif + + icloudbot_tmp(ix,jy) = icmv + + ! Find the bottom and top of clouds in grid cell ix, jy + call identify_cloud(ix,jy,lcw_tmp,lcwsum_tmp,nxlim,nylim, & + ctwc_tmp,clwc_tmp,ciwc_tmp,icloudbot_tmp,icloudtop_tmp,rho_tmp, & + tt_tmp,qv_tmp,uvzlev,wzlev) + + ! Adjust clouds according to minimum thickness, height, lower level, etc. + call apply_cloud_bounds(ix,jy,nxlim,nylim,lsprec_tmp,convprec_tmp,uvzlev, & + icloudbot_tmp,icloudtop_tmp,max_cloudthck_eta,conv_clrange_eta, & + highconvp_clrange_eta,lowconvp_clrange_eta) + enddo ! ix loop + enddo ! jy loop +end subroutine verttransform_ecmwf_cloud + +subroutine convert_cloud_params(ix,jy,nxlim,nylim,max_cloudthck_eta,conv_clrange_eta, & + highconvp_clrange_eta,lowconvp_clrange_eta,uvzlev) + + implicit none + + integer, intent(in) :: ix,jy,nxlim,nylim real,intent(in),dimension(0:nxlim,0:nylim,nzmax) :: uvzlev - integer,dimension(0:nxmax-1,0:nymax-1) :: rain_cloud_above - - integer :: ix,jy,kz,kz_inv - real :: pressure,rh,lsp,convp,cloudh_min,prec - - !*********************************************************************************** - if (lreadclouds) then !HG METHOD - ! The method is loops all grids vertically and constructs the 3D matrix for clouds - ! Cloud top and cloud bottom gid cells are assigned as well as the total column - ! cloud water. For precipitating grids, the type and whether it is in or below - ! cloud scavenging are assigned with numbers 2-5 (following the old metod). - ! Distinction is done for lsp and convp though they are treated the same in regards - ! to scavenging. Also clouds that are not precipitating are defined which may be - ! to include future cloud processing by non-precipitating-clouds. - !*********************************************************************************** - !write(*,*) 'Global ECMWF fields: using cloud water' - clw_tmp(0:nxlim,0:nylim,:)=0.0 - ! icloud_stats(:,:,:,n)=0.0 - ctwc_tmp(:,:)=0.0 - clouds_tmp(0:nxlim,0:nylim,:)=0 - ! If water/ice are read separately into clwc and ciwc, store sum in clwc - if (.not.lsumclouds) then - clwc_tmp(0:nxlim,0:nylim,:) = clwc_tmp(0:nxlim,0:nylim,:) + ciwc_tmp(:,:,:) - end if - do jy=0,nylim - do ix=0,nxlim - lsp=lsprec_tmp(ix,jy) - convp=convprec_tmp(ix,jy) - prec=lsp+convp - ! tot_cloud_h=0 - ! Find clouds in the vertical + ! converted parameters for eta coordinates: + integer,intent(out) :: max_cloudthck_eta + integer, dimension(2),intent(out) :: conv_clrange_eta,highconvp_clrange_eta, & + lowconvp_clrange_eta + integer :: i, kz + + + ! Convert cloud parameters to eta coords. + ! Reverse sign when using eta (eta:1-0, meter:0-max) + max_cloudthck_eta=int(uvheight(nz)*eta_convert) + conv_clrange_eta=int(uvheight(nz)*eta_convert) + highconvp_clrange_eta=int(uvheight(nz)*eta_convert) + lowconvp_clrange_eta=int(uvheight(nz)*eta_convert) + do kz=1,nz + if (uvzlev(ix,jy,kz).gt.max_cloudthck) then + max_cloudthck_eta=int(uvheight(kz)*eta_convert) + exit + endif + end do + do i=1,2 + do kz=1,nz + if (uvzlev(ix,jy,kz).gt.conv_clrange(i)) then + conv_clrange_eta(i)=int(uvheight(kz)*eta_convert) + exit + endif + end do + do kz=1,nz + if (uvzlev(ix,jy,kz).gt.highconvp_clrange(i)) then + highconvp_clrange_eta(i)=int(uvheight(kz)*eta_convert) + exit + endif + end do + do kz=1,nz + if (uvzlev(ix,jy,kz).gt.lowconvp_clrange(i)) then + lowconvp_clrange_eta(i)=int(uvheight(kz)*eta_convert) + exit + endif + end do + end do +end subroutine convert_cloud_params + +subroutine identify_cloud(ix,jy,lcw_tmp,lcwsum_tmp,nxlim,nylim, & + ctwc_tmp,clwc_tmp,ciwc_tmp,icloudbot_tmp,icloudtop_tmp,rho_tmp, & + tt_tmp,qv_tmp,uvzlev,wzlev) + + implicit none + + logical,intent(in) :: lcw_tmp,lcwsum_tmp + integer, intent(in) :: ix,jy,nxlim,nylim + real,intent(out) :: ctwc_tmp(0:nxlim,0:nylim) + + real,intent(inout) :: clwc_tmp(0:nxlim,0:nylim,nzmax) + real,intent(in) :: ciwc_tmp(0:nxlim,0:nylim,nzmax) + real,intent(in),dimension(0:nxlim,0:nylim,nzmax) :: rho_tmp,tt_tmp,qv_tmp + real,intent(in),dimension(0:nxlim,0:nylim,nzmax) :: uvzlev,wzlev + + integer,intent(out) :: icloudbot_tmp(0:nxlim,0:nylim), icloudtop_tmp(0:nxlim,0:nylim) + + integer :: kz + real :: pressure,rh + real :: clw + + !******************************************************************************* + if (lcw_tmp) then ! identify clouds based on cloud water content + !******************************************************************************* + + ctwc_tmp(ix,jy) = 0. ! initialise cloud total water content + if (.not.lcwsum_tmp) clwc_tmp(ix,jy,:) = clwc_tmp(ix,jy,:) + ciwc_tmp(ix,jy,:) + do kz = 1,nz-1 ! Changed order of loop to prevent ETA computation to be done unnecessarily + + ! vertically integrate cloud water and determine cloud bottom, top + ! cloud water per cell in kg / m2 + ! calculate cloud water mass per area: kgCW/kgAIR * kgAIR/m3 * m = kgCW/m2 + + ! assuming rho is in kg/m3 and hz in m gives: kg/kg * kg/m3 *m3/kg /m = m2/m3 #ifdef ETA - cloudh_min=uvzlev(ix,jy,nz-1) + clw = clwc_tmp(ix,jy,kz)*rho_tmp(ix,jy,kz)*(uvzlev(ix,jy,kz+1)-uvzlev(ix,jy,kz)) #else - cloudh_min=height(nz-1) + clw = clwc_tmp(ix,jy,kz)*rho_tmp(ix,jy,kz)*(height(kz+1)-height(kz)) #endif - do kz=1, nz-1 !go from top to bottom - if (clwc_tmp(ix,jy,kz).gt.0) then - ! assuming rho is in kg/m3 and hz in m gives: kg/kg * kg/m3 *m3/kg /m = m2/m3 + ! Add this layer to column cloud water [m3/m3] + ctwc_tmp(ix,jy) = ctwc_tmp(ix,jy)+clw ! kg / m2 (or eta) in column + + if (clw .gt. 0.) then ! cloud layer - maybe use threshold? #ifdef ETA - clw_tmp(ix,jy,kz)=(clwc_tmp(ix,jy,kz)*rho_tmp(ix,jy,kz))* & - (uvzlev(ix,jy,kz+1)-uvzlev(ix,jy,kz)) - cloudh_min=min(uvzlev(ix,jy,kz+1),uvzlev(ix,jy,kz)) + if (icloudbot_tmp(ix,jy) .eq. icmv) & !cloud bottom set to first cloud instance + icloudbot_tmp(ix,jy) = int(uvheight(kz)*eta_convert) + icloudtop_tmp(ix,jy) = int(uvheight(kz)*eta_convert) !After the loop, icloudtop will be the top #else - clw_tmp(ix,jy,kz)=(clwc_tmp(ix,jy,kz)*rho_tmp(ix,jy,kz))* & - (height(kz+1)-height(kz)) - ! Cloud BOT height stats [m] - ! icloud_stats(ix,jy,3,n)= min(height(kz+1),height(kz)) - cloudh_min=min(height(kz+1),height(kz)) + if (icloudbot_tmp(ix,jy) .eq. icmv) & + icloudbot_tmp(ix,jy) = (height(kz)) + icloudtop_tmp(ix,jy) = (height(kz)) #endif - ! tot_cloud_h=tot_cloud_h+(height(kz+1)-height(kz)) - ! Column cloud water [m3/m3] - ! icloud_stats(ix,jy,4,n)= icloud_stats(ix,jy,4,n)+clw(ix,jy,kz,n) - ctwc_tmp(ix,jy) = ctwc_tmp(ix,jy)+clw_tmp(ix,jy,kz) - - endif - end do - - ! If Precipitation. Define removal type in the vertical - if ((lsp.gt.0.01).or.(convp.gt.0.01)) then ! cloud and precipitation + endif + end do - do kz=nz,2,-1 !go Bottom up! - if (clw_tmp(ix,jy,kz).gt. 0) then ! is in cloud + !************************************************************************** + else ! identify clouds using relative humidity + !************************************************************************** + do kz = 1,nz-1 ! Changed order of loop to prevent ETA computation to be done unnecessarily + pressure=rho_tmp(ix,jy,kz)*r_air*tt_tmp(ix,jy,kz) + rh=qv_tmp(ix,jy,kz)/f_qvsat(pressure,tt_tmp(ix,jy,kz)) + ! PS if (prec.gt.0.01) print*,'relhum',prec,kz,rh,height(kz) + if (rh .ge. rhmin) then #ifdef ETA - cloudsh_tmp(ix,jy)=cloudsh_tmp(ix,jy) + & - int(uvzlev(ix,jy,kz)-uvzlev(ix,jy,kz-1)) + if (icloudbot_tmp(ix,jy) .eq. icmv) then + icloudbot_tmp(ix,jy)=int(uvheight(kz)*eta_convert) + endif + icloudtop_tmp(ix,jy)=int(uvheight(kz) *eta_convert) #else - cloudsh_tmp(ix,jy)=cloudsh_tmp(ix,jy)+int(height(kz)-height(kz-1)) + if (icloudbot_tmp(ix,jy) .eq. icmv) then + icloudbot_tmp(ix,jy)=(height(kz)) + endif + icloudtop_tmp(ix,jy)=(height(kz)) #endif - clouds_tmp(ix,jy,kz)=1 ! is a cloud - if (lsp.ge.convp) then - clouds_tmp(ix,jy,kz)=3 ! lsp in-cloud - else - clouds_tmp(ix,jy,kz)=2 ! convp in-cloud - endif ! convective or large scale - elseif((clw_tmp(ix,jy,kz).le.0) .and. (cloudh_min.ge.height(kz))) then - ! is below cloud - if (lsp.ge.convp) then - clouds_tmp(ix,jy,kz)=5 ! lsp dominated washout - else - clouds_tmp(ix,jy,kz)=4 ! convp dominated washout - endif ! convective or large scale - endif - if (height(kz).ge. 19000) then ! set a max height for removal - clouds_tmp(ix,jy,kz)=0 - endif !clw>0 - end do !nz - endif ! precipitation - end do + endif end do +!************************************************************************** + endif ! lcw true/false +!************************************************************************** +end subroutine identify_cloud + +subroutine apply_cloud_bounds(ix,jy,nxlim,nylim,lsprec_tmp,convprec_tmp,uvzlev, & + icloudbot_tmp,icloudtop_tmp,max_cloudthck_eta,conv_clrange_eta, & + highconvp_clrange_eta,lowconvp_clrange_eta) + + implicit none - ! eso: copy the relevant data to clw4 to reduce amount of communicated data for MPI - ! ctwc(:,:,n) = icloud_stats(:,:,4,n) + integer, intent(in) :: ix,jy,nxlim,nylim - !************************************************************************** - else ! use old definitions - !************************************************************************** - ! create a cloud and rainout/washout field, clouds occur where rh>80% - ! total cloudheight is stored at level 0 - !write(*,*) 'Global fields: using cloud water from Parameterization' - do jy=0,nylim - do ix=0,nxlim - ! OLD METHOD - rain_cloud_above(ix,jy)=0 - lsp=lsprec_tmp(ix,jy) - convp=convprec_tmp(ix,jy) - cloudsh_tmp(ix,jy)=0 - do kz_inv=1,nz-1 - kz=nz-kz_inv+1 - pressure=rho_tmp(ix,jy,kz)*r_air*tt_tmp(ix,jy,kz) - rh=qv_tmp(ix,jy,kz)/f_qvsat(pressure,tt_tmp(ix,jy,kz)) - clouds_tmp(ix,jy,kz)=0 - if (rh.gt.0.8) then ! in cloud - if ((lsp.gt.0.01).or.(convp.gt.0.01)) then ! cloud and precipitation - rain_cloud_above(ix,jy)=1 + real,intent(in) :: lsprec_tmp(0:nxlim,0:nylim,numpf),convprec_tmp(0:nxlim,0:nylim,numpf) + real,intent(in),dimension(0:nxlim,0:nylim,nzmax) :: uvzlev + + ! converted parameters for eta coordinates: + integer,intent(in) :: max_cloudthck_eta + integer,intent(in),dimension(2) :: conv_clrange_eta,highconvp_clrange_eta,lowconvp_clrange_eta + + integer,intent(inout) :: icloudbot_tmp(0:nxlim,0:nylim), icloudtop_tmp(0:nxlim,0:nylim) + + integer :: icloudtop_old, min_cloudtop + integer :: kz + real :: lsp,convp,prec + logical lconvectprec + + + real,parameter :: precmin = 0.002 ! minimum prec in mm/h for cloud diagn. + + + ! memorise icloudtop + icloudtop_old = icloudtop_tmp(ix,jy) + ! top level, kz=nz-1 + ! limit cloud top to 19 km: #ifdef ETA - cloudsh_tmp(ix,jy)=cloudsh_tmp(ix,jy)+ & - int(uvzlev(ix,jy,kz)-uvzlev(ix,jy,kz-1)) + ! Enforce maximum cloudtop height in eta coords + if (icloudbot_tmp(ix,jy) .eq. icmv) then !Can we skip to the next gridcell? + icloudtop_tmp(ix,jy)=icmv + else if (icloudtop_tmp(ix,jy) .lt. max_cloudthck_eta) then + icloudtop_tmp(ix,jy) = max_cloudthck_eta + endif + + ! To compute the minimum thickness in eta coordinates, this needs + ! to be computed from the bottom level: + ! 1) Convert icloudbot_tmp to meter coordinates + ! 2) Add the min_cloudthck to the icloudbot_tmp(meter) + ! 3) Convert this back to eta coordinates (min_cloudtop(eta)) + ! 4) Check if our cloudtop is higher (lower eta) than this minimum + do kz=1,nz + if (int(uvheight(kz)*eta_convert).le.icloudbot_tmp(ix,jy)) then + min_cloudtop = uvzlev(ix,jy,kz)+min_cloudthck ! In meters + exit + endif + end do + do kz=1,nz + if (int(uvzlev(ix,jy,kz)).gt.min_cloudtop) then ! back to eta + min_cloudtop=int(uvheight(kz)*eta_convert) + exit + endif + enddo + ! PS get rid of too thin clouds + if (icloudtop_tmp(ix,jy) .gt. min_cloudtop) then + icloudbot_tmp(ix,jy)=icmv + icloudtop_tmp(ix,jy)=icmv + endif + ! PS implement a rough fix for badly represented convection + ! PS is based on looking at a limited set of comparison data + lsp= sum( lsprec_tmp(ix,jy,:) ) + convp=sum( convprec_tmp(ix,jy,:) ) + prec=lsp+convp + if (lsp.gt.convp) then ! prectype='lsp' + lconvectprec = .false. + else ! prectype='cp ' + lconvectprec = .true. + endif + if (lconvectprec .and. prec .gt. precmin .and. & + (icloudtop_old .gt. conv_clrange_eta(2) .or. & + icloudbot_tmp(ix,jy) .lt. conv_clrange_eta(1)) ) then + if (convp .lt. 0.1) then + icloudbot_tmp(ix,jy) = lowconvp_clrange_eta(1) + icloudtop_tmp(ix,jy) = lowconvp_clrange_eta(2) + else + icloudbot_tmp(ix,jy) = highconvp_clrange_eta(1) + icloudtop_tmp(ix,jy) = highconvp_clrange_eta(2) + endif + endif + + !--------------------------------------------------------------------------------------- #else - cloudsh_tmp(ix,jy)=cloudsh_tmp(ix,jy)+ & - int(height(kz)-height(kz-1)) + if (icloudbot_tmp(ix,jy) .eq. icmv) then ! if no bottom found, no top either + icloudtop_tmp(ix,jy)=icmv + else if (icloudtop_tmp(ix,jy) .gt. max_cloudthck) then ! max cloud height + icloudtop_tmp(ix,jy) = max_cloudthck + endif + ! PS get rid of too thin clouds + if (icloudtop_tmp(ix,jy) .lt. icloudbot_tmp(ix,jy) + min_cloudthck) then + icloudbot_tmp(ix,jy)=icmv + icloudtop_tmp(ix,jy)=icmv + endif + ! PS implement a rough fix for badly represented convection + ! PS is based on looking at a limited set of comparison data + lsp= sum( lsprec_tmp(ix,jy,:) ) + convp=sum( convprec_tmp(ix,jy,:) ) + prec=lsp+convp + if (lsp.gt.convp) then ! prectype='lsp' + lconvectprec = .false. + else ! prectype='cp ' + lconvectprec = .true. + endif + if (lconvectprec .and. prec .gt. precmin .and. & + (icloudtop_old .lt. conv_clrange(2) .or. & + icloudbot_tmp(ix,jy) .gt. conv_clrange(1)) ) then + if (convp .lt. 0.1) then + icloudbot_tmp(ix,jy) = lowconvp_clrange(1) + icloudtop_tmp(ix,jy) = lowconvp_clrange(2) + else + icloudbot_tmp(ix,jy) = highconvp_clrange(1) + icloudtop_tmp(ix,jy) = highconvp_clrange(2) + endif + endif #endif - if (lsp.ge.convp) then - clouds_tmp(ix,jy,kz)=3 ! lsp dominated rainout - else - clouds_tmp(ix,jy,kz)=2 ! convp dominated rainout - endif - else ! no precipitation - clouds_tmp(ix,jy,kz)=1 ! cloud - endif - else ! no cloud - if (rain_cloud_above(ix,jy).eq.1) then ! scavenging - if (lsp.ge.convp) then - clouds_tmp(ix,jy,kz)=5 ! lsp dominated washout - else - clouds_tmp(ix,jy,kz)=4 ! convp dominated washout - endif - endif - endif - end do - !END OLD METHOD - end do - end do - endif !readclouds -end subroutine verttransform_ecmwf_cloud +end subroutine apply_cloud_bounds subroutine verttransform_gfs(n,uuh,vvh,wwh,pvh) - ! i i i i i + ! i i i i i !***************************************************************************** ! * ! This subroutine transforms temperature, dew point temperature and * @@ -1078,60 +1279,89 @@ subroutine verttransform_gfs(n,uuh,vvh,wwh,pvh) ! 12 August 1996 * ! Update: 16 January 1998 * ! * + ! * + !***************************************************************************** + ! CHANGES * ! Major update: 17 February 1999 * ! by G. Wotawa * - ! CHANGE 17/11/2005 Caroline Forster, NCEP GFS version * ! * - ! - Vertical levels for u, v and w are put together * - ! - Slope correction for vertical velocity: Modification of calculation * - ! procedure * + ! - Vertical levels for u, v and w are put together * + ! - Slope correction for vertical velocity: Modification of calculation * + ! procedure * ! * - !***************************************************************************** - ! Changes, Bernd C. Krueger, Feb. 2001: - ! Variables tth and qvh (on eta coordinates) from common block - ! - ! Unified ECMWF and GFS builds - ! Marian Harustak, 12.5.2017 - ! - Renamed routine from verttransform to verttransform_gfs - ! + ! Bernd C. Krueger, Feb. 2001: * + ! Variables tth and qvh (on eta coordinates) from common block * + ! * + ! Sabine Eckhardt, March 2007: * + ! added the variable cloud for use with scavenging - descr. in com_mod * + ! PS/AT 2018/-21: variable "cloud" is replaced by quickfix, see below * + ! * + ! Unified ECMWF and GFS builds * + ! Marian Harustak, 12.5.2017 * + ! - Renamed from verttransform to verttransform_ecmwf * + ! * + ! undocumented modifications by NILU for v10 * + ! * + ! Petra Seibert, 2018-06-13: * + ! - put back SAVE attribute for INIT, just to be safe * + ! - minor changes, most of them just cosmetics * + ! for details see changelog.txt in branch unive * + ! * + ! Petra Seibert, Anne Philipp, 2019-05-02: implement wetdepo quickfix * + ! Petra Seibert, Anne Tipka, 2020-11-19: reimplement in latest version * + ! * + ! **************************************************************************** + !***************************************************************************** ! * ! Variables: * + ! Note PS, AT 2021-01-29: all these fields are 0:nxmax-1,0:nymax-1 !! * ! nx,ny,nz field dimensions in x,y and z direction * - ! uu(0:nxmax,0:nymax,nzmax,2) wind components in x-direction [m/s] * - ! vv(0:nxmax,0:nymax,nzmax,2) wind components in y-direction [m/s] * - ! ww(0:nxmax,0:nymax,nzmax,2) wind components in z-direction [deltaeta/s]* - ! tt(0:nxmax,0:nymax,nzmax,2) temperature [K] * - ! pv(0:nxmax,0:nymax,nzmax,2) potential voriticity (pvu) * - ! ps(0:nxmax,0:nymax,2) surface pressure [Pa] * - ! clouds(0:nxmax,0:nymax,0:nzmax,2) cloud field for wet deposition * + ! icloudbot(0:nxmax,0:nymax,numwfmem) cloud bottom field for wet deposition * + ! icloudtop(0:nxmax,0:nymax,numwfmem) cloud thickness for wet deposition * + ! uu(0:nxmax,0:nymax,nzmax,numwfmem) wind components in x-direction [m/s]* + ! vv(0:nxmax,0:nymax,nzmax,numwfmem) wind components in y-direction [m/s]* + ! ww(0:nxmax,0:nymax,nzmax,numwfmem) wind components in z-direction * + ! [deltaeta/s] * + ! tt(0:nxmax,0:nymax,nzmax,numwfmem) temperature [K] * + ! pv(0:nxmax,0:nymax,nzmax,numwfmem) potential voriticity (pvu) * + ! ps(0:nxmax,0:nymax,numwfmem) surface pressure [Pa] * ! * !***************************************************************************** - !use cmapf_mod - implicit none - integer :: ix,jy,kz,iz,n,kmin,kl,klp,ix1,jy1,ixp,jyp - integer :: rain_cloud_above,kz_inv - real :: pressure - real :: rh,lsp,cloudh_min,convp,prec - real :: rhoh(nuvzmax),pinmconv(nzmax) + real,intent(in),dimension(0:nxmax-1,0:nymax-1,nuvzmax) :: uuh,vvh,pvh + real,intent(in),dimension(0:nxmax-1,0:nymax-1,nwzmax) :: wwh + + real,dimension(0:nxmax-1,0:nymax-1,nzmax) :: uvwzlev + real,dimension(nuvzmax) :: rhoh + real,dimension(nwzmax) :: wzlev + real,dimension(nzmax) :: pinmconv + +! local array introduced in v10 by ?? to achieve better loop order (PS) + integer,dimension(0:nxmax-1,0:nymax-1) :: idx + + integer :: icloudtop_old + integer :: ix,jy,kz,iz,n,kmin,kl,klp,ix1,jy1,ixp,jyp,ixm,jym,kz_inv + real :: clw ! cloud water in kg / m2 in a grid cell + real :: pressure,rh,lsp,convp,prec + real :: pint,tv,tvold,pold,dz1,dz2,dz,ui,vi real :: xlon,ylat,xlonr,dzdx,dzdy real :: dzdx1,dzdx2,dzdy1,dzdy2,cosf real :: uuaux,vvaux,uupolaux,vvpolaux,ddpol,ffpol,wdummy - real :: uuh(0:nxmax-1,0:nymax-1,nuvzmax) - real :: vvh(0:nxmax-1,0:nymax-1,nuvzmax) - real :: pvh(0:nxmax-1,0:nymax-1,nuvzmax) - real :: wwh(0:nxmax-1,0:nymax-1,nwzmax) - real :: wzlev(nwzmax),uvwzlev(0:nxmax-1,0:nymax-1,nzmax) + real,parameter :: const=r_air/ga + real,parameter :: precmin = 0.002 ! minimum prec in mm/h for cloud diagnostics + + logical lconvectprec + logical, save :: init = .true. !PS 2018-06-13: add back save attribute ! NCEP version integer :: llev, i - logical :: init = .true. + integer :: rank_thread , nr_threads !************************************************************************* @@ -1157,15 +1387,18 @@ subroutine verttransform_gfs(n,uuh,vvh,wwh,pvh) ! Loop over the whole grid !************************* - +!$OMP DO do jy=0,nymin1 do ix=0,nxmin1 + +! if ((jy.eq.0).and.(ix.eq.0)) print*, 'in loop 1' + ! NCEP version: find first level above ground llev = 0 do i=1,nuvz if (ps(ix,jy,1,n).lt.akz(i)) llev=i - end do + enddo llev = llev+1 if (llev.gt.nuvz-2) llev = nuvz-2 ! if (llev.eq.nuvz-2) write(*,*) 'verttransform @@ -1182,6 +1415,8 @@ subroutine verttransform_gfs(n,uuh,vvh,wwh,pvh) uvwzlev(ix,jy,llev)=0. rhoh(llev)=pold/(r_air*tvold) +! if ((jy.eq.0).and.(ix.eq.0)) print*, 'in loop 2' + do kz=llev+1,nuvz pint=akz(kz)+bkz(kz)*ps(ix,jy,1,n) tv=tth(ix,jy,kz,n)*(1.+0.608*qvh(ix,jy,kz,n)) @@ -1197,9 +1432,10 @@ subroutine verttransform_gfs(n,uuh,vvh,wwh,pvh) tvold=tv pold=pint - end do + enddo ! pinmconv=(h2-h1)/(p2-p1) +! if ((jy.eq.0).and.(ix.eq.0)) print*, 'in loop 3' pinmconv(llev)=(uvwzlev(ix,jy,llev+1)-uvwzlev(ix,jy,llev))/ & ((aknew(llev+1)+bknew(llev+1)*ps(ix,jy,1,n))- & @@ -1208,7 +1444,7 @@ subroutine verttransform_gfs(n,uuh,vvh,wwh,pvh) pinmconv(kz)=(uvwzlev(ix,jy,kz+1)-uvwzlev(ix,jy,kz-1))/ & ((aknew(kz+1)+bknew(kz+1)*ps(ix,jy,1,n))- & (aknew(kz-1)+bknew(kz-1)*ps(ix,jy,1,n))) - end do + enddo pinmconv(nz)=(uvwzlev(ix,jy,nz)-uvwzlev(ix,jy,nz-1))/ & ((aknew(nz)+bknew(nz)*ps(ix,jy,1,n))- & (aknew(nz-1)+bknew(nz-1)*ps(ix,jy,1,n))) @@ -1216,13 +1452,17 @@ subroutine verttransform_gfs(n,uuh,vvh,wwh,pvh) ! Levels, where u,v,t and q are given !************************************ +! if ((jy.eq.0).and.(ix.eq.0)) print*, 'in loop 4' + uu(ix,jy,1,n)=uuh(ix,jy,llev) vv(ix,jy,1,n)=vvh(ix,jy,llev) tt(ix,jy,1,n)=tth(ix,jy,llev,n) qv(ix,jy,1,n)=qvh(ix,jy,llev,n) + + ! IP & SEC, 201812 add clouds - if (readclouds) then + if (lcw) then clwc(ix,jy,1,n)=clwch(ix,jy,llev,n) endif pv(ix,jy,1,n)=pvh(ix,jy,llev) @@ -1233,22 +1473,27 @@ subroutine verttransform_gfs(n,uuh,vvh,wwh,pvh) tt(ix,jy,nz,n)=tth(ix,jy,nuvz,n) qv(ix,jy,nz,n)=qvh(ix,jy,nuvz,n) ! IP & SEC, 201812 add clouds - if (readclouds) then + + + if (lcw) then clwc(ix,jy,nz,n)=clwch(ix,jy,nuvz,n) endif pv(ix,jy,nz,n)=pvh(ix,jy,nuvz) rho(ix,jy,nz,n)=rhoh(nuvz) pplev(ix,jy,nz,n)=akz(nuvz) kmin=llev+1 + + do iz=2,nz-1 do kz=kmin,nuvz - if(height(iz).gt.uvwzlev(ix,jy,nuvz)) then + ! print*, 'in loop 4.3.1', jy, ix, iz, kz + if (height(iz).gt.uvwzlev(ix,jy,nuvz)) then uu(ix,jy,iz,n)=uu(ix,jy,nz,n) vv(ix,jy,iz,n)=vv(ix,jy,nz,n) tt(ix,jy,iz,n)=tt(ix,jy,nz,n) qv(ix,jy,iz,n)=qv(ix,jy,nz,n) ! IP & SEC, 201812 add clouds - if (readclouds) then + if (lcw) then clwc(ix,jy,iz,n)=clwc(ix,jy,nz,n) endif pv(ix,jy,iz,n)=pv(ix,jy,nz,n) @@ -1257,31 +1502,34 @@ subroutine verttransform_gfs(n,uuh,vvh,wwh,pvh) exit endif if ((height(iz).gt.uvwzlev(ix,jy,kz-1)).and. & - (height(iz).le.uvwzlev(ix,jy,kz))) then + (height(iz).le.uvwzlev(ix,jy,kz))) then + !real,dimension(0:nxmax-1,0:nymax-1,nzmax) :: uvwzlev dz1=height(iz)-uvwzlev(ix,jy,kz-1) dz2=uvwzlev(ix,jy,kz)-height(iz) dz=dz1+dz2 uu(ix,jy,iz,n)=(uuh(ix,jy,kz-1)*dz2+uuh(ix,jy,kz)*dz1)/dz vv(ix,jy,iz,n)=(vvh(ix,jy,kz-1)*dz2+vvh(ix,jy,kz)*dz1)/dz - tt(ix,jy,iz,n)=(tth(ix,jy,kz-1,n)*dz2 & - +tth(ix,jy,kz,n)*dz1)/dz - qv(ix,jy,iz,n)=(qvh(ix,jy,kz-1,n)*dz2 & - +qvh(ix,jy,kz,n)*dz1)/dz + tt(ix,jy,iz,n)=(tth(ix,jy,kz-1,n)*dz2+tth(ix,jy,kz,n)*dz1)/dz + qv(ix,jy,iz,n)=(qvh(ix,jy,kz-1,n)*dz2+qvh(ix,jy,kz,n)*dz1)/dz + ! IP & SEC, 201812 add clouds - if (readclouds) then - clwc(ix,jy,iz,n)=(clwch(ix,jy,kz-1,n)*dz2 & - +clwch(ix,jy,kz,n)*dz1)/dz + if (lcw) then + clwc(ix,jy,iz,n)= & + (clwch(ix,jy,kz-1,n)*dz2+clwch(ix,jy,kz,n)*dz1)/dz endif pv(ix,jy,iz,n)=(pvh(ix,jy,kz-1)*dz2+pvh(ix,jy,kz)*dz1)/dz + rho(ix,jy,iz,n)=(rhoh(kz-1)*dz2+rhoh(kz)*dz1)/dz + pplev(ix,jy,iz,n)=(akz(kz-1)*dz2+akz(kz)*dz1)/dz - endif - end do - end do + endif + enddo + enddo - ! Levels, where w is given - !************************* + + ! Interpolation of vertical motion (levels where w is given) + !*********************************************************** ww(ix,jy,1,n)=wwh(ix,jy,llev)*pinmconv(llev) ww(ix,jy,nz,n)=wwh(ix,jy,nwz)*pinmconv(nz) @@ -1289,53 +1537,68 @@ subroutine verttransform_gfs(n,uuh,vvh,wwh,pvh) do iz=2,nz do kz=kmin,nwz if ((height(iz).gt.wzlev(kz-1)).and. & - (height(iz).le.wzlev(kz))) then + (height(iz).le.wzlev(kz))) then dz1=height(iz)-wzlev(kz-1) dz2=wzlev(kz)-height(iz) dz=dz1+dz2 ww(ix,jy,iz,n)=(wwh(ix,jy,kz-1)*pinmconv(kz-1)*dz2 & - +wwh(ix,jy,kz)*pinmconv(kz)*dz1)/dz + +wwh(ix,jy,kz)*pinmconv(kz)*dz1)/dz endif - end do - end do - + enddo + enddo +!if ((jy.eq.0).and.(ix.eq.0)) print*, 'in loop 6' ! Compute density gradients at intermediate levels !************************************************* - drhodz(ix,jy,1,n)=(rho(ix,jy,2,n)-rho(ix,jy,1,n))/ & - (height(2)-height(1)) + drhodz(ix,jy,1,n)=(rho(ix,jy,2,n)-rho(ix,jy,1,n))/(height(2)-height(1)) do kz=2,nz-1 drhodz(ix,jy,kz,n)=(rho(ix,jy,kz+1,n)-rho(ix,jy,kz-1,n))/ & - (height(kz+1)-height(kz-1)) - end do + (height(kz+1)-height(kz-1)) + enddo drhodz(ix,jy,nz,n)=drhodz(ix,jy,nz-1,n) - end do - end do + !if ((jy.eq.0).and.(ix.eq.0)) + + enddo + enddo +!$OMP END DO !**************************************************************** ! Compute slope of eta levels in windward direction and resulting ! vertical wind correction !**************************************************************** + +!$OMP DO do jy=1,ny-2 cosf=cos((real(jy)*dy+ylat0)*pi180) + do ix=1,nx-2 + ! print*, '1] slope of eta levels jy, ix=',jy, ix + + !if ((jy.le.2).and.(ix.eq.1)) print*, 'in eta loop 1' ! NCEP version: find first level above ground llev = 0 do i=1,nuvz if (ps(ix,jy,1,n).lt.akz(i)) llev=i end do - llev = llev+1 - if (llev.gt.nuvz-2) llev = nuvz-2 + llev = llev+1 + +!if ((jy.le.2).and.(ix.eq.1)) print*, 'in eta loop 2' + + + if (llev.gt.nuvz-2) llev = nuvz-2 ! if (llev.eq.nuvz-2) write(*,*) 'verttransform ! +WARNING: LLEV eq NUZV-2' ! NCEP version kmin=llev+1 + + !if ((jy.le.3).and.(ix.gt.250)) print*, 'in eta loop 3' + do iz=2,nz-1 ui=uu(ix,jy,iz,n)*dxconst/cosf @@ -1343,6 +1606,7 @@ subroutine verttransform_gfs(n,uuh,vvh,wwh,pvh) klp=nz+1 do kz=kmin,nz + if ((height(iz).gt.uvwzlev(ix,jy,kz-1)).and. & (height(iz).le.uvwzlev(ix,jy,kz))) then dz1=height(iz)-uvwzlev(ix,jy,kz-1) @@ -1352,12 +1616,18 @@ subroutine verttransform_gfs(n,uuh,vvh,wwh,pvh) klp=kz exit endif - end do + + enddo if (klp.eq.nz+1) then klp=nz kl=nz-1 - dz1=uvwzlev(ix,jy,kz)-uvwzlev(ix,jy,kz-1) + + ! real,dimension(0:nxmax-1,0:nymax-1,nzmax) :: uvwzlev + + dz1=uvwzlev(ix,jy,klp)-uvwzlev(ix,jy,kl) + + dz2=0. endif @@ -1366,20 +1636,26 @@ subroutine verttransform_gfs(n,uuh,vvh,wwh,pvh) ixp=ix+1 jyp=jy+1 - dzdx1=(uvwzlev(ixp,jy,kl)-uvwzlev(ix1,jy,kl))/2. - dzdx2=(uvwzlev(ixp,jy,klp)-uvwzlev(ix1,jy,klp))/2. + dzdx1=(uvwzlev(ixp,jy,kl)-uvwzlev(ix1,jy,kl))*0.5 + dzdx2=(uvwzlev(ixp,jy,klp)-uvwzlev(ix1,jy,klp))*0.5 dzdx=(dzdx1*dz2+dzdx2*dz1)/dz - dzdy1=(uvwzlev(ix,jyp,kl)-uvwzlev(ix,jy1,kl))/2. - dzdy2=(uvwzlev(ix,jyp,klp)-uvwzlev(ix,jy1,klp))/2. + dzdy1=(uvwzlev(ix,jyp,kl)-uvwzlev(ix,jy1,kl))*0.5 + dzdy2=(uvwzlev(ix,jyp,klp)-uvwzlev(ix,jy1,klp))*0.5 dzdy=(dzdy1*dz2+dzdy2*dz1)/dz ww(ix,jy,iz,n)=ww(ix,jy,iz,n)+(dzdx*ui+dzdy*vi) - end do + enddo ! z - end do - end do + !if ((jy.le.3).and.(ix.eq.1)) print*, 'in eta loop end z jy=',jy + + + enddo + + + enddo +!$OMP END DO ! If north pole is in the domain, calculate wind velocities in polar @@ -1387,40 +1663,38 @@ subroutine verttransform_gfs(n,uuh,vvh,wwh,pvh) !******************************************************************* if (nglobal) then - do jy=int(switchnorthg)-2,nymin1 - ylat=ylat0+real(jy)*dy - do ix=0,nxmin1 - xlon=xlon0+real(ix)*dx - do iz=1,nz + do iz=1,nz + do jy=int(switchnorthg)-2,nymin1 + ylat=ylat0+real(jy)*dy + do ix=0,nxmin1 + xlon=xlon0+real(ix)*dx call cc2gll(northpolemap,ylat,xlon,uu(ix,jy,iz,n), & - vv(ix,jy,iz,n),uupol(ix,jy,iz,n), & - vvpol(ix,jy,iz,n)) - end do - end do - end do + vv(ix,jy,iz,n),uupol(ix,jy,iz,n),vvpol(ix,jy,iz,n)) + enddo + enddo + enddo do iz=1,nz - ! CALCULATE FFPOL, DDPOL FOR CENTRAL GRID POINT + ! CALCULATE FFPOL, DDPOL FOR CENTRAL GRID POINT xlon=xlon0+real(nx/2-1)*dx xlonr=xlon*pi/180. ffpol=sqrt(uu(nx/2-1,nymin1,iz,n)**2+vv(nx/2-1,nymin1,iz,n)**2) if (vv(nx/2-1,nymin1,iz,n).lt.0.) then ddpol=atan(uu(nx/2-1,nymin1,iz,n)/vv(nx/2-1,nymin1,iz,n))-xlonr elseif (vv(nx/2-1,nymin1,iz,n).gt.0.) then - ddpol=pi+atan(uu(nx/2-1,nymin1,iz,n)/ & - vv(nx/2-1,nymin1,iz,n))-xlonr + ddpol=pi+atan(uu(nx/2-1,nymin1,iz,n)/vv(nx/2-1,nymin1,iz,n))-xlonr else - ddpol=pi/2-xlonr + ddpol=pi*0.5-xlonr endif - if(ddpol.lt.0.) ddpol=2.0*pi+ddpol - if(ddpol.gt.2.0*pi) ddpol=ddpol-2.0*pi + if(ddpol.lt.0.) ddpol=2.*pi+ddpol + if(ddpol.gt.2.*pi) ddpol=ddpol-2.*pi - ! CALCULATE U,V FOR 180 DEG, TRANSFORM TO POLAR STEREOGRAPHIC GRID - xlon=180.0 + ! CALCULATE U,V FOR 180 DEG, TRANSFORM TO POLAR STEREOGRAPHIC GRID + xlon=180. xlonr=xlon*pi/180. - ylat=90.0 + ylat=90. uuaux=-ffpol*sin(xlonr+ddpol) vvaux=-ffpol*cos(xlonr+ddpol) call cc2gll(northpolemap,ylat,xlon,uuaux,vvaux,uupolaux,vvpolaux) @@ -1428,25 +1702,27 @@ subroutine verttransform_gfs(n,uuh,vvh,wwh,pvh) do ix=0,nxmin1 uupol(ix,jy,iz,n)=uupolaux vvpol(ix,jy,iz,n)=vvpolaux - end do - end do + enddo + + enddo - ! Fix: Set W at pole to the zonally averaged W of the next equator- - ! ward parallel of latitude + ! Fix: Set W (vertical wind) at pole to the zonally averaged W of the next + ! equator-ward parallel + do iz=1,nz wdummy=0. jy=ny-2 do ix=0,nxmin1 wdummy=wdummy+ww(ix,jy,iz,n) - end do + enddo wdummy=wdummy/real(nx) jy=nymin1 do ix=0,nxmin1 ww(ix,jy,iz,n)=wdummy - end do - end do + enddo + enddo endif @@ -1456,37 +1732,37 @@ subroutine verttransform_gfs(n,uuh,vvh,wwh,pvh) !******************************************************************* if (sglobal) then - do jy=0,int(switchsouthg)+3 - ylat=ylat0+real(jy)*dy - do ix=0,nxmin1 - xlon=xlon0+real(ix)*dx - do iz=1,nz + do iz=1,nz + do jy=0,int(switchsouthg)+3 + ylat=ylat0+real(jy)*dy + do ix=0,nxmin1 + xlon=xlon0+real(ix)*dx call cc2gll(southpolemap,ylat,xlon,uu(ix,jy,iz,n), & - vv(ix,jy,iz,n),uupol(ix,jy,iz,n),vvpol(ix,jy,iz,n)) - end do - end do - end do + vv(ix,jy,iz,n),uupol(ix,jy,iz,n),vvpol(ix,jy,iz,n)) + enddo + enddo + enddo do iz=1,nz - ! CALCULATE FFPOL, DDPOL FOR CENTRAL GRID POINT + ! CALCULATE FFPOL, DDPOL FOR CENTRAL GRID POINT xlon=xlon0+real(nx/2-1)*dx xlonr=xlon*pi/180. ffpol=sqrt(uu(nx/2-1,0,iz,n)**2+vv(nx/2-1,0,iz,n)**2) - if(vv(nx/2-1,0,iz,n).lt.0.) then + if (vv(nx/2-1,0,iz,n).lt.0.) then ddpol=atan(uu(nx/2-1,0,iz,n)/vv(nx/2-1,0,iz,n))+xlonr elseif (vv(nx/2-1,0,iz,n).gt.0.) then ddpol=pi+atan(uu(nx/2-1,0,iz,n)/vv(nx/2-1,0,iz,n))-xlonr else - ddpol=pi/2-xlonr + ddpol=pi*0.5-xlonr endif - if(ddpol.lt.0.) ddpol=2.0*pi+ddpol - if(ddpol.gt.2.0*pi) ddpol=ddpol-2.0*pi + if(ddpol.lt.0.) ddpol=2.*pi+ddpol + if(ddpol.gt.2.*pi) ddpol=ddpol-2.*pi - ! CALCULATE U,V FOR 180 DEG, TRANSFORM TO POLAR STEREOGRAPHIC GRID - xlon=180.0 + ! CALCULATE U,V FOR 180 DEG, TRANSFORM TO POLAR STEREOGRAPHIC GRID + xlon=180. xlonr=xlon*pi/180. - ylat=-90.0 + ylat=-90. uuaux=+ffpol*sin(xlonr-ddpol) vvaux=-ffpol*cos(xlonr-ddpol) call cc2gll(northpolemap,ylat,xlon,uuaux,vvaux,uupolaux,vvpolaux) @@ -1495,12 +1771,13 @@ subroutine verttransform_gfs(n,uuh,vvh,wwh,pvh) do ix=0,nxmin1 uupol(ix,jy,iz,n)=uupolaux vvpol(ix,jy,iz,n)=vvpolaux - end do - end do + enddo + + enddo - ! Fix: Set W at pole to the zonally averaged W of the next equator- - ! ward parallel of latitude + ! Fix: Set W at pole to the zonally averaged W of the next equator- + ! ward parallel of latitude do iz=1,nz wdummy=0. @@ -1512,113 +1789,187 @@ subroutine verttransform_gfs(n,uuh,vvh,wwh,pvh) jy=0 do ix=0,nxmin1 ww(ix,jy,iz,n)=wdummy - end do - end do + enddo + enddo + endif + ! PS, AT: for v10.5, we add back the quick fix to interpolate clouds in + ! interpol_rain.f90 developed by PS for v8 and extend it to using + ! cloud water fields + + !******************************************************************************* + if (lcw) then ! identify clouds based on cloud water content + !******************************************************************************* - !*********************************************************************************** - ! IP & SEC, 201812 GFS clouds read - if (readclouds) then - ! The method is loops all grids vertically and constructs the 3D matrix for clouds - ! Cloud top and cloud bottom gid cells are assigned as well as the total column - ! cloud water. For precipitating grids, the type and whether it is in or below - ! cloud scavenging are assigned with numbers 2-5 (following the old metod). - ! Distinction is done for lsp and convp though they are treated the same in regards - ! to scavenging. Also clouds that are not precipitating are defined which may be - ! to include future cloud processing by non-precipitating-clouds. - !*********************************************************************************** write(*,*) 'Global NCEP fields: using cloud water' - clw(:,:,:,n)=0.0 - ctwc(:,:,n)=0.0 - clouds(:,:,:,n)=0 - ! If water/ice are read separately into clwc and ciwc, store sum in clwc - do jy=0,nymin1 - do ix=0,nxmin1 - lsp=lsprec(ix,jy,1,n) - convp=convprec(ix,jy,1,n) - prec=lsp+convp - cloudh_min=height(nz-1) - ! Find clouds in the vertical - do kz=1, nz-1 !go from top to bottom - if (clwc(ix,jy,kz,n).gt.0) then - ! assuming rho is in kg/m3 and hz in m gives: kg/kg * kg/m3 *m3/kg /m = m2/m3 - clw(ix,jy,kz,n)=(clwc(ix,jy,kz,n)*rho(ix,jy,kz,n))*(height(kz+1)-height(kz)) - ctwc(ix,jy,n) = ctwc(ix,jy,n)+clw(ix,jy,kz,n) - cloudh_min=min(height(kz+1),height(kz)) + + ctwc(:,:,n)=0. ! initialise cloud total water content + + ! If water/ice are read separately into clwc and ciwc, store sum in clwc + if (.not. lcwsum) clwc(:,:,:,n) = clwc(:,:,:,n) + ciwc(:,:,:,n) + + do kz = 1,nz-1 + do jy=0,nymin1 + do ix=0,nxmin1 + if (kz .eq. 1) then + icloudbot(ix,jy,n) = icmv +!! icloudtop=icmv ! this is just a local variable +! we will use icloudtop as workspace for cloud top endif - end do - ! If Precipitation. Define removal type in the vertical - if ((lsp.gt.0.01).or.(convp.gt.0.01)) then ! cloud and precipitation + ! vertically integrate cloud water and determine cloud bottom, top + ! cloud water per cell in kg / m2 + ! calculate cloud water mass per area: kgCW/kgAIR * kgAIR/m3 * m = kgCW/m2 - do kz=nz,2,-1 !go Bottom up! - if (clw(ix,jy,kz,n).gt. 0) then ! is in cloud - cloudsh(ix,jy,n)=cloudsh(ix,jy,n)+int(height(kz)-height(kz-1)) - clouds(ix,jy,kz,n)=1 ! is a cloud - if (lsp.ge.convp) then - clouds(ix,jy,kz,n)=3 ! lsp in-cloud - else - clouds(ix,jy,kz,n)=2 ! convp in-cloud - endif ! convective or large scale - elseif((clw(ix,jy,kz,n).le.0) .and. (cloudh_min.ge.height(kz))) then - ! is below cloud - if (lsp.ge.convp) then - clouds(ix,jy,kz,n)=5 ! lsp dominated washout - else - clouds(ix,jy,kz,n)=4 ! convp dominated washout - endif ! convective or large scale + clw = clwc(ix,jy,kz,n)*rho(ix,jy,kz,n)*(height(kz+1)-height(kz)) + ! Add this layer to column cloud water [m3/m3] + ctwc(ix,jy,n) = ctwc(ix,jy,n)+clw ! kg / m2 in column + + if (clw .gt. 0.) then ! cloud layer - maybe use threshold? + if (icloudbot(ix,jy,n) .eq. icmv) & + icloudbot(ix,jy,n) = nint(height(kz)) + icloudtop(ix,jy,n) = nint(height(kz)) + endif + + if (kz .eq. nz-1) then ! top level + ! memorise icloudtop + icloudtop_old = icloudtop(ix,jy,n) + ! limit cloud top to 19 km: + if (icloudtop(ix,jy,n) .gt. 19000) icloudtop(ix,jy,n) = 19000 + if (icloudbot(ix,jy,n) .eq. icmv) then + icloudtop(ix,jy,n) = icmv endif - if (height(kz).ge. 19000) then ! set a max height for removal - clouds(ix,jy,kz,n)=0 - endif !clw>0 - end do !nz - endif ! precipitation - end do - end do - else - write(*,*) 'Global NCEP fields: using cloud water from Parameterization' - ! write (*,*) 'initializing clouds, n:',n,nymin1,nxmin1,nz - ! create a cloud and rainout/washout field, clouds occur where rh>80% - ! total cloudheight is stored at level 0 - do jy=0,nymin1 - do ix=0,nxmin1 - rain_cloud_above=0 - lsp=lsprec(ix,jy,1,n) - convp=convprec(ix,jy,1,n) - cloudsh(ix,jy,n)=0 - do kz_inv=1,nz-1 - kz=nz-kz_inv+1 - pressure=rho(ix,jy,kz,n)*r_air*tt(ix,jy,kz,n) - rh=qv(ix,jy,kz,n)/f_qvsat(pressure,tt(ix,jy,kz,n)) - clouds(ix,jy,kz,n)=0 - if (rh.gt.0.8) then ! in cloud - if ((lsp.gt.0.01).or.(convp.gt.0.01)) then ! cloud and precipitation - rain_cloud_above=1 - cloudsh(ix,jy,n)=cloudsh(ix,jy,n)+int(height(kz)-height(kz-1)) - if (lsp.ge.convp) then - clouds(ix,jy,kz,n)=3 ! lsp dominated rainout + ! PS get rid of too thin clouds + if (icloudtop(ix,jy,n) .lt. 50) then + icloudbot(ix,jy,n)=icmv + icloudtop(ix,jy,n)=icmv + endif + + ! PS implement a rough fix for badly represented convection + ! PS is based on looking at a limited set of comparison data + lsp= sum( lsprec(ix,jy,1,:,n) ) + convp=sum( convprec(ix,jy,1,:,n) ) + prec=lsp+convp + if (lsp.gt.convp) then ! prectype='lsp' + lconvectprec = .false. + else ! prectype='cp ' + lconvectprec = .true. + endif + if (lconvectprec .and. prec .gt. precmin .and. & + (icloudtop_old .lt. 6000 .or. icloudbot(ix,jy,n) .gt. 3000) ) then + if (convp .lt. 0.1) then + icloudbot(ix,jy,n) = 500 + icloudtop(ix,jy,n) = 8000 else - clouds(ix,jy,kz,n)=2 ! convp dominated rainout + icloudbot(ix,jy,n) = 0 + icloudtop(ix,jy,n) = 10000 endif - else ! no precipitation - clouds(ix,jy,kz,n)=1 ! cloud - endif - else ! no cloud - if (rain_cloud_above.eq.1) then ! scavenging - if (lsp.ge.convp) then - clouds(ix,jy,kz,n)=5 ! lsp dominated washout - else - clouds(ix,jy,kz,n)=4 ! convp dominated washout - endif - endif - endif - end do - end do - end do - endif ! IP & SEC 201812, GFS clouds read + endif + endif ! end top level + + enddo ! ix loop + enddo ! jy loop + enddo ! kz loop + + +!************************************************************************** + else ! identify clouds using relative humidity +!************************************************************************** +! clouds occur where rh>90% (using rh_ice for T<-20 deg C) + + write(*,*) 'NCEP fields: using relative humidity for cloud & + &identification' + do kz = 1,nz-1 + do jy=0,nymin1 + do ix=0,nxmin1 + +!PS note that original by Sabine Eckhart was 80% +!PS however, for T<-20 C we consider saturation over ice +!PS so I think 90% should be enough + if (kz .eq. 1) then + icloudbot(ix,jy,n) = icmv +!! icloudtop=icmv ! this is just a local variable +! we will use icloudtop as workspace for cloud top + endif +!98 do kz=1,nz + pressure=rho(ix,jy,kz,n)*r_air*tt(ix,jy,kz,n) + rh=qv(ix,jy,kz,n)/f_qvsat(pressure,tt(ix,jy,kz,n)) +!PS if (prec.gt.0.01) print*,'relhum',prec,kz,rh,height(kz) + if (rh .ge. rhmin) then + if (icloudbot(ix,jy,n) .eq. icmv) then + icloudbot(ix,jy,n)=nint(height(kz))! use int to save memory + endif + icloudtop(ix,jy,n)=nint(height(kz)) ! use int to save memory + endif +! enddo + +!PS/AT 2021: in this version, we skip the iteration with smaller rhmin +!PS try to get a cloud thicker than 50 m +!PS if there is at least .01 mm/h - changed to 0.002 and put into +!PS parameter precpmin +! if ((icloudbot(ix,jy,n) .eq. icmv .or. & +! icloudtop-icloudbot(ix,jy,n) .lt. 50) .and. prec .gt. precmin) then +! rhmin = rhmin - 0.05 +! if (rhmin .ge. 0.30) goto 98 ! give up for <= 25% rel.hum. +! endif +! if (icloudtop .ne. icmv) then +! icloudtop(ix,jy,n) = icloudtop-icloudbot(ix,jy,n) +! else +! icloudtop(ix,jy,n) = icmv +! endif + + if (kz .eq. nz-1) then ! top level + + ! memorise icloudtop + icloudtop_old = icloudtop(ix,jy,n) + ! limit cloud top to 19 km: + if (icloudtop(ix,jy,n) .gt. 19000) icloudtop(ix,jy,n) = 19000 + if (icloudbot(ix,jy,n) .ne. icmv) then + icloudtop(ix,jy,n) = icloudtop(ix,jy,n)-icloudbot(ix,jy,n) + else + icloudtop(ix,jy,n) = icmv + endif + + ! PS get rid of too thin clouds + if (icloudtop(ix,jy,n) .lt. 50) then + icloudbot(ix,jy,n)=icmv + icloudtop(ix,jy,n)=icmv + endif + + ! PS implement a rough fix for badly represented convection + ! PS is based on looking at a limited set of comparison data + lsp= sum( lsprec(ix,jy,1,:,n) ) + convp=sum( convprec(ix,jy,1,:,n) ) + prec=lsp+convp + if (lsp.gt.convp) then ! prectype='lsp' + lconvectprec = .false. + else ! prectype='cp ' + lconvectprec = .true. + endif + if (lconvectprec .and. prec .gt. precmin .and. & + (icloudtop_old .lt. 6000 .or. icloudbot(ix,jy,n) .gt. 3000) ) then + if (convp .lt. 0.1) then + icloudbot(ix,jy,n) = 500 + icloudtop(ix,jy,n) = 8000 + endif + else + icloudbot(ix,jy,n) = 0 + icloudtop(ix,jy,n) = 10000 + endif + + endif ! end top level + + enddo ! ix loop + enddo ! jy loop + enddo ! kz loop + +!************************************************************************** + endif ! lcw true/false +!************************************************************************** + end subroutine verttransform_gfs subroutine verttransform_ecmwf_heights(nxlim,nylim, & @@ -1633,68 +1984,115 @@ subroutine verttransform_ecmwf_heights(nxlim,nylim, & real,intent(out),dimension(0:nxlim,0:nylim,nuvzmax) :: rhoh_tmp,prsh_tmp real,intent(out),dimension(0:nxlim,0:nylim,nzmax) :: pinmconv real,intent(out),dimension(0:nxlim,0:nylim,nuvzmax) :: uvzlev,wzlev - real,dimension(0:nxlim,0:nylim) :: tvold,pold,pint,tv + !real,dimension(0:nxlim,0:nylim) :: tvold,pold,pint,tv + real :: tvold,pold,pint,tv real,parameter :: const=r_air/ga integer :: ix,jy,kz ! Loop over the whole grid !************************* - +!$OMP PARALLEL PRIVATE(jy,ix,pint,tv,tvold,pold,kz) +!$OMP DO do jy=0,nylim do ix=0,nxlim - tvold(ix,jy)=tt2_tmp(ix,jy)*(1.+0.378*ew(td2_tmp(ix,jy),ps_tmp(ix,jy))/ & + tvold=tt2_tmp(ix,jy)*(1.+0.378*ew(td2_tmp(ix,jy),ps_tmp(ix,jy))/ & ps_tmp(ix,jy)) - end do - end do + pold=ps_tmp(ix,jy) + uvzlev(ix,jy,1)=0. + wzlev(ix,jy,1)=0. + rhoh_tmp(ix,jy,1)=pold/(r_air*tvold) + prsh_tmp(ix,jy,1)=ps_tmp(ix,jy) + + do kz=2,nuvz + pint=akz(kz)+bkz(kz)*ps_tmp(ix,jy) + prsh_tmp(ix,jy,kz)=pint + tv=tth_tmp(ix,jy,kz)*(1.+0.608*qvh_tmp(ix,jy,kz)) + rhoh_tmp(ix,jy,kz)=pint/(r_air*tv) - pold(:,:)=ps_tmp(:,:) - uvzlev(:,:,1)=0. - wzlev(:,:,1)=0. - rhoh_tmp(:,:,1)=pold(:,:)/(r_air*tvold(:,:)) - prsh_tmp(:,:,1)=ps_tmp(:,:) + if (abs(tv-tvold).gt.0.2) then + uvzlev(ix,jy,kz)=uvzlev(ix,jy,kz-1)+const* & + log(pold/pint)*(tv-tvold)/log(tv/tvold) + else + uvzlev(ix,jy,kz)=uvzlev(ix,jy,kz-1)+const* & + log(pold/pint)*tv + endif - ! Compute heights of eta levels - !****************************** + tvold=tv + pold=pint - do kz=2,nuvz - pint(:,:)=akz(kz)+bkz(kz)*ps_tmp(:,:) - prsh_tmp(:,:,kz)=pint(:,:) - tv(:,:)=tth_tmp(:,:,kz)*(1.+0.608*qvh_tmp(:,:,kz)) - rhoh_tmp(:,:,kz)=pint(:,:)/(r_air*tv(:,:)) - - where (abs(tv(:,:)-tvold(:,:)).gt.0.2) - uvzlev(:,:,kz)=uvzlev(:,:,kz-1)+const*& - &log(pold(:,:)/pint(:,:))* & - (tv(:,:)-tvold(:,:))/& - &log(tv(:,:)/tvold(:,:)) - elsewhere - uvzlev(:,:,kz)=uvzlev(:,:,kz-1)+const*& - &log(pold(:,:)/pint(:,:))*tv(:,:) - endwhere - - tvold(:,:)=tv(:,:) - pold(:,:)=pint(:,:) + end do + + do kz=2,nwz-1 + wzlev(ix,jy,kz)=(uvzlev(ix,jy,kz+1)+uvzlev(ix,jy,kz))*0.5 + end do + wzlev(ix,jy,nwz)=wzlev(ix,jy,nwz-1)+ & + uvzlev(ix,jy,nuvz)-uvzlev(ix,jy,nuvz-1) - end do - do kz=2,nwz-1 - wzlev(:,:,kz)=(uvzlev(:,:,kz+1)+uvzlev(:,:,kz))/2. + pinmconv(ix,jy,1)=(uvzlev(ix,jy,2))/ & + ((aknew(2)+bknew(2)*ps_tmp(ix,jy))- & + (aknew(1)+bknew(1)*ps_tmp(ix,jy))) + do kz=2,nz-1 + pinmconv(ix,jy,kz)=(uvzlev(ix,jy,kz+1)-uvzlev(ix,jy,kz-1))/ & + ((aknew(kz+1)+bknew(kz+1)*ps_tmp(ix,jy))- & + (aknew(kz-1)+bknew(kz-1)*ps_tmp(ix,jy))) + end do + pinmconv(ix,jy,nz)=(uvzlev(ix,jy,nz)-uvzlev(ix,jy,nz-1))/ & + ((aknew(nz)+bknew(nz)*ps_tmp(ix,jy))- & + (aknew(nz-1)+bknew(nz-1)*ps_tmp(ix,jy))) + end do end do - wzlev(:,:,nwz)=wzlev(:,:,nwz-1)+ & - uvzlev(:,:,nuvz)-uvzlev(:,:,nuvz-1) +!$OMP END DO +!$OMP END PARALLEL + ! pold(:,:)=ps_tmp(:,:) + ! uvzlev(:,:,1)=0. + ! wzlev(:,:,1)=0. + ! rhoh_tmp(:,:,1)=pold(:,:)/(r_air*tvold(:,:)) + ! prsh_tmp(:,:,1)=ps_tmp(:,:) - pinmconv(:,:,1)=(uvzlev(:,:,2))/ & - ((aknew(2)+bknew(2)*ps_tmp(:,:))- & - (aknew(1)+bknew(1)*ps_tmp(:,:))) - do kz=2,nz-1 - pinmconv(:,:,kz)=(uvzlev(:,:,kz+1)-uvzlev(:,:,kz-1))/ & - ((aknew(kz+1)+bknew(kz+1)*ps_tmp(:,:))- & - (aknew(kz-1)+bknew(kz-1)*ps_tmp(:,:))) - end do - pinmconv(:,:,nz)=(uvzlev(:,:,nz)-uvzlev(:,:,nz-1))/ & - ((aknew(nz)+bknew(nz)*ps_tmp(:,:))- & - (aknew(nz-1)+bknew(nz-1)*ps_tmp(:,:))) + ! Compute heights of eta levels + !****************************** + + ! do kz=2,nuvz + ! pint(:,:)=akz(kz)+bkz(kz)*ps_tmp(:,:) + ! prsh_tmp(:,:,kz)=pint(:,:) + ! tv(:,:)=tth_tmp(:,:,kz)*(1.+0.608*qvh_tmp(:,:,kz)) + ! rhoh_tmp(:,:,kz)=pint(:,:)/(r_air*tv(:,:)) + + ! where (abs(tv(:,:)-tvold(:,:)).gt.0.2) + ! uvzlev(:,:,kz)=uvzlev(:,:,kz-1)+const*& + ! &log(pold(:,:)/pint(:,:))* & + ! (tv(:,:)-tvold(:,:))/& + ! &log(tv(:,:)/tvold(:,:)) + ! elsewhere + ! uvzlev(:,:,kz)=uvzlev(:,:,kz-1)+const*& + ! &log(pold(:,:)/pint(:,:))*tv(:,:) + ! endwhere + + ! tvold(:,:)=tv(:,:) + ! pold(:,:)=pint(:,:) + + ! end do + + ! do kz=2,nwz-1 + ! wzlev(:,:,kz)=(uvzlev(:,:,kz+1)+uvzlev(:,:,kz))/2. + ! end do + ! wzlev(:,:,nwz)=wzlev(:,:,nwz-1)+ & + ! uvzlev(:,:,nuvz)-uvzlev(:,:,nuvz-1) + + + ! pinmconv(:,:,1)=(uvzlev(:,:,2))/ & + ! ((aknew(2)+bknew(2)*ps_tmp(:,:))- & + ! (aknew(1)+bknew(1)*ps_tmp(:,:))) + ! do kz=2,nz-1 + ! pinmconv(:,:,kz)=(uvzlev(:,:,kz+1)-uvzlev(:,:,kz-1))/ & + ! ((aknew(kz+1)+bknew(kz+1)*ps_tmp(:,:))- & + ! (aknew(kz-1)+bknew(kz-1)*ps_tmp(:,:))) + ! end do + ! pinmconv(:,:,nz)=(uvzlev(:,:,nz)-uvzlev(:,:,nz-1))/ & + ! ((aknew(nz)+bknew(nz)*ps_tmp(:,:))- & + ! (aknew(nz-1)+bknew(nz-1)*ps_tmp(:,:))) end subroutine verttransform_ecmwf_heights subroutine verttransform_ecmwf_windfields_nest(l,n, & @@ -1737,9 +2135,9 @@ subroutine verttransform_ecmwf_windfields_nest(l,n, & #ifndef ETA qvn(ix,jy,1,n,l)=qvhn(ix,jy,1,n,l) #endif - if (readclouds_nest(l)) then + if (lcw_nest(l)) then clwcn(ix,jy,1,n,l)=clwchn(ix,jy,1,n,l) - if (.not.sumclouds_nest(l)) ciwcn(ix,jy,1,n,l)=ciwchn(ix,jy,1,n,l) + if (.not.lcwsum_nest(l)) ciwcn(ix,jy,1,n,l)=ciwchn(ix,jy,1,n,l) end if pvn(ix,jy,1,n,l)=pvhn(ix,jy,1,l) rhon(ix,jy,1,n,l)=rhohn(ix,jy,1) @@ -1750,9 +2148,9 @@ subroutine verttransform_ecmwf_windfields_nest(l,n, & ttn(ix,jy,nz,n,l)=tthn(ix,jy,nuvz,n,l) #ifndef ETA qvn(ix,jy,nz,n,l)=qvhn(ix,jy,nuvz,n,l) - if (readclouds_nest(l)) then + if (lcw_nest(l)) then clwcn(ix,jy,nz,n,l)=clwchn(ix,jy,nuvz,n,l) - if (.not.sumclouds_nest(l)) ciwcn(ix,jy,nz,n,l)=ciwchn(ix,jy,nuvz,n,l) + if (.not.lcwsum_nest(l)) ciwcn(ix,jy,nz,n,l)=ciwchn(ix,jy,nuvz,n,l) endif #endif pvn(ix,jy,nz,n,l)=pvhn(ix,jy,nuvz,l) @@ -1760,8 +2158,8 @@ subroutine verttransform_ecmwf_windfields_nest(l,n, & prsn(ix,jy,nz,n,l)=prshn(ix,jy,nuvz) idx(ix,jy)=2 - end do - end do + enddo + enddo !$OMP END DO do iz=2,nz-1 @@ -1776,16 +2174,16 @@ subroutine verttransform_ecmwf_windfields_nest(l,n, & #ifndef ETA qvn(ix,jy,iz,n,l)=qvn(ix,jy,nz,n,l) !hg adding the cloud water - if (readclouds_nest(l)) then + if (lcw_nest(l)) then clwcn(ix,jy,iz,n,l)=clwcn(ix,jy,nz,n,l) - if (.not.sumclouds_nest(l)) ciwcn(ix,jy,iz,n,l)=ciwcn(ix,jy,nz,n,l) + if (.not.lcwsum_nest(l)) ciwcn(ix,jy,iz,n,l)=ciwcn(ix,jy,nz,n,l) endif #endif rhon(ix,jy,iz,n,l)=rhon(ix,jy,nz,n,l) prsn(ix,jy,iz,n,l)=prsn(ix,jy,nz,n,l) else innuvz: do kz=idx(ix,jy),nuvz - if ((idx(ix,jy).le.kz).and. & + if ((idx(ix,jy).lt.kz).and. & (height(iz).gt.etauvheightn(ix,jy,kz-1,n,l)).and. & (height(iz).le.etauvheightn(ix,jy,kz,n,l))) then idx(ix,jy)=kz @@ -1808,9 +2206,9 @@ subroutine verttransform_ecmwf_windfields_nest(l,n, & qvn(ix,jy,iz,n,l)=(qvhn(ix,jy,kz-1,n,l)*dz2 & +qvhn(ix,jy,kz,n,l)*dz1)/dz !hg adding the cloud water - if (readclouds_nest(l)) then + if (lcw_nest(l)) then clwcn(ix,jy,iz,n,l)=(clwchn(ix,jy,kz-1,n,l)*dz2+clwchn(ix,jy,kz,n,l)*dz1)/dz - if (.not.sumclouds_nest(l)) ciwcn(ix,jy,iz,n,l) = & + if (.not.lcwsum_nest(l)) ciwcn(ix,jy,iz,n,l) = & (ciwchn(ix,jy,kz-1,n,l)*dz2+ciwchn(ix,jy,kz,n,l)*dz1)/dz end if #endif @@ -1823,8 +2221,8 @@ subroutine verttransform_ecmwf_windfields_nest(l,n, & !$OMP BARRIER enddo - ! Levels, where w is given - !************************* + ! Interpolation of vertical motion (levels where w is given) + !*********************************************************** !$OMP DO do jy=0,nym1 @@ -1832,8 +2230,8 @@ subroutine verttransform_ecmwf_windfields_nest(l,n, & idx(ix,jy)=2 wwn(ix,jy,1,n,l)=wwhn(ix,jy,1,l)*pinmconv(ix,jy,1) wwn(ix,jy,nz,n,l)=wwhn(ix,jy,nwz,l)*pinmconv(ix,jy,nz) - end do - end do + enddo + enddo !$OMP END DO do iz=2,nz-1 @@ -1862,7 +2260,7 @@ subroutine verttransform_ecmwf_windfields_nest(l,n, & enddo !$OMP END DO !$OMP BARRIER - end do + enddo ! Compute density gradients at intermediate levels !************************************************* @@ -1886,12 +2284,12 @@ subroutine verttransform_ecmwf_windfields_nest(l,n, & cosf(jy)=1./cos((real(jy)*dyn(l)+ylat0n(l))*pi180) do ix=1,nxn(l)-2 idx(ix,jy)=2 - end do - end do + enddo + enddo !$OMP END DO do iz=2,nz-1 -!$OMP DO SCHEDULE(dynamic) +!$OMP DO SCHEDULE(guided) do jy=1,nyn(l)-2 do ix=1,nxn(l)-2 @@ -1913,23 +2311,23 @@ subroutine verttransform_ecmwf_windfields_nest(l,n, & ixp=ix+1 jyp=jy+1 - dzdx1=(etauvheightn(ixp,jy,kz-1,n,l)-etauvheightn(ix1,jy,kz-1,n,l))/2. - dzdx2=(etauvheightn(ixp,jy,kz,n,l)-etauvheightn(ix1,jy,kz,n,l))/2. + dzdx1=(etauvheightn(ixp,jy,kz-1,n,l)-etauvheightn(ix1,jy,kz-1,n,l))*0.5 + dzdx2=(etauvheightn(ixp,jy,kz,n,l)-etauvheightn(ix1,jy,kz,n,l))*0.5 dzdx=(dzdx1*dz2+dzdx2*dz1)/dz - dzdy1=(etauvheightn(ix,jyp,kz-1,n,l)-etauvheightn(ix,jy1,kz-1,n,l))/2. - dzdy2=(etauvheightn(ix,jyp,kz,n,l)-etauvheightn(ix,jy1,kz,n,l))/2. + dzdy1=(etauvheightn(ix,jyp,kz-1,n,l)-etauvheightn(ix,jy1,kz-1,n,l))*0.5 + dzdy2=(etauvheightn(ix,jyp,kz,n,l)-etauvheightn(ix,jy1,kz,n,l))*0.5 dzdy=(dzdy1*dz2+dzdy2*dz1)/dz wwn(ix,jy,iz,n,l)=wwn(ix,jy,iz,n,l) + & (dzdx*uun(ix,jy,iz,n,l)*dxconst*xresoln(l)*cosf(jy)+ & dzdy*vvn(ix,jy,iz,n,l)*dyconst*yresoln(l)) - end do - end do + enddo + enddo !$OMP END DO !$OMP BARRIER - end do + enddo ! Keep original fields if wind_coord_type==ETA #ifdef ETA @@ -1950,9 +2348,9 @@ subroutine verttransform_ecmwf_windfields_nest(l,n, & ! ((qvn(ix,jy,kz,n,l)+0.622)/(0.622*qvn(ix,jy,kz,n,l)+0.622)) if ((kz.gt.1).and.(kz.lt.nz)) drhodzetan(ix,jy,kz,n,l)= & (rhohn(ix,jy,kz+1)-rhohn(ix,jy,kz-1))/(height(kz+1)-height(kz-1)) - if (readclouds) then + if (lcw) then clwcn(ix,jy,kz,n,l)=clwchn(ix,jy,kz,n,l) - if (.not.sumclouds_nest(l)) ciwcn(ix,jy,kz,n,l)=ciwchn(ix,jy,kz,n,l) + if (.not.lcwsum_nest(l)) ciwcn(ix,jy,kz,n,l)=ciwchn(ix,jy,kz,n,l) endif end do end do @@ -1982,13 +2380,13 @@ subroutine verttransform_ecmwf_windfields_nest(l,n, & (wheight(kz+1)-wheight(kz-1)) endif wwetan(ix,jy,kz,n,l)=wwhn(ix,jy,kz,l)/dpdeta - end do + enddo wwetan(ix,jy,nuvz,n,l)=wwetan(ix,jy,nuvz-1,n,l) - end do - end do + enddo + enddo !$OMP END DO #endif !$OMP END PARALLEL end subroutine verttransform_ecmwf_windfields_nest -end module verttransform_mod \ No newline at end of file +end module verttransform_mod diff --git a/src/wetdepo_mod.f90 b/src/wetdepo_mod.f90 index ae3644bb165bb4f04072b172bda91341cd3d1342..e13a9c42da4e2e40df6716c9ed7135a0d92926b3 100644 --- a/src/wetdepo_mod.f90 +++ b/src/wetdepo_mod.f90 @@ -35,6 +35,9 @@ subroutine wetdepo(itime,ltsample,loutnext) ! * ! 2021 Andreas Plach: - moved backward wet depo. calc. here from timemanager * ! - bugfix in-cloud scavenging * + ! * + ! PS, AP 2021: followed up on some variable renaming and * + ! corrected get_wetscav subroutine parameter list * !***************************************************************************** ! * ! Variables: * @@ -61,10 +64,9 @@ subroutine wetdepo(itime,ltsample,loutnext) integer :: i,jpart,itime,ltsample,loutnext,ldeltat integer :: itage,nage,inage,ithread,thread - integer :: ks, kp,stat - integer(selected_int_kind(16)), dimension(nspec) :: blc_count, inc_count - real :: grfraction(3),wetscav,restmass - real,allocatable,dimension(:) :: wetdeposit + integer :: ks, kp, stat + real :: gridfract,wetscav,restmass + real,allocatable,dimension(:) :: wettmp real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled ! Compute interval since radioactive decay of deposited mass was computed @@ -78,105 +80,104 @@ subroutine wetdepo(itime,ltsample,loutnext) ! Loop over all particles !************************ - blc_count(:)=0 - inc_count(:)=0 #ifdef _OPENMP call omp_set_num_threads(numthreads_grid) #endif -!$OMP PARALLEL PRIVATE(jpart,itage,nage,inage,ks,kp,thread,wetscav,wetdeposit, & -!$OMP restmass, grfraction) REDUCTION(+:blc_count,inc_count) - + +!$OMP PARALLEL PRIVATE(jpart,itage,nage,inage,ks,kp,thread,wetscav,wettmp, & +!$OMP restmass, gridfract) + #if (defined _OPENMP) thread = OMP_GET_THREAD_NUM() ! Starts with 0 #else thread = 0 #endif - allocate( wetdeposit(nspec),stat=stat) - if (stat.ne.0) write(*,*)'ERROR: could not allocate wetdeposit inside of OMP loop' + allocate( wettmp(nspec),stat=stat) + if (stat.ne.0) write(*,*)'ERROR: could not allocate wettmp inside of OMP loop' !$OMP DO do i=1,count%alive jpart=count%ialive(i) - + ! Determine age class of the particle - nage is used for the kernel !****************************************************************** itage=abs(itime-part(jpart)%tstart) nage=1 - do inage=1,nageclass - nage=inage - if (itage.lt.lage(nage)) exit - end do + if (lagespectra.eq.1) then + do inage=1,nageclass + nage=inage + if (itage.lt.lage(nage)) exit + end do + endif do ks=1,nspec ! loop over species - if (WETDEPSPEC(ks).eqv..false.) cycle + if (.not. WETDEPSPEC(ks)) cycle !************************************************** ! CALCULATE DEPOSITION !************************************************** - call get_wetscav(itime,ltsample,jpart,ks,grfraction,inc_count,blc_count,wetscav) ! OMP carefully check + call get_wetscav(itime,jpart,ks,gridfract,wetscav) if (WETBKDEP) then if ((xscav_frac1(jpart,ks).lt.-0.1)) then ! particle marked as starting particle if (wetscav.gt.0.) then xscav_frac1(jpart,ks)=wetscav*(zpoint2(part(jpart)%npoint)-& - zpoint1(part(jpart)%npoint))*grfraction(1) + zpoint1(part(jpart)%npoint))*gridfract else - part(jpart)%mass(ks)=0. + mass(jpart,ks)=0. xscav_frac1(jpart,ks)=0. endif endif endif if (wetscav.gt.0.) then - wetdeposit(ks)=part(jpart)%mass(ks)* & - (1.-exp(-wetscav*abs(ltsample)))*grfraction(1) ! wet deposition + wettmp(ks)=mass(jpart,ks)* & + (1.-exp(-wetscav*abs(ltsample)))*gridfract ! wet deposition + else ! if no scavenging - wetdeposit(ks)=0. + wettmp(ks)=0. endif - part(jpart)%wetdepo(ks)=part(jpart)%wetdepo(ks)+wetdeposit(ks) - restmass = part(jpart)%mass(ks)-wetdeposit(ks) + wetdeposit(jpart,ks)=wetdeposit(jpart,ks)+wettmp(ks) + restmass = mass(jpart,ks)-wettmp(ks) if (ioutputforeachrelease.eq.1) then kp=part(jpart)%npoint else kp=1 endif if (restmass .gt. smallnum) then - part(jpart)%mass(ks)=restmass - ! depostatistic - ! wetdepo_sum(ks,kp)=wetdepo_sum(ks,kp)+wetdeposit(ks) - ! depostatistic + mass(jpart,ks)=restmass else - part(jpart)%mass(ks)=0. + mass(jpart,ks)=0. endif ! Correct deposited mass to the last time step when radioactive decay of ! gridded deposited mass was calculated if (decay(ks).gt.0.) then - wetdeposit(ks)=wetdeposit(ks)*exp(abs(ldeltat)*decay(ks)) + wettmp(ks)=wettmp(ks)*exp(abs(ldeltat)*decay(ks)) endif - ! endif ! no deposition end do ! loop over species - ! Sabine Eckhardt, June 2008 create deposition runs only for forward runs - ! Add the wet deposition to accumulated amount on output grid and nested output grid - !***************************************************************************** + !************************************************************************ + ! Sabine Eckhardt, June 2008 create deposition only for forward runs + ! Add the wet deposition to accumulated amount on output grid + ! and nested output grid if ((ldirect.eq.1).and.(iout.ne.0)) then !OMP reduction necessary for wetgridunc - call wetdepokernel(part(jpart)%nclass,wetdeposit,real(part(jpart)%xlon), & + call wetdepokernel(part(jpart)%nclass,wettmp,real(part(jpart)%xlon), & real(part(jpart)%ylat),nage,kp,thread+1) if (nested_output.eq.1) call wetdepokernel_nest(part(jpart)%nclass, & - wetdeposit,real(part(jpart)%xlon),real(part(jpart)%ylat),nage,kp,thread+1) + wettmp,real(part(jpart)%xlon),real(part(jpart)%ylat),nage,kp,thread+1) endif end do ! all particles !$OMP END DO - deallocate(wetdeposit) + deallocate(wettmp) !$OMP END PARALLEL #ifdef _OPENMP @@ -197,14 +198,11 @@ subroutine wetdepo(itime,ltsample,loutnext) endif endif #endif - !write(*,*) 'WETGRIDUNC:',sum(wetgridunc),wetgridunc(20,270,1,1,1,1),wetgridunc(19,269,1,1,1,1) - ! count the total number of below-cloud and in-cloud occurences: - tot_blc_count(1:nspec)=tot_blc_count(1:nspec)+blc_count(1:nspec) - tot_inc_count(1:nspec)=tot_inc_count(1:nspec)+inc_count(1:nspec) + end subroutine wetdepo -subroutine get_wetscav(itime,ltsample,jpart,ks,grfraction,inc_count,blc_count,wetscav) - ! i i i i i o o o o +subroutine get_wetscav(itime,jpart,ks,gridfract,wetscav) + ! i i i i i o o !***************************************************************************** ! * ! Calculation of wet deposition using the concept of scavenging coefficients.* @@ -222,6 +220,16 @@ subroutine get_wetscav(itime,ltsample,jpart,ks,grfraction,inc_count,blc_count,we ! use centred precipitation data for integration * ! Code may not be correct for decay of deposition! * ! * + ! ZHG, for v10: use below-cloud scavenging according to Laakso et al (2003) * + ! and Kyro et al (2009) as described in Grytte et al (2017, GMD) * + ! * + ! PS, AP 04/2019: - put back temporal interpolation of rain, from v10.01 * + ! - tansferred BCSCHEME parameters to par_mod.f90 * + ! - added call to rain interpolation subroutine with new * + ! interpolation for rain and all cloud params * + ! - cleaned up scavenging determination algorithm * + ! - added new below-cloud scavenging scheme * + ! * !***************************************************************************** ! * ! Variables: * @@ -235,7 +243,7 @@ subroutine get_wetscav(itime,ltsample,jpart,ks,grfraction,inc_count,blc_count,we ! and convective precipitation (dependent on prec. rate) * ! loutnext [s] time for which gridded deposition is next output * ! loutstep [s] interval at which gridded deposition is output * - ! lsp [mm/h] large scale precipitation rate * + ! lsp [mm/h] large-scale precipitation rate * ! ltsample [s] interval over which mass is deposited * ! prec [mm/h] precipitation rate in subgrid, where precipitation occurs* ! wetgrid accumulated deposited mass on output grid * @@ -253,42 +261,33 @@ subroutine get_wetscav(itime,ltsample,jpart,ks,grfraction,inc_count,blc_count,we implicit none - integer :: jpart,itime,ltsample,i,j - integer :: hz,interp_time, n + integer,intent(in) :: jpart,itime,ks + real,intent(out) :: gridfract,wetscav + + integer :: hz,interp_time, n,i,j,kz integer(kind=1) :: clouds_v - integer :: ks integer(selected_int_kind(16)), dimension(nspec) :: blc_count, inc_count - ! integer :: n1,n2, icbot,ictop, indcloud !TEST - real :: S_i, act_temp, cl, cle ! in cloud scavenging - real :: clouds_h ! cloud height for the specific grid point - real :: lsp,convp,cc,grfraction(3),prec(3),wetscav - real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled + integer :: indcloud + integer :: icbot,ictop + real :: t_particle, si, cl, cle ! in cloud scavenging + real :: lsp,convp,cc,prec !save lfr,cfr real :: xts,yts - real, parameter :: lfr(5) = (/ 0.5,0.65,0.8,0.9,0.95/) - real, parameter :: cfr(5) = (/ 0.4,0.55,0.7,0.8,0.9 /) + real, parameter :: precsub = 0.01 ! minimum precip rate (mm/h) - !ZHG aerosol below-cloud scavenging removal polynomial constants for rain and snow - real, parameter :: bclr(6) = (/274.35758, 332839.59273, 226656.57259, 58005.91340, 6588.38582, 0.244984/) !rain (Laakso et al 2003) - real, parameter :: bcls(6) = (/22.7, 0.0, 0.0, 1321.0, 381.0, 0.0/) !now (Kyro et al 2009) - real :: frac_act, liq_frac, ice_frac, dquer_m + real :: f logical :: readclouds_this_nest - wetscav=0. - ! Interpolate large scale precipitation, convective precipitation and - ! total cloud cover - ! Note that interpolated time refers to itime-0.5*ltsample [PS] + ! Interpolate large-scale precipitation, convective precipitation, + ! total cloud cover, particle temperature, cloud water content, + ! cloud bottom and top !******************************************************************** - interp_time=nint(itime-0.5*ltsample) - - n=memind(2) - if (abs(memtime(1)-interp_time).lt.abs(memtime(2)-interp_time)) & - n=memind(1) + interp_time=itime xts=real(part(jpart)%xlon) yts=real(part(jpart)%ylat) @@ -298,7 +297,9 @@ subroutine get_wetscav(itime,ltsample,jpart,ks,grfraction,inc_count,blc_count,we readclouds_this_nest=.false. call find_ngrid(xts,yts) - if ( (ngrid.gt.0) .and. readclouds_nest(ngrid)) readclouds_this_nest=.true. + if ( (ngrid.gt.0) ) then + if (lcw_nest(ngrid)) readclouds_this_nest=.true. + endif ! If point at border of grid -> small displacement into grid !*********************************************************** @@ -312,48 +313,379 @@ subroutine get_wetscav(itime,ltsample,jpart,ks,grfraction,inc_count,blc_count,we call find_grid_indices(xts,yts) call find_grid_distances(xts,yts) + +#ifdef ETA + call update_zeta_to_z(itime,jpart) + call find_z_level_eta_uv(real(part(jpart)%zeta)) + kz=induv +#else + call find_z_level_meters(real(part(jpart)%z)) + kz=indz +#endif + + ! Interpolate cloud information + call interpol_rain(itime,kz,lsp,convp,cc,t_particle,cl,icbot,ictop,icmv) + ! cc = total cloud cover + ! cl = ctwc + +! If total precipitation is less than precsub=0.01 mm/h - no scavenging +! Note: original PS version (in order avoid step at 0.01) +!----------------------------------------------------------------------- + prec = lsp+convp + if (prec .le. precsub) then + return + endif - if (ngrid.le.0) then - ! No temporal interpolation to stay consistent with clouds - call hor_interpol(lsprec,lsp,1,n,1) ! large scale total precipitation - call hor_interpol(convprec,convp,1,n,1) ! convective precipitation - call hor_interpol(tcc,cc,1,n,1) ! total cloud cover + ! Remove the minimum 0.01 from the large scale precipitation (lsp) and + ! convective precipitation (convp). Why 0.01??? + f = (prec-precsub)/prec + lsp = f*lsp + convp = f*convp + + if (abs(memtime(1)-interp_time) .lt. abs(memtime(2)-interp_time)) then + n=memind(1) else - call hor_interpol_nest(lsprecn,lsp,1,n,1) ! large scale total precipitation - call hor_interpol_nest(convprecn,convp,1,n,1) ! convective precipitation - call hor_interpol_nest(tccn,cc,1,n,1) ! total cloud cover + n=memind(2) endif - ! If total precipitation is less than 0.01 mm/h - no scavenging occurs - if ((lsp.lt.0.01).and.(convp.lt.0.01)) return - + ! if particle is above the clouds no scavenging is done + !------------------------------------------------------ + ! PS: part of 2011/2012 fix + ! NOTE this is just for z coordinate + ! Reverse sign for eta #ifdef ETA - call find_z_level_eta_uv(real(part(jpart)%zeta)) - hz=induv + if (part(jpart)%zeta .gt. real(ictop)/eta_convert) then + if (part(jpart)%zeta .le. real(icbot)/eta_convert) then #else - call find_z_level_meters(real(part(jpart)%z)) - hz=indz + if (part(jpart)%z .le. real(ictop)) then + if (part(jpart)%z .gt. real(icbot)) then #endif - - if (ngrid.le.0) then - clouds_v=clouds(ix,jy,hz,n) - clouds_h=cloudsh(ix,jy,n) + indcloud = 2 ! in-cloud + else + indcloud = 1 ! below-cloud + endif + elseif (ictop .eq. icmv) then + indcloud = 0 ! no cloud found, use old scheme else - clouds_v=cloudsn(ix,jy,hz,n,ngrid) - clouds_h=cloudshn(ix,jy,n,ngrid) + return ! above cloud endif - ! if there is no precipitation or the particle is above the clouds no - ! scavenging is done + ! 1) Parameterization of the the area fraction of the grid cell where the + ! precipitation occurs: the absolute limit is the total cloud cover, but + ! for low precipitation rates, an even smaller fraction of the grid cell + ! is used. Large scale precipitation occurs over larger areas than + ! convective precipitation. + !************************************************************************** + call get_gridfract(lsp,convp,cc,gridfract) + + ! 2) Computation of precipitation rate in sub-grid cell + !****************************************************** + prec=(lsp+convp)/gridfract + + ! 3) Computation of scavenging coefficients for all species + !********************************************************** + !------------------------------------------------------- + if (indcloud .eq. 0) then ! NO CLOUD FOUND + !------------------------------------------------------- + ! Note: more complex formulation using H or particle diametre + ! may be introduced later + wetscav=wet_a*prec**wet_b + + !------------------------------------------------------- + else if (indcloud .eq. 1) then ! BELOW CLOUD SCAVENGING + !------------------------------------------------------- + if (dquer(ks).le.0. .and. & + weta_gas(ks).gt.0. .and. wetb_gas(ks).gt.0.) then + ! gas: if positive below-cloud parameters (A or B), and dquer<=0 + call get_wetscav_belowcld_gas(ks,prec,wetscav) + + else if (dquer(ks).gt.0. .and. & + (crain_aero(ks).gt.0. .or. csnow_aero(ks).gt.0.)) then + ! aerosols: if positive below-cloud parameters (Crain/Csnow or B), and dquer>0 + + if (t_particle .ge. 273. .and. crain_aero(ks).gt.0.) then ! Rain: + call get_wetscav_belowcld_aerosol_rain(ks,prec,wetscav) + + else if (t_particle .lt. 273. .and. csnow_aero(ks).gt.0.) then ! Snow: + call get_wetscav_belowcld_aerosol_snow(ks,prec,wetscav) + !else ???????? + endif + endif ! gas or particle + ! positive below-cloud scavenging parameters given in Species file + ! end below cloud scavening + !--------------------------------------------------------- + elseif (indcloud .eq. 2) then ! IN CLOUD SCAVENGING + !--------------------------------------------------------- + + ! if negative coefficients (turned off) set to zero for use in equation + if (ccn_aero(ks).lt.0.) ccn_aero(ks)=0. + if (in_aero(ks).lt.0.) in_aero(ks)=0. + + if (dquer(ks).gt.0) then !aerosol + call get_wetscav_incld_aerosol(ks,gridfract,prec,cl,cc,t_particle,wetscav) + else !gas + call get_wetscav_incld_gas(ks,gridfract,prec,cl,cc,t_particle,wetscav) + endif +!--------------------------------------------------------- + endif ! incloud +!--------------------------------------------------------- + +end subroutine get_wetscav + +subroutine get_wetscav_belowcld_gas(ks,prec,wetscav) + implicit none + + integer,intent(in) :: ks ! Species index + real, intent(in) :: prec ! precipitation in sub-grid cell + real, intent(out) :: wetscav ! scavenging coefficient + + ! Sum number of particles below the cloud + icnt_belowcld(ks)=icnt_belowcld(ks)+1 + !weta_gas and wetb_gas are set in the SPECIES file + wetscav=weta_gas(ks)*prec**wetb_gas(ks) +end subroutine get_wetscav_belowcld_gas + +subroutine get_wetscav_belowcld_aerosol_rain(ks,prec,wetscav) + implicit none + + integer,intent(in) :: ks ! Species index + real, intent(in) :: prec ! precipitation in sub-grid cell + real, intent(out) :: wetscav ! scavenging coefficient + + + real :: dquer_m, ldquer + real :: wetscavlim, logAd, B + + ! Sum number of particles below the cloud + icnt_belowcld(ks)=icnt_belowcld(ks)+1 + + ! NIK 17.02.2015: local conversion particle diameter from um + ! (SPECIES file, readspecies) to meter + dquer_m = dquer(ks)*1.e-6 + + ! The parameterizations used by HG scheme are valid only for d < 10 um + ! Therefore, locally the diametre is clipped. However, settling and dry dep + ! are still calculated with the original diametre + ! TODO check whether warning is written by readrelease for d > 10 um + dquer_m = min( 10.e-6, dquer_m ) + + ! PS note that solid precip is usually expected for T<Tf, not T<273 + ! also, if freezing/melting point is desired, why not 273.2? + + ! AT parameterization after WANG ET AL 2014 + ! unit of dquer is in um + ! unit of precip is in mm/h + ! Wang et al. 2014: eq 6+7 + ldquer = log10(dquer(ks)) + if (dquer(ks) .le. 2.) then + logAd = bclr_a(1) + & + bclr_a(2) * ldquer + & + bclr_a(3) * ldquer**2. + & + bclr_a(4) * ldquer**3. + + B = bclr_c(1) + bclr_c(2)*ldquer + + else ! dquer .gt. 2. + logAd = bclr_b(1) + & + bclr_b(2) * ldquer + & + bclr_b(3) * ldquer**2. + & + bclr_b(4) * ldquer**3. + & + bclr_b(5) * ldquer**4. + & + bclr_b(6) * ldquer**5. + & + bclr_b(7) * ldquer**6. + + B = bclr_e(1) + & + bclr_e(2) * ldquer + & + bclr_e(3) * ldquer**2. + & + bclr_e(4) * ldquer**3. + & + bclr_e(5) * ldquer**4. + & + bclr_e(6) * ldquer**5. + & + bclr_e(7) * ldquer**6. + + endif ! dquer + + ! Wang et al. 2014: eq. 4 + wetscav = 10**(logAd+B*log10(prec)) - if (clouds_v.le.1) return +end subroutine get_wetscav_belowcld_aerosol_rain +subroutine get_wetscav_belowcld_aerosol_snow(ks,prec,wetscav) + implicit none + + integer,intent(in) :: ks ! Species index + real, intent(in) :: prec ! precipitation in sub-grid cell + real, intent(out) :: wetscav ! scavenging coefficient + + + real :: dquer_m, ldquer + real :: wetscavlim, logAd, B + + ! Sum number of particles below the cloud + icnt_belowcld(ks)=icnt_belowcld(ks)+1 + + ! NIK 17.02.2015: local conversion particle diameter from um + ! (SPECIES file, readspecies) to meter + dquer_m = dquer(ks)*1.e-6 + + ! The parameterizations used by HG scheme are valid only for d < 10 um + ! Therefore, locally the diametre is clipped. However, settling and dry dep + ! are still calculated with the original diametre + ! TODO check whether warning is written by readrelease for d > 10 um + dquer_m = min( 10.e-6, dquer_m ) + + ! AT parameterization after WANG ET AL 2014 + ! unit of dquer is in um + ! unit of precip is in mm/h + ldquer = log10(dquer(ks)) + ! Wang et al. 2014: eq. 8+9 + if (dquer(ks) .le. 1.44) then + logAd = bcls_a(1) + & + bcls_a(2) * ldquer + & + bcls_a(3) * ldquer**2. + & + bcls_a(4) * ldquer**3. + & + bcls_a(5) * ldquer**4. + & + bcls_a(6) * ldquer**5. + & + bcls_a(7) * ldquer**6. + + B = bcls_c(1) + & + bcls_c(2) * ldquer + & + bcls_c(3) * ldquer**2. + & + bcls_c(4) * ldquer**3. + & + bcls_c(5) * ldquer**4. + & + bcls_c(6) * ldquer**5. + & + bcls_c(7) * ldquer**6. + + else ! dquer .gt. 1.44 + logAd = bcls_b(1) + & + bcls_b(2) * ldquer + & + bcls_b(3) * ldquer**2. + & + bcls_b(4) * ldquer**3. + & + bcls_b(5) * ldquer**4. + & + bcls_b(6) * ldquer**5. + & + bcls_b(7) * ldquer**6. + + B = bcls_e(1) + & + bcls_e(2) * ldquer + & + bcls_e(3) * ldquer**2. + & + bcls_e(4) * ldquer**3. + & + bcls_e(5) * ldquer**4. + & + bcls_e(6) * ldquer**5. + & + bcls_e(7) * ldquer**6. + + endif ! dquer + + ! Wang et al. 2014: eq. 4 + wetscav = 10**(logAd+B*log10(prec)) + +end subroutine get_wetscav_belowcld_aerosol_snow + +subroutine get_wetscav_incld_aerosol(ks,gridfract,prec,cl,cc,t_particle,wetscav) + implicit none + + integer,intent(in) :: ks + real,intent(in) :: gridfract + real,intent(in) :: t_particle ! temperature + real, intent(in) :: prec,cc ! precipitation in sub-grid cell + real, intent(inout) :: cl ! scavenging coefficient + real,intent(out) :: wetscav + + real :: frac_act,si + + ! NIK 13 may 2015: do only if in-cloud aerosol scavenging parameters > 0 + ! (all defined in SPECIES) + if (ccn_aero(ks)+in_aero(ks) .le. 0.) return + + icnt_incld(ks)=icnt_incld(ks)+1 + + ! Compute cloud liquid and ice water + call get_cloud_liquid(gridfract,prec,cc,cl) + ! Compute actived fraction based on the temperature (rain vs. snow ) + call get_activated_frac(ks,t_particle, frac_act) + !ZHG Use the activated fraction and the liqid water to calculate the washout + si= frac_act/cl + ! scavenging coefficient based on Hertel et al 1995 - + ! using si (S_i in paper) for both gas and aerosol + + ! wetscav = ratio_incloud*si*prec/3.6E6/cloud_thickness + ! cloud_thickness cancels out since cl is computed without + wetscav=ratio_incloud*si* prec/3.6E6 ! mm/h -> m/s +end subroutine get_wetscav_incld_aerosol + +subroutine get_wetscav_incld_gas(ks,gridfract,prec,cl,cc,t_particle,wetscav) + implicit none + + integer,intent(in) :: ks + real,intent(in) :: gridfract + real,intent(in) :: t_particle ! temperature + real, intent(in) :: prec,cc ! precipitation in sub-grid cell + real, intent(inout) :: cl ! scavenging coefficient + real,intent(out) :: wetscav + + real :: frac_act,si,cle + ! NIK 13 may 2015: do only if in-cloud aerosol scavenging parameters > 0 + ! and Henry's constant > 0 (all defined in SPECIES) + if (ccn_aero(ks)+in_aero(ks)+henry(ks) .le. 0.) return + + icnt_incld(ks)=icnt_incld(ks)+1 + + ! Compute cloud liquid and ice water + call get_cloud_liquid(gridfract,prec,cc,cl) + ! Compute actived fraction based on the temperature (rain vs. snow ) + call get_activated_frac(ks,t_particle, frac_act) + + !ZHG Use the activated fraction and the liqid water to calculate the washout + cle=(1.-cl)/(henry(ks)*(r_air/3500.)*t_particle) + cl + si=1./cle + ! scavenging coefficient based on Hertel et al 1995 - + ! using si (S_i in paper) for both gas and aerosol + + ! wetscav = ratio_incloud*si*prec/3.6E6/cloud_thickness + ! cloud_thickness cancels out since cl is computed without + wetscav=ratio_incloud*si* prec/3.6E6 ! mm/h -> m/s +end subroutine get_wetscav_incld_gas + +subroutine get_activated_frac(ks,t_particle,frac_act) + implicit none + integer, intent(in) :: ks + real, intent(in) :: t_particle + real, intent(out) :: frac_act + real :: frac_liq, frac_ice + ! AT use of correct Kelvin temperature for T_ice; after ECMWF + if (t_particle .le. 250.16) then ! ice + frac_liq=0. + frac_ice=1. + ! AT use of correct Kelvin temperature for T_liquid; after ECMWF + elseif (t_particle .ge. 273.16) then ! liquid + frac_liq=1. + frac_ice=0. + else ! mixed cloud + ! Use exact value for the melting point and ice threshold as in ECMWF/IFS + frac_liq= ((t_particle-250.16)/(273.16-250.16))**2. + frac_ice = max(0., 1. - frac_liq) + endif + frac_act = frac_liq*ccn_aero(ks) + frac_ice*in_aero(ks) +end subroutine get_activated_frac + +subroutine get_gridfract(lsp,convp,cc,gridfract) ! 1) Parameterization of the the area fraction of the grid cell where the ! precipitation occurs: the absolute limit is the total cloud cover, but ! for low precipitation rates, an even smaller fraction of the grid cell ! is used. Large scale precipitation occurs over larger areas than ! convective precipitation. !************************************************************************** + implicit none + + real,intent(in) :: lsp,cc,convp + real, intent(out) :: gridfract + ! Where do these numbers come from? + real, parameter :: lfr(5) = (/ 0.5,0.65,0.8,0.9,0.95/) + real, parameter :: cfr(5) = (/ 0.4,0.55,0.7,0.8,0.9 /) + integer :: i, j + + if (.not. lgridfraction) then + gridfract=1.0 + return + endif if (lsp.gt.20.) then i=5 @@ -379,146 +711,60 @@ subroutine get_wetscav(itime,ltsample,jpart,ks,grfraction,inc_count,blc_count,we j=1 endif + ! In the future, we may differentiate the gridfract for lsp and convp + ! for now they are still mixed + gridfract=max( 0.05, cc* (lsp*lfr(i) + convp*cfr(j)) / (lsp+convp)) +end subroutine get_gridfract - !ZHG oct 2014 : Calculated for 1) both 2) lsp 3) convp - 2 and 3 not used removed by SE - ! Tentatively differentiate the grfraction for lsp and convp for treating differently the two forms - ! for now they are treated the same - grfraction(1)=max(0.05,cc*(lsp*lfr(i)+convp*cfr(j))/(lsp+convp)) - - ! 2) Computation of precipitation rate in sub-grid cell - !****************************************************** - prec(1)=(lsp+convp)/grfraction(1) - - ! 3) Computation of scavenging coefficients for all species - ! Computation of wet deposition - !********************************************************** - - if (ngrid.gt.0) then -#ifdef ETA - act_temp=ttetan(ix,jy,hz,n,ngrid) -#else - act_temp=ttn(ix,jy,hz,n,ngrid) -#endif - else -#ifdef ETA - act_temp=tteta(ix,jy,hz,n) -#else - act_temp=tt(ix,jy,hz,n) -#endif - endif +subroutine get_cloud_liquid(gridfract,prec,cc,cl) + use interpol_mod - !*********************** - ! BELOW CLOUD SCAVENGING - !*********************** - if (clouds_v.ge.4) then !below cloud + implicit none - ! For gas: if positive below-cloud parameters (A or B), and dquer<=0 - !****************************************************************** - if ((dquer(ks).le.0.).and.(weta_gas(ks).gt.0..or.wetb_gas(ks).gt.0.)) then - blc_count(ks)=blc_count(ks)+1 - wetscav=weta_gas(ks)*prec(1)**wetb_gas(ks) - - ! For aerosols: if positive below-cloud parameters (Crain/Csnow or B), and dquer>0 - !********************************************************************************* - else if ((dquer(ks).gt.0.).and.(crain_aero(ks).gt.0..or.csnow_aero(ks).gt.0.)) then - blc_count(ks)=blc_count(ks)+1 - - !NIK 17.02.2015 - ! For the calculation here particle size needs to be in meter and not um as dquer is - ! changed in readreleases - ! For particles larger than 10 um use the largest size defined in the parameterizations (10um) - dquer_m=min(10.,dquer(ks))/1000000. !conversion from um to m - - ! Rain: - if (act_temp .ge. 273. .and. crain_aero(ks).gt.0.) then - - ! ZHG 2014 : Particle RAIN scavenging coefficient based on Laakso et al 2003, - ! the below-cloud scavenging (rain efficienty) parameter Crain (=crain_aero) from SPECIES file - wetscav=crain_aero(ks)*10**(bclr(1)+(bclr(2)*(log10(dquer_m))**(-4))+ & - & (bclr(3)*(log10(dquer_m))**(-3))+ (bclr(4)*(log10(dquer_m))**(-2))+& - &(bclr(5)*(log10(dquer_m))**(-1))+bclr(6)* (prec(1))**(0.5)) - - ! Snow: - elseif (act_temp .lt. 273. .and. csnow_aero(ks).gt.0.) then - ! ZHG 2014 : Particle SNOW scavenging coefficient based on Kyro et al 2009, - ! the below-cloud scavenging (Snow efficiency) parameter Csnow (=csnow_aero) from SPECIES file - wetscav=csnow_aero(ks)*10**(bcls(1)+(bcls(2)*(log10(dquer_m))**(-4))+& - &(bcls(3)*(log10(dquer_m))**(-3))+ (bcls(4)*(log10(dquer_m))**(-2))+& - &(bcls(5)*(log10(dquer_m))**(-1))+ bcls(6)* (prec(1))**(0.5)) + real, intent(in) :: prec,cc,gridfract ! precipitation in sub-grid cell + real, intent(inout) :: cl ! scavenging coefficient + !ZHG 2015 use cloud liquid & ice water (CLWC+CIWC) from ECMWF - endif - - endif ! gas or particle - ! endif ! positive below-cloud scavenging parameters given in Species file - endif !end BELOW - - !******************** - ! IN CLOUD SCAVENGING - !******************** - if (clouds_v.lt.4) then ! In-cloud - ! NIK 13 may 2015: only do incloud if positive in-cloud scavenging parameters are - ! given in species file, or if gas and positive Henry's constant - if ((ccn_aero(ks).gt.0. .or. in_aero(ks).gt.0.).or.(henry(ks).gt.0.and.dquer(ks).le.0)) then - inc_count(ks)=inc_count(ks)+1 - ! if negative coefficients (turned off) set to zero for use in equation - if (ccn_aero(ks).lt.0.) ccn_aero(ks)=0. - if (in_aero(ks).lt.0.) in_aero(ks)=0. - - !ZHG 2015 Cloud liquid & ice water (CLWC+CIWC) from ECMWF - ! nested fields - if (ngrid.gt.0.and.readclouds_this_nest) then - cl=ctwcn(ix,jy,n,ngrid)*(grfraction(1)/cc) - else if (ngrid.eq.0.and.readclouds) then - ! cl=ctwc(ix,jy,n)*(grfraction(1)/cc) - ! A.Plach 2021 cl should not become too small - cl=max(1E6*2E-7*prec(1)**0.36, ctwc(ix,jy,n)*(grfraction(1)/cc)) - else !parameterize cloudwater m2/m3 - !ZHG updated parameterization of cloud water to better reproduce the values coming from ECMWF - ! sec test - ! cl=1E6*1E-7*prec(1)**0.3 !Sec GFS new - cl=1E6*2E-7*prec(1)**0.36 !Sec ECMWF new, is also suitable for GFS - ! cl=2E-7*prec(1)**0.36 !Andreas - ! cl=1.6E-6*prec(1)**0.36 !Henrik - endif + ! MC -- Integrated water content: + ! CTWC = SUM(CLWC * rho_water * cloud_thickness) [kg/kg * kg/m3 * m] + ! -> Average water content: cl = CTWC/rho_water/cloud_thickness [m3(water)/m3(cloud)] - !ZHG: Calculate the partition between liquid and water phase water. - if (act_temp .le. 253.) then - liq_frac=0 - ice_frac=1 - else if (act_temp .ge. 273.) then - liq_frac=1 - ice_frac=0 + ! Note that cloud_thickness is not included, since this will cancel out when + ! computing the wetscavenging: Wetscav=ratio_incloud*S_i*(prec/3.6E6)/cloud_thickness + ! S_i=1/cl + ! Mother grid + if (ngrid.le.0) then + if (lcw) then + if (lgridfraction) then + cl=cl/rho_water*(gridfract/cc) else - ! sec bugfix after FLEXPART paper review, liq_frac was 1-liq_frac - ! IP bugfix v10.4, calculate ice_frac and liq_frac - ice_frac= ((act_temp-273.)/(273.-253.))**2. - !liq_frac = 1-ice_frac !((act_temp-253.)/(273.-253.))**2. - liq_frac=max(0.,1.-ice_frac) - end if - ! ZHG: Calculate the aerosol partition based on cloud phase and Ai and Bi - ! frac_act = liq_frac*ccn_aero(ks) +(1-liq_frac)*in_aero(ks) - ! IP, use ice_frac and liq_frac - frac_act = liq_frac*ccn_aero(ks) + ice_frac*in_aero(ks) - - !ZHG Use the activated fraction and the liqid water to calculate the washout - - ! AEROSOL - !******** - if (dquer(ks).gt.0.) then - S_i= frac_act/cl - ! GAS - !**** + cl=cl/rho_water ! Grythe et al. eq (1), no cloud_thickness since this will cancel out later + endif + ! cl = cl*(gridfract/cc) + ! A.Plach 2021 cl should not become too small + ! cl=max(0.2*prec**0.36, cl*(gridfract/cc)) + else ! no cloud water available, use parameterisation for cloud water [m2/m3] + cl=0.2*prec**0.36 !max(0.2*prec**0.36, cl*(gridfract/cc)) + ! ZHG updated parameterization to better reproduce the values from ECMWF + ! cl = 1.E6*2E-7*prec**0.36 ! SEC ECMWF new, is also suitable for GFS + ! SEC test: + ! cl=1.E6*1.E-7*prec**0.3 ! SEC GFS new + ! cl= 2.E-7*prec**0.36 ! Andreas + ! cl= 1.6E-6*prec**0.36 ! Henrik + endif + else + if (lcw_nest(ngrid)) then + if (lgridfraction) then + cl=cl/rho_water*(gridfract/cc) else - cle=(1-cl)/(henry(ks)*(r_air/3500.)*act_temp)+cl - S_i=1/cle - endif ! gas or particle - - ! scavenging coefficient based on Hertel et al 1995 - using the S_i for either gas or aerosol - !SEC wetscav fix, the cloud height is no longer needed, it gives wrong results - wetscav=incloud_ratio*S_i*(prec(1)/3.6E6) - endif ! positive in-cloud scavenging parameters given in Species file - endif !incloud -end subroutine get_wetscav + cl=cl/rho_water ! Grythe et al. eq (1), no cloud_thickness since this will cancel out later + endif + !cl = cl*(gridfract/cc) + else + cl=0.2*prec**0.36 + endif + endif +end subroutine get_cloud_liquid subroutine wetdepokernel(nunc,deposit,x,y,nage,kp,thread) ! i i i i i @@ -818,12 +1064,13 @@ subroutine writeprecip(itime,imem) do i=1,numpoint xp1=xpoint1(i)*dx+xlon0 !lat, long (real) coord yp1=ypoint1(i)*dy+ylat0 !lat, long (real) coord - ix=int((xpoint1(i)+xpoint2(i))/2.) - jy=int((ypoint1(i)+ypoint2(i))/2.) - write(unitprecip,*) jjjjmmdd, ihmmss, & - xp1,yp1,lsprec(ix,jy,1,imem),convprec(ix,jy,1,imem) !time is the same as in the ECMWF windfield + ix=int((xpoint1(i)+xpoint2(i))*0.5) + jy=int((ypoint1(i)+ypoint2(i))*0.5) + write(unitprecip,*) jjjjmmdd, ihmmss,xp1,yp1, & + sum(lsprec(ix,jy,1,:,imem)),sum(convprec(ix,jy,1,:,imem)) + !time is the same as in the ECMWF windfield ! units mm/h, valid for the time given in the windfield - end do + enddo close(unitprecip) diff --git a/src/windfields_mod.f90 b/src/windfields_mod.f90 index aaeeb4a3353f3e790d27387299126df7a7adaf79..5ba63cce159cf8ddddda1dbd5f4567924c979295 100644 --- a/src/windfields_mod.f90 +++ b/src/windfields_mod.f90 @@ -74,7 +74,7 @@ module windfields_mod uu,vv,ww, & ! wind components in x,y and z direction [m/s] uupol,vvpol, & ! wind components in polar stereographic projection [m/s] tt,tth, & ! temperature data on internal and half model levels [K] - qv,qvh, & ! specific humidity data on internal and half model levels + qv,qvh, & ! specific humidity data on internal and half model levels (eta if 'ETA') pv, & ! potential vorticity rho, & ! air density [kg/m3] drhodz, & ! vertical air density gradient [kg/m2] @@ -83,24 +83,17 @@ module windfields_mod rho_dry ! dry air density RLT Only printed out in binary mode??? ! Cloud properties - ! clouds: no cloud, no precipitation 0 - ! cloud, no precipitation 1 - ! rainout conv/lsp dominated 2/3 - ! washout conv/lsp dominated 4/5 - ! PS 2013 !***************************************** real, allocatable,dimension(:,:,:,:) :: & clwc, & ! liquid [kg/kg] ZHG ciwc, & ! ice [kg/kg] ZHG - clw, & ! combined [m3/m3] ZHG clwch, & ! original eta level liquid [kg/kg] ZHG ciwch ! original eta level ice [kg/kg] ZHG real, allocatable,dimension(:,:,:) :: & ctwc ! ESO: =icloud_stats(:,:,4,:) total cloud water content - integer(kind=1),allocatable,dimension(:,:,:,:) :: & - clouds ! scavenging NIK, PS - integer,allocatable,dimension(:,:,:) :: & - cloudsh ! scavenging NIK, PS + integer,allocatable,dimension(:,:,:) :: & ! new scavenging AT 2021 + icloudbot, & ! cloud bottom height [m/eta] + icloudtop ! cloud top [m/eta] ! 3d nested fields !***************** @@ -130,15 +123,13 @@ module windfields_mod real,allocatable,dimension(:,:,:,:,:) :: & clwcn, & ! liquid [kg/kg] ZHG ciwcn, & ! ice [kg/kg] ZHG - clwn, & ! combined [m3/m3] ZHG clwchn, & ! original eta level liquid [kg/kg] ZHG ciwchn ! original eta level ice [kg/kg] ZHG real,allocatable,dimension(:,:,:,:) :: & ctwcn ! ESO: =icloud_stats(:,:,4,:) total cloud water content - integer(kind=1),allocatable,dimension(:,:,:,:,:) :: & - cloudsn ! scavenging NIK, PS - integer,allocatable,dimension(:,:,:,:) :: & - cloudshn ! scavenging NIK, PS + integer,allocatable,dimension(:,:,:,:) :: & ! new scavenging AT 2021 + icloudbotn, & ! cloud bottom height [m/eta] + icloudtopn ! cloud thickness [m/eta] ! 2d fields !********** @@ -151,17 +142,21 @@ module windfields_mod v10, & ! 10 meter v tt2, & ! 2 meter temperature td2, & ! 2 meter dew point - lsprec, & ! large scale total precipitation [mm/h] - convprec, & ! convective precipitation [mm/h] sshf, & ! surface sensible heat flux ssr, & ! surface solar radiation - sfcstress, & ! surface stress + sfcstress, & ! surface stress ustar, & ! friction velocity [m/s] wstar, & ! convective velocity scale [m/s] hmix, & ! mixing height [m] tropopause, & ! altitude of thermal tropopause [m] oli ! inverse Obukhov length (1/L) [m] + ! 2d fields + !********** + real, allocatable,dimension(:,:,:,:,:) :: & ! newWetDepoScheme, extra precip dimension AT 2021 + lsprec, & ! large scale total precipitation [mm/h] + convprec ! convective precipitation [mm/h] + ! 2d nested fields !******************* real, allocatable,dimension(:,:,:,:,:) :: & @@ -173,11 +168,9 @@ module windfields_mod v10n, & ! 10 meter v tt2n, & ! 2 meter temperature td2n, & ! 2 meter dew point - lsprecn, & ! large scale total precipitation [mm/h] - convprecn, & ! convective precipitation [mm/h] sshfn, & ! surface sensible heat flux ssrn, & ! surface solar radiation - sfcstressn, & ! surface stress + sfcstressn, & ! surface stress ustarn, & ! friction velocity [m/s] wstarn, & ! convective velocity scale [m/s] hmixn, & ! mixing height [m] @@ -185,6 +178,12 @@ module windfields_mod olin, & ! inverse Obukhov length (1/L) [m] vdepn ! + ! 2d fields + !********** + real, allocatable,dimension(:,:,:,:,:,:) :: & ! newWetDepoScheme, extra precip dimension AT 2021 + lsprecn, & ! large scale total precipitation [mm/h] + convprecn ! convective precipitation [mm/h] + integer :: metdata_format ! storing the input data type (ECMWF/NCEP) !**************************************************************************** @@ -304,6 +303,10 @@ subroutine gridcheck_ecmwf ! Marian Harustak, 12.5.2017 * ! - Renamed from gridcheck to gridcheck_ecmwf * ! * + ! * + ! Anne Tipka, Petra Seibert 2021-02: implement new interpolation * + ! for precipitation according to #295 using 2 additional fields * + ! * !********************************************************************** ! * ! DESCRIPTION: * @@ -340,18 +343,21 @@ subroutine gridcheck_ecmwf implicit none - !HSO parameters for grib_api integer :: ifile integer :: iret integer :: igrib integer :: gotGrid,stat real(kind=4) :: xaux1,xaux2,yaux1,yaux2 real(kind=8) :: xaux1in,xaux2in,yaux1in,yaux2in - integer :: gribVer,parCat,parNum,typSurf,valSurf,discipl,parId + integer :: gribVer,parCat,parNum,typSfc,valSurf,discipl,parId !HSO end - integer :: ix,jy,i,ifn,ifield,j,k,iumax,iwmax,numskip,size1,size2 + integer :: ix,jy,i,ifn,ifield,j,iumax,iwmax,numskip,size1,size2 + integer :: k ! (as k, is the level in ECWMF notation, top->bot) real :: sizesouth,sizenorth,xauxa + integer :: istep, ipf ! istep=stepRange for precip field identification + integer :: pcount ! counter for precipitation fields + ! VARIABLES AND ARRAYS NEEDED FOR GRIB DECODING ! dimension of isec2 at least (22+n), where n is the number of parallels or @@ -360,17 +366,28 @@ subroutine gridcheck_ecmwf ! dimension of zsec2 at least (10+nn), where nn is the number of vertical ! coordinate parameters - integer :: isec1(56), isec2(3) real(kind=4),allocatable,dimension(:) :: zsec2 real(kind=4),allocatable,dimension(:) :: zsec4 + ! AT PS replace isec1, isec2 arrays by scalar values because we don't need + ! arrays anymore. isec1(X) -> isX, isec2(X) -> jsX + integer :: is6, js2, js3, js12 character(len=1) :: opt !HSO grib api error messages character(len=24) :: gribErrorMsg = 'Error reading grib file' - character(len=20) :: gribFunction = 'gridcheck' + + character(len=20) :: thisSubr = 'gridcheck_ecmwf' + + logical :: lstep(0:2), luseprec iumax=0 iwmax=0 + + ! AT defaults to identify precipitation interpolation algorithm + luseprec=.false. + lprecint=.false. + lstep(:)=.false. + pcount=0 if(ideltas.gt.0) then ifn=1 @@ -380,11 +397,9 @@ subroutine gridcheck_ecmwf ! ! OPENING OF DATA FILE (GRIB CODE) ! -5 call grib_open_file(ifile,path(3)(1:length(3)) & - //trim(wfname(ifn)),'r',iret) - if (iret.ne.GRIB_SUCCESS) then - goto 999 ! ERROR DETECTED - endif + call grib_open_file(ifile,path(3)(1:length(3))//trim(wfname(ifn)),'r',iret) + if (iret.ne.GRIB_SUCCESS) goto 999 ! ERROR DETECTED + !turn on support for multi fields messages !call grib_multi_support_on @@ -392,9 +407,10 @@ subroutine gridcheck_ecmwf ifield=0 do while(.true.) ifield=ifield+1 - ! - ! GET NEXT FIELDS - ! + + ! reading messages from GRIB file + !-------------------------------- + call grib_new_from_file(ifile,igrib,iret) if (iret.eq.GRIB_END_OF_FILE ) then exit ! EOF DETECTED @@ -404,191 +420,209 @@ subroutine gridcheck_ecmwf !first see if we read GRIB1 or GRIB2 call grib_get_int(igrib,'editionNumber',gribVer,iret) - call grib_check(iret,gribFunction,gribErrorMsg) + call grib_check(iret,thisSubr,gribErrorMsg) + + ! AT stepRange is used to identify additional precip fields + call grib_get_int(igrib,'stepRange',istep,iret) + call grib_check(iret,thisSubr,gribErrorMsg) if (gribVer.eq.1) then ! GRIB Edition 1 - !print*,'GRiB Edition 1' - !read the grib2 identifiers - call grib_get_int(igrib,'indicatorOfParameter',isec1(6),iret) - call grib_check(iret,gribFunction,gribErrorMsg) - call grib_get_int(igrib,'level',isec1(8),iret) - call grib_check(iret,gribFunction,gribErrorMsg) + ! read the grib1 identifiers + call grib_get_int(igrib,'indicatorOfParameter',is6,iret) + call grib_check(iret,thisSubr,gribErrorMsg) + + call grib_get_int(igrib,'level',k,iret) + call grib_check(iret,thisSubr,gribErrorMsg) !change code for etadot to code for omega - if (isec1(6).eq.77) then - isec1(6)=135 - endif + if (is6 .eq. 77) is6=135 - !print*,isec1(6),isec1(8) + else ! GRiB Edition 2 - else - - !print*,'GRiB Edition 2' !read the grib2 identifiers call grib_get_int(igrib,'discipline',discipl,iret) - call grib_check(iret,gribFunction,gribErrorMsg) + call grib_check(iret,thisSubr,gribErrorMsg) + call grib_get_int(igrib,'parameterCategory',parCat,iret) - call grib_check(iret,gribFunction,gribErrorMsg) + call grib_check(iret,thisSubr,gribErrorMsg) + call grib_get_int(igrib,'parameterNumber',parNum,iret) - call grib_check(iret,gribFunction,gribErrorMsg) - call grib_get_int(igrib,'typeOfFirstFixedSurface',typSurf,iret) - call grib_check(iret,gribFunction,gribErrorMsg) - call grib_get_int(igrib,'level',valSurf,iret) - call grib_check(iret,gribFunction,gribErrorMsg) + call grib_check(iret,thisSubr,gribErrorMsg) + + call grib_get_int(igrib,'typeOfFirstFixedSurface',typSfc,iret) + call grib_check(iret,thisSubr,gribErrorMsg) + + call grib_get_int(igrib,'level',k,iret) + call grib_check(iret,thisSubr,gribErrorMsg) + call grib_get_int(igrib,'paramId',parId,iret) - call grib_check(iret,gribFunction,gribErrorMsg) - - !print*,discipl,parCat,parNum,typSurf,valSurf + call grib_check(iret,thisSubr,gribErrorMsg) !convert to grib1 identifiers - isec1(6)=-1 - isec1(7)=-1 - isec1(8)=-1 - isec1(8)=valSurf ! level - if ((parCat.eq.0).and.(parNum.eq.0).and.(typSurf.eq.105)) then ! T - isec1(6)=130 ! indicatorOfParameter - elseif ((parCat.eq.2).and.(parNum.eq.2).and.(typSurf.eq.105)) then ! U - isec1(6)=131 ! indicatorOfParameter - elseif ((parCat.eq.2).and.(parNum.eq.3).and.(typSurf.eq.105)) then ! V - isec1(6)=132 ! indicatorOfParameter - elseif ((parCat.eq.1).and.(parNum.eq.0).and.(typSurf.eq.105)) then ! Q - isec1(6)=133 ! indicatorOfParameter - !ZHG FOR CLOUDS FROM GRIB - elseif ((parCat.eq.1).and.(parNum.eq.83).and.(typSurf.eq.105)) then ! clwc - isec1(6)=246 ! indicatorOfParameter - elseif ((parCat.eq.1).and.(parNum.eq.84).and.(typSurf.eq.105)) then ! ciwc - isec1(6)=247 ! indicatorOfParameter - !ZHG end - ! ESO qc(=clwc+ciwc) - elseif ((parCat.eq.201).and.(parNum.eq.31).and.(typSurf.eq.105)) then ! qc - isec1(6)=201031 ! indicatorOfParameter - elseif ((parCat.eq.3).and.(parNum.eq.0).and.(typSurf.eq.1)) then !SP - isec1(6)=134 ! indicatorOfParameter - elseif ((parCat.eq.2).and.(parNum.eq.32)) then ! W, actually eta dot - isec1(6)=135 ! indicatorOfParameter - elseif ((parCat.eq.128).and.(parNum.eq.77)) then ! W, actually eta dot - isec1(6)=135 ! indicatorOfParameter - elseif ((parCat.eq.3).and.(parNum.eq.0).and.(typSurf.eq.101)) then !SLP - isec1(6)=151 ! indicatorOfParameter - elseif ((parCat.eq.2).and.(parNum.eq.2).and.(typSurf.eq.103)) then ! 10U - isec1(6)=165 ! indicatorOfParameter - elseif ((parCat.eq.2).and.(parNum.eq.3).and.(typSurf.eq.103)) then ! 10V - isec1(6)=166 ! indicatorOfParameter - elseif ((parCat.eq.0).and.(parNum.eq.0).and.(typSurf.eq.103)) then ! 2T - isec1(6)=167 ! indicatorOfParameter - elseif ((parCat.eq.0).and.(parNum.eq.6).and.(typSurf.eq.103)) then ! 2D - isec1(6)=168 ! indicatorOfParameter - elseif ((parCat.eq.1).and.(parNum.eq.11).and.(typSurf.eq.1)) then ! SD - isec1(6)=141 ! indicatorOfParameter - elseif ((parCat.eq.6).and.(parNum.eq.1) .or. parId .eq. 164) then ! CC - isec1(6)=164 ! indicatorOfParameter - elseif ((parCat.eq.1).and.(parNum.eq.9) .or. parId .eq. 142) then ! LSP - isec1(6)=142 ! indicatorOfParameter - elseif ((parCat.eq.1).and.(parNum.eq.10)) then ! CP - isec1(6)=143 ! indicatorOfParameter - elseif ((parCat.eq.0).and.(parNum.eq.11).and.(typSurf.eq.1)) then ! SHF - isec1(6)=146 ! indicatorOfParameter - elseif ((parCat.eq.4).and.(parNum.eq.9).and.(typSurf.eq.1)) then ! SR - isec1(6)=176 ! indicatorOfParameter - elseif ((parCat.eq.2).and.(parNum.eq.17) .or. parId .eq. 180) then ! EWSS - isec1(6)=180 ! indicatorOfParameter - elseif ((parCat.eq.2).and.(parNum.eq.18) .or. parId .eq. 181) then ! NSSS - isec1(6)=181 ! indicatorOfParameter - elseif ((parCat.eq.3).and.(parNum.eq.4)) then ! ORO - isec1(6)=129 ! indicatorOfParameter - elseif ((parCat.eq.3).and.(parNum.eq.7) .or. parId .eq. 160) then ! SDO - isec1(6)=160 ! indicatorOfParameter - elseif ((discipl.eq.2).and.(parCat.eq.0).and.(parNum.eq.0).and. & - (typSurf.eq.1)) then ! LSM - isec1(6)=172 ! indicatorOfParameter + is6=-1 + if (parCat .eq. 0 .and. parNum .eq. 0 .and. typSfc .eq. 105) then ! T + is6=130 + elseif (parCat .eq. 2 .and. parNum .eq. 2 .and. typSfc .eq. 105) then ! U + is6=131 + elseif (parCat .eq. 2 .and. parNum .eq. 3 .and. typSfc .eq. 105) then ! V + is6=132 + elseif (parCat .eq. 1 .and. parNum .eq. 0 .and. typSfc .eq. 105) then ! Q + is6=133 + ! ESO Cloud water is in a) fields CLWC and CIWC, *or* b) field QC + elseif (parCat .eq. 1 .and. parNum .eq. 83 .and. typSfc .eq. 105) then ! clwc + is6=246 + elseif (parCat .eq. 1 .and. parNum .eq. 84 .and. typSfc .eq. 105) then ! ciwc + is6=247 + ! ESO qc(=clwc+ciwc): + elseif (parCat .eq. 201 .and. parNum .eq. 31 .and. typSfc .eq. 105) then ! qc + is6=201031 + elseif (parCat .eq. 3 .and. parNum .eq. 0 .and. typSfc .eq. 1) then !SP + is6=134 + elseif (parCat .eq. 2 .and. parNum .eq. 32) then ! W, actually eta dot + is6=135 + elseif (parCat .eq. 128 .and. parNum .eq. 77) then ! W, actually eta dot + is6=135 + elseif (parCat .eq. 3 .and. parNum .eq. 0 .and. typSfc .eq. 101) then ! SLP + is6=151 + elseif (parCat .eq. 2 .and. parNum .eq. 2 .and. typSfc .eq. 103) then ! 10U + is6=165 + elseif (parCat .eq. 2 .and. parNum .eq. 3 .and. typSfc .eq. 103) then ! 10V + is6=166 + elseif (parCat .eq. 0 .and. parNum .eq. 0 .and. typSfc .eq. 103) then ! 2T + is6=167 + elseif (parCat .eq. 0 .and. parNum .eq. 6 .and. typSfc .eq. 103) then ! 2D + is6=168 + elseif (parCat .eq. 1 .and. parNum .eq. 11 .and. typSfc .eq. 1) then ! SD + is6=141 + elseif (parCat .eq. 6 .and. parNum .eq. 1 .or. parId .eq. 164) then ! CC + is6=164 + elseif (parCat .eq. 1 .and. parNum .eq. 9 .or. parId .eq. 142) then ! LSP + is6=142 + elseif (parCat .eq. 1 .and. parNum .eq. 10) then ! CP + is6=143 + elseif (parCat .eq. 0 .and. parNum .eq. 11 .and. typSfc .eq. 1) then ! SHF + is6=146 + elseif (parCat .eq. 4 .and. parNum .eq. 9 .and. typSfc .eq. 1) then ! SR + is6=176 + elseif (parCat .eq. 2 .and. parNum .eq. 38 .or. parId .eq. 180) then ! EWSS --correct + is6=180 + elseif (parCat .eq. 2 .and. parNum .eq. 37 .or. parId .eq. 181) then ! NSSS --correct + is6=181 + elseif (parCat .eq. 3 .and. parNum .eq. 4) then ! ORO + is6=129 + elseif (parCat .eq. 3 .and. parNum .eq. 7 .or. parId .eq. 160) then ! SDO + is6=160 + elseif (discipl .eq. 2 .and. parCat .eq. 0 .and. parNum .eq. 0 .and. & + typSfc .eq. 1) then ! LSM + is6=172 + elseif (parNum .eq. 152) then + is6=152 ! avoid warning for lnsp else - print*,'***ERROR: undefined GRiB2 message found!',discipl, & - parCat,parNum,typSurf + print*,'***WARNING: undefined GRiB2 message found!',discipl, & + parCat,parNum,typSfc endif - if(parId .ne. isec1(6) .and. parId .ne. 77) then - write(*,*) 'parId',parId, 'isec1(6)',isec1(6) - ! stop + if (parId .ne. is6 .and. parId .ne. 77) write(*,*) 'parId',parId, 'is6',is6 + + endif !gribVer + +! call grib_get_int(igrib,'numberOfPointsAlongAParallel',js2,iret) +! if (js2 .gt. nxmax) THEN +! write(*,*) 'FLEXPART error: Too many grid points in x direction.' +! write(*,*) 'Reduce resolution of wind fields.' +! write(*,*) 'Or change parameter settings in file par_mod.f90' +! write(*,*) js2,nxmax +! stop +! endif + + ! AT, PS + ! Identify how many precip fields are available per input time step + if (is6 .eq. 142 .or. is6 .eq. 143) then ! PRECIPITATION + pcount=pcount+1 + lstep(istep)=.true. + ipf=istep+1 + if (pcount .gt. 2) then ! additional precip field found + if (numpf .eq. 1) then + write(*,*) '*** ERROR: additional precip fields available ***' + write(*,*) '*** You must use them, set numpf=3 and recompile ***' + stop 'readwind_ecmwf: set numpf to 3 in par_mod.f90' + elseif (ipf .le. numpf) then + luseprec=.true. + else + write(*,*) '*** ERROR: unexpected value of numpf=',numpf,' ***' + write(*,*) '*** Set to 1 or 3 and recompile ***' + stop 'readwind_ecmwf: numpf too small' + endif + else ! regular precip field + luseprec=.true. endif - endif - call grib_get_int(igrib,'numberOfPointsAlongAParallel', & - isec2(1),iret) - ! ! nx=isec2(2) - ! ! WRITE(*,*) nx,nxmax - ! if (isec2(2).gt.nxmax) then - ! WRITE(*,*) 'FLEXPART error: Too many grid points in x direction.' - ! WRITE(*,*) 'Reduce resolution of wind fields.' - ! WRITE(*,*) 'Or change parameter settings in file ecmwf_mod.' - ! WRITE(*,*) isec2(2),nxmax - ! ! STOP - ! endif + if (ifield .eq. 1) then - if (ifield.eq.1) then + call grib_get_int(igrib,'numberOfPointsAlongAParallel',js2,iret) + call grib_check(iret,thisSubr,gribErrorMsg) - !HSO get the required fields from section 2 in a gribex compatible manner - call grib_get_int(igrib,'numberOfPointsAlongAParallel', & - isec2(1),iret) - call grib_check(iret,gribFunction,gribErrorMsg) - call grib_get_int(igrib,'numberOfPointsAlongAMeridian', & - isec2(2),iret) - call grib_check(iret,gribFunction,gribErrorMsg) - call grib_get_real8(igrib,'longitudeOfFirstGridPointInDegrees', & - xaux1in,iret) - call grib_check(iret,gribFunction,gribErrorMsg) - call grib_get_int(igrib,'numberOfVerticalCoordinateValues', & - isec2(3),iret) - call grib_check(iret,gribFunction,gribErrorMsg) + call grib_get_int(igrib,'numberOfPointsAlongAMeridian',js3,iret) + call grib_check(iret,thisSubr,gribErrorMsg) + + call grib_get_int(igrib,'numberOfVerticalCoordinateValues',js12) + call grib_check(iret,thisSubr,gribErrorMsg) - nxfield=isec2(1) - ny=isec2(2) - nlev_ec=isec2(3)/2-1 + call grib_get_real8(igrib,'longitudeOfFirstGridPointInDegrees',xaux1in,iret) + call grib_check(iret,thisSubr,gribErrorMsg) + + nxfield=js2 + ny=js3 + nlev_ec=js12/2-1 ! call grib_get_size(igrib,'values',size1,iret) ! call grib_check(iret,gribFunction,gribErrorMsg) call grib_get_size(igrib,'pv',size2,iret) - call grib_check(iret,gribFunction,gribErrorMsg) + call grib_check(iret,thisSubr,gribErrorMsg) allocate(zsec2(size2), stat=stat) if (stat.ne.0) error stop "Could not allocate zsec2" call grib_get_real4_array(igrib,'pv',zsec2,iret) - call grib_check(iret,gribFunction,gribErrorMsg) - endif + call grib_check(iret,thisSubr,gribErrorMsg) + + endif ! ifield !get the size and data of the values array - if (isec1(6).ne.-1) then + if (is6.ne.-1) then ! LB: Within ecCodes, especially when moving from the grib_api to eccodes, ! memory is allocated within the function below when the input array is ! dynamically allocated. This is why it needs to be allocated and ! deallocated for every field to avoid unexpected behaviour. call grib_get_size(igrib,'values',size1,iret) - call grib_check(iret,gribFunction,gribErrorMsg) + call grib_check(iret,thisSubr,gribErrorMsg) allocate(zsec4(size1), stat=stat) if (stat.ne.0) error stop "Could not allocate zsec4" call grib_get_real4_array(igrib,'values',zsec4,iret) - call grib_check(iret,gribFunction,gribErrorMsg) + call grib_check(iret,thisSubr,gribErrorMsg) endif !HSO get the second part of the grid dimensions only from GRiB1 messages - if (isec1(6) .eq. 167 .and. (gotGrid.eq.0)) then - call grib_get_real8(igrib,'longitudeOfLastGridPointInDegrees', & - xaux2in,iret) - call grib_check(iret,gribFunction,gribErrorMsg) - call grib_get_real8(igrib,'latitudeOfLastGridPointInDegrees', & - yaux1in,iret) - call grib_check(iret,gribFunction,gribErrorMsg) - call grib_get_real8(igrib,'latitudeOfFirstGridPointInDegrees', & - yaux2in,iret) - call grib_check(iret,gribFunction,gribErrorMsg) + if (is6 .eq. 167 .and. gotGrid .eq. 0) then + + call grib_get_real8(igrib,'longitudeOfLastGridPointInDegrees',xaux2in,iret) + call grib_check(iret,thisSubr,gribErrorMsg) + + call grib_get_real8(igrib,'latitudeOfLastGridPointInDegrees',yaux1in,iret) + call grib_check(iret,thisSubr,gribErrorMsg) + + call grib_get_real8(igrib,'latitudeOfFirstGridPointInDegrees',yaux2in,iret) + call grib_check(iret,thisSubr,gribErrorMsg) + xaux1=real(xaux1in) xaux2=real(xaux2in) yaux1=real(yaux1in) yaux2=real(yaux2in) - if (xaux1.gt.180.) xaux1=xaux1-360.0 - if (xaux2.gt.180.) xaux2=xaux2-360.0 - if (xaux1.lt.-180.) xaux1=xaux1+360.0 - if (xaux2.lt.-180.) xaux2=xaux2+360.0 - if (xaux2.lt.xaux1) xaux2=xaux2+360.0 + if (xaux1.gt.180.) xaux1=xaux1-360. + if (xaux2.gt.180.) xaux2=xaux2-360. + if (xaux1.lt.-180.) xaux1=xaux1+360. + if (xaux2.lt.-180.) xaux2=xaux2+360. + if (xaux2.lt.xaux1) xaux2=xaux2+360. + xlon0=xaux1 ylat0=yaux1 dx=(xaux2-xaux1)/real(nxfield-1) @@ -596,10 +630,12 @@ subroutine gridcheck_ecmwf dxconst=180./(dx*r_earth*pi) dyconst=180./(dy*r_earth*pi) gotGrid=1 + + !------------------------------------------------------------- ! Check whether fields are global ! If they contain the poles, specify polar stereographic map ! projections using the stlmbr- and stcm2p-calls - !*********************************************************** + !------------------------------------------------------------- xauxa=abs(xaux2+dx-360.-xaux1) if (xauxa.lt.0.001) then @@ -666,11 +702,10 @@ subroutine gridcheck_ecmwf ! error stop ! endif - k=isec1(8) - if(isec1(6).eq.131) iumax=max(iumax,nlev_ec-k+1) - if(isec1(6).eq.135) iwmax=max(iwmax,nlev_ec-k+1) + if (is6 .eq. 131) iumax=max(iumax,nlev_ec-k+1) + if (is6 .eq. 135) iwmax=max(iwmax,nlev_ec-k+1) - if (isec1(6) .eq. 167) then + if (is6 .eq. 167) then ! Asking grid values and allocate memory to read windfields nxmax=nxfield if (xglobal) then @@ -687,21 +722,21 @@ subroutine gridcheck_ecmwf write(*,*) 'grid dim:',nxmax,nymax,nwzmax,nuvzmax,nconvlevmax,na endif - if(isec1(6).eq.129) then + if(is6.eq.129) then do jy=0,ny-1 do ix=0,nxfield-1 oro(ix,jy)=zsec4(nxfield*(ny-jy-1)+ix+1)/ga end do end do endif - if(isec1(6).eq.172) then + if(is6.eq.172) then do jy=0,ny-1 do ix=0,nxfield-1 lsm(ix,jy)=zsec4(nxfield*(ny-jy-1)+ix+1) end do end do endif - if(isec1(6).eq.160) then + if(is6.eq.160) then do jy=0,ny-1 do ix=0,nxfield-1 excessoro(ix,jy)=zsec4(nxfield*(ny-jy-1)+ix+1) @@ -710,13 +745,23 @@ subroutine gridcheck_ecmwf endif call grib_release(igrib) - if (isec1(6).ne.-1) deallocate( zsec4 ) + if (is6.ne.-1) deallocate( zsec4 ) + + end do !! READ NEXT GRIB MESSAGE (LEVEL OR PARAMETER) - end do !! READ NEXT LEVEL OR PARAMETER ! ! CLOSING OF INPUT DATA FILE ! call grib_close_file(ifile) + + if (luseprec .eqv. .false.) & + error stop "Conditions for precipitation interpolation not fulfilled! & + Please check number of precipitation fields per type in GRIB files and & + numpf parameter in par_mod.f90." + + ! save info for type of precipitation interpolation + ! true if new interpolation / false for old interpolation + if ( all(lstep) ) lprecint=.true. ! Allocate memory for windfields !******************************* @@ -724,8 +769,7 @@ subroutine gridcheck_ecmwf !error message if no fields found with correct first longitude in it if (gotGrid.eq.0) then - print*,'***ERROR: input file needs to contain GRiB1 formatted'// & - 'messages' + print*,'***ERROR: input file needs to contain GRIB1 formatted messages' error stop endif @@ -733,23 +777,22 @@ subroutine gridcheck_ecmwf nwz =iwmax if(nuvz.eq.nlev_ec) nwz=nlev_ec+1 - ! if (nuvz+1.gt.nuvzmax) then - ! write(*,*) 'FLEXPART error: Too many u,v grid points in z '// & - ! 'direction.' - ! write(*,*) 'Reduce resolution of wind fields.' - ! write(*,*) 'Or change parameter settings in file par_mod.' - ! write(*,*) nuvz+1,nuvzmax - ! stop - ! endif - - ! if (nwz.gt.nwzmax) then - ! write(*,*) 'FLEXPART error: Too many w grid points in z '// & - ! 'direction.' - ! write(*,*) 'Reduce resolution of wind fields.' - ! write(*,*) 'Or change parameter settings in file par_mod.' - ! write(*,*) nwz,nwzmax - ! stop - ! endif + if (nuvz+1 .gt. nuvzmax) then + write(*,*) 'FLEXPART error: Too many u,v grid points in z direction.' + write(*,*) 'Reduce resolution of wind fields.' + write(*,*) 'Or change parameter settings in file par_mod.f90' + write(*,*) nuvz+1,nuvzmax + stop + endif + + if (nwz .gt. nwzmax) then + write(*,*) 'FLEXPART error: Too many w grid points in z direction.' + write(*,*) 'Reduce resolution of wind fields.' + write(*,*) 'Or change parameter settings in file par_mod.f90' + write(*,*) nwz,nwzmax + error stop + endif + ! If desired, shift all grids by nxshift grid cells !************************************************** @@ -762,56 +805,40 @@ subroutine gridcheck_ecmwf ! Output of grid info !******************** + write(*,'(a,2i7)') ' Vertical levels in ECMWF data: ', nuvz+1,nwz + write(*,*) + write(*,'(a)') ' Mother domain:' + write(*,'(a,f10.5,a,f10.5,a,f10.5)') ' Longitude range: ', & + xlon0,' to ',xlon0+(nx-1)*dx,' Grid distance: ',dx + write(*,'(a,f10.5,a,f10.5,a,f10.5)') ' Latitude range : ', & + ylat0,' to ',ylat0+(ny-1)*dy,' Grid distance: ',dy + write(*,*) - if (lroot) then - write(*,'(a,2i7)') ' Vertical levels in ECMWF data: ', & - nuvz+1,nwz - write(*,*) - write(*,'(a)') ' Mother domain:' - write(*,'(a,f10.5,a,f10.5,a,f10.5)') ' Longitude range: ', & - xlon0,' to ',xlon0+(nx-1)*dx,' Grid distance: ',dx - write(*,'(a,f10.5,a,f10.5,a,f10.5)') ' Latitude range : ', & - ylat0,' to ',ylat0+(ny-1)*dy,' Grid distance: ',dy - write(*,*) - end if - - ! CALCULATE VERTICAL DISCRETIZATION OF ECMWF MODEL - ! PARAMETER akm,bkm DESCRIBE THE HYBRID "ETA" COORDINATE SYSTEM + ! Calculate vertical discretization of ECMWF model + ! Parameters akm,bkm describe the hybrid "ETA" coordinate system numskip=nlev_ec-nuvz ! number of ecmwf model layers not used - ! by trajectory model - !do 8940 i=1,244 - ! write (*,*) 'zsec2:',i,ifield,zsec2(i),numskip - !940 continue - ! stop - ! SEC SEC SEC - ! for unknown reason zsec 1 to 10 is filled in this version - ! compared to the old one - ! SEC SEC SE + akm=0 bkm=0 akz=0 bkz=0 - do i=1,nwz ! LB: should start counting fom 0 to get the top level? - j=numskip+i - k=nlev_ec+1+numskip+i - akm(nwz-i+1)=zsec2(j) + do i=1,nwz ! LB: should start counting from 0 to get the top level? + akm(nwz-i+1)=zsec2(numskip+i) ! write (*,*) 'ifield:',ifield,k,j,zsec2(10+j) - bkm(nwz-i+1)=zsec2(k) + bkm(nwz-i+1)=zsec2(nlev_ec+1+numskip+i) wheight(nwz-i+1)=akm(nwz-i+1)/101325.+bkm(nwz-i+1) ! From FLEXTRA end do - ! - ! CALCULATION OF AKZ, BKZ - ! AKZ,BKZ: model discretization parameters at the center of each model - ! layer + ! Calculation of AKZ, BKZ + ! AKZ,BKZ: model discretization parameters at the center of each model layer ! ! Assign the 10 m winds to an artificial model level with akz=0 and bkz=1.0, ! i.e. ground level !***************************************************************************** akz(1)=0. - bkz(1)=1.0 + bkz(1)=1. uvheight(1)=1. do i=1,nuvz uvheight(i+1)=0.5*(wheight(i+1)+wheight(i)) ! From FLEXTRA @@ -837,38 +864,14 @@ subroutine gridcheck_ecmwf end do deallocate( zsec2 ) - ! Switch on following lines to use doubled vertical resolution - !************************************************************* - !nz=nuvz+nwz-1 - !if (nz.gt.nzmax) stop 'nzmax too small' - !do 100 i=1,nwz - ! aknew(2*(i-1)+1)=akm(i) - !00 bknew(2*(i-1)+1)=bkm(i) - !do 110 i=2,nuvz - ! aknew(2*(i-1))=akz(i) - !10 bknew(2*(i-1))=bkz(i) - ! End doubled vertical resolution return 999 write(*,*) - write(*,*) ' ###########################################'// & - '###### ' - write(*,*) ' TRAJECTORY MODEL SUBROUTINE GRIDCHECK:' + write(*,*) ' ################################################# ' + write(*,*) ' SUBROUTINE GRIDCHECK:' write(*,*) ' CAN NOT OPEN INPUT DATA FILE '//wfname(ifn) - write(*,*) ' ###########################################'// & - '###### ' - write(*,*) - write(*,'(a)') '!!! PLEASE INSERT A NEW CD-ROM AND !!!' - write(*,'(a)') '!!! PRESS ANY KEY TO CONTINUE... !!!' - write(*,'(a)') '!!! ...OR TERMINATE FLEXPART PRESSING!!!' - write(*,'(a)') '!!! THE "X" KEY... !!!' - write(*,*) - read(*,'(a)') opt - if(opt.eq.'X') then - error stop - else - goto 5 - endif + write(*,*) ' ################################################# ' + end subroutine gridcheck_ecmwf subroutine gridcheck_gfs @@ -894,6 +897,10 @@ subroutine gridcheck_gfs ! Marian Harustak, 12.5.2017 * ! - Renamed routine from gridcheck to gridcheck_gfs * ! * + ! * + ! Anne Tipka, Petra Seibert 2021-02: implement new interpolation * + ! for precipitation according to #295 using 2 additional fields * + ! * !********************************************************************** ! * ! DESCRIPTION: * @@ -928,6 +935,7 @@ subroutine gridcheck_gfs use grib_api use cmapf_mod, only: stlmbr,stcm2p + implicit none !HSO parameters for grib_api @@ -936,10 +944,11 @@ subroutine gridcheck_gfs integer :: igrib,stat,size1 real(kind=4) :: xaux1,xaux2,yaux1,yaux2 real(kind=8) :: xaux1in,xaux2in,yaux1in,yaux2in - integer :: gribVer,parCat,parNum,typSurf,valSurf,discipl + integer :: gribVer,parCat,parNum,typSfc,valSurf,discipl !HSO end integer :: ix,jy,i,ifn,ifield,j,k,iumax,iwmax,numskip real :: sizesouth,sizenorth,xauxa + real :: xsec18 !ip real,allocatable,dimension(:) :: akm_usort,pres,tmppres real,parameter :: eps=0.0001 @@ -957,7 +966,13 @@ subroutine gridcheck_gfs !HSO grib api error messages character(len=24) :: gribErrorMsg = 'Error reading grib file' character(len=20) :: gribFunction = 'gridcheckwind_gfs' - ! + +! real(kind=4),allocatable,dimension(:) :: zsec4 +! integer :: iret,size1,size2,stat + + + +! if (numbnests.ge.1) then write(*,*) ' ###########################################' write(*,*) ' FLEXPART ERROR SUBROUTINE GRIDCHECK:' @@ -1012,6 +1027,8 @@ subroutine gridcheck_gfs call grib_get_int(igrib,'level',isec1(8),iret) call grib_check(iret,gribFunction,gribErrorMsg) + xsec18 = real(isec1(8)) + else ! GRIB Edition 2 !read the grib2 identifiers @@ -1021,7 +1038,7 @@ subroutine gridcheck_gfs call grib_check(iret,gribFunction,gribErrorMsg) call grib_get_int(igrib,'parameterNumber',parNum,iret) call grib_check(iret,gribFunction,gribErrorMsg) - call grib_get_int(igrib,'typeOfFirstFixedSurface',typSurf,iret) + call grib_get_int(igrib,'typeOfFirstFixedSurface',typSfc,iret) call grib_check(iret,gribFunction,gribErrorMsg) call grib_get_int(igrib,'scaledValueOfFirstFixedSurface', & valSurf,iret) @@ -1031,19 +1048,36 @@ subroutine gridcheck_gfs isec1(6)=-1 isec1(7)=-1 isec1(8)=-1 - if ((parCat.eq.2).and.(parNum.eq.2).and.(typSurf.eq.100)) then ! U + xsec18 = -1.0 + + if ((parCat.eq.2).and.(parNum.eq.2).and.(typSfc.eq.100)) then ! U isec1(6)=33 ! indicatorOfParameter isec1(7)=100 ! indicatorOfTypeOfLevel isec1(8)=valSurf/100 ! level, convert to hPa - elseif ((parCat.eq.3).and.(parNum.eq.5).and.(typSurf.eq.1)) then ! TOPO + xsec18=valSurf/100.0 ! level, convert to hPa + + ! fixgfs11 + call grib_get_size(igrib,'values',size1,iret) + allocate( zsec4(size1),stat=stat ) + if (stat.ne.0) error stop "Could not allocate zsec4" + call grib_get_real4_array(igrib,'values',zsec4,iret) + call grib_check(iret,gribFunction,gribErrorMsg) + !PRINT*,zsec4(1:15) + !stop 'MIP2 in gridcheck' + deallocate(zsec4) + + elseif ((parCat.eq.3).and.(parNum.eq.5).and.(typSfc.eq.1)) then ! TOPO isec1(6)=7 ! indicatorOfParameter isec1(7)=1 ! indicatorOfTypeOfLevel isec1(8)=0 - elseif ((parCat.eq.0).and.(parNum.eq.0).and.(typSurf.eq.1) & + xsec18=real(0) + + elseif ((parCat.eq.0).and.(parNum.eq.0).and.(typSfc.eq.1) & .and.(discipl.eq.2)) then ! LSM isec1(6)=81 ! indicatorOfParameter isec1(7)=1 ! indicatorOfTypeOfLevel isec1(8)=0 + xsec18=real(0) endif endif ! gribVer @@ -1071,6 +1105,8 @@ subroutine gridcheck_gfs yaux2in,iret) call grib_check(iret,gribFunction,gribErrorMsg) + + ! Fix for flexpart.eu ticket #48 if (xaux2in.lt.0) xaux2in = 359.0 @@ -1082,9 +1118,15 @@ subroutine gridcheck_gfs nxfield=isec2(2) ny=isec2(3) if((abs(xaux1).lt.eps).and.(xaux2.ge.359)) then ! NCEP DATA FROM 0 TO - xaux1=-179.0 ! 359 DEG EAST -> - xaux2=-179.0+360.-360./real(nxfield) ! TRANSFORMED TO -179 + + ! fixgfs11 + ! xaux1=-179.0 ! 359 DEG EAST -> + ! xaux2=-179.0+360.-360./real(nxfield) ! TRANSFORMED TO -179 + ! reset to working v10 settings + xaux1=-180.0 ! 359 DEG EAST -> + xaux2=-180.0+360.-360./real(nxfield) ! TRANSFORMED TO -179 endif ! TO 180 DEG EAST + if (xaux1.gt.180) xaux1=xaux1-360.0 if (xaux2.gt.180) xaux2=xaux2-360.0 if (xaux1.lt.-180) xaux1=xaux1+360.0 @@ -1174,14 +1216,17 @@ subroutine gridcheck_gfs if((isec1(6).eq.33).and.(isec1(7).eq.100)) then ! check for U wind iumax=iumax+1 + ! fixgfs11 allocate( tmppres(iumax), stat=stat) if (stat.ne.0) error stop "Could not allocate tmppres" - if (iumax.gt.1) tmppres(1:iumax)=pres - pres(iumax)=real(isec1(8))*100.0 + if (iumax.gt.1) tmppres(1:iumax-1)=pres + !pres(iumax)=real(isec1(8))*100.0 call move_alloc(tmppres,pres) + pres(iumax)=xsec18*100.0 + ! ip 30.1.24 fix vertical coordinate reading bug endif - + ! fixgfs11 TODO: finish cleanup i179=nint(179./dx) if (dx.lt.0.7) then i180=nint(180./dx)+1 ! 0.5 deg data @@ -1190,13 +1235,16 @@ subroutine gridcheck_gfs endif i181=i180+1 + ! fixgfs11 -- revert to working v10.4 setting + i180=nint(180./dx) ! 0.5 deg data + i181=i180 + i179=i180 ! NCEP TERRAIN !************* if((isec1(6).eq.007).and.(isec1(7).eq.001)) then - ! IP 8/5/23 allocate fields missing for GFS reading - call alloc_fixedfields + ! IP 8/5/23 do jy=0,ny-1 do ix=0,nxfield-1 @@ -1229,7 +1277,7 @@ subroutine gridcheck_gfs endif call grib_release(igrib) - deallocate( zsec4 ) + if (isec1(6).ne.-1) deallocate( zsec4 ) !IP 28/11/23 fix to run GFS tests end do !! READ NEXT LEVEL OR PARAMETER ! ! CLOSING OF INPUT DATA FILE @@ -1242,12 +1290,14 @@ subroutine gridcheck_gfs nuvz=iumax nwz =iumax nlev_ec=iumax - + ! Allocate memory for windfields !******************************* nwzmax=nwz nuvzmax=nuvz nzmax=nuvz + nconvlevmax=iumax + na=nuvzmax call alloc_windfields if (nx.gt.nxmax) then @@ -1349,6 +1399,7 @@ subroutine gridcheck_gfs bkz(i)=bkm(i) end do + ! NOTE: In FLEXPART versions up to 4.0, the number of model levels was doubled ! upon the transformation to z levels. In order to save computer memory, this is ! not done anymore in the standard version. However, this option can still be @@ -1412,24 +1463,31 @@ subroutine gridcheck_nest ! * ! 8 February 1999 * ! * + ! * + ! Anne Tipka, Petra Seibert 2021-02: implement new interpolation * + ! for precipitation according to #295 using 2 additional fields * + ! * !***************************************************************************** ! CHANGE: 11/01/2008, Harald Sodemann, GRIB1/2 input with ECMWF grib_api * ! CHANGE: 03/12/2008, Harald Sodemann, change to f90 grib_api * + ! Petra Seibert, Anne Tipka, 2021-02: implement new interpolation * + ! for precipitation according to #295 using 2 additional fields * !***************************************************************************** use grib_api implicit none - !HSO parameters for grib_api integer :: ifile integer :: iret - integer :: igrib,stat,size1,size2 - integer :: gribVer,parCat,parNum,typSurf,valSurf,discipl + + integer :: igrib,size1,size2,stat + integer :: istep, ipf, npf ! istep=stepRange for precip field identification + integer :: gribVer,parCat,parNum,typSfc,discipl integer :: parID !added by mc for making it consistent with new gridcheck.f90 integer :: gotGrib - !HSO end - integer :: i,j,k,l,ifn,ifield,iumax,iwmax,numskip,nlev_ecn + + integer :: i,j,l,ifn,ifield,iumax,iwmax,numskip,nlev_ecn integer :: nuvzn,nwzn real :: akmn(nwzmax),bkmn(nwzmax),akzn(nuvzmax),bkzn(nuvzmax) real(kind=4) :: xaux1,xaux2,yaux1,yaux2 @@ -1437,18 +1495,15 @@ subroutine gridcheck_nest ! VARIABLES AND ARRAYS NEEDED FOR GRIB DECODING - ! dimension of isec2 at least (22+n), where n is the number of parallels or - ! meridians in a quasi-regular (reduced) Gaussian or lat/long grid - - ! dimension of zsec2 at least (10+nn), where nn is the number of vertical - ! coordinate parameters - - integer :: isec1(56),isec2(3) !(22+nxmaxn+nymaxn) real(kind=4),allocatable,dimension(:) :: zsec2,zsec4 + ! PS replace isec1, isec2 arrays by scalar values because we don't need + ! arrays anymore. isec1(X) -> isX, isec2(X) -> jsX + integer :: is6, js2, js3, js12 + integer :: k ! (as k, is the level in ECWMF notation, top->bot) !HSO grib api error messages character(len=24) :: gribErrorMsg = 'Error reading grib file' - character(len=20) :: gribFunction = 'gridcheck_nest' + character(len=20) :: thisSubr = 'gridcheck_nest' xresoln(0)=1. ! resolution enhancement for mother grid yresoln(0)=1. ! resolution enhancement for mother grid @@ -1475,9 +1530,7 @@ subroutine gridcheck_nest call grib_open_file(ifile,path(numpath+2*(l-1)+1) & (1:length(numpath+2*(l-1)+1))//trim(wfnamen(l,ifn)),'r',iret) - if (iret.ne.GRIB_SUCCESS) then - goto 999 ! ERROR DETECTED - endif + if (iret .ne. GRIB_SUCCESS) goto 999 ! ERROR DETECTED !turn on support for multi fields messages !call grib_multi_support_on @@ -1486,201 +1539,182 @@ subroutine gridcheck_nest do ifield=ifield+1 - ! - ! GET NEXT FIELDS - ! + ! reading messages from GRIB file + !-------------------------------- + call grib_new_from_file(ifile,igrib,iret) if (iret.eq.GRIB_END_OF_FILE) then exit ! EOF DETECTED elseif (iret.ne.GRIB_SUCCESS) then goto 999 ! ERROR DETECTED endif + !turn on support for multi fields messages + !call grib_multi_support_on - !first see if we read GRIB1 or GRIB2 + !first see whether we read GRIB1 or GRIB2 call grib_get_int(igrib,'editionNumber',gribVer,iret) - call grib_check(iret,gribFunction,gribErrorMsg) - - if (gribVer.eq.1) then ! GRIB Edition 1 + call grib_check(iret,thisSubr,gribErrorMsg) - !print*,'GRiB Edition 1' - !read the grib2 identifiers - call grib_get_int(igrib,'indicatorOfParameter',isec1(6),iret) - call grib_check(iret,gribFunction,gribErrorMsg) - call grib_get_int(igrib,'level',isec1(8),iret) - call grib_check(iret,gribFunction,gribErrorMsg) + if (gribVer .eq. 1) then ! GRIB Edition 1 + + call grib_get_int(igrib,'indicatorOfParameter',is6,iret) + call grib_check(iret,thisSubr,gribErrorMsg) + + call grib_get_int(igrib,'level',k,iret) + call grib_check(iret,thisSubr,gribErrorMsg) !change code for etadot to code for omega - if (isec1(6).eq.77) then - isec1(6)=135 - endif - - !print*,isec1(6),isec1(8) + if (is6 .eq. 77) is6=135 - else + else ! GRiB Edition 2 - !print*,'GRiB Edition 2' - !read the grib2 identifiers call grib_get_int(igrib,'discipline',discipl,iret) - call grib_check(iret,gribFunction,gribErrorMsg) + call grib_check(iret,thisSubr,gribErrorMsg) + call grib_get_int(igrib,'parameterCategory',parCat,iret) - call grib_check(iret,gribFunction,gribErrorMsg) + call grib_check(iret,thisSubr,gribErrorMsg) + call grib_get_int(igrib,'parameterNumber',parNum,iret) - call grib_check(iret,gribFunction,gribErrorMsg) - call grib_get_int(igrib,'typeOfFirstFixedSurface',typSurf,iret) - call grib_check(iret,gribFunction,gribErrorMsg) - call grib_get_int(igrib,'level',valSurf,iret) - call grib_check(iret,gribFunction,gribErrorMsg) - call grib_get_int(igrib,'paramId',parId,iret) !added by mc to make it consisitent with new grid_check.f90 - call grib_check(iret,gribFunction,gribErrorMsg) !added by mc to make it consisitent with new grid_check.f90 - - !print*,discipl,parCat,parNum,typSurf,valSurf + call grib_check(iret,thisSubr,gribErrorMsg) + + call grib_get_int(igrib,'typeOfFirstFixedSurface',typSfc,iret) + call grib_check(iret,thisSubr,gribErrorMsg) + + call grib_get_int(igrib,'level',k,iret) + call grib_check(iret,thisSubr,gribErrorMsg) + + call grib_get_int(igrib,'paramId',parId,iret) + call grib_check(iret,thisSubr,gribErrorMsg) !convert to grib1 identifiers - isec1(6)=-1 - isec1(7)=-1 - isec1(8)=-1 - isec1(8)=valSurf ! level - if ((parCat.eq.0).and.(parNum.eq.0).and.(typSurf.eq.105)) then ! T - isec1(6)=130 ! indicatorOfParameter - elseif ((parCat.eq.2).and.(parNum.eq.2).and.(typSurf.eq.105)) then ! U - isec1(6)=131 ! indicatorOfParameter - elseif ((parCat.eq.2).and.(parNum.eq.3).and.(typSurf.eq.105)) then ! V - isec1(6)=132 ! indicatorOfParameter - elseif ((parCat.eq.1).and.(parNum.eq.0).and.(typSurf.eq.105)) then ! Q - isec1(6)=133 ! indicatorOfParameter - elseif ((parCat.eq.1).and.(parNum.eq.83).and.(typSurf.eq.105)) then ! clwc - isec1(6)=246 ! indicatorOfParameter - elseif ((parCat.eq.1).and.(parNum.eq.84).and.(typSurf.eq.105)) then ! ciwc - isec1(6)=247 ! indicatorOfParameter - !ZHG end - ! ESO qc(=clwc+ciwc) - elseif ((parCat.eq.201).and.(parNum.eq.31).and.(typSurf.eq.105)) then ! qc - isec1(6)=201031 ! indicatorOfParameter - elseif ((parCat.eq.3).and.(parNum.eq.0).and.(typSurf.eq.1)) then !SP - isec1(6)=134 ! indicatorOfParameter - elseif ((parCat.eq.2).and.(parNum.eq.32)) then ! W, actually eta dot - isec1(6)=135 ! indicatorOfParameter - elseif ((parCat.eq.128).and.(parNum.eq.77)) then ! W, actually eta dot !added bymc to make it consistent with new gridcheck.f90 - isec1(6)=135 ! indicatorOfParameter ! - elseif ((parCat.eq.3).and.(parNum.eq.0).and.(typSurf.eq.101)) then !SLP - isec1(6)=151 ! indicatorOfParameter - elseif ((parCat.eq.2).and.(parNum.eq.2).and.(typSurf.eq.103)) then ! 10U - isec1(6)=165 ! indicatorOfParameter - elseif ((parCat.eq.2).and.(parNum.eq.3).and.(typSurf.eq.103)) then ! 10V - isec1(6)=166 ! indicatorOfParameter - elseif ((parCat.eq.0).and.(parNum.eq.0).and.(typSurf.eq.103)) then ! 2T - isec1(6)=167 ! indicatorOfParameter - elseif ((parCat.eq.0).and.(parNum.eq.6).and.(typSurf.eq.103)) then ! 2D - isec1(6)=168 ! indicatorOfParameter - elseif ((parCat.eq.1).and.(parNum.eq.11).and.(typSurf.eq.1)) then ! SD - isec1(6)=141 ! indicatorOfParameter - elseif ((parCat.eq.6).and.(parNum.eq.1) .or. parId .eq. 164) then ! CC !added by mc to make it consistent with new gridchek.f90 - isec1(6)=164 ! indicatorOfParameter - elseif ((parCat.eq.1).and.(parNum.eq.9) .or. parId .eq. 142) then ! LSP !added by mc to make it consistent with new gridchek.f90 - isec1(6)=142 ! indicatorOfParameter - elseif ((parCat.eq.1).and.(parNum.eq.10)) then ! CP - isec1(6)=143 ! indicatorOfParameter - elseif ((parCat.eq.0).and.(parNum.eq.11).and.(typSurf.eq.1)) then ! SHF - isec1(6)=146 ! indicatorOfParameter - elseif ((parCat.eq.4).and.(parNum.eq.9).and.(typSurf.eq.1)) then ! SR - isec1(6)=176 ! indicatorOfParameter - elseif ((parCat.eq.2).and.(parNum.eq.17) .or. parId .eq. 180) then ! EWSS !added by mc to make it consistent with new gridchek.f90 - isec1(6)=180 ! indicatorOfParameter - elseif ((parCat.eq.2).and.(parNum.eq.18) .or. parId .eq. 181) then ! NSSS !added by mc to make it consistent with new gridchek.f90 - isec1(6)=181 ! indicatorOfParameter - elseif ((parCat.eq.3).and.(parNum.eq.4)) then ! ORO - isec1(6)=129 ! indicatorOfParameter - elseif ((parCat.eq.3).and.(parNum.eq.7) .or. parId .eq. 160) then ! SDO !added by mc to make it consistent with new gridchek.f90 - isec1(6)=160 ! indicatorOfParameter - elseif ((discipl.eq.2).and.(parCat.eq.0).and.(parNum.eq.0).and. & - (typSurf.eq.1)) then ! LSM - isec1(6)=172 ! indicatorOfParameter + is6=-1 + if (parCat .eq. 0 .and. parNum .eq. 0 .and. typSfc .eq. 105) then ! T + is6=130 + elseif (parCat .eq. 2 .and. parNum .eq. 2 .and. typSfc .eq. 105) then ! U + is6=131 + elseif (parCat .eq. 2 .and. parNum .eq. 3 .and. typSfc .eq. 105) then ! V + is6=132 + elseif (parCat .eq. 1 .and. parNum .eq. 0 .and. typSfc .eq. 105) then ! Q + is6=133 + ! ESO Cloud water is in a) fields CLWC and CIWC, *or* b) field QC + elseif (parCat .eq. 1 .and. parNum .eq. 83 .and. typSfc .eq. 105) then ! clwc + is6=246 + elseif (parCat .eq. 1 .and. parNum .eq. 84 .and. typSfc .eq. 105) then ! ciwc + is6=247 + ! ESO qc(=clwc+ciwc): + elseif (parCat .eq. 201 .and. parNum .eq. 31 .and. typSfc .eq. 105) then ! qc + is6=201031 + elseif (parCat .eq. 3 .and. parNum .eq. 0 .and. typSfc .eq. 1) then !SP + is6=134 + elseif (parCat .eq. 2 .and. parNum .eq. 32) then ! W, actually eta dot + is6=135 + elseif (parCat .eq. 128 .and. parNum .eq. 77) then ! W, actually eta dot + is6=135 + elseif (parCat .eq. 3 .and. parNum .eq. 0 .and. typSfc .eq. 101) then ! SLP + is6=151 + elseif (parCat .eq. 2 .and. parNum .eq. 2 .and. typSfc .eq. 103) then ! 10U + is6=165 + elseif (parCat .eq. 2 .and. parNum .eq. 3 .and. typSfc .eq. 103) then ! 10V + is6=166 + elseif (parCat .eq. 0 .and. parNum .eq. 0 .and. typSfc .eq. 103) then ! 2T + is6=167 + elseif (parCat .eq. 0 .and. parNum .eq. 6 .and. typSfc .eq. 103) then ! 2D + is6=168 + elseif (parCat .eq. 1 .and. parNum .eq. 11 .and. typSfc .eq. 1) then ! SD + is6=141 + elseif (parCat .eq. 6 .and. parNum .eq. 1 .or. parId .eq. 164) then ! CC + is6=164 + elseif (parCat .eq. 1 .and. parNum .eq. 9 .or. parId .eq. 142) then ! LSP + is6=142 + elseif (parCat .eq. 1 .and. parNum .eq. 10) then ! CP + is6=143 + elseif (parCat .eq. 0 .and. parNum .eq. 11 .and. typSfc .eq. 1) then ! SHF + is6=146 + elseif (parCat .eq. 4 .and. parNum .eq. 9 .and. typSfc .eq. 1) then ! SR + is6=176 + elseif (parCat .eq. 2 .and. parNum .eq. 38 .or. parId .eq. 180) then ! EWSS --correct + is6=180 + elseif (parCat .eq. 2 .and. parNum .eq. 37 .or. parId .eq. 181) then ! NSSS --correct + is6=181 + elseif (parCat .eq. 3 .and. parNum .eq. 4) then ! ORO + is6=129 + elseif (parCat .eq. 3 .and. parNum .eq. 7 .or. parId .eq. 160) then ! SDO + is6=160 + elseif (discipl .eq. 2 .and. parCat .eq. 0 .and. parNum .eq. 0 .and. & + typSfc .eq. 1) then ! LSM + is6=172 + elseif (parNum .eq. 152) then + is6=152 ! avoid warning for lnsp else - print*,'***ERROR: undefined GRiB2 message found!',discipl, & - parCat,parNum,typSurf - endif - if(parId .ne. isec1(6) .and. parId .ne. 77) then !added by mc to make it consistent with new gridchek.f90 - write(*,*) 'parId',parId, 'isec1(6)',isec1(6) - ! stop + print*,'***WARNING: undefined GRiB2 message found!',discipl, & + parCat,parNum,typSfc endif - - endif + if (parId .ne. is6 .and. parId .ne. 77) write(*,*) 'parId',parId, 'is6',is6 + endif !gribVer !HSO get the required fields from section 2 in a gribex compatible manner if (ifield.eq.1) then - call grib_get_int(igrib,'numberOfPointsAlongAParallel', & - isec2(1),iret) - call grib_check(iret,gribFunction,gribErrorMsg) - call grib_get_int(igrib,'numberOfPointsAlongAMeridian', & - isec2(2),iret) - call grib_check(iret,gribFunction,gribErrorMsg) - call grib_get_int(igrib,'numberOfVerticalCoordinateValues', & - isec2(3),iret) - call grib_check(iret,gribFunction,gribErrorMsg) - - nxn(l)=isec2(1) - nyn(l)=isec2(2) - nlev_ecn=isec2(3)/2-1 + call grib_get_int(igrib,'numberOfPointsAlongAParallel',js2,iret) + call grib_check(iret,thisSubr,gribErrorMsg) + + call grib_get_int(igrib,'numberOfPointsAlongAMeridian',js3,iret) + call grib_check(iret,thisSubr,gribErrorMsg) + + call grib_get_int(igrib,'numberOfVerticalCoordinateValues',js12) + call grib_check(iret,thisSubr,gribErrorMsg) + + call grib_get_real8(igrib,'longitudeOfFirstGridPointInDegrees',xaux1in,iret) + call grib_check(iret,thisSubr,gribErrorMsg) + + nxn(l)=js2 + nyn(l)=js3 + nlev_ecn=js12/2-1 if (nxn(l).gt.nxmaxn) nxmaxn=nxn(l) if (nyn(l).gt.nymaxn) nymaxn=nyn(l) call grib_get_size(igrib,'pv',size2,iret) - call grib_check(iret,gribFunction,gribErrorMsg) + call grib_check(iret,thisSubr,gribErrorMsg) allocate(zsec2(size2), stat=stat) if (stat.ne.0) error stop "Could not allocate zsec2" !HSO get the size and data of the vertical coordinate array call grib_get_real4_array(igrib,'pv',zsec2,iret) - call grib_check(iret,gribFunction,gribErrorMsg) + call grib_check(iret,thisSubr,gribErrorMsg) call alloc_fixedfields_nest write(*,*) 'Dimensions nest:',nxmaxn,nymaxn,nlev_ecn - endif ! ifield + endif ! ifield eq 1 !get the size and data of the values array - if (isec1(6).ne.-1) then + if (is6.ne.-1) then call grib_get_size(igrib,'values',size1,iret) - call grib_check(iret,gribFunction,gribErrorMsg) + call grib_check(iret,thisSubr,gribErrorMsg) allocate(zsec4(size1), stat=stat) if (stat.ne.0) error stop "Could not allocate zsec4" call grib_get_real4_array(igrib,'values',zsec4,iret) - call grib_check(iret,gribFunction,gribErrorMsg) - endif - - if (nxn(l).gt.nxmaxn) then - write(*,*) 'FLEXPART error: Too many grid points in x direction.' - write(*,*) 'Reduce resolution of wind fields (file GRIDSPEC)' - write(*,*) 'for nesting level ',l - write(*,*) 'Or change parameter settings in file par_mod.' - write(*,*) nxn(l),nxmaxn - error stop - endif - - if (nyn(l).gt.nymaxn) then - write(*,*) 'FLEXPART error: Too many grid points in y direction.' - write(*,*) 'Reduce resolution of wind fields (file GRIDSPEC)' - write(*,*) 'for nesting level ',l - write(*,*) 'Or change parameter settings in file par_mod.' - write(*,*) nyn(l),nymaxn - error stop + call grib_check(iret,thisSubr,gribErrorMsg) endif !HSO get the second part of the grid dimensions only from GRiB1 messages - if (isec1(6) .eq. 167 .and. (gotGrib.eq.0)) then !added by mc to make it consistent with new gridchek.f90 note that gotGrid must be changed in gotGrib!! + if (is6 .eq. 167 .and. gotGrib .eq. 0) then !added by mc to make it consistent with new gridchek.f90 note that gotGrid must be changed in gotGrib!! + call grib_get_real8(igrib,'longitudeOfFirstGridPointInDegrees', & !comment by mc: note that this was in the (if (ifield.eq.1) ..end above in gridchek.f90 see line 257 xaux1in,iret) - call grib_check(iret,gribFunction,gribErrorMsg) + call grib_check(iret,thisSubr,gribErrorMsg) + call grib_get_real8(igrib,'longitudeOfLastGridPointInDegrees', & xaux2in,iret) - call grib_check(iret,gribFunction,gribErrorMsg) + call grib_check(iret,thisSubr,gribErrorMsg) + call grib_get_real8(igrib,'latitudeOfLastGridPointInDegrees', & - yaux1in,iret) - call grib_check(iret,gribFunction,gribErrorMsg) + yaux1in,iret) + call grib_check(iret,thisSubr,gribErrorMsg) + call grib_get_real8(igrib,'latitudeOfFirstGridPointInDegrees', & - yaux2in,iret) - call grib_check(iret,gribFunction,gribErrorMsg) + yaux2in,iret) + call grib_check(iret,thisSubr,gribErrorMsg) xaux1=real(xaux1in) xaux2=real(xaux2in) yaux1=real(yaux1in) @@ -1694,42 +1728,40 @@ subroutine gridcheck_nest ylat0n(l)=yaux1 dxn(l)=(xaux2-xaux1)/real(nxn(l)-1) dyn(l)=(yaux2-yaux1)/real(nyn(l)-1) - gotGrib=1 !commetn by mc note tahthere gotGRIB is used instead of gotGrid!!! - endif ! ifield.eq.1 + gotGrib=1 !comment by mc gotGRIB is used instead of gotGrid!!! + endif - k=isec1(8) - if(isec1(6).eq.131) iumax=max(iumax,nlev_ec-k+1) - if(isec1(6).eq.135) iwmax=max(iwmax,nlev_ec-k+1) + if(is6.eq.131) iumax=max(iumax,nlev_ec-k+1) + if(is6.eq.135) iwmax=max(iwmax,nlev_ec-k+1) - if(isec1(6).eq.129) then + if(is6.eq.129) then do j=0,nyn(l)-1 do i=0,nxn(l)-1 oron(i,j,l)=zsec4(nxn(l)*(nyn(l)-j-1)+i+1)/ga - end do - end do + enddo + enddo endif - if(isec1(6).eq.172) then + if(is6.eq.172) then do j=0,nyn(l)-1 do i=0,nxn(l)-1 lsmn(i,j,l)=zsec4(nxn(l)*(nyn(l)-j-1)+i+1)/ga - end do - end do + enddo + enddo endif - if(isec1(6).eq.160) then + if(is6.eq.160) then do j=0,nyn(l)-1 do i=0,nxn(l)-1 excessoron(i,j,l)=zsec4(nxn(l)*(nyn(l)-j-1)+i+1)/ga - end do - end do + enddo + enddo endif call grib_release(igrib) - deallocate( zsec4 ) + if (is6.ne.-1) deallocate( zsec4 ) end do !! READ NEXT LEVEL OR PARAMETER ! ! CLOSING OF INPUT DATA FILE ! - call grib_close_file(ifile) !error message if no fields found with correct first longitude in it @@ -1801,10 +1833,8 @@ subroutine gridcheck_nest numskip=nlev_ecn-nuvzn ! number of ecmwf model layers not used by FLEXPART do i=1,nwzn - j=numskip+i - k=nlev_ecn+1+numskip+i - akmn(nwzn-i+1)=zsec2(j) - bkmn(nwzn-i+1)=zsec2(k) + akmn(nwzn-i+1)=zsec2(numskip+i) + bkmn(nwzn-i+1)=zsec2(nlev_ecn+1+numskip+i) end do ! @@ -1817,7 +1847,7 @@ subroutine gridcheck_nest !***************************************************************************** akzn(1)=0. - bkzn(1)=1.0 + bkzn(1)=1. do i=1,nuvzn akzn(i+1)=0.5*(akmn(i+1)+akmn(i)) bkzn(i+1)=0.5*(bkmn(i+1)+bkmn(i)) @@ -1889,15 +1919,19 @@ subroutine readwind_ecmwf(indj,n,uuh,vvh,wwh) ! CHANGE: 03/12/2008, Harald Sodemann, update to f90 with * ! ECMWF grib_api * ! * - !********************************************************************** - ! Changes, Bernd C. Krueger, Feb. 2001: - ! Variables tth and qvh (on eta coordinates) in common block - ! - ! Unified ECMWF and GFS builds - ! Marian Harustak, 12.5.2017 - ! - Renamed from readwind to readwind_ecmwf - ! - ! L. Bakels, 2021: OpenMP parallelisation (following CTM version) + ! Changes, Bernd C. Krueger, Feb. 2001: * + ! Variables tth and qvh (on eta coordinates) in common block * + ! * + ! Unified ECMWF and GFS builds * + ! Marian Harustak, 12.5.2017 * + ! - Renamed from readwind to readwind_ecmwf * + ! * + ! L. Bakels, 2021: OpenMP parallelisation (following CTM version) * + ! * + ! Anne Tipka, Petra Seibert 2021-02: implement new interpolation * + ! for precipitation according to #295 using 2 additional fields * + ! change some double loops in wrong order to forall constructs * + ! * !********************************************************************** ! * ! DESCRIPTION: * @@ -1924,21 +1958,21 @@ subroutine readwind_ecmwf(indj,n,uuh,vvh,wwh) implicit none - ! include 'grib_api.h' - !HSO parameters for grib_api integer :: ifile integer :: iret, size1, stat integer, dimension(:), allocatable :: igrib integer :: nfield, ii, arsize - integer :: gribVer,parCat,parNum,typSurf,valSurf,discipl,parId + integer :: istep, ipf, npf ! istep=stepRange for precip field identification + integer :: gribVer,parCat,parNum,typSfc,discipl,parId integer :: gotGrid ! HSO end - real(kind=4) :: uuh(0:nxmax-1,0:nymax-1,nuvzmax) - real(kind=4) :: vvh(0:nxmax-1,0:nymax-1,nuvzmax) - real(kind=4) :: wwh(0:nxmax-1,0:nymax-1,nwzmax) - integer :: indj,i,j,k,n,levdiff2,iumax,iwmax!,ifield + real(kind=4), intent(inout) :: uuh(0:nxmax-1,0:nymax-1,nuvzmax) + real(kind=4), intent(inout) :: vvh(0:nxmax-1,0:nymax-1,nuvzmax) + real(kind=4), intent(inout) :: wwh(0:nxmax-1,0:nymax-1,nwzmax) + integer, intent(in) :: indj,n + integer :: i,j,ifield,iumax,iwmax ! VARIABLES AND ARRAYS NEEDED FOR GRIB DECODING @@ -1949,39 +1983,41 @@ subroutine readwind_ecmwf(indj,n,uuh,vvh,wwh) ! dimension of zsec2 at least (10+nn), where nn is the number of vertical ! coordinate parameters - integer :: isec1(56) - integer :: isec2(3) real(kind=4),allocatable,dimension(:) :: zsec4 + ! integer :: isec1(56),isec2(22+nxmax+nymax) + ! AT replace isec1, isec2 arrays by scalar values because we don't need + ! arrays anymore. isec1(X) -> isX, isec2(X) -> jsX + integer :: is6, js2, js3, js12 + integer :: k ! (as k, is the level in ECWMF notation, top->bot) + integer :: kz, kz1 ! (level in FLEXPART notation, bot->top) + integer :: jy ! y index in FLEXPART notation (S->N) + real(kind=4) :: xaux,yaux,xaux0,yaux0 real(kind=8) :: xauxin,yauxin real,parameter :: eps=1.e-4 real(kind=4) :: nsss(0:nxmax-1,0:nymax-1),ewss(0:nxmax-1,0:nymax-1) real :: plev1,pmean,tv,fu,hlev1,ff10m,fflev1,conversion_factor - logical :: hflswitch,strswitch!,readcloud + logical :: hflswitch,strswitch,lstep(0:2) !HSO grib api error messages character(len=24) :: gribErrorMsg = 'Error reading grib file' - character(len=20) :: gribFunction = 'readwind' + character(len=20) :: thisSubr = 'readwind_ecmwf' hflswitch=.false. strswitch=.false. - !ZHG test the grib fields that have lcwc without using them - ! readcloud=.false. - - levdiff2=nlev_ec-nwz+1 + iumax=0 iwmax=0 ! ! OPENING OF DATA FILE (GRIB CODE) ! - call grib_open_file(ifile,path(3)(1:length(3)) & - //trim(wfname(indj)),'r',iret) - if (iret.ne.GRIB_SUCCESS) then - goto 888 ! ERROR DETECTED - endif + call grib_open_file(ifile,path(3)(1:length(3))//trim(wfname(indj)),'r',iret) + if (iret .ne. GRIB_SUCCESS) goto 888 ! ERROR DETECTED + ! COUNT NUMBER OF MESSAGES IN FILE + ! call grib_count_in_file(ifile,nfield) ! allocate memory for grib handles @@ -1989,11 +2025,15 @@ subroutine readwind_ecmwf(indj,n,uuh,vvh,wwh) if (stat.ne.0) error stop "Could not allocate igrib" ! initialise igrib(:) = -1 - + + ! LOAD ALL MESSAGES FROM FILE + ! do ii = 1,nfield call grib_new_from_file(ifile, igrib(ii), iret) end do - + + ! CLOSE FILE + ! call grib_close_file(ifile) !turn on support for multi fields messages */ @@ -2002,14 +2042,15 @@ subroutine readwind_ecmwf(indj,n,uuh,vvh,wwh) gotGrid=0 !$OMP PARALLEL DEFAULT(none) & -!$OMP SHARED (nfield, igrib, gribFunction, nxfield, ny, nlev_ec, dx, xlon0, ylat0, & +!$OMP SHARED (nfield, igrib, thisSubr, nxfield, ny, nlev_ec, dx, xlon0, ylat0, & !$OMP n, tth, uuh, vvh, iumax, qvh, ps, wwh, iwmax, sd, msl, tcc, u10, v10, tt2, & !$OMP td2, lsprec, convprec, sshf, hflswitch, ssr, ewss, nsss, strswitch, oro, & -!$OMP excessoro, lsm, nymin1,ciwch,clwch,readclouds,sumclouds, nxshift,nxmax,nymax) & -!$OMP PRIVATE(ii, gribVer, iret, isec1, discipl, parCat, parNum, parId,typSurf, valSurf, & -!$OMP zsec4, isec2, gribErrorMsg, xauxin, yauxin, xaux, yaux, xaux0, & -!$OMP yaux0, k, arsize, stat, conversion_factor, size1) & +!$OMP excessoro, lsm, nymin1,ciwch,clwch,nxshift,lprecint, lcw, lcwsum) & +!$OMP PRIVATE(ii, gribVer, iret, is6, discipl, parCat, parNum, parId, typSfc, & +!$OMP zsec4, js2, js3, js12, gribErrorMsg, xauxin, yauxin, xaux, yaux, xaux0, & +!$OMP yaux0,k,arsize,stat,conversion_factor,size1,istep,ipf,npf,kz,kz1,jy) & !$OMP REDUCTION(+:gotGrid) + ! ! GET NEXT FIELDS ! @@ -2020,201 +2061,210 @@ subroutine readwind_ecmwf(indj,n,uuh,vvh,wwh) !first see if we read GRIB1 or GRIB2 call grib_get_int(igrib(ii),'editionNumber',gribVer,iret) - call grib_check(iret,gribFunction,gribErrorMsg) + call grib_check(iret,thisSubr,gribErrorMsg) + + ! AT stepRange is used to identify additional precip fields + call grib_get_int(igrib(ii),'stepRange',istep,iret) + call grib_check(iret,thisSubr,gribErrorMsg) + ipf=istep+1 if (gribVer.eq.1) then ! GRIB Edition 1 - !print*,'GRiB Edition 1' !read the grib2 identifiers - call grib_get_int(igrib(ii),'indicatorOfParameter',isec1(6),iret) - call grib_check(iret,gribFunction,gribErrorMsg) - call grib_get_int(igrib(ii),'level',isec1(8),iret) - call grib_check(iret,gribFunction,gribErrorMsg) - - !change code for etadot to code for omega - if (isec1(6).eq.77) then - isec1(6)=135 - endif + call grib_get_int(igrib(ii),'indicatorOfParameter',is6,iret) + call grib_check(iret,thisSubr,gribErrorMsg) + + call grib_get_int(igrib(ii),'level',k,iret) + call grib_check(iret,thisSubr,gribErrorMsg) + ! change code for etadot to code for omega + if (is6.eq.77) is6=135 + conversion_factor=1. - else + else ! GRiB Edition 2 - !print*,'GRiB Edition 2' - !read the grib2 identifiers + !read the grib2 identifiers call grib_get_int(igrib(ii),'discipline',discipl,iret) - call grib_check(iret,gribFunction,gribErrorMsg) + call grib_check(iret,thisSubr,gribErrorMsg) + call grib_get_int(igrib(ii),'parameterCategory',parCat,iret) - call grib_check(iret,gribFunction,gribErrorMsg) + call grib_check(iret,thisSubr,gribErrorMsg) + call grib_get_int(igrib(ii),'parameterNumber',parNum,iret) - call grib_check(iret,gribFunction,gribErrorMsg) - call grib_get_int(igrib(ii),'typeOfFirstFixedSurface',typSurf,iret) - call grib_check(iret,gribFunction,gribErrorMsg) - call grib_get_int(igrib(ii),'level',valSurf,iret) - call grib_check(iret,gribFunction,gribErrorMsg) + call grib_check(iret,thisSubr,gribErrorMsg) + + call grib_get_int(igrib(ii),'typeOfFirstFixedSurface',typSfc,iret) + call grib_check(iret,thisSubr,gribErrorMsg) + + call grib_get_int(igrib(ii),'level',k,iret) + call grib_check(iret,thisSubr,gribErrorMsg) + call grib_get_int(igrib(ii),'paramId',parId,iret) - call grib_check(iret,gribFunction,gribErrorMsg) - - !print*,discipl,parCat,parNum,typSurf,valSurf + call grib_check(iret,thisSubr,gribErrorMsg) - !convert to grib1 identifiers - isec1(6)=-1 - isec1(7)=-1 - isec1(8)=-1 - isec1(8)=valSurf ! level + !convert to grib1 identifiers + is6=-1 conversion_factor=1. - if ((parCat.eq.0).and.(parNum.eq.0).and.(typSurf.eq.105)) then ! T - isec1(6)=130 ! indicatorOfParameter - elseif ((parCat.eq.2).and.(parNum.eq.2).and.(typSurf.eq.105)) then ! U - isec1(6)=131 ! indicatorOfParameter - elseif ((parCat.eq.2).and.(parNum.eq.3).and.(typSurf.eq.105)) then ! V - isec1(6)=132 ! indicatorOfParameter - elseif ((parCat.eq.1).and.(parNum.eq.0).and.(typSurf.eq.105)) then ! Q - isec1(6)=133 ! indicatorOfParameter - ! ESO Cloud water is in a) fields CLWC and CIWC, *or* b) field QC - elseif ((parCat.eq.1).and.(parNum.eq.83).and.(typSurf.eq.105)) then ! clwc - isec1(6)=246 ! indicatorOfParameter - elseif ((parCat.eq.1).and.(parNum.eq.84).and.(typSurf.eq.105)) then ! ciwc - isec1(6)=247 ! indicatorOfParameter - ! ESO qc(=clwc+ciwc): - elseif ((parCat.eq.201).and.(parNum.eq.31).and.(typSurf.eq.105)) then ! qc - isec1(6)=201031 ! indicatorOfParameter - elseif ((parCat.eq.3).and.(parNum.eq.0).and.(typSurf.eq.1)) then !SP - isec1(6)=134 ! indicatorOfParameter - elseif ((parCat.eq.2).and.(parNum.eq.32)) then ! W, actually eta dot - isec1(6)=135 ! indicatorOfParameter - elseif ((parCat.eq.128).and.(parNum.eq.77)) then ! W, actually eta dot - isec1(6)=135 ! indicatorOfParameter - elseif ((parCat.eq.3).and.(parNum.eq.0).and.(typSurf.eq.101)) then !SLP - isec1(6)=151 ! indicatorOfParameter - elseif ((parCat.eq.2).and.(parNum.eq.2).and.(typSurf.eq.103)) then ! 10U - isec1(6)=165 ! indicatorOfParameter - elseif ((parCat.eq.2).and.(parNum.eq.3).and.(typSurf.eq.103)) then ! 10V - isec1(6)=166 ! indicatorOfParameter - elseif ((parCat.eq.0).and.(parNum.eq.0).and.(typSurf.eq.103)) then ! 2T - isec1(6)=167 ! indicatorOfParameter - elseif ((parCat.eq.0).and.(parNum.eq.6).and.(typSurf.eq.103)) then ! 2D - isec1(6)=168 ! indicatorOfParameter - elseif ((parCat.eq.1).and.(parNum.eq.11).and.(typSurf.eq.1)) then ! SD - isec1(6)=141 ! indicatorOfParameter + if (parCat .eq. 0 .and. parNum .eq. 0 .and. typSfc .eq. 105) then ! T + is6=130 + elseif (parCat .eq. 2 .and. parNum .eq. 2 .and. typSfc .eq. 105) then ! U + is6=131 + elseif (parCat .eq. 2 .and. parNum .eq. 3 .and. typSfc .eq. 105) then ! V + is6=132 + elseif (parCat .eq. 1 .and. parNum .eq. 0 .and. typSfc .eq. 105) then ! Q + is6=133 + ! ESO Cloud water is in a) fields CLWC and CIWC, *or* b) field QC + elseif (parCat .eq. 1 .and. parNum .eq. 83 .and. typSfc .eq. 105) then ! clwc + is6=246 + elseif (parCat .eq. 1 .and. parNum .eq. 84 .and. typSfc .eq. 105) then ! ciwc + is6=247 + ! ESO qc(=clwc+ciwc): + elseif (parCat .eq. 201 .and. parNum .eq. 31 .and. typSfc .eq. 105) then ! qc + is6=201031 + elseif (parCat .eq. 3 .and. parNum .eq. 0 .and. typSfc .eq. 1) then !SP + is6=134 + elseif (parCat .eq. 2 .and. parNum .eq. 32) then ! W, actually eta dot + is6=135 + elseif (parCat .eq. 128 .and. parNum .eq. 77) then ! W, actually eta dot + is6=135 + elseif (parCat .eq. 3 .and. parNum .eq. 0 .and. typSfc .eq. 101) then ! SLP + is6=151 + elseif (parCat .eq. 2 .and. parNum .eq. 2 .and. typSfc .eq. 103) then ! 10U + is6=165 + elseif (parCat .eq. 2 .and. parNum .eq. 3 .and. typSfc .eq. 103) then ! 10V + is6=166 + elseif (parCat .eq. 0 .and. parNum .eq. 0 .and. typSfc .eq. 103) then ! 2T + is6=167 + elseif (parCat .eq. 0 .and. parNum .eq. 6 .and. typSfc .eq. 103) then ! 2D + is6=168 + elseif (parCat .eq. 1 .and. parNum .eq. 11 .and. typSfc .eq. 1) then ! SD + is6=141 conversion_factor=1000. - elseif ((parCat.eq.6).and.(parNum.eq.1) .or. parId .eq. 164) then ! CC - isec1(6)=164 ! indicatorOfParameter - elseif ((parCat.eq.1).and.(parNum.eq.9) .or. parId .eq. 142) then ! LSP - isec1(6)=142 ! indicatorOfParameter - elseif ((parCat.eq.1).and.(parNum.eq.10)) then ! CP - isec1(6)=143 ! indicatorOfParameter + elseif (parCat .eq. 6 .and. parNum .eq. 1 .or. parId .eq. 164) then ! CC + is6=164 + elseif (parCat .eq. 1 .and. parNum .eq. 9 .or. parId .eq. 142) then ! LSP + is6=142 + elseif (parCat .eq. 1 .and. parNum .eq. 10) then ! CP + is6=143 conversion_factor=1000. - elseif ((parCat.eq.0).and.(parNum.eq.11).and.(typSurf.eq.1)) then ! SHF - isec1(6)=146 ! indicatorOfParameter - elseif ((parCat.eq.4).and.(parNum.eq.9).and.(typSurf.eq.1)) then ! SR - isec1(6)=176 ! indicatorOfParameter - ! elseif ((parCat.eq.2).and.(parNum.eq.17) .or. parId .eq. 180) then ! EWSS --wrong - elseif ((parCat.eq.2).and.(parNum.eq.38) .or. parId .eq. 180) then ! EWSS --correct - isec1(6)=180 ! indicatorOfParameter - ! elseif ((parCat.eq.2).and.(parNum.eq.18) .or. parId .eq. 181) then ! NSSS --wrong - elseif ((parCat.eq.2).and.(parNum.eq.37) .or. parId .eq. 181) then ! NSSS --correct - isec1(6)=181 ! indicatorOfParameter - elseif ((parCat.eq.3).and.(parNum.eq.4)) then ! ORO - isec1(6)=129 ! indicatorOfParameter - elseif ((parCat.eq.3).and.(parNum.eq.7) .or. parId .eq. 160) then ! SDO - isec1(6)=160 ! indicatorOfParameter - elseif ((discipl.eq.2).and.(parCat.eq.0).and.(parNum.eq.0).and. & - (typSurf.eq.1)) then ! LSM - isec1(6)=172 ! indicatorOfParameter - elseif (parNum.eq.152) then - isec1(6)=152 ! avoid warning for lnsp + elseif (parCat .eq. 0 .and. parNum .eq. 11 .and. typSfc .eq. 1) then ! SHF + is6=146 + elseif (parCat .eq. 4 .and. parNum .eq. 9 .and. typSfc .eq. 1) then ! SR + is6=176 + elseif (parCat .eq. 2 .and. parNum .eq. 38 .or. parId .eq. 180) then ! EWSS --correct + is6=180 + elseif (parCat .eq. 2 .and. parNum .eq. 37 .or. parId .eq. 181) then ! NSSS --correct + is6=181 + elseif (parCat .eq. 3 .and. parNum .eq. 4) then ! ORO + is6=129 + elseif (parCat .eq. 3 .and. parNum .eq. 7 .or. parId .eq. 160) then ! SDO + is6=160 + elseif (discipl .eq. 2 .and. parCat .eq. 0 .and. parNum .eq. 0 .and. & + typSfc .eq. 1) then ! LSM + is6=172 + elseif (parNum .eq. 152) then + is6=152 ! avoid warning for lnsp else - print*,'***WARNING: undefined GRiB2 message found!',discipl, & - parCat,parNum,typSurf - endif - if(parId .ne. isec1(6) .and. parId .ne. 77) then - write(*,*) 'parId',parId, 'isec1(6)',isec1(6) + print*,'***WARNING: undefined GRiB2 message found!',discipl,parCat,parNum,typSfc endif + + if (parId .ne. is6 .and. parId .ne. 77) write(*,*) 'parId',parId, 'is6',is6 - endif + endif ! grib Version conversion !HSO get the size and data of the values array - if (isec1(6).ne.-1) then + if (is6.ne.-1) then call grib_get_size(igrib(ii),'values',size1,iret) - call grib_check(iret,gribFunction,gribErrorMsg) + call grib_check(iret,thisSubr,gribErrorMsg) allocate(zsec4(size1), stat=stat) if (stat.ne.0) error stop "Could not allocate zsec4" + call grib_get_real4_array(igrib(ii),'values',zsec4,iret) - call grib_check(iret,gribFunction,gribErrorMsg) + call grib_check(iret,thisSubr,gribErrorMsg) endif !HSO get the required fields from section 2 in a gribex compatible manner if (ii.eq.1) then - call grib_get_int(igrib(ii),'numberOfPointsAlongAParallel',isec2(1),iret) - call grib_check(iret,gribFunction,gribErrorMsg) - call grib_get_int(igrib(ii),'numberOfPointsAlongAMeridian',isec2(2),iret) - call grib_check(iret,gribFunction,gribErrorMsg) - call grib_get_int(igrib(ii),'numberOfVerticalCoordinateValues',isec2(3)) - call grib_check(iret,gribFunction,gribErrorMsg) - ! CHECK GRID SPECIFICATIONS - if(isec2(1).ne.nxfield) error stop 'READWIND: NX NOT CONSISTENT' - if(isec2(2).ne.ny) error stop 'READWIND: NY NOT CONSISTENT' - if(isec2(3)/2-1.ne.nlev_ec) & + call grib_get_int(igrib(ii),'numberOfPointsAlongAParallel',js2,iret) + call grib_check(iret,thisSubr,gribErrorMsg) + + call grib_get_int(igrib(ii),'numberOfPointsAlongAMeridian',js3,iret) + call grib_check(iret,thisSubr,gribErrorMsg) + + call grib_get_int(igrib(ii),'numberOfVerticalCoordinateValues',js12) + call grib_check(iret,thisSubr,gribErrorMsg) + + ! CHECK GRID SPECIFICATIONS + if(js2.ne.nxfield) error stop 'READWIND: NX NOT CONSISTENT' + if(js3.ne.ny) error stop 'READWIND: NY NOT CONSISTENT' + if(js12/2-1 .ne. nlev_ec) & error stop 'READWIND: VERTICAL DISCRETIZATION NOT CONSISTENT' endif ! ifield !$OMP CRITICAL !HSO get the second part of the grid dimensions only from GRiB1 messages - if (isec1(6) .eq. 167 .and. (gotGrid.eq.0)) then + if (is6 .eq. 167 .and. gotGrid.eq.0) then + call grib_get_real8(igrib(ii),'longitudeOfFirstGridPointInDegrees', & xauxin,iret) - call grib_check(iret,gribFunction,gribErrorMsg) + call grib_check(iret,thisSubr,gribErrorMsg) + call grib_get_real8(igrib(ii),'latitudeOfLastGridPointInDegrees', & yauxin,iret) - call grib_check(iret,gribFunction,gribErrorMsg) - if (xauxin.gt.180.) xauxin=xauxin-360.0 - if (xauxin.lt.-180.) xauxin=xauxin+360.0 + call grib_check(iret,thisSubr,gribErrorMsg) + + if (xauxin.gt.180.) xauxin=xauxin-360. + if (xauxin.lt.-180.) xauxin=xauxin+360. xaux=real(xauxin)+real(nxshift)*dx yaux=real(yauxin) if (xaux.gt.180.) xaux=xaux-360.0 + if(abs(xaux-xlon0).gt.eps) & - error stop 'READWIND: LOWER LEFT LONGITUDE NOT CONSISTENT' + error stop 'READWIND ECMWF : LOWER LEFT LONGITUDE NOT CONSISTENT' if(abs(yaux-ylat0).gt.eps) & - error stop 'READWIND: LOWER LEFT LATITUDE NOT CONSISTENT' + error stop 'READWIND ECMWF: LOWER LEFT LATITUDE NOT CONSISTENT' gotGrid=1 endif ! gotGrid !$OMP END CRITICAL - k=isec1(8) - select case(isec1(6)) + + kz=nlev_ec-k+2 ! used for all 3D fields except W + kz1=nlev_ec-k+1 ! used for W + + select case(is6) !! TEMPERATURE case(130) do j=0,nymin1 do i=0,nxfield-1 - tth(i,j,nlev_ec-k+2,n) = zsec4(nxfield*(ny-j-1)+i+1) + tth(i,j,kz,n) = zsec4(nxfield*(ny-j-1)+i+1) end do end do !! U VELOCITY case(131) do j=0,nymin1 do i=0,nxfield-1 - uuh(i,j,nlev_ec-k+2) = zsec4(nxfield*(ny-j-1)+i+1) + uuh(i,j,kz) = zsec4(nxfield*(ny-j-1)+i+1) end do end do !$OMP CRITICAL - iumax=max(iumax,nlev_ec-k+1) + iumax=max(iumax,kz1) !$OMP END CRITICAL !! V VELOCITY case(132) do j=0,nymin1 do i=0,nxfield-1 - vvh(i,j,nlev_ec-k+2) = zsec4(nxfield*(ny-j-1)+i+1) + vvh(i,j,kz) = zsec4(nxfield*(ny-j-1)+i+1) end do end do !! SPEC. HUMIDITY case(133) do j=0,nymin1 do i=0,nxfield-1 - qvh(i,j,nlev_ec-k+2,n) = zsec4(nxfield*(ny-j-1)+i+1) - if (qvh(i,j,nlev_ec-k+2,n) .lt. 0.) & - qvh(i,j,nlev_ec-k+2,n) = 0. + qvh(i,j,kz,n) = zsec4(nxfield*(ny-j-1)+i+1) + if (qvh(i,j,kz,n) .lt. 0.) & + qvh(i,j,kz,n) = 0. ! this is necessary because the gridded data may contain ! spurious negative values end do @@ -2230,11 +2280,11 @@ subroutine readwind_ecmwf(indj,n,uuh,vvh,wwh) case(135) do j=0,nymin1 do i=0,nxfield-1 - wwh(i,j,nlev_ec-k+1) = zsec4(nxfield*(ny-j-1)+i+1) + wwh(i,j,kz1) = zsec4(nxfield*(ny-j-1)+i+1) end do end do !$OMP CRITICAL - iwmax=max(iwmax,nlev_ec-k+1) + iwmax=max(iwmax,kz1) !$OMP END CRITICAL !! SNOW DEPTH case(141) @@ -2289,16 +2339,16 @@ subroutine readwind_ecmwf(indj,n,uuh,vvh,wwh) case(142) do j=0,nymin1 do i=0,nxfield-1 - lsprec(i,j,1,n)=zsec4(nxfield*(ny-j-1)+i+1) - if (lsprec(i,j,1,n).lt.0.) lsprec(i,j,1,n)=0. + lsprec(i,j,1,ipf,n)=zsec4(nxfield*(ny-j-1)+i+1) + if (lsprec(i,j,1,ipf,n).lt.0.) lsprec(i,j,1,ipf,n)=0. end do end do !! CONVECTIVE PREC. case(143) do j=0,nymin1 do i=0,nxfield-1 - convprec(i,j,1,n)=zsec4(nxfield*(ny-j-1)+i+1)/conversion_factor - if (convprec(i,j,1,n).lt.0.) convprec(i,j,1,n)=0. + convprec(i,j,1,ipf,n)=zsec4(nxfield*(ny-j-1)+i+1)/conversion_factor + if (convprec(i,j,1,ipf,n).lt.0.) convprec(i,j,1,ipf,n)=0. end do end do !! SENS. HEAT FLUX @@ -2361,22 +2411,26 @@ subroutine readwind_ecmwf(indj,n,uuh,vvh,wwh) lsm(i,j) = zsec4(nxfield*(ny-j-1)+i+1) end do end do +! ZHG add reading of cloud water fields +! ESO add reading of total cloud water fields +! ESO TODO: add check whether either CLWC or CIWC is missing (->error) +! if all 3 cw fields exist, use QC and disregard the others !! CLWC Cloud liquid water content [kg/kg] case(246) do j=0,nymin1 do i=0,nxfield-1 - clwch(i,j,nlev_ec-k+2,n)=zsec4(nxfield*(ny-j-1)+i+1) + clwch(i,j,kz,n)=zsec4(nxfield*(ny-j-1)+i+1) end do end do !$OMP CRITICAL - readclouds=.true. - sumclouds=.false. + lcw=.true. + lcwsum=.false. !$OMP END CRITICAL !! CIWC Cloud ice water content case(247) do j=0,nymin1 do i=0,nxfield-1 - ciwch(i,j,nlev_ec-k+2,n)=zsec4(nxfield*(ny-j-1)+i+1) + ciwch(i,j,kz,n)=zsec4(nxfield*(ny-j-1)+i+1) end do end do !ZHG end @@ -2385,12 +2439,12 @@ subroutine readwind_ecmwf(indj,n,uuh,vvh,wwh) case(201031) do j=0,nymin1 do i=0,nxfield-1 - clwch(i,j,nlev_ec-k+2,n)=zsec4(nxfield*(ny-j-1)+i+1) + clwch(i,j,kz,n)=zsec4(nxfield*(ny-j-1)+i+1) end do end do !$OMP CRITICAL - readclouds=.true. - sumclouds=.false. + lcw=.true. + lcwsum=.true. !$OMP END CRITICAL end select @@ -2412,18 +2466,13 @@ subroutine readwind_ecmwf(indj,n,uuh,vvh,wwh) !error message if no fields found with correct first longitude in it if (gotGrid.eq.0) then - print*,'***ERROR: input file needs to contain GRiB1 formatted'// & - 'messages' + print*,'***ERROR: input file needs to contain GRiB1 formatted messages' error stop endif - if(levdiff2.eq.0) then + if(nlev_ec-nwz+1 .eq. 0) then iwmax=nlev_ec+1 - do i=0,nxmin1 - do j=0,nymin1 - wwh(i,j,nlev_ec+1)=0. - end do - end do + wwh(:,:,iwmax)=0. endif ! For global fields, assign the leftmost data column also to the rightmost @@ -2431,76 +2480,112 @@ subroutine readwind_ecmwf(indj,n,uuh,vvh,wwh) !************************************************************************* if (xglobal) then + if (lprecint) then + npf=numpf + else + npf=1 + endif +!$OMP PARALLEL SECTIONS PRIVATE(ipf) +!$OMP SECTION call shift_field_0(ewss,nxfield,ny) +!$OMP SECTION call shift_field_0(nsss,nxfield,ny) +!$OMP SECTION call shift_field_0(oro,nxfield,ny) +!$OMP SECTION call shift_field_0(excessoro,nxfield,ny) +!$OMP SECTION call shift_field_0(lsm,nxfield,ny) - call shift_field(ps,nxfield,ny,1,1,2,n) - call shift_field(sd,nxfield,ny,1,1,2,n) - call shift_field(msl,nxfield,ny,1,1,2,n) - call shift_field(tcc,nxfield,ny,1,1,2,n) - call shift_field(u10,nxfield,ny,1,1,2,n) - call shift_field(v10,nxfield,ny,1,1,2,n) - call shift_field(tt2,nxfield,ny,1,1,2,n) - call shift_field(td2,nxfield,ny,1,1,2,n) - call shift_field(lsprec,nxfield,ny,1,1,2,n) - call shift_field(convprec,nxfield,ny,1,1,2,n) - call shift_field(sshf,nxfield,ny,1,1,2,n) - call shift_field(ssr,nxfield,ny,1,1,2,n) - call shift_field(tth,nxfield,ny,nuvzmax,nuvz,2,n) - call shift_field(qvh,nxfield,ny,nuvzmax,nuvz,2,n) +!$OMP SECTION + call shift_field(ps,nxfield,ny,1,1,numwfmem,n) +!$OMP SECTION + call shift_field(sd,nxfield,ny,1,1,numwfmem,n) +!$OMP SECTION + call shift_field(msl,nxfield,ny,1,1,numwfmem,n) +!$OMP SECTION + call shift_field(tcc,nxfield,ny,1,1,numwfmem,n) +!$OMP SECTION + call shift_field(u10,nxfield,ny,1,1,numwfmem,n) +!$OMP SECTION + call shift_field(v10,nxfield,ny,1,1,numwfmem,n) +!$OMP SECTION + call shift_field(tt2,nxfield,ny,1,1,numwfmem,n) +!$OMP SECTION + call shift_field(td2,nxfield,ny,1,1,numwfmem,n) +!$OMP SECTION + do ipf=1,npf + call shift_field(lsprec(:,:,:,ipf,n),nxfield,ny,1,1,1,1) + end do +!$OMP SECTION + do ipf=1,npf + call shift_field(convprec(:,:,:,ipf,n),nxfield,ny,1,1,1,1) + end do +!$OMP SECTION + call shift_field(sshf,nxfield,ny,1,1,numwfmem,n) +!$OMP SECTION + call shift_field(ssr,nxfield,ny,1,1,numwfmem,n) +!$OMP SECTION + call shift_field(tth,nxfield,ny,nuvzmax,nuvz,numwfmem,n) +!$OMP SECTION + call shift_field(qvh,nxfield,ny,nuvzmax,nuvz,numwfmem,n) +!$OMP SECTION call shift_field(uuh,nxfield,ny,nuvzmax,nuvz,1,1) +!$OMP SECTION call shift_field(vvh,nxfield,ny,nuvzmax,nuvz,1,1) +!$OMP SECTION call shift_field(wwh,nxfield,ny,nwzmax,nwz,1,1) +!$OMP SECTION !ZHG - call shift_field(clwch,nxfield,ny,nuvzmax,nuvz,2,n) - if (.not.sumclouds) call shift_field(ciwch,nxfield,ny,nuvzmax,nuvz,2,n) + call shift_field(clwch,nxfield,ny,nuvzmax,nuvz,numwfmem,n) +!$OMP SECTION + if (.not.lcwsum) call shift_field(ciwch,nxfield,ny,nuvzmax,nuvz,numwfmem,n) !ZHG end - +!$OMP END PARALLEL SECTIONS endif - do i=0,nxmin1 - do j=0,nymin1 - if ((ewss(i,j).eq.0.).and.(nsss(i,j).eq.0.)) then - if ((i.ne.0).and.(j.ne.0).and.(i.ne.nxmin1).and.(j.ne.nymin1)) then - ewss(i,j)=(ewss(i-1,j-1)+ewss(i+1,j+1)+ewss(i+1,j)+ewss(i-1,j)+ & - ewss(i,j+1)+ewss(i,j-1)+ewss(i-1,j+1)+ewss(i+1,j-1))/8. - nsss(i,j)=(nsss(i-1,j-1)+nsss(i+1,j+1)+nsss(i+1,j)+nsss(i-1,j)+ & - nsss(i,j+1)+nsss(i,j-1)+nsss(i-1,j+1)+nsss(i+1,j-1))/8. - else if ((i.eq.0).and.(j.eq.0)) then - ewss(i,j)=(ewss(i+1,j+1)+ewss(i+1,j)+ewss(i,j+1))/3. - nsss(i,j)=(nsss(i+1,j+1)+nsss(i+1,j)+nsss(i,j+1))/3. - else if ((i.eq.nxmin1).and.(j.eq.nymin1)) then - ewss(i,j)=(ewss(i-1,j-1)+ewss(i-1,j)+ewss(i,j-1))/3. - nsss(i,j)=(nsss(i-1,j-1)+nsss(i-1,j)+nsss(i,j-1))/3. - else if ((i.eq.0).and.(j.eq.nymin1)) then - ewss(i,j)=(ewss(i+1,j-1)+ewss(i+1,j)+ewss(i,j-1))/3. - nsss(i,j)=(nsss(i+1,j-1)+nsss(i+1,j)+nsss(i,j-1))/3. - else if ((i.eq.nxmin1).and.(j.eq.0)) then - ewss(i,j)=(ewss(i-1,j+1)+ewss(i-1,j)+ewss(i,j+1))/3. - nsss(i,j)=(nsss(i-1,j+1)+nsss(i-1,j)+nsss(i,j+1))/3. - else if (i.eq.0) then - ewss(i,j)=(ewss(i+1,j+1)+ewss(i+1,j)+ewss(i,j+1)+ewss(i,j-1)+ewss(i+1,j-1))/5. - nsss(i,j)=(nsss(i+1,j+1)+nsss(i+1,j)+nsss(i,j+1)+nsss(i,j-1)+nsss(i+1,j-1))/5. - else if (i.eq.nxmin1) then - ewss(i,j)=(ewss(i-1,j+1)+ewss(i-1,j)+ewss(i,j+1)+ewss(i,j-1)+ewss(i-1,j-1))/5. - nsss(i,j)=(nsss(i-1,j+1)+nsss(i-1,j)+nsss(i,j+1)+nsss(i,j-1)+nsss(i-1,j-1))/5. - else if (j.eq.0) then - ewss(i,j)=(ewss(i+1,j+1)+ewss(i+1,j)+ewss(i-1,j)+ewss(i,j+1)+ewss(i-1,j+1))/5. - nsss(i,j)=(nsss(i+1,j+1)+nsss(i+1,j)+nsss(i-1,j)+nsss(i,j+1)+nsss(i-1,j+1))/5. - else if (j.eq.nymin1) then - ewss(i,j)=(ewss(i+1,j-1)+ewss(i+1,j)+ewss(i-1,j)+ewss(i,j-1)+ewss(i-1,j-1))/5. - nsss(i,j)=(nsss(i+1,j-1)+nsss(i+1,j)+nsss(i-1,j)+nsss(i,j-1)+nsss(i-1,j-1))/5. + ! Temporary fix for zero values in the meteo data + if (hflswitch .and. strswitch) then + do i=0,nxmin1 + do j=0,nymin1 + if ((ewss(i,j).eq.0.).and.(nsss(i,j).eq.0.)) then + if ((i.ne.0).and.(j.ne.0).and.(i.ne.nxmin1).and.(j.ne.nymin1)) then + ewss(i,j)=(ewss(i-1,j-1)+ewss(i+1,j+1)+ewss(i+1,j)+ewss(i-1,j)+ & + ewss(i,j+1)+ewss(i,j-1)+ewss(i-1,j+1)+ewss(i+1,j-1))/8. + nsss(i,j)=(nsss(i-1,j-1)+nsss(i+1,j+1)+nsss(i+1,j)+nsss(i-1,j)+ & + nsss(i,j+1)+nsss(i,j-1)+nsss(i-1,j+1)+nsss(i+1,j-1))/8. + else if ((i.eq.0).and.(j.eq.0)) then + ewss(i,j)=(ewss(i+1,j+1)+ewss(i+1,j)+ewss(i,j+1))/3. + nsss(i,j)=(nsss(i+1,j+1)+nsss(i+1,j)+nsss(i,j+1))/3. + else if ((i.eq.nxmin1).and.(j.eq.nymin1)) then + ewss(i,j)=(ewss(i-1,j-1)+ewss(i-1,j)+ewss(i,j-1))/3. + nsss(i,j)=(nsss(i-1,j-1)+nsss(i-1,j)+nsss(i,j-1))/3. + else if ((i.eq.0).and.(j.eq.nymin1)) then + ewss(i,j)=(ewss(i+1,j-1)+ewss(i+1,j)+ewss(i,j-1))/3. + nsss(i,j)=(nsss(i+1,j-1)+nsss(i+1,j)+nsss(i,j-1))/3. + else if ((i.eq.nxmin1).and.(j.eq.0)) then + ewss(i,j)=(ewss(i-1,j+1)+ewss(i-1,j)+ewss(i,j+1))/3. + nsss(i,j)=(nsss(i-1,j+1)+nsss(i-1,j)+nsss(i,j+1))/3. + else if (i.eq.0) then + ewss(i,j)=(ewss(i+1,j+1)+ewss(i+1,j)+ewss(i,j+1)+ewss(i,j-1)+ewss(i+1,j-1))/5. + nsss(i,j)=(nsss(i+1,j+1)+nsss(i+1,j)+nsss(i,j+1)+nsss(i,j-1)+nsss(i+1,j-1))/5. + else if (i.eq.nxmin1) then + ewss(i,j)=(ewss(i-1,j+1)+ewss(i-1,j)+ewss(i,j+1)+ewss(i,j-1)+ewss(i-1,j-1))/5. + nsss(i,j)=(nsss(i-1,j+1)+nsss(i-1,j)+nsss(i,j+1)+nsss(i,j-1)+nsss(i-1,j-1))/5. + else if (j.eq.0) then + ewss(i,j)=(ewss(i+1,j+1)+ewss(i+1,j)+ewss(i-1,j)+ewss(i,j+1)+ewss(i-1,j+1))/5. + nsss(i,j)=(nsss(i+1,j+1)+nsss(i+1,j)+nsss(i-1,j)+nsss(i,j+1)+nsss(i-1,j+1))/5. + else if (j.eq.nymin1) then + ewss(i,j)=(ewss(i+1,j-1)+ewss(i+1,j)+ewss(i-1,j)+ewss(i,j-1)+ewss(i-1,j-1))/5. + nsss(i,j)=(nsss(i+1,j-1)+nsss(i+1,j)+nsss(i-1,j)+nsss(i,j-1)+nsss(i-1,j-1))/5. + endif endif - endif - sfcstress(i,j,1,n)=sqrt(ewss(i,j)**2+nsss(i,j)**2) + sfcstress(i,j,1,n)=sqrt(ewss(i,j)**2+nsss(i,j)**2) + end do end do - end do + endif - if ((.not.hflswitch).or.(.not.strswitch)) then - write(*,*) 'WARNING: No flux data contained in GRIB file ', & - wfname(indj) + if (.not.hflswitch .or. .not.strswitch) then + write(*,*) 'WARNING: No flux data contained in GRIB file ', wfname(indj) ! CALCULATE USTAR AND SSHF USING THE PROFILE METHOD ! As ECMWF has increased the model resolution, such that now the first model @@ -2508,8 +2593,8 @@ subroutine readwind_ecmwf(indj,n,uuh,vvh,wwh) ! (3rd model level in FLEXPART) for the profile method !*************************************************************************** - do i=0,nxmin1 - do j=0,nymin1 + do j=0,nymin1 + do i=0,nxmin1 plev1=akz(3)+bkz(3)*ps(i,j,1,n) pmean=0.5*(ps(i,j,1,n)+plev1) tv=tth(i,j,3,n)*(1.+0.61*qvh(i,j,3,n)) @@ -2533,14 +2618,12 @@ subroutine readwind_ecmwf(indj,n,uuh,vvh,wwh) ! Temperature is taken as 2 m temperature !************************************************************************** - do i=0,nxmin1 - do j=0,nymin1 + forall (i=0:nxmin1, j=0:nymin1) uuh(i,j,1)=u10(i,j,1,n) vvh(i,j,1)=v10(i,j,1,n) qvh(i,j,1,n)=qvh(i,j,2,n) tth(i,j,1,n)=tt2(i,j,1,n) - end do - end do + end forall if(iumax.ne.nuvz-1) error stop 'READWIND: NUVZ NOT CONSISTENT' if(iwmax.ne.nwz) error stop 'READWIND: NWZ NOT CONSISTENT' @@ -2557,26 +2640,35 @@ end subroutine readwind_ecmwf subroutine readwind_gfs(indj,n,uuh,vvh,wwh) !*********************************************************************** - !* * - !* TRAJECTORY MODEL SUBROUTINE READWIND * - !* * + ! * + ! TRAJECTORY MODEL SUBROUTINE READWIND * + ! * !*********************************************************************** - !* * - !* AUTHOR: G. WOTAWA * - !* DATE: 1997-08-05 * - !* LAST UPDATE: 2000-10-17, Andreas Stohl * - !* CHANGE: 01/02/2001, Bernd C. Krueger, Variables tth and * - !* qvh (on eta coordinates) in common block * - !* CHANGE: 16/11/2005, Caroline Forster, GFS data * - !* CHANGE: 11/01/2008, Harald Sodemann, Input of GRIB1/2 * - !* data with the ECMWF grib_api library * - !* CHANGE: 03/12/2008, Harald Sodemann, update to f90 with * - !* ECMWF grib_api * + ! * + ! AUTHOR: G. WOTAWA * + ! DATE: 1997-08-05 * + ! LAST UPDATE: 2000-10-17, Andreas Stohl * + ! CHANGE: 01/02/2001, Bernd C. Krueger, Variables tth and * + ! qvh (on eta coordinates) in common block * + ! CHANGE: 16/11/2005, Caroline Forster, GFS data * + ! CHANGE: 11/01/2008, Harald Sodemann, Input of GRIB1/2 * + ! data with the ECMWF grib_api library * + ! CHANGE: 03/12/2008, Harald Sodemann, update to f90 with * + ! ECMWF grib_api * ! * ! Unified ECMWF and GFS builds * ! Marian Harustak, 12.5.2017 * ! - Renamed routine from readwind to readwind_gfs * - !* * + ! * + ! Petra Seibert, Anne Tipka, 2021-02: implement new interpolation * + ! just catch numpf>1 and produce error msg, adjust rank of precip * + ! and correct some loops in bad order * + ! * + ! * + ! Anne Tipka, Petra Seibert 2021-02: implement new interpolation * + ! for precipitation according to #295 using 2 additional fields * + ! change some double loops in wrong order to forall constructs * + ! * !*********************************************************************** !* * !* DESCRIPTION: * @@ -2608,7 +2700,8 @@ subroutine readwind_gfs(indj,n,uuh,vvh,wwh) integer :: ifile integer :: iret,size1,size2,stat integer :: igrib - integer :: gribVer,parCat,parNum,typSurf,valSurf,discipl + integer :: ipf + integer :: gribVer,parCat,parNum,typSfc,valSurf,discipl !HSO end edits real :: uuh(0:nxmax-1,0:nymax-1,nuvzmax) real :: vvh(0:nxmax-1,0:nymax-1,nuvzmax) @@ -2629,6 +2722,7 @@ subroutine readwind_gfs(indj,n,uuh,vvh,wwh) !HSO kept isec1, isec2 and zsec4 for consistency with gribex GRIB input integer :: isec1(8),isec2(3) + real :: xsec18 ! IP 29.1.24 real(kind=4),allocatable,dimension(:) :: zsec4 real(kind=4) :: xaux,yaux,xaux0,yaux0 real(kind=8) :: xauxin,yauxin @@ -2640,10 +2734,11 @@ subroutine readwind_gfs(indj,n,uuh,vvh,wwh) !HSO for grib api error messages character(len=24) :: gribErrorMsg = 'Error reading grib file' - ! character(len=20) :: gribFunction = 'readwind_gfs' + character(len=20) :: gribFunction = 'readwind_gfs' character(len=20) :: shortname - + if (numpf .gt. 1) goto 777 ! additional precip fields not implemented in GFS + hflswitch=.false. strswitch=.false. levdiff2=nlev_ec-nwz+1 @@ -2695,6 +2790,11 @@ subroutine readwind_gfs(indj,n,uuh,vvh,wwh) call grib_get_int(igrib,'level',isec1(8),iret) ! call grib_check(iret,gribFunction,gribErrorMsg) +! IP 01.24: port form nilu dev branch +!JMA / SH: isec1(8) not evaluated any more below +!b/c with GRIB 2 this may be a real variable + xsec18 = real(isec1(8)) + else ! GRIB Edition 2 !read the grib2 identifiers @@ -2706,102 +2806,146 @@ subroutine readwind_gfs(indj,n,uuh,vvh,wwh) ! call grib_check(iret,gribFunction,gribErrorMsg) call grib_get_int(igrib,'parameterNumber',parNum,iret) ! call grib_check(iret,gribFunction,gribErrorMsg) - call grib_get_int(igrib,'typeOfFirstFixedSurface',typSurf,iret) + call grib_get_int(igrib,'typeOfFirstFixedSurface',typSfc,iret) ! call grib_check(iret,gribFunction,gribErrorMsg) call grib_get_int(igrib,'scaledValueOfFirstFixedSurface', & valSurf,iret) ! call grib_check(iret,gribFunction,gribErrorMsg) - ! write(*,*) 'Field: ',ifield,parCat,parNum,typSurf,shortname + ! write(*,*) 'Field: ',ifield,parCat,parNum,typSfc,shortname !convert to grib1 identifiers isec1(6)=-1 isec1(7)=-1 isec1(8)=-1 - if ((parCat.eq.0).and.(parNum.eq.0).and.(typSurf.eq.100)) then ! T + + xsec18 =-1.0 + + if ((parCat.eq.0).and.(parNum.eq.0).and.(typSfc.eq.100)) then ! T isec1(6)=11 ! indicatorOfParameter isec1(7)=100 ! indicatorOfTypeOfLevel isec1(8)=valSurf/100 ! level, convert to hPa - elseif ((parCat.eq.2).and.(parNum.eq.2).and.(typSurf.eq.100)) then ! U + xsec18=valSurf/100.0 ! level, convert to hPa + + + ! IPfixgfs11 + call grib_get_size(igrib,'values',size1,iret) + allocate( zsec4(size1),stat=stat ) + call grib_get_real4_array(igrib,'values',zsec4,iret) + call grib_check(iret,gribFunction,gribErrorMsg) + deallocate(zsec4) + + + elseif ((parCat.eq.2).and.(parNum.eq.2).and.(typSfc.eq.100)) then ! U isec1(6)=33 ! indicatorOfParameter isec1(7)=100 ! indicatorOfTypeOfLevel isec1(8)=valSurf/100 ! level, convert to hPa - elseif ((parCat.eq.2).and.(parNum.eq.3).and.(typSurf.eq.100)) then ! V + xsec18=valSurf/100.0 ! level, convert to hPa + + ! IPfixgfs11 + call grib_get_size(igrib,'values',size1,iret) + allocate( zsec4(size1),stat=stat ) + call grib_get_real4_array(igrib,'values',zsec4,iret) + call grib_check(iret,gribFunction,gribErrorMsg) + deallocate(zsec4) + + + + elseif ((parCat.eq.2).and.(parNum.eq.3).and.(typSfc.eq.100)) then ! V isec1(6)=34 ! indicatorOfParameter isec1(7)=100 ! indicatorOfTypeOfLevel isec1(8)=valSurf/100 ! level, convert to hPa - elseif ((parCat.eq.2).and.(parNum.eq.8).and.(typSurf.eq.100)) then ! W + xsec18=valSurf/100.0 ! level, convert to hPa + elseif ((parCat.eq.2).and.(parNum.eq.8).and.(typSfc.eq.100)) then ! W isec1(6)=39 ! indicatorOfParameter isec1(7)=100 ! indicatorOfTypeOfLevel isec1(8)=valSurf/100 ! level, convert to hPa - elseif ((parCat.eq.1).and.(parNum.eq.1).and.(typSurf.eq.100)) then ! RH + xsec18=valSurf/100.0 ! level, convert to hPa + elseif ((parCat.eq.1).and.(parNum.eq.1).and.(typSfc.eq.100)) then ! RH isec1(6)=52 ! indicatorOfParameter isec1(7)=100 ! indicatorOfTypeOfLevel isec1(8)=valSurf/100 ! level, convert to hPa - elseif ((parCat.eq.1).and.(parNum.eq.1).and.(typSurf.eq.103)) then ! RH2 + xsec18=valSurf/100.0 ! level, convert to hPa + elseif ((parCat.eq.1).and.(parNum.eq.1).and.(typSfc.eq.103)) then ! RH2 isec1(6)=52 ! indicatorOfParameter isec1(7)=105 ! indicatorOfTypeOfLevel isec1(8)=2 - elseif ((parCat.eq.0).and.(parNum.eq.0).and.(typSurf.eq.103)) then ! T2 + xsec18=real(2) + elseif ((parCat.eq.0).and.(parNum.eq.0).and.(typSfc.eq.103)) then ! T2 isec1(6)=11 ! indicatorOfParameter isec1(7)=105 ! indicatorOfTypeOfLevel isec1(8)=2 - elseif ((parCat.eq.2).and.(parNum.eq.2).and.(typSurf.eq.103)) then ! U10 + xsec18=real(2) + elseif ((parCat.eq.2).and.(parNum.eq.2).and.(typSfc.eq.103)) then ! U10 isec1(6)=33 ! indicatorOfParameter isec1(7)=105 ! indicatorOfTypeOfLevel isec1(8)=10 - elseif ((parCat.eq.2).and.(parNum.eq.3).and.(typSurf.eq.103)) then ! V10 + xsec18=real(10) + elseif ((parCat.eq.2).and.(parNum.eq.3).and.(typSfc.eq.103)) then ! V10 isec1(6)=34 ! indicatorOfParameter isec1(7)=105 ! indicatorOfTypeOfLevel isec1(8)=10 - elseif ((parCat.eq.1).and.(parNum.eq.22).and.(typSurf.eq.100)) then ! CLWMR Cloud Mixing Ratio [kg/kg]: + xsec18=real(10) + elseif ((parCat.eq.1).and.(parNum.eq.22).and.(typSfc.eq.100)) then ! CLWMR Cloud Mixing Ratio [kg/kg]: isec1(6)=153 ! indicatorOfParameter isec1(7)=100 ! indicatorOfTypeOfLevel isec1(8)=valSurf/100 ! level, convert to hPa - elseif ((parCat.eq.3).and.(parNum.eq.1).and.(typSurf.eq.101)) then ! SLP + xsec18=valSurf/100.0 ! level, convert to hPa + elseif ((parCat.eq.3).and.(parNum.eq.1).and.(typSfc.eq.101)) then ! SLP isec1(6)=2 ! indicatorOfParameter isec1(7)=102 ! indicatorOfTypeOfLevel isec1(8)=0 - elseif ((parCat.eq.3).and.(parNum.eq.0).and.(typSurf.eq.1)) then ! SP + xsec18=real(0) + elseif ((parCat.eq.3).and.(parNum.eq.0).and.(typSfc.eq.1)) then ! SP isec1(6)=1 ! indicatorOfParameter isec1(7)=1 ! indicatorOfTypeOfLevel isec1(8)=0 - elseif ((parCat.eq.1).and.(parNum.eq.13).and.(typSurf.eq.1)) then ! SNOW + xsec18=real(0) + elseif ((parCat.eq.1).and.(parNum.eq.13).and.(typSfc.eq.1)) then ! SNOW isec1(6)=66 ! indicatorOfParameter isec1(7)=1 ! indicatorOfTypeOfLevel isec1(8)=0 - elseif ((parCat.eq.0).and.(parNum.eq.0).and.(typSurf.eq.104)) then ! T sigma 0 + xsec18=real(0) + elseif ((parCat.eq.0).and.(parNum.eq.0).and.(typSfc.eq.104)) then ! T sigma 0 isec1(6)=11 ! indicatorOfParameter isec1(7)=107 ! indicatorOfTypeOfLevel isec1(8)=0.995 ! lowest sigma level !LB: isec1 is an integer array!!! - elseif ((parCat.eq.2).and.(parNum.eq.2).and.(typSurf.eq.104)) then ! U sigma 0 + xsec18=0.995 ! lowest sigma level + elseif ((parCat.eq.2).and.(parNum.eq.2).and.(typSfc.eq.104)) then ! U sigma 0 isec1(6)=33 ! indicatorOfParameter isec1(7)=107 ! indicatorOfTypeOfLevel isec1(8)=0.995 ! lowest sigma level !LB: isec1 is an integer array!!! - elseif ((parCat.eq.2).and.(parNum.eq.3).and.(typSurf.eq.104)) then ! V sigma 0 + xsec18=0.995 ! lowest sigma level + elseif ((parCat.eq.2).and.(parNum.eq.3).and.(typSfc.eq.104)) then ! V sigma 0 isec1(6)=34 ! indicatorOfParameter isec1(7)=107 ! indicatorOfTypeOfLevel isec1(8)=0.995 ! lowest sigma level !LB: isec1 is an integer array!!! - elseif ((parCat.eq.3).and.(parNum.eq.5).and.(typSurf.eq.1)) then ! TOPO + xsec18=0.995 ! lowest sigma level + elseif ((parCat.eq.3).and.(parNum.eq.5).and.(typSfc.eq.1)) then ! TOPO isec1(6)=7 ! indicatorOfParameter isec1(7)=1 ! indicatorOfTypeOfLevel isec1(8)=0 - elseif ((parCat.eq.0).and.(parNum.eq.0).and.(typSurf.eq.1) & + xsec18=real(0) + elseif ((parCat.eq.0).and.(parNum.eq.0).and.(typSfc.eq.1) & .and.(discipl.eq.2)) then ! LSM isec1(6)=81 ! indicatorOfParameter isec1(7)=1 ! indicatorOfTypeOfLevel isec1(8)=0 - elseif ((parCat.eq.3).and.(parNum.eq.196).and.(typSurf.eq.1)) then ! BLH + xsec18=real(0) + elseif ((parCat.eq.3).and.(parNum.eq.196).and.(typSfc.eq.1)) then ! BLH isec1(6)=221 ! indicatorOfParameter isec1(7)=1 ! indicatorOfTypeOfLevel isec1(8)=0 - elseif ((parCat.eq.1).and.(parNum.eq.7).and.(typSurf.eq.1)) then ! LSP/TP + xsec18=real(0) + elseif ((parCat.eq.1).and.(parNum.eq.7).and.(typSfc.eq.1)) then ! LSP/TP isec1(6)=62 ! indicatorOfParameter isec1(7)=1 ! indicatorOfTypeOfLevel isec1(8)=0 - elseif ((parCat.eq.1).and.(parNum.eq.196).and.(typSurf.eq.1)) then ! CP + xsec18=real(0) + elseif ((parCat.eq.1).and.(parNum.eq.196).and.(typSfc.eq.1)) then ! CP isec1(6)=63 ! indicatorOfParameter isec1(7)=1 ! indicatorOfTypeOfLevel isec1(8)=0 + xsec18=real(0) endif endif ! gribVer @@ -2829,7 +2973,11 @@ subroutine readwind_gfs(indj,n,uuh,vvh,wwh) if(isec2(2).ne.nxfield) error stop 'READWIND: NX NOT CONSISTENT' if(isec2(3).ne.ny) error stop 'READWIND: NY NOT CONSISTENT' - if(xaux.eq.0.) xaux=-179.0 ! NCEP DATA + ! if(xaux.eq.0.) xaux=-179.0 ! NCEP DATA + ! IPfixgfs11: revert to working v10.4 settings + + if(xaux.eq.0.) xaux=-180.0 ! NCEP DATA + xaux0=xlon0 yaux0=ylat0 if(xaux.lt.0.) xaux=xaux+360. @@ -2837,9 +2985,9 @@ subroutine readwind_gfs(indj,n,uuh,vvh,wwh) if(xaux0.lt.0.) xaux0=xaux0+360. if(yaux0.lt.0.) yaux0=yaux0+360. if(abs(xaux-xaux0).gt.eps) & - error stop 'READWIND: LOWER LEFT LONGITUDE NOT CONSISTENT' + error stop 'READWIND GFS: LOWER LEFT LONGITUDE NOT CONSISTENT' if(abs(yaux-yaux0).gt.eps) & - error stop 'READWIND: LOWER LEFT LATITUDE NOT CONSISTENT' + error stop 'READWIND GFS: LOWER LEFT LATITUDE NOT CONSISTENT' endif !HSO end of edits @@ -2849,7 +2997,7 @@ subroutine readwind_gfs(indj,n,uuh,vvh,wwh) allocate( zsec4(size1),stat=stat ) if (stat.ne.0) error stop "Could not allocate zsec4" call grib_get_real4_array(igrib,'values',zsec4,iret) - ! call grib_check(iret,gribFunction,gribErrorMsg) + call grib_check(iret,gribFunction,gribErrorMsg) endif i179=nint(179./dx) @@ -2860,19 +3008,34 @@ subroutine readwind_gfs(indj,n,uuh,vvh,wwh) endif i181=i180+1 + ! IPfixgfs11: revert to v10.4 working settings + i180=nint(180./dx) + i181=i180 + i179=i180 + + if (isec1(6).ne.-1) then + do j=0,nymin1 do i=0,nxfield-1 if((isec1(6).eq.011).and.(isec1(7).eq.100)) then ! TEMPERATURE if((i.eq.0).and.(j.eq.0)) then - do ii=1,nuvz - if ((isec1(8)*100.0).eq.akz(ii)) numpt=ii - end do + !do ii=1,nuvz + ! if ((isec1(8)*100.0).eq.akz(ii)) numpt=ii + !end do + numpt=minloc(abs(xsec18*100.0-akz),dim=1) ! IP 29.1.24 + ! IPfixgfs11 + ! numpt was const 1, and akzs were from not initialized allocation endif help=zsec4(nxfield*(ny-j-1)+i+1) - if(i.le.i180) then + if (help.le.0) then + write (*, *) 'i, j: ', i, j + stop 'help <= 0.0 from zsec4' + endif +! if(i.le.i180) then ! 1==180 fills missing 0 lines in tth + if(i.lt.i180) then tth(i179+i,j,numpt,n)=help else tth(i-i181,j,numpt,n)=help @@ -2881,12 +3044,13 @@ subroutine readwind_gfs(indj,n,uuh,vvh,wwh) if((isec1(6).eq.033).and.(isec1(7).eq.100)) then ! U VELOCITY if((i.eq.0).and.(j.eq.0)) then - do ii=1,nuvz - if ((isec1(8)*100.0).eq.akz(ii)) numpu=ii - end do + ! do ii=1,nuvz + ! if ((isec1(8)*100.0).eq.akz(ii)) numpu=ii + ! end do + numpu=minloc(abs(xsec18*100.0-akz),dim=1) endif help=zsec4(nxfield*(ny-j-1)+i+1) - if(i.le.i180) then + if(i.lt.i180) then uuh(i179+i,j,numpu)=help else uuh(i-i181,j,numpu)=help @@ -2895,12 +3059,13 @@ subroutine readwind_gfs(indj,n,uuh,vvh,wwh) if((isec1(6).eq.034).and.(isec1(7).eq.100)) then ! V VELOCITY if((i.eq.0).and.(j.eq.0)) then - do ii=1,nuvz - if ((isec1(8)*100.0).eq.akz(ii)) numpv=ii - end do + !do ii=1,nuvz + ! if ((isec1(8)*100.0).eq.akz(ii)) numpv=ii + !end do + numpv=minloc(abs(xsec18*100.0-akz),dim=1) endif help=zsec4(nxfield*(ny-j-1)+i+1) - if(i.le.i180) then + if(i.lt.i180) then vvh(i179+i,j,numpv)=help else vvh(i-i181,j,numpv)=help @@ -2909,12 +3074,14 @@ subroutine readwind_gfs(indj,n,uuh,vvh,wwh) if((isec1(6).eq.052).and.(isec1(7).eq.100)) then ! RELATIVE HUMIDITY -> CONVERT TO SPECIFIC HUMIDITY LATER if((i.eq.0).and.(j.eq.0)) then - do ii=1,nuvz - if ((isec1(8)*100.0).eq.akz(ii)) numprh=ii - end do +! do ii=1,nuvz +! if ((isec1(8)*100.0).eq.akz(ii)) numprh=ii +! end do + numprh=minloc(abs(xsec18*100.0-akz),dim=1) + endif help=zsec4(nxfield*(ny-j-1)+i+1) - if(i.le.i180) then + if(i.lt.i180) then qvh(i179+i,j,numprh,n)=help else qvh(i-i181,j,numprh,n)=help @@ -2923,7 +3090,7 @@ subroutine readwind_gfs(indj,n,uuh,vvh,wwh) if((isec1(6).eq.001).and.(isec1(7).eq.001)) then ! SURFACE PRESSURE help=zsec4(nxfield*(ny-j-1)+i+1) - if(i.le.i180) then + if(i.lt.i180) then ps(i179+i,j,1,n)=help else ps(i-i181,j,1,n)=help @@ -2931,13 +3098,15 @@ subroutine readwind_gfs(indj,n,uuh,vvh,wwh) endif if((isec1(6).eq.039).and.(isec1(7).eq.100)) then ! W VELOCITY - if((i.eq.0).and.(j.eq.0)) then - do ii=1,nuvz - if ((isec1(8)*100.0).eq.akz(ii)) numpw=ii - end do - endif +! if((i.eq.0).and.(j.eq.0)) then +! do ii=1,nuvz +! if ((isec1(8)*100.0).eq.akz(ii)) numpw=ii +! end do +! endif + if((i.eq.0).and.(j.eq.0)) numpw=minloc(abs(xsec18*100.0-akz),dim=1) + help=zsec4(nxfield*(ny-j-1)+i+1) - if(i.le.i180) then + if(i.lt.i180) then wwh(i179+i,j,numpw)=help else wwh(i-i181,j,numpw)=help @@ -2946,7 +3115,7 @@ subroutine readwind_gfs(indj,n,uuh,vvh,wwh) if((isec1(6).eq.066).and.(isec1(7).eq.001)) then ! SNOW DEPTH help=zsec4(nxfield*(ny-j-1)+i+1) - if(i.le.i180) then + if(i.lt.i180) then sd(i179+i,j,1,n)=help else sd(i-i181,j,1,n)=help @@ -2955,7 +3124,7 @@ subroutine readwind_gfs(indj,n,uuh,vvh,wwh) if((isec1(6).eq.002).and.(isec1(7).eq.102)) then ! MEAN SEA LEVEL PRESSURE help=zsec4(nxfield*(ny-j-1)+i+1) - if(i.le.i180) then + if(i.lt.i180) then msl(i179+i,j,1,n)=help else msl(i-i181,j,1,n)=help @@ -2964,47 +3133,56 @@ subroutine readwind_gfs(indj,n,uuh,vvh,wwh) if((isec1(6).eq.071).and.(isec1(7).eq.244)) then ! TOTAL CLOUD COVER help=zsec4(nxfield*(ny-j-1)+i+1) - if(i.le.i180) then + if(i.lt.i180) then tcc(i179+i,j,1,n)=help else tcc(i-i181,j,1,n)=help endif endif if((isec1(6).eq.033).and.(isec1(7).eq.105).and. & - (isec1(8).eq.10)) then + (nint(xsec18).eq.10)) then +! (isec1(8).eq.10)) then + + ! 10 M U VELOCITY help=zsec4(nxfield*(ny-j-1)+i+1) - if(i.le.i180) then + if(i.lt.i180) then u10(i179+i,j,1,n)=help else u10(i-i181,j,1,n)=help endif endif if((isec1(6).eq.034).and.(isec1(7).eq.105).and. & - (isec1(8).eq.10)) then + (nint(xsec18).eq.10)) then +! (isec1(8).eq.10)) then + ! 10 M V VELOCITY help=zsec4(nxfield*(ny-j-1)+i+1) - if(i.le.i180) then + if(i.lt.i180) then v10(i179+i,j,1,n)=help else v10(i-i181,j,1,n)=help endif endif if((isec1(6).eq.011).and.(isec1(7).eq.105).and. & - (isec1(8).eq.02)) then + (nint(xsec18).eq.2)) then +! (isec1(8).eq.02)) then + ! 2 M TEMPERATURE help=zsec4(nxfield*(ny-j-1)+i+1) - if(i.le.i180) then + if(i.lt.i180) then tt2(i179+i,j,1,n)=help else tt2(i-i181,j,1,n)=help endif endif if((isec1(6).eq.017).and.(isec1(7).eq.105).and. & - (isec1(8).eq.02)) then + (nint(xsec18).eq.2)) then + ! (isec1(8).eq.02)) then + ! 2 M DEW POINT TEMPERATURE help=zsec4(nxfield*(ny-j-1)+i+1) - if(i.le.i180) then + if(i.lt.i180) then td2(i179+i,j,1,n)=help else td2(i-i181,j,1,n)=help @@ -3013,25 +3191,25 @@ subroutine readwind_gfs(indj,n,uuh,vvh,wwh) if((isec1(6).eq.062).and.(isec1(7).eq.001)) then ! LARGE SCALE PREC. help=zsec4(nxfield*(ny-j-1)+i+1) - if(i.le.i180) then - lsprec(i179+i,j,1,n)=help + if(i.lt.i180) then + lsprec(i179+i,j,1,1,n)=help else - lsprec(i-i181,j,1,n)=help + lsprec(i-i181,j,1,1,n)=help endif endif if((isec1(6).eq.063).and.(isec1(7).eq.001)) then ! CONVECTIVE PREC. help=zsec4(nxfield*(ny-j-1)+i+1) - if(i.le.i180) then - convprec(i179+i,j,1,n)=help + if(i.lt.i180) then + convprec(i179+i,j,1,1,n)=help else - convprec(i-i181,j,1,n)=help + convprec(i-i181,j,1,1,n)=help endif endif if((isec1(6).eq.007).and.(isec1(7).eq.001)) then ! TOPOGRAPHY help=zsec4(nxfield*(ny-j-1)+i+1) - if(i.le.i180) then + if(i.lt.i180) then oro(i179+i,j)=help excessoro(i179+i,j)=0.0 ! ISOBARIC SURFACES: SUBGRID TERRAIN DISREGARDED else @@ -3042,7 +3220,7 @@ subroutine readwind_gfs(indj,n,uuh,vvh,wwh) if((isec1(6).eq.081).and.(isec1(7).eq.001)) then ! LAND SEA MASK help=zsec4(nxfield*(ny-j-1)+i+1) - if(i.le.i180) then + if(i.lt.i180) then lsm(i179+i,j)=help else lsm(i-i181,j)=help @@ -3051,7 +3229,7 @@ subroutine readwind_gfs(indj,n,uuh,vvh,wwh) if((isec1(6).eq.221).and.(isec1(7).eq.001)) then ! MIXING HEIGHT help=zsec4(nxfield*(ny-j-1)+i+1) - if(i.le.i180) then + if(i.lt.i180) then hmix(i179+i,j,1,n)=help else hmix(i-i181,j,1,n)=help @@ -3061,7 +3239,7 @@ subroutine readwind_gfs(indj,n,uuh,vvh,wwh) (isec1(8).eq.02)) then ! 2 M RELATIVE HUMIDITY help=zsec4(nxfield*(ny-j-1)+i+1) - if(i.le.i180) then + if(i.lt.i180) then qvh2(i179+i,j)=help else qvh2(i-i181,j)=help @@ -3070,7 +3248,7 @@ subroutine readwind_gfs(indj,n,uuh,vvh,wwh) if((isec1(6).eq.011).and.(isec1(7).eq.107)) then ! TEMPERATURE LOWEST SIGMA LEVEL help=zsec4(nxfield*(ny-j-1)+i+1) - if(i.le.i180) then + if(i.lt.i180) then tlev1(i179+i,j)=help else tlev1(i-i181,j)=help @@ -3079,7 +3257,7 @@ subroutine readwind_gfs(indj,n,uuh,vvh,wwh) if((isec1(6).eq.033).and.(isec1(7).eq.107)) then ! U VELOCITY LOWEST SIGMA LEVEL help=zsec4(nxfield*(ny-j-1)+i+1) - if(i.le.i180) then + if(i.lt.i180) then ulev1(i179+i,j)=help else ulev1(i-i181,j)=help @@ -3088,7 +3266,7 @@ subroutine readwind_gfs(indj,n,uuh,vvh,wwh) if((isec1(6).eq.034).and.(isec1(7).eq.107)) then ! V VELOCITY LOWEST SIGMA LEVEL help=zsec4(nxfield*(ny-j-1)+i+1) - if(i.le.i180) then + if(i.lt.i180) then vlev1(i179+i,j)=help else vlev1(i-i181,j)=help @@ -3097,20 +3275,19 @@ subroutine readwind_gfs(indj,n,uuh,vvh,wwh) ! SEC & IP 12/2018 read GFS clouds if((isec1(6).eq.153).and.(isec1(7).eq.100)) then !! CLWCR Cloud liquid water content [kg/kg] if((i.eq.0).and.(j.eq.0)) then - do ii=1,nuvz - if ((isec1(8)*100.0).eq.akz(ii)) numpclwch=ii - end do + ! do ii=1,nuvz + !1 if ((isec1(8)*100.0).eq.akz(ii)) numpclwch=ii + ! end do + numpclwch=minloc(abs(xsec18*100.0-akz),dim=1) endif help=zsec4(nxfield*(ny-j-1)+i+1) - if(i.le.i180) then + if(i.lt.i180) then clwch(i179+i,j,numpclwch,n)=help else clwch(i-i181,j,numpclwch,n)=help endif - readclouds=.true. - sumclouds=.true. - ! readclouds=.false. - ! sumclouds=.false. + lcw=.true. + lcwsum=.true. endif @@ -3126,7 +3303,7 @@ subroutine readwind_gfs(indj,n,uuh,vvh,wwh) call grib_release(igrib) - deallocate( zsec4 ) + if (isec1(6).ne.-1) deallocate( zsec4 ) !IP 28/11/23 fix deallocation error end do !! READ NEXT LEVEL OR PARAMETER ! ! CLOSING OF INPUT DATA FILE @@ -3134,7 +3311,7 @@ subroutine readwind_gfs(indj,n,uuh,vvh,wwh) !HSO close grib file call grib_close_file(ifile) - + ! SENS. HEAT FLUX sshf(:,:,1,n)=0.0 ! not available from gfs.tccz.pgrbfxx files hflswitch=.false. ! Heat flux not available @@ -3151,18 +3328,18 @@ subroutine readwind_gfs(indj,n,uuh,vvh,wwh) do j=0,nymin1 do i=0,nxfield-1 if(i.le.i180) then - if (convprec(i179+i,j,1,n).lt.lsprec(i179+i,j,1,n)) then ! neg precip would occur - lsprec(i179+i,j,1,n)= & - lsprec(i179+i,j,1,n)-convprec(i179+i,j,1,n) + if (convprec(i179+i,j,1,1,n).lt.lsprec(i179+i,j,1,1,n)) then ! neg precip would occur + lsprec(i179+i,j,1,1,n)= & + lsprec(i179+i,j,1,1,n)-convprec(i179+i,j,1,1,n) else - lsprec(i179+i,j,1,n)=0 + lsprec(i179+i,j,1,1,n)=0 endif else - if (convprec(i-i181,j,1,n).lt.lsprec(i-i181,j,1,n)) then - lsprec(i-i181,j,1,n)= & - lsprec(i-i181,j,1,n)-convprec(i-i181,j,1,n) + if (convprec(i-i181,j,1,1,n).lt.lsprec(i-i181,j,1,1,n)) then + lsprec(i-i181,j,1,1,n)= & + lsprec(i-i181,j,1,1,n)-convprec(i-i181,j,1,1,n) else - lsprec(i-i181,j,1,n)=0 + lsprec(i-i181,j,1,1,n)=0 endif endif enddo @@ -3178,7 +3355,15 @@ subroutine readwind_gfs(indj,n,uuh,vvh,wwh) do k=1,nuvz help=qvh(i,j,k,n) temp=tth(i,j,k,n) + if (temp .le. 0.0) then + write (*, *) 'STOP: TRANSFORM RH TO SPECIFIC HUMIDITY: temp, i, j, k, n' + write (*, *) temp, i, j, k, n +! temp = 273.0 + stop + endif + plev1=akm(k)+bkm(k)*ps(i,j,1,n) + !print*, temp,plev1 elev=ew(temp,plev1)*help/100.0 qvh(i,j,k,n)=xmwml*(elev/(plev1-((1.0-xmwml)*elev))) end do @@ -3188,11 +3373,18 @@ subroutine readwind_gfs(indj,n,uuh,vvh,wwh) ! CALCULATE 2 M DEW POINT FROM 2 M RELATIVE HUMIDITY ! USING BOLTON'S (1980) FORMULA ! BECAUSE td2 IS NOT AVAILABLE FROM NCEP GFS DATA - + k=2 ! CHECK THIS!!! do j=0,ny-1 do i=0,nxfield-1 help=qvh2(i,j) temp=tt2(i,j,1,n) + if (temp .le. 0.0) then + write (*, *) 'STOP: CALCULATE 2 M DEW POINT FROM 2 M RELATIVE HUMIDITY: temp, i, j, k, n' + write (*, *) temp, i, j, k, n +! temp = 273.0 + stop + endif + plev1=akm(k)+bkm(k)*ps(i,j,1,n) elev=ew(temp,plev1)/100.*help/100. !vapour pressure in hPa td2(i,j,1,n)=243.5/(17.67/log(elev/6.112)-1)+273. @@ -3232,8 +3424,10 @@ subroutine readwind_gfs(indj,n,uuh,vvh,wwh) call shift_field(v10,nxfield,ny,1,1,2,n) call shift_field(tt2,nxfield,ny,1,1,2,n) call shift_field(td2,nxfield,ny,1,1,2,n) - call shift_field(lsprec,nxfield,ny,1,1,2,n) - call shift_field(convprec,nxfield,ny,1,1,2,n) + do ipf=1,numpf + call shift_field(lsprec(:,:,:,ipf,n),nxfield,ny,1,1,1,1) + call shift_field(convprec(:,:,:,ipf,n),nxfield,ny,1,1,1,1) + enddo call shift_field(sshf,nxfield,ny,1,1,2,n) call shift_field(ssr,nxfield,ny,1,1,2,n) call shift_field(hmix,nxfield,ny,1,1,2,n) @@ -3249,8 +3443,8 @@ subroutine readwind_gfs(indj,n,uuh,vvh,wwh) do i=0,nxmin1 do j=0,nymin1 ! Convert precip. from mm/s -> mm/hour - convprec(i,j,1,n)=convprec(i,j,1,n)*3600. - lsprec(i,j,1,n)=lsprec(i,j,1,n)*3600. + convprec(i,j,1,1,n)=convprec(i,j,1,1,n)*3600. + lsprec(i,j,1,1,n)=lsprec(i,j,1,1,n)*3600. sfcstress(i,j,1,n)=sqrt(ewss(i,j)**2+nsss(i,j)**2) end do end do @@ -3262,8 +3456,8 @@ subroutine readwind_gfs(indj,n,uuh,vvh,wwh) ! CALCULATE USTAR AND SSHF USING THE PROFILE METHOD !*************************************************************************** - do i=0,nxmin1 - do j=0,nymin1 + do j=0,nymin1 + do i=0,nxmin1 hlev1=30.0 ! HEIGHT OF FIRST MODEL SIGMA LAYER ff10m= sqrt(u10(i,j,1,n)**2+v10(i,j,1,n)**2) fflev1=sqrt(ulev1(i,j)**2+vlev1(i,j)**2) @@ -3280,6 +3474,14 @@ subroutine readwind_gfs(indj,n,uuh,vvh,wwh) if(iumax.ne.nwz) error stop 'READWIND: NWZ NOT CONSISTENT' return + +777 continue + write(*,*) ' #### FLEXPART MODEL ERROR! ####' + write(*,*) ' #### Additional precip fields not implemented in ####' + write(*,*) ' #### GFS version ####' + write(*,*) ' #### Set numpf=1 in par_mod.f90 and recompile! ####' + stop 'Execution terminated' + 888 write(*,*) ' #### FLEXPART MODEL ERROR! WINDFIELD #### ' write(*,*) ' #### ',wfname(indj),' #### ' write(*,*) ' #### IS NOT GRIB FORMAT !!! #### ' @@ -3288,7 +3490,7 @@ subroutine readwind_gfs(indj,n,uuh,vvh,wwh) end subroutine readwind_gfs subroutine readwind_nest(indj,n,uuhn,vvhn,wwhn) - ! i i o o o + ! i i o o o !***************************************************************************** ! * ! This routine reads the wind fields for the nested model domains. * @@ -3300,6 +3502,11 @@ subroutine readwind_nest(indj,n,uuhn,vvhn,wwhn) ! * ! Last update: 17 October 2000, A. Stohl * ! * + ! * + ! Anne Tipka, Petra Seibert 2021-02: implement new interpolation * + ! for precipitation according to #295 using 2 additional fields * + ! change some double loops in wrong order to forall constructs * + ! * !***************************************************************************** ! Changes, Bernd C. Krueger, Feb. 2001: * ! Variables tthn and qvhn (on eta coordinates) in common block * @@ -3311,47 +3518,46 @@ subroutine readwind_nest(indj,n,uuhn,vvhn,wwhn) implicit none - !HSO parameters for grib_api integer :: ifile integer :: iret,size1,stat integer :: igrib - integer :: gribVer,parCat,parNum,typSurf,valSurf,discipl - integer :: parId !!added by mc for making it consistent with new readwind.f90 + integer :: istep, ipf, npf ! istep=stepRange for precip field identification + integer :: gribVer,parCat,parNum,typSfc,discipl,parId integer :: gotGrid - !HSO end - real :: uuhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,numbnests) - real :: vvhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,numbnests) - real :: wwhn(0:nxmaxn-1,0:nymaxn-1,nwzmax,numbnests) - integer :: indj,i,j,k,n,levdiff2,ifield,iumax,iwmax,l + real :: uuhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests) + real :: vvhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests) + real :: wwhn(0:nxmaxn-1,0:nymaxn-1,nwzmax,maxnests) + integer :: indj,i,j,l,n,ifield,iumax,iwmax ! VARIABLES AND ARRAYS NEEDED FOR GRIB DECODING - ! dimension of isec2 at least (22+n), where n is the number of parallels or - ! meridians in a quasi-regular (reduced) Gaussian or lat/long grid - - ! dimension of zsec2 at least (10+nn), where nn is the number of vertical - ! coordinate parameters - - integer :: isec1(56),isec2(3) real(kind=4),allocatable,dimension(:) :: zsec4 + ! PS replace isec1, isec2 arrays by scalar values because we don't need + ! arrays anymore. isec1(X) -> isX, isec2(X) -> jsX + integer :: is6, js2, js3, js12 + integer :: k ! (as k, is the level in ECWMF notation, top->bot) + integer :: kz, kz1 ! (level in FLEXPART notation, bot->top) + integer :: jy ! y index in FLEXPART notation (S->N) + integer :: ij ! 2D index unrolled to 1D + real(kind=4) :: xaux,yaux real(kind=8) :: xauxin,yauxin - real,parameter :: eps=1.e-4 + real(kind=4),parameter :: eps=1.e-4 + real :: ewss(0:nxmaxn-1,0:nymaxn-1),nsss(0:nxmaxn-1,0:nymaxn-1) real :: plev1,pmean,tv,fu,hlev1,ff10m,fflev1 - real :: conversion_factor !added by mc to make it consistent with new gridchek.f90 + real :: conversion_factor logical :: hflswitch,strswitch !HSO grib api error messages character(len=24) :: gribErrorMsg = 'Error reading grib file' - character(len=20) :: gribFunction = 'readwind_nest' + character(len=20) :: thisSubr = 'readwind_nest' - do l=1,numbnests + l_loop: do l=1,numbnests hflswitch=.false. strswitch=.false. - levdiff2=nlev_ec-nwz+1 iumax=0 iwmax=0 @@ -3359,20 +3565,18 @@ subroutine readwind_nest(indj,n,uuhn,vvhn,wwhn) igrib=0 iret=0 - ! - ! OPENING OF DATA FILE (GRIB CODE) - ! - + ! + ! OPENING OF DATA FILE (GRIB CODE) + ! call grib_open_file(ifile,path(numpath+2*(l-1)+1) & (1:length(numpath+2*(l-1)+1))//trim(wfnamen(l,indj)),'r') - if (iret.ne.GRIB_SUCCESS) then - goto 888 ! ERROR DETECTED - endif + if (iret .ne. GRIB_SUCCESS) goto 888 ! ERROR DETECTED !turn on support for multi fields messages */ !call grib_multi_support_on gotGrid=0 ifield=0 + do ifield=ifield+1 ! @@ -3387,255 +3591,246 @@ subroutine readwind_nest(indj,n,uuhn,vvhn,wwhn) !first see if we read GRIB1 or GRIB2 call grib_get_int(igrib,'editionNumber',gribVer,iret) - call grib_check(iret,gribFunction,gribErrorMsg) + call grib_check(iret,thisSubr,gribErrorMsg) - if (gribVer.eq.1) then ! GRIB Edition 1 + ! AT stepRange is used to identify additional precip fields + call grib_get_int(igrib,'stepRange',istep,iret) + call grib_check(iret,thisSubr,gribErrorMsg) + ipf=istep+1 - !print*,'GRiB Edition 1' - !read the grib2 identifiers - call grib_get_int(igrib,'indicatorOfParameter',isec1(6),iret) - call grib_check(iret,gribFunction,gribErrorMsg) - call grib_get_int(igrib,'level',isec1(8),iret) - call grib_check(iret,gribFunction,gribErrorMsg) + if (gribVer.eq.1) then ! GRIB Edition 1 - !change code for etadot to code for omega - if (isec1(6).eq.77) then - isec1(6)=135 - endif + call grib_get_int(igrib,'indicatorOfParameter',is6,iret) + call grib_check(iret,thisSubr,gribErrorMsg) + + call grib_get_int(igrib,'level',k,iret) + call grib_check(iret,thisSubr,gribErrorMsg) + ! change code for etadot to code for omega + if (is6 .eq. 77) is6=135 conversion_factor=1. + else ! GRIB Edition 2 - else - - !print*,'GRiB Edition 2' - !read the grib2 identifiers call grib_get_int(igrib,'discipline',discipl,iret) - call grib_check(iret,gribFunction,gribErrorMsg) + call grib_check(iret,thisSubr,gribErrorMsg) + call grib_get_int(igrib,'parameterCategory',parCat,iret) - call grib_check(iret,gribFunction,gribErrorMsg) + call grib_check(iret,thisSubr,gribErrorMsg) + call grib_get_int(igrib,'parameterNumber',parNum,iret) - call grib_check(iret,gribFunction,gribErrorMsg) - call grib_get_int(igrib,'typeOfFirstFixedSurface',typSurf,iret) - call grib_check(iret,gribFunction,gribErrorMsg) - call grib_get_int(igrib,'level',valSurf,iret) - call grib_check(iret,gribFunction,gribErrorMsg) - call grib_get_int(igrib,'paramId',parId,iret) !added by mc to make it consisitent with new readwind.f90 - call grib_check(iret,gribFunction,gribErrorMsg) !added by mc to make it consisitent with new readwind.f90 + call grib_check(iret,thisSubr,gribErrorMsg) - !print*,discipl,parCat,parNum,typSurf,valSurf + call grib_get_int(igrib,'typeOfFirstFixedSurface',typSfc,iret) + call grib_check(iret,thisSubr,gribErrorMsg) + + call grib_get_int(igrib,'level',k,iret) + call grib_check(iret,thisSubr,gribErrorMsg) + + call grib_get_int(igrib,'paramId',parId,iret) + call grib_check(iret,thisSubr,gribErrorMsg) !convert to grib1 identifiers - isec1(6)=-1 - isec1(7)=-1 - isec1(8)=-1 - isec1(8)=valSurf ! level + is6=-1 conversion_factor=1. - if ((parCat.eq.0).and.(parNum.eq.0).and.(typSurf.eq.105)) then ! T - isec1(6)=130 ! indicatorOfParameter - elseif ((parCat.eq.2).and.(parNum.eq.2).and.(typSurf.eq.105)) then ! U - isec1(6)=131 ! indicatorOfParameter - elseif ((parCat.eq.2).and.(parNum.eq.3).and.(typSurf.eq.105)) then ! V - isec1(6)=132 ! indicatorOfParameter - elseif ((parCat.eq.1).and.(parNum.eq.0).and.(typSurf.eq.105)) then ! Q - isec1(6)=133 ! indicatorOfParameter + if (parCat .eq. 0 .and. parNum .eq. 0 .and. typSfc .eq. 105) then ! T + is6=130 + elseif (parCat .eq. 2 .and. parNum .eq. 2 .and. typSfc .eq. 105) then ! U + is6=131 + elseif (parCat .eq. 2 .and. parNum .eq. 3 .and. typSfc .eq. 105) then ! V + is6=132 + elseif (parCat .eq. 1 .and. parNum .eq. 0 .and. typSfc .eq. 105) then ! Q + is6=133 ! ESO Cloud water is in a) fields CLWC and CIWC, *or* b) field QC - elseif ((parCat.eq.1).and.(parNum.eq.83).and.(typSurf.eq.105)) then ! clwc - isec1(6)=246 ! indicatorOfParameter - elseif ((parCat.eq.1).and.(parNum.eq.84).and.(typSurf.eq.105)) then ! ciwc - isec1(6)=247 ! indicatorOfParameter + elseif (parCat .eq. 1 .and. parNum .eq. 83 .and. typSfc .eq. 105) then ! clwc + is6=246 + elseif (parCat .eq. 1 .and. parNum .eq. 84 .and. typSfc .eq. 105) then ! ciwc + is6=247 ! ESO qc(=clwc+ciwc): - elseif ((parCat.eq.201).and.(parNum.eq.31).and.(typSurf.eq.105)) then ! qc - isec1(6)=201031 ! indicatorOfParameter - elseif ((parCat.eq.3).and.(parNum.eq.0).and.(typSurf.eq.1)) then !SP - isec1(6)=134 ! indicatorOfParameter - elseif ((parCat.eq.2).and.(parNum.eq.32)) then ! W, actually eta dot ! - isec1(6)=135 ! indicatorOfParameter - elseif ((parCat.eq.128).and.(parNum.eq.77)) then ! W, actually eta dot !added by mc to make it consisitent with new readwind.f90 - isec1(6)=135 ! indicatorOfParameter !added by mc to make it consisitent with new readwind.f90 - elseif ((parCat.eq.3).and.(parNum.eq.0).and.(typSurf.eq.101)) then !SLP - isec1(6)=151 ! indicatorOfParameter - elseif ((parCat.eq.2).and.(parNum.eq.2).and.(typSurf.eq.103)) then ! 10U - isec1(6)=165 ! indicatorOfParameter - elseif ((parCat.eq.2).and.(parNum.eq.3).and.(typSurf.eq.103)) then ! 10V - isec1(6)=166 ! indicatorOfParameter - elseif ((parCat.eq.0).and.(parNum.eq.0).and.(typSurf.eq.103)) then ! 2T - isec1(6)=167 ! indicatorOfParameter - elseif ((parCat.eq.0).and.(parNum.eq.6).and.(typSurf.eq.103)) then ! 2D - isec1(6)=168 ! indicatorOfParameter - elseif ((parCat.eq.1).and.(parNum.eq.11).and.(typSurf.eq.1)) then ! SD - isec1(6)=141 ! indicatorOfParameter - conversion_factor=1000. !added by mc to make it consisitent with new readwind.f90 - elseif ((parCat.eq.6).and.(parNum.eq.1) .or. parId .eq. 164) then ! CC !added by mc to make it consisitent with new readwind.f90 - isec1(6)=164 ! indicatorOfParameter - elseif ((parCat.eq.1).and.(parNum.eq.9) .or. parId .eq. 142) then ! LSP !added by mc to make it consisitent with new readwind.f90 - isec1(6)=142 ! indicatorOfParameter - elseif ((parCat.eq.1).and.(parNum.eq.10)) then ! CP - isec1(6)=143 ! indicatorOfParameter - conversion_factor=1000. !added by mc to make it consisitent with new readwind.f90 - elseif ((parCat.eq.0).and.(parNum.eq.11).and.(typSurf.eq.1)) then ! SHF - isec1(6)=146 ! indicatorOfParameter - elseif ((parCat.eq.4).and.(parNum.eq.9).and.(typSurf.eq.1)) then ! SR - isec1(6)=176 ! indicatorOfParameter - elseif ((parCat.eq.2).and.(parNum.eq.38) .or. parId .eq. 180) then ! EWSS !added by mc to make it consisitent with new readwind.f90 - isec1(6)=180 ! indicatorOfParameter - elseif ((parCat.eq.2).and.(parNum.eq.37) .or. parId .eq. 181) then ! NSSS !added by mc to make it consisitent with new readwind.f90 - isec1(6)=181 ! indicatorOfParameter - elseif ((parCat.eq.3).and.(parNum.eq.4)) then ! ORO - isec1(6)=129 ! indicatorOfParameter - elseif ((parCat.eq.3).and.(parNum.eq.7) .or. parId .eq. 160) then ! SDO !added by mc to make it consisitent with new readwind.f90 - isec1(6)=160 ! indicatorOfParameter - elseif ((discipl.eq.2).and.(parCat.eq.0).and.(parNum.eq.0).and. & - (typSurf.eq.1)) then ! LSM - isec1(6)=172 ! indicatorOfParameter - elseif (parNum.eq.152) then - isec1(6)=152 ! avoid warning for lnsp + elseif (parCat .eq. 201 .and. parNum .eq. 31 .and. typSfc .eq. 105) then ! qc + is6=201031 + elseif (parCat .eq. 3 .and. parNum .eq. 0 .and. typSfc .eq. 1) then !SP + is6=134 + elseif (parCat .eq. 2 .and. parNum .eq. 32) then ! W, actually eta dot + is6=135 + elseif (parCat .eq. 128 .and. parNum .eq. 77) then ! W, actually eta dot + is6=135 + elseif (parCat .eq. 3 .and. parNum .eq. 0 .and. typSfc .eq. 101) then ! SLP + is6=151 + elseif (parCat .eq. 2 .and. parNum .eq. 2 .and. typSfc .eq. 103) then ! 10U + is6=165 + elseif (parCat .eq. 2 .and. parNum .eq. 3 .and. typSfc .eq. 103) then ! 10V + is6=166 + elseif (parCat .eq. 0 .and. parNum .eq. 0 .and. typSfc .eq. 103) then ! 2T + is6=167 + elseif (parCat .eq. 0 .and. parNum .eq. 6 .and. typSfc .eq. 103) then ! 2D + is6=168 + elseif (parCat .eq. 1 .and. parNum .eq. 11 .and. typSfc .eq. 1) then ! SD + is6=141 + conversion_factor=1000. + elseif (parCat .eq. 6 .and. parNum .eq. 1 .or. parId .eq. 164) then ! CC + is6=164 + elseif (parCat .eq. 1 .and. parNum .eq. 9 .or. parId .eq. 142) then ! LSP + is6=142 + elseif (parCat .eq. 1 .and. parNum .eq. 10) then ! CP + is6=143 + conversion_factor=1000. + elseif (parCat .eq. 0 .and. parNum .eq. 11 .and. typSfc .eq. 1) then ! SHF + is6=146 + elseif (parCat .eq. 4 .and. parNum .eq. 9 .and. typSfc .eq. 1) then ! SR + is6=176 + elseif (parCat .eq. 2 .and. parNum .eq. 38 .or. parId .eq. 180) then ! EWSS --correct + is6=180 + elseif (parCat .eq. 2 .and. parNum .eq. 37 .or. parId .eq. 181) then ! NSSS --correct + is6=181 + elseif (parCat .eq. 3 .and. parNum .eq. 4) then ! ORO + is6=129 + elseif (parCat .eq. 3 .and. parNum .eq. 7 .or. parId .eq. 160) then ! SDO + is6=160 + elseif (discipl .eq. 2 .and. parCat .eq. 0 .and. parNum .eq. 0 .and. & + typSfc .eq. 1) then ! LSM + is6=172 + elseif (parNum .eq. 152) then + is6=152 ! avoid warning for lnsp else print*,'***WARNING: undefined GRiB2 message found!',discipl, & - parCat,parNum,typSurf - endif - if(parId .ne. isec1(6) .and. parId .ne. 77) then !added by mc to make it consisitent with new readwind.f90 - write(*,*) 'parId',parId, 'isec1(6)',isec1(6) ! - ! stop + parCat,parNum,typSfc endif + if (parId .ne. is6 .and. parId .ne. 77) & + write(*,*) 'parId',parId, 'is6',is6 - endif + endif ! grib Version conversion !HSO get the required fields from section 2 in a gribex compatible manner if(ifield.eq.1) then - call grib_get_int(igrib,'numberOfPointsAlongAParallel', & - isec2(1),iret) - call grib_check(iret,gribFunction,gribErrorMsg) - call grib_get_int(igrib,'numberOfPointsAlongAMeridian', & - isec2(2),iret) - call grib_check(iret,gribFunction,gribErrorMsg) - call grib_get_int(igrib,'numberOfVerticalCoordinateValues', & - isec2(3)) - call grib_check(iret,gribFunction,gribErrorMsg) + call grib_get_int(igrib,'numberOfPointsAlongAParallel',js2,iret) + call grib_check(iret,thisSubr,gribErrorMsg) + + call grib_get_int(igrib,'numberOfPointsAlongAMeridian',js3,iret) + call grib_check(iret,thisSubr,gribErrorMsg) + + call grib_get_int(igrib,'numberOfVerticalCoordinateValues',js12) + call grib_check(iret,thisSubr,gribErrorMsg) ! CHECK GRID SPECIFICATIONS - if(isec2(1).ne.nxn(l)) error stop & - 'READWIND: NX NOT CONSISTENT FOR A NESTING LEVEL' - if(isec2(2).ne.nyn(l)) error stop & - 'READWIND: NY NOT CONSISTENT FOR A NESTING LEVEL' - if(isec2(3)/2-1.ne.nlev_ec) error stop 'READWIND: VERTICAL DISCRET& - &IZATION NOT CONSISTENT FOR A NESTING LEVEL' + if (js2 .ne. nxn(l)) & + stop 'READWIND: NX NOT CONSISTENT FOR A NESTING LEVEL' + if (js3 .ne. nyn(l)) & + stop 'READWIND: NY NOT CONSISTENT FOR A NESTING LEVEL' + if (js12/2-1 .ne. nlev_ec) stop 'READWIND: VERTICAL DISCRETIZATION NOT& + &CONSISTENT FOR A NESTING LEVEL' endif ! ifield !HSO get the size and data of the values array - if (isec1(6).ne.-1) then + if (is6 .ne. -1) then call grib_get_size(igrib,'values',size1,iret) - call grib_check(iret,gribFunction,gribErrorMsg) + call grib_check(iret,thisSubr,gribErrorMsg) allocate(zsec4(size1), stat=stat) if (stat.ne.0) error stop "Could not allocate zsec4" + call grib_get_real4_array(igrib,'values',zsec4,iret) - call grib_check(iret,gribFunction,gribErrorMsg) + call grib_check(iret,thisSubr,gribErrorMsg) endif !HSO get the second part of the grid dimensions only from GRiB1 messages - if (isec1(6) .eq. 167 .and. (gotGrid.eq.0)) then ! !added by mc to make it consisitent with new readwind.f90 + if (is6 .eq. 167 .and. gotGrid .eq. 0) then + call grib_get_real8(igrib,'longitudeOfFirstGridPointInDegrees', & - xauxin,iret) - call grib_check(iret,gribFunction,gribErrorMsg) - call grib_get_real8(igrib,'latitudeOfLastGridPointInDegrees', & - yauxin,iret) - call grib_check(iret,gribFunction,gribErrorMsg) - if (xauxin.gt.180.) xauxin=xauxin-360.0 - if (xauxin.lt.-180.) xauxin=xauxin+360.0 - + xauxin,iret) + call grib_check(iret,thisSubr,gribErrorMsg) + + call grib_get_real8(igrib,'latitudeOfLastGridPointInDegrees',yauxin,iret) + call grib_check(iret,thisSubr,gribErrorMsg) + + if (xauxin .gt. 180.) xauxin=xauxin-360.0 + if (xauxin .lt. -180.) xauxin=xauxin+360.0 + xaux=real(xauxin) yaux=real(yauxin) + if (abs(xaux-xlon0n(l)).gt.eps) & - error stop 'READWIND: LOWER LEFT LONGITUDE NOT CONSISTENT FOR A NESTING LEVEL' + stop 'READWIND: LOWER LEFT LONGITUDE NOT CONSISTENT FOR A NESTING LEVEL' if (abs(yaux-ylat0n(l)).gt.eps) & - error stop 'READWIND: LOWER LEFT LATITUDE NOT CONSISTENT FOR A NESTING LEVEL' + stop 'READWIND: LOWER LEFT LATITUDE NOT CONSISTENT FOR A NESTING LEVEL' gotGrid=1 - endif + + endif ! gotGrid + + kz=nlev_ec-k+2 ! used for all 3D fields except W + kz1=nlev_ec-k+1 ! used for W do j=0,nyn(l)-1 + jy=nyn(l)-j-1 do i=0,nxn(l)-1 - k=isec1(8) - if(isec1(6).eq.130) tthn(i,j,nlev_ec-k+2,n,l)= &!! TEMPERATURE - zsec4(nxn(l)*(nyn(l)-j-1)+i+1) - if(isec1(6).eq.131) uuhn(i,j,nlev_ec-k+2,l)= &!! U VELOCITY - zsec4(nxn(l)*(nyn(l)-j-1)+i+1) - if(isec1(6).eq.132) vvhn(i,j,nlev_ec-k+2,l)= &!! V VELOCITY - zsec4(nxn(l)*(nyn(l)-j-1)+i+1) - if(isec1(6).eq.133) then !! SPEC. HUMIDITY - qvhn(i,j,nlev_ec-k+2,n,l)=zsec4(nxn(l)*(nyn(l)-j-1)+i+1) - if (qvhn(i,j,nlev_ec-k+2,n,l) .lt. 0.) & - qvhn(i,j,nlev_ec-k+2,n,l) = 0. - ! this is necessary because the gridded data may contain - ! spurious negative values - endif - if(isec1(6).eq.134) psn(i,j,1,n,l)= &!! SURF. PRESS. - zsec4(nxn(l)*(nyn(l)-j-1)+i+1) - if(isec1(6).eq.135) wwhn(i,j,nlev_ec-k+1,l)= &!! W VELOCITY - zsec4(nxn(l)*(nyn(l)-j-1)+i+1) - if(isec1(6).eq.141) sdn(i,j,1,n,l)= &!! SNOW DEPTH - zsec4(nxn(l)*(nyn(l)-j-1)+i+1)/conversion_factor !added by mc to make it consisitent with new readwind.f90! - if(isec1(6).eq.151) msln(i,j,1,n,l)= &!! SEA LEVEL PRESS. - zsec4(nxn(l)*(nyn(l)-j-1)+i+1) - if(isec1(6).eq.164) tccn(i,j,1,n,l)= &!! CLOUD COVER - zsec4(nxn(l)*(nyn(l)-j-1)+i+1) - if(isec1(6).eq.165) u10n(i,j,1,n,l)= &!! 10 M U VELOCITY - zsec4(nxn(l)*(nyn(l)-j-1)+i+1) - if(isec1(6).eq.166) v10n(i,j,1,n,l)= &!! 10 M V VELOCITY - zsec4(nxn(l)*(nyn(l)-j-1)+i+1) - if(isec1(6).eq.167) tt2n(i,j,1,n,l)= &!! 2 M TEMPERATURE - zsec4(nxn(l)*(nyn(l)-j-1)+i+1) - if(isec1(6).eq.168) td2n(i,j,1,n,l)= &!! 2 M DEW POINT - zsec4(nxn(l)*(nyn(l)-j-1)+i+1) - if(isec1(6).eq.142) then !! LARGE SCALE PREC. - lsprecn(i,j,1,n,l)=zsec4(nxn(l)*(nyn(l)-j-1)+i+1) - if (lsprecn(i,j,1,n,l).lt.0.) lsprecn(i,j,1,n,l)=0. - endif - if(isec1(6).eq.143) then !! CONVECTIVE PREC. - convprecn(i,j,1,n,l)=zsec4(nxn(l)*(nyn(l)-j-1)+i+1)/conversion_factor !added by mc to make it consisitent with new readwind.f90 - if (convprecn(i,j,1,n,l).lt.0.) convprecn(i,j,1,n,l)=0. - endif - if(isec1(6).eq.146) sshfn(i,j,1,n,l)= &!! SENS. HEAT FLUX - zsec4(nxn(l)*(nyn(l)-j-1)+i+1) - if((isec1(6).eq.146).and. & - (zsec4(nxn(l)*(nyn(l)-j-1)+i+1).ne.0.)) hflswitch=.true. ! Heat flux available - if(isec1(6).eq.176) then !! SOLAR RADIATION - ssrn(i,j,1,n,l)=zsec4(nxn(l)*(nyn(l)-j-1)+i+1) + ij=nxn(l)*jy + i+1 + if (is6 .eq. 130) then ! TEMPERATURE + tthn(i,j,kz,n,l)=zsec4(ij) + elseif (is6 .eq. 131) then ! U VELOCITY + uuhn(i,j,kz,l)=zsec4(ij) + iumax=max(iumax,kz1) + elseif (is6 .eq. 132) then ! V VELOCITY + vvhn(i,j,kz,l)=zsec4(ij) + elseif (is6 .eq. 133) then ! SPEC. HUMIDITY + qvhn(i,j,kz,n,l)=zsec4(ij) + if (qvhn(i,j,kz,n,l) .lt. 0.) qvhn(i,j,kz,n,l) = 0. + ! necessary because the gridded data may contain spurious negative values + elseif (is6 .eq. 134) then ! SURF. PRESS. + psn(i,j,1,n,l)=zsec4(ij) + elseif (is6 .eq. 135) then ! W VELOCITY + wwhn(i,j,kz1,l)=zsec4(ij) + iwmax=max(iwmax,kz1) + elseif (is6 .eq. 141) then ! SNOW DEPTH + sdn(i,j,1,n,l)=zsec4(ij)/conversion_factor + elseif (is6 .eq. 151) then ! SEA LEVEL PRESS. + msln(i,j,1,n,l)=zsec4(ij) + elseif (is6 .eq. 164) then ! CLOUD COVER + tccn(i,j,1,n,l)=zsec4(ij) + elseif (is6 .eq. 165) then ! 10 M U VELOCITY + u10n(i,j,1,n,l)=zsec4(ij) + elseif (is6 .eq. 166) then ! 10 M V VELOCITY + v10n(i,j,1,n,l)=zsec4(ij) + elseif (is6 .eq. 167) then ! 2 M TEMPERATURE + tt2n(i,j,1,n,l)=zsec4(ij) + elseif (is6 .eq. 168) then ! 2 M DEW POINT + td2n(i,j,1,n,l)=zsec4(ij) + elseif (is6 .eq. 142) then ! LARGE SCALE PREC. + lsprecn(i,j,1,ipf,n,l)=zsec4(ij) + if (lsprecn(i,j,1,ipf,n,l).lt.0.) lsprecn(i,j,1,ipf,n,l)=0. + elseif (is6 .eq. 143) then ! CONVECTIVE PREC. + convprecn(i,j,1,ipf,n,l)=zsec4(ij)/conversion_factor + if (convprecn(i,j,1,ipf,n,l).lt.0.) convprecn(i,j,1,ipf,n,l)=0. + elseif (is6 .eq. 146) then ! SENS. HEAT FLUX + sshfn(i,j,1,n,l)=zsec4(ij) + if (zsec4(ij).ne.0.) hflswitch=.true. ! Heat flux available + elseif (is6 .eq. 176) then ! SOLAR RADIATION + ssrn(i,j,1,n,l)=zsec4(ij) if (ssrn(i,j,1,n,l).lt.0.) ssrn(i,j,1,n,l)=0. + elseif (is6 .eq. 180) then ! EW SURFACE STRESS + ewss(i,j)=zsec4(ij) + elseif (is6 .eq. 181) then ! NS SURFACE STRESS + nsss(i,j)=zsec4(ij) + if (zsec4(ij).ne.0.) strswitch=.true. ! stress available + elseif (is6 .eq. 129) then ! ECMWF OROGRAPHY + oron(i,j,l)=zsec4(ij)/ga + elseif (is6 .eq. 160) then ! STANDARD DEVIATION OF OROGRAPHY + excessoron(i,j,l)=zsec4(ij) + elseif (is6 .eq. 172) then ! ECMWF LAND SEA MASK + lsmn(i,j,l)=zsec4(ij) + ! ZHG add reading of cloud water fields + ! ESO add reading of total cloud water fields + ! ESO TODO: add check whether either CLWC or CIWC is missing (->error) + ! if all 3 cw fields exist, use QC and disregard the others + elseif (is6 .eq. 246) then ! CLWC Cloud liquid water content [kg/kg] + clwchn(i,j,kz,n,l)=zsec4(ij) + lcw_nest(l)=.true. + lcwsum_nest(l)=.false. + elseif (is6 .eq. 247) then ! CIWC Cloud ice water content + ciwchn(i,j,kz,n,l)=zsec4(ij) + elseif (is6 .eq. 201031) then ! QC Cloud water content (liq+ice) [kg/kg] + clwchn(i,j,kz,n,l)=zsec4(ij) + lcw_nest(l)=.true. + lcwsum_nest(l)=.true. endif - if(isec1(6).eq.180) ewss(i,j)= &!! EW SURFACE STRESS - zsec4(nxn(l)*(nyn(l)-j-1)+i+1) - if(isec1(6).eq.181) nsss(i,j)= &!! NS SURFACE STRESS - zsec4(nxn(l)*(nyn(l)-j-1)+i+1) - if(((isec1(6).eq.180).or.(isec1(6).eq.181)).and. & - (zsec4(nxn(l)*(nyn(l)-j-1)+i+1).ne.0.)) strswitch=.true. ! stress available - if(isec1(6).eq.129) oron(i,j,l)= &!! ECMWF OROGRAPHY - zsec4(nxn(l)*(nyn(l)-j-1)+i+1)/ga - if(isec1(6).eq.160) excessoron(i,j,l)= &!! STANDARD DEVIATION OF OROGRAPHY - zsec4(nxn(l)*(nyn(l)-j-1)+i+1) - if(isec1(6).eq.172) lsmn(i,j,l)= &!! ECMWF LAND SEA MASK - zsec4(nxn(l)*(nyn(l)-j-1)+i+1) - if(isec1(6).eq.131) iumax=max(iumax,nlev_ec-k+1) - if(isec1(6).eq.135) iwmax=max(iwmax,nlev_ec-k+1) - - ! ESO TODO: - ! -add check for if one of clwc/ciwc missing (error), - ! also if all 3 cw fields present, use qc and disregard the others - if(isec1(6).eq.246) then !! CLWC Cloud liquid water content [kg/kg] - clwchn(i,j,nlev_ec-k+2,n,l)=zsec4(nxn(l)*(nyn(l)-j-1)+i+1) - readclouds_nest(l)=.true. - sumclouds_nest(l)=.false. - endif - if(isec1(6).eq.247) then !! CIWC Cloud ice water content - ciwchn(i,j,nlev_ec-k+2,n,l)=zsec4(nxn(l)*(nyn(l)-j-1)+i+1) - endif - !ZHG end - !ESO read qc (=clwc+ciwc) - if(isec1(6).eq.201031) then !! QC Cloud liquid water content [kg/kg] - clwchn(i,j,nlev_ec-k+2,n,l)=zsec4(nxn(l)*(nyn(l)-j-1)+i+1) - readclouds_nest(l)=.true. - sumclouds_nest(l)=.true. - endif - end do end do @@ -3648,27 +3843,25 @@ subroutine readwind_nest(indj,n,uuhn,vvhn,wwhn) ! call grib_close_file(ifile) - !error message if no fields found with correct first longitude in it - if (gotGrid.eq.0) then - print*,'***ERROR: input file needs to contain GRiB1 formatted'// & - 'messages' - error stop + !error message if no field found with correct first longitude in it + if (gotGrid .eq. 0) then + print*,'***ERROR: input file needs to contain GRiB1-formatted messages' + stop endif - if(levdiff2.eq.0) then + if (nlev_ec-nwz+1 .eq. 0) then iwmax=nlev_ec+1 - do i=0,nxn(l)-1 - do j=0,nyn(l)-1 - wwhn(i,j,nlev_ec+1,l)=0. - end do - end do + wwhn(:,:,iwmax,l)=0. endif - do i=0,nxn(l)-1 - do j=0,nyn(l)-1 + ! Assign 10 m wind to model level at eta=1.0 to have one additional model + ! level at the ground + ! Specific humidity is taken the same as at one level above + ! Temperature is taken as 2 m temperature + !************************************************************************** + forall (i=0:nxn(l)-1,j=0:nyn(l)-1) & sfcstressn(i,j,1,n,l)=sqrt(ewss(i,j)**2+nsss(i,j)**2) - end do - end do + if ((.not.hflswitch).or.(.not.strswitch)) then write(*,*) 'WARNING: No flux data contained in GRIB file ', & @@ -3680,46 +3873,45 @@ subroutine readwind_nest(indj,n,uuhn,vvhn,wwhn) ! (3rd model level in FLEXPART) for the profile method !*************************************************************************** - do i=0,nxn(l)-1 - do j=0,nyn(l)-1 + do j=0,nyn(l)-1 + do i=0,nxn(l)-1 plev1=akz(3)+bkz(3)*psn(i,j,1,n,l) pmean=0.5*(psn(i,j,1,n,l)+plev1) tv=tthn(i,j,3,n,l)*(1.+0.61*qvhn(i,j,3,n,l)) fu=-r_air*tv/ga/pmean - hlev1=fu*(plev1-psn(i,j,1,n,l)) ! HEIGTH OF FIRST MODEL LAYER + hlev1=fu*(plev1-psn(i,j,1,n,l)) ! HEIGHT OF FIRST MODEL LAYER ff10m= sqrt(u10n(i,j,1,n,l)**2+v10n(i,j,1,n,l)**2) fflev1=sqrt(uuhn(i,j,3,l)**2+vvhn(i,j,3,l)**2) call pbl_profile(psn(i,j,1,n,l),td2n(i,j,1,n,l),hlev1, & tt2n(i,j,1,n,l),tthn(i,j,3,n,l),ff10m,fflev1, & sfcstressn(i,j,1,n,l),sshfn(i,j,1,n,l)) - if(sshfn(i,j,1,n,l).gt.200.) sshfn(i,j,1,n,l)=200. - if(sshfn(i,j,1,n,l).lt.-400.) sshfn(i,j,1,n,l)=-400. + if (sshfn(i,j,1,n,l) .gt. +200.) sshfn(i,j,1,n,l)=+200. + if (sshfn(i,j,1,n,l) .lt. -400.) sshfn(i,j,1,n,l)=-400. end do - end do - endif + enddo + endif + + ! Assign 10 m wind to model level at eta=1.0 to have one additional model + ! level at the ground + ! Specific humidity is taken the same as at one level above + ! Temperature is taken as 2 m temperature + !************************************************************************** - ! Assign 10 m wind to model level at eta=1.0 to have one additional model - ! level at the ground - ! Specific humidity is taken the same as at one level above - ! Temperature is taken as 2 m temperature - !************************************************************************** + forall (i=0:nxn(l)-1, j=0:nyn(l)-1) + uuhn(i,j,1,l)=u10n(i,j,1,n,l) + vvhn(i,j,1,l)=v10n(i,j,1,n,l) + qvhn(i,j,1,n,l)=qvhn(i,j,2,n,l) + tthn(i,j,1,n,l)=tt2n(i,j,1,n,l) + end forall - do i=0,nxn(l)-1 - do j=0,nyn(l)-1 - uuhn(i,j,1,l)=u10n(i,j,1,n,l) - vvhn(i,j,1,l)=v10n(i,j,1,n,l) - qvhn(i,j,1,n,l)=qvhn(i,j,2,n,l) - tthn(i,j,1,n,l)=tt2n(i,j,1,n,l) - end do - end do if(iumax.ne.nuvz-1) error stop & 'READWIND: NUVZ NOT CONSISTENT FOR A NESTING LEVEL' if(iwmax.ne.nwz) error stop & 'READWIND: NWZ NOT CONSISTENT FOR A NESTING LEVEL' - end do + end do l_loop return 888 write(*,*) ' #### FLEXPART MODEL ERROR! WINDFIELD #### ' @@ -3851,8 +4043,6 @@ subroutine alloc_fixedfields if (stat.ne.0) error stop "Could not allocate excessoro" allocate(lsm(0:nxmax-1,0:nymax-1),stat=stat) if (stat.ne.0) error stop "Could not allocate lsm" - allocate(pv(0:nxmax-1,0:nymax-1,nzmax,numwfmem),stat=stat) - if (stat.ne.0) error stop "Could not allocate pv" end subroutine alloc_fixedfields subroutine alloc_fixedfields_nest @@ -3915,6 +4105,8 @@ subroutine alloc_windfields if (stat.ne.0) error stop "Could not allocate tt" allocate(tth(0:nxmax-1,0:nymax-1,nuvzmax,numwfmem),stat=stat) if (stat.ne.0) error stop "Could not allocate tth" + allocate(pv(0:nxmax-1,0:nymax-1,nzmax,numwfmem),stat=stat) + if (stat.ne.0) error stop "Could not allocate pv" allocate(qv(0:nxmax-1,0:nymax-1,nzmax,numwfmem),stat=stat) if (stat.ne.0) error stop "Could not allocate qv" allocate(qvh(0:nxmax-1,0:nymax-1,nuvzmax,numwfmem),stat=stat) @@ -3936,23 +4128,22 @@ subroutine alloc_windfields if (stat.ne.0) error stop "Could not allocate clwc" allocate(ciwc(0:nxmax-1,0:nymax-1,nzmax,numwfmem),stat=stat) if (stat.ne.0) error stop "Could not allocate ciwc" - allocate(clw(0:nxmax-1,0:nymax-1,nzmax,numwfmem),stat=stat) - if (stat.ne.0) error stop "Could not allocate clw" allocate(clwch(0:nxmax-1,0:nymax-1,nuvzmax,numwfmem),stat=stat) if (stat.ne.0) error stop "Could not allocate clwch" allocate(ciwch(0:nxmax-1,0:nymax-1,nuvzmax,numwfmem),stat=stat) if (stat.ne.0) error stop "Could not allocate ciwch" + clwc=0.0 ciwc=0.0 - clw=0.0 clwch=0.0 ciwch=0.0 + allocate(ctwc(0:nxmax-1,0:nymax-1,numwfmem),stat=stat) if (stat.ne.0) error stop "Could not allocate ctwc" - allocate(cloudsh(0:nxmax-1,0:nymax-1,numwfmem),stat=stat) - if (stat.ne.0) error stop "Could not allocate cloudsh" - allocate(clouds(0:nxmax-1,0:nymax-1,nzmax,numwfmem),stat=stat) - if (stat.ne.0) error stop "Could not allocate clouds" + allocate(icloudbot(0:nxmax-1,0:nymax-1,numwfmem),stat=stat) + if (stat.ne.0) error stop "Could not allocate icloudbot" + allocate(icloudtop(0:nxmax-1,0:nymax-1,numwfmem),stat=stat) + if (stat.ne.0) error stop "Could not allocate icloudtop" ! 2d fields !********** @@ -3972,9 +4163,9 @@ subroutine alloc_windfields if (stat.ne.0) error stop "Could not allocate tt2" allocate(td2(0:nxmax-1,0:nymax-1,1,numwfmem),stat=stat) if (stat.ne.0) error stop "Could not allocate td2" - allocate(lsprec(0:nxmax-1,0:nymax-1,1,numwfmem),stat=stat) + allocate(lsprec(0:nxmax-1,0:nymax-1,1,numpf,numwfmem),stat=stat) if (stat.ne.0) error stop "Could not allocate lsprec" - allocate(convprec(0:nxmax-1,0:nymax-1,1,numwfmem),stat=stat) + allocate(convprec(0:nxmax-1,0:nymax-1,1,numpf,numwfmem),stat=stat) if (stat.ne.0) error stop "Could not allocate convprec" allocate(sshf(0:nxmax-1,0:nymax-1,1,numwfmem),stat=stat) if (stat.ne.0) error stop "Could not allocate sshf" @@ -4028,8 +4219,6 @@ subroutine alloc_windfields_nest if (stat.ne.0) error stop "Could not allocate clwcn" allocate(ciwcn(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests),stat=stat) if (stat.ne.0) error stop "Could not allocate ciwcn" - allocate(clwn(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests),stat=stat) - if (stat.ne.0) error stop "Could not allocate clwn" ! ETA equivalents #ifdef ETA @@ -4055,10 +4244,10 @@ subroutine alloc_windfields_nest allocate(etawheightn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,numwfmem,numbnests),stat=stat) if (stat.ne.0) error stop "Could not allocate etawheightn" - allocate(cloudsn(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests),stat=stat) - if (stat.ne.0) error stop "Could not allocate cloudsn" - allocate(cloudshn(0:nxmaxn-1,0:nymaxn-1,numwfmem,numbnests),stat=stat) - if (stat.ne.0) error stop "Could not allocate cloudshn" + allocate(icloudbotn(0:nxmax-1,0:nymax-1,numwfmem,numbnests),stat=stat) + if (stat.ne.0) error stop "Could not allocate icloudbotn" + allocate(icloudtopn(0:nxmax-1,0:nymax-1,numwfmem,numbnests),stat=stat) + if (stat.ne.0) error stop "Could not allocate icloudtopn" allocate(prsn(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests),stat=stat) if (stat.ne.0) error stop "Could not allocate prsn" allocate(rhon(0:nxmaxn-1,0:nymaxn-1,nzmax,numwfmem,numbnests),stat=stat) @@ -4094,9 +4283,9 @@ subroutine alloc_windfields_nest if (stat.ne.0) error stop "Could not allocate tt2n" allocate(td2n(0:nxmaxn-1,0:nymaxn-1,1,numwfmem,numbnests),stat=stat) if (stat.ne.0) error stop "Could not allocate td2n" - allocate(lsprecn(0:nxmaxn-1,0:nymaxn-1,1,numwfmem,numbnests),stat=stat) + allocate(lsprecn(0:nxmaxn-1,0:nymaxn-1,1,numpf,numwfmem,maxnests),stat=stat) if (stat.ne.0) error stop "Could not allocate lsprecn" - allocate(convprecn(0:nxmaxn-1,0:nymaxn-1,1,numwfmem,numbnests),stat=stat) + allocate(convprecn(0:nxmaxn-1,0:nymaxn-1,1,numpf,numwfmem,maxnests),stat=stat) if (stat.ne.0) error stop "Could not allocate convprecn" allocate(sshfn(0:nxmaxn-1,0:nymaxn-1,1,numwfmem,numbnests),stat=stat) if (stat.ne.0) error stop "Could not allocate sshfn" @@ -4164,12 +4353,12 @@ subroutine dealloc_windfields_nest deallocate(oron,excessoron,lsmn) - deallocate(uun,vvn,wwn,ttn,qvn,pvn,clwcn,ciwcn,clwn,cloudsn, & - cloudshn,rhon,prsn,drhodzn,tthn,qvhn,clwchn,ciwchn,ctwcn) + deallocate(uun,vvn,wwn,ttn,qvn,pvn,clwcn,ciwcn, & + rhon,prsn,drhodzn,tthn,qvhn,clwchn,ciwchn,ctwcn,etauvheightn,etawheightn) #ifdef ETA deallocate(uuetan,vvetan,wwetan,ttetan,pvetan,prsetan,rhoetan, & - drhodzetan,etauvheightn,etawheightn) + drhodzetan) #endif deallocate(psn,sdn,msln,tccn,u10n,v10n,tt2n,td2n,lsprecn,convprecn, & @@ -4193,7 +4382,7 @@ subroutine dealloc_windfields deallocate(uu,vv,ww,uupol,vvpol,tt,tth,qv,qvh,pv,rho,drhodz,pplev,prs,rho_dry) - deallocate(clwc,ciwc,clw,clwch,ciwch,ctwc,cloudsh,clouds) + deallocate(clwc,ciwc,clwch,ciwch,ctwc) deallocate(ps,sd,msl,tcc,u10,v10,tt2,td2,lsprec,convprec,sshf,ssr,sfcstress, & ustar,wstar,hmix,tropopause,oli) diff --git a/tests/bkw_master.txt b/tests/bkw_master.txt index 4b6b4c30adb18bd191c4655a47eb6578bc5dfe15..9f9d7ad34e5f87e2872eaf7bbbdd4e091abcb701 100644 --- a/tests/bkw_master.txt +++ b/tests/bkw_master.txt @@ -1,4 +1,4 @@ - Dry: mean abs: 9.32958668e-06 max abs: 3.06104193e-04 - Dry ETA: mean abs: 9.28268578e-06 max abs: 3.06104426e-04 - Wet: mean abs: 6.18856525e-04 max abs: 3.30591202e-01 - Wet ETA: mean abs: 8.27685395e-04 max abs: 3.24246705e-01 + Dry: mean abs: 9.34575478e-06 max abs: 3.00163374e-04 + Dry ETA: mean abs: 9.31242607e-06 max abs: 2.86252878e-04 + Wet: mean abs: 7.71495336e-04 max abs: 1.37401134e-01 + Wet ETA: mean abs: 7.66183068e-04 max abs: 1.37400538e-01 diff --git a/tests/default_etex/EC1994102312.REMOVED.git-id b/tests/default_etex/EC1994102312.REMOVED.git-id deleted file mode 100644 index 40b58307c5cc3b19825c3197fc515e8ac3693270..0000000000000000000000000000000000000000 --- a/tests/default_etex/EC1994102312.REMOVED.git-id +++ /dev/null @@ -1 +0,0 @@ -6da99ad066c33aa0caf7d353ee5ed24937d3c735 \ No newline at end of file diff --git a/tests/default_etex/EC1994102318.REMOVED.git-id b/tests/default_etex/EC1994102318.REMOVED.git-id deleted file mode 100644 index c25907be17e937395ef484354077f9ca2b97833e..0000000000000000000000000000000000000000 --- a/tests/default_etex/EC1994102318.REMOVED.git-id +++ /dev/null @@ -1 +0,0 @@ -90b7fca857f4493e8ce2982b2c3b4f5e4e0583cc \ No newline at end of file diff --git a/tests/default_etex/EC1994102400.REMOVED.git-id b/tests/default_etex/EC1994102400.REMOVED.git-id deleted file mode 100644 index c15690e2719153cae7055904fd8cf49a72ba00df..0000000000000000000000000000000000000000 --- a/tests/default_etex/EC1994102400.REMOVED.git-id +++ /dev/null @@ -1 +0,0 @@ -4eef5a1c6750ba955afdc7dc64c781998723e513 \ No newline at end of file diff --git a/tests/default_etex/EC1994102406.REMOVED.git-id b/tests/default_etex/EC1994102406.REMOVED.git-id deleted file mode 100644 index 7e282621d0caf84dbbe9f5a854187f7af8d0e62f..0000000000000000000000000000000000000000 --- a/tests/default_etex/EC1994102406.REMOVED.git-id +++ /dev/null @@ -1 +0,0 @@ -c8cc09ebb0f32986a15b6b12681c2010ccc6f7fd \ No newline at end of file diff --git a/tests/default_etex/EC1994102412.REMOVED.git-id b/tests/default_etex/EC1994102412.REMOVED.git-id deleted file mode 100644 index 9aac43d8470288621b19c3e5300bff767ade5e58..0000000000000000000000000000000000000000 --- a/tests/default_etex/EC1994102412.REMOVED.git-id +++ /dev/null @@ -1 +0,0 @@ -d268d2a3cc5e183690fdf1464f5146a31c18bccc \ No newline at end of file diff --git a/tests/default_etex/EC1994102418.REMOVED.git-id b/tests/default_etex/EC1994102418.REMOVED.git-id deleted file mode 100644 index 51e843c15eb018c74d922702b11b01a8234c2c84..0000000000000000000000000000000000000000 --- a/tests/default_etex/EC1994102418.REMOVED.git-id +++ /dev/null @@ -1 +0,0 @@ -7b83fd7d7b92d1fad60bdd037eaf27daabc58abd \ No newline at end of file diff --git a/tests/default_etex/EC1994102500.REMOVED.git-id b/tests/default_etex/EC1994102500.REMOVED.git-id deleted file mode 100644 index 55778f1270f87df76559fd1bcf2e3e134e3efcb7..0000000000000000000000000000000000000000 --- a/tests/default_etex/EC1994102500.REMOVED.git-id +++ /dev/null @@ -1 +0,0 @@ -37fbbda5bbe0027bbb10a4bb765659f74eb81174 \ No newline at end of file diff --git a/tests/default_etex/EC1994102506.REMOVED.git-id b/tests/default_etex/EC1994102506.REMOVED.git-id deleted file mode 100644 index c3237dcd6b20c85085ffd8787be35208c8e59318..0000000000000000000000000000000000000000 --- a/tests/default_etex/EC1994102506.REMOVED.git-id +++ /dev/null @@ -1 +0,0 @@ -790520b3c8b04e87e650a492a3f16d3a98b56a18 \ No newline at end of file diff --git a/tests/default_etex/EC1994102512.REMOVED.git-id b/tests/default_etex/EC1994102512.REMOVED.git-id deleted file mode 100644 index 0a759fab68acc9d06552c07446789bd4ccc2e220..0000000000000000000000000000000000000000 --- a/tests/default_etex/EC1994102512.REMOVED.git-id +++ /dev/null @@ -1 +0,0 @@ -691492d53210fbbe92a629a7345a4997c25b3142 \ No newline at end of file diff --git a/tests/default_etex/EC1994102518.REMOVED.git-id b/tests/default_etex/EC1994102518.REMOVED.git-id deleted file mode 100644 index bff2204b5e9540200482a864cc99a04a42b22a67..0000000000000000000000000000000000000000 --- a/tests/default_etex/EC1994102518.REMOVED.git-id +++ /dev/null @@ -1 +0,0 @@ -dc3c3d5cd682d7cbd664a5b99ae057195be3748a \ No newline at end of file diff --git a/tests/default_etex/EC1994102600.REMOVED.git-id b/tests/default_etex/EC1994102600.REMOVED.git-id deleted file mode 100644 index 448b8a660bdecec0877eb8bb12d0e9c878405323..0000000000000000000000000000000000000000 --- a/tests/default_etex/EC1994102600.REMOVED.git-id +++ /dev/null @@ -1 +0,0 @@ -90db95dd0b841f9136b678ee0225f2fae60017d8 \ No newline at end of file diff --git a/tests/default_etex/EC1994102606.REMOVED.git-id b/tests/default_etex/EC1994102606.REMOVED.git-id deleted file mode 100644 index 62b2977ebe46e0aac20d96c9cf46ef07172ac7cb..0000000000000000000000000000000000000000 --- a/tests/default_etex/EC1994102606.REMOVED.git-id +++ /dev/null @@ -1 +0,0 @@ -693268aefa934c02c93e438999aabb3db45d5077 \ No newline at end of file diff --git a/tests/default_etex/EC1994102612.REMOVED.git-id b/tests/default_etex/EC1994102612.REMOVED.git-id deleted file mode 100644 index 3e937b4a05153e5669a909f8dd1fbba76bbc71dc..0000000000000000000000000000000000000000 --- a/tests/default_etex/EC1994102612.REMOVED.git-id +++ /dev/null @@ -1 +0,0 @@ -74aa06b4d66cb845cfcd1624320d7999eaeabe6a \ No newline at end of file diff --git a/tests/default_etex/EC1994102618.REMOVED.git-id b/tests/default_etex/EC1994102618.REMOVED.git-id deleted file mode 100644 index 12a3275cf1c2e517232416af16e39a54626a94cd..0000000000000000000000000000000000000000 --- a/tests/default_etex/EC1994102618.REMOVED.git-id +++ /dev/null @@ -1 +0,0 @@ -1432774cb381a488eb4bab9bab32fecf4b6990a1 \ No newline at end of file diff --git a/tests/default_etex/EC1994102700.REMOVED.git-id b/tests/default_etex/EC1994102700.REMOVED.git-id deleted file mode 100644 index 7c9350d9ea58189f8c10bada7204ef4e7c59d619..0000000000000000000000000000000000000000 --- a/tests/default_etex/EC1994102700.REMOVED.git-id +++ /dev/null @@ -1 +0,0 @@ -4617e2548944564e5ce999e3cd426a710bf45c65 \ No newline at end of file diff --git a/tests/default_etex/EC1994102706.REMOVED.git-id b/tests/default_etex/EC1994102706.REMOVED.git-id deleted file mode 100644 index b430b4cf1492b3e2f06b6d4927fbbf33226c1944..0000000000000000000000000000000000000000 --- a/tests/default_etex/EC1994102706.REMOVED.git-id +++ /dev/null @@ -1 +0,0 @@ -217738d4c1d1220b46bb2c6f12c9719609276489 \ No newline at end of file diff --git a/tests/default_etex/EC1994102712.REMOVED.git-id b/tests/default_etex/EC1994102712.REMOVED.git-id deleted file mode 100644 index d0f8a77858d7e7eba3495894098f79042a3598b2..0000000000000000000000000000000000000000 --- a/tests/default_etex/EC1994102712.REMOVED.git-id +++ /dev/null @@ -1 +0,0 @@ -a6b4f28e5d33b1df9693526f01f5692990e69bb6 \ No newline at end of file diff --git a/tests/default_etex/pmch2.dat b/tests/default_etex/pmch2.dat new file mode 100644 index 0000000000000000000000000000000000000000..3487bc337a00f7a1225fbdf0fdaad9c68e59c915 --- /dev/null +++ b/tests/default_etex/pmch2.dat @@ -0,0 +1,169 @@ +station 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 +A01 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 +A02 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .01 .02 .07 .04 .02 .02 .02 .03 .03 .03 .01 .04 .01 .04 .01 .02 .01 .01 .02 .03 -.99 +A03 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 +A04 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 +A05 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 +A06 -.99 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 +A07 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 +A08 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 .09 .07 .01 .00 .00 .00 .03 .04 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +B01 -.99 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 .11 -.88 .07 .00 .07 -.88 .07 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +B02 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +B03 -.99 .00 .00 .00 .00 .01 .01 .00 .02 .55 .40 .15 .03 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 +B04 -.99 .00 .00 .00 .00 -.99 -.99 -.99 .00 1.03 2.50 .66 .04 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +B05 -.99 .00 .00 -.99 .00 .05 .00 .00 .00 .70 .38 .03 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 +BG01 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 .00 .36 .34 .31 -.99 .00 .01 .01 .01 .00 .00 +BG02 -.99 -.99 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .03 .02 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 +CH01 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 +CH02 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 +CH03 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +CH04 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 +CR01 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .02 .01 .04 .01 .09 .21 .47 .48 -.88 .57 .50 .42 .30 .22 .17 .14 .10 .06 .09 .07 -.99 +CR02 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .05 .16 .38 .45 .34 .38 .36 .27 .12 -.88 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 +CR03 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .02 .24 .44 .57 .31 .04 .04 .03 .02 .00 .00 .00 .00 .00 .01 .00 .00 .00 .00 -.99 +CR04 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .11 .39 .15 .23 .08 .03 .00 .00 .00 .00 .00 .00 -.99 .00 -.99 .00 -.99 .00 -.99 -.99 +D01 -.99 -.88 -.88 -.88 -.88 -.88 -.88 .00 .00 .00 .00 .03 .10 -.88 -.88 -.88 -.88 -.88 -.88 .02 -.88 .04 -.88 -.88 -.88 -.99 -.99 -.99 -.99 -.99 +D02 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .01 .02 .12 .10 .12 .30 .35 .21 .01 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 +D03 -.99 -.88 -.99 -.99 -.88 -.88 -.88 -.88 .00 .00 .00 -.88 -.88 -.88 -.88 -.88 .01 -.88 -.88 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +D04 -.99 -.88 -.88 -.88 -.88 .20 .02 .04 .12 .03 .03 -.88 -.88 -.88 -.88 -.88 -.88 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +D05 -.99 -.88 -.88 -.88 -.88 -.88 .00 .00 .00 .00 .01 .18 .47 .62 1.02 .86 .36 .18 .04 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 +D06 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .02 .00 .04 .89 2.50 .63 .10 .03 .39 -.99 .08 -.99 .00 -.99 .00 -.99 -.99 -.99 -.99 -.99 -.99 +D07 -.99 .00 -.88 -.99 -.99 -.99 -.99 -.99 -.99 -.88 .07 .10 5.21 -.99 -.99 .57 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +D08 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.88 .11 -.88 .52 .34 .28 .06 .00 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 +D09 -.99 -.88 .00 .00 .00 .00 .00 .00 .00 .02 .36 .39 .43 .46 .33 .31 .23 .16 .04 .01 .01 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 +D10 -.99 -.88 -.88 .00 .00 .00 .03 .07 .03 .23 2.55 1.91 .68 .11 .01 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 +D11 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +D12 -.99 .00 .00 -.88 -.88 -.88 -.88 -.88 .00 .40 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.99 -.99 -.99 -.99 -.99 +D13 -.99 .00 .00 .00 .00 .00 .06 .71 .79 2.11 1.24 .47 .09 .04 .03 .00 .00 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +D14 -.99 .00 -.88 -.88 .00 -.88 .00 .00 .00 .00 .00 .17 .42 .47 .72 .27 .26 .14 .10 .07 .02 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 +D15 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .08 .03 .10 .04 .08 .29 .26 .05 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 +D16 -.99 .00 .00 .00 .00 .00 .00 .01 .00 .01 .00 .00 .02 .09 .11 .15 .11 .01 .00 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 +D17 -.99 .00 -.88 .00 .00 .00 .00 .00 .07 -.99 -.99 1.24 -.99 .58 .36 1.28 .01 .00 .00 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 +D18 -.99 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.99 -.99 -.99 -.99 -.99 +D19 -.99 -.88 -.88 -.88 -.88 -.88 -.88 -.88 .15 .59 .80 .94 .46 .09 .02 .01 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 +D20 -.99 .00 -.99 .00 -.99 .00 -.99 .00 -.99 .01 -.99 .01 -.99 .01 -.99 .01 -.99 .01 -.99 .01 -.99 .01 -.99 .01 -.99 -.99 -.99 -.99 -.99 -.99 +D21 -.99 -.99 .00 .00 -.88 -.88 -.88 -.99 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.99 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.99 -.99 -.99 -.99 -.99 +D22 -.99 .00 .00 .00 .00 .00 .00 .06 .17 .20 .19 .28 -.99 .12 .01 .01 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 +D23 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +D24 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .01 .12 .23 .30 .43 .43 .32 .28 .21 .05 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 +D25 -.99 -.99 .00 .00 .00 .01 .00 .06 .00 .04 .01 2.02 1.31 -.88 .18 -.99 .00 .00 .00 .00 -.99 .00 -.99 .00 -.99 -.99 -.99 -.99 -.99 -.99 +D26 -.99 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.99 -.99 -.99 -.99 -.99 +D27 -.99 .00 .00 .00 -.88 .00 .00 .01 .00 .07 .16 -.88 .09 .31 .53 .46 .24 .09 .00 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 +D28 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .16 -.99 .15 -.99 .01 -.99 .17 -.99 .00 -.99 .00 .00 .00 -.88 .00 -.99 -.99 -.99 -.99 -.99 +D29 -.99 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 .42 -.99 -.99 -.99 -.99 -.99 +D30 -.99 .00 .00 .00 .00 .00 .00 .00 .01 .04 .03 .23 .19 .13 .03 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 +D31 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .01 .09 .12 .19 .17 .55 .59 .38 .16 .02 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 +D32 -.99 -.88 -.88 -.88 -.88 .01 -.88 .00 -.99 .00 .02 .07 .17 .55 .93 .63 .33 .14 -.99 .00 -.99 .00 -.99 .00 -.99 -.99 -.99 -.99 -.99 -.99 +D33 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .35 .42 .13 .03 .01 .00 .00 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 +D34 -.99 .00 .00 .00 .00 .27 .71 .39 .24 .97 .68 .16 .01 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 +D35 -.99 .00 .00 .00 .00 .00 .00 .09 .43 .38 .27 .24 .10 .02 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 +D36 -.99 .00 .00 .00 .00 .00 .05 .26 .23 .18 .08 .01 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 +D37 -.99 -.88 -.88 -.88 -.88 -.88 -.99 -.99 -.99 -.88 .33 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +D38 -.99 -.88 -.88 .01 -.88 -.88 -.88 -.88 .02 .09 .09 .07 .04 -.88 -.88 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 +D39 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .01 .01 .03 .10 .75 1.08 -.88 .88 .73 .38 .10 .01 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 +D40 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +D41 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .05 .00 .14 .81 -.88 .64 .24 .16 .00 .00 .00 .00 .07 .00 -.99 -.99 -.99 -.99 -.99 +D42 -.99 .00 -.99 .00 -.99 .00 -.99 .00 .00 .00 .04 .09 .21 1.50 1.00 2.02 .87 1.30 .07 .00 .00 .02 -.99 .06 -.99 -.99 -.99 -.99 -.99 -.99 +D43 -.99 .00 .00 .00 .00 .00 .01 .03 .03 .01 .02 .00 -.88 -.88 -.88 -.88 -.88 -.88 -.88 .00 .03 .01 .02 .02 -.88 -.99 -.99 -.99 -.99 -.99 +D44 -.99 .00 .00 .00 .00 .18 .47 .47 .68 .56 .31 .03 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 +D45 -.99 -.99 .00 .00 .04 .04 .00 .11 .00 1.00 2.84 .87 .16 .07 .05 .12 .03 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.99 -.99 -.99 -.99 -.99 +D46 -.99 .00 -.88 -.88 -.88 -.88 -.88 -.88 -.88 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.88 -.88 -.88 -.88 -.99 -.99 -.99 -.99 -.99 +D47 -.99 .00 .00 .00 .00 .00 .00 .38 .51 .53 .33 .17 .04 .01 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 +DK01 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .17 2.23 3.04 1.48 .31 .25 .13 .03 .02 .02 .02 .02 .01 -.99 +DK02 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .22 .88 1.00 1.03 .72 .23 .03 .01 .00 .00 .00 .00 .00 .00 .00 .00 .01 +DK03 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .04 .72 .95 .36 .30 .30 .18 .01 .00 .00 .00 .00 .00 .00 -.99 +DK04 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .02 .08 .17 .16 .02 .00 .00 .00 .00 .00 .00 -.99 +DK05 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .00 .01 .00 .30 2.01 1.30 1.16 .57 .43 .19 .06 .02 .02 .02 .03 .03 .03 .03 -.99 +DK06 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 -.99 .00 -.99 .05 .00 .06 2.20 .56 .23 .20 4.34 .36 .02 .07 .02 .07 .03 .00 .02 .00 -.99 +DK07 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 1.09 1.44 1.03 .89 .48 .73 .23 .03 .00 .00 .00 .00 .00 .00 -.99 +DK08 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .01 .01 .01 .10 .44 .22 .31 .46 .35 .05 .00 .00 .00 .00 .00 .00 .00 .00 -.99 +DK09 -.99 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .02 -.99 .60 .23 .10 .11 .09 .04 .02 .00 .00 .00 .00 +DK10 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .01 .00 .00 .00 .01 .02 1.55 1.39 .99 .75 .37 .19 .04 .04 .00 .07 -.99 .03 -.99 .07 -.99 -.99 +DK11 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +F01 .00 .00 .00 .00 .00 .01 .01 .05 1.98 .98 .20 .06 .04 .05 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +F02 .03 .98 1.92 .03 1.64 3.23 .78 .01 .02 .02 .01 .02 .01 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +F03 .00 .00 .00 .00 1.41 .95 .07 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +F04 .00 .00 .00 .00 .00 .00 .01 .03 .02 .03 .02 .03 .03 .03 .03 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +F05 .00 .00 .00 .00 .00 .00 .00 -.88 .09 -.88 -.88 .08 .05 -.88 -.88 .03 .07 -.88 -.88 .07 .08 -.88 .07 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +F06 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +F07 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +F08 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +F09 -.88 -.88 -.88 -.88 -.88 -.88 -.88 2.84 .00 .00 .02 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +F10 -.99 -.99 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +F11 -.99 -.99 -.99 .02 .02 .00 .05 .02 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +F12 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +F13 .00 .00 .00 .00 .00 .12 .29 .05 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +F14 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 .04 .07 .07 .08 .14 .12 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +F15 .00 .00 .00 .00 .00 .90 1.58 1.68 .41 .07 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +F16 .00 .00 .00 .00 .07 1.21 -.99 .66 .07 .02 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +F17 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.88 .00 -.88 -.99 -.99 -.99 -.99 -.99 -.99 +F18 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +F19 .00 .00 .04 1.49 1.47 2.27 2.46 .72 .01 .01 .01 .01 .01 .01 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +F20 .05 .00 .05 .55 1.68 -.88 1.18 -.88 .87 .05 .06 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +F21 .90 9.29 12.57 2.68 .00 .87 .92 .00 .00 .00 .00 .00 .00 .00 .00 .01 .00 .00 .00 .00 .00 -.88 1.39 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +F22 .00 .00 .06 .04 .00 .01 .92 1.91 .12 .04 .01 .01 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +F23 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +F24 .00 .00 .00 .00 .00 .00 .00 .08 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +F25 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.88 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +F26 .00 .00 .00 .00 .00 .00 .00 -.88 -.88 -.88 -.88 -.99 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.99 -.88 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +F27 .00 .00 .22 1.59 .93 2.12 2.42 .36 .00 .00 .00 .00 .00 .00 1.25 .00 .00 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +H01 -.99 -.99 -.99 -.99 -.99 -.99 -.99 .00 -.99 .00 -.99 .00 .05 .00 .10 .19 1.20 .76 1.05 .41 .22 .08 .12 .02 .04 .00 .03 .01 -.99 .00 +H02 -.99 -.99 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .05 .28 .52 .34 .12 .10 .04 .02 .02 .01 .00 .00 .00 .00 .01 .03 .01 .00 +H03 -.99 -.99 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 +H04 -.99 -.99 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .02 .03 .02 .01 .01 .01 .00 .00 .00 .00 .00 .02 .00 .00 .00 .00 .00 +N01 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .01 .02 .13 .16 .17 .22 .18 .22 .22 .14 .04 -.99 +N02 -.99 -.99 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .01 .01 +N04 -.99 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .22 .61 1.22 1.01 .15 .00 .01 .00 .00 .00 .00 .00 .00 +N05 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 .00 -.99 .00 -.99 .00 -.99 .00 .00 -.99 .00 -.99 .00 -.99 .00 -.99 .00 -.99 .14 -.99 .27 -.99 .18 +N06 -.99 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .01 .00 .00 .01 .00 .00 .00 .00 .00 .00 .00 +N07 -.99 -.99 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .01 .09 .37 .32 .19 .34 .33 .17 .13 .11 .08 .06 .03 .01 +NL01 -.99 -.99 -.99 .00 .00 .00 .01 .28 .10 .00 1.42 1.74 .19 .01 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 +NL02 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .01 .01 .17 -.88 2.61 .07 .04 .04 .03 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +NL03 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.88 -.88 -.88 .05 -.88 -.88 -.88 -.88 .06 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.99 -.99 -.99 -.99 -.99 +NL04 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .21 1.43 .60 .03 .00 .00 .00 -.88 .06 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +NL05 -.99 .00 .00 .00 .00 .00 .01 .01 .00 .10 1.99 1.04 .00 .02 .11 .12 .08 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +NL06 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.88 -.88 -.88 -.88 -.88 -.88 -.99 -.99 -.99 -.99 -.99 +NL07 -.99 .00 .00 -.99 .00 .00 .00 .00 .00 .00 .00 .01 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +NL08 -.99 -.99 .00 .00 .00 -.88 .00 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 -.88 .15 -.88 -.88 -.88 .00 -.99 -.99 -.99 -.99 -.99 +NL09 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .28 .01 .08 .02 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 +PL01 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.88 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .01 .02 .01 .01 .00 .00 .00 .00 .00 +PL02 -.99 -.99 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .13 .48 .41 .45 .41 .23 .09 .09 .13 .09 .08 .08 .08 +PL03 -.99 -.99 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .13 .28 .42 .72 .68 .44 .15 .07 .05 .00 .03 .07 .01 .01 .01 .01 .01 +PL04 -.99 -.99 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .01 .06 .08 .09 .11 .09 .19 .31 .25 .01 .00 .00 .00 .00 .00 .00 .00 +PL05 -.99 -.99 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .11 .25 .13 .25 .27 .22 .19 .08 .04 .02 .01 .00 .00 .00 .00 +PL06 -.99 -.99 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .00 .05 .03 .04 .05 .05 .10 .23 .12 .00 .00 .00 .00 .00 .00 .00 .00 +PL07 -.99 -.99 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .08 .15 .08 .16 .09 .03 .01 .00 +PL08 -.99 -.99 -.99 -.99 -.99 -.99 -.99 .00 .03 .00 .02 1.11 .19 1.94 1.20 1.23 1.97 1.49 .46 .17 .08 .00 .13 .00 .12 .00 .14 .00 .00 .00 +R01 -.99 -.99 -.99 -.99 -.99 -.99 -.99 .00 .06 -.99 .20 .13 .13 .12 .08 .11 .02 .00 .02 .01 .01 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 +R02 -.99 -.99 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .05 .10 .12 .09 .10 .09 .08 .08 .07 .06 +S01 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 +S02 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 -.88 -.88 .00 .00 .00 -.88 -.88 .00 .00 .00 .09 .16 .03 -.99 -.99 -.99 -.99 .02 .03 .00 .00 -.99 +S03 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +S04 -.99 -.99 -.99 -.99 -.99 -.88 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +S05 -.99 -.99 -.99 -.99 -.99 -.88 -.88 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .02 .06 .00 .00 .00 .00 -.99 +S06 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .01 .00 .00 .00 .00 .00 -.99 +S07 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .01 .22 .05 .05 .14 .11 .01 .00 .01 .00 .01 .00 .01 -.99 +S08 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .01 .03 .02 .14 .21 .11 .01 .00 .00 .01 .00 .00 -.99 +S09 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .01 .00 .01 -.88 .00 .00 .00 .01 .01 .01 .01 .01 -.99 +S10 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .01 .04 .03 .15 .29 .09 .00 .00 .00 .00 .00 .00 .00 -.99 +S11 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .01 .01 .01 .01 .02 .02 -.99 +S12 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 -.88 -.88 -.88 .05 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .02 -.88 -.88 .00 -.88 .04 1.25 -.99 +S13 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 +S14 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .01 .08 .04 .00 .00 .00 .00 .00 -.99 +S15 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .02 .03 .00 .00 .00 .00 .00 -.99 +S16 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .02 .01 .01 .00 -.99 +S17 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 +S18 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .02 .02 .01 .00 .01 -.99 +SF01 -.99 -.99 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 +SF02 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 +SR01 -.99 -.99 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .07 .35 .73 .74 .80 .82 .67 .55 .45 .24 .08 -.99 .03 .04 .04 .03 .00 +SR02 -.99 -.99 -.99 -.99 -.99 -.99 -.99 .00 .00 -.99 .00 .00 .00 .00 .00 .00 .00 .10 .31 .44 .49 .30 .11 .02 .05 .07 .05 .04 .00 .00 +SR03 -.99 -.99 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .02 .08 .11 .14 .21 .24 .20 .16 .15 .16 .15 .14 .08 .01 +SR04 -.99 -.99 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .02 .15 .33 .24 .25 .08 .01 .02 .03 .03 +UK01 -.99 -.88 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .01 .00 .03 .01 .68 .00 .06 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 +UK02 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.99 -.88 -.88 -.88 -.99 -.99 -.99 -.99 -.99 -.99 -.99 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 +UK03 -.99 .00 .00 .00 .00 .03 .01 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 .00 .00 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 +UK04 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 +UK05 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 +UK06 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 .01 .02 .02 .02 .02 .01 .00 .00 .01 .00 .00 -.99 -.99 -.99 -.99 -.99 +UK07 -.99 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 .00 -.99 -.99 -.99 -.99 -.99 diff --git a/tests/default_options/COMMAND b/tests/default_options/COMMAND index 24e6d08c7cd9a2efa725718ea4de1212839b8e73..6c2bc56e0b5ad65ce2c105e6edfb68c598b09604 100644 --- a/tests/default_options/COMMAND +++ b/tests/default_options/COMMAND @@ -40,5 +40,5 @@ NXSHIFT= 0, ! Shift of the global meteorological data. Default 359 for ECMWF and 0 for GFS if not given MAXTHREADGRID= 1, ! Set maximum number of threads for doing grid computations. Recommended to set this no higher than 16. High numbers create more overhead and a larger memory footprint, 1=no parallelisation on grid. MAXFILESIZE= 10000, ! Maximum output of each partoutput NetCDF-4 file in Mb before a new one is created - LOGVERTINTERP= 0, ! Flag to set all vertical interpolation to logarithmic instead of linear + LOGVERTINTERP= 0, ! Flag to set all vertical interpolation to logarithmic instead of linear / diff --git a/tests/default_options/RECEPTORS b/tests/default_options/RECEPTORS deleted file mode 100644 index 91806c1b31cc870f36da4fd149df5330faeda4f6..0000000000000000000000000000000000000000 --- a/tests/default_options/RECEPTORS +++ /dev/null @@ -1,10 +0,0 @@ -&RECEPTORS - RECEPTOR="receptor 1", - LON = 0.0000000, - LAT = 0.0000000, - / -&RECEPTORS - RECEPTOR="receptor 2", - LON = 1.00000000, - LAT = 0.00000000, - / diff --git a/tests/default_options/SPECIES/SPECIES.README b/tests/default_options/SPECIES/SPECIES.README deleted file mode 100644 index 4a1e85794825f819fbbb2afdcf655101ca9a3369..0000000000000000000000000000000000000000 --- a/tests/default_options/SPECIES/SPECIES.README +++ /dev/null @@ -1,18 +0,0 @@ -Specifies all physico-chemical properties for the species. - -To generate an overview table compile the specoverview.f90 program - -gfortran specoverview.f90 -o specoverview -./specoverview - -UPDATE FOR FLEXPART VERSION 10.0 DEV: --------------------------------------------------------------------------------- -Please note that the format of the SPECIES files has changed from the previous -version (9.2) of FLEXPART and it is important to update all SPECIES files -accordingly. The use of SPECIES files from older FLEXPART versions may lead to -run-time errors or erroneous results. --------------------------------------------------------------------------------- -Half life due to radioactive or chemical decay and can be switched off by -specifying a negative value. Molecular weight (molweight of the species, needed -for mixing ratio output) --------------------------------------------------------------------------------- diff --git a/tests/default_options/SPECIES/SPECIES_002 b/tests/default_options/SPECIES/SPECIES_002 deleted file mode 100644 index 371e65b09b7f5844798f08843826a98890ba188b..0000000000000000000000000000000000000000 --- a/tests/default_options/SPECIES/SPECIES_002 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="O3", ! Tracer name - PDECAY=-9.9, ! Species half life - PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho - PDQUER=0., ! Dry deposition (particles) - dquer - PDSIGMA=0., ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.9, ! Alternative: dry deposition velocity - PRELDIFF=1.6, ! Dry deposition (gases) - D - PHENRY=1.0E-2, ! Dry deposition (gases) - Henrys const. - PF0=1, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=48.0, ! molweight - POHCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - / diff --git a/tests/default_options/SPECIES/SPECIES_003 b/tests/default_options/SPECIES/SPECIES_003 deleted file mode 100644 index 3df5f23c95c7778e2962877e8b33e34e82684bb3..0000000000000000000000000000000000000000 --- a/tests/default_options/SPECIES/SPECIES_003 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="NO", ! Tracer name - PDECAY=-9.9, ! Species half life - PWETA_GAS=8.0E-6, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho - PDQUER=0.0, ! Dry deposition (particles) - dquer - PDSIGMA=0.0, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=1.2, ! Dry deposition (gases) - D - PHENRY=2.0E-03, ! Dry deposition (gases) - Henrys const. - PF0=0.0, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=30.0, ! molweight - POHCCONST=-0.9E+9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9 ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - / diff --git a/tests/default_options/SPECIES/SPECIES_004 b/tests/default_options/SPECIES/SPECIES_004 deleted file mode 100644 index 2fea08e601e305dc0d98e3a6f6c7fbe2320eb182..0000000000000000000000000000000000000000 --- a/tests/default_options/SPECIES/SPECIES_004 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="NO2", ! Tracer name - PDECAY=-9.9, ! Species half life - PWETA_GAS=1.0E-05, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=-0.9E9, ! Dry deposition (particles) - rho - PDQUER=0.0, ! Dry deposition (particles) - dquer - PDSIGMA=0.0, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=1.6, ! Dry deposition (gases) - D - PHENRY=1.0E-02, ! Dry deposition (gases) - Henrys const. - PF0=0.1, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=46.0, ! molweight - POHCCONST=-0.9E9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - / diff --git a/tests/default_options/SPECIES/SPECIES_005 b/tests/default_options/SPECIES/SPECIES_005 deleted file mode 100644 index 900a461cc8fbc924797f2f21e2e83c782adc5738..0000000000000000000000000000000000000000 --- a/tests/default_options/SPECIES/SPECIES_005 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="HNO3", ! Tracer name - PDECAY=-9.9, ! Species half life - PWETA_GAS=8.0E-04, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho - PDQUER=0.0, ! Dry deposition (particles) - dquer - PDSIGMA=0.0, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=1.9, ! Dry deposition (gases) - D - PHENRY=1E14, ! Dry deposition (gases) - Henrys const. - PF0=0, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=63.0, ! molweight - POHCCONST=-0.9E+9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - / diff --git a/tests/default_options/SPECIES/SPECIES_006 b/tests/default_options/SPECIES/SPECIES_006 deleted file mode 100644 index 446441a69dd50bcbaf9b6c246f7f924538716087..0000000000000000000000000000000000000000 --- a/tests/default_options/SPECIES/SPECIES_006 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="HNO2", ! Tracer name - PDECAY=-9.9, ! Species half life - PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho - PDQUER=0.0, ! Dry deposition (particles) - dquer - PDSIGMA=0.0, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=1.6, ! Dry deposition (gases) - D - PHENRY=100000.0, ! Dry deposition (gases) - Henrys const. - PF0=.1, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=47.0, ! molweight - POHCCONST=-0.9E+9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - / diff --git a/tests/default_options/SPECIES/SPECIES_007 b/tests/default_options/SPECIES/SPECIES_007 deleted file mode 100644 index 362ff3ae308077ce499379d474c950f119b40a64..0000000000000000000000000000000000000000 --- a/tests/default_options/SPECIES/SPECIES_007 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="H2O2", ! Tracer name - PDECAY=-9.9, ! Species half life - PWETA_GAS=1.0E-04, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho - PDQUER=0.0, ! Dry deposition (particles) - dquer - PDSIGMA=0.0, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=1.4, ! Dry deposition (gases) - D - PHENRY=100000.0, ! Dry deposition (gases) - Henrys const. - PF0=1.0, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=34.0, ! molweight - POHCCONST=-0.9E+9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - / diff --git a/tests/default_options/SPECIES/SPECIES_008 b/tests/default_options/SPECIES/SPECIES_008 deleted file mode 100644 index 5c49b9b07ca682b503881893aa1c5e4506e21259..0000000000000000000000000000000000000000 --- a/tests/default_options/SPECIES/SPECIES_008 +++ /dev/null @@ -1,26 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="NO2", ! Tracer name - PDECAY=-9.9, ! Species half life - PWETA_GAS=1.0E-05, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=-0.9E9, ! Dry deposition (particles) - rho - PDQUER=0.0, ! Dry deposition (particles) - dquer - PDSIGMA=0.0, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=1.6, ! Dry deposition (gases) - D - PHENRY=1.0E-02, ! Dry deposition (gases) - Henrys const. - PF0=0.1, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=46.0, ! molweight - POHCCONST=-0.9E9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - PAREA_HOUR=0.578, 0.491, 0.428, 0.329, 0.384, 0.485, 0.763, 1.103, 1.084, 1.047, 1.096, 1.196, 1.298, 1.357, 1.447, 1.565, 1.636, 1.662, 1.401, 1.168, 1.031, 0.926, 0.816, 0.709, - PPOINT_HOUR=0.845, 0.806, 0.786, 0.779, 0.793, 0.832, 0.895, 0.977, 1.031, 1.071, 1.105, 1.118, 1.131, 1.136, 1.143, 1.141, 1.133, 1.118, 1.097, 1.091, 1.079, 1.036, 0.966, 0.892, - PAREA_DOW=1.060, 1.060, 1.060, 1.060, 1.060, 0.900, 0.000, - PPOINT_DOW=1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, - / diff --git a/tests/default_options/SPECIES/SPECIES_009 b/tests/default_options/SPECIES/SPECIES_009 deleted file mode 100644 index b15e09554361536c1c8b32906e52bbe191879843..0000000000000000000000000000000000000000 --- a/tests/default_options/SPECIES/SPECIES_009 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="HCHO", ! Tracer name - PDECAY=-9.9, ! Species half life - PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho - PDQUER=0.0, ! Dry deposition (particles) - dquer - PDSIGMA=0.0, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=1,3, ! Dry deposition (gases) - D - PHENRY=6000.0, ! Dry deposition (gases) - Henrys const. - PF0=-9, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=30.0, ! molweight - POHCCONST=-0.9E+9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - / diff --git a/tests/default_options/SPECIES/SPECIES_010 b/tests/default_options/SPECIES/SPECIES_010 deleted file mode 100644 index 2fb4e88d6d5a676b86bafbf6e796ea6aa536372f..0000000000000000000000000000000000000000 --- a/tests/default_options/SPECIES/SPECIES_010 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="PAN", ! Tracer name - PDECAY=-9.9, ! Species half life - PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho - PDQUER=0.0, ! Dry deposition (particles) - dquer - PDSIGMA=0.0, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=2.6, ! Dry deposition (gases) - D - PHENRY=3.6, ! Dry deposition (gases) - Henrys const. - PF0=0.1, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=121.0, ! molweight - POHCCONST=-0.9E+9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - / diff --git a/tests/default_options/SPECIES/SPECIES_011 b/tests/default_options/SPECIES/SPECIES_011 deleted file mode 100644 index 371c515e066acf5aa270eca7071d3565b2f37a46..0000000000000000000000000000000000000000 --- a/tests/default_options/SPECIES/SPECIES_011 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="NH3", ! Tracer name - PDECAY=-9.9, ! Species half life - PWETA_GAS=9.9E-05, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho - PDQUER=0.0, ! Dry deposition (particles) - dquer - PDSIGMA=0.0, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=1.1, ! Dry deposition (gases) - D - PHENRY=2.0E14, ! Dry deposition (gases) - Henrys const. - PF0=0.0, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=17.0, ! molweight - POHCCONST=-0.9E+9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - / diff --git a/tests/default_options/SPECIES/SPECIES_012 b/tests/default_options/SPECIES/SPECIES_012 index d4bd4ac24b38100229c704304ae96b6c0c33c4df..a7bc64467c26418f9de0438f872ae1e1dc277c27 100644 --- a/tests/default_options/SPECIES/SPECIES_012 +++ b/tests/default_options/SPECIES/SPECIES_012 @@ -1,22 +1,10 @@ &SPECIES_PARAMS - PSPECIES="SO4-aero", ! Tracer name - PDECAY=-9.9, ! Species half life - PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=1.0, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=1.0, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=0.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=0.1, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=2000.0, ! Dry deposition (particles) - rho - PDQUER=4.0E-07, ! Dry deposition (particles) - dquer - PDSIGMA=3.3, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=-9.9, ! Dry deposition (gases) - D - PHENRY=-0.9E+9, ! Dry deposition (gases) - Henrys const. - PF0=-9, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=-9.9, ! molweight - POHCCONST=-0.9E+9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) + PSPECIES="SO4-aero", ! Tracer name + PCRAIN_AERO=1.0, ! Below-cloud scavenging (particles) - Crain (crain_aero) [Grythe et al. (2017)] + PCSNOW_AERO=1.0, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) [Grythe et al. (2017)] + PCCN_AERO=0.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) [Grythe et al. (2017)] + PIN_AERO=0.1, ! In-cloud scavenging (particles) - INeff (in_aero) [Grythe et al. (2017)] + PDENSITY=2.0E+03, ! Dry deposition (particles) - rho + PDIA=4.0E-07, ! Dry deposition (particles) - dquer [Tunved et al., 2013] + PDSIGMA=1.5, ! Dry deposition (particles) - dsig [Tunved et al., 2013] / diff --git a/tests/default_options/SPECIES/SPECIES_013 b/tests/default_options/SPECIES/SPECIES_013 deleted file mode 100644 index 21da254fcdd378f610aca68f96f3c5af9b20ba01..0000000000000000000000000000000000000000 --- a/tests/default_options/SPECIES/SPECIES_013 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="NO3-aero", ! Tracer name - PDECAY=-9.9, ! Species half life - PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=1.0, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=1.0, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=0.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=0.1, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=2.0E+3, ! Dry deposition (particles) - rho - PDQUER=4.0E-07, ! Dry deposition (particles) - dquer - PDSIGMA=3.3, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=-9.9, ! Dry deposition (gases) - D - PHENRY=-0.9E+9, ! Dry deposition (gases) - Henrys const. - PF0=-9, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=-9.9, ! molweight - POHCCONST=-0.9E+9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - / diff --git a/tests/default_options/SPECIES/SPECIES_014 b/tests/default_options/SPECIES/SPECIES_014 deleted file mode 100644 index 5ad9079085e99f49c04992745030961373892f70..0000000000000000000000000000000000000000 --- a/tests/default_options/SPECIES/SPECIES_014 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="I2-131", ! Tracer name - PDECAY=691200.0, ! Species half life - PWETA_GAS=8.0E-05, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho - PDQUER=0.0, ! Dry deposition (particles) - dquer - PDSIGMA=0.0, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=2.7, ! Dry deposition (gases) - D - PHENRY=100000.0, ! Dry deposition (gases) - Henrys const. - PF0=0.1, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=-9.9, ! molweight - POHCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - / diff --git a/tests/default_options/SPECIES/SPECIES_015 b/tests/default_options/SPECIES/SPECIES_015 deleted file mode 100644 index d8fad0fa33f09a980ad5fe4ada8ec27d60bcf51a..0000000000000000000000000000000000000000 --- a/tests/default_options/SPECIES/SPECIES_015 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="I-131", ! Tracer name - PDECAY=691200.0, ! Species half life - PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=1.0, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=1.0, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=0.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=0.1, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=2500.0, ! Dry deposition (particles) - rho - PDQUER=6.0E-07, ! Dry deposition (particles) - dquer - PDSIGMA=3.3, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=-9.9, ! Dry deposition (gases) - D - PHENRY=-9.9, ! Dry deposition (gases) - Henrys const. - PF0=-9, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=350.0, ! molweight - POHCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - / diff --git a/tests/default_options/SPECIES/SPECIES_016 b/tests/default_options/SPECIES/SPECIES_016 deleted file mode 100644 index fad26c579c2d9f2f78968e1698d73d3fa88e0350..0000000000000000000000000000000000000000 --- a/tests/default_options/SPECIES/SPECIES_016 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="Cs-137", ! Tracer name - PDECAY=-9.9, ! Species half life - PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=1.0, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=1.0, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=0.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=0.9, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=1900.0, ! Dry deposition (particles) - rho - PDQUER=0.4E-06, ! Dry deposition (particles) - dquer - PDSIGMA=3.3, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=-9.9, ! Dry deposition (gases) - D - PHENRY=-0.9E-9, ! Dry deposition (gases) - Henrys const. - PF0=-9, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=-9.9, ! molweight - POHCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - / diff --git a/tests/default_options/SPECIES/SPECIES_017 b/tests/default_options/SPECIES/SPECIES_017 deleted file mode 100644 index 54d9aec279df0b46b9fbc29ea9e4736b776be20e..0000000000000000000000000000000000000000 --- a/tests/default_options/SPECIES/SPECIES_017 +++ /dev/null @@ -1,23 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="Y-91", ! Tracer name - PDECAY=5037120.0, ! Species half life - PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=1.0, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=1.0, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=0.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=0.1, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=2500.0, ! Dry deposition (particles) - rho - PDQUER=6.0E-07, ! Dry deposition (particles) - dquer - PDSIGMA=3.3, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=-9.9, ! Dry deposition (gases) - D - PHENRY=-0.9E-9, ! Dry deposition (gases) - Henrys const. - PF0=-9.0, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=350.0, ! molweight - POHCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - / diff --git a/tests/default_options/SPECIES/SPECIES_018 b/tests/default_options/SPECIES/SPECIES_018 deleted file mode 100644 index e10df5743d8b18d2d5732006eba361ef5f60ee9b..0000000000000000000000000000000000000000 --- a/tests/default_options/SPECIES/SPECIES_018 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="Ru-106", ! Tracer name - PDECAY=31536000.0, ! Species half life - PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=1.0, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=1.0, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=0.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=0.1, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=2500.0, ! Dry deposition (particles) - rho - PDQUER=6.0E-07, ! Dry deposition (particles) - dquer - PDSIGMA=3.3, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=-9.9, ! Dry deposition (gases) - D - PHENRY=-0.9E-9, ! Dry deposition (gases) - Henrys const. - PF0=-9, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=350.0, ! molweight - POHCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - / diff --git a/tests/default_options/SPECIES/SPECIES_019 b/tests/default_options/SPECIES/SPECIES_019 deleted file mode 100644 index 76cc9868d03c2f8c36fce39d402bb6b337a5bca2..0000000000000000000000000000000000000000 --- a/tests/default_options/SPECIES/SPECIES_019 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="Kr-85", ! Tracer name - PDECAY=-9.9, ! Species half life - PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho - PDQUER=0.0, ! Dry deposition (particles) - dquer - PDSIGMA=0.0, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=-9.9, ! Dry deposition (gases) - D - PHENRY=-0.9E-9, ! Dry deposition (gases) - Henrys const. - PF0=-9, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=83.8, ! molweight - POHCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - / diff --git a/tests/default_options/SPECIES/SPECIES_020 b/tests/default_options/SPECIES/SPECIES_020 deleted file mode 100644 index 17dafa57ed84681ac468be1008e35d7551a6829a..0000000000000000000000000000000000000000 --- a/tests/default_options/SPECIES/SPECIES_020 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="Sr-90", ! Tracer name - PDECAY=-9.9, ! Species half life - PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=1.0, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=1.0, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=0.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=0.1, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=2500.0, ! Dry deposition (particles) - rho - PDQUER=6.0E-07, ! Dry deposition (particles) - dquer - PDSIGMA=3.3, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=-9.9, ! Dry deposition (gases) - D - PHENRY=-0.9E-9, ! Dry deposition (gases) - Henrys const. - PF0=-9, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=-9.9, ! molweight - POHCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - / diff --git a/tests/default_options/SPECIES/SPECIES_022 b/tests/default_options/SPECIES/SPECIES_022 deleted file mode 100644 index 50accc0769f96843b96d488b588d3cb095b9528b..0000000000000000000000000000000000000000 --- a/tests/default_options/SPECIES/SPECIES_022 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="CO", ! Tracer name - PDECAY=-9.9, ! Species half life - PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho - PDQUER=0.0, ! Dry deposition (particles) - dquer - PDSIGMA=0.0, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=-9.9, ! Dry deposition (gases) - D - PHENRY=-0.9E-9, ! Dry deposition (gases) - Henrys const. - PF0=-9, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=28.0, ! molweight - POHCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - / diff --git a/tests/default_options/SPECIES/SPECIES_023 b/tests/default_options/SPECIES/SPECIES_023 deleted file mode 100644 index 12461e766ff8be1afa78632dc81dac228cbfdde3..0000000000000000000000000000000000000000 --- a/tests/default_options/SPECIES/SPECIES_023 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="SO2", ! Tracer name - PDECAY=-9.9, ! Species half life - PWETA_GAS=2.0E-05, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=-0.9E-9, ! Dry deposition (particles) - rho - PDQUER=0.0, ! Dry deposition (particles) - dquer - PDSIGMA=0.0, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=2.0, ! Dry deposition (gases) - D - PHENRY=100000.0, ! Dry deposition (gases) - Henrys const. - PF0=0, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=64.0, ! molweight - POHCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - / diff --git a/tests/default_options/SPECIES/SPECIES_024 b/tests/default_options/SPECIES/SPECIES_024 index 92284f313318b9049fd380055b1bb98b2af05b3f..0b72d267ad9518d343df3331c5b50ca9a18ae7a6 100644 --- a/tests/default_options/SPECIES/SPECIES_024 +++ b/tests/default_options/SPECIES/SPECIES_024 @@ -10,13 +10,12 @@ PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho PDQUER=0.0, ! Dry deposition (particles) - dquer PDSIGMA=0.0, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia PDRYVEL=-9.99, ! Alternative: dry deposition velocity PRELDIFF=-9.9, ! Dry deposition (gases) - D PHENRY=-0.9E-9, ! Dry deposition (gases) - Henrys const. PF0=-9, ! Dry deposition (gases) - f0 (reactivity) PWEIGHTMOLAR=29.0, ! molweight - POHCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) + PCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec] + PDCONST=-9.9, ! OH Reaction rate - D [K] + PNCONST=2.0, ! OH Reaction rate - N (no unit) / diff --git a/tests/default_options/SPECIES/SPECIES_025 b/tests/default_options/SPECIES/SPECIES_025 deleted file mode 100644 index f41666a29cdb623ab9294586dadcf8e7cfc3d4e7..0000000000000000000000000000000000000000 --- a/tests/default_options/SPECIES/SPECIES_025 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="AERO-TRACE", ! Tracer name - PDECAY=-9.9, ! Species half life - PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=1.0, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=1.0, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=0.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=0.1, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=1400.0, ! Dry deposition (particles) - rho - PDQUER=2.5E-07, ! Dry deposition (particles) - dquer - PDSIGMA=1.25, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=-9.9, ! Dry deposition (gases) - D - PHENRY=-0.9E-9, ! Dry deposition (gases) - Henrys const. - PF0=-9, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=-9.9, ! molweight - POHCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - / diff --git a/tests/default_options/SPECIES/SPECIES_026 b/tests/default_options/SPECIES/SPECIES_026 deleted file mode 100644 index da37f55e982a184134c86ce41f8f5ef602c09bd6..0000000000000000000000000000000000000000 --- a/tests/default_options/SPECIES/SPECIES_026 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="CH4", ! Tracer name - PDECAY=-9.9, ! Species half life - PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho - PDQUER=0.0, ! Dry deposition (particles) - dquer - PDSIGMA=0.0, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=-9.9, ! Dry deposition (gases) - D - PHENRY=-0.9E-9, ! Dry deposition (gases) - Henrys const. - PF0=-9, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=16.0, ! molweight - POHCCONST=9.65E-20, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=1082.0, ! OH Reaction rate - D [K] - POHNCONST=2.58, ! OH Reaction rate - N (no unit) - / diff --git a/tests/default_options/SPECIES/SPECIES_027 b/tests/default_options/SPECIES/SPECIES_027 deleted file mode 100644 index 6265f9ba6f1004b7486207052a0b85a9075cb220..0000000000000000000000000000000000000000 --- a/tests/default_options/SPECIES/SPECIES_027 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="C2H6", ! Tracer name - PDECAY=-9.9, ! Species half life - PWETA_GAS=-0.9E-9, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=-9.9, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho - PDQUER=0.0, ! Dry deposition (particles) - dquer - PDSIGMA=0.0, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=-9.9, ! Dry deposition (gases) - D - PHENRY=-0.9E-9, ! Dry deposition (gases) - Henrys const. - PF0=-9, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=30.0, ! molweight - POHCCONST=15.2E-18, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=498.0, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - N (no unit) - / diff --git a/tests/default_options/SPECIES/SPECIES_028 b/tests/default_options/SPECIES/SPECIES_028 deleted file mode 100644 index 4e92447c237978dd059312b51173d651e52e70a0..0000000000000000000000000000000000000000 --- a/tests/default_options/SPECIES/SPECIES_028 +++ /dev/null @@ -1,7 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="C3H8 ", - PWEIGHTMOLAR= 44.0000000 , - POHCCONST= 1.55-E17, - POHDCONST= 61.0000000 , - POHNCONST= 2.00000000 , - / diff --git a/tests/default_options/SPECIES/SPECIES_031 b/tests/default_options/SPECIES/SPECIES_031 deleted file mode 100644 index 701f2866389a6e527e4bb25a0bbab198823cca6c..0000000000000000000000000000000000000000 --- a/tests/default_options/SPECIES/SPECIES_031 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="PCB28", ! Tracer name - PDECAY=-9.9, ! Species half life - PWETA_GAS=3.5E-05, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho - PDQUER=0.0, ! Dry deposition (particles) - dquer - PDSIGMA=0.0, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=4.3, ! Dry deposition (gases) - D - PHENRY=3.1, ! Dry deposition (gases) - Henrys const. - PF0=0.1, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=257.54, ! molweight - POHCCONST=1.07E-11, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=1203.0, ! OH Reaction rate - D [K] - POHNCONST=0.0, ! OH Reaction rate - N (no unit) - / diff --git a/tests/default_options/SPECIES/SPECIES_034 b/tests/default_options/SPECIES/SPECIES_034 deleted file mode 100644 index 5e7ebe277313703828a58db941f89e68058d8757..0000000000000000000000000000000000000000 --- a/tests/default_options/SPECIES/SPECIES_034 +++ /dev/null @@ -1,22 +0,0 @@ -&SPECIES_PARAMS - PSPECIES="G-HCH", ! Tracer name - PDECAY=-9.9, ! Species half life - PWETA_GAS=3.5E-05, ! Below-cloud scavenging (gases) - A (weta_gas) - PWETB_GAS=0.62, ! Below-cloud scavenging (gases) - B (wetb_gas) - PCRAIN_AERO=-9.9, ! Below-cloud scavenging (particles) - Crain (crain_aero) - PCSNOW_AERO=-9.9, ! Below-cloud scavenging (particles) - Csnow (csnow_aero) - PCCN_AERO=-9.9, ! In-cloud scavenging (particles) - CCNeff (ccn_aero) - PIN_AERO=-9.9, ! In-cloud scavenging (particles) - INeff (in_aero) - PDENSITY=-0.9E+9, ! Dry deposition (particles) - rho - PDQUER=0.0, ! Dry deposition (particles) - dquer - PDSIGMA=0.0, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia - PDRYVEL=-9.99, ! Alternative: dry deposition velocity - PRELDIFF=4.3, ! Dry deposition (gases) - D - PHENRY=422.0, ! Dry deposition (gases) - Henrys const. - PF0=0.1, ! Dry deposition (gases) - f0 (reactivity) - PWEIGHTMOLAR=290.83, ! molweight - POHCCONST=6.21E-11, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=1203.0, ! OH Reaction rate - D [K] - POHNCONST=2.00, ! OH Reaction rate - N (no unit) - / diff --git a/tests/default_options/SPECIES/SPECIES_040 b/tests/default_options/SPECIES/SPECIES_040 index c84cd113fa009123a28c09b5833f8595401d7c77..a3610c4a51640c8c7be40b741e1fc3c1c199c625 100644 --- a/tests/default_options/SPECIES/SPECIES_040 +++ b/tests/default_options/SPECIES/SPECIES_040 @@ -10,15 +10,14 @@ PDENSITY=1000.0, ! Dry deposition (particles) - rho PDQUER=50.0E-06, ! Dry deposition (particles) - dquer (equivalent diameter for shape) PDSIGMA=3.3, ! Dry deposition (particles) - dsig - PNDIA=1, ! Dry deposition (particles) - ndia PDRYVEL=-9.9, ! Alternative: dry deposition velocity PRELDIFF=-9.9, ! Dry deposition (gases) - D PHENRY=-0.9E-9, ! Dry deposition (gases) - Henrys const. PF0=-9, ! Dry deposition (gases) - f0 (reactivity) PWEIGHTMOLAR=-9.9, ! molweight - POHCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec] - POHDCONST=-9.9, ! OH Reaction rate - D [K] - POHNCONST=2.0, ! OH Reaction rate - C [cm^3/molecule/sec] + PCCONST=-0.9E-9, ! OH Reaction rate - C [cm^3/molecule/sec] + PDCONST=-9.9, ! OH Reaction rate - D [K] + PNCONST=2.0, ! OH Reaction rate - C [cm^3/molecule/sec] PSHAPE=1, ! 0 for sphere, 1 any shape (defined by axes PLA,PIA,PSA), 2-cylinder, 3-cube, 4-tetrahedron, 5-octahedron, 6-ellipsoid PASPECTRATIO=20.0 ! Aspect ratio of cylinders: works for PSHAPE=2 only PLA=940, ! Longest axis in micrometer (Bagheri & Bonadonna 2016): only for PSHAPE=1 diff --git a/tests/default_options/SPECIES/SPECIES_050 b/tests/default_options/SPECIES/SPECIES_050 new file mode 100644 index 0000000000000000000000000000000000000000..cd31071d77da59e030f5fc1c302f7d8871576192 --- /dev/null +++ b/tests/default_options/SPECIES/SPECIES_050 @@ -0,0 +1,17 @@ +&SPECIES_PARAMS + PSPECIES="DUST-1um ", + PCRAIN_AERO= 1.00000000 , + PCSNOW_AERO= 1.00000000 , + PCCN_AERO= 0.150000000 , + PIN_AERO= 0.020000000 , + PRELDIFF= -9.89999962 , + PHENRY= 9.99999972E-10, + PF0= 0.00000000 , + PDENSITY= 2650.00000 , + PDQUER= 9.99999997E-07, + PDSIGMA= 1.10000002 , + PAREA_DOW= 7*1.00000000 , + PAREA_HOUR= 24*1.00000000 , + PPOINT_DOW= 7*1.00000000 , + PPOINT_HOUR= 24*1.00000000 , + / diff --git a/tests/default_options/SPECIES/SPECIES_051 b/tests/default_options/SPECIES/SPECIES_051 new file mode 100644 index 0000000000000000000000000000000000000000..47bc33e811b8bf413ab4d250329da85a005a5684 --- /dev/null +++ b/tests/default_options/SPECIES/SPECIES_051 @@ -0,0 +1,16 @@ +&SPECIES_PARAMS + PSPECIES="DUST-5um ", + PCRAIN_AERO= 1.00000000 , + PCSNOW_AERO= 1.00000000 , + PCCN_AERO= 0.150000000 , + PIN_AERO= 0.020000000 , + PHENRY= 9.99999972E-10, + PF0= 0.00000000 , + PDENSITY= 2650.00000 , + PDQUER= 4.99999987E-06, + PDSIGMA= 1.10000002 , + PAREA_DOW= 7*1.00000000 , + PAREA_HOUR= 24*1.00000000 , + PPOINT_DOW= 7*1.00000000 , + PPOINT_HOUR= 24*1.00000000 , + / diff --git a/tests/default_options/SPECIES/specoverview.f90 b/tests/default_options/SPECIES/specoverview.f90 deleted file mode 100644 index 065b5721ad42ca7a478b2491d88332c11529ff49..0000000000000000000000000000000000000000 --- a/tests/default_options/SPECIES/specoverview.f90 +++ /dev/null @@ -1,115 +0,0 @@ -!********************************************************************** -! Copyright 1998,1999,2000,2001,2002,2005,2007,2008,2009,2010 * -! Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa, * -! Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann * -! * -! This file is part of FLEXPART. * -! * -! FLEXPART 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. * -! * -! FLEXPART 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 FLEXPART. If not, see <http://www.gnu.org/licenses/>. * -!********************************************************************** - implicit none - - character(len=11) :: speciesfn - character(len=3) :: aspec - character(len=16) :: pspecies - real :: pdecay, pweta_gas, pwetb_gas, preldiff, phenry, pf0, pdensity, pdquer - real :: pdsigma, pdryvel, pweightmolar, pohcconst, pohdconst, pohnconst - real :: pcrain_aero, pcsnow_aero, pccn_aero, pin_aero - integer :: readerror, unitspecies, specnumber - -! declare namelist - namelist /species_params/ & - pspecies, pdecay, pweta_gas, pwetb_gas, & - pcrain_aero, pcsnow_aero, pccn_aero, pin_aero, & - preldiff, phenry, pf0, pdensity, pdquer, & - pdsigma, pdryvel, pweightmolar, pohcconst, pohdconst, pohnconst - - unitspecies=4 - - write(*,*) ' Species | | WetDep(gas) | DryDep(gas) |WetDep(below-C)| WetDep(in-C)|'//& - ' DryDepo(particles) Altern| Radioact. | OH Reaction |' - - write(*,*) ' Name |molwght| A B | D H f0 | Crain Csnow | ccn in |' //& - ' rho dquer dsig vd | Halflife[s]| C** D[T] N*** |' - - write(*,*) '--------------|-------|-----------------|------------------|---------------|-------------|'//& - '-------------------------------|------------|----------------------|' - - -! write(*,*) ' Specie | Radioact. | WetDep(gas) |WetDep(below-C)| WetDep(in-C)| DryDepo(gas) |'//& -! ' DryDepo(particles) Altern| | OH Reaction |' -! write(*,*) ' Name | Halflife[s]| A B | Crain Csnow | ccn in | D H f0 |' //& -! ' rho dquer dsig vd |molwght| C** D[T] N*** |' -! write(*,*) '--------------|------------|-----------------|---------------|-------------|-------------------|'//& -! '-------------------------------|-------|----------------------|' - - do specnumber=1,100 - - write (aspec,'(i0.3)') specnumber - speciesfn='SPECIES_'//aspec - -! write(*,*) 'Processing: ',speciesfn - - pspecies="" ! read failure indicator value - pdecay=-9.9 - pweta_gas=-0.9E-09 - pwetb_gas=0.0 - pcrain_aero=-9.9 - pcsnow_aero=-9.9 - pccn_aero=-9.9 - pin_aero=-9.9 - preldiff=-9.9 - phenry=0.0 - pf0=0.0 - pdensity=-0.9E09 - pdquer=0.0 - pdsigma=0.0 - pdryvel=-9.99 - pohcconst=-9.9 - pohdconst=-9.9 - pohnconst=2.0 - pweightmolar=-9.9 - -! Open the SPECIES file and read species names and properties -!************************************************************ - open(unitspecies,file=speciesfn,status='old',form='formatted',err=998) - read(unitspecies,species_params,err=998) - close(unitspecies) - - write(*,45) specnumber,' ',pspecies,'|',pweightmolar,'|',pweta_gas,' ',pwetb_gas,'|', & - preldiff,' ',phenry,' ',pf0,'|', & - pcrain_aero,' ',pcsnow_aero,'|',pccn_aero,' ',pin_aero,'|', & - pdensity,pdquer,pdsigma,pdryvel,'|',pdecay,'|',pohcconst,pohdconst,pohnconst,'|' - -45 format(i3,a1,a11,a1,f7.1,a1,e8.1,a1,f8.2,a1, & - f4.1,a1,e8.1,a1,f4.1,a1, & - f7.1,a1,f7.1,a1,f6.1,a1,f6.1,a1, & - e8.1,e9.1,f7.1,f7.2,a1,f12.1,a1,e8.1,f7.1,f7.1,a1) - -! write(*,45) specnumber,' ',pspecies,'|',pdecay,'|',pweta_gas,' ',pwetb_gas,'|',pcrain_aero,' ', & -! pcsnow_aero,'|',pccn_aero,' ',pin_aero,'|',preldiff,' ',phenry,' ',pf0,'|', & -! pdensity,pdquer,pdsigma,pdryvel,'|',pweightmolar,'|',pohcconst,pohdconst,pohnconst,'|' - -!5 format(i3,a1,a11,a1,f12.1,a1,e8.1,a1,f8.2,a1,f7.1,a1,f7.1,a1,f6.1,a1,f6.1,a1,f5.1,a1,e8.1,a1,f4.1,a1, & -! e8.1,e9.1,f7.1,f7.2,a1,f7.1,a1,e8.1,f7.1,f7.1,a1) - -998 continue -enddo - -write(*,*) '** unit [cm^3/molec/s] (in FLEXPART version 9.2 and below this had unit [cm3/s], note the unit is now changed!)' -write(*,*) '*** no unit' - - print*,'rho: density' - -end diff --git a/tests/default_winds/AVAILABLE_europe b/tests/default_winds/AVAILABLE_europe new file mode 100644 index 0000000000000000000000000000000000000000..148f27c135e285b93a3dfbdcd920e4550a05d980 --- /dev/null +++ b/tests/default_winds/AVAILABLE_europe @@ -0,0 +1,5 @@ +XXXXXX EMPTY LINES XXXXXXXXX +XXXXXX EMPTY LINES XXXXXXXX +YYYYMMDD HHMMSS name of the file(up to 80 characters) +20090101 000000 EAe2009010100 ON DISK +20090101 060000 EAe2009010106 ON DISK diff --git a/tests/default_winds/AVAILABLE_glob b/tests/default_winds/AVAILABLE_glob new file mode 100644 index 0000000000000000000000000000000000000000..1cac537d7f4e3e5543525c5ab1cc5ae11faa1246 --- /dev/null +++ b/tests/default_winds/AVAILABLE_glob @@ -0,0 +1,5 @@ +XXXXXX EMPTY LINES XXXXXXXXX +XXXXXX EMPTY LINES XXXXXXXX +YYYYMMDD HHMMSS name of the file(up to 80 characters) +20090101 000000 EA2009010100 ON DISK +20090101 060000 EA2009010106 ON DISK diff --git a/tests/etex_test.py b/tests/etex_test.py index 29c630b8f2208fdda5328c4bb5af8ea24f2c80a6..4136440cb563f0ec87f5d636055675616c58bb6b 100644 --- a/tests/etex_test.py +++ b/tests/etex_test.py @@ -66,7 +66,7 @@ class Grid(): class Etex(): def __init__(self, path_to_directory="/home/lucie/ETEX_PS_2000/Statistik_ASt/", - fname = "pmcp.dat",locname="stationlist.950130"): + fname = "pmch2.dat",locname="stationlist.950130"): self.path = path_to_directory self.fname = fname @@ -175,4 +175,4 @@ grid=Grid(path_to_directory="./output_etex/", fname = "grid_conc_19941023160000.nc") etex=Etex(path_to_directory="./default_etex/") econc,gconc=compute_etex_concentrations(grid,etex) -compute_error_measures(econc,gconc,"./etex_test.txt") \ No newline at end of file +compute_error_measures(econc,gconc,"./etex_test.txt") diff --git a/tests/part_ic.nc b/tests/part_ic.nc new file mode 100644 index 0000000000000000000000000000000000000000..5ec33e537c4e90c2732b3564b5be5e81de33fcdc Binary files /dev/null and b/tests/part_ic.nc differ diff --git a/tests/pathnames_nests b/tests/pathnames_nests new file mode 100644 index 0000000000000000000000000000000000000000..491ada3f98de456481e7f9076f5791dc24dd6b53 --- /dev/null +++ b/tests/pathnames_nests @@ -0,0 +1,7 @@ +./current/ +./output/ +./default_winds/ +./default_winds/AVAILABLE_glob +./default_winds/ +./default_winds/AVAILABLE_europe +============================================ \ No newline at end of file diff --git a/tests/run_default_options_test.sh b/tests/run_default_options_test.sh index 2c4d63ad8c7f772a2c390993a08b53892d63b702..d975bda5574db91c6c28f94d68617e804147cc6f 100644 --- a/tests/run_default_options_test.sh +++ b/tests/run_default_options_test.sh @@ -278,6 +278,31 @@ TESTSRUN=$((TESTSRUN + 1)) rm -rf ./current ./output/* # # +#PART_IC.NC input +cp -rf ./default_options ./current +sed -i "/IPIN=/c\ IPIN= 3," ./current/COMMAND +sed -i "/LDIRECT=/c\ LDIRECT= -1," ./current/COMMAND +sed -i "/LOUTRESTART=/c\ LOUTRESTART= 3600," ./current/COMMAND +sed -i "/IOUTPUTFOREACHRELEASE=/c\ IOUTPUTFOREACHRELEASE= 1," ./current/COMMAND +sed -i "/IOUT=/c\ IOUT= 1," ./current/COMMAND +sed -i "/IBTIME=/c\ IBTIME= 020000," ./current/COMMAND +sed -i "/LOUTSTEP=/c\ LOUTSTEP= 3600," ./current/COMMAND +sed -i "/LOUTAVER=/c\ LOUTAVER= 3600," ./current/COMMAND +cp -rf part_ic.nc output/ +./FLEXPART pathnames +report "[$MM] TEST $TESTRUN (IPIN=3)" +STATUS=$((STATUS + $?)) +TESTSRUN=$((TESTSRUN + 1)) + +# and IPIN=4 +mv output/restart_20090101020000 output/restart.bin +sed -i "/IPIN=/c\ IPIN= 4," ./current/COMMAND +./FLEXPART pathnames +report "[$MM] TEST $TESTRUN (IPIN=4)" +STATUS=$((STATUS + $?)) +TESTSRUN=$((TESTSRUN + 1)) +# clean up +rm -rf ./current ./output/* # #IFLUX cp -rf ./default_options ./current diff --git a/tests/run_etex_test.sh b/tests/run_etex_test.sh index 5bda88a0f07c43d2f80486527d4bc1a08710d882..29f932325f4e9c6805d4725c09cb3fad91ee9274 100644 --- a/tests/run_etex_test.sh +++ b/tests/run_etex_test.sh @@ -53,6 +53,8 @@ sed -i "/IBDATE=/c\ IBDATE= 19941023," ./current/COMMAND sed -i "/IBTIME=/c\ IBTIME= 160000," ./current/COMMAND sed -i "/IEDATE=/c\ IEDATE= 19941027," ./current/COMMAND sed -i "/IETIME=/c\ IETIME= 110000," ./current/COMMAND +sed -i "/LOUTSTEP=/c\ LOUTSTEP= 10800," ./current/COMMAND +sed -i "/LOUTAVER=/c\ LOUTAVER= 10800," ./current/COMMAND sed -i "/CTL=/c\ CTL= 10.0000," ./current/COMMAND sed -i "/IFINE=/c\ IFINE= 4," ./current/COMMAND sed -i "/LOUTNETCDFOUT=/c\ LOUTNETCDFOUT= 1," ./current/COMMAND diff --git a/tests/run_nests_test.sh b/tests/run_nests_test.sh new file mode 100644 index 0000000000000000000000000000000000000000..11be1af3474f78087985db9dd903f17e0edf8cb0 --- /dev/null +++ b/tests/run_nests_test.sh @@ -0,0 +1,70 @@ +#!/bin/bash +# By LB +# run ETEX simulations +RED='\033[0;31m' +GREEN='\033[0;32m' +YELLOW='\033[1;33m' +NC='\033[0m' +MM='FLEXPART MANUAL NESTS TEST' + +warning() { + printf "%-68s[$YELLOW%10s$NC]\n" "$@" "SKIPPED" + return 0 +} + +report() { + if [ $? -eq 0 ]; then + printf "%-68s[$GREEN%10s$NC]\n" "$@" "OK" + return 0 + else + printf "%-68s[$RED%10s$NC]\n" "$@" "FAILED" + return 1 + fi +} +# +# initial conditions +# +warning "[$MM] $PWD" +# +# Change to directory of this script +# +cd $(dirname $0) +# +# Check for Flexpart executable build before +# +test -f ../src/FLEXPART +report "[$MM] executable: ../src/FLEXPART" || exit 1 +ln -s ../src/FLEXPART . +ln -s ../src/FLEXPART_ETA . +test -d ./default_options +report "[$MM] default options: ./default_options" || exit 1 +cp -rf ./default_options ./current +# +# Different options tests +# +STATUS=0 +TESTSRUN=0 +# run Options test with nested output +# +sed -i "/LOUTNETCDFOUT=/c\ LOUTNETCDFOUT= 1," ./current/COMMAND + +mkdir -p ./output/ +./FLEXPART pathnames_nests +report "[$MM] TEST $TESTRUN (NESTS)" + +STATUS=$((STATUS + $?)) +TESTSRUN=$((TESTSRUN + 1)) + +./FLEXPART_ETA pathnames_nests +report "[$MM] TEST $TESTRUN (ETA NESTS)" + +STATUS=$((STATUS + $?)) +TESTSRUN=$((TESTSRUN + 1)) +# +# FINAL +# +echo "[$MM] Tests failed: $STATUS / $TESTSRUN" +# +# Return collective error status +# +exit $STATUS \ No newline at end of file diff --git a/tests/settling_master.txt b/tests/settling_master.txt index 1813caf4981134a2dc58fad2939705f9842ab2b9..b2f93a0a268299e3702f6ea4c2d999523988cdbc 100644 --- a/tests/settling_master.txt +++ b/tests/settling_master.txt @@ -1,74 +1,74 @@ - longitude: mean abs: 1.97740594e+01 max abs: 3.07020187e+01 - longitude ETA: mean abs: 1.97740094e+01 max abs: 3.07033710e+01 - longitude_av: mean abs: 1.97848016e+01 max abs: 3.05876732e+01 - longitude_av ETA: mean abs: 1.97847625e+01 max abs: 3.05888042e+01 - latitude: mean abs: 3.48925750e+01 max abs: 5.04721565e+01 - latitude ETA: mean abs: 3.48925312e+01 max abs: 5.04734116e+01 - latitude_av: mean abs: 3.49040125e+01 max abs: 5.04243546e+01 - latitude_av ETA: mean abs: 3.49039750e+01 max abs: 5.04254761e+01 - height: mean abs: 4.84618156e+01 max abs: 1.31529022e+02 - height ETA: mean abs: 4.85209281e+01 max abs: 1.31316452e+02 - height_av: mean abs: 4.86866125e+01 max abs: 1.26583130e+02 - height_av ETA: mean abs: 4.87390250e+01 max abs: 1.26399139e+02 - pv: mean abs: 2.25662422e+00 max abs: 3.21795273e+01 - pv ETA: mean abs: 2.24790234e+00 max abs: 3.22219543e+01 - pv_av: mean abs: 2.23525391e+00 max abs: 3.22249832e+01 - pv_av ETA: mean abs: 2.22549160e+00 max abs: 3.22536697e+01 + lon: mean abs: 1.97740594e+01 max abs: 3.07020264e+01 + lon ETA: mean abs: 1.97740094e+01 max abs: 3.07033691e+01 + lon_av: mean abs: 1.97848031e+01 max abs: 3.05876732e+01 + lon_av ETA: mean abs: 1.97847625e+01 max abs: 3.05888042e+01 + lat: mean abs: 3.48925750e+01 max abs: 5.04721527e+01 + lat ETA: mean abs: 3.48925312e+01 max abs: 5.04734192e+01 + lat_av: mean abs: 3.49040125e+01 max abs: 5.04243584e+01 + lat_av ETA: mean abs: 3.49039750e+01 max abs: 5.04254761e+01 + z: mean abs: 4.84617813e+01 max abs: 1.31528992e+02 + z ETA: mean abs: 4.85208813e+01 max abs: 1.31314911e+02 + z_av: mean abs: 4.86865781e+01 max abs: 1.26583099e+02 + z_av ETA: mean abs: 4.87389781e+01 max abs: 1.26397697e+02 + pv: mean abs: 2.25664551e+00 max abs: 3.21795197e+01 + pv ETA: mean abs: 2.24792422e+00 max abs: 3.22219505e+01 + pv_av: mean abs: 2.23526914e+00 max abs: 3.22249832e+01 + pv_av ETA: mean abs: 2.22550684e+00 max abs: 3.22536697e+01 qv: mean abs: 3.93889465e-03 max abs: 7.79772364e-03 - qv ETA: mean abs: 3.93881683e-03 max abs: 7.79843284e-03 - qv_av: mean abs: 3.92801132e-03 max abs: 7.75149744e-03 - qv_av ETA: mean abs: 3.92791710e-03 max abs: 7.75184669e-03 - rho: mean abs: 1.22830195e+00 max abs: 1.35756600e+00 + qv ETA: mean abs: 3.93881683e-03 max abs: 7.79843098e-03 + qv_av: mean abs: 3.92801170e-03 max abs: 7.75149744e-03 + qv_av ETA: mean abs: 3.92791710e-03 max abs: 7.75184203e-03 + rho: mean abs: 1.22830205e+00 max abs: 1.35756588e+00 rho ETA: mean abs: 1.22826748e+00 max abs: 1.35788083e+00 - rho_av: mean abs: 1.22791484e+00 max abs: 1.35774088e+00 - rho_av ETA: mean abs: 1.22787881e+00 max abs: 1.35802841e+00 - temperature: mean abs: 2.77977625e+02 max abs: 2.87984100e+02 - temperature ETA: mean abs: 2.77983450e+02 max abs: 2.87999176e+02 - temperature_av: mean abs: 2.78092275e+02 max abs: 2.87902893e+02 - temperature_av ETA: mean abs: 2.78098300e+02 max abs: 2.87902832e+02 - pr: mean abs: 9.81952768e+04 max abs: 1.04051203e+05 - pr ETA: mean abs: 9.81946432e+04 max abs: 1.04050156e+05 - pr_av: mean abs: 9.82031680e+04 max abs: 1.03865078e+05 - pr_av ETA: mean abs: 9.82025088e+04 max abs: 1.03864320e+05 - hmix: mean abs: 3.74020600e+02 max abs: 1.81797595e+03 - hmix ETA: mean abs: 3.74021400e+02 max abs: 1.81805615e+03 - hmix_av: mean abs: 3.72722150e+02 max abs: 1.79257666e+03 - hmix_av ETA: mean abs: 3.72722300e+02 max abs: 1.79256348e+03 - tr: mean abs: 1.12843584e+04 max abs: 1.57277559e+04 - tr ETA: mean abs: 1.12843984e+04 max abs: 1.57281152e+04 - tr_av: mean abs: 1.12753376e+04 max abs: 1.57058320e+04 - tr_av ETA: mean abs: 1.12753728e+04 max abs: 1.57061426e+04 - topo: mean abs: 3.23780175e+02 max abs: 1.12426550e+03 - topo ETA: mean abs: 3.23776725e+02 max abs: 1.12414734e+03 - topo_av: mean abs: 3.23853525e+02 max abs: 1.11385352e+03 - topo_av ETA: mean abs: 3.23850750e+02 max abs: 1.11391516e+03 - mass001: mean abs: 9.86679316e-05 max abs: 9.99999975e-05 - mass001 ETA: mean abs: 9.85343039e-05 max abs: 9.99999975e-05 - mass_av001: mean abs: 9.89422262e-05 max abs: 9.99999975e-05 - mass_av001 ETA: mean abs: 9.88323808e-05 max abs: 9.99999975e-05 - u: mean abs: 2.09955117e+00 max abs: 7.07874727e+00 - u ETA: mean abs: 2.10246602e+00 max abs: 7.08937645e+00 - u_av: mean abs: 2.10358027e+00 max abs: 7.12824774e+00 - u_av ETA: mean abs: 2.10650957e+00 max abs: 7.13932705e+00 - v: mean abs: 3.02053320e+00 max abs: 1.11122808e+01 - v ETA: mean abs: 3.02394824e+00 max abs: 1.11222582e+01 - v_av: mean abs: 3.05966094e+00 max abs: 1.12192640e+01 - v_av ETA: mean abs: 3.06319102e+00 max abs: 1.12289562e+01 - w: mean abs: 2.97906446e-04 max abs: 3.80160334e-03 - w ETA: mean abs: 2.97123909e-04 max abs: 3.79444822e-03 - w_av: mean abs: 2.96450281e-04 max abs: 3.69339995e-03 - w_av ETA: mean abs: 2.96099448e-04 max abs: 3.68712912e-03 - settling: mean abs: 3.56945604e-05 max abs: 3.88661101e-05 - settling ETA: mean abs: 3.56944025e-05 max abs: 3.88658809e-05 - settling_av: mean abs: 3.56944948e-05 max abs: 3.88588523e-05 - settling_av ETA: mean abs: 3.56943727e-05 max abs: 3.88586559e-05 - wetdepo001: mean abs: 5.73900342e-07 max abs: 3.03990637e-05 - wetdepo001 ETA: mean abs: 7.07873609e-07 max abs: 3.05098602e-05 - drydepo001: mean abs: 7.58154877e-07 max abs: 4.87260877e-06 - drydepo001 ETA: mean abs: 7.57810473e-07 max abs: 4.87258103e-06 - Concentrations: mean abs: 4.52076849e-05 max abs: 3.61836259e-03 - Concentrations ETA: mean abs: 4.51686803e-05 max abs: 3.61836259e-03 - WET deposition: mean abs: 7.76642049e-05 max abs: 2.48293206e-02 - WET deposition ETA: mean abs: 9.85958565e-05 max abs: 3.75747979e-02 - DRY deposition: mean abs: 9.22456586e-05 max abs: 2.52001104e-03 - DRY deposition ETA: mean abs: 9.22415807e-05 max abs: 2.52443482e-03 + rho_av: mean abs: 1.22791484e+00 max abs: 1.35774064e+00 + rho_av ETA: mean abs: 1.22787891e+00 max abs: 1.35802817e+00 + T: mean abs: 2.77977625e+02 max abs: 2.87984100e+02 + T ETA: mean abs: 2.77983450e+02 max abs: 2.87999176e+02 + T_av: mean abs: 2.78092275e+02 max abs: 2.87903900e+02 + T_av ETA: mean abs: 2.78098275e+02 max abs: 2.87903931e+02 + prs: mean abs: 9.81952768e+04 max abs: 1.04051203e+05 + prs ETA: mean abs: 9.81946432e+04 max abs: 1.04050172e+05 + prs_av: mean abs: 9.82031680e+04 max abs: 1.03865070e+05 + prs_av ETA: mean abs: 9.82025088e+04 max abs: 1.03864328e+05 + hmix: mean abs: 3.74020650e+02 max abs: 1.81797595e+03 + hmix ETA: mean abs: 3.74021500e+02 max abs: 1.81805627e+03 + hmix_av: mean abs: 3.72722200e+02 max abs: 1.79257666e+03 + hmix_av ETA: mean abs: 3.72722425e+02 max abs: 1.79256348e+03 + tro: mean abs: 1.12843584e+04 max abs: 1.57277539e+04 + tro ETA: mean abs: 1.12843984e+04 max abs: 1.57281152e+04 + tro_av: mean abs: 1.12753376e+04 max abs: 1.57058320e+04 + tro_av ETA: mean abs: 1.12753728e+04 max abs: 1.57061416e+04 + to: mean abs: 3.23780200e+02 max abs: 1.12426550e+03 + to ETA: mean abs: 3.23776725e+02 max abs: 1.12415088e+03 + to_av: mean abs: 3.23853500e+02 max abs: 1.11385352e+03 + to_av ETA: mean abs: 3.23850750e+02 max abs: 1.11391602e+03 + m001: mean abs: 9.87321079e-05 max abs: 9.99999975e-05 + m001 ETA: mean abs: 9.86580849e-05 max abs: 9.99999975e-05 + m_av001: mean abs: 9.90111351e-05 max abs: 9.99999975e-05 + m_av001 ETA: mean abs: 9.89460289e-05 max abs: 9.99999975e-05 + u: mean abs: 2.09955020e+00 max abs: 7.07874107e+00 + u ETA: mean abs: 2.10246445e+00 max abs: 7.08939075e+00 + u_av: mean abs: 2.10357930e+00 max abs: 7.12824345e+00 + u_av ETA: mean abs: 2.10650801e+00 max abs: 7.13930893e+00 + v: mean abs: 3.02053164e+00 max abs: 1.11122770e+01 + v ETA: mean abs: 3.02394648e+00 max abs: 1.11222630e+01 + v_av: mean abs: 3.05965898e+00 max abs: 1.12192640e+01 + v_av ETA: mean abs: 3.06318945e+00 max abs: 1.12289639e+01 + w: mean abs: 2.97905493e-04 max abs: 3.80159984e-03 + w ETA: mean abs: 2.97119617e-04 max abs: 3.79439490e-03 + w_av: mean abs: 2.96449280e-04 max abs: 3.69339623e-03 + w_av ETA: mean abs: 2.96115828e-04 max abs: 3.68707534e-03 + vset: mean abs: 3.55857462e-05 max abs: 3.88669905e-05 + vset ETA: mean abs: 3.55858743e-05 max abs: 3.88668086e-05 + vset_av: mean abs: 3.55930209e-05 max abs: 3.88597255e-05 + vset_av ETA: mean abs: 3.55931044e-05 max abs: 3.88595618e-05 + wetdepo001: mean abs: 4.97677177e-07 max abs: 3.10084833e-05 + wetdepo001 ETA: mean abs: 5.72570320e-07 max abs: 3.10087562e-05 + drydepo001: mean abs: 7.70202093e-07 max abs: 4.90112552e-06 + drydepo001 ETA: mean abs: 7.69326324e-07 max abs: 4.90110233e-06 + Concentrations: mean abs: 4.52316050e-05 max abs: 3.61591275e-03 + Concentrations ETA: mean abs: 4.52076445e-05 max abs: 3.61591345e-03 + WET deposition: mean abs: 6.56905919e-05 max abs: 2.21248250e-02 + WET deposition ETA: mean abs: 7.84755508e-05 max abs: 3.06908134e-02 + DRY deposition: mean abs: 9.38503127e-05 max abs: 2.49430700e-03 + DRY deposition ETA: mean abs: 9.37944732e-05 max abs: 2.47154129e-03