diff --git a/.ci-pipelines/build-matrix.yml b/.ci-pipelines/build-matrix.yml deleted file mode 100644 index dd8e5757..00000000 --- a/.ci-pipelines/build-matrix.yml +++ /dev/null @@ -1,63 +0,0 @@ -#============================================================================= -# Build matrix pipeline: -# -# This pipeline checks that pre-releases and the main branch -# compile in a wide variety of build environments. This pipeline -# is intended to be a rigorous check of HEMCO's build. -# -# This pipeline triggers on tagged pre-releases (alpha and beta -# versions, as well as release candidates). Commits to the main -# branch also trigger this pipeline. -#============================================================================= -trigger: - branches: - include: - - main - exclude: - - bugfix* - - dev* - - feature* - tags: - include: # Semantic versioning 2.0.0 examples: - - '*-alpha*' # 12.7.1-alpha.3 - - '*-beta*' # 12.7.0-beta.1 - - '*-rc*' # 12.7.0-rc.1 -pr: none - -# Basic agent set up -pool: - vmImage: 'ubuntu-latest' - - -# Define the "matrix" of build images to try building HEMCO in -strategy: - matrix: - ubuntu_basic: - containerImage: geoschem/buildmatrix:netcdf-ubuntu - gcc8: - containerImage: geoschem/buildmatrix:netcdf-gcc8 - gcc9: - containerImage: geoschem/buildmatrix:netcdf-gcc9 - gcc10: - containerImage: geoschem/buildmatrix:netcdf-gcc10 -container: $[ variables['containerImage'] ] - - -# Try building HEMCO (this is run for each "matrix" entry above) -steps: -- checkout: self - submodules: true -- script: | - . /opt/spack/share/spack/setup-env.sh - export CC=gcc - export CXX=g++ - export FC=gfortran - set -x - spack load cmake - spack load netcdf-c - spack load netcdf-fortran - mkdir build - cd build - cmake -DCMAKE_COLOR_MAKEFILE=FALSE $(Build.Repository.LocalPath) - make -j - displayName: 'Building HEMCO' diff --git a/.ci-pipelines/quick-build.yml b/.ci-pipelines/quick-build.yml deleted file mode 100644 index 70aa42c9..00000000 --- a/.ci-pipelines/quick-build.yml +++ /dev/null @@ -1,49 +0,0 @@ -#============================================================================= -# Quick build pipeline: -# -# This pipeline checks that commits and open pull requests don't -# introduce compiler errors. This is meant to be a quick and simple -# check that runs frequently. -# -# This pipeline triggers on commits to development and bug-fix -# branches. Commits to the main branch do not trigger this pipeline -# because those are tested against the build matrix. Commits to -# feature branches do not trigger this pipeline, but open pull requests -# and commits to pull requests do. -#============================================================================= -trigger: - branches: - include: - - dev* - - patch* - - bugfix* -pr: - branches: - include: - - '*' - drafts: false - -# Basic agent and container set up -pool: - vmImage: 'ubuntu-latest' -container: geoschem/buildmatrix:netcdf-ubuntu - - -# Try building HEMCO -steps: -- checkout: self - submodules: true -- script: | - . /opt/spack/share/spack/setup-env.sh - export CC=gcc - export CXX=g++ - export FC=gfortran - set -x - spack load cmake - spack load netcdf-c - spack load netcdf-fortran - mkdir build - cd build - cmake -DCMAKE_COLOR_MAKEFILE=FALSE $(Build.Repository.LocalPath) - make -j - displayName: 'Building HEMCO' diff --git a/.ci-pipelines/release.dockerfile b/.ci-pipelines/release.dockerfile deleted file mode 100644 index f03b8bb9..00000000 --- a/.ci-pipelines/release.dockerfile +++ /dev/null @@ -1,36 +0,0 @@ -FROM liambindle/penelope:0.1.0-ubuntu16.04-gcc7-netcdf4.5.0-netcdff4.4.4 - -# Make a directory to install HEMCO to -RUN mkdir /opt/hemco && mkdir /opt/hemco/bin - -# Copy the HEMCO repository (".") to /hemco-src -# This means this docker build command's context must be -# HEMCO's root source code directory -COPY . /hemco-src -RUN cd /hemco-src \ -&& mkdir build - -# Commands to properly set up the environment inside the container -RUN echo "module load gcc/7" >> /init.rc \ -&& echo "spack load hdf5" >> /init.rc \ -&& echo "spack load netcdf" >> /init.rc \ -&& echo "spack load netcdf-fortran" >> /init.rc \ -&& echo "export PATH=$PATH:/opt/hemco/bin" >> /init.rc - -# Make bash the default shell -SHELL ["/bin/bash", "-c"] - -# Build Standard and copy the executable to /opt/hemco/bin -RUN cd /hemco-src/build \ -&& cmake -DRUNDIR=IGNORE -DCMAKE_COLOR_MAKEFILE=FALSE .. \ -&& make -j install \ -&& cp hemco_standalone /opt/hemco/bin/hemco-standard \ -&& rm -rf /hemco-src/build/* - -RUN rm -rf /hemco-src - -RUN echo "#!/usr/bin/env bash" > /usr/bin/start-container.sh \ -&& echo ". /init.rc" >> /usr/bin/start-container.sh \ -&& echo 'if [ $# -gt 0 ]; then exec "$@"; else /bin/bash ; fi' >> /usr/bin/start-container.sh \ -&& chmod +x /usr/bin/start-container.sh -ENTRYPOINT ["start-container.sh"] diff --git a/.ci-pipelines/release.yml b/.ci-pipelines/release.yml deleted file mode 100644 index 20ae1ccb..00000000 --- a/.ci-pipelines/release.yml +++ /dev/null @@ -1,53 +0,0 @@ -#============================================================================= -# Release pipeline: -# -# This pipeline performs deployment actions upon a HEMCO release. -# Currently, the only deployment action is to build and push a docker -# container with prebuilt HEMCO executable for the newly released version. - -# This pipeline is triggered by tagged versions excluding -# pre-releases. -#============================================================================= -trigger: - branches: - exclude: - - '*' - tags: - include: - - '*' - exclude: - - '*-alpha*' - - '*-beta*' - - '*-rc*' -pr: none - - -# Basic agent set up -pool: - vmImage: 'ubuntu-latest' - -# Login to Docker Hub, build the image, and push the built image -# to Docker Hub -steps: - - script: VERSION_TAG=`git describe --tags` && echo "##vso[task.setvariable variable=VERSION_TAG]$VERSION_TAG" - displayName: Get the repo's tag - - task: Docker@2 - displayName: Login to Docker Hub - inputs: - command: login - containerRegistry: DockerHub # The name of the service connection in the Azure project - - task: Docker@2 - displayName: Build image - inputs: - command: build - buildContext: $(Build.Repository.LocalPath) # The path to the source code repo - Dockerfile: .ci-pipelines/release.dockerfile - repository: geoschemdev/hemco # Docker Hub repository - tags: $(VERSION_TAG) # Source code repo's tag - - task: Docker@2 - displayName: Push image - inputs: - containerRegistry: DockerHub - repository: geoschemdev/hemco # Docker Hub repository - command: push - tags: $(VERSION_TAG) diff --git a/.github/workflows/lint-ci-workflows.yml b/.github/workflows/lint-ci-workflows.yml new file mode 100644 index 00000000..2f09ab47 --- /dev/null +++ b/.github/workflows/lint-ci-workflows.yml @@ -0,0 +1,77 @@ +# Workflow to run linting checks on source +name: Lint + +# Controls when the workflow will run +on: + # Triggers the workflow on pushes to the "main" or "dev/"* branches, + # i.e., PR merges + push: + branches: [ "main", "dev/*" ] + + # Triggers the workflow on pushes to open pull requests with code changes + pull_request: + paths: + - '.github/workflows/*.yml' + + # Allows you to run this workflow manually from the Actions tab + # (usually leave it blank) + workflow_dispatch: + +# Allow the jobs to read the secret GitHub token +permissions: + contents: read + +# Cancel jobs running if new commits are pushed +concurrency: + group: ${{ github.workflow }}-${{ github.event.pull_request.number || github.ref }} + cancel-in-progress: true + +# Workflow run - one or more jobs that can run sequentially or in parallel +jobs: + + # This workflow contains a single job called "lint" + lint: + + # The type of runner that the job will run on + runs-on: ubuntu-latest + + # Don't quit the Action at the first + strategy: + fail-fast: false + + # GitHub secret token + env: + GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} + + # Steps represent a sequence of tasks that will be + # executed as part of the job + steps: + + # Checks-out your repository under $GITHUB_WORKSPACE, + # so your job can access it + - name: Checkout code + with: + persist-credentials: false + uses: actions/checkout@v4 + + # Installs Python 3.x + - name: Install Python + uses: actions/setup-python@v5 + with: + python-version: '3.x' + + # Installs Python packages + - name: Install dependencies + run: | + python -m pip install --upgrade pip + python -m venv ci_venv + . ci_venv/bin/activate + pip install zizmor==0.9.2 + + # Apply GitHub Actions linter, zizmor + - name: zizmor + if: always() + run: | + cd ${{ github.workspace }} + . ci_venv/bin/activate + zizmor .github/workflows/*.yml diff --git a/.github/workflows/mac.yml b/.github/workflows/mac.yml index 7c33b05b..0227e82a 100644 --- a/.github/workflows/mac.yml +++ b/.github/workflows/mac.yml @@ -4,7 +4,16 @@ on: push: branches: - main + - dev/** + - release + - release/** pull_request: + branches: + - main + - dev + - dev/** + - release + - release/** workflow_dispatch: concurrency: @@ -17,13 +26,16 @@ jobs: strategy: fail-fast: false matrix: - gcc_version: [12, 13, 14] + gcc_version: [13, 14, 15] build_type: [Debug, Release] env: FC: gfortran-${{ matrix.gcc_version }} steps: - - uses: actions/checkout@v4 + - name: Checkout code + uses: actions/checkout@v4 + with: + persist-credentials: false - name: Install dependencies run: brew install netcdf netcdf-fortran diff --git a/.github/workflows/ubuntu.yml b/.github/workflows/ubuntu.yml index 53cf6f79..904241cd 100644 --- a/.github/workflows/ubuntu.yml +++ b/.github/workflows/ubuntu.yml @@ -4,7 +4,17 @@ on: push: branches: - main + - dev + - dev/** + - release + - release/** pull_request: + branches: + - main + - dev + - dev/** + - release + - release/** workflow_dispatch: concurrency: @@ -25,7 +35,9 @@ jobs: steps: - name: Checkout code uses: actions/checkout@v4 - + with: + persist-credentials: false + - name: Install dependencies run: | sudo apt-get update @@ -39,4 +51,4 @@ jobs: - name: Run tests run: ctest -C ${{ matrix.build_type }} --rerun-failed --output-on-failure . --verbose - working-directory: build \ No newline at end of file + working-directory: build diff --git a/.github/workflows/windows.yml b/.github/workflows/windows.yml index 1fc812d0..745745ee 100644 --- a/.github/workflows/windows.yml +++ b/.github/workflows/windows.yml @@ -4,7 +4,17 @@ on: push: branches: - main + - dev + - dev/** + - release + - release/** pull_request: + branches: + - main + - dev + - dev/** + - release + - release/** workflow_dispatch: concurrency: @@ -22,7 +32,9 @@ jobs: steps: - name: Checkout code uses: actions/checkout@v4 - + with: + persist-credentials: false + - name: Setup MSYS2 uses: msys2/setup-msys2@v2 with: @@ -52,4 +64,4 @@ jobs: - name: Run tests shell: msys2 {0} run: ctest -C ${{ matrix.build_type }} --rerun-failed --output-on-failure . --verbose - working-directory: build \ No newline at end of file + working-directory: build diff --git a/CHANGELOG.md b/CHANGELOG.md index affa5879..55dc92a6 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,49 @@ All notable changes to this project will be documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). +## [3.12.0] - 2026-02-05 +### Added +- Added the functionality of selectively applying gridded scaling factor based on the value of mask ID from a gridded file +- Added functions `HCO_WordWrapPrint` and `HCO_CountMatches` as `PRIVATE` routines to `hco_error_mod.F90` +- Added function `IO_ErrMsg` to `hcoio_read_std_mod.F90` to generate a replacement error message for the "cannot find field for current simulation time" message +- Added GNU compiler collection version 15 to the GitHub action that builds HEMCO on MacOS +- Added `DustL23M` extension module `src/Extensions/hcox_dustl23m_mod.F90` +- Added call to `HCO_SetPBLm` in routine `HCOI_SA_RUN` so that the PBL height will evolve with time in the HEMCO standalone +- Added `ExtState%TSKIN` for skin temperature and `ExtState%HFLUX` for sensible heat flux +- Added `run/config_for_offline_emissions` folder to contain sample `HEMCO_Config.rc` files +- Added `do_sum` argument to routine `Collapse` in`src/Core/hco_interp_mod.F90` +- Added `docs/read_the_docs_environment.yml` Conda environment file + +### Changed +- Updated `lint-ci-workflows` to run on `main` and `dev/*` branches +- Updated badges on `README.md` and `docs/source/index.rst` +- Updated GitHub Actions to run if the branch name matches `dev`, `dev/**`, `release`, `release/**` +- Rewrote "cannot find field for current simulation time" error message for clarity +- Updated `HCO_Error` and `HCO_Warning` to call `HCO_WordWrapPrint` to wrap messages to 78 characters wide +- Replaced terse error messages in `hcoio_read_std_mod.F90` with more descriptive ones +- Updated error messages in routine `ExtStateInit` to be more descriptive +- Renamed `ExtState%SNOWHGT` to `ExtState%SNOMAS` +- Changed call to `ExtDat_Set` for `ExtData%SNOMAS` to read data from the GMAO `SNOMAS` field instead of `SNOWHGT` +- Updated `run/HEMCO_sa_Spec.rc` to be consistent with the new dust species +- Updated `run/createRunDir.sh` to copy the`cleanRunDir.sh` script to the run directory +- Updated comment headers and removed GCHP-specific text in `run/cleanRunDir.sh` +- Replaced `DST{1..4}` with `DSTbin{1..7}` and renumbered lines accordingly in `run/HEMCO_sa_Spec.rc` +- Updated link to current HEMCO Standalone documentation in `run/README` +- Updated ReadTheDocs documentation for the addition of `DustL23M` and removal of `DustDead` and DustGinoux` extensions +- Updated `geos-chem-shared-docs/editing_these_docs.rst` with instructions for using a Conda environment to build RTD doc + +### Fixed +- Fixed security issues in GitHub Actions +- Fixed bug in routine `Register_Species` caused by a null string being passed to `HCO_Msg` +- Fixed bug in `hco_interp_mod.F90` where `Met_DELPDRY` was being averaged in the vertical instead of summed + +### Removed +- Removed Microsoft Azure Dev Pipeline continuous integration tests +- Removed GNU Compiler Collection version 12 from the GitHub action that builds HEMCO on MacOS +- Removed `ExtState%PBLH` (and code that referenced this), as PBL height may be obtained from `HcoState%Grid%PBLHEIGHT`. +- Removed `DustDead` source code (`src/Extensions/hcox_dustdead_mod.F`) +- Removed `DustGinoux` source code (`src/Extensions/hcox_dustginoux_mod.F90`) + ## [3.11.2] - 2025-07-28 ### Changed - Increase string length for reading lines from HEMCO standalone grid file for 0.125x0.15625 global resolution diff --git a/CMakeLists.txt b/CMakeLists.txt index 5d18c862..e5527dc0 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -1,7 +1,7 @@ # HEMCO/CMakeLists.txt cmake_minimum_required(VERSION 3.5) -project(HEMCO VERSION 3.11.2 LANGUAGES Fortran) +project(HEMCO VERSION 3.12.0 LANGUAGES Fortran) # Reminder: Make sure to also update version in src/Core/hco_error_mod.F90 #----------------------------------------------------------------------------- diff --git a/README.md b/README.md index fc95d3f5..45168c94 100644 --- a/README.md +++ b/README.md @@ -1,13 +1,12 @@ # HEMCO: The Harmonized Emissions Component

- - - -
- DOI - - + Latest release + Release date + DOI
+ License + ReadTheDocs Ubuntu Mac Windows diff --git a/docs/read_the_docs_environment.yml b/docs/read_the_docs_environment.yml new file mode 100644 index 00000000..5aefcac1 --- /dev/null +++ b/docs/read_the_docs_environment.yml @@ -0,0 +1,24 @@ +--- +# ====================================================================== +# ReadTheDocs environment file +# +# If you wish to build a Mamba/Conda environment with the dependencies +# needed for building the ReadTheDocs documentation, use: +# +# $ mamba env create -n rtd_env --file=read_the_docs_environment.yml +# ====================================================================== +name: rtd_env +channels: + - conda-forge + - nodefaults +dependencies: + - python==3.12.0 + - sphinx==7.2.6 + - sphinx_rtd_theme==2.0.0 + - sphinxcontrib-bibtex==2.6.2 + - sphinx-autobuild==2021.3.14 + - recommonmark==0.7.1 + - docutils==0.20.1 + - jinja2==3.1.6 + + diff --git a/docs/source/conf.py b/docs/source/conf.py index c67cc1a6..11f27710 100644 --- a/docs/source/conf.py +++ b/docs/source/conf.py @@ -23,7 +23,7 @@ author = 'GEOS-Chem Support Team' # The full version, including alpha/beta/rc tags -release = '3.11.2' +release = '3.12.0' # -- General configuration --------------------------------------------------- diff --git a/docs/source/geos-chem-shared-docs b/docs/source/geos-chem-shared-docs index 3887938a..03078d47 160000 --- a/docs/source/geos-chem-shared-docs +++ b/docs/source/geos-chem-shared-docs @@ -1 +1 @@ -Subproject commit 3887938a14f933607b597e04436e1741f102d017 +Subproject commit 03078d47075177a7c2684664a6afe15024272234 diff --git a/docs/source/hco-ref-guide/extensions.rst b/docs/source/hco-ref-guide/extensions.rst index 19e10875..0d966289 100644 --- a/docs/source/hco-ref-guide/extensions.rst +++ b/docs/source/hco-ref-guide/extensions.rst @@ -33,28 +33,20 @@ be considered. DustAlk ------- -- **Species**: DSTAL1, DSTAL2, DSTAL3, DSTAL4 +- **Species**: DSTALbin1, DSTALbin2, DSTALbin3, DSTALbin4, DSTALbin5, + DSTALbin6, DSTALbin7 - **Reference**: Fairlie et al (check) -.. _hco-ext-list-dustdead: +.. _hco-ext-list-dustl23m: -DustDead +DustL23M -------- -Emissions of mineral dust from the DEAD dust mobilization model. +Emissions of mineral dust. -- **Species**: DST1, DST2, DST3, DST4 -- **Reference**: :cite:t:`Zender_et_al._2003` - -.. _hco-ext-list-dustginoux: - -DustGinoux ----------- - -Emissions of mineral dust from the P. Ginoux dust mobilization model. - -- **Species**: DST1, DST2, DST3, DST4 -- **Reference**: :cite:t:`Ginoux_et_al._2001` +- **Species**: DSTbin1, DSTbin2, DSTbin3, DSTbin4, DSTbin5, DSTbin6, + DSTbin7, TDST +- **Reference**: :cite:t:`Zhang_et_al._2025` .. _hco-ext-list-gcrnpbbe: @@ -67,7 +59,7 @@ Emissions of radionuclide species as used in the `GEOS-Chem - **Species**: Rn222, Be7, Be7Strat, Be10, Be10Strat If :literal:`ZHANG_Rn222` is :literal:`on`, then Rn222 emissions - will be computed according to :cite:t:`Zhang_et_al._2021`. +will be computed according to :cite:t:`Zhang_et_al._2021`. If :literal:`ZHANG_Rn222` is :literal:`off`, then Rn222 emissions will be computed according to :cite:t:`Jacob_et_al._1997`. @@ -280,257 +272,302 @@ Environmental fields used by HEMCO The following fields can be passed from the atmospheric model to HEMCO for use by the various extensions: -.. option:: AIR +AIR +--- - Air mass. +Air mass. - - **Dim**: xyz - - **Units**: kg - - **Used by**: :ref:`hco-ext-list-gcrnpbbe`, :ref:`hco-ext-list-paranox` +- **Dim**: xyz +- **Units**: kg +- **Used by**: :ref:`hco-ext-list-gcrnpbbe`, :ref:`hco-ext-list-paranox` -.. option:: AIRVOL +AIRVOL +------ - Air volume (i.e. volume of grid box). +Air volume (i.e. volume of grid box). - - **Dim**: xyz - - **Units**: kg - - **Used by**: :ref:`hco-ext-list-paranox` +- **Dim**: xyz +- **Units**: kg +- **Used by**: :ref:`hco-ext-list-paranox` -.. option:: ALBD +ALBD +---- - Surface albedo. +Surface albedo. - - **Dim**: xy - - **Units**: unitless - - **Used by**: :ref:`hco-ext-list-soilnox`, :ref:`hco-ext-list-seaflux` +- **Dim**: xy +- **Units**: unitless +- **Used by**: :ref:`hco-ext-list-soilnox`, :ref:`hco-ext-list-seaflux` -.. option:: CLDFRC +CLDFRC +------ - Cloud fraction +Cloud fraction - - **Dim**: xy - - **Units**: unitless - - **Used by**: :ref:`hco-ext-list-megan` +- **Dim**: xy +- **Units**: unitless +- **Used by**: :ref:`hco-ext-list-megan` -.. option:: CNV_MFC +CNV_MFC +------- - Convective mass flux. +Convective mass flux. - - **Dim**: xyz - - **Units**: kg/m2/s - - **Used by**: :ref:`hco-ext-list-lightnox` +- **Dim**: xyz +- **Units**: kg/m2/s +- **Used by**: :ref:`hco-ext-list-lightnox` -.. option:: FRAC_OF_PBL +FRAC_OF_PBL +----------- - Fraction of grid box within the planetary boundary layer (PBL). +Fraction of grid box within the planetary boundary layer (PBL). - - **Dim**: xyz - - **Units**: unitless - - **Used by**: :ref:`hco-ext-list-paranox`, :ref:`hco-ext-list-seaflux` +- **Dim**: xyz +- **Units**: unitless +- **Used by**: :ref:`hco-ext-list-paranox`, :ref:`hco-ext-list-seaflux` -.. option:: FRCLND +FRCLND +------ - Land fraction +Land fraction - - **Dim**: xy - - **Units**: unitless - - **Used by**: :ref:`hco-ext-list-gcrnpbbe`, :ref:`hco-ext-list-seaflux` +- **Dim**: xy +- **Units**: unitless +- **Used by**: :ref:`hco-ext-list-gcrnpbbe`, :ref:`hco-ext-list-seaflux` -.. option:: GWETROOT +GWETROOT +-------- - Root soil moisture. +Root soil moisture. +- **Dim**: xy +- **Units**: unitless +- **Used by**: :ref:`hco-ext-list-megan` + +GWETTOP +------- + +Top soil moisture. - **Dim**: xy - **Units**: unitless - - **Used by**: :ref:`hco-ext-list-megan` + - **Used by**: :ref:`hco-ext-list-dustl23m`, :ref:`hco-ext-list-megan` -.. option:: GWETTOP +HFLUX +----- - Top soil moisture. +Sensible heat flux (from turbulence). - - **Dim**: xy - - **Units**: unitless - - **Used by**: :ref:`hco-ext-list-megan` +- **Dim**: xy +- **Units**: W/m2 +- **Used by**: :ref:`hco-ext-list-dustl23m`, :ref:`hco-ext-list-megan` + +HNO3 +---- -.. option:: HNO3 +HNO3 mass. - HNO3 mass. +- **Dim**: xyz +- **Units**: kg +- **Used by**: :ref:`hco-ext-list-paranox` - - **Dim**: xyz - - **Units**: kg - - **Used by**: :ref:`hco-ext-list-paranox` +JO1D +---- -.. option:: JO1D +Photolysis J-value for O1D. - Photolysis J-value for O1D. +- **Dim**: xy +- **Units**: 1/s +- **Used by**: :ref:`hco-ext-list-paranox` - - **Dim**: xy - - **Units**: 1/s - - **Used by**: :ref:`hco-ext-list-paranox` +JNO2 +---- -.. option:: JNO2 +Photolysis J-value for NO2. - Photolysis J-value for NO2. +- **Dim**: xy +- **Units**: 1/s +- **Used by**: :ref:`hco-ext-list-paranox` - - **Dim**: xy - - **Units**: 1/s - - **Used by**: :ref:`hco-ext-list-paranox` +LAI +--- -.. option:: LAI +Leaf area index. - Leaf area index. +- **Dim**: xy +- **Units**: cm2 leaf/cm2 grid box +- **Used by**: :ref:`hco-ext-list-megan` - - **Dim**: xy - - **Units**: cm2 leaf/cm2 grid box - - **Used by**: :ref:`hco-ext-list-megan` +NO +-- -.. option:: NO +NO mass. - NO mass. +- **Dim**: xyz +- **Units**: kg +- **Used by**: :ref:`hco-ext-list-paranox` - - **Dim**: xyz - - **Units**: kg - - **Used by**: :ref:`hco-ext-list-paranox` +NO2 +--- -.. option:: NO2 +NO2 mass. - NO2 mass. +- **Dim**: xyz +- **Units**: kg +- **Used by**: :ref:`hco-ext-list-paranox` - - **Dim**: xyz - - **Units**: kg - - **Used by**: :ref:`hco-ext-list-paranox` +O3 +-- -.. option:: O3 +O3 mass. - O3 mass. +- **Dim**: xyz +- **Units**: kg +- **Used by**: :ref:`hco-ext-list-paranox` - - **Dim**: xyz - - **Units**: kg - - **Used by**: :ref:`hco-ext-list-paranox` +PARDF +----- -.. option:: PARDF +Diffuse photosynthetic active radiation - Diffuse photosynthetic active radiation +- **Dim**: xy +- **Units**: W/m2 +- **Used by**: :ref:`hco-ext-list-megan` - - **Dim**: xy - - **Units**: W/m2 - - **Used by**: :ref:`hco-ext-list-megan` +PARDR +----- -.. option:: PARDR +Direct photosynthetic active radiation - Direct photosynthetic active radiation +- **Dim**: xy +- **Units**: W/m2 +- **Used by**: :ref:`hco-ext-list-megan` - - **Dim**: xy - - **Units**: W/m2 - - **Used by**: :ref:`hco-ext-list-megan` +RADSWG +------ -.. option:: RADSWG +Short-wave incident surface radiation - Short-wave incident surface radiation +- **Dim**: xy +- **Units**: W/m2 +- **Used by**: :ref:`hco-ext-list-soilnox` - - **Dim**: xy - - **Units**: W/m2 - - **Used by**: :ref:`hco-ext-list-soilnox` +SNOMAS +------ -.. option:: SNOWHGT +Total snow storage on land. - Snow height (mm of H2O equivalent). +- **Dim**: xy +- **Units**: kg H2O/m2 +- **Used by**: :ref:`hco-ext-list-dustl23m`, :ref:`hco-ext-list-tomas-dustdead` - - **Dim**: xy - - **Units**: kg H2O/m2 - - **Used by**: :ref:`hco-ext-list-dustdead`, :ref:`hco-ext-list-tomas-dustdead` +SPHU +---- -.. option:: SPHU +Specific humidity - Specific humidity +- **Dim**: xyz +- **Units**: kg H2O/kg air +- **Used by**: :ref:`hco-ext-list-paranox`, :ref:`hco-ext-list-tomas-dustdead` - - **Dim**: xyz - - **Units**: kg H2O/kg air - - **Used by**: :ref:`hco-ext-list-dustdead`, :ref:`hco-ext-list-paranox`, - :ref:`hco-ext-list-tomas-dustdead` +SZAFACT +------- -.. option:: SZAFACT +Cosine of the solar zenith angle. - Cosine of the solar zenith angle. +- **Dim**: xy +- **Units**: unitless +- **Used by**: :ref:`hco-ext-list-megan` - - **Dim**: xy - - **Units**: unitless - - **Used by**: :ref:`hco-ext-list-megan` +T2M +--- -.. option:: TK +Temperature at 2 meters above surface (proxy for surface temperature). - Temperature. +- **Dim**: xy +- **Units**: K +- **Used by**: :ref:`hco-ext-list-dustl23m` + +TK +--- - - **Dim**: xyz - - **Units**: K - - **Used by**: :ref:`hco-ext-list-dustdead`, :ref:`hco-ext-list-lightnox`, - :ref:`hco-ext-list-tomas-dustdead` +Temperature. -.. option:: TROPP +- **Dim**: xyz +- **Units**: K +- **Used by**: :ref:`hco-ext-list-lightnox`, :ref:`hco-ext-list-tomas-dustdead` - Tropopause pressure. +TROPP +----- - - **Dim**: xy - - **Units**: Pa - - **Used by**: :ref:`hco-ext-list-gcrnpbbe`, :ref:`hco-ext-list-lightnox` +Tropopause pressure. -.. option:: TSKIN +- **Dim**: xy +- **Units**: Pa +- **Used by**: :ref:`hco-ext-list-gcrnpbbe`, :ref:`hco-ext-list-lightnox` - Surface skin temperature +TSKIN +----- - - **Dim**: xy - - **Units**: K - - **Used by**: :ref:`hco-ext-list-seaflux`, :ref:`hco-ext-list-seasalt` +Surface skin temperature -.. option:: U10M +- **Dim**: xy +- **Units**: K +- **Used by**: :ref:`hco-ext-list-dustl23m`, + :ref:`hco-ext-list-seaflux`, :ref:`hco-ext-list-seasalt` + +U10M +---- - E/W wind speed @ 10 meters above surface. +E/W wind speed @ 10 meters above surface. - - **Dim**: xy - - **Units**: m/s - - **Used by**: :ref:`hco-ext-list-dustalk`, :ref:`hco-ext-list-dustdead`, - :ref:`hco-ext-list-dustginoux`, :ref:`hco-ext-list-paranox`, - :ref:`hco-ext-list-seaflux`, :ref:`hco-ext-list-seasalt`, - :ref:`hco-ext-list-soilnox`, :ref:`hco-ext-list-tomas-dustdead`, - :ref:`hco-ext-list-tomas-jeagle` +- **Dim**: xy +- **Units**: m/s +- **Used by**: :ref:`hco-ext-list-dustalk`, :ref:`hco-ext-list-paranox`, + :ref:`hco-ext-list-seaflux`, :ref:`hco-ext-list-seasalt`, + :ref:`hco-ext-list-soilnox`, :ref:`hco-ext-list-tomas-dustdead`, + :ref:`hco-ext-list-tomas-jeagle` -.. option:: USTAR +USTAR +----- - Friction velocity. +Friction velocity. - - **Dim**: xy - - **Units**: m/s - - **Used by**: :ref:`hco-ext-list-dustdead`, :ref:`hco-ext-list-tomas-dustdead` +- **Dim**: xy +- **Units**: m/s +- **Used by**: :ref:`hco-ext-list-dustl23m`, :ref:`hco-ext-list-tomas-dustdead` -.. option:: V10M +V10M +---- - N/S wind speed @ 10 meters above surface. +N/S wind speed @ 10 meters above surface. - - **Dim**: xy - - **Units**: m/s - - **Used by**: :ref:`hco-ext-list-dustalk`, - :ref:`hco-ext-list-dustdead`, :ref:`hco-ext-list-dustginoux`, - :ref:`hco-ext-list-paranox`, :ref:`hco-ext-list-seaflux`, - :ref:`hco-ext-list-seasalt`, :ref:`hco-ext-list-soilnox`, - :ref:`hco-ext-list-tomas-dustdead`, :ref:`hco-ext-list-tomas-jeagle` +- **Dim**: xy +- **Units**: m/s +- **Used by**: :ref:`hco-ext-list-dustalk`, + :ref:`hco-ext-list-paranox`, :ref:`hco-ext-list-seaflux`, + :ref:`hco-ext-list-seasalt`, :ref:`hco-ext-list-soilnox`, + :ref:`hco-ext-list-tomas-dustdead`, :ref:`hco-ext-list-tomas-jeagle` -.. option:: WLI +WLI +--- - Water-land-ice flags (:literal:`0` = water, :literal:`1` = land, - :literal:`2` = ice). +Water-land-ice flags (:literal:`0` = water, :literal:`1` = land, +:literal:`2` = ice). - - **Dim**: xy - - **Units**: unitless - - **Used by**: Almost every extension +- **Dim**: xy +- **Units**: unitless +- **Used by**: Almost every extension -.. option:: Z0 +Z0 +--- - Roughness height. +Roughness height. - - **Dim**: xy - - **Units**: m - - **Used by**: :ref:`hco-ext-list-dustdead`, :ref:`hco-ext-list-tomas-dustdead` +- **Dim**: xy +- **Units**: m +- **Used by**: :ref:`hco-ext-list-tomas-dustdead` +>>>>>>> docs/dev .. _hco-ext-rst-vars: diff --git a/docs/source/hco-ref-guide/hco.bib b/docs/source/hco-ref-guide/hco.bib index f7bd3993..8196befa 100644 --- a/docs/source/hco-ref-guide/hco.bib +++ b/docs/source/hco-ref-guide/hco.bib @@ -1,17 +1,5 @@ %%% References copied from The HEMCO User's Guide on the geos-chem wiki %%% -@article{Ginoux_et_al._2001, - author = {Ginoux, P. and M.~ Chin and I.~ Tegen, and J.~ Prospero and - B.~ Hoben and O.~ Dubovik and S.J.~ Lin}, - title = {Sources and distributions of dust aerosols simulated with the - GOCART model}, - journal = {J. Geophys. Res.}, - volume = {106}, - number = {D17}, - pages = {20255--20273}, - year = {2001} -} - @article{Giglio_et_al._2013, author = {Giglio, L. and J.T.~ Randerson and G.R.~ van der Werf}, title = {Analysis of daily, monthly, and annual burned area using the @@ -101,7 +89,7 @@ @article{Jaegle_et_al._2011 @article{Jacob_et_al._1997, author = {Jacob, D.J. and Prather, M.J. and Rasch, P.J. et al.}, title = {Evaluation and intercomparison of global atmospheric - transport models using Rn-222 and other short-lived tracers}, + transport models using Rn-222 and other short-lived tracers}, journal = {J. Geophys. Res}, volume = {102}, number = {D5}, @@ -243,7 +231,7 @@ @article{Zender_et_al._2003 doi = {10.1029/2002JD002775} } -@article{Zhang_et_al._2021,, +@article{Zhang_et_al._2021, author = {Zhang, B. and H. Liu and J.H. Crawford and G. Chen, and T.D. Fairlie and S. Chambers and C.-H. Kang and A.G. Williams and K. Zhang and D.B. Considine and M.P. Sulprizio and @@ -258,3 +246,13 @@ @article{Zhang_et_al._2021 doi = {10.5194/acp-21-1861-2021} } +@article{Zhang_et_al._2025, + author = {Zhang, D and R.V. Martin and X. Liu and, A. van Donkelaar and C.R. Oxford and Y. Li and J. Meng and D.M. Leung and J.F. Kok and L. Li, and H. Zhu and J.R. Turner and Y. Yan and M. Brauer and Y. Rudich and E. Windwer}, + title = {Improving annual fine mineral dust representation from the surface to the column in GEOS-Chem 14.4.1}, + journal = {Geosci. Model Dev.}, + volume = {18}, + pages = {6767-6803}, + year = {2025}, + url = {https://gmd.copernicus.org/articles/18/6767/2025/}, + doi = {10.5194/gmd-18-6767-2025} +} diff --git a/docs/source/hco-ref-guide/hemco-config.rst b/docs/source/hco-ref-guide/hemco-config.rst index f3451716..e8c3cf3c 100644 --- a/docs/source/hco-ref-guide/hemco-config.rst +++ b/docs/source/hco-ref-guide/hemco-config.rst @@ -1118,51 +1118,49 @@ Specifies the spatial dimension of the input data and/or the model levels into which emissions will be placed. Here are some examples that illustrate its use. -+------------------------+--------------------------------------------------+ -| SrcDim setting | What this does | -+========================+==================================================+ -| ``xy`` | Specifies 2-dimensional input data | -+------------------------+--------------------------------------------------+ -| ``xyz`` | Specifies 3-dimensional input data | -+------------------------+--------------------------------------------------+ -| ``xy5`` | Emits the lowest 5 levels of the input data | -| | into HEMCO levels 1 through 5. | -+------------------------+--------------------------------------------------+ -| ``xy-5`` | Emits the tompmost 5 levels of the input data | -| | into HEMCO levels 1 through 5 (i.e. in | -| | reversed order, so that the topmost level is | -| | placed into HEMCO level 1, etc.) | -+------------------------+--------------------------------------------------+ -| ``xyL=5`` | Emits a 2-D input data field into HEMCO | -| | level 5. | -+------------------------+--------------------------------------------------+ -| ``xyL=2000m`` | Emits a 2-D input data field into the model | -| | level corresponding to 2000m above the surface. | -+------------------------+--------------------------------------------------+ -| ``xyL=2:5000m`` | Emits between HEMCO level 2 and 5000m | -+------------------------+--------------------------------------------------+ -| ``xyL=1:PBL`` | Emits from the surface (HEMCO level 1) up to the | -| | HEMCO level containing the PBL top. | -+------------------------+--------------------------------------------------+ -| ``xyL=PBL:5500m`` | Emits from the PBL top level up to 5500m. | -+------------------------+--------------------------------------------------+ -| ``xyL*`` | Emit same value to all emission levels. A scale | -| | scale factor should be applied to distribute the | -| | emissions vertically. | -+------------------------+--------------------------------------------------+ -| ``xyL=1:scal300`` | Emit from the surface (HEMCO level 1) to the | -| | injection height that is listed under scale | -| | factor 300. This scale factor may be read from | -| | a netCDF file. | -+------------------------+--------------------------------------------------+ -| ``xyz+"ensemble=3"`` | Read a netCDF file containing ensemble data (xyz | -| | plus an additional dimension named | -| | ``ensemble``), using the 3rd ensemble member. | -+------------------------+--------------------------------------------------+ -| ``xyz+"ensemble=$EN"`` | Similar to the previous example, but using a | -| | :ref:`token ` to denote | -| | which ensemble member to use. [#A]_ | -+------------------------+--------------------------------------------------+ +.. list-table:: + :header-rows: 1 + + * - SrcDim setting + - What this does + * - :literal:`xy` + - Specifies 2-dimensional input data + * - :literal:`xyz` + - Specifies 3-dimensional input data + * - :literal:`xy5` + - Emits the lowest 5 levels of the input data into HEMCO levels 1 + through 5. + * - :literal:`xy-5` + - Emits the tompmost 5 levels of the input data into HEMCO levels + 1 through 5 (i.e. in reversed order, so that the topmost level + is placed into HEMCO level 1, etc.) + * - :literal:`xyL=5` + - Emits a 2-D input data field into HEMCO level 5. + * - :literal:`xyL=2000m` + - Emits a 2-D input data field into the model level corresponding + to 2000m above the surface. + * - :literal:`xyL=2:5000m` + - Emits between HEMCO level 2 and 5000m + * - :literal:`xyL=1:PBL` + - Emits from the surface (HEMCO level 1) up to the HEMCO level + containing the PBL top. + * - :literal:`xyL=PBL:5500m` + - Emits from the PBL top level up to 5500m. + * - :literal:`xyL*` + - Emit same value to all emission levels. A scalefactor should + be applied to distribute the emissions vertically. + * - :literal:`xyL=1:scal300` + - Emit from the surface (HEMCO level 1) to the injection height + that is listed under scale factor 300. This scale factor may + be read from a netCDF file. + * - :literal:`xyz+"ensemble=3"` + - Read a netCDF file containing ensemble data (:literal:`xyz` + plus an additional dimension named :literal:`ensemble`), using + the 3rd ensemble member. + * - :literal:`xyz+"ensemble=$EN"` + - Similar to the previous example, but using a :ref:`token + ` to denote which ensemble member to + use. [#A]_ .. rubric:: Notes for SrcDim @@ -1198,21 +1196,30 @@ to it. This can be useful for extensions that import some ScalIDs ------- +.. note:: + + ScalIDs only affect fields that are assigned to the base extension + (:literal:`ExtNr = 0`). + Identification numbers of all scale factors and masks that shall be applied to this base emission field. Multiple entries must be separated by the separator character. ScalIDs must csorrespond to the numbers provided in the :ref:`hco-cfg-scalefac` and +:ref:`hco-cfg-masks` sections. -.. note:: - - This option only takes effect for fields that are assigned to the - base extension (:literal:`ExtNr = 0`). +If you do not wish to apply any scale factors or masks, leave a +:literal:`-` in the ScalIDs column. .. _hco-cfg-base-cat: Cat --- +.. note:: + + Cat only affects fields that are assigned to the base extension + (:literal:`ExtNr = 0`). + Emission category. Used to distinguish different, independent emission sources. Emissions of different categories are always added to each other. @@ -1234,27 +1241,22 @@ means "Put everything into the first listed category (1=anthropogenic), and set the other listed categories (2=biofuels, 12=trash) to zero. -.. note:: - - This option only takes effect for fields that are assigned to the - base extension (:literal:`ExtNr = 0`). - .. _hco-cfg-base-hier: Hier ---- +.. note:: + + Hier only affects fields that are assigned to the base extension + (:literal:`ExtNr = 0`). + Emission hierarchy. Used to prioritize emission fields within the same emission category. Emissions of higher hierarchy overwrite lower hierarchy data. Fields are only considered within their defined domain, i.e. regional inventories are only considered within their mask boundaries. -.. note:: - - This option only takes effect for fields that are assigned to the - base extension (:literal:`ExtNr = 0`). - .. _hco-cfg-scalefac: ============= diff --git a/docs/source/hco-ref-guide/intro.rst b/docs/source/hco-ref-guide/intro.rst index 946477ce..8a57a398 100644 --- a/docs/source/hco-ref-guide/intro.rst +++ b/docs/source/hco-ref-guide/intro.rst @@ -1,10 +1,10 @@ .. _hco-ref-guide: -########################## -Introduction to this Guide -########################## +##################### +Introduction to HEMCO +##################### -In this **HEMCO Reference Guide**, you will learn about HEMCO +In this :program:`HEMCO Reference Guide`, you will learn about HEMCO configuration files, HEMCO extensions, HEMCO interfaces, and other technical information. @@ -17,7 +17,7 @@ Contents .. toctree:: :maxdepth: 1 - + basic-examples.rst hemco-config.rst extensions.rst diff --git a/docs/source/hco-ref-guide/under-the-hood.rst b/docs/source/hco-ref-guide/under-the-hood.rst index b5bcb106..741ece44 100644 --- a/docs/source/hco-ref-guide/under-the-hood.rst +++ b/docs/source/hco-ref-guide/under-the-hood.rst @@ -305,8 +305,8 @@ Initialization: horizontal mid points and edges (all 2D fields), the hybrid sigma coordinate edges (3D), the grid box areas (2D), and the grid box heights. The latter is only used by some extensions - (:ref:`hco-ext-list-dustdead`, :ref:`hco-ext-list-lightnox`) and - may be left undefined if those are not used. |br| + (:ref:`hco-ext-list-lightnox`) and may be left undefined if those + are not used. |br| |br| - Define emission species. Species definitions are stored in vector diff --git a/docs/source/hco-sa-guide/compiling.rst b/docs/source/hco-sa-guide/compiling.rst index 291403ba..378254fa 100644 --- a/docs/source/hco-sa-guide/compiling.rst +++ b/docs/source/hco-sa-guide/compiling.rst @@ -239,51 +239,68 @@ to the run directory. HEMCO standalone build options ============================== -.. option:: RUNDIR +RUNDIR +------ - Paths to run directories where :command:`make install` installs - HEMCO standalone. Multiple run directories can be specified by a - semicolon separated list. A warning is issues if one of these - directories does not look like a run directory. +Paths to run directories where :command:`make install` installs +HEMCO standalone. Multiple run directories can be specified by a +semicolon separated list. A warning is issues if one of these +directories does not look like a run directory. - These paths can be relative paths or absolute paths. Relative paths - are interpreted as relative to your build directory. +These paths can be relative paths or absolute paths. Relative paths +are interpreted as relative to your build directory. -.. option:: CMAKE_BUILD_TYPE +CMAKE_BUILD_TYPE +---------------- - Specifies the build type. Allowable values are: +Specifies the build type. Allowable values are: - .. option:: Release +.. list-table:: + :header-rows: 1 + :widths: 20 80 - The default option. Compiles HEMCO standalone for speed. + * - Value + - Description + * - Release + - The default option. Compiles HEMCO standalone for speed. + * - Debug + - Compiles HEMCO standalone with several debugging flags turned + on. This may help you find common errors such as + array-out-of-bounds, division-by-zero, or not-a-number. - .. option:: Debug - - Compiles HEMCO standalone with several debugging flags turned - on. This may help you find common errors such as - array-out-of-bounds, division-by-zero, or not-a-number. +.. important:: - .. important:: + The additional error checks that are applied with :literal:`Debug` + will cause HEMCO standalone to run much more slowly! Do not use + :literal:`Debug` for long production simulations. - The additional error checks that are applied with - :literal:`Debug` will cause HEMCO standalone to run much more - slowly! Do not use :literal:`Debug` for long production - simulations. +HEMCO_Fortran_FLAGS_ +--------------------------------- -.. option:: HEMCO_Fortran_FLAGS_ +Additional compiler options for HEMCO standalone for the +:literal:`Release` or :literal:`Debug` build type. - Additional compiler options for HEMCO standalone for build type - :literal:``. + +------------- - .. option:: +Allowable values are: - Valid values are :literal:`GNU` and :literal:`Intel`. +.. list-table:: + :header-rows: 1 + :widths: 20 80 -.. option:: HEMCO_Fortran_FLAGS__ + * - Value + - Description + * - GNU + - Specifies the GNU Compiler Collection (:literal:`gcc`, + :literal:`g++`, :literal:`gfortran`). + * - Intel + - Specifies the Intel compiler suite (:literal:`icc`, + :literal:`icpc`, :literal:`ifort`). - Compiler options for HEMCO standalone for the given - :option:`CMAKE_BUILD_TYPE`. - .. option:: +HEMCO_Fortran_FLAGS__ +---------------------------------------------------- - Valid values are :literal:`GNU` and :literal:`Intel`. +Compiler options for HEMCO standalone for build type +:literal:`Release` or :literal:`Debug`. diff --git a/docs/source/hco-sa-guide/config-sim.rst b/docs/source/hco-sa-guide/config-sim.rst index 30ce1ec2..f218f0e8 100644 --- a/docs/source/hco-sa-guide/config-sim.rst +++ b/docs/source/hco-sa-guide/config-sim.rst @@ -16,80 +16,116 @@ Navigate to your new directory, and examine the contents: $ cd /path/to/hemco/run/dir $ ls - build/ HEMCO_Diagn.rc HEMCO_sa_Spec.rc README - CodeDir@ HEMCO_sa_Config.rc HEMCO_sa_Time.rc rundir.version - HEMCO_Config.rc HEMCO_sa_Grid.4x5.rc OutputDir/ runHEMCO.sh* + build/ download_data.yml HEMCO_sa_Grid.4x5.rc Restarts/ + cleanRunDir.sh* HEMCO_Config.rc HEMCO_sa_Spec.rc rundir.version + CodeDir@ HEMCO_Config.rc.gmao_metfields HEMCO_sa_Time.rc runHEMCO.sh* + config_for_offline_emissions/ HEMCO_Diagn.rc OutputDir/ + download_data.py* HEMCO_sa_Config.rc README + +.. _hco-sa-sim-config-rundir: + +================================= +Run directory configuration files +================================= The following files can be modified to set up your HEMCO standalone simulation. -.. option:: HEMCO_sa_Config.rc +.. _hco-sa-sim-config-rundir-sa: + +HEMCO_sa_Config.rc +------------------ + +Main configuration file for the HEMCO standalone simulation. This +file points to the other configuration files used to set up your +simulation (e.g. :ref:`hco-sa-sim-config-rundir-sa-grid`, +:ref:`hco-sa-sim-config-rundir-sa-time`, etc):. + +This file typically references a +:ref:`hco-sa-sim-config-rundir-sa-hcorc` file using + +.. code-block:: none + + >>>include HEMCO_Config.rc + +which contains the emissions settings. Settings in +:file:`HEMCO_sa_Config.rc` will always override any settings in +the included :ref:`hco-sa-sim-config-rundir-sa-hcorc`. + +.. _hco-sa-sim-config-rundir-sa-hcorc: + +HEMCO_Config.rc +--------------- + +Contains emissions settings. :file:`HEMCO_Config.rc` can be taken +from a another model (such as GEOS-Chem), or can be built from a +sample file. - Main configuration file for the HEMCO standalone simulation. This - file points to the other configuration files used to set up your - simulation (e.g. :option:`HEMCO_sa_Grid.4x5.rc`, - :option:`HEMCO_sa_Time.rc`). +For more information on editing :file:`HEMCO_Config.rc`, please +see the following chapters: :ref:`hco-cfg`, :ref:`edit-hco-cfg`, +and :ref:`cfg-ex`. - This file typically references a :option:`HEMCO_Config.rc` file - using +.. important:: - .. code-block:: none + Make sure that the path to your data directory in the + :file:`HEMCO_Config.rc` file is correct. Otherwise, HEMCO + standalone will not be able read data from disk. - >>>include HEMCO_Config.rc +.. _hco-sa-sim-config-rundir-sa-hcodg: - which contains the emissions settings. Settings in - :option:`HEMCO_sa_Config.rc` will always override any settings in - the included :option:`HEMCO_Config.rc` file. +HEMCO_Diagn.rc +-------------- -.. option:: HEMCO_Config.rc +Specifies which fields to save out to the HEMCO diagnostics file +saved in :file:`OutputDir` by default. The frequency to save out +diagnostics is controlled by the :ref:`hco-cfg-set-diagnfreq` +setting in :ref:`hco-sa-sim-config-rundir-sa`. - Contains emissions settings. :option:`HEMCO_Config.rc` can be taken - from a another model (such as GEOS-Chem), or can be built from a - sample file. +For more information, please see the chapter entitled +:ref:`hco-diag-configfile`. - For more information on editing :option:`HEMCO_Config.rc`, please - see the following chapters: :ref:`hco-cfg`, :ref:`edit-hco-cfg`, - and :ref:`cfg-ex`. +.. _hco-sa-sim-config-rundir-sa-grid: - .. important:: +HEMCO_sa_Grid.$RES.rc +--------------------- - Make sure that the path to your data directory in the - :option:`HEMCO_Config.rc` file is correct. Otherwise, HEMCO - standalone will not be able read data from disk. +Defines the grid specification for resolution :literal:`$RES`. Sample +files for several horizontal resolutions (4.0 x 5.0, 2.0 x 2.5, 0.5 x +0.625, and 0.25 x 0.3125 global grids) are stored in the in +:file:`HEMCO/run/` folder. These are are automatically copied to the +run directory based on options chosen when running +:file:`createRunDir.sh`. -.. option:: HEMCO_Diagn.rc +If you choose to run with a custom grid or over a regional domain, you +will need to modify this file manually. - Specifies which fields to save out to the HEMCO diagnostics file - saved in :file:`OutputDir` by default. The frequency to save out - diagnostics is controlled by the :ref:`hco-cfg-set-diagnfreq` - setting in :option:`HEMCO_sa_Config.rc` +.. _hco-sa-sim-config-rundir-sa-spec: - For more information, please see the chapter entitled - :ref:`hco-diag-configfile`. +HEMCO_sa_Spec.rc +---------------- -.. option:: HEMCO_sa_Grid.4x5.rc +Defines the species to include in the HEMCO standalone +simulation. By default, the species in a GEOS-Chem full-chemistry +"standard" simulation are included. - Defines the grid specification. Sample files are provided for 4.0 x - 5.0, 2.0 x 2.5, 0.5 x 0.625, and 0.25 x 0.3125 global grids in - :file:`HEMCO/run/` and are automatically copied to the run - directory based on options chosen when running - :file:`createRunDir.sh`. you choose to run with a custom grid or - over a regional domain, you will need to modify this file - manually. +You may easily generate a :file:`HEMCO_sa_Spec.rc` corresponding to a +different GEOS-Chem simulation with the GCPy example script +:file:`make_hemco_sa_spec.py`. For usage details, see the `Generate a +HEMCO_sa_Spec.rc for HEMCO Standalone +`_ +documentation at gcpy.readthedocs.io. -.. option:: HEMCO_sa_Spec.rc +.. _hco-sa-sim-config-rundir-sa-time: - Defines the species to include in the HEMCO standalone - simulation. By default, the species in a GEOS-Chem full-chemistry - simulation are defined. To include other species, you can modify - this file by providing the species name, molecular weight, and - other properties. +HEMCO_sa_Time.rc +---------------- -.. option:: HEMCO_sa_Time.rc +Defines the start and end times of the HEMCO standalone simulation +as well as the emissions timestep (s). - Defines the start and end times of the HEMCO standalone simulation - as well as the emissions timestep (s). +.. _hco-sa-sim-config-rundir-sa-run: -.. option:: runHEMCO.sh +runHEMCO.sh +----------- - Sample run script for submitting a HEMCO standalone simulation via - SLURM. +Sample run script for submitting a HEMCO standalone simulation via +SLURM. diff --git a/docs/source/hco-sa-guide/hco-sa-dry-run.rst b/docs/source/hco-sa-guide/hco-sa-dry-run.rst index 9c110f02..62335ff1 100644 --- a/docs/source/hco-sa-guide/hco-sa-dry-run.rst +++ b/docs/source/hco-sa-guide/hco-sa-dry-run.rst @@ -55,36 +55,40 @@ standalone will need to perform the corresponding "production" simulation. You will download data from the :ref:`GEOS-Chem Input Data ` portal. -.. important:: +Initialize the GCPy Python environment +-------------------------------------- + +You will need to activate a Python environment before you can start +downloading data. We recommend using the Python environment for `GCPy +`_, as it has all of the relevant +packages installed. If you `installed GCPy from PyPI +`_, +then no further action is needed. On the other hand, if you +`installed GCPy from conda-forge +`_, +you will need to activate the GCPy Python environment with this +command: - Before you use the :file:`download_data.py` script, make sure to - initialize a Mamba or Conda environment with the relevant command - shown below: - - .. code-block:: console - - $ mamba activate ENV-NAME # If using Mamba - - $ conda activate ENV-NAME # If using Conda +.. code-block:: console - Here :literal:`ENV-NAME` is the name of your environment. + $ conda activate gcpy_env + (gcpy_env) $ - Also make sure that you have installed the PyYAML module to your - conda environment. PyYAML will allow the :file:`download_data.py` - script to read certain configurable settings from a YAML file in - your run directory. +Activating the environment adds the prefix :literal:`(gcpy_env)` to +the command prompt. This is a visual cue to remind you that the +environment is active. - The Python environment for GCPy has all of the proper packages - that you need to download data from a dry-run simulation. For - more information, please see `gcpy.readthedocs.io - `_. +Run the download_data.py script +------------------------------- -Navigate to your HEMCO run directory where you executed the dry-run -and type. +Navigate to the HEMCO run directory where you executed the dry-run +simulation. You will use the :file:`download_data.py` script to +transfer data to your machine. The command you will use takes this +form: .. code-block:: console - $ ./download_data.py log.dryrun PORTAL-NAME + (gcpy_env) $ ./download_data.py log.dryrun PORTAL-NAME where: @@ -118,26 +122,38 @@ where: - :command:`wget` - HTTP * - rochester - - :ref:`GCAP 2.0 met data @ Rochester ` + - :ref:`GCAP 2.0 met data @ Rochester + ` - :command:`wget` - HTTP + * - skip-download + - Skips data download altogether + - N/A + - N/A For example, to download data from the :ref:`GEOS-Chem Input Data -` portal using the AWS CLI download (which is faster than -HTTP download), use this command: +` portal, use this command: .. code-block:: console - $ ./download_data.py log.dryrun geoschem+s3 + (gcpy_env) $ ./download_data.py log.dryrun geoschem+http -.. note:: +But if you have `AWS CLI (command-line interface) +`_ set up on your machine, use +this command instead: - You must have the `AWS CLI (command-line interface) - `_ software installed on your system - before in order to use the :literal:`geoschem+aws` or - :literal:`nested+aws` options in the table listed above. +.. code-block:: console -The :file:`download_data.py` program will generate a **log of + (gcpy_env) $ ./download_data.py log.dryrun geoschem+aws + +This will result in a much faster data transfer than by HTTP. This is +also the command you will use if you are running HEMCO Standalone on +an AWS EC2 cloud instance. + +(Optional) Examine the log of unique data files +----------------------------------------------- + +The :file:`download_data.py` script will generate a **log of unique data files** (i.e. with all duplicate listings removed), which looks similar to this: @@ -176,24 +192,34 @@ example, we passed :file:`log.dryrun` to :file:`download_data.py`, so the "unique" log file will be named :file:`log.dryrun.unique`. This "unique" log file can be very useful for documentation purposes. -============================================= -Skip download, but create log of unique files -============================================= - -If you wish to only produce the \*log of unique data files without -downloading any data, then type the following command from within your -HEMCO-standalone run directory: +If you wish to only produce the **log of unique data files** without +downloading any data, then use :literal:`skip-download` in place of +the :literal:`PORTAL-NAME` when running :file:`donwload_data.py`: .. code-block:: console - $ ./download_data.py log.dryrun skip-download + (gcpy_env) $ ./download_data.py log.dryrun skip-download -or for short: +You can also abbreviate the command to: .. code-block:: console - $ ./download_data.py log.dryrun skip + (gcpy_env) $ ./download_data.py log.dryrun skip This can be useful if you already have the necessary data downloaded to your system but wish to create the log of unique files for documentation -purposes (such as for benchmark simulations, etc.) +purposes. + +Deactivate the GCPy Python environment +-------------------------------------- + +Once you have downloaded all of the data needed for your GEOS-Chem +Classic simulation, you can deactivate the GCPy Python environment. + +.. code-block:: console + + (gcpy_env) $ conda deactivate + $ + +This will remove the :literal:`(gcpy_env)` prefix from the command +prompt. diff --git a/docs/source/hco-sa-guide/intro.rst b/docs/source/hco-sa-guide/intro.rst index 55df1347..e96589a5 100644 --- a/docs/source/hco-sa-guide/intro.rst +++ b/docs/source/hco-sa-guide/intro.rst @@ -1,8 +1,8 @@ .. _hco-sa-guide: -########################## -Introduction to this Guide -########################## +#################################### +Introduction to the HEMCO Standalone +#################################### In this **HEMCO Standalone User Guide**, you will learn how to run HEMCO in **standalone mode** (i.e. not connected to an external model). diff --git a/docs/source/hco-sa-guide/login-env.rst b/docs/source/hco-sa-guide/login-env.rst index 518e284a..0b2438c2 100644 --- a/docs/source/hco-sa-guide/login-env.rst +++ b/docs/source/hco-sa-guide/login-env.rst @@ -271,7 +271,7 @@ system) into a file named :file:`~/intel23.env`. echo "" echo "Done sourcing ${BASH_SOURCE[0]}" - + .. tip:: Ask your sysadmin how to load software libraries. If you @@ -347,42 +347,48 @@ shared-memory (aka serial) parallelization. Add the following environment variables to your environment file to control the OpenMP parallelization settings: -.. option:: OMP_NUM_THREADS +.. _hco-sa-envvar-parallel-threads: + +OMP_NUM_THREADS +--------------- - The :envvar:`OMP_NUM_THREADS` environment variable sets the number of - computational cores (aka threads) to use. +The :envvar:`OMP_NUM_THREADS` environment variable sets the number of +computational cores (aka threads) to use. - For example, the command below will tell HEMCO standalone to use 8 - cores within parallel sections of code: +For example, the command below will tell HEMCO standalone to use 8 +cores within parallel sections of code: - .. code:: console +.. code:: console - $ export OMP_NUM_THREADS=8 + $ export OMP_NUM_THREADS=8 -.. option:: OMP_STACKSIZE +.. _hco-sa-envvar-parallel-stack: - In order to use HEMCO standalone with `OpenMP - parallelization `_, you must request the - maximum amount of stack memory in your login environment. (The - stack memory is where local automatic variables and temporary - :envvar:`!$OMP PRIVATE` variables will be created.) Add the - following lines to your system startup file and to your GEOS-Chem - run scripts: +OMP_STACKSIZE +------------- - .. code-block:: bash +In order to use HEMCO standalone with `OpenMP +parallelization `_, you must request the +maximum amount of stack memory in your login environment. (The +stack memory is where local automatic variables and temporary +:envvar:`!$OMP PRIVATE` variables will be created.) Add the +following lines to your system startup file and to your GEOS-Chem +run scripts: + +.. code-block:: bash - ulimit -s unlimited - export OMP_STACKSIZE=500m + ulimit -s unlimited + export OMP_STACKSIZE=500m - The :command:`ulimit -s unlimited` command will tell the bash shell - to use the maximum amount of stack memory that is available. +The :command:`ulimit -s unlimited` command will tell the bash shell +to use the maximum amount of stack memory that is available. - The environment variable :envvar:`OMP_STACKSIZE` must also be set to a very - large number. In this example, we are nominally requesting 500 MB of - memory. But in practice, this will tell the GNU Fortran compiler to use - the maximum amount of stack memory available on your system. The value - **500m** is a good round number that is larger than the amount of stack - memory on most computer clusters, but you can increase this if you wish. +The environment variable :envvar:`OMP_STACKSIZE` must also be set to a very +large number. In this example, we are nominally requesting 500 MB of +memory. But in practice, this will tell the GNU Fortran compiler to use +the maximum amount of stack memory available on your system. The value +**500m** is a good round number that is larger than the amount of stack +memory on most computer clusters, but you can increase this if you wish. .. _errors_caused_by_incorrect_settings: @@ -392,14 +398,14 @@ Fix errors caused by incorrect settings Be on the lookout for these errors: - #. If :option:`OMP_NUM_THREADS` is set to 1, then your - HEMCO standalone simulation will execute using only - one computational core. This will make your simulation take much + #. If :ref:`hco-sa-envvar-parallel-threads` is set to 1, then your + HEMCO standalone simulation will execute using only one + computational core. This will make your simulation take much longer than is necessary. - #. If :option:`OMP_STACKSIZE` environment variable is not included - in your environment file (or if it is set to a very low value), - you might encounter a **segmentation fault**. In this case, - the HEMCO standalone "thinks" that it does not have + #. If :ref:`hco-sa-envvar-parallel-stack` environment variable is + not included in your environment file (or if it is set to a very + low value), you might encounter a **segmentation fault**. In + this case, the HEMCO standalone "thinks" that it does not have enough memory to perform the simulation, even though sufficient memory may be present. diff --git a/docs/source/index.rst b/docs/source/index.rst index 59b0ce5a..a879c2fb 100644 --- a/docs/source/index.rst +++ b/docs/source/index.rst @@ -7,13 +7,15 @@ The Harmonized Emissions Component (HEMCO) .. raw:: html

- - - - - - - + + +
+ DOI + + + Ubuntu + Mac + Windows

The **Harmonized Emissions Component (HEMCO)** is a software component @@ -69,6 +71,7 @@ HEMCO is given in :cite:t:`Keller_et_al._2014` and geos-chem-shared-docs/supplemental-guides/error-guide.rst geos-chem-shared-docs/supplemental-guides/debug-guide.rst geos-chem-shared-docs/doc/gcid-portal-overview.rst + geos-chem-shared-docs/doc/gcid-special-portals.rst geos-chem-shared-docs/supplemental-guides/bashdatacatalog.rst geos-chem-shared-docs/supplemental-guides/parallel-guide.rst geos-chem-shared-docs/supplemental-guides/netcdf-guide.rst diff --git a/run/HEMCO_Diagn.rc.sample b/run/HEMCO_Diagn.rc.sample index b512da54..4bc31bdd 100644 --- a/run/HEMCO_Diagn.rc.sample +++ b/run/HEMCO_Diagn.rc.sample @@ -29,5 +29,4 @@ #BOC # Name Spec ExtNr Cat Hier Dim OutUnit LongName EmisNO_Total NO -1 -1 -1 3 kg/m2/s NO_emission_flux_from_all_sectors - #EOC diff --git a/run/HEMCO_sa_Spec.rc b/run/HEMCO_sa_Spec.rc index 41647879..afbaf799 100644 --- a/run/HEMCO_sa_Spec.rc +++ b/run/HEMCO_sa_Spec.rc @@ -46,128 +46,131 @@ 35 OCPI 12.01 0.000000E+00 0.00 0.00 36 BCPO 12.01 0.000000E+00 0.00 0.00 37 OCPO 12.01 0.000000E+00 0.00 0.00 -38 DST1 29.00 0.000000E+00 0.00 0.00 -39 DST2 29.00 0.000000E+00 0.00 0.00 -40 DST3 29.00 0.000000E+00 0.00 0.00 -41 DST4 29.00 0.000000E+00 0.00 0.00 -42 SALA 31.40 0.000000E+00 0.00 0.00 -43 SALC 31.40 0.000000E+00 0.00 0.00 -44 Br2 160.00 7.600000E-01 3720.00 0.00 -45 Br 80.00 0.000000E+00 0.00 0.00 -46 BrO 96.00 0.000000E+00 0.00 0.00 -47 HOBr 97.00 6.100000E+03 6014.00 0.00 -48 HBr 81.00 7.100000E+13 10200.00 0.00 -49 BrNO2 126.00 0.000000E+00 0.00 0.00 -50 BrNO3 142.00 0.000000E+00 0.00 0.00 -51 CHBr3 253.00 0.000000E+00 0.00 0.00 -52 CH2Br2 174.00 0.000000E+00 0.00 0.00 -53 CH3Br 95.00 0.000000E+00 0.00 0.00 -54 MPN 93.00 0.000000E+00 0.00 0.00 -55 ISOPND 147.00 2.000000E+06 9200.00 0.00 -56 ISOPNB 147.00 2.000000E+06 9200.00 0.00 -57 MOBA 114.00 2.300000E+04 6300.00 0.00 -58 PROPNN 119.00 5.000000E+05 0.00 0.00 -59 HAC 74.00 1.400000E+06 7200.00 0.00 -60 GLYC 60.00 4.100000E+04 4600.00 0.00 -61 MVKN 149.00 2.000000E+06 9200.00 0.00 -62 MACRN 149.00 2.000000E+06 9200.00 0.00 -63 MAP 76.00 8.400000E+02 5300.00 0.00 -64 NO2 46.00 0.000000E+00 0.00 0.00 -65 NO3 62.00 0.000000E+00 0.00 0.00 -66 HNO2 47.00 0.000000E+00 0.00 0.00 -67 BENZ 78.11 0.000000E+00 0.00 0.00 -68 TOLU 92.14 0.000000E+00 0.00 0.00 -69 XYLE 106.16 0.000000E+00 0.00 0.00 -70 MTPA 136.23 4.900000E-02 0.00 0.00 -71 LIMO 136.23 7.000000E-02 0.00 0.00 -72 MTPO 136.23 4.900000E-02 0.00 0.00 -73 SOAP 150.00 0.000000E+00 0.00 0.00 -74 SOAS 150.00 0.000000E+00 0.00 0.00 -75 EOH 46.07 1.900000E+02 6600.00 0.00 -76 MGLY 72.00 3.700000E+03 7500.00 0.00 -77 GLYX 58.00 3.600000E+05 7200.00 0.00 -78 ACTA 60.00 4.100000E+03 6300.00 0.00 -79 HPALD 116.00 0.000000E+00 0.00 0.00 -80 DHDN 226.00 2.000000E+06 9200.00 0.00 -81 ETHLN 105.00 2.000000E+06 9200.00 0.00 -82 HCOOH 46.00 8.900000E+03 6100.00 0.00 -83 IEPOXA 118.00 8.000000E+07 0.00 0.00 -84 IEPOXB 118.00 8.000000E+07 0.00 0.00 -85 IEPOXD 118.00 8.000000E+07 0.00 0.00 -86 ISN1 147.00 2.000000E+06 9200.00 0.00 -87 RIPA 118.00 1.700000E+06 0.00 0.00 -88 RIPB 118.00 1.700000E+06 0.00 0.00 -89 RIPD 118.00 1.700000E+06 0.00 0.00 -90 IMAE 102.00 1.200000E+05 7200.00 0.00 -91 SOAIE 118.00 0.000000E+00 0.00 0.00 -92 SOAME 102.00 0.000000E+00 0.00 0.00 -93 SOAGX 58.00 0.000000E+00 0.00 0.00 -94 SOAMG 72.00 0.000000E+00 0.00 0.00 -95 LVOC 154.00 1.000000E+08 7200.00 0.00 -96 LVOCOA 154.00 0.000000E+00 0.00 0.00 -97 ISN1OG 226.00 2.300000E+04 9200.00 0.00 -98 ISN1OA 226.00 0.000000E+00 0.00 0.00 -99 MONITS 215.00 1.700000E+04 9200.00 0.00 -100 MONITU 215.00 1.700000E+04 9200.00 0.00 -101 HONIT 215.00 2.690000E+13 5487.00 0.00 -102 IONITA 14.00 0.000000E+00 0.00 0.00 -103 MONITA 14.00 0.000000E+00 0.00 0.00 -104 INDIOL 102.00 0.000000E+00 0.00 0.00 -105 IPMN 147.00 0.000000E+00 0.00 0.00 -106 HC187 187.00 0.000000E+00 0.00 0.00 -107 N2O 44.00 0.000000E+00 0.00 0.00 -108 OCS 60.00 0.000000E+00 0.00 0.00 -109 CH4 16.00 0.000000E+00 0.00 0.00 -110 BrCl 115.00 0.000000E+00 0.00 0.00 -111 HCl 36.00 7.000000E+10 11000.00 0.00 -112 CCl4 152.00 0.000000E+00 0.00 0.00 -113 CH3Cl 50.00 0.000000E+00 0.00 0.00 -114 CH3CCl3 133.00 0.000000E+00 0.00 0.00 -115 CFC113 187.00 0.000000E+00 0.00 0.00 -116 CFC114 187.00 0.000000E+00 0.00 0.00 -117 CFC115 187.00 0.000000E+00 0.00 0.00 -118 HCFC123 117.00 0.000000E+00 0.00 0.00 -119 HCFC141b 117.00 0.000000E+00 0.00 0.00 -120 HCFC142b 117.00 0.000000E+00 0.00 0.00 -121 CFC11 137.00 0.000000E+00 0.00 0.00 -122 CFC12 121.00 0.000000E+00 0.00 0.00 -123 HCFC22 86.00 0.000000E+00 0.00 0.00 -124 H1211 165.00 0.000000E+00 0.00 0.00 -125 H1301 149.00 0.000000E+00 0.00 0.00 -126 H2402 260.00 0.000000E+00 0.00 0.00 -127 Cl 35.00 0.000000E+00 0.00 0.00 -128 ClO 51.00 0.000000E+00 0.00 0.00 -129 HOCl 52.00 6.500000E+02 5900.00 0.00 -130 ClNO3 97.00 0.000000E+00 0.00 0.00 -131 ClNO2 81.00 0.000000E+00 0.00 0.00 -132 ClOO 67.00 0.000000E+00 0.00 0.00 -133 OClO 67.00 0.000000E+00 0.00 0.00 -134 Cl2 71.00 0.000000E+00 0.00 0.00 -135 Cl2O2 103.00 0.000000E+00 0.00 0.00 -136 H2O 18.00 0.000000E+00 0.00 0.00 -137 BrSALA 80.00 0.000000E+00 0.00 0.00 -138 BrSALC 80.00 0.000000E+00 0.00 0.00 -139 CHCl3 119.00 0.000000E+00 0.00 0.00 -140 CH2Cl2 85.00 0.000000E+00 0.00 0.00 -141 CH3I 142.00 1.973846E-05 3600.00 0.00 -142 CH2I2 268.00 0.000000E+00 0.00 0.00 -143 CH2ICl 167.00 0.000000E+00 0.00 0.00 -144 CH2IBr 221.00 0.000000E+00 0.00 0.00 -145 HOI 144.00 1.540000E+04 8371.00 0.00 -146 I2 254.00 2.700000E+00 7507.40 0.00 -147 IBr 207.00 2.400000E+01 4916.70 0.00 -148 ICl 162.00 1.110000E+02 2105.50 0.00 -149 I 127.00 0.000000E+00 0.00 0.00 -150 IO 143.00 0.000000E+00 0.00 0.00 -151 HI 128.00 7.430000E+13 3187.20 0.00 -152 OIO 159.00 0.000000E+00 0.00 0.00 -153 INO 157.00 0.000000E+00 0.00 0.00 -154 IONO 173.00 3.000000E-01 7240.40 0.00 -155 IONO2 189.00 1.000000E+20 3980.00 0.00 -156 I2O2 286.00 1.000000E+20 18900.00 0.00 -157 I2O3 302.00 1.000000E+20 13400.00 0.00 -158 I2O4 318.00 1.000000E+20 13400.00 0.00 -159 ISALA 127.00 0.000000E+00 0.00 0.00 -160 ISALC 127.00 0.000000E+00 0.00 0.00 -161 AERI 127.00 0.000000E+00 0.00 0.00 -162 pFe 55.85 0.000000E+00 0.00 0.00 +38 DSTbin1 29.00 0.000000E+00 0.00 0.00 +39 DSTbin2 29.00 0.000000E+00 0.00 0.00 +40 DSTbin3 29.00 0.000000E+00 0.00 0.00 +41 DSTbin4 29.00 0.000000E+00 0.00 0.00 +42 DSTbin5 29.00 0.000000E+00 0.00 0.00 +43 DSTbin6 29.00 0.000000E+00 0.00 0.00 +44 DSTbin7 29.00 0.000000E+00 0.00 0.00 +45 SALA 31.40 0.000000E+00 0.00 0.00 +46 SALC 31.40 0.000000E+00 0.00 0.00 +47 Br2 160.00 7.600000E-01 3720.00 0.00 +48 Br 80.00 0.000000E+00 0.00 0.00 +49 BrO 96.00 0.000000E+00 0.00 0.00 +50 HOBr 97.00 6.100000E+03 6014.00 0.00 +51 HBr 81.00 7.100000E+13 10200.00 0.00 +52 BrNO2 126.00 0.000000E+00 0.00 0.00 +53 BrNO3 142.00 0.000000E+00 0.00 0.00 +54 CHBr3 253.00 0.000000E+00 0.00 0.00 +55 CH2Br2 174.00 0.000000E+00 0.00 0.00 +56 CH3Br 95.00 0.000000E+00 0.00 0.00 +57 MPN 93.00 0.000000E+00 0.00 0.00 +58 ISOPND 147.00 2.000000E+06 9200.00 0.00 +59 ISOPNB 147.00 2.000000E+06 9200.00 0.00 +60 MOBA 114.00 2.300000E+04 6300.00 0.00 +61 PROPNN 119.00 5.000000E+05 0.00 0.00 +62 HAC 74.00 1.400000E+06 7200.00 0.00 +63 GLYC 60.00 4.100000E+04 4600.00 0.00 +64 MVKN 149.00 2.000000E+06 9200.00 0.00 +65 MACRN 149.00 2.000000E+06 9200.00 0.00 +66 MAP 76.00 8.400000E+02 5300.00 0.00 +67 NO2 46.00 0.000000E+00 0.00 0.00 +68 NO3 62.00 0.000000E+00 0.00 0.00 +69 HNO2 47.00 0.000000E+00 0.00 0.00 +70 BENZ 78.11 0.000000E+00 0.00 0.00 +71 TOLU 92.14 0.000000E+00 0.00 0.00 +72 XYLE 106.16 0.000000E+00 0.00 0.00 +73 MTPA 136.23 4.900000E-02 0.00 0.00 +74 LIMO 136.23 7.000000E-02 0.00 0.00 +75 MTPO 136.23 4.900000E-02 0.00 0.00 +76 SOAP 150.00 0.000000E+00 0.00 0.00 +77 SOAS 150.00 0.000000E+00 0.00 0.00 +78 EOH 46.07 1.900000E+02 6600.00 0.00 +79 MGLY 72.00 3.700000E+03 7500.00 0.00 +80 GLYX 58.00 3.600000E+05 7200.00 0.00 +81 ACTA 60.00 4.100000E+03 6300.00 0.00 +82 HPALD 116.00 0.000000E+00 0.00 0.00 +83 DHDN 226.00 2.000000E+06 9200.00 0.00 +84 ETHLN 105.00 2.000000E+06 9200.00 0.00 +85 HCOOH 46.00 8.900000E+03 6100.00 0.00 +86 IEPOXA 118.00 8.000000E+07 0.00 0.00 +87 IEPOXB 118.00 8.000000E+07 0.00 0.00 +88 IEPOXD 118.00 8.000000E+07 0.00 0.00 +89 ISN1 147.00 2.000000E+06 9200.00 0.00 +90 RIPA 118.00 1.700000E+06 0.00 0.00 +91 RIPB 118.00 1.700000E+06 0.00 0.00 +92 RIPD 118.00 1.700000E+06 0.00 0.00 +93 IMAE 102.00 1.200000E+05 7200.00 0.00 +94 SOAIE 118.00 0.000000E+00 0.00 0.00 +95 SOAME 102.00 0.000000E+00 0.00 0.00 +96 SOAGX 58.00 0.000000E+00 0.00 0.00 +97 SOAMG 72.00 0.000000E+00 0.00 0.00 +98 LVOC 154.00 1.000000E+08 7200.00 0.00 +99 LVOCOA 154.00 0.000000E+00 0.00 0.00 +100 ISN1OG 226.00 2.300000E+04 9200.00 0.00 +101 ISN1OA 226.00 0.000000E+00 0.00 0.00 +102 MONITS 215.00 1.700000E+04 9200.00 0.00 +103 MONITU 215.00 1.700000E+04 9200.00 0.00 +104 HONIT 215.00 2.690000E+13 5487.00 0.00 +105 IONITA 14.00 0.000000E+00 0.00 0.00 +106 MONITA 14.00 0.000000E+00 0.00 0.00 +107 INDIOL 102.00 0.000000E+00 0.00 0.00 +108 IPMN 147.00 0.000000E+00 0.00 0.00 +109 HC187 187.00 0.000000E+00 0.00 0.00 +110 N2O 44.00 0.000000E+00 0.00 0.00 +111 OCS 60.00 0.000000E+00 0.00 0.00 +112 CH4 16.00 0.000000E+00 0.00 0.00 +113 BrCl 115.00 0.000000E+00 0.00 0.00 +114 HCl 36.00 7.000000E+10 11000.00 0.00 +115 CCl4 152.00 0.000000E+00 0.00 0.00 +116 CH3Cl 50.00 0.000000E+00 0.00 0.00 +117 CH3CCl3 133.00 0.000000E+00 0.00 0.00 +118 CFC113 187.00 0.000000E+00 0.00 0.00 +119 CFC114 187.00 0.000000E+00 0.00 0.00 +120 CFC115 187.00 0.000000E+00 0.00 0.00 +121 HCFC123 117.00 0.000000E+00 0.00 0.00 +122 HCFC141b 117.00 0.000000E+00 0.00 0.00 +123 HCFC142b 117.00 0.000000E+00 0.00 0.00 +124 CFC11 137.00 0.000000E+00 0.00 0.00 +125 CFC12 121.00 0.000000E+00 0.00 0.00 +126 HCFC22 86.00 0.000000E+00 0.00 0.00 +127 H1211 165.00 0.000000E+00 0.00 0.00 +128 H1301 149.00 0.000000E+00 0.00 0.00 +129 H2402 260.00 0.000000E+00 0.00 0.00 +130 Cl 35.00 0.000000E+00 0.00 0.00 +131 ClO 51.00 0.000000E+00 0.00 0.00 +132 HOCl 52.00 6.500000E+02 5900.00 0.00 +133 ClNO3 97.00 0.000000E+00 0.00 0.00 +134 ClNO2 81.00 0.000000E+00 0.00 0.00 +135 ClOO 67.00 0.000000E+00 0.00 0.00 +136 OClO 67.00 0.000000E+00 0.00 0.00 +137 Cl2 71.00 0.000000E+00 0.00 0.00 +138 Cl2O2 103.00 0.000000E+00 0.00 0.00 +139 H2O 18.00 0.000000E+00 0.00 0.00 +140 BrSALA 80.00 0.000000E+00 0.00 0.00 +141 BrSALC 80.00 0.000000E+00 0.00 0.00 +142 CHCl3 119.00 0.000000E+00 0.00 0.00 +143 CH2Cl2 85.00 0.000000E+00 0.00 0.00 +144 CH3I 142.00 1.973846E-05 3600.00 0.00 +145 CH2I2 268.00 0.000000E+00 0.00 0.00 +146 CH2ICl 167.00 0.000000E+00 0.00 0.00 +147 CH2IBr 221.00 0.000000E+00 0.00 0.00 +148 HOI 144.00 1.540000E+04 8371.00 0.00 +149 I2 254.00 2.700000E+00 7507.40 0.00 +150 IBr 207.00 2.400000E+01 4916.70 0.00 +151 ICl 162.00 1.110000E+02 2105.50 0.00 +152 I 127.00 0.000000E+00 0.00 0.00 +153 IO 143.00 0.000000E+00 0.00 0.00 +154 HI 128.00 7.430000E+13 3187.20 0.00 +155 OIO 159.00 0.000000E+00 0.00 0.00 +156 INO 157.00 0.000000E+00 0.00 0.00 +157 IONO 173.00 3.000000E-01 7240.40 0.00 +158 IONO2 189.00 1.000000E+20 3980.00 0.00 +159 I2O2 286.00 1.000000E+20 18900.00 0.00 +160 I2O3 302.00 1.000000E+20 13400.00 0.00 +161 I2O4 318.00 1.000000E+20 13400.00 0.00 +162 ISALA 127.00 0.000000E+00 0.00 0.00 +163 ISALC 127.00 0.000000E+00 0.00 0.00 +164 AERI 127.00 0.000000E+00 0.00 0.00 +165 pFe 55.85 0.000000E+00 0.00 0.00 diff --git a/run/README b/run/README index cb3932e5..7f5a57c7 100644 --- a/run/README +++ b/run/README @@ -1,10 +1,9 @@ This is a HEMCO standalone run directory. -For more information on how to download and run the HEMCO standalone model, +For more information on how to download and run the HEMCO Standalone model, please see: - http://wiki.geos-chem.org/HEMCO_standalone + https://hemco.readthedocs.io/en/stable/hco-sa-guide/intro.html -28 Sep 2020 +17 Nov 2025 GEOS-Chem Support Team -geos-chem-support@g.harvard.edu \ No newline at end of file diff --git a/run/cleanRunDir.sh b/run/cleanRunDir.sh index 6629ac42..99f148f4 100755 --- a/run/cleanRunDir.sh +++ b/run/cleanRunDir.sh @@ -1,17 +1,19 @@ #!/bin/bash #============================================================================ -# cleanRunDir.sh: Removes files created by GEOS-Chem from a run directory +# cleanRunDir.sh: Removes files created by HEMCO standalone from a run dir. # # Usage: # ------ -# $ ./cleanRunDir.sh # Removes model output files in the run directory. -# # Also prompts the user before removing diagnostic -# # output files in OutputDir/. +# $ ./cleanRunDir.sh # Removes model output files in the run +# # directory. Also prompts the user before +# # removing diagnostic output files from +# # from OutputDir/. # -# $ ./cleanRunDir.sh 1 # Removes model ouptut files in the run directory, -# # but will remove diagnostic output files without -# # prompting first. USE WITH CAUTION! +# $ ./cleanRunDir.sh --force # Removes model output files in the run +# # directory, but will remove diagnostic +# # output files without prompting first. +# # USE WITH CAUTION! #============================================================================ # Clean model output files in the run directory @@ -33,8 +35,3 @@ else # User Confirmation not required rm -fv ./OutputDir/*.nc* rm -fv ./OutputDir/*.txt* fi - -#--------------------------------------------------------------------------- -# Give instruction to reset start date if using GCHP -#--------------------------------------------------------------------------- -echo "Reset simulation start date in cap_restart if using GCHP" diff --git a/run/config_for_offline_emissions/HEMCO_Config.rc.025x03125.GEOSFP.DustL23M b/run/config_for_offline_emissions/HEMCO_Config.rc.025x03125.GEOSFP.DustL23M new file mode 100644 index 00000000..60852790 --- /dev/null +++ b/run/config_for_offline_emissions/HEMCO_Config.rc.025x03125.GEOSFP.DustL23M @@ -0,0 +1,145 @@ +#------------------------------------------------------------------------------ +# Harmonized Emissions Component (HEMCO) ! +#------------------------------------------------------------------------------ +#BOP +# +# !MODULE: HEMCO_sa_Config.rc +# +# !DESCRIPTION: Contains configuration information for the HEMCO standalone +# model. You can define global settings here. +#\\ +#\\ +# !REMARKS: +# See The HEMCO User's Guide for file details: +# http://wiki.geos-chem.org/The_HEMCO_User%27s_Guide +# +# For HEMCO standalone simulations, you can simply "drop in" an existing +# HEMCO_Config.rc file from another model (e.g. GEOS-Chem), and those settings +# will be activated. This is done with the ">>>include HEMCO_Config.rc" +# statement. Settings in HEMCO_sa_Config.rc will always override any settings +# in the included HEMCO_Config.rc. +# +# We recommend to use the emissions options in HEMCO_Config.rc (rather than +# overriding them in HEMCO_sa_Config.rc) so that the standalone simulation +# will provide the same emissions as would the corresponding model simulation. +# +# !REVISION HISTORY: +# See https://github.com/geoschem/hemco for complete history +#EOP +#------------------------------------------------------------------------------ +#BOC +############################################################################### +### BEGIN SECTION SETTINGS +############################################################################### +#----------------------------------------------------- +# Settings for HEMCO standalone input and output +#----------------------------------------------------- +ROOT: /ExtData/HEMCO +METDIR: /ExtData/GEOS_0.25x0.3125/GEOS_FP +GridFile: HEMCO_sa_Grid.025x03125.rc +SpecFile: HEMCO_sa_Spec.rc +TimeFile: HEMCO_sa_Time.rc +DiagnFile: HEMCO_Diagn.rc +Logfile: * +#----------------------------------------------------- +# Settings for HEMCO grid +#----------------------------------------------------- +MET: GEOSFP +RES: 025x03125 +NC: nc +#----------------------------------------------------- +# Settings for HEMCO standalone diagnostics +#----------------------------------------------------- +DefaultDiagnOn: false +DefaultDiagnSname: TOTAL_ +DefaultDiagnLname: HEMCO_total_emissions_ +DefaultDiagnDim: 2 +DefaultDiagnUnit: kgm-2s-1 +DiagnPrefix: OutputDir/HEMCO_sa_diagnostics +DiagnFreq: 00000000 010000 +#----------------------------------------------------- +# Debugging options +# (set verbose to true to toggle debug printout) +#----------------------------------------------------- +Unit tolerance: 1 +Negative values: 0 +Verbose: false +#----------------------------------------------------- +# Additional settings +#----------------------------------------------------- +PBL dry deposition: False + +### END SECTION SETTINGS ### + +############################################################################### +### BEGIN SECTION EXTENSION SWITCHES +############################################################################### +### Set the below switches below to false and HEMCO extensions to off. They +### are only needed for GEOS-Chem simualations, but not for HEMCO standalone +### simulations. Turning off the extensions also avoids having to supply +### certain data fields for the extentions that usually are obtained directly +### from GEOS-Chem. +############################################################################### +# ExtNr ExtName on/off Species +0 Base : on * +# ----- MAIN SWITCHES --------------------------------------------------------- + --> EMISSIONS : true + --> METEOROLOGY : true # 1980-2021 + --> CHEMISTRY_INPUT : false +125 DustL23M : on TDST/DSTbin1/DSTbin2/DSTbin3/DSTbin4/DSTbin5/DSTbin6/DSTbin7 + --> Mass tuning factor : 2.832e-3 +### END SECTION EXTENSION SWITCHES ### + +############################################################################### +### BEGIN SECTION BASE EMISSIONS +############################################################################### + +# ExtNr Name sourceFile sourceVar sourceTime C/R/E SrcDim SrcUnit Species ScalIDs Cat Hier +(((EMISSIONS +(((DustL23M +125 L23M_A_bare $ROOT/DustL23M/v2025-07/LandCover/MCD12C1.LC.$YYYY.0.1.nc4 LC_bare 1998-2022/1/1/0 C xy 1 * - 1 1 +125 L23M_A_veg $ROOT/DustL23M/v2025-07/LandCover/MCD12C1.LC.$YYYY.0.1.nc4 LC_veg 1998-2022/1/1/0 C xy 1 * - 1 1 +125 L23M_Csah $ROOT/DustL23M/v2025-07/scale/DustL23_scale_025x03125_scaleSAv2.nc4 scale 2000/1/1/0 C xy 1 * - 1 1 +125 L23M_LAI $ROOT/DustL23M/v2025-07/LandCover/XLAI_025x025_$YYYY_MonMean.nc4 LAI 2000-2020/1-12/1/0 C xy 1 * - 1 1 +125 L23M_fclay $ROOT/DustL23M/v2025-07/GSDE/GSDE_clay-sand-silt_0.1.nc4 f_clay 2000/1/1/0 C xy 1 * - 1 1 +125 L23M_BD $ROOT/DustL23M/v2025-07/GSDE/GSDE_clay-sand-silt_0.1.nc4 bulk_density 2000/1/1/0 C xy kg-soil/m3 * - 1 1 +125 L23M_poros $ROOT/DustL23M/v2025-07/poros/MERRA2.const_2d_lnd_Nx.poros.nc4 poros 1980/1/1/0 C xy 1 * - 1 1 +125 L23M_roughness_r $ROOT/DustL23M/v2025-07/roughness/Surf_roughness_min_rocks_1997.nc4 roughness_r 1997/1/1/0 C xy m * - 1 1 +)))DustL23M +)))EMISSIONS +(((METEOROLOGY +* USTAR $METDIR/$YYYY/$MM/$MET.$YYYY$MM$DD.A1.$RES.$NC USTAR 2014-2024/1-12/1-31/*/+30minute EFY xy m/s * - 1 1 +* T2M $METDIR/$YYYY/$MM/$MET.$YYYY$MM$DD.A1.$RES.$NC T2M 2014-2024/1-12/1-31/*/+30minute EFY xy K * - 1 1 +* TS $METDIR/$YYYY/$MM/$MET.$YYYY$MM$DD.A1.$RES.$NC TS 2014-2024/1-12/1-31/*/+30minute EFY xy K * - 1 1 +* PBLH $METDIR/$YYYY/$MM/$MET.$YYYY$MM$DD.A1.$RES.$NC PBLH 2014-2024/1-12/1-31/*/+30minute EFY xy m * - 1 1 +* GWETTOP $METDIR/$YYYY/$MM/$MET.$YYYY$MM$DD.A1.$RES.$NC GWETTOP 2014-2024/1-12/1-31/*/+30minute EFY xy 1 * - 1 1 +* HFLUX $METDIR/$YYYY/$MM/$MET.$YYYY$MM$DD.A1.$RES.$NC HFLUX 2014-2024/1-12/1-31/*/+30minute EFY xy W/m2 * - 1 1 +* SNOMAS $METDIR/$YYYY/$MM/$MET.$YYYY$MM$DD.A1.$RES.$NC SNOMAS 2014-2024/1-12/1-31/*/+30minute EFY xy kg-H2O/m2 * - 1 1 + +* PS $METDIR/$YYYY/$MM/$MET.$YYYY$MM$DD.I3.$RES.$NC PS 2014-2024/1-12/1-31/* EFY xy hPa * - 1 1 +)))METEOROLOGY + +#============================================================================== +# --- Drop in a "HEMCO_Config.rc" file here --- +#============================================================================== +# >>>include HEMCO_Config.rc + +### END SECTION BASE EMISSIONS ### + +############################################################################### +### BEGIN SECTION SCALE FACTORS +############################################################################### + +# ScalID Name sourceFile sourceVar sourceTime C/R/E SrcDim SrcUnit Oper + +### END SECTION SCALE FACTORS ### + +############################################################################### +### BEGIN SECTION MASKS +############################################################################### + +# ScalID Name sourceFile sourceVar sourceTime C/R/E SrcDim SrcUnit Oper Lon1/Lat1/Lon2/Lat2 +### END SECTION MASKS ### + +### END OF HEMCO INPUT FILE ### +#EOC diff --git a/run/config_for_offline_emissions/HEMCO_Config.rc.05x0625.GEOSIT.DustL23M b/run/config_for_offline_emissions/HEMCO_Config.rc.05x0625.GEOSIT.DustL23M new file mode 100644 index 00000000..9691ea4e --- /dev/null +++ b/run/config_for_offline_emissions/HEMCO_Config.rc.05x0625.GEOSIT.DustL23M @@ -0,0 +1,144 @@ +#------------------------------------------------------------------------------ +# Harmonized Emissions Component (HEMCO) ! +#------------------------------------------------------------------------------ +#BOP +# +# !MODULE: HEMCO_sa_Config.rc +# +# !DESCRIPTION: Contains configuration information for the HEMCO standalone +# model. You can define global settings here. +#\\ +#\\ +# !REMARKS: +# See The HEMCO User's Guide for file details: +# http://wiki.geos-chem.org/The_HEMCO_User%27s_Guide +# +# For HEMCO standalone simulations, you can simply "drop in" an existing +# HEMCO_Config.rc file from another model (e.g. GEOS-Chem), and those settings +# will be activated. This is done with the ">>>include HEMCO_Config.rc" +# statement. Settings in HEMCO_sa_Config.rc will always override any settings +# in the included HEMCO_Config.rc. +# +# We recommend to use the emissions options in HEMCO_Config.rc (rather than +# overriding them in HEMCO_sa_Config.rc) so that the standalone simulation +# will provide the same emissions as would the corresponding model simulation. +# +# !REVISION HISTORY: +# See https://github.com/geoschem/hemco for complete history +#EOP +#------------------------------------------------------------------------------ +#BOC +############################################################################### +### BEGIN SECTION SETTINGS +############################################################################### +#----------------------------------------------------- +# Settings for HEMCO standalone input and output +#----------------------------------------------------- +ROOT: /ExtData/HEMCO +METDIR: /ExtData/GEOS_0.5x0.625/GEOS_IT +GridFile: HEMCO_sa_Grid.05x0625.rc +SpecFile: HEMCO_sa_Spec.rc +TimeFile: HEMCO_sa_Time.rc +DiagnFile: HEMCO_Diagn.rc +Logfile: * +#----------------------------------------------------- +# Settings for HEMCO grid +#----------------------------------------------------- +MET: GEOSIT +RES: 05x0625 +NC: nc +#----------------------------------------------------- +# Settings for HEMCO standalone diagnostics +#----------------------------------------------------- +DefaultDiagnOn: false +DefaultDiagnSname: TOTAL_ +DefaultDiagnLname: HEMCO_total_emissions_ +DefaultDiagnDim: 2 +DefaultDiagnUnit: kgm-2s-1 +DiagnPrefix: OutputDir/HEMCO_sa_diagnostics +DiagnFreq: 00000000 010000 +#----------------------------------------------------- +# Debugging options +# (set verbose to true to toggle debug printout) +#----------------------------------------------------- +Unit tolerance: 1 +Negative values: 0 +Verbose: false +#----------------------------------------------------- +# Additional settings +#----------------------------------------------------- +PBL dry deposition: False + +### END SECTION SETTINGS ### + +############################################################################### +### BEGIN SECTION EXTENSION SWITCHES +############################################################################### +### Set the below switches below to false and HEMCO extensions to off. They +### are only needed for GEOS-Chem simualations, but not for HEMCO standalone +### simulations. Turning off the extensions also avoids having to supply +### certain data fields for the extentions that usually are obtained directly +### from GEOS-Chem. +############################################################################### +# ExtNr ExtName on/off Species +0 Base : on * +# ----- MAIN SWITCHES --------------------------------------------------------- + --> EMISSIONS : true + --> METEOROLOGY : true # 1980-2021 + --> CHEMISTRY_INPUT : false +125 DustL23M : on TDST/DSTbin1/DSTbin2/DSTbin3/DSTbin4/DSTbin5/DSTbin6/DSTbin7 + --> Mass tuning factor : 2.411E-03 +### END SECTION EXTENSION SWITCHES ### + +############################################################################### +### BEGIN SECTION BASE EMISSIONS +############################################################################### + +# ExtNr Name sourceFile sourceVar sourceTime C/R/E SrcDim SrcUnit Species ScalIDs Cat Hier +(((EMISSIONS +(((DustL23M +125 L23M_A_bare $ROOT/DustL23M/v2025-07/LandCover/MCD12C1.LC.$YYYY.0.1.nc4 LC_bare 1998-2022/1/1/0 C xy 1 * - 1 1 +125 L23M_A_veg $ROOT/DustL23M/v2025-07/LandCover/MCD12C1.LC.$YYYY.0.1.nc4 LC_veg 1998-2022/1/1/0 C xy 1 * - 1 1 +125 L23M_Csah $ROOT/DustL23M/v2025-07/scale/DustL23_scale_025x03125_scaleSAv2.nc4 scale 2000/1/1/0 C xy 1 * - 1 1 +125 L23M_LAI $ROOT/DustL23M/v2025-07/LandCover/XLAI_025x025_$YYYY_MonMean.nc4 LAI 2000-2020/1-12/1/0 C xy 1 * - 1 1 +125 L23M_fclay $ROOT/DustL23M/v2025-07/GSDE/GSDE_clay-sand-silt_0.1.nc4 f_clay 2000/1/1/0 C xy 1 * - 1 1 +125 L23M_BD $ROOT/DustL23M/v2025-07/GSDE/GSDE_clay-sand-silt_0.1.nc4 bulk_density 2000/1/1/0 C xy kg-soil/m3 * - 1 1 +125 L23M_poros $ROOT/DustL23M/v2025-07/poros/MERRA2.const_2d_lnd_Nx.poros.nc4 poros 1980/1/1/0 C xy 1 * - 1 1 +125 L23M_roughness_r $ROOT/DustL23M/v2025-07/roughness/Surf_roughness_min_rocks_1997.nc4 roughness_r 1997/1/1/0 C xy m * - 1 1 +)))DustL23M +)))EMISSIONS +(((METEOROLOGY +* USTAR $METDIR/$YYYY/$MM/$MET.$YYYY$MM$DD.A1.$RES.$NC USTAR 2014-2024/1-12/1-31/*/+30minute EFY xy m/s * - 1 1 +* T2M $METDIR/$YYYY/$MM/$MET.$YYYY$MM$DD.A1.$RES.$NC T2M 2014-2024/1-12/1-31/*/+30minute EFY xy K * - 1 1 +* TS $METDIR/$YYYY/$MM/$MET.$YYYY$MM$DD.A1.$RES.$NC TS 2014-2024/1-12/1-31/*/+30minute EFY xy K * - 1 1 +* PBLH $METDIR/$YYYY/$MM/$MET.$YYYY$MM$DD.A1.$RES.$NC PBLH 2014-2024/1-12/1-31/*/+30minute EFY xy m * - 1 1 +* GWETTOP $METDIR/$YYYY/$MM/$MET.$YYYY$MM$DD.A1.$RES.$NC GWETTOP 2014-2024/1-12/1-31/*/+30minute EFY xy 1 * - 1 1 +* HFLUX $METDIR/$YYYY/$MM/$MET.$YYYY$MM$DD.A1.$RES.$NC HFLUX 2014-2024/1-12/1-31/*/+30minute EFY xy W/m2 * - 1 1 +* SNOMAS $METDIR/$YYYY/$MM/$MET.$YYYY$MM$DD.A1.$RES.$NC SNOMAS 2014-2024/1-12/1-31/*/+30minute EFY xy kg-H2O/m2 * - 1 1 + +* PS $METDIR/$YYYY/$MM/$MET.$YYYY$MM$DD.I3.$RES.$NC PS 2014-2024/1-12/1-31/* EFY xy hPa * - 1 1 +)))METEOROLOGY + +#============================================================================== +# --- Drop in a "HEMCO_Config.rc" file here --- +#============================================================================== +# >>>include HEMCO_Config.rc + +### END SECTION BASE EMISSIONS ### + +############################################################################### +### BEGIN SECTION SCALE FACTORS +############################################################################### + +# ScalID Name sourceFile sourceVar sourceTime C/R/E SrcDim SrcUnit Oper +### END SECTION SCALE FACTORS ### + +############################################################################### +### BEGIN SECTION MASKS +############################################################################### + +# ScalID Name sourceFile sourceVar sourceTime C/R/E SrcDim SrcUnit Oper Lon1/Lat1/Lon2/Lat2 +### END SECTION MASKS ### + +### END OF HEMCO INPUT FILE ### +#EOC diff --git a/run/config_for_offline_emissions/HEMCO_Config.rc.05x0625.MERRA2.DustL23M b/run/config_for_offline_emissions/HEMCO_Config.rc.05x0625.MERRA2.DustL23M new file mode 100644 index 00000000..1806d641 --- /dev/null +++ b/run/config_for_offline_emissions/HEMCO_Config.rc.05x0625.MERRA2.DustL23M @@ -0,0 +1,145 @@ +#------------------------------------------------------------------------------ +# Harmonized Emissions Component (HEMCO) ! +#------------------------------------------------------------------------------ +#BOP +# +# !MODULE: HEMCO_sa_Config.rc +# +# !DESCRIPTION: Contains configuration information for the HEMCO standalone +# model. You can define global settings here. +#\\ +#\\ +# !REMARKS: +# See The HEMCO User's Guide for file details: +# http://wiki.geos-chem.org/The_HEMCO_User%27s_Guide +# +# For HEMCO standalone simulations, you can simply "drop in" an existing +# HEMCO_Config.rc file from another model (e.g. GEOS-Chem), and those settings +# will be activated. This is done with the ">>>include HEMCO_Config.rc" +# statement. Settings in HEMCO_sa_Config.rc will always override any settings +# in the included HEMCO_Config.rc. +# +# We recommend to use the emissions options in HEMCO_Config.rc (rather than +# overriding them in HEMCO_sa_Config.rc) so that the standalone simulation +# will provide the same emissions as would the corresponding model simulation. +# +# !REVISION HISTORY: +# See https://github.com/geoschem/hemco for complete history +#EOP +#------------------------------------------------------------------------------ +#BOC +############################################################################### +### BEGIN SECTION SETTINGS +############################################################################### +#----------------------------------------------------- +# Settings for HEMCO standalone input and output +#----------------------------------------------------- +ROOT: /ExtData/HEMCO +METDIR: /ExtData/GEOS_0.5x0.625/MERRA2 +GridFile: HEMCO_sa_Grid.05x0625.rc +SpecFile: HEMCO_sa_Spec.rc +TimeFile: HEMCO_sa_Time.rc +DiagnFile: HEMCO_Diagn.rc +Logfile: * +#----------------------------------------------------- +# Settings for HEMCO grid +#----------------------------------------------------- +MET: MERRA2 +RES: 05x0625 +NC: nc4 +#----------------------------------------------------- +# Settings for HEMCO standalone diagnostics +#----------------------------------------------------- +DefaultDiagnOn: false +DefaultDiagnSname: TOTAL_ +DefaultDiagnLname: HEMCO_total_emissions_ +DefaultDiagnDim: 2 +DefaultDiagnUnit: kgm-2s-1 +DiagnPrefix: OutputDir/HEMCO_sa_diagnostics +DiagnFreq: 00000000 010000 +#----------------------------------------------------- +# Debugging options +# (set verbose to true to toggle debug printout) +#----------------------------------------------------- +Unit tolerance: 1 +Negative values: 0 +Verbose: false +#----------------------------------------------------- +# Additional settings +#----------------------------------------------------- +PBL dry deposition: False + +### END SECTION SETTINGS ### + +############################################################################### +### BEGIN SECTION EXTENSION SWITCHES +############################################################################### +### Set the below switches below to false and HEMCO extensions to off. They +### are only needed for GEOS-Chem simualations, but not for HEMCO standalone +### simulations. Turning off the extensions also avoids having to supply +### certain data fields for the extentions that usually are obtained directly +### from GEOS-Chem. +############################################################################### +# ExtNr ExtName on/off Species +0 Base : on * +# ----- MAIN SWITCHES --------------------------------------------------------- + --> EMISSIONS : true + --> METEOROLOGY : true # 1980-2021 + --> CHEMISTRY_INPUT : false +125 DustL23M : on TDST/DSTbin1/DSTbin2/DSTbin3/DSTbin4/DSTbin5/DSTbin6/DSTbin7 + --> Mass tuning factor : 3.758E-03 +### END SECTION EXTENSION SWITCHES ### + +############################################################################### +### BEGIN SECTION BASE EMISSIONS +############################################################################### + +# ExtNr Name sourceFile sourceVar sourceTime C/R/E SrcDim SrcUnit Species ScalIDs Cat Hier +(((EMISSIONS +(((DustL23M +125 L23M_A_bare $ROOT/DustL23M/v2025-07/LandCover/MCD12C1.LC.$YYYY.0.1.nc4 LC_bare 1998-2022/1/1/0 C xy 1 * - 1 1 +125 L23M_A_veg $ROOT/DustL23M/v2025-07/LandCover/MCD12C1.LC.$YYYY.0.1.nc4 LC_veg 1998-2022/1/1/0 C xy 1 * - 1 1 +125 L23M_Csah $ROOT/DustL23M/v2025-07/scale/DustL23_scale_025x03125_scaleSAv2.nc4 scale 2000/1/1/0 C xy 1 * - 1 1 +125 L23M_LAI $ROOT/DustL23M/v2025-07/LandCover/XLAI_025x025_$YYYY_MonMean.nc4 LAI 2000-2020/1-12/1/0 C xy 1 * - 1 1 +125 L23M_fclay $ROOT/DustL23M/v2025-07/GSDE/GSDE_clay-sand-silt_0.1.nc4 f_clay 2000/1/1/0 C xy 1 * - 1 1 +125 L23M_BD $ROOT/DustL23M/v2025-07/GSDE/GSDE_clay-sand-silt_0.1.nc4 bulk_density 2000/1/1/0 C xy kg-soil/m3 * - 1 1 +125 L23M_poros $ROOT/DustL23M/v2025-07/poros/MERRA2.const_2d_lnd_Nx.poros.nc4 poros 1980/1/1/0 C xy 1 * - 1 1 +125 L23M_roughness_r $ROOT/DustL23M/v2025-07/roughness/Surf_roughness_min_rocks_1997.nc4 roughness_r 1997/1/1/0 C xy m * - 1 1 +)))DustL23M +)))EMISSIONS +(((METEOROLOGY +* USTAR $METDIR/$YYYY/$MM/$MET.$YYYY$MM$DD.A1.$RES.$NC USTAR 2014-2024/1-12/1-31/*/+30minute EFY xy m/s * - 1 1 +* T2M $METDIR/$YYYY/$MM/$MET.$YYYY$MM$DD.A1.$RES.$NC T2M 2014-2024/1-12/1-31/*/+30minute EFY xy K * - 1 1 +* TS $METDIR/$YYYY/$MM/$MET.$YYYY$MM$DD.A1.$RES.$NC TS 2014-2024/1-12/1-31/*/+30minute EFY xy K * - 1 1 +* PBLH $METDIR/$YYYY/$MM/$MET.$YYYY$MM$DD.A1.$RES.$NC PBLH 2014-2024/1-12/1-31/*/+30minute EFY xy m * - 1 1 +* GWETTOP $METDIR/$YYYY/$MM/$MET.$YYYY$MM$DD.A1.$RES.$NC GWETTOP 2014-2024/1-12/1-31/*/+30minute EFY xy 1 * - 1 1 +* HFLUX $METDIR/$YYYY/$MM/$MET.$YYYY$MM$DD.A1.$RES.$NC HFLUX 2014-2024/1-12/1-31/*/+30minute EFY xy W/m2 * - 1 1 +* SNOMAS $METDIR/$YYYY/$MM/$MET.$YYYY$MM$DD.A1.$RES.$NC SNOMAS 2014-2024/1-12/1-31/*/+30minute EFY xy kg-H2O/m2 * - 1 1 + +* PS $METDIR/$YYYY/$MM/$MET.$YYYY$MM$DD.I3.$RES.$NC PS 2014-2024/1-12/1-31/* EFY xy hPa * 105 1 1 +)))METEOROLOGY + +#============================================================================== +# --- Drop in a "HEMCO_Config.rc" file here --- +#============================================================================== +# >>>include HEMCO_Config.rc + +### END SECTION BASE EMISSIONS ### + +############################################################################### +### BEGIN SECTION SCALE FACTORS +############################################################################### + +# ScalID Name sourceFile sourceVar sourceTime C/R/E SrcDim SrcUnit Oper +105 Pa_to_hPa 0.01 - - - xy 1 1 +### END SECTION SCALE FACTORS ### + +############################################################################### +### BEGIN SECTION MASKS +############################################################################### + +# ScalID Name sourceFile sourceVar sourceTime C/R/E SrcDim SrcUnit Oper Lon1/Lat1/Lon2/Lat2 +### END SECTION MASKS ### + +### END OF HEMCO INPUT FILE ### +#EOC diff --git a/run/createRunDir.sh b/run/createRunDir.sh index b22dfe09..11a29cce 100755 --- a/run/createRunDir.sh +++ b/run/createRunDir.sh @@ -304,16 +304,18 @@ done mkdir -p ${rundir} # Copy run directory files and subdirectories -cp -r ./OutputDir ${rundir} +cp -r ./OutputDir ${rundir} +cp -r ./config_for_offline_emissions ${rundir} mkdir -p ${rundir}/Restarts -cp ./HEMCO_sa_Config.template ${rundir}/HEMCO_sa_Config.rc -cp ./HEMCO_sa_Time.rc ${rundir} -cp ./HEMCO_sa_Spec.rc ${rundir} -cp ./${grid_file} ${rundir} -cp ./runHEMCO.sh ${rundir} -cp ./README ${rundir} -cp ./download_data* ${rundir} -cp ${hco_config_dir}/HEMCO_Config.* ${rundir} +cp ./HEMCO_sa_Config.template ${rundir}/HEMCO_sa_Config.rc +cp ./HEMCO_sa_Time.rc ${rundir} +cp ./HEMCO_sa_Spec.rc ${rundir} +cp ./${grid_file} ${rundir} +cp ./runHEMCO.sh ${rundir} +cp ./README ${rundir} +cp ./download_data* ${rundir} +cp ./cleanRunDir.sh ${rundir} +cp ${hco_config_dir}/HEMCO_Config.* ${rundir} if [[ -f ${hco_config_dir}/HEMCO_Diagn.rc ]]; then cp ${hco_config_dir}/HEMCO_Diagn.rc ${rundir} else diff --git a/src/Core/hco_calc_mod.F90 b/src/Core/hco_calc_mod.F90 index c9a6f2a2..dabfdd44 100644 --- a/src/Core/hco_calc_mod.F90 +++ b/src/Core/hco_calc_mod.F90 @@ -1193,32 +1193,6 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, & ! Continue to end of loop if an error has occurred ! (we cannot exit from a parallel loop) IF ( error > 0 ) CYCLE - - !--------------------------------------------------------------- - ! If there is a mask associated with this scale factors, check - ! if this grid box is within or outside of the mask region. - ! Values that partially fall into the mask region are either - ! treated as binary (100% inside or outside), or partially - ! (using the real grid area fractions), depending on the - ! HEMCO options. - !--------------------------------------------------------------- - - ! Default mask scaling is 1.0 (no mask applied) - maskScale = 1.0_sp - - ! If there is a mask applied to this scale factor ... - IF ( isMaskDct ) THEN - CALL GetMaskVal ( MaskDct, I, J, & - MaskScale, MaskFractions, EC ) - IF ( EC /= HCO_SUCCESS ) THEN - error = 4 - CYCLE - ENDIF - ENDIF - - ! We continue an skip this grid box if mask is completely zero - IF ( maskScale <= 0.0_sp ) CYCLE - ! Get current time index for this container and at this location tIDx = tIDx_GetIndx( HcoState, ScalDct%Dta, I, J ) IF ( tIDx < 1 ) THEN @@ -1293,13 +1267,27 @@ SUBROUTINE Get_Current_Emissions( HcoState, BaseDct, nI, nJ, & ! value if it's a scalar field. !------------------------------------------------------------ tmpVal = Get_Value_From_DataCont( I, J, L, tIdX, ScalDct ) - - ! Set missing value to one - IF ( tmpVal == HCO_MISSVAL ) tmpVal = 1.0_sp - - ! Eventually apply mask scaling - IF ( maskScale /= 1.0_sp ) THEN - tmpVal = tmpVal * MaskScale + + !--------------------------------------------------------------- + ! If there is srcGMaskID defined with this scale factors, check + ! if scale (mask) in this grid box is equal to srcGMaskID or not. + ! if scale(mask) == srcGMaskID, scale = 1, else = 0. + !--------------------------------------------------------------- + + ! Eventually apply srcGmaskID to set to scale (mask) to binary + ! If there is a srcGMaskID applied to this scale factor, + ! then this scale factor is actually a global mask ... + IF ( ScalDct%srcGMaskID > 0 ) THEN + ! Set missing mask to 0 + IF ( tmpVal == HCO_MISSVAL ) tmpVal = 0.0_sp + IF ( abs(TMPVAL - ScalDct%srcGMaskID) < 0.01_sp ) THEN + tmpval = 1.0_sp + ELSE + tmpval = 0.0_sp + ENDIF + ELSE + ! Set missing value to one + IF ( tmpVal == HCO_MISSVAL ) tmpVal = 1.0_sp ENDIF !------------------------------------------------------------ @@ -3108,22 +3096,6 @@ SUBROUTINE Get_Current_Emissions_Adj( HcoState, BaseDct, & ! HEMCO options. ! ------------------------------------------------------------ - ! Default mask scaling is 1.0 (no mask applied) - MaskScale = 1.0_sp - - ! If there is a mask applied to this scale factor ... - IF ( ASSOCIATED(MaskDct) ) THEN - CALL GetMaskVal ( MaskDct, I, J, & - MaskScale, MaskFractions, RC ) - IF ( RC /= HCO_SUCCESS ) THEN - ERROR = 4 - EXIT - ENDIF - ENDIF - - ! We can skip this grid box if mask is completely zero - IF ( MaskScale <= 0.0_sp ) CYCLE - ! Get current time index for this container and at this location tIDx = tIDx_GetIndx( HcoState, ScalDct%Dta, I, J ) IF ( tIDx < 1 ) THEN @@ -3202,12 +3174,26 @@ SUBROUTINE Get_Current_Emissions_Adj( HcoState, BaseDct, & TMPVAL = ScalDct%Dta%V3(tidx)%Val(I,J,TmpLL) ENDIF - ! Set missing value to one - IF ( TMPVAL == HCO_MISSVAL ) TMPVAL = 1.0_sp - - ! Eventually apply mask scaling - IF ( MaskScale /= 1.0_sp ) THEN - TMPVAL = TMPVAL * MaskScale + !------------------------------------------------------------ + ! Get scale factor for this grid box. Use same uniform + ! value if it's a scalar field. + !------------------------------------------------------------ + tmpVal = Get_Value_From_DataCont( I, J, L, tIdX, ScalDct ) + + ! Eventually apply srcGmaskID to set to scale (mask) to binary + ! If there is a srcGMaskID applied to this scale factor, + ! then this scale factor is actually a global mask ... + IF ( ScalDct%srcGMaskID > 0 ) THEN + ! Set missing mask to 0 + IF ( tmpVal == HCO_MISSVAL ) tmpVal = 0.0_sp + IF ( abs(TMPVAL - ScalDct%srcGMaskID) < 0.01_sp ) THEN + tmpval = 1.0_sp + ELSE + tmpval = 0.0_sp + ENDIF + ELSE + ! Set missing value to one + IF ( tmpVal == HCO_MISSVAL ) tmpVal = 1.0_sp ENDIF ! For negative scale factor, proceed according to the diff --git a/src/Core/hco_chartools_mod.F90 b/src/Core/hco_chartools_mod.F90 index 9eff7bd3..9a4bccac 100644 --- a/src/Core/hco_chartools_mod.F90 +++ b/src/Core/hco_chartools_mod.F90 @@ -30,7 +30,7 @@ MODULE HCO_CharTools_Mod PUBLIC :: IsInWord PUBLIC :: NextCharPos PUBLIC :: GetNextLine - PUBLIC :: HCO_READLINE + PUBLIC :: HCO_ReadLine ! ! !REVISION HISTORY: ! 18 Dec 2013 - C. Keller - Initialization diff --git a/src/Core/hco_config_mod.F90 b/src/Core/hco_config_mod.F90 index a5c404c9..b70ea429 100644 --- a/src/Core/hco_config_mod.F90 +++ b/src/Core/hco_config_mod.F90 @@ -5224,15 +5224,11 @@ SUBROUTINE UpdateDtaProperties( char1, char2, dctType, int3, & IF ( levScal2 > 0 ) Lct%Dct%levScalID2 = levScal2 !======================================================================== - ! For scale factors: check if a mask is assigned to this scale factor. - ! In this case, pass mask ID to first slot of Scal_cID vector. This - ! value will be set to the container ID of the corresponding mask - ! field later on. + ! For scale factors: Use srcGMaskID to select specific grid boxes with the + ! scale (mask) value equal to srcGMaskID (D. Zhang, 05/28/2025) !======================================================================== IF ( DctType == HCO_DCTTYPE_SCAL .AND. Int3 > 0 ) THEN - ALLOCATE ( Lct%Dct%Scal_cID(1) ) - Lct%Dct%Scal_cID(1) = Int3 - Lct%Dct%nScalID = 1 + Lct%Dct%srcGMaskID = REAL(Int3, kind=sp) ENDIF !======================================================================== diff --git a/src/Core/hco_datacont_mod.F90 b/src/Core/hco_datacont_mod.F90 index 220ea1f2..ea7aa138 100644 --- a/src/Core/hco_datacont_mod.F90 +++ b/src/Core/hco_datacont_mod.F90 @@ -190,6 +190,7 @@ SUBROUTINE DataCont_Init( Dct, cID ) Dct%cName = '' Dct%spcName = '' Dct%ScalID = -999 + Dct%srcGMaskID = -999.0_sp Dct%HcoID = -999 Dct%Cat = -999 Dct%Hier = -999 diff --git a/src/Core/hco_error_mod.F90 b/src/Core/hco_error_mod.F90 index 46138233..29a1eec7 100644 --- a/src/Core/hco_error_mod.F90 +++ b/src/Core/hco_error_mod.F90 @@ -131,7 +131,7 @@ MODULE HCO_Error_Mod #endif ! HEMCO version number. - CHARACTER(LEN=12), PARAMETER, PUBLIC :: HCO_VERSION = '3.11.2' + CHARACTER(LEN=12), PARAMETER, PUBLIC :: HCO_VERSION = '3.12.0' ! ! !REVISION HISTORY: @@ -206,7 +206,7 @@ SUBROUTINE HCO_Error( ErrMsg, RC, THISLOC, LUN ) !------------------------------------------------------------------------------ !BOC INTEGER :: I, J, hcoLogLUN - CHARACTER(LEN=1023) :: MSG, MSG1, MSG2 + CHARACTER(LEN=1023) :: MSG #if defined( ESMF_) INTEGER :: localPET, STATUS CHARACTER(4) :: localPETchar @@ -218,11 +218,8 @@ SUBROUTINE HCO_Error( ErrMsg, RC, THISLOC, LUN ) !====================================================================== ! Specify where to write - IF ( PRESENT(LUN) ) THEN - hcoLogLUN = LUN - ELSE - hcoLogLUN = 6 - ENDIF + hcoLogLUN = 6 + IF ( PRESENT( LUN ) ) hcoLogLUN = LUN ! Construct error message #if defined( ESMF_ ) @@ -230,18 +227,20 @@ SUBROUTINE HCO_Error( ErrMsg, RC, THISLOC, LUN ) CALL ESMF_VMGetCurrent(VM, RC=STATUS) CALL ESMF_VmGet( VM, localPET=localPET, __RC__ ) WRITE(localPETchar,'(I4.4)') localPET - MSG1 = 'HEMCO ERROR ['//TRIM(localPETchar)//']: '//TRIM(ErrMsg) + MSG = 'HEMCO ERROR [' // TRIM( localPETchar ) //']: '// TRIM( ErrMsg ) #else - MSG1 = 'HEMCO ERROR: '//TRIM(ErrMsg) + MSG = 'HEMCO ERROR: ' // TRIM( ErrMsg ) #endif - MSG2 = '' - IF ( PRESENT(THISLOC) ) THEN - MSG2 = NEW_LINE('a') // ' --> LOCATION: ' // TRIM( THISLOC ) - ENDIF - MSG = NEW_LINE('a') // TRIM(MSG1) // TRIM(MSG2) + MSG = NEW_LINE('a') // TRIM( MSG ) - ! Print error message - WRITE(hcoLogLUN,*) TRIM(MSG) + ! Print error message with word wrap + CALL HCO_WordWrapPrint( MSG, LineWidth=78, FileLun=hcoLogLUN ) + + ! Print location (if THISLOC argument is passed) with word wrap + IF ( PRESENT( THISLOC ) ) THEN + MSG = ' --> LOCATION: ' // TRIM( THISLOC ) + CALL HCO_WordWrapPrint( MSG, LineWidth=78, FileLun=hcoLogLUN ) + ENDIF ! Return w/ error RC = HCO_FAIL @@ -266,7 +265,7 @@ END SUBROUTINE HCO_Error ! SUBROUTINE HCO_Warning( ErrMsg, THISLOC, LUN ) ! -! !INPUT PARAMETERS" +! !INPUT PARAMETERS: ! CHARACTER(LEN=*), INTENT(IN ) :: ErrMsg CHARACTER(LEN=*), INTENT(IN ), OPTIONAL :: THISLOC @@ -286,20 +285,17 @@ SUBROUTINE HCO_Warning( ErrMsg, THISLOC, LUN ) !====================================================================== ! Specify where to write - IF ( PRESENT(LUN) ) THEN - hcoLogLUN = LUN - ELSE - hcoLogLUN = 6 - ENDIF + hcoLogLUN = 6 + IF ( PRESENT( LUN ) ) hcoLogLUN = LUN ! Print warning MSG = 'HEMCO WARNING: ' // TRIM( ErrMsg ) - WRITE( hcoLogLUN, '(a)' ) TRIM(MSG) + CALL HCO_WordWrapPrint( MSG, LineWidth=78, FileLun=hcoLogLUN ) ! Print location IF ( PRESENT(THISLOC) ) THEN MSG = '--> LOCATION: ' // TRIM(THISLOC) - WRITE( hcoLogLUN, '(a)' ) TRIM(MSG) + CALL HCO_WordWrapPrint( MSG, LineWidth=78, FileLun=hcoLogLUN ) ENDIF END SUBROUTINE HCO_Warning @@ -346,11 +342,11 @@ SUBROUTINE HCO_MSG( Msg, Sep1, Sep2, LUN ) hcoLogLUN = 6 IF ( PRESENT(LUN) ) hcoLogLUN = LUN - ! Write message + ! Write message IF ( PRESENT(SEP1) ) THEN WRITE( hcoLogLUN,'(a)' ) REPEAT( SEP1, 79 ) ENDIF - WRITE( hcoLogLUN,'(a)' ) TRIM( MSG ) + CALL HCO_WordWrapPrint( MSG, LineWidth=78, FileLun=hcoLogLUN ) IF ( PRESENT(SEP2) ) THEN WRITE( hcoLogLUN,'(a)' ) REPEAT( SEP2, 79 ) ENDIF @@ -844,4 +840,181 @@ SUBROUTINE HCO_LogFile_Close( Err ) END SUBROUTINE HCO_LogFile_Close !EOC +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: HCO_CountMatches +! +! !DESCRIPTION: Counts the number of characters in str1 that match +! a character in str2. This is a dependency of HCO_WordWrapPrint. +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE HCO_CountMatches( Str1, Str2, Imat, Locations ) +! +! !INPUT PARAMETERS: +! + CHARACTER(LEN=*), INTENT(IN) :: Str1 ! Text to scan + CHARACTER(LEN=*), INTENT(IN) :: Str2 ! Character to match +! +! !OUTPUT PARAMETERS: +! + INTEGER, INTENT(OUT) :: imat ! Number of matches + INTEGER, OPTIONAL :: Locations(255) ! Positions of matches +! +! !REVISION HISTORY: +! DATE: JAN. 6, 1995 +! AUTHOR: R.D. STEWART +! COMMENTS: Revised slightly (2-5-1996) so that trailing +! blanks in str1 are ignored. Revised again +! on 3-6-1996. +! See https://github.com/geoschem/geos-chem for complete history +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + ! Scalars + INTEGER :: L1, L2, i, j + LOGICAL :: again + + ! Arrays + INTEGER :: TmpLocations(255) + + ! Initialize + TmpLocations = 0 + L1 = MAX(1,LEN_TRIM(str1)) + L2 = LEN(str2) + imat = 0 + + DO i=1,L1 + again = .true. + j = 1 + DO WHILE (again) + IF (str2(j:j).EQ.str1(i:i)) THEN + imat = imat+1 + TmpLocations(imat) = i + again = .false. + ELSEIF (j.LT.L2) THEN + j=j+1 + ELSE + again = .false. + ENDIF + ENDDO + ENDDO + + ! Return positions where matches occured (OPTIONAL) + IF ( PRESENT( Locations ) ) Locations = TmpLocations + + END SUBROUTINE HCO_CountMatches +!EOC +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: HCO_WordWrapPrint +! +! !DESCRIPTION: Prints a text string wrapped to a specified line width. +! Useful for displaying error and warning messages. +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE HCO_WordWrapPrint( Text, LineWidth, Delimiter, FileLun ) +! +! !INPUT PARAMETERS: +! + CHARACTER(LEN=*), INTENT(IN) :: Text ! Text to print + INTEGER, INTENT(IN) :: LineWidth ! Width (characters) of lines + CHARACTER(LEN=1), OPTIONAL :: Delimiter ! Delimiter between words + INTEGER, OPTIONAL :: fileLun ! LUN of file to write +! +! !REMARKS: +! (1) This routine must be placed here in hco_error_mod.F90 and not +! in hco_chartools_mod.F90 in order to avoid a circular dependency. +! (2) The default DELIMITER is the space (" ") character. +! +! !REVISION HISTORY: +! 20 Dec 2015 - R. Yantosca - Initial version +! See https://github.com/geoschem/geos-chem for complete history +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + ! Scalars + INTEGER :: C, S, B, Matches, Length, LUN + + ! Arrays + INTEGER :: BreakPts(100) + INTEGER :: SpaceLoc(500) + + ! Strings + CHARACTER(LEN=1) :: Delim + + !======================================================================= + ! WordWrapPrint begins here! + !======================================================================= + + ! SpaceLoc is the array of where delimiters (usually the " " + ! character) occur in the text, and S is its index. + S = 1 + SpaceLoc = 0 + + ! BreakPts is the array of where line breaks occur + ! and B is its index. + BreakPts = 0 + B = 1 + BreakPts(B) = 1 + + ! Delimiter for separating words (will be the space character by default) + Delim = ' ' + IF ( PRESENT( Delimiter ) ) Delim = Delimiter + + ! If writing to file, get the logical unit numbef from the fileLun arg + LUN = 6 + IF ( PRESENT( FileLun ) ) LUN = fileLun + + ! Find the Location of spaces in the text + CALL HCO_CountMatches( Text, ' ', Matches, SpaceLoc ) + + ! Loop through the number of matches + DO + + ! Move to the next delimiter location + S = S + 1 + + ! Compute the length of the line + Length = SpaceLoc(S) - BreakPts(B) + + ! If the length of this segment is greater than the requested + ! line length, store the position of this line break + IF ( Length > LineWidth ) THEN + B = B + 1 + BreakPts(B) = SpaceLoc(S-1) + 1 + ENDIF + + ! If we have exceeded the number of delimiters in the text, then set + ! the last breakpoint at the end of the text and exit the loop. + IF ( S > Matches ) THEN + B = B + 1 + BreakPts(B) = LEN_TRIM( Text ) + 1 + EXIT + ENDIF + + ENDDO + + ! Print each line + DO C = 1, B-1 + WRITE( LUN, '(a)' ) Text( BreakPts(C):BreakPts(C+1)-1 ) + ENDDO + + END SUBROUTINE HCO_WordWrapPrint +!EOC END MODULE HCO_Error_Mod diff --git a/src/Core/hco_interp_mod.F90 b/src/Core/hco_interp_mod.F90 index 5cf71221..812a77d2 100644 --- a/src/Core/hco_interp_mod.F90 +++ b/src/Core/hco_interp_mod.F90 @@ -590,7 +590,7 @@ SUBROUTINE ModelLev_Interpolate( HcoState, REGR_4D, Lct, RC ) INTEGER :: L, T, NL, I INTEGER :: OS LOGICAL :: verb, infl, clps - LOGICAL :: DONE + LOGICAL :: DONE, do_sum CHARACTER(LEN=255) :: MSG, LOC !================================================================= @@ -683,6 +683,12 @@ SUBROUTINE ModelLev_Interpolate( HcoState, REGR_4D, Lct, RC ) !=================================================================== IF ( .NOT. DONE ) THEN + !---------------------------------------------------------------- + ! Determine if the variable (e.g. Met_DELPDRY) needs + ! to be summed in the vertical instead of averaged. + !---------------------------------------------------------------- + do_sum = ( INDEX( TRIM( Lct%Dct%cName ), "DELPDRY" ) > 0 ) + !---------------------------------------------------------------- ! Native to reduced GEOS-5 levels !---------------------------------------------------------------- @@ -725,18 +731,18 @@ SUBROUTINE ModelLev_Interpolate( HcoState, REGR_4D, Lct, RC ) ! If remapping model grid layers, collapse layers IF ( nlev == 72 ) THEN ! Collapse two levels (e.g. levels 37-38 into level 37): - CALL COLLAPSE( Lct, REGR_4D, 37, 37, 2, T, 5, RC ) - CALL COLLAPSE( Lct, REGR_4D, 38, 39, 2, T, 5, RC ) - CALL COLLAPSE( Lct, REGR_4D, 39, 41, 2, T, 5, RC ) - CALL COLLAPSE( Lct, REGR_4D, 40, 43, 2, T, 5, RC ) + CALL COLLAPSE( Lct, REGR_4D, 37, 37, 2, T, 5, do_sum, RC ) + CALL COLLAPSE( Lct, REGR_4D, 38, 39, 2, T, 5, do_sum, RC ) + CALL COLLAPSE( Lct, REGR_4D, 39, 41, 2, T, 5, do_sum, RC ) + CALL COLLAPSE( Lct, REGR_4D, 40, 43, 2, T, 5, do_sum, RC ) ! Collapse four levels: - CALL COLLAPSE( Lct, REGR_4D, 41, 45, 4, T, 5, RC ) - CALL COLLAPSE( Lct, REGR_4D, 42, 49, 4, T, 5, RC ) - CALL COLLAPSE( Lct, REGR_4D, 43, 53, 4, T, 5, RC ) - CALL COLLAPSE( Lct, REGR_4D, 44, 57, 4, T, 5, RC ) - CALL COLLAPSE( Lct, REGR_4D, 45, 61, 4, T, 5, RC ) - CALL COLLAPSE( Lct, REGR_4D, 46, 65, 4, T, 5, RC ) - CALL COLLAPSE( Lct, REGR_4D, 47, 69, 4, T, 5, RC ) + CALL COLLAPSE( Lct, REGR_4D, 41, 45, 4, T, 5, do_sum, RC ) + CALL COLLAPSE( Lct, REGR_4D, 42, 49, 4, T, 5, do_sum, RC ) + CALL COLLAPSE( Lct, REGR_4D, 43, 53, 4, T, 5, do_sum, RC ) + CALL COLLAPSE( Lct, REGR_4D, 44, 57, 4, T, 5, do_sum, RC ) + CALL COLLAPSE( Lct, REGR_4D, 45, 61, 4, T, 5, do_sum, RC ) + CALL COLLAPSE( Lct, REGR_4D, 46, 65, 4, T, 5, do_sum, RC ) + CALL COLLAPSE( Lct, REGR_4D, 47, 69, 4, T, 5, do_sum, RC ) ! If remapping model grid edges, sample at edges ELSEIF ( nlev == 73 ) THEN Lct%Dct%Dta%V3(T)%Val(:,:,38) = REGR_4D(:,:,39,T) @@ -815,21 +821,21 @@ SUBROUTINE ModelLev_Interpolate( HcoState, REGR_4D, Lct, RC ) ! If remapping model grid layers, collapse layers IF ( nlev == 102 ) THEN ! Collapse two levels (e.g. levels 61-62 into level 61): - CALL COLLAPSE( Lct, REGR_4D, 61, 61, 2, T, 22, RC ) - CALL COLLAPSE( Lct, REGR_4D, 62, 63, 2, T, 22, RC ) - CALL COLLAPSE( Lct, REGR_4D, 63, 65, 2, T, 22, RC ) - CALL COLLAPSE( Lct, REGR_4D, 64, 67, 2, T, 22, RC ) - CALL COLLAPSE( Lct, REGR_4D, 65, 69, 2, T, 22, RC ) - CALL COLLAPSE( Lct, REGR_4D, 66, 71, 2, T, 22, RC ) - CALL COLLAPSE( Lct, REGR_4D, 67, 73, 2, T, 22, RC ) + CALL COLLAPSE( Lct, REGR_4D, 61, 61, 2, T, 22, do_sum, RC ) + CALL COLLAPSE( Lct, REGR_4D, 62, 63, 2, T, 22, do_sum, RC ) + CALL COLLAPSE( Lct, REGR_4D, 63, 65, 2, T, 22, do_sum, RC ) + CALL COLLAPSE( Lct, REGR_4D, 64, 67, 2, T, 22, do_sum, RC ) + CALL COLLAPSE( Lct, REGR_4D, 65, 69, 2, T, 22, do_sum, RC ) + CALL COLLAPSE( Lct, REGR_4D, 66, 71, 2, T, 22, do_sum, RC ) + CALL COLLAPSE( Lct, REGR_4D, 67, 73, 2, T, 22, do_sum, RC ) ! Collapse four levels: - CALL COLLAPSE( Lct, REGR_4D, 68, 75, 4, T, 22, RC ) - CALL COLLAPSE( Lct, REGR_4D, 69, 79, 4, T, 22, RC ) - CALL COLLAPSE( Lct, REGR_4D, 70, 83, 4, T, 22, RC ) - CALL COLLAPSE( Lct, REGR_4D, 71, 87, 4, T, 22, RC ) - CALL COLLAPSE( Lct, REGR_4D, 72, 91, 4, T, 22, RC ) - CALL COLLAPSE( Lct, REGR_4D, 73, 95, 4, T, 22, RC ) - CALL COLLAPSE( Lct, REGR_4D, 74, 99, 4, T, 22, RC ) + CALL COLLAPSE( Lct, REGR_4D, 68, 75, 4, T, 22, do_sum, RC ) + CALL COLLAPSE( Lct, REGR_4D, 69, 79, 4, T, 22, do_sum, RC ) + CALL COLLAPSE( Lct, REGR_4D, 70, 83, 4, T, 22, do_sum, RC ) + CALL COLLAPSE( Lct, REGR_4D, 71, 87, 4, T, 22, do_sum, RC ) + CALL COLLAPSE( Lct, REGR_4D, 72, 91, 4, T, 22, do_sum, RC ) + CALL COLLAPSE( Lct, REGR_4D, 73, 95, 4, T, 22, do_sum, RC ) + CALL COLLAPSE( Lct, REGR_4D, 74, 99, 4, T, 22, do_sum, RC ) ! If remapping model grid edges, sample at the edges ELSE Lct%Dct%Dta%V3(T)%Val(:,:,62) = REGR_4D(:,:,63,T) @@ -1020,21 +1026,25 @@ END SUBROUTINE ModelLev_Interpolate !\\ ! !INTERFACE: ! - SUBROUTINE COLLAPSE ( Lct, REGR_4D, OutLev, InLev1, NLEV, T, MET, RC ) + SUBROUTINE COLLAPSE( Lct, REGR_4D, OutLev, & + InLev1, NLEV, T, & + MET, do_sum, RC ) ! ! !INPUT PARAMETERS: ! - REAL(sp), POINTER :: REGR_4D(:,:,:,:) ! 4D input data - INTEGER, INTENT(IN) :: OutLev - INTEGER, INTENT(IN) :: InLev1 - INTEGER, INTENT(IN) :: NLEV - INTEGER, INTENT(IN) :: T - INTEGER, INTENT(IN) :: MET ! 22=GISS E2.2, else GEOS-5 + REAL(sp), POINTER :: REGR_4D(:,:,:,:) ! 4D input data + INTEGER, INTENT(IN) :: OutLev ! Output level + INTEGER, INTENT(IN) :: InLev1 ! 1st input level + INTEGER, INTENT(IN) :: NLEV ! # of levels + INTEGER, INTENT(IN) :: T ! Time index + LOGICAL, INTENT(IN) :: do_sum ! Sum instead of avg? + INTEGER, INTENT(IN) :: MET ! 22=GISS E2.2, + ! otherwise GMAO ! ! !INPUT/OUTPUT PARAMETERS: ! - TYPE(ListCont), POINTER :: Lct ! HEMCO list container - INTEGER, INTENT(INOUT) :: RC ! Success or failure? + TYPE(ListCont), POINTER :: Lct ! HEMCO list container + INTEGER, INTENT(INOUT) :: RC ! Success or failure? ! ! !REVISION HISTORY: ! 30 Dec 2014 - C. Keller - Initial version @@ -1080,12 +1090,17 @@ SUBROUTINE COLLAPSE ( Lct, REGR_4D, OutLev, InLev1, NLEV, T, MET, RC ) ! Thickness of output level THICK = EDG(1) - EDG(NLEV+1) - ! Get level weights + ! Get level weights. If DO_SUM = T, then we will sum + ! the variable in the vertical instead of averaging. ALLOCATE(WGT(NLEV)) - WGT = 0.0 - DO I = 1, NLEV - WGT(I) = ( EDG(I) - EDG(I+1) ) / THICK - ENDDO + IF ( do_sum ) THEN + WGT = 1.0 + ELSE + WGT = 0.0 + DO I = 1, NLEV + WGT(I) = ( EDG(I) - EDG(I+1) ) / THICK + ENDDO + ENDIF ! Pass levels to output data, one after each other Lct%Dct%Dta%V3(T)%Val(:,:,OutLev) = REGR_4D(:,:,InLev1,T) * WGT(1) diff --git a/src/Core/hco_state_mod.F90 b/src/Core/hco_state_mod.F90 index 66f2e280..8a085be3 100644 --- a/src/Core/hco_state_mod.F90 +++ b/src/Core/hco_state_mod.F90 @@ -369,8 +369,8 @@ SUBROUTINE HcoState_Init( HcoState, HcoConfig, nSpecies, RC ) CALL HCO_ArrInit( HcoState%Buffer3D, 0, 0, 0, RC ) IF ( RC /= 0 ) RETURN - ! Dust bins (set default to 4) - HcoState%nDust = 4 + ! Dust bins (set default to 7) + HcoState%nDust = 7 ! Turn off marine POA by default HcoState%MarinePOA = .FALSE. diff --git a/src/Core/hco_types_mod.F90 b/src/Core/hco_types_mod.F90 index e0f6370c..ac1c86b8 100644 --- a/src/Core/hco_types_mod.F90 +++ b/src/Core/hco_types_mod.F90 @@ -317,6 +317,7 @@ MODULE HCO_TYPES_MOD INTEGER :: Cat ! Category INTEGER :: Hier ! Hierarchy INTEGER :: ScalID ! Scale factor ID + REAL(sp) :: srcGMaskID ! global source mask ID INTEGER :: Oper ! Operator INTEGER :: levScalID1 ! ID of vertical level field INTEGER :: levScalID2 ! ID of vertical level field diff --git a/src/Core/hco_unit_mod.F90 b/src/Core/hco_unit_mod.F90 index c3c58f0a..ff8dcdef 100644 --- a/src/Core/hco_unit_mod.F90 +++ b/src/Core/hco_unit_mod.F90 @@ -60,7 +60,7 @@ MODULE HCO_Unit_Mod ! add more units if you don't want HEMCO to attempt to convert data ! in these units. ! All characters in this list should be lower case! - INTEGER, PARAMETER :: NUL = 38 + INTEGER, PARAMETER :: NUL = 40 CHARACTER(LEN=15), PARAMETER :: UL(NUL) = (/ '1 ', & 'count ', & 'unitless ', & @@ -76,6 +76,8 @@ MODULE HCO_Unit_Mod 'm2/m2 ', & 'm2m-2 ', & 'kg/kg ', & + 'kg-soil/m3 ', & + 'kg-h2o/m2 ', & 'kgkg-1 ', & 'mg/m3 ', & 'mg/m2/d ', & diff --git a/src/Core/hcoio_read_std_mod.F90 b/src/Core/hcoio_read_std_mod.F90 index 47bda575..a941e118 100644 --- a/src/Core/hcoio_read_std_mod.F90 +++ b/src/Core/hcoio_read_std_mod.F90 @@ -224,8 +224,9 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) ! Enter CALL HCO_ENTER( HcoState%Config%Err, LOC, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 0', RC, THISLOC=LOC ) - RETURN + MSG = 'Error encountered in routine "HCO_Enter"!' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF ! Initialize pointers @@ -301,10 +302,9 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) ! ---------------------------------------------------------------- CALL SrcFile_Parse( HcoState, Lct, srcFile, FOUND, RC ) IF ( RC /= HCO_SUCCESS ) THEN - MSG = 'Error encountered in routine "SrcFile_Parse", located ' // & - 'module src/Core/hcoio_read_std_mod.F90!' - CALL HCO_ERROR( MSG, RC ) - RETURN + MSG = 'Error encountered in routine "SrcFile_Parse" (#1)!' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF ! Handle found or not in the standard way if HEMCO is in regular run mode. @@ -320,13 +320,10 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) IF ( ( Lct%Dct%Dta%CycleFlag == HCO_CFLAG_RANGE ) .OR. & ( Lct%Dct%Dta%CycleFlag == HCO_CFLAG_EXACT ) ) THEN - ! If MustFind flag is enabled, return with error if field is not - ! found + ! If MustFind flag is enabled, return with error if field isn't + ! found. Generate explicit error messages to reduce confusion. IF ( Lct%Dct%Dta%MustFind ) THEN - MSG = 'Cannot find file for current simulation time: ' // & - TRIM(srcFile) // ' - Cannot get field ' // & - TRIM(Lct%Dct%cName) // '. Please check file name ' // & - 'and time (incl. time range flag) in the config. file' + MSG = IO_ErrMsg( TRIM(Lct%Dct%cName), TRIM(srcFile) ) CALL HCO_ERROR( MSG, RC ) RETURN @@ -342,10 +339,7 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) ENDIF ELSE - MSG = 'Cannot find file for current simulation time: ' // & - TRIM(srcFile) // ' - Cannot get field ' // & - TRIM(Lct%Dct%cName) // '. Please check file name ' // & - 'and time (incl. time range flag) in the config. file' + MSG = IO_ErrMsg( TRIM(Lct%Dct%cName), TRIM(srcFile) ) CALL HCO_ERROR( MSG, RC ) RETURN ENDIF @@ -373,10 +367,7 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) ! If MustFind flag is enabled, return with error if field is not ! found IF ( Lct%Dct%Dta%MustFind ) THEN - MSG = 'Cannot find file for current simulation time: ' // & - TRIM(srcFile) // ' - Cannot get field ' // & - TRIM(Lct%Dct%cName) // '. Please check file name ' // & - 'and time (incl. time range flag) in the config. file' + MSG = IO_ErrMsg( TRIM(Lct%Dct%cName), TRIM(srcFile) ) IF ( HcoState%Config%doVerbose ) CALL HCO_WARNING( MSG ) ! Write a msg to stdout (NOT FOUND) @@ -400,10 +391,7 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) ! Not range or exact ELSE - MSG = 'Cannot find file for current simulation time: ' // & - TRIM(srcFile) // ' - Cannot get field ' // & - TRIM(Lct%Dct%cName) // '. Please check file name ' // & - 'and time (incl. time range flag) in the config. file' + MSG = IO_ErrMsg( TRIM(Lct%Dct%cName), TRIM(srcFile) ) IF ( HcoState%Config%doVerbose ) CALL HCO_WARNING( MSG ) ! Write a msg to stdout (NOT FOUND) @@ -495,8 +483,9 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) wgt1, wgt2, oYMDhm1, & YMDhma, YMDhm1, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 1', RC, THISLOC=LOC ) - RETURN + MSG = 'Error encountered in routine "Get_TimeIdx" (#1)!' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF !----------------------------------------------------------------- @@ -518,10 +507,7 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) ELSEIF ( ( Lct%Dct%Dta%CycleFlag == HCO_CFLAG_RANGE ) .OR. & ( Lct%Dct%Dta%CycleFlag == HCO_CFLAG_EXACT ) ) THEN IF ( Lct%Dct%Dta%MustFind ) THEN - MSG = 'Cannot find field with valid time stamp in ' // & - TRIM(srcFile) // ' - Cannot get field ' // & - TRIM(Lct%Dct%cName) // '. Please check file name ' // & - 'and time (incl. time range flag) in the config. file' + MSG = IO_ErrMsg( TRIM(Lct%Dct%cName), TRIM(srcFile) ) CALL HCO_ERROR( MSG, RC ) DoReturn = .TRUE. ELSE @@ -573,7 +559,8 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) ! Extract longitude midpoints CALL NC_READ_VAR ( ncLun, 'lon', nlon, thisUnit, LonMid, NCRC ) IF ( NCRC /= 0 ) THEN - CALL HCO_ERROR( 'NC_READ_VAR: lon', RC ) + MSG = 'Error encountered in routine "NC_READ_VAR" (lon)!' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) RETURN ENDIF @@ -581,7 +568,8 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) CALL NC_READ_VAR ( ncLun, 'longitude', nlon, thisUnit, LonMid, NCRC ) ENDIF IF ( NCRC /= 0 ) THEN - CALL HCO_ERROR( 'NC_READ_VAR: longitude', RC ) + MSG = 'Error encountered in routine "NC_READ_VAR" (longitude)!' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) RETURN ENDIF @@ -589,7 +577,8 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) CALL NC_READ_VAR ( ncLun, 'Longitude', nlon, thisUnit, LonMid, NCRC ) ENDIF IF ( NCRC /= 0 ) THEN - CALL HCO_ERROR( 'NC_READ_LON: Longitude', RC ) + MSG = 'Error encountered in routine "NC_READ_VAR" (Longitude)!' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) RETURN ENDIF @@ -612,14 +601,16 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) ! Make sure longitude is steadily increasing. CALL HCO_ValidateLon( HcoState, nlon, LonMid, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 2', RC, THISLOC=LOC ) - RETURN + MSG = 'Error encountered in routine "HCO_ValidateLon" (#2)!' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF ! Extract latitude midpoints CALL NC_READ_VAR ( ncLun, 'lat', nlat, thisUnit, LatMid, NCRC ) IF ( NCRC /= 0 ) THEN - CALL HCO_ERROR( 'NC_READ_LON: lat', RC ) + MSG = 'Error encountered in routine "NC_READ_VAR" (lat)!' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) RETURN ENDIF @@ -627,7 +618,8 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) CALL NC_READ_VAR ( ncLun, 'latitude', nlat, thisUnit, LatMid, NCRC ) ENDIF IF ( NCRC /= 0 ) THEN - CALL HCO_ERROR( 'NC_READ_LON: latitude', RC ) + MSG = 'Error encountered in routine "NC_READ_VAR" (latitude)!' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) RETURN ENDIF @@ -635,7 +627,8 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) CALL NC_READ_VAR ( ncLun, 'Latitude', nlat, thisUnit, LatMid, NCRC ) ENDIF IF ( NCRC /= 0 ) THEN - CALL HCO_ERROR( 'NC_READ_LON: Latitude', RC ) + MSG = 'Error encountered in routine "NC_READ_VAR" (Latitude)!' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) RETURN ENDIF @@ -662,14 +655,16 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) LevName = 'lev' CALL NC_READ_VAR ( ncLun, LevName, nlev, LevUnit, LevMid, NCRC ) IF ( NCRC /= 0 ) THEN - CALL HCO_ERROR( 'NC_READ_VAR: lev', RC ) + MSG = 'Error encountered in routine "NC_READ_VAR" (lev)!' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) RETURN ENDIF IF ( nlev == 0 ) THEN LevName = 'height' CALL NC_READ_VAR ( ncLun, LevName, nlev, LevUnit, LevMid, NCRC ) IF ( NCRC /= 0 ) THEN - CALL HCO_ERROR( 'NC_READ_VAR: height', RC ) + MSG = 'Error encountered in routine "NC_READ_VAR" (height)!' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) RETURN ENDIF ENDIF @@ -677,7 +672,8 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) LevName = 'level' CALL NC_READ_VAR ( ncLun, LevName, nlev, LevUnit, LevMid, NCRC ) IF ( NCRC /= 0 ) THEN - CALL HCO_ERROR( 'NC_READ_VAR: level', RC ) + MSG = 'Error encountered in routine "NC_READ_VAR" (level)!' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) RETURN ENDIF ENDIF @@ -724,8 +720,9 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) CALL ModelLev_Check( HcoState, nlev, IsModelLevel, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 3', RC, THISLOC=LOC ) - RETURN + MSG = 'Error encountered in routine "ModelLev_Check"!' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF #endif @@ -788,8 +785,9 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) ! ---------------------------------------------------------------- CALL GetArbDimIndex( HcoState, ncLun, Lct, ArbIdx, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 4', RC, THISLOC=LOC ) - RETURN + MSG = 'Error encountered in routine "GetArbDimIndex"!' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF ! ---------------------------------------------------------------- @@ -821,7 +819,8 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) RC = NCRC ) IF ( NCRC /= 0 ) THEN - CALL HCO_ERROR( 'NC_READ_ARRAY', RC ) + MSG = 'Error encountered in routine "NC_Read_Arr" (#1)!' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) RETURN ENDIF @@ -857,8 +856,9 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) CALL SrcFile_Parse ( HcoState, Lct, srcFile2, & FOUND, RC, Direction = Direction ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 5', RC, THISLOC=LOC ) - RETURN + MSG = 'Error encountered in routine "SrcFile_Parse" (#2)!' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF ENDIF @@ -876,8 +876,9 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) wgt1, wgt2, oYMDhm2, & YMDhmb, YMDhm1, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 6', RC, THISLOC=LOC ) - RETURN + MSG = 'Error encountered in routine "Get_TimeIdx" (#2)!' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF ! Always read first time slice @@ -905,7 +906,7 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) ArbIdx = ArbIdx, & RC = NCRC ) IF ( NCRC /= 0 ) THEN - CALL HCO_ERROR( 'NC_READ_ARRAY (2)', RC ) + MSG = 'Error encountered in routine "NC_Read_Arr" (#2)!' RETURN ENDIF @@ -968,8 +969,9 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) CALL HcoClock_Get( HcoState%Clock, cYYYY=cYr, cMM=cMt, cDD=cDy, & cH=cHr, RC=RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 7', RC, THISLOC=LOC ) - RETURN + MSG = 'Error encountered in routine "HcoClock_Get" (#1)!' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF ! Determine year range to be read: @@ -1005,8 +1007,9 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) CALL SrcFile_Parse ( HcoState, Lct, srcFile2, & FOUND, RC, Year=iYear ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 8', RC, THISLOC=LOC ) - RETURN + MSG = 'Error encountered in routine "SrcFile_Parse" (#3)!' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF ! If found, read data. Assume that all meta-data is the same. @@ -1027,8 +1030,9 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) YMDhmb, YMDhm1, RC, & Year=iYear ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 9', RC, THISLOC=LOC ) - RETURN + MSG = 'Error encountered in routine "Get_TimeIdx" (#3)' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF ! Do not perform weights @@ -1187,15 +1191,17 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) IF ( ncYr == 0 ) THEN CALL HcoClock_Get( HcoState%Clock, cYYYY = ncYr, RC=RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 10', RC, THISLOC=LOC ) - RETURN + MSG = 'Error encountered in routine "HcoClock_Get" (#2)!' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF ENDIF IF ( ncMt == 0 ) THEN CALL HcoClock_Get( HcoState%Clock, cMM = ncMt, RC=RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 11', RC, THISLOC=LOC ) - RETURN + MSG = 'Error encountered in routine "HcoClock_Get" (#3)!' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF ENDIF @@ -1292,8 +1298,9 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) CALL NORMALIZE_AREA( HcoState, ncArr, nlon, & LatEdge, srcFile, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 12', RC, THISLOC=LOC ) - RETURN + MSG = 'Error encountered in routine "NORMALIZE_AREA"!' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF ! All other combinations are invalid @@ -1319,8 +1326,9 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) ENDIF CALL HCO_ValidateLon( HcoState, nlonEdge, LonEdge, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 13', RC, THISLOC=LOC ) - RETURN + MSG = 'Error encountered in routine "HCO_ValidateLon" (#2)!' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF ! Get latitude edges (only if they have not been read yet @@ -1410,13 +1418,12 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) ! of the GEOS-Chem levels (sigma = p/ps on INTERFACE) ! ! There are caveats with this. This is essentially a copy of the - ! hardcoded hPa lists from - ! http://wiki.seas.harvard.edu/geos-chem/index.php/GEOS-Chem_vertical_grids - ! hard-coded by hand, and we only assume that the data is either - ! 47-levels or 72-levels. + ! hardcoded hPa lists from the "GEOS-Chem vertical grids" + ! chapter of geos-chem.readthedocs.io hard-coded by hand, and we + ! only assume that the data is either 47-levels or 72-levels. ! - ! Parse the 72 list using regex like so: ^ ?\d{1,2} then remove the lines - ! Then you have the 73 edges. + ! Parse the 72 list using regex like so: ^ ?\d{1,2} + ! then remove the lines. Then you have the 73 edges with: ! ! psfc = PEDGE(0) = 1013.250 hPa ! @@ -1477,8 +1484,9 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) ! Interpolate onto edges CALL SigmaMidToEdges ( HcoState, SigLev, SigEdge, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 14', RC, THISLOC=LOC ) - RETURN + MSG = 'Error encountered in routine "SigmaMidToEdges"!' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF ! Sigma levels are not needed anymore @@ -1509,8 +1517,8 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) LonEdge, LatEdge, SigEdge, & Lct, IsModelLevel, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 15', RC, THISLOC=LOC ) - RETURN + MSG = 'Error encountered in routine "HCO_MESSY_REGRID"!' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) ENDIF ! Cleanup @@ -1527,8 +1535,9 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) CALL REGRID_MAPA2A ( HcoState, NcArr, LonEdge, LatEdge, Lct, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 16', RC, THISLOC=LOC ) - RETURN + MSG = 'Error encountered in routine "REGRID_MAPA2A"!' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF ENDIF @@ -1542,8 +1551,9 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) CALL Diagn_Update ( HcoState, cName=TRIM(Lct%Dct%cName), & Array3D=Lct%Dct%Dta%V3(1)%Val, COL=-1, RC=RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 17', RC, THISLOC=LOC ) - RETURN + MSG = 'Error encountered in routine "DIAGN_UPDATE" (#1)!' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF ENDIF ELSEIF ( Lct%Dct%Dta%SpaceDim == 2 .AND. ASSOCIATED(Lct%Dct%Dta%V2) ) THEN @@ -1551,8 +1561,9 @@ SUBROUTINE HCOIO_Read( HcoState, Lct, RC ) CALL Diagn_Update ( HcoState, cName=TRIM(Lct%Dct%cName), & Array2D=Lct%Dct%Dta%V2(1)%Val, COL=-1, RC=RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 18', RC, THISLOC=LOC ) - RETURN + MSG = 'Error encountered in routine "DIAGN_UPDATE" (#2)!' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF ENDIF ENDIF @@ -1622,5 +1633,67 @@ SUBROUTINE HCOIO_CloseAll( HcoState, RC ) END SUBROUTINE HCOIO_CloseAll !EOC +!------------------------------------------------------------------------------ +! GEOS-Chem Global Chemical Transport Model ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: IO_ErrMsg +! +! !DESCRIPTION: Returns an error message string when HEMCO cannot find +! a field for the current simulation time. +!\\ +!\\ +! !INTERFACE: +! + FUNCTION IO_ErrMsg( fldName, srcFile ) RESULT( errMsg ) +! +! !INPUT PARAMETERS: +! + CHARACTER(LEN=*), INTENT(IN) :: fldName + CHARACTER(LEN=*), INTENT(IN) :: srcFile +! +! !RETURN VALUE: +! + CHARACTER(LEN=1023) :: errMsg +! +! !REVISION HISTORY: +! 20 Oct 2015 - R. Yantosca - Initial version +! See the subsequent Git history with the gitk browser! +!EOP +!------------------------------------------------------------------------------ +!BOC + IF ( fldName(1:4) == "SPC_" .and. INDEX( srcFile, "Restart" ) > 0 ) THEN + + !--------------------------------------------------------------------- + ! Case 1: GEOS-Chem Classic restart file + !--------------------------------------------------------------------- + errMsg = "Cannot find the " // fldName // " field in the " // & + "GEOS-Chem restart file " // srcFile // "! This " // & + "indicates that either (1) the timestamp in the restart " // & + "file does not match the simulation start date, or (2) " // & + "that the restart file does not contain initial " // & + "conditions for all species in the simulation. You may " // & + "allow your simulation to proceed by changing the time " // & + "cycle flag for the 'SPC_' entry in your " // & + "'HEMCO_Config.rc' file from `EFYO` to either 'CYS' or " // & + "'EY'. Please refer to hemco.readthedocs.io for more " // & + "information about 'HEMCO_Config.rc' settings." + ELSE + + !--------------------------------------------------------------------- + ! Case 2: Other files + !--------------------------------------------------------------------- + errMsg = "Cannot find the "// fldName // " field in file " // & + srcFile // "! Please doublecheck the name, time, and " // & + "time cycle flag settings for field " // fldName // & + " in your 'HEMCO_Config.rc' file. Please refer to " // & + "hemco.readthedocs.io for more information about " // & + "'HEMCO_Config.rc' settings." + + ENDIF + + END FUNCTION IO_ErrMsg +!EOC END MODULE HCOIO_Read_Mod #endif diff --git a/src/Extensions/CMakeLists.txt b/src/Extensions/CMakeLists.txt index 4fb4c754..565a7c57 100755 --- a/src/Extensions/CMakeLists.txt +++ b/src/Extensions/CMakeLists.txt @@ -1,11 +1,10 @@ # Extensions/CMakeLists.txt add_library(HCOX STATIC EXCLUDE_FROM_ALL - drydep_toolbox_mod.F90 - hcox_custom_mod.F90 + drydep_toolbox_mod.F90 + hcox_custom_mod.F90 hcox_driver_mod.F90 - hcox_dustdead_mod.F - hcox_dustginoux_mod.F90 + hcox_dustl23m_mod.F90 hcox_finn_include.FINNv16 hcox_finn_mod.F90 hcox_finn_mod.FINNv16 @@ -20,7 +19,6 @@ add_library(HCOX STATIC EXCLUDE_FROM_ALL hcox_seasalt_mod.F90 hcox_soilnox_mod.F90 hcox_state_mod.F90 - hcox_template_mod.F90x $<$:hcox_tomas_jeagle_mod.F90 hcox_tomas_dustdead_mod.F> hcox_tools_mod.F90 hcox_volcano_mod.F90 diff --git a/src/Extensions/hcox_driver_mod.F90 b/src/Extensions/hcox_driver_mod.F90 index 7f1b9c7a..9479f6c7 100644 --- a/src/Extensions/hcox_driver_mod.F90 +++ b/src/Extensions/hcox_driver_mod.F90 @@ -100,8 +100,7 @@ SUBROUTINE HCOX_Init( HcoState, ExtState, RC ) USE HCOX_ParaNOx_Mod, ONLY : HCOX_ParaNOx_Init USE HCOX_LightNox_Mod, ONLY : HCOX_LightNox_Init USE HCOX_SoilNox_Mod, ONLY : HCOX_SoilNox_Init - USE HCOX_DustDead_Mod, ONLY : HCOX_DustDead_Init - USE HCOX_DustGinoux_Mod, ONLY : HCOX_DustGinoux_Init + USE HCOX_DustL23M_Mod, ONLY : HCOX_DustL23M_Init USE HCOX_SeaSalt_Mod, ONLY : HCOX_SeaSalt_Init USE HCOX_GFED_Mod, ONLY : HCOX_GFED_Init USE HCOX_MEGAN_Mod, ONLY : HCOX_MEGAN_Init @@ -234,7 +233,7 @@ SUBROUTINE HCOX_Init( HcoState, ExtState, RC ) ENDIF !-------------------------------------------------------------------- - ! SoilNox + ! SoilNOx !-------------------------------------------------------------------- CALL HCOX_SoilNox_Init( HcoState, 'SoilNOx', ExtState, RC ) IF ( RC /= HCO_SUCCESS ) THEN @@ -244,30 +243,11 @@ SUBROUTINE HCOX_Init( HcoState, ExtState, RC ) ENDIF !-------------------------------------------------------------------- - ! Dust emissions (DEAD model) - !-------------------------------------------------------------------- - CALL HCOX_DustDead_Init( HcoState, 'DustDead', ExtState, RC ) - IF ( RC /= HCO_SUCCESS ) THEN - ErrMsg = 'Error encountered in "HCOX_DustDead_Init"!' - CALL HCO_ERROR( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF -#if defined( TOMAS ) - CALL HCOX_TOMAS_DustDead_Init( HcoState, 'TOMAS_DustDead', & - ExtState, RC ) - IF ( RC /= HCO_SUCCESS ) THEN - ErrMsg = 'Error encountered in "HCOX_TOMAS_DustDead_Init"!' - CALL HCO_ERROR( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF -#endif - - !-------------------------------------------------------------------- - ! Dust Ginoux emissions + ! Dust emissions (DustL23M model) !-------------------------------------------------------------------- - CALL HCOX_DustGinoux_Init( HcoState, 'DustGinoux', ExtState, RC ) + CALL HCOX_DustL23M_Init( HcoState, 'DustL23M', ExtState, RC ) IF ( RC /= HCO_SUCCESS ) THEN - ErrMsg = 'Error encountered in "HCOX_DustGinoux_Init"!' + ErrMsg = 'Error encountered in "HCOX_DustL23M_Init"!' CALL HCO_ERROR( ErrMsg, RC, ThisLoc ) RETURN ENDIF @@ -343,6 +323,17 @@ SUBROUTINE HCOX_Init( HcoState, ExtState, RC ) ENDIF #if defined( TOMAS ) + !-------------------------------------------------------------------- + ! TOMAS sectional dust emissions (based on the DEAD model) + !-------------------------------------------------------------------- + CALL HCOX_TOMAS_DustDead_Init( HcoState, 'TOMAS_DustDead', & + ExtState, RC ) + IF ( RC /= HCO_SUCCESS ) THEN + ErrMsg = 'Error encountered in "HCOX_TOMAS_DustDead_Init"!' + CALL HCO_ERROR( ErrMsg, RC, ThisLoc ) + RETURN + ENDIF + !-------------------------------------------------------------------- ! TOMAS sectional sea salt aerosol emissions !-------------------------------------------------------------------- @@ -363,9 +354,11 @@ SUBROUTINE HCOX_Init( HcoState, ExtState, RC ) ! Sanity checks !======================================================================= - ! Cannot have both DustDead and DustGinoux turned on! - IF ( ExtState%DustDead > 0 .AND. ExtState%DustGinoux > 0 ) THEN - ErrMsg = 'Ginoux and DEAD dust emissions switched on!' + ! Can only have one dust emission scheme turned on! + IF ( (MERGE(1, 0, ExtState%DustDead > 0) + & + MERGE(1, 0, ExtState%DustGinoux > 0) + & + MERGE(1, 0, ExtState%DustL23M > 0)) > 1 ) THEN + ErrMsg = 'At least two dust emission schemes are turned on simultaneously (DustDead, DustGinoux, or DustL23M)!' CALL HCO_ERROR( ErrMsg, RC, ThisLoc ) RETURN ENDIF @@ -414,8 +407,7 @@ SUBROUTINE HCOX_Run( HcoState, ExtState, RC ) USE HCOX_ParaNox_Mod, ONLY : HCOX_ParaNox_Run USE HCOX_LightNox_Mod, ONLY : HCOX_LightNox_Run USE HCOX_SoilNox_Mod, ONLY : HCOX_SoilNox_Run - USE HCOX_DustDead_Mod, ONLY : HCOX_DustDead_Run - USE HCOX_DustGinoux_Mod, ONLY : HCOX_DustGinoux_Run + USE HCOX_DustL23M_Mod, ONLY : HCOX_DustL23M_Run USE HCOX_SeaSalt_Mod, ONLY : HCOX_SeaSalt_Run USE HCOX_Megan_Mod, ONLY : HCOX_Megan_Run USE HCOX_GFED_Mod, ONLY : HCOX_GFED_Run @@ -572,36 +564,12 @@ SUBROUTINE HCOX_Run( HcoState, ExtState, RC ) ENDIF !-------------------------------------------------------------------- - ! Dust emissions (DEAD model) - !-------------------------------------------------------------------- - IF ( ExtState%DustDead > 0 ) THEN - CALL HCOX_DustDead_Run( ExtState, HcoState, RC ) - IF ( RC /= HCO_SUCCESS ) THEN - ErrMsg = 'Error encountered in "HCOX_DustDead_Run"!' - CALL HCO_ERROR( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - ENDIF - -#ifdef TOMAS - IF ( ExtState%TOMAS_DustDead > 0 ) THEN - !print*, 'JACK TOMAS_DustDead is on' - CALL HCOX_TOMAS_DustDead_Run( ExtState, HcoState, RC ) - IF ( RC /= HCO_SUCCESS ) THEN - ErrMsg = 'Error encountered in "HCOX_TOMAS_DustDead_Run"!' - CALL HCO_ERROR( ErrMsg, RC, ThisLoc ) - RETURN - ENDIF - ENDIF -#endif - - !-------------------------------------------------------------------- - ! Dust emissions (Ginoux) + ! Dust emissions (DustL23M model) !-------------------------------------------------------------------- - IF ( ExtState%DustGinoux > 0 ) THEN - CALL HCOX_DustGinoux_Run( ExtState, HcoState, RC ) + IF ( ExtState%DustL23M > 0 ) THEN + CALL HCOX_DustL23M_Run( ExtState, HcoState, RC ) IF ( RC /= HCO_SUCCESS ) THEN - ErrMsg = 'Error encountered in "HCOX_DustGinoux_Run"!' + ErrMsg = 'Error encountered in "HCOX_DustL23M_Run"!' CALL HCO_ERROR( ErrMsg, RC, ThisLoc ) RETURN ENDIF @@ -683,6 +651,18 @@ SUBROUTINE HCOX_Run( HcoState, ExtState, RC ) !-------------------------------------------------------------------- ! TOMAS sectional sea salt emissions !-------------------------------------------------------------------- + IF ( ExtState%TOMAS_DustDead > 0 ) THEN + CALL HCOX_TOMAS_DustDead_Run( ExtState, HcoState, RC ) + IF ( RC /= HCO_SUCCESS ) THEN + ErrMsg = 'Error encountered in "HCOX_TOMAS_DustDead_Run"!' + CALL HCO_ERROR( ErrMsg, RC, ThisLoc ) + RETURN + ENDIF + ENDIF + + !-------------------------------------------------------------------- + ! TOMAS sectional dust emissions (based on the DEAD model) + !-------------------------------------------------------------------- IF ( ExtState%TOMAS_Jeagle > 0 ) THEN CALL HCOX_TOMAS_Jeagle_Run( ExtState, HcoState, RC ) IF ( RC /= HCO_SUCCESS ) THEN @@ -757,8 +737,7 @@ SUBROUTINE HCOX_Final( HcoState, ExtState, RC ) USE HCOX_ParaNOx_Mod, ONLY : HCOX_PARANOX_Final USE HCOX_LightNox_Mod, ONLY : HCOX_LightNox_Final USE HCOX_SoilNox_Mod, ONLY : HCOX_SoilNox_Final - USE HCOX_DustDead_Mod, ONLY : HCOX_DustDead_Final - USE HCOX_DustGinoux_Mod, ONLY : HCOX_DustGinoux_Final + USE HCOX_DustL23M_Mod, ONLY : HCOX_DustL23M_Final USE HCOX_SeaSalt_Mod, ONLY : HCOX_SeaSalt_Final USE HCOX_MEGAN_Mod, ONLY : HCOX_MEGAN_Final USE HCOX_GFED_Mod, ONLY : HCOX_GFED_Final @@ -823,21 +802,8 @@ SUBROUTINE HCOX_Final( HcoState, ExtState, RC ) CALL HCOX_LIGHTNOX_Final( ExtState ) ENDIF - IF ( ExtState%DustDead > 0 ) THEN - CALL HCOX_DustDead_Final( ExtState ) - ENDIF - -#ifdef TOMAS - IF ( ExtState%TOMAS_DustDead > 0 ) THEN - CALL HCOX_TOMAS_DustDead_Final( ExtState ) - ENDIF - - IF ( ExtState%TOMAS_Jeagle > 0 ) THEN - CALL HCOX_TOMAS_Jeagle_Final( ExtState ) - ENDIF -#endif - IF ( ExtState%DustGinoux > 0 ) THEN - CALL HCOX_DustGinoux_Final( ExtState ) + IF ( ExtState%DustL23M > 0 ) THEN + CALL HCOX_DustL23M_Final( ExtState ) ENDIF IF ( ExtState%SeaSalt > 0 ) THEN @@ -876,6 +842,16 @@ SUBROUTINE HCOX_Final( HcoState, ExtState, RC ) CALL HCOX_Iodine_Final( ExtState ) ENDIF +#ifdef TOMAS + IF ( ExtState%TOMAS_DustDead > 0 ) THEN + CALL HCOX_TOMAS_DustDead_Final( ExtState ) + ENDIF + + IF ( ExtState%TOMAS_Jeagle > 0 ) THEN + CALL HCOX_TOMAS_Jeagle_Final( ExtState ) + ENDIF +#endif + ENDIF ! Deallocate ExtState object diff --git a/src/Extensions/hcox_dustdead_mod.F b/src/Extensions/hcox_dustdead_mod.F deleted file mode 100644 index 901187f4..00000000 --- a/src/Extensions/hcox_dustdead_mod.F +++ /dev/null @@ -1,5868 +0,0 @@ -!------------------------------------------------------------------------------ -! Harmonized Emissions Component (HEMCO) ! -!------------------------------------------------------------------------------ -!BOP -! -! !MODULE: hcox_dust_dead_mod.F -! -! !DESCRIPTION: Module hcox\_dust\_dead\_mod.F contains routines and -! variables from Charlie Zender's DEAD dust mobilization model. -! Most routines are from Charlie Zender, but have been modified and/or -! cleaned up for inclusion into GEOS-Chem. -!\\ -!\\ -! This is a HEMCO extension module that uses many of the HEMCO core -! utilities. -!\\ -!\\ -! NOTE: The current (dust) code was validated at 2 x 2.5 resolution. -! We have found that running at 4x5 we get much lower (~50%) dust -! emissions than at 2x2.5. Recommend we either find a way to scale -! the U* computed in the dust module, or run a 1x1 and store the the -! dust emissions, with which to drive lower resolution runs. -! -- Duncan Fairlie, 1/25/07 -!\\ -!\\ -! (We'll) implement the [dust] code in the standard [GEOS-Chem] -! model and put a warning about expected low bias when the simulation -! is run at 4x5. Whoever is interested in running dust at 4x5 in the -! future can deal with making the fix. -! -- Daniel Jacob, 1/25/07 -!\\ -!\\ -! !REFERENCES: -! -! \begin{itemize} -! \item Zender, C. S., Bian, H., and Newman, D.: Mineral Dust Entrainment and -! Deposition (DEAD) model: Description and 1990s dust climatology, -! Journal of Geophysical Research: Atmospheres, 108, 2003. -! \end{itemize} -! -! !INTERFACE: -! - MODULE HCOX_DUSTDEAD_MOD -! -! !USES: -! - USE HCO_ERROR_MOD - USE HCO_DIAGN_MOD - USE HCOX_State_MOD, ONLY : Ext_State - USE HCO_STATE_MOD, ONLY : HCO_State - - IMPLICIT NONE - PRIVATE -! -! !PUBLIC MEMBER FUNCTIONS: -! - PUBLIC :: HCOX_DustDead_Run - PUBLIC :: HCOX_DustDead_Init - PUBLIC :: HCOX_DustDead_Final -! -! !REVISION HISTORY: -! 08 Apr 2004 - T. D. Fairlie - Initial version -! See https://github.com/geoschem/hemco for complete history -!EOP -!------------------------------------------------------------------------------ -!BOC -! -! !MODULE VARIABLES: -! - ! Now pack all local variables into customized instance - TYPE :: MyInst - - ! Fields required by module - INTEGER :: Instance - INTEGER :: ExtNr ! Extension num for DustDead - INTEGER :: ExtNrAlk ! Extension num for DustAlk - INTEGER, ALLOCATABLE :: HcoIDs(:) ! tracer IDs for DustDead - INTEGER, ALLOCATABLE :: HcoIDsAlk(:) ! tracer IDs for DustAlk - REAL*8 :: FLX_MSS_FDG_FCT - - !--------------------------------------- - ! 2-D pointers pointing to netCDF arrays - !--------------------------------------- - - ! Time-invariant fields - REAL(hp), POINTER :: ERD_FCT_GEO (:,:) => NULL() -! REAL, POINTER :: ERD_FCT_HYDRO(:,:,:,:) -! REAL, POINTER :: ERD_FCT_TOPO (:,:,:,:) -! REAL, POINTER :: ERD_FCT_UNITY(:,:,:,:) -! REAL, POINTER :: MBL_BSN_FCT (:,:,:,:) - - ! GOCART source function (tdf, bmy, 1/25/07) - REAL(hp), POINTER :: SRCE_FUNC(:,:) => NULL() - - ! Land surface that is not lake or wetland (by area) - REAL(hp), POINTER :: LND_FRC_DRY (:,:) => NULL() - REAL(hp), POINTER :: MSS_FRC_CACO3(:,:) => NULL() - REAL(hp), POINTER :: MSS_FRC_CLY (:,:) => NULL() - REAL(hp), POINTER :: MSS_FRC_SND (:,:) => NULL() - REAL(hp), POINTER :: SFC_TYP (:,:) => NULL() - REAL(hp), POINTER :: VAI_DST(:,:) => NULL() - - ! Time-varying surface info from CTM -! REAL*8, ALLOCATABLE :: FLX_LW_DWN_SFC(:,:) -! REAL*8, ALLOCATABLE :: FLX_SW_ABS_SFC(:,:) -! REAL*8, ALLOCATABLE :: TPT_GND(:,:) -! REAL*8, ALLOCATABLE :: TPT_SOI(:,:) -! REAL*8, ALLOCATABLE :: VWC_SFC(:,:) - - ! Variables initialized in dst_tvbds_ntp() and dst_tvbds_ini() -! REAL*8, ALLOCATABLE :: SRC_STR(:,:) - - ! LSM plant type, 28 land surface types plus 0 for ocean - ! Also account for 3 different land types in each grid box - ! NN_SFCTYP denotes the highest possible surface type number. - ! (ckeller, 07/24/2014) - INTEGER, ALLOCATABLE :: PLN_TYP(:,:) - REAL*8, ALLOCATABLE :: PLN_FRC(:,:) - REAL*8, ALLOCATABLE :: TAI(:,:) - - ! Other fields - REAL*8, ALLOCATABLE :: DMT_VWR(:) -! REAL*8, ALLOCATABLE :: DNS_AER(:) - REAL*8, ALLOCATABLE :: OVR_SRC_SNK_FRC(:,:) - REAL*8, ALLOCATABLE :: OVR_SRC_SNK_MSS(:,:) -! INTEGER, ALLOCATABLE :: OROGRAPHY(:,:) - REAL*8, ALLOCATABLE :: DMT_MIN(:) - REAL*8, ALLOCATABLE :: DMT_MAX(:) - REAL*8, ALLOCATABLE :: DMT_VMA_SRC(:) - REAL*8, ALLOCATABLE :: GSD_ANL_SRC(:) - REAL*8, ALLOCATABLE :: MSS_FRC_SRC(:) - TYPE(MyInst), POINTER :: NextInst => NULL() - END TYPE MyInst - - ! Pointer to instances - TYPE(MyInst), POINTER :: AllInst => NULL() - - !--------------------------------------- - ! MODULE PARAMETER - !--------------------------------------- - INTEGER, PARAMETER :: NBINS = 4 ! # of dust bins - INTEGER, PARAMETER :: NN_SFCTYP = 28 - - ! Fundamental physical constants - REAL*8, PARAMETER :: GAS_CST_UNV = 8.3144598d0 - REAL*8, PARAMETER :: MMW_H2O = 1.8015259d-02 - REAL*8, PARAMETER :: MMW_DRY_AIR = 28.97d-3 - REAL*8, PARAMETER :: CST_VON_KRM = 0.4d0 - REAL*8, PARAMETER :: GRV_SFC = 9.80665d0 - REAL*8, PARAMETER :: GAS_CST_DRY_AIR = 287.0d0 - REAL*8, PARAMETER :: RDS_EARTH = 6.37122d+6 - REAL*8, PARAMETER :: GAS_CST_H2O = 461.65D0 - REAL*8, PARAMETER :: SPC_HEAT_DRY_AIR = 1005.0d0 - REAL*8, PARAMETER :: TPT_FRZ_PNT = 273.15d0 - - ! Derived quantities - REAL*8, PARAMETER :: GRV_SFC_RCP = 1.0d0 / GRV_SFC - REAL*8, PARAMETER :: CST_VON_KRM_RCP = 1.0d0 / CST_VON_KRM - REAL*8, PARAMETER :: EPS_H2O = MMW_H2O / MMW_DRY_AIR - REAL*8, PARAMETER :: EPS_H2O_RCP_M1 = -1.0d0 + MMW_DRY_AIR - & / MMW_H2O - REAL*8, PARAMETER :: KAPPA_DRY_AIR = GAS_CST_DRY_AIR - & / SPC_HEAT_DRY_AIR - - ! Fixed-size grid information - INTEGER, PARAMETER :: DST_SRC_NBR = 3 - INTEGER, PARAMETER :: MVT = 14 - - CONTAINS -!EOC -!------------------------------------------------------------------------------ -! Harmonized Emissions Component (HEMCO) ! -!------------------------------------------------------------------------------ -!BOP -! -! !IROUTINE: HCOX_DustDead_Run -! -! !DESCRIPTION: Subroutine HcoX\_DustDead\_Run is the driver routine -! for the HEMCO DEAD dust extension. -!\\ -!\\ -! !INTERFACE: -! - SUBROUTINE HCOX_DustDead_Run( ExtState, HcoState, RC ) -! -! !USES: -! - USE HCO_CALC_MOD, ONLY : HCO_EvalFld, HCO_CalcEmis - USE HCO_FLUXARR_MOD, ONLY : HCO_EmisAdd - USE HCO_CLOCK_MOD, ONLY : HcoClock_Get - USE HCO_CLOCK_MOD, ONLY : HcoClock_First -! -! !INPUT PARAMETERS: -! - TYPE(Ext_State), POINTER :: ExtState ! Module options - TYPE(HCO_State), POINTER :: HcoState ! Hemco state -! -! !INPUT/OUTPUT PARAMETERS: -! - INTEGER, INTENT(INOUT) :: RC - -! !REVISION HISTORY: -! 08 Apr 2004 - T. D. Fairlie - Initial version -! See https://github.com/geoschem/hemco for complete history -!EOP -!------------------------------------------------------------------------------ -!BOC -! -! !LOCAL VARIABLES: -! - ! Scalars - LOGICAL :: ERR - INTEGER :: I, J, L, N - INTEGER :: M, IOS, INC, LAT_IDX - INTEGER :: NDB, NSTEP, intDOY - REAL*8 :: DEN, DIAM, U_TS0 - REAL*8 :: U_TS, SRCE_P, Reynol, YMID_R - REAL*8 :: ALPHA, BETA, GAMMA, CW - REAL*8 :: XTAU, P1, P2 - REAL*8 :: AREA_M2, DTSRCE, DOY - - ! Arrays - INTEGER :: OROGRAPHY(HcoState%NX,HcoState%NY) - REAL*8 :: PSLON(HcoState%NX) ! surface pressure - REAL*8 :: PTHICK(HcoState%NX) ! delta P (L=1) - REAL*8 :: PMID(HcoState%NX) ! mid layer P (L=1) - REAL*8 :: TLON(HcoState%NX) ! temperature (L=1) - REAL*8 :: THLON(HcoState%NX) ! pot. temp. (L=1) - REAL*8 :: BHT2(HcoState%NX) ! half box height (L=1) - REAL*8 :: Q_H2O(HcoState%NX) ! specific humidity (L=1) - REAL*8 :: ORO(HcoState%NX) ! "orography" - REAL*8 :: SNW_HGT_LQD(HcoState%NX) ! equivalent snow ht. - REAL*8 :: DSRC(HcoState%NX,NBINS) ! dust mixing ratio incr. - REAL*8 :: DUST_EMI_TOTAL(HcoState%NX) ! total dust emiss - - ! Flux array [kg/m2/s] - REAL(hp), TARGET :: FLUX(HcoState%NX, - & HcoState%NY, - & NBINS) - - ! Flux array for dust alkalinity [kg/m2/s] - REAL(hp), TARGET :: FLUX_ALK(HcoState%NX, - & HcoState%NY, - & NBINS) - - ! Pointers - TYPE(MyInst), POINTER :: Inst - - ! Strings - CHARACTER(LEN=255) :: MSG, LOC -! -! !DEFINED PARAMETERS: -! -! REAL*8, PARAMETER :: Ch_dust = 9.375d-10 -! REAL*8, PARAMETER :: g0 = 9.80665d0 -! REAL*8, PARAMETER :: G = g0 * 1.D2 -! REAL*8, PARAMETER :: RHOA = 1.25D-3 - REAL*8, PARAMETER :: CP = 1004.16d0 - REAL*8, PARAMETER :: RGAS = 8314.3d0 / 28.97d0 - REAL*8, PARAMETER :: AKAP = RGAS / CP - REAL*8, PARAMETER :: P1000 = 1000d0 - - !================================================================= - ! HCOX_DUSTDEAD_RUN begins here! - !================================================================= - LOC = 'HCOX_DUSTDEAD_RUN (HCOX_DUSTDEAD_MOD.F)' - - ! Return if extension disabled - IF ( ExtState%DustDead <= 0 ) RETURN - - ! Enter - CALL HCO_ENTER( HcoState%Config%Err, LOC, RC ) - IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 0', RC, THISLOC=LOC ) - RETURN - ENDIF - - ! Get instance - Inst => NULL() - CALL InstGet ( ExtState%DustDead, Inst, RC ) - IF ( RC /= HCO_SUCCESS ) THEN - WRITE(MSG,*) 'Cannot find DEAD instance Nr. ', ExtState%DustDead - CALL HCO_ERROR(MSG,RC) - RETURN - ENDIF - - !================================================================= - ! Get pointers to gridded data imported through config. file - !================================================================= - ! - ! The following time-invariant fields are read in - ! ERD_FCT_GEO ; geomorphic erodibility: HcoState%NX HcoState%NY - ! ERD_FCT_HYDRO ; hydrologic erodibility: HcoState%NX HcoState%NY - ! ERD_FCT_TOPO ; topog. erodibility (Ginoux): HcoState%NX HcoState%NY - ! ERD_FCT_UNITY ; uniform erodibility: HcoState%NX HcoState%NY - ! MBL_BSN_FCT ; overall erodibility factor : HcoState%NX HcoState%NY - ! - ! Erodibility field should be copied onto mbl_bsn_fct - ! which is the one used by the DEAD code Duncan 8/1/2003 - ! - ! LND_FRC_DRY ; dry land fraction: HcoState%NX HcoState%NY - ! MSS_FRC_CACO3 ; mass fraction of soil CaCO3: HcoState%NX HcoState%NY - ! MSS_FRC_CLY ; mass fraction of clay: HcoState%NX HcoState%NY - ! MSS_FRC_SND ; mass fraction of sand: HcoState%NX HcoState%NY - ! SFC_TYP ; surface type: HcoState%NX HcoState%NY - !================================================================= - !IF ( HcoClock_First(HcoState%Clock,.TRUE.) ) THEN - CALL HCO_EvalFld( HcoState, 'DEAD_EF_GEO', - & Inst%ERD_FCT_GEO, RC) - IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 1', RC, THISLOC=LOC ) - RETURN - ENDIF - - CALL HCO_EvalFld( HcoState, 'DEAD_LF_DRY', - & Inst%LND_FRC_DRY, RC) - IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 2', RC, THISLOC=LOC ) - RETURN - ENDIF - - CALL HCO_EvalFld( HcoState, 'DEAD_MF_CACO3', - & Inst%MSS_FRC_CACO3, RC ) - IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 3', RC, THISLOC=LOC ) - RETURN - ENDIF - - CALL HCO_EvalFld( HcoState, 'DEAD_MF_CLY', - & Inst%MSS_FRC_CLY, RC) - IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 4', RC, THISLOC=LOC ) - RETURN - ENDIF - - CALL HCO_EvalFld( HcoState, 'DEAD_MF_SND', - & Inst%MSS_FRC_SND, RC) - IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 5', RC, THISLOC=LOC ) - RETURN - ENDIF - - CALL HCO_EvalFld( HcoState, 'DEAD_SFC_TYP', - & Inst%SFC_TYP, RC ) - IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 6', RC, THISLOC=LOC ) - RETURN - ENDIF - - CALL HCO_EvalFld( HcoState, 'DEAD_GOC_SRC', - & Inst%SRCE_FUNC, RC ) - IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 7', RC, THISLOC=LOC ) - RETURN - ENDIF - - CALL HCO_EvalFld( HcoState, 'DEAD_VAI', - & Inst%VAI_DST, RC ) - IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 8', RC, THISLOC=LOC ) - RETURN - ENDIF - -! FIRST = .FALSE. - !ENDIF - - !================================================================= - ! CALL DUST MOBILIZATION SCHEME - !================================================================= - - ! Make OROGRAPHY array (0=Ocean; 1=Land; 2=Ice) - CALL GET_ORO( HcoState, ExtState, OROGRAPHY, RC ) - IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 9', RC, THISLOC=LOC ) - RETURN - ENDIF - - ! Get emissions time step - DTSRCE = HcoState%TS_EMIS - - ! Get day of year, convert to real!! - CALL HcoClock_Get( HcoState%Clock, cDOY = intDOY, RC=RC ) - IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 10', RC, THISLOC=LOC ) - RETURN - ENDIF - DOY = intDOY - - ! Init - FLUX(:,:,:) = 0.0_hp - FLUX_ALK(:,:,:) = 0.0_hp - - ! Error check - ERR = .FALSE. - -!$OMP PARALLEL DO -!$OMP+DEFAULT( SHARED ) -!$OMP+PRIVATE( I, J, P1, P2, PTHICK, PMID, TLON ) -!$OMP+PRIVATE( THLON, BHT2, Q_H2O, ORO, SNW_HGT_LQD ) -!$OMP+PRIVATE( N, YMID_R, DSRC, RC, AREA_M2, DUST_EMI_TOTAL ) - - ! Loop over latitudes - DO J = 1, HcoState%NY - - ! Don't do calculations if there has been an error - IF ( ERR ) CYCLE - - ! Loop over longitudes - DO I = 1, HcoState%NX - - ! Pressure [Pa] at bottom and top edge of level 1 - P1 = HcoState%Grid%PEDGE%Val(I,J,1) - P2 = HcoState%Grid%PEDGE%Val(I,J,2) - - ! Pressure thickness of 1st layer [Pa] - PTHICK(I) = ( P1 - P2 ) - - ! Pressure at midpt of surface layer [Pa] - PMID(I) = ( P1 + P2 ) / 2.0_hp - - ! Temperature [K] at midpoint of surface layer - TLON(I) = ExtState%TK%Arr%Val(I,J,1) - - ! Potential temperature [K] at midpoint - THLON(I) = TLON(I) * ( P1000 / PMID(I) )**AKAP - - ! Half box height at surface [m] - BHT2(I) = HcoState%Grid%BXHEIGHT_M%Val(I,J,1) / 2.d0 - - ! Specific humidity at midpoint of surface layer [kg H2O/kg air] - Q_H2O(I) = ExtState%SPHU%Arr%Val(I,J,1) - - ! Orography at surface - ! Ocean is 0; land is 1; ice is 2 - ORO(I) = REAL(OROGRAPHY(I,J),KIND=dp) - - ! Snow [m H2O]. SNOWHGT is in kg H2O/m2, which is equivalent to - ! mm H2O. Convert to m H2O here. - SNW_HGT_LQD(I) = ExtState%SNOWHGT%Arr%Val(I,J) / 1000.d0 - - ! Dust tracer and increments - DSRC(I,:) = 0.0d0 - ENDDO !I - - !============================================================== - ! CALL DUST MOBILIZATION DRIVER (DST_MBL) FOR LATITUDE J - !============================================================== - - ! Latitude in RADIANS - YMID_R = HcoState%Grid%YMID%Val(1,J) * HcoState%Phys%PI /180.d0 - - ! Call DEAD dust mobilization - CALL DST_MBL( HcoState, ExtState, Inst, DOY, - & BHT2, J, YMID_R, ORO, - & PTHICK, PMID, Q_H2O, DSRC, SNW_HGT_LQD, - & DTSRCE, TLON, THLON, - & J, RC ) - - ! Error check - IF ( RC /= HCO_SUCCESS ) THEN - ERR = .TRUE. - CYCLE - ENDIF - - ! Redistribute dust emissions using new dust size distribution - ! scheme (L. Zhang, 6/26/15) - DUST_EMI_TOTAL = 0.0d0 - DO N = 1, NBINS - DUST_EMI_TOTAL(:) = DUST_EMI_TOTAL(:) + DSRC(:,N) - ENDDO - DSRC(:,1) = DUST_EMI_TOTAL(:) * 0.0766d0 - DSRC(:,2) = DUST_EMI_TOTAL(:) * 0.1924d0 - DSRC(:,3) = DUST_EMI_TOTAL(:) * 0.3491d0 - DSRC(:,4) = DUST_EMI_TOTAL(:) * 0.3819d0 - - ! Write to emissions array - DO I = 1, HcoState%NX - - ! Loop over dust tracers - ! Write into flux array: kg/box --> kg/m2/s - AREA_M2 = HcoState%Grid%AREA_M2%Val( I, J ) - DO N = 1, NBINS - - IF ( Inst%HcoIDs(N) > 0 ) THEN - FLUX(I,J,N) = ( DSRC(I,N) / AREA_M2 / DTSRCE ) - ENDIF - - ! Include DUST Alkalinity SOURCE, assuming an alkalinity - ! of 4% by weight [kg]. !tdf 05/10/08 - !tdf with 3% Ca, there's also 1% equ. Mg, makes 4% - IF ( Inst%ExtNrAlk > 0 ) THEN - FLUX_ALK(I,J,N) = 0.04 * ( DSRC(I,N) / AREA_M2 / - & DTSRCE ) - ENDIF - - ENDDO !N - ENDDO !I - ENDDO !J -!$OMP END PARALLEL DO - - ! Error check - IF ( ERR ) THEN - RC = HCO_FAIL - RETURN - ENDIF - - !================================================================= - ! PASS TO HEMCO STATE AND UPDATE DIAGNOSTICS - !================================================================= - DO N = 1, NBINS - - IF ( Inst%HcoIDs(N) > 0 ) THEN - - ! Add to emissions array - CALL HCO_EmisAdd( HcoState, FLUX(:,:,N), - & Inst%HcoIDs(N), RC, ExtNr=Inst%ExtNr ) - IF ( RC /= HCO_SUCCESS ) THEN - WRITE(MSG,*) 'HCO_EmisAdd error: dust bin ', N - CALL HCO_ERROR(MSG, RC ) - RETURN - ENDIF - - ENDIF - - IF ( Inst%ExtNrAlk > 0 ) THEN - IF ( Inst%HcoIDsAlk(N) > 0 ) THEN - - ! Add to dust alkalinity emissions array - CALL HCO_EmisAdd( HcoState, FLUX_Alk(:,:,N), - & Inst%HcoIDsAlk(N), RC, - & ExtNr=Inst%ExtNrAlk ) - IF ( RC /= HCO_SUCCESS ) THEN - WRITE(MSG,*) 'HCO_EmisAdd error: dust alk bin ', N - CALL HCO_ERROR(MSG, RC ) - RETURN - ENDIF - - ENDIF - ENDIF - - ENDDO !N - - ! Return w/ success - Inst => NULL() - CALL HCO_LEAVE( HcoState%Config%Err, RC ) - - END SUBROUTINE HCOX_DustDead_Run -!EOC -!------------------------------------------------------------------------------ -! Harmonized Emissions Component (HEMCO) ! -!------------------------------------------------------------------------------ -!BOP -! -! !IROUTINE: HCOX_DustDead_Init -! -! !DESCRIPTION: Subroutine HcoX\_DustDead\_Init initializes the HEMCO -! DUST\_DEAD extension. -!\\ -!\\ -! !INTERFACE: -! - SUBROUTINE HCOX_DustDead_Init ( HcoState, ExtName, - & ExtState, RC ) -! -! !USES: -! - USE HCO_ExtList_Mod, ONLY : GetExtNr, GetExtOpt - USE HCO_STATE_MOD, ONLY : HCO_GetExtHcoID -! -! !INPUT PARAMETERS: -! - TYPE(HCO_State), POINTER :: HcoState ! Hemco state - CHARACTER(LEN=*), INTENT(IN ) :: ExtName ! Extension name - TYPE(Ext_State), POINTER :: ExtState ! Module options -! -! !INPUT/OUTPUT PARAMETERS: -! - INTEGER, INTENT(INOUT) :: RC - -! !REVISION HISTORY: -! 25 Nov 2013 - C. Keller - Now a HEMCO extension -! See https://github.com/geoschem/hemco for complete history -!EOP -!------------------------------------------------------------------------------ -!BOC -! -! !LOCAL VARIABLES: -! - CHARACTER(LEN=255) :: MSG, LOC - INTEGER :: I, J, N, AS - INTEGER :: ExtNr, nSpc - INTEGER :: nSpcAlk - CHARACTER(LEN=31), ALLOCATABLE :: SpcNames(:) - CHARACTER(LEN=31), ALLOCATABLE :: SpcNamesAlk(:) - REAL(dp) :: TmpScal - LOGICAL :: FOUND - TYPE(MyInst), POINTER :: Inst -#if defined ( MODEL_GEOS ) - CHARACTER(LEN=2047) :: TuningTable - CHARACTER(LEN=2047), PARAMETER :: TuningTable_Default = - & 'DustDead_TuningTable.txt' -#endif - - !================================================================= - ! HCOX_DUST_DEAD_INIT begins here! - !================================================================= - LOC = 'HCOX_DUST_DEAD_INIT (HCOX_DUSTDEAD_MOD.F)' - - ! Extension Nr. - ExtNr = GetExtNr( HcoState%Config%ExtList, TRIM(ExtName) ) - IF ( ExtNr <= 0 ) RETURN - - ! Enter - CALL HCO_ENTER ( HcoState%Config%Err, LOC, RC ) - IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 11', RC, THISLOC=LOC ) - RETURN - ENDIF - - ! Create AeroCom instance for this simulation - Inst => NULL() - CALL InstCreate ( ExtNr, ExtState%DustDead, Inst, RC ) - IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR ( - & 'Cannot create DEAD instance', RC ) - RETURN - ENDIF - - ! Check for dust alkalinity option - Inst%ExtNrAlk = GetExtNr( HcoState%Config%ExtList, 'DustAlk') - - ! Get horizontal dimensions - I = HcoState%NX - J = HcoState%NY - - !----------------------------------------------------------------- - ! Get species IDs - !----------------------------------------------------------------- - - CALL HCO_GetExtHcoID( HcoState, ExtNr, Inst%HcoIDs, - & SpcNames, nSpc, RC) - IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 12', RC, THISLOC=LOC ) - RETURN - ENDIF - - ! Get the dust alkalinity species defined for DustAlk option - IF ( Inst%ExtNrAlk > 0 ) THEN - CALL HCO_GetExtHcoID( HcoState, Inst%ExtNrAlk, - & Inst%HcoIDsAlk, - & SpcNamesAlk, nSpcAlk, RC) - IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 13', RC, THISLOC=LOC ) - RETURN - ENDIF - ENDIF - - ! Sanity check - IF ( nSpc /= NBINS ) THEN - MSG = 'Dust DEAD model does not have four species!' - CALL HCO_ERROR(MSG, RC ) - RETURN - ENDIF - - ! Set scale factor: first try to read from configuration file. If - ! not specified, call wrapper function which sets teh scale factor - ! based upon compiler switches. - CALL GetExtOpt( HcoState%Config, ExtNr, - & 'Mass tuning factor', - & OptValDp=TmpScal, Found=FOUND, RC=RC ) - IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 14', RC, THISLOC=LOC ) - RETURN - ENDIF - - ! Set parameter FLX_MSS_FDG_FCT to specified tuning factor as - ! defined in configuration file - IF ( FOUND ) THEN - Inst%FLX_MSS_FDG_FCT = TmpScal - ELSE - Inst%FLX_MSS_FDG_FCT = -999.0e0 - ENDIF - -#if defined ( MODEL_GEOS ) - ! Determine mass flux tuning factor based on grid resolution - IF ( Inst%FLX_MSS_FDG_FCT == -999.0e0 ) THEN - CALL GetExtOpt( HcoState%Config, ExtNr, - & 'Mass tuning table', - & OptValChar=TuningTable, Found=FOUND, RC=RC ) - IF ( .NOT. FOUND ) TuningTable = TuningTable_Default - CALL ReadTuningFactor(HcoState, TuningTable, - & Inst%FLX_MSS_FDG_FCT, RC) - IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR ReadTuningFactor', RC, THISLOC=LOC ) - RETURN - ENDIF - ENDIF -#endif - - ! Error - IF ( Inst%FLX_MSS_FDG_FCT == -999.0e0 ) THEN - MSG = 'Mass flux tuning factor not defined. ' // - & 'Please explicitly set it by modifying the line ' // - & '` --> Mass tuning factor: XX.X` in HEMCO_Config.rc. ' - CALL HCO_ERROR(MSG, - & RC, THISLOC='HCOX_DustDead_Init') - RETURN - ENDIF - - ! Verbose mode - IF ( HcoState%amIRoot ) THEN - - ! Write the name of the extension regardless of the verbose setting - msg = 'Using HEMCO extension: DustDead (dust mobilization)' - CALL HCO_MSG( msg, sep1='-', LUN=HcoState%Config%hcoLogLUN ) ! with separator - - ! Write all other messages as debug printout only - IF ( Inst%ExtNrAlk > 0 ) THEN - MSG = 'Use dust alkalinity option' - CALL HCO_MSG(MSG, SEP1='-',LUN=HcoState%Config%hcoLogLUN ) - ENDIF - - MSG = 'Use the following species (Name: HcoID):' - CALL HCO_MSG(MSG,LUN=HcoState%Config%hcoLogLUN) - DO N = 1, nSpc - WRITE(MSG,*) TRIM(SpcNames(N)), ':', Inst%HcoIDs(N) - CALL HCO_MSG(MSG,LUN=HcoState%Config%hcoLogLUN) - ENDDO - IF ( Inst%ExtNrAlk > 0 ) THEN - DO N = 1, nSpcAlk - WRITE(MSG,*) TRIM(SpcNamesAlk(N)), ':', Inst%HcoIDsAlk(N) - CALL HCO_MSG(MSG,LUN=HcoState%Config%hcoLogLUN) - ENDDO - ENDIF - - WRITE(MSG,*) 'Global mass flux tuning factor: ', - & Inst%FLX_MSS_FDG_FCT - CALL HCO_MSG(MSG,SEP2='-',LUN=HcoState%Config%hcoLogLUN) - - ENDIF - - !----------------------------------------------------------------- - ! Init module arrays - !----------------------------------------------------------------- - - ALLOCATE( Inst%ERD_FCT_GEO( HcoState%NX, HcoState%NY), STAT=AS ) - IF ( AS /= 0 ) THEN - msg = 'Could not allocate Inst%ERD_FCT_GEO!' - CALL HCO_ERROR( msg, RC, thisLoc=loc ) - RETURN - ENDIF - Inst%ERD_FCT_GEO = 0.0_hp - - ALLOCATE( Inst%SRCE_FUNC( HcoState%NX, HcoState%NY), STAT=AS ) - IF ( AS /= 0 ) THEN - msg = 'Could not allocate Inst%SRCE_FUNC!' - CALL HCO_ERROR( msg, RC, thisLoc=loc ) - RETURN - ENDIF - Inst%SRCE_FUNC = 0.0_hp - - ALLOCATE( Inst%LND_FRC_DRY( HcoState%NX, HcoState%NY), STAT=AS ) - IF ( AS /= 0 ) THEN - msg = 'Could not allocate Inst%LND_FRC_DRY!' - CALL HCO_ERROR( msg, RC, thisLoc=loc ) - RETURN - ENDIF - Inst%LND_FRC_DRY = 0.0_hp - - ALLOCATE( Inst%MSS_FRC_CACO3( HcoState%NX, HcoState%NY), STAT=AS ) - IF ( AS /= 0 ) THEN - msg = 'Could not allocate Inst%MSS_FRC_CACO3!' - CALL HCO_ERROR( msg, RC, thisLoc=loc ) - RETURN - ENDIF - Inst%MSS_FRC_CACO3 = 0.0_hp - - ALLOCATE( Inst%MSS_FRC_CLY( HcoState%NX, HcoState%NY), STAT=AS ) - IF ( AS /= 0 ) THEN - msg = 'Could not allocate Inst%MSS_FRC_CLY!' - CALL HCO_ERROR( msg, RC, thisLoc=loc ) - RETURN - ENDIF - Inst%MSS_FRC_CLY = 0.0_hp - - ALLOCATE( Inst%MSS_FRC_SND( HcoState%NX, HcoState%NY), STAT=AS ) - IF ( AS /= 0 ) THEN - msg = 'Could not allocate Inst%MSS_FRC_SND!' - CALL HCO_ERROR( msg, RC, thisLoc=loc ) - RETURN - ENDIF - Inst%MSS_FRC_SND = 0.0_hp - - ALLOCATE( Inst%SFC_TYP( HcoState%NX, HcoState%NY), STAT=AS ) - IF ( AS /= 0 ) THEN - msg = 'Could not allocate Inst%SFC_TYP!' - CALL HCO_ERROR( msg, RC, thisLoc=loc ) - RETURN - ENDIF - Inst%SFC_TYP = 0.0_hp - - ALLOCATE( Inst%VAI_DST( HcoState%NX, HcoState%NY), STAT=AS ) - IF ( AS /= 0 ) THEN - msg = 'Could not allocate Inst%VAI_DST!' - CALL HCO_ERROR( msg, RC, thisLoc=loc ) - RETURN - ENDIF - Inst%VAI_DST = 0.0_hp - -! ! Allocate arrays -! ALLOCATE( Inst%FLX_LW_DWN_SFC( I, J ), STAT=AS ) -! IF ( AS /= 0 ) THEN -! CALL HCO_ERROR ( 'FLX_LW_DWN_SFC', RC ) -! RETURN -! ENDIF -! Inst%FLX_LW_DWN_SFC = 0d0 - -! ALLOCATE( Inst%FLX_SW_ABS_SFC( I, J ), STAT=AS ) -! IF ( AS /= 0 ) THEN -! CALL HCO_ERROR ( 'FLX_SW_ABS_SFC', RC ) -! RETURN -! ENDIF -! Inst%FLX_SW_ABS_SFC = 0d0 - -! ALLOCATE( Inst%TPT_GND( I, J ), STAT=AS ) -! IF ( AS /= 0 ) THEN -! CALL HCO_ERROR ( 'TPT_GND', RC ) -! RETURN -! ENDIF -! Inst%TPT_GND = 0d0 - -! ALLOCATE( Inst%TPT_SOI( I, J ), STAT=AS ) -! IF ( AS /= 0 ) THEN -! CALL HCO_ERROR ( 'TPT_SOI', RC ) -! RETURN -! ENDIF -! Inst%TPT_SOI = 0d0 - -! ALLOCATE( Inst%VWC_SFC( I, J ), STAT=AS ) -! IF ( AS /= 0 ) THEN -! CALL HCO_ERROR ( 'VWC_SFC', RC ) -! RETURN -! ENDIF -! Inst%VWC_SFC = 0d0 - -! ALLOCATE( Inst%SRC_STR( I, J ), STAT=AS ) -! IF ( AS /= 0 ) THEN -! CALL HCO_ERROR ( 'SRC_STR', RC ) -! RETURN -! ENDIF -! Inst%SRC_STR = 0d0 - - ALLOCATE( Inst%PLN_TYP( 0:28, 3 ), STAT=AS ) - IF ( AS /= 0 ) THEN - CALL HCO_ERROR ( 'PLN_TYP', RC ) - RETURN - ENDIF - Inst%PLN_TYP = 0 - - ALLOCATE( Inst%PLN_FRC( 0:28, 3 ), STAT=AS ) - IF ( AS /= 0 ) THEN - CALL HCO_ERROR ( 'PLN_FRC', RC ) - RETURN - ENDIF - Inst%PLN_FRC = 0d0 - - ALLOCATE( Inst%TAI( MVT, 12 ), STAT=AS ) - IF ( AS /= 0 ) THEN - CALL HCO_ERROR ( 'TAI', RC ) - RETURN - ENDIF - Inst%TAI = 0d0 - - ALLOCATE( Inst%DMT_VWR( NBINS ), STAT=AS ) - IF ( AS /= 0 ) THEN - CALL HCO_ERROR ( 'DMT_VWR', RC ) - RETURN - ENDIF - Inst%DMT_VWR = 0d0 - -! ALLOCATE( Inst%DNS_AER( NBINS ), STAT=AS ) -! IF ( AS /= 0 ) THEN -! CALL HCO_ERROR ( 'DNS_AER', RC ) -! RETURN -! ENDIF -! Inst%DNS_AER = 0d0 - - ALLOCATE( Inst%OVR_SRC_SNK_FRC( DST_SRC_NBR, NBINS ), STAT=AS ) - IF ( AS /= 0 ) THEN - CALL HCO_ERROR ( 'OVR_SRC_SNK_FRC', RC ) - RETURN - ENDIF - Inst%OVR_SRC_SNK_FRC = 0d0 - - ALLOCATE( Inst%OVR_SRC_SNK_MSS( DST_SRC_NBR, NBINS ), STAT=AS ) - IF ( AS /= 0 ) THEN - CALL HCO_ERROR ( 'OVR_SRC_SNK_MSS', RC ) - RETURN - ENDIF - Inst%OVR_SRC_SNK_MSS = 0d0 - -! ALLOCATE( Inst%OROGRAPHY( I, J ), STAT=AS ) -! IF ( AS /= 0 ) THEN -! CALL HCO_ERROR ( 'OROGRAPHY', RC ) -! RETURN -! ENDIF -! Inst%OROGRAPHY = 0 - - ! Bin size min diameter [m] - ALLOCATE( Inst%DMT_MIN( NBINS ), STAT=AS ) - IF ( AS /= 0 ) THEN - CALL HCO_ERROR ( 'DMT_MIN', RC ) - RETURN - ENDIF - Inst%DMT_MIN(1) = 0.2d-6 - Inst%DMT_MIN(2) = 2.0d-6 - Inst%DMT_MIN(3) = 3.6d-6 - Inst%DMT_MIN(4) = 6.0d-6 - - ! Bin size max diameter [m] - ALLOCATE( Inst%DMT_MAX( NBINS ), STAT=AS ) - IF ( AS /= 0 ) THEN - CALL HCO_ERROR ( 'DMT_MAX', RC ) - RETURN - ENDIF - Inst%DMT_MAX(1) = 2.0d-6 - Inst%DMT_MAX(2) = 3.6d-6 - Inst%DMT_MAX(3) = 6.0d-6 - Inst%DMT_MAX(4) = 1.2d-5 - - ! DMT_VMA_SRC: D'Almeida's (1987) "Background" modes - ! as default [m] (Zender et al. p.5 Table 1) - ! These modes also summarized in BSM96 p. 73 Table 2 - ! Mass median diameter BSM96 p. 73 Table 2 - ALLOCATE( Inst%DMT_VMA_SRC( DST_SRC_NBR ), STAT=AS ) - IF ( AS /= 0 ) THEN - CALL HCO_ERROR ( 'DMT_VMA_SRC', RC ) - RETURN - ENDIF - Inst%DMT_VMA_SRC(1) = 0.832d-6 - Inst%DMT_VMA_SRC(2) = 4.82d-6 - Inst%DMT_VMA_SRC(3) = 19.38d-6 - - ! GSD_ANL_SRC: Geometric standard deviation [fraction] - ! BSM96 p. 73 Table 2 - ALLOCATE( Inst%GSD_ANL_SRC( DST_SRC_NBR ), STAT=AS ) - IF ( AS /= 0 ) THEN - CALL HCO_ERROR ( 'GSD_ANL_SRC', RC ) - RETURN - ENDIF - Inst%GSD_ANL_SRC(1) = 2.10d0 - Inst%GSD_ANL_SRC(2) = 1.90d0 - Inst%GSD_ANL_SRC(3) = 1.60d0 - - ! MSS_FRC_SRC: Mass fraction BSM96 p. 73 Table 2 - ALLOCATE( Inst%MSS_FRC_SRC( DST_SRC_NBR ), STAT=AS ) - IF ( AS /= 0 ) THEN - CALL HCO_ERROR ( 'MSS_FRC_SRC', RC ) - RETURN - ENDIF - Inst%MSS_FRC_SRC(1) = 0.036d0 - Inst%MSS_FRC_SRC(2) = 0.957d0 - Inst%MSS_FRC_SRC(3) = 0.007d0 - - !================================================================= - ! Compute mass overlaps, Mij, between "source" PDFs - ! and size bins (Zender et al., 2K3, Equ. 12, and Table 1) - !================================================================= - CALL OVR_SRC_SNK_FRC_GET( HcoState, - & DST_SRC_NBR, Inst%DMT_VMA_SRC, - & Inst%GSD_ANL_SRC, NBINS, - & Inst%DMT_MIN, Inst%DMT_MAX, - & Inst%OVR_SRC_SNK_FRC, RC ) - IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 15', RC, THISLOC=LOC ) - RETURN - ENDIF - - !================================================================= - ! Compute OVR_SRC_SNK_MSS, the fraction of dust transported, given - ! the mass overlap, OVR_SRC_SNK_FRC, and the mass fraction - ! MSS_FRC_SRC. OVR_SRC_SNK_MSS is used in routine - ! FLX_MSS_VRT_DST_PRT which partitions the total vertical - ! dust flux into transport - !============================================================== - CALL DST_PSD_MSS( Inst%OVR_SRC_SNK_FRC, Inst%MSS_FRC_SRC, - & Inst%OVR_SRC_SNK_MSS, NBINS, DST_SRC_NBR ) - - !================================================================= - ! Get plant type, cover, and Leaf area index from land sfc model - !================================================================= - CALL PLN_TYP_GET( Inst%PLN_TYP, Inst%PLN_FRC, Inst%TAI ) - - ! Activate met fields used by this extension - ExtState%SPHU%DoUse = .TRUE. - ExtState%TK%DoUse = .TRUE. - ExtState%T2M%DoUse = .TRUE. - ExtState%GWETTOP%DoUse = .TRUE. - ExtState%SNOWHGT%DoUse = .TRUE. - ExtState%USTAR%DoUse = .TRUE. - ExtState%FRLAND%DoUse = .TRUE. - ExtState%FRLANDIC%DoUse= .TRUE. - ExtState%FROCEAN%DoUse = .TRUE. - ExtState%FRSEAICE%DoUse= .TRUE. - ExtState%FRLAKE%DoUse = .TRUE. - - ! Leave w/ success - Inst => NULL() - IF ( ALLOCATED(SpcNames ) ) DEALLOCATE(SpcNames ) - IF ( ALLOCATED(SpcNamesAlk) ) DEALLOCATE(SpcNamesAlk) - CALL HCO_LEAVE( HcoState%Config%Err, RC ) - - END SUBROUTINE HCOX_DustDead_Init -!EOC -!------------------------------------------------------------------------------ -! Harmonized Emissions Component (HEMCO) ! -!------------------------------------------------------------------------------ -!BOP -! -! !IROUTINE: HCOX_DustDead_Final -! -! !DESCRIPTION: Subroutine HcoX\_DustDead\_Final finalizes the HEMCO -! DUST\_DEAD extension. -!\\ -!\\ -! !INTERFACE: -! - SUBROUTINE HCOX_DustDead_Final ( ExtState ) -! -! !INPUT PARAMETERS: -! - TYPE(Ext_State), POINTER :: ExtState ! Module options -! -! !REVISION HISTORY: -! 25 Nov 2013 - C. Keller - Now a HEMCO extension -! See https://github.com/geoschem/hemco for complete history -!EOP -!------------------------------------------------------------------------------ -!BOC -! -! !LOCAL VARIABLES: -! - CALL InstRemove ( ExtState%DustDead ) - - END SUBROUTINE HCOX_DustDead_Final -!EOC -!------------------------------------------------------------------------------ -! Harmonized Emissions Component (HEMCO) ! -!------------------------------------------------------------------------------ -! -!****************************************************************************** -! ORIGINAL ROUTINES FOLLOW BELOW -!****************************************************************************** - - SUBROUTINE DST_MBL( HcoState, ExtState, Inst, - & DOY, HGT_MDP, LAT_IDX, - & LAT_RDN, ORO, PRS_DLT, - & PRS_MDP, Q_H2O_VPR, DSRC, - & SNW_HGT_LQD, TM_ADJ, TPT_MDP, - & TPT_PTN_MDP, - & NSTEP, RC ) -! -!****************************************************************************** -! Subroutine DST_MBL is the driver for aerosol mobilization (DEAD model). -! It is designed to require only single layer surface fields, allowing for -! easier implementation. DST_MBL is called once per latitude. Modified -! for GEOS-CHEM by Duncan Fairlie and Bob Yantosca. -! (tdf, bmy, 1/25/07, 12/18/09) -! -! Arguments as Input: -! ============================================================================ -! (1 ) DOY (REAL*8 ) : Day of year [1.0..366.0) [unitless] -! (2 ) HGT_MDP (REAL*8 ) : Midpoint height above surface [m ] -! (3 ) LAT_IDX (INTEGER) : Model latitude index [unitless] -! (4 ) LAT_RDN (REAL*8 ) : Model latitude [radians ] -! (5 ) ORO (REAL*8 ) : Orography [fraction] -! (6 ) PRS_DLT (REAL*8 ) : Pressure thickness of grid box [Pa ] -! (7 ) PRS_MDP (REAL*8 ) : Pressure @ midpoint of grid box [Pa ] -! (8 ) Q_H2O_VPR, (REAL*8 ) : Water vapor mixing ratio [kg/kg ] -! (9 ) SNW_HGT_LQD (REAL*8 ) : Equivalent liquid water snow depth [m ] -! (10) TM_ADJ, (REAL*8 ) : Adjustment timestep [s ] -! (11) TPT_MDP, (REAL*8 ) : Temperature [K ] -! (12) TPT_PTN_MDP (REAL*8 ) : Midlayer local potential temp. [K ] -! (15) FIRST, (LOGICAL) : Logical used ot open output dataset [unitless] -! (16) NSTEP (INTEGER) : Iteration counter [unitless] -! -! Arguments as Output: -! ============================================================================ -! (10) DSRC ! O [kg kg-1] Dust mixing ratio increment -! -! NOTES: -! (1 ) Cleaned up and added comments. Also force double precision with -! "D" exponents. (bmy, 3/30/04) -! (2 ) Now get GOCART source function. (tdf, bmy, 1/25/07) -! (3 ) Tune nested-domain emissions dust to the same as 2x2.5 simulation -! Also tune GEOS-3 1x1 N. America nested-grid dust emissions to -! the 4x5 totals from the GEOS-5 4x5 v8-01-01-Run0 benchmark. -! (yxw, bmy, dan, 11/6/08) -! (4 ) New scale parameter for 2x2.5 GEOS-5 (tdf, jaf, phs, 10/30/09) -! (5 ) Defined FLX_MSS_FDG_FCT for GEOS_4 2x2.5, GEOS_5 2x2.5, NESTED_NA and -! NESTED_EU. Redefined FLX_MSS_FDG_FCT for NESTED_CH, based upon above -! changes. (amv, bmy, 12/18/09) -! (6 ) For now treat MERRA like GEOS-5 (bmy, 8/13/10) -! 29 Oct 2010 - T. D. Fairlie, R. Yantosca - Retune dust for MERRA 4x5 -! 08 Feb 2012 - R. Yantosca - For now, use same FLX_MSS_FDG_FCT for -! GEOS-5.7.x as for MERRA -! 01 Mar 2012 - R. Yantosca - Now use GET_AREA_M2(I,J,L) from grid_mod.F90 -! 09 Nov 2012 - M. Payer - Replaced all met field arrays with State_Met -! derived type object -! 5 Jun 2013 - K. Yu - Use 0.5 x 0.666 NA scale factor for the -! 0.25 x 0.3125 NA nested simulation -!****************************************************************************** -! - ! Arguments - TYPE(HCO_State), POINTER :: HcoState ! Hemco state - TYPE(Ext_State), POINTER :: ExtState ! Module options - TYPE(MyInst), POINTER :: Inst - INTEGER, INTENT(IN) :: LAT_IDX - REAL*8, INTENT(IN) :: DOY - REAL*8, INTENT(IN) :: HGT_MDP(HcoState%NX) - REAL*8, INTENT(IN) :: LAT_RDN - REAL*8, INTENT(IN) :: ORO(HcoState%NX) - REAL*8, INTENT(IN) :: PRS_DLT(HcoState%NX) - REAL*8, INTENT(IN) :: PRS_MDP(HcoState%NX) - REAL*8, INTENT(IN) :: Q_H2O_VPR(HcoState%NX) - REAL*8, INTENT(IN) :: SNW_HGT_LQD(HcoState%NX) - REAL*8, INTENT(IN) :: TM_ADJ - REAL*8, INTENT(IN) :: TPT_MDP(HcoState%NX) - REAL*8, INTENT(IN) :: TPT_PTN_MDP(HcoState%NX) - INTEGER, INTENT(IN) :: NSTEP - REAL*8, INTENT(INOUT) :: DSRC(HcoState%NX, NBINS) - INTEGER, INTENT(INOUT) :: RC - - !-------------- - ! Parameters - !-------------- - - ! Reference height for mobilization processes [m] - REAL*8, PARAMETER :: HGT_RFR = 10.0d0 - - ! Zero plane displacement for erodible surfaces [m] - REAL*8, PARAMETER :: HGT_ZPD_MBL = 0.0d0 - - ! Set roughness length momentum for erodible surfaces, S&P, p. 858. [m] - REAL*8, PARAMETER :: RGH_MMN_MBL = 1.0d-3 - - ! rgh_mmn_smt set to 33.3e-6 um, MaB95 p. 16426 recommend 10.0e-6 - ! Smooth roughness length MaB95 p. 16426, MaB97 p. 4392, GMB98 p. 6207 - ! [m] Z0,m,s - REAL*8, PARAMETER :: RGH_MMN_SMT = 33.3d-6 - - ! Minimum windspeed used for mobilization [m/s] - REAL*8, PARAMETER :: WND_MIN_MBL = 1.0d0 - - !-------------- - ! Local Output - !-------------- - REAL*8 DST_SLT_FLX_RAT_TTL(HcoState%NX) ! [m-1] Ratio of vertical dust flux to - ! streamwise mass flux - REAL*8 FLX_MSS_HRZ_SLT_TTL(HcoState%NX) ! [kg/m/s] Vertically integrated - ! streamwise mass flux - REAL*8 FLX_MSS_VRT_DST_TTL(HcoState%NX) ! [kg/m2/s] Total vertical mass - ! flux of dust - REAL*8 FRC_THR_NCR_DRG(HcoState%NX) ! [frc] Threshold friction velocity - ! increase from roughness - REAL*8 FRC_THR_NCR_WTR(HcoState%NX) ! [frc] Threshold friction velocity - ! increase from moisture - REAL*8 FLX_MSS_VRT_DST(HcoState%NX,NBINS) ! [kg/m2/s] Vertical mass flux - ! of dust - REAL*8 HGT_ZPD(HcoState%NX) ! [m] Zero plane displacement - REAL*8 LND_FRC_MBL_SLICE(HcoState%NX) ! [frc] Bare ground fraction - REAL*8 WND_FRC(HcoState%NX) ! [m/s] Friction velocity - REAL*8 SNW_FRC(HcoState%NX) ! [frc] Fraction of surface covered - ! by snow - REAL*8 TRN_FSH_VPR_SOI_ATM(HcoState%NX) ! [frc] Transfer efficiency of vapor - ! from soil to atmosphere - REAL*8 wnd_frc_slt(HcoState%NX) ! [m/s] Saltating friction velocity - REAL*8 WND_FRC_THR_SLT(HcoState%NX) ! [m/s] Threshold friction velocity - ! for saltation - - LOGICAL FLG_CACO3 ! [FLG] Activate CaCO3 tracer - LOGICAL FLG_MBL_SLICE(HcoState%NX) ! [flg] Mobilization candidates - CHARACTER(80) FL_OUT ! [sng] Name of netCDF output file - INTEGER I ! [idx] Counting index - INTEGER M ! [idx] Counting index - INTEGER MBL_NBR ! [nbr] Number of mobilization candidates - INTEGER SFC_TYP_SLICE(HcoState%NX) ! [idx] LSM surface type lat slice (0..28) - REAL*8 CND_TRM_SOI(HcoState%NX) ! [W/m/K] Soil thermal conductivity - REAL*8 DNS_MDP(HcoState%NX) ! [kg/m3] Midlayer density - REAL*8 FLX_LW_DWN_SFC_SLICE(HcoState%NX) ! [W/m2] Longwave downwelling flux - ! at surface - REAL*8 FLX_SW_ABS_SFC_SLICE(HcoState%NX) ! [W/m2] Solar flux absorbed by ground - - REAL*8 LND_FRC_DRY_SLICE(HcoState%NX) ! [frc] Dry land fraction - REAL*8 MBL_BSN_FCT_SLICE(HcoState%NX) ! [frc] Erodibility factor - REAL*8 MSS_FRC_CACO3_SLICE(HcoState%NX) ! [frc] Mass fraction of CaCO3 - REAL*8 MSS_FRC_CLY_SLICE(HcoState%NX) ! [frc] Mass fraction of clay - REAL*8 MSS_FRC_SND_SLICE(HcoState%NX) ! [frc] Mass fraction of sand - - ! GOCART source function (tdf, bmy, 1/25/07) - REAL*8 SRCE_FUNC_SLICE(HcoState%NX) ! GOCART source function - - REAL*8 LVL_DLT(HcoState%NX) ! [m] Soil layer thickness - REAL*8 MPL_AIR(HcoState%NX) ! [kg/m2] Air mass path in layer - - REAL*8 TM_DLT ! [s] Mobilization timestep - REAL*8 TPT_GND_SLICE(HcoState%NX) ! [K] Ground temperature - REAL*8 TPT_SOI_SLICE(HcoState%NX) ! [K] Soil temperature - REAL*8 TPT_SOI_FRZ ! [K] Temperature of frozen soil - REAL*8 TPT_VRT_MDP ! [K] Midlayer virtual temperature - REAL*8 VAI_DST_SLICE(HcoState%NX) ! [m2/m2] Vegetation area index, - ! one-sided - REAL*8 VWC_DRY(HcoState%NX) ! [m3/s] Dry volumetric water content - ! (no E-T) - REAL*8 VWC_OPT(HcoState%NX) ! [m3/m3] E-T optimal volumetric water - ! content - REAL*8 VWC_SAT(HcoState%NX) ! [m3/m3] Saturated volumetric water - ! content (sand-dependent) - REAL*8 VWC_SFC_SLICE(HcoState%NX) ! [m3/m3] Volumetric water content - REAL*8 GWC_SFC(HcoState%NX) ! [kg/kg] Gravimetric water content - - ! GCM diagnostics - ! Dust tendency due to gravitational settling [kg/kg/s] - REAL*8 Q_DST_TND_MBL(HcoState%NX,NBINS) - - ! Total dust tendency due to gravitational settling [kg/kg/s] - REAL*8 Q_DST_TND_MBL_TTL(HcoState%NX) - - ! Temperature - REAL(dp) :: TMP - - ! For error handling - CHARACTER(LEN=255) :: MSG, LOC - - !================================================================= - ! DST_MBL begins here! - !================================================================= - LOC = 'DST_MBL (HCOX_DUSTDEAD_MOD.F)' - - ! Start - RC = HCO_SUCCESS - - ! Time step [s] - TM_DLT = TM_ADJ - - ! Freezing pt of soil [K] -- assume it's 0C - TPT_SOI_FRZ = TPT_FRZ_PNT - - ! Initialize output fluxes and tendencies - Q_DST_TND_MBL(:,:) = 0.0D0 ! [kg kg-1 s-1] - Q_DST_TND_MBL_TTL(:) = 0.0D0 ! [kg kg-1 s-1] - FLX_MSS_VRT_DST(:,:) = 0.0D0 ! [kg m-2 s-1] - FLX_MSS_VRT_DST_TTL(:) = 0.0D0 ! [kg m-2 s-1] - FRC_THR_NCR_WTR(:) = 0.0D0 ! [frc] - WND_FRC(:) = 0.0D0 ! [m s-1] - WND_FRC_SLT(:) = 0.0D0 ! [m s-1] - WND_FRC_THR_SLT(:) = 0.0D0 ! [m s-1] - HGT_ZPD(:) = HGT_ZPD_MBL ! [m] - - DSRC(:,:) = 0.0D0 - - !================================================================= - ! Compute necessary derived fields - !================================================================= - DO I = 1, HcoState%NX - - ! Stop occasional haywire model runs -! IF ( TPT_MDP(I) > 350.0d0 ) THEN -! MSG = 'TPT_MDP(i) > 350.0' -! CALL HCO_ERROR(MSG, RC, THISLOC='DST_MBL' ) -! RETURN -! ENDIF - ! Now simply restrict to 350K, rather than crashing - IF ( TPT_MDP(I) > 350.0d0 ) THEN - TMP = 350.0d0 - ELSE - TMP = TPT_MDP(I) - ENDIF - - ! Midlayer virtual temperature [K] - TPT_VRT_MDP = TMP - & * (1.0d0 + EPS_H2O_RCP_M1 * Q_H2O_VPR(I)) - - ! Density at center of gridbox [kg/m3] - DNS_MDP(I) = PRS_MDP(I) - & / (TPT_VRT_MDP * GAS_CST_DRY_AIR) - - ! Commented out - !cApproximate surface virtual temperature (uses midlayer moisture) - !c tpt_vrt_sfc=tpt_sfc(i)*(1.0+eps_H2O_rcp_m1*q_H2O_vpr(i)) ! [K] - !c - !c Surface density - !c dns_sfc(i)=prs_sfc(i)/(tpt_vrt_sfc*gas_cst_dry_air) ! [kg m-3] - - ! Mass of air currently in gridbox [kg/m2] - MPL_AIR(I) = PRS_DLT(I) * GRV_SFC_RCP - - ENDDO - - !================================================================= - ! Gather input variables from GEOS-CHEM modules etc. - !================================================================= - - ! Get LSM Surface type (0..28) - CALL SFC_TYP_GET( HcoState, ExtState, Inst, - & LAT_IDX, SFC_TYP_SLICE, RC ) - IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 16', RC, THISLOC=LOC ) - RETURN - ENDIF - - ! Get erodability and mass fractions - CALL SOI_TXT_GET( - & HcoState, ! Hemco state object - & ExtState, Inst, ! Extension options - & LAT_IDX, ! I [idx] Latitude index - & LND_FRC_DRY_SLICE, ! O [frc] Dry land fraction - & MBL_BSN_FCT_SLICE, ! O [frc] Erodibility factor - & MSS_FRC_CACO3_SLICE, ! O [frc] Mass fraction of CaCO3 - & MSS_FRC_CLY_SLICE, ! O [frc] Mass fraction of clay - & MSS_FRC_SND_SLICE ) ! O [frc] Mass fraction of sand - - ! Get GOCART source function (tdf, bmy, 1/25/07) - CALL SRCE_FUNC_GET( ! GOCART source function - & HcoState, Inst, ! Hemco state object - & LAT_IDX, ! I [idx] Latitude index - & SRCE_FUNC_SLICE ) ! O [frc] GOCART source function - - ! Get volumetric water content from GWET - CALL VWC_SFC_GET( - & HcoState, ! Hemco state object - & LAT_IDX, ! I [idx] Latitude index - & ExtState%GWETTOP%Arr%Val, ! I [unitless] Top soil moisture - & VWC_SFC_SLICE ) ! O [m3 m-3] Volumetric water content - - ! Get surface and soil temperature - CALL TPT_GND_SOI_GET( - & HcoState, ! Hemco state object - & LAT_IDX, ! I [idx] Latitude index! - & ExtState%T2M%Arr%Val, ! I [K] Sfc temperature at 2m - & TPT_GND_SLICE, ! O [K] Ground temperature - & TPT_SOI_SLICE ) ! O [K] Soil temperature - - ! Get time-varying vegetation area index - CALL DST_TVBDS_GET( - & Inst, ! # of lons - & HcoState%NX, ! # of lons - & LAT_IDX, ! I [idx] Latitude index - & VAI_DST_SLICE) ! O [m2 m-2] Vegetation area index, one-sided - - ! Get fraction of surface covered by snow - CALL SNW_FRC_GET( - & HcoState, ! Hemco state object - & SNW_HGT_LQD, ! I [m] Equivalent liquid water snow depth - & SNW_FRC ) ! O [frc] Fraction of surface covered by snow - - !================================================================= - ! Use the variables retrieved above to compute the fraction - ! of each gridcell suitable for dust mobilization - !================================================================= - CALL LND_FRC_MBL_GET( - % HcoState, - & DOY, ! I [day] Day of year [1.0..366.0) - & FLG_MBL_SLICE, ! O [flg] Mobilization candidate flag - & LAT_RDN, ! I [rdn] Latitude - & LND_FRC_DRY_SLICE, ! I [frc] Dry land fraction - & LND_FRC_MBL_SLICE, ! O [frc] Bare ground fraction - & MBL_NBR, ! O [flg] Number of mobilization candidates - & ORO, ! I [frc] Orography - & SFC_TYP_SLICE, ! I [idx] LSM surface type (0..28) - & SNW_FRC, ! I [frc] Fraction of surface covered by snow - & TPT_SOI_SLICE, ! I [K] Soil temperature - & TPT_SOI_FRZ, ! I [K] Temperature of frozen soil - & VAI_DST_SLICE, ! I [m2 m-2] Vegetation area index, one-sided - & RC ) - IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 17', RC, THISLOC=LOC ) - RETURN - ENDIF - - ! Much ado about nothing - if (mbl_nbr == 0) then - goto 737 - endif - - !================================================================= - ! Compute time-invariant hydrologic properties - ! NB flg_mbl IS time-dependent, so keep this in time loop. - !================================================================= - CALL HYD_PRP_GET( ! NB: These properties are time-invariant - & HcoState, - & FLG_MBL_SLICE, ! I [flg] Mobilization candidate flag - & MSS_FRC_CLY_SLICE, ! I [frc] Mass fraction clay - & MSS_FRC_SND_SLICE, ! I [frc] Mass fraction sand - & VWC_DRY, ! O [m3/m3] Dry vol'mtric water content (no E-T) - & VWC_OPT, ! O [m3/m3] E-T optimal volumetric water content - & VWC_SAT) ! O [m3/m3] Saturated volumetric water content - - CND_TRM_SOI(:) = 0.0D0 - LVL_DLT(:) = 0.0D0 - - ! The following chuncks are removed since Ustar is read from meteorology now - !================================================================= - ! Get reference wind at 10m - !================================================================= - - - !================================================================= - ! Compute standard roughness length. This call is probably - ! unnecessary, because we are only concerned with mobilisation - ! candidates, for which roughness length is imposed in blm_mbl - !================================================================= - - !================================================================= - ! Introduce Ustar and Z0 from GEOS data - !================================================================= - DO I = 1, HcoState%NX - - ! Just assign for flag mobilisation candidates - IF ( FLG_MBL_SLICE(I) ) THEN - WND_FRC(I) = ExtState%USTAR%Arr%Val(I,LAT_IDX) - ELSE - WND_FRC(I) = 0.0D0 - ENDIF - ENDDO - - !================================================================= - ! Surface exchange properties over erodible surfaces - ! DO NEED THIS: Compute Monin-Obukhov and Friction velocities - ! appropriate for dust producing regions. - ! - ! Now calling Stripped down (adiabatic) version tdf 10/27/2K3 - ! rgh_mmn_mbl parameter included directly in blm_mbl - ! since Monin-Obukhov length is not used as well, comment out this call - !================================================================= - - !================================================================= - ! Factor by which surface roughness increases threshold friction - ! velocity. The sink of atrmospheric momentum into non-erodible - ! roughness elements Zender et al., expression (3) - !================================================================= -!----------------------------------------------------------------------------- -! Prior to 1/25/07: -! For now, instead of calling this routine to get FRC_THR_NCR_DRG, we will -! just set it to 1 (tdf, bmy, 1/25/07) -! -! %%%%% DO NOT DELETE -- LEAVE THIS CODE COMMENTED OUT %%%%% -! -! CALL FRC_THR_NCR_DRG_GET( -! & HcoState, -! & FRC_THR_NCR_DRG, ! O [frc] Factor increases thresh. fric. veloc. -! & FLG_MBL_SLICE, ! I [flg] Mobilization candidate flag -! & RGH_MMN_MBL, ! I [m] Rgh length momentum for erodible sfcs -! & RGH_MMN_SMT, ! I [m] Smooth roughness length, Z0,m,s -! & RC ) -!----------------------------------------------------------------------------- - - ! Now set roughness factor to 1.0 (tdf, bmy, 1/25/07) - FRC_THR_NCR_DRG(:) = 1.0d0 - - !================================================================= - ! Convert volumetric water content to gravimetric water content - ! NB: Owen effect included in wnd_frc_slt_get - !================================================================= - CALL VWC2GWC( - & HcoState, - & FLG_MBL_SLICE, ! I [flg] Mobilization candidate flag - & GWC_SFC, ! O [kg kg-1] Gravimetric water content - & VWC_SAT, ! I [m3 m-3] Saturated VWC (sand-dependent) - & VWC_SFC_SLICE ) ! I [m3 m-3] Volumetric water content - - !================================================================= - ! Factor by which soil moisture increases threshold friction - ! velocity -- i.e. the inhibition of saltation by soil mositure, - ! Zender et al., exp(5). - !================================================================= - CALL FRC_THR_NCR_WTR_GET( - & HcoState, - & FLG_MBL_SLICE, ! I [flg] Mobilization candidate flag - & FRC_THR_NCR_WTR, ! O [frc] Factor by which moisture increases - ! threshold friction velocity - & MSS_FRC_CLY_SLICE, ! I [frc] Mass fraction of clay - & GWC_SFC) ! I [kg kg-1] Gravimetric water content - - !================================================================= - ! Now, compute basic threshold friction velocity for saltation - ! over dry, bare, smooth ground. fxm: Use surface density not - ! midlayer density - !================================================================= - CALL WND_FRC_THR_SLT_GET( - & HcoState, - & FLG_MBL_SLICE, ! I mobilisation flag - & DNS_MDP, ! I [kg m-3] Midlayer density - & WND_FRC_THR_SLT, ! O [m s-1] Threshold friction velocity - & RC ) - IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 20', RC, THISLOC=LOC ) - RETURN - ENDIF - - ! Adjust threshold friction velocity to account - ! for moisture and roughness - DO I = 1, HcoState%NX - WND_FRC_THR_SLT(I) = ! [m s-1] Threshold friction velocity - ! for saltation - & WND_FRC_THR_SLT(i) ! [m s-1] Threshold for dry, flat ground - & * FRC_THR_NCR_WTR(i) ! [frc] Adjustment for moisture - & * FRC_THR_NCR_DRG(i) ! [frc] Adjustment for roughness - ENDDO - - - !================================================================= - ! Saltation increases friction speed by roughening surface - ! i.e. Owen effect, Zender et al., expression (4) - ! - ! Compute the wind friction velocity due to saltation, U*,s - ! accounting for the Owen effect. - ! Comment out since WND_FRC_SLT is simply set to WND_FRC in this function - !================================================================= - !================================================================= - DO I = 1, HcoState%NX - WND_FRC_SLT(I) = WND_FRC(I) - ENDDO - - !================================================================= - ! Compute horizontal streamwise mass flux, Zender et al., expr. (10) - !================================================================= - CALL FLX_MSS_HRZ_SLT_TTL_WHI79_GET( - & HcoState, - & DNS_MDP, ! I [kg m-3] Midlayer density - & FLG_MBL_SLICE, ! I [flg] Mobilization candidate flag - & FLX_MSS_HRZ_SLT_TTL, ! O [kg m-1 s-1] Vertically integrated - ! streamwise mass flux - & WND_FRC_SLT, ! I [m s-1] Saltating friction velocity - & WND_FRC_THR_SLT ) ! I [m s-1] Threshold friction vel for saltation - -!----------------------------------------------------------------------------- -! Prior to 1/25/07: -! We now multiply by the GOCART source function, and we will ignore -! the MBL_BSN_FCT_SLICE. (tdf, bmy, 1/25/07) -! -! %%%%% DO NOT DELETE -- LEAVE THIS CODE COMMENTED OUT %%%%% -! -!ctdf...prior to Apr/05/06 -! ! Apply land surface and vegetation limitations -! ! and global tuning factor -! DO I = 1, HcoState%NX -! FLX_MSS_HRZ_SLT_TTL(I) = FLX_MSS_HRZ_SLT_TTL(I) ! [kg m-2 s-1] -! & * LND_FRC_MBL_SLICE(i) ! [frc] Bare ground fraction -! & * MBL_BSN_FCT_SLICE(i) ! [frc] Erodibility factor -! & * FLX_MSS_FDG_FCT ! [frc] Global mass flux tuning -! ! factor (empirical) -! ENDDO -!----------------------------------------------------------------------------- - - ! Now simply multiply by the GOCART source function. - ! The vegetation effect has been eliminated in LND_FRC_MBL_GET - ! and we also ignore MBL_BSN_FCT. (tdf, bmy, 1/25/07) - DO I = 1, HcoState%NX - FLX_MSS_HRZ_SLT_TTL(I) = FLX_MSS_HRZ_SLT_TTL(I) ! [kg m-2 s-1] - & * LND_FRC_MBL_SLICE(i) ! [frc] Bare ground fraction - & * Inst%FLX_MSS_FDG_FCT ! [frc] Global mass flux tuning - & * SRCE_FUNC_SLICE(I) ! GOCART source function - ENDDO - - !================================================================= - ! Compute vertical dust mass flux, see Zender et al., expr. (11). - !================================================================= - CALL FLX_MSS_VRT_DST_TTL_MAB95_GET( - & HcoState, - & DST_SLT_FLX_RAT_TTL, ! O [m-1] Ratio of vertical dust flux to - ! streamwise mass flux - & FLG_MBL_SLICE, ! I [flg] Mobilization candidate flag - & FLX_MSS_HRZ_SLT_TTL, ! I [kg/m/s] Vertically integrated - ! streamwise mass flux - & FLX_MSS_VRT_DST_TTL, ! O [kg/m2/s] Total vertical mass flux of dust - & MSS_FRC_CLY_SLICE ) ! I [frc] Mass fraction clay - - !================================================================= - ! Now, partition vertical dust mass flux into transport bins - ! - ! OVR_SRC_SNK_MSS needed in FLX_MSS_VRT_DST_PRT - ! computed in DST_PSD_MSS, called from "dust_mod.f" (tdf, 3/30/04) - !================================================================= - CALL FLX_MSS_VRT_DST_PRT( Inst, - & HcoState%NX, - & FLG_MBL_SLICE, ! I [flg] Mobilization candidate flag - & FLX_MSS_VRT_DST, ! O [kg m-2 s-1] Vertical mass flux of dust - & FLX_MSS_VRT_DST_TTL) ! I [kg m-2 s-1] Total vertical mass flux of dus - - !================================================================= - ! Mask dust mass flux by tracer mass fraction at source - !================================================================= - FLG_CACO3 = .FALSE. ! [flg] Activate CaCO3 tracer - IF ( FLG_CACO3 ) THEN - CALL FLX_MSS_CACO3_MSK( - & HcoState, - & ExtState, - & Inst%DMT_VWR, ! I [m] Mass weighted diameter resolved - & FLG_MBL_SLICE, ! I [flg] Mobilization candidate flag - & FLX_MSS_VRT_DST, ! I/O [kg m-2 s-1] Vert. mass flux of dust - & MSS_FRC_CACO3_SLICE, ! I [frc] Mass fraction of CaCO3 - & MSS_FRC_CLY_SLICE, ! I [frc] Mass fraction of clay - & MSS_FRC_SND_SLICE, ! I [frc] Mass fraction of sand - & RC ) - IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 21', RC, THISLOC=LOC ) - RETURN - ENDIF - endif - - ! Now, flx_mss_vrt_dst has units of kg/m2/sec - - ! Fluxes are known, so adjust mixing ratios - DO I=1, HcoState%NX ! NB: Inefficient loop order - IF (FLG_MBL_SLICE(I)) THEN - - ! Loop over dust bins - DO M = 1, NBINS - - !======================================================== - ! Compute dust mobilisation tendency. Recognise that - ! what GEOS-CHEM wants is an increment in kg...So, - ! multiply by DXYP [m2] and tm_adj [sec] - !======================================================== - - ! [kg/sec] - Q_DST_TND_MBL(I,M) = FLX_MSS_VRT_DST(I,M) - & *HcoState%Grid%AREA_M2%Val(I,LAT_IDX) - - ! Introduce DSRC: dust mixing ratio increment 12/9/2K3 - ! [kg] - DSRC(I,M) = TM_ADJ * Q_DST_TND_MBL(I,M) - - ENDDO - ENDIF - ENDDO - - ! Jump to here when no points are mobilization candidates - 737 CONTINUE - - RC = HCO_SUCCESS - - ! Return to calling program - END SUBROUTINE DST_MBL - -!------------------------------------------------------------------------------ - - SUBROUTINE SRCE_FUNC_GET( HcoState, Inst, LAT_IDX, SRCE_FUNC_OUT ) -! -!****************************************************************************** -! Subroutine SRCE_FUNC_GET returns a latitude slice of the GOCART source -! function. This routine is called by DST_MBL. (tdf, bmy, 1/25/07) -! -! Arguments as Input: -! ============================================================================ -! (1 ) LAT_IDX (INTEGER) : GEOS-Chem latitude index -! -! Arguments as Output: -! ============================================================================ -! (1 ) SRCE_FUNC_OUT (REAL*8 ) : GOCART source function [fraction] -! -! NOTES: -!****************************************************************************** -! - ! Arguments - TYPE(HCO_State), POINTER :: HcoState ! Hemco state - TYPE(MyInst), POINTER :: Inst - INTEGER, INTENT(IN) :: LAT_IDX - REAL*8, INTENT(OUT) :: SRCE_FUNC_OUT(HcoState%NX) - - ! Local variables - INTEGER :: LON_IDX - - !================================================================= - ! SRCE_FUNC_GET begins here! - !================================================================= - - ! Loop over longitudes - DO LON_IDX = 1, HcoState%NX - - ! Save latitude slice in SRCE_FUNC_OUT - SRCE_FUNC_OUT(LON_IDX) = Inst%SRCE_FUNC(LON_IDX,LAT_IDX) - - ENDDO - - ! Return to calling program - END SUBROUTINE SRCE_FUNC_GET - -!------------------------------------------------------------------------------ - - SUBROUTINE SOI_TXT_GET( HcoState, ExtState, Inst, J, - & LND_FRC_DRY_OUT, - & MBL_BSN_FCT_OUT, MSS_FRC_CACO3_OUT, - & MSS_FRC_CLY_OUT, MSS_FRC_SND_OUT ) -! -!****************************************************************************** -! Subroutine SOI_GET_TXT returns a latitude slice of soil texture to the -! calling program DST_MBL. (tdf, bmy, 3/30/04) -! -! Arguments as Input: -! ============================================================================ -! (1 ) J (INTEGER) : Grid box latitude index -! -! Arguments as Output: -! ============================================================================ -! (2 ) lnd_frc_dry_out (REAL*8 ) : Dry land fraction [fraction] -! (3 ) mbl_bsn_fct_out (REAL*8 ) : Erodibility factor [fraction] -! (4 ) mss_frc_CaCO3_out (REAL*8 ) : Mass fraction of CaCO3 [fraction] -! (5 ) mss_frc_cly_out (REAL*8 ) : Mass fraction of clay [fraction] -! (6 ) mss_frc_snd_out (REAL*8 ) : Mass fraction of sand [fraction] -! -! NOTES: -! (1 ) Updated comments, cosmetic changes (bmy, 3/30/04) -!****************************************************************************** -! - - ! Arguments - TYPE(HCO_State), POINTER :: HcoState ! Hemco state - TYPE(Ext_State), POINTER :: ExtState ! Module options - TYPE(MyInst), POINTER :: Inst - INTEGER, INTENT(IN) :: J - REAL*8, INTENT(OUT) :: LND_FRC_DRY_OUT(HcoState%NX) - REAL*8, INTENT(OUT) :: MBL_BSN_FCT_OUT(HcoState%NX) - REAL*8, INTENT(OUT) :: MSS_FRC_CACO3_OUT(HcoState%NX) - REAL*8, INTENT(OUT) :: MSS_FRC_CLY_OUT(HcoState%NX) - REAL*8, INTENT(OUT) :: MSS_FRC_SND_OUT(HcoState%NX) - - ! Local variables - INTEGER :: I - - ! Ad hoc globally uniform clay mass fraction [kg/kg] - REAL*8, PARAMETER :: MSS_FRC_CLY_GLB = 0.20d0 - - !================================================================= - ! SOI_GET_TXT begins here! - !================================================================= - DO I = 1, HcoState%NX - - ! Save dry land fraction slice - LND_FRC_DRY_OUT(I) = Inst%LND_FRC_DRY(I,J) - - ! Change surface source distribution to "geomorphic" tdf 12/12/2K3 - MBL_BSN_FCT_OUT(I) = Inst%ERD_FCT_GEO(I,J) - - !fxm: CaCO3 currently has missing value of - ! 1.0e36 which causes problems - IF ( Inst%MSS_FRC_CACO3(I,J) <= 1.0D0 ) THEN - MSS_FRC_CACO3_OUT(I) = Inst%MSS_FRC_CACO3(I,J) - ELSE - MSS_FRC_CACO3_OUT(I) = 0.0D0 - ENDIF - - ! fxm Temporarily set mss_frc_cly used in mobilization to globally - ! uniform SGS value of 0.20, and put excess mass fraction - ! into sand - MSS_FRC_CLY_OUT(I) = MSS_FRC_CLY_GLB - MSS_FRC_SND_OUT(I) = Inst%MSS_FRC_SND(I,J) + - & Inst%MSS_FRC_CLY(I,J) - - & MSS_FRC_CLY_GLB - - ENDDO - - ! Return to calling program - END SUBROUTINE SOI_TXT_GET - -!------------------------------------------------------------------------------ - - SUBROUTINE SFC_TYP_GET( HcoState, ExtState, - & Inst, J, SFC_TYP_OUT, RC ) -! -!****************************************************************************** -! Subroutine SFC_TYP_GET returns a latitude slice of LSM surface type -! to the calling programs DST_MBL & DST_DPS_DRY. (tdf, bmy, 3/30/04) -! -! Arguments as Input: -! ============================================================================ -! (1 ) J (INTEGER) : Grid box latitude index -! -! Arguments as Output: -! ============================================================================ -! (1 ) sfc_typ_out (REAL*8 ) : LSM surface type (0..28) [unitless] -! -! NOTES -! (1 ) Updated comments & cosmetic changes (bmy, 3/30/04) -! (2 ) Added error trap (ckeller, 7/24/2014) -!****************************************************************************** -! - - ! Arguments - TYPE(HCO_State), POINTER :: HcoState ! Hemco state - TYPE(Ext_State), POINTER :: ExtState - TYPE(MyInst), POINTER :: Inst - INTEGER, INTENT(IN) :: J - INTEGER, INTENT(OUT) :: SFC_TYP_OUT(HcoState%NX) - INTEGER, INTENT(INOUT) :: RC - - ! Local variables - INTEGER :: I, TMP - CHARACTER(LEN=255) :: MSG - - !================================================================= - ! SFC_TYP_GET begins here! - !================================================================= - DO I = 1, HcoState%NX - TMP = INT(Inst%SFC_TYP(I,J)) - - ! Make sure value is within valid range (1 - NN_SFCTYP). - SFC_TYP_OUT(I) = MAX( MIN(TMP,NN_SFCTYP), 0 ) - ENDDO - - ! Return with success - RC = HCO_SUCCESS - - ! Return to calling program - END SUBROUTINE SFC_TYP_GET ! end sfc_typ_get() - -!------------------------------------------------------------------------------ - - SUBROUTINE TPT_GND_SOI_GET( HcoState, J, TS, - & TPT_GND_OUT, TPT_SOI_OUT ) -! -!****************************************************************************** -! Subroutine TPT_GND_SOI_GET returns a latitude slice of soil temperature and -! ground temperature to the calling program DST_MBL. (tdf, bmy, 3/30/04) -! -! Arguments as Input: -! ============================================================================ -! (1 ) J (INTEGER) : Grid box latitude index -! (2 ) TS (REAL*8) : Surface temperature at 2m [K] -! -! Arguments as Output: -! ============================================================================ -! (2 ) TPT_GND_OUT (REAL*8 ) : Ground temperature array slice [K] -! (3 ) tpt_soi_out (REAL*8 ) : Soil temperature array slice [K] -! -! NOTES -! (1 ) Updated comments & cosmetic changes (bmy, 3/30/04) -!****************************************************************************** -! - - ! Arguments - INTEGER, INTENT(IN) :: J - TYPE(HCO_State), POINTER :: HcoState ! Hemco state - REAL(hp),INTENT(IN) :: TS(HcoState%NX,HcoState%NY) - REAL*8, INTENT(OUT) :: TPT_GND_OUT(HcoState%NX) - REAL*8, INTENT(OUT) :: TPT_SOI_OUT(HcoState%NX) - - ! Local variables - INTEGER :: I - - !================================================================= - ! TPT_GND_SOI_GET begins here! - !================================================================= - - ! Use TS from GEOS-CHEM (tdf, 3/30/04) - DO I = 1, HcoState%NX - TPT_GND_OUT(I) = TS(I,J) - TPT_SOI_OUT(I) = TS(I,J) - ENDDO - - ! Return to calling program - END SUBROUTINE TPT_GND_SOI_GET - -!------------------------------------------------------------------------------ - - SUBROUTINE VWC_SFC_GET( HcoState, J, GWETTOP, VWC_SFC_OUT ) -! -!****************************************************************************** -! Subroutine TPT_GND_SOI_GET returns a latitude slice of volumetric water -! content to the calling program DST_MBL. (tdf, bmy, 3/30/04) -! -! Arguments as Input: -! ============================================================================ -! (1 ) J (INTEGER) : Grid box latitude index -! (2 ) GWETTOP (REAL*8) : Top soil moisture [unitless] -! -! Arguments as Output: -! ============================================================================ -! VWC_SFC_OUT (REAL*8 ) : Volumetric water content [m3/m3] -! -! NOTES -! (1 ) Updated comments & cosmetic changes (bmy, 3/30/04) -!****************************************************************************** -! - - ! Arguments - INTEGER, INTENT(IN) :: J - TYPE(HCO_State), POINTER :: HcoState ! Hemco state - REAL(hp), INTENT(IN) :: GWETTOP(HcoState%NX,HcoState%NY) - REAL*8, INTENT(OUT) :: VWC_SFC_OUT(HcoState%NX) - - ! Local variables - INTEGER :: I - - !================================================================= - ! VWC_SFC_GET begins here! - !================================================================= - DO I = 1, HcoState%NX - VWC_SFC_OUT(I) = GWETTOP(I,J) - ENDDO - - ! Return to calling program - END SUBROUTINE VWC_SFC_GET - -!------------------------------------------------------------------------------ - - REAL*8 FUNCTION DSVPDT_H2O_LQD_PRK78_FST_SCL( TPT_CLS ) -! -!****************************************************************************** -! Function DSVPDT_H2O_LQD_PRK78_FST_SCL returns the derivative of saturation -! vapor pressure [Pa] over planar liquid water (tdf, bmy, 3/30/04) -! -! Arguments as Input: -! ============================================================================ -! (1 ) TPT_CLS (REAL*8) : Temperature in Celsius [C] -! -! NOTES: -! (1 ) Updated comments, cosmetic changes. Also now force double-precision -! with "D" exponents. (bmy, 3/30/04) -!****************************************************************************** -! - ! Arguments - REAL*8, INTENT(IN) :: TPT_CLS - - ! Local variables - REAL*8, PARAMETER :: C0 = 4.438099984d-01 - REAL*8, PARAMETER :: C1 = 2.857002636d-02 - REAL*8, PARAMETER :: C2 = 7.938054040d-04 - REAL*8, PARAMETER :: C3 = 1.215215065d-05 - REAL*8, PARAMETER :: C4 = 1.036561403d-07 - REAL*8, PARAMETER :: C5 = 3.532421810d-10 - REAL*8, PARAMETER :: C6 =-7.090244804d-13 - - !================================================================= - ! DSVPDT_H2O_LQD_PRK78_FST_SCL begins here! - !================================================================= - - ! Return deriv. of saturation vapor pressure [Pa] - DSVPDT_H2O_LQD_PRK78_FST_SCL = 100.0d0 * ( C0+TPT_CLS * - & ( C1+TPT_CLS * - & ( C2+TPT_CLS * - & ( C3+TPT_CLS * - & ( C4+TPT_CLS * - & ( C5+TPT_CLS * C6 )))))) - - ! Return to calling program - END FUNCTION DSVPDT_H2O_LQD_PRK78_FST_SCL - -!------------------------------------------------------------------------------ - - REAL*8 FUNCTION DSVPDT_H2O_ICE_PRK78_FST_SCL( TPT_CLS ) -! -!****************************************************************************** -! Function DSVPDT_H2O_ICE_PRK78_FST_SCL returns the derivative of saturation -! vapor pressure [Pa] over planar ice water (tdf, bmy, 3/30/04) -! -! Arguments as Input: -! ============================================================================ -! (1 ) TPT_CLS (REAL*8) : Temperature in Celsius [C] -! -! NOTES: -! (1 ) Updated comments, cosmetic changes. Also now force double-precision -! with "D" exponents. (bmy, 3/30/04) -!****************************************************************************** -! - ! Arguments - REAL*8, INTENT(IN) :: TPT_CLS - - ! Local variables - REAL*8, PARAMETER :: D0 = 5.030305237d-01 - REAL*8, PARAMETER :: D1 = 3.773255020d-02 - REAL*8, PARAMETER :: D2 = 1.267995369d-03 - REAL*8, PARAMETER :: D3 = 2.477563108d-05 - REAL*8, PARAMETER :: D4 = 3.005693132d-07 - REAL*8, PARAMETER :: D5 = 2.158542548d-09 - REAL*8, PARAMETER :: D6 = 7.131097725d-12 - - !================================================================= - ! DSVPDT_H2O_ICE_PRK78_FST_SCL begins here! - !================================================================= - - ! Return deriv. of sat vapor pressure [Pa] - DSVPDT_H2O_ICE_PRK78_FST_SCL = 100.0D0 * ( D0+TPT_CLS * - & ( D1+TPT_CLS * - & ( D2+TPT_CLS * - & ( D3+TPT_CLS * - & ( D4+TPT_CLS * - & ( D5+TPT_CLS * D6 )))))) - - ! Return to calling program - END FUNCTION DSVPDT_H2O_ICE_PRK78_FST_SCL - -!------------------------------------------------------------------------------ - - REAL*8 FUNCTION SVP_H2O_LQD_PRK78_FST_SCL( TPT_CLS ) -! -!****************************************************************************** -! Function SVP_H2O_LQD_PRK78_FST_SCL returns the saturation vapor pressure -! over planer liquid water [Pa] See Lowe and Ficke (1974) as reported in -! PrK78 p. 625. Range of validity is -50 C < T < 50 C. (tdf, bmy, 3/30/04) -! -! Arguments as Input: -! ============================================================================ -! (1 ) TPT_CLS (REAL*8) : Temperature in Celsius [C] -! -! NOTES: -! (1 ) Updated comments, cosmetic changes. Also now force double-precision -! with "D" exponents. (bmy, 3/30/04) -!****************************************************************************** -! - ! Arguments - REAL*8, INTENT(IN) :: TPT_CLS - - ! Local variables - REAL*8, PARAMETER :: A0 = 6.107799961d0 - REAL*8, PARAMETER :: A1 = 4.436518521d-01 - REAL*8, PARAMETER :: A2 = 1.428945805d-02 - REAL*8, PARAMETER :: A3 = 2.650648471d-04 - REAL*8, PARAMETER :: A4 = 3.031240396d-06 - REAL*8, PARAMETER :: A5 = 2.034080948d-08 - REAL*8, PARAMETER :: A6 = 6.136820929d-11 - - !================================================================= - ! SVP_H2O_LQD_PRK78_FST_SCL begins here! - !================================================================= - - ! Return saturation vapor pressure over liquid water [Pa] - SVP_H2O_LQD_PRK78_FST_SCL = 100.0D0 * ( A0+TPT_CLS * - & ( A1+TPT_CLS * - & ( A2+TPT_CLS * - & ( A3+TPT_CLS * - & ( A4+TPT_CLS * - & ( A5+TPT_CLS * A6 )))))) - - ! Return to calling program - END FUNCTION SVP_H2O_LQD_PRK78_FST_SCL - -!------------------------------------------------------------------------------ - - REAL*8 FUNCTION SVP_H2O_ICE_PRK78_FST_SCL( TPT_CLS ) -! -!****************************************************************************** -! Function SVP_H2O_ICE_PRK78_FST_SCL returns the saturation vapor pressure -! [Pa] over planar ice water (tdf, bmy, 3/30/04) -! -! Arguments as Input: -! ============================================================================ -! (1 ) TPT_CLS (REAL*8) : Temperature in Celsius [C] -! -! NOTES: -! (1 ) Updated comments, cosmetic changes. Also now force double-precision -! with "D" exponents. (bmy, 3/30/04) -!****************************************************************************** -! - - ! Arguments - REAL*8, INTENT(IN) :: TPT_CLS - - ! Local variables - REAL*8, PARAMETER :: B0 = 6.109177956d0 - REAL*8, PARAMETER :: B1 = 5.034698970d-01 - REAL*8, PARAMETER :: B2 = 1.886013408d-02 - REAL*8, PARAMETER :: B3 = 4.176223716d-04 - REAL*8, PARAMETER :: B4 = 5.824720280d-06 - REAL*8, PARAMETER :: B5 = 4.838803174d-08 - REAL*8, PARAMETER :: B6 = 1.838826904d-10 - - !================================================================= - ! SVP_H2O_ICE_PRK78_FST_SCL begins here! - !================================================================= - - ! Return saturation vapor pressure over ice [Pa] - SVP_H2O_ICE_PRK78_FST_SCL = 100.0D0 * ( B0+TPT_CLS * - & ( B1+TPT_CLS * - & ( B2+TPT_CLS * - & ( B3+TPT_CLS * - & ( B4+TPT_CLS * - & ( B5+TPT_CLS * B6 )))))) - - ! Return to calling program - END FUNCTION SVP_H2O_ICE_PRK78_FST_SCL - -!------------------------------------------------------------------------------ - - REAL*8 FUNCTION TPT_BND_CLS_GET( TPT ) -! -!****************************************************************************** -! Function TPT_BND_CLS_GET returns the bounded temperature in [C], -! (i.e., -50 < T [C] < 50 C), given the temperature in [K]. -! (tdf, bmy, 3/30/04) -! -! Arguments as Input: -! ============================================================================ -! (1 ) TPT (REAL*8) : Temperature in Kelvin [K] -! -! NOTES: -!****************************************************************************** -! - ! Arguments - REAL*8, INTENT(IN) :: TPT - - ! Local variables - REAL*8, PARAMETER :: TPT_FRZ_PNT=273.15 - - !================================================================= - ! TPT_BND_CLS_GET begins here! - !================================================================= - TPT_BND_CLS_GET = MIN( 50.0D0, MAX( -50.0D0, ( TPT-TPT_FRZ_PNT)) ) - - ! Return to calling program - END FUNCTION TPT_BND_CLS_GET - -!------------------------------------------------------------------------------ - - SUBROUTINE GET_ORO( HcoState, ExtState, OROGRAPHY, RC ) -! -! !USES: -! - USE HCO_GEOTOOLS_MOD, ONLY : HCO_LANDTYPE -! -!****************************************************************************** -! Subroutine GET_ORO creates a 2D orography array, OROGRAPHY, from the -! GMAO surface type fraction fields, based on definition of GMAO LWI, with -! modification to qualify land ice as ice. Ocean=0 (no ice); Land=1; Ice=2. -! -! Arguments as Output: -! ============================================================================ -! (1 ) OROGRAPHY (INTEGER) : Array for orography flags -! -! NOTES: -! (1 ) Added parallel DO-loop (bmy, 4/14/04) -! (2 ) Now modified for GCAP and GEOS-5 met fields (swu, bmy, 6/9/05) -! (3 ) Now use IS_LAND, IS_WATER, IS_ICE functions from "dao_mod.f" -! (bmy, 8/17/05) -! 09 Nov 2012 - M. Payer - Replaced all met field arrays with State_Met -! derived type object -!****************************************************************************** -! - - ! Arguments - TYPE(HCO_State), POINTER :: HcoState - Type(Ext_State), POINTER :: ExtState - INTEGER, INTENT(OUT ) :: OROGRAPHY(HcoState%NX, - & HcoState%NY) - INTEGER, INTENT(INOUT) :: RC - - ! Local variables - INTEGER :: I, J - - !================================================================= - ! GET_ORO begins here! - !================================================================= - -!$OMP PARALLEL DO -!$OMP+DEFAULT( SHARED ) -!$OMP+PRIVATE( I, J ) - DO J = 1, HcoState%NY - DO I = 1, HcoState%NX - - ! Set orography to from fraction land type - OROGRAPHY (I,J) = HCO_LANDTYPE( ExtState%FRLAND%Arr%Val(I,J), - & ExtState%FRLANDIC%Arr%Val(I,J), - & ExtState%FROCEAN%Arr%Val(I,J), - & ExtState%FRSEAICE%Arr%Val(I,J), - & ExtState%FRLAKE%Arr%Val(I,J) ) - - ENDDO - ENDDO -!$OMP END PARALLEL DO - - ! Return w/ success - RC = HCO_SUCCESS - - END SUBROUTINE GET_ORO - -!------------------------------------------------------------------------------ - - SUBROUTINE HYD_PRP_GET( HcoState, FLG_MBL, MSS_FRC_CLY_SLC, - & MSS_FRC_SND_SLC, VWC_DRY, VWC_OPT, - & VWC_SAT ) -! -!****************************************************************************** -! Subroutine HYD_PRP_GET determines hydrologic properties from soil texture. -! (tdf, bmy, 3/30/04) -! -! Arguments as Input: -! ============================================================================ -! (1 ) FLG_MBL (LOGICAL) : Mobilization candidate flag [unitless] -! (2 ) MSS_FRC_CLY (REAL*8 ) : Mass fraction clay [fraction] -! (3 ) MSS_FRC_SND (REAL*8 ) : Mass fraction sand [fraction] -! -! Arguments as Output: -! ============================================================================ -! (4 ) VWC_DRY (REAL*8 ) : Dry volumetric water content (no E-T) [m3/m3] -! (5 ) VWC_OPT (REAL*8 ) : E-T optimal volumetric water content [m3/m3] -! (6 ) VWC_SAT (REAL*8 ) : Saturated volumetric water content [m3/m3] -! -! NOTES: -! (1 ) All I/O for this routine is time-invariant, thus, the hydrologic -! properties could be computed once at initialization. However, -! FLG_MBL is time-dependent, so we should keep this as-is. -! (tdf, 10/27/03) -!****************************************************************************** -! - - ! Arguments - TYPE(HCO_State), POINTER :: HcoState - LOGICAL, INTENT(IN) :: FLG_MBL(HcoState%NX) - REAL*8, INTENT(IN) :: MSS_FRC_CLY_SLC(HcoState%NX) - REAL*8, INTENT(IN) :: MSS_FRC_SND_SLC(HcoState%NX) - REAL*8, INTENT(OUT) :: VWC_DRY(HcoState%NX) - REAL*8, INTENT(OUT) :: VWC_OPT(HcoState%NX) - REAL*8, INTENT(OUT) :: VWC_SAT(HcoState%NX) - - ! Local variables - INTEGER :: LON_IDX - - ! [frc] Exponent "b" for smp (clay-dependent) - REAL*8 :: SMP_XPN_B(HcoState%NX) - - ! [mm H2O] Saturated soil matric potential (sand-dependent) - REAL*8 :: SMP_SAT(HcoState%NX) - - !================================================================= - ! HYD_PRP_GET begins here - !================================================================= - - ! Initialize output values - VWC_DRY(:) = 0.0D0 - VWC_OPT(:) = 0.0D0 - VWC_SAT(:) = 0.0D0 - - ! Time-invariant soil hydraulic properties - ! See Bon96 p. 98, implemented in CCM:lsm/lsmtci() - DO LON_IDX = 1, HcoState%NX - - IF ( FLG_MBL(LON_IDX) ) THEN - - ! Exponent "b" for smp (clay-dependent) [fraction] - SMP_XPN_B(LON_IDX) = - & 2.91D0 +0.159D0 * MSS_FRC_CLY_SLC(LON_IDX) * 100.0D0 - - ! NB: Adopt convention that matric potential is positive definite - ! Saturated soil matric potential (sand-dependent) [mm H2O] - SMP_SAT(LON_IDX) = - & 10.0D0 * (10.0D0**(1.88D0-0.0131D0 - & * MSS_FRC_SND_SLC(LON_IDX)*100.0D0)) - - ! Saturated volumetric water content (sand-dependent) ! [m3 m-3] - VWC_SAT(LON_IDX)= - & 0.489D0 - 0.00126D0 * MSS_FRC_SND_SLC(LON_IDX)*100.0D0 - - ! [m3 m-3] - VWC_DRY(LON_IDX) = - - ! Dry volumetric water content (no E-T) - & VWC_SAT(LON_IDX)*(316230.0D0/SMP_SAT(LON_IDX)) - & **(-1.0D0/SMP_XPN_B(LON_IDX)) - - ! E-T optimal volumetric water content! [m3 m-3] - VWC_OPT(LON_IDX) = - & VWC_SAT(LON_IDX)*(158490.0D0/SMP_SAT(LON_IDX)) - & **(-1.0D0/SMP_XPN_B(LON_IDX)) - ENDIF - ENDDO - - ! Return to calling program - END SUBROUTINE HYD_PRP_GET - -!------------------------------------------------------------------------------ - - SUBROUTINE CND_TRM_SOI_GET( HcoState,CND_TRM_SOI,FLG_MBL,LVL_DLT, - & MSS_FRC_CLY_SLC, MSS_FRC_SND_SLC, - & TPT_SOI, - & VWC_DRY, VWC_OPT, VWC_SAT, - & VWC_SFC ) - -! -!****************************************************************************** -! Subroutine CND_TRM_SOI_GET gets thermal properties of soil. Currently this -! routine is optimized for ground without snow-cover. Although snow -! thickness is read in, it is not currently used. (tdf, bmy, 3/30/04) -! -! Arguments as Input: -! ============================================================================ -! (3 ) lvl_dlt (REAL*8 ) : Soil layer thickness [m ] -! (4 ) mss_frc_cly (REAL*8 ) : Mass fraction clay [frac.] -! (5 ) mss_frc_snd (REAL*8 ) : Mass fraction sand [frac.] -! (6 ) tpt_soi (REAL*8 ) : Soil temperature [K ] -! (7 ) vwc_dry (REAL*8 ) : Dry volumetric water content (no E-T) [m3/m3] -! (8 ) vwc_opt (REAL*8 ) : E-T optimal volumetric water content [m3/m3] -! (9 ) vwc_sat (REAL*8 ) : Saturated volumetric water content [m3/m3] -! (10) vwc_sfc (REAL*8 ) : Volumetric water content [m3/m3] -! -! Arguments as Output: -! ============================================================================ -! (1 ) CND_TRM_SOI (REAL*8 ) : Soil thermal conductivity [W/m/K] -! (2 ) FLG_MBL (LOGICAL) : Mobilization candidate flag [flag ] -! -! NOTES: -!****************************************************************************** -! - - ! Arguments - TYPE(HCO_State), POINTER :: HcoState - LOGICAL, INTENT(IN) :: FLG_MBL(HcoState%NX) - REAL*8, INTENT(IN) :: MSS_FRC_CLY_SLC(HcoState%NX) - REAL*8, INTENT(IN) :: MSS_FRC_SND_SLC(HcoState%NX) - REAL*8, INTENT(IN) :: TPT_SOI(HcoState%NX) - REAL*8, INTENT(IN) :: VWC_DRY(HcoState%NX) - REAL*8, INTENT(IN) :: VWC_OPT(HcoState%NX) - REAL*8, INTENT(IN) :: VWC_SAT(HcoState%NX) - REAL*8, INTENT(IN) :: VWC_SFC(HcoState%NX) - REAL*8, INTENT(OUT) :: CND_TRM_SOI(HcoState%NX) - REAL*8, INTENT(OUT) :: LVL_DLT(HcoState%NX) - - !------------ - ! Parameters - !------------ - - ! Thermal conductivity of ice water [W m-1 K-1] - REAL*8, PARAMETER :: CND_TRM_H2O_ICE = 2.2d0 - - ! Thermal conductivity of liquid water [W m-1 K-1] - REAL*8, PARAMETER :: CND_TRM_H2O_LQD = 0.6d0 - - ! Thermal conductivity of snow Bon96 p. 77 [W m-1 K-1] - REAL*8, PARAMETER :: CND_TRM_SNW = 0.34d0 - - ! Soil layer thickness, top layer! [m] - REAL*8, PARAMETER :: LVL_DLT_SFC = 0.1d0 - - ! Temperature range of mixed phase soil [K] - REAL*8, PARAMETER :: TPT_DLT = 0.5d0 - - ! Latent heat of fusion of H2O at 0 C, standard [J kg-1] - REAL*8, PARAMETER :: LTN_HEAT_FSN_H2O_STD = 0.3336d06 - - ! Liquid water density [kg/m3] - REAL*8, PARAMETER :: DNS_H2O_LQD_STD = 1000.0d0 - - ! Kelvin--Celsius scale offset Bol80 [K] - REAL*8, PARAMETER :: TPT_FRZ_PNT = 273.15d0 - - !----------------- - ! Local variables - !----------------- - - ! Longitude index - INTEGER :: LON_IDX - - ! Thermal conductivity of dry soil [W m-1 K-1] - REAL*8 :: CND_TRM_SOI_DRY(HcoState%NX) - - ! Soil thermal conductivity, frozen [W m-1 K-1] - REAL*8 :: CND_TRM_SOI_FRZ(HcoState%NX) - - ! Thermal conductivity of soil solids [W m-1 K-1] - REAL*8 :: CND_TRM_SOI_SLD(HcoState%NX) - - ! Soil thermal conductivity, unfrozen [W m-1 K-1] - REAL*8 :: CND_TRM_SOI_WRM(HcoState%NX) - - ! Volumetric latent heat of fusion [J m-3] - REAL*8 :: LTN_HEAT_FSN_VLM(HcoState%NX) - - ! Bounded geometric bulk thickness of snow [m] - REAL*8 :: SNW_HGT_BND - - !================================================================= - ! CND_TRM_SOI_GET begins here! - !================================================================= - - ! [m] Soil layer thickness - LVL_DLT(:) = LVL_DLT_SFC - - ! [W m-1 K-1] Soil thermal conductivity - CND_TRM_SOI(:) = 0.0D0 - - ! Loop over longitude - DO LON_IDX = 1, HcoState%NX - IF ( FLG_MBL(LON_IDX) ) THEN - - ! Volumetric latent heat of fusion [J m-3] - LTN_HEAT_FSN_VLM(LON_IDX) = VWC_SFC(LON_IDX) - & * LTN_HEAT_FSN_H2O_STD * DNS_H2O_LQD_STD - - !Thermal conductivity of soil solids Bon96 p. 77 [W/m/K] - CND_TRM_SOI_SLD(LON_IDX) = - & ( 8.80D0 *MSS_FRC_SND_SLC(LON_IDX) - & + 2.92D0 *MSS_FRC_CLY_SLC(LON_IDX) ) - & / (MSS_FRC_SND_SLC(LON_IDX) - & + MSS_FRC_CLY_SLC(LON_IDX)) - - ! Thermal conductivity of dry soil Bon96 p. 77 [W/m/K] - cnd_trm_soi_dry(lon_idx) = 0.15D0 - - ! Soil thermal conductivity, unfrozen [W/m/K] - CND_TRM_SOI_WRM(LON_IDX) = - & CND_TRM_SOI_DRY(LON_IDX) - & + ( CND_TRM_SOI_SLD(LON_IDX) - & ** (1.0D0-VWC_SAT(LON_IDX)) - & * (CND_TRM_H2O_LQD ** VWC_SFC(LON_IDX) ) - & - CND_TRM_SOI_DRY(LON_IDX) ) - & * VWC_SFC(LON_IDX) / VWC_SAT(lon_idx) - - ! Soil thermal conductivity, frozen [W/m/K] - CND_TRM_SOI_FRZ(LON_IDX) = - & CND_TRM_SOI_DRY(LON_IDX) - & + ( CND_TRM_SOI_SLD(LON_IDX) - & ** (1.0D0-VWC_SAT(LON_IDX)) - & * (CND_TRM_H2O_ICE ** VWC_SFC(LON_IDX) ) - & - CND_TRM_SOI_DRY(LON_IDX) ) - & * VWC_SFC(LON_IDX) / VWC_SAT(LON_IDX) - - IF (TPT_SOI(LON_IDX) < TPT_FRZ_PNT-TPT_DLT) THEN - ! Soil thermal conductivity [W/m/K] - CND_TRM_SOI(LON_IDX) = CND_TRM_SOI_FRZ(LON_IDX) - ENDIF - - IF ( (TPT_SOI(LON_IDX) >= TPT_FRZ_PNT-TPT_DLT) - & .AND. (TPT_SOI(LON_IDX) <= TPT_FRZ_PNT+TPT_DLT) ) - & THEN - - ! Soil thermal conductivity [W/m/K] - CND_TRM_SOI(LON_IDX) = - & CND_TRM_SOI_FRZ(LON_IDX) - & + (CND_TRM_SOI_FRZ(LON_IDX) - & - CND_TRM_SOI_WRM(LON_IDX) ) - & * (TPT_SOI(LON_IDX) - & -TPT_FRZ_PNT+TPT_DLT) - & / (2.0D0*TPT_DLT) - ENDIF - - IF (TPT_SOI(LON_IDX) > TPT_FRZ_PNT+TPT_DLT) THEN - ! Soil thermal conductivity[W/m/K] - CND_TRM_SOI(LON_IDX)=CND_TRM_SOI_WRM(LON_IDX) - ENDIF - -! Implement this later(??) -!cZ Blend snow into first soil layer -!cZ Snow is not allowed to cover dust mobilization regions -!cZ snw_hgt_bnd=min(snw_hgt(lon_idx),1.0D0) ! [m] Bounded geometric bulk thickness of snow -!cZ lvl_dlt_snw(lon_idx)=lvl_dlt(lon_idx)+snw_hgt_bnd ! O [m] Soil layer thickness -!cZ including snow Bon96 p. 77 -! -!cZ cnd_trm_soi(lon_idx)= & ! [W m-1 K-1] Soil thermal conductivity Bon96 p. 77 -!cZ cnd_trm_snw*cnd_trm_soi(lon_idx)*lvl_dlt_snw(lon_idx) & -!cZ /(cnd_trm_snw*lvl_dlt(lon_idx)+cnd_trm_soi(lon_idx)*snw_hgt_bnd) - - ENDIF - ENDDO - - END SUBROUTINE CND_TRM_SOI_GET - -!------------------------------------------------------------------------------ - - SUBROUTINE TRN_FSH_VPR_SOI_ATM_GET( HcoState, FLG_MBL, - & TPT_SOI, - & TPT_SOI_FRZ, - & TRN_FSH_VPR_SOI_ATM, - & VWC_DRY, - & VWC_OPT, - & VWC_SFC ) -! -!****************************************************************************** -! Subroutine TRN_FSH_VPR_SOI_ATM_GET computes the factor describing effects -! of soil texture and moisture on vapor transfer between soil and atmosphere. -! Taken from Bon96 p. 59, CCM:lsm/surphys. (tdf, bmy, 3/30/04) -! -! The TRN_FSH_VPR_SOI_ATM efficiency factor attempts to tie soil texture and -! moisture properties to the vapor conductance of the soil-atmosphere system. -! When the soil temperature is sub-freezing, the conductance describes the -! resistance to vapor sublimation (or deposition) and transport through the -! open soil pores to the atmosphere. -! -! For warm soils, vapor transfer is most efficient at the optimal VWC for E-T -! Thus when vwc_sfc = vwc_opt, soil vapor transfer is perfectly efficient -! (trn_fsh_vpr_soi_atm = 1.0) so the soil does not contribute any resistance -! to the surface vapor transfer. -! -! When vwc_sfc > vwc_opt, the soil has an excess of moisture and, again, -! vapor transfer is not limited by soil characteristics. -! In fact, according to Bon96 p. 98, vwc_dry is only slightly smaller than -! vwc_opt, so trn_fsh_vpr_soi_atm is usually either 0 or 1 and intermediate -! efficiencies occur over only a relatively small range of VWC. -! -! When vwc_sfc < vwc_dry, the soil matrix is subsaturated and acts as a -! one-way sink for vapor through osmotic and capillary potentials. -! In this case trn_fsh_vpr_soi_atm = 0, which would cause the surface -! resistance rss_vpr_sfc to blow up, but this is guarded against and -! rss_sfc_vpr is set to ~1.0e6*rss_aer_vpr instead. -! -! Note that this formulation does not seem to allow vapor transfer from -! the atmosphere to the soil when vwc_sfc < vwc_dry, even when -! e_atm > esat(Tg). -! -! Air at the apparent sink for moisture is has vapor pressure e_sfc -! e_atm = Vapor pressure of ambient air at z = hgt_mdp -! e_sfc = Vapor pressure at apparent sink for moisture at z = zpd + rgh_vpr -! e_gnd = Vapor pressure at air/ground interface temperature -! Air at the soil interface is assumed saturated, i.e., e_gnd = esat(Tg) -! -! Arguments as Input: -! ============================================================================ -! (1 ) FLG_MBL (LOGICAL) : Mobilization candidate flag [unitless] -! (2 ) TPT_SOI (REAL*8 ) : Soil temperature [K ] -! (3 ) TPT_SOI_FRZ (REAL*8 ) : Temperature of frozen soil [K ] -! (5 ) VWC_DRY (REAL*8 ) : Dry volumetric WC (no E-T) [m3/m3 ] -! (6 ) VWC_OPT (REAL*8 ) : E-T optimal volumetric WC [m3/m3 ] -! (7 ) VWC_SFC (REAL*8 ) : Volumetric water content [m3/m3 ] -! -! Arguments as Output: -! ============================================================================ -! (4 ) TRN_FSH_VPR_SOI_ATM (REAL*8 ) : Transfer efficiency of vapor from -! soil to atmosphere [fraction] -! -! NOTES: -! (1 ) Updated comments, cosmetic changes. Also force double-precision -! with "D" exponents. (tdf, bmy, 3/30/04) -!****************************************************************************** -! - - !---------------- - ! Arguments - !---------------- - TYPE(HCO_State), POINTER :: HCoState - LOGICAL, INTENT(IN) :: FLG_MBL(HcoState%NX) - REAL*8, INTENT(IN) :: TPT_SOI(HcoState%NX) - REAL*8, INTENT(IN) :: TPT_SOI_FRZ - REAL*8, INTENT(IN) :: VWC_DRY(HcoState%NX) - REAL*8, INTENT(IN) :: VWC_OPT(HcoState%NX) - REAL*8, INTENT(IN) :: VWC_SFC(HcoState%NX) - REAL*8, INTENT(OUT) :: TRN_FSH_VPR_SOI_ATM(HcoState%NX) - - !---------------- - ! Parameters - !---------------- - - ! Transfer efficiency of vapor from frozen soil to - ! atmosphere CCM:lsm/surphy() [fraction] - REAL*8, PARAMETER :: TRN_FSH_VPR_SOI_ATM_FRZ = 0.01D0 - - !----------------- - ! Local variables - !----------------- - INTEGER :: LON_IDX - - !================================================================= - ! TRN_FSH_VPR_SOI_ATM_GET - !================================================================= - TRN_FSH_VPR_SOI_ATM(:) = 0.0D0 - - ! Loop over longitudes - DO LON_IDX = 1, HcoState%NX - - ! If this is a mobilization candidate ... - IF ( FLG_MBL(LON_IDX) ) THEN - - ! ... and if the soil is above freezing ... - IF ( TPT_SOI(LON_IDX) > TPT_SOI_FRZ ) THEN - - ! Transfer efficiency of cvapor from soil to atmosphere [frac] - ! CCM:lsm/surphys Bon96 p. 59 - TRN_FSH_VPR_SOI_ATM(LON_IDX) = - & MIN ( MAX(VWC_SFC(LON_IDX)-VWC_DRY(LON_IDX), 0.0D0) - & /(VWC_OPT(LON_IDX)-VWC_DRY(LON_IDX)), 1.0D0) - - ELSE - - ! [frc] Bon96 p. 59 - TRN_FSH_VPR_SOI_ATM(LON_IDX) = TRN_FSH_VPR_SOI_ATM_FRZ - - ENDIF - ENDIF - ENDDO - - ! Return to calling program - END SUBROUTINE TRN_FSH_VPR_SOI_ATM_GET - -!------------------------------------------------------------------------------ - - SUBROUTINE BLM_MBL( HcoState, FLG_MBL, RGH_MMN, - & WND_10M, MNO_LNG, WND_FRC, RC ) -! -!****************************************************************************** -! Subroutine BLM_MBL computes the boundary-layer exchange properties, given -! the meteorology at the GEOS-CHEM layer midpoint. This routine is optimized -! for dust source regions: dry, bare, uncovered land. Theory and algorithms: -! Bonan (1996) CCM:lsm/surtem(). Stripped down version, based on adiabatic -! approximation to U*. (tdf, bmy, 3/30/04) -! -! Arguments as Input: -! ============================================================================ -! (1 ) FLG_MBL (LOGICAL) : Mobilization candidate flag [unitless] -! (2 ) RGH_MMN (REAL*8 ) : Roughness length momentum [m ] -! (3 ) WND_10M (REAL*8 ) : 10 m wind speed [m/s ] -! -! Arguments as Output: -! ============================================================================ -! (4 ) MNO_LNG (REAL*8 ) : Monin-Obukhov length [m ] -! (5 ) WND_FRC (REAL*8 ) : Surface friction velocity [m/s ] -! -! NOTES: -! (1 ) Updated comments, cosmetic changes. Also force double-precision with -! "D" exponents. (tdf, bmy, 3/30/04) -!****************************************************************************** -! - !----------------- - ! Arguments - !----------------- - TYPE(HCO_State), POINTER :: HcoState - LOGICAL, INTENT(IN) :: FLG_MBL(HcoState%NX) - REAL*8, INTENT(IN) :: RGH_MMN(HcoState%NX) - REAL*8, INTENT(IN) :: WND_10M(HcoState%NX) - REAL*8, INTENT(OUT) :: MNO_LNG(HcoState%NX) - REAL*8, INTENT(OUT) :: WND_FRC(HcoState%NX) - INTEGER, INTENT(INOUT) :: RC - - !----------------- - ! Parameters - !----------------- - - ! Prevents division by zero [unitless] - REAL*8, PARAMETER :: EPS_DBZ = 1.0d-6 - - ! Minimum windspeed used for mobilization [m/s] - REAL*8, PARAMETER :: WND_MIN_MBL = 1.0d0 - - ! Roughness length momentum for erodible surfaces [m] - ! MaB95 p. 16420, GMB98 p. 6205 - REAL*8, PARAMETER :: RGH_MMN_MBL = 100.0d-6 - - ! Reference height for mobilization processes [m] - REAL*8, PARAMETER :: HGT_RFR = 10.0d0 - - !----------------- - ! Local variables - !----------------- - - ! Counting index for lon - INTEGER :: LON_IDX - - ! Denominator of Monin-Obukhov length Bon96 p. 49 - REAL*8 :: MNO_DNM - - ! Surface layer mean wind speed [m/s] - REAL*8 :: WND_MDP_BND(HcoState%NX) - - ! denominator for wind friction velocity - REAL*8 :: WND_FRC_DENOM - - ! For error handling - CHARACTER(LEN=255) :: MSG - - !================================================================= - ! BLM_MBL begins here! - !================================================================= - - ! Initialize - MNO_LNG(:) = 0.0D0 - WND_FRC(:) = 0.0D0 - - ! Loop over longitudes - DO LON_IDX = 1, HcoState%NX - - ! Surface layer mean wind speed bounded [m/s] - WND_MDP_BND(LON_IDX) = - & MAX(WND_10M(LON_IDX), WND_MIN_MBL) - - ! Friction velocity (adiabatic approximation S&P equ. 16.57, - ! tdf 10/27/2K3 -- Sanity check - IF ( RGH_MMN(LON_IDX) <= 0.0 ) THEN - MSG = 'RGH_MMN <= 0.0' - CALL HCO_ERROR(MSG,RC,THISLOC='BLM_MBL') - RETURN - ENDIF - - ! Distinguish between mobilisation candidates and noncandidates - IF ( FLG_MBL(LON_IDX) ) THEN - WND_FRC_DENOM = HGT_RFR / RGH_MMN_MBL ! z = 10 m - ELSE - WND_FRC_DENOM = HGT_RFR / RGH_MMN(LON_IDX) ! z = 10 m - ENDIF - - ! Sanity check - IF ( WND_FRC_DENOM <= 0.0 ) THEN - MSG = 'WND_FRC_DENOM <= 0.0' - CALL HCO_ERROR(MSG,RC,THISLOC='BLM_MBL') - RETURN - ENDIF - - ! Take natural LOG of WND_FRC_DENOM - WND_FRC_DENOM = LOG(WND_FRC_DENOM) - - ! Convert to [m/s] - WND_FRC(LON_IDX) = WND_MDP_BND(LON_IDX) * CST_VON_KRM - & / WND_FRC_DENOM - - ! Denominator of Monin-Obukhov length Bon96 p. 49 - ! Set denominator of Monin-Obukhov length to minimum value - MNO_DNM = EPS_DBZ - - ! Monin-Obukhov length Bon96 p. 49 [m] - MNO_LNG(LON_IDX) = -1.0D0 * (WND_FRC(LON_IDX)**3.0D0) - & /MNO_DNM - - ! Override for non mobilisation candidates - IF ( .NOT. FLG_MBL(LON_IDX) ) THEN - WND_FRC(LON_IDX) = 0.0D0 - ENDIF - ENDDO - - ! Return w/ success - RC = HCO_SUCCESS - - END SUBROUTINE BLM_MBL - -!------------------------------------------------------------------------------ - - LOGICAL FUNCTION ORO_IS_OCN( ORO_VAL ) -! -!****************************************************************************** -! Function ORO_IS_OCN returns TRUE if a grid box contains more than 50% -! ocean. (tdf, bmy, 3/30/04) -! -! Arguments as Input: -! ============================================================================ -! (1 ) ORO_VAL (REAL*8) : Orography at a grid box (0=ocean; 1=land; 2=ice) -! -! NOTES: -!****************************************************************************** -! - ! Arguments - REAL*8, INTENT(IN) :: ORO_VAL - - !================================================================= - ! ORO_IS_OCN begins here! - !================================================================= - ORO_IS_OCN = ( NINT( ORO_VAL ) == 0 ) - - ! Return to calling program - END FUNCTION ORO_IS_OCN - -!------------------------------------------------------------------------------ - - LOGICAL FUNCTION ORO_IS_LND( ORO_VAL ) -! -!****************************************************************************** -! Function ORO_IS_LND returns TRUE if a grid box contains more than 50% -! land. (tdf, bmy, 3/30/04, 3/1/05) -! -! Arguments as Input: -! ============================================================================ -! (1 ) ORO_VAL (REAL*8) : Orography at a grid box (0=ocean; 1=land; 2=ice) -! -! NOTES: -! (1 ) Bug fix: Replaced ": :" with "::" in order to prevent compile error -! on Linux w/ PGI compiler. (bmy, 3/1/05) -!****************************************************************************** -! - ! Arguments - REAL*8, INTENT(IN) :: ORO_VAL - - !================================================================= - ! ORO_IS_OCN begins here! - !================================================================= - ORO_IS_LND = ( NINT( ORO_VAL ) == 1 ) - - ! Return to calling program - END FUNCTION ORO_IS_LND - -!------------------------------------------------------------------------------ - - LOGICAL FUNCTION ORO_IS_ICE( ORO_VAL ) -! -!****************************************************************************** -! Function ORO_IS_LND returns TRUE if a grid box contains more than 50% -! ice. (tdf, bmy, 3/30/04) -! -! Arguments as Input: -! ============================================================================ -! (1 ) ORO_VAL (REAL*8) : Orography at a grid box (0=ocean; 1=land; 2=ice) -! -! NOTES: -!****************************************************************************** -! - ! Arguments - REAL*8, INTENT(IN) :: ORO_VAL - - !================================================================= - ! ORO_IS_ICE begins here! - !================================================================= - ORO_IS_ICE = ( NINT( ORO_VAL ) == 2 ) - - ! Return to calling program - END FUNCTION ORO_IS_ICE - -!------------------------------------------------------------------------------ - - REAL*8 FUNCTION MNO_STB_CRC_HEAT_UNS_GET( SML_FNC_MMN_UNS_RCP ) -! -!****************************************************************************** -! Function MNO_STB_CRC_HEAT_UNS_GET returns the stability correction factor -! for heat (usually called PSI), given the reciprocal of the Monin-Obukhov -! similarity function (usually called PHI) for momentum in an unstable -! atmosphere. (tdf, bmy, 3/30/04) -! -! Arguments as Input: -! ============================================================================ -! (1 ) sml_fnc_mmn_uns_rcp (REAL*8) : 1/(M-O similarity function) [fraction] -! -! References: -! ============================================================================ -! References are Ary88 p. 167, Bru82 p. 71, SeP97 p. 869, -! Bon96 p. 52, BKL97 p. F1, LaP81 p. 325, LaP82 p. 466 -! Currently this function is BFB with CCM:dom/flxoce() -! -! NOTES: -! (1 ) Updated comments, cosmetic changes (bmy, 3/30/04) -!****************************************************************************** -! - ! Arguments - REAL*8, INTENT(IN) :: SML_FNC_MMN_UNS_RCP - - !================================================================= - ! MNO_STB_CRC_HEAT_UNS_GET - !================================================================= - MNO_STB_CRC_HEAT_UNS_GET = 2.0D0 * - & LOG( ( 1.0D0+SML_FNC_MMN_UNS_RCP * SML_FNC_MMN_UNS_RCP) / 2.0D0 ) - - ! Return to calling program - END FUNCTION MNO_STB_CRC_HEAT_UNS_GET - -!------------------------------------------------------------------------------ - - REAL*8 FUNCTION MNO_STB_CRC_MMN_UNS_GET( SML_FNC_MMN_UNS_RCP ) -! -!****************************************************************************** -! Function MNO_STB_CRC_MMN_UNS_GET returns the stability correction factor -! for momentum (usually called PSI), given the reciprocal of the -! Monin-Obukhov similarity function (usually called PHI), for momentum in -! an unstable atmosphere. (tdf, bmy, 3/30/04) -! -! Arguments as Input: -! ============================================================================ -! (1 ) SML_FNC_MMN_UNS_RCP (REAL*8) : 1/(M-O similarity function) [fraction] -! -! References: -! ============================================================================ -! References are Ary88 p. 167, Bru82 p. 71, SeP97 p. 869, -! Bon96 p. 52, BKL97 p. F1, LaP81 p. 325, LaP82 p. 466 -! Currently this function is BFB with CCM:dom/flxoce() -! -! NOTES: -! (1 ) Updated comments, cosmetic changes (bmy, 3/30/04) -!****************************************************************************** -! - ! Arguments - REAL*8, INTENT(IN) :: SML_FNC_MMN_UNS_RCP - - !================================================================= - ! MNO_STB_CRC_MMN_UNS_GET begins here! - !================================================================= - MNO_STB_CRC_MMN_UNS_GET = - & LOG((1.0D0+SML_FNC_MMN_UNS_RCP*(2.0D0+SML_FNC_MMN_UNS_RCP)) - & *(1.0D0+SML_FNC_MMN_UNS_RCP*SML_FNC_MMN_UNS_RCP)/8.0D0) - & -2.0D0*ATAN(SML_FNC_MMN_UNS_RCP)+1.571D0 - - ! Return to calling program - END FUNCTION MNO_STB_CRC_MMN_UNS_GET - -!------------------------------------------------------------------------------ - - REAL*8 FUNCTION XCH_CFF_MMN_OCN_NTR_GET( WND_10M_NTR ) -! -!****************************************************************************** -! Function XCH_CFF_MMN_OCN_NTR_GET returns the Neutral 10m drag coefficient -! over oceans. (tdf, bmy, 3/30/04) -! -! Arguments as Input: -! ============================================================================ -! (1 ) WIND_10M_NTR (REAL*8) : Wind speed @ 10 m[m/s] -! -! References: -! ============================================================================ -! LaP82 CCM:dom/flxoce(), NOS97 p. I2 -! -! NOTES: -! (1 ) Updated comments, cosmetic changes (bmy, 3/30/04) -!****************************************************************************** -! - ! Arguments - REAL*8, INTENT(IN) :: WND_10M_NTR - - !================================================================= - ! XCH_CFF_MMN_OCN_NTR_GET begins here! - !================================================================= - XCH_CFF_MMN_OCN_NTR_GET = 0.0027D0 / WND_10M_NTR + 0.000142D0 - & + 0.0000764D0 * WND_10M_NTR - - ! REturn to calling program - END FUNCTION XCH_CFF_MMN_OCN_NTR_GET - -!------------------------------------------------------------------------------ - - SUBROUTINE RGH_MMN_GET( HcoState,Inst,ORO, RGH_MMN, - & SFC_TYP_SLC, SNW_FRC, WND_10M, RC ) -! -!****************************************************************************** -! Subroutine RGH_MMN_GET sets the roughness length. (tdf, bmy, 3/30/04) -! -! Arguments as Input: -! ============================================================================ -! (1 ) ORO (INTEGER) : Orography (0=ocean; 1=land; 2=ice) [unitless] -! (3 ) SFC_TYP (REAL*8 ) : LSM surface type (0..28) [unitless] -! (4 ) SNW_FRC (REAL*8 ) : Fraction of surface covered by snow [fraction] -! (5 ) WND_10M (REAL*8 ) : 10 m wind speed [m/s ] -! -! Arguments as Output: -! ============================================================================ -! (2 ) RGH_MMN (REAL*8 ) : Roughness length momentu [m ] -! -! NOTES: -! (1 ) Updated comments, cosmetic changes. Also now force double-precision -! with "D" exponents (bmy, 3/30/04) -!****************************************************************************** -! - - !----------------- - ! Arguments - !----------------- - TYPE(HCO_State), POINTER :: HcoState - TYPE(MyInst), POINTER :: Inst - INTEGER, INTENT(IN) :: SFC_TYP_SLC(HcoState%NX) - REAL*8, INTENT(IN) :: ORO(HcoState%NX) - REAL*8, INTENT(IN) :: SNW_FRC(HcoState%NX) - REAL*8, INTENT(IN) :: WND_10M(HcoState%NX) - REAL*8, INTENT(OUT) :: RGH_MMN(HcoState%NX) - INTEGER, INTENT(INOUT) :: RC - - !----------------- - ! Parameters - !----------------- - - ! Roughness length over frozen lakes Bon96 p. 59 [m] - REAL*8, PARAMETER :: RGH_MMN_ICE_LAK = 0.04d0 - - ! Roughness length over ice, bare ground, wetlands Bon96 p. 59 [m] - REAL*8, PARAMETER :: RGH_MMN_ICE_LND = 0.05d0 - - ! Roughness length over sea ice BKL97 p. F-3 [m] - REAL*8, PARAMETER :: RGH_MMN_ICE_OCN = 0.0005d0 - - ! Roughness length over unfrozen lakes Bon96 p. 59 [m] - REAL*8, PARAMETER :: RGH_MMN_LAK_WRM = 0.001d0 - - ! Roughness length over snow Bon96 p. 59 CCM:lsm/snoconi.F ! [m] - REAL*8, PARAMETER :: RGH_MMN_SNW = 0.04d0 - - ! Minimum windspeed for momentum exchange - REAL*8, PARAMETER :: WND_MIN_DPS = 1.0d0 - - !----------------- - ! Local variables - !----------------- - - ! [idx] Longitude index array (sea ice) - INTEGER :: ICE_IDX(HcoState%NX) - - ! [nbr] Number of sea ice points - INTEGER :: ICE_NBR - - ! [Idx] Counting index - INTEGER :: IDX_IDX - - ! [idx] Longitude index array (land) - INTEGER :: LND_IDX(HcoState%NX) - - ! [nbr] Number of land points - INTEGER :: LND_NBR - - ! [idx] Counting index - INTEGER :: LON_IDX - - ! [idx] Longitude index array (ocean) - INTEGER :: OCN_IDX(HcoState%NX) - - ! [nbr] Number of ocean points - INTEGER :: OCN_NBR - - ! [idx] Plant type index - INTEGER :: PLN_TYP_IDX - - ! [idx] Surface type index - INTEGER :: SFC_TYP_IDX - - ! [idx] Surface sub-gridscale index - INTEGER :: SGS_IDX - - ! [m] Roughness length of current sub-gridscale - REAL*8 :: RLM_CRR - - ! [m s-1] Bounded wind speed at 10 m - REAL*8 :: WND_10M_BND - - ! [frc] Neutral 10 m drag coefficient over ocean - REAL*8 :: XCH_CFF_MMN_OCN_NTR - - ! Momentum roughness length [m] - REAL*8 :: Z0MVT(MVT) = (/ 0.94d0, 0.77d0, 2.62d0, 1.10d0, 0.99d0, - & 0.06d0, 0.06d0, 0.06d0, 0.06d0, 0.06d0, - & 0.06d0, 0.06d0, 0.06d0, 0.00d0 /) - - ! Displacement height (fn of plant type) - REAL*8 :: ZPDVT(MVT) = (/ 11.39d0, 9.38d0, 23.45d0, 13.40d0, - & 12.06d0, 0.34d0, 0.34d0, 0.34d0, - & 0.34d0, 0.34d0, 0.34d0, 0.34d0, - & 0.34d0, 0.00d0 /) - - !================================================================= - ! RGH_MMN_GET begins here - !================================================================= - RGH_MMN(:) = 0.0D0 - - ! Count ocean grid boxes - OCN_NBR = 0 - DO LON_IDX = 1, HcoState%NX - IF ( ORO_IS_OCN( ORO(LON_IDX) ) ) THEN - OCN_NBR = OCN_NBR + 1 - OCN_IDX(OCN_NBR) = LON_IDX - ENDIF - ENDDO - - ! Count ice grid boxes - ICE_NBR = 0 - DO LON_IDX = 1, HcoState%NX - IF ( ORO_IS_ICE( ORO(LON_IDX) ) ) THEN - ICE_NBR = ICE_NBR+1 - ICE_IDX(ICE_NBR) = LON_IDX - ENDIF - ENDDO - - ! Count land grid boxes - LND_NBR = 0 - DO LON_IDX = 1, HcoState%NX - IF ( ORO_IS_LND( ORO(LON_IDX) ) ) THEN - LND_NBR = LND_NBR + 1 - LND_IDX(LND_NBR) = LON_IDX - ENDIF - ENDDO - - !================================================================= - ! Ocean points - !================================================================= - DO IDX_IDX = 1, OCN_NBR - - ! Longitude index of the ocean point - LON_IDX = OCN_IDX(IDX_IDX) - - ! Convert wind speed to roughness length over ocean [m/s] - WND_10M_BND = MAX( WND_MIN_DPS, WND_10M(LON_IDX) ) - - !Approximation: neutral 10 m wind speed unavailable, - ! use 10 m wind speed [fraction] - XCH_CFF_MMN_OCN_NTR = XCH_CFF_MMN_OCN_NTR_GET(WND_10M_BND) - - ! BKL97 p. F-4, LaP81 p. 327 (14) Ocean Points [m] - RGH_MMN(LON_IDX)=10.0D0 - & * EXP(-CST_VON_KRM / SQRT(XCH_CFF_MMN_OCN_NTR)) - ENDDO - - !================================================================= - ! Sea ice points - !================================================================= - DO IDX_IDX = 1, ICE_NBR - LON_IDX = ICE_IDX(IDX_IDX) - RGH_MMN(LON_IDX) = SNW_FRC(LON_IDX) * RGH_MMN_SNW - & +(1.0D0-SNW_FRC(LON_IDX)) * RGH_MMN_ICE_OCN ! [m] Bon96 p. 59 - ENDDO - - !================================================================= - ! Land points - !================================================================= - DO IDX_IDX = 1, LND_NBR - - ! Longitude - LON_IDX = LND_IDX(IDX_IDX) - - ! Store surface blend for current gridpoint, sfc_typ(lon_idx) - SFC_TYP_IDX = SFC_TYP_SLC(LON_IDX) - - ! Inland lakes - IF ( SFC_TYP_IDX == 0 ) THEN - - !fxm: Add temperature input and so ability to discriminate warm - ! from frozen lakes here [m] Bon96 p. 59 - RGH_MMN(LON_IDX) = RGH_MMN_LAK_WRM - - ! Land ice - ELSE IF ( SFC_TYP_IDX == 1 ) THEN - - ! [m] Bon96 p. 59 - RGH_MMN(LON_IDX) = SNW_FRC(LON_IDX)*RGH_MMN_SNW - & + (1.0D0-SNW_FRC(LON_IDX))*RGH_MMN_ICE_LND - - - ! Normal land - ELSE - DO SGS_IDX = 1, 3 - - ! Bare ground is pln_typ=14, ocean is pln_typ=0 - PLN_TYP_IDX = Inst%PLN_TYP(SFC_TYP_IDX,SGS_IDX) - - ! Bare ground - IF ( PLN_TYP_IDX == 14 ) THEN - - ! Bon96 p. 59 (glacial ice is same as bare ground) - RLM_CRR = SNW_FRC(LON_IDX) * RGH_MMN_SNW - & + (1.0D0-SNW_FRC(LON_IDX)) * RGH_MMN_ICE_LND ! [m] - - ! Regular plant type - ELSE IF ( PLN_TYP_IDX > 0 ) THEN - RLM_CRR = SNW_FRC(LON_IDX) * RGH_MMN_SNW - & + (1.0D0-SNW_FRC(LON_IDX)) * Z0MVT(PLN_TYP_IDX) - ! [m] Bon96 p. 59 - - ! Presumably ocean snuck through - ELSE - CALL HCO_ERROR( - & 'pln_typ_idx == 0', RC, - & THISLOC='RGH_MMN_GET' ) - RETURN - ENDIF ! endif - - ! Roughness length for normal land - RGH_MMN(LON_IDX) = RGH_MMN(LON_IDX) ! [m] - & + Inst%PLN_FRC(SFC_TYP_IDX,SGS_IDX) ! [frc] - & * RLM_CRR ! [m] - - ENDDO - ENDIF - ENDDO - - ! Return w/ success - RC = HCO_SUCCESS - - ! Return to calling program - END SUBROUTINE RGH_MMN_GET - -!------------------------------------------------------------------------------ - - SUBROUTINE SNW_FRC_GET( HcoState, SNW_HGT_LQD, SNW_FRC ) -! -!****************************************************************************** -! Subroutine SNW_FRC_GET converts equivalent liquid water snow depth to -! fractional snow cover. Uses the snow thickness -> fraction algorithm of -! Bon96. (tdf bmy, 3/30/04) -! -! Arguments as Input: -! =========================================================================== -! (1 ) snw_hgt_lqd (REAL*8) : Equivalent liquid water snow depth [m] -! -! Arguments as Output: -! =========================================================================== -! (2 ) snw_frc (REAL*8 ) : Fraction of surface covered by snow -! -! NOTES: -! (1 ) Updated comments, cosmetic changes. Also now force double-precision -! with "D" exponents. (bmy, 3/30/04) -!****************************************************************************** -! - - !---------------- - ! Arguments - !---------------- - TYPE(HCO_State), POINTER :: HcoState - REAL*8, INTENT(IN) :: SNW_HGT_LQD(HcoState%NX) - REAL*8, INTENT(OUT) :: SNW_FRC(HcoState%NX) - - !---------------- - ! Parameters - !---------------- - - ! Note disparity in bulk snow density between CCM and LSM - ! WiW80 p. 2724, 2725 has some discussion of bulk snow density - ! - ! Bulk density of snow [kg m-3] - REAL*8, PARAMETER :: DNS_H2O_SNW_GND_LSM = 250.0D0 - - ! Standard bulk density of snow on ground [kg m-3] - REAL*8, PARAMETER :: DNS_H2O_SNW_GND_STD = 100.0D0 - - ! Geometric snow thickness for 100% coverage ! [m] - REAL*8, PARAMETER :: SNW_HGT_THR = 0.05D0 - - ! Liquid water density! [kg/m3] - REAL*8, PARAMETER :: DNS_H2O_LQD_STD = 1000.0D0 - - !----------------- - ! Local variables - !----------------- - - ! [idx] Counting index for lon - INTEGER :: LON_IDX - - ! [m] Geometric bulk thickness of snow - REAL*8 :: SNW_HGT(HcoState%NX) - - ! Conversion factor from liquid water depth - ! to geometric snow thickness [fraction] - REAL*8 :: HGT_LQD_SNW_CNV - - !================================================================= - ! SNW_FRC_GET begins here! - !================================================================= - - ! Conversion factor from liquid water depth to - ! geometric snow thickness [fraction] - HGT_LQD_SNW_CNV = DNS_H2O_LQD_STD - & / DNS_H2O_SNW_GND_STD - - ! Fractional snow cover - DO LON_IDX = 1, HcoState%NX - - ! Snow height [m] - SNW_HGT(LON_IDX) = SNW_HGT_LQD(LON_IDX) - & * HGT_LQD_SNW_CNV - - ! Snow fraction - ! NB: CCM and LSM seem to disagree on this - SNW_FRC(LON_IDX) = MIN(SNW_HGT(LON_IDX)/SNW_HGT_THR, 1.0D0) - ENDDO - - ! Return to calling program - END SUBROUTINE SNW_FRC_GET - -!------------------------------------------------------------------------------ - - SUBROUTINE WND_RFR_GET( HcoState, FLG_ORO, HGT_MDP, HGT_RFR, - & HGT_ZPD, MNO_LNG, WND_FRC, WND_MDP, - & WND_MIN, WND_RFR ) -! -!****************************************************************************** -! Subroutine WND_RFR_GET interpolates wind speed at given height to wind -! speed at reference height. (tdf, bmy, 3/30/04) -! -! Arguments as Input: -! =========================================================================== -! (1 ) FLG_ORO (LOGICAL) : Orography flag (mobilization flag) [flag] -! (2 ) HGT_MDP (REAL*8 ) : Midpoint height above surface [m ] -! (3 ) HGT_RFR (REAL*8 ) : Reference height [m ] -! (4 ) HGT_ZPD (REAL*8 ) : Zero plane displacement [m ] -! (5 ) MNO_LNG (REAL*8 ) : Monin-Obukhov length [m ] -! (6 ) WND_FRC (REAL*8 ) : Surface friction velocity [m/s ] -! (7 ) WND_MDP (REAL*8 ) : Surface layer mean wind speed [m/s ] -! (8 ) WND_MIN (REAL*8 ) : Minimum windspeed [m/s ] -! -! Arguments as Output: -! =========================================================================== -! (9 ) WND_RFR (REAL*8 ) : Wind speed at reference height [m/s ] -! -! NOTES: -! (1 ) Updated comments, cosmetic changes. Also now force double-precision -! with "D" exponents. (bmy, 3/30/04) -!****************************************************************************** -! - - !------------------ - ! Arguments - !------------------ - TYPE(HCO_State), POINTER :: HcoState - LOGICAL, INTENT(IN) :: FLG_ORO(HcoState%NX) - REAL*8, INTENT(IN) :: HGT_MDP(HcoState%NX) - REAL*8, INTENT(IN) :: HGT_RFR - REAL*8, INTENT(IN) :: HGT_ZPD(HcoState%NX) - REAL*8, INTENT(IN) :: MNO_LNG(HcoState%NX) - REAL*8, INTENT(IN) :: WND_FRC(HcoState%NX) - REAL*8, INTENT(IN) :: WND_MDP(HcoState%NX) - REAL*8, INTENT(IN) :: WND_MIN - REAL*8, INTENT(OUT) :: WND_RFR(HcoState%NX) - - !------------------ - ! Parameters - !------------------ - - ! Named index for lower (target) hght - INTEGER, PARAMETER :: RFR_HGT_IDX=1 - - ! Named index for upper (known) hght - INTEGER, PARAMETER :: GCM_HGT_IDX=2 - - !------------------ - ! Local variables - !------------------ - - ! [idx] Counting index - INTEGER :: IDX_IDX - - ! [idx] Counting index for lon - INTEGER :: LON_IDX - - ! Stability computation loop index - INTEGER :: LVL_IDX - - ! Valid indices - INTEGER :: VLD_IDX(HcoState%NX) - - ! [nbr] Number of valid indices - INTEGER :: VLD_NBR - - ! [frc] Monin-Obukhov stability correction momentum - REAL*8 :: MNO_STB_CRC_MMN(HcoState%NX,2) - - ! [frc] Monin-Obukhov stability parameter - REAL*8 :: MNO_STB_PRM(HcoState%NX,2) - - ! [frc] Reciprocal of similarity function - ! for momentum, unstable atmosphere - REAL*8 :: SML_FNC_MMN_UNS_RCP - - ! Term in stability correction computation - REAL*8 :: TMP2 - - ! Term in stability correction computation - REAL*8 :: TMP3 - - ! Term in stability correction computation - REAL*8 :: TMP4 - - ! [frc] Wind correction factor - REAL*8 :: WND_CRC_FCT(HcoState%NX) - - ! [m-1] Reciprocal of reference height - REAL*8 :: HGT_RFR_RCP - - !================================================================= - ! WND_RFR_GET begins here! - !================================================================= - - HGT_RFR_RCP = 1.0D0 / HGT_RFR ! [m-1] - WND_RFR = WND_MIN ! [m s-1] - - ! Compute horizontal wind speed at reference height - DO LON_IDX = 1, HcoState%NX - IF (FLG_ORO(LON_IDX) .AND. HGT_ZPD(LON_IDX) < HGT_RFR) THEN - - ! Code uses notation of Bon96 p. 50, where lvl_idx=1 - ! is 10 m ref. hgt, lvl_idx=2 is atm. hgt - MNO_STB_PRM(LON_IDX,RFR_HGT_IDX) = - & MIN((HGT_RFR-HGT_ZPD(LON_IDX)) - & /MNO_LNG(LON_IDX),1.0D0) ! [frc] - - MNO_STB_PRM(LON_IDX,GCM_HGT_IDX) = - & MIN((HGT_MDP(LON_IDX)-HGT_ZPD(LON_IDX)) - & /MNO_LNG(LON_IDX),1.0D0) ! [frc] - - DO LVL_IDX = 1, 2 - IF (MNO_STB_PRM(LON_IDX,LVL_IDX) < 0.0D0) THEN - SML_FNC_MMN_UNS_RCP = (1.0D0 - 16.0D0 - & * MNO_STB_PRM(LON_IDX,LVL_IDX))**0.25D0 - TMP2 = LOG((1.0D0 + SML_FNC_MMN_UNS_RCP - & * SML_FNC_MMN_UNS_RCP)/2.0D0) - TMP3 = LOG((1.0D0 + SML_FNC_MMN_UNS_RCP)/2.0D0) - MNO_STB_CRC_MMN(LON_IDX,LVL_IDX) = - & 2.0D0 * TMP3 + TMP2 - 2.0D0 - & * ATAN(SML_FNC_MMN_UNS_RCP) + 1.5707963 - ELSE ! not stable - MNO_STB_CRC_MMN(LON_IDX,LVL_IDX) = -5.0D0 - & * MNO_STB_PRM(LON_IDX,LVL_IDX) - ENDIF ! stable - ENDDO ! end loop over lvl_idx - - TMP4 = LOG( (HGT_MDP(LON_IDX)-HGT_ZPD(LON_IDX)) - & / (HGT_RFR-HGT_ZPD(LON_IDX)) ) - - ! Correct neutral stability assumption - WND_CRC_FCT(LON_IDX) = TMP4 - & - MNO_STB_CRC_MMN(LON_IDX,GCM_HGT_IDX) - & + MNO_STB_CRC_MMN(LON_IDX,RFR_HGT_IDX) ! [frc] - WND_RFR(LON_IDX) = WND_MDP(LON_IDX)-WND_FRC(LON_IDX) - & * CST_VON_KRM_RCP * WND_CRC_FCT(LON_IDX) ! [m s-1] - WND_RFR(LON_IDX) = MAX(WND_RFR(LON_IDX),WND_MIN) ! [m s-1] - ENDIF - ENDDO - - ! Return to calling program - END SUBROUTINE WND_RFR_GET - -!------------------------------------------------------------------------------ - - SUBROUTINE WND_FRC_THR_SLT_GET( HcoState, FLG_MBL, - & DNS_MDP, WND_FRC_THR_SLT, RC ) -! -!****************************************************************************** -! Subroutine WND_FRC_THR_SLT_GET ccmputes the dry threshold friction velocity -! for saltation -- See Zender et al. expression (1) (tdf, bmy, 3/30/04) -! -! Arguments as Input: -! =========================================================================== -! (1 ) FLG_MBL (LOGICAL) : mobilisation flag -! (2 ) DNS_MDP (REAL*8 ) : Midlayer density [kg/m3] -! -! Arguments as Output: -! =========================================================================== -! (3 ) WND_FRC_THR_SLT (REAL*8 ) : Threshold friction velocity -! for saltation [m/s] -! -! NOTES: -! (1 ) Updated comments, cosmetic changes. Also now force double-precision -! with "D" exponents. (bmy, 3/30/04) -!****************************************************************************** -! - - !---------------- - ! Arguments - !---------------- - TYPE(HCO_State), POINTER :: HcoState - LOGICAL, INTENT(IN) :: FLG_MBL(HcoState%NX) - REAL*8, INTENT(IN) :: DNS_MDP(HcoState%NX) - REAL*8, INTENT(OUT) :: WND_FRC_THR_SLT(HcoState%NX) - INTEGER, INTENT(INOUT) :: RC - - !----------------- - ! Parameters - !----------------- - - ! [m] Optimal diameter for saltation, - ! IvW82 p. 117 Fgr. 8, Pye87 p. 31, MBA97 p. 4388, SRL96 (2) - REAL*8, PARAMETER :: DMT_SLT_OPT = 75.0d-6 - - ! [kg m-3] Density of optimal saltation particles, - ! MBA97 p. 4388 friction velocity for saltation - REAL*8, PARAMETER :: DNS_SLT = 2650.0d0 - - !----------------- - ! Local variables - !----------------- - - ! [idx] Longitude Counting Index - INTEGER :: LON_IDX - - ! Threshold friction Reynolds number - ! approximation for optimal size [frc] - REAL*8 :: RYN_NBR - - ! Density ratio factor for saltation calculation - REAL*8 :: DNS_FCT - - ! Interparticle cohesive forces factor for saltation calculation - REAL*8 :: ALPHA, BETA, GAMMA, TMP1 - - - !================================================================= - ! WND_FRC_THR_SLT_GET begins here! - !================================================================= - - ! Initialize some variables - ! MaB95 pzn. for Re*t(D_opt) circumvents iterative solution - ! [frc] "B" MaB95 p. 16417 (5) - - ! [m/s] Threshold velocity - WND_FRC_THR_SLT(:) = 0.0D0 - - ! Threshold friction Reynolds number approximation for optimal size - RYN_NBR = 0.38D0 + 1331.0D0 - & * (100.0D0*DMT_SLT_OPT)**1.56D0 - - ! tdf NB conversion of Dp to [cm] - ! Given Re*t(D_opt), compute time independent factors contributing - ! to u*t. IvW82 p. 115 (6) MaB95 p. 16417 (4) Interparticle cohesive - ! forces. see Zender et al., Equ. (1). - - ! tdf introduced beta [fraction] - BETA = 1.0D0+6.0D-07 / (DNS_SLT*GRV_SFC*(DMT_SLT_OPT**2.5D0)) - - ! IvW82 p. 115 (6) MaB95 p. 16417 (4) - DNS_FCT = DNS_SLT * GRV_SFC * DMT_SLT_OPT - - ! Error check - IF ( RYN_NBR < 0.03D0 ) THEN - CALL HCO_ERROR ( 'RYN_NBR < 0.03', RC, - & THISLOC='WND_FRC_THR_SLT_GET' ) - RETURN - - ELSE IF ( RYN_NBR < 10.0D0 ) THEN - - ! IvW82 p. 114 (3), MaB95 p. 16417 (6) - ! tdf introduced gamma [fraction] - GAMMA = -1.0D0 + 1.928D0 * (RYN_NBR**0.0922D0) - TMP1 = 0.129D0*0.129D0 * BETA / GAMMA - - ELSE - - ! ryn_nbr > 10.0D0 - ! IvW82 p. 114 (3), MaB95 p. 16417 (7) - ! tdf introduced gamma [fraction] - GAMMA = 1.0D0-0.0858D0 * EXP(-0.0617D0*(RYN_NBR-10.0D0)) - TMP1 = 0.12D0*0.12D0 * BETA * GAMMA * GAMMA - - ENDIF - - DO LON_IDX = 1, HcoState%NX - - ! Threshold friction velocity for saltation dry ground - ! tdf introduced alpha - ALPHA = DNS_FCT / DNS_MDP(LON_IDX) - - ! Added mobilisation constraint - IF ( FLG_MBL(LON_IDX) ) THEN - WND_FRC_THR_SLT(LON_IDX) = SQRT(TMP1) * SQRT(ALPHA) ! [m s-1] - ENDIF - ENDDO - - ! Return w/ success - RC = HCO_SUCCESS - - END SUBROUTINE WND_FRC_THR_SLT_GET - -!------------------------------------------------------------------------------ - - SUBROUTINE WND_RFR_THR_SLT_GET( HcoState, WND_FRC, - & WND_FRC_THR_SLT, WND_MDP, WND_RFR, - & WND_RFR_THR_SLT ) -! -!****************************************************************************** -! Subroutine WND_RFR_THR_SLT_GET computes the threshold horizontal wind -! speed at reference height for saltation. (tdf, bmy, 3/30/04) -! -! Arguments as Input: -! ============================================================================ -! (1 ) wnd_frc (REAL*8) : Surface friction velocity [m/s] -! (2 ) wnd_frc_thr_slt (REAL*8) : Threshold friction vel. for saltation [m/s] -! (3 ) wnd_mdp (REAL*8) : Surface layer mean wind speed [m/s] -! (4 ) wnd_rfr (REAL*8) : Wind speed at reference height [m/s] -! -! Arguments as Output: -! ============================================================================ -! (5 ) wnd_rfr_thr_slt (REAL*8) : Threshold 10m wind speed for saltation [m/s] -! -! NOTES: -! (1 ) Updated comments, cosmetic changes. -!****************************************************************************** -! - ! Arguments - TYPE(HCO_State), POINTER :: HcoState - REAL*8, INTENT(IN) :: WND_FRC(HcoState%NX) - REAL*8, INTENT(IN) :: WND_FRC_THR_SLT(HcoState%NX) - REAL*8, INTENT(IN) :: WND_MDP(HcoState%NX) - REAL*8, INTENT(IN) :: WND_RFR(HcoState%NX) - REAL*8, INTENT(OUT) :: WND_RFR_THR_SLT(HcoState%NX) - - ! Local variables - INTEGER :: I - - !================================================================= - ! WND_RFR_THR_SLT_GET begins here - !================================================================= - DO I = 1, HcoState%NX - - ! A more complicated procedure would recompute mno_lng for - ! wnd_frc_thr, and then integrate vertically from rgh_mmn+hgt_zpd - ! to hgt_rfr. - ! - ! wnd_crc_fct is (1/k)*[ln(z-D)/z0 - psi(zeta2) + psi(zeta1)] - WND_RFR_THR_SLT(I) = WND_FRC_THR_SLT(I) - & * WND_RFR(I) / WND_FRC(I) - - ENDDO - - ! Return to calling program - END SUBROUTINE WND_RFR_THR_SLT_GET - -!------------------------------------------------------------------------------ - - SUBROUTINE VWC2GWC( HcoState, FLG_MBL, GWC_SFC, VWC_SAT, VWC_SFC ) -! -!****************************************************************************** -! Subroutine VWC2GWC converts volumetric water content to gravimetric water -! content -- assigned only for mobilisation candidates. (tdf, bmy, 3/30/04) -! -! Arguments as Input: -! =========================================================================== -! (1 ) FLG_MBL (LOGICAL) : Mobilization candidate flag [flag] -! (3 ) VWC_SAT (REAL*8 ) : Saturated VWC (sand-dependent) [m3/m3] -! (4 ) VWC_SFC (REAL*8 ) : Volumetric water content! [m3/m3 -! -! Arguments as Output: -! =========================================================================== -! (2 ) gwc_sfc (REAL*8 ) : Gravimetric water content [kg/kg] -! -! NOTES: -! (1 ) Updated comments, cosmetic changes. Also now forces double-precision -! with "D" exponents. (tdf, bmy, 3/30/04) -!****************************************************************************** -! - - !---------------- - ! Arguments - !---------------- - TYPE(HCO_State), POINTER :: HcoState - LOGICAL, INTENT(IN) :: FLG_MBL(HcoState%NX) - REAL*8, INTENT(IN) :: VWC_SAT(HcoState%NX) - REAL*8, INTENT(IN) :: VWC_SFC(HcoState%NX) - REAL*8, INTENT(OUT) :: GWC_SFC(HcoState%NX) - - !---------------- - ! Parameters - !---------------- - - ! Dry density of soil ! particles (excluding pores) [kg/m3] - REAL*8, PARAMETER :: DNS_PRT_SFC = 2650.0d0 - - ! liq. H2O density [kg/m3] - REAL*8, PARAMETER :: DNS_H2O_LQD_STD = 1000.0d0 - - !----------------- - ! Local variables - !----------------- - - ! Longitude index - INTEGER :: LON_IDX - - ! [kg m-3] Bulk density of dry surface soil - REAL*8 :: DNS_BLK_DRY(HcoState%NX) - - !================================================================= - ! VWC2GWC begins here! - !================================================================= - GWC_SFC(:) = 0.0D0 - DNS_BLK_DRY(:) = 0.0D0 - - ! Loop over longitudes - DO LON_IDX = 1, HcoState%NX - - ! If this is a mobilization candidate then... - IF ( FLG_MBL(LON_IDX) ) THEN - - ! Assume volume of air pores when dry equals saturated VWC - ! This implies air pores are completely filled by water in - ! saturated soil - - ! Bulk density of dry surface soil [kg m-3] - DNS_BLK_DRY(LON_IDX) = DNS_PRT_SFC - & * ( 1.0d0 - VWC_SAT(LON_IDX) ) - - ! Gravimetric water content [ kg kg-1] - GWC_SFC(LON_IDX) = VWC_SFC(LON_IDX) - & * DNS_H2O_LQD_STD - & / DNS_BLK_DRY(LON_IDX) - - ENDIF - ENDDO - - ! Return to calling program - END SUBROUTINE VWC2GWC - -!------------------------------------------------------------------------------ - - SUBROUTINE FRC_THR_NCR_WTR_GET( HcoState, FLG_MBL, - & FRC_THR_NCR_WTR, MSS_FRC_CLY_SLC, GWC_SFC ) -! -!****************************************************************************** -! Subroutine FRC_THR_NCR_WTR_GET computes the factor by which soil moisture -! increases threshold friction velocity. This parameterization is based on -! FMB99. Zender et al., exp. (5). (tdf, bmy, 4/5/04) -! -! Arguments as Input: -! =========================================================================== -! (1 ) FLG_MBL (LOGICAL) : Mobilization candidate flag [flags ] -! (3 ) MSS_FRC_CLY (REAL*8 ) : Mass fraction of clay [fraction] -! (4 ) GWC_SFC (REAL*8 ) : Gravimetric water content [kg/kg ] -! -! Arguments as Output: -! =========================================================================== -! (2 ) FRC_THR_NCR_WTR (REAL*8 ) : Factor by which moisture increases -! threshold friction velocity [fraction] -! -! NOTES: -! (1 ) Updated comments, cosmetic changes. Also now forces double-precision -! with "D" exponents. (tdf, bmy, 4/5/04) -!****************************************************************************** -! - - ! Arguments - TYPE(HCO_State), POINTER :: HcoState - LOGICAL, INTENT(IN) :: FLG_MBL(HcoState%NX) - REAL*8, INTENT(IN) :: MSS_FRC_CLY_SLC(HcoState%NX) - REAL*8, INTENT(IN) :: GWC_SFC(HcoState%NX) - REAL*8, INTENT(OUT) :: FRC_THR_NCR_WTR(HcoState%NX) - - ! local variables - INTEGER :: LON_IDX ! [idx] Counting index - REAL*8 :: GWC_THR(HcoState%NX) ! [kg/kg] Threshold GWC - - !================================================================= - ! FRC_THR_NCR_WTR_GET begins here! - !================================================================= - - ! Initialize - frc_thr_ncr_wtr(:) = 1.0D0 - gwc_thr(:) = 0.0D0 - - ! Loop over longitudes - DO LON_IDX = 1, HcoState%NX - - ! If this is a candidate for mobilization... - IF ( FLG_MBL(LON_IDX) ) THEN - - !=========================================================== - ! Adjust threshold velocity for inhibition by moisture - ! frc_thr_ncr_wtr(lon_idx)=exp(22.7D0*vwc_sfc(lon_idx)) - ! [frc] SRL96 - ! - ! Compute threshold soil moisture based on clay content - ! GWC_THR=MSS_FRC_CLY*(0.17D0+0.14D0*MSS_FRC_CLY) [m3/m3] - ! FMB99 p. 155 (14) - ! - ! 19991105 remove factor of mss_frc_cly from gwc_thr to - ! improve large scale behavior. - !=========================================================== - - ! [m3 m-3] - GWC_THR(LON_IDX) = 0.17D0 + 0.14D0* MSS_FRC_CLY_SLC(LON_IDX) - - IF ( GWC_SFC(LON_IDX) > GWC_THR(LON_IDX) ) - & FRC_THR_NCR_WTR(LON_IDX) = SQRT(1.0D0+1.21D0 - & * (100.0D0 * (GWC_SFC(LON_IDX)-GWC_THR(LON_IDX))) - & ** 0.68D0) ! [frc] FMB99 p. 155 (15) - ENDIF - ENDDO - - ! Return to calling program - END SUBROUTINE FRC_THR_NCR_WTR_GET - -!------------------------------------------------------------------------------ - - SUBROUTINE FRC_THR_NCR_DRG_GET( HcoState, FRC_THR_NCR_DRG, - & FLG_MBL, Z0M, ZS0M, RC ) -! -!****************************************************************************** -! Subroutine FRC_THR_NCR_DRG_GET computes factor by which surface roughness -! increases threshold friction velocity. Zender et al., expression (3) -! This parameterization is based on MaB95 and GMB98. (tdf, bmy, 4/5/04) -! -! Arguments as Input: -! =========================================================================== -! (2 ) FLG_MBL (LOGICAL) : Mobilization candidate flag -! (3 ) Z0M (REAL*8 ) : Roughness length momentum -! : for erodible surfaces [m] -! (4 ) ZS0M (REAL*8 ) : Smooth roughness length [m] -! -! Arguments as Output: -! =========================================================================== -! (1 ) FRC_THR_NCR_DRG (REAL*8 ) : Factor by which surface roughness -! increases threshold fric. velocity [frac] -! -! NOTES: -! (1 ) Updated comments, cosmetic changes. Also now forces double-precision -! with "D" exponents. (tdf, bmy, 4/5/04) -!****************************************************************************** -! - - !----------------- - ! Arguments - !----------------- - TYPE(HCO_State), POINTER :: HcoState - LOGICAL, INTENT(IN) :: FLG_MBL(HcoState%NX) - REAL*8, INTENT(IN) :: Z0M - REAL*8, INTENT(IN) :: ZS0M - REAL*8, INTENT(OUT) :: FRC_THR_NCR_DRG(HcoState%NX) - INTEGER, INTENT(INOUT) :: RC - - !----------------- - ! Local variables - !----------------- - - ! [idx] Counting index - integer lon_idx - - ! [frc] Efficient fraction of wind friction - real*8 Feff - - ! [frc] Reciprocal of Feff - real*8 Feff_rcp - - ! for error handling - CHARACTER(LEN=255) :: MSG - - !================================================================= - ! FRC_THR_NCR_DRG_GET begins here! - !================================================================= - - FRC_THR_NCR_DRG(:) = 1.0D0 - - ! Adjust threshold velocity for inhibition by roughness elements - ! Zender et al. Equ. (3), fd. - - ! [frc] MaB95 p. 16420, GMB98 p. 6207 - FEFF = 1.0D0 - LOG( Z0M /ZS0M ) - & / LOG( 0.35D0*( (0.1D0/ZS0M)**0.8D0) ) - - ! Error check - if ( FEFF <= 0.0D0 .OR. FEFF > 1.0D0 ) THEN - MSG = 'Feff out of range!' - CALL HCO_ERROR(MSG, RC, - & THISLOC='FRC_THR_NC_DRG_GET' ) - RETURN - ENDIF - - ! Reciprocal of FEFF [fraction] - FEFF_RCP = 1.0D0 / FEFF - - ! Loop over longitudes - DO LON_IDX = 1, HcoState%NX - - ! If this is a mobilization candidate... - IF ( FLG_MBL(LON_IDX) ) THEN - - ! Save into FRC_THR_NCR_DRG - FRC_THR_NCR_DRG(LON_IDX) = FEFF_RCP - - ! fxm: 19991012 - ! Set frc_thr_ncr_drg=1.0, equivalent to assuming mobilization - ! takes place at smooth roughness length - FRC_THR_NCR_DRG(LON_IDX) = 1.0D0 - - ENDIF - ENDDO - - ! Return w/ success - RC = HCO_SUCCESS - - END SUBROUTINE FRC_THR_NCR_DRG_GET - -!------------------------------------------------------------------------------ - - SUBROUTINE WND_FRC_SLT_GET( HcoState, FLG_MBL, WND_FRC, - & WND_FRC_SLT, WND_RFR, WND_RFR_THR_SLT) -! -!****************************************************************************** -! Subroutine WND_FRC_SLT_GET computes the saltating friction velocity. -! Saltation increases friction speed by roughening surface, AKA "Owen's -! effect". This acts as a positive feedback to the friction speed. GMB98 -! parameterized this feedback in terms of 10 m windspeeds, Zender et al. -! equ. (4). (tdf, bmy, 4/5/04, 1/25/07) -! -! Arguments as Input: -! =========================================================================== -! (1 ) FLG_MBL (LOGICAL) : Mobilization candidate flag -! (2 ) WND_FRC (REAL*8 ) : Surface friction velocity [m/s] -! (4 ) WND_RFR (REAL*8 ) : Wind speed at reference height [m/s] -! (5 ) WND_RFR_THR_SLT (REAL*8 ) : Thresh. 10m wind speed for saltation [m/s] -! -! Arguments as Output: -! =========================================================================== -! (3 ) WND_FRC_SLT (REAL*8 ) : Saltating friction velocity [m/s] -! -! NOTES: -! (1 ) Updated comments, cosmetic changes. Also now forces double-precision -! with "D" exponents. (tdf, bmy, 4/5/04) -! (2 ) Now eliminate Owen effect (tdf, bmy, 1/25/07) -!****************************************************************************** -! - - !------------------- - ! Arguments - !------------------- - TYPE(HCO_State), POINTER :: HcoState - LOGICAL, INTENT(IN) :: FLG_MBL(HcoState%NX) - REAL*8, INTENT(IN) :: WND_FRC(HcoState%NX) - REAL*8, INTENT(IN) :: WND_RFR(HcoState%NX) - REAL*8, INTENT(IN) :: WND_RFR_THR_SLT(HcoState%NX) - REAL*8, INTENT(OUT) :: WND_FRC_SLT(HcoState%NX) - - !------------------- - ! Local variables - !------------------- - - ! [idx] Counting index - INTEGER :: LON_IDX - - !--------------------------------------------------------------------- - ! Prior to 1/25/07: - ! Eliminate Owen effect, so comment out this code (tdf, bmy, 1/25/07) - ! - ! %%%%% DO NOT DELETE -- LEAVE THIS CODE COMMENTED OUT %%%%% - ! - !! [m/s] Reference windspeed excess over threshold - !REAL*8 :: WND_RFR_DLT - ! - !! [m/s] Friction velocity increase from saltation - !REAL*8 :: WND_FRC_SLT_DLT - !--------------------------------------------------------------------- - - !================================================================= - ! WND_FRC_SLT_GET begins here! - !================================================================= - - ! [m/s] Saltating friction velocity - WND_FRC_SLT(:) = WND_FRC(:) - -!------------------------------------------------------------------------------ -! Prior to 1/25/07: -! Eliminate the Owen effect. Note that the more computationally -! efficient way to do this is to just comment out the entire IF block. -! (tdf, bmy, 1/25/07) -! -! %%%%% DO NOT DELETE -- LEAVE THIS CODE COMMENTED OUT %%%%% -! -! ! Loop over longitudes -! DO LON_IDX = 1, HcoState%NX -! -! ! If this is a mobilization candidate, then only -! ! only apply Owen effect only when Uref > Ureft (tdf 4/5/04) -! IF ( FLG_MBL(LON_IDX) .AND. -! & WND_RFR(LON_IDX) >= WND_RFR_THR_SLT(LON_IDX) ) THEN -! -! !================================================================== -! ! Saltation roughens the boundary layer, AKA "Owen's effect" -! ! GMB98 p. 6206 Fig. 1 shows observed/computed u* dependence -! ! on observed U(1 m). GMB98 p. 6209 (12) has u* in cm s-1 and -! ! U, Ut in m s-1, personal communication, D. Gillette, 19990529 -! ! With everything in MKS, the 0.3 coefficient in GMB98 (12) -! ! becomes 0.003. Increase in friction velocity due to saltation -! ! varies as square of difference between reference wind speed -! ! and reference threshold speed. -! !================================================================== -! WND_RFR_DLT = WND_RFR(LON_IDX) - WND_RFR_THR_SLT(LON_IDX) -! -! ! Friction velocity increase from saltation GMB98 p. 6209 [m/s] -! wnd_frc_slt_dlt = 0.003D0 * wnd_rfr_dlt * wnd_rfr_dlt -! -! ! Saltation friction velocity, U*,s, Zender et al. Equ. (4). -! WND_FRC_SLT(LON_IDX) = WND_FRC(LON_IDX) -! & + WND_FRC_SLT_DLT ! [m s-1] -! -! ! -!ctdf Eliminate Owen effect tdf 01/13/2K5 -! wnd_frc_slt(:) = wnd_frc(:) -! -! ENDIF -! ENDDO -!------------------------------------------------------------------------------ - - ! Return to calling program - END SUBROUTINE WND_FRC_SLT_GET - -!------------------------------------------------------------------------------ - - SUBROUTINE FLX_MSS_CACO3_MSK( HcoState, ExtState, - & DMT_VWR, - & FLG_MBL, - & FLX_MSS_VRT_DST_CACO3, - & MSS_FRC_CACO3_SLC, - & MSS_FRC_CLY_SLC, - & MSS_FRC_SND_SLC, RC ) -! -!****************************************************************************** -! Subroutine FLX_MSS_CACO3_MSK masks dust mass flux by CaCO3 mass fraction at -! source. Theory: Uses soil CaCO3 mass fraction from Global Soil Data Task, -! 1999 (Sch99). Uses size dependent apportionment of CaCO3 from Claquin et -! al, 1999 (CSB99). (tdf, bmy, 4/5/04) -! -! Arguments as Input: -! =========================================================================== -! (1 ) DMT_VWR (REAL*8 ) : Mass weighted diameter resolved [m] -! (2 ) FLG_MBL (LOGICAL) : Mobilization candidate flag -! (3 ) FLX_MSS_VRT_DST_CACO3 (REAL*8 ) : Vert. mass flux of dust [kg/m2/s ] -! (4 ) MSS_FRC_CACO3 (REAL*8 ) : Mass fraction of CaCO3 [fraction] -! (5 ) MSS_FRC_CLY (REAL*8 ) : Mass fraction of clay [fraction] -! (6 ) MSS_FRC_SND (REAL*8 ) : Mass fraction of sand [fraction] -! -! Arguments as Output: -! =========================================================================== -! (3 ) FLX_MSS_VRT_DST_CACO3 (REAL*8 ) : Vertical mass flux of CaCO3 [kg/m2/s] -! -! NOTES: -! (1 ) Updated comments, cosmetic changes. Also now forces double-precision -! with "D" exponents. (tdf, bmy, 4/5/04) -!****************************************************************************** -! - - !------------------ - ! Arguments - !------------------ - TYPE(HCO_State), POINTER :: HcoState - TYPE(Ext_State), POINTER :: ExtState - LOGICAL, INTENT(IN) :: FLG_MBL(HcoState%NX) - REAL*8, INTENT(IN) :: DMT_VWR(NBINS) - REAL*8, INTENT(IN) :: MSS_FRC_CACO3_SLC(HcoState%NX) - REAL*8, INTENT(IN) :: MSS_FRC_CLY_SLC(HcoState%NX) - REAL*8, INTENT(IN) :: MSS_FRC_SND_SLC(HcoState%NX) - REAL*8, INTENT(INOUT) :: FLX_MSS_VRT_DST_CACO3(HcoState%NX,NBINS) - INTEGER, INTENT(INOUT) :: RC - - !------------------ - ! Parameters - !------------------ - - ! Maximum diameter of Clay soil texture CSB99 p. 22250 [m] - REAL*8, PARAMETER :: DMT_CLY_MAX = 2.0d-6 - - ! Maximum diameter of Silt soil texture CSB99 p. 22250 [m] - REAL*8, PARAMETER :: DMT_SLT_MAX = 50.0d-6 - - ! Density of CaCO3 http://www.ssc.on.ca/mandm/calcit.htm [kg/m3] - REAL*8, PARAMETER :: DNS_CACO3 = 2950.0d0 - - !------------------ - ! Local variables - !------------------ - - ! [idx] Counting index - INTEGER :: M - - ! [idx] Counting index for lon - INTEGER :: LON_IDX - - ! [frc] Mass fraction of silt - REAL*8 :: MSS_FRC_SLT_SLC(HcoState%NX) - - ! [frc] Fraction of soil CaCO3 in size bin - REAL*8 :: MSS_FRC_CACO3_SZ_CRR - - ! [frc] Fraction of CaCO3 in clay - REAL*8 :: MSS_FRC_CACO3_CLY - - ! [frc] Fraction of CaCO3 in silt - REAL*8 :: MSS_FRC_CACO3_SLT - - ! [frc] Fraction of CaCO3 in sand - REAL*8 :: MSS_FRC_CACO3_SND - - ! Error handling - CHARACTER(LEN=255) :: MSG - - !================================================================= - ! FLX_MSS_CACO3_MSK - !================================================================= - - ! INITIALIZE - MSS_FRC_SLT_SLC(:) = 0.0D0 - - ! Loop over dust bins - DO M = 1, NBINS - - ! Loop over longitudes - DO LON_IDX = 1, HcoState%NX - - !=========================================================== - ! Simple technique is to mask dust mass by tracer mass - ! fraction. The model transports (hence conserves) CaCO3 - ! rather than total dust itself. The method assumes source, - ! transport, and removal processes are linear with tracer - ! mass - !=========================================================== - - ! If this is a mobilization candidate, then... - IF ( FLG_MBL(LON_IDX) ) THEN - - ! 20000320: Currently this is only process in - ! dust model requiring mss_frc_slt - - ! [frc] Mass fraction of silt - MSS_FRC_SLT_SLC(LON_IDX) = - & MAX(0.0D0, 1.0D0 -MSS_FRC_CLY_SLC(LON_IDX) - & -MSS_FRC_SND_SLC(LON_IDX)) - - ! CSB99 showed that CaCO3 is not uniformly distributed - ! across sizes. There is more CaCO3 per unit mass of - ! silt than per unit mass of clay. - - ! Fraction of CaCO3 in clay CSB99 p. 22249 Figure 1b - MSS_FRC_CACO3_CLY = MAX(0.0D0,-0.045D0+0.5D0 - & * MIN(0.5D0,MSS_FRC_CLY_SLC(LON_IDX))) - - ! Fraction of CaCO3 in silt CSB99 p. 22249 Figure 1a - MSS_FRC_CACO3_SLT = MAX(0.0D0,-0.175D0+1.4D0 - & * MIN(0.5D0,MSS_FRC_SLT_SLC(LON_IDX))) - - ! Fraction of CaCO3 in sand CSB99 p. 22249 Figure 1a - MSS_FRC_CACO3_SND = 1.0D0 - MSS_FRC_CACO3_CLY - & - MSS_FRC_CACO3_SND - - ! Set CaCO3 fraction of total CaCO3 for each transport bin - IF ( DMT_VWR(M) < DMT_CLY_MAX ) THEN - - ! Transport bin carries Clay - ! Fraction of soil CaCO3 in size bin - MSS_FRC_CACO3_SZ_CRR = MSS_FRC_CACO3_CLY - - ELSE IF ( DMT_VWR(M) < DMT_SLT_MAX ) THEN - - ! Transport bin carries Silt - ! Fraction of soil CaCO3 in size bin - MSS_FRC_CACO3_SZ_CRR = MSS_FRC_CACO3_SLT - - ELSE - - ! Transport bin carries Sand - ! Fraction of soil CaCO3 in size bin - MSS_FRC_CACO3_SZ_CRR = MSS_FRC_CACO3_SND - - ENDIF - - ! Error checks - IF ( MSS_FRC_CACO3_SZ_CRR < 0.0D0 .OR. - & MSS_FRC_CACO3_SZ_CRR > 1.0D0 ) THEN - MSG = 'mss_frc_CaC_s < 0.0.or.mss_frc_CaC_s > 1.0!' - CALL HCO_ERROR(MSG, RC, - & THISLOC='FLX_MSS_CACO3_MSK' ) - RETURN - ENDIF - - IF ( MSS_FRC_CACO3_SLC(LON_IDX) < 0.0D0 .OR. - & MSS_FRC_CACO3_SLC(LON_IDX) > 1.0D0 ) THEN - MSG = 'mss_frc_CaCO3_s < 0.0.or.mss_frc_CaCO3 > 1.0!' - CALL HCO_ERROR(MSG, RC, - & THISLOC='FLX_MSS_CACO3_MSK' ) - RETURN - ENDIF - - ! Convert dust flux to CaCO3 flux - FLX_MSS_VRT_DST_CACO3(LON_IDX,M) = - & FLX_MSS_VRT_DST_CACO3(LON_IDX,M) ! [KG m-2 s-1] - & * MSS_FRC_CACO3_SLC(LON_IDX) ! [frc] Mass fraction of - ! CaCO3 (at this location) - ! 20020925 fxm: Remove size dependence of CaCO3 - & * 1.0D0 - - ENDIF - ENDDO - ENDDO - - ! Return w/ success - RC = HCO_SUCCESS - - END SUBROUTINE FLX_MSS_CACO3_MSK - -!------------------------------------------------------------------------------ - - SUBROUTINE FLX_MSS_HRZ_SLT_TTL_WHI79_GET( HcoState, DNS_MDP, - & FLG_MBL, QS_TTL, U_S, U_ST ) -! -!****************************************************************************** -! Subroutine FLX_MSS_HRZ_SLT_TTL_WHI79_GET computes vertically integrated -! streamwise mass flux of particles. Theory: Uses method proposed by White -! (1979). See Zender et al., expr (10). fxm: use surface air density not -! midlayer density (tdf, bmy, 4/5/04) -! -! Arguments as Input: -! ============================================================================ -! (1 ) DNS_MDP (REAL*8 ) : Midlayer density [g/m3 ] -! (2 ) FLG_MBL (LOGICAL) : Mobilization candidate flag [flag ] -! (4 ) U_S (REAL*8 ) : Surface friction velocity [m/s ] -! (5 ) U_ST (REAL*8 ) : Threshold friction spd for saltation [m/s ] -! -! Arguments as Output: -! ============================================================================ -! (3 ) QS_TTL (REAL*8 ) : Vertically integrated streamwise mass flux [kg/m/s] -! -! NOTES: -! (1 ) Updated comments, cosmetic changes. Also now forces double-precision -! with "D" exponents. (tdf, bmy, 4/5/04) -!****************************************************************************** -! - - !------------------ - ! Arguments - !------------------ - TYPE(HCO_State), POINTER :: HcoState - LOGICAL, INTENT(IN) :: FLG_MBL(HcoState%NX) - REAL*8, INTENT(IN) :: DNS_MDP(HcoState%NX) - REAL*8, INTENT(IN) :: U_S(HcoState%NX) - REAL*8, INTENT(IN) :: U_ST(HcoState%NX) - REAL*8, INTENT(OUT) :: QS_TTL(HcoState%NX) - - !------------------ - ! Parameters - !------------------ - - ! [frc] Saltation constant Whi79 p. 4648, MaB97 p. 16422 - REAL*8, PARAMETER :: CST_SLT = 2.61d0 - - !------------------ - ! Local variables - !------------------ - - ! [frc] Ratio of wind friction threshold to wind friction - real*8 :: U_S_rat - - ! [idx] Counting index for lon - integer :: lon_idx - - !================================================================= - ! FLX_MSS_HRZ_SLT_TTL_WHI79_GET begins here! - !================================================================= - - ! Initialize - QS_TTL(:) = 0.0D0 - - ! Loop over longitudes - DO LON_IDX = 1, HcoState%NX - - ! If this is a mobilization candidate and the friction - ! velocity is above the threshold for saltation... - IF ( FLG_MBL(LON_IDX) .AND. - & U_S(LON_IDX) > U_ST(LON_IDX) ) THEN - - ! Ratio of wind friction threshold to wind friction - U_S_RAT = U_ST(LON_IDX) / U_S(LON_IDX) - - ! Whi79 p. 4648 (19), MaB97 p. 16422 (28) - QS_TTL(LON_IDX) = ! [kg m-1 s-1] - & CST_SLT * DNS_MDP(LON_IDX) * (U_S(LON_IDX)**3.0D0) - & * (1.0D0-U_S_RAT) * (1.0D0+U_S_RAT) - & * (1.0D0+U_S_RAT) / GRV_SFC - - ENDIF - ENDDO - - ! Return to calling program - END SUBROUTINE FLX_MSS_HRZ_SLT_TTL_WHI79_GET - -!------------------------------------------------------------------------------ - - SUBROUTINE FLX_MSS_VRT_DST_TTL_MAB95_GET( HcoState, - & DST_SLT_FLX_RAT_TTL, - & FLG_MBL, - & FLX_MSS_HRZ_SLT_TTL, - & FLX_MSS_VRT_DST_TTL, - & MSS_FRC_CLY_SLC ) -! -!****************************************************************************** -! Subroutine FLX_MSS_VRT_DST_TTL_MAB95_GET diagnoses total vertical mass flux -! of dust from vertically integrated streamwise mass flux, Zender et al., -! expr. (11). (tdf, bmy, 4/5/04) -! -! Theory: Uses clay-based method proposed by Marticorena & Bergametti (1995) -! Their parameterization is based only on data for mss_frc_cly < 0.20 -! For clayier soils, dst_slt_flx_rat_ttl may behave dramatically differently -! Whether this behavior changes when mss_frc_cly > 0.20 is unknown -! Anecdotal evidence suggests vertical flux decreases for mss_frc_cly > 0.20 -! Thus we use min[mss_frc_cly,0.20] in MaB95 parameterization -! -! Arguments as Input: -! ============================================================================ -! (2 ) FLG_MBL (LOGICAL) : Mobilization candidate flag -! (3 ) FLX_MSS_HRZ_SLT_TTL (REAL*8 ) : Vertically integrated streamwise -! mass flux [kg/m/s] -! (5 ) MSS_FRC_CLY (REAL*8 ) : Mass fraction clay [fraction] -! -! Arguments as Output: -! ============================================================================ -! (1 ) DST_SLT_FLX_RAT_TTL (REAL*8 ) : Ratio of vertical dust flux t -! to streamwise mass flux [1/m] -! (4 ) FX_MSS_VRT_DST_TTL (REAL*8 ) : Total vert. mass flux of dust [kg/m2/s] -! -! NOTES: -! (1 ) Updated comments, cosmetic changes. Also now forces double-precision -! with "D" exponents. (tdf, bmy, 4/5/04) -!****************************************************************************** -! - - !----------------- - ! Arguments - !----------------- - TYPE(HCO_State), POINTER :: HcoState - LOGICAL, INTENT(IN) :: FLG_MBL(HcoState%NX) - REAL*8, INTENT(IN) :: FLX_MSS_HRZ_SLT_TTL(HcoState%NX) - REAL*8, INTENT(IN) :: MSS_FRC_CLY_SLC(HcoState%NX) - REAL*8, INTENT(OUT) :: DST_SLT_FLX_RAT_TTL(HcoState%NX) - REAL*8, INTENT(OUT) :: FLX_MSS_VRT_DST_TTL(HcoState%NX) - - !----------------- - ! Local variables - !----------------- - - ! [idx] Counting index for lon - INTEGER :: LON_IDX - - ! [frc] Mass fraction clay limited to 0.20 - REAL*8 :: MSS_FRC_CLY_VLD - - ! [frc] Natural log of 10 - REAL*8 :: LN10 - - !================================================================= - ! FLX_MSS_VRT_DST_TTL_MAB95_GET - !================================================================= - - ! Initialize - LN10 = LOG(10.0D0) - DST_SLT_FLX_RAT_TTL(:) = 0.0D0 - FLX_MSS_VRT_DST_TTL(:) = 0.0D0 - - ! Loop over longitudes - DO LON_IDX = 1, HcoState%NX - - ! If this is a mobilization candidate... - IF ( FLG_MBL(LON_IDX) ) then - - ! 19990603: fxm: Dust production is EXTREMELY sensitive to - ! this parameter, which changes flux by 3 orders of magnitude - ! in 0.0 < mss_frc_cly < 0.20 - MSS_FRC_CLY_VLD = MIN(MSS_FRC_CLY_SLC(LON_IDX),0.2D0) ! [frc] - - DST_SLT_FLX_RAT_TTL(LON_IDX) = ! [m-1] - & 100.0D0 * EXP(LN10*(13.4D0*MSS_FRC_CLY_VLD-6.0D0)) - ! MaB95 p. 16423 (47) - - FLX_MSS_VRT_DST_TTL(LON_IDX) = ! [kg M-1 s-1] - & FLX_MSS_HRZ_SLT_TTL(LON_IDX) - & * DST_SLT_FLX_RAT_TTL(LON_IDX) - - ENDIF - ENDDO - - ! Return to calling program - END SUBROUTINE FLX_MSS_VRT_DST_TTL_MAB95_GET - -!------------------------------------------------------------------------------ - - SUBROUTINE DST_PSD_MSS( OVR_SRC_SNK_FRC, MSS_FRC_SRC, - & OVR_SRC_SNK_MSS, NBINS, DST_SRC_NBR ) -! -!****************************************************************************** -! Subroutine DST_PSD_MSS computes OVR_SRC_SNK_MSS from OVR_SRC_SNK_FRC -! and MSS_FRC_SRC. (tdf, bmy, 4/5/04) -! -! Multiply ovr_src_snk_frc(src_idx,*) by mss_frc(src_idx) to obtain -! absolute mass fraction mapping from source dists. to sink bins -! -! Arguments as Input: -! ============================================================================ -! (1 ) OVR_SRC_SNK_FRC (REAL*8 ) : Mass overlap, Mij, Zender p. 5, Equ. 12 -! (2 ) MSS_FRC_SRC (REAL*8 ) : Mass fraction in each mode (Table 1, M) -! (4 ) NBINS (INTEGER) : Number of GEOS_CHEM dust bins -! (5 ) DST_SRC_NBR (INTEGER) : Number of source modes -! -! Arguments as Output: -! ============================================================================ -! (3 ) OVR_SRC_SNK_MSS (REAL*8 ) : Mass of stuff ??? -! -! NOTES: -! (1 ) Updated comments, cosmetic changes. Also now forces double-precision -! with "D" exponents. (tdf, bmy, 4/5/04) -!****************************************************************************** -! - !----------------- - ! Arguments - !----------------- - INTEGER, INTENT(IN) :: DST_SRC_NBR, NBINS - REAL*8, INTENT(IN) :: OVR_SRC_SNK_FRC(DST_SRC_NBR,NBINS) - REAL*8, INTENT(IN) :: MSS_FRC_SRC(DST_SRC_NBR) - REAL*8, INTENT(OUT) :: OVR_SRC_SNK_MSS(DST_SRC_NBR,NBINS) - - !----------------- - ! Local variables - !----------------- - INTEGER :: SRC_IDX, SNK_IDX - REAL*8 :: MSS_FRC_TRN_DST_SRC(NBINS) - REAL*8 :: OVR_SRC_SNK_MSS_TTL - - !================================================================= - ! DST_PSD_MSS begins here! - !================================================================= - - ! Fraction of vertical dust flux which is transported - OVR_SRC_SNK_MSS_TTL = 0.0D0 - - ! Fraction of transported dust mass at source - DO SNK_IDX = 1, NBINS - MSS_FRC_TRN_DST_SRC(SNK_IDX) = 0.0D0 - ENDDO - - DO SNK_IDX = 1, NBINS - DO SRC_IDX = 1, DST_SRC_NBR - OVR_SRC_SNK_MSS (SRC_IDX,SNK_IDX) = ! [frc] - & OVR_SRC_SNK_FRC (SRC_IDX,SNK_IDX) - & * MSS_FRC_SRC (SRC_IDX) ! [frc] - ENDDO - ENDDO - - ! Split double do loop into 2 parts tdf 10/22/2K3 - DO SNK_IDX = 1, NBINS - DO SRC_IDX = 1, DST_SRC_NBR - - ! [frc] Fraction of transported dust mass at source - MSS_FRC_TRN_DST_SRC(SNK_IDX) = - & MSS_FRC_TRN_DST_SRC(SNK_IDX) - & + OVR_SRC_SNK_MSS(SRC_IDX,SNK_IDX) - - ! [frc] Compute total transported mass fraction of dust flux - OVR_SRC_SNK_MSS_TTL = OVR_SRC_SNK_MSS_TTL - & + OVR_SRC_SNK_MSS (SRC_IDX,snk_idx) - ENDDO - ENDDO - - ! Convert fraction of mobilized mass to fraction of transported mass - DO SNK_IDX = 1, NBINS - MSS_FRC_TRN_DST_SRC (SNK_IDX) = - & MSS_FRC_TRN_DST_SRC (SNK_IDX) / OVR_SRC_SNK_MSS_TTL - ENDDO - - ! Return to calling program - END SUBROUTINE DST_PSD_MSS - -!------------------------------------------------------------------------------ - - SUBROUTINE FLX_MSS_VRT_DST_PRT( Inst, NX, FLG_MBL, - & FLX_MSS_VRT_DST, - & FLX_MSS_VRT_DST_TTL ) -! -!****************************************************************************** -! Subroutine FLX_MSS_VRT_DST_PRT partitions total vertical mass flux of dust -! into transport bins. Assumes a trimodal lognormal probability density -! function (see Zender et al., p. 5). (tdf, bmy, 4/5/04) -! -! DST_SRC_NBR = 3 - trimodal size distribution in source c regions (p. 5) -! OVR_SRC_SNK_MSS [frc] computed in dst_psd_mss, called from dust_mod.f -! -! Arguments as Input: -! ============================================================================ -! (1 ) FLG_MBL (LOGICAL) : Mobilization candidate flag -! (3 ) FLX_MSS_VRT_DST_TTL (REAL*8 ) : Total vert. mass flux of dust [kg/m2/s] -! -! Arguments as Output: -! ============================================================================ -! (2 ) FLX_MSS_VRT_DST (REAL*8 ) : Vertical mass flux of dust [kg/m2/s] -! -! NOTES: -! (1 ) Updated comments, cosmetic changes. Also now forces double-precision -! with "D" exponents. (tdf, bmy, 4/5/04) -!****************************************************************************** -! - - ! Arguments - TYPE(MyInst), POINTER :: Inst - INTEGER, INTENT(IN) :: NX - LOGICAL, INTENT(IN) :: FLG_MBL(NX) - REAL*8, INTENT(IN) :: FLX_MSS_VRT_DST_TTL(NX) - REAL*8, INTENT(OUT) :: FLX_MSS_VRT_DST(NX,NBINS) - - ! Local variables - INTEGER :: LON_IDX ! [idx] Counting index for lon - INTEGER :: SRC_IDX ! [idx] Counting index for src - INTEGER :: SNK_IDX ! [idx] Counting index for snk - INTEGER :: SNK_NBR ! [nbr] Dimension size - - !================================================================= - ! FLX_MSS_VRT_DST_PRT begins here! - !================================================================= - - ! Initialize - FLX_MSS_VRT_DST(:,:) = 0.0D0 ! [frc] - - ! Loop over longitudes (NB: Inefficient loop order) - DO LON_IDX = 1, NX - - ! If this is a mobilization candidate... - IF ( FLG_MBL(LON_IDX) ) THEN - - ! Loop over source & sink indices - DO SNK_IDX = 1, NBINS - DO SRC_IDX = 1, DST_SRC_NBR - FLX_MSS_VRT_DST(LON_IDX,SNK_IDX) = ! [kg m-2 s-1] - & FLX_MSS_VRT_DST(LON_IDX,SNK_IDX) - & + Inst%OVR_SRC_SNK_MSS(SRC_IDX,SNK_IDX) - & * FLX_MSS_VRT_DST_TTL(LON_IDX) - ENDDO - ENDDO - ENDIF - ENDDO - - ! Return to calling program - END SUBROUTINE FLX_MSS_VRT_DST_PRT - -!------------------------------------------------------------------------------ - - SUBROUTINE TM_2_IDX_WGT() - - ! routine eliminated: see original code - END SUBROUTINE TM_2_IDX_WGT - -!------------------------------------------------------------------------------ - - SUBROUTINE LND_FRC_MBL_GET( HcoState, DOY, - & FLG_MBL, LAT_RDN, - & LND_FRC_DRY_SLC, LND_FRC_MBL, MBL_NBR, - & ORO, SFC_TYP_SLC, SNW_FRC, - & TPT_SOI, TPT_SOI_FRZ, VAI_DST_SLC, - & RC) -! -!****************************************************************************** -! Subroutine LND_FRC_MBL_GET returns the fraction of each GEOS-CHEM grid -! box which is suitable for dust mobilization. This routine is called -! by DST_MBL. (tdf, bmy, 4/5/04, 1/13/10) -! -! The DATE is used to obtain the time-varying vegetation cover. -! Routine currently uses latitude slice of VAI from time-dependent surface -! boundary dataset (tdf, 10/27/03). LAI/VAI algorithm is from CCM:lsm/phenol -! () Bon96. The LSM data are mid-month values, i.e., valid on the 15th of ! -! the month.! -! -! Criterion for mobilisation candidate (tdf, 4/5/04): -! (1) first, must be a land point, not ocean, not ice -! (2) second, it cannot be an inland lake, wetland or ice -! (3) modulated by vegetation type -! (4) modulated by subgridscale wetness -! (5) cannot be snow covered -! -! Arguments as Input: -! ============================================================================ -! (1 ) DOY (REAL*8 ) : Day of year [1.0-366.0] -! (3 ) LAT_RDN (REAL*8 ) : Latitude [radians ] -! (4 ) LND_FRC_DRY (REAL*8 ) : Dry land fraction [fraction ] -! (7 ) ORO (REAL*8 ) : Orography: land/ocean/ice [flags ] -! (8 ) SFC_TYP (INTEGER) : LSM surface type (0..28) [unitless ] -! (9 ) SNW_FRC (REAL*8 ) : Fraction of surface covered by snow [fraction ] -! (10) TPT_SOI (REAL*8 ) : Soil temperature [K ] -! (11) TPT_SOI_FRZ (REAL*8 ) : Temperature of frozen soil [K ] -! (12) VAI_DST (REAL*8 ) : Vegetation area index, one-sided [m2/m2 ] -! -! Arguments as Output: -! ============================================================================ -! (2 ) FLG_MBL (LOGICAL) : Mobilization candidate flag [flag ] -! (5 ) LND_FRC_MBL (REAL*8 ) : Bare ground fraction [fraction ] -! (6 ) MBL_NBR (INTEGER) : Number of mobilization candidates [unitless ] -! -! NOTES: -! (1 ) Updated comments, cosmetic changes. Also now forces double-precision -! with "D" exponents. (tdf, bmy, 4/5/04) -! (2 ) For the GOCART source function, we don't use VAI, so set FLG_VAI_TVBDS -! = .FALSE. and disable calls to ERROR_STOP (tdf, bmy, 1/25/07) -! (3 ) Modification for GEOS-4 1 x 1.25 grids (lok, bmy, 1/13/10) -!****************************************************************************** -! - - !------------------ - ! Arguments - !------------------ - TYPE(HCO_State), POINTER :: HcoState - INTEGER, INTENT(IN) :: SFC_TYP_SLC(HcoState%NX) - REAL*8, INTENT(IN) :: DOY - REAL*8, INTENT(IN) :: LAT_RDN - REAL*8, INTENT(IN) :: LND_FRC_DRY_SLC(HcoState%NX) - REAL*8, INTENT(IN) :: ORO(HcoState%NX) - REAL*8, INTENT(IN) :: SNW_FRC(HcoState%NX) - REAL*8, INTENT(IN) :: TPT_SOI(HcoState%NX) - REAL*8, INTENT(IN) :: TPT_SOI_FRZ - REAL*8, INTENT(IN) :: VAI_DST_SLC(HcoState%NX) - INTEGER, INTENT(OUT) :: MBL_NBR - LOGICAL, INTENT(OUT) :: FLG_MBL(HcoState%NX) - REAL*8, INTENT(OUT) :: LND_FRC_MBL(HcoState%NX) - INTEGER, INTENT(INOUT) :: RC - - !------------------ - ! Parameters - !------------------ - - ! VAI threshold quench [m2/m2] - REAL*8, PARAMETER :: VAI_MBL_THR = 0.30D0 - - !------------------ - ! Local variables - !------------------ - - ! [idx] Counting index - INTEGER :: IDX_IDX - - ! [idx] Interpolation month, future - INTEGER :: IDX_MTH_GLB - - ! [idx] Interpolation month, past - INTEGER :: IDX_MTH_LUB - - ! [idx] Longitude index array (land) - INTEGER :: LND_IDX(HcoState%NX) - - ! [nbr] Number of land points - INTEGER :: LND_NBR - - ! [idx] Counting index for longitude - INTEGER :: LON_IDX - - ! [idx] Surface type index - INTEGER :: SFC_TYP_IDX - - ! [idx] Surface sub-gridscale index - INTEGER :: SGS_IDX - - !------------------------------------------------------------------- - ! Prior to 1/25/07: - ! For GOCART source function, we don't use VAI (tdf, bmy, 1/25/07) - ! - ! %%%%% DO NOT DELETE -- LEAVE THIS CODE COMMENTED OUT %%%%% - ! - !! [flg] Use VAI data from time-varying boundary dataset - ! LOGICAL :: FLG_VAI_TVBDS = .TRUE. - !------------------------------------------------------------------- - - ! For GOCART source function, we do not use VAI (tdf, bmy, 1/25/07) - LOGICAL :: FLG_VAI_TVBDS = .FALSE. - - ! [flg] Add 182 days in southern hemisphere - LOGICAL :: FLG_SH_ADJ = .TRUE. - - ! [dgr] Latitude - REAL*8 :: LAT_DGR - - ! [m2 m-2] Leaf + stem area index, one-sided - REAL*8 :: VAI_SGS - - ! Error handling - CHARACTER(LEN=255) :: MSG - - !================================================================= - ! LND_FRC_MBL_GET begins here! - !================================================================= - - ! Error check - IF ( VAI_MBL_THR <= 0.0d0 ) THEN - MSG = 'VAI_MBL_THR <= 0.0' - CALL HCO_ERROR(MSG, RC, - & THISLOC='LND_FRC_MBL_GET' ) - RETURN - ENDIF - - ! Latitude (degrees) - LAT_DGR = 180.0D0 * LAT_RDN/HcoState%Phys%PI - - ! Initialize outputs - MBL_NBR = 0 - - DO LON_IDX = 1, HcoState%NX - FLG_MBL(LON_IDX) = .FALSE. - ENDDO - - LND_FRC_MBL(:) = 0.0D0 - - !================================================================= - ! For dust mobilisation, we need to have land! tdf 10/27/2K3 - ! Set up lnd_idx to hold the longitude indices for land - ! Land ahoy! - !================================================================= - LND_NBR = 0 - DO LON_IDX = 1, HcoState%NX - IF ( ORO_IS_LND( ORO(LON_IDX)) ) THEN - LND_NBR = LND_NBR + 1 - LND_IDX(LND_NBR) = LON_IDX - ENDIF - ENDDO - - ! Much ado about nothing (no land points) - IF ( LND_NBR == 0 ) RETURN - -!----------------------------------------------------------------------------- -! Prior to 1/25/07: -! When GOCART source function is used, VAI flag is NOT used, so -! we need to disable the ERROR_STOP call (tdf, bmy, 1/25/07) -! -! %%%%% DO NOT DELETE -- LEAVE THIS CODE COMMENTED OUT %%%%% -! -! ! Introduce error message for flg_vai_tvbds=F (VAI not used!) -! IF ( .not. FLG_VAI_TVBDS ) THEN -!c print *,' FLG_VAI_TVBDS is false: GOCART source function used' -! CALL ERROR_STOP( 'FLG_VAI_TVBDS=F', -! & 'LND_FRC_MBL_GET ("dust_dead_mod.f")' ) -! ENDIF -!----------------------------------------------------------------------------- - - !================================================================= - ! Only land points are possible candidates for dust mobilization - !================================================================= - - ! Loop over land points - DO IDX_IDX = 1, LND_NBR - LON_IDX = LND_IDX(IDX_IDX) - - ! Store surface blend of current gridpoint - SFC_TYP_IDX = SFC_TYP_SLC(LON_IDX) - - ! Check for wet or frozen conditions - no mobilisation allowed - ! Surface type 1 = inland lakes & land ice - ! Surface type 27 = wetlands - IF ( SFC_TYP_IDX <= 1 .OR. SFC_TYP_IDX >= 27 .OR. - & TPT_SOI(LON_IDX) < TPT_SOI_FRZ ) THEN - - ! SET bare ground fraction to zero - LND_FRC_MBL(LON_IDX) = 0.0D0 - - ELSE - - !------------------------- - ! If we are using VAI... - !------------------------- - IF ( FLG_VAI_TVBDS ) THEN - - ! "bare ground" fraction of current gridcell decreases - ! linearly from 1.0 to 0.0 as VAI increases from 0.0 to - ! vai_mbl_thr. NOTE: vai_mbl_thr set to 0.3 (tdf, 4/5/04) - LND_FRC_MBL(LON_IDX) = - & 1.0D0 - MIN(1.0D0, MIN(VAI_DST_SLC(LON_IDX), - & VAI_MBL_THR) / VAI_MBL_THR) - - !--------------------------- - ! If we're not using VAI... - !--------------------------- - ELSE - -!----------------------------------------------------------------------------- -! Prior to 1/25/07: -! When GOCART source function is used, VAI flag is NOT used, so -! we need to disable the ERROR_STOP call. (tdf, bmy, 1/25/07) -! -! %%%%% DO NOT DELETE -- LEAVE THIS CODE COMMENTED OUT %%%%% -! -! CALL ERROR_STOP( 'FLG_VAI_TVBDS=F', -! & 'LND_FRC_MBL_GET ("dust_dead_mod.f")' ) -!----------------------------------------------------------------------------- - - ! For GOCART source function, set the bare - ! ground fraction to 1 (tdf, bmy, 1/25/07) - LND_FRC_MBL(LON_IDX) = 1.0D0 - - ENDIF - - ENDIF ! endif normal land - - !============================================================== - ! We have now filled "lnd_frc_mbl" the land fraction suitable - ! for mobilisation. Adjust for factors which constrain entire - ! gridcell LND_FRC_MBL modulated by LND_FRC_DRY and SNW_FRC. - ! (tdf, 4/5/04) - !============================================================== - - ! Take the bare ground fraction, multiply by the fraction - ! that is dry and that is NOT covered by snow - LND_FRC_MBL(LON_IDX) = LND_FRC_MBL(LON_IDX) - & * LND_FRC_DRY_SLC(LON_IDX) - & * ( 1.0D0 - SNW_FRC(LON_IDX) ) - - ! Temporary fix for 1 x 1.25 grids -- Lok Lamsal 1/13/10 - IF ( LND_FRC_MBL(LON_IDX) .GT. 1.0D0 ) THEN - LND_FRC_MBL(LON_IDX) = 0.99D0 - ENDIF - - ! Error check - IF ( LND_FRC_MBL(lon_idx) > 1.0D0 ) THEN - MSG = 'LND_FRC_MBL > 1' - CALL HCO_ERROR(MSG, RC, - & THISLOC='LND_FRC_MBL_GET' ) - RETURN - ENDIF - - IF ( LND_FRC_MBL(LON_IDX) < 0.0D0 ) then - MSG = 'LND_FRC_MBL < 0' - CALL HCO_ERROR(MSG, RC, - & THISLOC='LND_FRC_MBL_GET' ) - RETURN - ENDIF - - ! If there is dry land in this longitude - if ( LND_FRC_MBL(LON_IDX) > 0.0D0 ) then - - ! Set flag, we have a candidate! - FLG_MBL(LON_IDX) = .TRUE. - - ! Increment # of candidates - MBL_NBR = MBL_NBR + 1 - ENDIF - - ENDDO - - ! Return w/ success - RC = HCO_SUCCESS - - ! Return to calling program - END SUBROUTINE LND_FRC_MBL_GET - -!------------------------------------------------------------------------------ - - SUBROUTINE DST_ADD_LON( NX, NBINS, Q, Q_TTL ) -! -!****************************************************************************** -! Subroutine DST_ADD_LON dst_add_lon() computes and returns the total -! property (e.g., mixing ratio, flux), obtained by simply adding along the -! (dust) constituent dimension, when given an 3-D array of an additive -! property (e.g., mixing ratio, flux). (tdf, bmy, 4/5/04) -! -! Arguments as Input: -! ============================================================================ -! (1 ) q (REAL*8) : Total property -! -! Arguments as Output: -! ============================================================================ -! (2 ) q_ttl (REAL*8) : Property for each size class -! -! NOTES: -! (1 ) Updated comments, cosmetic changes. Also now forces double-precision -! with "D" exponents. (tdf, bmy, 4/5/04) -!****************************************************************************** -! - - ! Arguments - INTEGER, INTENT(IN) :: NX, NBINS - REAL*8, INTENT(IN) :: Q(NX,NBINS) - REAL*8, INTENT(OUT) :: Q_TTL(NX) - - ! Local variables - INTEGER :: I, M - - !================================================================= - ! DST_ADD_LON begins here! - !================================================================= - - ! Initialize - Q_TTL = 0d0 - - ! Loop over dust bins - DO M = 1, NBINS - - ! Loop over longitudes - DO I = 1, NX - - ! Integrate! - Q_TTL(I) = Q_TTL(I) + Q(I,M) - - ENDDO - ENDDO - - ! Return to calling program - END SUBROUTINE DST_ADD_LON - -!------------------------------------------------------------------------------ - - SUBROUTINE DST_TVBDS_GET( Inst, NX, LAT_IDX, VAI_DST_OUT ) -! -!****************************************************************************** -! Subroutine DST_TVBDS_GET returns a specifed latitude slice of VAI data. -! (tdf, bmy, 4/5/04) -! -! Arguments as Input: -! ============================================================================ -! (1 ) LAT_IDX (INTEGER) : Latitude index -! -! Arguments as Output: -! ============================================================================ -! (2 ) VAI_DST_OUT (REAL*8 ) : Vegetation area index, 1-sided, current [m2/m2] -! -! NOTES: -! (1 ) Updated comments, cosmetic changes. Also now forces double-precision -! with "D" exponents. (tdf, bmy, 4/5/04) -!****************************************************************************** -! - - ! Arguments - TYPE(MyInst), POINTER :: Inst - INTEGER, INTENT(IN) :: NX - INTEGER, INTENT(IN) :: LAT_IDX - REAL*8, INTENT(OUT) :: VAI_DST_OUT(:) - - ! Local variables - INTEGER :: LON_IDX - - !================================================================= - ! DST_TVBDS_GET begins here! - !================================================================= - - ! Return lat slice of VAI [m2/m2] - DO LON_IDX = 1, NX - VAI_DST_OUT(LON_IDX) = Inst%VAI_DST(LON_IDX,LAT_IDX) - ENDDO - - ! Return to calling program - END SUBROUTINE DST_TVBDS_GET - -!------------------------------------------------------------------------------ - - SUBROUTINE OVR_SRC_SNK_FRC_GET( HcoState, - & SRC_NBR, MDN_SRC, - & GSD_SRC, SNK_NBR, - & DMT_MIN_SNK, DMT_MAX_SNK, - & OVR_SRC_SNK_FRC, RC ) - - USE HCO_CLOCK_MOD, ONLY : HcoClock_First -! -!****************************************************************************** -! Subroutine OVR_SRC_SNK_FRC_GET, given one set (the "source") of lognormal -! distributions, and one set of bin boundaries (the "sink"), computes and -! returns the overlap factors between the source distributions and the sink -! bins. (tdf, bmy, 4/5/04) -! -! The output is a matrix, Mij, OVR_SRC_SNK_FRC(SRC_NBR,SNK_NBR) -! Element ovr_src_snk_frc(i,j) is the fraction of size distribution i -! in group src that overlaps sink bin j -! -! Arguments as Input: -! ============================================================================ -! (1 ) SRC_NBR (INTEGER) : Dimension size [unitless] -! (2 ) MDN_SRC (REAL*8 ) : Mass median particle size [m ] -! (3 ) GSD_SRC (REAL*8 ) : Geometric standard deviation [fraction] -! (4 ) SNK_NBR (INTEGER) : Dimension size [unitless] -! (5 ) DMT_MIN_SNK (REAL*8 ) : Minimum diameter in bin [m ] -! (6 ) DMT_MAX_SNK (REAL*8 ) : Maximum diameter in bin [m ] -! -! Arguments as Output: -! ============================================================================ -! (7 ) OVR_SRC_SNK_FRC (REAL*8 ) : Fractional overlap of src with snk, Mij. -! -! NOTES -! (1 ) Updated comments, cosmetic changes. Also now forces double-precision -! with "D" exponents. (tdf, bmy, 4/5/04) -!****************************************************************************** -! - - ! Arguments - TYPE(HCO_State), POINTER :: HcoState - INTEGER, INTENT(IN) :: SRC_NBR - REAL*8, INTENT(IN) :: MDN_SRC(SRC_NBR) - REAL*8, INTENT(IN) :: GSD_SRC(SRC_NBR) - INTEGER, INTENT(IN) :: SNK_NBR - REAL*8, INTENT(IN) :: DMT_MIN_SNK(SNK_NBR) - REAL*8, INTENT(IN) :: DMT_MAX_SNK(SNK_NBR) - REAL*8, INTENT(OUT) :: OVR_SRC_SNK_FRC(SRC_NBR,SNK_NBR) - INTEGER, INTENT(INOUT) :: RC - - ! Local -! LOGICAL :: FIRST = .TRUE. - INTEGER :: SRC_IDX ! [idx] Counting index for src - INTEGER :: SNK_IDX ! [idx] Counting index for snk - REAL*8 :: LN_GSD ! [frc] ln(gsd) - REAL*8 :: SQRT2LNGSDI ! [frc] Factor in erf() argument - REAL*8 :: LNDMAXJOVRDMDNI ! [frc] Factor in erf() argument - REAL*8 :: LNDMINJOVRDMDNI ! [frc] Factor in erf() argument - CHARACTER(LEN=255) :: MSG - - !================================================================= - ! OVR_SRC_SNK_FRC_GET begins here - !================================================================= - - IF ( HcoClock_First(HcoState%Clock,.TRUE.) ) THEN - - ! Test if ERF is implemented OK on this platform - ! 19990913: erf() in SGI /usr/lib64/mips4/libftn.so is bogus - IF ( ABS( 0.8427d0 - ERF(1.0d0) ) / 0.8427d0 > 0.001d0 ) THEN - MSG = 'ERF error 1 in OVR_SRC_SNK_FRC_GET!' - CALL HCO_ERROR(MSG, RC, - & THISLOC='OVR_SRC_SNK_FRC_GET' ) - RETURN - ENDIF - - ! Another ERF check - IF ( ERF( 0.0D0 ) /= 0.0D0 ) THEN - MSG = 'ERF error 2 in OVR_SRC_SNK_FRC_GET!' - CALL HCO_ERROR(MSG, RC, - & THISLOC='OVR_SRC_SNK_FRC_GET' ) - RETURN - ENDIF - - ! Reset first-time flag - !FIRST = .FALSE. - ENDIF - - - ! Loop over source index (cf Zender et al eq 12) - DO SRC_IDX = 1, SRC_NBR - - ! Fraction - SQRT2LNGSDI = SQRT(2.0D0) * LOG( GSD_SRC(SRC_IDX) ) - - ! Loop over sink index - DO SNK_IDX = 1, SNK_NBR - - ! [fraction] - LNDMAXJOVRDMDNI = LOG(DMT_MAX_SNK(SNK_IDX)/MDN_SRC(SRC_IDX)) - - ! [fraction] - LNDMINJOVRDMDNI = LOG(DMT_MIN_SNK(SNK_IDX)/MDN_SRC(SRC_IDX)) - - ! [fraction] - OVR_SRC_SNK_FRC (SRC_IDX,SNK_IDX)= ! [frc] - & 0.5D0 * (ERF(LNDMAXJOVRDMDNI/SQRT2LNGSDI) - & - ERF(LNDMINJOVRDMDNI/SQRT2LNGSDI) ) - ENDDO - ENDDO - - ! Return w/ success - RC = HCO_SUCCESS - - END SUBROUTINE OVR_SRC_SNK_FRC_GET - -!------------------------------------------------------------------------------ - - FUNCTION ERF( X ) RESULT( ERF_VAL ) -! -!****************************************************************************** -! Function ERF returns the error function erf(x). See comments heading -! routine CALERF below. Author/Date: W. J. Cody, January 8, 1985 -! (tdf, bmy, 4/5/04) -! -! Arguments as Input: -! ============================================================================ -! (1 ) X (REAL*8) : Argument to erf(x) -! -! NOTES: -! (1 ) Updated comments (bmy, 4/5/04) -!****************************************************************************** -! - IMPLICIT NONE - - ! Arguments - REAL*8, INTENT(IN) :: X - - ! Local variables - INTEGER :: JINT - REAL*8 :: RESULT, ERF_VAL - - !================================================================ - ! ERF begins here! - !================================================================ - JINT = 0 - CALL CALERF( X, RESULT, JINT ) - ERF_VAL = RESULT - - ! Return to calling program - END FUNCTION ERF - -!------------------------------------------------------------------------------ - - SUBROUTINE CALERF( ARG, RESULT, JINT ) -! -!****************************************************************************** -! This packet evaluates erf(x), erfc(x), and exp(x*x)*erfc(x) -! for a real argument x. It contains three function type -! subprograms: erf, erfc, and erfcx (or derf, derfc, and derfcx), -! and one subroutine type subprogram, calerf. The calling -! statements for the primary entries are: -! -! y=erf(x) (or y=derf(x)), -! y=erfc(x) (or y=derfc(x)), -! and -! y=erfcx(x) (or y=derfcx(x)). -! -! The routine calerf is intended for internal packet use only, -! all computations within the packet being concentrated in this -! routine. The function subprograms invoke calerf with the -! statement -! call calerf(arg,result,jint) -! where the parameter usage is as follows -! -! Function Parameters for calerf -! Call Arg Result Jint -! -! erf(arg) any real argument erf(arg) 0 -! erfc(arg) abs(arg) < xbig erfc(arg) 1 -! erfcx(arg) xneg < arg < xmax erfcx(arg) 2 -! -! The main computation evaluates near-minimax approximations: -! from "Rational Chebyshev Approximations for the Error Function" -! by W. J. Cody, Math. Comp., 1969, pp. 631-638. This -! transportable program uses rational functions that theoretically -! approximate erf(x) and erfc(x) to at least 18 significant -! decimal digits. The accuracy achieved depends on the arithmetic -! system, the compiler, the intrinsic functions, and proper -! selection of the machine-dependent constants. -! -! Explanation of machine-dependent constants: -! xmin = The smallest positive floating-point number. -! xinf = The largest positive finite floating-point number. -! xneg = The largest negative argument acceptable to erfcx; -! the negative of the solution to the equation -! 2*exp(x*x) = xinf. -! xsmall = Argument below which erf(x) may be represented by -! 2*x/sqrt(pi) and above which x*x will not underflow. -! A conservative value is the largest machine number x -! such that 1.0 + x = 1.0 to machine precision. -! xbig = Largest argument acceptable to erfc; solution to -! the equation: w(x)* (1-0.5/x**2) = xmin, where -! w(x) = exp(-x*x)/[x*sqrt(pi)]. -! xhuge = Argument above which 1.0 - 1/(2*x*x) = 1.0 to -! machine precision. a conservative value is -! 1/[2*sqrt(xsmall)] -! xmax = Largest acceptable argument to erfcx; the minimum -! of xinf and 1/[sqrt(pi)*xmin]. -! -! Approximate values for some important machines are: -! xmin xinf xneg xsmall -! CDC 7600 (s.p.) 3.13e-294 1.26e+322 -27.220 7.11e-15 -! Cray-1 (s.p.) 4.58e-2467 5.45e+2465 -75.345 7.11e-15 -! IEEE (IBM/XT, -! Sun, etc.) (s.p.) 1.18e-38 3.40e+38 -9.382 5.96e-8 -! IEEE (IBM/XT, -! Sun, etc.) (d.p.) 2.23d-308 1.79d+308 -26.628 1.11d-16 -! IBM 195 (d.p.) 5.40d-79 7.23e+75 -13.190 1.39d-17 -! Univac 1108 (d.p.) 2.78d-309 8.98d+307 -26.615 1.73d-18 -! Vax d-format (d.p.) 2.94d-39 1.70d+38 -9.345 1.39d-17 -! Vax g-format (d.p.) 5.56d-309 8.98d+307 -26.615 1.11d-16 -! -! xbig xhuge xmax -! CDC 7600 (s.p.) 25.922 8.39e+6 1.80x+293 -! Cray-1 (s.p.) 75.326 8.39e+6 5.45e+2465 -! IEEE (IBM/XT, -! Sun, etc.) (s.p.) 9.194 2.90e+3 4.79e+37 -! IEEE (IBM/XT, -! Sun, etc.) (d.p.) 26.543 6.71d+7 2.53d+307 -! IBM 195 (d.p.) 13.306 1.90d+8 7.23e+75 -! Univac 1108 (d.p.) 26.582 5.37d+8 8.98d+307 -! Vax d-format (d.p.) 9.269 1.90d+8 1.70d+38 -! Vax g-format (d.p.) 26.569 6.71d+7 8.98d+307 -! -! Error returns: -! The program returns erfc = 0 for arg >= xbig; -! erfcx = xinf for arg < xneg; -! and -! erfcx = 0 for arg >= xmax. -! -! Intrinsic functions required are: -! abs, aint, exp -! -! Author: W. J. Cody -! Mathematics And Computer Science Division -! Argonne National Laboratory -! Argonne, IL 60439 -! Latest modification: March 19, 1990 -! -! NOTES: -! (1 ) Now force double-precision w/ "D" exponents (bmy, 4/5/04) -!****************************************************************************** -! - IMPLICIT NONE - INTEGER I,JINT - REAL*8 A,ARG,B,C,D,DEL,FOUR,HALF,P,ONE,Q,RESULT,SIXTEN,SQRPI, - & TWO,THRESH,X,XBIG,XDEN,XHUGE,XINF,XMAX,XNEG,XNUM,XSMALL, - & Y,YSQ,ZERO - DIMENSION A(5),B(4),C(9),D(8),P(6),Q(5) - - ! Mathematical constants - data four,one,half,two,zero/4.0d0,1.0d0,0.5d0,2.0d0,0.0d0/, - & sqrpi/5.6418958354775628695d-1/,thresh/0.46875d0/, - & sixten/16.0d0/ - - ! Machine-dependent constants - data xinf,xneg,xsmall/3.40d+38,-9.382d0,5.96d-8/, - & xbig,xhuge,xmax/9.194d0,2.90d3,4.79d37/ - - ! Coefficients for approximation to erf in first interval - data a /3.16112374387056560d00,1.13864154151050156d02, - & 3.77485237685302021d02,3.20937758913846947d03, - & 1.85777706184603153d-1/ - - data b /2.36012909523441209d01,2.44024637934444173d02, - & 1.28261652607737228d03,2.84423683343917062d03/ - - ! Coefficients for approximation to erfc in second interval - data c /5.64188496988670089d-1,8.88314979438837594d0, - & 6.61191906371416295d01,2.98635138197400131d02, - & 8.81952221241769090d02,1.71204761263407058d03, - & 2.05107837782607147d03,1.23033935479799725d03, - & 2.15311535474403846d-8/ - - data d /1.57449261107098347d01,1.17693950891312499d02, - & 5.37181101862009858d02,1.62138957456669019d03, - & 3.29079923573345963d03,4.36261909014324716d03, - & 3.43936767414372164d03,1.23033935480374942d03/ - - ! Coefficients for approximation to erfc in third interval - data p /3.05326634961232344d-1,3.60344899949804439d-1, - & 1.25781726111229246d-1,1.60837851487422766d-2, - & 6.58749161529837803d-4,1.63153871373020978d-2/ - - data q /2.56852019228982242d00,1.87295284992346047d00, - & 5.27905102951428412d-1,6.05183413124413191d-2, - & 2.33520497626869185d-3/ - -c Main Code - x=arg - y=abs(x) - if (y <= thresh) then -c Evaluate erf for |x| <= 0.46875 - ysq=zero - if (y > xsmall) ysq=y*y - xnum=a(5)*ysq - xden=ysq - do i=1,3 - xnum=(xnum+a(i))*ysq - xden=(xden+b(i))*ysq - end do - result=x*(xnum+a(4))/(xden+b(4)) - if (jint /= 0) result=one-result - if (jint == 2) result=exp(ysq)*result - go to 800 - -c Evaluate erfc for 0.46875 <= |x| <= 4.0 - else if (y <= four) then - xnum=c(9)*y - xden=y - do i=1,7 - xnum=(xnum+c(i))*y - xden=(xden+d(i))*y - end do - result=(xnum+c(8))/(xden+d(8)) - if (jint /= 2) then - ysq=aint(y*sixten)/sixten - del=(y-ysq)*(y+ysq) - result=exp(-ysq*ysq)*exp(-del)*result - end if - -c Evaluate erfc for |x| > 4.0 - else - result=zero - if (y >= xbig) then - if ((jint /= 2).or.(y >= xmax)) go to 300 - if (y >= xhuge) then - result=sqrpi/y - go to 300 - end if - end if - ysq=one/(y*y) - xnum=p(6)*ysq - xden=ysq - do i=1,4 - xnum=(xnum+p(i))*ysq - xden=(xden+q(i))*ysq - end do - result=ysq*(xnum+p(5))/(xden+q(5)) - result=(sqrpi-result)/y - if (jint /= 2) then - ysq=aint(y*sixten)/sixten - del=(y-ysq)*(y+ysq) - result=exp(-ysq*ysq)*exp(-del)*result - end if - end if - -c Fix up for negative argument, erf, etc. - 300 if (jint == 0) then - result=(half-result)+half - if (x < zero) result=-result - else if (jint == 1) then - if (x < zero) result=two-result - else - if (x < zero) then - if (x < xneg) then - result=xinf - else - ysq=aint(x*sixten)/sixten - del=(x-ysq)*(x+ysq) - y=exp(ysq*ysq)*exp(del) - result=(y+y)-result - end if - end if - end if - 800 return - - ! Return to calling program - END SUBROUTINE CALERF - -!------------------------------------------------------------------------------ - - SUBROUTINE PLN_TYP_GET( PLN_TYP, PLN_FRC, TAI ) - -! -!****************************************************************************** -! Subroutine PLN_TYPE_GET returns LSM information needed by the DEAD -! dust parameterization. (tdf, bmy, 4/5/04) -! -! Arguments as Output: -! ============================================================================ -! (1 ) PLN_TYP (INTEGER) : LSM plant type index (1..14) -! (2 ) PLN_TYP (REAL*8 ) : Weight of corresponding plant type (sums to 1.0) -! (3 ) TAI (REAL*8 ) : Leaf-area index (one sided) [index] -! -! NOTES: -! (1 ) Updated comments. Now force double-precision w/ "D" exponents. -! (bmy, 4/5/04) -!****************************************************************************** -! - ! Arguments - INTEGER, INTENT(OUT) :: PLN_TYP(0:28,3) - REAL*8, INTENT(OUT) :: PLN_FRC(0:28,3) - REAL*8, INTENT(OUT) :: TAI(14,12) - - ! Local variables - INTEGER :: I, J - - !================================================================= - ! There are 29 land surface types: 0 = ocean, 1 to 28 = land. - ! Each land point has up to three vegetation types, ranging in - ! value from 1 to 14. PLN_TYPE contains the vegetation type of - ! the 3 subgrid points for each surface type. PLN_FRC contains - ! the fractional area of the 3 subgrid points for each surface - ! type. - !================================================================= - PLN_TYP(0:28,1) = (/ 0, - & 14, 14, 1, 2, 4, 1 , 1, - & 4, 1, 3, 5, 13, 1, 2, - & 11, 11, 6, 13, 9, 7, 8, - & 8, 12, 11, 12, 11, 3, 14/) - - PLN_FRC(0:28,1) = (/ 0.00d0, - & 1.00d0, 1.00d0, 0.75d0, 0.50d0, - & 0.75d0, 0.37d0, 0.75d0, - & 0.75d0, 0.37d0, 0.95d0, 0.75d0, - & 0.70d0, 0.25d0, 0.25d0, - & 0.40d0, 0.40d0, 0.60d0, 0.60d0, - & 0.30d0, 0.80d0, 0.80d0, - & 0.10d0, 0.85d0, 0.85d0, 0.85d0, - & 0.85d0, 0.80d0, 1.00d0/) - - - PLN_TYP(0:28,2) = (/ 0, - & 14, 14, 14, 14, 14, 4 ,14, - & 14, 4, 14, 14, 5, 10, 10, - & 4, 4, 13, 6, 10, 14, 14, - & 14, 14, 14, 14, 14, 14, 14/) - - PLN_FRC(0:28,2) = (/ 0.00d0, - & 0.00d0, 0.00d0, 0.25d0, 0.50d0, - & 0.25d0, 0.37d0, 0.25d0, - & 0.25d0, 0.37d0, 0.05d0, 0.25d0, - & 0.30d0, 0.25d0, 0.25d0, - & 0.30d0, 0.30d0, 0.20d0, 0.20d0, - & 0.30d0, 0.20d0, 0.20d0, - & 0.90d0, 0.15d0, 0.15d0, 0.15d0, - & 0.15d0, 0.20d0, 0.00d0/) - - PLN_TYP(0:28,3) = (/ 0, - & 14, 14, 14, 14, 14, 14, 14, - & 14, 14, 14, 14, 14, 14, 14, - & 1, 1, 14, 14, 14, 14, 14, - & 14, 14, 14, 14, 14, 14, 14/) - - PLN_FRC(0:28,3) = (/ 0.00d0, - & 0.00d0, 0.00d0, 0.00d0, 0.00d0, - & 0.00d0, 0.26d0, 0.00d0, - & 0.00d0, 0.26d0, 0.00d0, 0.00d0, - & 0.00d0, 0.50d0, 0.50d0, - & 0.30d0, 0.30d0, 0.20d0, 0.20d0, - & 0.40d0, 0.00d0, 0.00d0, - & 0.00d0, 0.00d0, 0.00d0, 0.00d0, - & 0.00d0, 0.00d0, 0.00d0/) - - !================================================================= - ! ---------------------------------------------------------------- - ! description of the 29 surface types - ! ---------------------------------------------------------------- - ! - ! no vegetation - ! ------------- - ! 0 ocean - ! 1 land ice (glacier) - ! 2 desert - ! - ! forest vegetation - ! ----------------- - ! 3 cool needleleaf evergreen tree - ! 4 cool needleleaf deciduous tree - ! 5 cool broadleaf deciduous tree - ! 6 cool mixed needleleaf evergreen and broadleaf deciduous tree - ! 7 warm needleleaf evergreen tree - ! 8 warm broadleaf deciduous tree - ! 9 warm mixed needleleaf evergreen and broadleaf deciduous tree - ! 10 tropical broadleaf evergreen tree - ! 11 tropical seasonal deciduous tree - ! - ! interrupted woods - ! ---------------- - ! 12 savanna - ! 13 evergreen forest tundra - ! 14 deciduous forest tundra - ! 15 cool forest crop - ! 16 warm forest crop - ! - ! non-woods - ! --------- - ! 17 cool grassland - ! 18 warm grassland - ! 19 tundra - ! 20 evergreen shrub - ! 21 deciduous shrub - ! 22 semi-desert - ! 23 cool irrigated crop - ! 24 cool non-irrigated crop - ! 25 warm irrigated crop - ! 26 warm non-irrigated crop - ! - ! wetlands - ! -------- - ! 27 forest (mangrove) - ! 28 non-forest - ! - ! ---------------------------------------------------------------- - ! description of the 14 plant types. see vegconi.F for - ! parameters that depend on vegetation type - ! ---------------------------------------------------------------- - ! - ! 1 = needleleaf evergreen tree - ! 2 = needleleaf deciduous tree - ! 3 = broadleaf evergreen tree - ! 4 = broadleaf deciduous tree - ! 5 = tropical seasonal tree - ! 6 = cool grass (c3) - ! 7 = evergreen shrub - ! 8 = deciduous shrub - ! 9 = arctic deciduous shrub - ! 10 = arctic grass - ! 11 = crop - ! 12 = irrigated crop - ! 13 = warm grass (c4) - ! 14 = not vegetated - !================================================================= - - ! TAI = monthly leaf area index + stem area index, one-sided - TAI(1,1:12) = (/ 4.5d0, 4.7d0, 5.0d0, 5.1d0, 5.3d0, 5.5d0, - & 5.3d0, 5.3d0, 5.2d0, 4.9d0, 4.6d0, 4.5d0 /) - - TAI(2,1:12) = (/ 0.3d0, 0.3d0, 0.3d0, 1.0d0, 1.6d0, 2.4d0, - & 4.3d0, 2.9d0, 2.0d0, 1.3d0, 0.8d0, 0.5d0 /) - - TAI(3,1:12) = (/ 5.0d0, 5.0d0, 5.0d0, 5.0d0, 5.0d0, 5.0d0, - & 5.0d0, 5.0d0, 5.0d0, 5.0d0, 5.0d0, 5.0d0 /) - - TAI(4,1:12) = (/ 0.4d0, 0.4d0, 0.7d0, 1.6d0, 3.5d0, 5.1d0, - & 5.4d0, 4.8d0, 3.8d0, 1.7d0, 0.6d0, 0.4d0 /) - - TAI(5,1:12) = (/ 1.2d0, 1.0d0, 0.9d0, 0.8d0, 0.8d0, 1.0d0, - & 2.0d0, 3.7d0, 3.2d0, 2.7d0, 1.9d0, 1.2d0 /) - - TAI(6,1:12) = (/ 0.7d0, 0.8d0, 0.9d0, 1.0d0, 1.5d0, 3.4d0, - & 4.3d0, 3.8d0, 1.8d0, 1.0d0, 0.9d0, 0.8d0 /) - - TAI(7,1:12) = (/ 1.3d0, 1.3d0, 1.3d0, 1.3d0, 1.3d0, 1.3d0, - & 1.3d0, 1.3d0, 1.3d0, 1.3d0, 1.3d0, 1.3d0 /) - - TAI(8,1:12) = (/ 1.0d0, 1.0d0, 0.8d0, 0.3d0, 0.6d0, 0.0d0, - & 0.1d0, 0.3d0, 0.5d0, 0.6d0, 0.7d0, 0.9d0 /) - - TAI(9,1:12) = (/ 0.1d0, 0.1d0, 0.1d0, 0.1d0, 0.1d0, 0.3d0, - & 1.5d0, 1.7d0, 1.4d0, 0.1d0, 0.1d0, 0.1d0 /) - - TAI(10,1:12) = (/ 0.7d0, 0.8d0, 0.9d0, 1.0d0, 1.5d0, 3.4d0, - & 4.3d0, 3.8d0, 1.8d0, 1.0d0, 0.9d0, 0.8d0 /) - - TAI(11,1:12) = (/ 0.0d0, 0.0d0, 0.0d0, 0.0d0, 1.0d0, 2.0d0, - & 3.0d0, 3.0d0, 1.5d0, 0.0d0, 0.0d0, 0.0d0 /) - - TAI(12,1:12) = (/ 0.0d0, 0.0d0, 0.0d0, 0.0d0, 1.0d0, 2.0d0, - & 3.0d0, 3.0d0, 1.5d0, 0.0d0, 0.0d0, 0.0d0 /) - - TAI(13,1:12) = (/ 0.7d0, 0.8d0, 0.9d0, 1.0d0, 1.5d0, 3.4d0, - & 4.3d0, 3.8d0, 1.8d0, 1.0d0, 0.9d0, 0.8d0 /) - - TAI(14,1:12) = (/ 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, - & 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0, 0.0d0 /) - - ! Return to calling program - END SUBROUTINE PLN_TYP_GET - -!****************************************************************************** -!------------------------------------------------------------------------------ -! Harmonized Emissions Component (HEMCO) ! -!------------------------------------------------------------------------------ -!BOP -! -! !IROUTINE: InstGet -! -! !DESCRIPTION: Subroutine InstGet returns a pointer to the desired instance. -!\\ -!\\ -! !INTERFACE: -! - SUBROUTINE InstGet ( Instance, Inst, RC, PrevInst ) -! -! !INPUT PARAMETERS: -! - INTEGER :: Instance - TYPE(MyInst), POINTER :: Inst - INTEGER :: RC - TYPE(MyInst), POINTER, OPTIONAL :: PrevInst -! -! !REVISION HISTORY: -! 18 Feb 2016 - C. Keller - Initial version -! See https://github.com/geoschem/hemco for complete history -!EOP -!------------------------------------------------------------------------------ -!BOC - TYPE(MyInst), POINTER :: PrvInst - - !================================================================= - ! InstGet begins here! - !================================================================= - - ! Get instance. Also archive previous instance. - PrvInst => NULL() - Inst => AllInst - DO WHILE ( ASSOCIATED(Inst) ) - IF ( Inst%Instance == Instance ) EXIT - PrvInst => Inst - Inst => Inst%NextInst - END DO - IF ( .NOT. ASSOCIATED( Inst ) ) THEN - RC = HCO_FAIL - RETURN - ENDIF - - ! Pass output arguments - IF ( PRESENT(PrevInst) ) PrevInst => PrvInst - - ! Cleanup & Return - PrvInst => NULL() - RC = HCO_SUCCESS - - END SUBROUTINE InstGet -!EOC -!------------------------------------------------------------------------------ -! Harmonized Emissions Component (HEMCO) ! -!------------------------------------------------------------------------------ -!BOP -! -! !IROUTINE: InstCreate -! -! !DESCRIPTION: Subroutine InstCreate creates a new instance. -!\\ -!\\ -! !INTERFACE: -! - SUBROUTINE InstCreate ( ExtNr, Instance, Inst, RC ) -! -! !INPUT PARAMETERS: -! - INTEGER, INTENT(IN) :: ExtNr -! -! !OUTPUT PARAMETERS: -! - INTEGER, INTENT( OUT) :: Instance - TYPE(MyInst), POINTER :: Inst -! -! !INPUT/OUTPUT PARAMETERS: -! - INTEGER, INTENT(INOUT) :: RC -! -! !REVISION HISTORY: -! 18 Feb 2016 - C. Keller - Initial version -! See https://github.com/geoschem/hemco for complete history -!EOP -!------------------------------------------------------------------------------ -!BOC - TYPE(MyInst), POINTER :: TmpInst - INTEGER :: nnInst - - !================================================================= - ! InstCreate begins here! - !================================================================= - - ! ---------------------------------------------------------------- - ! Generic instance initialization - ! ---------------------------------------------------------------- - - ! Initialize - Inst => NULL() - - ! Get number of already existing instances - TmpInst => AllInst - nnInst = 0 - DO WHILE ( ASSOCIATED(TmpInst) ) - nnInst = nnInst + 1 - TmpInst => TmpInst%NextInst - END DO - - ! Create new instance - ALLOCATE(Inst) - Inst%Instance = nnInst + 1 - Inst%ExtNr = ExtNr - - ! Attach to instance list - Inst%NextInst => AllInst - AllInst => Inst - - ! Update output instance - Instance = Inst%Instance - - ! ---------------------------------------------------------------- - ! Type specific initialization statements follow below - ! ---------------------------------------------------------------- - Inst%ERD_FCT_GEO => NULL() - Inst%SRCE_FUNC => NULL() - Inst%LND_FRC_DRY => NULL() - Inst%MSS_FRC_CACO3 => NULL() - Inst%MSS_FRC_SND => NULL() - Inst%SFC_TYP => NULL() - Inst%VAI_DST => NULL() - - ! Return w/ success - RC = HCO_SUCCESS - - END SUBROUTINE InstCreate -!EOC -!------------------------------------------------------------------------------ -! Harmonized Emissions Component (HEMCO) ! -!------------------------------------------------------------------------------ -!BOP -! -! !IROUTINE: InstRemove -! -! !DESCRIPTION: Subroutine InstRemove creates a new instance. -!\\ -!\\ -! !INTERFACE: -! - SUBROUTINE InstRemove ( Instance ) -! -! !INPUT PARAMETERS: -! - INTEGER :: Instance -! -! !REVISION HISTORY: -! 18 Feb 2016 - C. Keller - Initial version -! See https://github.com/geoschem/hemco for complete history -!EOP -!------------------------------------------------------------------------------ -!BOC - INTEGER :: RC - TYPE(MyInst), POINTER :: PrevInst - TYPE(MyInst), POINTER :: Inst - - !================================================================= - ! InstRemove begins here! - !================================================================= - - ! Get instance. Also archive previous instance. - PrevInst => NULL() - Inst => NULL() - CALL InstGet ( Instance, Inst, RC, PrevInst=PrevInst ) - - ! Instance-specific deallocation - IF ( ASSOCIATED(Inst) ) THEN - - !-------------------------------------------------------------- - ! Deallocate fields of Inst before popping off from the list - ! in order to avoid memory leaks (Bob Yantosca (17 Aug 2022) - !-------------------------------------------------------------- - IF ( ASSOCIATED( Inst%ERD_FCT_GEO ) ) THEN - DEALLOCATE(Inst%ERD_FCT_GEO ) - ENDIF - Inst%ERD_FCT_GEO => NULL() - - IF ( ASSOCIATED( Inst%SRCE_FUNC ) ) THEN - DEALLOCATE(Inst%SRCE_FUNC ) - ENDIF - Inst%SRCE_FUNC => NULL() - - IF ( ASSOCIATED( Inst%LND_FRC_DRY ) ) THEN - DEALLOCATE(Inst%LND_FRC_DRY ) - ENDIF - Inst%LND_FRC_DRY => NULL() - - IF ( ASSOCIATED( Inst%MSS_FRC_CACO3 ) ) THEN - DEALLOCATE(Inst%MSS_FRC_CACO3) - ENDIF - Inst%MSS_FRC_CACO3 => NULL() - - IF ( ASSOCIATED( Inst%MSS_FRC_CLY ) ) THEN - DEALLOCATE(Inst%MSS_FRC_CLY) - ENDIF - Inst%MSS_FRC_CLY => NULL() - - IF ( ASSOCIATED( Inst%MSS_FRC_SND ) ) THEN - DEALLOCATE(Inst%MSS_FRC_SND ) - ENDIF - Inst%MSS_FRC_SND => NULL() - - IF ( ASSOCIATED( Inst%SFC_TYP ) ) THEN - DEALLOCATE(Inst%SFC_TYP ) - ENDIF - Inst%SFC_TYP => NULL() - - IF ( ASSOCIATED( Inst%VAI_DST ) ) THEN - DEALLOCATE(Inst%VAI_DST ) - ENDIF - Inst%VAI_DST => NULL() - - IF ( ALLOCATED( Inst%PLN_TYP ) ) THEN - DEALLOCATE( Inst%PLN_TYP ) - ENDIF - - IF ( ALLOCATED( Inst%PLN_FRC ) ) THEN - DEALLOCATE( Inst%PLN_FRC ) - ENDIF - - IF ( ALLOCATED( Inst%TAI ) ) THEN - DEALLOCATE( Inst%TAI ) - ENDIF - - IF ( ALLOCATED( Inst%DMT_VWR ) ) THEN - DEALLOCATE( Inst%DMT_VWR ) - ENDIF - - IF ( ALLOCATED( Inst%OVR_SRC_SNK_FRC ) ) THEN - DEALLOCATE( Inst%OVR_SRC_SNK_FRC ) - ENDIF - - IF ( ALLOCATED( Inst%OVR_SRC_SNK_MSS ) ) THEN - DEALLOCATE( Inst%OVR_SRC_SNK_MSS ) - ENDIF - - IF ( ALLOCATED( Inst%DMT_MIN ) ) THEN - DEALLOCATE( Inst%DMT_MIN ) - ENDIF - - IF ( ALLOCATED( Inst%DMT_MAX ) ) THEN - DEALLOCATE( Inst%DMT_MAX ) - ENDIF - - IF ( ALLOCATED( Inst%DMT_VMA_SRC ) ) THEN - DEALLOCATE( Inst%DMT_VMA_SRC ) - ENDIF - - IF ( ALLOCATED( Inst%GSD_ANL_SRC ) ) THEN - DEALLOCATE( Inst%GSD_ANL_SRC ) - ENDIF - - IF ( ALLOCATED( Inst%MSS_FRC_SRC ) ) THEN - DEALLOCATE( Inst%MSS_FRC_SRC ) - ENDIF - - IF ( ALLOCATED( Inst%HcoIDs ) ) THEN - DEALLOCATE( Inst%HcoIDs ) - ENDIF - - IF ( ALLOCATED( Inst%HcoIDsALK ) ) THEN - DEALLOCATE( Inst%HcoIDsALK ) - ENDIF - - !-------------------------------------------------------------- - ! Pop off instance from list - !-------------------------------------------------------------- - IF ( ASSOCIATED(PrevInst) ) THEN - PrevInst%NextInst => Inst%NextInst - ELSE - AllInst => Inst%NextInst - ENDIF - DEALLOCATE(Inst) - - ENDIF - - ! Free pointers before exiting - PrevInst => NULL() - Inst => NULL() - - END SUBROUTINE InstRemove -!EOC -#if defined ( MODEL_GEOS ) -!------------------------------------------------------------------------------ - SUBROUTINE ReadTuningFactor(HcoState, TuningTable, FCT, RC ) -! - USE HCO_CharTools_Mod - USE HCO_inquireMod, ONLY : findFreeLUN - - ! Arguments - TYPE(HCO_State), POINTER :: HcoState ! Hemco state - CHARACTER(LEN=*), INTENT(IN) :: TuningTable - REAL*8 , INTENT(INOUT) :: FCT - INTEGER , INTENT(INOUT) :: RC - - ! Return value - - ! Local variables - REAL(hp) :: AM2, RES - INTEGER :: IU, IDX - CHARACTER(LEN=7) :: CSLABEL, FNDLABEL - CHARACTER(LEN=255) :: MSG, LINE, ICSL - LOGICAL :: EX, EOF - - CHARACTER(LEN=255), PARAMETER :: LOC = - & 'ReadTuningFactor (hcox_dustdead_mod)' - - !================================================================ - ! ReadTuningFactor begins here! - !================================================================ - - ! Enter - CALL HCO_ENTER ( HcoState%Config%Err, LOC, RC ) - - ! Init - FCT = -999.0 - - ! Determine resolution based on grid cell area - CSLABEL = 'UNKNOWN' - FNDLABEL = TRIM(CSLABEL) - IF ( .NOT. HcoState%Grid%AREA_M2%Alloc ) THEN - MSG = 'Warning: AREA_M2 not found, will use default number' - IF ( HcoState%Config%doVerbose ) THEN - CALL HCO_WARNING( MSG, THISLOC=LOC ) - ENDIF - ELSE - AM2 = SUM(HcoState%Grid%AREA_M2%Val)/(HcoState%NX*HcoState%NY) - RES = SQRT(AM2) - IF ( RES > 280.0_hp ) THEN - CSLABEL = 'C24' - ELSEIF ( RES > 140.0_hp .AND. RES <= 280.0_hp ) THEN - CSLABEL = 'C48' - ELSEIF ( RES > 70.0_hp .AND. RES <= 140.0_hp ) THEN - CSLABEL = 'C90' - ELSEIF ( RES > 35.0_hp .AND. RES <= 70.0_hp ) THEN - CSLABEL = 'C180' - ELSEIF ( RES > 17.5_hp .AND. RES <= 35.0_hp ) THEN - CSLABEL = 'C360' - ELSEIF ( RES > 8.75_hp .AND. RES <= 17.5_hp ) THEN - CSLABEL = 'C720' - ELSEIF ( RES > 4.375_hp .AND. RES <= 8.75_hp ) THEN - CSLABEL = 'C1440' - ELSEIF ( RES <= 4.375_hp ) THEN - CSLABEL = 'C2880' - ENDIF - ENDIF - - ! Open file - INQUIRE( FILE=TRIM(TuningTable), EXIST=EX ) - IF ( .NOT. EX ) THEN - MSG = 'FILE NOT FOUND: '//TRIM(TuningTable) - CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) - RETURN - ENDIF - IU = findFreeLUN() - OPEN( IU, FILE=TRIM(TuningTable) ) - - ! Search for resolution entry in file, assuming they are listed as follows: - ! C360: 1.0 - ! C48: 2.0e2 - ! C90: 1.0e-4 - DO - CALL HCO_ReadLine ( IU, LINE, EOF, RC ) - IF ( EOF ) EXIT - IDX = INDEX( LINE, ':' ) - IF ( IDX > 0 ) ICSL = ADJUSTL(LINE(1:(IDX-1))) - ! If cube-sphere label matches current resolution, read factor - IF ( TRIM(ICSL)==TRIM(CSLABEL) ) THEN - READ(LINE(IDX+1:LEN(LINE)),*) FCT - FNDLABEL = TRIM(ICSL) - EXIT - ENDIF - ENDDO - - ! All done - CLOSE ( IU ) - - ! Verbose - IF ( HcoState%amIRoot ) THEN - MSG = 'Read dust tuning factor from '//TRIM(TuningTable) - CALL HCO_MSG(MSG, SEP1='-',LUN=HcoState%Config%hcoLogLUN ) - MSG = 'Model resolution: '//TRIM(CSLABEL) - CALL HCO_MSG(MSG, SEP1='-',LUN=HcoState%Config%hcoLogLUN ) - MSG = 'Resolution label in file: '//TRIM(FNDLABEL) - CALL HCO_MSG(MSG, SEP1='-',LUN=HcoState%Config%hcoLogLUN ) - WRITE(MSG,*) 'Scale factor: ',FCT - CALL HCO_MSG(MSG, SEP1='-',LUN=HcoState%Config%hcoLogLUN ) - ENDIF - - ! Leave - CALL HCO_LEAVE( HcoState%Config%Err, RC ) - - END SUBROUTINE ReadTuningFactor -#endif - END MODULE HCOX_DUSTDEAD_MOD -!EOM diff --git a/src/Extensions/hcox_dustginoux_mod.F90 b/src/Extensions/hcox_dustginoux_mod.F90 deleted file mode 100644 index 02b60ac9..00000000 --- a/src/Extensions/hcox_dustginoux_mod.F90 +++ /dev/null @@ -1,1140 +0,0 @@ -!------------------------------------------------------------------------------ -! Harmonized Emissions Component (HEMCO) ! -!------------------------------------------------------------------------------ -!BOP -! -! !MODULE: hcox_dustginoux_mod.F90 -! -! !DESCRIPTION: Paul GINOUX dust source function. This subroutine updates -! the surface mixing ratio of dust aerosols for NDSTBIN size bins. The -! uplifting of dust depends in space on the source function, and in time -! and space on the soil moisture and surface wind speed (10 meters). Dust -! is uplifted if the wind speed is greater than a threshold velocity which -! is calculated with the formula of Marticorena et al. (JGR, v.102, -! pp 23277-23287, 1997). To run this subroutine you need the source -! function which can be obtained by contacting Paul Ginoux at -! ginoux@rondo.gsfc.nasa.gov/ If you are not using GEOS DAS met fields, -! you will most likely need to adapt the adjusting parameter. -!\\ -!\\ -! This is a HEMCO extension module that uses many of the HEMCO core -! utilities. -!\\ -!\\ -! References: -! -! \begin{enumerate} -! \item Ginoux, P., M. Chin, I. Tegen, J. Prospero, B. Hoben, O. Dubovik, -! and S.-J. Lin, "Sources and distributions of dust aerosols simulated -! with the GOCART model", J. Geophys. Res., 2001 -! \item Chin, M., P. Ginoux, S. Kinne, B. Holben, B. Duncan, R. Martin, -! J. Logan, A. Higurashi, and T. Nakajima, "Tropospheric aerosol -! optical thickness from the GOCART model and comparisons with -! satellite and sunphotometers measurements", J. Atmos Sci., 2001. -! \end{enumerate} -! -! !AUTHOR: -! Paul Ginoux (ginoux@rondo.gsfc.nasa.gov) -! -! !INTERFACE: -! -MODULE HCOX_DustGinoux_Mod -! -! !USES: -! - USE HCO_Error_Mod - USE HCO_Diagn_Mod - USE HCO_State_Mod, ONLY : HCO_State - USE HCOX_State_Mod, ONLY : Ext_State - - IMPLICIT NONE - PRIVATE -! -! !PUBLIC MEMBER FUNCTIONS: -! - PUBLIC :: HcoX_DustGinoux_Run - PUBLIC :: HcoX_DustGinoux_Init - PUBLIC :: HcoX_DustGinoux_Final - PUBLIC :: HcoX_DustGinoux_GetChDust -! -! !REVISION HISTORY: -! 08 Apr 2004 - T. D. Fairlie - Initial version -! See https://github.com/geoschem/hemco for complete history -!EOP -!------------------------------------------------------------------------------ -!BOC -! -! !PRIVATE TYPES: -! - TYPE :: MyInst - - ! Quantities related to dust bins - INTEGER :: Instance - INTEGER :: NBINS - INTEGER :: ExtNr = -1 ! Extension number for DustGinoux - INTEGER :: ExtNrAlk = -1 ! Extension number for DustAlk - INTEGER, ALLOCATABLE :: HcoIDs (:) ! HEMCO species IDs for DustGinoux - INTEGER, ALLOCATABLE :: HcoIDsAlk (:) ! HEMCO species IDs for DustAlk - INTEGER, POINTER :: IPOINT (:) ! 1=sand, 2=silt, 3=clay - REAL, POINTER :: FRAC_S (:) ! - REAL, POINTER :: DUSTDEN (:) ! dust density [kg/m3] - REAL, POINTER :: DUSTREFF (:) ! effective radius [um] - REAL(hp), POINTER :: FLUX(:,:,:) - REAL(hp), POINTER :: FLUX_ALK(:,:,:) - - ! Source functions (get from HEMCO core) - REAL(hp), POINTER :: SRCE_SAND(:,:) => NULL() - REAL(hp), POINTER :: SRCE_SILT(:,:) => NULL() - REAL(hp), POINTER :: SRCE_CLAY(:,:) => NULL() - - ! Transfer coefficient (grid-dependent) - REAL(dp) :: CH_DUST - - TYPE(MyInst), POINTER :: NextInst => NULL() - END TYPE MyInst - - ! Pointer to instances - TYPE(MyInst), POINTER :: AllInst => NULL() - -CONTAINS -!EOC -!------------------------------------------------------------------------------ -! Harmonized Emissions Component (HEMCO) ! -!------------------------------------------------------------------------------ -!BOP -! -! !IROUTINE: HCOX_DustGinoux_Run -! -! !DESCRIPTION: Subroutine HcoX\_DustGinoux\_Run is the driver routine -! for the Paul Ginoux dust source function HEMCO extension. -!\\ -!\\ -! !INTERFACE: -! - SUBROUTINE HcoX_DustGinoux_Run( ExtState, HcoState, RC ) -! -! !USES: -! - USE HCO_Calc_Mod, ONLY : HCO_EvalFld - USE HCO_EmisList_Mod, ONLY : HCO_GetPtr - USE HCO_FluxArr_Mod, ONLY : HCO_EmisAdd - USE HCO_Clock_Mod, ONLY : HcoClock_First -! -! !INPUT PARAMETERS: -! - TYPE(Ext_State), POINTER :: ExtState ! Options for this ext -! -! !INPUT/OUTPUT PARAMETERS: -! - TYPE(HCO_State), POINTER :: HcoState ! HEMCO state object - INTEGER, INTENT(INOUT) :: RC ! Success or failure? -! -! !REMARKS: -! SRCE_FUNK Source function (-) -! for 1: Sand, 2: Silt, 3: Clay -! . -! DUSTDEN Dust density (kg/m3) -! DUSTREFF Effective radius (um) -! AD Air mass for each grid box (kg) -! NTDT Time step (s) -! W10m Velocity at the anemometer level (10meters) (m/s) -! GWET Surface wetness (-) -! . -! Dust properties used in GOCART -! . -! Size classes: 01-1, 1-1.8, 1.8-3, 3-6 (um) -! Radius: 0.7, 1.5, 2.5, 4 (um) -! Density: 2500, 2650, 2650, 2650 (kg/m3) -! -! !REVISION HISTORY: -! 08 Apr 2004 - T. D. Fairlie - Initial version -! See https://github.com/geoschem/hemco for complete history -!EOP -!------------------------------------------------------------------------------ -!BOC -! -! !DEFINED PARAMETER: -! - REAL*8, PARAMETER :: RHOA = 1.25d-3 - -! -! !LOCAL VARIABLES: -! - ! SAVED scalars -! LOGICAL, SAVE :: FIRST = .TRUE. - - ! Scalars - INTEGER :: I, J, N, M, tmpID - LOGICAL :: ERR - REAL*8 :: W10M, DEN, DIAM, U_TS0, U_TS - REAL*8 :: SRCE_P, REYNOL, ALPHA, BETA - REAL*8 :: GAMMA, CW, DTSRCE, A_M2, G - REAL :: DSRC - CHARACTER(LEN=63) :: MSG, LOC - - ! Arrays - REAL*8 :: DUST_EMI_TOTAL(HcoState%NX, HcoState%NY) - - ! Pointers - TYPE(MyInst), POINTER :: Inst - REAL(hp), POINTER :: Arr2D(:,:) - - !======================================================================= - ! HCOX_DUSTGINOUX_RUN begins here! - !======================================================================= - LOC = 'HCOX_DUSTGINOUX_RUN (HCOX_DUSTGINOUX_MOD.F90)' - - ! Return if extension is disabled - IF ( ExtState%DustGinoux <= 0 ) RETURN - - ! Enter - CALL HCO_ENTER(HcoState%Config%Err, LOC, RC) - IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 0', RC, THISLOC=LOC ) - RETURN - ENDIF - - ! Get instance - Inst => NULL() - CALL InstGet ( ExtState%DustGinoux, Inst, RC ) - IF ( RC /= HCO_SUCCESS ) THEN - WRITE(MSG,*) 'Cannot find DustGinoux instance Nr. ', ExtState%DustGinoux - CALL HCO_ERROR(MSG,RC) - RETURN - ENDIF - - ! Set gravity at earth surface (cm/s^2) - G = HcoState%Phys%g0 * 1.0d2 - - ! Emission timestep [s] - DTSRCE = HcoState%TS_EMIS - - ! Initialize total dust emissions array [kg/m2/s] - DUST_EMI_TOTAL = 0.0d0 - - ! Error check - ERR = .FALSE. - - ! Init - Arr2D => NULL() - - !================================================================= - ! Point to DUST source functions - !================================================================= - !IF ( HcoClock_First(HcoState%Clock,.TRUE.) ) THEN - - ! Sand - CALL HCO_EvalFld( HcoState, 'GINOUX_SAND', Inst%SRCE_SAND, RC ) - IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 1', RC, THISLOC=LOC ) - RETURN - ENDIF - - ! Silt - CALL HCO_EvalFld( HcoState, 'GINOUX_SILT', Inst%SRCE_SILT, RC ) - IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 2', RC, THISLOC=LOC ) - RETURN - ENDIF - - ! Clay - CALL HCO_EvalFld( HcoState, 'GINOUX_CLAY', Inst%SRCE_CLAY, RC ) - IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 3', RC, THISLOC=LOC ) - RETURN - ENDIF - !ENDIF - - !================================================================= - ! Compute dust emisisons - !================================================================= -!$OMP PARALLEL DO & -!$OMP DEFAULT( SHARED ) & -!$OMP PRIVATE( I, J, M, N, DEN, DIAM ) & -!$OMP PRIVATE( REYNOL, ALPHA, BETA, GAMMA, U_TS0, U_TS ) & -!$OMP PRIVATE( CW, W10M, SRCE_P, RC ) & -!$OMP SCHEDULE( DYNAMIC ) - DO N = 1, Inst%NBINS - - !==================================================================== - ! Threshold velocity as a function of the dust density and the - ! diameter from Bagnold (1941), valid for particles larger - ! than 10 um. - ! - ! u_ts0 = 6.5*sqrt(dustden(n)*g0*2.*dustreff(n)) - ! - ! Threshold velocity from Marticorena and Bergametti - ! Convert units to fit dimensional parameters - !==================================================================== - DEN = Inst%DUSTDEN(N) * 1.d-3 ! [g/cm3] - DIAM = 2d0 * Inst%DUSTREFF(N) * 1.d2 ! [cm in diameter] - REYNOL = 1331.d0 * DIAM**(1.56d0) + 0.38d0 ! [Reynolds number] - ALPHA = DEN * G * DIAM / RHOA - BETA = 1d0 + ( 6.d-3 / ( DEN * G * DIAM**(2.5d0) ) ) - GAMMA = ( 1.928d0 * REYNOL**(0.092d0) ) - 1.d0 - - !==================================================================== - ! I think the 129.d-5 is to put U_TS in m/sec instead of cm/sec - ! This is a threshold friction velocity! from M&B - ! i.e. Ginoux uses the Gillette and Passi formulation - ! but has substituted Bagnold's Ut with M&B's U*t. - ! This appears to be a problem. (tdf, 4/2/04) - !==================================================================== - - ! [m/s] - U_TS0 = 129.d-5 * SQRT( ALPHA ) * SQRT( BETA ) / SQRT( GAMMA ) - - ! Index used to select the source function (1=sand, 2=silt, 3=clay) - M = Inst%IPOINT(N) - - ! Loop over grid boxes - DO J = 1, HcoState%NY - DO I = 1, HcoState%NX - - ! Fraction of emerged surfaces - ! (subtract lakes, coastal ocean,...) - CW = 1.d0 - - ! Case of surface dry enough to erode - IF ( ExtState%GWETTOP%Arr%Val(I,J) < 0.2d0 ) THEN - - U_TS = U_TS0 *( 1.2d0 + 0.2d0 * & - LOG10( MAX(1.d-3,ExtState%GWETTOP%Arr%Val(I,J)))) - U_TS = MAX( 0.d0, U_TS ) - - ELSE - - ! Case of wet surface, no erosion - U_TS = 100.d0 - - ENDIF - - ! 10m wind speed squared [m2/s2] - W10M = ExtState%U10M%Arr%Val(I,J)**2 & - + ExtState%V10M%Arr%Val(I,J)**2 - - ! Get source function - SELECT CASE( M ) - CASE( 1 ) - SRCE_P = Inst%SRCE_SAND(I,J) - CASE( 2 ) - SRCE_P = Inst%SRCE_SILT(I,J) - CASE( 3 ) - SRCE_P = Inst%SRCE_CLAY(I,J) - END SELECT - - ! Units are m2 - SRCE_P = Inst%FRAC_S(N) * SRCE_P !* A_M2 - - ! Dust source increment [kg/m2/s] - Inst%FLUX(I,J,N) = CW * Inst%CH_DUST * SRCE_P * W10M & - * ( SQRT(W10M) - U_TS ) - - ! Not less than zero - IF ( Inst%FLUX(I,J,N) < 0.d0 ) Inst%FLUX(I,J,N) = 0.d0 - - ! Increment total dust emissions [kg/m2/s] (L. Zhang, 6/26/15) - DUST_EMI_TOTAL(I,J) = DUST_EMI_TOTAL(I,J) + Inst%FLUX(I,J,N) - - ! Include DUST Alkalinity SOURCE, assuming an alkalinity - ! of 4% by weight [kg]. !tdf 05/10/08 - !tdf 3% Ca + equ 1% Mg = 4% alkalinity - IF ( Inst%ExtNrAlk > 0 ) THEN - Inst%FLUX_ALK(I,J,N) = 0.04 * Inst%FLUX(I,J,N) - ENDIF - - ENDDO - ENDDO - ENDDO -!$OMP END PARALLEL DO - - ! Error check - IF ( ERR ) THEN - RC = HCO_FAIL - RETURN - ENDIF - - ! Redistribute dust emissions across bins (L. Zhang, 6/26/15) -!$OMP PARALLEL DO & -!$OMP DEFAULT( SHARED ) & -!$OMP PRIVATE( I, J, N ) & -!$OMP SCHEDULE( DYNAMIC ) - DO N=1,Inst%NBINS - DO J=1,HcoState%NY - DO I=1,HcoState%NX - SELECT CASE( N ) - CASE( 1 ) - Inst%FLUX(I,J,N) = DUST_EMI_TOTAL(I,J) * 0.0766d0 - CASE( 2 ) - Inst%FLUX(I,J,N) = DUST_EMI_TOTAL(I,J) * 0.1924d0 - CASE( 3 ) - Inst%FLUX(I,J,N) = DUST_EMI_TOTAL(I,J) * 0.3491d0 - CASE( 4 ) - Inst%FLUX(I,J,N) = DUST_EMI_TOTAL(I,J) * 0.3819d0 - END SELECT - ENDDO - ENDDO - ENDDO -!$OMP END PARALLEL DO - - !======================================================================= - ! PASS TO HEMCO STATE AND UPDATE DIAGNOSTICS - !======================================================================= - DO N = 1, Inst%NBINS - IF ( Inst%HcoIDs(N) > 0 ) THEN - - ! Add flux to emission array - CALL HCO_EmisAdd( HcoState, Inst%FLUX(:,:,N), & - Inst%HcoIDs(N), RC, ExtNr=Inst%ExtNr ) - IF ( RC /= HCO_SUCCESS ) THEN - WRITE(MSG,*) 'HCO_EmisAdd error: dust bin ', N - CALL HCO_ERROR(MSG, RC ) - RETURN - ENDIF - - ENDIF - - ! This block is only relevant if the DustAlk extension - ! has been turned on. Skip othewrise. (bmy, 7/7/17) - IF ( Inst%ExtNrAlk > 0 ) THEN - IF ( Inst%HcoIDsAlk(N) > 0 ) THEN - - ! Add flux to emission array - CALL HCO_EmisAdd( HcoState, Inst%FLUX_Alk(:,:,N), & - Inst%HcoIDsAlk(N), RC, ExtNr=Inst%ExtNrAlk) - IF ( RC /= HCO_SUCCESS ) THEN - WRITE(MSG,*) 'HCO_EmisAdd error: dust alkalinity bin ', N - CALL HCO_ERROR(MSG, RC ) - RETURN - ENDIF - ENDIF - ENDIF - - ENDDO - - !======================================================================= - ! Cleanup & quit - !======================================================================= - - ! Nullify pointers - Inst => NULL() - - ! Leave w/ success - CALL HCO_LEAVE( HcoState%Config%Err,RC ) - - END SUBROUTINE HcoX_DustGinoux_Run -!EOC -!------------------------------------------------------------------------------ -! Harmonized Emissions Component (HEMCO) ! -!------------------------------------------------------------------------------ -!BOP -! -! !IROUTINE: HCOX_DustGinoux_Init -! -! !DESCRIPTION: Subroutine HcoX\_DustGinoux\_Init initializes the HEMCO -! DUSTGINOUX extension. -!\\ -!\\ -! !INTERFACE: -! - SUBROUTINE HcoX_DustGinoux_Init( HcoState, ExtName, ExtState, RC ) -! -! !USES: -! - USE HCO_ExtList_Mod, ONLY : GetExtNr, GetExtOpt - USE HCO_State_Mod, ONLY : HCO_GetExtHcoID -! -! !INPUT PARAMETERS: -! - TYPE(HCO_State), POINTER :: HcoState ! HEMCO State object - CHARACTER(LEN=*), INTENT(IN ) :: ExtName ! Extension name - TYPE(Ext_State), POINTER :: ExtState ! Extension options -! -! !INPUT/OUTPUT PARAMETERS: -! - INTEGER, INTENT(INOUT) :: RC ! Success or failure? -! -! !REVISION HISTORY: -! 11 Dec 2013 - C. Keller - Now a HEMCO extension -! See https://github.com/geoschem/hemco for complete history -!EOP -!------------------------------------------------------------------------------ -!BOC -! -! !LOCAL VARIABLES: -! - ! Scalars - INTEGER :: N, AS, nSpc, nSpcAlk, ExtNr - CHARACTER(LEN=255) :: MSG, LOC - REAL(dp) :: Mp, Rp, TmpScal - LOGICAL :: FOUND - - ! Arrays - CHARACTER(LEN=31), ALLOCATABLE :: SpcNames(:) - CHARACTER(LEN=31), ALLOCATABLE :: SpcNamesAlk(:) - - ! Pointers - TYPE(MyInst), POINTER :: Inst - - !======================================================================= - ! HCOX_DUSTGINOUX_INIT begins here! - !======================================================================= - LOC = 'HCOX_DUSTGINOUX_INIT (HCOX_DUSTGINOUX_MOD.F90)' - - ! Extension Nr. - ExtNr = GetExtNr( HcoState%Config%ExtList, TRIM(ExtName) ) - IF ( ExtNr <= 0 ) RETURN - - ! Create Instance - Inst => NULL() - CALL InstCreate ( ExtNr, ExtState%DustGinoux, Inst, RC ) - IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR ( 'Cannot create DustGinoux instance', RC ) - RETURN - ENDIF - ! Also fill Inst%ExtNr - Inst%ExtNr = ExtNr - - ! Check for dust alkalinity option - Inst%ExtNrAlk = GetExtNr( HcoState%Config%ExtList, 'DustAlk' ) - - ! Enter - CALL HCO_ENTER(HcoState%Config%Err, LOC, RC) - IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 4', RC, THISLOC=LOC ) - RETURN - ENDIF - - ! Get the expected number of dust species - Inst%NBINS = HcoState%nDust - - ! Get the actual number of dust species defined for DustGinoux extension - CALL HCO_GetExtHcoID( HcoState, Inst%ExtNr, Inst%HcoIDs, & - SpcNames, nSpc, RC ) - IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 5', RC, THISLOC=LOC ) - RETURN - ENDIF - - ! Get the dust alkalinity species defined for DustAlk option - IF ( Inst%ExtNrAlk > 0 ) THEN - CALL HCO_GetExtHcoID( HcoState, Inst%ExtNrAlk, Inst%HcoIDsAlk, & - SpcNamesAlk, nSpcAlk, RC) - IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 6', RC, THISLOC=LOC ) - RETURN - ENDIF - ENDIF - - ! Make sure the # of dust species is as expected - IF ( nSpc /= Inst%NBINS ) THEN - WRITE( MSG, 100 ) Inst%NBINS, nSpc - 100 FORMAT( 'Expected ', i3, ' DustGinoux species but only found ', i3, & - ' in the HEMCO configuration file! Exiting...' ) - CALL HCO_ERROR(MSG, RC ) - RETURN - ENDIF - - ! Set scale factor: first try to read from configuration file. If - ! not specified, call wrapper function which sets teh scale factor - ! based upon compiler switches. - CALL GetExtOpt( HcoState%Config, Inst%ExtNr, 'Mass tuning factor', & - OptValDp=TmpScal, Found=FOUND, RC=RC ) - IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 7', RC, THISLOC=LOC ) - RETURN - ENDIF - - ! Set parameter FLX_MSS_FDG_FCT to specified tuning factor. Get from - ! wrapper routine if not defined in configuration file - IF ( FOUND ) THEN - Inst%CH_DUST = TmpScal - ELSE - ! Get global mass flux tuning factor - Inst%CH_DUST = HcoX_DustGinoux_GetCHDust( Inst, HcoState ) - IF ( Inst%CH_DUST < 0.0_dp ) THEN - RC = HCO_FAIL - RETURN - ENDIF - ENDIF - - ! Verbose mode - IF ( HcoState%amIRoot ) THEN - - ! Write the name of the extension regardless of the verbose setting - msg = 'Using HEMCO extension: DustGinoux (dust mobilization)' - CALL HCO_Msg( msg, sep1='-', LUN=HcoState%Config%hcoLogLUN ) ! with separator - - ! Write all other messages as debug printout only - IF ( Inst%ExtNrAlk > 0 ) THEN - MSG = 'Use dust alkalinity option' - CALL HCO_MSG(MSG, SEP1='-', LUN=HcoState%Config%hcoLogLUN ) - ENDIF - - MSG = 'Use the following species (Name: HcoID):' - CALL HCO_MSG( msg, LUN=HcoState%Config%hcoLogLUN ) - DO N = 1, nSpc - WRITE(MSG,*) TRIM(SpcNames(N)), ':', Inst%HcoIDs(N) - CALL HCO_MSG( msg, LUN=HcoState%Config%hcoLogLUN ) - ENDDO - IF ( Inst%ExtNrAlk > 0 ) THEN - DO N = 1, nSpcAlk - WRITE(MSG,*) TRIM(SpcNamesAlk(N)), ':', Inst%HcoIDsAlk(N) - CALL HCO_MSG( msg, LUN=HcoState%Config%hcoLogLUN ) - ENDDO - ENDIF - - WRITE(MSG,*) 'Global mass flux tuning factor: ', Inst%CH_DUST - CALL HCO_MSG(MSG,SEP2='-',LUN=HcoState%Config%hcoLogLUN) - ENDIF - - ! Allocate vectors holding bin-specific informations - ALLOCATE ( Inst%IPOINT (Inst%NBINS) ) - ALLOCATE ( Inst%FRAC_S (Inst%NBINS) ) - ALLOCATE ( Inst%DUSTDEN (Inst%NBINS) ) - ALLOCATE ( Inst%DUSTREFF(Inst%NBINS) ) - ALLOCATE ( Inst%FLUX (HcoState%NX,HcoState%NY,Inst%NBINS) ) - ALLOCATE ( Inst%FLUX_ALK(HcoState%NX,HcoState%NY,Inst%NBINS) ) - - ! Allocate arrays - ALLOCATE ( Inst%SRCE_SAND ( HcoState%NX, HcoState%NY ), & - Inst%SRCE_SILT ( HcoState%NX, HcoState%NY ), & - Inst%SRCE_CLAY ( HcoState%NX, HcoState%NY ), & - STAT = AS ) - IF ( AS /= 0 ) THEN - CALL HCO_ERROR('Allocation error', RC ) - RETURN - ENDIF - - ! Init - Inst%FLUX = 0.0_hp - Inst%FLUX_ALK = 0.0_hp - Inst%SRCE_SAND = 0.0_hp - Inst%SRCE_SILT = 0.0_hp - Inst%SRCE_CLAY = 0.0_hp - - - !======================================================================= - ! Setup for simulations that use 4 dust bins (w/ or w/o TOMAS) - !======================================================================= - - ! Fill bin-specific information - IF ( Inst%NBINS == 4 ) THEN - - Inst%IPOINT (1:Inst%NBINS) = (/ 3, 2, 2, 2 /) - Inst%FRAC_S (1:Inst%NBINS) = (/ 0.095d0, 0.3d0, 0.3d0, 0.3d0 /) - Inst%DUSTDEN (1:Inst%NBINS) = (/ 2500.d0, 2650.d0, 2650.d0, 2650.d0 /) - Inst%DUSTREFF(1:Inst%NBINS) = (/ 0.73d-6, 1.4d-6, 2.4d-6, 4.5d-6 /) - - ELSE - -#if !defined( TOMAS ) - MSG = 'Cannot have > 4 GINOUX dust bins unless you are using TOMAS!' - CALL HCO_ERROR(MSG, RC ) - RETURN -#endif - - ENDIF - -#if defined( TOMAS ) - - !======================================================================= - ! Setup for TOMAS simulations using more than 4 dust bins - ! - ! from Ginoux: - ! The U.S. Department of Agriculture (USDA) defines particles - ! with a radius between 1 um and 25 um as silt, and below 1 um - ! as clay [Hillel, 1982]. Mineralogical silt particles are mainly - ! composed of quartz, but they are often coated with strongly - ! adherent clay such that their physicochemical properties are - ! similar to clay [Hillel, 1982]. - ! - ! SRCE_FUNC Source function - ! for 1: Sand, 2: Silt, 3: Clay - !======================================================================= - IF ( Inst%NBINS == HcoState%MicroPhys%nBins ) THEN - - !-------------------------------------------------------------------- - ! Define the IPOINT array based on particle size - !-------------------------------------------------------------------- - - ! Loop over # of TOMAS bins - DO N = 1, HcoState%MicroPhys%nBins - - ! Compute particle mass and radius - Mp = 1.4 * HcoState%MicroPhys%BinBound(N) - Rp = ( ( Mp /2500. ) * (3./(4.*HcoState%Phys%PI)))**(0.333) - - ! Pick the source function based on particle size - IF ( Rp < 1.d-6 ) THEN - Inst%IPOINT(N) = 3 - ELSE - Inst%IPOINT(N) = 2 - END IF - END DO - - !-------------------------------------------------------------------- - ! Set up dust density (DUSTDEN) array - !-------------------------------------------------------------------- - DO N = 1, HcoState%MicroPhys%nBins - IF ( HcoState%MicroPhys%BinBound(N) < 4.0D-15 ) THEN - Inst%DUSTDEN(N) = 2500.d0 - ELSE - Inst%DUSTDEN(N) = 2650.d0 - ENDIF - ENDDO - - !-------------------------------------------------------------------- - ! Set up dust density (DUSTDEN) array - !-------------------------------------------------------------------- - DO N = 1, HcoState%MicroPhys%nBins - Inst%DUSTREFF(N) = 0.5d0 & - * ( SQRT( HcoState%MicroPhys%BinBound(N) * & - HcoState%MicroPhys%BinBound(N+1) ) & - / Inst%DUSTDEN(N) * 6.d0/HcoState%Phys%PI )**( 0.333d0 ) - ENDDO - - !-------------------------------------------------------------------- - ! Set up the FRAC_S array - !-------------------------------------------------------------------- - - ! Initialize - Inst%FRAC_S( 1:HcoState%MicroPhys%nBins ) = 0d0 - -# if defined( TOMAS12 ) || defined( TOMAS15 ) - - !--------------------------------------------------- - ! TOMAS simulations with 12 or 15 size bins - !--------------------------------------------------- - Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 1 ) = 7.33E-10 - Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 2 ) = 2.032E-08 - Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 3 ) = 3.849E-07 - Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 4 ) = 5.01E-06 - Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 5 ) = 4.45E-05 - Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 6 ) = 2.714E-04 - Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 7 ) = 1.133E-03 - Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 8 ) = 3.27E-03 - Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 9 ) = 6.81E-03 - Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 10 ) = 1.276E-02 - Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 11 ) = 2.155E-01 - Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 12 ) = 6.085E-01 - -# else - - !--------------------------------------------------- - ! TOMAS simulations with 30 or 40 size bins - !--------------------------------------------------- - Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 1 ) = 1.05d-10 - Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 2 ) = 6.28d-10 - Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 3 ) = 3.42d-09 - Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 4 ) = 1.69d-08 - Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 5 ) = 7.59d-08 - Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 6 ) = 3.09d-07 - Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 7 ) = 1.15d-06 - Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 8 ) = 3.86d-06 - Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 9 ) = 1.18d-05 - Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 10 ) = 3.27d-05 - Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 11 ) = 8.24d-05 - Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 12 ) = 1.89d-04 - Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 13 ) = 3.92d-04 - Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 14 ) = 7.41d-04 - Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 15 ) = 1.27d-03 - Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 16 ) = 2.00d-03 - Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 17 ) = 2.89d-03 - Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 18 ) = 3.92d-03 - Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 19 ) = 5.26d-03 - Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 20 ) = 7.50d-03 - Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 21 ) = 1.20d-02 - Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 22 ) = 2.08d-02 - Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 23 ) = 3.62d-02 - Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 24 ) = 5.91d-02 - Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 25 ) = 8.74d-02 - Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 26 ) = 1.15d-01 - Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 27 ) = 1.34d-01 - Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 28 ) = 1.37d-01 - Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 29 ) = 1.24d-01 - Inst%FRAC_S( HcoState%MicroPhys%nActiveModeBins + 30 ) = 9.85d-02 - -# endif - - ELSE - - ! Stop w/ error message - CALL HCO_ERROR( 'Wrong number of TOMAS dust bins!', RC ) - - ENDIF - -#endif - - !===================================================================== - ! Activate fields in ExtState used by Ginoux dust - !===================================================================== - - ! Activate met. fields required by this module - ExtState%U10M%DoUse = .TRUE. - ExtState%V10M%DoUse = .TRUE. - ExtState%GWETTOP%DoUse = .TRUE. - - !======================================================================= - ! Leave w/ success - !======================================================================= - IF ( ALLOCATED(SpcNames) ) DEALLOCATE(SpcNames) - - ! Nullify pointers - Inst => NULL() - - CALL HCO_LEAVE( HcoState%Config%Err,RC ) - - END SUBROUTINE HcoX_DustGinoux_Init -!EOC -!------------------------------------------------------------------------------ -! Harmonized Emissions Component (HEMCO) ! -!------------------------------------------------------------------------------ -!BOP -! -! !IROUTINE: HCOX_DustGinoux_Final -! -! !DESCRIPTION: Subroutine HcoX\_DustGinoux\_Final finalizes the HEMCO -! DUSTGINOUX extension. -!\\ -!\\ -! !INTERFACE: -! - SUBROUTINE HcoX_DustGinoux_Final( ExtState ) -! -! !INPUT PARAMETERS: -! - TYPE(Ext_State), POINTER :: ExtState ! Module options -! -! !REVISION HISTORY: -! 11 Dec 2013 - C. Keller - Now a HEMCO extension -! See https://github.com/geoschem/hemco for complete history -!EOP -!------------------------------------------------------------------------------ -!BOC - - !======================================================================= - ! HCOX_DUSTGINOUX_FINAL begins here! - !======================================================================= - - CALL InstRemove ( ExtState%DustGinoux ) - - - - END SUBROUTINE HcoX_DustGinoux_Final -!EOC -!------------------------------------------------------------------------------ -! Harmonized Emissions Component (HEMCO) ! -!------------------------------------------------------------------------------ -!BOP -! -! !IROUTINE: HCOX_DustGinoux_GetChDust -! -! !DESCRIPTION: Function HCOX\_DustGinoux\_GetChDust returns the CH\_DUST -! parameter for the current simulation type. -!\\ -!\\ -! !INTERFACE: -! - FUNCTION HCOX_DustGinoux_GetChDust( Inst, HcoState ) RESULT( CH_DUST ) -! -! !INPUT PARAMETERS: -! - TYPE(MyInst), POINTER :: Inst ! Instance - TYPE(HCO_State), POINTER :: HcoState ! Hemco state -! -! !RETURN VALUE: -! - REAL*8 :: CH_DUST -! -! !REMARKS: -! The logic in the #ifdefs may need to be cleaned up later on. We have -! just replicated the existing code in pre-HEMCO versions of dust_mod.F. -! -! !REVISION HISTORY: -! 11 Dec 2013 - C. Keller - Initial version -! See https://github.com/geoschem/hemco for complete history -!EOP -!------------------------------------------------------------------------------ -!BOC -! -! !LOCAL VARIABLES: -! - ! Transfer coeff for type natural source (kg*s2/m5) - ! Emission reduction factor for China-nested grid domain (win, 4/27/08) - - IF ( TRIM(HcoState%Config%GridRes) == '4.0x5.0' ) THEN - - !----------------------------------------------------------------------- - ! All 4x5 simulations (including TOMAS) - !----------------------------------------------------------------------- - Inst%CH_DUST = 9.375d-10 - - ELSE - - !----------------------------------------------------------------------- - ! All other resolutions - !----------------------------------------------------------------------- - - ! Start w/ same value as for 4x5 - Inst%CH_DUST = 9.375d-10 - -#if defined( TOMAS ) - ! KLUDGE: For TOMAS simulations at grids higher than 4x5 (e.g. 2x25), - ! then multiplyCH_DUST by 0.75. (Sal Farina) - Inst%CH_DUST = Inst%CH_DUST * 0.75d0 -#endif - - ENDIF - - END FUNCTION HCOX_DustGinoux_GetChDust -!EOC -!------------------------------------------------------------------------------ -! Harmonized Emissions Component (HEMCO) ! -!------------------------------------------------------------------------------ -!BOP -! -! !IROUTINE: InstGet -! -! !DESCRIPTION: Subroutine InstGet returns a poiner to the desired instance. -!\\ -!\\ -! !INTERFACE: -! - SUBROUTINE InstGet ( Instance, Inst, RC, PrevInst ) -! -! !INPUT PARAMETERS: -! - INTEGER :: Instance - TYPE(MyInst), POINTER :: Inst - INTEGER :: RC - TYPE(MyInst), POINTER, OPTIONAL :: PrevInst -! -! !REVISION HISTORY: -! 18 Feb 2016 - C. Keller - Initial version -! See https://github.com/geoschem/hemco for complete history -!EOP -!------------------------------------------------------------------------------ -!BOC - TYPE(MyInst), POINTER :: PrvInst - - !================================================================= - ! InstGet begins here! - !================================================================= - - ! Get instance. Also archive previous instance. - PrvInst => NULL() - Inst => AllInst - DO WHILE ( ASSOCIATED(Inst) ) - IF ( Inst%Instance == Instance ) EXIT - PrvInst => Inst - Inst => Inst%NextInst - END DO - IF ( .NOT. ASSOCIATED( Inst ) ) THEN - RC = HCO_FAIL - RETURN - ENDIF - - ! Pass output arguments - IF ( PRESENT(PrevInst) ) PrevInst => PrvInst - - ! Cleanup & Return - PrvInst => NULL() - RC = HCO_SUCCESS - - END SUBROUTINE InstGet -!EOC -!------------------------------------------------------------------------------ -! Harmonized Emissions Component (HEMCO) ! -!------------------------------------------------------------------------------ -!BOP -! -! !IROUTINE: InstCreate -! -! !DESCRIPTION: Subroutine InstCreate creates a new instance. -!\\ -!\\ -! !INTERFACE: -! - SUBROUTINE InstCreate ( ExtNr, Instance, Inst, RC ) -! -! !INPUT PARAMETERS: -! - INTEGER, INTENT(IN) :: ExtNr -! -! !OUTPUT PARAMETERS: -! - INTEGER, INTENT( OUT) :: Instance - TYPE(MyInst), POINTER :: Inst -! -! !INPUT/OUTPUT PARAMETERS: -! - INTEGER, INTENT(INOUT) :: RC -! -! !REVISION HISTORY: -! 18 Feb 2016 - C. Keller - Initial version -! See https://github.com/geoschem/hemco for complete history -!EOP -!------------------------------------------------------------------------------ -!BOC - TYPE(MyInst), POINTER :: TmpInst - INTEGER :: nnInst - - !================================================================= - ! InstCreate begins here! - !================================================================= - - ! ---------------------------------------------------------------- - ! Generic instance initialization - ! ---------------------------------------------------------------- - - ! Initialize - Inst => NULL() - - ! Get number of already existing instances - TmpInst => AllInst - nnInst = 0 - DO WHILE ( ASSOCIATED(TmpInst) ) - nnInst = nnInst + 1 - TmpInst => TmpInst%NextInst - END DO - - ! Create new instance - ALLOCATE(Inst) - Inst%Instance = nnInst + 1 - Inst%ExtNr = ExtNr - - ! Attach to instance list - Inst%NextInst => AllInst - AllInst => Inst - - ! Update output instance - Instance = Inst%Instance - - ! ---------------------------------------------------------------- - ! Type specific initialization statements follow below - ! ---------------------------------------------------------------- - - ! Return w/ success - RC = HCO_SUCCESS - - END SUBROUTINE InstCreate -!EOC -!------------------------------------------------------------------------------ -! Harmonized Emissions Component (HEMCO) ! -!------------------------------------------------------------------------------ -!BOP -!BOP -! -! !IROUTINE: InstRemove -! -! !DESCRIPTION: Subroutine InstRemove creates a new instance. -!\\ -!\\ -! !INTERFACE: -! - SUBROUTINE InstRemove ( Instance ) -! -! !INPUT PARAMETERS: -! - INTEGER :: Instance -! -! !REVISION HISTORY: -! 18 Feb 2016 - C. Keller - Initial version -! See https://github.com/geoschem/hemco for complete history -!EOP -!------------------------------------------------------------------------------ -!BOC - INTEGER :: RC - TYPE(MyInst), POINTER :: PrevInst - TYPE(MyInst), POINTER :: Inst - - !================================================================= - ! InstRemove begins here! - !================================================================= - - ! Init - PrevInst => NULL() - Inst => NULL() - - ! Get instance. Also archive previous instance. - CALL InstGet ( Instance, Inst, RC, PrevInst=PrevInst ) - - ! Instance-specific deallocation - IF ( ASSOCIATED(Inst) ) THEN - - !--------------------------------------------------------------------- - ! Deallocate fields of Inst before popping Inst off the list - ! in order to avoid memory leaks (Bob Yantosca, 17 Aug 2020) - !--------------------------------------------------------------------- - IF ( ASSOCIATED( Inst%SRCE_SAND ) ) THEN - DEALLOCATE( Inst%SRCE_SAND ) - ENDIF - Inst%SRCE_SAND => NULL() - - IF ( ASSOCIATED( Inst%SRCE_SILT ) ) THEN - DEALLOCATE( Inst%SRCE_SILT ) - ENDIF - Inst%SRCE_SILT => NULL() - - IF ( ASSOCIATED( Inst%SRCE_CLAY ) ) THEN - DEALLOCATE( Inst%SRCE_CLAY ) - ENDIF - Inst%SRCE_CLAY => NULL() - - IF ( ASSOCIATED( Inst%IPOINT ) ) THEN - DEALLOCATE( Inst%IPOINT ) - ENDIF - Inst%IPOINT => NULL() - - IF ( ASSOCIATED( Inst%FRAC_S ) ) THEN - DEALLOCATE( Inst%FRAC_S ) - ENDIf - Inst%FRAC_S => NULL() - - IF ( ASSOCIATED( Inst%DUSTDEN ) ) THEN - DEALLOCATE( Inst%DUSTDEN ) - ENDIF - Inst%DUSTDEN => NULL() - - IF ( ASSOCIATED( Inst%DUSTREFF ) ) THEN - DEALLOCATE( Inst%DUSTREFF ) - ENDIF - Inst%DUSTREFF => NULL() - - IF ( ASSOCIATED( Inst%FLUX ) ) THEN - DEALLOCATE( Inst%FLUX ) - ENDIF - Inst%FLUX => NULL() - - IF ( ASSOCIATED( Inst%FLUX_ALK ) ) THEN - DEALLOCATE( Inst%FLUX_ALK ) - ENDIF - Inst%FLUX_ALK => NULL() - - IF ( ALLOCATED ( Inst%HcoIDs ) ) THEN - DEALLOCATE( Inst%HcoIDs ) - ENDIF - - IF ( ALLOCATED ( Inst%HcoIDsALK ) ) THEN - DEALLOCATE( Inst%HcoIDsALK ) - ENDIF - - !--------------------------------------------------------------------- - ! Pop off instance from list - !--------------------------------------------------------------------- - IF ( ASSOCIATED(PrevInst) ) THEN - PrevInst%NextInst => Inst%NextInst - ELSE - AllInst => Inst%NextInst - ENDIF - DEALLOCATE(Inst) - ENDIF - - ! Free pointers before exiting - PrevInst => NULL() - Inst => NULL() - - END SUBROUTINE InstRemove -!EOC -END MODULE HCOX_DustGinoux_Mod diff --git a/src/Extensions/hcox_dustl23m_mod.F90 b/src/Extensions/hcox_dustl23m_mod.F90 new file mode 100644 index 00000000..612de58f --- /dev/null +++ b/src/Extensions/hcox_dustl23m_mod.F90 @@ -0,0 +1,1751 @@ +!------------------------------------------------------------------------------ +! Harmonized Emissions Component (HEMCO) ! +!------------------------------------------------------------------------------ +!BOP +! +! !MODULE: hcox_dustl23m_mod.F90 +! +! !DESCRIPTION: Module hcox\_dustl23m\_mod.F90 contains routines and +! variables from modified Danny M. Leung's dust emission scheme. +! +! References: +! +! [1] Leung, D. M., Kok, J. F., Li, L., Okin, G. S., Prigent, C., Klose, +! M., Pérez García-Pando, C., Menut, L., Mahowald, N. M., Lawrence, +! D. M., and Chamecki, M.: "A new process-based and scale-aware desert +! dust emission scheme for global climate models – Part I: Description +! and evaluation against inverse modeling emissions," +! Atmos. Chem. Phys., 23, 6487–6523, +! https://doi.org/10.5194/acp-23-6487-2023, 2023. +! +! [2] Zhang, D., Martin, R. V., Liu, X., van Donkelaar, A., Oxford, C. R., +! Li, Y., Meng, J., Leung, D. M., Kok, J. F., Li, L., Zhu, H., +! Turner, J. R., Yan, Y., Brauer, M., Rudich, Y., and Windwer, E.: +! "Improving Fine Mineral Dust Representation from the Surface to the +! Column in GEOS-Chem 14.4.1", +! EGUsphere [preprint], +! https://doi.org/10.5194/egusphere-2025-438, 2025. +!\\ +!\\ +! !INTERFACE: +! +MODULE HCOX_DustL23M_mod +! +! !USES: +! + USE HCO_Error_MOD + USE HCO_Diagn_MOD + USE HCOX_TOOLS_MOD + USE HCOX_State_MOD, ONLY : Ext_State + USE HCO_State_MOD, ONLY : HCO_State + + IMPLICIT NONE + PRIVATE +! +! !PUBLIC MEMBER FUNCTIONS: +! + PUBLIC :: HCOX_DustL23M_Run + PUBLIC :: HCOX_DustL23M_Init + PUBLIC :: HCOX_DustL23M_Final +! +! !REVISION HISTORY: +! 02 May 2024 - Dandan Zhang - Initial version +! See https://github.com/geoschem/hemco for complete history +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !PRIVATE TYPES: +! + ! MyInst is the extension-specific derived type. It should hold all module + ! variables and arrays that are required to compute the emissions. + ! For instance, if the extension relies on an input field read through the + ! HEMCO configuration file (e.g. MY_INPUT_FIELD), the data array pointer + ! to that field should be listed within the instance and NOT outside of it. + ! This ensures that the same extension can be invoked in various instances, + ! all of them potentially pointing to different data fields. + TYPE :: MyInst + + !----------------------------------------------------------------------- + ! General properties + !----------------------------------------------------------------------- + INTEGER :: Instance + INTEGER :: ExtNr ! Ext. num for DustL23 + INTEGER :: ExtNrAlk ! Ext. num for DustAlk + INTEGER, ALLOCATABLE :: HcoIDs(:) ! Spc IDs for DustL23 + INTEGER, ALLOCATABLE :: HcoIDsAlk(:) ! Spc IDs for DustAlk + INTEGER :: nSpc ! # of species + REAL(sp), ALLOCATABLE :: SpcScl(:) ! Species scale factors + CHARACTER(LEN=31), ALLOCATABLE :: SpcNames(:) ! Species names + INTEGER :: nSpcAlk ! # of species + CHARACTER(LEN=31), ALLOCATABLE :: SpcNamesAlk(:) + CHARACTER(LEN=61), ALLOCATABLE :: SpcScalFldNme(:) ! Scalefac field names + + ! Other fields + REAL(hp) :: C_tune ! Met-specific factor + REAL(hp), ALLOCATABLE :: DMT_MIN(:) ! Bin size min diam [m] + REAL(hp), ALLOCATABLE :: DMT_MAX(:) ! Bin size max diam [m] + + !----------------------------------------------------------------------- + ! Pointer arrays + !----------------------------------------------------------------------- + + ! The fraction of barren and sparsely vegetated land cover [unitless] + REAL(hp), POINTER :: A_bare(:,:) + + ! The fraction of short vegetation land cover [unitless] + REAL(hp), POINTER :: A_veg(:,:) + + ! Scaling factor of 0.6 over the Sahara [unitless] + REAL(hp), POINTER :: C_sah(:,:) + + ! The total XLAI [cm2 cm-2] from MODIS MCD12C1 + ! processed by Yuan et al. (XLAI in HEMCO) + REAL(hp), POINTER :: XLAI_t(:,:) + + ! The fraction of clay content in topmost soil [unitless] + REAL(hp), POINTER :: f_clay(:,:) + + ! The bulk density of the topmost soil [kg m-3] + REAL(hp), POINTER :: bulk_den(:,:) + + ! Soil porosity taken from the constant field from + ! MERRA2 M2C0NXLND collection [unitless] + REAL(hp), POINTER :: poros(:,:) + + ! Surface roughness length due to rocks [m] + REAL(hp), POINTER :: roughness_r(:,:) + + !----------------------------------------------------------------------- + ! Pointers to the next node in the linked list + !----------------------------------------------------------------------- + TYPE(MyInst), POINTER :: NextInst => NULL() + + END TYPE MyInst + + ! Pointer to all instances + TYPE(MyInst), POINTER :: AllInst => NULL() +! +! !DEFINED PARAMETERS: +! + ! Number of dust bins + INTEGER, PARAMETER :: NBINS = 7 + + ! Total number of species (NBINS + 1) + INTEGER, PARAMETER :: TNSPEC = 8 + + ! Save the value of 1/3 so we don't need to keep recomputing it + REAL(hp), PARAMETER :: ONE_THIRD = 1.0_hp / 3.0_hp + + ! Save the value of SQRT(2) so we don't need to keep recomputing it + REAL(hp), PARAMETER :: SQ_RT_2 = SQRT( 2.0_hp ) + + ! Von Karman's constant + REAL(hp), PARAMETER :: CST_VON_KRM = 0.386_hp + + ! Specific heat of dry air + REAL(hp), PARAMETER :: SPC_HEAT_DRY_AIR = 1005.0_hp + + ! Median diameter of soil particle [m] + REAL(hp), PARAMETER :: D_p = 127.0e-6_hp + + ! Soil particle density [kg m-3] + REAL(hp), PARAMETER :: rho_p = 2650.0_hp + + ! Water density [kg m-3] + REAL(hp), PARAMETER :: rho_w = 1000.0_hp + + ! Standard air density at sea level and 15 degrees C [kg m-3] + REAL(hp), PARAMETER :: rho_a0 = 1.225_hp + + ! Threshold LAI [unitless] + REAL(hp), PARAMETER :: LAI_thr = 0.5_hp + + ! Threshold snow depth [m] + REAL(hp), PARAMETER :: snowdep_thr = 0.05_hp + + ! Frozen temperature of soil to prevent dust emissions [K] + REAL(hp), PARAMETER :: T0 = 273.15_hp + +CONTAINS +!EOC +!------------------------------------------------------------------------------ +! Harmonized Emissions Component (HEMCO) ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: HCOX_dustl23m_Run +! +! !DESCRIPTION: Subroutine HcoX\_dustl23m\_Run is the driver routine +! for the HEMCO DustL23M extension. +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE HCOX_DustL23M_Run( ExtState, HcoState, RC ) +! +! !USES: +! + USE HCO_CALC_MOD, ONLY : HCO_EvalFld, HCO_CalcEmis + USE HCO_FLUXARR_MOD, ONLY : HCO_EmisAdd + USE HCO_CLOCK_MOD, ONLY : HcoClock_Get + USE HCO_CLOCK_MOD, ONLY : HcoClock_First +! +! !INPUT PARAMETERS: +! + TYPE(Ext_State), POINTER :: ExtState ! Module options + TYPE(HCO_State), POINTER :: HcoState ! Hemco state +! +! !INPUT/OUTPUT PARAMETERS: +! + INTEGER, INTENT(INOUT) :: RC ! Success or failure +! +! !REMARKS: +! +! +! !REVISION HISTORY: +! 02 May 2024 - Dandan Zhang - Revised from template for DustL23 +! See https://github.com/geoschem/hemco for complete history +!EOP +!------------------------------------------------------------------------------ +!BOC +! + ! Local variables + INTEGER :: N + CHARACTER(LEN=255) :: MSG, LOC + + ! Total dust emission flux [kg/m2/s] + REAL(hp), TARGET :: TFLUX(HcoState%NX, HcoState%NY) + + ! Flux array [kg/m2/s] + REAL(hp), TARGET :: FLUX(HcoState%NX, HcoState%NY, TNSPEC) + + ! Flux array for dust alkalinity [kg/m2/s] + REAL(hp), TARGET :: FLUX_ALK(HcoState%NX,HcoState%NY,TNSPEC) + + ! Pointer to this instance + TYPE(MyInst), POINTER :: Inst + + !================================================================= + ! HCOX_DustL23M_RUN begins here! + !================================================================= + + ! Initialize + LOC = 'HCOX_DustL23M_RUN (HCOX_DustL23M_MOD.F90)' + + ! Return if extension disabled + IF ( ExtState%DustL23M <= 0 ) RETURN + + ! Enter + CALL HCO_ENTER( HcoState%Config%Err, LOC, RC ) + IF ( RC /= HCO_SUCCESS ) THEN + MSG = 'Error encountered in "HCO_Enter"!' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN + ENDIF + + ! Get pointer to this instance. Varible Inst contains all module + ! variables for the current instance. The instance number is + ! ExtState%DustL23 + ! Get instance + Inst => NULL() + CALL InstGet( ExtState%DustL23M, Inst, RC ) + IF ( RC /= HCO_SUCCESS ) THEN + WRITE(MSG,*) 'Cannot find DustL23M instance Nr. ', ExtState%DustL23M + CALL HCO_ERROR( MSG, RC ) + RETURN + ENDIF + + !================================================================= + ! Module code comes below + !================================================================= + CALL HCO_EvalFld( HcoState, 'L23M_A_bare', Inst%A_bare, RC) + IF ( RC /= HCO_SUCCESS ) THEN + MSG = 'Could not retrieve field: L23M_A_bare' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN + ENDIF + + CALL HCO_EvalFld( HcoState, 'L23M_A_veg', Inst%A_veg, RC) + IF ( RC /= HCO_SUCCESS ) THEN + MSG = 'Could not retrieve field: L23M_A_veg' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN + ENDIF + + CALL HCO_EvalFld( HcoState, 'L23M_Csah', Inst%C_sah, RC) + IF ( RC /= HCO_SUCCESS ) THEN + MSG = 'Could not retrieve field: L23M_Csah' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN + ENDIF + + CALL HCO_EvalFld( HcoState, 'L23M_LAI', Inst%XLAI_t, RC) + IF ( RC /= HCO_SUCCESS ) THEN + MSG = 'Could not retrieve field: L23M_LAI' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN + ENDIF + + CALL HCO_EvalFld( HcoState, 'L23M_fclay', Inst%f_clay, RC) + IF ( RC /= HCO_SUCCESS ) THEN + MSG = 'Could not retrieve field: L23M_fclay' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN + ENDIF + + CALL HCO_EvalFld( HcoState, 'L23M_BD', Inst%bulk_den, RC) + IF ( RC /= HCO_SUCCESS ) THEN + MSG = 'Could not retrieve field: L23M_BD' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN + ENDIF + + CALL HCO_EvalFld( HcoState, 'L23M_poros', Inst%poros, RC) + IF ( RC /= HCO_SUCCESS ) THEN + MSG = 'Could not retrieve field: L23M_poros' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN + ENDIF + + CALL HCO_EvalFld( HcoState, 'L23M_roughness_r', Inst%roughness_r, RC) + IF ( RC /= HCO_SUCCESS ) THEN + MSG = 'Could not retrieve field: L23M_roughness_r' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN + ENDIF + + !================================================================= + ! DustL23M Emission Scheme + !================================================================= + CALL CAL_DUSTL23M_EmisFlux( HcoState, ExtState, Inst, TFLUX, RC ) + + ! Error check + IF ( RC /= HCO_SUCCESS ) THEN + MSG = 'Error encountered in routine "CAL_DUSTL23M_EMISFLUX"!' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN + ENDIF + + ! Save total and binned fluxes to the appropriate slots of FLUX + FLUX(:,:,1) = TFLUX + FLUX(:,:,2) = TFLUX * 3.344e-4_hp + FLUX(:,:,3) = TFLUX * 1.593e-3_hp + FLUX(:,:,4) = TFLUX * 1.194e-2_hp + FLUX(:,:,5) = TFLUX * 3.430e-2_hp + FLUX(:,:,6) = TFLUX * 1.248e-1_hp + FLUX(:,:,7) = TFLUX * 2.573e-1_hp + FLUX(:,:,8) = TFLUX * 5.698e-1_hp + + ! Include DUST Alkalinity SOURCE, assuming an alkalinity + ! of 4% by weight [kg]. !tdf 05/10/08 + !tdf with 3% Ca, there's also 1% equ. Mg, makes 4% + IF ( Inst%ExtNrAlk > 0 ) THEN + FLUX_ALK = 0.04_hp * FLUX + ENDIF + + !======================================================================== + ! PASS TO HEMCO STATE AND UPDATE DIAGNOSTICS + !======================================================================== + DO N = 1, TNSPEC + IF ( Inst%HcoIDs(N) > 0 ) THEN + ! Add to emissions array + CALL HCO_EmisAdd( HcoState, FLUX(:,:,N), & + Inst%HcoIDs(N), RC, & + ExtNr=Inst%ExtNr ) + IF ( RC /= HCO_SUCCESS ) THEN + WRITE(MSG,*) 'HCO_EmisAdd error: dust bin ', N + CALL HCO_ERROR( MSG, RC ) + RETURN + ENDIF + ENDIF + + IF ( Inst%ExtNrAlk > 0 ) THEN + IF ( Inst%HcoIDsAlk(N) > 0 ) THEN + ! Add to dust alkalinity emissions array + CALL HCO_EmisAdd( HcoState, FLUX_Alk(:,:,N), & + Inst%HcoIDsAlk(N), RC, & + ExtNr=Inst%ExtNrAlk ) + IF ( RC /= HCO_SUCCESS ) THEN + WRITE(MSG,*) 'HCO_EmisAdd error: dust alk bin ', N + CALL HCO_ERROR( MSG, RC ) + RETURN + ENDIF + ENDIF + ENDIF + ENDDO + + ! Cleanup + Inst => NULL() + + ! Return w/ success + CALL HCO_LEAVE( HcoState%Config%Err, RC ) + + END SUBROUTINE HCOX_DustL23M_Run +!EOC +!------------------------------------------------------------------------------ +! Harmonized Emissions Component (HEMCO) ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: HCOX_DustL23M_Init +! +! !DESCRIPTION: Subroutine HcoX\_DustL23M\_Init initializes the HEMCO +! DUSTL23M extension. +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE HCOX_DustL23M_Init( HcoState, ExtName, ExtState, RC ) +! +! !USES: +! + USE HCO_ExtList_Mod, ONLY : GetExtNr + USE HCO_ExtList_Mod, ONLY : GetExtOpt + USE HCO_STATE_MOD, ONLY : HCO_GetExtHcoID + USE HCO_ExtList_Mod, ONLY : GetExtSpcVal +! +! !INPUT PARAMETERS: +! + CHARACTER(LEN=*), INTENT(IN ) :: ExtName ! Extension name + TYPE(Ext_State), POINTER :: ExtState ! Module options +! +! !INPUT/OUTPUT PARAMETERS: +! + TYPE(HCO_State), POINTER :: HcoState ! Hemco state + INTEGER, INTENT(INOUT) :: RC + +! !REVISION HISTORY: +! 06 May 2024 - Dandan Zhang - Initial version for DustL23 +! See https://github.com/geoschem/hemco for complete history +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + ! Scalars + LOGICAL :: FOUND + INTEGER :: ExtNr + INTEGER :: N + REAL(hp) :: TmpScal + + ! Strings + CHARACTER(LEN=255) :: MSG + CHARACTER(LEN=255) :: LOC + + ! Pointers + TYPE(MyInst), POINTER :: Inst + + !======================================================================== + ! HCOX_DustL23M_INIT begins here! + !======================================================================== + + ! Assume success + RC = HCO_SUCCESS + + ! Exit if this extension is turned off + ExtNr = GetExtNr( HcoState%Config%ExtList, TRIM( ExtName ) ) + IF ( ExtNr <= 0 ) RETURN + + ! Initialize + TmpScal = 0.0_hp + MSG = '' + LOC = 'HCOX_DustL23M_INIT (HCOX_DUSTL23M_MOD.F90)' + Inst => NULL() + + ! Enter + CALL HCO_ENTER( HcoState%Config%Err, LOC, RC ) + IF ( RC /= HCO_SUCCESS ) THEN + MSG = 'Error encountered in "HCO_Enter"!' + CALL HCO_ERROR( MSG, RC, LOC ) + RETURN + ENDIF + + ! Create instance for this simulation. Link instance number to the + ! ExtState object for future reference to the instance. See InstCreate + ! for more details. + CALL InstCreate( ExtNr, ExtState%DustL23M, Inst, RC ) + IF ( RC /= HCO_SUCCESS ) THEN + CALL HCO_ERROR( 'Cannot create DustL23M instance', RC ) + RETURN + ENDIF + + ! Get species IDs. + CALL HCO_GetExtHcoID( HcoState, Inst%ExtNr, Inst%HcoIDs, & + Inst%SpcNames, Inst%nSpc, RC ) + IF ( RC /= HCO_SUCCESS ) THEN + MSG = 'Error encountered in "HCO_GetExtHcoId"' + CALL HCO_ERROR( MSG, RC, LOC ) + RETURN + ENDIF + + ! Check for dust alkalinity option + Inst%ExtNrAlk = GetExtNr( HcoState%Config%ExtList, 'DustAlk') + + ! Get the dust alkalinity species defined for DustAlk option + IF ( Inst%ExtNrAlk > 0 ) THEN + CALL HCO_GetExtHcoID( HcoState, Inst%ExtNrAlk, & + Inst%HcoIDsAlk, Inst%SpcNamesAlk, & + Inst%nSpcAlk, RC ) + IF ( RC /= HCO_SUCCESS ) THEN + MSG = 'Error encountered in "HCO_GetExtHcoId" (for DustAlk)' + CALL HCO_ERROR( 'ERROR 3', RC, THISLOC=LOC ) + RETURN + ENDIF + ENDIF + + ! Sanity check + IF ( Inst%nSpc /= TNSPEC ) THEN + MSG = 'DustL23M model does not have 7(+1 total) species!' + CALL HCO_ERROR(MSG, RC ) + RETURN + ENDIF + + ! There must be at least one species + IF ( Inst%nSpc == 0 ) THEN + CALL HCO_ERROR ( 'No DustL23M species specified', RC ) + RETURN + ENDIF + + ! Set resolution-dependent scale factor: first try to read from + ! configuration file. If not specified, call wrapper function which + ! sets teh scale factor + ! based upon compiler switches. + CALL GetExtOpt( HcoState%Config, Inst%ExtNr, 'Mass tuning factor', & + OptValDp=TmpScal, Found=FOUND, RC=RC ) + IF ( RC /= HCO_SUCCESS ) THEN + MSG = 'Error encountered in routine "GetExtOpt" (for tuning factor)!' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN + ENDIF + + ! Read horizontal-grid dependent parameter C_tune from config file. + ! Now halt run if C_tune is not found, as the negative fill value + ! will result in negative emissions. + IF ( FOUND ) THEN + Inst%C_tune = TmpScal + ELSE + Inst%C_tune = -999.0e0 + ENDIF + IF ( Inst%C_tune < 0.0 ) THEN + CALL HCO_ERROR( 'Mass tuning factor "C_tune" is undefined!', RC ) + RETURN + ENDIF + + ! Determine scale factor to be applied to each species. This is 1.00 + ! by default, but can be set in the HEMCO configuration file via setting + ! Scaling_. + CALL GetExtSpcVal( HcoState%Config, Inst%ExtNr, Inst%nSpc, & + Inst%SpcNames, 'Scaling', 1.0_sp, & + Inst%SpcScl, RC ) + IF ( RC /= HCO_SUCCESS ) THEN + MSG = 'Error encountered in routine "GetExtSpcVal" (for "Scaling")!' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN + ENDIF + + ! Get species mask fields + CALL GetExtSpcVal( HcoState%Config, Inst%ExtNr, Inst%nSpc, & + Inst%SpcNames, 'ScaleField', HCOX_NOSCALE, & + Inst%SpcScalFldNme, RC ) + IF ( RC /= HCO_SUCCESS ) THEN + MSG = 'Error encountered in routine "GetExtSpcVal" (for "ScaleField")!' + + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN + ENDIF + + ! Verbose mode + IF ( HcoState%amIRoot ) THEN + + ! Write the name of the extension regardless of the verbose setting + ! Use the separator if Verbose output is turned on + msg = 'Using HEMCO extension: DustL23M (dust emission scheme)' + IF ( HcoState%Config%doVerbose ) THEN + CALL HCO_Msg( msg, sep1='-', LUN=HcoState%Config%hcoLogLUN ) + ELSE + CALL HCO_Msg( msg, LUN=HcoState%Config%hcoLogLUN ) + ENDIF + + ! Write all other messages as debug printout only + MSG = ' - use the following species (Name, HcoID, Scaling):' + CALL HCO_MSG( MSG, LUN=HcoState%Config%hcoLogLUN ) + DO N = 1, Inst%nSpc + WRITE(MSG,*) TRIM(Inst%SpcNames(N)), ', ', & + Inst%HcoIDs(N), ', ', & + Inst%SpcScl(N) + CALL HCO_MSG( MSG, LUN=HcoState%Config%hcoLogLUN ) + WRITE(MSG,*) 'Apply scale field: ', TRIM(Inst%SpcScalFldNme(N)) + CALL HCO_MSG( MSG, LUN=HcoState%Config%hcoLogLUN ) + ENDDO + ENDIF + + !----------------------------------------------------------------- + ! Init module arrays + !----------------------------------------------------------------- + ALLOCATE( Inst%A_bare( HcoState%NX, HcoState%NY), STAT=RC ) + IF ( RC /= HCO_SUCCESS ) THEN + msg = 'Could not allocate Inst%A_bare!' + CALL HCO_ERROR( msg, RC, thisLoc=loc ) + RETURN + ENDIF + Inst%A_bare = -9999.0_hp + + ALLOCATE( Inst%A_veg( HcoState%NX, HcoState%NY), STAT=RC ) + IF ( RC /= HCO_SUCCESS ) THEN + msg = 'Could not allocate Inst%A_veg!' + CALL HCO_ERROR( msg, RC, thisLoc=loc ) + RETURN + ENDIF + Inst%A_veg = -9999.0_hp + + ALLOCATE( Inst%C_sah( HcoState%NX, HcoState%NY), STAT=RC ) + IF ( RC /= HCO_SUCCESS ) THEN + msg = 'Could not allocate Inst%C_sah!' + CALL HCO_ERROR( msg, RC, thisLoc=loc ) + RETURN + ENDIF + Inst%C_sah = -9999.0_hp + + ALLOCATE( Inst%XLAI_t( HcoState%NX, HcoState%NY), STAT=RC ) + IF ( RC /= HCO_SUCCESS ) THEN + msg = 'Could not allocate Inst%XLAI_t!' + CALL HCO_ERROR( msg, RC, thisLoc=loc ) + RETURN + ENDIF + Inst%XLAI_t = -9999.0_hp + + ALLOCATE( Inst%f_clay( HcoState%NX, HcoState%NY), STAT=RC ) + IF ( RC /= HCO_SUCCESS ) THEN + msg = 'Could not allocate Inst%f_clay!' + CALL HCO_ERROR( msg, RC, thisLoc=loc ) + RETURN + ENDIF + Inst%f_clay = -9999.0_hp + + ALLOCATE( Inst%bulk_den( HcoState%NX, HcoState%NY), STAT=RC ) + IF ( RC /= HCO_SUCCESS ) THEN + msg = 'Could not allocate Inst%bulk_den!' + CALL HCO_ERROR( msg, RC, thisLoc=loc ) + RETURN + ENDIF + Inst%bulk_den = -9999.0_hp + + ALLOCATE( Inst%poros( HcoState%NX, HcoState%NY), STAT=RC ) + IF ( RC /= HCO_SUCCESS ) THEN + msg = 'Could not allocate Inst%poros!' + CALL HCO_ERROR( msg, RC, thisLoc=loc ) + RETURN + ENDIF + Inst%poros = -9999.0_hp + + ALLOCATE( Inst%roughness_r( HcoState%NX, HcoState%NY), STAT=RC ) + IF ( RC /= HCO_SUCCESS ) THEN + msg = 'Could not allocate Inst%roughness_r!' + CALL HCO_ERROR( msg, RC, thisLoc=loc ) + RETURN + ENDIF + Inst%roughness_r = -9999.0_hp + + ! Bin size min diameter [m] + ALLOCATE( Inst%DMT_MIN( NBINS ), STAT=RC ) + IF ( RC /= HCO_SUCCESS ) THEN + CALL HCO_ERROR ( 'DMT_MIN', RC, LOC ) + RETURN + ENDIF + Inst%DMT_MIN(1) = 0.2e-6_hp + Inst%DMT_MIN(2) = 0.36e-6_hp + Inst%DMT_MIN(3) = 0.6e-6_hp + Inst%DMT_MIN(4) = 1.2e-6_hp + Inst%DMT_MIN(5) = 2.0e-6_hp + Inst%DMT_MIN(6) = 3.6e-6_hp + Inst%DMT_MIN(7) = 6.0e-6_hp + + ! Bin size max diameter [m] + ALLOCATE( Inst%DMT_MAX( NBINS ), STAT=RC ) + IF ( RC /= 0 ) THEN + CALL HCO_ERROR ( 'DMT_MAX', RC ) + RETURN + ENDIF + Inst%DMT_MAX(1) = 0.36e-6_hp + Inst%DMT_MAX(2) = 0.6e-6_hp + Inst%DMT_MAX(3) = 1.2e-6_hp + Inst%DMT_MAX(4) = 2.0e-6_hp + Inst%DMT_MAX(5) = 3.6e-6_hp + Inst%DMT_MAX(6) = 6.0e-6_hp + Inst%DMT_MAX(7) = 1.2e-5_hp + + ! Activate met fields used by this extension + ! NOTE: PS and PBLH will be taken from the HcoState%Grid object + ExtState%GWETTOP%DoUse = .TRUE. + ExtState%HFLUX%DoUse = .TRUE. + ExtState%SNOMAS%DoUse = .TRUE. + ExtState%T2M%DoUse = .TRUE. + ExtState%TSKIN%DoUse = .TRUE. + ExtState%USTAR%DoUse = .TRUE. + + ! Cleanup + Inst => NULL() + CALL HCO_LEAVE( HcoState%Config%Err, RC ) + + END SUBROUTINE HCOX_DustL23M_Init +!EOC +!------------------------------------------------------------------------------ +! Harmonized Emissions Component (HEMCO) ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: HCOX_DustL23M_Final +! +! !DESCRIPTION: Subroutine HcoX\_DustL23M\_Final finalizes the HEMCO +! DustL23M extension. +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE HCOX_DustL23M_Final ( ExtState ) +! +! !INPUT PARAMETERS: +! + TYPE(Ext_State), POINTER :: ExtState ! Module options +! +! !REVISION HISTORY: +! 06 May 2024 - Dandan Zhang - Initial version +! See https://github.com/geoschem/hemco for complete history +!EOP +!------------------------------------------------------------------------------ +!BOC + !================================================================= + ! HCOX_DustL23M_FINAL begins here! + !================================================================= + CALL InstRemove( ExtState%DustL23M ) + + END SUBROUTINE HCOX_DustL23M_Final +!EOC +!------------------------------------------------------------------------------ +! Harmonized Emissions Component (HEMCO) ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: InstGet +! +! !DESCRIPTION: Subroutine InstGet returns a pointer to the desired instance. +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE InstGet( Instance, Inst, RC, PrevInst ) +! +! !INPUT PARAMETERS: +! + INTEGER :: Instance + TYPE(MyInst), POINTER :: Inst + INTEGER :: RC + TYPE(MyInst), POINTER, OPTIONAL :: PrevInst +! +! !REVISION HISTORY: +! 18 Feb 2016 - C. Keller - Initial version +! See https://github.com/geoschem/hemco for complete history +!EOP +!------------------------------------------------------------------------------ +!BOC + TYPE(MyInst), POINTER :: PrvInst + + !================================================================= + ! InstGet begins here! + !================================================================= + + ! Get instance. Also archive previous instance. + PrvInst => NULL() + Inst => AllInst + DO WHILE ( ASSOCIATED(Inst) ) + IF ( Inst%Instance == Instance ) EXIT + PrvInst => Inst + Inst => Inst%NextInst + END DO + IF ( .NOT. ASSOCIATED( Inst ) ) THEN + RC = HCO_FAIL + RETURN + ENDIF + + ! Pass output arguments + IF ( PRESENT(PrevInst) ) PrevInst => PrvInst + + ! Cleanup & Return + PrvInst => NULL() + RC = HCO_SUCCESS + + END SUBROUTINE InstGet +!EOC +!------------------------------------------------------------------------------ +! Harmonized Emissions Component (HEMCO) ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: InstCreate +! +! !DESCRIPTION: Subroutine InstCreate adds a new instance to the list of +! instances, assigns a unique instance number to this new instance, and +! archives this instance number to output argument Instance. +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE InstCreate( ExtNr, Instance, Inst, RC ) +! +! !INPUT PARAMETERS: +! + INTEGER, INTENT(IN) :: ExtNr +! +! !OUTPUT PARAMETERS: +! + INTEGER, INTENT( OUT) :: Instance + TYPE(MyInst), POINTER :: Inst +! +! !INPUT/OUTPUT PARAMETERS: +! + INTEGER, INTENT(INOUT) :: RC +! +! !REVISION HISTORY: +! 18 Feb 2016 - C. Keller - Initial version +! See https://github.com/geoschem/hemco for complete history +!EOP +!------------------------------------------------------------------------------ +!BOC + TYPE(MyInst), POINTER :: TmpInst => NULL() + INTEGER :: nnInst + + !================================================================= + ! InstCreate begins here! + !================================================================= + + ! ---------------------------------------------------------------- + ! Generic instance initialization + ! ---------------------------------------------------------------- + + ! Initialize + Inst => NULL() + + ! Get number of already existing instances + TmpInst => AllInst + nnInst = 0 + DO WHILE ( ASSOCIATED(TmpInst) ) + nnInst = nnInst + 1 + TmpInst => TmpInst%NextInst + END DO + + ! Create new instance + ALLOCATE(Inst) + Inst%Instance = nnInst + 1 + Inst%ExtNr = ExtNr + + ! Attach to instance list + Inst%NextInst => AllInst + AllInst => Inst + + ! Update output instance + Instance = Inst%Instance + + ! ---------------------------------------------------------------- + ! Type specific initialization statements follow below + ! ---------------------------------------------------------------- + Inst%A_bare => NULL() + Inst%A_veg => NULL() + Inst%C_sah => NULL() + Inst%XLAI_t => NULL() + Inst%f_clay => NULL() + Inst%bulk_den => NULL() + Inst%poros => NULL() + Inst%roughness_r => NULL() + + ! Return w/ success + RC = HCO_SUCCESS + + END SUBROUTINE InstCreate +!EOC +!------------------------------------------------------------------------------ +! Harmonized Emissions Component (HEMCO) ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: InstRemove +! +! !DESCRIPTION: Subroutine InstRemove removes an instance from the list of +! instances. +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE InstRemove( Instance ) +! +! !INPUT PARAMETERS: +! + INTEGER :: Instance +! +! !REVISION HISTORY: +! 18 Feb 2016 - C. Keller - Initial version +! See https://github.com/geoschem/hemco for complete history +!EOP +!------------------------------------------------------------------------------ +!BOC + INTEGER :: RC + TYPE(MyInst), POINTER :: PrevInst + TYPE(MyInst), POINTER :: Inst + + !================================================================= + ! InstRemove begins here! + !================================================================= + + ! Initialize + PrevInst => NULL() + Inst => NULL() + + ! Get instance. Also archive previous instance. + CALL InstGet ( Instance, Inst, RC, PrevInst=PrevInst ) + + ! Instance-specific deallocation + IF ( ASSOCIATED(Inst) ) THEN + + !--------------------------------------------------------------------- + ! Deallocate fields of Inst before popping off from the list + ! in order to avoid memory leaks (Bob Yantosca (17 Aug 2022) + !--------------------------------------------------------------------- + IF ( ALLOCATED( Inst%HcoIDs ) ) DEALLOCATE( Inst%HcoIDs ) + IF ( ALLOCATED( Inst%SpcScl ) ) DEALLOCATE( Inst%SpcScl ) + IF ( ALLOCATED( Inst%SpcNames ) ) DEALLOCATE( Inst%SpcNames ) + IF ( ALLOCATED( Inst%SpcScalFldNme ) ) DEALLOCATE( Inst%SpcScalFldNme ) + IF ( ASSOCIATED( Inst%A_bare ) ) DEALLOCATE( Inst%A_bare ) + IF ( ASSOCIATED( Inst%A_veg ) ) DEALLOCATE( Inst%A_veg ) + IF ( ASSOCIATED( Inst%C_sah ) ) DEALLOCATE( Inst%C_sah ) + IF ( ASSOCIATED( Inst%XLAI_t ) ) DEALLOCATE( Inst%XLAI_t ) + IF ( ASSOCIATED( Inst%f_clay ) ) DEALLOCATE( Inst%f_clay ) + IF ( ASSOCIATED( Inst%bulk_den ) ) DEALLOCATE( Inst%bulk_den ) + IF ( ASSOCIATED( Inst%poros ) ) DEALLOCATE( Inst%poros ) + IF ( ASSOCIATED( Inst%roughness_r ) ) DEALLOCATE( Inst%roughness_r ) + + ! Nullify pointer fields + Inst%A_bare => NULL() + Inst%A_veg => NULL() + Inst%C_sah => NULL() + Inst%XLAI_t => NULL() + Inst%f_clay => NULL() + Inst%bulk_den => NULL() + Inst%poros => NULL() + Inst%roughness_r => NULL() + + ! ---------------------------------------------------------------- + ! Pop off instance from list + ! ---------------------------------------------------------------- + IF ( ASSOCIATED( PrevInst ) ) THEN + PrevInst%NextInst => Inst%NextInst + ELSE + AllInst => Inst%NextInst + ENDIF + DEALLOCATE( Inst ) + ENDIF + + ! Free pointers before exiting + PrevInst => NULL() + Inst => NULL() + + END SUBROUTINE InstRemove +!EOC +!------------------------------------------------------------------------------ +! Harmonized Emissions Component (HEMCO) ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: CAL_THR_FRIC_VEL +! +! !DESCRIPTION: Calculates threshold friction velocities +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE CAL_THR_FRIC_VEL( HcoState, rho_a, f_clay, bulk_den, & + poros, GWETTOP, u_star_ft0, u_star_ft, & + u_star_it, u_star_st, RC ) +! +! !INPUT/OUTPUT PARAMETERS: +! + ! HEMCO state object + TYPE(HCO_State), POINTER :: HcoState +! +! !INPUT PARAMETERS: +! + ! surface air density [kg m-3] + REAL(hp), INTENT(IN) :: rho_a(HcoState%NX, HcoState%NY) + + ! Soil clay fraction [unitless] + REAL(hp), INTENT(IN) :: f_clay(HcoState%NX, HcoState%NY) + + ! Bulk density of the topmost soil [kg m-3] + REAL(hp), INTENT(IN) :: bulk_den(HcoState%NX, HcoState%NY) + + ! Soil porosity [unitless] + REAL(hp), INTENT(IN) :: poros(HcoState%NX, HcoState%NY) + + ! Ground wetness [unitless] => to calculate soil moisture content SFMC + REAL(hp), INTENT(IN) :: GWETTOP(HcoState%NX, HcoState%NY) +! +! !OUTPUT PARAMETERS: +! + ! Dry fluid thershold friction velocity [m s-1] + REAL(hp), INTENT(OUT) :: u_star_ft0(HcoState%NX, HcoState%NY) + + ! Wet fluid thershold friction velocity [m s-1] + REAL(hp), INTENT(OUT) :: u_star_ft(HcoState%NX, HcoState%NY) + + ! Dynamic fluid thershold friction velocity [m s-1] + REAL(hp), INTENT(OUT) :: u_star_it(HcoState%NX, HcoState%NY) + + ! Standardized wet fluid thershold friction velocity [m s-1] + REAL(hp), INTENT(OUT) :: u_star_st(HcoState%NX, HcoState%NY) + + ! Success or failure? + INTEGER, INTENT(OUT) :: RC +! +! !REVISION HISTORY: +! 02 May 2024 - Dandan Zhang - Initial version +! See https://github.com/geoschem/hemco for complete history +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !DEFINED PARAMETERS: +! + REAL(hp), PARAMETER :: A = 0.0123_hp + REAL(hp), PARAMETER :: gamma = 1.65e-4_hp ! [kg s-2] + REAL(hp), PARAMETER :: B_it = 0.82_hp +! +! !LOCAL VARIABLES: +! + !------------------------------------------------------------------------ + ! Local variables + !------------------------------------------------------------------------ + + ! Scalars + INTEGER :: I, J + REAL(hp) :: w + REAL(hp) :: w_t + + ! Arrays + REAL(hp) :: f_m(HcoState%NX, HcoState%NY) + + !======================================================================== + ! CAL_THR_FRIC_VEL begins here! + !======================================================================== + + !$OMP PARALLEL DO & + !$OMP DEFAULT( SHARED )& + !$OMP PRIVATE( I, J, w, w_t )& + !$OMP COLLAPSE( 2 ) + DO J = 1, HcoState%NY + DO I = 1, HcoState%NX + + !--------------------------------------------------------------------- + ! Dry fluid threshold velocity [m s-1]: + ! calculate u_star_ft0 + ! = sqrt(A * (rho_p * g * D_p + gamma / D_p) / rho_a) + !--------------------------------------------------------------------- + u_star_ft0(I,J) = & + SQRT(A * (rho_p * HcoState%Phys%g0 * D_p + gamma / D_p) / rho_a(I,J)) + + !--------------------------------------------------------------------- + ! Calculate w, gravimetric soil moisture [unitless] + ! = rho_w / rho_b * theta with additional 0.5 scaling + ! + ! According to https://gmao.gsfc.nasa.gov/reanalysis/MERRA-2/FAQ/#Q1: + ! Soil moisture (SFMC) can be computed as SFMC = GWETTOP * poros, + ! since SFMC is not archived in MERRA2/GEOSFP for GEOS-Chem) + ! + ! Also prevent div-by-zero in case bulk_den is zero + !--------------------------------------------------------------------- + w = 0.0_hp + IF ( bulk_den(I,J) > 0.0_hp ) THEN + w = rho_w / bulk_den(I,J) * ( GWETTOP(I,J) * poros(I,J) ) * 0.5_hp + ENDIF + + !--------------------------------------------------------------------- + ! Calculate w_t, ! Threshols gravimetric soil moisture [unitlss] + + ! = 0.01 * a * (17 * f_clay + 14 * f_clay**2) + ! where a is a tuning factor and was set to be 1.0 + !--------------------------------------------------------------------- + w_t = 0.01_hp & + * ( 17.0_hp * f_clay(I,J) + 14.0_hp * f_clay(I,J)**2 ) + + !--------------------------------------------------------------------- + ! Factor by which threshold velocity increases due to soil wetness + ! calculate f_m [unitless] + ! = SQRT( 1 + 1.21 * ( (100.0 * (w - w_t) )**0.68 ) ) for w > w_t + ! = 1 for w <= w_t + !--------------------------------------------------------------------- + f_m(I,J) = 1.0_hp + IF ( ( w > w_t ) .and. & + ( bulk_den(I,J) > 1.0e-15 ) .and. & + ( poros(I,J) > 1.0e-15 ) .and. & + ( f_clay(I,J) > 1.0e-15 ) ) THEN + f_m(I,J) = & + SQRT( 1.0_hp + 1.21_hp * ( ( 100.0_hp * ( w - w_t ) )**0.68_hp ) ) + ENDIF + + ENDDO + ENDDO + !$OMP END PARALLEL DO + + ! Wet threshold friction velocity [m s-1] + u_star_ft = u_star_ft0 * f_m + + ! Dynamic threshold friction velocity [m s-1] + ! calculate u_star_it = B_it * u_star_ft0 + u_star_it = B_it * u_star_ft0 + + ! Standardized wet fluid thershold friction velocity [m s-1] + u_star_st = u_star_ft * SQRT( rho_a / rho_a0 ) + + ! Return w/ success + RC = HCO_SUCCESS + + END SUBROUTINE CAL_THR_FRIC_VEL +!EOC +!------------------------------------------------------------------------------ +! Harmonized Emissions Component (HEMCO) ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: CAL_DRAG_PART +! +! !DESCRIPTION: Calculate drag partioning effects due to rocks and vegetation. +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE CAL_DRAG_PART( HcoState, z_0a, LAI, A_r, A_v, & + f_eff_r, f_eff_v, F_eff, RC ) +! +! !INPUT/OUTPUT PARAMETERS: +! + ! HEMCO state object + TYPE(HCO_State), POINTER :: HcoState +! +! !INPUT PARAMETERS: +! + ! surface roughness length due to rocks [m] + REAL(hp), INTENT(IN) :: z_0a(HcoState%NX, HcoState%NY) + + ! Leaf area index [unitless] + REAL(hp), INTENT(IN) :: LAI(HcoState%NX, HcoState%NY) + + ! The fraction of barren and sparsely vegetated land cover [unitless] + REAL(hp), INTENT(IN) :: A_r(HcoState%NX, HcoState%NY) + + ! The fraction of short vegetation land cover [unitless] + REAL(hp), INTENT(IN) :: A_v(HcoState%NX, HcoState%NY) +! +! !OUTPUT PARAMETERS: +! + ! The drag partitioning effects due to rocks [unitless] + REAL(hp), INTENT(OUT) :: f_eff_r(HcoState%NX, HcoState%NY) + + ! The drag partitioning effects due to short vegetation [unitless] + REAL(hp), INTENT(OUT) :: f_eff_v(HcoState%NX, HcoState%NY) + + ! The total drag partitioning effects due to rocks + ! and short vegetation [unitless] + REAL(hp), INTENT(OUT) :: F_eff(HcoState%NX, HcoState%NY) + + ! Success or failure? + INTEGER, INTENT(OUT) :: RC +! +! !REVISION HISTORY: +! 02 May 2024 - Dandan Zhang - Initial version +! See https://github.com/geoschem/hemco for complete history +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !DEFINED PARAMETERS: +! + ! Coefficients + REAL(hp), PARAMETER :: b1 = 0.7_hp + REAL(hp), PARAMETER :: b2 = 0.8_hp + REAL(hp), PARAMETER :: X = 10.0_hp ! [m] + REAL(hp), PARAMETER :: f0 = 0.32_hp + REAL(hp), PARAMETER :: c = 4.8_hp + + ! Smooth roughness length which quantifies the roughness of a + ! bed of fine soil particles in the absence of roughness elements [m] + REAL(hp), PARAMETER :: z_0s = 2.0_hp * D_p / 30.0_hp +! +! !LOCAL VARIABLES: +! + ! Scalars + INTEGER :: I, J + REAL(hp) :: K + + !======================================================================== + ! CAL_DRAG_PART begins here! + !======================================================================== + + !$OMP PARALLEL DO & + !$OMP DEFAULT( SHARED )& + !$OMP PRIVATE( I, J, K )& + !$OMP COLLAPSE( 2 ) + DO J = 1, HcoState%NY + DO I = 1, HcoState%NX + + !--------------------------------------------------------------------- + ! Calculate K = pi/2 * (1 / f_v - 1) = pi/2 * (LAI_thr / LAI - 1) + ! + ! Also prevent div-by-zero when LAI is zero (over oceans) + !--------------------------------------------------------------------- + K = 0.0_hp + IF ( LAI(I,J) > 0.0_hp ) THEN + K = HcoState%Phys%PI / 2.0_hp * ( LAI_thr / LAI(I,J) - 1.0_hp ) + ENDIF + + ! Force values to be positive + IF ( K < 0.0_hp ) K = 0.0_hp + + !--------------------------------------------------------------------- + ! Calculate drag partioning effects due to rocks: + ! f_eff_r = 1 - ln(z_0a / z_0s) / ln(b1 * (X / z_0s) ** b2) + !--------------------------------------------------------------------- + f_eff_r(I,J) = 1.0_hp + IF ( z_0a(I,J) > 0.0_hp ) THEN + f_eff_r(I,J) = & + 1.0_hp - LOG( z_0a(I,J) / z_0s ) / LOG( b1 * ( X / z_0s )**b2 ) + ENDIF + + ! Force values to be in the range 0..1 + IF ( f_eff_r(I,J) < 0.0_hp ) THEN + f_eff_r(I,J) = 0.0_hp + ELSE IF ( f_eff_r(I,J) > 1.0_hp .or. LAI(I,J) > LAI_thr ) THEN + f_eff_r(I,J) = 1.0_hp + ENDIF + + !--------------------------------------------------------------------- + ! calculate drag partioning effects due to vegetation: + ! f_eff_v = (K + f0 * c) / (K + c) + !--------------------------------------------------------------------- + f_eff_v(I,J) = ( K + f0 * c ) / ( K + c ) + + ! Force values to be in the range 0..1 + IF ( f_eff_v(I,J) < 0.0_hp ) THEN + f_eff_v(I,J) = 0.0_hp + ELSE IF ( f_eff_v(I,J) > 1.0_hp .or. LAI(I,J) < 1.0e-15_hp ) THEN + f_eff_v(I,J) = 1.0_hp + ENDIF + + !--------------------------------------------------------------------- + ! calculate the weighted-mean drag partioning effects due to + ! rocks and vegetation + !--------------------------------------------------------------------- + F_eff(I,J) = ( A_r(I,J) * f_eff_r(I,J)**3 & + + A_v(I,J) * f_eff_v(I,J)**3 )**ONE_THIRD + + ! Force values to be in the range 0..1 + IF ( F_eff(I,J) < 0.0_hp ) THEN + F_eff(I,J) = 0.0_hp + ELSE IF ( F_eff(I,J) > 1.0_hp ) THEN + F_eff(I,J) = 1.0_hp + ENDIF + + ENDDO + ENDDO + !$OMP END PARALLEL DO + + ! Return w/ success + RC = HCO_SUCCESS + + END SUBROUTINE CAL_DRAG_PART +!EOC +!------------------------------------------------------------------------------ +! Harmonized Emissions Component (HEMCO) ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: CAL_INTERM_FACTOR +! +! !DESCRIPTION: Calculate intermittency factor due to turbulence +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE CAL_INTERM_FACTOR( HcoState, u_star_ft, u_star_it, u_star_s, & + PBLH, rho_a, T2M, u_star, & + HFLUX, eta, RC ) +! +! !INPUT/OUTPUT PARAMETERS: +! + ! HEMCO state object + TYPE(HCO_State), POINTER :: HcoState +! +! !INPUT PARAMETERS: +! + ! Wet fluid threshold friction velocity [m s-1] + REAL(hp), INTENT(IN) :: u_star_ft(HcoState%NX, HcoState%NY) + + ! Dynamic fluid threshold friction velocity [m s-1] + REAL(hp), INTENT(IN) :: u_star_it(HcoState%NX, HcoState%NY) + + ! Soil friction velocity [m s-1] + REAL(hp), INTENT(IN) :: u_star_s(HcoState%NX, HcoState%NY) + + ! Planetary boundary layer height [m] + REAL(hp), INTENT(IN) :: PBLH(HcoState%NX, HcoState%NY) + + ! Surface air density [kg m-3] + REAL(hp), INTENT(IN) :: rho_a(HcoState%NX, HcoState%NY) + + ! Temperature at 2 meter [K] (proxy for air temperature) + REAL(hp), INTENT(IN) :: T2M(HcoState%NX, HcoState%NY) + + ! Friction velocity [m s-1] + REAL(hp), INTENT(IN) :: u_star(HcoState%NX, HcoState%NY) + + ! Sensible heat flux [W m-2] + REAL(hp), INTENT(IN) :: HFLUX(HcoState%NX, HcoState%NY) +! +! !OUTPUT PARAMETERS: +! + ! Intermittency factor with values in [0,1] [unitless] + REAL(hp), INTENT(OUT) :: eta(HcoState%NX, HcoState%NY) + + ! Success or failure + INTEGER, INTENT(OUT) :: RC +! +! !REVISION HISTORY: +! 02 May 2024 - Dandan Zhang - Initial version +! See https://github.com/geoschem/hemco for complete history +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !DEFINED PARAMETERS: +! + REAL(hp), PARAMETER :: z_sal = 0.1_hp ! saltation height [m] + REAL(hp), PARAMETER :: z_0a_c = 1.0e-4_hp ! Assume constant (simplicity) [m] +! +! !LOCAL VARIABLES: +! + ! Scalars + INTEGER :: I, J + REAL(hp) :: alpha, L, P_ft, P_it + REAL(hp) :: sigma, term_1, term_2, term_3 + REAL(hp) :: u_ft, u_it, u_s + + !======================================================================== + ! CAL_INTERM_FACTOR begins here! + !======================================================================== + + ! Initialize + RC = HCO_SUCCESS ! Assume success + eta = 1.0_hp ! Start by setting eta = 1 everywhere + + ! Loop over grid boxes + !$OMP PARALLEL DO & + !$OMP DEFAULT( SHARED )& + !$OMP PRIVATE( alpha, P_ft, P_it, sigma, term_1, term_2 )& + !$OMP PRIVATE( term_3, u_ft, u_it, u_s, L )& + !$OMP SCHEDULE( GUIDED, 24 )& + !$OMP COLLAPSE( 2 ) + DO J = 1, HcoState%NY + DO I = 1, HcoState%NX + + !--------------------------------------------------------------------- + ! Initialize for safety's sake + !--------------------------------------------------------------------- + alpha = 0.0_hp + P_ft = 0.0_hp + P_it = 0.0_hp + sigma = 0.0_hp + term_1 = 0.0_hp + term_2 = 0.0_hp + term_3 = 0.0_hp + + !--------------------------------------------------------------------- + ! Compute friction velocities + ! Only compute the log term once (for efficiency) + !--------------------------------------------------------------------- + term_1 = LOG( z_sal / z_0a_c ) + u_ft = u_star_ft(I,J) / CST_VON_KRM * term_1 + u_it = u_star_it(I,J) / CST_VON_KRM * term_1 + u_s = u_star_s(I,J) / CST_VON_KRM * term_1 + + !--------------------------------------------------------------------- + ! Calculate the Monin-Obukhov length + ! L = -rho_a * cp * T * u_star ** 3 / (k * g * H) + !--------------------------------------------------------------------- + L = -rho_a(I,J) * SPC_HEAT_DRY_AIR & + * T2M(I,J) * u_star(I,J)**3 & + / ( CST_VON_KRM * HcoState%Phys%g0 * HFLUX(I,J) ) + + !--------------------------------------------------------------------- + ! Calculate sigma for instantaneous soil friction velocity: + ! + ! sigma = u_star_s * (12 - 0.5 * PBLH / L) ** (1/3) + ! for (12 - 0.5 * PBLH / L) >= 0 + ! + ! + ! NOTE: If the term (12 - 0.5 * PBLH / L) is negative, we cannot + ! compute sigma. We also cannot compute alpha, P_ft, and + ! P_it, which also depend on sigma. If this is the case, + ! then leave eta = 1 (as defined initially) and skip to the + ! next grid box. + ! + ! NOTE: Similarly, if sigma = 0, then this will incur a div-by-zero + ! in the formula for alpha below. Also leave eta = 1 and + ! skip ahead to the next grid box. + !--------------------------------------------------------------------- + term_1 = 12.0_hp - 0.5_hp * PBLH(I,J) / L + + IF ( term_1 < 0.0_hp ) CYCLE + + sigma = u_star_s(I,J) * term_1**ONE_THIRD + + IF ( .not. ABS( sigma ) > 0.0_hp ) CYCLE + + !--------------------------------------------------------------------- + ! Calculate alpha, the fluid threshold crossing fraction: + ! + ! alpha = (EXP( (u_ft**2 - u_it**2 - 2 * u_s * (u_ft - u_it)) / + ! (2 * sigma**2)) + 1)**(-1) + ! + ! NOTE: Use 1 / (EXP(...)) instead of (EXP(...)**(-1), as this + ! will avoid a computationally-expensive exponential term. + ! + ! NOTE: If the argument of EXP is large enough to result in a + ! floating-point overflow, leave eta = 1 (as originally + ! defined above) and skip to the next grid box. + !--------------------------------------------------------------------- + term_1 = u_ft**2 - u_it**2 - 2.0_hp * u_s * ( u_ft - u_it ) + term_2 = 2.0_hp * sigma**2 + term_3 = term_1 / term_2 + + IF ( term_3 > 700.0_hp ) CYCLE + + alpha = 1.0_hp / ( EXP( term_3 ) + 1.0_hp ) + + !--------------------------------------------------------------------- + ! Calculate the cumulative probability that instananeous soil + ! friction velocity does not exceed the wet fluid threshold + ! u_ft or the impact threshold u_it of P_ft or P_it + ! + ! P_ft = 0.5 * (1 + erf((u_ft - u_s) / (sqrt(2) * sigma))); + ! P_it = 0.5 * (1 + erf((u_it - u_s) / (sqrt(2) * sigma))) + ! + ! NOTE: Pull out the SQRT(2)*sigma term to avoid repeated computation + !--------------------------------------------------------------------- + term_1 = SQ_RT_2 * sigma + P_ft = 0.5_hp * ( 1.0_hp + ERF( ( u_ft - u_s ) / term_1 ) ) + P_it = 0.5_hp * ( 1.0_hp + ERF( ( u_it - u_s ) / term_1 ) ) + + !--------------------------------------------------------------------- + ! Calculate intermittency factor: + ! eta = 1 - P_ft + alpha * (P_ft - P_it) + !--------------------------------------------------------------------- + term_1 = 1.0_hp - P_ft + alpha * ( P_ft - P_it ) + + ! Only assign to eta if eta_temp is in the range 0..1 + ! Otherwise leave eta = 1 (as was initially assigned above) + IF ( term_1 > 0.0_hp .and. term_1 < 1.0_hp ) THEN + eta(I,J) = term_1 + ENDIF + + ENDDO + ENDDO + !$OMP END PARALLEL DO + + END SUBROUTINE CAL_INTERM_FACTOR +!EOC +!------------------------------------------------------------------------------ +! Harmonized Emissions Component (HEMCO) ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: CAL_DUSTL23M_EmisFlux +! +! !DESCRIPTION: Calculates DustL23M total emission flux [kg m-2 s-1] +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE CAL_DUSTL23M_EmisFlux( HcoState, ExtState, Inst, & + DUST_EMIS_FLUX, RC ) +! +! !INPUT/OUTPUT PARAMETERS: +! + TYPE(HCO_State), POINTER :: HcoState ! HEMCO state object + TYPE(Ext_State), POINTER :: ExtState ! Extension state object + TYPE(MyInst), POINTER :: Inst ! Specific instances of DustL23 +! +! !OUTPUT PARAMETERS: +! + ! Total dust emission flux [kg m-2 s-1] + REAL(hp), INTENT(OUT) :: DUST_EMIS_FLUX(HcoState%NX, HcoState%NY) + + ! Success or failure + INTEGER, INTENT(OUT) :: RC +! +! !REVISION HISTORY: +! 02 May 2024 - Dandan Zhang - Initial version +! See https://github.com/geoschem/hemco for complete history +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !DEFINED PARAMETERS: +! + ! empirical constants + REAL(hp), PARAMETER :: C_d0 = 4.4e-5_hp ! [unitless] + REAL(hp), PARAMETER :: C_e = 2.0_hp ! [unitless] + REAL(hp), PARAMETER :: C_kappa = 2.7_hp ! [unitless] + + ! other constants + REAL(hp), PARAMETER :: u_star_st0 = 0.16_hp ! [m s-1] +! +! !LOCAL VARIABLES: +! + ! Scalars and strings + INTEGER :: I, J + CHARACTER(LEN=255) :: Msg, SUBLOC + + ! Snow depth [m] + REAL(hp) :: snowdep(HcoState%NX, HcoState%NY) + + ! Fraction of snow cover [unitless] + REAL(hp) :: A_snow(HcoState%NX, HcoState%NY) + + ! Dry fluid thershold friction velocity [m s-1] + REAL(hp) :: u_star_ft0(HcoState%NX, HcoState%NY) + + ! Wet fluid thershold friction velocity [m s-1] + REAL(hp) :: u_star_ft(HcoState%NX, HcoState%NY) + + ! Dynamic fluid threshold friction velocity [m s-1] + REAL(hp) :: u_star_it(HcoState%NX, HcoState%NY) + + ! Standardized wet fluid threshold friction velocity [m s-1] + REAL(hp) :: u_star_st(HcoState%NX, HcoState%NY) + + ! The drag partitioning effects due to rocks [unitless] + REAL(hp) :: f_eff_r(HcoState%NX, HcoState%NY) + + ! The drag partitioning effects due to short vegetation [unitless] + REAL(hp) :: f_eff_v(HcoState%NX, HcoState%NY) + + ! The total drag partitioning effects due to rocks and + ! short vegetation [unitless] + REAL(hp) :: F_eff(HcoState%NX, HcoState%NY) + + ! Intermittency factor with values in [0,1] [unitless] + REAL(hp) :: eta(HcoState%NX, HcoState%NY) + + ! Total dust emission flux [kg m-2 s-1] + REAL(hp) :: DUST_EMIS_FLUX_Tmp + + ! surface air density [kg m-3] + REAL(hp) :: rho_a(HcoState%NX, HcoState%NY) + + ! Soil erodibility coefficient [unitless] + REAL(hp) :: C_d + + ! [unitless] + REAL(hp) :: f_bare + + ! Soil surface friction velocity [m s-1] + REAL(hp) :: u_star_s(HcoState%NX, HcoState%NY) + + ! Fragmentaion exponent [unitless] + REAL(hp) :: kappa + + ! Threshold friction velocity used [m s-1] + REAL(hp) :: u_star_t(HcoState%NX, HcoState%NY) + + ! 2-m temperature (proxy for surface temperature [K] + REAL(hp), POINTER :: T2M(:,:) + + ! Surface skin temperature [K] + REAL(hp), POINTER :: TSKIN(:,:) + + ! Surface pressure [Pa] + REAL(hp), POINTER :: PS(:,:) + + ! PBL height [m] + REAL(hp), POINTER :: PBLH(:,:) + + !======================================================================== + ! CAL_DUSTL23M_EmisFlux begins here! + !======================================================================== + + ! Initialize + RC = HCO_SUCCESS ! Success or failure? + DUST_EMIS_FLUX = 0.0_hp ! Dust emissions [kg/m2/s] + PS => HcoState%Grid%PSFC%Val ! Surface pressure [Pa] + PBLH => HcoState%Grid%PBLHEIGHT%Val ! PBL height [m] + T2M => ExtState%T2M%Arr%Val ! Proxy for surface temp [K] + TSKIN => ExtState%TSKIN%Arr%Val ! Surface skin temp [K] + + !------------------------------------------------------------------------ + ! Calculate air density & snow cover + !------------------------------------------------------------------------ + !$OMP PARALLEL DO & + !$OMP DEFAULT( SHARED )& + !$OMP PRIVATE( I, J )& + !$OMP COLLAPSE( 2 ) + DO J = 1, HcoState%NY + DO I = 1, HcoState%NX + + ! Air density [kg/m3] + rho_a(I,J) = PS(I,J) & + * ( HcoState%Phys%AIRMW * 1.0e-3_hp ) & + / ( HcoState%Phys%RSTARG * T2M(I,J) ) + + ! According to https://gmao.gsfc.nasa.gov/reanalysis/MERRA-2/FAQ/#Q2, + ! because snwomass is relative to the gridbox area, we use snowmass + ! instead of snow depth from the met field. + ! SNOWDEP = SNOMAS / 1000 * (1000 / 100) = SNOMAS / 100 + snowdep(I,J) = ExtState%SNOMAS%Arr%Val(I,J) / 100.0_hp + A_snow(I,J) = snowdep(I,J) / snowdep_thr + IF ( A_snow(I,J) > 1.0_hp .or. TSKIN(I,J) < T0 ) THEN + A_snow(I,J) = 1.0_hp + ENDIF + + ENDDO + ENDDO + !$OMP END PARALLEL DO + + !------------------------------------------------------------------------ + ! Calculate threshold friction velocity [m/s] + !------------------------------------------------------------------------ + SUBLOC = 'CAL_THR_FRIC_VEL' + CALL CAL_THR_FRIC_VEL( & + HcoState, rho_a, Inst%f_clay, Inst%bulk_den, & + Inst%poros, ExtState%GWETTOP%Arr%Val, u_star_ft0, u_star_ft, & + u_star_it, u_star_st, RC ) + + ! Trap errors + IF ( RC /= HCO_SUCCESS ) THEN + MSG = 'Error encountered in DustL23M @ ' // TRIM( SUBLOC ) + CALL HCO_ERROR( MSG, RC, THISLOC=SUBLOC ) + RETURN + ENDIF + + !------------------------------------------------------------------------ + ! Calculate drag partioning effects due to rocks and vegetation + !------------------------------------------------------------------------ + SUBLOC = 'CAL_DRAG_PART' + CALL CAL_DRAG_PART(& + HcoState, Inst%roughness_r, Inst%XLAI_t, Inst%A_bare, & + Inst%A_veg, f_eff_r, f_eff_v, F_eff, RC ) + + ! Trap errors + IF ( RC /= HCO_SUCCESS ) THEN + MSG = 'Error encountered in DustL23M @ ' // TRIM( SUBLOC ) + CALL HCO_ERROR( MSG, RC, THISLOC=SUBLOC ) + RETURN + ENDIF + + u_star_s = ExtState%USTAR%Arr%Val * F_eff + + !------------------------------------------------------------------------ + ! Calculate calculate intermittency factor due to turbulence + !------------------------------------------------------------------------ + SUBLOC = 'CAL_INTERM_FACTOR' + CALL CAL_INTERM_FACTOR( & + HcoState, u_star_ft, u_star_it, & + u_star_s, PBLH, rho_a, & + T2M, ExtState%USTAR%Arr%Val, ExtState%HFLUX%Arr%Val, & + eta, RC ) + + ! Trap errors + IF ( RC /= HCO_SUCCESS ) THEN + MSG = 'Error encountered in DustL23M @ ' // TRIM( SUBLOC ) + CALL HCO_ERROR( MSG, RC, THISLOC=SUBLOC ) + RETURN + ENDIF + + !------------------------------------------------------------------------ + ! Calculate dust emission flux + !------------------------------------------------------------------------ + + !$OMP PARALLEL DO & + !$OMP DEFAULT( SHARED )& + !$OMP PRIVATE( I, J, C_d, f_bare, kappa, DUST_EMIS_FLUX_Tmp )& + !$OMP COLLAPSE( 2 ) + DO J = 1, HcoState%NY + DO I = 1, HcoState%NX + + !--------------------------------------------------------------------- + ! Calculate C_d (soil erodibility coefficient) + !--------------------------------------------------------------------- + C_d = C_d0 * EXP (- C_e * (u_star_st(I,J) - u_star_st0) / u_star_st0 ) + + !--------------------------------------------------------------------- + ! Calculate f_bare (fraction of bare land) + ! = 0 (for LAI > LAI_thr) + ! = A_bare * (1 - A_snow) * (1 - LAI / LAI_thr) (for LAI <= LAI_thr) + !--------------------------------------------------------------------- + f_bare = 0.0_hp + IF ( Inst%XLAI_t(I,J) <= LAI_thr ) THEN + f_bare = Inst%A_bare(I,J) & + * ( 1.0_hp - A_snow(I,J) ) & + * ( 1.0_hp - Inst%XLAI_t(I,J) / LAI_thr ) + ENDIF + + !--------------------------------------------------------------------- + ! Calculate Kappa (fragmentation exponent) + !--------------------------------------------------------------------- + kappa = C_kappa * ( u_star_st(I,J) - u_star_st0 ) / u_star_st0 + + ! Cap value + IF ( kappa > 3.0_hp ) kappa = 3.0_hp + + !--------------------------------------------------------------------- + ! Calculate dust emission flux + !--------------------------------------------------------------------- + u_star_t(I,J) = u_star_it(I,J) + + DUST_EMIS_FLUX_Tmp = & + eta(I,J) * Inst%C_tune * & + Inst%C_sah(I,J) * C_d * & + f_bare * rho_a(I,J) * & + ( u_star_s(I,J)**2 - u_star_t(I,J)**2 ) / & + u_star_st(I,J) * & + ( ( u_star_s(I,J) / u_star_t(I,J) )**kappa ) + + ! Prevent negatives + IF ( DUST_EMIS_FLUX_Tmp < 0.0_hp .or. & + u_star_s(I,J) <= u_star_t(I,J) ) THEN + DUST_EMIS_FLUX_Tmp = 0.0_hp + ENDIF + + ! Require all inputs are defined, also use a small value instead of + ! 0 as the criterion as missing value will be filled with a very + ! small value in HEMCO, Remove the ELSE block for efficiency. + IF ( ( DUST_EMIS_FLUX_Tmp > 1.0e-15_hp ) .and. & + ( f_bare > 1.0e-15_hp ) .and. & + ( Inst%f_clay(I,J) > 1.0e-15_hp ) .and. & + ( Inst%bulk_den(I,J) > 1.0e-15_hp ) .and. & + ( Inst%poros(I,J) > 1.0e-15_hp ) .and. & + ( Inst%roughness_r(I,J) > 1.0e-15_hp ) ) THEN + DUST_EMIS_FLUX(I,J) = DUST_EMIS_FLUX_Tmp + ENDIF + + ENDDO + ENDDO + !$OMP END PARALLEL DO + + ! Cleanup & return + RC = HCO_SUCCESS + PBLH => NULL() + PS => NULL() + T2M => NULL() + TSKIN => NULL() + + END SUBROUTINE CAL_DUSTL23M_EmisFlux +!EOC +END MODULE HCOX_DustL23M_Mod diff --git a/src/Extensions/hcox_gc_POPs_mod.F90 b/src/Extensions/hcox_gc_POPs_mod.F90 index ca75d696..6184625c 100644 --- a/src/Extensions/hcox_gc_POPs_mod.F90 +++ b/src/Extensions/hcox_gc_POPs_mod.F90 @@ -649,7 +649,7 @@ SUBROUTINE SOILEMISPOP( POP_SURF, F_OC_SOIL, HcoState, ExtState, Inst ) ( IS_ICE (I,J,ExtState) ) ) IS_SNOW_OR_ICE = ( ( IS_ICE (I,J,ExtState) ) .OR. & ( IS_LAND(I,J,ExtState) .AND. & - ExtState%SNOWHGT%Arr%Val(I,J) > 10e+0_hp ) ) + ExtState%SNOMAS%Arr%Val(I,J) > 10e+0_hp ) ) ! Do soils routine only if we are on land that is not covered with ! snow or ice @@ -968,7 +968,7 @@ SUBROUTINE LAKEEMISPOP( POP_SURF, HcoState, ExtState, Inst ) ( IS_ICE (I,J,ExtState) ) ) IS_SNOW_OR_ICE = ( ( IS_ICE (I,J,ExtState) ) .OR. & ( IS_LAND(I,J,ExtState) .AND. & - ExtState%SNOWHGT%Arr%Val(I,J) > 10e+0_hp ) ) + ExtState%SNOMAS%Arr%Val(I,J) > 10e+0_hp ) ) ! Do soils routine only if we are on land that is not covered with ! snow or ice @@ -1306,7 +1306,7 @@ SUBROUTINE VEGEMISPOP( POP_SURF, HcoState, ExtState, Inst ) (IS_ICE (I,J,ExtState)) ) IS_SNOW_OR_ICE = ( (IS_ICE (I,J,ExtState)) .OR. & (IS_LAND(I,J,ExtState) .AND. & - ExtState%SNOWHGT%Arr%Val(I,J) > 10e+0_hp ) ) + ExtState%SNOMAS%Arr%Val(I,J) > 10e+0_hp ) ) ! Do soils routine only if we are on land that is not covered with ! snow or ice @@ -1739,7 +1739,7 @@ SUBROUTINE HCOX_GC_POPs_Init( HcoState, ExtName, ExtState, RC ) ExtState%FRAC_OF_PBL%DoUse = .TRUE. ExtState%LAI%DoUse = .TRUE. ExtState%PSC2_WET%DoUse = .TRUE. - ExtState%SNOWHGT%DoUse = .TRUE. + ExtState%SNOMAS%DoUse = .TRUE. ExtState%TK%DoUse = .TRUE. ExtState%TSKIN%DoUse = .TRUE. ExtState%U10M%DoUse = .TRUE. diff --git a/src/Extensions/hcox_state_mod.F90 b/src/Extensions/hcox_state_mod.F90 index 0375f4b0..e1a63ed9 100644 --- a/src/Extensions/hcox_state_mod.F90 +++ b/src/Extensions/hcox_state_mod.F90 @@ -99,6 +99,7 @@ MODULE HCOX_STATE_MOD ! switch in subroutine ExtStateInit below! !---------------------------------------------------------------------- INTEGER :: Custom ! Customizable ext. + INTEGER :: DustL23M ! DustL23M dust model INTEGER :: DustDead ! DEAD dust model INTEGER :: DustGinoux ! Ginoux dust emissions INTEGER :: DustAlk ! Dust alkalinity @@ -129,12 +130,15 @@ MODULE HCOX_STATE_MOD TYPE(ExtDat_2R), POINTER :: U10M ! E/W 10m wind speed [m/s] TYPE(ExtDat_2R), POINTER :: V10M ! N/S 10m wind speed [m/s] TYPE(ExtDat_2R), POINTER :: ALBD ! Surface albedo [-] - TYPE(ExtDat_2R), POINTER :: T2M ! 2m Sfce temperature [K] + TYPE(ExtDat_2R), POINTER :: T2M ! T at 2m above sfc [K]; Used as + ! a proxy for GMAO surface temp. + TYPE(ExtDat_2R), POINTER :: TS ! Surface temperature [K]; Keep + ! in case non-GEOS met needs it. TYPE(ExtDat_2R), POINTER :: TSKIN ! Surface skin temperature [K] TYPE(ExtDat_2R), POINTER :: TSOIL1 ! Soil temperature, layer 1 [K] TYPE(ExtDat_2R), POINTER :: GWETROOT ! Root soil wetness [1] - TYPE(ExtDat_2R), POINTER :: GWETTOP ! Top soil moisture [-] - TYPE(ExtDat_2R), POINTER :: SNOWHGT ! Snow height [mm H2O = kg H2O/m2] + TYPE(ExtDat_2R), POINTER :: GWETTOP ! Top soil moisture [1] + TYPE(ExtDat_2R), POINTER :: SNOMAS ! Snow mass [mm H2O = kg H2O/m2] TYPE(ExtDat_2R), POINTER :: SNODP ! Snow depth [m ] TYPE(ExtDat_2R), POINTER :: SNICE ! Fraction of snow/ice [1] TYPE(ExtDat_2R), POINTER :: USTAR ! Friction velocity [m/s] @@ -144,6 +148,7 @@ MODULE HCOX_STATE_MOD TYPE(ExtDat_2R), POINTER :: SZAFACT ! current SZA/total daily SZA TYPE(ExtDat_2R), POINTER :: PARDR ! direct photsyn radiation [W/m2] TYPE(ExtDat_2R), POINTER :: PARDF ! diffuse photsyn radiation [W/m2] + TYPE(ExtDat_2R), POINTER :: HFLUX ! Sensible height flux due to turbulence [W m-2] TYPE(ExtDat_2R), POINTER :: PSC2_WET ! Interpolated sfc pressure [hPa] TYPE(ExtDat_2R), POINTER :: RADSWG ! surface radiation [W/m2] TYPE(ExtDat_2R), POINTER :: FRCLND ! Olson land fraction [-] @@ -278,7 +283,8 @@ SUBROUTINE ExtStateInit( ExtState, RC ) ! ! !LOCAL VARIABLES: ! - CHARACTER(LEN=255) :: LOC + CHARACTER(LEN=255) :: LOC, MSG + !====================================================================== ! ExtStateInit begins here !====================================================================== @@ -291,6 +297,7 @@ SUBROUTINE ExtStateInit( ExtState, RC ) ! Set all switches to -1 !----------------------------------------------------------------------- ExtState%Custom = -1 + ExtState%DustL23M = -1 ExtState%DustDead = -1 ExtState%DustGinoux = -1 ExtState%DustAlk = -1 @@ -328,316 +335,382 @@ SUBROUTINE ExtStateInit( ExtState, RC ) !----------------------------------------------------------------------- CALL ExtDat_Init( ExtState%U10M, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 0', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%U10M' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%V10M, RC ) + CALL ExtDat_Init( ExtState%V10M, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 1', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%V10M' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%ALBD, RC ) + CALL ExtDat_Init( ExtState%ALBD, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 2', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%ALBD' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%T2M, RC ) + CALL ExtDat_Init( ExtState%T2M, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 4', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%T2M' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%TSKIN, RC ) + CALL ExtDat_Init( ExtState%TS, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 5', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%TS' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%TSOIL1, RC ) + CALL ExtDat_Init( ExtState%TSKIN, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'Initializing TSOIL1', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%TSKIN' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%GWETROOT, RC ) + CALL ExtDat_Init( ExtState%TSOIL1, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 6', RC, THISLOC=LOC ) + MSG = 'Could not allocate ExtState%TSOIL1' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) RETURN ENDIF - CALL ExtDat_Init ( ExtState%GWETTOP, RC ) + CALL ExtDat_Init( ExtState%GWETROOT, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 7', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%GWETROOT' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%SNOWHGT, RC ) + CALL ExtDat_Init( ExtState%GWETTOP, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 8', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%GWETTOP' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%SNODP, RC ) + CALL ExtDat_Init( ExtState%SNOMAS, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 9', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%SNOMAS' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%SNICE, RC ) + CALL ExtDat_Init( ExtState%SNODP, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 10', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%SNODP' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%USTAR, RC ) + CALL ExtDat_Init( ExtState%SNICE, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 11', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%SNICE' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%Z0, RC ) + CALL ExtDat_Init( ExtState%USTAR, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 12', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%USTAR' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%TROPP, RC ) + CALL ExtDat_Init( ExtState%Z0, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 13', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%Z0' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%SUNCOS, RC ) + CALL ExtDat_Init( ExtState%TROPP, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 14', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%TROPP' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%SZAFACT, RC ) + CALL ExtDat_Init( ExtState%SUNCOS, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 15', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%SUNCOS' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%PARDR, RC ) + CALL ExtDat_Init( ExtState%SZAFACT, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 16', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%SZAFACT' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%PARDF, RC ) + CALL ExtDat_Init( ExtState%PARDR, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 17', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%PARDR' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%PSC2_WET, RC ) + CALL ExtDat_Init( ExtState%HFLUX, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 18', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%HFLUX' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%RADSWG, RC ) + CALL ExtDat_Init( ExtState%PARDF, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 19', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%PARDF' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%FRCLND, RC ) + CALL ExtDat_Init( ExtState%PSC2_WET, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 20', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%PSC2_WET' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%FRLAND, RC ) + CALL ExtDat_Init( ExtState%RADSWG, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 21', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%RADSWG' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%FROCEAN, RC ) + CALL ExtDat_Init( ExtState%FRCLND, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 22', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%FRCLND' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%FRSEAICE, RC ) + CALL ExtDat_Init( ExtState%FRLAND, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 23', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%FRLAND' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%QV2M, RC ) + CALL ExtDat_Init( ExtState%FROCEAN, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 24', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%FROCEAN' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN + ENDIF + + CALL ExtDat_Init( ExtState%FRSEAICE, RC ) + IF ( RC /= HCO_SUCCESS ) THEN + MSG = 'Could not allocate ExtState%FRSEAICE' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN + ENDIF + + CALL ExtDat_Init( ExtState%QV2M, RC ) + IF ( RC /= HCO_SUCCESS ) THEN + MSG = 'Could not allocate ExtState%QV2M' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF CALL ExtDat_Init ( ExtState%FRLAKE, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 25', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%FRLAKE' + CALL HCO_ERROR( 'ERROR 25', RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%FRLANDIC, RC ) + CALL ExtDat_Init( ExtState%FRLANDIC, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 26', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%FRLANDIC' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%CLDFRC, RC ) + CALL ExtDat_Init( ExtState%CLDFRC, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 27', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%CLDFRC' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%LAI, RC ) + CALL ExtDat_Init( ExtState%LAI, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 28', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%LAI' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%CHLR, RC ) + CALL ExtDat_Init( ExtState%CHLR, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 29', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%CHLR' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%FLASH_DENS, RC ) + CALL ExtDat_Init( ExtState%FLASH_DENS, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 30', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%FLASH_DENS' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%CONV_DEPTH, RC ) + CALL ExtDat_Init( ExtState%CONV_DEPTH, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 31', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%CONV_DEPTH' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%JNO2, RC ) + CALL ExtDat_Init( ExtState%JNO2, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 32', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%JNO2' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%JOH, RC ) + CALL ExtDat_Init( ExtState%JOH, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 33', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%JOH' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%CNV_MFC, RC ) + CALL ExtDat_Init( ExtState%CNV_MFC, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 34', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%CNV_MFC' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF ExtState%PBL_MAX => NULL() - CALL ExtDat_Init ( ExtState%FRAC_OF_PBL, RC ) + CALL ExtDat_Init( ExtState%FRAC_OF_PBL, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 35', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%FRAC_OF_PBL' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%SPHU, RC ) + CALL ExtDat_Init( ExtState%SPHU, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 36', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%SPHU' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%TK, RC ) + CALL ExtDat_Init( ExtState%TK, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 37', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%TK' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%AIR, RC ) + CALL ExtDat_Init( ExtState%AIR, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 38', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%AIR' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%AIRVOL, RC ) + CALL ExtDat_Init( ExtState%AIRVOL, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 39', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%AIRVOL' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%AIRDEN, RC ) + CALL ExtDat_Init( ExtState%AIRDEN, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 40', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%AIRDEN' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%O3, RC ) + CALL ExtDat_Init( ExtState%O3, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 41', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%O3' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%NO, RC ) + CALL ExtDat_Init( ExtState%NO, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 42', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%NO' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%NO2, RC ) + CALL ExtDat_Init( ExtState%NO2, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 43', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%NO2' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%HNO3, RC ) + CALL ExtDat_Init( ExtState%HNO3, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 44', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%HNO3' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%POPG, RC ) + CALL ExtDat_Init( ExtState%POPG, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 45', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%POPG' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%DRY_TOTN, RC ) + CALL ExtDat_Init( ExtState%DRY_TOTN, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 46', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%DRY_TOTN' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%WET_TOTN, RC ) + CALL ExtDat_Init( ExtState%WET_TOTN, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 47', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%WET_TOTN' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%BYNCY, RC ) + CALL ExtDat_Init( ExtState%BYNCY, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 48', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%BYNCY' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%LFR, RC ) + CALL ExtDat_Init( ExtState%LFR, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 49', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%LFR' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%CNV_FRC, RC ) + CALL ExtDat_Init( ExtState%CNV_FRC, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 50', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%CNV_FRC' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF - CALL ExtDat_Init ( ExtState%TropLev, RC ) + CALL ExtDat_Init( ExtState%TropLev, RC ) IF ( RC /= HCO_SUCCESS ) THEN - CALL HCO_ERROR( 'ERROR 51', RC, THISLOC=LOC ) - RETURN + MSG = 'Could not allocate ExtState%TropLev' + CALL HCO_ERROR( MSG, RC, THISLOC=LOC ) + RETURN ENDIF ! Return w/ success @@ -682,11 +755,12 @@ SUBROUTINE ExtStateFinal( ExtState ) CALL ExtDat_Cleanup( ExtState%V10M ) CALL ExtDat_Cleanup( ExtState%ALBD ) CALL ExtDat_Cleanup( ExtState%T2M ) + CALL ExtDat_Cleanup( ExtState%TS ) CALL ExtDat_Cleanup( ExtState%TSKIN ) CALL ExtDat_Cleanup( ExtState%TSOIL1 ) CALL ExtDat_Cleanup( ExtState%GWETROOT ) CALL ExtDat_Cleanup( ExtState%GWETTOP ) - CALL ExtDat_Cleanup( ExtState%SNOWHGT ) + CALL ExtDat_Cleanup( ExtState%SNOMAS ) CALL ExtDat_Cleanup( ExtState%SNODP ) CALL ExtDat_Cleanup( ExtState%SNICE ) CALL ExtDat_Cleanup( ExtState%USTAR ) @@ -696,6 +770,7 @@ SUBROUTINE ExtStateFinal( ExtState ) CALL ExtDat_Cleanup( ExtState%SZAFACT ) CALL ExtDat_Cleanup( ExtState%PARDR ) CALL ExtDat_Cleanup( ExtState%PARDF ) + CALL ExtDat_Cleanup( ExtState%HFLUX ) CALL ExtDat_Cleanup( ExtState%PSC2_WET ) CALL ExtDat_Cleanup( ExtState%RADSWG ) CALL ExtDat_Cleanup( ExtState%FRCLND ) diff --git a/src/Extensions/hcox_tomas_dustdead_mod.F b/src/Extensions/hcox_tomas_dustdead_mod.F index a18f9005..9e7c1cdd 100644 --- a/src/Extensions/hcox_tomas_dustdead_mod.F +++ b/src/Extensions/hcox_tomas_dustdead_mod.F @@ -446,9 +446,9 @@ SUBROUTINE HCOX_TOMAS_DustDead_Run( ExtState, HcoState, RC ) ! Ocean is 0; land is 1; ice is 2 ORO(I) = REAL(OROGRAPHY(I,J),KIND=8) - ! Snow [m H2O]. SNOWHGT is in kg H2O/m2, which is equivalent to + ! Snow [m H2O]. SNOMAS is in kg H2O/m2, which is equivalent to ! mm H2O. Convert to m H2O here. - SNW_HGT_LQD(I) = ExtState%SNOWHGT%Arr%Val(I,J) / 1000.d0 + SNW_HGT_LQD(I) = ExtState%SNOMAS%Arr%Val(I,J) / 1000.d0 ! Dust tracer and increments DSRC(I,:) = 0.0d0 @@ -1094,7 +1094,7 @@ SUBROUTINE HCOX_TOMAS_DustDead_Init( HcoState, ExtName, ExtState, ExtState%V10M%DoUse = .TRUE. ExtState%T2M%DoUse = .TRUE. ExtState%GWETTOP%DoUse = .TRUE. - ExtState%SNOWHGT%DoUse = .TRUE. + ExtState%SNOMAS%DoUse = .TRUE. ExtState%USTAR%DoUse = .TRUE. ExtState%Z0%DoUse = .TRUE. ExtState%FRLAND%DoUse = .TRUE. diff --git a/src/Interfaces/Standalone/hcoi_standalone_mod.F90 b/src/Interfaces/Standalone/hcoi_standalone_mod.F90 index c9764760..bbf54c81 100644 --- a/src/Interfaces/Standalone/hcoi_standalone_mod.F90 +++ b/src/Interfaces/Standalone/hcoi_standalone_mod.F90 @@ -475,12 +475,14 @@ SUBROUTINE HCOI_SA_Run( RC ) ! ! !USES: ! - USE HCO_FluxArr_Mod, ONLY : HCO_FluxarrReset - USE HCO_Clock_Mod, ONLY : HcoClock_Set - USE HCO_Clock_Mod, ONLY : HcoClock_Get - USE HCO_Clock_Mod, ONLY : HcoClock_Increase - USE HCO_Driver_Mod, ONLY : HCO_RUN - USE HCOX_Driver_Mod, ONLY : HCOX_RUN + USE HCO_FluxArr_Mod, ONLY : HCO_FluxarrReset + USE HCO_Calc_Mod, ONLY : HCO_EvalFld + USE HCO_Clock_Mod, ONLY : HcoClock_Set + USE HCO_Clock_Mod, ONLY : HcoClock_Get + USE HCO_Clock_Mod, ONLY : HcoClock_Increase + USE HCO_Driver_Mod, ONLY : HCO_Run + USE HCO_GeoTools_Mod, ONLY : HCO_SetPBLm + USE HCOX_Driver_Mod, ONLY : HCOX_Run ! ! !INPUT/OUTPUT PARAMETERS: ! @@ -620,6 +622,21 @@ SUBROUTINE HCOI_SA_Run( RC ) IF ( notDryRun ) THEN + ! Evaluate the PBL height in meters from the meteorology here, + ! If meteorology is turned off, set to a default height of 1 km. + ! This is needed so that PBL height will evolve with time. + ! (skip for dry-run) + CALL HCO_SetPBLm( HcoState = HcoState, & + FldName = 'PBLH', & + PBLM = HcoState%Grid%PBLHEIGHT%Val, & + DefVal = 1000.0_hp, & + RC = RC ) + IF ( RC /= HCO_SUCCESS ) THEN + ErrMsg = 'Error encountered in routine "HCO_SetPBLm"!' + CALL HCO_Error( ErrMsg, RC, ThisLoc ) + RETURN + ENDIF + ! Set ExtState fields (skip for dry-run) CALL ExtState_SetFields( HcoState, ExtState, RC ) IF ( RC /= HCO_SUCCESS ) THEN @@ -1531,7 +1548,7 @@ SUBROUTINE Set_Grid( HcoState, RC ) ! Define a default PBL height CALL HCO_SetPBLm( HcoState = HcoState, & - FldName ='PBL_HEIGHT', & + FldName ='PBLH', & PBLM = HcoState%Grid%PBLHEIGHT%Val, & DefVal = 1000.0_hp, & RC = RC ) @@ -1731,7 +1748,7 @@ SUBROUTINE Register_Species( HcoState, RC ) ENDDO !I - CALL HCO_MSG('',SEP1='-') + CALL HCO_MSG(' ',SEP1='-') ! Return w/ success RC = HCO_SUCCESS @@ -2169,11 +2186,11 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) ! (2) Not all extension fields are used for a given simulation type !------------------------------------------------------------------------ - !%%%%% 10-m winds %%%%% + !%%%%% 10-m wind (zonal) %%%%% IF ( ExtState%U10M%DoUse ) THEN Name = 'U10M' CALL ExtDat_Set( HcoState, ExtState%U10M, & - TRIM( Name ), RC, FIRST=FIRST ) + TRIM( Name ), RC, FIRST=FIRST ) IF ( RC /= HCO_SUCCESS ) THEN ErrMsg = 'Could not find quantity "' // TRIM( Name ) // & '" for the HEMCO standalone simulation!' @@ -2183,10 +2200,11 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) ENDIF ENDIF + !%%%%% 10-m wind (meridional) %%%%% IF ( ExtState%V10M%DoUse ) THEN Name = 'V10M' CALL ExtDat_Set( HcoState, ExtState%V10M, & - TRIM( Name ), RC, FIRST=FIRST ) + TRIM( Name ), RC, FIRST=FIRST ) IF ( RC /= HCO_SUCCESS ) THEN ErrMsg = 'Could not find quantity "' // TRIM( Name ) // & '" for the HEMCO standalone simulation!' @@ -2200,7 +2218,7 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) IF ( ExtState%ALBD%DoUse ) THEN Name = 'ALBEDO' CALL ExtDat_Set( HcoState, ExtState%ALBD, & - TRIM( Name ), RC, FIRST=FIRST ) + TRIM( Name ), RC, FIRST=FIRST ) IF ( RC /= HCO_SUCCESS ) THEN ErrMsg = 'Could not find quantity "' // TRIM( Name ) // & '" for the HEMCO standalone simulation!' @@ -2214,7 +2232,21 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) IF ( ExtState%T2M%DoUse ) THEN Name = 'T2M' CALL ExtDat_Set( HcoState, ExtState%T2M, & - TRIM( Name ), RC, FIRST=FIRST ) + TRIM( Name ), RC, FIRST=FIRST ) + IF ( RC /= HCO_SUCCESS ) THEN + ErrMsg = 'Could not find quantity "' // TRIM( Name ) // & + '" for the HEMCO standalone simulation!' + CALL HCO_Error( ErrMsg, RC, ThisLoc ) + CALL HCO_Leave( HcoState%Config%Err, RC ) + RETURN + ENDIF + ENDIF + + !%%%%% Surface temperature %%%%% + IF ( ExtState%TS%DoUse ) THEN + Name = 'TS' + CALL ExtDat_Set( HcoState, ExtState%TS, & + TRIM( Name ), RC, FIRST=FIRST ) IF ( RC /= HCO_SUCCESS ) THEN ErrMsg = 'Could not find quantity "' // TRIM( Name ) // & '" for the HEMCO standalone simulation!' @@ -2228,7 +2260,7 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) IF ( ExtState%TSKIN%DoUse ) THEN Name = 'TS' CALL ExtDat_Set( HcoState, ExtState%TSKIN, & - TRIM( Name ), RC, FIRST=FIRST ) + TRIM( Name ), RC, FIRST=FIRST ) IF ( RC /= HCO_SUCCESS ) THEN ErrMsg = 'Could not find quantity "' // TRIM( Name ) // & '" for the HEMCO standalone simulation!' @@ -2242,7 +2274,7 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) IF ( ExtState%TSOIL1%DoUse ) THEN Name = 'TSOIL1' CALL ExtDat_Set( HcoState, ExtState%TSOIL1, & - TRIM( Name ), RC, FIRST=FIRST ) + TRIM( Name ), RC, FIRST=FIRST ) IF ( RC /= HCO_SUCCESS ) THEN ErrMsg = 'Could not find quantity "' // TRIM( Name ) // & '" for the HEMCO standalone simulation!' @@ -2252,11 +2284,11 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) ENDIF ENDIF - !%%%%% Soil moisture %%%%% + !%%%%% Soil moisture (@ roots) %%%%% IF ( ExtState%GWETROOT%DoUse ) THEN Name = 'GWETROOT' CALL ExtDat_Set( HcoState, ExtState%GWETROOT, & - TRIM( Name ), RC, FIRST=FIRST ) + TRIM( Name ), RC, FIRST=FIRST ) IF ( RC /= HCO_SUCCESS ) THEN ErrMsg = 'Could not find quantity "' // TRIM( Name ) // & '" for the HEMCO standalone simulation!' @@ -2266,10 +2298,11 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) ENDIF ENDIF + !%%%%% Soil moisture (@ surface) %%%%% IF ( ExtState%GWETTOP%DoUse ) THEN Name = 'GWETTOP' CALL ExtDat_Set( HcoState, ExtState%GWETTOP, & - TRIM( Name ), RC, FIRST=FIRST ) + TRIM( Name ), RC, FIRST=FIRST ) IF ( RC /= HCO_SUCCESS ) THEN ErrMsg = 'Could not find quantity "' // TRIM( Name ) // & '" for the HEMCO standalone simulation!' @@ -2279,24 +2312,25 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) ENDIF ENDIF - !%%%%% Snow fields %%%%% - IF ( ExtState%SNOWHGT%DoUse ) THEN + !%%%%% Total snow storage (land) %%%%% + IF ( ExtState%SNOMAS%DoUse ) THEN Name = 'SNOMAS' - CALL ExtDat_Set( HcoState, ExtState%SNOWHGT, & - TRIM( Name ), RC, FIRST=FIRST ) + CALL ExtDat_Set( HcoState, ExtState%SNOMAS, & + TRIM( Name ), RC, FIRST=FIRST ) IF ( RC /= HCO_SUCCESS ) THEN - ErrMsg = 'Could not find quantity "' // TRIM( Name ) // & - '" for the HEMCO standalone simulation!' + ErrMsg = 'Could not find quantity "SNOMAS" (aka "SNOMAS") ' // & + 'for the HEMCO standalone simulation!' CALL HCO_Error( ErrMsg, RC, ThisLoc ) CALL HCO_Leave( HcoState%Config%Err, RC ) RETURN ENDIF ENDIF + !%%%%% Snow depth %%%%% IF ( ExtState%SNODP%DoUse ) THEN Name = 'SNODP' CALL ExtDat_Set( HcoState, ExtState%SNODP, & - TRIM( Name ), RC, FIRST=FIRST ) + TRIM( Name ), RC, FIRST=FIRST ) IF ( RC /= HCO_SUCCESS ) THEN ErrMsg = 'Could not find quantity "' // TRIM( Name ) // & '" for the HEMCO standalone simulation!' @@ -2310,7 +2344,21 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) IF ( ExtState%USTAR%DoUse ) THEN Name = 'USTAR' CALL ExtDat_Set( HcoState, ExtState%USTAR, & - TRIM( Name ), RC, FIRST=FIRST ) + TRIM( Name ), RC, FIRST=FIRST ) + IF ( RC /= HCO_SUCCESS ) THEN + ErrMsg = 'Could not find quantity "' // TRIM( Name ) // & + '" for the HEMCO standalone simulation!' + CALL HCO_Error( ErrMsg, RC, ThisLoc ) + CALL HCO_Leave( HcoState%Config%Err, RC ) + RETURN + ENDIF + ENDIF + + !%%%%% Sensible heat flux %%%%% + IF ( ExtState%HFLUX%DoUse ) THEN + Name = 'HFLUX' + CALL ExtDat_Set( HcoState, ExtState%HFLUX, & + TRIM( Name ), RC, FIRST=FIRST ) IF ( RC /= HCO_SUCCESS ) THEN ErrMsg = 'Could not find quantity "' // TRIM( Name ) // & '" for the HEMCO standalone simulation!' @@ -2324,7 +2372,7 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) IF ( ExtState%Z0%DoUse ) THEN Name = 'Z0M' CALL ExtDat_Set( HcoState, ExtState%Z0, & - TRIM( Name ), RC, FIRST=FIRST ) + TRIM( Name ), RC, FIRST=FIRST ) IF ( RC /= HCO_SUCCESS ) THEN ErrMsg = 'Could not find quantity "' // TRIM( Name ) // & '" for the HEMCO standalone simulation!' @@ -2338,7 +2386,7 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) IF ( ExtState%TROPP%DoUse ) THEN Name = 'TROPPT' CALL ExtDat_Set( HcoState, ExtState%TROPP, & - TRIM( Name ), RC, FIRST=FIRST ) + TRIM( Name ), RC, FIRST=FIRST ) IF ( RC /= HCO_SUCCESS ) THEN ErrMsg = 'Could not find quantity "' // TRIM( Name ) // & '" for the HEMCO standalone simulation!' @@ -2348,11 +2396,11 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) ENDIF ENDIF - !%%%%% PAR direct and diffuse %%%%% + !%%%%% PAR direct %%%%% IF ( ExtState%PARDR%DoUse ) THEN Name = 'PARDR' CALL ExtDat_Set( HcoState, ExtState%PARDR, & - TRIM( Name ), RC, FIRST=FIRST ) + TRIM( Name ), RC, FIRST=FIRST ) IF ( RC /= HCO_SUCCESS ) THEN ErrMsg = 'Could not find quantity "' // TRIM( Name ) // & '" for the HEMCO standalone simulation!' @@ -2362,10 +2410,11 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) ENDIF ENDIF + !%%%%% PAR diffuse %%%%% IF ( ExtState%PARDF%DoUse ) THEN Name = 'PARDF' CALL ExtDat_Set( HcoState, ExtState%PARDF, & - TRIM( Name ), RC, FIRST=FIRST ) + TRIM( Name ), RC, FIRST=FIRST ) IF ( RC /= HCO_SUCCESS ) THEN ErrMsg = 'Could not find quantity "' // TRIM( Name ) // & '" for the HEMCO standalone simulation!' @@ -2375,10 +2424,11 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) ENDIF ENDIF + !%%%%% Surface incoming shortwave flux %%%%% IF ( ExtState%RADSWG%DoUse ) THEN Name = 'SWGDN' CALL ExtDat_Set( HcoState, ExtState%RADSWG, & - TRIM( Name ), RC, FIRST=FIRST ) + TRIM( Name ), RC, FIRST=FIRST ) IF ( RC /= HCO_SUCCESS ) THEN ErrMsg = 'Could not find quantity "' // TRIM( Name ) // & '" for the HEMCO standalone simulation!' @@ -2392,7 +2442,7 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) IF ( ExtState%CLDFRC%DoUse ) THEN Name = 'CLDTOT' CALL ExtDat_Set( HcoState, ExtState%CLDFRC, & - TRIM( Name ), RC, FIRST=FIRST ) + TRIM( Name ), RC, FIRST=FIRST ) IF ( RC /= HCO_SUCCESS ) THEN ErrMsg = 'Could not find quantity "' // TRIM( Name ) // & '" for the HEMCO standalone simulation!' @@ -2406,7 +2456,7 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) IF ( ExtState%LAI%DoUse ) THEN Name = 'LAI' CALL ExtDat_Set( HcoState, ExtState%LAI, & - TRIM( Name ), RC, FIRST=FIRST ) + TRIM( Name ), RC, FIRST=FIRST ) IF ( RC /= HCO_SUCCESS ) THEN ErrMsg = 'Could not find quantity "' // TRIM( Name ) // & '" for the HEMCO standalone simulation!' @@ -2420,7 +2470,7 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) IF ( ExtState%FLASH_DENS%DoUse ) THEN Name = 'FLASH_DENS' CALL ExtDat_Set( HcoState, ExtState%FLASH_DENS, & - TRIM( Name ), RC, FIRST=FIRST ) + TRIM( Name ), RC, FIRST=FIRST ) IF ( RC /= HCO_SUCCESS ) THEN ErrMsg = 'Could not find quantity "' // TRIM( Name ) // & '" for the HEMCO standalone simulation!' @@ -2434,7 +2484,7 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) IF ( ExtState%CONV_DEPTH%DoUse ) THEN Name = 'CONV_DEPTH' CALL ExtDat_Set( HcoState, ExtState%CONV_DEPTH, & - TRIM( Name ), RC, FIRST=FIRST ) + TRIM( Name ), RC, FIRST=FIRST ) IF ( RC /= HCO_SUCCESS ) THEN ErrMsg = 'Could not find quantity "' // TRIM( Name ) // & '" for the HEMCO standalone simulation!' @@ -2448,7 +2498,7 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) IF ( ExtState%FRCLND%DoUse ) THEN Name = 'FRCLND' CALL ExtDat_Set( HcoState, ExtState%FRCLND, & - TRIM( Name ), RC, FIRST=FIRST ) + TRIM( Name ), RC, FIRST=FIRST ) IF ( RC /= HCO_SUCCESS ) THEN ErrMsg = 'Could not find quantity "' // TRIM( Name ) // & '" for the HEMCO standalone simulation!' @@ -2458,10 +2508,11 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) ENDIF ENDIF + !%%%%%% Land fraction %%%%% IF ( ExtState%FRLAND%DoUse ) THEN Name = 'FRLAND' CALL ExtDat_Set( HcoState, ExtState%FRLAND, & - TRIM( Name ), RC, FIRST=FIRST ) + TRIM( Name ), RC, FIRST=FIRST ) IF ( RC /= HCO_SUCCESS ) THEN ErrMsg = 'Could not find quantity "' // TRIM( Name ) // & '" for the HEMCO standalone simulation!' @@ -2471,10 +2522,11 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) ENDIF ENDIF + !%%%%% Ocean fraction %%%%% IF ( ExtState%FROCEAN%DoUse ) THEN Name = 'FROCEAN' CALL ExtDat_Set( HcoState, ExtState%FROCEAN, & - TRIM( Name ), RC, FIRST=FIRST ) + TRIM( Name ), RC, FIRST=FIRST ) IF ( RC /= HCO_SUCCESS ) THEN ErrMsg = 'Could not find quantity "' // TRIM( Name ) // & '" for the HEMCO standalone simulation!' @@ -2484,10 +2536,11 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) ENDIF ENDIF + !%%%%% Lake fraction %%%%% IF ( ExtState%FRLAKE%DoUse ) THEN Name = 'FRLAKE' CALL ExtDat_Set( HcoState, ExtState%FRLAKE, & - TRIM( Name ), RC, FIRST=FIRST ) + TRIM( Name ), RC, FIRST=FIRST ) IF ( RC /= HCO_SUCCESS ) THEN ErrMsg = 'Could not find quantity "' // TRIM( Name ) // & '" for the HEMCO standalone simulation!' @@ -2497,10 +2550,11 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) ENDIF ENDIF + !%%%%% Land ice fraction %%%%% IF ( ExtState%FRLANDIC%DoUse ) THEN Name = 'FRLANDIC' CALL ExtDat_Set( HcoState, ExtState%FRLANDIC, & - TRIM( Name ), RC, FIRST=FIRST ) + TRIM( Name ), RC, FIRST=FIRST ) IF ( RC /= HCO_SUCCESS ) THEN ErrMsg = 'Could not find quantity "' // TRIM( Name ) // & '" for the HEMCO standalone simulation!' @@ -2514,7 +2568,7 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) IF ( ExtState%FRSEAICE%DoUse ) THEN Name = 'FRSEAICE' CALL ExtDat_Set( HcoState, ExtState%FRSEAICE, & - TRIM( Name ), RC, FIRST=FIRST ) + TRIM( Name ), RC, FIRST=FIRST ) IF ( RC /= HCO_SUCCESS ) THEN ErrMsg = 'Could not find quantity "' // TRIM( Name ) // & '" for the HEMCO standalone simulation!' @@ -2528,7 +2582,7 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) IF ( ExtState%QV2M%DoUse ) THEN Name = 'QV2M' CALL ExtDat_Set( HcoState, ExtState%QV2M, & - TRIM( Name ), RC, FIRST=FIRST ) + TRIM( Name ), RC, FIRST=FIRST ) IF ( RC /= HCO_SUCCESS ) THEN ErrMsg = 'Could not find quantity "' // TRIM( Name ) // & '" for the HEMCO standalone simulation!' @@ -2542,7 +2596,7 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) IF ( ExtState%SZAFACT%DoUse ) THEN Name = 'SZAFACT' CALL ExtDat_Set( HcoState, ExtState%SZAFACT, & - TRIM( Name ), RC, FIRST=FIRST ) + TRIM( Name ), RC, FIRST=FIRST ) IF ( RC /= HCO_SUCCESS ) THEN ErrMsg = 'Could not find quantity "' // TRIM( Name ) // & '" for the HEMCO standalone simulation!' @@ -2556,7 +2610,7 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) IF ( ExtState%JNO2%DoUse ) THEN Name = 'JNO2' CALL ExtDat_Set( HcoState, ExtState%JNO2, & - TRIM( Name ), RC, FIRST=FIRST ) + TRIM( Name ), RC, FIRST=FIRST ) IF ( RC == HCO_SUCCESS ) THEN ErrMsg = 'Could not find quantity "' // TRIM( Name ) // & '" for the HEMCO standalone simulation!' @@ -2569,7 +2623,7 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) IF ( ExtState%JOH%DoUse ) THEN Name = 'JOH' CALL ExtDat_Set( HcoState, ExtState%JOH, & - TRIM( Name ), RC, FIRST=FIRST ) + TRIM( Name ), RC, FIRST=FIRST ) IF ( RC == HCO_SUCCESS ) THEN ErrMsg = 'Could not find quantity "' // TRIM( Name ) // & '" for the HEMCO standalone simulation!' @@ -2589,9 +2643,8 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) !%%%%% Cloud convection mass flux %%%%% IF ( ExtState%CNV_MFC%DoUse ) THEN Name = 'CMFMC' - CALL ExtDat_Set( HcoState, ExtState%CNV_MFC, & - TRIM( Name ), RC, FIRST=FIRST, & - OnLevEdge=.TRUE. ) + CALL ExtDat_Set( HcoState, ExtState%CNV_MFC, TRIM( Name ), & + RC, FIRST=FIRST, OnLevEdge=.TRUE. ) IF ( RC /= HCO_SUCCESS ) THEN ErrMsg = 'Could not find quantity "' // TRIM( Name ) // & '" for the HEMCO standalone simulation!' @@ -2605,7 +2658,7 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) IF ( ExtState%SPHU%DoUse ) THEN Name = 'SPHU' CALL ExtDat_Set( HcoState, ExtState%SPHU, & - TRIM( Name ), RC, FIRST=FIRST ) + TRIM( Name ), RC, FIRST=FIRST ) IF ( RC /= HCO_SUCCESS ) THEN ErrMsg = 'Could not find quantity "' // TRIM( Name ) // & '" for the HEMCO standalone simulation!' @@ -2619,7 +2672,7 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) IF ( ExtState%TK%DoUse ) THEN Name = 'TMPU' CALL ExtDat_Set( HcoState, ExtState%TK, & - TRIM( Name ), RC, FIRST=FIRST ) + TRIM( Name ), RC, FIRST=FIRST ) IF ( RC /= HCO_SUCCESS ) THEN ErrMsg = 'Could not find quantity "' // TRIM( Name ) // & '" for the HEMCO standalone simulation!' @@ -2633,7 +2686,7 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) IF ( ExtState%AIR%DoUse ) THEN Name = 'AIR' CALL ExtDat_Set( HcoState, ExtState%AIR, & - TRIM( Name ), RC, FIRST=FIRST ) + TRIM( Name ), RC, FIRST=FIRST ) IF ( RC == HCO_SUCCESS ) THEN ErrMsg = 'Could not find quantity "' // TRIM( Name ) // & '" for the HEMCO standalone simulation!' @@ -2646,7 +2699,7 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) IF ( ExtState%AIRVOL%DoUse ) THEN Name = 'AIRVOL' CALL ExtDat_Set( HcoState, ExtState%AIRVOL, & - TRIM( Name ), RC, FIRST=FIRST ) + TRIM( Name ), RC, FIRST=FIRST ) IF ( RC == HCO_SUCCESS ) THEN ErrMsg = 'Could not find quantity "' // TRIM( Name ) // & '" for the HEMCO standalone simulation!' @@ -2659,7 +2712,7 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) IF ( ExtState%AIRDEN%DoUse ) THEN Name = 'AIRDEN' CALL ExtDat_Set( HcoState, ExtState%AIRDEN, & - TRIM( Name ), RC, FIRST=FIRST ) + TRIM( Name ), RC, FIRST=FIRST ) IF ( RC == HCO_SUCCESS ) THEN ErrMsg = 'Could not find quantity "' // TRIM( Name ) // & '" for the HEMCO standalone simulation!' @@ -2669,11 +2722,11 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) ENDIF ENDIF - !%%%%% Concentration fields %%%%% + !%%%%% O3 concentration %%%%% IF ( ExtState%O3%DoUse ) THEN Name = 'O3' CALL ExtDat_Set( HcoState, ExtState%O3, & - TRIM( Name ), RC, FIRST=FIRST ) + TRIM( Name ), RC, FIRST=FIRST ) IF ( RC == HCO_SUCCESS ) THEN ErrMsg = 'Could not find quantity "' // TRIM( Name ) // & '" for the HEMCO standalone simulation!' @@ -2683,10 +2736,11 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) ENDIF ENDIF + !%%%%% NO concentration %%%%% IF ( ExtState%NO%DoUse ) THEN Name = 'NO' CALL ExtDat_Set( HcoState, ExtState%NO, & - TRIM( Name ), RC, FIRST=FIRST ) + TRIM( Name ), RC, FIRST=FIRST ) IF ( RC == HCO_SUCCESS ) THEN ErrMsg = 'Could not find quantity "' // TRIM( Name ) // & '" for the HEMCO standalone simulation!' @@ -2696,10 +2750,11 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) ENDIF ENDIF + !%%%%% NO2 concentration %%%%% IF ( ExtState%NO2%DoUse ) THEN Name = 'NO2' CALL ExtDat_Set( HcoState, ExtState%NO2, & - TRIM( Name ), RC, FIRST=FIRST ) + TRIM( Name ), RC, FIRST=FIRST ) IF ( RC == HCO_SUCCESS ) THEN ErrMsg = 'Could not find quantity "' // TRIM( Name ) // & '" for the HEMCO standalone simulation!' @@ -2709,10 +2764,11 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) ENDIF ENDIF + !%%%%% HNO3 concentration %%%%% IF ( ExtState%HNO3%DoUse ) THEN Name = 'HNO3' CALL ExtDat_Set( HcoState, ExtState%HNO3, & - TRIM( Name ), RC, FIRST=FIRST ) + TRIM( Name ), RC, FIRST=FIRST ) IF ( RC == HCO_SUCCESS ) THEN ErrMsg = 'Could not find quantity "' // TRIM( Name ) // & '" for the HEMCO standalone simulation!' @@ -2722,11 +2778,11 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) ENDIF ENDIF - !%%%%% Deposition fields (for soil NOx) %%%%% + !%%%%% Dry-deposited nitrogen (for soil NOx) %%%%% IF ( ExtState%DRY_TOTN%DoUse ) THEN Name = 'DRY_TOTN' CALL ExtDat_Set( HcoState, ExtState%DRY_TOTN, & - TRIM( Name ), RC, FIRST=FIRST ) + TRIM( Name ), RC, FIRST=FIRST ) IF ( RC == HCO_SUCCESS ) THEN ErrMsg = 'Could not find quantity "' // TRIM( Name ) // & '" for the HEMCO standalone simulation!' @@ -2736,10 +2792,11 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) ENDIF ENDIF + !%%%%% Wet-deposited nitrogen (for soil NOx) %%%%% IF ( ExtState%WET_TOTN%DoUse ) THEN Name = 'WET_TOTN' CALL ExtDat_Set( HcoState, ExtState%WET_TOTN, & - TRIM( Name ), RC, FIRST=FIRST ) + TRIM( Name ), RC, FIRST=FIRST ) IF ( RC == HCO_SUCCESS ) THEN ErrMsg = 'Could not find quantity "' // TRIM( Name ) // & '" for the HEMCO standalone simulation!' @@ -2753,7 +2810,7 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) IF ( ExtState%FRAC_OF_PBL%DoUse ) THEN Name = 'FRAC_OF_PBL' CALL ExtDat_Set( HcoState, ExtState%FRAC_OF_PBL, & - TRIM( Name ), RC, FIRST=FIRST ) + TRIM( Name ), RC, FIRST=FIRST ) IF ( RC == HCO_SUCCESS ) THEN ErrMsg = 'Could not find quantity "' // TRIM( Name ) // & '" for the HEMCO standalone simulation!' @@ -2763,16 +2820,16 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) ENDIF ENDIF - !----------------------------------------------------------------- + !------------------------------------------------------------------------ ! ==> DRYCOEFF must be read from the configuration file in module ! hcox_soilnox_mod.F90. - !----------------------------------------------------------------- + !------------------------------------------------------------------------ - !----------------------------------------------------------------- + !------------------------------------------------------------------------ ! Check for vertical grid update. This will try to read the ! vertical grid quantities from disk or calculate them from other ! quantities read from disk. - !----------------------------------------------------------------- + !------------------------------------------------------------------------ ! Attempt to calculate vertical grid quantities CALL HCO_CalcVertGrid( HcoState, PSFC, ZSFC, TK, BXHEIGHT, PEDGE, RC ) @@ -2789,12 +2846,13 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) BXHEIGHT => NULL() PEDGE => NULL() - !----------------------------------------------------------------- + !------------------------------------------------------------------------ ! If needed, calculate SUNCOS values - !----------------------------------------------------------------- + !------------------------------------------------------------------------ IF ( ExtState%SUNCOS%DoUse ) THEN IF ( FIRST ) THEN - CALL HCO_ArrAssert( ExtState%SUNCOS%Arr, HcoState%NX, HcoState%NY, RC ) + CALL HCO_ArrAssert( ExtState%SUNCOS%Arr, HcoState%NX, & + HcoState%NY, RC ) IF ( RC /= HCO_SUCCESS ) THEN ErrMsg = 'SUNCOS array is not the expected dimensions!' CALL HCO_Error( ErrMsg, RC, ThisLoc ) @@ -2812,9 +2870,9 @@ SUBROUTINE ExtState_SetFields ( HcoState, ExtState, RC ) ENDIF ENDIF - !----------------------------------------------------------------- + !------------------------------------------------------------------------ ! All done - !----------------------------------------------------------------- + !------------------------------------------------------------------------ ! Not first call any more FIRST = .FALSE.