diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index 4434891a3a00e32018d3f393ba545315adecfe3b..dab311c4d1fbe3d1516d8d1d6c5bba8ef11ae516 100644
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@@ -24,11 +24,30 @@ alma8-build:
- ./src/FLEXPART_ETA
expire_in: never
+rocky9-build:
+ image: harbor.wolke.img.univie.ac.at/flexpart/rockylinux9:latest
+ stage: build
+
+ script:
+ - export FC=gfortran
+ - export LIBRARY_PATH=/usr/lib64:/usr/local/lib64
+ - export CPATH=/usr/include:/usr/local/include:/usr/lib64/gfortran/modules
+ - make -j -C src -f makefile_gfortran eta=no
+ - make -j -C src -f makefile_gfortran
+ artifacts:
+ when: on_success
+ paths:
+ - ./src/FLEXPART
+ - ./src/FLEXPART_ETA
+ expire_in: never
+
options-test:
- image: harbor.wolke.img.univie.ac.at/flexpart/almalinux8:latest
+ # image: harbor.wolke.img.univie.ac.at/flexpart/almalinux8:latest
+ image: harbor.wolke.img.univie.ac.at/flexpart/rockylinux9:latest
stage: test
needs:
- alma8-build
+ - rocky9-build
script:
- ulimit -s unlimited
@@ -42,17 +61,35 @@ 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/almalinux8:latest
+ image: harbor.wolke.img.univie.ac.at/flexpart/rockylinux9:latest
stage: test
needs:
- alma8-build
+ - rocky9-build
script:
- ulimit -s unlimited
- bash ./tests/run_openmp_test.sh
-
+
artifacts:
when: on_success
paths:
@@ -63,11 +100,13 @@ openmp-simulation:
expire_in: 5 mins
etex-simulation:
- image: harbor.wolke.img.univie.ac.at/flexpart/almalinux8:latest
+ # 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
@@ -92,7 +131,7 @@ settling-test:
when: always
paths:
- ./tests/settling_test.txt
- expire_in: never
+ expire_in: never
bkw-test:
image: harbor.wolke.img.univie.ac.at/flexpart/postprocessing:py39
@@ -107,7 +146,7 @@ bkw-test:
when: always
paths:
- ./tests/bkw_test.txt
- expire_in: never
+ expire_in: never
openmp-test:
image: harbor.wolke.img.univie.ac.at/flexpart/postprocessing:py39
@@ -132,4 +171,11 @@ etex-test:
when: on_success
paths:
- ./tests/etex_test.txt
- expire_in: never
\ No newline at end of file
+ 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/Dockerfile b/Dockerfile
index 7837b13bedd2128bace3bd154d070efd3cb478b4..9aea002457f59bab4759a78b4b2dc8572c45e347 100644
--- a/Dockerfile
+++ b/Dockerfile
@@ -2,26 +2,31 @@
# Dockerfile for CI and Flexpart container images
# Build Examples:
# - podman build -t harbor.wolke.img.univie.ac.at/flexpart/almalinux8 -f Dockerfile
+# - podman build -t harbor.wolke.img.univie.ac.at/flexpart/rockylinux9 -f Dockerfile
#
-FROM almalinux:8-minimal
+# FROM rockylinux:8-minimal
+FROM rockylinux:9-minimal
#
# Build development image (with/without jasper)
# jasper was used in FP 10.4 (eccodes, emoslib)
#
+# 8: --enablerepo=powertools
+# since 9, there is 2.31 eccodes in epel
RUN microdnf install -y epel-release && \
- microdnf install -y --enablerepo=powertools make netcdf-fortran-devel.x86_64 netcdf.x86_64 cmake tar gcc-c++ perl && \
- microdnf clean all -y
+ microdnf install -y --enablerepo=crb make netcdf-fortran-devel.x86_64 netcdf.x86_64 eccodes eccodes-devel cmake tar gcc-c++ perl git && \
+ microdnf clean all -y && \
+ rm -rf /var/cache/yum
#
# Download ECCODES Version
# note 2.30.0 has an issue!!!
#
-RUN curl https://confluence.ecmwf.int/download/attachments/45757960/eccodes-2.31.0-Source.tar.gz | tar xz
-RUN mkdir build && \
- cd build && \
- cmake -DENABLE_ECCODES_OMP_THREADS=ON ../eccodes-*/ && \
- make -j8 && \
- make install
+# RUN curl https://confluence.ecmwf.int/download/attachments/45757960/eccodes-2.31.0-Source.tar.gz | tar xz
+# RUN mkdir build && \
+# cd build && \
+# cmake -DENABLE_ECCODES_OMP_THREADS=ON ../eccodes-*/ && \
+# make -j8 && \
+# make install
#
# set environment variables
#
diff --git a/Dockerfile_flexpart b/Dockerfile_flexpart
index 3195888ec0e7d5954ab685522da458feb6318c3c..5a9b61c3e2335068001b1ad046b2ef0193c90a7e 100644
--- a/Dockerfile_flexpart
+++ b/Dockerfile_flexpart
@@ -4,12 +4,13 @@
# - COMMIT = ... (use git log --pretty=format:'%h %D (%s %at)' -n 1)
# with this option Flexpart is build inside the container
# Build Examples:
-# - podman build -t harbor.wolke.img.univie.ac.at/flexpart/flexpartv11:$(git rev-parse --abbrev-ref HEAD) -f Dockerfile_flexpart --build-arg COMMIT=$(git log --pretty=format:'%h %D %ad' -n 1)
+# - podman build -t harbor.wolke.img.univie.ac.at/flexpart/flexpartv11:$(git rev-parse --abbrev-ref HEAD) -f Dockerfile_flexpart --build-arg COMMIT="$(git log --pretty=format:'%h %D %ad' -n 1)"
#
#
# Build image with Flexpart inside
#
-FROM harbor.wolke.img.univie.ac.at/flexpart/almalinux8:latest
+#FROM harbor.wolke.img.univie.ac.at/flexpart/almalinux8:latest
+FROM harbor.wolke.img.univie.ac.at/flexpart/rockylinux9:latest
ARG COMMIT=0
ENV COMMIT=$COMMIT
COPY ./src /src
@@ -17,7 +18,16 @@ COPY ./tests/default_options /options
COPY ./tests/default_winds /inputs
COPY ./entrypoint.sh /entrypoint.sh
WORKDIR /src
-RUN make -f makefile_gfortran && \
- mkdir -p /output && \
- echo -e "/options/\n/output/\n/inputs/\n/inputs/AVAILABLE" > /pathnames
+#
+# compile using a standardized
+# need to fix march to x86_64_v3 , remove mtune
+# here generic means core_avx2
+RUN make -f makefile_gfortran eta=no arch=generic \
+ && make -f makefile_gfortran arch=generic \
+ && mkdir -p /output \
+ && echo -e "/options/\n/output/\n/inputs/\n/inputs/AVAILABLE" > /pathnames
+# In the Dockerfile, the ENTRYPOINT command defines the executable,
+# while CMD sets the default parameter.
+# so here our entrypoint run script and default FLEXPART_ETA or FLEXPART
ENTRYPOINT ["/entrypoint.sh"]
+CMD ["FLEXPART_ETA"]
diff --git a/README.md b/README.md
index 72f7b8fec3405d63d618bedc2761b1c6a0d949f9..6c26f5d235c9e4a81c750c018ca6cff69e591062 100644
--- a/README.md
+++ b/README.md
@@ -63,11 +63,354 @@ Now you are almost ready to run.
In the winds are available in flex_ecmwf/work it should suffice to execute
`./src/FLEXPART` in the main directory
+### Container version
+
+since version 11, FLEXPART is also available as a container. There is a Dockerfile and some instructions on how to build the container from scratch or you can download the container from our [registry](https://harbor.wolke.img.univie.ac.at) using for example podman/docker or singularity/apptainer:
+
+Specifications:
+- compiled using `march=core-avx2`, compatible with CPUs above AVX2 (since Haswell or Zen)
+- ecCodes
+
+
+```sh
+# registry download, replace podman to docker or vice versa
+podman pull harbor.wolke.img.univie.ac.at/flexpart/flexpartv11:master
+# using singularity/apptainer for running FLEXPART
+# there might be some warnings about EPERM (can be ignored)
+apptainer pull flexpart.sif docker://harbor.wolke.img.univie.ac.at/flexpart/flexpartv11:master
+```
+
+running it using podman/docker or singularity/apptainer:
+
+```sh
+# simple run the container with default settings
+podman run harbor.wolke.img.univie.ac.at/flexpart/flexpartv11:master
+# running the container requires a writable output directory
+# mounting the local directory to /output inside the container
+apptainer run -B .:/output flexpart.sif
+```
+
+
+
+<details>
+<summary>podman/docker flexpart run log</summary>
+<pre><code class="shell">
+Welcome, running FLEXPART
+Using defaults (/pathnames)
+/options/
+/output/
+/inputs/
+/inputs/AVAILABLE
+Mount volumes to change inputs
+Git: c5bdd94 HEAD -> master, origin/master, origin/HEAD Tue Nov 21 16:15:27 2023 +0100
+EXECUTING FLEXPART
+trying to execute: /src/FLEXPART_ETA
+Executing: /src/FLEXPART_ETA
+ Welcome to FLEXPART Version 11
+ Git: undefined
+ FLEXPART is free software released under the GNU General Public License.
+ FLEXPART is running with ETA coordinates.
+ ----------------
+ INFORMATION: SUBGRIDSCALE TERRAIN EFFECT IS
+ NOT PARAMETERIZED DURING THIS SIMULATION.
+ ----------------
+
+ *********** WARNING **********************************
+ * FLEXPART running in parallel mode *
+ * Number of uncertainty classes in *
+ * set to number of threads: 1 *
+ * All other computations are done with 8 threads. *
+ *******************************************************
+
+ FLEXPART WARNING: TIME DIFFERENCE BETWEEN TWO
+ WIND FIELDS IS BIG. THIS MAY CAUSE A DEGRADATION
+ OF SIMULATION QUALITY.
+ ECMWF metdata detected
+ NXSHIFT is set to 0
+ grid dim: 181 91 92 92 91 92
+ Vertical levels in ECMWF data: 92 92
+
+ Mother domain:
+ Longitude range: -178.00000 to 182.00000 Grid distance: 2.00000
+ Latitude range : -90.00000 to 90.00000 Grid distance: 2.00000
+
+ Number of receptors: 2
+ Releasepoints : 1
+ reading SPECIES 24
+ Particle shape SPHERE for particle 24
+
+ SPECIES: 24 AIRTRACER (GAS)
+ Wet removal for gases is turned: OFF
+ Dry deposition for gases is turned: OFF
+ Below-cloud scavenging: OFF
+ In-cloud scavenging: OFF
+ Particles released (numpartmax): 10000
+ Total mass released: 1.0000000E+00
+ Allocating fields for global output (x,y): 85 65
+ Concentrations are calculated using kernel
+ WARNING: turbulence switched off.
+ Simulated 0.0 hours ( 0 s), 0 particles
+ Time: 0 seconds. Total spawned: 0 alive: 0 terminated: 0
+ Allocating 10000 particles 0 0 0
+ Finished allocation
+ Time: 900 seconds. Total spawned: 10000 alive: 10000 terminated: 0
+ Time: 1800 seconds. Total spawned: 10000 alive: 10000 terminated: 0
+ Time: 2700 seconds. Total spawned: 10000 alive: 10000 terminated: 0
+ Time: 3600 seconds. Total spawned: 10000 alive: 10000 terminated: 0
+ 3600 Seconds simulated: 10000 Particles: Uncertainty: 0.000 0.000 0.000
+ Time: 4500 seconds. Total spawned: 10000 alive: 10000 terminated: 0
+ Time: 5400 seconds. Total spawned: 10000 alive: 10000 terminated: 0
+ Time: 6300 seconds. Total spawned: 10000 alive: 10000 terminated: 0
+ Time: 7200 seconds. Total spawned: 10000 alive: 10000 terminated: 0
+ 7200 Seconds simulated: 10000 Particles: Uncertainty: 0.000 0.000 0.000
+ Time: 8100 seconds. Total spawned: 10000 alive: 10000 terminated: 0
+ Time: 9000 seconds. Total spawned: 10000 alive: 10000 terminated: 0
+ Time: 9900 seconds. Total spawned: 10000 alive: 10000 terminated: 0
+ Time: 10800 seconds. Total spawned: 10000 alive: 10000 terminated: 0
+ 10800 Seconds simulated: 10000 Particles: Uncertainty: 0.000 0.000 0.000
+ Read wind fields: 0.609375000 seconds
+ Timemanager: 1.17187500 seconds,first timestep: 1.09375000 seconds
+ Write particle files: 4.68750000E-02 seconds
+ Total running time: 1.81250000 seconds
+ tps,io,tot: 1.95312500E-02 0.131249994 1.81250000
+ CONGRATULATIONS: YOU HAVE SUCCESSFULLY COMPLETED A FLEXPART MODEL RUN!
+FINISHED
+</code></pre>
+</details>
+
+
+<details>
+<summary>singularity/apptainer flexpart run log</summary>
+<pre>
+<code class="language-shell">
+INFO: gocryptfs not found, will not be able to use gocryptfs
+Welcome, running FLEXPART
+Using defaults (/pathnames)
+/options/
+/output/
+/inputs/
+/inputs/AVAILABLE
+Mount volumes to change inputs
+Git: c5bdd94 HEAD -> master, origin/master, origin/HEAD Tue Nov 21 16:15:27 2023 +0100
+EXECUTING FLEXPART
+trying to execute: /src/FLEXPART_ETA
+Executing: /src/FLEXPART_ETA
+ Welcome to FLEXPART Version 11
+ Git: undefined
+ FLEXPART is free software released under the GNU General Public License.
+ FLEXPART is running with ETA coordinates.
+ ----------------
+ INFORMATION: SUBGRIDSCALE TERRAIN EFFECT IS
+ NOT PARAMETERIZED DURING THIS SIMULATION.
+ ----------------
+
+ *********** WARNING **********************************
+ * FLEXPART running in parallel mode *
+ * Number of uncertainty classes in *
+ * set to number of threads: 1 *
+ * All other computations are done with 8 threads. *
+ *******************************************************
+
+ FLEXPART WARNING: TIME DIFFERENCE BETWEEN TWO
+ WIND FIELDS IS BIG. THIS MAY CAUSE A DEGRADATION
+ OF SIMULATION QUALITY.
+ ECMWF metdata detected
+ NXSHIFT is set to 0
+ grid dim: 181 91 92 92 91 92
+ Vertical levels in ECMWF data: 92 92
+
+ Mother domain:
+ Longitude range: -178.00000 to 182.00000 Grid distance: 2.00000
+ Latitude range : -90.00000 to 90.00000 Grid distance: 2.00000
+
+ Number of receptors: 2
+ Releasepoints : 1
+ reading SPECIES 24
+ Particle shape SPHERE for particle 24
+
+ SPECIES: 24 AIRTRACER (GAS)
+ Wet removal for gases is turned: OFF
+ Dry deposition for gases is turned: OFF
+ Below-cloud scavenging: OFF
+ In-cloud scavenging: OFF
+ Particles released (numpartmax): 10000
+ Total mass released: 1.0000000E+00
+ Allocating fields for global output (x,y): 85 65
+ Concentrations are calculated using kernel
+ WARNING: turbulence switched off.
+ Simulated 0.0 hours ( 0 s), 0 particles
+ Time: 0 seconds. Total spawned: 0 alive: 0 terminated: 0
+ Allocating 10000 particles 0 0 0
+ Finished allocation
+ Time: 900 seconds. Total spawned: 10000 alive: 10000 terminated: 0
+ Time: 1800 seconds. Total spawned: 10000 alive: 10000 terminated: 0
+ Time: 2700 seconds. Total spawned: 10000 alive: 10000 terminated: 0
+ Time: 3600 seconds. Total spawned: 10000 alive: 10000 terminated: 0
+ 3600 Seconds simulated: 10000 Particles: Uncertainty: 0.000 0.000 0.000
+ Time: 4500 seconds. Total spawned: 10000 alive: 10000 terminated: 0
+ Time: 5400 seconds. Total spawned: 10000 alive: 10000 terminated: 0
+ Time: 6300 seconds. Total spawned: 10000 alive: 10000 terminated: 0
+ Time: 7200 seconds. Total spawned: 10000 alive: 10000 terminated: 0
+ 7200 Seconds simulated: 10000 Particles: Uncertainty: 0.000 0.000 0.000
+ Time: 8100 seconds. Total spawned: 10000 alive: 10000 terminated: 0
+ Time: 9000 seconds. Total spawned: 10000 alive: 10000 terminated: 0
+ Time: 9900 seconds. Total spawned: 10000 alive: 10000 terminated: 0
+ Time: 10800 seconds. Total spawned: 10000 alive: 10000 terminated: 0
+ 10800 Seconds simulated: 10000 Particles: Uncertainty: 0.000 0.000 0.000
+ Read wind fields: 0.703125000 seconds
+ Timemanager: 1.25000000 seconds,first timestep: 1.15625000 seconds
+ Write particle files: 1.56250000E-02 seconds
+ Total running time: 2.00000000 seconds
+ tps,io,tot: 2.34375000E-02 0.143749997 2.00000000
+ CONGRATULATIONS: YOU HAVE SUCCESSFULLY COMPLETED A FLEXPART MODEL RUN!
+FINISHED
+</code></pre>
+</details>
+
+<details>
+<summary>ncdump of default run output</summary>
+<pre><code class="language-shell">
+# check the output
+ncdump -h grid_conc_20090101000000.nc
+netcdf grid_conc_20090101000000 {
+dimensions:
+ time = UNLIMITED ; // (3 currently)
+ longitude = 85 ;
+ latitude = 65 ;
+ height = 4 ;
+ numspec = 1 ;
+ pointspec = 1 ;
+ nageclass = 1 ;
+ nchar = 45 ;
+ ncharrec = 16 ;
+ numpoint = 1 ;
+ receptor = UNLIMITED ; // (2 currently)
+variables:
+ int time(time) ;
+ time:units = "seconds since 2009-01-01 00:00" ;
+ time:calendar = "proleptic_gregorian" ;
+ float longitude(longitude) ;
+ longitude:long_name = "longitude in degree east" ;
+ longitude:axis = "Lon" ;
+ longitude:units = "degrees_east" ;
+ longitude:standard_name = "grid_longitude" ;
+ longitude:description = "grid cell centers" ;
+ float latitude(latitude) ;
+ latitude:long_name = "latitude in degree north" ;
+ latitude:axis = "Lat" ;
+ latitude:units = "degrees_north" ;
+ latitude:standard_name = "grid_latitude" ;
+ latitude:description = "grid cell centers" ;
+ float height(height) ;
+ height:units = "meters" ;
+ height:positive = "up" ;
+ height:standard_name = "height" ;
+ height:long_name = "height above ground" ;
+ char RELCOM(numpoint, nchar) ;
+ RELCOM:long_name = "release point name" ;
+ float RELLNG1(numpoint) ;
+ RELLNG1:units = "degrees_east" ;
+ RELLNG1:long_name = "release longitude lower left corner" ;
+ float RELLNG2(numpoint) ;
+ RELLNG2:units = "degrees_east" ;
+ RELLNG2:long_name = "release longitude upper right corner" ;
+ float RELLAT1(numpoint) ;
+ RELLAT1:units = "degrees_north" ;
+ RELLAT1:long_name = "release latitude lower left corner" ;
+ float RELLAT2(numpoint) ;
+ RELLAT2:units = "degrees_north" ;
+ RELLAT2:long_name = "release latitude upper right corner" ;
+ float RELZZ1(numpoint) ;
+ RELZZ1:units = "meters" ;
+ RELZZ1:long_name = "release height bottom" ;
+ float RELZZ2(numpoint) ;
+ RELZZ2:units = "meters" ;
+ RELZZ2:long_name = "release height top" ;
+ int RELKINDZ(numpoint) ;
+ RELKINDZ:long_name = "release kind" ;
+ int RELSTART(numpoint) ;
+ RELSTART:units = "seconds" ;
+ RELSTART:long_name = "release start relative to simulation start" ;
+ int RELEND(numpoint) ;
+ RELEND:units = "seconds" ;
+ RELEND:long_name = "release end relative to simulation start" ;
+ int RELPART(numpoint) ;
+ RELPART:long_name = "number of release particles" ;
+ float RELXMASS(numspec, numpoint) ;
+ RELXMASS:long_name = "total release particle mass" ;
+ int LAGE(nageclass) ;
+ LAGE:units = "seconds" ;
+ LAGE:long_name = "age class" ;
+ int ORO(latitude, longitude) ;
+ ORO:standard_name = "surface altitude" ;
+ ORO:long_name = "outgrid surface altitude" ;
+ ORO:units = "m" ;
+ char receptor(receptor, ncharrec) ;
+ receptor:long_name = "receptor name" ;
+ float spec001_mr(nageclass, pointspec, time, height, latitude, longitude) ;
+ spec001_mr:units = "ng m-3" ;
+ spec001_mr:long_name = "AIRTRACER" ;
+ spec001_mr:decay = -0.07001485f ;
+ spec001_mr:weightmolar = 29.f ;
+ spec001_mr:ohcconst = -9.e-10f ;
+ spec001_mr:ohdconst = -9.9f ;
+ spec001_mr:vsetaver = 0.f ;
+ float receptor_conc001(receptor, time) ;
+ receptor_conc001:units = "ng m-3" ;
+ receptor_conc001:_FillValue = -1.f ;
+ receptor_conc001:positive = "up" ;
+ receptor_conc001:standard_name = "receptor_conc" ;
+ receptor_conc001:long_name = "receptor_concentration" ;
+
+// global attributes:
+ :Conventions = "CF-1.6" ;
+ :title = "FLEXPART model output" ;
+ :git = "undefined" ;
+ :source = "Version 11 model output" ;
+ :history = "2023-11-21 16:22 +0100 created by mblaschek on NB513" ;
+ :references = "Stohl et al., Atmos. Chem. Phys., 2005, doi:10.5194/acp-5-2461-200" ;
+ :outlon0 = -25.f ;
+ :outlat0 = 10.f ;
+ :dxout = 1.f ;
+ :dyout = 1.f ;
+ :ldirect = 1 ;
+ :ibdate = "20090101" ;
+ :ibtime = "000000" ;
+ :iedate = "20090101" ;
+ :ietime = "030000" ;
+ :loutstep = 3600 ;
+ :loutaver = 3600 ;
+ :loutsample = 900 ;
+ :loutrestart = -1 ;
+ :lsynctime = 900 ;
+ :ctl = -0.2f ;
+ :ifine = 1 ;
+ :iout = 1 ;
+ :ipout = 0 ;
+ :lsubgrid = 0 ;
+ :lconvection = 0 ;
+ :lagespectra = 0 ;
+ :ipin = 0 ;
+ :ioutputforeachrelease = 0 ;
+ :iflux = 0 ;
+ :mdomainfill = 0 ;
+ :ind_source = 1 ;
+ :ind_receptor = 1 ;
+ :mquasilag = 0 ;
+ :nested_output = 0 ;
+ :sfc_only = 0 ;
+ :linit_cond = 0 ;
+}
+</code>
+</pre>
+</details>
+
+
### Contribution guidelines
* The version contributed should compile on a reference version of the system and compiler.
- `FLEXPART 10.4` used as reference gfortran 5.4 on Ubuntu 16.04
- - `FLEXPART 11` uses as reference gfortran 8.5.0 on AlmaLinux 8
+ - `FLEXPART 11` uses as reference gfortran 8.5.0 on AlmaLinux 8/RockyLinux 8 or gfortran 11.4.1 on RockyLinux 9
* Code contribution including new features and bug fixes should be complemented with appropriate tests
An essential test consists of a set of input files and directories that allow FLEXPART to run.
diff --git a/documentation/docs/installation.md b/documentation/docs/building.md
similarity index 96%
rename from documentation/docs/installation.md
rename to documentation/docs/building.md
index 3e241d57a215df0bc324b4a0e3795590fe79556b..a52d84d373e513c138572483234121de74230e2f 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:
diff --git a/documentation/docs/configuration.md b/documentation/docs/configuration.md
new file mode 100644
index 0000000000000000000000000000000000000000..fd92c65bd5ea5c6288ab609e60e9da740b9be4ed
--- /dev/null
+++ b/documentation/docs/configuration.md
@@ -0,0 +1,287 @@
+# 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)
+- [RECEPTORS](configuration.md#receptors)
+- [PARTOPTIONS](configuration.md#partoptions)
+
+### <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="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="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. 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 |
+|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 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 |
+
+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="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.
+
+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.
+
+## <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). 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 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/index.md b/documentation/docs/index.md
index e408e65feb1d541d01ccae16301fd2ae8880d9fb..34d39a6bfb702fcb147a9c9ee9cf41618f852fb7 100644
--- a/documentation/docs/index.md
+++ b/documentation/docs/index.md
@@ -1,7 +1,7 @@
# 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).
+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).
diff --git a/documentation/docs/running.md b/documentation/docs/running.md
index 5e4e5062349c0a574aae4665842f9511ae90fc12..aed622b09d9e8eee7005e9373ab9e0562cee4874 100644
--- a/documentation/docs/running.md
+++ b/documentation/docs/running.md
@@ -1,287 +1,91 @@
-# Running FLEXPART
-To run FLEXPART, there are three important (sets) of files that need to be specified.
-These are:
-
-- 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,
-
-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.
-
-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).
-
-When wanting to restart a previous simulation, see [restarting a simulation](running.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**](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.
-
-Inside the `options/` directory a template of all option files can be found:
-
-- [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)
-
-### <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](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.
-
-| 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 |
-
-<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](running.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](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)).
+# Running
-### <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.
+<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.
-The following specifies the parameters associated with each physicochemical process simulated.
+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.
-- 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.
+## Command line usage
-| 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 |
+FLEXPART accepts two command line options:
-<br/>
+- `pathnames`, setting all appropriate paths, as explained in [Configuration](configuration.md#config).
+- `-v <verbosity>`, currently not operational
-### <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.
+## Exit code
+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.
-| 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) |
+## Input data
-<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) |
-
-<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.
+To run FLEXPART, there are three important (sets) of files that need to be specified.
+These are:
-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.
+- 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).
-## <a name="pathnames"></a>Pathnames file
-The pathnames file is a text file containing the path to:
+A full description of these files can be found in [Configuration](configuration.md#config).
-- 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)).
+### <a name="meteodata"></a>Meteorological input data
-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:
+Necessary fields from Eularian models:
-- 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.
+- 3D wind velocities
+- Temperatures
+- Specific humidity
+- Surface and sea level pressure
+- Snow depth
+- Cloud cover
+- Cloud liquid and ice water content (when available)
+- 2 metre dew point
+- Large scale precipitation
+- Convective precipitation
+- Sensible heat flux
+- Solar radiation
+- Ew and ns surface stress
+- Orography and its standard deviation
+- Land sea mask
-## <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.
+#### ECMWF
-## <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:
+#### GFS
-**Header**
+## OpenMP
-| 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 |
+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.
-<br/>
+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.
-**Data**
+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.
-| 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 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](running.md#ioutputforeachrelease) in [COMMAND](running.md#command) is set | 1D-array of integers with dimension `particle` |
+## HPC systems
-<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..7e2d62ed21a2b2f537750bf712273826e7df4a05 100644
--- a/documentation/mkdocs.yml
+++ b/documentation/mkdocs.yml
@@ -30,10 +30,12 @@ markdown_extensions:
# - pymdownx.tilde
nav:
- 'index.md'
- - 'installation.md'
+ - 'building.md'
+ - 'configuration.md'
- 'running.md'
- 'output.md'
- 'transport.md'
- 'evolution.md'
- 'examples.md'
+ - 'troubleshooting.md'
diff --git a/entrypoint.sh b/entrypoint.sh
index 64b8ff3dac61e0baa3fc43c7b4327577bb863bad..5fb5f2902975e561208044db36913791b4b62f1f 100755
--- a/entrypoint.sh
+++ b/entrypoint.sh
@@ -1,12 +1,23 @@
#!/bin/bash
# By MB
# run FLEXPART, but provide a bit of information
-
echo "Welcome, running FLEXPART "
-echo "Using defaults:"
+echo "Using defaults (/pathnames)"
cat /pathnames
echo "Mount volumes to change inputs"
echo "Git: $COMMIT"
echo "EXECUTING FLEXPART"
-/src/FLEXPART /pathnames
+if [ $# -eq 1 ]; then
+ echo "trying to execute: /src/$1"
+ if [ -e /src/"$1" ]; then
+ echo "Executing: /src/$1"
+ /src/"$1" /pathnames
+ else
+ echo "Falling back to default, executing: /src/FLEXPART_ETA"
+ /src/FLEXPART_ETA /pathnames
+ fi
+else
+ echo "Executing: /src/FLEXPART_ETA"
+ /src/FLEXPART_ETA /pathnames
+fi
echo "FINISHED"
diff --git a/options/COMMAND b/options/COMMAND
index e759d3f6fda8f0b76e444190dcbd5eed01d3b44d..3f3e57509d83169453c0f43d9d3d75d0b1a626f5 100644
--- a/options/COMMAND
+++ b/options/COMMAND
@@ -41,4 +41,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
+ BCSCHEME= 1, ! Below-cloud scheme; [1] Laakso & Kyro [2] Wang et al [3] modified Wang et al
/
diff --git a/src/FLEXPART.f90 b/src/FLEXPART.f90
index 859927b3cb933b972f213d5cd1d6898adb63029d..1942fc3199fd131fe6fafd5554c650b1df49b70a 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'
@@ -172,7 +188,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 +231,6 @@ subroutine read_options_and_initialise_flexpart
!********************************
call readageclasses
-
! ! Allocate memory for windfields
! !*******************************
! call alloc_windfields
@@ -393,6 +408,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,7 +418,7 @@ subroutine initialise_particles
#endif
endif
- if (ipout.ne.0) call readpartoptions
+
if (iout.ne.0) then
call alloc_grid
diff --git a/src/advance_mod.f90 b/src/advance_mod.f90
index ee8963b05b2ab97549492b4f0af57dd97c38a7d5..e9691ab957d1a353c8978eb7d17b802f32564d69 100644
--- a/src/advance_mod.f90
+++ b/src/advance_mod.f90
@@ -410,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
@@ -586,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
@@ -712,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, &
@@ -721,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
diff --git a/src/com_mod.f90 b/src/com_mod.f90
index 97b5cef366ad19a0a6fe64f50d69c6367c8ef955..ba4be2d0cef37b7531206b247a58df879fbb2f35 100644
--- a/src/com_mod.f90
+++ b/src/com_mod.f90
@@ -6,14 +6,17 @@
! *
! 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
+ numclass, maxcolumn, maxrand, numwfmem, numpf
implicit none
@@ -21,10 +24,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
@@ -159,24 +164,33 @@ 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.
+ logical :: lcw=.false. ! ZHG Sep 2015 ! AT renamed
+ ! whether or not cloud water data found in GRIB, overwritten if CW is found
-!ESO: Disable settling if more than 1 species per release point
- logical :: lsettling=.true.
+ logical :: lcwsum=.false. ! ESO Dec 2015 ! AT renamed
+ ! whether or not both clwc and ciwc are present (if so they are summed)
- logical,dimension(maxnests) :: readclouds_nest, sumclouds_nest
-
+ 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
-!NIK 16.02.2015
- integer(selected_int_kind(16)),allocatable,dimension(:) :: &
- tot_blc_count,tot_inc_count
+ integer :: bcscheme ! AT 2021
+ ! = 1 for below cloud scheme of Grythe et al 2017 (based on Laakso and Kyro)
+ ! = 2 for below-cloud scheme of Tipka et al 2023 (based on Wang et al 2014)
+ ! = 3 for below-cloud scheme of Tipka et al 2023 (based on modified Wang et al 2014)
!*********************************************************************
! Variables defining the release locations, released species and their
@@ -527,8 +541,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), &
@@ -552,8 +566,9 @@ contains
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
+
+ icnt_belowcld=0
+ icnt_incld=0
end subroutine alloc_com
subroutine alloc_com_ndia
@@ -565,7 +580,7 @@ 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, &
diff --git a/src/conv_mod.f90 b/src/conv_mod.f90
index 8cf8d113f69d0fb600d7d090c1effd312ff08037..b2c7efcf5f5cb390773b266b64bb050b3151bffb 100644
--- a/src/conv_mod.f90
+++ b/src/conv_mod.f90
@@ -853,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
@@ -915,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.
@@ -926,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))
@@ -971,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..9101553191e1f257e6a8df62e5b0afbdf677b23d 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)
diff --git a/src/drydepo_mod.f90 b/src/drydepo_mod.f90
index 3e97bc4dcc7f9903f0a935c2b93090f85f043b68..9ce54e021c134677a55c7032f41f5ec47943472d 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
@@ -1301,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
@@ -1317,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
diff --git a/src/getfields_mod.f90 b/src/getfields_mod.f90
index a0f253f21260e81ffb6c2b9fc85a3755192154db..fe60124a5437d8428674edbb86261300ebfe0ce0 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
@@ -886,7 +888,7 @@ subroutine calcpar(n)
! *
! 21 May 1995 *
! *
- ! ------------------------------------------------------------------ *
+ !*****************************************************************************
! Petra Seibert, Feb 2000: *
! convection scheme: *
! new variables in call to richardson *
@@ -901,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: *
@@ -1059,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
@@ -1159,7 +1163,7 @@ subroutine calcpar_nest(n)
! *
! 8 February 1999 *
! *
- ! ------------------------------------------------------------------ *
+ !*****************************************************************************
! Petra Seibert, Feb 2000: *
! convection scheme: *
! new variables in call to richardson *
@@ -1171,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) *
@@ -1301,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)
diff --git a/src/initialise_mod.f90 b/src/initialise_mod.f90
index 572d394852d73e50d1b8f779c589397caddcf66c..798f2acf07830c72462c25207347950759eb19c1 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
@@ -147,6 +145,7 @@ subroutine releaseparticles(itime)
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?
@@ -214,11 +213,14 @@ subroutine releaseparticles(itime)
zaux=zpoint2(i)-zpoint1(i)
if (ipin.le.1 .and. ipout.eq.0) then
- totpart = numrel-(count%allocated-count%alive)
+ 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
@@ -260,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
@@ -353,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
@@ -377,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)/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
+
+ ! 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)
@@ -411,8 +446,8 @@ subroutine init_mass_conversion(ipart,ipoint)
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)
@@ -435,8 +470,8 @@ subroutine init_mass_conversion(ipart,ipoint)
rho_rel(ipoint)=rhoout
- ! Multiply "mass" (i.e., mass mixing ratio in forward runs) with density
- !********************************************************************
+ ! Multiply "mass" (i.e., mass mixing ratio in forward runs) with density
+ !***********************************************************************
mass(ipart,:)=mass(ipart,:)*rhoout
mass_init(ipart,:)=mass(ipart,:)
endif
@@ -898,9 +933,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
@@ -1358,7 +1393,7 @@ subroutine boundcond_domainfill(itime,loutend)
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
@@ -1382,6 +1417,8 @@ 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
@@ -1417,6 +1454,7 @@ subroutine boundcond_domainfill(itime,loutend)
! ithread = 0
! #endif
ithread=0
+ iterm_index=1
! !$OMP DO
do jy=ny_sn(1),ny_sn(2)
@@ -1530,7 +1568,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
@@ -1745,7 +1783,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
@@ -1836,6 +1874,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..7786a73289976fecaf525de0781c25c70282b189 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
+ real, 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=(yi1(1)*dt2 + yi1(2)*dt1)/dt
+ if (yi1(1) .eq. float(icmv)) intiy1=yi1(2)
+ if (yi1(2) .eq. float(icmv)) intiy1=yi1(1)
+
+ intiy2=(yi2(1)*dt2 + yi2(2)*dt1)/dt
+ if (yi2(1) .eq. float(icmv)) intiy2=yi2(2)
+ if (yi2(2) .eq. float(icmv)) intiy2=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/makefile_gfortran b/src/makefile_gfortran
index 884df8ebfb6cf208f3936e40910d240c2bcb9e53..d5a520dc02bf1fc4f4feb35f02bf851a6bfa9bea 100644
--- a/src/makefile_gfortran
+++ b/src/makefile_gfortran
@@ -78,8 +78,23 @@ endif
O_LEV = 3 # [0,1,2,3,g,s,fast]
O_LEV_DBG = g # [0,g]
# -fopenmp #-pg -fbacktrace -fcheck=all -fbounds-check #-fopenmp#-p -fbacktrace -fopenmp #-tau_options=-optCompInst -tau_makefile=/home/lucie/Codes/Tau/x86_64/lib/Makefile.tau-mpi-pdt-openmp-opari#-fdefault-real-8# -freal-8-real-4#-pg -fcheck=all
-#FUSER = -g -fopenmp -march=skylake-avx512
-FUSER = -g -fopenmp -march=native -mtune=native
+#
+# Different CPU microarchitectures
+# check https://gcc.gnu.org/onlinedocs/gcc/x86-Options.html
+# using generic (AVX2)
+# using skylake (AVX512)
+# using native is the default, which will use whatever it can
+# (defined by the machine where you are compiling it)
+#
+ifeq ($(arch), generic)
+ FUSER = -g -fopenmp -march=core-avx2
+else ifeq ($(arch), skylake)
+ FUSER = -g -fopenmp -march=skylake-avx512
+else
+ FUSER = -g -fopenmp -march=native -mtune=native
+endif
+
+
mpi: FUSER := $(FUSER) -Dusempi #-MM -MT -MD
## LIBRARIES
LIBS = -leccodes -leccodes_f90 -lm $(NCOPT) $(ETAOPT) #MD -ljasper
@@ -106,7 +121,7 @@ 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 \
diff --git a/src/netcdf_output_mod.f90 b/src/netcdf_output_mod.f90
index 5a7a971fc98a9f49a7ca9d23e19f0836690a9c2c..e464d0e5383f5ec7ec64dcda1b925118e2007a87 100644
--- a/src/netcdf_output_mod.f90
+++ b/src/netcdf_output_mod.f90
@@ -41,7 +41,7 @@ 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
+ unitoutrecept,unitoutreceptppt,unittmp,lpartoutputperfield
use com_mod, only: path,length,ldirect,ibdate,ibtime,iedate,ietime,itime_init, &
loutstep,loutaver,loutsample,outlon0,outlat0,&
numxgrid,numygrid,dxout,dyout,numzgrid, &
@@ -76,7 +76,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 +86,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,7 +117,7 @@ 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,update_partoutput_pointers,ppointer_part
! Not written yet:
! concoutput_sfc_netcdf,concoutput_sfc_nest_netcdf,
@@ -141,15 +132,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
!****************************************************************
@@ -1674,19 +1664,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 +1687,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 +1872,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 +1887,17 @@ 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,55 +1908,102 @@ 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 +2014,233 @@ 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) 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) 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,14 +2275,19 @@ 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))
+ 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 +2299,94 @@ 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 +2400,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)) 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)) 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
@@ -2564,6 +2631,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'
@@ -2811,10 +2882,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
@@ -2844,6 +2922,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
diff --git a/src/output_mod.f90 b/src/output_mod.f90
index 78882b5477deed0b7bd58728dbfa7c0f81f75c1f..ebb1bb75f8ec11370d118a863a6646a6a79ae9ae 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
@@ -209,6 +209,7 @@ subroutine output_particles(itime,initial_output)
init_out=.false.
endif
+
!$OMP PARALLEL PRIVATE(i,j,m,tmp,ns,i_av,cartxyz_comp,cartxyz,np,lskip)
! Some variables needed for temporal interpolation
!*************************************************
@@ -260,6 +261,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,6 +305,7 @@ subroutine output_particles(itime,initial_output)
output(np,i)=part(i)%settling
cycle
case ('MA') ! Mass
+ if (mass_written) cycle
masstemp(i,:)=mass(i,:)
cycle
case ('ma') ! Mass averaged
@@ -365,6 +368,7 @@ subroutine output_particles(itime,initial_output)
!$OMP END DO
!$OMP END PARALLEL
+
if ((.not. init_out).and.(numpart.gt.0)) then
do np=1,num_partopt
if (.not. partopt(np)%print) cycle
@@ -391,67 +395,77 @@ 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
+ call update_partoutput_pointers(itime, ncid)
+ !ppointer_part = count%allocated
+ endif
+ ! Fill the fields in parallel
+ if (numpart.gt.0) then
- ! 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)
+ ! 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
diff --git a/src/par_mod.f90 b/src/par_mod.f90
index 5fe9783e60e5fdec64871cef622e4c9aeae683fd..4f54f7a4194bde6e58835ca2fb2d1053175a8faa 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,13 +185,16 @@ 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 :: 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
@@ -195,6 +203,55 @@ module par_mod
!**************************************************************************
integer,parameter :: maxxOH=72, maxyOH=46, maxzOH=7
+
+ !**************************************************************************
+ ! aerosol below-cloud scavenging removal polynomial constants for rain & snow
+ !**************************************************************************
+
+ ! for bcscheme = 1
+ ! rain (Laakso et al 2003, figure 7) Size range: 10-510 nm
+ real, parameter :: bclr(6) = &
+ (/274.35758, 332839.59273, 226656.57259, 58005.91340, 6588.38582, 0.244984/)
+ ! snow (Kyro et al 2009) Size range: 10nm-1um
+ real, parameter :: bcls(6) = (/22.7, 0.0, 0.0, 1321.0, 381.0, 0.0/)
+
+ ! for bcscheme = 2 & 3
+ ! 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
@@ -245,6 +302,11 @@ module par_mod
! integer code for missing values, used in wet scavenging (PS, 2012)
!******************************************************
- integer,parameter :: icmv=-9999
+ integer,parameter :: icmv=-9999.
+
+ logical,parameter :: lpartoutputperfield=.false.
+
+ ! Temporary parameter to switch off the gridfaction calculation in the wetdeposition
+ logical,parameter :: lgridfraction=.false.
end module par_mod
diff --git a/src/particle_mod.f90 b/src/particle_mod.f90
index 55635d8497b2053816082377796298615502a8ad..35363566ecf31e1ecfcf7110dcc48c03b083116e 100644
--- a/src/particle_mod.f90
+++ b/src/particle_mod.f90
@@ -83,8 +83,8 @@ module particle_mod
! 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;
@@ -99,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 :: &
@@ -134,6 +136,7 @@ module particle_mod
dealloc_all_particles, &
terminate_particle, &
rewrite_ialive, &
+ rewrite_iterm, &
spawn_particle, &
spawn_particles, &
get_totalpart_num, &
@@ -209,28 +212,30 @@ 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
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 ((count%spawned-count%terminated) .lt. count%allocated) then
+ else if (iterm_index.le.count%iterm_max) then
! Find dead particles to replace
- do i=1,count%allocated
- if (.not. part(i)%alive) then
- ipart=i
- exit
- endif
- end do
+ 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
@@ -323,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
!********************************************************
@@ -386,8 +394,27 @@ contains
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
@@ -443,6 +470,13 @@ 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
@@ -593,6 +627,7 @@ contains
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
diff --git a/src/readoptions_mod.f90 b/src/readoptions_mod.f90
index 7fe1fcfcc2c11f7b96dded18836c6a6b9859603c..fbc1f90f313188be17a1f7413e9b5230d3c26ca1 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,9 @@ subroutine readcommand
! 18 May 1996 *
! HSO, 1 July 2014 *
! Added optional namelist input *
+ ! *
+ ! June 2023 Anne Tipka *
+ ! Added new parameter bcscheme for selcting below cloud scheme *
! *
!*****************************************************************************
! *
@@ -517,7 +519,9 @@ subroutine readcommand
nxshift, &
maxthreadgrid, &
maxfilesize, &
- logvertinterp
+ logvertinterp, &
+ bcscheme, &
+ itsplit ! deprecated: only for IO back compatibility
! Presetting namelist command
ldirect=0
@@ -559,6 +563,8 @@ subroutine readcommand
maxthreadgrid=1
maxfilesize=10000
logvertinterp=0
+ bcscheme=2
+ itsplit=999999999 ! deprecated: only for IO back compatibility
!Af set release-switch
WETBKDEP=.false.
@@ -1913,8 +1919,7 @@ subroutine readreceptors
! prepare namelist output if requested
if (nmlout) open(unitreceptorout,file=trim(path(2))// &
- 'RECEPTORS.namelist',err=1000)
-
+ 'RECEPTORS.namelist',status='replace',err=1000)
if (ios .ne. 0) then ! read as regular text file
@@ -2668,7 +2673,7 @@ subroutine readspecies(id_spec,pos_spec)
character(len=16) :: pspecies
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, pohcconst, pohdconst, pohnconst, pdia
real :: pcrain_aero, pcsnow_aero, pccn_aero, pin_aero
real :: parea_dow(7), parea_hour(24), ppoint_dow(7), ppoint_hour(24)
integer :: pndia
@@ -2681,7 +2686,7 @@ 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, &
+ preldiff, phenry, pf0, pdensity, pdquer, pdia, &
pdsigma, pndia, pdryvel, pweightmolar, pohcconst, pohdconst, pohnconst, &
parea_dow, parea_hour, ppoint_dow, ppoint_hour, &
pshape, paspectratio, pla, pia, psa, porient
@@ -2699,6 +2704,7 @@ subroutine readspecies(id_spec,pos_spec)
pf0=0.0
pdensity=-9.9E09
pdquer=0.0
+ pdia=0.0
pdsigma=0.0
pndia=1
pdryvel=-9.99
@@ -2864,7 +2870,14 @@ subroutine readspecies(id_spec,pos_spec)
henry(pos_spec)=phenry
f0(pos_spec)=pf0
density(pos_spec)=pdensity
- dquer(pos_spec)=pdquer
+ if (pdia.ne.0.0) then
+ dquer(pos_spec)=pdia
+ else if (pdquer.ne.0.0) 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
@@ -3253,154 +3266,188 @@ 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
diff --git a/src/timemanager_mod.f90 b/src/timemanager_mod.f90
index 31b010b9064ef791c8803e5315990d0a5f125ff0..841d5990c6a308b3a6beafcf8ec5bea7f842d1f4 100644
--- a/src/timemanager_mod.f90
+++ b/src/timemanager_mod.f90
@@ -189,8 +189,8 @@ subroutine timemanager
s_firstt = real(count_clock)/real(count_rate)
endif
- ! Writing restart file
- !*********************
+ ! 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)
endif
@@ -200,14 +200,13 @@ subroutine timemanager
! endif
call init_output(itime,filesize)
- ! Get necessary wind fields if not available
- !*******************************************
+ ! Get necessary wind fields if not available
+ !*******************************************
call getfields(itime,nstop1) !OMP on verttransform_ecmwf and readwind_ecmwf, getfields_mod.f90
if (nstop1.gt.1) error stop 'NO METEO FIELDS AVAILABLE'
- ! In case of ETA coordinates being read from file, convert the z positions to zeta
- !*********************************************************************************
-#ifdef ETA
+ ! In case of ETA coordinates being read from file, convert the z positions to zeta
+ !*********************************************************************************
if ((itime.eq.itime_init).and.((ipin.eq.1).or.(ipin.eq.3).or.(ipin.eq.4))) then
if (count%allocated.le.0) error stop 'Something is going wrong reading the old particle file! &
@@ -215,12 +214,18 @@ subroutine timemanager
!$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
endif
-#endif
+
if (WETDEP .and. (itime.ne.0) .and. (numpart.gt.0)) then
call wetdepo(itime,lsynctime,loutnext)
diff --git a/src/verttransform_mod.f90 b/src/verttransform_mod.f90
index 9699ef8f6be3218c71852dff7429e869fb74cfe5..13a8556c1fac58ffc7b2ad5825e7d95402aa0050 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.
@@ -140,12 +146,30 @@ subroutine verttransform_ecmwf(n,uuh,vvh,wwh,pvh)
! 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
@@ -413,11 +465,11 @@ subroutine verttransform_ecmwf_windfields(n,nxlim,nylim,uuh,vvh,wwh,pvh,rhoh,prs
end forall
!$OMP END WORKSHARE NOWAIT
- if (readclouds) then
+ 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. sumclouds) ciwc(0:nxlim,0:nylim,kz,n)=ciwch(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
@@ -497,12 +549,12 @@ subroutine verttransform_ecmwf_windfields(n,nxlim,nylim,uuh,vvh,wwh,pvh,rhoh,prs
!$OMP END WORKSHARE NOWAIT
#ifndef ETA
- if (readclouds) then !hg adding the cloud water
+ 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. sumclouds) then
+ 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)
@@ -529,9 +581,9 @@ subroutine verttransform_ecmwf_windfields(n,nxlim,nylim,uuh,vvh,wwh,pvh,rhoh,prs
#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
else
@@ -550,10 +602,10 @@ subroutine verttransform_ecmwf_windfields(n,nxlim,nylim,uuh,vvh,wwh,pvh,rhoh,prs
#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
+ 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
#endif
@@ -561,6 +613,7 @@ subroutine verttransform_ecmwf_windfields(n,nxlim,nylim,uuh,vvh,wwh,pvh,rhoh,prs
! 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
@@ -591,10 +644,11 @@ subroutine verttransform_ecmwf_windfields(n,nxlim,nylim,uuh,vvh,wwh,pvh,rhoh,prs
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) &
@@ -670,15 +724,15 @@ 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/2.-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, &
@@ -825,15 +879,15 @@ 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/2.-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, &
@@ -903,181 +957,330 @@ subroutine verttransform_ecmwf_stereo(n)
endif
end subroutine verttransform_ecmwf_stereo
-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
+
+ real,intent(out) :: icloudbot_tmp(0:nxlim,0:nylim), icloudtop_tmp(0:nxlim,0:nylim)
+
+ integer :: ix,jy
+
+ ! converted parameters for eta coordinates:
+ real :: max_cloudthck_eta
+ real, 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 !we will use icloudtop as workspace for cloud top
+
+ ! Find the bottom and top of present clouds in gridcell 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 :: 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
-
-!$OMP PARALLEL PRIVATE(ix,jy,kz,lsp,convp,prec,cloudh_min) REDUCTION(+:ctwc_tmp)
-!$OMP DO SCHEDULE(dynamic,max(1,nylim/50))
- 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:
+ real,intent(out) :: max_cloudthck_eta
+ real, dimension(2),intent(out) :: conv_clrange_eta,highconvp_clrange_eta, &
+ lowconvp_clrange_eta
+ integer :: kz
+
+
+ ! Convert cloud parameters to eta coords.
+ ! Reverse sign when using eta (eta:1-0, meter:0-max)
+ max_cloudthck_eta=uvheight(nz)
+ conv_clrange_eta=uvheight(nz)
+ highconvp_clrange_eta=uvheight(nz)
+ lowconvp_clrange_eta=uvheight(nz)
+ do kz=1,nz
+ if (uvzlev(ix,jy,kz).gt.max_cloudthck) then
+ max_cloudthck_eta=uvheight(kz)
+ exit
+ endif
+ end do
+ do kz=1,nz
+ if (uvzlev(ix,jy,kz).gt.conv_clrange(1)) then
+ conv_clrange_eta(1)=uvheight(kz)
+ exit
+ endif
+ end do
+ do kz=1,nz
+ if (uvzlev(ix,jy,kz).gt.conv_clrange(2)) then
+ conv_clrange_eta(2)=uvheight(kz)
+ exit
+ endif
+ end do
+ do kz=1,nz
+ if (uvzlev(ix,jy,kz).gt.highconvp_clrange(1)) then
+ highconvp_clrange_eta(1)=uvheight(kz)
+ exit
+ endif
+ end do
+ do kz=1,nz
+ if (uvzlev(ix,jy,kz).gt.highconvp_clrange(2)) then
+ highconvp_clrange_eta(2)=uvheight(kz)
+ exit
+ endif
+ end do
+ do kz=1,nz
+ if (uvzlev(ix,jy,kz).gt.lowconvp_clrange(1)) then
+ lowconvp_clrange_eta(1)=uvheight(kz)
+ exit
+ endif
+ end do
+ do kz=1,nz
+ if (uvzlev(ix,jy,kz).gt.lowconvp_clrange(2)) then
+ lowconvp_clrange_eta(2)=uvheight(kz)
+ exit
+ endif
+ 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
+
+ real,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
- if (.not.lsumclouds) clwc_tmp(ix,jy,:) = clwc_tmp(ix,jy,:) + ciwc_tmp(ix,jy,:)
- 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) = uvheight(kz)
+ icloudtop_tmp(ix,jy) = uvheight(kz) !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)=uvheight(kz)
+ endif
+ icloudtop_tmp(ix,jy)=uvheight(kz)
#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
-!$OMP END DO
-!$OMP END PARALLEL
+!**************************************************************************
+ 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'
-!$OMP PARALLEL PRIVATE(jy,ix,kz_inv,kz,lsp,convp,pressure,rh,rain_cloud_above)
-!$OMP DO
- do jy=0,nylim
- do ix=0,nxlim
- ! OLD METHOD
- rain_cloud_above=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=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:
+ real,intent(in) :: max_cloudthck_eta
+ real,intent(in),dimension(2) :: conv_clrange_eta,highconvp_clrange_eta,lowconvp_clrange_eta
+
+ real,intent(inout) :: icloudbot_tmp(0:nxlim,0:nylim), icloudtop_tmp(0:nxlim,0:nylim)
+
+ real :: 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 (uvheight(kz).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 (uvzlev(ix,jy,kz).gt.min_cloudtop) then ! back to eta
+ min_cloudtop=uvheight(kz)
+ 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.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
-!$OMP END DO
-!$OMP END PARALLEL
- 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 *
@@ -1092,60 +1295,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
!*************************************************************************
@@ -1171,15 +1403,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
@@ -1196,6 +1431,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))
@@ -1211,9 +1448,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))- &
@@ -1222,7 +1460,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)))
@@ -1230,13 +1468,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)
@@ -1247,22 +1489,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)
@@ -1271,31 +1518,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
+ 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)
@@ -1303,53 +1553,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
@@ -1357,6 +1622,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)
@@ -1366,12 +1632,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
@@ -1380,20 +1652,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
@@ -1401,40 +1679,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/2.-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)
@@ -1442,25 +1718,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
@@ -1470,37 +1748,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/2.-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)
@@ -1509,12 +1787,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.
@@ -1526,113 +1805,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, &
@@ -1798,9 +2151,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)
@@ -1811,9 +2164,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)
@@ -1821,8 +2174,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
@@ -1837,16 +2190,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
@@ -1869,9 +2222,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
@@ -1884,8 +2237,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
@@ -1893,8 +2246,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
@@ -1923,7 +2276,7 @@ subroutine verttransform_ecmwf_windfields_nest(l,n, &
enddo
!$OMP END DO
!$OMP BARRIER
- end do
+ enddo
! Compute density gradients at intermediate levels
!*************************************************
@@ -1947,8 +2300,8 @@ 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
@@ -1974,23 +2327,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
@@ -2011,9 +2364,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
@@ -2043,13 +2396,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 cd8165e2e257b9af8676948a09228b118c743187..5765d74d2193d4552d8e6867cf374f07a17a89c5 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,9 +64,8 @@ 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
+ integer :: ks, kp, stat
+ real :: gridfract,wetscav,restmass
real,allocatable,dimension(:) :: wettmp
real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
@@ -78,15 +80,14 @@ 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,wettmp, &
-!$OMP restmass, grfraction) REDUCTION(+:blc_count,inc_count)
-
+!$OMP restmass, gridfract)
+
#if (defined _OPENMP)
thread = OMP_GET_THREAD_NUM() ! Starts with 0
#else
@@ -114,19 +115,19 @@ subroutine wetdepo(itime,ltsample,loutnext)
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
mass(jpart,ks)=0.
xscav_frac1(jpart,ks)=0.
@@ -136,7 +137,8 @@ subroutine wetdepo(itime,ltsample,loutnext)
if (wetscav.gt.0.) then
wettmp(ks)=mass(jpart,ks)* &
- (1.-exp(-wetscav*abs(ltsample)))*grfraction(1) ! wet deposition
+ (1.-exp(-wetscav*abs(ltsample)))*gridfract ! wet deposition
+
else ! if no scavenging
wettmp(ks)=0.
endif
@@ -149,9 +151,6 @@ subroutine wetdepo(itime,ltsample,loutnext)
endif
if (restmass .gt. smallnum) then
mass(jpart,ks)=restmass
- ! depostatistic
- ! wetdepo_sum(ks,kp)=wetdepo_sum(ks,kp)+wetdeposit(ks)
- ! depostatistic
else
mass(jpart,ks)=0.
endif
@@ -161,12 +160,12 @@ subroutine wetdepo(itime,ltsample,loutnext)
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,wettmp,real(part(jpart)%xlon), &
@@ -199,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.*
@@ -224,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: *
@@ -237,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 *
@@ -255,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
+ real :: 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)
@@ -301,7 +298,7 @@ subroutine get_wetscav(itime,ltsample,jpart,ks,grfraction,inc_count,blc_count,we
call find_ngrid(xts,yts)
if ( (ngrid.gt.0) ) then
- if (readclouds_nest(ngrid)) readclouds_this_nest=.true.
+ if (lcw_nest(ngrid)) readclouds_this_nest=.true.
endif
! If point at border of grid -> small displacement into grid
@@ -316,48 +313,453 @@ 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. ictop) then
+ if (part(jpart)%zeta .le. icbot) then
#else
- call find_z_level_meters(real(part(jpart)%z))
- hz=indz
+ if (part(jpart)%z .le. ictop) then
+ if (part(jpart)%z .gt. 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?
+
+ if (bcscheme .eq. 1) then
+ ! ZHG 2014: Particle rain scavenging coefficient based on Laakso et al 2003,
+ ! scaling factor Crain (=crain_aero) is read from SPECIES file
+
+ ! Laakso et al. 2003 eq. 6 + 7
+ 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**0.5 &
+ )
+
+ elseif (bcscheme .eq. 2 .or. bcscheme .eq. 3) then
+ ! 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 (bcscheme .eq. 3) then
+ ! this is a fix to avoid the scavenging gap
+ ldquer = log10(2.)
+ 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
+
+ wetscavlim = 10**(logAd+B*log10(prec))
+
+ wetscav = max(wetscav, wetscavlim)
+
+ endif
+
+ endif ! bcscheme Laakso or Wang
+
+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 )
+
+
+ if (bcscheme .eq. 1) then
+ ! ZHG 2014 : Particle snow scavenging coefficient based on Kyro et al 2009,
+ ! scaling factor Csnow (=csnow_aero) is read 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**0.5 &
+ )
+
+ elseif (bcscheme .eq. 2 .or. bcscheme .eq. 3) then
+ ! 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))
+
+ if (bcscheme .eq. 3) then
+ ldquer = log10(1.44)
+ 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.
+
+ wetscavlim = 10**(logAd+B*log10(prec))
+ wetscav = max(wetscav, wetscavlim)
+ endif
+
+ endif ! bcscheme Laakso or Wang
+
+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
- if (clouds_v.le.1) return
+ 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
@@ -383,146 +785,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
@@ -822,12 +1138,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 9df46e4f4820ba29cb3e4584fee15629986d9658..bcd4a28a2c4aa98b326bb1cfd5b7440c1db66cc2 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
+ real,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
+ real,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
-
- !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_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)
- nxfield=isec2(1)
- ny=isec2(2)
- nlev_ec=isec2(3)/2-1
+ 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)
+
+ 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)
+ 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)
+ 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,7 +2480,12 @@ subroutine readwind_ecmwf(indj,n,uuh,vvh,wwh)
!*************************************************************************
if (xglobal) then
-!$OMP PARALLEL SECTIONS
+ 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
@@ -2443,33 +2497,37 @@ subroutine readwind_ecmwf(indj,n,uuh,vvh,wwh)
!$OMP SECTION
call shift_field_0(lsm,nxfield,ny)
!$OMP SECTION
- call shift_field(ps,nxfield,ny,1,1,2,n)
+ call shift_field(ps,nxfield,ny,1,1,numwfmem,n)
!$OMP SECTION
- call shift_field(sd,nxfield,ny,1,1,2,n)
+ call shift_field(sd,nxfield,ny,1,1,numwfmem,n)
!$OMP SECTION
- call shift_field(msl,nxfield,ny,1,1,2,n)
+ call shift_field(msl,nxfield,ny,1,1,numwfmem,n)
!$OMP SECTION
- call shift_field(tcc,nxfield,ny,1,1,2,n)
+ call shift_field(tcc,nxfield,ny,1,1,numwfmem,n)
!$OMP SECTION
- call shift_field(u10,nxfield,ny,1,1,2,n)
+ call shift_field(u10,nxfield,ny,1,1,numwfmem,n)
!$OMP SECTION
- call shift_field(v10,nxfield,ny,1,1,2,n)
+ call shift_field(v10,nxfield,ny,1,1,numwfmem,n)
!$OMP SECTION
- call shift_field(tt2,nxfield,ny,1,1,2,n)
+ call shift_field(tt2,nxfield,ny,1,1,numwfmem,n)
!$OMP SECTION
- call shift_field(td2,nxfield,ny,1,1,2,n)
+ call shift_field(td2,nxfield,ny,1,1,numwfmem,n)
!$OMP SECTION
- call shift_field(lsprec,nxfield,ny,1,1,2,n)
+ do ipf=1,npf
+ call shift_field(lsprec(:,:,:,ipf,n),nxfield,ny,1,1,1,1)
+ end do
!$OMP SECTION
- call shift_field(convprec,nxfield,ny,1,1,2,n)
+ 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,2,n)
+ call shift_field(sshf,nxfield,ny,1,1,numwfmem,n)
!$OMP SECTION
- call shift_field(ssr,nxfield,ny,1,1,2,n)
+ call shift_field(ssr,nxfield,ny,1,1,numwfmem,n)
!$OMP SECTION
- call shift_field(tth,nxfield,ny,nuvzmax,nuvz,2,n)
+ call shift_field(tth,nxfield,ny,nuvzmax,nuvz,numwfmem,n)
!$OMP SECTION
- call shift_field(qvh,nxfield,ny,nuvzmax,nuvz,2,n)
+ call shift_field(qvh,nxfield,ny,nuvzmax,nuvz,numwfmem,n)
!$OMP SECTION
call shift_field(uuh,nxfield,ny,nuvzmax,nuvz,1,1)
!$OMP SECTION
@@ -2478,55 +2536,56 @@ subroutine readwind_ecmwf(indj,n,uuh,vvh,wwh)
call shift_field(wwh,nxfield,ny,nwzmax,nwz,1,1)
!$OMP SECTION
!ZHG
- call shift_field(clwch,nxfield,ny,nuvzmax,nuvz,2,n)
+ call shift_field(clwch,nxfield,ny,nuvzmax,nuvz,numwfmem,n)
!$OMP SECTION
- if (.not.sumclouds) call shift_field(ciwch,nxfield,ny,nuvzmax,nuvz,2,n)
+ if (.not.lcwsum) call shift_field(ciwch,nxfield,ny,nuvzmax,nuvz,numwfmem,n)
!ZHG end
!$OMP END PARALLEL SECTIONS
endif
! Temporary fix for zero values in the meteo data
- 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.
+ 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
@@ -2534,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))
@@ -2559,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'
@@ -2583,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: *
@@ -2634,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)
@@ -2655,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
@@ -2666,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
@@ -2721,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
@@ -2732,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
@@ -2855,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.
@@ -2863,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
@@ -2875,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)
@@ -2886,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
@@ -2907,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
@@ -2921,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
@@ -2935,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
@@ -2949,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
@@ -2957,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
@@ -2972,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
@@ -2981,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
@@ -2990,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
@@ -3039,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
@@ -3068,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
@@ -3077,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
@@ -3087,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
@@ -3096,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
@@ -3105,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
@@ -3114,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
@@ -3123,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
@@ -3152,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
@@ -3160,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
@@ -3177,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
@@ -3204,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
@@ -3214,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.
@@ -3258,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)
@@ -3275,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
@@ -3288,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)
@@ -3306,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 !!! #### '
@@ -3314,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. *
@@ -3326,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 *
@@ -3337,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
@@ -3385,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
!
@@ -3413,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
@@ -3674,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 ', &
@@ -3706,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 #### '
@@ -3877,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
@@ -3941,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)
@@ -3962,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
!**********
@@ -3998,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"
@@ -4054,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
@@ -4081,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)
@@ -4120,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"
@@ -4190,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, &
@@ -4219,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/Dockerfile.python b/tests/Dockerfile.python
new file mode 100644
index 0000000000000000000000000000000000000000..e43cfffb4bfa5a70610bbc0b95448c09538754e5
--- /dev/null
+++ b/tests/Dockerfile.python
@@ -0,0 +1,3 @@
+FROM mambaorg/micromamba:latest
+RUN micromamba install -y -n base -c conda-forge python==3.9.* netcdf4 numpy pandas scipy && \
+ micromamba clean --all --yes
diff --git a/tests/bkw_master.txt b/tests/bkw_master.txt
index 4b6b4c30adb18bd191c4655a47eb6578bc5dfe15..4a11e254ba77486acbebbf1e09270a652a18eaf3 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.21681051e-06 max abs: 2.89734802e-04
+ Dry ETA: mean abs: 9.21777875e-06 max abs: 2.84630223e-04
+ Wet: mean abs: 1.65826858e-03 max abs: 2.79553115e-01
+ Wet ETA: mean abs: 1.64790814e-03 max abs: 2.79977024e-01
diff --git a/tests/default_options/COMMAND b/tests/default_options/COMMAND
index 24e6d08c7cd9a2efa725718ea4de1212839b8e73..02e66430213930dab3b94b4ca444219fb321c547 100644
--- a/tests/default_options/COMMAND
+++ b/tests/default_options/COMMAND
@@ -41,4 +41,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
+ BCSCHEME= 2,
/
diff --git a/tests/pathnames_nests b/tests/pathnames_nests
new file mode 100644
index 0000000000000000000000000000000000000000..7ee7831a14dd1de4d4d7e4321a07177dc414708c
--- /dev/null
+++ b/tests/pathnames_nests
@@ -0,0 +1,6 @@
+./current/
+./output/
+./default_winds/
+./default_winds/AVAILABLE_glob
+./default_winds/
+============================================
\ No newline at end of file
diff --git a/tests/run_default_options_test.sh b/tests/run_default_options_test.sh
index 2c4d63ad8c7f772a2c390993a08b53892d63b702..c29196144de2ee15da30c4f391c3dd2f0c527ea0 100644
--- a/tests/run_default_options_test.sh
+++ b/tests/run_default_options_test.sh
@@ -277,7 +277,22 @@ TESTSRUN=$((TESTSRUN + 1))
# clean up
rm -rf ./current ./output/*
#
-#
+# # part_ic option
+# cp -rf ./default_options ./current
+# sed -i "/IPIN=/c\ IPIN= 3," ./current/COMMAND
+# sed -i "/LDIRECT=/c\ LDIRECT= -1," ./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))
+# # clean up
+# rm -rf ./current ./output/*
#
#IFLUX
cp -rf ./default_options ./current
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..94f5d5dde9691a2a055e6f33ba3070d289dc274a 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
- 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
- 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
+ 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.97848016e+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.48925281e+01 max abs: 5.04734192e+01
+ lat_av: mean abs: 3.49040125e+01 max abs: 5.04243546e+01
+ lat_av ETA: mean abs: 3.49039750e+01 max abs: 5.04254761e+01
+ z: mean abs: 4.84618125e+01 max abs: 1.31529022e+02
+ z ETA: mean abs: 4.85209250e+01 max abs: 1.31316452e+02
+ z_av: mean abs: 4.86866062e+01 max abs: 1.26583122e+02
+ z_av ETA: mean abs: 4.87390219e+01 max abs: 1.26399139e+02
+ pv: mean abs: 2.25662461e+00 max abs: 3.21795273e+01
+ pv ETA: mean abs: 2.24790391e+00 max abs: 3.22219543e+01
+ pv_av: mean abs: 2.23525410e+00 max abs: 3.22249832e+01
+ pv_av ETA: mean abs: 2.22549336e+00 max abs: 3.22536697e+01
+ qv: mean abs: 3.93889465e-03 max abs: 7.79772317e-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.92791672e-03 max abs: 7.75184669e-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
+ T: mean abs: 2.77977625e+02 max abs: 2.87984131e+02
+ T ETA: mean abs: 2.77983450e+02 max abs: 2.87999176e+02
+ T_av: mean abs: 2.78092275e+02 max abs: 2.87902893e+02
+ T_av ETA: mean abs: 2.78098300e+02 max abs: 2.87902863e+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.03865078e+05
+ prs_av ETA: mean abs: 9.82025088e+04 max abs: 1.03864344e+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
+ tro: mean abs: 1.12843584e+04 max abs: 1.57277559e+04
+ tro ETA: mean abs: 1.12844000e+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.57061426e+04
+ to: mean abs: 3.23780175e+02 max abs: 1.12426550e+03
+ to ETA: mean abs: 3.23776725e+02 max abs: 1.12414734e+03
+ to_av: mean abs: 3.23853525e+02 max abs: 1.11385352e+03
+ to_av ETA: mean abs: 3.23850750e+02 max abs: 1.11391516e+03
+ m001: mean abs: 9.86326694e-05 max abs: 9.99999975e-05
+ m001 ETA: mean abs: 9.86040950e-05 max abs: 9.99999975e-05
+ m_av001: mean abs: 9.89405155e-05 max abs: 9.99999975e-05
+ m_av001 ETA: mean abs: 9.89151716e-05 max abs: 9.99999975e-05
+ u: mean abs: 2.09955117e+00 max abs: 7.07874727e+00
+ u ETA: mean abs: 2.10246621e+00 max abs: 7.08937645e+00
+ u_av: mean abs: 2.10358008e+00 max abs: 7.12824774e+00
+ u_av ETA: mean abs: 2.10650977e+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.05966055e+00 max abs: 1.12192631e+01
+ v_av ETA: mean abs: 3.06319102e+00 max abs: 1.12289562e+01
+ w: mean abs: 2.97906423e-04 max abs: 3.80160334e-03
+ w ETA: mean abs: 2.97123837e-04 max abs: 3.79444822e-03
+ w_av: mean abs: 2.96450257e-04 max abs: 3.69339995e-03
+ w_av ETA: mean abs: 2.96099424e-04 max abs: 3.68712889e-03
+ vset: mean abs: 3.56950760e-05 max abs: 3.88669978e-05
+ vset ETA: mean abs: 3.56949538e-05 max abs: 3.88667650e-05
+ vset_av: mean abs: 3.56949955e-05 max abs: 3.88597291e-05
+ vset_av ETA: mean abs: 3.56948853e-05 max abs: 3.88595181e-05
+ wetdepo001: mean abs: 6.09834818e-07 max abs: 2.30988608e-05
+ wetdepo001 ETA: mean abs: 6.38959650e-07 max abs: 2.30990718e-05
+ drydepo001: mean abs: 7.57480366e-07 max abs: 4.87260877e-06
+ drydepo001 ETA: mean abs: 7.56929256e-07 max abs: 4.87258103e-06
+ Concentrations: mean abs: 4.52137883e-05 max abs: 3.61566036e-03
+ Concentrations ETA: mean abs: 4.52048342e-05 max abs: 3.61566106e-03
+ WET deposition: mean abs: 7.88419117e-05 max abs: 2.12080628e-02
+ WET deposition ETA: mean abs: 8.39153350e-05 max abs: 2.46815812e-02
+ DRY deposition: mean abs: 9.21872407e-05 max abs: 2.45532882e-03
+ DRY deposition ETA: mean abs: 9.21631183e-05 max abs: 2.44458020e-03