From 6ffa2d6541ed1c346e7f59a6217604cb1511e88c Mon Sep 17 00:00:00 2001 From: "dependabot[bot]" <49699333+dependabot[bot]@users.noreply.github.com> Date: Tue, 28 Nov 2023 20:18:00 +0000 Subject: [PATCH 01/57] Bump JamesIves/github-pages-deploy-action from 4.4.3 to 4.5.0 Bumps [JamesIves/github-pages-deploy-action](https://github.com/jamesives/github-pages-deploy-action) from 4.4.3 to 4.5.0. - [Release notes](https://github.com/jamesives/github-pages-deploy-action/releases) - [Commits](https://github.com/jamesives/github-pages-deploy-action/compare/v4.4.3...v4.5.0) --- updated-dependencies: - dependency-name: JamesIves/github-pages-deploy-action dependency-type: direct:production update-type: version-update:semver-minor ... Signed-off-by: dependabot[bot] --- .github/workflows/doc-deployment.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/doc-deployment.yml b/.github/workflows/doc-deployment.yml index 6c2a7a8bd..5a74b3cb5 100644 --- a/.github/workflows/doc-deployment.yml +++ b/.github/workflows/doc-deployment.yml @@ -70,7 +70,7 @@ jobs: # Deploy documentation # - name: Deploy API Documentation - uses: JamesIves/github-pages-deploy-action@v4.4.3 + uses: JamesIves/github-pages-deploy-action@v4.5.0 if: ${{ github.event_name == 'push' && github.ref == 'refs/heads/main' }} with: branch: gh-pages From 8131adcc527431c796d5a2be5a3aa7a04ddbdfb3 Mon Sep 17 00:00:00 2001 From: Robert Pincus Date: Wed, 29 Nov 2023 22:06:40 -0500 Subject: [PATCH 02/57] Documentation -> develop (#244) Update develop with changes from documentation branch --- .github/workflows/doc-deployment.yml | 4 ++-- README.md | 2 +- ...v1.8-Release-notes.md => 2023-11-27-v1.7-Release-notes.md} | 4 ++-- 3 files changed, 5 insertions(+), 5 deletions(-) rename doc/jekyll_site/_posts/{2023-11-27-v1.8-Release-notes.md => 2023-11-27-v1.7-Release-notes.md} (88%) diff --git a/.github/workflows/doc-deployment.yml b/.github/workflows/doc-deployment.yml index 5a74b3cb5..1d67ab9e8 100644 --- a/.github/workflows/doc-deployment.yml +++ b/.github/workflows/doc-deployment.yml @@ -60,7 +60,7 @@ jobs: # Check broken links # - name: Broken Link Check - if: ${{ github.ref == 'refs/heads/main'}} + if: ${{ github.ref == 'refs/heads/documentation'}} uses: technote-space/broken-link-checker-action@v2 with: TARGET: file://${{ github.workspace }}/doc/ford_site/pages/index.html @@ -71,7 +71,7 @@ jobs: # - name: Deploy API Documentation uses: JamesIves/github-pages-deploy-action@v4.5.0 - if: ${{ github.event_name == 'push' && github.ref == 'refs/heads/main' }} + if: ${{ github.event_name == 'push' && github.ref == 'refs/heads/documentation' }} with: branch: gh-pages folder: public/ diff --git a/README.md b/README.md index c40427f4b..b41d49c0a 100644 --- a/README.md +++ b/README.md @@ -38,7 +38,7 @@ Two examples are provided in `examples/`, one for clear skies and one including Code releases are archived at Zenodo. All releases are available at [![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.3403172.svg)](https://doi.org/10.5281/zenodo.3403172). -The current release is available at: [![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.7521518.svg)](https://doi.org/10.5281/zenodo.7521518) +The current release is available at: [![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.7521518.svg)](https://doi.org/10.5281/zenodo.10211873) Please cite the code using these DOIs and the information in the `CITATION.cff` file in addition to the reference [paper](https://doi.org/10.1029/2019MS001621) diff --git a/doc/jekyll_site/_posts/2023-11-27-v1.8-Release-notes.md b/doc/jekyll_site/_posts/2023-11-27-v1.7-Release-notes.md similarity index 88% rename from doc/jekyll_site/_posts/2023-11-27-v1.8-Release-notes.md rename to doc/jekyll_site/_posts/2023-11-27-v1.7-Release-notes.md index 85d9e4384..ef4cc27a1 100644 --- a/doc/jekyll_site/_posts/2023-11-27-v1.8-Release-notes.md +++ b/doc/jekyll_site/_posts/2023-11-27-v1.7-Release-notes.md @@ -1,6 +1,6 @@ --- layout: post -title: "v1.8 Release notes" +title: "v1.7 Release notes" categories: Release-notes --- @@ -9,7 +9,7 @@ to branch `main` makes the following changes: - Libraries can be built in single precision by changes in `rte-kind/mo_rte_kind.F90`. Differences with respect to double precision are roughly 0.13 W/m2. - A class for computing the optical properties of aerosols following the MERRA representation has been added. -- The repository is reorganized into `frontend` and `kernel` directories for `rte` and `rrtmgp`. Data has been moved to a separate [repository])((https://github.com/earth-system-radiation/rrtmgp-data/). +- The repository is reorganized into `frontend` and `kernel` directories for `rte` and `rrtmgp`. Data has been moved to a separate [repository]((https://github.com/earth-system-radiation/rrtmgp-data/). - Citation information has been added. As usual some bugs have been fixed, the use of OpenACC and OpenMP GPU offload directives continues to evolve, and the continous integration continues to be fine-tuned. From b9dbe26d4bfc0b73e2c33c54002480f939326c9a Mon Sep 17 00:00:00 2001 From: Robert Pincus Date: Fri, 1 Dec 2023 17:46:11 -0500 Subject: [PATCH 03/57] Update Readme Build instructions point to the Github Pages site. --- README.md | 12 ++---------- 1 file changed, 2 insertions(+), 10 deletions(-) diff --git a/README.md b/README.md index b41d49c0a..dfbb39610 100644 --- a/README.md +++ b/README.md @@ -17,16 +17,8 @@ RTE computes fluxes given spectrally-resolved optical descriptions and source fu ## Building the libraries, examples, and unit-testing codes. -RTE+RRTMGP has an ad hoc homemade build system that can be invoked as follows: - -1. Set environment variables `FC` (the Fortran 2003 compiler) and `FCFLAGS` (compiler flags). Examples are provided in the `Compiler-flags.md` file. -2. Set environment variables `RRTMGP_ROOT` to the top-level RTE+RRTMGP directory and `RTE_KERNELS` to `accel` if you want the OpenACC/OpenMP kernels rather than the default. -3. `make libs` in the top-level directory will make the RTE and RRTMGP libraries. -4. The examples and testing codes use netCDF. Set the variables `NCHOME` and `NFHOME` to the roots of the C and Fortran netCDF installations. -5. Download the RRTMGP data either by cloning the [data repository](https://github.com/earth-system-radiation/rrtmgp-data) or from the [Zenodo archive](https://doi.org/10.5281/zenodo.7988260). Set the environment variable `RRTMGP_DATA` to the root of this directory. -6. `make tests` to will build and run the test. -7. Evaluating the results of the tests requires `Python` and the packages described in `environment.yml`. Comparisons can be made with `make check` in the top level directory. -8. `make` invoked without a target in the top level attempts all three steps. + +A description of building RTE+RRTMGP with an ad hoc homemade system is described in the [documentation](https://earth-system-radiation.github.io/rte-rrtmgp/how-tos/). See also the `autoconf` branch for a Gnu autotools build system. From 90925e385be9f596b12ac076b075239568d0259a Mon Sep 17 00:00:00 2001 From: Robert Pincus Date: Sat, 2 Dec 2023 14:44:14 -0500 Subject: [PATCH 04/57] Simplify build flags (#247) Deprecating NCHOME, NFHOME --- .github/workflows/continuous-integration.yml | 2 +- environment-dev.yml | 2 +- examples/all-sky/Makefile | 11 +++++------ examples/rfmip-clear-sky/Makefile | 10 +++++----- tests/Makefile | 10 +++++----- 5 files changed, 17 insertions(+), 18 deletions(-) diff --git a/.github/workflows/continuous-integration.yml b/.github/workflows/continuous-integration.yml index 33f7bbb66..2a37a3c0a 100644 --- a/.github/workflows/continuous-integration.yml +++ b/.github/workflows/continuous-integration.yml @@ -25,7 +25,7 @@ jobs: FC: ${{ matrix.fortran-compiler }} FCFLAGS: "-ffree-line-length-none -m64 -std=f2008 -march=native -fbounds-check -fmodule-private -fimplicit-none -finit-real=nan -g -DRTE_USE_CBOOL -DRTE_USE_${{ matrix.fpmodel }}" # Make variables: - NFHOME: /usr + FCINCLUDE: -I/usr/include RRTMGP_ROOT: ${{ github.workspace }} RRTMGP_DATA: ${{ github.workspace }}/rrtmgp-data RUN_CMD: diff --git a/environment-dev.yml b/environment-dev.yml index 5ddc6cf51..6a5924052 100644 --- a/environment-dev.yml +++ b/environment-dev.yml @@ -22,4 +22,4 @@ variables: FCFLAGS: "-ffree-line-length-none -m64 -std=f2008 -march=native -fbounds-check -finit-real=nan -g -DRTE_USE_CBOOL" # Shell environment variables can't be used within this YML files, so # Users still need to set RRTMGP_ROOT, - # NCHOME = CONDA_PREFIX, NFHOME = CONDA_PREFIX + # FCINCLUDE=-I${CONDA_PREFIX}/include diff --git a/examples/all-sky/Makefile b/examples/all-sky/Makefile index af7a22d9d..b221dd0a2 100644 --- a/examples/all-sky/Makefile +++ b/examples/all-sky/Makefile @@ -9,12 +9,11 @@ LDFLAGS += -L$(RRTMGP_BUILD) LIBS += -lrrtmgp -lrte FCINCLUDE += -I$(RRTMGP_BUILD) -# -# netcdf library, module files -# Environment variables NCHOME and NFHOME point to root of C and Fortran interfaces respectively - -# -FCINCLUDE += -I$(NFHOME)/include -LDFLAGS += -L$(NFHOME)/lib -L$(NCHOME)/lib +# netcdf Fortran module files has to be in the search path or added via environment variable FCINCLUDE e.g. +#FCINCLUDE += -I$(NFHOME)/include + +# netcdf C and Fortran libraries have to be in the search path or added via environment variable LDFLAGS e.g. +#LDFLAGS += -L$(NFHOME)/lib -L$(NCHOME)/lib LIBS += -lnetcdff -lnetcdf VPATH = ../:$(RRTMGP_ROOT)/rrtmgp-frontend # Needed for cloud_optics and aerosol_optics diff --git a/examples/rfmip-clear-sky/Makefile b/examples/rfmip-clear-sky/Makefile index a2edd1539..6f2bc3621 100644 --- a/examples/rfmip-clear-sky/Makefile +++ b/examples/rfmip-clear-sky/Makefile @@ -10,11 +10,11 @@ RRTMGP_BUILD = $(RRTMGP_ROOT)/build FCINCLUDE += -I$(RRTMGP_BUILD) # -# netcdf library, module files -# Environment variables NCHOME and NFHOME point to root of C and Fortran interfaces respectively - -# -FCINCLUDE += -I$(NFHOME)/include -LDFLAGS += -L$(NFHOME)/lib -L$(NCHOME)/lib +# netcdf Fortran module files has to be in the search path or added via environment variable FCINCLUDE e.g. +#FCINCLUDE += -I$(NFHOME)/include + +# netcdf C and Fortran libraries have to be in the search path or added via environment variable LDFLAGS e.g. +#LDFLAGS += -L$(NFHOME)/lib -L$(NCHOME)/lib LIBS += -lnetcdff -lnetcdf VPATH = ../ diff --git a/tests/Makefile b/tests/Makefile index 620512565..d433f4725 100644 --- a/tests/Makefile +++ b/tests/Makefile @@ -9,13 +9,13 @@ RRTMGP_BUILD = $(RRTMGP_ROOT)/build # LIBS += -lrrtmgp -lrte FCINCLUDE += -I$(RRTMGP_BUILD) # -# netcdf library, module files -# Environment variables NCHOME and NFHOME point to root of C and Fortran interfaces respectively - -# -FCINCLUDE += -I$(NFHOME)/include +# netcdf Fortran module files has to be in the search path or added via environment variable FCINCLUDE e.g. +#FCINCLUDE += -I$(NFHOME)/include + +# netcdf C and Fortran libraries have to be in the search path or added via environment variable LDFLAGS e.g. +#LDFLAGS += -L$(NFHOME)/lib -L$(NCHOME)/lib LDFLAGS += -L$(RRTMGP_BUILD) LIBS += -lrte -lrrtmgp -LDFLAGS += -L$(NFHOME)/lib -L$(NCHOME)/lib LIBS += -lnetcdff -lnetcdf VPATH = .:$(RRTMGP_ROOT)/examples:$(RRTMGP_ROOT)/examples/rfmip-clear-sky:$(RRTMGP_ROOT)/examples/all-sky From 98213245df4bb50dcc03837dd14bc7773d955046 Mon Sep 17 00:00:00 2001 From: Robert Pincus Date: Mon, 4 Dec 2023 11:13:55 -0800 Subject: [PATCH 05/57] Update Documentation (#248) Consolidating build information --- Compiler-flags.md | 47 -------------- doc/jekyll_site/how-tos/build-and-test.md | 76 +++++++++++++++++++++++ doc/jekyll_site/how-tos/index.md | 20 +----- 3 files changed, 77 insertions(+), 66 deletions(-) delete mode 100644 Compiler-flags.md create mode 100644 doc/jekyll_site/how-tos/build-and-test.md diff --git a/Compiler-flags.md b/Compiler-flags.md deleted file mode 100644 index 817de049a..000000000 --- a/Compiler-flags.md +++ /dev/null @@ -1,47 +0,0 @@ -# Compiler flag Examples - -Before using the Makefiles supplied with the `RTE+RRTMGP` repository, the environment variables `FC` and -`FCFLAGS`, identifying the Fortran compiler and flags passed to it, need to be set. Here are some examples -used during development and testing. - -To build any of the executables in `examples/` or `tests` the locations of the C and Fortran netCDF libraries -need to be set via environment variables `NCHOME` and `NFHOME`, and the variable `RRTMGP_ROOT` must be set to the -root of the RTE+RRTMGP installation. - -## Gnu Fortran -(see also the [continuous integration](https://github.com/earth-system-radiation/rte-rrtmgp/blob/main/.github/workflows/continuous-integration.yml)) -`FC: `gfortran-10` or `gfortran-11` or `gfortran-12` -### Debugging flags -`FCFLAGS: "-ffree-line-length-none -m64 -std=f2008 -march=native -fbounds-check -finit-real=nan -DRTE_USE_CBOOL"` -### Even stricter debugging flags -`FCFLAGS: "-ffree-line-length-none -m64 -std=f2008 -march=native -fbounds-check -fbacktrace -finit-real=nan -DRTE_USE_CBOOL -pedantic -g -Wall"` - -## Intel Fortran Classic -(see also the [continuous integration](https://github.com/earth-system-radiation/rte-rrtmgp/blob/main/.github/workflows/containerized-ci.yml)) -`FC: ifort` -### Debugging flags -`FCFLAGS: "-m64 -g -traceback -heap-arrays -assume realloc_lhs -extend-source 132 -check bounds,uninit,pointers,stack -stand f08"` -### Optimization flags: -`FCFLAGS:"-m64 -O3 -g -traceback -heap-arrays -assume realloc_lhs -extend-source 132"` - -## Intel Fortran -(LLVM, see also the [continuous integration](https://github.com/earth-system-radiation/rte-rrtmgp/blob/main/.github/workflows/containerized-ci.yml)) -`FC: ifort` -### Debugging flags -`FCFLAGS: "-debug -traceback -heap-arrays -assume realloc_lhs -extend-source 132 -stand f08"` -### Using OpenMP GPU offload -See [this open issue](https://github.com/earth-system-radiation/rte-rrtmgp/issues/194) - -## NVFortran -(see also the see also the [continuous integration](https://github.com/earth-system-radiation/rte-rrtmgp/blob/main/.github/workflows/containerized-ci.yml)) -`FC: nvfortran` -### Debugging flags -`FCFLAGS: "-g -Minfo -Mbounds -Mchkptr -Mstandard -Kieee -Mchkstk -Mallocatable=03 -Mpreprocess"` -### Optimization flags: -`FCFLAGS: "-O3 -fast -Minfo -Mallocatable=03 -Mpreprocess"` - -## HPE CCE for GPU using OpenMP-acc: crayftn -- requires at least CCE 14.0.0 -`FC: crayftn` -### Debugging flags (these appear to be insufficient during the link stage) -`FCFLAGS: "-hnoacc -homp -O0"` - diff --git a/doc/jekyll_site/how-tos/build-and-test.md b/doc/jekyll_site/how-tos/build-and-test.md new file mode 100644 index 000000000..07b4dc186 --- /dev/null +++ b/doc/jekyll_site/how-tos/build-and-test.md @@ -0,0 +1,76 @@ +--- +layout: "page" +title: "How to build and run tests" +--- +How to build the libraries, tests, and examples, run the tests, and verify the results + +## In a nutshell +In the root directory: +- `make libs` makes the RTE and RRTMGP libraries, the unit tests, and the examples +- `make tests` runs the tests +- `make check` uses Python to verify results against reference calculations +- `make` invoked without a target in the top level attempts all three steps. + +Evaluating the results of the tests requires `Python` and the packages described in `environment*.yml`. + +## Building and testing using the handbuilt Makefiles + +Before using the Makefiles supplied with the `RTE+RRTMGP` repository, the environment variables `FC` and +`FCFLAGS`, identifying the Fortran compiler and flags passed to it, need to be set. + +To build any of the examples in `examples/` or `tests` the locations of the C and Fortran netCDF libraries and the +location of the netCDF Fortran module file (`netcdf.mod`) must be in the search path. +Non-standard paths can also be added via macros `FCINCLUDE` and/or `LDFLAGS`. + +## Building and testing using (Gnu) autotools + +Sergey Kosukhin and his colleagues at the Max Planck Institute for Meteorology +maintain the `autoconf` branch which adds Gnu `autotools` building to `main` branch. + +## Supplying data + +Running the tests and verifying the results requires the RRTMGP data. Clone the +[data repository](https://github.com/earth-system-radiation/rrtmgp-data) or download the +[Zenodo archive](https://doi.org/10.5281/zenodo.7988260). Set the environment variable `RRTMGP_DATA` +to the root of this directory. + +## Example compiler flags + +In these examples `FC` is the Fortran compilers using flags `FCFLAGS` + +### Gnu Fortran +(see also the [continuous integration](https://github.com/earth-system-radiation/rte-rrtmgp/blob/main/.github/workflows/continuous-integration.yml)) +`FC`: `gfortran-10` or `gfortran-11` or `gfortran-12` +#### Debugging flags +`FCFLAGS: "-ffree-line-length-none -m64 -std=f2008 -march=native -fbounds-check -finit-real=nan -DRTE_USE_CBOOL"` +#### Even stricter debugging flags +`FCFLAGS: "-ffree-line-length-none -m64 -std=f2008 -march=native -fbounds-check -fbacktrace -finit-real=nan -DRTE_USE_CBOOL -pedantic -g -Wall"` + +### Intel Fortran Classic +(see also the [continuous integration](https://github.com/earth-system-radiation/rte-rrtmgp/blob/main/.github/workflows/containerized-ci.yml)) +`FC: ifort` +#### Debugging flags +`FCFLAGS: "-m64 -g -traceback -heap-arrays -assume realloc_lhs -extend-source 132 -check bounds,uninit,pointers,stack -stand f08"` +#### Optimization flags: +`FCFLAGS:"-m64 -O3 -g -traceback -heap-arrays -assume realloc_lhs -extend-source 132"` + +### Intel Fortran +(LLVM, see also the [continuous integration](https://github.com/earth-system-radiation/rte-rrtmgp/blob/main/.github/workflows/containerized-ci.yml)) +`FC: ifort` +#### Debugging flags +`FCFLAGS: "-debug -traceback -heap-arrays -assume realloc_lhs -extend-source 132 -stand f08"` +#### Using OpenMP GPU offload +See [this open issue](https://github.com/earth-system-radiation/rte-rrtmgp/issues/194) + +### NVFortran +(see also the see also the [continuous integration](https://github.com/earth-system-radiation/rte-rrtmgp/blob/main/.github/workflows/containerized-ci.yml)) +`FC: nvfortran` +#### Debugging flags +`FCFLAGS: "-g -Minfo -Mbounds -Mchkptr -Mstandard -Kieee -Mchkstk -Mallocatable=03 -Mpreprocess"` +#### Optimization flags: +`FCFLAGS: "-O3 -fast -Minfo -Mallocatable=03 -Mpreprocess"` + +### HPE CCE for GPU using OpenMP-acc: crayftn -- requires at least CCE 14.0.0 +`FC: crayftn` +#### Debugging flags (these appear to be insufficient during the link stage) +`FCFLAGS: "-hnoacc -homp -O0"` \ No newline at end of file diff --git a/doc/jekyll_site/how-tos/index.md b/doc/jekyll_site/how-tos/index.md index b104fd854..c956dad9b 100644 --- a/doc/jekyll_site/how-tos/index.md +++ b/doc/jekyll_site/how-tos/index.md @@ -2,22 +2,4 @@ layout: "page" title: "How-to guides" --- -# How-to guides will live here - -## How-to: build, run, and test the libraries, examples, and unit-testing codes. - -1. Set environment variables `FC` (the Fortran 2003 compiler) and `FCFLAGS` (compiler flags). Examples are provided in the `Compiler-flags.md` file. -2. Set environment variables `RRTMGP_ROOT` to the top-level RTE+RRTMGP directory and `RTE_KERNELS` to `accel` if you want the OpenACC/OpenMP kernels rather than the default. -3. `make libs` in the top-level directory will make the RTE and RRTMGP libraries. -4. The examples and testing codes use netCDF. Set the variables `NCHOME` and `NFHOME` to the roots of the C and Fortran netCDF installations. -5. Download the RRTMGP data either by cloning the [data repository](https://github.com/earth-system-radiation/rrtmgp-data) or from the [Zenodo archive](https://doi.org/10.5281/zenodo.7988260). Set the environment variable `RRTMGP_DATA` to the root of this directory. -6. `make tests` to will build and run the test. -7. Evaluating the results of the tests requires `Python` and the packages described in `environment.yml`. Comparisons can be made with `make check` in the top level directory. -8. `make` invoked without a target in the top level attempts all three steps. - - - -### Building and testing using (Gnu) make - -Sergey Kosukhin and his colleagues at the Max Planck Institute for Meteorology -maintain the `autoconf` branch which adds Gnu `autotools` building to `main` branch. +- How to [build and test](https://earth-system-radiation.github.io/rte-rrtmgp/how-tos/build-and-test.html) From fee55ca842ba3e0d96f4acee86a4036197bff817 Mon Sep 17 00:00:00 2001 From: Sergey Kosukhin Date: Wed, 6 Dec 2023 20:58:49 +0100 Subject: [PATCH 06/57] Update CI configuration (#249) Skip self-hosted jobs in the fork repositories, use new container tags --- .github/workflows/containerized-ci.yml | 6 +++--- .github/workflows/self-hosted-ci.yml | 1 + 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/.github/workflows/containerized-ci.yml b/.github/workflows/containerized-ci.yml index 08071c78a..e8f3a149f 100644 --- a/.github/workflows/containerized-ci.yml +++ b/.github/workflows/containerized-ci.yml @@ -40,11 +40,11 @@ jobs: fcflags: -Mallocatable=03 -Mstandard -Mbounds -Mchkptr -Kieee -Mchkstk -acc # Set container images - fortran-compiler: ifort - image: ghcr.io/earth-system-radiation/rte-rrtmgp-ci:ifort + image: ghcr.io/earth-system-radiation/rte-rrtmgp-ci:oneapi - fortran-compiler: ifx - image: ghcr.io/earth-system-radiation/rte-rrtmgp-ci:ifort + image: ghcr.io/earth-system-radiation/rte-rrtmgp-ci:oneapi - fortran-compiler: nvfortran - image: ghcr.io/earth-system-radiation/rte-rrtmgp-ci:nvfortran + image: ghcr.io/earth-system-radiation/rte-rrtmgp-ci:nvhpc container: image: ${{ matrix.image }} env: diff --git a/.github/workflows/self-hosted-ci.yml b/.github/workflows/self-hosted-ci.yml index c285eb7f7..5fa20f9f5 100644 --- a/.github/workflows/self-hosted-ci.yml +++ b/.github/workflows/self-hosted-ci.yml @@ -13,6 +13,7 @@ defaults: jobs: CI: + if: github.repository == 'earth-system-radiation/rte-rrtmgp' runs-on: labels: cscs-ci continue-on-error: ${{ matrix.experimental }} From a8acd3be414dc7bbfa81f629b6feb246644ae43a Mon Sep 17 00:00:00 2001 From: Robert Pincus Date: Wed, 13 Dec 2023 21:01:47 -0500 Subject: [PATCH 07/57] Update environment*.yml files (#251) Update YML files for simplicity and consistency with CI. Update Python version to 3.11 --- .github/workflows/continuous-integration.yml | 2 +- environment-dev.yml | 29 +++++++++++--------- environment-noplots.yml | 10 +++---- environment.yml | 24 ++++++++-------- 4 files changed, 35 insertions(+), 30 deletions(-) diff --git a/.github/workflows/continuous-integration.yml b/.github/workflows/continuous-integration.yml index 2a37a3c0a..b256147f1 100644 --- a/.github/workflows/continuous-integration.yml +++ b/.github/workflows/continuous-integration.yml @@ -77,7 +77,7 @@ jobs: miniforge-version: latest activate-environment: rte_rrtmgp_test environment-file: environment-noplots.yml - python-version: 3.9 + python-version: 3.11 auto-activate-base: false # Use the cache properly: use-only-tar-bz2: true diff --git a/environment-dev.yml b/environment-dev.yml index 6a5924052..b9fa161d9 100644 --- a/environment-dev.yml +++ b/environment-dev.yml @@ -3,23 +3,26 @@ # Also include gfortran and netCDF for development # name: rte_rrtmgp_dev +channels: + - conda-forge + - nodefaults dependencies: - - conda-forge::python=3.9 - - conda-forge::urllib3 - - conda-forge::netcdf4 - - conda-forge::xarray - - conda-forge::dask - - conda-forge::numpy - - conda-forge::scipy - - conda-forge::matplotlib - - conda-forge::seaborn - - conda-forge::colorcet - - conda-forge::gfortran - - conda-forge::netcdf-fortran + - python=3.11 + - urllib3 + - netcdf4 + - xarray + - dask + - numpy + - scipy + - matplotlib + - seaborn + - colorcet + - gfortran + - netcdf-fortran variables: FC: gfortran # Debugging flags below - FCFLAGS: "-ffree-line-length-none -m64 -std=f2008 -march=native -fbounds-check -finit-real=nan -g -DRTE_USE_CBOOL" + FCFLAGS: "-ffree-line-length-none -m64 -std=f2008 -march=native -fbounds-check -fmodule-private -fimplicit-none -finit-real=nan -g -DRTE_USE_CBOOL" # Shell environment variables can't be used within this YML files, so # Users still need to set RRTMGP_ROOT, # FCINCLUDE=-I${CONDA_PREFIX}/include diff --git a/environment-noplots.yml b/environment-noplots.yml index 7b29fc6bf..dfa6536fc 100644 --- a/environment-noplots.yml +++ b/environment-noplots.yml @@ -4,8 +4,8 @@ name: rte_rrtmgp_test_noplots dependencies: - - conda-forge::python=3.9 - - conda-forge::netcdf4 - - conda-forge::xarray - - conda-forge::dask - - conda-forge::numpy + - python=3.11 + - netcdf4 + - xarray + - dask + - numpy diff --git a/environment.yml b/environment.yml index c595faa38..a67fb5d14 100644 --- a/environment.yml +++ b/environment.yml @@ -2,15 +2,17 @@ # Python modules below are needed to run tests, check results and generate validation plots # name: rte_rrtmgp_test - +channels: + - conda-forge + - nodefaults dependencies: - - conda-forge::python=3.9 - - conda-forge::urllib3 - - conda-forge::netcdf4 - - conda-forge::xarray - - conda-forge::dask - - conda-forge::numpy - - conda-forge::scipy - - conda-forge::matplotlib - - conda-forge::seaborn - - conda-forge::colorcet + - python=3.11 + - urllib3 + - netcdf4 + - xarray + - dask + - numpy + - scipy + - matplotlib + - seaborn + - colorcet From c61f37352a3513111c94cde93c9e3f9f7e8f3cdb Mon Sep 17 00:00:00 2001 From: Robert Pincus Date: Thu, 14 Dec 2023 14:14:07 -0500 Subject: [PATCH 08/57] Simplify LW source functions (#250) Single level source for LW no-scattering solver; spectral mapping as the sqrt of the product of the mappings in each adjacent layer --- .github/workflows/containerized-ci.yml | 2 +- .github/workflows/continuous-integration.yml | 2 +- .github/workflows/self-hosted-ci.yml | 2 +- examples/all-sky/rrtmgp_allsky.F90 | 8 +- examples/rfmip-clear-sky/rrtmgp_rfmip_lw.F90 | 8 +- rrtmgp-frontend/mo_gas_optics_rrtmgp.F90 | 6 +- .../accel/mo_gas_optics_rrtmgp_kernels.F90 | 42 +++-- .../mo_gas_optics_rrtmgp_kernels.F90 | 32 ++-- rte-frontend/mo_rte_lw.F90 | 12 +- rte-frontend/mo_source_functions.F90 | 20 +-- rte-kernels/accel/mo_rte_solver_kernels.F90 | 168 ++++++------------ rte-kernels/mo_rte_solver_kernels.F90 | 137 +++++--------- 12 files changed, 174 insertions(+), 265 deletions(-) diff --git a/.github/workflows/containerized-ci.yml b/.github/workflows/containerized-ci.yml index e8f3a149f..ba5382a57 100644 --- a/.github/workflows/containerized-ci.yml +++ b/.github/workflows/containerized-ci.yml @@ -59,7 +59,7 @@ jobs: RUN_CMD: # https://github.com/earth-system-radiation/rte-rrtmgp/issues/194 OMP_TARGET_OFFLOAD: DISABLED - FAILURE_THRESHOLD: 7.e-4 + FAILURE_THRESHOLD: 5.8e-2 # 7.e-4 steps: # diff --git a/.github/workflows/continuous-integration.yml b/.github/workflows/continuous-integration.yml index b256147f1..31d6f7328 100644 --- a/.github/workflows/continuous-integration.yml +++ b/.github/workflows/continuous-integration.yml @@ -29,7 +29,7 @@ jobs: RRTMGP_ROOT: ${{ github.workspace }} RRTMGP_DATA: ${{ github.workspace }}/rrtmgp-data RUN_CMD: - FAILURE_THRESHOLD: 7.e-4 + FAILURE_THRESHOLD: 5.8e-2 # 7.e-4 steps: # # Relax failure thresholds for single precision diff --git a/.github/workflows/self-hosted-ci.yml b/.github/workflows/self-hosted-ci.yml index 5fa20f9f5..a5409d80a 100644 --- a/.github/workflows/self-hosted-ci.yml +++ b/.github/workflows/self-hosted-ci.yml @@ -50,7 +50,7 @@ jobs: RRTMGP_DATA: ${{ github.workspace }}/rrtmgp-data RTE_KERNELS: ${{ matrix.rte-kernels }} RUN_CMD: "srun -C gpu -A d56 -p cscsci -t 15:00" - FAILURE_THRESHOLD: 7.e-4 + FAILURE_THRESHOLD: 5.8e-2 # 7.e-4 steps: # # Checks-out repository under $GITHUB_WORKSPACE diff --git a/examples/all-sky/rrtmgp_allsky.F90 b/examples/all-sky/rrtmgp_allsky.F90 index 05d6a1973..e25ec0bf3 100644 --- a/examples/all-sky/rrtmgp_allsky.F90 +++ b/examples/all-sky/rrtmgp_allsky.F90 @@ -310,10 +310,10 @@ program rte_rrtmgp_allsky ! ! Should we allocate these once, rather than once per loop? They're big. ! - !$acc data create( lw_sources, lw_sources%lay_source, lw_sources%lev_source_inc) & - !$acc create( lw_sources%lev_source_dec, lw_sources%sfc_source, lw_sources%sfc_source_Jac) - !$omp target data map(alloc: lw_sources%lay_source, lw_sources%lev_source_inc) & - !$omp map(alloc: lw_sources%lev_source_dec, lw_sources%sfc_source, lw_sources%sfc_source_Jac) + !$acc data create( lw_sources, lw_sources%lay_source, lw_sources%lev_source) & + !$acc create( lw_sources%sfc_source, lw_sources%sfc_source_Jac) + !$omp target data map(alloc: lw_sources%lay_source, lw_sources%lev_source) & + !$omp map(alloc: lw_sources%sfc_source, lw_sources%sfc_source_Jac) call stop_on_err(k_dist%gas_optics(p_lay, p_lev, & t_lay, t_sfc, & gas_concs, & diff --git a/examples/rfmip-clear-sky/rrtmgp_rfmip_lw.F90 b/examples/rfmip-clear-sky/rrtmgp_rfmip_lw.F90 index 2a6e3d6c8..607e372ef 100644 --- a/examples/rfmip-clear-sky/rrtmgp_rfmip_lw.F90 +++ b/examples/rfmip-clear-sky/rrtmgp_rfmip_lw.F90 @@ -219,8 +219,8 @@ program rrtmgp_rfmip_lw !$omp target enter data map(alloc:sfc_emis_spec) !$acc enter data create(optical_props, optical_props%tau) !$omp target enter data map(alloc:optical_props%tau) - !$acc enter data create(source, source%lay_source, source%lev_source_inc, source%lev_source_dec, source%sfc_source) - !$omp target enter data map(alloc:source%lay_source, source%lev_source_inc, source%lev_source_dec, source%sfc_source) + !$acc enter data create(source, source%lay_source, source%lev_source, source%sfc_source) + !$omp target enter data map(alloc:source%lay_source, source%lev_source, source%sfc_source) ! -------------------------------------------------- ! ! Loop over blocks @@ -265,8 +265,8 @@ program rrtmgp_rfmip_lw !$omp target exit data map(release:sfc_emis_spec) !$acc exit data delete(optical_props%tau, optical_props) !$omp target exit data map(release:optical_props%tau) - !$acc exit data delete(source%lay_source, source%lev_source_inc, source%lev_source_dec, source%sfc_source) - !$omp target exit data map(release:source%lay_source, source%lev_source_inc, source%lev_source_dec, source%sfc_source) + !$acc exit data delete(source%lay_source, source%lev_source, source%sfc_source) + !$omp target exit data map(release:source%lay_source, source%lev_source, source%sfc_source) !$acc exit data delete(source) ! --------------------------------------------------m call unblock_and_write(trim(flxup_file), 'rlu', flux_up) diff --git a/rrtmgp-frontend/mo_gas_optics_rrtmgp.F90 b/rrtmgp-frontend/mo_gas_optics_rrtmgp.F90 index 7af8ae543..7583fe579 100644 --- a/rrtmgp-frontend/mo_gas_optics_rrtmgp.F90 +++ b/rrtmgp-frontend/mo_gas_optics_rrtmgp.F90 @@ -890,9 +890,9 @@ function source(this, & !------------------------------------------------------------------- ! Compute internal (Planck) source functions at layers and levels, ! which depend on mapping from spectral space that creates k-distribution. - !$acc data copyin(sources) copyout( sources%lay_source, sources%lev_source_inc, sources%lev_source_dec) & + !$acc data copyin(sources) copyout( sources%lay_source, sources%lev_source) & !$acc copyout( sources%sfc_source, sources%sfc_source_Jac) - !$omp target data map(from:sources%lay_source, sources%lev_source_inc, sources%lev_source_dec) & + !$omp target data map(from:sources%lay_source, sources%lev_source) & !$omp map(from:sources%sfc_source, sources%sfc_source_Jac) !$acc kernels copyout(top_at_1) @@ -907,7 +907,7 @@ function source(this, & fmajor, jeta, tropo, jtemp, jpress, & this%get_gpoint_bands(), this%get_band_lims_gpoint(), this%planck_frac, this%temp_ref_min,& this%totplnk_delta, this%totplnk, this%gpoint_flavor, & - sources%sfc_source, sources%lay_source, sources%lev_source_inc, sources%lev_source_dec, & + sources%sfc_source, sources%lay_source, sources%lev_source, & sources%sfc_source_Jac) !$acc end data !$omp end target data diff --git a/rrtmgp-kernels/accel/mo_gas_optics_rrtmgp_kernels.F90 b/rrtmgp-kernels/accel/mo_gas_optics_rrtmgp_kernels.F90 index 91ca01900..44ed0a08c 100644 --- a/rrtmgp-kernels/accel/mo_gas_optics_rrtmgp_kernels.F90 +++ b/rrtmgp-kernels/accel/mo_gas_optics_rrtmgp_kernels.F90 @@ -573,7 +573,7 @@ subroutine compute_Planck_source( & fmajor, jeta, tropo, jtemp, jpress, & gpoint_bands, band_lims_gpt, & pfracin, temp_ref_min, totplnk_delta, totplnk, gpoint_flavor, & - sfc_src, lay_src, lev_src_inc, lev_src_dec, sfc_source_Jac) bind(C, name="rrtmgp_compute_Planck_source") + sfc_src, lay_src, lev_src, sfc_source_Jac) bind(C, name="rrtmgp_compute_Planck_source") integer, intent(in) :: ncol, nlay, nbnd, ngpt integer, intent(in) :: nflav, neta, npres, ntemp, nPlanckTemp real(wp), dimension(ncol,nlay ), intent(in) :: tlay @@ -593,10 +593,10 @@ subroutine compute_Planck_source( & real(wp), dimension(nPlanckTemp,nbnd), intent(in) :: totplnk integer, dimension(2,ngpt), intent(in) :: gpoint_flavor - real(wp), dimension(ncol, ngpt), intent(out) :: sfc_src - real(wp), dimension(ncol,nlay,ngpt), intent(out) :: lay_src - real(wp), dimension(ncol,nlay,ngpt), intent(out) :: lev_src_inc, lev_src_dec - real(wp), dimension(ncol, ngpt), intent(out) :: sfc_source_Jac + real(wp), dimension(ncol, ngpt), intent(out) :: sfc_src + real(wp), dimension(ncol,nlay, ngpt), intent(out) :: lay_src + real(wp), dimension(ncol,nlay+1,ngpt), intent(out) :: lev_src + real(wp), dimension(ncol, ngpt), intent(out) :: sfc_source_Jac ! ----------------- ! local real(wp), parameter :: delta_Tsurf = 1.0_wp @@ -604,14 +604,14 @@ subroutine compute_Planck_source( & integer :: ilay, icol, igpt, ibnd, itropo, iflav integer :: gptS, gptE real(wp), dimension(2), parameter :: one = [1._wp, 1._wp] - real(wp) :: pfrac + real(wp) :: pfrac, pfrac_m1 ! Planck fraction in this layer and the one below real(wp) :: planck_function_1, planck_function_2 ! ----------------- !$acc data copyin( tlay,tlev,tsfc,fmajor,jeta,tropo,jtemp,jpress,gpoint_bands,pfracin,totplnk,gpoint_flavor) & - !$acc copyout( sfc_src,lay_src,lev_src_inc,lev_src_dec,sfc_source_Jac) + !$acc copyout( sfc_src,lay_src,lev_src,sfc_source_Jac) !$omp target data map( to:tlay,tlev,tsfc,fmajor,jeta,tropo,jtemp,jpress,gpoint_bands,pfracin,totplnk,gpoint_flavor) & - !$omp map(from: sfc_src,lay_src,lev_src_inc,lev_src_dec,sfc_source_Jac) + !$omp map(from: sfc_src,lay_src,lev_src,sfc_source_Jac) ! Calculation of fraction of band's Planck irradiance associated with each g-point !$acc parallel loop tile(128,2) @@ -625,19 +625,29 @@ subroutine compute_Planck_source( & ! itropo = 1 lower atmosphere; itropo = 2 upper atmosphere itropo = merge(1,2,tropo(icol,ilay)) !WS moved itropo inside loop for GPU iflav = gpoint_flavor(itropo, igpt) !eta interpolation depends on band's flavor + ! interpolation in temperature, pressure, and eta pfrac = & - ! interpolation in temperature, pressure, and eta interpolate3D(one, fmajor(:,:,:,icol,ilay,iflav), pfracin, & igpt, jeta(:,icol,ilay,iflav), jtemp(icol,ilay),jpress(icol,ilay)+itropo) + ! Compute layer source irradiance for g-point, equals band irradiance x fraction for g-point planck_function_1 = interpolate1D(tlay(icol,ilay), temp_ref_min, totplnk_delta, totplnk(:,ibnd)) - lay_src(icol,ilay,igpt) = pfrac * planck_function_1 - ! Compute layer source irradiance for g-point, equals band irradiance x fraction for g-point - planck_function_1 = interpolate1D(tlev(icol,ilay), temp_ref_min, totplnk_delta, totplnk(:,ibnd)) - planck_function_2 = interpolate1D(tlev(icol,ilay+1), temp_ref_min, totplnk_delta, totplnk(:,ibnd)) - lev_src_dec(icol,ilay,igpt) = pfrac * planck_function_1 - lev_src_inc(icol,ilay,igpt) = pfrac * planck_function_2 + lay_src (icol,ilay,igpt) = pfrac * planck_function_1 + ! Compute layer source irradiance for g-point, equals band irradiance x fraction for g-point + planck_function_1 = interpolate1D(tlev(icol,ilay), temp_ref_min, totplnk_delta, totplnk(:,ibnd)) + if (ilay == 1) then + lev_src(icol,ilay, igpt) = pfrac * planck_function_1 + else if (ilay == nlay) then + lev_src(icol,ilay, igpt) = pfrac * planck_function_1 + planck_function_2 = interpolate1D(tlev(icol,nlay+1), temp_ref_min, totplnk_delta, totplnk(:,ibnd)) + lev_src(icol,nlay+1,igpt) = pfrac * planck_function_2 + else + pfrac_m1 = & + interpolate3D(one, fmajor(:,:,:,icol,ilay-1,iflav), pfracin, & + igpt, jeta(:,icol,ilay-1,iflav), jtemp(icol,ilay-1),jpress(icol,ilay-1)+itropo) + lev_src(icol,ilay, igpt) = sqrt(pfrac * pfrac_m1) * planck_function_1 + end if if (ilay == sfc_lay) then planck_function_1 = interpolate1D(tsfc(icol) , temp_ref_min, totplnk_delta, totplnk(:,ibnd)) planck_function_2 = interpolate1D(tsfc(icol) + delta_Tsurf, temp_ref_min, totplnk_delta, totplnk(:,ibnd)) @@ -645,10 +655,8 @@ subroutine compute_Planck_source( & sfc_source_Jac(icol,igpt) = pfrac * (planck_function_2 - planck_function_1) end if end do ! igpt - end do ! icol end do ! ilay - !$acc end data !$omp end target data end subroutine compute_Planck_source diff --git a/rrtmgp-kernels/mo_gas_optics_rrtmgp_kernels.F90 b/rrtmgp-kernels/mo_gas_optics_rrtmgp_kernels.F90 index e9adff780..7a050fb84 100644 --- a/rrtmgp-kernels/mo_gas_optics_rrtmgp_kernels.F90 +++ b/rrtmgp-kernels/mo_gas_optics_rrtmgp_kernels.F90 @@ -571,7 +571,7 @@ subroutine compute_Planck_source( & fmajor, jeta, tropo, jtemp, jpress, & gpoint_bands, band_lims_gpt, & pfracin, temp_ref_min, totplnk_delta, totplnk, gpoint_flavor, & - sfc_src, lay_src, lev_src_inc, lev_src_dec, sfc_source_Jac) bind(C, name="rrtmgp_compute_Planck_source") + sfc_src, lay_src, lev_src, sfc_source_Jac) bind(C, name="rrtmgp_compute_Planck_source") integer, intent(in) :: ncol, nlay, nbnd, ngpt !! input dimensions integer, intent(in) :: nflav, neta, npres, ntemp, nPlanckTemp @@ -597,11 +597,10 @@ subroutine compute_Planck_source( & real(wp), dimension(nPlanckTemp,nbnd), intent(in) :: totplnk !! Total Planck function by band at each temperature integer, dimension(2,ngpt), intent(in) :: gpoint_flavor !! major gas flavor (pair) by upper/lower, g-point - real(wp), dimension(ncol, ngpt), intent(out) :: sfc_src !! Planck emssion from the surface - real(wp), dimension(ncol,nlay,ngpt), intent(out) :: lay_src !! Planck emssion from layer centers - real(wp), dimension(ncol,nlay,ngpt), intent(out) :: lev_src_inc, lev_src_dec - !! Planck emission at layer boundaries, using spectral mapping in the direction of propagation - real(wp), dimension(ncol, ngpt), intent(out) :: sfc_source_Jac + real(wp), dimension(ncol, ngpt), intent(out) :: sfc_src !! Planck emission from the surface + real(wp), dimension(ncol,nlay, ngpt), intent(out) :: lay_src !! Planck emission from layer centers + real(wp), dimension(ncol,nlay+1,ngpt), intent(out) :: lev_src !! Planck emission from layer boundaries + real(wp), dimension(ncol, ngpt), intent(out) :: sfc_source_Jac !! Jacobian (derivative) of the surface Planck source with respect to surface temperature ! ----------------- ! local @@ -675,11 +674,13 @@ subroutine compute_Planck_source( & end do end do - ! compute level source irradiances for each g-point, one each for upward and downward paths + ! compute level source irradiances for each g-point + do icol = 1, ncol + planck_function (icol, 1,1:nbnd) = interpolate1D(tlev(icol, 1),temp_ref_min, totplnk_delta, totplnk) + end do do ilay = 1, nlay do icol = 1, ncol - planck_function(icol, 1,1:nbnd) = interpolate1D(tlev(icol, 1),temp_ref_min, totplnk_delta, totplnk) - planck_function(icol,ilay+1,1:nbnd) = interpolate1D(tlev(icol,ilay+1),temp_ref_min, totplnk_delta, totplnk) + planck_function(icol,ilay+1,1:nbnd) = interpolate1D(tlev(icol,ilay+1),temp_ref_min, totplnk_delta, totplnk) end do end do @@ -690,12 +691,19 @@ subroutine compute_Planck_source( & gptS = band_lims_gpt(1, ibnd) gptE = band_lims_gpt(2, ibnd) do igpt = gptS, gptE - do ilay = 1, nlay + do icol = 1, ncol + lev_src(icol, 1,igpt) = pfrac(icol, 1,igpt) * planck_function(icol, 1,ibnd) + end do + do ilay = 2, nlay do icol = 1, ncol - lev_src_inc(icol,ilay,igpt) = pfrac(icol,ilay,igpt) *planck_function(icol,ilay+1,ibnd) - lev_src_dec(icol,ilay,igpt) = pfrac(icol,ilay,igpt) *planck_function(icol,ilay ,ibnd) + lev_src(icol,ilay,igpt) = sqrt(pfrac(icol,ilay-1, igpt) * & + pfrac(icol,ilay, igpt)) & + * planck_function(icol,ilay, ibnd) end do end do + do icol = 1, ncol + lev_src(icol,nlay+1,igpt) = pfrac(icol,nlay,igpt) * planck_function(icol,nlay+1,ibnd) + end do end do end do diff --git a/rte-frontend/mo_rte_lw.F90 b/rte-frontend/mo_rte_lw.F90 index 2ff0f9382..c36c55f8c 100644 --- a/rte-frontend/mo_rte_lw.F90 +++ b/rte-frontend/mo_rte_lw.F90 @@ -353,8 +353,8 @@ function rte_lw(optical_props, top_at_1, & logical(top_at_1, wl), n_quad_angs, & secants, gauss_wts(1:n_quad_angs,n_quad_angs), & optical_props%tau, & - sources%lay_source, sources%lev_source_inc, & - sources%lev_source_dec, & + sources%lay_source, & + sources%lev_source, & sfc_emis_gpt, sources%sfc_source, & inc_flux_diffuse, & gpt_flux_up, gpt_flux_dn, & @@ -371,8 +371,8 @@ function rte_lw(optical_props, top_at_1, & ! two-stream calculation with scattering ! call lw_solver_2stream(ncol, nlay, ngpt, logical(top_at_1, wl), & - optical_props%tau, optical_props%ssa, optical_props%g, & - sources%lay_source, sources%lev_source_inc, sources%lev_source_dec, & + optical_props%tau, optical_props%ssa, optical_props%g, & + sources%lay_source, sources%lev_source, & sfc_emis_gpt, sources%sfc_source, & inc_flux_diffuse, & gpt_flux_up, gpt_flux_dn) @@ -396,8 +396,8 @@ function rte_lw(optical_props, top_at_1, & logical(top_at_1, wl), n_quad_angs, & secants, gauss_wts(1:n_quad_angs,n_quad_angs), & optical_props%tau, & - sources%lay_source, sources%lev_source_inc, & - sources%lev_source_dec, & + sources%lay_source, & + sources%lev_source, & sfc_emis_gpt, sources%sfc_source, & inc_flux_diffuse, & gpt_flux_up, gpt_flux_dn, & diff --git a/rte-frontend/mo_source_functions.F90 b/rte-frontend/mo_source_functions.F90 index d242a9e83..7df75257b 100644 --- a/rte-frontend/mo_source_functions.F90 +++ b/rte-frontend/mo_source_functions.F90 @@ -30,10 +30,8 @@ module mo_source_functions type, extends(ty_optical_props), public :: ty_source_func_lw real(wp), allocatable, dimension(:,:,:) :: lay_source !! Planck source at layer average temperature (ncol, nlay, ngpt) - real(wp), allocatable, dimension(:,:,:) :: lev_source_inc - !! Planck source at layer edge in increasing ilay direction (ncol, nlay+1, ngpt) - real(wp), allocatable, dimension(:,:,:) :: lev_source_dec - !! Planck source at layer edge in decreasing ilay direction (ncol, nlay+1, ngpt) + real(wp), allocatable, dimension(:,:,:) :: lev_source + !! Planck source at layer edge (ncol, nlay+1, ngpt) real(wp), allocatable, dimension(:,: ) :: sfc_source !! Planck function at surface temperature real(wp), allocatable, dimension(:,: ) :: sfc_source_Jac @@ -102,13 +100,11 @@ function alloc_lw(this, ncol, nlay) result(err_message) if(allocated(this%sfc_source)) deallocate(this%sfc_source) if(allocated(this%sfc_source_Jac)) deallocate(this%sfc_source_Jac) if(allocated(this%lay_source)) deallocate(this%lay_source) - if(allocated(this%lev_source_inc)) deallocate(this%lev_source_inc) - if(allocated(this%lev_source_dec)) deallocate(this%lev_source_dec) + if(allocated(this%lev_source)) deallocate(this%lev_source) ngpt = this%get_ngpt() - allocate(this%sfc_source (ncol, ngpt), this%lay_source (ncol,nlay,ngpt), & - this%lev_source_inc(ncol,nlay,ngpt), this%lev_source_dec(ncol,nlay,ngpt)) - allocate(this%sfc_source_Jac(ncol, ngpt)) + allocate(this%sfc_source (ncol, ngpt), this%lay_source (ncol,nlay,ngpt), & + this%lev_source (ncol,nlay+1,ngpt), this%sfc_source_Jac(ncol, ngpt)) end function alloc_lw ! -------------------------------------------------------------- function copy_and_alloc_lw(this, ncol, nlay, spectral_desc) result(err_message) @@ -181,8 +177,7 @@ subroutine finalize_lw(this) class(ty_source_func_lw), intent(inout) :: this if(allocated(this%lay_source )) deallocate(this%lay_source) - if(allocated(this%lev_source_inc)) deallocate(this%lev_source_inc) - if(allocated(this%lev_source_dec)) deallocate(this%lev_source_dec) + if(allocated(this%lev_source )) deallocate(this%lev_source) if(allocated(this%sfc_source )) deallocate(this%sfc_source) if(allocated(this%sfc_source_Jac)) deallocate(this%sfc_source_Jac) call this%ty_optical_props%finalize() @@ -260,8 +255,7 @@ function get_subset_range_lw(full, start, n, subset) result(err_message) subset%sfc_source (1:n, :) = full%sfc_source (start:start+n-1, :) subset%sfc_source_Jac(1:n, :) = full%sfc_source_Jac(start:start+n-1, :) subset%lay_source (1:n,:,:) = full%lay_source (start:start+n-1,:,:) - subset%lev_source_inc(1:n,:,:) = full%lev_source_inc(start:start+n-1,:,:) - subset%lev_source_dec(1:n,:,:) = full%lev_source_dec(start:start+n-1,:,:) + subset%lev_source (1:n,:,:) = full%lev_source (start:start+n-1,:,:) end function get_subset_range_lw ! ------------------------------------------------------------------------------------------ function get_subset_range_sw(full, start, n, subset) result(err_message) diff --git a/rte-kernels/accel/mo_rte_solver_kernels.F90 b/rte-kernels/accel/mo_rte_solver_kernels.F90 index b193964d8..ba1175957 100644 --- a/rte-kernels/accel/mo_rte_solver_kernels.F90 +++ b/rte-kernels/accel/mo_rte_solver_kernels.F90 @@ -52,8 +52,8 @@ module mo_rte_solver_kernels ! using user-supplied weights ! ! --------------------------------------------------------------- - subroutine lw_solver_noscat_oneangle(ncol, nlay, ngpt, top_at_1, D, weight, & - tau, lay_source, lev_source_inc, lev_source_dec, sfc_emis, sfc_src, & + subroutine lw_solver_noscat_oneangle(ncol, nlay, ngpt, top_at_1, D, weight, & + tau, lay_source, lev_source, sfc_emis, sfc_src, & incident_flux, & flux_up, flux_dn, & do_broadband, broadband_up, broadband_dn, & @@ -68,8 +68,8 @@ subroutine lw_solver_noscat_oneangle(ncol, nlay, ngpt, top_at_1, D, weight, ! Planck source at layer edge for radiation in increasing/decreasing ilay direction ! lev_source_dec applies the mapping in layer i to the Planck function at layer i ! lev_source_inc applies the mapping in layer i to the Planck function at layer i+1 - real(wp), dimension(ncol,nlay, ngpt), target, & - intent(in ) :: lev_source_inc, lev_source_dec + real(wp), dimension(ncol,nlay+1,ngpt), target, & + intent(in ) :: lev_source real(wp), dimension(ncol, ngpt), intent(in ) :: sfc_emis ! Surface emissivity [] real(wp), dimension(ncol, ngpt), intent(in ) :: sfc_src ! Surface source function [W/m2] real(wp), dimension(ncol, ngpt), intent(in ) :: incident_flux! Boundary condition for flux [W/m2] @@ -95,8 +95,6 @@ subroutine lw_solver_noscat_oneangle(ncol, nlay, ngpt, top_at_1, D, weight, trans ! transmissivity = exp(-tau) real(wp), dimension(ncol,nlay,ngpt) :: source_dn, source_up - real(wp), dimension(:,:,:), pointer :: lev_source_up, lev_source_dn ! Mapping increasing/decreasing indicies to up/down - real(wp), parameter :: pi = acos(-1._wp) ! @@ -111,25 +109,18 @@ subroutine lw_solver_noscat_oneangle(ncol, nlay, ngpt, top_at_1, D, weight, ! ------------------------------------ ! Which way is up? ! Level Planck sources for upward and downward radiation - ! When top_at_1, lev_source_up => lev_source_dec - ! lev_source_dn => lev_source_inc, and vice-versa - if(top_at_1) then top_level = 1 sfc_level = nlay+1 - lev_source_up => lev_source_dec - lev_source_dn => lev_source_inc else top_level = nlay+1 sfc_level = 1 - lev_source_up => lev_source_inc - lev_source_dn => lev_source_dec end if !$acc data create( tau_loc,trans,source_dn,source_up ) & - !$acc copyin( D, tau,lev_source_up,lev_source_dn) + !$acc copyin( D, tau, lev_source) !$omp target data map(alloc:tau_loc,trans,source_dn,source_up ) & - !$omp map(to: D, tau,lev_source_up,lev_source_dn) + !$omp map(to: D, tau, lev_source) !$acc enter data create( flux_dn,flux_up) !$omp target enter data map(alloc:flux_dn,flux_up) @@ -182,10 +173,11 @@ subroutine lw_solver_noscat_oneangle(ncol, nlay, ngpt, top_at_1, D, weight, tau_loc(icol,ilay,igpt) = tau(icol,ilay,igpt)*D(icol,igpt) trans (icol,ilay,igpt) = exp(-tau_loc(icol,ilay,igpt)) end if - call lw_source_noscat(lay_source (icol,ilay,igpt), & - lev_source_up(icol,ilay,igpt), lev_source_dn(icol,ilay,igpt), & - tau_loc (icol,ilay,igpt), trans (icol,ilay,igpt), & - source_dn (icol,ilay,igpt), source_up (icol,ilay,igpt)) + call lw_source_noscat(top_at_1, & + lay_source(icol,ilay,igpt), lev_source(icol,ilay,igpt), & + lev_source(icol,ilay+1,igpt), & + tau_loc (icol,ilay,igpt), trans (icol,ilay,igpt), & + source_dn (icol,ilay,igpt), source_up (icol,ilay,igpt)) end do end do end do @@ -264,7 +256,7 @@ end subroutine lw_solver_noscat_oneangle subroutine lw_solver_noscat(ncol, nlay, ngpt, top_at_1, & nmus, Ds, weights, & tau, & - lay_source, lev_source_inc, lev_source_dec, & + lay_source, lev_source, & sfc_emis, sfc_src, & inc_flux, & flux_up, flux_dn, & @@ -273,20 +265,16 @@ subroutine lw_solver_noscat(ncol, nlay, ngpt, top_at_1, & do_rescaling, ssa, g) bind(C, name="rte_lw_solver_noscat") integer, intent(in ) :: ncol, nlay, ngpt ! Number of columns, layers, g-points logical(wl), intent(in ) :: top_at_1 - integer, intent(in ) :: nmus ! number of quadrature angles + integer, intent(in ) :: nmus ! number of quadrature angles real(wp), dimension (ncol, ngpt, & nmus), intent(in ) :: Ds - real(wp), dimension(nmus), intent(in ) :: weights ! quadrature secants, weights - real(wp), dimension(ncol,nlay, ngpt), intent(in ) :: tau ! Absorption optical thickness [] - real(wp), dimension(ncol,nlay, ngpt), intent(in ) :: lay_source ! Planck source at layer average temperature [W/m2] - real(wp), dimension(ncol,nlay, ngpt), intent(in ) :: lev_source_inc - ! Planck source at layer edge for radiation in increasing ilay direction [W/m2] - ! Includes spectral weighting that accounts for state-dependent frequency to g-space mapping - real(wp), dimension(ncol,nlay, ngpt), intent(in ) :: lev_source_dec - ! Planck source at layer edge for radiation in decreasing ilay direction [W/m2] - real(wp), dimension(ncol, ngpt), intent(in ) :: sfc_emis ! Surface emissivity [] - real(wp), dimension(ncol, ngpt), intent(in ) :: sfc_src ! Surface source function [W/m2] - real(wp), dimension(ncol, ngpt), intent(in ) :: inc_flux ! Incident diffuse flux, probably 0 [W/m2] + real(wp), dimension(nmus), intent(in ) :: weights ! quadrature secants, weights + real(wp), dimension(ncol,nlay, ngpt), intent(in ) :: tau ! Absorption optical thickness [] + real(wp), dimension(ncol,nlay, ngpt), intent(in ) :: lay_source ! Planck source at layer average temperature [W/m2] + real(wp), dimension(ncol,nlay+1,ngpt), intent(in ) :: lev_source ! Planck source at layer edge [W/m2] + real(wp), dimension(ncol, ngpt), intent(in ) :: sfc_emis ! Surface emissivity [] + real(wp), dimension(ncol, ngpt), intent(in ) :: sfc_src ! Surface source function [W/m2] + real(wp), dimension(ncol, ngpt), intent(in ) :: inc_flux ! Incident diffuse flux, probably 0 [W/m2] real(wp), dimension(ncol,nlay+1,ngpt), target, & intent( out) :: flux_up, flux_dn ! Fluxes [W/m2] ! @@ -313,8 +301,8 @@ subroutine lw_solver_noscat(ncol, nlay, ngpt, top_at_1, & integer :: icol, ilev, igpt, imu ! ------------------------------------ - !$acc data copyin(Ds, tau, lay_source, lev_source_inc, lev_source_dec, sfc_emis, sfc_src) - !$omp target data map(to:Ds, tau, lay_source, lev_source_inc, lev_source_dec, sfc_emis, sfc_src) + !$acc data copyin(Ds, tau, lay_source, lev_source, sfc_emis, sfc_src) + !$omp target data map(to:Ds, tau, lay_source, lev_source, sfc_emis, sfc_src) !$acc data copyout( flux_up, flux_dn) if (.not. do_broadband) !$omp target data map(from:flux_up, flux_dn) if (.not. do_broadband) !$acc data copyout( broadband_up, broadband_dn) if ( do_broadband) @@ -337,7 +325,7 @@ subroutine lw_solver_noscat(ncol, nlay, ngpt, top_at_1, & !$omp target data map(alloc:this_broadband_up, this_broadband_dn, this_flux_up, this_flux_dn) call lw_solver_noscat_oneangle(ncol, nlay, ngpt, & top_at_1, Ds(:,:,1), weights(1), tau, & - lay_source, lev_source_inc, lev_source_dec, sfc_emis, sfc_src, & + lay_source, lev_source, sfc_emis, sfc_src, & inc_flux, & this_flux_up, this_flux_dn, & do_broadband, this_broadband_up, this_broadband_dn, & @@ -371,7 +359,7 @@ subroutine lw_solver_noscat(ncol, nlay, ngpt, top_at_1, & do imu = 2, nmus call lw_solver_noscat_oneangle(ncol, nlay, ngpt, & top_at_1, Ds(:,:,imu), weights(imu), tau, & - lay_source, lev_source_inc, lev_source_dec, sfc_emis, sfc_src, & + lay_source, lev_source, sfc_emis, sfc_src, & inc_flux, & this_flux_up, this_flux_dn, & do_broadband, this_broadband_up, this_broadband_dn, & @@ -423,7 +411,7 @@ end subroutine lw_solver_noscat ! ------------------------------------------------------------------------------------------------- subroutine lw_solver_2stream (ncol, nlay, ngpt, top_at_1, & tau, ssa, g, & - lay_source, lev_source_inc, lev_source_dec, sfc_emis, sfc_src, & + lay_source, lev_source, sfc_emis, sfc_src, & inc_flux, & flux_up, flux_dn) bind(C, name="rte_lw_solver_2stream") integer, intent(in ) :: ncol, nlay, ngpt ! Number of columns, layers, g-points @@ -431,11 +419,8 @@ subroutine lw_solver_2stream (ncol, nlay, ngpt, top_at_1, & real(wp), dimension(ncol,nlay, ngpt), intent(in ) :: tau, & ! Optical thickness, ssa, & ! single-scattering albedo, g ! asymmetry parameter [] - real(wp), dimension(ncol,nlay,ngpt), intent(in ) :: lay_source ! Planck source at layer average temperature [W/m2] - real(wp), dimension(ncol,nlay,ngpt), target, & - intent(in ) :: lev_source_inc, lev_source_dec - ! Planck source at layer edge for radiation in increasing/decreasing ilay direction [W/m2] - ! Includes spectral weighting that accounts for state-dependent frequency to g-space mapping + real(wp), dimension(ncol,nlay, ngpt), intent(in ) :: lay_source ! Planck source at layer average temperature [W/m2] + real(wp), dimension(ncol,nlay+1,ngpt), intent(in ) :: lev_source ! Planck source at layer edge [W/m2] real(wp), dimension(ncol, ngpt), intent(in ) :: sfc_emis ! Surface emissivity [] real(wp), dimension(ncol, ngpt), intent(in ) :: sfc_src ! Surface source function [W/m2] real(wp), dimension(ncol, ngpt), intent(in ) :: inc_flux ! Incident diffuse flux, probably 0 [W/m2] @@ -444,24 +429,20 @@ subroutine lw_solver_2stream (ncol, nlay, ngpt, top_at_1, & integer :: icol, igpt, top_level real(wp), dimension(ncol,nlay ,ngpt) :: Rdif, Tdif, gamma1, gamma2 real(wp), dimension(ncol ,ngpt) :: sfc_albedo - real(wp), dimension(ncol,nlay+1,ngpt) :: lev_source real(wp), dimension(ncol,nlay ,ngpt) :: source_dn, source_up real(wp), dimension(ncol ,ngpt) :: source_sfc ! ------------------------------------ ! ------------------------------------ - !$acc enter data copyin(tau, ssa, g, lay_source, lev_source_inc, lev_source_dec, sfc_emis, sfc_src, flux_dn) - !$omp target enter data map(to:tau, ssa, g, lay_source, lev_source_inc, lev_source_dec, sfc_emis, sfc_src, flux_dn) - !$acc enter data create(flux_up, Rdif, Tdif, gamma1, gamma2, sfc_albedo, lev_source, source_dn, source_up, source_sfc) - !$omp target enter data map(alloc:flux_up, Rdif, Tdif, gamma1, gamma2, sfc_albedo, lev_source, source_dn, source_up, source_sfc) + !$acc enter data copyin(tau, ssa, g, lay_source, lev_source, sfc_emis, sfc_src, flux_dn) + !$omp target enter data map(to:tau, ssa, g, lay_source, lev_source, sfc_emis, sfc_src, flux_dn) + !$acc enter data create( flux_up, Rdif, Tdif, gamma1, gamma2, sfc_albedo, source_dn, source_up, source_sfc) + !$omp target enter data map(alloc:flux_up, Rdif, Tdif, gamma1, gamma2, sfc_albedo, source_dn, source_up, source_sfc) ! ! RRTMGP provides source functions at each level using the spectral mapping ! of each adjacent layer. Combine these for two-stream calculations ! top_level = nlay+1 if(top_at_1) top_level = 1 - call lw_combine_sources(ncol, nlay, ngpt, top_at_1, & - lev_source_inc, lev_source_dec, & - lev_source) ! ! Cell properties: reflection, transmission for diffuse radiation ! Coupling coefficients needed for source function @@ -469,7 +450,6 @@ subroutine lw_solver_2stream (ncol, nlay, ngpt, top_at_1, & call lw_two_stream(ncol, nlay, ngpt, & tau , ssa, g, & gamma1, gamma2, Rdif, Tdif) - ! ! Source function for diffuse radiation ! @@ -495,10 +475,10 @@ subroutine lw_solver_2stream (ncol, nlay, ngpt, top_at_1, & Rdif, Tdif, & source_dn, source_up, source_sfc, & flux_up, flux_dn) - !$acc exit data delete(tau, ssa, g, lay_source, lev_source_inc, lev_source_dec, sfc_emis, sfc_src) - !$omp target exit data map(release:tau, ssa, g, lay_source, lev_source_inc, lev_source_dec, sfc_emis, sfc_src) - !$acc exit data delete(Rdif, Tdif, gamma1, gamma2, sfc_albedo, lev_source, source_dn, source_up, source_sfc) - !$omp target exit data map(release:Rdif, Tdif, gamma1, gamma2, sfc_albedo, lev_source, source_dn, source_up, source_sfc) + !$acc exit data delete( tau, ssa, g, lay_source, lev_source, sfc_emis, sfc_src) + !$omp target exit data map(release:tau, ssa, g, lay_source, lev_source, sfc_emis, sfc_src) + !$acc exit data delete( Rdif, Tdif, gamma1, gamma2, sfc_albedo, source_dn, source_up, source_sfc) + !$omp target exit data map(release:Rdif, Tdif, gamma1, gamma2, sfc_albedo, source_dn, source_up, source_sfc) !$acc exit data copyout(flux_up, flux_dn) !$omp target exit data map(from:flux_up, flux_dn) end subroutine lw_solver_2stream @@ -714,28 +694,28 @@ end subroutine sw_solver_2stream ! This routine implements point-wise stencil, and has to be called in a loop ! ! --------------------------------------------------------------- - subroutine lw_source_noscat(lay_source, lev_source_up, lev_source_dn, tau, trans, & + subroutine lw_source_noscat(top_at_1, lay_source, lev_source, levp1_source, tau, trans, & source_dn, source_up) !$acc routine seq !$omp declare target ! - real(wp), intent(in) :: lay_source, & ! Planck source at layer center - lev_source_up, & ! Planck source at levels (layer edges), - lev_source_dn, & ! increasing/decreasing layer index - tau, & ! Optical path (tau/mu) - trans ! Transmissivity (exp(-tau)) + logical(wl), intent(in) :: top_at_1 + real(wp), intent(in) :: lay_source, & ! Planck source at layer center + lev_source, & ! Planck source at levels (layer edges), + levp1_source, & ! Planck source at level +1 (layer edges), + tau, & ! Optical path (tau/mu) + trans ! Transmissivity (exp(-tau)) real(wp), intent(inout):: source_dn, source_up ! Source function at layer edges ! Down at the bottom of the layer, up at the top ! -------------------------------- real(wp), parameter :: tau_thresh = sqrt(sqrt(epsilon(tau))) - real(wp) :: fact + real(wp) :: fact, source_inc, source_dec ! --------------------------------------------------------------- ! - ! Weighting factor. Use 2nd order series expansion when rounding error (~tau^2) + ! Weighting factor. Use 3rd order series expansion when rounding error (~tau^2) ! is of order epsilon (smallest difference from 1. in working precision) - ! Thanks to Peter Blossey - ! Updated to 3rd order series and lower threshold based on suggestion from Dmitry Alexeev (Nvidia) + ! Thanks to Peter Blossey (UW) for the idea and Dmitry Alexeev (Nvidia) for suggesting 3rd order ! if(tau > tau_thresh) then fact = (1._wp - trans)/tau - trans @@ -745,11 +725,15 @@ subroutine lw_source_noscat(lay_source, lev_source_up, lev_source_dn, tau, trans ! ! Equation below is developed in Clough et al., 1992, doi:10.1029/92JD01419, Eq 13 ! - source_dn = (1._wp - trans) * lev_source_dn + & - 2._wp * fact * (lay_source - lev_source_dn) - source_up = (1._wp - trans) * lev_source_up + & - 2._wp * fact * (lay_source - lev_source_up) - + source_inc = (1._wp - trans) * levp1_source + 2._wp * fact * (lay_source - levp1_source) + source_dec = (1._wp - trans) * lev_source + 2._wp * fact * (lay_source - lev_source) + if (top_at_1) then + source_dn = source_inc + source_up = source_dec + else + source_up = source_inc + source_dn = source_dec + end if end subroutine lw_source_noscat ! --------------------------------------------------------------- ! @@ -930,50 +914,6 @@ subroutine lw_two_stream(ncol, nlay, ngpt, tau, w0, g, & !$acc exit data copyout(gamma1, gamma2, Rdif, Tdif) !$omp target exit data map(from:gamma1, gamma2, Rdif, Tdif) end subroutine lw_two_stream - ! ------------------------------------------------------------------------------------------------- - ! - ! Source function combination - ! RRTMGP provides two source functions at each level - ! using the spectral mapping from each of the adjascent layers. - ! Need to combine these for use in two-stream calculation. - ! - ! ------------------------------------------------------------------------------------------------- - subroutine lw_combine_sources(ncol, nlay, ngpt, top_at_1, & - lev_src_inc, lev_src_dec, lev_source) - integer, intent(in ) :: ncol, nlay, ngpt - logical(wl), intent(in ) :: top_at_1 - real(wp), dimension(ncol, nlay , ngpt), intent(in ) :: lev_src_inc, lev_src_dec - real(wp), dimension(ncol, nlay+1, ngpt), intent(out) :: lev_source - - integer :: icol, ilay, igpt - ! --------------------------------------------------------------- - ! --------------------------------- - !$acc enter data copyin(lev_src_inc, lev_src_dec) - !$omp target enter data map(to:lev_src_inc, lev_src_dec) - !$acc enter data create(lev_source) - !$omp target enter data map(alloc:lev_source) - - !$acc parallel loop collapse(3) - !$omp target teams distribute parallel do simd collapse(3) - do igpt = 1, ngpt - do ilay = 1, nlay+1 - do icol = 1,ncol - if(ilay == 1) then - lev_source(icol, ilay, igpt) = lev_src_dec(icol, ilay, igpt) - else if (ilay == nlay+1) then - lev_source(icol, ilay, igpt) = lev_src_inc(icol, ilay-1, igpt) - else - lev_source(icol, ilay, igpt) = sqrt(lev_src_dec(icol, ilay, igpt) * & - lev_src_inc(icol, ilay-1, igpt)) - end if - end do - end do - end do - !$acc exit data delete (lev_src_inc, lev_src_dec) - !$omp target exit data map(release:lev_src_inc, lev_src_dec) - !$acc exit data copyout(lev_source) - !$omp target exit data map(from:lev_source) - end subroutine lw_combine_sources ! --------------------------------------------------------------- ! ! Compute LW source function for upward and downward emission at levels using linear-in-tau assumption diff --git a/rte-kernels/mo_rte_solver_kernels.F90 b/rte-kernels/mo_rte_solver_kernels.F90 index 0dc8c98e2..f3308cc5e 100644 --- a/rte-kernels/mo_rte_solver_kernels.F90 +++ b/rte-kernels/mo_rte_solver_kernels.F90 @@ -48,12 +48,12 @@ module mo_rte_solver_kernels !> using user-supplied weights ! ! --------------------------------------------------------------- - subroutine lw_solver_noscat_oneangle(ncol, nlay, ngpt, top_at_1, D, weight, & - tau, lay_source, lev_source_inc, lev_source_dec, sfc_emis, sfc_src, & + subroutine lw_solver_noscat_oneangle(ncol, nlay, ngpt, top_at_1, D, weight, & + tau, lay_source, lev_source, sfc_emis, sfc_src, & incident_flux, & flux_up, flux_dn, & do_broadband, broadband_up, broadband_dn, & - do_Jacobians, sfc_srcJac, flux_upJac, & + do_Jacobians, sfc_srcJac, flux_upJac, & do_rescaling, ssa, g) integer, intent(in ) :: ncol, nlay, ngpt ! Number of columns, layers, g-points logical(wl), intent(in ) :: top_at_1 @@ -61,11 +61,7 @@ subroutine lw_solver_noscat_oneangle(ncol, nlay, ngpt, top_at_1, D, weight, real(wp), intent(in ) :: weight ! quadrature weight real(wp), dimension(ncol,nlay, ngpt), intent(in ) :: tau ! Absorption optical thickness [] real(wp), dimension(ncol,nlay, ngpt), intent(in ) :: lay_source ! Planck source at layer average temperature [W/m2] - ! Planck source at layer edge for radiation in increasing/decreasing ilay direction - ! lev_source_dec applies the mapping in layer i to the Planck function at layer i - ! lev_source_inc applies the mapping in layer i to the Planck function at layer i+1 - real(wp), dimension(ncol,nlay, ngpt), target, & - intent(in ) :: lev_source_inc, lev_source_dec + real(wp), dimension(ncol,nlay+1,ngpt), intent(in ) :: lev_source ! Planck source at layer edge [W/m2] real(wp), dimension(ncol, ngpt), intent(in ) :: sfc_emis ! Surface emissivity [] real(wp), dimension(ncol, ngpt), intent(in ) :: sfc_src ! Surface source function [W/m2] real(wp), dimension(ncol, ngpt), intent(in ) :: incident_flux! Boundary condition for flux [W/m2] @@ -91,8 +87,6 @@ subroutine lw_solver_noscat_oneangle(ncol, nlay, ngpt, top_at_1, D, weight, real(wp), dimension(ncol,nlay) :: source_dn, source_up real(wp), dimension(ncol ) :: sfc_albedo - real(wp), dimension(:,:,:), pointer :: lev_source_up, lev_source_dn ! Mapping increasing/decreasing indicies to up/down - real(wp), parameter :: pi = acos(-1._wp) ! loc_fluxes hold a single g-point flux if fluxes are being integrated instead of returned ! with spectral detail @@ -117,19 +111,12 @@ subroutine lw_solver_noscat_oneangle(ncol, nlay, ngpt, top_at_1, D, weight, real(wp), dimension(ncol,nlay+1) :: gpt_flux_Jac ! ------------------------------------ ! Which way is up? - ! Level Planck sources for upward and downward radiation - ! When top_at_1, lev_source_up => lev_source_dec - ! lev_source_dn => lev_source_inc, and vice-versa if(top_at_1) then top_level = 1 sfc_level = nlay+1 - lev_source_up => lev_source_dec - lev_source_dn => lev_source_inc else top_level = nlay+1 sfc_level = 1 - lev_source_up => lev_source_inc - lev_source_dn => lev_source_dec end if ! @@ -198,8 +185,8 @@ subroutine lw_solver_noscat_oneangle(ncol, nlay, ngpt, top_at_1, D, weight, ! ! Source function for diffuse radiation ! - call lw_source_noscat(ncol, nlay, & - lay_source(:,:,igpt), lev_source_up(:,:,igpt), lev_source_dn(:,:,igpt), & + call lw_source_noscat(ncol, nlay, top_at_1, & + lay_source(:,:,igpt), lev_source(:,:,igpt), & tau_loc, trans, source_dn, source_up) ! ! Transport down @@ -261,7 +248,7 @@ end subroutine lw_solver_noscat_oneangle subroutine lw_solver_noscat(ncol, nlay, ngpt, top_at_1, & nmus, Ds, weights, & tau, & - lay_source, lev_source_inc, lev_source_dec, & + lay_source, lev_source, & sfc_emis, sfc_src, & inc_flux, & flux_up, flux_dn, & @@ -283,10 +270,8 @@ subroutine lw_solver_noscat(ncol, nlay, ngpt, top_at_1, & !! Absorption optical thickness [] real(wp), dimension(ncol,nlay, ngpt), intent(in ) :: lay_source !! Planck source at layer average temperature [W/m2] - real(wp), dimension(ncol,nlay, ngpt), intent(in ) :: lev_source_inc - !! Planck source at layer edge for radiation in increasing ilay direction [W/m2] - real(wp), dimension(ncol,nlay, ngpt), intent(in ) :: lev_source_dec - !! Planck source at layer edge for radiation in decreasing ilay direction [W/m2] + real(wp), dimension(ncol,nlay+1,ngpt), intent(in ) :: lev_source + !! Planck source at layer edge for radiation[W/m2] real(wp), dimension(ncol, ngpt), intent(in ) :: sfc_emis !! Surface emissivity [] real(wp), dimension(ncol, ngpt), intent(in ) :: sfc_src @@ -327,8 +312,8 @@ subroutine lw_solver_noscat(ncol, nlay, ngpt, top_at_1, & ! For the first angle output arrays store total flux ! call lw_solver_noscat_oneangle(ncol, nlay, ngpt, & - top_at_1, Ds(:,:,1), weights(1), tau, & - lay_source, lev_source_inc, lev_source_dec, sfc_emis, sfc_src, & + top_at_1, Ds(:,:,1), weights(1), tau, & + lay_source, lev_source, sfc_emis, sfc_src, & inc_flux, & flux_up, flux_dn, & do_broadband, broadband_up, broadband_dn, & @@ -358,7 +343,7 @@ subroutine lw_solver_noscat(ncol, nlay, ngpt, top_at_1, & do imu = 2, nmus call lw_solver_noscat_oneangle(ncol, nlay, ngpt, & top_at_1, Ds(:,:,imu), weights(imu), tau, & - lay_source, lev_source_inc, lev_source_dec, sfc_emis, sfc_src, & + lay_source, lev_source, sfc_emis, sfc_src, & inc_flux, & this_flux_up, this_flux_dn, & do_broadband, this_broadband_up, this_broadband_dn, & @@ -391,7 +376,7 @@ end subroutine lw_solver_noscat ! ------------------------------------------------------------------------------------------------- subroutine lw_solver_2stream (ncol, nlay, ngpt, top_at_1, & tau, ssa, g, & - lay_source, lev_source_inc, lev_source_dec, sfc_emis, sfc_src, & + lay_source, lev_source, sfc_emis, sfc_src, & inc_flux, & flux_up, flux_dn) bind(C, name="rte_lw_solver_2stream") integer, intent(in ) :: ncol, nlay, ngpt @@ -402,10 +387,8 @@ subroutine lw_solver_2stream (ncol, nlay, ngpt, top_at_1, & !! Optical thickness, single-scattering albedo, asymmetry parameter [] real(wp), dimension(ncol,nlay, ngpt), intent(in ) :: lay_source !! Planck source at layer average temperature [W/m2] - real(wp), dimension(ncol,nlay, ngpt), intent(in ) :: lev_source_inc - !! Planck source at layer edge for radiation in increasing ilay direction [W/m2] - real(wp), dimension(ncol,nlay, ngpt), intent(in ) :: lev_source_dec - !! Planck source at layer edge for radiation in decreasing ilay direction [W/m2] + real(wp), dimension(ncol,nlay+1,ngpt), intent(in ) :: lev_source + !! Planck source at layer edge temperature [W/m2] real(wp), dimension(ncol, ngpt), intent(in ) :: sfc_emis !! Surface emissivity [] real(wp), dimension(ncol, ngpt), intent(in ) :: sfc_src @@ -418,7 +401,6 @@ subroutine lw_solver_2stream (ncol, nlay, ngpt, top_at_1, & integer :: igpt, top_level real(wp), dimension(ncol,nlay ) :: Rdif, Tdif, gamma1, gamma2 real(wp), dimension(ncol ) :: sfc_albedo - real(wp), dimension(ncol,nlay+1) :: lev_source real(wp), dimension(ncol,nlay ) :: source_dn, source_up real(wp), dimension(ncol ) :: source_sfc ! ------------------------------------ @@ -426,13 +408,6 @@ subroutine lw_solver_2stream (ncol, nlay, ngpt, top_at_1, & if(top_at_1) top_level = 1 do igpt = 1, ngpt ! - ! RRTMGP provides source functions at each level using the spectral mapping - ! of each adjacent layer. Combine these for two-stream calculations - ! - call lw_combine_sources(ncol, nlay, top_at_1, & - lev_source_inc(:,:,igpt), lev_source_dec(:,:,igpt), & - lev_source) - ! ! Cell properties: reflection, transmission for diffuse radiation ! Coupling coefficients needed for source function ! @@ -642,29 +617,37 @@ end subroutine sw_solver_2stream ! See Clough et al., 1992, doi: 10.1029/92JD01419, Eq 13 ! ! --------------------------------------------------------------- - subroutine lw_source_noscat(ncol, nlay, lay_source, lev_source_up, lev_source_dn, tau, trans, & + subroutine lw_source_noscat(ncol, nlay, top_at_1, lay_source, lev_source, tau, trans, & source_dn, source_up) - integer, intent(in) :: ncol, nlay - real(wp), dimension(ncol, nlay), intent(in) :: lay_source, & ! Planck source at layer center - lev_source_up, & ! Planck source at levels (layer edges), - lev_source_dn, & ! increasing/decreasing layer index - tau, & ! Optical path (tau/mu) - trans ! Transmissivity (exp(-tau)) - real(wp), dimension(ncol, nlay), intent(out):: source_dn, source_up + integer, intent(in) :: ncol, nlay + logical(wl), intent(in) :: top_at_1 + real(wp), dimension(ncol, nlay ), intent(in) :: lay_source, & ! Planck source at layer center + tau, & ! Optical path (tau/mu) + trans ! Transmissivity (exp(-tau)) + real(wp), dimension(ncol, nlay+1), intent(in) :: lev_source ! Planck source at levels (layer edges) + real(wp), dimension(ncol, nlay ), target, & + intent(out):: source_dn, source_up ! Source function at layer edges ! Down at the bottom of the layer, up at the top ! -------------------------------- + real(wp), dimension(:,:), pointer :: source_inc, source_dec integer :: icol, ilay real(wp) :: fact real(wp), parameter :: tau_thresh = sqrt(sqrt(epsilon(tau))) ! --------------------------------------------------------------- + if (top_at_1) then + source_inc => source_dn + source_dec => source_up + else + source_inc => source_up + source_dec => source_dn + end if do ilay = 1, nlay do icol = 1, ncol ! - ! Weighting factor. Use 2nd order series expansion when rounding error (~tau^2) + ! Weighting factor. Use 3rd order series expansion when rounding error (~tau^2) ! is of order epsilon (smallest difference from 1. in working precision) - ! Thanks to Peter Blossey - ! Updated to 3rd order series and lower threshold based on suggestion from Dmitry Alexeev (Nvidia) + ! Thanks to Peter Blossey (UW) for the idea and Dmitry Alexeev (Nvidia) for suggesting 3rd order ! if(tau(icol, ilay) > tau_thresh) then fact = (1._wp - trans(icol,ilay))/tau(icol,ilay) - trans(icol,ilay) @@ -674,11 +657,20 @@ subroutine lw_source_noscat(ncol, nlay, lay_source, lev_source_up, lev_source_dn ! ! Equation below is developed in Clough et al., 1992, doi:10.1029/92JD01419, Eq 13 ! - source_dn(icol,ilay) = (1._wp - trans(icol,ilay)) * lev_source_dn(icol,ilay) + & - 2._wp * fact * (lay_source(icol,ilay) - lev_source_dn(icol,ilay)) - source_up(icol,ilay) = (1._wp - trans(icol,ilay)) * lev_source_up(icol,ilay ) + & - 2._wp * fact * (lay_source(icol,ilay) - lev_source_up(icol,ilay)) - end do + source_inc(icol,ilay) = (1._wp - trans(icol,ilay)) * lev_source(icol,ilay+1) + & + 2._wp * fact * (lay_source(icol,ilay) - lev_source(icol,ilay+1)) + source_dec(icol,ilay) = (1._wp - trans(icol,ilay)) * lev_source(icol,ilay ) + & + 2._wp * fact * (lay_source(icol,ilay) - lev_source(icol,ilay )) + ! + ! Even better - omit the layer Planck source (not working so well) + ! + if(.false.) then + source_inc(icol,ilay) = (1._wp - trans(icol,ilay)) * lev_source(icol,ilay+1) + & + fact * (lev_source(icol,ilay ) - lev_source(icol,ilay+1)) + source_dec(icol,ilay) = (1._wp - trans(icol,ilay)) * lev_source(icol,ilay ) + & + fact * (lev_source(icol,ilay+1) - lev_source(icol,ilay )) + end if + end do end do end subroutine lw_source_noscat ! ------------------------------------------------------------------------------------------------- @@ -915,39 +907,6 @@ pure subroutine lw_two_stream(ncol, nlay, tau, w0, g, & end do end subroutine lw_two_stream - ! ------------------------------------------------------------------------------------------------- - ! - ! Source function combination - ! RRTMGP provides two source functions at each level - ! using the spectral mapping from each of the adjascent layers. - ! Need to combine these for use in two-stream calculation. - ! - ! ------------------------------------------------------------------------------------------------- - subroutine lw_combine_sources(ncol, nlay, top_at_1, & - lev_src_inc, lev_src_dec, lev_source) - integer, intent(in ) :: ncol, nlay - logical(wl), intent(in ) :: top_at_1 - real(wp), dimension(ncol, nlay ), intent(in ) :: lev_src_inc, lev_src_dec - real(wp), dimension(ncol, nlay+1), intent(out) :: lev_source - - integer :: icol, ilay - ! --------------------------------------------------------------- - ilay = 1 - do icol = 1,ncol - lev_source(icol, ilay) = lev_src_dec(icol, ilay) - end do - do ilay = 2, nlay - do icol = 1,ncol - lev_source(icol, ilay) = sqrt(lev_src_dec(icol, ilay) * & - lev_src_inc(icol, ilay-1)) - end do - end do - ilay = nlay+1 - do icol = 1,ncol - lev_source(icol, ilay) = lev_src_inc(icol, ilay-1) - end do - - end subroutine lw_combine_sources ! --------------------------------------------------------------- ! ! Compute LW source function for upward and downward emission at levels using linear-in-tau assumption From 6616f4f797af5b719f5be933313e0591d40e4932 Mon Sep 17 00:00:00 2001 From: "dependabot[bot]" <49699333+dependabot[bot]@users.noreply.github.com> Date: Thu, 14 Dec 2023 21:10:14 +0000 Subject: [PATCH 09/57] Bump actions/upload-artifact from 3 to 4 Bumps [actions/upload-artifact](https://github.com/actions/upload-artifact) from 3 to 4. - [Release notes](https://github.com/actions/upload-artifact/releases) - [Commits](https://github.com/actions/upload-artifact/compare/v3...v4) --- updated-dependencies: - dependency-name: actions/upload-artifact dependency-type: direct:production update-type: version-update:semver-major ... Signed-off-by: dependabot[bot] --- .github/workflows/containerized-ci.yml | 2 +- .github/workflows/doc-deployment.yml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/containerized-ci.yml b/.github/workflows/containerized-ci.yml index ba5382a57..e4167a473 100644 --- a/.github/workflows/containerized-ci.yml +++ b/.github/workflows/containerized-ci.yml @@ -110,7 +110,7 @@ jobs: # - name: Upload validation plots if: matrix.fortran-compiler == 'ifort' && matrix.rte-kernels == 'default' && matrix.fpmodel == 'DP' - uses: actions/upload-artifact@v3 + uses: actions/upload-artifact@v4 with: name: valdiation-plot path: tests/validation-figures.pdf diff --git a/.github/workflows/doc-deployment.yml b/.github/workflows/doc-deployment.yml index 1d67ab9e8..2ee1de23b 100644 --- a/.github/workflows/doc-deployment.yml +++ b/.github/workflows/doc-deployment.yml @@ -51,7 +51,7 @@ jobs: # Upload documentation # - name: Upload Documentation - uses: actions/upload-artifact@v3 + uses: actions/upload-artifact@v4 with: name: documentation path: public/ From 5ac4d0a8e9fe4e8a2769634f92e3d4e4c35f4e98 Mon Sep 17 00:00:00 2001 From: Robert Pincus Date: Mon, 18 Dec 2023 11:28:21 -0500 Subject: [PATCH 10/57] Temperature and source function refinements (#253) Remove a workaround for PGI Fortran 19 and `present` status; interpolate level temperatures on device. --- rrtmgp-frontend/mo_gas_optics_rrtmgp.F90 | 65 +++++++++++------------- 1 file changed, 31 insertions(+), 34 deletions(-) diff --git a/rrtmgp-frontend/mo_gas_optics_rrtmgp.F90 b/rrtmgp-frontend/mo_gas_optics_rrtmgp.F90 index 7583fe579..fcf414455 100644 --- a/rrtmgp-frontend/mo_gas_optics_rrtmgp.F90 +++ b/rrtmgp-frontend/mo_gas_optics_rrtmgp.F90 @@ -304,30 +304,21 @@ function gas_optics_int(this, & ! ! Interpolate source function - ! - if(present(tlev)) then - ! - ! present status of optional argument should be passed to source() - ! but isn't with PGI 19.10 - ! - error_msg = source(this, & - ncol, nlay, nband, ngpt, & - play, plev, tlay, tsfc, & - jtemp, jpress, jeta, tropo, fmajor, & - sources, & - tlev) - !$acc exit data delete(tlev) + ! present status of optional argument is passed to source() + ! + error_msg = source(this, & + ncol, nlay, nband, ngpt, & + play, plev, tlay, tsfc, & + jtemp, jpress, jeta, tropo, fmajor, & + sources, & + tlev) + if(present(tlev)) then + !$acc exit data delete(tlev) !$omp target exit data map(release:tlev) - else - error_msg = source(this, & - ncol, nlay, nband, ngpt, & - play, plev, tlay, tsfc, & - jtemp, jpress, jeta, tropo, fmajor, & - sources) - end if - !$acc exit data delete(tsfc) + end if + !$acc exit data delete(tsfc) !$omp target exit data map(release:tsfc) - !$acc exit data delete(jtemp, jpress, tropo, fmajor, jeta) + !$acc exit data delete(jtemp, jpress, tropo, fmajor, jeta) !$omp target exit data map(release:jtemp, jpress, tropo, fmajor, jeta) end function gas_optics_int !------------------------------------------------------------------------------------------ @@ -858,7 +849,15 @@ function source(this, & error_msg = "" ! ! Source function needs temperature at interfaces/levels and at layer centers + ! Allocate small local array for tlev unconditionally ! + !$acc data copyin(sources) copyout( sources%lay_source, sources%lev_source) & + !$acc copyout( sources%sfc_source, sources%sfc_source_Jac) & + !$acc create(tlev_arr) + !$omp target data map(from:sources%lay_source, sources%lev_source) & + !$omp map(from:sources%sfc_source, sources%sfc_source_Jac) & + !$omp map(alloc:tlev_arr) + if (present(tlev)) then ! Users might have provided these tlev_wk => tlev @@ -868,32 +867,30 @@ function source(this, & ! Interpolate temperature to levels if not provided ! Interpolation and extrapolation at boundaries is weighted by pressure ! + !$acc parallel loop gang vector + !$omp target teams distribute parallel do simd do icol = 1, ncol - tlev_arr(icol,1) = tlay(icol,1) & + tlev_arr(icol,1) = tlay(icol,1) & + (plev(icol,1)-play(icol,1))*(tlay(icol,2)-tlay(icol,1)) & - & / (play(icol,2)-play(icol,1)) + / (play(icol,2)-play(icol,1)) + tlev_arr(icol,nlay+1) = tlay(icol,nlay) & + + (plev(icol,nlay+1)-play(icol,nlay))*(tlay(icol,nlay)-tlay(icol,nlay-1)) & + / (play(icol,nlay)-play(icol,nlay-1)) end do - do ilay = 2, nlay + !$acc parallel loop gang vector collapse(2) + !$omp target teams distribute parallel do simd collapse(2) + do ilay = 2, nlay do icol = 1, ncol tlev_arr(icol,ilay) = (play(icol,ilay-1)*tlay(icol,ilay-1)*(plev(icol,ilay )-play(icol,ilay)) & + play(icol,ilay )*tlay(icol,ilay )*(play(icol,ilay-1)-plev(icol,ilay))) / & (plev(icol,ilay)*(play(icol,ilay-1) - play(icol,ilay))) end do end do - do icol = 1, ncol - tlev_arr(icol,nlay+1) = tlay(icol,nlay) & - + (plev(icol,nlay+1)-play(icol,nlay))*(tlay(icol,nlay)-tlay(icol,nlay-1)) & - / (play(icol,nlay)-play(icol,nlay-1)) - end do end if !------------------------------------------------------------------- ! Compute internal (Planck) source functions at layers and levels, ! which depend on mapping from spectral space that creates k-distribution. - !$acc data copyin(sources) copyout( sources%lay_source, sources%lev_source) & - !$acc copyout( sources%sfc_source, sources%sfc_source_Jac) - !$omp target data map(from:sources%lay_source, sources%lev_source) & - !$omp map(from:sources%sfc_source, sources%sfc_source_Jac) !$acc kernels copyout(top_at_1) !$omp target map(from:top_at_1) From 5c55f2c0bdaee8b2c6f0cc53ebfd6cc97d8feadc Mon Sep 17 00:00:00 2001 From: "dependabot[bot]" <49699333+dependabot[bot]@users.noreply.github.com> Date: Wed, 17 Jan 2024 15:30:13 -0500 Subject: [PATCH 11/57] Bump actions/cache from 3 to 4 (#254) Bumps [actions/cache](https://github.com/actions/cache) from 3 to 4. - [Release notes](https://github.com/actions/cache/releases) - [Changelog](https://github.com/actions/cache/blob/main/RELEASES.md) - [Commits](https://github.com/actions/cache/compare/v3...v4) --- updated-dependencies: - dependency-name: actions/cache dependency-type: direct:production update-type: version-update:semver-major ... Signed-off-by: dependabot[bot] Co-authored-by: dependabot[bot] <49699333+dependabot[bot]@users.noreply.github.com> --- .github/workflows/continuous-integration.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/continuous-integration.yml b/.github/workflows/continuous-integration.yml index 31d6f7328..3e19910a2 100644 --- a/.github/workflows/continuous-integration.yml +++ b/.github/workflows/continuous-integration.yml @@ -64,7 +64,7 @@ jobs: # Cache Conda packages # - name: Cache Conda packages - uses: actions/cache@v3 + uses: actions/cache@v4 with: path: ~/conda_pkgs_dir key: conda-pkgs From 44e4352d295c285214ca640e35f00193d3eddeff Mon Sep 17 00:00:00 2001 From: Sergey Kosukhin Date: Wed, 24 Jan 2024 18:23:05 +0100 Subject: [PATCH 12/57] Run CI jobs on Levante via GitLab (#255) Add CI jobs that run the tests on the GPU partition of Levante. The compiler version and flags are what we currently use to build ICON by default. For security reasons, the jobs are skipped for PRs from the forks. --- .github/workflows/gitlab-ci.yml | 89 +++++++++++++++++++++++++++++++++ .gitlab/levante.yml | 73 +++++++++++++++++++++++++++ 2 files changed, 162 insertions(+) create mode 100644 .github/workflows/gitlab-ci.yml create mode 100644 .gitlab/levante.yml diff --git a/.github/workflows/gitlab-ci.yml b/.github/workflows/gitlab-ci.yml new file mode 100644 index 000000000..0567d97b5 --- /dev/null +++ b/.github/workflows/gitlab-ci.yml @@ -0,0 +1,89 @@ +name: GitLab CI +on: + push: + branches-ignore: + - documentation + pull_request: + branches-ignore: + - documentation + +defaults: + run: + shell: bash + +jobs: + # + # Deferred GitLab pipelines on Levante at DKRZ (see .gitlab/levante.yml): + # + levante-init: + if: | + github.repository_owner == 'earth-system-radiation' && + ( github.event_name != 'pull_request' || + github.event.pull_request.head.repo.owner.login == github.repository_owner ) + runs-on: ubuntu-latest + outputs: + ref-name: ${{ steps.g-push-rev.outputs.ref-name }} + pipeline-id: ${{ steps.gl-trigger-pipeline.outputs.pipeline-id }} + steps: + # + # Check out GitHub repository + # + - name: Check out GitHub repository + uses: actions/checkout@v3 + with: + fetch-depth: 0 + # + # Push to GitLab repository + # + - name: Push to GitLab repository + id: g-push-rev + uses: "skosukhin/git-ci-hub-lab/g-push-rev@v1" + with: + remote-url: ${{ vars.DKRZ_GITLAB_SERVER }}/${{ vars.DKRZ_GITLAB_PROJECT }}.git + password: ${{ secrets.DKRZ_GITLAB_TOKEN }} + ref-type: tag + ref-message: ${{ github.server_url }}/${{ github.repository }}/actions/runs/${{ github.run_id }} + force-push: true + # + # Trigger GitLab CI/CD Pipeline + # + - name: Trigger GitLab CI/CD Pipeline + id: gl-trigger-pipeline + uses: "skosukhin/git-ci-hub-lab/gl-trigger-pipeline@v1" + with: + server-url: ${{ vars.DKRZ_GITLAB_SERVER }} + project-name: ${{ vars.DKRZ_GITLAB_PROJECT }} + token: ${{ secrets.DKRZ_GITLAB_TRIGGER_TOKEN }} + ref-name: ${{ steps.g-push-rev.outputs.ref-name }} + expected-sha: ${{ github.sha }} + levante: + runs-on: ubuntu-latest + needs: levante-init + strategy: + fail-fast: false + matrix: + config-name: [nvhpc-gpu-openacc-DP, nvhpc-gpu-openacc-SP] + steps: + # + # Build, run and check (fetch the log) + # + - name: Build, run and check (fetch the log) + uses: "skosukhin/git-ci-hub-lab/gl-attach-job@v1" + with: + server-url: ${{ vars.DKRZ_GITLAB_SERVER }} + project-name: ${{ vars.DKRZ_GITLAB_PROJECT }} + token: ${{ secrets.DKRZ_GITLAB_TOKEN }} + pipeline-id: ${{ needs.levante-init.outputs.pipeline-id }} + job-name: ${{ matrix.config-name }} + levante-cleanup: + runs-on: ubuntu-latest + needs: [levante-init, levante] + if: always() && needs.levante-init.result != 'skipped' + continue-on-error: true + steps: + - uses: "skosukhin/git-ci-hub-lab/g-delete-ref@v1" + with: + remote-url: ${{ vars.DKRZ_GITLAB_SERVER }}/${{ vars.DKRZ_GITLAB_PROJECT }}.git + password: ${{ secrets.DKRZ_GITLAB_TOKEN }} + ref-type: tag + ref-name: ${{ needs.levante-init.outputs.ref-name }} diff --git a/.gitlab/levante.yml b/.gitlab/levante.yml new file mode 100644 index 000000000..93d01fa87 --- /dev/null +++ b/.gitlab/levante.yml @@ -0,0 +1,73 @@ +workflow: + rules: + - if: $CI_PIPELINE_SOURCE == "trigger" + +include: + - project: 'anw_dienste/ci-templates' + file: '.slurm-ci.yml' + +variables: + SCHEDULER_PARAMETERS: >- + --account=mh0287 + --partition=gpu + --gpus=1 + --time=05:00 + +.build-common: + extends: .default + variables: + # Core variables: + FC: /sw/spack-levante/nvhpc-22.5-v4oky3/Linux_x86_64/22.5/compilers/bin/nvfortran + # Production flags for ICON model: + FCFLAGS: -g -O2 -Mrecursive -Mallocatable=03 -Mstack_arrays -Minfo=accel,inline -acc=gpu,verystrict -gpu=cc80,cuda11.7 -DRTE_USE_${FPMODEL} + # Convenience variables: + NFHOME: /sw/spack-levante/netcdf-fortran-4.5.4-syv4qr + NCHOME: /sw/spack-levante/netcdf-c-4.9.0-gc7kgj + PYHOME: /sw/spack-levante/mambaforge-22.9.0-2-Linux-x86_64-kptncg + # Suppress an irrelevant but annoying error message: + PROJ_LIB: ${PYHOME}/share/proj + # Make variables: + FCINCLUDE: -I${NFHOME}/include + LDFLAGS: -L${NFHOME}/lib -L${NCHOME}/lib + RRTMGP_ROOT: ${CI_PROJECT_DIR} + RRTMGP_DATA: ${CI_PROJECT_DIR}/rrtmgp-data + RTE_KERNELS: accel + before_script: + - module purge + - module load git + # Extend the existing environment variables: + - export PATH="${PYHOME}/bin:${PATH}" + - export LD_LIBRARY_PATH="${NFHOME}/lib:${NCHOME}/lib:${LD_LIBRARY_PATH-}" + # The -Mstack_arrays compiler flag requires a large stack: + - ulimit -s unlimited + script: + # + # Build libraries, examples and tests + # + - ${FC} --version + - make libs + - make -C build separate-libs + # + # Check out data + # + - git clone --depth 1 https://github.com/earth-system-radiation/rrtmgp-data.git "${RRTMGP_DATA}" + # + # Run examples and tests + # + - make tests + # + # Compare the results + # + - make check + +nvhpc-gpu-openacc-DP: + extends: .build-common + variables: + FPMODEL: DP + FAILURE_THRESHOLD: "5.8e-2" + +nvhpc-gpu-openacc-SP: + extends: .build-common + variables: + FPMODEL: SP + FAILURE_THRESHOLD: "3.5e-1" From 592c30a072b977f032d32e828188f4213ed64c5c Mon Sep 17 00:00:00 2001 From: Sergey Kosukhin Date: Fri, 26 Jan 2024 15:14:05 +0100 Subject: [PATCH 13/57] Extend Levante CI with NAG (#259) This adds CI tests with the NAG compiler on Levante with compiler version and flags currently used to build ICON by default. Both DP and SP floating models are tested, as are default and accelerator kernels, but not all possible combinations. Accelerator kernels fail with a run-time error and are marked as experimental. --- .github/workflows/gitlab-ci.yml | 19 +++++- .gitlab/levante.yml | 113 +++++++++++++++++++++++++++----- 2 files changed, 113 insertions(+), 19 deletions(-) diff --git a/.github/workflows/gitlab-ci.yml b/.github/workflows/gitlab-ci.yml index 0567d97b5..941e85796 100644 --- a/.github/workflows/gitlab-ci.yml +++ b/.github/workflows/gitlab-ci.yml @@ -29,7 +29,7 @@ jobs: # Check out GitHub repository # - name: Check out GitHub repository - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: fetch-depth: 0 # @@ -59,10 +59,24 @@ jobs: levante: runs-on: ubuntu-latest needs: levante-init + continue-on-error: ${{ matrix.experimental }} strategy: fail-fast: false matrix: - config-name: [nvhpc-gpu-openacc-DP, nvhpc-gpu-openacc-SP] + config-name: + - nvhpc-gpu-openacc-DP + - nvhpc-gpu-openacc-SP + #- nag-cpu-default-DP + - nag-cpu-default-SP + - nag-cpu-accel-DP + #- nag-cpu-accel-SP + include: + # The tests are not experimental by default: + - experimental: false + - config-name: nag-cpu-accel-DP + experimental: true + #- config-name: nag-cpu-accel-SP + # experimental: true steps: # # Build, run and check (fetch the log) @@ -87,3 +101,4 @@ jobs: password: ${{ secrets.DKRZ_GITLAB_TOKEN }} ref-type: tag ref-name: ${{ needs.levante-init.outputs.ref-name }} + force: true diff --git a/.gitlab/levante.yml b/.gitlab/levante.yml index 93d01fa87..8104acd52 100644 --- a/.gitlab/levante.yml +++ b/.gitlab/levante.yml @@ -9,42 +9,74 @@ include: variables: SCHEDULER_PARAMETERS: >- --account=mh0287 - --partition=gpu - --gpus=1 --time=05:00 + ${EXTRA_SCHEDULER_PARAMETERS} + EXTRA_SCHEDULER_PARAMETERS: -.build-common: +.gpu: extends: .default + variables: + EXTRA_SCHEDULER_PARAMETERS: >- + --partition=gpu + --gpus=1 + +.cpu: + extends: .default + variables: + EXTRA_SCHEDULER_PARAMETERS: >- + --partition=shared + +.nvhpc: variables: # Core variables: FC: /sw/spack-levante/nvhpc-22.5-v4oky3/Linux_x86_64/22.5/compilers/bin/nvfortran - # Production flags for ICON model: - FCFLAGS: -g -O2 -Mrecursive -Mallocatable=03 -Mstack_arrays -Minfo=accel,inline -acc=gpu,verystrict -gpu=cc80,cuda11.7 -DRTE_USE_${FPMODEL} # Convenience variables: + VERSION_FCFLAGS: --version NFHOME: /sw/spack-levante/netcdf-fortran-4.5.4-syv4qr NCHOME: /sw/spack-levante/netcdf-c-4.9.0-gc7kgj + +.nag: + variables: + # Core variables: + FC: /sw/spack-levante/nag-7.1-lqjbej/bin/nagfor + # Convenience variables: + VERSION_FCFLAGS: -V + NFHOME: /sw/spack-levante/netcdf-fortran-4.5.3-5di6qe + NCHOME: /sw/spack-levante/netcdf-c-4.8.1-vbnli5 + +.dp: + variables: + FPMODEL: DP + FAILURE_THRESHOLD: "5.8e-2" + +.sp: + variables: + FPMODEL: SP + FAILURE_THRESHOLD: "3.5e-1" + +.common: + variables: PYHOME: /sw/spack-levante/mambaforge-22.9.0-2-Linux-x86_64-kptncg - # Suppress an irrelevant but annoying error message: + # Suppress an irrelevant but annoying error message: PROJ_LIB: ${PYHOME}/share/proj # Make variables: FCINCLUDE: -I${NFHOME}/include LDFLAGS: -L${NFHOME}/lib -L${NCHOME}/lib RRTMGP_ROOT: ${CI_PROJECT_DIR} RRTMGP_DATA: ${CI_PROJECT_DIR}/rrtmgp-data - RTE_KERNELS: accel before_script: - module purge - module load git # Extend the existing environment variables: - export PATH="${PYHOME}/bin:${PATH}" - export LD_LIBRARY_PATH="${NFHOME}/lib:${NCHOME}/lib:${LD_LIBRARY_PATH-}" - # The -Mstack_arrays compiler flag requires a large stack: + # Some tests require a large stack: - ulimit -s unlimited script: # # Build libraries, examples and tests # - - ${FC} --version + - ${FC} ${VERSION_FCFLAGS} - make libs - make -C build separate-libs # @@ -60,14 +92,61 @@ variables: # - make check -nvhpc-gpu-openacc-DP: - extends: .build-common +.nvhpc-gpu-openacc: + extends: + - .gpu + - .nvhpc + - .common variables: - FPMODEL: DP - FAILURE_THRESHOLD: "5.8e-2" + # Compiler flags used for ICON model: + FCFLAGS: -g -O2 -Mrecursive -Mallocatable=03 -Mstack_arrays -Minfo=accel,inline -acc=gpu,verystrict -gpu=cc80,cuda11.7 -DRTE_USE_${FPMODEL} + RTE_KERNELS: accel -nvhpc-gpu-openacc-SP: - extends: .build-common +.nag-cpu: + extends: + - .cpu + - .nag + - .common variables: - FPMODEL: SP - FAILURE_THRESHOLD: "3.5e-1" + # Compiler flags used for ICON model: + FCFLAGS: -Wc=/sw/spack-levante/gcc-11.2.0-bcn7mb/bin/gcc -f2008 -colour -w=uep -g -gline -O0 -float-store -nan -Wc,-g -Wc,-pipe -Wc,--param,max-vartrack-size=200000000 -Wc,-mno-fma -C=all -DRTE_USE_CBOOL -DRTE_USE_${FPMODEL} + +.nag-cpu-default: + extends: .nag-cpu + variables: + RTE_KERNELS: default + +.nag-cpu-accel: + extends: .nag-cpu + variables: + RTE_KERNELS: accel + +nvhpc-gpu-openacc-DP: + extends: + - .dp + - .nvhpc-gpu-openacc + +nvhpc-gpu-openacc-SP: + extends: + - .sp + - .nvhpc-gpu-openacc + +#nag-cpu-default-DP: +# extends: +# - .dp +# - .nag-cpu-default + +nag-cpu-default-SP: + extends: + - .sp + - .nag-cpu-default + +nag-cpu-accel-DP: + extends: + - .dp + - .nag-cpu-accel + +#nag-cpu-accel-SP: +# extends: +# - .sp +# - .nag-cpu-accel From 0a17084bf89ef061713789d875b94aede22624c3 Mon Sep 17 00:00:00 2001 From: Robert Pincus Date: Fri, 26 Jan 2024 13:21:28 -0500 Subject: [PATCH 14/57] Adjust tolerances, fix error in accelerator source function kernel (#258) Scripts fails when individual tests fail, small tolerance adjustments to tests pass, small correction to LW source calculation in accel kernels, revert change in 5ac4d0a: nvfortran fails to pass present status of args to lower-level procedures --- examples/all-sky/all_tests.sh | 1 + rrtmgp-frontend/mo_gas_optics_rrtmgp.F90 | 24 ++++++++++++------ .../accel/mo_gas_optics_rrtmgp_kernels.F90 | 14 ++++++----- tests/all_tests.sh | 1 + tests/check_equivalence.F90 | 25 ++++++++++--------- 5 files changed, 39 insertions(+), 26 deletions(-) diff --git a/examples/all-sky/all_tests.sh b/examples/all-sky/all_tests.sh index bbc272ef6..61a2bceb7 100644 --- a/examples/all-sky/all_tests.sh +++ b/examples/all-sky/all_tests.sh @@ -1,3 +1,4 @@ +set -eux ./rrtmgp_allsky 24 72 1 rrtmgp-allsky-lw.nc \ ${RRTMGP_DATA}/rrtmgp-gas-lw-g256.nc ${RRTMGP_DATA}/rrtmgp-clouds-lw.nc ${RRTMGP_DATA}/rrtmgp-aerosols-merra-lw.nc ./rrtmgp_allsky 24 72 1 rrtmgp-allsky-sw.nc \ diff --git a/rrtmgp-frontend/mo_gas_optics_rrtmgp.F90 b/rrtmgp-frontend/mo_gas_optics_rrtmgp.F90 index fcf414455..9aeb476f5 100644 --- a/rrtmgp-frontend/mo_gas_optics_rrtmgp.F90 +++ b/rrtmgp-frontend/mo_gas_optics_rrtmgp.F90 @@ -304,17 +304,25 @@ function gas_optics_int(this, & ! ! Interpolate source function - ! present status of optional argument is passed to source() - ! - error_msg = source(this, & - ncol, nlay, nband, ngpt, & - play, plev, tlay, tsfc, & - jtemp, jpress, jeta, tropo, fmajor, & - sources, & - tlev) + ! present status of optional argument should be passed to source() + ! but nvfortran (and PGI Fortran before it) do not do so + ! if(present(tlev)) then + error_msg = source(this, & + ncol, nlay, nband, ngpt, & + play, plev, tlay, tsfc, & + jtemp, jpress, jeta, tropo, fmajor, & + sources, & + tlev) !$acc exit data delete(tlev) !$omp target exit data map(release:tlev) + else + error_msg = source(this, & + ncol, nlay, nband, ngpt, & + play, plev, tlay, tsfc, & + jtemp, jpress, jeta, tropo, fmajor, & + sources) + end if !$acc exit data delete(tsfc) !$omp target exit data map(release:tsfc) diff --git a/rrtmgp-kernels/accel/mo_gas_optics_rrtmgp_kernels.F90 b/rrtmgp-kernels/accel/mo_gas_optics_rrtmgp_kernels.F90 index 44ed0a08c..103850776 100644 --- a/rrtmgp-kernels/accel/mo_gas_optics_rrtmgp_kernels.F90 +++ b/rrtmgp-kernels/accel/mo_gas_optics_rrtmgp_kernels.F90 @@ -624,7 +624,7 @@ subroutine compute_Planck_source( & ibnd = gpoint_bands(igpt) ! itropo = 1 lower atmosphere; itropo = 2 upper atmosphere itropo = merge(1,2,tropo(icol,ilay)) !WS moved itropo inside loop for GPU - iflav = gpoint_flavor(itropo, igpt) !eta interpolation depends on band's flavor + iflav = gpoint_flavor(itropo, igpt) !eta interpolation depends on band's flavor ! interpolation in temperature, pressure, and eta pfrac = & interpolate3D(one, fmajor(:,:,:,icol,ilay,iflav), pfracin, & @@ -634,20 +634,22 @@ subroutine compute_Planck_source( & planck_function_1 = interpolate1D(tlay(icol,ilay), temp_ref_min, totplnk_delta, totplnk(:,ibnd)) lay_src (icol,ilay,igpt) = pfrac * planck_function_1 - ! Compute layer source irradiance for g-point, equals band irradiance x fraction for g-point + ! Compute level source irradiance for g-point planck_function_1 = interpolate1D(tlev(icol,ilay), temp_ref_min, totplnk_delta, totplnk(:,ibnd)) if (ilay == 1) then lev_src(icol,ilay, igpt) = pfrac * planck_function_1 - else if (ilay == nlay) then - lev_src(icol,ilay, igpt) = pfrac * planck_function_1 - planck_function_2 = interpolate1D(tlev(icol,nlay+1), temp_ref_min, totplnk_delta, totplnk(:,ibnd)) - lev_src(icol,nlay+1,igpt) = pfrac * planck_function_2 else + itropo = merge(1,2,tropo(icol,ilay-1)) !WS moved itropo inside loop for GPU + iflav = gpoint_flavor(itropo, igpt) !eta interpolation depends on band's flavor pfrac_m1 = & interpolate3D(one, fmajor(:,:,:,icol,ilay-1,iflav), pfracin, & igpt, jeta(:,icol,ilay-1,iflav), jtemp(icol,ilay-1),jpress(icol,ilay-1)+itropo) lev_src(icol,ilay, igpt) = sqrt(pfrac * pfrac_m1) * planck_function_1 end if + if (ilay == nlay) then + planck_function_1 = interpolate1D(tlev(icol,nlay+1), temp_ref_min, totplnk_delta, totplnk(:,ibnd)) + lev_src(icol,nlay+1,igpt) = pfrac * planck_function_1 + end if if (ilay == sfc_lay) then planck_function_1 = interpolate1D(tsfc(icol) , temp_ref_min, totplnk_delta, totplnk(:,ibnd)) planck_function_2 = interpolate1D(tsfc(icol) + delta_Tsurf, temp_ref_min, totplnk_delta, totplnk(:,ibnd)) diff --git a/tests/all_tests.sh b/tests/all_tests.sh index dba254b6d..9af6c7021 100644 --- a/tests/all_tests.sh +++ b/tests/all_tests.sh @@ -1,3 +1,4 @@ +set -eux ./check_equivalence test_atmospheres.nc ${RRTMGP_DATA}/rrtmgp-gas-lw-g256.nc ./check_equivalence test_atmospheres.nc ${RRTMGP_DATA}/rrtmgp-gas-lw-g128.nc ./check_equivalence test_atmospheres.nc ${RRTMGP_DATA}/rrtmgp-gas-sw-g224.nc diff --git a/tests/check_equivalence.F90 b/tests/check_equivalence.F90 index 8ac814965..40270178e 100644 --- a/tests/check_equivalence.F90 +++ b/tests/check_equivalence.F90 @@ -275,8 +275,8 @@ program rte_check_equivalence ! Orientation invariance ! call lw_clear_sky_vr - if(.not. allclose(tst_flux_up, ref_flux_up) .or. & - .not. allclose(tst_flux_dn, ref_flux_dn) ) & + if(.not. allclose(tst_flux_up, ref_flux_up, tol=4._wp) .or. & + .not. allclose(tst_flux_dn, ref_flux_dn, tol=4._wp) ) & call report_err(" Vertical invariance failure") print *, " Vertical orientation invariance" ! ------------------------------------------------------- @@ -411,9 +411,9 @@ program rte_check_equivalence ! Threshold of 4x spacing() works on CPUs but 8x is needed for GPUs ! call sw_clear_sky_tsi - if(.not. allclose(tst_flux_up, ref_flux_up, tol = 8._wp) .or. & - .not. allclose(tst_flux_dn, ref_flux_dn, tol = 8._wp) .or. & - .not. allclose(tst_flux_dir,ref_flux_dir,tol = 8._wp)) & + if(.not. allclose(tst_flux_up, ref_flux_up, tol = 10._wp) .or. & + .not. allclose(tst_flux_dn, ref_flux_dn, tol = 8._wp) .or. & + .not. allclose(tst_flux_dir,ref_flux_dir,tol = 8._wp)) & call report_err(" Changing TSI fails") print *, " TSI invariance" ! ------------------------------------------------------- @@ -432,9 +432,9 @@ program rte_check_equivalence mu0, toa_flux, & sfc_alb_dir, sfc_alb_dif, & fluxes)) - if(.not. allclose(tst_flux_up, ref_flux_up, tol = 6._wp) .or. & + if(.not. allclose(tst_flux_up, ref_flux_up, tol = 8._wp) .or. & .not. allclose(tst_flux_dn, ref_flux_dn, tol = 6._wp) .or. & - .not. allclose(tst_flux_dir,ref_flux_dir,tol = 6._wp)) & + .not. allclose(tst_flux_dir,ref_flux_dir,tol = 8._wp)) & call report_err(" halving/doubling fails") call increment_with_1scl @@ -442,7 +442,7 @@ program rte_check_equivalence mu0, toa_flux, & sfc_alb_dir, sfc_alb_dif, & fluxes)) - if(.not. allclose(tst_flux_up, ref_flux_up, tol = 6._wp) .or. & + if(.not. allclose(tst_flux_up, ref_flux_up, tol = 8._wp) .or. & .not. allclose(tst_flux_dn, ref_flux_dn, tol = 6._wp) .or. & .not. allclose(tst_flux_dir,ref_flux_dir,tol = 6._wp)) & call report_err(" Incrementing with 1scl fails") @@ -453,9 +453,9 @@ program rte_check_equivalence atmos, & toa_flux)) call increment_with_2str - if(.not. allclose(tst_flux_up, ref_flux_up, tol = 6._wp) .or. & - .not. allclose(tst_flux_dn, ref_flux_dn, tol = 6._wp) .or. & - .not. allclose(tst_flux_dir,ref_flux_dir,tol = 6._wp)) & + if(.not. allclose(tst_flux_up, ref_flux_up, tol = 8._wp) .or. & + .not. allclose(tst_flux_dn, ref_flux_dn, tol = 6._wp) .or. & + .not. allclose(tst_flux_dir,ref_flux_dir,tol = 6._wp)) & call report_err(" Incrementing with 2str fails") call stop_on_err(k_dist%gas_optics(p_lay, p_lev, & @@ -468,7 +468,7 @@ program rte_check_equivalence mu0, toa_flux, & sfc_alb_dir, sfc_alb_dif, & fluxes)) - if(.not. allclose(tst_flux_up, ref_flux_up, tol = 6._wp) .or. & + if(.not. allclose(tst_flux_up, ref_flux_up, tol = 8._wp) .or. & .not. allclose(tst_flux_dn, ref_flux_dn, tol = 6._wp) .or. & .not. allclose(tst_flux_dir,ref_flux_dir,tol = 6._wp)) & call report_err(" Incrementing with nstr fails") @@ -489,6 +489,7 @@ subroutine lw_clear_sky_vr character(32), & dimension(gas_concs%get_num_gases()) & :: gc_gas_names + ! ! Reverse the orientation of the problem ! From 9dcc9ba6346887710b74ce7d2b2255c994333762 Mon Sep 17 00:00:00 2001 From: Sergey Kosukhin Date: Tue, 30 Jan 2024 19:03:41 +0100 Subject: [PATCH 15/57] Fix intent in subroutine lw_transport_noscat_up (#261) Fix subroutine intent, mark corresponding CI as not-experimental --- .github/workflows/gitlab-ci.yml | 4 ---- rte-kernels/accel/mo_rte_solver_kernels.F90 | 2 +- 2 files changed, 1 insertion(+), 5 deletions(-) diff --git a/.github/workflows/gitlab-ci.yml b/.github/workflows/gitlab-ci.yml index 941e85796..392d4ba8f 100644 --- a/.github/workflows/gitlab-ci.yml +++ b/.github/workflows/gitlab-ci.yml @@ -73,10 +73,6 @@ jobs: include: # The tests are not experimental by default: - experimental: false - - config-name: nag-cpu-accel-DP - experimental: true - #- config-name: nag-cpu-accel-SP - # experimental: true steps: # # Build, run and check (fetch the log) diff --git a/rte-kernels/accel/mo_rte_solver_kernels.F90 b/rte-kernels/accel/mo_rte_solver_kernels.F90 index ba1175957..42d234abd 100644 --- a/rte-kernels/accel/mo_rte_solver_kernels.F90 +++ b/rte-kernels/accel/mo_rte_solver_kernels.F90 @@ -790,7 +790,7 @@ subroutine lw_transport_noscat_up(ncol, nlay, ngpt, & logical(wl), intent(in ) :: top_at_1 ! real(wp), dimension(ncol,nlay ,ngpt), intent(in ) :: trans ! transmissivity = exp(-tau) real(wp), dimension(ncol,nlay ,ngpt), intent(in ) :: source_up ! Diffuse radiation emitted by the layer - real(wp), dimension(ncol,nlay+1,ngpt), intent( out) :: radn_up ! Radiances [W/m2-str] + real(wp), dimension(ncol,nlay+1,ngpt), intent(inout) :: radn_up ! Radiances [W/m2-str] logical(wl), intent(in ) :: do_Jacobians real(wp), dimension(ncol,nlay+1,ngpt), intent(inout) :: radn_upJac ! surface temperature Jacobian of Radiances [W/m2-str / K] ! Local variables From a0ed5bfcb493c20c412f6e5185e65637afdabb67 Mon Sep 17 00:00:00 2001 From: Robert Pincus Date: Fri, 9 Feb 2024 12:54:36 -0800 Subject: [PATCH 16/57] Reduce use of CI (#264) Enable manual runs of CI , don't run CI on push except for main, develop --- .github/workflows/containerized-ci.yml | 6 ++++-- .github/workflows/continuous-integration.yml | 6 ++++-- .github/workflows/gitlab-ci.yml | 6 ++++-- .github/workflows/self-hosted-ci.yml | 6 ++++-- 4 files changed, 16 insertions(+), 8 deletions(-) diff --git a/.github/workflows/containerized-ci.yml b/.github/workflows/containerized-ci.yml index e4167a473..bf48d3265 100644 --- a/.github/workflows/containerized-ci.yml +++ b/.github/workflows/containerized-ci.yml @@ -1,11 +1,13 @@ name: Continuous integration in a box on: push: - branches-ignore: - - documentation + branches: + - main + - develop pull_request: branches-ignore: - documentation + workflow_dispatch: jobs: Containerized-CI: diff --git a/.github/workflows/continuous-integration.yml b/.github/workflows/continuous-integration.yml index 3e19910a2..2c5a931bb 100644 --- a/.github/workflows/continuous-integration.yml +++ b/.github/workflows/continuous-integration.yml @@ -1,11 +1,13 @@ name: Continuous Integration on: push: - branches-ignore: - - documentation + branches: + - main + - develop pull_request: branches-ignore: - documentation + workflow_dispatch: defaults: run: diff --git a/.github/workflows/gitlab-ci.yml b/.github/workflows/gitlab-ci.yml index 392d4ba8f..fce24d1f8 100644 --- a/.github/workflows/gitlab-ci.yml +++ b/.github/workflows/gitlab-ci.yml @@ -1,11 +1,13 @@ name: GitLab CI on: push: - branches-ignore: - - documentation + branches: + - main + - develop pull_request: branches-ignore: - documentation + workflow_dispatch: defaults: run: diff --git a/.github/workflows/self-hosted-ci.yml b/.github/workflows/self-hosted-ci.yml index a5409d80a..64fc77adb 100644 --- a/.github/workflows/self-hosted-ci.yml +++ b/.github/workflows/self-hosted-ci.yml @@ -1,11 +1,13 @@ name: Self-hosted CI on: push: - branches-ignore: - - documentation + branches: + - main + - develop pull_request: branches-ignore: - documentation + workflow_dispatch: defaults: run: From ebb1b8caaa977aae5bf34334298755b9fcf5a670 Mon Sep 17 00:00:00 2001 From: Sergey Kosukhin Date: Fri, 16 Feb 2024 18:06:40 +0100 Subject: [PATCH 17/57] Run CI jobs on Lumi via GitLab (#265) --- .github/workflows/gitlab-ci.yml | 103 +++++++++++++++++++++++++ .gitlab/lumi.yml | 130 ++++++++++++++++++++++++++++++++ 2 files changed, 233 insertions(+) create mode 100644 .gitlab/lumi.yml diff --git a/.github/workflows/gitlab-ci.yml b/.github/workflows/gitlab-ci.yml index fce24d1f8..ce17ebc5c 100644 --- a/.github/workflows/gitlab-ci.yml +++ b/.github/workflows/gitlab-ci.yml @@ -100,3 +100,106 @@ jobs: ref-type: tag ref-name: ${{ needs.levante-init.outputs.ref-name }} force: true + # + # Deferred GitLab pipelines on Lumi at CSC (see .gitlab/lumi.yml): + # + lumi-init: + if: | + github.repository_owner == 'earth-system-radiation' && + ( github.event_name != 'pull_request' || + github.event.pull_request.head.repo.owner.login == github.repository_owner ) + runs-on: ubuntu-latest + outputs: + ref-name: ${{ steps.g-push-rev.outputs.ref-name }} + pipeline-id: ${{ steps.gl-create-pipeline.outputs.pipeline-id }} + steps: + # + # Check out GitHub repository + # + - name: Check out GitHub repository + uses: actions/checkout@v4 + with: + fetch-depth: 0 + # + # Push to GitLab repository + # + - name: Push to GitLab repository + id: g-push-rev + uses: "skosukhin/git-ci-hub-lab/g-push-rev@v1" + with: + remote-url: ${{ vars.GITLAB_SERVER }}/${{ vars.GITLAB_PROJECT }}.git + password: ${{ secrets.GITLAB_TOKEN }} + rev-id: ${{ github.sha }} + rev-signing-format: ssh + rev-signing-key: ${{ secrets.GITLAB_SIGNING_KEY }} + ref-type: tag + ref-message: ${{ github.server_url }}/${{ github.repository }}/actions/runs/${{ github.run_id }} + force-push: true + # + # Create GitLab CI/CD Pipeline + # + - name: Create GitLab CI/CD Pipeline + id: gl-create-pipeline + uses: "skosukhin/git-ci-hub-lab/gl-create-pipeline@v1" + with: + server-url: ${{ vars.GITLAB_SERVER }} + project-name: ${{ vars.GITLAB_PROJECT }} + token: ${{ secrets.GITLAB_TOKEN }} + ref-name: ${{ steps.g-push-rev.outputs.ref-name }} + expected-sha: ${{ steps.g-push-rev.outputs.ref-commit }} + # + # Set up Python virtual environment (fetch the log) + # + - name: Set up Python virtual environment (fetch the log) + uses: "skosukhin/git-ci-hub-lab/gl-attach-job@v1" + with: + server-url: ${{ vars.GITLAB_SERVER }} + project-name: ${{ vars.GITLAB_PROJECT }} + token: ${{ secrets.GITLAB_TOKEN }} + pipeline-id: ${{ steps.gl-create-pipeline.outputs.pipeline-id }} + job-name: setup-python + lumi: + runs-on: ubuntu-latest + needs: lumi-init + continue-on-error: ${{ matrix.experimental }} + strategy: + fail-fast: false + matrix: + config-name: + - cce-gpu-openacc-DP + - cce-gpu-openacc-SP + include: + # The tests are not experimental by default: + - experimental: false + steps: + # + # Build, run and check (fetch the log) + # + - name: Build, run and check (fetch the log) + uses: "skosukhin/git-ci-hub-lab/gl-attach-job@v1" + with: + server-url: ${{ vars.GITLAB_SERVER }} + project-name: ${{ vars.GITLAB_PROJECT }} + token: ${{ secrets.GITLAB_TOKEN }} + pipeline-id: ${{ needs.lumi-init.outputs.pipeline-id }} + job-name: ${{ matrix.config-name }} + lumi-cleanup: + runs-on: ubuntu-latest + needs: [lumi-init, lumi] + if: always() && needs.lumi-init.result != 'skipped' + continue-on-error: true + steps: + - uses: "skosukhin/git-ci-hub-lab/gl-cancel-pipeline@v1" + with: + server-url: ${{ vars.GITLAB_SERVER }} + project-name: ${{ vars.GITLAB_PROJECT }} + token: ${{ secrets.GITLAB_TOKEN }} + pipeline-id: ${{ needs.lumi-init.outputs.pipeline-id }} + - uses: "skosukhin/git-ci-hub-lab/gl-delete-ref@v1" + with: + server-url: ${{ vars.GITLAB_SERVER }} + project-name: ${{ vars.GITLAB_PROJECT }} + token: ${{ secrets.GITLAB_TOKEN }} + ref-type: tag + ref-name: ${{ needs.lumi-init.outputs.ref-name }} + force: true diff --git a/.gitlab/lumi.yml b/.gitlab/lumi.yml new file mode 100644 index 000000000..6899ac95d --- /dev/null +++ b/.gitlab/lumi.yml @@ -0,0 +1,130 @@ +workflow: + rules: + - if: $CI_PIPELINE_SOURCE == "api" + +default: + tags: + - lumi + +variables: + SCHEDULER_PARAMETERS: >- + --account=project_465000454 + --nodes=1 + --ntasks=1 + --cpus-per-task=4 + --mem-per-cpu=1G + --time=05:00 + ${EXTRA_SCHEDULER_PARAMETERS} + EXTRA_SCHEDULER_PARAMETERS: + +.gpu: + variables: + EXTRA_SCHEDULER_PARAMETERS: >- + --partition=dev-g + --gpus=1 + +.cpu: + variables: + EXTRA_SCHEDULER_PARAMETERS: >- + --partition=debug + +.cce: + variables: + # Core variables: + FC: ftn + # Convenience variables: + VERSION_FCFLAGS: -V + COMPILER_MODULES: PrgEnv-cray cce/16.0.1 craype-x86-milan + +.dp: + variables: + FPMODEL: DP + FAILURE_THRESHOLD: "5.8e-2" + +.sp: + variables: + FPMODEL: SP + FAILURE_THRESHOLD: "3.5e-1" + +# +# Set up Python virtual environment +# +.python-common: + variables: + PYHOME: ${CI_PROJECT_DIR}/python-venv + FF_USE_FASTZIP: 1 + +setup-python: + extends: + - .cpu + - .python-common + script: + - test ! -d "${PYHOME}" || exit 0 + - module load cray-python + - python -m venv ${PYHOME} + - ${PYHOME}/bin/python -m pip install --upgrade pip + - ${PYHOME}/bin/python -m pip install dask[array] netCDF4 numpy xarray + cache: + # Update the key to regenerate the virtual environment: + key: python-venv-version-1 + paths: + - ${PYHOME} + artifacts: + paths: + - ${PYHOME} + expire_in: 60 minutes + +.common: + extends: .python-common + needs: + - setup-python + variables: + # Make variables: + RRTMGP_ROOT: ${CI_PROJECT_DIR} + RRTMGP_DATA: ${CI_PROJECT_DIR}/rrtmgp-data + before_script: + - module --force purge + - module load ${COMPILER_MODULES} ${EXTRA_COMPILER_MODULES} cray-hdf5 cray-netcdf + # Extend the existing environment variables: + - export PATH="${PYHOME}/bin:${PATH}" + script: + # + # Build libraries, examples and tests + # + - ${FC} ${VERSION_FCFLAGS} + - make libs + - make -C build separate-libs + # + # Check out data + # + - git clone --depth 1 https://github.com/earth-system-radiation/rrtmgp-data.git "${RRTMGP_DATA}" + # + # Run examples and tests + # + - make tests + # + # Compare the results + # + - make check + +.cce-gpu-openacc: + extends: + - .gpu + - .cce + - .common + variables: + # Compiler flags used for ICON model: + FCFLAGS: -hacc -hadd_paren -Ktrap=divz,ovf,inv -hflex_mp=intolerant -hfp1 -g -DRTE_USE_${FPMODEL} + RTE_KERNELS: accel + # Convenience variables: + EXTRA_COMPILER_MODULES: craype-accel-amd-gfx90a rocm + +cce-gpu-openacc-DP: + extends: + - .dp + - .cce-gpu-openacc + +cce-gpu-openacc-SP: + extends: + - .dp + - .cce-gpu-openacc From 6cda8687d7ccdfc21b299db59814486870530596 Mon Sep 17 00:00:00 2001 From: Sergey Kosukhin Date: Mon, 19 Feb 2024 17:31:32 +0100 Subject: [PATCH 18/57] Align success/failure of CI with expectations (#267) CI now reports success if a) the code compiles but fails at runtime with `cce-gpu-openmp` in self-hosted CI, and b) fails with an internal compiler error for `ifx-gpu-openmp`. See the PR for more details. --- .github/workflows/containerized-ci.yml | 33 ++++++++++++++++++++------ .github/workflows/gitlab-ci.yml | 8 ------- .github/workflows/self-hosted-ci.yml | 23 ++++++++++++------ 3 files changed, 42 insertions(+), 22 deletions(-) diff --git a/.github/workflows/containerized-ci.yml b/.github/workflows/containerized-ci.yml index bf48d3265..01343d395 100644 --- a/.github/workflows/containerized-ci.yml +++ b/.github/workflows/containerized-ci.yml @@ -12,7 +12,6 @@ on: jobs: Containerized-CI: runs-on: ubuntu-22.04 - continue-on-error: ${{ matrix.experimental }} strategy: fail-fast: false matrix: @@ -20,8 +19,6 @@ jobs: rte-kernels: [default, accel] fpmodel: [DP, SP] include: - # The tests are not experimental by default: - - experimental: false # Set flags for Intel Fortran Compiler Classic - fortran-compiler: ifort fcflags: -m64 -g -traceback -heap-arrays -assume realloc_lhs -extend-source 132 -check bounds,uninit,pointers,stack -stand f08 @@ -32,7 +29,6 @@ jobs: - fortran-compiler: ifx rte-kernels: accel fcflags: -debug -traceback -O0 -heap-arrays -assume realloc_lhs -extend-source 132 -stand f08 -fiopenmp -fopenmp-targets=spir64 - experimental: true # Set flags for NVIDIA Fortran compiler - fortran-compiler: nvfortran rte-kernels: default @@ -77,28 +73,51 @@ jobs: repository: earth-system-radiation/rrtmgp-data path: rrtmgp-data # - # Build libraries, examples and tests + # Build libraries, examples and tests (expect success) # - - name: Build libraries, examples and tests + - name: Build libraries, examples and tests (expect success) + id: build-success + if: matrix.fortran-compiler != 'ifx' || matrix.rte-kernels != 'accel' run: | $FC --version make libs make -C build separate-libs # + # Build libraries, examples and tests (expect failure) + # + - name: Build libraries, examples and tests (expect failure) + if: steps.build-success.outcome == 'skipped' + shell: bash + run: | + $FC --version + make libs 2> >(tee make.err >&2) && { + echo "Unexpected success" + exit 1 + } || { + grep make.err -e 'Internal compiler error' && { + echo "Expected failure" + } || { + echo "Unexpected failure" + exit 1 + } + } + # # Run examples and tests # - name: Run examples and tests + if: steps.build-success.outcome != 'skipped' run: make tests # # Relax failure thresholds for single precision # - name: Relax failure threshold for single precision - if: matrix.fpmodel == 'SP' + if: matrix.fpmodel == 'SP' && steps.build-success.outcome != 'skipped' run: echo "FAILURE_THRESHOLD=3.5e-1" >> $GITHUB_ENV # # Compare the results # - name: Compare the results + if: steps.build-success.outcome != 'skipped' run: make check # # Generate validation plots diff --git a/.github/workflows/gitlab-ci.yml b/.github/workflows/gitlab-ci.yml index ce17ebc5c..0c987d844 100644 --- a/.github/workflows/gitlab-ci.yml +++ b/.github/workflows/gitlab-ci.yml @@ -61,7 +61,6 @@ jobs: levante: runs-on: ubuntu-latest needs: levante-init - continue-on-error: ${{ matrix.experimental }} strategy: fail-fast: false matrix: @@ -72,9 +71,6 @@ jobs: - nag-cpu-default-SP - nag-cpu-accel-DP #- nag-cpu-accel-SP - include: - # The tests are not experimental by default: - - experimental: false steps: # # Build, run and check (fetch the log) @@ -161,16 +157,12 @@ jobs: lumi: runs-on: ubuntu-latest needs: lumi-init - continue-on-error: ${{ matrix.experimental }} strategy: fail-fast: false matrix: config-name: - cce-gpu-openacc-DP - cce-gpu-openacc-SP - include: - # The tests are not experimental by default: - - experimental: false steps: # # Build, run and check (fetch the log) diff --git a/.github/workflows/self-hosted-ci.yml b/.github/workflows/self-hosted-ci.yml index 64fc77adb..87dd7e32d 100644 --- a/.github/workflows/self-hosted-ci.yml +++ b/.github/workflows/self-hosted-ci.yml @@ -18,15 +18,12 @@ jobs: if: github.repository == 'earth-system-radiation/rte-rrtmgp' runs-on: labels: cscs-ci - continue-on-error: ${{ matrix.experimental }} strategy: fail-fast: false matrix: config-name: [nvidia-gpu-openacc, cce-cpu-icon-production, cce-gpu-openmp] fpmodel: [DP, SP] include: - # The tests are not experimental by default: - - experimental: false - config-name: nvidia-gpu-openacc rte-kernels: accel compiler-modules: "PrgEnv-nvidia nvidia craype-accel-nvidia60 cdt-cuda/21.09 !cray-libsci_acc" @@ -42,7 +39,6 @@ jobs: compiler-modules: "PrgEnv-cray craype-accel-nvidia60 cdt-cuda/22.05 cudatoolkit/11.2.0_3.39-2.1__gf93aa1c" # OpenMP flags from Nichols Romero (Argonne) fcflags: "-hnoacc -homp -O0" - experimental: true env: # Core variables: FC: ftn @@ -103,18 +99,31 @@ jobs: make libs make -C build separate-libs # - # Run examples and tests + # Run examples and tests (expect success) # - - name: Run examples and tests + - name: Run examples and tests (expect success) + id: run-success + if: matrix.config-name != 'cce-gpu-openmp' run: make tests # + # Run examples and tests (expect failure) + # + - name: Run examples and tests (expect failure) + if: steps.run-success.outcome == 'skipped' + run: | + make tests && { + echo "Unexpected success" + exit 1 + } || echo "Expected failure" + # # Relax failure thresholds for single precision # - name: Relax failure threshold for single precision - if: matrix.fpmodel == 'SP' + if: matrix.fpmodel == 'SP' && steps.run-success.outcome != 'skipped' run: echo "FAILURE_THRESHOLD=3.5e-1" >> $GITHUB_ENV # # Compare the results # - name: Compare the results + if: steps.run-success.outcome != 'skipped' run: make check From 43adc58fbd5cbd373f3bc1c031b81861e03a70aa Mon Sep 17 00:00:00 2001 From: Robert Pincus Date: Mon, 19 Feb 2024 08:36:39 -0800 Subject: [PATCH 19/57] Add initial unit tests (solvers) (#263) Adds stand-alone unit tests for solvers alone (in tests/rte[sl]w_unit_tests.F90). Longwave solvers are tested for correctness in radiative equilibrium and for invariance to choices (vertical orientation, problem size...). Shortwave solvers are tested only for invariance. --- CITATION.cff | 4 +- Makefile | 8 +- rrtmgp-frontend/mo_gas_optics_rrtmgp.F90 | 4 +- rte-frontend/mo_rte_sw.F90 | 2 +- tests/Makefile | 21 +- tests/all_tests.sh | 11 +- tests/check_equivalence.F90 | 119 ++---- tests/check_variants.F90 | 117 +++--- tests/mo_gas_optics_defs_rrtmgp.F90 | 250 ++++++++++++ tests/mo_testing_utils.F90 | 276 +++++++++++++ tests/rte_lw_solver_unit_tests.F90 | 383 ++++++++++++++++++ tests/rte_optic_prop_unit_tests.F90 | 231 +++++++++++ tests/rte_sw_solver_unit_tests.F90 | 346 ++++++++++++++++ ...test_zenith_angle_spherical_correction.F90 | 4 +- 14 files changed, 1625 insertions(+), 151 deletions(-) create mode 100644 tests/mo_gas_optics_defs_rrtmgp.F90 create mode 100644 tests/mo_testing_utils.F90 create mode 100644 tests/rte_lw_solver_unit_tests.F90 create mode 100644 tests/rte_optic_prop_unit_tests.F90 create mode 100644 tests/rte_sw_solver_unit_tests.F90 diff --git a/CITATION.cff b/CITATION.cff index fddcb6833..b574ec618 100644 --- a/CITATION.cff +++ b/CITATION.cff @@ -25,12 +25,14 @@ authors: given-names: Igor N. - family-names: Romero given-names: Nicols A. + - family-names: Kosukhin + given-names: Sergey S. - family-names: Wehe given-names: Andre type: software repository-code: "https://github.com/earth-system-radiaton/rte-rrtmgp" license: BSD-3-Clause -date-released: "2023-05-30" +date-released: "2023-11-27" version: 1.7 abstract: "RTE+RRTMGP is a set of codes for computing radiative fluxes in planetary atmospheres. diff --git a/Makefile b/Makefile index c36bd1179..668b88f93 100644 --- a/Makefile +++ b/Makefile @@ -2,7 +2,7 @@ # Top-level Makefile # .PHONY: libs tests check docs -all: libs tests check docs +all: libs tests check docs libs: make -C build -j @@ -11,21 +11,21 @@ libs: make -C examples/rfmip-clear-sky -j tests: + make -C tests tests make -C examples/rfmip-clear-sky tests make -C examples/all-sky tests - make -C tests tests check: + make -C tests check make -C examples/rfmip-clear-sky check make -C examples/all-sky check - make -C tests check docs: @cd doc; ./build_documentation.sh clean: make -C build clean + make -C tests clean make -C examples/rfmip-clear-sky clean make -C examples/all-sky clean - make -C tests clean rm -rf public diff --git a/rrtmgp-frontend/mo_gas_optics_rrtmgp.F90 b/rrtmgp-frontend/mo_gas_optics_rrtmgp.F90 index 9aeb476f5..c83601586 100644 --- a/rrtmgp-frontend/mo_gas_optics_rrtmgp.F90 +++ b/rrtmgp-frontend/mo_gas_optics_rrtmgp.F90 @@ -1728,10 +1728,10 @@ end function is_loaded ! subroutine finalize(this) class(ty_gas_optics_rrtmgp), intent(inout) :: this - real(wp), dimension(:), allocatable :: press_ref, press_ref_log, temp_ref if(this%is_loaded()) then !$acc exit data delete(this%gas_names, this%vmr_ref, this%flavor) & + !$acc delete(this%press_ref, this%press_ref_log, this%temp_ref) & !$acc delete(this%gpoint_flavor, this%kmajor) & !$acc delete(this%minor_limits_gpt_lower) & !$acc delete(this%minor_scales_with_density_lower, this%scale_by_complement_lower) & @@ -1742,6 +1742,7 @@ subroutine finalize(this) !$acc delete(this%idx_minor_upper, this%idx_minor_scaling_upper) & !$acc delete(this%kminor_start_upper, this%kminor_upper) !$omp target exit data map(release:this%gas_names, this%vmr_ref, this%flavor) & + !$omp map(release:this%press_ref, this%press_ref_log, this%temp_ref) !$omp map(release:this%gpoint_flavor, this%kmajor) & !$omp map(release:this%minor_limits_gpt_lower) & !$omp map(release:this%minor_scales_with_density_lower, this%scale_by_complement_lower) & @@ -1752,6 +1753,7 @@ subroutine finalize(this) !$omp map(release:this%idx_minor_upper, this%idx_minor_scaling_upper) & !$omp map(release:this%kminor_start_upper, this%kminor_upper) deallocate(this%gas_names, this%vmr_ref, this%flavor, this%gpoint_flavor, this%kmajor) + deallocate(this%press_ref, this%press_ref_log, this%temp_ref) deallocate(this%minor_limits_gpt_lower, & this%minor_scales_with_density_lower, this%scale_by_complement_lower, & this%idx_minor_lower, this%idx_minor_scaling_lower, this%kminor_start_lower, this%kminor_lower) diff --git a/rte-frontend/mo_rte_sw.F90 b/rte-frontend/mo_rte_sw.F90 index 961209543..22cdf3aeb 100644 --- a/rte-frontend/mo_rte_sw.F90 +++ b/rte-frontend/mo_rte_sw.F90 @@ -336,7 +336,7 @@ function rte_sw_mu0_full(atmos, top_at_1, & ! type is (ty_fluxes_broadband) if(associated(fluxes%flux_net)) then - !$acc parallel loop collapse(2) copyout(fluxes%flux_net) + !$acc parallel loop collapse(2) copyin(fluxes) copyout(fluxes%flux_net) !$omp target teams distribute parallel do simd collapse(2) do ilev = 1, nlay+1 do icol = 1, ncol diff --git a/tests/Makefile b/tests/Makefile index d433f4725..aaa159f47 100644 --- a/tests/Makefile +++ b/tests/Makefile @@ -32,9 +32,10 @@ VPATH += $(RRTMGP_ROOT)/rrtmgp-frontend:$(RRTMGP_ROOT)/extensions:$(RRTMGP_ROOT) # Extra sources -- extensions to RRTMGP classes, shared infrastructure, local sources # ADDITIONS = mo_heating_rates.o mo_compute_bc.o mo_rrtmgp_clr_all_sky.o +ADDITIONS += mo_gas_optics_defs_rrtmgp.o # File I/O -ADDITIONS += mo_load_coefficients.o mo_simple_netcdf.o mo_rfmip_io.o -ADDITIONS += mo_testing_io.o +ADDITIONS += mo_simple_netcdf.o mo_rfmip_io.o +ADDITIONS += mo_testing_io.o mo_testing_utils.o # Cloud optics CLOUDS += mo_cloud_sampling.o mo_cloud_optics_rrtmgp.o mo_load_cloud_coefficients.o mo_garand_atmos_io.o # Solar variability @@ -45,7 +46,7 @@ ADDITIONS += mo_solar_variability.o # # Targets # -all: check_variants check_equivalence test_zenith_angle_spherical_correction +all: check_variants check_equivalence test_zenith_angle_spherical_correction rte_sw_solver_unit_tests rte_optic_prop_unit_tests rte_lw_solver_unit_tests check_equivalence: $(ADDITIONS) $(LIB_DEPS) check_equivalence.o check_equivalence.o: $(ADDITIONS) $(LIB_DEPS) check_equivalence.F90 @@ -62,14 +63,28 @@ mo_cloud_optics_rrtmgp.o: $(LIB_DEPS) mo_cloud_optics_rrtmgp.F90 mo_load_cloud_coefficients.o: $(LIB_DEPS) mo_simple_netcdf.o mo_cloud_optics_rrtmgp.o mo_load_cloud_coefficients.F90 mo_cloud_sampling.o: $(LIB_DEPS) mo_cloud_sampling.F90 +mo_gas_optics_defs_rrtmgp.o: $(LIB_DEPS) mo_testing_utils.o mo_simple_netcdf.o mo_gas_optics_defs_rrtmgp.F90 + mo_load_coefficients.o: $(LIB_DEPS) mo_simple_netcdf.o mo_load_coefficients.F90 mo_rfmip_io.o.o: $(LIB_DEPS) mo_simple_netcdf.o mo_rfmip_io.F90 mo_simple_netcdf.o: $(LIB_DEPS) mo_simple_netcdf.F90 +rte_optic_prop_unit_tests.o: $(LIB_DEPS) mo_testing_utils.o rte_optic_prop_unit_tests.F90 +rte_optic_prop_unit_tests : $(LIB_DEPS) mo_testing_utils.o rte_optic_prop_unit_tests.o + +rte_lw_solver_unit_tests.o: $(LIB_DEPS) mo_testing_utils.o rte_lw_solver_unit_tests.F90 +rte_lw_solver_unit_tests : $(LIB_DEPS) mo_testing_utils.o rte_lw_solver_unit_tests.o + +rte_sw_solver_unit_tests.o: $(LIB_DEPS) mo_testing_utils.o rte_sw_solver_unit_tests.F90 +rte_sw_solver_unit_tests : $(LIB_DEPS) mo_testing_utils.o rte_sw_solver_unit_tests.o + + .PHONY: tests tests: cp ${RRTMGP_DATA}/examples/rfmip-clear-sky/inputs/multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc ./test_atmospheres.nc $(RUN_CMD) bash all_tests.sh + + check: echo "Nothing to check in tests/" diff --git a/tests/all_tests.sh b/tests/all_tests.sh index 9af6c7021..7752f4064 100644 --- a/tests/all_tests.sh +++ b/tests/all_tests.sh @@ -1,7 +1,10 @@ set -eux +./rte_optic_prop_unit_tests +./rte_lw_solver_unit_tests +./rte_sw_solver_unit_tests ./check_equivalence test_atmospheres.nc ${RRTMGP_DATA}/rrtmgp-gas-lw-g256.nc -./check_equivalence test_atmospheres.nc ${RRTMGP_DATA}/rrtmgp-gas-lw-g128.nc -./check_equivalence test_atmospheres.nc ${RRTMGP_DATA}/rrtmgp-gas-sw-g224.nc -./check_equivalence test_atmospheres.nc ${RRTMGP_DATA}/rrtmgp-gas-sw-g112.nc +./check_equivalence test_atmospheres.nc ${RRTMGP_DATA}/rrtmgp-gas-lw-g128.nc +./check_equivalence test_atmospheres.nc ${RRTMGP_DATA}/rrtmgp-gas-sw-g224.nc +./check_equivalence test_atmospheres.nc ${RRTMGP_DATA}/rrtmgp-gas-sw-g112.nc ./check_variants test_atmospheres.nc ${RRTMGP_DATA}/rrtmgp-gas-lw-g256.nc ${RRTMGP_DATA}/rrtmgp-gas-lw-g128.nc -./check_variants test_atmospheres.nc ${RRTMGP_DATA}/rrtmgp-gas-sw-g224.nc ${RRTMGP_DATA}/rrtmgp-gas-sw-g112.nc \ No newline at end of file +./check_variants test_atmospheres.nc ${RRTMGP_DATA}/rrtmgp-gas-sw-g224.nc ${RRTMGP_DATA}/rrtmgp-gas-sw-g112.nc \ No newline at end of file diff --git a/tests/check_equivalence.F90 b/tests/check_equivalence.F90 index 40270178e..ed6022788 100644 --- a/tests/check_equivalence.F90 +++ b/tests/check_equivalence.F90 @@ -34,13 +34,13 @@ program rte_check_equivalence ty_optical_props_arry, & ty_optical_props_1scl, ty_optical_props_2str, ty_optical_props_nstr use mo_rte_util_array, only: zero_array - use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use mo_gas_concentrations, only: ty_gas_concs + use mo_gas_optics_defs, only: gas_optics, load_and_init use mo_source_functions, only: ty_source_func_lw use mo_fluxes, only: ty_fluxes_broadband use mo_rte_lw, only: rte_lw use mo_rte_sw, only: rte_sw - use mo_load_coefficients, only: load_and_init + use mo_testing_utils, only: increment_with_1scl, increment_with_2str, increment_with_nstr use mo_rfmip_io, only: read_size, read_and_block_pt, read_and_block_gases_ty, & read_and_block_lw_bc, read_and_block_sw_bc, determine_gas_names use mo_simple_netcdf, only: get_dim_size, read_field @@ -89,7 +89,6 @@ program rte_check_equivalence ! ! Derived types from the RTE and RRTMGP libraries ! - type(ty_gas_optics_rrtmgp) :: k_dist type(ty_gas_concs) :: gas_concs type(ty_gas_concs), dimension(:), allocatable & :: gas_conc_array @@ -111,7 +110,7 @@ program rte_check_equivalence character(len=32 ), & dimension(:), allocatable :: kdist_gas_names, rfmip_gas_games - character(len=256) :: input_file = "", k_dist_file = "" + character(len=256) :: input_file = "", gas_optics_file = "" ! ---------------------------------------------------------------------------------- ! Code ! ---------------------------------------------------------------------------------- @@ -120,10 +119,10 @@ program rte_check_equivalence ! failed = .false. nUserArgs = command_argument_count() - if (nUserArgs < 2) call stop_on_err("Need to supply input_file k_distribution_file ") + if (nUserArgs < 2) call stop_on_err("Need to supply input_file gas_optics_file ") if (nUserArgs > 3) print *, "Ignoring command line arguments beyond the first three..." call get_command_argument(1,input_file) - call get_command_argument(2,k_dist_file) + call get_command_argument(2,gas_optics_file) if(trim(input_file) == '-h' .or. trim(input_file) == "--help") then call stop_on_err("rte_check_equivalence input_file absorption_coefficients_file") end if @@ -132,7 +131,7 @@ program rte_check_equivalence ! Arrays are allocated as they are read ! call read_size (input_file, ncol, nlay, nexp) - call determine_gas_names(input_file, k_dist_file, 1, kdist_gas_names, rfmip_gas_games) + call determine_gas_names(input_file, gas_optics_file, 1, kdist_gas_names, rfmip_gas_games) call read_and_block_pt (input_file, ncol, p_lay_3d, p_lev_3d, t_lay_3d, t_lev_3d) ! ! Only do the first RFMIP experiment @@ -158,17 +157,17 @@ program rte_check_equivalence deallocate(gas_conc_array) ! ---------------------------------------------------------------------------- ! load data into classes - call load_and_init(k_dist, k_dist_file, gas_concs) - is_sw = k_dist%source_is_external() + call load_and_init(gas_optics, gas_optics_file, gas_concs) + is_sw = gas_optics%source_is_external() is_lw = .not. is_sw - print *, "k-distribution is for the " // merge("longwave ", "shortwave", is_lw) - print *, " pressure limits (Pa):", k_dist%get_press_min(), k_dist%get_press_max() - print *, " temperature limits (K):", k_dist%get_temp_min(), k_dist%get_temp_max() + print *, "gas optics is for the " // merge("longwave ", "shortwave", is_lw) + print *, " pressure limits (Pa):", gas_optics%get_press_min(), gas_optics%get_press_max() + print *, " temperature limits (K):", gas_optics%get_temp_min(), gas_optics%get_temp_max() ! ! Problem sizes ! - nbnd = k_dist%get_nband() - ngpt = k_dist%get_ngpt() + nbnd = gas_optics%get_nband() + ngpt = gas_optics%get_ngpt() top_at_1 = p_lay(1, 1) < p_lay(1, nlay) ! ---------------------------------------------------------------------------- ! @@ -191,7 +190,7 @@ program rte_check_equivalence mu0(:) = cos(abs(sza(:,1)) * acos(-1._wp)/180._wp) else allocate(sfc_t(ncol), sfc_emis(nbnd, ncol)) - call stop_on_err(lw_sources%alloc(ncol, nlay, k_dist)) + call stop_on_err(lw_sources%alloc(ncol, nlay, gas_optics)) call read_and_block_lw_bc(input_file, ncol, bc_3d, sfc_t_3d) ! ! Surface emissivity is spectrally uniform @@ -202,7 +201,7 @@ program rte_check_equivalence end if ! ---------------------------------------------------------------------------- ! - ! Fluxes, heat rates, Jacobians + ! Fluxes, heating rates, Jacobians ! allocate(ref_flux_up(ncol,nlay+1), ref_flux_dn(ncol,nlay+1), & tst_flux_up(ncol,nlay+1), tst_flux_dn(ncol,nlay+1), & @@ -221,9 +220,9 @@ program rte_check_equivalence ! ! initialization, finalization of optical properties ! - call make_optical_props_1scl(k_dist) + call make_optical_props_1scl(gas_optics) call atmos%finalize() - call make_optical_props_1scl(k_dist) + call make_optical_props_1scl(gas_optics) call atmos%set_name("gas only atmosphere") print *, " Intialized atmosphere twice" ! @@ -231,7 +230,7 @@ program rte_check_equivalence ! fluxes%flux_up => ref_flux_up(:,:) fluxes%flux_dn => ref_flux_dn(:,:) - call stop_on_err(k_dist%gas_optics(p_lay, p_lev, & + call stop_on_err(gas_optics%gas_optics(p_lay, p_lev, & t_lay, sfc_t, & gas_concs, & atmos, & @@ -302,7 +301,7 @@ program rte_check_equivalence .not. allclose(tst_flux_dn, ref_flux_dn) ) & call report_err(" halving/doubling fails") - call increment_with_1scl + call increment_with_1scl(atmos) call stop_on_err(rte_lw(atmos, top_at_1, & lw_sources, & sfc_emis, & @@ -311,7 +310,7 @@ program rte_check_equivalence .not. allclose(tst_flux_dn, ref_flux_dn) ) & call report_err(" Incrementing with 1scl fails") - call increment_with_2str + call increment_with_2str(atmos) call stop_on_err(rte_lw(atmos, top_at_1, & lw_sources, & sfc_emis, & @@ -320,7 +319,7 @@ program rte_check_equivalence .not. allclose(tst_flux_dn, ref_flux_dn) ) & call report_err(" Incrementing with 2str fails") - call increment_with_nstr + call increment_with_nstr(atmos) call stop_on_err(rte_lw(atmos, top_at_1, & lw_sources, & sfc_emis, & @@ -344,7 +343,7 @@ program rte_check_equivalence ! ! Increase surface temperature by 1K and recompute fluxes ! - call stop_on_err(k_dist%gas_optics(p_lay, p_lev, & + call stop_on_err(gas_optics%gas_optics(p_lay, p_lev, & t_lay, sfc_t + 1._wp, & gas_concs, & atmos, & @@ -370,9 +369,9 @@ program rte_check_equivalence ! ! initialization, finalization of optical properties ! - call make_optical_props_2str(k_dist) + call make_optical_props_2str(gas_optics) call atmos%finalize() - call make_optical_props_2str(k_dist) + call make_optical_props_2str(gas_optics) print *, " Intialized atmosphere twice" ! @@ -381,7 +380,7 @@ program rte_check_equivalence fluxes%flux_up => ref_flux_up (:,:) fluxes%flux_dn => ref_flux_dn (:,:) fluxes%flux_dn_dir => ref_flux_dir(:,:) - call stop_on_err(k_dist%gas_optics(p_lay, p_lev, & + call stop_on_err(gas_optics%gas_optics(p_lay, p_lev, & t_lay, & gas_concs, & atmos, & @@ -421,7 +420,7 @@ program rte_check_equivalence ! Incrementing ! Threshold of 4x spacing() works in double precision ! - call stop_on_err(k_dist%gas_optics(p_lay, p_lev, & + call stop_on_err(gas_optics%gas_optics(p_lay, p_lev, & t_lay, & gas_concs, & atmos, & @@ -437,7 +436,7 @@ program rte_check_equivalence .not. allclose(tst_flux_dir,ref_flux_dir,tol = 8._wp)) & call report_err(" halving/doubling fails") - call increment_with_1scl + call increment_with_1scl(atmos) call stop_on_err(rte_sw(atmos, top_at_1, & mu0, toa_flux, & sfc_alb_dir, sfc_alb_dif, & @@ -447,23 +446,23 @@ program rte_check_equivalence .not. allclose(tst_flux_dir,ref_flux_dir,tol = 6._wp)) & call report_err(" Incrementing with 1scl fails") - call stop_on_err(k_dist%gas_optics(p_lay, p_lev, & + call stop_on_err(gas_optics%gas_optics(p_lay, p_lev, & t_lay, & gas_concs, & atmos, & toa_flux)) - call increment_with_2str + call increment_with_2str(atmos) if(.not. allclose(tst_flux_up, ref_flux_up, tol = 8._wp) .or. & .not. allclose(tst_flux_dn, ref_flux_dn, tol = 6._wp) .or. & .not. allclose(tst_flux_dir,ref_flux_dir,tol = 6._wp)) & call report_err(" Incrementing with 2str fails") - call stop_on_err(k_dist%gas_optics(p_lay, p_lev, & + call stop_on_err(gas_optics%gas_optics(p_lay, p_lev, & t_lay, & gas_concs, & atmos, & toa_flux)) - call increment_with_nstr + call increment_with_nstr(atmos) call stop_on_err(rte_sw(atmos, top_at_1, & mu0, toa_flux, & sfc_alb_dir, sfc_alb_dif, & @@ -489,7 +488,6 @@ subroutine lw_clear_sky_vr character(32), & dimension(gas_concs%get_num_gases()) & :: gc_gas_names - ! ! Reverse the orientation of the problem ! @@ -510,7 +508,7 @@ subroutine lw_clear_sky_vr call stop_on_err(gas_concs_vr%set_vmr(gc_gas_names(i), vmr)) end do - call stop_on_err(k_dist%gas_optics(p_lay, p_lev, & + call stop_on_err(gas_optics%gas_optics(p_lay, p_lev, & t_lay, sfc_t, & gas_concs_vr, & atmos, & @@ -541,7 +539,7 @@ subroutine lw_clear_sky_subset :: up, dn integer :: i, colS, colE - call stop_on_err(k_dist%gas_optics(p_lay, p_lev, & + call stop_on_err(gas_optics%gas_optics(p_lay, p_lev, & t_lay, sfc_t, & gas_concs, & atmos, & @@ -597,7 +595,7 @@ subroutine sw_clear_sky_vr call stop_on_err(gas_concs_vr%set_vmr(gc_gas_names(i), vmr)) end do - call stop_on_err(k_dist%gas_optics(p_lay, p_lev, & + call stop_on_err(gas_optics%gas_optics(p_lay, p_lev, & t_lay, & gas_concs_vr, & atmos, & @@ -628,9 +626,9 @@ subroutine sw_clear_sky_tsi default_tsi = sum(toa_flux(1, :)) ! Set TSI to half the default - call stop_on_err(k_dist%set_tsi(tsi_scale*default_tsi)) + call stop_on_err(gas_optics%set_tsi(tsi_scale*default_tsi)) ! Redo gas optics - call stop_on_err(k_dist%gas_optics(p_lay, p_lev, & + call stop_on_err(gas_optics%gas_optics(p_lay, p_lev, & t_lay, & gas_concs, & atmos, & @@ -643,7 +641,7 @@ subroutine sw_clear_sky_tsi tst_flux_dn (:,:) = tst_flux_dn (:,:) / tsi_scale tst_flux_dir(:,:) = tst_flux_dir(:,:) / tsi_scale - call stop_on_err(k_dist%set_tsi(default_tsi)) + call stop_on_err(gas_optics%set_tsi(default_tsi)) toa_flux (:,:) = toa_flux(:,:) / tsi_scale end subroutine sw_clear_sky_tsi @@ -673,41 +671,10 @@ subroutine report_err(error_msg) failed = .true. end if end subroutine report_err - ! ---------------------------------------------------------------------------- - subroutine increment_with_1scl - type(ty_optical_props_1scl) :: transparent - - call stop_on_err(transparent%alloc_1scl(ncol, nlay, k_dist)) - call zero_array (ncol, nlay, ngpt, transparent%tau) - call stop_on_err(transparent%increment(atmos)) - call transparent%finalize() - end subroutine increment_with_1scl - ! ------- - subroutine increment_with_2str - type(ty_optical_props_2str) :: transparent - - call stop_on_err(transparent%alloc_2str(ncol, nlay, k_dist)) - call zero_array (ncol, nlay, ngpt, transparent%tau) - call zero_array (ncol, nlay, ngpt, transparent%ssa) - call zero_array (ncol, nlay, ngpt, transparent%g) - call stop_on_err(transparent%increment(atmos)) - call transparent%finalize() - end subroutine increment_with_2str - ! ------- - subroutine increment_with_nstr - type(ty_optical_props_nstr) :: transparent - integer, parameter :: nmom = 4 - call stop_on_err(transparent%alloc_nstr(nmom, ncol, nlay, k_dist)) - call zero_array ( ncol, nlay, ngpt, transparent%tau) - call zero_array ( ncol, nlay, ngpt, transparent%ssa) - call zero_array (nmom, ncol, nlay, ngpt, transparent%p) - call stop_on_err(transparent%increment(atmos)) - call transparent%finalize() - end subroutine increment_with_nstr ! ---------------------------------------------------------------------------- - subroutine make_optical_props_1scl(k_dist) - class (ty_optical_props), intent(in) :: k_dist + subroutine make_optical_props_1scl(gas_optics) + class (ty_optical_props), intent(in) :: gas_optics if(allocated(atmos)) then call atmos%finalize() @@ -719,14 +686,14 @@ subroutine make_optical_props_1scl(k_dist) ! select type(atmos) class is (ty_optical_props_1scl) - call stop_on_err(atmos%alloc_1scl(ncol, nlay, k_dist)) + call stop_on_err(atmos%alloc_1scl(ncol, nlay, gas_optics)) class default call stop_on_err("rte_check_equivalence: Don't recognize the kind of optical properties ") end select end subroutine make_optical_props_1scl ! ---------------------------------------------------------------------------- - subroutine make_optical_props_2str(k_dist) - class (ty_optical_props), intent(in) :: k_dist + subroutine make_optical_props_2str(gas_optics) + class (ty_optical_props), intent(in) :: gas_optics if(allocated(atmos)) then call atmos%finalize() deallocate(atmos) @@ -737,7 +704,7 @@ subroutine make_optical_props_2str(k_dist) ! select type(atmos) class is (ty_optical_props_2str) - call stop_on_err(atmos%alloc_2str(ncol, nlay, k_dist)) + call stop_on_err(atmos%alloc_2str(ncol, nlay, gas_optics)) class default call stop_on_err("rte_check_equivalence: Don't recognize the kind of optical properties ") end select diff --git a/tests/check_variants.F90 b/tests/check_variants.F90 index 72564c2d1..a57b9ec84 100644 --- a/tests/check_variants.F90 +++ b/tests/check_variants.F90 @@ -28,22 +28,21 @@ end subroutine stop_on_err ! Serves also to exercise various code paths ! Longwave: ! omiting level temperatures, use optimal angle, use three-angle integration, -! two-stream solution; reduced-resolution k-distribution +! two-stream solution; reduced-resolution gas optics ! Shortwave: -! reduced-resolution k-distribution +! reduced-resolution gas optics ! program rte_clear_sky_regression use mo_rte_kind, only: wp use mo_optical_props, only: ty_optical_props, & ty_optical_props_arry, & ty_optical_props_1scl, ty_optical_props_2str, ty_optical_props_nstr - use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use mo_gas_concentrations, only: ty_gas_concs + use mo_gas_optics_defs, only: gas_optics => gas_optics, load_and_init use mo_source_functions, only: ty_source_func_lw use mo_fluxes, only: ty_fluxes_broadband use mo_rte_lw, only: rte_lw use mo_rte_sw, only: rte_sw - use mo_load_coefficients, only: load_and_init use mo_rfmip_io, only: read_size, read_and_block_pt, read_and_block_gases_ty, & read_and_block_lw_bc, read_and_block_sw_bc, determine_gas_names use mo_simple_netcdf, only: get_dim_size, read_field @@ -91,7 +90,6 @@ program rte_clear_sky_regression ! ! Derived types from the RTE and RRTMGP libraries ! - type(ty_gas_optics_rrtmgp) :: k_dist, k_dist_2 type(ty_gas_concs) :: gas_concs type(ty_gas_concs), dimension(:), allocatable & :: gas_conc_array @@ -112,7 +110,7 @@ program rte_clear_sky_regression character(len=32 ), & dimension(:), allocatable :: kdist_gas_names, rfmip_gas_games - character(len=256) :: input_file = "", k_dist_file = "", k_dist_file_2 = "" + character(len=256) :: input_file = "", gas_optics_file = "", gas_optics_file_2 = "" ! ---------------------------------------------------------------------------------- ! Code ! ---------------------------------------------------------------------------------- @@ -120,10 +118,10 @@ program rte_clear_sky_regression ! Parse command line for any file names, block size ! nUserArgs = command_argument_count() - if (nUserArgs < 2) call stop_on_err("Need to supply input_file k_distribution_file [k_dist_file_2]") + if (nUserArgs < 2) call stop_on_err("Need to supply input_file gas_optics_file [gas_optics_file_2]") if (nUserArgs >= 1) call get_command_argument(1,input_file) - if (nUserArgs >= 2) call get_command_argument(2,k_dist_file) - if (nUserArgs >= 3) call get_command_argument(3,k_dist_file_2) + if (nUserArgs >= 2) call get_command_argument(2,gas_optics_file) + if (nUserArgs >= 3) call get_command_argument(3,gas_optics_file_2) if (nUserArgs > 4) print *, "Ignoring command line arguments beyond the first four..." if(trim(input_file) == '-h' .or. trim(input_file) == "--help") then call stop_on_err("clear_sky_regression input_file absorption_coefficients_file") @@ -133,7 +131,7 @@ program rte_clear_sky_regression ! Arrays are allocated as they are read ! call read_size (input_file, ncol, nlay, nexp) - call determine_gas_names(input_file, k_dist_file, 1, kdist_gas_names, rfmip_gas_games) + call determine_gas_names(input_file, gas_optics_file, 1, kdist_gas_names, rfmip_gas_games) call read_and_block_pt (input_file, ncol, p_lay_3d, p_lev_3d, t_lay_3d, t_lev_3d) ! ! Only do the first RFMIP experiment @@ -159,15 +157,15 @@ program rte_clear_sky_regression deallocate(gas_conc_array) ! ---------------------------------------------------------------------------- ! load data into classes - call load_and_init(k_dist, k_dist_file, gas_concs) - is_sw = k_dist%source_is_external() + call load_and_init(gas_optics, gas_optics_file, gas_concs) + is_sw = gas_optics%source_is_external() is_lw = .not. is_sw - print *, "k-distribution is for the " // merge("longwave ", "shortwave", is_lw) + print *, "gas optics is for the " // merge("longwave ", "shortwave", is_lw) ! ! Problem sizes ! - nbnd = k_dist%get_nband() - ngpt = k_dist%get_ngpt() + nbnd = gas_optics%get_nband() + ngpt = gas_optics%get_ngpt() top_at_1 = p_lay(1, 1) < p_lay(1, nlay) ! ---------------------------------------------------------------------------- ! @@ -190,7 +188,7 @@ program rte_clear_sky_regression sun_up) else allocate(sfc_t(ncol), sfc_emis(nbnd, ncol)) - call stop_on_err(lw_sources%alloc(ncol, nlay, k_dist)) + call stop_on_err(lw_sources%alloc(ncol, nlay, gas_optics)) call read_and_block_lw_bc(input_file, ncol, bc_3d, sfc_t_3d) ! ! Surface emissivity is spectrally uniform @@ -211,36 +209,39 @@ program rte_clear_sky_regression fluxes%flux_up => flux_up(:,:) fluxes%flux_dn => flux_dn(:,:) if(is_lw) then - call make_optical_props_1scl(k_dist) + call make_optical_props_1scl(gas_optics) call atmos%set_name("gas only atmosphere") call lw_clear_sky_default call lw_clear_sky_notlev call lw_clear_sky_3ang call lw_clear_sky_optangle call lw_clear_sky_jaco - call make_optical_props_2str(k_dist) + call make_optical_props_2str(gas_optics) call lw_clear_sky_2str - if(len_trim(k_dist_file_2) > 0) then - call load_and_init(k_dist_2, k_dist_file_2, gas_concs) - print *, "Alternate k-distribution is for the " // merge("longwave ", "shortwave", .not. k_dist_2%source_is_external()) - print *, " Resolution :", k_dist_2%get_nband(), k_dist_2%get_ngpt() - ngpt = k_dist_2%get_ngpt() + ! + ! Replaces default gas optics with alternative + ! + if(len_trim(gas_optics_file_2) > 0) then + call load_and_init(gas_optics, gas_optics_file_2, gas_concs) + print *, "Alternate gas optics is for the " // merge("longwave ", "shortwave", gas_optics%source_is_internal()) + print *, " Resolution :", gas_optics%get_nband(), gas_optics%get_ngpt() + ngpt = gas_optics%get_ngpt() call atmos%finalize() - call make_optical_props_1scl(k_dist_2) - call stop_on_err(lw_sources%alloc(ncol, nlay, k_dist_2)) + call make_optical_props_1scl(gas_optics) + call stop_on_err(lw_sources%alloc(ncol, nlay, gas_optics)) call lw_clear_sky_alt end if else - call make_optical_props_2str(k_dist) + call make_optical_props_2str(gas_optics) call sw_clear_sky_default - if(len_trim(k_dist_file_2) > 0) then - call load_and_init(k_dist_2, k_dist_file_2, gas_concs) - print *, "Alternate k-distribution is for the " // merge("longwave ", "shortwave", .not. k_dist_2%source_is_external()) - print *, " Resolution :", k_dist_2%get_nband(), k_dist_2%get_ngpt() + if(len_trim(gas_optics_file_2) > 0) then + call load_and_init(gas_optics, gas_optics_file_2, gas_concs) + print *, "Alternate gas optics is for the " // merge("longwave ", "shortwave", gas_optics%source_is_internal()) + print *, " Resolution :", gas_optics%get_nband(), gas_optics%get_ngpt() call atmos%finalize() - call make_optical_props_2str(k_dist_2) + call make_optical_props_2str(gas_optics) deallocate(toa_flux) - allocate(toa_flux(ncol, k_dist_2%get_ngpt())) + allocate(toa_flux(ncol, gas_optics%get_ngpt())) call sw_clear_sky_alt end if end if @@ -254,7 +255,7 @@ subroutine lw_clear_sky_default real(wp), dimension(ncol, nlay) :: heating_rate fluxes%flux_net => flux_net - call stop_on_err(k_dist%gas_optics(p_lay, p_lev, & + call stop_on_err(gas_optics%gas_optics(p_lay, p_lev, & t_lay, sfc_t, & gas_concs, & atmos, & @@ -291,7 +292,7 @@ end subroutine lw_clear_sky_default ! Clear-sky longwave fluxes, level temperatures provided ! subroutine lw_clear_sky_notlev - call stop_on_err(k_dist%gas_optics(p_lay, p_lev, & + call stop_on_err(gas_optics%gas_optics(p_lay, p_lev, & t_lay, sfc_t, & gas_concs, & atmos, & @@ -308,7 +309,7 @@ end subroutine lw_clear_sky_notlev ! Clear-sky longwave fluxes, all info, three angles ! subroutine lw_clear_sky_3ang - call stop_on_err(k_dist%gas_optics(p_lay, p_lev, & + call stop_on_err(gas_optics%gas_optics(p_lay, p_lev, & t_lay, sfc_t, & gas_concs, & atmos, & @@ -327,13 +328,13 @@ end subroutine lw_clear_sky_3ang ! subroutine lw_clear_sky_optangle real(wp), dimension(ncol, ngpt) :: lw_Ds - call stop_on_err(k_dist%gas_optics(p_lay, p_lev, & + call stop_on_err(gas_optics%gas_optics(p_lay, p_lev, & t_lay, sfc_t, & gas_concs, & atmos, & lw_sources, & tlev = t_lev)) - call stop_on_err(k_dist%compute_optimal_angles(atmos, lw_Ds)) + call stop_on_err(gas_optics%compute_optimal_angles(atmos, lw_Ds)) call stop_on_err(rte_lw(atmos, top_at_1, & lw_sources, & sfc_emis, & @@ -348,7 +349,7 @@ end subroutine lw_clear_sky_optangle subroutine lw_clear_sky_jaco real(wp), dimension(ncol,nlay+1) :: jFluxUp - call stop_on_err(k_dist%gas_optics(p_lay, p_lev, & + call stop_on_err(gas_optics%gas_optics(p_lay, p_lev, & t_lay, sfc_t, & gas_concs, & atmos, & @@ -363,7 +364,7 @@ subroutine lw_clear_sky_jaco call write_broadband_field(input_file, flux_dn, "lw_flux_dn_jaco", "LW flux dn, computing Jaobians") call write_broadband_field(input_file, jFluxUp, "lw_jaco_up" , "Jacobian of LW flux up to surface temperature") - call stop_on_err(k_dist%gas_optics(p_lay, p_lev, & + call stop_on_err(gas_optics%gas_optics(p_lay, p_lev, & t_lay, sfc_t + 1._wp, & gas_concs, & atmos, & @@ -384,7 +385,7 @@ end subroutine lw_clear_sky_jaco ! The second uses the two-stream solver ! subroutine lw_clear_sky_2str - call stop_on_err(k_dist%gas_optics(p_lay, p_lev, & + call stop_on_err(gas_optics%gas_optics(p_lay, p_lev, & t_lay, sfc_t, & gas_concs, & atmos, & @@ -412,12 +413,12 @@ subroutine lw_clear_sky_alt real(wp), dimension(ncol, ngpt) :: lw_Ds fluxes%flux_net => flux_net - call stop_on_err(k_dist_2%gas_optics(p_lay, p_lev, & - t_lay, sfc_t, & - gas_concs, & - atmos, & - lw_sources, & - tlev = t_lev)) + call stop_on_err(gas_optics%gas_optics(p_lay, p_lev, & + t_lay, sfc_t, & + gas_concs, & + atmos, & + lw_sources, & + tlev = t_lev)) call stop_on_err(rte_lw(atmos, top_at_1, & lw_sources, & sfc_emis, & @@ -430,7 +431,7 @@ subroutine lw_clear_sky_alt "lw_flux_hr_alt", "LW heating rate, fewer g-points", & vert_dim_name = "layer") - call stop_on_err(k_dist_2%compute_optimal_angles(atmos, lw_Ds)) + call stop_on_err(gas_optics%compute_optimal_angles(atmos, lw_Ds)) call stop_on_err(rte_lw(atmos, top_at_1, & lw_sources, & sfc_emis, & @@ -442,7 +443,7 @@ subroutine lw_clear_sky_alt call write_broadband_field(input_file, heating_rate, & "lw_flux_hr_alt_oa", "LW heating rate, fewer g-points, opt. angle", & vert_dim_name = "layer") - call k_dist_2%finalize() + call gas_optics%finalize() end subroutine lw_clear_sky_alt ! ---------------------------------------------------------------------------- ! @@ -457,7 +458,7 @@ subroutine sw_clear_sky_default real(wp) :: rrtmgp_tsi type(ty_optical_props_2str) :: atmos2 - call stop_on_err(k_dist%gas_optics(p_lay, p_lev, & + call stop_on_err(gas_optics%gas_optics(p_lay, p_lev, & t_lay, & gas_concs, & atmos, & @@ -485,10 +486,10 @@ subroutine sw_clear_sky_default end subroutine sw_clear_sky_default ! ---------------------------------------------------------------------------- subroutine sw_clear_sky_alt - real(wp), dimension(ncol, k_dist_2%get_ngpt()) & + real(wp), dimension(ncol, gas_optics%get_ngpt()) & :: rfmip_tsi_scale real(wp) :: rrtmgp_tsi - call stop_on_err(k_dist_2%gas_optics(p_lay, p_lev, & + call stop_on_err(gas_optics%gas_optics(p_lay, p_lev, & t_lay, & gas_concs, & atmos, & @@ -497,7 +498,7 @@ subroutine sw_clear_sky_alt ! Scaling factor for column dependence of TSI in RFMIP ! rrtmgp_tsi = sum(toa_flux(1,:)) - rfmip_tsi_scale(:,:) = spread(tsi_3d(:,1)/rrtmgp_tsi, dim=2, ncopies=k_dist_2%get_ngpt()) + rfmip_tsi_scale(:,:) = spread(tsi_3d(:,1)/rrtmgp_tsi, dim=2, ncopies=gas_optics%get_ngpt()) toa_flux(:,:) = toa_flux(:,:) * rfmip_tsi_scale(:,:) call stop_on_err(rte_sw(atmos, top_at_1, & @@ -515,8 +516,8 @@ subroutine sw_clear_sky_alt call write_broadband_field(input_file, flux_dn, "sw_flux_dn_alt", "SW flux dn, fewer g-points") end subroutine sw_clear_sky_alt ! ---------------------------------------------------------------------------- - subroutine make_optical_props_1scl(k_dist) - class (ty_optical_props), intent(in) :: k_dist + subroutine make_optical_props_1scl(gas_optics) + class (ty_optical_props), intent(in) :: gas_optics if(allocated(atmos)) then call atmos%finalize() @@ -529,14 +530,14 @@ subroutine make_optical_props_1scl(k_dist) ! select type(atmos) class is (ty_optical_props_1scl) - call stop_on_err(atmos%alloc_1scl(ncol, nlay, k_dist)) + call stop_on_err(atmos%alloc_1scl(ncol, nlay, gas_optics)) class default call stop_on_err("rte_rrtmgp_atmos: Don't recognize the kind of optical properties ") end select end subroutine make_optical_props_1scl ! ---------------------------------------------------------------------------- - subroutine make_optical_props_2str(k_dist) - class (ty_optical_props), intent(in) :: k_dist + subroutine make_optical_props_2str(gas_optics) + class (ty_optical_props), intent(in) :: gas_optics if(allocated(atmos)) then call atmos%finalize() deallocate(atmos) @@ -548,7 +549,7 @@ subroutine make_optical_props_2str(k_dist) ! select type(atmos) class is (ty_optical_props_2str) - call stop_on_err(atmos%alloc_2str(ncol, nlay, k_dist)) + call stop_on_err(atmos%alloc_2str(ncol, nlay, gas_optics)) class default call stop_on_err("rte_rrtmgp_atmos: Don't recognize the kind of optical properties ") end select diff --git a/tests/mo_gas_optics_defs_rrtmgp.F90 b/tests/mo_gas_optics_defs_rrtmgp.F90 new file mode 100644 index 000000000..b99422f94 --- /dev/null +++ b/tests/mo_gas_optics_defs_rrtmgp.F90 @@ -0,0 +1,250 @@ +! This code is part of Radiative Transfer for Energetics (RTE) +! +! Contacts: Robert Pincus and Eli Mlawer +! email: rrtmgp@aer.com +! +! Copyright 2024- Atmospheric and Environmental Research, +! Regents of the University of Colorado, +! Trustees of Columbia University in the City of New York +! All right reserved. +! +! Use and duplication is permitted under the terms of the +! BSD 3-clause license, see http://opensource.org/licenses/BSD-3-Clause +! ---------------------------------------------------------------------------- +! +! This module is intended to support generic codes using RTE-compatibale gas optics types. +! It defines variable `gas_optics` of class `ty_gas_optics` and subroutine +! `load_and_init()` that loads data into the gas_optics variable from a single netCDF file +! This module might be replaced by others that implement the same variable and procedure +! +! Gas optics classes need to be initialized with data; for RRTMGP data comes from a netCDF file. +! The gas optics classes themselves don't include methods for reading the data so we don't conflict with users' +! local environment. This module provides a straight-forward serial implementation of reading the data +! and calling gas_optics%load(). +! +! +module mo_gas_optics_defs + use mo_rte_kind, only: wp, wl + use mo_gas_concentrations, only: ty_gas_concs + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + use mo_testing_utils, only: stop_on_err + ! -------------------------------------------------- + use mo_simple_netcdf, only: read_field, read_char_vec, read_logical_vec, var_exists, get_dim_size + use netcdf + implicit none + + type(ty_gas_optics_rrtmgp) :: gas_optics + private + public :: gas_optics, load_and_init + +contains + !-------------------------------------------------------------------------------------------------------------------- + ! read optical coefficients from NetCDF file + subroutine load_and_init(kdist, filename, available_gases) + class(ty_gas_optics_rrtmgp), intent(inout) :: kdist + character(len=*), intent(in ) :: filename + class(ty_gas_concs), intent(in ) :: available_gases ! Which gases does the host model have available? + ! -------------------------------------------------- + ! + ! Variables that will be passed to gas_optics%load() + ! + character(len=32), dimension(:), allocatable :: gas_names + integer, dimension(:,:,:), allocatable :: key_species + integer, dimension(:,: ), allocatable :: band2gpt + real(wp), dimension(:,: ), allocatable :: band_lims + real(wp) :: press_ref_trop, temp_ref_p, temp_ref_t + real(wp), dimension(: ), allocatable :: press_ref + real(wp), dimension(: ), allocatable :: temp_ref + real(wp), dimension(:,:,: ), allocatable :: vmr_ref + real(wp), dimension(:,:,:,:), allocatable :: kmajor + + character(len=32), dimension(:), allocatable :: gas_minor, identifier_minor + character(len=32), dimension(:), allocatable :: minor_gases_lower, minor_gases_upper + integer, dimension(:,:), allocatable :: minor_limits_gpt_lower, minor_limits_gpt_upper + logical(wl), dimension(:), allocatable :: minor_scales_with_density_lower, minor_scales_with_density_upper + character(len=32), dimension(:), allocatable :: scaling_gas_lower, scaling_gas_upper + logical(wl), dimension(:), allocatable :: scale_by_complement_lower, scale_by_complement_upper + integer, dimension(:), allocatable :: kminor_start_lower, kminor_start_upper + real(wp), dimension(:,:,:), allocatable :: kminor_lower, kminor_upper + + real(wp), dimension(:,:,: ), allocatable :: rayl_lower, rayl_upper + real(wp), dimension(: ), allocatable :: solar_quiet, solar_facular, solar_sunspot + real(wp) :: tsi_default, mg_default, sb_default + real(wp), dimension(:,: ), allocatable :: totplnk + real(wp), dimension(:,:,:,:), allocatable :: planck_frac + real(wp), dimension(:,:) , allocatable :: optimal_angle_fit + + ! ----------------- + ! + ! Book-keeping variables + ! + integer :: ncid + integer :: ntemps, & + npress, & + nabsorbers, & + nextabsorbers, & + nminorabsorbers, & + nmixingfracs, & + nlayers, & + nbnds, & + ngpts, & + npairs, & + nminor_absorber_intervals_lower, & + nminor_absorber_intervals_upper, & + ncontributors_lower, & + ncontributors_upper, & + ninternalSourcetemps, & + nfit_coeffs + ! -------------------------------------------------- + ! + ! How big are the various arrays? + ! + if(nf90_open(trim(fileName), NF90_NOWRITE, ncid) /= NF90_NOERR) & + call stop_on_err("load_and_init(): can't open file " // trim(fileName)) + ntemps = get_dim_size(ncid,'temperature') + npress = get_dim_size(ncid,'pressure') + nabsorbers = get_dim_size(ncid,'absorber') + nminorabsorbers = get_dim_size(ncid,'minor_absorber') + nextabsorbers = get_dim_size(ncid,'absorber_ext') + nmixingfracs = get_dim_size(ncid,'mixing_fraction') + nlayers = get_dim_size(ncid,'atmos_layer') + nbnds = get_dim_size(ncid,'bnd') + ngpts = get_dim_size(ncid,'gpt') + npairs = get_dim_size(ncid,'pair') + nminor_absorber_intervals_lower & + = get_dim_size(ncid,'minor_absorber_intervals_lower') + nminor_absorber_intervals_upper & + = get_dim_size(ncid,'minor_absorber_intervals_upper') + ninternalSourcetemps & + = get_dim_size(ncid,'temperature_Planck') + ncontributors_lower = get_dim_size(ncid,'contributors_lower') + ncontributors_upper = get_dim_size(ncid,'contributors_upper') + nfit_coeffs = get_dim_size(ncid,'fit_coeffs') ! Will be 0 for SW + + ! ----------------- + ! + ! Read the many arrays + ! + gas_names = read_char_vec(ncid, 'gas_names', nabsorbers) + key_species = int(read_field(ncid, 'key_species', 2, nlayers, nbnds)) + band_lims = read_field(ncid, 'bnd_limits_wavenumber', 2, nbnds) + band2gpt = int(read_field(ncid, 'bnd_limits_gpt', 2, nbnds)) + press_ref = read_field(ncid, 'press_ref', npress) + temp_ref = read_field(ncid, 'temp_ref', ntemps) + temp_ref_p = read_field(ncid, 'absorption_coefficient_ref_P') + temp_ref_t = read_field(ncid, 'absorption_coefficient_ref_T') + press_ref_trop = read_field(ncid, 'press_ref_trop') + kminor_lower = read_field(ncid, 'kminor_lower', & + ncontributors_lower, nmixingfracs, ntemps) + kminor_upper = read_field(ncid, 'kminor_upper', & + ncontributors_upper, nmixingfracs, ntemps) + gas_minor = read_char_vec(ncid, 'gas_minor', nminorabsorbers) + identifier_minor = read_char_vec(ncid, 'identifier_minor', nminorabsorbers) + minor_gases_lower = read_char_vec(ncid, 'minor_gases_lower', nminor_absorber_intervals_lower) + minor_gases_upper = read_char_vec(ncid, 'minor_gases_upper', nminor_absorber_intervals_upper) + minor_limits_gpt_lower & + = int(read_field(ncid, 'minor_limits_gpt_lower', npairs,nminor_absorber_intervals_lower)) + minor_limits_gpt_upper & + = int(read_field(ncid, 'minor_limits_gpt_upper', npairs,nminor_absorber_intervals_upper)) + minor_scales_with_density_lower & + = read_logical_vec(ncid, 'minor_scales_with_density_lower', nminor_absorber_intervals_lower) + minor_scales_with_density_upper & + = read_logical_vec(ncid, 'minor_scales_with_density_upper', nminor_absorber_intervals_upper) + scale_by_complement_lower & + = read_logical_vec(ncid, 'scale_by_complement_lower', nminor_absorber_intervals_lower) + scale_by_complement_upper & + = read_logical_vec(ncid, 'scale_by_complement_upper', nminor_absorber_intervals_upper) + scaling_gas_lower & + = read_char_vec(ncid, 'scaling_gas_lower', nminor_absorber_intervals_lower) + scaling_gas_upper & + = read_char_vec(ncid, 'scaling_gas_upper', nminor_absorber_intervals_upper) + kminor_start_lower & + = int(read_field(ncid, 'kminor_start_lower', nminor_absorber_intervals_lower)) + kminor_start_upper & + = int(read_field(ncid, 'kminor_start_upper', nminor_absorber_intervals_upper)) + vmr_ref = read_field(ncid, 'vmr_ref', nlayers, nextabsorbers, ntemps) + + kmajor = read_field(ncid, 'kmajor', ngpts, nmixingfracs, npress+1, ntemps) + if(var_exists(ncid, 'rayl_lower')) then + rayl_lower = read_field(ncid, 'rayl_lower', ngpts, nmixingfracs, ntemps) + rayl_upper = read_field(ncid, 'rayl_upper', ngpts, nmixingfracs, ntemps) + end if + ! -------------------------------------------------- + ! + ! Initialize the gas optics class with data. The calls look slightly different depending + ! on whether the radiation sources are internal to the atmosphere (longwave) or external (shortwave) + ! gas_optics%load() returns a string; a non-empty string indicates an error. + ! + if(var_exists(ncid, 'totplnk')) then + ! + ! If there's a totplnk variable in the file it's a longwave (internal sources) type + ! + totplnk = read_field(ncid, 'totplnk', ninternalSourcetemps, nbnds) + planck_frac = read_field(ncid, 'plank_fraction', ngpts, nmixingfracs, npress+1, ntemps) + optimal_angle_fit = read_field(ncid, 'optimal_angle_fit', nfit_coeffs, nbnds) + call stop_on_err(kdist%load(available_gases, & + gas_names, & + key_species, & + band2gpt, & + band_lims, & + press_ref, & + press_ref_trop, & + temp_ref, & + temp_ref_p, temp_ref_t, & + vmr_ref, kmajor, & + kminor_lower, kminor_upper, & + gas_minor,identifier_minor, & + minor_gases_lower, minor_gases_upper, & + minor_limits_gpt_lower, & + minor_limits_gpt_upper, & + minor_scales_with_density_lower, & + minor_scales_with_density_upper, & + scaling_gas_lower, scaling_gas_upper, & + scale_by_complement_lower, & + scale_by_complement_upper, & + kminor_start_lower, & + kminor_start_upper, & + totplnk, planck_frac, & + rayl_lower, rayl_upper, & + optimal_angle_fit)) + else + ! + ! Solar source doesn't have an dependencies yet + ! + solar_quiet = read_field(ncid, 'solar_source_quiet', ngpts) + solar_facular = read_field(ncid, 'solar_source_facular', ngpts) + solar_sunspot = read_field(ncid, 'solar_source_sunspot', ngpts) + tsi_default = read_field(ncid, 'tsi_default') + mg_default = read_field(ncid, 'mg_default') + sb_default = read_field(ncid, 'sb_default') + call stop_on_err(kdist%load(available_gases, & + gas_names, & + key_species, & + band2gpt, & + band_lims, & + press_ref, & + press_ref_trop, & + temp_ref, & + temp_ref_p, temp_ref_t, & + vmr_ref, kmajor, & + kminor_lower, kminor_upper, & + gas_minor,identifier_minor,& + minor_gases_lower, minor_gases_upper, & + minor_limits_gpt_lower, & + minor_limits_gpt_upper, & + minor_scales_with_density_lower, & + minor_scales_with_density_upper, & + scaling_gas_lower, scaling_gas_upper, & + scale_by_complement_lower, & + scale_by_complement_upper, & + kminor_start_lower, & + kminor_start_upper, & + solar_quiet, solar_facular, solar_sunspot, & + tsi_default, mg_default, sb_default, & + rayl_lower, rayl_upper)) + end if + ! -------------------------------------------------- + ncid = nf90_close(ncid) + end subroutine load_and_init + !-------------------------------------------------------------------------------------------------------------------- +end module mo_gas_optics_defs \ No newline at end of file diff --git a/tests/mo_testing_utils.F90 b/tests/mo_testing_utils.F90 new file mode 100644 index 000000000..07adffa39 --- /dev/null +++ b/tests/mo_testing_utils.F90 @@ -0,0 +1,276 @@ +! This code is part of Radiative Transfer for Energetics (RTE) +! +! Contacts: Robert Pincus and Eli Mlawer +! email: rrtmgp@aer.com +! +! Copyright 2023- Atmospheric and Environmental Research, +! Regents of the University of Colorado, +! Trustees of Columbia University in the City of New York +! All right reserved. +! +! Use and duplication is permitted under the terms of the +! BSD 3-clause license, see http://opensource.org/licenses/BSD-3-Clause +! ---------------------------------------------------------------------------- +module mo_testing_utils + use iso_fortran_env, only: error_unit + use mo_rte_kind, only: wp + use mo_rte_util_array, only: zero_array + use mo_optical_props, only: ty_optical_props_arry, ty_optical_props_1scl, & + ty_optical_props_2str, ty_optical_props_nstr + use mo_source_functions, only: ty_source_func_lw + implicit none + private + public :: allclose, ops_match, check_fluxes + public :: stop_on_err, report_err + public :: increment_with_1scl, increment_with_2str, increment_with_nstr, vr + + interface allclose + module procedure allclose_1, allclose_2, allclose_3, allclose_4 + end interface allclose + + interface ops_match + module procedure ops_match_1scl, ops_match_2str, ops_match_nstr + end interface ops_match + + interface check_fluxes + module procedure check_fluxes_1pair, check_fluxes_2pair + end interface check_fluxes +contains + ! ---------------------------------------------------------------------------- + ! + ! Compare two arrays; return false if abs(x-y) > tol*spacing(x) for any element + ! + ! ---------------------------------------------------------------------------- + logical function allclose_1(tst_array, ref_array, tol) + real(wp), dimension(:), intent(in) :: tst_array, ref_array + real(wp), optional, intent(in) :: tol + + real(wp) :: tolerance + if (present(tol)) then + tolerance = tol + else + tolerance = 2._wp + end if + + allclose_1 = all(abs(tst_array-ref_array) <= tolerance * spacing(ref_array)) + end function allclose_1 + ! ---------------------------------------------------------------------------- + logical function allclose_2(tst_array, ref_array, tol) + real(wp), dimension(:,:), intent(in) :: tst_array, ref_array + real(wp), optional, intent(in) :: tol + + real(wp) :: tolerance + if (present(tol)) then + tolerance = tol + else + tolerance = 2._wp + end if + + allclose_2= all(abs(tst_array-ref_array) <= tolerance * spacing(ref_array)) + end function allclose_2 + ! ---------------------------------------------------------------------------- + logical function allclose_3(tst_array, ref_array, tol) + real(wp), dimension(:,:,:), intent(in) :: tst_array, ref_array + real(wp), optional, intent(in) :: tol + + real(wp) :: tolerance + if (present(tol)) then + tolerance = tol + else + tolerance = 2._wp + end if + + allclose_3= all(abs(tst_array-ref_array) <= tolerance * spacing(ref_array)) + end function allclose_3 + ! ---------------------------------------------------------------------------- + logical function allclose_4(tst_array, ref_array, tol) + real(wp), dimension(:,:,:,:), intent(in) :: tst_array, ref_array + real(wp), optional, intent(in) :: tol + + real(wp) :: tolerance + if (present(tol)) then + tolerance = tol + else + tolerance = 2._wp + end if + + allclose_4= all(abs(tst_array-ref_array) <= tolerance * spacing(ref_array)) + end function allclose_4 + ! ---------------------------------------------------------------------------- + ! + ! Compare two sets of optical properties; return false if abs(x-y) > tol*spacing(x) for any element + ! + ! ---------------------------------------------------------------------------- + logical function ops_match_1scl(tst_values, ref_values, tol) + class(ty_optical_props_1scl), intent(in) :: tst_values, ref_values + real(wp), optional, intent(in) :: tol + + ops_match_1scl = allclose(tst_values%tau, ref_values%tau, tol) + end function ops_match_1scl + ! ---------------------------------------------------------------------------- + logical function ops_match_2str(tst_values, ref_values, tol) + class(ty_optical_props_2str), intent(in) :: tst_values, ref_values + real(wp), optional, intent(in) :: tol + + ops_match_2str = allclose(tst_values%tau, ref_values%tau, tol) .and. & + allclose(tst_values%ssa, ref_values%ssa, tol) .and. & + allclose(tst_values%g , ref_values%g , tol) + end function ops_match_2str + ! ---------------------------------------------------------------------------- + logical function ops_match_nstr(tst_values, ref_values, tol) + class(ty_optical_props_nstr), intent(in) :: tst_values, ref_values + real(wp), optional, intent(in) :: tol + + ops_match_nstr = allclose(tst_values%tau, ref_values%tau, tol) .and. & + allclose(tst_values%ssa, ref_values%ssa, tol) .and. & + allclose(tst_values%p , ref_values%p , tol) + end function ops_match_nstr + ! ---------------------------------------------------------------------------- + + ! ---------------------------------------------------------------------------- + ! + ! Error report - print to screen with or without exit + ! + ! ---------------------------------------------------------------------------- + subroutine report_err(error_msg) + use iso_fortran_env, only : error_unit + character(len=*), intent(in) :: error_msg + + if(error_msg /= "") then + write (error_unit,*) trim(error_msg) + end if + end subroutine report_err + ! ---------------------------------------------------------------------------- + subroutine stop_on_err(error_msg) + use iso_fortran_env, only : error_unit + character(len=*), intent(in) :: error_msg + + if(error_msg /= "") then + write (error_unit,*) trim(error_msg) + write (error_unit,*) "unit tests stopping" + error stop 1 + end if + end subroutine stop_on_err + ! ---------------------------------------------------------------------------- + subroutine check_fluxes_1pair(flux_1, flux_2, status, message) + real(wp), dimension(:,:), intent(in) :: flux_1, flux_2 + logical :: status + character(len=*), intent(in) :: message + + if(.not. allclose(flux_1, flux_2)) then + status = .false. + print *, "check_fluxes: max diffs rel. to scaling: ", & + maxval(abs(flux_1 - flux_2)/spacing(flux_1)) + call report_err(" " // trim(message)) + end if + end subroutine check_fluxes_1pair + ! ---------------------------------------------------------------------------- + subroutine check_fluxes_2pair(flux_1, flux_2, flux_3, flux_4, status, message) + real(wp), dimension(:,:), intent(in) :: flux_1, flux_2, flux_3, flux_4 + logical :: status + character(len=*), intent(in) :: message + + if(.not. (allclose(flux_1, flux_2) .and. & + allclose(flux_3, flux_4))) then + status = .false. + print *, "check_fluxes: max diffs rel. to scaling: ", & + maxval(abs(flux_1 - flux_2)/spacing(flux_1)), & + maxval(abs(flux_3 - flux_4)/spacing(flux_3)) + call report_err(" " // trim(message)) + end if + end subroutine check_fluxes_2pair + ! ---------------------------------------------------------------------------- + ! + ! Adding transparent (tau = 0) optical properties + ! These routines test allocation, validation, incrementing, and + ! finalization for optical properties + ! Fluxes should not change + ! Should these be extended to test end-to-end with GPUs? + ! + ! ---------------------------------------------------------------------------- + subroutine increment_with_1scl(atmos) + class(ty_optical_props_arry), intent(inout) :: atmos + + ! Local variable + type(ty_optical_props_1scl) :: transparent + integer :: ncol, nlay, ngpt + ncol = atmos%get_ncol() + nlay = atmos%get_nlay() + ngpt = atmos%get_ngpt() + + call stop_on_err(transparent%alloc_1scl(ncol, nlay, atmos)) + call zero_array (ncol, nlay, ngpt, transparent%tau) + call stop_on_err(transparent%increment(atmos)) + call stop_on_err(atmos%validate()) + call transparent%finalize() + end subroutine increment_with_1scl + ! ------- + subroutine increment_with_2str(atmos) + class(ty_optical_props_arry), intent(inout) :: atmos + + ! Local variable + type(ty_optical_props_2str) :: transparent + integer :: ncol, nlay, ngpt + ncol = atmos%get_ncol() + nlay = atmos%get_nlay() + ngpt = atmos%get_ngpt() + + call stop_on_err(transparent%alloc_2str(ncol, nlay, atmos)) + call zero_array (ncol, nlay, ngpt, transparent%tau) + call zero_array (ncol, nlay, ngpt, transparent%ssa) + call zero_array (ncol, nlay, ngpt, transparent%g) + call stop_on_err(transparent%increment(atmos)) + call stop_on_err(atmos%validate()) + call transparent%finalize() + end subroutine increment_with_2str + ! ------- + subroutine increment_with_nstr(atmos) + class(ty_optical_props_arry), intent(inout) :: atmos + + ! Local variable + type(ty_optical_props_nstr) :: transparent + integer, parameter :: nmom = 4 + integer :: ncol, nlay, ngpt + ncol = atmos%get_ncol() + nlay = atmos%get_nlay() + ngpt = atmos%get_ngpt() + + call stop_on_err(transparent%alloc_nstr(nmom, ncol, nlay, atmos)) + call zero_array ( ncol, nlay, ngpt, transparent%tau) + call zero_array ( ncol, nlay, ngpt, transparent%ssa) + call zero_array (nmom, ncol, nlay, ngpt, transparent%p) + call stop_on_err(transparent%increment(atmos)) + call stop_on_err(atmos%validate()) + call transparent%finalize() + end subroutine increment_with_nstr + ! ---------------------------------------------------------------------------- + ! + ! Vertically reverse optical properties + ! + subroutine vr(atmos, sources) + class(ty_optical_props_arry), intent(inout) :: atmos + type(ty_source_func_lw), optional, & + intent(inout) :: sources + + integer :: nlay + ! ----------------------- + nlay = atmos%get_nlay() + + atmos%tau(:,:,:) = atmos%tau(:,nlay:1:-1,:) + + select type (atmos) + type is (ty_optical_props_2str) + atmos%ssa(:,:,:) = atmos%ssa(:,nlay:1:-1,:) + atmos%g (:,:,:)= atmos%g (:,nlay:1:-1,:) + type is (ty_optical_props_nstr) + atmos%ssa(:,:,:) = atmos%ssa(:,nlay:1:-1,:) + atmos%p(:,:,:,:) = atmos%p(:,:,nlay:1:-1,:) + end select + + if(present(sources)) then + sources%lev_source(:,:,:) = sources%lev_source(:,nlay+1:1:-1,:) + sources%lay_source(:,:,:) = sources%lay_source(:,nlay :1:-1,:) + end if + end subroutine vr + ! ---------------------------------------------------------------------------- +end module mo_testing_utils diff --git a/tests/rte_lw_solver_unit_tests.F90 b/tests/rte_lw_solver_unit_tests.F90 new file mode 100644 index 000000000..fc18afc44 --- /dev/null +++ b/tests/rte_lw_solver_unit_tests.F90 @@ -0,0 +1,383 @@ +! This code is part of Radiative Transfer for Energetics (RTE) +! +! Contacts: Robert Pincus and Eli Mlawer +! email: rrtmgp@aer.com +! +! Copyright 2023- Atmospheric and Environmental Research, +! Regents of the University of Colorado, +! Trustees of Columbia University in the City of New York +! All right reserved. +! +! Use and duplication is permitted under the terms of the +! BSD 3-clause license, see http://opensource.org/licenses/BSD-3-Clause +! ---------------------------------------------------------------------------- +program rte_lw_solver_unit_tests + ! + ! Exercise various paths through RTE LW solvers + ! Tests are run on an idealized problem (radiative equilibirum) + ! and checked for correctness against known analytic solution + ! Beyond correctness tests check invariance, e.g. with respect to vertical ordering + ! + use mo_rte_kind, only: wp + use mo_optical_props, only: ty_optical_props, & + ty_optical_props_arry, & + ty_optical_props_1scl, ty_optical_props_2str, ty_optical_props_nstr + use mo_rte_util_array, only: zero_array + use mo_source_functions, only: ty_source_func_lw + use mo_fluxes, only: ty_fluxes_broadband + use mo_rte_lw, only: rte_lw + use mo_testing_utils, only: allclose, stop_on_err, report_err, check_fluxes, & + vr, & + increment_with_1scl, increment_with_2str, increment_with_nstr + implicit none + ! ---------------------------------------------------------------------------------- + ! + ! Longwave tests use gray radiative equilibrium from + ! e.g. Weaver and Rmanathan 1995 https://doi.org/10.1029/95JD00770 + ! Net flux is constant with height, OLR is known from surface temperature + ! Tests include + ! Solutions match analytic results + ! Net fluxes = down-up when computed in various combos (net only, up/down only, all three) + ! using ty_broadband_flues + ! Answers are invariant to + ! Extracting subsets + ! Vertical orientation + ! Adding transparent optical properties + ! Longwave specific tests: + ! Computing the Jacibian doesn't change fluxes + ! Fluxes inferred from Jacobian are close to fluxes with perturbed surface T. (TODO) + ! + ! Other possibilites: + ! Vertical discretization? Maybe just check boundary fluxes + ! Test the application of the boundary condition? + + real(wp), parameter :: pi = acos(-1._wp) + integer, parameter :: ncol = 8, nlay = 16 + integer :: icol, ilay + ! + ! Longwave tests - gray radiative equilibrium + ! + real(wp), parameter :: sigma = 5.670374419e-8_wp, & ! Stefan-Boltzmann constant + D = 1.66_wp ! Diffusivity angle, from single-angle RRTMGP solver + real(wp), dimension( ncol), parameter :: sfc_t = [(285._wp, icol = 1,ncol/2), & + (310._wp, icol = 1,ncol/2)] + real(wp), dimension( ncol), parameter :: total_tau = [0.1_wp, 1._wp, 10._wp, 50._wp, & + 0.1_wp, 1._wp, 10._wp, 50._wp] ! Would be nice to parameterize + real(wp), dimension(1,ncol), parameter :: sfc_emis = 1._wp + real(wp), dimension(ncol,1), parameter :: lw_Ds = D ! Diffusivity angle - use default value for all columns + + type(ty_optical_props_1scl) :: lw_atmos + type(ty_source_func_lw) :: lw_sources + type(ty_optical_props_2str) :: sw_atmos + type(ty_fluxes_broadband) :: fluxes + logical :: top_at_1 + real(wp), dimension(ncol,nlay+1), target :: & + ref_flux_up, ref_flux_dn, ref_flux_net, & + tst_flux_up, tst_flux_dn, tst_flux_net, & + jFluxUp + + logical :: passed + + ! ------------------------------------------------------------------------------------------------------ + top_at_1 = .true. + ! ------------------------------------------------------------------------------------------------------ + ! + ! Longwave tests + ! + ! ------------------------------------------------------------------------------------------------------ + print *, "RTE LW solver unit tests" + ! + ! Gray radiative equillibrium + ! + print *, "Using gray radiative equilibrium" + call gray_rad_equil(sfc_t(1:ncol), total_tau(1:ncol), nlay, top_at_1, lw_atmos, lw_sources) + + fluxes%flux_up => ref_flux_up (:,:) + fluxes%flux_dn => ref_flux_dn (:,:) + fluxes%flux_net => ref_flux_net(:,:) + call stop_on_err(rte_lw(lw_atmos, top_at_1, & + lw_sources, & + sfc_emis, & + fluxes)) + ! + ! Is the solution correct (does it satisfy the profile for radiative equilibrium?) + ! Error reporting happens inside check_gray_rad_equil() + ! + passed = check_gray_rad_equil(sfc_t, total_tau, top_at_1, ref_flux_up, ref_flux_net) + ! ------------------------------------------------------------------------------------ + ! + ! Net fluxes on- vs off-line + ! Are the net fluxes correct? + ! + print *, " Net flux variants" + call check_fluxes(ref_flux_net, ref_flux_dn-ref_flux_up, passed, "net fluxes don't match down-up") + ! + ! Compute only net fluxes + ! + nullify(fluxes%flux_up) + nullify(fluxes%flux_dn) + call stop_on_err(rte_lw(lw_atmos, top_at_1, & + lw_sources, sfc_emis,& + fluxes)) + call check_fluxes(ref_flux_net, ref_flux_dn-ref_flux_up, & + passed, "Net fluxes computed alone doesn'tt match down-up computed separately") + ! + ! Compute only up and down fluxes + ! + fluxes%flux_up => tst_flux_up (:,:) + fluxes%flux_dn => tst_flux_dn (:,:) + call stop_on_err(rte_lw(lw_atmos, top_at_1, & + lw_sources, sfc_emis, & + fluxes)) + call check_fluxes(ref_flux_net, tst_flux_dn-tst_flux_up, & + passed, "LW net fluxes don't match down-up computed together") + ! ------------------------------------------------------- + ! + ! Subsets of atmospheric columns + ! + print *, " Subsetting invariance" + call gray_rad_equil(sfc_t, total_tau, nlay, top_at_1, lw_atmos, lw_sources) + call clear_sky_subset(lw_atmos, lw_sources, sfc_emis, tst_flux_up, tst_flux_dn) + call check_fluxes(tst_flux_up, ref_flux_up, & + tst_flux_dn, ref_flux_dn, & + passed, "Doing problem in subsets fails") + + ! ------------------------------------------------------- + ! + ! Vertically-reverse + ! + print *, " Vertical orientation invariance" + call gray_rad_equil(sfc_t, total_tau, nlay, top_at_1, lw_atmos, lw_sources) + call vr(lw_atmos, lw_sources) + call stop_on_err(rte_lw(lw_atmos, .not. top_at_1, & + lw_sources, sfc_emis, & + fluxes)) + ! + ! Seems like these fluxes should be bitwise identical regardless of orientation + ! but nvfortran 22.5 on Levante has differences of up to 3*spacing() + ! + if (.not. allclose(tst_flux_up(:,nlay+1:1:-1), ref_flux_up) .and. & + allclose(tst_flux_dn(:,nlay+1:1:-1), ref_flux_dn, tol=3._wp)) then + passed = .false. + call report_err(" " // "Doing problem upside down fails") + end if + call vr(lw_atmos, lw_sources) + ! ------------------------------------------------------- + ! + ! Computing Jacobian shouldn't change net fluxes + ! + print *, " Jacobian" + call gray_rad_equil(sfc_t, total_tau, nlay, top_at_1, lw_atmos, lw_sources) + call stop_on_err(rte_lw(lw_atmos, top_at_1, & + lw_sources, & + sfc_emis, & + fluxes, & + flux_up_Jac = jFluxUp)) + call check_fluxes(tst_flux_up, ref_flux_up, tst_flux_dn, ref_flux_dn, & + passed, "Computing Jacobian changes fluxes fails") + ! + ! Increase surface temperature in source function by 1K and recompute fluxes + ! + lw_sources%sfc_source (:,1) = sigma/pi * (sfc_t + 1._wp)**4 + lw_sources%sfc_source_Jac(:,1) = 4._wp * sigma/pi * (sfc_t + 1._wp)**3 + call stop_on_err(rte_lw(lw_atmos, top_at_1, & + lw_sources, & + sfc_emis, & + fluxes)) + ! + ! Comparision of fluxes with increased surface T aren't expected to match + ! fluxes + their Jacobian w.r.t. surface T exactly + ! + print '(" Jacobian accurate to within ", f6.2, "%")', & + maxval((tst_flux_up - ref_flux_up + jFluxUp)/tst_flux_up * 100._wp) + ! ------------------------------------------------------------------------------------ + ! + ! Using Tang approach for purely absorbing problem should be the same + ! + print *, " Two-stream optical properties" + call gray_rad_equil(sfc_t, total_tau, nlay, top_at_1, lw_atmos, lw_sources) + call stop_on_err(sw_atmos%alloc_2str(ncol, nlay, lw_atmos)) + sw_atmos%tau = lw_atmos%tau + sw_atmos%ssa = 0._wp + sw_atmos%g = 0._wp + + call stop_on_err(rte_lw(sw_atmos, top_at_1, & + lw_sources, & + sfc_emis, & + fluxes, & + flux_up_Jac = jFluxUp)) + call check_fluxes(tst_flux_up, ref_flux_up, tst_flux_dn, ref_flux_dn, & + passed, "Using two-stream properties fails") + call sw_atmos%finalize() + ! ------------------------------------------------------------------------------------ + ! + ! Specifying diffusivity angle + ! + print *, " Specified transport angle" + call stop_on_err(rte_lw(lw_atmos, top_at_1, & + lw_sources, & + sfc_emis, & + fluxes, & + lw_Ds = lw_Ds)) + call check_fluxes(tst_flux_up, ref_flux_up, tst_flux_dn, ref_flux_dn, & + passed, "Specifying diffusivity angle D fails") + + ! ------------------------------------------------------------------------------------ + ! Done + ! + print *, "RTE LW solver unit tests done" + print * + if(.not. passed) error stop 1 + ! ------------------------------------------------------------------------------------ +contains + ! ------------------------------------------------------------------------------------ + ! + ! Define an atmosphere in gray radiative equillibrium + ! See, for example, section 2 of Weaver and Rmanathan 1995 https://doi.org/10.1029/95JD00770 + ! + subroutine gray_rad_equil(sfc_t, total_tau, nlay, top_at_1, atmos, sources) + real(wp), dimension(:), intent(in) :: sfc_t, total_tau + integer, intent(in) :: nlay + logical, intent(in) :: top_at_1 + type(ty_optical_props_1scl), intent(inout) :: atmos + type(ty_source_func_lw), intent(inout) :: sources + + integer :: ncol + real(wp), dimension(size(sfc_t)) :: olr + + ncol = size(sfc_t) + ! + ! Set up a gray spectral distribution - one band, one g-point + ! + call stop_on_err(atmos%init(band_lims_wvn = reshape([0._wp, 3250._wp], shape = [2, 1]), & + band_lims_gpt = reshape([1, 1], shape = [2, 1]), & + name = "Gray atmosphere")) + call stop_on_err(atmos%alloc_1scl(ncol, nlay)) + + ! + ! Divide optical depth evenly among layers + ! + atmos%tau(1:ncol,1:nlay,1) = spread(total_tau(1:ncol)/real(nlay, wp), dim=2, ncopies=nlay) + + ! + ! Longwave sources - for broadband these are sigma/pi T^4 + ! (isotropic radiation) + ! + olr(:) = gray_rad_equil_olr(sfc_t, total_tau) + + call stop_on_err(sources%alloc(ncol, nlay, atmos)) + sources%sfc_source (:,1) = sigma/pi * sfc_t**4 + sources%sfc_source_Jac(:,1) = 4._wp * sigma/pi * sfc_t**3 + ! + ! Calculation with top_at_1 + ! + ilay = 1 + sources%lev_source(:,ilay, 1) = 0.5_wp/pi * olr(:) + do ilay = 2, nlay+1 + sources%lev_source(:,ilay, 1) = 0.5_wp/pi * olr(:) * & + (1._wp + D * sum(atmos%tau(:,:ilay-1,1),dim=2)) + ! + ! The source is linear in optical depth so layer source is average of edges + ! + sources%lay_source(:,ilay-1,1) = 0.5_wp * (sources%lev_source(:,ilay, 1) + & + sources%lev_source(:,ilay-1,1)) + end do + if (.not. top_at_1) then + ! + ! Reverse vertical ordering of source functions + ! + sources%lev_source(:,1:nlay+1,1) = sources%lev_source(:,nlay+1:1:-1,1) + sources%lay_source(:,1:nlay, 1) = sources%lay_source(:,nlay :1:-1,1) + end if + end subroutine gray_rad_equil + ! ------------------------------------------------------------------------------------ + ! + ! Check that solutions are in gray radiative equilibrium + ! We could use this to check heating rates but we'd have to make up pressure levels... + ! + function check_gray_rad_equil(sfc_T, lw_tau, top_at_1, up_flux, net_flux) + real(wp), dimension(:), intent(in) :: sfc_T, lw_tau + real(wp), dimension(:,:), intent(in) :: up_flux, net_flux + logical, intent(in) :: top_at_1 + logical :: check_gray_rad_equil + + logical :: passed + integer :: toa + ! ------------------------------ + check_gray_rad_equil = .true. + toa = merge(1, size(up_flux, 2), top_at_1) + + ! + ! Check top-of-atmosphere energy balance + ! + if(.not. allclose(up_flux(:,toa), & + gray_rad_equil_olr(sfc_t, lw_tau), tol=4._wp)) then + call report_err("OLR is not consistent with gray radiative equilibrium") + check_gray_rad_equil = .false. + end if + ! + ! Check that net fluxes are constant with height + ! Fairly relaxed threshold w.r.t. spacing() because net flux is small relative to + ! large up and down fluxes that vary with tau + ! + if(.not. allclose(net_flux(:,:), & + spread(net_flux(:,1), dim=2, ncopies=size(net_flux,2)), & + tol = 70._wp)) then + call report_err("Net flux not constant with tau in gray radiative equilibrium") + check_gray_rad_equil = .false. + end if + end function check_gray_rad_equil + ! ------------------------------------------------------------------------------------ + ! + ! Incoming energy = OLR in gray radiative equilibirum + ! Equation 6b of Weaver and Rmanathan 1995 https://doi.org/10.1029/95JD00770 with with f0 = OLR + ! + function gray_rad_equil_olr(T, tau) + real(wp), dimension(:), intent(in) :: T, tau + real(wp), dimension(size(T)) :: gray_rad_equil_olr + + gray_rad_equil_olr(:) = (2._wp * sigma * T(:)**4)/(2 + D * tau(:)) + end function gray_rad_equil_olr + ! ------------------------------------------------------------------------------------ + ! + ! Invariance tests + ! + ! ------------------------------------------------------------------------------------ + ! + ! Clear-sky longwave fluxes, half the columns at a time + ! We're counting on ncol being even + ! + subroutine clear_sky_subset(atmos, sources, sfc_emis, flux_up, flux_dn) + type(ty_optical_props_1scl), intent(inout) :: atmos + type(ty_source_func_lw), intent(inout) :: sources + real(wp), dimension(:,:), intent(in ) :: sfc_emis + real(wp), dimension(:,:), intent( out) :: flux_up, flux_dn + + type(ty_optical_props_1scl) :: atmos_subset + type(ty_source_func_lw) :: sources_subset + type(ty_fluxes_broadband) :: fluxes ! Use local variable + real(wp), dimension(atmos%get_ncol()/2, & + atmos%get_nlay()+1), target & + :: up, dn + integer :: i, colS, colE + integer :: ncol + ! ------------------------------ + ncol = atmos%get_ncol() + call stop_on_err(atmos_subset%init(atmos)) + fluxes%flux_up => up + fluxes%flux_dn => dn + + do i = 1, 2 + colS = ((i-1) * ncol/2) + 1 + colE = i * ncol/2 + call stop_on_err(atmos%get_subset (colS, ncol/2, atmos_subset)) + call stop_on_err(sources%get_subset(colS, ncol/2, sources_subset)) + call stop_on_err(rte_lw(atmos_subset, top_at_1, & + sources_subset, & + sfc_emis(:,colS:colE), & + fluxes)) + flux_up(colS:colE,:) = up + flux_dn(colS:colE,:) = dn + end do + end subroutine clear_sky_subset +end program rte_lw_solver_unit_tests \ No newline at end of file diff --git a/tests/rte_optic_prop_unit_tests.F90 b/tests/rte_optic_prop_unit_tests.F90 new file mode 100644 index 000000000..4fea31ff5 --- /dev/null +++ b/tests/rte_optic_prop_unit_tests.F90 @@ -0,0 +1,231 @@ +! This code is part of Radiative Transfer for Energetics (RTE) +! +! Contacts: Robert Pincus and Eli Mlawer +! email: rrtmgp@aer.com +! +! Copyright 2023- Atmospheric and Environmental Research, +! Regents of the University of Colorado, +! Trustees of Columbia University in the City of New York +! All right reserved. +! +! Use and duplication is permitted under the terms of the +! BSD 3-clause license, see http://opensource.org/licenses/BSD-3-Clause +! ---------------------------------------------------------------------------- +program optical_prop_unit_tests + ! + ! Unit tests for RTE optical properties + ! Incrementing with tranparent medium (tau=0) doesn't change optical props + ! + use mo_rte_kind, only: wp + use mo_optical_props, only: ty_optical_props_arry, & + ty_optical_props_1scl, ty_optical_props_2str, ty_optical_props_nstr + use mo_rte_util_array, only: zero_array + use mo_testing_utils, only: allclose, ops_match, stop_on_err, report_err, & + increment_with_1scl, increment_with_2str, increment_with_nstr + + type(ty_optical_props_1scl) :: ref_1scl, tst_1scl + type(ty_optical_props_2str) :: ref_2str, tst_2str + type(ty_optical_props_nstr) :: ref_nstr, tst_nstr + integer, parameter :: ncol = 4, nlay = 8, nmom = 4 + integer :: icol, ilay, imom + logical :: passed + real(wp), dimension( ncol), parameter :: total_tau = [0.1_wp, 1._wp, 10._wp, 50._wp] + real(wp), parameter :: g = 0.85_wp, ssa = 1._wp - 1.e-4_wp + ! ---------------------------------------------------------------------------- + print *, "Optical properties unit testing" + ! + ! Set up a gray spectral distribution - one band, one g-point + ! + call stop_on_err(ref_1scl%init(band_lims_wvn = reshape([0._wp, 3250._wp], shape = [2, 1]), & + band_lims_gpt = reshape([1, 1], shape = [2, 1]), & + name = "Gray atmosphere")) + call stop_on_err(ref_1scl%alloc_1scl(ncol, nlay)) + print '(" Problem size: (ncol, nlay, nband, ngpt): ", 4(i2, 2x))', & + ref_1scl%get_ncol(), ref_1scl%get_nlay(), ref_1scl%get_nband(), ref_1scl%get_ngpt() + ! + ! Divide optical depth evenly among layers + ! + ref_1scl%tau(1:ncol,1:nlay,1) = spread(total_tau(1:ncol)/real(nlay, wp), dim=2, ncopies=nlay) + ! + ! 2- and n-stream optical properties + ! + call stop_on_err(ref_2str%alloc_2str(ncol, nlay, ref_1scl)) + ref_2str%tau = ref_1scl%tau + ref_2str%ssa = ssa + ref_2str%g = g + + call stop_on_err(ref_nstr%alloc_nstr(nmom, ncol, nlay, ref_1scl)) + ref_nstr%tau = ref_1scl%tau + ref_nstr%ssa = ssa + ! Henyey-Greenstein phase function + do imom = 1, nmom + ref_nstr%p(imom,:,:,:) = g**imom + end do + + passed = .true. + ! ---------------------------------------------------------------------------- + ! + ! Incrementing with transparent (tau=0) sets of optical properties + ! + ! ---------------------------------------------------------------------------- + print *, " Incrementing 1scl" + ! + ! Increment 1scl + ! + call make_copy_1scl + call increment_with_1scl(tst_1scl) + if(.not. ops_match(tst_1scl, ref_1scl)) then + call report_err("1scl+1scl fails") + passed = .false. + end if + + call make_copy_1scl + call increment_with_2str(tst_1scl) + if(.not. ops_match(tst_1scl, ref_1scl)) then + call report_err("1scl+2str fails") + passed = .false. + end if + + call make_copy_1scl + call increment_with_nstr(tst_1scl) + if(.not. ops_match(tst_1scl, ref_1scl)) then + call report_err("1scl+nstr fails") + passed = .false. + end if + + call tst_1scl%finalize() + ! ---------------------------------------------------------------------------- + print *, " Incrementing 2str" + ! + ! Increment 2str + ! + call make_copy_2str + call increment_with_1scl(tst_2str) + if(.not. ops_match(tst_2str, ref_2str)) then + call report_err("2str+1scl fails") + passed = .false. + end if + + call make_copy_2str + call increment_with_2str(tst_2str) + if(.not. ops_match(tst_2str, ref_2str)) then + call report_err("2str+2str fails") + passed = .false. + end if + + call make_copy_2str + call increment_with_nstr(tst_2str) + if(.not. ops_match(tst_2str, ref_2str)) then + call report_err("2str+nstr fails") + passed = .false. + end if + + call tst_2str%finalize() + ! ---------------------------------------------------------------------------- + print *, " Incrementing nstr" + ! + ! Increment nstr + ! + call make_copy_nstr + call increment_with_1scl(tst_nstr) + if(.not. ops_match(tst_nstr, ref_nstr)) then + call report_err("nstr+1scl fails") + passed = .false. + end if + + call make_copy_nstr + call increment_with_2str(tst_nstr) + if(.not. ops_match(tst_nstr, ref_nstr)) then + call report_err("nstr+2str fails") + passed = .false. + end if + + call make_copy_nstr + call increment_with_nstr(tst_nstr) + if(.not. ops_match(tst_nstr, ref_nstr)) then + call report_err("nstr+nstr fails") + passed = .false. + end if + + call tst_2str%finalize() + ! ---------------------------------------------------------------------------- + print *, " Halving/doubling optical thickness" + ! + ! Adding two media of half optical thickness to recover original values + ! + call make_copy_1scl + tst_1scl%tau = 0.5_wp * tst_1scl%tau + call stop_on_err(tst_1scl%increment(tst_1scl)) + if(.not. ops_match(tst_1scl, ref_1scl)) then + call report_err("1scl half/double fails") + passed = .false. + end if + + call make_copy_2str + tst_2str%tau = 0.5_wp * tst_2str%tau + call stop_on_err(tst_2str%increment(tst_2str)) + if(.not. ops_match(tst_2str, ref_2str)) then + call report_err("2str half/double fails") + passed = .false. + end if + + call make_copy_nstr + tst_nstr%tau = 0.5_wp * tst_nstr%tau + call stop_on_err(tst_nstr%increment(tst_nstr)) + if(.not. ops_match(tst_nstr, ref_nstr)) then + call report_err("nstr half/double fails") + passed = .false. + end if + ! ---------------------------------------------------------------------------- + print *, " Delta scaling" + ! + ! Delta-scale with forward-fraction f=0 (i.e. Rayleigh scattering) + ! + call make_copy_2str + call stop_on_err(tst_2str%delta_scale(spread(spread(spread(0._wp, 1, ncol), 2, nlay), 3, 1))) + if(.not. ops_match(tst_2str, ref_2str)) then + call report_err("2str delta-scaling with f=0 fails") + passed = .false. + end if + ! ---------------------------------------------------------------------------- + if (.not. passed) call stop_on_err("Optical props unit tests fail") + print *, "Optical properties unit testing finished" + print * + ! ---------------------------------------------------------------------------- +contains + ! ---------------------------------------------------------------------------- + ! + ! Make copies of the existing optical depth + ! + subroutine make_copy_1scl + call tst_1scl%finalize() + call stop_on_err(tst_1scl%alloc_1scl(ref_1scl%get_ncol(), ref_1scl%get_nlay(), & + ref_1scl)) + tst_1scl%tau = ref_1scl%tau + end subroutine make_copy_1scl + ! ---------------------------------------------------------------------------- + ! + ! Make copies of the existing optical depth + ! + subroutine make_copy_2str + call tst_2str%finalize() + call stop_on_err(tst_2str%alloc_2str(ref_2str%get_ncol(), ref_2str%get_nlay(), & + ref_2str)) + tst_2str%tau = ref_2str%tau + tst_2str%ssa = ref_2str%ssa + tst_2str%g = ref_2str%g + end subroutine make_copy_2str + ! ---------------------------------------------------------------------------- + ! + ! Make copies of the existing optical depth + ! + subroutine make_copy_nstr + call tst_nstr%finalize() + call stop_on_err(tst_nstr%alloc_nstr(ref_nstr%get_nmom(), ref_nstr%get_ncol(), ref_nstr%get_nlay(), & + ref_2str)) + tst_nstr%tau = ref_nstr%tau + tst_nstr%ssa = ref_nstr%ssa + tst_nstr%p = ref_nstr%p + end subroutine make_copy_nstr + ! ---------------------------------------------------------------------------- +end program optical_prop_unit_tests \ No newline at end of file diff --git a/tests/rte_sw_solver_unit_tests.F90 b/tests/rte_sw_solver_unit_tests.F90 new file mode 100644 index 000000000..196fd1f4a --- /dev/null +++ b/tests/rte_sw_solver_unit_tests.F90 @@ -0,0 +1,346 @@ +! This code is part of Radiative Transfer for Energetics (RTE) +! +! Contacts: Robert Pincus and Eli Mlawer +! email: rrtmgp@aer.com +! +! Copyright 2023- Atmospheric and Environmental Research, +! Regents of the University of Colorado, +! Trustees of Columbia University in the City of New York +! All right reserved. +! +! Use and duplication is permitted under the terms of the +! BSD 3-clause license, see http://opensource.org/licenses/BSD-3-Clause +! ---------------------------------------------------------------------------- +program rte_sw_solver_unit_tests + ! + ! Exercise various paths through RTE code including solvers, optical properties, fluxes + ! Tests are run on idealized problems with analytic solutions (e.g. radiative equilibrium) + ! Solutions are checked for correctness where possible + ! Some tests check invariance, e.g. with respect to vertical ordering + ! + use mo_rte_kind, only: wp + use mo_optical_props, only: ty_optical_props, & + ty_optical_props_arry, & + ty_optical_props_1scl, ty_optical_props_2str, ty_optical_props_nstr + use mo_rte_util_array, only: zero_array + use mo_fluxes, only: ty_fluxes_broadband + use mo_rte_sw, only: rte_sw + use mo_testing_utils, only: allclose, stop_on_err, report_err, check_fluxes, & + vr, & + increment_with_1scl, increment_with_2str, increment_with_nstr + implicit none + ! ---------------------------------------------------------------------------------- + ! + ! Exercise various paths through RTE SW solvers + ! For the moment tests are run using thin, scattering, gray atmospheres + ! and checked for correctness against known analytic solution (not a great approximation) + ! Beyond correctness tests check invariance, e.g. with respect to vertical ordering + ! Tests include + ! Net fluxes = down-up when computed in various combos (net only, up/down only, all three) + ! using ty_broadband_fluxes + ! Answers are invariant to + ! Extracting subsets + ! Vertical orientation + ! Adding transparent optical properties + ! Shortwave specific tests: + ! Solutions are linear in TOA flux + ! + ! Other possibilites: + ! Vertical discretization? Maybe just check boundary fluxes + ! Test the application of the boundary condition? + + real(wp), parameter :: pi = acos(-1._wp) + integer, parameter :: ncol = 8, nlay = 16 + integer, parameter :: nmu0 = 2 + integer :: icol, ilay, imu0 + + ! + ! Shorteave tests - thin atmosphere + ! + real(wp), dimension(2), parameter :: g = [0.85_wp, 0.65_wp], & + tau = [1.e-4_wp, 1.e-2_wp], & + ssa = 1._wp - & + [1.e-4_wp, 1.e-2_wp] + real(wp), dimension(nmu0), parameter :: mu0 = [1._wp, 0.5_wp] + real(wp), dimension(1,ncol), parameter :: sfc_albedo = 0._wp + real(wp), dimension(ncol,1), parameter :: toa_flux = 1._wp + real(wp), parameter :: factor = 2._wp ! for checking linearity + real(wp), dimension(ncol) :: mu0_arr + + type(ty_optical_props_2str) :: atmos + type(ty_fluxes_broadband) :: fluxes + logical :: top_at_1 + real(wp), dimension(ncol,nlay+1), target :: & + ref_flux_up, ref_flux_dn, ref_flux_dir, ref_flux_net, & + tst_flux_up, tst_flux_dn, tst_flux_dir, tst_flux_net +#ifdef __NVCOMPILER + ! We need the following temporary variables to circumvent the -Mbounds issue: + real(wp), dimension(ncol, nlay+1) :: tst_flux_up_reversed, ref_flux_dn_reversed +#endif + real(wp), dimension(:), pointer :: sfc + + logical :: passed + + ! ------------------------------------------------------------------------------------------------------ + top_at_1 = .true. + ! ------------------------------------------------------------------------------------ + ! + ! Shortwave tests - thin atmospheres + ! + ! ------------------------------------------------------------------------------------ + print *, "RTE SW solver unit tests" + + print *, "Thin, scattering atmospheres" + call stop_on_err(atmos%init(band_lims_wvn = reshape([3250._wp, 10000._wp], shape = [2, 1]), & + band_lims_gpt = reshape([1, 1 ], shape = [2, 1]), & + name = "Gray atmosphere")) + call stop_on_err(atmos%alloc_2str(ncol, nlay)) + call thin_scattering(tau, ssa, g, nlay, atmos) + + do imu0 = 1, nmu0 + print '(" mu0 = ", f4.2)', mu0(imu0) + mu0_arr = mu0(imu0) + fluxes%flux_up => ref_flux_up (:,:) + fluxes%flux_dn => ref_flux_dn (:,:) + fluxes%flux_dn_dir => ref_flux_dir(:,:) + fluxes%flux_net => ref_flux_net(:,:) + call stop_on_err(rte_sw(atmos, top_at_1, & + mu0_arr, & + toa_flux, & + sfc_albedo, sfc_albedo, & + fluxes)) + ! + ! Is the solution correct? + ! WIP - differences are up to 25%, so skip correctness test for the moment + ! + ! passed = check_thin_scattering(atmos, spread(mu0(1), 1, ncol), top_at_1, & + ! ref_flux_up, ref_flux_dn, ref_flux_dir) + if(imu0 == 1) passed = .true. + ! ------------------------------------------------------------------------------------ + ! + ! Check direct beam for correctness with Beer-Lambert-Bouguier + ! + if(top_at_1) then + sfc => ref_flux_dir(:,nlay+1) + else + sfc => ref_flux_dir(:, 1) + end if + if(.not. allclose(sfc, & + toa_flux(:,1)*mu0_arr*exp(-sum(atmos%tau(:,:,1),dim=2)/mu0_arr), & + tol=20._wp)) then ! Tolerances as big as 20 needed for GPU implementations + passed = .false. + call report_err("Direct flux doesn't match") + end if + ! ------------------------------------------------------------------------------------ + ! + ! Net fluxes on- vs off-line + ! Are the net fluxes correct? + ! + print *, " Net flux variants" + call check_fluxes(ref_flux_net, ref_flux_dn-ref_flux_up, passed, "net fluxes don't match down-up") + ! + ! Compute only net fluxes + ! + nullify(fluxes%flux_up) + nullify(fluxes%flux_dn) + call stop_on_err(rte_sw(atmos, top_at_1, & + mu0_arr, & + toa_flux, & + sfc_albedo, sfc_albedo, & + fluxes)) + call check_fluxes(ref_flux_net, ref_flux_dn-ref_flux_up, & + passed, "Net fluxes computed alone doesn't match down-up computed separately") + ! + ! Compute only up and down fluxes + ! + fluxes%flux_up => tst_flux_up (:,:) + fluxes%flux_dn => tst_flux_dn (:,:) + call stop_on_err(rte_sw(atmos, top_at_1, & + mu0_arr, & + toa_flux, & + sfc_albedo, sfc_albedo, & + fluxes)) + call check_fluxes(ref_flux_net, tst_flux_dn-tst_flux_up, & + passed, "Net fluxes don't match down-up computed together") + ! ------------------------------------------------------- + ! + ! Subsets of atmospheric columns + ! + print *, " Subsetting invariance" + call clear_sky_subset(atmos, mu0_arr, toa_flux, sfc_albedo, tst_flux_up, tst_flux_dn) + call check_fluxes(tst_flux_up, ref_flux_up, & + tst_flux_dn, ref_flux_dn, & + passed, "Doing problem in subsets fails") + ! ------------------------------------------------------- + ! + ! Vertically-reverse + ! + print *, " Vertical orientation invariance" + call thin_scattering(tau, ssa, g, nlay, atmos) + call vr(atmos) + call stop_on_err(rte_sw(atmos, .not. top_at_1, & + mu0_arr, & + toa_flux, & + sfc_albedo, sfc_albedo, & + fluxes)) +#ifdef __NVCOMPILER + ! The -Mbounds flag breaks the actual arrays that are passed to check_fluxes + tst_flux_up_reversed = tst_flux_up(:,nlay+1:1:-1) + ref_flux_dn_reversed = tst_flux_dn(:,nlay+1:1:-1) + call check_fluxes(tst_flux_up_reversed, ref_flux_up, & + ref_flux_dn_reversed, ref_flux_dn, & +#else + call check_fluxes(tst_flux_up(:,nlay+1:1:-1), ref_flux_up, & + tst_flux_dn(:,nlay+1:1:-1), ref_flux_dn, & +#endif + passed, "Doing problem upside down fails") + call vr(atmos) + ! ------------------------------------------------------- + ! + ! Linear in TOA flux + ! + print *, " Linear in TOA flux" + call thin_scattering(tau, ssa, g, nlay, atmos) + call stop_on_err(rte_sw(atmos, top_at_1, & + mu0_arr, & + toa_flux * factor, & + sfc_albedo, sfc_albedo, & + fluxes)) + call check_fluxes(tst_flux_up/factor, ref_flux_up, & + tst_flux_dn/factor, ref_flux_dn, & + passed, "Linearity in TOA flux fails") + ! ------------------------------------------------------------------------------------ + end do + ! Done + ! + print *, "RTE SW solver unit tests done" + print * + if(.not. passed) error stop 1 + ! ------------------------------------------------------------------------------------ +contains + ! ------------------------------------------------------------------------------------ + ! + ! Define an atmosphere in gray radiative equillibrium + ! See, for example, section 2 of Weaver and Rmanathan 1995 https://doi.org/10.1029/95JD00770 + ! + subroutine thin_scattering(tau, ssa, g, nlay, atmos) + real(wp), dimension(:), intent(in) :: tau, ssa, g + integer, intent(in) :: nlay + type(ty_optical_props_2str), intent(inout) :: atmos + + integer :: ntau, nssa, ng, ncol + integer :: i, j, k + real(wp), dimension(size(tau)*size(ssa)*size(g)) & + :: temp + + ntau = size(tau); nssa = size(ssa); ng = size(g) + ncol = ntau*nssa*ng + if(ncol /= atmos%get_ncol()) call stop_on_err("Number of SW columns incompatible") + ! + ! Set up a gray spectral distribution - one band, one g-point + ! + call stop_on_err(atmos%init(band_lims_wvn = reshape([3250._wp, 1.e5_wp], shape = [2, 1]), & + band_lims_gpt = reshape([1, 1], shape = [2, 1]), & + name = "Gray SW atmosphere")) + call stop_on_err(atmos%alloc_2str(ncol, nlay)) + + temp = [(((tau(i), k = 1, 1 ), i = 1, ntau), j = 1, nssa*ng)] + ! + ! Divide optical depth evenly among layers + ! + atmos%tau(1:ncol,1:nlay,1) = spread(temp(1:ncol)/real(nlay, wp), dim=2, ncopies=nlay) + ! + ! ... and make the medium uniform + ! + temp = [(((ssa(i), k = 1, ntau ), i = 1, nssa), j = 1, ng)] + atmos%ssa(1:ncol,1:nlay,1) = spread(temp(1:ncol), dim=2, ncopies=nlay) + temp = [(((g (i), k = 1, ntau*ng), i = 1, ng ), j = 1, 1 )] + atmos%g (1:ncol,1:nlay,1) = spread(temp(1:ncol), dim=2, ncopies=nlay) + + if(.false.) then + print *, "Original values" + print '("tau: ", 8(e9.3,2x))', sum(atmos%tau(:,:,1),dim=2) + print '("ssa: ", 8(e9.3,2x))', atmos%ssa(:,1,1) + print '("g : ", 8(e9.3,2x))', atmos%g (:,1,1) + print * + end if + ! + ! Delta-scale + ! + call stop_on_err(atmos%delta_scale()) + + end subroutine thin_scattering + ! ------------------------------------------------------------------------------------ + function check_thin_scattering(atmos, mu0, top_at_1, ref_flux_up, ref_flux_dn, ref_flux_dir) + type(ty_optical_props_2str), intent(in) :: atmos + real(wp), dimension(:), intent(in) :: mu0 + logical, intent(in) :: top_at_1 + real(wp), dimension(:,:), intent(in) :: ref_flux_up, ref_flux_dn, ref_flux_dir + logical :: check_thin_scattering + + real(wp), dimension(atmos%get_ncol()) :: gamma3, R, T ! Reflectance, transmittance + + check_thin_scattering = .true. + ! + ! Solutions for small tau + ! Meador and Weaver 1980, 10.1175/1520-0469(1980)037<0630:TSATRT>2.0.CO;2 + ! Equation 19 using the same gamma3 as in RTE (and gamma3+gamma4=1) + ! ssa and g are assumed to be vertically uniform + ! + gamma3(:) = (2._wp - 3._wp * mu0(:) * atmos%g(:,1,1)) * .25_wp + R(:) = (atmos%ssa(:,1,1)*sum(atmos%tau(:,:,1),dim=2))/mu0(:) * gamma3(:) + if(.false.) then + print '("tau: ", 8(e9.3,2x))', sum(atmos%tau(:,:,1),dim=2) + print '("ssa: ", 8(e9.3,2x))', atmos%ssa(:,1,1) + print '("g : ", 8(e9.3,2x))', atmos%g (:,1,1) + print * + print '("R : ", 8(e9.3,2x))', R + print '("RTE: ", 8(e9.3,2x))', ref_flux_up(:,1) + print '("Dif: ", 8(e9.3,2x))', R(:) - ref_flux_up(:,1) + print '("Rel: ", 8(f9.2,2x))', (R(:) - ref_flux_up(:,1))/ref_flux_up(:,1) * 100._wp + end if + end function check_thin_scattering + ! ------------------------------------------------------------------------------------ + ! + ! Invariance tests + ! + ! ------------------------------------------------------------------------------------ + ! + ! Clear-sky fluxes, half the columns at a time + ! We're counting on ncol being even + ! + subroutine clear_sky_subset(atmos, mu0, toa_flux, sfc_albedo, flux_up, flux_dn) + type(ty_optical_props_2str), intent(inout) :: atmos + real(wp), dimension(:), intent(in ) :: mu0 + real(wp), dimension(:,:), intent(in ) :: toa_flux, sfc_albedo + real(wp), dimension(:,:), intent( out) :: flux_up, flux_dn + + type(ty_optical_props_2str) :: atmos_subset + type(ty_fluxes_broadband) :: fluxes ! Use local variable + real(wp), dimension(atmos%get_ncol()/2, & + atmos%get_nlay()+1), target & + :: up, dn + integer :: i, colS, colE + integer :: ncol + ! ------------------------------ + ncol = atmos%get_ncol() + call stop_on_err(atmos_subset%init(atmos)) + fluxes%flux_up => up + fluxes%flux_dn => dn + + do i = 1, 2 + colS = ((i-1) * ncol/2) + 1 + colE = i * ncol/2 + call stop_on_err(atmos%get_subset(colS, ncol/2, atmos_subset)) + call stop_on_err(rte_sw(atmos_subset, top_at_1, & + mu0(colS:colE), & + toa_flux(colS:colE,:), & + sfc_albedo(:,colS:colE), sfc_albedo(:,colS:colE), & + fluxes)) + flux_up(colS:colE,:) = up + flux_dn(colS:colE,:) = dn + end do + end subroutine clear_sky_subset + ! ------------------------------------------------------------------------------------ + +end program rte_sw_solver_unit_tests \ No newline at end of file diff --git a/tests/test_zenith_angle_spherical_correction.F90 b/tests/test_zenith_angle_spherical_correction.F90 index 851281521..26ad615e0 100644 --- a/tests/test_zenith_angle_spherical_correction.F90 +++ b/tests/test_zenith_angle_spherical_correction.F90 @@ -16,11 +16,10 @@ program test_solar_zenith_angle use mo_rcemip_profiles, only: make_rcemip_profiles use mo_gas_concentrations, only: ty_gas_concs - use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + use mo_gas_optics_defs, only: gas_optics, load_and_init use mo_optical_props, only: ty_optical_props_2str use mo_fluxes, only: ty_fluxes_broadband use mo_rte_sw, only: rte_sw - use mo_load_coefficients, only: load_and_init use mo_heating_rates, only: compute_heating_rate implicit none @@ -31,7 +30,6 @@ program test_solar_zenith_angle real(wp), dimension(ncol, 0:nlay) :: alt, mu type(ty_gas_concs) :: gas_concs - type(ty_gas_optics_rrtmgp) :: gas_optics type(ty_optical_props_2str) :: atmos type(ty_fluxes_broadband) :: fluxes real(wp) :: p_lay(ncol, nlay), t_lay(ncol, nlay), & From 3274155d41bfc51dc71ea91672e84f6219080038 Mon Sep 17 00:00:00 2001 From: Sergey Kosukhin Date: Mon, 19 Feb 2024 18:00:55 +0100 Subject: [PATCH 20/57] Fix cce-gpu-openacc-SP --- .gitlab/lumi.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitlab/lumi.yml b/.gitlab/lumi.yml index 6899ac95d..2b105d19c 100644 --- a/.gitlab/lumi.yml +++ b/.gitlab/lumi.yml @@ -126,5 +126,5 @@ cce-gpu-openacc-DP: cce-gpu-openacc-SP: extends: - - .dp + - .sp - .cce-gpu-openacc From e24246637482d2352114537c1c7c1405296e6dfd Mon Sep 17 00:00:00 2001 From: Sergey Kosukhin Date: Mon, 19 Feb 2024 18:38:33 +0100 Subject: [PATCH 21/57] Small refactoring for the build system (#266) Streamline and add flexibility to the build process. --- .github/workflows/containerized-ci.yml | 10 +++---- .github/workflows/continuous-integration.yml | 8 +++--- .github/workflows/self-hosted-ci.yml | 10 +++---- .gitlab/levante.yml | 8 +++--- .gitlab/lumi.yml | 8 +++--- Makefile | 28 ++++++++++---------- examples/all-sky/Makefile | 4 +-- examples/rfmip-clear-sky/Makefile | 2 +- tests/Makefile | 2 +- 9 files changed, 40 insertions(+), 40 deletions(-) diff --git a/.github/workflows/containerized-ci.yml b/.github/workflows/containerized-ci.yml index 01343d395..a43718cf1 100644 --- a/.github/workflows/containerized-ci.yml +++ b/.github/workflows/containerized-ci.yml @@ -80,8 +80,8 @@ jobs: if: matrix.fortran-compiler != 'ifx' || matrix.rte-kernels != 'accel' run: | $FC --version - make libs - make -C build separate-libs + make -j4 libs + make -j4 -C build separate-libs # # Build libraries, examples and tests (expect failure) # @@ -90,7 +90,7 @@ jobs: shell: bash run: | $FC --version - make libs 2> >(tee make.err >&2) && { + make -j4 libs 2> >(tee make.err >&2) && { echo "Unexpected success" exit 1 } || { @@ -106,7 +106,7 @@ jobs: # - name: Run examples and tests if: steps.build-success.outcome != 'skipped' - run: make tests + run: make -j4 tests # # Relax failure thresholds for single precision # @@ -118,7 +118,7 @@ jobs: # - name: Compare the results if: steps.build-success.outcome != 'skipped' - run: make check + run: make -j4 check # # Generate validation plots # diff --git a/.github/workflows/continuous-integration.yml b/.github/workflows/continuous-integration.yml index 2c5a931bb..ed8ccd964 100644 --- a/.github/workflows/continuous-integration.yml +++ b/.github/workflows/continuous-integration.yml @@ -89,15 +89,15 @@ jobs: - name: Build libraries, examples and tests run: | $FC --version - make libs - make -C build separate-libs + make -j4 libs + make -j4 -C build separate-libs # # Run examples and tests # - name: Run examples and tests - run: make tests + run: make -j4 tests # # Compare the results # - name: Compare the results - run: make check + run: make -j4 check diff --git a/.github/workflows/self-hosted-ci.yml b/.github/workflows/self-hosted-ci.yml index 87dd7e32d..3e4810eff 100644 --- a/.github/workflows/self-hosted-ci.yml +++ b/.github/workflows/self-hosted-ci.yml @@ -96,22 +96,22 @@ jobs: - name: Build libraries, examples and tests run: | $FC --version - make libs - make -C build separate-libs + make -j8 libs + make -j8 -C build separate-libs # # Run examples and tests (expect success) # - name: Run examples and tests (expect success) id: run-success if: matrix.config-name != 'cce-gpu-openmp' - run: make tests + run: make -j8 tests # # Run examples and tests (expect failure) # - name: Run examples and tests (expect failure) if: steps.run-success.outcome == 'skipped' run: | - make tests && { + make -j8 tests && { echo "Unexpected success" exit 1 } || echo "Expected failure" @@ -126,4 +126,4 @@ jobs: # - name: Compare the results if: steps.run-success.outcome != 'skipped' - run: make check + run: make -j8 check diff --git a/.gitlab/levante.yml b/.gitlab/levante.yml index 8104acd52..78de62697 100644 --- a/.gitlab/levante.yml +++ b/.gitlab/levante.yml @@ -77,8 +77,8 @@ variables: # Build libraries, examples and tests # - ${FC} ${VERSION_FCFLAGS} - - make libs - - make -C build separate-libs + - make -j8 libs + - make -j8 -C build separate-libs # # Check out data # @@ -86,11 +86,11 @@ variables: # # Run examples and tests # - - make tests + - make -j8 tests # # Compare the results # - - make check + - make -j8 check .nvhpc-gpu-openacc: extends: diff --git a/.gitlab/lumi.yml b/.gitlab/lumi.yml index 6899ac95d..d8894c1be 100644 --- a/.gitlab/lumi.yml +++ b/.gitlab/lumi.yml @@ -92,8 +92,8 @@ setup-python: # Build libraries, examples and tests # - ${FC} ${VERSION_FCFLAGS} - - make libs - - make -C build separate-libs + - make -j8 libs + - make -j8 -C build separate-libs # # Check out data # @@ -101,11 +101,11 @@ setup-python: # # Run examples and tests # - - make tests + - make -j8 tests # # Compare the results # - - make check + - make -j8 check .cce-gpu-openacc: extends: diff --git a/Makefile b/Makefile index 668b88f93..ec6eb75a3 100644 --- a/Makefile +++ b/Makefile @@ -5,27 +5,27 @@ all: libs tests check docs libs: - make -C build -j - make -C tests -j 1 - make -C examples/all-sky -j - make -C examples/rfmip-clear-sky -j + $(MAKE) -C build + $(MAKE) -C tests + $(MAKE) -C examples/all-sky + $(MAKE) -C examples/rfmip-clear-sky tests: - make -C tests tests - make -C examples/rfmip-clear-sky tests - make -C examples/all-sky tests + $(MAKE) -C examples/rfmip-clear-sky $@ + $(MAKE) -C examples/all-sky $@ + $(MAKE) -C tests $@ check: - make -C tests check - make -C examples/rfmip-clear-sky check - make -C examples/all-sky check + $(MAKE) -C examples/rfmip-clear-sky $@ + $(MAKE) -C examples/all-sky $@ + $(MAKE) -C tests $@ docs: @cd doc; ./build_documentation.sh clean: - make -C build clean - make -C tests clean - make -C examples/rfmip-clear-sky clean - make -C examples/all-sky clean + $(MAKE) -C build $@ + $(MAKE) -C examples/rfmip-clear-sky $@ + $(MAKE) -C examples/all-sky $@ + $(MAKE) -C tests $@ rm -rf public diff --git a/examples/all-sky/Makefile b/examples/all-sky/Makefile index b221dd0a2..a3da6beb1 100644 --- a/examples/all-sky/Makefile +++ b/examples/all-sky/Makefile @@ -50,10 +50,10 @@ tests: $(RUN_CMD) bash all_tests.sh check: - python ${RRTMGP_ROOT}/examples/compare-to-reference.py --ref_dir ${RRTMGP_DATA}/examples/all-sky/reference --tst_dir ${RRTMGP_ROOT}/examples/all-sky \ + $${PYTHON-python} ${RRTMGP_ROOT}/examples/compare-to-reference.py --ref_dir ${RRTMGP_DATA}/examples/all-sky/reference --tst_dir ${RRTMGP_ROOT}/examples/all-sky \ --var lw_flux_up lw_flux_dn sw_flux_up sw_flux_dn sw_flux_dir \ --file rrtmgp-allsky-lw.nc rrtmgp-allsky-sw.nc - python ${RRTMGP_ROOT}/examples/compare-to-reference.py --ref_dir ${RRTMGP_DATA}/examples/all-sky/reference --tst_dir ${RRTMGP_ROOT}/examples/all-sky \ + $${PYTHON-python} ${RRTMGP_ROOT}/examples/compare-to-reference.py --ref_dir ${RRTMGP_DATA}/examples/all-sky/reference --tst_dir ${RRTMGP_ROOT}/examples/all-sky \ --var lw_flux_up lw_flux_dn sw_flux_up sw_flux_dn sw_flux_dir \ --file rrtmgp-allsky-lw-no-aerosols.nc rrtmgp-allsky-sw-no-aerosols.nc diff --git a/examples/rfmip-clear-sky/Makefile b/examples/rfmip-clear-sky/Makefile index 6f2bc3621..0d90cea7a 100644 --- a/examples/rfmip-clear-sky/Makefile +++ b/examples/rfmip-clear-sky/Makefile @@ -57,7 +57,7 @@ tests: multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc \ $(RUN_CMD) ./rrtmgp_rfmip_sw 8 multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc ${RRTMGP_DATA}/rrtmgp-gas-sw-g224.nc check: - python ${RRTMGP_ROOT}/examples/compare-to-reference.py \ + $${PYTHON-python} ${RRTMGP_ROOT}/examples/compare-to-reference.py \ --ref_dir ${RRTMGP_DATA}/examples/rfmip-clear-sky/reference --tst_dir ${RRTMGP_ROOT}/examples/rfmip-clear-sky \ --var rld rlu rsd rsu --file r??_Efx_RTE-RRTMGP-181204_rad-irf_r1i1p1f1_gn.nc diff --git a/tests/Makefile b/tests/Makefile index aaa159f47..1b90ed26c 100644 --- a/tests/Makefile +++ b/tests/Makefile @@ -66,7 +66,7 @@ mo_cloud_sampling.o: $(LIB_DEPS) mo_cloud_sampling.F90 mo_gas_optics_defs_rrtmgp.o: $(LIB_DEPS) mo_testing_utils.o mo_simple_netcdf.o mo_gas_optics_defs_rrtmgp.F90 mo_load_coefficients.o: $(LIB_DEPS) mo_simple_netcdf.o mo_load_coefficients.F90 -mo_rfmip_io.o.o: $(LIB_DEPS) mo_simple_netcdf.o mo_rfmip_io.F90 +mo_rfmip_io.o: $(LIB_DEPS) mo_simple_netcdf.o mo_rfmip_io.F90 mo_simple_netcdf.o: $(LIB_DEPS) mo_simple_netcdf.F90 rte_optic_prop_unit_tests.o: $(LIB_DEPS) mo_testing_utils.o rte_optic_prop_unit_tests.F90 From dc88744316e9eb0620f5d9c4ccab7d7e4f959f8f Mon Sep 17 00:00:00 2001 From: Robert Pincus Date: Wed, 28 Feb 2024 10:21:33 -0500 Subject: [PATCH 22/57] Make front-end/kernel libraries by default --- .github/workflows/containerized-ci.yml | 1 - .github/workflows/continuous-integration.yml | 1 - .github/workflows/self-hosted-ci.yml | 1 - .gitlab/levante.yml | 1 - .gitlab/lumi.yml | 1 - build/Makefile | 3 ++- 6 files changed, 2 insertions(+), 6 deletions(-) diff --git a/.github/workflows/containerized-ci.yml b/.github/workflows/containerized-ci.yml index a43718cf1..0f247ba05 100644 --- a/.github/workflows/containerized-ci.yml +++ b/.github/workflows/containerized-ci.yml @@ -81,7 +81,6 @@ jobs: run: | $FC --version make -j4 libs - make -j4 -C build separate-libs # # Build libraries, examples and tests (expect failure) # diff --git a/.github/workflows/continuous-integration.yml b/.github/workflows/continuous-integration.yml index ed8ccd964..3cb19a757 100644 --- a/.github/workflows/continuous-integration.yml +++ b/.github/workflows/continuous-integration.yml @@ -90,7 +90,6 @@ jobs: run: | $FC --version make -j4 libs - make -j4 -C build separate-libs # # Run examples and tests # diff --git a/.github/workflows/self-hosted-ci.yml b/.github/workflows/self-hosted-ci.yml index 3e4810eff..21fe2116e 100644 --- a/.github/workflows/self-hosted-ci.yml +++ b/.github/workflows/self-hosted-ci.yml @@ -97,7 +97,6 @@ jobs: run: | $FC --version make -j8 libs - make -j8 -C build separate-libs # # Run examples and tests (expect success) # diff --git a/.gitlab/levante.yml b/.gitlab/levante.yml index 78de62697..4835a4383 100644 --- a/.gitlab/levante.yml +++ b/.gitlab/levante.yml @@ -78,7 +78,6 @@ variables: # - ${FC} ${VERSION_FCFLAGS} - make -j8 libs - - make -j8 -C build separate-libs # # Check out data # diff --git a/.gitlab/lumi.yml b/.gitlab/lumi.yml index 997ccf4b9..245129d5c 100644 --- a/.gitlab/lumi.yml +++ b/.gitlab/lumi.yml @@ -93,7 +93,6 @@ setup-python: # - ${FC} ${VERSION_FCFLAGS} - make -j8 libs - - make -j8 -C build separate-libs # # Check out data # diff --git a/build/Makefile b/build/Makefile index d00adcb3a..800bbed3e 100644 --- a/build/Makefile +++ b/build/Makefile @@ -9,7 +9,8 @@ RRTMGP_KERNEL_DIR = ../rrtmgp-kernels # Compiler variables FC, FCFLAGS must be set in the environment # # Make all the libraries though we'll only use the interface + kernels -all: librte.a librrtmgp.a +all: librte.a librrtmgp.a \ + librtekernels.a librtef.a librrtmgpkernels.a librrtmgpf.a separate-libs: librtekernels.a librtef.a librrtmgpkernels.a librrtmgpf.a COMPILE = $(FC) $(FCFLAGS) $(FCINCLUDE) -c From f6d4a63118f535480def9319661afc3c163ae27a Mon Sep 17 00:00:00 2001 From: Jian Sun Date: Fri, 22 Mar 2024 11:41:37 -0600 Subject: [PATCH 23/57] fix the gpu runtime error on nvidia a100 with nvhpc/24.3 --- rrtmgp-frontend/mo_gas_optics_rrtmgp.F90 | 22 ++++++++++++++++------ 1 file changed, 16 insertions(+), 6 deletions(-) diff --git a/rrtmgp-frontend/mo_gas_optics_rrtmgp.F90 b/rrtmgp-frontend/mo_gas_optics_rrtmgp.F90 index c83601586..906c7cccb 100644 --- a/rrtmgp-frontend/mo_gas_optics_rrtmgp.F90 +++ b/rrtmgp-frontend/mo_gas_optics_rrtmgp.F90 @@ -801,6 +801,7 @@ function set_tsi(this, tsi) result(error_msg) character(len=128) :: error_msg !! Empty if successful real(wp) :: norm + integer :: igpt, length ! ---------------------------------------------------------- error_msg = "" if(tsi < 0._wp) then @@ -809,12 +810,21 @@ function set_tsi(this, tsi) result(error_msg) ! ! Scale the solar source function to the input tsi ! - !$acc kernels - !$omp target - norm = 1._wp/sum(this%solar_source(:)) - this%solar_source(:) = this%solar_source(:) * tsi * norm - !$acc end kernels - !$omp end target + norm = 0._wp + length = size(this%solar_source) + !$acc parallel loop gang vector reduction(+:norm) + !$omp target teams distribute parallel do simd reduction(+:norm) + do igpt = 1, length + norm = norm + this%solar_source(igpt) + end do + + norm = 1._wp/norm + + !$acc parallel loop gang vector + !$omp target teams distribute parallel do simd + do igpt = 1, length + this%solar_source(igpt) = this%solar_source(igpt) * tsi * norm + end do end if end function set_tsi From 36f34c6d5bb4c6462eb31473ca151b0520a1c252 Mon Sep 17 00:00:00 2001 From: Robert Pincus Date: Tue, 2 Apr 2024 10:25:06 -0400 Subject: [PATCH 24/57] Add kernel API (#272) Adds C and Fortran headers for the kernels in *-kernels/api subdirectories. Kernel headers are tested for consistency against Fortran front-end. Changes the makefiles a) to not build the documentation by defaults, and b) to group the building and running of tests, so that make libs makes, um, only the libraries. --------- Co-authored-by: Alexander Soklev --- .github/workflows/check-api.yml | 34 ++ .github/workflows/continuous-integration.yml | 4 +- .github/workflows/self-hosted-ci.yml | 8 +- Makefile | 15 +- build/Makefile | 26 +- examples/all-sky/Makefile | 3 +- examples/rfmip-clear-sky/Makefile | 13 +- extensions/mo_fluxes_byband.F90 | 4 +- .../api/mo_gas_optics_rrtmgp_kernels.F90 | 245 +++++++++++ rrtmgp-kernels/api/rrtmgp_kernels.h | 123 ++++++ .../api/mo_fluxes_broadband_kernels.F90 | 74 ++++ rte-kernels/api/mo_optical_props_kernels.F90 | 377 +++++++++++++++++ rte-kernels/api/mo_rte_solver_kernels.F90 | 202 +++++++++ rte-kernels/api/mo_rte_util_array.F90 | 47 +++ rte-kernels/api/rte_kernels.h | 389 ++++++++++++++++++ rte-kernels/api/rte_types.h | 34 ++ tests/Makefile | 13 +- 17 files changed, 1575 insertions(+), 36 deletions(-) create mode 100644 .github/workflows/check-api.yml create mode 100644 rrtmgp-kernels/api/mo_gas_optics_rrtmgp_kernels.F90 create mode 100644 rrtmgp-kernels/api/rrtmgp_kernels.h create mode 100644 rte-kernels/api/mo_fluxes_broadband_kernels.F90 create mode 100644 rte-kernels/api/mo_optical_props_kernels.F90 create mode 100644 rte-kernels/api/mo_rte_solver_kernels.F90 create mode 100644 rte-kernels/api/mo_rte_util_array.F90 create mode 100644 rte-kernels/api/rte_kernels.h create mode 100644 rte-kernels/api/rte_types.h diff --git a/.github/workflows/check-api.yml b/.github/workflows/check-api.yml new file mode 100644 index 000000000..b3681e666 --- /dev/null +++ b/.github/workflows/check-api.yml @@ -0,0 +1,34 @@ +name: Check Fortran API +on: + push: + branches: + - main + - develop + pull_request: + branches-ignore: + - documentation + workflow_dispatch: + + +jobs: + API: + runs-on: ubuntu-22.04 + env: + # Core variables: + FC: gfortran-12 + FCFLAGS: "-ffree-line-length-none -m64 -std=f2008 -march=native -fbounds-check -fmodule-private -fimplicit-none -finit-real=nan -g -DRTE_USE_CBOOL" + RRTMGP_ROOT: ${{ github.workspace }} + RTE_KERNELS: extern + steps: + # + # Check out repository under $GITHUB_WORKSPACE + # + - name: Check out code + uses: actions/checkout@v4 + # + # Build libraries + # + - name: Build libraries + run: | + $FC --version + make -j4 libs \ No newline at end of file diff --git a/.github/workflows/continuous-integration.yml b/.github/workflows/continuous-integration.yml index 3cb19a757..138994fd4 100644 --- a/.github/workflows/continuous-integration.yml +++ b/.github/workflows/continuous-integration.yml @@ -86,14 +86,14 @@ jobs: # # Build libraries, examples and tests # - - name: Build libraries, examples and tests + - name: Build libraries run: | $FC --version make -j4 libs # # Run examples and tests # - - name: Run examples and tests + - name: Build and run examples and tests run: make -j4 tests # # Compare the results diff --git a/.github/workflows/self-hosted-ci.yml b/.github/workflows/self-hosted-ci.yml index 21fe2116e..5ef3cd98b 100644 --- a/.github/workflows/self-hosted-ci.yml +++ b/.github/workflows/self-hosted-ci.yml @@ -42,7 +42,7 @@ jobs: env: # Core variables: FC: ftn - FCFLAGS: ${{ matrix.fcflags }} -DRTE_USE_${{ matrix.fpmodel}} + FCFLAGS: ${{ matrix.fcflags }} -DRTE_USE_${{ matrix.fpmodel }} # Make variables: RRTMGP_ROOT: ${{ github.workspace }} RRTMGP_DATA: ${{ github.workspace }}/rrtmgp-data @@ -93,21 +93,21 @@ jobs: # # Build libraries, examples and tests # - - name: Build libraries, examples and tests + - name: Build libraries run: | $FC --version make -j8 libs # # Run examples and tests (expect success) # - - name: Run examples and tests (expect success) + - name: Build and run examples and tests (expect success) id: run-success if: matrix.config-name != 'cce-gpu-openmp' run: make -j8 tests # # Run examples and tests (expect failure) # - - name: Run examples and tests (expect failure) + - name: Build and run examples and tests (expect failure) if: steps.run-success.outcome == 'skipped' run: | make -j8 tests && { diff --git a/Makefile b/Makefile index ec6eb75a3..96c1e2edd 100644 --- a/Makefile +++ b/Makefile @@ -1,31 +1,28 @@ # # Top-level Makefile # -.PHONY: libs tests check docs -all: libs tests check docs +.PHONY: libs tests check +all: libs tests check libs: - $(MAKE) -C build - $(MAKE) -C tests - $(MAKE) -C examples/all-sky - $(MAKE) -C examples/rfmip-clear-sky + $(MAKE) -C build $@ tests: + $(MAKE) -C tests $@ $(MAKE) -C examples/rfmip-clear-sky $@ $(MAKE) -C examples/all-sky $@ - $(MAKE) -C tests $@ check: + $(MAKE) -C tests $@ $(MAKE) -C examples/rfmip-clear-sky $@ $(MAKE) -C examples/all-sky $@ - $(MAKE) -C tests $@ docs: @cd doc; ./build_documentation.sh clean: $(MAKE) -C build $@ + $(MAKE) -C tests $@ $(MAKE) -C examples/rfmip-clear-sky $@ $(MAKE) -C examples/all-sky $@ - $(MAKE) -C tests $@ rm -rf public diff --git a/build/Makefile b/build/Makefile index 800bbed3e..efd0341d2 100644 --- a/build/Makefile +++ b/build/Makefile @@ -12,6 +12,7 @@ RRTMGP_KERNEL_DIR = ../rrtmgp-kernels all: librte.a librrtmgp.a \ librtekernels.a librtef.a librrtmgpkernels.a librrtmgpf.a separate-libs: librtekernels.a librtef.a librrtmgpkernels.a librrtmgpf.a +libs: all COMPILE = $(FC) $(FCFLAGS) $(FCINCLUDE) -c %.o: %.F90 @@ -22,23 +23,38 @@ include $(RRTMGP_DIR)/Make.depends include $(RTE_KERNEL_DIR)/Make.depends include $(RRTMGP_KERNEL_DIR)/Make.depends -VPATH = $(RTE_DIR):$(RTE_KERNEL_DIR):$(RRTMGP_DIR):$(RRTMGP_KERNEL_DIR):$(GAS_OPTICS_DIR) # # If using OpenACC/OpenMP files in *-kernels/accel take precendence # ifeq ($(RTE_KERNELS), accel) - VPATH = $(RTE_DIR):$(RTE_KERNEL_DIR)/accel:$(RTE_KERNEL_DIR):$(RRTMGP_DIR):$(RRTMGP_KERNEL_DIR)/accel:$(RRTMGP_KERNEL_DIR):$(GAS_OPTICS_DIR) + VPATH = $(RTE_KERNEL_DIR)/accel:$(RRTMGP_KERNEL_DIR)/accel endif +# +# If using external libraries just compile the interfaces +# +ifeq ($(RTE_KERNELS), extern) + VPATH = $(RTE_KERNEL_DIR)/api:$(RRTMGP_KERNEL_DIR)/api +endif +VPATH += $(RTE_DIR):$(RTE_KERNEL_DIR):$(RRTMGP_DIR):$(RRTMGP_KERNEL_DIR):$(GAS_OPTICS_DIR) +# +# Complete library - kernels plus Fortran front end +# librte.a: $(RTE_FORTRAN_KERNELS) $(RTE_FORTRAN_INTERFACE) ar -rvs librte.a $(RTE_FORTRAN_KERNELS) $(RTE_FORTRAN_INTERFACE) - +# +# Library with just the kernels... +# librtekernels.a: $(RTE_FORTRAN_KERNELS) ar -rvs librtekernels.a $(RTE_FORTRAN_KERNELS) - +# +# ... and just the Fortran front-end +# librtef.a: $(RTE_FORTRAN_INTERFACE) ar -rvs librtef.a $(RTE_FORTRAN_INTERFACE) - +# +# As with RTE, libraries with Fortran front-end and kernels, separate and combined +# librrtmgp.a: $(RRTMGP_FORTRAN_KERNELS) $(RRTMGP_FORTRAN_INTERFACE) ar -rvs librrtmgp.a $(RRTMGP_FORTRAN_KERNELS) $(RRTMGP_FORTRAN_INTERFACE) diff --git a/examples/all-sky/Makefile b/examples/all-sky/Makefile index a3da6beb1..d404181c1 100644 --- a/examples/all-sky/Makefile +++ b/examples/all-sky/Makefile @@ -1,3 +1,4 @@ +#!/usr/bin/env make # # Location of RTE+RRTMGP libraries, module files. # @@ -46,7 +47,7 @@ mo_load_coefficients.o: mo_simple_netcdf.o mo_load_cloud_coefficients.o: mo_simple_netcdf.o mo_cloud_optics_rrtmgp.o mo_load_cloud_coefficients.F90 mo_load_aerosol_coefficients.o: mo_simple_netcdf.o mo_aerosol_optics_rrtmgp_merra.o mo_load_aerosol_coefficients.F90 -tests: +tests: rrtmgp_allsky $(RUN_CMD) bash all_tests.sh check: diff --git a/examples/rfmip-clear-sky/Makefile b/examples/rfmip-clear-sky/Makefile index 0d90cea7a..bad1bc80f 100644 --- a/examples/rfmip-clear-sky/Makefile +++ b/examples/rfmip-clear-sky/Makefile @@ -1,3 +1,4 @@ +#!/usr/bin/env make # # Location of RTE+RRTMGP libraries, module files. # @@ -5,11 +6,10 @@ RRTMGP_BUILD = $(RRTMGP_ROOT)/build # # RRTMGP library, module files # -# LDFLAGS += -L$(RRTMGP_BUILD) -# LIBS += -lrrtmgp -lrte +LDFLAGS += -L$(RRTMGP_BUILD) +LIBS += -lrrtmgp -lrte FCINCLUDE += -I$(RRTMGP_BUILD) -# # netcdf Fortran module files has to be in the search path or added via environment variable FCINCLUDE e.g. #FCINCLUDE += -I$(NFHOME)/include @@ -38,11 +38,11 @@ ADDITIONS = mo_simple_netcdf.o mo_rfmip_io.o mo_load_coefficients.o all: rrtmgp_rfmip_lw rrtmgp_rfmip_sw -rrtmgp_rfmip_lw: rrtmgp_rfmip_lw.o $(ADDITIONS) $(RRTMGP_BUILD)/librrtmgp.a $(RRTMGP_BUILD)/librte.a +rrtmgp_rfmip_lw: rrtmgp_rfmip_lw.o $(ADDITIONS) rrtmgp_rfmip_lw.o: rrtmgp_rfmip_lw.F90 $(ADDITIONS) -rrtmgp_rfmip_sw: rrtmgp_rfmip_sw.o $(ADDITIONS) $(RRTMGP_BUILD)/librrtmgp.a $(RRTMGP_BUILD)/librte.a +rrtmgp_rfmip_sw: rrtmgp_rfmip_sw.o $(ADDITIONS) rrtmgp_rfmip_sw.o: rrtmgp_rfmip_sw.F90 $(ADDITIONS) @@ -50,7 +50,8 @@ mo_rfmip_io.o: mo_rfmip_io.F90 mo_simple_netcdf.o mo_load_coefficients.o: mo_load_coefficients.F90 mo_simple_netcdf.o -tests: multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc \ +tests: rrtmgp_rfmip_lw rrtmgp_rfmip_sw \ + multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc \ rld_Efx_RTE-RRTMGP-181204_rad-irf_r1i1p1f1_gn.nc rlu_Efx_RTE-RRTMGP-181204_rad-irf_r1i1p1f1_gn.nc \ rsd_Efx_RTE-RRTMGP-181204_rad-irf_r1i1p1f1_gn.nc rsu_Efx_RTE-RRTMGP-181204_rad-irf_r1i1p1f1_gn.nc $(RUN_CMD) ./rrtmgp_rfmip_lw 8 multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc ${RRTMGP_DATA}/rrtmgp-gas-lw-g256.nc diff --git a/extensions/mo_fluxes_byband.F90 b/extensions/mo_fluxes_byband.F90 index 587ab42bf..7bf334b66 100644 --- a/extensions/mo_fluxes_byband.F90 +++ b/extensions/mo_fluxes_byband.F90 @@ -156,7 +156,7 @@ end function are_desired_byband ! ! Spectral reduction over all points ! - subroutine sum_byband(ncol, nlev, ngpt, nbnd, band_lims, spectral_flux, byband_flux) bind (C) + subroutine sum_byband(ncol, nlev, ngpt, nbnd, band_lims, spectral_flux, byband_flux) bind(C, name="rte_sum_byband") integer, intent(in ) :: ncol, nlev, ngpt, nbnd integer, dimension(2, nbnd), intent(in ) :: band_lims real(wp), dimension(ncol, nlev, ngpt), intent(in ) :: spectral_flux @@ -181,7 +181,7 @@ end subroutine sum_byband ! ! Net flux: Spectral reduction over all points ! - subroutine net_byband_full(ncol, nlev, ngpt, nbnd, band_lims, spectral_flux_dn, spectral_flux_up, byband_flux_net) bind (C) + subroutine net_byband_full(ncol, nlev, ngpt, nbnd, band_lims, spectral_flux_dn, spectral_flux_up, byband_flux_net) bind(C, name="rte_net_byband_full") integer, intent(in ) :: ncol, nlev, ngpt, nbnd integer, dimension(2, nbnd), intent(in ) :: band_lims real(wp), dimension(ncol, nlev, ngpt), intent(in ) :: spectral_flux_dn, spectral_flux_up diff --git a/rrtmgp-kernels/api/mo_gas_optics_rrtmgp_kernels.F90 b/rrtmgp-kernels/api/mo_gas_optics_rrtmgp_kernels.F90 new file mode 100644 index 000000000..9272bb16e --- /dev/null +++ b/rrtmgp-kernels/api/mo_gas_optics_rrtmgp_kernels.F90 @@ -0,0 +1,245 @@ +module mo_gas_optics_rrtmgp_kernels + use mo_rte_kind, only : wp, wl + use mo_rte_util_array,only : zero_array + implicit none + private + public :: interpolation, compute_tau_absorption, compute_tau_rayleigh, compute_Planck_source + ! ------------------------------------------------------------------------------------------------------------------ + interface + subroutine interpolation( & + ncol,nlay,ngas,nflav,neta, npres, ntemp, & + flavor, & + press_ref_log, temp_ref,press_ref_log_delta, & + temp_ref_min,temp_ref_delta,press_ref_trop_log, & + vmr_ref, & + play,tlay,col_gas, & + jtemp,fmajor,fminor,col_mix,tropo,jeta,jpress) bind(C, name="rrtmgp_interpolation") + use mo_rte_kind, only : wp, wl + ! input dimensions + integer, intent(in) :: ncol,nlay + !! physical domain size + integer, intent(in) :: ngas,nflav,neta,npres,ntemp + !! k-distribution table dimensions + integer, dimension(2,nflav), intent(in) :: flavor + !! index into vmr_ref of major gases for each flavor + real(wp), dimension(npres), intent(in) :: press_ref_log + !! log of pressure dimension in RRTMGP tables + real(wp), dimension(ntemp), intent(in) :: temp_ref + !! temperature dimension in RRTMGP tables + real(wp), intent(in) :: press_ref_log_delta, & + temp_ref_min, temp_ref_delta, & + press_ref_trop_log + !! constants related to RRTMGP tables + real(wp), dimension(2,0:ngas,ntemp), intent(in) :: vmr_ref + !! reference volume mixing ratios used in compute "binary species parameter" eta + + ! inputs from profile or parent function + real(wp), dimension(ncol,nlay), intent(in) :: play, tlay + !! input pressure (Pa?) and temperature (K) + real(wp), dimension(ncol,nlay,0:ngas), intent(in) :: col_gas + !! input column gas amount - molecules/cm^2 + ! outputs + integer, dimension(ncol,nlay), intent(out) :: jtemp, jpress + !! temperature and pressure interpolation indexes + logical(wl), dimension(ncol,nlay), intent(out) :: tropo + !! use lower (or upper) atmosphere tables + integer, dimension(2, ncol,nlay,nflav), intent(out) :: jeta + !! Index for binary species interpolation +#if !defined(__INTEL_LLVM_COMPILER) && __INTEL_COMPILER >= 2021 + ! A performance-hitting workaround for the vectorization problem reported in + ! https://github.com/earth-system-radiation/rte-rrtmgp/issues/159 + ! The known affected compilers are Intel Fortran Compiler Classic + ! 2021.4, 2021.5 and 2022.1. We do not limit the workaround to these + ! versions because it is not clear when the compiler bug will be fixed, see + ! https://community.intel.com/t5/Intel-Fortran-Compiler/Compiler-vectorization-bug/m-p/1362591. + ! We, however, limit the workaround to the Classic versions only since the + ! problem is not confirmed for the Intel Fortran Compiler oneAPI (a.k.a + ! 'ifx'), which does not mean there is none though. + real(wp), dimension(:, :, :, :), intent(out) :: col_mix +#else + real(wp), dimension(2, ncol,nlay,nflav), intent(out) :: col_mix + !! combination of major species's column amounts (first index is strat/trop) +#endif + real(wp), dimension(2,2,2,ncol,nlay,nflav), intent(out) :: fmajor + !! Interpolation weights in pressure, eta, strat/trop + real(wp), dimension(2,2, ncol,nlay,nflav), intent(out) :: fminor + !! Interpolation fraction in eta, strat/trop + end subroutine interpolation + end interface + ! ------------------------------------------------------------------------------------------------------------------ + interface + subroutine compute_tau_absorption( & + ncol,nlay,nbnd,ngpt, & ! dimensions + ngas,nflav,neta,npres,ntemp, & + nminorlower, nminorklower, & ! number of minor contributors, total num absorption coeffs + nminorupper, nminorkupper, & + idx_h2o, & + gpoint_flavor, & + band_lims_gpt, & + kmajor, & + kminor_lower, & + kminor_upper, & + minor_limits_gpt_lower, & + minor_limits_gpt_upper, & + minor_scales_with_density_lower, & + minor_scales_with_density_upper, & + scale_by_complement_lower, & + scale_by_complement_upper, & + idx_minor_lower, & + idx_minor_upper, & + idx_minor_scaling_lower, & + idx_minor_scaling_upper, & + kminor_start_lower, & + kminor_start_upper, & + tropo, & + col_mix,fmajor,fminor, & + play,tlay,col_gas, & + jeta,jtemp,jpress, & + tau) bind(C, name="rrtmgp_compute_tau_absorption") + ! --------------------- + use mo_rte_kind, only : wp, wl + ! input dimensions + integer, intent(in) :: ncol,nlay,nbnd,ngpt !! array sizes + integer, intent(in) :: ngas,nflav,neta,npres,ntemp !! tables sizes + integer, intent(in) :: nminorlower, nminorklower,nminorupper, nminorkupper + !! table sizes + integer, intent(in) :: idx_h2o !! index of water vapor in col_gas + ! --------------------- + ! inputs from object + integer, dimension(2,ngpt), intent(in) :: gpoint_flavor + !! major gas flavor (pair) by upper/lower, g-point + integer, dimension(2,nbnd), intent(in) :: band_lims_gpt + !! beginning and ending g-point for each band + real(wp), dimension(ntemp,neta,npres+1,ngpt), intent(in) :: kmajor + !! absorption coefficient table - major gases + real(wp), dimension(ntemp,neta,nminorklower), intent(in) :: kminor_lower + !! absorption coefficient table - minor gases, lower atmosphere + real(wp), dimension(ntemp,neta,nminorkupper), intent(in) :: kminor_upper + !! absorption coefficient table - minor gases, upper atmosphere + integer, dimension(2,nminorlower), intent(in) :: minor_limits_gpt_lower + !! beginning and ending g-point for each minor gas + integer, dimension(2,nminorupper), intent(in) :: minor_limits_gpt_upper + logical(wl), dimension( nminorlower), intent(in) :: minor_scales_with_density_lower + !! generic treatment of minor gases - scales with density (e.g. continuum, collision-induced absorption)? + logical(wl), dimension( nminorupper), intent(in) :: minor_scales_with_density_upper + logical(wl), dimension( nminorlower), intent(in) :: scale_by_complement_lower + !! generic treatment of minor gases - scale by density (e.g. self-continuum) or complement? + logical(wl), dimension( nminorupper), intent(in) :: scale_by_complement_upper + integer, dimension( nminorlower), intent(in) :: idx_minor_lower + !! index of each minor gas in col_gas + integer, dimension( nminorupper), intent(in) :: idx_minor_upper + integer, dimension( nminorlower), intent(in) :: idx_minor_scaling_lower + !! for this minor gas, index of the "scaling gas" in col_gas + integer, dimension( nminorupper), intent(in) :: idx_minor_scaling_upper + integer, dimension( nminorlower), intent(in) :: kminor_start_lower + !! starting g-point index in minor gas absorption table + integer, dimension( nminorupper), intent(in) :: kminor_start_upper + logical(wl), dimension(ncol,nlay), intent(in) :: tropo + !! use upper- or lower-atmospheric tables? + ! --------------------- + ! inputs from profile or parent function + real(wp), dimension(2, ncol,nlay,nflav ), intent(in) :: col_mix + !! combination of major species's column amounts - computed in interpolation() + real(wp), dimension(2,2,2,ncol,nlay,nflav ), intent(in) :: fmajor + !! interpolation weights for major gases - computed in interpolation() + real(wp), dimension(2,2, ncol,nlay,nflav ), intent(in) :: fminor + !! interpolation weights for minor gases - computed in interpolation() + real(wp), dimension( ncol,nlay ), intent(in) :: play, tlay + !! input temperature and pressure + real(wp), dimension( ncol,nlay,0:ngas), intent(in) :: col_gas + !! input column gas amount (molecules/cm^2) + integer, dimension(2, ncol,nlay,nflav ), intent(in) :: jeta + !! interpolation indexes in eta - computed in interpolation() + integer, dimension( ncol,nlay ), intent(in) :: jtemp + !! interpolation indexes in temperature - computed in interpolation() + integer, dimension( ncol,nlay ), intent(in) :: jpress + !! interpolation indexes in pressure - computed in interpolation() + ! --------------------- + ! output - optical depth + real(wp), dimension(ncol,nlay,ngpt), intent(inout) :: tau !! aborption optional depth + end subroutine compute_tau_absorption + end interface + ! ------------------------------------------------------------------------------------------------------------------ + interface + subroutine compute_tau_rayleigh(ncol,nlay,nbnd,ngpt, & + ngas,nflav,neta,npres,ntemp, & + gpoint_flavor,band_lims_gpt, & + krayl, & + idx_h2o, col_dry,col_gas, & + fminor,jeta,tropo,jtemp, & + tau_rayleigh) bind(C, name="rrtmgp_compute_tau_rayleigh") + use mo_rte_kind, only : wp, wl + integer, intent(in ) :: ncol,nlay,nbnd,ngpt + !! input dimensions + integer, intent(in ) :: ngas,nflav,neta,npres,ntemp + !! table dimensions + integer, dimension(2,ngpt), intent(in ) :: gpoint_flavor + !! major gas flavor (pair) by upper/lower, g-point + integer, dimension(2,nbnd), intent(in ) :: band_lims_gpt + !! start and end g-point for each band + real(wp), dimension(ntemp,neta,ngpt,2), intent(in ) :: krayl + !! Rayleigh scattering coefficients + integer, intent(in ) :: idx_h2o + !! index of water vapor in col_gas + real(wp), dimension(ncol,nlay), intent(in ) :: col_dry + !! column amount of dry air + real(wp), dimension(ncol,nlay,0:ngas), intent(in ) :: col_gas + !! input column gas amount (molecules/cm^2) + real(wp), dimension(2,2,ncol,nlay,nflav), intent(in ) :: fminor + !! interpolation weights for major gases - computed in interpolation() + integer, dimension(2, ncol,nlay,nflav), intent(in ) :: jeta + !! interpolation indexes in eta - computed in interpolation() + logical(wl), dimension(ncol,nlay), intent(in ) :: tropo + !! use upper- or lower-atmospheric tables? + integer, dimension(ncol,nlay), intent(in ) :: jtemp + !! interpolation indexes in temperature - computed in interpolation() + ! outputs + real(wp), dimension(ncol,nlay,ngpt), intent(out) :: tau_rayleigh + !! Rayleigh optical depth + end subroutine compute_tau_rayleigh + end interface + ! ------------------------------------------------------------------------------------------------------------------ + interface + subroutine compute_Planck_source( & + ncol, nlay, nbnd, ngpt, & + nflav, neta, npres, ntemp, nPlanckTemp,& + tlay, tlev, tsfc, sfc_lay, & + fmajor, jeta, tropo, jtemp, jpress, & + gpoint_bands, band_lims_gpt, & + pfracin, temp_ref_min, totplnk_delta, totplnk, gpoint_flavor, & + sfc_src, lay_src, lev_src, sfc_source_Jac) bind(C, name="rrtmgp_compute_Planck_source") + use mo_rte_kind, only : wp, wl + integer, intent(in) :: ncol, nlay, nbnd, ngpt + !! input dimensions + integer, intent(in) :: nflav, neta, npres, ntemp, nPlanckTemp + !! table dimensions + real(wp), dimension(ncol,nlay ), intent(in) :: tlay !! temperature at layer centers (K) + real(wp), dimension(ncol,nlay+1), intent(in) :: tlev !! temperature at interfaces (K) + real(wp), dimension(ncol ), intent(in) :: tsfc !! surface temperture + integer, intent(in) :: sfc_lay !! index into surface layer + ! Interpolation variables + real(wp), dimension(2,2,2,ncol,nlay,nflav), intent(in) :: fmajor + !! interpolation weights for major gases - computed in interpolation() + integer, dimension(2, ncol,nlay,nflav), intent(in) :: jeta + !! interpolation indexes in eta - computed in interpolation() + logical(wl), dimension( ncol,nlay), intent(in) :: tropo + !! use upper- or lower-atmospheric tables? + integer, dimension( ncol,nlay), intent(in) :: jtemp, jpress + !! interpolation indexes in temperature and pressure - computed in interpolation() + ! Table-specific + integer, dimension(ngpt), intent(in) :: gpoint_bands !! band to which each g-point belongs + integer, dimension(2, nbnd), intent(in) :: band_lims_gpt !! start and end g-point for each band + real(wp), dimension(ntemp,neta,npres+1,ngpt), intent(in) :: pfracin !! Fraction of the Planck function in each g-point + real(wp), intent(in) :: temp_ref_min, totplnk_delta !! interpolation constants + real(wp), dimension(nPlanckTemp,nbnd), intent(in) :: totplnk !! Total Planck function by band at each temperature + integer, dimension(2,ngpt), intent(in) :: gpoint_flavor !! major gas flavor (pair) by upper/lower, g-point + + real(wp), dimension(ncol, ngpt), intent(out) :: sfc_src !! Planck emssion from the surface + real(wp), dimension(ncol,nlay, ngpt), intent(out) :: lay_src !! Planck emssion from layer centers + real(wp), dimension(ncol,nlay+1,ngpt), intent(out) :: lev_src !! Planck emission at layer boundaries + real(wp), dimension(ncol, ngpt), intent(out) :: sfc_source_Jac + !! Jacobian (derivative) of the surface Planck source with respect to surface temperature + end subroutine compute_Planck_source + end interface + ! ------------------------------------------------------------------------------------------------------------------ +end module mo_gas_optics_rrtmgp_kernels diff --git a/rrtmgp-kernels/api/rrtmgp_kernels.h b/rrtmgp-kernels/api/rrtmgp_kernels.h new file mode 100644 index 000000000..92c36957c --- /dev/null +++ b/rrtmgp-kernels/api/rrtmgp_kernels.h @@ -0,0 +1,123 @@ +/* This code is part of RRTMGP + +Contacts: Robert Pincus and Eli Mlawer +email: rrtmgp@aer.com + +Copyright 2024- + Trustees of Columbia University in the City of New York + All right reserved. + +Use and duplication is permitted under the terms of the + BSD 3-clause license, see http://opensource.org/licenses/BSD-3-Clause + +This header files defines the C bindings for the kernels used in RRTMGP + Adapted from code written by Chiel van Heerwaarden at Wageningen University and Research + +*/ +#pragma once +#include "rte_types.h" + +extern "C" +{ + void rrtmgp_interpolation( + const int& ncol, const int& nlay, + const int& ngas, const int& nflav, const int& neta, + const int& npres, const int& ntemp, + const int* flavor, // (2,nflav) + const Float* press_ref_log, // (npres) + const Float* temp_ref, // (ntemp) + const Float& press_ref_log_delta, + const Float& temp_ref_min, + const Float& temp_ref_delta, + const Float& press_ref_trop_log, + const Float* vmr_ref, //(2,ngas+1,ntemp) + const Float* play, // (ncol,nlay) + const Float* tlay, // (ncol,nlay) + const Float* col_gas, // (ncol,nlay,ngas+1) + int* jtemp, // [out] (ncol*nlay) + Float* fmajor, // [out] (2,2,2,ncol,nlay,nflav) + Float* fminor, // [out[ (2,2, ncol,nlay,nflav)) + Float* col_mix, // [out] (2, ncol,nlay,nflav) + Bool* tropo, // [out] size (ncol*nlay) + int* jeta,// [out] size (2*ncol*nlay*nflav) + int* jpress // [out] size (ncol*nlay) + ); + + void rrtmgp_compute_tau_absorption( + const int& ncol, const int& nlay, const int& nband, const int& ngpt, + const int& ngas, const int& nflav, const int& neta, + const int& npres, const int& ntemp, + const int& nminorlower, const int& nminorklower, + const int& nminorupper, const int& nminorkupper, + const int& idx_h2o, + const int* gpoint_flavor, // (2,ngpt) + const int* band_lims_gpt, // (2,nbnd) + const Float* kmajor, // (ntemp,neta,npres+1,ngpt) + const Float* kminor_lower, // (ntemp,neta,nminorklower) + const Float* kminor_upper, // (ntemp,neta,nminorkupper) + const int* minor_limits_gpt_lower, // (2,nminorlower) + const int* minor_limits_gpt_upper, // (2,nminorupper) + const Bool* minor_scales_with_density_lower, // ( nminorlower) + const Bool* minor_scales_with_density_upper,// ( nminorupper) + const Bool* scale_by_complement_lower,// ( nminorlower) + const Bool* scale_by_complement_upper,// ( nminorupper) + const int* idx_minor_lower, // ( nminorlower) + const int* idx_minor_upper, // ( nminorupper) + const int* idx_minor_scaling_lower,// ( nminorlower) + const int* idx_minor_scaling_upper,// ( nminorupper) + const int* kminor_start_lower, // ( nminorlower) + const int* kminor_start_upper,// ( nminorupper) + const Bool* tropo, // (ncol,nlay) + const Float* col_mix, // (2, ncol,nlay,nflav ) + const Float* fmajor, // (2,2,2,ncol,nlay,nflav ) + const Float* fminor, // (2,2, ncol,nlay,nflav ) + const Float* play, // (ncol,nlay) + const Float* tlay, // (ncol,nlay) + const Float* col_gas, // (ncol,nlay,ngas+1) + const int* jeta, // (2, ncol,nlay,nflav ) + const int* jtemp, // (ncol,nlay) + const int* jpress, // (ncol,nlay) + Float* tau // [inout] (ncol,nlay.ngpt) + ); + + void rrtmgp_compute_tau_rayleigh( + const int& ncol, const int& nlay, const int& nband, const int& ngpt, + const int& ngas, const int& nflav, const int& neta, const int& npres, const int& ntemp, + const int* gpoint_flavor, // (2,ngpt) + const int* band_lims_gpt, // (2,nbnd) + const Float* krayl, // (ntemp,neta,ngpt,2) + const int& idx_h2o, + const Float* col_dry, // (ncol,nlay) + const Float* col_gas, // (ncol,nlay,ngas+1) + const Float* fminor, // (2,2,ncol,nlay,nflav) + const int* jeta, // (2, ncol,nlay,nflav) + const Bool* tropo, // (ncol,nlay) + const int* jtemp, // (ncol,nlay) + Float* tau_rayleigh // [inout] (ncol,nlay.ngpt) + ); + + void rrtmgp_compute_Planck_source( + const int& ncol, const int& nlay, const int& nbnd, const int& ngpt, + const int& nflav, const int& neta, const int& npres, const int& ntemp, + const int& nPlanckTemp, + const Float* tlay, // (ncol,nlay ) + const Float* tlev, // (ncol,nlay+1) + const Float* tsfc, //(ncol ) + const int& sfc_lay, + const Float* fmajor, // (2,2,2,ncol,nlay,nflav) + const int* jeta, // (2, ncol,nlay,nflav) + const Bool* tropo, // ( ncol,nlay) + const int* jtemp, // ( ncol,nlay) + const int* jpress, // ( ncol,nlay) + const int* gpoint_bands, // (ngpt) + const int* band_lims_gpt, // (2, nbnd) + const Float* pfracin, // (ntemp,neta,npres+1,ngpt) + const Float& temp_ref_min, const Float& totplnk_delta, + const Float* totplnk, // (nPlanckTemp,nbnd) + const int* gpoint_flavor, // (2,ngpt) + Float* sfc_src, // [out] (ncol, ngpt) + Float* lay_src, // [out] (ncol,nlay, ngpt) + Float* lev_src, // [out] (ncol,nlay+1,ngpt) + Float* sfc_src_jac // [out] (ncol, ngpt) + ); +} diff --git a/rte-kernels/api/mo_fluxes_broadband_kernels.F90 b/rte-kernels/api/mo_fluxes_broadband_kernels.F90 new file mode 100644 index 000000000..d64c1fa29 --- /dev/null +++ b/rte-kernels/api/mo_fluxes_broadband_kernels.F90 @@ -0,0 +1,74 @@ +! This code is part of Radiative Transfer for Energetics (RTE) +! +! Contacts: Robert Pincus and Eli Mlawer +! email: rrtmgp@aer.com +! +! Copyright 2015-, Atmospheric and Environmental Research, +! Regents of the University of Colorado, Trustees of Columbia University. All right reserved. +! +! Use and duplication is permitted under the terms of the +! BSD 3-clause license, see http://opensource.org/licenses/BSD-3-Clause +! ------------------------------------------------------------------------------------------------- +!> +!> ## Kernels for computing broadband fluxes +!> +! ------------------------------------------------------------------------------------------------- +module mo_fluxes_broadband_kernels + use, intrinsic :: iso_c_binding + use mo_rte_kind, only: wp + implicit none + private + public :: sum_broadband, net_broadband + + ! ---------------------------------------------------------------------------- + !> + !> Spectral reduction over all points + !> + interface + subroutine sum_broadband(ncol, nlev, ngpt, spectral_flux, broadband_flux) bind(C, name="rte_sum_broadband") + use mo_rte_kind, only: wp + integer, intent(in ) :: ncol, nlev, ngpt + !! Array sizes + real(wp), dimension(ncol, nlev, ngpt), intent(in ) :: spectral_flux + !! Spectrally-resolved flux + real(wp), dimension(ncol, nlev), intent(out) :: broadband_flux + !! Sum of spectrally-resolved flux over `ngpt` + end subroutine sum_broadband + end interface + ! ---------------------------------------------------------------------------- + !> + !> Spectral reduction over all points for net flux + !> Overloaded - which routine is called depends on arguments + !> + interface net_broadband + ! ---------------------------------------------------------------------------- + !> + !> Net flux from g-point fluxes up and down + !> + subroutine net_broadband_full(ncol, nlev, ngpt, spectral_flux_dn, spectral_flux_up, broadband_flux_net) & + bind(C, name="rte_net_broadband_full") + use mo_rte_kind, only: wp + integer, intent(in ) :: ncol, nlev, ngpt + !! Array sizes + real(wp), dimension(ncol, nlev, ngpt), intent(in ) :: spectral_flux_dn, spectral_flux_up + !! Spectrally-resolved flux up and down + real(wp), dimension(ncol, nlev), intent(out) :: broadband_flux_net + !! Net (down minus up) summed over `ngpt` + end subroutine net_broadband_full + ! ---------------------------------------------------------------------------- + !> + !> Net flux when bradband flux up and down are already available + !> + subroutine net_broadband_precalc(ncol, nlev, flux_dn, flux_up, broadband_flux_net) & + bind(C, name="rte_net_broadband_precalc") + use mo_rte_kind, only: wp + integer, intent(in ) :: ncol, nlev + !! Array sizes + real(wp), dimension(ncol, nlev), intent(in ) :: flux_dn, flux_up + !! Broadband downward and upward fluxes + real(wp), dimension(ncol, nlev), intent(out) :: broadband_flux_net + !! Net (down minus up) + end subroutine net_broadband_precalc + end interface net_broadband + ! ---------------------------------------------------------------------------- +end module mo_fluxes_broadband_kernels diff --git a/rte-kernels/api/mo_optical_props_kernels.F90 b/rte-kernels/api/mo_optical_props_kernels.F90 new file mode 100644 index 000000000..bb7e5116f --- /dev/null +++ b/rte-kernels/api/mo_optical_props_kernels.F90 @@ -0,0 +1,377 @@ +! This code is part of Radiative Transfer for Energetics (RTE) +! +! Contacts: Robert Pincus and Eli Mlawer +! email: rrtmgp@aer.com +! +! Copyright 2015-, Atmospheric and Environmental Research, +! Regents of the University of Colorado, Trustees of Columbia University. All right reserved. +! +! Use and duplication is permitted under the terms of the +! BSD 3-clause license, see http://opensource.org/licenses/BSD-3-Clause +! ------------------------------------------------------------------------------------------------- +! +!> ## Kernels for arrays of optical properties: +!> - delta-scaling +!> - adding two sets of properties +!> - extracting subsets along the column dimension +! +! ------------------------------------------------------------------------------------------------- + +module mo_optical_props_kernels + use, intrinsic :: iso_c_binding + use mo_rte_kind, only: wp, wl + implicit none + + public + + ! ------------------------------------------------------------------------------------------------- + ! + ! Delta-scaling is provided only for two-stream properties at present + ! + interface delta_scale_2str_kernel + ! ------------------------------------------------------------------------------------------------- + !> Delta-scale two-stream optical properties given user-provided value of \(f\) (forward scattering) + ! + pure subroutine delta_scale_2str_f_k(ncol, nlay, ngpt, tau, ssa, g, f) & + bind(C, name="rte_delta_scale_2str_f_k") + use mo_rte_kind, only: wp, wl + integer, intent(in ) :: ncol, nlay, ngpt + !! Array sizes + real(wp), dimension(ncol, nlay, ngpt), intent(inout) :: tau, ssa, g + !! Optical depth, single-scattering albedo, asymmetry parameter + real(wp), dimension(ncol, nlay, ngpt), intent(in ) :: f + !! User-provided forward-scattering fraction + end subroutine delta_scale_2str_f_k + ! --------------------------------- + !> Delta-scale assuming forward-scatternig fraction is the square of the asymmetry parameter + !> i.e. \(f = g^2\) + ! + pure subroutine delta_scale_2str_k(ncol, nlay, ngpt, tau, ssa, g) & + bind(C, name="rte_delta_scale_2str_k") + use mo_rte_kind, only: wp, wl + integer, intent(in ) :: ncol, nlay, ngpt + !! Array sizes + real(wp), dimension(ncol, nlay, ngpt), intent(inout) :: tau, ssa, g + !! Optical depth, single-scattering albedo, asymmetry parameter + end subroutine delta_scale_2str_k + end interface delta_scale_2str_kernel + ! ------------------------------------------------------------------------------------------------- + ! + ! Addition of optical properties: the first set are incremented by the second set. + ! + ! There are three possible representations of optical properties (scalar = optical depth only; + ! two-stream = tau, single-scattering albedo, and asymmetry factor g, and + ! n-stream = tau, ssa, and phase function moments p.) Thus we need nine routines, three for + ! each choice of representation on the left hand side times three representations of the + ! optical properties to be added. + ! + ! There are two sets of these nine routines. In the first the two sets of optical + ! properties are defined at the same spectral resolution. There is also a set of routines + ! to add properties defined at lower spectral resolution to a set defined at higher spectral + ! resolution (adding properties defined by band to those defined by g-point) + ! + ! ------------------------------------------------------------------------------------------------- + !> increase one absorption optical depth by a second value + interface + pure subroutine increment_1scalar_by_1scalar(ncol, nlay, ngpt, & + tau1, & + tau2) bind(C, name="rte_increment_1scalar_by_1scalar") + use mo_rte_kind, only: wp, wl + integer, intent(in ) :: ncol, nlay, ngpt !! array sizes + real(wp), dimension(ncol,nlay,ngpt), intent(inout) :: tau1 !! optical properties to be modified + real(wp), dimension(ncol,nlay,ngpt), intent(in ) :: tau2 !! optical properties to be added to original + end subroutine increment_1scalar_by_1scalar + end interface + ! --------------------------------- + !> increase absorption optical depth with extinction optical depth (2-stream form) + interface + pure subroutine increment_1scalar_by_2stream(ncol, nlay, ngpt, & + tau1, & + tau2, ssa2) bind(C, name="rte_increment_1scalar_by_2stream") + use mo_rte_kind, only: wp, wl + integer, intent(in ) :: ncol, nlay, ngpt !! array sizes + real(wp), dimension(ncol,nlay,ngpt), intent(inout) :: tau1 !! optical properties to be modified + real(wp), dimension(ncol,nlay,ngpt), intent(in ) :: tau2, ssa2 !! optical properties to be added to original + end subroutine increment_1scalar_by_2stream + end interface + ! --------------------------------- + !> increase absorption optical depth with extinction optical depth (n-stream form) + interface + pure subroutine increment_1scalar_by_nstream(ncol, nlay, ngpt, & + tau1, & + tau2, ssa2) bind(C, name="rte_increment_1scalar_by_nstream") + use mo_rte_kind, only: wp, wl + integer, intent(in ) :: ncol, nlay, ngpt !! array sizes + real(wp), dimension(ncol,nlay,ngpt), intent(inout) :: tau1 !! optical properties to be modified + real(wp), dimension(ncol,nlay,ngpt), intent(in ) :: tau2, ssa2 !! optical properties to be added to original + end subroutine increment_1scalar_by_nstream + end interface + ! --------------------------------- + ! --------------------------------- + !> increment two-stream optical properties \(\tau, \omega_0, g\) with absorption optical depth + interface + pure subroutine increment_2stream_by_1scalar(ncol, nlay, ngpt, & + tau1, ssa1, & + tau2) bind(C, name="rte_increment_2stream_by_1scalar") + use mo_rte_kind, only: wp, wl + integer, intent(in ) :: ncol, nlay, ngpt !! array sizes + real(wp), dimension(ncol,nlay,ngpt), intent(inout) :: tau1, ssa1 !! optical properties to be modified + real(wp), dimension(ncol,nlay,ngpt), intent(in ) :: tau2 !! optical properties to be added to original + end subroutine increment_2stream_by_1scalar + end interface + ! --------------------------------- + !> increment two-stream optical properties \(\tau, \omega_0, g\) with a second set + interface + pure subroutine increment_2stream_by_2stream(ncol, nlay, ngpt, & + tau1, ssa1, g1, & + tau2, ssa2, g2) bind(C, name="rte_increment_2stream_by_2stream") + use mo_rte_kind, only: wp, wl + integer, intent(in ) :: ncol, nlay, ngpt !! array sizes + real(wp), dimension(ncol,nlay,ngpt), intent(inout) :: tau1, ssa1, g1 !! optical properties to be modified + real(wp), dimension(ncol,nlay,ngpt), intent(in ) :: tau2, ssa2, g2 !! optical properties to be added to original + end subroutine increment_2stream_by_2stream + end interface + ! --------------------------------- + !> increment two-stream optical properties \(\tau, \omega_0, g\) with _n_-stream + interface + pure subroutine increment_2stream_by_nstream(ncol, nlay, ngpt, nmom2, & + tau1, ssa1, g1, & + tau2, ssa2, p2) bind(C, name="rte_increment_2stream_by_nstream") + use mo_rte_kind, only: wp, wl + integer, intent(in ) :: ncol, nlay, ngpt, nmom2 !! array sizes + real(wp), dimension(ncol,nlay,ngpt), intent(inout) :: tau1, ssa1, g1 !! optical properties to be modified + real(wp), dimension(ncol,nlay,ngpt), intent(in ) :: tau2, ssa2 !! optical properties to be added to original + real(wp), dimension(nmom2, & + ncol,nlay,ngpt), intent(in ) :: p2 !! moments of the phase function to be added + end subroutine increment_2stream_by_nstream + end interface + ! --------------------------------- + ! --------------------------------- + !> increment _n_-stream optical properties \(\tau, \omega_0, p\) with absorption optical depth + interface + pure subroutine increment_nstream_by_1scalar(ncol, nlay, ngpt, & + tau1, ssa1, & + tau2) bind(C, name="rte_increment_nstream_by_1scalar") + use mo_rte_kind, only: wp, wl + integer, intent(in ) :: ncol, nlay, ngpt !! array sizes + real(wp), dimension(ncol,nlay,ngpt), intent(inout) :: tau1, ssa1 !! optical properties to be modified + real(wp), dimension(ncol,nlay,ngpt), intent(in ) :: tau2 !! optical properties to be added to original + end subroutine increment_nstream_by_1scalar + end interface + ! --------------------------------- + !> increment _n_-stream optical properties \(\tau, \omega_0, p\) with two-stream values + interface + pure subroutine increment_nstream_by_2stream(ncol, nlay, ngpt, nmom1, & + tau1, ssa1, p1, & + tau2, ssa2, g2) bind(C, name="rte_increment_nstream_by_2stream") + use mo_rte_kind, only: wp, wl + integer, intent(in ) :: ncol, nlay, ngpt, nmom1 !! array sizes + real(wp), dimension(ncol,nlay,ngpt), intent(inout) :: tau1, ssa1 !! optical properties to be modified + real(wp), dimension(nmom1, & + ncol,nlay,ngpt), intent(inout) :: p1 !! moments of the phase function be modified + real(wp), dimension(ncol,nlay,ngpt), intent(in ) :: tau2, ssa2, g2 !! optical properties to be added to original + end subroutine increment_nstream_by_2stream + end interface + ! --------------------------------- + !> increment one set of _n_-stream optical properties with another set + interface + pure subroutine increment_nstream_by_nstream(ncol, nlay, ngpt, nmom1, nmom2, & + tau1, ssa1, p1, & + tau2, ssa2, p2) bind(C, name="rte_increment_nstream_by_nstream") + use mo_rte_kind, only: wp, wl + integer, intent(in ) :: ncol, nlay, ngpt, nmom1, nmom2 !! array sizes + real(wp), dimension(ncol,nlay,ngpt), intent(inout) :: tau1, ssa1 !! optical properties to be modified + real(wp), dimension(nmom1, & + ncol,nlay,ngpt), intent(inout) :: p1 !! moments of the phase function be modified + real(wp), dimension(ncol,nlay,ngpt), intent(in ) :: tau2, ssa2 !! optical properties to be added to original + real(wp), dimension(nmom2, & + ncol,nlay,ngpt), intent(in ) :: p2 !! moments of the phase function to be added + end subroutine increment_nstream_by_nstream + end interface + ! ------------------------------------------------------------------------------------------------- + ! + ! Incrementing when the second set of optical properties is defined at lower spectral resolution + ! (e.g. by band instead of by gpoint) + ! + ! ------------------------------------------------------------------------------------------------- + !> increase one absorption optical depth defined on g-points by a second value defined on bands + interface + pure subroutine inc_1scalar_by_1scalar_bybnd(ncol, nlay, ngpt, & + tau1, & + tau2, & + nbnd, gpt_lims) bind(C, name="rte_inc_1scalar_by_1scalar_bybnd") + use mo_rte_kind, only: wp, wl + integer, intent(in ) :: ncol, nlay, ngpt, nbnd !! array sizes + real(wp), dimension(ncol,nlay,ngpt), intent(inout) :: tau1 !! optical properties to be modified (defined on g-points) + real(wp), dimension(ncol,nlay,nbnd), intent(in ) :: tau2 !! optical properties to be added to original (defined on bands) + integer, dimension(2,nbnd), intent(in ) :: gpt_lims !! Starting and ending gpoint for each band + end subroutine inc_1scalar_by_1scalar_bybnd + end interface + ! --------------------------------- + !> increase absorption optical depth defined on g-points with extinction optical depth (2-stream form) defined on bands + interface + pure subroutine inc_1scalar_by_2stream_bybnd(ncol, nlay, ngpt, & + tau1, & + tau2, ssa2, & + nbnd, gpt_lims) bind(C, name="rte_inc_1scalar_by_2stream_bybnd") + use mo_rte_kind, only: wp, wl + integer, intent(in ) :: ncol, nlay, ngpt, nbnd !! array sizes + real(wp), dimension(ncol,nlay,ngpt), intent(inout) :: tau1 !! optical properties to be modified (defined on g-points) + real(wp), dimension(ncol,nlay,nbnd), intent(in ) :: tau2, ssa2 !! optical properties to be added to original (defined on bands) + integer, dimension(2,nbnd), intent(in ) :: gpt_lims !! Starting and ending gpoint for each band + end subroutine inc_1scalar_by_2stream_bybnd + end interface + ! --------------------------------- + !> increase absorption optical depth defined on g-points with extinction optical depth (n-stream form) defined on bands + interface + pure subroutine inc_1scalar_by_nstream_bybnd(ncol, nlay, ngpt, & + tau1, & + tau2, ssa2, & + nbnd, gpt_lims) bind(C, name="rte_inc_1scalar_by_nstream_bybnd") + use mo_rte_kind, only: wp, wl + integer, intent(in ) :: ncol, nlay, ngpt, nbnd !! array sizes + real(wp), dimension(ncol,nlay,ngpt), intent(inout) :: tau1 !! optical properties to be modified (defined on g-points) + real(wp), dimension(ncol,nlay,nbnd), intent(in ) :: tau2, ssa2 !! optical properties to be added to original (defined on bands) + integer, dimension(2,nbnd), intent(in ) :: gpt_lims !! Starting and ending gpoint for each band + end subroutine inc_1scalar_by_nstream_bybnd + end interface + ! --------------------------------- + !> increment two-stream optical properties \(\tau, \omega_0, g\) defined on g-points with absorption optical depth defined on bands + interface + pure subroutine inc_2stream_by_1scalar_bybnd(ncol, nlay, ngpt, & + tau1, ssa1, & + tau2, & + nbnd, gpt_lims) bind(C, name="rte_inc_2stream_by_1scalar_bybnd") + use mo_rte_kind, only: wp, wl + integer, intent(in ) :: ncol, nlay, ngpt, nbnd !! array sizes + real(wp), dimension(ncol,nlay,ngpt), intent(inout) :: tau1, ssa1 !! optical properties to be modified (defined on g-points) + real(wp), dimension(ncol,nlay,nbnd), intent(in ) :: tau2 !! optical properties to be added to original (defined on bands) + integer, dimension(2,nbnd), intent(in ) :: gpt_lims !! Starting and ending gpoint for each band + end subroutine inc_2stream_by_1scalar_bybnd + end interface + ! --------------------------------- + !> increment 2-stream optical properties defined on g-points with another set defined on bands + interface + pure subroutine inc_2stream_by_2stream_bybnd(ncol, nlay, ngpt, & + tau1, ssa1, g1, & + tau2, ssa2, g2, & + nbnd, gpt_lims) bind(C, name="rte_inc_2stream_by_2stream_bybnd") + use mo_rte_kind, only: wp, wl + integer, intent(in ) :: ncol, nlay, ngpt, nbnd !! array sizes + real(wp), dimension(ncol,nlay,ngpt), intent(inout) :: tau1, ssa1, g1 !! optical properties to be modified (defined on g-points) + real(wp), dimension(ncol,nlay,nbnd), intent(in ) :: tau2, ssa2, g2 !! optical properties to be added to original (defined on bands) + integer, dimension(2,nbnd), intent(in ) :: gpt_lims !! Starting and ending gpoint for each band + end subroutine inc_2stream_by_2stream_bybnd + end interface + ! --------------------------------- + !> increment 2-stream optical properties defined on g-points with _n_-stream properties set defined on bands + interface + pure subroutine inc_2stream_by_nstream_bybnd(ncol, nlay, ngpt, nmom2, & + tau1, ssa1, g1, & + tau2, ssa2, p2, & + nbnd, gpt_lims) bind(C, name="rte_inc_2stream_by_nstream_bybnd") + use mo_rte_kind, only: wp, wl + integer, intent(in ) :: ncol, nlay, ngpt, nmom2, nbnd !! array sizes + real(wp), dimension(ncol,nlay,ngpt), intent(inout) :: tau1, ssa1, g1 !! optical properties to be modified (defined on g-points) + real(wp), dimension(ncol,nlay,nbnd), intent(in ) :: tau2, ssa2 !! optical properties to be added to original (defined on bands) + real(wp), dimension(nmom2, & + ncol,nlay,nbnd), intent(in ) :: p2 !! moments of the phase function to be added + integer, dimension(2,nbnd), intent(in ) :: gpt_lims !! Starting and ending gpoint for each band + end subroutine inc_2stream_by_nstream_bybnd + end interface + ! --------------------------------- + ! --------------------------------- + !> increment _n_-stream optical properties defined on g-points with absorption optical depth defined on bands + interface + pure subroutine inc_nstream_by_1scalar_bybnd(ncol, nlay, ngpt, & + tau1, ssa1, & + tau2, & + nbnd, gpt_lims) bind(C, name="rte_inc_nstream_by_1scalar_bybnd") + use mo_rte_kind, only: wp, wl + integer, intent(in ) :: ncol, nlay, ngpt, nbnd !! array sizes + real(wp), dimension(ncol,nlay,ngpt), intent(inout) :: tau1, ssa1 !! optical properties to be modified (defined on g-points) + real(wp), dimension(ncol,nlay,nbnd), intent(in ) :: tau2 !! optical properties to be added to original (defined on bands) + integer, dimension(2,nbnd), intent(in ) :: gpt_lims !! Starting and ending gpoint for each band + end subroutine inc_nstream_by_1scalar_bybnd + end interface + ! --------------------------------- + !> increment n-stream optical properties defined on g-points with 2-stream properties set defined on bands + interface + pure subroutine inc_nstream_by_2stream_bybnd(ncol, nlay, ngpt, nmom1, & + tau1, ssa1, p1, & + tau2, ssa2, g2, & + nbnd, gpt_lims) bind(C, name="rte_inc_nstream_by_2stream_bybnd") + use mo_rte_kind, only: wp, wl + integer, intent(in ) :: ncol, nlay, ngpt, nmom1, nbnd !! array sizes + real(wp), dimension(ncol,nlay,ngpt), intent(inout) :: tau1, ssa1 !! optical properties to be modified (defined on g-points) + real(wp), dimension(nmom1, & + ncol,nlay,ngpt), intent(inout) :: p1 !! moments of the phase function be modified + real(wp), dimension(ncol,nlay,nbnd), intent(in ) :: tau2, ssa2, g2 !! optical properties to be added to original (defined on bands) + integer, dimension(2,nbnd), intent(in ) :: gpt_lims !! Starting and ending gpoint for each band + end subroutine inc_nstream_by_2stream_bybnd + end interface + ! --------------------------------- + !> increment _n_-stream optical properties defined on g-points with a second set defined on bands + interface + pure subroutine inc_nstream_by_nstream_bybnd(ncol, nlay, ngpt, nmom1, nmom2, & + tau1, ssa1, p1, & + tau2, ssa2, p2, & + nbnd, gpt_lims) bind(C, name="rte_inc_nstream_by_nstream_bybnd") + use mo_rte_kind, only: wp, wl + integer, intent(in ) :: ncol, nlay, ngpt, nmom1, nmom2, nbnd !! array sizes + real(wp), dimension(ncol,nlay,ngpt), intent(inout) :: tau1, ssa1 !! optical properties to be modified (defined on g-points) + real(wp), dimension(nmom1, & + ncol,nlay,ngpt), intent(inout) :: p1 !! moments of the phase function be modified + real(wp), dimension(ncol,nlay,nbnd), intent(in ) :: tau2, ssa2 !! optical properties to be added to original (defined on bands) + real(wp), dimension(nmom2, & + ncol,nlay,nbnd), intent(in ) :: p2 !! moments of the phase function to be added + integer, dimension(2,nbnd), intent(in ) :: gpt_lims !! Starting and ending gpoint for each band + end subroutine inc_nstream_by_nstream_bybnd + end interface + ! ------------------------------------------------------------------------------------------------- + ! + ! Subsetting, meaning extracting some portion of the 3D domain + ! + ! ------------------------------------------------------------------------------------------------- + !> + !> Extract a subset from the first dimension (normally columns) of a 3D field. + !> Applicable to most variables e.g. tau, ssa, g + !> + interface extract_subset + pure subroutine extract_subset_dim1_3d(ncol, nlay, ngpt, array_in, colS, colE, array_out) & + bind (C, name="rte_extract_subset_dim1_3d") + use mo_rte_kind, only: wp, wl + integer, intent(in ) :: ncol, nlay, ngpt !! Array sizes + real(wp), dimension(ncol,nlay,ngpt), intent(in ) :: array_in !! Array to subset + integer, intent(in ) :: colS, colE !! Starting and ending index + real(wp), dimension(colE-colS+1,& + nlay,ngpt), intent(out) :: array_out !! subset of the input array + end subroutine extract_subset_dim1_3d + ! --------------------------------- + !> Extract a subset from the second dimension (normally columns) of a 4D field. + !> Applicable to phase function moments, where the first dimension is the moment + pure subroutine extract_subset_dim2_4d(nmom, ncol, nlay, ngpt, array_in, colS, colE, array_out) & + bind (C, name="rte_extract_subset_dim2_4d") + use mo_rte_kind, only: wp, wl + integer, intent(in ) :: nmom, ncol, nlay, ngpt !! Array sizes + real(wp), dimension(nmom,ncol,nlay,ngpt), intent(in ) :: array_in !! Array to subset + integer, intent(in ) :: colS, colE !! Starting and ending index + real(wp), dimension(nmom,colE-colS+1,& + nlay,ngpt), intent(out) :: array_out !! subset of the input array + end subroutine extract_subset_dim2_4d + ! --------------------------------- + ! + !> Extract the absorption optical thickness \(\tau_{abs} = 1 - \omega_0 \tau_{ext}\) + ! + pure subroutine extract_subset_absorption_tau(ncol, nlay, ngpt, tau_in, ssa_in, & + colS, colE, tau_out) & + bind (C, name="rte_extract_subset_absorption_tau") + use mo_rte_kind, only: wp, wl + integer, intent(in ) :: ncol, nlay, ngpt !! Array sizes + real(wp), dimension(ncol,nlay,ngpt), intent(in ) :: tau_in, ssa_in !! Optical thickness, single scattering albedo + integer, intent(in ) :: colS, colE !! Starting and ending index + real(wp), dimension(colE-colS+1,& + nlay,ngpt), intent(out) :: tau_out !! absorption optical thickness subset + end subroutine extract_subset_absorption_tau + end interface extract_subset +end module mo_optical_props_kernels diff --git a/rte-kernels/api/mo_rte_solver_kernels.F90 b/rte-kernels/api/mo_rte_solver_kernels.F90 new file mode 100644 index 000000000..da8d0f706 --- /dev/null +++ b/rte-kernels/api/mo_rte_solver_kernels.F90 @@ -0,0 +1,202 @@ +! This code is part of Radiative Transfer for Energetics (RTE) +! +! Contacts: Robert Pincus and Eli Mlawer +! email: rrtmgp@aer.com +! +! Copyright 2015-, Atmospheric and Environmental Research, +! Regents of the University of Colorado, Trustees of Columbia University. All right reserved. +! +! Use and duplication is permitted under the terms of the +! BSD 3-clause license, see http://opensource.org/licenses/BSD-3-Clause +! ------------------------------------------------------------------------------------------------- +! +!>## Numeric calculations for radiative transfer solvers +!> - Emission/absorption (no-scattering) calculations +!> - solver for multi-angle Gaussian quadrature +!> - Extinction-only calculation (direct solar beam) +!> - Two-stream calculations: +!> solvers for LW and SW with different boundary conditions and source functions +! +! ------------------------------------------------------------------------------------------------- +module mo_rte_solver_kernels + use, intrinsic :: iso_c_binding + use mo_rte_kind, only: wp, wl + implicit none + private + + public :: lw_solver_noscat, lw_solver_2stream, & + sw_solver_noscat, sw_solver_2stream + ! ------------------------------------------------------------------------------------------------- + ! + ! Top-level longwave kernels + ! + ! ------------------------------------------------------------------------------------------------- + ! + !> LW transport, no scattering, multi-angle quadrature + !> Users provide a set of weights and quadrature angles + !> Routine sums over single-angle solutions for each sets of angles/weights + ! + ! --------------------------------------------------------------- + interface + subroutine lw_solver_noscat(ncol, nlay, ngpt, top_at_1, & + nmus, Ds, weights, & + tau, & + lay_source, lev_source, & + sfc_emis, sfc_src, & + inc_flux, & + flux_up, flux_dn, & + do_broadband, broadband_up, broadband_dn, & + do_Jacobians, sfc_srcJac, flux_upJac, & + do_rescaling, ssa, g) bind(C, name="rte_lw_solver_noscat") + use mo_rte_kind, only: wp, wl + integer, intent(in ) :: ncol, nlay, ngpt + !! Number of columns, layers, g-points + logical(wl), intent(in ) :: top_at_1 + !! ilay = 1 is the top of the atmosphere? + integer, intent(in ) :: nmus + !! number of quadrature angles + real(wp), dimension (ncol, ngpt, & + nmus), intent(in ) :: Ds + !! quadrature secants + real(wp), dimension(nmus), intent(in ) :: weights + !! quadrature weights + real(wp), dimension(ncol,nlay, ngpt), intent(in ) :: tau + !! Absorption optical thickness [] + real(wp), dimension(ncol,nlay, ngpt), intent(in ) :: lay_source + !! Planck source at layer average temperature [W/m2] + real(wp), dimension(ncol,nlay+1,ngpt), intent(in ) :: lev_source + !! Planck source at layer edge for radiation [W/m2] + real(wp), dimension(ncol, ngpt), intent(in ) :: sfc_emis + !! Surface emissivity [] + real(wp), dimension(ncol, ngpt), intent(in ) :: sfc_src + !! Surface source function [W/m2] + real(wp), dimension(ncol, ngpt), intent(in ) :: inc_flux + !! Incident diffuse flux, probably 0 [W/m2] + real(wp), dimension(ncol,nlay+1,ngpt), target, & + intent( out) :: flux_up, flux_dn + !! Fluxes [W/m2] + ! + ! Optional variables - arrays aren't referenced if corresponding logical == False + ! + logical(wl), intent(in ) :: do_broadband + real(wp), dimension(ncol,nlay+1 ), target, & + intent( out) :: broadband_up, broadband_dn + !! Spectrally-integrated fluxes [W/m2] + logical(wl), intent(in ) :: do_Jacobians + !! compute Jacobian with respect to surface temeprature? + real(wp), dimension(ncol ,ngpt), intent(in ) :: sfc_srcJac + !! surface temperature Jacobian of surface source function [W/m2/K] + real(wp), dimension(ncol,nlay+1 ), target, & + intent( out) :: flux_upJac + !! surface temperature Jacobian of Radiances [W/m2-str / K] + logical(wl), intent(in ) :: do_rescaling + !! Approximate treatment of scattering (10.1175/JAS-D-18-0014.1) + real(wp), dimension(ncol,nlay ,ngpt), intent(in ) :: ssa, g + !! single-scattering albedo, asymmetry parameter + end subroutine lw_solver_noscat + end interface + ! ------------------------------------------------------------------------------------------------- + ! + !> Longwave two-stream calculation: + !> - combine RRTMGP-specific sources at levels + !> - compute layer reflectance, transmittance + !> - compute total source function at levels using linear-in-tau + !> - transport + ! + ! ------------------------------------------------------------------------------------------------- + interface + subroutine lw_solver_2stream (ncol, nlay, ngpt, top_at_1, & + tau, ssa, g, & + lay_source, lev_source, sfc_emis, sfc_src, & + inc_flux, & + flux_up, flux_dn) bind(C, name="rte_lw_solver_2stream") + use mo_rte_kind, only: wp, wl + integer, intent(in ) :: ncol, nlay, ngpt + !! Number of columns, layers, g-points + logical(wl), intent(in ) :: top_at_1 + !! ilay = 1 is the top of the atmosphere? + real(wp), dimension(ncol,nlay, ngpt), intent(in ) :: tau, ssa, g + !! Optical thickness, single-scattering albedo, asymmetry parameter [] + real(wp), dimension(ncol,nlay, ngpt), intent(in ) :: lay_source + !! Planck source at layer average temperature [W/m2] + real(wp), dimension(ncol,nlay+1,ngpt), intent(in ) :: lev_source + !! Planck source at layer edge for radiation [W/m2] + real(wp), dimension(ncol, ngpt), intent(in ) :: sfc_emis + !! Surface emissivity [] + real(wp), dimension(ncol, ngpt), intent(in ) :: sfc_src + !! Surface source function [W/m2] + real(wp), dimension(ncol, ngpt), intent(in ) :: inc_flux + !! Incident diffuse flux, probably 0 [W/m2] + real(wp), dimension(ncol,nlay+1,ngpt), intent( out) :: flux_up, flux_dn + !! Fluxes [W/m2] + end subroutine lw_solver_2stream + end interface + ! ------------------------------------------------------------------------------------------------- + ! + ! Top-level shortwave kernels + ! + ! ------------------------------------------------------------------------------------------------- + ! + ! !> Extinction-only shortwave solver i.e. solar direct beam + ! + ! ------------------------------------------------------------------------------------------------- + interface + pure subroutine sw_solver_noscat(ncol, nlay, ngpt, top_at_1, & + tau, mu0, inc_flux_dir, flux_dir) bind(C, name="rte_sw_solver_noscat") + use mo_rte_kind, only: wp, wl + integer, intent(in ) :: ncol, nlay, ngpt ! Number of columns, layers, g-points + !! Number of columns, layers, g-points + logical(wl), intent(in ) :: top_at_1 + !! ilay = 1 is the top of the atmosphere? + real(wp), dimension(ncol,nlay, ngpt), intent(in ) :: tau + !! Absorption optical thickness [] + real(wp), dimension(ncol,nlay ), intent(in ) :: mu0 + !! cosine of solar zenith angle + real(wp), dimension(ncol, ngpt), intent(in ) :: inc_flux_dir + !! Direct beam incident flux [W/m2] + real(wp), dimension(ncol,nlay+1,ngpt), intent(out) :: flux_dir + end subroutine sw_solver_noscat + end interface + ! ------------------------------------------------------------------------------------------------- + ! + !> Shortwave two-stream calculation: + !> compute layer reflectance, transmittance + !> compute solar source function for diffuse radiation + !> transport + ! + ! ------------------------------------------------------------------------------------------------- + interface + subroutine sw_solver_2stream (ncol, nlay, ngpt, top_at_1, & + tau, ssa, g, mu0, & + sfc_alb_dir, sfc_alb_dif, & + inc_flux_dir, & + flux_up, flux_dn, flux_dir, & + has_dif_bc, inc_flux_dif, & + do_broadband, broadband_up, & + broadband_dn, broadband_dir) bind(C, name="rte_sw_solver_2stream") + use mo_rte_kind, only: wp, wl + integer, intent(in ) :: ncol, nlay, ngpt + !! Number of columns, layers, g-points + logical(wl), intent(in ) :: top_at_1 + !! ilay = 1 is the top of the atmosphere? + real(wp), dimension(ncol,nlay, ngpt), intent(in ) :: tau, ssa, g + !! Optical thickness, single-scattering albedo, asymmetry parameter [] + real(wp), dimension(ncol,nlay ), intent(in ) :: mu0 + !! cosine of solar zenith angle + real(wp), dimension(ncol, ngpt), intent(in ) :: sfc_alb_dir, sfc_alb_dif + !! Spectral surface albedo for direct and diffuse radiation + real(wp), dimension(ncol, ngpt), intent(in ) :: inc_flux_dir + !! Direct beam incident flux + real(wp), dimension(ncol,nlay+1,ngpt), target, & + intent( out) :: flux_up, flux_dn, flux_dir + !! Fluxes [W/m2] + logical(wl), intent(in ) :: has_dif_bc + !! Is a boundary condition for diffuse flux supplied? + real(wp), dimension(ncol, ngpt), intent(in ) :: inc_flux_dif + !! Boundary condition for diffuse flux [W/m2] + logical(wl), intent(in ) :: do_broadband + !! Provide broadband-integrated, not spectrally-resolved, fluxes? + real(wp), dimension(ncol,nlay+1 ), intent( out) :: broadband_up, broadband_dn, broadband_dir + end subroutine sw_solver_2stream + end interface +end module mo_rte_solver_kernels diff --git a/rte-kernels/api/mo_rte_util_array.F90 b/rte-kernels/api/mo_rte_util_array.F90 new file mode 100644 index 000000000..cdae473c4 --- /dev/null +++ b/rte-kernels/api/mo_rte_util_array.F90 @@ -0,0 +1,47 @@ +! This code is part of Radiative Transfer for Energetics (RTE) +! +! Contacts: Robert Pincus and Eli Mlawer +! email: rrtmgp@aer.com +! +! Copyright 2015- Atmospheric and Environmental Research, +! Regents of the University of Colorado, +! Trustees of Columbia University in the City of New York +! All right reserved. +! +! Use and duplication is permitted under the terms of the +! BSD 3-clause license, see http://opensource.org/licenses/BSD-3-Clause +! ------------------------------------------------------------------------------------------------- +module mo_rte_util_array + use mo_rte_kind, only: wp, wl + implicit none + public :: zero_array + + !------------------------------------------------------------------------------------------------- + ! Initializing arrays to 0 + !------------------------------------------------------------------------------------------------- + interface zero_array + subroutine zero_array_1D(ni, array) bind(C, name="zero_array_1D") + use mo_rte_kind, only: wp, wl + integer, intent(in ) :: ni + real(wp), dimension(ni), intent(out) :: array + end subroutine zero_array_1D + ! ---------------------------------------------------------- + subroutine zero_array_2D(ni, nj, array) bind(C, name="zero_array_2D") + use mo_rte_kind, only: wp, wl + integer, intent(in ) :: ni, nj + real(wp), dimension(ni, nj), intent(out) :: array + end subroutine zero_array_2D + ! ---------------------------------------------------------- + subroutine zero_array_3D(ni, nj, nk, array) bind(C, name="zero_array_3D") + use mo_rte_kind, only: wp, wl + integer, intent(in ) :: ni, nj, nk + real(wp), dimension(ni, nj, nk), intent(out) :: array + end subroutine zero_array_3D + ! ---------------------------------------------------------- + subroutine zero_array_4D(ni, nj, nk, nl, array) bind(C, name="zero_array_4D") + use mo_rte_kind, only: wp, wl + integer, intent(in ) :: ni, nj, nk, nl + real(wp), dimension(ni, nj, nk, nl), intent(out) :: array + end subroutine zero_array_4D + end interface zero_array +end module mo_rte_util_array diff --git a/rte-kernels/api/rte_kernels.h b/rte-kernels/api/rte_kernels.h new file mode 100644 index 000000000..71f86b81e --- /dev/null +++ b/rte-kernels/api/rte_kernels.h @@ -0,0 +1,389 @@ +/* This code is part of Radiative Transfer for Energetics (RTE) + +Contacts: Robert Pincus and Eli Mlawer +email: rrtmgp@aer.com + +Copyright 2024- + Trustees of Columbia University in the City of New York + All right reserved. + +Use and duplication is permitted under the terms of the + BSD 3-clause license, see http://opensource.org/licenses/BSD-3-Clause + +This header files defines the C bindings for the kernels used in RTE + Adapted from code written by Chiel van Heerwaarden at Wageningen University and Research + +*/ + +#include "rte_types.h" + +extern "C" +{ + // + // Shortwave solvers + // + void rte_sw_solver_noscat( + const int& ncol, const int& nlay, const int& ngpt, const Bool& top_at_1, + const Float* tau, // (ncol,nlay, ngpt) + const Float* mu0, // (ncol,nlay) + const Float* inc_flux_dir, // (ncol, ngpt) + Float* flux_dir); // [out] (ncol,nlay+1,ngpt) + + void rte_sw_solver_2stream( + const int& ncol, + const int& nlay, + const int& ngpt, + const Bool& top_at_1, + const Float* tau, // (ncol,nlay, ngpt) + const Float* ssa, // (ncol,nlay, ngpt) + const Float* g, // (ncol,nlay, ngpt) + const Float* mu0, // (ncol,nlay) + const Float* sfc_alb_dir, // (ncol, ngpt) + const Float* sfc_alb_dif, // (ncol, ngpt) + const Float* inc_flux_dir, // (ncol, ngpt) + Float* flux_up, // [out] (ncol,nlay+1,ngpt) + Float* flux_dn, // [out] (ncol,nlay+1,ngpt) + Float* flux_dir, // [out] (ncol,nlay+1,ngpt) + const Bool& has_dif_bc, + const Float* inc_flux_dif, // (ncol, ngpt) + const Bool& do_broadband, + Float* broadband_up, // [out] (ncol,nlay+1) + Float* broadband_dn, // [out] (ncol,nlay+1) + Float* broadband_dir); // [out] (ncol,nlay+1) + + void rte_lw_solver_noscat( + const int& ncol, + const int& nlay, + const int& ngpt, + const Bool& top_at_1, + const int& nmus, + const Float* secants, // (nmus) + const Float* weights, // (nmus) + const Float* tau, // (ncol,nlay, ngpt) + const Float* lay_source, // (ncol,nlay, ngpt) + const Float* lev_source, // (ncol,nlay+1,ngpt) + const Float* sfc_emis, // (ncol, ngpt) + const Float* sfc_src, // (ncol, ngpt) + const Float* inc_flux, // (ncol, ngpt) + Float* flux_up, // [out] (ncol,nlay+1,ngpt) + Float* flux_dn, // [out] (ncol,nlay+1,ngpt) + const Bool& do_broadband, + Float* broadband_up, + // [out] (ncol,nlay+1) + Float* broadband_dn, + // [out] (ncol,nlay+1) + const Bool& do_jacobians, + const Float* sfc_src_jac, + // (ncol, ngpt) + Float* flux_up_jac, + // [out] (ncol,nlay+1,ngpt) + const Bool& do_rescaling, + const Float* ssa, // (ncol,nlay, ngpt) + const Float* g); // (ncol,nlay, ngpt) + + + void rte_lw_solver_2stream( + const int& ncol, + const int& nlay, + const int& ngpt, + const Bool& top_at_1, + const Float* tau, // (ncol,nlay, ngpt) + const Float* ssa, // (ncol,nlay, ngpt) + const Float* g, // (ncol,nlay, ngpt) + const Float* lay_source, // (ncol,nlay, ngpt) + const Float* lev_source, // (ncol,nlay+1,ngpt) + const Float* sfc_emis, // (ncol, ngpt) + const Float* sfc_src, // (ncol, ngpt) + const Float* inc_flux, // (ncol, ngpt) + Float* flux_up, // [out] (ncol,nlay+1,ngpt) + Float* flux_dn // [out] (ncol,nlay+1,ngpt) + ); + + // + // OPTICAL PROPS - INCREMENT + // + void rte_increment_1scalar_by_1scalar( + const int& ncol, + const int& nlay, + const int& ngpt, + Float* tau_inout, // [inout] (ncol,nlay,ngpt) + const Float* tau_in); // (ncol,nlay,ngpt) + + + void rte_increment_1scalar_by_2stream( + const int& ncol, + const int& nlay, + const int& ngpt, + Float* tau_inout, // [inout] (ncol,nlay,ngpt) + const Float* tau_in, // (ncol,nlay,ngpt) + const Float* ssa_in); // (ncol,nlay,ngpt) + + void rte_increment_1scalar_by_nstream( + const int& ncol, + const int& nlay, + const int& ngpt, + Float* tau_inout, // [inout] (ncol,nlay,ngpt) + const Float* tau_in, // (ncol,nlay,ngpt) + const Float* ssa_in); // (ncol,nlay,ngpt) + + void rte_increment_2stream_by_1scalar( + const int& ncol, + const int& nlay, + const int& ngpt, + Float* tau_inout, // [inout] (ncol,nlay,ngpt) + Float* ssa_inout, // [inout] (ncol,nlay,ngpt) + const Float* tau_in); // (ncol,nlay,ngpt) + + void rte_increment_2stream_by_2stream( + const int& ncol, + const int& nlay, + const int& ngpt, + Float* tau_inout, // [inout] (ncol,nlay,ngpt) + Float* ssa_inout, // [inout] (ncol,nlay,ngpt) + Float* g_inout, // [inout] (ncol,nlay,ngpt) + const Float* tau_in, // (ncol,nlay,ngpt) + const Float* ssa_in, // (ncol,nlay,ngpt) + const Float* g_in); // (ncol,nlay,ngpt) + + + void rte_increment_2stream_by_nstream( + const int& ncol, const int& nlay, const int& ngpt, const int& nmom, + Float* tau_inout, // [inout] (ncol,nlay,ngpt) + Float* ssa_inout, // [inout] (ncol,nlay,ngpt) + Float* g_inout, // [inout] (ncol,nlay,ngpt) + const Float* tau_in, // (ncol,nlay,ngpt) + const Float* ssa_in, // (ncol,nlay,ngpt) + const Float* p_in); //(nmom,ncol,nlay,ngpt) + + void rte_increment_nstream_by_1scalar( + const int& ncol, + const int& nlay, + const int& ngpt, + Float* tau_inout, // [inout] (ncol,nlay,ngpt) + const Float* tau_in, // (ncol,nlay,ngpt) + const Float* ssa_in); // (ncol,nlay,ngpt) + + void rte_increment_nstream_by_2stream( + const int& ncol, + const int& nlay, + const int& ngpt, + const int& nmom1, + Float* tau_inout, // [inout] (ncol,nlay,ngpt) + Float* ssa_inout, // [inout] (ncol,nlay,ngpt) + Float* p_inout, // [inout] (nmom,ncol,nlay,ngpt) + const Float* tau_in, // (ncol,nlay,ngpt) + const Float* ssa_in, // (ncol,nlay,ngpt) + const Float* g_in); // (ncol,nlay,ngpt) + + void rte_increment_nstream_by_nstream( + const int& ncol, + const int& nlay, + const int& ngpt, + const int& nmom1, + const int& nmom2, + Float* tau_inout, // [inout] (ncol,nlay,ngpt) + Float* ssa_inout, // [inout] (ncol,nlay,ngpt) + Float* p_inout, // [inout](nmom1,ncol,nlay,ngpt) + const Float* tau_in, // (ncol,nlay,ngpt) + const Float* ssa_in, // (ncol,nlay,ngpt) + const Float* p_in); // (nmom2,ncol,nlay,ngpt) + + // + // OPTICAL PROPS - INCREMENT BYBND + // + void rte_inc_1scalar_by_1scalar_bybnd( + const int& ncol, + const int& nlay, + const int& ngpt, + Float* tau_inout,// [inout] (ncol,nlay,ngpt) + const Float* tau_in, // (ncol,nlay,nbnd) + const int& nbnd, + const int* band_lims_gpoint); // (2,nbnd) + + void rte_inc_1scalar_by_2stream_bybnd( + const int& ncol, + const int& nlay, + const int& ngpt, + Float* tau_inout, // [inout] (ncol,nlay,ngpt) + const Float* tau_in, // (ncol,nlay,nbnd) + const Float* ssa_in, // (ncol,nlay,nbnd) + const int& nbnd, + const int* band_lims_gpoint); // (2,nbnd) + + void rte_inc_1scalar_by_nstream_bybnd( + const int& ncol, + const int& nlay, + const int& ngpt, + Float* tau_inout, // [inout] (ncol,nlay,ngpt) + const Float* tau_in, // (ncol,nlay,nbnd) + const Float* ssa_in, // (ncol,nlay,nbnd) + const int& nbnd, + const int* band_lims_gpoint); // (2,nbnd) + + void rte_inc_2stream_by_1scalar_bybnd( + const int& ncol, + const int& nlay, + const int& ngpt, + Float* tau_inout, // [inout] (ncol,nlay,ngpt) + Float* ssa_inout, // [inout] (ncol,nlay,ngpt) + const Float* tau_in, // (ncol,nlay,nbnd) + const int& nbnd, + const int* band_lims_gpoint); // (2,nbnd) + + void rte_inc_2stream_by_2stream_bybnd( + const int& ncol, + const int& nlay, + const int& ngpt, + Float* tau_inout, // [inout] (ncol,nlay,ngpt) + Float* ssa_inout, // [inout] (ncol,nlay,ngpt) + Float* g_inout, // [inout] (ncol,nlay,ngpt) + const Float* tau_in, // (ncol,nlay,nbnd) + const Float* ssa_in, // (ncol,nlay,nbnd) + const Float* g_in, // (ncol,nlay,nbnd) + const int& nbnd, + const int* band_lims_gpoint); // (2,nbnd) + + void rte_inc_2stream_by_nstream_bybnd( + const int& ncol, + const int& nlay, + const int& ngpt, + const int& nmom, + Float* tau_inout, // [inout] (ncol,nlay,ngpt) + Float* ssa_inout, // [inout] (ncol,nlay,ngpt) + Float* g_inout, // [inout] (ncol,nlay,ngpt) + const Float* tau_in, // (ncol,nlay,nbnd) + const Float* ssa_in, // (ncol,nlay,nbnd) + const Float* p_in, // (nmom,ncol,nlay,nbnd) + const int& nbnd, + const int* band_lims_gpoint); // (2,nbnd) + + void rte_inc_nstream_by_1scalar_bybnd( + const int& ncol, + const int& nlay, + const int& ngpt, + Float* tau_inout, // [inout] (ncol,nlay,ngpt) + Float* ssa_inout, // [inout] (ncol,nlay,ngpt) + const Float* tau_in, // (ncol,nlay,nbnd) + const int& nbnd, + const int* band_lims_gpoint); // (2,nbnd) + + void rte_inc_nstream_by_2stream_bybnd( + const int& ncol, + const int& nlay, + const int& ngpt, + const int& nmom1, + Float* tau_inout, // [inout] (ncol,nlay,ngpt) + Float* ssa_inout, // [inout] (ncol,nlay,ngpt) + Float* p_inout, + // [inout] (nomo,ncol,nlay,ngpt) + const Float* tau_in, // (ncol,nlay,nbnd) + const Float* ssa_in, // (ncol,nlay,nbnd) + const Float* g_in, // (ncol,nlay,nbnd) + const int& nbnd, + const int* band_lims_gpoint); // (2,nbnd) + + void rte_inc_nstream_by_nstream_bybnd( + const int& ncol, + const int& nlay, + const int& ngpt, + const int& nmom1, + const int& nmom2, + Float* tau_inout, // [inout] (ncol,nlay,ngpt) + Float* ssa_inout, // [inout] (ncol,nlay,ngpt) + Float* p_inout, + // [inout] (nomo,ncol,nlay,ngpt) + const Float* tau_in, // (ncol,nlay,nbnd) + const Float* ssa_in, // (ncol,nlay,nbnd) + const Float* p_in, // (nmom,ncol,nlay,nbnd) + const int& nbnd, + const int* band_lims_gpoint); // (2,nbnd) + + // + // OPTICAL PROPS - DELTA SCALING + // + void rte_delta_scale_2str_k( + const int& ncol, const int& nlay, const int& ngpt, + Float* tau_inout, // [inout] (ncol,nlev,ngpt) + Float* ssa_inout, // [inout] (ncol,nlev,ngpt) + Float* g_inout); // [inout] (ncol,nlev,ngpt) + + void rte_delta_scale_2str_f_k( + const int& ncol, const int& nlay, const int& ngpt, + Float* tau_inout, // [inout] (ncol,nlev,ngpt) + Float* ssa_inout, // [inout] (ncol,nlev,ngpt) + Float* g_inout, // [inout] (ncol,nlev,ngpt) + const Float* f); // (ncol,nlev,ngpt) + + // + // OPTICAL PROPS - SUBSET + // + void rte_extract_subset_dim1_3d( + const int& ncol, const int& nlay, const int& ngpt, + Float* array_in, // (ncol,nlay,ngpt) + const int& ncol_start, const int& ncol_end, + Float* array_out); // [out] (ncol_end-ncol_start+1,nlay,ngpt) + + void rte_extract_subset_dim2_4d( + const int& nmom, const int& ncol, const int& nlay, const int& ngpt, + const Float* array_in, // (nmom,ncol,nlay,ngpt) + const int& ncol_start, const int& ncol_end, + Float* array_out); // [out] (nmom,ncol_end-ncol_start+1,nlay,ngpt) + + void rte_extract_subset_absorption_tau( + const int& ncol, const int& nlay, const int& ngpt, + const Float* tau_in, // (ncol,nlay,ngpt) + const Float* ssa_in, // (ncol,nlay,ngpt) + const int& ncol_start, const int& ncol_end, + Float* tau_out); // [out] (ncol_end-ncol_start+1,nlay,ngpt) + + // + // Fluxes - reduction + // + void rte_sum_broadband( + const int& ncol, const int& nlev, const int& ngpt, + const Float* gpt_flux, // (ncol,nlev,ngpt) + Float* flux); // [out] (ncol,nlev) + + void rte_net_broadband_full( + const int& ncol, const int& nlev, const int& ngpt, + const Float* gpt_flux_dn, // (ncol,nlev,ngpt) + const Float* gpt_flux_up, // (ncol,nlev,ngpt) + Float* flux_net); // [out] (ncol,nlev) + + void rte_net_broadband_precalc( + const int& ncol, const int& nlev, + const Float* broadband_flux_dn, // (ncol, nlev) + const Float* broadband_flux_up, // (ncol, nlev) + Float* broadband_flux_net);//[out] (ncol, nlev) + + void rte_sum_byband( + const int& ncol, const int& nlev, const int& ngpt, const int& nbnd, + const int* band_lims, // dimension(2, nbnd) + const Float* gpt_flux, // (ncol, nlev, ngpt) + Float* bnd_flux); // [out] (ncol, nlev, ngpt) + + void rte_net_byband_full( + const int& ncol, const int& nlev, const int& ngpt, const int& nbnd, int* band_lims, + const Float* bnd_flux_dn, // (ncol,nlev,nbnd) + const Float* bnd_flux_up, // (ncol,nlev,nbnd) + Float* bnd_flux_net); // [out] (ncol,nlev) + // + // Array utilities + // + void zero_array_1D( + const int& ni, + Float* array); // [out] (ni) + + void zero_array_2D( + const int& ni, const int& nj, + Float* array); // [out] (ni, nj) + + void zero_array_3D( + const int& ni, const int& nj, const int& nk, + Float* array); // [out] (ni, nj, nk) + + void zero_array_4D( + const int& ni, const int& nj, const int& nk, const int& nl, + Float* array); // [out] (ni, nj, nk, nl) + +} diff --git a/rte-kernels/api/rte_types.h b/rte-kernels/api/rte_types.h new file mode 100644 index 000000000..fc645f203 --- /dev/null +++ b/rte-kernels/api/rte_types.h @@ -0,0 +1,34 @@ +/* This code is part of Radiative Transfer for Energetics (RTE) + +Contacts: Robert Pincus and Eli Mlawer +email: rrtmgp@aer.com + +Copyright 2024- + Trustees of Columbia University in the City of New York + All right reserved. + +Use and duplication is permitted under the terms of the + BSD 3-clause license, see http://opensource.org/licenses/BSD-3-Clause + +This header files C-compatible Boolean and floating point types (see mo_rte_type.F90 for the Fortran equivalent) + Adapted from code written by Chiel van Heerwaarden at Wageningen University and Research + +*/ +#pragma once + +#ifdef RTE_USE_CBOOL +using Bool = signed char; +#else +using Bool = int; +#endif + +#ifdef RTE_USE_SP +using Float = float; +const Float Float_epsilon = FLT_EPSILON; +#else +using Float = double; +const Float Float_epsilon = DBL_EPSILON; +#endif + + + diff --git a/tests/Makefile b/tests/Makefile index 1b90ed26c..a5060c623 100644 --- a/tests/Makefile +++ b/tests/Makefile @@ -1,3 +1,4 @@ +#!/usr/bin/env make # # Location of RTE+RRTMGP libraries, module files. # @@ -5,20 +6,18 @@ RRTMGP_BUILD = $(RRTMGP_ROOT)/build # # RRTMGP library, module files # -# LDFLAGS += -L$(RRTMGP_BUILD) -# LIBS += -lrrtmgp -lrte +LDFLAGS += -L$(RRTMGP_BUILD) +LIBS += -lrrtmgp -lrte FCINCLUDE += -I$(RRTMGP_BUILD) -# + # netcdf Fortran module files has to be in the search path or added via environment variable FCINCLUDE e.g. #FCINCLUDE += -I$(NFHOME)/include # netcdf C and Fortran libraries have to be in the search path or added via environment variable LDFLAGS e.g. #LDFLAGS += -L$(NFHOME)/lib -L$(NCHOME)/lib -LDFLAGS += -L$(RRTMGP_BUILD) -LIBS += -lrte -lrrtmgp LIBS += -lnetcdff -lnetcdf -VPATH = .:$(RRTMGP_ROOT)/examples:$(RRTMGP_ROOT)/examples/rfmip-clear-sky:$(RRTMGP_ROOT)/examples/all-sky +VPATH = $(RRTMGP_ROOT)/examples:$(RRTMGP_ROOT)/examples/rfmip-clear-sky:$(RRTMGP_ROOT)/examples/all-sky VPATH += $(RRTMGP_ROOT)/rrtmgp-frontend:$(RRTMGP_ROOT)/extensions:$(RRTMGP_ROOT)/:$(RRTMGP_ROOT)/extensions/solar_variability # Compilation rules @@ -80,7 +79,7 @@ rte_sw_solver_unit_tests : $(LIB_DEPS) mo_testing_utils.o rte_sw_solver_unit_te .PHONY: tests -tests: +tests: check_variants check_equivalence test_zenith_angle_spherical_correction rte_sw_solver_unit_tests rte_optic_prop_unit_tests rte_lw_solver_unit_tests cp ${RRTMGP_DATA}/examples/rfmip-clear-sky/inputs/multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc ./test_atmospheres.nc $(RUN_CMD) bash all_tests.sh From bbc14c20a2d9c6c1375128a24ba9978789cdb525 Mon Sep 17 00:00:00 2001 From: Robert Pincus Date: Thu, 18 Apr 2024 07:32:42 -0400 Subject: [PATCH 25/57] Re-vectorize SW two-stream (#275) Adopt suggestions by @peterukk in #215. Makes expensive direct beam computations even when solar zenith angle is < 0, but masks those results out in layers where the direct beam does not reach. This will have practical impacts only in columns where the top of the column is in sunlight but the bottom not (or if users aren't removing columns entirely below the horizon). --- .github/workflows/containerized-ci.yml | 2 +- rte-kernels/mo_rte_solver_kernels.F90 | 113 +++++++++++++------------ tests/check_equivalence.F90 | 64 ++++++++------ 3 files changed, 99 insertions(+), 80 deletions(-) diff --git a/.github/workflows/containerized-ci.yml b/.github/workflows/containerized-ci.yml index 0f247ba05..2548e2940 100644 --- a/.github/workflows/containerized-ci.yml +++ b/.github/workflows/containerized-ci.yml @@ -21,7 +21,7 @@ jobs: include: # Set flags for Intel Fortran Compiler Classic - fortran-compiler: ifort - fcflags: -m64 -g -traceback -heap-arrays -assume realloc_lhs -extend-source 132 -check bounds,uninit,pointers,stack -stand f08 + fcflags: -m64 -g -traceback -heap-arrays -assume realloc_lhs -extend-source 132 -check bounds,uninit,pointers,stack -stand f08 -diag-disable=10448 # Set flags for Intel Fortran Compiler - fortran-compiler: ifx rte-kernels: default diff --git a/rte-kernels/mo_rte_solver_kernels.F90 b/rte-kernels/mo_rte_solver_kernels.F90 index f3308cc5e..e10a0cb36 100644 --- a/rte-kernels/mo_rte_solver_kernels.F90 +++ b/rte-kernels/mo_rte_solver_kernels.F90 @@ -1003,6 +1003,7 @@ pure subroutine sw_dif_and_source(ncol, nlay, top_at_1, mu0, sfc_albedo, & ! Ancillary variables real(wp), parameter :: min_k = 1.e4_wp * epsilon(1._wp) ! Suggestion from Chiel van Heerwaarden + real(wp), parameter :: min_mu0 = sqrt(epsilon(1._wp)) real(wp) :: k, exp_minusktau, k_mu, k_gamma3, k_gamma4 real(wp) :: RT_term, exp_minus2ktau real(wp) :: Rdir, Tdir, Tnoscat @@ -1022,6 +1023,7 @@ pure subroutine sw_dif_and_source(ncol, nlay, top_at_1, mu0, sfc_albedo, & dir_flux_trans => flux_dn_dir(:,lay_index ) end if + !$OMP SIMD do i = 1, ncol ! ! Scalars @@ -1029,7 +1031,6 @@ pure subroutine sw_dif_and_source(ncol, nlay, top_at_1, mu0, sfc_albedo, & tau_s = tau(i, lay_index) w0_s = w0 (i, lay_index) g_s = g (i, lay_index) - mu0_s = mu0(i, lay_index) ! ! Zdunkowski Practical Improved Flux Method "PIFM" ! (Zdunkowski et al., 1980; Contributions to Atmospheric Physics 53, 147-66) @@ -1059,63 +1060,69 @@ pure subroutine sw_dif_and_source(ncol, nlay, top_at_1, mu0, sfc_albedo, & ! ! On a round earth, where mu0 can increase with depth in the atmosphere, ! levels with mu0 <= 0 have no direct beam and hence no source for diffuse light + ! Compute transmission and reflection using a nominal value but mask out later ! - if(mu0_s > 0._wp) then - k_mu = k * mu0_s - ! - ! Equation 14, multiplying top and bottom by exp(-k*tau) - ! and rearranging to avoid div by 0. - ! - RT_term = w0_s * RT_term/merge(1._wp - k_mu*k_mu, & - epsilon(1._wp), & - abs(1._wp - k_mu*k_mu) >= epsilon(1._wp)) - ! - ! Zdunkowski Practical Improved Flux Method "PIFM" - ! (Zdunkowski et al., 1980; Contributions to Atmospheric Physics 53, 147-66) - ! - gamma3 = (2._wp - 3._wp * mu0_s * g_s ) * .25_wp - gamma4 = 1._wp - gamma3 - alpha1 = gamma1 * gamma4 + gamma2 * gamma3 ! Eq. 16 - alpha2 = gamma1 * gamma3 + gamma2 * gamma4 ! Eq. 17 + mu0_s = max(min_mu0, mu0(i, lay_index)) + k_mu = k * mu0_s + ! + ! Equation 14, multiplying top and bottom by exp(-k*tau) + ! and rearranging to avoid div by 0. + ! + RT_term = w0_s * RT_term/merge(1._wp - k_mu*k_mu, & + epsilon(1._wp), & + abs(1._wp - k_mu*k_mu) >= epsilon(1._wp)) + ! + ! Zdunkowski Practical Improved Flux Method "PIFM" + ! (Zdunkowski et al., 1980; Contributions to Atmospheric Physics 53, 147-66) + ! + gamma3 = (2._wp - 3._wp * mu0_s * g_s ) * .25_wp + gamma4 = 1._wp - gamma3 + alpha1 = gamma1 * gamma4 + gamma2 * gamma3 ! Eq. 16 + alpha2 = gamma1 * gamma3 + gamma2 * gamma4 ! Eq. 17 - ! - ! Transmittance of direct, unscattered beam. - ! - k_gamma3 = k * gamma3 - k_gamma4 = k * gamma4 - Tnoscat = exp(-tau_s/mu0_s) - Rdir = RT_term * & - ((1._wp - k_mu) * (alpha2 + k_gamma3) - & - (1._wp + k_mu) * (alpha2 - k_gamma3) * exp_minus2ktau - & - 2.0_wp * (k_gamma3 - alpha2 * k_mu) * exp_minusktau * Tnoscat) - ! - ! Equation 15, multiplying top and bottom by exp(-k*tau), - ! multiplying through by exp(-tau/mu0) to - ! prefer underflow to overflow - ! Omitting direct transmittance - ! - Tdir = -RT_term * & - ((1._wp + k_mu) * (alpha1 + k_gamma4) * Tnoscat - & - (1._wp - k_mu) * (alpha1 - k_gamma4) * exp_minus2ktau * Tnoscat - & - 2.0_wp * (k_gamma4 + alpha1 * k_mu) * exp_minusktau) - ! Final check that energy is not spuriously created, by recognizing that - ! the beam can either be reflected, penetrate unscattered to the base of a layer, - ! or penetrate through but be scattered on the way - the rest is absorbed - ! Makes the equations safer in single precision. Credit: Robin Hogan, Peter Ukkonen - Rdir = max(0.0_wp, min(Rdir, (1.0_wp - Tnoscat ) )) - Tdir = max(0.0_wp, min(Tdir, (1.0_wp - Tnoscat - Rdir) )) + ! + ! Transmittance of direct, unscattered beam. + ! + k_gamma3 = k * gamma3 + k_gamma4 = k * gamma4 + Tnoscat = exp(-tau_s/mu0_s) + Rdir = RT_term * & + ((1._wp - k_mu) * (alpha2 + k_gamma3) - & + (1._wp + k_mu) * (alpha2 - k_gamma3) * exp_minus2ktau - & + 2.0_wp * (k_gamma3 - alpha2 * k_mu) * exp_minusktau * Tnoscat) + ! + ! Equation 15, multiplying top and bottom by exp(-k*tau), + ! multiplying through by exp(-tau/mu0) to + ! prefer underflow to overflow + ! Omitting direct transmittance + ! + Tdir = -RT_term * & + ((1._wp + k_mu) * (alpha1 + k_gamma4) * Tnoscat - & + (1._wp - k_mu) * (alpha1 - k_gamma4) * exp_minus2ktau * Tnoscat - & + 2.0_wp * (k_gamma4 + alpha1 * k_mu) * exp_minusktau) + ! Final check that energy is not spuriously created, by recognizing that + ! the beam can either be reflected, penetrate unscattered to the base of a layer, + ! or penetrate through but be scattered on the way - the rest is absorbed + ! Makes the equations safer in single precision. Credit: Robin Hogan, Peter Ukkonen + Rdir = max(0.0_wp, min(Rdir, (1.0_wp - Tnoscat ) )) + Tdir = max(0.0_wp, min(Tdir, (1.0_wp - Tnoscat - Rdir) )) - source_up(i,lay_index) = Rdir * dir_flux_inc(i) - source_dn(i,lay_index) = Tdir * dir_flux_inc(i) - dir_flux_trans(i) = Tnoscat * dir_flux_inc(i) - else - source_up(i,lay_index) = 0._wp - source_dn(i,lay_index) = 0._wp - dir_flux_trans(i) = 0._wp - end if + source_up(i,lay_index) = Rdir * dir_flux_inc(i) + source_dn(i,lay_index) = Tdir * dir_flux_inc(i) + dir_flux_trans(i) = Tnoscat * dir_flux_inc(i) end do end do - source_sfc(:) = dir_flux_trans(:)*sfc_albedo(:) + ! + ! T and R for the direct beam are computed using nominal values even when the + ! sun is below the horizon (mu0 < 0); set those values back to zero + ! This won't be efficient if many nighttime columns are passed + ! + source_sfc(:) = merge(dir_flux_trans(:)*sfc_albedo(:), & + 0._wp, mu0(:,lay_index) > 0._wp) + where(mu0(:,:) <= 0._wp) + source_up(:,:) = 0._wp + source_dn(:,:) = 0._wp + end where end subroutine sw_dif_and_source ! --------------------------------------------------------------- diff --git a/tests/check_equivalence.F90 b/tests/check_equivalence.F90 index ed6022788..f08ca8a26 100644 --- a/tests/check_equivalence.F90 +++ b/tests/check_equivalence.F90 @@ -421,55 +421,67 @@ program rte_check_equivalence ! Threshold of 4x spacing() works in double precision ! call stop_on_err(gas_optics%gas_optics(p_lay, p_lev, & - t_lay, & - gas_concs, & - atmos, & - toa_flux)) + t_lay, & + gas_concs, & + atmos, & + toa_flux)) atmos%tau(:,:,:) = 0.5_wp * atmos%tau(:,:,:) call stop_on_err(atmos%increment(atmos)) call stop_on_err(rte_sw(atmos, top_at_1, & mu0, toa_flux, & sfc_alb_dir, sfc_alb_dif, & fluxes)) - if(.not. allclose(tst_flux_up, ref_flux_up, tol = 8._wp) .or. & - .not. allclose(tst_flux_dn, ref_flux_dn, tol = 6._wp) .or. & - .not. allclose(tst_flux_dir,ref_flux_dir,tol = 8._wp)) & + if(.not. allclose(tst_flux_up, ref_flux_up, tol = 8._wp) .or. & + .not. allclose(tst_flux_dn, ref_flux_dn, tol = 10._wp) .or. & + .not. allclose(tst_flux_dir,ref_flux_dir,tol = 10._wp)) & call report_err(" halving/doubling fails") + ! + ! Incremement with 0 optical depth + ! + call stop_on_err(gas_optics%gas_optics(p_lay, p_lev, & + t_lay, & + gas_concs, & + atmos, & + toa_flux)) call increment_with_1scl(atmos) call stop_on_err(rte_sw(atmos, top_at_1, & mu0, toa_flux, & sfc_alb_dir, sfc_alb_dif, & fluxes)) - if(.not. allclose(tst_flux_up, ref_flux_up, tol = 8._wp) .or. & - .not. allclose(tst_flux_dn, ref_flux_dn, tol = 6._wp) .or. & - .not. allclose(tst_flux_dir,ref_flux_dir,tol = 6._wp)) & + if(.not. allclose(tst_flux_up, ref_flux_up, tol = 8._wp) .or. & + .not. allclose(tst_flux_dn, ref_flux_dn, tol = 10._wp) .or. & + .not. allclose(tst_flux_dir,ref_flux_dir,tol = 10._wp)) & call report_err(" Incrementing with 1scl fails") - call stop_on_err(gas_optics%gas_optics(p_lay, p_lev, & - t_lay, & - gas_concs, & - atmos, & - toa_flux)) - call increment_with_2str(atmos) - if(.not. allclose(tst_flux_up, ref_flux_up, tol = 8._wp) .or. & - .not. allclose(tst_flux_dn, ref_flux_dn, tol = 6._wp) .or. & - .not. allclose(tst_flux_dir,ref_flux_dir,tol = 6._wp)) & + call stop_on_err(gas_optics%gas_optics(p_lay, p_lev, & + t_lay, & + gas_concs, & + atmos, & + toa_flux)) + call increment_with_2str(atmos) + call stop_on_err(rte_sw(atmos, top_at_1, & + mu0, toa_flux, & + sfc_alb_dir, sfc_alb_dif, & + fluxes)) + if(.not. allclose(tst_flux_up, ref_flux_up, tol = 8._wp) .or. & + .not. allclose(tst_flux_dn, ref_flux_dn, tol = 10._wp) .or. & + .not. allclose(tst_flux_dir,ref_flux_dir,tol = 10._wp)) & call report_err(" Incrementing with 2str fails") call stop_on_err(gas_optics%gas_optics(p_lay, p_lev, & - t_lay, & - gas_concs, & - atmos, & - toa_flux)) + t_lay, & + gas_concs, & + atmos, & + toa_flux)) call increment_with_nstr(atmos) call stop_on_err(rte_sw(atmos, top_at_1, & mu0, toa_flux, & sfc_alb_dir, sfc_alb_dif, & fluxes)) - if(.not. allclose(tst_flux_up, ref_flux_up, tol = 8._wp) .or. & - .not. allclose(tst_flux_dn, ref_flux_dn, tol = 6._wp) .or. & - .not. allclose(tst_flux_dir,ref_flux_dir,tol = 6._wp)) & + if(.not. allclose(tst_flux_up, ref_flux_up, tol = 8._wp) .or. & + .not. allclose(tst_flux_dn, ref_flux_dn, tol = 10._wp) .or. & + .not. allclose(tst_flux_dir,ref_flux_dir,tol = 10._wp)) & call report_err(" Incrementing with nstr fails") print *, " Incrementing" end if From 8cf510ce4d50e9ddb56dd30449a9590067194e58 Mon Sep 17 00:00:00 2001 From: Sergey Kosukhin Date: Thu, 18 Apr 2024 15:05:55 +0200 Subject: [PATCH 26/57] Skip GitLab CI for dependabot (#278) --- .github/workflows/gitlab-ci.yml | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/.github/workflows/gitlab-ci.yml b/.github/workflows/gitlab-ci.yml index 0c987d844..374def61a 100644 --- a/.github/workflows/gitlab-ci.yml +++ b/.github/workflows/gitlab-ci.yml @@ -21,7 +21,8 @@ jobs: if: | github.repository_owner == 'earth-system-radiation' && ( github.event_name != 'pull_request' || - github.event.pull_request.head.repo.owner.login == github.repository_owner ) + ( github.event.pull_request.head.repo.owner.login == github.repository_owner && + github.event.pull_request.user.login != 'dependabot' )) runs-on: ubuntu-latest outputs: ref-name: ${{ steps.g-push-rev.outputs.ref-name }} @@ -103,7 +104,8 @@ jobs: if: | github.repository_owner == 'earth-system-radiation' && ( github.event_name != 'pull_request' || - github.event.pull_request.head.repo.owner.login == github.repository_owner ) + ( github.event.pull_request.head.repo.owner.login == github.repository_owner && + github.event.pull_request.user.login != 'dependabot' )) runs-on: ubuntu-latest outputs: ref-name: ${{ steps.g-push-rev.outputs.ref-name }} From 29cc4b37384684e663cb3ad32cf9a3dca9e39cc1 Mon Sep 17 00:00:00 2001 From: Robert Pincus Date: Thu, 18 Apr 2024 09:13:32 -0400 Subject: [PATCH 27/57] Different user for dependabot jobs --- .github/workflows/gitlab-ci.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/gitlab-ci.yml b/.github/workflows/gitlab-ci.yml index 374def61a..2a46e8557 100644 --- a/.github/workflows/gitlab-ci.yml +++ b/.github/workflows/gitlab-ci.yml @@ -22,7 +22,7 @@ jobs: github.repository_owner == 'earth-system-radiation' && ( github.event_name != 'pull_request' || ( github.event.pull_request.head.repo.owner.login == github.repository_owner && - github.event.pull_request.user.login != 'dependabot' )) + github.event.pull_request.user.login != 'dependabot[bot]' )) runs-on: ubuntu-latest outputs: ref-name: ${{ steps.g-push-rev.outputs.ref-name }} @@ -105,7 +105,7 @@ jobs: github.repository_owner == 'earth-system-radiation' && ( github.event_name != 'pull_request' || ( github.event.pull_request.head.repo.owner.login == github.repository_owner && - github.event.pull_request.user.login != 'dependabot' )) + github.event.pull_request.user.login != 'dependabot[bot]' )) runs-on: ubuntu-latest outputs: ref-name: ${{ steps.g-push-rev.outputs.ref-name }} From 9caac5ec3ceab9a295699a2abb58809a9dca87de Mon Sep 17 00:00:00 2001 From: "dependabot[bot]" <49699333+dependabot[bot]@users.noreply.github.com> Date: Thu, 18 Apr 2024 09:24:04 -0400 Subject: [PATCH 28/57] Bump JamesIves/github-pages-deploy-action from 4.5.0 to 4.6.0 (#276) Bumps [JamesIves/github-pages-deploy-action](https://github.com/jamesives/github-pages-deploy-action) from 4.5.0 to 4.6.0. - [Release notes](https://github.com/jamesives/github-pages-deploy-action/releases) - [Commits](https://github.com/jamesives/github-pages-deploy-action/compare/v4.5.0...v4.6.0) --- updated-dependencies: - dependency-name: JamesIves/github-pages-deploy-action dependency-type: direct:production update-type: version-update:semver-minor ... Signed-off-by: dependabot[bot] Co-authored-by: dependabot[bot] <49699333+dependabot[bot]@users.noreply.github.com> --- .github/workflows/doc-deployment.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/doc-deployment.yml b/.github/workflows/doc-deployment.yml index 2ee1de23b..d948d3453 100644 --- a/.github/workflows/doc-deployment.yml +++ b/.github/workflows/doc-deployment.yml @@ -70,7 +70,7 @@ jobs: # Deploy documentation # - name: Deploy API Documentation - uses: JamesIves/github-pages-deploy-action@v4.5.0 + uses: JamesIves/github-pages-deploy-action@v4.6.0 if: ${{ github.event_name == 'push' && github.ref == 'refs/heads/documentation' }} with: branch: gh-pages From aad596a347a58f7d737f80c81d4b776e723917eb Mon Sep 17 00:00:00 2001 From: Sergey Kosukhin Date: Mon, 29 Apr 2024 05:28:05 +0200 Subject: [PATCH 29/57] Homogenize GitLab CI (#279) --- .gitlab/common.yml | 37 ++++++++++++++++++++++++++++++++ .gitlab/levante.yml | 48 +++++------------------------------------- .gitlab/lumi.yml | 51 ++++++++++++--------------------------------- 3 files changed, 55 insertions(+), 81 deletions(-) create mode 100644 .gitlab/common.yml diff --git a/.gitlab/common.yml b/.gitlab/common.yml new file mode 100644 index 000000000..196c641f4 --- /dev/null +++ b/.gitlab/common.yml @@ -0,0 +1,37 @@ +.dp: + variables: + FPMODEL: DP + FAILURE_THRESHOLD: "5.8e-2" + +.sp: + variables: + FPMODEL: SP + FAILURE_THRESHOLD: "3.5e-1" + +.common: + variables: + # Make variables: + MAKEFLAGS: -j8 + RRTMGP_ROOT: ${CI_PROJECT_DIR} + RRTMGP_DATA: ${CI_PROJECT_DIR}/rrtmgp-data + # Convenience variables: + RRTMGP_DATA_REPO: https://github.com/earth-system-radiation/rrtmgp-data.git + RRTMGP_DATA_TAG: + script: + # + # Build libraries, examples and tests + # + - ${FC} ${VERSION_FCFLAGS} + - make libs + # + # Check out data + # + - git clone --depth 1 ${RRTMGP_DATA_TAG:+--branch "${RRTMGP_DATA_TAG}"} "${RRTMGP_DATA_REPO}" "${RRTMGP_DATA}" + # + # Run examples and tests + # + - make tests + # + # Compare the results + # + - make check diff --git a/.gitlab/levante.yml b/.gitlab/levante.yml index 4835a4383..be6f253b2 100644 --- a/.gitlab/levante.yml +++ b/.gitlab/levante.yml @@ -5,6 +5,7 @@ workflow: include: - project: 'anw_dienste/ci-templates' file: '.slurm-ci.yml' + - local: '.gitlab/common.yml' variables: SCHEDULER_PARAMETERS: >- @@ -44,17 +45,8 @@ variables: NFHOME: /sw/spack-levante/netcdf-fortran-4.5.3-5di6qe NCHOME: /sw/spack-levante/netcdf-c-4.8.1-vbnli5 -.dp: - variables: - FPMODEL: DP - FAILURE_THRESHOLD: "5.8e-2" - -.sp: - variables: - FPMODEL: SP - FAILURE_THRESHOLD: "3.5e-1" - -.common: +.common-levante: + extends: .common variables: PYHOME: /sw/spack-levante/mambaforge-22.9.0-2-Linux-x86_64-kptncg # Suppress an irrelevant but annoying error message: @@ -62,8 +54,6 @@ variables: # Make variables: FCINCLUDE: -I${NFHOME}/include LDFLAGS: -L${NFHOME}/lib -L${NCHOME}/lib - RRTMGP_ROOT: ${CI_PROJECT_DIR} - RRTMGP_DATA: ${CI_PROJECT_DIR}/rrtmgp-data before_script: - module purge - module load git @@ -72,30 +62,12 @@ variables: - export LD_LIBRARY_PATH="${NFHOME}/lib:${NCHOME}/lib:${LD_LIBRARY_PATH-}" # Some tests require a large stack: - ulimit -s unlimited - script: - # - # Build libraries, examples and tests - # - - ${FC} ${VERSION_FCFLAGS} - - make -j8 libs - # - # Check out data - # - - git clone --depth 1 https://github.com/earth-system-radiation/rrtmgp-data.git "${RRTMGP_DATA}" - # - # Run examples and tests - # - - make -j8 tests - # - # Compare the results - # - - make -j8 check .nvhpc-gpu-openacc: extends: - .gpu - .nvhpc - - .common + - .common-levante variables: # Compiler flags used for ICON model: FCFLAGS: -g -O2 -Mrecursive -Mallocatable=03 -Mstack_arrays -Minfo=accel,inline -acc=gpu,verystrict -gpu=cc80,cuda11.7 -DRTE_USE_${FPMODEL} @@ -105,7 +77,7 @@ variables: extends: - .cpu - .nag - - .common + - .common-levante variables: # Compiler flags used for ICON model: FCFLAGS: -Wc=/sw/spack-levante/gcc-11.2.0-bcn7mb/bin/gcc -f2008 -colour -w=uep -g -gline -O0 -float-store -nan -Wc,-g -Wc,-pipe -Wc,--param,max-vartrack-size=200000000 -Wc,-mno-fma -C=all -DRTE_USE_CBOOL -DRTE_USE_${FPMODEL} @@ -130,11 +102,6 @@ nvhpc-gpu-openacc-SP: - .sp - .nvhpc-gpu-openacc -#nag-cpu-default-DP: -# extends: -# - .dp -# - .nag-cpu-default - nag-cpu-default-SP: extends: - .sp @@ -144,8 +111,3 @@ nag-cpu-accel-DP: extends: - .dp - .nag-cpu-accel - -#nag-cpu-accel-SP: -# extends: -# - .sp -# - .nag-cpu-accel diff --git a/.gitlab/lumi.yml b/.gitlab/lumi.yml index 245129d5c..1a642d992 100644 --- a/.gitlab/lumi.yml +++ b/.gitlab/lumi.yml @@ -2,7 +2,10 @@ workflow: rules: - if: $CI_PIPELINE_SOURCE == "api" -default: +include: + - local: '.gitlab/common.yml' + +.default: tags: - lumi @@ -18,12 +21,14 @@ variables: EXTRA_SCHEDULER_PARAMETERS: .gpu: + extends: .default variables: EXTRA_SCHEDULER_PARAMETERS: >- --partition=dev-g --gpus=1 .cpu: + extends: .default variables: EXTRA_SCHEDULER_PARAMETERS: >- --partition=debug @@ -36,20 +41,10 @@ variables: VERSION_FCFLAGS: -V COMPILER_MODULES: PrgEnv-cray cce/16.0.1 craype-x86-milan -.dp: - variables: - FPMODEL: DP - FAILURE_THRESHOLD: "5.8e-2" - -.sp: - variables: - FPMODEL: SP - FAILURE_THRESHOLD: "3.5e-1" - # # Set up Python virtual environment # -.python-common: +.python-common-lumi: variables: PYHOME: ${CI_PROJECT_DIR}/python-venv FF_USE_FASTZIP: 1 @@ -57,7 +52,7 @@ variables: setup-python: extends: - .cpu - - .python-common + - .python-common-lumi script: - test ! -d "${PYHOME}" || exit 0 - module load cray-python @@ -74,43 +69,23 @@ setup-python: - ${PYHOME} expire_in: 60 minutes -.common: - extends: .python-common +.common-lumi: + extends: + - .python-common-lumi + - .common needs: - setup-python - variables: - # Make variables: - RRTMGP_ROOT: ${CI_PROJECT_DIR} - RRTMGP_DATA: ${CI_PROJECT_DIR}/rrtmgp-data before_script: - module --force purge - module load ${COMPILER_MODULES} ${EXTRA_COMPILER_MODULES} cray-hdf5 cray-netcdf # Extend the existing environment variables: - export PATH="${PYHOME}/bin:${PATH}" - script: - # - # Build libraries, examples and tests - # - - ${FC} ${VERSION_FCFLAGS} - - make -j8 libs - # - # Check out data - # - - git clone --depth 1 https://github.com/earth-system-radiation/rrtmgp-data.git "${RRTMGP_DATA}" - # - # Run examples and tests - # - - make -j8 tests - # - # Compare the results - # - - make -j8 check .cce-gpu-openacc: extends: - .gpu - .cce - - .common + - .common-lumi variables: # Compiler flags used for ICON model: FCFLAGS: -hacc -hadd_paren -Ktrap=divz,ovf,inv -hflex_mp=intolerant -hfp1 -g -DRTE_USE_${FPMODEL} From 3acd06244be598473392a8c991220952dd5a2794 Mon Sep 17 00:00:00 2001 From: "dependabot[bot]" <49699333+dependabot[bot]@users.noreply.github.com> Date: Mon, 20 May 2024 20:48:57 +0000 Subject: [PATCH 30/57] --- updated-dependencies: - dependency-name: JamesIves/github-pages-deploy-action dependency-type: direct:production update-type: version-update:semver-patch ... Signed-off-by: dependabot[bot] --- .github/workflows/doc-deployment.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/doc-deployment.yml b/.github/workflows/doc-deployment.yml index d948d3453..4bc492e9b 100644 --- a/.github/workflows/doc-deployment.yml +++ b/.github/workflows/doc-deployment.yml @@ -70,7 +70,7 @@ jobs: # Deploy documentation # - name: Deploy API Documentation - uses: JamesIves/github-pages-deploy-action@v4.6.0 + uses: JamesIves/github-pages-deploy-action@v4.6.1 if: ${{ github.event_name == 'push' && github.ref == 'refs/heads/documentation' }} with: branch: gh-pages From 2516f688229b1e8fce7193cc9e0f54b11bd8b311 Mon Sep 17 00:00:00 2001 From: Robert Pincus Date: Mon, 20 May 2024 17:53:13 -0400 Subject: [PATCH 31/57] Update LW quadrature angles (#282) Updates weights and secants for LW quadrature to the "Gauss-Jacobi-5" described in R. J. Hogan 2023, doi:10.1002/qj.4598. Changes answers for LW calculations. --- .github/workflows/containerized-ci.yml | 3 +- .github/workflows/continuous-integration.yml | 3 +- .github/workflows/self-hosted-ci.yml | 3 +- .gitlab/common.yml | 4 +- .gitlab/lumi.yml | 3 ++ examples/rfmip-clear-sky/stage_files.py | 45 -------------------- examples/rfmip-clear-sky/stage_files.sh | 5 --- rte-frontend/mo_rte_lw.F90 | 25 ++++++----- rte-kernels/accel/mo_rte_solver_kernels.F90 | 12 +++--- rte-kernels/mo_rte_solver_kernels.F90 | 12 +++--- tests/rte_lw_solver_unit_tests.F90 | 8 ++-- 11 files changed, 41 insertions(+), 82 deletions(-) delete mode 100755 examples/rfmip-clear-sky/stage_files.py delete mode 100644 examples/rfmip-clear-sky/stage_files.sh diff --git a/.github/workflows/containerized-ci.yml b/.github/workflows/containerized-ci.yml index 2548e2940..022fe2217 100644 --- a/.github/workflows/containerized-ci.yml +++ b/.github/workflows/containerized-ci.yml @@ -57,7 +57,7 @@ jobs: RUN_CMD: # https://github.com/earth-system-radiation/rte-rrtmgp/issues/194 OMP_TARGET_OFFLOAD: DISABLED - FAILURE_THRESHOLD: 5.8e-2 # 7.e-4 + FAILURE_THRESHOLD: 7.e-4 steps: # @@ -72,6 +72,7 @@ jobs: with: repository: earth-system-radiation/rrtmgp-data path: rrtmgp-data + ref: develop # # Build libraries, examples and tests (expect success) # diff --git a/.github/workflows/continuous-integration.yml b/.github/workflows/continuous-integration.yml index 138994fd4..9921917d6 100644 --- a/.github/workflows/continuous-integration.yml +++ b/.github/workflows/continuous-integration.yml @@ -31,7 +31,7 @@ jobs: RRTMGP_ROOT: ${{ github.workspace }} RRTMGP_DATA: ${{ github.workspace }}/rrtmgp-data RUN_CMD: - FAILURE_THRESHOLD: 5.8e-2 # 7.e-4 + FAILURE_THRESHOLD: 7.e-4 steps: # # Relax failure thresholds for single precision @@ -52,6 +52,7 @@ jobs: with: repository: earth-system-radiation/rrtmgp-data path: rrtmgp-data + ref: develop # # Synchronize the package index # diff --git a/.github/workflows/self-hosted-ci.yml b/.github/workflows/self-hosted-ci.yml index 5ef3cd98b..3f344cd93 100644 --- a/.github/workflows/self-hosted-ci.yml +++ b/.github/workflows/self-hosted-ci.yml @@ -48,7 +48,7 @@ jobs: RRTMGP_DATA: ${{ github.workspace }}/rrtmgp-data RTE_KERNELS: ${{ matrix.rte-kernels }} RUN_CMD: "srun -C gpu -A d56 -p cscsci -t 15:00" - FAILURE_THRESHOLD: 5.8e-2 # 7.e-4 + FAILURE_THRESHOLD: 7.e-4 steps: # # Checks-out repository under $GITHUB_WORKSPACE @@ -62,6 +62,7 @@ jobs: with: repository: earth-system-radiation/rrtmgp-data path: rrtmgp-data + ref: develop # # Finalize build environment # diff --git a/.gitlab/common.yml b/.gitlab/common.yml index 196c641f4..914f3c381 100644 --- a/.gitlab/common.yml +++ b/.gitlab/common.yml @@ -1,7 +1,7 @@ .dp: variables: FPMODEL: DP - FAILURE_THRESHOLD: "5.8e-2" + FAILURE_THRESHOLD: "7.e-4" .sp: variables: @@ -16,7 +16,7 @@ RRTMGP_DATA: ${CI_PROJECT_DIR}/rrtmgp-data # Convenience variables: RRTMGP_DATA_REPO: https://github.com/earth-system-radiation/rrtmgp-data.git - RRTMGP_DATA_TAG: + RRTMGP_DATA_TAG: develop script: # # Build libraries, examples and tests diff --git a/.gitlab/lumi.yml b/.gitlab/lumi.yml index 1a642d992..9e2c1ad4c 100644 --- a/.gitlab/lumi.yml +++ b/.gitlab/lumi.yml @@ -8,6 +8,9 @@ include: .default: tags: - lumi + id_tokens: + CI_JOB_JWT: + aud: https://gitlab.com variables: SCHEDULER_PARAMETERS: >- diff --git a/examples/rfmip-clear-sky/stage_files.py b/examples/rfmip-clear-sky/stage_files.py deleted file mode 100755 index b23a6986e..000000000 --- a/examples/rfmip-clear-sky/stage_files.py +++ /dev/null @@ -1,45 +0,0 @@ -#! /usr/bin/env python -# -# This script downloads and/or creates files needed for the RFMIP off-line test -# cases -# -import sys - -import subprocess -import urllib.request -from pathlib import Path - -# -# Download and/or create input files and output template files -# -rte_rrtmgp_dir = Path("..").joinpath("..") -rfmip_dir = rte_rrtmgp_dir.joinpath("examples", "rfmip-clear-sky") -conds_file = "multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc" -conds_url = ("http://aims3.llnl.gov/thredds/fileServer/user_pub_work/" - "input4MIPs/CMIP6/RFMIP/UColorado/UColorado-RFMIP-1-2/" + - "atmos/fx/multiple/none/v20190401/" + conds_file) -# -# The official RFMIP conditions are available from the ESFG, as above, but this -# fails from time to time, so we use the copy at Lamont-Doherty Earth -# Observatory, which we have to access via ftp(!) -# -conds_url = ("ftp://ftp.ldeo.columbia.edu/pub/robertp/rte-rrtmgp/" - "continuous-integration/" + conds_file) -output_files = [f"r{wl}{d}_Efx_RTE-RRTMGP-181204_rad-irf_r1i1p1f1_gn.nc" - for wl in ['l', 's'] for d in ['u', 'd']] -# -# Remove previous versions of files -# -for f in output_files: - Path(f).unlink(missing_ok=True) -Path(conds_file).unlink(missing_ok=True) - -# -# Download the profiles for RFMIP; download or make the empty output files -# -print("Downloading RFMIP input files") -urllib.request.urlretrieve(conds_url, conds_file) - -print("Downloading output templates") -for f in output_files: - urllib.request.urlretrieve(conds_url.replace(conds_file, f), f) diff --git a/examples/rfmip-clear-sky/stage_files.sh b/examples/rfmip-clear-sky/stage_files.sh deleted file mode 100644 index 7fa81db9f..000000000 --- a/examples/rfmip-clear-sky/stage_files.sh +++ /dev/null @@ -1,5 +0,0 @@ -wget ftp://ftp.ldeo.columbia.edu/pub/robertp/rte-rrtmgp/continuous-integration/multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc -wget ftp://ftp.ldeo.columbia.edu/pub/robertp/rte-rrtmgp/continuous-integration/rld_Efx_RTE-RRTMGP-181204_rad-irf_r1i1p1f1_gn.nc -wget ftp://ftp.ldeo.columbia.edu/pub/robertp/rte-rrtmgp/continuous-integration/rlu_Efx_RTE-RRTMGP-181204_rad-irf_r1i1p1f1_gn.nc -wget ftp://ftp.ldeo.columbia.edu/pub/robertp/rte-rrtmgp/continuous-integration/rsd_Efx_RTE-RRTMGP-181204_rad-irf_r1i1p1f1_gn.nc -wget ftp://ftp.ldeo.columbia.edu/pub/robertp/rte-rrtmgp/continuous-integration/rsu_Efx_RTE-RRTMGP-181204_rad-irf_r1i1p1f1_gn.nc diff --git a/rte-frontend/mo_rte_lw.F90 b/rte-frontend/mo_rte_lw.F90 index c36c55f8c..47a11ebe6 100644 --- a/rte-frontend/mo_rte_lw.F90 +++ b/rte-frontend/mo_rte_lw.F90 @@ -125,22 +125,25 @@ function rte_lw(optical_props, top_at_1, & real(wp), dimension(:,:), pointer :: inc_flux_diffuse ! -------------------------------------------------- ! - ! Weights and angle secants for first order (k=1) Gaussian quadrature. - ! Values from Table 2, Clough et al, 1992, doi:10.1029/92JD01419 - ! after Abramowitz & Stegun 1972, page 921 + ! Weights and angle secants for "Gauss-Jacobi-5" quadrature. + ! Values from Table 1, R. J. Hogan 2023, doi:10.1002/qj.4598 ! integer, parameter :: max_gauss_pts = 4 real(wp), parameter, & dimension(max_gauss_pts, max_gauss_pts) :: & - gauss_Ds = RESHAPE([1.66_wp, 0._wp, 0._wp, 0._wp, & ! Diffusivity angle, not Gaussian angle - 1.18350343_wp, 2.81649655_wp, 0._wp, 0._wp, & - 1.09719858_wp, 1.69338507_wp, 4.70941630_wp, 0._wp, & - 1.06056257_wp, 1.38282560_wp, 2.40148179_wp, 7.15513024_wp], & + ! + ! Values provided are for mu = cos(theta); we require the inverse + ! + gauss_Ds = 1._wp / & + RESHAPE([0.6096748751_wp, huge(1._wp) , huge(1._wp) , huge(1._wp), & + 0.2509907356_wp, 0.7908473988_wp, huge(1._wp) , huge(1._wp), & + 0.1024922169_wp, 0.4417960320_wp, 0.8633751621_wp, huge(1._wp), & + 0.0454586727_wp, 0.2322334416_wp, 0.5740198775_wp, 0.9030775973_wp], & [max_gauss_pts, max_gauss_pts]), & - gauss_wts = RESHAPE([0.5_wp, 0._wp, 0._wp, 0._wp, & - 0.3180413817_wp, 0.1819586183_wp, 0._wp, 0._wp, & - 0.2009319137_wp, 0.2292411064_wp, 0.0698269799_wp, 0._wp, & - 0.1355069134_wp, 0.2034645680_wp, 0.1298475476_wp, 0.0311809710_wp], & + gauss_wts = RESHAPE([1._wp, 0._wp, 0._wp, 0._wp, & + 0.2300253764_wp, 0.7699746236_wp, 0._wp, 0._wp, & + 0.0437820218_wp, 0.3875796738_wp, 0.5686383044_wp, 0._wp, & + 0.0092068785_wp, 0.1285704278_wp, 0.4323381850_wp, 0.4298845087_wp], & [max_gauss_pts, max_gauss_pts]) ! ------------------------------------------------------------------------------------ ncol = optical_props%get_ncol() diff --git a/rte-kernels/accel/mo_rte_solver_kernels.F90 b/rte-kernels/accel/mo_rte_solver_kernels.F90 index 42d234abd..36d2366ec 100644 --- a/rte-kernels/accel/mo_rte_solver_kernels.F90 +++ b/rte-kernels/accel/mo_rte_solver_kernels.F90 @@ -133,7 +133,7 @@ subroutine lw_solver_noscat_oneangle(ncol, nlay, ngpt, top_at_1, D, weight, & ! Transport is for intensity ! convert flux at top of domain to intensity assuming azimuthal isotropy ! - flux_dn(icol,top_level,igpt) = incident_flux(icol,igpt)/(2._wp * pi * weight) + flux_dn(icol,top_level,igpt) = incident_flux(icol,igpt)/(pi * weight) end do end do @@ -219,16 +219,16 @@ subroutine lw_solver_noscat_oneangle(ncol, nlay, ngpt, top_at_1, D, weight, & ! Broadband reduction including ! conversion from intensity to flux assuming azimuthal isotropy and quadrature weight ! - call sum_broadband_factor(ncol, nlay+1, ngpt, 2._wp * pi * weight, flux_dn, broadband_dn) - call sum_broadband_factor(ncol, nlay+1, ngpt, 2._wp * pi * weight, flux_up, broadband_up) + call sum_broadband_factor(ncol, nlay+1, ngpt, pi * weight, flux_dn, broadband_dn) + call sum_broadband_factor(ncol, nlay+1, ngpt, pi * weight, flux_up, broadband_up) !$acc exit data delete( flux_dn,flux_up) !$omp target exit data map(release:flux_dn,flux_up) else ! ! Convert intensity to flux assuming azimuthal isotropy and quadrature weight ! - call apply_factor_3D(ncol, nlay+1, ngpt, 2._wp*pi*weight, flux_dn) - call apply_factor_3D(ncol, nlay+1, ngpt, 2._wp*pi*weight, flux_up) + call apply_factor_3D(ncol, nlay+1, ngpt, pi * weight, flux_dn) + call apply_factor_3D(ncol, nlay+1, ngpt, pi * weight, flux_up) !$acc exit data copyout( flux_dn,flux_up) !$omp target exit data map(from:flux_dn,flux_up) end if @@ -236,7 +236,7 @@ subroutine lw_solver_noscat_oneangle(ncol, nlay, ngpt, top_at_1, D, weight, & ! Only broadband-integrated Jacobians are provided ! if (do_Jacobians) then - call sum_broadband_factor(ncol, nlay+1, ngpt, 2._wp * pi * weight, gpt_Jac, flux_upJac) + call sum_broadband_factor(ncol, nlay+1, ngpt, pi * weight, gpt_Jac, flux_upJac) end if !$acc end data diff --git a/rte-kernels/mo_rte_solver_kernels.F90 b/rte-kernels/mo_rte_solver_kernels.F90 index e10a0cb36..6a1156224 100644 --- a/rte-kernels/mo_rte_solver_kernels.F90 +++ b/rte-kernels/mo_rte_solver_kernels.F90 @@ -141,7 +141,7 @@ subroutine lw_solver_noscat_oneangle(ncol, nlay, ngpt, top_at_1, D, weight, & ! Transport is for intensity ! convert flux at top of domain to intensity assuming azimuthal isotropy ! - gpt_flux_dn(:,top_level) = incident_flux(:,igpt)/(2._wp * pi * weight) + gpt_flux_dn(:,top_level) = incident_flux(:,igpt)/(pi * weight) ! ! Optical path and transmission, used in source function and transport calculations ! @@ -220,8 +220,8 @@ subroutine lw_solver_noscat_oneangle(ncol, nlay, ngpt, top_at_1, D, weight, & ! ! Convert intensity to flux assuming azimuthal isotropy and quadrature weight ! - gpt_flux_dn(:,:) = 2._wp * pi * weight * gpt_flux_dn(:,:) - gpt_flux_up(:,:) = 2._wp * pi * weight * gpt_flux_up(:,:) + gpt_flux_dn(:,:) = pi * weight * gpt_flux_dn(:,:) + gpt_flux_up(:,:) = pi * weight * gpt_flux_up(:,:) end if ! ! Only broadband-integrated Jacobians are provided @@ -231,11 +231,11 @@ subroutine lw_solver_noscat_oneangle(ncol, nlay, ngpt, top_at_1, D, weight, & end do ! g point loop if(do_broadband) then - broadband_up(:,:) = 2._wp * pi * weight* broadband_up(:,:) - broadband_dn(:,:) = 2._wp * pi * weight* broadband_dn(:,:) + broadband_up(:,:) = pi * weight* broadband_up(:,:) + broadband_dn(:,:) = pi * weight* broadband_dn(:,:) end if if(do_Jacobians) & - flux_upJac(:,:) = 2._wp * pi * weight * flux_upJac(:,:) + flux_upJac(:,:) = pi * weight * flux_upJac(:,:) end subroutine lw_solver_noscat_oneangle ! ------------------------------------------------------------------------------------------------- diff --git a/tests/rte_lw_solver_unit_tests.F90 b/tests/rte_lw_solver_unit_tests.F90 index fc18afc44..baf08fd3f 100644 --- a/tests/rte_lw_solver_unit_tests.F90 +++ b/tests/rte_lw_solver_unit_tests.F90 @@ -57,8 +57,8 @@ program rte_lw_solver_unit_tests ! ! Longwave tests - gray radiative equilibrium ! - real(wp), parameter :: sigma = 5.670374419e-8_wp, & ! Stefan-Boltzmann constant - D = 1.66_wp ! Diffusivity angle, from single-angle RRTMGP solver + real(wp), parameter :: sigma = 5.670374419e-8_wp, & ! Stefan-Boltzmann constant + D = 1._wp/0.6096748751_wp ! Diffusivity angle, from single-angle RRTMGP solver real(wp), dimension( ncol), parameter :: sfc_t = [(285._wp, icol = 1,ncol/2), & (310._wp, icol = 1,ncol/2)] real(wp), dimension( ncol), parameter :: total_tau = [0.1_wp, 1._wp, 10._wp, 50._wp, & @@ -311,7 +311,7 @@ function check_gray_rad_equil(sfc_T, lw_tau, top_at_1, up_flux, net_flux) ! Check top-of-atmosphere energy balance ! if(.not. allclose(up_flux(:,toa), & - gray_rad_equil_olr(sfc_t, lw_tau), tol=4._wp)) then + gray_rad_equil_olr(sfc_t, lw_tau), tol=8._wp)) then call report_err("OLR is not consistent with gray radiative equilibrium") check_gray_rad_equil = .false. end if @@ -322,7 +322,7 @@ function check_gray_rad_equil(sfc_T, lw_tau, top_at_1, up_flux, net_flux) ! if(.not. allclose(net_flux(:,:), & spread(net_flux(:,1), dim=2, ncopies=size(net_flux,2)), & - tol = 70._wp)) then + tol = 100._wp)) then call report_err("Net flux not constant with tau in gray radiative equilibrium") check_gray_rad_equil = .false. end if From 481d49acaa6e74a4335e2dc05d110752c64431d0 Mon Sep 17 00:00:00 2001 From: Robert Pincus Date: Mon, 20 May 2024 21:33:11 -0400 Subject: [PATCH 32/57] Use tag v1.8.1 for data repo --- .github/workflows/containerized-ci.yml | 2 +- .github/workflows/continuous-integration.yml | 2 +- .github/workflows/self-hosted-ci.yml | 2 +- .gitlab/common.yml | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/.github/workflows/containerized-ci.yml b/.github/workflows/containerized-ci.yml index 022fe2217..be87e23a1 100644 --- a/.github/workflows/containerized-ci.yml +++ b/.github/workflows/containerized-ci.yml @@ -72,7 +72,7 @@ jobs: with: repository: earth-system-radiation/rrtmgp-data path: rrtmgp-data - ref: develop + ref: 1.8.1 # # Build libraries, examples and tests (expect success) # diff --git a/.github/workflows/continuous-integration.yml b/.github/workflows/continuous-integration.yml index 9921917d6..d8a52f32d 100644 --- a/.github/workflows/continuous-integration.yml +++ b/.github/workflows/continuous-integration.yml @@ -52,7 +52,7 @@ jobs: with: repository: earth-system-radiation/rrtmgp-data path: rrtmgp-data - ref: develop + ref: v1.8.1 # # Synchronize the package index # diff --git a/.github/workflows/self-hosted-ci.yml b/.github/workflows/self-hosted-ci.yml index 3f344cd93..7077eda6f 100644 --- a/.github/workflows/self-hosted-ci.yml +++ b/.github/workflows/self-hosted-ci.yml @@ -62,7 +62,7 @@ jobs: with: repository: earth-system-radiation/rrtmgp-data path: rrtmgp-data - ref: develop + ref: v1.8.1 # # Finalize build environment # diff --git a/.gitlab/common.yml b/.gitlab/common.yml index 914f3c381..83a267840 100644 --- a/.gitlab/common.yml +++ b/.gitlab/common.yml @@ -16,7 +16,7 @@ RRTMGP_DATA: ${CI_PROJECT_DIR}/rrtmgp-data # Convenience variables: RRTMGP_DATA_REPO: https://github.com/earth-system-radiation/rrtmgp-data.git - RRTMGP_DATA_TAG: develop + RRTMGP_DATA_TAG: v1.8.1 script: # # Build libraries, examples and tests From 798ce3209c653cab5275caaaade5b43be0b9c832 Mon Sep 17 00:00:00 2001 From: Robert Pincus Date: Mon, 20 May 2024 21:54:00 -0400 Subject: [PATCH 33/57] tag typo? --- .github/workflows/containerized-ci.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/containerized-ci.yml b/.github/workflows/containerized-ci.yml index be87e23a1..3a931c60b 100644 --- a/.github/workflows/containerized-ci.yml +++ b/.github/workflows/containerized-ci.yml @@ -72,7 +72,7 @@ jobs: with: repository: earth-system-radiation/rrtmgp-data path: rrtmgp-data - ref: 1.8.1 + ref: v1.8.1 # # Build libraries, examples and tests (expect success) # From 04ac3f7986376b7899f0f258f79b6847e87ccd82 Mon Sep 17 00:00:00 2001 From: Robert Pincus Date: Mon, 20 May 2024 22:53:42 -0400 Subject: [PATCH 34/57] Merge main back into develop No files should actually be changed, this PR just ensures that the branches are up to date with one another. From 84d2730397e82e50537f1186f3cfbcad1f75e2c6 Mon Sep 17 00:00:00 2001 From: Robert Pincus Date: Tue, 21 May 2024 11:44:08 -0400 Subject: [PATCH 35/57] Script producing typos --- examples/all-sky/make_problem_size_loop.py | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/examples/all-sky/make_problem_size_loop.py b/examples/all-sky/make_problem_size_loop.py index 17483e71f..8b4cdee98 100644 --- a/examples/all-sky/make_problem_size_loop.py +++ b/examples/all-sky/make_problem_size_loop.py @@ -60,5 +60,5 @@ for l in args.nlay: for i in args.ncol: print(f"{args.executable} {i:6d} {l:4d} {args.nloops:3d} " + - f"{args.output_file} {args.k_distribution}" + - f"{args.cloud_optics} {args.aerosol_optics}") + f"{args.output_file} {args.k_distribution} " + + f"{args.cloud_optics} {args.aerosol_optics} ") From fb26ee794ed32c682fc30d077f4f5095e3ce0afb Mon Sep 17 00:00:00 2001 From: Robert Pincus Date: Thu, 23 May 2024 14:10:35 -0400 Subject: [PATCH 36/57] Fortran front-end: encapsulate orientation (#287) Introduces a top_at_1 variable encoding the vertical orientation to ty_optical_props_arry i.e. optical properties stored as array of values. The value is set by gas_optics() but could also be set by hand with op%set_top_at_1(). It's undefined by default which could lead to mischief. Changes the API for ty_optical_props_arry, rte_lw(), rte_sw() --- examples/all-sky/rrtmgp_allsky.F90 | 16 ++-- examples/rfmip-clear-sky/rrtmgp_rfmip_lw.F90 | 9 +- examples/rfmip-clear-sky/rrtmgp_rfmip_sw.F90 | 11 +-- extensions/mo_compute_bc.F90 | 4 +- extensions/mo_heating_rates.F90 | 1 - extensions/mo_rrtmgp_clr_all_sky.F90 | 33 ++----- rrtmgp-frontend/mo_gas_optics_rrtmgp.F90 | 30 +++--- rte-frontend/mo_optical_props.F90 | 36 +++++++- rte-frontend/mo_rte_lw.F90 | 20 ++-- rte-frontend/mo_rte_sw.F90 | 29 +++--- tests/check_equivalence.F90 | 91 +++++++++---------- tests/check_variants.F90 | 77 ++++++++-------- tests/mo_testing_utils.F90 | 1 + tests/rte_lw_solver_unit_tests.F90 | 46 +++++----- tests/rte_sw_solver_unit_tests.F90 | 19 ++-- ...test_zenith_angle_spherical_correction.F90 | 5 +- 16 files changed, 212 insertions(+), 216 deletions(-) diff --git a/examples/all-sky/rrtmgp_allsky.F90 b/examples/all-sky/rrtmgp_allsky.F90 index e25ec0bf3..f891a194e 100644 --- a/examples/all-sky/rrtmgp_allsky.F90 +++ b/examples/all-sky/rrtmgp_allsky.F90 @@ -89,10 +89,11 @@ program rte_rrtmgp_allsky ! ! Inputs to RRTMGP ! - logical :: top_at_1, is_sw, is_lw + logical :: is_sw, is_lw integer :: nbnd, ngpt integer :: icol, ilay, ibnd, iloop, igas + logical :: top_is_at_1 ! CCE OMP workaround character(len=8) :: char_input integer :: nUserArgs, nloops, ncol, nlay @@ -191,7 +192,6 @@ program rte_rrtmgp_allsky ! nbnd = k_dist%get_nband() ngpt = k_dist%get_ngpt() - top_at_1 = p_lay(1, 1) < p_lay(1, nlay) ! ---------------------------------------------------------------------------- ! LW calculations neglect scattering; SW calculations use the 2-stream approximation @@ -249,9 +249,10 @@ program rte_rrtmgp_allsky !$acc enter data create (t_sfc, emis_sfc) !$omp target enter data map(alloc:t_sfc, emis_sfc) ! Surface temperature + top_is_at_1 = atmos%top_is_at_1() ! CCE OMP workaround !$acc kernels !$omp target - t_sfc = t_lev(1, merge(nlay+1, 1, top_at_1)) + t_sfc = t_lev(1, merge(nlay+1, 1, top_is_at_1)) emis_sfc = 0.98_wp !$acc end kernels !$omp end target @@ -322,9 +323,9 @@ program rte_rrtmgp_allsky tlev = t_lev)) if(do_clouds) call stop_on_err(clouds%increment(atmos)) if(do_aerosols) call stop_on_err(aerosols%increment(atmos)) - call stop_on_err(rte_lw(atmos, top_at_1, & - lw_sources, & - emis_sfc, & + call stop_on_err(rte_lw(atmos, & + lw_sources, & + emis_sfc, & fluxes)) !$acc end data !$omp end target data @@ -347,8 +348,7 @@ program rte_rrtmgp_allsky call stop_on_err(aerosols%delta_scale()) call stop_on_err(aerosols%increment(atmos)) end if - call stop_on_err(rte_sw(atmos, top_at_1, & - mu0, toa_flux, & + call stop_on_err(rte_sw(atmos, mu0, toa_flux, & sfc_alb_dir, sfc_alb_dif, & fluxes)) !$acc end data diff --git a/examples/rfmip-clear-sky/rrtmgp_rfmip_lw.F90 b/examples/rfmip-clear-sky/rrtmgp_rfmip_lw.F90 index 607e372ef..07fac9c26 100644 --- a/examples/rfmip-clear-sky/rrtmgp_rfmip_lw.F90 +++ b/examples/rfmip-clear-sky/rrtmgp_rfmip_lw.F90 @@ -90,7 +90,6 @@ program rrtmgp_rfmip_lw character(len=132) :: kdist_file = 'coefficients_lw.nc' character(len=132) :: flxdn_file, flxup_file integer :: nargs, ncol, nlay, nbnd, nexp, nblocks, block_size, forcing_index, physics_index, n_quad_angles = 1 - logical :: top_at_1 integer :: b, icol, ibnd character(len=4) :: block_size_char, forcing_index_char = '1', physics_index_char = '1' @@ -168,10 +167,6 @@ program rrtmgp_rfmip_lw ! Allocation on assignment within reading routines ! call read_and_block_pt(rfmip_file, block_size, p_lay, p_lev, t_lay, t_lev) - ! - ! Are the arrays ordered in the vertical with 1 at the top or the bottom of the domain? - ! - top_at_1 = p_lay(1, 1, 1) < p_lay(1, nlay, 1) ! ! Read the gas concentrations and surface properties @@ -193,7 +188,8 @@ program rrtmgp_rfmip_lw ! is set to 10^-3 Pa. Here we pretend the layer is just a bit less deep. ! This introduces an error but shows input sanitizing. ! - if(top_at_1) then + ! Are the arrays ordered in the vertical with 1 at the top or the bottom of the domain? + if(p_lay(1, 1, 1) < p_lay(1, nlay, 1)) then p_lev(:,1,:) = k_dist%get_press_min() + epsilon(k_dist%get_press_min()) else p_lev(:,nlay+1,:) & @@ -256,7 +252,6 @@ program rrtmgp_rfmip_lw ! via ty_fluxes_broadband ! call stop_on_err(rte_lw(optical_props, & - top_at_1, & source, & sfc_emis_spec, & fluxes, n_gauss_angles = n_quad_angles)) diff --git a/examples/rfmip-clear-sky/rrtmgp_rfmip_sw.F90 b/examples/rfmip-clear-sky/rrtmgp_rfmip_sw.F90 index 547d9b4e3..e914f3f93 100644 --- a/examples/rfmip-clear-sky/rrtmgp_rfmip_sw.F90 +++ b/examples/rfmip-clear-sky/rrtmgp_rfmip_sw.F90 @@ -90,7 +90,6 @@ program rrtmgp_rfmip_sw character(len=132) :: kdist_file = 'coefficients_sw.nc' character(len=132) :: flxdn_file, flxup_file integer :: nargs, ncol, nlay, nbnd, ngpt, nexp, nblocks, block_size, forcing_index - logical :: top_at_1 integer :: b, icol, ibnd, igpt character(len=4) :: block_size_char, forcing_index_char = '1' @@ -166,10 +165,6 @@ program rrtmgp_rfmip_sw ! Allocation on assignment within reading routines ! call read_and_block_pt(rfmip_file, block_size, p_lay, p_lev, t_lay, t_lev) - ! - ! Are the arrays ordered in the vertical with 1 at the top or the bottom of the domain? - ! - top_at_1 = p_lay(1, 1, 1) < p_lay(1, nlay, 1) ! ! Read the gas concentrations and surface properties @@ -193,7 +188,10 @@ program rrtmgp_rfmip_sw ! is set to 10^-3 Pa. Here we pretend the layer is just a bit less deep. ! This introduces an error but shows input sanitizing. ! - if(top_at_1) then + ! + ! Are the arrays ordered in the vertical with 1 at the top or the bottom of the domain? + ! + if(p_lay(1, 1, 1) < p_lay(1, nlay, 1)) then p_lev(:,1,:) = k_dist%get_press_min() + epsilon(k_dist%get_press_min()) else p_lev(:,nlay+1,:) & @@ -296,7 +294,6 @@ program rrtmgp_rfmip_sw ! via ty_fluxes_broadband ! call stop_on_err(rte_sw(optical_props, & - top_at_1, & mu0, & toa_flux, & sfc_alb_spec, & diff --git a/extensions/mo_compute_bc.F90 b/extensions/mo_compute_bc.F90 index ef2a50b29..fbec1d974 100644 --- a/extensions/mo_compute_bc.F90 +++ b/extensions/mo_compute_bc.F90 @@ -166,7 +166,6 @@ function compute_bc(k_dist, & ! Compute fluxes ! error_msg = rte_lw(optical_props_1lay, & - top_at_1, & lw_sources_1lay, & lower_bc, fluxes_1lev) else @@ -191,8 +190,7 @@ function compute_bc(k_dist, & optical_props_1lay, & solar_src) error_msg = rte_sw(optical_props_1lay, & - top_at_1, mu0, & - solar_src, & + mu0, solar_src, & lower_bc, lower_bc, fluxes_1lev) endif end function diff --git a/extensions/mo_heating_rates.F90 b/extensions/mo_heating_rates.F90 index dc2ce15c7..9535ae4cd 100644 --- a/extensions/mo_heating_rates.F90 +++ b/extensions/mo_heating_rates.F90 @@ -71,7 +71,6 @@ function compute_heating_rate_solar_varmu0(flux_up, flux_dn, flux_dir, p_lev, mu ! --------- integer :: ncol, nlay, icol, ilay integer :: last_sunlight_layer(size(mu0, 1)) - logical(wl) :: top_at_1 ! --------- error_msg = "" ! diff --git a/extensions/mo_rrtmgp_clr_all_sky.F90 b/extensions/mo_rrtmgp_clr_all_sky.F90 index 755681cbb..eb122d73d 100644 --- a/extensions/mo_rrtmgp_clr_all_sky.F90 +++ b/extensions/mo_rrtmgp_clr_all_sky.F90 @@ -74,7 +74,6 @@ function rte_lw(k_dist, gas_concs, p_lay, t_lay, p_lev, & type(ty_source_func_lw) :: sources integer :: ncol, nlay, ngpt, nband, nstr - logical :: top_at_1 ! -------------------------------- ! Problem sizes ! @@ -85,11 +84,6 @@ function rte_lw(k_dist, gas_concs, p_lay, t_lay, p_lev, & ngpt = k_dist%get_ngpt() nband = k_dist%get_nband() - !$acc kernels copyout(top_at_1) - !$omp target map(from:top_at_1) - top_at_1 = p_lay(1, 1) < p_lay(1, nlay) - !$acc end kernels - !$omp end target ! ------------------------------------------------------------------------------------ ! Error checking @@ -161,8 +155,8 @@ function rte_lw(k_dist, gas_concs, p_lay, t_lay, p_lev, & if(present(aer_props)) error_msg = aer_props%increment(optical_props) if(error_msg /= '') return - error_msg = base_rte_lw(optical_props, top_at_1, sources, & - sfc_emis, clrsky_fluxes, & + error_msg = base_rte_lw(optical_props, sources, & + sfc_emis, clrsky_fluxes, & inc_flux, n_gauss_angles) if(error_msg /= '') return ! ------------------------------------------------------------------------------------ @@ -171,8 +165,8 @@ function rte_lw(k_dist, gas_concs, p_lay, t_lay, p_lev, & error_msg = cloud_props%increment(optical_props) if(error_msg /= '') return - error_msg = base_rte_lw(optical_props, top_at_1, sources, & - sfc_emis, allsky_fluxes, & + error_msg = base_rte_lw(optical_props, sources, & + sfc_emis, allsky_fluxes, & inc_flux, n_gauss_angles) call sources%finalize() @@ -207,7 +201,6 @@ function rte_sw(k_dist, gas_concs, p_lay, t_lay, p_lev, & class(ty_optical_props_arry), allocatable :: optical_props real(wp), dimension(:,:), allocatable :: toa_flux integer :: ncol, nlay, ngpt, nband, nstr - logical :: top_at_1 ! -------------------------------- ! Problem sizes ! @@ -218,12 +211,6 @@ function rte_sw(k_dist, gas_concs, p_lay, t_lay, p_lev, & ngpt = k_dist%get_ngpt() nband = k_dist%get_nband() - !$acc kernels copyout(top_at_1) - !$omp target map(from:top_at_1) - top_at_1 = p_lay(1, 1) < p_lay(1, nlay) - !$acc end kernels - !$omp end target - ! ------------------------------------------------------------------------------------ ! Error checking ! @@ -276,7 +263,7 @@ function rte_sw(k_dist, gas_concs, p_lay, t_lay, p_lev, & ! Gas optical depth -- pressure need to be expressed as Pa ! error_msg = k_dist%gas_optics(p_lay, p_lev, t_lay, gas_concs, & - optical_props, toa_flux, & + optical_props, toa_flux, & col_dry) if (error_msg /= '') return ! @@ -289,9 +276,8 @@ function rte_sw(k_dist, gas_concs, p_lay, t_lay, p_lev, & if(present(aer_props)) error_msg = aer_props%increment(optical_props) if(error_msg /= '') return - error_msg = base_rte_sw(optical_props, top_at_1, & - mu0, toa_flux, & - sfc_alb_dir, sfc_alb_dif, & + error_msg = base_rte_sw(optical_props, mu0, toa_flux, & + sfc_alb_dir, sfc_alb_dif, & clrsky_fluxes) if(error_msg /= '') return @@ -301,9 +287,8 @@ function rte_sw(k_dist, gas_concs, p_lay, t_lay, p_lev, & error_msg = cloud_props%increment(optical_props) if(error_msg /= '') return - error_msg = base_rte_sw(optical_props, top_at_1, & - mu0, toa_flux, & - sfc_alb_dir, sfc_alb_dif, & + error_msg = base_rte_sw(optical_props, mu0, toa_flux, & + sfc_alb_dir, sfc_alb_dif, & allsky_fluxes) call optical_props%finalize() diff --git a/rrtmgp-frontend/mo_gas_optics_rrtmgp.F90 b/rrtmgp-frontend/mo_gas_optics_rrtmgp.F90 index 906c7cccb..967d656a9 100644 --- a/rrtmgp-frontend/mo_gas_optics_rrtmgp.F90 +++ b/rrtmgp-frontend/mo_gas_optics_rrtmgp.F90 @@ -258,6 +258,10 @@ function gas_optics_int(this, & ngpt = this%get_ngpt() nband = this%get_nband() ! + ! Vertical orientation + ! + call optical_props%set_top_at_1(play(1,1) < play(1, nlay)) + ! ! Gas optics ! !$acc enter data create(jtemp, jpress, tropo, fmajor, jeta) @@ -309,7 +313,7 @@ function gas_optics_int(this, & ! if(present(tlev)) then error_msg = source(this, & - ncol, nlay, nband, ngpt, & + ncol, nlay, nband, ngpt, optical_props%top_is_at_1(), & play, plev, tlay, tsfc, & jtemp, jpress, jeta, tropo, fmajor, & sources, & @@ -318,7 +322,7 @@ function gas_optics_int(this, & !$omp target exit data map(release:tlev) else error_msg = source(this, & - ncol, nlay, nband, ngpt, & + ncol, nlay, nband, ngpt, optical_props%top_is_at_1(), & play, plev, tlay, tsfc, & jtemp, jpress, jeta, tropo, fmajor, & sources) @@ -328,6 +332,7 @@ function gas_optics_int(this, & !$omp target exit data map(release:tsfc) !$acc exit data delete(jtemp, jpress, tropo, fmajor, jeta) !$omp target exit data map(release:jtemp, jpress, tropo, fmajor, jeta) + end function gas_optics_int !------------------------------------------------------------------------------------------ ! @@ -371,6 +376,10 @@ function gas_optics_ext(this, & ngas = this%get_ngas() nflav = get_nflav(this) ! + ! Vertical orientation + ! + call optical_props%set_top_at_1(play(1,1) < play(1, nlay)) + ! ! Gas optics ! !$acc enter data create(jtemp, jpress, tropo, fmajor, jeta) @@ -383,6 +392,7 @@ function gas_optics_ext(this, & col_dry) !$acc exit data delete(jtemp, jpress, tropo, fmajor, jeta) !$omp target exit data map(release:jtemp, jpress, tropo, fmajor, jeta) + if(error_msg /= '') return ! ---------------------------------------------------------- @@ -833,7 +843,7 @@ end function set_tsi ! Compute Planck source functions at layer centers and levels ! function source(this, & - ncol, nlay, nbnd, ngpt, & + ncol, nlay, nbnd, ngpt, top_at_1, & play, plev, tlay, tsfc, & jtemp, jpress, jeta, tropo, fmajor, & sources, & ! Planck sources @@ -842,6 +852,7 @@ function source(this, & ! inputs class(ty_gas_optics_rrtmgp), intent(in ) :: this integer, intent(in ) :: ncol, nlay, nbnd, ngpt + logical, intent(in ) :: top_at_1 real(wp), dimension(ncol,nlay), intent(in ) :: play ! layer pressures [Pa, mb] real(wp), dimension(ncol,nlay+1), intent(in ) :: plev ! level pressures [Pa, mb] real(wp), dimension(ncol,nlay), intent(in ) :: tlay ! layer temperatures [K] @@ -858,7 +869,6 @@ function source(this, & optional, target :: tlev ! level temperatures [K] character(len=128) :: error_msg ! ---------------------------------------------------------- - logical(wl) :: top_at_1 integer :: icol, ilay ! Variables for temperature at layer edges [K] (ncol, nlay+1) real(wp), dimension( ncol,nlay+1), target :: tlev_arr @@ -910,18 +920,12 @@ function source(this, & ! Compute internal (Planck) source functions at layers and levels, ! which depend on mapping from spectral space that creates k-distribution. - !$acc kernels copyout(top_at_1) - !$omp target map(from:top_at_1) - top_at_1 = play(1,1) < play(1, nlay) - !$acc end kernels - !$omp end target - call compute_Planck_source(ncol, nlay, nbnd, ngpt, & get_nflav(this), this%get_neta(), this%get_npres(), this%get_ntemp(), this%get_nPlanckTemp(), & - tlay, tlev_wk, tsfc, merge(nlay, 1, top_at_1), & - fmajor, jeta, tropo, jtemp, jpress, & + tlay, tlev_wk, tsfc, merge(nlay, 1, logical(top_at_1, wl)), & + fmajor, jeta, tropo, jtemp, jpress, & this%get_gpoint_bands(), this%get_band_lims_gpoint(), this%planck_frac, this%temp_ref_min,& - this%totplnk_delta, this%totplnk, this%gpoint_flavor, & + this%totplnk_delta, this%totplnk, this%gpoint_flavor, & sources%sfc_source, sources%lay_source, sources%lev_source, & sources%sfc_source_Jac) !$acc end data diff --git a/rte-frontend/mo_optical_props.F90 b/rte-frontend/mo_optical_props.F90 index c49fd5dc8..5f216a52e 100644 --- a/rte-frontend/mo_optical_props.F90 +++ b/rte-frontend/mo_optical_props.F90 @@ -33,6 +33,7 @@ !> !> These classes must be allocated before use. Initialization and allocation can be combined. !> The classes have a validate() function that checks all arrays for valid values (e.g. tau > 0.) +!> The vertical orientation can be specified via this%set_top_at_1() or obtained via this%top_at_1(). !> !> Optical properties can be delta-scaled (though this is currently implemented only for two-stream arrays) !> @@ -51,7 +52,7 @@ !@endnote !> ------------------------------------------------------------------------------------------------- module mo_optical_props - use mo_rte_kind, only: wp + use mo_rte_kind, only: wp, wl use mo_rte_config, only: check_extents, check_values use mo_rte_util_array_validation, & only: any_vals_less_than, any_vals_outside, extents_are @@ -109,6 +110,7 @@ module mo_optical_props ! ------------------------------------------------------------------------------------------------- type, extends(ty_optical_props), abstract, public :: ty_optical_props_arry real(wp), dimension(:,:,:), allocatable :: tau !! optical depth (ncol, nlay, ngpt) + logical(wl), private :: top_at_1 ! No default - maybe uninitialized values will get caught? contains procedure, public :: get_ncol procedure, public :: get_nlay @@ -116,6 +118,11 @@ module mo_optical_props !> Increment another set of values !> procedure, public :: increment + !> + !> + !> + procedure, public :: top_is_at_1 + procedure, public :: set_top_at_1 !> !> Deferred procedures -- each must be implemented in each child class with @@ -757,6 +764,7 @@ function subset_1scl_range(full, start, n, subset) result(err_message) subset%p(:,1:n,:,:) = 0._wp end select call extract_subset(ncol, nlay, ngpt, full%tau, start, start+n-1, subset%tau) + call subset%set_top_at_1(full%top_is_at_1()) end function subset_1scl_range ! ------------------------------------------------------------------------------------------ @@ -810,6 +818,7 @@ function subset_2str_range(full, start, n, subset) result(err_message) subset%p(1,1:n,:,:) = full%g (start:start+n-1,:,:) subset%p(2:,:, :,:) = 0._wp end select + call subset%set_top_at_1(full%top_is_at_1()) end function subset_2str_range ! ------------------------------------------------------------------------------------------ @@ -858,6 +867,7 @@ function subset_nstr_range(full, start, n, subset) result(err_message) call extract_subset( ncol, nlay, ngpt, full%ssa, start, start+n-1, subset%ssa) call extract_subset(nmom, ncol, nlay, ngpt, full%p , start, start+n-1, subset%p ) end select + call subset%set_top_at_1(full%top_is_at_1()) end function subset_nstr_range !> ------------------------------------------------------------------------------------------ @@ -1057,6 +1067,30 @@ pure function get_nmom(this) get_nmom = 0 end if end function get_nmom + !> ----------------------------------------------------------------------------------------------- + !> + !> Routines for array classes: vertical orientation + !> + ! ------------------------------------------------------------------------------------------ + pure function top_is_at_1(this) + ! + ! Vertical orientation - .true. if array index 1 is top of atmosphere + ! + class(ty_optical_props_arry), intent(in) :: this + logical :: top_is_at_1 + + top_is_at_1 = this%top_at_1 + end function top_is_at_1 + ! ------------------------------------------------------------------------------------------ + subroutine set_top_at_1(this, top_at_1) + ! + !> Set vertical orientation of class - .true. if array index 1 is top of atmosphere + ! + class(ty_optical_props_arry), intent(inout) :: this + logical, intent(in ) :: top_at_1 + + this%top_at_1 = top_at_1 + end subroutine set_top_at_1 ! ----------------------------------------------------------------------------------------------- ! ! Routines for base class: spectral discretization diff --git a/rte-frontend/mo_rte_lw.F90 b/rte-frontend/mo_rte_lw.F90 index 47a11ebe6..d03eaf1e9 100644 --- a/rte-frontend/mo_rte_lw.F90 +++ b/rte-frontend/mo_rte_lw.F90 @@ -67,15 +67,13 @@ module mo_rte_lw ! Interface using only optical properties and source functions as inputs; fluxes as outputs. ! ! -------------------------------------------------- - function rte_lw(optical_props, top_at_1, & - sources, sfc_emis, & - fluxes, & + function rte_lw(optical_props, & + sources, sfc_emis, & + fluxes, & inc_flux, n_gauss_angles, use_2stream, & lw_Ds, flux_up_Jac) result(error_msg) class(ty_optical_props_arry), intent(in ) :: optical_props !! Set of optical properties as one or more arrays - logical, intent(in ) :: top_at_1 - !! Is the top of the domain at index 1? (if not, ordering is bottom-to-top) type(ty_source_func_lw), intent(in ) :: sources !! Derived type with Planck source functions real(wp), dimension(:,:), intent(in ) :: sfc_emis @@ -353,8 +351,8 @@ function rte_lw(optical_props, top_at_1, & end do end if call lw_solver_noscat(ncol, nlay, ngpt, & - logical(top_at_1, wl), n_quad_angs, & - secants, gauss_wts(1:n_quad_angs,n_quad_angs), & + logical(optical_props%top_is_at_1(), wl), & + n_quad_angs, secants, gauss_wts(1:n_quad_angs,n_quad_angs), & optical_props%tau, & sources%lay_source, & sources%lev_source, & @@ -373,7 +371,8 @@ function rte_lw(optical_props, top_at_1, & ! ! two-stream calculation with scattering ! - call lw_solver_2stream(ncol, nlay, ngpt, logical(top_at_1, wl), & + call lw_solver_2stream(ncol, nlay, ngpt, & + logical(optical_props%top_is_at_1(), wl), & optical_props%tau, optical_props%ssa, optical_props%g, & sources%lay_source, sources%lev_source, & sfc_emis_gpt, sources%sfc_source, & @@ -396,7 +395,8 @@ function rte_lw(optical_props, top_at_1, & ! Re-scaled solution to account for scattering ! call lw_solver_noscat(ncol, nlay, ngpt, & - logical(top_at_1, wl), n_quad_angs, & + logical(optical_props%top_is_at_1(), wl), & + n_quad_angs, & secants, gauss_wts(1:n_quad_angs,n_quad_angs), & optical_props%tau, & sources%lay_source, & @@ -438,7 +438,7 @@ function rte_lw(optical_props, top_at_1, & ! ! ...or reduce spectral fluxes to desired output quantities ! - error_msg = fluxes%reduce(gpt_flux_up, gpt_flux_dn, optical_props, top_at_1) + error_msg = fluxes%reduce(gpt_flux_up, gpt_flux_dn, optical_props, optical_props%top_is_at_1()) end select end if ! no error message from validation !$acc end data diff --git a/rte-frontend/mo_rte_sw.F90 b/rte-frontend/mo_rte_sw.F90 index 22cdf3aeb..7a4b359c0 100644 --- a/rte-frontend/mo_rte_sw.F90 +++ b/rte-frontend/mo_rte_sw.F90 @@ -53,14 +53,12 @@ module mo_rte_sw contains ! ------------------------------------------------------------------------------------------------- - function rte_sw_mu0_bycol(atmos, top_at_1, & + function rte_sw_mu0_bycol(atmos, & mu0, inc_flux, & sfc_alb_dir, sfc_alb_dif, & fluxes, inc_flux_dif) result(error_msg) class(ty_optical_props_arry), intent(in ) :: atmos !! Optical properties provided as arrays - logical, intent(in ) :: top_at_1 - !! Is the top of the domain at index 1? (if not, ordering is bottom-to-top) real(wp), dimension(:), intent(in ) :: mu0 !! cosine of solar zenith angle (ncol) - will be assumed constant with height real(wp), dimension(:,:), intent(in ) :: inc_flux @@ -94,22 +92,19 @@ function rte_sw_mu0_bycol(atmos, top_at_1, & end do end do - error_msg = rte_sw_mu0_full(atmos, top_at_1, & - mu0_bylay, inc_flux, & - sfc_alb_dir, sfc_alb_dif, & + error_msg = rte_sw_mu0_full(atmos, & + mu0_bylay, inc_flux, & + sfc_alb_dir, sfc_alb_dif, & fluxes, inc_flux_dif) !$acc end data !$omp end target data end function rte_sw_mu0_bycol ! ------------------------------------------------------------------------------------------------- - function rte_sw_mu0_full(atmos, top_at_1, & - mu0, inc_flux, & - sfc_alb_dir, sfc_alb_dif, & - fluxes, inc_flux_dif) result(error_msg) + function rte_sw_mu0_full(atmos, mu0, inc_flux, & + sfc_alb_dir, sfc_alb_dif, & + fluxes, inc_flux_dif) result(error_msg) class(ty_optical_props_arry), intent(in ) :: atmos !! Optical properties provided as arrays - logical, intent(in ) :: top_at_1 - !! Is the top of the domain at index 1? (if not, ordering is bottom-to-top) real(wp), dimension(:,:), intent(in ) :: mu0 !! cosine of solar zenith angle (ncol, nlay) real(wp), dimension(:,:), intent(in ) :: inc_flux @@ -293,8 +288,9 @@ function rte_sw_mu0_full(atmos, top_at_1, & ! ! Direct beam only - for completeness, unlikely to be used in practice ! - call sw_solver_noscat(ncol, nlay, ngpt, logical(top_at_1, wl), & - atmos%tau, mu0, inc_flux, & + call sw_solver_noscat(ncol, nlay, ngpt, & + logical(atmos%top_is_at_1(), wl), & + atmos%tau, mu0, inc_flux, & gpt_flux_dir) call zero_array(ncol, nlay+1, ngpt, gpt_flux_up) ! @@ -308,7 +304,8 @@ function rte_sw_mu0_full(atmos, top_at_1, & ! ! two-stream calculation with scattering ! - call sw_solver_2stream(ncol, nlay, ngpt, logical(top_at_1, wl), & + call sw_solver_2stream(ncol, nlay, ngpt, & + logical(atmos%top_is_at_1(), wl), & atmos%tau, atmos%ssa, atmos%g, mu0, & sfc_alb_dir_gpt, sfc_alb_dif_gpt, & inc_flux, & @@ -348,7 +345,7 @@ function rte_sw_mu0_full(atmos, top_at_1, & ! ! ...or reduce spectral fluxes to desired output quantities ! - error_msg = fluxes%reduce(gpt_flux_up, gpt_flux_dn, atmos, top_at_1, gpt_flux_dir) + error_msg = fluxes%reduce(gpt_flux_up, gpt_flux_dn, atmos, atmos%top_is_at_1(), gpt_flux_dir) end select end if ! In case of an error we exit here diff --git a/tests/check_equivalence.F90 b/tests/check_equivalence.F90 index f08ca8a26..7ece94aae 100644 --- a/tests/check_equivalence.F90 +++ b/tests/check_equivalence.F90 @@ -99,7 +99,7 @@ program rte_check_equivalence ! ! Inputs to RRTMGP ! - logical :: top_at_1, is_sw, is_lw + logical :: is_sw, is_lw integer :: ncol, nlay, nbnd, ngpt, nexp integer :: icol, ilay, ibnd, iloop, igas @@ -168,7 +168,6 @@ program rte_check_equivalence ! nbnd = gas_optics%get_nband() ngpt = gas_optics%get_ngpt() - top_at_1 = p_lay(1, 1) < p_lay(1, nlay) ! ---------------------------------------------------------------------------- ! ! Boundary conditions @@ -236,9 +235,9 @@ program rte_check_equivalence atmos, & lw_sources, & tlev = t_lev)) - call stop_on_err(rte_lw(atmos, top_at_1, & - lw_sources, & - sfc_emis, & + call stop_on_err(rte_lw(atmos, & + lw_sources, & + sfc_emis, & fluxes)) print *, " Default calculation" ! @@ -253,17 +252,17 @@ program rte_check_equivalence nullify(fluxes%flux_up) nullify(fluxes%flux_dn) allocate(fluxes%flux_net(ncol,nlay+1)) - call stop_on_err(rte_lw(atmos, top_at_1, & - lw_sources, & - sfc_emis, & + call stop_on_err(rte_lw(atmos, & + lw_sources, & + sfc_emis, & fluxes)) if(.not. allclose(fluxes%flux_net, ref_flux_dn-ref_flux_up) ) & call stop_on_err("Net fluxes don't match when computed alone") fluxes%flux_up => tst_flux_up(:,:) fluxes%flux_dn => tst_flux_dn(:,:) - call stop_on_err(rte_lw(atmos, top_at_1, & - lw_sources, & - sfc_emis, & + call stop_on_err(rte_lw(atmos, & + lw_sources, & + sfc_emis, & fluxes)) if(.not. allclose(fluxes%flux_net, ref_flux_dn-ref_flux_up) ) & call report_err("Net fluxes don't match when computed in tandem") @@ -293,36 +292,36 @@ program rte_check_equivalence ! atmos%tau(:,:,:) = 0.5_wp * atmos%tau(:,:,:) call stop_on_err(atmos%increment(atmos)) - call stop_on_err(rte_lw(atmos, top_at_1, & - lw_sources, & - sfc_emis, & + call stop_on_err(rte_lw(atmos, & + lw_sources, & + sfc_emis, & fluxes)) if(.not. allclose(tst_flux_up, ref_flux_up) .or. & .not. allclose(tst_flux_dn, ref_flux_dn) ) & call report_err(" halving/doubling fails") call increment_with_1scl(atmos) - call stop_on_err(rte_lw(atmos, top_at_1, & - lw_sources, & - sfc_emis, & + call stop_on_err(rte_lw(atmos, & + lw_sources, & + sfc_emis, & fluxes)) if(.not. allclose(tst_flux_up, ref_flux_up) .or. & .not. allclose(tst_flux_dn, ref_flux_dn) ) & call report_err(" Incrementing with 1scl fails") call increment_with_2str(atmos) - call stop_on_err(rte_lw(atmos, top_at_1, & - lw_sources, & - sfc_emis, & + call stop_on_err(rte_lw(atmos, & + lw_sources, & + sfc_emis, & fluxes)) if(.not. allclose(tst_flux_up, ref_flux_up) .or. & .not. allclose(tst_flux_dn, ref_flux_dn) ) & call report_err(" Incrementing with 2str fails") call increment_with_nstr(atmos) - call stop_on_err(rte_lw(atmos, top_at_1, & - lw_sources, & - sfc_emis, & + call stop_on_err(rte_lw(atmos, & + lw_sources, & + sfc_emis, & fluxes)) if(.not. allclose(tst_flux_up, ref_flux_up) .or. & .not. allclose(tst_flux_dn, ref_flux_dn) ) & @@ -332,10 +331,10 @@ program rte_check_equivalence ! ! Computing Jacobian shouldn't change net fluxes ! - call stop_on_err(rte_lw(atmos, top_at_1, & - lw_sources, & - sfc_emis, & - fluxes, & + call stop_on_err(rte_lw(atmos, & + lw_sources, & + sfc_emis, & + fluxes, & flux_up_Jac = jFluxUp)) if(.not. allclose(tst_flux_up, ref_flux_up) .or. & .not. allclose(tst_flux_dn, ref_flux_dn) ) & @@ -349,9 +348,9 @@ program rte_check_equivalence atmos, & lw_sources, & tlev = t_lev)) - call stop_on_err(rte_lw(atmos, top_at_1, & - lw_sources, & - sfc_emis, & + call stop_on_err(rte_lw(atmos, & + lw_sources, & + sfc_emis, & fluxes)) ! ! Comparision of fluxes with increased surface T aren't expected to match @@ -385,8 +384,7 @@ program rte_check_equivalence gas_concs, & atmos, & toa_flux)) - call stop_on_err(rte_sw(atmos, top_at_1, & - mu0, toa_flux, & + call stop_on_err(rte_sw(atmos, mu0, toa_flux, & sfc_alb_dir, sfc_alb_dif, & fluxes)) print *, " Default calculation" @@ -427,8 +425,7 @@ program rte_check_equivalence toa_flux)) atmos%tau(:,:,:) = 0.5_wp * atmos%tau(:,:,:) call stop_on_err(atmos%increment(atmos)) - call stop_on_err(rte_sw(atmos, top_at_1, & - mu0, toa_flux, & + call stop_on_err(rte_sw(atmos, mu0, toa_flux, & sfc_alb_dir, sfc_alb_dif, & fluxes)) if(.not. allclose(tst_flux_up, ref_flux_up, tol = 8._wp) .or. & @@ -445,7 +442,7 @@ program rte_check_equivalence atmos, & toa_flux)) call increment_with_1scl(atmos) - call stop_on_err(rte_sw(atmos, top_at_1, & + call stop_on_err(rte_sw(atmos, & mu0, toa_flux, & sfc_alb_dir, sfc_alb_dif, & fluxes)) @@ -460,7 +457,7 @@ program rte_check_equivalence atmos, & toa_flux)) call increment_with_2str(atmos) - call stop_on_err(rte_sw(atmos, top_at_1, & + call stop_on_err(rte_sw(atmos, & mu0, toa_flux, & sfc_alb_dir, sfc_alb_dif, & fluxes)) @@ -475,7 +472,7 @@ program rte_check_equivalence atmos, & toa_flux)) call increment_with_nstr(atmos) - call stop_on_err(rte_sw(atmos, top_at_1, & + call stop_on_err(rte_sw(atmos, & mu0, toa_flux, & sfc_alb_dir, sfc_alb_dif, & fluxes)) @@ -507,7 +504,6 @@ subroutine lw_clear_sky_vr t_lay (:,:) = t_lay (:, nlay :1:-1) p_lev (:,:) = p_lev (:,(nlay+1):1:-1) t_lev (:,:) = t_lev (:,(nlay+1):1:-1) - top_at_1 = .not. top_at_1 ! ! No direct access to gas concentrations so use the classes ! This also tests otherwise uncovered routines for ty_gas_concs @@ -526,9 +522,9 @@ subroutine lw_clear_sky_vr atmos, & lw_sources, & tlev=t_lev)) - call stop_on_err(rte_lw(atmos, top_at_1, & - lw_sources, & - sfc_emis, & + call stop_on_err(rte_lw(atmos, & + lw_sources, & + sfc_emis, & fluxes)) tst_flux_up(:,:) = tst_flux_up(:,(nlay+1):1:-1) tst_flux_dn(:,:) = tst_flux_dn(:,(nlay+1):1:-1) @@ -536,7 +532,6 @@ subroutine lw_clear_sky_vr t_lay (:,:) = t_lay (:, nlay :1:-1) p_lev (:,:) = p_lev (:,(nlay+1):1:-1) t_lev (:,:) = t_lev (:,(nlay+1):1:-1) - top_at_1 = .not. top_at_1 end subroutine lw_clear_sky_vr ! ---------------------------------------------------------------------------- ! @@ -566,8 +561,8 @@ subroutine lw_clear_sky_subset colE = i * ncol/2 call stop_on_err(atmos%get_subset (colS, ncol/2, atmos_subset)) call stop_on_err(lw_sources%get_subset(colS, ncol/2, sources_subset)) - call stop_on_err(rte_lw(atmos_subset, top_at_1, & - sources_subset, & + call stop_on_err(rte_lw(atmos_subset, & + sources_subset, & sfc_emis(:, colS:colE), & fluxes)) tst_flux_up(colS:colE,:) = up @@ -594,7 +589,6 @@ subroutine sw_clear_sky_vr p_lay (:,:) = p_lay (:, nlay :1:-1) t_lay (:,:) = t_lay (:, nlay :1:-1) p_lev (:,:) = p_lev (:,(nlay+1):1:-1) - top_at_1 = .not. top_at_1 ! ! No direct access to gas concentrations so use the classes ! This also tests otherwise uncovered routines for ty_gas_concs @@ -612,8 +606,7 @@ subroutine sw_clear_sky_vr gas_concs_vr, & atmos, & toa_flux)) - call stop_on_err(rte_sw(atmos, top_at_1, & - mu0, toa_flux, & + call stop_on_err(rte_sw(atmos, mu0, toa_flux, & sfc_alb_dir, sfc_alb_dif, & fluxes)) ! @@ -626,7 +619,6 @@ subroutine sw_clear_sky_vr p_lay (:,:) = p_lay (:, nlay :1:-1) t_lay (:,:) = t_lay (:, nlay :1:-1) p_lev (:,:) = p_lev (:,(nlay+1):1:-1) - top_at_1 = .not. top_at_1 end subroutine sw_clear_sky_vr ! ---------------------------------------------------------------------------- ! @@ -645,8 +637,7 @@ subroutine sw_clear_sky_tsi gas_concs, & atmos, & toa_flux)) - call stop_on_err(rte_sw(atmos, top_at_1, & - mu0, toa_flux, & + call stop_on_err(rte_sw(atmos, mu0, toa_flux, & sfc_alb_dir, sfc_alb_dif, & fluxes)) tst_flux_up (:,:) = tst_flux_up (:,:) / tsi_scale diff --git a/tests/check_variants.F90 b/tests/check_variants.F90 index a57b9ec84..db58d7885 100644 --- a/tests/check_variants.F90 +++ b/tests/check_variants.F90 @@ -100,7 +100,7 @@ program rte_clear_sky_regression ! ! Inputs to RRTMGP ! - logical :: top_at_1, is_sw, is_lw + logical :: is_sw, is_lw integer :: ncol, nlay, nbnd, ngpt, nexp integer :: icol, ilay, ibnd, iloop, igas @@ -166,7 +166,6 @@ program rte_clear_sky_regression ! nbnd = gas_optics%get_nband() ngpt = gas_optics%get_ngpt() - top_at_1 = p_lay(1, 1) < p_lay(1, nlay) ! ---------------------------------------------------------------------------- ! ! Boundary conditions @@ -261,9 +260,9 @@ subroutine lw_clear_sky_default atmos, & lw_sources, & tlev = t_lev)) - call stop_on_err(rte_lw(atmos, top_at_1, & - lw_sources, & - sfc_emis, & + call stop_on_err(rte_lw(atmos, & + lw_sources, & + sfc_emis, & fluxes)) call write_broadband_field(input_file, flux_up, "lw_flux_up", "LW flux up") call write_broadband_field(input_file, flux_dn, "lw_flux_dn", "LW flux dn") @@ -277,9 +276,9 @@ subroutine lw_clear_sky_default ! nullify(fluxes%flux_up) nullify(fluxes%flux_dn) - call stop_on_err(rte_lw(atmos, top_at_1, & - lw_sources, & - sfc_emis, & + call stop_on_err(rte_lw(atmos, & + lw_sources, & + sfc_emis, & fluxes)) call write_broadband_field(input_file, flux_net, "lw_flux_net_2", "LW flux net, direct") fluxes%flux_up => flux_up @@ -297,9 +296,9 @@ subroutine lw_clear_sky_notlev gas_concs, & atmos, & lw_sources)) - call stop_on_err(rte_lw(atmos, top_at_1, & - lw_sources, & - sfc_emis, & + call stop_on_err(rte_lw(atmos, & + lw_sources, & + sfc_emis, & fluxes)) call write_broadband_field(input_file, flux_up, "lw_flux_up_notlev", "LW flux up, no level temperatures") call write_broadband_field(input_file, flux_dn, "lw_flux_dn_notlev", "LW flux dn, no level temperatures") @@ -315,9 +314,9 @@ subroutine lw_clear_sky_3ang atmos, & lw_sources, & tlev = t_lev)) - call stop_on_err(rte_lw(atmos, top_at_1, & - lw_sources, & - sfc_emis, & + call stop_on_err(rte_lw(atmos, & + lw_sources, & + sfc_emis, & fluxes, n_gauss_angles=3)) call write_broadband_field(input_file, flux_up, "lw_flux_up_3ang", "LW flux up, three quadrature angles") call write_broadband_field(input_file, flux_dn, "lw_flux_dn_3ang", "LW flux dn, three quadrature angles") @@ -335,9 +334,9 @@ subroutine lw_clear_sky_optangle lw_sources, & tlev = t_lev)) call stop_on_err(gas_optics%compute_optimal_angles(atmos, lw_Ds)) - call stop_on_err(rte_lw(atmos, top_at_1, & - lw_sources, & - sfc_emis, & + call stop_on_err(rte_lw(atmos, & + lw_sources, & + sfc_emis, & fluxes, lw_Ds=lw_Ds)) call write_broadband_field(input_file, flux_up, "lw_flux_up_optang", "LW flux up, single optimal angles") call write_broadband_field(input_file, flux_dn, "lw_flux_dn_optang", "LW flux dn, single optimal angles") @@ -355,10 +354,10 @@ subroutine lw_clear_sky_jaco atmos, & lw_sources, & tlev=t_lev)) - call stop_on_err(rte_lw(atmos, top_at_1, & - lw_sources, & - sfc_emis, & - fluxes, & + call stop_on_err(rte_lw(atmos, & + lw_sources, & + sfc_emis, & + fluxes, & flux_up_Jac = jFluxUp)) call write_broadband_field(input_file, flux_up, "lw_flux_up_jaco", "LW flux up, computing Jaobians") call write_broadband_field(input_file, flux_dn, "lw_flux_dn_jaco", "LW flux dn, computing Jaobians") @@ -370,9 +369,9 @@ subroutine lw_clear_sky_jaco atmos, & lw_sources, & tlev=t_lev)) - call stop_on_err(rte_lw(atmos, top_at_1, & - lw_sources, & - sfc_emis, & + call stop_on_err(rte_lw(atmos, & + lw_sources, & + sfc_emis, & fluxes)) call write_broadband_field(input_file, flux_up, "lw_flux_up_stp1", "LW flux up, surface T+1K") call write_broadband_field(input_file, flux_dn, "lw_flux_dn_stp1", "LW flux dn, surface T+1K") @@ -391,16 +390,16 @@ subroutine lw_clear_sky_2str atmos, & lw_sources, & tlev=t_lev)) - call stop_on_err(rte_lw(atmos, top_at_1, & - lw_sources, & - sfc_emis, & + call stop_on_err(rte_lw(atmos, & + lw_sources, & + sfc_emis, & fluxes)) call write_broadband_field(input_file, flux_up, "lw_flux_up_1rescl", "LW flux up, clear-sky _1rescl") call write_broadband_field(input_file, flux_dn, "lw_flux_dn_1rescl", "LW flux dn, clear-sky _1rescl") - call stop_on_err(rte_lw(atmos, top_at_1, & - lw_sources, & - sfc_emis, & + call stop_on_err(rte_lw(atmos, & + lw_sources, & + sfc_emis, & fluxes, use_2stream=.true.)) call write_broadband_field(input_file, flux_up, "lw_flux_up_2str", "LW flux up, clear-sky _2str") call write_broadband_field(input_file, flux_dn, "lw_flux_dn_2str", "LW flux dn, clear-sky _2str") @@ -419,9 +418,9 @@ subroutine lw_clear_sky_alt atmos, & lw_sources, & tlev = t_lev)) - call stop_on_err(rte_lw(atmos, top_at_1, & - lw_sources, & - sfc_emis, & + call stop_on_err(rte_lw(atmos, & + lw_sources, & + sfc_emis, & fluxes)) call write_broadband_field(input_file, flux_up, "lw_flux_up_alt", "LW flux up, fewer g-points") call write_broadband_field(input_file, flux_dn, "lw_flux_dn_alt", "LW flux dn, fewer g-points") @@ -432,9 +431,9 @@ subroutine lw_clear_sky_alt vert_dim_name = "layer") call stop_on_err(gas_optics%compute_optimal_angles(atmos, lw_Ds)) - call stop_on_err(rte_lw(atmos, top_at_1, & - lw_sources, & - sfc_emis, & + call stop_on_err(rte_lw(atmos, & + lw_sources, & + sfc_emis, & fluxes, lw_Ds=lw_Ds)) call write_broadband_field(input_file, flux_up, "lw_flux_up_alt_oa", "LW flux up, fewer g-points, opt. angle") call write_broadband_field(input_file, flux_dn, "lw_flux_dn_alt_oa", "LW flux dn, fewer g-points, opt. angle") @@ -470,8 +469,7 @@ subroutine sw_clear_sky_default rfmip_tsi_scale(:,:) = spread(tsi_3d(:,1)/rrtmgp_tsi, dim=2, ncopies=ngpt) toa_flux(:,:) = toa_flux(:,:) * rfmip_tsi_scale(:,:) - call stop_on_err(rte_sw(atmos, top_at_1, & - mu0, toa_flux, & + call stop_on_err(rte_sw(atmos, mu0, toa_flux, & sfc_alb_dir, sfc_alb_dif, & fluxes)) ! @@ -501,8 +499,7 @@ subroutine sw_clear_sky_alt rfmip_tsi_scale(:,:) = spread(tsi_3d(:,1)/rrtmgp_tsi, dim=2, ncopies=gas_optics%get_ngpt()) toa_flux(:,:) = toa_flux(:,:) * rfmip_tsi_scale(:,:) - call stop_on_err(rte_sw(atmos, top_at_1, & - mu0, toa_flux, & + call stop_on_err(rte_sw(atmos, mu0, toa_flux, & sfc_alb_dir, sfc_alb_dif, & fluxes)) ! diff --git a/tests/mo_testing_utils.F90 b/tests/mo_testing_utils.F90 index 07adffa39..95dce46c0 100644 --- a/tests/mo_testing_utils.F90 +++ b/tests/mo_testing_utils.F90 @@ -256,6 +256,7 @@ subroutine vr(atmos, sources) ! ----------------------- nlay = atmos%get_nlay() + call atmos%set_top_at_1(.not. atmos%top_is_at_1()) atmos%tau(:,:,:) = atmos%tau(:,nlay:1:-1,:) select type (atmos) diff --git a/tests/rte_lw_solver_unit_tests.F90 b/tests/rte_lw_solver_unit_tests.F90 index baf08fd3f..ed42440e4 100644 --- a/tests/rte_lw_solver_unit_tests.F90 +++ b/tests/rte_lw_solver_unit_tests.F90 @@ -95,7 +95,7 @@ program rte_lw_solver_unit_tests fluxes%flux_up => ref_flux_up (:,:) fluxes%flux_dn => ref_flux_dn (:,:) fluxes%flux_net => ref_flux_net(:,:) - call stop_on_err(rte_lw(lw_atmos, top_at_1, & + call stop_on_err(rte_lw(lw_atmos, & lw_sources, & sfc_emis, & fluxes)) @@ -116,7 +116,7 @@ program rte_lw_solver_unit_tests ! nullify(fluxes%flux_up) nullify(fluxes%flux_dn) - call stop_on_err(rte_lw(lw_atmos, top_at_1, & + call stop_on_err(rte_lw(lw_atmos, & lw_sources, sfc_emis,& fluxes)) call check_fluxes(ref_flux_net, ref_flux_dn-ref_flux_up, & @@ -126,7 +126,7 @@ program rte_lw_solver_unit_tests ! fluxes%flux_up => tst_flux_up (:,:) fluxes%flux_dn => tst_flux_dn (:,:) - call stop_on_err(rte_lw(lw_atmos, top_at_1, & + call stop_on_err(rte_lw(lw_atmos, & lw_sources, sfc_emis, & fluxes)) call check_fluxes(ref_flux_net, tst_flux_dn-tst_flux_up, & @@ -149,7 +149,7 @@ program rte_lw_solver_unit_tests print *, " Vertical orientation invariance" call gray_rad_equil(sfc_t, total_tau, nlay, top_at_1, lw_atmos, lw_sources) call vr(lw_atmos, lw_sources) - call stop_on_err(rte_lw(lw_atmos, .not. top_at_1, & + call stop_on_err(rte_lw(lw_atmos, & lw_sources, sfc_emis, & fluxes)) ! @@ -168,7 +168,7 @@ program rte_lw_solver_unit_tests ! print *, " Jacobian" call gray_rad_equil(sfc_t, total_tau, nlay, top_at_1, lw_atmos, lw_sources) - call stop_on_err(rte_lw(lw_atmos, top_at_1, & + call stop_on_err(rte_lw(lw_atmos, & lw_sources, & sfc_emis, & fluxes, & @@ -180,7 +180,7 @@ program rte_lw_solver_unit_tests ! lw_sources%sfc_source (:,1) = sigma/pi * (sfc_t + 1._wp)**4 lw_sources%sfc_source_Jac(:,1) = 4._wp * sigma/pi * (sfc_t + 1._wp)**3 - call stop_on_err(rte_lw(lw_atmos, top_at_1, & + call stop_on_err(rte_lw(lw_atmos, & lw_sources, & sfc_emis, & fluxes)) @@ -200,8 +200,10 @@ program rte_lw_solver_unit_tests sw_atmos%tau = lw_atmos%tau sw_atmos%ssa = 0._wp sw_atmos%g = 0._wp + call sw_atmos%set_top_at_1(lw_atmos%top_is_at_1()) - call stop_on_err(rte_lw(sw_atmos, top_at_1, & + + call stop_on_err(rte_lw(sw_atmos, & lw_sources, & sfc_emis, & fluxes, & @@ -214,7 +216,7 @@ program rte_lw_solver_unit_tests ! Specifying diffusivity angle ! print *, " Specified transport angle" - call stop_on_err(rte_lw(lw_atmos, top_at_1, & + call stop_on_err(rte_lw(lw_atmos, & lw_sources, & sfc_emis, & fluxes, & @@ -258,7 +260,7 @@ subroutine gray_rad_equil(sfc_t, total_tau, nlay, top_at_1, atmos, sources) ! Divide optical depth evenly among layers ! atmos%tau(1:ncol,1:nlay,1) = spread(total_tau(1:ncol)/real(nlay, wp), dim=2, ncopies=nlay) - + call atmos%set_top_at_1(top_at_1) ! ! Longwave sources - for broadband these are sigma/pi T^4 ! (isotropic radiation) @@ -271,17 +273,17 @@ subroutine gray_rad_equil(sfc_t, total_tau, nlay, top_at_1, atmos, sources) ! ! Calculation with top_at_1 ! - ilay = 1 - sources%lev_source(:,ilay, 1) = 0.5_wp/pi * olr(:) - do ilay = 2, nlay+1 - sources%lev_source(:,ilay, 1) = 0.5_wp/pi * olr(:) * & - (1._wp + D * sum(atmos%tau(:,:ilay-1,1),dim=2)) - ! - ! The source is linear in optical depth so layer source is average of edges - ! - sources%lay_source(:,ilay-1,1) = 0.5_wp * (sources%lev_source(:,ilay, 1) + & - sources%lev_source(:,ilay-1,1)) - end do + ilay = 1 + sources%lev_source(:,ilay, 1) = 0.5_wp/pi * olr(:) + do ilay = 2, nlay+1 + sources%lev_source(:,ilay, 1) = 0.5_wp/pi * olr(:) * & + (1._wp + D * sum(atmos%tau(:,:ilay-1,1),dim=2)) + ! + ! The source is linear in optical depth so layer source is average of edges + ! + sources%lay_source(:,ilay-1,1) = 0.5_wp * (sources%lev_source(:,ilay, 1) + & + sources%lev_source(:,ilay-1,1)) + end do if (.not. top_at_1) then ! ! Reverse vertical ordering of source functions @@ -372,8 +374,8 @@ subroutine clear_sky_subset(atmos, sources, sfc_emis, flux_up, flux_dn) colE = i * ncol/2 call stop_on_err(atmos%get_subset (colS, ncol/2, atmos_subset)) call stop_on_err(sources%get_subset(colS, ncol/2, sources_subset)) - call stop_on_err(rte_lw(atmos_subset, top_at_1, & - sources_subset, & + call stop_on_err(rte_lw(atmos_subset, & + sources_subset, & sfc_emis(:,colS:colE), & fluxes)) flux_up(colS:colE,:) = up diff --git a/tests/rte_sw_solver_unit_tests.F90 b/tests/rte_sw_solver_unit_tests.F90 index 196fd1f4a..610e20d3a 100644 --- a/tests/rte_sw_solver_unit_tests.F90 +++ b/tests/rte_sw_solver_unit_tests.F90 @@ -69,7 +69,7 @@ program rte_sw_solver_unit_tests type(ty_optical_props_2str) :: atmos type(ty_fluxes_broadband) :: fluxes - logical :: top_at_1 + logical, parameter :: top_at_1 = .true. real(wp), dimension(ncol,nlay+1), target :: & ref_flux_up, ref_flux_dn, ref_flux_dir, ref_flux_net, & tst_flux_up, tst_flux_dn, tst_flux_dir, tst_flux_net @@ -81,8 +81,6 @@ program rte_sw_solver_unit_tests logical :: passed - ! ------------------------------------------------------------------------------------------------------ - top_at_1 = .true. ! ------------------------------------------------------------------------------------ ! ! Shortwave tests - thin atmospheres @@ -95,6 +93,7 @@ program rte_sw_solver_unit_tests band_lims_gpt = reshape([1, 1 ], shape = [2, 1]), & name = "Gray atmosphere")) call stop_on_err(atmos%alloc_2str(ncol, nlay)) + call atmos%set_top_at_1(top_at_1) call thin_scattering(tau, ssa, g, nlay, atmos) do imu0 = 1, nmu0 @@ -104,7 +103,7 @@ program rte_sw_solver_unit_tests fluxes%flux_dn => ref_flux_dn (:,:) fluxes%flux_dn_dir => ref_flux_dir(:,:) fluxes%flux_net => ref_flux_net(:,:) - call stop_on_err(rte_sw(atmos, top_at_1, & + call stop_on_err(rte_sw(atmos, & mu0_arr, & toa_flux, & sfc_albedo, sfc_albedo, & @@ -120,7 +119,7 @@ program rte_sw_solver_unit_tests ! ! Check direct beam for correctness with Beer-Lambert-Bouguier ! - if(top_at_1) then + if(atmos%top_is_at_1()) then sfc => ref_flux_dir(:,nlay+1) else sfc => ref_flux_dir(:, 1) @@ -143,7 +142,7 @@ program rte_sw_solver_unit_tests ! nullify(fluxes%flux_up) nullify(fluxes%flux_dn) - call stop_on_err(rte_sw(atmos, top_at_1, & + call stop_on_err(rte_sw(atmos, & mu0_arr, & toa_flux, & sfc_albedo, sfc_albedo, & @@ -155,7 +154,7 @@ program rte_sw_solver_unit_tests ! fluxes%flux_up => tst_flux_up (:,:) fluxes%flux_dn => tst_flux_dn (:,:) - call stop_on_err(rte_sw(atmos, top_at_1, & + call stop_on_err(rte_sw(atmos, & mu0_arr, & toa_flux, & sfc_albedo, sfc_albedo, & @@ -178,7 +177,7 @@ program rte_sw_solver_unit_tests print *, " Vertical orientation invariance" call thin_scattering(tau, ssa, g, nlay, atmos) call vr(atmos) - call stop_on_err(rte_sw(atmos, .not. top_at_1, & + call stop_on_err(rte_sw(atmos, & mu0_arr, & toa_flux, & sfc_albedo, sfc_albedo, & @@ -201,7 +200,7 @@ program rte_sw_solver_unit_tests ! print *, " Linear in TOA flux" call thin_scattering(tau, ssa, g, nlay, atmos) - call stop_on_err(rte_sw(atmos, top_at_1, & + call stop_on_err(rte_sw(atmos, & mu0_arr, & toa_flux * factor, & sfc_albedo, sfc_albedo, & @@ -332,7 +331,7 @@ subroutine clear_sky_subset(atmos, mu0, toa_flux, sfc_albedo, flux_up, flux_dn) colS = ((i-1) * ncol/2) + 1 colE = i * ncol/2 call stop_on_err(atmos%get_subset(colS, ncol/2, atmos_subset)) - call stop_on_err(rte_sw(atmos_subset, top_at_1, & + call stop_on_err(rte_sw(atmos_subset, & mu0(colS:colE), & toa_flux(colS:colE,:), & sfc_albedo(:,colS:colE), sfc_albedo(:,colS:colE), & diff --git a/tests/test_zenith_angle_spherical_correction.F90 b/tests/test_zenith_angle_spherical_correction.F90 index 26ad615e0..917349441 100644 --- a/tests/test_zenith_angle_spherical_correction.F90 +++ b/tests/test_zenith_angle_spherical_correction.F90 @@ -38,7 +38,6 @@ program test_solar_zenith_angle p_lev(ncol, nlay+1) real(wp), dimension(ncol, nlay+1), target & :: flux_up, flux_dn, flux_dir - logical :: top_at_1 character(len=128) :: k_dist_file = "rrtmgp-gas-sw-g112.nc" real(wp), dimension(:,:), allocatable & :: toa_flux, sfc_alb_dir, sfc_alb_dif @@ -95,9 +94,7 @@ program test_solar_zenith_angle ! Set small solar zenith angles, varying by column; compute fluxes and heating rates ! call stop_on_err(zenith_angle_with_height(z_lay(:,1), 3 * [0.01_wp, 0.02_wp, 0.03_wp, 0.04_wp], z_lay, mu0)) - top_at_1 = p_lay(1, 1) < p_lay(1,nlay) - call stop_on_err(rte_sw(atmos, top_at_1, & - mu0, toa_flux, & + call stop_on_err(rte_sw(atmos, mu0, toa_flux, & sfc_alb_dir, sfc_alb_dif, & fluxes)) call stop_on_err(compute_heating_rate(flux_up, flux_dn, flux_dir, p_lev, mu0, heating_rate)) From 417b8e0cfa8b75a89906d28115a4ccf37df84119 Mon Sep 17 00:00:00 2001 From: Sergey Kosukhin Date: Fri, 31 May 2024 16:13:30 +0200 Subject: [PATCH 37/57] Set default variables in the makefiles (#290) Set default RRTMGP_ROOT, RRTMGP_DATA, FAILURE_THRESHOLD in the makefiles; override with environment variables. --- examples/all-sky/Makefile | 8 +++++++- examples/rfmip-clear-sky/Makefile | 11 ++++++++++- tests/Makefile | 8 +++++++- 3 files changed, 24 insertions(+), 3 deletions(-) diff --git a/examples/all-sky/Makefile b/examples/all-sky/Makefile index d404181c1..225946e31 100644 --- a/examples/all-sky/Makefile +++ b/examples/all-sky/Makefile @@ -2,6 +2,7 @@ # # Location of RTE+RRTMGP libraries, module files. # +RRTMGP_ROOT ?= ../.. RRTMGP_BUILD = $(RRTMGP_ROOT)/build # # RRTMGP library, module files @@ -15,7 +16,7 @@ FCINCLUDE += -I$(RRTMGP_BUILD) # netcdf C and Fortran libraries have to be in the search path or added via environment variable LDFLAGS e.g. #LDFLAGS += -L$(NFHOME)/lib -L$(NCHOME)/lib -LIBS += -lnetcdff -lnetcdf +LIBS += -lnetcdff VPATH = ../:$(RRTMGP_ROOT)/rrtmgp-frontend # Needed for cloud_optics and aerosol_optics @@ -47,6 +48,11 @@ mo_load_coefficients.o: mo_simple_netcdf.o mo_load_cloud_coefficients.o: mo_simple_netcdf.o mo_cloud_optics_rrtmgp.o mo_load_cloud_coefficients.F90 mo_load_aerosol_coefficients.o: mo_simple_netcdf.o mo_aerosol_optics_rrtmgp_merra.o mo_load_aerosol_coefficients.F90 +# The default location of the input data: +RRTMGP_DATA ?= $(RRTMGP_ROOT)/rrtmgp-data +# Make it available to the scripts: +export RRTMGP_DATA + tests: rrtmgp_allsky $(RUN_CMD) bash all_tests.sh diff --git a/examples/rfmip-clear-sky/Makefile b/examples/rfmip-clear-sky/Makefile index bad1bc80f..9d60aab9a 100644 --- a/examples/rfmip-clear-sky/Makefile +++ b/examples/rfmip-clear-sky/Makefile @@ -2,6 +2,7 @@ # # Location of RTE+RRTMGP libraries, module files. # +RRTMGP_ROOT ?= ../.. RRTMGP_BUILD = $(RRTMGP_ROOT)/build # # RRTMGP library, module files @@ -15,7 +16,7 @@ FCINCLUDE += -I$(RRTMGP_BUILD) # netcdf C and Fortran libraries have to be in the search path or added via environment variable LDFLAGS e.g. #LDFLAGS += -L$(NFHOME)/lib -L$(NCHOME)/lib -LIBS += -lnetcdff -lnetcdf +LIBS += -lnetcdff VPATH = ../ @@ -50,6 +51,9 @@ mo_rfmip_io.o: mo_rfmip_io.F90 mo_simple_netcdf.o mo_load_coefficients.o: mo_load_coefficients.F90 mo_simple_netcdf.o +# The default location of the input data: +RRTMGP_DATA ?= $(RRTMGP_ROOT)/rrtmgp-data + tests: rrtmgp_rfmip_lw rrtmgp_rfmip_sw \ multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc \ rld_Efx_RTE-RRTMGP-181204_rad-irf_r1i1p1f1_gn.nc rlu_Efx_RTE-RRTMGP-181204_rad-irf_r1i1p1f1_gn.nc \ @@ -57,6 +61,11 @@ tests: rrtmgp_rfmip_lw rrtmgp_rfmip_sw \ $(RUN_CMD) ./rrtmgp_rfmip_lw 8 multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc ${RRTMGP_DATA}/rrtmgp-gas-lw-g256.nc $(RUN_CMD) ./rrtmgp_rfmip_sw 8 multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc ${RRTMGP_DATA}/rrtmgp-gas-sw-g224.nc +# The default failure threshold: +FAILURE_THRESHOLD ?= 7.e-4 +# Make it available to the scripts: +export FAILURE_THRESHOLD + check: $${PYTHON-python} ${RRTMGP_ROOT}/examples/compare-to-reference.py \ --ref_dir ${RRTMGP_DATA}/examples/rfmip-clear-sky/reference --tst_dir ${RRTMGP_ROOT}/examples/rfmip-clear-sky \ diff --git a/tests/Makefile b/tests/Makefile index a5060c623..de61c4a22 100644 --- a/tests/Makefile +++ b/tests/Makefile @@ -2,6 +2,7 @@ # # Location of RTE+RRTMGP libraries, module files. # +RRTMGP_ROOT ?= .. RRTMGP_BUILD = $(RRTMGP_ROOT)/build # # RRTMGP library, module files @@ -15,7 +16,7 @@ FCINCLUDE += -I$(RRTMGP_BUILD) # netcdf C and Fortran libraries have to be in the search path or added via environment variable LDFLAGS e.g. #LDFLAGS += -L$(NFHOME)/lib -L$(NCHOME)/lib -LIBS += -lnetcdff -lnetcdf +LIBS += -lnetcdff VPATH = $(RRTMGP_ROOT)/examples:$(RRTMGP_ROOT)/examples/rfmip-clear-sky:$(RRTMGP_ROOT)/examples/all-sky VPATH += $(RRTMGP_ROOT)/rrtmgp-frontend:$(RRTMGP_ROOT)/extensions:$(RRTMGP_ROOT)/:$(RRTMGP_ROOT)/extensions/solar_variability @@ -78,6 +79,11 @@ rte_sw_solver_unit_tests.o: $(LIB_DEPS) mo_testing_utils.o rte_sw_solver_unit_te rte_sw_solver_unit_tests : $(LIB_DEPS) mo_testing_utils.o rte_sw_solver_unit_tests.o +# The default location of the input data: +RRTMGP_DATA ?= $(RRTMGP_ROOT)/rrtmgp-data +# Make it available to the scripts: +export RRTMGP_DATA + .PHONY: tests tests: check_variants check_equivalence test_zenith_angle_spherical_correction rte_sw_solver_unit_tests rte_optic_prop_unit_tests rte_lw_solver_unit_tests cp ${RRTMGP_DATA}/examples/rfmip-clear-sky/inputs/multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc ./test_atmospheres.nc From 9660d18696882c825e957093ac0d7c1a3d7cbe3f Mon Sep 17 00:00:00 2001 From: "dependabot[bot]" <49699333+dependabot[bot]@users.noreply.github.com> Date: Sat, 6 Jul 2024 11:19:02 -0400 Subject: [PATCH 38/57] Bump JamesIves/github-pages-deploy-action from 4.6.1 to 4.6.3 (#292) Bumps [JamesIves/github-pages-deploy-action](https://github.com/jamesives/github-pages-deploy-action) from 4.6.1 to 4.6.3. - [Release notes](https://github.com/jamesives/github-pages-deploy-action/releases) - [Commits](https://github.com/jamesives/github-pages-deploy-action/compare/v4.6.1...v4.6.3) --- updated-dependencies: - dependency-name: JamesIves/github-pages-deploy-action dependency-type: direct:production update-type: version-update:semver-patch ... Signed-off-by: dependabot[bot] Co-authored-by: dependabot[bot] <49699333+dependabot[bot]@users.noreply.github.com> --- .github/workflows/doc-deployment.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/doc-deployment.yml b/.github/workflows/doc-deployment.yml index 4bc492e9b..8f434ce97 100644 --- a/.github/workflows/doc-deployment.yml +++ b/.github/workflows/doc-deployment.yml @@ -70,7 +70,7 @@ jobs: # Deploy documentation # - name: Deploy API Documentation - uses: JamesIves/github-pages-deploy-action@v4.6.1 + uses: JamesIves/github-pages-deploy-action@v4.6.3 if: ${{ github.event_name == 'push' && github.ref == 'refs/heads/documentation' }} with: branch: gh-pages From 6685a94d228614239d492ded219ab2f081923f02 Mon Sep 17 00:00:00 2001 From: Sergey Kosukhin Date: Thu, 15 Aug 2024 14:49:41 +0200 Subject: [PATCH 39/57] Fixes for CI (#294) * Lumi CI: push as a branch, do not fail the clean-up if the pipeline is missing * GitLab CI: do not duplicate reference types * Self-hosted CI: a workaround for the old runtime on Daint --- .github/workflows/gitlab-ci.yml | 10 ++++++---- .github/workflows/self-hosted-ci.yml | 4 ++++ 2 files changed, 10 insertions(+), 4 deletions(-) diff --git a/.github/workflows/gitlab-ci.yml b/.github/workflows/gitlab-ci.yml index 2a46e8557..f079e1333 100644 --- a/.github/workflows/gitlab-ci.yml +++ b/.github/workflows/gitlab-ci.yml @@ -25,6 +25,7 @@ jobs: github.event.pull_request.user.login != 'dependabot[bot]' )) runs-on: ubuntu-latest outputs: + ref-type: ${{ steps.g-push-rev.outputs.ref-type }} ref-name: ${{ steps.g-push-rev.outputs.ref-name }} pipeline-id: ${{ steps.gl-trigger-pipeline.outputs.pipeline-id }} steps: @@ -94,7 +95,7 @@ jobs: with: remote-url: ${{ vars.DKRZ_GITLAB_SERVER }}/${{ vars.DKRZ_GITLAB_PROJECT }}.git password: ${{ secrets.DKRZ_GITLAB_TOKEN }} - ref-type: tag + ref-type: ${{ needs.levante-init.outputs.ref-type }} ref-name: ${{ needs.levante-init.outputs.ref-name }} force: true # @@ -108,6 +109,7 @@ jobs: github.event.pull_request.user.login != 'dependabot[bot]' )) runs-on: ubuntu-latest outputs: + ref-type: ${{ steps.g-push-rev.outputs.ref-type }} ref-name: ${{ steps.g-push-rev.outputs.ref-name }} pipeline-id: ${{ steps.gl-create-pipeline.outputs.pipeline-id }} steps: @@ -130,8 +132,7 @@ jobs: rev-id: ${{ github.sha }} rev-signing-format: ssh rev-signing-key: ${{ secrets.GITLAB_SIGNING_KEY }} - ref-type: tag - ref-message: ${{ github.server_url }}/${{ github.repository }}/actions/runs/${{ github.run_id }} + ref-type: branch force-push: true # # Create GitLab CI/CD Pipeline @@ -189,11 +190,12 @@ jobs: project-name: ${{ vars.GITLAB_PROJECT }} token: ${{ secrets.GITLAB_TOKEN }} pipeline-id: ${{ needs.lumi-init.outputs.pipeline-id }} + force: true - uses: "skosukhin/git-ci-hub-lab/gl-delete-ref@v1" with: server-url: ${{ vars.GITLAB_SERVER }} project-name: ${{ vars.GITLAB_PROJECT }} token: ${{ secrets.GITLAB_TOKEN }} - ref-type: tag + ref-type: ${{ needs.lumi-init.outputs.ref-type }} ref-name: ${{ needs.lumi-init.outputs.ref-name }} force: true diff --git a/.github/workflows/self-hosted-ci.yml b/.github/workflows/self-hosted-ci.yml index 7077eda6f..8f1953115 100644 --- a/.github/workflows/self-hosted-ci.yml +++ b/.github/workflows/self-hosted-ci.yml @@ -13,6 +13,10 @@ defaults: run: shell: bash +# A workaround for the old runtime: +env: + ACTIONS_ALLOW_USE_UNSECURE_NODE_VERSION: true + jobs: CI: if: github.repository == 'earth-system-radiation/rte-rrtmgp' From 466afa89fb3bfa578a22a8cd7f32fdba588e8979 Mon Sep 17 00:00:00 2001 From: "dependabot[bot]" <49699333+dependabot[bot]@users.noreply.github.com> Date: Mon, 2 Sep 2024 20:55:47 +0000 Subject: [PATCH 40/57] Bump JamesIves/github-pages-deploy-action from 4.6.3 to 4.6.4 Bumps [JamesIves/github-pages-deploy-action](https://github.com/jamesives/github-pages-deploy-action) from 4.6.3 to 4.6.4. - [Release notes](https://github.com/jamesives/github-pages-deploy-action/releases) - [Commits](https://github.com/jamesives/github-pages-deploy-action/compare/v4.6.3...v4.6.4) --- updated-dependencies: - dependency-name: JamesIves/github-pages-deploy-action dependency-type: direct:production update-type: version-update:semver-patch ... Signed-off-by: dependabot[bot] --- .github/workflows/doc-deployment.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/doc-deployment.yml b/.github/workflows/doc-deployment.yml index 8f434ce97..93bd2205a 100644 --- a/.github/workflows/doc-deployment.yml +++ b/.github/workflows/doc-deployment.yml @@ -70,7 +70,7 @@ jobs: # Deploy documentation # - name: Deploy API Documentation - uses: JamesIves/github-pages-deploy-action@v4.6.3 + uses: JamesIves/github-pages-deploy-action@v4.6.4 if: ${{ github.event_name == 'push' && github.ref == 'refs/heads/documentation' }} with: branch: gh-pages From 390fb52b04fc54e378d140d16384154316ae0d0f Mon Sep 17 00:00:00 2001 From: "dependabot[bot]" <49699333+dependabot[bot]@users.noreply.github.com> Date: Fri, 27 Sep 2024 20:30:15 +0000 Subject: [PATCH 41/57] Bump JamesIves/github-pages-deploy-action from 4.6.4 to 4.6.6 Bumps [JamesIves/github-pages-deploy-action](https://github.com/jamesives/github-pages-deploy-action) from 4.6.4 to 4.6.6. - [Release notes](https://github.com/jamesives/github-pages-deploy-action/releases) - [Commits](https://github.com/jamesives/github-pages-deploy-action/compare/v4.6.4...v4.6.6) --- updated-dependencies: - dependency-name: JamesIves/github-pages-deploy-action dependency-type: direct:production update-type: version-update:semver-patch ... Signed-off-by: dependabot[bot] --- .github/workflows/doc-deployment.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/doc-deployment.yml b/.github/workflows/doc-deployment.yml index 93bd2205a..c836ad917 100644 --- a/.github/workflows/doc-deployment.yml +++ b/.github/workflows/doc-deployment.yml @@ -70,7 +70,7 @@ jobs: # Deploy documentation # - name: Deploy API Documentation - uses: JamesIves/github-pages-deploy-action@v4.6.4 + uses: JamesIves/github-pages-deploy-action@v4.6.6 if: ${{ github.event_name == 'push' && github.ref == 'refs/heads/documentation' }} with: branch: gh-pages From e891f926b01bad734c03b0e9aa309cbdc0ae1f97 Mon Sep 17 00:00:00 2001 From: "dependabot[bot]" <49699333+dependabot[bot]@users.noreply.github.com> Date: Mon, 30 Sep 2024 20:40:17 +0000 Subject: [PATCH 42/57] Bump JamesIves/github-pages-deploy-action from 4.6.6 to 4.6.8 Bumps [JamesIves/github-pages-deploy-action](https://github.com/jamesives/github-pages-deploy-action) from 4.6.6 to 4.6.8. - [Release notes](https://github.com/jamesives/github-pages-deploy-action/releases) - [Commits](https://github.com/jamesives/github-pages-deploy-action/compare/v4.6.6...v4.6.8) --- updated-dependencies: - dependency-name: JamesIves/github-pages-deploy-action dependency-type: direct:production update-type: version-update:semver-patch ... Signed-off-by: dependabot[bot] --- .github/workflows/doc-deployment.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/doc-deployment.yml b/.github/workflows/doc-deployment.yml index c836ad917..34da5232c 100644 --- a/.github/workflows/doc-deployment.yml +++ b/.github/workflows/doc-deployment.yml @@ -70,7 +70,7 @@ jobs: # Deploy documentation # - name: Deploy API Documentation - uses: JamesIves/github-pages-deploy-action@v4.6.6 + uses: JamesIves/github-pages-deploy-action@v4.6.8 if: ${{ github.event_name == 'push' && github.ref == 'refs/heads/documentation' }} with: branch: gh-pages From a7cdefbd05d339a80f263cdf766538c2dabe587d Mon Sep 17 00:00:00 2001 From: Robert Pincus Date: Mon, 21 Oct 2024 09:38:56 -0400 Subject: [PATCH 43/57] Update CI to use current data release --- .github/workflows/containerized-ci.yml | 2 +- .github/workflows/continuous-integration.yml | 2 +- .github/workflows/self-hosted-ci.yml | 2 +- .gitlab/common.yml | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/.github/workflows/containerized-ci.yml b/.github/workflows/containerized-ci.yml index 3a931c60b..de94e8417 100644 --- a/.github/workflows/containerized-ci.yml +++ b/.github/workflows/containerized-ci.yml @@ -72,7 +72,7 @@ jobs: with: repository: earth-system-radiation/rrtmgp-data path: rrtmgp-data - ref: v1.8.1 + ref: v1.8.2 # # Build libraries, examples and tests (expect success) # diff --git a/.github/workflows/continuous-integration.yml b/.github/workflows/continuous-integration.yml index d8a52f32d..57bd196e8 100644 --- a/.github/workflows/continuous-integration.yml +++ b/.github/workflows/continuous-integration.yml @@ -52,7 +52,7 @@ jobs: with: repository: earth-system-radiation/rrtmgp-data path: rrtmgp-data - ref: v1.8.1 + ref: v1.8.2 # # Synchronize the package index # diff --git a/.github/workflows/self-hosted-ci.yml b/.github/workflows/self-hosted-ci.yml index 8f1953115..5257e0880 100644 --- a/.github/workflows/self-hosted-ci.yml +++ b/.github/workflows/self-hosted-ci.yml @@ -66,7 +66,7 @@ jobs: with: repository: earth-system-radiation/rrtmgp-data path: rrtmgp-data - ref: v1.8.1 + ref: v1.8.2 # # Finalize build environment # diff --git a/.gitlab/common.yml b/.gitlab/common.yml index 83a267840..b8c180085 100644 --- a/.gitlab/common.yml +++ b/.gitlab/common.yml @@ -16,7 +16,7 @@ RRTMGP_DATA: ${CI_PROJECT_DIR}/rrtmgp-data # Convenience variables: RRTMGP_DATA_REPO: https://github.com/earth-system-radiation/rrtmgp-data.git - RRTMGP_DATA_TAG: v1.8.1 + RRTMGP_DATA_TAG: v1.8.2 script: # # Build libraries, examples and tests From 2d697528a4b8aca39cdde99fb9a3d159425c4e07 Mon Sep 17 00:00:00 2001 From: Robert Pincus Date: Thu, 7 Nov 2024 17:53:51 -0500 Subject: [PATCH 44/57] Disable Lumi CI (compilers are broken) --- .github/workflows/gitlab-ci.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/gitlab-ci.yml b/.github/workflows/gitlab-ci.yml index f079e1333..feacb5f7f 100644 --- a/.github/workflows/gitlab-ci.yml +++ b/.github/workflows/gitlab-ci.yml @@ -103,6 +103,7 @@ jobs: # lumi-init: if: | + false && github.repository_owner == 'earth-system-radiation' && ( github.event_name != 'pull_request' || ( github.event.pull_request.head.repo.owner.login == github.repository_owner && From 210e23447c5b8b78d2983794a45ee628fa47ea91 Mon Sep 17 00:00:00 2001 From: Robert Pincus Date: Fri, 8 Nov 2024 20:20:57 -0500 Subject: [PATCH 45/57] Self-hosted CI no longer has access to resources --- .github/workflows/self-hosted-ci.yml | 7 ------- 1 file changed, 7 deletions(-) diff --git a/.github/workflows/self-hosted-ci.yml b/.github/workflows/self-hosted-ci.yml index 5257e0880..d9ad8838a 100644 --- a/.github/workflows/self-hosted-ci.yml +++ b/.github/workflows/self-hosted-ci.yml @@ -1,12 +1,5 @@ name: Self-hosted CI on: - push: - branches: - - main - - develop - pull_request: - branches-ignore: - - documentation workflow_dispatch: defaults: From 06ea8284071b80d393ff8df659a2ef4b4bfb2aa8 Mon Sep 17 00:00:00 2001 From: Robert Pincus Date: Fri, 8 Nov 2024 20:23:51 -0500 Subject: [PATCH 46/57] Separate cloud optics kernels (#302) Separate cloud optics kernels from the Fortran front-end implementation. Update `nvfortran` used in Levante CI to 24.07. --- .gitlab/levante.yml | 5 +- rrtmgp-frontend/Make.depends | 7 + rrtmgp-frontend/mo_cloud_optics_rrtmgp.F90 | 194 +---------------- rrtmgp-kernels/Make.depends | 6 +- .../api/mo_cloud_optics_rrtmgp_kernels.F90 | 58 +++++ rrtmgp-kernels/api/rrtmgp_kernels.h | 52 +++++ .../mo_cloud_optics_rrtmgp_kernels.F90 | 198 ++++++++++++++++++ 7 files changed, 329 insertions(+), 191 deletions(-) create mode 100644 rrtmgp-kernels/api/mo_cloud_optics_rrtmgp_kernels.F90 create mode 100644 rrtmgp-kernels/mo_cloud_optics_rrtmgp_kernels.F90 diff --git a/.gitlab/levante.yml b/.gitlab/levante.yml index be6f253b2..2a0a1a435 100644 --- a/.gitlab/levante.yml +++ b/.gitlab/levante.yml @@ -30,7 +30,8 @@ variables: .nvhpc: variables: # Core variables: - FC: /sw/spack-levante/nvhpc-22.5-v4oky3/Linux_x86_64/22.5/compilers/bin/nvfortran + # FC: /sw/spack-levante/nvhpc-22.5-v4oky3/Linux_x86_64/22.5/compilers/bin/nvfortran + FC: /sw/spack-levante/nvhpc-24.9-p7iohv/Linux_x86_64/24.9/compilers/bin/nvfortran # Convenience variables: VERSION_FCFLAGS: --version NFHOME: /sw/spack-levante/netcdf-fortran-4.5.4-syv4qr @@ -70,7 +71,7 @@ variables: - .common-levante variables: # Compiler flags used for ICON model: - FCFLAGS: -g -O2 -Mrecursive -Mallocatable=03 -Mstack_arrays -Minfo=accel,inline -acc=gpu,verystrict -gpu=cc80,cuda11.7 -DRTE_USE_${FPMODEL} + FCFLAGS: -g -O2 -Mrecursive -Mallocatable=03 -Mstack_arrays -Minfo=accel,inline -acc=gpu,verystrict -gpu=cc80,cuda11.8 -DRTE_USE_${FPMODEL} RTE_KERNELS: accel .nag-cpu: diff --git a/rrtmgp-frontend/Make.depends b/rrtmgp-frontend/Make.depends index 1a06c30f5..1c70a9a08 100644 --- a/rrtmgp-frontend/Make.depends +++ b/rrtmgp-frontend/Make.depends @@ -38,3 +38,10 @@ mo_gas_optics_rrtmgp.o: \ mo_gas_concentrations.o \ mo_gas_optics.o \ mo_gas_optics_rrtmgp_kernels.o mo_gas_optics_rrtmgp.F90 + +# +# RRTMGP cloud optics +# +mo_cloud_optics_rrtmgp.o: \ + $(RTE_FORTRAN_INTERFACE) \ + mo_cloud_optics_rrtmgp_kernels.o mo_cloud_optics_rrtmgp.F90 diff --git a/rrtmgp-frontend/mo_cloud_optics_rrtmgp.F90 b/rrtmgp-frontend/mo_cloud_optics_rrtmgp.F90 index 582fe36e0..07102b534 100644 --- a/rrtmgp-frontend/mo_cloud_optics_rrtmgp.F90 +++ b/rrtmgp-frontend/mo_cloud_optics_rrtmgp.F90 @@ -28,10 +28,9 @@ module mo_cloud_optics_rrtmgp ty_optical_props_1scl, & ty_optical_props_2str, & ty_optical_props_nstr + use mo_cloud_optics_rrtmgp_kernels, only: & + compute_cld_from_table, compute_cld_from_pade implicit none - interface pade_eval - module procedure pade_eval_nbnd, pade_eval_1 - end interface pade_eval private ! ----------------------------------------------------------------------------------- type, extends(ty_optical_props), public :: ty_cloud_optics_rrtmgp @@ -486,14 +485,14 @@ function cloud_optics(this, & ! ! Liquid ! - call compute_all_from_table(ncol, nlay, nbnd, liqmsk, clwp, reliq, & + call compute_cld_from_table(ncol, nlay, nbnd, liqmsk, clwp, reliq, & this%liq_nsteps,this%liq_step_size,this%radliq_lwr, & this%lut_extliq, this%lut_ssaliq, this%lut_asyliq, & ltau, ltaussa, ltaussag) ! ! Ice ! - call compute_all_from_table(ncol, nlay, nbnd, icemsk, ciwp, reice, & + call compute_cld_from_table(ncol, nlay, nbnd, icemsk, ciwp, reice, & this%ice_nsteps,this%ice_step_size,this%radice_lwr, & this%lut_extice(:,:,this%icergh), & this%lut_ssaice(:,:,this%icergh), & @@ -505,13 +504,13 @@ function cloud_optics(this, & ! Hard coded assumptions: order of approximants, three size regimes ! nsizereg = size(this%pade_extliq,2) - call compute_all_from_pade(ncol, nlay, nbnd, nsizereg, & + call compute_cld_from_pade(ncol, nlay, nbnd, nsizereg, & liqmsk, clwp, reliq, & 2, 3, this%pade_sizreg_extliq, this%pade_extliq, & 2, 2, this%pade_sizreg_ssaliq, this%pade_ssaliq, & 2, 2, this%pade_sizreg_asyliq, this%pade_asyliq, & ltau, ltaussa, ltaussag) - call compute_all_from_pade(ncol, nlay, nbnd, nsizereg, & + call compute_cld_from_pade(ncol, nlay, nbnd, nsizereg, & icemsk, ciwp, reice, & 2, 3, this%pade_sizreg_extice, this%pade_extice(:,:,:,this%icergh), & 2, 2, this%pade_sizreg_ssaice, this%pade_ssaice(:,:,:,this%icergh), & @@ -619,185 +618,4 @@ function get_max_radius_ice(this) result(r) r = this%radice_upr end function get_max_radius_ice - !-------------------------------------------------------------------------------------------------------------------- - ! - ! Ancillary functions - ! - !-------------------------------------------------------------------------------------------------------------------- - ! - ! Linearly interpolate values from a lookup table with "nsteps" evenly-spaced - ! elements starting at "offset." The table's second dimension is band. - ! Returns 0 where the mask is false. - ! We could also try gather/scatter for efficiency - ! - subroutine compute_all_from_table(ncol, nlay, nbnd, mask, lwp, re, & - nsteps, step_size, offset, & - tau_table, ssa_table, asy_table, & - tau, taussa, taussag) - integer, intent(in) :: ncol, nlay, nbnd, nsteps - logical(wl), dimension(ncol,nlay), intent(in) :: mask - real(wp), dimension(ncol,nlay), intent(in) :: lwp, re - real(wp), intent(in) :: step_size, offset - real(wp), dimension(nsteps, nbnd), intent(in) :: tau_table, ssa_table, asy_table - real(wp), dimension(ncol,nlay,nbnd) :: tau, taussa, taussag - ! --------------------------- - integer :: icol, ilay, ibnd - integer :: index - real(wp) :: fint - real(wp) :: t, ts ! tau, tau*ssa, tau*ssa*g - ! --------------------------- - !$acc parallel loop gang vector default(present) collapse(3) - !$omp target teams distribute parallel do simd collapse(3) - do ibnd = 1, nbnd - do ilay = 1,nlay - do icol = 1, ncol - if(mask(icol,ilay)) then - index = min(floor((re(icol,ilay) - offset)/step_size)+1, nsteps-1) - fint = (re(icol,ilay) - offset)/step_size - (index-1) - t = lwp(icol,ilay) * & - (tau_table(index, ibnd) + fint * (tau_table(index+1,ibnd) - tau_table(index,ibnd))) - ts = t * & - (ssa_table(index, ibnd) + fint * (ssa_table(index+1,ibnd) - ssa_table(index,ibnd))) - taussag(icol,ilay,ibnd) = & - ts * & - (asy_table(index, ibnd) + fint * (asy_table(index+1,ibnd) - asy_table(index,ibnd))) - taussa (icol,ilay,ibnd) = ts - tau (icol,ilay,ibnd) = t - else - tau (icol,ilay,ibnd) = 0._wp - taussa (icol,ilay,ibnd) = 0._wp - taussag(icol,ilay,ibnd) = 0._wp - end if - end do - end do - end do - end subroutine compute_all_from_table - ! - ! Pade functions - ! - !--------------------------------------------------------------------------- - subroutine compute_all_from_pade(ncol, nlay, nbnd, nsizes, & - mask, lwp, re, & - m_ext, n_ext, re_bounds_ext, coeffs_ext, & - m_ssa, n_ssa, re_bounds_ssa, coeffs_ssa, & - m_asy, n_asy, re_bounds_asy, coeffs_asy, & - tau, taussa, taussag) - integer, intent(in) :: ncol, nlay, nbnd, nsizes - logical(wl), & - dimension(ncol,nlay), intent(in) :: mask - real(wp), dimension(ncol,nlay), intent(in) :: lwp, re - real(wp), dimension(nsizes+1), intent(in) :: re_bounds_ext, re_bounds_ssa, re_bounds_asy - integer, intent(in) :: m_ext, n_ext - real(wp), dimension(nbnd,nsizes,0:m_ext+n_ext), & - intent(in) :: coeffs_ext - integer, intent(in) :: m_ssa, n_ssa - real(wp), dimension(nbnd,nsizes,0:m_ssa+n_ssa), & - intent(in) :: coeffs_ssa - integer, intent(in) :: m_asy, n_asy - real(wp), dimension(nbnd,nsizes,0:m_asy+n_asy), & - intent(in) :: coeffs_asy - real(wp), dimension(ncol,nlay,nbnd) :: tau, taussa, taussag - ! --------------------------- - integer :: icol, ilay, ibnd, irad - real(wp) :: t, ts - - !$acc parallel loop gang vector default(present) collapse(3) - !$omp target teams distribute parallel do simd collapse(3) - do ibnd = 1, nbnd - do ilay = 1, nlay - do icol = 1, ncol - if(mask(icol,ilay)) then - ! - ! Finds index into size regime table - ! This works only if there are precisely three size regimes (four bounds) and it's - ! previously guaranteed that size_bounds(1) <= size <= size_bounds(4) - ! - irad = min(floor((re(icol,ilay) - re_bounds_ext(2))/re_bounds_ext(3))+2, 3) - t = lwp(icol,ilay) * & - pade_eval(ibnd, nbnd, nsizes, m_ext, n_ext, irad, re(icol,ilay), coeffs_ext) - - irad = min(floor((re(icol,ilay) - re_bounds_ssa(2))/re_bounds_ssa(3))+2, 3) - ! Pade approximants for co-albedo can sometimes be negative - ts = t * (1._wp - max(0._wp, & - pade_eval(ibnd, nbnd, nsizes, m_ssa, n_ssa, irad, re(icol,ilay), coeffs_ssa))) - - irad = min(floor((re(icol,ilay) - re_bounds_asy(2))/re_bounds_asy(3))+2, 3) - taussag(icol,ilay,ibnd) = & - ts * & - pade_eval(ibnd, nbnd, nsizes, m_asy, n_asy, irad, re(icol,ilay), coeffs_asy) - - taussa (icol,ilay,ibnd) = ts - tau (icol,ilay,ibnd) = t - else - tau (icol,ilay,ibnd) = 0._wp - taussa (icol,ilay,ibnd) = 0._wp - taussag(icol,ilay,ibnd) = 0._wp - end if - end do - end do - end do - - end subroutine compute_all_from_pade - !--------------------------------------------------------------------------- - ! - ! Evaluate Pade approximant of order [m/n] - ! - function pade_eval_nbnd(nbnd, nrads, m, n, irad, re, pade_coeffs) - integer, intent(in) :: nbnd, nrads, m, n, irad - real(wp), dimension(nbnd, nrads, 0:m+n), & - intent(in) :: pade_coeffs - real(wp), intent(in) :: re - real(wp), dimension(nbnd) :: pade_eval_nbnd - - integer :: iband - real(wp) :: numer, denom - integer :: i - - do iband = 1, nbnd - denom = pade_coeffs(iband,irad,n+m) - do i = n-1+m, 1+m, -1 - denom = pade_coeffs(iband,irad,i)+re*denom - end do - denom = 1._wp +re*denom - - numer = pade_coeffs(iband,irad,m) - do i = m-1, 1, -1 - numer = pade_coeffs(iband,irad,i)+re*numer - end do - numer = pade_coeffs(iband,irad,0) +re*numer - - pade_eval_nbnd(iband) = numer/denom - end do - end function pade_eval_nbnd - !--------------------------------------------------------------------------- - ! - ! Evaluate Pade approximant of order [m/n] - ! - function pade_eval_1(iband, nbnd, nrads, m, n, irad, re, pade_coeffs) - !$acc routine seq - !$omp declare target - ! - integer, intent(in) :: iband, nbnd, nrads, m, n, irad - real(wp), dimension(nbnd, nrads, 0:m+n), & - intent(in) :: pade_coeffs - real(wp), intent(in) :: re - real(wp) :: pade_eval_1 - - real(wp) :: numer, denom - integer :: i - - denom = pade_coeffs(iband,irad,n+m) - do i = n-1+m, 1+m, -1 - denom = pade_coeffs(iband,irad,i)+re*denom - end do - denom = 1._wp +re*denom - - numer = pade_coeffs(iband,irad,m) - do i = m-1, 1, -1 - numer = pade_coeffs(iband,irad,i)+re*numer - end do - numer = pade_coeffs(iband,irad,0) +re*numer - - pade_eval_1 = numer/denom - end function pade_eval_1 end module mo_cloud_optics_rrtmgp diff --git a/rrtmgp-kernels/Make.depends b/rrtmgp-kernels/Make.depends index c12e33c2c..0953a6247 100644 --- a/rrtmgp-kernels/Make.depends +++ b/rrtmgp-kernels/Make.depends @@ -1,6 +1,10 @@ -RRTMGP_FORTRAN_KERNELS = mo_gas_optics_rrtmgp_kernels.o +RRTMGP_FORTRAN_KERNELS = mo_gas_optics_rrtmgp_kernels.o mo_cloud_optics_rrtmgp_kernels.o # # Gas optics # mo_gas_optics_rrtmgp_kernels.o: $(RTE_FORTRAN_KERNELS) mo_gas_optics_rrtmgp_kernels.F90 +# +# Cloud optics +# +mo_cloud_optics_rrtmgp_kernels.o: $(RTE_FORTRAN_KERNELS) mo_cloud_optics_rrtmgp_kernels.F90 diff --git a/rrtmgp-kernels/api/mo_cloud_optics_rrtmgp_kernels.F90 b/rrtmgp-kernels/api/mo_cloud_optics_rrtmgp_kernels.F90 new file mode 100644 index 000000000..ed6959fa7 --- /dev/null +++ b/rrtmgp-kernels/api/mo_cloud_optics_rrtmgp_kernels.F90 @@ -0,0 +1,58 @@ +module mo_cloud_optics_rrtmgp_kernels + use mo_rte_kind, only : wp, wl + implicit none + private + public :: compute_cld_from_table, compute_cld_from_pade + interface + !--------------------------------------------------------------------------- + ! + ! Linearly interpolate values from a lookup table with "nsteps" evenly-spaced + ! elements starting at "offset." The table's second dimension is band. + ! Returns 0 where the mask is false. + ! We could also try gather/scatter for efficiency + ! + subroutine compute_cld_from_table(ncol, nlay, nbnd, mask, lwp, re, & + nsteps, step_size, offset, & + tau_table, ssa_table, asy_table, & + tau, taussa, taussag) bind(C, name="rrtmgp_compute_cld_from_table") + use mo_rte_kind, only : wp, wl + integer, intent(in) :: ncol, nlay, nbnd, nsteps + logical(wl), dimension(ncol,nlay), intent(in) :: mask + real(wp), dimension(ncol,nlay), intent(in) :: lwp, re + real(wp), intent(in) :: step_size, offset + real(wp), dimension(nsteps, nbnd), intent(in) :: tau_table, ssa_table, asy_table + real(wp), dimension(ncol,nlay,nbnd) :: tau, taussa, taussag + end subroutine compute_cld_from_table + + !--------------------------------------------------------------------------- + ! + ! Pade functions + ! + !--------------------------------------------------------------------------- + subroutine compute_cld_from_pade(ncol, nlay, nbnd, nsizes, & + mask, lwp, re, & + m_ext, n_ext, re_bounds_ext, coeffs_ext, & + m_ssa, n_ssa, re_bounds_ssa, coeffs_ssa, & + m_asy, n_asy, re_bounds_asy, coeffs_asy, & + tau, taussa, taussag) bind(C, name="rrtmgp_compute_cld_from_pade") + use mo_rte_kind, only : wp, wl + integer, intent(in) :: ncol, nlay, nbnd, nsizes + logical(wl), & + dimension(ncol,nlay), intent(in) :: mask + real(wp), dimension(ncol,nlay), intent(in) :: lwp, re + real(wp), dimension(nsizes+1), intent(in) :: re_bounds_ext, re_bounds_ssa, re_bounds_asy + integer, intent(in) :: m_ext, n_ext + real(wp), dimension(nbnd,nsizes,0:m_ext+n_ext), & + intent(in) :: coeffs_ext + integer, intent(in) :: m_ssa, n_ssa + real(wp), dimension(nbnd,nsizes,0:m_ssa+n_ssa), & + intent(in) :: coeffs_ssa + integer, intent(in) :: m_asy, n_asy + real(wp), dimension(nbnd,nsizes,0:m_asy+n_asy), & + intent(in) :: coeffs_asy + real(wp), dimension(ncol,nlay,nbnd) :: tau, taussa, taussag + end subroutine compute_cld_from_pade + end interface + !--------------------------------------------------------------------------- +end module mo_cloud_optics_rrtmgp_kernels + diff --git a/rrtmgp-kernels/api/rrtmgp_kernels.h b/rrtmgp-kernels/api/rrtmgp_kernels.h index 92c36957c..6d8976c3b 100644 --- a/rrtmgp-kernels/api/rrtmgp_kernels.h +++ b/rrtmgp-kernels/api/rrtmgp_kernels.h @@ -19,6 +19,7 @@ This header files defines the C bindings for the kernels used in RRTMGP extern "C" { + /* Gas optics kernels */ void rrtmgp_interpolation( const int& ncol, const int& nlay, const int& ngas, const int& nflav, const int& neta, @@ -120,4 +121,55 @@ extern "C" Float* lev_src, // [out] (ncol,nlay+1,ngpt) Float* sfc_src_jac // [out] (ncol, ngpt) ); + + /* Cloud optics kernels */ + void rrtmgp_compute_tau_rayleigh( + const int& ncol, const int& nlay, const int& nband, const int& ngpt, + const int& ngas, const int& nflav, const int& neta, const int& npres, const int& ntemp, + const int* gpoint_flavor, // (2,ngpt) + const int* band_lims_gpt, // (2,nbnd) + const Float* krayl, // (ntemp,neta,ngpt,2) + const int& idx_h2o, + const Float* col_dry, // (ncol,nlay) + const Float* col_gas, // (ncol,nlay,ngas+1) + const Float* fminor, // (2,2,ncol,nlay,nflav) + const int* jeta, // (2, ncol,nlay,nflav) + const Bool* tropo, // (ncol,nlay) + const int* jtemp, // (ncol,nlay) + Float* tau_rayleigh // [inout] (ncol,nlay.ngpt) + ); + + void rrtmgp_compute_cld_from_table( + const int& ncol, int& nlay, int& nbnd, int& nsteps, + const Bool* mask, // (ncol,nlay) + const Float* lwp, // (ncol,nlay) + const Float* re, // (ncol,nlay) + const Float& step_size, + const Float& offset, + const Float* tau_table, // (nsteps, nbnd) + const Float* ssa_table, // (nsteps, nbnd) + const Float* asy_table, // (nsteps, nbnd) + Float* tau, // (ncol,nlay,nbnd) + Float* taussa, // (ncol,nlay,nbnd) + Float* taussag // (ncol,nlay,nbnd) + ); + + void rrtmgp_compute_cld_from_pade( + const int& ncol, int& nlay, int& nbnd, int& nsizes, + const Bool* mask, // (ncol,nlay) + const Float* lwp, // (ncol,nlay) + const Float* re, // (ncol,nlay) + const Float* re_bounds_ext, // (nsizes+1) + const Float* re_bounds_ssa, // (nsizes+1) + const Float* re_bounds_asy, // (nsizes+1) + const int& m_ext, int& n_ext, + const Float* coeffs_ext, // (nbnd,nsizes,0:m_ext+n_ext) + const int& m_ssa, int& n_ssa, + const Float* coeffs_ssa, // (nbnd,nsizes,0:m_ssa+n_ssa) + const int& m_asy, int& n_asy, + const Float* coeffs_asy, // (nbnd,nsizes,0:m_asy+n_asy) + Float* tau, // (ncol,nlay,nbnd) + Float* taussa, // (ncol,nlay,nbnd) + Float* taussag // (ncol,nlay,nbnd) + ); } diff --git a/rrtmgp-kernels/mo_cloud_optics_rrtmgp_kernels.F90 b/rrtmgp-kernels/mo_cloud_optics_rrtmgp_kernels.F90 new file mode 100644 index 000000000..a5c9e295e --- /dev/null +++ b/rrtmgp-kernels/mo_cloud_optics_rrtmgp_kernels.F90 @@ -0,0 +1,198 @@ +! This code is part of +! RRTM for GCM Applications - Parallel (RRTMGP) +! +! Copyright 2024-, Atmospheric and Environmental Research, +! Trustees of Columbia University. All right reserved. +! +! Use and duplication is permitted under the terms of the +! BSD 3-clause license, see http://opensource.org/licenses/BSD-3-Clause +! +module mo_cloud_optics_rrtmgp_kernels + use mo_rte_kind, only : wp, wl + implicit none + private + public :: compute_cld_from_table, compute_cld_from_pade + interface pade_eval + module procedure pade_eval_nbnd, pade_eval_1 + end interface pade_eval +contains + !--------------------------------------------------------------------------- + ! + ! Linearly interpolate values from a lookup table with "nsteps" evenly-spaced + ! elements starting at "offset." The table's second dimension is band. + ! Returns 0 where the mask is false. + ! We could also try gather/scatter for efficiency + ! + subroutine compute_cld_from_table(ncol, nlay, nbnd, mask, lwp, re, & + nsteps, step_size, offset, & + tau_table, ssa_table, asy_table, & + tau, taussa, taussag) bind(C, name="rrtmgp_compute_cld_from_table") + integer, intent(in) :: ncol, nlay, nbnd, nsteps + logical(wl), dimension(ncol,nlay), intent(in) :: mask + real(wp), dimension(ncol,nlay), intent(in) :: lwp, re + real(wp), intent(in) :: step_size, offset + real(wp), dimension(nsteps, nbnd), intent(in) :: tau_table, ssa_table, asy_table + real(wp), dimension(ncol,nlay,nbnd) :: tau, taussa, taussag + ! --------------------------- + integer :: icol, ilay, ibnd + integer :: index + real(wp) :: fint + real(wp) :: t, ts ! tau, tau*ssa, tau*ssa*g + ! --------------------------- + !$acc parallel loop gang vector default(present) collapse(3) + !$omp target teams distribute parallel do simd collapse(3) + do ibnd = 1, nbnd + do ilay = 1,nlay + do icol = 1, ncol + if(mask(icol,ilay)) then + index = min(floor((re(icol,ilay) - offset)/step_size)+1, nsteps-1) + fint = (re(icol,ilay) - offset)/step_size - (index-1) + t = lwp(icol,ilay) * & + (tau_table(index, ibnd) + fint * (tau_table(index+1,ibnd) - tau_table(index,ibnd))) + ts = t * & + (ssa_table(index, ibnd) + fint * (ssa_table(index+1,ibnd) - ssa_table(index,ibnd))) + taussag(icol,ilay,ibnd) = & + ts * & + (asy_table(index, ibnd) + fint * (asy_table(index+1,ibnd) - asy_table(index,ibnd))) + taussa (icol,ilay,ibnd) = ts + tau (icol,ilay,ibnd) = t + else + tau (icol,ilay,ibnd) = 0._wp + taussa (icol,ilay,ibnd) = 0._wp + taussag(icol,ilay,ibnd) = 0._wp + end if + end do + end do + end do + end subroutine compute_cld_from_table + !--------------------------------------------------------------------------- + ! + ! Pade functions + ! + !--------------------------------------------------------------------------- + subroutine compute_cld_from_pade(ncol, nlay, nbnd, nsizes, & + mask, lwp, re, & + m_ext, n_ext, re_bounds_ext, coeffs_ext, & + m_ssa, n_ssa, re_bounds_ssa, coeffs_ssa, & + m_asy, n_asy, re_bounds_asy, coeffs_asy, & + tau, taussa, taussag) bind(C, name="rrtmgp_compute_cld_from_pade") + integer, intent(in) :: ncol, nlay, nbnd, nsizes + logical(wl), & + dimension(ncol,nlay), intent(in) :: mask + real(wp), dimension(ncol,nlay), intent(in) :: lwp, re + real(wp), dimension(nsizes+1), intent(in) :: re_bounds_ext, re_bounds_ssa, re_bounds_asy + integer, intent(in) :: m_ext, n_ext + real(wp), dimension(nbnd,nsizes,0:m_ext+n_ext), & + intent(in) :: coeffs_ext + integer, intent(in) :: m_ssa, n_ssa + real(wp), dimension(nbnd,nsizes,0:m_ssa+n_ssa), & + intent(in) :: coeffs_ssa + integer, intent(in) :: m_asy, n_asy + real(wp), dimension(nbnd,nsizes,0:m_asy+n_asy), & + intent(in) :: coeffs_asy + real(wp), dimension(ncol,nlay,nbnd) :: tau, taussa, taussag + ! --------------------------- + integer :: icol, ilay, ibnd, irad + real(wp) :: t, ts + + !$acc parallel loop gang vector default(present) collapse(3) + !$omp target teams distribute parallel do simd collapse(3) + do ibnd = 1, nbnd + do ilay = 1, nlay + do icol = 1, ncol + if(mask(icol,ilay)) then + ! + ! Finds index into size regime table + ! This works only if there are precisely three size regimes (four bounds) and it's + ! previously guaranteed that size_bounds(1) <= size <= size_bounds(4) + ! + irad = min(floor((re(icol,ilay) - re_bounds_ext(2))/re_bounds_ext(3))+2, 3) + t = lwp(icol,ilay) * & + pade_eval(ibnd, nbnd, nsizes, m_ext, n_ext, irad, re(icol,ilay), coeffs_ext) + + irad = min(floor((re(icol,ilay) - re_bounds_ssa(2))/re_bounds_ssa(3))+2, 3) + ! Pade approximants for co-albedo can sometimes be negative + ts = t * (1._wp - max(0._wp, & + pade_eval(ibnd, nbnd, nsizes, m_ssa, n_ssa, irad, re(icol,ilay), coeffs_ssa))) + + irad = min(floor((re(icol,ilay) - re_bounds_asy(2))/re_bounds_asy(3))+2, 3) + taussag(icol,ilay,ibnd) = & + ts * & + pade_eval(ibnd, nbnd, nsizes, m_asy, n_asy, irad, re(icol,ilay), coeffs_asy) + + taussa (icol,ilay,ibnd) = ts + tau (icol,ilay,ibnd) = t + else + tau (icol,ilay,ibnd) = 0._wp + taussa (icol,ilay,ibnd) = 0._wp + taussag(icol,ilay,ibnd) = 0._wp + end if + end do + end do + end do + + end subroutine compute_cld_from_pade + !--------------------------------------------------------------------------- + ! + ! Evaluate Pade approximant of order [m/n] + ! + function pade_eval_nbnd(nbnd, nrads, m, n, irad, re, pade_coeffs) + integer, intent(in) :: nbnd, nrads, m, n, irad + real(wp), dimension(nbnd, nrads, 0:m+n), & + intent(in) :: pade_coeffs + real(wp), intent(in) :: re + real(wp), dimension(nbnd) :: pade_eval_nbnd + + integer :: iband + real(wp) :: numer, denom + integer :: i + + do iband = 1, nbnd + denom = pade_coeffs(iband,irad,n+m) + do i = n-1+m, 1+m, -1 + denom = pade_coeffs(iband,irad,i)+re*denom + end do + denom = 1._wp +re*denom + + numer = pade_coeffs(iband,irad,m) + do i = m-1, 1, -1 + numer = pade_coeffs(iband,irad,i)+re*numer + end do + numer = pade_coeffs(iband,irad,0) +re*numer + + pade_eval_nbnd(iband) = numer/denom + end do + end function pade_eval_nbnd + !--------------------------------------------------------------------------- + ! + ! Evaluate Pade approximant of order [m/n] + ! + function pade_eval_1(iband, nbnd, nrads, m, n, irad, re, pade_coeffs) + !$acc routine seq + !$omp declare target + ! + integer, intent(in) :: iband, nbnd, nrads, m, n, irad + real(wp), dimension(nbnd, nrads, 0:m+n), & + intent(in) :: pade_coeffs + real(wp), intent(in) :: re + real(wp) :: pade_eval_1 + + real(wp) :: numer, denom + integer :: i + + denom = pade_coeffs(iband,irad,n+m) + do i = n-1+m, 1+m, -1 + denom = pade_coeffs(iband,irad,i)+re*denom + end do + denom = 1._wp +re*denom + + numer = pade_coeffs(iband,irad,m) + do i = m-1, 1, -1 + numer = pade_coeffs(iband,irad,i)+re*numer + end do + numer = pade_coeffs(iband,irad,0) +re*numer + + pade_eval_1 = numer/denom + end function pade_eval_1 + +end module mo_cloud_optics_rrtmgp_kernels From c155dd5f2d7b18dea530443f2d53c84ce13f1dcf Mon Sep 17 00:00:00 2001 From: "dependabot[bot]" <49699333+dependabot[bot]@users.noreply.github.com> Date: Tue, 19 Nov 2024 20:58:33 -0500 Subject: [PATCH 47/57] Bump JamesIves/github-pages-deploy-action from 4.6.8 to 4.6.9 (#303) Bumps [JamesIves/github-pages-deploy-action](https://github.com/jamesives/github-pages-deploy-action) from 4.6.8 to 4.6.9. - [Release notes](https://github.com/jamesives/github-pages-deploy-action/releases) - [Commits](https://github.com/jamesives/github-pages-deploy-action/compare/v4.6.8...v4.6.9) --- updated-dependencies: - dependency-name: JamesIves/github-pages-deploy-action dependency-type: direct:production update-type: version-update:semver-patch ... Signed-off-by: dependabot[bot] Co-authored-by: dependabot[bot] <49699333+dependabot[bot]@users.noreply.github.com> --- .github/workflows/doc-deployment.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/doc-deployment.yml b/.github/workflows/doc-deployment.yml index 34da5232c..0e291980d 100644 --- a/.github/workflows/doc-deployment.yml +++ b/.github/workflows/doc-deployment.yml @@ -70,7 +70,7 @@ jobs: # Deploy documentation # - name: Deploy API Documentation - uses: JamesIves/github-pages-deploy-action@v4.6.8 + uses: JamesIves/github-pages-deploy-action@v4.6.9 if: ${{ github.event_name == 'push' && github.ref == 'refs/heads/documentation' }} with: branch: gh-pages From 27f2649172ae4d56acc39abb37ea590d8ecef38d Mon Sep 17 00:00:00 2001 From: "dependabot[bot]" <49699333+dependabot[bot]@users.noreply.github.com> Date: Sat, 30 Nov 2024 17:37:53 -0500 Subject: [PATCH 48/57] Bump JamesIves/github-pages-deploy-action from 4.6.9 to 4.7.1 (#306) Bumps [JamesIves/github-pages-deploy-action](https://github.com/jamesives/github-pages-deploy-action) from 4.6.9 to 4.7.1. - [Release notes](https://github.com/jamesives/github-pages-deploy-action/releases) - [Commits](https://github.com/jamesives/github-pages-deploy-action/compare/v4.6.9...v4.7.1) --- updated-dependencies: - dependency-name: JamesIves/github-pages-deploy-action dependency-type: direct:production update-type: version-update:semver-minor ... Signed-off-by: dependabot[bot] Co-authored-by: dependabot[bot] <49699333+dependabot[bot]@users.noreply.github.com> --- .github/workflows/doc-deployment.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/doc-deployment.yml b/.github/workflows/doc-deployment.yml index 0e291980d..31c4efa9a 100644 --- a/.github/workflows/doc-deployment.yml +++ b/.github/workflows/doc-deployment.yml @@ -70,7 +70,7 @@ jobs: # Deploy documentation # - name: Deploy API Documentation - uses: JamesIves/github-pages-deploy-action@v4.6.9 + uses: JamesIves/github-pages-deploy-action@v4.7.1 if: ${{ github.event_name == 'push' && github.ref == 'refs/heads/documentation' }} with: branch: gh-pages From 4080fc3bcd5e371a53379cc35fc16bc030013265 Mon Sep 17 00:00:00 2001 From: "dependabot[bot]" <49699333+dependabot[bot]@users.noreply.github.com> Date: Tue, 3 Dec 2024 20:20:57 +0000 Subject: [PATCH 49/57] Bump JamesIves/github-pages-deploy-action from 4.7.1 to 4.7.2 Bumps [JamesIves/github-pages-deploy-action](https://github.com/jamesives/github-pages-deploy-action) from 4.7.1 to 4.7.2. - [Release notes](https://github.com/jamesives/github-pages-deploy-action/releases) - [Commits](https://github.com/jamesives/github-pages-deploy-action/compare/v4.7.1...v4.7.2) --- updated-dependencies: - dependency-name: JamesIves/github-pages-deploy-action dependency-type: direct:production update-type: version-update:semver-patch ... Signed-off-by: dependabot[bot] --- .github/workflows/doc-deployment.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/doc-deployment.yml b/.github/workflows/doc-deployment.yml index 31c4efa9a..2c3a5c216 100644 --- a/.github/workflows/doc-deployment.yml +++ b/.github/workflows/doc-deployment.yml @@ -70,7 +70,7 @@ jobs: # Deploy documentation # - name: Deploy API Documentation - uses: JamesIves/github-pages-deploy-action@v4.7.1 + uses: JamesIves/github-pages-deploy-action@v4.7.2 if: ${{ github.event_name == 'push' && github.ref == 'refs/heads/documentation' }} with: branch: gh-pages From bda5e7ef9da8b29cd61366c5b7f8c9f05d8e764f Mon Sep 17 00:00:00 2001 From: Robert Pincus Date: Fri, 20 Dec 2024 16:00:14 -0500 Subject: [PATCH 50/57] Thomas Jahn's gas optics interpolation fixes (#315) * Fix work-around with reasonable code. * The following is bad in any performance-sensitive codes: + Using arrays instead of scalars. + Assigning to the same array element more than once in a loop-nest. While the compiler can in principle fix this up, it's actually too hard to ask for that and in the case fixed here, seriously trips up the Intel Fortran compiler. * Replace unnecessary log operation. * Replace division by multiplication of inverse. * Replace array reference with scalar. * Replace division by multiplication with inverse. * Keep data in float format. * In some cases these conversions are carried out via memory such that reading data just written to memory back into a register stalls the FPU. * Fix mix in precisions. --------- Co-authored-by: Thomas Jahns --- .../mo_gas_optics_rrtmgp_kernels.F90 | 58 +++++++++---------- tests/check_equivalence.F90 | 16 ++--- 2 files changed, 36 insertions(+), 38 deletions(-) diff --git a/rrtmgp-kernels/mo_gas_optics_rrtmgp_kernels.F90 b/rrtmgp-kernels/mo_gas_optics_rrtmgp_kernels.F90 index 7a050fb84..df656859b 100644 --- a/rrtmgp-kernels/mo_gas_optics_rrtmgp_kernels.F90 +++ b/rrtmgp-kernels/mo_gas_optics_rrtmgp_kernels.F90 @@ -71,22 +71,9 @@ subroutine interpolation( & logical(wl), dimension(ncol,nlay), intent(out) :: tropo !! use lower (or upper) atmosphere tables integer, dimension(2, ncol,nlay,nflav), intent(out) :: jeta - !! Index for binary species interpolation -#if !defined(__INTEL_LLVM_COMPILER) && __INTEL_COMPILER >= 1910 - ! A performance-hitting workaround for the vectorization problem reported in - ! https://github.com/earth-system-radiation/rte-rrtmgp/issues/159 - ! The known affected compilers are Intel Fortran Compiler Classic - ! 2021.4, 2021.5 and 2022.1. We do not limit the workaround to these - ! versions because it is not clear when the compiler bug will be fixed, see - ! https://community.intel.com/t5/Intel-Fortran-Compiler/Compiler-vectorization-bug/m-p/1362591. - ! We, however, limit the workaround to the Classic versions only since the - ! problem is not confirmed for the Intel Fortran Compiler oneAPI (a.k.a - ! 'ifx'), which does not mean there is none though. - real(wp), dimension(:, :, :, :), intent(out) :: col_mix -#else + !! Index for binary species interpolation real(wp), dimension(2, ncol,nlay,nflav), intent(out) :: col_mix !! combination of major species's column amounts (first index is strat/trop) -#endif real(wp), dimension(2,2,2,ncol,nlay,nflav), intent(out) :: fmajor !! Interpolation weights in pressure, eta, strat/trop real(wp), dimension(2,2, ncol,nlay,nflav), intent(out) :: fminor @@ -100,29 +87,40 @@ subroutine interpolation( & real(wp) :: eta, feta ! binary_species_parameter, interpolation variable for eta real(wp) :: loceta ! needed to find location in eta grid real(wp) :: ftemp_term + real(wp) :: press_ref_trop + real(wp) :: temp_ref_delta_inv + real(wp) :: press_ref_log_1 + real(wp) :: press_ref_log_delta_inv + real(wp) :: jpress_aint ! ----------------- ! local indexes - integer :: icol, ilay, iflav, igases(2), itropo, itemp + integer :: icol, ilay, iflav, igas_1, igas_2, itropo, itemp, jtemp_ + press_ref_trop = exp(press_ref_trop_log) + temp_ref_delta_inv = 1.0_wp / temp_ref_delta + press_ref_log_1 = press_ref_log(1) + press_ref_log_delta_inv = 1.0_wp / press_ref_log_delta do ilay = 1, nlay do icol = 1, ncol ! index and factor for temperature interpolation - jtemp(icol,ilay) = int((tlay(icol,ilay) - (temp_ref_min - temp_ref_delta)) / temp_ref_delta) - jtemp(icol,ilay) = min(ntemp - 1, max(1, jtemp(icol,ilay))) ! limit the index range - ftemp(icol,ilay) = (tlay(icol,ilay) - temp_ref(jtemp(icol,ilay))) / temp_ref_delta + jtemp_ = INT((tlay(icol,ilay) - (temp_ref_min - temp_ref_delta)) * temp_ref_delta_inv) + jtemp(icol,ilay) = min(ntemp - 1, max(1, jtemp_)) ! limit the index range + ftemp(icol,ilay) = (tlay(icol,ilay) - temp_ref(jtemp_)) * temp_ref_delta_inv ! index and factor for pressure interpolation - locpress = 1._wp + (log(play(icol,ilay)) - press_ref_log(1)) / press_ref_log_delta - jpress(icol,ilay) = min(npres-1, max(1, int(locpress))) - fpress(icol,ilay) = locpress - float(jpress(icol,ilay)) + locpress = 1._wp + (log(play(icol,ilay)) - press_ref_log_1) * press_ref_log_delta_inv + jpress_aint = min(real(npres-1, wp), max(1.0_wp, aint(locpress))) + jpress(icol,ilay) = int(jpress_aint) + fpress(icol,ilay) = locpress - jpress_aint ! determine if in lower or upper part of atmosphere - tropo(icol,ilay) = log(play(icol,ilay)) > press_ref_trop_log + tropo(icol,ilay) = play(icol,ilay) > press_ref_trop end do end do do iflav = 1, nflav - igases(:) = flavor(:,iflav) + igas_1 = flavor(1,iflav) + igas_2 = flavor(2,iflav) do ilay = 1, nlay do icol = 1, ncol ! itropo = 1 lower atmosphere; itropo = 2 upper atmosphere @@ -132,9 +130,9 @@ subroutine interpolation( & ! compute interpolation fractions needed for lower, then upper reference temperature level ! compute binary species parameter (eta) for flavor and temperature and ! associated interpolation index and factors - ratio_eta_half = vmr_ref(itropo,igases(1),(jtemp(icol,ilay)+itemp-1)) / & - vmr_ref(itropo,igases(2),(jtemp(icol,ilay)+itemp-1)) - col_mix(itemp,icol,ilay,iflav) = col_gas(icol,ilay,igases(1)) + ratio_eta_half * col_gas(icol,ilay,igases(2)) + ratio_eta_half = vmr_ref(itropo,igas_1,(jtemp(icol,ilay)+itemp-1)) / & + vmr_ref(itropo,igas_2,(jtemp(icol,ilay)+itemp-1)) + col_mix(itemp,icol,ilay,iflav) = col_gas(icol,ilay,igas_1) + ratio_eta_half * col_gas(icol,ilay,igas_2) ! Keep this commented lines. Fortran does allow for ! substantial optimizations and in this merge cases may ! happen that all expressions are evaluated and so create @@ -142,18 +140,18 @@ subroutine interpolation( & ! save. Merge is the way to do it in general inside of ! loops, but sometimes it may not work. ! - ! eta = merge(col_gas(icol,ilay,igases(1)) / col_mix(itemp,icol,ilay,iflav), 0.5_wp, & + ! eta = merge(col_gas(icol,ilay,igas_1) / col_mix(itemp,icol,ilay,iflav), 0.5_wp, & ! col_mix(itemp,icol,ilay,iflav) > 2._wp * tiny(col_mix)) ! ! In essence: do not turn it back to merge(...)! if (col_mix(itemp,icol,ilay,iflav) > 2._wp * tiny(col_mix)) then - eta = col_gas(icol,ilay,igases(1)) / col_mix(itemp,icol,ilay,iflav) + eta = col_gas(icol,ilay,igas_1) / col_mix(itemp,icol,ilay,iflav) else eta = 0.5_wp endif - loceta = eta * float(neta-1) + loceta = eta * real(neta-1, wp) jeta(itemp,icol,ilay,iflav) = min(int(loceta)+1, neta-1) - feta = mod(loceta, 1.0_wp) + feta = loceta - aint(loceta) ! compute interpolation fractions needed for minor species ! ftemp_term = (1._wp-ftemp(icol,ilay)) for itemp = 1, ftemp(icol,ilay) for itemp=2 ftemp_term = (real(2-itemp, wp) + real(2*itemp-3, wp) * ftemp(icol,ilay)) diff --git a/tests/check_equivalence.F90 b/tests/check_equivalence.F90 index 7ece94aae..86d064232 100644 --- a/tests/check_equivalence.F90 +++ b/tests/check_equivalence.F90 @@ -429,8 +429,8 @@ program rte_check_equivalence sfc_alb_dir, sfc_alb_dif, & fluxes)) if(.not. allclose(tst_flux_up, ref_flux_up, tol = 8._wp) .or. & - .not. allclose(tst_flux_dn, ref_flux_dn, tol = 10._wp) .or. & - .not. allclose(tst_flux_dir,ref_flux_dir,tol = 10._wp)) & + .not. allclose(tst_flux_dn, ref_flux_dn, tol = 12._wp) .or. & + .not. allclose(tst_flux_dir,ref_flux_dir,tol = 12._wp)) & call report_err(" halving/doubling fails") ! @@ -447,8 +447,8 @@ program rte_check_equivalence sfc_alb_dir, sfc_alb_dif, & fluxes)) if(.not. allclose(tst_flux_up, ref_flux_up, tol = 8._wp) .or. & - .not. allclose(tst_flux_dn, ref_flux_dn, tol = 10._wp) .or. & - .not. allclose(tst_flux_dir,ref_flux_dir,tol = 10._wp)) & + .not. allclose(tst_flux_dn, ref_flux_dn, tol = 12._wp) .or. & + .not. allclose(tst_flux_dir,ref_flux_dir,tol = 12._wp)) & call report_err(" Incrementing with 1scl fails") call stop_on_err(gas_optics%gas_optics(p_lay, p_lev, & @@ -462,8 +462,8 @@ program rte_check_equivalence sfc_alb_dir, sfc_alb_dif, & fluxes)) if(.not. allclose(tst_flux_up, ref_flux_up, tol = 8._wp) .or. & - .not. allclose(tst_flux_dn, ref_flux_dn, tol = 10._wp) .or. & - .not. allclose(tst_flux_dir,ref_flux_dir,tol = 10._wp)) & + .not. allclose(tst_flux_dn, ref_flux_dn, tol = 12._wp) .or. & + .not. allclose(tst_flux_dir,ref_flux_dir,tol = 12._wp)) & call report_err(" Incrementing with 2str fails") call stop_on_err(gas_optics%gas_optics(p_lay, p_lev, & @@ -477,8 +477,8 @@ program rte_check_equivalence sfc_alb_dir, sfc_alb_dif, & fluxes)) if(.not. allclose(tst_flux_up, ref_flux_up, tol = 8._wp) .or. & - .not. allclose(tst_flux_dn, ref_flux_dn, tol = 10._wp) .or. & - .not. allclose(tst_flux_dir,ref_flux_dir,tol = 10._wp)) & + .not. allclose(tst_flux_dn, ref_flux_dn, tol = 12._wp) .or. & + .not. allclose(tst_flux_dir,ref_flux_dir,tol = 12._wp)) & call report_err(" Incrementing with nstr fails") print *, " Incrementing" end if From e13d20e5b6c3df99188f6564c415976a3438d316 Mon Sep 17 00:00:00 2001 From: Sergey Kosukhin Date: Mon, 23 Dec 2024 20:52:32 +0100 Subject: [PATCH 51/57] Refactor CMake and CI scripting (#316) Move from Gnu Make to CMake/Ninja as the build system and update continuous integration. See the PR history for details. --------- Co-authored-by: Chiel van Heerwaarden Co-authored-by: Robert Pincus Co-authored-by: Alexander Soklev --- .cmake-format.py | 25 +++ .git-blame-ignore-revs | 2 + .github/workflows/check-api.yml | 11 +- .github/workflows/containerized-ci.yml | 88 +++----- .github/workflows/continuous-integration.yml | 193 ++++++++++-------- .github/workflows/self-hosted-ci.yml | 126 ------------ .github/workflows/style.yml | 72 +++++++ .gitignore | 6 + .gitlab/common.yml | 38 ++-- .gitlab/levante.yml | 27 +-- .gitlab/lumi.yml | 7 +- CMakeLists.txt | 79 +++++++ Makefile | 28 --- build/Makefile | 68 ------ cmake/CheckFortranNeedsCBool.cmake | 72 +++++++ cmake/CheckPython3Package.cmake | 43 ++++ cmake/FindNetCDF_Fortran.cmake | 19 ++ doc/jekyll_site/how-tos/build-and-test.md | 30 +-- environment-dev.yml | 2 + environment-noplots.yml | 5 +- examples/CMakeLists.txt | 31 +++ examples/all-sky/CMakeLists.txt | 75 +++++++ examples/all-sky/Makefile | 68 ------ examples/all-sky/all_tests.sh | 9 - examples/rfmip-clear-sky/CMakeLists.txt | 59 ++++++ examples/rfmip-clear-sky/Makefile | 75 ------- rrtmgp-frontend/CMakeLists.txt | 24 +++ rrtmgp-frontend/Make.depends | 47 ----- rrtmgp-kernels/CMakeLists.txt | 38 ++++ rrtmgp-kernels/Make.depends | 10 - rte-frontend/CMakeLists.txt | 18 ++ rte-frontend/Make.depends | 51 ----- rte-kernels/CMakeLists.txt | 51 +++++ rte-kernels/Make.depends | 27 --- {rte-frontend => rte-kernels}/mo_rte_kind.F90 | 0 setup.sh | 23 +++ tests/CMakeLists.txt | 114 +++++++++++ tests/Makefile | 97 --------- tests/all_tests.sh | 10 - tests/validation-plots.py | 22 +- 40 files changed, 970 insertions(+), 820 deletions(-) create mode 100644 .cmake-format.py create mode 100644 .git-blame-ignore-revs delete mode 100644 .github/workflows/self-hosted-ci.yml create mode 100644 .github/workflows/style.yml create mode 100644 CMakeLists.txt delete mode 100644 Makefile delete mode 100644 build/Makefile create mode 100644 cmake/CheckFortranNeedsCBool.cmake create mode 100644 cmake/CheckPython3Package.cmake create mode 100644 cmake/FindNetCDF_Fortran.cmake create mode 100644 examples/CMakeLists.txt create mode 100644 examples/all-sky/CMakeLists.txt delete mode 100644 examples/all-sky/Makefile delete mode 100644 examples/all-sky/all_tests.sh create mode 100644 examples/rfmip-clear-sky/CMakeLists.txt delete mode 100644 examples/rfmip-clear-sky/Makefile create mode 100644 rrtmgp-frontend/CMakeLists.txt delete mode 100644 rrtmgp-frontend/Make.depends create mode 100644 rrtmgp-kernels/CMakeLists.txt delete mode 100644 rrtmgp-kernels/Make.depends create mode 100644 rte-frontend/CMakeLists.txt delete mode 100644 rte-frontend/Make.depends create mode 100644 rte-kernels/CMakeLists.txt delete mode 100644 rte-kernels/Make.depends rename {rte-frontend => rte-kernels}/mo_rte_kind.F90 (100%) create mode 100755 setup.sh create mode 100644 tests/CMakeLists.txt delete mode 100644 tests/Makefile delete mode 100644 tests/all_tests.sh mode change 100644 => 100755 tests/validation-plots.py diff --git a/.cmake-format.py b/.cmake-format.py new file mode 100644 index 000000000..f6ee981d9 --- /dev/null +++ b/.cmake-format.py @@ -0,0 +1,25 @@ +with section("parse"): + additional_commands = {"check_python3_package": {"pargs": 1, "kwargs": {"CODE": 1}}} + +with section("format"): + dangle_parens = True + max_lines_hwrap = 0 + keyword_case = "upper" + autosort = True + +with section("lint"): + # The formatter sometimes fails to fit the code into the line limit (C0301) and can + # disagree with the linter regarding the indentation (C0307): + disabled_codes = ["C0301", "C0307"] + # Names of local variables must be in lowercase but sometimes we need to + # override standard CMake variables: + local_var_pattern = "CMAKE_[0-9A-Z_]+|[a-z][0-9a-z_]+" + # The standard names of the languages in CMake are C and Fortran. Names of + # private variables must be in lowercase but can have substings "C" and + # "Fortran": + private_var_pattern = ( + "([a-z_][0-9a-z_]*_)?(C|Fortran)(_[a-z_][0-9a-z_]*)?|[a-z_][0-9a-z_]+" + ) + # The standard name of the language in CMake is Fortran. Names of public + # variables must be in uppercase but can have substring "Fortran": + public_var_pattern = "([A-Z][0-9A-Z_]*_)?Fortran(_[A-Z][0-9A-Z_]*)?|[A-Z][0-9A-Z_]+" diff --git a/.git-blame-ignore-revs b/.git-blame-ignore-revs new file mode 100644 index 000000000..593947014 --- /dev/null +++ b/.git-blame-ignore-revs @@ -0,0 +1,2 @@ +# Formatted entire CMake code base with cmake-format +45b43632309cff022326472a8be0fdd5efc8f5c8 diff --git a/.github/workflows/check-api.yml b/.github/workflows/check-api.yml index b3681e666..4b50a0355 100644 --- a/.github/workflows/check-api.yml +++ b/.github/workflows/check-api.yml @@ -14,11 +14,11 @@ jobs: API: runs-on: ubuntu-22.04 env: - # Core variables: FC: gfortran-12 - FCFLAGS: "-ffree-line-length-none -m64 -std=f2008 -march=native -fbounds-check -fmodule-private -fimplicit-none -finit-real=nan -g -DRTE_USE_CBOOL" - RRTMGP_ROOT: ${{ github.workspace }} + FFLAGS: "-m64 -std=f2008 -march=native -fbounds-check -fmodule-private -fimplicit-none -finit-real=nan" RTE_KERNELS: extern + CMAKE_BUILD_PARALLEL_LEVEL: 8 + VERBOSE: steps: # # Check out repository under $GITHUB_WORKSPACE @@ -31,4 +31,7 @@ jobs: - name: Build libraries run: | $FC --version - make -j4 libs \ No newline at end of file + cmake -S . -B build \ + -DCMAKE_BUILD_TYPE=RelWithDebInfo \ + -DKERNEL_MODE=$RTE_KERNELS + cmake --build build diff --git a/.github/workflows/containerized-ci.yml b/.github/workflows/containerized-ci.yml index de94e8417..aa91da7f3 100644 --- a/.github/workflows/containerized-ci.yml +++ b/.github/workflows/containerized-ci.yml @@ -21,21 +21,26 @@ jobs: include: # Set flags for Intel Fortran Compiler Classic - fortran-compiler: ifort - fcflags: -m64 -g -traceback -heap-arrays -assume realloc_lhs -extend-source 132 -check bounds,uninit,pointers,stack -stand f08 -diag-disable=10448 + fcflags: -m64 -traceback -heap-arrays -assume realloc_lhs -extend-source 132 -check bounds,uninit,pointers,stack -stand f08 -diag-disable=10448 + build-type: RelWithDebInfo # Set flags for Intel Fortran Compiler - fortran-compiler: ifx rte-kernels: default fcflags: -debug -traceback -O0 -heap-arrays -assume realloc_lhs -extend-source 132 -stand f08 + build-type: None - fortran-compiler: ifx rte-kernels: accel fcflags: -debug -traceback -O0 -heap-arrays -assume realloc_lhs -extend-source 132 -stand f08 -fiopenmp -fopenmp-targets=spir64 + build-type: None # Set flags for NVIDIA Fortran compiler - fortran-compiler: nvfortran rte-kernels: default fcflags: -Mallocatable=03 -Mstandard -Mbounds -Mchkptr -Kieee -Mchkstk + build-type: None - fortran-compiler: nvfortran rte-kernels: accel fcflags: -Mallocatable=03 -Mstandard -Mbounds -Mchkptr -Kieee -Mchkstk -acc + build-type: None # Set container images - fortran-compiler: ifort image: ghcr.io/earth-system-radiation/rte-rrtmgp-ci:oneapi @@ -46,33 +51,30 @@ jobs: container: image: ${{ matrix.image }} env: - # Core variables: FC: ${{ matrix.fortran-compiler }} - FCFLAGS: ${{ matrix.fcflags }} -DRTE_USE_${{ matrix.fpmodel}} - # Make variables: - NFHOME: /opt/netcdf-fortran - RRTMGP_ROOT: ${{ github.workspace }} - RRTMGP_DATA: ${{ github.workspace }}/rrtmgp-data - RTE_KERNELS: ${{ matrix.rte-kernels }} - RUN_CMD: + FFLAGS: ${{ matrix.fcflags }} + NetCDF_Fortran_ROOT: /opt/netcdf-fortran + CMAKE_BUILD_PARALLEL_LEVEL: 8 + VERBOSE: + # TODO: add missing test dependencies and run them in parallel: + # CTEST_PARALLEL_LEVEL: 8 + CTEST_OUTPUT_ON_FAILURE: 1 # https://github.com/earth-system-radiation/rte-rrtmgp/issues/194 OMP_TARGET_OFFLOAD: DISABLED - FAILURE_THRESHOLD: 7.e-4 steps: # - # Checks-out repository under $GITHUB_WORKSPACE + # Check out repository under $GITHUB_WORKSPACE # - - uses: actions/checkout@v4 + - name: Check out code + uses: actions/checkout@v4 # - # Check out data + # Install required tools # - - name: Check out data - uses: actions/checkout@v4 - with: - repository: earth-system-radiation/rrtmgp-data - path: rrtmgp-data - ref: v1.8.2 + - name: Install Required Tools + run: | + apt-get update + apt-get install -y git cmake ninja-build # # Build libraries, examples and tests (expect success) # @@ -80,52 +82,26 @@ jobs: id: build-success if: matrix.fortran-compiler != 'ifx' || matrix.rte-kernels != 'accel' run: | - $FC --version - make -j4 libs - # - # Build libraries, examples and tests (expect failure) - # - - name: Build libraries, examples and tests (expect failure) - if: steps.build-success.outcome == 'skipped' - shell: bash - run: | - $FC --version - make -j4 libs 2> >(tee make.err >&2) && { - echo "Unexpected success" - exit 1 - } || { - grep make.err -e 'Internal compiler error' && { - echo "Expected failure" - } || { - echo "Unexpected failure" - exit 1 - } - } + cmake -S . -B build -G "Ninja" \ + -DCMAKE_BUILD_TYPE=${{ matrix.build-type }} \ + -DRTE_ENABLE_SP=`test 'x${{ matrix.fpmodel }}' = xSP && echo ON || echo OFF` \ + -DKERNEL_MODE=${{ matrix.rte-kernels }} \ + -DBUILD_TESTING=ON + cmake --build build # # Run examples and tests # - name: Run examples and tests + working-directory: build if: steps.build-success.outcome != 'skipped' - run: make -j4 tests - # - # Relax failure thresholds for single precision - # - - name: Relax failure threshold for single precision - if: matrix.fpmodel == 'SP' && steps.build-success.outcome != 'skipped' - run: echo "FAILURE_THRESHOLD=3.5e-1" >> $GITHUB_ENV - # - # Compare the results - # - - name: Compare the results - if: steps.build-success.outcome != 'skipped' - run: make -j4 check + run: ctest # # Generate validation plots # - name: Generate validation plots if: matrix.fortran-compiler == 'ifort' && matrix.rte-kernels == 'default' && matrix.fpmodel == 'DP' - working-directory: tests - run: python validation-plots.py + run: | + cmake --build build --target validation-plots # # Upload validation plots # @@ -134,4 +110,4 @@ jobs: uses: actions/upload-artifact@v4 with: name: valdiation-plot - path: tests/validation-figures.pdf + path: build/tests/validation-figures.pdf diff --git a/.github/workflows/continuous-integration.yml b/.github/workflows/continuous-integration.yml index 57bd196e8..84d1829d8 100644 --- a/.github/workflows/continuous-integration.yml +++ b/.github/workflows/continuous-integration.yml @@ -1,12 +1,13 @@ name: Continuous Integration + on: push: branches: - - main - - develop + - main + - develop pull_request: branches-ignore: - - documentation + - documentation workflow_dispatch: defaults: @@ -16,88 +17,116 @@ defaults: jobs: CI: - runs-on: ubuntu-22.04 strategy: fail-fast: false matrix: - fortran-compiler: [gfortran-10, gfortran-11, gfortran-12] + os: [ubuntu-24.04, macos-13, macos-latest, windows-2022] + gfortran-version: [12, 13, 14] + gfortran-from: [system, conda] fpmodel: [DP, SP] + exclude: + - os: ubuntu-24.04 + gfortran-from: conda + - os: macos-13 + gfortran-from: system + - os: macos-13 + gfortran-version: 14 + gfortran-from: conda + - os: macos-latest + gfortran-from: system + - os: macos-latest + gfortran-version: 14 + gfortran-from: conda + - os: windows-2022 + include: + - os: ubuntu-24.04 + gfortran-version: 13 + gfortran-from: conda + fpmodel: DP + - os: windows-2022 + gfortran-version: 13 + gfortran-from: conda + fpmodel: DP + - os: windows-2022 + gfortran-version: 13 + gfortran-from: conda + fpmodel: SP + - os: windows-2022 + gfortran-version: 14 + gfortran-from: conda + fpmodel: DP + - os: windows-2022 + gfortran-version: 14 + gfortran-from: conda + fpmodel: SP env: - # Core variables: - FC: ${{ matrix.fortran-compiler }} - FCFLAGS: "-ffree-line-length-none -m64 -std=f2008 -march=native -fbounds-check -fmodule-private -fimplicit-none -finit-real=nan -g -DRTE_USE_CBOOL -DRTE_USE_${{ matrix.fpmodel }}" - # Make variables: - FCINCLUDE: -I/usr/include - RRTMGP_ROOT: ${{ github.workspace }} - RRTMGP_DATA: ${{ github.workspace }}/rrtmgp-data - RUN_CMD: - FAILURE_THRESHOLD: 7.e-4 + FC: gfortran-${{ matrix.gfortran-version }} + FFLAGS: "-ffree-line-length-none -m64 -std=f2008 -march=native -fbounds-check -fmodule-private -fimplicit-none -finit-real=nan" + CMAKE_BUILD_PARALLEL_LEVEL: 8 + VERBOSE: + # TODO: add missing test dependencies and run them in parallel: + # CTEST_PARALLEL_LEVEL: 8 + CTEST_OUTPUT_ON_FAILURE: 1 + runs-on: ${{ matrix.os }} steps: - # - # Relax failure thresholds for single precision - # - - name: Relax failure threshold for single precision - if: matrix.fpmodel == 'SP' - run: echo "FAILURE_THRESHOLD=3.5e-1" >> $GITHUB_ENV - # - # Check out repository under $GITHUB_WORKSPACE - # - - name: Check out code - uses: actions/checkout@v4 - # - # Check out data - # - - name: Check out data - uses: actions/checkout@v4 - with: - repository: earth-system-radiation/rrtmgp-data - path: rrtmgp-data - ref: v1.8.2 - # - # Synchronize the package index - # - - name: Synchronize the package index - run: sudo apt-get update - # - # Install NetCDF-Fortran (compatible with all compilers) - # - - name: Install NetCDF-Fortran - run: sudo apt-get install libnetcdff-dev - # - # Cache Conda packages - # - - name: Cache Conda packages - uses: actions/cache@v4 - with: - path: ~/conda_pkgs_dir - key: conda-pkgs - # - # Set up Conda - # - - name: Set up Conda - uses: conda-incubator/setup-miniconda@v3 - with: - miniforge-version: latest - activate-environment: rte_rrtmgp_test - environment-file: environment-noplots.yml - python-version: 3.11 - auto-activate-base: false - # Use the cache properly: - use-only-tar-bz2: true - # - # Build libraries, examples and tests - # - - name: Build libraries - run: | - $FC --version - make -j4 libs - # - # Run examples and tests - # - - name: Build and run examples and tests - run: make -j4 tests - # - # Compare the results - # - - name: Compare the results - run: make -j4 check + # + # Check out repository under $GITHUB_WORKSPACE + # + - name: Check out code + uses: actions/checkout@v4 + # + # Cache Conda packages + # + - name: Cache Conda packages + uses: actions/cache@v4 + with: + path: ~/conda_pkgs_dir + key: conda-pkgs-${{ matrix.os }} + # + # Set up Conda + # + - name: Set up Conda + uses: conda-incubator/setup-miniconda@v3 + with: + miniforge-version: latest + activate-environment: rte_rrtmgp_test + environment-file: environment-noplots.yml + python-version: 3.11 + auto-activate-base: false + # Use the cache properly: + use-only-tar-bz2: false + # + # Install compiler + # + - name: Install compiler + if: matrix.gfortran-from == 'conda' + run: | + conda install -c conda-forge gfortran=${{ matrix.gfortran-version }} -y + echo "FC=gfortran" >> $GITHUB_ENV + # + # Install dependencies + # + - name: Install dependencies + run: conda install -c conda-forge netcdf-fortran ninja -y + # + # Adjust toolchain + # + - name: Adjust toolchain + if: matrix.os == 'windows-2022' + run: echo "FC=${FC}.exe" >> $GITHUB_ENV + # + # Build libraries, examples, and tests + # + - name: Build libraries and tests + run: | + cmake -S . -B build -G "Ninja" \ + -DCMAKE_BUILD_TYPE=RelWithDebInfo \ + -DRTE_ENABLE_SP=`test 'x${{ matrix.fpmodel }}' = xSP && echo ON || echo OFF` \ + -DBUILD_TESTING=ON + cmake --build build + # + # Run examples, tests and checks + # + - name: Run examples, tests and checks + working-directory: build + run: ctest diff --git a/.github/workflows/self-hosted-ci.yml b/.github/workflows/self-hosted-ci.yml deleted file mode 100644 index d9ad8838a..000000000 --- a/.github/workflows/self-hosted-ci.yml +++ /dev/null @@ -1,126 +0,0 @@ -name: Self-hosted CI -on: - workflow_dispatch: - -defaults: - run: - shell: bash - -# A workaround for the old runtime: -env: - ACTIONS_ALLOW_USE_UNSECURE_NODE_VERSION: true - -jobs: - CI: - if: github.repository == 'earth-system-radiation/rte-rrtmgp' - runs-on: - labels: cscs-ci - strategy: - fail-fast: false - matrix: - config-name: [nvidia-gpu-openacc, cce-cpu-icon-production, cce-gpu-openmp] - fpmodel: [DP, SP] - include: - - config-name: nvidia-gpu-openacc - rte-kernels: accel - compiler-modules: "PrgEnv-nvidia nvidia craype-accel-nvidia60 cdt-cuda/21.09 !cray-libsci_acc" - # Generic accelerator flag - fcflags: "-O3 -acc -Mallocatable=03 -gopt" - - config-name: cce-cpu-icon-production - rte-kernels: default - compiler-modules: "PrgEnv-cray" - # Production flags for Icon model - fcflags: "-hadd_paren -r am -Ktrap=divz,ovf,inv -hflex_mp=intolerant -hfp1 -hnoacc -O1,cache0" - - config-name: cce-gpu-openmp - rte-kernels: accel - compiler-modules: "PrgEnv-cray craype-accel-nvidia60 cdt-cuda/22.05 cudatoolkit/11.2.0_3.39-2.1__gf93aa1c" - # OpenMP flags from Nichols Romero (Argonne) - fcflags: "-hnoacc -homp -O0" - env: - # Core variables: - FC: ftn - FCFLAGS: ${{ matrix.fcflags }} -DRTE_USE_${{ matrix.fpmodel }} - # Make variables: - RRTMGP_ROOT: ${{ github.workspace }} - RRTMGP_DATA: ${{ github.workspace }}/rrtmgp-data - RTE_KERNELS: ${{ matrix.rte-kernels }} - RUN_CMD: "srun -C gpu -A d56 -p cscsci -t 15:00" - FAILURE_THRESHOLD: 7.e-4 - steps: - # - # Checks-out repository under $GITHUB_WORKSPACE - # - - uses: actions/checkout@v3 - # - # Check out data - # - - name: Check out data - uses: actions/checkout@v3 - with: - repository: earth-system-radiation/rrtmgp-data - path: rrtmgp-data - ref: v1.8.2 - # - # Finalize build environment - # - - name: Finalize build environment - run: | - # There are significant limitations on what can go into ${GITHUB_ENV}, - # therefore, we use ${BASH_ENV} but only when necessary: - BASH_ENV="${GITHUB_WORKSPACE}/.bash" - echo "source '${GITHUB_WORKSPACE}/.github/workflows/module_switcher'" >> "${BASH_ENV}" - echo "switch_for_module daint-gpu ${{ matrix.compiler-modules }} cray-netcdf cray-hdf5" >> "${BASH_ENV}" - # Use custom Python environment: - # The environment can be re-generated as follows: - # module load cray-python - # python3 -m venv /scratch/snx3000/rpincus/rte-rrtmgp-python - # /scratch/snx3000/rpincus/rte-rrtmgp-python/bin/pip3 install --upgrade pip - # /scratch/snx3000/rpincus/rte-rrtmgp-python/bin/pip3 install dask[array] netCDF4 numpy xarray - echo 'PATH="/scratch/snx3000/rpincus/rte-rrtmgp-python/bin:${PATH}"' >> "${BASH_ENV}" - # Make bash run the above on startup: - echo "BASH_ENV=${BASH_ENV}" >> "${GITHUB_ENV}" - # Compiler needs more temporary space than normally available: - tmpdir='${{ github.workspace }}/tmp' - mkdir "${tmpdir}" && echo "TMPDIR=${tmpdir}" >> "${GITHUB_ENV}" - # We use the "non-default products" for the tests - # (see https://support.hpe.com/hpesc/public/docDisplay?docId=a00113984en_us&page=Modify_Linking_Behavior_to_Use_Non-default_Libraries.html): - echo 'LD_LIBRARY_PATH="${CRAY_LD_LIBRARY_PATH}:${LD_LIBRARY_PATH}"' >> "${BASH_ENV}" - # SLURM jobs, user home directories and HDF5 file locking are - # incompatible on Daint: - echo 'HDF5_USE_FILE_LOCKING=FALSE' >> "${GITHUB_ENV}" - # - # Build libraries, examples and tests - # - - name: Build libraries - run: | - $FC --version - make -j8 libs - # - # Run examples and tests (expect success) - # - - name: Build and run examples and tests (expect success) - id: run-success - if: matrix.config-name != 'cce-gpu-openmp' - run: make -j8 tests - # - # Run examples and tests (expect failure) - # - - name: Build and run examples and tests (expect failure) - if: steps.run-success.outcome == 'skipped' - run: | - make -j8 tests && { - echo "Unexpected success" - exit 1 - } || echo "Expected failure" - # - # Relax failure thresholds for single precision - # - - name: Relax failure threshold for single precision - if: matrix.fpmodel == 'SP' && steps.run-success.outcome != 'skipped' - run: echo "FAILURE_THRESHOLD=3.5e-1" >> $GITHUB_ENV - # - # Compare the results - # - - name: Compare the results - if: steps.run-success.outcome != 'skipped' - run: make -j8 check diff --git a/.github/workflows/style.yml b/.github/workflows/style.yml new file mode 100644 index 000000000..a9f60a699 --- /dev/null +++ b/.github/workflows/style.yml @@ -0,0 +1,72 @@ +name: Check Style +on: + push: + branches: + - main + - develop + pull_request: + branches-ignore: + - documentation + workflow_dispatch: + +env: + FIND_CMAKE_FILES_CMD: "find '${{ github.workspace }}' -name 'CMakeLists.txt' -o -name '*.cmake'" + +jobs: + Format: + runs-on: ubuntu-22.04 + env: + DEFAULT: '\033[0m' + RED: '\033[0;31m' + GREEN: '\033[0;32m' + FORMAT_PATCH: '${{ github.workspace }}/format.patch' + steps: + - name: Check out code + uses: actions/checkout@v4 + - name: Install Python + uses: actions/setup-python@v5 + with: + python-version: '>=3.8' + - name: Install required tools + run: python -m pip install cmake-format + - name: Format CMake + run: cmake-format -i $(eval "${FIND_CMAKE_FILES_CMD}") + - name: Check if patching is required + id: patch-required + run: | + git -C '${{ github.workspace }}' diff --patch-with-raw > "${FORMAT_PATCH}" + test -s "${FORMAT_PATCH}" && { + printf "${RED}The source code does not meet the format requirements. \ + Please, apply the patch (see artifacts).${DEFAULT}\n" + + printf "${RED}Note that the result of the formatting might depend \ + on the versions of the formatting tools. In this project, whatever \ + formatting this CI job produces if the correct one. If it expects \ + you to reformat parts of the source code that you did not modify, do \ + so in a separate commit, which must not be squashed, and list the \ + commit in the '.git-blame-ignore-revs' file.${DEFAULT}\n" + + exit 1 + } || { + printf "${GREEN}The source code meets the format requirements.${DEFAULT}\n" + rm -rf "${FORMAT_PATCH}" + } + - name: Upload the patch file + if: always() && steps.patch-required.outcome == 'failure' + uses: actions/upload-artifact@v4 + with: + name: format-patch + path: ${{ env.FORMAT_PATCH }} + Lint: + runs-on: ubuntu-22.04 + steps: + - name: Check out code + uses: actions/checkout@v4 + - name: Install Python + uses: actions/setup-python@v5 + with: + python-version: '>=3.8' + - name: Install required tools + run: python -m pip install cmake-format + - name: Lint CMake + run: cmake-lint $(eval "${FIND_CMAKE_FILES_CMD}") diff --git a/.gitignore b/.gitignore index 2ae1d6a51..e32360bf6 100644 --- a/.gitignore +++ b/.gitignore @@ -33,8 +33,14 @@ examples/*/*/*.nc *.html *.gif +# Python virtual environments +.venv*/ + # gh-pages directory public +# build +build/ + # Ruby stuff **/Gemfile.lock diff --git a/.gitlab/common.yml b/.gitlab/common.yml index b8c180085..707122f1c 100644 --- a/.gitlab/common.yml +++ b/.gitlab/common.yml @@ -1,37 +1,33 @@ .dp: variables: - FPMODEL: DP + RTE_ENABLE_SP: OFF FAILURE_THRESHOLD: "7.e-4" .sp: variables: - FPMODEL: SP + RTE_ENABLE_SP: ON FAILURE_THRESHOLD: "3.5e-1" .common: variables: - # Make variables: - MAKEFLAGS: -j8 - RRTMGP_ROOT: ${CI_PROJECT_DIR} - RRTMGP_DATA: ${CI_PROJECT_DIR}/rrtmgp-data - # Convenience variables: - RRTMGP_DATA_REPO: https://github.com/earth-system-radiation/rrtmgp-data.git - RRTMGP_DATA_TAG: v1.8.2 + CMAKE_BUILD_PARALLEL_LEVEL: 8 + VERBOSE: + # TODO: add missing test dependencies and run them in parallel: + # CTEST_PARALLEL_LEVEL: 8 + CTEST_OUTPUT_ON_FAILURE: 1 script: # # Build libraries, examples and tests # - - ${FC} ${VERSION_FCFLAGS} - - make libs + - | + cmake -S . -B build \ + -DCMAKE_BUILD_TYPE=None \ + -DRTE_ENABLE_SP=$RTE_ENABLE_SP \ + -DKERNEL_MODE=$KERNEL_MODE \ + -DBUILD_TESTING=ON \ + -DFAILURE_THRESHOLD=$FAILURE_THRESHOLD + - cmake --build build # - # Check out data + # Run examples, tests and checks # - - git clone --depth 1 ${RRTMGP_DATA_TAG:+--branch "${RRTMGP_DATA_TAG}"} "${RRTMGP_DATA_REPO}" "${RRTMGP_DATA}" - # - # Run examples and tests - # - - make tests - # - # Compare the results - # - - make check + - ctest --test-dir build diff --git a/.gitlab/levante.yml b/.gitlab/levante.yml index 2a0a1a435..677cf4039 100644 --- a/.gitlab/levante.yml +++ b/.gitlab/levante.yml @@ -29,22 +29,13 @@ variables: .nvhpc: variables: - # Core variables: - # FC: /sw/spack-levante/nvhpc-22.5-v4oky3/Linux_x86_64/22.5/compilers/bin/nvfortran FC: /sw/spack-levante/nvhpc-24.9-p7iohv/Linux_x86_64/24.9/compilers/bin/nvfortran - # Convenience variables: - VERSION_FCFLAGS: --version - NFHOME: /sw/spack-levante/netcdf-fortran-4.5.4-syv4qr - NCHOME: /sw/spack-levante/netcdf-c-4.9.0-gc7kgj + NetCDF_Fortran_ROOT: /sw/spack-levante/netcdf-fortran-4.6.1-4wu5wt .nag: variables: - # Core variables: FC: /sw/spack-levante/nag-7.1-lqjbej/bin/nagfor - # Convenience variables: - VERSION_FCFLAGS: -V - NFHOME: /sw/spack-levante/netcdf-fortran-4.5.3-5di6qe - NCHOME: /sw/spack-levante/netcdf-c-4.8.1-vbnli5 + NetCDF_Fortran_ROOT: /sw/spack-levante/netcdf-fortran-4.5.3-5di6qe .common-levante: extends: .common @@ -52,15 +43,11 @@ variables: PYHOME: /sw/spack-levante/mambaforge-22.9.0-2-Linux-x86_64-kptncg # Suppress an irrelevant but annoying error message: PROJ_LIB: ${PYHOME}/share/proj - # Make variables: - FCINCLUDE: -I${NFHOME}/include - LDFLAGS: -L${NFHOME}/lib -L${NCHOME}/lib before_script: - module purge - module load git # Extend the existing environment variables: - export PATH="${PYHOME}/bin:${PATH}" - - export LD_LIBRARY_PATH="${NFHOME}/lib:${NCHOME}/lib:${LD_LIBRARY_PATH-}" # Some tests require a large stack: - ulimit -s unlimited @@ -71,8 +58,8 @@ variables: - .common-levante variables: # Compiler flags used for ICON model: - FCFLAGS: -g -O2 -Mrecursive -Mallocatable=03 -Mstack_arrays -Minfo=accel,inline -acc=gpu,verystrict -gpu=cc80,cuda11.8 -DRTE_USE_${FPMODEL} - RTE_KERNELS: accel + FFLAGS: -g -O2 -Mrecursive -Mallocatable=03 -Mstack_arrays -Minfo=accel,inline -acc=gpu,verystrict -gpu=cc80,cuda12.6 + KERNEL_MODE: accel .nag-cpu: extends: @@ -81,17 +68,17 @@ variables: - .common-levante variables: # Compiler flags used for ICON model: - FCFLAGS: -Wc=/sw/spack-levante/gcc-11.2.0-bcn7mb/bin/gcc -f2008 -colour -w=uep -g -gline -O0 -float-store -nan -Wc,-g -Wc,-pipe -Wc,--param,max-vartrack-size=200000000 -Wc,-mno-fma -C=all -DRTE_USE_CBOOL -DRTE_USE_${FPMODEL} + FFLAGS: -Wc=/sw/spack-levante/gcc-11.2.0-bcn7mb/bin/gcc -f2008 -colour -w=uep -g -gline -O0 -float-store -nan -Wc,-g -Wc,-pipe -Wc,--param,max-vartrack-size=200000000 -Wc,-mno-fma -C=all .nag-cpu-default: extends: .nag-cpu variables: - RTE_KERNELS: default + KERNEL_MODE: default .nag-cpu-accel: extends: .nag-cpu variables: - RTE_KERNELS: accel + KERNEL_MODE: accel nvhpc-gpu-openacc-DP: extends: diff --git a/.gitlab/lumi.yml b/.gitlab/lumi.yml index 9e2c1ad4c..4f351f2e2 100644 --- a/.gitlab/lumi.yml +++ b/.gitlab/lumi.yml @@ -38,10 +38,7 @@ variables: .cce: variables: - # Core variables: FC: ftn - # Convenience variables: - VERSION_FCFLAGS: -V COMPILER_MODULES: PrgEnv-cray cce/16.0.1 craype-x86-milan # @@ -91,8 +88,8 @@ setup-python: - .common-lumi variables: # Compiler flags used for ICON model: - FCFLAGS: -hacc -hadd_paren -Ktrap=divz,ovf,inv -hflex_mp=intolerant -hfp1 -g -DRTE_USE_${FPMODEL} - RTE_KERNELS: accel + FFLAGS: -hacc -hadd_paren -Ktrap=divz,ovf,inv -hflex_mp=intolerant -hfp1 -g + KERNEL_MODE: accel # Convenience variables: EXTRA_COMPILER_MODULES: craype-accel-amd-gfx90a rocm diff --git a/CMakeLists.txt b/CMakeLists.txt new file mode 100644 index 000000000..29513fd1a --- /dev/null +++ b/CMakeLists.txt @@ -0,0 +1,79 @@ +cmake_minimum_required(VERSION 3.18) + +project( + rte-rrtmgp + VERSION 1.8 + LANGUAGES Fortran +) + +option(BUILD_TESTING "Build tests" OFF) + +option(RTE_ENABLE_SP "Enable single-precision floating-point model" OFF) + +set(PREFERRED_KERNEL_MODES "default" "accel" "extern") +set(KERNEL_MODE + "default" + CACHE STRING "Select the kernel mode: ${PREFERRED_KERNEL_MODES}" +) +set_property(CACHE KERNEL_MODE PROPERTY STRINGS ${PREFERRED_KERNEL_MODES}) + +list(APPEND CMAKE_MODULE_PATH ${PROJECT_SOURCE_DIR}/cmake) + +add_compile_options( + $<$:-ffree-line-length-none> +) + +set(CMAKE_Fortran_MODULE_DIRECTORY ${PROJECT_BINARY_DIR}/modules) + +add_subdirectory(rte-kernels) +add_subdirectory(rte-frontend) +add_subdirectory(rrtmgp-kernels) +add_subdirectory(rrtmgp-frontend) + +include(CTest) +if(BUILD_TESTING) + find_package(Python3 REQUIRED COMPONENTS Interpreter) + include(CheckPython3Package) + check_python3_package(numpy) + check_python3_package( + "netCDF4 or h5netcdf+scipy" + CODE "try: + import netCDF4 +except: + import h5netcdf + import scipy +" + ) + check_python3_package( + "xarray>=0.12.2" + CODE "import xarray +exit(tuple(map(int, xarray.__version__.split('.'))) < (0, 12, 2))" + ) + check_python3_package(dask.array) + + find_package(NetCDF_Fortran REQUIRED) + + if(NOT RRTMGP_DATA) + set(RRTMGP_DATA + "${PROJECT_BINARY_DIR}/rrtmgp-data" + CACHE PATH "Path to the RRTMGP data" FORCE + ) + set(RRTMGP_DATA_VERSION "v1.8.2") + include(FetchContent) + message(CHECK_START "Fetching RRTMGP data ${RRTMGP_DATA_VERSION}") + FetchContent_Declare( + rrtmgp-data + GIT_REPOSITORY https://github.com/earth-system-radiation/rrtmgp-data.git + GIT_TAG ${RRTMGP_DATA_VERSION} + SOURCE_DIR ${RRTMGP_DATA} + ) + FetchContent_MakeAvailable(rrtmgp-data) + message(CHECK_PASS "done") + endif() + + add_subdirectory(examples) + add_subdirectory(tests) +else() + # Allow for 'make test' even if the tests are disabled: + enable_testing() +endif() diff --git a/Makefile b/Makefile deleted file mode 100644 index 96c1e2edd..000000000 --- a/Makefile +++ /dev/null @@ -1,28 +0,0 @@ -# -# Top-level Makefile -# -.PHONY: libs tests check -all: libs tests check - -libs: - $(MAKE) -C build $@ - -tests: - $(MAKE) -C tests $@ - $(MAKE) -C examples/rfmip-clear-sky $@ - $(MAKE) -C examples/all-sky $@ - -check: - $(MAKE) -C tests $@ - $(MAKE) -C examples/rfmip-clear-sky $@ - $(MAKE) -C examples/all-sky $@ - -docs: - @cd doc; ./build_documentation.sh - -clean: - $(MAKE) -C build $@ - $(MAKE) -C tests $@ - $(MAKE) -C examples/rfmip-clear-sky $@ - $(MAKE) -C examples/all-sky $@ - rm -rf public diff --git a/build/Makefile b/build/Makefile deleted file mode 100644 index efd0341d2..000000000 --- a/build/Makefile +++ /dev/null @@ -1,68 +0,0 @@ -#!/usr/bin/env make - -RTE_DIR = ../rte-frontend -GAS_OPTICS_DIR = ../gas-optics -RRTMGP_DIR = ../rrtmgp-frontend -RTE_KERNEL_DIR = ../rte-kernels -RRTMGP_KERNEL_DIR = ../rrtmgp-kernels -# -# Compiler variables FC, FCFLAGS must be set in the environment -# -# Make all the libraries though we'll only use the interface + kernels -all: librte.a librrtmgp.a \ - librtekernels.a librtef.a librrtmgpkernels.a librrtmgpf.a -separate-libs: librtekernels.a librtef.a librrtmgpkernels.a librrtmgpf.a -libs: all - -COMPILE = $(FC) $(FCFLAGS) $(FCINCLUDE) -c -%.o: %.F90 - $(COMPILE) $< - -include $(RTE_DIR)/Make.depends -include $(RRTMGP_DIR)/Make.depends -include $(RTE_KERNEL_DIR)/Make.depends -include $(RRTMGP_KERNEL_DIR)/Make.depends - -# -# If using OpenACC/OpenMP files in *-kernels/accel take precendence -# -ifeq ($(RTE_KERNELS), accel) - VPATH = $(RTE_KERNEL_DIR)/accel:$(RRTMGP_KERNEL_DIR)/accel -endif -# -# If using external libraries just compile the interfaces -# -ifeq ($(RTE_KERNELS), extern) - VPATH = $(RTE_KERNEL_DIR)/api:$(RRTMGP_KERNEL_DIR)/api -endif -VPATH += $(RTE_DIR):$(RTE_KERNEL_DIR):$(RRTMGP_DIR):$(RRTMGP_KERNEL_DIR):$(GAS_OPTICS_DIR) - -# -# Complete library - kernels plus Fortran front end -# -librte.a: $(RTE_FORTRAN_KERNELS) $(RTE_FORTRAN_INTERFACE) - ar -rvs librte.a $(RTE_FORTRAN_KERNELS) $(RTE_FORTRAN_INTERFACE) -# -# Library with just the kernels... -# -librtekernels.a: $(RTE_FORTRAN_KERNELS) - ar -rvs librtekernels.a $(RTE_FORTRAN_KERNELS) -# -# ... and just the Fortran front-end -# -librtef.a: $(RTE_FORTRAN_INTERFACE) - ar -rvs librtef.a $(RTE_FORTRAN_INTERFACE) -# -# As with RTE, libraries with Fortran front-end and kernels, separate and combined -# -librrtmgp.a: $(RRTMGP_FORTRAN_KERNELS) $(RRTMGP_FORTRAN_INTERFACE) - ar -rvs librrtmgp.a $(RRTMGP_FORTRAN_KERNELS) $(RRTMGP_FORTRAN_INTERFACE) - -librrtmgpkernels.a: $(RRTMGP_FORTRAN_KERNELS) - ar -rvs librrtmgpkernels.a $(RRTMGP_FORTRAN_KERNELS) - -librrtmgpf.a: $(RRTMGP_FORTRAN_INTERFACE) - ar -rvs librrtmgpf.a $(RRTMGP_FORTRAN_INTERFACE) - -clean: - rm -f *.optrpt *.mod *.o lib*.a diff --git a/cmake/CheckFortranNeedsCBool.cmake b/cmake/CheckFortranNeedsCBool.cmake new file mode 100644 index 000000000..1780d21e6 --- /dev/null +++ b/cmake/CheckFortranNeedsCBool.cmake @@ -0,0 +1,72 @@ +# ~~~ +# check_fortran_needs_c_bool() +# ~~~ +# Checks whether the Fortran compiler requires the c_bool kind of the logical +# type. Sets the cache to the result of the check. +# +function(check_fortran_needs_cbool var) + if(DEFINED ${var}) + return() + endif() + + if(NOT CMAKE_REQUIRED_QUIET) + message(CHECK_START "Checking if the Fortran compiler requires C_BOOL") + endif() + + set(CMAKE_TRY_COMPILE_TARGET_TYPE STATIC_LIBRARY) + + set(check_source_code + " + subroutine conftest_foo(a) bind(C) + use iso_c_binding + implicit none +#ifdef RTE_USE_CBOOL + integer, parameter :: wl = c_bool +#else + integer, parameter :: wl = kind(.true.) +#endif + logical(wl) :: a + end subroutine +" + ) + + set(check_source_file + "${CMAKE_BINARY_DIR}${CMAKE_FILES_DIRECTORY}/CMakeTmp/src.F90" + ) + + unset(check_result) + file(WRITE "${check_source_file}" "${check_source_code}") + try_compile(try_result "${CMAKE_BINARY_DIR}" "${check_source_file}") + if(try_result) + set(check_result FALSE) + else() + file(WRITE "${check_source_file}" "${check_source_code}") + try_compile( + try_result "${CMAKE_BINARY_DIR}" + "${check_source_file}" + COMPILE_DEFINITIONS "-DRTE_USE_CBOOL" + ) + if(try_result) + set(check_result TRUE) + endif() + endif() + + if(NOT CMAKE_REQUIRED_QUIET) + if(NOT DEFINED check_result) + message(CHECK_FAIL "unknown (assuming no)") + elseif(check_result) + message(CHECK_PASS "yes") + else() + message(CHECK_PASS "no") + endif() + endif() + + if(NOT DEFINED check_result) + set(check_result FALSE) + endif() + + set(${var} + "${check_result}" + CACHE BOOL "Whether the Fortran compiler requires CBOOL type" + ) +endfunction() diff --git a/cmake/CheckPython3Package.cmake b/cmake/CheckPython3Package.cmake new file mode 100644 index 000000000..c70241edd --- /dev/null +++ b/cmake/CheckPython3Package.cmake @@ -0,0 +1,43 @@ +# ~~~ +# check_python3_package( +# [CODE ]) +# ~~~ +# Checks whether the Python3 is available by running the with +# ${Python3_EXECUTABLE} (defaults to 'import '). Fails the +# configuration if the result is negative. +# +function(check_python3_package package) + cmake_parse_arguments(PARSE_ARGV 1 arg "" "CODE" "") + + if(DEFINED ${var}) + return() + endif() + + if(NOT CMAKE_REQUIRED_QUIET) + message( + CHECK_START "Checking if the Python3 package ${package} is available" + ) + endif() + + if(NOT arg_CODE) + set(arg_CODE "import ${package}") + endif() + + execute_process( + COMMAND ${Python3_EXECUTABLE} -c "${arg_CODE}" + RESULT_VARIABLE exit_status + OUTPUT_QUIET ERROR_QUIET + ) + + if(NOT CMAKE_REQUIRED_QUIET) + if(NOT exit_status) + message(CHECK_PASS "yes") + else() + message(CHECK_FAIL "no") + endif() + endif() + + if(exit_status) + message(FATAL_ERROR "Required Python3 package ${package} is not available") + endif() +endfunction() diff --git a/cmake/FindNetCDF_Fortran.cmake b/cmake/FindNetCDF_Fortran.cmake new file mode 100644 index 000000000..7dd8da726 --- /dev/null +++ b/cmake/FindNetCDF_Fortran.cmake @@ -0,0 +1,19 @@ +find_library( + NetCDF_Fortran_LIBRARY + NAMES netcdff + DOC "NetCDF-Fortran library" +) +mark_as_advanced(NetCDF_Fortran_LIBRARY) + +find_path( + NetCDF_Fortran_INCLUDE_DIR + NAMES netcdf.mod NETCDF.mod + DOC "NetCDF_Fortran include directory" +) +mark_as_advanced(NetCDF_Fortran_INCLUDE_DIR) + +include(FindPackageHandleStandardArgs) +find_package_handle_standard_args( + NetCDF_Fortran + REQUIRED_VARS NetCDF_Fortran_LIBRARY NetCDF_Fortran_INCLUDE_DIR +) diff --git a/doc/jekyll_site/how-tos/build-and-test.md b/doc/jekyll_site/how-tos/build-and-test.md index 07b4dc186..bec95a35b 100644 --- a/doc/jekyll_site/how-tos/build-and-test.md +++ b/doc/jekyll_site/how-tos/build-and-test.md @@ -5,22 +5,26 @@ title: "How to build and run tests" How to build the libraries, tests, and examples, run the tests, and verify the results ## In a nutshell -In the root directory: -- `make libs` makes the RTE and RRTMGP libraries, the unit tests, and the examples -- `make tests` runs the tests -- `make check` uses Python to verify results against reference calculations -- `make` invoked without a target in the top level attempts all three steps. +RTE+RRTMGP uses `CMake`. In the root directory: +`cmake -S . -B build` will guide you through configuration options. + +Environment variables can also be set and passed to `CMake` as in this example, which +builds and runs the tests: + +` +cmake -S . -B build \ + -DCMAKE_Fortran_COMPILER=$FC \ + -DCMAKE_Fortran_FLAGS=$FCFLAGS \ + -DRRTMGP_DATA_VERSION=$RRTMGP_DATA_VERSION \ + -DPRECISION=$FP_MODEL \ + -DUSE_C_BOOL=$RTE_CBOOL \ + -DKERNEL_MODE=$RTE_KERNELS \ + -DENABLE_TESTS=ON \ + -DFAILURE_THRESHOLD=$FAILURE_THRESHOLD +` Evaluating the results of the tests requires `Python` and the packages described in `environment*.yml`. -## Building and testing using the handbuilt Makefiles - -Before using the Makefiles supplied with the `RTE+RRTMGP` repository, the environment variables `FC` and -`FCFLAGS`, identifying the Fortran compiler and flags passed to it, need to be set. - -To build any of the examples in `examples/` or `tests` the locations of the C and Fortran netCDF libraries and the -location of the netCDF Fortran module file (`netcdf.mod`) must be in the search path. -Non-standard paths can also be added via macros `FCINCLUDE` and/or `LDFLAGS`. ## Building and testing using (Gnu) autotools diff --git a/environment-dev.yml b/environment-dev.yml index b9fa161d9..5b46be5b8 100644 --- a/environment-dev.yml +++ b/environment-dev.yml @@ -19,6 +19,8 @@ dependencies: - colorcet - gfortran - netcdf-fortran + - cmake + - ninja variables: FC: gfortran # Debugging flags below diff --git a/environment-noplots.yml b/environment-noplots.yml index dfa6536fc..50a628def 100644 --- a/environment-noplots.yml +++ b/environment-noplots.yml @@ -2,10 +2,13 @@ # Python modules below are needed to run tests and check results # name: rte_rrtmgp_test_noplots - +channels: + - conda-forge + - nodefaults dependencies: - python=3.11 - netcdf4 - xarray - dask - numpy + - cmake diff --git a/examples/CMakeLists.txt b/examples/CMakeLists.txt new file mode 100644 index 000000000..4f96a3e62 --- /dev/null +++ b/examples/CMakeLists.txt @@ -0,0 +1,31 @@ +if(RTE_ENABLE_SP) + set(default_FAILURE_THRESHOLD "3.5e-1") +else() + set(default_FAILURE_THRESHOLD "7.e-4") +endif() + +set(FAILURE_THRESHOLD + "${default_FAILURE_THRESHOLD}" + CACHE STRING "Default failure threshold for tests" +) + +set(CMAKE_Fortran_MODULE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/modules) + +add_library( + examples_utils STATIC # cmake-format: sort + mo_garand_atmos_io.F90 mo_load_coefficients.F90 mo_simple_netcdf.F90 +) + +target_include_directories( + examples_utils + PUBLIC + $:${CMAKE_Fortran_MODULE_DIRECTORY}>> + ${NetCDF_Fortran_INCLUDE_DIR} +) + +target_link_libraries( + examples_utils PUBLIC rrtmgp rte ${NetCDF_Fortran_LIBRARY} +) + +add_subdirectory(all-sky) +add_subdirectory(rfmip-clear-sky) diff --git a/examples/all-sky/CMakeLists.txt b/examples/all-sky/CMakeLists.txt new file mode 100644 index 000000000..62a3e112c --- /dev/null +++ b/examples/all-sky/CMakeLists.txt @@ -0,0 +1,75 @@ +set(TEST_INPUTS + ${RRTMGP_DATA}/examples/all-sky/reference/rrtmgp-allsky-lw.nc + ${RRTMGP_DATA}/examples/all-sky/reference/rrtmgp-allsky-sw.nc + ${RRTMGP_DATA}/examples/all-sky/reference/rrtmgp-allsky-lw-no-aerosols.nc + ${RRTMGP_DATA}/examples/all-sky/reference/rrtmgp-allsky-sw-no-aerosols.nc +) + +add_custom_target( + all_sky_test_inputs ALL + COMMAND + ${CMAKE_COMMAND} -E copy_if_different ${TEST_INPUTS} + ${CMAKE_CURRENT_BINARY_DIR}/ + COMMENT "Copying required test input files" +) + +add_library( + all_sky_utils STATIC # cmake-format: sort + mo_load_aerosol_coefficients.F90 mo_load_cloud_coefficients.F90 +) + +target_link_libraries(all_sky_utils PUBLIC examples_utils) + +add_executable(rrtmgp_allsky rrtmgp_allsky.F90) +target_link_libraries(rrtmgp_allsky PRIVATE all_sky_utils) +add_dependencies(rrtmgp_allsky all_sky_test_inputs) + +add_test( + NAME allsky_test_lw + COMMAND + rrtmgp_allsky 24 72 1 rrtmgp-allsky-lw.nc + ${RRTMGP_DATA}/rrtmgp-gas-lw-g256.nc ${RRTMGP_DATA}/rrtmgp-clouds-lw.nc + ${RRTMGP_DATA}/rrtmgp-aerosols-merra-lw.nc +) + +add_test( + NAME allsky_test_sw + COMMAND + rrtmgp_allsky 24 72 1 rrtmgp-allsky-sw.nc + ${RRTMGP_DATA}/rrtmgp-gas-sw-g224.nc ${RRTMGP_DATA}/rrtmgp-clouds-sw.nc + ${RRTMGP_DATA}/rrtmgp-aerosols-merra-sw.nc +) + +add_test( + NAME allsky_test_lw_no_aerosols + COMMAND + rrtmgp_allsky 24 72 1 rrtmgp-allsky-lw-no-aerosols.nc + ${RRTMGP_DATA}/rrtmgp-gas-lw-g256.nc ${RRTMGP_DATA}/rrtmgp-clouds-lw.nc +) + +add_test( + NAME allsky_test_sw_no_aerosols + COMMAND + rrtmgp_allsky 24 72 1 rrtmgp-allsky-sw-no-aerosols.nc + ${RRTMGP_DATA}/rrtmgp-gas-sw-g224.nc ${RRTMGP_DATA}/rrtmgp-clouds-sw.nc +) + +add_test( + NAME check_allsky_lw_sw + COMMAND + ${Python3_EXECUTABLE} ${CMAKE_SOURCE_DIR}/examples/compare-to-reference.py + --ref_dir ${RRTMGP_DATA}/examples/all-sky/reference --tst_dir + ${CMAKE_CURRENT_BINARY_DIR} --variables lw_flux_up lw_flux_dn sw_flux_up + sw_flux_dn sw_flux_dir --file_names rrtmgp-allsky-lw.nc rrtmgp-allsky-sw.nc + --failure_threshold ${FAILURE_THRESHOLD} +) + +add_test( + NAME check_allsky_no_aerosols_lw_sw + COMMAND + ${Python3_EXECUTABLE} ${CMAKE_SOURCE_DIR}/examples/compare-to-reference.py + --ref_dir ${RRTMGP_DATA}/examples/all-sky/reference --tst_dir + ${CMAKE_CURRENT_BINARY_DIR} --variables lw_flux_up lw_flux_dn sw_flux_up + sw_flux_dn sw_flux_dir --file_names rrtmgp-allsky-lw-no-aerosols.nc + rrtmgp-allsky-sw-no-aerosols.nc --failure_threshold ${FAILURE_THRESHOLD} +) diff --git a/examples/all-sky/Makefile b/examples/all-sky/Makefile deleted file mode 100644 index 225946e31..000000000 --- a/examples/all-sky/Makefile +++ /dev/null @@ -1,68 +0,0 @@ -#!/usr/bin/env make -# -# Location of RTE+RRTMGP libraries, module files. -# -RRTMGP_ROOT ?= ../.. -RRTMGP_BUILD = $(RRTMGP_ROOT)/build -# -# RRTMGP library, module files -# -LDFLAGS += -L$(RRTMGP_BUILD) -LIBS += -lrrtmgp -lrte -FCINCLUDE += -I$(RRTMGP_BUILD) - -# netcdf Fortran module files has to be in the search path or added via environment variable FCINCLUDE e.g. -#FCINCLUDE += -I$(NFHOME)/include - -# netcdf C and Fortran libraries have to be in the search path or added via environment variable LDFLAGS e.g. -#LDFLAGS += -L$(NFHOME)/lib -L$(NCHOME)/lib -LIBS += -lnetcdff - -VPATH = ../:$(RRTMGP_ROOT)/rrtmgp-frontend # Needed for cloud_optics and aerosol_optics - -# Compilation rules -%.o: %.F90 - $(FC) $(FCFLAGS) $(FCINCLUDE) -c $< -%: %.o - $(FC) $(FCFLAGS) -o $@ $^ $(LDFLAGS) $(LIBS) - -# -# Extra sources -- extensions to RRTMGP classes, shared infrastructure, local sources -# -ADDITIONS = mo_load_coefficients.o mo_simple_netcdf.o -ADDITIONS += mo_cloud_optics_rrtmgp.o mo_load_cloud_coefficients.o -ADDITIONS += mo_aerosol_optics_rrtmgp_merra.o mo_load_aerosol_coefficients.o - -# -# Targets -# -all: rrtmgp_allsky - -rrtmgp_allsky: $(ADDITIONS) rrtmgp_allsky.o - -rrtmgp_allsky.o: $(ADDITIONS) rrtmgp_allsky.F90 - -mo_cloud_optics_rrtmgp.o: mo_cloud_optics_rrtmgp.F90 -mo_aerosol_optics_rrtmgp_merra.o: mo_aerosol_optics_rrtmgp_merra.F90 -mo_load_coefficients.o: mo_simple_netcdf.o mo_load_coefficients.F90 -mo_load_cloud_coefficients.o: mo_simple_netcdf.o mo_cloud_optics_rrtmgp.o mo_load_cloud_coefficients.F90 -mo_load_aerosol_coefficients.o: mo_simple_netcdf.o mo_aerosol_optics_rrtmgp_merra.o mo_load_aerosol_coefficients.F90 - -# The default location of the input data: -RRTMGP_DATA ?= $(RRTMGP_ROOT)/rrtmgp-data -# Make it available to the scripts: -export RRTMGP_DATA - -tests: rrtmgp_allsky - $(RUN_CMD) bash all_tests.sh - -check: - $${PYTHON-python} ${RRTMGP_ROOT}/examples/compare-to-reference.py --ref_dir ${RRTMGP_DATA}/examples/all-sky/reference --tst_dir ${RRTMGP_ROOT}/examples/all-sky \ - --var lw_flux_up lw_flux_dn sw_flux_up sw_flux_dn sw_flux_dir \ - --file rrtmgp-allsky-lw.nc rrtmgp-allsky-sw.nc - $${PYTHON-python} ${RRTMGP_ROOT}/examples/compare-to-reference.py --ref_dir ${RRTMGP_DATA}/examples/all-sky/reference --tst_dir ${RRTMGP_ROOT}/examples/all-sky \ - --var lw_flux_up lw_flux_dn sw_flux_up sw_flux_dn sw_flux_dir \ - --file rrtmgp-allsky-lw-no-aerosols.nc rrtmgp-allsky-sw-no-aerosols.nc - -clean: - -rm rrtmgp_allsky *.o *.optrpt ../*.optrpt *.mod *.nc diff --git a/examples/all-sky/all_tests.sh b/examples/all-sky/all_tests.sh deleted file mode 100644 index 61a2bceb7..000000000 --- a/examples/all-sky/all_tests.sh +++ /dev/null @@ -1,9 +0,0 @@ -set -eux -./rrtmgp_allsky 24 72 1 rrtmgp-allsky-lw.nc \ - ${RRTMGP_DATA}/rrtmgp-gas-lw-g256.nc ${RRTMGP_DATA}/rrtmgp-clouds-lw.nc ${RRTMGP_DATA}/rrtmgp-aerosols-merra-lw.nc -./rrtmgp_allsky 24 72 1 rrtmgp-allsky-sw.nc \ - ${RRTMGP_DATA}/rrtmgp-gas-sw-g224.nc ${RRTMGP_DATA}/rrtmgp-clouds-sw.nc ${RRTMGP_DATA}/rrtmgp-aerosols-merra-sw.nc -./rrtmgp_allsky 24 72 1 rrtmgp-allsky-lw-no-aerosols.nc \ - ${RRTMGP_DATA}/rrtmgp-gas-lw-g256.nc ${RRTMGP_DATA}/rrtmgp-clouds-lw.nc -./rrtmgp_allsky 24 72 1 rrtmgp-allsky-sw-no-aerosols.nc \ - ${RRTMGP_DATA}/rrtmgp-gas-sw-g224.nc ${RRTMGP_DATA}/rrtmgp-clouds-sw.nc \ No newline at end of file diff --git a/examples/rfmip-clear-sky/CMakeLists.txt b/examples/rfmip-clear-sky/CMakeLists.txt new file mode 100644 index 000000000..6cfd6bba3 --- /dev/null +++ b/examples/rfmip-clear-sky/CMakeLists.txt @@ -0,0 +1,59 @@ +set(TEST_INPUTS + # cmake-format: sort + ${RRTMGP_DATA}/examples/rfmip-clear-sky/inputs/multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc + ${RRTMGP_DATA}/examples/rfmip-clear-sky/inputs/rld_Efx_RTE-RRTMGP-181204_rad-irf_r1i1p1f1_gn.nc + ${RRTMGP_DATA}/examples/rfmip-clear-sky/inputs/rlu_Efx_RTE-RRTMGP-181204_rad-irf_r1i1p1f1_gn.nc + ${RRTMGP_DATA}/examples/rfmip-clear-sky/inputs/rsd_Efx_RTE-RRTMGP-181204_rad-irf_r1i1p1f1_gn.nc + ${RRTMGP_DATA}/examples/rfmip-clear-sky/inputs/rsu_Efx_RTE-RRTMGP-181204_rad-irf_r1i1p1f1_gn.nc +) + +add_custom_target( + rfmip_clear_sky_test_inputs ALL + COMMAND + ${CMAKE_COMMAND} -E copy_if_different ${TEST_INPUTS} + ${CMAKE_CURRENT_BINARY_DIR}/ + COMMENT "Copying required test input files" +) + +add_library(rfmip_clear_utils STATIC mo_rfmip_io.F90) +target_link_libraries(rfmip_clear_utils PUBLIC examples_utils) + +foreach( + test_executable IN + ITEMS # cmake-format: sort + rrtmgp_rfmip_lw + rrtmgp_rfmip_sw +) + add_executable(${test_executable} ${test_executable}.F90) + target_link_libraries(${test_executable} PRIVATE rfmip_clear_utils) + add_dependencies(${test_executable} rfmip_clear_sky_test_inputs) +endforeach() + +add_test( + NAME rfmip_test_lw + COMMAND + rrtmgp_rfmip_lw 8 + multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc + ${RRTMGP_DATA}/rrtmgp-gas-lw-g256.nc +) + +add_test( + NAME rfmip_test_sw + COMMAND + rrtmgp_rfmip_sw 8 + multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc + ${RRTMGP_DATA}/rrtmgp-gas-sw-g224.nc +) + +add_test( + NAME check_rfmip_lw_sw + COMMAND + ${Python3_EXECUTABLE} ${CMAKE_SOURCE_DIR}/examples/compare-to-reference.py + --ref_dir ${RRTMGP_DATA}/examples/rfmip-clear-sky/reference --tst_dir + ${CMAKE_CURRENT_BINARY_DIR} --variables rld rlu rsd rsu --file_names + rld_Efx_RTE-RRTMGP-181204_rad-irf_r1i1p1f1_gn.nc + rlu_Efx_RTE-RRTMGP-181204_rad-irf_r1i1p1f1_gn.nc + rsd_Efx_RTE-RRTMGP-181204_rad-irf_r1i1p1f1_gn.nc + rsu_Efx_RTE-RRTMGP-181204_rad-irf_r1i1p1f1_gn.nc --failure_threshold + ${FAILURE_THRESHOLD} +) diff --git a/examples/rfmip-clear-sky/Makefile b/examples/rfmip-clear-sky/Makefile deleted file mode 100644 index 9d60aab9a..000000000 --- a/examples/rfmip-clear-sky/Makefile +++ /dev/null @@ -1,75 +0,0 @@ -#!/usr/bin/env make -# -# Location of RTE+RRTMGP libraries, module files. -# -RRTMGP_ROOT ?= ../.. -RRTMGP_BUILD = $(RRTMGP_ROOT)/build -# -# RRTMGP library, module files -# -LDFLAGS += -L$(RRTMGP_BUILD) -LIBS += -lrrtmgp -lrte -FCINCLUDE += -I$(RRTMGP_BUILD) - -# netcdf Fortran module files has to be in the search path or added via environment variable FCINCLUDE e.g. -#FCINCLUDE += -I$(NFHOME)/include - -# netcdf C and Fortran libraries have to be in the search path or added via environment variable LDFLAGS e.g. -#LDFLAGS += -L$(NFHOME)/lib -L$(NCHOME)/lib -LIBS += -lnetcdff - -VPATH = ../ - -# Compilation rules -%.o: %.F90 - $(FC) $(FCFLAGS) $(FCINCLUDE) -c $< - -%: %.o - $(FC) $(FCFLAGS) -o $@ $^ $(LDFLAGS) $(LIBS) - -# Required netCDF files are in $RRTMGP_DATA -%.nc: - cp ${RRTMGP_DATA}/examples/rfmip-clear-sky/inputs/$@ . - - -# -# Ancillary codes -# -ADDITIONS = mo_simple_netcdf.o mo_rfmip_io.o mo_load_coefficients.o - -all: rrtmgp_rfmip_lw rrtmgp_rfmip_sw - -rrtmgp_rfmip_lw: rrtmgp_rfmip_lw.o $(ADDITIONS) - -rrtmgp_rfmip_lw.o: rrtmgp_rfmip_lw.F90 $(ADDITIONS) - -rrtmgp_rfmip_sw: rrtmgp_rfmip_sw.o $(ADDITIONS) - -rrtmgp_rfmip_sw.o: rrtmgp_rfmip_sw.F90 $(ADDITIONS) - -mo_rfmip_io.o: mo_rfmip_io.F90 mo_simple_netcdf.o - -mo_load_coefficients.o: mo_load_coefficients.F90 mo_simple_netcdf.o - -# The default location of the input data: -RRTMGP_DATA ?= $(RRTMGP_ROOT)/rrtmgp-data - -tests: rrtmgp_rfmip_lw rrtmgp_rfmip_sw \ - multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc \ - rld_Efx_RTE-RRTMGP-181204_rad-irf_r1i1p1f1_gn.nc rlu_Efx_RTE-RRTMGP-181204_rad-irf_r1i1p1f1_gn.nc \ - rsd_Efx_RTE-RRTMGP-181204_rad-irf_r1i1p1f1_gn.nc rsu_Efx_RTE-RRTMGP-181204_rad-irf_r1i1p1f1_gn.nc - $(RUN_CMD) ./rrtmgp_rfmip_lw 8 multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc ${RRTMGP_DATA}/rrtmgp-gas-lw-g256.nc - $(RUN_CMD) ./rrtmgp_rfmip_sw 8 multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc ${RRTMGP_DATA}/rrtmgp-gas-sw-g224.nc - -# The default failure threshold: -FAILURE_THRESHOLD ?= 7.e-4 -# Make it available to the scripts: -export FAILURE_THRESHOLD - -check: - $${PYTHON-python} ${RRTMGP_ROOT}/examples/compare-to-reference.py \ - --ref_dir ${RRTMGP_DATA}/examples/rfmip-clear-sky/reference --tst_dir ${RRTMGP_ROOT}/examples/rfmip-clear-sky \ - --var rld rlu rsd rsu --file r??_Efx_RTE-RRTMGP-181204_rad-irf_r1i1p1f1_gn.nc - -clean: - -rm rrtmgp_rfmip_sw rrtmgp_rfmip_lw *.o *.mod *.optrpt *.nc diff --git a/rrtmgp-frontend/CMakeLists.txt b/rrtmgp-frontend/CMakeLists.txt new file mode 100644 index 000000000..3af68510d --- /dev/null +++ b/rrtmgp-frontend/CMakeLists.txt @@ -0,0 +1,24 @@ +set(gas_optics_source_dir ${PROJECT_SOURCE_DIR}/gas-optics) + +add_library( + rrtmgp STATIC # cmake-format: sort + ${gas_optics_source_dir}/mo_gas_concentrations.F90 + ${gas_optics_source_dir}/mo_gas_optics.F90 + ${gas_optics_source_dir}/mo_gas_optics_constants.F90 + ${gas_optics_source_dir}/mo_gas_optics_util_string.F90 + mo_aerosol_optics_rrtmgp_merra.F90 + mo_cloud_optics_rrtmgp.F90 + mo_gas_optics_rrtmgp.F90 +) + +target_include_directories( + rrtmgp + PUBLIC + $:${CMAKE_Fortran_MODULE_DIRECTORY}>> +) + +target_link_libraries( + rrtmgp + PUBLIC rrtmgpkernels + PRIVATE rte +) diff --git a/rrtmgp-frontend/Make.depends b/rrtmgp-frontend/Make.depends deleted file mode 100644 index 1c70a9a08..000000000 --- a/rrtmgp-frontend/Make.depends +++ /dev/null @@ -1,47 +0,0 @@ -RRTMGP_FORTRAN_INTERFACE = \ - mo_gas_optics_util_string.o \ - mo_gas_optics_constants.o \ - mo_gas_concentrations.o \ - mo_gas_optics.o \ - mo_gas_optics_rrtmgp.o - -##### -# RRTMGP: RRTM for GCM Applications - Parallel -# Built on top of RTE, requiring mo_rte_kind.o, mo_rte_util_array.o, mo_rte_util_array_validation.o, mo_optical_props.o -# -# Physical constants -# -mo_gas_optics_constants.o: $(RTE_FORTRAN_INTERFACE) mo_gas_optics_constants.F90 -# -# Utility -# -mo_gas_optics_util_string.o: mo_gas_optics_util_string.F90 - -# -# Gas concentrations - used by gas optics base class -# -mo_gas_concentrations.o: $(RTE_FORTRAN_INTERFACE) mo_gas_concentrations.F90 - -# -# Gas optics base class -# -mo_gas_optics.o: \ - $(RTE_FORTRAN_INTERFACE) mo_gas_concentrations.o \ - mo_gas_optics.F90 - -# -# RRTMGP gas optics -# -mo_gas_optics_rrtmgp.o: \ - $(RTE_FORTRAN_INTERFACE) \ - mo_gas_optics_constants.o mo_gas_optics_util_string.o \ - mo_gas_concentrations.o \ - mo_gas_optics.o \ - mo_gas_optics_rrtmgp_kernels.o mo_gas_optics_rrtmgp.F90 - -# -# RRTMGP cloud optics -# -mo_cloud_optics_rrtmgp.o: \ - $(RTE_FORTRAN_INTERFACE) \ - mo_cloud_optics_rrtmgp_kernels.o mo_cloud_optics_rrtmgp.F90 diff --git a/rrtmgp-kernels/CMakeLists.txt b/rrtmgp-kernels/CMakeLists.txt new file mode 100644 index 000000000..e85c187cf --- /dev/null +++ b/rrtmgp-kernels/CMakeLists.txt @@ -0,0 +1,38 @@ +add_library(rrtmgpkernels OBJECT) + +if(KERNEL_MODE STREQUAL "extern") + target_sources( + rrtmgpkernels + PRIVATE # cmake-format: sort + api/mo_cloud_optics_rrtmgp_kernels.F90 + api/mo_gas_optics_rrtmgp_kernels.F90 + api/rrtmgp_kernels.h + ) +else() + target_sources( + rrtmgpkernels + PRIVATE # cmake-format: sort + mo_cloud_optics_rrtmgp_kernels.F90 + ) + if(KERNEL_MODE STREQUAL "accel") + target_sources( + rrtmgpkernels + PRIVATE # cmake-format: sort + accel/mo_gas_optics_rrtmgp_kernels.F90 + ) + else() + target_sources( + rrtmgpkernels + PRIVATE # cmake-format: sort + mo_gas_optics_rrtmgp_kernels.F90 + ) + endif() +endif() + +target_include_directories( + rrtmgpkernels + PUBLIC + $:${CMAKE_Fortran_MODULE_DIRECTORY}>> +) + +target_link_libraries(rrtmgpkernels PRIVATE rte) diff --git a/rrtmgp-kernels/Make.depends b/rrtmgp-kernels/Make.depends deleted file mode 100644 index 0953a6247..000000000 --- a/rrtmgp-kernels/Make.depends +++ /dev/null @@ -1,10 +0,0 @@ -RRTMGP_FORTRAN_KERNELS = mo_gas_optics_rrtmgp_kernels.o mo_cloud_optics_rrtmgp_kernels.o - -# -# Gas optics -# -mo_gas_optics_rrtmgp_kernels.o: $(RTE_FORTRAN_KERNELS) mo_gas_optics_rrtmgp_kernels.F90 -# -# Cloud optics -# -mo_cloud_optics_rrtmgp_kernels.o: $(RTE_FORTRAN_KERNELS) mo_cloud_optics_rrtmgp_kernels.F90 diff --git a/rte-frontend/CMakeLists.txt b/rte-frontend/CMakeLists.txt new file mode 100644 index 000000000..3a313038b --- /dev/null +++ b/rte-frontend/CMakeLists.txt @@ -0,0 +1,18 @@ +add_library( + rte STATIC # cmake-format: sort + mo_fluxes.F90 + mo_optical_props.F90 + mo_rte_config.F90 + mo_rte_lw.F90 + mo_rte_sw.F90 + mo_rte_util_array_validation.F90 + mo_source_functions.F90 +) + +target_include_directories( + rte + PUBLIC + $:${CMAKE_Fortran_MODULE_DIRECTORY}>> +) + +target_link_libraries(rte PUBLIC rtekernels) diff --git a/rte-frontend/Make.depends b/rte-frontend/Make.depends deleted file mode 100644 index 5b5b098a5..000000000 --- a/rte-frontend/Make.depends +++ /dev/null @@ -1,51 +0,0 @@ -RTE_FORTRAN_INTERFACE = \ - mo_rte_kind.o \ - mo_rte_config.o \ - mo_rte_util_array_validation.o \ - mo_optical_props.o \ - mo_source_functions.o \ - mo_fluxes.o \ - mo_rte_lw.o \ - mo_rte_sw.o - -################################## -# RTE - Radiative transfer for energetics -################################## -# -# -mo_rte_config.o: mo_rte_config.F90 mo_rte_kind.o -# -# -mo_rte_util_array_validation.o: mo_rte_util_array_validation.F90 mo_rte_kind.o -# -# Optical properties -# -mo_optical_props.o: mo_rte_kind.o mo_rte_util_array_validation.o mo_optical_props_kernels.o mo_optical_props.F90 -# -# Source functions -# -mo_source_functions.o: mo_rte_kind.o mo_optical_props.o mo_source_functions.F90 -# -# Flux reduction -# -mo_fluxes.o: mo_rte_kind.o mo_fluxes_broadband_kernels.o mo_rte_config.o mo_optical_props.o mo_rte_util_array_validation.o mo_fluxes.F90 - -mo_rte_lw.o: mo_rte_kind.o \ - mo_rte_config.o \ - mo_rte_util_array.o \ - mo_rte_util_array_validation.o \ - mo_optical_props.o \ - mo_source_functions.o \ - mo_fluxes.o \ - mo_rte_solver_kernels.o \ - mo_rte_lw.F90 - -mo_rte_sw.o: mo_rte_kind.o \ - mo_rte_config.o \ - mo_rte_util_array.o \ - mo_rte_util_array_validation.o \ - mo_optical_props.o \ - mo_source_functions.o \ - mo_fluxes.o \ - mo_rte_solver_kernels.o \ - mo_rte_sw.F90 diff --git a/rte-kernels/CMakeLists.txt b/rte-kernels/CMakeLists.txt new file mode 100644 index 000000000..d7e4a75a4 --- /dev/null +++ b/rte-kernels/CMakeLists.txt @@ -0,0 +1,51 @@ +add_library(rtekernels OBJECT mo_rte_kind.F90) + +if(KERNEL_MODE STREQUAL "extern") + target_sources( + rtekernels + PRIVATE # cmake-format: sort + api/mo_fluxes_broadband_kernels.F90 + api/mo_optical_props_kernels.F90 + api/mo_rte_solver_kernels.F90 + api/mo_rte_util_array.F90 + api/rte_kernels.h + api/rte_types.h + ) +else() + target_sources( + rtekernels + PRIVATE # cmake-format: sort + mo_fluxes_broadband_kernels.F90 + mo_rte_util_array.F90 + ) + if(KERNEL_MODE STREQUAL "accel") + target_sources( + rtekernels + PRIVATE # cmake-format: sort + accel/mo_optical_props_kernels.F90 + accel/mo_rte_solver_kernels.F90 + ) + else() + target_sources( + rtekernels + PRIVATE # cmake-format: sort + mo_optical_props_kernels.F90 + mo_rte_solver_kernels.F90 + ) + endif() +endif() + +include(CheckFortranNeedsCBool) +check_fortran_needs_cbool(RTE_USE_C_BOOL) + +target_compile_definitions( + rtekernels + PRIVATE $<$:RTE_USE_SP> + $<$:RTE_USE_CBOOL> +) + +target_include_directories( + rtekernels + PUBLIC + $:${CMAKE_Fortran_MODULE_DIRECTORY}>> +) diff --git a/rte-kernels/Make.depends b/rte-kernels/Make.depends deleted file mode 100644 index 6a8911e09..000000000 --- a/rte-kernels/Make.depends +++ /dev/null @@ -1,27 +0,0 @@ -RTE_FORTRAN_KERNELS = \ - mo_rte_kind.o \ - mo_rte_util_array.o \ - mo_rte_solver_kernels.o \ - mo_optical_props_kernels.o \ - mo_fluxes_broadband_kernels.o \ - -# -# Array utilities -# -mo_rte_util_array.o: mo_rte_kind.o mo_rte_util_array.F90 - -# -# Optical properties -# -mo_optical_props_kernels.o: mo_rte_kind.o mo_optical_props_kernels.F90 - -# -# Flux reduction -# -mo_fluxes_broadband_kernels.o : mo_rte_kind.o mo_fluxes_broadband_kernels.F90 - -# -# Radiative transfer -# -mo_rte_solver_kernels.o: mo_rte_kind.o mo_rte_util_array.o mo_rte_solver_kernels.F90 - diff --git a/rte-frontend/mo_rte_kind.F90 b/rte-kernels/mo_rte_kind.F90 similarity index 100% rename from rte-frontend/mo_rte_kind.F90 rename to rte-kernels/mo_rte_kind.F90 diff --git a/setup.sh b/setup.sh new file mode 100755 index 000000000..66bb3a651 --- /dev/null +++ b/setup.sh @@ -0,0 +1,23 @@ +rm -rf build +# conda --version +# conda env create -f environment-dev.yml + +FC=gfortran +FFLAGS='-ffree-line-length-none -m64 -std=f2008 -march=native -fbounds-check -fmodule-private -fimplicit-none -finit-real=nan' +RTE_ENABLE_SP=OFF +KERNEL_MODE=default +FAILURE_THRESHOLD='7.e-4' + +cmake -S . -B build -G "Ninja" \ + -DCMAKE_Fortran_COMPILER=$FC \ + -DCMAKE_Fortran_FLAGS="$FFLAGS" \ + -DRTE_ENABLE_SP=$RTE_ENABLE_SP \ + -DKERNEL_MODE=$KERNEL_MODE \ + -DBUILD_TESTING=ON \ + -DFAILURE_THRESHOLD=$FAILURE_THRESHOLD \ + -DCMAKE_BUILD_TYPE=Release + +# cmake --build build --target all --parallel + +# The --test-dir option is available only starting CMake 3.20: +# ctest -V --test-dir build diff --git a/tests/CMakeLists.txt b/tests/CMakeLists.txt new file mode 100644 index 000000000..6f92e3281 --- /dev/null +++ b/tests/CMakeLists.txt @@ -0,0 +1,114 @@ +set(TEST_INPUTS + ${RRTMGP_DATA}/examples/rfmip-clear-sky/inputs/multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc +) + +add_custom_target( + tests_test_inputs ALL + COMMAND + ${CMAKE_COMMAND} -E copy_if_different ${TEST_INPUTS} + ${CMAKE_CURRENT_BINARY_DIR}/ + COMMENT "Copying required test input files" +) + +set(CMAKE_Fortran_MODULE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/modules) + +set(extensions_source_dir ${PROJECT_SOURCE_DIR}/extensions) + +add_library( + test_utils STATIC # cmake-format: sort + ${extensions_source_dir}/mo_compute_bc.F90 + ${extensions_source_dir}/mo_heating_rates.F90 + ${extensions_source_dir}/mo_rrtmgp_clr_all_sky.F90 + ${extensions_source_dir}/mo_zenith_angle_spherical_correction.F90 + ${extensions_source_dir}/solar_variability/mo_solar_variability.F90 + mo_gas_optics_defs_rrtmgp.F90 + mo_rcemip_profiles.F90 + mo_testing_io.F90 + mo_testing_utils.F90 +) + +target_include_directories( + test_utils + PUBLIC + $:${CMAKE_Fortran_MODULE_DIRECTORY}>> + ${NetCDF_Fortran_INCLUDE_DIR} +) + +target_link_libraries(test_utils PUBLIC rfmip_clear_utils) + +foreach( + test_executable IN + ITEMS # cmake-format: sort + check_equivalence + check_variants + rte_lw_solver_unit_tests + rte_optic_prop_unit_tests + rte_sw_solver_unit_tests + test_zenith_angle_spherical_correction +) + add_executable(${test_executable} ${test_executable}.F90) + target_link_libraries(${test_executable} PRIVATE test_utils) +endforeach() + +add_dependencies(check_equivalence tests_test_inputs) +add_dependencies(check_variants tests_test_inputs) + +add_test(NAME rte_optic_prop_unit_tests COMMAND rte_optic_prop_unit_tests) +add_test(NAME rte_lw_solver_unit_tests COMMAND rte_lw_solver_unit_tests) +add_test(NAME rte_sw_solver_unit_tests COMMAND rte_sw_solver_unit_tests) + +add_test( + NAME check_equivalence_lw_g256 + COMMAND + check_equivalence + multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc + ${RRTMGP_DATA}/rrtmgp-gas-lw-g256.nc +) + +add_test( + NAME check_equivalence_lw_g128 + COMMAND + check_equivalence + multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc + ${RRTMGP_DATA}/rrtmgp-gas-lw-g128.nc +) + +add_test( + NAME check_equivalence_sw_g224 + COMMAND + check_equivalence + multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc + ${RRTMGP_DATA}/rrtmgp-gas-sw-g224.nc +) + +add_test( + NAME check_equivalence_sw_g112 + COMMAND + check_equivalence + multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc + ${RRTMGP_DATA}/rrtmgp-gas-sw-g112.nc +) + +add_test( + NAME check_variants_lw + COMMAND + check_variants + multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc + ${RRTMGP_DATA}/rrtmgp-gas-lw-g256.nc ${RRTMGP_DATA}/rrtmgp-gas-lw-g128.nc +) + +add_test( + NAME check_variants_sw + COMMAND + check_variants + multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc + ${RRTMGP_DATA}/rrtmgp-gas-sw-g224.nc ${RRTMGP_DATA}/rrtmgp-gas-sw-g112.nc +) + +add_custom_target( + validation-plots + COMMAND + ${Python3_EXECUTABLE} ${CMAKE_CURRENT_SOURCE_DIR}/validation-plots.py + --input_file multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc + COMMENT "Generating validation plots" +) diff --git a/tests/Makefile b/tests/Makefile deleted file mode 100644 index de61c4a22..000000000 --- a/tests/Makefile +++ /dev/null @@ -1,97 +0,0 @@ -#!/usr/bin/env make -# -# Location of RTE+RRTMGP libraries, module files. -# -RRTMGP_ROOT ?= .. -RRTMGP_BUILD = $(RRTMGP_ROOT)/build -# -# RRTMGP library, module files -# -LDFLAGS += -L$(RRTMGP_BUILD) -LIBS += -lrrtmgp -lrte -FCINCLUDE += -I$(RRTMGP_BUILD) - -# netcdf Fortran module files has to be in the search path or added via environment variable FCINCLUDE e.g. -#FCINCLUDE += -I$(NFHOME)/include - -# netcdf C and Fortran libraries have to be in the search path or added via environment variable LDFLAGS e.g. -#LDFLAGS += -L$(NFHOME)/lib -L$(NCHOME)/lib -LIBS += -lnetcdff - -VPATH = $(RRTMGP_ROOT)/examples:$(RRTMGP_ROOT)/examples/rfmip-clear-sky:$(RRTMGP_ROOT)/examples/all-sky -VPATH += $(RRTMGP_ROOT)/rrtmgp-frontend:$(RRTMGP_ROOT)/extensions:$(RRTMGP_ROOT)/:$(RRTMGP_ROOT)/extensions/solar_variability - -# Compilation rules -%.o: %.F90 - $(FC) $(FCFLAGS) $(FCINCLUDE) -c $< -%: %.o - $(FC) $(FCFLAGS) -o $@ $^ $(LDFLAGS) $(LIBS) - - -# -# Extra sources -- extensions to RRTMGP classes, shared infrastructure, local sources -# -ADDITIONS = mo_heating_rates.o mo_compute_bc.o mo_rrtmgp_clr_all_sky.o -ADDITIONS += mo_gas_optics_defs_rrtmgp.o -# File I/O -ADDITIONS += mo_simple_netcdf.o mo_rfmip_io.o -ADDITIONS += mo_testing_io.o mo_testing_utils.o -# Cloud optics -CLOUDS += mo_cloud_sampling.o mo_cloud_optics_rrtmgp.o mo_load_cloud_coefficients.o mo_garand_atmos_io.o -# Solar variability -ADDITIONS += mo_solar_variability.o - -# Many codes will need to be updated if the library changes -# LIB_DEPS = $(RRTMGP_BUILD)/librte.a $(RRTMGP_BUILD)/librrtmgp.a -# -# Targets -# -all: check_variants check_equivalence test_zenith_angle_spherical_correction rte_sw_solver_unit_tests rte_optic_prop_unit_tests rte_lw_solver_unit_tests - -check_equivalence: $(ADDITIONS) $(LIB_DEPS) check_equivalence.o -check_equivalence.o: $(ADDITIONS) $(LIB_DEPS) check_equivalence.F90 - -check_variants: $(ADDITIONS) $(LIB_DEPS) check_variants.o -check_variants.o: $(ADDITIONS) $(LIB_DEPS) check_variants.F90 - -test_zenith_angle_spherical_correction: mo_zenith_angle_spherical_correction.o mo_rcemip_profiles.o $(ADDITIONS) $(LIB_DEPS) test_zenith_angle_spherical_correction.o -test_zenith_angle_spherical_correction.o: mo_zenith_angle_spherical_correction.o mo_rcemip_profiles.o $(ADDITIONS) $(LIB_DEPS) test_zenith_angle_spherical_correction.F90 - -mo_testing_io.o: $(LIB_DEPS) mo_simple_netcdf.o mo_testing_io.F90 - -mo_cloud_optics_rrtmgp.o: $(LIB_DEPS) mo_cloud_optics_rrtmgp.F90 -mo_load_cloud_coefficients.o: $(LIB_DEPS) mo_simple_netcdf.o mo_cloud_optics_rrtmgp.o mo_load_cloud_coefficients.F90 -mo_cloud_sampling.o: $(LIB_DEPS) mo_cloud_sampling.F90 - -mo_gas_optics_defs_rrtmgp.o: $(LIB_DEPS) mo_testing_utils.o mo_simple_netcdf.o mo_gas_optics_defs_rrtmgp.F90 - -mo_load_coefficients.o: $(LIB_DEPS) mo_simple_netcdf.o mo_load_coefficients.F90 -mo_rfmip_io.o: $(LIB_DEPS) mo_simple_netcdf.o mo_rfmip_io.F90 -mo_simple_netcdf.o: $(LIB_DEPS) mo_simple_netcdf.F90 - -rte_optic_prop_unit_tests.o: $(LIB_DEPS) mo_testing_utils.o rte_optic_prop_unit_tests.F90 -rte_optic_prop_unit_tests : $(LIB_DEPS) mo_testing_utils.o rte_optic_prop_unit_tests.o - -rte_lw_solver_unit_tests.o: $(LIB_DEPS) mo_testing_utils.o rte_lw_solver_unit_tests.F90 -rte_lw_solver_unit_tests : $(LIB_DEPS) mo_testing_utils.o rte_lw_solver_unit_tests.o - -rte_sw_solver_unit_tests.o: $(LIB_DEPS) mo_testing_utils.o rte_sw_solver_unit_tests.F90 -rte_sw_solver_unit_tests : $(LIB_DEPS) mo_testing_utils.o rte_sw_solver_unit_tests.o - - -# The default location of the input data: -RRTMGP_DATA ?= $(RRTMGP_ROOT)/rrtmgp-data -# Make it available to the scripts: -export RRTMGP_DATA - -.PHONY: tests -tests: check_variants check_equivalence test_zenith_angle_spherical_correction rte_sw_solver_unit_tests rte_optic_prop_unit_tests rte_lw_solver_unit_tests - cp ${RRTMGP_DATA}/examples/rfmip-clear-sky/inputs/multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc ./test_atmospheres.nc - $(RUN_CMD) bash all_tests.sh - - -check: - echo "Nothing to check in tests/" - -clean: - -rm clear_sky_regression *.o *.optrpt *.mod diff --git a/tests/all_tests.sh b/tests/all_tests.sh deleted file mode 100644 index 7752f4064..000000000 --- a/tests/all_tests.sh +++ /dev/null @@ -1,10 +0,0 @@ -set -eux -./rte_optic_prop_unit_tests -./rte_lw_solver_unit_tests -./rte_sw_solver_unit_tests -./check_equivalence test_atmospheres.nc ${RRTMGP_DATA}/rrtmgp-gas-lw-g256.nc -./check_equivalence test_atmospheres.nc ${RRTMGP_DATA}/rrtmgp-gas-lw-g128.nc -./check_equivalence test_atmospheres.nc ${RRTMGP_DATA}/rrtmgp-gas-sw-g224.nc -./check_equivalence test_atmospheres.nc ${RRTMGP_DATA}/rrtmgp-gas-sw-g112.nc -./check_variants test_atmospheres.nc ${RRTMGP_DATA}/rrtmgp-gas-lw-g256.nc ${RRTMGP_DATA}/rrtmgp-gas-lw-g128.nc -./check_variants test_atmospheres.nc ${RRTMGP_DATA}/rrtmgp-gas-sw-g224.nc ${RRTMGP_DATA}/rrtmgp-gas-sw-g112.nc \ No newline at end of file diff --git a/tests/validation-plots.py b/tests/validation-plots.py old mode 100644 new mode 100755 index 4dcc9434b..99847da97 --- a/tests/validation-plots.py +++ b/tests/validation-plots.py @@ -1,3 +1,5 @@ +#! /usr/bin/env python + import colorcet as cc import matplotlib as mpl import matplotlib.pyplot as plt @@ -7,6 +9,7 @@ import xarray as xr from matplotlib.backends.backend_pdf import PdfPages +import argparse def mae(diff, col_dim): # @@ -62,6 +65,21 @@ def construct_lbl_esgf_root(var, esgf_node="llnl"): ######################################################################## def main(): + parser = argparse.ArgumentParser() + parser.add_argument( + "--input_file", + help="Path to the input NetCDF file (test_atmosphere.nc)." + ) + parser.add_argument( + "--output_pdf", + help="Path to the output PDF file for validation plots.", + default="validation-figures.pdf" + ) + args = parser.parse_args() + + input_file = args.input_file + output_pdf = args.output_pdf + warnings.simplefilter("ignore", xr.SerializationWarning) # # Reference values from LBLRTM - download locally, since OpenDAP access is @@ -87,7 +105,7 @@ def main(): # # Open the test results # - gp = xr.open_dataset("test_atmospheres.nc") + gp = xr.open_dataset(input_file) # # Does the flux plus the Jacobian equal a calculation with perturbed surface # temperature? @@ -120,7 +138,7 @@ def main(): plev.load() gpi.load() lbli.load() - with PdfPages('validation-figures.pdf') as pdf: + with PdfPages(output_pdf) as pdf: ######################################################################## # Longwave ######################################################################## From 457353900381cca5d30a5add637f335b852847e7 Mon Sep 17 00:00:00 2001 From: Sergey Kosukhin Date: Sat, 4 Jan 2025 17:02:02 +0100 Subject: [PATCH 52/57] CMake: add missing test dependencies (#319) Improves file handling during the running of tests and examples. See PR (#319) for details. --- .github/workflows/containerized-ci.yml | 3 +- .github/workflows/continuous-integration.yml | 5 +- .gitlab/common.yml | 8 +- CMakeLists.txt | 66 +++++++----- examples/all-sky/CMakeLists.txt | 72 +++++++------ examples/rfmip-clear-sky/CMakeLists.txt | 78 +++++++++----- tests/CMakeLists.txt | 102 +++++++++++-------- 7 files changed, 201 insertions(+), 133 deletions(-) diff --git a/.github/workflows/containerized-ci.yml b/.github/workflows/containerized-ci.yml index aa91da7f3..98458a7a4 100644 --- a/.github/workflows/containerized-ci.yml +++ b/.github/workflows/containerized-ci.yml @@ -56,8 +56,7 @@ jobs: NetCDF_Fortran_ROOT: /opt/netcdf-fortran CMAKE_BUILD_PARALLEL_LEVEL: 8 VERBOSE: - # TODO: add missing test dependencies and run them in parallel: - # CTEST_PARALLEL_LEVEL: 8 + CTEST_PARALLEL_LEVEL: 8 CTEST_OUTPUT_ON_FAILURE: 1 # https://github.com/earth-system-radiation/rte-rrtmgp/issues/194 OMP_TARGET_OFFLOAD: DISABLED diff --git a/.github/workflows/continuous-integration.yml b/.github/workflows/continuous-integration.yml index 84d1829d8..d9e346e9e 100644 --- a/.github/workflows/continuous-integration.yml +++ b/.github/workflows/continuous-integration.yml @@ -61,11 +61,10 @@ jobs: fpmodel: SP env: FC: gfortran-${{ matrix.gfortran-version }} - FFLAGS: "-ffree-line-length-none -m64 -std=f2008 -march=native -fbounds-check -fmodule-private -fimplicit-none -finit-real=nan" + FFLAGS: "-m64 -std=f2008 -march=native -fbounds-check -fmodule-private -fimplicit-none -finit-real=nan" CMAKE_BUILD_PARALLEL_LEVEL: 8 VERBOSE: - # TODO: add missing test dependencies and run them in parallel: - # CTEST_PARALLEL_LEVEL: 8 + CTEST_PARALLEL_LEVEL: 8 CTEST_OUTPUT_ON_FAILURE: 1 runs-on: ${{ matrix.os }} steps: diff --git a/.gitlab/common.yml b/.gitlab/common.yml index 707122f1c..81aac69e4 100644 --- a/.gitlab/common.yml +++ b/.gitlab/common.yml @@ -1,19 +1,16 @@ .dp: variables: RTE_ENABLE_SP: OFF - FAILURE_THRESHOLD: "7.e-4" .sp: variables: RTE_ENABLE_SP: ON - FAILURE_THRESHOLD: "3.5e-1" .common: variables: CMAKE_BUILD_PARALLEL_LEVEL: 8 VERBOSE: - # TODO: add missing test dependencies and run them in parallel: - # CTEST_PARALLEL_LEVEL: 8 + CTEST_PARALLEL_LEVEL: 8 CTEST_OUTPUT_ON_FAILURE: 1 script: # @@ -24,8 +21,7 @@ -DCMAKE_BUILD_TYPE=None \ -DRTE_ENABLE_SP=$RTE_ENABLE_SP \ -DKERNEL_MODE=$KERNEL_MODE \ - -DBUILD_TESTING=ON \ - -DFAILURE_THRESHOLD=$FAILURE_THRESHOLD + -DBUILD_TESTING=ON - cmake --build build # # Run examples, tests and checks diff --git a/CMakeLists.txt b/CMakeLists.txt index 29513fd1a..796360727 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -33,44 +33,64 @@ add_subdirectory(rrtmgp-frontend) include(CTest) if(BUILD_TESTING) find_package(Python3 REQUIRED COMPONENTS Interpreter) - include(CheckPython3Package) - check_python3_package(numpy) - check_python3_package( - "netCDF4 or h5netcdf+scipy" - CODE "try: + + if(NOT _RTE_RRTMGP_HAVE_PY_PACKAGES) + include(CheckPython3Package) + check_python3_package(numpy) + check_python3_package( + "netCDF4 or h5netcdf+scipy" + CODE "try: import netCDF4 except: import h5netcdf import scipy " - ) - check_python3_package( - "xarray>=0.12.2" - CODE "import xarray + ) + check_python3_package( + "xarray>=0.12.2" + CODE "import xarray exit(tuple(map(int, xarray.__version__.split('.'))) < (0, 12, 2))" - ) - check_python3_package(dask.array) + ) + check_python3_package(dask.array) + set(_RTE_RRTMGP_HAVE_PY_PACKAGES + TRUE + CACHE INTERNAL + "RTE-RRTMGP found all Python packages required for testing" + ) + endif() find_package(NetCDF_Fortran REQUIRED) - if(NOT RRTMGP_DATA) - set(RRTMGP_DATA - "${PROJECT_BINARY_DIR}/rrtmgp-data" - CACHE PATH "Path to the RRTMGP data" FORCE - ) - set(RRTMGP_DATA_VERSION "v1.8.2") - include(FetchContent) - message(CHECK_START "Fetching RRTMGP data ${RRTMGP_DATA_VERSION}") - FetchContent_Declare( + if(RRTMGP_DATA) + add_test(NAME fetch_rrtmgp_data COMMAND ${CMAKE_COMMAND} -E true) + else() + set(RRTMGP_DATA "${PROJECT_BINARY_DIR}/rrtmgp-data") + + include(ExternalProject) + ExternalProject_Add( rrtmgp-data GIT_REPOSITORY https://github.com/earth-system-radiation/rrtmgp-data.git - GIT_TAG ${RRTMGP_DATA_VERSION} + GIT_TAG "v1.8.2" + GIT_SHALLOW True + EXCLUDE_FROM_ALL True + PREFIX rrtmgp-data-cmake SOURCE_DIR ${RRTMGP_DATA} + CONFIGURE_COMMAND "" + BUILD_COMMAND "" + INSTALL_COMMAND "" + ) + add_test( + NAME fetch_rrtmgp_data + COMMAND + ${CMAKE_COMMAND} --build ${CMAKE_CURRENT_BINARY_DIR} --config + "$" --target rrtmgp-data ) - FetchContent_MakeAvailable(rrtmgp-data) - message(CHECK_PASS "done") endif() + set_tests_properties( + fetch_rrtmgp_data PROPERTIES FIXTURES_SETUP fetch_rrtmgp_data + ) + add_subdirectory(examples) add_subdirectory(tests) else() diff --git a/examples/all-sky/CMakeLists.txt b/examples/all-sky/CMakeLists.txt index 62a3e112c..185900070 100644 --- a/examples/all-sky/CMakeLists.txt +++ b/examples/all-sky/CMakeLists.txt @@ -1,18 +1,3 @@ -set(TEST_INPUTS - ${RRTMGP_DATA}/examples/all-sky/reference/rrtmgp-allsky-lw.nc - ${RRTMGP_DATA}/examples/all-sky/reference/rrtmgp-allsky-sw.nc - ${RRTMGP_DATA}/examples/all-sky/reference/rrtmgp-allsky-lw-no-aerosols.nc - ${RRTMGP_DATA}/examples/all-sky/reference/rrtmgp-allsky-sw-no-aerosols.nc -) - -add_custom_target( - all_sky_test_inputs ALL - COMMAND - ${CMAKE_COMMAND} -E copy_if_different ${TEST_INPUTS} - ${CMAKE_CURRENT_BINARY_DIR}/ - COMMENT "Copying required test input files" -) - add_library( all_sky_utils STATIC # cmake-format: sort mo_load_aerosol_coefficients.F90 mo_load_cloud_coefficients.F90 @@ -22,46 +7,71 @@ target_link_libraries(all_sky_utils PUBLIC examples_utils) add_executable(rrtmgp_allsky rrtmgp_allsky.F90) target_link_libraries(rrtmgp_allsky PRIVATE all_sky_utils) -add_dependencies(rrtmgp_allsky all_sky_test_inputs) add_test( - NAME allsky_test_lw + NAME run_allsky_lw COMMAND rrtmgp_allsky 24 72 1 rrtmgp-allsky-lw.nc ${RRTMGP_DATA}/rrtmgp-gas-lw-g256.nc ${RRTMGP_DATA}/rrtmgp-clouds-lw.nc ${RRTMGP_DATA}/rrtmgp-aerosols-merra-lw.nc ) +set_tests_properties( + run_allsky_lw + PROPERTIES FIXTURES_REQUIRED fetch_rrtmgp_data FIXTURES_SETUP run_allsky +) add_test( - NAME allsky_test_sw + NAME run_allsky_sw COMMAND rrtmgp_allsky 24 72 1 rrtmgp-allsky-sw.nc ${RRTMGP_DATA}/rrtmgp-gas-sw-g224.nc ${RRTMGP_DATA}/rrtmgp-clouds-sw.nc ${RRTMGP_DATA}/rrtmgp-aerosols-merra-sw.nc ) +set_tests_properties( + run_allsky_sw + PROPERTIES FIXTURES_REQUIRED fetch_rrtmgp_data FIXTURES_SETUP run_allsky +) add_test( - NAME allsky_test_lw_no_aerosols + NAME check_allsky_lw_sw + COMMAND + ${Python3_EXECUTABLE} ${CMAKE_SOURCE_DIR}/examples/compare-to-reference.py + --ref_dir ${RRTMGP_DATA}/examples/all-sky/reference --tst_dir + ${CMAKE_CURRENT_BINARY_DIR} --variables lw_flux_up lw_flux_dn sw_flux_up + sw_flux_dn sw_flux_dir --file_names rrtmgp-allsky-lw.nc rrtmgp-allsky-sw.nc + --failure_threshold ${FAILURE_THRESHOLD} +) +set_tests_properties( + check_allsky_lw_sw + PROPERTIES FIXTURES_REQUIRED "fetch_rrtmgp_data;run_allsky" +) + +add_test( + NAME run_allsky_no_aerosols_lw COMMAND rrtmgp_allsky 24 72 1 rrtmgp-allsky-lw-no-aerosols.nc ${RRTMGP_DATA}/rrtmgp-gas-lw-g256.nc ${RRTMGP_DATA}/rrtmgp-clouds-lw.nc ) +set_tests_properties( + run_allsky_no_aerosols_lw + PROPERTIES FIXTURES_REQUIRED + fetch_rrtmgp_data + FIXTURES_SETUP + run_allsky_no_aerosols +) add_test( - NAME allsky_test_sw_no_aerosols + NAME run_allsky_no_aerosols_sw COMMAND rrtmgp_allsky 24 72 1 rrtmgp-allsky-sw-no-aerosols.nc ${RRTMGP_DATA}/rrtmgp-gas-sw-g224.nc ${RRTMGP_DATA}/rrtmgp-clouds-sw.nc ) - -add_test( - NAME check_allsky_lw_sw - COMMAND - ${Python3_EXECUTABLE} ${CMAKE_SOURCE_DIR}/examples/compare-to-reference.py - --ref_dir ${RRTMGP_DATA}/examples/all-sky/reference --tst_dir - ${CMAKE_CURRENT_BINARY_DIR} --variables lw_flux_up lw_flux_dn sw_flux_up - sw_flux_dn sw_flux_dir --file_names rrtmgp-allsky-lw.nc rrtmgp-allsky-sw.nc - --failure_threshold ${FAILURE_THRESHOLD} +set_tests_properties( + run_allsky_no_aerosols_sw + PROPERTIES FIXTURES_REQUIRED + fetch_rrtmgp_data + FIXTURES_SETUP + run_allsky_no_aerosols ) add_test( @@ -73,3 +83,7 @@ add_test( sw_flux_dn sw_flux_dir --file_names rrtmgp-allsky-lw-no-aerosols.nc rrtmgp-allsky-sw-no-aerosols.nc --failure_threshold ${FAILURE_THRESHOLD} ) +set_tests_properties( + check_allsky_no_aerosols_lw_sw + PROPERTIES FIXTURES_REQUIRED "fetch_rrtmgp_data;run_allsky_no_aerosols" +) diff --git a/examples/rfmip-clear-sky/CMakeLists.txt b/examples/rfmip-clear-sky/CMakeLists.txt index 6cfd6bba3..37c69177a 100644 --- a/examples/rfmip-clear-sky/CMakeLists.txt +++ b/examples/rfmip-clear-sky/CMakeLists.txt @@ -1,20 +1,3 @@ -set(TEST_INPUTS - # cmake-format: sort - ${RRTMGP_DATA}/examples/rfmip-clear-sky/inputs/multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc - ${RRTMGP_DATA}/examples/rfmip-clear-sky/inputs/rld_Efx_RTE-RRTMGP-181204_rad-irf_r1i1p1f1_gn.nc - ${RRTMGP_DATA}/examples/rfmip-clear-sky/inputs/rlu_Efx_RTE-RRTMGP-181204_rad-irf_r1i1p1f1_gn.nc - ${RRTMGP_DATA}/examples/rfmip-clear-sky/inputs/rsd_Efx_RTE-RRTMGP-181204_rad-irf_r1i1p1f1_gn.nc - ${RRTMGP_DATA}/examples/rfmip-clear-sky/inputs/rsu_Efx_RTE-RRTMGP-181204_rad-irf_r1i1p1f1_gn.nc -) - -add_custom_target( - rfmip_clear_sky_test_inputs ALL - COMMAND - ${CMAKE_COMMAND} -E copy_if_different ${TEST_INPUTS} - ${CMAKE_CURRENT_BINARY_DIR}/ - COMMENT "Copying required test input files" -) - add_library(rfmip_clear_utils STATIC mo_rfmip_io.F90) target_link_libraries(rfmip_clear_utils PUBLIC examples_utils) @@ -26,24 +9,65 @@ foreach( ) add_executable(${test_executable} ${test_executable}.F90) target_link_libraries(${test_executable} PRIVATE rfmip_clear_utils) - add_dependencies(${test_executable} rfmip_clear_sky_test_inputs) endforeach() +set(inoutputs + rld_Efx_RTE-RRTMGP-181204_rad-irf_r1i1p1f1_gn.nc + rlu_Efx_RTE-RRTMGP-181204_rad-irf_r1i1p1f1_gn.nc + rsd_Efx_RTE-RRTMGP-181204_rad-irf_r1i1p1f1_gn.nc + rsu_Efx_RTE-RRTMGP-181204_rad-irf_r1i1p1f1_gn.nc +) + +list( + TRANSFORM inoutputs + PREPEND ${RRTMGP_DATA}/examples/rfmip-clear-sky/inputs/ + OUTPUT_VARIABLE inputs +) + +# The tests write to the input files, therefore we copy them: add_test( - NAME rfmip_test_lw + NAME copy_rrtmgp_rfmip_inputs + COMMAND + ${CMAKE_COMMAND} -E copy_if_different ${inputs} + ${CMAKE_CURRENT_BINARY_DIR}/ +) +set_tests_properties( + copy_rrtmgp_rfmip_inputs + PROPERTIES FIXTURES_REQUIRED + fetch_rrtmgp_data + FIXTURES_SETUP + copy_rrtmgp_rfmip_inputs +) + +add_test( + NAME run_rrtmgp_rfmip_lw COMMAND rrtmgp_rfmip_lw 8 - multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc + ${RRTMGP_DATA}/examples/rfmip-clear-sky/inputs/multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc ${RRTMGP_DATA}/rrtmgp-gas-lw-g256.nc ) +set_tests_properties( + run_rrtmgp_rfmip_lw + PROPERTIES FIXTURES_REQUIRED + "fetch_rrtmgp_data;copy_rrtmgp_rfmip_inputs" + FIXTURES_SETUP + run_rrtmgp_rfmip +) add_test( - NAME rfmip_test_sw + NAME run_rrtmgp_rfmip_sw COMMAND rrtmgp_rfmip_sw 8 - multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc + ${RRTMGP_DATA}/examples/rfmip-clear-sky/inputs/multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc ${RRTMGP_DATA}/rrtmgp-gas-sw-g224.nc ) +set_tests_properties( + run_rrtmgp_rfmip_sw + PROPERTIES FIXTURES_REQUIRED + "fetch_rrtmgp_data;copy_rrtmgp_rfmip_inputs" + FIXTURES_SETUP + run_rrtmgp_rfmip +) add_test( NAME check_rfmip_lw_sw @@ -51,9 +75,9 @@ add_test( ${Python3_EXECUTABLE} ${CMAKE_SOURCE_DIR}/examples/compare-to-reference.py --ref_dir ${RRTMGP_DATA}/examples/rfmip-clear-sky/reference --tst_dir ${CMAKE_CURRENT_BINARY_DIR} --variables rld rlu rsd rsu --file_names - rld_Efx_RTE-RRTMGP-181204_rad-irf_r1i1p1f1_gn.nc - rlu_Efx_RTE-RRTMGP-181204_rad-irf_r1i1p1f1_gn.nc - rsd_Efx_RTE-RRTMGP-181204_rad-irf_r1i1p1f1_gn.nc - rsu_Efx_RTE-RRTMGP-181204_rad-irf_r1i1p1f1_gn.nc --failure_threshold - ${FAILURE_THRESHOLD} + ${inoutputs} --failure_threshold ${FAILURE_THRESHOLD} +) +set_tests_properties( + check_rfmip_lw_sw + PROPERTIES FIXTURES_REQUIRED "fetch_rrtmgp_data;run_rrtmgp_rfmip" ) diff --git a/tests/CMakeLists.txt b/tests/CMakeLists.txt index 6f92e3281..2ebddccb8 100644 --- a/tests/CMakeLists.txt +++ b/tests/CMakeLists.txt @@ -1,15 +1,3 @@ -set(TEST_INPUTS - ${RRTMGP_DATA}/examples/rfmip-clear-sky/inputs/multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc -) - -add_custom_target( - tests_test_inputs ALL - COMMAND - ${CMAKE_COMMAND} -E copy_if_different ${TEST_INPUTS} - ${CMAKE_CURRENT_BINARY_DIR}/ - COMMENT "Copying required test input files" -) - set(CMAKE_Fortran_MODULE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/modules) set(extensions_source_dir ${PROJECT_SOURCE_DIR}/extensions) @@ -50,43 +38,58 @@ foreach( target_link_libraries(${test_executable} PRIVATE test_utils) endforeach() -add_dependencies(check_equivalence tests_test_inputs) -add_dependencies(check_variants tests_test_inputs) - -add_test(NAME rte_optic_prop_unit_tests COMMAND rte_optic_prop_unit_tests) -add_test(NAME rte_lw_solver_unit_tests COMMAND rte_lw_solver_unit_tests) -add_test(NAME rte_sw_solver_unit_tests COMMAND rte_sw_solver_unit_tests) - -add_test( - NAME check_equivalence_lw_g256 - COMMAND - check_equivalence - multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc - ${RRTMGP_DATA}/rrtmgp-gas-lw-g256.nc +foreach( + test_executable IN + ITEMS # cmake-format: sort + rte_lw_solver_unit_tests + rte_optic_prop_unit_tests + rte_sw_solver_unit_tests ) + add_test(NAME ${test_executable} COMMAND ${test_executable}) +endforeach() -add_test( - NAME check_equivalence_lw_g128 - COMMAND - check_equivalence - multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc - ${RRTMGP_DATA}/rrtmgp-gas-lw-g128.nc -) +foreach(g_value IN ITEMS 256 128) + add_test( + NAME check_equivalence_lw_g${g_value} + COMMAND + check_equivalence + ${RRTMGP_DATA}/examples/rfmip-clear-sky/inputs/multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc + ${RRTMGP_DATA}/rrtmgp-gas-lw-g${g_value}.nc + ) + set_tests_properties( + check_equivalence_lw_g${g_value} + PROPERTIES FIXTURES_REQUIRED fetch_rrtmgp_data + ) +endforeach() -add_test( - NAME check_equivalence_sw_g224 - COMMAND - check_equivalence - multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc - ${RRTMGP_DATA}/rrtmgp-gas-sw-g224.nc -) +foreach(g_value IN ITEMS 224 112) + add_test( + NAME check_equivalence_sw_g${g_value} + COMMAND + check_equivalence + ${RRTMGP_DATA}/examples/rfmip-clear-sky/inputs/multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc + ${RRTMGP_DATA}/rrtmgp-gas-sw-g${g_value}.nc + ) + set_tests_properties( + check_equivalence_sw_g${g_value} + PROPERTIES FIXTURES_REQUIRED fetch_rrtmgp_data + ) +endforeach() +# The tests write to the input file, therefore we copy it: add_test( - NAME check_equivalence_sw_g112 + NAME copy_check_variants_input COMMAND - check_equivalence - multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc - ${RRTMGP_DATA}/rrtmgp-gas-sw-g112.nc + ${CMAKE_COMMAND} -E copy_if_different + ${RRTMGP_DATA}/examples/rfmip-clear-sky/inputs/multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc + ${CMAKE_CURRENT_BINARY_DIR}/ +) +set_tests_properties( + copy_check_variants_input + PROPERTIES FIXTURES_REQUIRED + fetch_rrtmgp_data + FIXTURES_SETUP + copy_check_variants_input ) add_test( @@ -96,6 +99,10 @@ add_test( multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc ${RRTMGP_DATA}/rrtmgp-gas-lw-g256.nc ${RRTMGP_DATA}/rrtmgp-gas-lw-g128.nc ) +set_tests_properties( + check_variants_lw + PROPERTIES FIXTURES_REQUIRED "fetch_rrtmgp_data;copy_check_variants_input" +) add_test( NAME check_variants_sw @@ -104,6 +111,15 @@ add_test( multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc ${RRTMGP_DATA}/rrtmgp-gas-sw-g224.nc ${RRTMGP_DATA}/rrtmgp-gas-sw-g112.nc ) +set_tests_properties( + check_variants_sw + PROPERTIES FIXTURES_REQUIRED + "fetch_rrtmgp_data;copy_check_variants_input" + # The test writes to the same file as check_variants_lw, therefore + # we cannot run them in parallel: + DEPENDS + check_variants_lw +) add_custom_target( validation-plots From 986c5399411b1adca725cf947d5d82ceb361073b Mon Sep 17 00:00:00 2001 From: Sergey Kosukhin Date: Mon, 6 Jan 2025 13:34:21 +0100 Subject: [PATCH 53/57] ci: exclude failing ifx accel test (#321) Exclude ifx/accel jobs rather than setting them up and skipping them. --- .github/workflows/containerized-ci.yml | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/.github/workflows/containerized-ci.yml b/.github/workflows/containerized-ci.yml index 98458a7a4..cf6ffad2d 100644 --- a/.github/workflows/containerized-ci.yml +++ b/.github/workflows/containerized-ci.yml @@ -18,6 +18,12 @@ jobs: fortran-compiler: [ifort, ifx, nvfortran] rte-kernels: [default, accel] fpmodel: [DP, SP] + exclude: + # Fails with error #5633: **Internal compiler error: segmentation violation signal raised** + - fortran-compiler: ifx + rte-kernels: accel + # fcflags: -debug -traceback -O0 -heap-arrays -assume realloc_lhs -extend-source 132 -stand f08 -fiopenmp -fopenmp-targets=spir64 + # build-type: None include: # Set flags for Intel Fortran Compiler Classic - fortran-compiler: ifort @@ -28,10 +34,6 @@ jobs: rte-kernels: default fcflags: -debug -traceback -O0 -heap-arrays -assume realloc_lhs -extend-source 132 -stand f08 build-type: None - - fortran-compiler: ifx - rte-kernels: accel - fcflags: -debug -traceback -O0 -heap-arrays -assume realloc_lhs -extend-source 132 -stand f08 -fiopenmp -fopenmp-targets=spir64 - build-type: None # Set flags for NVIDIA Fortran compiler - fortran-compiler: nvfortran rte-kernels: default @@ -75,11 +77,9 @@ jobs: apt-get update apt-get install -y git cmake ninja-build # - # Build libraries, examples and tests (expect success) + # Build libraries, examples and tests # - - name: Build libraries, examples and tests (expect success) - id: build-success - if: matrix.fortran-compiler != 'ifx' || matrix.rte-kernels != 'accel' + - name: Build libraries, examples and tests run: | cmake -S . -B build -G "Ninja" \ -DCMAKE_BUILD_TYPE=${{ matrix.build-type }} \ @@ -92,7 +92,6 @@ jobs: # - name: Run examples and tests working-directory: build - if: steps.build-success.outcome != 'skipped' run: ctest # # Generate validation plots From a7d6a69c7eb82d36d6bbfef1429747b115356452 Mon Sep 17 00:00:00 2001 From: Sergey Kosukhin Date: Mon, 6 Jan 2025 18:43:56 +0100 Subject: [PATCH 54/57] CMake: add install target (#323) Adds CMake install target for the RTE and RRTMGP libraries. Other CMake refinements. See the PR for details. --- .github/workflows/style.yml | 2 +- CMakeLists.txt | 39 ++++++++++++++++++++++++++++++++++ cmake/config.cmake.in | 6 ++++++ examples/CMakeLists.txt | 3 ++- rrtmgp-frontend/CMakeLists.txt | 13 +++++++----- rrtmgp-kernels/CMakeLists.txt | 4 +--- rte-frontend/CMakeLists.txt | 7 +++++- rte-kernels/CMakeLists.txt | 6 +----- 8 files changed, 64 insertions(+), 16 deletions(-) create mode 100644 cmake/config.cmake.in diff --git a/.github/workflows/style.yml b/.github/workflows/style.yml index a9f60a699..a156e744e 100644 --- a/.github/workflows/style.yml +++ b/.github/workflows/style.yml @@ -10,7 +10,7 @@ on: workflow_dispatch: env: - FIND_CMAKE_FILES_CMD: "find '${{ github.workspace }}' -name 'CMakeLists.txt' -o -name '*.cmake'" + FIND_CMAKE_FILES_CMD: "find '${{ github.workspace }}' -name 'CMakeLists.txt' -o -name '*.cmake' -o -name '*.cmake.in'" jobs: Format: diff --git a/CMakeLists.txt b/CMakeLists.txt index 796360727..c5bdc7f17 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -19,6 +19,14 @@ set_property(CACHE KERNEL_MODE PROPERTY STRINGS ${PREFERRED_KERNEL_MODES}) list(APPEND CMAKE_MODULE_PATH ${PROJECT_SOURCE_DIR}/cmake) +# GNUInstallDirs issues a warning if CMAKE_SIZEOF_VOID_P is not defined, which +# is the case with NAG. One way to circumvent that is to enable C language for +# the project: +if(CMAKE_Fortran_COMPILER_ID STREQUAL NAG) + enable_language(C) +endif() +include(GNUInstallDirs) + add_compile_options( $<$:-ffree-line-length-none> ) @@ -97,3 +105,34 @@ else() # Allow for 'make test' even if the tests are disabled: enable_testing() endif() + +export( + EXPORT rte-rrtmgp-targets FILE ${PROJECT_BINARY_DIR}/rte-rrtmgp-targets.cmake +) + +include(CMakePackageConfigHelpers) +configure_package_config_file( + ${PROJECT_SOURCE_DIR}/cmake/config.cmake.in + ${PROJECT_BINARY_DIR}/rte-rrtmgp-config.cmake + INSTALL_DESTINATION ${CMAKE_INSTALL_LIBDIR}/rte-rrtmgp/cmake + NO_SET_AND_CHECK_MACRO NO_CHECK_REQUIRED_COMPONENTS_MACRO +) + +write_basic_package_version_file( + ${PROJECT_BINARY_DIR}/rte-rrtmgp-config-version.cmake + VERSION ${PROJECT_VERSION} + COMPATIBILITY SameMinorVersion +) + +install(DIRECTORY ${CMAKE_Fortran_MODULE_DIRECTORY}/ TYPE INCLUDE) + +install( + EXPORT rte-rrtmgp-targets + DESTINATION ${CMAKE_INSTALL_LIBDIR}/rte-rrtmgp/cmake +) + +install( + FILES ${PROJECT_BINARY_DIR}/rte-rrtmgp-config.cmake + ${PROJECT_BINARY_DIR}/rte-rrtmgp-config-version.cmake + DESTINATION ${CMAKE_INSTALL_LIBDIR}/rte-rrtmgp/cmake +) diff --git a/cmake/config.cmake.in b/cmake/config.cmake.in new file mode 100644 index 000000000..b2de3db4d --- /dev/null +++ b/cmake/config.cmake.in @@ -0,0 +1,6 @@ +@PACKAGE_INIT@ + +include(${CMAKE_CURRENT_LIST_DIR}/rte-rrtmgp-targets.cmake) + +include(FindPackageHandleStandardArgs) +find_package_handle_standard_args(rte-rrtmgp REQUIRED_VARS rte-rrtmgp_DIR) diff --git a/examples/CMakeLists.txt b/examples/CMakeLists.txt index 4f96a3e62..1b4a7c96a 100644 --- a/examples/CMakeLists.txt +++ b/examples/CMakeLists.txt @@ -24,7 +24,8 @@ target_include_directories( ) target_link_libraries( - examples_utils PUBLIC rrtmgp rte ${NetCDF_Fortran_LIBRARY} + examples_utils + PUBLIC rte-rrtmgp::rrtmgp rte-rrtmgp::rte ${NetCDF_Fortran_LIBRARY} ) add_subdirectory(all-sky) diff --git a/rrtmgp-frontend/CMakeLists.txt b/rrtmgp-frontend/CMakeLists.txt index 3af68510d..386a8756b 100644 --- a/rrtmgp-frontend/CMakeLists.txt +++ b/rrtmgp-frontend/CMakeLists.txt @@ -2,6 +2,7 @@ set(gas_optics_source_dir ${PROJECT_SOURCE_DIR}/gas-optics) add_library( rrtmgp STATIC # cmake-format: sort + $ ${gas_optics_source_dir}/mo_gas_concentrations.F90 ${gas_optics_source_dir}/mo_gas_optics.F90 ${gas_optics_source_dir}/mo_gas_optics_constants.F90 @@ -11,14 +12,16 @@ add_library( mo_gas_optics_rrtmgp.F90 ) +add_library(rte-rrtmgp::rrtmgp ALIAS rrtmgp) + +set_target_properties(rrtmgp PROPERTIES EXPORT_NAME rte-rrtmgp::rrtmgp) + target_include_directories( rrtmgp PUBLIC $:${CMAKE_Fortran_MODULE_DIRECTORY}>> ) -target_link_libraries( - rrtmgp - PUBLIC rrtmgpkernels - PRIVATE rte -) +target_link_libraries(rrtmgp PRIVATE rte) + +install(TARGETS rrtmgp EXPORT rte-rrtmgp-targets) diff --git a/rrtmgp-kernels/CMakeLists.txt b/rrtmgp-kernels/CMakeLists.txt index e85c187cf..2c50a17c9 100644 --- a/rrtmgp-kernels/CMakeLists.txt +++ b/rrtmgp-kernels/CMakeLists.txt @@ -30,9 +30,7 @@ else() endif() target_include_directories( - rrtmgpkernels - PUBLIC - $:${CMAKE_Fortran_MODULE_DIRECTORY}>> + rrtmgpkernels PRIVATE ${CMAKE_Fortran_MODULE_DIRECTORY} ) target_link_libraries(rrtmgpkernels PRIVATE rte) diff --git a/rte-frontend/CMakeLists.txt b/rte-frontend/CMakeLists.txt index 3a313038b..9a84452a0 100644 --- a/rte-frontend/CMakeLists.txt +++ b/rte-frontend/CMakeLists.txt @@ -1,5 +1,6 @@ add_library( rte STATIC # cmake-format: sort + $ mo_fluxes.F90 mo_optical_props.F90 mo_rte_config.F90 @@ -9,10 +10,14 @@ add_library( mo_source_functions.F90 ) +add_library(rte-rrtmgp::rte ALIAS rte) + +set_target_properties(rte PROPERTIES EXPORT_NAME rte-rrtmgp::rte) + target_include_directories( rte PUBLIC $:${CMAKE_Fortran_MODULE_DIRECTORY}>> ) -target_link_libraries(rte PUBLIC rtekernels) +install(TARGETS rte EXPORT rte-rrtmgp-targets) diff --git a/rte-kernels/CMakeLists.txt b/rte-kernels/CMakeLists.txt index d7e4a75a4..056feb047 100644 --- a/rte-kernels/CMakeLists.txt +++ b/rte-kernels/CMakeLists.txt @@ -44,8 +44,4 @@ target_compile_definitions( $<$:RTE_USE_CBOOL> ) -target_include_directories( - rtekernels - PUBLIC - $:${CMAKE_Fortran_MODULE_DIRECTORY}>> -) +target_include_directories(rtekernels PRIVATE ${CMAKE_Fortran_MODULE_DIRECTORY}) From 70551374f81083b4d70f8d73c026e7e2c16d05f6 Mon Sep 17 00:00:00 2001 From: Robert Pincus Date: Mon, 6 Jan 2025 12:46:08 -0500 Subject: [PATCH 55/57] Tests don't write to inputs (#322) tests/check_variants creates a new output file sharing two of the input file dimensions. CMake scripting creates separate SW and LW files. --- environment-dev.yml | 1 + tests/CMakeLists.txt | 42 +++--------- tests/check_variants.F90 | 137 +++++++++++++++++++++++++++----------- tests/intel-codecov.sh | 75 --------------------- tests/mo_testing_io.F90 | 60 ----------------- tests/validation-plots.py | 23 +++++-- 6 files changed, 129 insertions(+), 209 deletions(-) delete mode 100644 tests/intel-codecov.sh delete mode 100644 tests/mo_testing_io.F90 diff --git a/environment-dev.yml b/environment-dev.yml index 5b46be5b8..affe2b0b2 100644 --- a/environment-dev.yml +++ b/environment-dev.yml @@ -20,6 +20,7 @@ dependencies: - gfortran - netcdf-fortran - cmake + - cmake-format - ninja variables: FC: gfortran diff --git a/tests/CMakeLists.txt b/tests/CMakeLists.txt index 2ebddccb8..643374dcd 100644 --- a/tests/CMakeLists.txt +++ b/tests/CMakeLists.txt @@ -11,7 +11,6 @@ add_library( ${extensions_source_dir}/solar_variability/mo_solar_variability.F90 mo_gas_optics_defs_rrtmgp.F90 mo_rcemip_profiles.F90 - mo_testing_io.F90 mo_testing_utils.F90 ) @@ -76,55 +75,36 @@ foreach(g_value IN ITEMS 224 112) ) endforeach() -# The tests write to the input file, therefore we copy it: -add_test( - NAME copy_check_variants_input - COMMAND - ${CMAKE_COMMAND} -E copy_if_different - ${RRTMGP_DATA}/examples/rfmip-clear-sky/inputs/multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc - ${CMAKE_CURRENT_BINARY_DIR}/ -) -set_tests_properties( - copy_check_variants_input - PROPERTIES FIXTURES_REQUIRED - fetch_rrtmgp_data - FIXTURES_SETUP - copy_check_variants_input -) - add_test( NAME check_variants_lw COMMAND check_variants - multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc - ${RRTMGP_DATA}/rrtmgp-gas-lw-g256.nc ${RRTMGP_DATA}/rrtmgp-gas-lw-g128.nc + ${RRTMGP_DATA}/examples/rfmip-clear-sky/inputs/multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc + lw_flux_variants.nc ${RRTMGP_DATA}/rrtmgp-gas-lw-g256.nc + ${RRTMGP_DATA}/rrtmgp-gas-lw-g128.nc ) set_tests_properties( - check_variants_lw - PROPERTIES FIXTURES_REQUIRED "fetch_rrtmgp_data;copy_check_variants_input" + check_variants_lw PROPERTIES FIXTURES_REQUIRED fetch_rrtmgp_data ) add_test( NAME check_variants_sw COMMAND check_variants - multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc - ${RRTMGP_DATA}/rrtmgp-gas-sw-g224.nc ${RRTMGP_DATA}/rrtmgp-gas-sw-g112.nc + ${RRTMGP_DATA}/examples/rfmip-clear-sky/inputs/multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc + sw_flux_variants.nc ${RRTMGP_DATA}/rrtmgp-gas-sw-g224.nc + ${RRTMGP_DATA}/rrtmgp-gas-sw-g112.nc ) set_tests_properties( - check_variants_sw - PROPERTIES FIXTURES_REQUIRED - "fetch_rrtmgp_data;copy_check_variants_input" - # The test writes to the same file as check_variants_lw, therefore - # we cannot run them in parallel: - DEPENDS - check_variants_lw + check_variants_sw PROPERTIES FIXTURES_REQUIRED fetch_rrtmgp_data ) add_custom_target( validation-plots COMMAND ${Python3_EXECUTABLE} ${CMAKE_CURRENT_SOURCE_DIR}/validation-plots.py - --input_file multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc + --state_file + ${RRTMGP_DATA}/examples/rfmip-clear-sky/inputs/multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc + --lw_vars_file lw_flux_variants.nc --sw_vars_file sw_flux_variants.nc COMMENT "Generating validation plots" ) diff --git a/tests/check_variants.F90 b/tests/check_variants.F90 index db58d7885..385ca04a8 100644 --- a/tests/check_variants.F90 +++ b/tests/check_variants.F90 @@ -47,7 +47,8 @@ program rte_clear_sky_regression read_and_block_lw_bc, read_and_block_sw_bc, determine_gas_names use mo_simple_netcdf, only: get_dim_size, read_field use mo_heating_rates, only: compute_heating_rate - use mo_testing_io, only: write_broadband_field + use netcdf + use mo_simple_netcdf implicit none ! ---------------------------------------------------------------------------------- ! Variables @@ -110,7 +111,8 @@ program rte_clear_sky_regression character(len=32 ), & dimension(:), allocatable :: kdist_gas_names, rfmip_gas_games - character(len=256) :: input_file = "", gas_optics_file = "", gas_optics_file_2 = "" + character(len=256) :: input_file = "", output_file = "", gas_optics_file = "", gas_optics_file_2 = "" + integer :: ncid, dimid ! ---------------------------------------------------------------------------------- ! Code ! ---------------------------------------------------------------------------------- @@ -118,11 +120,12 @@ program rte_clear_sky_regression ! Parse command line for any file names, block size ! nUserArgs = command_argument_count() - if (nUserArgs < 2) call stop_on_err("Need to supply input_file gas_optics_file [gas_optics_file_2]") + if (nUserArgs < 3) call stop_on_err("Need to supply input_file output_file gas_optics_file [gas_optics_file_2]") if (nUserArgs >= 1) call get_command_argument(1,input_file) - if (nUserArgs >= 2) call get_command_argument(2,gas_optics_file) - if (nUserArgs >= 3) call get_command_argument(3,gas_optics_file_2) - if (nUserArgs > 4) print *, "Ignoring command line arguments beyond the first four..." + if (nUserArgs >= 2) call get_command_argument(2,output_file) + if (nUserArgs >= 3) call get_command_argument(3,gas_optics_file) + if (nUserArgs >= 4) call get_command_argument(4,gas_optics_file_2) + if (nUserArgs > 5) print *, "Ignoring command line arguments beyond the first four..." if(trim(input_file) == '-h' .or. trim(input_file) == "--help") then call stop_on_err("clear_sky_regression input_file absorption_coefficients_file") end if @@ -201,6 +204,21 @@ program rte_clear_sky_regression ! Fluxes ! allocate(flux_up(ncol,nlay+1), flux_dn(ncol,nlay+1), flux_dir(ncol,nlay+1)) + ! ---------------------------------------------------------------------------- + ! + ! Create output file and site, level, layer dimensions + ! + if(nf90_create(trim(output_file), NF90_CLOBBER, ncid) /= NF90_NOERR) & + call stop_on_err("write_fluxes: can't create file " // trim(output_file)) + if(nf90_def_dim(ncid, "site", ncol, dimid) /= NF90_NOERR) & + call stop_on_err("fail to create 'site' dimension") + if(nf90_def_dim(ncid, "level", nlay+1, dimid) /= NF90_NOERR) & + call stop_on_err("fail to create 'level' dimension") + if(nf90_def_dim(ncid, "layer", nlay, dimid) /= NF90_NOERR) & + call stop_on_err("fail to create 'layer' dimension") + if(nf90_enddef(ncid) /= NF90_NOERR) & + call stop_on_err("fail to to end redefinition??") + ! ---------------------------------------------------------------------------- ! ! Solvers @@ -244,6 +262,7 @@ program rte_clear_sky_regression call sw_clear_sky_alt end if end if + ncid = nf90_close(ncid) contains ! ---------------------------------------------------------------------------- ! @@ -264,12 +283,12 @@ subroutine lw_clear_sky_default lw_sources, & sfc_emis, & fluxes)) - call write_broadband_field(input_file, flux_up, "lw_flux_up", "LW flux up") - call write_broadband_field(input_file, flux_dn, "lw_flux_dn", "LW flux dn") - call write_broadband_field(input_file, flux_net, "lw_flux_net", "LW flux net") + call write_broadband_field(flux_up, "lw_flux_up", "LW flux up") + call write_broadband_field(flux_dn, "lw_flux_dn", "LW flux dn") + call write_broadband_field(flux_net, "lw_flux_net", "LW flux net") call stop_on_err(compute_heating_rate(flux_up, flux_dn, p_lev, heating_rate)) - call write_broadband_field(input_file, heating_rate, & + call write_broadband_field(heating_rate, & "lw_flux_hr_default", "LW heating rate", vert_dim_name = "layer") ! ! Test for mo_fluxes_broadband for computing only net flux @@ -280,7 +299,7 @@ subroutine lw_clear_sky_default lw_sources, & sfc_emis, & fluxes)) - call write_broadband_field(input_file, flux_net, "lw_flux_net_2", "LW flux net, direct") + call write_broadband_field(flux_net, "lw_flux_net_2", "LW flux net, direct") fluxes%flux_up => flux_up fluxes%flux_dn => flux_dn nullify(fluxes%flux_net) @@ -300,8 +319,8 @@ subroutine lw_clear_sky_notlev lw_sources, & sfc_emis, & fluxes)) - call write_broadband_field(input_file, flux_up, "lw_flux_up_notlev", "LW flux up, no level temperatures") - call write_broadband_field(input_file, flux_dn, "lw_flux_dn_notlev", "LW flux dn, no level temperatures") + call write_broadband_field(flux_up, "lw_flux_up_notlev", "LW flux up, no level temperatures") + call write_broadband_field(flux_dn, "lw_flux_dn_notlev", "LW flux dn, no level temperatures") end subroutine lw_clear_sky_notlev ! ---------------------------------------------------------------------------- ! @@ -318,8 +337,8 @@ subroutine lw_clear_sky_3ang lw_sources, & sfc_emis, & fluxes, n_gauss_angles=3)) - call write_broadband_field(input_file, flux_up, "lw_flux_up_3ang", "LW flux up, three quadrature angles") - call write_broadband_field(input_file, flux_dn, "lw_flux_dn_3ang", "LW flux dn, three quadrature angles") + call write_broadband_field(flux_up, "lw_flux_up_3ang", "LW flux up, three quadrature angles") + call write_broadband_field(flux_dn, "lw_flux_dn_3ang", "LW flux dn, three quadrature angles") end subroutine lw_clear_sky_3ang ! ---------------------------------------------------------------------------- ! @@ -338,8 +357,8 @@ subroutine lw_clear_sky_optangle lw_sources, & sfc_emis, & fluxes, lw_Ds=lw_Ds)) - call write_broadband_field(input_file, flux_up, "lw_flux_up_optang", "LW flux up, single optimal angles") - call write_broadband_field(input_file, flux_dn, "lw_flux_dn_optang", "LW flux dn, single optimal angles") + call write_broadband_field(flux_up, "lw_flux_up_optang", "LW flux up, single optimal angles") + call write_broadband_field(flux_dn, "lw_flux_dn_optang", "LW flux dn, single optimal angles") end subroutine lw_clear_sky_optangle ! ---------------------------------------------------------------------------- ! @@ -359,9 +378,9 @@ subroutine lw_clear_sky_jaco sfc_emis, & fluxes, & flux_up_Jac = jFluxUp)) - call write_broadband_field(input_file, flux_up, "lw_flux_up_jaco", "LW flux up, computing Jaobians") - call write_broadband_field(input_file, flux_dn, "lw_flux_dn_jaco", "LW flux dn, computing Jaobians") - call write_broadband_field(input_file, jFluxUp, "lw_jaco_up" , "Jacobian of LW flux up to surface temperature") + call write_broadband_field(flux_up, "lw_flux_up_jaco", "LW flux up, computing Jaobians") + call write_broadband_field(flux_dn, "lw_flux_dn_jaco", "LW flux dn, computing Jaobians") + call write_broadband_field(jFluxUp, "lw_jaco_up" , "Jacobian of LW flux up to surface temperature") call stop_on_err(gas_optics%gas_optics(p_lay, p_lev, & t_lay, sfc_t + 1._wp, & @@ -373,8 +392,8 @@ subroutine lw_clear_sky_jaco lw_sources, & sfc_emis, & fluxes)) - call write_broadband_field(input_file, flux_up, "lw_flux_up_stp1", "LW flux up, surface T+1K") - call write_broadband_field(input_file, flux_dn, "lw_flux_dn_stp1", "LW flux dn, surface T+1K") + call write_broadband_field(flux_up, "lw_flux_up_stp1", "LW flux up, surface T+1K") + call write_broadband_field(flux_dn, "lw_flux_dn_stp1", "LW flux dn, surface T+1K") end subroutine lw_clear_sky_jaco ! ---------------------------------------------------------------------------- ! @@ -394,15 +413,15 @@ subroutine lw_clear_sky_2str lw_sources, & sfc_emis, & fluxes)) - call write_broadband_field(input_file, flux_up, "lw_flux_up_1rescl", "LW flux up, clear-sky _1rescl") - call write_broadband_field(input_file, flux_dn, "lw_flux_dn_1rescl", "LW flux dn, clear-sky _1rescl") + call write_broadband_field(flux_up, "lw_flux_up_1rescl", "LW flux up, clear-sky _1rescl") + call write_broadband_field(flux_dn, "lw_flux_dn_1rescl", "LW flux dn, clear-sky _1rescl") call stop_on_err(rte_lw(atmos, & lw_sources, & sfc_emis, & fluxes, use_2stream=.true.)) - call write_broadband_field(input_file, flux_up, "lw_flux_up_2str", "LW flux up, clear-sky _2str") - call write_broadband_field(input_file, flux_dn, "lw_flux_dn_2str", "LW flux dn, clear-sky _2str") + call write_broadband_field(flux_up, "lw_flux_up_2str", "LW flux up, clear-sky _2str") + call write_broadband_field(flux_dn, "lw_flux_dn_2str", "LW flux dn, clear-sky _2str") end subroutine lw_clear_sky_2str ! ---------------------------------------------------------------------------- @@ -422,11 +441,11 @@ subroutine lw_clear_sky_alt lw_sources, & sfc_emis, & fluxes)) - call write_broadband_field(input_file, flux_up, "lw_flux_up_alt", "LW flux up, fewer g-points") - call write_broadband_field(input_file, flux_dn, "lw_flux_dn_alt", "LW flux dn, fewer g-points") - call write_broadband_field(input_file, flux_net, "lw_flux_net_alt", "LW flux ne, fewer g-pointst") + call write_broadband_field(flux_up, "lw_flux_up_alt", "LW flux up, fewer g-points") + call write_broadband_field(flux_dn, "lw_flux_dn_alt", "LW flux dn, fewer g-points") + call write_broadband_field(flux_net, "lw_flux_net_alt", "LW flux ne, fewer g-pointst") call stop_on_err(compute_heating_rate(flux_up, flux_dn, p_lev, heating_rate)) - call write_broadband_field(input_file, heating_rate, & + call write_broadband_field(heating_rate, & "lw_flux_hr_alt", "LW heating rate, fewer g-points", & vert_dim_name = "layer") @@ -435,11 +454,11 @@ subroutine lw_clear_sky_alt lw_sources, & sfc_emis, & fluxes, lw_Ds=lw_Ds)) - call write_broadband_field(input_file, flux_up, "lw_flux_up_alt_oa", "LW flux up, fewer g-points, opt. angle") - call write_broadband_field(input_file, flux_dn, "lw_flux_dn_alt_oa", "LW flux dn, fewer g-points, opt. angle") - call write_broadband_field(input_file, flux_net, "lw_flux_net_alt_oa", "LW flux ne, fewer g-points, opt. angle") + call write_broadband_field(flux_up, "lw_flux_up_alt_oa", "LW flux up, fewer g-points, opt. angle") + call write_broadband_field(flux_dn, "lw_flux_dn_alt_oa", "LW flux dn, fewer g-points, opt. angle") + call write_broadband_field(flux_net, "lw_flux_net_alt_oa", "LW flux ne, fewer g-points, opt. angle") call stop_on_err(compute_heating_rate(flux_up, flux_dn, p_lev, heating_rate)) - call write_broadband_field(input_file, heating_rate, & + call write_broadband_field(heating_rate, & "lw_flux_hr_alt_oa", "LW heating rate, fewer g-points, opt. angle", & vert_dim_name = "layer") call gas_optics%finalize() @@ -479,8 +498,8 @@ subroutine sw_clear_sky_default flux_up = 0._wp flux_dn = 0._wp end where - call write_broadband_field(input_file, flux_up, "sw_flux_up", "SW flux up") - call write_broadband_field(input_file, flux_dn, "sw_flux_dn", "SW flux dn") + call write_broadband_field(flux_up, "sw_flux_up", "SW flux up") + call write_broadband_field(flux_dn, "sw_flux_dn", "SW flux dn") end subroutine sw_clear_sky_default ! ---------------------------------------------------------------------------- subroutine sw_clear_sky_alt @@ -509,8 +528,8 @@ subroutine sw_clear_sky_alt flux_up = 0._wp flux_dn = 0._wp end where - call write_broadband_field(input_file, flux_up, "sw_flux_up_alt", "SW flux up, fewer g-points") - call write_broadband_field(input_file, flux_dn, "sw_flux_dn_alt", "SW flux dn, fewer g-points") + call write_broadband_field(flux_up, "sw_flux_up_alt", "SW flux up, fewer g-points") + call write_broadband_field(flux_dn, "sw_flux_dn_alt", "SW flux dn, fewer g-points") end subroutine sw_clear_sky_alt ! ---------------------------------------------------------------------------- subroutine make_optical_props_1scl(gas_optics) @@ -552,4 +571,44 @@ subroutine make_optical_props_2str(gas_optics) end select end subroutine make_optical_props_2str ! ---------------------------------------------------------------------------- -end program rte_clear_sky_regression + subroutine write_broadband_field(field, field_name, field_description, col_dim_name, vert_dim_name) + ! + ! Write a field defined by column and some vertical dimension (lev or lay)) + ! + real(wp), dimension(:,:), intent(in) :: field + character(len=*), intent(in) :: field_name, field_description + character(len=*), optional, & + intent(in) ::col_dim_name, vert_dim_name + ! ------------------- + integer :: varid, ncol, nlev + ! + ! Names of column (first) and vertical (second) dimension. + ! Because they are used in an array constuctor the need to have the same number of characters + ! + character(len=32) :: cdim, vdim + ! ------------------- + cdim = "site " + vdim = "level" + if(present(col_dim_name)) cdim = col_dim_name + if(present(vert_dim_name)) vdim = vert_dim_name + + ncol = size(field, dim=1) + nlev = size(field, dim=2) + + call create_var(ncid, trim(field_name), [cdim, vdim], [ncol, nlev]) + call stop_on_err(write_field(ncid, trim(field_name), field)) + ! + ! Adding descriptive text as an attribute means knowing the varid + ! + if(nf90_inq_varid(ncid, trim(field_name), varid) /= NF90_NOERR) & + call stop_on_err("Can't find variable " // trim(field_name)) + if(nf90_redef(ncid) /= NF90_NOERR) & + call stop_on_err("write_broadband_field: can't put file into redefine mode") + if(nf90_put_att(ncid, varid, "description", trim(field_description)) /= NF90_NOERR) & + call stop_on_err("Can't write 'description' attribute to variable " // trim(field_name)) + if(nf90_enddef(ncid) /= NF90_NOERR) & + call stop_on_err("write_broadband_field: fail to to end redefinition??") + + end subroutine write_broadband_field + ! ---------------------------------------------------------------------------- +end program diff --git a/tests/intel-codecov.sh b/tests/intel-codecov.sh deleted file mode 100644 index 90422fda2..000000000 --- a/tests/intel-codecov.sh +++ /dev/null @@ -1,75 +0,0 @@ -#!/bin/bash -ulimit -s hard -export FC=ifort -export FCFLAGS="-m64 -prof-gen=srcpos -g -traceback -heap-arrays -assume realloc_lhs -extend-source 132" -# -# Intel specific - where will the profiling files be generated? -# -export RRTMGP_ROOT=`cd ..;pwd` -export RRTMGP_BUILD=${RRTMGP_ROOT}/build -export PROF_DIR=$PWD -# -# Environment variables for netCDF Fortran and C installations -# -export NFHOME=${HOME}/Applications/${FC} -export NCHOME=/opt/local - -# -# An Anaconda environent with modules needed for other python scripts -# (xarray, matplotlib, ...) -# -source activate pangeo -cd ${PROF_DIR} -rm -rf *.dyn pgopti.* CODE_COVERAGE.html CodeCoverage/ -# -# Build RTE+RRTMGP librarues -# -make -C ${RRTMGP_BUILD} clean -make -C ${RRTMGP_BUILD} -j 4 || exit 1 - -# -# Build and run RFMIP examples -# -cd ${RRTMGP_ROOT}/examples/rfmip-clear-sky || exit 1 -export FCFLAGS+=" -I${RRTMGP_BUILD} -I${NFHOME}/include" -export LDFLAGS+=" -L${RRTMGP_BUILD} -L${NFHOME}/lib -L${NCHOME}/lib -lrte -lrrtmgp -lnetcdff -lnetcdf" -make clean || exit 1 -make -j 4 || exit 1 -python ./stage_files.py -python ./run-rfmip-examples.py -python ./compare-to-reference.py --fail=7.e-4 -make clean -# -# Build and run all-sky examples -# -cd ${RRTMGP_ROOT}/examples/all-sky || exit 1 -make clean || exit 1 -make -j 4 || exit 1 -python ./run-allsky-example.py -python ./compare-to-reference.py -make clean -# -# Build and run regression tests -# -cd ${PROF_DIR} || exit 1 -make clean || exit 1 -make -j 4 || exit 1 -cp ${RRTMGP_DATA}/examples/rfmip-clear-sky/inputs/multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc test_atmospheres.nc -./clear_sky_regression test_atmospheres.nc ${RRTMGP_DATA}/rrtmgp-gas-lw-g256.nc -./clear_sky_regression test_atmospheres.nc ${RRTMGP_DATA}/rrtmgp-gas-sw-g224.nc -# Need to repeat for openacc-kernels - -# -# Merge -# -cd ${PROF_DIR} -profmerge -a -echo " -mo_ -~mo_simple_netcdf -~mo_rfmip_io -~mo_testing_io -~mo_garand_atmos_io -~mo_load" > intel_codecov_filter.txt -codecov -prj rte-rrtmgp -comp intel_codecov_filter.txt -rm intel_codecov_filter.txt diff --git a/tests/mo_testing_io.F90 b/tests/mo_testing_io.F90 deleted file mode 100644 index 8444cac56..000000000 --- a/tests/mo_testing_io.F90 +++ /dev/null @@ -1,60 +0,0 @@ -!-------------------------------------------------------------------------------------------------------------------- -module mo_testing_io - ! - ! RTE+RRTMGP modules - ! - use mo_rte_kind, only: wp - ! - ! NetCDF I/O routines, shared with other RTE+RRTMGP examples - ! - use mo_simple_netcdf, only: write_field, create_dim, create_var - use netcdf - implicit none - private - public :: write_broadband_field -contains - !-------------------------------------------------------------------------------------------------------------------- - subroutine write_broadband_field(fileName, field, field_name, field_description, col_dim_name, vert_dim_name) - ! - ! Write a field defined by column and some vertical dimension (lev or lay)) - ! - character(len=*), intent(in) :: fileName - real(wp), dimension(:,:), intent(in) :: field - character(len=*), intent(in) :: field_name, field_description - character(len=*), optional, & - intent(in) ::col_dim_name, vert_dim_name - ! ------------------- - integer :: ncid, varid, ncol, nlev - ! - ! Names of column (first) and vertical (second) dimension. - ! Because they are used in an array constuctor the need to have the same number of characters - ! - character(len=32) :: cdim, vdim - ! ------------------- - cdim = "site " - vdim = "level" - if(present(col_dim_name)) cdim = col_dim_name - if(present(vert_dim_name)) vdim = vert_dim_name - - if(nf90_open(trim(fileName), NF90_WRITE, ncid) /= NF90_NOERR) & - call stop_on_err("write_fluxes: can't open file " // trim(fileName)) - - ncol = size(field, dim=1) - nlev = size(field, dim=2) - - call create_dim(ncid, trim(cdim), ncol) - call create_var(ncid, trim(field_name), [cdim, vdim], [ncol, nlev]) - call stop_on_err(write_field(ncid, trim(field_name), field)) - ! - ! Adding descriptive text as an attribute means knowing the varid - ! - if(nf90_inq_varid(ncid, trim(field_name), varid) /= NF90_NOERR) & - call stop_on_err("Can't find variable " // trim(field_name)) - if(nf90_put_att(ncid, varid, "description", trim(field_description)) /= NF90_NOERR) & - call stop_on_err("Can't write 'description' attribute to variable " // trim(field_name)) - - ncid = nf90_close(ncid) - - end subroutine write_broadband_field - !-------------------------------------------------------------------------------------------------------------------- -end module mo_testing_io diff --git a/tests/validation-plots.py b/tests/validation-plots.py index 99847da97..9564e9216 100755 --- a/tests/validation-plots.py +++ b/tests/validation-plots.py @@ -67,8 +67,21 @@ def construct_lbl_esgf_root(var, esgf_node="llnl"): def main(): parser = argparse.ArgumentParser() parser.add_argument( - "--input_file", - help="Path to the input NetCDF file (test_atmosphere.nc)." + "--state_file", + help="Path to the state information NetCDF file.", + default="multiple_input4MIPs_radiation_RFMIP_UColorado-RFMIP-1-2_none.nc" + ) + parser.add_argument( + "--lw_vars_file", + help="Path to the LW results file", + default="lw_flux_variants.nc" + + ) + parser.add_argument( + "--sw_vars_file", + help="Path to the SW results file", + default="sw_flux_variants.nc" + ) parser.add_argument( "--output_pdf", @@ -77,7 +90,9 @@ def main(): ) args = parser.parse_args() - input_file = args.input_file + state_file = args.state_file + lw_vars_file = args.lw_vars_file + sw_vars_file = args.sw_vars_file output_pdf = args.output_pdf warnings.simplefilter("ignore", xr.SerializationWarning) @@ -105,7 +120,7 @@ def main(): # # Open the test results # - gp = xr.open_dataset(input_file) + gp = xr.open_mfdataset([state_file, lw_vars_file, sw_vars_file]) # # Does the flux plus the Jacobian equal a calculation with perturbed surface # temperature? From ce661609f7fec3698aa2e7450c1b483f1a03aa45 Mon Sep 17 00:00:00 2001 From: Sergey Kosukhin Date: Mon, 6 Jan 2025 19:07:24 +0100 Subject: [PATCH 56/57] cmake: install data files --- CMakeLists.txt | 25 ++++++++++++++++++++++--- 1 file changed, 22 insertions(+), 3 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index c5bdc7f17..1e933892b 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -71,6 +71,10 @@ exit(tuple(map(int, xarray.__version__.split('.'))) < (0, 12, 2))" if(RRTMGP_DATA) add_test(NAME fetch_rrtmgp_data COMMAND ${CMAKE_COMMAND} -E true) + message( + NOTICE + "Using an external dataset from ${RRTMGP_DATA}: the data files will not be installed" + ) else() set(RRTMGP_DATA "${PROJECT_BINARY_DIR}/rrtmgp-data") @@ -87,12 +91,27 @@ exit(tuple(map(int, xarray.__version__.split('.'))) < (0, 12, 2))" BUILD_COMMAND "" INSTALL_COMMAND "" ) - add_test( - NAME fetch_rrtmgp_data - COMMAND + + set(fetch_rrtmgp_data_command ${CMAKE_COMMAND} --build ${CMAKE_CURRENT_BINARY_DIR} --config "$" --target rrtmgp-data ) + + add_test(NAME fetch_rrtmgp_data COMMAND ${fetch_rrtmgp_data_command}) + + install(CODE "execute_process(COMMAND ${fetch_rrtmgp_data_command})") + install( + FILES # cmake-format: sort + ${RRTMGP_DATA}/rrtmgp-aerosols-merra-lw.nc + ${RRTMGP_DATA}/rrtmgp-aerosols-merra-sw.nc + ${RRTMGP_DATA}/rrtmgp-clouds-lw.nc + ${RRTMGP_DATA}/rrtmgp-clouds-sw.nc + ${RRTMGP_DATA}/rrtmgp-gas-lw-g128.nc + ${RRTMGP_DATA}/rrtmgp-gas-lw-g256.nc + ${RRTMGP_DATA}/rrtmgp-gas-sw-g112.nc + ${RRTMGP_DATA}/rrtmgp-gas-sw-g224.nc + DESTINATION ${CMAKE_INSTALL_DATAROOTDIR}/rte-rrtmgp/ + ) endif() set_tests_properties( From 6769f2b08f1ad016c5b524def6299c94931f36fa Mon Sep 17 00:00:00 2001 From: Robert Pincus Date: Mon, 6 Jan 2025 13:11:29 -0500 Subject: [PATCH 57/57] Project version in CMake to 1.9.0 Updates project version in CMakeLists.txt. Not the same as the Github release version number! --- CMakeLists.txt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index c5bdc7f17..158edfdec 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -2,7 +2,7 @@ cmake_minimum_required(VERSION 3.18) project( rte-rrtmgp - VERSION 1.8 + VERSION 1.9.0 LANGUAGES Fortran )